aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorno-author <no-author@gcc.gnu.org>1997-08-21 22:58:49 +0000
committerno-author <no-author@gcc.gnu.org>1997-08-21 22:58:49 +0000
commitf89bc1624a9f01bd33de395ea8ee8698634af79d (patch)
treeb5402095de45a8d16fd7dd80a4fa06b7f02a0bda
parenta1ca14cd2336b3e92b74bc0cab73ca09a1f78d68 (diff)
This commit was manufactured by cvs2svn to create tag 'start'.start
git-svn-id: https://gcc.gnu.org/svn/gcc/tags/start@14881 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--.cvsignore31
-rw-r--r--COPYING340
-rw-r--r--COPYING.LIB481
-rw-r--r--ChangeLog5207
-rw-r--r--Makefile.in1608
-rw-r--r--README47
-rw-r--r--config-ml.in612
-rwxr-xr-xconfig.guess833
-rwxr-xr-xconfig.sub1177
-rw-r--r--config/ChangeLog312
-rw-r--r--config/mh-a68bsd12
-rw-r--r--config/mh-aix3861
-rw-r--r--config/mh-apollo683
-rw-r--r--config/mh-cxux14
-rw-r--r--config/mh-cygwin3216
-rw-r--r--config/mh-decstation5
-rw-r--r--config/mh-delta884
-rw-r--r--config/mh-dgux4
-rw-r--r--config/mh-dgux38622
-rw-r--r--config/mh-go324
-rw-r--r--config/mh-hp30013
-rw-r--r--config/mh-hpux4
-rw-r--r--config/mh-hpux84
-rw-r--r--config/mh-irix47
-rw-r--r--config/mh-irix53
-rw-r--r--config/mh-irix67
-rw-r--r--config/mh-lynxos2
-rw-r--r--config/mh-lynxrs6k8
-rw-r--r--config/mh-m68kpic1
-rw-r--r--config/mh-ncr300017
-rw-r--r--config/mh-ncrsvr439
-rw-r--r--config/mh-necv411
-rw-r--r--config/mh-papic1
-rw-r--r--config/mh-ppcpic1
-rw-r--r--config/mh-riscos15
-rw-r--r--config/mh-sco10
-rw-r--r--config/mh-solaris6
-rw-r--r--config/mh-sparcpic1
-rw-r--r--config/mh-sun33
-rw-r--r--config/mh-sysv3
-rw-r--r--config/mh-sysv411
-rw-r--r--config/mh-vaxult22
-rw-r--r--config/mh-windows16
-rw-r--r--config/mh-x86pic1
-rw-r--r--config/mpw-mh-mpw157
-rw-r--r--config/mpw/ChangeLog53
-rw-r--r--config/mpw/MoveIfChange19
-rw-r--r--config/mpw/README23
-rw-r--r--config/mpw/forward-include3
-rw-r--r--config/mpw/g-mpw-make.sed293
-rw-r--r--config/mpw/mpw-touch7
-rw-r--r--config/mpw/mpw-true1
-rw-r--r--config/mpw/null-command1
-rw-r--r--config/mpw/open-brace4
-rw-r--r--config/mpw/tr-7to8-src9
-rw-r--r--config/mpw/true1
-rw-r--r--config/mt-m68kpic1
-rw-r--r--config/mt-netware1
-rw-r--r--config/mt-papic1
-rw-r--r--config/mt-ppcpic1
-rw-r--r--config/mt-sparcpic1
-rw-r--r--config/mt-v8104
-rw-r--r--config/mt-x86pic1
-rwxr-xr-xconfigure1406
-rw-r--r--configure.in874
-rw-r--r--etc/ChangeLog392
-rw-r--r--etc/Makefile.in88
-rwxr-xr-xetc/configure858
-rw-r--r--etc/configure.in7
-rw-r--r--etc/make-stds.texi893
-rw-r--r--etc/standards.texi3061
-rw-r--r--gcc/config/alpha/vms-tramp.asm22
-rw-r--r--gcc/config/float-i128.h96
-rw-r--r--gcc/f/BUGS198
-rw-r--r--gcc/f/ChangeLog3721
-rw-r--r--gcc/f/INSTALL1517
-rw-r--r--gcc/f/Make-lang.in567
-rw-r--r--gcc/f/Makefile.in562
-rw-r--r--gcc/f/NEWS1064
-rw-r--r--gcc/f/README7
-rw-r--r--gcc/f/assert.j27
-rw-r--r--gcc/f/bad.c543
-rw-r--r--gcc/f/bad.def705
-rw-r--r--gcc/f/bad.h108
-rw-r--r--gcc/f/bit.c201
-rw-r--r--gcc/f/bit.h84
-rw-r--r--gcc/f/bld-op.def69
-rw-r--r--gcc/f/bld.c5782
-rw-r--r--gcc/f/bld.h1009
-rw-r--r--gcc/f/bugs.texi287
-rw-r--r--gcc/f/bugs0.texi17
-rw-r--r--gcc/f/com-rt.def281
-rw-r--r--gcc/f/com.c16225
-rw-r--r--gcc/f/com.h419
-rw-r--r--gcc/f/config-lang.in100
-rw-r--r--gcc/f/config.j27
-rw-r--r--gcc/f/convert.j28
-rw-r--r--gcc/f/data.c1810
-rw-r--r--gcc/f/data.h74
-rw-r--r--gcc/f/equiv.c1444
-rw-r--r--gcc/f/equiv.h101
-rw-r--r--gcc/f/expr.c19405
-rw-r--r--gcc/f/expr.h194
-rw-r--r--gcc/f/fini.c774
-rw-r--r--gcc/f/flags.j27
-rw-r--r--gcc/f/g77.1364
-rw-r--r--gcc/f/g77.c1557
-rw-r--r--gcc/f/g77.texi13831
-rw-r--r--gcc/f/gbe/2.7.2.2.diff11296
-rw-r--r--gcc/f/gbe/README45
-rw-r--r--gcc/f/glimits.j28
-rw-r--r--gcc/f/global.c1490
-rw-r--r--gcc/f/global.h201
-rw-r--r--gcc/f/hconfig.j27
-rw-r--r--gcc/f/implic.c383
-rw-r--r--gcc/f/implic.h74
-rw-r--r--gcc/f/info-b.def36
-rw-r--r--gcc/f/info-k.def37
-rw-r--r--gcc/f/info-w.def41
-rw-r--r--gcc/f/info.c305
-rw-r--r--gcc/f/info.h186
-rw-r--r--gcc/f/input.j27
-rw-r--r--gcc/f/install.texi2036
-rw-r--r--gcc/f/install0.texi14
-rw-r--r--gcc/f/intdoc.c1339
-rw-r--r--gcc/f/intdoc.h2370
-rw-r--r--gcc/f/intdoc.texi10570
-rw-r--r--gcc/f/intrin.c2047
-rw-r--r--gcc/f/intrin.def3350
-rw-r--r--gcc/f/intrin.h130
-rw-r--r--gcc/f/lab.c159
-rw-r--r--gcc/f/lab.h154
-rw-r--r--gcc/f/lang-options.h152
-rw-r--r--gcc/f/lang-specs.h96
-rw-r--r--gcc/f/lex.c4697
-rw-r--r--gcc/f/lex.h202
-rw-r--r--gcc/f/malloc.c565
-rw-r--r--gcc/f/malloc.h183
-rw-r--r--gcc/f/name.c242
-rw-r--r--gcc/f/name.h109
-rw-r--r--gcc/f/news.texi1468
-rw-r--r--gcc/f/news0.texi14
-rw-r--r--gcc/f/parse.c93
-rw-r--r--gcc/f/proj.c71
-rw-r--r--gcc/f/proj.h102
-rw-r--r--gcc/f/rtl.j28
-rw-r--r--gcc/f/runtime/ChangeLog698
-rw-r--r--gcc/f/runtime/Makefile.in251
-rw-r--r--gcc/f/runtime/README46
-rw-r--r--gcc/f/runtime/TODO17
-rw-r--r--gcc/f/runtime/changes.netlib2836
-rwxr-xr-xgcc/f/runtime/configure2048
-rw-r--r--gcc/f/runtime/configure.in371
-rw-r--r--gcc/f/runtime/disclaimer.netlib15
-rw-r--r--gcc/f/runtime/f2c.h.in227
-rw-r--r--gcc/f/runtime/f2cext.c565
-rw-r--r--gcc/f/runtime/libF77/F77_aloc.c32
-rw-r--r--gcc/f/runtime/libF77/Makefile.in95
-rw-r--r--gcc/f/runtime/libF77/Notice23
-rw-r--r--gcc/f/runtime/libF77/README.netlib108
-rw-r--r--gcc/f/runtime/libF77/Version.c65
-rw-r--r--gcc/f/runtime/libF77/abort_.c18
-rw-r--r--gcc/f/runtime/libF77/c_abs.c14
-rw-r--r--gcc/f/runtime/libF77/c_cos.c21
-rw-r--r--gcc/f/runtime/libF77/c_div.c40
-rw-r--r--gcc/f/runtime/libF77/c_exp.c23
-rw-r--r--gcc/f/runtime/libF77/c_log.c21
-rw-r--r--gcc/f/runtime/libF77/c_sin.c21
-rw-r--r--gcc/f/runtime/libF77/c_sqrt.c38
-rw-r--r--gcc/f/runtime/libF77/cabs.c27
-rw-r--r--gcc/f/runtime/libF77/d_abs.c12
-rw-r--r--gcc/f/runtime/libF77/d_acos.c13
-rw-r--r--gcc/f/runtime/libF77/d_asin.c13
-rw-r--r--gcc/f/runtime/libF77/d_atan.c13
-rw-r--r--gcc/f/runtime/libF77/d_atn2.c13
-rw-r--r--gcc/f/runtime/libF77/d_cnjg.c17
-rw-r--r--gcc/f/runtime/libF77/d_cos.c13
-rw-r--r--gcc/f/runtime/libF77/d_cosh.c13
-rw-r--r--gcc/f/runtime/libF77/d_dim.c10
-rw-r--r--gcc/f/runtime/libF77/d_exp.c13
-rw-r--r--gcc/f/runtime/libF77/d_imag.c10
-rw-r--r--gcc/f/runtime/libF77/d_int.c13
-rw-r--r--gcc/f/runtime/libF77/d_lg10.c15
-rw-r--r--gcc/f/runtime/libF77/d_log.c13
-rw-r--r--gcc/f/runtime/libF77/d_mod.c40
-rw-r--r--gcc/f/runtime/libF77/d_nint.c14
-rw-r--r--gcc/f/runtime/libF77/d_prod.c10
-rw-r--r--gcc/f/runtime/libF77/d_sign.c12
-rw-r--r--gcc/f/runtime/libF77/d_sin.c13
-rw-r--r--gcc/f/runtime/libF77/d_sinh.c13
-rw-r--r--gcc/f/runtime/libF77/d_sqrt.c13
-rw-r--r--gcc/f/runtime/libF77/d_tan.c13
-rw-r--r--gcc/f/runtime/libF77/d_tanh.c13
-rw-r--r--gcc/f/runtime/libF77/derf_.c12
-rw-r--r--gcc/f/runtime/libF77/derfc_.c14
-rw-r--r--gcc/f/runtime/libF77/dtime_.c45
-rw-r--r--gcc/f/runtime/libF77/ef1asc_.c21
-rw-r--r--gcc/f/runtime/libF77/ef1cmc_.c14
-rw-r--r--gcc/f/runtime/libF77/erf_.c12
-rw-r--r--gcc/f/runtime/libF77/erfc_.c12
-rw-r--r--gcc/f/runtime/libF77/etime_.c38
-rw-r--r--gcc/f/runtime/libF77/exit_.c37
-rw-r--r--gcc/f/runtime/libF77/f2ch.add162
-rw-r--r--gcc/f/runtime/libF77/getarg_.c28
-rw-r--r--gcc/f/runtime/libF77/getenv_.c51
-rw-r--r--gcc/f/runtime/libF77/h_abs.c12
-rw-r--r--gcc/f/runtime/libF77/h_dim.c10
-rw-r--r--gcc/f/runtime/libF77/h_dnnt.c14
-rw-r--r--gcc/f/runtime/libF77/h_indx.c26
-rw-r--r--gcc/f/runtime/libF77/h_len.c10
-rw-r--r--gcc/f/runtime/libF77/h_mod.c10
-rw-r--r--gcc/f/runtime/libF77/h_nint.c14
-rw-r--r--gcc/f/runtime/libF77/h_sign.c12
-rw-r--r--gcc/f/runtime/libF77/hl_ge.c12
-rw-r--r--gcc/f/runtime/libF77/hl_gt.c12
-rw-r--r--gcc/f/runtime/libF77/hl_le.c12
-rw-r--r--gcc/f/runtime/libF77/hl_lt.c12
-rw-r--r--gcc/f/runtime/libF77/i_abs.c12
-rw-r--r--gcc/f/runtime/libF77/i_dim.c10
-rw-r--r--gcc/f/runtime/libF77/i_dnnt.c14
-rw-r--r--gcc/f/runtime/libF77/i_indx.c26
-rw-r--r--gcc/f/runtime/libF77/i_len.c10
-rw-r--r--gcc/f/runtime/libF77/i_mod.c10
-rw-r--r--gcc/f/runtime/libF77/i_nint.c14
-rw-r--r--gcc/f/runtime/libF77/i_sign.c12
-rw-r--r--gcc/f/runtime/libF77/iargc_.c11
-rw-r--r--gcc/f/runtime/libF77/l_ge.c12
-rw-r--r--gcc/f/runtime/libF77/l_gt.c12
-rw-r--r--gcc/f/runtime/libF77/l_le.c12
-rw-r--r--gcc/f/runtime/libF77/l_lt.c12
-rw-r--r--gcc/f/runtime/libF77/lbitbits.c62
-rw-r--r--gcc/f/runtime/libF77/lbitshft.c11
-rw-r--r--gcc/f/runtime/libF77/main.c135
-rw-r--r--gcc/f/runtime/libF77/makefile.netlib103
-rw-r--r--gcc/f/runtime/libF77/pow_ci.c20
-rw-r--r--gcc/f/runtime/libF77/pow_dd.c13
-rw-r--r--gcc/f/runtime/libF77/pow_di.c35
-rw-r--r--gcc/f/runtime/libF77/pow_hh.c33
-rw-r--r--gcc/f/runtime/libF77/pow_ii.c33
-rw-r--r--gcc/f/runtime/libF77/pow_qq.c33
-rw-r--r--gcc/f/runtime/libF77/pow_ri.c35
-rw-r--r--gcc/f/runtime/libF77/pow_zi.c61
-rw-r--r--gcc/f/runtime/libF77/pow_zz.c23
-rw-r--r--gcc/f/runtime/libF77/qbitbits.c66
-rw-r--r--gcc/f/runtime/libF77/qbitshft.c11
-rw-r--r--gcc/f/runtime/libF77/r_abs.c12
-rw-r--r--gcc/f/runtime/libF77/r_acos.c13
-rw-r--r--gcc/f/runtime/libF77/r_asin.c13
-rw-r--r--gcc/f/runtime/libF77/r_atan.c13
-rw-r--r--gcc/f/runtime/libF77/r_atn2.c13
-rw-r--r--gcc/f/runtime/libF77/r_cnjg.c16
-rw-r--r--gcc/f/runtime/libF77/r_cos.c13
-rw-r--r--gcc/f/runtime/libF77/r_cosh.c13
-rw-r--r--gcc/f/runtime/libF77/r_dim.c10
-rw-r--r--gcc/f/runtime/libF77/r_exp.c13
-rw-r--r--gcc/f/runtime/libF77/r_imag.c10
-rw-r--r--gcc/f/runtime/libF77/r_int.c13
-rw-r--r--gcc/f/runtime/libF77/r_lg10.c15
-rw-r--r--gcc/f/runtime/libF77/r_log.c13
-rw-r--r--gcc/f/runtime/libF77/r_mod.c40
-rw-r--r--gcc/f/runtime/libF77/r_nint.c14
-rw-r--r--gcc/f/runtime/libF77/r_sign.c12
-rw-r--r--gcc/f/runtime/libF77/r_sin.c13
-rw-r--r--gcc/f/runtime/libF77/r_sinh.c13
-rw-r--r--gcc/f/runtime/libF77/r_sqrt.c13
-rw-r--r--gcc/f/runtime/libF77/r_tan.c13
-rw-r--r--gcc/f/runtime/libF77/r_tanh.c13
-rw-r--r--gcc/f/runtime/libF77/s_cat.c75
-rw-r--r--gcc/f/runtime/libF77/s_cmp.c44
-rw-r--r--gcc/f/runtime/libF77/s_copy.c51
-rw-r--r--gcc/f/runtime/libF77/s_paus.c88
-rw-r--r--gcc/f/runtime/libF77/s_rnge.c26
-rw-r--r--gcc/f/runtime/libF77/s_stop.c37
-rw-r--r--gcc/f/runtime/libF77/sig_die.c45
-rw-r--r--gcc/f/runtime/libF77/signal1.h5
-rw-r--r--gcc/f/runtime/libF77/signal1.h025
-rw-r--r--gcc/f/runtime/libF77/signal_.c14
-rw-r--r--gcc/f/runtime/libF77/system_.c36
-rw-r--r--gcc/f/runtime/libF77/z_abs.c12
-rw-r--r--gcc/f/runtime/libF77/z_cos.c19
-rw-r--r--gcc/f/runtime/libF77/z_div.c39
-rw-r--r--gcc/f/runtime/libF77/z_exp.c21
-rw-r--r--gcc/f/runtime/libF77/z_log.c20
-rw-r--r--gcc/f/runtime/libF77/z_sin.c19
-rw-r--r--gcc/f/runtime/libF77/z_sqrt.c33
-rw-r--r--gcc/f/runtime/libI77/Makefile.in129
-rw-r--r--gcc/f/runtime/libI77/Notice23
-rw-r--r--gcc/f/runtime/libI77/README.netlib225
-rw-r--r--gcc/f/runtime/libI77/Version.c272
-rw-r--r--gcc/f/runtime/libI77/backspace.c101
-rw-r--r--gcc/f/runtime/libI77/close.c99
-rw-r--r--gcc/f/runtime/libI77/dfe.c156
-rw-r--r--gcc/f/runtime/libI77/dolio.c20
-rw-r--r--gcc/f/runtime/libI77/due.c73
-rw-r--r--gcc/f/runtime/libI77/endfile.c195
-rw-r--r--gcc/f/runtime/libI77/err.c298
-rw-r--r--gcc/f/runtime/libI77/f2ch.add162
-rw-r--r--gcc/f/runtime/libI77/fio.h102
-rw-r--r--gcc/f/runtime/libI77/fmt.c516
-rw-r--r--gcc/f/runtime/libI77/fmt.h99
-rw-r--r--gcc/f/runtime/libI77/fmtlib.c45
-rw-r--r--gcc/f/runtime/libI77/fp.h28
-rw-r--r--gcc/f/runtime/libI77/ftell_.c46
-rw-r--r--gcc/f/runtime/libI77/iio.c147
-rw-r--r--gcc/f/runtime/libI77/ilnw.c82
-rw-r--r--gcc/f/runtime/libI77/inquire.c108
-rw-r--r--gcc/f/runtime/libI77/lio.h74
-rw-r--r--gcc/f/runtime/libI77/lread.c684
-rw-r--r--gcc/f/runtime/libI77/lwrite.c310
-rw-r--r--gcc/f/runtime/libI77/makefile.netlib104
-rw-r--r--gcc/f/runtime/libI77/open.c245
-rw-r--r--gcc/f/runtime/libI77/rawio.h45
-rw-r--r--gcc/f/runtime/libI77/rdfmt.c476
-rw-r--r--gcc/f/runtime/libI77/rewind.c26
-rw-r--r--gcc/f/runtime/libI77/rsfe.c80
-rw-r--r--gcc/f/runtime/libI77/rsli.c105
-rw-r--r--gcc/f/runtime/libI77/rsne.c607
-rw-r--r--gcc/f/runtime/libI77/sfe.c44
-rw-r--r--gcc/f/runtime/libI77/sue.c87
-rw-r--r--gcc/f/runtime/libI77/typesize.c12
-rw-r--r--gcc/f/runtime/libI77/uio.c69
-rw-r--r--gcc/f/runtime/libI77/util.c51
-rw-r--r--gcc/f/runtime/libI77/wref.c276
-rw-r--r--gcc/f/runtime/libI77/wrtfmt.c385
-rw-r--r--gcc/f/runtime/libI77/wsfe.c85
-rw-r--r--gcc/f/runtime/libI77/wsle.c41
-rw-r--r--gcc/f/runtime/libI77/wsne.c26
-rw-r--r--gcc/f/runtime/libI77/xwsne.c72
-rw-r--r--gcc/f/runtime/libU77/COPYING.LIB481
-rw-r--r--gcc/f/runtime/libU77/Makefile.in155
-rw-r--r--gcc/f/runtime/libU77/PROJECTS10
-rw-r--r--gcc/f/runtime/libU77/README40
-rw-r--r--gcc/f/runtime/libU77/Version.c12
-rw-r--r--gcc/f/runtime/libU77/access_.c80
-rw-r--r--gcc/f/runtime/libU77/acconfig.h2
-rw-r--r--gcc/f/runtime/libU77/alarm_.c59
-rw-r--r--gcc/f/runtime/libU77/bes.c46
-rw-r--r--gcc/f/runtime/libU77/chdir_.c57
-rw-r--r--gcc/f/runtime/libU77/chmod_.c79
-rw-r--r--gcc/f/runtime/libU77/config.h.in73
-rwxr-xr-xgcc/f/runtime/libU77/configure1758
-rw-r--r--gcc/f/runtime/libU77/configure.in111
-rw-r--r--gcc/f/runtime/libU77/ctime_.c57
-rw-r--r--gcc/f/runtime/libU77/date_.c39
-rw-r--r--gcc/f/runtime/libU77/dbes.c46
-rw-r--r--gcc/f/runtime/libU77/dtime_.c82
-rw-r--r--gcc/f/runtime/libU77/etime_.c78
-rw-r--r--gcc/f/runtime/libU77/fdate_.c53
-rw-r--r--gcc/f/runtime/libU77/fgetc_.c70
-rw-r--r--gcc/f/runtime/libU77/flush1_.c46
-rw-r--r--gcc/f/runtime/libU77/fnum_.c38
-rw-r--r--gcc/f/runtime/libU77/fputc_.c65
-rw-r--r--gcc/f/runtime/libU77/fstat_.c71
-rw-r--r--gcc/f/runtime/libU77/gerror_.c49
-rw-r--r--gcc/f/runtime/libU77/getcwd_.c98
-rw-r--r--gcc/f/runtime/libU77/getgid_.c35
-rw-r--r--gcc/f/runtime/libU77/getlog_.c62
-rw-r--r--gcc/f/runtime/libU77/getpid_.c35
-rw-r--r--gcc/f/runtime/libU77/getuid_.c35
-rw-r--r--gcc/f/runtime/libU77/gmtime_.c54
-rw-r--r--gcc/f/runtime/libU77/hostnm_.c48
-rw-r--r--gcc/f/runtime/libU77/idate_.c57
-rw-r--r--gcc/f/runtime/libU77/ierrno_.c32
-rw-r--r--gcc/f/runtime/libU77/irand_.c57
-rw-r--r--gcc/f/runtime/libU77/isatty_.c44
-rw-r--r--gcc/f/runtime/libU77/itime_.c51
-rw-r--r--gcc/f/runtime/libU77/kill_.c37
-rw-r--r--gcc/f/runtime/libU77/link_.c58
-rw-r--r--gcc/f/runtime/libU77/lnblnk_.c35
-rw-r--r--gcc/f/runtime/libU77/lstat_.c86
-rw-r--r--gcc/f/runtime/libU77/ltime_.c54
-rw-r--r--gcc/f/runtime/libU77/mclock_.c47
-rw-r--r--gcc/f/runtime/libU77/perror_.c48
-rw-r--r--gcc/f/runtime/libU77/rand_.c54
-rw-r--r--gcc/f/runtime/libU77/rename_.c53
-rw-r--r--gcc/f/runtime/libU77/secnds_.c51
-rw-r--r--gcc/f/runtime/libU77/second_.c26
-rw-r--r--gcc/f/runtime/libU77/sleep_.c37
-rw-r--r--gcc/f/runtime/libU77/srand_.c37
-rw-r--r--gcc/f/runtime/libU77/stat_.c79
-rw-r--r--gcc/f/runtime/libU77/symlnk_.c62
-rw-r--r--gcc/f/runtime/libU77/system_clock_.c64
-rw-r--r--gcc/f/runtime/libU77/time_.c46
-rw-r--r--gcc/f/runtime/libU77/ttynam_.c57
-rw-r--r--gcc/f/runtime/libU77/u77-test.f178
-rw-r--r--gcc/f/runtime/libU77/umask_.c34
-rw-r--r--gcc/f/runtime/libU77/unlink_.c55
-rw-r--r--gcc/f/runtime/libU77/vxtidate_.c55
-rw-r--r--gcc/f/runtime/libU77/vxttime_.c54
-rw-r--r--gcc/f/runtime/permission.netlib23
-rw-r--r--gcc/f/runtime/readme.netlib585
-rw-r--r--gcc/f/src.c436
-rw-r--r--gcc/f/src.h144
-rw-r--r--gcc/f/st.c554
-rw-r--r--gcc/f/st.h81
-rw-r--r--gcc/f/sta.c1993
-rw-r--r--gcc/f/sta.h116
-rw-r--r--gcc/f/stb.c25192
-rw-r--r--gcc/f/stb.h253
-rw-r--r--gcc/f/stc.c13895
-rw-r--r--gcc/f/stc.h360
-rw-r--r--gcc/f/std.c6739
-rw-r--r--gcc/f/std.h298
-rw-r--r--gcc/f/ste.c5414
-rw-r--r--gcc/f/ste.h168
-rw-r--r--gcc/f/storag.c573
-rw-r--r--gcc/f/storag.h167
-rw-r--r--gcc/f/stp.c59
-rw-r--r--gcc/f/stp.h508
-rw-r--r--gcc/f/str-1t.fin135
-rw-r--r--gcc/f/str-2t.fin60
-rw-r--r--gcc/f/str-fo.fin55
-rw-r--r--gcc/f/str-io.fin43
-rw-r--r--gcc/f/str-nq.fin55
-rw-r--r--gcc/f/str-op.fin57
-rw-r--r--gcc/f/str-ot.fin47
-rw-r--r--gcc/f/str.c217
-rw-r--r--gcc/f/str.h85
-rw-r--r--gcc/f/sts.c271
-rw-r--r--gcc/f/sts.h89
-rw-r--r--gcc/f/stt.c1034
-rw-r--r--gcc/f/stt.h218
-rw-r--r--gcc/f/stu.c1161
-rw-r--r--gcc/f/stu.h69
-rw-r--r--gcc/f/stv.c66
-rw-r--r--gcc/f/stv.h165
-rw-r--r--gcc/f/stw.c428
-rw-r--r--gcc/f/stw.h184
-rw-r--r--gcc/f/symbol.c1469
-rw-r--r--gcc/f/symbol.def654
-rw-r--r--gcc/f/symbol.h289
-rw-r--r--gcc/f/target.c2487
-rw-r--r--gcc/f/target.h1865
-rw-r--r--gcc/f/tconfig.j27
-rw-r--r--gcc/f/tm.j27
-rw-r--r--gcc/f/top.c926
-rw-r--r--gcc/f/top.h261
-rw-r--r--gcc/f/tree.j28
-rw-r--r--gcc/f/type.c107
-rw-r--r--gcc/f/type.h64
-rw-r--r--gcc/f/where.c542
-rw-r--r--gcc/f/where.h138
-rw-r--r--gcc/f/zzz.c56
-rw-r--r--gcc/f/zzz.h35
-rw-r--r--include/COPYING340
-rw-r--r--include/ChangeLog1254
-rw-r--r--include/ansidecl.h154
-rw-r--r--include/demangle.h90
-rw-r--r--include/floatformat.h111
-rw-r--r--include/fnmatch.h69
-rw-r--r--include/getopt.h129
-rw-r--r--include/libiberty.h161
-rw-r--r--include/objalloc.h115
-rw-r--r--include/obstack.h570
-rwxr-xr-xinstall-sh287
-rw-r--r--libiberty/COPYING.LIB481
-rw-r--r--libiberty/ChangeLog2233
-rw-r--r--libiberty/Makefile.in336
-rw-r--r--libiberty/README129
-rw-r--r--libiberty/alloca-botch.h5
-rw-r--r--libiberty/alloca-norm.h23
-rw-r--r--libiberty/alloca.c479
-rw-r--r--libiberty/argv.c333
-rw-r--r--libiberty/atexit.c14
-rw-r--r--libiberty/basename.c43
-rw-r--r--libiberty/bcmp.c49
-rw-r--r--libiberty/bcopy.c35
-rw-r--r--libiberty/bzero.c31
-rw-r--r--libiberty/choose-temp.c147
-rw-r--r--libiberty/clock.c73
-rw-r--r--libiberty/concat.c167
-rw-r--r--libiberty/config.h-vms13
-rw-r--r--libiberty/config.table69
-rw-r--r--libiberty/config/mh-a68bsd2
-rw-r--r--libiberty/config/mh-aix10
-rw-r--r--libiberty/config/mh-apollo682
-rw-r--r--libiberty/config/mh-cxux73
-rw-r--r--libiberty/config/mh-cygwin322
-rw-r--r--libiberty/config/mh-go321
-rw-r--r--libiberty/config/mh-hpbsd2
-rw-r--r--libiberty/config/mh-irix44
-rw-r--r--libiberty/config/mh-ncr300019
-rw-r--r--libiberty/config/mh-riscix6
-rw-r--r--libiberty/config/mh-sysv1
-rw-r--r--libiberty/config/mh-sysv43
-rw-r--r--libiberty/config/mh-windows2
-rw-r--r--libiberty/config/mt-sunos42
-rw-r--r--libiberty/config/mt-vxworks528
-rw-r--r--libiberty/configure.bat15
-rw-r--r--libiberty/configure.in66
-rw-r--r--libiberty/copysign.c140
-rw-r--r--libiberty/cplus-dem.c3087
-rw-r--r--libiberty/dummy.c49
-rw-r--r--libiberty/fdmatch.c73
-rw-r--r--libiberty/floatformat.c401
-rw-r--r--libiberty/fnmatch.c223
-rw-r--r--libiberty/functions.def69
-rw-r--r--libiberty/getcwd.c52
-rw-r--r--libiberty/getopt.c760
-rw-r--r--libiberty/getopt1.c190
-rw-r--r--libiberty/getpagesize.c89
-rw-r--r--libiberty/getruntime.c82
-rw-r--r--libiberty/hex.c33
-rw-r--r--libiberty/index.c11
-rw-r--r--libiberty/insque.c50
-rw-r--r--libiberty/makefile.dos29
-rw-r--r--libiberty/makefile.vms37
-rw-r--r--libiberty/memchr.c60
-rw-r--r--libiberty/memcmp.c38
-rw-r--r--libiberty/memcpy.c28
-rw-r--r--libiberty/memmove.c18
-rw-r--r--libiberty/memset.c19
-rw-r--r--libiberty/mpw-config.in9
-rw-r--r--libiberty/mpw-make.sed51
-rw-r--r--libiberty/mpw.c1010
-rw-r--r--libiberty/msdos.c15
-rw-r--r--libiberty/objalloc.c289
-rw-r--r--libiberty/obstack.c514
-rw-r--r--libiberty/pexecute.c580
-rw-r--r--libiberty/random.c373
-rw-r--r--libiberty/rename.c22
-rw-r--r--libiberty/rindex.c11
-rw-r--r--libiberty/sigsetmask.c30
-rw-r--r--libiberty/spaces.c78
-rw-r--r--libiberty/strcasecmp.c82
-rw-r--r--libiberty/strchr.c34
-rw-r--r--libiberty/strdup.c10
-rw-r--r--libiberty/strerror.c831
-rw-r--r--libiberty/strncasecmp.c82
-rw-r--r--libiberty/strrchr.c34
-rw-r--r--libiberty/strsignal.c638
-rw-r--r--libiberty/strstr.c51
-rw-r--r--libiberty/strtod.c122
-rw-r--r--libiberty/strtol.c143
-rw-r--r--libiberty/strtoul.c110
-rw-r--r--libiberty/tmpnam.c39
-rw-r--r--libiberty/vasprintf.c165
-rw-r--r--libiberty/vfork.c8
-rw-r--r--libiberty/vfprintf.c13
-rw-r--r--libiberty/vmsbuild.com166
-rw-r--r--libiberty/vprintf.c15
-rw-r--r--libiberty/vsprintf.c55
-rw-r--r--libiberty/waitpid.c11
-rw-r--r--libiberty/xatexit.c82
-rw-r--r--libiberty/xexit.c36
-rw-r--r--libiberty/xmalloc.c113
-rw-r--r--libiberty/xstrdup.c17
-rw-r--r--libiberty/xstrerror.c56
-rw-r--r--libio/ChangeLog1940
-rw-r--r--libio/Makefile.in124
-rw-r--r--libio/NEWS51
-rw-r--r--libio/PlotFile.cc157
-rw-r--r--libio/PlotFile.h89
-rw-r--r--libio/README30
-rw-r--r--libio/SFile.cc82
-rw-r--r--libio/SFile.h55
-rw-r--r--libio/builtinbuf.cc78
-rw-r--r--libio/builtinbuf.h68
-rw-r--r--libio/cleanup.c17
-rw-r--r--libio/config.shared487
-rw-r--r--libio/config/hpux.mt3
-rw-r--r--libio/config/isc.mt4
-rw-r--r--libio/config/linux.mt26
-rw-r--r--libio/config/mn10200.mt3
-rw-r--r--libio/config/netware.mt16
-rw-r--r--libio/config/sco4.mt3
-rw-r--r--libio/configure.in93
-rw-r--r--libio/dbz/Makefile.in217
-rw-r--r--libio/dbz/README25
-rw-r--r--libio/dbz/altbytes7
-rw-r--r--libio/dbz/byteflip.c38
-rw-r--r--libio/dbz/case.c129
-rw-r--r--libio/dbz/case.h12
-rw-r--r--libio/dbz/configure.in17
-rw-r--r--libio/dbz/dbz.1221
-rw-r--r--libio/dbz/dbz.3z547
-rw-r--r--libio/dbz/dbz.c1763
-rw-r--r--libio/dbz/dbz.h32
-rw-r--r--libio/dbz/dbzmain.c519
-rw-r--r--libio/dbz/fake.c144
-rw-r--r--libio/dbz/firstlast2550
-rwxr-xr-xlibio/dbz/getmap6
-rw-r--r--libio/dbz/random.c31
-rw-r--r--libio/dbz/revbytes7
-rw-r--r--libio/dbz/stdio.h1
-rw-r--r--libio/depend352
-rw-r--r--libio/editbuf.cc717
-rw-r--r--libio/editbuf.h185
-rw-r--r--libio/filebuf.cc206
-rw-r--r--libio/filedoalloc.c102
-rw-r--r--libio/fileops.c755
-rw-r--r--libio/floatconv.c2375
-rw-r--r--libio/floatio.h51
-rw-r--r--libio/fstream.cc110
-rw-r--r--libio/fstream.h92
-rwxr-xr-xlibio/gen-params698
-rw-r--r--libio/genops.c852
-rw-r--r--libio/indstream.cc121
-rw-r--r--libio/indstream.h77
-rw-r--r--libio/ioassign.cc49
-rw-r--r--libio/ioextend.cc132
-rw-r--r--libio/iofclose.c47
-rw-r--r--libio/iofdopen.c121
-rw-r--r--libio/iofflush.c38
-rw-r--r--libio/iofgetpos.c46
-rw-r--r--libio/iofgets.c40
-rw-r--r--libio/iofopen.c49
-rw-r--r--libio/iofprintf.c48
-rw-r--r--libio/iofputs.c37
-rw-r--r--libio/iofread.c38
-rw-r--r--libio/iofscanf.c48
-rw-r--r--libio/iofsetpos.c43
-rw-r--r--libio/ioftell.c45
-rw-r--r--libio/iofwrite.c44
-rw-r--r--libio/iogetdelim.c99
-rw-r--r--libio/iogetline.c74
-rw-r--r--libio/iogets.c47
-rw-r--r--libio/ioignore.c46
-rw-r--r--libio/iolibio.h53
-rw-r--r--libio/iomanip.cc90
-rw-r--r--libio/iomanip.h165
-rw-r--r--libio/iopadn.c65
-rw-r--r--libio/ioperror.c22
-rw-r--r--libio/iopopen.c222
-rw-r--r--libio/ioprims.c72
-rw-r--r--libio/ioprintf.c47
-rw-r--r--libio/ioputs.c38
-rw-r--r--libio/ioscanf.c47
-rw-r--r--libio/ioseekoff.c43
-rw-r--r--libio/ioseekpos.c39
-rw-r--r--libio/iosetbuffer.c36
-rw-r--r--libio/iosetvbuf.c78
-rw-r--r--libio/iosprintf.c47
-rw-r--r--libio/iosscanf.c47
-rw-r--r--libio/iostdio.h114
-rw-r--r--libio/iostream.cc821
-rw-r--r--libio/iostream.h258
-rw-r--r--libio/iostream.texi1971
-rw-r--r--libio/iostreamP.h26
-rw-r--r--libio/iostrerror.c12
-rw-r--r--libio/ioungetc.c35
-rw-r--r--libio/iovfprintf.c885
-rw-r--r--libio/iovfscanf.c787
-rw-r--r--libio/iovsprintf.c40
-rw-r--r--libio/iovsscanf.c37
-rw-r--r--libio/isgetline.cc139
-rw-r--r--libio/isgetsb.cc59
-rw-r--r--libio/isscan.cc45
-rw-r--r--libio/istream.h25
-rw-r--r--libio/libio.h267
-rw-r--r--libio/libioP.h497
-rw-r--r--libio/osform.cc54
-rw-r--r--libio/ostream.h25
-rw-r--r--libio/outfloat.c204
-rw-r--r--libio/parsestream.cc317
-rw-r--r--libio/parsestream.h156
-rw-r--r--libio/pfstream.cc92
-rw-r--r--libio/pfstream.h59
-rw-r--r--libio/procbuf.cc55
-rw-r--r--libio/procbuf.h50
-rw-r--r--libio/sbform.cc40
-rw-r--r--libio/sbgetline.cc31
-rw-r--r--libio/sbscan.cc45
-rw-r--r--libio/stdfiles.c44
-rw-r--r--libio/stdio/ChangeLog93
-rw-r--r--libio/stdio/Makefile.in23
-rw-r--r--libio/stdio/clearerr.c10
-rw-r--r--libio/stdio/configure.in48
-rw-r--r--libio/stdio/fdopen.c9
-rw-r--r--libio/stdio/feof.c34
-rw-r--r--libio/stdio/ferror.c10
-rw-r--r--libio/stdio/fgetc.c10
-rw-r--r--libio/stdio/fileno.c12
-rw-r--r--libio/stdio/fputc.c11
-rw-r--r--libio/stdio/freopen.c14
-rw-r--r--libio/stdio/fseek.c12
-rw-r--r--libio/stdio/getc.c11
-rw-r--r--libio/stdio/getchar.c10
-rw-r--r--libio/stdio/getline.c13
-rw-r--r--libio/stdio/getw.c13
-rw-r--r--libio/stdio/popen.c23
-rw-r--r--libio/stdio/putc.c12
-rw-r--r--libio/stdio/putchar.c10
-rw-r--r--libio/stdio/putw.c15
-rw-r--r--libio/stdio/rewind.c10
-rw-r--r--libio/stdio/setbuf.c9
-rw-r--r--libio/stdio/setfileno.c17
-rw-r--r--libio/stdio/setlinebuf.c11
-rw-r--r--libio/stdio/snprintf.c51
-rw-r--r--libio/stdio/stdio.h181
-rw-r--r--libio/stdio/vfprintf.c35
-rw-r--r--libio/stdio/vfscanf.c36
-rw-r--r--libio/stdio/vprintf.c33
-rw-r--r--libio/stdio/vscanf.c34
-rw-r--r--libio/stdio/vsnprintf.c43
-rw-r--r--libio/stdiostream.cc159
-rw-r--r--libio/stdiostream.h79
-rw-r--r--libio/stdstrbufs.cc115
-rw-r--r--libio/stdstreams.cc153
-rw-r--r--libio/stream.cc170
-rw-r--r--libio/stream.h59
-rw-r--r--libio/streambuf.cc343
-rw-r--r--libio/streambuf.h475
-rw-r--r--libio/strfile.h62
-rw-r--r--libio/strops.c290
-rw-r--r--libio/strstream.cc116
-rw-r--r--libio/strstream.h113
-rw-r--r--libio/tests/ChangeLog140
-rw-r--r--libio/tests/Makefile.in197
-rw-r--r--libio/tests/configure.in21
-rw-r--r--libio/tests/hounddog.cc85
-rw-r--r--libio/tests/hounddog.exp7
-rw-r--r--libio/tests/hounddog.inp7
-rw-r--r--libio/tests/putbackdog.cc97
-rw-r--r--libio/tests/tFile.cc550
-rw-r--r--libio/tests/tFile.exp75
-rw-r--r--libio/tests/tFile.inp5
-rw-r--r--libio/tests/tfformat.c4181
-rw-r--r--libio/tests/tiformat.c5112
-rw-r--r--libio/tests/tiomanip.cc35
-rw-r--r--libio/tests/tiomanip.exp4
-rw-r--r--libio/tests/tiomisc.cc236
-rw-r--r--libio/tests/tiomisc.exp11
-rw-r--r--libio/tests/tstdiomisc.c43
-rw-r--r--libio/tests/tstdiomisc.exp8
-rw-r--r--libio/testsuite/ChangeLog49
-rw-r--r--libio/testsuite/Makefile.in89
-rw-r--r--libio/testsuite/config/default.exp1
-rw-r--r--libio/testsuite/configure.in21
-rw-r--r--libio/testsuite/lib/libio.exp164
-rw-r--r--libio/testsuite/libio.tests/hounddog.exp3
-rw-r--r--libio/testsuite/libio.tests/putbackdog.exp3
-rw-r--r--libio/testsuite/libio.tests/tFile.exp3
-rw-r--r--libio/testsuite/libio.tests/tfformat.exp1
-rw-r--r--libio/testsuite/libio.tests/tiformat.exp1
-rw-r--r--libio/testsuite/libio.tests/tiomanip.exp1
-rw-r--r--libio/testsuite/libio.tests/tiomisc.exp1
-rw-r--r--libio/testsuite/libio.tests/tstdiomisc.exp1
-rw-r--r--libstdc++/ChangeLog823
-rw-r--r--libstdc++/Makefile.in307
-rw-r--r--libstdc++/NEWS13
-rw-r--r--libstdc++/algorithm7
-rw-r--r--libstdc++/cassert7
-rw-r--r--libstdc++/cctype7
-rw-r--r--libstdc++/cerrno7
-rw-r--r--libstdc++/cfloat7
-rw-r--r--libstdc++/cinst.cc155
-rw-r--r--libstdc++/ciso6467
-rw-r--r--libstdc++/climits7
-rw-r--r--libstdc++/clocale7
-rw-r--r--libstdc++/cmath76
-rw-r--r--libstdc++/cmathi.cc7
-rw-r--r--libstdc++/complex18
-rw-r--r--libstdc++/complex.h6
-rw-r--r--libstdc++/config/aix.ml8
-rw-r--r--libstdc++/config/dec-osf.ml6
-rw-r--r--libstdc++/config/elf.ml8
-rw-r--r--libstdc++/config/elfshlibm.ml6
-rw-r--r--libstdc++/config/hpux.ml6
-rw-r--r--libstdc++/config/irix5.ml6
-rw-r--r--libstdc++/config/linux.ml6
-rw-r--r--libstdc++/config/sol2shm.ml6
-rw-r--r--libstdc++/config/sunos4.ml9
-rw-r--r--libstdc++/configure.in85
-rw-r--r--libstdc++/csetjmp8
-rw-r--r--libstdc++/csignal7
-rw-r--r--libstdc++/cstdarg7
-rw-r--r--libstdc++/cstddef7
-rw-r--r--libstdc++/cstdio7
-rw-r--r--libstdc++/cstdlib23
-rw-r--r--libstdc++/cstdlibi.cc7
-rw-r--r--libstdc++/cstring96
-rw-r--r--libstdc++/cstringi.cc7
-rw-r--r--libstdc++/ctime7
-rw-r--r--libstdc++/cwchar7
-rw-r--r--libstdc++/cwctype7
-rw-r--r--libstdc++/deque7
-rw-r--r--libstdc++/functional7
-rw-r--r--libstdc++/iterator7
-rw-r--r--libstdc++/list7
-rw-r--r--libstdc++/map7
-rw-r--r--libstdc++/memory7
-rw-r--r--libstdc++/numeric7
-rw-r--r--libstdc++/queue7
-rw-r--r--libstdc++/set7
-rw-r--r--libstdc++/sinst.cc132
-rw-r--r--libstdc++/stack7
-rw-r--r--libstdc++/std/bastring.cc514
-rw-r--r--libstdc++/std/bastring.h560
-rw-r--r--libstdc++/std/complext.cc273
-rw-r--r--libstdc++/std/complext.h423
-rw-r--r--libstdc++/std/dcomplex.h94
-rw-r--r--libstdc++/std/fcomplex.h90
-rw-r--r--libstdc++/std/ldcomplex.h98
-rw-r--r--libstdc++/std/straits.h161
-rw-r--r--libstdc++/stdexcept93
-rw-r--r--libstdc++/stdexcepti.cc8
-rw-r--r--libstdc++/stl.h15
-rw-r--r--libstdc++/stl/ChangeLog192
-rw-r--r--libstdc++/stl/README16
-rw-r--r--libstdc++/stl/algo.h2665
-rw-r--r--libstdc++/stl/algobase.h841
-rw-r--r--libstdc++/stl/alloc.h674
-rw-r--r--libstdc++/stl/bvector.h585
-rw-r--r--libstdc++/stl/defalloc.h87
-rw-r--r--libstdc++/stl/deque.h1452
-rw-r--r--libstdc++/stl/function.h634
-rw-r--r--libstdc++/stl/hash_map.h319
-rw-r--r--libstdc++/stl/hash_set.h306
-rw-r--r--libstdc++/stl/hashtable.h1013
-rw-r--r--libstdc++/stl/heap.h204
-rw-r--r--libstdc++/stl/iterator.h598
-rw-r--r--libstdc++/stl/list.h624
-rw-r--r--libstdc++/stl/map.h188
-rw-r--r--libstdc++/stl/multimap.h182
-rw-r--r--libstdc++/stl/multiset.h167
-rw-r--r--libstdc++/stl/pair.h63
-rw-r--r--libstdc++/stl/pthread_alloc.h344
-rw-r--r--libstdc++/stl/rope.h2055
-rw-r--r--libstdc++/stl/ropeimpl.h1510
-rw-r--r--libstdc++/stl/set.h167
-rw-r--r--libstdc++/stl/slist.h729
-rw-r--r--libstdc++/stl/stack.h171
-rw-r--r--libstdc++/stl/stl_config.h170
-rw-r--r--libstdc++/stl/tempbuf.h121
-rw-r--r--libstdc++/stl/tree.h1085
-rw-r--r--libstdc++/stl/type_traits.h227
-rw-r--r--libstdc++/stl/vector.h544
-rw-r--r--libstdc++/stlinst.cc8
-rw-r--r--libstdc++/string13
-rw-r--r--libstdc++/tests/ChangeLog87
-rw-r--r--libstdc++/tests/Makefile.in35
-rw-r--r--libstdc++/tests/configure.in50
-rw-r--r--libstdc++/tests/tcomplex.cc151
-rw-r--r--libstdc++/tests/tcomplex.exp37
-rw-r--r--libstdc++/tests/tcomplex.inp1
-rw-r--r--libstdc++/tests/tlist.cc165
-rw-r--r--libstdc++/tests/tlist.exp44
-rw-r--r--libstdc++/tests/tmap.cc69
-rw-r--r--libstdc++/tests/tmap.exp7
-rw-r--r--libstdc++/tests/tstring.cc189
-rw-r--r--libstdc++/tests/tstring.exp20
-rw-r--r--libstdc++/tests/tstring.inp1
-rw-r--r--libstdc++/tests/tvector.cc23
-rw-r--r--libstdc++/tests/tvector.exp4
-rw-r--r--libstdc++/testsuite/ChangeLog54
-rw-r--r--libstdc++/testsuite/Makefile.in66
-rw-r--r--libstdc++/testsuite/config/default.exp1
-rw-r--r--libstdc++/testsuite/configure.in23
-rw-r--r--libstdc++/testsuite/lib/libstdc++.exp165
-rw-r--r--libstdc++/testsuite/libstdc++.tests/test.exp34
-rw-r--r--libstdc++/utility8
-rw-r--r--libstdc++/vector7
-rwxr-xr-xltconfig1064
-rw-r--r--ltmain.sh1819
-rwxr-xr-xmissing134
-rwxr-xr-xmkinstalldirs36
-rwxr-xr-xmove-if-change32
-rw-r--r--mpw-README376
-rw-r--r--mpw-build.in204
-rw-r--r--mpw-config.in113
-rw-r--r--mpw-configure448
-rwxr-xr-xsymlink-tree48
-rw-r--r--texinfo/COPYING339
-rw-r--r--texinfo/ChangeLog2389
-rw-r--r--texinfo/INSTALL181
-rw-r--r--texinfo/INTRODUCTION119
-rw-r--r--texinfo/Makefile.in244
-rw-r--r--texinfo/NEWS93
-rw-r--r--texinfo/README163
-rw-r--r--texinfo/TODO35
-rw-r--r--texinfo/aclocal.m445
-rwxr-xr-xtexinfo/configure2025
-rw-r--r--texinfo/configure.in48
-rw-r--r--texinfo/dir16
-rw-r--r--texinfo/dir-example309
-rw-r--r--texinfo/dir.info-template67
-rw-r--r--texinfo/emacs/Makefile.in91
-rw-r--r--texinfo/emacs/detexinfo.el250
-rwxr-xr-xtexinfo/emacs/elisp-comp7
-rw-r--r--texinfo/emacs/info.el1846
-rw-r--r--texinfo/emacs/informat.el429
-rw-r--r--texinfo/emacs/makeinfo.el247
-rw-r--r--texinfo/emacs/new-useful-setqs180
-rw-r--r--texinfo/emacs/texinfmt.el3979
-rw-r--r--texinfo/emacs/texinfo.el932
-rw-r--r--texinfo/emacs/texnfo-tex.el346
-rw-r--r--texinfo/emacs/texnfo-upd.el2058
-rwxr-xr-xtexinfo/gen-info-dir101
-rw-r--r--texinfo/gpl.texinfo398
-rw-r--r--texinfo/info/Makefile.in232
-rw-r--r--texinfo/info/NEWS200
-rw-r--r--texinfo/info/README37
-rw-r--r--texinfo/info/clib.c112
-rw-r--r--texinfo/info/clib.h42
-rw-r--r--texinfo/info/dir.c273
-rw-r--r--texinfo/info/display.c561
-rw-r--r--texinfo/info/display.h76
-rw-r--r--texinfo/info/doc.h58
-rw-r--r--texinfo/info/dribble.c71
-rw-r--r--texinfo/info/dribble.h41
-rw-r--r--texinfo/info/echo_area.c1508
-rw-r--r--texinfo/info/echo_area.h63
-rw-r--r--texinfo/info/filesys.c617
-rw-r--r--texinfo/info/filesys.h84
-rw-r--r--texinfo/info/footnotes.c265
-rw-r--r--texinfo/info/footnotes.h46
-rw-r--r--texinfo/info/gc.c95
-rw-r--r--texinfo/info/gc.h36
-rw-r--r--texinfo/info/general.h94
-rw-r--r--texinfo/info/indices.c667
-rw-r--r--texinfo/info/indices.h39
-rw-r--r--texinfo/info/info-stnd.texi1365
-rw-r--r--texinfo/info/info-utils.c672
-rw-r--r--texinfo/info/info-utils.h140
-rw-r--r--texinfo/info/info.1229
-rw-r--r--texinfo/info/info.c565
-rw-r--r--texinfo/info/info.h100
-rw-r--r--texinfo/info/info.texi929
-rw-r--r--texinfo/info/infodoc.c771
-rw-r--r--texinfo/info/infomap.c274
-rw-r--r--texinfo/info/infomap.h82
-rw-r--r--texinfo/info/m-x.c195
-rw-r--r--texinfo/info/makedoc.c481
-rw-r--r--texinfo/info/man.c643
-rw-r--r--texinfo/info/man.h36
-rw-r--r--texinfo/info/nodemenu.c329
-rw-r--r--texinfo/info/nodes.c1207
-rw-r--r--texinfo/info/nodes.h168
-rw-r--r--texinfo/info/search.c519
-rw-r--r--texinfo/info/search.h75
-rw-r--r--texinfo/info/session.c4263
-rw-r--r--texinfo/info/session.h146
-rw-r--r--texinfo/info/signals.c173
-rw-r--r--texinfo/info/signals.h89
-rw-r--r--texinfo/info/termdep.h76
-rw-r--r--texinfo/info/terminal.c769
-rw-r--r--texinfo/info/terminal.h129
-rw-r--r--texinfo/info/tilde.c376
-rw-r--r--texinfo/info/tilde.h58
-rw-r--r--texinfo/info/userdoc.texi1270
-rw-r--r--texinfo/info/variables.c272
-rw-r--r--texinfo/info/variables.h64
-rw-r--r--texinfo/info/window.c1482
-rw-r--r--texinfo/info/window.h229
-rw-r--r--texinfo/info/xmalloc.c80
-rwxr-xr-xtexinfo/install-sh250
-rw-r--r--texinfo/lgpl.texinfo548
-rw-r--r--texinfo/liblic.texi23
-rw-r--r--texinfo/libtxi/Makefile.in84
-rw-r--r--texinfo/libtxi/alloca.c504
-rw-r--r--texinfo/libtxi/bzero.c44
-rw-r--r--texinfo/libtxi/getopt.c762
-rw-r--r--texinfo/libtxi/getopt.h129
-rw-r--r--texinfo/libtxi/getopt1.c180
-rw-r--r--texinfo/libtxi/memcpy.c20
-rw-r--r--texinfo/libtxi/memmove.c24
-rw-r--r--texinfo/libtxi/strdup.c43
-rw-r--r--texinfo/license.texi24
-rw-r--r--texinfo/makeinfo/Makefile.in116
-rw-r--r--texinfo/makeinfo/macro.texi177
-rw-r--r--texinfo/makeinfo/macros/example.texi224
-rw-r--r--texinfo/makeinfo/macros/html.texi269
-rw-r--r--texinfo/makeinfo/macros/multifmt.texi41
-rw-r--r--texinfo/makeinfo/macros/res-samp.texi32
-rw-r--r--texinfo/makeinfo/macros/resume.texi64
-rw-r--r--texinfo/makeinfo/macros/simpledoc.texi135
-rw-r--r--texinfo/makeinfo/makeinfo.c9349
-rw-r--r--texinfo/makeinfo/makeinfo.h193
-rw-r--r--texinfo/makeinfo/makeinfo.texi311
-rw-r--r--texinfo/makeinfo/multi.c418
-rw-r--r--texinfo/makeinfo/multiformat.texi40
-rw-r--r--texinfo/testsuite/ChangeLog37
-rw-r--r--texinfo/testsuite/Makefile.in100
-rw-r--r--texinfo/testsuite/config/unix.exp29
-rwxr-xr-xtexinfo/testsuite/configure707
-rw-r--r--texinfo/testsuite/configure.in5
-rw-r--r--texinfo/testsuite/lib/utils.exp31
-rw-r--r--texinfo/testsuite/makeinfo.0/atnode.exp19
-rw-r--r--texinfo/testsuite/makeinfo.0/conditions.exp21
-rw-r--r--texinfo/testsuite/makeinfo.0/mini.exp17
-rw-r--r--texinfo/testsuite/makeinfo.0/missnode.exp25
-rw-r--r--texinfo/testsuite/makeinfo.0/nonsense.exp12
-rw-r--r--texinfo/testsuite/makeinfo.0/not.exp15
-rw-r--r--texinfo/testsuite/makeinfo.0/smstruct.exp14
-rw-r--r--texinfo/testsuite/text/atnode.texi21
-rw-r--r--texinfo/testsuite/text/conditions.texi26
-rw-r--r--texinfo/testsuite/text/dfltnode.texi21
-rw-r--r--texinfo/testsuite/text/minimal.texi2
-rw-r--r--texinfo/testsuite/text/missnode.texi22
-rw-r--r--texinfo/testsuite/text/nonsense.texi3
-rw-r--r--texinfo/testsuite/text/not.texi1
-rw-r--r--texinfo/testsuite/text/smstruct.texi21
-rw-r--r--texinfo/texinfo.tex4800
-rw-r--r--texinfo/texinfo.texi16886
-rw-r--r--texinfo/util/Makefile.in105
-rw-r--r--texinfo/util/deref.c238
-rwxr-xr-xtexinfo/util/fixfonts84
-rwxr-xr-xtexinfo/util/gen-dir-node176
-rw-r--r--texinfo/util/install-info.c1111
-rwxr-xr-xtexinfo/util/mkinstalldirs40
-rwxr-xr-xtexinfo/util/tex3patch71
-rwxr-xr-xtexinfo/util/texi2dvi367
-rw-r--r--texinfo/util/texindex.c1793
-rw-r--r--xiberty/configure.in101
-rwxr-xr-xylwrap107
1006 files changed, 396320 insertions, 118 deletions
diff --git a/.cvsignore b/.cvsignore
new file mode 100644
index 00000000000..944dd6db952
--- /dev/null
+++ b/.cvsignore
@@ -0,0 +1,31 @@
+*-all
+*-co
+*-dirs
+*-done
+*-info
+*-install
+*-install-info
+*-src
+*-stamp-*
+*-tagged
+blockit
+cfg-paper.info
+config.status
+configure.aux
+configure.cp
+configure.cps
+configure.dvi
+configure.fn
+configure.fns
+configure.ky
+configure.kys
+configure.log
+configure.pg
+configure.pgs
+configure.toc
+configure.tp
+configure.tps
+configure.vr
+configure.vrs
+dir.info
+Makefile
diff --git a/COPYING b/COPYING
new file mode 100644
index 00000000000..60549be514a
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,340 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, 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 software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, 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 redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+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 give any other recipients of the Program a copy of this License
+along with the Program.
+
+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 Program or any portion
+of it, thus forming a work based on the Program, 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) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+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 Program, 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 Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) 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; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, 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 executable. 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.
+
+If distribution of executable or 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 counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program 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.
+
+ 5. 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 Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program 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.
+
+ 7. 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 Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program 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 Program.
+
+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.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program 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.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the 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 Program
+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 Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, 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
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "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 PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. 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 PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ This program 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 of the License, or
+ (at your option) any later version.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) 19yy name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/COPYING.LIB b/COPYING.LIB
new file mode 100644
index 00000000000..eb685a5ec98
--- /dev/null
+++ b/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.
+
+ <one line to give the library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ 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.
+
+ <signature of Ty Coon>, 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 00000000000..5d2401a295e
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,5207 @@
+Wed Aug 20 19:57:37 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (BISON, YACC): Use $$s.
+ (all-bison): Depend on all-texinfo.
+
+Tue Aug 19 01:41:32 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (BISON): Add -L flag.
+ (YACC): Likewise.
+
+
+
+Mon Aug 18 09:24:06 1997 Gavin Koch <gavin@cygnus.com>
+
+ * config.sub: Add mipstx39. Delete r3900.
+
+Mon Aug 18 17:20:10 1997 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (all-autoconf): Depends on all-texinfo.
+
+Fri Aug 15 23:09:26 1997 Michael Meissner <meissner@cygnus.com>
+
+ * config-ml.in ({powerpc,rs6000}*-*-*): Update to current AIX and
+ eabi targets.
+
+Thu Aug 14 14:42:17 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Get CFLAGS and CXXFLAGS from Makefile, if possible.
+
+ * configure: When handling a Canadian Cross, handle YACC as well as
+ BISON. Just set BISON to bison. When setting YACC, prefer bison.
+
+Tue Aug 12 20:09:48 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (BISON): bison, not byacc or bison -y.
+ (YACC): bison -y or byacc or yacc.
+ (various): Add *-bison as appropriate.
+ (taz): No need to mess with BISON anymore.
+
+Tue Aug 12 22:33:08 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: If OSTYPE matches *win32*, try to find a good value for
+ CONFIG_SHELL.
+
+Sun Aug 10 14:41:11 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (taz): Get the version number from AM_INIT_AUTOMAKE in
+ configure.in if it is present.
+
+Sat Aug 9 00:58:01 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (LD_FOR_TARGET): Change ld.new to ld-new.
+
+Fri Aug 8 16:30:13 1997 Doug Evans <dje@canuck.cygnus.com>
+
+ * config.sub: Recognize `arc' cpu.
+ * configure.in: Likewise.
+ * config-ml.in: Likewise.
+
+Thu Aug 7 11:02:34 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in ($(INSTALL_X11_MODULES)): Depend upon installdirs.
+
+Wed Aug 6 16:27:29 1997 Chris Provenzano <proven@cygnus.com>
+
+ * configure: Changed sed delimiter from ':' to '|' when
+ attempting to substitute ${config_shell} for SHELL. On
+ NT ${config_shell} may contain a ':' in it.
+
+Wed Aug 6 12:29:05 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (EXTRA_GCC_FLAGS): Fix for non-bash shells.
+
+Wed Aug 6 00:42:35 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (AS_FOR_TARGET): Change as.new to as-new.
+
+Tue Aug 5 14:08:51 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (NM_FOR_TARGET): Change nm.new to nm-new.
+
+ * ylwrap: If the program is a relative path, force it to be
+ absolute.
+
+Tue Aug 5 12:12:44 1997 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * configure (tooldir): Set BISON to `bison -y' and not just bison.
+
+Mon Aug 4 22:59:02 1997 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * Makefile.in (CC_FOR_TARGET): When winsup/Makefile present,
+ correctly specify the target build directory $(TARGET_SUBDIR)/winsup
+ for libraries.
+
+Mon Aug 4 12:40:24 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (EXTRA_GCC_FLAGS): Fix handling of macros with values
+ separated by spaces.
+
+Thu Jul 31 19:49:49 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * ylwrap: New file.
+ * Makefile.in (DEVO_SUPPORT): Add ylwrap.
+
+ * ltmain.sh: Handle /bin/sh at start of install program.
+
+ * Makefile.in (DEVO_SUPPORT): Add ltconfig, ltmain.sh, and missing.
+
+ * ltconfig, ltmain.sh: New files, from libtool 1.0.
+ * missing: New file, from automake 1.2.
+
+Thu Jul 24 12:57:56 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in: Treat tix like tk, putting it in X11_MODULES. Add
+ check-tk to CHECK_X11_MODULES.
+
+Wed Jul 23 17:03:29 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.sub: Merge with FSF.
+
+Tue Jul 22 19:08:29 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.guess: Merge with FSF.
+
+Tue Jul 22 14:50:42 1997 Robert Hoehne <robert.hoehne@Mathematik.TU-Chemnitz.DE>
+
+ * configure: Treat msdosdjgpp like go32.
+ * configure.in: Likewise. Don't remove gprof for go32.
+
+ * configure: Change Makefile.tem2 to Makefile.tm2.
+
+Mon Jul 21 10:31:26 1997 Stephen Peters <speters@cygnus.com>
+
+ * configure.in (noconfigdirs): For alpha-dec-osf*, don't ignore grep.
+
+Tue Jul 15 14:33:03 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * install-sh (chmodcmd): Set to null if the DST directory already
+ exists. Same as Nov 11th change.
+
+Mon Jul 14 11:01:15 1997 Martin M. Hunt <hunt@cygnus.com>
+
+ * configure (GDB_TK): Needs itcl and tix.
+
+Mon Jul 14 00:32:10 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config.guess: Update from FSF.
+
+Fri Jul 11 11:57:11 1997 Martin M. Hunt <hunt@cygnus.com>
+
+ * Makefile.in (GDB_TK): Depend on itcl and tix.
+
+Fri Jul 4 13:25:31 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (INSTALL_PROGRAM_ARGS): New variable.
+ (INSTALL_PROGRAM): Use $(INSTALL_PROGRAM_ARGS).
+ (INSTALL_SCRIPT): New variable.
+ (BASE_FLAGS_TO_PASS): Pass down INSTALL_SCRIPT.
+ * configure.in: If host is *-*-cygwin32*, set INSTALL_PROGRAM_ARGS
+ to -x.
+ * install-sh: Add support for -x option.
+
+Mon Jun 30 15:51:30 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in, Makefile.in: Treat tix like itcl.
+
+Thu Jun 26 13:59:19 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (WINDRES): New variable.
+ (WINDRES_FOR_TARGET): New variable.
+ (BASE_FLAGS_TO_PASS): Add WINDRES_FOR_TARGET.
+ (EXTRA_HOST_FLAGS): Add WINDRES.
+ (EXTRA_TARGET_FLAGS): Add WINDRES.
+ (EXTRA_GCC_FLAGS): Add WINDRES.
+ ($(DO_X)): Pass down WINDRES.
+ ($(CONFIGURE_TARGET_MODULES)): Set WINDRES when configuring.
+ * configure: Treat WINDRES like DLLTOOL, and WINDRES_FOR_TARGET like
+ DLLTOOL_FOR_TARGET.
+
+Wed Jun 25 15:01:26 1997 Felix Lee <flee@cygnus.com>
+
+ * configure.in: configure sim before gdb for win32-x-ppc
+
+Wed Jun 25 12:18:54 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ Move gperf into the toplevel, from libg++.
+ * configure.in (target_tools): Add target-gperf.
+ (native_only): Add target-gperf.
+ * Makefile.in (all-target-gperf): New target, depend on
+ all-target-libg++.
+ (configure-target-gperf): Empty rule.
+ (ALL_TARGET_MODULES): Add all-target-gperf.
+ (CONFIGURE_TARGET_MODULES): Add configure-target-gperf.
+ (CHECK_TARGET_MODULES): Add check-target-gperf.
+ (INSTALL_TARGET_MODULES): Add install-target-gperf.
+ (CLEAN_TARGET_MODULES): Add clean-target-gperf.
+
+Mon Jun 23 10:51:53 1997 Jeffrey A Law (law@cygnus.com)
+
+ * config.sub (mn10200): Recognize new basic machine.
+
+Thu Jun 19 14:16:42 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * configure.in: Don't set ENABLE_MULTILIB, so we'll be passing
+ --enable-multilib down to subdirs; setting TARGET_SUBDIR was enough.
+
+Tue Jun 17 15:31:20 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * configure.in: If we're building mips-sgi-irix6* native, turn on
+ ENABLE_MULTILIB and set TARGET_SUBDIR.
+
+Tue Jun 17 12:20:59 1997 Tom Tromey <tromey@cygnus.com>
+
+ * Makefile.in (all-sn): Depend on all-grep.
+
+Mon Jun 16 11:11:10 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Use mh-ppcpic and mt-ppcpic for powerpc*-* targets.
+
+ * configure: Set CFLAGS and CXXFLAGS, and substitute them into
+ Makefile. From Jeff Makey <jeff@cts.com>.
+ * Makefile.in: Add comment for CFLAGS and CXXFLAGS.
+
+ * Makefile.in (DISTBISONFILES): Remove.
+ (taz): Don't futz with DISTBISONFILES. Change BISON to use
+ $(DEFAULT_YACC).
+
+ * configure.in: Build itl, db, sn, etc., when building for native
+ cygwin32.
+
+ * Makefile.in (LD): New variable.
+ (EXTRA_HOST_FLAGS): Pass down LD.
+ ($(DO_X)): Likewise.
+
+Mon Jun 16 11:10:35 1997 Philip Blundell <Philip.Blundell@pobox.com>
+
+ * Makefile.in (INSTALL): Use $(SHELL) when executing install-sh.
+
+Fri Jun 13 10:22:56 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * configure.in (targargs): Strip out any supplied --build argument
+ before adding our own. Always add --build.
+
+Thu Jun 12 21:12:28 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * configure.in (targargs): Pass --build if we're doing
+ a cross-compile.
+
+Fri Jun 6 21:38:40 1997 Rob Savoye <rob@chinadoll.cygnus.com>
+
+ * configure: Use '|' instead of ":" as the seperator in
+ sed. Otherwise sed chokes on NT path names with drive
+ designators. Also look for "?:*" as the leading characters in an
+ absolute pathname.
+
+Mon Jun 2 13:05:20 1997 Gavin Koch <gavin@cygnus.com>
+
+ * config.sub: Support for r3900.
+
+Wed May 21 17:33:31 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Use install-sh, not install.sh.
+
+Wed May 14 16:06:51 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (taz): Improve check for BISON so it doesn't try to
+ apply it twice.
+
+Fri May 9 17:22:05 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (INSTALL_MODULES): Put install-opcodes before
+ install-binutils.
+
+Thu May 8 17:29:50 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in: Add automake targets.
+ * configure.in (host_tools): Add automake.
+
+Tue May 6 15:49:52 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Default CXX to c++, not gcc.
+ * Makefile.in (CXX): Set to c++, not gcc.
+ (CXX_FOR_TARGET): When cross, transform c++, not gcc.
+
+Thu May 1 10:11:43 1997 Geoffrey Noer <noer@cygnus.com>
+
+ * install-sh: try appending a .exe if source file doesn't
+ exist
+
+Wed Apr 30 12:05:36 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure.in: Turn on multilib by default.
+ (cross_only): Remove target-libiberty.
+
+ * Makefile.in (all-gcc): Don't depend on libiberty.
+
+Mon Apr 28 18:39:45 1997 Michael Snyder <msnyder@cleaver.cygnus.com>
+
+ * config.guess: improve algorithm for recognizing Gnu Hurd x86.
+
+Thu Apr 24 19:30:07 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (DEVO_SUPPORT): Add mpw-install.
+ (DISTBISONFILES): Add ld/Makefile.in
+
+Tue Apr 22 17:17:28 1997 Geoffrey Noer <noer@pizza.cygnus.com>
+
+ * configure.in: if target is cygwin32 but host isn't cygwin32,
+ don't configure gdb tcl tk expect, not just gdb.
+
+Mon Apr 21 13:33:39 1997 Tom Tromey <tromey@cygnus.com>
+
+ * configure.in: Added gnuserv everywhere sn appears.
+
+ * Makefile.in (ALL_MODULES): Added all-gnuserv.
+ (CROSS_CHECK_MODULES): Added check-gnuserv.
+ (INSTALL_MODULES): Added install-gnuserv.
+ (CLEAN_MODULES): Added clean-gnuserv.
+ (all-gnuserv): New target.
+
+Thu Apr 17 13:57:06 1997 Per Fogelstrom <pefo@openbsd.org>
+
+ * config.guess: Fixes for MIPS OpenBSD systems.
+
+Tue Apr 15 12:21:07 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (INSTALL_XFORM): Remove.
+ (BASE_FLAGS_TO_PASS): Remove INSTALL_XFORM.
+
+ * mkinstalldirs: New file, copied from automake.
+ * Makefile.in (installdirs): Rename from install-dirs. Use
+ mkinstalldirs. Change all users.
+ (DEVO_SUPPORT): Add mkinstalldirs.
+
+Mon Apr 14 11:21:38 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * install-sh: Rename from install.sh.
+ * Makefile.in (INSTALL): Change install.sh to install-sh.
+ (DEVO_SUPPORT): Likewise.
+
+ * configure: Use ${config_shell} with ${moveifchange}. From Thomas
+ Graichen <graichen@rzpd.de>.
+
+Fri Apr 11 16:37:10 1997 Niklas Hallqvist <niklas@appli.se>
+
+ * config.guess: Recognize OpenBSD systems correctly.
+
+Fri Apr 11 17:07:04 1997 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * README, Makefile.in (ETC_SUPPORT): Remove references to
+ cfg-paper*, configure.{texi,man,info*}._
+
+Sun Apr 6 18:47:57 1997 Andrew Cagney <cagney@kremvax.cygnus.com>
+
+ * Makefile.in (all.normal): Ensure that gcc is built after all
+ the x11 - ie gdb - targets.
+
+Tue Apr 1 16:28:50 1997 Klaus Kaempf <kkaempf@progis.de>
+
+ * makefile.vms: Don't run conf-a-gas.
+
+Mon Mar 31 16:26:55 1997 Joel Sherrill <joel@oarcorp.com>
+
+ * configure.in (hppa1.1-*-rtems*): New target, like hppa-*-*elf*.
+
+Fri Mar 28 18:28:52 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Set cache_file to config.cache.
+ * Makefile.in (local-distclean): Remove config.cache.
+
+Wed Mar 26 18:49:39 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * COPYING: Update FSF address.
+
+Mon Mar 24 15:02:39 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (install-dirs): Don't crash if prefix, and hence
+ MAKEDIRS, is empty.
+
+Mon Mar 24 12:40:55 1997 Doug Evans <dje@canuck.cygnus.com>
+
+ * config.sub: Tweak mn10300 entry.
+
+Fri Mar 21 15:35:27 1997 Michael Meissner <meissner@cygnus.com>
+
+ * configure.in (host_tools): Put sim before gdb, so gdb's
+ configure.tgt can determine if the simulator was configured.
+
+Sun Mar 16 16:07:08 1997 Fred Fish <fnf@cygnus.com>
+
+ * config.sub: Move BeOS $os case to be with other Cygnus
+ local cases.
+
+Sun Mar 16 01:34:55 1997 Martin Hunt <hunt@cygnus.com>
+
+ * config.sub: Remove misplaced comment that broke Linux.
+
+Sat Mar 15 22:50:15 1997 Fred Fish <fnf@cygnus.com>
+
+ * config.sub: Add BeOS support.
+
+Mon Mar 10 13:30:11 1997 Tom Tromey <tromey@cygnus.com>
+
+ * Makefile.in (CHECK_X11_MODULES): Don't run check-tk.
+
+Wed Mar 5 12:09:29 1997 Martin <hunt@cygnus.com>
+
+ * configure.in (noconfigdirs): Remove tcl and tk from
+ noconfigdirs for cygwin32 builds.
+
+Thu Feb 27 14:57:26 1997 Ken Raeburn <raeburn@cygnus.com>
+
+ * Makefile.in (GAS_SUPPORT_DIRS, BINUTILS_SUPPORT_DIRS): Remove
+ make-all.com, use makefile.vms instead.
+
+Tue Feb 25 18:46:14 1997 Stan Shebs <shebs@andros.cygnus.com>
+
+ * config.sub: Accept -lnews*.
+
+Thu Feb 13 22:04:44 1997 Klaus Kaempf <kkaempf@progis.de>
+
+ * makefile.vms: New file.
+ * make-all.com: Remove.
+
+Wed Feb 12 12:54:18 1997 Jim Wilson <wilson@cygnus.com>
+
+ * Makefile.in (EXTRA_GCC_FLAGS): Add LIBGCC2_DEBUG_CFLAGS.
+
+Sat Feb 8 20:36:49 1997 Michael Meissner <meissner@cygnus.com>
+
+ * Makefile.in (all-itcl): The rule is all-itcl, not all-tcl.
+
+Tue Feb 4 11:39:29 1997 Tom Tromey <tromey@cygnus.com>
+
+ * Makefile.in (ALL_MODULES): Added all-db.
+ (CROSS_CHECK_MODULES): Addec check-db.
+ (INSTALL_MODULES): Added install-db.
+ (CLEAN_MODULES): Added clean-db.
+
+Mon Feb 3 13:29:36 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.guess: Merge with latest FSF sources.
+
+Tue Jan 28 09:20:37 1997 Tom Tromey <tromey@cygnus.com>
+
+ * Makefile.in (ALL_MODULES): Added all-itcl.
+ (CROSS_CHECK_MODULES): Added check-itcl.
+ (INSTALL_MODULES): Added install-itcl.
+ (CLEAN_MODULES): Added clean-itcl.
+
+Thu Jan 23 01:44:27 1997 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: build gdb for mn10200
+
+Fri Jan 17 15:32:15 1997 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (all-target-winsup): Depend on all-target-libio.
+
+Fri Jan 3 16:04:03 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (MAKEINFO): Check for the existence of the Makefile,
+ rather than the makeinfo program.
+ (do-info): Depend upon all-texinfo.
+
+Tue Dec 31 16:00:31 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Remove uses of config/mh-linux.
+
+ * config.sub, config.guess: Merge with latest FSF sources.
+
+Fri Dec 27 12:07:59 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.sub, config.guess: Merge with latest FSF sources.
+
+Wed Dec 18 22:46:39 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-build.in: Build ld before gcc, use NewFolderRecursive.
+ * mpw-config.in: Test for NewFolderRecursive.
+ * mpw-install: Use symbolic name for startup filename.
+ * mpw-README: Add various additional details.
+
+Wed Dec 18 13:11:46 1996 Jim Wilson <wilson@cygnus.com>
+
+ * configure.in (mips*-sgi-irix6*): Remove binutils from noconfigdirs.
+
+Wed Dec 18 10:29:31 1996 Jeffrey A Law (law@cygnus.com)
+
+ * configure.in: Do build gcc and the target libraries for
+ the mn10200.
+
+Wed Dec 4 16:53:05 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: don't avoid building gdb for mn10300 any more
+ * Makefile.in: double-quote GCC_FOR_TARGET line in EXTRA_GCC_FLAGS
+ instead of single-quoting it.
+
+Tue Dec 3 23:26:50 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure.in: Don't use --with-stabs on IRIX 6.
+
+Tue Dec 3 09:05:25 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * configure.in (m32r): Build gdb, libg++ now.
+
+Sun Dec 1 00:18:59 1996 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * configure.in (mips*-sgi-irix6*): Remove gdb and related
+ directories from noconfigdirs.
+
+Tue Nov 26 11:45:33 1996 Kim Knuttila <krk@cygnus.com>
+
+ * config.sub (basic_machine): added mips16 configuration
+
+Sat Nov 23 19:26:22 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * config.sub: Handle d10v-unknown.
+
+Thu Nov 21 16:19:44 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * Makefile.in: add findutils
+ * configure.in: add findutils to list of host_tools
+
+Wed Nov 20 10:09:01 1996 Jeffrey A Law (law@cygnus.com)
+
+ * config.sub: Handle mn10200 and mn10300.
+
+Tue Nov 19 16:35:14 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (d10v-*): Do not build librx.
+
+Mon Nov 18 13:28:41 1996 Jeffrey A Law (law@cygnus.com)
+
+ * configure.in (mn10300): Build everything except gdb & libgloss.
+
+Wed Nov 13 14:59:46 1996 Per Bothner <bothner@deneb.cygnus.com>
+
+ * config.guess: Patch for Dansk Data Elektronik servers,
+ from Niels Skou Olsen <nso@dde.dk>.
+
+ For ncr, use /bin/uname rather than uname, since GNU uname does not
+ support -p. Suggested by Mark Mitchell <mmitchell@usa.net>.
+
+ Patch for MIPS R4000 running System V,
+ from Eric S. Raymond <esr@snark.thyrsus.com>.
+
+ Fix thinko for nextstep.
+
+ Patch for OSF1 in i?86, from Dan Murphy <dlm@osf.org> via Harlan Stenn.
+
+ Sat Jun 24 18:58:17 1995 Morten Welinder <terra+@cs.cmu.edu>
+ * config.guess: Guess mips-dec-mach_bsd4.3.
+
+ Thu Oct 10 04:07:04 1996 Harlan Stenn <harlan@pfcs.com>
+ * config.guess (i?86-ncr-sysv*): Emit just enough of the minor
+ release numbers.
+ * config.guess (mips-mips-riscos*): Emit just enough of the
+ release number.
+
+ Tue Oct 8 10:37:22 1996 Frank Vance <fvance@waii.com>
+ * config.guess (sparc-auspex-sunos*): Added.
+ (f300-fujitsu-*): Added.
+
+ Wed Sep 25 22:00:35 1996 Jeff Woolsey <woolsey@jlw.com>
+ * config.guess: Recognize a Tadpole as a sparc.
+
+Wed Nov 13 00:53:09 1996 David J. MacKenzie <djm@churchy.gnu.ai.mit.edu>
+
+ * config.guess: Don't assume that NextStep version is either 2 or
+ 3. NextStep 4 (aka OpenStep 4) has come out now.
+
+Mon Nov 11 23:52:03 1996 David J. MacKenzie <djm@churchy.gnu.ai.mit.edu>
+
+ * config.guess: Support Cray T90 that reports itself as "CRAY TS".
+ From Rik Faith <faith@cs.unc.edu>.
+
+Fri Nov 8 11:34:58 1996 David J. MacKenzie <djm@geech.gnu.ai.mit.edu>
+
+ * config.sub: Contributions from bug-gnu-utils to:
+ Support plain "hppa" (no version given) architecture, reported by
+ OpenStep.
+ OpenBSD like NetBSD.
+ LynxOs is not a hardware supplier.
+
+ * config.guess: Contributions from bug-gnu-utils to add support for:
+ OpenBSD like NetBSD.
+ Stratus systems.
+ More Pyramid systems.
+ i[n>4]86 Intel chips.
+ M680[n>4]0 Motorola chips.
+ Use unknown instead of lynx for hardware manufacturer.
+
+Mon Nov 11 10:09:08 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * install.sh (chmodcmd): Set to null if the DST directory already
+ exists.
+
+Mon Nov 11 10:43:41 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (powerpc*-{eabi,elf,linux,rtem,sysv,solaris}*): Do
+ not use mt-ppc target Makefile fragment any more.
+
+Sun Nov 3 19:17:07 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * configure.in (*-*-windows): Exclude everything but those dirs
+ needed to build windows.
+
+Tue Oct 29 16:41:31 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (all-target-winsup): Depend on all-target-librx.
+
+Mon Oct 28 17:32:46 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * configure.in: Exclude mmalloc from i386-windows.
+ * config/mh-windows: Add rules for building MSVC makefiles.
+
+Thu Oct 24 09:22:46 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * Undo my previous change.
+
+Thu Oct 24 12:12:04 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (EXTRA_GCC_FLAGS): Pass down GCC_FOR_TARGET
+ unconditionally.
+ (MAKEOVERRIDES): Define (revert this part of October 18 change).
+
+Thu Oct 24 09:02:07 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * Makefile.in (FLAGS_TO_PASS): Add $(HOST_FLAGS) to allow the
+ host to add it's own flags.
+ * config/mh-windows (HOST_FLAGS): Set srcroot, which is needed
+ for MSVC build procedure.
+
+Tue Oct 22 15:20:26 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Handle GCC_FOR_TARGET like CC_FOR_TARGET.
+
+Fri Oct 18 13:37:13 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (CC_FOR_TARGET): Check for xgcc, not Makefile.
+ (CXX_FOR_TARGET): Likewise.
+ (GCC_FOR_TARGET): Define.
+ (BASE_FLAGS_TO_PASS): Remove GCC_FOR_TARGET.
+ (EXTRA_GCC_FLAGS): Define GCC_FOR_TARGET based on whether
+ CC_FOR_TARGET was specified on the command line.
+ (MAKEOVERRIDES): Don't define.
+
+Thu Oct 17 10:27:56 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * configure.in (m32r): Fix spelling of libg++ libs.
+
+Thu Oct 10 10:37:17 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * config.sub (-apple*): Remove, now redundant.
+
+Thu Oct 10 12:30:54 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Don't get confused by CPU-VENDOR-linux-gnu.
+
+ * configure: Rework yesterday's sed script patch.
+
+ * config.sub: Merge with FSF.
+
+Wed Oct 9 17:24:59 1996 Per Bothner <bothner@deneb.cygnus.com>
+
+ * config.guess: Merge from FSF.
+
+ 1996-09-12 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
+ * config.guess: Use pc instead of unknown, for pc clone systems.
+ Change linux to linux-gnu.
+
+ Mon Jul 15 23:51:11 1996 Karl Heuer <kwzh@gnu.ai.mit.edu>
+ * config.guess: Avoid non-portable tr syntax.
+
+Wed Oct 9 06:06:46 1996 Jeffrey A Law (law@cygnus.com)
+
+ * test-build.mk (HOLES): Add "xargs" for gdb.
+
+ * configure: Avoid hpux10.20 sed bug.
+
+Tue Oct 8 08:32:48 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * configure.in config/mh-windows: Add support for windows host
+ (that is a build done under the Microsoft build environment).
+
+Tue Oct 8 10:39:08 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in: Replace all uses of srcroot with s, to shrink
+ command line lengths.
+
+ Patches from Geoffrey Noer <noer@cygnus.com>:
+ * configure.in: If configuring for newlib, pass --with-newlib to
+ subdirectories.
+ * Makefile.in (CC_FOR_TARGET): If winsup/Makefile exists, pass a
+ -Bnewlib/ and -Lwinsup to gcc.
+ (CXX_FOR_TARGET): Likewise.
+
+Mon Oct 7 10:59:35 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (ETC_SUPPORT): Add configure.
+
+Fri Oct 4 12:22:58 1996 Angela Marie Thomas (angela@cygnus.com)
+
+ * configure.in: Use config/mh-dgux386 for i[345]86-dg-dgux
+ host configuration file.
+
+Thu Oct 3 09:28:25 1996 Jeffrey A Law (law@cygnus.com)
+
+ * configure.in: Break mn10x00 support into separate
+ mn10200 and mn10300 configurations.
+ * config.sub: Likewise.
+
+Wed Oct 2 22:27:52 1996 Jeffrey A Law (law@cygnus.com)
+
+ * configure.in: Add lots of stuff to noconfigdirs for
+ the mn10x00 targets.
+
+ * config.sub, configure.in: Add mn10x00 support.
+
+Wed Oct 2 15:52:36 1996 Klaus Kaempf <kkaempf@progis.de>
+
+ * make-all.com: Call conf-a-gas, not config-a-gas.
+
+Tue Oct 1 01:28:41 1996 James G. Smith <jsmith@cygnus.co.uk>
+
+ * configure.in (noconfigdirs): Don't build libgloss for arm-coff
+ targets.
+
+Mon Sep 30 14:24:01 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-README: Add much more detail for native PowerMac.
+ * mpw-install: New file.
+ * mpw-configure: Add --norecursion and --help options.
+ * mpw-config.in: Translate readme and install files when
+ copying to objdir.
+ * mpw-build.in: Don't always depend on byacc and flex.
+ (install-only-top): New action.
+
+Tue Sep 24 19:05:12 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * configure.in (noconfigdirs): Don't configure any C++ dirs
+ if targeting D10V.
+
+Tue Sep 17 12:15:31 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.sub: Recognize mips64vr5000.
+
+Mon Sep 16 17:00:52 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Use a single line for host_tools and native_only.
+
+Mon Sep 9 12:21:30 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * config.sub, configure.in: Add entries for m32r.
+
+Thu Sep 5 13:52:47 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (inet-install): Don't run install-gzip.
+
+Wed Sep 4 17:26:13 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * configure.in: Don't config lots of things for *-*-windows*.
+
+Sat Aug 31 11:45:57 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-config.in: Test for mpw-true, true, and null-command scripts.
+ (host_libs, host_tools): Copy from configure.in.
+ * mpw-configure: Don't complain about directories not found.
+
+Thu Aug 29 16:44:58 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (i[345]86): Recognize i686 for pentium pro.
+ (i[3456]86-*-dgux*): Use config/mh-sysv for the host configuration
+ file.
+
+ * config.guess (i[345]86): Ditto.
+
+Mon Aug 26 18:34:42 1996 Martin M. Hunt <hunt@pizza.cygnus.com>
+
+ * configure.in (noconfigdirs): Removed gdb for D10V.
+
+Wed Aug 21 18:56:38 1996 Fred Fish <fnf@cygnus.com>
+
+ * configure: Fix three locations where shell scripts were
+ being run directly rather than with config_shell.
+
+Thu Aug 15 12:19:33 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure: Handle multiple enable/disable options and
+ pass them down recursively, handle -c and -s flags appropriately
+ depending on choice of compiler, add escape mechanism for
+ quoted arguments to gC.
+
+Mon Aug 12 13:15:13 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (powerpc*-*-*): For eabi, system V.4, Linux, and
+ solaris targets, use config/mt-ppc to set C{,XX}FLAGS_FOR_TARGETS
+ so that -mrelocatable-lib and -mno-eabi are used.
+
+ * Makefile.in (CONFIGURE_TARGET_MODULES): If target compiler does
+ not support --print-multi-lib, don't abort.
+
+Sun Aug 11 20:51:50 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * config/mh-cygwin32 (CFLAGS): Define _WIN32 to be compatible
+ with normal Windows compilation environment.
+
+Thu Aug 8 12:18:59 1996 Klaus Kaempf <kkaempf@progis.de>
+
+ * make-all.com: Run config-a-gas.
+ * setup.com: Don't copy subdirectory files around.
+
+Tue Jul 30 17:49:31 1996 Brendan Kehoe <brendan@cygnus.com>
+
+ * configure.in (*-*-ose): Remove exclusion of libgloss for this
+ target, it now compiles correctly.
+
+Sat Jul 27 15:10:43 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-config.in: Generate Mac include for elf/dwarf2.h.
+
+Tue Jul 23 10:47:04 1996 Martin M. Hunt <hunt@pizza.cygnus.com>
+
+ * configure.in (d10v-*-*): Remove ld from $noconfigdirs.
+
+Mon Jul 22 13:28:51 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * configure.in (native_only): Add prms.
+
+Mon Jul 22 12:27:58 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (GAS_SUPPORT_DIRS): Add make-all.com and setup.com.
+ (BINUTILS_SUPPORT_DIRS): Likewise.
+
+Thu Jul 18 12:55:40 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (d10v-*-*): Don't configure ld or gdb until the
+ d10v support is added.
+
+Wed Jul 17 14:33:09 1996 Martin M. Hunt <hunt@pizza.cygnus.com>
+
+ * configure.in (d10v-*-*): New target.
+
+Mon Jul 15 11:53:00 1996 Jeffrey A Law (law@cygnus.com)
+
+ * config.guess (HP 9000/811): Recognize this as a PA1.1
+ machine.
+
+Fri Jul 12 23:21:17 1996 Ken Raeburn <raeburn@cygnus.com>
+
+ * Makefile.in (do-tar-gz): New target, split out from tail end of
+ taz target. Run each command separately, don't use pipes.
+ (taz): Use it.
+
+Fri Jul 12 12:08:04 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure: Look for g-mpw-make.sed in config/mpw.
+ * mpw-build.in: No builds should depend on building byacc or flex,
+ they are assumed to be installed already.
+
+Fri Jul 12 09:52:52 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * Makefile.in (CONFIGURE_TARGET_MODULES): Set r environment
+ variable that CC_FOR_TARGET needs.
+
+Thu Jul 11 10:09:45 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * Makefile.in (CONFIGURE_TARGET_MODULES): Determine if the multlib
+ options have changed since the last time the subdirectory was
+ configured, and if it has, reconfigure.
+ (CLEAN_TARGET_MODULES): Delete multilib.out and tmpmulti.out, which
+ CONFIGURE_TARGET_MODULES uses to remember the old multilib options.
+
+Wed Jul 10 18:56:59 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (ALL_MODULES,CROSS_CHECK_MODULES,INSTALL_MODULES,
+ CLEAN_MODULES): Add bash.
+ (all-bash): New target.
+
+Mon Jul 8 17:33:14 1996 Jim Wilson <wilson@cygnus.com>
+
+ * configure.in (mips-sgi-irix6*): Use mh-irix6 instead of mh-irix5.
+
+Mon Jul 1 13:31:35 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * config.sub (basic_machine): Recognize d10v as a valid processor.
+
+Fri Jun 28 12:14:35 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure: Add support for --bindir.
+ * mpw-build.in: Use a GCC-specific build script for GCC actions.
+
+Wed Jun 26 17:20:12 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: add bash, time, gawk to list of hosttools and things
+ to only build for native toolchains
+
+Tue Jun 25 23:09:03 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (docdir): Remove.
+
+Tue Jun 25 19:00:08 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (datadir): Set to $(prefix)/share.
+
+Mon Jun 24 23:26:07 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: build diff and patch for cygwin32-hosted
+ toolchains.
+
+Mon Jun 24 15:01:12 1996 Joel Sherrill <joel@merlin.gcs.redstone.army.mil>
+
+ * config.sub: Accept -rtems*.
+
+Sun Jun 23 22:41:54 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: enable dosrel for cygwin32-hosted builds,
+ remove diff from the list of things not buildable
+ via Canadian Cross
+
+Sat Jun 22 11:39:01 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (TARGET_SUBDIR): Move comment to previous line so we
+ don't get ". ".
+
+Fri Jun 21 17:24:48 1996 Jim Wilson <wilson@cygnus.com>
+
+ * configure.in (mips*-sgi-irix6*): Set noconfigdirs appropriately.
+
+Thu Jun 20 16:57:40 1996 Ken Raeburn <raeburn@cygnus.com>
+
+ * Makefile.in (taz): Handle case where tex3patch didn't even get
+ checked out. Also, if it was found, put the symlink in a new util
+ subdirectory.
+
+Thu Jun 20 12:20:33 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * config.guess (*:Linux:*:*): Add support for PowerPC Linux.
+
+Tue Jun 18 14:24:12 1996 Klaus Kaempf (kkaempf@progis.de)
+
+ * config.sub: Recognize -openvms.
+ * configure.in (alpha*-*-*vms*): Set noconfigdirs.
+ * make-all.com, setup.com: New files.
+
+Mon Jun 17 16:34:46 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (taz): tex3patch moved to texinfo/util.
+
+Sat Jun 15 17:13:25 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * configure: enable_gdbtk=no for cygwin32-hosted toolchains
+ * configure.in: remove make from disable-if-Can-Cross list
+ enable gdb if ${host} and ${target} are cygwin32
+
+Fri Jun 7 18:16:52 1996 Harlan Stenn <harlan@pfcs.com>
+
+ * config.guess (i?86-ncr-sysv*): Emit minor release numbers.
+ Recognize the NCR 4850 machine and NCR Pentium-based platforms.
+
+Wed Jun 5 00:09:17 1996 Per Bothner <bothner@wombat.gnu.ai.mit.edu>
+
+ * config.guess: Combine mips-mips-riscos cases, and use cpp to
+ distinguish sysv/svr4/bsd variants.
+ Based on a patch from Harlan Stenn <harlan@pfcs.com>.
+
+Fri Jun 7 14:24:49 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * configure.in: Added copyright notice.
+ * move-if-change: Added copyright notice.
+
+Thu Jun 6 16:27:05 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (powerpcle-*-solaris*): Until we get shared
+ libraries working, don't build gdb, sim, make, tcl, tk, or
+ expect.
+
+Tue Jun 4 20:41:45 1996 Per Bothner <bothner@deneb.cygnus.com>
+
+ * config.guess: Merge with FSF:
+
+ Mon Jun 3 08:49:14 1996 Karl Heuer <kwzh@gnu.ai.mit.edu>
+ * config.guess (*:Linux:*:*): Add guess for sparc-unknown-linux.
+
+ Fri May 24 18:34:53 1996 Roland McGrath <roland@delasyd.gnu.ai.mit.edu>
+ * config.guess (AViiON:dgux:*:*): Fix typo in recognizing mc88110.
+
+ Fri Apr 12 20:03:59 1996 Per Bothner <bothner@spiff.gnu.ai.mit.edu>
+ * config.guess: Combine two OSF1 rules.
+ Also recognize field test versions. From mjr@zk3.dec.com.
+ * config.guess (dgux): Use /usr/bin/uname rather than uname,
+ because GNU uname does not support -p. From pmr@pajato.com.
+
+Tue Jun 4 11:07:25 1996 Tom Tromey <tromey@csk3.cygnus.com>
+
+ * Makefile.in (MAKEDIRS): Removed $(tooldir).
+
+Tue May 28 12:30:50 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-README: Document GCCIncludes.
+
+Sun May 26 15:16:27 1996 Fred Fish <fnf@cygnus.com>
+
+ * configure.in (alpha-*-linux*): Set enable_shared to yes.
+
+Tue May 21 15:41:39 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure: Handle --enable-FOO and --disable-FOO.
+
+Mon May 20 10:12:29 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in (*-*-cygwin32): Configure make.
+
+Tue May 7 14:19:42 1996 Tom Tromey <tromey@snuffle.cygnus.com>
+
+ * Makefile.in (inet-install): Quote value of INSTALL_MODULES.
+
+Fri May 3 08:57:17 1996 Tom Tromey <tromey@lisa.cygnus.com>
+
+ * Makefile.in (all-inet): Depend on all-perl.
+
+ * Makefile.in (inet-install): New target.
+
+ * Makefile.in (all-inet): Depend on all-tcl.
+ (all-inet): Depend on all-send-pr.
+
+Tue Apr 30 13:55:51 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (powerpcle-*-solaris*): Turn off tk and tcl
+ temporarily.
+
+Thu Apr 25 11:48:20 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Don't configure --with-gnu-ld on AIX.
+
+Thu Apr 25 06:33:36 1996 Michael Meissner <meissner@wogglebug.tiac.net>
+
+ * configure.in (powerpcle-*-solaris*): Turn off gdb temporarily.
+
+Tue Apr 23 09:07:39 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (ALL_MODULES): Added all-inet.
+ (CROSS_CHECK_MODULES): Added check-inet.
+ (INSTALL_MODULES): Added install-inet.
+ (CLEAN_MODULES): Added clean-inet.
+ (all-indent): New target.
+
+ * configure.in (host_tools): Added inet.
+ (native_only): Added inet.
+ (noconfigdirs): Added inet.
+
+Fri Apr 19 15:35:29 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Don't configure libgloss if we are not configuring
+ newlib.
+
+Wed Apr 17 19:30:01 1996 Rob Savoye <rob@chinadoll.cygnus.com>
+
+ * configure.in: Don't configure libgloss for unsupported
+ architectures.
+
+Tue Apr 16 11:17:05 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * Makefile.in (CLEAN_MODULES): Add clean-apache.
+
+Mon Apr 15 15:09:05 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (ALL_MODULES): Include all-apache.
+ (CROSS_CHECK_MODULES): Include check-apache.
+ (INSTALL_MODULES): Include install-apache.
+ (all-apache): New target.
+
+ * configure.in: Added apache everywhere perl is seen.
+
+Mon Apr 15 14:59:13 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * Makefile.in: Add support for clean-{module} and
+ clean-target-{module} rules.
+
+Wed Apr 10 21:37:41 PDT 1996 Marilyn E. Sander <msander@cygnus.com>
+
+ * configure.in (*-*-ose) do not build libgloss.
+
+Mon Apr 8 16:16:20 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * config.guess (prep*:SunOS:5.*:*): Turn into
+ powerpele-unknown-solaris2.
+
+Mon Apr 8 14:45:41 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Permit --enable-shared to specify a list of
+ directories.
+
+Fri Apr 5 08:17:57 1996 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in (host==solaris): Pass only the first word of $CC
+ to /usr/bin/which when checking if we're using /usr/ccs/bin/cc.
+
+Fri Apr 5 03:16:13 1996 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Makefile.in (BASE_FLAGS_TO_PASS): pass down $(MAKE).
+
+Thu Mar 28 14:11:11 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (ALL_MODULES): Include all-perl.
+ (CROSS_CHECK_MODULES): Include check-perl.
+ (INSTALL_MODULES): Include install-perl.
+ (ALL_X11_MODULES): Include all-guile.
+ (CHECK_X11_MODULES): Include check-guile.
+ (INSTALL_X11_MODULES): Include install-guile.
+ (all-perl): New target.
+ (all-guile): New target.
+
+ * configure.in (host_tools): Include perl and guile.
+ (native_only): Include perl and guile.
+ (noconfigdirs): Don't build guile and perl; no ports have been
+ done.
+
+Tue Mar 26 21:18:50 1996 Andrew Cagney <cagney@kremvax.highland.com.au>
+
+ * configure (--enable-*): Handle quoted option lists such as
+ --enable-sim-cflags='-g0 -O' better.
+
+Thu Mar 21 11:53:08 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * Makefile.in ({,inst}all-target): New rule so we can make and
+ install all of the target directories easily.
+
+Wed Mar 20 18:10:57 1996 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
+
+ * configure.in: Add missing global flag in sed substitution when
+ deleting `target-' from ${configdirs}.
+
+Thu Mar 14 19:15:06 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (DO_X): Don't get confused if CC contains `=' in an
+ option.
+
+ * configure.in (mips*-nec-sysvr4*): Use a host_makefile_frag of
+ config/mh-necv4.
+
+ * install.sh: Correct misspelling of transformbasename.
+
+ * config.guess: Recognize mips-*-sysv*.
+
+Mon Mar 11 15:36:42 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * config.sub: Recognize mon960.
+
+Sun Mar 10 13:18:38 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Restore Canadian Cross handling of BISON and LEX,
+ removed in Feb 20 change.
+
+Fri Mar 8 20:07:09 1996 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * README: Suggestions from Torbjorn Granlund <tege@matematik.su.se>:
+ Mention make install. Remove the old copyright date as well the
+ clumsy and rather pointless copyright on the README file.
+
+Fri Mar 8 17:51:35 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in ($(CONFIGURE_TARGET_MODULES)): If there is a
+ Makefile after running symlink-tree, then run `make distclean' to
+ avoid clobbering any generated files in srcdir.
+
+Tue Mar 5 08:21:44 1996 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * configure.in (m68k-*-netbsd*): Build everything now.
+
+Wed Feb 28 12:25:46 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (taz): Fix quoting.
+
+Tue Feb 27 11:33:57 1996 Doug Evans <dje@charmed.cygnus.com>
+
+ * configure.in (sparclet-*-*): Build everything now.
+
+Tue Feb 27 14:31:51 1996 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
+
+ * configure.in (m68k-*-linux*): New host.
+
+Mon Feb 26 14:32:44 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Check for bison before byacc.
+
+Tue Feb 20 23:12:35 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * Makefile.in configure: Change the way LEX and BISON/YACC are
+ set. configure now defines DEFAULT_LEX and DEFAULT_YACC by
+ searching PATH. These are used as fallbacks by Makefile.in if
+ flex/bison/byacc aren't in objdir.
+
+Mon Feb 19 11:45:30 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in: Make everything which depends upon all-bfd also
+ depend upon all-opcodes, in case --with-commonbfdlib is used.
+
+Thu Feb 15 19:50:50 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (host *-*-cygwin32): Don't build gdb if we are
+ building NT native compilers on Unix.
+
+Thu Feb 15 17:42:25 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Don't get CC from the host Makefile fragment if we
+ can find gcc in PATH, or if this is a Canadian Cross. Move the
+ Solaris test for /usr/ucb/cc to the post target script, just after
+ the compiler sanity test.
+
+Wed Feb 14 16:57:40 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.sub: Merge with FSF.
+
+Tue Feb 13 14:27:48 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (RPATH_ENVVAR): New variable.
+ (REALLY_SET_LIB_PATH): Use it.
+ * configure.in: On HP/UX, set RPATH_ENVVAR to SHLIB_PATH.
+
+Mon Feb 12 15:28:49 1996 Doug Evans <dje@charmed.cygnus.com>
+
+ * config.sub, configure.in: Recognize sparclet cpu.
+
+Mon Feb 12 15:33:59 1996 Christian Bauernfeind <chrisbfd@theorie3.physik.uni-erlangen.de>
+
+ * config.guess: Support m68k-cbm-sysv4.
+
+Sat Feb 10 12:06:42 1996 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
+
+ * config.guess (*:Linux:*:*): Guess m68k-unknown-linux and
+ m68k-unknown-linuxaout from linker help string. Put quotes around
+ $ld_help_string.
+
+Thu Dec 7 09:03:24 1995 Tom Horsley <Tom.Horsley@mail.hcsc.com>
+
+ * config.guess (powerpc-harris-powerunix): Add guess for port
+ to new target.
+
+Thu Feb 8 15:37:52 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * config.guess (UNAME_VERSION): Recognize X4.x as an OSF version.
+
+Mon Feb 5 16:36:51 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: If --enable-shared was used, set SET_LIB_PATH to
+ $(REALLY_SET_LIB_PATH) in Makefile.
+ * Makefile.in (SET_LIB_PATH): New variable.
+ (REALLY_SET_LIB_PATH): New variable.
+ ($(DO_X)): Use $(SET_LIB_PATH).
+ (install.all, gcc-no-fixedincludes, $(ALL_MODULES)): Likewise.
+ ($(NATIVE_CHECK_MODULES), $(CROSS_CHECK_MODULES)): Likewise.
+ ($(INSTALL_MODULES), $(CONFIGURE_TARGET_MODULES)): Likewise.
+ ($(ALL_TARGET_MODULES), $(CHECK_TARGET_MODULES)): Likewise.
+ ($(INSTALL_TARGET_MODULES), $(ALL_X11_MODULES)): Likewise.
+ ($(CHECK_X11_MODULES), $(INSTALL_X11_MODULES)): Likewise.
+ (all-gcc, all-bootstrap, check-gcc, install-gcc): Likewise.
+ (install-dosrel): Likewise.
+ (all-opcodes): Depend upon all-libiberty.
+
+Sun Feb 4 16:51:11 1996 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * config.guess (*:CYGWIN*): New
+
+Sat Feb 3 10:42:35 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * Makefile.in (all-target-winsup): All all-target-libiberty.
+
+Fri Feb 2 17:58:56 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (noconfigdirs): Add missing # in front of comment.
+
+Thu Feb 1 14:38:13 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: add second pass to things added to noconfigdirs
+ so *-gm-magic can exclude libgloss properly.
+
+Thu Feb 1 11:10:16 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure (extralibs_name, rez_name): Set correctly
+ for MWC68K compiler.
+
+ * mpw-README: Add more info on the necessary build tools.
+
+Thu Feb 1 10:22:38 1996 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * configure.in, config.sub: Recognize cygwin32.
+
+Wed Jan 31 14:17:10 1996 Richard Henderson <rth@tamu.edu>
+
+ * config.guess, config.sub: Recognize A/UX.
+
+Wed Jan 31 13:52:14 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.sub: Merge with gcc/config.sub.
+
+Thu Jan 25 11:01:10 1996 Raymond Jou <rjou@mexican.cygnus.com>
+
+ * mpw-build.in (do-binutils): Add build of stamps.
+
+Thu Jan 25 17:05:26 1996 James G. Smith <jsmith@cygnus.co.uk>
+
+ * config.sub: Add recognition for mips64vr4100*-* targets.
+
+Wed Jan 24 12:47:55 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * test-build.mk: Add checking of `hpux9' rather than just `hpux'.
+ Add creation of gconfigargs with `--enable-shared' turned on.
+ ($(host)-stamp-stage2-configured): Pass $(gconfigargs).
+ ($(host)-stamp-stage3-configured): Likewise.
+ (HOLES): Add chatr and ldd.
+ (i386-ncr-sysv4.3*): Add use of /usr/ccs/bin in the PATH and HOLE_DIRS.
+
+Wed Jan 24 20:32:30 1996 Torbjorn Granlund <tege@noisy.matematik.su.se>
+
+ * configure: Pass --nfp to recursive configures.
+
+Mon Jan 22 10:41:56 1996 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * Makefile.in (DLLTOOL): New.
+ (DLLTOOL_FOR_TARGET): New.
+ (EXTRA_HOST_FLAGS): Pass down DLLTOOL.
+ (EXTRA_TARGET_FLAGS): Ditto.
+ (EXTRA_GCC_FLAGS): Ditto.
+ (CONFIGURE_TARGET_MODULES): Ditto.
+ (DO_X): Ditto.
+ * configure: Add DLLTOOL.
+
+Fri Jan 19 13:30:15 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ SCO OpenServer 5 changes from Robert Lipe <robertl@dgii.com>:
+ * configure.in (i[345]86-*-sco3.2v5*): Use mh-sysv instead of
+ mh-sco, since old workarounds no longer needed, and don't
+ build ld, since libraries have weak symbols in COFF.
+
+Sun Jan 14 23:01:31 1996 Fred Fish <fnf@cygnus.com>
+
+ * Makefile.in (CONFIGURE_TARGET_MODULES): Add missing ';'.
+
+Fri Jan 12 15:25:35 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Make sure that ${CC} can be used to compile an
+ executable.
+
+Sat Jan 6 07:23:33 1996 Michael Meissner <meissner@wogglebug.tiac.net>
+
+ * Makefile.in (all-gdb): Depend on $(GDB_TK).
+ * configure (GDB_TK): Set GDB_TK to either "all-tcl all-tk" or
+ nothing depending on whether gdbtk is being built.
+
+Wed Jan 3 17:54:41 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (newlib.tar.gz): Delete building of newlib's info files.
+
+Mon Jan 1 19:09:14 1996 Brendan Kehoe <brendan@rtl.cygnus.com>
+
+ * configure.in (noconfigdirs): Put ld or gas in this early, if the
+ user specifically used --with-gnu-ld=no or --with-gnu-as=no.
+
+Sat Dec 30 16:08:57 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * config-ml.in: Add support for
+ --disable-{softfloat,m68881,m68000,m68020} on m68*-*-*.
+ Simplify setting of multidirs from --disable-foo.
+
+Fri Dec 29 07:56:11 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * Makefile.in (EXTRA_GCC_FLAGS): If any of the make variables
+ LANGUAGES, BOOT_CFLAGS, STMP_FIXPROTO, LIMITS_H_TEST,
+ LIBGCC1_TEST, LIBGCC2_CFLAGS, LIBGCC2_INCLUDES, and ENQUIRE are
+ non-empty, pass them on to the GCC make.
+ (all-bootstrap): New rule that is like all-gcc, except it executes
+ the GCC bootstrap rule instead of the GCC all rule.
+
+Wed Dec 27 15:51:48 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * config-ml.in (ml_realsrcdir): New, to account for ${subdir}.
+
+Tue Dec 26 11:45:31 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * config.guess (AViiON:dgux:*:*): Update from FSF to add pentium
+ DG/UX support.
+
+Fri Dec 15 10:01:27 1995 Stan Cox <coxs@dg-rtp.dg.com>
+
+ * config.sub (i*86*) Change [345] to [3456]
+
+Wed Dec 20 17:41:40 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * configure.in (noconfigdirs): Add gas or ld if --with-gnu-as=no or
+ --with-gnu-ld=no.
+
+Wed Dec 20 15:15:35 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * config-ml.in (rs6000*, powerpc*): Add switches to control which
+ AIX multilibs get built.
+
+Mon Dec 18 17:55:46 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in (i386-win32): Don't build expect if we're not
+ building the tcl subdir.
+
+Mon Dec 18 11:47:19 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * Makefile.in: (configure-target-examples, all-target-examples):
+ New targets, configure and build example programs.
+
+Fri Dec 15 16:13:03 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure: If an mpw-config.in generated a file mk.sed,
+ use it as input to sedit the generated MPW makefile.
+ * mpw-README: Add a suggestion about Gestalt.h.
+
+Wed Dec 13 16:43:51 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.sub: Accept *-*-ieee*.
+
+Tue Dec 12 11:52:57 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (local-distclean): Remove $(TARGET_SUBDIR). From
+ Ronald F. Guilmette <rfg@monkeys.com>.
+
+Mon Dec 11 15:31:58 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in (host==powerpc-pe): Add many directories to noconfigdirs
+ for powerpc-pe native.
+ (target==i386-win32): add tcl, make to noconfigdirs if canadian cross.
+ (target==powerpc-pe): duplicate i386-win32 entry.
+
+Sat Dec 9 14:58:28 1995 Jim Wilson <wilson@chestnut.cygnus.com>
+
+ * configure.in (noconfigdirs): Exclude target-newlib for all versions
+ of vxworks, not just vxworks5.1.
+
+Mon Dec 4 12:05:40 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure: Add support for exec-prefix.
+
+Mon Dec 4 10:22:50 1995 Jeffrey A. Law <law@rtl.cygnus.com>
+
+ * config.guess: Recognize HP model 816 machines as having
+ a PA1.1 processor.
+
+Mon Dec 4 12:38:15 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Ignore new autoconf configure options.
+
+Thu Nov 30 14:45:25 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * config/mt-v810 (CC_FOR_TARGET): Add -ansi flag. NEC compiler
+ defaults to K&R mode, but doesn't have varargs.h, so we have to
+ compile in ANSI mode.
+
+Thu Nov 30 16:57:33 1995 Per Bothner <bothner@wombat.gnu.ai.mit.edu>
+
+ * config.guess: Recognize Pentium under SCO.
+ From Robert Lipe <robertl@arnet.com>.
+
+Wed Nov 29 13:49:08 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * configure.in (noconfigdirs): Disable target-libio on v810-*-*.
+ * config/mt-v810 (CC_FOR_TARGET, AS_FOR_TARGET, AR_FOR_TARGET,
+ RANLIB_FOR_TARGET): Set as appropriate for NEC v810 toolchain.
+
+Wed Nov 29 12:12:01 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Don't configure gas for alpha-dec-osf*.
+
+Tue Nov 28 17:16:48 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Default to --with-stabs for some targets for which
+ it makes sense: mips*-*-*, alpha*-*-osf*, i[345]86*-*-sysv4* and
+ i[345]86*-*-unixware*.
+
+Mon Nov 27 13:44:15 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * config-ml.in: Get list of multidirs using gcc --print-multi-lib
+ rather than basing it on the target. Simplify handling of options
+ controlling which directories to configure. Remove extraneous
+ slash in multi-clean target.
+
+Fri Nov 24 17:29:29 1995 Doug Evans <dje@deneb.cygnus.com>
+
+ * config-ml.in: Prefix more variables with ml_ so they don't collide
+ with configure's.
+
+Wed Nov 22 11:27:02 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Don't turn -v into --v.
+
+Tue Nov 21 16:48:02 1995 Doug Evans <dje@deneb.cygnus.com>
+
+ * configure.in (targargs): Fix typo.
+
+ * Makefile.in (DEVO_SUPPORT): Add symlink-tree.
+
+Tue Nov 21 14:08:28 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Strip --host and --target options from
+ CONFIG_ARGUMENTS, and always configure for --host only. Add
+ --with-cross-host option when building with a cross-compiler.
+ * configure: Canonicalize the arguments put into config.status by
+ always using `=' for an option with an argument. Pass a presumed
+ --host or --target explicitly.
+
+Fri Nov 17 17:50:30 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * config.sub: Merge -macos*, -magic*, -pe*, and -win32 cases
+ into general OS recognition case.
+
+Fri Nov 17 17:42:25 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in (target_configdirs): add target-winsup only
+ for win32 target systems.
+
+Thu Nov 16 14:04:47 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (all-target-libgloss): Depend upon
+ configure-target-newlib, since when libgloss is built it looks to
+ see if the newlib directory exists.
+
+Wed Nov 15 14:47:52 1995 Ken Raeburn <raeburn@cygnus.com>
+
+ * Makefile.in (DEVO_SUPPORT): Use config-ml.in instead of
+ cfg-ml-*.in.
+
+Wed Nov 15 11:45:23 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Handle LD and LD_FOR_TARGET when configuring a
+ Canadian Cross.
+
+Tue Nov 14 15:03:12 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * config/mh-i386win32: add LD_FOR_TARGET.
+
+Tue Nov 14 14:56:11 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in (target_libs): add target-winsup.
+ (target==i386-win32): add patch diff flex make to $noconfigdirs.
+ (target==ppcle-pe): remove ld from $noconfigdirs.
+
+Tue Nov 14 01:25:50 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (CONFIGURE_TARGET_MODULES): Pass --with-target-subdir.
+ Preserve relative path names in $srcdir. Build symlink tree if
+ configuring cross target dir and srcdir=. (= no VPATH support).
+ (configure-target-libg++): Depend on configure-target-librx.
+ * cfg-ml-com.in, cfg-ml-pos.in: Deleted.
+ * config-ml.in: New file.
+ * symlink-tree: New file.
+ * configure: Ensure srcdir="." if that's what it is.
+
+Mon Nov 13 12:34:20 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-README: Clarify some phrasing, add notes about CodeWarrior
+ includes and FLEX_SKELETON setting.
+ * mpw-configure (--with-gnu-ld): New option, controls whether
+ to use PPCLink or ld with PowerMac GCC.
+ * mpw-build.in (all-grez, do-grez, install-grez): New targets.
+ * mpw-config.in: Configure grez if targeting Mac.
+
+ * config.sub: Accept pmac and pmac-mpw as names for PowerMacs,
+ accept mpw and mac-mpw as names for m68k Macs, change macos7 to
+ just macos.
+ * configure.in: Configure grez resource compiler if targeting Mac.
+ * Makefile.in (all-grez, install-grez): New targets.
+
+Wed Nov 8 17:33:51 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure: CXX defaults to gcc, not g++. If we find
+ gcc in the path, set CC to gcc -O2.
+
+Tue Nov 7 15:45:17 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Default ${build} correctly. Avoid picking up extra
+ spaces when reading CC and CXX from Makefile. When doing a
+ Canadian Cross, use plausible default values for numerous
+ variables.
+ * configure.in: When doing a Canadian Cross, don't try to
+ configure tools whose configure script can't handle it.
+
+Mon Nov 6 19:32:17 1995 Jim Wilson <wilson@chestnut.cygnus.com>
+
+ * cfg-ml-com.in (sh-*-*): Add m2 and ml/m2 to multidirs.
+
+Sun Nov 5 00:15:41 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure: Remove dubious bug reporting address.
+
+Fri Nov 3 08:17:54 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in ($(CONFIGURE_TARGET_MODULES)): If subdir has
+ configure script, run that instead of this directory's configure.
+ In either case, print a message that we're configuring the sub-dir.
+
+Thu Nov 2 23:23:36 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in: Before checking for the existence of various files,
+ use sed to filter out "target-".
+
+Thu Nov 2 13:24:56 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (DO_X): Split rule to decrease command line length
+ for systems with small ARG_MAX values. From phdm@info.ucl.ac.be
+ (Philippe De Muyter).
+
+Wed Nov 1 15:18:35 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Makefile.in (all-patch): depend on all-libiberty.
+
+Wed Nov 1 12:23:20 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: If the only directory in target_configdirs which
+ actually exists is libiberty, then set target_configdirs to empty,
+ to avoid trying to build a target libiberty in a gas or gdb
+ distribution.
+
+Tue Oct 31 17:52:39 1995 J.T. Conklin <jtc@slave.cygnus.com>
+
+ * configure.in (host_makefile_frag): Use m68k-sun-sunos* instead
+ of m68k-sun-* when selecting mh-sun3 to avoid matching NetBSD/sun3
+ systems.
+
+Tue Oct 31 16:57:32 1995 Jim Wilson <wilson@chestnut.cygnus.com>
+
+ * configure.in (copy_dirs): Use sys-include instead of include
+ for --with-headers option.
+
+Tue Oct 31 10:29:36 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * Makefile.in, configure.in: Make winsup builds work with
+ new scheme.
+
+Mon Oct 30 18:57:09 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Build the linker on AIX.
+
+Mon Oct 30 12:27:16 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (CC_FOR_TARGET, CXX_FOR_TARGET): Add $(TARGET_SUBDIR)
+ where needed.
+
+Mon Oct 30 12:45:25 1995 Doug Evans <dje@cygnus.com>
+
+ * Makefile.in (all-gcc): Fix typo.
+
+Sat Oct 28 10:27:59 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in ($(CHECK_TARGET_MODULES)): Fix typo.
+
+Fri Oct 27 23:14:12 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in: Rename libFOO to target-libFOO, and xiberty
+ to target-xiberty, to provide more flexibility.
+ (target_subdir): Define. Create if cross.
+ Set TARGET_SUBDIR in Makefile to ${target_subdir}.
+ * Makefile.in: Rename all-libFOO -> all-target-libFOO, all-xiberty
+ -> all-target-libiberty, configure-libFOO -> configure-target-libFOO,
+ check-libFOO -> check-target-libFOO, etc.
+ ($(DO_X)): Iterate over TARGET_CONFIGDIRS after SUBDIRS.
+ ($(CONFIGURE_TARGET_MODULES), $(CHECK_TARGET_MODULES),
+ $(ALL_TARGET_MODULES), $(INSTALL_TARGET_MODULES)): Update accordingly.
+ (configure-target-XXX): Depend on $(ALL_GCC), not all-gcc, to
+ allow ALL_GCC="" to only configure.
+ (DEVO_SUPPORT): Add cfg-ml-com.in and cfg-ml-pos.in.
+ (ETC_SUPPORT, ETC_SUPPORT_PFX): Merge; update 'taz' accordingly.
+ (LIBGXX_SUPPORT_DIRS): Remove xiberty.
+
+Sat Oct 28 01:53:49 1995 Ken Raeburn <raeburn@cygnus.com>
+
+ * Makefile.in (taz): Build "info" in etc explicitly.
+
+Fri Oct 27 09:32:30 1995 Stu Grossman (grossman@cygnus.com)
+
+ * configure.in: Make sure that CC is undefined (as opposed to
+ null) if toplevel/config/mh-{host} doesn't define it. Fixes a
+ problem with autoconf trying to configure on a host without GCC.
+
+Thu Oct 26 22:35:01 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure: Set host alias from choice of host compiler,
+ only use generic MPW Makefile sed if present, edit a file
+ named "hacked_Makefile.in" instead of "Makefile.in" if present.
+ * mpw-README: Add problem notes about CW6 and CW7.
+
+Thu Oct 26 05:45:10 1995 Ken Raeburn <raeburn@kr-pc.cygnus.com>
+
+ * Makefile.in (taz): Use ";" instead of ";;".
+
+Wed Oct 25 15:18:24 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (taz): Grep for '^diststuff:' or '^info:' in
+ sub-directory Makefiles, instead of using DISTSTUFFDIRS and
+ DISTDOCDIRS.
+ (DISTSTUFFDIRS, DISTDOCDIRS): Removed - no longer used.
+ (newlib.tar.gz): Don't pass DISTDOCDIRS to recursive make.
+
+Wed Oct 25 14:43:55 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (DISTDOCDIRS): Remove ld gprof bnutils gas libg++ gdb
+ and gnats, because they are now subsumed by DISTSTUFFDIRS.
+ Move bfd to DISTSTUFFDIRS.
+
+Tue Oct 24 18:19:09 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Makefile.in (X11_LIB): Removed.
+ (X11_FLAGS_TO_PASS): pass only X11_EXTRA_CFLAGS and X11_EXTRA_LIBS.
+
+ * configure.in (host_makefile_frag): mh-aix & mh-sun removed.
+
+Sun Oct 22 13:04:42 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * cfg-ml-com.in (powerpc*): Shorten some of the multilib directory
+ names.
+
+Fri Oct 20 18:02:10 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * cfg-ml-com.in (powerpc*-eabi*): Add mcall-aixdesc varients.
+
+Thu Oct 19 10:40:57 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * configure.in (i[345]86-*-win32): Always build newlib.
+ Don't configure cvs, autoconf or texinfo.
+ * Makefile.in (LD_FOR_TARGET): New.
+ (BASE_FLAGS_TO_PASS, EXTRA_TARGET_FLAGS, CONFIGURE_TARGET_MODULES):
+ Pass down LD_FOR_TARGET.
+
+Wed Oct 18 15:53:56 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * winsup: New directory.
+ * Makefile.in: Build winsup.
+ * configure.in: Winsup is configured when target is win32.
+ Can only build win32 target GDB when native.
+
+Mon Oct 16 09:42:31 1995 Jeffrey A Law (law@cygnus.com)
+
+ * config.guess: Recognize HP model 819 machines as having
+ a PA 1.1 processor.
+
+Mon Oct 16 10:49:43 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Fix sed loop which substitutes for CC and CXX to
+ avoid bug found in various sed implementations.
+
+Wed Oct 11 16:16:20 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * cfg-ml-com.in (powerpc-*-eabisim): Delete separate rule for
+ simulator. Use standard powerpc-*-eabi*.
+
+Mon Oct 9 17:21:56 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Stop putting gas and binutils in noconfigdirs for
+ powerpc-*-aix* and rs6000-*-*.
+
+Mon Oct 9 12:38:40 1995 Michael Meissner <meissner@cygnus.com>
+
+ * cfg-ml-com.in (powerpc*-*-eabisim*): Add support for building
+ -mcall-aixdesc libraries.
+
+Fri Oct 6 16:17:57 1995 Ken Raeburn <raeburn@cygnus.com>
+
+ Mon Sep 25 22:49:32 1995 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
+
+ * config.sub (arm | armel | armeb): Fix shell syntax.
+
+Fri Oct 6 14:40:28 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * cfg-ml-com.in ({powerpc,rs6000}-ibm-aix*): Add multilibs for
+ -msoft-float and -mcpu=common support.
+ (powerpc*-*-eabisim*): Add support for building -mcall-aix
+ libraries.
+
+Thu Oct 5 13:26:37 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * configure.in: Allow configuration and build of emacs19 for the alpha.
+
+Wed Oct 4 22:05:36 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in (CC): Get ^CC, not just any old CC, from
+ ${host_makefile_frag}.
+
+Wed Oct 4 21:55:00 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in (CC): Try to get CC from
+ ${srcdir}/${host_makefile_frag}, not ${host_makefile_frag}.
+
+Wed Oct 4 21:44:12 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Makefile.in (TARGET_CONFIGDIRS): configure targetdirs
+ only if it exists in $(srcdir).
+
+Wed Oct 4 11:52:31 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: If CC and CXX are not set in the environment, set
+ them, based on either an existing Makefile or on searching for gcc
+ in PATH. Substitute for CC and CXX in Makefile.
+ * configure.in: Remove libm from target_libs. Separate
+ target_configdirs from configdirs. If CC is not set in
+ environment, try to get it from a host Makefile fragment. Rewrite
+ changes of configdirs to use skipdirs instead. A few minor
+ tweaks. Take directories out of target_configdirs as they are
+ taken out of configdirs. Remove existing Makefile files from
+ subdirectories. Substitute for TARGET_CONFIGDIRS and
+ CONFIG_ARGUMENTS in Makefile.
+ * Makefile.in (TARGET_CONFIGDIRS): New variable, automatically set
+ by configure.in.
+ (CONFIG_ARGUMENTS): Likewise.
+ (CONFIGURE_TARGET_MODULES): New variable.
+ ($(DO_X)): Loop over TARGET_CONFIGDIRS as well as SUBDIRS.
+ ($(CONFIGURE_TARGET_MODULES)): New target.
+ (configure-libg++, configure-libio): New targets.
+ (all-libg++): Depend upon configure-libg++.
+ (all-libio): Depend upon configure-libio.
+ (configure-libgloss, all-libgloss): New targets.
+ (configure-libstdc++): New target.
+ (all-libstdc++): Depend upon configure-libstdc++.
+ (configure-librx, all-librx): New targets.
+ (configure-newlib): New target.
+ (all-newlib): Depend upon configure-newlib
+ (configure-xiberty): New target.
+ (all-xiberty): Depend upon configure-xiberty.
+
+Sat Sep 30 04:32:59 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in (host i[345]86-*-win32): Expand the
+ noconfigdirs again.
+
+Thu Sep 28 21:18:49 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-configure: Fix sed command file name.
+
+Thu Sep 28 17:39:56 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * configure.in (host i[345]86-*-win32): Reduce the
+ noconfigdirs again.
+
+Wed Sep 27 12:24:00 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Don't configure ld and gdb for powerpc*-*-winnt*
+ or powerpc*-*-pe*, since they are not yet supported.
+
+Tue Sep 26 14:30:01 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ Add PowerMac support and many other enhancements.
+ * mpw-configure: New option --cc to select compiler to use,
+ paste options set according to --cc into the generated
+ Makefile, generate the Makefile by sed'ing the Unix Makefile.in
+ if mpw-make.sed is present.
+ * mpw-config.in: Don't test for gC1, test for mpw-touch,
+ add forward includes for PowerPC include files.
+ * mpw-build.in: Build using Makefile.PPC if present.
+ (do-byacc, etc): Remove separate version resource builds.
+ (do-gas): Build "stamps" before "all".
+ (do-gcc): Build "stamps-h" and "stamps-c" before "all".
+ * mpw-README: Update to reflect --cc option, PowerMac support,
+ and recently-reported compatibility problems.
+
+Fri Sep 22 12:15:42 1995 Doug Evans <dje@deneb.cygnus.com>
+
+ * cfg-ml-com.in (m68*-*-*): Only build multilibs for
+ embedded m68k systems (-aout, -coff, -elf, -vxworks).
+ (--with-multilib-top): Pass to recursive invocations.
+
+Tue Sep 19 13:51:05 1995 J.T. Conklin <jtc@blues.cygnus.com>
+
+ * configure.in (noconfigdirs): Disable libg++ and libstdc++ on
+ v810-*-*.
+
+Mon Sep 18 23:08:26 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * configure.in (noconfigdirs): Disable bfd, binutils, gas, gcc,
+ gdb, ld and opcodes on v810-*-*.
+
+Sat Sep 16 18:31:08 PDT 1995 Angela Marie Thomas <angela@cygnus.com>
+
+ * config/mh-ncrsvr43: Removed AR_FLAGS
+
+Tue Sep 12 18:03:31 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (DO_X): Change do-realclean to do-maintainer-clean.
+ (local-maintainer-clean): New target.
+ (maintainer-clean): New target.
+ (realclean): Just depend upon maintainer-clean.
+
+Fri Sep 8 17:11:14 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * configure.in (noconfigdirs): Disable gdb on m68k-*-netbsd*.
+
+Fri Sep 8 16:46:29 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Build ld in mips*-*-bsd* case.
+
+Thu Sep 7 20:03:41 1995 Ken Raeburn <raeburn@cygnus.com>
+
+ * config.sub: Accept -lites* OS. From Ian Dall.
+
+Fri Sep 1 08:06:58 1995 James G. Smith <jsmith@beauty.cygnus.com>
+
+ * config.sub: recognise mips64vr4300 and mips64vr4300el as valid
+ targets.
+
+Wed Aug 30 21:06:50 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in: treat i386-win32 canadian cross the same as
+ i386-go32 canadian cross.
+
+Thu Aug 24 14:53:20 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * cfg-ml-com.in (powerpc*-*-eabisim): Add support for PowerPC
+ running under the simulator to build a reduced set of libraries.
+ (powerpc-*-eabiaix): Add fine grained multilib support added to
+ other powerpc targets yesterday.
+
+Wed Aug 23 09:41:56 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * cfg-ml-com.in (powerpc*): Add support for -disable-biendian,
+ -disable-softfloat, -disable-relocatable, -disable-aix, and
+ -disable-sysv to control which multilib libraries get built.
+
+Thu Aug 17 16:03:41 1995 Ken Raeburn <raeburn@kr-laptop.cygnus.com>
+
+ * configure: Add Makefile.tem to list of files to remove in trap
+ handler.
+
+Mon Aug 14 19:27:56 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.guess (*Linux*): Add missing "exit"s.
+ Also, need specific check for alpha-unknown-linux (uses COFF).
+
+Fri Aug 11 15:38:20 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.guess: Merge with FSF:
+
+ Wed Jun 28 17:57:27 1995 David Edelsohn <edelsohn@mhpcc.edu>
+ * config.guess (AIX4): More robust release numbering discovery.
+
+ Thu Jun 22 19:01:24 1995 Kenneth Stailey (kstailey@eagle.dol-esa.gov)
+ * config.guess (i386-sequent-ptx): Properly get version number.
+
+ Thu Jun 22 18:36:42 1995 Uwe Seimet (seimet@iris1.chemie.uni-kl.de)
+ * config.guess (mips:*:4*:UMIPS): New case.
+
+Mon Aug 7 09:21:35 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * configure.in (i386-go32 host): Fix typo (deja-gnu -> dejagnu).
+ (i386-win32 host): Likewise. Don't build readline.
+
+Sat Aug 5 09:51:49 1995 Fred Fish <fnf@rtl.cygnus.com>
+
+ * Makefile.in (GDBTK_SUPPORT_DIRS): Define and pass as part of
+ SUPPORT_FILES to submakes.
+
+Fri Aug 4 13:04:36 1995 Fred Fish <fnf@cygnus.com>
+
+ * Makefile.in (GDB_SUPPORT_DIRS): Add utils.
+ (DEVO_SUPPORT): Add mpw-README, mpw-build.in, mpw-config.h and
+ mpw-configure.
+
+Wed Aug 2 16:32:40 1995 Ken Raeburn <raeburn@cygnus.com>
+
+ * configure.in (appdirs): Use =, not ==, in test expression when
+ trying to build the text to print in the warning message for
+ Solaris users.
+
+Mon Jul 31 09:56:18 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * cfg-ml-com.in (z8k-*-coff): Add 'std' multilib build.
+
+Fri Jul 28 00:16:31 1995 Jeffrey A. Law <law@rtl.cygnus.com>
+
+ * config.guess: Recognize lynx-2.3.
+
+Thu Jul 27 15:47:59 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * config.sub (z8ksim): Deleted
+ (z8k-*-coff): New, this is the one true name of the target.
+
+Thu Jul 27 14:33:33 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * cfg-ml-pos.in (dotdot): Work around SunOS sed bug.
+
+Thu Jul 27 13:31:05 1995 Fred Fish (fnf@cygnus.com)
+
+ * config.guess (*:Linux:*:*): First try asking the linker what the
+ default object file format is (elf, aout, or coff). Then if this
+ fails, try previous methods.
+
+Thu Jul 27 11:28:17 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * configure.in: Don't build newlib for *-*-vxworks5.1.
+
+Thu Jul 27 11:18:47 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * configure.in: Don't build newlib for a29k-*-vxworks5.1.
+ * test-build.mk: Add setting of --with-headers for a29k-vxworks5.1.
+
+Tue Jul 25 21:25:39 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * cfg-ml-pos.in (MULTITOP): Trim excess trailing "/.".
+
+Fri Jul 21 10:41:12 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * cfg-ml-com.in: New file.
+ * cfg-ml-pos.in: New file.
+
+Wed Jul 19 00:37:27 1995 Jeffrey A. Law <law@rtl.cygnus.com>
+
+ * COPYING.NEWLIB: Add HP free copyright to list.
+
+Tue Jul 18 10:58:51 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * config.sub: Recognize -eabi* for the system, not just -eabi.
+
+Mon Jul 3 13:44:51 1995 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * Makfile.in (DLLTOOL_FOR_TARGET): New name, pass it down.
+ * config.sub, configure.in (win32): New target and host.
+
+Wed Jun 28 23:57:08 1995 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * configure.in: Add i386-pe configuration.
+
+Fri Jun 23 14:28:44 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-build.in (install): Install GDB after LD.
+
+Thu Jun 22 17:10:53 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-config.in (elf/mips.h): Always forward-include, needed
+ for GDB to build.
+
+Wed Jun 21 15:17:30 1995 Rob Savoye <rob@darkstar.cygnus.com>
+
+ * testsuite: New directory for customer acceptance and whole tool
+ chain tests.
+
+Wed Jun 21 16:50:29 1995 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * configure: If per-host line isn't found, but AC_OUTPUT is found
+ and a configure script exists, run it instead.
+
+Thu Jun 15 21:09:24 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.guess: Update from FSF, for alpha-dec-winnt3.5 and Crays.
+
+Tue Jun 13 21:43:27 1995 Rob Savoye <rob@darkstar.cygnus.com>
+
+ * configure: Set build_{cpu,vendor,os,alias} to host values when
+ --build isn't specified.
+
+Mon Jun 5 18:26:36 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (PICFLAG, PICFLAG_FOR_TARGET): New macros.
+ (FLAGS_TO_PASS): Pass them.
+ (EXTRA_TARGET_FLAGS): Ditto.
+
+ * config/m?-*pic: Define PICFLAG* instead of LIB*FLAGS*.
+
+Wed May 31 22:27:42 1995 Jim Wilson <wilson@chestnut.cygnus.com>
+
+ * Makefile.in (all-libg++): Depend on all-libstdc++.
+
+Thu May 25 22:40:59 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * configure.in (noconfigdirs): Enable all packages for
+ i386-unknown-netbsd.
+
+Sat May 20 13:22:31 1995 Angela Marie Thomas <angela@cirdan.cygnus.com>
+
+ * configure.in (noconfigdirs): Don't configure tk for i386-go32
+ hosted builds (DOS builds)
+
+Thu May 18 18:08:49 1995 Ken Raeburn <raeburn@kr-laptop.cygnus.com>
+
+ Changes for ARM based on patches from Richard Earnshaw:
+ * config.sub: Handle armeb and armel.
+ * configure.in: Omit arm linker only for riscix.
+
+Thu May 11 17:23:26 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.guess: Update from FSF.
+
+Tue May 9 15:52:05 1995 Michael Meissner <meissner@cygnus.com>
+
+ * config.sub: Recognize powerpcle as the little endian varient of
+ the PowerPC. Recgonize ppc as a PowerPC variant, and ppcle as a
+ powerpcle variant. Convert pentium into i586, not i486. Add p5
+ alias for i586. Map new x86 variants p6, k5, nexgen into i586
+ temporarily.
+
+Tue May 2 16:29:41 1995 Jeff Law (law@snake.cs.utah.edu)
+
+ * configure.in (hppa*-*-lites*): Treat like hppa*-*-*elf*.
+
+Sun Apr 30 21:38:09 1995 Jeff Law (law@snake.cs.utah.edu)
+
+ * config.sub: Accept -lites* as a basic system type.
+
+Thu Apr 27 11:33:29 1995 Michael Meissner (meissner@cygnus.com)
+
+ * config.guess (*:Linux:*:*): Check for whether the pre-BFD linker is
+ installed, and if so return linuxoldld as the system name.
+
+Wed Apr 26 10:59:02 1995 Jeff Law (law@snake.cs.utah.edu)
+
+ * config.guess: Add hppa1.1-hp-lites support.
+
+Tue Apr 25 11:08:11 1995 Rob Savoye <rob@darkstar.cygnus.com>
+
+ * configure.in: Don't build newlib for m68k-vxworks5.1.
+
+Wed Apr 19 17:02:43 1995 Jim Wilson <wilson@chestnut.cygnus.com>
+
+ * configure.in (mips-sgi-irix6): Use mh-irix5.
+
+Fri Apr 14 15:21:17 1995 Doug Evans <dje@chestnut.cygnus.com>
+
+ * Makefile.in (all-gcc): Depend on all-ld (for libgcc1-test).
+
+Wed Apr 12 16:06:01 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * test-build.mk: Enable building of shared libraries on IRIX 5 and
+ OSF/1. Fix compiler flags.
+ * build-all.mk: Support Linux and OSF/1 3.0. Fix compiler flags.
+
+Tue Apr 11 18:55:40 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * configure.in: Recognize --with-newlib.
+ (sparc-*-sunos4*): Build sim, dejagnu, expect, tcl if cross target.
+
+Mon Apr 10 14:38:20 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Makefile.in: move {all,check,install}-gdb from *_MODULES
+ to *_X11_MODULES due to gdbtk needing X include files et al.
+
+Mon Apr 10 11:42:22 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ Merge in support for Mac MPW as a host.
+ (Old change descriptions retained for informational value.)
+
+ * mpw-config.in: Add generic include forwards for cpu-specific
+ include files in aout and elf directories.
+
+ * mpw-configure: Added copyright.
+ * mpw-config.in: Check for presence of required build tools.
+ (target_libs): Add newlib.
+ (target_tools): Add examples.
+ (Read Me): Generate as "Read Me for MPW" instead.
+ * mpw-build.in: Base sub-builds on all-foo instead of do-foo.
+ (all-byacc, do-byacc, all-flex, do-flex, do-newlib): New actions.
+ (do-gas, do-gcc, do-gdb, do-ld): Build Version.r first.
+
+ * mpw-configure: Remove subdir-specific makefile hackery,
+ delete mk.tmp after using it.
+
+ * mpw-build.in (all): Display start and end times.
+
+ * mpw-configure (host_canonical): Set.
+ (target_cpu): Always add to makefiles.
+ (ARCHDEFS, EMUL): Add to makefile only if nonempty.
+ (TM_FILE, XM_FILE, NM_FILE): No longer add to makefile.
+ (mpw-mh-mpw): Look for in srcdir and srcroot.
+ Use sed instead of mpw-edit-prefix to edit prefix definitions.
+
+ * mpw-build.in: (install-only): New target.
+
+ * mpw-configure (host_alias, target_alias): Rename from hostalias
+ and targetalias, add into generated Makefile.
+ (mk.tmp): If present, add into generated Makefile.
+ * mpw-build.in (all-gas): Build config.h first before gas proper.
+
+ * mpw-configure (config.status): Write only if changed.
+ * mpw-config.in (readline): Configure it (not built, just used for
+ definitions).
+
+ * mpw-config.in (elf/mips.h): Add a forward include.
+
+ * mpw-config.in: Forward-include most .h files in include into
+ extra-include.
+ (readline): Don't build.
+ mpw-build.in (install): Install GDB.
+
+ * mpw-configure (prefix, mpw_prefix): Handle it.
+ * mpw-config.in (mmalloc, readline): Don't configure.
+ * mpw-build.in (thisscript): Rename to ThisScript.
+ Use mpw-build instead of BuildProgram everywhere.
+ (mmalloc, readline): Don't build.
+ * mpw-README: New file, basic documentation about the MPW port.
+
+ * mpw-config.in: Use forward-include to create include files.
+
+ * mpw-configure: Add more things to the top of each configured
+ Makefile, including contents of config/mpw-mh-mpw.
+ * mpw-config.in (extra-include): Create this directory and fill it
+ with Posix-like include files when configuring.
+
+ * config.sub (apple, mac, mpw): Add various aliases.
+
+ * mpw-build.in: New file, top-level build script fragment for MPW.
+ * mpw-configure: New file, configure script for MPW.
+ * mpw-config.in: New file, config fragment for MPW.
+
+Fri Apr 7 19:33:16 1995 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * configure.in (host_libs): Remove glob, since it is gone from the
+ sources.
+
+Fri Mar 31 11:36:17 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Makefile.in: define empty GDB_NLM_DEPS var.
+
+ * configure.in(target_makefile_frag): use config/mt-netware
+ for netware targets.
+
+Thu Mar 30 13:51:43 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.sub: Merge in recent FSF changes. Remove linux special
+ cases.
+
+Tue Mar 28 14:47:34 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ build-all.mk,config/mh-solaris: revert these two changes:
+
+ Tue Mar 30 10:03:09 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * build-all.mk: Use CC=cc -Xs on Solaris.
+
+ Mon Mar 29 19:59:26 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config/mh-solaris: SunPRO C needs -Xs to be able to get a
+ working xmakefile for Emacs.
+
+Tue Mar 21 10:43:32 1995 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * glob/*: Removed. Schauer's 24 Feb 1994 readline change made us
+ stop using it.
+ * Makefile.in: Nuke all references to glob subdirectory.
+
+Thu Mar 16 13:35:30 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * configure.in: Fix --enable-shared logic in per-host.
+
+Mon Mar 13 12:33:15 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in (*-hp-hpux[78]*): Use mh-hpux8.
+
+Mon Mar 6 10:21:58 1995 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * configure.in (noconfigdirs): Don't build gas on AIX, for
+ powerpc*-*-aix* as well as for rs6000*-*-aix*.
+
+Wed Mar 1 12:51:53 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: Fix --cache-file to work if the file argument is a
+ relative path.
+
+Tue Feb 28 17:36:07 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure: If the --cache-file is used, pass it down to
+ configure in subdirectories.
+
+Mon Feb 27 12:52:46 1995 Kung Hsu <kung@mexican.cygnus.com>
+
+ * config.sub: add vxworks29k configuration.
+
+Fri Feb 10 16:12:26 1995 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * Makefile.in (taz): Do "diststuff" part quietly.
+
+Sun Feb 5 14:16:35 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * config.sub: Mini-merge with gcc/config.sub.
+
+Sat Feb 4 12:11:35 1995 Jim Wilson <wilson@chestnut.cygnus.com>
+
+ * config.guess (IRIX): Sed - to _.
+
+Fri Feb 3 11:54:42 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * Makefile.in (source-vault, binary-vault): New targets.
+
+Thu Jan 26 13:00:11 1995 Michael Meissner <meissner@cygnus.com>
+
+ * config.sub: Recognize -eabi as a basic system type.
+
+Thu Jan 12 13:13:23 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * configure.in (enable_shared stuff): Fix typo.
+
+Thu Jan 12 01:36:51 1995 deanm@medulla.LABS.TEK.COM (Dean Messing)
+
+ * Makefile.in (BASE_FLAGS_TO_PASS): Fix typo in passing LIBCXXFLAGS*.
+
+Wed Jan 11 16:29:53 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (LIBCXXFLAGS_FOR_TARGET): Add -fno-implicit-templates.
+
+Mon Jan 9 12:48:01 1995 Jim Kingdon <kingdon@lioth.cygnus.com>
+
+ * configure.in (rs6000-*-*): Don't build gas.
+
+Wed Jan 4 23:53:49 1995 Ian Lance Taylor <ian@tweedledumb.cygnus.com>
+
+ * Makefile.in: Use /x/x/ instead of /brokensed/brokensed/, to
+ reduce command line length.
+ (AS_FOR_TARGET): Check for as.new, not Makefile.
+ (NM_FOR_TARGET): Check for nm.new, not Makefile.
+
+Wed Jan 4 13:02:39 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.guess: Merge from FSF.
+
+Thu Dec 15 17:11:37 1994 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * configure: Don't use $ when handling program_suffix.
+
+Mon Dec 12 12:09:37 1994 Stu Grossman (grossman@cygnus.com)
+
+ * configure.in: Configure tk for hppa/hpux.
+
+Fri Dec 2 15:55:38 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (LIBGXX_SUPPORT_DIRS): Add libstdc++.
+
+Tue Nov 29 19:37:56 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in: Move -fno-implicit-template from CXXFLAGS
+ to LIBCXXFLAGS. Tests are better run without it.
+
+Wed Nov 23 10:29:25 1994 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * Makefile.in (all-ispell): Depend on all-emacs19 instead of all-emacs.
+
+Mon Nov 21 11:14:01 1994 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * configure.in (*-*-netware*): Don't configure xiberty.
+
+Mon Nov 14 08:49:15 1994 Stu Grossman (grossman@cygnus.com)
+
+ * configure.in: Remove tk from native_only list.
+
+Fri Nov 11 15:31:26 1994 Bill Cox (bill@rtl.cygnus.com)
+
+ * build-all.mk: Add mips-ncd-elf target to sun4 targets
+ for special NCD build.
+
+Mon Nov 7 20:58:17 1994 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * Makefile.in (DEVO_SUPPORT): Remove configure.bat and
+ makeall.bat, they're only useful for binutils snapshots.
+ (binutils.tar.gz, gas+binutils.tar.gz): Add configure.bat and
+ makeall.bat to specified SUPPORT_FILES.
+
+Mon Nov 7 17:25:18 1994 Bill Cox (bill@cirdan.cygnus.com)
+
+ * build-all.mk: Add Ericsson targets to sun4 and solaris
+ hosts. Add BNR's sun4 target to solaris host, so their
+ build-from-source will be tested in-house first.
+
+Sat Nov 5 18:43:30 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * Makefile.in (LIBCFLAGS): New variable.
+ (CFLAGS_FOR_TARGET): Ditto.
+ (LIBCFLAGS_FOR_TARGET): Ditto.
+ (LIBCXXFLAGS): Ditto.
+ (CXXFLAGS_FOR_TARGET): Ditto.
+ (LIBCXXFLAGS_FOR_TARGET): Ditto.
+ (BASE_FLAGS_TO_PASS): Pass them.
+ (EXTRA_TARGET_FLAGS): Ditto.
+
+ * configure.in, config/m[th]-*pic: Support --enable-shared.
+
+Sat Nov 5 15:44:00 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in (target_libs): Include libstdc++ again.
+ * config.guess: Update from FSF (for FreeBSD).
+
+Thu Nov 3 16:32:30 1994 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * Makefile.in (DEVO_SUPPORT): Include configure.bat and
+ makeall.bat.
+ (DISTDOCDIRS): Add `etc'.
+ (ETC_SUPPORT_PFX): New variable.
+ (taz): Include anything from etc starting with a word in
+ ETC_SUPPORT_PFX.
+
+Wed Oct 26 16:19:35 1994 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * config.sub: Update for recent FSF changes. Remove obsolete
+ h8300hds entry. Add -windows* and -osx as basic os. Minor
+ spacing changes.
+
+Thu Oct 20 18:41:56 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in (target_libs): Remove libstdc++ for libg++-2.6.1.
+
+ * config.guess: Merge with FSF.
+ * configure.in: Match on i?86-ncr-sysv4.3, not i?86-ncr-sysv43.
+
+Thu Oct 20 19:26:56 1994 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * configure: Since the "trap 0" handler will override the exit
+ status on many systems, only use it for "exit 1", and make it set
+ a non-zero exit status; reset it before "exit 0". Also, check
+ exit status of config.sub, and error out if it failed.
+
+Wed Oct 19 18:49:55 1994 Rob Savoye (rob@cygnus.com)
+
+ * Makefile.in: (ALL_TARGET_MODULES,INSTALL_TARGET_MODULES) Build
+ and install libgloss.
+
+Tue Oct 18 15:25:24 1994 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * Makefile.in (all-binutils): Depend upon all-byacc.
+
+ * configure.in: Don't build emacs on Irix 5.
+
+Mon Oct 17 16:22:12 1994 J.T. Conklin (jtc@phishhead.cygnus.com)
+
+ * configure.in (*-*-netware*): Add libio.
+
+Thu Oct 13 15:51:20 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * Makefile.in (ALL_TARGET_MODULES): Add libstdc++.
+ (CHECK_TARGET_MODULES): Ditto.
+ (INSTALL_TARGET_MODULES): Ditto.
+ (TARGET_LIBS): Ditto.
+ (all-libstdc++): Note dependencies.
+
+Thu Oct 13 01:43:08 1994 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * Makefile.in (BINUTILS_SUPPORT_DIRS): Add gas.
+
+Tue Oct 11 12:12:29 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * Makefile.in (CXXFLAGS): Use -fno-implicit-templates instead of
+ -fexternal-templates.
+
+ * configure.in (target_libs): Add libstdc++.
+ (noconfigdirs): Add libstdc++ as appropriate.
+
+Thu Oct 6 18:00:54 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess: Update from FSF.
+
+Tue Oct 4 12:05:42 1994 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * configure: Use ${config_shell} when running ${configsub}.
+
+Mon Oct 3 14:28:34 1994 Doug Evans <dje@canuck.cygnus.com>
+
+ * config.sub: No longer recognize h8300h.
+
+Mon Oct 3 12:40:54 1994 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * config.sub: Remove extraneous differences between config.sub and
+ gcc/config.sub.
+
+Sat Oct 1 00:23:12 1994 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * Makefile.in (DISTSTUFFDIRS): Add gas.
+
+Thu Sep 22 19:04:55 1994 Doug Evans (dje@canuck.cygnus.com)
+
+ * COPYING.NEWLIB: New file.
+
+Mon Sep 19 18:25:40 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess (HP-UX): Patch from Harlan Stenn
+ <harlan@landmark.com> to also emit release level.
+
+Wed Sep 7 13:15:25 1994 Jim Wilson (wilson@sphagnum.cygnus.com)
+
+ * config.guess (sun4*:SunOS:*:*): Change '-JL' to '_JL'.
+
+Tue Sep 6 23:23:18 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.sub: Merge nextstep cleanup from FSF.
+
+Mon Sep 5 05:01:30 1994 Ken Raeburn (raeburn@kr-pc.cygnus.com)
+
+ * configure.in (arm-*-*): Don't configure ld for this target.
+
+Thu Sep 1 09:35:00 1994 J.T. Conklin (jtc@phishhead.cygnus.com)
+
+ * configure.in (*-*-netware): don't configure libg++, libio,
+ librx, or newlib.
+
+Wed Aug 31 13:52:08 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * configure.in (alpha-dec-osf*): Use osf*, not osf1*. Don't
+ configure ld--it works, but it doesn't support shared libraries.
+
+Sun Aug 28 18:13:45 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess (*-unknown-freebsd*): Get rid of possible
+ trailing "(Release)" in version string.
+ Patch from Paul Richards <paul@isl.cf.ac.uk>.
+
+Sat Aug 27 15:00:49 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess: Fix i486-ncr-sysv43 -> i486-ncr-sysv4.3.
+ Fix type: *-next-neststep -> *-next-nextstep.
+
+ * config.guess: Merge from FSF:
+
+ Fri Aug 26 18:45:25 1994 Philippe De Muyter (phdm@info.ucl.ac.be)
+
+ * config.guess: Recognize powerpc-ibm-aix3.2.5.
+
+ Wed Apr 20 06:36:32 1994 Philippe De Muyter (phdm@info.ucl.ac.be)
+
+ * config.guess: Recognize UnixWare 1.1 (UNAME_SYSTEM is SYSTEM_V
+ instead of UNIX_SV for UnixWare 1.0).
+
+Sat Aug 27 01:56:30 1994 Stu Grossman (grossman@cygnus.com)
+
+ * Makefile.in (all-gdb): Add dependencies on all-gcc and all-ld
+ to make gdb/nlm/* build after the compiler and linker.
+
+Fri Aug 26 14:30:05 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess (netbsd, freebsd, linux): Accept any machine,
+ not just i[34]86.
+ (m68k-atari-sysv4): Relocate to match FSF version.
+
+ * config.guess: More merges from the FSF:
+
+ Add a space before function call or macro invocation.
+
+ Tue May 10 16:53:55 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
+
+ * config.guess: Add trap cmd to remove dummy.c and dummy when
+ interrupted.
+
+ Wed Apr 20 18:07:13 1994 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
+
+ * config.guess (dummy.c): Redirect stderr for `hostinfo' command.
+ (dummy): Redirect stderr from compilation of dummy.c.
+
+ Sat Apr 9 14:59:28 1994 Christian Kranz (kranz@sent5.uni-duisburg.de)
+
+ * config.guess: Distinguish between NeXTStep 2.1 and 3.x.
+
+Fri Aug 26 13:42:20 1994 Ken Raeburn (raeburn@kr-laptop.cygnus.com)
+
+ * configure: Accept and ignore --cache*, for compatibility with
+ new autoconf.
+
+Fri Aug 26 13:05:27 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess: Merge from FSF:
+
+ Thu Aug 25 20:28:51 1994 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * config.guess (Pyramid*:OSx*:*:*): New case.
+ (PATH): Add /.attbin at end for finding uname.
+ (dummy.c): Handle i860-alliant-bsd. Follow whitespace conventions.
+
+ Wed Aug 17 18:21:02 1994 Tor Egge (tegge@pvv.unit.no)
+
+ * config.guess (M88*:DolphinOS:*:*): New case.
+
+ Thu Aug 11 17:00:13 1994 Stan Cox (coxs@dg-rtp.dg.com)
+
+ * config.guess (AViiON:dgux:*:*): Use TARGET_BINARY_INTERFACE
+ to select whether to use ELF or COFF.
+
+ Sun Jul 24 16:20:53 1994 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * config.guess: Recognize i860-stardent-sysv and i860-unknown-sysv.
+
+ Sun May 1 10:23:10 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu)
+
+ * config.guess: Guess the OS version for HPUX.
+
+ Tue Mar 1 21:53:03 1994 Karl Heuer (kwzh@hal.gnu.ai.mit.edu)
+
+ * config.guess (UNAME_VERSION): Recognize aix3.2.4 and aix3.2.5.
+
+Fri Aug 26 11:19:08 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * configure.in: Recognize --with-headers, --with-libs, and
+ --without-newlib.
+ * Makefile.in (all-xiberty): Depend upon all-ld.
+
+Wed Aug 24 12:36:50 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * configure.in: Change i[34]86 to i[345]86.
+
+Mon Aug 22 10:58:33 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * configure (version): A few more tweaks to help message.
+
+Fri Aug 19 12:40:25 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in: Remove (for now) librx as a host library,
+ now that we're building it for target.
+
+Fri Aug 19 10:49:17 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * configure: Fix up help message; from karl@owl.hq.ileaf.com
+ (Karl Berry).
+
+Tue Aug 16 16:11:08 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * configure.in: Also configure librx.
+
+Mon Aug 15 16:51:45 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in: Update various rules to reflect that librx
+ is now needed for libg++.
+
+Fri Aug 12 18:07:21 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * config.sub: Accept mips64orion and mips64orionel as a CPU name.
+
+Mon Aug 8 11:36:17 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * configure.in: Configure the examples directory.
+
+Thu Aug 4 16:12:36 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * configure: Simplify Jun 2 1994 change.
+
+Wed Aug 3 04:58:16 1994 D. V. Henkel-Wallace (gumby@cygnus.com)
+
+ * change CC to /usr/latest/bin/gcc for lynx host builds, since
+ /bin/gcc isn't good enough to build gcc.
+
+Wed Jul 27 09:07:14 1994 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in (GDB_SUPPORT_FILES): Remove
+ (setup-dirs-gdb, gdb.tar.gz, make-gdb.tar.gz): Remove old rules.
+ (gdb.tar.gz): Add new rule to use standard distribution building
+ mechanism.
+
+Mon Jul 25 11:10:06 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure.in: Warn about use of /usr/ucb/cc on Solaris. From
+ Bill Cox <bill@cygnus.com>.
+
+Sat Jul 23 12:19:46 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess: Recognize ISC. Patch from kwzh@gnu.ai.mit.edu.
+
+Fri Jul 22 17:53:59 1994 Stu Grossman (grossman@cygnus.com)
+
+ * configure: Search current dir first in .gdbinit.
+
+Fri Jul 22 11:28:30 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.sub: Recognize freebsd (merged from gcc config.sub).
+
+Thu Jul 21 14:10:52 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.sub: Refer to NeXT's operating system as nextstep.
+
+ * config.sub (case $basic_machine): Re-order the cases, to match
+ the order in the FSF version (which is mostly alphabethical).
+ Merge in some additions and changes from the FSF.
+
+Sat Jul 16 12:03:08 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * config.guess: Recognize m68k-atari-sysv4 and m88k-harris-csux7.
+ * config.sub: Recognize cxux7.
+ * configure.in: Use mh-cxux for m88k-harris-cxux*.
+
+Mon Jul 11 14:37:39 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.sub: Fix typo powerpc -> powerpc-*.
+
+Sat Jul 9 13:03:43 1994 Michael Tiemann (tiemann@blues.cygnus.com)
+
+ * Makefile.in: `all-emacs19' depends on `all-byacc'.
+
+ * Makefile.in: Add all-emacs19 and install-emacs19 rules (in
+ parallel with all-emacs and install-emacs). Top-level command
+ `make all-emacs19 CC=gcc' now behaves as `make all-emacs CC=gcc'.
+
+Thu Jun 30 16:53:42 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * test-build.mk ($(host)-stamp-stage2-installed): Remove
+ $(relbindir)/make before doing ``make install'', and use
+ $(GNU_MAKE) while doing it. Avoids problem on SunOS with
+ installing over running make binary.
+ ($(host)-stamp-stage3-installed): Likewise.
+
+Tue Jun 28 13:43:25 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Recognize Mach.
+
+Mon Jun 27 16:41:14 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * configure: Check ${exec_prefixoption}, not ${exec_prefix}, to
+ see whether --exec-prefix was used.
+
+Sun Jun 26 21:15:54 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * README: Explicitly mention libg++/README. (Zoo's idea.)
+
+Tue Jun 21 12:45:55 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in: Add all-librx target similar to all-libproc.
+
+Wed Jun 8 23:11:55 1994 Stu Grossman (grossman@cygnus.com)
+
+ * config.guess: Rearrange tests for Alpha-OSF1 to properly deal
+ with post 1.2 uname bogosity.
+
+Thu Jun 9 00:27:59 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure: Remove temporary files on receipt of a signal.
+
+Tue Jun 7 12:06:24 1994 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure: If there is a package_makefile_frag, remove
+ ${subdir}/Makefile.tem after copying it in.
+
+Mon Jun 6 21:35:02 1994 D. V. Henkel-Wallace (gumby@cygnus.com)
+
+ * build_all.mk: support rs6000 lynx identifies itself as
+ rs6000-lynx-lynxos2.2.2. Also, use /usr/cygnus/progressive/bin/gcc
+ since /bin/gcc is too feeble to compile a modern gcc.
+
+Mon Jun 6 16:06:34 1994 Karen Christiansen (karen@cirdan.cygnus.com)
+
+ * brought devo/test-build.mk update-to-date with progressive/
+ test-build.mk. Add lynx targets and hppa flag info.
+
+Sat Jun 4 17:23:54 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * configure.in: Use mh-ncrsvr43. Patch from
+ Tom McConnell <tmcconne@sedona.intel.com>.
+
+Fri Jun 3 17:47:24 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess (i386-unknown-bsdi): No longer need to
+ check #if defined(__bsdi__) && defined(__i386__).
+
+Thu Jun 2 18:56:46 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure: Set program_transform_nameoption correctly.
+
+Thu Jun 2 10:57:06 1994 Karen Christiansen (karen@cirdan.cygnus.com)
+
+ * brought build-all.mk update-to-date with progressive build-all.mk,
+ added new targets and hppa info.
+
+Thu Jun 2 00:12:44 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure: If config.guess result is a prefix of the user
+ specified target, assume a native build and use the user specified
+ target as the host alias. Remove SunOS patch suffix removal hack.
+ * configure.in: Remove SunOS patch suffix removal hack.
+
+ * Makefile.in (CROSS_CHECK_MODULES): Remove check-flex, since it's
+ in NATIVE_CHECK_MODULES.
+
+Wed Jun 1 10:49:41 1994 Bill Cox (bill@rtl.cygnus.com)
+
+ * Makefile.in: Rename HOST_ONLY to NATIVE.
+ * configure: Delete SunOs patch suffix from host_canonical
+ and build_canonical variables that are prepended to Makefiles.
+ * configure.in: Add comments for easier maintenance.
+
+Tue May 31 19:39:47 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in: Add all-libproc target similar to all-gui.
+
+Tue May 31 17:16:33 1994 Tom Lord (lord@cygnus.com)
+
+ * Makefile.in (CHECK_MODULES): split into
+ HOST_ONLY_CHECK_MODULES and CROSS_CHECK_MODULES.
+
+Tue May 31 16:36:36 1994 Paul Eggert (eggert@twinsun.com)
+
+ * config.guess (i386-unknown-bsdi): New system to guess.
+
+Wed May 25 16:47:10 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in: Add all-gui target (but not yet build by "all").
+
+Thu May 26 08:53:19 1994 Bill Cox (bill@rtl.cygnus.com)
+
+ * config.sub: Move deletion of patch suffix from here...
+ * configure.in: To here, at Ian's suggestion. The top-
+ level scripts might need to know of a patch level.
+
+Wed May 25 09:15:54 1994 Bill Cox (bill@rtl.cygnus.com)
+
+ * config.sub: Strip off patch suffix so rtl is recognized
+ as a sunos4.1.3 machine, even though it's been patched.
+
+Fri May 20 08:25:49 1994 Steve Chamberlain (sac@deneb.cygnus.com)
+
+ * Makefile.in (INSTALL_LAST): Delete.
+ (INSTALL_DOSREL): New.
+
+Thu May 19 17:12:12 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure.in: Use ld for i[34]86-*-sysv4* and sparc-*-solaris2*.
+ Don't set use_gnu_ld to no for *-*-sysv4; that only controls
+ whether we pass down --with-gnu-ld anyhow.
+
+Thu May 19 09:29:12 1994 Steve Chamberlain (sac@cygnus.com)
+
+ * Makefile.in (INSTALL_LAST): Change operation so it works
+ on more flavors of make.
+ * configure.in (go32): Don't build libg++ or libio.
+
+Fri May 13 13:28:34 1994 Steve Chamberlain (sac@cygnus.com)
+
+ * Makefile.in (Move HOST_PREFIX_1 and friends up so
+ they can be overriden by templates.
+
+Sat May 7 16:46:44 1994 Steve Chamberlain (sac@cygnus.com)
+
+ * configure.in (target==go32): Don't build gdb.
+ * dosrel: New directory.
+
+Fri May 6 14:19:25 1994 Steve Chamberlain (sac@cygnus.com)
+
+ * configure.in (host==go32): Configure dosrel too.
+ * Makefile.in (INTALL_TARGET): Call INSTALL_LAST last.
+ (HOST_CC, HOST_PREFIX, HOST_PREFIX_1): Undefine, they should
+ be set by incoming names or templates.
+ (INSTALL_LAST): New rule.
+ * config/mh-go32: New fragment.
+
+Thu May 5 17:35:05 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * config.sub (sparclitefrw, sparclitefrwcompat): Don't set the os.
+
+Thu May 5 20:06:45 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ * config/mh-lynxrs6k: Renamed from mh-lynxosrs6k, to make it
+ unique in 8.3 naming schemes.
+ * configure.in (appdirs): New variable. Currently empty, but will
+ be used in gas distribution. If nonempty, lists a set of
+ directories at least one of which must get configured, or top
+ level configuration is considered to have failed.
+ (rs6000-*-lynxos*): Use new file name.
+
+Thu May 5 13:38:36 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ Eliminate XTRAFLAGS.
+ * Makefile.in (CC_FOR_TARGET): If newlib exists, refer to the
+ newlib include files using -idirafter, and also use -nostdinc.
+ (CXX_FOR_TARGET): Likewise.
+ (XTRAFLAGS): Removed.
+ (BASE_FLAGS_TO_PASS): Remove XTRAFLAGS_FOR_TARGET.
+ (EXTRA_HOST_FLAGS): Remove XTRAFLAGS.
+ (EXTRA_TARGET_FLAGS, EXTRA_GCC_FLAGS): Likewise.
+ ($(DO_X)): Don't pass down XTRAFLAGS.
+
+Thu May 5 00:16:36 1994 Ken Raeburn (raeburn@kr-pc.cygnus.com)
+
+ * configure.in (mips*-dec-bsd*): New target; do build linker.
+ (mips*-*-bsd*): New target; don't build linker.
+
+Wed May 4 20:10:10 1994 D. V. Henkel-Wallace (gumby@cygnus.com)
+
+ * configure.in: support rs6000-*-lynxos* configuration.
+ support sunos4 as a cross target.
+
+ * config.sub: look for lynx*, not lynx since the OS version may
+ legitimately be part of the name.
+
+Tue May 3 21:48:11 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ * configure.in (i[34]86-*-sco*): Move to be with other i386
+ targets.
+ (romp-*-*): New target. Skip various binary utilities.
+ (vax-*-*): New target. Don't build newlib.
+ (vax-*-vms): Renamed from *-*-vms. Don't build opcodes or newlib.
+
+Thu Apr 28 15:03:05 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * configure.in: Only set host_makefile_frag if config
+ directory exists.
+
+Wed Apr 27 12:14:30 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * install.sh: If $dstdir exists, don't check whether each
+ component does.
+
+Tue Apr 26 18:11:33 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * test-build.mk (HOLES): Add sleep; used by rcs/src/conf.sh.
+
+Mon Apr 25 15:06:34 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * configure.in (*-*-lynxos*): Don't configure newlib for either
+ native or cross Lynx.
+
+Sat Apr 16 11:58:16 1994 Doug Evans (dje@canuck.cygnus.com)
+
+ * config.sub (sparc64-elf): Fix os.
+ (z8k): Remove duplicate.
+
+Thu Apr 14 23:33:17 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * Makefile.in (gcc-no-fixedincludes): Touch gcc/include/fixed, not
+ gcc/stmp-fixproto, to try to prevent fixproto from being run.
+
+Wed Apr 13 15:14:52 1994 Bill Cox (bill@cygnus.com)
+
+ * configure: Make file links cleanly even if Lynx fails on
+ an NFS symlink (at least fail cleanly).
+
+Mon Apr 11 10:58:56 1994 Jim Wilson (wilson@sphagnum.cygnus.com)
+
+ * test-build.mk (CC): For mips-sgi-irix4, change -XNh1500 to
+ -XNh2000.
+
+Sat Apr 9 15:10:45 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * configure: Unknown options are fatal again.
+
+Fri Apr 8 12:01:41 1994 David J. Mackenzie (djm@cygnus.com)
+
+ * configure: Ignore --x-includes and --x-libraries, for Autoconf
+ compatibility.
+
+Thu Apr 7 17:31:43 1994 Doug Evans (dje@canuck.cygnus.com)
+
+ * build-all.mk: Add `clean' target.
+
+Wed Apr 6 20:44:56 1994 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * config.guess: Add SINIX support.
+ * configure.in: Add mips-*-sysv4* support.
+
+Mon Apr 4 17:41:44 1994 Doug Evans (dje@canuck.cygnus.com)
+
+ * build-all.mk: Document all useful targets.
+ If canonhost is sparc-sun-solaris2.3, change it to sparc-sun-solaris2.
+ If canonhost is mips-sgi-irix4.0.5H, change it to mips-sgi-irix4.
+
+Thu Mar 31 04:55:57 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * configure: Support --silent, --quiet.
+
+Wed Mar 30 21:37:38 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * configure: Support --disable-FEATURE.
+
+Tue Mar 29 19:15:05 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Recognize NCR running SVR4.3.
+
+Mon Mar 28 14:55:15 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess: Make BSDI generate i386-unknown-bsd386.
+ Patch from Paul Eggert <eggert@twinsun.com>.
+
+Mon Mar 28 12:54:52 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure.in (powerpc-*-aix*): Treat like rs6000-*-*.
+
+Sat Mar 26 11:25:48 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * configure: Make unrecognized options give nonfatal warnings
+ instead of fatal errors, and pass them to any subdirectory
+ configures in case they recognize them.
+ Make --x equivalent to --with-x.
+
+Fri Mar 25 21:52:10 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * configure: Add --enable-* options. Clean up usage message and
+ some comments.
+
+Thu Mar 24 09:12:53 1994 Doug Evans (dje@canuck.cygnus.com)
+
+ * Makefile.in (NM_FOR_TARGET): Build tree version is now nm.new.
+
+Sun Mar 20 11:28:22 1994 Jeffrey A. Law (law@snake.cs.utah.edu)
+
+ * configure.in (hppa*-*-*): Enable binutils.
+
+Sat Mar 19 11:50:16 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.sub: Recognize cisco.
+
+Fri Mar 18 16:42:32 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * Makefile.in (CXXFLAGS): Add -fexternal-templates.
+
+Tue Mar 15 11:25:55 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: about target *-hitachi-hiuxwe2, don't print more
+ than one configuration name. Add comment.
+
+Sun Mar 6 23:13:38 1994 Hisashi MINAMINO (minamino@sra.co.jp)
+
+ * config.guess: about target *-hitachi-hiuxwe2, fixed
+ machine guessing order. [Hitachi's CPU_IS_HP_MC68K
+ macro is incorrect.]
+
+Sun Mar 13 09:10:08 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in (TAGS): Just build TAGS in each subdirectory, rather
+ than the "make ls" stuff which used to be here.
+
+Fri Mar 11 12:52:39 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess: Recognize i[34]86-unknown-freebsd.
+ From Shawn M Carey <smcarey@rodan.syr.edu>.
+
+Thu Mar 3 14:24:21 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * configure.in (noconfigdirs for alpha): Remove libg++ and libio.
+
+Wed Mar 2 13:28:48 1994 Jim Kingdon (kingdon@deneb.cygnus.com)
+
+ * config.guess: Check for ptx.
+
+Mon Feb 28 16:46:50 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * config.sub: Add os9k checking.
+
+Thu Feb 24 07:09:04 1994 Jeffrey A. Law (law@snake.cs.utah.edu)
+
+ * config.guess: Handle OSF1 running on HPPA processors
+
+Fri Feb 18 14:14:00 1994 Ken Raeburn (raeburn@rtl.cygnus.com)
+
+ * configure: If subdir configure fails, print out a message with
+ subdirectory name, in case subdir's configure code didn't identify
+ itself.
+
+Fri Feb 18 12:50:15 1994 Doug Evans (dje@cygnus.com)
+
+ * configure.in: Remove embedded newlines from configdirs.
+ Avoid mismatches of substrings. Fix matching strings at end
+ of configdirs.
+
+Fri Feb 11 15:33:33 1994 Stu Grossman (grossman at cygnus.com)
+
+ * config.guess: Add Lynx/rs6000 config support.
+
+Tue Feb 8 13:41:09 1994 Ken Raeburn (raeburn@rtl.cygnus.com)
+
+ * configure.in (alpha-dec-osf1*, alpha*-*-*): Build gas.
+
+Mon Feb 7 15:42:36 1994 Jeffrey A. Law (law@cygnus.com)
+
+ * configure.in (hppa*-*-osf*): Treat this just like most other
+ PA configurations (eg no binutils or ld).
+ (hppa*-*-*elf*): These configurations have binutils and ld.
+
+Sun Feb 6 16:35:07 1994 Jeffrey A. Law (law@snake.cs.utah.edu)
+
+ * config.sub (hiux): Fix typo. From m-kasahr@sramhc.sra.co.JP.
+
+Sat Feb 5 01:00:33 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure.in (rs6000-*-*): Build gas.
+
+Wed Feb 2 13:57:57 1994 Jeffrey A. Law (law@snake.cs.utah.edu)
+
+ * Makefile.in: Avoid bug in losing hpux sed.
+
+Wed Feb 2 14:53:05 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in, test-build.mk: Remove MUNCH_NM; it was only needed
+ for GDB and GDB has been fixed to not need it.
+
+Mon Jan 31 18:40:55 1994 Stu Grossman (grossman at cygnus.com)
+
+ * config/mh-lynxosrs6k: Account for lack of ranlib!
+
+Sun Jan 30 17:58:06 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ * config.guess: Recognize vax hosts.
+
+Fri Jan 28 15:29:38 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ * configure (while loop): Don't use "break 2" inside case
+ statement -- the case statement isn't an enclosing loop.
+
+Mon Jan 24 18:40:06 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess: Clean up NeXT support, to allow nextstep
+ on Intel machines. Make OS be nextstep.
+
+Sun Jan 23 18:47:22 1994 Richard Kenner (kenner@vlsi1.ultra.nyu.edu)
+
+ * config.guess: Add alternate forms for Convex.
+
+Thu Jan 20 16:13:41 1994 Stu Grossman (grossman at cygnus.com)
+
+ * configure: Completely rewrite option processing. Take
+ advantage of pattern-matching to avoid invoking test frequently.
+ Also clean up host and target defaulting logic.
+
+Mon Jan 17 15:06:56 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ * Makefile.in: Replace all occurrances of "rootme" with "r" and
+ "$${rootme}" with "$$r", to increase the likelihood that the do-*
+ commands (plus user environment) will fit SCO limits.
+
+Thu Jan 6 11:20:57 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure.in: Don't issue warnings about directories which are
+ not being configured if -norecursion is set. Correct test for
+ --with-gnu-as and --with-gnu-ld to not get confused by substring
+ matches.
+
+ * configure.in: Don't build gas for alpha-dec-osf1*.
+
+Tue Jan 4 17:10:19 1994 Stu Grossman (grossman at cygnus.com)
+
+ * configure: Back out Per's change of 12/19/1993. It changes the
+ behavior of configure in unexpected and confusing ways.
+
+ Also, use different delim char when calculating
+ program_transform_name so that the name can contain slashes.
+
+Sat Jan 1 13:45:31 1994 Rob Savoye (rob@darkstar.cygnus.com)
+
+ * configure.in, config.sub: Add support for VSTa micro-kernel.
+
+Sat Dec 25 20:00:47 1993 Jeffrey A. Law (law@snake.cs.utah.edu)
+
+ * configure.in: Nuke hacks which were used to get a special
+ version of GAS for HPPA configurations.
+
+Sun Dec 19 20:40:44 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * configure: If only ${target_alias} is given, use that
+ as the default for ${host_alias}.
+ * configure: Add missing back-slashes before nested quotes.
+
+Wed Dec 15 18:07:18 1993 david d `zoo' zuhn (zoo@andros.cygnus.com)
+
+ * Makefile.in (BASE_FLAGS_TO_PASS): add YACC=$(BISON)
+
+Tue Dec 14 21:25:33 1993 Per Bothner (bothner@cygnus.com)
+
+ * config.guess: Recognize some Tektronix configurations.
+ From Kaveh R. Ghazi <ghazi@noc.rutgers.edu>.
+
+Sat Dec 11 11:18:00 1993 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * config.sub: Match any flavor of SH.
+
+Thu Dec 2 17:16:58 1993 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ * configure.in: Don't try to configure newlib for Alpha.
+
+Thu Dec 2 14:35:54 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure.in: Don't build ld for Irix 5. Don't build gas,
+ libg++ or libio for any Alpha target.
+
+ * configure.in (mips*-sgi-irix5*): New target; use mh-irix5.
+ * config/mh-irix5. New file for Irix 5.
+
+Wed Dec 1 17:00:33 1993 Jason Merrill (jason@deneb.cygnus.com)
+
+ * Makefile.in (GZIPPROG): Renamed from GZIP, which gzip uses for
+ default arguments -- so it tried to compress itself.
+
+Tue Nov 30 13:45:15 1993 david d `zoo' zuhn (zoo@andros.cygnus.com)
+
+ * configure.in (notsupp): ensure that a space is always at the end
+ of the configdirs list, since the grep checks for an explicit space
+
+Tue Nov 16 15:04:27 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in (target i386-sysv4.2): don't build ld, since static
+ versions of many libraries are not available.
+
+Tue Nov 16 14:28:12 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Recognize Apollos (using environment variables).
+ * configure.in: Don't configure ld, binutils, or gprof for Apollo.
+
+Thu Nov 11 12:03:50 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Recognize Sony news mips running newsos.
+
+Wed Nov 10 16:57:00 1993 Mark Eichin (eichin@cygnus.com)
+
+ * Makefile.in (all-cygnus, build-cygnus): "fi else" needs to be
+ "fi ; else" for bash.
+
+Tue Nov 9 15:54:01 1993 Mark Eichin (eichin@cygnus.com)
+
+ * Makefile.in (BASE_FLAGS_TO_PASS): pass SHELL.
+
+Fri Nov 5 08:07:27 1993 D. V. Henkel-Wallace (gumby@blues.cygnus.com)
+
+ * config.sub: accept unixware as an alias for svr4.2.
+ Fix some inconsistancies with the gcc version.
+
+Fri Nov 5 15:14:12 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in (DISTDOCDIRS): Add gdb.
+
+Fri Nov 5 11:59:42 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (DISTDOCDIRS): Add libg++ and libio.
+
+Fri Nov 5 10:35:05 1993 Ken Raeburn (raeburn@rover.cygnus.com)
+
+ * Makefile.in (taz): Only build "info" in DISTDOCDIRS.
+ (DISTDOCDIRS): Don't assume libg++ and gdb folks necessarily want
+ this now.
+
+Thu Nov 4 18:58:23 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.sub: Accept hiux* as an OS name.
+
+ * Makefile.in: Change RUNTEST_FLAGS back to RUNTESTFLAGS per
+ etc/make-stds.texi. The underscore came from gcc, and dje now
+ agrees that RUNTESTFLAGS is the correct name.
+
+Thu Nov 4 10:49:01 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * install.sh: Remove 'set -e'. It makes any conditionals
+ in the script useless.
+
+ * config.guess: Automatically recognize arm-acorn-riscix
+ Patch from Richard Earnshaw (rwe11@cl.cam.ac.uk).
+
+Thu Nov 04 08:08:04 1993 Jeffrey Wheat (cassidy@cygnus.com)
+
+ * Makefile.in: Change RUNTESTFLAGS to RUNTEST_FLAGS
+
+Wed Nov 3 22:09:46 1993 Ken Raeburn (raeburn@rtl.cygnus.com)
+
+ * Makefile.in (DISTDOCDIRS): New variable.
+ (taz): Edit local Makefile.in sooner, instead of proto-toplev
+ Makefile.in later. Build "info" and "dvi" in DISTDOCDIRS.
+
+Wed Nov 3 21:31:52 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in (hppa target): check the source directory for the
+ pagas sub-directory
+
+Wed Nov 3 11:12:22 1993 Doug Evans (dje@canuck.cygnus.com)
+
+ * config.sub: Allow -aout* and -elf*.
+
+Wed Nov 3 11:08:33 1993 Ken Raeburn (raeburn@rtl.cygnus.com)
+
+ * configure.in: Don't build ld on i386-solaris2, same as for
+ sparc-solaris2.
+
+Tue Nov 2 14:21:25 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (taz): Add texinfo/lgpl.texinfo (for libg++).
+
+Tue Nov 2 13:38:30 1993 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * configure.in: Configure gdb for alpha.
+
+Mon Nov 1 10:42:54 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in (CXXFLAGS): Add -O.
+
+Wed Oct 27 10:45:06 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * config.guess: added support for DG Aviion
+
+Tue Oct 26 14:37:37 1993 Ken Raeburn (raeburn@rover.cygnus.com)
+
+ * configure.in: Produce warning message for subdirectories not
+ configurable for this host/target combination. Don't try to
+ configure gdb for vms.
+
+Mon Oct 25 11:22:15 1993 Ken Raeburn (raeburn@rover.cygnus.com)
+
+ * Makefile.in (taz): Replace "byacc" with "bison -y" in the
+ appropriate files before making "diststuff".
+ (DISTBISONFILES): New var: list of files to be edited.
+ (DISTSTUFFDIRS): Add binutils.
+
+Fri Oct 22 20:32:15 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * config.sub: also handle mipsel and mips64el (for little endian mips)
+
+Fri Oct 22 07:59:20 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * configure.in: Add * to end of all OS names.
+
+Thu Oct 21 11:38:28 1993 Stan Shebs (shebs@rtl.cygnus.com)
+
+ * configure.in: Build newlib for LynxOS native.
+
+Wed Oct 20 09:56:12 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Add support for delta 88k running SVR3.
+
+ * configure.in: Add comment about HP compiler vs. emacs.
+
+Tue Oct 19 16:02:22 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in: don't build ld on solaris2 (not a viable option
+ due to bugs in getpwnam & getpwuid)
+
+Tue Oct 19 15:13:56 1993 Ken Raeburn (raeburn@rtl.cygnus.com)
+
+ * configure.in: Accept alpha-dec-osf1*, not just -osf1, since
+ config.guess will produce a full version number.
+
+Tue Oct 19 15:58:01 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure.in: Build linker and binutils for alpha-dec-osf1.
+
+Tue Oct 19 11:41:55 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in: Remove -O from CXXFLAGS for consistency with CFLAGS,
+ and gdb/testsuite/Makefile.in.
+
+Sat Oct 9 18:39:07 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in: recognize mips*- instead of mips-
+
+Fri Oct 8 14:15:39 1993 Ken Raeburn (raeburn@cygnus.com)
+
+ * config.sub: Accept linux*coff and linux*elf as operating
+ systems.
+
+Thu Oct 7 12:57:19 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * config.sub: Recognize mips64, and mips3 as an alias for it.
+
+Wed Oct 6 13:54:21 1993 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * configure.in: Remove alpha-dec-osf*, no longer necessary now that
+ gdb knows how to handle OSF/1 shared libraries.
+
+Tue Oct 5 11:55:04 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * configure.in: Recognize hppa*-*-hiux* (currently synonym for hpux).
+ * config.guess: Recognize Hitachi's HIUX.
+ * config.sub: Recognize h3050r* and hppahitachi.
+ Remove redundant cases for hp9k[23]*.
+
+Mon Oct 4 16:15:09 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in: default to '--with-gnu-as' and '--with-gnu-ld'
+ if gas and ld are in the source tree and are in ${configdirs}.
+ If ${use_gnu_as} or ${use_gnu_ld} are 'no', then don't set the
+ the --with options (but still pass them down on the command line,
+ if they were explicitly specified).
+
+Fri Sep 24 19:11:13 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure: substitute SHELL value in Makefile.in with
+ ${CONFIG_SHELL}
+
+Thu Sep 23 18:05:13 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * configure.in: Build gas, ld, and binutils for *-*-sysv4* and
+ *-*-solaris2* targets.
+
+Sun Sep 19 17:01:41 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * Makefile.in: define M4, and pass it down to sub-makes;
+ all-autoconf now depends on all-m4
+
+Sat Sep 18 00:38:23 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * Makefile.in ({AR,RANLIB}_FOR_TARGET): make contingent on
+ presence of {ar,ranlib} instead of a configured directory
+
+Wed Sep 15 08:41:44 1993 Jim Kingdon (kingdon@cirdan.cygnus.com)
+
+ * config.guess: Accept 34?? as well as 33?? for NCR.
+
+Mon Sep 13 12:28:43 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in: grab mt-hppa for HPPA targets; use 'gas ' instead
+ of 'gas' in sed commands, since 'gash' is now in the tree as well.
+
+Fri Sep 10 11:23:52 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure: grab values for $(CC) and $(CXX) from the
+ environment, so that someone can do "CC=gcc configure; make" and
+ have it work right (matching the way that autoconf works now)
+
+ * configure.in, Makefile.in: add support for gash, the tcl
+ interface to Galaxy
+
+ * config.guess: add NetBSD variants (hp300, x86)
+
+Thu Sep 9 16:48:52 1993 Jason Merrill (jason@deneb.cygnus.com)
+
+ * install.sh: Support -d option (in the manner of SunOS 4 install,
+ as it is more deterministic than that of GNU install)
+ (chmodcmd): Set file to mode 755 by default (should also do default
+ chgrp and chown, but I don't feel like dealing with that now)
+
+Tue Sep 7 11:59:39 1993 Doug Evans (dje@canuck.cygnus.com)
+
+ * config.sub: Remove h8300hhms alias.
+
+Tue Aug 31 11:00:09 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * configure.in: Match *-*-solaris2* not *-sun-solaris2*.
+
+Mon Aug 30 18:29:10 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * Makefile.in (gcc-no-fixedincludes): touch stmp-fixproto as well
+ as stmp-fixinc
+
+Wed Aug 25 16:35:59 1993 K. Richard Pixley (rich@sendai.cygnus.com)
+
+ * config.sub: recognize m88110-bug-coff.
+
+Tue Aug 24 10:23:24 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * Makefile.in (all-libio): all dependencies on the toolchain used
+ to build this (gcc, gas, ld, etc)
+
+Fri Aug 20 17:24:24 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Deal with OSF/1 1.3 on alpha.
+
+Thu Aug 19 11:43:04 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * install.sh: add some 'else true' clauses for portability
+
+ * configure.in: don't build libio for h8[35]00-*-* targets
+
+Tue Aug 17 19:02:31 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in: Add support for new libio.
+
+Sun Aug 15 20:48:55 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * install.sh: If one command fails, don't try the rest. Don't try
+ to remove $dsttmp (via trap) unless we have already created it.
+ If $src doesn't exist, detect it and exit with an error.
+
+ * config.guess: Recognize BSD on hp300.
+
+Wed Aug 11 18:35:13 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.guess: Map (9000/[34]??:HP-UX:*:*) to m68k-hp-hpux.
+ Bug report from "Hamish (H.I.) Macdonald" <hamish@bnr.ca>.
+
+Wed Aug 11 15:37:51 1993 Jason Merrill (jason@deneb.cygnus.com)
+
+ * Makefile.in (all-send-pr): depends on all-prms
+
+Wed Aug 11 16:56:03 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Fix typo (9000/8??:4.3bsd -> 9000/7??:4.3bsd).
+
+Fri Aug 6 14:45:02 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * config.guess: From michael@mercury.cs.mun.ca (Michael Rendell):
+ Added test for mips-mips-riscos5.
+
+Thu Aug 5 15:45:08 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in: use mh-hp300 for 68k HP hosts
+
+Mon Aug 2 11:56:53 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure: add support for CONFIG_SHELL, so that you can use
+ some alternate shell for evaluating configure scripts
+
+Sun Aug 1 11:36:27 1993 Fred Fish (fnf@deneb.cygnus.com)
+
+ * Makefile.in (make-gdb.tar.gz): Sed bug reporting address
+ in configure script to bug-gdb@prep.ai.mit.edu when building
+ distribution archive.
+ * Makefile.in (COMPRESS): Remove def.
+ * Makefile.in (gdb.tar.gz, make-gdb.tar.gz): Renamed from
+ gdb.tar.Z and make-gdb.tar.Z respectively.
+ * Makefile.in (make-gdb.tar.gz): Now only build gzip'd archive.
+ * Makefile.in (make-gdb.tar.gz): Minor changes to move closer
+ to convergence with 'taz' target in Makefile.in.
+
+Fri Jul 30 12:34:57 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * install.sh (dsttmp): use trap to ensure that tmp files go
+ away on error conditions
+
+Wed Jul 28 11:57:36 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * Makefile.in (BASE_FLAGS_TO_PASS): remove LOADLIBES
+
+Tue Jul 27 12:43:40 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in (install-dirs): Deal with a prefix like /gnu;
+ its parent is '/' not ''.
+
+ * Makefile.in (DEVO_SUPPORT): Add comments about ChangeLog.
+
+Fri Jul 23 09:53:37 1993 Jason Merrill (jason@wahini.cygnus.com)
+
+ * configure: if ${newsrcdir}/configure doesn't exist, don't assume
+ that ${newsrcdir}/configure.in does.
+
+Tue Jul 20 11:28:50 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * test-build.mk: support for CONFIG_SHELL
+
+Mon Jul 19 21:54:46 1993 Fred Fish (fnf@deneb.cygnus.com)
+
+ * config.sub (netware): Add as a basic system type.
+
+Wed Jul 14 12:03:11 1993 K. Richard Pixley (rich@sendai.cygnus.com)
+
+ * Makefile.in (Makefile): depend on configure.in. Also drop the
+ $(srcdir)/ from the dependency on Makefile.in.
+
+Tue Jul 13 20:10:58 1993 Doug Evans (dje@canuck.cygnus.com)
+
+ * config.sub: Recognize h8300hhms as h8300h-hitachi-hms.
+ (h8300hhms is temporary until multi-libraries are implemented).
+ * configure.in: Handle h8300h too.
+
+Sun Jul 11 17:35:27 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Recognize dpx/2 as m68k-bull-sysv3.
+
+Thu Jul 8 18:26:12 1993 John Gilmore (gnu@cygnus.com)
+
+ * configure: Remove extraneous output when guessing host type.
+ * config.guess: Remove extraneous output when guessing using C
+ compiler rather than uname, or when guessing fails.
+
+Wed Jul 7 17:58:14 1993 david d `zoo' zuhn (zoo at rtl.cygnus.com)
+
+ * Makefile.in: remove all.cross and install.cross targets
+
+ * configure: remove CROSS=-DCROSS_COMPILE and ALL=all.cross
+ definitions
+
+Tue Jul 6 10:39:44 1993 Steve Chamberlain (sac@phydeaux.cygnus.com)
+
+ * configure.in (target sh): Build gprof.
+
+Thu Jul 1 16:52:56 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config.sub: change -solaris to -solaris2
+
+Thu Jul 1 15:46:16 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * configure.in: Use config/mh-riscos for mips-*-sysv*.
+
+Wed Jun 30 09:31:58 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure: Correct error message for missing Makefile.in to
+ print correct directory.
+
+Tue Jun 29 13:52:16 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * install.sh: kludge around 386BSD shell bug
+
+Tue Jun 29 13:06:49 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * config.guess: Recognize NeXT.
+ * config.guess: Recognize i486-ncr-sysv4.
+ * Makefile.in (taz): rm $(TOOL)-$$VER before linking.
+
+Tue Jun 29 12:50:57 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (MAKEINFOFLAGS): New variable.
+ (FLAGS_TO_PASS): Pass MAKEINFO as MAKEINFO MAKEINFOFLAGS.
+ * build-all.mk, test-build.mk: Pass down --no-split as
+ MAKEINFOFLAGS when hosted on DOS. Compile DOS hosted without -g.
+
+Thu Jun 24 13:39:11 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Makefile.in (DEVO_SUPPORT): Add COPYING COPYING.LIB install.sh.
+
+Wed Jun 23 12:59:21 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Makefile.in (libg++.tar.z): New rule.
+ * Makefile.in (taz): Replace 'configure -rm' by 'make distclean'.
+ * Makefile.in (taz): Only do a single chmod.
+
+Fri Jun 18 12:03:10 1993 david d `zoo' zuhn (zoo at majipoor.cygnus.com)
+
+ * install.sh: don't use dirname anymore (replaced with sed usage)
+
+Thu Jun 17 18:43:42 1993 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in: Change extension for gzip'd files from '.z' to
+ '.gz' per new FSF standard usage.
+
+Thu Jun 17 16:58:50 1993 david d `zoo' zuhn (zoo at majipoor.cygnus.com)
+
+ * configure: put quotes around the final value of program_transform_name
+
+Tue Jun 15 16:48:51 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: new install.sh support; update install-info rules
+
+Wed Jun 9 12:31:34 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure.in: Build diff for crosses, but not for go32 host.
+
+ * configure.in: Build gprof only for native, and don't build it
+ for mips-*-*, rs6000-*-*, or i[34]86-*-sco*.
+
+Mon Jun 7 13:12:11 1993 david d `zoo' zuhn (zoo at deneb.cygnus.com)
+
+ * configure.in: don't build gas,ld,binutils on for *-*-sysv4
+
+Mon Jun 7 11:40:11 1993 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * configure.in (host_tools): Add prms.
+
+Fri Jun 4 13:30:42 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: install gcc, do installation of $(INSTALL_MODULES)
+ with $(FLAGS_TO_PASS) on the command line
+
+ * config.sub: Recognize lynx and lynxos
+
+Fri Jun 4 10:59:56 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * config.sub: Accept -ecoff*, not just -ecoff.
+
+Thu Jun 3 17:38:54 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * Makefile.in (taz): Use .gz suffix instead of .z.
+ (binutils.tar.gz, gas+binutils.tar.gz, gas.tar.gz): Fixed target
+ names.
+
+Thu Jun 3 00:27:06 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in (vault-install): add an 'else true' (for Ultrix)
+
+Wed Jun 2 18:19:16 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in (install-no-fixedincludes): install gcc last, so
+ that rebuilds that might happen during 'make install' don't get
+ bogus gcc include files
+
+Wed Jun 2 16:14:10 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ Change from Utah for HPPA support:
+ * config.guess: Recognize hppa1.x-hp-bsd.
+
+Wed Jun 2 11:53:33 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * config.guess: Add support for Motorola Delta 68k, up to r3v7.
+ Patch from pot@fly.cnuce.cnr.it (Francesco Potorti`).
+
+Tue Jun 1 17:48:42 1993 Rob Savoye (rob at darkstar.cygnus.com)
+
+ * config.sub: Add support for rom68k and bug boot monitors.
+
+Mon May 31 09:36:37 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * Makefile.in: Make all-opcodes depend on all-bfd.
+
+Thu May 27 08:05:31 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * config.guess: Added special check for i[34]86-univel-sysv4*.
+
+Wed May 26 16:33:40 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * config.guess: For i[34]86-unknown-sysv4 use UNAME_MACHINE for
+ the processor rather than assuming i486.
+
+Wed May 26 09:40:18 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.guess: Recognize SunOS6 as Solaris3.
+
+Tue May 25 23:03:11 1993 Per Bothner (bothner@cygnus.com)
+
+ * config.guess: Fix typo. Avoid #elif (not in K&R 1).
+ Recognize SunOS 5.* only (and not [6-9].*) as being Solaris2.
+
+Tue May 25 12:44:18 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * build-all.mk (all-cross): New target for Canadian Cross.
+ Added Q2 go32 targets.
+ * test-build.mk: Configure go32 cross sparclite-aout and
+ mips-idt-ecoff -with-gnu-ld. Moved build binary directory from
+ PARTIAL_HOLE_DIRS to BUILD_HOLES_DIRS.
+
+Mon May 24 15:30:06 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: fix Alpha GDB typo; also, don't build DejaGnu for
+ GO32 hosted toolchains
+
+Mon May 24 14:18:41 1993 Rob Savoye (rob at darkstar.cygnus.com)
+
+ * configure: change so "-exec-prefix" gets passed down rather
+ than "-exec_prefix" so autoconf generated Makefiles get the
+ exec_prefix set right.
+
+Fri May 21 10:42:25 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config.guess: get the Solaris2 minor version number
+
+ * Makefile.in: add standards.texi and make-stds.texi to ETC_SUPPORT
+
+Fri May 21 06:20:52 1993 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * config.guess: Recognize some Sequent platforms.
+
+Thu May 20 14:33:48 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: added the vault-install target
+
+ * configure.in: actually use the Sun3 makefile fragment that's in
+ config, also added the release dir to configdirs
+
+Thu May 20 14:19:18 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * Makefile.in (taz): Fix modes on stuff in $(TOOL) dir also.
+
+Tue May 18 20:26:41 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: remove some program from Alpha targetted toolchains
+
+Tue May 18 15:23:19 1993 Ken Raeburn (raeburn@cygnus.com)
+
+ * Makefile.in (DISTSTUFFDIRS): Renamed from PROTODIRS. Add ld and
+ gprof.
+ (taz): Run "make diststuff" in those directories instead of "make
+ proto-dir". Look for "VERSION=" only at start of line in subdir
+ Makefile. Use "gzip -9" for compression.
+ (TEXINFO_SUPPORT, DIST_SUPPORT, BINUTILS_SUPPORT_DIRS): New vars.
+ (binutils.tar.z): New target.
+
+Mon May 17 17:01:15 1993 Ken Raeburn (raeburn@deneb.cygnus.com)
+
+ * Makefile.in (taz): Include gpl.texinfo.
+
+Fri May 14 06:48:38 1993 Ken Raeburn (raeburn@deneb.cygnus.com)
+
+ * Makefile.in (setup-dirs): Merged into "taz" target.
+ (taz): Only do `proto-dir' stuff if a directory is actually needed
+ for this target.
+
+Wed May 12 13:09:44 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (MUNCH_NM): New variable, defined to be $(NM).
+ (FLAGS_TO_PASS): Pass down MUNCH_NM.
+ (HOST_CC, HOST_PREFIX, HOST_PREFIX_1): New variables.
+ (EXTRA_GCC_FLAGS): Pass down HOST_* variables.
+ (gcc-no-fixedincludes): Correct for current gcc Makefile.
+
+Tue May 11 10:14:25 1993 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in (make-gdb.tar.Z): Add configure, config.guess,
+ config.sub, and move-if-change to gdb testsuite distribution
+ archive, so the testsuite can be extracted, configured, and
+ run separately from the gdb distribution. Blow away the Chill
+ tests that require a Chill compiled executable, since GNU Chill
+ is not yet publically available.
+
+Mon May 10 17:22:26 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * test-build.mk: set environment variables in a single command,
+ instead of a list of assignments and exports
+
+ * config.guess: recognize Alpha/OSF1 systems
+
+Mon May 10 14:55:51 1993 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * configure: Change help message to prefer --options rather than
+ -options.
+
+Mon May 10 05:58:35 1993 Ken Raeburn (raeburn@kr-pc.cygnus.com)
+
+ * config.sub: Convergent Tech. "miniframe" uses m68010, sez
+ zippy@ecst.csuchico.edu.
+ * config.guess: Recognize miniframe.
+
+Sun May 9 17:47:57 1993 Rob Savoye (rob at darkstar.cygnus.com)
+
+ * Makefile.in: Use srcroot to find runtest rather than rootme.
+ Pass RUNTESTFLAGS and EXPECT down in BASE_FLAGS_TO_PASS.
+
+Fri May 7 14:55:59 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * test-build.mk: Extensive additions to support building on a
+ machine other than the host.
+
+Wed May 5 08:35:04 1993 Ken Raeburn (raeburn@deneb.cygnus.com)
+
+ * configure (tooldir): Fix for i386-aix again.
+
+Mon May 3 19:00:27 1993 Per Bothner (bothner@cygnus.com)
+
+ * configure, Makefile.in: Change definition of $(tooldir)
+ to match the FSF.
+
+Fri Apr 30 15:55:21 1993 Fred Fish (fnf@cygnus.com)
+
+ * config.guess: Recognize i[34]86/SVR4.
+
+Fri Apr 30 15:52:46 1993 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * Makefile.in (all-gdb): gdb depends on sim.
+
+Thu Apr 29 23:30:48 1993 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in (gdb.tar.Z): Make prototype gdb testsuite directory
+ at the same time we make the prototype gdb directory.
+ * Makefile.in (make-gdb.tar.Z): Make the testsuite distribution
+ files at the same time as the gdb base release distribution.
+
+Thu Apr 29 12:50:37 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (check): Use individual check targets rather than
+ DO_X rule.
+ (check-gcc): Added.
+
+Thu Apr 29 09:50:07 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * config.sub: Use sysv3.2 not sysv32 for canonical OS
+ for System V release 3.2.
+
+Thu Apr 29 10:33:22 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * config.sub: Recognize hppaosf.
+ * configure.in: Do configure ld/binutils/gas for it.
+
+Tue Apr 27 06:25:34 1993 Ken Raeburn (raeburn@kr-pc.cygnus.com)
+
+ * configure (tooldir): Alter syntax used to set this, for systems
+ where "\$" isn't handled right, like i386-aix.
+
+Thu Apr 22 08:17:35 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure: Pass program-transform-name, not
+ program_transform_name, to recursive configures.
+
+Thu Apr 22 02:58:21 1993 Ken Raeburn (raeburn@cygnus.com)
+
+ * Makefile.in (gas+binutils.tar.z): New rule for building snapshots
+ of gas+ld+binutils.
+
+Mon Apr 19 17:41:30 1993 Per Bothner (bothner@cygnus.com)
+
+ * config.guess: Recognize AIX3.2 as distinct from 3.1.
+
+Sat Apr 17 17:19:50 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: rename m88k-motorola-m88kbcs to m88k-motorola-sysv
+
+ * config/mh-delta88: remove extraneous GCC references
+
+Tue Apr 13 16:52:16 1993 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * Makefile.in (PRMS): Set back to all-prms.
+
+Sat Apr 10 12:04:07 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * test-build.mk: Pass -with-gnu-as for known MIPS native and MIPS
+ targets, rather than for MIPS hosts.
+
+Fri Apr 9 13:51:06 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: add comment for --with-x default values
+
+ * config.guess: handle Motorola Delta88 box for SVR3 and SVR4.
+
+ * Makefile.in: add check-* targets for each of the directories in
+ the tree. Add a definition of RUNTEST that will use the one we
+ just built, if it exists. Pass this down via FLAGS_TO_PASS.
+
+Thu Apr 8 09:21:30 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure.in: Removed obsolete references to bfd_target and
+ target_makefile_frag.
+
+ * build-all.mk: Set assorted targets for Q2.
+ * config.sub: Recognize z8k-sim and h8300-hms.
+ * test-build.mk: Really don't pass host to configure.
+ (HOLES): Added uname.
+
+Wed Apr 7 15:48:19 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure: Handle an empty program-prefix, program-suffix or
+ program-transform-name correctly.
+
+Tue Apr 6 13:48:41 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * build-all.mk: -G 8 no longer required for MIPS targets.
+ * test-build.mk: Don't pass host argument to configure; make it
+ guess.
+
+Tue Apr 6 10:36:53 1993 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in (gdb.tar.Z): Fix for building gzip'd distribution.
+ * Makefile.in (COMPRESS): New macro, like GZIP.
+
+Fri Apr 2 09:02:31 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * test-build.mk: Use -with-gnu-as for mips-sgi-irix4 as well.
+
+ * build-all.mk: Set GCC to gcc -O -G 8 for MIPS targets, since gcc
+ with gas currently defaults to -G 0.
+
+Thu Apr 1 08:25:42 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (all-flex): flex depends on byacc.
+
+ * build-all.mk: If host not specified, use config.guess. Pass TAG
+ to test-build.mk as RELEASE_TAG.
+ * test-build.mk (configargs): New variable containing arguments to
+ pass to configure. Set to -with-gnu-as on mips-dec-ultrix.
+ (FLAGS_TO_PASS): Pass down RELEASE_TAG.
+
+ * config.guess: Use /bin/uname when checking -X argument on SCO,
+ to avoid invoking GNU uname which doesn't understand -X.
+
+ * test-build.mk: Don't use /usr/unsupported/bin/as on AIX.
+
+ * configure.in: Build gas for mips-*-*.
+
+Wed Mar 31 21:20:58 1993 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * Makefile.in (all.normal): insert missing backslash.
+
+Wed Mar 31 12:31:56 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * build-all.mk, config/mh-irix4: Bump -XNh value to 1500 to match
+ gcc requirements.
+
+ * Makefile.in: Complete overhaul to merge many almost identical
+ targets.
+
+Tue Mar 30 20:17:01 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * Makefile.in (setup-dirs-gdb): Renamed from setup-dirs.
+ (gdb.tar.Z): Adjusted.
+
+ * Makefile.in (setup-dirs, taz): New targets; should be general
+ enough to adapt for gdb sometime. Build only .z file.
+ (gas.tar.z): New target.
+
+Tue Mar 30 10:03:09 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * build-all.mk: Use CC=cc -Xs on Solaris.
+
+Mon Mar 29 19:59:26 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config/mh-sun3: cc needs -J to compile cp-parse.c correctly
+
+ * config/mh-solaris: SunPRO C needs -Xs to be able to get a
+ working xmakefile for Emacs.
+
+Thu Mar 25 15:14:30 1993 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in: Incorporate changes suggested by wilson@cygnus.com
+ for handling BISON for FSF releases.
+
+Thu Mar 25 06:19:48 1993 Ken Raeburn (raeburn@kr-pc.cygnus.com)
+
+ * configure: Actually implement the change zoo just documented.
+
+Wed Mar 24 13:02:44 1993 david d `zoo' zuhn (zoo at poseidon.cygnus.com)
+
+ * configure: when using config.guess, only set target_alias when
+ it's not already been set (ie, on the command line)
+
+Mon Mar 22 23:07:39 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: add installcheck target, set PRMS to install-prms
+
+Sun Mar 21 16:46:12 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure: add support for package_makefile_fragment, handle the
+ case where a directory has a configure.in file but no Makefile.in
+ more gracefully (with an actual understandable error message, even);
+ add support for --without (and add this to the usage message); also
+ explicitly add a --host=${host_alias} to the command line when
+ config.guess is used
+
+Sun Mar 21 12:11:58 1993 Jim Wilson (wilson@sphagnum.cygnus.com)
+
+ * configure: Must use both --host and --target in recursive calls.
+
+Thu Mar 18 12:31:35 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: Change deja-gnu to dejagnu.
+
+Mon Mar 15 15:44:35 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure.in (h8300-*-*, h8500-*-*): Don't build libg++.
+
+Fri Mar 12 18:30:14 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: canonicalize all instances to *-*-solaris2*,
+ also strip out a number of tools to not build for go32 host
+
+Wed Mar 10 12:08:27 1993 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * config.guess: add GPL.
+
+ * Makefile.in, config.guess, config.sub, configure: bump
+ copyrights to 93.
+
+Wed Mar 10 07:12:48 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (do-info): Removed obsolete check for existence of
+ localenv file.
+
+ * Makefile.in (MAKEOVERRIDES): Define to be empty.
+
+Wed Mar 10 03:11:56 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: a couple of 'else true' for decstation,
+ support for TclX
+
+ * configure.in: configure tclX too; don't remove Tk on RS/6000 anymore
+
+Tue Mar 9 16:06:12 1993 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in (setup-dirs): change invocation of make to $(MAKE).
+
+Mon Mar 8 14:52:11 1993 Ken Raeburn (raeburn@cambridge)
+
+ * config.guess: Recognize i386-ibm-aix (PS/2).
+ * configure.in: Use config/mh-aix386 file for it.
+
+Mon Mar 8 11:12:43 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (GCC_FOR_TARGET): Eliminated definition; use
+ CC_FOR_TARGET instead.
+ (BASE_FLAGS_TO_PASS): Pass GCC_FOR_TARGET=$(CC_FOR_TARGET).
+
+Wed Mar 3 16:00:28 1993 Steve Chamberlain (sac@ok.cygnus.com)
+
+ * Makefile.in: Add sim to list of directories sent with gdb
+
+Wed Mar 3 11:42:39 1993 Ken Raeburn (raeburn@cygnus.com)
+
+ * configure.in: Put back mips-dec-bsd* case.
+
+Tue Mar 2 21:15:58 1993 Fred Fish (fnf@cygnus.com)
+
+ (Ultrix 2.2 support from Michael Rendell <michael@mercury.cs.mun.ca>)
+ * configure.in (vax-*-ultrix2*): Add Ultrix 2.2 triplet.
+ * config.guess: Change 'VAX*:ULTRIX:*:*' to 'VAX*:ULTRIX*:*:*'.
+ * config/mh-vaxult2: New file.
+
+Tue Mar 2 18:11:03 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: remove no-op mips-dec-bsd* in "case $target"
+
+ * Makefile.in (dir.info): only run gen-info-dir if it exists,
+ (install-info): install dir.info only if it exists,
+ (all-expect, install-expect): pass along X11_FLAGS_TO_PASS
+
+Tue Mar 2 09:01:30 1993 Ken Raeburn (raeburn@cygnus.com)
+
+ * configure.in: For vms target, skip bfd, ld, binutils. Do build
+ gas for mips-dec-bsd.
+
+Tue Mar 2 08:35:24 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure (makesrcdir): If ${srcdir} is relative and not ".",
+ and ${subdir} is not ".", set makesrcdir based on ${invsubdir}.
+
+Tue Feb 23 14:18:28 1993 Mike Werner (mtw@poseidon.cygnus.com)
+
+ * configure.in: Added "dejagnu" to hosttools list.
+
+Mon Feb 22 23:28:38 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * config.sub, configure.in, config.guess: Add support
+ for Bosx, an AIX variant from Bull.
+ Patches from F.Pierresteguy@frcl.bull.fr.
+
+Sun Feb 21 11:15:22 1993 Mike Werner (mtw@poseidon.cygnus.com)
+
+ * devo/dejagnu: Initial creation of devo/dejagnu.
+ Migrated dejagnu testcases and support files for testing software
+ tools to reside as subdirectories, currently called "testsuite",
+ within the directory of the software tool. Migrated all programs,
+ support libraries, etc. beloging to dejagnu proper from
+ devo/deja-gnu to devo/dejagnu. These files were moved "as is"
+ with no modifications. The changes to these files which will
+ allow them to configure, build, and execute properly will be made
+ in a future update.
+
+Fri Feb 19 20:19:39 1993 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * Makefile.in: Change send_pr to send-pr.
+ * configure.in: Likewise.
+ * send_pr: Renamed directory to send-pr.
+
+Fri Feb 19 19:00:13 1993 Per Bothner (bothner@cygnus.com)
+
+ * Makefile.in: Add some extra semi-colons (needed if SHELL=bash).
+
+Fri Feb 19 00:59:33 1993 John Gilmore (gnu@cygnus.com)
+
+ * README: Update for gdb-4.8 release.
+ * Makefile.in (gdb.tar.Z): Add texinfo/tex3patch. Build
+ gdb-xxx.tar.z (gzip'd) file also.
+
+Thu Feb 18 09:16:17 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: make all-diff depend on all-libiberty
+
+Tue Feb 16 16:06:31 1993 K. Richard Pixley (rich@cygnus.com)
+
+ * config.guess: add vax-ultrix in the spirit of mips-ultrix.
+
+Tue Feb 16 05:57:15 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in, Makefile.in: add hello, tar, gzip, recode, indent
+
+Tue Feb 16 00:58:20 1993 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in (DEVO_SUPPORT): Remove etc directory
+ (ETC_SUPPORT): Only add the files GDB wants from etc/.
+ (gdb.tar.Z): Use ETC_SUPPORT. Use byacc when building the file.
+
+Thu Feb 11 20:14:28 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: makeinfo binary is in a new location
+
+Tue Feb 9 12:42:27 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * config.sub: Accept -ecoff as an OS.
+
+ * Makefile.in: Various changes to eliminate a level of make
+ recursion and reduce the required command line length.
+ (BASE_FLAGS_TO_PASS): New variable holding flags passed to all
+ sub-makes.
+ (EXTRA_HOST_FLAGS, EXTRA_TARGET_FLAGS, EXTRA_GCC_FLAGS): New
+ variables holding settings for specific sub-makes.
+ (FLAGS_TO_PASS, TARGET_FLAGS_TO_PASS, GCC_FLAGS_TO_PASS): Rewrote
+ in terms of BASE_FLAGS_TO_PASS.
+ (TARGET_LIBS): New variable listing directories which use
+ TARGET_FLAGS_TO_PASS.
+ (subdir_do): Eliminated.
+ (do-*): New set of targets to replace subdir_do.
+ (various): All targets which used subdir_do now depend on do-*.
+ (local-clean): Renamed from do_clean.
+ (local-distclean): New target, dependency of distclean and
+ realclean.
+ (install-info): Don't create directories. Depend on dir.info
+ rather than calling make recursively.
+ (install-dir.info): Eliminated.
+ (install-info-dirs): Create all info directories here.
+ (dir.info): Depend upon do-install-info.
+
+ * test-build.mk (HOLES): Added false.
+
+Sat Feb 6 14:05:09 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * config.guess: Recognize BSDI and BSDJ (Jolitz 386bsd).
+
+Thu Feb 4 20:49:18 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in (info): remove dependency on all-texinfo. The
+ problem was really in texinfo/C, not at this level.
+
+Thu Feb 4 13:38:41 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (info): Added dependency on all-texinfo (PR 2112).
+
+Thu Feb 4 01:50:53 1993 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in (make-gdb.tar.Z): Change BISON to 'bison -y' for
+ GDB releases.
+
+Wed Feb 3 17:22:16 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * configure: Include srcdir in message about target of link not
+ being found. Don't convert `-' to `_' in `with' options being
+ passed to subdirs.
+
+Tue Feb 2 18:57:59 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: add uudecode to host_tools
+
+ * Makefile.in: added {all,install}-uudecode targets, added them to
+ the appropriate lists
+
+Tue Feb 2 11:45:53 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (all-gcc): Added dependency on all-gas.
+
+ * configure.in (mips-*-*): Build ld and binutils.
+
+Mon Feb 1 12:35:41 1993 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * configure: check return code from mkdir, print error message and
+ exit on failure.
+
+Sat Jan 30 16:40:28 1993 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in (make-gdb.tar.Z): New location for texinfo.tex.
+
+Thu Jan 28 15:09:59 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * test-build.mk (HOLES): Added tar, cpio and uudecode.
+
+Wed Jan 27 16:50:32 1993 Jim Wilson (wilson@sphagnum.cygnus.com)
+
+ * config.sub (h8500): Recognize this as a cpu type.
+
+Sat Jan 23 20:32:01 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure: source directory missing is no longer a warning
+
+ * configure.in: recognize irix[34]* instead of irix[34]
+
+ * Makefile.in: define and pass down X11_LIB
+
+ * config/mh-sco: define X11_LIB to the mess that SCO ODT requires
+
+Sat Jan 23 13:49:40 1993 Per Bothner (bothner@cygnus.com)
+
+ * guess-systype: Renamed to ...
+ * config.guess: ... by popular request.
+ * configure.in, Makefile.in: Update accordingly.
+
+Thu Jan 21 12:20:55 1993 Per Bothner (bothner@cygnus.com)
+
+ * guess-systype: Patches from John Eaton <jwe@che.utexas.edu>:
+ + Add Convex, Cray/Unicos, and Encore/Multimax support.
+ + Execute ./dummy instead of assuming . is in PATH.
+
+Tue Jan 19 17:18:06 1993 Per Bothner (bothner@cygnus.com)
+
+ * guess-systype: New shell script. Attempts to guess the
+ canonical host name of the executing host.
+ Only a few hosts are supported so far.
+ * configure: Call guess-systype if no host is specified.
+
+Tue Jan 19 08:26:07 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (gcc-no-fixedincludes): Made to work with current
+ gcc Makefile.
+
+
+Fri Jan 15 10:27:02 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (GCC_FLAGS_TO_PASS): New variable.
+ (all-gcc, install-gcc, subdir_do): Use it.
+
+Wed Jan 13 17:06:45 1993 Jim Wilson (wilson@sphagnum.cygnus.com)
+
+ * Makefile.in: Rename uninstalled gcc driver from gcc to xgcc.
+
+Wed Jan 6 20:29:16 1993 Mike Werner (mtw@rtl.cygnus.com)
+
+ * Makefile.in: Removed explicit setting of SUBDIRS. SUBDIRS is now
+ set exclusively by configure, using configure.in .
+
+Wed Jan 6 13:44:11 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * test-build.mk: set $PATH for all builds
+
+ * Makefile.in: pass TARGET_FLAGS_TO_PASS for xiberty and libm
+
+Wed Jan 6 11:02:10 1993 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in (GCC_FOR_TARGET): Supply a default that matches
+ the one used in gcc/Makefile.in, so that a null expansion doesn't
+ override the one needed to build gcc with a native cc.
+
+
+Tue Jan 5 07:55:12 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * configure: Accept -with arguments.
+
+Sun Jan 3 15:15:09 1993 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * Makefile.in: added h8300sim
+
+Tue Dec 29 15:06:00 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * config/mh-sco: Don't override BISON definition.
+
+ * build-all.mk: If canonhost is i386-unknown-sco3.2v4, change it
+ to i386-sco3.2v4. Set TARGETS and CFLAGS for i386-sco3.2v4.
+ (all-cygnus, native, build-cygnus): Make
+ $(canonhost)-stamp-3stage-done, not $(host)....
+ * test-build.mk (stamp-3stage-compared): Use tail +10c for
+ i386-sco3.2v4. Added else true to if command.
+
+Mon Dec 28 12:08:56 1992 Ken Raeburn (raeburn@cygnus.com)
+
+ * config.sub: (from FSF) Sequent uses a BSD-like OS.
+
+Mon Dec 28 08:32:06 1992 Minh Tran-Le (mtranle@paris.intellicorp.com)
+
+ * configure.in (i[34]86-*-isc*): added; uses mh-sysv.
+
+Thu Dec 24 17:26:24 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: don't remove binutils from Solaris builds
+
+Thu Dec 24 14:08:38 1992 david d`zoo' zuhn (zoo@cygnus.com)
+
+ * Makefile.in: get rid of earlier definitions for *clean,
+ also handle the recursive info rule better
+
+Thu Dec 24 12:40:21 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Makefile.in (mostlyclean, distclean, realclean): Fix to
+ do more-or-less the right thing.
+
+Wed Dec 16 10:25:31 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: Add lines defining CC and CXX, and use CXX rather
+ than gcc in definitions of CXX_FOR_BUILD and CXX_FOR_TARGET.
+
+Tue Dec 15 00:34:32 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: change all $(host_cpu)-$(host_vendor)-$(host_os) to
+ $(host_canonical).
+
+ * configure.in: split the configdirs list into 4 categories (native
+ v. cross, library v. tool) and handle the cross-only and native-
+ only in more reasonable (and correct!) way.
+
+Mon Dec 14 17:04:22 1992 Stu Grossman (grossman at cygnus.com)
+
+ * configure.in (hppa*-*-*): Don't remove bfd and gdb from
+ configdirs anymore.
+
+Sun Dec 13 00:37:26 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: extensive cleanup:: removed all of the explicit
+ clean-* targets, collapsed many wrappers around subdir_do into
+ one, added additional targets to satisfy standards.texi, deleted
+ some old targets, some changes for consistency
+
+Fri Dec 11 20:18:02 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: handle some programs as cross-only, and others as
+ native only
+
+ * test-build.mk: handle partial holes in a more generic manner
+
+ * Makefile.in: m4 depends on libiberty
+
+Mon Dec 7 06:43:27 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config/mh-sco: don't default $(CC) to gcc
+
+Thu Dec 3 21:52:11 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: add m4, textutils, fileutils, sed, shellutils,
+ time, wdiff, and find to configdirs
+
+ * Makefile.in: all, clean, and install rules for the new programs
+ added to configure.in
+
+Mon Nov 30 14:54:34 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: use mh-sun for all *-sun-* hosts
+
+ * config/mh-solaris: rework standard X location to use
+ $OPENWINHOME, if defined.
+
+ * config/mh-sun: handle X11 include locations
+
+ * config/mh-decstation: define NeedFunctionPrototypes to 0, to
+ work around dain-bramaged DECwindows include files
+
+Fri Nov 27 18:35:54 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: define flags for X11 include files and library file
+ locations, pass them down to the programs that need this info
+
+ * build-all.mk: added a 'native' target, to 3stage the native toolchain
+
+ * config/{mh-hpux,mh-solaris}: define the "standard" locations for
+ the vendor supplied X11 headers and libraries
+
+Sun Nov 22 18:59:13 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: start building libg++ for HP-UX targets
+
+Wed Nov 18 19:33:11 1992 John Gilmore (gnu@cygnus.com)
+
+ * README: Update references to files moved into etc/.
+
+Sun Nov 15 09:36:08 1992 Fred Fish (fnf@cygnus.com)
+
+ * config.sub (i386sol2, i486sol2): i[34]86-unknown-solaris2.
+ * configure.in (i[34]86-*-solaris2*): Use config/mh-sysv4.
+
+Thu Nov 12 08:50:42 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure: accept dash as well as underscore in long option
+ names for FSF compatibility.
+
+Wed Nov 11 08:04:37 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * config.sub: added -sco3.2v4 support from FSF.
+
+Sun Nov 8 21:14:30 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: expand the section that adds or removes
+ directories from the list of programs to build, to handle native
+ vs. cross in addition to host v. native
+
+Sat Nov 7 18:52:27 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Makefile.in: Replace C++ in macro names with CXX.
+ This is less likely to break ...
+
+Sat Nov 7 15:16:58 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * test-build.mk: add -w to GNU_MAKE
+
+Fri Nov 6 23:10:37 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config.sub: remove 'sparc'-->'sparc-sun' default transformation,
+ add 'sparc' to list of recognized cpus. This needed to make
+ 'sparc-aout' expand to 'sparc-unknown-aout' instead of 'sparc-sun-aout'.
+ Delete some redundant ose68 variants. Recognize -wrs as an os,
+ then changes that into $CPU-wrs-vxworks.
+
+ * configure.in: remove most references to gdbtest, regularize
+ target based program removal
+
+ * test-build.mk: import from p3 tree (many fixes and changes)
+
+Fri Nov 6 20:59:00 1992 david d `zoo' zuhn (zoo@cygnus.com)
+
+ * Makefile.in: added rules to handle tcl, tk, and expect
+
+ * configure.in: handle those directories if they exist
+
+Thu Nov 5 14:35:41 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config.sub: removed bogus hppabsd and hppahpux names, since
+ "hppa" is not a valid cpu (hppa1.1 or hppa1.0 are, though)
+
+Thu Oct 29 00:12:41 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: all-gcc now depends on all-binutils. all-libg++
+ depends upon all-xiberty
+
+ * Makefile.in: changes from p3, including:
+
+ Thu Oct 8 15:00:17 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (XTRAFLAGS): include newlib directories if
+ newlib/Makefile exists, rather than if host != target.
+
+ Fri Sep 25 13:41:52 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: added -nostdinc to XTRAFLAGS if we are using gcc
+ from the same source tree and not building a cross-compiler. This
+ matters for the libg++ configuration if reconfiguring a tree that
+ has already been installed.
+
+ Thu Sep 10 10:35:51 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: added -I for newlib/targ-include to XTRAFLAGS, to
+ pick up the machine and system specific header files.
+
+ * Makefile.in: added AS_FOR_TARGET, passed down in
+ TARGET_FLAGS_TO_PASS. Added CC_FOR_BUILD, which is intended to be
+ the C compiler to use to create programs which are run in the
+ build environment, set it to default to $(CC), and passed it down
+ in FLAGS_TO_PASS and TARGET_FLAGS_TO_PASS.
+
+ Mon Sep 7 22:34:42 1992 Ian Lance Taylor (ian@cirdan.cygnus.com)
+
+ * Makefile.in: add $(host) = $(target) tests back to *_FOR_TARGET.
+ We need them for unusual native builds, like systems without
+ ranlib.
+
+ * configure: also define $(host_canonical) and
+ $(target_canonical), which are the full, canonical names for the
+ given host and target
+
+Sun Nov 1 16:38:17 1992 Per Bothner (bothner@cygnus.com)
+
+ * Makefile.in: Added separate definitions for C++.
+
+Fri Oct 30 11:37:52 1992 Fred Fish (fnf@cygnus.com)
+
+ * configure.in (configdirs): Add deja-gnu.
+
+Fri Oct 23 00:39:18 1992 John Gilmore (gnu@cygnus.com)
+
+ * README: Update for configure.texi and gdb-4.7 release.
+
+Wed Oct 21 21:54:27 1992 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in: Move "all" target to top of file.
+ Previously, first target was ".PHONY" which caused BSD4.4 make
+ to build .PHONY when make was run without arguments.
+
+Mon Oct 19 01:17:54 1992 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in: Add COPYING.LIB to GDB releases, now that there's
+ Library-copylefted code in libiberty.
+
+Tue Oct 13 01:22:32 1992 John Gilmore (gnu@cygnus.com)
+
+ * config.sub: Replace m68kmote with plain old m68k.
+
+Fri Oct 9 03:14:24 1992 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in: Remove space from blank line, avoid Make complaints.
+
+Thu Oct 8 18:41:45 1992 Ken Raeburn (raeburn@cygnus.com)
+
+ * config.sub: Complain if no argument is given. Added support for
+ 386bsd as OS and target alias.
+
+Thu Oct 8 15:07:22 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (XTRAFLAGS): include newlib directories if
+ newlib/Makefile exists, rather than if host != target.
+
+Mon Oct 5 03:00:09 1992 Mark Eichin (eichin at tweedledumber.cygnus.com)
+
+ * config.sub: recognize sparclite-wrs-vxworks.
+
+ * Makefile.in (install-xiberty): added *-xiberty make rules (from
+ p3.) Added clean-xiberty to clean.
+
+Thu Oct 1 17:59:19 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: use *-*-* instead of nested cases for host and target
+
+Tue Sep 29 14:11:18 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: added -nostdinc to XTRAFLAGS if we are using gcc
+ from the same source tree and not building a cross-compiler. This
+ matters for the libg++ configuration if reconfiguring a tree that
+ has already been installed.
+
+Sep 20 08:53:10 1992 Fred Fish (fnf@cygnus.com)
+
+ * config.sub (i486v/i486v4): Merge in from FSF version.
+
+Fri Sep 18 00:32:00 1992 Mark Eichin (eichin@cygnus.com)
+
+ * configure: only set PWD if it is already set.
+
+Thu Sep 17 23:05:53 1992 Mark Eichin (eichin@cygnus.com)
+
+ * configure: just set PWD=`pwd` at the top, since Ultrix sh
+ doesn't have unset and all success paths (and most error paths)
+ out set it anyway. (Note: should change all uses of ${PWD=`pwd`}
+ to just ${PWD} to avoid confusion.)
+
+Tue Sep 15 16:00:54 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure: always set $(tooldir) to $(libdir)/$(target_alias),
+ even for a native compilation.
+
+Tue Sep 15 02:22:56 1992 John Gilmore (gnu@cygnus.com)
+
+ Changes to make the gdb.tar.Z rule work better.
+
+ * Makefile.in (GDB_SUPPORT_DIRS): Add opcodes.
+ (DEVO_SUPPORT): Add configure.texi.
+ (bfd-ilrt.tar.Z): Remove ancient rule.
+
+Thu Sep 10 10:43:19 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: added -I for newlib/targ-include to XTRAFLAGS, to
+ pick up the machine and system specific header files.
+
+ * configure.in, config.sub: added new target m68010-adobe-scout,
+ with alias of adobe68k. Changed configure.in to check for
+ -scout before -sco* to avoid a false match.
+
+ * Makefile.in: added AS_FOR_TARGET, passed down in
+ TARGET_FLAGS_TO_PASS. Added CC_FOR_BUILD, which is intended to be
+ the C compiler to use to create programs which are run in the
+ build environment, set it to default to $(CC), and passed it down
+ in FLAGS_TO_PASS and TARGET_FLAGS_TO_PASS.
+
+Wed Sep 9 12:21:42 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: added TARGET_FLAGS_TO_PASS, CC_FOR_TARGET,
+ AR_FOR_TARGET, RANLIB_FOR_TARGET, NM_FOR_TARGET. Pass
+ TARGET_FLAGS_TO_PASS, which defines CC, AR, RANLIB and NM as the
+ FOR_TARGET variants, to newlib and libg++.
+
+Tue Sep 8 17:28:30 1992 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * Makefile.in (all-gas, all-gdb): Require all-opcodes to be built
+ first.
+
+Wed Sep 2 02:50:05 1992 John Gilmore (gnu@cygnus.com)
+
+ * config.sub: Accept `elf' as an environment.
+
+Tue Sep 1 15:48:30 1992 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * Makefile.in (all-opcodes): cd into the right directory
+
+Sun Aug 30 21:12:11 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * configure: added -program_transform_name option, used as
+ argument to sed when installing programs.
+ configure.texi: added documentation for -program_prefix,
+ -program_suffix and -program_transform_name.
+
+Thu Aug 27 21:59:44 1992 John Gilmore (gnu@cygnus.com)
+
+ * config.sub: Accept i486 where i386 ok.
+
+Thu Aug 27 13:04:42 1992 Brendan Kehoe (brendan@rtl.cygnus.com)
+
+ * config.sub: accept we32k
+
+Mon Aug 24 14:05:14 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * config.sub, configure.in: accept OSE68000 and OSE68k.
+
+ * Makefile.in: don't create all directories for ``make install'';
+ let the subdirectories create the ones they need.
+
+Tue Aug 11 23:13:17 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * COPYING: new file, GPL v2
+
+Tue Aug 4 01:12:43 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: use the new gen-info-dir, which needs a template
+ argument (which also lives in texinfo)
+
+ * configure.texi, standards.texi: fix INFO-DIR-ENTRY
+
+Mon Aug 3 15:41:28 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config/mh-solaris: removed the -xs from CFLAGS (let the people
+ with Sun's C compiler deal with it themselved)
+
+Mon Aug 3 00:34:17 1992 Fred Fish (fnf@cygnus.com)
+
+ * config.sub (ncr3000): Change i386 to i486.
+
+Thu Jul 23 00:12:17 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: add install-rcs, install-grep to
+ install-no-fixedincludes, removed install-bison and install-libgcc
+
+Tue Jul 21 01:01:50 1992 david d `zoo' zuhn (zoo@cygnus.com)
+
+ * configure.in: grab the HPUX makefile fragment if on HPUX
+
+Mon Jul 20 11:02:09 1992 D. V. Henkel-Wallace (gumby@cygnus.com)
+
+ * Makefile.in: eradicate bison spoor (ditto libgcc).
+ configure.in: recognise m68{k,000}-ericsson-OSE.
+ es1800 is alias for m68k-ericsson-OSE
+
+Sun Jul 19 17:49:02 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: rearrange the parts that remove programs from
+ configdirs, based now on HOST==TARGET or by canonical triple.
+
+Fri Jul 17 22:52:49 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * test-build.mk: recurse explicitly with -f test-build.mk when
+ appropriate. predicate stage3 and comparison on the existence
+ of gcc. That is, if gcc isn't around, we aren't three-staging.
+ On very clean, also remove ...stamp-co. Build in-place before
+ doing other builds.
+
+Thu Jul 16 18:33:09 1992 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * Makefile.in, configure.in: add tgas
+
+Thu Jul 16 16:05:28 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * Makefile.in: a number of changes merged in from progressive.
+
+ * configure.in: add libm.
+
+ * .cvsignore: ignore some stuff that comes from test-build.mk.
+
+Wed Jul 8 00:01:30 1992 Stu Grossman (grossman at cygnus.com)
+
+ * config/mh-solaris: Use -xs when compiling so that Sun-C puts
+ a symbol-table into the executable.
+
+Tue Jul 7 00:24:52 1992 Fred Fish (fnf@cygnus.com)
+
+ * config.sub: Add es1800 (m68k-ericsson-es1800).
+
+Tue Jun 30 20:24:41 1992 D. V. Henkel-Wallace (gumby@cygnus.com)
+
+ * configure: Add program_suffix (parallel to program_prefix)
+ * Makefile.in: adjust directory-creating script for losing decstation
+
+Mon Jun 22 23:43:48 1992 Per Bothner (bothner@cygnus.com)
+
+ * configure: Minor $subdir-related fixes.
+
+Mon Jun 22 18:30:26 1992 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * configure: fix various problems with propogating
+ makefile_target_frag in subdirs.
+ * configure.in: config libgcc if its there
+
+Fri Jun 19 15:19:40 1992 Stu Grossman (grossman at cygnus.com)
+
+ * config.sub: HPPA merge.
+
+Mon Jun 15 12:31:52 1992 Fred Fish (fnf@cygnus.com)
+
+ * config/mh-ncr3000 (INSTALL): Don't use /usr/ucb/install,
+ it is broken on ncr 3000's.
+
+Sun Jun 14 10:29:19 1992 John Gilmore (gnu at cygnus.com)
+
+ * Makefile.in: Replace all-bison with all-byacc in all
+ dependency lines for other tools (which now use byacc).
+
+Fri Jun 12 22:21:57 1992 John Gilmore (gnu at cygnus.com)
+
+ * config.sub: Add sun4sol2 => sparc-sun-solaris2.
+
+Tue Jun 9 17:18:11 1992 Fred Fish (fnf at cygnus.com)
+
+ * config/{mh-ncr3000, mh-sysv4}: Add INSTALL.
+
+Thu Jun 4 12:07:32 1992 Mark Eichin (eichin@cygnus.com)
+
+ * Makefile.in: make gprof rules similar to byacc rules (instead of
+ vestigal $(unsubdir) that didn't work...)
+
+Thu Jun 4 00:37:05 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * config.sub: Add support for Linux.
+ * Makefile.in: Use $(FLAGS_TO_PASS) more consistently
+ (at least for libg++).
+
+Tue Jun 02 20:03:00 1992 david d `zoo' zuhn (zoo@cygnus.com)
+
+ * configure.texi: fix doc for the -nfp option to configure
+
+Tue Jun 2 17:20:52 1992 Michael Tiemann (tiemann@cygnus.com)
+
+ * Makefile.in (all-binutils): ar needs flex, so depend on all-flex.
+
+Sun May 31 15:04:08 1992 Mark Eichin (eichin at cygnus.com)
+
+ * config.sub: changed [^-]+ to [^-][^-]* so that it works under
+ Sun sed. (BSD 4.3 sed doesn't handle [^-]+ either.)
+ * configure.in: added solaris* host_makefile_frag hook.
+
+Sun May 31 01:10:34 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config.sub: changed recognition of m68000 so that various
+ m68k types can be specified via m680[01234]0
+
+Sat May 30 21:01:06 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * config.sub (basic_machine): fix sed so that '-foo' isn't
+ completely substituted out while .+'-foo' loses the '-foo'
+
+Wed May 27 23:18:52 1992 Michael Tiemann (tiemann@rtl.cygnus.com)
+
+ * config.sub ($os): Add -aout.
+
+Fri May 22 14:00:02 1992 Per Bothner (bothner@cygnus.com)
+
+ * configure: If host_makefile_frag is absolute, don't
+ prefix ${invsubdir} (relevant to libg++ auto-configure).
+
+Thu May 21 18:00:09 1992 Michael Tiemann (tiemann@rtl.cygnus.com)
+
+ * Makefile.in (tooldir): Define it.
+ (all-ld): Depend on all-flex.
+
+Sun May 10 21:45:59 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Makefile.in (check): Fix libg++ special case.
+
+Fri May 8 08:31:41 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * configure: do not bury `pwd` into config.status, thus do fewer
+ pwd's.
+
+ * configure: print the "Building in" message only when building in
+ other than "." AND verbose.
+
+ * configure: remove -s, rework -v to better accomodate guested
+ configures.
+
+ * standards.texi: updated to 3 may, fixed librid <-> libdir typo.
+
+Fri May 1 18:00:50 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in: macroize flags passed on recursion. remove
+ fileutils.
+
+Thu Apr 30 08:56:20 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * configure: get makesrcdir right for subdirs deeper than 1.
+
+ * Makefile.in: pass INSTALL, INSTALL_DATA, INSTALL_PROGRAM on
+ install.
+
+Fri Apr 24 15:51:51 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in: don't print subdir_do or recursion lines.
+
+Fri Apr 24 15:22:04 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * standards.texi: added menu item.
+
+ * Makefile.in: build and install standards.info.
+
+ * standards.texi: new file.
+
+Wed Apr 22 18:06:55 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * configure: test for and move config.status pieces from
+ ${subdir}/.
+
+Wed Apr 22 14:38:34 1992 Fred Fish (fnf@cygnus.com)
+
+ * config/mh-delta88, config/mh-ncr3000: Replace MINUS_G with
+ CFLAGS per new configuration strategy.
+ * configure: Test for existance of files before trying to mv
+ them, to avoid numerous non-existance messages.
+
+Tue Apr 21 12:31:33 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * configure: correct final line of config.status.
+
+ * configure: patch from eggert. Avoids a protection problem if
+ the original Makefile.in is read only.
+
+ * configure: use move-if-change from gcc to create config.status.
+ Some makefiles depend on config.status to tell if a directory
+ has been reconfigured for a different host. This change
+ prevents those directories from remaking everything in the case
+ where the reconfig was only intended to rebuild a Makefile.
+
+ * configure: test for config.sub with "config.sub sun4" rather
+ than "config.sub ${host_alias}". Otherwise we can't tell a bad
+ host alias from a missing config.sub.
+
+Mon Apr 20 18:16:36 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * Makefile.in: explicitly pass CFLAGS on recursion. no longer pass
+ MINUS_G (this can be done with CFLAGS). Default CFLAGS to -g.
+
+Fri Apr 17 18:27:51 1992 Per Bothner (bothner@cygnus.com)
+
+ * configure: mkdir ${subdir} as needed.
+
+Wed Apr 15 17:37:22 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in,configure.in: added autoconf.
+
+Wed Apr 15 17:27:34 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * Makefile.in: no longer pass against on recursion.
+
+ * Makefile.in: added .NOEXPORT: so that stray makefile_frag
+ definitions are not inherited.
+
+ * configure: correct makesrcdir when subdir is .
+
+Tue Apr 14 11:56:09 1992 Per Bothner (bothner@cygnus.com)
+
+ * configure: Add support for 'subdirs' variable, which is
+ like 'configdirs', except that configure doesn't re-invoke
+ itself for subdirs, it just creates a Makefile for each subdir.
+ * configure.texi: Document subdirs.
+
+Mon Apr 13 18:50:16 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: added flex to configdirs
+
+Mon Apr 13 18:43:55 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in: remove clean-stamps from clean.
+
+Sat Apr 11 03:52:03 1992 John Gilmore (gnu at cygnus.com)
+
+ * configure.in: Add gdbtest to configdirs.
+
+Fri Apr 10 23:11:49 1992 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in (MINUS_G): Add macro, default to -g, pass on
+ to recursive makes.
+ * configure.in: Recognize new ncr3000 config.
+
+Wed Apr 8 23:08:12 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in, configure.in: removed references to gdbm.
+
+Tue Apr 7 16:48:20 1992 Per Bothner (bothner@cygnus.com)
+
+ * config.sub: Don't canonicalize os value
+ newsos* to bsd (readline needs to check for newsos).
+ (This fix was earlier made Jan 31, but got re-broken.)
+
+Mon Apr 6 14:34:08 1992 Stu Grossman (grossman at cygnus.com)
+
+ * configure.in: sco is an os, not a vendor!
+
+ * configure: Quote $( better. Keep various shells happy.
+
+Tue Mar 31 16:32:57 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in: eliminate stamp-files.
+
+Mon Mar 30 22:20:23 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in: add send_pr. remove "force" from .stmp-gprof rule.
+ Supress echoing of all the "if [ -d ... $(MAKE)" lines.
+
+Wed Mar 25 15:20:04 1992 Stu Grossman (grossman@cygnus.com)
+
+ * config.sub: fix iris/iris3.
+
+Wed Mar 25 10:34:19 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * configure: re-add -rm.
+
+Tue Mar 24 23:50:16 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Maskefile.in: add .stmp-rcs to all.
+
+ * configure.in: remove gas from rs6000 build, use aix host fragment.
+
+Mon Mar 23 19:43:35 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * configure: pass down site_option during recursion.
+
+Thu Mar 19 16:49:36 1992 Stu Grossman (grossman at cygnus.com)
+
+ * Makefile.in (all.cross): Add .stmp-bfd .stmp-readline.
+
+Wed Mar 18 15:29:33 1992 Mike Stump (mrs@cygnus.com)
+
+ * configure: Change exec_prefix so that it really defaults to prefix.
+
+Sat Mar 14 17:20:38 1992 Fred Fish (fnf@cygnus.com)
+
+ * Makefile.in, configure.in: Add support for mmalloc library.
+
+Fri Mar 13 18:44:18 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in: add stmp dependencies for a few more things.
+
+Thu Mar 12 04:56:24 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * configure: adjusted error message on objdir/srcdir configure
+ collision, per john's suggestion.
+
+ * Makefile.in: add libiberty stmp to all and all.cross.
+
+Wed Mar 11 02:07:52 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in: remove force dependencies, add grep to all.
+
+Tue Mar 10 21:49:18 1992 K. Richard Pixley (rich@mars.cygnus.com)
+
+ * Makefile.in: drop flex. make stamp files work.
+
+ * configure: added test for conflicting configuration in srcdir,
+ remove trailing slashes from srcdir. Otherwise emacs gdb mode
+ gets cranky. use relative paths for configure and srcdir
+ whenever possible. Send some error messages to stderr that were
+ going to stdout.
+
+Tue Mar 10 18:01:55 1992 Per Bothner (bothner@cygnus.com)
+
+ * Makefile.in: Fix libg++ rule to check for gcc directory
+ before using gcc/gcc. Also pass XTRAFLAGS.
+
+Thu Mar 5 21:45:07 1992 K. Richard Pixley (rich@sendai)
+
+ * Makefile.in: added stmp-files so that directories aren't polled
+ when they are already built.
+
+ * configure.texi: fixed a node pointer problem.
+
+Thu Mar 5 12:05:58 1992 Stu Grossman (grossman at cygnus.com)
+
+ * config.sub configure.in config/mh-irix4 gdb/configure.in
+ gdb/mips-tdep.c gdb/mipsread.c gdb/procfs.c gdb/signame.h
+ gdb/tm-irix3.h gdb/tm-mips.h gdb/xm-irix4.h gdb/config/mt-irix3
+ gdb/config/mh-irix4 texinfo/configure.in: Port to SGI Irix-4.x.
+
+Wed Mar 4 02:57:46 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * configure: -recurring becomes -silent. corrected help message
+ for -site= option.
+
+ * Makefile.in: mkdir $(exec_prefix) and $(tooldir).
+
+Tue Mar 3 14:51:21 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * configure: when building Makefile for crosses, replace
+ tooldir and program_prefix. default srcdir from location of
+ config.sub. remove "for host in hosts" and "for target in
+ targets" loops.
+
+Wed Feb 26 19:48:25 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * Makefile.in: Do not pass bindir or mandir to cvs.
+
+Wed Feb 26 18:04:40 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in, configure.in: removed traces of namesubdir,
+ -subdirs, $(subdir), $(unsubdir), some rcs triggers. Forced
+ copyrights to '92, changed some from Cygnus to FSF.
+
+ * configure.texi: remove most references to multiple hosts,
+ multiple targets, subdirs, etc.
+
+ * configure.man: removed rcsid. reference config.sub not
+ config.subr.
+
+ * Makefile.in: mkdir $(infodir) on install-info.
+
+Wed Feb 19 15:41:13 1992 John Gilmore (gnu at cygnus.com)
+
+ * configure.texi: Explain better about .gdbinit and about
+ the environment that configure.in sections run in.
+
+Fri Feb 7 07:55:00 1992 John Gilmore (gnu at cygnus.com)
+
+ * configure.in: Ultrix is only a decstation if it's a MIPS.
+
+Fri Jan 31 21:54:51 1992 John Gilmore (gnu at cygnus.com)
+
+ * README: DOC.configure => cfg-paper.texi.
+
+Fri Jan 31 21:48:18 1992 Stu Grossman (grossman at cygnus.com)
+
+ * config.sub (near case $os): Don't convert newsos* to bsd!
+
+Fri Jan 31 02:27:32 1992 John Gilmore (gnu at cygnus.com)
+
+ * Makefile.in: Reinstall change from gdb-4.3 that reduces
+ the number of copies of COPYING that go into the GDB tar file.
+
+Thu Jan 30 16:17:30 1992 Stu Grossman (grossman at cygnus.com)
+
+ * bfd/configure.in, config/mh-sco, gdb/config/mh-i386sco,
+ gdb/config/mt-i386v32, gdb/configure.in, readline/configure.in:
+ Fix SCO configuration stuff.
+
+Tue Jan 28 23:51:07 1992 Per Bothner (bothner at cygnus.com)
+
+ * Makefile.in: For libg++, make sure the -I pointing
+ to the gcc directory goes *after* all the libg++-local -I flags.
+ Also, move just-gcc dependency from just-libg++ to all-libg++.
+
+Tue Jan 28 12:56:24 1992 Stu Grossman (grossman at cygnus.com)
+
+ * configure: Change -x to -f to keep Ultrix /bin/test happy.
+
+Sat Jan 18 17:45:11 1992 Stu Grossman (grossman at cygnus.com)
+
+ * Makefile.in (make-gdb.tar.Z): Remove texinfo targets.
+
+Sat Jan 18 17:03:21 1992 Fred Fish (fnf at cygnus.com)
+
+ * config.sub: Add stratus configuration frags. Also
+ submitted to FSF.
+
+Sat Jan 18 15:35:29 1992 Stu Grossman (grossman at cygnus.com)
+
+ * Makefile.in (DEV_SUPPORT): add configure.man.
+
+ * config.sub(Decode manufacturer-specific): add -none*.
+
+Fri Jan 17 17:58:05 1992 Stu Grossman (grossman at cygnus.com)
+
+ * Makefile.in: remove form feeds to make Sun's make happy.
+ (DEVO_SUPPORT): DOC.configure => cfg-paper.texi.
+
+Sat Jan 4 16:11:44 1992 John Gilmore (gnu at cygnus.com)
+
+ * Makefile.in (AR_FLAGS): Make quieter.
+
+Thu Jan 2 22:57:12 1992 John Gilmore (gnu at cygnus.com)
+
+ * configure.in: Add libg++.
+ * configure: When verbose, don't output the command line at each
+ level; it will be unremarkably the same as the previous version,
+ which will be the same as what the user typed.
+
+Fri Dec 27 16:26:47 1991 K. Richard Pixley (rich at cygnus.com)
+
+ * configure.in, Makefile.in: fix clean-info, add flex. add
+ fileutils.
+
+ * configure: be less sensitive to spaces in Makefile.in. Do not
+ look for sources in "..". Doing so breaks subdirectories that
+ might have their own configure. If a subdir has it's own
+ configure script, use it.
+
+Thu Dec 26 16:30:26 1991 K. Richard Pixley (rich at cygnus.com)
+
+ * cfg-paper.texi: some changes suggested by rms.
+
+Thu Dec 26 10:13:36 1991 Fred Fish (fnf at cygnus.com)
+
+ * config.sub: Merge in some small additions from the FSF version,
+ taken from the gcc distribution, to bring the Cygnus and FSF
+ versions into closer sync.
+
+Fri Dec 20 11:34:18 1991 Fred Fish (fnf at cygnus.com)
+
+ * configure.in: Changed svr4 references to sysv4.
+
+Thu Dec 19 15:54:29 1991 K. Richard Pixley (rich at cygnus.com)
+
+ * configure: added -V for version number option.
+
+Wed Dec 18 15:39:34 1991 K. Richard Pixley (rich at cygnus.com)
+
+ * DOC.configure, cfg-paper.texi: revised, updated, and texinfo'd.
+ renamed from DOC.configure to cfg-paper.texi.
+
+Mon Dec 16 23:05:19 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * configure, config.subr, config.sub: config.subr is now
+ config.sub again.
+
+Fri Dec 13 01:17:06 1991 K. Richard Pixley (rich at cygnus.com)
+
+ * configure.texi: new file, in progress.
+
+ * Makefile.in: build info file and install the man page for
+ configure.
+
+ * configure.man: new file, first cut.
+
+ * configure: find config.subr again now that configuration "none"
+ has gone. removed all traces of the -ansi option. removed all
+ traces of the -languages option.
+
+ * config.subr: resync from rms.
+
+Wed Dec 11 22:25:20 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * configure, config.sub, config.subr: merge config.sub into
+ config.subr, call the result config.subr, remove config.sub, use
+ config.subr.
+
+ * Makefile.in: revised install for dir.info.
+
+Tue Dec 10 00:04:35 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * configure.in: add decstation host makefile frag.
+
+ * Makefile.in: BISON now bison -y again. also install-gcc on
+ install. clean-gdbm on clean. infodir belongs in datadir.
+ Make directories for info install. Build dir.info here then
+ install it.
+
+Mon Dec 9 16:48:33 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * Makefile.in: fix for bad directory tests.
+
+Sat Dec 7 00:17:01 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * configure: \{1,2\} appears to be a sysv'ism. Use a different
+ regexp. -srcdir relative was being handled incorrectly.
+
+ * Makefile.in: unwrapped some for loops so that parallel makes
+ work again and so one can focus one's attention on a particular
+ package.
+
+Fri Dec 6 00:22:08 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * configure: added PWD as a stand in for `pwd` (for speed). use
+ elif wherever possible. make -srcdir work without -objdir.
+ -objdir= commented out.
+
+Thu Dec 5 22:46:52 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * configure: +options become --options. -subdirs commented out.
+ added -host, -datadir. Renamed -destdir to -prefix. Comment in
+ Makefile now at top of generated Makefile. Removed cvs log
+ entries. added -srcdir. create .gdbinit only if there is one
+ in ${srcdir}.
+
+ * Makefile.in: idestdir and ddestdir go away. Added copyrights
+ and shift gpl to v2. Added ChangeLog if it didn't exist. docdir
+ and mandir now keyed off datadir by default.
+
+Fri Nov 22 07:38:11 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * Freshly created ChangeLog.
+
+
+Local Variables:
+mode: change-log
+left-margin: 8
+fill-column: 76
+version-control: never
+End:
diff --git a/Makefile.in b/Makefile.in
new file mode 100644
index 00000000000..af7fb16c276
--- /dev/null
+++ b/Makefile.in
@@ -0,0 +1,1608 @@
+#
+# Makefile for directory with subdirs to build.
+# Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 1997 Free Software Foundation
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+
+srcdir = .
+
+prefix = /usr/local
+
+exec_prefix = $(prefix)
+bindir = $(exec_prefix)/bin
+libdir = $(exec_prefix)/lib
+tooldir = $(exec_prefix)/$(target)
+
+program_transform_name =
+
+datadir = $(prefix)/share
+mandir = $(prefix)/man
+man1dir = $(mandir)/man1
+man2dir = $(mandir)/man2
+man3dir = $(mandir)/man3
+man4dir = $(mandir)/man4
+man5dir = $(mandir)/man5
+man6dir = $(mandir)/man6
+man7dir = $(mandir)/man7
+man8dir = $(mandir)/man8
+man9dir = $(mandir)/man9
+infodir = $(prefix)/info
+includedir = $(prefix)/include
+GDB_NLM_DEPS =
+
+SHELL = /bin/sh
+
+# INSTALL_PROGRAM_ARGS is changed by configure.in to use -x for a
+# cygwin32 host.
+INSTALL_PROGRAM_ARGS =
+
+INSTALL = $(SHELL) $$s/install-sh -c
+INSTALL_PROGRAM = $(INSTALL) $(INSTALL_PROGRAM_ARGS)
+INSTALL_SCRIPT = $(INSTALL)
+INSTALL_DATA = $(INSTALL) -m 644
+
+INSTALL_DOSREL = install-dosrel-fake
+
+AS = as
+AR = ar
+AR_FLAGS = rc
+CC = cc
+
+# Special variables passed down in EXTRA_GCC_FLAGS. They are defined
+# here so that they can be overridden by Makefile fragments.
+HOST_CC = $(CC_FOR_BUILD)
+HOST_PREFIX =
+HOST_PREFIX_1 = loser-
+
+# These flag values are normally overridden by the configure script.
+CFLAGS = -g
+CXXFLAGS = -g -O2
+
+LIBCFLAGS = $(CFLAGS)
+CFLAGS_FOR_TARGET = $(CFLAGS)
+LDFLAGS_FOR_TARGET =
+LIBCFLAGS_FOR_TARGET = $(CFLAGS_FOR_TARGET)
+PICFLAG =
+PICFLAG_FOR_TARGET =
+
+CXX = c++
+
+# Use -O2 to stress test the compiler.
+LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates
+CXXFLAGS_FOR_TARGET = $(CXXFLAGS)
+LIBCXXFLAGS_FOR_TARGET = $(CXXFLAGS_FOR_TARGET) -fno-implicit-templates
+
+RANLIB = ranlib
+
+DLLTOOL = dlltool
+WINDRES = windres
+
+NM = nm
+
+LD = ld
+
+# Not plain GZIP, since gzip looks there for extra command-line options.
+GZIPPROG = gzip
+
+# These values are substituted by configure.
+DEFAULT_YACC = yacc
+DEFAULT_LEX = lex
+
+BISON = `if [ -f $$r/bison/bison ] ; then \
+ echo $$r/bison/bison -L $$s/bison/ ; \
+ else \
+ echo bison ; \
+ fi`
+
+YACC = `if [ -f $$r/bison/bison ] ; then \
+ echo $$r/bison/bison -y -L $$s/bison/ ; \
+ elif [ -f $$r/byacc/byacc ] ; then \
+ echo $$r/byacc/byacc ; \
+ else \
+ echo ${DEFAULT_YACC} ; \
+ fi`
+
+LEX = `if [ -f $$r/flex/flex ] ; \
+ then echo $$r/flex/flex ; \
+ else echo ${DEFAULT_LEX} ; fi`
+
+M4 = `if [ -f $$r/m4/m4 ] ; \
+ then echo $$r/m4/m4 ; \
+ else echo m4 ; fi`
+
+MAKEINFO = `if [ -f $$r/texinfo/makeinfo/Makefile ] ; \
+ then echo $$r/texinfo/makeinfo/makeinfo ; \
+ else echo makeinfo ; fi`
+
+# This just becomes part of the MAKEINFO definition passed down to
+# sub-makes. It lets flags be given on the command line while still
+# using the makeinfo from the object tree.
+MAKEINFOFLAGS =
+
+EXPECT = `if [ -f $$r/expect/expect ] ; \
+ then echo $$r/expect/expect ; \
+ else echo expect ; fi`
+
+RUNTEST = `if [ -f $$s/dejagnu/runtest ] ; \
+ then echo $$s/dejagnu/runtest ; \
+ else echo runtest ; fi`
+
+
+# compilers to use to create programs which must be run in the build
+# environment.
+CC_FOR_BUILD = $(CC)
+CXX_FOR_BUILD = $(CXX)
+
+SUBDIRS = "this is set via configure, don't edit this"
+OTHERS =
+
+# This is set by the configure script to the list of directories which
+# should be built using the target tools.
+TARGET_CONFIGDIRS = libiberty libgloss newlib libio librx libstdc++ libg++ winsup
+
+# Target libraries are put under this directory:
+# Changed by configure to $(target_alias) if cross.
+TARGET_SUBDIR = .
+
+# This is set by the configure script to the arguments passed to configure.
+CONFIG_ARGUMENTS =
+
+# This is set by configure to REALLY_SET_LIB_PATH if --enable-shared
+# was used.
+SET_LIB_PATH =
+
+# This is the name of the environment variable used for the path to
+# the libraries. This may be changed by configure.in.
+RPATH_ENVVAR = LD_LIBRARY_PATH
+
+# configure.in sets SET_LIB_PATH to this if --enable-shared was used.
+REALLY_SET_LIB_PATH = \
+ $(RPATH_ENVVAR)=$$r/bfd:$$r/opcodes:$$$(RPATH_ENVVAR); \
+ export $(RPATH_ENVVAR);
+
+ALL = all.normal
+INSTALL_TARGET = installdirs \
+ $(INSTALL_MODULES) \
+ $(INSTALL_TARGET_MODULES) \
+ $(INSTALL_X11_MODULES) \
+ install-gcc \
+ $(INSTALL_DOSREL)
+
+
+CC_FOR_TARGET = ` \
+ if [ -f $$r/gcc/xgcc ] ; then \
+ if [ -f $$r/$(TARGET_SUBDIR)/newlib/Makefile ] ; then \
+ if [ -f $$r/$(TARGET_SUBDIR)/winsup/Makefile ] ; then \
+ echo $$r/gcc/xgcc -B$$r/gcc/ -B$$r/newlib/ -L$$r/$(TARGET_SUBDIR)/winsup -idirafter $$r/$(TARGET_SUBDIR)/newlib/targ-include -idirafter $$s/newlib/libc/include -nostdinc; \
+ else \
+ echo $$r/gcc/xgcc -B$$r/gcc/ -idirafter $$r/$(TARGET_SUBDIR)/newlib/targ-include -idirafter $$s/newlib/libc/include -nostdinc; \
+ fi; \
+ else \
+ echo $$r/gcc/xgcc -B$$r/gcc/; \
+ fi; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(CC); \
+ else \
+ t='$(program_transform_name)'; echo gcc | sed -e 's/x/x/' $$t; \
+ fi; \
+ fi`
+
+# If CC_FOR_TARGET is not overriden on the command line, then this
+# variable is passed down to the gcc Makefile, where it is used to
+# build libgcc2.a. We define it here so that it can itself be
+# overridden on the command line.
+GCC_FOR_TARGET = $$r/gcc/xgcc -B$$r/gcc/
+
+
+CXX_FOR_TARGET = ` \
+ if [ -f $$r/gcc/xgcc ] ; then \
+ if [ -f $$r/$(TARGET_SUBDIR)/newlib/Makefile ] ; then \
+ if [ -f $$r/$(TARGET_SUBDIR)/winsup/Makefile ] ; then \
+ echo $$r/gcc/xgcc -B$$r/gcc/ -B$$r/newlib/ -L$$r/winsup -idirafter $$r/$(TARGET_SUBDIR)/newlib/targ-include -idirafter $$s/newlib/libc/include -nostdinc; \
+ else \
+ echo $$r/gcc/xgcc -B$$r/gcc/ -idirafter $$r/$(TARGET_SUBDIR)/newlib/targ-include -idirafter $$s/newlib/libc/include -nostdinc; \
+ fi; \
+ else \
+ echo $$r/gcc/xgcc -B$$r/gcc/; \
+ fi; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(CXX); \
+ else \
+ t='$(program_transform_name)'; echo c++ | sed -e 's/x/x/' $$t; \
+ fi; \
+ fi`
+
+AS_FOR_TARGET = ` \
+ if [ -f $$r/gas/as-new ] ; then \
+ echo $$r/gas/as-new ; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(AS); \
+ else \
+ t='$(program_transform_name)'; echo as | sed -e 's/x/x/' $$t ; \
+ fi; \
+ fi`
+
+LD_FOR_TARGET = ` \
+ if [ -f $$r/ld/ld-new ] ; then \
+ echo $$r/ld/ld-new ; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(LD); \
+ else \
+ t='$(program_transform_name)'; echo ld | sed -e 's/x/x/' $$t ; \
+ fi; \
+ fi`
+
+DLLTOOL_FOR_TARGET = ` \
+ if [ -f $$r/binutils/dlltool ] ; then \
+ echo $$r/binutils/dlltool ; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(DLLTOOL); \
+ else \
+ t='$(program_transform_name)'; echo dlltool | sed -e 's/x/x/' $$t ; \
+ fi; \
+ fi`
+
+WINDRES_FOR_TARGET = ` \
+ if [ -f $$r/binutils/windres ] ; then \
+ echo $$r/binutils/windres ; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(WINDRES); \
+ else \
+ t='$(program_transform_name)'; echo windres | sed -e 's/x/x/' $$t ; \
+ fi; \
+ fi`
+
+AR_FOR_TARGET = ` \
+ if [ -f $$r/binutils/ar ] ; then \
+ echo $$r/binutils/ar ; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(AR); \
+ else \
+ t='$(program_transform_name)'; echo ar | sed -e 's/x/x/' $$t ; \
+ fi; \
+ fi`
+
+RANLIB_FOR_TARGET = ` \
+ if [ -f $$r/binutils/ranlib ] ; then \
+ echo $$r/binutils/ranlib ; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(RANLIB); \
+ else \
+ t='$(program_transform_name)'; echo ranlib | sed -e 's/x/x/' $$t ; \
+ fi; \
+ fi`
+
+NM_FOR_TARGET = ` \
+ if [ -f $$r/binutils/nm-new ] ; then \
+ echo $$r/binutils/nm-new ; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ echo $(NM); \
+ else \
+ t='$(program_transform_name)'; echo nm | sed -e 's/x/x/' $$t ; \
+ fi; \
+ fi`
+
+#### host and target specific makefile fragments come in here.
+###
+
+# Flags to pass down to all sub-makes.
+# Please keep these in alphabetical order.
+BASE_FLAGS_TO_PASS = \
+ "AR_FLAGS=$(AR_FLAGS)" \
+ "AR_FOR_TARGET=$(AR_FOR_TARGET)" \
+ "AS_FOR_TARGET=$(AS_FOR_TARGET)" \
+ "BISON=$(BISON)" \
+ "CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+ "CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+ "CFLAGS=$(CFLAGS)" \
+ "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+ "CXX_FOR_BUILD=$(CXX_FOR_BUILD)" \
+ "CXXFLAGS=$(CXXFLAGS)" \
+ "CXXFLAGS_FOR_TARGET=$(CXXFLAGS_FOR_TARGET)" \
+ "CXX_FOR_TARGET=$(CXX_FOR_TARGET)" \
+ "DLLTOOL_FOR_TARGET=$(DLLTOOL_FOR_TARGET)" \
+ "INSTALL=$(INSTALL)" \
+ "INSTALL_DATA=$(INSTALL_DATA)" \
+ "INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+ "INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \
+ "LDFLAGS=$(LDFLAGS)" \
+ "LEX=$(LEX)" \
+ "LD_FOR_TARGET=$(LD_FOR_TARGET)" \
+ "LIBCFLAGS=$(LIBCFLAGS)" \
+ "LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \
+ "LIBCXXFLAGS=$(LIBCXXFLAGS)" \
+ "LIBCXXFLAGS_FOR_TARGET=$(LIBCXXFLAGS_FOR_TARGET)" \
+ "M4=$(M4)" \
+ "MAKE=$(MAKE)" \
+ "MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \
+ "NM_FOR_TARGET=$(NM_FOR_TARGET)" \
+ "PICFLAG=$(PICFLAG)" \
+ "PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \
+ "RANLIB_FOR_TARGET=$(RANLIB_FOR_TARGET)" \
+ "SHELL=$(SHELL)" \
+ "EXPECT=$(EXPECT)" \
+ "RUNTEST=$(RUNTEST)" \
+ "RUNTESTFLAGS=$(RUNTESTFLAGS)" \
+ "WINDRES_FOR_TARGET=$(WINDRES_FOR_TARGET)" \
+ "YACC=$(YACC)" \
+ "exec_prefix=$(exec_prefix)" \
+ "prefix=$(prefix)" \
+ "tooldir=$(tooldir)"
+
+# Flags to pass down to most sub-makes, in which we're building with
+# the host environment.
+# If any variables are added here, they must be added to do-*, below.
+EXTRA_HOST_FLAGS = \
+ 'AR=$(AR)' \
+ 'AS=$(AS)' \
+ 'CC=$(CC)' \
+ 'CXX=$(CXX)' \
+ 'DLLTOOL=$(DLLTOOL)' \
+ 'LD=$(LD)' \
+ 'NM=$(NM)' \
+ 'RANLIB=$(RANLIB)' \
+ 'WINDRES=$(WINDRES)'
+
+FLAGS_TO_PASS = $(BASE_FLAGS_TO_PASS) $(EXTRA_HOST_FLAGS)
+
+# Flags that are concerned with the location of the X11 include files
+# and library files
+#
+# NOTE: until the top-level is getting the values via autoconf, it only
+# causes problems to have this top-level Makefile overriding the autoconf-set
+# values in child directories. Only variables that don't conflict with
+# autoconf'ed ones should be passed by X11_FLAGS_TO_PASS for now.
+#
+X11_FLAGS_TO_PASS = \
+ 'X11_EXTRA_CFLAGS=$(X11_EXTRA_CFLAGS)' \
+ 'X11_EXTRA_LIBS=$(X11_EXTRA_LIBS)'
+
+# Flags to pass down to makes which are built with the target environment.
+# The double $ decreases the length of the command line; the variables
+# are set in BASE_FLAGS_TO_PASS, and the sub-make will expand them.
+# If any variables are added here, they must be added to do-*, below.
+EXTRA_TARGET_FLAGS = \
+ 'AR=$$(AR_FOR_TARGET)' \
+ 'AS=$$(AS_FOR_TARGET)' \
+ 'CC=$$(CC_FOR_TARGET)' \
+ 'CFLAGS=$$(CFLAGS_FOR_TARGET)' \
+ 'CXX=$$(CXX_FOR_TARGET)' \
+ 'CXXFLAGS=$$(CXXFLAGS_FOR_TARGET)' \
+ 'DLLTOOL=$$(DLLTOOL_FOR_TARGET)' \
+ 'LD=$$(LD_FOR_TARGET)' \
+ 'LIBCFLAGS=$$(LIBCFLAGS_FOR_TARGET)' \
+ 'LIBCXXFLAGS=$$(LIBCXXFLAGS_FOR_TARGET)' \
+ 'NM=$$(NM_FOR_TARGET)' \
+ 'PICFLAG=$$(PICFLAG_FOR_TARGET)' \
+ 'RANLIB=$$(RANLIB_FOR_TARGET)' \
+ 'WINDRES=$$(WINDRES_FOR_TARGET)'
+
+TARGET_FLAGS_TO_PASS = $(BASE_FLAGS_TO_PASS) $(EXTRA_TARGET_FLAGS)
+
+# Flags to pass down to gcc. gcc builds a library, libgcc.a, so it
+# unfortunately needs the native compiler and the target ar and
+# ranlib.
+# If any variables are added here, they must be added to do-*, below.
+# The HOST_* variables are a special case, which are used for the gcc
+# cross-building scheme.
+EXTRA_GCC_FLAGS = \
+ 'AR=$$(AR_FOR_TARGET)' \
+ 'AS=$(AS)' \
+ 'CC=$(CC)' \
+ 'CXX=$(CXX)' \
+ 'DLLTOOL=$$(DLLTOOL_FOR_TARGET)' \
+ 'HOST_CC=$(CC_FOR_BUILD)' \
+ 'HOST_PREFIX=$(HOST_PREFIX)' \
+ 'HOST_PREFIX_1=$(HOST_PREFIX_1)' \
+ 'NM=$(NM)' \
+ 'RANLIB=$$(RANLIB_FOR_TARGET)' \
+ 'WINDRES=$$(WINDRES_FOR_TARGET)' \
+ "GCC_FOR_TARGET=$(GCC_FOR_TARGET)" \
+ "`if test x'$(LANGUAGES)' != x; then echo 'LANGUAGES=$(LANGUAGES)'; else echo 'XFOO=bar'; fi`" \
+ "`if test x'$(STMP_FIXPROTO)' != x; then echo 'STMP_FIXPROTO=$(STMP_FIXPROTO)'; else echo 'XFOO=bar'; fi`" \
+ "`if test x'$(LIMITS_H_TEST)' != x; then echo 'LIMITS_H_TEST=$(LIMITS_H_TEST)'; else echo 'XFOO=bar'; fi`" \
+ "`if test x'$(LIBGCC1_TEST)' != x; then echo 'LIBGCC1_TEST=$(LIBGCC1_TEST)'; else echo 'XFOO=bar'; fi`" \
+ "`if test x'$(LIBGCC2_CFLAGS)' != x; then echo 'LIBGCC2_CFLAGS=$(LIBGCC2_CFLAGS)'; else echo 'XFOO=bar'; fi`" \
+ "`if test x'$(LIBGCC2_DEBUG_CFLAGS)' != x; then echo 'LIBGCC2_DEBUG_CFLAGS=$(LIBGCC2_DEBUG_CFLAGS)'; else echo 'XFOO=bar'; fi`" \
+ "`if test x'$(LIBGCC2_INCLUDES)' != x; then echo 'LIBGCC2_INCLUDES=$(LIBGCC2_INCLUDES)'; else echo 'XFOO=bar'; fi`" \
+ "`if test x'$(ENQUIRE)' != x; then echo 'ENQUIRE=$(ENQUIRE)'; else echo 'XFOO=bar'; fi`" \
+ "`if test x'$(BOOT_CFLAGS)' != x; then echo 'BOOT_CFLAGS=$(BOOT_CFLAGS)'; else echo 'XFOO=bar'; fi`"
+
+GCC_FLAGS_TO_PASS = $(BASE_FLAGS_TO_PASS) $(EXTRA_GCC_FLAGS)
+
+# This is a list of the targets for all of the modules which are compiled
+# using $(FLAGS_TO_PASS).
+ALL_MODULES = \
+ all-apache \
+ all-autoconf \
+ all-automake \
+ all-bash \
+ all-bfd \
+ all-binutils \
+ all-bison \
+ all-byacc \
+ all-cvs \
+ all-db \
+ all-dejagnu \
+ all-diff \
+ all-dosutils \
+ all-etc \
+ all-fileutils \
+ all-findutils \
+ all-find \
+ all-flex \
+ all-gas \
+ all-gawk \
+ all-gnuserv \
+ all-gprof \
+ all-grep \
+ all-grez \
+ all-gzip \
+ all-hello \
+ all-indent \
+ all-inet \
+ all-ispell \
+ all-itcl \
+ all-ld \
+ all-libiberty \
+ all-m4 \
+ all-make \
+ all-mmalloc \
+ all-opcodes \
+ all-patch \
+ all-perl \
+ all-prms \
+ all-rcs \
+ all-readline \
+ all-release \
+ all-recode \
+ all-sed \
+ all-send-pr \
+ all-shellutils \
+ all-sim \
+ all-sn \
+ all-tar \
+ all-tcl \
+ all-texinfo \
+ all-textutils \
+ all-tgas \
+ all-time \
+ all-uudecode \
+ all-wdiff
+
+# This is a list of the check targets for all of the modules which are
+# compiled using $(FLAGS_TO_PASS).
+#
+# The list is in two parts. The first lists those tools which
+# are tested as part of the host's native tool-chain, and not
+# tested in a cross configuration.
+NATIVE_CHECK_MODULES = \
+ check-bison \
+ check-byacc \
+ check-flex
+
+CROSS_CHECK_MODULES = \
+ check-apache \
+ check-autoconf \
+ check-automake \
+ check-bash \
+ check-bfd \
+ check-binutils \
+ check-cvs \
+ check-db \
+ check-dejagnu \
+ check-diff \
+ check-etc \
+ check-fileutils \
+ check-findutils \
+ check-find \
+ check-gas \
+ check-gawk \
+ check-gnuserv \
+ check-gprof \
+ check-grep \
+ check-gzip \
+ check-hello \
+ check-indent \
+ check-inet \
+ check-ispell \
+ check-itcl \
+ check-ld \
+ check-libiberty \
+ check-m4 \
+ check-make \
+ check-mmcheckoc \
+ check-opcodes \
+ check-patch \
+ check-perl \
+ check-prms \
+ check-rcs \
+ check-readline \
+ check-recode \
+ check-sed \
+ check-send-pr \
+ check-shellutils \
+ check-sn \
+ check-sim \
+ check-tar \
+ check-tcl \
+ check-texinfo \
+ check-textutils \
+ check-tgas \
+ check-time \
+ check-uudecode \
+ check-wdiff
+
+CHECK_MODULES=$(NATIVE_CHECK_MODULES) $(CROSS_CHECK_MODULES)
+
+# This is a list of the install targets for all of the modules which are
+# compiled using $(FLAGS_TO_PASS).
+# We put install-opcodes before install-binutils because the installed
+# binutils might be on PATH, and they might need the shared opcodes
+# library.
+INSTALL_MODULES = \
+ install-apache \
+ install-autoconf \
+ install-automake \
+ install-bash \
+ install-bfd \
+ install-opcodes \
+ install-binutils \
+ install-bison \
+ install-byacc \
+ install-cvs \
+ install-db \
+ install-dejagnu \
+ install-diff \
+ install-dosutils \
+ install-etc \
+ install-fileutils \
+ install-findutils \
+ install-find \
+ install-flex \
+ install-gas \
+ install-gawk \
+ install-gnuserv \
+ install-gprof \
+ install-grep \
+ install-grez \
+ install-gzip \
+ install-hello \
+ install-indent \
+ install-inet \
+ install-ispell \
+ install-itcl \
+ install-ld \
+ install-libiberty \
+ install-m4 \
+ install-make \
+ install-mmalloc \
+ install-patch \
+ install-perl \
+ install-prms \
+ install-rcs \
+ install-readline \
+ install-recode \
+ install-sed \
+ install-send-pr \
+ install-shellutils \
+ install-sim \
+ install-sn \
+ install-tar \
+ install-tcl \
+ install-texinfo \
+ install-textutils \
+ install-tgas \
+ install-time \
+ install-uudecode \
+ install-wdiff
+
+# This is a list of the targets for all of the modules which are compiled
+# using $(X11_FLAGS_TO_PASS).
+ALL_X11_MODULES = \
+ all-emacs \
+ all-emacs19 \
+ all-gdb \
+ all-expect \
+ all-gash \
+ all-guile \
+ all-tclX \
+ all-tk \
+ all-tix
+
+# This is a list of the check targets for all of the modules which are
+# compiled using $(X11_FLAGS_TO_PASS).
+CHECK_X11_MODULES = \
+ check-emacs \
+ check-gdb \
+ check-guile \
+ check-expect \
+ check-gash \
+ check-tclX \
+ check-tk \
+ check-tix
+
+# This is a list of the install targets for all the modules which are
+# compiled using $(X11_FLAGS_TO_PASS).
+INSTALL_X11_MODULES = \
+ install-emacs \
+ install-emacs19 \
+ install-gdb \
+ install-guile \
+ install-expect \
+ install-gash \
+ install-tclX \
+ install-tk \
+ install-tix
+
+# This is a list of the targets for all of the modules which are compiled
+# using $(TARGET_FLAGS_TO_PASS).
+ALL_TARGET_MODULES = \
+ all-target-libio \
+ all-target-libstdc++ \
+ all-target-librx \
+ all-target-libg++ \
+ all-target-newlib \
+ all-target-winsup \
+ all-target-libgloss \
+ all-target-libiberty \
+ all-target-gperf \
+ all-target-examples
+
+# This is a list of the configure targets for all of the modules which
+# are compiled using the target tools.
+CONFIGURE_TARGET_MODULES = \
+ configure-target-libio \
+ configure-target-libstdc++ \
+ configure-target-librx \
+ configure-target-libg++ \
+ configure-target-newlib \
+ configure-target-winsup \
+ configure-target-libgloss \
+ configure-target-libiberty \
+ configure-target-gperf \
+ configure-target-examples
+
+# This is a list of the check targets for all of the modules which are
+# compiled using $(TARGET_FLAGS_TO_PASS).
+CHECK_TARGET_MODULES = \
+ check-target-libio \
+ check-target-libstdc++ \
+ check-target-libg++ \
+ check-target-newlib \
+ check-target-winsup \
+ check-target-libiberty \
+ check-target-gperf
+
+# This is a list of the install targets for all of the modules which are
+# compiled using $(TARGET_FLAGS_TO_PASS).
+INSTALL_TARGET_MODULES = \
+ install-target-libio \
+ install-target-libstdc++ \
+ install-target-libg++ \
+ install-target-newlib \
+ install-target-winsup \
+ install-target-libgloss \
+ install-target-libiberty \
+ install-target-gperf
+
+# This is a list of the targets for which we can do a clean-{target}.
+CLEAN_MODULES = \
+ clean-apache \
+ clean-autoconf \
+ clean-automake \
+ clean-bash \
+ clean-bfd \
+ clean-binutils \
+ clean-bison \
+ clean-byacc \
+ clean-cvs \
+ clean-db \
+ clean-dejagnu \
+ clean-diff \
+ clean-dosutils \
+ clean-etc \
+ clean-fileutils \
+ clean-findutils \
+ clean-find \
+ clean-flex \
+ clean-gas \
+ clean-gawk \
+ clean-gnuserv \
+ clean-gprof \
+ clean-grep \
+ clean-grez \
+ clean-gzip \
+ clean-hello \
+ clean-indent \
+ clean-inet \
+ clean-ispell \
+ clean-itcl \
+ clean-ld \
+ clean-libiberty \
+ clean-m4 \
+ clean-make \
+ clean-mmalloc \
+ clean-opcodes \
+ clean-patch \
+ clean-perl \
+ clean-prms \
+ clean-rcs \
+ clean-readline \
+ clean-release \
+ clean-recode \
+ clean-sed \
+ clean-send-pr \
+ clean-shellutils \
+ clean-sim \
+ clean-sn \
+ clean-tar \
+ clean-tcl \
+ clean-texinfo \
+ clean-textutils \
+ clean-tgas \
+ clean-time \
+ clean-uudecode \
+ clean-wdiff
+
+# All of the target modules that can be cleaned
+CLEAN_TARGET_MODULES = \
+ clean-target-libio \
+ clean-target-libstdc++ \
+ clean-target-librx \
+ clean-target-libg++ \
+ clean-target-newlib \
+ clean-target-winsup \
+ clean-target-libgloss \
+ clean-target-libiberty \
+ clean-target-gperf \
+ clean-target-examples
+
+# All of the x11 modules that can be cleaned
+CLEAN_X11_MODULES = \
+ clean-emacs \
+ clean-emacs19 \
+ clean-gdb \
+ clean-expect \
+ clean-gash \
+ clean-guile \
+ clean-tclX \
+ clean-tk \
+ clean-tix
+
+# The first rule in the file had better be this one. Don't put any above it.
+all: all.normal
+.PHONY: all
+
+# The target built for a native build.
+.PHONY: all.normal
+all.normal: \
+ $(ALL_MODULES) \
+ $(ALL_X11_MODULES) \
+ $(ALL_TARGET_MODULES) \
+ all-gcc
+
+# Do a target for all the subdirectories. A ``make do-X'' will do a
+# ``make X'' in all subdirectories (because, in general, there is a
+# dependency (below) of X upon do-X, a ``make X'' will also do this,
+# but it may do additional work as well).
+# This target ensures that $(BASE_FLAGS_TO_PASS) appears only once,
+# because it is so large that it can easily overflow the command line
+# length limit on some systems.
+DO_X = \
+ do-clean \
+ do-distclean \
+ do-dvi \
+ do-info \
+ do-install-info \
+ do-installcheck \
+ do-mostlyclean \
+ do-maintainer-clean \
+ do-TAGS
+.PHONY: $(DO_X)
+$(DO_X):
+ @target=`echo $@ | sed -e 's/^do-//'`; \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ for i in $(SUBDIRS) -dummy-; do \
+ if [ -f ./$$i/Makefile ]; then \
+ case $$i in \
+ gcc) \
+ for flag in $(EXTRA_GCC_FLAGS); do \
+ eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'|"`; \
+ done; \
+ ;; \
+ *) \
+ for flag in $(EXTRA_HOST_FLAGS); do \
+ eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'|"`; \
+ done; \
+ ;; \
+ esac ; \
+ export AR AS CC CXX LD NM RANLIB DLLTOOL WINDRES; \
+ if (cd ./$$i; \
+ $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+ "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+ "RANLIB=$${RANLIB}" \
+ "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
+ $${target}); \
+ then true; else exit 1; fi; \
+ else true; fi; \
+ done
+ @target=`echo $@ | sed -e 's/^do-//'`; \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ for i in $(TARGET_CONFIGDIRS) -dummy-; do \
+ if [ -f $(TARGET_SUBDIR)/$$i/Makefile ]; then \
+ for flag in $(EXTRA_TARGET_FLAGS); do \
+ eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'|"`; \
+ done; \
+ export AR AS CC CXX LD NM RANLIB DLLTOOL WINDRES; \
+ if (cd $(TARGET_SUBDIR)/$$i; \
+ $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \
+ "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \
+ "RANLIB=$${RANLIB}" \
+ "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" \
+ $${target}); \
+ then true; else exit 1; fi; \
+ else true; fi; \
+ done
+
+# Here are the targets which correspond to the do-X targets.
+
+.PHONY: info installcheck dvi install-info
+.PHONY: clean distclean mostlyclean maintainer-clean realclean
+.PHONY: local-clean local-distclean local-maintainer-clean
+info: do-info
+installcheck: do-installcheck
+dvi: do-dvi
+
+# Make sure makeinfo is built before we do a `make info'.
+do-info: all-texinfo
+
+install-info: do-install-info dir.info
+ s=`cd $(srcdir); pwd`; export s; \
+ if [ -f dir.info ] ; then \
+ $(INSTALL_DATA) dir.info $(infodir)/dir.info ; \
+ else true ; fi
+
+local-clean:
+ -rm -f *.a TEMP errs core *.o *~ \#* TAGS *.E
+
+local-distclean:
+ -rm -f Makefile config.status config.cache
+ -if [ "$(TARGET_SUBDIR)" != "." ]; then \
+ rm -rf $(TARGET_SUBDIR); \
+ else true; fi
+
+local-maintainer-clean:
+ @echo "This command is intended for maintainers to use;"
+ @echo "it deletes files that may require special tools to rebuild."
+
+clean: do-clean local-clean
+mostlyclean: do-mostlyclean local-clean
+distclean: do-distclean local-clean local-distclean
+maintainer-clean: local-maintainer-clean do-maintainer-clean local-clean
+maintainer-clean: local-distclean
+realclean: maintainer-clean
+
+# This rule is used to clean specific modules.
+.PHONY: $(CLEAN_MODULES) $(CLEAN_X11_MODULES) clean-gcc
+$(CLEAN_MODULES) $(CLEAN_X11_MODULES) clean-gcc:
+ @dir=`echo $@ | sed -e 's/clean-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; $(MAKE) $(FLAGS_TO_PASS) clean); \
+ else \
+ true; \
+ fi
+
+.PHONY: $(CLEAN_TARGET_MODULES)
+$(CLEAN_TARGET_MODULES):
+ @dir=`echo $@ | sed -e 's/clean-target-//'`; \
+ rm -f $(TARGET_SUBDIR)/$${dir}/multilib.out $(TARGET_SUBDIR)/$${dir}/tmpmulti.out; \
+ if [ -f $(TARGET_SUBDIR)/$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $(TARGET_SUBDIR)/$${dir}; $(MAKE) $(TARGET_FLAGS_TO_PASS) clean); \
+ else \
+ true; \
+ fi
+
+clean-target: $(CLEAN_TARGET_MODULES)
+
+# Check target.
+
+.PHONY: check
+check: $(CHECK_MODULES) \
+ $(CHECK_TARGET_MODULES) \
+ $(CHECK_X11_MODULES) \
+ check-gcc
+
+# Installation targets.
+
+.PHONY: install uninstall source-vault binary-vault vault-install
+install: $(INSTALL_TARGET)
+
+uninstall:
+ @echo "the uninstall target is not supported in this tree"
+
+source-vault:
+ $(MAKE) -f ./release/Build-A-Release \
+ host=$(host_alias) source-vault
+
+binary-vault:
+ $(MAKE) -f ./release/Build-A-Release \
+ host=$(host_alias) target=$(target_alias)
+
+vault-install:
+ @if [ -f ./release/vault-install ] ; then \
+ ./release/vault-install $(host_alias) $(target_alias) ; \
+ else \
+ true ; \
+ fi
+
+.PHONY: install.all
+install.all: install-no-fixedincludes
+ @if [ -f ./gcc/Makefile ] ; then \
+ r=`pwd` ; export r ; \
+ $(SET_LIB_PATH) \
+ (cd ./gcc; \
+ $(MAKE) $(FLAGS_TO_PASS) install-headers) ; \
+ else \
+ true ; \
+ fi
+
+# inet-install is used because the I*Net wants DejaGNU installed but
+# not built. Similarly, gzip is built but not installed.
+inet-install:
+ $(MAKE) INSTALL_MODULES="`echo $(INSTALL_MODULES) | sed -e 's/install-dejagnu//' -e 's/install-gzip//'`" install
+
+# install-no-fixedincludes is used because Cygnus can not distribute
+# the fixed header files.
+.PHONY: install-no-fixedincludes
+install-no-fixedincludes: \
+ installdirs \
+ $(INSTALL_MODULES) \
+ $(INSTALL_TARGET_MODULES) \
+ $(INSTALL_X11_MODULES) \
+ gcc-no-fixedincludes
+
+# Install the gcc headers files, but not the fixed include files,
+# which Cygnus is not allowed to distribute. This rule is very
+# dependent on the workings of the gcc Makefile.in.
+.PHONY: gcc-no-fixedincludes
+gcc-no-fixedincludes:
+ @if [ -f ./gcc/Makefile ]; then \
+ rm -rf gcc/tmp-include; \
+ mv gcc/include gcc/tmp-include 2>/dev/null; \
+ mkdir gcc/include; \
+ cp $(srcdir)/gcc/gsyslimits.h gcc/include/syslimits.h; \
+ touch gcc/stmp-fixinc gcc/include/fixed; \
+ rm -f gcc/stmp-headers gcc/stmp-int-hdrs; \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd` ; export s; \
+ $(SET_LIB_PATH) \
+ (cd ./gcc; \
+ $(MAKE) $(GCC_FLAGS_TO_PASS) install); \
+ rm -rf gcc/include; \
+ mv gcc/tmp-include gcc/include 2>/dev/null; \
+ else true; fi
+
+# This rule is used to build the modules which use FLAGS_TO_PASS. To
+# build a target all-X means to cd to X and make all.
+#
+# all-gui, and all-libproc are handled specially because
+# they are still experimental, and if they fail to build, that
+# shouldn't stop "make all".
+.PHONY: $(ALL_MODULES) all-gui all-libproc
+$(ALL_MODULES) all-gui all-libproc:
+ @dir=`echo $@ | sed -e 's/all-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; $(MAKE) $(FLAGS_TO_PASS) all); \
+ else \
+ true; \
+ fi
+
+# These rules are used to check the modules which use FLAGS_TO_PASS.
+# To build a target check-X means to cd to X and make check. Some
+# modules are only tested in a native toolchain.
+
+.PHONY: $(CHECK_MODULES) $(NATIVE_CHECK_MODULES) $(CROSS_CHECK_MODULES)
+$(NATIVE_CHECK_MODULES):
+ @if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+ dir=`echo $@ | sed -e 's/check-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; $(MAKE) $(FLAGS_TO_PASS) check); \
+ else \
+ true; \
+ fi; \
+ fi
+
+$(CROSS_CHECK_MODULES):
+ @dir=`echo $@ | sed -e 's/check-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; $(MAKE) $(FLAGS_TO_PASS) check); \
+ else \
+ true; \
+ fi
+
+# This rule is used to install the modules which use FLAGS_TO_PASS.
+# To build a target install-X means to cd to X and make install.
+.PHONY: $(INSTALL_MODULES)
+$(INSTALL_MODULES): installdirs
+ @dir=`echo $@ | sed -e 's/install-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; $(MAKE) $(FLAGS_TO_PASS) install); \
+ else \
+ true; \
+ fi
+
+# This rule is used to configure the modules which are built with the
+# target tools.
+.PHONY: $(CONFIGURE_TARGET_MODULES)
+$(CONFIGURE_TARGET_MODULES):
+ @dir=`echo $@ | sed -e 's/configure-target-//'`; \
+ if [ -d $(TARGET_SUBDIR)/$${dir} ]; then \
+ r=`pwd`; export r; \
+ $(CC_FOR_TARGET) --print-multi-lib > $(TARGET_SUBDIR)/$${dir}/tmpmulti.out 2> /dev/null; \
+ if [ -s $(TARGET_SUBDIR)/$${dir}/tmpmulti.out ]; then \
+ if [ -f $(TARGET_SUBDIR)/$${dir}/multilib.out ]; then \
+ if cmp $(TARGET_SUBDIR)/$${dir}/multilib.out $(TARGET_SUBDIR)/$${dir}/tmpmulti.out > /dev/null; then \
+ rm -f $(TARGET_SUBDIR)/$${dir}/tmpmulti.out; \
+ else \
+ echo "Multilibs changed for $${dir}, reconfiguring"; \
+ rm -f $(TARGET_SUBDIR)/$${dir}/multilib.out $(TARGET_SUBDIR)/$${dir}/Makefile; \
+ mv $(TARGET_SUBDIR)/$${dir}/tmpmulti.out $(TARGET_SUBDIR)/$${dir}/multilib.out; \
+ fi; \
+ else \
+ mv $(TARGET_SUBDIR)/$${dir}/tmpmulti.out $(TARGET_SUBDIR)/$${dir}/multilib.out; \
+ fi; \
+ fi; \
+ fi; exit 0 # break command into two pieces
+ @dir=`echo $@ | sed -e 's/configure-target-//'`; \
+ if [ ! -d $(TARGET_SUBDIR) ]; then \
+ true; \
+ elif [ -f $(TARGET_SUBDIR)/$${dir}/Makefile ] ; then \
+ true; \
+ elif echo " $(TARGET_CONFIGDIRS) " | grep " $${dir} " >/dev/null 2>&1; then \
+ if [ -d $(srcdir)/$${dir} ]; then \
+ [ -d $(TARGET_SUBDIR)/$${dir} ] || mkdir $(TARGET_SUBDIR)/$${dir};\
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ AR="$(AR_FOR_TARGET)"; export AR; \
+ AS="$(AS_FOR_TARGET)"; export AS; \
+ CC="$(CC_FOR_TARGET)"; export CC; \
+ CFLAGS="$(CFLAGS_FOR_TARGET)"; export CFLAGS; \
+ CXX="$(CXX_FOR_TARGET)"; export CXX; \
+ CXXFLAGS="$(CXXFLAGS_FOR_TARGET)"; export CXXFLAGS; \
+ DLLTOOL="$(DLLTOOL_FOR_TARGET)"; export DLLTOOL; \
+ LD="$(LD_FOR_TARGET)"; export LD; \
+ LDFLAGS="$(LDFLAGS_FOR_TARGET)"; export LDFLAGS; \
+ NM="$(NM_FOR_TARGET)"; export NM; \
+ RANLIB="$(RANLIB_FOR_TARGET)"; export RANLIB; \
+ WINDRES="$(WINDRES_FOR_TARGET)"; export WINDRES; \
+ echo Configuring in $(TARGET_SUBDIR)/$${dir}; \
+ cd $(TARGET_SUBDIR)/$${dir}; \
+ case $(srcdir) in \
+ /*) \
+ topdir=$(srcdir) ;; \
+ *) \
+ case "$(TARGET_SUBDIR)" in \
+ .) topdir="../$(srcdir)" ;; \
+ *) topdir="../../$(srcdir)" ;; \
+ esac ;; \
+ esac; \
+ if [ "$(srcdir)" = "." ] ; then \
+ if [ "$(TARGET_SUBDIR)" != "." ] ; then \
+ if $(SHELL) $$s/symlink-tree $${topdir}/$${dir} "no-such-file" ; then \
+ if [ -f Makefile ]; then \
+ if $(MAKE) distclean; then \
+ true; \
+ else \
+ exit 1; \
+ fi; \
+ else \
+ true; \
+ fi; \
+ else \
+ exit 1; \
+ fi; \
+ else \
+ true; \
+ fi; \
+ srcdiroption="--srcdir=."; \
+ libsrcdir="."; \
+ else \
+ srcdiroption="--srcdir=$${topdir}/$${dir}"; \
+ libsrcdir="$$s/$${dir}"; \
+ fi; \
+ if [ -f $${libsrcdir}/configure ] ; then \
+ $(SHELL) $${libsrcdir}/configure \
+ $(CONFIG_ARGUMENTS) $${srcdiroption} \
+ --with-target-subdir="$(TARGET_SUBDIR)"; \
+ else \
+ $(SHELL) $$s/configure \
+ $(CONFIG_ARGUMENTS) $${srcdiroption} \
+ --with-target-subdir="$(TARGET_SUBDIR)"; \
+ fi; \
+ else \
+ true; \
+ fi; \
+ else \
+ true; \
+ fi
+
+# This rule is used to build the modules which use TARGET_FLAGS_TO_PASS.
+# To build a target all-X means to cd to X and make all.
+.PHONY: $(ALL_TARGET_MODULES)
+$(ALL_TARGET_MODULES):
+ @dir=`echo $@ | sed -e 's/all-target-//'`; \
+ if [ -f $(TARGET_SUBDIR)/$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $(TARGET_SUBDIR)/$${dir}; $(MAKE) $(TARGET_FLAGS_TO_PASS) all); \
+ else \
+ true; \
+ fi
+
+# This rule is used to check the modules which use TARGET_FLAGS_TO_PASS.
+# To build a target install-X means to cd to X and make install.
+.PHONY: $(CHECK_TARGET_MODULES)
+$(CHECK_TARGET_MODULES):
+ @dir=`echo $@ | sed -e 's/check-target-//'`; \
+ if [ -f $(TARGET_SUBDIR)/$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $(TARGET_SUBDIR)/$${dir};$(MAKE) $(TARGET_FLAGS_TO_PASS) check);\
+ else \
+ true; \
+ fi
+
+# This rule is used to install the modules which use
+# TARGET_FLAGS_TO_PASS. To build a target install-X means to cd to X
+# and make install.
+.PHONY: $(INSTALL_TARGET_MODULES)
+$(INSTALL_TARGET_MODULES): installdirs
+ @dir=`echo $@ | sed -e 's/install-target-//'`; \
+ if [ -f $(TARGET_SUBDIR)/$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $(TARGET_SUBDIR)/$${dir}; \
+ $(MAKE) $(TARGET_FLAGS_TO_PASS) install); \
+ else \
+ true; \
+ fi
+
+# This rule is used to build the modules which use X11_FLAGS_TO_PASS.
+# To build a target all-X means to cd to X and make all.
+.PHONY: $(ALL_X11_MODULES)
+$(ALL_X11_MODULES):
+ @dir=`echo $@ | sed -e 's/all-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; \
+ $(MAKE) $(FLAGS_TO_PASS) $(X11_FLAGS_TO_PASS) all); \
+ else \
+ true; \
+ fi
+
+# This rule is used to check the modules which use X11_FLAGS_TO_PASS.
+# To build a target check-X means to cd to X and make all.
+.PHONY: $(CHECK_X11_MODULES)
+$(CHECK_X11_MODULES):
+ @dir=`echo $@ | sed -e 's/check-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; \
+ $(MAKE) $(FLAGS_TO_PASS) $(X11_FLAGS_TO_PASS) check); \
+ else \
+ true; \
+ fi
+
+# This rule is used to install the modules which use X11_FLAGS_TO_PASS.
+# To build a target install-X means to cd to X and make install.
+.PHONY: $(INSTALL_X11_MODULES)
+$(INSTALL_X11_MODULES): installdirs
+ @dir=`echo $@ | sed -e 's/install-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; \
+ $(MAKE) $(FLAGS_TO_PASS) $(X11_FLAGS_TO_PASS) install); \
+ else \
+ true; \
+ fi
+
+# gcc is the only module which uses GCC_FLAGS_TO_PASS.
+.PHONY: all-gcc
+all-gcc:
+ @if [ -f ./gcc/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd gcc; $(MAKE) $(GCC_FLAGS_TO_PASS) all); \
+ else \
+ true; \
+ fi
+
+.PHONY: all-bootstrap
+all-bootstrap:
+ @if [ -f ./gcc/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd gcc; $(MAKE) $(GCC_FLAGS_TO_PASS) bootstrap); \
+ else \
+ true; \
+ fi
+
+.PHONY: check-gcc
+check-gcc:
+ @if [ -f ./gcc/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd gcc; $(MAKE) $(GCC_FLAGS_TO_PASS) check); \
+ else \
+ true; \
+ fi
+
+.PHONY: install-gcc
+install-gcc:
+ @if [ -f ./gcc/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd gcc; $(MAKE) $(GCC_FLAGS_TO_PASS) install); \
+ else \
+ true; \
+ fi
+
+
+# EXPERIMENTAL STUFF
+# This rule is used to install the modules which use FLAGS_TO_PASS.
+# To build a target install-X means to cd to X and make install.
+.PHONY: install-dosrel
+install-dosrel: installdirs info
+ @dir=`echo $@ | sed -e 's/install-//'`; \
+ if [ -f ./$${dir}/Makefile ] ; then \
+ r=`pwd`; export r; \
+ s=`cd $(srcdir); pwd`; export s; \
+ $(SET_LIB_PATH) \
+ (cd $${dir}; $(MAKE) $(FLAGS_TO_PASS) install); \
+ else \
+ true; \
+ fi
+
+install-dosrel-fake:
+
+
+# This is a list of inter-dependencies among modules.
+all-apache:
+all-autoconf: all-m4 all-texinfo
+all-automake:
+all-bash:
+all-bfd:
+all-binutils: all-libiberty all-opcodes all-bfd all-flex all-bison all-byacc
+all-bison: all-texinfo
+all-byacc:
+all-cvs:
+all-db:
+all-dejagnu: all-tcl all-expect all-tk
+all-diff: all-libiberty
+all-emacs:
+all-emacs19: all-bison all-byacc
+all-etc:
+configure-target-examples: $(ALL_GCC)
+all-target-examples: configure-target-examples
+all-expect: all-tcl all-tk
+all-fileutils: all-libiberty
+all-findutils:
+all-find:
+all-flex: all-libiberty all-bison all-byacc
+all-gas: all-libiberty all-opcodes all-bfd
+all-gash: all-tcl
+all-gawk:
+ALL_GCC = all-gcc
+all-gcc: all-bison all-byacc all-binutils all-gas all-ld
+all-bootstrap: all-libiberty all-bison all-byacc all-binutils all-gas all-ld
+GDB_TK = all-tk all-tcl all-itcl all-tix
+all-gdb: all-libiberty all-opcodes all-bfd all-mmalloc all-readline all-bison all-byacc all-sim $(gdbnlmrequirements) $(GDB_TK)
+all-gnuserv:
+configure-target-gperf: $(ALL_GCC)
+all-target-gperf: configure-target-gperf all-target-libiberty all-target-libg++
+all-gprof: all-libiberty all-bfd all-opcodes
+all-grep: all-libiberty
+all-grez: all-libiberty all-bfd all-opcodes
+all-gui: all-gdb all-libproc all-target-librx
+all-guile:
+all-gzip: all-libiberty
+all-hello: all-libiberty
+all-indent:
+all-inet: all-tcl all-send-pr all-perl
+all-ispell: all-emacs19
+all-itcl: all-tcl all-tk
+all-ld: all-libiberty all-bfd all-opcodes all-bison all-byacc all-flex
+configure-target-libg++: $(ALL_GCC) configure-target-librx
+all-target-libg++: configure-target-libg++ all-gas all-ld all-gcc all-target-libiberty all-target-newlib all-target-libio all-target-librx all-target-libstdc++
+configure-target-libgloss: $(ALL_GCC)
+all-target-libgloss: configure-target-libgloss configure-target-newlib
+configure-target-libio: $(ALL_GCC)
+all-target-libio: configure-target-libio all-gas all-ld all-gcc all-target-libiberty all-target-newlib
+all-libiberty:
+configure-target-librx: $(ALL_GCC) configure-target-newlib
+all-target-librx: configure-target-librx
+configure-target-libstdc++: $(ALL_GCC)
+all-target-libstdc++: configure-target-libstdc++ all-gas all-ld all-gcc all-target-libiberty all-target-newlib all-target-libio
+all-m4: all-libiberty
+all-make: all-libiberty
+all-mmalloc:
+configure-target-newlib: $(ALL_GCC)
+all-target-newlib: configure-target-newlib all-binutils all-gas all-gcc
+all-opcodes: all-bfd all-libiberty
+all-patch: all-libiberty
+all-perl:
+all-prms: all-libiberty
+all-rcs:
+all-readline:
+all-recode: all-libiberty
+all-sed: all-libiberty
+all-send-pr: all-prms
+all-shellutils:
+all-sim: all-libiberty all-bfd all-opcodes
+all-sn: all-tcl all-tk all-itcl all-db all-grep
+all-tar: all-libiberty
+all-tcl:
+all-tclX: all-tcl all-tk
+all-tk: all-tcl
+all-texinfo: all-libiberty
+all-textutils:
+all-tgas: all-libiberty all-bfd all-opcodes
+all-time:
+all-tix: all-tcl all-tk
+all-wdiff:
+all-target-winsup: all-target-newlib all-target-libiberty all-target-librx all-target-libio configure-target-winsup
+configure-target-winsup: configure-target-newlib
+all-uudecode: all-libiberty
+configure-target-libiberty: $(ALL_GCC)
+all-target-libiberty: configure-target-libiberty all-gcc all-ld all-target-newlib
+all-target: $(ALL_TARGET_MODULES)
+install-target: $(INSTALL_TARGET_MODULES)
+
+### other supporting targets
+
+MAKEDIRS= \
+ $(prefix) \
+ $(exec_prefix)
+.PHONY: installdirs
+installdirs: mkinstalldirs
+ $(SHELL) $(srcdir)/mkinstalldirs $(MAKEDIRS)
+
+dir.info: do-install-info
+ if [ -f $(srcdir)/texinfo/gen-info-dir ] ; then \
+ $(srcdir)/texinfo/gen-info-dir $(infodir) $(srcdir)/texinfo/dir.info-template > dir.info.new ; \
+ mv -f dir.info.new dir.info ; \
+ else true ; \
+ fi
+
+dist:
+ @echo "Building a full distribution of this tree isn't done"
+ @echo "via 'make dist'. Check out the etc/ subdirectory"
+
+etags tags: TAGS
+
+# Right now this just builds TAGS in each subdirectory. emacs19 has the
+# ability to use several tags files at once, so there is probably no need
+# to combine them into one big TAGS file (like CVS 1.3 does). We could
+# (if we felt like it) have this Makefile write a piece of elisp which
+# the user could load to tell emacs19 where all the TAGS files we just
+# built are.
+TAGS: do-TAGS
+
+# with the gnu make, this is done automatically.
+
+Makefile: Makefile.in configure.in $(host_makefile_frag) $(target_makefile_frag)
+ $(SHELL) ./config.status
+
+#
+# Support for building net releases
+
+# Files in devo used in any net release.
+# ChangeLog omitted because it may refer to files which are not in this
+# distribution (perhaps it would be better to include it anyway).
+DEVO_SUPPORT= README Makefile.in configure configure.in \
+ config.guess config.sub config move-if-change \
+ mpw-README mpw-build.in mpw-config.in mpw-configure mpw-install \
+ COPYING COPYING.LIB install-sh config-ml.in symlink-tree \
+ mkinstalldirs ltconfig ltmain.sh missing ylwrap
+
+# Files in devo/etc used in any net release.
+# ChangeLog omitted because it may refer to files which are not in this
+# distribution (perhaps it would be better to include it anyway).
+ETC_SUPPORT= Makefile.in configure configure.in standards.texi \
+ make-stds.texi standards.info*
+
+# When you use `make setup-dirs' or `make taz' you should always redefine
+# this macro.
+SUPPORT_FILES = list-of-support-files-for-tool-in-question
+
+.PHONY: taz
+
+taz: $(DEVO_SUPPORT) $(SUPPORT_FILES) \
+ texinfo/texinfo.tex texinfo/gpl.texinfo texinfo/lgpl.texinfo
+ # Take out texinfo from a few places; make simple BISON=bison line.
+ sed -e '/^all\.normal: /s/\all-texinfo //' \
+ -e '/^ install-texinfo /d' \
+ <Makefile.in >tmp
+ mv -f tmp Makefile.in
+ #
+ ./configure sun4
+ [ -z "$(CONFIGURE_TARGET_MODULES)" ] \
+ || $(MAKE) $(CONFIGURE_TARGET_MODULES) ALL_GCC="" \
+ CC_FOR_TARGET="$(CC)" CXX_FOR_TARGET="$(CXX)"
+ # Make links, and run "make diststuff" or "make info" when needed.
+ rm -rf proto-toplev ; mkdir proto-toplev
+ set -e ; dirs="$(TOOL) $(DEVO_SUPPORT) $(SUPPORT_FILES)" ; \
+ for d in $$dirs ; do \
+ if [ -d $$d ]; then \
+ if [ ! -f $$d/Makefile ] ; then true ; \
+ elif grep '^diststuff:' $$d/Makefile >/dev/null ; then \
+ (cd $$d ; $(MAKE) diststuff ) || exit 1 ; \
+ elif grep '^info:' $$d/Makefile >/dev/null ; then \
+ (cd $$d ; $(MAKE) info ) || exit 1 ; \
+ fi ; \
+ if [ -d $$d/proto-$$d.dir ]; then \
+ ln -s ../$$d/proto-$$d.dir proto-toplev/$$d ; \
+ else \
+ ln -s ../$$d proto-toplev/$$d ; \
+ fi ; \
+ else ln -s ../$$d proto-toplev/$$d ; fi ; \
+ done
+ cd etc ; $(MAKE) info
+ $(MAKE) distclean
+ #
+ mkdir proto-toplev/etc
+ (cd proto-toplev/etc; \
+ for i in $(ETC_SUPPORT); do \
+ ln -s ../../etc/$$i . ; \
+ done)
+ #
+ # Take out texinfo from configurable dirs
+ rm proto-toplev/configure.in
+ sed -e '/^host_tools=/s/texinfo //' \
+ <configure.in >proto-toplev/configure.in
+ #
+ mkdir proto-toplev/texinfo
+ ln -s ../../texinfo/texinfo.tex proto-toplev/texinfo/
+ ln -s ../../texinfo/gpl.texinfo proto-toplev/texinfo/
+ ln -s ../../texinfo/lgpl.texinfo proto-toplev/texinfo/
+ if test -r texinfo/util/tex3patch ; then \
+ mkdir proto-toplev/texinfo/util && \
+ ln -s ../../../texinfo/util/tex3patch proto-toplev/texinfo/util ; \
+ else true; fi
+ chmod og=u `find . -print`
+ if grep AM_INIT_AUTOMAKE $(TOOL)/configure.in >/dev/null 2>&1; then \
+ ver=`sed < $(TOOL)/configure.in -n 's/AM_INIT_AUTOMAKE[^,]*, *\([^)]*\))/\1/p'`; \
+ else \
+ ver=`sed <$(TOOL)/Makefile.in -n 's/^VERSION *= *//p'`; \
+ fi; \
+ $(MAKE) -f Makefile.in do-tar-gz TOOL=$(TOOL) VER=$$ver
+
+do-tar-gz:
+ echo "==> Making $(TOOL)-$(VER).tar.gz"
+ -rm -f $(TOOL)-$(VER)
+ ln -s proto-toplev $(TOOL)-$(VER)
+ tar cfh $(TOOL)-$(VER).tar $(TOOL)-$(VER)
+ $(GZIPPROG) -v -9 $(TOOL)-$(VER).tar
+
+TEXINFO_SUPPORT= texinfo/texinfo.tex texinfo/gpl.texinfo texinfo/lgpl.texinfo
+DIST_SUPPORT= $(DEVO_SUPPORT) $(TEXINFO_SUPPORT)
+
+.PHONY: gas.tar.gz
+GAS_SUPPORT_DIRS= bfd include libiberty opcodes setup.com makefile.vms
+gas.tar.gz: $(DIST_SUPPORT) $(GAS_SUPPORT_DIRS) gas
+ $(MAKE) -f Makefile.in taz TOOL=gas \
+ SUPPORT_FILES="$(GAS_SUPPORT_DIRS)"
+
+# The FSF "binutils" release includes gprof and ld.
+.PHONY: binutils.tar.gz
+BINUTILS_SUPPORT_DIRS= bfd gas include libiberty opcodes ld gprof setup.com makefile.vms
+binutils.tar.gz: $(DIST_SUPPORT) $(BINUTILS_SUPPORT_DIRS) binutils
+ $(MAKE) -f Makefile.in taz TOOL=binutils \
+ SUPPORT_FILES="$(BINUTILS_SUPPORT_DIRS) makeall.bat configure.bat"
+
+.PHONY: gas+binutils.tar.gz
+GASB_SUPPORT_DIRS= $(GAS_SUPPORT_DIRS) binutils ld gprof
+gas+binutils.tar.gz: $(DIST_SUPPORT) $(GASB_SUPPORT_DIRS) gas
+ $(MAKE) -f Makefile.in taz TOOL=gas \
+ SUPPORT_FILES="$(GASB_SUPPORT_DIRS) makeall.bat configure.bat"
+
+.PHONY: libg++.tar.gz
+LIBGXX_SUPPORT_DIRS=include libstdc++ libio librx libiberty
+libg++.tar.gz: $(DIST_SUPPORT) libg++
+ $(MAKE) -f Makefile.in taz TOOL=libg++ \
+ SUPPORT_FILES="$(LIBGXX_SUPPORT_DIRS)"
+
+GNATS_SUPPORT_DIRS=include libiberty send-pr
+gnats.tar.gz: $(DIST_SUPPORT) $(GNATS_SUPPORT_DIRS) gnats
+ $(MAKE) -f Makefile.in taz TOOL=gnats \
+ SUPPORT_FILES="$(GNATS_SUPPORT_DIRS)"
+
+.PHONY: gdb.tar.gz
+GDB_SUPPORT_DIRS= bfd include libiberty mmalloc opcodes readline sim utils
+GDBTK_SUPPORT_DIRS= `if [ -d tcl -a -d tk ] ; then echo tcl tk ; fi`
+gdb.tar.gz: $(DIST_SUPPORT) $(GDB_SUPPORT_DIRS) gdb
+ $(MAKE) -f Makefile.in taz TOOL=gdb \
+ SUPPORT_FILES="$(GDB_SUPPORT_DIRS) $(GDBTK_SUPPORT_DIRS)"
+
+.PHONY: newlib.tar.gz
+NEWLIB_SUPPORT_DIRS=libgloss
+# taz configures for the sun4 target which won't configure newlib.
+# We need newlib configured so that the .info files are made.
+# Unfortunately, it is not enough to just configure newlib separately:
+# taz will build the .info files but since SUBDIRS won't contain newlib,
+# distclean won't be run (leaving Makefile, config.status, and the tmp files
+# used in building the .info files, eg: *.def, *.ref).
+# The problem isn't solvable however without a lot of extra work because
+# target libraries are built in subdir $(target_alias) which gets nuked during
+# the make distclean. For now punt on the issue of shipping newlib info files
+# with newlib net releases and wait for a day when some native target (sun4?)
+# supports newlib (if only minimally).
+newlib.tar.gz: $(DIST_SUPPORT) $(NEWLIB_SUPPORT_DIRS) newlib
+ $(MAKE) -f Makefile.in taz TOOL=newlib \
+ SUPPORT_FILES="$(NEWLIB_SUPPORT_DIRS)" \
+ DEVO_SUPPORT="$(DEVO_SUPPORT) COPYING.NEWLIB" newlib
+
+.NOEXPORT:
+MAKEOVERRIDES=
+
+
+# end of Makefile.in
diff --git a/README b/README
new file mode 100644
index 00000000000..eb0e436d860
--- /dev/null
+++ b/README
@@ -0,0 +1,47 @@
+ README for GNU development tools
+
+This directory contains various GNU compilers, assemblers, linkers,
+debuggers, etc., plus their support routines, definitions, and documentation.
+
+If you are receiving this as part of a GDB release, see the file gdb/README.
+If with a binutils release, see binutils/README; if with a libg++ release,
+see libg++/README, etc. That'll give you info about this
+package -- supported targets, how to use it, how to report bugs, etc.
+
+It is now possible to automatically configure and build a variety of
+tools with one command. To build all of the tools contained herein,
+run the ``configure'' script here, e.g.:
+
+ ./configure
+ make
+
+To install them (by default in /usr/local/bin, /usr/local/lib, etc),
+then do:
+ make install
+
+(If the configure script can't determine your type of computer, give it
+the name as an argument, for instance ``./configure sun4''. You can
+use the script ``config.sub'' to test whether a name is recognized; if
+it is, config.sub translates it to a triplet specifying CPU, vendor,
+and OS.)
+
+If you have more than one compiler on your system, it is often best to
+explicitly set CC in the environment before running configure, and to
+also set CC when running make. For example (assuming sh/bash/ksh):
+
+ CC=gcc ./configure
+ make
+
+A similar example using csh:
+
+ setenv CC gcc
+ ./configure
+ make
+
+Much of the code and documentation enclosed is copyright by
+the Free Software Foundation, Inc. See the file COPYING or
+COPYING.LIB in the various directories, for a description of the
+GNU General Public License terms under which you can copy the files.
+
+REPORTING BUGS: Again, see gdb/README, binutils/README, etc., for info
+on where and how to report problems.
diff --git a/config-ml.in b/config-ml.in
new file mode 100644
index 00000000000..57613d90d7e
--- /dev/null
+++ b/config-ml.in
@@ -0,0 +1,612 @@
+# Configure fragment invoked in the post-target section for subdirs
+# wanting multilib support.
+#
+# It is advisable to support a few --enable/--disable options to let the
+# user select which libraries s/he really wants.
+#
+# Subdirectories wishing to use multilib should put the following lines
+# in the "post-target" section of configure.in.
+#
+# if [ "${srcdir}" = "." ] ; then
+# if [ "${with_target_subdir}" != "." ] ; then
+# . ${with_multisrctop}../../config-ml.in
+# else
+# . ${with_multisrctop}../config-ml.in
+# fi
+# else
+# . ${srcdir}/../config-ml.in
+# fi
+#
+# See librx/configure.in in the libg++ distribution for an example of how
+# to handle autoconf'd libraries.
+#
+# Things are complicated because 6 separate cases must be handled:
+# 2 (native, cross) x 3 (absolute-path, relative-not-dot, dot) = 6.
+#
+# srcdir=. is special. It must handle make programs that don't handle VPATH.
+# To implement this, a symlink tree is built for each library and for each
+# multilib subdir.
+#
+# The build tree is layed out as
+#
+# ./
+# libg++
+# newlib
+# m68020/
+# libg++
+# newlib
+# m68881/
+# libg++
+# newlib
+#
+# The nice feature about this arrangement is that inter-library references
+# in the build tree work without having to care where you are. Note that
+# inter-library references also work in the source tree because symlink trees
+# are built when srcdir=.
+#
+# Unfortunately, trying to access the libraries in the build tree requires
+# the user to manually choose which library to use as GCC won't be able to
+# find the right one. This is viewed as the lesser of two evils.
+#
+# Configure variables:
+# ${with_target_subdir} = "." for native, or ${target_alias} for cross.
+# Set by top level Makefile.
+# ${with_multisrctop} = how many levels of multilibs there are in the source
+# tree. It exists to handle the case of configuring in the source tree:
+# ${srcdir} is not constant.
+# ${with_multisubdir} = name of multilib subdirectory (eg: m68020/m68881).
+#
+# Makefile variables:
+# MULTISRCTOP = number of multilib levels in source tree (+1 if cross)
+# (FIXME: note that this is different than ${with_multisrctop}. Check out.).
+# MULTIBUILDTOP = number of multilib levels in build tree
+# MULTIDIRS = list of multilib subdirs (eg: m68000 m68020 ...)
+# (only defined in each library's main Makefile).
+# MULTISUBDIR = installed subdirectory name with leading '/' (eg: /m68000)
+# (only defined in each multilib subdir).
+
+# FIXME: Multilib is currently disabled by default for everything other than
+# newlib. It is up to each target to turn on multilib support for the other
+# libraries as desired.
+
+# We have to handle being invoked by both Cygnus configure and Autoconf.
+#
+# Cygnus configure incoming variables:
+# srcdir, subdir, target, arguments
+#
+# Autoconf incoming variables:
+# srcdir, target, ac_configure_args
+#
+# We *could* figure srcdir and target out, but we'd have to do work that
+# our caller has already done to figure them out and requiring these two
+# seems reasonable.
+
+if [ -n "${ac_configure_args}" ]; then
+ Makefile=${ac_file-Makefile}
+ ml_config_shell=${CONFIG_SHELL-/bin/sh}
+ ml_arguments="${ac_configure_args}"
+ ml_realsrcdir=${srcdir}
+else
+ Makefile=${Makefile-Makefile}
+ ml_config_shell=${config_shell-/bin/sh}
+ ml_arguments="${arguments}"
+ if [ -n "${subdir}" -a "${subdir}" != "." ] ; then
+ ml_realsrcdir=${srcdir}/${subdir}
+ else
+ ml_realsrcdir=${srcdir}
+ fi
+fi
+
+# Scan all the arguments and set all the ones we need.
+
+for option in ${ml_arguments}
+do
+ case $option in
+ --*) ;;
+ -*) option=-$option ;;
+ esac
+
+ case $option in
+ --*=*)
+ optarg=`echo $option | sed -e 's/^[^=]*=//'`
+ ;;
+ esac
+
+ case $option in
+ --disable-*)
+ enableopt=`echo ${option} | sed 's:^--disable-:enable_:;s:-:_:g'`
+ eval $enableopt=no
+ ;;
+ --enable-*)
+ case "$option" in
+ *=*) ;;
+ *) optarg=yes ;;
+ esac
+ enableopt=`echo ${option} | sed 's:^--::;s:=.*$::;s:-:_:g'`
+ eval $enableopt="$optarg"
+ ;;
+ --norecursion | --no*)
+ ml_norecursion=yes
+ ;;
+ --verbose | --v | --verb*)
+ ml_verbose=--verbose
+ ;;
+ --with-*)
+ case "$option" in
+ *=*) ;;
+ *) optarg=yes ;;
+ esac
+ withopt=`echo ${option} | sed 's:^--::;s:=.*$::;s:-:_:g'`
+ eval $withopt="$optarg"
+ ;;
+ --without-*)
+ withopt=`echo ${option} | sed 's:^--::;s:out::;s:-:_:g'`
+ eval $withopt=no
+ ;;
+ esac
+done
+
+# Only do this if --enable-multilib.
+if [ "${enable_multilib}" = yes ]; then
+
+# Compute whether this is the library's top level directory
+# (ie: not a multilib subdirectory, and not a subdirectory like libg++/src).
+# ${with_multisubdir} tells us we're in the right branch, but we could be
+# in a subdir of that.
+# ??? The previous version could void this test by separating the process into
+# two files: one that only the library's toplevel configure.in ran (to
+# configure the multilib subdirs), and another that all configure.in's ran to
+# update the Makefile. It seemed reasonable to collapse all multilib support
+# into one file, but it does leave us with having to perform this test.
+ml_toplevel_p=no
+if [ -z "${with_multisubdir}" ]; then
+ if [ "${srcdir}" = "." ]; then
+ # Use ${ml_realsrcdir} instead of ${srcdir} here to account for ${subdir}.
+ # ${with_target_subdir} = "." for native, otherwise target alias.
+ if [ "${with_target_subdir}" = "." ]; then
+ if [ -f ${ml_realsrcdir}/../config-ml.in ]; then
+ ml_toplevel_p=yes
+ fi
+ else
+ if [ -f ${ml_realsrcdir}/../../config-ml.in ]; then
+ ml_toplevel_p=yes
+ fi
+ fi
+ else
+ # Use ${ml_realsrcdir} instead of ${srcdir} here to account for ${subdir}.
+ if [ -f ${ml_realsrcdir}/../config-ml.in ]; then
+ ml_toplevel_p=yes
+ fi
+ fi
+fi
+
+# If this is the library's top level directory, set multidirs to the
+# multilib subdirs to support. This lives at the top because we need
+# `multidirs' set right away.
+
+if [ "${ml_toplevel_p}" = yes ]; then
+
+multidirs=
+for i in `${CC-gcc} --print-multi-lib 2>/dev/null`; do
+ dir=`echo $i | sed -e 's/;.*$//'`
+ if [ "${dir}" = "." ]; then
+ true
+ else
+ if [ -z "${multidirs}" ]; then
+ multidirs="${dir}"
+ else
+ multidirs="${multidirs} ${dir}"
+ fi
+ fi
+done
+
+case "${target}" in
+arc-*-elf*)
+ if [ x$enable_biendian != xyes ]
+ then
+ old_multidirs=${multidirs}
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "${x}" in
+ *be*) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ ;;
+m68*-*-*)
+ if [ x$enable_softfloat = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *soft-float* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_m68881 = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *m68881* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_m68000 = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *m68000* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_m68020 = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *m68020* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ ;;
+mips*-*-*)
+ if [ x$enable_single_float = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *single* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_biendian = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *el* ) : ;;
+ *eb* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_softfloat = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *soft-float* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ ;;
+powerpc*-*-* | rs6000*-*-*)
+ if [ x$enable_softfloat = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *soft-float* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_powercpu = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ power | */power | */power/* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_powerpccpu = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *powerpc* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_powerpcos = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *mcall-linux* | *mcall-solaris* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_biendian = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *mlittle* | *mbig* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_sysv = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *mcall-sysv* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ if [ x$enable_aix = xno ]
+ then
+ old_multidirs="${multidirs}"
+ multidirs=""
+ for x in ${old_multidirs}; do
+ case "$x" in
+ *mcall-aix* ) : ;;
+ *) multidirs="${multidirs} ${x}" ;;
+ esac
+ done
+ fi
+ ;;
+esac
+
+# Remove extraneous blanks from multidirs.
+# Tests like `if [ -n "$multidirs" ]' require it.
+multidirs=`echo "$multidirs" | sed -e 's/^[ ][ ]*//' -e 's/[ ][ ]*$//' -e 's/[ ][ ]*/ /g'`
+
+# Add code to library's top level makefile to handle building the multilib
+# subdirs.
+
+cat > Multi.tem <<\EOF
+
+# FIXME: There should be an @-sign in front of the `if'.
+# Leave out until this is tested a bit more.
+multi-do:
+ if [ -z "$(MULTIDIRS)" ]; then \
+ true; \
+ else \
+ rootpre=`pwd`/; export rootpre; \
+ srcrootpre=`cd $(srcdir); pwd`/; export srcrootpre; \
+ lib=`echo $${rootpre} | sed -e 's,^.*/\([^/][^/]*\)/$$,\1,'`; \
+ compiler="$(CC)"; \
+ for i in `$${compiler} --print-multi-lib 2>/dev/null`; do \
+ dir=`echo $$i | sed -e 's/;.*$$//'`; \
+ if [ "$${dir}" = "." ]; then \
+ true; \
+ else \
+ if [ -d ../$${dir}/$${lib} ]; then \
+ flags=`echo $$i | sed -e 's/^[^;]*;//' -e 's/@/ -/g'`; \
+ if (cd ../$${dir}/$${lib}; $(MAKE) $(FLAGS_TO_PASS) \
+ CFLAGS="$(CFLAGS) $${flags}" \
+ CXXFLAGS="$(CXXFLAGS) $${flags}" \
+ LIBCFLAGS="$(LIBCFLAGS) $${flags}" \
+ LIBCXXFLAGS="$(LIBCXXFLAGS) $${flags}" \
+ $(DO)); then \
+ true; \
+ else \
+ exit 1; \
+ fi; \
+ else true; \
+ fi; \
+ fi; \
+ done; \
+ fi
+
+# FIXME: There should be an @-sign in front of the `if'.
+# Leave out until this is tested a bit more.
+multi-clean:
+ if [ -z "$(MULTIDIRS)" ]; then \
+ true; \
+ else \
+ lib=`pwd | sed -e 's,^.*/\([^/][^/]*\)$$,\1,'`; \
+ for dir in Makefile $(MULTIDIRS); do \
+ if [ -f ../$${dir}/$${lib}/Makefile ]; then \
+ if (cd ../$${dir}/$${lib}; $(MAKE) $(FLAGS_TO_PASS) $(DO)); \
+ then true; \
+ else exit 1; \
+ fi; \
+ else true; \
+ fi; \
+ done; \
+ fi
+EOF
+
+cat ${Makefile} Multi.tem > Makefile.tem
+rm -f ${Makefile} Multi.tem
+mv Makefile.tem ${Makefile}
+
+fi # ${ml_toplevel_p} = yes
+
+if [ "${ml_verbose}" = --verbose ]; then
+ echo "Adding multilib support to Makefile in ${ml_realsrcdir}"
+ if [ "${ml_toplevel_p}" = yes ]; then
+ echo "multidirs=${multidirs}"
+ fi
+ echo "with_multisubdir=${with_multisubdir}"
+fi
+
+if [ "${srcdir}" = "." ]; then
+ if [ "${with_target_subdir}" != "." ]; then
+ ml_srcdotdot="../"
+ else
+ ml_srcdotdot=""
+ fi
+else
+ ml_srcdotdot=""
+fi
+
+if [ -z "${with_multisubdir}" ]; then
+ ml_subdir=
+ ml_builddotdot=
+ : # ml_srcdotdot= # already set
+else
+ ml_subdir="/${with_multisubdir}"
+ # The '[^/][^/]*' appears that way to work around a SunOS sed bug.
+ ml_builddotdot=`echo ${with_multisubdir} | sed -e 's:[^/][^/]*:..:g'`/
+ if [ "$srcdir" = "." ]; then
+ ml_srcdotdot=${ml_srcdotdot}${ml_builddotdot}
+ else
+ : # ml_srcdotdot= # already set
+ fi
+fi
+
+if [ "${ml_toplevel_p}" = yes ]; then
+ ml_do='$(MAKE)'
+ ml_clean='$(MAKE)'
+else
+ ml_do=true
+ ml_clean=true
+fi
+
+# TOP is used by newlib and should not be used elsewhere for this purpose.
+# MULTI{SRC,BUILD}TOP are the proper ones to use. MULTISRCTOP is empty
+# when srcdir != builddir. MULTIBUILDTOP is always some number of ../'s.
+# FIXME: newlib needs to be updated to use MULTI{SRC,BUILD}TOP so we can
+# delete TOP. Newlib may wish to continue to use TOP for its own purposes
+# of course.
+# MULTIDIRS is non-empty for the cpu top level Makefile (eg: newlib/Makefile)
+# and lists the subdirectories to recurse into.
+# MULTISUBDIR is non-empty in each cpu subdirectory's Makefile
+# (eg: newlib/h8300h/Makefile) and is the installed subdirectory name with
+# a leading '/'.
+# MULTIDO is used for targets like all, install, and check where
+# $(FLAGS_TO_PASS) augmented with the subdir's compiler option is needed.
+# MULTICLEAN is used for the *clean targets.
+#
+# ??? It is possible to merge MULTIDO and MULTICLEAN into one. They are
+# currently kept separate because we don't want the *clean targets to require
+# the existence of the compiler (which MULTIDO currently requires) and
+# therefore we'd have to record the directory options as well as names
+# (currently we just record the names and use --print-multi-lib to get the
+# options).
+
+sed -e "s:^TOP[ ]*=[ ]*\([./]*\)[ ]*$:TOP = ${ml_builddotdot}\1:" \
+ -e "s:^MULTISRCTOP[ ]*=.*$:MULTISRCTOP = ${ml_srcdotdot}:" \
+ -e "s:^MULTIBUILDTOP[ ]*=.*$:MULTIBUILDTOP = ${ml_builddotdot}:" \
+ -e "s:^MULTIDIRS[ ]*=.*$:MULTIDIRS = ${multidirs}:" \
+ -e "s:^MULTISUBDIR[ ]*=.*$:MULTISUBDIR = ${ml_subdir}:" \
+ -e "s:^MULTIDO[ ]*=.*$:MULTIDO = $ml_do:" \
+ -e "s:^MULTICLEAN[ ]*=.*$:MULTICLEAN = $ml_clean:" \
+ ${Makefile} > Makefile.tem
+rm -f ${Makefile}
+mv Makefile.tem ${Makefile}
+
+# If this is the library's top level, configure each multilib subdir.
+# This is done at the end because this is the loop that runs configure
+# in each multilib subdir and it seemed reasonable to finish updating the
+# Makefile before going on to configure the subdirs.
+
+if [ "${ml_toplevel_p}" = yes ]; then
+
+# We must freshly configure each subdirectory. This bit of code is
+# actually partially stolen from the main configure script. FIXME.
+
+if [ -n "${multidirs}" ] && [ -z "${ml_norecursion}" ]; then
+
+ if [ "${ml_verbose}" = --verbose ]; then
+ echo "Running configure in multilib subdirs ${multidirs}"
+ echo "pwd: `pwd`"
+ fi
+
+ ml_origdir=`pwd`
+ ml_libdir=`echo $ml_origdir | sed -e 's,^.*/,,'`
+ # cd to top-level-build-dir/${with_target_subdir}
+ cd ..
+
+ for ml_dir in ${multidirs}; do
+
+ if [ "${ml_verbose}" = --verbose ]; then
+ echo "Running configure in multilib subdir ${ml_dir}"
+ echo "pwd: `pwd`"
+ fi
+
+ if [ -d ${ml_dir} ]; then true; else mkdir ${ml_dir}; fi
+ if [ -d ${ml_dir}/${ml_libdir} ]; then true; else mkdir ${ml_dir}/${ml_libdir}; fi
+
+ # Eg: if ${ml_dir} = m68000/m68881, dotdot = ../../
+ dotdot=../`echo ${ml_dir} | sed -e 's|[^/]||g' -e 's|/|../|g'`
+
+ case ${srcdir} in
+ ".")
+ echo Building symlink tree in `pwd`/${ml_dir}/${ml_libdir}
+ if [ "${with_target_subdir}" != "." ]; then
+ ml_unsubdir="../"
+ else
+ ml_unsubdir=""
+ fi
+ (cd ${ml_dir}/${ml_libdir};
+ ../${dotdot}${ml_unsubdir}symlink-tree ../${dotdot}${ml_unsubdir}${ml_libdir} "")
+ ml_newsrcdir="."
+ ml_srcdiroption=
+ multisrctop=${dotdot}
+ ;;
+ *)
+ case "${srcdir}" in
+ /*) # absolute path
+ ml_newsrcdir=${srcdir}
+ ;;
+ *) # otherwise relative
+ ml_newsrcdir=${dotdot}${srcdir}
+ ;;
+ esac
+ ml_srcdiroption="-srcdir=${ml_newsrcdir}"
+ multisrctop=
+ ;;
+ esac
+
+ case "${progname}" in
+ /*) ml_recprog=${progname} ;;
+ *) ml_recprog=${dotdot}${progname} ;;
+ esac
+
+ # FIXME: POPDIR=${PWD=`pwd`} doesn't work here.
+ ML_POPDIR=`pwd`
+ cd ${ml_dir}/${ml_libdir}
+
+ if [ -f ${ml_newsrcdir}/configure ]; then
+ ml_recprog=${ml_newsrcdir}/configure
+ fi
+ if eval ${ml_config_shell} ${ml_recprog} \
+ --with-multisubdir=${ml_dir} --with-multisrctop=${multisrctop} \
+ ${ml_arguments} ${ml_srcdiroption} ; then
+ true
+ else
+ exit 1
+ fi
+
+ cd ${ML_POPDIR}
+
+ done
+
+ cd ${ml_origdir}
+fi
+
+fi # ${ml_toplevel_p} = yes
+fi # ${enable_multilib} = yes
diff --git a/config.guess b/config.guess
new file mode 100755
index 00000000000..a73a8d93c0c
--- /dev/null
+++ b/config.guess
@@ -0,0 +1,833 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+# Copyright (C) 1992, 93, 94, 95, 96, 1997 Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Written by Per Bothner <bothner@cygnus.com>.
+# The master version of this file is at the FSF in /home/gd/gnu/lib.
+#
+# This script attempts to guess a canonical system name similar to
+# config.sub. If it succeeds, it prints the system name on stdout, and
+# exits with 0. Otherwise, it exits with 1.
+#
+# The plan is that this can be called by configure scripts if you
+# don't specify an explicit system type (host/target name).
+#
+# Only a few systems have been added to this list; please add others
+# (but try to keep the structure clean).
+#
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 8/24/94.)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+ PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ alpha:OSF1:*:*)
+ # A Vn.n version is a released version.
+ # A Tn.n version is a released field test version.
+ # A Xn.n version is an unreleased experimental baselevel.
+ # 1.2 uses "1.2" for uname -r.
+ cat <<EOF >dummy.s
+ .globl main
+ .ent main
+main:
+ .frame \$30,0,\$26,0
+ .prologue 0
+ .long 0x47e03d84
+ cmoveq \$4,0,\$3
+ addl \$3,\$31,\$0
+ ret \$31,(\$26),1
+ .end main
+EOF
+ ${CC-cc} dummy.s -o dummy 2>/dev/null
+ if test "$?" = 0 ; then
+ ./dummy
+ case "$?" in
+ 1)
+ UNAME_MACHINE="alphaev5"
+ ;;
+ 2)
+ UNAME_MACHINE="alphaev56"
+ ;;
+ esac
+ fi
+ rm -f dummy.s dummy
+ echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//'`
+ exit 0 ;;
+ 21064:Windows_NT:50:3)
+ echo alpha-dec-winnt3.5
+ exit 0 ;;
+ Amiga*:UNIX_System_V:4.0:*)
+ echo m68k-cbm-sysv4
+ exit 0;;
+ amiga:NetBSD:*:*)
+ echo m68k-cbm-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ amiga:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ arc64:OpenBSD:*:*)
+ echo mips64el-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ arc:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ hkmips:OpenBSD:*:*)
+ echo mips-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ pmax:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ sgi:OpenBSD:*:*)
+ echo mips-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ wgrisc:OpenBSD:*:*)
+ echo mipsel-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+ echo arm-acorn-riscix${UNAME_RELEASE}
+ exit 0;;
+ arm32:NetBSD:*:*)
+ echo arm-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ exit 0 ;;
+ SR2?01:HI-UX/MPP:*:*)
+ echo hppa1.1-hitachi-hiuxmpp
+ exit 0;;
+ Pyramid*:OSx*:*:*|MIS*:OSx*:*:*)
+ # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+ if test "`(/bin/universe) 2>/dev/null`" = att ; then
+ echo pyramid-pyramid-sysv3
+ else
+ echo pyramid-pyramid-bsd
+ fi
+ exit 0 ;;
+ NILE:*:*:dcosx)
+ echo pyramid-pyramid-svr4
+ exit 0 ;;
+ sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+ echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ i86pc:SunOS:5.*:*)
+ echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:6*:*)
+ # According to config.sub, this is the proper way to canonicalize
+ # SunOS6. Hard to guess exactly what SunOS6 will be like, but
+ # it's likely to be more like Solaris than SunOS4.
+ echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:*:*)
+ case "`/usr/bin/arch -k`" in
+ Series*|S4*)
+ UNAME_RELEASE=`uname -v`
+ ;;
+ esac
+ # Japanese Language versions have a version number like `4.1.3-JL'.
+ echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+ exit 0 ;;
+ sun3*:SunOS:*:*)
+ echo m68k-sun-sunos${UNAME_RELEASE}
+ exit 0 ;;
+ aushp:SunOS:*:*)
+ echo sparc-auspex-sunos${UNAME_RELEASE}
+ exit 0 ;;
+ atari*:NetBSD:*:*)
+ echo m68k-atari-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ atari*:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ sun3*:NetBSD:*:*)
+ echo m68k-sun-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ sun3*:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mac68k:NetBSD:*:*)
+ echo m68k-apple-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mac68k:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mvme68k:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ mvme88k:OpenBSD:*:*)
+ echo m88k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ powerpc:machten:*:*)
+ echo powerpc-apple-machten${UNAME_RELEASE}
+ exit 0 ;;
+ RISC*:Mach:*:*)
+ echo mips-dec-mach_bsd4.3
+ exit 0 ;;
+ RISC*:ULTRIX:*:*)
+ echo mips-dec-ultrix${UNAME_RELEASE}
+ exit 0 ;;
+ VAX*:ULTRIX*:*:*)
+ echo vax-dec-ultrix${UNAME_RELEASE}
+ exit 0 ;;
+ 2020:CLIX:*:*)
+ echo clipper-intergraph-clix${UNAME_RELEASE}
+ exit 0 ;;
+ mips:*:*:UMIPS | mips:*:*:RISCos)
+ sed 's/^ //' << EOF >dummy.c
+ int main (argc, argv) int argc; char **argv; {
+ #if defined (host_mips) && defined (MIPSEB)
+ #if defined (SYSTYPE_SYSV)
+ printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_SVR4)
+ printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+ printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+ #endif
+ #endif
+ exit (-1);
+ }
+EOF
+ ${CC-cc} dummy.c -o dummy \
+ && ./dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \
+ && rm dummy.c dummy && exit 0
+ rm -f dummy.c dummy
+ echo mips-mips-riscos${UNAME_RELEASE}
+ exit 0 ;;
+ Night_Hawk:Power_UNIX:*:*)
+ echo powerpc-harris-powerunix
+ exit 0 ;;
+ m88k:CX/UX:7*:*)
+ echo m88k-harris-cxux7
+ exit 0 ;;
+ m88k:*:4*:R4*)
+ echo m88k-motorola-sysv4
+ exit 0 ;;
+ m88k:*:3*:R3*)
+ echo m88k-motorola-sysv3
+ exit 0 ;;
+ AViiON:dgux:*:*)
+ # DG/UX returns AViiON for all architectures
+ UNAME_PROCESSOR=`/usr/bin/uname -p`
+ if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88110 ] ; then
+ if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \
+ -o ${TARGET_BINARY_INTERFACE}x = x ] ; then
+ echo m88k-dg-dgux${UNAME_RELEASE}
+ else
+ echo m88k-dg-dguxbcs${UNAME_RELEASE}
+ fi
+ else echo i586-dg-dgux${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ M88*:DolphinOS:*:*) # DolphinOS (SVR3)
+ echo m88k-dolphin-sysv3
+ exit 0 ;;
+ M88*:*:R3*:*)
+ # Delta 88k system running SVR3
+ echo m88k-motorola-sysv3
+ exit 0 ;;
+ XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+ echo m88k-tektronix-sysv3
+ exit 0 ;;
+ Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+ echo m68k-tektronix-bsd
+ exit 0 ;;
+ *:IRIX*:*:*)
+ echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+ exit 0 ;;
+ ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+ echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
+ exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+ i?86:AIX:*:*)
+ echo i386-ibm-aix
+ exit 0 ;;
+ *:AIX:2:3)
+ if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+ sed 's/^ //' << EOF >dummy.c
+ #include <sys/systemcfg.h>
+
+ main()
+ {
+ if (!__power_pc())
+ exit(1);
+ puts("powerpc-ibm-aix3.2.5");
+ exit(0);
+ }
+EOF
+ ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0
+ rm -f dummy.c dummy
+ echo rs6000-ibm-aix3.2.5
+ elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+ echo rs6000-ibm-aix3.2.4
+ else
+ echo rs6000-ibm-aix3.2
+ fi
+ exit 0 ;;
+ *:AIX:*:4)
+ if /usr/sbin/lsattr -EHl proc0 | grep POWER >/dev/null 2>&1; then
+ IBM_ARCH=rs6000
+ else
+ IBM_ARCH=powerpc
+ fi
+ if [ -x /usr/bin/oslevel ] ; then
+ IBM_REV=`/usr/bin/oslevel`
+ else
+ IBM_REV=4.${UNAME_RELEASE}
+ fi
+ echo ${IBM_ARCH}-ibm-aix${IBM_REV}
+ exit 0 ;;
+ *:AIX:*:*)
+ echo rs6000-ibm-aix
+ exit 0 ;;
+ ibmrt:4.4BSD:*|romp-ibm:BSD:*)
+ echo romp-ibm-bsd4.4
+ exit 0 ;;
+ ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and
+ echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
+ exit 0 ;; # report: romp-ibm BSD 4.3
+ *:BOSX:*:*)
+ echo rs6000-bull-bosx
+ exit 0 ;;
+ DPX/2?00:B.O.S.:*:*)
+ echo m68k-bull-sysv3
+ exit 0 ;;
+ 9000/[34]??:4.3bsd:1.*:*)
+ echo m68k-hp-bsd
+ exit 0 ;;
+ hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+ echo m68k-hp-bsd4.4
+ exit 0 ;;
+ 9000/[3478]??:HP-UX:*:*)
+ case "${UNAME_MACHINE}" in
+ 9000/31? ) HP_ARCH=m68000 ;;
+ 9000/[34]?? ) HP_ARCH=m68k ;;
+ 9000/7?? | 9000/8?[1679] ) HP_ARCH=hppa1.1 ;;
+ 9000/8?? ) HP_ARCH=hppa1.0 ;;
+ esac
+ HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+ echo ${HP_ARCH}-hp-hpux${HPUX_REV}
+ exit 0 ;;
+ 3050*:HI-UX:*:*)
+ sed 's/^ //' << EOF >dummy.c
+ #include <unistd.h>
+ int
+ main ()
+ {
+ long cpu = sysconf (_SC_CPU_VERSION);
+ /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+ true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
+ results, however. */
+ if (CPU_IS_PA_RISC (cpu))
+ {
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+ default: puts ("hppa-hitachi-hiuxwe2"); break;
+ }
+ }
+ else if (CPU_IS_HP_MC68K (cpu))
+ puts ("m68k-hitachi-hiuxwe2");
+ else puts ("unknown-hitachi-hiuxwe2");
+ exit (0);
+ }
+EOF
+ ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0
+ rm -f dummy.c dummy
+ echo unknown-hitachi-hiuxwe2
+ exit 0 ;;
+ 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
+ echo hppa1.1-hp-bsd
+ exit 0 ;;
+ 9000/8??:4.3bsd:*:*)
+ echo hppa1.0-hp-bsd
+ exit 0 ;;
+ hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
+ echo hppa1.1-hp-osf
+ exit 0 ;;
+ hp8??:OSF1:*:*)
+ echo hppa1.0-hp-osf
+ exit 0 ;;
+ i?86:OSF1:*:*)
+ if [ -x /usr/sbin/sysversion ] ; then
+ echo ${UNAME_MACHINE}-unknown-osf1mk
+ else
+ echo ${UNAME_MACHINE}-unknown-osf1
+ fi
+ exit 0 ;;
+ parisc*:Lites*:*:*)
+ echo hppa1.1-hp-lites
+ exit 0 ;;
+ C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+ echo c1-convex-bsd
+ exit 0 ;;
+ C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit 0 ;;
+ C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+ echo c34-convex-bsd
+ exit 0 ;;
+ C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+ echo c38-convex-bsd
+ exit 0 ;;
+ C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+ echo c4-convex-bsd
+ exit 0 ;;
+ CRAY*X-MP:*:*:*)
+ echo xmp-cray-unicos
+ exit 0 ;;
+ CRAY*Y-MP:*:*:*)
+ echo ymp-cray-unicos${UNAME_RELEASE}
+ exit 0 ;;
+ CRAY*[A-Z]90:*:*:*)
+ echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
+ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/
+ exit 0 ;;
+ CRAY*TS:*:*:*)
+ echo t90-cray-unicos${UNAME_RELEASE}
+ exit 0 ;;
+ CRAY-2:*:*:*)
+ echo cray2-cray-unicos
+ exit 0 ;;
+ F300:UNIX_System_V:*:*)
+ FUJITSU_SYS=`uname -p | tr [A-Z] [a-z] | sed -e 's/\///'`
+ FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
+ echo "f300-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+ exit 0 ;;
+ F301:UNIX_System_V:*:*)
+ echo f301-fujitsu-uxpv`echo $UNAME_RELEASE | sed 's/ .*//'`
+ exit 0 ;;
+ hp3[0-9][05]:NetBSD:*:*)
+ echo m68k-hp-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ hp300:OpenBSD:*:*)
+ echo m68k-unknown-openbsd${UNAME_RELEASE}
+ exit 0 ;;
+ i?86:BSD/386:*:* | *:BSD/OS:*:*)
+ echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ *:FreeBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+ exit 0 ;;
+ *:NetBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ exit 0 ;;
+ *:OpenBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ exit 0 ;;
+ i*:CYGWIN*:*)
+ echo i386-pc-cygwin32
+ exit 0 ;;
+ i*:MINGW*:*)
+ echo i386-pc-mingw32
+ exit 0 ;;
+ p*:CYGWIN*:*)
+ echo powerpcle-unknown-cygwin32
+ exit 0 ;;
+ prep*:SunOS:5.*:*)
+ echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ *:GNU:*:*)
+ echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+ exit 0 ;;
+ *:Linux:*:*)
+ # The BFD linker knows what the default object file format is, so
+ # first see if it will tell us.
+ ld_help_string=`ld --help 2>&1`
+ ld_supported_emulations=`echo $ld_help_string \
+ | sed -ne '/supported emulations:/!d
+ s/[ ][ ]*/ /g
+ s/.*supported emulations: *//
+ s/ .*//
+ p'`
+ case "$ld_supported_emulations" in
+ i?86linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" ; exit 0 ;;
+ i?86coff) echo "${UNAME_MACHINE}-pc-linux-gnucoff" ; exit 0 ;;
+ sparclinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;;
+ m68klinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;;
+ elf32ppc) echo "powerpc-unknown-linux-gnu" ; exit 0 ;;
+ esac
+
+ if test "${UNAME_MACHINE}" = "alpha" ; then
+ sed 's/^ //' <<EOF >dummy.s
+ .globl main
+ .ent main
+ main:
+ .frame \$30,0,\$26,0
+ .prologue 0
+ .long 0x47e03d84
+ cmoveq \$4,0,\$3
+ addl \$3,\$31,\$0
+ ret \$31,(\$26),1
+ .end main
+EOF
+ ${CC-cc} dummy.s -o dummy 2>/dev/null
+ if test "$?" = 0 ; then
+ ./dummy
+ case "$?" in
+ 1)
+ UNAME_MACHINE="alphaev5"
+ ;;
+ 2)
+ UNAME_MACHINE="alphaev56"
+ ;;
+ esac
+ fi
+ rm -f dummy.s dummy
+ echo ${UNAME_MACHINE}-unknown-linux-gnu ; exit 0
+ elif test "${UNAME_MACHINE}" = "mips" ; then
+ cat >dummy.c <<EOF
+main(argc, argv)
+ int argc;
+ char *argv[];
+{
+#ifdef __MIPSEB__
+ printf ("%s-unknown-linux-gnu\n", argv[1]);
+#endif
+#ifdef __MIPSEL__
+ printf ("%sel-unknown-linux-gnu\n", argv[1]);
+#endif
+ return 0;
+}
+EOF
+ ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0
+ rm -f dummy.c dummy
+ else
+ # Either a pre-BFD a.out linker (linux-gnuoldld)
+ # or one that does not give us useful --help.
+ # GCC wants to distinguish between linux-gnuoldld and linux-gnuaout.
+ # If ld does not provide *any* "supported emulations:"
+ # that means it is gnuoldld.
+ echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations:"
+ test $? != 0 && echo "${UNAME_MACHINE}-pc-linux-gnuoldld" && exit 0
+
+ case "${UNAME_MACHINE}" in
+ i?86)
+ VENDOR=pc;
+ ;;
+ *)
+ VENDOR=unknown;
+ ;;
+ esac
+ # Determine whether the default compiler is a.out or elf
+ cat >dummy.c <<EOF
+#include <features.h>
+main(argc, argv)
+ int argc;
+ char *argv[];
+{
+#ifdef __ELF__
+# ifdef __GLIBC__
+# if __GLIBC__ >= 2
+ printf ("%s-${VENDOR}-linux-gnu\n", argv[1]);
+# else
+ printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]);
+# endif
+# else
+ printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]);
+# endif
+#else
+ printf ("%s-${VENDOR}-linux-gnuaout\n", argv[1]);
+#endif
+ return 0;
+}
+EOF
+ ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0
+ rm -f dummy.c dummy
+ fi ;;
+# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions
+# are messed up and put the nodename in both sysname and nodename.
+ i?86:DYNIX/ptx:4*:*)
+ echo i386-sequent-sysv4
+ exit 0 ;;
+ i?86:UNIX_SV:4.2MP:2.*)
+ # Unixware is an offshoot of SVR4, but it has its own version
+ # number series starting with 2...
+ # I am not positive that other SVR4 systems won't match this,
+ # I just have to hope. -- rms.
+ # Use sysv4.2uw... so that sysv4* matches it.
+ echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
+ exit 0 ;;
+ i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*)
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE}
+ else
+ echo ${UNAME_MACHINE}-pc-sysv${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ i?86:*:3.2:*)
+ if test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+ echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
+ elif /bin/uname -X 2>/dev/null >/dev/null ; then
+ UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
+ (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \
+ && UNAME_MACHINE=i586
+ echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
+ else
+ echo ${UNAME_MACHINE}-pc-sysv32
+ fi
+ exit 0 ;;
+ pc:*:*:*)
+ # uname -m prints for DJGPP always 'pc', but it prints nothing about
+ # the processor, so we play safe by assuming i386.
+ echo i386-pc-msdosdjgpp
+ exit 0 ;;
+ Intel:Mach:3*:*)
+ echo i386-pc-mach3
+ exit 0 ;;
+ paragon:*:*:*)
+ echo i860-intel-osf1
+ exit 0 ;;
+ i860:*:4.*:*) # i860-SVR4
+ if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+ echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
+ else # Add other i860-SVR4 vendors below as they are discovered.
+ echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4
+ fi
+ exit 0 ;;
+ mini*:CTIX:SYS*5:*)
+ # "miniframe"
+ echo m68010-convergent-sysv
+ exit 0 ;;
+ M68*:*:R3V[567]*:*)
+ test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
+ 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 4850:*:4.0:3.0)
+ OS_REL=''
+ test -r /etc/.relid \
+ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4.3${OS_REL} && exit 0
+ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+ && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;;
+ 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4 && exit 0 ;;
+ m68*:LynxOS:2.*:*)
+ echo m68k-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ mc68030:UNIX_System_V:4.*:*)
+ echo m68k-atari-sysv4
+ exit 0 ;;
+ i?86:LynxOS:2.*:*)
+ echo i386-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ TSUNAMI:LynxOS:2.*:*)
+ echo sparc-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*)
+ echo rs6000-unknown-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ SM[BE]S:UNIX_SV:*:*)
+ echo mips-dde-sysv${UNAME_RELEASE}
+ exit 0 ;;
+ RM*:SINIX-*:*:*)
+ echo mips-sni-sysv4
+ exit 0 ;;
+ *:SINIX-*:*:*)
+ if uname -p 2>/dev/null >/dev/null ; then
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ echo ${UNAME_MACHINE}-sni-sysv4
+ else
+ echo ns32k-sni-sysv
+ fi
+ exit 0 ;;
+ PENTIUM:CPunix:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+ # says <Richard.M.Bartel@ccMail.Census.GOV>
+ echo i586-unisys-sysv4
+ exit 0 ;;
+ *:UNIX_System_V:4*:FTX*)
+ # From Gerald Hewes <hewes@openmarket.com>.
+ # How about differentiating between stratus architectures? -djm
+ echo hppa1.1-stratus-sysv4
+ exit 0 ;;
+ *:*:*:FTX*)
+ # From seanf@swdc.stratus.com.
+ echo i860-stratus-sysv4
+ exit 0 ;;
+ mc68*:A/UX:*:*)
+ echo m68k-apple-aux${UNAME_RELEASE}
+ exit 0 ;;
+ news*:NEWS-OS:*:6*)
+ echo mips-sony-newsos6
+ exit 0 ;;
+ R3000:*System_V*:*:* | R4000:UNIX_SYSV:*:*)
+ if [ -d /usr/nec ]; then
+ echo mips-nec-sysv${UNAME_RELEASE}
+ else
+ echo mips-unknown-sysv${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+esac
+
+#echo '(No uname command or uname output not recognized.)' 1>&2
+#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
+
+cat >dummy.c <<EOF
+#ifdef _SEQUENT_
+# include <sys/types.h>
+# include <sys/utsname.h>
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+ /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
+ I don't know.... */
+ printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include <sys/param.h>
+ printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+ "4"
+#else
+ ""
+#endif
+ ); exit (0);
+#endif
+#endif
+
+#if defined (__arm) && defined (__acorn) && defined (__unix)
+ printf ("arm-acorn-riscix"); exit (0);
+#endif
+
+#if defined (hp300) && !defined (hpux)
+ printf ("m68k-hp-bsd\n"); exit (0);
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+ exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+ printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+ printf ("ns32k-encore-mach\n"); exit (0);
+#else
+ printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+ printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+ printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+ printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+ struct utsname un;
+
+ uname(&un);
+
+ if (strncmp(un.version, "V2", 2) == 0) {
+ printf ("i386-sequent-ptx2\n"); exit (0);
+ }
+ if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+ printf ("i386-sequent-ptx1\n"); exit (0);
+ }
+ printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+#if !defined (ultrix)
+ printf ("vax-dec-bsd\n"); exit (0);
+#else
+ printf ("vax-dec-ultrix\n"); exit (0);
+#endif
+#endif
+
+#if defined (alliant) && defined (i860)
+ printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+ exit (1);
+}
+EOF
+
+${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy && rm dummy.c dummy && exit 0
+rm -f dummy.c dummy
+
+# Apollos put the system type in the environment.
+
+test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; }
+
+# Convex versions that predate uname can use getsysinfo(1)
+
+if [ -x /usr/convex/getsysinfo ]
+then
+ case `getsysinfo -f cpu_type` in
+ c1*)
+ echo c1-convex-bsd
+ exit 0 ;;
+ c2*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit 0 ;;
+ c34*)
+ echo c34-convex-bsd
+ exit 0 ;;
+ c38*)
+ echo c38-convex-bsd
+ exit 0 ;;
+ c4*)
+ echo c4-convex-bsd
+ exit 0 ;;
+ esac
+fi
+
+#echo '(Unable to guess system type)' 1>&2
+
+exit 1
diff --git a/config.sub b/config.sub
new file mode 100755
index 00000000000..eb77a640f01
--- /dev/null
+++ b/config.sub
@@ -0,0 +1,1177 @@
+#! /bin/sh
+# Configuration validation subroutine script, version 1.1.
+# Copyright (C) 1991, 92, 93, 94, 95, 96, 1997 Free Software Foundation, Inc.
+# This file is (in principle) common to ALL GNU software.
+# The presence of a machine in this file suggests that SOME GNU software
+# can handle that machine. It does not imply ALL GNU software can.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support. The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+if [ x$1 = x ]
+then
+ echo Configuration name missing. 1>&2
+ echo "Usage: $0 CPU-MFR-OPSYS" 1>&2
+ echo "or $0 ALIAS" 1>&2
+ echo where ALIAS is a recognized configuration type. 1>&2
+ exit 1
+fi
+
+# First pass through any local machine types.
+case $1 in
+ *local*)
+ echo $1
+ exit 0
+ ;;
+ *)
+ ;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
+# Here we must recognize all the valid KERNEL-OS combinations.
+maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+case $maybe_os in
+ linux-gnu*)
+ os=-$maybe_os
+ basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+ ;;
+ *)
+ basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+ if [ $basic_machine != $1 ]
+ then os=`echo $1 | sed 's/.*-/-/'`
+ else os=; fi
+ ;;
+esac
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work. We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+ -sun*os*)
+ # Prevent following clause from handling this invalid input.
+ ;;
+ -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+ -apple)
+ os=
+ basic_machine=$1
+ ;;
+ -sim | -cisco | -oki | -wec | -winbond ) # CYGNUS LOCAL
+ os=
+ basic_machine=$1
+ ;;
+ -scout) # CYGNUS LOCAL
+ ;;
+ -wrs) # CYGNUS LOCAL
+ os=vxworks
+ basic_machine=$1
+ ;;
+ -hiux*)
+ os=-hiuxwe2
+ ;;
+ -sco5)
+ os=sco3.2v5
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco4)
+ os=-sco3.2v4
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco3.2.[4-9]*)
+ os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco3.2v[4-9]*)
+ # Don't forget version if it is 3.2v4 or newer.
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco*)
+ os=-sco3.2v2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -isc)
+ os=-isc2.2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -clix*)
+ basic_machine=clipper-intergraph
+ ;;
+ -isc*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -lynx*)
+ os=-lynxos
+ ;;
+ -ptx*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+ ;;
+ -windowsnt*)
+ os=`echo $os | sed -e 's/windowsnt/winnt/'`
+ ;;
+ -psos*)
+ os=-psos
+ ;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+ # Recognize the basic CPU types without company name.
+ # Some are omitted here because they have special meanings below.
+ tahoe | i860 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \
+ | arme[lb] | pyramid | mn10200 | mn10300 \
+ | tron | a29k | 580 | i960 | h8300 | hppa | hppa1.0 | hppa1.1 \
+ | alpha | alphaev5 | alphaev56 | we32k | ns16k | clipper \
+ | i370 | sh | powerpc | powerpcle | 1750a | dsp16xx | pdp11 \
+ | mips64 | mipsel | mips64el | mips64orion | mips64orionel \
+ | mipstx39 | mipstx39el \
+ | sparc | sparclet | sparclite | sparc64)
+ basic_machine=$basic_machine-unknown
+ ;;
+ m88110 | m680[01234]0 | m683?2 | m68360 | z8k | v70 | h8500 | w65) # CYGNUS LOCAL
+ basic_machine=$basic_machine-unknown
+ ;;
+ mips64vr4300 | mips64vr4300el) # CYGNUS LOCAL jsmith/vr4300
+ basic_machine=$basic_machine-unknown
+ ;;
+ mips64vr4100 | mips64vr4100el) # CYGNUS LOCAL jsmith/vr4100
+ basic_machine=$basic_machine-unknown
+ ;;
+ mips64vr5000 | mips64vr5000el) # CYGNUS LOCAL ian/vr5000
+ basic_machine=$basic_machine-unknown
+ ;;
+ mips16) # CYGNUS LOCAL krk/mips16
+ basic_machine=$basic_machine-unknown
+ ;;
+ d10v) # CYGNUS LOCAL meissner/d10v
+ basic_machine=$basic_machine-unknown
+ ;;
+ # We use `pc' rather than `unknown'
+ # because (1) that's what they normally are, and
+ # (2) the word "unknown" tends to confuse beginning users.
+ i[3456]86)
+ basic_machine=$basic_machine-pc
+ ;;
+ # Object if more than one company name word.
+ *-*-*)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+ # Recognize the basic CPU types with company name.
+ vax-* | tahoe-* | i[3456]86-* | i860-* | m32r-* | m68k-* | m68000-* \
+ | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \
+ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \
+ | power-* | none-* | 580-* | cray2-* | h8300-* | i960-* \
+ | xmp-* | ymp-* | hppa-* | hppa1.0-* | hppa1.1-* \
+ | alpha-* | alphaev5-* | alphaev56-* | we32k-* | cydra-* \
+ | ns16k-* | pn-* | np1-* | xps100-* | clipper-* | orion-* \
+ | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \
+ | sparc64-* | mips64-* | mipsel-* \
+ | mips64el-* | mips64orion-* | mips64orionel-* \
+ | mipstx39-* | mipstx39el-* \
+ | f301-*)
+ ;;
+ m88110-* | m680[01234]0-* | m683?2-* | m68360-* | z8k-* | h8500-* | d10v-*) # CYGNUS LOCAL
+ ;;
+ mips64vr4300-* | mips64vr4300el-*) # CYGNUS LOCAL jsmith/vr4300
+ ;;
+ mips64vr4100-* | mips64vr4100el-*) # CYGNUS LOCAL jsmith/vr4100
+ ;;
+ mips16-*) # CYGNUS LOCAL krk/mips16
+ ;;
+ # Recognize the various machine names and aliases which stand
+ # for a CPU type and a company and sometimes even an OS.
+ 386bsd) # CYGNUS LOCAL
+ basic_machine=i386-unknown
+ os=-bsd
+ ;;
+ 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+ basic_machine=m68000-att
+ ;;
+ 3b*)
+ basic_machine=we32k-att
+ ;;
+ a29khif) # CYGNUS LOCAL
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ adobe68k) # CYGNUS LOCAL
+ basic_machine=m68010-adobe
+ os=-scout
+ ;;
+ alliant | fx80)
+ basic_machine=fx80-alliant
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ ;;
+ am29k)
+ basic_machine=a29k-none
+ os=-bsd
+ ;;
+ amdahl)
+ basic_machine=580-amdahl
+ os=-sysv
+ ;;
+ amiga | amiga-*)
+ basic_machine=m68k-cbm
+ ;;
+ amigados)
+ basic_machine=m68k-cbm
+ os=-amigados
+ ;;
+ amigaunix | amix)
+ basic_machine=m68k-cbm
+ os=-sysv4
+ ;;
+ apollo68)
+ basic_machine=m68k-apollo
+ os=-sysv
+ ;;
+ apollo68bsd) # CYGNUS LOCAL
+ basic_machine=m68k-apollo
+ os=-bsd
+ ;;
+ aux)
+ basic_machine=m68k-apple
+ os=-aux
+ ;;
+ balance)
+ basic_machine=ns32k-sequent
+ os=-dynix
+ ;;
+ convex-c1)
+ basic_machine=c1-convex
+ os=-bsd
+ ;;
+ convex-c2)
+ basic_machine=c2-convex
+ os=-bsd
+ ;;
+ convex-c32)
+ basic_machine=c32-convex
+ os=-bsd
+ ;;
+ convex-c34)
+ basic_machine=c34-convex
+ os=-bsd
+ ;;
+ convex-c38)
+ basic_machine=c38-convex
+ os=-bsd
+ ;;
+ cray | ymp)
+ basic_machine=ymp-cray
+ os=-unicos
+ ;;
+ cray2)
+ basic_machine=cray2-cray
+ os=-unicos
+ ;;
+ [ctj]90-cray)
+ basic_machine=c90-cray
+ os=-unicos
+ ;;
+ crds | unos)
+ basic_machine=m68k-crds
+ ;;
+ da30 | da30-*)
+ basic_machine=m68k-da30
+ ;;
+ decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ ;;
+ delta | 3300 | motorola-3300 | motorola-delta \
+ | 3300-motorola | delta-motorola)
+ basic_machine=m68k-motorola
+ ;;
+ delta88)
+ basic_machine=m88k-motorola
+ os=-sysv3
+ ;;
+ dpx20 | dpx20-*)
+ basic_machine=rs6000-bull
+ os=-bosx
+ ;;
+ dpx2* | dpx2*-bull)
+ basic_machine=m68k-bull
+ os=-sysv3
+ ;;
+ ebmon29k)
+ basic_machine=a29k-amd
+ os=-ebmon
+ ;;
+ elxsi)
+ basic_machine=elxsi-elxsi
+ os=-bsd
+ ;;
+ encore | umax | mmax)
+ basic_machine=ns32k-encore
+ ;;
+ es1800 | OSE68k | ose68k | ose | OSE) # CYGNUS LOCAL
+ basic_machine=m68k-ericsson
+ os=-ose
+ ;;
+ fx2800)
+ basic_machine=i860-alliant
+ ;;
+ genix)
+ basic_machine=ns32k-ns
+ ;;
+ gmicro)
+ basic_machine=tron-gmicro
+ os=-sysv
+ ;;
+ h3050r* | hiux*)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ h8300hms)
+ basic_machine=h8300-hitachi
+ os=-hms
+ ;;
+ h8300xray) # CYGNUS LOCAL
+ basic_machine=h8300-hitachi
+ os=-xray
+ ;;
+ h8500hms) # CYGNUS LOCAL
+ basic_machine=h8500-hitachi
+ os=-hms
+ ;;
+ harris)
+ basic_machine=m88k-harris
+ os=-sysv3
+ ;;
+ hp300-*)
+ basic_machine=m68k-hp
+ ;;
+ hp300bsd)
+ basic_machine=m68k-hp
+ os=-bsd
+ ;;
+ hp300hpux)
+ basic_machine=m68k-hp
+ os=-hpux
+ ;;
+ w89k-*) # CYGNUS LOCAL
+ basic_machine=hppa1.1-winbond
+ os=-proelf
+ ;;
+ op50n-*) # CYGNUS LOCAL
+ basic_machine=hppa1.1-oki
+ os=-proelf
+ ;;
+ op60c-*) # CYGNUS LOCAL
+ basic_machine=hppa1.1-oki
+ os=-proelf
+ ;;
+ hppro) # CYGNUS LOCAL
+ basic_machine=hppa1.1-hp
+ os=-proelf
+ ;;
+ hp9k2[0-9][0-9] | hp9k31[0-9])
+ basic_machine=m68000-hp
+ ;;
+ hp9k3[2-9][0-9])
+ basic_machine=m68k-hp
+ ;;
+ hp9k7[0-9][0-9] | hp7[0-9][0-9] | hp9k8[0-9]7 | hp8[0-9]7)
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[0-9][0-9] | hp8[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hppa-next)
+ os=-nextstep3
+ ;;
+ hppaosf) # CYGNUS LOCAL
+ basic_machine=hppa1.1-hp
+ os=-osf
+ ;;
+ i370-ibm* | ibm*)
+ basic_machine=i370-ibm
+ os=-mvs
+ ;;
+# I'm not sure what "Sysv32" means. Should this be sysv3.2?
+ i[3456]86v32)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv32
+ ;;
+ i[3456]86v4*)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv4
+ ;;
+ i[3456]86v)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv
+ ;;
+ i[3456]86sol2)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-solaris2
+ ;;
+ i386mach) # CYGNUS LOCAL
+ basic_machine=i386-mach
+ os=-mach
+ ;;
+ i386-vsta | vsta) # CYGNUS LOCAL
+ basic_machine=i386-unknown
+ os=-vsta
+ ;;
+ i386-go32 | go32) # CYGNUS LOCAL
+ basic_machine=i386-unknown
+ os=-go32
+ ;;
+ iris | iris4d)
+ basic_machine=mips-sgi
+ case $os in
+ -irix*)
+ ;;
+ *)
+ os=-irix4
+ ;;
+ esac
+ ;;
+ isi68 | isi)
+ basic_machine=m68k-isi
+ os=-sysv
+ ;;
+ m88k-omron*)
+ basic_machine=m88k-omron
+ ;;
+ magnum | m3230)
+ basic_machine=mips-mips
+ os=-sysv
+ ;;
+ merlin)
+ basic_machine=ns32k-utek
+ os=-sysv
+ ;;
+ miniframe)
+ basic_machine=m68000-convergent
+ ;;
+ mipsel*-linux*)
+ basic_machine=mipsel-unknown
+ os=-linux-gnu
+ ;;
+ mips*-linux*)
+ basic_machine=mips-unknown
+ os=-linux-gnu
+ ;;
+ mips3*-*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
+ ;;
+ mips3*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
+ ;;
+ monitor) # CYGNUS LOCAL
+ basic_machine=m68k-rom68k
+ os=-coff
+ ;;
+ msdos) # CYGNUS LOCAL
+ basic_machine=i386-unknown
+ os=-msdos
+ ;;
+ ncr3000)
+ basic_machine=i486-ncr
+ os=-sysv4
+ ;;
+ netbsd386)
+ basic_machine=i386-unknown # CYGNUS LOCAL
+ os=-netbsd
+ ;;
+ news | news700 | news800 | news900)
+ basic_machine=m68k-sony
+ os=-newsos
+ ;;
+ news1000)
+ basic_machine=m68030-sony
+ os=-newsos
+ ;;
+ news-3600 | risc-news)
+ basic_machine=mips-sony
+ os=-newsos
+ ;;
+ necv70) # CYGNUS LOCAL
+ basic_machine=v70-nec
+ os=-sysv
+ ;;
+ next | m*-next )
+ basic_machine=m68k-next
+ case $os in
+ -nextstep* )
+ ;;
+ -ns2*)
+ os=-nextstep2
+ ;;
+ *)
+ os=-nextstep3
+ ;;
+ esac
+ ;;
+ nh3000)
+ basic_machine=m68k-harris
+ os=-cxux
+ ;;
+ nh[45]000)
+ basic_machine=m88k-harris
+ os=-cxux
+ ;;
+ nindy960)
+ basic_machine=i960-intel
+ os=-nindy
+ ;;
+ mon960) # CYGNUS LOCAL
+ basic_machine=i960-intel
+ os=-mon960
+ ;;
+ np1)
+ basic_machine=np1-gould
+ ;;
+ OSE68000 | ose68000) # CYGNUS LOCAL
+ basic_machine=m68000-ericsson
+ os=-ose
+ ;;
+ os68k) # CYGNUS LOCAL
+ basic_machine=m68k-none
+ os=-os68k
+ ;;
+ pa-hitachi)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ paragon)
+ basic_machine=i860-intel
+ os=-osf
+ ;;
+ pbd)
+ basic_machine=sparc-tti
+ ;;
+ pbb)
+ basic_machine=m68k-tti
+ ;;
+ pc532 | pc532-*)
+ basic_machine=ns32k-pc532
+ ;;
+ pentium | p5)
+ basic_machine=i586-intel
+ ;;
+ pentiumpro | p6)
+ basic_machine=i686-intel
+ ;;
+ pentium-* | p5-*)
+ basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pentiumpro-* | p6-*)
+ basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ k5)
+ # We don't have specific support for AMD's K5 yet, so just call it a Pentium
+ basic_machine=i586-amd
+ ;;
+ nexen)
+ # We don't have specific support for Nexgen yet, so just call it a Pentium
+ basic_machine=i586-nexgen
+ ;;
+ pn)
+ basic_machine=pn-gould
+ ;;
+ power) basic_machine=rs6000-ibm
+ ;;
+ ppc) basic_machine=powerpc-unknown
+ ;;
+ ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ppcle | powerpclittle | ppc-le | powerpc-little)
+ basic_machine=powerpcle-unknown
+ ;;
+ ppcle-* | powerpclittle-*)
+ basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ps2)
+ basic_machine=i386-ibm
+ ;;
+ rom68k) # CYGNUS LOCAL
+ basic_machine=m68k-rom68k
+ os=-coff
+ ;;
+ rm[46]00)
+ basic_machine=mips-siemens
+ ;;
+ rtpc | rtpc-*)
+ basic_machine=romp-ibm
+ ;;
+ sa29200) # CYGNUS LOCAL
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ sequent)
+ basic_machine=i386-sequent
+ ;;
+ sh)
+ basic_machine=sh-hitachi
+ os=-hms
+ ;;
+ sparclite-wrs) # CYGNUS LOCAL
+ basic_machine=sparclite-wrs
+ os=-vxworks
+ ;;
+ sps7)
+ basic_machine=m68k-bull
+ os=-sysv2
+ ;;
+ spur)
+ basic_machine=spur-unknown
+ ;;
+ st2000) # CYGNUS LOCAL
+ basic_machine=m68k-tandem
+ ;;
+ stratus) # CYGNUS LOCAL
+ basic_machine=i860-stratus
+ os=-sysv4
+ ;;
+ sun2)
+ basic_machine=m68000-sun
+ ;;
+ sun2os3)
+ basic_machine=m68000-sun
+ os=-sunos3
+ ;;
+ sun2os4)
+ basic_machine=m68000-sun
+ os=-sunos4
+ ;;
+ sun3os3)
+ basic_machine=m68k-sun
+ os=-sunos3
+ ;;
+ sun3os4)
+ basic_machine=m68k-sun
+ os=-sunos4
+ ;;
+ sun4os3)
+ basic_machine=sparc-sun
+ os=-sunos3
+ ;;
+ sun4os4)
+ basic_machine=sparc-sun
+ os=-sunos4
+ ;;
+ sun4sol2)
+ basic_machine=sparc-sun
+ os=-solaris2
+ ;;
+ sun3 | sun3-*)
+ basic_machine=m68k-sun
+ ;;
+ sun4)
+ basic_machine=sparc-sun
+ ;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ ;;
+ symmetry)
+ basic_machine=i386-sequent
+ os=-dynix
+ ;;
+ tx39)
+ basic_machine=mipstx39-unknown
+ ;;
+ tx39el)
+ basic_machine=mipstx39el-unknown
+ ;;
+ tower | tower-32)
+ basic_machine=m68k-ncr
+ ;;
+ udi29k)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ ultra3)
+ basic_machine=a29k-nyu
+ os=-sym1
+ ;;
+ v810 | necv810) # CYGNUS LOCAL
+ basic_machine=v810-nec
+ os=-none
+ ;;
+ vaxv)
+ basic_machine=vax-dec
+ os=-sysv
+ ;;
+ vms)
+ basic_machine=vax-dec
+ os=-vms
+ ;;
+ vpp*|vx|vx-*)
+ basic_machine=f301-fujitsu
+ ;;
+ vxworks960)
+ basic_machine=i960-wrs
+ os=-vxworks
+ ;;
+ vxworks68)
+ basic_machine=m68k-wrs
+ os=-vxworks
+ ;;
+ vxworks29k)
+ basic_machine=a29k-wrs
+ os=-vxworks
+ ;;
+ w65*) # CYGNUS LOCAL
+ basic_machine=w65-wdc
+ os=-none
+ ;;
+ xmp)
+ basic_machine=xmp-cray
+ os=-unicos
+ ;;
+ xps | xps100)
+ basic_machine=xps100-honeywell
+ ;;
+ z8k-*-coff) # CYGNUS LOCAL
+ basic_machine=z8k-unknown
+ os=-sim
+ ;;
+ none)
+ basic_machine=none-none
+ os=-none
+ ;;
+
+# Here we handle the default manufacturer of certain CPU types. It is in
+# some cases the only manufacturer, in others, it is the most popular.
+ w89k) # CYGNUS LOCAL
+ basic_machine=hppa1.1-winbond
+ ;;
+ op50n) # CYGNUS LOCAL
+ basic_machine=hppa1.1-oki
+ ;;
+ op60c) # CYGNUS LOCAL
+ basic_machine=hppa1.1-oki
+ ;;
+ mips)
+ if [ x$os = x-linux-gnu ]; then
+ basic_machine=mips-unknown
+ else
+ basic_machine=mips-mips
+ fi
+ ;;
+ romp)
+ basic_machine=romp-ibm
+ ;;
+ rs6000)
+ basic_machine=rs6000-ibm
+ ;;
+ vax)
+ basic_machine=vax-dec
+ ;;
+ pdp11)
+ basic_machine=pdp11-dec
+ ;;
+ we32k)
+ basic_machine=we32k-att
+ ;;
+ sparc)
+ basic_machine=sparc-sun
+ ;;
+ cydra)
+ basic_machine=cydra-cydrome
+ ;;
+ orion)
+ basic_machine=orion-highlevel
+ ;;
+ orion105)
+ basic_machine=clipper-highlevel
+ ;;
+ mac | mpw | mac-mpw) # CYGNUS LOCAL
+ basic_machine=m68k-apple
+ ;;
+ pmac | pmac-mpw) # CYGNUS LOCAL
+ basic_machine=powerpc-apple
+ ;;
+ *)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+ *-digital*)
+ basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
+ ;;
+ *-commodore*)
+ basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
+ ;;
+ *)
+ ;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+ # First match some system type aliases
+ # that might get confused with valid system types.
+ # -solaris* is a basic system type, with this one exception.
+ -solaris1 | -solaris1.*)
+ os=`echo $os | sed -e 's|solaris1|sunos4|'`
+ ;;
+ -solaris)
+ os=-solaris2
+ ;;
+ -unixware* | svr4*)
+ os=-sysv4
+ ;;
+ -gnu/linux*)
+ os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+ ;;
+ # First accept the basic system types.
+ # The portable systems comes first.
+ # Each alternative MUST END IN A *, to match a version number.
+ # -sysv* is not here because it comes later, after sysvr4.
+ -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
+ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
+ | -amigados* | -msdos* | -newsos* | -unicos* | -aof* | -aos* \
+ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+ | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \
+ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \
+ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+ | -cygwin32* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+ | -mingw32* | -linux-gnu* | -uxpv*)
+ # Remember, each alternative MUST END IN *, to match a version number.
+ ;;
+ # CYGNUS LOCAL
+ -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+ | -windows* | -osx | -abug | -netware* | -os9* | -beos* \
+ | -macos* | -mpw* | -magic* | -mon960* | -lnews* )
+ ;;
+ -mac*)
+ os=`echo $os | sed -e 's|mac|macos|'`
+ ;;
+ # END CYGNUS LOCAL
+ -linux*)
+ os=`echo $os | sed -e 's|linux|linux-gnu|'`
+ ;;
+ -sunos5*)
+ os=`echo $os | sed -e 's|sunos5|solaris2|'`
+ ;;
+ -sunos6*)
+ os=`echo $os | sed -e 's|sunos6|solaris3|'`
+ ;;
+ -osfrose*)
+ os=-osfrose
+ ;;
+ -osf*)
+ os=-osf
+ ;;
+ -utek*)
+ os=-bsd
+ ;;
+ -dynix*)
+ os=-bsd
+ ;;
+ -acis*)
+ os=-aos
+ ;;
+ -386bsd) # CYGNUS LOCAL
+ os=-bsd
+ ;;
+ -ctix* | -uts*)
+ os=-sysv
+ ;;
+ -ns2 )
+ os=-nextstep2
+ ;;
+ # Preserve the version number of sinix5.
+ -sinix5.*)
+ os=`echo $os | sed -e 's|sinix|sysv|'`
+ ;;
+ -sinix*)
+ os=-sysv4
+ ;;
+ -triton*)
+ os=-sysv3
+ ;;
+ -oss*)
+ os=-sysv3
+ ;;
+ -svr4)
+ os=-sysv4
+ ;;
+ -svr3)
+ os=-sysv3
+ ;;
+ -sysvr4)
+ os=-sysv4
+ ;;
+ # This must come after -sysvr4.
+ -sysv*)
+ ;;
+ -ose*) # CYGNUS LOCAL
+ os=-ose
+ ;;
+ -es1800*) # CYGNUS LOCAL
+ os=-ose
+ ;;
+ -xenix)
+ os=-xenix
+ ;;
+ -none)
+ ;;
+ *)
+ # Get rid of the `-' at the beginning of $os.
+ os=`echo $os | sed 's/[^-]*-//'`
+ echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system. Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+ *-acorn)
+ os=-riscix1.2
+ ;;
+ arm*-semi)
+ os=-aout
+ ;;
+ pdp11-*)
+ os=-none
+ ;;
+ *-dec | vax-*)
+ os=-ultrix4.2
+ ;;
+ m68*-apollo)
+ os=-domain
+ ;;
+ i386-sun)
+ os=-sunos4.0.2
+ ;;
+ m68000-sun)
+ os=-sunos3
+ # This also exists in the configure program, but was not the
+ # default.
+ # os=-sunos4
+ ;;
+ m68*-cisco) # CYGNUS LOCAL
+ os=-aout
+ ;;
+ mips*-cisco) # CYGNUS LOCAL
+ os=-elf
+ ;;
+ mips*-*) # CYGNUS LOCAL
+ os=-elf
+ ;;
+ *-tti) # must be before sparc entry or we get the wrong os.
+ os=-sysv3
+ ;;
+ sparc-* | *-sun)
+ os=-sunos4.1.1
+ ;;
+ *-be) # CYGNUS LOCAL
+ os=-beos
+ ;;
+ *-ibm)
+ os=-aix
+ ;;
+ *-wec) # CYGNUS LOCAL
+ os=-proelf
+ ;;
+ *-winbond) # CYGNUS LOCAL
+ os=-proelf
+ ;;
+ *-oki) # CYGNUS LOCAL
+ os=-proelf
+ ;;
+ *-hp)
+ os=-hpux
+ ;;
+ *-hitachi)
+ os=-hiux
+ ;;
+ i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+ os=-sysv
+ ;;
+ *-cbm)
+ os=-amigados
+ ;;
+ *-dg)
+ os=-dgux
+ ;;
+ *-dolphin)
+ os=-sysv3
+ ;;
+ m68k-ccur)
+ os=-rtu
+ ;;
+ m88k-omron*)
+ os=-luna
+ ;;
+ *-next )
+ os=-nextstep
+ ;;
+ *-sequent)
+ os=-ptx
+ ;;
+ *-crds)
+ os=-unos
+ ;;
+ *-ns)
+ os=-genix
+ ;;
+ i370-*)
+ os=-mvs
+ ;;
+ *-next)
+ os=-nextstep3
+ ;;
+ *-gould)
+ os=-sysv
+ ;;
+ *-highlevel)
+ os=-bsd
+ ;;
+ *-encore)
+ os=-bsd
+ ;;
+ *-sgi)
+ os=-irix
+ ;;
+ *-siemens)
+ os=-sysv4
+ ;;
+ *-masscomp)
+ os=-rtu
+ ;;
+ f301-fujitsu)
+ os=-uxpv
+ ;;
+ *-rom68k) # CYGNUS LOCAL
+ os=-coff
+ ;;
+ *-*bug) # CYGNUS LOCAL
+ os=-coff
+ ;;
+ *-apple) # CYGNUS LOCAL
+ os=-macos
+ ;;
+ *)
+ os=-none
+ ;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer. We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+ *-unknown)
+ case $os in
+ -riscix*)
+ vendor=acorn
+ ;;
+ -sunos*)
+ vendor=sun
+ ;;
+ -aix*)
+ vendor=ibm
+ ;;
+ -beos*) # CYGNUS LOCAL
+ vendor=be
+ ;;
+ -hpux*)
+ vendor=hp
+ ;;
+ -hiux*)
+ vendor=hitachi
+ ;;
+ -unos*)
+ vendor=crds
+ ;;
+ -dgux*)
+ vendor=dg
+ ;;
+ -luna*)
+ vendor=omron
+ ;;
+ -genix*)
+ vendor=ns
+ ;;
+ -mvs*)
+ vendor=ibm
+ ;;
+ -ptx*)
+ vendor=sequent
+ ;;
+ -vxsim* | -vxworks*)
+ vendor=wrs
+ ;;
+ -aux*)
+ vendor=apple
+ ;;
+ -hms*) # CYGNUS LOCAL
+ vendor=hitachi
+ ;;
+ -mpw* | -macos*) # CYGNUS LOCAL
+ vendor=apple
+ ;;
+ esac
+ basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+ ;;
+esac
+
+echo $basic_machine$os
diff --git a/config/ChangeLog b/config/ChangeLog
new file mode 100644
index 00000000000..b68a85c7a21
--- /dev/null
+++ b/config/ChangeLog
@@ -0,0 +1,312 @@
+Wed Jul 23 12:32:18 1997 Robert Hoehne <robert.hoehne@Mathematik.TU-Chemnitz.DE>
+
+ * mh-go32 (CFLAGS): Don't set -fno-omit-frame-pointer.
+
+Mon Jun 16 19:06:41 1997 Geoff Keating <geoffk@ozemail.com.au>
+
+ * mh-ppcpic: New file.
+ * mt-ppcpic: New file.
+
+Thu Mar 27 15:52:40 1997 Geoffrey Noer <noer@cygnus.com>
+
+ * mh-cygwin32: override CXXFLAGS, setting to -O2 only
+ (no debug)
+
+Tue Mar 25 18:16:43 1997 Geoffrey Noer <noer@cygnus.com>
+
+ * mh-cygwin32: override LIBGCC2_DEBUG_CFLAGS so debug info
+ isn't included in cygwin32-hosted libgcc2.a by default
+
+Wed Jan 8 19:56:43 1997 Geoffrey Noer <noer@cygnus.com>
+
+ * mh-cygwin32: override CFLAGS so debug info isn't included
+ in cygwin32-hosted tools by default
+
+Tue Dec 31 16:04:26 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * mh-linux: Remove.
+
+Mon Nov 11 10:29:51 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * mt-ppc: Delete file, options moved to newlib configure.
+
+Fri Oct 4 12:21:03 1996 Angela Marie Thomas (angela@cygnus.com)
+
+ * mh-dgux386: New file. x86 dgux specific flags
+
+Mon Sep 30 15:10:07 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-mh-mpw (EXTRALIBS_PPC_XCOFF): New, was EXTRALIBS_PPC.
+ (EXTRALIBS_PPC): Use shared libraries instead of xcoff.
+
+Sat Aug 17 04:56:25 1996 Geoffrey Noer <noer@skaro.cygnus.com>
+
+ * mh-cygwin32: don't -D_WIN32 here anymore
+
+Thu Aug 15 19:46:44 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-mh-mpw (SEGFLAG_68K, SEGFLAG_PPC): Remove.
+ (EXTRALIBS_PPC): Add libgcc.xcoff.
+
+Thu Aug 8 14:51:47 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * mt-ppc: New file, add -mrelocatable-lib and -mno-eabi to all
+ target builds for PowerPC eabi targets.
+
+Fri Jul 12 12:06:01 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw: New subdir, Mac MPW configuration support bits.
+
+Mon Jul 8 17:30:52 1996 Jim Wilson <wilson@cygnus.com>
+
+ * mh-irix6: New file.
+
+Mon Jul 8 15:15:37 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * mt-sparcpic (PICFLAG_FOR_TARGET): Use -fPIC.
+
+Fri Jul 5 11:49:02 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * mh-irix4 (RANLIB): Don't define; Irix 4 does have ranlib.
+
+Sun Jun 23 22:59:25 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * mh-cygwin32: new file. Like mh-go32 without the CFLAGS entry.
+
+Tue Mar 26 14:10:41 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * mh-go32 (CFLAGS): Define.
+
+Thu Mar 14 19:20:54 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * mh-necv4: New file.
+
+Thu Feb 15 13:07:43 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * mh-cxux (CC): New variable.
+ (CFLAGS, LDFLAGS): Remove.
+ * mh-ncrsvr43 (CC): New variable.
+ (CFLAGS): Remove.
+ * mh-solaris (CFLAGS): Remove.
+
+ * mh-go32: Remove most variable settings, since they presumed a
+ Canadian Cross, which is now handled correctly by the configure
+ script.
+
+ * mh-sparcpic (PICFLAG): Set to -fPIC, not -fpic.
+
+Mon Feb 12 14:53:39 1996 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
+
+ * mh-m68kpic, mt-m68kpic: New files.
+
+Thu Feb 1 14:15:42 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-mh-mpw (CC_MWC68K): Add options similar to those used
+ in CC_MWCPPC, and -mc68020 -model far.
+ (AR_MWLINK68K): Add -xm library.
+ (AR_AR): Define.
+ (CC_LD_MWLINK68K): Remove -d.
+ (EXTRALIBS_MWC68K): Define.
+
+Thu Jan 25 16:05:33 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * mh-ncrsvr43 (CFLAGS): Remove -Hnocopyr.
+
+Tue Nov 7 15:41:30 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-mh-mpw (CC_MWC68K, CC_MWCPPC): Remove unused include path.
+ (CC_MWCPPC): Add -mpw_chars, disable warnings, add comments
+ explaining reasons for various flags.
+ (EXTRALIBS_PPC, EXTRALIBS_MWCPPC ): Put runtime library first.
+
+Fri Oct 13 14:44:25 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * mh-aix, mh-sun: Removed.
+
+ * mh-decstation (X11_EXTRA_CFLAGS): Define.
+
+ * mh-sco, mh-solaris, mh-sysv4 (X11_EXTRA_LIBS): Define.
+
+ * mh-hp300, mh-hpux, mh-hpux8, mh-solaris, mh-sun3, mh-sysv4: Don't
+ hardcode location of X stuff here.
+
+Thu Sep 28 13:14:56 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-mh-mpw: Add definitions for various 68K and PowerMac
+ compilers, add definitions for library and link steps for
+ PowerMacs.
+
+Thu Sep 14 08:20:04 1995 Fred Fish <fnf@cygnus.com>
+
+ * mh-hp300 (CC): Add "CC = cc -Wp,-H256000" to avoid
+ "too much defining" errors from the HPUX compiler.
+
+Thu Aug 17 17:28:56 1995 Ken Raeburn <raeburn@kr-laptop.cygnus.com>
+
+ * mh-hp300 (RANLIB): Use "ar ts", in case GNU ar was used and
+ didn't build a symbol table.
+
+Thu Jun 22 17:47:24 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-mh-mpw (CC): Define ANSI_PROTOTYPES.
+
+Mon Apr 10 12:29:48 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-mh-mpw (EXTRALIBS): Always link in Math.o, CSANELIB.o,
+ and ToolLibs.o.
+
+ * mpw-mh-mpw (CC): Define ALMOST_STDC.
+ (CFLAGS): Remove ALMOST_STDC, -mc68881.
+ (LDFLAGS): add -w.
+
+ * mpw-mh-mpw (CFLAGS): Add -b option to put strings at the ends of
+ functions.
+
+ * mpw-mh-mpw: New file, host makefile definitions for MPW.
+
+Fri Mar 31 11:35:17 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * mt-netware: New file.
+
+Mon Mar 13 12:31:29 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * mh-hpux8: New file.
+ * mh-hpux: Use X11R5 rather than X11R4.
+
+Thu Feb 9 11:04:13 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * mh-linux (SYSV): Don't define.
+ (RANLIB): Don't define.
+
+Wed Jan 11 16:29:34 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * m?-*pic (LIBCXXFLAGS): Add -fno-implicit-templates.
+
+Thu Nov 3 17:27:19 1994 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * mh-irix4 (CC): Increase maximum string length.
+
+ * mh-sco (CC): Define away const, it doesn't work right; elements
+ of arrays of ptr-to-const are considered const themselves.
+
+Sat Jul 16 12:17:49 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * mh-cxux: New file, from Bob Rusk (rrusk@mail.csd.harris.com).
+
+Sat Jun 4 17:22:12 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * mh-ncrsvr43: New file from Tom McConnell
+ <tmcconne@sedona.intel.com>.
+
+Thu May 19 00:32:11 1994 Jeff Law (law@snake.cs.utah.edu)
+
+ * mh-hpux (CC): Add -Wp,-H256000 to avoid "too much defining"
+ errors from the HPUX 8 compilers.
+
+Wed May 4 20:14:47 1994 D. V. Henkel-Wallace (gumby@cygnus.com)
+
+ * mh-lynxrs6k: set SHELL to /bin/bash
+
+Tue Apr 12 12:38:17 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * mh-irix4 (CC): Change -XNh1500 to -XNh2000.
+
+Sat Dec 25 20:03:45 1993 Jeffrey A. Law (law@snake.cs.utah.edu)
+
+ * mt-hppa: Delete.
+
+Tue Nov 16 22:54:39 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * mh-a68bsd: Define CC to gcc.
+
+Mon Nov 15 16:56:51 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * mh-linux: Don't put -static in LDFLAGS. Add comments.
+
+Mon Nov 15 13:37:58 1993 david d `zoo' zuhn (zoo@cirdan.cygnus.com)
+
+ * mh-sysv4 (AR_FLAGS): change from cq to cr
+
+Fri Nov 5 08:12:32 1993 D. V. Henkel-Wallace (gumby@blues.cygnus.com)
+
+ * mh-unixware: remove. It's the same as sysv4, and config.guess
+ can't tell the difference. So don't allow skew.
+
+Wed Oct 20 20:35:14 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * mh-hp300: Revert yesterday's change, but add comment explaining.
+
+Tue Oct 19 18:58:21 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * mh-hp300: Don't define CFLAGS to empty. Why should hp300 be
+ different from anything else? ("gdb doesn't understand the native
+ debug format" isn't a good enough answer because we might be using
+ gcc).
+
+Tue Oct 5 12:17:40 1993 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * mh-alphaosf: Remove, no longer necessary now that gdb knows
+ how to handle OSF/1 shared libraries.
+
+Tue Jul 6 11:27:33 1993 Steve Chamberlain (sac@phydeaux.cygnus.com)
+
+ * mh-alphaosf: New file.
+
+Thu Jul 1 15:49:33 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * mh-riscos: New file.
+
+Mon Jun 14 12:03:18 1993 david d `zoo' zuhn (zoo at rtl.cygnus.com)
+
+ * mh-aix, mh-aix386, mh-decstation, mh-delta88, mh-hpux, mh-irix4,
+ mh-ncr3000, mh-solaris, mh-sysv, mh-sysv4: remove INSTALL=cp line,
+ now that we're using install.sh globally
+
+Fri Jun 4 16:09:34 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * mh-sysv4 (INSTALL): Use cp, not /usr/ucb/install.
+
+Thu Apr 8 11:21:52 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * mt-a29k, mt-ebmon29k, mt-os68k, mt-ose68000, mt-ose68k,
+ mt-vxworks68, mt-vxworks960: Removed obsolete, unused target
+ Makefile fragment files.
+
+Mon Mar 8 15:05:25 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * mh-aix386: New file; old mh-aix, plus no-op RANLIB.
+
+Thu Oct 1 13:50:48 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * mh-solaris: INSTALL is NOT /usr/ucb/install
+
+Mon Aug 24 14:25:35 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * mt-ose68000, mt-ose68k: renamed from mt-OSE*.
+
+Tue Jul 21 02:11:01 1992 D. V. Henkel-Wallace (gumby@cygnus.com)
+
+ * mt-OSE68k, mt-680000: new configs.
+
+Thu Jul 16 17:12:09 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * mh-irix4: merged changes from progressive.
+
+Tue Jun 9 23:29:38 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Everywhere: Change RANLIB=echo>/dev/null (which confuses
+ some shells - and I don't blame them) to RANLIB=true.
+ * mh-solaris: Use /usr/ucb/install for INSTALL.
+
+Sun May 31 14:45:23 1992 Mark Eichin (eichin at cygnus.com)
+
+ * mh-solaris2: Add new configuration for Solaris 2 (sysv, no ranlib)
+
+Fri Apr 10 23:10:08 1992 Fred Fish (fnf@cygnus.com)
+
+ * mh-ncr3000: Add new configuration for NCR 3000.
+
+Tue Dec 10 00:10:55 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * ChangeLog: fresh changelog.
+
diff --git a/config/mh-a68bsd b/config/mh-a68bsd
new file mode 100644
index 00000000000..c991289dd5f
--- /dev/null
+++ b/config/mh-a68bsd
@@ -0,0 +1,12 @@
+RANLIB=true
+
+#None of the Apollo compilers can compile gas or binutils. The preprocessor
+# chokes on bfd, the compiler won't let you assign integers to enums, and
+# other problems. Defining CC to gcc is a questionable way to say "don't use
+# the apollo compiler" (the preferred version of GCC could be called cc,
+# or whatever), but I'm not sure leaving CC as cc is any better...
+
+#CC=cc -A ansi -A runtype,any -A systype,any -U__STDC__ -DNO_STDARG
+CC=gcc
+
+BISON=yacc
diff --git a/config/mh-aix386 b/config/mh-aix386
new file mode 100644
index 00000000000..4accd1cddfb
--- /dev/null
+++ b/config/mh-aix386
@@ -0,0 +1 @@
+RANLIB = @:
diff --git a/config/mh-apollo68 b/config/mh-apollo68
new file mode 100644
index 00000000000..4497ed93585
--- /dev/null
+++ b/config/mh-apollo68
@@ -0,0 +1,3 @@
+HDEFINES = -DUSG
+RANLIB=true
+CC= cc -A ansi -A runtype,any -A systype,any -U__STDC__ -DUSG
diff --git a/config/mh-cxux b/config/mh-cxux
new file mode 100644
index 00000000000..54b2a16c834
--- /dev/null
+++ b/config/mh-cxux
@@ -0,0 +1,14 @@
+# Configuration for Harris CX/UX 7 (and maybe 6), based on sysv4 configuration.
+
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV -DSVR4
+RANLIB = true
+
+# C++ debugging is not yet supported under SVR4 (DWARF)
+CXXFLAGS=-O
+
+# The l flag generates a warning from the SVR4 archiver, remove it.
+AR_FLAGS = cq
+
+# Under CX/UX, we want to tell the compiler to use ANSI mode.
+CC=cc -Xa
diff --git a/config/mh-cygwin32 b/config/mh-cygwin32
new file mode 100644
index 00000000000..3f6c1c6cbeb
--- /dev/null
+++ b/config/mh-cygwin32
@@ -0,0 +1,16 @@
+# We don't want debugging info in Win32-hosted toolchains.
+# Accomplish this by overriding CFLAGS.
+CFLAGS=-O2
+CXXFLAGS=-O2
+
+# We also need to override LIBGCC2_DEBUG_CFLAGS so libgcc2 will be
+# build without debugging information
+
+LIBGCC2_DEBUG_CFLAGS=
+
+# We set MAKEINFOFLAGS to not split .info files, because the resulting
+# file names don't work on DOS.
+MAKEINFOFLAGS=--no-split
+
+# custom installation rules for cygwin32 (append .exe to binaries, etc.)
+INSTALL_DOSREL=install-dosrel
diff --git a/config/mh-decstation b/config/mh-decstation
new file mode 100644
index 00000000000..37201926d5f
--- /dev/null
+++ b/config/mh-decstation
@@ -0,0 +1,5 @@
+CC = cc -Wf,-XNg1000
+
+# for X11, since the native DECwindows include files are really broken when
+# it comes to function prototypes.
+X11_EXTRA_CFLAGS = "-DNeedFunctionPrototypes=0"
diff --git a/config/mh-delta88 b/config/mh-delta88
new file mode 100644
index 00000000000..bc9c45302d5
--- /dev/null
+++ b/config/mh-delta88
@@ -0,0 +1,4 @@
+RANLIB = true
+
+
+
diff --git a/config/mh-dgux b/config/mh-dgux
new file mode 100644
index 00000000000..e7d85d6126a
--- /dev/null
+++ b/config/mh-dgux
@@ -0,0 +1,4 @@
+HDEFINES=-DHOST_SYS=DGUX_SYS
+CC=gcc -Wall -ansi -D__using_DGUX
+RANLIB=true
+
diff --git a/config/mh-dgux386 b/config/mh-dgux386
new file mode 100644
index 00000000000..15885c3e042
--- /dev/null
+++ b/config/mh-dgux386
@@ -0,0 +1,22 @@
+# from mh-dgux
+HDEFINES=-DHOST_SYS=DGUX_SYS
+CC=gcc -Wall -ansi -D__using_DGUX
+RANLIB = true
+
+# from mh-sysv4
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV -DSVR4
+RANLIB = true
+
+# C++ debugging is not yet supported under SVR4 (DWARF)
+CXXFLAGS=-O
+
+# The l flag generates a warning from the SVR4 archiver, remove it.
+AR_FLAGS = cr
+
+X11_EXTRA_LIBS = -lnsl
+
+# from angela
+# no debugging due to broken compiler, use BSD style timeofday
+CFLAGS=-O -D_BSD_TIMEOFDAY_FLAVOR
+
diff --git a/config/mh-go32 b/config/mh-go32
new file mode 100644
index 00000000000..f12007b0e0f
--- /dev/null
+++ b/config/mh-go32
@@ -0,0 +1,4 @@
+# We don't want to use debugging information on DOS. Unfortunately,
+# this requires that we set CFLAGS.
+# This used to set -fno-omit-frame-pointer.
+CFLAGS=-O2
diff --git a/config/mh-hp300 b/config/mh-hp300
new file mode 100644
index 00000000000..761724d92de
--- /dev/null
+++ b/config/mh-hp300
@@ -0,0 +1,13 @@
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV
+# Avoid "too much defining" errors from HPUX compiler.
+CC = cc -Wp,-H256000
+# If "ar" in $PATH is GNU ar, the symbol table may need rebuilding.
+# If it's HP/UX ar, this should be harmless.
+RANLIB = ar ts
+
+# Native cc can't bootstrap gcc with -g. Defining CFLAGS here loses (a)
+# for non-gcc directories, (b) if we are compiling with gcc, not
+# native cc. Neither (a) nor (b) has a trivial fix though.
+
+CFLAGS =
diff --git a/config/mh-hpux b/config/mh-hpux
new file mode 100644
index 00000000000..4d71c9dc837
--- /dev/null
+++ b/config/mh-hpux
@@ -0,0 +1,4 @@
+# Define SYSV as -DSYSV if you are using a System V operating system.
+CC = cc -Wp,-H256000
+SYSV = -DSYSV
+RANLIB = true
diff --git a/config/mh-hpux8 b/config/mh-hpux8
new file mode 100644
index 00000000000..4d71c9dc837
--- /dev/null
+++ b/config/mh-hpux8
@@ -0,0 +1,4 @@
+# Define SYSV as -DSYSV if you are using a System V operating system.
+CC = cc -Wp,-H256000
+SYSV = -DSYSV
+RANLIB = true
diff --git a/config/mh-irix4 b/config/mh-irix4
new file mode 100644
index 00000000000..6872145e833
--- /dev/null
+++ b/config/mh-irix4
@@ -0,0 +1,7 @@
+# Makefile changes for SGI's running IRIX-4.x.
+# Tell compiler to use K&R C. We can't compile under the SGI Ansi
+# environment. Also bump switch table size so that cp-parse will
+# compile. Bump string length limit so linker builds.
+
+CC = cc -cckr -Wf,-XNg1500 -Wf,-XNk1000 -Wf,-XNh2000 -Wf,-XNl8192
+SYSV = -DSYSV
diff --git a/config/mh-irix5 b/config/mh-irix5
new file mode 100644
index 00000000000..8bd7c99f844
--- /dev/null
+++ b/config/mh-irix5
@@ -0,0 +1,3 @@
+# Makefile changes for SGI's running IRIX-5.x.
+SYSV = -DSYSV
+RANLIB = true
diff --git a/config/mh-irix6 b/config/mh-irix6
new file mode 100644
index 00000000000..6d25c16b2f4
--- /dev/null
+++ b/config/mh-irix6
@@ -0,0 +1,7 @@
+# Makefile changes for SGI's running IRIX-6.x.
+SYSV = -DSYSV
+RANLIB = true
+# Specify the ABI, to ensure that all Irix 6 systems will behave the same.
+# Also, using -32 avoids bugs that exist in the n32/n64 support in some
+# versions of the SGI compiler.
+CC = cc -32
diff --git a/config/mh-lynxos b/config/mh-lynxos
new file mode 100644
index 00000000000..9afcb79fca7
--- /dev/null
+++ b/config/mh-lynxos
@@ -0,0 +1,2 @@
+# /bin/cc is less than useful for our purposes. Always use GCC
+CC = /bin/gcc
diff --git a/config/mh-lynxrs6k b/config/mh-lynxrs6k
new file mode 100644
index 00000000000..b2793996eff
--- /dev/null
+++ b/config/mh-lynxrs6k
@@ -0,0 +1,8 @@
+# LynxOS running on the rs6000 doesn't have ranlib
+RANLIB = true
+
+# /bin/cc is less than useful for our purposes. Always use GCC
+CC = /usr/cygnus/progressive/bin/gcc
+
+# /bin/sh is too buggy, so use /bin/bash instead.
+SHELL = /bin/bash
diff --git a/config/mh-m68kpic b/config/mh-m68kpic
new file mode 100644
index 00000000000..92e48d90fbd
--- /dev/null
+++ b/config/mh-m68kpic
@@ -0,0 +1 @@
+PICFLAG=-fpic
diff --git a/config/mh-ncr3000 b/config/mh-ncr3000
new file mode 100644
index 00000000000..5bbd8037009
--- /dev/null
+++ b/config/mh-ncr3000
@@ -0,0 +1,17 @@
+# Host configuration file for an NCR 3000 (i486/SVR4) system.
+
+# The NCR 3000 ships with a MetaWare compiler installed as /bin/cc.
+# This compiler not only emits obnoxious copyright messages every time
+# you run it, but it chokes and dies on a whole bunch of GNU source
+# files. Default to using the AT&T compiler installed in /usr/ccs/ATT/cc.
+# Unfortunately though, the AT&T compiler sometimes generates code that
+# the assembler barfs on if -g is used, so disable it by default as well.
+CC = /usr/ccs/ATT/cc
+CFLAGS =
+
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV -DSVR4
+RANLIB = true
+
+# The l flag generates a warning from the SVR4 archiver, remove it.
+AR_FLAGS = cq
diff --git a/config/mh-ncrsvr43 b/config/mh-ncrsvr43
new file mode 100644
index 00000000000..43b09912ca9
--- /dev/null
+++ b/config/mh-ncrsvr43
@@ -0,0 +1,9 @@
+# Host configuration file for an NCR 3000 (i486/SVR43) system.
+
+# The MetaWare compiler will generate a copyright message unless you
+# turn it off by adding the -Hnocopyr flag.
+CC = cc -Hnocopyr
+
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV -DSVR4
+RANLIB = true
diff --git a/config/mh-necv4 b/config/mh-necv4
new file mode 100644
index 00000000000..e887736f8be
--- /dev/null
+++ b/config/mh-necv4
@@ -0,0 +1,11 @@
+# Host Makefile fragment for NEC MIPS SVR4.
+
+# The C compiler on NEC MIPS SVR4 needs bigger tables.
+CC = cc -ZXNd=5000 -ZXNg=1000
+
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV -DSVR4
+RANLIB = true
+
+# NEC -lX11 needs some other libraries.
+X11_EXTRA_LIBS = -lsocket -lnsl
diff --git a/config/mh-papic b/config/mh-papic
new file mode 100644
index 00000000000..35cf2c8ee4e
--- /dev/null
+++ b/config/mh-papic
@@ -0,0 +1 @@
+PICFLAG=-fPIC
diff --git a/config/mh-ppcpic b/config/mh-ppcpic
new file mode 100644
index 00000000000..35cf2c8ee4e
--- /dev/null
+++ b/config/mh-ppcpic
@@ -0,0 +1 @@
+PICFLAG=-fPIC
diff --git a/config/mh-riscos b/config/mh-riscos
new file mode 100644
index 00000000000..e586b30b1a9
--- /dev/null
+++ b/config/mh-riscos
@@ -0,0 +1,15 @@
+# This is for a MIPS running RISC/os 4.52C.
+
+# This is needed for GDB, but needs to be in the top-level make because
+# if a library is compiled with the bsd headers and gets linked with the
+# sysv system libraries all hell can break loose (e.g. a jmp_buf might be
+# a different size).
+# ptrace(2) apparently has problems in the BSD environment. No workaround is
+# known except to select the sysv environment. Could we use /proc instead?
+# These "sysv environments" and "bsd environments" often end up being a pain.
+#
+# This is not part of CFLAGS because perhaps not all C compilers have this
+# option.
+CC= cc -systype sysv
+
+RANLIB = true
diff --git a/config/mh-sco b/config/mh-sco
new file mode 100644
index 00000000000..cc337c98f93
--- /dev/null
+++ b/config/mh-sco
@@ -0,0 +1,10 @@
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV
+RANLIB = true
+# You may need this if you don't have bison.
+# BISON = yacc -Sm10400
+# The native C compiler botches some simple uses of const. Unfortunately,
+# it doesn't defined anything like "__sco__" for us to test for in ansidecl.h.
+CC = cc -Dconst=
+
+X11_EXTRA_LIBS = -lsocket -lm -lintl -lmalloc
diff --git a/config/mh-solaris b/config/mh-solaris
new file mode 100644
index 00000000000..ddbea549b93
--- /dev/null
+++ b/config/mh-solaris
@@ -0,0 +1,6 @@
+# Makefile changes for Suns running Solaris 2
+
+SYSV = -DSYSV
+RANLIB = true
+
+X11_EXTRA_LIBS = -lnsl -lsocket
diff --git a/config/mh-sparcpic b/config/mh-sparcpic
new file mode 100644
index 00000000000..35cf2c8ee4e
--- /dev/null
+++ b/config/mh-sparcpic
@@ -0,0 +1 @@
+PICFLAG=-fPIC
diff --git a/config/mh-sun3 b/config/mh-sun3
new file mode 100644
index 00000000000..dcd5155b736
--- /dev/null
+++ b/config/mh-sun3
@@ -0,0 +1,3 @@
+# Sun's C compiler needs the -J flag to be able to compile cp-parse.c
+# without overflowing the jump tables (-J says to use a 32 bit table)
+CC = cc -J
diff --git a/config/mh-sysv b/config/mh-sysv
new file mode 100644
index 00000000000..16b1187b447
--- /dev/null
+++ b/config/mh-sysv
@@ -0,0 +1,3 @@
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV
+RANLIB = true
diff --git a/config/mh-sysv4 b/config/mh-sysv4
new file mode 100644
index 00000000000..81066510600
--- /dev/null
+++ b/config/mh-sysv4
@@ -0,0 +1,11 @@
+# Define SYSV as -DSYSV if you are using a System V operating system.
+SYSV = -DSYSV -DSVR4
+RANLIB = true
+
+# C++ debugging is not yet supported under SVR4 (DWARF)
+CXXFLAGS=-O
+
+# The l flag generates a warning from the SVR4 archiver, remove it.
+AR_FLAGS = cr
+
+X11_EXTRA_LIBS = -lnsl
diff --git a/config/mh-vaxult2 b/config/mh-vaxult2
new file mode 100644
index 00000000000..3de2dc8ffe3
--- /dev/null
+++ b/config/mh-vaxult2
@@ -0,0 +1,2 @@
+# The old BSD pcc isn't up to compiling parts of gdb so use gcc
+CC = gcc
diff --git a/config/mh-windows b/config/mh-windows
new file mode 100644
index 00000000000..a5cc5d611df
--- /dev/null
+++ b/config/mh-windows
@@ -0,0 +1,16 @@
+CC=cc
+CFLAGS=
+RANLIB=true
+AR_FLAGS=
+
+.PHONY: windows
+windows: nmake.mak
+ @echo "Don't forget to setup setvars.mak!"
+
+nmake.mak: to-be-built
+ @echo Building nmake files
+ @$(srcdir)/gdb/mswin/genmakes
+
+to-be-built:
+ @echo Recording commands
+ @$(srcdir)/gdb/mswin/recordit
diff --git a/config/mh-x86pic b/config/mh-x86pic
new file mode 100644
index 00000000000..92e48d90fbd
--- /dev/null
+++ b/config/mh-x86pic
@@ -0,0 +1 @@
+PICFLAG=-fpic
diff --git a/config/mpw-mh-mpw b/config/mpw-mh-mpw
new file mode 100644
index 00000000000..543ef4fb2a1
--- /dev/null
+++ b/config/mpw-mh-mpw
@@ -0,0 +1,157 @@
+# This is an MPW makefile fragment.
+
+# Since there are a multiplicity of Mac compilers and two different
+# processors, this file is primarily a library of options for each
+# compiler. Somebody else (such as a configure or build script) will
+# make the actual choice.
+
+# Compiler to use for compiling.
+
+CC_MPW_C = C -d MPW_C -d ALMOST_STDC -d ANSI_PROTOTYPES -d MPW -mc68020 -model far -b -w
+
+CC_SC = SC -d ALMOST_STDC -d ANSI_PROTOTYPES -d MPW -mc68020 -model far -b -i '' -i :
+
+CC_MWC68K = MWC68K -d MPW -enum int -mpw_chars -sym on -w off -mc68020 -model far
+
+CC_PPCC = PPCC -d powerc=1 -d pascal= -d ALMOST_STDC -d ANSI_PROTOTYPES -d MPW -w
+
+CC_MRC = MrC -d powerc=1 -d pascal= -d ALMOST_STDC -d ANSI_PROTOTYPES -d MPW -i '' -i : -jm
+
+CC_SMrC = SMrC -d MPW
+
+# "-mpw_chars" is necessary because GNU sources often mix signed and
+# unsigned casually.
+# "-w off" is not a great idea, but CW7 is complaining about enum
+# assignments.
+# "-opt global,peep,l4,speed" is sometimes good, and sometimes bad.
+# We must use {CIncludes} so that MPW tools will work; {MWCIncludes}
+# defines stdout, islower, etc, in ways that are incompatible with MPW's
+# runtime. However, this cannot be done via -i "{CIncludes}", since
+# that does not affect how <>-type includes happen; instead, the variable
+# MWCIncludes must be set to point at {CIncludes}.
+
+CC_MWCPPC = MWCPPC -d MPW -enum int -mpw_chars -sym on -w off
+
+# Note that GCC does *not* wire in a definition of "pascal", so that
+# it can be handled in another way if desired.
+
+CC_68K_GCC = gC -Dpascal= -DANSI_PROTOTYPES -DMPW
+
+CC_PPC_GCC = gC -Dpowerc=1 -Dpascal= -DANSI_PROTOTYPES -DMPW
+
+# Nothing for the default CFLAGS.
+
+CFLAGS =
+
+# Tool to use for making libraries/archives.
+
+AR_LIB = Lib
+
+AR_MWLINK68K = MWLink68K -xm library
+
+AR_PPCLINK = PPCLink -xm library
+
+AR_MWLINKPPC = MWLinkPPC -xm library
+
+AR_AR = ar
+
+AR_FLAGS = -o
+
+RANLIB_NULL = null-command
+
+RANLIB_RANLIB = ranlib
+
+# Compiler and/or linker to use for linking.
+
+CC_LD_LINK = Link -w -d -model far {CC_LD_TOOL_FLAGS}
+
+CC_LD_MWLINK68K = MWLink68K -w {CC_LD_TOOL_FLAGS} -sym on -model far
+
+CC_LD_PPCLINK = PPCLink -main __start -outputformat xcoff
+
+CC_LD_MWLINKPPC = MWLinkPPC -w {CC_LD_TOOL_FLAGS} -sym on
+
+CC_LD_GLD = gC
+
+# Extension for linker output.
+
+PROG_EXT_68K =
+
+PROG_EXT_XCOFF = .xcoff
+
+# Nothing for the default LDFLAGS.
+
+LDFLAGS = -w
+
+CC_LD_TOOL_FLAGS = -c 'MPS ' -t MPST
+
+# Libraries to link against.
+
+# It would appear that the math libraries are not
+# needed except to provide a definition for scalb,
+# which is called from ldexp, which is referenced
+# in the m68k opcodes library.
+
+EXTRALIBS_C = \Option-d
+ "{CLibraries}"StdClib.o \Option-d
+ "{CLibraries}"Math.o \Option-d
+ "{CLibraries}"CSANELib.o \Option-d
+ "{Libraries}"Stubs.o \Option-d
+ "{Libraries}"Runtime.o \Option-d
+ "{Libraries}"Interface.o \Option-d
+ "{Libraries}"ToolLibs.o
+
+EXTRALIBS_MWC68K = \Option-d
+ "{CLibraries}"StdClib.o \Option-d
+ "{CLibraries}"Math.o \Option-d
+ "{CLibraries}"CSANELib.o \Option-d
+ "{Libraries}"Stubs.o \Option-d
+ "{Libraries}"Runtime.o \Option-d
+ "{Libraries}"Interface.o \Option-d
+ "{Libraries}"ToolLibs.o \Option-d
+ "{MW68KLibraries}MPW ANSI (4i) C.68K.Lib"
+
+EXTRALIBS_PPC_XCOFF = \Option-d
+ "{PPCLibraries}"StdCRuntime.o \Option-d
+ "{PPCLibraries}"InterfaceLib.xcoff \Option-d
+ "{PPCLibraries}"MathLib.xcoff \Option-d
+ "{PPCLibraries}"StdCLib.xcoff \Option-d
+ "{PPCLibraries}"PPCToolLibs.o \Option-d
+ "{PPCLibraries}"PPCCRuntime.o \Option-d
+ "{GCCPPCLibraries}"libgcc.xcoff
+
+EXTRALIBS_PPC = \Option-d
+ "{PPCLibraries}"StdCRuntime.o \Option-d
+ "{SharedLibraries}"InterfaceLib \Option-d
+ "{SharedLibraries}"MathLib \Option-d
+ "{SharedLibraries}"StdCLib \Option-d
+ "{PPCLibraries}"PPCToolLibs.o \Option-d
+ "{PPCLibraries}"PPCCRuntime.o \Option-d
+ "{GCCPPCLibraries}"libgcc.xcoff
+
+EXTRALIBS_MWCPPC = \Option-d
+ "{MWPPCLibraries}"MWStdCRuntime.Lib \Option-d
+ "{MWPPCLibraries}"InterfaceLib \Option-d
+ "{MWPPCLibraries}"StdCLib \Option-d
+ "{MWPPCLibraries}"MathLib \Option-d
+ "{MWPPCLibraries}"PPCToolLibs.o
+
+# Tool to make PEF with, if needed.
+
+MAKEPEF_NULL = null-command
+
+MAKEPEF_PPC = MakePEF
+
+MAKEPEF_FLAGS = \Option-d
+ -l InterfaceLib.xcoff=InterfaceLib \Option-d
+ -l MathLib.xcoff=MathLib \Option-d
+ -l StdCLib.xcoff=StdCLib
+
+MAKEPEF_TOOL_FLAGS = -ft MPST -fc 'MPS '
+
+# Resource compiler to use.
+
+REZ_68K = Rez
+
+REZ_PPC = Rez -d WANT_CFRG
+
diff --git a/config/mpw/ChangeLog b/config/mpw/ChangeLog
new file mode 100644
index 00000000000..3cdefbf7a75
--- /dev/null
+++ b/config/mpw/ChangeLog
@@ -0,0 +1,53 @@
+Tue Nov 26 12:34:12 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * g-mpw-make.sed: Fix some comments.
+
+Mon Sep 16 14:42:52 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * g-mpw-make.sed (HLDENV): Edit out all references.
+
+Thu Aug 15 19:49:23 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * true: New script, identical to mpw-true.
+ * g-mpw-make.sed: Add @DASH_C_FLAG@ and @SEGMENT_FLAG()@
+ to the editors for compile commands.
+
+Thu Aug 1 15:01:42 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-true, mpw-touch, null-command: New scripts.
+ * README: Describe usage in more detail.
+
+Tue Dec 12 14:51:51 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * g-mpw-make.sed: Don't edit out "version=" occurrences.
+
+Fri Dec 1 11:46:18 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * g-mpw-make.sed (bindir, libdir): Edit the positions of
+ pathname separators to work with other pathnames better.
+
+Tue Nov 7 15:08:07 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * g-mpw-make.sed: Add comment about Duplicate vs Catenate,
+ add additional pattern for editing link-compile commands.
+
+Tue Oct 24 14:28:51 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * g-mpw-make.sed: Add handling for *.tab.[hc] files.
+ (CHILL_FOR_TARGET, CHILL_LIB): Edit out tricky definitions
+ of these.
+
+Thu Sep 28 21:05:10 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * g-mpw-make.sed: New file, generic sed commands to translate
+ Unix makefiles into MPW makefile syntax.
+
+Fri Mar 17 11:51:20 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * README: Clarify instructions.
+ * fi: Remove.
+
+Wed Dec 21 15:45:53 1994 Stan Shebs <shebs@andros.cygnus.com>
+
+ * MoveIfChange, README, fi, forward-include, open-brace,
+ tr-7to8-src: New files.
diff --git a/config/mpw/MoveIfChange b/config/mpw/MoveIfChange
new file mode 100644
index 00000000000..0dbc12582f5
--- /dev/null
+++ b/config/mpw/MoveIfChange
@@ -0,0 +1,19 @@
+# Rename a file only if it is different from a previously existing
+# file of the same name. This is useful for keeping make from doing
+# too much work if the contents of a file haven't changed.
+
+# This is an MPW translation of the standard GNU sh script move-if-change.
+
+Set exit 0
+
+If "`exists -f "{2}"`"
+ Compare "{1}" "{2}" >dev:null
+ If {status} != 0
+ Rename -y "{1}" "{2}"
+ Else
+ Echo "{2}" is unchanged
+ Delete -i -y "{1}"
+ End
+Else
+ Rename -y "{1}" "{2}"
+End
diff --git a/config/mpw/README b/config/mpw/README
new file mode 100644
index 00000000000..554700adc81
--- /dev/null
+++ b/config/mpw/README
@@ -0,0 +1,23 @@
+This directory contains MPW scripts and related files that are needed to
+build Cygnus GNU tools for MPW. The scripts should be somewhere on the
+command path; our usual practice has been to have a separate directory
+for the scripts, and put the tools (byacc, flex, and sed at least) there
+also; then it's easier to drag the support bits around as a group, or to
+upgrade MPW versions. The complete package of scripts and tool binaries
+is usually available as pub/mac/buildtools.cpt.hqx on ftp.cygnus.com.
+
+"tr-7to8-src" is actually the source to an MPW script that transforms
+sequences like "\Option-d" into the actual 8-bit chars that MPW needs.
+It's only the source because it can't itself include any 8-bit chars.
+It *can* be processed into a genuine "tr-7to8" by using itself:
+
+ tr-7to8 tr-7to8-src | sed -e 's/Src//' >new-tr-7to8
+
+Use this to verify:
+
+ compare tr-7to8 new-tr-7to8
+
+If you don't have a working tr-7to8, then you will have to manually
+replace all occurrences of "\Option-d" with real Option-d (which looks
+like a delta), then do similarly with all the other "\Option-..."
+strings, and then change "\SrcOption-d" into the string "\Option-d".
diff --git a/config/mpw/forward-include b/config/mpw/forward-include
new file mode 100644
index 00000000000..ddd6bd71105
--- /dev/null
+++ b/config/mpw/forward-include
@@ -0,0 +1,3 @@
+Echo '#include' ¶""{1}"¶" >"{2}".tem
+MoveIfChange "{2}".tem "{2}"
+
diff --git a/config/mpw/g-mpw-make.sed b/config/mpw/g-mpw-make.sed
new file mode 100644
index 00000000000..e7d3c770736
--- /dev/null
+++ b/config/mpw/g-mpw-make.sed
@@ -0,0 +1,293 @@
+# Sed commands to translate Unix makefiles into MPW makefiles.
+# These are nominally generic, but work best on the makefiles used
+# for GNU programs.
+
+# Whack out any commented-out lines that are probably commands;
+# they can only cause trouble later on.
+/^# /d
+
+# Change dependency char.
+/:$/s/:/ \\Option-f/g
+/^[^ :#][^:]*:/s/\([ ]*\):\([ ]*\)/ \\Option-f /g
+
+# Change syntax of Makefile vars.
+/\$/s/\${\([a-zA-Z0-9_-]*\)}/{\1}/g
+/\$/s/\$(\([a-zA-Z0-9_-]*\))/{\1}/g
+/ $@/s/ $@/ {Targ}/
+
+# Double-$ are literals to Unix but not to MPW make.
+/\$\$/s/\$\$/$/g
+
+# Change pathname syntax.
+/\//s,\.\./\/\.\./,:::,g
+/\//s,\.\./,::,g
+/\.\//s,\./,:,g
+/\//s,/,:,g
+# Undo excess changes.
+/and/s,and:or$,and/or,
+/and/s,and:or ,and/or ,
+/want/s,want:need,want/need,
+# Fixing up sed commands.
+/-e/s_":\([^:]*\):d"_"/\1/d"_g
+/-e/s_":\([^:]*\):,:\([^:]*\):d"_"/\1/,/\2/d"_g
+
+/=/s/ = \.$/ = :/
+
+# Make these go away so that later edits not confused.
+/HLDENV/s/{HLDENV}//
+
+# Comment out any explicit srcdir setting.
+/srcdir/s/^srcdir/# srcdir/
+
+/BASEDIR/s/^BASEDIR =.*$/BASEDIR = "{srcroot}"/
+/{BASEDIR}:/s/{BASEDIR}:/{BASEDIR}/g
+/{srcdir}:/s/{srcdir}:/"{srcdir}"/g
+/"{srcdir}":/s/"{srcdir}":/"{srcdir}"/g
+
+# Tweak some conventions that are backwards for the Mac.
+/bindir/s/{exec_prefix}:bin/{exec_prefix}bin:/
+/libdir/s/{exec_prefix}:lib/{exec_prefix}lib:/
+
+# Comment out settings of anything set by mpw host config.
+/CC/s/^CC *=/#CC =/
+/CFLAGS/s/^CFLAGS *=/#CFLAGS =/
+/AR/s/^AR *=/#AR =/
+/AR_FLAGS/s/^AR_FLAGS *=/#AR_FLAGS =/
+/RANLIB/s/^RANLIB *=/#RANLIB =/
+/CC_LD/s/^CC_LD *=/#CC_LD =/
+/LDFLAGS/s/^LDFLAGS *=/#LDFLAGS =/
+
+# Change -I usages.
+/-I/s/-I\./-i :/g
+/-I/s/-I::bfd/-i ::bfd:/g
+/-I/s/-I::include/-i ::include:/g
+/-I/s/-I/-i /g
+
+# Change -D usage.
+/-D/s/\([ =]\)-D\([^ ]*\)/\1-d \2/g
+
+# Change continuation char.
+/\\$/s/\\$/\\Option-d/
+
+# Change wildcard char.
+/\*/s/\*/\\Option-x/g
+
+# Change path of various types of source files. This rule does not allow
+# for file names with multiple dots in the name.
+/\.[chly]/s/\([ ><=]\)\([-a-zA-Z0-9_${}:"]*\)\.\([chly]\)/\1"{s}"\2.\3/g
+/\.[chly]/s/^\([-a-zA-Z0-9_${}:"]*\)\.\([chly]\)/"{s}"\1.\2/
+# Allow files named *.tab.[ch] as a special case.
+/\.tab\.[ch]/s/\([ ><=]\)\([-a-zA-Z0-9_${}:"]*\.tab\)\.\([ch]\)/\1"{s}"\2.\3/g
+/\.tab\.[ch]/s/^\([-a-zA-Z0-9_${}:"]*\.tab\)\.\([ch]\)/"{s}"\1.\2/
+# Fix some overenthusiasms.
+/{s}/s/"{s}""{srcdir}"/"{srcdir}"/g
+/{s}/s/"{s}"{\([a-zA-Z0-9_]*\)dir}/"{\1dir}"/g
+/{s}/s/"{s}"{\([a-zA-Z0-9_]*\)DIR}/"{\1DIR}"/g
+/{s}/s/"{s}""{\([a-zA-Z0-9_]*\)dir}"/"{\1dir}"/g
+/{s}/s/"{s}""{\([a-zA-Z0-9_]*\)DIR}"/"{\1DIR}"/g
+/{s}/s/"{s}":/:/g
+/{s}/s/^"{s}"//g
+/{s}/s/"{s}""{s}"/"{s}"/g
+/{s}/s/"{s}""{srcdir}"/"{s}"/g
+/{s}/s/"{srcdir}""{s}"/"{s}"/g
+
+# The .def files are also typically source files.
+/\.def/s/\([ ><]\)\([-a-zA-Z0-9_${}:"]*\)\.def/\1"{s}"\2.def/g
+/\.def/s/^\([-a-zA-Z0-9_${}:"]*\)\.def/"{s}"\1.def/g
+
+# Change extension and path of objects.
+/\.o/s/\([ =]\)\([-a-zA-Z0-9_${}:"]*\)\.o/\1"{o}"\2.c.o/g
+/\.o/s/^\([-a-zA-Z0-9_${}:"]*\)\.o/"{o}"\1.c.o/
+# Allow *.tab.o files as a special case of a 2-dot-name file.
+/\.o/s/\([ =]\)\([-a-zA-Z0-9_${}:"]*\)\.tab\.o/\1"{o}"\2.tab.c.o/g
+/\.o/s/^\([-a-zA-Z0-9_${}:"]*\)\.tab\.o/"{o}"\1.tab.c.o/
+# Clean up.
+/"{o}"/s/"{o}""{o}"/"{o}"/g
+/"{o}"/s/^"{o}"\([a-zA-Z0-9_]*\)=/\1=/
+
+# Change extension of libs.
+/\.a/s/lib\([a-z]*\)\.a/lib\1.o/g
+
+# Remove non-fail option.
+/-/s/^\([ ]*\)-/\1/
+# Fix overeagernesses - assumes no one-letter commands.
+/^[ ]*[a-z] /s/^\([ ]*\)\([a-z]\) /\1-\2 /
+
+# Remove non-echo option. (watch out for autoconf things)
+/@/s/^\([ ]*\)@/\1/
+
+# Change cp to Duplicate.
+# Catenate is perhaps more accurate, but the pattern would have to
+# identify the output file and add a '>' redirection into it.
+/cp/s/^\([ ]*\)cp /\1Duplicate -d -y /
+# Change mv to Rename.
+/mv/s/^\([ ]*\)mv /\1Rename -y /
+/Rename/s/^\([ ]*\)Rename -y -f/\1Rename -y/
+# Change rm to Delete.
+/rm -rf/s/^\([ ]*\)rm -rf /\1Delete -i -y /
+/rm -f/s/^\([ ]*\)rm -f /\1Delete -i -y /
+/rm/s/^\([ ]*\)rm /\1Delete -i -y /
+# Note that we don't mess with ln - directory-specific scripts
+# must decide what to do with symlinks.
+# Change cat to Catenate.
+/cat/s/^\([ ]*\)cat /\1Catenate /
+# Change touch to mpw-touch.
+/touch/s/^\([ ]*\)touch /\1mpw-touch /
+# Change mkdir to NewFolder.
+/mkdir/s/^\([ ]*\)mkdir /\1NewFolder /
+# Change var setting to Set.
+/=/s/^\([ ]*\)\([-a-zA-Z0-9_]*\)=\([^;]*\); \\Option-d/\1Set \2 \3/
+
+# Change tests.
+/if /s/if \[ *-f \([^ ]*\) ] *; *\\Option-d/If "`Exists "\1"`" != ""/
+/if /s/if \[ *-f \([^ ]*\) ] *; *then *\\Option-d/If "`Exists "\1"`" != ""/
+/if /s/if \[ ! *-f \([^ ]*\) ] *; *\\Option-d/If "`Exists "\1"`" == ""/
+/if /s/if \[ ! *-f \([^ ]*\) ] *; *then \\Option-d/If "`Exists "\1"`" == ""/
+
+/if /s/if \[ *-d \([^ ]*\) ] *; *\\Option-d/If "`Exists "\1"`" != ""/
+/if /s/if \[ *-d \([^ ]*\) ] *; *then *\\Option-d/If "`Exists "\1"`" != ""/
+/if /s/if \[ ! *-d \([^ ]*\) ] *; *\\Option-d/If "`Exists "\1"`" == ""/
+/if /s/if \[ ! *-d \([^ ]*\) ] *; *then *\\Option-d/If "`Exists "\1"`" == ""/
+
+/if /s/if \[ -d \([^ ]*\) ] *; then true *; else mkdir \([^ ;]*\) *; fi/If "`Exists "\1"`" != "" NewFolder \2 End If/
+
+/if /s/if \[ \([^ ]*\) = \([^ ]*\) ] *; *\\Option-d/If "\1" == "\2"/
+/if /s/if \[ \([^ ]*\) = \([^ ]*\) ] *; *then *\\Option-d/If "\1" == "\2"/
+
+/if /s/if \[ \([^ ]*\) != \([^ ]*\) ] *; *\\Option-d/If "\1" != "\2"/
+/if /s/if \[ \([^ ]*\) != \([^ ]*\) ] *; *then *\\Option-d/If "\1" != "\2"/
+
+/if /s/if \[ \([^ ]*\) -eq \([^ ]*\) ] *; *\\Option-d/If "\1" != "\2"/
+/if /s/if \[ \([^ ]*\) -eq \([^ ]*\) ] *; *then *\\Option-d/If "\1" != "\2"/
+
+/^[ ]*else true$/c\
+ Else\
+ mpw-true\
+
+
+/else/s/^\([ ]*\)else[ ]*$/\1Else/
+/else/s/^\([ ]*\)else[; ]*\\Option-d$/\1Else/
+
+/^[ ]*else[ ]*true[ ]*$/c\
+ Else\
+ mpw-true
+
+/^[ ]*else[ ]*true[; ]*fi$/c\
+ Else\
+ mpw-true\
+ End If
+
+/fi/s/^\([ ]*\)fi *$/\1End/
+/fi/s/^\([ ]*\)fi *; *\\Option-d/\1End/
+
+# Change looping.
+/for/s/^\([ ]*\)for \([-a-zA-Z0-9_]*\) in \([^;]*\); *do *\\Option-d/\1For \2 In \3/
+/^\([ ]*\)do *\\Option-d/d
+/done/s/^\([ ]*\)done *; *\\Option-d/\1End/
+/done/s/^\([ ]*\)done$/\1End/
+
+# Trailing semicolons and continued lines are unneeded sh syntax.
+/; \\Option-d/s/; \\Option-d//
+
+# Change move-if-change to MoveIfChange.
+/move-if-change/s/\([^ ]*\)move-if-change/MoveIfChange/g
+
+# Change $(SHELL) to the script name by itself.
+/SHELL/s/^\([ ]*\){SHELL} /\1/
+
+# Change syntax of default rule dependency.
+/^\.c\.o/s/^\.c\.o \\Option-f$/.c.o \\Option-f .c/
+
+# Change default rule's action.
+/{CC} -c/s/{CC} -c \(.*\) \$<$/{CC} @DASH_C_FLAG@ {DepDir}{Default}.c \1 @SEGMENT_FLAG({Default})@ -o {TargDir}{Default}.c.o/
+
+# This is pretty disgusting, but I can't seem to detect empty rules.
+/Option-f$/s/Option-f$/Option-f _oldest/g
+
+# Remove -c from explicit compiler calls. (but should not if GCC)
+# Handle the case of a source file that is "{xxx}"file.c.
+/ -c /s/{\([A-Z_]*\)CC}\(.*\) -c \(.*\)"\([^"]*\)"\([-a-z_]*\)\.c/{\1CC}\2 @DASH_C_FLAG@ \3"\4"\5.c -o "{o}"\5.c.o/
+# Handle the case of a source file that is "{xxx}"dir:file.c.
+/ -c /s/{\([A-Z_]*\)CC}\(.*\) -c \(.*\)"\([^"]*\)"\([-a-z_]*\):\([-a-z_]*\)\.c/{\1CC}\2 @DASH_C_FLAG@ \3"\4"\5:\6.c -o "{o}"\6.c.o/
+
+# Change linking cc to linking sequence.
+/-o/s/^\([ ]*\){CC} \(.*\){\([A-Z_]*\)CFLAGS} \(.*\){LDFLAGS} \(.*\)-o \([^ ]*\) \(.*\)$/\1{CC_LD} \2 {\3CFLAGS} \4 {LDFLAGS} \5 -o \6{PROG_EXT} \7\
+\1{MAKEPEF} \6{PROG_EXT} -o \6 {MAKEPEF_TOOL_FLAGS} {MAKEPEF_FLAGS}\
+\1{REZ} "{s}"\6.r -o \6 -append -d PROG_NAME='"'\6'"' -d VERSION_STRING='"'{version}'"'/
+/-o/s/^\([ ]*\){CC} \(.*\){\([A-Z_]*\)CFLAGS} \(.*\)-o \([^ ]*\) \(.*\){LDFLAGS} \(.*\)$/\1{CC_LD} \2 {\3CFLAGS} \4 {LDFLAGS} \6 -o \5{PROG_EXT} \7\
+\1{MAKEPEF} \5{PROG_EXT} -o \5 {MAKEPEF_TOOL_FLAGS} {MAKEPEF_FLAGS}\
+\1{REZ} "{s}"\5.r -o \5 -append -d PROG_NAME='"'\5'"' -d VERSION_STRING='"'{version}'"'/
+/-o/s/^\([ ]*\){HOST_CC} \(.*\)-o \([^ ]*\) \(.*\)$/\1{HOST_CC_LD} \2 -o \3{PROG_EXT} \4\
+\1{MAKEPEF} \3{PROG_EXT} -o \3 {MAKEPEF_TOOL_FLAGS} {MAKEPEF_FLAGS}\
+\1{REZ} "{s}"\3.r -o \3 -append -d PROG_NAME='"'\3'"' -d VERSION_STRING='"'{version}'"'/
+
+# Comment out .NOEXPORT rules.
+/\.NOEXPORT/s/^\.NOEXPORT/#\.NOEXPORT/
+# Comment out .PHONY rules.
+/\.PHONY/s/^\.PHONY/#\.PHONY/
+# Comment out .PRECIOUS rules.
+/\.PRECIOUS/s/^\.PRECIOUS/#\.PRECIOUS/
+# Comment out .SUFFIXES rules.
+/\.SUFFIXES/s/^\.SUFFIXES/#\.SUFFIXES/
+
+# Set the install program appropriately.
+/INSTALL/s/^INSTALL *= *`.*`:install.sh -c/INSTALL = Duplicate -y/
+
+# Don't try to decide whether to use the tree's own tools.
+/bison/s/`.*bison:bison.*`/bison -y/
+/byacc/s/`.*byacc:byacc.*`/byacc/
+/flex/s/`.*flex:flex.*`/flex/
+
+# Turn transformed C comments in echo commands back into comments.
+/echo/s,echo '\(.*\):\\Option-x\(.*\)\\Option-x:\(.*\)',echo '\1/*\2*/\3',
+
+# Whack out various clever expressions that search for tools, since
+# the clever code is too /bin/sh specific.
+
+/^AR_FOR_TARGET = `/,/`$/c\
+AR_FOR_TARGET = ::binutils:ar\
+
+
+/^RANLIB_FOR_TARGET = `/,/`$/c\
+RANLIB_FOR_TARGET = ::binutils:ranlib\
+
+
+/^RANLIB_TEST_FOR_TARGET = /,/ranlib ] )$/c\
+RANLIB_TEST_FOR_TARGET = \
+
+
+/^EXPECT = `/,/`$/c\
+EXPECT = \
+
+
+/^RUNTEST = `/,/`$/c\
+RUNTEST = \
+
+
+/^CC_FOR_TARGET = `/,/`$/c\
+CC_FOR_TARGET = \
+
+
+/^CXX_FOR_TARGET = `/,/`$/c\
+CXX_FOR_TARGET = \
+
+
+/^CHILL_FOR_TARGET = `/,/`$/c\
+CHILL_FOR_TARGET = \
+
+
+/^CHILL_LIB = `/,/`$/c\
+CHILL_LIB = \
+
+/sanit/s/{start-sanit...-[a-z0-9]*}//
+/sanit/s/{end-sanit...-[a-z0-9]*}//
+
+# Add standard defines and default rules.
+/^# srcdir/a\
+\
+s = "{srcdir}"\
+\
+o = :\
+\
+"{o}" \\Option-f : "{s}"
+
diff --git a/config/mpw/mpw-touch b/config/mpw/mpw-touch
new file mode 100644
index 00000000000..c743a5122b5
--- /dev/null
+++ b/config/mpw/mpw-touch
@@ -0,0 +1,7 @@
+# "Touch" command.
+
+If "`Exists "{1}"`" != ""
+ SetFile -m . "{1}"
+Else
+ Echo ' ' > "{1}"
+End If
diff --git a/config/mpw/mpw-true b/config/mpw/mpw-true
new file mode 100644
index 00000000000..0506530d3c6
--- /dev/null
+++ b/config/mpw/mpw-true
@@ -0,0 +1 @@
+Exit 0
diff --git a/config/mpw/null-command b/config/mpw/null-command
new file mode 100644
index 00000000000..4844c8ec553
--- /dev/null
+++ b/config/mpw/null-command
@@ -0,0 +1 @@
+# This command does nothing.
diff --git a/config/mpw/open-brace b/config/mpw/open-brace
new file mode 100644
index 00000000000..58465dcc18c
--- /dev/null
+++ b/config/mpw/open-brace
@@ -0,0 +1,4 @@
+# MPW makefiles seem not to have any way to get a literal open
+# brace into a rule anywhere, so this does the job.
+
+Echo '{'
diff --git a/config/mpw/tr-7to8-src b/config/mpw/tr-7to8-src
new file mode 100644
index 00000000000..b20b649c895
--- /dev/null
+++ b/config/mpw/tr-7to8-src
@@ -0,0 +1,9 @@
+StreamEdit -e \Option-d
+ '/\Option-x/ \Option-d
+ Replace /\Option-d\SrcOption-d/ "\Option-d\Option-d" -c \Option-5 ; \Option-d
+ Replace /\Option-d\SrcOption-f/ "\Option-d\Option-f" -c \Option-5 ; \Option-d
+ Replace /\Option-d\SrcOption-8/ "\Option-d\Option-8" -c \Option-5 ; \Option-d
+ Replace /\Option-d\SrcOption-5/ "\Option-d\Option-5" -c \Option-5 ; \Option-d
+ Replace /\Option-d\SrcOption-x/ "\Option-d\Option-x" -c \Option-5 ; \Option-d
+ Replace /\Option-d\SrcOption-r/ "\Option-d\Option-r" -c \Option-5' \Option-d
+ "{1}"
diff --git a/config/mpw/true b/config/mpw/true
new file mode 100644
index 00000000000..0506530d3c6
--- /dev/null
+++ b/config/mpw/true
@@ -0,0 +1 @@
+Exit 0
diff --git a/config/mt-m68kpic b/config/mt-m68kpic
new file mode 100644
index 00000000000..ff987275575
--- /dev/null
+++ b/config/mt-m68kpic
@@ -0,0 +1 @@
+PICFLAG_FOR_TARGET=-fpic
diff --git a/config/mt-netware b/config/mt-netware
new file mode 100644
index 00000000000..9482f9b36d2
--- /dev/null
+++ b/config/mt-netware
@@ -0,0 +1 @@
+GDB_NLM_DEPS = all-gcc all-ld
diff --git a/config/mt-papic b/config/mt-papic
new file mode 100644
index 00000000000..35b8c9e4dc2
--- /dev/null
+++ b/config/mt-papic
@@ -0,0 +1 @@
+PICFLAG_FOR_TARGET=-fPIC
diff --git a/config/mt-ppcpic b/config/mt-ppcpic
new file mode 100644
index 00000000000..35b8c9e4dc2
--- /dev/null
+++ b/config/mt-ppcpic
@@ -0,0 +1 @@
+PICFLAG_FOR_TARGET=-fPIC
diff --git a/config/mt-sparcpic b/config/mt-sparcpic
new file mode 100644
index 00000000000..35b8c9e4dc2
--- /dev/null
+++ b/config/mt-sparcpic
@@ -0,0 +1 @@
+PICFLAG_FOR_TARGET=-fPIC
diff --git a/config/mt-v810 b/config/mt-v810
new file mode 100644
index 00000000000..97da6c26592
--- /dev/null
+++ b/config/mt-v810
@@ -0,0 +1,4 @@
+CC_FOR_TARGET = ca732 -ansi
+AS_FOR_TARGET = as732
+AR_FOR_TARGET = ar732
+RANLIB_FOR_TARGET = true
diff --git a/config/mt-x86pic b/config/mt-x86pic
new file mode 100644
index 00000000000..ff987275575
--- /dev/null
+++ b/config/mt-x86pic
@@ -0,0 +1 @@
+PICFLAG_FOR_TARGET=-fpic
diff --git a/configure b/configure
new file mode 100755
index 00000000000..e168e94002d
--- /dev/null
+++ b/configure
@@ -0,0 +1,1406 @@
+#!/bin/sh
+
+### WARNING: this file contains embedded tabs. Do not run untabify on this file.
+
+# Configuration script
+# Copyright (C) 1988, 90, 91, 92, 93, 94, 95, 96, 1997
+# Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# This file was originally written by K. Richard Pixley.
+
+#
+# Shell script to create proper links to machine-dependent files in
+# preparation for compilation.
+#
+# If configure succeeds, it leaves its status in config.status.
+# If configure fails after disturbing the status quo,
+# config.status is removed.
+#
+
+export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh $0 $argv; kill $$)
+
+remove=rm
+hard_link=ln
+symbolic_link='ln -s'
+
+#for Test
+#remove="echo rm"
+#hard_link="echo ln"
+#symbolic_link="echo ln -s"
+
+# clear some things potentially inherited from environment.
+
+Makefile=Makefile
+Makefile_in=Makefile.in
+arguments=
+build_alias=
+cache_file=config.cache
+cache_file_option=
+configdirs=
+exec_prefix=
+exec_prefixoption=
+fatal=
+floating_point=default
+gas=default
+host_alias=NOHOST
+host_makefile_frag=
+moveifchange=
+norecursion=
+other_options=
+package_makefile_frag=
+prefix=/usr/local
+progname=
+program_prefix=
+program_prefixoption=
+program_suffix=
+program_suffixoption=
+program_transform_name=
+program_transform_nameoption=
+redirect=">/dev/null"
+removing=
+site=
+site_makefile_frag=
+site_option=
+srcdir=
+srctrigger=
+subdirs=
+target_alias=NOTARGET
+target_makefile_frag=
+undefs=NOUNDEFS
+version="$Revision: 1.244 $"
+x11=default
+
+### we might need to use some other shell than /bin/sh for running subshells
+
+### If we are on Windows, search for the shell. This will permit people
+### to not have /bin/sh, but to be able to see /SOME/PATH/sh configure
+### without also having to set CONFIG_SHELL. This code will work when
+### using bash, which sets OSTYPE.
+case "${OSTYPE}" in
+*win32*)
+ if [ x${CONFIG_SHELL} = x ]; then
+ if [ ! -f /bin/sh ]; then
+ if [ x${SHELL} != x ] && [ -f ${SHELL} ]; then
+ CONFIG_SHELL=${SHELL}
+ export CONFIG_SHELL
+ else
+ for prog in sh sh.exe bash bash.exe; do
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/$prog; then
+ CONFIG_SHELL=$dir/$prog
+ export CONFIG_SHELL
+ break
+ fi
+ done
+ IFS="$save_ifs"
+ test -n "${CONFIG_SHELL}" && break
+ done
+ fi
+ fi
+ fi
+ ;;
+esac
+
+config_shell=${CONFIG_SHELL-/bin/sh}
+
+NO_EDIT="This file was generated automatically by configure. Do not edit."
+
+## this is a little touchy and won't always work, but...
+##
+## if the argv[0] starts with a slash then it is an absolute name that can (and
+## must) be used as is.
+##
+## otherwise, if argv[0] has no slash in it, we can assume that it is on the
+## path. Since PATH might include "." we also add `pwd` to the end of PATH.
+##
+
+progname=$0
+# if PWD already has a value, it is probably wrong.
+if [ -n "$PWD" ]; then PWD=`pwd`; fi
+
+case "${progname}" in
+/*) ;;
+*/*) ;;
+*)
+ PATH=$PATH:${PWD=`pwd`} ; export PATH
+ ;;
+esac
+
+# Loop over all args
+
+while :
+do
+
+# Break out if there are no more args
+ case $# in
+ 0)
+ break
+ ;;
+ esac
+
+# Get the first arg, and shuffle
+ option=$1
+ shift
+
+# Make all options have two hyphens
+ orig_option=$option # Save original for error messages
+ case $option in
+ --*) ;;
+ -*) option=-$option ;;
+ esac
+
+# Split out the argument for options that take them
+ case $option in
+ --*=*)
+ optarg=`echo $option | sed -e 's/^[^=]*=//'`
+ arguments="$arguments $option"
+ ;;
+# These options have mandatory values. Since we didn't find an = sign,
+# the value must be in the next argument
+ --bu* | --cache* | --ex* | --ho* | --pre* | --program-p* | --program-s* | --program-t* | --si* | --sr* | --ta* | --tm* | --x-* | --bi* | --sb* | --li* | --da* | --sy* | --sh* | --lo* | --in* | --ol* | --ma*)
+ optarg=$1
+ shift
+ arguments="$arguments $option=$optarg"
+ ;;
+ --v)
+ arguments="$arguments -v"
+ ;;
+ --*)
+ arguments="$arguments $option"
+ ;;
+ esac
+
+# Now, process the options
+ case $option in
+
+ --build* | --bu*)
+ case "$build_alias" in
+ "") build_alias=$optarg ;;
+ *) echo '***' Can only configure for one build machine at a time. 1>&2
+ fatal=yes
+ ;;
+ esac
+ ;;
+ --cache*)
+ cache_file=$optarg
+ ;;
+ --disable-*)
+ enableopt=`echo ${option} | sed 's:^--disable-:enable_:;s:-:_:g'`
+ eval $enableopt=no
+ disableoptions="$disableoptions $option"
+ ;;
+ --enable-*)
+ case "$option" in
+ *=*) ;;
+ *) optarg=yes ;;
+ esac
+
+ enableopt=`echo ${option} | sed 's:^--::;s:=.*$::;s:-:_:g'`
+ eval "$enableopt='$optarg'"
+ enableoptions="$enableoptions '$option'"
+ ;;
+ --exec-prefix* | --ex*)
+ exec_prefix=$optarg
+ exec_prefixoption="--exec-prefix=$optarg"
+ ;;
+ --gas | --g*)
+ gas=yes
+ ;;
+ --help | --he*)
+ fatal=yes
+ ;;
+ --host* | --ho*)
+ case $host_alias in
+ NOHOST) host_alias=$optarg ;;
+ *) echo '***' Can only configure for one host at a time. 1>&2
+ fatal=yes
+ ;;
+ esac
+ ;;
+ --nfp | --nf*)
+ floating_point=no
+ floating_pointoption="--nfp"
+ ;;
+ --norecursion | --no*)
+ norecursion=yes
+ ;;
+ --prefix* | --pre*)
+ prefix=$optarg
+ prefixoption="--prefix=$optarg"
+ ;;
+ --program-prefix* | --program-p*)
+ program_prefix=$optarg
+ program_prefixoption="--program-prefix=$optarg"
+ ;;
+ --program-suffix* | --program-s*)
+ program_suffix=$optarg
+ program_suffixoption="--program-suffix=$optarg"
+ ;;
+ --program-transform-name* | --program-t*)
+ # Double any backslashes or dollar signs in the argument
+ program_transform_name="${program_transform_name} -e `echo ${optarg} | sed -e 's/\\\\/\\\\\\\\/g' -e 's/\\\$/$$/g'`"
+ program_transform_nameoption="${program_transform_nameoption} --program-transform-name='$optarg'"
+ ;;
+ --rm)
+ removing=--rm
+ ;;
+ --silent | --sil* | --quiet | --q*)
+ redirect=">/dev/null"
+ verbose=--silent
+ ;;
+ --site* | --sit*)
+ site=$optarg
+ site_option="--site=$optarg"
+ ;;
+ --srcdir*/ | --sr*/)
+ # Remove trailing slashes. Otherwise, when the file name gets
+ # bolted into an object file as debug info, it has two slashes
+ # in it. Ordinarily this is ok, but emacs takes double slash
+ # to mean "forget the first part".
+ srcdir=`echo $optarg | sed -e 's:/$::'`
+ ;;
+ --srcdir* | --sr*)
+ srcdir=$optarg
+ ;;
+ --target* | --ta*)
+ case $target_alias in
+ NOTARGET) target_alias=$optarg ;;
+ *) echo '***' Can only configure for one target at a time. 1>&2
+ fatal=yes
+ ;;
+ esac
+ ;;
+ --tmpdir* | --tm*)
+ TMPDIR=$optarg
+ tmpdiroption="--tmpdir=$optarg"
+ ;;
+ --verbose | --v | --verb*)
+ redirect=
+ verbose=--verbose
+ ;;
+ --version | --V | --vers*)
+ echo "This is Cygnus Configure version" `echo ${version} | sed 's/[ $:]//g'`
+ exit 0
+ ;;
+ --with-*)
+ case "$option" in
+ *=*) ;;
+ *) optarg=yes ;;
+ esac
+
+ withopt=`echo ${option} | sed 's:^--::;s:=.*$::;s:-:_:g'`
+ eval $withopt="$optarg"
+ withoptions="$withoptions $option"
+ ;;
+ --without-*)
+ withopt=`echo ${option} | sed 's:^--::;s:out::;s:-:_:g'`
+ eval $withopt=no
+ withoutoptions="$withoutoptions $option"
+ ;;
+ --x) with_x=yes
+ withoptions="$withoptions --with-x"
+ ;;
+ --x-i* | --x-l*) other_options="$other_options $orig_option"
+ ;;
+ --bi* | --sb* | --li* | --da* | --sy* | --sh* | --lo* | --in* | --ol* | --ma*)
+ # These options were added to autoconf for emacs.
+ ;;
+ --*)
+ echo "configure: Unrecognized option: \"$orig_option\"; use --help for usage." >&2
+ exit 1
+ ;;
+ *)
+ case $undefs in
+ NOUNDEFS) undefs=$option ;;
+ *) echo '***' Can only configure for one host and one target at a time. 1>&2
+ fatal=yes
+ ;;
+ esac
+ ;;
+ esac
+done
+
+# process host and target
+
+# Do some error checking and defaulting for the host and target type.
+# The inputs are:
+# configure --host=HOST --target=TARGET UNDEFS
+#
+# The rules are:
+# 1. You aren't allowed to specify --host, --target, and undefs at the
+# same time.
+# 2. Host defaults to undefs.
+# 3. If undefs is not specified, then host defaults to the current host,
+# as determined by config.guess.
+# 4. Target defaults to undefs.
+# 5. If undefs is not specified, then target defaults to host.
+
+case "${fatal}" in
+"")
+ # Make sure that host, target & undefs aren't all specified at the
+ # same time.
+ case $host_alias---$target_alias---$undefs in
+ NOHOST---*---* | *---NOTARGET---* | *---*---NOUNDEFS)
+ ;;
+ *) echo '***' Can only configure for one host and one target at a time. 1>&2
+ fatal=yes
+ break 2
+ ;;
+ esac
+
+ # Now, do defaulting for host.
+ case $host_alias in
+ NOHOST)
+ case $undefs in
+ NOUNDEFS)
+ # Neither --host option nor undefs were present.
+ # Call config.guess.
+ guesssys=`echo ${progname} | sed 's/configure$/config.guess/'`
+ if host_alias=`${config_shell} ${guesssys}`
+ then
+ # If the string we are going to use for
+ # the target is a prefix of the string
+ # we just guessed for the host, then
+ # assume we are running native, and force
+ # the same string for both target and host.
+ case $target_alias in
+ NOTARGET) ;;
+ *)
+ if expr $host_alias : $target_alias >/dev/null
+ then
+ host_alias=$target_alias
+ fi
+ ;;
+ esac
+ echo "Configuring for a ${host_alias} host." 1>&2
+ arguments="--host=$host_alias $arguments"
+ else
+ echo 'Config.guess failed to determine the host type. You need to specify one.' 1>&2
+ fatal=yes
+ fi
+ ;;
+ *)
+ host_alias=$undefs
+ arguments="--host=$host_alias $arguments"
+ undefs=NOUNDEFS
+ ;;
+ esac
+ esac
+
+ # Do defaulting for target. If --target option isn't present, default
+ # to undefs. If undefs isn't present, default to host.
+ case $target_alias in
+ NOTARGET)
+ case $undefs in
+ NOUNDEFS)
+ target_alias=$host_alias
+ ;;
+ *)
+ target_alias=$undefs
+ arguments="--target=$target_alias $arguments"
+ ;;
+ esac
+ esac
+ ;;
+*) ;;
+esac
+
+if [ -n "${fatal}" -o "${host_alias}" = "help" ] ; then
+ exec 1>&2
+ echo Usage: configure [OPTIONS] [HOST]
+ echo
+ echo Options: [defaults in brackets]
+ echo ' --prefix=MYDIR install into MYDIR [/usr/local]'
+ echo ' --exec-prefix=MYDIR install host-dependent files into MYDIR [/usr/local]'
+ echo ' --help print this message [normal config]'
+ echo ' --build=BUILD configure for building on BUILD [BUILD=HOST]'
+ echo ' --host=HOST configure for HOST [determined via config.guess]'
+ echo ' --norecursion configure this directory only [recurse]'
+ echo ' --program-prefix=FOO prepend FOO to installed program names [""]'
+ echo ' --program-suffix=FOO append FOO to installed program names [""]'
+ echo ' --program-transform-name=P transform installed names by sed pattern P [""]'
+ echo ' --site=SITE configure with site-specific makefile for SITE'
+ echo ' --srcdir=DIR find the sources in DIR [. or ..]'
+ echo ' --target=TARGET configure for TARGET [TARGET=HOST]'
+ echo ' --tmpdir=TMPDIR create temporary files in TMPDIR [/tmp]'
+ echo ' --nfp configure for software floating point [hard float]'
+ echo ' --with-FOO, --with-FOO=BAR package FOO is available (parameter BAR)'
+ echo ' --without-FOO package FOO is NOT available'
+ echo ' --enable-FOO, --enable-FOO=BAR include feature FOO (parameter BAR)'
+ echo ' --disable-FOO do not include feature FOO'
+ echo
+ echo 'Where HOST and TARGET are something like "sparc-sunos", "mips-sgi-irix5", etc.'
+ echo
+ if [ -r config.status ] ; then
+ cat config.status
+ fi
+
+ exit 1
+fi
+
+configsub=`echo ${progname} | sed 's/configure$/config.sub/'`
+moveifchange=`echo ${progname} | sed 's/configure$/move-if-change/'`
+
+# this is a hack. sun4 must always be a valid host alias or this will fail.
+if ${config_shell} ${configsub} sun4 >/dev/null 2>&1 ; then
+ true
+else
+ echo '***' cannot find config.sub. 1>&2
+ exit 1
+fi
+
+touch config.junk
+if ${config_shell} ${moveifchange} config.junk config.trash ; then
+ true
+else
+ echo '***' cannot find move-if-change. 1>&2
+ exit 1
+fi
+rm -f config.junk config.trash
+
+case "${srcdir}" in
+"")
+ if [ -r configure.in ] ; then
+ srcdir=.
+ else
+ if [ -r ${progname}.in ] ; then
+ srcdir=`echo ${progname} | sed 's:/configure$::'`
+ else
+ echo '***' "Can't find configure.in. Try using --srcdir=some_dir" 1>&2
+ exit 1
+ fi
+ fi
+ ;;
+*)
+ # Set srcdir to "." if that's what it is.
+ # This is important for multilib support.
+ if [ ! -d ${srcdir} ] ; then
+ echo "Invalid source directory ${srcdir}" >&2
+ exit 1
+ fi
+ pwd=`pwd`
+ srcpwd=`cd ${srcdir} ; pwd`
+ if [ "${pwd}" = "${srcpwd}" ] ; then
+ srcdir=.
+ fi
+esac
+
+### warn about some conflicting configurations.
+
+case "${srcdir}" in
+".") ;;
+*)
+ if [ -f ${srcdir}/config.status ] ; then
+ echo '***' Cannot configure here in \"${PWD=`pwd`}\" when \"${srcdir}\" is currently configured. 1>&2
+ exit 1
+ fi
+esac
+
+# default exec_prefix
+case "${exec_prefixoption}" in
+"") exec_prefix="\$(prefix)" ;;
+*) ;;
+esac
+
+### break up ${srcdir}/configure.in.
+case "`grep '^# per\-host:' ${srcdir}/configure.in`" in
+"")
+ echo '***' ${srcdir}/configure.in has no \"per-host:\" line. 1>&2
+ # Check for a directory that's been converted to use autoconf since
+ # it was last configured.
+ if grep AC_OUTPUT ${srcdir}/configure.in >/dev/null ; then
+ echo '***' Hmm, looks like this directory has been autoconfiscated. 1>&2
+ if [ -r ${srcdir}/configure ] ; then
+ echo '***' Running the local configure script. 1>&2
+ case "${cache_file}" in
+ "") cache_file_option= ;;
+ *) cache_file_option="--cache-file=${cache_file}" ;;
+ esac
+ srcdiroption="--srcdir=${srcdir}"
+ case "${build_alias}" in
+ "") buildopt= ;;
+ *) buildopt="--build=${build_alias}" ;;
+ esac
+ eval exec ${config_shell} ${srcdir}/configure ${verbose} \
+ ${buildopt} --host=${host_alias} --target=${target_alias} \
+ ${prefixoption} ${tmpdiroption} ${exec_prefixoption} \
+ ${srcdiroption} \
+ ${program_prefixoption} ${program_suffixoption} \
+ ${program_transform_nameoption} ${site_option} \
+ ${withoptions} ${withoutoptions} \
+ ${enableoptions} ${disableoptions} ${floating_pointoption} \
+ ${cache_file_option} ${removing} ${other_options} ${redirect}
+ else
+ echo '***' There is no configure script present though. 1>&2
+ fi
+ fi
+ exit 1
+ ;;
+*) ;;
+esac
+
+case "`grep '^# per\-target:' ${srcdir}/configure.in`" in
+"")
+ echo '***' ${srcdir}/configure.in has no \"per-target:\" line. 1>&2
+ exit 1
+ ;;
+*) ;;
+esac
+
+case "${TMPDIR}" in
+"") TMPDIR=/tmp ; export TMPDIR ;;
+*) ;;
+esac
+
+# keep this filename short for &%*%$*# 14 char file names
+tmpfile=${TMPDIR}/cONf$$
+# Note that under many versions of sh a trap handler for 0 will *override* any
+# exit status you explicitly specify! At this point, the only non-error exit
+# is at the end of the script; these actions are duplicated there, minus
+# the "exit 1". Don't use "exit 0" anywhere after this without resetting the
+# trap handler, or you'll lose.
+trap "rm -f Makefile.tem ${tmpfile}.com ${tmpfile}.tgt ${tmpfile}.hst ${tmpfile}.pos; exit 1" 0 1 2 15
+
+# split ${srcdir}/configure.in into common, per-host, per-target,
+# and post-target parts. Post-target is optional.
+sed -e '/^# per\-host:/,$d' ${srcdir}/configure.in > ${tmpfile}.com
+sed -e '1,/^# per\-host:/d' -e '/^# per\-target:/,$d' ${srcdir}/configure.in > ${tmpfile}.hst
+if grep '^# post-target:' ${srcdir}/configure.in >/dev/null ; then
+ sed -e '1,/^# per\-target:/d' -e '/^# post\-target:/,$d' ${srcdir}/configure.in > ${tmpfile}.tgt
+ sed -e '1,/^# post\-target:/d' ${srcdir}/configure.in > ${tmpfile}.pos
+else
+ sed -e '1,/^# per\-target:/d' ${srcdir}/configure.in > ${tmpfile}.tgt
+ echo >${tmpfile}.pos
+fi
+
+### do common part of configure.in
+
+. ${tmpfile}.com
+
+# some sanity checks on configure.in
+case "${srctrigger}" in
+"")
+ echo '***' srctrigger not set in ${PWD=`pwd`}/configure.in. 1>&2
+ exit 1
+ ;;
+*) ;;
+esac
+
+case "${build_alias}" in
+"")
+ if result=`${config_shell} ${configsub} ${host_alias}` ; then
+ build_cpu=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+ build_vendor=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+ build_os=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+ build=${build_cpu}-${build_vendor}-${build_os}
+ build_alias=${host_alias}
+ fi
+ ;;
+*)
+ if result=`${config_shell} ${configsub} ${build_alias}` ; then
+ buildopt="--build=${build_alias}"
+ build_cpu=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+ build_vendor=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+ build_os=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+ build=${build_cpu}-${build_vendor}-${build_os}
+ else
+ echo "Unrecognized build system name ${build_alias}." 1>&2
+ exit 1
+ fi
+ ;;
+esac
+
+if result=`${config_shell} ${configsub} ${host_alias}` ; then
+ true
+else
+ echo "Unrecognized host system name ${host_alias}." 1>&2
+ exit 1
+fi
+host_cpu=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+host=${host_cpu}-${host_vendor}-${host_os}
+
+. ${tmpfile}.hst
+
+if result=`${config_shell} ${configsub} ${target_alias}` ; then
+ true
+else
+ echo "Unrecognized target system name ${target_alias}." 1>&2
+ exit 1
+fi
+target_cpu=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+target_vendor=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+target_os=`echo $result | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+target=${target_cpu}-${target_vendor}-${target_os}
+
+. ${tmpfile}.tgt
+
+# Find the source files, if location was not specified.
+case "${srcdir}" in
+"")
+ srcdirdefaulted=1
+ srcdir=.
+ if [ ! -r ${srctrigger} ] ; then
+ srcdir=..
+ fi
+ ;;
+*) ;;
+esac
+
+if [ ! -r ${srcdir}/${srctrigger} ] ; then
+ case "${srcdirdefaulted}" in
+ "") echo '***' "${progname}: Can't find ${srcname} sources in ${PWD=`pwd`}/${srcdir}" 1>&2 ;;
+ *) echo '***' "${progname}: Can't find ${srcname} sources in ${PWD=`pwd`}/. or ${PWD=`pwd`}/.." 1>&2 ;;
+ esac
+
+ echo '***' \(At least ${srctrigger} is missing.\) 1>&2
+ exit 1
+fi
+
+# Some systems (e.g., one of the i386-aix systems the gas testers are
+# using) don't handle "\$" correctly, so don't use it here.
+tooldir='$(exec_prefix)'/${target_alias}
+
+if [ "${host_alias}" != "${target_alias}" ] ; then
+ if [ "${program_prefixoption}" = "" ] ; then
+ if [ "${program_suffixoption}" = "" ] ; then
+ if [ "${program_transform_nameoption}" = "" ] ; then
+ program_prefix=${target_alias}- ;
+ fi
+ fi
+ fi
+fi
+
+# Merge program_prefix and program_suffix onto program_transform_name.
+# (program_suffix used to use $, but it's hard to preserve $ through both
+# make and sh.)
+if [ "${program_suffix}" != "" ] ; then
+ program_transform_name="-e s,\\\\(.*\\\\),\\\\1${program_suffix}, ${program_transform_name}"
+fi
+
+if [ "${program_prefix}" != "" ] ; then
+ program_transform_name="-e s,^,${program_prefix}, ${program_transform_name}"
+fi
+
+# If CC and CXX are not set in the environment, and the Makefile
+# exists, try to extract them from it. This is to handle running
+# ./config.status by hand.
+if [ -z "${CC}" -a -r Makefile ]; then
+ sed -n -e ':loop
+/\\$/ N
+s/\\\n//g
+t loop
+/^CC[ ]*=/ s/CC[ ]*=[ ]*\(.*\)/\1/p' < Makefile > Makefile.cc
+ CC=`tail -1 Makefile.cc`
+ rm -f Makefile.cc
+fi
+
+if [ -z "${CFLAGS}" -a -r Makefile ]; then
+ sed -n -e ':loop
+/\\$/ N
+s/\\\n//g
+t loop
+/^CFLAGS[ ]*=/ s/CFLAGS[ ]*=[ ]*\(.*\)/\1/p' < Makefile > Makefile.cc
+ CFLAGS=`tail -1 Makefile.cc`
+ rm -f Makefile.cc
+fi
+
+if [ -z "${CXX}" -a -r Makefile ]; then
+ sed -n -e ':loop
+/\\$/ N
+s/\\\n//g
+t loop
+/^CXX[ ]*=/ s/CXX[ ]*=[ ]*\(.*\)/\1/p' < Makefile > Makefile.cc
+ CXX=`tail -1 Makefile.cc`
+ rm -f Makefile.cc
+fi
+
+if [ -z "${CXXFLAGS}" -a -r Makefile ]; then
+ sed -n -e ':loop
+/\\$/ N
+s/\\\n//g
+t loop
+/^CXXFLAGS[ ]*=/ s/CXXFLAGS[ ]*=[ ]*\(.*\)/\1/p' < Makefile > Makefile.cc
+ CXXFLAGS=`tail -1 Makefile.cc`
+ rm -f Makefile.cc
+fi
+
+# Generate a default definition for YACC. This is used if the makefile can't
+# locate bison or byacc in objdir.
+
+for prog in 'bison -y' byacc yacc
+do
+ set dummy $prog; tmp=$2
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/$tmp; then
+ DEFAULT_YACC="$prog"
+ break
+ fi
+ done
+ IFS="$save_ifs"
+
+ test -n "$DEFAULT_YACC" && break
+done
+
+# Generate a default definition for LEX. This is used if the makefile can't
+# locate flex in objdir.
+
+for prog in flex lex
+do
+ set dummy $prog; tmp=$2
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/$tmp; then
+ DEFAULT_LEX="$prog"
+ break
+ fi
+ done
+ IFS="$save_ifs"
+
+ test -n "$DEFAULT_LEX" && break
+done
+
+if [ "${build}" != "${host}" ]; then
+ # If we are doing a Canadian Cross, in which the host and build systems
+ # are not the same, we set reasonable default values for the tools.
+
+ tools="AR AR_FOR_TARGET AS AS_FOR_TARGET BISON CC_FOR_BUILD"
+ tools="${tools} CC_FOR_TARGET CXX_FOR_TARGET"
+ tools="${tools} DLLTOOL DLLTOOL_FOR_TARGET GCC_FOR_TARGET HOST_PREFIX"
+ tools="${tools} HOST_PREFIX_1 LD LD_FOR_TARGET LEX MAKEINFO NM"
+ tools="${tools} NM_FOR_TARGET RANLIB RANLIB_FOR_TARGET"
+ tools="${tools} WINDRES WINDRES_FOR_TARGET YACC"
+
+ for var in ${tools}; do
+ if [ -z "`eval 'echo $'"${var}"`" -a -r Makefile ]; then
+ sed -n -e ':loop
+/\\$/ N
+s/\\\n//g
+t loop
+/^'"${var}"'[ ]*=/ s/'"${var}"'[ ]*=[ ]*\(.*\)/\1/p' \
+ < Makefile > Makefile.v
+ t=`tail -1 Makefile.v`
+ if [ -n "${t}" ]; then
+ eval "${var}='${t}'"
+ fi
+ rm -f Makefile.v
+ fi
+ done
+
+ AR=${AR-${host_alias}-ar}
+ AR_FOR_TARGET=${AR_FOR_TARGET-${target_alias}-ar}
+ AS=${AS-${host_alias}-as}
+ AS_FOR_TARGET=${AS_FOR_TARGET-${target_alias}-as}
+ BISON=${BISON-bison}
+ CC=${CC-${host_alias}-gcc}
+ CFLAGS=${CFLAGS-"-g -O2"}
+ CXX=${CXX-${host_alias}-c++}
+ CXXFLAGS=${CXXFLAGS-"-g -O2"}
+ CC_FOR_BUILD=${CC_FOR_BUILD-gcc}
+ CC_FOR_TARGET=${CC_FOR_TARGET-${target_alias}-gcc}
+ CXX_FOR_TARGET=${CXX_FOR_TARGET-${target_alias}-c++}
+ DLLTOOL=${DLLTOOL-${host_alias}-dlltool}
+ DLLTOOL_FOR_TARGET=${DLLTOOL_FOR_TARGET-${target_alias}-dlltool}
+ GCC_FOR_TARGET=${GCC_FOR_TARGET-${CC_FOR_TARGET-${target_alias}-gcc}}
+ HOST_PREFIX=${build_alias}-
+ HOST_PREFIX_1=${build_alias}-
+ LD=${LD-${host_alias}-ld}
+ LD_FOR_TARGET=${LD_FOR_TARGET-${target_alias}-ld}
+ MAKEINFO=${MAKEINFO-makeinfo}
+ NM=${NM-${host_alias}-nm}
+ NM_FOR_TARGET=${NM_FOR_TARGET-${target_alias}-nm}
+ RANLIB=${RANLIB-${host_alias}-ranlib}
+ RANLIB_FOR_TARGET=${RANLIB_FOR_TARGET-${target_alias}-ranlib}
+ WINDRES=${WINDRES-${host_alias}-windres}
+ WINDRES_FOR_TARGET=${WINDRES_FOR_TARGET-${target_alias}-windres}
+
+ if [ -z "${YACC}" ]; then
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/bison; then
+ YACC="bison -y"
+ break
+ fi
+ if test -f $dir/byacc; then
+ YACC=byacc
+ break
+ fi
+ if test -f $dir/yacc; then
+ YACC=yacc
+ break
+ fi
+ done
+ IFS="$save_ifs"
+ if [ -z "${YACC}" ]; then
+ YACC="bison -y"
+ fi
+ fi
+
+ if [ -z "${LEX}" ]; then
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/flex; then
+ LEX=flex
+ break
+ fi
+ if test -f $dir/lex; then
+ LEX=lex
+ break
+ fi
+ done
+ IFS="$save_ifs"
+ LEX=${LEX-flex}
+ fi
+
+ # Export variables which autoconf might try to set.
+ export AS
+ export AR
+ export CC_FOR_BUILD
+ export DLLTOOL
+ export LD
+ export NM
+ export RANLIB
+ export WINDRES
+else
+ # If CC is still not set, try to get gcc.
+ if [ -z "${CC}" ]; then
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/gcc; then
+ CC="gcc"
+ echo 'void f(){}' > conftest.c
+ if test -z "`${CC} -g -c conftest.c 2>&1`"; then
+ CFLAGS=${CFLAGS-"-g -O2"}
+ CXXFLAGS=${CFLAGS-"-g -O2"}
+ else
+ CFLAGS=${CFLAGS-"-O2"}
+ CXXFLAGS=${CFLAGS-"-O2"}
+ fi
+ rm -f conftest*
+ break
+ fi
+ done
+ IFS="$save_ifs"
+ CC=${CC-cc}
+ fi
+
+ CXX=${CXX-"c++"}
+ CFLAGS=${CFLAGS-"-g"}
+ CXXFLAGS=${CXXFLAGS-"-g -O2"}
+fi
+
+export CC
+export CXX
+export CFLAGS
+export CXXFLAGS
+
+# FIXME: This should be in configure.in, not configure
+case "$host" in
+ *go32*)
+ enable_gdbtk=no ;;
+ *msdosdjgpp*)
+ enable_gdbtk=no ;;
+ *cygwin32*)
+ enable_gdbtk=no ;;
+esac
+
+# FIXME: This should be in configure.in, not configure
+# Determine whether gdb needs tk/tcl or not.
+if [ "$enable_gdbtk" != "no" ]; then
+ GDB_TK="all-tcl all-tk all-itcl all-tix"
+else
+ GDB_TK=""
+fi
+
+for subdir in . ${subdirs} ; do
+
+ # ${subdir} is relative path from . to the directory we're currently
+ # configuring.
+ # ${invsubdir} is inverse of ${subdir), *with* trailing /, if needed.
+ invsubdir=`echo ${subdir}/ | sed -e 's|\./||g' -e 's|[^/]*/|../|g'`
+
+ ### figure out what to do with srcdir
+ case "${srcdir}" in
+ ".") # no -srcdir option. We're building in place.
+ makesrcdir=. ;;
+ /*) # absolute path
+ makesrcdir=`echo ${srcdir}/${subdir} | sed -e 's|/\.$||'`
+ ;;
+ *) # otherwise relative
+ case "${subdir}" in
+ .) makesrcdir=${srcdir} ;;
+ *) makesrcdir=${invsubdir}${srcdir}/${subdir} ;;
+ esac
+ ;;
+ esac
+
+ if [ "${subdir}/" != "./" ] ; then
+ Makefile=${subdir}/Makefile
+ fi
+
+ if [ ! -d ${subdir} ] ; then
+ if mkdir ${subdir} ; then
+ true
+ else
+ echo '***' "${progname}: could not make ${PWD=`pwd`}/${subdir}" 1>&2
+ exit 1
+ fi
+ fi
+
+ case "${removing}" in
+ "")
+ case "${subdir}" in
+ .) ;;
+ *) eval echo Building in ${subdir} ${redirect} ;;
+ esac
+
+ # FIXME Should this be done recursively ??? (Useful for e.g. gdbtest)
+ # Set up the list of links to be made.
+ # ${links} is the list of link names, and ${files} is the list of names to link to.
+
+ # Make the links.
+ configlinks="${links}"
+ if [ -r ${subdir}/config.status ] ; then
+ mv -f ${subdir}/config.status ${subdir}/config.back
+ fi
+ while [ -n "${files}" ] ; do
+ # set file to car of files, files to cdr of files
+ set ${files}; file=$1; shift; files=$*
+ set ${links}; link=$1; shift; links=$*
+
+ if [ ! -r ${srcdir}/${file} ] ; then
+ echo '***' "${progname}: cannot create a link \"${link}\"," 1>&2
+ echo '***' "since the file \"${srcdir}/${file}\" does not exist." 1>&2
+ exit 1
+ fi
+
+ ${remove} -f ${link}
+ # Make a symlink if possible, otherwise try a hard link
+ if ${symbolic_link} ${srcdir}/${file} ${link} >/dev/null 2>&1 ; then
+ true
+ else
+ # We need to re-remove the file because Lynx leaves a
+ # very strange directory there when it fails an NFS symlink.
+ ${remove} -r -f ${link}
+ ${hard_link} ${srcdir}/${file} ${link}
+ fi
+ if [ ! -r ${link} ] ; then
+ echo '***' "${progname}: unable to link \"${link}\" to \"${srcdir}/${file}\"." 1>&2
+ exit 1
+ fi
+
+ echo "Linked \"${link}\" to \"${srcdir}/${file}\"."
+ done
+
+ # Create a .gdbinit file which runs the one in srcdir
+ # and tells GDB to look there for source files.
+
+ if [ -r ${srcdir}/${subdir}/.gdbinit ] ; then
+ case ${srcdir} in
+ .) ;;
+ *) cat > ${subdir}/.gdbinit <<EOF
+# ${NO_EDIT}
+dir ${makesrcdir}
+dir .
+source ${makesrcdir}/.gdbinit
+EOF
+ ;;
+ esac
+ fi
+
+ # Install a makefile, and make it set VPATH
+ # if necessary so that the sources are found.
+ # Also change its value of srcdir.
+ # NOTE: Makefile generation constitutes the majority of the time in configure. Hence, this section has
+ # been somewhat optimized and is perhaps a bit twisty.
+
+ # code is order so as to try to sed the smallest input files we know.
+
+ # the four makefile fragments MUST end up in the resulting Makefile in this order:
+ # package, target, host, and site. so do these separately because I don't trust the
+ # order of sed -e expressions.
+
+ if [ -f ${srcdir}/${subdir}/${Makefile_in} ] ; then
+
+ # Conditionalize for this site from "Makefile.in" (or whatever it's called) into Makefile.tem
+ rm -f ${subdir}/Makefile.tem
+ case "${site}" in
+ "") cp ${srcdir}/${subdir}/${Makefile_in} ${subdir}/Makefile.tem ;;
+ *)
+ site_makefile_frag=${srcdir}/config/ms-${site}
+
+ if [ -f ${site_makefile_frag} ] ; then
+ sed -e "/^####/ r ${site_makefile_frag}" ${srcdir}/${subdir}/${Makefile_in} \
+ > ${subdir}/Makefile.tem
+ else
+ cp ${srcdir}/${subdir}/${Makefile_in} ${subdir}/Makefile.tem
+ site_makefile_frag=
+ fi
+ ;;
+ esac
+ # working copy now in ${subdir}/Makefile.tem
+
+ # Conditionalize the makefile for this host.
+ rm -f ${Makefile}
+ case "${host_makefile_frag}" in
+ "") mv ${subdir}/Makefile.tem ${Makefile} ;;
+ *)
+ if [ ! -f ${host_makefile_frag} ] ; then
+ host_makefile_frag=${srcdir}/${host_makefile_frag}
+ fi
+ if [ -f ${host_makefile_frag} ] ; then
+ sed -e "/^####/ r ${host_makefile_frag}" ${subdir}/Makefile.tem > ${Makefile}
+ else
+ echo '***' Expected host makefile fragment \"${host_makefile_frag}\" 1>&2
+ echo '***' is missing in ${PWD=`pwd`}. 1>&2
+ mv ${subdir}/Makefile.tem ${Makefile}
+ fi
+ esac
+ # working copy now in ${Makefile}
+
+ # Conditionalize the makefile for this target.
+ rm -f ${subdir}/Makefile.tem
+ case "${target_makefile_frag}" in
+ "") mv ${Makefile} ${subdir}/Makefile.tem ;;
+ *)
+ if [ ! -f ${target_makefile_frag} ] ; then
+ target_makefile_frag=${srcdir}/${target_makefile_frag}
+ fi
+ if [ -f ${target_makefile_frag} ] ; then
+ sed -e "/^####/ r ${target_makefile_frag}" ${Makefile} > ${subdir}/Makefile.tem
+ else
+ mv ${Makefile} ${subdir}/Makefile.tem
+ target_makefile_frag=
+ fi
+ ;;
+ esac
+ # real copy now in ${subdir}/Makefile.tem
+
+ # Conditionalize the makefile for this package.
+ rm -f ${Makefile}
+ case "${package_makefile_frag}" in
+ "") mv ${subdir}/Makefile.tem ${Makefile} ;;
+ *)
+ if [ ! -f ${package_makefile_frag} ] ; then
+ package_makefile_frag=${srcdir}/${package_makefile_frag}
+ fi
+ if [ -f ${package_makefile_frag} ] ; then
+ sed -e "/^####/ r ${package_makefile_frag}" ${subdir}/Makefile.tem > ${Makefile}
+ rm -f ${subdir}/Makefile.tem
+ else
+ echo '***' Expected package makefile fragment \"${package_makefile_frag}\" 1>&2
+ echo '***' is missing in ${PWD=`pwd`}. 1>&2
+ mv ${subdir}/Makefile.tem ${Makefile}
+ fi
+ esac
+ # working copy now in ${Makefile}
+
+ mv ${Makefile} ${subdir}/Makefile.tem
+
+ # real copy now in ${subdir}/Makefile.tem
+
+ # prepend warning about editting, and a bunch of variables.
+ rm -f ${Makefile}
+ cat > ${Makefile} <<EOF
+# ${NO_EDIT}
+VPATH = ${makesrcdir}
+links = ${configlinks}
+host_alias = ${host_alias}
+host_cpu = ${host_cpu}
+host_vendor = ${host_vendor}
+host_os = ${host_os}
+host_canonical = ${host_cpu}-${host_vendor}-${host_os}
+target_alias = ${target_alias}
+target_cpu = ${target_cpu}
+target_vendor = ${target_vendor}
+target_os = ${target_os}
+target_canonical = ${target_cpu}-${target_vendor}-${target_os}
+EOF
+ case "${build}" in
+ "") ;;
+ *) cat >> ${Makefile} << EOF
+build_alias = ${build_alias}
+build_cpu = ${build_cpu}
+build_vendor = ${build_vendor}
+build_os = ${build_os}
+build_canonical = ${build_cpu}-${build_vendor}-${build_os}
+EOF
+ esac
+
+ case "${package_makefile_frag}" in
+ "") ;;
+ /*) echo package_makefile_frag = ${package_makefile_frag} >>${Makefile} ;;
+ *) echo package_makefile_frag = ${invsubdir}${package_makefile_frag} >>${Makefile} ;;
+ esac
+
+ case "${target_makefile_frag}" in
+ "") ;;
+ /*) echo target_makefile_frag = ${target_makefile_frag} >>${Makefile} ;;
+ *) echo target_makefile_frag = ${invsubdir}${target_makefile_frag} >>${Makefile} ;;
+ esac
+
+ case "${host_makefile_frag}" in
+ "") ;;
+ /*) echo host_makefile_frag = ${host_makefile_frag} >>${Makefile} ;;
+ *) echo host_makefile_frag = ${invsubdir}${host_makefile_frag} >>${Makefile} ;;
+ esac
+
+ if [ "${site_makefile_frag}" != "" ] ; then
+ echo site_makefile_frag = ${invsubdir}${site_makefile_frag} >>${Makefile}
+ fi
+
+ # reset prefix, exec_prefix, srcdir, SUBDIRS, NONSUBDIRS,
+ # remove any form feeds.
+ if [ -z "${subdirs}" ]; then
+ rm -f ${subdir}/Makefile.tm2
+ sed -e "s:^SUBDIRS[ ]*=.*$:SUBDIRS = ${configdirs}:" \
+ -e "s:^NONSUBDIRS[ ]*=.*$:NONSUBDIRS = ${noconfigdirs}:" \
+ ${subdir}/Makefile.tem > ${subdir}/Makefile.tm2
+ rm -f ${subdir}/Makefile.tem
+ mv ${subdir}/Makefile.tm2 ${subdir}/Makefile.tem
+ fi
+ sed -e "s|^prefix[ ]*=.*$|prefix = ${prefix}|" \
+ -e "s|^exec_prefix[ ]*=.*$|exec_prefix = ${exec_prefix}|" \
+ -e "/^CC[ ]*=/{
+ :loop1
+ /\\\\$/ N
+ s/\\\\\\n//g
+ t loop1
+ s%^CC[ ]*=.*$%CC = ${CC}%
+ }" \
+ -e "/^CXX[ ]*=/{
+ :loop2
+ /\\\\$/ N
+ s/\\\\\\n//g
+ t loop2
+ s%^CXX[ ]*=.*$%CXX = ${CXX}%
+ }" \
+ -e "/^CFLAGS[ ]*=/{
+ :loop3
+ /\\\\$/ N
+ s/\\\\\\n//g
+ t loop3
+ s%^CFLAGS[ ]*=.*$%CFLAGS = ${CFLAGS}%
+ }" \
+ -e "/^CXXFLAGS[ ]*=/{
+ :loop4
+ /\\\\$/ N
+ s/\\\\\\n//g
+ t loop4
+ s%^CXXFLAGS[ ]*=.*$%CXXFLAGS = ${CXXFLAGS}%
+ }" \
+ -e "s|^SHELL[ ]*=.*$|SHELL = ${config_shell}|" \
+ -e "s:^GDB_TK[ ]*=.*$:GDB_TK = ${GDB_TK}:" \
+ -e "s|^srcdir[ ]*=.*$|srcdir = ${makesrcdir}|" \
+ -e "s/ //" \
+ -e "s:^program_prefix[ ]*=.*$:program_prefix = ${program_prefix}:" \
+ -e "s:^program_suffix[ ]*=.*$:program_suffix = ${program_suffix}:" \
+ -e "s:^program_transform_name[ ]*=.*$:program_transform_name = ${program_transform_name}:" \
+ -e "s|^tooldir[ ]*=.*$|tooldir = ${tooldir}|" \
+ -e "s:^DEFAULT_YACC[ ]*=.*$:DEFAULT_YACC = ${DEFAULT_YACC}:" \
+ -e "s:^DEFAULT_LEX[ ]*=.*$:DEFAULT_LEX = ${DEFAULT_LEX}:" \
+ ${subdir}/Makefile.tem >> ${Makefile}
+
+ # If this is a Canadian Cross, preset the values of many more
+ # tools.
+ if [ "${build}" != "${host}" ]; then
+ for var in ${tools}; do
+ val=`eval 'echo $'"${var}"`
+ sed -e "/^${var}[ ]*=/{
+ :loop1
+ /\\\\$/ N
+ /\\\\$/ b loop1
+ s/\\\\\\n//g
+ s%^${var}[ ]*=.*$%${var} = ${val}%
+ }" ${Makefile} > ${Makefile}.tem
+ mv -f ${Makefile}.tem ${Makefile}
+ done
+ fi
+
+ # final copy now in ${Makefile}
+
+ else
+ echo "No Makefile.in found in ${srcdir}/${subdir}, unable to configure" 1>&2
+ fi
+
+ rm -f ${subdir}/Makefile.tem
+
+ case "${host_makefile_frag}" in
+ "") using= ;;
+ *) using="and \"${host_makefile_frag}\"" ;;
+ esac
+
+ case "${target_makefile_frag}" in
+ "") ;;
+ *) using="${using} and \"${target_makefile_frag}\"" ;;
+ esac
+
+ case "${site_makefile_frag}" in
+ "") ;;
+ *) using="${using} and \"${site_makefile_frag}\"" ;;
+ esac
+
+ newusing=`echo "${using}" | sed 's/and/using/'`
+ using=${newusing}
+ echo "Created \"${Makefile}\" in" ${PWD=`pwd`} ${using}
+
+ . ${tmpfile}.pos
+
+ # describe the chosen configuration in config.status.
+ # Make that file a shellscript which will reestablish
+ # the same configuration. Used in Makefiles to rebuild
+ # Makefiles.
+
+ case "${norecursion}" in
+ "") arguments="${arguments} --norecursion" ;;
+ *) ;;
+ esac
+
+ if [ ${subdir} = . ] ; then
+ echo "#!/bin/sh
+# ${NO_EDIT}
+# This directory was configured as follows:
+${progname}" ${arguments} "
+# ${using}" > ${subdir}/config.new
+ else
+ echo "#!/bin/sh
+# ${NO_EDIT}
+# This directory was configured as follows:
+cd ${invsubdir}
+${progname}" ${arguments} "
+# ${using}" > ${subdir}/config.new
+ fi
+ chmod a+x ${subdir}/config.new
+ if [ -r ${subdir}/config.back ] ; then
+ mv -f ${subdir}/config.back ${subdir}/config.status
+ fi
+ ${config_shell} ${moveifchange} ${subdir}/config.new ${subdir}/config.status
+ ;;
+
+ *) rm -f ${Makefile} ${subdir}/config.status ${links} ;;
+ esac
+done
+
+# If there are subdirectories, then recur.
+if [ -z "${norecursion}" -a -n "${configdirs}" ] ; then
+ for configdir in ${configdirs} ; do
+
+ if [ -d ${srcdir}/${configdir} ] ; then
+ eval echo Configuring ${configdir}... ${redirect}
+ case "${srcdir}" in
+ ".") ;;
+ *)
+ if [ ! -d ./${configdir} ] ; then
+ if mkdir ./${configdir} ; then
+ true
+ else
+ echo '***' "${progname}: could not make ${PWD=`pwd`}/${configdir}" 1>&2
+ exit 1
+ fi
+ fi
+ ;;
+ esac
+
+ POPDIR=${PWD=`pwd`}
+ cd ${configdir}
+
+### figure out what to do with srcdir
+ case "${srcdir}" in
+ ".") newsrcdir=${srcdir} ;; # no -srcdir option. We're building in place.
+ /*) # absolute path
+ newsrcdir=${srcdir}/${configdir}
+ srcdiroption="--srcdir=${newsrcdir}"
+ ;;
+ ?:*) # absolute path on win32
+ newsrcdir=${srcdir}/${configdir}
+ srcdiroption="--srcdir=${newsrcdir}"
+ ;;
+ *) # otherwise relative
+ newsrcdir=../${srcdir}/${configdir}
+ srcdiroption="--srcdir=${newsrcdir}"
+ ;;
+ esac
+
+ # Handle --cache-file=../XXX
+ case "${cache_file}" in
+ "") # empty
+ ;;
+ /*) # absolute path
+ cache_file_option="--cache-file=${cache_file}"
+ ;;
+ ?:*) # absolute path on win32
+ cache_file_option="--cache-file=${cache_file}"
+ ;;
+ *) # relative path
+ cache_file_option="--cache-file=../${cache_file}"
+ ;;
+ esac
+
+### check for guested configure, otherwise fix possibly relative progname
+ if [ -f ${newsrcdir}/configure ] ; then
+ recprog=${newsrcdir}/configure
+ elif [ -f ${newsrcdir}/configure.in ] ; then
+ case "${progname}" in
+ /*) recprog=${progname} ;;
+ ?:*) recprog=${progname} ;;
+ *) recprog=../${progname} ;;
+ esac
+ else
+ eval echo No configuration information in ${configdir} ${redirect}
+ recprog=
+ fi
+
+### The recursion line is here.
+ if [ ! -z "${recprog}" ] ; then
+ if eval ${config_shell} ${recprog} ${verbose} ${buildopt} --host=${host_alias} --target=${target_alias} \
+ ${prefixoption} ${tmpdiroption} ${exec_prefixoption} \
+ ${srcdiroption} ${program_prefixoption} ${program_suffixoption} ${program_transform_nameoption} ${site_option} ${withoptions} ${withoutoptions} ${enableoptions} ${disableoptions} ${floating_pointoption} ${cache_file_option} ${removing} ${other_options} ${redirect} ; then
+ true
+ else
+ echo Configure in `pwd` failed, exiting. 1>&2
+ exit 1
+ fi
+ fi
+
+ cd ${POPDIR}
+ fi
+ done
+fi
+
+# Perform the same cleanup as the trap handler, minus the "exit 1" of course,
+# and reset the trap handler.
+rm -f ${tmpfile}.com ${tmpfile}.tgt ${tmpfile}.hst ${tmpfile}.pos
+trap 0
+
+exit 0
+
+#
+# Local Variables:
+# fill-column: 131
+# End:
+#
+
+# end of configure
diff --git a/configure.in b/configure.in
new file mode 100644
index 00000000000..e251e85b424
--- /dev/null
+++ b/configure.in
@@ -0,0 +1,874 @@
+#! /bin/bash
+##############################################################################
+
+## This file is a shell script fragment that supplies the information
+## necessary to tailor a template configure script into the configure
+## script appropriate for this directory. For more information, check
+## any existing configure script.
+
+## Be warned, there are two types of configure.in files. There are those
+## used by Autoconf, which are macros which are expanded into a configure
+## script by autoconf. The other sort, of which this is one, is executed
+## by Cygnus configure.
+
+## For more information on these two systems, check out the documentation
+## for 'Autoconf' (autoconf.texi) and 'Configure' (configure.texi).
+
+# Copyright (C) 1992, 93, 94, 95, 96, 1997 Free Software Foundation, Inc.
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+##############################################################################
+
+### To add a new directory to the tree, first choose whether it is a target
+### or a host dependent tool. Then put it into the appropriate list
+### (library or tools, host or target), doing a dependency sort. For
+### example, gdb requires that byacc (or bison) be built first, so it is in
+### the ${host_tools} list after byacc and bison.
+
+
+# these libraries are used by various programs built for the host environment
+#
+host_libs="mmalloc libiberty opcodes bfd readline gash db tcl tk tclX itcl tix"
+
+if [ "${enable_gdbgui}" = "yes" ] ; then
+ host_libs="${host_libs} libgui"
+fi
+
+# these tools are built for the host environment
+# Note, the powerpc-eabi build depends on sim occurring before gdb in order to
+# know that we are building the simulator.
+host_tools="texinfo byacc flex bison binutils ld gas gcc sim gdb make patch prms send-pr gprof gdbtest tgas etc expect dejagnu bash m4 autoconf automake ispell grep diff rcs cvs fileutils shellutils time textutils wdiff find emacs emacs19 uudecode hello tar gzip indent recode release sed utils guile perl apache inet gawk findutils sn"
+
+# these libraries are built for the target environment, and are built after
+# the host libraries and the host tools (which may be a cross compiler)
+#
+target_libs="target-libiberty target-libgloss target-newlib target-libio target-librx target-libstdc++ target-libg++"
+
+
+# these tools are built using the target libs, and are intended to run only
+# in the target environment
+#
+# note: any program that *uses* libraries that are in the "target_libs"
+# list belongs in this list. those programs are also very likely
+# candidates for the "native_only" list which follows
+#
+target_tools="target-examples target-groff target-gperf"
+
+################################################################################
+
+## These two lists are of directories that are to be removed from the
+## ${configdirs} list for either cross-compilations or for native-
+## compilations. For example, it doesn't make that much sense to
+## cross-compile Emacs, nor is it terribly useful to compile target-libiberty in
+## a native environment.
+
+# directories to be built in the native environment only
+#
+# This must be a single line because of the way it is searched by grep in
+# the code below.
+native_only="autoconf automake cvs emacs emacs19 fileutils find gawk grep gzip hello indent ispell m4 rcs recode sed shellutils tar textutils gash uudecode wdiff gprof target-groff guile perl apache inet time bash prms sn gnuserv target-gperf"
+
+# directories to be built in a cross environment only
+#
+cross_only="target-libgloss target-newlib"
+
+## All tools belong in one of the four categories, and are assigned above
+## We assign ${configdirs} this way to remove all embedded newlines. This
+## is important because configure will choke if they ever get through.
+## ${configdirs} is directories we build using the host tools.
+## ${target_configdirs} is directories we build using the target tools.
+#
+configdirs=`echo ${host_libs} ${host_tools}`
+target_configdirs=`echo ${target_libs} ${target_tools}`
+
+################################################################################
+
+srctrigger=move-if-change
+srcname="gnu development package"
+
+# This gets set non-empty for some net releases of packages.
+appdirs=""
+
+# per-host:
+
+# Work in distributions that contain no compiler tools, like Autoconf.
+if [ -d ${srcdir}/config ]; then
+case "${host}" in
+ m68k-hp-hpux*) host_makefile_frag=config/mh-hp300 ;;
+ m68k-apollo-sysv*) host_makefile_frag=config/mh-apollo68 ;;
+ m68k-apollo-bsd*) host_makefile_frag=config/mh-a68bsd ;;
+ m88k-dg-dgux*) host_makefile_frag=config/mh-dgux ;;
+ m88k-harris-cxux*) host_makefile_frag=config/mh-cxux ;;
+ m88k-motorola-sysv*) host_makefile_frag=config/mh-delta88;;
+ mips*-dec-ultrix*) host_makefile_frag=config/mh-decstation ;;
+ mips*-nec-sysv4*) host_makefile_frag=config/mh-necv4 ;;
+ mips*-sgi-irix6*) host_makefile_frag=config/mh-irix6 ;;
+ mips*-sgi-irix5*) host_makefile_frag=config/mh-irix5 ;;
+ mips*-sgi-irix4*) host_makefile_frag=config/mh-irix4 ;;
+ mips*-sgi-irix3*) host_makefile_frag=config/mh-sysv ;;
+ mips*-*-sysv4*) host_makefile_frag=config/mh-sysv4 ;;
+ mips*-*-sysv*) host_makefile_frag=config/mh-riscos ;;
+ i[3456]86-*-dgux*) host_makefile_frag=config/mh-dgux386 ;;
+ i[3456]86-ncr-sysv4.3) host_makefile_frag=config/mh-ncrsvr43 ;;
+ i[3456]86-ncr-sysv4*) host_makefile_frag=config/mh-ncr3000 ;;
+ i[3456]86-*-sco3.2v5*) host_makefile_frag=config/mh-sysv ;;
+ i[3456]86-*-sco*) host_makefile_frag=config/mh-sco ;;
+ i[3456]86-*-isc*) host_makefile_frag=config/mh-sysv ;;
+ i[3456]86-*-solaris2*) host_makefile_frag=config/mh-sysv4 ;;
+ i[3456]86-*-aix*) host_makefile_frag=config/mh-aix386 ;;
+ i[3456]86-*-go32*) host_makefile_frag=config/mh-go32 ;;
+ i[3456]86-*-msdosdjgpp*) host_makefile_frag=config/mh-go32 ;;
+ *-cygwin32*) host_makefile_frag=config/mh-cygwin32 ;;
+ *-windows*) host_makefile_frag=config/mh-windows ;;
+ vax-*-ultrix2*) host_makefile_frag=config/mh-vaxult2 ;;
+ *-*-solaris2*) host_makefile_frag=config/mh-solaris ;;
+ m68k-sun-sunos*) host_makefile_frag=config/mh-sun3 ;;
+ *-hp-hpux[78]*) host_makefile_frag=config/mh-hpux8 ;;
+ *-hp-hpux*) host_makefile_frag=config/mh-hpux ;;
+ *-*-hiux*) host_makefile_frag=config/mh-hpux ;;
+ rs6000-*-lynxos*) host_makefile_frag=config/mh-lynxrs6k ;;
+ *-*-lynxos*) host_makefile_frag=config/mh-lynxos ;;
+ *-*-sysv4*) host_makefile_frag=config/mh-sysv4 ;;
+ *-*-sysv*) host_makefile_frag=config/mh-sysv ;;
+esac
+fi
+
+# If we aren't going to be using gcc, see if we can extract a definition
+# of CC from the fragment.
+if [ -z "${CC}" -a "${build}" = "${host}" ]; then
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ found=
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/gcc; then
+ found=yes
+ break
+ fi
+ done
+ IFS="$save_ifs"
+ if [ -z "${found}" -a -n "${host_makefile_frag}" -a -f "${srcdir}/${host_makefile_frag}" ]; then
+ xx=`sed -n -e 's/^[ ]*CC[ ]*=[ ]*\(.*\)$/\1/p' < ${srcdir}/${host_makefile_frag}`
+ if [ -n "${xx}" ] ; then
+ CC=$xx
+ fi
+ fi
+fi
+
+# We default to --with-shared on platforms where -fpic is meaningless.
+# Well, we don't yet, but we will.
+if false && [ "${host}" = "${target}" ] && [ x${enable_shared} = x ]; then
+ case "${target}" in
+ alpha-dec-osf*) enable_shared=yes ;;
+ alpha-*-linux*) enable_shared=yes ;;
+ mips-sgi-irix5*) enable_shared=yes ;;
+ *) enable_shared=no ;;
+ esac
+fi
+
+case "${enable_shared}" in
+ yes) shared=yes ;;
+ no) shared=no ;;
+ "") shared=no ;;
+ *) shared=yes ;;
+esac
+
+if [ x${shared} = xyes ]; then
+ waugh=
+ case "${host}" in
+ hppa*) waugh=config/mh-papic ;;
+ i[3456]86-*) waugh=config/mh-x86pic ;;
+ sparc64-*) waugh=config/mh-sparcpic ;;
+ powerpc*-*) waugh=config/mh-ppcpic ;;
+ *) waugh=config/mh-${host_cpu}pic ;;
+ esac
+ if [ -f ${srcdir}/${waugh} ]; then
+ if [ -n "${host_makefile_frag}" ] ; then
+ cat ${srcdir}/${host_makefile_frag} > mh-frag
+ cat ${srcdir}/${waugh} >> mh-frag
+ host_makefile_frag=mh-frag
+ else
+ host_makefile_frag=${waugh}
+ fi
+ fi
+fi
+
+# per-target:
+
+case "${target}" in
+ v810*) target_makefile_frag=config/mt-v810 ;;
+ i[3456]86-*-netware*) target_makefile_frag=config/mt-netware ;;
+ powerpc-*-netware*) target_makefile_frag=config/mt-netware ;;
+esac
+
+skipdirs=
+gasdir=gas
+use_gnu_ld=
+use_gnu_as=
+
+# some tools are so dependent upon X11 that if we're not building with X,
+# it's not even worth trying to configure, much less build, that tool.
+
+case ${with_x} in
+ yes | "") # the default value for this tree is that X11 is available
+ ;;
+ no)
+ skipdirs="${skipdirs} tk gash"
+ ;;
+ *)
+ echo "*** bad value \"${with_x}\" for -with-x flag; ignored" 1>&2
+ ;;
+esac
+
+# Some tools are only suitable for building in a "native" situation.
+# Those are added when we have a host==target configuration. For cross
+# toolchains, we add some directories that should only be useful in a
+# cross-compiler.
+
+is_cross_compiler=
+
+if [ x"${host}" = x"${target}" ] ; then
+ # when doing a native toolchain, don't build the targets
+ # that are in the 'cross only' list
+ skipdirs="${skipdirs} ${cross_only}"
+ is_cross_compiler=no
+ target_subdir=.
+ case "${host}" in
+ # We need multilib support for irix6, to get libiberty built
+ # properly for o32 and n32.
+ mips-sgi-irix6*) target_subdir=${host} ;;
+ esac
+else
+ # similarly, don't build the targets in the 'native only'
+ # list when building a cross compiler
+ skipdirs="${skipdirs} ${native_only}"
+ is_cross_compiler=yes
+ target_subdir=${target_alias}
+fi
+
+if [ ! -d ${target_subdir} ] ; then
+ if mkdir ${target_subdir} ; then true
+ else
+ echo "'*** could not make ${PWD=`pwd`}/${target_subdir}" 1>&2
+ exit 1
+ fi
+fi
+
+copy_dirs=
+
+# Handle --with-headers=XXX. The contents of the named directory are
+# copied to $(tooldir)/sys-include.
+if [ x"${with_headers}" != x ]; then
+ if [ x${is_cross_compiler} = xno ]; then
+ echo 1>&2 '***' --with-headers is only supported when cross compiling
+ exit 1
+ fi
+ case "${exec_prefixoption}" in
+ "") x=${prefix} ;;
+ *) x=${exec_prefix} ;;
+ esac
+ copy_dirs="${copy_dirs} ${with_headers} $x/${target_alias}/sys-include"
+fi
+
+# Handle --with-libs=XXX. Multiple directories are permitted. The
+# contents are copied to $(tooldir)/lib.
+if [ x"${with_libs}" != x ]; then
+ if [ x${is_cross_compiler} = xno ]; then
+ echo 1>&2 '***' --with-libs is only supported when cross compiling
+ exit 1
+ fi
+ # Copy the libraries in reverse order, so that files in the first named
+ # library override files in subsequent libraries.
+ case "${exec_prefixoption}" in
+ "") x=${prefix} ;;
+ *) x=${exec_prefix} ;;
+ esac
+ for l in ${with_libs}; do
+ copy_dirs="$l $x/${target_alias}/lib ${copy_dirs}"
+ done
+fi
+
+# If both --with-headers and --with-libs are specified, default to
+# --without-newlib.
+if [ x"${with_headers}" != x ] && [ x"${with_libs}" != x ]; then
+ if [ x"${with_newlib}" = x ]; then
+ with_newlib=no
+ fi
+fi
+
+# Recognize --with-newlib/--without-newlib.
+if [ x${with_newlib} = xno ]; then
+ skipdirs="${skipdirs} target-newlib"
+elif [ x${with_newlib} = xyes ]; then
+ skipdirs=`echo " ${skipdirs} " | sed -e 's/ target-newlib / /'`
+fi
+
+# Default to using --with-stabs for certain targets.
+if [ x${with_stabs} = x ]; then
+ case "${target}" in
+ mips*-*-irix6*)
+ ;;
+ mips*-*-* | alpha*-*-osf* | i[3456]86*-*-sysv4* | i[3456]86*-*-unixware*)
+ with_stabs=yes;
+ withoptions="${withoptions} --with-stabs"
+ ;;
+ esac
+fi
+
+# Handle ${copy_dirs}
+set fnord ${copy_dirs}
+shift
+while [ $# != 0 ]; do
+ if [ -f $2/COPIED ] && [ x"`cat $2/COPIED`" = x"$1" ]; then
+ :
+ else
+ echo Copying $1 to $2
+
+ # Use the install script to create the directory and all required
+ # parent directories.
+ if [ -d $2 ]; then
+ :
+ else
+ echo >config.temp
+ ${srcdir}/install-sh -c -m 644 config.temp $2/COPIED
+ fi
+
+ # Copy the directory, assuming we have tar.
+ # FIXME: Should we use B in the second tar? Not all systems support it.
+ (cd $1; tar -cf - .) | (cd $2; tar -xpf -)
+
+ # It is the responsibility of the user to correctly adjust all
+ # symlinks. If somebody can figure out how to handle them correctly
+ # here, feel free to add the code.
+
+ echo $1 > $2/COPIED
+ fi
+ shift; shift
+done
+
+# Configure extra directories which are host specific
+
+case "${host}" in
+ i[3456]86-*-go32*)
+ configdirs="$configdirs dosrel" ;;
+ *-cygwin32*)
+ configdirs="$configdirs dosrel" ;;
+esac
+
+# Remove more programs from consideration, based on the host or
+# target this usually means that a port of the program doesn't
+# exist yet.
+
+noconfigdirs=""
+
+case "${host}" in
+ i[3456]86-*-vsta)
+ noconfigdirs="tcl expect dejagnu make texinfo bison patch flex byacc send-pr gprof uudecode dejagnu diff guile perl apache inet itcl tix db sn gnuserv"
+ ;;
+ i[3456]86-*-go32* | i[3456]86-*-msdosdjgpp*)
+ noconfigdirs="tcl tk expect dejagnu make texinfo bison patch flex byacc send-pr uudecode dejagnu diff guile perl apache inet itcl tix db sn gnuserv"
+ ;;
+ *-*-cygwin32)
+ noconfigdirs="expect dejagnu cvs autoconf automake bison send-pr gprof rcs guile perl texinfo apache inet"
+ ;;
+ *-*-windows*)
+# This is only used to build WinGDB...
+# note that powerpc-eabi depends on sim configured before gdb.
+ configdirs="bfd libiberty opcodes readline sim gdb"
+ target_configdirs=
+ ;;
+ ppc*-*-pe)
+ noconfigdirs="patch diff make tk tcl expect dejagnu cvs autoconf automake texinfo bison send-pr gprof rcs guile perl apache inet itcl tix db sn gnuserv"
+ ;;
+esac
+
+
+case "${target}" in
+ *-*-netware)
+ noconfigdirs="$noconfigdirs target-libg++ target-libstdc++ target-librx target-newlib target-libiberty target-libgloss"
+ ;;
+ *-*-vxworks*)
+ noconfigdirs="$noconfigdirs target-newlib target-libgloss"
+ ;;
+ alpha-dec-osf*)
+ # ld works, but does not support shared libraries. emacs doesn't
+ # work. newlib is not 64 bit ready. I'm not sure about fileutils.
+ # gas doesn't generate exception information.
+ noconfigdirs="$noconfigdirs gas ld emacs fileutils target-newlib target-libgloss"
+ ;;
+ alpha*-*-*vms*)
+ noconfigdirs="$noconfigdirs gdb ld target-newlib target-libgloss"
+ ;;
+ alpha*-*-*)
+ # newlib is not 64 bit ready
+ noconfigdirs="$noconfigdirs target-newlib target-libgloss"
+ ;;
+ arc-*-*)
+ noconfigdirs="$noconfigdirs target-libgloss"
+ ;;
+ arm-*-pe*)
+ noconfigdirs="$noconfigdirs target-libgloss"
+ ;;
+ arm-*-coff*)
+ noconfigdirs="$noconfigdirs target-libgloss"
+ ;;
+ arm-*-riscix*)
+ noconfigdirs="$noconfigdirs ld target-libgloss"
+ ;;
+ d10v-*-*)
+ noconfigdirs="$noconfigdirs target-librx target-libg++ target-libstdc++ target-libio target-libgloss"
+ ;;
+ h8300*-*-* | \
+ h8500-*-*)
+ noconfigdirs="$noconfigdirs target-libg++ target-libstdc++ target-libio target-librx target-libgloss"
+ ;;
+ hppa*-*-*elf* | \
+ hppa*-*-lites* | \
+ hppa*-*-rtems* )
+ # Do configure ld/binutils/gas for this case.
+ ;;
+ hppa*-*-*)
+ # HP's C compiler doesn't handle Emacs correctly (but on BSD and Mach
+ # cc is gcc, and on any system a user should be able to link cc to
+ # whatever they want. FIXME, emacs emacs19).
+ case "${CC}" in
+ "" | cc*) noconfigdirs="$noconfigdirs emacs emacs19" ;;
+ *) ;;
+ esac
+ noconfigdirs="$noconfigdirs ld shellutils"
+ ;;
+ i[3456]86-*-go32* | i[3456]-*-msdosdjgpp*)
+ # but don't build gdb
+ noconfigdirs="$noconfigdirs gdb target-libg++ target-libstdc++ target-libio target-librx"
+ ;;
+ *-*-cygwin32)
+ target_configdirs="$target_configdirs target-winsup"
+ noconfigdirs="$noconfigdirs expect target-libgloss"
+ # always build newlib.
+ skipdirs=`echo " ${skipdirs} " | sed -e 's/ target-newlib / /'`
+
+ # Can't build gdb for cygwin32 if not native.
+ case "${host}" in
+ *-*-cygwin32) ;; # keep gdb tcl tk expect etc.
+ *) noconfigdirs="$noconfigdirs gdb tcl tk expect itcl tix db sn gnuserv"
+ ;;
+ esac
+ ;;
+ i[3456]86-*-pe)
+ noconfigdirs="$noconfigdirs target-libg++ target-libstdc++ target-libio target-librx target-libgloss"
+ ;;
+ i[3456]86-*-sco3.2v5*)
+ # The linker does not yet know about weak symbols in COFF,
+ # and is not configured to handle mixed ELF and COFF.
+ noconfigdirs="$noconfigdirs gprof ld target-libgloss"
+ ;;
+ i[3456]86-*-sco*)
+ noconfigdirs="$noconfigdirs gprof target-libgloss"
+ ;;
+ i[3456]86-*-solaris2*)
+ # The linker does static linking correctly, but the Solaris C library
+ # has bugs such that some important functions won't work when statically
+ # linked. (See man pages for getpwuid, for example.)
+ noconfigdirs="$noconfigdirs ld target-libgloss"
+ ;;
+ i[3456]86-*-sysv4*)
+ # The SYSV4 C compiler doesn't handle Emacs correctly
+ case "${CC}" in
+ "" | cc*) noconfigdirs="$noconfigdirs emacs emacs19" ;;
+ *) ;;
+ esac
+ # but that's okay since emacs doesn't work anyway
+ noconfigdirs="$noconfigdirs emacs emacs19 target-libgloss"
+ ;;
+ mn10200-*-*)
+ noconfigdirs="$noconfigdirs target-libgloss"
+ ;;
+ mn10300-*-*)
+ noconfigdirs="$noconfigdirs target-libgloss"
+ ;;
+ powerpc-*-aix*)
+ # copied from rs6000-*-* entry
+ noconfigdirs="$noconfigdirs gprof cvs target-libgloss"
+ # This is needed until gcc and ld are fixed to work together.
+ use_gnu_ld=no
+ ;;
+ powerpc*-*-winnt* | powerpc*-*-pe* | ppc*-*-pe)
+ target_configdirs="$target_configdirs target-winsup"
+ noconfigdirs="$noconfigdirs gdb tcl tk make expect target-libgloss itcl tix db sn gnuserv"
+ # always build newlib.
+ skipdirs=`echo " ${skipdirs} " | sed -e 's/ target-newlib / /'`
+ ;;
+ # This is temporary until we can link against shared libraries
+ powerpcle-*-solaris*)
+ noconfigdirs="$noconfigdirs gdb sim make tcl tk expect itcl tix db sn gnuserv"
+ ;;
+ rs6000-*-lynxos*)
+ # The CVS server code doesn't work on the RS/6000
+ # Newlib makes problems for libg++ in crosses.
+ noconfigdirs="$noconfigdirs target-newlib gprof cvs"
+ ;;
+ rs6000-*-aix*)
+ noconfigdirs="$noconfigdirs gprof"
+ # This is needed until gcc and ld are fixed to work together.
+ use_gnu_ld=no
+ ;;
+ rs6000-*-*)
+ noconfigdirs="$noconfigdirs gprof"
+ ;;
+ m68k-apollo-*)
+ noconfigdirs="$noconfigdirs ld binutils gprof target-libgloss"
+ ;;
+ mips*-*-irix5*)
+ # The GNU linker does not support shared libraries.
+ # emacs is emacs 18, which does not work on Irix 5 (emacs19 does work)
+ noconfigdirs="$noconfigdirs ld gprof emacs target-libgloss"
+ ;;
+ mips*-*-irix6*)
+ # The GNU assembler and linker do not support IRIX 6.
+ # emacs is emacs 18, which does not work on Irix 5 (emacs19 does work)
+ noconfigdirs="$noconfigdirs ld gas gprof emacs target-libgloss"
+ ;;
+ mips*-dec-bsd*)
+ noconfigdirs="$noconfigdirs gprof target-libgloss"
+ ;;
+ mips*-*-bsd*)
+ noconfigdirs="$noconfigdirs gprof target-libgloss"
+ ;;
+ mips*-*-*)
+ noconfigdirs="$noconfigdirs gprof"
+ ;;
+ romp-*-*)
+ noconfigdirs="$noconfigdirs bfd binutils ld gas opcodes target-libgloss"
+ ;;
+ sh-*-*)
+ case "${host}" in
+ i[3456]86-*-vsta) ;; # don't add gprof back in
+ i[3456]86-*-go32*) ;; # don't add gprof back in
+ i[3456]86-*-msdosdjgpp*) ;; # don't add gprof back in
+ *) skipdirs=`echo " ${skipdirs} " | sed -e 's/ gprof / /'` ;;
+ esac
+ noconfigdirs="$noconfigdirs target-libgloss"
+ ;;
+ sparc-*-sunos4*)
+ if [ x${is_cross_compiler} != xno ] ; then
+ noconfigdirs="$noconfigdirs gdb gdbtest target-newlib target-libgloss"
+ else
+ use_gnu_ld=no
+ fi
+ ;;
+ v810-*-*)
+ noconfigdirs="$noconfigdirs bfd binutils gas gcc gdb ld target-libio target-libg++ target-libstdc++ opcodes target-libgloss"
+ ;;
+ vax-*-vms)
+ noconfigdirs="$noconfigdirs bfd binutils gdb ld target-newlib opcodes target-libgloss"
+ ;;
+ vax-*-*)
+ noconfigdirs="$noconfigdirs target-newlib target-libgloss"
+ ;;
+ *-*-lynxos*)
+ # Newlib makes problems for libg++ in crosses.
+ noconfigdirs="$noconfigdirs target-newlib target-libgloss"
+ ;;
+ *-*-macos* | \
+ *-*-mpw*)
+ # Macs want a resource compiler.
+ configdirs="$configdirs grez"
+ ;;
+esac
+
+# targets that need a second pass
+case "${target}" in
+ *-gm-magic*)
+ noconfigdirs="$noconfigdirs target-libgloss"
+ ;;
+esac
+
+# If we aren't building newlib, then don't build libgloss, since libgloss
+# depends upon some newlib header files.
+case "${noconfigdirs}" in
+ *target-libgloss*) ;;
+ *target-newlib*) noconfigdirs="$noconfigdirs target-libgloss" ;;
+esac
+
+# If we are building a Canadian Cross, discard tools that can not be built
+# using a cross compiler. FIXME: These tools should be fixed.
+if [ "${build}" != "${host}" ]; then
+ noconfigdirs="$noconfigdirs expect dejagnu"
+fi
+
+# Make sure we don't let GNU ld be added if we didn't want it.
+if [ x$with_gnu_ld = xno ]; then
+ use_gnu_ld=no
+ noconfigdirs="$noconfigdirs ld"
+fi
+
+# Make sure we don't let GNU as be added if we didn't want it.
+if [ x$with_gnu_as = xno ]; then
+ use_gnu_as=no
+ noconfigdirs="$noconfigdirs gas"
+fi
+
+# Remove the entries in $skipdirs and $noconfigdirs from $configdirs and
+# $target_configdirs.
+# If we have the source for $noconfigdirs entries, add them to $notsupp.
+
+notsupp=""
+for dir in . $skipdirs $noconfigdirs ; do
+ dirname=`echo $dir | sed -e s/target-//g`
+ if [ $dir != . ] && echo " ${configdirs} " | grep " ${dir} " >/dev/null 2>&1; then
+ configdirs=`echo " ${configdirs} " | sed -e "s/ ${dir} / /"`
+ if [ -r $srcdir/$dirname/configure ] \
+ || [ -r $srcdir/$dirname/configure.in ]; then
+ if echo " ${skipdirs} " | grep " ${dir} " >/dev/null 2>&1; then
+ true
+ else
+ notsupp="$notsupp $dir"
+ fi
+ fi
+ fi
+ if [ $dir != . ] && echo " ${target_configdirs} " | grep " ${dir} " >/dev/null 2>&1; then
+ target_configdirs=`echo " ${target_configdirs} " | sed -e "s/ ${dir} / /"`
+ if [ -r $srcdir/$dirname/configure ] \
+ || [ -r $srcdir/$dirname/configure.in ]; then
+ if echo " ${skipdirs} " | grep " ${dir} " >/dev/null 2>&1; then
+ true
+ else
+ notsupp="$notsupp $dir"
+ fi
+ fi
+ fi
+done
+
+# Sometimes the tools are distributed with libiberty but with no other
+# libraries. In that case, we don't want to build target-libiberty.
+if [ -n "${target_configdirs}" ]; then
+ others=
+ for i in `echo ${target_configdirs} | sed -e s/target-//g` ; do
+ if [ "$i" != "libiberty" ]; then
+ if [ -r $srcdir/$i/configure ] || [ -r $srcdir/$i/configure.in ]; then
+ others=yes;
+ break;
+ fi
+ fi
+ done
+ if [ -z "${others}" ]; then
+ target_configdirs=
+ fi
+fi
+
+# Deconfigure all subdirectories, in case we are changing the
+# configuration from one where a subdirectory is supported to one where it
+# is not.
+if [ -z "${norecursion}" -a -n "${configdirs}" ]; then
+ for i in `echo ${configdirs} | sed -e s/target-//g` ; do
+ rm -f $i/Makefile
+ done
+fi
+if [ -z "${norecursion}" -a -n "${target_configdirs}" ]; then
+ for i in `echo ${target_configdirs} | sed -e s/target-//g` ; do
+ rm -f ${target_subdir}/$i/Makefile
+ done
+fi
+
+# Produce a warning message for the subdirs we can't configure.
+# This isn't especially interesting in the Cygnus tree, but in the individual
+# FSF releases, it's important to let people know when their machine isn't
+# supported by the one or two programs in a package.
+
+if [ -n "${notsupp}" ] && [ -z "${norecursion}" ]; then
+ # If $appdirs is non-empty, at least one of those directories must still
+ # be configured, or we error out. (E.g., if the gas release supports a
+ # specified target in some subdirs but not the gas subdir, we shouldn't
+ # pretend that all is well.)
+ if [ -n "$appdirs" ]; then
+ for dir in $appdirs ; do
+ if [ -r $dir/Makefile.in ]; then
+ if echo " ${configdirs} " | grep " ${dir} " >/dev/null 2>&1; then
+ appdirs=""
+ break
+ fi
+ if echo " ${target_configdirs} " | grep " ${dir} " >/dev/null 2>&1; then
+ appdirs=""
+ break
+ fi
+ fi
+ done
+ if [ -n "$appdirs" ]; then
+ echo "*** This configuration is not supported by this package." 1>&2
+ exit 1
+ fi
+ fi
+ # Okay, some application will build, or we don't care to check. Still
+ # notify of subdirs not getting built.
+ echo "*** This configuration is not supported in the following subdirectories:" 1>&2
+ echo " ${notsupp}" 1>&2
+ echo " (Any other directories should still work fine.)" 1>&2
+fi
+
+# Set with_gnu_as and with_gnu_ld as appropriate.
+#
+# This is done by determining whether or not the appropriate directory
+# is available, and by checking whether or not specific configurations
+# have requested that this magic not happen.
+#
+# The command line options always override the explicit settings in
+# configure.in, and the settings in configure.in override this magic.
+#
+# If the default for a toolchain is to use GNU as and ld, and you don't
+# want to do that, then you should use the --without-gnu-as and
+# --without-gnu-ld options for the configure script.
+
+if [ x${use_gnu_as} = x ] ; then
+ if [ x${with_gnu_as} != xno ] && echo " ${configdirs} " | grep " ${gasdir} " > /dev/null 2>&1 && [ -d ${srcdir}/${gasdir} ] ; then
+ with_gnu_as=yes
+ withoptions="$withoptions --with-gnu-as"
+ fi
+fi
+
+if [ x${use_gnu_ld} = x ] ; then
+ if [ x${with_gnu_ld} != xno ] && echo " ${configdirs} " | grep " ld " > /dev/null 2>&1 && [ -d ${srcdir}/ld ] ; then
+ with_gnu_ld=yes
+ withoptions="$withoptions --with-gnu-ld"
+ fi
+fi
+
+# If using newlib, add --with-newlib to the withoptions so that gcc/configure
+# can detect this case.
+
+if [ x${with_newlib} != xno ] && echo " ${target_configdirs} " | grep " target-newlib " > /dev/null 2>&1 && [ -d ${srcdir}/newlib ] ; then
+ with_newlib=yes
+ withoptions="$withoptions --with-newlib"
+fi
+
+if [ x${shared} = xyes ]; then
+ case "${target}" in
+ hppa*) target_makefile_frag=config/mt-papic ;;
+ i[3456]86-*) target_makefile_frag=config/mt-x86pic ;;
+ powerpc*-*) target_makefile_frag=config/mt-ppcpic ;;
+ *) target_makefile_frag=config/mt-${target_cpu}pic ;;
+ esac
+fi
+
+# post-target:
+
+# Make sure that the compiler is able to generate an executable. If it
+# can't, we are probably in trouble. We don't care whether we can run the
+# executable--we might be using a cross compiler--we only care whether it
+# can be created. At this point the main configure script has set CC.
+echo "int main () { return 0; }" > conftest.c
+${CC} -o conftest ${CFLAGS} ${CPPFLAGS} ${LDFLAGS} conftest.c
+if [ $? = 0 ] && [ -s conftest ]; then
+ :
+else
+ echo 1>&2 "*** The command '${CC} -o conftest ${CFLAGS} ${CPPFLAGS} ${LDFLAGS} conftest.c' failed."
+ echo 1>&2 "*** You must set the environment variable CC to a working compiler."
+ rm -f conftest*
+ exit 1
+fi
+rm -f conftest*
+
+# The Solaris /usr/ucb/cc compiler does not appear to work.
+case "${host}" in
+ sparc-sun-solaris2*)
+ CCBASE="`echo ${CC-cc} | sed 's/ .*$//'`"
+ if [ "`/usr/bin/which $CCBASE`" = "/usr/ucb/cc" ] ; then
+ could_use=
+ [ -d /opt/SUNWspro/bin ] && could_use="/opt/SUNWspro/bin"
+ if [ -d /opt/cygnus/bin ] ; then
+ if [ "$could_use" = "" ] ; then
+ could_use="/opt/cygnus/bin"
+ else
+ could_use="$could_use or /opt/cygnus/bin"
+ fi
+ fi
+ if [ "$could_use" = "" ] ; then
+ echo "Warning: compilation may fail because you're using"
+ echo "/usr/ucb/cc. You should change your PATH or CC "
+ echo "variable and rerun configure."
+ else
+ echo "Warning: compilation may fail because you're using"
+ echo "/usr/ucb/cc, when you should use the C compiler from"
+ echo "$could_use. You should change your"
+ echo "PATH or CC variable and rerun configure."
+ fi
+ fi
+ ;;
+esac
+
+# If --enable-shared was set, we must set LD_LIBRARY_PATH so that the
+# binutils tools will find libbfd.so.
+if [ "${shared}" = "yes" ]; then
+ sed -e 's/^SET_LIB_PATH[ ]*=.*$/SET_LIB_PATH = $(REALLY_SET_LIB_PATH)/' \
+ Makefile > Makefile.tem
+ rm -f Makefile
+ mv -f Makefile.tem Makefile
+
+ case "${host}" in
+ *-*-hpux*)
+ sed -e 's/RPATH_ENVVAR[ ]*=.*$/RPATH_ENVVAR = SHLIB_PATH/' \
+ Makefile > Makefile.tem
+ rm -f Makefile
+ mv -f Makefile.tem Makefile
+ ;;
+ esac
+fi
+
+# If we are building for a cygwin32 host, then set INSTALL_PROGRAM_ARGS to
+# -x. This will cause programs to be installed with .exe extensions.
+case "${host}" in
+*-*-cygwin32*)
+ sed -e 's/^INSTALL_PROGRAM_ARGS[ ]*=.*$/INSTALL_PROGRAM_ARGS = -x/' \
+ Makefile > Makefile.tem
+ rm -f Makefile
+ mv -f Makefile.tem Makefile
+ ;;
+esac
+
+# Record target_configdirs and the configure arguments in Makefile.
+target_configdirs=`echo "${target_configdirs}" | sed -e 's/target-//g'`
+targargs=`echo "${arguments}" | \
+ sed -e 's/--norecursion//' \
+ -e 's/--cache[a-z-]*=[^ ]*//' \
+ -e 's/--ho[a-z-]*=[^ ]*//' \
+ -e 's/--bu[a-z-]*=[^ ]*//' \
+ -e 's/--ta[a-z-]*=[^ ]*//'`
+
+# Passing a --with-cross-host argument lets the target libraries know
+# whether they are being built with a cross-compiler or being built
+# native. However, it would be better to use other mechanisms to make the
+# sorts of decisions they want to make on this basis. Please consider
+# this option to be deprecated. FIXME.
+if [ x${is_cross_compiler} = xyes ]; then
+ targargs="--with-cross-host=${host_alias} ${targargs}"
+fi
+
+# Default to --enable-multilib.
+if [ x${enable_multilib} = x ]; then
+ targargs="--enable-multilib ${targargs}"
+fi
+
+targargs="--host=${target_alias} --build=${build_alias} ${targargs}"
+sed -e "s:^TARGET_CONFIGDIRS[ ]*=.*$:TARGET_CONFIGDIRS = ${target_configdirs}:" \
+ -e "s%^CONFIG_ARGUMENTS[ ]*=.*$%CONFIG_ARGUMENTS = ${targargs}%" \
+ -e "s%^TARGET_SUBDIR[ ]*=.*$%TARGET_SUBDIR = ${target_subdir}%" \
+ Makefile > Makefile.tem
+rm -f Makefile
+mv -f Makefile.tem Makefile
+
+#
+# Local Variables:
+# fill-column: 131
+# End:
+#
diff --git a/etc/ChangeLog b/etc/ChangeLog
new file mode 100644
index 00000000000..54c1a44f24a
--- /dev/null
+++ b/etc/ChangeLog
@@ -0,0 +1,392 @@
+Tue Jun 17 15:50:23 1997 Angela Marie Thomas (angela@cygnus.com)
+
+ * Install.in: Add /usr/bsd to PATH for Irix (home of compress)
+
+Thu Jun 12 13:47:00 1997 Angela Marie Thomas (angela@cygnus.com)
+
+ * Install.in (show_exec_prefix_msg): fix quoting
+
+Wed Jun 4 15:31:43 1997 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * rebuilding.texi: Removed.
+
+Sat May 24 18:02:20 1997 Angela Marie Thomas (angela@cygnus.com)
+
+ * cross-tools-fix: Remove host check since it doesn't matter
+ for this case.
+ * Install.in (guess_system): clean up more unused hosts.
+ * Install.in, cross-tools-fix, comp-tools-fix, comp-tools-verify:
+ Hack for host check to not warn the user for certain cases.
+
+Fri May 23 23:46:10 1997 Angela Marie Thomas (angela@cygnus.com)
+
+ * subst-strings: Remove a lot of unused code
+ * Install.in: Remove reference to TAPEdflt, use variables instead of
+ string substitution when able.
+
+Fri Apr 11 17:25:52 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Change file named in AC_INIT to Makefile.in.
+ * configure: Rebuild.
+
+Fri Apr 11 18:12:42 1997 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Install.in (guess_system): Back out change to INSTALLHOST to
+ call all IRIX systems "mips-sgi-irix4"
+
+ * Makefile.in: Remove references to configure.texi and cfg-paper.texi.
+
+Thu Apr 10 23:26:45 1997 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * srctree.texi, emacs-relnotes.texi, cfg-paper.texi: Remove.
+ * Install.in: Remove Ultrix-specific hacks.
+ Update Cygnus phone numbers.
+ (guess_system): Remove some old systems (Ultrix, OSF1 v1 & 2,
+ m68k-HPUX, m68k SunOS, etc.)
+ (show_gnu_root_msg): Remove.
+ Removed all the remove option code.
+
+Thu Apr 10 23:23:33 1997 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * configure.man, configure.texi: Remote.
+
+Mon Apr 7 18:15:00 1997 Brendan Kehoe <brendan@cygnus.com>
+
+ * Fix the version string for OSF1 4.0 to recognize either
+ V4.* or X4.*
+
+Mon Apr 7 15:34:47 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * standards.texi, make-stds.texi: Update to current FSF versions.
+
+Tue Apr 1 16:19:31 1997 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Install.in (show_exec_prefix_msg): GDBTK_FILENAME to
+ GDBTK_LIBRARY, also update TCL_LIBRARY and TK_LIBRARY.
+
+Tue Nov 19 15:36:14 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * make-rel-sym-tree: New file.
+
+Wed Oct 23 00:34:07 1996 Angela Marie Thomas (angela@cygnus.com)
+
+ * Lots of patches from progressive...
+ * Install.in: restore DDOPTS for AIX 4.x
+ * Install.in, subst-strings: add case for DG Aviion
+ * subst-strings: fix typo in INSTALLdir var setting
+ * comp-tools-verify: set SHLIB_PATH for shared libs
+ * Install.in, subst-strings: add case for solaris2.5
+ * Install.in: fix regression for hppa1.1 check
+ * comp-tools-fix: set LD_LIBRARY_PATH
+ * comp-tools-fix: If fixincludes fixes /usr/include/limits.h,
+ install it as syslimits.h.
+
+Wed Oct 16 19:20:42 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * Install.in (guess_system): Treat powerpc-ibm-aix4.1 the same as
+ rs6000-ibm-aix4.1, since the compiler now uses common mode by
+ default.
+
+Wed Oct 2 15:39:07 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * configure.in (AC_PROG_INSTALL): Added.
+ * Makefile.in (distclean): Remove config.cache.
+
+Wed Oct 2 14:33:58 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * configure.in: Switch to autoconf configure.in.
+ * configure: New.
+ * Makefile.in: Use autoconf-substituted values.
+
+Tue Jun 25 18:56:08 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (datadir): Changed to $(prefix)/share.
+
+Fri Mar 29 11:38:01 1996 J.T. Conklin (jtc@lisa.cygnus.com)
+
+ * configure.man: Changed to be recognized by catman -w on Solaris.
+
+Wed Dec 6 15:40:28 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * comp-tools-fix (fixincludes): Define FIXPROTO_DEFINES from
+ .../install-tools/fixproto-defines.
+
+Sun Nov 12 19:31:27 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * comp-tools-verify (verify_cxx_initializers): delete argv,
+ argc declarations, add -static to compile line.
+ (verify_cxx_hello_world): delete argv, argc declarations, add
+ -static to compile line.
+
+Wed Sep 20 13:21:52 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (maintainer-clean): New target, synonym for
+ realclean.
+
+Thu Sep 14 17:19:58 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Install.in (show_exec_prefix_msg): print out paths for
+ TCL_LIBRARY, TK_LIBRARY and GDBTK_FILENAME.
+
+Mon Aug 28 17:25:49 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Install.in (PATH): add /usr/ucb to $PATH (for SunOS 4.1.x).
+
+Tue Aug 15 21:51:58 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Install.in (guess_system): Match OSF/1 v3.x as the same as
+ v2.x--v2.x binaries are upward compatible.
+
+Tue Aug 15 21:46:54 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Install.in (guess_system): recognize HP 9000/800 systems as the
+ same as HP 9000/700 systems.
+
+Tue Aug 8 13:11:56 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * Install.in: For emacs, run show_emacs_alternate_msg and exit.
+ (show_emacs_alternate_msg): New message saying how emacs can't be
+ installed in an alternate prefix.
+
+Thu Jun 8 00:42:56 1995 Angela Marie Thomas <angela@cirdan.cygnus.com>
+
+ * subst-strings: change du commands to $BINDIR/. & $SRCDIR/. just
+ in case they are symlinks.
+
+Tue Apr 18 14:23:10 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * cdk-fix: Extracted table of targets that don't need their
+ headers fixed from gcc's configure script.
+
+ * cdk-fix, cdk-verify: Use ${HOST} instead of ||HOSTstr||
+
+ * cdk-fix, cdk-verify: New files, install script fragments used
+ for Cygnus Developer's Kit.
+
+ * Install.in (do_mkdir): New function.
+
+ * Install.in: Added support for --with and --without options.
+ Changed so that tape commands are not run when extracting
+ from a file.
+ (do_mt): Changed to take only one argument.
+
+Wed Mar 29 11:16:38 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Install.in: catch UNAME==alpha-dec-osf2.x and correct entry for
+ alpha-dec-osf1.x
+
+Fri Jan 27 12:04:29 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * subst-strings (mips-sgi-irix5): New entry in table.
+
+Thu Jan 19 12:15:44 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * Install.in: Major rewrite, bundle dependent code (for example,
+ fixincludes for comp-tools) will be inserted into the Install
+ script when it is generated.
+
+Tue Jan 17 16:51:32 1995 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * Makefile.in (Makefile): Rebuild using $(SHELL).
+
+Thu Nov 3 19:30:33 1994 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * Makefile.in (install-info): Depend on info.
+
+Fri Aug 19 16:16:38 1994 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Install.in: set $FIX_HEADER so fixproto can find fix-header.
+
+Fri May 6 16:18:58 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Makefile.in (install-info): add a semicolon in the if statement.
+
+Fri Apr 29 16:56:07 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * cfg-paper.texi: Update some outdated information.
+
+ * Makefile.in (install-info): Pass file, not directory, as last
+ arg to INSTALL_DATA.
+ (uninstall): New target.
+
+Thu Apr 28 14:42:22 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * configure.texi: Comment out @smallbook.
+
+ * Makefile.in: Define TEXI2DVI and TEXIDIR, and use the latter.
+ Remove info files in realclean, not clean, per coding standards.
+ Remove TeX output in clean.
+
+Tue Apr 26 17:18:03 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in: fixincludes output is actually put in fixincludes.log,
+ but echo'ed messages claim it is fixinc.log. This is the same
+ messages as I logged in March 4 1994, but for some reason we found
+ the change hadn't been done. I'll have to dig through the logs
+ and find out what I really did do that day. :)
+
+Mon Apr 25 20:28:19 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in: use eval to call do_mt() for Ultrix brokenness.
+
+Mon Apr 25 20:00:00 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in(do_mt): exit with error status 1 if # of parameters
+ != 3.
+
+Mon Apr 25 19:42:36 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in: lose TAPE_FORWARD and TAPE_REWIND, add do_mt()
+ to do all tape movement operations. Currently untested. Addresses
+ PR # 4886 from bull.
+
+ * Install.in: add 1994 to the copyright thing.
+
+Fri Apr 22 19:05:13 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * standards.texi: Update from FSF.
+
+Fri Apr 22 15:46:10 1994 Jason Molenda (crash@cygnus.com)
+
+ * Install.in: Add $DDOPTS, has ``bs=124b'' for all systems except
+ AIX (some versions of AIX don't understand bs=124b. Silly OS).
+
+Mon Apr 4 22:55:05 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in: null out $TOOLS before adding stuff to it
+ non-destructively.
+
+Wed Mar 30 21:45:35 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * standards.texi: Fix typo.
+
+ * configure.texi, configure.man: Document --disable-.
+
+Mon Mar 28 13:22:15 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * standards.texi: Update from FSF.
+
+Sat Mar 26 09:21:44 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * standards.texi, make-stds.texi: Update from FSF.
+
+Fri Mar 25 22:59:45 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * configure.texi, configure.man: Document --enable-* options.
+
+Wed Mar 23 23:38:24 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in: set CPP to be gcc -E for fixincludes.
+
+Wed Mar 23 13:42:48 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in: set PATH to $PATH:/bin:/usr/bin so we can pick
+ up native tools even if the user doesn't have them in his
+ path.
+
+ * Install.in: ``hppa-1.1-hp-hpux'' -> ``hppa1.1-hp-hpux''.
+
+Tue Mar 15 22:09:20 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in: TAPE_REWIND and TAPE_FORWARD variables for Unixunaware,
+ added switch statement to detect if system is Unixunaware.
+
+Fri Mar 4 12:10:30 1994 Jason Molenda (crash@sendai.cygnus.com)
+
+ * Install.in: fixincludes output is actually put in fixincludes.log,
+ but echo'ed messages claim it is fixinc.log.
+
+Wed Nov 3 02:58:02 1993 Jeffrey Osier (jeffrey@thepub.cygnus.com)
+
+ * subst-strings: output TEXBUNDLE for more install notes matching
+ * install-texi.in: PRMS info now exists
+
+Tue Oct 26 16:57:12 1993 K. Richard Pixley (rich@sendai.cygnus.com)
+
+ * subst-strings: match solaris*. Also, add default case to catch
+ and error out for unrecognized systems.
+
+Thu Aug 19 18:21:31 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * Install.in: handle the new fixproto work
+
+Mon Jul 19 12:05:41 1993 david d `zoo' zuhn (zoo@cirdan.cygnus.com)
+
+ * Install.in: remove "MT=tctl" for AIX (not needed, and barely
+ worked anyway)
+
+Mon Jun 14 19:09:22 1993 Jeffrey Osier (jeffrey@cygnus.com)
+
+ * subst-strings: changed HOST to recognize Solaris for install notes
+
+Thu Jun 10 16:01:25 1993 Jeffrey Osier (jeffrey@cygnus.com)
+
+ * dos-inst.texi: new file.
+
+Wed Jun 9 19:23:59 1993 Jeffrey Osier (jeffrey@rtl.cygnus.com)
+
+ * install-texi.in: added conditionals (nearly complete)
+ cleaned up
+ added support for other releases (not done)
+
+Wed Jun 9 15:53:58 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * Makefile.in (install-info): Use INSTALL_DATA.
+ ({dist,real}clean): Also delete Makefile and config.status.
+
+Fri Jun 4 17:09:56 1993 Jeffrey Osier (jeffrey@cygnus.com)
+
+ * subst-strings: added data for OS_STRING
+
+ * subst-strings: added support for OS_STRING
+
+Thu Jun 3 00:37:01 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Install.in: pull COPYING and COPYING.LIB off of the tape
+
+Tue Jun 1 16:52:08 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * subst-strings: replace RELEASE_DIR too
+
+Mon Mar 22 23:55:27 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: add installcheck target
+
+Wed Mar 17 02:21:15 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Install.in: fix 'source only' extraction bug where it looked for
+ the src dir under H-<host>/src instead of src; also remove stray
+ reference to EMACSHIBIN
+
+Mon Mar 15 01:25:45 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * make-stds.texi: added 'installcheck' to the standard targets
+
+Tue Mar 9 19:48:28 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * standards.texi: added INFO-DIR-ENTRY, updated version from the FSF
+
+Tue Feb 9 12:40:23 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (standards.info): Added -I$(srcdir) to find
+ make-stds.texi.
+
+Mon Feb 1 16:32:56 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * standards.texi: updated to latest FSF version, which includes:
+
+ * make-stds.texi: new file
+
+Mon Nov 30 01:31:40 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * install-texi.in, relnotes.texi, intro.texi: changed Cygnus phone
+ numbers from the old Palo Alto ones to the new Mtn. View numbers
+
+Mon Nov 16 16:50:43 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: define $(RM) to "rm -f"
+
+Sun Oct 11 16:05:48 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * intro.texi: added INFO-DIR-ENTRY
+
diff --git a/etc/Makefile.in b/etc/Makefile.in
new file mode 100644
index 00000000000..a5d59d6efdb
--- /dev/null
+++ b/etc/Makefile.in
@@ -0,0 +1,88 @@
+#
+# Makefile.in for etc
+#
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+bindir = @bindir@
+libdir = @libdir@
+tooldir = $(libdir)
+datadir = @datadir@
+
+mandir = @mandir@
+man1dir = $(mandir)/man1
+man2dir = $(mandir)/man2
+man3dir = $(mandir)/man3
+man4dir = $(mandir)/man4
+man5dir = $(mandir)/man5
+man6dir = $(mandir)/man6
+man7dir = $(mandir)/man7
+man8dir = $(mandir)/man8
+man9dir = $(mandir)/man9
+infodir = @infodir@
+
+SHELL = /bin/sh
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+MAKEINFO = makeinfo
+TEXI2DVI = texi2dvi
+
+# Where to find texinfo.tex to format documentation with TeX.
+TEXIDIR = $(srcdir)/../texinfo
+
+#### Host, target, and site specific Makefile fragments come in here.
+###
+
+INFOFILES = standards.info
+DVIFILES = standards.dvi
+
+all:
+
+install:
+
+uninstall:
+
+info: $(INFOFILES)
+
+install-info: info
+ if test ! -f standards.info ; then cd $(srcdir); fi; \
+ for i in standards.info*; do \
+ $(INSTALL_DATA) $$i $(infodir)/$$i; \
+ done
+
+dvi: $(DVIFILES)
+
+standards.info: $(srcdir)/standards.texi
+ $(MAKEINFO) -I$(srcdir) -o standards.info $(srcdir)/standards.texi
+
+standards.dvi: $(srcdir)/standards.texi
+ TEXINPUTS=$(TEXIDIR):$$TEXINPUTS $(TEXI2DVI) $(srcdir)/standards.texi
+
+
+clean:
+ rm -f *.aux *.cp *.cps *.dvi *.fn *.fns *.ky *.kys *.log
+ rm -f *.pg *.pgs *.toc *.tp *.tps *.vr *.vrs
+
+mostlyclean: clean
+
+distclean: clean
+ rm -f Makefile config.status config.cache
+
+maintainer-clean realclean: distclean
+ rm -f *.info*
+
+Makefile: $(srcdir)/Makefile.in $(host_makefile_frag) $(target_makefile_frag)
+ $(SHELL) ./config.status
+
+## these last targets are for standards.texi conformance
+dist:
+check:
+installcheck:
+TAGS:
diff --git a/etc/configure b/etc/configure
new file mode 100755
index 00000000000..c4a76356c46
--- /dev/null
+++ b/etc/configure
@@ -0,0 +1,858 @@
+#! /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=Makefile.in
+
+# 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
+
+
+
+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.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:553: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ for ac_prog in ginstall installbsd scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ # OSF/1 installbsd also uses dspmsg, but is usable.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+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 <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/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
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > 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%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_DATA@%$INSTALL_DATA%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 <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $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
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ 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
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $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/etc/configure.in b/etc/configure.in
new file mode 100644
index 00000000000..b785068009e
--- /dev/null
+++ b/etc/configure.in
@@ -0,0 +1,7 @@
+dnl Process this file with autoconf to produce a configure script.
+AC_PREREQ(2.5)
+AC_INIT(Makefile.in)
+
+AC_PROG_INSTALL
+
+AC_OUTPUT(Makefile)
diff --git a/etc/make-stds.texi b/etc/make-stds.texi
new file mode 100644
index 00000000000..e7c9cf98217
--- /dev/null
+++ b/etc/make-stds.texi
@@ -0,0 +1,893 @@
+@comment This file is included by both standards.texi and make.texinfo.
+@comment It was broken out of standards.texi on 1/6/93 by roland.
+
+@node Makefile Conventions
+@chapter Makefile Conventions
+@comment standards.texi does not print an index, but make.texinfo does.
+@cindex makefile, conventions for
+@cindex conventions for makefiles
+@cindex standards for makefiles
+
+This
+@ifinfo
+node
+@end ifinfo
+@iftex
+@ifset CODESTD
+section
+@end ifset
+@ifclear CODESTD
+chapter
+@end ifclear
+@end iftex
+describes conventions for writing the Makefiles for GNU programs.
+
+@menu
+* Makefile Basics:: General Conventions for Makefiles
+* Utilities in Makefiles:: Utilities in Makefiles
+* Command Variables:: Variables for Specifying Commands
+* Directory Variables:: Variables for Installation Directories
+* Standard Targets:: Standard Targets for Users
+* Install Command Categories:: Three categories of commands in the `install'
+ rule: normal, pre-install and post-install.
+@end menu
+
+@node Makefile Basics
+@section General Conventions for Makefiles
+
+Every Makefile should contain this line:
+
+@example
+SHELL = /bin/sh
+@end example
+
+@noindent
+to avoid trouble on systems where the @code{SHELL} variable might be
+inherited from the environment. (This is never a problem with GNU
+@code{make}.)
+
+Different @code{make} programs have incompatible suffix lists and
+implicit rules, and this sometimes creates confusion or misbehavior. So
+it is a good idea to set the suffix list explicitly using only the
+suffixes you need in the particular Makefile, like this:
+
+@example
+.SUFFIXES:
+.SUFFIXES: .c .o
+@end example
+
+@noindent
+The first line clears out the suffix list, the second introduces all
+suffixes which may be subject to implicit rules in this Makefile.
+
+Don't assume that @file{.} is in the path for command execution. When
+you need to run programs that are a part of your package during the
+make, please make sure that it uses @file{./} if the program is built as
+part of the make or @file{$(srcdir)/} if the file is an unchanging part
+of the source code. Without one of these prefixes, the current search
+path is used.
+
+The distinction between @file{./} (the @dfn{build directory}) and
+@file{$(srcdir)/} (the @dfn{source directory}) is important because
+users can build in a separate directory using the @samp{--srcdir} option
+to @file{configure}. A rule of the form:
+
+@smallexample
+foo.1 : foo.man sedscript
+ sed -e sedscript foo.man > foo.1
+@end smallexample
+
+@noindent
+will fail when the build directory is not the source directory, because
+@file{foo.man} and @file{sedscript} are in the the source directory.
+
+When using GNU @code{make}, relying on @samp{VPATH} to find the source
+file will work in the case where there is a single dependency file,
+since the @code{make} automatic variable @samp{$<} will represent the
+source file wherever it is. (Many versions of @code{make} set @samp{$<}
+only in implicit rules.) A Makefile target like
+
+@smallexample
+foo.o : bar.c
+ $(CC) -I. -I$(srcdir) $(CFLAGS) -c bar.c -o foo.o
+@end smallexample
+
+@noindent
+should instead be written as
+
+@smallexample
+foo.o : bar.c
+ $(CC) -I. -I$(srcdir) $(CFLAGS) -c $< -o $@@
+@end smallexample
+
+@noindent
+in order to allow @samp{VPATH} to work correctly. When the target has
+multiple dependencies, using an explicit @samp{$(srcdir)} is the easiest
+way to make the rule work well. For example, the target above for
+@file{foo.1} is best written as:
+
+@smallexample
+foo.1 : foo.man sedscript
+ sed -e $(srcdir)/sedscript $(srcdir)/foo.man > $@@
+@end smallexample
+
+GNU distributions usually contain some files which are not source
+files---for example, Info files, and the output from Autoconf, Automake,
+Bison or Flex. Since these files normally appear in the source
+directory, they should always appear in the source directory, not in the
+build directory. So Makefile rules to update them should put the
+updated files in the source directory.
+
+However, if a file does not appear in the distribution, then the
+Makefile should not put it in the source directory, because building a
+program in ordinary circumstances should not modify the source directory
+in any way.
+
+Try to make the build and installation targets, at least (and all their
+subtargets) work correctly with a parallel @code{make}.
+
+@node Utilities in Makefiles
+@section Utilities in Makefiles
+
+Write the Makefile commands (and any shell scripts, such as
+@code{configure}) to run in @code{sh}, not in @code{csh}. Don't use any
+special features of @code{ksh} or @code{bash}.
+
+The @code{configure} script and the Makefile rules for building and
+installation should not use any utilities directly except these:
+
+@c dd find
+@c gunzip gzip md5sum
+@c mkfifo mknod tee uname
+
+@example
+cat cmp cp diff echo egrep expr false grep install-info
+ln ls mkdir mv pwd rm rmdir sed sleep sort tar test touch true
+@end example
+
+The compression program @code{gzip} can be used in the @code{dist} rule.
+
+Stick to the generally supported options for these programs. For
+example, don't use @samp{mkdir -p}, convenient as it may be, because
+most systems don't support it.
+
+It is a good idea to avoid creating symbolic links in makefiles, since a
+few systems don't support them.
+
+The Makefile rules for building and installation can also use compilers
+and related programs, but should do so via @code{make} variables so that the
+user can substitute alternatives. Here are some of the programs we
+mean:
+
+@example
+ar bison cc flex install ld ldconfig lex
+make makeinfo ranlib texi2dvi yacc
+@end example
+
+Use the following @code{make} variables to run those programs:
+
+@example
+$(AR) $(BISON) $(CC) $(FLEX) $(INSTALL) $(LD) $(LDCONFIG) $(LEX)
+$(MAKE) $(MAKEINFO) $(RANLIB) $(TEXI2DVI) $(YACC)
+@end example
+
+When you use @code{ranlib} or @code{ldconfig}, you should make sure
+nothing bad happens if the system does not have the program in question.
+Arrange to ignore an error from that command, and print a message before
+the command to tell the user that failure of this command does not mean
+a problem. (The Autoconf @samp{AC_PROG_RANLIB} macro can help with
+this.)
+
+If you use symbolic links, you should implement a fallback for systems
+that don't have symbolic links.
+
+Additional utilities that can be used via Make variables are:
+
+@example
+chgrp chmod chown mknod
+@end example
+
+It is ok to use other utilities in Makefile portions (or scripts)
+intended only for particular systems where you know those utilities
+exist.
+
+@node Command Variables
+@section Variables for Specifying Commands
+
+Makefiles should provide variables for overriding certain commands, options,
+and so on.
+
+In particular, you should run most utility programs via variables.
+Thus, if you use Bison, have a variable named @code{BISON} whose default
+value is set with @samp{BISON = bison}, and refer to it with
+@code{$(BISON)} whenever you need to use Bison.
+
+File management utilities such as @code{ln}, @code{rm}, @code{mv}, and
+so on, need not be referred to through variables in this way, since users
+don't need to replace them with other programs.
+
+Each program-name variable should come with an options variable that is
+used to supply options to the program. Append @samp{FLAGS} to the
+program-name variable name to get the options variable name---for
+example, @code{BISONFLAGS}. (The name @code{CFLAGS} is an exception to
+this rule, but we keep it because it is standard.) Use @code{CPPFLAGS}
+in any compilation command that runs the preprocessor, and use
+@code{LDFLAGS} in any compilation command that does linking as well as
+in any direct use of @code{ld}.
+
+If there are C compiler options that @emph{must} be used for proper
+compilation of certain files, do not include them in @code{CFLAGS}.
+Users expect to be able to specify @code{CFLAGS} freely themselves.
+Instead, arrange to pass the necessary options to the C compiler
+independently of @code{CFLAGS}, by writing them explicitly in the
+compilation commands or by defining an implicit rule, like this:
+
+@smallexample
+CFLAGS = -g
+ALL_CFLAGS = -I. $(CFLAGS)
+.c.o:
+ $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
+@end smallexample
+
+Do include the @samp{-g} option in @code{CFLAGS}, because that is not
+@emph{required} for proper compilation. You can consider it a default
+that is only recommended. If the package is set up so that it is
+compiled with GCC by default, then you might as well include @samp{-O}
+in the default value of @code{CFLAGS} as well.
+
+Put @code{CFLAGS} last in the compilation command, after other variables
+containing compiler options, so the user can use @code{CFLAGS} to
+override the others.
+
+Every Makefile should define the variable @code{INSTALL}, which is the
+basic command for installing a file into the system.
+
+Every Makefile should also define the variables @code{INSTALL_PROGRAM}
+and @code{INSTALL_DATA}. (The default for each of these should be
+@code{$(INSTALL)}.) Then it should use those variables as the commands
+for actual installation, for executables and nonexecutables
+respectively. Use these variables as follows:
+
+@example
+$(INSTALL_PROGRAM) foo $(bindir)/foo
+$(INSTALL_DATA) libfoo.a $(libdir)/libfoo.a
+@end example
+
+@noindent
+Always use a file name, not a directory name, as the second argument of
+the installation commands. Use a separate command for each file to be
+installed.
+
+@node Directory Variables
+@section Variables for Installation Directories
+
+Installation directories should always be named by variables, so it is
+easy to install in a nonstandard place. The standard names for these
+variables are described below. They are based on a standard filesystem
+layout; variants of it are used in SVR4, 4.4BSD, Linux, Ultrix v4, and
+other modern operating systems.
+
+These two variables set the root for the installation. All the other
+installation directories should be subdirectories of one of these two,
+and nothing should be directly installed into these two directories.
+
+@table @samp
+@item prefix
+A prefix used in constructing the default values of the variables listed
+below. The default value of @code{prefix} should be @file{/usr/local}.
+When building the complete GNU system, the prefix will be empty and
+@file{/usr} will be a symbolic link to @file{/}.
+(If you are using Autoconf, write it as @samp{@@prefix@@}.)
+
+@item exec_prefix
+A prefix used in constructing the default values of some of the
+variables listed below. The default value of @code{exec_prefix} should
+be @code{$(prefix)}.
+(If you are using Autoconf, write it as @samp{@@exec_prefix@@}.)
+
+Generally, @code{$(exec_prefix)} is used for directories that contain
+machine-specific files (such as executables and subroutine libraries),
+while @code{$(prefix)} is used directly for other directories.
+@end table
+
+Executable programs are installed in one of the following directories.
+
+@table @samp
+@item bindir
+The directory for installing executable programs that users can run.
+This should normally be @file{/usr/local/bin}, but write it as
+@file{$(exec_prefix)/bin}.
+(If you are using Autoconf, write it as @samp{@@bindir@@}.)
+
+@item sbindir
+The directory for installing executable programs that can be run from
+the shell, but are only generally useful to system administrators. This
+should normally be @file{/usr/local/sbin}, but write it as
+@file{$(exec_prefix)/sbin}.
+(If you are using Autoconf, write it as @samp{@@sbindir@@}.)
+
+@item libexecdir
+@comment This paragraph adjusted to avoid overfull hbox --roland 5jul94
+The directory for installing executable programs to be run by other
+programs rather than by users. This directory should normally be
+@file{/usr/local/libexec}, but write it as @file{$(exec_prefix)/libexec}.
+(If you are using Autoconf, write it as @samp{@@libexecdir@@}.)
+@end table
+
+Data files used by the program during its execution are divided into
+categories in two ways.
+
+@itemize @bullet
+@item
+Some files are normally modified by programs; others are never normally
+modified (though users may edit some of these).
+
+@item
+Some files are architecture-independent and can be shared by all
+machines at a site; some are architecture-dependent and can be shared
+only by machines of the same kind and operating system; others may never
+be shared between two machines.
+@end itemize
+
+This makes for six different possibilities. However, we want to
+discourage the use of architecture-dependent files, aside from object
+files and libraries. It is much cleaner to make other data files
+architecture-independent, and it is generally not hard.
+
+Therefore, here are the variables Makefiles should use to specify
+directories:
+
+@table @samp
+@item datadir
+The directory for installing read-only architecture independent data
+files. This should normally be @file{/usr/local/share}, but write it as
+@file{$(prefix)/share}.
+(If you are using Autoconf, write it as @samp{@@datadir@@}.)
+As a special exception, see @file{$(infodir)}
+and @file{$(includedir)} below.
+
+@item sysconfdir
+The directory for installing read-only data files that pertain to a
+single machine--that is to say, files for configuring a host. Mailer
+and network configuration files, @file{/etc/passwd}, and so forth belong
+here. All the files in this directory should be ordinary ASCII text
+files. This directory should normally be @file{/usr/local/etc}, but
+write it as @file{$(prefix)/etc}.
+(If you are using Autoconf, write it as @samp{@@sysconfdir@@}.)
+
+@c rewritten to avoid overfull hbox --tower
+Do not install executables
+@c here
+in this directory (they probably
+belong in @file{$(libexecdir)} or @file{$(sbindir)}). Also do not
+install files that are modified in the normal course of their use
+(programs whose purpose is to change the configuration of the system
+excluded). Those probably belong in @file{$(localstatedir)}.
+
+@item sharedstatedir
+The directory for installing architecture-independent data files which
+the programs modify while they run. This should normally be
+@file{/usr/local/com}, but write it as @file{$(prefix)/com}.
+(If you are using Autoconf, write it as @samp{@@sharedstatedir@@}.)
+
+@item localstatedir
+The directory for installing data files which the programs modify while
+they run, and that pertain to one specific machine. Users should never
+need to modify files in this directory to configure the package's
+operation; put such configuration information in separate files that go
+in @file{$(datadir)} or @file{$(sysconfdir)}. @file{$(localstatedir)}
+should normally be @file{/usr/local/var}, but write it as
+@file{$(prefix)/var}.
+(If you are using Autoconf, write it as @samp{@@localstatedir@@}.)
+
+@item libdir
+The directory for object files and libraries of object code. Do not
+install executables here, they probably ought to go in @file{$(libexecdir)}
+instead. The value of @code{libdir} should normally be
+@file{/usr/local/lib}, but write it as @file{$(exec_prefix)/lib}.
+(If you are using Autoconf, write it as @samp{@@libdir@@}.)
+
+@item infodir
+The directory for installing the Info files for this package. By
+default, it should be @file{/usr/local/info}, but it should be written
+as @file{$(prefix)/info}.
+(If you are using Autoconf, write it as @samp{@@infodir@@}.)
+
+@item lispdir
+The directory for installing any Emacs Lisp files in this package. By
+default, it should be @file{/usr/local/share/emacs/site-lisp}, but it
+should be written as @file{$(prefix)/share/emacs/site-lisp}.
+
+If you are using Autoconf, write the default as @samp{@@lispdir@@}.
+In order to make @samp{@@lispdir@@} work, you need the following lines
+in your @file{configure.in} file:
+
+@example
+lispdir='$@{datadir@}/emacs/site-lisp'
+AC_SUBST(lispdir)
+@end example
+
+@item includedir
+@c rewritten to avoid overfull hbox --roland
+The directory for installing header files to be included by user
+programs with the C @samp{#include} preprocessor directive. This
+should normally be @file{/usr/local/include}, but write it as
+@file{$(prefix)/include}.
+(If you are using Autoconf, write it as @samp{@@includedir@@}.)
+
+Most compilers other than GCC do not look for header files in
+@file{/usr/local/include}. So installing the header files this way is
+only useful with GCC. Sometimes this is not a problem because some
+libraries are only really intended to work with GCC. But some libraries
+are intended to work with other compilers. They should install their
+header files in two places, one specified by @code{includedir} and one
+specified by @code{oldincludedir}.
+
+@item oldincludedir
+The directory for installing @samp{#include} header files for use with
+compilers other than GCC. This should normally be @file{/usr/include}.
+(If you are using Autoconf, you can write it as @samp{@@oldincludedir@@}.)
+
+The Makefile commands should check whether the value of
+@code{oldincludedir} is empty. If it is, they should not try to use
+it; they should cancel the second installation of the header files.
+
+A package should not replace an existing header in this directory unless
+the header came from the same package. Thus, if your Foo package
+provides a header file @file{foo.h}, then it should install the header
+file in the @code{oldincludedir} directory if either (1) there is no
+@file{foo.h} there or (2) the @file{foo.h} that exists came from the Foo
+package.
+
+To tell whether @file{foo.h} came from the Foo package, put a magic
+string in the file---part of a comment---and @code{grep} for that string.
+@end table
+
+Unix-style man pages are installed in one of the following:
+
+@table @samp
+@item mandir
+The top-level directory for installing the man pages (if any) for this
+package. It will normally be @file{/usr/local/man}, but you should
+write it as @file{$(prefix)/man}.
+(If you are using Autoconf, write it as @samp{@@mandir@@}.)
+
+@item man1dir
+The directory for installing section 1 man pages. Write it as
+@file{$(mandir)/man1}.
+@item man2dir
+The directory for installing section 2 man pages. Write it as
+@file{$(mandir)/man2}
+@item @dots{}
+
+@strong{Don't make the primary documentation for any GNU software be a
+man page. Write a manual in Texinfo instead. Man pages are just for
+the sake of people running GNU software on Unix, which is a secondary
+application only.}
+
+@item manext
+The file name extension for the installed man page. This should contain
+a period followed by the appropriate digit; it should normally be @samp{.1}.
+
+@item man1ext
+The file name extension for installed section 1 man pages.
+@item man2ext
+The file name extension for installed section 2 man pages.
+@item @dots{}
+Use these names instead of @samp{manext} if the package needs to install man
+pages in more than one section of the manual.
+@end table
+
+And finally, you should set the following variable:
+
+@table @samp
+@item srcdir
+The directory for the sources being compiled. The value of this
+variable is normally inserted by the @code{configure} shell script.
+(If you are using Autconf, use @samp{srcdir = @@srcdir@@}.)
+@end table
+
+For example:
+
+@smallexample
+@c I have changed some of the comments here slightly to fix an overfull
+@c hbox, so the make manual can format correctly. --roland
+# Common prefix for installation directories.
+# NOTE: This directory must exist when you start the install.
+prefix = /usr/local
+exec_prefix = $(prefix)
+# Where to put the executable for the command `gcc'.
+bindir = $(exec_prefix)/bin
+# Where to put the directories used by the compiler.
+libexecdir = $(exec_prefix)/libexec
+# Where to put the Info files.
+infodir = $(prefix)/info
+@end smallexample
+
+If your program installs a large number of files into one of the
+standard user-specified directories, it might be useful to group them
+into a subdirectory particular to that program. If you do this, you
+should write the @code{install} rule to create these subdirectories.
+
+Do not expect the user to include the subdirectory name in the value of
+any of the variables listed above. The idea of having a uniform set of
+variable names for installation directories is to enable the user to
+specify the exact same values for several different GNU packages. In
+order for this to be useful, all the packages must be designed so that
+they will work sensibly when the user does so.
+
+@node Standard Targets
+@section Standard Targets for Users
+
+All GNU programs should have the following targets in their Makefiles:
+
+@table @samp
+@item all
+Compile the entire program. This should be the default target. This
+target need not rebuild any documentation files; Info files should
+normally be included in the distribution, and DVI files should be made
+only when explicitly asked for.
+
+By default, the Make rules should compile and link with @samp{-g}, so
+that executable programs have debugging symbols. Users who don't mind
+being helpless can strip the executables later if they wish.
+
+@item install
+Compile the program and copy the executables, libraries, and so on to
+the file names where they should reside for actual use. If there is a
+simple test to verify that a program is properly installed, this target
+should run that test.
+
+Do not strip executables when installing them. Devil-may-care users can
+use the @code{install-strip} target to do that.
+
+If possible, write the @code{install} target rule so that it does not
+modify anything in the directory where the program was built, provided
+@samp{make all} has just been done. This is convenient for building the
+program under one user name and installing it under another.
+
+The commands should create all the directories in which files are to be
+installed, if they don't already exist. This includes the directories
+specified as the values of the variables @code{prefix} and
+@code{exec_prefix}, as well as all subdirectories that are needed.
+One way to do this is by means of an @code{installdirs} target
+as described below.
+
+Use @samp{-} before any command for installing a man page, so that
+@code{make} will ignore any errors. This is in case there are systems
+that don't have the Unix man page documentation system installed.
+
+The way to install Info files is to copy them into @file{$(infodir)}
+with @code{$(INSTALL_DATA)} (@pxref{Command Variables}), and then run
+the @code{install-info} program if it is present. @code{install-info}
+is a program that edits the Info @file{dir} file to add or update the
+menu entry for the given Info file; it is part of the Texinfo package.
+Here is a sample rule to install an Info file:
+
+@comment This example has been carefully formatted for the Make manual.
+@comment Please do not reformat it without talking to roland@gnu.ai.mit.edu.
+@smallexample
+$(infodir)/foo.info: foo.info
+ $(POST_INSTALL)
+# There may be a newer info file in . than in srcdir.
+ -if test -f foo.info; then d=.; \
+ else d=$(srcdir); fi; \
+ $(INSTALL_DATA) $$d/foo.info $@@; \
+# Run install-info only if it exists.
+# Use `if' instead of just prepending `-' to the
+# line so we notice real errors from install-info.
+# We use `$(SHELL) -c' because some shells do not
+# fail gracefully when there is an unknown command.
+ if $(SHELL) -c 'install-info --version' \
+ >/dev/null 2>&1; then \
+ install-info --dir-file=$(infodir)/dir \
+ $(infodir)/foo.info; \
+ else true; fi
+@end smallexample
+
+When writing the @code{install} target, you must classify all the
+commands into three categories: normal ones, @dfn{pre-installation}
+commands and @dfn{post-installation} commands. @xref{Install Command
+Categories}.
+
+@item uninstall
+Delete all the installed files---the copies that the @samp{install}
+target creates.
+
+This rule should not modify the directories where compilation is done,
+only the directories where files are installed.
+
+The uninstallation commands are divided into three categories, just like
+the installation commands. @xref{Install Command Categories}.
+
+@item install-strip
+Like @code{install}, but strip the executable files while installing
+them. In many cases, the definition of this target can be very simple:
+
+@smallexample
+install-strip:
+ $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' \
+ install
+@end smallexample
+
+Normally we do not recommend stripping an executable unless you are sure
+the program has no bugs. However, it can be reasonable to install a
+stripped executable for actual execution while saving the unstripped
+executable elsewhere in case there is a bug.
+
+@comment The gratuitous blank line here is to make the table look better
+@comment in the printed Make manual. Please leave it in.
+@item clean
+
+Delete all files from the current directory that are normally created by
+building the program. Don't delete the files that record the
+configuration. Also preserve files that could be made by building, but
+normally aren't because the distribution comes with them.
+
+Delete @file{.dvi} files here if they are not part of the distribution.
+
+@item distclean
+Delete all files from the current directory that are created by
+configuring or building the program. If you have unpacked the source
+and built the program without creating any other files, @samp{make
+distclean} should leave only the files that were in the distribution.
+
+@item mostlyclean
+Like @samp{clean}, but may refrain from deleting a few files that people
+normally don't want to recompile. For example, the @samp{mostlyclean}
+target for GCC does not delete @file{libgcc.a}, because recompiling it
+is rarely necessary and takes a lot of time.
+
+@item maintainer-clean
+Delete almost everything from the current directory that can be
+reconstructed with this Makefile. This typically includes everything
+deleted by @code{distclean}, plus more: C source files produced by
+Bison, tags tables, Info files, and so on.
+
+The reason we say ``almost everything'' is that running the command
+@samp{make maintainer-clean} should not delete @file{configure} even if
+@file{configure} can be remade using a rule in the Makefile. More generally,
+@samp{make maintainer-clean} should not delete anything that needs to
+exist in order to run @file{configure} and then begin to build the
+program. This is the only exception; @code{maintainer-clean} should
+delete everything else that can be rebuilt.
+
+The @samp{maintainer-clean} target is intended to be used by a maintainer of
+the package, not by ordinary users. You may need special tools to
+reconstruct some of the files that @samp{make maintainer-clean} deletes.
+Since these files are normally included in the distribution, we don't
+take care to make them easy to reconstruct. If you find you need to
+unpack the full distribution again, don't blame us.
+
+To help make users aware of this, the commands for the special
+@code{maintainer-clean} target should start with these two:
+
+@smallexample
+@@echo 'This command is intended for maintainers to use; it'
+@@echo 'deletes files that may need special tools to rebuild.'
+@end smallexample
+
+@item TAGS
+Update a tags table for this program.
+@c ADR: how?
+
+@item info
+Generate any Info files needed. The best way to write the rules is as
+follows:
+
+@smallexample
+info: foo.info
+
+foo.info: foo.texi chap1.texi chap2.texi
+ $(MAKEINFO) $(srcdir)/foo.texi
+@end smallexample
+
+@noindent
+You must define the variable @code{MAKEINFO} in the Makefile. It should
+run the @code{makeinfo} program, which is part of the Texinfo
+distribution.
+
+Normally a GNU distribution comes with Info files, and that means the
+Info files are present in the source directory. Therefore, the Make
+rule for an info file should update it in the source directory. When
+users build the package, ordinarily Make will not update the Info files
+because they will already be up to date.
+
+@item dvi
+Generate DVI files for all Texinfo documentation.
+For example:
+
+@smallexample
+dvi: foo.dvi
+
+foo.dvi: foo.texi chap1.texi chap2.texi
+ $(TEXI2DVI) $(srcdir)/foo.texi
+@end smallexample
+
+@noindent
+You must define the variable @code{TEXI2DVI} in the Makefile. It should
+run the program @code{texi2dvi}, which is part of the Texinfo
+distribution.@footnote{@code{texi2dvi} uses @TeX{} to do the real work
+of formatting. @TeX{} is not distributed with Texinfo.} Alternatively,
+write just the dependencies, and allow GNU @code{make} to provide the command.
+
+@item dist
+Create a distribution tar file for this program. The tar file should be
+set up so that the file names in the tar file start with a subdirectory
+name which is the name of the package it is a distribution for. This
+name can include the version number.
+
+For example, the distribution tar file of GCC version 1.40 unpacks into
+a subdirectory named @file{gcc-1.40}.
+
+The easiest way to do this is to create a subdirectory appropriately
+named, use @code{ln} or @code{cp} to install the proper files in it, and
+then @code{tar} that subdirectory.
+
+Compress the tar file file with @code{gzip}. For example, the actual
+distribution file for GCC version 1.40 is called @file{gcc-1.40.tar.gz}.
+
+The @code{dist} target should explicitly depend on all non-source files
+that are in the distribution, to make sure they are up to date in the
+distribution.
+@ifset CODESTD
+@xref{Releases, , Making Releases}.
+@end ifset
+@ifclear CODESTD
+@xref{Releases, , Making Releases, standards, GNU Coding Standards}.
+@end ifclear
+
+@item check
+Perform self-tests (if any). The user must build the program before
+running the tests, but need not install the program; you should write
+the self-tests so that they work when the program is built but not
+installed.
+@end table
+
+The following targets are suggested as conventional names, for programs
+in which they are useful.
+
+@table @code
+@item installcheck
+Perform installation tests (if any). The user must build and install
+the program before running the tests. You should not assume that
+@file{$(bindir)} is in the search path.
+
+@item installdirs
+It's useful to add a target named @samp{installdirs} to create the
+directories where files are installed, and their parent directories.
+There is a script called @file{mkinstalldirs} which is convenient for
+this; you can find it in the Texinfo package.
+@c It's in /gd/gnu/lib/mkinstalldirs.
+You can use a rule like this:
+
+@comment This has been carefully formatted to look decent in the Make manual.
+@comment Please be sure not to make it extend any further to the right.--roland
+@smallexample
+# Make sure all installation directories (e.g. $(bindir))
+# actually exist by making them if necessary.
+installdirs: mkinstalldirs
+ $(srcdir)/mkinstalldirs $(bindir) $(datadir) \
+ $(libdir) $(infodir) \
+ $(mandir)
+@end smallexample
+
+This rule should not modify the directories where compilation is done.
+It should do nothing but create installation directories.
+@end table
+
+@node Install Command Categories
+@section Install Command Categories
+
+@cindex pre-installation commands
+@cindex post-installation commands
+When writing the @code{install} target, you must classify all the
+commands into three categories: normal ones, @dfn{pre-installation}
+commands and @dfn{post-installation} commands.
+
+Normal commands move files into their proper places, and set their
+modes. They may not alter any files except the ones that come entirely
+from the package they belong to.
+
+Pre-installation and post-installation commands may alter other files;
+in particular, they can edit global configuration files or data bases.
+
+Pre-installation commands are typically executed before the normal
+commands, and post-installation commands are typically run after the
+normal commands.
+
+The most common use for a post-installation command is to run
+@code{install-info}. This cannot be done with a normal command, since
+it alters a file (the Info directory) which does not come entirely and
+solely from the package being installed. It is a post-installation
+command because it needs to be done after the normal command which
+installs the package's Info files.
+
+Most programs don't need any pre-installation commands, but we have the
+feature just in case it is needed.
+
+To classify the commands in the @code{install} rule into these three
+categories, insert @dfn{category lines} among them. A category line
+specifies the category for the commands that follow.
+
+A category line consists of a tab and a reference to a special Make
+variable, plus an optional comment at the end. There are three
+variables you can use, one for each category; the variable name
+specifies the category. Category lines are no-ops in ordinary execution
+because these three Make variables are normally undefined (and you
+@emph{should not} define them in the makefile).
+
+Here are the three possible category lines, each with a comment that
+explains what it means:
+
+@smallexample
+ $(PRE_INSTALL) # @r{Pre-install commands follow.}
+ $(POST_INSTALL) # @r{Post-install commands follow.}
+ $(NORMAL_INSTALL) # @r{Normal commands follow.}
+@end smallexample
+
+If you don't use a category line at the beginning of the @code{install}
+rule, all the commands are classified as normal until the first category
+line. If you don't use any category lines, all the commands are
+classified as normal.
+
+These are the category lines for @code{uninstall}:
+
+@smallexample
+ $(PRE_UNINSTALL) # @r{Pre-uninstall commands follow.}
+ $(POST_UNINSTALL) # @r{Post-uninstall commands follow.}
+ $(NORMAL_UNINSTALL) # @r{Normal commands follow.}
+@end smallexample
+
+Typically, a pre-uninstall command would be used for deleting entries
+from the Info directory.
+
+If the @code{install} or @code{uninstall} target has any dependencies
+which act as subroutines of installation, then you should start
+@emph{each} dependency's commands with a category line, and start the
+main target's commands with a category line also. This way, you can
+ensure that each command is placed in the right category regardless of
+which of the dependencies actually run.
+
+Pre-installation and post-installation commands should not run any
+programs except for these:
+
+@example
+[ basename bash cat chgrp chmod chown cmp cp dd diff echo
+egrep expand expr false fgrep find getopt grep gunzip gzip
+hostname install install-info kill ldconfig ln ls md5sum
+mkdir mkfifo mknod mv printenv pwd rm rmdir sed sort tee
+test touch true uname xargs yes
+@end example
+
+@cindex binary packages
+The reason for distinguishing the commands in this way is for the sake
+of making binary packages. Typically a binary package contains all the
+executables and other files that need to be installed, and has its own
+method of installing them---so it does not need to run the normal
+installation commands. But installing the binary package does need to
+execute the pre-installation and post-installation commands.
+
+Programs to build binary packages work by extracting the
+pre-installation and post-installation commands. Here is one way of
+extracting the pre-installation commands:
+
+@smallexample
+make -n install -o all \
+ PRE_INSTALL=pre-install \
+ POST_INSTALL=post-install \
+ NORMAL_INSTALL=normal-install \
+ | gawk -f pre-install.awk
+@end smallexample
+
+@noindent
+where the file @file{pre-install.awk} could contain this:
+
+@smallexample
+$0 ~ /^\t[ \t]*(normal_install|post_install)[ \t]*$/ @{on = 0@}
+on @{print $0@}
+$0 ~ /^\t[ \t]*pre_install[ \t]*$/ @{on = 1@}
+@end smallexample
+
+The resulting file of pre-installation commands is executed as a shell
+script as part of installing the binary package.
diff --git a/etc/standards.texi b/etc/standards.texi
new file mode 100644
index 00000000000..4170093c65f
--- /dev/null
+++ b/etc/standards.texi
@@ -0,0 +1,3061 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename standards.info
+@settitle GNU Coding Standards
+@c UPDATE THIS DATE WHENEVER YOU MAKE CHANGES!
+@set lastupdate 16 January 1997
+@c %**end of header
+
+@ifinfo
+@format
+START-INFO-DIR-ENTRY
+* Standards: (standards). GNU coding standards.
+END-INFO-DIR-ENTRY
+@end format
+@end ifinfo
+
+@c @setchapternewpage odd
+@setchapternewpage off
+
+@c This is used by a cross ref in make-stds.texi
+@set CODESTD 1
+@iftex
+@set CHAPTER chapter
+@end iftex
+@ifinfo
+@set CHAPTER node
+@end ifinfo
+
+@ifinfo
+GNU Coding Standards
+Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+@end ignore
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@end ifinfo
+
+@titlepage
+@title GNU Coding Standards
+@author Richard Stallman
+@author last updated @value{lastupdate}
+@page
+
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@end titlepage
+
+@ifinfo
+@node Top, Preface, (dir), (dir)
+@top Version
+
+Last updated @value{lastupdate}.
+@end ifinfo
+
+@menu
+* Preface:: About the GNU Coding Standards
+* Intellectual Property:: Keeping Free Software Free
+* Design Advice:: General Program Design
+* Program Behavior:: Program Behavior for All Programs
+* Writing C:: Making The Best Use of C
+* Documentation:: Documenting Programs
+* Managing Releases:: The Release Process
+@end menu
+
+@node Preface
+@chapter About the GNU Coding Standards
+
+The GNU Coding Standards were written by Richard Stallman and other GNU
+Project volunteers. Their purpose is to make the GNU system clean,
+consistent, and easy to install. This document can also be read as a
+guide to writing portable, robust and reliable programs. It focuses on
+programs written in C, but many of the rules and principles are useful
+even if you write in another programming language. The rules often
+state reasons for writing in a certain way.
+
+Corrections or suggestions regarding this document should be sent to
+@code{gnu@@prep.ai.mit.edu}. If you make a suggestion, please include a
+suggested new wording for it; our time is limited. We prefer a context
+diff to the @file{standards.texi} or @file{make-stds.texi} files, but if
+you don't have those files, please mail your suggestion anyway.
+
+This release of the GNU Coding Standards was last updated
+@value{lastupdate}.
+
+@node Intellectual Property
+@chapter Keeping Free Software Free
+
+This @value{CHAPTER} discusses how you can make sure that GNU software
+remains unencumbered.
+
+@menu
+* Reading Non-Free Code:: Referring to Proprietary Programs
+* Contributions:: Accepting Contributions
+@end menu
+
+@node Reading Non-Free Code
+@section Referring to Proprietary Programs
+
+Don't in any circumstances refer to Unix source code for or during
+your work on GNU! (Or to any other proprietary programs.)
+
+If you have a vague recollection of the internals of a Unix program,
+this does not absolutely mean you can't write an imitation of it, but
+do try to organize the imitation internally along different lines,
+because this is likely to make the details of the Unix version
+irrelevant and dissimilar to your results.
+
+For example, Unix utilities were generally optimized to minimize
+memory use; if you go for speed instead, your program will be very
+different. You could keep the entire input file in core and scan it
+there instead of using stdio. Use a smarter algorithm discovered more
+recently than the Unix program. Eliminate use of temporary files. Do
+it in one pass instead of two (we did this in the assembler).
+
+Or, on the contrary, emphasize simplicity instead of speed. For some
+applications, the speed of today's computers makes simpler algorithms
+adequate.
+
+Or go for generality. For example, Unix programs often have static
+tables or fixed-size strings, which make for arbitrary limits; use
+dynamic allocation instead. Make sure your program handles NULs and
+other funny characters in the input files. Add a programming language
+for extensibility and write part of the program in that language.
+
+Or turn some parts of the program into independently usable libraries.
+Or use a simple garbage collector instead of tracking precisely when
+to free memory, or use a new GNU facility such as obstacks.
+
+
+@node Contributions
+@section Accepting Contributions
+
+If someone else sends you a piece of code to add to the program you are
+working on, we need legal papers to use it---the same sort of legal
+papers we will need to get from you. @emph{Each} significant
+contributor to a program must sign some sort of legal papers in order
+for us to have clear title to the program. The main author alone is not
+enough.
+
+So, before adding in any contributions from other people, tell us
+so we can arrange to get the papers. Then wait until we tell you
+that we have received the signed papers, before you actually use the
+contribution.
+
+This applies both before you release the program and afterward. If
+you receive diffs to fix a bug, and they make significant changes, we
+need legal papers for it.
+
+You don't need papers for changes of a few lines here or there, since
+they are not significant for copyright purposes. Also, you don't need
+papers if all you get from the suggestion is some ideas, not actual code
+which you use. For example, if you write a different solution to the
+problem, you don't need to get papers.
+
+We know this is frustrating; it's frustrating for us as well. But if
+you don't wait, you are going out on a limb---for example, what if the
+contributor's employer won't sign a disclaimer? You might have to take
+that code out again!
+
+The very worst thing is if you forget to tell us about the other
+contributor. We could be very embarrassed in court some day as a
+result.
+
+@node Design Advice
+@chapter General Program Design
+
+This @value{CHAPTER} discusses some of the issues you should take into
+account when designing your program.
+
+@menu
+* Compatibility:: Compatibility with other implementations
+* Using Extensions:: Using non-standard features
+* ANSI C:: Using ANSI C features
+* Source Language:: Using languages other than C
+@end menu
+
+@node Compatibility
+@section Compatibility with Other Implementations
+
+With occasional exceptions, utility programs and libraries for GNU
+should be upward compatible with those in Berkeley Unix, and upward
+compatible with @sc{ansi} C if @sc{ansi} C specifies their behavior, and
+upward compatible with @sc{POSIX} if @sc{POSIX} specifies their
+behavior.
+
+When these standards conflict, it is useful to offer compatibility
+modes for each of them.
+
+@sc{ansi} C and @sc{POSIX} prohibit many kinds of extensions. Feel free
+to make the extensions anyway, and include a @samp{--ansi},
+@samp{--posix}, or @samp{--compatible} option to turn them off.
+However, if the extension has a significant chance of breaking any real
+programs or scripts, then it is not really upward compatible. Try to
+redesign its interface.
+
+Many GNU programs suppress extensions that conflict with POSIX if the
+environment variable @code{POSIXLY_CORRECT} is defined (even if it is
+defined with a null value). Please make your program recognize this
+variable if appropriate.
+
+When a feature is used only by users (not by programs or command
+files), and it is done poorly in Unix, feel free to replace it
+completely with something totally different and better. (For example,
+@code{vi} is replaced with Emacs.) But it is nice to offer a compatible
+feature as well. (There is a free @code{vi} clone, so we offer it.)
+
+Additional useful features not in Berkeley Unix are welcome.
+Additional programs with no counterpart in Unix may be useful,
+but our first priority is usually to duplicate what Unix already
+has.
+
+@node Using Extensions
+@section Using Non-standard Features
+
+Many GNU facilities that already exist support a number of convenient
+extensions over the comparable Unix facilities. Whether to use these
+extensions in implementing your program is a difficult question.
+
+On the one hand, using the extensions can make a cleaner program.
+On the other hand, people will not be able to build the program
+unless the other GNU tools are available. This might cause the
+program to work on fewer kinds of machines.
+
+With some extensions, it might be easy to provide both alternatives.
+For example, you can define functions with a ``keyword'' @code{INLINE}
+and define that as a macro to expand into either @code{inline} or
+nothing, depending on the compiler.
+
+In general, perhaps it is best not to use the extensions if you can
+straightforwardly do without them, but to use the extensions if they
+are a big improvement.
+
+An exception to this rule are the large, established programs (such as
+Emacs) which run on a great variety of systems. Such programs would
+be broken by use of GNU extensions.
+
+Another exception is for programs that are used as part of
+compilation: anything that must be compiled with other compilers in
+order to bootstrap the GNU compilation facilities. If these require
+the GNU compiler, then no one can compile them without having them
+installed already. That would be no good.
+
+@node ANSI C
+@section @sc{ansi} C and pre-@sc{ansi} C
+
+Do not ever use the ``trigraph'' feature of @sc{ansi} C.
+
+@sc{ansi} C is widespread enough now that it is ok to write new programs
+that use @sc{ansi} C features (and therefore will not work in
+non-@sc{ansi} compilers). And if a program is already written in
+@sc{ansi} C, there's no need to convert it to support non-@sc{ansi}
+compilers.
+
+However, it is easy to support non-@sc{ansi} compilers in most programs,
+so you might still consider doing so when you write a program. Instead
+of writing function definitions in @sc{ansi} prototype form,
+
+@example
+int
+foo (int x, int y)
+@dots{}
+@end example
+
+@noindent
+write the definition in pre-@sc{ansi} style like this,
+
+@example
+int
+foo (x, y)
+ int x, y;
+@dots{}
+@end example
+
+@noindent
+and use a separate declaration to specify the argument prototype:
+
+@example
+int foo (int, int);
+@end example
+
+You need such a declaration anyway, in a header file, to get the benefit
+of @sc{ansi} C prototypes in all the files where the function is called.
+And once you have it, you lose nothing by writing the function
+definition in the pre-@sc{ansi} style.
+
+If you don't know non-@sc{ansi} C, there's no need to learn it; just
+write in @sc{ansi} C.
+
+@node Source Language
+@section Using Languages Other Than C
+
+Using a language other than C is like using a non-standard feature: it
+will cause trouble for users. Even if GCC supports the other language,
+users may find it inconvenient to have to install the compiler for that
+other language in order to build your program. So please write in C.
+
+There are three exceptions for this rule:
+
+@itemize @bullet
+@item
+It is okay to use a special language if the same program contains an
+interpreter for that language.
+
+For example, if your program links with GUILE, it is ok to write part of
+the program in Scheme or another language supported by GUILE.
+
+@item
+It is okay to use another language in a tool specifically intended for
+use with that language.
+
+This is okay because the only people who want to build the tool will be
+those who have installed the other language anyway.
+
+@item
+If an application is not of extremely widespread interest, then perhaps
+it's not important if the application is inconvenient to install.
+@end itemize
+
+@node Program Behavior
+@chapter Program Behavior for All Programs
+
+This @value{CHAPTER} describes how to write robust software. It also
+describes general standards for error messages, the command line interface,
+and how libraries should behave.
+
+@menu
+* Semantics:: Writing robust programs
+* Libraries:: Library behavior
+* Errors:: Formatting error messages
+* User Interfaces:: Standards for command line interfaces
+* Option Table:: Table of long options.
+* Memory Usage:: When and how to care about memory needs
+@end menu
+
+@node Semantics
+@section Writing Robust Programs
+
+Avoid arbitrary limits on the length or number of @emph{any} data
+structure, including file names, lines, files, and symbols, by allocating
+all data structures dynamically. In most Unix utilities, ``long lines
+are silently truncated''. This is not acceptable in a GNU utility.
+
+Utilities reading files should not drop NUL characters, or any other
+nonprinting characters @emph{including those with codes above 0177}. The
+only sensible exceptions would be utilities specifically intended for
+interface to certain types of printers that can't handle those characters.
+
+Check every system call for an error return, unless you know you wish to
+ignore errors. Include the system error text (from @code{perror} or
+equivalent) in @emph{every} error message resulting from a failing
+system call, as well as the name of the file if any and the name of the
+utility. Just ``cannot open foo.c'' or ``stat failed'' is not
+sufficient.
+
+Check every call to @code{malloc} or @code{realloc} to see if it
+returned zero. Check @code{realloc} even if you are making the block
+smaller; in a system that rounds block sizes to a power of 2,
+@code{realloc} may get a different block if you ask for less space.
+
+In Unix, @code{realloc} can destroy the storage block if it returns
+zero. GNU @code{realloc} does not have this bug: if it fails, the
+original block is unchanged. Feel free to assume the bug is fixed. If
+you wish to run your program on Unix, and wish to avoid lossage in this
+case, you can use the GNU @code{malloc}.
+
+You must expect @code{free} to alter the contents of the block that was
+freed. Anything you want to fetch from the block, you must fetch before
+calling @code{free}.
+
+If @code{malloc} fails in a noninteractive program, make that a fatal
+error. In an interactive program (one that reads commands from the
+user), it is better to abort the command and return to the command
+reader loop. This allows the user to kill other processes to free up
+virtual memory, and then try the command again.
+
+Use @code{getopt_long} to decode arguments, unless the argument syntax
+makes this unreasonable.
+
+When static storage is to be written in during program execution, use
+explicit C code to initialize it. Reserve C initialized declarations
+for data that will not be changed.
+@c ADR: why?
+
+Try to avoid low-level interfaces to obscure Unix data structures (such
+as file directories, utmp, or the layout of kernel memory), since these
+are less likely to work compatibly. If you need to find all the files
+in a directory, use @code{readdir} or some other high-level interface.
+These will be supported compatibly by GNU.
+
+By default, the GNU system will provide the signal handling functions of
+@sc{BSD} and of @sc{POSIX}. So GNU software should be written to use
+these.
+
+In error checks that detect ``impossible'' conditions, just abort.
+There is usually no point in printing any message. These checks
+indicate the existence of bugs. Whoever wants to fix the bugs will have
+to read the source code and run a debugger. So explain the problem with
+comments in the source. The relevant data will be in variables, which
+are easy to examine with the debugger, so there is no point moving them
+elsewhere.
+
+Do not use a count of errors as the exit status for a program.
+@emph{That does not work}, because exit status values are limited to 8
+bits (0 through 255). A single run of the program might have 256
+errors; if you try to return 256 as the exit status, the parent process
+will see 0 as the status, and it will appear that the program succeeded.
+
+If you make temporary files, check the @code{TMPDIR} environment
+variable; if that variable is defined, use the specified directory
+instead of @file{/tmp}.
+
+@node Libraries
+@section Library Behavior
+
+Try to make library functions reentrant. If they need to do dynamic
+storage allocation, at least try to avoid any nonreentrancy aside from
+that of @code{malloc} itself.
+
+Here are certain name conventions for libraries, to avoid name
+conflicts.
+
+Choose a name prefix for the library, more than two characters long.
+All external function and variable names should start with this
+prefix. In addition, there should only be one of these in any given
+library member. This usually means putting each one in a separate
+source file.
+
+An exception can be made when two external symbols are always used
+together, so that no reasonable program could use one without the
+other; then they can both go in the same file.
+
+External symbols that are not documented entry points for the user
+should have names beginning with @samp{_}. They should also contain
+the chosen name prefix for the library, to prevent collisions with
+other libraries. These can go in the same files with user entry
+points if you like.
+
+Static functions and variables can be used as you like and need not
+fit any naming convention.
+
+@node Errors
+@section Formatting Error Messages
+
+Error messages from compilers should look like this:
+
+@example
+@var{source-file-name}:@var{lineno}: @var{message}
+@end example
+
+Error messages from other noninteractive programs should look like this:
+
+@example
+@var{program}:@var{source-file-name}:@var{lineno}: @var{message}
+@end example
+
+@noindent
+when there is an appropriate source file, or like this:
+
+@example
+@var{program}: @var{message}
+@end example
+
+@noindent
+when there is no relevant source file.
+
+In an interactive program (one that is reading commands from a
+terminal), it is better not to include the program name in an error
+message. The place to indicate which program is running is in the
+prompt or with the screen layout. (When the same program runs with
+input from a source other than a terminal, it is not interactive and
+would do best to print error messages using the noninteractive style.)
+
+The string @var{message} should not begin with a capital letter when
+it follows a program name and/or file name. Also, it should not end
+with a period.
+
+Error messages from interactive programs, and other messages such as
+usage messages, should start with a capital letter. But they should not
+end with a period.
+
+@node User Interfaces
+@section Standards for Command Line Interfaces
+
+Please don't make the behavior of a utility depend on the name used
+to invoke it. It is useful sometimes to make a link to a utility
+with a different name, and that should not change what it does.
+
+Instead, use a run time option or a compilation switch or both
+to select among the alternate behaviors.
+
+Likewise, please don't make the behavior of the program depend on the
+type of output device it is used with. Device independence is an
+important principle of the system's design; do not compromise it
+merely to save someone from typing an option now and then.
+
+If you think one behavior is most useful when the output is to a
+terminal, and another is most useful when the output is a file or a
+pipe, then it is usually best to make the default behavior the one that
+is useful with output to a terminal, and have an option for the other
+behavior.
+
+Compatibility requires certain programs to depend on the type of output
+device. It would be disastrous if @code{ls} or @code{sh} did not do so
+in the way all users expect. In some of these cases, we supplement the
+program with a preferred alternate version that does not depend on the
+output device type. For example, we provide a @code{dir} program much
+like @code{ls} except that its default output format is always
+multi-column format.
+
+It is a good idea to follow the @sc{POSIX} guidelines for the
+command-line options of a program. The easiest way to do this is to use
+@code{getopt} to parse them. Note that the GNU version of @code{getopt}
+will normally permit options anywhere among the arguments unless the
+special argument @samp{--} is used. This is not what @sc{POSIX}
+specifies; it is a GNU extension.
+
+Please define long-named options that are equivalent to the
+single-letter Unix-style options. We hope to make GNU more user
+friendly this way. This is easy to do with the GNU function
+@code{getopt_long}.
+
+One of the advantages of long-named options is that they can be
+consistent from program to program. For example, users should be able
+to expect the ``verbose'' option of any GNU program which has one, to be
+spelled precisely @samp{--verbose}. To achieve this uniformity, look at
+the table of common long-option names when you choose the option names
+for your program (@pxref{Option Table}).
+
+It is usually a good idea for file names given as ordinary arguments to
+be input files only; any output files would be specified using options
+(preferably @samp{-o} or @samp{--output}). Even if you allow an output
+file name as an ordinary argument for compatibility, try to provide an
+option as another way to specify it. This will lead to more consistency
+among GNU utilities, and fewer idiosyncracies for users to remember.
+
+All programs should support two standard options: @samp{--version}
+and @samp{--help}.
+
+@table @code
+@item --version
+This option should direct the program to information about its name,
+version, origin and legal status, all on standard output, and then exit
+successfully. Other options and arguments should be ignored once this
+is seen, and the program should not perform its normal function.
+
+The first line is meant to be easy for a program to parse; the version
+number proper starts after the last space. In addition, it contains
+the canonical name for this program, in this format:
+
+@example
+GNU Emacs 19.30
+@end example
+
+@noindent
+The program's name should be a constant string; @emph{don't} compute it
+from @code{argv[0]}. The idea is to state the standard or canonical
+name for the program, not its file name. There are other ways to find
+out the precise file name where a command is found in @code{PATH}.
+
+If the program is a subsidiary part of a larger package, mention the
+package name in parentheses, like this:
+
+@example
+emacsserver (GNU Emacs) 19.30
+@end example
+
+@noindent
+If the package has a version number which is different from this
+program's version number, you can mention the package version number
+just before the close-parenthesis.
+
+If you @strong{need} to mention the version numbers of libraries which
+are distributed separately from the package which contains this program,
+you can do so by printing an additional line of version info for each
+library you want to mention. Use the same format for these lines as for
+the first line.
+
+Please don't mention all the libraries that the program uses ``just for
+completeness''---that would produce a lot of unhelpful clutter. Please
+mention library version numbers only if you find in practice that they
+are very important to you in debugging.
+
+The following line, after the version number line or lines, should be a
+copyright notice. If more than one copyright notice is called for, put
+each on a separate line.
+
+Next should follow a brief statement that the program is free software,
+and that users are free to copy and change it on certain conditions. If
+the program is covered by the GNU GPL, say so here. Also mention that
+there is no warranty, to the extent permitted by law.
+
+It is ok to finish the output with a list of the major authors of the
+program, as a way of giving credit.
+
+Here's an example of output that follows these rules:
+
+@smallexample
+GNU Emacs 19.34.5
+Copyright (C) 1996 Free Software Foundation, Inc.
+GNU Emacs comes with NO WARRANTY, to the extent permitted by law.
+You may redistribute copies of GNU Emacs
+under the terms of the GNU General Public License.
+For more information about these matters, see the files named COPYING.
+@end smallexample
+
+You should adapt this to your program, of course, filling in the proper
+year, copyright holder, name of program, and the references to
+distribution terms, and changing the rest of the wording as necessary.
+
+This copyright notice only needs to mention the most recent year in
+which changes were made---there's no need to list the years for previous
+versions' changes. You don't have to mention the name of the program in
+these notices, if that is inconvenient, since it appeared in the first
+line.
+
+@item --help
+This option should output brief documentation for how to invoke the
+program, on standard output, then exit successfully. Other options and
+arguments should be ignored once this is seen, and the program should
+not perform its normal function.
+
+Near the end of the @samp{--help} option's output there should be a line
+that says where to mail bug reports. It should have this format:
+
+@example
+Report bugs to @var{mailing-address}.
+@end example
+@end table
+
+@node Option Table
+@section Table of Long Options
+
+Here is a table of long options used by GNU programs. It is surely
+incomplete, but we aim to list all the options that a new program might
+want to be compatible with. If you use names not already in the table,
+please send @samp{gnu@@prep.ai.mit.edu} a list of them, with their
+meanings, so we can update the table.
+
+@c Please leave newlines between items in this table; it's much easier
+@c to update when it isn't completely squashed together and unreadable.
+@c When there is more than one short option for a long option name, put
+@c a semicolon between the lists of the programs that use them, not a
+@c period. --friedman
+
+@table @samp
+@item after-date
+@samp{-N} in @code{tar}.
+
+@item all
+@samp{-a} in @code{du}, @code{ls}, @code{nm}, @code{stty}, @code{uname},
+and @code{unexpand}.
+
+@item all-text
+@samp{-a} in @code{diff}.
+
+@item almost-all
+@samp{-A} in @code{ls}.
+
+@item append
+@samp{-a} in @code{etags}, @code{tee}, @code{time};
+@samp{-r} in @code{tar}.
+
+@item archive
+@samp{-a} in @code{cp}.
+
+@item archive-name
+@samp{-n} in @code{shar}.
+
+@item arglength
+@samp{-l} in @code{m4}.
+
+@item ascii
+@samp{-a} in @code{diff}.
+
+@item assign
+@samp{-v} in @code{gawk}.
+
+@item assume-new
+@samp{-W} in Make.
+
+@item assume-old
+@samp{-o} in Make.
+
+@item auto-check
+@samp{-a} in @code{recode}.
+
+@item auto-pager
+@samp{-a} in @code{wdiff}.
+
+@item auto-reference
+@samp{-A} in @code{ptx}.
+
+@item avoid-wraps
+@samp{-n} in @code{wdiff}.
+
+@item backward-search
+@samp{-B} in @code{ctags}.
+
+@item basename
+@samp{-f} in @code{shar}.
+
+@item batch
+Used in GDB.
+
+@item baud
+Used in GDB.
+
+@item before
+@samp{-b} in @code{tac}.
+
+@item binary
+@samp{-b} in @code{cpio} and @code{diff}.
+
+@item bits-per-code
+@samp{-b} in @code{shar}.
+
+@item block-size
+Used in @code{cpio} and @code{tar}.
+
+@item blocks
+@samp{-b} in @code{head} and @code{tail}.
+
+@item break-file
+@samp{-b} in @code{ptx}.
+
+@item brief
+Used in various programs to make output shorter.
+
+@item bytes
+@samp{-c} in @code{head}, @code{split}, and @code{tail}.
+
+@item c@t{++}
+@samp{-C} in @code{etags}.
+
+@item catenate
+@samp{-A} in @code{tar}.
+
+@item cd
+Used in various programs to specify the directory to use.
+
+@item changes
+@samp{-c} in @code{chgrp} and @code{chown}.
+
+@item classify
+@samp{-F} in @code{ls}.
+
+@item colons
+@samp{-c} in @code{recode}.
+
+@item command
+@samp{-c} in @code{su};
+@samp{-x} in GDB.
+
+@item compare
+@samp{-d} in @code{tar}.
+
+@item compat
+Used in @code{gawk}.
+
+@item compress
+@samp{-Z} in @code{tar} and @code{shar}.
+
+@item concatenate
+@samp{-A} in @code{tar}.
+
+@item confirmation
+@samp{-w} in @code{tar}.
+
+@item context
+Used in @code{diff}.
+
+@item copyleft
+@samp{-W copyleft} in @code{gawk}.
+
+@item copyright
+@samp{-C} in @code{ptx}, @code{recode}, and @code{wdiff};
+@samp{-W copyright} in @code{gawk}.
+
+@item core
+Used in GDB.
+
+@item count
+@samp{-q} in @code{who}.
+
+@item count-links
+@samp{-l} in @code{du}.
+
+@item create
+Used in @code{tar} and @code{cpio}.
+
+@item cut-mark
+@samp{-c} in @code{shar}.
+
+@item cxref
+@samp{-x} in @code{ctags}.
+
+@item date
+@samp{-d} in @code{touch}.
+
+@item debug
+@samp{-d} in Make and @code{m4};
+@samp{-t} in Bison.
+
+@item define
+@samp{-D} in @code{m4}.
+
+@item defines
+@samp{-d} in Bison and @code{ctags}.
+
+@item delete
+@samp{-D} in @code{tar}.
+
+@item dereference
+@samp{-L} in @code{chgrp}, @code{chown}, @code{cpio}, @code{du},
+@code{ls}, and @code{tar}.
+
+@item dereference-args
+@samp{-D} in @code{du}.
+
+@item diacritics
+@samp{-d} in @code{recode}.
+
+@item dictionary-order
+@samp{-d} in @code{look}.
+
+@item diff
+@samp{-d} in @code{tar}.
+
+@item digits
+@samp{-n} in @code{csplit}.
+
+@item directory
+Specify the directory to use, in various programs. In @code{ls}, it
+means to show directories themselves rather than their contents. In
+@code{rm} and @code{ln}, it means to not treat links to directories
+specially.
+
+@item discard-all
+@samp{-x} in @code{strip}.
+
+@item discard-locals
+@samp{-X} in @code{strip}.
+
+@item dry-run
+@samp{-n} in Make.
+
+@item ed
+@samp{-e} in @code{diff}.
+
+@item elide-empty-files
+@samp{-z} in @code{csplit}.
+
+@item end-delete
+@samp{-x} in @code{wdiff}.
+
+@item end-insert
+@samp{-z} in @code{wdiff}.
+
+@item entire-new-file
+@samp{-N} in @code{diff}.
+
+@item environment-overrides
+@samp{-e} in Make.
+
+@item eof
+@samp{-e} in @code{xargs}.
+
+@item epoch
+Used in GDB.
+
+@item error-limit
+Used in @code{makeinfo}.
+
+@item error-output
+@samp{-o} in @code{m4}.
+
+@item escape
+@samp{-b} in @code{ls}.
+
+@item exclude-from
+@samp{-X} in @code{tar}.
+
+@item exec
+Used in GDB.
+
+@item exit
+@samp{-x} in @code{xargs}.
+
+@item exit-0
+@samp{-e} in @code{unshar}.
+
+@item expand-tabs
+@samp{-t} in @code{diff}.
+
+@item expression
+@samp{-e} in @code{sed}.
+
+@item extern-only
+@samp{-g} in @code{nm}.
+
+@item extract
+@samp{-i} in @code{cpio};
+@samp{-x} in @code{tar}.
+
+@item faces
+@samp{-f} in @code{finger}.
+
+@item fast
+@samp{-f} in @code{su}.
+
+@item fatal-warnings
+@samp{-E} in @code{m4}.
+
+@item file
+@samp{-f} in @code{info}, @code{gawk}, Make, @code{mt}, and @code{tar};
+@samp{-n} in @code{sed};
+@samp{-r} in @code{touch}.
+
+@item field-separator
+@samp{-F} in @code{gawk}.
+
+@item file-prefix
+@samp{-b} in Bison.
+
+@item file-type
+@samp{-F} in @code{ls}.
+
+@item files-from
+@samp{-T} in @code{tar}.
+
+@item fill-column
+Used in @code{makeinfo}.
+
+@item flag-truncation
+@samp{-F} in @code{ptx}.
+
+@item fixed-output-files
+@samp{-y} in Bison.
+
+@item follow
+@samp{-f} in @code{tail}.
+
+@item footnote-style
+Used in @code{makeinfo}.
+
+@item force
+@samp{-f} in @code{cp}, @code{ln}, @code{mv}, and @code{rm}.
+
+@item force-prefix
+@samp{-F} in @code{shar}.
+
+@item format
+Used in @code{ls}, @code{time}, and @code{ptx}.
+
+@item freeze-state
+@samp{-F} in @code{m4}.
+
+@item fullname
+Used in GDB.
+
+@item gap-size
+@samp{-g} in @code{ptx}.
+
+@item get
+@samp{-x} in @code{tar}.
+
+@item graphic
+@samp{-i} in @code{ul}.
+
+@item graphics
+@samp{-g} in @code{recode}.
+
+@item group
+@samp{-g} in @code{install}.
+
+@item gzip
+@samp{-z} in @code{tar} and @code{shar}.
+
+@item hashsize
+@samp{-H} in @code{m4}.
+
+@item header
+@samp{-h} in @code{objdump} and @code{recode}
+
+@item heading
+@samp{-H} in @code{who}.
+
+@item help
+Used to ask for brief usage information.
+
+@item here-delimiter
+@samp{-d} in @code{shar}.
+
+@item hide-control-chars
+@samp{-q} in @code{ls}.
+
+@item idle
+@samp{-u} in @code{who}.
+
+@item ifdef
+@samp{-D} in @code{diff}.
+
+@item ignore
+@samp{-I} in @code{ls};
+@samp{-x} in @code{recode}.
+
+@item ignore-all-space
+@samp{-w} in @code{diff}.
+
+@item ignore-backups
+@samp{-B} in @code{ls}.
+
+@item ignore-blank-lines
+@samp{-B} in @code{diff}.
+
+@item ignore-case
+@samp{-f} in @code{look} and @code{ptx};
+@samp{-i} in @code{diff} and @code{wdiff}.
+
+@item ignore-errors
+@samp{-i} in Make.
+
+@item ignore-file
+@samp{-i} in @code{ptx}.
+
+@item ignore-indentation
+@samp{-I} in @code{etags}.
+
+@item ignore-init-file
+@samp{-f} in Oleo.
+
+@item ignore-interrupts
+@samp{-i} in @code{tee}.
+
+@item ignore-matching-lines
+@samp{-I} in @code{diff}.
+
+@item ignore-space-change
+@samp{-b} in @code{diff}.
+
+@item ignore-zeros
+@samp{-i} in @code{tar}.
+
+@item include
+@samp{-i} in @code{etags};
+@samp{-I} in @code{m4}.
+
+@item include-dir
+@samp{-I} in Make.
+
+@item incremental
+@samp{-G} in @code{tar}.
+
+@item info
+@samp{-i}, @samp{-l}, and @samp{-m} in Finger.
+
+@item initial
+@samp{-i} in @code{expand}.
+
+@item initial-tab
+@samp{-T} in @code{diff}.
+
+@item inode
+@samp{-i} in @code{ls}.
+
+@item interactive
+@samp{-i} in @code{cp}, @code{ln}, @code{mv}, @code{rm};
+@samp{-e} in @code{m4};
+@samp{-p} in @code{xargs};
+@samp{-w} in @code{tar}.
+
+@item intermix-type
+@samp{-p} in @code{shar}.
+
+@item jobs
+@samp{-j} in Make.
+
+@item just-print
+@samp{-n} in Make.
+
+@item keep-going
+@samp{-k} in Make.
+
+@item keep-files
+@samp{-k} in @code{csplit}.
+
+@item kilobytes
+@samp{-k} in @code{du} and @code{ls}.
+
+@item language
+@samp{-l} in @code{etags}.
+
+@item less-mode
+@samp{-l} in @code{wdiff}.
+
+@item level-for-gzip
+@samp{-g} in @code{shar}.
+
+@item line-bytes
+@samp{-C} in @code{split}.
+
+@item lines
+Used in @code{split}, @code{head}, and @code{tail}.
+
+@item link
+@samp{-l} in @code{cpio}.
+
+@item lint
+@itemx lint-old
+Used in @code{gawk}.
+
+@item list
+@samp{-t} in @code{cpio};
+@samp{-l} in @code{recode}.
+
+@item list
+@samp{-t} in @code{tar}.
+
+@item literal
+@samp{-N} in @code{ls}.
+
+@item load-average
+@samp{-l} in Make.
+
+@item login
+Used in @code{su}.
+
+@item machine
+No listing of which programs already use this;
+someone should check to
+see if any actually do and tell @code{gnu@@prep.ai.mit.edu}.
+
+@item macro-name
+@samp{-M} in @code{ptx}.
+
+@item mail
+@samp{-m} in @code{hello} and @code{uname}.
+
+@item make-directories
+@samp{-d} in @code{cpio}.
+
+@item makefile
+@samp{-f} in Make.
+
+@item mapped
+Used in GDB.
+
+@item max-args
+@samp{-n} in @code{xargs}.
+
+@item max-chars
+@samp{-n} in @code{xargs}.
+
+@item max-lines
+@samp{-l} in @code{xargs}.
+
+@item max-load
+@samp{-l} in Make.
+
+@item max-procs
+@samp{-P} in @code{xargs}.
+
+@item mesg
+@samp{-T} in @code{who}.
+
+@item message
+@samp{-T} in @code{who}.
+
+@item minimal
+@samp{-d} in @code{diff}.
+
+@item mixed-uuencode
+@samp{-M} in @code{shar}.
+
+@item mode
+@samp{-m} in @code{install}, @code{mkdir}, and @code{mkfifo}.
+
+@item modification-time
+@samp{-m} in @code{tar}.
+
+@item multi-volume
+@samp{-M} in @code{tar}.
+
+@item name-prefix
+@samp{-a} in Bison.
+
+@item nesting-limit
+@samp{-L} in @code{m4}.
+
+@item net-headers
+@samp{-a} in @code{shar}.
+
+@item new-file
+@samp{-W} in Make.
+
+@item no-builtin-rules
+@samp{-r} in Make.
+
+@item no-character-count
+@samp{-w} in @code{shar}.
+
+@item no-check-existing
+@samp{-x} in @code{shar}.
+
+@item no-common
+@samp{-3} in @code{wdiff}.
+
+@item no-create
+@samp{-c} in @code{touch}.
+
+@item no-defines
+@samp{-D} in @code{etags}.
+
+@item no-deleted
+@samp{-1} in @code{wdiff}.
+
+@item no-dereference
+@samp{-d} in @code{cp}.
+
+@item no-inserted
+@samp{-2} in @code{wdiff}.
+
+@item no-keep-going
+@samp{-S} in Make.
+
+@item no-lines
+@samp{-l} in Bison.
+
+@item no-piping
+@samp{-P} in @code{shar}.
+
+@item no-prof
+@samp{-e} in @code{gprof}.
+
+@item no-regex
+@samp{-R} in @code{etags}.
+
+@item no-sort
+@samp{-p} in @code{nm}.
+
+@item no-split
+Used in @code{makeinfo}.
+
+@item no-static
+@samp{-a} in @code{gprof}.
+
+@item no-time
+@samp{-E} in @code{gprof}.
+
+@item no-timestamp
+@samp{-m} in @code{shar}.
+
+@item no-validate
+Used in @code{makeinfo}.
+
+@item no-wait
+Used in @code{emacsclient}.
+
+@item no-warn
+Used in various programs to inhibit warnings.
+
+@item node
+@samp{-n} in @code{info}.
+
+@item nodename
+@samp{-n} in @code{uname}.
+
+@item nonmatching
+@samp{-f} in @code{cpio}.
+
+@item nstuff
+@samp{-n} in @code{objdump}.
+
+@item null
+@samp{-0} in @code{xargs}.
+
+@item number
+@samp{-n} in @code{cat}.
+
+@item number-nonblank
+@samp{-b} in @code{cat}.
+
+@item numeric-sort
+@samp{-n} in @code{nm}.
+
+@item numeric-uid-gid
+@samp{-n} in @code{cpio} and @code{ls}.
+
+@item nx
+Used in GDB.
+
+@item old-archive
+@samp{-o} in @code{tar}.
+
+@item old-file
+@samp{-o} in Make.
+
+@item one-file-system
+@samp{-l} in @code{tar}, @code{cp}, and @code{du}.
+
+@item only-file
+@samp{-o} in @code{ptx}.
+
+@item only-prof
+@samp{-f} in @code{gprof}.
+
+@item only-time
+@samp{-F} in @code{gprof}.
+
+@item output
+In various programs, specify the output file name.
+
+@item output-prefix
+@samp{-o} in @code{shar}.
+
+@item override
+@samp{-o} in @code{rm}.
+
+@item overwrite
+@samp{-c} in @code{unshar}.
+
+@item owner
+@samp{-o} in @code{install}.
+
+@item paginate
+@samp{-l} in @code{diff}.
+
+@item paragraph-indent
+Used in @code{makeinfo}.
+
+@item parents
+@samp{-p} in @code{mkdir} and @code{rmdir}.
+
+@item pass-all
+@samp{-p} in @code{ul}.
+
+@item pass-through
+@samp{-p} in @code{cpio}.
+
+@item port
+@samp{-P} in @code{finger}.
+
+@item portability
+@samp{-c} in @code{cpio} and @code{tar}.
+
+@item posix
+Used in @code{gawk}.
+
+@item prefix-builtins
+@samp{-P} in @code{m4}.
+
+@item prefix
+@samp{-f} in @code{csplit}.
+
+@item preserve
+Used in @code{tar} and @code{cp}.
+
+@item preserve-environment
+@samp{-p} in @code{su}.
+
+@item preserve-modification-time
+@samp{-m} in @code{cpio}.
+
+@item preserve-order
+@samp{-s} in @code{tar}.
+
+@item preserve-permissions
+@samp{-p} in @code{tar}.
+
+@item print
+@samp{-l} in @code{diff}.
+
+@item print-chars
+@samp{-L} in @code{cmp}.
+
+@item print-data-base
+@samp{-p} in Make.
+
+@item print-directory
+@samp{-w} in Make.
+
+@item print-file-name
+@samp{-o} in @code{nm}.
+
+@item print-symdefs
+@samp{-s} in @code{nm}.
+
+@item printer
+@samp{-p} in @code{wdiff}.
+
+@item prompt
+@samp{-p} in @code{ed}.
+
+@item query-user
+@samp{-X} in @code{shar}.
+
+@item question
+@samp{-q} in Make.
+
+@item quiet
+Used in many programs to inhibit the usual output. @strong{Note:} every
+program accepting @samp{--quiet} should accept @samp{--silent} as a
+synonym.
+
+@item quiet-unshar
+@samp{-Q} in @code{shar}
+
+@item quote-name
+@samp{-Q} in @code{ls}.
+
+@item rcs
+@samp{-n} in @code{diff}.
+
+@item re-interval
+Used in @code{gawk}.
+
+@item read-full-blocks
+@samp{-B} in @code{tar}.
+
+@item readnow
+Used in GDB.
+
+@item recon
+@samp{-n} in Make.
+
+@item record-number
+@samp{-R} in @code{tar}.
+
+@item recursive
+Used in @code{chgrp}, @code{chown}, @code{cp}, @code{ls}, @code{diff},
+and @code{rm}.
+
+@item reference-limit
+Used in @code{makeinfo}.
+
+@item references
+@samp{-r} in @code{ptx}.
+
+@item regex
+@samp{-r} in @code{tac} and @code{etags}.
+
+@item release
+@samp{-r} in @code{uname}.
+
+@item reload-state
+@samp{-R} in @code{m4}.
+
+@item relocation
+@samp{-r} in @code{objdump}.
+
+@item rename
+@samp{-r} in @code{cpio}.
+
+@item replace
+@samp{-i} in @code{xargs}.
+
+@item report-identical-files
+@samp{-s} in @code{diff}.
+
+@item reset-access-time
+@samp{-a} in @code{cpio}.
+
+@item reverse
+@samp{-r} in @code{ls} and @code{nm}.
+
+@item reversed-ed
+@samp{-f} in @code{diff}.
+
+@item right-side-defs
+@samp{-R} in @code{ptx}.
+
+@item same-order
+@samp{-s} in @code{tar}.
+
+@item same-permissions
+@samp{-p} in @code{tar}.
+
+@item save
+@samp{-g} in @code{stty}.
+
+@item se
+Used in GDB.
+
+@item sentence-regexp
+@samp{-S} in @code{ptx}.
+
+@item separate-dirs
+@samp{-S} in @code{du}.
+
+@item separator
+@samp{-s} in @code{tac}.
+
+@item sequence
+Used by @code{recode} to chose files or pipes for sequencing passes.
+
+@item shell
+@samp{-s} in @code{su}.
+
+@item show-all
+@samp{-A} in @code{cat}.
+
+@item show-c-function
+@samp{-p} in @code{diff}.
+
+@item show-ends
+@samp{-E} in @code{cat}.
+
+@item show-function-line
+@samp{-F} in @code{diff}.
+
+@item show-tabs
+@samp{-T} in @code{cat}.
+
+@item silent
+Used in many programs to inhibit the usual output.
+@strong{Note:} every program accepting
+@samp{--silent} should accept @samp{--quiet} as a synonym.
+
+@item size
+@samp{-s} in @code{ls}.
+
+@item sort
+Used in @code{ls}.
+
+@item source
+@samp{-W source} in @code{gawk}.
+
+@item sparse
+@samp{-S} in @code{tar}.
+
+@item speed-large-files
+@samp{-H} in @code{diff}.
+
+@item split-at
+@samp{-E} in @code{unshar}.
+
+@item split-size-limit
+@samp{-L} in @code{shar}.
+
+@item squeeze-blank
+@samp{-s} in @code{cat}.
+
+@item start-delete
+@samp{-w} in @code{wdiff}.
+
+@item start-insert
+@samp{-y} in @code{wdiff}.
+
+@item starting-file
+Used in @code{tar} and @code{diff} to specify which file within
+a directory to start processing with.
+
+@item statistics
+@samp{-s} in @code{wdiff}.
+
+@item stdin-file-list
+@samp{-S} in @code{shar}.
+
+@item stop
+@samp{-S} in Make.
+
+@item strict
+@samp{-s} in @code{recode}.
+
+@item strip
+@samp{-s} in @code{install}.
+
+@item strip-all
+@samp{-s} in @code{strip}.
+
+@item strip-debug
+@samp{-S} in @code{strip}.
+
+@item submitter
+@samp{-s} in @code{shar}.
+
+@item suffix
+@samp{-S} in @code{cp}, @code{ln}, @code{mv}.
+
+@item suffix-format
+@samp{-b} in @code{csplit}.
+
+@item sum
+@samp{-s} in @code{gprof}.
+
+@item summarize
+@samp{-s} in @code{du}.
+
+@item symbolic
+@samp{-s} in @code{ln}.
+
+@item symbols
+Used in GDB and @code{objdump}.
+
+@item synclines
+@samp{-s} in @code{m4}.
+
+@item sysname
+@samp{-s} in @code{uname}.
+
+@item tabs
+@samp{-t} in @code{expand} and @code{unexpand}.
+
+@item tabsize
+@samp{-T} in @code{ls}.
+
+@item terminal
+@samp{-T} in @code{tput} and @code{ul}.
+@samp{-t} in @code{wdiff}.
+
+@item text
+@samp{-a} in @code{diff}.
+
+@item text-files
+@samp{-T} in @code{shar}.
+
+@item time
+Used in @code{ls} and @code{touch}.
+
+@item to-stdout
+@samp{-O} in @code{tar}.
+
+@item total
+@samp{-c} in @code{du}.
+
+@item touch
+@samp{-t} in Make, @code{ranlib}, and @code{recode}.
+
+@item trace
+@samp{-t} in @code{m4}.
+
+@item traditional
+@samp{-t} in @code{hello};
+@samp{-W traditional} in @code{gawk};
+@samp{-G} in @code{ed}, @code{m4}, and @code{ptx}.
+
+@item tty
+Used in GDB.
+
+@item typedefs
+@samp{-t} in @code{ctags}.
+
+@item typedefs-and-c++
+@samp{-T} in @code{ctags}.
+
+@item typeset-mode
+@samp{-t} in @code{ptx}.
+
+@item uncompress
+@samp{-z} in @code{tar}.
+
+@item unconditional
+@samp{-u} in @code{cpio}.
+
+@item undefine
+@samp{-U} in @code{m4}.
+
+@item undefined-only
+@samp{-u} in @code{nm}.
+
+@item update
+@samp{-u} in @code{cp}, @code{ctags}, @code{mv}, @code{tar}.
+
+@item usage
+Used in @code{gawk}; same as @samp{--help}.
+
+@item uuencode
+@samp{-B} in @code{shar}.
+
+@item vanilla-operation
+@samp{-V} in @code{shar}.
+
+@item verbose
+Print more information about progress. Many programs support this.
+
+@item verify
+@samp{-W} in @code{tar}.
+
+@item version
+Print the version number.
+
+@item version-control
+@samp{-V} in @code{cp}, @code{ln}, @code{mv}.
+
+@item vgrind
+@samp{-v} in @code{ctags}.
+
+@item volume
+@samp{-V} in @code{tar}.
+
+@item what-if
+@samp{-W} in Make.
+
+@item whole-size-limit
+@samp{-l} in @code{shar}.
+
+@item width
+@samp{-w} in @code{ls} and @code{ptx}.
+
+@item word-regexp
+@samp{-W} in @code{ptx}.
+
+@item writable
+@samp{-T} in @code{who}.
+
+@item zeros
+@samp{-z} in @code{gprof}.
+@end table
+
+@node Memory Usage
+@section Memory Usage
+
+If it typically uses just a few meg of memory, don't bother making any
+effort to reduce memory usage. For example, if it is impractical for
+other reasons to operate on files more than a few meg long, it is
+reasonable to read entire input files into core to operate on them.
+
+However, for programs such as @code{cat} or @code{tail}, that can
+usefully operate on very large files, it is important to avoid using a
+technique that would artificially limit the size of files it can handle.
+If a program works by lines and could be applied to arbitrary
+user-supplied input files, it should keep only a line in memory, because
+this is not very hard and users will want to be able to operate on input
+files that are bigger than will fit in core all at once.
+
+If your program creates complicated data structures, just make them in
+core and give a fatal error if @code{malloc} returns zero.
+
+@node Writing C
+@chapter Making The Best Use of C
+
+This @value{CHAPTER} provides advice on how best to use the C language
+when writing GNU software.
+
+@menu
+* Formatting:: Formatting Your Source Code
+* Comments:: Commenting Your Work
+* Syntactic Conventions:: Clean Use of C Constructs
+* Names:: Naming Variables and Functions
+* System Portability:: Portability between different operating systems
+* CPU Portability:: Supporting the range of CPU types
+* System Functions:: Portability and ``standard'' library functions
+* Internationalization:: Techniques for internationalization
+* Mmap:: How you can safely use @code{mmap}.
+@end menu
+
+@node Formatting
+@section Formatting Your Source Code
+
+It is important to put the open-brace that starts the body of a C
+function in column zero, and avoid putting any other open-brace or
+open-parenthesis or open-bracket in column zero. Several tools look
+for open-braces in column zero to find the beginnings of C functions.
+These tools will not work on code not formatted that way.
+
+It is also important for function definitions to start the name of the
+function in column zero. This helps people to search for function
+definitions, and may also help certain tools recognize them. Thus,
+the proper format is this:
+
+@example
+static char *
+concat (s1, s2) /* Name starts in column zero here */
+ char *s1, *s2;
+@{ /* Open brace in column zero here */
+ @dots{}
+@}
+@end example
+
+@noindent
+or, if you want to use @sc{ansi} C, format the definition like this:
+
+@example
+static char *
+concat (char *s1, char *s2)
+@{
+ @dots{}
+@}
+@end example
+
+In @sc{ansi} C, if the arguments don't fit nicely on one line,
+split it like this:
+
+@example
+int
+lots_of_args (int an_integer, long a_long, short a_short,
+ double a_double, float a_float)
+@dots{}
+@end example
+
+For the body of the function, we prefer code formatted like this:
+
+@example
+if (x < foo (y, z))
+ haha = bar[4] + 5;
+else
+ @{
+ while (z)
+ @{
+ haha += foo (z, z);
+ z--;
+ @}
+ return ++x + bar ();
+ @}
+@end example
+
+We find it easier to read a program when it has spaces before the
+open-parentheses and after the commas. Especially after the commas.
+
+When you split an expression into multiple lines, split it
+before an operator, not after one. Here is the right way:
+
+@example
+if (foo_this_is_long && bar > win (x, y, z)
+ && remaining_condition)
+@end example
+
+Try to avoid having two operators of different precedence at the same
+level of indentation. For example, don't write this:
+
+@example
+mode = (inmode[j] == VOIDmode
+ || GET_MODE_SIZE (outmode[j]) > GET_MODE_SIZE (inmode[j])
+ ? outmode[j] : inmode[j]);
+@end example
+
+Instead, use extra parentheses so that the indentation shows the nesting:
+
+@example
+mode = ((inmode[j] == VOIDmode
+ || (GET_MODE_SIZE (outmode[j]) > GET_MODE_SIZE (inmode[j])))
+ ? outmode[j] : inmode[j]);
+@end example
+
+Insert extra parentheses so that Emacs will indent the code properly.
+For example, the following indentation looks nice if you do it by hand,
+but Emacs would mess it up:
+
+@example
+v = rup->ru_utime.tv_sec*1000 + rup->ru_utime.tv_usec/1000
+ + rup->ru_stime.tv_sec*1000 + rup->ru_stime.tv_usec/1000;
+@end example
+
+But adding a set of parentheses solves the problem:
+
+@example
+v = (rup->ru_utime.tv_sec*1000 + rup->ru_utime.tv_usec/1000
+ + rup->ru_stime.tv_sec*1000 + rup->ru_stime.tv_usec/1000);
+@end example
+
+Format do-while statements like this:
+
+@example
+do
+ @{
+ a = foo (a);
+ @}
+while (a > 0);
+@end example
+
+Please use formfeed characters (control-L) to divide the program into
+pages at logical places (but not within a function). It does not matter
+just how long the pages are, since they do not have to fit on a printed
+page. The formfeeds should appear alone on lines by themselves.
+
+
+@node Comments
+@section Commenting Your Work
+
+Every program should start with a comment saying briefly what it is for.
+Example: @samp{fmt - filter for simple filling of text}.
+
+Please write the comments in a GNU program in English, because English
+is the one language that nearly all programmers in all countries can
+read. If you do not write English well, please write comments in
+English as well as you can, then ask other people to help rewrite them.
+If you can't write comments in English, please find someone to work with
+you and translate your comments into English.
+
+Please put a comment on each function saying what the function does,
+what sorts of arguments it gets, and what the possible values of
+arguments mean and are used for. It is not necessary to duplicate in
+words the meaning of the C argument declarations, if a C type is being
+used in its customary fashion. If there is anything nonstandard about
+its use (such as an argument of type @code{char *} which is really the
+address of the second character of a string, not the first), or any
+possible values that would not work the way one would expect (such as,
+that strings containing newlines are not guaranteed to work), be sure
+to say so.
+
+Also explain the significance of the return value, if there is one.
+
+Please put two spaces after the end of a sentence in your comments, so
+that the Emacs sentence commands will work. Also, please write
+complete sentences and capitalize the first word. If a lower-case
+identifier comes at the beginning of a sentence, don't capitalize it!
+Changing the spelling makes it a different identifier. If you don't
+like starting a sentence with a lower case letter, write the sentence
+differently (e.g., ``The identifier lower-case is @dots{}'').
+
+The comment on a function is much clearer if you use the argument
+names to speak about the argument values. The variable name itself
+should be lower case, but write it in upper case when you are speaking
+about the value rather than the variable itself. Thus, ``the inode
+number NODE_NUM'' rather than ``an inode''.
+
+There is usually no purpose in restating the name of the function in
+the comment before it, because the reader can see that for himself.
+There might be an exception when the comment is so long that the function
+itself would be off the bottom of the screen.
+
+There should be a comment on each static variable as well, like this:
+
+@example
+/* Nonzero means truncate lines in the display;
+ zero means continue them. */
+int truncate_lines;
+@end example
+
+Every @samp{#endif} should have a comment, except in the case of short
+conditionals (just a few lines) that are not nested. The comment should
+state the condition of the conditional that is ending, @emph{including
+its sense}. @samp{#else} should have a comment describing the condition
+@emph{and sense} of the code that follows. For example:
+
+@example
+@group
+#ifdef foo
+ @dots{}
+#else /* not foo */
+ @dots{}
+#endif /* not foo */
+@end group
+@end example
+
+@noindent
+but, by contrast, write the comments this way for a @samp{#ifndef}:
+
+@example
+@group
+#ifndef foo
+ @dots{}
+#else /* foo */
+ @dots{}
+#endif /* foo */
+@end group
+@end example
+
+
+@node Syntactic Conventions
+@section Clean Use of C Constructs
+
+Please explicitly declare all arguments to functions.
+Don't omit them just because they are @code{int}s.
+
+Declarations of external functions and functions to appear later in the
+source file should all go in one place near the beginning of the file
+(somewhere before the first function definition in the file), or else
+should go in a header file. Don't put @code{extern} declarations inside
+functions.
+
+It used to be common practice to use the same local variables (with
+names like @code{tem}) over and over for different values within one
+function. Instead of doing this, it is better declare a separate local
+variable for each distinct purpose, and give it a name which is
+meaningful. This not only makes programs easier to understand, it also
+facilitates optimization by good compilers. You can also move the
+declaration of each local variable into the smallest scope that includes
+all its uses. This makes the program even cleaner.
+
+Don't use local variables or parameters that shadow global identifiers.
+
+Don't declare multiple variables in one declaration that spans lines.
+Start a new declaration on each line, instead. For example, instead
+of this:
+
+@example
+@group
+int foo,
+ bar;
+@end group
+@end example
+
+@noindent
+write either this:
+
+@example
+int foo, bar;
+@end example
+
+@noindent
+or this:
+
+@example
+int foo;
+int bar;
+@end example
+
+@noindent
+(If they are global variables, each should have a comment preceding it
+anyway.)
+
+When you have an @code{if}-@code{else} statement nested in another
+@code{if} statement, always put braces around the @code{if}-@code{else}.
+Thus, never write like this:
+
+@example
+if (foo)
+ if (bar)
+ win ();
+ else
+ lose ();
+@end example
+
+@noindent
+always like this:
+
+@example
+if (foo)
+ @{
+ if (bar)
+ win ();
+ else
+ lose ();
+ @}
+@end example
+
+If you have an @code{if} statement nested inside of an @code{else}
+statement, either write @code{else if} on one line, like this,
+
+@example
+if (foo)
+ @dots{}
+else if (bar)
+ @dots{}
+@end example
+
+@noindent
+with its @code{then}-part indented like the preceding @code{then}-part,
+or write the nested @code{if} within braces like this:
+
+@example
+if (foo)
+ @dots{}
+else
+ @{
+ if (bar)
+ @dots{}
+ @}
+@end example
+
+Don't declare both a structure tag and variables or typedefs in the
+same declaration. Instead, declare the structure tag separately
+and then use it to declare the variables or typedefs.
+
+Try to avoid assignments inside @code{if}-conditions. For example,
+don't write this:
+
+@example
+if ((foo = (char *) malloc (sizeof *foo)) == 0)
+ fatal ("virtual memory exhausted");
+@end example
+
+@noindent
+instead, write this:
+
+@example
+foo = (char *) malloc (sizeof *foo);
+if (foo == 0)
+ fatal ("virtual memory exhausted");
+@end example
+
+Don't make the program ugly to placate @code{lint}. Please don't insert any
+casts to @code{void}. Zero without a cast is perfectly fine as a null
+pointer constant, except when calling a varargs function.
+
+@node Names
+@section Naming Variables and Functions
+
+The names of global variables and functions in a program serve as
+comments of a sort. So don't choose terse names---instead, look for
+names that give useful information about the meaning of the variable or
+function. In a GNU program, names should be English, like other
+comments.
+
+Local variable names can be shorter, because they are used only within
+one context, where (presumably) comments explain their purpose.
+
+Please use underscores to separate words in a name, so that the Emacs
+word commands can be useful within them. Stick to lower case; reserve
+upper case for macros and @code{enum} constants, and for name-prefixes
+that follow a uniform convention.
+
+For example, you should use names like @code{ignore_space_change_flag};
+don't use names like @code{iCantReadThis}.
+
+Variables that indicate whether command-line options have been
+specified should be named after the meaning of the option, not after
+the option-letter. A comment should state both the exact meaning of
+the option and its letter. For example,
+
+@example
+@group
+/* Ignore changes in horizontal whitespace (-b). */
+int ignore_space_change_flag;
+@end group
+@end example
+
+When you want to define names with constant integer values, use
+@code{enum} rather than @samp{#define}. GDB knows about enumeration
+constants.
+
+Use file names of 14 characters or less, to avoid creating gratuitous
+problems on older System V systems. You can use the program
+@code{doschk} to test for this. @code{doschk} also tests for potential
+name conflicts if the files were loaded onto an MS-DOS file
+system---something you may or may not care about.
+
+@node System Portability
+@section Portability between System Types
+
+In the Unix world, ``portability'' refers to porting to different Unix
+versions. For a GNU program, this kind of portability is desirable, but
+not paramount.
+
+The primary purpose of GNU software is to run on top of the GNU kernel,
+compiled with the GNU C compiler, on various types of @sc{cpu}. The
+amount and kinds of variation among GNU systems on different @sc{cpu}s
+will be comparable to the variation among Linux-based GNU systems or
+among BSD systems today. So the kinds of portability that are absolutely
+necessary are quite limited.
+
+But many users do run GNU software on non-GNU Unix or Unix-like systems.
+So supporting a variety of Unix-like systems is desirable, although not
+paramount.
+
+The easiest way to achieve portability to most Unix-like systems is to
+use Autoconf. It's unlikely that your program needs to know more
+information about the host platform than Autoconf can provide, simply
+because most of the programs that need such knowledge have already been
+written.
+
+Avoid using the format of semi-internal data bases (e.g., directories)
+when there is a higher-level alternative (@code{readdir}).
+
+As for systems that are not like Unix, such as MSDOS, Windows, the
+Macintosh, VMS, and MVS, supporting them is usually so much work that it
+is better if you don't.
+
+The planned GNU kernel is not finished yet, but you can tell which
+facilities it will provide by looking at the GNU C Library Manual. The
+GNU kernel is based on Mach, so the features of Mach will also be
+available. However, if you use Mach features, you'll probably have
+trouble debugging your program today.
+
+@node CPU Portability
+@section Portability between @sc{cpu}s
+
+Even GNU systems will differ because of differences among @sc{cpu}
+types---for example, difference in byte ordering and alignment
+requirements. It is absolutely essential to handle these differences.
+However, don't make any effort to cater to the possibility that an
+@code{int} will be less than 32 bits. We don't support 16-bit machines
+in GNU.
+
+Don't assume that the address of an @code{int} object is also the
+address of its least-significant byte. This is false on big-endian
+machines. Thus, don't make the following mistake:
+
+@example
+int c;
+@dots{}
+while ((c = getchar()) != EOF)
+ write(file_descriptor, &c, 1);
+@end example
+
+When calling functions, you need not worry about the difference between
+pointers of various types, or between pointers and integers. On most
+machines, there's no difference anyway. As for the few machines where
+there is a difference, all of them support @sc{ansi} C, so you can use
+prototypes (conditionalized to be active only in @sc{ansi} C) to make
+the code work on those systems.
+
+In certain cases, it is ok to pass integer and pointer arguments
+indiscriminately to the same function, and use no prototype on any
+system. For example, many GNU programs have error-reporting functions
+that pass their arguments along to @code{printf} and friends:
+
+@example
+error (s, a1, a2, a3)
+ char *s;
+ int a1, a2, a3;
+@{
+ fprintf (stderr, "error: ");
+ fprintf (stderr, s, a1, a2, a3);
+@}
+@end example
+
+@noindent
+In practice, this works on all machines, and it is much simpler than any
+``correct'' alternative. Be sure @emph{not} to use a prototype
+for such functions.
+
+However, avoid casting pointers to integers unless you really need to.
+These assumptions really reduce portability, and in most programs they
+are easy to avoid. In the cases where casting pointers to integers is
+essential---such as, a Lisp interpreter which stores type information as
+well as an address in one word---it is ok to do so, but you'll have to
+make explicit provisions to handle different word sizes.
+
+@node System Functions
+@section Calling System Functions
+
+C implementations differ substantially. @sc{ansi} C reduces but does not
+eliminate the incompatibilities; meanwhile, many users wish to compile
+GNU software with pre-@sc{ansi} compilers. This chapter gives
+recommendations for how to use the more or less standard C library
+functions to avoid unnecessary loss of portability.
+
+@itemize @bullet
+@item
+Don't use the value of @code{sprintf}. It returns the number of
+characters written on some systems, but not on all systems.
+
+@item
+@code{main} should be declared to return type @code{int}. It should
+terminate either by calling @code{exit} or by returning the integer
+status code; make sure it cannot ever return an undefined value.
+
+@item
+Don't declare system functions explicitly.
+
+Almost any declaration for a system function is wrong on some system.
+To minimize conflicts, leave it to the system header files to declare
+system functions. If the headers don't declare a function, let it
+remain undeclared.
+
+While it may seem unclean to use a function without declaring it, in
+practice this works fine for most system library functions on the
+systems where this really happens; thus, the disadvantage is only
+theoretical. By contrast, actual declarations have frequently caused
+actual conflicts.
+
+@item
+If you must declare a system function, don't specify the argument types.
+Use an old-style declaration, not an @sc{ansi} prototype. The more you
+specify about the function, the more likely a conflict.
+
+@item
+In particular, don't unconditionally declare @code{malloc} or
+@code{realloc}.
+
+Most GNU programs use those functions just once, in functions
+conventionally named @code{xmalloc} and @code{xrealloc}. These
+functions call @code{malloc} and @code{realloc}, respectively, and
+check the results.
+
+Because @code{xmalloc} and @code{xrealloc} are defined in your program,
+you can declare them in other files without any risk of type conflict.
+
+On most systems, @code{int} is the same length as a pointer; thus, the
+calls to @code{malloc} and @code{realloc} work fine. For the few
+exceptional systems (mostly 64-bit machines), you can use
+@strong{conditionalized} declarations of @code{malloc} and
+@code{realloc}---or put these declarations in configuration files
+specific to those systems.
+
+@item
+The string functions require special treatment. Some Unix systems have
+a header file @file{string.h}; others have @file{strings.h}. Neither
+file name is portable. There are two things you can do: use Autoconf to
+figure out which file to include, or don't include either file.
+
+@item
+If you don't include either strings file, you can't get declarations for
+the string functions from the header file in the usual way.
+
+That causes less of a problem than you might think. The newer @sc{ansi}
+string functions should be avoided anyway because many systems still
+don't support them. The string functions you can use are these:
+
+@example
+strcpy strncpy strcat strncat
+strlen strcmp strncmp
+strchr strrchr
+@end example
+
+The copy and concatenate functions work fine without a declaration as
+long as you don't use their values. Using their values without a
+declaration fails on systems where the width of a pointer differs from
+the width of @code{int}, and perhaps in other cases. It is trivial to
+avoid using their values, so do that.
+
+The compare functions and @code{strlen} work fine without a declaration
+on most systems, possibly all the ones that GNU software runs on.
+You may find it necessary to declare them @strong{conditionally} on a
+few systems.
+
+The search functions must be declared to return @code{char *}. Luckily,
+there is no variation in the data type they return. But there is
+variation in their names. Some systems give these functions the names
+@code{index} and @code{rindex}; other systems use the names
+@code{strchr} and @code{strrchr}. Some systems support both pairs of
+names, but neither pair works on all systems.
+
+You should pick a single pair of names and use it throughout your
+program. (Nowadays, it is better to choose @code{strchr} and
+@code{strrchr} for new programs, since those are the standard @sc{ansi}
+names.) Declare both of those names as functions returning @code{char
+*}. On systems which don't support those names, define them as macros
+in terms of the other pair. For example, here is what to put at the
+beginning of your file (or in a header) if you want to use the names
+@code{strchr} and @code{strrchr} throughout:
+
+@example
+#ifndef HAVE_STRCHR
+#define strchr index
+#endif
+#ifndef HAVE_STRRCHR
+#define strrchr rindex
+#endif
+
+char *strchr ();
+char *strrchr ();
+@end example
+@end itemize
+
+Here we assume that @code{HAVE_STRCHR} and @code{HAVE_STRRCHR} are
+macros defined in systems where the corresponding functions exist.
+One way to get them properly defined is to use Autoconf.
+
+@node Internationalization
+@section Internationalization
+
+GNU has a library called GNU gettext that makes it easy to translate the
+messages in a program into various languages. You should use this
+library in every program. Use English for the messages as they appear
+in the program, and let gettext provide the way to translate them into
+other languages.
+
+Using GNU gettext involves putting a call to the @code{gettext} macro
+around each string that might need translation---like this:
+
+@example
+printf (gettext ("Processing file `%s'..."));
+@end example
+
+@noindent
+This permits GNU gettext to replace the string @code{"Processing file
+`%s'..."} with a translated version.
+
+Once a program uses gettext, please make a point of writing calls to
+@code{gettext} when you add new strings that call for translation.
+
+Using GNU gettext in a package involves specifying a @dfn{text domain
+name} for the package. The text domain name is used to separate the
+translations for this package from the translations for other packages.
+Normally, the text domain name should be the same as the name of the
+package---for example, @samp{fileutils} for the GNU file utilities.
+
+To enable gettext to work well, avoid writing code that makes
+assumptions about the structure of words or sentences. When you want
+the precise text of a sentence to vary depending on the data, use two or
+more alternative string constants each containing a complete sentences,
+rather than inserting conditionalized words or phrases into a single
+sentence framework.
+
+Here is an example of what not to do:
+
+@example
+printf ("%d file%s processed", nfiles,
+ nfiles != 1 ? "s" : "");
+@end example
+
+@noindent
+The problem with that example is that it assumes that plurals are made
+by adding `s'. If you apply gettext to the format string, like this,
+
+@example
+printf (gettext ("%d file%s processed"), nfiles,
+ nfiles != 1 ? "s" : "");
+@end example
+
+@noindent
+the message can use different words, but it will still be forced to use
+`s' for the plural. Here is a better way:
+
+@example
+printf ((nfiles != 1 ? "%d files processed"
+ : "%d file processed"),
+ nfiles);
+@end example
+
+@noindent
+This way, you can apply gettext to each of the two strings
+independently:
+
+@example
+printf ((nfiles != 1 ? gettext ("%d files processed")
+ : gettext ("%d file processed")),
+ nfiles);
+@end example
+
+@noindent
+This can any method of forming the plural of the word for ``file'', and
+also handles languages that require agreement in the word for
+``processed''.
+
+A similar problem appears at the level of sentence structure with this
+code:
+
+@example
+printf ("# Implicit rule search has%s been done.\n",
+ f->tried_implicit ? "" : " not");
+@end example
+
+@noindent
+Adding @code{gettext} calls to this code cannot give correct results for
+all languages, because negation in some languages requires adding words
+at more than one place in the sentence. By contrast, adding
+@code{gettext} calls does the job straightfowardly if the code starts
+out like this:
+
+@example
+printf (f->tried_implicit
+ ? "# Implicit rule search has been done.\n",
+ : "# Implicit rule search has not been done.\n");
+@end example
+
+@node Mmap
+@section Mmap
+
+Don't assume that @code{mmap} either works on all files or fails
+for all files. It may work on some files and fail on others.
+
+The proper way to use @code{mmap} is to try it on the specific file for
+which you want to use it---and if @code{mmap} doesn't work, fall back on
+doing the job in another way using @code{read} and @code{write}.
+
+The reason this precaution is needed is that the GNU kernel (the HURD)
+provides a user-extensible file system, in which there can be many
+different kinds of ``ordinary files.'' Many of them support
+@code{mmap}, but some do not. It is important to make programs handle
+all these kinds of files.
+
+@node Documentation
+@chapter Documenting Programs
+
+@menu
+* GNU Manuals:: Writing proper manuals.
+* Manual Structure Details:: Specific structure conventions.
+* NEWS File:: NEWS files supplement manuals.
+* Change Logs:: Recording Changes
+* Man Pages:: Man pages are secondary.
+* Reading other Manuals:: How far you can go in learning
+ from other manuals.
+@end menu
+
+@node GNU Manuals
+@section GNU Manuals
+
+The preferred way to document part of the GNU system is to write a
+manual in the Texinfo formatting language. See the Texinfo manual,
+either the hardcopy, or the on-line version available through
+@code{info} or the Emacs Info subsystem (@kbd{C-h i}).
+
+Programmers often find it most natural to structure the documentation
+following the structure of the implementation, which they know. But
+this structure is not necessarily good for explaining how to use the
+program; it may be irrelevant and confusing for a user.
+
+At every level, from the sentences in a paragraph to the grouping of
+topics into separate manuals, the right way to structure documentation
+is according to the concepts and questions that a user will have in mind
+when reading it. Sometimes this structure of ideas matches the
+structure of the implementation of the software being documented---but
+often they are different. Often the most important part of learning to
+write good documentation is learning to notice when you are structuring
+the documentation like the implementation, and think about better
+alternatives.
+
+For example, each program in the GNU system probably ought to be
+documented in one manual; but this does not mean each program should
+have its own manual. That would be following the structure of the
+implementation, rather than the structure that helps the user
+understand.
+
+Instead, each manual should cover a coherent @emph{topic}. For example,
+instead of a manual for @code{diff} and a manual for @code{diff3}, we
+have one manual for ``comparison of files'' which covers both of those
+programs, as well as @code{cmp}. By documenting these programs
+together, we can make the whole subject clearer.
+
+The manual which discusses a program should document all of the
+program's command-line options and all of its commands. It should give
+examples of their use. But don't organize the manual as a list of
+features. Instead, organize it logically, by subtopics. Address the
+questions that a user will ask when thinking about the job that the
+program does.
+
+In general, a GNU manual should serve both as tutorial and reference.
+It should be set up for convenient access to each topic through Info,
+and for reading straight through (appendixes aside). A GNU manual
+should give a good introduction to a beginner reading through from the
+start, and should also provide all the details that hackers want.
+
+That is not as hard as it first sounds. Arrange each chapter as a
+logical breakdown of its topic, but order the sections, and write their
+text, so that reading the chapter straight through makes sense. Do
+likewise when structuring the book into chapters, and when structuring a
+section into paragraphs. The watchword is, @emph{at each point, address
+the most fundamental and important issue raised by the preceding text.}
+
+If necessary, add extra chapters at the beginning of the manual which
+are purely tutorial and cover the basics of the subject. These provide
+the framework for a beginner to understand the rest of the manual. The
+Bison manual provides a good example of how to do this.
+
+Don't use Unix man pages as a model for how to write GNU documentation;
+most of them are terse, badly structured, and give inadequate
+explanation of the underlying concepts. (There are, of course
+exceptions.) Also Unix man pages use a particular format which is
+different from what we use in GNU manuals.
+
+Please do not use the term ``pathname'' that is used in Unix
+documentation; use ``file name'' (two words) instead. We use the term
+``path'' only for search paths, which are lists of file names.
+
+Please do not use the term ``illegal'' to refer to erroneous input to a
+computer program. Please use ``invalid'' for this, and reserve the term
+``illegal'' for violations of law.
+
+@node Manual Structure Details
+@section Manual Structure Details
+
+The title page of the manual should state the version of the programs or
+packages documented in the manual. The Top node of the manual should
+also contain this information. If the manual is changing more
+frequently than or independent of the program, also state a version
+number for the manual in both of these places.
+
+Each program documented in the manual should should have a node named
+@samp{@var{program} Invocation} or @samp{Invoking @var{program}}. This
+node (together with its subnodes, if any) should describe the program's
+command line arguments and how to run it (the sort of information people
+would look in a man page for). Start with an @samp{@@example}
+containing a template for all the options and arguments that the program
+uses.
+
+Alternatively, put a menu item in some menu whose item name fits one of
+the above patterns. This identifies the node which that item points to
+as the node for this purpose, regardless of the node's actual name.
+
+There will be automatic features for specifying a program name and
+quickly reading just this part of its manual.
+
+If one manual describes several programs, it should have such a node for
+each program described.
+
+@node NEWS File
+@section The NEWS File
+
+In addition to its manual, the package should have a file named
+@file{NEWS} which contains a list of user-visible changes worth
+mentioning. In each new release, add items to the front of the file and
+identify the version they pertain to. Don't discard old items; leave
+them in the file after the newer items. This way, a user upgrading from
+any previous version can see what is new.
+
+If the @file{NEWS} file gets very long, move some of the older items
+into a file named @file{ONEWS} and put a note at the end referring the
+user to that file.
+
+@node Change Logs
+@section Change Logs
+
+Keep a change log to describe all the changes made to program source
+files. The purpose of this is so that people investigating bugs in the
+future will know about the changes that might have introduced the bug.
+Often a new bug can be found by looking at what was recently changed.
+More importantly, change logs can help you eliminate conceptual
+inconsistencies between different parts of a program, by giving you a
+history of how the conflicting concepts arose and who they came from.
+
+@menu
+* Change Log Concepts::
+* Style of Change Logs::
+* Simple Changes::
+* Conditional Changes::
+@end menu
+
+@node Change Log Concepts
+@subsection Change Log Concepts
+
+You can think of the change log as a conceptual ``undo list'' which
+explains how earlier versions were different from the current version.
+People can see the current version; they don't need the change log
+to tell them what is in it. What they want from a change log is a
+clear explanation of how the earlier version differed.
+
+The change log file is normally called @file{ChangeLog} and covers an
+entire directory. Each directory can have its own change log, or a
+directory can use the change log of its parent directory--it's up to
+you.
+
+Another alternative is to record change log information with a version
+control system such as RCS or CVS. This can be converted automatically
+to a @file{ChangeLog} file.
+
+There's no need to describe the full purpose of the changes or how they
+work together. If you think that a change calls for explanation, you're
+probably right. Please do explain it---but please put the explanation
+in comments in the code, where people will see it whenever they see the
+code. For example, ``New function'' is enough for the change log when
+you add a function, because there should be a comment before the
+function definition to explain what it does.
+
+However, sometimes it is useful to write one line to describe the
+overall purpose of a batch of changes.
+
+The easiest way to add an entry to @file{ChangeLog} is with the Emacs
+command @kbd{M-x add-change-log-entry}. An entry should have an
+asterisk, the name of the changed file, and then in parentheses the name
+of the changed functions, variables or whatever, followed by a colon.
+Then describe the changes you made to that function or variable.
+
+@node Style of Change Logs
+@subsection Style of Change Logs
+
+Here are some examples of change log entries:
+
+@example
+* register.el (insert-register): Return nil.
+(jump-to-register): Likewise.
+
+* sort.el (sort-subr): Return nil.
+
+* tex-mode.el (tex-bibtex-file, tex-file, tex-region):
+Restart the tex shell if process is gone or stopped.
+(tex-shell-running): New function.
+
+* expr.c (store_one_arg): Round size up for move_block_to_reg.
+(expand_call): Round up when emitting USE insns.
+* stmt.c (assign_parms): Round size up for move_block_from_reg.
+@end example
+
+It's important to name the changed function or variable in full. Don't
+abbreviate function or variable names, and don't combine them.
+Subsequent maintainers will often search for a function name to find all
+the change log entries that pertain to it; if you abbreviate the name,
+they won't find it when they search.
+
+For example, some people are tempted to abbreviate groups of function
+names by writing @samp{* register.el (@{insert,jump-to@}-register)};
+this is not a good idea, since searching for @code{jump-to-register} or
+@code{insert-register} would not find that entry.
+
+Separate unrelated change log entries with blank lines. When two
+entries represent parts of the same change, so that they work together,
+then don't put blank lines between them. Then you can omit the file
+name and the asterisk when successive entries are in the same file.
+
+@node Simple Changes
+@subsection Simple Changes
+
+Certain simple kinds of changes don't need much detail in the change
+log.
+
+When you change the calling sequence of a function in a simple fashion,
+and you change all the callers of the function, there is no need to make
+individual entries for all the callers that you changed. Just write in
+the entry for the function being called, ``All callers changed.''
+
+@example
+* keyboard.c (Fcommand_execute): New arg SPECIAL.
+All callers changed.
+@end example
+
+When you change just comments or doc strings, it is enough to write an
+entry for the file, without mentioning the functions. Just ``Doc
+fixes'' is enough for the change log.
+
+There's no need to make change log entries for documentation files.
+This is because documentation is not susceptible to bugs that are hard
+to fix. Documentation does not consist of parts that must interact in a
+precisely engineered fashion. To correct an error, you need not know
+the history of the erroneous passage; it is enough to compare what the
+documentation says with the way the program actually works.
+
+@node Conditional Changes
+@subsection Conditional Changes
+
+C programs often contain compile-time @code{#if} conditionals. Many
+changes are conditional; sometimes you add a new definition which is
+entirely contained in a conditional. It is very useful to indicate in
+the change log the conditions for which the change applies.
+
+Our convention for indicating conditional changes is to use square
+brackets around the name of the condition.
+
+Here is a simple example, describing a change which is conditional but
+does not have a function or entity name associated with it:
+
+@example
+* xterm.c [SOLARIS2]: Include string.h.
+@end example
+
+Here is an entry describing a new definition which is entirely
+conditional. This new definition for the macro @code{FRAME_WINDOW_P} is
+used only when @code{HAVE_X_WINDOWS} is defined:
+
+@example
+* frame.h [HAVE_X_WINDOWS] (FRAME_WINDOW_P): Macro defined.
+@end example
+
+Here is an entry for a change within the function @code{init_display},
+whose definition as a whole is unconditional, but the changes themselves
+are contained in a @samp{#ifdef HAVE_LIBNCURSES} conditional:
+
+@example
+* dispnew.c (init_display) [HAVE_LIBNCURSES]: If X, call tgetent.
+@end example
+
+Here is an entry for a change that takes affect only when
+a certain macro is @emph{not} defined:
+
+@example
+(gethostname) [!HAVE_SOCKETS]: Replace with winsock version.
+@end example
+
+@node Man Pages
+@section Man Pages
+
+In the GNU project, man pages are secondary. It is not necessary or
+expected for every GNU program to have a man page, but some of them do.
+It's your choice whether to include a man page in your program.
+
+When you make this decision, consider that supporting a man page
+requires continual effort each time the program is changed. The time
+you spend on the man page is time taken away from more useful work.
+
+For a simple program which changes little, updating the man page may be
+a small job. Then there is little reason not to include a man page, if
+you have one.
+
+For a large program that changes a great deal, updating a man page may
+be a substantial burden. If a user offers to donate a man page, you may
+find this gift costly to accept. It may be better to refuse the man
+page unless the same person agrees to take full responsibility for
+maintaining it---so that you can wash your hands of it entirely. If
+this volunteer later ceases to do the job, then don't feel obliged to
+pick it up yourself; it may be better to withdraw the man page from the
+distribution until someone else agrees to update it.
+
+When a program changes only a little, you may feel that the
+discrepancies are small enough that the man page remains useful without
+updating. If so, put a prominent note near the beginning of the man
+page explaining that you don't maintain it and that the Texinfo manual
+is more authoritative. The note should say how to access the Texinfo
+documentation.
+
+@node Reading other Manuals
+@section Reading other Manuals
+
+There may be non-free books or documentation files that describe the
+program you are documenting.
+
+It is ok to use these documents for reference, just as the author of a
+new algebra textbook can read other books on algebra. A large portion
+of any non-fiction book consists of facts, in this case facts about how
+a certain program works, and these facts are necessarily the same for
+everyone who writes about the subject. But be careful not to copy your
+outline structure, wording, tables or examples from preexisting non-free
+documentation. Copying from free documentation may be ok; please check
+with the FSF about the individual case.
+
+@node Managing Releases
+@chapter The Release Process
+
+Making a release is more than just bundling up your source files in a
+tar file and putting it up for FTP. You should set up your software so
+that it can be configured to run on a variety of systems. Your Makefile
+should conform to the GNU standards described below, and your directory
+layout should also conform to the standards discussed below. Doing so
+makes it easy to include your package into the larger framework of
+all GNU software.
+
+@menu
+* Configuration:: How Configuration Should Work
+* Makefile Conventions:: Makefile Conventions
+* Releases:: Making Releases
+@end menu
+
+@node Configuration
+@section How Configuration Should Work
+
+Each GNU distribution should come with a shell script named
+@code{configure}. This script is given arguments which describe the
+kind of machine and system you want to compile the program for.
+
+The @code{configure} script must record the configuration options so
+that they affect compilation.
+
+One way to do this is to make a link from a standard name such as
+@file{config.h} to the proper configuration file for the chosen system.
+If you use this technique, the distribution should @emph{not} contain a
+file named @file{config.h}. This is so that people won't be able to
+build the program without configuring it first.
+
+Another thing that @code{configure} can do is to edit the Makefile. If
+you do this, the distribution should @emph{not} contain a file named
+@file{Makefile}. Instead, it should include a file @file{Makefile.in} which
+contains the input used for editing. Once again, this is so that people
+won't be able to build the program without configuring it first.
+
+If @code{configure} does write the @file{Makefile}, then @file{Makefile}
+should have a target named @file{Makefile} which causes @code{configure}
+to be rerun, setting up the same configuration that was set up last
+time. The files that @code{configure} reads should be listed as
+dependencies of @file{Makefile}.
+
+All the files which are output from the @code{configure} script should
+have comments at the beginning explaining that they were generated
+automatically using @code{configure}. This is so that users won't think
+of trying to edit them by hand.
+
+The @code{configure} script should write a file named @file{config.status}
+which describes which configuration options were specified when the
+program was last configured. This file should be a shell script which,
+if run, will recreate the same configuration.
+
+The @code{configure} script should accept an option of the form
+@samp{--srcdir=@var{dirname}} to specify the directory where sources are found
+(if it is not the current directory). This makes it possible to build
+the program in a separate directory, so that the actual source directory
+is not modified.
+
+If the user does not specify @samp{--srcdir}, then @code{configure} should
+check both @file{.} and @file{..} to see if it can find the sources. If
+it finds the sources in one of these places, it should use them from
+there. Otherwise, it should report that it cannot find the sources, and
+should exit with nonzero status.
+
+Usually the easy way to support @samp{--srcdir} is by editing a
+definition of @code{VPATH} into the Makefile. Some rules may need to
+refer explicitly to the specified source directory. To make this
+possible, @code{configure} can add to the Makefile a variable named
+@code{srcdir} whose value is precisely the specified directory.
+
+The @code{configure} script should also take an argument which specifies the
+type of system to build the program for. This argument should look like
+this:
+
+@example
+@var{cpu}-@var{company}-@var{system}
+@end example
+
+For example, a Sun 3 might be @samp{m68k-sun-sunos4.1}.
+
+The @code{configure} script needs to be able to decode all plausible
+alternatives for how to describe a machine. Thus, @samp{sun3-sunos4.1}
+would be a valid alias. For many programs, @samp{vax-dec-ultrix} would
+be an alias for @samp{vax-dec-bsd}, simply because the differences
+between Ultrix and @sc{BSD} are rarely noticeable, but a few programs
+might need to distinguish them.
+@c Real 4.4BSD now runs on some Suns.
+
+There is a shell script called @file{config.sub} that you can use
+as a subroutine to validate system types and canonicalize aliases.
+
+Other options are permitted to specify in more detail the software
+or hardware present on the machine, and include or exclude optional
+parts of the package:
+
+@table @samp
+@item --enable-@var{feature}@r{[}=@var{parameter}@r{]}
+Configure the package to build and install an optional user-level
+facility called @var{feature}. This allows users to choose which
+optional features to include. Giving an optional @var{parameter} of
+@samp{no} should omit @var{feature}, if it is built by default.
+
+No @samp{--enable} option should @strong{ever} cause one feature to
+replace another. No @samp{--enable} option should ever substitute one
+useful behavior for another useful behavior. The only proper use for
+@samp{--enable} is for questions of whether to build part of the program
+or exclude it.
+
+@item --with-@var{package}
+@c @r{[}=@var{parameter}@r{]}
+The package @var{package} will be installed, so configure this package
+to work with @var{package}.
+
+@c Giving an optional @var{parameter} of
+@c @samp{no} should omit @var{package}, if it is used by default.
+
+Possible values of @var{package} include @samp{x}, @samp{x-toolkit},
+@samp{gnu-as} (or @samp{gas}), @samp{gnu-ld}, @samp{gnu-libc}, and
+@samp{gdb}.
+
+Do not use a @samp{--with} option to specify the file name to use to
+find certain files. That is outside the scope of what @samp{--with}
+options are for.
+
+@item --nfp
+The target machine has no floating point processor.
+
+@item --gas
+The target machine assembler is GAS, the GNU assembler.
+This is obsolete; users should use @samp{--with-gnu-as} instead.
+
+@item --x
+The target machine has the X Window System installed.
+This is obsolete; users should use @samp{--with-x} instead.
+@end table
+
+All @code{configure} scripts should accept all of these ``detail''
+options, whether or not they make any difference to the particular
+package at hand. In particular, they should accept any option that
+starts with @samp{--with-} or @samp{--enable-}. This is so users will
+be able to configure an entire GNU source tree at once with a single set
+of options.
+
+You will note that the categories @samp{--with-} and @samp{--enable-}
+are narrow: they @strong{do not} provide a place for any sort of option
+you might think of. That is deliberate. We want to limit the possible
+configuration options in GNU software. We do not want GNU programs to
+have idiosyncratic configuration options.
+
+Packages that perform part of the compilation process may support cross-compilation.
+In such a case, the host and target machines for the program may be
+different. The @code{configure} script should normally treat the
+specified type of system as both the host and the target, thus producing
+a program which works for the same type of machine that it runs on.
+
+The way to build a cross-compiler, cross-assembler, or what have you, is
+to specify the option @samp{--host=@var{hosttype}} when running
+@code{configure}. This specifies the host system without changing the
+type of target system. The syntax for @var{hosttype} is the same as
+described above.
+
+Bootstrapping a cross-compiler requires compiling it on a machine other
+than the host it will run on. Compilation packages accept a
+configuration option @samp{--build=@var{hosttype}} for specifying the
+configuration on which you will compile them, in case that is different
+from the host.
+
+Programs for which cross-operation is not meaningful need not accept the
+@samp{--host} option, because configuring an entire operating system for
+cross-operation is not a meaningful thing.
+
+Some programs have ways of configuring themselves automatically. If
+your program is set up to do this, your @code{configure} script can simply
+ignore most of its arguments.
+
+@comment The makefile standards are in a separate file that is also
+@comment included by make.texinfo. Done by roland@gnu.ai.mit.edu on 1/6/93.
+@comment For this document, turn chapters into sections, etc.
+@lowersections
+@include make-stds.texi
+@raisesections
+
+@node Releases
+@section Making Releases
+
+Package the distribution of Foo version 69.96 in a gzipped tar file
+named @file{foo-69.96.tar.gz}. It should unpack into a subdirectory
+named @file{foo-69.96}.
+
+Building and installing the program should never modify any of the files
+contained in the distribution. This means that all the files that form
+part of the program in any way must be classified into @dfn{source
+files} and @dfn{non-source files}. Source files are written by humans
+and never changed automatically; non-source files are produced from
+source files by programs under the control of the Makefile.
+
+Naturally, all the source files must be in the distribution. It is okay
+to include non-source files in the distribution, provided they are
+up-to-date and machine-independent, so that building the distribution
+normally will never modify them. We commonly include non-source files
+produced by Bison, @code{lex}, @TeX{}, and @code{makeinfo}; this helps avoid
+unnecessary dependencies between our distributions, so that users can
+install whichever packages they want to install.
+
+Non-source files that might actually be modified by building and
+installing the program should @strong{never} be included in the
+distribution. So if you do distribute non-source files, always make
+sure they are up to date when you make a new distribution.
+
+Make sure that the directory into which the distribution unpacks (as
+well as any subdirectories) are all world-writable (octal mode 777).
+This is so that old versions of @code{tar} which preserve the
+ownership and permissions of the files from the tar archive will be
+able to extract all the files even if the user is unprivileged.
+
+Make sure that all the files in the distribution are world-readable.
+
+Make sure that no file name in the distribution is more than 14
+characters long. Likewise, no file created by building the program
+should have a name longer than 14 characters. The reason for this is
+that some systems adhere to a foolish interpretation of the POSIX
+standard, and refuse to open a longer name, rather than truncating as
+they did in the past.
+
+Don't include any symbolic links in the distribution itself. If the tar
+file contains symbolic links, then people cannot even unpack it on
+systems that don't support symbolic links. Also, don't use multiple
+names for one file in different directories, because certain file
+systems cannot handle this and that prevents unpacking the
+distribution.
+
+Try to make sure that all the file names will be unique on MS-DOS. A
+name on MS-DOS consists of up to 8 characters, optionally followed by a
+period and up to three characters. MS-DOS will truncate extra
+characters both before and after the period. Thus,
+@file{foobarhacker.c} and @file{foobarhacker.o} are not ambiguous; they
+are truncated to @file{foobarha.c} and @file{foobarha.o}, which are
+distinct.
+
+Include in your distribution a copy of the @file{texinfo.tex} you used
+to test print any @file{*.texinfo} or @file{*.texi} files.
+
+Likewise, if your program uses small GNU software packages like regex,
+getopt, obstack, or termcap, include them in the distribution file.
+Leaving them out would make the distribution file a little smaller at
+the expense of possible inconvenience to a user who doesn't know what
+other files to get.
+
+@contents
+
+@bye
diff --git a/gcc/config/alpha/vms-tramp.asm b/gcc/config/alpha/vms-tramp.asm
deleted file mode 100644
index fce9ec539ca..00000000000
--- a/gcc/config/alpha/vms-tramp.asm
+++ /dev/null
@@ -1,22 +0,0 @@
-;# New Alpha OpenVMS trampoline
-;#
- .set noreorder
- .set volatile
- .set noat
- .file 1 "tramp.s"
-.text
- .align 3
- .globl __tramp
- .ent __tramp
-__tramp..en:
-
-.link
- .align 3
-__tramp:
- .pdesc __tramp..en,null
-.text
- ldq $1,24($27)
- ldq $27,16($27)
- ldq $28,8($27)
- jmp $31,($28),0
- .end __tramp
diff --git a/gcc/config/float-i128.h b/gcc/config/float-i128.h
deleted file mode 100644
index 6a9dd48b1a3..00000000000
--- a/gcc/config/float-i128.h
+++ /dev/null
@@ -1,96 +0,0 @@
-/* float.h for target with IEEE 32, 64 and 128 bit floating point formats */
-#ifndef _FLOAT_H_
-#define _FLOAT_H_
-/* Produced by enquire version 4.3, CWI, Amsterdam */
-
- /* Radix of exponent representation */
-#undef FLT_RADIX
-#define FLT_RADIX 2
- /* Number of base-FLT_RADIX digits in the significand of a float */
-#undef FLT_MANT_DIG
-#define FLT_MANT_DIG 24
- /* Number of decimal digits of precision in a float */
-#undef FLT_DIG
-#define FLT_DIG 6
- /* Addition rounds to 0: zero, 1: nearest, 2: +inf, 3: -inf, -1: unknown */
-#undef FLT_ROUNDS
-#define FLT_ROUNDS 1
- /* Difference between 1.0 and the minimum float greater than 1.0 */
-#undef FLT_EPSILON
-#define FLT_EPSILON 1.19209290e-07F
- /* Minimum int x such that FLT_RADIX**(x-1) is a normalised float */
-#undef FLT_MIN_EXP
-#define FLT_MIN_EXP (-125)
- /* Minimum normalised float */
-#undef FLT_MIN
-#define FLT_MIN 1.17549435e-38F
- /* Minimum int x such that 10**x is a normalised float */
-#undef FLT_MIN_10_EXP
-#define FLT_MIN_10_EXP (-37)
- /* Maximum int x such that FLT_RADIX**(x-1) is a representable float */
-#undef FLT_MAX_EXP
-#define FLT_MAX_EXP 128
- /* Maximum float */
-#undef FLT_MAX
-#define FLT_MAX 3.40282347e+38F
- /* Maximum int x such that 10**x is a representable float */
-#undef FLT_MAX_10_EXP
-#define FLT_MAX_10_EXP 38
-
- /* Number of base-FLT_RADIX digits in the significand of a double */
-#undef DBL_MANT_DIG
-#define DBL_MANT_DIG 53
- /* Number of decimal digits of precision in a double */
-#undef DBL_DIG
-#define DBL_DIG 15
- /* Difference between 1.0 and the minimum double greater than 1.0 */
-#undef DBL_EPSILON
-#define DBL_EPSILON 2.2204460492503131e-16
- /* Minimum int x such that FLT_RADIX**(x-1) is a normalised double */
-#undef DBL_MIN_EXP
-#define DBL_MIN_EXP (-1021)
- /* Minimum normalised double */
-#undef DBL_MIN
-#define DBL_MIN 2.2250738585072014e-308
- /* Minimum int x such that 10**x is a normalised double */
-#undef DBL_MIN_10_EXP
-#define DBL_MIN_10_EXP (-307)
- /* Maximum int x such that FLT_RADIX**(x-1) is a representable double */
-#undef DBL_MAX_EXP
-#define DBL_MAX_EXP 1024
- /* Maximum double */
-#undef DBL_MAX
-#define DBL_MAX 1.7976931348623157e+308
- /* Maximum int x such that 10**x is a representable double */
-#undef DBL_MAX_10_EXP
-#define DBL_MAX_10_EXP 308
-
- /* Number of base-FLT_RADIX digits in the significand of a long double */
-#undef LDBL_MANT_DIG
-#define LDBL_MANT_DIG 113
- /* Number of decimal digits of precision in a long double */
-#undef LDBL_DIG
-#define LDBL_DIG 33
- /* Difference between 1.0 and the minimum long double greater than 1.0 */
-#undef LDBL_EPSILON
-#define LDBL_EPSILON 1.925929944387235853055977942584927319E-34L
- /* Minimum int x such that FLT_RADIX**(x-1) is a normalised long double */
-#undef LDBL_MIN_EXP
-#define LDBL_MIN_EXP (-16381)
- /* Minimum normalised long double */
-#undef LDBL_MIN
-#define LDBL_MIN 3.362103143112093506262677817321752603E-4932L
- /* Minimum int x such that 10**x is a normalised long double */
-#undef LDBL_MIN_10_EXP
-#define LDBL_MIN_10_EXP (-4931)
- /* Maximum int x such that FLT_RADIX**(x-1) is a representable long double */
-#undef LDBL_MAX_EXP
-#define LDBL_MAX_EXP 16384
- /* Maximum long double */
-#undef LDBL_MAX
-#define LDBL_MAX 1.189731495357231765085759326628007016E+4932L
- /* Maximum int x such that 10**x is a representable long double */
-#undef LDBL_MAX_10_EXP
-#define LDBL_MAX_10_EXP 4932
-
-#endif /* _FLOAT_H_ */
diff --git a/gcc/f/BUGS b/gcc/f/BUGS
new file mode 100644
index 00000000000..ebeaedb7b46
--- /dev/null
+++ b/gcc/f/BUGS
@@ -0,0 +1,198 @@
+This file lists known bugs in the GNU Fortran compiler. Copyright (C)
+1995, 1996 Free Software Foundation, Inc. You may copy, distribute,
+and modify it freely as long as you preserve this copyright notice and
+permission notice.
+
+Bugs in GNU Fortran
+*******************
+
+ This section identifies bugs that `g77' *users* might run into.
+This includes bugs that are actually in the `gcc' back end (GBE) or in
+`libf2c', because those sets of code are at least somewhat under the
+control of (and necessarily intertwined with) `g77', so it isn't worth
+separating them out.
+
+ For information on bugs that might afflict people who configure,
+port, build, and install `g77', *Note Problems Installing::.
+
+ * Work is needed on the `SIGNAL()' intrinsic to ensure that pointers
+ and integers are properly handled on all targets, including 64-bit
+ machines.
+
+ * When using `-fugly-comma', `g77' assumes an extra `%VAL(0)'
+ argument is to be passed to intrinsics taking no arguments, such
+ as `IARGC()', which in turn reject such a call. Although this has
+ been worked around for 0.5.18 due to changes in the handling of
+ intrinsics, `g77' needs to do the ugly-argument-appending trick
+ only for external-function invocation, as this would probably be
+ more consistent with compilers that default to using that trick.
+
+ * Something about `g77''s straightforward handling of label
+ references and definitions sometimes prevents the GBE from
+ unrolling loops. Until this is solved, try inserting or removing
+ `CONTINUE' statements as the terminal statement, using the `END DO'
+ form instead, and so on. (Probably improved, but not wholly
+ fixed, in 0.5.21.)
+
+ * The `g77' command itself should more faithfully process options
+ the way the `gcc' command does. For example, `gcc' accepts
+ abbreviated forms of long options, `g77' generally doesn't.
+
+ * Some confusion in diagnostics concerning failing `INCLUDE'
+ statements from within `INCLUDE''d or `#include''d files.
+
+ * `g77' assumes that `INTEGER(KIND=1)' constants range from `-2**31'
+ to `2**31-1' (the range for two's-complement 32-bit values),
+ instead of determining their range from the actual range of the
+ type for the configuration (and, someday, for the constant).
+
+ Further, it generally doesn't implement the handling of constants
+ very well in that it makes assumptions about the configuration
+ that it no longer makes regarding variables (types).
+
+ Included with this item is the fact that `g77' doesn't recognize
+ that, on IEEE-754/854-compliant systems, `0./0.' should produce a
+ NaN and no warning instead of the value `0.' and a warning. This
+ is to be fixed in version 0.6, when `g77' will use the `gcc' back
+ end's constant-handling mechanisms to replace its own.
+
+ * `g77' uses way too much memory and CPU time to process large
+ aggregate areas having any initialized elements.
+
+ For example, `REAL A(1000000)' followed by `DATA A(1)/1/' takes up
+ way too much time and space, including the size of the generated
+ assembler file. This is to be mitigated somewhat in version 0.6.
+
+ Version 0.5.18 improves cases like this--specifically, cases of
+ *sparse* initialization that leave large, contiguous areas
+ uninitialized--significantly. However, even with the
+ improvements, these cases still require too much memory and CPU
+ time.
+
+ (Version 0.5.18 also improves cases where the initial values are
+ zero to a much greater degree, so if the above example ends with
+ `DATA A(1)/0/', the compile-time performance will be about as good
+ as it will ever get, aside from unrelated improvements to the
+ compiler.)
+
+ Note that `g77' does display a warning message to notify the user
+ before the compiler appears to hang. *Note Initialization of
+ Large Aggregate Areas: Large Initialization, for information on
+ how to change the point at which `g77' decides to issue this
+ warning.
+
+ * `g77' doesn't emit variable and array members of common blocks for
+ use with a debugger (the `-g' command-line option). The code is
+ present to do this, but doesn't work with at least one debug
+ format--perhaps it works with others. And it turns out there's a
+ similar bug for local equivalence areas, so that has been disabled
+ as well.
+
+ As of Version 0.5.19, a temporary kludge solution is provided
+ whereby some rudimentary information on a member is written as a
+ string that is the member's value as a character string.
+
+ *Note Options for Code Generation Conventions: Code Gen Options,
+ for information on the `-fdebug-kludge' option.
+
+ * When debugging, after starting up the debugger but before being
+ able to see the source code for the main program unit, the user
+ must currently set a breakpoint at `MAIN__' (or `MAIN___' or
+ `MAIN_' if `MAIN__' doesn't exist) and run the program until it
+ hits the breakpoint. At that point, the main program unit is
+ activated and about to execute its first executable statement, but
+ that's the state in which the debugger should start up, as is the
+ case for languages like C.
+
+ * Debugging `g77'-compiled code using debuggers other than `gdb' is
+ likely not to work.
+
+ Getting `g77' and `gdb' to work together is a known
+ problem--getting `g77' to work properly with other debuggers, for
+ which source code often is unavailable to `g77' developers, seems
+ like a much larger, unknown problem, and is a lower priority than
+ making `g77' and `gdb' work together properly.
+
+ On the other hand, information about problems other debuggers have
+ with `g77' output might make it easier to properly fix `g77', and
+ perhaps even improve `gdb', so it is definitely welcome. Such
+ information might even lead to all relevant products working
+ together properly sooner.
+
+ * `g77' currently inserts needless padding for things like `COMMON
+ A,IPAD' where `A' is `CHARACTER*1' and `IPAD' is `INTEGER(KIND=1)'
+ on machines like x86, because the back end insists that `IPAD' be
+ aligned to a 4-byte boundary, but the processor has no such
+ requirement (though it's good for performance).
+
+ It is possible that this is not a real bug, and could be considered
+ a performance feature, but it might be important to provide the
+ ability to Fortran code to specify minimum padding for aggregate
+ areas such as common blocks--and, certainly, there is the
+ potential, with the current setup, for interface differences in
+ the way such areas are laid out between `g77' and other compilers.
+
+ * Some crashes occur when compiling under Solaris on x86 machines.
+
+ Nothing has been heard about any such problems for some time, so
+ this is considering a closed item as of 0.5.20. Please submit any
+ bug reports pertinent to `g77''s support for Solaris/x86 systems.
+
+ * RS/6000 support is not complete as of the gcc 2.6.3 back end. The
+ 2.7.0 back end appears to fix this problem, or at least mitigate
+ it significantly, but there is at least one known problem that is
+ likely to be a code-generation bug in `gcc-2.7.0' plus
+ `g77-0.5.16'. This problem shows up only when compiling the
+ Fortran program with `-O'.
+
+ Nothing has been heard about any RS/6000 problems for some time,
+ so this is considering a closed item as of 0.5.20. Please submit
+ any bug reports pertinent to `g77''s support for RS/6000 systems.
+
+ * SGI support is known to be a bit buggy. The known problem shows
+ up only when compiling the Fortran program with `-O'.
+
+ It is possible these problems have all been fixed in 0.5.20 by
+ emulating complex arithmetic in the front end. Please submit any
+ bug reports pertinent to `g77''s support for SGI systems.
+
+ * `g77' doesn't work perfectly on 64-bit configurations such as the
+ Alpha. This problem is expected to be largely resolved as of
+ version 0.5.20, and further addressed by 0.5.21. Version 0.6
+ should solve most or all related problems (such as 64-bit machines
+ other than Digital Semiconductor ("DEC") Alphas).
+
+ One known bug that causes a compile-time crash occurs when
+ compiling code such as the following with optimization:
+
+ SUBROUTINE CRASH (TEMP)
+ INTEGER*2 HALF(2)
+ REAL TEMP
+ HALF(1) = NINT (TEMP)
+ END
+
+ It is expected that a future version of `g77' will have a fix for
+ this problem, almost certainly by the time `g77' supports the
+ forthcoming version 2.8.0 of `gcc'.
+
+ * Maintainers of gcc report that the back end definitely has "broken"
+ support for `COMPLEX' types. Based on their input, it seems many
+ of the problems affect only the more-general facilities for gcc's
+ `__complex__' type, such as `__complex__ int' (where the real and
+ imaginary parts are integers) that GNU Fortran does not use.
+
+ Version 0.5.20 of `g77' works around this problem by not using the
+ back end's support for `COMPLEX'. The new option
+ `-fno-emulate-complex' avoids the work-around, reverting to using
+ the same "broken" mechanism as that used by versions of `g77'
+ prior to 0.5.20.
+
+ * There seem to be some problems with passing constants, and perhaps
+ general expressions (other than simple variables/arrays), to
+ procedures when compiling on some systems (such as i386) with
+ `-fPIC', as in when compiling for ELF targets. The symptom is
+ that the assembler complains about invalid opcodes. More
+ investigation is needed, but the problem is almost certainly in
+ the gcc back end, and it apparently occurs only when compiling
+ sufficiently complicated functions *without* the `-O' option.
+
diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
new file mode 100644
index 00000000000..38546900343
--- /dev/null
+++ b/gcc/f/ChangeLog
@@ -0,0 +1,3721 @@
+Mon Aug 11 21:19:22 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in ($(RUNTIMESTAGESTUFF)): Add
+ f/runtime/stamp-lib.
+
+Mon Aug 11 01:52:03 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_build_complex_constant_): Go with the
+ new build_complex() approach used in gcc-2.8.
+
+ * com.c (ffecom_sym_transform_): Don't set
+ DECL_IN_SYSTEM_HEADER for a tree node that isn't
+ a VAR_DECL, which happens when var is in common!
+
+ * com.c (ffecom_expr_intrinsic_) (case FFEINTRIN_impALARM):
+ No need to test codegen_imp -- there's only one valid here.
+
+ * intrin.def (FFEINTRIN_impALARM): Specify `Status' argument
+ as write-only.
+
+Fri Aug 8 05:40:23 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Substantial changes to accommodate distinctions among
+ run-time routines that support intrinsics, and between
+ routines that compute and return the same type vs. those
+ that compute one type and return another (or `void'):
+ * com-rt.def: Specify new return type REAL_F2C_ instead
+ of many DOUBLE_, COMPLEX_F2C_ instead of COMPLEX_, and
+ so on.
+ Clear up the *BES* routines "once and for all".
+ * com.c: New return types.
+ (ffecom_convert_narrow_, ffecom_convert_widen_):
+ New functions that are "safe" variants of convert(),
+ to catch errors that ffecom_expr_intrinsic_() now
+ no longer catches.
+ (ffecom_arglist_expr_): Ensure arguments are not
+ converted to narrower types.
+ (ffecom_call_): Ensure return value is not converted
+ to a wider type.
+ (ffecom_char_args_): Use new ffeintrin_gfrt_direct()
+ routine.
+ (ffecom_expr_intrinsic_): Simplify how run-time
+ routine is selected (via `gfrt' only now; lose the
+ redundant `ix' variable).
+ Eliminate the `library' label; any code that doesn't
+ return directly just `break's out now with `gfrt'
+ set appropriately.
+ Set `gfrt' to default choice initially, either a
+ fast direct form or, if not available, a slower
+ indirect-callable form.
+ (ffecom_make_gfrt_): No longer need to do special
+ check for complex; it's built into the new return-type
+ regime.
+ (ffecom_ptr_to_expr): Use new ffeintrin_gfrt_indirect()
+ routine.
+ * intrin.c, intrin.h: `gfrt' field replaced with three fields,
+ so it is easier to provide faster direct-callable and
+ GNU-convention indirect-callable routines in the future.
+ DEFIMP macro adjusted accordingly, along with all its uses.
+ (ffeintrin_gfrt_direct): New function.
+ (ffeintrin_gfrt_indirect): Ditto.
+ (ffeintrin_is_actualarg): If `-fno-f2c' is in effect,
+ require a GNU-callable version of intrinsic instead of
+ an f2c-callable version, so indirect calling is still checked.
+ * intrin.def: Replace one GFRT field with the three new fields,
+ as appropriate for each DEFIMP intrinsic.
+
+ * com.c (ffecom_stabilize_aggregate_,
+ ffecom_convert_to_complex_): Make these `static'.
+
+Thu Aug 7 11:24:34 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Provide means for front end to determine actual
+ "standard" return type for an intrinsic if it is
+ passed as an actual argument:
+ * com.h, com.c (ffecom_gfrt_basictype,
+ ffecom_gfrt_kindtype): New functions.
+ (ffecom_gfrt_kind_type_): Replaced with new function.
+ All callers updated.
+ (ffecom_make_gfrt_): No longer need do anything
+ with kind type.
+
+ * intrin.c (ffeintrin_basictype, ffeintrin_kindtype):
+ Now returns correct type info for specific intrinsic
+ (based on type of run-time-library implementation).
+
+Wed Aug 6 23:08:46 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * global.c (ffeglobal_ref_progunit_): Don't reset
+ number of arguments just due to new type info,
+ so useful warnings can be issued.
+
+1997-08-06 Dave Love <d.love@dl.ac.uk>
+
+ * intrin.def: Fix IDATE_vxt argument order.
+ * intdoc.h: Likewise.
+
+Thu Jul 31 22:22:03 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * global.c (ffeglobal_proc_ref_arg): If REF/DESCR
+ disagreement, DESCR is CHARACTER, and types disagree,
+ pretend the argsummary agrees so the message ends up
+ being about type disagreement.
+ (ffeglobal_proc_def_arg): Ditto.
+
+ * expr.c (ffeexpr_token_first_rhs_3_): Set info for LABTOK
+ to NONE of everything, to avoid misdiagnosing filewide
+ usage of alternate returns.
+
+Sun Jul 20 23:07:47 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_sym_transform_): If type gets set
+ to error_mark_node, just return that for transformed symbol.
+ (ffecom_member_phase2_): If type gets set to error_mark_node,
+ just return.
+ (ffecom_check_size_overflow_): Add `dummy' argument to
+ flag that type is for a dummy, update all callers.
+
+Sun Jul 13 17:40:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Fix 970712-1.f:
+ * where.c (ffewhere_set_from_track): If start point
+ is too large, just use initial start point. 0.6 should
+ fix all this properly.
+
+ Fix 970712-2.f:
+ * com.c (ffecom_sym_transform_): Preserve error_mark_node for type.
+ (ffecom_type_localvar_): Ditto.
+ (ffecom_sym_transform_): If type is error_mark_node,
+ don't error-check decl size, because back end responds by
+ setting that to an integer 0 instead of error_mark_node.
+ (ffecom_transform_common_): Same as earlier fix to _transform_
+ in that size is checked by dividing BITS_PER_UNIT instead of
+ multiplying.
+ (ffecom_transform_equiv_): Ditto.
+
+ Fix 970712-3.f:
+ * stb.c (ffestb_R10014_): Fix flaky fall-through in error
+ test for FFELEX_typeCONCAT by just replicating the code,
+ and do FFELEX_typeCOLONCOLON while at it.
+
+1997-07-07 Dave Love <d.love@dl.ac.uk>
+
+ * intdoc.h: Add various missing pieces; correct GMTIME, LTIME
+ result ordering.
+
+ * intrin.def, com-rt.def: Add alarm.
+
+ * com.c (ffecom_expr_intrinsic_): Add case for alarm.
+
+Thu Jun 26 04:19:40 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Fix 970302-3.f:
+ * com.c (ffecom_sym_transform_): For sanity-check compare
+ of gbe size of local variable to g77 expectation,
+ use varasm.c/assemble_variable technique of dividing
+ BITS_PER_UNIT out of gbe info instead of multiplying
+ g77 info up, to avoid crash when size in bytes is very
+ large, and overflows an `int' or similar when multiplied.
+
+ Fix 970626-2.f:
+ * com.c (ffecom_finish_symbol_transform_): Don't bother
+ transforming a dummy argument, to avoid a crash.
+ * ste.c (ffeste_R1227): Don't return a value if the
+ result decl, or its type, is error_mark_node.
+
+ Fix 970626-4.f:
+ * lex.c (ffelex_splice_tokens): `-fdollar-ok' is
+ irrelevant to whether a DOLLAR token should be made
+ from an initial character of `$'.
+
+ Fix 970626-6.f:
+ * stb.c (ffestb_do3_): DO iteration variable is an
+ lhs, not rhs, expression.
+
+ Fix 970626-7.f and 970626-8.f:
+ * expr.c (ffeexpr_cb_comma_i_1_): Set IMPDO expression
+ to have clean info, because undefined rank, for example,
+ caused crash on mangled source on UltraSPARC but not
+ on Alpha for a series of weird reasons.
+ (ffeexpr_cb_close_paren_): If not CLOSE_PAREN, push
+ opANY expression onto stack instead of attempting
+ to mimic what program might have wanted.
+ (ffeexpr_cb_close_paren_): Don't wrap opPAREN around
+ opIMPDO, just warn that it's gratuitous.
+ * bad.def (FFEBAD_IMPDO_PAREN): New warning.
+
+ Fix 970626-9.f:
+ * expr.c (ffeexpr_declare_parenthesized_): Must shut down
+ parsing in kindANY case, otherwise the parsing engine might
+ decide there's an ambiguity.
+ (ffeexpr_token_name_rhs_): Eliminate parentypeSUBROUTINE_
+ case, so we crash right away if it comes through.
+ * st.c, st.h, sta.c, sta.h (ffest_shutdown, ffesta_shutdown):
+ New functions.
+
+Tue Jun 24 19:47:29 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_check_size_overflow_): New function
+ catches some cases of the size of a type getting
+ too large. varasm.c must catch the rest.
+ (ffecom_sym_transform_): Use new function.
+ (ffecom_type_localvar_): Ditto.
+
+Mon Jun 23 01:09:28 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * global.c (ffeglobal_proc_def_arg): Fix comparison
+ of argno to #args.
+ (ffeglobal_proc_ref_arg): Ditto.
+
+ * lang-options.h, top.c: Rename `-fdebug' to `-fxyzzy',
+ since it's an unsupported internals option and some
+ poor user might guess that it does something.
+
+ * bad.def: Make a warning for each filewide diagnostic.
+ Put all filewides together.
+ * com.c (ffecom_sym_transform_): Don't substitute
+ known global tree for global entities when `-fno-globals'.
+ * global.c (ffeglobal_new_progunit_): Don't produce
+ fatal diagnostics about globals when `-fno-globals'.
+ Instead, produce equivalent warning when `-Wglobals'.
+ (ffeglobal_proc_ref_arg): Ditto.
+ (ffeglobal_proc_ref_nargs): Ditto.
+ (ffeglobal_ref_progunit_): Ditto.
+ * lang-options.h, top.c, top.h: New `-fno-globals' option.
+
+Sat Jun 21 12:32:54 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * expr.c (ffeexpr_fulfill_call_): Set array variable
+ to avoid warning about uninitialized variable.
+
+ * Make-lang.in: Get rid of any setting of HOST_* macros,
+ since these will break gcc's build!
+ * makefile: New file to make building derived files
+ easier.
+
+Thu Jun 19 18:19:28 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * g77.c (main): Install Emilio Lopes' patch to support
+ Ratfor, and to fix the printing of the version string
+ to go to stderr, not stdout.
+ * lang-specs.h: Install Emilio Lopes' patch to support
+ Ratfor, and patch the result to support picking up
+ `*f771' from the `specs' file.
+
+Thu Jun 12 14:36:25 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * storag.c (ffestorag_update_init, ffestorag_update_save):
+ Also update parent, in case equivalence processing
+ has already eliminated pointers to it via the
+ local equivalence info.
+
+Tue Jun 10 14:08:26 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * intdoc.c: Add cross-reference to end of description
+ of any generic intrinsic pointing to other intrinsics
+ with the same name.
+
+ Warn about explicit type declaration for intrinsic
+ that disagrees with invocation:
+ * expr.c (ffeexpr_paren_rhs_let_): Preserve type info
+ for intrinsic functions.
+ (ffeexpr_token_funsubstr_): Ditto.
+ * intrin.c (ffeintrin_fulfill_generic): Warn if type
+ info of fulfilled intrinsic invocation disagrees with
+ explicit type info given symbol.
+ (ffeintrin_fulfill_specific): Ditto.
+ * stc.c (ffestc_R1208_item): Preserve type info
+ for intrinsics.
+ (ffestc_R501_item): Ditto.
+
+Mon Jun 9 17:45:44 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_expr_intrinsic_): Fix several of the
+ libU77/libF77-unix handlers to properly convert their
+ arguments.
+
+ * com-rt.def (FFECOM_gfrtFSTAT): Append missing "i" to
+ arg string.
+
+Fri Jun 6 14:37:30 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_expr_intrinsic_): Have a case statement
+ for every intrinsic implementation, so missing ones
+ are caught via gcc warnings.
+ Don't call ffeintrin_codegen_imp anymore.
+ * intrin.c (ffeintrin_fulfill_generic): Remove cg_imp
+ stuff from here.
+ (ffeintrin_codegen_imp): Delete this function.
+ * intrin.def, intrin.h: Remove DEFIMQ stuff from here
+ as well.
+
+Thu Jun 5 13:03:07 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * top.c (ffe_decode_option): New -fbadu77-intrinsics-*
+ options.
+ * top.h: Ditto.
+ * intrin.h: New BADU77 family.
+ * intrin.c (ffeintrin_state_family): Ditto.
+
+ Implement new scheme to track intrinsic names vs. forms:
+ * intrin.c (ffeintrin_fulfill_generic),
+ (ffeintrin_fulfill_specific), (ffeintrin_is_intrinsic),
+ intrin.def: The documented name is now either in the
+ generic info or, if no generic, in the specific info.
+ For a generic, the specific info contains merely the
+ distinguishing form (usually "function" or "subroutine"),
+ used for diagnostics about ambiguous references and
+ in the documentation.
+
+ * intrin.def: Clean up formatting of DEFNAME block.
+ Convert many libU77 intrinsics into generics that
+ support both subroutine and function forms.
+ Put the function forms of side-effect routines into
+ the new BADU77 family.
+ Make MCLOCK and TIME return INTEGER*4 again, and add
+ INTEGER*8 equivalents called MCLOCK8 and TIME8.
+ Fix up more status return values to be written and
+ insist on them being I1 as well.
+ * com.c (ffecom_expr_intrinsic_): Lots of changes to
+ support new libU77 intrinsic interfaces.
+
+Mon Jun 2 00:37:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_init_0): Pointer type is now INTEGER(KIND=7),
+ not INTEGER(KIND=0), since we want to reserve KIND=0 for
+ future use.
+
+Thu May 29 14:30:33 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Fix bugs preventing CTIME(I*4) from working correctly:
+ * com.c (ffecom_char_args_): For FUNCREF case, process
+ args to intrinsic just as they would be in
+ ffecom_expr_intrinsic_.
+ * com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtTTYNAM): Fix
+ argument decls to specify `&'.
+
+Wed May 28 22:19:49 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Fix gratuitous warnings exposed by dophot aka 970528-1:
+ * global.c (ffeglobal_proc_def_arg, ffeglobal_proc_ref_arg):
+ Support distinct function/subroutine arguments instead of
+ just procedures.
+ * global.h: Ditto.
+ * expr.c (ffeexpr_fulfill_call_): A SYMTER with kindNONE
+ also is a procedure (either function or subroutine).
+
+Mon May 26 20:25:31 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * bad.def: Have several lexer diagnostics refer to
+ documentation for people who need more info on what Fortran
+ source code is supposed to look like.
+
+ * expr.c (ffeexpr_reduced_bool1_), bad.def: New diagnostics
+ specific to .NOT. now mention only one operand instead
+ of two.
+
+ * g77.c: Recognize -fsyntax-only, similar to -c etc.
+ (lookup_option): Fix bug that prevented non-`--' options
+ from being recognized.
+
+Sun May 25 04:29:04 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * intrin.def (FFEINTRIN_impCTIME): Accept `I*' expression
+ for STime instead of requiring `I2'.
+
+Tue May 20 16:14:40 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * symbol.c (ffesymbol_reference): All references to
+ standard intrinsics are considered explicit, so as
+ to avoid generating basically useless warnings.
+ * intrin.c, intrin.h (ffeintrin_is_standard): Returns TRUE
+ if intrinsic is standard.
+
+Sun May 18 21:14:59 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com-rt.def: Changed all external names of the
+ form `"\([a-z0-9]*\)_' to `"G77_\1_0"' so as to
+ allow any name valid as an intrinsic to be used
+ as such and as a user-defined external procedure
+ name or common block as well.
+
+Thu May 8 13:07:10 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * expr.c (ffeexpr_cb_end_notloc_): For %VAL, %REF, and
+ %DESCR, copy arg info into new node.
+
+Mon May 5 14:42:17 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ From Uwe F. Mayer <mayer@math.Vanderbilt.Edu>:
+ * Make-lang.in (g77-cross): Fix typo in g77.c path.
+
+ From Brian McIlwrath <bkm@star.rl.ac.uk>:
+ * lang-specs.h: Have g77 pick up options from a section
+ labeled `*f771' of the `specs' file.
+
+Sat May 3 02:46:08 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * intrin.def (FFEINTRIN_defSIGNAL): Add optional `Status'
+ argument that com.c already expects (per Dave Love).
+
+ More changes to support better tracking of (filewide)
+ globals, in particular, the arguments to procedures:
+ * bad.def (FFEBAD_FILEWIDE_NARGS, FFEBAD_FILEWIDE_NARGS_W,
+ FFEBAD_FILEWIDE_ARG, FFEBAD_FILEWIDE_ARG_W): New diagnostics.
+ * expr.c (ffebad_fulfill_call_): Provide info on each
+ argument to ffeglobal.
+ * global.c, global.h (ffeglobal_proc_def_arg,
+ ffeglobal_proc_def_nargs, ffeglobal_proc_ref_arg,
+ ffeglobal_proc_ref_args): New functions.
+ (ffeglobalArgSummary, ffeglobalArgInfo_): New types.
+
+Tue Apr 29 18:35:41 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ More changes to support better tracking of (filewide)
+ globals:
+ * expr.c (ffeexpr_fulfill_call_): New function.
+ (ffeexpr_token_name_lhs_): Call after building procedure
+ reference expression. Also leave info field for ANY-ized
+ expression alone.
+ (ffeexpr_token_arguments_): Ditto.
+
+Mon Apr 28 20:04:18 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Changes to support better tracking of (filewide)
+ globals, mainly to avoid crashes due to inlining:
+ * bad.def: Go back to quoting intrinsic names,
+ (FFEBAD_FILEWIDE_DISAGREEMENT, FFEBAD_FILEWIDE_TIFF,
+ FFEBAD_FILEWIDE_TYPE_MISMATCH): New diagnostics.
+ (FFEBAD_INTRINSIC_EXPIMP, FFEBAD_INTRINSIC_GLOBAL): Reword
+ for clarity.
+ * com.c (ffecom_do_entry_, ffecom_start_progunit_,
+ ffecom_sym_transform_): Accommodate new FFEGLOBAL_typeEXT
+ possibility.
+ * expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_extfunc_,
+ ffeexpr_sym_rhs_actualarg_, ffeexpr_declare_parenthesized_,
+ ffeexpr_paren_rhs_let_, ffeexpr_token_funsubstr_):
+ Fill in real kind info instead of leaving NONE where
+ appropriate.
+ Register references to intrinsics and globals with ffesymbol
+ using new ffesymbol_reference function instead of
+ ffesymbol_globalize.
+ * global.c (ffeglobal_type_string_): New array for
+ new diagnostics.
+ * global.h, global.c:
+ Replace ->init mechanism with ->tick mechanism.
+ Move other common-related members into a substructure of
+ a union, so the proc substructure can be introduced
+ to include members related to externals other than commons.
+ Don't complain about ANY-ized globals; ANY-ize globals
+ once they're complained about, in any case where code
+ generation could become a problem.
+ Handle global entries that have NONE type (seen as
+ intrinsics), EXT type (seen as EXTERNAL), and so on.
+ Keep track of kind and type of externals, both via
+ definition and via reference.
+ Diagnose disagreements about kind or type of externals
+ (such as functions).
+ (ffeglobal_ref_intrinsic, ffeglobal_ref_progunit_): New
+ functions.
+ * stc.c (ffestc_R1207_item, ffestc_R1208_item,
+ ffestc_R1219, ffestc_R1226):
+ Call ffesymbol_reference, not ffesymbol_globalize.
+ * stu.c (ffestu_sym_end_transition,
+ ffestu_sym_exec_transition):
+ Call ffesymbol_reference, not ffesymbol_globalize.
+ * symbol.c (ffesymbol_globalize): Removed...
+ (ffesymbol_reference): ...to this new function,
+ which more generally registers references to symbols,
+ globalizes globals, and calls on the ffeglobal module
+ to check globals filewide.
+
+ * global.h, global.c: Rename some macros and functions
+ to more clearly distinguish common from other globals.
+ All callers changed.
+
+ * com.c (ffecom_sym_transform_): Trees describing
+ filewide globals must be allocated on permanent obstack.
+
+ * expr.c (ffeexpr_token_name_lhs_): Don't generate
+ gratuitous diagnostics for FFEINFO_whereANY case.
+
+Thu Apr 17 03:27:18 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * global.c: Add support for flagging intrinsic/global
+ confusion via warnings.
+ * bad.def (FFEBAD_INTRINSIC_EXPIMP,
+ FFEBAD_INTRINSIC_GLOBAL): New diagnostics.
+ * expr.c (ffeexpr_token_funsubstr_): Ditto.
+ (ffeexpr_sym_lhs_call_): Ditto.
+ (ffeexpr_paren_rhs_let_): Ditto.
+ * stc.c (ffestc_R1208_item): Ditto.
+
+Wed Apr 16 22:40:56 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * expr.c (ffeexpr_declare_parenthesized_): INCLUDE
+ context can't be an intrinsic invocation either.
+
+Fri Mar 28 10:43:28 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * expr.c (ffeexpr_token_arguments_): Make sure top of
+ exprstack is operand before dereferencing operand field.
+
+ * lex.c (ffelex_prepare_eos_): Fill up truncated
+ hollerith token, so crash on null ->text field doesn't
+ happen later.
+
+ * stb.c (ffestb_R10014_): If NAMES isn't recognized (or
+ the recognized part is followed in the token by a
+ non-digit), don't try and collect digits, as there
+ might be more than FFEWHERE_indexMAX letters to skip
+ past to do so -- and the code is diagnosed anyway.
+
+Thu Mar 27 00:02:48 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_sym_transform_): Force local
+ adjustable array onto stack.
+
+ * stc.c (ffestc_R547_item_object): Don't actually put
+ the symbol in COMMON if the symbol has already been
+ EQUIVALENCE'd to a different COMMON area.
+
+ * equiv.c (ffeequiv_add): Don't actually do anything
+ if there's a disagreement over which COMMON area is
+ involved.
+
+Tue Mar 25 03:35:19 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_transform_common_): If no explicit init
+ of COMMON area, don't actually init it even though
+ storage area suggests it.
+
+Mon Mar 24 12:10:08 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * lex.c (ffelex_image_char_): Avoid overflowing the
+ column counter itself, as well as the card image.
+
+ * where.c (ffewhere_line_new): Cast ffelex_line_length()
+ to (size_t) so 255 doesn't overflow to 0!
+
+ * stc.c (ffestc_labeldef_notloop_begin_): Don't gratuitously
+ terminate loop before processing statement, so block
+ doesn't disappear out from under EXIT/CYCLE processing.
+ (ffestc_labeldef_notloop_): Has old code from above
+ function, instead of just calling it.
+
+ * expr.c (ffeexpr_cb_comma_i_4_): Don't skip over
+ arbitrary token (such as EOS).
+
+ * com.c (ffecom_init_zero_): Handle RECORD_TYPE and
+ UNION_TYPE so -fno-zeros works with -femulated-complex.
+
+1997-03-12 Dave Love <d.love@dl.ac.uk>
+
+ * intrin.def: New intrinsics INT2, INT8, CPU_TIME. Fix AND, OR,
+ XOR. [Integrated by burley, AND/OR/XOR already fixed, INT8
+ implementation changed/fixed.]
+
+Wed Mar 12 10:40:08 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in ($(srcdir)/f/intdoc.texi): Simplify rules
+ so building f/intdoc is not always necessary; remove
+ f/intdoc after running it if it is built.
+
+Tue Mar 11 23:42:00 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * intrin.def (FFEINTRIN_impAND, FFEINTRIN_impOR,
+ FFEINTRIN_impXOR): Use the IAND, IOR, and IEOR implementations
+ of these, instead of crashing in ffecom_expr_intrinsic_
+ or adding case labels there.
+
+Mon Mar 10 22:51:23 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * intdoc.c: Fix so any C compiler can compile this.
+
+Fri Feb 28 13:16:50 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Version 0.5.20 released.
+
+Fri Feb 28 01:45:25 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in (RUNTIMESTAGESTUFF, LIBU77STAGESTUFF):
+ Move some files incorrectly in the former to the latter,
+ and add another file or two to the latter.
+
+ New meanings for (KIND=n), and new denotations in the
+ little language describing intrinsics:
+ * com.c (ffecom_init_0): Assign new meanings.
+ * intdoc.c: Document new meanings.
+ Support the new denotations.
+ * intrin.c: Employ new meanings, mapping them to internal
+ values (which are the same as they ever were for now).
+ Support the new denotations.
+ * intrin.def: Switch DEFIMP table to the new denotations.
+
+ * intrin.c (ffeintrin_check_): Fix bug that was leaving
+ LOC() and %LOC() returning INTEGER*4 on systems where
+ it should return INTEGER*8.
+
+ * type.c: Canonicalize function definitions, for etags
+ and such.
+
+Wed Feb 26 20:43:03 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_init_0): Choose INTEGER(KIND=n) types,
+ where n is 2, 3, and 4, according to the new docs
+ instead of according to the old C correspondences
+ (which seem less useful at this point).
+
+ * equiv.c (ffeequiv_destroy_): New function.
+ (ffeequiv_layout_local_): Use this new function
+ whenever the laying out of a local equivalence chain
+ is aborted for any reason.
+ Otherwise ensure that symbols no longer reference
+ the stale ffeequiv entries that result when they
+ are killed off in this procedure.
+ Also, the rooted symbol is one that has storage,
+ it really is irrelevant whether it has an equiv entry
+ at this point (though the code to remove the equiv
+ entry was put in at the end, just in case).
+ (ffeequiv_kill): When doing internal checks, make
+ sure the victim isn't named by any symbols it points
+ to. Not as complete a check as looking through the
+ entire symbol table (which does matter, since some
+ code in equiv.c used to remove symbols from the lists
+ for an ffeequiv victim but not remove that victim as the
+ symbol's equiv info), but this check did find some
+ real bugs in the code (that were fixed).
+
+Mon Feb 24 16:42:13 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_expr_intrinsic_): Fix a couple of
+ warnings about uninitialized variables.
+ * intrin.c (ffeintrin_check_): Ditto, but there were
+ a couple of _real_ uninitialized-variable _bugs_ here!
+ (ffeintrin_fulfill_specific): Ditto, no real bug here.
+
+Sun Feb 23 15:01:20 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Clean up diagnostics (especially about intrinsics):
+ * bad.def (FFEBAD_UNIMPL_STMT): Remove.
+ (FFEBAD_INTRINSIC_*, FFEBAD_NEED_INTRINSIC): Clean these
+ up so they're friendlier.
+ (FFEBAD_INTRINSIC_CMPAMBIG): New.
+ * intrin.c (ffeintrin_fulfill_generic,
+ ffeintrin_fulfill_specific, ffeintrin_is_intrinsic):
+ Always choose
+ generic or specific name text (which is for doc purposes
+ anyway) over implementation name text (which is for
+ internal use).
+ * intrin.def: Use more descriptive name texts for generics
+ and specifics in cases where the names themselves are not
+ enough (e.g. IDATE, which has two forms).
+
+ Fix some intrinsic mappings:
+ * intrin.def (FFEINTRIN_specIDINT, FFEINTRIN_specAND,
+ FFEINTRIN_specDFLOAT, FFEINTRIN_specDREAL, FFEINTRIN_specOR,
+ FFEINTRIN_specXOR): Now have their own implementations,
+ instead of borrowing from others.
+ (FFEINTRIN_specAJMAX0, FFEINTRIN_specAJMIN0, FFEINTRIN_specBJTEST,
+ FFEINTRIN_specDFLOTJ, FFEINTRIN_specFLOATJ, FFEINTRIN_specJIABS,
+ FFEINTRIN_specJIAND, FFEINTRIN_specJIBCLR, FFEINTRIN_specJIBITS,
+ FFEINTRIN_specJIBSET, FFEINTRIN_specJIDIM, FFEINTRIN_specJIDINT,
+ FFEINTRIN_specJIDNNT, FFEINTRIN_specJIEOR, FFEINTRIN_specJIFIX,
+ FFEINTRIN_specJINT, FFEINTRIN_specJIOR, FFEINTRIN_specJISHFT,
+ FFEINTRIN_specJISHFTC, FFEINTRIN_specJISIN, FFEINTRIN_specJMAX0,
+ FFEINTRIN_specJMAX1, FFEINTRIN_specJMIN0, FFEINTRIN_specJMIN1,
+ FFEINTRIN_specJMOD, FFEINTRIN_specJNINT, FFEINTRIN_specJNOT,):
+ Turn these implementations off, since it's not clear
+ just what types they expect in the context of portable Fortran.
+ (DFLOAT): Now in FVZ family, since f2c supports them
+
+ Support intrinsic inquiry functions (BIT_SIZE, LEN):
+ * intrin.c: Allow `i' in <arg_extra>.
+ * intrin.def (FFEINTRIN_impBIT_SIZE, FFEINTRIN_impLEN):
+ Mark args with `i'.
+
+Sat Feb 22 13:34:09 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Only warn, don't error, for reference to unimplemented
+ intrinsic:
+ * bad.def (FFEBAD_INTRINSIC_UNIMPLW): Warning version
+ of _UNIMPL.
+ * intrin.c (ffeintrin_is_intrinsic): Use new warning
+ version of _UNIMPL (FFEBAD_INTRINSIC_UNIMPLW).
+
+ Complain about REAL(Z) and AIMAG(Z) (Z is DOUBLE COMPLEX):
+ * bad.def (FFEBAD_INTRINSIC_CMPAMBIG): New diagnostic.
+ * expr.c: Needed #include "intrin.h" anyway.
+ (ffeexpr_token_intrincheck_): New function handles delayed
+ diagnostic for "REAL(REAL(expr)" if next token isn't ")".
+ (ffeexpr_token_arguments_): Do most of the actual checking here.
+ * intrin.h, intrin.c (ffeintrin_fulfill_specific): New
+ argument, check_intrin, to tell caller that intrin is REAL(Z)
+ or AIMAG(Z). All callers updated, mostly to pass NULL in
+ for this.
+ (ffeintrin_check_): Also has new arg check_intrin for same
+ purpose. All callers updated the same way.
+ * intrin.def (FFEINTRIN_impAIMAG): Change return type
+ from "R0" to "RC", to accommodate f2c (and perhaps other
+ non-F90 F77 compilers).
+ * top.h, top.c: New option -fugly-complex.
+
+ New GNU intrinsics REALPART, IMAGPART, and COMPLEX:
+ * com.c (ffecom_expr_intrinsic_): Implement impCOMPLEX
+ and impREALPART here. (specIMAGPART => specAIMAG.)
+ * intrin.def: Add the intrinsics here.
+
+ Rename implementations of VXTIDATE and VXTTIME to IDATEVXT
+ and TIMEVXT, so they sort more consistently:
+ * com.c (ffecom_expr_intrinsic_):
+ * intrin.def:
+
+ Delete intrinsic group `dcp', add `gnu', etc.:
+ * intrin.c (ffeintrin_state_family): FFEINTRIN_familyGNU
+ replaces FFEINTRIN_familyDCP, and gets state from `gnu'
+ group.
+ Get rid of FFEINTRIN_familyF2Z, nobody needs it.
+ Move FFEINTRIN_specDCMPLX from DCP family to FVZ family,
+ as f2c has it.
+ Move FFEINTRIN_specDFLOAT from F2C family to FVZ family.
+ (FFEINTRIN_specZABS, FFEINTRIN_specZCOS, FFEINTRIN_specZEXP,
+ FFEINTRIN_specZLOG, FFEINTRIN_specZSIN, FFEINTRIN_specZSQRT):
+ Move these from F2Z family to F2C family.
+ * intrin.h (FFEINTRIN_familyF2Z, FFEINTRIN_familyDCP): Remove.
+ (FFEINTRIN_familyGNU): Add.
+ * top.h, top.c: Replace `dcp' with `gnu'.
+
+ * com.c (ffecom_expr_intrinsic_): Clean up by collecting
+ simple conversions into one nice, conceptual place.
+ Fix up some intrinsic subroutines (MVBITS, KILL, UMASK) to
+ properly push and pop call temps, to avoid wasting temp
+ registers.
+
+ * g77.c (doit): Toon says variables should be defined
+ before being referenced. Spoilsport.
+
+ * intrin.c (ffeintrin_check_): Now Dave's worried about
+ warnings about uninitialized variables. Okay, so for
+ basic return values 'g' and 's', they _were_
+ uninitialized -- is determinism really _that_ useful?
+
+ * intrin.def (FFEINTRIN_impFGETC): Fix STATUS argument
+ so that it is INTENT(OUT) instead of INTENT(IN).
+
+1997-02-21 Dave Love <d.love@dl.ac.uk>
+
+ * intrin.def, com.c: Support Sun-type `short' and `long'
+ intrinsics. Perhaps should also do Microcruft-style `int2'.
+
+Thu Feb 20 15:16:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_expr_intrinsic_): Clean up indentation.
+ Support SECONDSUBR intrinsic implementation.
+ Rename SECOND to SECONDFUNC for direct support via library.
+
+ * g77.c: Fix to return proper status value to shell,
+ by obtaining it from processes it spawns.
+
+ * intdoc.c: Fix minor typo.
+
+ * intrin.def: Turn SECOND into generic that maps into
+ function and subroutine forms.
+
+ * intrin.def: Make FLOAT and SNGL into specific intrinsics.
+
+ * intrin.def, intrin.h: Change the way DEFGEN and DEFSPEC
+ macros work, to save on verbage.
+
+Mon Feb 17 02:08:04 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ New subsystem to automatically generate documentation
+ on intrinsics:
+ * Make-lang.in ($(srcdir)/f/g77.info,
+ $(srcdir)/f/g77.dvi): Move g77 doc rules around.
+ Add to g77 doc rules the new subsystem.
+ (f77.mostlyclean, f77.maintainer-clean): Also clean up
+ after new doc subsystem.
+ * intdoc.c, intdoc.h: New doc subsystem code.
+ * intrin.h [FFEINTRIN_DOC]: When 1, don't pull in
+ stuff not needed by doc subsystem.
+
+ Improve on intrinsics mechanism to both be more
+ self-documenting and to catch more user errors:
+ * intrin.c (ffeintrin_check_): Recognize new arg-len
+ and arg-rank information, and check it.
+ Move goto and signal indicators to the basic type.
+ Permit reference to arbitrary argument number, not
+ just first argument (for BESJN and BESYN).
+ (ffeintrin_init_0): Check and accept new notations.
+ * intrin.c, intrin.def: Value in COL now identifies
+ arguments starting with number 0 being the first.
+
+ Some minor intrinsics cleanups (resulting from doc work):
+ * com.c (ffecom_expr_intrinsic_): Implement FLUSH
+ directly once again, handle its optional argument,
+ so it need not be a generic (awkward to handle in docs).
+ * intrin.def (BESJ0, BESJ1, BESJN, BESY0, BESY1, BESYN,
+ CHDIR, CHMOD, CTIME, DBESJ0, DBESJ1, DBESJN, DBESY0,
+ DBESY1, DBESYN, DDIM, ETIME, FGETC, FNUM, FPUTC, FSTAT,
+ GERROR, GETCWD, GETGID, GETLOG, GETPID, GETUID, GMTIME,
+ HOSTNM, IDATE, IERRNO, IIDINT, IRAND, ISATTY, ITIME, JIDINT,
+ LNBLNK, LSTAT, LTIME, MCLOCK, PERROR, SRAND, SYMLNK, TTYNAM,
+ UMASK): Change capitalization of initcaps (official) name
+ to be consistent with Burley's somewhat arbitrary rules.
+ (BESJN, BESYN): These have return arguments of same type
+ as their _second_ argument.
+ (FLUSH): Now a specific, not generic, intrinsic, with one
+ optional argument.
+ (FLUSH1): Eliminated.
+ Add arg-len and arg-rank info to several intrinsics.
+ (ITIME): Change argument type from REAL to INTEGER.
+
+Tue Feb 11 14:04:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in (f771): Invocation of Makefile now done
+ with $(srcdir)=gcc to go along with $(VPATH)=gcc.
+ ($(srcdir)/f/runtime/configure,
+ $(srcdir)/f/runtime/libU77/configure): Break these out
+ so spurious triggers of this rule don't happen (as when
+ configure.in is more recent than libU77/configure).
+ (f77.rebuilt): Distinguish source versus build files,
+ so this target can be invoked from build directory and
+ still work.
+ * Makefile.in: This now expects $(srcdir) to be the gcc
+ source directory, not gcc/f, to agree with $(VPATH).
+ Accordingly, $(INCLUDES) has been fixed, various cruft
+ removed, the removal of f771 has been fixed to remove
+ the _real_ f771 (not the one in gcc's parent directory),
+ and so on.
+
+ * lex.c: Part of ffelex_finish_statement_() now done
+ by new function ffelex_prepare_eos_(), so that, in one
+ popular case, the EOS can be prepared while the pointer
+ is at the end of the non-continued line instead of the
+ end of the line that marks no continuation. This improves
+ the appearance of diagnostics substantially.
+
+Mon Feb 10 12:44:06 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in: runtime Makefile's, and include/f2c.h,
+ also depend on f/runtime/configure and f/runtime/libU77/configure.
+
+ Fix various libU77 routines:
+ * com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtMCLOCK,
+ FFECOM_gfrtTIME): These now use INTEGER*8 for time values,
+ for compatibility with systems like Alpha.
+ (FFECOM_gfrtSYSTEM_CLOCK, FFECOM_gfrtTTYNAM): Delete incorrect
+ trailing underscore in routine names.
+ * intrin.c, intrin.def: Support INTEGER*8 return values and
+ arguments ('4'). Change FFEINTRIN_impCTIME, FFEINTRIN_impMCLOCK,
+ and FFEINTRIN_impTIME accordingly.
+ (ffeintrin_is_intrinsic): Don't give caller a clue about
+ form of intrinsic -- shouldn't be needed at this point.
+
+ Cope with generic intrinsics that are subroutines and functions:
+ * com.c (ffecom_finish_symbol_transform_, ffecom_expr_transform_):
+ Don't transform an intrinsic that is not known to be a subroutine
+ or a function. (Maybe someday have to avoid transforming
+ any intrinsic with an undecided or unknown implementation.)
+ * expr.c (ffeexpr_declare_unadorned_,
+ ffeexpr_declare_parenthesized_): Ok to invoke generic
+ intrinsic that has at least one subroutine form as a
+ subroutine.
+ Ok to pass intrinsic as actual arg if it has a known specific
+ intrinsic form that is valid as actual arg.
+ (ffeexpr_declare_parenthesized_): An unknown kind of
+ intrinsic has a paren_type chosen based on context.
+ (ffeexpr_token_arguments_): Build funcref/subrref based
+ on context, not on kind of procedure being called.
+ * intrin.h, intrin.c (ffeintrin_is_intrinsic): Undo changes of
+ Tue Feb 4 23:12:04 1997 by me, change all callers to leave
+ intrinsics as FFEINFO_kindNONE at this point. (Some callers
+ also had unused variables deleted as a result.)
+
+ Enable all intrinsic groups (especially f90 and vxt):
+ * target.h (FFETARGET_defaultSTATE_DCP, FFETARGET_defaultSTATE_F2C,
+ FFETARGET_defaultSTATE_F90, FFETARGET_defaultSTATE_MIL,
+ FFETARGET_defaultSTATE_UNIX, FFETARGET_defaultSTATE_VXT):
+ Delete these macros, let top.c set them directly.
+ * top.c (ffeintrinsic_state_dcp_, ffe_intrinsic_state_f2c_,
+ ffe_intrinsic_state_f90_, ffe_intrinsic_state_mil_,
+ ffe_intrinsic_state_unix_, ffe_intrinsic_state_vxt_):
+ Enable all these directly.
+
+Sat Feb 8 03:21:50 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * g77.c: Incorporate recent changes to ../gcc.c.
+ For version magic (e.g. `g77 -v'), instead of compiling
+ /dev/null, write, compile, run, and then delete a small
+ program that prints the version numbers of the three
+ components of libf2c (libF77, libI77, and libU77),
+ so we get this info with bug reports.
+ Also, this change reduces the chances of accidentally
+ linking to an old (complex-alias-problem) libf2c.
+ Fix `-L' so the argument is expected in `-Larg'.
+
+ * com.h (FFECOM_f2cLONGINT): For INTEGER*8 support in f2c.h,
+ dynamically determine proper type here, instead of
+ assuming `long long int' is correct.
+
+Tue Feb 4 23:12:04 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Add libU77 library from Dave Love <d.love@dl.ac.uk>:
+ * Make-lang.in (f77-runtime): Depend on new Makefile.
+ (f/runtime/libU77/Makefile): New rule.
+ Also configure libU77.
+ ($(srcdir)/f/runtime/configure: Use Makefile.in,
+ so configuration doesn't have to have happened.
+ (f77.mostlyclean, f77.clean, f77.distclean,
+ f77.maintainer-clean): Some fixups here, but more work
+ needed.
+ (RUNTIMESTAGESTUFF): Add libU77's config.status.
+ (LIBU77STAGESTUFF, f77.stage1, f77.stage2, f77.stage3,
+ f77.stage4): New macro, appropriate uses added.
+ * com-rt.def: Add libU77 procedures.
+ * com.c (ffecom_f2c_ptr_to_integer_type_node,
+ ffecom_f2c_ptr_to_real_type_node): New type nodes.
+ (FFECOM_rttypeCHARACTER_): New type of run-time function.
+ (ffecom_char_args_): Handle CHARACTER*n intrinsics
+ where n != 1 here, instead of in ffecom_expr_intrinsic_.
+ (ffecom_expr_intrinsic_): New code to handle new
+ intrinsics.
+ In particular, change how FFEINTRIN_impFLUSH is handled.
+ (ffecom_make_gfrt_): Handle new type of run-time function.
+ (ffecom_init_0): Initialize new type nodes.
+ * config-lang.in: New libU77 directory.
+ * intrin.h, intrin.c (ffeintrin_is_intrinsic): Handle
+ potential generic for subroutine _and_ function
+ specifics via two new arguments. All callers changed.
+ Properly ignore deleted/disabled intrinsics in resolving
+ generics.
+ (ffeintrin_check_, ffeintrin_init_0): Handle CHARACTER intrinsics of (*)
+ length.
+ * intrin.def: Permission granted by FSF to place this in
+ public domain, which will allow it to serve as source
+ for both g77 program and its documentation.
+ Add libU77 intrinsics.
+ (FLUSH): Now a generic, not specific, intrinsic.
+ (DEFIMP): Now support return modifier for CHARACTER intrinsics.
+
+ * com-rt.def (FFECOM_gfrtDIM, FFECOM_gfrtERF,
+ FFECOM_gfrtERFC, FFECOM_gfrtEXP, FFECOM_gfrtSIGN,
+ FFECOM_gfrtSIN, FFECOM_gfrtSINH, FFECOM_gfrtTAN,
+ FFECOM_gfrtTANH, FFECOM_gfrtPOW_RI): Change "&r" to "&f".
+
+Sat Feb 1 12:15:09 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Version 0.5.19.1 released.
+
+ * com.c (ffecom_expr_, ffecom_expr_intrinsic_,
+ ffecom_tree_divide_): FFECOM_gfrtPOW_ZI,
+ FFECOM_gfrtCONJG, FFECOM_gfrtDCONJG,
+ FFECOM_gfrtCCOS, FFECOM_gfrtCDCOS,
+ FFECOM_gfrtCLOG, FFECOM_gfrtCDLOG,
+ FFECOM_gfrtCSIN, FFECOM_gfrtCDSIN,
+ FFECOM_gfrtCSQRT, FFECOM_gfrtCDSQRT,
+ FFECOM_gfrtDIV_CC, FFECOM_gfrtDIV_ZZ: These all require
+ result to _not_ overlap one or more inputs.
+
+Sat Feb 1 00:25:55 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_init_0): Do internal checks only if
+ -fset-g77-defaults not specified.
+
+ Fix %LOC(), LOC() to return sufficiently wide type:
+ * com.h, com.c (ffecom_pointer_kind_, ffecom_label_kind_,
+ ffecom_pointer_kind(), ffecom_label_kind()): New globals
+ and accessor macros hold kind for integer pointers on target
+ machine.
+ (ffecom_init_0): Determine narrowest INTEGER type that
+ can hold a pointer (usually INTEGER*4 or INTEGER*8),
+ store it in ffecom_pointer_kind_, etc.
+ * expr.c (ffeexpr_cb_end_loc_): Use right type for %LOC().
+ * intrin.c (ffeintrin_check_, ffeintrin_init_0): Support
+ new 'p' kind for type of intrinsic.
+ * intrin.def (FFEINTRIN_impLOC): Returns "Ip" instead of "I1",
+ so LOC() type is correct for target machine.
+
+ Support -fugly-assign:
+ * lang-options.h, top.h, top.c (ffe_decode_option):
+ Accept -fugly-assign and -fno-ugly-assign.
+ * com.c (ffecom_expr_): Handle -fugly-assign.
+ * expr.c (ffeexpr_finished_): Check right type for ASSIGN
+ contexts.
+
+Fri Jan 31 14:30:00 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Remove last vestiges of -fvxt-not-f90:
+ * stb.c (ffestb_R10012_, ffestb_R10014_, ffestb_V0201_):
+ top.c, top.h:
+
+Fri Jan 31 02:13:54 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * top.c (ffe_decode_option): Warn if -fugly is specified,
+ it'll go away soon.
+
+ * symbol.h: No need to #include "bad.h".
+
+ Reorganize features from -fvxt-not-f90 to -fvxt:
+ * lang-options.h, top.h, top.c:
+ Accept -fvxt and -fno-vxt, but not -fvxt-not-f90 or -ff90-not-vxt.
+ Warn if the latter two are used.
+ * expr.c (ffeexpr_nil_rhs_): Double-quote means octal constant.
+ (ffeexpr_token_rhs_): Double-quote means octal constant.
+ * target.h (FFETARGET_defaultIS_VXT_NOT_90): Delete macro
+ definition, no longer needed.
+
+ Make some -ff90 features the default:
+ * data.c (ffedata_value): DATA implies SAVE.
+ * src.h (ffesrc_is_name_noninit): Underscores always okay.
+
+ Fix up some more #error directives by quoting their text:
+ * bld.c (ffebld_constant_is_zero):
+ * target.h:
+
+Sat Jan 18 18:22:09 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * g77.c (lookup_option, main): Recognize `-Xlinker',
+ `-Wl,', `-l', `-L', `--library-directory', `-o',
+ `--output'.
+ (lookup_option): Don't depend on SWITCH_TAKES_ARG
+ being correct, it might or might not have `-x' in
+ it depending on host.
+ Return NULL argument if it would be an empty string.
+ (main): If no input files (by gcc.c's definition)
+ but `-o' or `--output' specified, produce diagnostic
+ to avoid overwriting output via gcc.
+ Recognize C++ `+e' options.
+ Treat -L as another non-magical option (like -B).
+ Don't append_arg `-x' twice.
+
+Fri Jan 10 23:36:00 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * top.c [BUILT_FOR_270] (ffe_decode_option): Make
+ -fargument-noalias-global the default.
+
+Fri Jan 10 07:42:27 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Enable inlining of previously-compiled program units:
+ * com.c (ffecom_do_entry_, ffecom_start_progunit_):
+ Register new public function in ffeglobal database.
+ (ffecom_sym_transform_): Any GLOBAL or potentially GLOBAL
+ symbol should be looked up in ffeglobal database and
+ that tree node used, if found. That way, gcc knows
+ the references are to those earlier definitions, so it
+ can emit shorter branches/calls, inline, etc.
+ (ffecom_transform_common_): Minor change for clarity.
+ * expr.c (ffeexpr_sym-lhs_call_, ffeexpr_sym_lhs_extfunc_,
+ ffeexpr_sym_rhs_actualarg_, ffeexpr_paren_rhs_let_,
+ ffeexpr_token_funsubstr_): Globalize symbol as needed.
+ * global.c (ffeglobal_promoted): New function to look up
+ existing local symbol in ffeglobal database.
+ * global.h: Declare new function.
+ * name.h (ffename_token): New macro, plus alphabetize.
+ * stc.c (ffestc_R1207_item): Globalize EXTERNAL symbol.
+ * stu.c (ffestu_sym_end_transition, ffestu_sym_exec_transition):
+ Globalize symbol as needed.
+ * symbol.h, symbol.c (ffesymbol_globalize): New function.
+
+Thu Jan 9 14:20:00 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * ste.c (ffeste_R809): Produce a diagnostic for SELECT CASE
+ on CHARACTER type, instead of crashing.
+
+Thu Jan 9 00:52:45 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * stc.c (ffestc_order_entry_, ffestc_order_format_,
+ ffestc_R1226): Allow ENTRY and FORMAT before IMPLICIT
+ NONE, by having them transition only to state 1 instead
+ of state 2 (which is disallowed by IMPLICIT NONE).
+
+Mon Jan 6 22:44:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Fix AXP bug found by Rick Niles (961201-1.f):
+ * com.c (ffecom_init_0): Undo my 1996-05-14 change, as
+ it is incorrect and prevented easily finding this bug.
+ * target.h [__alpha__] (ffetargetReal1, ffetargetReal2):
+ Use int instead of long.
+ (ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r1_,
+ ffetarget_cvt_r2_to_rv_, ffetarget_cvt_rv_to_r2_):
+ New functions that intercede for callers of
+ REAL_VALUE_(TO|UNTO)_TARGET_(SINGLE|DOUBLE).
+ All callers changed, and damaging casts to (long *) removed.
+
+Sun Jan 5 03:26:11 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in (g77, g77-cross): Depend on both g77.c and
+ zzz.c, in $(srcdir)/f/.
+
+ Better design for -fugly-assumed:
+ * stc.c (ffestc_R501_item, ffestc_R524_item,
+ ffestc_R547_item_object): Pass new is_ugly_assumed flag.
+ * stt.c, stt.h (ffestt_dimlist_as_expr,
+ ffestt_dimlist_type): New is_ugly_assumed flag now
+ controls whether "1" is treated as "*".
+ Don't treat "2-1" or other collapsed constants as "*".
+
+Sat Jan 4 15:26:22 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * stb.c (ffestb_R10012_): Don't confirm on FORMAT(A,)
+ or even FORMAT(A,,B), as R1229 only warns about the
+ former currently, and this seems reasonable.
+
+ Improvements to diagnostics:
+ * sta.c (ffesta_second_): Don't add any ffestb parsers
+ unless they're specifically called for.
+ Set up ffesta_tokens[0] before calling ffestc_exec_transition,
+ else stale info might get used.
+ (ffesta_save_): Do a better job picking which parser to run
+ after running all parsers with no confirmed possibles.
+ (FFESTA_maxPOSSIBLES_): Decrease from 100 now that so few
+ possibles are ever on the list at a given time.
+ (struct _ffesta_possible): Add named attribute.
+ (ffesta_add_possible_exec_, ffesta_add_possible_nonexec_):
+ Make these into macros that call a single function that now
+ sets the named attribute.
+ (ffesta_add_possible_unnamed_exec_,
+ ffeseta_add_possible_unnamed_nonexec_): New macros.
+ (ffesta_second_): Designate unnamed possibles as
+ appropriate.
+ * stb.c (ffestb_R1229, ffestb_R12291_): Use more general
+ diagnostic, so things like "POINTER (FOO, BAR)" are
+ diagnosed as unrecognized statements, not invalid statement
+ functions.
+ * stb.h, stb.c (ffestb_unimplemented): Remove function.
+
+1996-12-30 Dave Love <d.love@dl.ac.uk>
+
+ * com.c: #include libU77/config.h
+ (ffecom_f2c_ptr_to_integer_type_node,
+ ffecom_f2c_ptr_to_integer_type_node): New variables.
+ (ffecom_init_0): Use them.
+ (ffecom_expr_intrinsic_): Many news cases for libU77 intrinsics.
+
+ * com-rt.def: New definitions for libU77.
+ * intrin.def: Likewise. Also correct ftell arg spec.
+
+ * Makefile.in (f/runtime/libU77/config.h): New target for com.c
+ dependency.
+ * Make-lang.in (f771): Depend on f/runtime/Makefile for the above.
+
+Sat Dec 28 12:28:29 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * stt.c (ffestt_dimlist_type): Treat ([...,]1) in dimlist
+ as ([...,]*) if -fugly-assumed, so assumed-size array
+ detected early enough.
+
+Thu Dec 19 14:01:57 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * target.h (FFETARGET_REAL_VALUE_FROM_INT_): Conditionalize
+ definition on BUILT_FOR_280, not BUILT_WITH_280, since
+ the name of the macro was (properly) changed since 0.5.19.
+
+ Fix warnings/errors resulting from ffetargetOffset becoming
+ `long long int' instead of `unsigned long' as of 0.5.19,
+ while ffebitCount remains `unsigned long':
+ * bld.c (ffebld_constantarray_dump): Avoid warnings by
+ using loop var of appropriate type, and using casts.
+ * com.c (ffecom_expr_): Use right type for loop var.
+ (ffecom_sym_transform_, ffecom_transform_equiv_):
+ Cast to right type in assertions.
+ * data.c (ffedata_gather_, ffedata_value_): Cast to right
+ type in assertions and comparisons.
+
+Wed Dec 18 12:07:11 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Patch from Alexandre Oliva <oliva@dcc.unicamp.br>:
+ * Makefile.in (all.indirect): Don't pass -bbigtoc option
+ to GNU ld.
+
+ Cope with new versions of gcc:
+ * com.h (BUILT_FOR_280): New macro.
+ * com.c (ffecom_ptr_to_expr): Conditionalize test of
+ OFFSET_REF.
+ (ffecom_build_complex_constant_): Conditionalize calling
+ sequence for build_complex.
+
+Sat Dec 7 07:15:17 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Version 0.5.19 released.
+
+Fri Dec 6 12:23:55 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * g77.c: Default to assuming "f77" is in $LANGUAGES, since
+ the LANGUAGE_F77 macro isn't defined by anyone anymore (but
+ might as well leave the no-f77 code in just in case).
+ * Make-lang.in (g77, g77-cross): Don't define LANGUAGE_F77
+ anymore.
+
+1996-12-06 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in (g77, g77-cross): Revert to building `g77' or not
+ conditional on `f77' in LANGUAGES.
+
+Wed Dec 4 13:08:44 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in (g77, g77-cross): No libs or lib dependencies
+ in case where "f77" is not in $LANGUAGES.
+
+ * lex.c (ffelex_image_char_, ffelex_file_fixed,
+ ffelex_file_free): Fixes to properly handle lines with
+ null character, and too-long lines as well.
+
+ * lex.c: Call ffebad_start_msg_lex instead of
+ ffebad_start_msg throughout.
+
+Sun Dec 1 21:19:55 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Fix-up for 1996-11-25 changes:
+ * com.c (ffecom_member_phase2_): Subtract out 0 offset for
+ elegance and consistency with EQUIVALENCE aggregates.
+ (ffecom_sym_transform_): Ditto for LOCAL/COMMON, and
+ ensure we get the same parent storage area.
+ * data.c (ffedata_gather_, ffedata_value_): Subtract out
+ aggregate offset.
+
+Wed Nov 27 13:55:57 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * proj.h: Quote the text of the #error message, to avoid
+ strange-looking diagnostics from non-gcc ANSI compilers.
+
+ * top.c: Make -fno-debug-kludge the default.
+
+Mon Nov 25 20:13:45 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Provide more info on EQUIVALENCE mismatches:
+ * bad.def (FFEBAD_EQUIV_MISMATCH): More detailed message.
+ * equiv.c (ffeequiv_layout_local_, ffeequiv_layout_cblock):
+ More details for FFEBAD_EQUIV_MISMATCH.
+
+ Fix problem with EQUIVALENCE handling:
+ * equiv.c (ffeequiv_layout_local_): Redesign algorithm --
+ old one was broken, resulting in rejection of good code.
+ (ffeequiv_offset_): Add argument, change callers.
+ Clean up the code, fix up the (probably unused) negative-value
+ case for SYMTER.
+ * com.c (ffecom_sym_transform_): For local EQUIVALENCE
+ member, subtract out aggregate offset (which is <= 0).
+
+Thu Nov 21 12:44:56 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Change type of ffetargetOffset from `unsigned long' to `long long':
+ * bld.c (ffebld_constantarray_dump): Change printf formats.
+ * storag.c (ffestorag_dump): Ditto.
+ * symbol.c (ffesymbol_report): Ditto.
+ * target.h (ffetargetOffset_f): Ditto and change type itself.
+
+ Handle situation where list of languages does not include f77:
+ * Make-lang.in: Define LANGUAGE_F77 to 1 only if `f77' is in
+ the $LANGUAGES macro for the build.
+ * g77.c: Compile to a (nearly) no-op program if LANGUAGE_F77
+ is not defined to 1.
+
+ Fixes to delay confirmation of READ, WRITE, and GOTO statements
+ so the corresponding assignments to same-named CHAR*(*) arrays
+ work:
+ * stb.c (ffestb_R90915_, ffestb_91014_): New functions.
+ (ffestb_goto3_, ffestb_goto5_): Move confirmation from 3 to 5
+ for the OPEN_PAREN case.
+ (ffestb_R9091_, ffestb_R9094_, ffestb_R90913_, ffestb_R90914_,
+ ffestb_R91012_, ffestb_R91013_): Use new functions, and confirm
+ except for the OPEN_PAREN case.
+
+ Fixes to not confirm declarations with an open paren where
+ an equal sign or other assignment-like token might be, so the
+ corresponding assignments to same-named CHAR*(*) arrays work:
+ (ffestb_decl_entsp_5_): Move assertion so we crash on that first,
+ if it turns out to be wrong, before the less-debuggable crash
+ on mistaken confirmation.
+ (ffestb_decl_entsp_6_, ffestb_decl_entsp_7_, ffestb_decl_entsp_8_):
+ Include OPEN_PAREN in list of assignment-only tokens.
+
+ Fix more diagnosed-crash bugs:
+ * stu.c (ffestu_sym_end_transition): ANY-ize an adjustable array
+ with bad dimension expressions even if still stateUNCERTAIN.
+ (ffestu_symter_end_transition_, ffestu_symter_exec_transition_):
+ Return TRUE for opANY as well.
+ For code elegance, move opSYMTER case into first switch.
+
+1996-11-17 Dave Love <d.love@dl.ac.uk>
+
+ * lex.c: Fix last change.
+
+1996-11-14 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in, config-lang.in: Remove the (broken) libU77 stuff,
+ pending 0.5.20.
+
+Thu Nov 14 15:40:59 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * bad.def (FFEBAD_UNIMPL_STMT): Explain that invalid
+ intrinsic references can trigger this message, too.
+
+1996-11-12 Dave Love <d.love@dl.ac.uk>
+
+ * lex.c: Declare dwarfout routines.
+
+ * config-lang.in: Sink grep o/p.
+
+Mon Nov 11 14:21:13 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * g77.c (main): Might as well print version number
+ for --verbose as well.
+
+Thu Nov 7 18:41:41 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * expr.c, lang-options.h, target.h, top.c, top.h: Split out
+ remaining -fugly stuff into -fugly-logint and -fugly-comma,
+ leaving -fugly as simply a `macro' that expands into other
+ options, and eliminate defaults for some of the ugly stuff
+ in target.h.
+
+ * Make-lang.in (gcc-cross): Compile zzz.c, not version.o (!),
+ in to get version info for this target.
+
+ * config-lang.in: Test for GBE patch application based
+ on whether 2.6.x or 2.7.x GBE is detected.
+
+Wed Nov 6 14:19:45 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in (g77): Compile zzz.c in to get version info.
+ * g77.c: Add support for --help and --version.
+
+ * g77.c (lookup_option): Short-circuit long-winded tests
+ when second char is not hyphen, just to save a spot of time.
+
+Sat Nov 2 13:50:31 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * intrin.def: Add FTELL and FSEEK intrinsics, plus new
+ `g' codes for alternate-return (GOTO) arguments.
+ * intrin.c (ffeintrin_check_): Support `g' codes.
+ * com-rt.def: Add ftell_() and fseek_() to database.
+ * com.c (ffecom_expr_intrinsic_): Ditto. Also, let each
+ subroutine intrinsic decide for itself what to do with
+ tree_type, the default being NULL_TREE once again (so
+ ffecom_call_ doesn't think it's supposed to cast the
+ function call to the type in the fall-through case).
+
+ * ste.c (ffeste_R909_finish): Don't special-case list-directed
+ I/O, now that libf2c can return non-zero status codes.
+ (ffeste_R910_finish): Ditto.
+ (ffeste_io_call_): Simplify logic.
+ (ffeste_io_impdo_):
+ (ffeste_subr_beru_):
+ (ffeste_R904):
+ (ffeste_R907):
+ (ffeste_R909_start):
+ (ffeste_R909_item):
+ (ffeste_R909_finish):
+ (ffeste_R910_start):
+ (ffeste_R910_item):
+ (ffeste_R910_finish):
+ (ffeste_R911_start):
+ (ffeste_R923A): Ditto all the above.
+
+Thu Oct 31 20:56:28 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * config-lang.in, Make-lang.in: Rename flag file
+ build-u77 to build-libu77, for consistency with
+ install-libf2c and such.
+
+ * config-lang.in: Don't complain about failure to patch
+ if pre-2.7.0 gcc is involved (since our patch for that
+ doesn't add support for tooning).
+
+Sat Oct 26 05:56:51 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * bad.def (FFEBAD_TYPELESS_TOO_LARGE): Remove this
+ unused and redundant diagnostic.
+
+Sat Oct 26 00:45:42 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * target.c (ffetarget_integerhex): Fix dumb bug.
+
+1996-10-20 Dave Love <d.love@dl.ac.uk>
+
+ * gbe/2.7.2.1.diff: New file.
+
+ * Makefile.in (F771_LDFLAGS): Add -bbigtoc for AIX4.1 up, suggested by
+ endo@material.tohoku.ac.jp [among others!].
+
+Sat Oct 19 03:11:14 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * bad.def, bld.c, bld.h, expr.c, lang-options.h, target.c,
+ target.h, top.c, top.h (ffebld_constant_new_integerbinary,
+ ffebld_constant_new_integerhex, ffebld_constant_new_integeroctal,
+ ffeexpr_token_name_apos_name_, ffetarget_integerbinary,
+ ffetarget_integerhex, ffetarget_integeroctal): Support
+ new -fno-typeless-boz option with new functions, mods to
+ existing octal-handling functions, new macros, new error
+ messages, and so on.
+
+ * com.c, lang-options.h, top.c, top.h (ffecom_notify_primary_entry):
+ Print program unit name on stderr if -fno-silent (new option).
+
+ * lang-options.h, top.c, top.h, stt.c (ffestt_dimlist_as_expr):
+ Treat ([...,]1) in dimlist as ([...,]*) if -fugly-assumed
+ (new option).
+
+ * lang-options.h: Comment out options duplicated in gcc/toplev.c,
+ because, somehow, having them commented in and building on my
+ DEC Alpha results in a cc1 that always segfaults, and gdb that
+ also segfaults whenever it debugs it up to init_lex() calling
+ xmalloc() or so.
+
+Thu Oct 17 00:39:27 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * stb.c (ffestb_R10013_): Don't change meaning of .sign until
+ after previous meaning/value used to set sign of value
+ (960507-1.f).
+
+Sun Oct 13 22:15:23 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * top.c (ffe_decode_option): Don't set back-end flags
+ that are nonexistent prior to gcc 2.7.0.
+
+Sun Oct 13 12:48:45 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (convert): Don't convert emulated complex expr to
+ real (via REALPART_EXPR) if the target type is (emulated)
+ complex.
+
+Wed Oct 2 21:57:12 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_debug_kludge_): Set DECL_IN_SYSTEM_HEADER so
+ -Wunused doesn't complain about these manufactured decls.
+ (ffecom_expr_): Ditto, for original (non-ASSIGN'ed) variable.
+ (ffecom_transform_equiv_): Clear DECL_IGNORED_P for aggregate
+ area so it shows up as a debug-accessible symbol.
+ (pushdecl): Default for "invented" identifiers (a g77-specific
+ concept for now) is that they are artificial, in system header,
+ ignored for debugging purposes, used, and (for types) suppressed.
+ This ought to be overkill.
+
+Fri Sep 27 23:13:07 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Support
+ one-trip DO loops (F66-style).
+ * lang-options.h, top.c, top.h (-fonetrip): New option.
+
+Thu Sep 26 00:18:40 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_debug_kludge_): New function.
+ (ffecom_sym_transform_): Use new function for COMMON and EQUIVALENCE
+ members.
+
+ * lang-options.h, top.c, top.h (-fno-debug-kludge):
+ New option.
+
+1996-09-24 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in (include/f2c.h):
+ Remove dependencies on xmake_file and tmake_file.
+ They expand inconsistently in 2.8 c.f. 2.7; $(GCC_PARTS) depends on
+ them anyhow.
+
+1996-09-22 Dave Love <d.love@dl.ac.uk>
+
+ * config-lang.in: Add --enable-libu77 option handling.
+
+ * Make-lang.in:
+ Conditionally add --enable-libu77 when running runtime configure.
+ Define LIBU77STAGESTUFF and use it in relevant rules.
+
+1996-08-21 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in (f77-runtime):
+ `stmp-hdrs' should have been `stmp-headers'.
+
+1996-08-20 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in (f77-runtime):
+ Depend on stmp-hdrs, not stmp-int-hdrs, since libF77
+ needs float.h.
+
+Sat Jun 22 18:17:11 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_tree_divide_): Fix RECORD_TYPE case to
+ look at type of first field, properly, to determine
+ whether to call c_div or z_div.
+
+Tue Jun 4 04:27:18 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_build_complex_constant_): Explicitly specify
+ TREE_PURPOSE.
+ (ffecom_expr_): Fix thinko.
+ (ffecom_2): For COMPLEX_EXPR, explicitly specify TREE_PURPOSE.
+
+Mon May 27 16:23:43 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Changes to optionally avoid gcc's back-end complex support:
+ * com.c (ffecom_stabilize_aggregate_): New function.
+ (ffecom_convert_to_complex_): New function.
+ (ffecom_make_complex_type_): New function.
+ (ffecom_build_complex_constant_): New function.
+ (ffecom_expr_): For opCONVERT of non-COMPLEX to COMPLEX,
+ don't bother explicitly converting to the subtype first,
+ because gcc does that anyway, and more code would have
+ to be added to find the subtype for the emulated-complex
+ case.
+ (ffecom_f2c_make_type_): Use ffecom_make_complex_type_
+ instead of make_node etc. to make a complex type.
+ (ffecom_1, ffecom_2): Translate operations on COMPLEX operands
+ to appropriate operations when emulating complex.
+ (ffecom_constantunion): Use ffecom_build_complex_constant_
+ instead of build_complex to build a complex constant.
+ (ffecom_init_0): Change point at which types are laid out
+ for improved consistency.
+ Use ffecom_make_complex_type_ instead of make_node etc.
+ to make a complex type.
+ Always calculate storage sizes from TYPE_SIZE, never TYPE_PRECISION.
+ (convert): Use e, not expr, since we've copied into that anyway.
+ For RECORD_TYPE cases, do emulated-complex conversions.
+ (ffecom_f2c_set_lio_code_): Always calculate storage sizes
+ from TYPE_SIZE, never TYPE_PRECISION.
+ (ffecom_tree_divide_): Allow RECORD_TYPE to also be handled
+ by run-time library.
+ (ffecom_expr_intrinsic_): Handle possible RECORD_TYPE as argument
+ to AIMAG intrinsic.
+
+ * top.h, top.c, lang-options.h: Support new -f(no-)emulate-complex option.
+
+ * com.c (ffecom_sym_transform_): Clarify and fix typos in comments.
+
+Mon May 20 02:06:27 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * target.h: Use new REAL_VALUE_UNTO_TARGET_* macros instead
+ of REAL_VALUE_FROM_TARGET_DOUBLE and _SINGLE.
+ Explicitly use long instead of HOST_WIDE_INT for emulation
+ of ffetargetReal1 and ffetargetReal2.
+
+1996-05-20 Dave Love <d.love@dl.ac.uk>
+
+ * config-lang.in:
+ Test for patch being applied with flag_move_all_movables in toplev.c.
+
+ * install.texi (Patching GNU Fortran):
+ Mention overriding X_CFLAGS rather than
+ editing proj.h on SunOS4.
+
+ * Make-lang.in (F77_FLAGS_TO_PASS):
+ Add X_CFLAGS (convenient for SunOS4 kluge, in
+ particular).
+ (f77.{,mostly,dist}clean): Reorder things, in particular not to delete
+ Makefiles too early.
+
+ * g77.c (DEFAULT_SWITCH_TAKES_ARG): Define a la gcc.c in the
+ current GCC snapshot.
+
+Tue May 14 00:24:07 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Changes for DEC Alpha AXP support:
+ * com.c (ffecom_init_0): REAL_ARITHMETIC means internal
+ REAL/DOUBLE PRECISION might well have a different size
+ than the compiled type, so don't crash if this is the
+ case.
+ * target.h: Use `int' for ffetargetInteger1,
+ ffetargetLogical1, and magical tests. Set _f format
+ strings accordingly.
+
+Tue Apr 16 14:08:28 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * top.c (ffe_decode_option): -Wall no longer implies
+ -Wsurprising.
+
+Sat Apr 13 14:50:06 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_char_args_): If item is error_mark_node,
+ set *length that way, too.
+
+ * com.c (ffecom_expr_power_integer_): If either operand
+ is error_mark_node, return that.
+
+ * com.c (ffecom_intrinsic_len_): If item is error_mark_node,
+ return that for length.
+
+ * expr.c (ffeexpr_declare_unadorned_,
+ ffeexpr_declare_parenthesized_): Instead of crashing
+ on unexpected contexts, produce a diagnostic.
+
+ * intrin.c (ffeintrin_check_), intrin.def (impSIGNAL):
+ Allow procedure as second arg to SIGNAL intrinsic.
+
+ * stu.c (ffestu_symter_end_transition_): New function.
+ (ffestu_symter_exec_transition_): Return bool arg.
+ Always transition symbol (don't inhibit when !whereNONE).
+ (ffestu_sym_end_transition): If DUMMY/LOCAL arg has any
+ opANY exprs in its dimlist, diagnose it so it doesn't
+ make it through to later stages that try to deal with
+ dimlist stuff.
+ (ffestu_sym_exec_transition): If sym has any opANY exprs
+ in its dimlist, diagnose it so it becomes opANY itself.
+
+ * symbol.c (ffesymbol_error): If token arg is NULL,
+ just ANY-ize the symbol -- don't produce diagnostic.
+
+Mon Apr 1 10:14:02 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Version 0.5.18 released.
+
+Mon Mar 25 20:52:24 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_expr_power_integer_): Don't generate code
+ that compares COMPLEX (or, as it happens, REAL) via "LT_EXPR",
+ since the back end crashes on that. (This code would never
+ be executed anyway, but the test that avoids it has now been
+ translated to control whether the code gets generated at all.)
+ Fixes 960323-3.f.
+
+ * com.c (ffecom_type_localvar_): Handle variable-sized
+ dimension bounds expressions here, so they get calculated
+ and saved on procedure entry. Fixes 960323-4.f.
+
+ * com.c (ffecom_notify_init_symbol): Symbol has no init
+ info at all if only zeros have been used to initialize it.
+ Fixes 960324-0.f.
+
+ * expr.c, expr.h (ffeexpr_type_combine): Renamed from
+ ffeexpr_type_combine_ and now a public procedure; last arg now
+ a token, instead of an internal structure used to extract a token.
+ Now allows the outputs to be aliased with the inputs.
+ Now allows a NULL token to mean "don't report error".
+ (ffeexpr_reduced_bool2_, ffeexpr_reduced_eqop2_,
+ ffeexpr_reduced_math2_, ffeexpr_reduced_power_,
+ ffeexpr_reduced_relop2_): Handle new calling sequence for
+ ffeexpr_type_combine.
+ * (ffeexpr_convert): Don't put an opCONVERT node
+ in just because the size is unknown; all downstream code
+ should be able to deal without it being there anyway, and
+ getting rid of it allows new intrinsic code to more easily
+ combine types and such without generating bad code.
+ * info.c, info.h (ffeinfo_kindtype_max): Rewrite to do
+ proper comparison of size of types, not just comparison
+ of their internal kind numbers (so I2.eq.I1 doesn't promote
+ I1 to I2, rather the other way around).
+ * intrin.c (ffeintrin_check_): Combine types of arguments
+ in COL a la expression handling, for greater flexibility
+ and permissiveness (though, someday, -fpedantic should
+ report use of this kind of thing).
+ Make sure Hollerith/typeless where CHARACTER expected is
+ rejected. This all fixes 960323-2.f.
+
+ * ste.c (ffeste_begin_iterdo_): Fix some more type conversions
+ so INTEGER*2-laden DO loops don't crash at compile time on
+ certain machines. Believed to fix 960323-1.f.
+
+ * stu.c (ffestu_sym_end_transition): Certainly reject
+ whereDUMMY not in any dummy list, whether stateUNCERTAIN
+ or stateUNDERSTOOD. Fixes 960323-0.f.
+
+Tue Mar 19 13:12:40 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * data.c (ffedata_value): Fix crash on opANY, and simplify
+ the code at the same time.
+
+ * Make-lang.in (f77-runtime): Also depends on lib[FI]77/Makefile...
+ (include/f2c.h...): ...which in turn depend on */Makefile.in.
+ (f77.rebuilt): Rebuild runtime stuff too.
+
+ * intrin.c (ffeintrin_check_): Accommodate TYPELESS/HOLLERITH
+ types, convert args as necessary, etc.
+
+ * expr.c (ffeexpr_convert): Fix test for TYPELESS/HOLLERITH
+ to obey the docs; crash if no source token when error.
+ (ffeexpr_collapse_convert): Crash if no token when error.
+
+Mon Mar 18 15:51:30 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_init_zero_): Renamed from
+ ffecom_init_local_zero_; now handles top-level
+ (COMMON) initializations too.
+
+ * bld.c (ffebld_constant_is_zero):
+ * com.c (ffecom_symbol_transform_, ffecom_sym_transform_assign_,
+ ffecom_transform_common_, ffecom_transform_equiv_):
+ * data.c:
+ * equiv.c:
+ * equiv.h:
+ * lang-options.h:
+ * stc.c:
+ * storag.c:
+ * storag.h:
+ * symbol.c:
+ * symbol.h:
+ * target.c:
+ * target.h:
+ * top.c:
+ * top.h: All of this is mostly housekeeping-type changes
+ to support -f(no-)zeros, i.e. not always stuff zero
+ values into the initializer fields of symbol/storage objects,
+ but still track that they have been given initial values.
+
+ * bad.def: Fix wording for DATA-related diagnostics.
+
+ * com.c (ffecom_sym_transform_assign_): Don't check
+ any EQUIVALENCE stuff for local ASSIGN, the check was
+ bad (crashing), and it's not necessary, anyway.
+
+ * com.c (ffecom_expr_intrinsic_): For MAX and MIN,
+ ignore null arguments as far arg[123], and fix handling
+ of ANY arguments. (New intrinsic support now allows
+ spurious trailing null arguments.)
+
+ * com.c (ffecom_init_0): Add HOLLERITH (unsigned)
+ equivalents for INTEGER*2, *4, and *8, so shift intrinsics
+ and other things that need unsigned versions of signed
+ types work.
+
+Sat Mar 16 12:11:40 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * storag.c (ffestorag_exec_layout): Treat adjustable
+ local array like dummy -- don't create storage object.
+ * com.c (ffecom_sym_transform_): Allow for NULL storage
+ object in LOCAL case (adjustable array).
+
+Fri Mar 15 13:09:41 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_sym_transform_): Allow local symbols
+ with nonconstant sizes (adjustable local arrays).
+ (ffecom_type_localvar_): Allow dimensions with nonconstant
+ component (adjustable local arrays).
+ * expr.c: Various minor changes to handle adjustable
+ local arrays (a new case of stateUNCERTAIN).
+ * stu.c (ffestu_sym_end_transition,
+ ffestu_sym_exec_transition): Ditto.
+ * symbol.def: Update docs to reflect these changes.
+
+ * com.c (ffecom_expr_): Reduce space/time needed for
+ opACCTER case by handling it here instead of converting
+ it to opARRTER earlier on.
+ (ffecom_notify_init_storage): Don't convert ACCTER to ARRTER.
+ (ffecom_notify_init_symbol): Ditto.
+
+ * com.c (ffecom_init_0): Crash and burn if any of the types'
+ sizes, according to the GBE, disagrees with the sizes of
+ the FFE's internal implementation. This might catch
+ Alpha/SGI bugs earlier.
+
+Fri Mar 15 01:09:41 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com-rt.def, com.c, com.h: Changes for rewrite of intrinsic
+ handling.
+ * com.c (ffecom_arglist_expr_): New function.
+ (ffecom_widest_expr_type_): New function.
+ (ffecom_expr_intrinsic_): Reorganize, some rewriting.
+ (ffecom_f2c_make_type_): Layout complex types.
+ (ffecom_gfrt_args_): New function.
+ (ffecom_list_expr): Trivial change for consistency.
+
+ * expr.c (ffeexpr_token_name_rhs_): Go back to getting
+ type from specific, not implementation, info.
+ (ffeexpr_token_funsubstr_): Set intrinsic implementation too!
+ * intrin.c: Major rewrite of most portions.
+ * intrin.def: Major rearchitecting of tables.
+ * intrin.h (ffeintrin_basictype, ffeintrin_kindtype):
+ Now (once again) take ffeintrinSpec as arg, not ffeintrinImp;
+ for now, these return NONE, since they're not really needed
+ and adding the necessary info to the tables is not trivial.
+ (ffeintrin_codegen_imp): New function.
+ * stc.c (ffestc_R1208_item): Change way ffeintrin funcs called,
+ back to original per above; but comment out the code anyway.
+
+ * intrin.c (ffe_init_0): Do internal checks only if
+ -fset-g77-defaults not specified.
+
+ * lang-options.h: Add -fset-g77-defaults option.
+ * lang-specs.h: Always pass -fset-g77-defaults.
+ * top.c, top.h: New option.
+
+Sat Mar 9 17:49:50 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in (stmp-int-hdrs): Use --no-validate when
+ generating the f77.rebuilt files (BUGS, INSTALL, NEWS)
+ so cross-references can work properly in g77.info
+ without a lot of hassle. Users can probably deal with
+ the way they end up looking in the f77.rebuilt files.
+
+ * bld.c (ffebld_constant_new_integer4_val): INTEGER*8
+ support -- new function.
+ (ffebld_constant_new_logical4_val): New function.
+ * com.c (ffecom_f2c_longint_type_node): New type.
+ (FFECOM_rttypeLONGINT_): New return type code.
+ (ffecom_expr_): Add code to invoke pow_qq instead
+ of pow_ii for INTEGER4 (INTEGER*8) case.
+ If ffecom_expr_power_integer_ returns NULL_TREE, just do
+ the usual work.
+ (ffecom_make_gfrt_): Handle new type.
+ (ffecom_expr_power_integer_): Let caller do the work if in
+ dummy-transforming case, since
+ caller now knows about INTEGER*8 and such, by returning
+ NULL_TREE.
+ * expr.c (ffeexpr_reduced_power_): Complain about non-INTEGER
+ raised to INTEGER4 (INTEGER*8) power.
+
+ * target.c (ffetarget_power_integerdefault_integerdefault):
+ Fix any**negative.
+ * com.c (ffecom_expr_power_integer_): Fix (-1)**(-8) and similar
+ to ABS() the integral result if the exponent is negative
+ and even.
+
+ * ste.c (ffeste_begin_iterdo_): Clean up a type ref.
+ Always convert iteration count to _default_ INTEGER.
+
+ * sta.c (ffesta_second_): Add BYTE and WORD type/stmts;
+ changes by Scott Snyder <snyder@d0sgif.fnal.gov>.
+ * stb.c (ffestb_decl_recursive): Ditto.
+ (ffestb_decl_recursive): Ditto.
+ (ffestb_decl_entsp_2_): Ditto.
+ (ffestb_decl_entsp_3_): Ditto.
+ (ffestb_decl_funcname_2_): Ditto.
+ (ffestb_decl_R539): Ditto.
+ (ffestb_decl_R5395_): Ditto.
+ * stc.c (ffestc_establish_declstmt_): Ditto.
+ * std.c (ffestd_R539item): Ditto.
+ (ffestd_R1219): Ditto.
+ * stp.h: Ditto.
+ * str-1t.fin: Ditto.
+ * str-2t.fin: Ditto.
+
+ * expr.c (ffeexpr_finished_): For DO loops, allow
+ any INTEGER type; convert LOGICAL (assuming -fugly)
+ to corresponding INTEGER type instead of always default
+ INTEGER; let later phases do conversion of DO start,
+ end, incr vars for implied-DO; change checks for non-integral
+ DO vars to be -Wsurprising warnings.
+ * ste.c (ffeste_io_impdo_): Convert start, end, and incr
+ to type of DO variable.
+
+ * com.c (ffecom_init_0): Add new types for [IL][234],
+ much of which was done by Scott Snyder <snyder@d0sgif.fnal.gov>.
+ * target.c: Ditto.
+ * target.h: Ditto.
+
+Wed Mar 6 14:08:45 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * top.c (ffe_init_gbe_): Make -frerun-loop-opt the default.
+
+Mon Mar 4 12:27:00 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * expr.c (ffeexpr_exprstack_push_unary_): Really warn only
+ about two successive _arithmetic_ operators.
+
+ * stc.c (ffestc_R522item_object): Allow SAVE of (understood)
+ local entity.
+
+ * top.c (ffe_decode_option): New -f(no-)second-underscore options.
+ * top.h: New options.
+ * com.c (ffecom_get_external_identifier_, ffecom_get_identifier_):
+ New options.
+
+ * Make-lang.in (f77.maintainer-clean): Clean f/BUGS, f/INSTALL,
+ f/NEWS.
+ ($(srcdir)/f/BUGS, $(srcdir)/f/INSTALL, $(srcdir)/f/NEWS):
+ New rules.
+ ($(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi): Depend on
+ f/bugs.texi and f/news.texi.
+ (f77.install-man): Install f77 man pages (if enabled).
+ (f77.uninstall): Uninstall info docs, f77 man pages (if enabled).
+
+ * top.c (ffe_init_gbe_): New function.
+ (ffe_decode_option, ffe_file): Call ffe_init_gbe_ to
+ set defaults for gcc options.
+
+Sat Jan 20 13:57:19 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_get_identifier_): Eliminate needless
+ comparison of results of strchr.
+
+Tue Dec 26 11:41:56 1995 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Make-lang.in: Add rules for new files g77.texi, g77.info,
+ and g77.dvi.
+ Reorganize the *clean rules to more closely parallel gcc's.
+
+ * config-lang.in: Exclude g77.info from diffs.
+
+Sun Dec 10 02:29:13 1995 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * expr.c (ffeexpr_declare_unadorned_,
+ ffeexpr_declare_parenthesized_): Break out handling of
+ contextDATAIMPDO[INDEX,CTRL] so it's independent of symbol state.
+ Don't exec-transition these here (let ffeexpr_sym_impdoitem_
+ handle that when appropriate). Don't "declare" them twice.
+
+Tue Dec 5 06:48:26 1995 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * stc.c (ffestc_promote_sfdummy_): Allow whereNONE parent
+ symbol, since it is not necessarily known whether it will
+ become LOCAL or DUMMY.
+
+Mon Dec 4 03:46:55 1995 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * lex.c (ffelex_display_token, ffelex_type_string_): Resurrect
+ these from their old versions and update them for possible invocation
+ from debugger.
+ * lex.h (ffelex_display_token): Declare this in case anyone
+ else wants to call it.
+
+ * lex.c (ffelex_total_tokens_): Have this reflect actual allocated
+ tokens, no longer include outstanding "uses" of tokens.
+
+ * malloc.c, malloc.h (MALLOC_DEBUG): New macro to control
+ checking of whether callers follow rules, now defaults to 0
+ for "no checking" to improve compile times.
+
+ * malloc.c (malloc_pool_kill): Fix bug that could prevent
+ subpool from actually being killed (wasn't setting its use
+ count to 1).
+
+ * proj.h, *.c (dmpout): Replace all occurrences of `stdout'
+ and some of `stderr' with `dmpout', so where to dump debugging
+ output can be easily controlled during build; add default
+ for `dmpout' of `stderr' to proj.h.
+
+Sun Dec 3 00:56:29 1995 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * com.c (ffecom_return_expr): Eliminate attempt at warning
+ about unset return values, since the back end does this better,
+ with better wording, and is not triggered by clearly working
+ (but spaghetti) code as easily as this test.
+
+Sat Dec 2 08:28:56 1995 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * target.c (ffetarget_power_*_integerdefault): Raising 0 to
+ integer constant power should not be an error condition;
+ if so, other code should catch 0 to any power, etc.
+
+ * bad.def (FFEBAD_BAD_POWER): 0**integer now a warning instead
+ of an error.
+
+Fri Dec 1 00:12:03 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * bad.def: Clarify diagnostic regarding complex constant elements.
+ * expr.c (ffeexpr_cb_comma_c_): Capitalize real/imaginary
+ for clarified diagnostic.
+
+ * com.c (ffecom_close_include_): Close the file!
+
+ * lex.c (ffelex_file_fixed): Update line info if the line
+ has any content, not just if it finishes a previous line
+ or has a label.
+ (ffelex_file_free): Clarify switch statement code.
+
+Sat Nov 18 19:37:22 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.17 released.
+
+Fri Nov 17 14:27:24 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Make-lang.in: Fix typo in comment.
+
+ * Makefile.in (f/fini.o, f/proj-h.o): Don't use `$<' since
+ not all makes support it (e.g. NeXT make), use explicit
+ source name instead (with $(srcdir) and munging).
+ (ASSERT_H): assert.h lives in source dir, not build dir.
+
+Thu Nov 16 12:47:50 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_init_0): Fix dumb bug in code to produce
+ warning message about non-32-bit-systems.
+
+ * stc.c (ffestc_R501_item): Parenthesize test to make
+ warning go away (and perhaps fix bug).
+
+Thu Nov 16 03:43:33 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * g77.c: Upgrade to 2.7.0's gcc.c.
+ Fix -v to pass a temp name instead of "/dev/null" for "-o".
+
+Fri Nov 10 19:16:05 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * ste.c (ffeste_begin_iterdo_): Add Toon's change to
+ make loops faster on some machines (implement termination
+ condition as "--i >= 0" instead of "i-- > 0").
+
+Thu Nov 2 03:58:17 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Make-lang.in: Remove unnecessary $(exeext) a la cp/Make-lang.in.
+
+ * com.c (ffecom_expr_): Restore old strategy for assignp variant
+ of opSYMTER case...always return the ASSIGN version of var.
+ That way, `-O -Wuninitialized' will catch "I=3;GOTO I;END"
+ (though the diagnostic will refer to `__g77_ASSIGN_i').
+
+ * com.c (ffecom_expr_power_integer_): For constant rhs case,
+ wrap every new eval of lhs in save_expr() so it is clear to
+ back end that MULT_EXPR(lhs,lhs) has identical operands,
+ otherwise for an rhs like 32767 it generates around 65K pseudo
+ registers, which which stupid_life_analysis cannot cope
+ (due to reg_renumber in regs.h being `short *' instead of
+ `int *').
+
+ * com.c (ffecom_expr_): Speed up implementation of LOGICAL
+ versions of opNOT, opAND, opOR, opXOR/opNEQV, and opEQV by
+ assuming the values actually are kosher LOGICAL bit patterns.
+ Also simplify code that implements some of the INTEGER versions
+ of these.
+
+ * com.c (skip_redundant_dir_prefix, read_name_map,
+ ffecom_open_include_, signed_type, unsigned_type): Fold in
+ changes to cccp.c made from 2.7.0 through ss-950826.
+
+ * equiv.c (ffeequiv_layout_local_): Kill the equiv list
+ if no syms in list.
+
+ * expr.c (ffeexpr_reduced_eqop2_): Issue specific diagnostic
+ regarding usage of .EQV./.NEQV. in preference to .EQ./.NE..
+
+ * intrin.c: Add ERF and ERFC as generic intrinsics.
+ intrin.def: Same.
+
+ * sta.c (ffesta_save_, ffesta_second_): Whoever calls
+ ffestd_exec_begin must also set ffesta_seen_first_exec = TRUE,
+ and anytime stc sees an exec transition, it must do both.
+ stc.c (ffestc_eof): Same.
+
+ * stc.c (ffestc_promote_sfdummy_): If failed implicit typing
+ or CHARACTER*(*) arg, after calling ffesymbol_error, don't
+ reset info to ENTITY/DUMMY, because ffecom_sym_transform_
+ doesn't expect such a thing with ANY/ANY type.
+
+ * target.h (*logical*): Change some of these so they parallel
+ changes in com.c, e.g. for _eqv_, use (l)==(r) instead of
+ !!(l)==!!(r), to get a more faithful result.
+
+Fri Oct 27 07:06:59 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_sym_transform_): Simplify code for local
+ EQUIVALENCE case.
+
+ * expr.c (ffeexpr_exprstack_push_unary_): Warn about two
+ successive operators.
+ (ffeexpr_exprstack_push_binary_): Warn about "surprising"
+ operator precedence, as in "-2**2".
+
+ * lang-options.h: Add -W(no-)surprising options.
+
+ * parse.c (yyparse): Don't reset -fpedantic if not -pedantic.
+
+ * top.c (ffe_decode_option): Support new -Wsurprising option.
+ * top.h: Ditto.
+
+Mon Oct 23 09:14:15 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_finish_symbol_transform_): Don't transform
+ NONE/NONE (CHARACTER*(*)) vars, as these don't mean anything
+ in debugging terms, and can't be turned into anything
+ in the back end (so ffecom_sym_transform_ crashes on them).
+
+ * com.c (ffecom_expr_): Change strategy for assignp variant
+ of opSYMTER case...always return the original var unless
+ it is not wide enough.
+
+ * ste.c (ffeste_io_cilist_): Clarify diagnostic for ASSIGN
+ involving too-narrow variable. This shouldn't happen, though.
+ (ffeste_io_icilist_): Ditto.
+ (ffeste_R838): Ditto.
+ (ffeste_R839): Ditto.
+
+Thu Oct 19 03:21:20 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_sym_transform_assign_): Set TREE_STATIC
+ using the same decision-making process as used for their twin
+ variables, so ASSIGN can last across RETURN/CALL as appropriate.
+
+Fri Sep 22 20:21:18 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Makefile.in: fini is a host program, so it needs a host-compiled
+ version of proj.o, named proj-h.o. f/fini, f/fini.o, and
+ f/proj-h.o targets updated accordingly.
+
+ * com.c (__eprintf): New function.
+
+Wed Sep 20 02:26:36 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * lang-options.h: Add omitted -funix-intrinsics-* options.
+
+ * malloc.c (malloc_find_inpool_): Check for infinite
+ loop, crash if detected (user reports encountering
+ them in some large programs, this might help track
+ down the bugs).
+
+Thu Sep 7 13:00:32 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (lang_print_error_function): Don't dereference null
+ pointer when outside any program unit.
+ (ffecom_let_char_, ffecom_arg_ptr_to_expr): If catlist
+ item or length ever error_mark_node, don't continue processing,
+ since back-end functions like build_pointer_type crash on
+ error_mark_node's (due to pushing bad obstacks, etc.).
+
+Wed Aug 30 15:58:35 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.16 released.
+
+Mon Aug 28 12:24:20 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * bad.c (ffebad_finish): Fix botched message when no places
+ are printed (due to unknown line info, etc.).
+
+ * std.c (ffestd_subr_labels_): Do a better job finding
+ line info in the case of typeANY and diagnostics.
+
+Fri Aug 25 15:19:29 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (DECL_ARTIFICIAL): Surround all references to this
+ macro with #if !BUILT_FOR_270 and #endif.
+ (init_lex): Surround print_error_function decl with
+ #if !BUILT_FOR_270 and #endif.
+ (lang_init): Call new ffelex_hash_kludge function to solve
+ problem with preprocessed files that have INCLUDE statements.
+
+ * lex.c (ffelex_getc_): New function.
+ (ffelex_cfelex_): Use ffelex_getc_ instead of getc in any
+ paths of code that can be affected by ffelex_hash_kludge.
+ Don't make an EOF token for unrecognized token; set token
+ to NULL instead, to avoid problems when not initialized.
+ (ffelex_hash_): Use ffelex_getc_ instead of getc in any
+ paths of code that can be affected by ffelex_hash_kludge.
+ Test token returned by ffelex_cfelex_ for NULL, meaning
+ unrecognized token.
+ Get rid of useless used_up variable.
+ Don't do ffewhere stuff or kill any tokens if in
+ ffelex_hash_kludge.
+ (ffelex_file_fixed, ffelex_file_free): Use ffelex_getc_
+ instead of getc in any paths of code that can be affected
+ by ffelex_hash_kludge.
+ (ffelex_hash_kludge): New function.
+
+ * lex.h (ffelex_hash_kludge): New function.
+
+Wed Aug 23 15:17:40 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c: Implement -f(no-)underscoring options by always
+ compiling in code to do it, and having that code inhibit
+ itself when -fno-underscoring is in effect. This option
+ overrides -f(no-)f2c for this purpose; -f(no-)f2c returns
+ to it's <=0.5.15 behavior of affecting only how code
+ is generated, not how/whether names are mangled.
+
+ * target.h: Redo specification of appending underscores so
+ the macros are named "_default" instead of "_is" and the
+ two-underscore macro defaults to 1.
+
+ * top.c, top.h (underscoring): Add appropriate stuff
+ for the -f(no-)underscoring options.
+
+Tue Aug 22 10:25:01 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * bad.c (ffebad_finish): Call report_error_function (in toplev.c)
+ to better identify location of problem.
+ Say "(continued):" instead of "(continued:)" for consistency.
+
+ * com.c (ffecom_gen_sfuncdef_): Set and reset new
+ ffecom_nested_entry_ variable to hold ffesymbol being compiled.
+ (lang_print_error_function): New function from toplev.c.
+ Use ffecom_nested_entry_ to help determine which name
+ and kind-string to print.
+ (ffecom_expr_intrinsic_): Handle EXIT and FLUSH invocations
+ with different calling sequences than library functions.
+ Have SIGNAL and SYSTEM push and pop calltemps, and convert
+ their return values to the destination type (just in case).
+ (FFECOM_rttypeINT_): New return type for `int', in case
+ gcc/f/runtime/libF77/system_.c(system_) is really supposed
+ to return `int' instead of `ftnint'.
+
+ * com.h (report_error_function): Declare this.
+
+ * equiv.c (ffeequiv_layout_local_): Don't forget to consider
+ root variable itself as possible "first rooted variable",
+ else might never set symbol and then crash later.
+
+ * intrin.c (ffeintrin_check_exit_): Change to allow no args
+ and rename to ffeintrin_check_int_1_o_ for `optional'.
+ #define ffeintrin_check_exit_ and _flush_ to this new
+ function, so intrin.def can refer to the appropriate names.
+
+ * intrin.def (FFEINTRIN_impFLUSH): Validate using
+ ffeintrin_check_flush_ so passing an INTEGER arg is allowed.
+
+ * lex.c (ffelex_file_push_, ffelex_file_pop_): New functions
+ to manage input_file_stack in gbe.
+ (ffelex_hash_): Call new functions (instead of doing code).
+ (ffelex_include_): Call new functions to update stack for
+ INCLUDE (_hash_ handles cpp output of #include).
+
+Mon Aug 21 08:09:04 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Makefile.in: Put `-W' in front of every `-Wall', since
+ 2.7.0 requires that to engage `-Wunused' for parameters.
+
+ * com.c: Mark all parameters as artificial, so
+ `-W -Wunused' doesn't complain about unused ones (since
+ there's no way right not to individually specify attributes
+ like `unused').
+
+ * proj.h: Don't #define UNUSED if already defined, regardless
+ of host compiler.
+
+Sun Aug 20 16:03:56 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * gbe/2.7.0.diff: Regenerate.
+
+ * lang-options.h, lang-specs.h: If not __STDC__ (ANSI C),
+ avoid doing anything, especially the stringizing in -specs.h.
+
+Thu Aug 17 03:36:12 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * lang-specs.h: Remove useless optional settings of -traditional,
+ since -traditional is always set anyway.
+
+Wed Aug 16 16:56:46 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Make-lang.in (F2C_INSTALL_FLAG, F2CLIBOK): More
+ control over whether to install f2c-related stuff.
+ (install-f2c-*): New targets to install f2c-related
+ stuff in system, not just gcc, directories.
+
+ * com.c: Change calls to ffecom_get_invented_identifier
+ to use generally more predictable names.
+ Change calls to build_range_type to ensure consistency
+ of types of operands.
+ (ffecom_get_external_identifier_): Change to accept
+ symbol info, not just text, so it can use f2c flag for
+ symbol to decide whether to append underscore(s).
+ (ffecom_get_identifier_): Don't change names if f2c flag
+ off for compilation.
+ (ffecom_type_permanent_copy_): Use same type for new max as
+ used for min.
+ (ffecom_notify_init_storage): Offline fixups for stand-alone.
+
+ * data.c (ffedata_gather): Explicitly test for common block,
+ since it's no longer always the case that a local EQUIVALENCE
+ group has no symbol ptr (it now can, if a user-predictable
+ "rooted" symbol has been identified).
+
+ * equiv.c: Add some debugging stuff.
+ (ffeequiv_layout_local_): Set symbol ptr with user-predictable
+ "rooted" symbol, for giving the invented aggregate a
+ predictable name.
+
+ * g77.c (append_arg): Allow for 20 extra args instead of 10.
+ (main): For version-only case, add `-fnull-version' and, unless
+ explicitly omitted, `-lf2c -lm'.
+
+ * lang-options.h: New "-fnull-version" option.
+
+ * lang-specs.h: Support ".fpp" suffix for preprocessed source
+ (useful for OS/2, MS-DOS, other case-insensitive systems).
+
+ * stc.c (ffestc_R544_equiv_): Swap way lists are merged so this
+ is consistent with the order in which lists are built, making
+ user predictability of invented aggregate name much higher.
+
+ * storag.c, storag.h (FFESTORAG_typeDUMMY): Delete this enum.
+
+ * top.c: Accept, but otherwise ignore, `-fnull-version'.
+
+Tue Aug 15 07:01:07 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * DOC, INSTALL, PROJECTS: Extensive improvements to documentation.
+
+Sun Aug 13 01:55:18 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * INSTALL (f77-install-ok): Document the use of this file.
+
+ * Make-lang.in (F77_INSTALL_FLAG): New flag to control
+ whether to install an `f77' command (based on whether
+ a file named `f77-install-ok' exists in the source or
+ build directory) to replace the broken attempt to use
+ comment lines to avoid installing `f77' (broken in the
+ sense that it prevented installation of `g77').
+
+Mon Aug 7 06:14:26 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * DOC: Add new sections for g77 & gcc compiler options,
+ source code form, and types, sizes and precisions.
+ Remove lots of old "delta-version" info, or at least
+ summarize it.
+
+ * INSTALL: Add info here that used to be in DOC.
+ Other changes.
+
+ * g77.c (lookup_option, main): Check for --print-* options,
+ so we avoid adding version-determining stuff.
+
+Wed Jul 26 15:51:03 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Make-lang.in, Makefile.in (input.j, INPUT_H): New file.
+ Update dependencies accordingly.
+
+ * bad.c (ffebad_here): Okay to use unknown line/col.
+
+ * compilers.h (@f77-cpp-input): Remove -P option now that
+ # directives are handled by f771. Update other options
+ to be more consistent with @c in gcc/gcc.c. Don't run f771
+ if -E specified, etc., a la @c.
+ (@f77): Don't run f771 if -E specified, etc., a la @c.
+
+ * config-lang.in: Avoid use of word "guaranteed".
+
+ * input.j: New file to wrap around gcc/input.h.
+
+ * lex.j: Add support for parsing # directives output by cpp.
+ (ffelex_cfebackslash_): New function.
+ (ffelex_cfelex_): New function.
+ (ffelex_get_directive_line_): New function.
+ (ffelex_hash_): New function.
+ (ffelex_include_): Change to not use ffewhere_file_(begin|end).
+ Also fix bug in pointing to next line (for diagnostics, &c)
+ following successful INCLUDE.
+ (ffelex_next_line_): New function that does chunk of code
+ seen in several places elsewhere in the lexers.
+ (ffelex_file_fixed): Delay finishing statement until source
+ line is registered with ffewhere, so INCLUDE processing
+ picks up the info correctly.
+ Okay to kill or use unknown line/col objects now.
+ Handle HASH (#) lines.
+ Reorder tests for insubstantial lines to put most frequent
+ occurrences at top, for possible minor speedup.
+ Some general consolidation of code.
+ (ffelex_file_free): Handle HASH (#) lines.
+ Okay to kill or use unknown line/col objects now.
+ Some general consolidation of code.
+ (ffelex_init_1): Detect HASH (#) lines.
+ (ffelex_set_expecting_hollerith): Okay to kill or use unknown
+ line/col objects now.
+
+ * lex.h (FFELEX_typeHASH): New enum.
+
+ * options-lang.h (-fident, -fno-ident): New options.
+
+ * stw.c (ffestw_update): Okay to kill unknown line/col objects
+ now.
+
+ * target.h (FFETARGET_okREALQUAD, FFETARGET_okCOMPLEXDOUBLE,
+ FFETARGET_okCOMPLEXQUAD): #define these appropriately.
+
+ * top.c: Include flag.j wrapper, not flags.h directly.
+ (ffe_is_ident_): New flag.
+ (ffe_decode_option): Handle -fident and -fno-ident.
+ (ffe_file): Replace obsolete ffewhere_file_(begin|end) with
+ ffewhere_file_set.
+
+ * top.h (ffe_is_ident_, ffe_is_ident, ffe_set_is_ident):
+ New flag and access functions.
+
+ * where.c, where.h: Remove all tracking of parent file.
+ (ffewhere_file_begin, ffewhere_file_end): Delete these.
+ (ffewhere_line_use): Make it work with unknown line object.
+
+Mon Jul 17 03:04:09 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_sym_transform_): Set DECL_IN_SYSTEM_HEADER
+ flag for any local vars used as stmtfunc dummies or DATA
+ implied-DO iter vars, so no -Wunused warnings are produced
+ for them (a la f2c).
+ (ffecom_init_0): Do "extern int xargc;" for IARGC() intrinsic.
+ Warn if target machine not 32 bits, since g77 isn't yet
+ working on them at all well.
+
+ * expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_data_,
+ ffeexpr_sym_lhs_extfunc_, ffeexpr_sym_rhs_actualarg_,
+ ffeexpr_sym_rhs_let_, ffeexpr_paren_rhs_let_): Don't
+ gratuitously set attr bits that don't apply just
+ to avoid null set meaning error; instead, use explicit
+ error flag, and allow null attr set, to
+ fix certain bugs discovered by looking at this code.
+
+ * g77.c: Major changes to improve support for gcc long options,
+ to make `g77 -v' report more useful info, and so on.
+
+Mon Jul 3 14:49:16 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * DOC, com.c, intrin.h, intrin.c, intrin.def, target.h, top.c,
+ top.h: Add new `unix' group of intrinsics, which includes the
+ newly added ERF, ERFC, EXIT, plus even newer ABORT, DERF, DERFC,
+ FLUSH, GETARG, GETENV, SIGNAL, and SYSTEM.
+
+Tue Jun 27 23:01:05 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * bld.c, bld.h (ffebld_constant_pool,
+ ffebld_constant_character_pool): Use a single macro (the
+ former) to access the pool for allocating constants, instead
+ of latter in public and FFEBLD_CONSTANT_POOL_ internally
+ in bld.c (which was the only one that was correct before
+ these changes). Add verification of integrity of certain
+ heap-allocated areas.
+
+ * com.c (ffecom_overlap_, ffecom_args_overlap_,
+ ffecom_tree_canonize_ptr_, ffecom_tree_canonize_ref_): New
+ functions to optimize calling COMPLEX and, someday, CHARACTER
+ functions requiring additional argument to be passed.
+ (ffecom_call_, ffecom_call_binop_, ffecom_expr_,
+ ffecom_expr_intrinsic_): Change calling
+ sequences to include more info on possible destination.
+ (ffecom_expr_intrinsic_): Add ERF(), ERFC(), and EXIT()
+ intrinsic code.
+ (ffecom_sym_transform_): For assumed-size arrays, set high
+ bound to highest possible value instead of low bound, to
+ improve validity of overlap checking.
+ (duplicate_decls): If olddecl and newdecl are the same,
+ don't do any munging, just return affirmative.
+
+ * expr.c: Change ffecom_constant_character_pool() to
+ ffecom_constant_pool().
+
+ * info.c (ffeinfo_new): Compile this version if not being
+ compiled by GNU C.
+
+ * info.h (ffeinfo_new): Don't define macro if not being
+ compiled by GNU C.
+
+ * intrin.c, intrin.def: Add ERF(), ERFC(), and EXIT() intrinsics.
+ (ffeintrin_check_exit_): New for EXIT() subroutine intrinsic.
+
+ * malloc.c, malloc.h (malloc_verify_*): New functions to verify
+ integrity of heap-storage areas.
+
+ * stc.c (ffestc_R834, ffestc_R835): Handle possibility that
+ an enclosing DO won't have a construct name even when the
+ CYCLE/EXIT does (i.e. without dereferencing NULL).
+
+ * target.c, target.h (ffetarget_verify_character1): New function
+ to verify integrity of heap storage used to hold character constant.
+
+Thu Jun 22 15:36:39 1995 Howard Gordon (flash@super.org)
+
+ * stp.h (ffestpVxtcodeIx): Fix typo in typedef for this.
+
+Mon May 29 15:22:31 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * *: Make all sorts of changes to accommodate upcoming gcc-2.7.0.
+ I didn't keep track of them, nor just when I made them, nor
+ when I (much later, probably in early August 1995) modified
+ them so they could properly handle both 2.7.0 and 2.6.x.
+
+ * com.c (ffecom_expr_power_integer_): Don't expand_start_stmt_expr
+ if transforming dummy args, because the back end cannot handle
+ that (it's rejected by the gcc front end), just generate
+ call to run-time library.
+ Back out changes in 0.5.15 because more temporaries might be
+ needed anyway (for COMPLEX**INTEGER).
+ (ffecom_push_tempvar): Remove inhibitor.
+ Around start_decl and finish_decl (in particular, arround
+ expand_decl, which is called by them), push NULL_TREE into
+ sequence_rtl_expr, an external published by gcc/function.c.
+ This makes sure the temporary is truly in the function's
+ context, not the inner context of a statement-valued expression.
+ (I think the back end is inconsistent here, but am not
+ interested in convincing the gbe maintainers about this now.)
+ (pushdecl): Make sure that when pushing PARM_DECLs, nothing
+ other than them are pushed, as happened for 0.5.15 and which,
+ if done for other reasons not fixed here, might well indicate
+ some other problem -- so crash if it happens.
+
+ * equiv.c (ffeequiv_layout_local_): If the local equiv group
+ has a non-nil COMMON field, it should mean that an error has
+ occurred and been reported, so just trash the local equiv
+ group and do nothing.
+
+ * stc.c (ffestc_promote_sfdummy_): Set sfdummy arg state to
+ UNDERSTOOD so above checking for duplicate args actually
+ works, and so we don't crash later in pushdecl.
+
+ * ste.c (ffeste_R1001): Set initial value only for VAR_DECLs,
+ not for, e.g., LABEL_DECLs, which the FORMAT label can be
+ if it was previously treated as an executable label.
+
+Sat May 20 01:53:53 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_sym_transform_): For adjustable arrays,
+ pass high bound through variable_size in case its primaries
+ are changed (dumb0.f, and this might also improve
+ performance so it approaches f2c|gcc).
+
+Fri May 19 11:00:36 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.15 released.
+
+ * com.c (ffecom_expr_power_integer_): Push temp vars
+ before expanding a statement expression, since that seems
+ to cause temp vars to be "forgotten" after the end of the
+ expansion in the back end. Disallow more temp-var
+ pushing during such an expansion, just in case.
+ (ffecom_push_tempvar): Crash if a new variable needs to be
+ pushed but cannot be at this point (should never happen).
+
+Wed May 17 12:26:16 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * expr.c (ffeexpr_collapse_convert): Add code to convert
+ LOGICAL to CHARACTER. Reject conversion of REAL or COMPLEX
+ to CHARACTER entirely, as it cannot be supported with all
+ configurations.
+
+ * target.h, target.c (ffetarget_convert_character1_logical1):
+ New function.
+
+Sun May 14 00:00:09 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_do_entry_, ffecom_gen_sfuncdef_,
+ ffecom_start_progunit_, ffecom_sym_transform_,
+ ffecom_init_0, start_function): Changes to have REAL
+ external functions return same type as DOUBLE PRECISION
+ external functions when -ff2c is in force; while at it,
+ some code cleanups done.
+
+ * stc.c (ffestc_R547_item_object): Disallow array declarator
+ if one already exists for symbol.
+
+ * ste.c (ffeste_R1227): Convert result variable to type
+ of function result as seen by back end (e.g. for when REAL
+ external function actually returns result as double).
+
+ * target.h (FFETARGET_defaultFIXED_LINE_LENGTH): New
+ macro for default for -ffixed-line-length-N option.
+
+ * top.c (ffe_fixed_line_length_): Initialize this to new
+ target.h macro instead of constant 72.
+
+Tue May 9 01:20:03 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * lex.c (ffelex_send_token_): If sending CHARACTER token with
+ null text field, put a single '\0' in it and set length/size
+ fields to 0 (to fix 950508-0.f).
+ (ffelex_image_char_): When setting ffelex_bad_line_ to TRUE,
+ always "close" card image by appending a null char and setting
+ ffelex_card_length_. As part of this, append useful text
+ to identify the two kinds of problems that involve this.
+ (ffelex_file_fixed): Reset ffelex_bad_line_ to FALSE after
+ seeing a line with invalid first character (fixes 950508-1.f).
+ If final nontab column is zero, assume tab seen in line.
+ (ffelex_card_image_): Always make this array 8 characters
+ longer than reflected by ffelex_card_size_.
+ (ffelex_init_1): Get final nontab column info from top instead
+ of assuming 72.
+
+ * options-lang.h: Add -ffixed-line-length- prefix.
+
+ * top.h: Add ffe_fixed_line_length() and _set_ version, plus
+ corresponding extern.
+
+ * top.c: Handle -ffixed-line-length- option prefix.
+
+Fri Apr 28 05:40:25 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.14 released.
+
+ * Make-lang.in: Add assert.j.
+
+ * Makefile.in: Add assert.j.
+
+ * assert.j: New file.
+
+Thu Apr 27 16:24:22 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * bad.h (ffebad_severity): New function.
+
+ * bad.c (ffebad_severity): New function.
+
+ * bad.def (FFEBAD_OPEN_INCLUDE): Change severity from SEVERE
+ to FATAL, since processing continues, and that seems fine.
+
+ * com.c: Add facility to handle -I.
+ (ffecom_file, ffecom_close_include, ffecom_open_include,
+ ffecom_decode_include_option): New global functions for -I.
+ (ffecom_file_, ffecom_initialize_char_syntax_,
+ ffecom_close_include_, ffecom_decode_include_option_,
+ ffecom_open_include_, append_include_chain, open_include_file,
+ print_containing_files, read_filename_string, file_name_map,
+ savestring): New internal functions for -I.
+
+ * compilers.h: Pass -I flag(s) to f771 (via "%{I*}").
+
+ * lex.c (ffelex_include_): Call ffecom_close_include
+ to close include file, for its tracking needs for -I,
+ instead of using fclose.
+
+ * options-lang.h: Add -I prefix.
+
+ * parse.c (yyparse): Call ffecom_file for main input file,
+ so -I handling works (diagnostics).
+
+ * std.c (ffestd_S3P4): Have ffecom_open_include handle
+ opening and diagnosing errors with INCLUDE files.
+
+ * ste.c (ffeste_begin_iterdo_): Use correct algorithm for
+ calculating # of iterations -- mathematically similar but
+ computationally different algorithm was not handling cases
+ like "DO I=6,5,2" correctly, because (5-6)/2+1 => 1, not 0.
+
+ * top.c (ffe_decode_option): Allow -I, restructure a bit
+ for clarity and, maybe, speed.
+
+Mon Apr 17 13:31:11 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * g77.c: Remove -lc, turns out not all systems has it, but
+ leave other changes in for clarity of code.
+
+Sun Apr 16 21:50:33 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_expr_): Implement ARRAY_EXPR as INDIRECT_REF
+ of appropriate PLUS_EXPRs of ptr_to_expr of array, to see
+ if this generates better code. (Conditional on
+ FFECOM_FASTER_ARRAY_REFS.)
+
+Sun Apr 16 00:22:48 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Make-lang.in (F77_SRCS): Remove g77.c, since it doesn't
+ contribute to building f771.
+
+ * Makefile.in (dircheck): Remove/replace with f/Makefile, because
+ phony targets that are referenced in other real targets get run
+ when those targets are specified, which is a waste of time (e.g.
+ when rebuilding and only g77.c has changed, f771 was being linked
+ anyway).
+
+ * g77.c: Include -lc between -lf2c and -lm throughout.
+
+ * implic.c (ffeimplic_establish_symbol): If -Wimplicit, warn if
+ implicit type given to symbol.
+
+ * lex.c (ffelex_include_): Don't gratuitously increment line
+ number here.
+
+ * top.h, top.c (ffe_is_warn_implicit_): New global variable and
+ related access macros.
+ (ffe_decode_option): Handle -W options, including -Wall and
+ -Wimplicit.
+
+ * where.c (ffewhere_line_new): Don't muck with root line (was
+ crashing on null input since lexer changes over the past week
+ or so).
+
+Thu Apr 13 16:48:30 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_init_0): Register built-in functions for cos,
+ sin, and sqrt.
+ (ffecom_tree_fun_type_double): New variable.
+ (ffecom_expr_intrinsic_): Update f2c input and output files
+ to latest version of f2c (no important g77-related changes
+ noted, just bug fixes to f2c and such).
+ (builtin_function): New function from c-decl.c.
+
+ * com-rt.def: Refer to built-in functions for cos, sin, and sqrt.
+
+Thu Apr 13 10:25:09 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_expr_intrinsic_): Convert 0. to appropriate
+ type to keep DCMPLX(I) from crashing the compiler.
+ (ffecom_expr_): Don't convert result from ffecom_tree_divide_.
+ (ffecom_tree_divide_): Add tree_type argument, have all callers
+ pass one, and don't convert right-hand operand to it (this is
+ to make this new function work as much like the old in-line
+ code used in ffecom_expr_ as possible).
+
+ * lex.c: Maintain lineno and input_filename the way the gcc
+ lexer does.
+
+ * std.c (ffestd_exec_end): Save and restore lineno and
+ input_filename around the second pass, which sets them
+ appropriately for each saved statement.
+
+Wed Apr 12 09:44:45 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_expr_power_integer_): New function.
+ (ffecom_expr_): Call new function for power op with integer second
+ argument, for generating better code. Also replace divide
+ code with call to new ffecom_tree_divide_ function.
+ Canonicalize calls to ffecom_truth_value(_invert).
+ (ffecom_tree_divide_): New function.
+
+Wed Apr 5 14:15:44 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * lex.c: Change to allocate text for tokens only when actually
+ needed, which should speed compilation up somewhat.
+ Change to allow INCLUDE at any point where a statement
+ can end, i.e. in ffelex_finish_statement_ or when a SEMICOLON
+ token is sent.
+ Remove some old, obsolete code.
+ Clean up layout of entire file to improve formatting,
+ readability, etc.
+ (ffelex_set_expecting_hollerith): Remove include argument.
+
+Fri Mar 31 23:19:08 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * bad.h, bad.c (ffebad_start_msg, ffebad_start_msg_lex):
+ New functions to generate arbitrary messages.
+ (FFEBAD_severityPEDANTIC): New severity, to correspond
+ to toplev's pedwarn() function.
+
+ * lex.c (ffelex_backslash_): New function to implement
+ backslash processing.
+ (ffelex_file_fixed, ffelex_file_free): Implement new
+ backslash processing.
+
+ * std.c (ffestd_R1001dump_): Don't assume CHARACTER and
+ HOLLERITH tokens stop at '\0' characters, now that backslash
+ processing is supported -- use their advertised lengths instead,
+ and double up the '\002' character for libf2c.
+
+Mon Mar 27 17:10:33 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_init_local_zero_): Implement -finit-local-zero.
+ (ffecom_sym_transform_): Same.
+ (ffecom_transform_equiv_): Same.
+
+ * options-lang.h: Add -f(no-)(init-local-zero,backslash,ugly-init).
+
+ * stb.c (ffestb_V020): Reject "TYPEblah(...", which might be
+ an array assignment.
+
+ * target.h, top.h, top.c: Implement -finit-local-zero.
+
+Fri Mar 24 19:56:22 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Make-lang.in, Makefile.in: Remove conf-proj(.in) and
+ proj.h(.in) rules, plus related config.log, config.cache,
+ and config.status stuff.
+
+ * com.c (ffecom_init_0): Change messages when atof(), bsearch(),
+ or strtoul() do not work as expected in the start-up test.
+
+ * conf-proj, conf-proj.in: Delete.
+
+ * lex.c (ffelex_file_fixed): Allow f2c's '&' in column 1
+ to mean continuation line.
+
+ * options-lang.h: New file, #include'd by ../toplev.c.
+
+ * proj.h.in: Rename back to proj.h.
+
+ * proj.h (LAME_ASSERT): Remove.
+ (LAME_STDIO): Remove.
+ (NO_STDDEF): Remove.
+ (NO_STDLIB): Remove.
+ (NO_BSEARCH): Remove auto detection, rename to !FFEPROJ_BSEARCH.
+ (NO_STRTOUL): Remove auto detection, rename to !FFEPROJ_STRTOUL.
+ (USE_HOST_LIMITS): Remove (maybe still needed by stand-alone?).
+ (STR, STRX): Do only ANSI C definitions.
+
+Mon Mar 13 10:46:13 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * BUGS: Add item about g77 requiring gcc to compile it.
+
+ * NEWS: New file listing user-visible changes in the release.
+
+ * PROJECTS: Update to include a new item or two, and modify
+ or delete items that are addressed in this or previous releases.
+
+ * bad.c (ffebad_finish): Don't crash if missing string &c,
+ just substitute obviously distressed string "[REPORT BUG!!]"
+ for cases where the message/caller are fudgy.
+
+ * bad.def: Clean up error messages in a major way, add new ones
+ for use by changes in target.c.
+
+ * com.c (ffecom_expr_): Handle opANY in opCONVERT.
+ (ffecom_let_char_): Disregard destinations with ERROR_MARK.
+ (ffecom_1, ffecom_1_fn, ffecom_2, ffecom_2s, ffecom_3,
+ ffecom_3s, &c): Check all inputs for error_mark_node.
+ (ffecom_start_progunit_): Don't transform all symbols
+ in BLOCK DATA, since it never executes, and it is silly
+ to, e.g., generate all the structures for NAMELIST.
+ (ffecom_char_length_expr_): Rename to ffecom_intrinsic_len_.
+ (ffecom_intrinsic_ichar_): New function to handle ICHAR of
+ arbitrary expression with possible 0-length operands.
+ (ffecom_expr_intrinsic_): Use ffecom_intrinsic_char_.
+ For MVBITS, set tree_type to void_type_node.
+ (ffecom_start_progunit_): Name master function for entry points
+ after primary entry point so users can easily guess it while
+ debugging.
+ (ffecom_arg_ptr_to_expr): Change treatment of Hollerith,
+ Typeless, and %DESCR.
+ (ffecom_expr_): Change treatment of Hollerith.
+
+ * data.c (ffedata_gather_): Handle opANY in opCONVERT.
+
+ * expr.c (ffeexpr_token_apostrophe_): Issue FFEBAD_NULL_CHAR_CONST
+ warning as necessary.
+ (ffeexpr_token_name_rhs_): Set context for args to intrinsic
+ so that assignment-like concatenation is allowed for ICHAR(),
+ IACHAR(), and LEN() intrinsics.
+ (ffeexpr_reduced_*_): Say "an array" instead of "an entity" in
+ diagnostics, since it's more informative.
+ (ffeexpr_finished_): For many contexts, check for null expression
+ and array before trying to do a conversion, to avoid redundant
+ diagnostics.
+
+ * g77.1: Fix typo for preprocessed suffix (.F, not .f).
+
+ * global.c (ffeglobal_init_common): Warn if initializing
+ blank common.
+ (ffeglobal_pad_common): Enable code to warn if initial
+ padding needed.
+ (ffeglobal_size_common): Complain if enlarging already-
+ initialized common, since it won't work right anyway.
+
+ * intrin.c: Add IMAG() intrinsic.
+ (ffeintrin_check_loc_): Allow opSUBSTR in LOC().
+
+ * intrin.def: Add IMAG() intrinsic.
+
+ * lex.c: Don't report FFEBAD_NULL_CHAR_CONST errors.
+
+ * sta.c, sta.h, stb.c: Changes to clean up error messages (see
+ bad.def).
+
+ * stb.c (ffestb_R100113_): Issue FFEBAD_NULL_CHAR_CONST
+ warning as necessary.
+
+ * stc.c (ffestc_shriek_do_): Don't try to reference doref_line
+ stuff in ANY case, since it won't be valid.
+ (ffestc_R1227): Allow RETURN in main program unit, with
+ appropriate warnings/errors.
+ (ffestc_subr_format_): Array of any type is a CHAREXPR (F77 C5).
+
+ * ste.c (ffeste_begin_doiter_): Couple of fixes to accurately
+ determine if loop never executes.
+
+ * target.c (ffetarget_convert_*_hollerith_): Append spaces,
+ not zeros, to follow F77 Appendix C, and to warn when
+ truncation of non-blanks done.
+ (ffetarget_convert_*_typeless): Rewrite to do typeless
+ conversions properly, and warn when truncation done.
+ (ffetarget_print_binary, ffetarget_print_octal,
+ ffetarget_print_hex): Rewrite to use new implementation of
+ typeless.
+ (ffetarget_typeless_*): Rewrite to use new implementation
+ of typeless, and to warn about overflow.
+
+ * target.h (ffetargetTypeless): New implementation of
+ this type.
+
+ * type.h, type.c (ffetype_size_typeless): Remove (incorrect)
+ implementation of this function and its extern.
+
+Sun Mar 5 18:46:42 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * BUGS: Clarify that constant handling would also fix lack of
+ adequate IEEE-754/854 support to some degree, and typeless
+ and non-decimal constants.
+
+ * com.c (ffecom_type_permanent_copy_): Comment out to avoid
+ warnings.
+ (duplicate_decls): New function a la gcc/c-decl.c.
+ (pushdecl): Use duplicate_decls to decide whether to return
+ existing decl or new one, instead of always returning existing
+ decl.
+ (ffecom_expr_): opPERCENT_LOC now supports CHARACTER arguments.
+ (ffecom_init_0): Give f2c I/O code 0 for basictypeANY/kindtypeANY.
+ (ffecom_sym_transform_): For adjustable arrays, pass low bound
+ through variable_size in case its primaries are changed (950302-1.f).
+
+ * com.h: More decls that belong in tree.h &c.
+
+ * data.c (ffedata_eval_integer1_): Fix opPAREN case to not
+ treat value of expression as an error code.
+
+ * expr.c (ffeexpr_finished_): Allow opSUBSTR in contextLOC case.
+
+ * proj.c: Add "const" as appropriate.
+
+Mon Feb 27 10:04:03 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * bad.def (FFEBAD_BAD_SUBSTR): Fix bad grammar in message.
+
+Fri Feb 24 16:21:31 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.13 released.
+
+ * INSTALL: Warn that f/zzz.o will compare differently between
+ stages, since it puts the __TIME__ macro into a string.
+
+ * com.c (ffecom_sym_transform_): Transform kindFUNCTION/whereDUMMY
+ to pointer-to-function, not function.
+ (ffecom_expr_): Use ffecom_arg_ptr_to_expr instead of
+ ffecom_char_args_ to handle comparison between CHARACTER
+ types, so either operand can be a CONCATENATE.
+ (ffecom_transform_common_): Set size of initialized common area
+ to global (largest-known) size, even though size of init might
+ be smaller.
+
+ * equiv.c (ffeequiv_offset_): Check symbol info for ANY.
+
+ * expr.c (ffeexpr_find_close_paren_, ffeexpr_nil_*): New functions
+ to handle following the contour of a rejected expression, so
+ statements like "PRINT(I,I,I)=0" don't cause the PRINT statement
+ code to get the second passed back to it as if there was a
+ missing close-paren before it, the comma causing the PRINT code
+ to confirm the statement, resulting in an ambiguity vis-a-vis
+ the let statement code.
+ Use the new ffecom_find_close_paren_ handler when an expected
+ close-paren is missing.
+ (ffeexpr_isdigits_): New function, use in all places that
+ currently use isdigit in repetitive code.
+ (ffeexpr_collapse_symter): Collapse to ANY if init-expr is ANY,
+ so as to avoid having symbol get "transformed" if used to
+ dimension an array.
+ (ffeexpr_token_real_, ffeexpr_token_number_real_): Don't issue
+ diagnostic about exponent, since it'll be passed along the
+ handler path, resulting in a diagnostic anyway.
+ (ffeexpr_token_apos_char_): Use consistent handler path
+ regardless of whether diagnostics inhibited.
+ (ffeexpr_token_name_apos_name_): Skip past closing quote/apos
+ even if not a match or other diagnostic issued.
+ (ffeexpr_sym_impdoitem_): Exec-transition local SEEN symbol.
+
+ * lex.c (ffelex_image_char_): Set ffelex_saw_tab_ if TAB
+ seen, not if anything other than TAB seen!
+
+ * stc.c (ffestc_R537_item): If source is ANY but dest isn't,
+ set dest symbol's init expr to ANY.
+ (ffestc_R501_attrib, ffestc_R522, ffestc_R522start): Complain
+ about conflict between "SAVE" by itself and other uses of
+ SAVE only in pedantic mode.
+
+ * ste.c (ffeste_R1212): Fix loop over labels to always
+ increment caseno, to avoid pushcase returning 2 for duplicate
+ values when one of the labels is invalid.
+
+Thu Feb 23 12:42:04 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.12 released.
+
+ * Make-lang.in (f77.install-common): Add "else true;" before outer
+ "fi" per Makefile.in patch.
+
+ * Makefile.in (dircheck): Add "else true;" before "fi" per
+ patch from chs1pm@surrey.ac.uk.
+
+ * com.c (ffecom_push_tempvar): If type desired is ERROR_MARK,
+ return error_mark_node, to avoid crash that results from
+ making a VAR_DECL with error_mark_node as its type.
+
+ * ste.c (ffeste_begin_iterdo_): Convert itercount to INTEGER
+ anytime calculation of number of iterations ends up with type
+ other than INTEGER (e.g. DOUBLE PRECISION, REAL).
+
+Thu Feb 23 02:48:38 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.11 released.
+
+ * DOC: Explain -fugly-args.
+
+ * bad.def (FFEBAD_ACTUALARG): Explain -fugly-args and how to
+ rewrite code to not require it.
+
+ * com.c (ffecom_vardesc_): Handle negative type code, just in
+ case.
+ (ffecom_arg_ptr_to_expr): Let ffecom_expr handle hollerith
+ and typeless constants (move code to ffecom_constantunion).
+ (ffecom_constantunion): Handle hollerith and typeless constants.
+
+ * expr.c (ffecom_finished_): Check -fugly-args in actual-arg
+ context where hollerith/typeless provided.
+
+ * intrin.def (FFEINTRIN_genDFLOAT): Add FFEINTRIN_specDFLOAT.
+ (FFEINTRIN_specDFLOAT): Add as f2c intrinsic.
+
+ * target.h (ffetarget_convert_real[12]_integer,
+ ffetarget_convert_complex[12]_integer): Pass -1 for high integer
+ value if low part is negative.
+ (FFETARGET_defaultIS_UGLY_ARGS): New macro.
+
+ * top.c (ffe_is_ugly_args_): New variable.
+ (ffe_decode_option): Handle -fugly-args and -fno-ugly-args.
+
+ * top.h (ffe_is_ugly_args_, ffe_is_ugly_args(),
+ ffe_set_is_ugly_args()): New variable and macros.
+
+Thu Feb 23 02:48:38 1995 Pedro A M Vazquez (vazquez@iqm.unicamp.br)
+
+ * g77.c (sys_errlist): Use const for __FreeBSD__ systems
+ as well.
+
+Wed Feb 22 13:33:43 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.10 released.
+
+ * CREDITS: Add Rick Niles.
+
+ * INSTALL: Note how to get around lack of makeinfo.
+
+ * Make-lang.in (f/proj.h): Remove # comment.
+
+ * Makefile.in (f/proj.h): Remove # comment.
+
+ * com.c (ffecom_expr_): Simplify opFUNCREF/opSUBRREF conversion.
+ (ffecom_sym_transform_): For whereGLOBAL and whereDUMMY
+ kindFUNCTION, use ffecom_tree_fun_type[][] only for non-constant
+ (non-statement-function) f2c functions.
+ (ffecom_init_0): ffecom_tree_fun_type[][] and _ptr_to_*_* are
+ really f2c-interface arrays, so use base type void for COMPLEX
+ (like CHARACTER).
+
+Tue Feb 21 19:01:18 1995 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in (f77.install-common): Expurgate the test for and
+ possible installation of f2c in line with elsewhere. Seems to have
+ been missing a semicolon anyhow!
+
+Tue Feb 21 11:45:25 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.9 released.
+
+ * Make-lang.in (f/proj.h): touch file to register update,
+ because the previous commands won't necessarily modify it.
+
+ * Makefile.in (f/proj.h): touch file to register update,
+ because the previous commands won't necessarily modify it.
+
+ * Makefile.in (f/str-*.h, f/str-*.j): Explicitly specify
+ output file names, so these targets go in build, not source,
+ directory.
+
+ * bits.c, bits.h: Switch to valid ANSI C replacement for
+ ARRAY_ZERO.
+
+ * com.c (ffecom_expr_): Add assignp arg to support ASSIGN better.
+ If assignp is TRUE, use different tree for FFEBLD_opSYMTER case.
+ (ffecom_sym_transform_assign_): New function.
+ (ffecom_expr_assign): New function.
+ (ffecom_expr_assign_w): New function.
+
+ * com.c (ffecom_f2c_make_type_): Do make_signed_type instead
+ of make_unsigned_type throughout.
+
+ * com.c (ffecom_finish_symbol_transform_): Expand scope of
+ commented-out code to probably produce faster compiler code.
+
+ * com.c (ffecom_gen_sfuncdef_): Push/pop calltemps so
+ COMPLEX works right.
+ Remove obsolete comment.
+
+ * com.c (ffecom_start_progunit_): If non-multi alt-entry
+ COMPLEX function, primary (static) entry point returns result
+ directory, not via extra arg -- to agree with ffecom_return_expr
+ and others.
+ Pretransform all symbols so statement functions are defined
+ before any code emitted.
+
+ * com.c (ffecom_finish_progunit): Don't posttransform all
+ symbols here -- pretransform them instead.
+
+ * com.c (ffecom_init_0): Don't warn about possible ASSIGN
+ crash, as this shouldn't happen now.
+
+ * com.c (ffecom_push_tempvar): Fix to handle temp vars
+ pushed while context is a statement (nested) function, and
+ add appropriate commentary.
+
+ * com.c (ffecom_return_expr): Check TREE_USED to determine
+ where return value is unset.
+
+ * com.h (struct _ffecom_symbol_): Add note about length_tree
+ now being used to keep tree for ASSIGN version of symbol.
+
+ * com.h (ffecom_expr_assign, ffecom_expr_assign_rw): New decls.
+ (error): Add this prototype for back-end function.
+
+ * fini.c (main): Grab input, output, and include names
+ directly off the command line instead of making the latter
+ two out of the first.
+
+ * lex.c: Improve tab handling for both fixed and free source
+ forms, and ignore carriage-returns on input, while generally
+ improving the code. ffelex_handle_tab_ has been renamed and
+ reinvented as ffelex_image_char_, among other things.
+
+ * malloc.c, malloc.h: Switch to valid ANSI C replacement for
+ ARRAY_ZERO, and kill the full number of bytes in pools and
+ areas.
+
+ * proj.h.in (ARRAY_ZERO, ARRAY_ZERO_SIZE): Remove.
+
+ * ste.c (ffeste_io_cilist_, ffeste_io_icilist_, ffeste_R838,
+ ffeste_R839): Issue diagnostic if a too-narrow variable used in an
+ ASSIGN context despite changes to this code and code in com.c.
+
+ * where.c, where.h: Switch to valid ANSI C replacement for
+ ARRAY_ZERO.
+
+Fri Feb 17 03:35:19 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.8 released.
+
+ * INSTALL: In quick-build case, list g77 target first so g77
+ gets installed. Also, explain that gcc gets built and installed
+ as well, even though this isn't really what we want (and maybe
+ we'll find a way around this someday).
+
+Fri Feb 17 02:35:41 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.7 released.
+
+ * Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Remove
+ ../ prefix in front of .h files, since they're in the cd.
+
+Fri Feb 17 01:50:48 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.6 released.
+
+Thu Feb 16 20:26:54 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * ../README.g77: Remove description of g77 as "not-yet-published".
+
+ * CREDITS: More changes.
+
+ * Make-lang.in (G77STAGESTUFF): Remove cktyps stuff.
+
+ * Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Don't
+ prefix gcc dir with $(srcdir) since these don't live there,
+ they are created in the build dir by gcc's configure. Add
+ a note explaining what these macros are about.
+ Update dependencies via deps-kinda.
+
+ * README.NEXTSTEP: Credit Toon, and per his request, add his
+ email address.
+
+ * com.h (FFECOM_DETERMINE_TYPES): #include "config.j".
+
+ * config.j, convert.j, flags.j, hconfig.j, rtl.j, tconfig.j,
+ tm.j, tree.j: Don't #include if already done.
+
+ * convert.j: #include "tree.j" first, as convert.h clearly depends
+ on trees being defined.
+
+ * rtl.j: #include "config.j" first, since there's some stuff
+ in rtl.h that assumes it has been #included.
+
+ * tree.j: #include "config.j" first, or real.h makes inconsistent
+ decision about return type of ereal_atof, leading to bugs, and
+ because tree.h/real.h assume config.h already included.
+
+Wed Feb 15 14:40:20 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.5 released.
+
+ * Copyright notices updated to be FSF-style.
+
+ * INSTALL: Some more clarification regarding building just f77.
+
+ * Make-lang.in (F77_SRCS): Update wrt changing some .h to .j.
+ (install-libf77): Fix typo in new parenthetical note.
+
+ * Makefile.in (f/*.o): Update.
+ (CONFIG_H, CONVERT_H, FLAGS_H, GLIMITS_H, HCONFIG_H, RTL_H,
+ TCONFIG_H, TM_H, TREE_H): Update/new symbols.
+ (deps-kinda): More fixes wrt changing some .h to .j.
+ Document and explain this rule a bit better.
+ Accommodate changes in output of gcc -MM.
+
+ * *.h, *.c: Change #include's so proj.h not assumed to #include
+ malloc.h or config.h (now config.j), and so new .j files are
+ used instead of old .h ones.
+
+ * com.c (ffecom_init_0): Use FLOAT_TYPE_SIZE for f2c's
+ TYLONG/TYLOGICAL type codes, to get g77 working on Alpha.
+
+ * com.h: Make all f2c-related integral types "int", not "long
+ int".
+
+ * config.j, convert.j, flags.j, glimits.j, hconfig.j, rtl.j,
+ tconfig.j, tm.j, tree.j: New files wrapping around gbe
+ .h files.
+
+ * config.h, convert.h, flags.h, glimits.h, hconfig.h, rtl.h,
+ tconfig.h, tm.h, tree.h: Deleted so new .j files
+ can #include the gbe files directly, instead of using "../",
+ and thus do better with various kinds of builds.
+
+ * proj.h: Delete unused NO_STDDEF and related stuff.
+
+Tue Feb 14 08:28:08 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * BUGS: Remove item #12, cross-compiling & autoconf scripts
+ reportedly expected to work properly (according to d.love).
+
+ * INSTALL: Add explanation of d.love's patch to config-lang.in.
+ Add explanation of how to install just g77 when gcc already installed.
+ Add note about usability of "-Wall". Add note about bug-
+ reporting.
+
+ * Make-lang.in ($(srcdir)/f/conf-proj): Add comment about why
+ conf-proj.out.
+ (install-libf77): Echo parenthetical note to user about how to do
+ just the (aborted) libf2c installation.
+ (deps-kinda): Update to work with new configuration/build stuff.
+
+ * bad.c (ffebad_finish): Put capitalized "warning:" &c message
+ as prefix on any diagnostic without pointers into source.
+
+ * bad.def (FFEBAD_TOO_BIG_INIT): Add this warning message.
+
+ * config-lang.in: Add Dave Love's patch to catch case where
+ back-end patches not applied and abort configuration.
+
+ * data.c (ffedata_gather_, ffedata_value_): Warn when about
+ to initialize a large aggregate area, due to design flaw resulting
+ in too much time/space used to handle such cases.
+ Use COMMON area name, and first notice of symbol, for multiple-
+ initialization diagnostic, instead of member symbol and unknown
+ location.
+ (FFEDATA_sizeTOO_BIG_INIT_): New macro per above.
+
+Mon Feb 13 13:54:26 1995 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in (F77_SRCS): Use $(srcdir)/f/proj.h.in, not
+ $(srcdir)/f/proj.h for build outside srcdir.
+
+Sun Feb 12 13:37:11 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * ../README.g77: Clarify procedures for unpacking, add asterisks
+ to mark important things the user must do.
+
+ * Fix dates in/add dates to ../README.g77, BUGS, CREDITS, DOC,
+ INSTALL, PROJECTS, README.
+
+Sun Feb 12 00:26:10 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.4 released.
+
+ * Make-lang.in (f/proj.h): Reproduce this rule here from
+ Makefile.in.
+ ($(srcdir)/f/conf-proj): Put autoconf's stdout in temp file
+ conf-proj.out, then mv to conf-proj only if successful, so
+ conf-proj not touched if autoconf not installed.
+
+ * Makefile.in ($(srcdir)/conf-proj): See Make-lang.in's similar
+ rule.
+
+Sat Feb 11 20:56:02 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * BUGS: Clarify some bugs.
+
+ * DOC: Many improvements and fixes.
+
+ * README: Move bulk of text, edited, to ../README.g77, and
+ replace with pointer to that file.
+
+ * com.c (ffecom_init_0): Comment out warning about sizeof(ftnlen)
+ as per ste.c change. Add text about ASSIGN to help user understand
+ what is being warned about.
+
+ * conf-proj.in: Fix typos in comments.
+
+ * proj.h.in: Add ARRAY_ZERO_SIZE to parallel malloc.h's version,
+ in case it proves to be needed.
+
+ * ste.c: Comment out assertions requiring sizeof(ftnlen) >=
+ sizeof(char *), in the hopes that overflow will never happen.
+ (ffeste_R838): Change assertion to fatal() with at least
+ partially helpful message.
+
+Sat Feb 11 12:38:00 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * com.c (ffecom_vardesc_): Crash if typecode is -1.
+
+ * ste.c (ffeste_io_dolio_): Crash if typecode is -1.
+
+Sat Feb 11 09:51:57 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * ste.c: In I/O code tests for item arrayness, sort of revert
+ to much earlier code that tests original exp, but also check
+ in newer way just in case. Newer way alone treated FOO(1:40)
+ as an array, not sure why older way alone didn't work, but I
+ think maybe it was when diagnosed code was involved, and
+ since there are now checks for error_mark_node, maybe the old
+ way alone would work. But better to be safe; both original
+ ffebld exp _and_ the transformed tree must indicate an array
+ for the size-determination code to be used, else just 1/2 elements
+ assumed. And this text is for EMACS: (foo at bar).
+
+Fri Feb 10 11:05:50 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * ste.c: In many cases, surround statement-expansion code
+ with ffecom_push_calltemps () and ffecom_pop_calltemps ()
+ so COMPLEX-returning functions can have temporaries pushed
+ in "auto-pop" mode and have them auto-popped at the end of
+ the statement.
+
+Wed Feb 8 14:35:10 1995 Dave Love <d.love@dl.ac.uk>
+
+ * runtime/f2c.h.in (ftnlen, ftnint): Make same size as integer.
+
+ * runtime/libI77/err.c (f_init): Thinko in MISSING_FILE_ELEMS
+ conditional.
+ * runtime/libI77/wrtfmt.c (mv_cur): Likewise.
+ * runtime/libI77/wsfe.c (x_putc): Likewise.
+
+ * runtime/libF77/signal_.c (signal_): Return 0 (this is a
+ subroutine).
+
+ * Makefile.in (f/proj.h): Depend on com.h.
+ * Make-lang.in (include/f2c.h): Likewise (and proj.h).
+ (install-libf77): Also install f2c.h.
+
+ * runtime/libI77/Makefile.in (*.o): Add f2c.h dependency.
+ * runtime/libF77/Makefile.in: Likewise.
+
+Wed Feb 8 13:56:47 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * stc.c (ffestc_R501_item): Don't reset kind/where to NONE when
+ setting basictype/kindtype info for symbol, or especially
+ its function/result twin, because kind/where might not be NONE.
+
+Tue Feb 7 14:47:26 1995 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in (include/f2c.h:): Set shell variable src more
+ robustly (independent of whether srcdir is relative or absolute).
+ * Makefile.in (f/proj.h:): Likewise.
+
+ * conf-proj.in: Check need for LAME_ASSERT. Fix indentation in
+ check for LAME_STDIO (cosmetic only with ANSI C).
+
+ * com.h: Extra ...SIZE stuff taken from com.c.
+
+ * com.c (FFECOM_DETERMINE_TYPES): Define before including com.h.
+ (BITS_PER_WORD etc.) Remove and use conditional definitions to com.h.
+
+ * runtime/configure.in: #define FFECOM_DETERMINE_TYPES for com.h in
+ f2c type determination.
+
+ * tm.h: Remove (at least pro tem) because of relative path and use
+ top-level one.
+
+ * Make-lang.in (include/f2c.h:): Set shell variable src more
+ robustly (independent of whether srcdir is relative or absolute).
+ * Makefile.in (f/proj.h:): Likewise.
+
+Mon Feb 6 19:58:32 1995 Dave Love <d.love@dl.ac.uk>
+
+ * g77.c (append_arg): Use K&R declaration for, e.g. SunOS4 build.
+
+Fri Feb 3 20:33:14 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * g77.c (main): Treat -l like filename in terms of -x handling.
+ Rewrite arglist mechanism for ease of maintenance.
+ Make sure every -lf2c is followed by -lm and vice versa.
+
+ * Make-lang.in: Put complete list of sources in F77_SRCS def
+ so changing a .h file, for example, causes rebuild.
+
+ * Makefile.in: Change test for nextstep to m68k-next-nextstep* so
+ all versions of nextstep on m68k get the necessary flag.
+
+Fri Feb 3 19:10:32 1995 Dave Love <d.love@dl.ac.uk>
+
+ * INSTALL: Note about possible conflict with existing libf2c.a and
+ f2c.h.
+
+ * Make-lang.in (f77.distclean): Tidy and move deletion of
+ f/config.cache to mostlyclean.
+ (install-libf77): Test for $(libdir)/libf2c.* and barf if found
+ unless F2CLIBOK defined.
+
+ * runtime/Makefile.in (all): Change path to include directory (and
+ elsewhere).
+ (INCLUDES): Remove (unused/misleading).
+ (distclean): Include f2c.h.
+ (clean): Include config.cache.
+
+ * runtime/libF77/Makefile.in (.SUFFIXES): Correct typo.
+ (ALL_CFLAGS) Fix up include search path to find f2c.h in top level
+ includes always.
+ (all): Depend on f2c.h.
+ * runtime/libI77/Makefile.in (.SUFFIXES): Likewise.
+
+Thu Feb 2 17:17:06 1995 Dave Love <d.love@dl.ac.uk>
+
+ * INSTALL: Note about --srcdir and GNU make.
+
+ * runtime/f2c.h.in (Pad_UDread, ALWAYS_FLUSH): Reomve the #defines
+ per below.
+
+ * runtime/configure.in (Pad_UDread, ALWAYS_FLUSH): Define these
+ here, not in f2c.h as they'r eonly relevant for building.
+ * runtime/configure: Regenerated.
+
+ * config-lang.in: Warn about using GNU make outside source tree
+ since I can't get Irix5 or SunOS4 makes to work in this case.
+
+ * Makefile.in (VPATH): Don't set it here.
+ (srcdir): Make it the normal `.' (overridden) at top level.
+ (all.indirect): New dependency `dircheck'.
+ (f771): Likewise
+ (dircheck): New target for foolproofing.
+ (f/proj.h:): Change finding source.
+ (CONFIG_H): Don't use this as the relative path in the include loses
+ f builddir != srcdir.
+
+ * config.h: Remove per CONFIG_H change above.
+
+ * Make-lang.in (F77_FLAGS_TO_PASS): Remove GCC_FOR_TARGET.
+ (f771:): Pass VPATH, srcdir to sub-make.
+ (f/Makefile:): New target.
+ (stmp-int-hdrs): new variable for cheating build.
+ (f77-runtime:): Alter GCC_FOR_TARGET treatment.
+ (include/f2c.h f/runtime/Makefile:) Likewise.
+ (f77-runtime-unsafe:): New (cheating) target.
+
+Thu Feb 2 12:09:51 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * BUGS: Update regarding losing EQUIVALENCE members in -g, and
+ regarding RS/6000 problems in the back end.
+
+ * CREDITS: Make some changes as requested.
+
+ * com.c (ffecom_member_trunk_): Remove unused static variable.
+ (ffecom_finish_symbol_transform_): Improve comments.
+ (ffecom_let_char_): Fix size of temp address-type var.
+ (ffecom_member_phase2_): Try fixing problem fixed by change
+ to ffecom_transform_equiv_ (f_m_p2_ function currently not used).
+ (ffecom_transform_equiv_): Remove def of unused static variable.
+ Comment-out use of ffecom_member_phase2_, until problems with
+ back end fixed.
+ (ffecom_push_tempvar): Fix assertion to not crash okay code.
+
+ * com.h: Remove old, commented-out code.
+ Add prototype for warning() in back end.
+
+ * ste.c (ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_,
+ ffeste_io_icilist_): Check correct type of variable for arrayness.
+
+Sun Jan 29 14:41:42 1995 Dave Love <d.love@dl.ac.uk>
+
+ * BUGS: Remove references to my configure bugs; add another.
+
+ * runtime/Makefile.in (AR_FLAGS): Provide default value.
+
+ * runtime/f2c.h.in (integer, logical): Take typedefs from
+ F2C_INTEGER configuration parameter again.
+ (NON_UNIX_STDIO): don't define it.
+
+ * runtime/configure.in: Bring type checks for f2c.h in line with
+ com.h.
+ (MISSING_FILE_ELEMS): New variable to determine whether the relevant
+ elements of the FILE struct exist, independent of NON_UNIX_STDIO.
+ * runtime/libI77/{err,wrtfmt,wsfe}.c (MISSING_FILE_ELEMS): Use new
+ parameter.
+
+ * config-lang.in: Comment out more of f2c rules (c.f. Make-lang.in).
+ (This stuff is relevant iff you gave configure --enable-f2c.)
+ Create f/runtime directory tree iff not building in source
+ directory.
+
+ * Makefile.in (srcdir): Append slash so we get the right value when
+ not building in the source directory. This is a consequence of not
+ building the `f' sources in `f'.
+ (VPATH): Override configure's value for reasons above.
+ (f/proj.h f/conf-proj): New rules to build proj.h by
+ autoconfiguration.
+
+ * proj.h: Rename to proj.h.in for autoconfiguration.
+ * proj.h.in: New as above.
+ * conf-proj conf-proj.in: New files for autoconfiguration.
+
+ * Make-lang.in (include/f2c.h f/runtime/Makefile:): Change the order
+ of setting the sh variables so that the right GCC_FOR_TARGET is
+ used.
+ (f77.*clean:) Add products of new configuration files and make sure
+ all the *clean targets do something (unlike the ones in
+ cp/Make-lange.in).
+
+ * com.h (FFECOM_f2cINTEGER, FFECOM_f2cLOGICAL): Define as long or
+ int appropriately to ensure sizeof(real) == sizeof(integer).
+
+ * PROJECTS: Library section.
+
+ * runtime/libI77/endfile.c: Don't #include sys/types.h conditional
+ on NON_UNIX_STDIO since rawio.h needs size_t.
+ * runtime/libI77/uio.c: #include <sys/types.h> for size_t if not
+ KR_headers.
+
+Wed Jan 25 03:31:51 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.3 released.
+
+ * INSTALL: Revise.
+
+ * Make-lang.in: Comment out rules for building f2c itself (f/f2c/).
+
+ * README: Revise.
+
+ * com.c (ffecom_init_0): Warn if ftnlen or INTEGER not big enough
+ to hold a char *.
+
+ * gbe/2.6.2.diff: Update.
+
+Mon Jan 23 17:10:49 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * TODO: Remove.
+ BUGS: New file.
+ PROJECTS: New file.
+ CREDITS: New file.
+
+ * cktyps*: Remove.
+ Make-lang.in: Remove cktyps stuff.
+ Makefile.in: Remove cktyps stuff.
+
+ * DOC: Add info on changes for 0.5.3.
+
+ * bad.c: Put "warning:" &c on diagnostic messages.
+ Don't output informational messages if warnings disabled.
+
+Thu Jan 19 12:38:13 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * g77.c: Avoid putting out useless "-xnone -xf77" pairs so
+ larger command lines can be accommodated.
+ Recognize both `-xlang' and `-x lang'.
+ Recognize `-xnone' and `-x none' to mean what it does, instead
+ of treating "none" as any other language.
+ Some minor, slight improvements in the way args are handled
+ (hopefully for clearer, more maintainable code), including
+ consistency checks on arg count just in case.
+
+Wed Jan 18 16:41:57 1995 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * DOC: Explain -fautomatic better.
+
+ * INSTALL: Describe libf2c.a better.
+
+ * Make-lang.in, Makefile.in: Build f771 &c with gcc/ as cd instead
+ of gcc/f/ so debugging info is better (source file tracking).
+ Add new source file type.c.
+
+ * Makefile.in: For nextstep3, link f771 with -segaddr __DATA
+ 6000000. Fix typo. Change deps-kinda target to handle building
+ from gcc/. Update dependencies.
+
+ * bld-op.def, bld.h, bld.c: Remove opBACKEND and all related
+ stuff.
+ Remove consistency tests that cause compiler warnings.
+
+ * cktyps.c: Remove all typing checking.
+
+ * com-rt.def: Change all rttypeFLOAT_ intrinsics to rttypeDOUBLE_,
+ to precisely match how they're declared in libf2c.
+
+ * com.h, com.c: Revise to more elegantly track related stuff
+ in the version of f2c.h used to build libf2c.
+
+ * com.c: Increase FFECOM_sizeMAXSTACKITEM, and if 0 or undefined
+ when checked to determine where to put entity, treat as infinite.
+ Rewrite temporary mechanism to be based on trees instead of
+ ffeinfo stuff, and make it much simpler. Change interface
+ accordingly.
+ Fixes to better track types of things, make appropriate
+ conversions, etc. E.g. when making an arg for a libf2c
+ function, make sure it's of the right type (such as ftnlen).
+ Delete opBACKEND transformation code.
+ (ffecom_init_0): Smoother initialization of types, especially
+ paying attention to using consistent rules for making INTEGER,
+ REAL, DOUBLE PRECISION, etc., and for deciding their "*N"
+ and kind values that will work across all g77 platforms.
+ No longer require per-target configuration info in target.h
+ or config/*/*; use new type module to store size, alignment.
+ (ffecom_member_phase2): Declare COMMON/EQUIVALENCE group members
+ so debugger sees them.
+ (ffecom_finish_progunit): Transform all symbols in program unit,
+ so -g will show they all exist.
+
+ * expr.c (ffeexpr_collapse_substr): Handle strange substring
+ range values.
+
+ * info.h, info.c: Provide connection to new type module.
+ Remove tests that yield compiler warnings.
+
+ * intrin.c (ffeintrin_is_intrinsic): Properly handle deleted
+ intrinsic.
+
+ * lex.c (ffelex_file_fixed): Remove redundant/buggy code.
+
+ * stc.c (ffestc_kindtype_kind_, ffestc_kindtype_star_): Replace
+ boring switch stmt with simple call to new type module. This
+ sort of thing is a reason to get up in the morning.
+
+ * ste.c: Update to handle new interface for
+ ffecom_push/pop_tempvar.
+ Fixes to better track types of things.
+ Fixes to not crash for certain diagnosed constructs.
+ (ffeste_begin_iterdo_): Check only constants for overflow to avoid
+ spurious diagnostics.
+ Don't convert larger integer (say, INTEGER*8) to canonical integer
+ for iteration count.
+
+ * stw.h: Track DO iteration count temporary variable.
+
+ * symbol.c: Remove consistency tests that cause compiler warnings.
+
+ * target.c (ffetarget_aggregate_info): Replace big switch with
+ little call to new type module.
+ (ffetarget_layout): Remove consistency tests that cause
+ compiler warnings.
+ (ffetarget_convert_character1_typeless): Pick up length of
+ typeless type from new type module.
+
+ * target.h: Crash build if target float bit pattern cannot be
+ precisely determined.
+ Remove all the type cruft now determined by ffecom_init_0
+ at invocation time and maintained in new type module.
+ Put casts on second arg of all REAL_VALUE_TO_TARGET_DOUBLE
+ uses so compiler warnings avoided (requires target float bit
+ pattern to be precisely determined, hence code to crash build).
+
+ * top.c: Add inits/terminates for new type module.
+
+ * type.h, type.c: New module.
+
+ * gbe/2.6.2.diff: Remove all patches to files in gcc/config/
+ directory and its subdirectories.
+
+Mon Jan 9 19:23:25 1995 Dave Love <d.love@dl.ac.uk>
+
+ * com.h (FFECOM_F2C_INTEGER_TYPE_NODE): Define and use instead of
+ long_integer_type_node where appropriate.
+
+Tue Jan 3 14:56:18 1995 Dave Love <d.love@dl.ac.uk>
+
+ * com.h: Make ffecom_f2c_logical_type_node long, consistent with
+ integer.
+
+Fri Dec 2 20:07:37 1994 Dave Love <d.love@dl.ac.uk>
+
+ * config-lang.in (stagestuff): Add f2c conditionally.
+ * Make-lang.in: Add f2c and related targets.
+ * f2c: Add the directory.
+
+Fri Nov 25 22:17:26 1994 Dave Love <d.love@dl.ac.uk>
+
+ * Makefile.in (FLAGS_TO_PASS): pass $(CROSS)
+ * Make-lang.in: more changes to runtime targets
+
+Thu Nov 24 18:03:21 1994 Dave Love <d.love@dl.ac.uk>
+
+ * Makefile.in (FLAGS_TO_PASS): define for sub-makes
+
+ * g77.c (main): change f77-cpp-output to f77-cpp-input (.F files)
+
+Wed Nov 23 15:22:53 1994 Dave Love <d.love@dl.ac.uk>
+
+ * bad.c (ffebad_finish): kluge to fool emacs19 into finding errors:
+ add trailing space to <file>:<line>:
+
+Tue Nov 22 11:30:50 1994 Dave Love <d.love@dl.ac.uk>
+
+ * runtime/libF77/signal_.c (RETSIGTYPE): added
+
+Mon Nov 21 13:04:13 1994 Dave Love <d.love@dl.ac.uk>
+
+ * Makefile.in (compiler): add runtime
+
+ * config-lang.in (stagestuff): add libf2c.a to stagestuff
+
+ * Make-lang.in:
+ G77STAGESTUFF <- MORESTAGESTUFF
+ f77-runtime: new target, plus supporting ones
+
+ * runtime: add the directory, containing libI77, libF77 and autoconf
+ stuff
+
+ * g++.1: remove
+
+ * g77.1: minor fixes
+
+Thu Nov 17 15:18:05 1994 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.2 released.
+
+ * bad.def: Modify wording of FFEBAD_UNIMPL_STMT to indicate
+ that it covers a wide array of possible problems (that, someday,
+ should be handled via separate diagnostics).
+
+ * lex.c: Allow $ in identifiers if -fdollar-ok.
+ * top.c: Support -fdollar-ok.
+ * top.h: Support -fdollar-ok.
+ * target.h: Support -fdollar-ok.
+ * DOC: Describe -fdollar-ok.
+
+ * std.c (ffestd_R1229_finish): Fix bug so stand-alone build works.
+ * ste.c (ffeste_R819A): Fix bug so stand-alone build works.
+
+ * Make: Improvements for stand-alone build.
+
+ * Makefile.in: Fix copyright text at top of file.
+
+ * LINK, SRCS, UNLINK: Removed. Not particularly useful now that
+ g77 sources live in their own subdirectory.
+
+ * g77.c (main): Cast arg to bzero to avoid warning. (This is
+ identical to Kenner's fix to cp/g++.c.)
+
+ * gbe/: New subdirectory, to contain .diff files for various
+ versions of the GNU CC back end.
+
+ * gbe/README: New file.
+ * gbe/2.6.2.diff: New file.
+
+Tue Nov 8 10:23:10 1994 Dave Love <d.love@dl.ac.uk>
+
+ * Make-lang.in: don't install as f77 as well as g77 to avoid
+ confusion with system's compiler (especially while testing)
+
+ * g77.c (main): use -lf2c and -lm; fix sense of test for .f/.F files
+
+Fri Oct 28 09:45:00 1994 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.1 released.
+
+ * gcc.c: Invoke f771 instead of f-771.
+
+Fri Oct 28 02:00:44 1994 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Version 0.5.0 released.
+
+Fri Oct 14 15:03:35 1994 Craig Burley (burley@gnu.ai.mit.edu)
+
+ * Makefile.in: Handle the Fortran-77 front-end in a subdirectory.
+ * f-*: Move Fortran-77 front-end to f/*.
diff --git a/gcc/f/INSTALL b/gcc/f/INSTALL
new file mode 100644
index 00000000000..97423be1498
--- /dev/null
+++ b/gcc/f/INSTALL
@@ -0,0 +1,1517 @@
+This file contains installation information for the GNU Fortran
+compiler. Copyright (C) 1995, 1996 Free Software Foundation, Inc. You
+may copy, distribute, and modify it freely as long as you preserve this
+copyright notice and permission notice.
+
+Installing GNU Fortran
+**********************
+
+ The following information describes how to install `g77'.
+
+ The information in this file generally pertains to dealing with
+*source* distributions of `g77' and `gcc'. It is possible that some of
+this information will be applicable to some *binary* distributions of
+these products--however, since these distributions are not made by the
+maintainers of `g77', responsibility for binary distributions rests with
+whoever built and first distributed them.
+
+ Nevertheless, efforts to make `g77' easier to both build and install
+from source and package up as a binary distribution are ongoing.
+
+Prerequisites
+=============
+
+ The procedures described to unpack, configure, build, and install
+`g77' assume your system has certain programs already installed.
+
+ The following prerequisites should be met by your system before you
+follow the `g77' installation instructions:
+
+`gzip'
+ To unpack the `gcc' and `g77' distributions, you'll need the
+ `gunzip' utility in the `gzip' distribution. Most UNIX systems
+ already have `gzip' installed. If yours doesn't, you can get it
+ from the FSF.
+
+ Note that you'll need `tar' and other utilities as well, but all
+ UNIX systems have these. There are GNU versions of all these
+ available--in fact, a complete GNU UNIX system can be put together
+ on most systems, if desired.
+
+`gcc-2.7.2.2.tar.gz'
+ You need to have this, or some other applicable, version of `gcc'
+ on your system. The version should be an exact copy of a
+ distribution from the FSF. It is approximately 7MB large.
+
+ If you've already unpacked `gcc-2.7.2.2.tar.gz' into a directory
+ (named `gcc-2.7.2.2') called the "source tree" for `gcc', you can
+ delete the distribution itself, but you'll need to remember to
+ skip any instructions to unpack this distribution.
+
+ Without an applicable `gcc' source tree, you cannot build `g77'.
+ You can obtain an FSF distribution of `gcc' from the FSF.
+
+`g77-0.5.21.tar.gz'
+ You probably have already unpacked this distribution, or you are
+ reading an advanced copy of this manual, which is contained in
+ this distribution. This distribution approximately 1MB large.
+
+ You can obtain an FSF distribution of `g77' from the FSF, the same
+ way you obtained `gcc'.
+
+100MB disk space
+ For a complete "bootstrap" build, about 100MB of disk space is
+ required for `g77' by the author's current GNU/Linux system.
+
+ Some juggling can reduce the amount of space needed; during the
+ bootstrap process, once Stage 3 starts, during which the version
+ of `gcc' that has been copied into the `stage2/' directory is used
+ to rebuild the system, you can delete the `stage1/' directory to
+ free up some space.
+
+ It is likely that many systems don't require the complete
+ bootstrap build, as they already have a recent version of `gcc'
+ installed. Such systems might be able to build `g77' with only
+ about 75MB of free space.
+
+`patch'
+ Although you can do everything `patch' does yourself, by hand,
+ without much trouble, having `patch' installed makes installation
+ of new versions of GNU utilities such as `g77' so much easier that
+ it is worth getting. You can obtain `patch' the same way you
+ obtained `gcc' and `g77'.
+
+ In any case, you can apply patches by hand--patch files are
+ designed for humans to read them.
+
+`make'
+ Your system must have `make', and you will probably save yourself
+ a lot of trouble if it is GNU `make' (sometimes referred to as
+ `gmake').
+
+`cc'
+ Your system must have a working C compiler.
+
+ *Note Installing GNU CC: (gcc)Installation, for more information
+ on prerequisites for installing `gcc'.
+
+`bison'
+ If you do not have `bison' installed, you can usually work around
+ any need for it, since `g77' itself does not use it, and `gcc'
+ normally includes all files generated by running it in its
+ distribution. You can obtain `bison' the same way you obtained
+ `gcc' and `g77'.
+
+ *Note Missing bison?::, for information on how to work around not
+ having `bison'.
+
+`makeinfo'
+ If you are missing `makeinfo', you can usually work around any
+ need for it. You can obtain `makeinfo' the same way you obtained
+ `gcc' and `g77'.
+
+ *Note Missing makeinfo?::, for information on getting around the
+ lack of `makeinfo'.
+
+`root' access
+ To perform the complete installation procedures on a system, you
+ need to have `root' access to that system, or equivalent access.
+
+ Portions of the procedure (such as configuring and building `g77')
+ can be performed by any user with enough disk space and virtual
+ memory.
+
+ However, these instructions are oriented towards less-experienced
+ users who want to install `g77' on their own personal systems.
+
+ System administrators with more experience will want to determine
+ for themselves how they want to modify the procedures described
+ below to suit the needs of their installation.
+
+Problems Installing
+===================
+
+ This is a list of problems (and some apparent problems which don't
+really mean anything is wrong) that show up when configuring, building,
+installing, or porting GNU Fortran.
+
+ *Note Installation Problems: (gcc)Installation Problems, for more
+information on installation problems that can afflict either `gcc' or
+`g77'.
+
+General Problems
+----------------
+
+ These problems can occur on most or all systems.
+
+GNU C Required
+..............
+
+ Compiling `g77' requires GNU C, not just ANSI C. Fixing this
+wouldn't be very hard (just tedious), but the code using GNU extensions
+to the C language is expected to be rewritten for 0.6 anyway, so there
+are no plans for an interim fix.
+
+ This requirement does not mean you must already have `gcc' installed
+to build `g77'. As long as you have a working C compiler, you can use a
+bootstrap build to automate the process of first building `gcc' using
+the working C compiler you have, then building `g77' and rebuilding
+`gcc' using that just-built `gcc', and so on.
+
+Patching GNU CC Necessary
+.........................
+
+ `g77' currently requires application of a patch file to the gcc
+compiler tree. The necessary patches should be folded in to the
+mainline gcc distribution.
+
+ Some combinations of versions of `g77' and `gcc' might actually
+*require* no patches, but the patch files will be provided anyway as
+long as there are more changes expected in subsequent releases. These
+patch files might contain unnecessary, but possibly helpful, patches.
+As a result, it is possible this issue might never be resolved, except
+by eliminating the need for the person configuring `g77' to apply a
+patch by hand, by going to a more automated approach (such as
+configure-time patching).
+
+Building GNU CC Necessary
+.........................
+
+ It should be possible to build the runtime without building `cc1'
+and other non-Fortran items, but, for now, an easy way to do that is
+not yet established.
+
+Missing strtoul
+...............
+
+ On SunOS4 systems, linking the `f771' program produces an error
+message concerning an undefined symbol named `_strtoul'.
+
+ This is not a `g77' bug. *Note Patching GNU Fortran::, for
+information on a workaround provided by `g77'.
+
+ The proper fix is either to upgrade your system to one that provides
+a complete ANSI C environment, or improve `gcc' so that it provides one
+for all the languages and configurations it supports.
+
+ *Note:* In earlier versions of `g77', an automated workaround for
+this problem was attempted. It worked for systems without `_strtoul',
+substituting the incomplete-yet-sufficient version supplied with `g77'
+for those systems. However, the automated workaround failed
+mysteriously for systems that appeared to have conforming ANSI C
+environments, and it was decided that, lacking resources to more fully
+investigate the problem, it was better to not punish users of those
+systems either by requiring them to work around the problem by hand or
+by always substituting an incomplete `strtoul()' implementation when
+their systems had a complete, working one. Unfortunately, this meant
+inconveniencing users of systems not having `strtoul()', but they're
+using obsolete (and generally unsupported) systems anyway.
+
+Object File Differences
+.......................
+
+ A comparison of object files after building Stage 3 during a
+bootstrap build will result in `gcc/f/zzz.o' being flagged as different
+from the Stage 2 version. That is because it contains a string with an
+expansion of the `__TIME__' macro, which expands to the current time of
+day. It is nothing to worry about, since `gcc/f/zzz.c' doesn't contain
+any actual code. It does allow you to override its use of `__DATE__'
+and `__TIME__' by defining macros for the compilation--see the source
+code for details.
+
+Cleanup Kills Stage Directories
+...............................
+
+ It'd be helpful if `g77''s `Makefile.in' or `Make-lang.in' would
+create the various `stageN' directories and their subdirectories, so
+developers and expert installers wouldn't have to reconfigure after
+cleaning up.
+
+Missing `gperf'?
+................
+
+ If a build aborts trying to invoke `gperf', that strongly suggests
+an improper method was used to create the `gcc' source directory, such
+as the UNIX `cp -r' command instead of `cp -pr', since this problem
+very likely indicates that the date-time-modified information on the
+`gcc' source files is incorrect.
+
+ The proper solution is to recreate the `gcc' source directory from a
+`gcc' distribution known to be provided by the FSF.
+
+ It is possible you might be able to temporarily work around the
+problem, however, by trying these commands:
+
+ sh# cd gcc
+ sh# touch c-gperf.h
+ sh#
+
+ These commands update the date-time-modified information for the
+file produced by the invocation of `gperf' in the current versions of
+`gcc', so that `make' no longer believes it needs to update it. This
+file should already exist in a `gcc' distribution, but mistakes made
+when copying the `gcc' directory can leave the modification information
+set such that the `gperf' input files look more "recent" than the
+corresponding output files.
+
+ If the above does not work, definitely start from scratch and avoid
+copying the `gcc' using any method that does not reliably preserve
+date-time-modified information, such as the UNIX `cp -r' command.
+
+Cross-compiler Problems
+-----------------------
+
+ `g77' has been in alpha testing since September of 1992, and in
+public beta testing since February of 1995. Alpha testing was done by
+a small number of people worldwide on a fairly wide variety of
+machines, involving self-compilation in most or all cases. Beta
+testing has been done primarily via self-compilation, but in more and
+more cases, cross-compilation (and "criss-cross compilation", where a
+version of a compiler is built on one machine to run on a second and
+generate code that runs on a third) has been tried and has succeeded,
+to varying extents.
+
+ Generally, `g77' can be ported to any configuration to which `gcc',
+`f2c', and `libf2c' can be ported and made to work together, aside from
+the known problems described in this manual. If you want to port `g77'
+to a particular configuration, you should first make sure `gcc' and
+`libf2c' can be ported to that configuration before focusing on `g77',
+because `g77' is so dependent on them.
+
+ Even for cases where `gcc' and `libf2c' work, you might run into
+problems with cross-compilation on certain machines, for several
+reasons.
+
+ * There is one known bug (a design bug to be fixed in 0.6) that
+ prevents configuration of `g77' as a cross-compiler in some cases,
+ though there are assumptions made during configuration that
+ probably make doing non-self-hosting builds a hassle, requiring
+ manual intervention.
+
+ * `gcc' might still have some trouble being configured for certain
+ combinations of machines. For example, it might not know how to
+ handle floating-point constants.
+
+ * Improvements to the way `libf2c' is built could make building
+ `g77' as a cross-compiler easier--for example, passing and using
+ `LD' and `AR' in the appropriate ways.
+
+ * There are still some challenges putting together the right
+ run-time libraries (needed by `libf2c') for a target system,
+ depending on the systems involved in the configuration. (This is
+ a general problem with cross-compilation, and with `gcc' in
+ particular.)
+
+Changing Settings Before Building
+=================================
+
+ Here are some internal `g77' settings that can be changed by editing
+source files in `gcc/f/' before building.
+
+ This information, and perhaps even these settings, represent
+stop-gap solutions to problems people doing various ports of `g77' have
+encountered. As such, none of the following information is expected to
+be pertinent in future versions of `g77'.
+
+Larger File Unit Numbers
+------------------------
+
+ As distributed, whether as part of `f2c' or `g77', `libf2c' accepts
+file unit numbers only in the range 0 through 99. For example, a
+statement such as `WRITE (UNIT=100)' causes a run-time crash in
+`libf2c', because the unit number, 100, is out of range.
+
+ If you know that Fortran programs at your installation require the
+use of unit numbers higher than 99, you can change the value of the
+`MXUNIT' macro, which represents the maximum unit number, to an
+appropriately higher value.
+
+ To do this, edit the file `f/runtime/libI77/fio.h' in your `g77'
+source tree, changing the following line:
+
+ #define MXUNIT 100
+
+ Change the line so that the value of `MXUNIT' is defined to be at
+least one *greater* than the maximum unit number used by the Fortran
+programs on your system.
+
+ (For example, a program that does `WRITE (UNIT=255)' would require
+`MXUNIT' set to at least 256 to avoid crashing.)
+
+ Then build or rebuild `g77' as appropriate.
+
+ *Note:* Changing this macro has *no* effect on other limits your
+system might place on the number of files open at the same time. That
+is, the macro might allow a program to do `WRITE (UNIT=100)', but the
+library and operating system underlying `libf2c' might disallow it if
+many other files have already been opened (via `OPEN' or implicitly via
+`READ', `WRITE', and so on). Information on how to increase these
+other limits should be found in your system's documentation.
+
+Always Flush Output
+-------------------
+
+ Some Fortran programs require output (writes) to be flushed to the
+operating system (under UNIX, via the `fflush()' library call) so that
+errors, such as disk full, are immediately flagged via the relevant
+`ERR=' and `IOSTAT=' mechanism, instead of such errors being flagged
+later as subsequent writes occur, forcing the previously written data
+to disk, or when the file is closed.
+
+ Essentially, the difference can be viewed as synchronous error
+reporting (immediate flagging of errors during writes) versus
+asynchronous, or, more precisely, buffered error reporting (detection
+of errors might be delayed).
+
+ `libf2c' supports flagging write errors immediately when it is built
+with the `ALWAYS_FLUSH' macro defined. This results in a `libf2c' that
+runs slower, sometimes quite a bit slower, under certain
+circumstances--for example, accessing files via the networked file
+system NFS--but the effect can be more reliable, robust file I/O.
+
+ If you know that Fortran programs requiring this level of precision
+of error reporting are to be compiled using the version of `g77' you
+are building, you might wish to modify the `g77' source tree so that
+the version of `libf2c' is built with the `ALWAYS_FLUSH' macro defined,
+enabling this behavior.
+
+ To do this, find this line in `f/runtime/configure.in' in your `g77'
+source tree:
+
+ dnl AC_DEFINE(ALWAYS_FLUSH)
+
+ Remove the leading `dnl ', so the line begins with `AC_DEFINE(', and
+run `autoconf' in that file's directory. (Or, if you don't have
+`autoconf', you can modify `f2c.h.in' in the same directory to include
+the line `#define ALWAYS_FLUSH' after `#define F2C_INCLUDE'.)
+
+ Then build or rebuild `g77' as appropriate.
+
+Maximum Stackable Size
+----------------------
+
+ `g77', on most machines, puts many variables and arrays on the stack
+where possible, and can be configured (by changing
+`FFECOM_sizeMAXSTACKITEM' in `gcc/f/com.c') to force smaller-sized
+entities into static storage (saving on stack space) or permit
+larger-sized entities to be put on the stack (which can improve
+run-time performance, as it presents more opportunities for the GBE to
+optimize the generated code).
+
+ *Note:* Putting more variables and arrays on the stack might cause
+problems due to system-dependent limits on stack size. Also, the value
+of `FFECOM_sizeMAXSTACKITEM' has no effect on automatic variables and
+arrays. *Note But-bugs::, for more information.
+
+Floating-point Bit Patterns
+---------------------------
+
+ The `g77' build will crash if an attempt is made to build it as a
+cross-compiler for a target when `g77' cannot reliably determine the
+bit pattern of floating-point constants for the target. Planned
+improvements for g77-0.6 will give it the capabilities it needs to not
+have to crash the build but rather generate correct code for the target.
+(Currently, `g77' would generate bad code under such circumstances if
+it didn't crash during the build, e.g. when compiling a source file
+that does something like `EQUIVALENCE (I,R)' and `DATA R/9.43578/'.)
+
+Initialization of Large Aggregate Areas
+---------------------------------------
+
+ A warning message is issued when `g77' sees code that provides
+initial values (e.g. via `DATA') to an aggregate area (`COMMON' or
+`EQUIVALENCE', or even a large enough array or `CHARACTER' variable)
+that is large enough to increase `g77''s compile time by roughly a
+factor of 10.
+
+ This size currently is quite small, since `g77' currently has a
+known bug requiring too much memory and time to handle such cases. In
+`gcc/f/data.c', the macro `FFEDATA_sizeTOO_BIG_INIT_' is defined to the
+minimum size for the warning to appear. The size is specified in
+storage units, which can be bytes, words, or whatever, on a
+case-by-case basis.
+
+ After changing this macro definition, you must (of course) rebuild
+and reinstall `g77' for the change to take effect.
+
+ Note that, as of version 0.5.18, improvements have reduced the scope
+of the problem for *sparse* initialization of large arrays, especially
+those with large, contiguous uninitialized areas. However, the warning
+is issued at a point prior to when `g77' knows whether the
+initialization is sparse, and delaying the warning could mean it is
+produced too late to be helpful.
+
+ Therefore, the macro definition should not be adjusted to reflect
+sparse cases. Instead, adjust it to generate the warning when densely
+initialized arrays begin to cause responses noticeably slower than
+linear performance would suggest.
+
+Alpha Problems Fixed
+--------------------
+
+ `g77' used to warn when it was used to compile Fortran code for a
+target configuration that is not basically a 32-bit machine (such as an
+Alpha, which is a 64-bit machine, especially if it has a 64-bit
+operating system running on it). That was because `g77' was known to
+not work properly on such configurations.
+
+ As of version 0.5.20, `g77' is believed to work well enough on such
+systems. So, the warning is no longer needed or provided.
+
+ However, support for 64-bit systems, especially in areas such as
+cross-compilation and handling of intrinsics, is still incomplete. The
+symptoms are believed to be compile-time diagnostics rather than the
+generation of bad code. It is hoped that version 0.6 will completely
+support 64-bit systems.
+
+Quick Start
+===========
+
+ This procedure configures, builds, and installs `g77' "out of the
+box" and works on most UNIX systems. Each command is identified by a
+unique number, used in the explanatory text that follows. For the most
+part, the output of each command is not shown, though indications of
+the types of responses are given in a few cases.
+
+ To perform this procedure, the installer must be logged in as user
+`root'. Much of it can be done while not logged in as `root', and
+users experienced with UNIX administration should be able to modify the
+procedure properly to do so.
+
+ Following traditional UNIX conventions, it is assumed that the
+source trees for `g77' and `gcc' will be placed in `/usr/src'. It also
+is assumed that the source distributions themselves already reside in
+`/usr/FSF', a naming convention used by the author of `g77' on his own
+system:
+
+ /usr/FSF/gcc-2.7.2.2.tar.gz
+ /usr/FSF/g77-0.5.21.tar.gz
+
+ Users of the following systems should not blindly follow these
+quick-start instructions, because of problems their systems have coping
+with straightforward installation of `g77':
+
+ * SunOS4
+
+ Instead, see *Note Complete Installation::, for detailed information
+on how to configure, build, and install `g77' for your particular
+system. Also, see *Note Known Causes of Trouble with GNU Fortran:
+Trouble, for information on bugs and other problems known to afflict the
+installation process, and how to report newly discovered ones.
+
+ If your system is *not* on the above list, and *is* a UNIX system or
+one of its variants, you should be able to follow the instructions
+below. If you vary *any* of the steps below, you might run into
+trouble, including possibly breaking existing programs for other users
+of your system. Before doing so, it is wise to review the explanations
+of some of the steps. These explanations follow this list of steps.
+
+ sh[ 1]# cd /usr/src
+
+ sh[ 2]# gunzip -c < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -
+ [Might say "Broken pipe"...that is normal on some systems.]
+
+ sh[ 3]# gunzip -c < /usr/FSF/g77-0.5.21.tar.gz | tar xf -
+ ["Broken pipe" again possible.]
+
+ sh[ 4]# ln -s gcc-2.7.2.2 gcc
+
+ sh[ 5]# ln -s g77-0.5.21 g77
+
+ sh[ 6]# mv -i g77/* gcc
+ [No questions should be asked by mv here; or, you made a mistake.]
+
+ sh[ 7]# patch -p1 -V t -d gcc < gcc/f/gbe/2.7.2.2.diff
+ [Unless patch complains about rejected patches, this step worked.]
+
+ sh[ 8]# cd gcc
+ sh[ 9]# touch f77-install-ok
+ [Do not do the above if your system already has an f77
+ command, unless you've checked that overwriting it
+ is okay.]
+
+ sh[10]# touch f2c-install-ok
+ [Do not do the above if your system already has an f2c
+ command, unless you've checked that overwriting it
+ is okay. Else, touch f2c-exists-ok.]
+
+ sh[11]# ./configure --prefix=/usr
+ [Do not do the above if gcc is not installed in /usr/bin.
+ You might need a different --prefix=..., as
+ described below.]
+
+ sh[12]# make bootstrap
+ [This takes a long time, and is where most problems occur.]
+
+ sh[13]# rm -fr stage1
+
+ sh[14]# make -k install
+ [The actual installation.]
+
+ sh[15]# g77 -v
+ [Verify that g77 is installed, obtain version info.]
+
+ sh[16]#
+
+ *Note Updating Your Info Directory: Updating Documentation, for
+information on how to update your system's top-level `info' directory
+to contain a reference to this manual, so that users of `g77' can
+easily find documentation instead of having to ask you for it.
+
+ Elaborations of many of the above steps follows:
+
+Step 1: `cd /usr/src'
+ You can build `g77' pretty much anyplace. By convention, this
+ manual assumes `/usr/src'. It might be helpful if other users on
+ your system knew where to look for the source code for the
+ installed version of `g77' and `gcc' in any case.
+
+Step 3: `gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -'
+ It is not always necessary to obtain the latest version of `g77'
+ as a complete `.tar.gz' file if you have a complete, earlier
+ distribution of `g77'. If appropriate, you can unpack that earlier
+ version of `g77', and then apply the appropriate patches to
+ achieve the same result--a source tree containing version 0.5.21
+ of `g77'.
+
+Step 4: `ln -s gcc-2.7.2.2 gcc'
+
+Step 5: `ln -s g77-0.5.21 g77'
+ These commands mainly help reduce typing, and help reduce visual
+ clutter in examples in this manual showing what to type to install
+ `g77'.
+
+ *Note Unpacking::, for information on using distributions of `g77'
+ made by organizations other than the FSF.
+
+Step 6: `mv -i g77/* gcc'
+ After doing this, you can, if you like, type `rm g77' and `rmdir
+ g77-0.5.21' to remove the empty directory and the symbol link to
+ it. But, it might be helpful to leave them around as quick
+ reminders of which version(s) of `g77' are installed on your
+ system.
+
+ *Note Unpacking::, for information on the contents of the `g77'
+ directory (as merged into the `gcc' directory).
+
+Step 7: `patch -p1 ...'
+ This can produce a wide variety of printed output, from `Hmm, I
+ can't seem to find a patch in there anywhere...' to long lists of
+ messages indicated that patches are being found, applied
+ successfully, and so on.
+
+ If messages about "fuzz", "offset", or especially "reject files"
+ are printed, it might mean you applied the wrong patch file. If
+ you believe this is the case, it is best to restart the sequence
+ after deleting (or at least renaming to unused names) the
+ top-level directories for `g77' and `gcc' and their symbolic links.
+
+ After this command finishes, the `gcc' directory might have old
+ versions of several files as saved by `patch'. To remove these,
+ after `cd gcc', type `rm -i *.~*~'.
+
+ *Note Merging Distributions::, for more information.
+
+Step 9: `touch f77-install-ok'
+ Don't do this if you don't want to overwrite an existing version
+ of `f77' (such as a native compiler, or a script that invokes
+ `f2c'). Otherwise, installation will overwrite the `f77' command
+ and the `f77' man pages with copies of the corresponding `g77'
+ material.
+
+ *Note Installing `f77': Installing f77, for more information.
+
+Step 10: `touch f2c-install-ok'
+ Don't do this if you don't want to overwrite an existing
+ installation of `libf2c' (though, chances are, you do). Instead,
+ `touch f2c-exists-ok' to allow the installation to continue
+ without any error messages about `/usr/lib/libf2c.a' already
+ existing.
+
+ *Note Installing `f2c': Installing f2c, for more information.
+
+Step 11: `./configure --prefix=/usr'
+ This is where you specify that the `g77' executable is to be
+ installed in `/usr/bin/', the `libf2c.a' library is to be
+ installed in `/usr/lib/', and so on.
+
+ You should ensure that any existing installation of the `gcc'
+ executable is in `/usr/bin/'. Otherwise, installing `g77' so that
+ it does not fully replace the existing installation of `gcc' is
+ likely to result in the inability to compile Fortran programs.
+
+ *Note Where in the World Does Fortran (and GNU CC) Go?: Where to
+ Install, for more information on determining where to install
+ `g77'. *Note Configuring gcc::, for more information on the
+ configuration process triggered by invoking the `./configure'
+ script.
+
+Step 12: `make bootstrap'
+ *Note Installing GNU CC: (gcc)Installation, for information on the
+ kinds of diagnostics you should expect during this procedure.
+
+ *Note Building gcc::, for complete `g77'-specific information on
+ this step.
+
+Step 13: `rm -fr stage1'
+ You don't need to do this, but it frees up disk space.
+
+Step 14: `make -k install'
+ If this doesn't seem to work, try:
+
+ make -k install install-libf77 install-f2c-all
+
+ *Note Installation of Binaries::, for more information.
+
+ *Note Updating Your Info Directory: Updating Documentation, for
+ information on entering this manual into your system's list of
+ texinfo manuals.
+
+Step 15: `g77 -v'
+ If this command prints approximately 25 lines of output, including
+ the GNU Fortran Front End version number (which should be the same
+ as the version number for the version of `g77' you just built and
+ installed) and the version numbers for the three parts of the
+ `libf2c' library (`libF77', `libI77', `libU77'), and those version
+ numbers are all in agreement, then there is a high likelihood that
+ the installation has been successfully completed.
+
+ You might consider doing further testing. For example, log in as
+ a non-privileged user, then create a small Fortran program, such
+ as:
+
+ PROGRAM SMTEST
+ DO 10 I=1, 10
+ PRINT *, 'Hello World #', I
+ 10 CONTINUE
+ END
+
+ Compile, link, and run the above program, and, assuming you named
+ the source file `smtest.f', the session should look like this:
+
+ sh# g77 -o smtest smtest.f
+ sh# ./smtest
+ Hello World # 1
+ Hello World # 2
+ Hello World # 3
+ Hello World # 4
+ Hello World # 5
+ Hello World # 6
+ Hello World # 7
+ Hello World # 8
+ Hello World # 9
+ Hello World # 10
+ sh#
+
+ After proper installation, you don't need to keep your gcc and g77
+ source and build directories around anymore. Removing them can
+ free up a lot of disk space.
+
+Complete Installation
+=====================
+
+ Here is the complete `g77'-specific information on how to configure,
+build, and install `g77'.
+
+Unpacking
+---------
+
+ The `gcc' source distribution is a stand-alone distribution. It is
+designed to be unpacked (producing the `gcc' source tree) and built as
+is, assuming certain prerequisites are met (including the availability
+of compatible UNIX programs such as `make', `cc', and so on).
+
+ However, before building `gcc', you will want to unpack and merge
+the `g77' distribution in with it, so that you build a Fortran-capable
+version of `gcc', which includes the `g77' command, the necessary
+run-time libraries, and this manual.
+
+ Unlike `gcc', the `g77' source distribution is *not* a stand-alone
+distribution. It is designed to be unpacked and, afterwards,
+immediately merged into an applicable `gcc' source tree. That is, the
+`g77' distribution *augments* a `gcc' distribution--without `gcc',
+generally only the documentation is immediately usable.
+
+ A sequence of commands typically used to unpack `gcc' and `g77' is:
+
+ sh# cd /usr/src
+ sh# gunzip -d < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -
+ sh# gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -
+ sh# ln -s gcc-2.7.2.2 gcc
+ sh# ln -s g77-0.5.21 g77
+ sh# mv -i g77/* gcc
+
+ *Notes:* The commands beginning with `gunzip...' might print `Broken
+pipe...' as they complete. That is nothing to worry about, unless you
+actually *hear* a pipe breaking. The `ln' commands are helpful in
+reducing typing and clutter in installation examples in this manual.
+Hereafter, the top level of `gcc' source tree is referred to as `gcc',
+and the top level of just the `g77' source tree (prior to issuing the
+`mv' command, above) is referred to as `g77'.
+
+ There are three top-level names in a `g77' distribution:
+
+ g77/COPYING.g77
+ g77/README.g77
+ g77/f
+
+ All three entries should be moved (or copied) into a `gcc' source
+tree (typically named after its version number and as it appears in the
+FSF distributions--e.g. `gcc-2.7.2.2').
+
+ `g77/f' is the subdirectory containing all of the code,
+documentation, and other information that is specific to `g77'. The
+other two files exist to provide information on `g77' to someone
+encountering a `gcc' source tree with `g77' already present, who has
+not yet read these installation instructions and thus needs help
+understanding that the source tree they are looking at does not come
+from a single FSF distribution. They also help people encountering an
+unmerged `g77' source tree for the first time.
+
+ *Note:* Please use *only* `gcc' and `g77' source trees as
+distributed by the FSF. Use of modified versions, such as the
+Pentium-specific-optimization port of `gcc', is likely to result in
+problems that appear to be in the `g77' code but, in fact, are not. Do
+not use such modified versions unless you understand all the
+differences between them and the versions the FSF distributes--in which
+case you should be able to modify the `g77' (or `gcc') source trees
+appropriately so `g77' and `gcc' can coexist as they do in the stock
+FSF distributions.
+
+Merging Distributions
+---------------------
+
+ After merging the `g77' source tree into the `gcc' source tree, the
+final merge step is done by applying the pertinent patches the `g77'
+distribution provides for the `gcc' source tree.
+
+ Read the file `gcc/f/gbe/README', and apply the appropriate patch
+file for the version of the GNU CC compiler you have, if that exists.
+If the directory exists but the appropriate file does not exist, you
+are using either an old, unsupported version, or a release one that is
+newer than the newest `gcc' version supported by the version of `g77'
+you have.
+
+ As of version 0.5.18, `g77' modifies the version number of `gcc' via
+the pertinent patches. This is done because the resulting version of
+`gcc' is deemed sufficiently different from the vanilla distribution to
+make it worthwhile to present, to the user, information signaling the
+fact that there are some differences.
+
+ GNU version numbers make it easy to figure out whether a particular
+version of a distribution is newer or older than some other version of
+that distribution. The format is, generally, MAJOR.MINOR.PATCH, with
+each field being a decimal number. (You can safely ignore leading
+zeros; for example, 1.5.3 is the same as 1.5.03.) The MAJOR field only
+increases with time. The other two fields are reset to 0 when the
+field to their left is incremented; otherwise, they, too, only increase
+with time. So, version 2.6.2 is newer than version 2.5.8, and version
+3.0 is newer than both. (Trailing `.0' fields often are omitted in
+announcements and in names for distributions and the directories they
+create.)
+
+ If your version of `gcc' is older than the oldest version supported
+by `g77' (as casually determined by listing the contents of
+`gcc/f/gbe/'), you should obtain a newer, supported version of `gcc'.
+(You could instead obtain an older version of `g77', or try and get
+your `g77' to work with the old `gcc', but neither approach is
+recommended, and you shouldn't bother reporting any bugs you find if you
+take either approach, because they're probably already fixed in the
+newer versions you're not using.)
+
+ If your version of `gcc' is newer than the newest version supported
+by `g77', it is possible that your `g77' will work with it anyway. If
+the version number for `gcc' differs only in the PATCH field, you might
+as well try applying the `g77' patch that is for the newest version of
+`gcc' having the same MAJOR and MINOR fields, as this is likely to work.
+
+ So, for example, if a particular version of `g77' has support for
+`gcc' versions 2.7.0 and 2.7.1, it is likely that `gcc-2.7.2' would
+work well with `g77' by using the `2.7.1.diff' patch file provided with
+`g77' (aside from some offsets reported by `patch', which usually are
+harmless).
+
+ However, `gcc-2.8.0' would almost certainly not work with that
+version of `g77' no matter which patch file was used, so a new version
+of `g77' would be needed (and you should wait for it rather than
+bothering the maintainers--*note User-Visible Changes: Changes.).
+
+ This complexity is the result of `gcc' and `g77' being separate
+distributions. By keeping them separate, each product is able to be
+independently improved and distributed to its user base more frequently.
+
+ However, `g77' often requires changes to contemporary versions of
+`gcc'. Also, the GBE interface defined by `gcc' typically undergoes
+some incompatible changes at least every time the MINOR field of the
+version number is incremented, and such changes require corresponding
+changes to the `g77' front end (FFE).
+
+ It is hoped that the GBE interface, and the `gcc' and `g77' products
+in general, will stabilize sufficiently for the need for hand-patching
+to disappear.
+
+ Invoking `patch' as described in `gcc/f/gbe/README' can produce a
+wide variety of printed output, from `Hmm, I can't seem to find a patch
+in there anywhere...' to long lists of messages indicated that patches
+are being found, applied successfully, and so on.
+
+ If messages about "fuzz", "offset", or especially "reject files" are
+printed, it might mean you applied the wrong patch file. If you
+believe this is the case, it is best to restart the sequence after
+deleting (or at least renaming to unused names) the top-level
+directories for `g77' and `gcc' and their symbolic links. That is
+because `patch' might have partially patched some `gcc' source files,
+so reapplying the correct patch file might result in the correct
+patches being applied incorrectly (due to the way `patch' necessarily
+works).
+
+ After `patch' finishes, the `gcc' directory might have old versions
+of several files as saved by `patch'. To remove these, after `cd gcc',
+type `rm -i *.~*~'.
+
+ *Note:* `g77''s configuration file `gcc/f/config-lang.in' ensures
+that the source code for the version of `gcc' being configured has at
+least one indication of being patched as required specifically by `g77'.
+This configuration-time checking should catch failure to apply the
+correct patch and, if so caught, should abort the configuration with an
+explanation. *Please* do not try to disable the check, otherwise `g77'
+might well appear to build and install correctly, and even appear to
+compile correctly, but could easily produce broken code.
+
+ `diff -rcp2N' is used to create the patch files in `gcc/f/gbe/'.
+
+Installing `f77'
+----------------
+
+ You should decide whether you want installation of `g77' to also
+install an `f77' command. On systems with a native `f77', this is not
+normally desired, so `g77' does not do this by default.
+
+ If you want `f77' installed, create the file `f77-install-ok' (e.g.
+via the UNIX command `touch f77-install-ok') in the source or build
+top-level directory (the same directory in which the `g77' `f'
+directory resides, not the `f' directory itself), or edit
+`gcc/f/Make-lang.in' and change the definition of the
+`F77_INSTALL_FLAG' macro appropriately.
+
+ Usually, this means that, after typing `cd gcc', you would type
+`touch f77-install-ok'.
+
+ When you enable installation of `f77', either a link to or a direct
+copy of the `g77' command is made. Similarly, `f77.1' is installed as
+a man page.
+
+ (The `uninstall' target in the `gcc/Makefile' also tests this macro
+and file, when invoked, to determine whether to delete the installed
+copies of `f77' and `f77.1'.)
+
+ *Note:* No attempt is yet made to install a program (like a shell
+script) that provides compatibility with any other `f77' programs.
+Only the most rudimentary invocations of `f77' will work the same way
+with `g77'.
+
+Installing `f2c'
+----------------
+
+ Currently, `g77' does not include `f2c' itself in its distribution.
+However, it does include a modified version of the `libf2c'. This
+version is normally compatible with `f2c', but has been modified to
+meet the needs of `g77' in ways that might possibly be incompatible
+with some versions or configurations of `f2c'.
+
+ Decide how installation of `g77' should affect any existing
+installation of `f2c' on your system.
+
+ If you do not have `f2c' on your system (e.g. no `/usr/bin/f2c', no
+`/usr/include/f2c.h', and no `/usr/lib/libf2c.a', `/usr/lib/libF77.a',
+or `/usr/lib/libI77.a'), you don't need to be concerned with this item.
+
+ If you do have `f2c' on your system, you need to decide how users of
+`f2c' will be affected by your installing `g77'. Since `g77' is
+currently designed to be object-code-compatible with `f2c' (with very
+few, clear exceptions), users of `f2c' might want to combine
+`f2c'-compiled object files with `g77'-compiled object files in a
+single executable.
+
+ To do this, users of `f2c' should use the same copies of `f2c.h' and
+`libf2c.a' that `g77' uses (and that get built as part of `g77').
+
+ If you do nothing here, the `g77' installation process will not
+overwrite the `include/f2c.h' and `lib/libf2c.a' files with its own
+versions, and in fact will not even install `libf2c.a' for use with the
+newly installed versions of `gcc' and `g77' if it sees that
+`lib/libf2c.a' exists--instead, it will print an explanatory message
+and skip this part of the installation.
+
+ To install `g77''s versions of `f2c.h' and `libf2c.a' in the
+appropriate places, create the file `f2c-install-ok' (e.g. via the UNIX
+command `touch f2c-install-ok') in the source or build top-level
+directory (the same directory in which the `g77' `f' directory resides,
+not the `f' directory itself), or edit `gcc/f/Make-lang.in' and change
+the definition of the `F2C_INSTALL_FLAG' macro appropriately.
+
+ Usually, this means that, after typing `cd gcc', you would type
+`touch f2c-install-ok'.
+
+ Make sure that when you enable the overwriting of `f2c.h' and
+`libf2c.a' as used by `f2c', you have a recent and properly configured
+version of `bin/f2c' so that it generates code that is compatible with
+`g77'.
+
+ If you don't want installation of `g77' to overwrite `f2c''s existing
+installation, but you do want `g77' installation to proceed with
+installation of its own versions of `f2c.h' and `libf2c.a' in places
+where `g77' will pick them up (even when linking `f2c'-compiled object
+files--which might lead to incompatibilities), create the file
+`f2c-exists-ok' (e.g. via the UNIX command `touch f2c-exists-ok') in
+the source or build top-level directory, or edit `gcc/f/Make-lang.in'
+and change the definition of the `F2CLIBOK' macro appropriately.
+
+Patching GNU Fortran
+--------------------
+
+ If you're using a SunOS4 system, you'll need to make the following
+change to `gcc/f/proj.h': edit the line reading
+
+ #define FFEPROJ_STRTOUL 1 ...
+
+by replacing the `1' with `0'. Or, you can avoid editing the source by
+adding
+ CFLAGS='-DFFEPROJ_STRTOUL=0 -g -O'
+ to the command line for `make' when you invoke it. (`-g' is the
+default for `CFLAGS'.)
+
+ This causes a minimal version of `strtoul()' provided as part of the
+`g77' distribution to be compiled and linked into whatever `g77'
+programs need it, since some systems (like SunOS4 with only the bundled
+compiler and its runtime) do not provide this function in their system
+libraries.
+
+ Similarly, a minimal version of `bsearch()' is available and can be
+enabled by editing a line similar to the one for `strtoul()' above in
+`gcc/f/proj.h', if your system libraries lack `bsearch()'. The method
+of overriding `X_CFLAGS' may also be used.
+
+ These are not problems with `g77', which requires an ANSI C
+environment. You should upgrade your system to one that provides a
+full ANSI C environment, or encourage the maintainers of `gcc' to
+provide one to all `gcc'-based compilers in future `gcc' distributions.
+
+ *Note Problems Installing::, for more information on why `strtoul()'
+comes up missing and on approaches to dealing with this problem that
+have already been tried.
+
+Where in the World Does Fortran (and GNU CC) Go?
+------------------------------------------------
+
+ Before configuring, you should make sure you know where you want the
+`g77' and `gcc' binaries to be installed after they're built, because
+this information is given to the configuration tool and used during the
+build itself.
+
+ A `g77' installation necessarily requires installation of a
+`g77'-aware version of `gcc', so that the `gcc' command recognizes
+Fortran source files and knows how to compile them.
+
+ For this to work, the version of `gcc' that you will be building as
+part of `g77' *must* be installed as the "active" version of `gcc' on
+the system.
+
+ Sometimes people make the mistake of installing `gcc' as
+`/usr/local/bin/gcc', leaving an older, non-Fortran-aware version in
+`/usr/bin/gcc'. (Or, the opposite happens.) This can result in `g77'
+being unable to compile Fortran source files, because when it calls on
+`gcc' to do the actual compilation, `gcc' complains that it does not
+recognize the language, or the file name suffix.
+
+ So, determine whether `gcc' already is installed on your system,
+and, if so, *where* it is installed, and prepare to configure the new
+version of `gcc' you'll be building so that it installs over the
+existing version of `gcc'.
+
+ You might want to back up your existing copy of `bin/gcc', and the
+entire `lib/' directory, before you perform the actual installation (as
+described in this manual).
+
+ Existing `gcc' installations typically are found in `/usr' or
+`/usr/local'. If you aren't certain where the currently installed
+version of `gcc' and its related programs reside, look at the output of
+this command:
+
+ gcc -v -o /tmp/delete-me -xc /dev/null -xnone
+
+ All sorts of interesting information on the locations of various
+`gcc'-related programs and data files should be visible in the output
+of the above command. (The output also is likely to include a
+diagnostic from the linker, since there's no `main_()' function.)
+However, you do have to sift through it yourself; `gcc' currently
+provides no easy way to ask it where it is installed and where it looks
+for the various programs and data files it calls on to do its work.
+
+ Just *building* `g77' should not overwrite any installed
+programs--but, usually, after you build `g77', you will want to install
+it, so backing up anything it might overwrite is a good idea. (This is
+true for any package, not just `g77', though in this case it is
+intentional that `g77' overwrites `gcc' if it is already installed--it
+is unusual that the installation process for one distribution
+intentionally overwrites a program or file installed by another
+distribution.)
+
+ Another reason to back up the existing version first, or make sure
+you can restore it easily, is that it might be an older version on
+which other users have come to depend for certain behaviors. However,
+even the new version of `gcc' you install will offer users the ability
+to specify an older version of the actual compilation programs if
+desired, and these older versions need not include any `g77' components.
+*Note Specifying Target Machine and Compiler Version: (gcc)Target
+Options, for information on the `-V' option of `gcc'.
+
+Configuring GNU CC
+------------------
+
+ `g77' is configured automatically when you configure `gcc'. There
+are two parts of `g77' that are configured in two different
+ways--`g77', which "camps on" to the `gcc' configuration mechanism, and
+`libf2c', which uses a variation of the GNU `autoconf' configuration
+system.
+
+ Generally, you shouldn't have to be concerned with either `g77' or
+`libf2c' configuration, unless you're configuring `g77' as a
+cross-compiler. In this case, the `libf2c' configuration, and possibly
+the `g77' and `gcc' configurations as well, might need special
+attention. (This also might be the case if you're porting `gcc' to a
+whole new system--even if it is just a new operating system on an
+existing, supported CPU.)
+
+ To configure the system, see *Note Installing GNU CC:
+(gcc)Installation, following the instructions for running `./configure'.
+Pay special attention to the `--prefix=' option, which you almost
+certainly will need to specify.
+
+ (Note that `gcc' installation information is provided as a straight
+text file in `gcc/INSTALL'.)
+
+ The information printed by the invocation of `./configure' should
+show that the `f' directory (the Fortran language) has been configured.
+If it does not, there is a problem.
+
+ *Note:* Configuring with the `--srcdir' argument is known to work
+with GNU `make', but it is not known to work with other variants of
+`make'. Irix5.2 and SunOS4.1 versions of `make' definitely won't work
+outside the source directory at present. `g77''s portion of the
+`configure' script issues a warning message about this when you
+configure for building binaries outside the source directory.
+
+Building GNU CC
+---------------
+
+ Building `g77' requires building enough of `gcc' that these
+instructions assume you're going to build all of `gcc', including
+`g++', `protoize', and so on. You can save a little time and disk
+space by changes the `LANGUAGES' macro definition in `gcc/Makefile.in'
+or `gcc/Makefile', but if you do that, you're on your own. One change
+is almost *certainly* going to cause failures: removing `c' or `f77'
+from the definition of the `LANGUAGES' macro.
+
+ After configuring `gcc', which configures `g77' and `libf2c'
+automatically, you're ready to start the actual build by invoking
+`make'.
+
+ *Note:* You *must* have run `./configure' before you run `make',
+even if you're using an already existing `gcc' development directory,
+because `./configure' does the work to recognize that you've added
+`g77' to the configuration.
+
+ There are two general approaches to building GNU CC from scratch:
+
+"bootstrap"
+ This method uses minimal native system facilities to build a
+ barebones, unoptimized `gcc', that is then used to compile
+ ("bootstrap") the entire system.
+
+"straight"
+ This method assumes a more complete native system exists, and uses
+ that just once to build the entire system.
+
+ On all systems without a recent version of `gcc' already installed,
+the bootstrap method must be used. In particular, `g77' uses
+extensions to the C language offered, apparently, only by `gcc'.
+
+ On most systems with a recent version of `gcc' already installed,
+the straight method can be used. This is an advantage, because it
+takes less CPU time and disk space for the build. However, it does
+require that the system have fairly recent versions of many GNU
+programs and other programs, which are not enumerated here.
+
+Bootstrap Build
+...............
+
+ A complete bootstrap build is done by issuing a command beginning
+with `make bootstrap ...', as described in *Note Installing GNU CC:
+(gcc)Installation. This is the most reliable form of build, but it
+does require the most disk space and CPU time, since the complete system
+is built twice (in Stages 2 and 3), after an initial build (during
+Stage 1) of a minimal `gcc' compiler using the native compiler and
+libraries.
+
+ You might have to, or want to, control the way a bootstrap build is
+done by entering the `make' commands to build each stage one at a time,
+as described in the `gcc' manual. For example, to save time or disk
+space, you might want to not bother doing the Stage 3 build, in which
+case you are assuming that the `gcc' compiler you have built is
+basically sound (because you are giving up the opportunity to compare a
+large number of object files to ensure they're identical).
+
+ To save some disk space during installation, after Stage 2 is built,
+you can type `rm -fr stage1' to remove the binaries built during Stage
+1.
+
+ *Note:* *Note Object File Differences::, for information on expected
+differences in object files produced during Stage 2 and Stage 3 of a
+bootstrap build. These differences will be encountered as a result of
+using the `make compare' or similar command sequence recommended by the
+GNU CC installation documentation.
+
+ Also, *Note Installing GNU CC: (gcc)Installation, for important
+information on building `gcc' that is not described in this `g77'
+manual. For example, explanations of diagnostic messages and whether
+they're expected, or indicate trouble, are found there.
+
+Straight Build
+..............
+
+ If you have a recent version of `gcc' already installed on your
+system, and if you're reasonably certain it produces code that is
+object-compatible with the version of `gcc' you want to build as part
+of building `g77', you can save time and disk space by doing a straight
+build.
+
+ To build just the C and Fortran compilers and the necessary run-time
+libraries, issue the following command:
+
+ make -k CC=gcc LANGUAGES=f77 all g77
+
+ (The `g77' target is necessary because the `gcc' build procedures
+apparently do not automatically build command drivers for languages in
+subdirectories. It's the `all' target that triggers building
+everything except, apparently, the `g77' command itself.)
+
+ If you run into problems using this method, you have two options:
+
+ * Abandon this approach and do a bootstrap build.
+
+ * Try to make this approach work by diagnosing the problems you're
+ running into and retrying.
+
+ Especially if you do the latter, you might consider submitting any
+solutions as bug/fix reports. *Note Known Causes of Trouble with GNU
+Fortran: Trouble.
+
+ However, understand that many problems preventing a straight build
+from working are not `g77' problems, and, in such cases, are not likely
+to be addressed in future versions of `g77'.
+
+Pre-installation Checks
+-----------------------
+
+ Before installing the system, which includes installing `gcc', you
+might want to do some minimum checking to ensure that some basic things
+work.
+
+ Here are some commands you can try, and output typically printed by
+them when they work:
+
+ sh# cd /usr/src/gcc
+ sh# ./g77 --driver=./xgcc -B./ -v
+ g77 version 0.5.21
+ ./xgcc -B./ -v -fnull-version -o /tmp/gfa18047 ...
+ Reading specs from ./specs
+ gcc version 2.7.2.2.f.3
+ ./cpp -lang-c -v -isystem ./include -undef ...
+ GNU CPP version 2.7.2.2.f.3 (Linux/Alpha)
+ #include "..." search starts here:
+ #include <...> search starts here:
+ ./include
+ /usr/local/include
+ /usr/alpha-unknown-linux/include
+ /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.3/include
+ /usr/include
+ End of search list.
+ ./f771 /tmp/cca18048.i -fset-g77-defaults -quiet -dumpbase ...
+ GNU F77 version 2.7.2.2.f.3 (Linux/Alpha) compiled ...
+ GNU Fortran Front End version 0.5.21 compiled: ...
+ as -nocpp -o /tmp/cca180481.o /tmp/cca18048.s
+ ld -G 8 -O1 -o /tmp/gfa18047 /usr/lib/crt0.o -L. ...
+ __G77_LIBF77_VERSION__: 0.5.21
+ @(#)LIBF77 VERSION 19970404
+ __G77_LIBI77_VERSION__: 0.5.21
+ @(#) LIBI77 VERSION pjw,dmg-mods 19970527
+ __G77_LIBU77_VERSION__: 0.5.21
+ @(#) LIBU77 VERSION 19970609
+ sh# ./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone
+ Reading specs from ./specs
+ gcc version 2.7.2.2.f.3
+ ./cpp -lang-c -v -isystem ./include -undef ...
+ GNU CPP version 2.7.2.2.f.3 (Linux/Alpha)
+ #include "..." search starts here:
+ #include <...> search starts here:
+ ./include
+ /usr/local/include
+ /usr/alpha-unknown-linux/include
+ /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.3/include
+ /usr/include
+ End of search list.
+ ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version ...
+ GNU C version 2.7.2.2.f.3 (Linux/Alpha) compiled ...
+ as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s
+ ld -G 8 -O1 -o /tmp/delete-me /usr/lib/crt0.o -L. ...
+ /usr/lib/crt0.o: In function `__start':
+ crt0.S:110: undefined reference to `main'
+ /usr/lib/crt0.o(.lita+0x28): undefined reference to `main'
+ sh#
+
+ (Note that long lines have been truncated, and `...' used to
+indicate such truncations.)
+
+ The above two commands test whether `g77' and `gcc', respectively,
+are able to compile empty (null) source files, whether invocation of
+the C preprocessor works, whether libraries can be linked, and so on.
+
+ If the output you get from either of the above two commands is
+noticeably different, especially if it is shorter or longer in ways
+that do not look consistent with the above sample output, you probably
+should not install `gcc' and `g77' until you have investigated further.
+
+ For example, you could try compiling actual applications and seeing
+how that works. (You might want to do that anyway, even if the above
+tests work.)
+
+ To compile using the not-yet-installed versions of `gcc' and `g77',
+use the following commands to invoke them.
+
+ To invoke `g77', type:
+
+ /usr/src/gcc/g77 --driver=/usr/src/gcc/xgcc -B/usr/src/gcc/ ...
+
+ To invoke `gcc', type:
+
+ /usr/src/gcc/xgcc -B/usr/src/gcc/ ...
+
+Installation of Binaries
+------------------------
+
+ After configuring, building, and testing `g77' and `gcc', when you
+are ready to install them on your system, type:
+
+ make -k CC=gcc LANGUAGES=f77 install
+
+ As described in *Note Installing GNU CC: (gcc)Installation, the
+values for the `CC' and `LANGUAGES' macros should be the same as those
+you supplied for the build itself.
+
+ So, the details of the above command might vary if you used a
+bootstrap build (where you might be able to omit both definitions, or
+might have to supply the same definitions you used when building the
+final stage) or if you deviated from the instructions for a straight
+build.
+
+ If the above command does not install `libf2c.a' as expected, try
+this:
+
+ make -k ... install install-libf77 install-f2c-all
+
+ We don't know why some non-GNU versions of `make' sometimes require
+this alternate command, but they do. (Remember to supply the
+appropriate definitions for `CC' and `LANGUAGES' where you see `...' in
+the above command.)
+
+ Note that using the `-k' option tells `make' to continue after some
+installation problems, like not having `makeinfo' installed on your
+system. It might not be necessary for your system.
+
+Updating Your Info Directory
+----------------------------
+
+ As part of installing `g77', you should make sure users of `info'
+can easily access this manual on-line. Do this by making sure a line
+such as the following exists in `/usr/info/dir', or in whatever file is
+the top-level file in the `info' directory on your system (perhaps
+`/usr/local/info/dir':
+
+ * g77: (g77). The GNU Fortran programming language.
+
+ If the menu in `dir' is organized into sections, `g77' probably
+belongs in a section with a name such as one of the following:
+
+ * Fortran Programming
+
+ * Writing Programs
+
+ * Programming Languages
+
+ * Languages Other Than C
+
+ * Scientific/Engineering Tools
+
+ * GNU Compilers
+
+Missing `bison'?
+----------------
+
+ If you cannot install `bison', make sure you have started with a
+*fresh* distribution of `gcc', do *not* do `make maintainer-clean' (in
+other versions of `gcc', this was called `make realclean'), and, to
+ensure that `bison' is not invoked by `make' during the build, type
+these commands:
+
+ sh# cd gcc
+ sh# touch bi-parser.c bi-parser.h c-parse.c c-parse.h cexp.c
+ sh# touch cp/parse.c cp/parse.h objc-parse.c
+ sh#
+
+ These commands update the date-time-modified information for all the
+files produced by the various invocations of `bison' in the current
+versions of `gcc', so that `make' no longer believes it needs to update
+them. All of these files should already exist in a `gcc' distribution,
+but the application of patches to upgrade to a newer version can leave
+the modification information set such that the `bison' input files look
+more "recent" than the corresponding output files.
+
+ *Note:* New versions of `gcc' might change the set of files it
+generates by invoking `bison'--if you cannot figure out for yourself
+how to handle such a situation, try an older version of `gcc' until you
+find someone who can (or until you obtain and install `bison').
+
+Missing `makeinfo'?
+-------------------
+
+ If you cannot install `makeinfo', either use the `-k' option when
+invoking make to specify any of the `install' or related targets, or
+specify `MAKEINFO=echo' on the `make' command line.
+
+ If you fail to do one of these things, some files, like `libf2c.a',
+might not be installed, because the failed attempt by `make' to invoke
+`makeinfo' causes it to cancel any further processing.
+
+Distributing Binaries
+=====================
+
+ If you are building `g77' for distribution to others in binary form,
+first make sure you are aware of your legal responsibilities (read the
+file `gcc/COPYING' thoroughly).
+
+ Then, consider your target audience and decide where `g77' should be
+installed.
+
+ For systems like GNU/Linux that have no native Fortran compiler (or
+where `g77' could be considered the native compiler for Fortran and
+`gcc' for C, etc.), you should definitely configure `g77' for
+installation in `/usr/bin' instead of `/usr/local/bin'. Specify the
+`--prefix=/usr' option when running `./configure'. You might also want
+to set up the distribution so the `f77' command is a link to
+`g77'--just make an empty file named `f77-install-ok' in the source or
+build directory (the one in which the `f' directory resides, not the
+`f' directory itself) when you specify one of the `install' or
+`uninstall' targets in a `make' command.
+
+ For a system that might already have `f2c' installed, you definitely
+will want to make another empty file (in the same directory) named
+either `f2c-exists-ok' or `f2c-install-ok'. Use the former if you
+don't want your distribution to overwrite `f2c'-related files in
+existing systems; use the latter if you want to improve the likelihood
+that users will be able to use both `f2c' and `g77' to compile code for
+a single program without encountering link-time or run-time
+incompatibilities.
+
+ (Make sure you clearly document, in the "advertising" for your
+distribution, how installation of your distribution will affect
+existing installations of `gcc', `f2c', `f77', `libf2c.a', and so on.
+Similarly, you should clearly document any requirements you assume are
+met by users of your distribution.)
+
+ For other systems with native `f77' (and `cc') compilers, configure
+`g77' as you (or most of your audience) would configure `gcc' for their
+installations. Typically this is for installation in `/usr/local', and
+would not include a copy of `g77' named `f77', so users could still use
+the native `f77'.
+
+ In any case, for `g77' to work properly, you *must* ensure that the
+binaries you distribute include:
+
+`bin/g77'
+ This is the command most users use to compile Fortran.
+
+`bin/gcc'
+ This is the command all users use to compile Fortran, either
+ directly or indirectly via the `g77' command. The `bin/gcc'
+ executable file must have been built from a `gcc' source tree into
+ which a `g77' source tree was merged and configured, or it will
+ not know how to compile Fortran programs.
+
+`bin/f77'
+ In installations with no non-GNU native Fortran compiler, this is
+ the same as `bin/g77'. Otherwise, it should be omitted from the
+ distribution, so the one on already on a particular system does
+ not get overwritten.
+
+`info/g77.info*'
+ This is the documentation for `g77'. If it is not included, users
+ will have trouble understanding diagnostics messages and other
+ such things, and will send you a lot of email asking questions.
+
+ Please edit this documentation (by editing `gcc/f/*.texi' and
+ doing `make doc' from the `/usr/src/gcc' directory) to reflect any
+ changes you've made to `g77', or at least to encourage users of
+ your binary distribution to report bugs to you first.
+
+ Also, whether you distribute binaries or install `g77' on your own
+ system, it might be helpful for everyone to add a line listing
+ this manual by name and topic to the top-level `info' node in
+ `/usr/info/dir'. That way, users can find `g77' documentation more
+ easily. *Note Updating Your Info Directory: Updating
+ Documentation.
+
+`man/man1/g77.1'
+ This is the short man page for `g77'. It is out of date, but you
+ might as well include it for people who really like man pages.
+
+`man/man1/f77.1'
+ In installations where `f77' is the same as `g77', this is the
+ same as `man/man1/g77.1'. Otherwise, it should be omitted from
+ the distribution, so the one already on a particular system does
+ not get overwritten.
+
+`lib/gcc-lib/.../f771'
+ This is the actual Fortran compiler.
+
+`lib/gcc-lib/.../libf2c.a'
+ This is the run-time library for `g77'-compiled programs.
+
+ Whether you want to include the slightly updated (and possibly
+improved) versions of `cc1', `cc1plus', and whatever other binaries get
+rebuilt with the changes the GNU Fortran distribution makes to the GNU
+back end, is up to you. These changes are highly unlikely to break any
+compilers, and it is possible they'll fix back-end bugs that can be
+demonstrated using front ends other than GNU Fortran's.
+
+ Please assure users that unless they have a specific need for their
+existing, older versions of `gcc' command, they are unlikely to
+experience any problems by overwriting it with your version--though
+they could certainly protect themselves by making backup copies first!
+Otherwise, users might try and install your binaries in a "safe" place,
+find they cannot compile Fortran programs with your distribution
+(because, perhaps, they're picking up their old version of the `gcc'
+command, which does not recognize Fortran programs), and assume that
+your binaries (or, more generally, GNU Fortran distributions in
+general) are broken, at least for their system.
+
+ Finally, *please* ask for bug reports to go to you first, at least
+until you're sure your distribution is widely used and has been well
+tested. This especially goes for those of you making any changes to
+the `g77' sources to port `g77', e.g. to OS/2.
+<fortran@gnu.ai.mit.edu> has received a fair number of bug reports that
+turned out to be problems with other peoples' ports and distributions,
+about which nothing could be done for the user. Once you are quite
+certain a bug report does not involve your efforts, you can forward it
+to us.
+
diff --git a/gcc/f/Make-lang.in b/gcc/f/Make-lang.in
new file mode 100644
index 00000000000..7e59b6100c3
--- /dev/null
+++ b/gcc/f/Make-lang.in
@@ -0,0 +1,567 @@
+# Top level makefile fragment for GNU Fortran. -*-makefile-*-
+# 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 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.
+
+# This file provides the language dependent support in the main Makefile.
+# Each language makefile fragment must provide the following targets:
+#
+# foo.all.build, foo.all.cross, foo.start.encap, foo.rest.encap,
+# foo.info, foo.dvi,
+# foo.install-normal, foo.install-common, foo.install-info, foo.install-man,
+# foo.uninstall, foo.distdir,
+# foo.mostlyclean, foo.clean, foo.distclean, foo.extraclean,
+# foo.maintainer-clean, foo.stage1, foo.stage2, foo.stage3, foo.stage4
+#
+# where `foo' is the name of the language.
+#
+# It should also provide rules for:
+#
+# - making any compiler driver (eg: g77)
+# - the compiler proper (eg: f771)
+# - define the names for selecting the language in LANGUAGES.
+#
+# $(srcdir) must be set to the gcc/ source directory (not gcc/f/).
+
+# Extra flags to pass to recursive makes (and to sub-configure).
+# Use different quoting rules compared with FLAGS_TO_PASS so we can use
+# this to set environment variables as well
+# Note that GCC_FOR_TARGET, GCC_FLAGS aren't in here -- treated separately.
+F77_FLAGS_TO_PASS = \
+ CROSS="$(CROSS)" \
+ AR_FLAGS="$(AR_FLAGS)" \
+ AR_FOR_TARGET="$(AR_FOR_TARGET)" \
+ BISON="$(BISON)" \
+ BISONFLAGS="$(BISONFLAGS)" \
+ CC="$(CC)" \
+ CFLAGS="$(CFLAGS)" \
+ X_CFLAGS="$(X_CFLAGS)" \
+ LDFLAGS="$(LDFLAGS)" \
+ LEX="$(LEX)" \
+ LEXFLAGS="$(LEXFLAGS)" \
+ MAKEINFO="$(MAKEINFO)" \
+ MAKEINFOFLAGS="$(MAKEINFOFLAGS)" \
+ RANLIB_FOR_TARGET="$(RANLIB_FOR_TARGET)" \
+ RANLIB_TEST_FOR_TARGET="$(RANLIB_TEST_FOR_TARGET)" \
+ SHELL="$(SHELL)" \
+ exec_prefix="$(exec_prefix)" \
+ prefix="$(prefix)" \
+ tooldir="$(tooldir)" \
+ bindir="$(bindir)" \
+ libsubdir="$(libsubdir)"
+# "F77_FOR_BUILD=$(F77_FOR_BUILD)" \
+# "F77FLAGS=$(F77FLAGS)" \
+# "F77_FOR_TARGET=$(F77_FOR_TARGET)"
+
+# This flag controls whether to install (overwrite) f77 on this system,
+# and also whether to uninstall it when using the uninstall target.
+# As shipped, the flag is a test of whether the `f77_install_ok'
+# file exists in the build or source directories (top level), but
+# you can just change it here if you like.
+F77_INSTALL_FLAG = [ -f f77-install-ok -o -f $(srcdir)/f77-install-ok ]
+
+# This flag is similar to F77_INSTALL_FLAG, but controls whether
+# to install (ovewrite) f2c-related items on this system. Currently
+# these are `include/f2c.h' and `lib/libf2c.a', though at some point
+# `bin/f2c' itself might be added to the g77 distribution.
+F2C_INSTALL_FLAG = [ -f f2c-install-ok -o -f $(srcdir)/f2c-install-ok ]
+
+# This flag controls whether it is safe to install gcc's libf2c.a
+# even when there's already a lib/libf2c.a installed (which, unless
+# F2C_INSTALL_FLAG is set, will be left alone).
+F2CLIBOK = [ -f f2c-exists-ok -o -f $(srcdir)/f2c-exists-ok ]
+
+# Actual names to use when installing a native compiler.
+F77_INSTALL_NAME = `t='$(program_transform_name)'; echo f77 | sed $$t`
+G77_INSTALL_NAME = `t='$(program_transform_name)'; echo g77 | sed $$t`
+
+# Actual names to use when installing a cross-compiler.
+F77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo f77 | sed $$t`
+G77_CROSS_NAME = `t='$(program_transform_cross_name)'; echo g77 | sed $$t`
+
+# Define the names for selecting f77 in LANGUAGES.
+# Note that it would be nice to move the dependency on g77
+# into the F77 rule, but that needs a little bit of work
+# to do the right thing within all.cross.
+F77 f77: f771 f77-runtime
+
+# Tell GNU make to ignore these if they exist.
+.PHONY: F77 f77 f77-runtime f77-runtime-unsafe f77.all.build f77.all.cross \
+ f77.start.encap f77.rest.encap f77.info f77.dvi maybe-f2c \
+ f77.install-normal install-libf77 install-f2c-all install-f2c-header \
+ install-f2c-lib f77.install-common f77.install-info f77.install-man \
+ f77.uninstall f77.mostlyclean f77.clean f77.distclean f77.extraclean \
+ f77.maintainer-clean f77.realclean f77.stage1 f77.stage2 f77.stage3 \
+ f77.stage4 f77.distdir f77.rebuilt
+
+# Create the compiler driver for g77 (only if `f77' is in LANGUAGES).
+g77: $(srcdir)/f/g77.c $(srcdir)/f/zzz.c $(CONFIG_H) $(LIBDEPS)
+ case '$(LANGUAGES)' in \
+ *f77*) \
+ $(CC) $(ALL_CFLAGS) $(INCLUDES) $(LDFLAGS) \
+ -o $@ $(srcdir)/f/g77.c $(srcdir)/f/zzz.c $(LIBS) ;; \
+ esac
+
+# Create a version of the g77 driver which calls the cross-compiler
+# (only if `f77' is in LANGUAGES).
+g77-cross: $(srcdir)/f/g77.c $(srcdir)/f/zzz.c version.o $(LIBDEPS)
+ case '$(LANGUAGES)' in \
+ *f77*) \
+ $(CC) $(ALL_CFLAGS) $(INCLUDES) $(LDFLAGS) \
+ -DGCC_NAME=\"$(GCC_CROSS_NAME)\" \
+ -o $@ $(srcdir)/f/g77.c $(srcdir)/f/zzz.c $(LIBS) ;; \
+ esac
+
+F77_SRCS = \
+ $(srcdir)/f/assert.j \
+ $(srcdir)/f/bad.c \
+ $(srcdir)/f/bad.def \
+ $(srcdir)/f/bad.h \
+ $(srcdir)/f/bit.c \
+ $(srcdir)/f/bit.h \
+ $(srcdir)/f/bld-op.def \
+ $(srcdir)/f/bld.c \
+ $(srcdir)/f/bld.h \
+ $(srcdir)/f/com-rt.def \
+ $(srcdir)/f/com.c \
+ $(srcdir)/f/com.h \
+ $(srcdir)/f/config.j \
+ $(srcdir)/f/convert.j \
+ $(srcdir)/f/data.c \
+ $(srcdir)/f/data.h \
+ $(srcdir)/f/equiv.c \
+ $(srcdir)/f/equiv.h \
+ $(srcdir)/f/expr.c \
+ $(srcdir)/f/expr.h \
+ $(srcdir)/f/fini.c \
+ $(srcdir)/f/flags.j \
+ $(srcdir)/f/glimits.j \
+ $(srcdir)/f/global.c \
+ $(srcdir)/f/global.h \
+ $(srcdir)/f/hconfig.j \
+ $(srcdir)/f/implic.c \
+ $(srcdir)/f/implic.h \
+ $(srcdir)/f/input.j \
+ $(srcdir)/f/info-b.def \
+ $(srcdir)/f/info-k.def \
+ $(srcdir)/f/info-w.def \
+ $(srcdir)/f/info.c \
+ $(srcdir)/f/info.h \
+ $(srcdir)/f/intrin.c \
+ $(srcdir)/f/intrin.def \
+ $(srcdir)/f/intrin.h \
+ $(srcdir)/f/lab.c \
+ $(srcdir)/f/lab.h \
+ $(srcdir)/f/lex.c \
+ $(srcdir)/f/lex.h \
+ $(srcdir)/f/malloc.c \
+ $(srcdir)/f/malloc.h \
+ $(srcdir)/f/name.c \
+ $(srcdir)/f/name.h \
+ $(srcdir)/f/parse.c \
+ $(srcdir)/f/proj.c \
+ $(srcdir)/f/proj.h \
+ $(srcdir)/f/rtl.j \
+ $(srcdir)/f/src.c \
+ $(srcdir)/f/src.h \
+ $(srcdir)/f/st.c \
+ $(srcdir)/f/st.h \
+ $(srcdir)/f/sta.c \
+ $(srcdir)/f/sta.h \
+ $(srcdir)/f/stb.c \
+ $(srcdir)/f/stb.h \
+ $(srcdir)/f/stc.c \
+ $(srcdir)/f/stc.h \
+ $(srcdir)/f/std.c \
+ $(srcdir)/f/std.h \
+ $(srcdir)/f/ste.c \
+ $(srcdir)/f/ste.h \
+ $(srcdir)/f/storag.c \
+ $(srcdir)/f/storag.h \
+ $(srcdir)/f/stp.c \
+ $(srcdir)/f/stp.h \
+ $(srcdir)/f/str-1t.fin \
+ $(srcdir)/f/str-2t.fin \
+ $(srcdir)/f/str-fo.fin \
+ $(srcdir)/f/str-io.fin \
+ $(srcdir)/f/str-nq.fin \
+ $(srcdir)/f/str-op.fin \
+ $(srcdir)/f/str-ot.fin \
+ $(srcdir)/f/str.c \
+ $(srcdir)/f/str.h \
+ $(srcdir)/f/sts.c \
+ $(srcdir)/f/sts.h \
+ $(srcdir)/f/stt.c \
+ $(srcdir)/f/stt.h \
+ $(srcdir)/f/stu.c \
+ $(srcdir)/f/stu.h \
+ $(srcdir)/f/stv.c \
+ $(srcdir)/f/stv.h \
+ $(srcdir)/f/stw.c \
+ $(srcdir)/f/stw.h \
+ $(srcdir)/f/symbol.c \
+ $(srcdir)/f/symbol.def \
+ $(srcdir)/f/symbol.h \
+ $(srcdir)/f/target.c \
+ $(srcdir)/f/target.h \
+ $(srcdir)/f/tconfig.j \
+ $(srcdir)/f/tm.j \
+ $(srcdir)/f/top.c \
+ $(srcdir)/f/top.h \
+ $(srcdir)/f/tree.j \
+ $(srcdir)/f/type.c \
+ $(srcdir)/f/type.h \
+ $(srcdir)/f/where.c \
+ $(srcdir)/f/where.h \
+ $(srcdir)/f/zzz.c \
+ $(srcdir)/f/zzz.h
+
+f771: $(P) $(F77_SRCS) $(LIBDEPS) stamp-objlist f/Makefile
+ $(MAKE) -f f/Makefile $(FLAGS_TO_PASS) VPATH=$(srcdir) srcdir=$(srcdir) f771
+
+f/Makefile: $(srcdir)/f/Makefile.in $(srcdir)/configure
+ $(SHELL) config.status
+
+# Note that the runtime is built in the top-level directory rather
+# than in f/runtime a la the Cygnus CHILL example; then xgcc -B./ will
+# find it. Use an absolute name for GCC_FOR_TARGET (so we don't have
+# to keep stage? links around everywhere) unless this value has been
+# overridden from the default "./xgcc -B./", hence the case statement.
+# We depend on GCC_PASSES through f/runtime/Makefile.
+stmp-headers = stmp-headers # to be overrideable in unsafe version
+# Depend on stmp-headers, not stmp-int-hdrs, since libF77 needs float.h.
+f77-runtime: f/runtime/Makefile include/f2c.h $(stmp-headers) \
+ f/runtime/libF77/Makefile f/runtime/libI77/Makefile f/runtime/libU77/Makefile
+ case "$(LANGUAGES)" in \
+ *f77*) top=`pwd`; \
+ cd f/runtime && $(MAKE) \
+ GCC_FOR_TARGET="`case '$(GCC_FOR_TARGET)' in \
+ './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
+ *) echo '$(GCC_FOR_TARGET)';; esac`" \
+ GCC_FLAGS="$(GCC_FLAGS)" $(F77_FLAGS_TO_PASS) \
+ all ;; \
+ esac
+
+# This one doesn't depend on cc1 etc. but f2c.h may not be found,
+# in particular, at present...
+f77-runtime-unsafe:
+ $(MAKE) stmp-headers= GCC_PARTS= f77-runtime
+
+# The configuration of the runtime system relies on an autoconf-type
+# configure, not a Cygnus-type one. It needs to be run *after* the
+# appropriate (cross-)compiler has been built, thus depend on GCC_PARTS.
+# NB, sh uses the *first* value of $a from `a=fred a=joe prog'.
+include/f2c.h \
+f/runtime/Makefile \
+f/runtime/libF77/Makefile \
+f/runtime/libI77/Makefile \
+f/runtime/libU77/Makefile: \
+ $(srcdir)/f/runtime/f2c.h.in \
+ $(srcdir)/f/com.h $(srcdir)/f/proj.h \
+ $(srcdir)/f/runtime/Makefile.in \
+ $(srcdir)/f/runtime/libF77/Makefile.in \
+ $(srcdir)/f/runtime/libI77/Makefile.in \
+ $(srcdir)/f/runtime/libU77/Makefile.in \
+ $(srcdir)/f/runtime/configure \
+ $(srcdir)/f/runtime/libU77/configure \
+ $(GCC_PARTS)
+# The make "stage?" in compiler spec. is fully qualified as above
+ top=`pwd`; \
+ src=`cd $(srcdir); pwd`; \
+ cd f/runtime; \
+ CC="`case '$(GCC_FOR_TARGET)' in \
+ './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
+ *) echo '$(GCC_FOR_TARGET)';; esac`" \
+ $(F77_FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) \
+ $${src}/f/runtime/configure --srcdir=$${src}/f/runtime
+ top=`pwd`; \
+ src=`cd $(srcdir); pwd`; \
+ cd f/runtime/libU77; \
+ CC="`case '$(GCC_FOR_TARGET)' in \
+ './xgcc -B./') echo $${top}/xgcc -B$${top}/;; \
+ *) echo '$(GCC_FOR_TARGET)';; esac`" \
+ $(F77_FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) \
+ $${src}/f/runtime/libU77/configure --srcdir=$${src}/f/runtime/libU77
+
+#For now, omit f2c stuff. -- burley
+#f2c: stmp-headers f/f2c/Makefile
+# cd f/f2c; $(MAKE) all
+#
+#f/f2c/Makefile: $(srcdir)/f/f2c/Makefile.in $(GCC_PARTS) \
+# $(srcdir)/config/$(xmake_file) $(srcdir)/config/$(tmake_file)
+# top=`pwd`; cd f/f2c; \
+# $${top}/f/f2c/configure --srcdir=$${top}/f/f2c
+
+# Build hooks:
+
+# I'm not sure there's a way of getting f2c into here conditionally on
+# the --enable-f2c flag detected by config-lang.in so kluge it with the
+# maybe-f2c target by looking at STAGESTUFF.
+f77.all.build: g77 maybe-f2c
+f77.all.cross: g77-cross maybe-f2c
+f77.start.encap: g77 maybe-f2c
+f77.rest.encap:
+
+f77.info: $(srcdir)/f/g77.info
+f77.dvi: $(srcdir)/f/g77.dvi
+
+# g77 documentation.
+$(srcdir)/f/g77.info: f/g77.texi f/bugs.texi f/install.texi f/news.texi f/intdoc.texi
+ cd $(srcdir)/f; $(MAKEINFO) g77.texi
+
+$(srcdir)/f/g77.dvi: f/g77.texi f/bugs.texi f/install.texi f/news.texi f/intdoc.texi
+ cd $(srcdir)/f; $(TEXI2DVI) g77.texi
+
+$(srcdir)/f/intdoc.texi: f/intdoc.c f/intdoc.h f/intrin.def f/intrin.h
+ $(HOST_CC) $(HOST_CFLAGS) $(HOST_LDFLAGS) \
+ `echo $(srcdir)/f/intdoc.c | sed 's,^\./,,'` -o f/intdoc
+ f/intdoc > $(srcdir)/f/intdoc.texi
+ rm f/intdoc
+
+$(srcdir)/f/BUGS: f/bugs0.texi f/bugs.texi
+ cd $(srcdir)/f; $(MAKEINFO) -D BUGSONLY --no-header --no-split \
+ --no-validate bugs0.texi -o BUGS
+
+$(srcdir)/f/INSTALL: f/install0.texi f/install.texi
+ cd $(srcdir)/f; $(MAKEINFO) -D INSTALLONLY --no-header --no-split \
+ --no-validate install0.texi -o INSTALL
+
+$(srcdir)/f/NEWS: f/news0.texi f/news.texi
+ cd $(srcdir)/f; $(MAKEINFO) -D NEWSONLY --no-header --no-split \
+ --no-validate news0.texi -o NEWS
+
+$(srcdir)/f/runtime/configure: $(srcdir)/f/runtime/configure.in
+ cd f/runtime && $(MAKE) srcdir=../../$(srcdir)/f/runtime -f ../../$(srcdir)/f/runtime/Makefile.in rebuilt
+$(srcdir)/f/runtime/libU77/configure: $(srcdir)/f/runtime/libU77/configure.in
+ cd f/runtime && $(MAKE) srcdir=../../$(srcdir)/f/runtime -f ../../$(srcdir)/f/runtime/Makefile.in rebuilt
+
+f77.rebuilt: $(srcdir)/f/g77.info $(srcdir)/f/BUGS $(srcdir)/f/INSTALL \
+ $(srcdir)/f/NEWS $(srcdir)/f/runtime/configure \
+ $(srcdir)/f/runtime/libU77/configure
+
+maybe-f2c:
+#For now, omit f2c stuff. -- burley
+# case "$(STAGESTUFF)" in *f2c*) $(MAKE) f2c;; esac
+
+# Install hooks:
+# f771 is installed elsewhere as part of $(COMPILERS).
+
+f77.install-normal: install-libf77 install-f2c-all
+
+# Install the F77 run time library.
+install-libf77: f77-runtime
+# Check for the presence of other versions of the library and includes.
+# Test libf2c.* in case of a shared version, for instance.
+ @if test -z "$(F2CLIBOK)" && \
+ test -z "$(F2C_INSTALL_FLAG)" && \
+ test "`echo $(libdir)/libf2c.*`" != "$(libdir)/libf2c.*"; then \
+ echo ; \
+ echo 'You already have a version of libf2c installed as' $(libdir)/libf2c.*; \
+ echo 'To use g77 this must be consistent with the one that will be built.'; \
+ echo 'You should probably delete it and/or install ./libf2c.a in its place.'; \
+ echo 'Resume the "make install" after removing the existing library or'; \
+ echo 'define the make variable F2CLIBOK to avoid this test.'; \
+ echo 'Check also for' $(includedir)/f2c.h 'per INSTALL instructions.'; \
+ echo '(Note that a quick and easy way to resume "make -k install" is to'; \
+ echo 'use "make install-libf77".)'; \
+ exit 1; else true; fi
+ if [ -f libf2c.a ] ; then \
+ $(INSTALL_DATA) libf2c.a $(libsubdir)/libf2c.a; \
+ if $(RANLIB_TEST) ; then \
+ (cd $(libsubdir); $(RANLIB) libf2c.a); else true; fi; \
+ chmod a-x $(libsubdir)/libf2c.a; \
+ else true; fi
+ if [ -f include/f2c.h ] ; then \
+ $(INSTALL_DATA) include/f2c.h $(libsubdir)/include/f2c.h; \
+ else true; fi
+
+# Install the f2c-related stuff in the directories
+# where f2c and vanilla ld might look for them.
+
+install-f2c-all: install-f2c-header install-f2c-lib
+
+install-f2c-header:
+ -if test -n "$(F2C_INSTALL_FLAG)" && test -f include/f2c.h; then \
+ $(INSTALL_DATA) include/f2c.h $(includedir)/f2c.h; \
+ chmod a+r $(includedir)/f2c.h; \
+ else true; fi
+
+install-f2c-lib:
+ -if test -n "$(F2C_INSTALL_FLAG)" && test -f libf2c.a; then \
+ $(INSTALL_DATA) libf2c.a $(libdir)/libf2c.a; \
+ if $(RANLIB_TEST) ; then \
+ (cd $(libdir); $(RANLIB) libf2c.a); else true; fi; \
+ chmod a-x $(libdir)/libf2c.a; \
+ else true; fi
+
+# Install the driver program as $(target)-g77
+# and also as either g77 (if native) or $(tooldir)/bin/g77.
+f77.install-common:
+ -if [ -f f771$(exeext) ] ; then \
+ if [ -f g77-cross$(exeext) ] ; then \
+ rm -f $(bindir)/$(G77_CROSS_NAME)$(exeext); \
+ $(INSTALL_PROGRAM) g77-cross$(exeext) $(bindir)/$(G77_CROSS_NAME)$(exeext); \
+ chmod a+x $(bindir)/$(G77_CROSS_NAME)$(exeext); \
+ if $(F77_INSTALL_FLAG) ; then \
+ rm -f $(bindir)/$(F77_CROSS_NAME)$(exeext); \
+ ln $(bindir)/$(G77_CROSS_NAME)$(exeext) $(bindir)/$(F77_CROSS_NAME)$(exeext) \
+ > /dev/null 2>&1 \
+ || cp $(bindir)/$(G77_CROSS_NAME)$(exeext) $(bindir)/$(F77_CROSS_NAME)$(exeext) ; \
+ fi ; \
+ else \
+ rm -f $(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+ $(INSTALL_PROGRAM) g77$(exeext) $(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+ chmod a+x $(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+ if $(F77_INSTALL_FLAG) ; then \
+ rm -f $(bindir)/$(F77_INSTALL_NAME)$(exeext); \
+ ln $(bindir)/$(G77_INSTALL_NAME)$(exeext) $(bindir)/$(F77_INSTALL_NAME)$(exeext) \
+ > /dev/null 2>&1 \
+ || cp $(bindir)/$(G77_INSTALL_NAME)$(exeext) $(bindir)/$(F77_INSTALL_NAME)$(exeext) ; \
+ fi ; \
+ fi ; \
+ else true; fi
+
+f77.install-info:
+ -rm -f $(infodir)/g77.info*
+ cd $(srcdir)/f; for f in g77.info*; \
+ do $(INSTALL_DATA) $$f $(infodir)/$$f; done
+ -chmod a-x $(infodir)/g77.info*
+
+f77.install-man: $(srcdir)/f/g77.1
+ -if [ -f f771$(exeext) ] ; then \
+ if [ -f g77-cross$(exeext) ] ; then \
+ rm -f $(mandir)/$(G77_CROSS_NAME)$(manext); \
+ $(INSTALL_DATA) $(srcdir)/f/g77.1 $(mandir)/$(G77_CROSS_NAME)$(manext); \
+ chmod a-x $(mandir)/$(G77_CROSS_NAME)$(manext); \
+ if $(F77_INSTALL_FLAG) ; then \
+ rm -f $(mandir)/$(F77_CROSS_NAME)$(manext); \
+ ln $(mandir)/$(G77_CROSS_NAME)$(manext) $(mandir)/$(F77_CROSS_NAME)$(manext) \
+ > /dev/null 2>&1 \
+ || cp $(mandir)/$(F77_CROSS_NAME)$(manext) $(mandir)/$(F77_CROSS_NAME)$(manext) ; \
+ fi ;\
+ else \
+ rm -f $(mandir)/$(G77_INSTALL_NAME)$(manext); \
+ $(INSTALL_DATA) $(srcdir)/f/g77.1 $(mandir)/$(G77_INSTALL_NAME)$(manext); \
+ chmod a-x $(mandir)/$(G77_INSTALL_NAME)$(manext); \
+ if $(F77_INSTALL_FLAG) ; then \
+ rm -f $(mandir)/$(F77_INSTALL_NAME)$(manext); \
+ ln $(mandir)/$(G77_INSTALL_NAME)$(manext) $(mandir)/$(F77_INSTALL_NAME)$(manext) \
+ > /dev/null 2>&1 \
+ || cp $(mandir)/$(F77_INSTALL_NAME)$(manext) $(mandir)/$(F77_INSTALL_NAME)$(manext) ; \
+ fi ;\
+ fi; \
+ else true; fi
+
+f77.uninstall:
+ -if $(F77_INSTALL_FLAG) ; then \
+ rm -rf $(bindir)/$(F77_INSTALL_NAME)$(exeext) ; \
+ rm -rf $(bindir)/$(F77_CROSS_NAME)$(exeext) ; \
+ rm -rf $(mandir)/$(F77_INSTALL_NAME)$(manext) ; \
+ rm -rf $(mandir)/$(F77_CROSS_NAME)$(manext) ; \
+ fi
+ -rm -rf $(bindir)/$(G77_INSTALL_NAME)$(exeext)
+ -rm -rf $(bindir)/$(G77_CROSS_NAME)$(exeext)
+ -rm -rf $(mandir)/$(G77_INSTALL_NAME)$(manext)
+ -rm -rf $(mandir)/$(G77_CROSS_NAME)$(manext)
+ -rm -rf $(infodir)/g77.info*
+ -rm -rf $(libsubdir)/libf2c.a
+ -if $(F2C_INSTALL_FLAG) ; then \
+ rm -rf include/f2c.h ; \
+ rm -rf $(libdir)/libf2c.a ; \
+ fi
+
+# Clean hooks:
+# A lot of the ancillary files are deleted by the main makefile.
+# We just have to delete files specific to us.
+
+f77.mostlyclean:
+ -rm -f f/*$(objext)
+ -rm -f f/fini f/f771 f/stamp-str f/str-*.h f/str-*.j f/intdoc
+ -cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in mostlyclean
+f77.clean:
+ -cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in clean
+f77.distclean:
+ -cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in distclean
+ -rm -f f/Makefile
+# like gcc's extraclean, which does clean f/ for us, but not f/gbe,
+# f/runtime, f/runtime/libF77, f/runtime/libI77, and f/runtime/libU77,
+# so do those.
+f77.extraclean: f77.distclean
+ -rm -f f/*/=* f/*/"#"* f/*/*~*
+ -rm -f f/*/patch* f/*/*.orig f/*/*.rej
+ -rm -f f/*/*.dvi f/*/*.oaux f/*/*.d f/*/*.[zZ] f/*/*.gz
+ -rm -f f/*/*.tar f/*/*.xtar f/*/*diff f/*/*.diff.* f/*/*.tar.* f/*/*.xtar.* f/*/*diffs
+ -rm -f f/*/*lose f/*/*.s f/*/*.s[0-9] f/*/*.i
+ -rm -f f/*/*/=* f/*/*/"#"* f/*/*/*~*
+ -rm -f f/*/*/patch* f/*/*/*.orig f/*/*/*.rej
+ -rm -f f/*/*/*.dvi f/*/*/*.oaux f/*/*/*.d f/*/*/*.[zZ] f/*/*/*.gz
+ -rm -f f/*/*/*.tar f/*/*/*.xtar f/*/*/*diff f/*/*/*.diff.* f/*/*/*.tar.* f/*/*/*.xtar.* f/*/*/*diffs
+ -rm -f f/*/*/*lose f/*/*/*.s f/*/*/*.s[0-9] f/*/*/*.i
+# realclean is the pre-2.7.0 name for maintainer-clean
+f77.maintainer-clean f77.realclean: f77.distclean
+ -cd f/runtime; $(MAKE) -f ../../$(srcdir)/f/runtime/Makefile.in maintainer-clean
+ -$(MAKE) f77.maintainer-clean
+ -rm -f f/g77.info* f/g77.*aux f/TAGS f/BUGS f/INSTALL f/NEWS f/intdoc.texi
+
+# Stage hooks:
+# The main makefile has already created stage?/f.
+
+G77STAGESTUFF = f/*$(objext) f/fini f/stamp-str f/str-*.h f/str-*.j
+RUNTIMESTAGESTUFF = f/runtime/config.cache f/runtime/config.log \
+ f/runtime/config.status f/runtime/Makefile f/runtime/stamp-lib
+LIBF77STAGESTUFF = f/runtime/libF77/*$(objext) f/runtime/libF77/Makefile
+LIBI77STAGESTUFF = f/runtime/libI77/*$(objext) f/runtime/libI77/Makefile
+LIBU77STAGESTUFF = f/runtime/libU77/*$(objext) f/runtime/libU77/Makefile \
+ f/runtime/libU77/config.cache f/runtime/libU77/config.log \
+ f/runtime/libU77/config.status
+
+f77.stage1:
+ -mv $(G77STAGESTUFF) stage1/f
+ -mv $(RUNTIMESTAGESTUFF) stage1/f/runtime
+ -mv $(LIBF77STAGESTUFF) stage1/f/runtime/libF77
+ -mv $(LIBI77STAGESTUFF) stage1/f/runtime/libI77
+ -mv $(LIBU77STAGESTUFF) stage1/f/runtime/libU77
+f77.stage2:
+ -mv $(G77STAGESTUFF) stage2/f
+ -mv $(RUNTIMESTAGESTUFF) stage2/f/runtime
+ -mv $(LIBF77STAGESTUFF) stage2/f/runtime/libF77
+ -mv $(LIBI77STAGESTUFF) stage2/f/runtime/libI77
+ -mv $(LIBU77STAGESTUFF) stage2/f/runtime/libU77
+f77.stage3:
+ -mv $(G77STAGESTUFF) stage3/f
+ -mv $(RUNTIMESTAGESTUFF) stage3/f/runtime
+ -mv $(LIBF77STAGESTUFF) stage3/f/runtime/libF77
+ -mv $(LIBI77STAGESTUFF) stage3/f/runtime/libI77
+ -mv $(LIBU77STAGESTUFF) stage3/f/runtime/libU77
+f77.stage4:
+ -mv $(G77STAGESTUFF) stage4/f
+ -mv $(RUNTIMESTAGESTUFF) stage4/f/runtime
+ -mv $(LIBF77STAGESTUFF) stage4/f/runtime/libF77
+ -mv $(LIBI77STAGESTUFF) stage4/f/runtime/libI77
+ -mv $(LIBU77STAGESTUFF) stage4/f/runtime/libU77
+
+# Maintenance hooks:
+
+# This target creates the files that can be rebuilt, but go in the
+# distribution anyway. It then copies the files to the distdir directory.
+f77.distdir: f77.rebuilt
+ mkdir tmp/f
+ cd f; \
+ for file in *[0-9a-zA-Z+]; do \
+ ln $$file ../tmp/f >/dev/null 2>&1 || cp $$file ../tmp/f; \
+ done
diff --git a/gcc/f/Makefile.in b/gcc/f/Makefile.in
new file mode 100644
index 00000000000..79eba82a3a9
--- /dev/null
+++ b/gcc/f/Makefile.in
@@ -0,0 +1,562 @@
+# Makefile for GNU F77 compiler.
+# 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 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.
+
+# The makefile built from this file lives in the language subdirectory.
+# Its purpose is to provide support for:
+#
+# 1) recursion where necessary, and only then (building .o's), and
+# 2) building and debugging f771 from the language subdirectory, and
+# 3) nothing else.
+#
+# The parent makefile handles all other chores, with help from the
+# language makefile fragment, of course.
+#
+# The targets for external use are:
+# all, TAGS, ???mostlyclean, ???clean.
+
+# Suppress smart makes who think they know how to automake Yacc files
+.y.c:
+
+# Variables that exist for you to override.
+# See below for how to change them for certain systems.
+
+ALLOCA =
+
+# Various ways of specifying flags for compilations:
+# CFLAGS is for the user to override to, e.g., do a bootstrap with -O2.
+# BOOT_CFLAGS is the value of CFLAGS to pass
+# to the stage2 and stage3 compilations
+# XCFLAGS is used for most compilations but not when using the GCC just built.
+XCFLAGS =
+CFLAGS = -g
+BOOT_CFLAGS = -O $(CFLAGS)
+# These exists to be overridden by the x-* and t-* files, respectively.
+X_CFLAGS =
+T_CFLAGS =
+
+X_CPPFLAGS =
+T_CPPFLAGS =
+
+CC = cc
+HOST_CC = $(CC)
+BISON = bison
+BISONFLAGS =
+LEX = flex
+LEXFLAGS =
+AR = ar
+AR_FLAGS = rc
+SHELL = /bin/sh
+MAKEINFO = makeinfo
+TEXI2DVI = texi2dvi
+
+# Define this as & to perform parallel make on a Sequent.
+# Note that this has some bugs, and it seems currently necessary
+# to compile all the gen* files first by hand to avoid erroneous results.
+P =
+
+# This is used in the definition of SUBDIR_USE_ALLOCA.
+# ??? Perhaps it would be better if it just looked for *gcc*.
+OLDCC = cc
+
+# This is used instead of ALL_CFLAGS when compiling with GCC_FOR_TARGET.
+# It omits XCFLAGS, and specifies -B./.
+# It also specifies -B$(tooldir)/ to find as and ld for a cross compiler.
+GCC_CFLAGS=$(INTERNAL_CFLAGS) $(X_CFLAGS) $(T_CFLAGS) $(CFLAGS)
+
+# Tools to use when building a cross-compiler.
+# These are used because `configure' appends `cross-make'
+# to the makefile when making a cross-compiler.
+
+target= ... `configure' substitutes actual target name here.
+xmake_file= ... `configure' substitutes actual x- file name here.
+tmake_file= ... `configure' substitutes actual t- file name here.
+
+# Directory where gcc sources are (gcc/), from where we are.
+# Note that this should be overridden when building f771, which happens
+# at the top level, not in f. Likewise for VPATH (if added).
+srcdir = .
+VPATH = .
+
+# Additional system libraries to link with.
+CLIB=
+
+# Change this to a null string if obstacks are installed in the
+# system library.
+OBSTACK=obstack.o
+
+# Choose the real default target.
+ALL=all
+
+# End of variables for you to override.
+
+# Definition of `none' is here so that new rules inserted by sed
+# do not specify the default target.
+none:
+ @echo ''
+ @echo 'Do not use this makefile to build anything other than the'
+ @echo 'g77 derived files via the "make g77-only" target.'
+ @echo 'Instead, use the documented procedures to build gcc itself,'
+ @echo 'which will build g77 as well when done properly.'
+ @echo ''
+ @exit 1
+
+# This rule is just a handy way to build the g77 derived files without
+# having the gcc source tree around.
+g77-only: force
+ if [ -f g77.texi ] ; then \
+ (cd ..; $(MAKE) srcdir=. HOST_CC=cc HOST_CFLAGS=-g -f f/Make-lang.in f77.rebuilt); \
+ else \
+ $(MAKE) srcdir=. HOST_CC=cc HOST_CFLAGS=-g -f f/Make-lang.in f77.rebuilt; \
+ fi
+
+all: all.indirect
+
+# This tells GNU Make version 3 not to put all variables in the environment.
+.NOEXPORT:
+
+# sed inserts variable overrides after the following line.
+####target overrides
+####host overrides
+####cross overrides
+####build overrides
+
+# Now figure out from those variables how to compile and link.
+
+all.indirect: f/Makefile f771
+
+# IN_GCC tells obstack.h that we are using gcc's <stddef.h> file.
+INTERNAL_CFLAGS = $(CROSS) -DIN_GCC
+
+# This is the variable actually used when we compile.
+ALL_CFLAGS = $(INTERNAL_CFLAGS) $(X_CFLAGS) $(T_CFLAGS) $(CFLAGS) $(XCFLAGS) -W -Wall
+
+# Likewise.
+ALL_CPPFLAGS = $(CPPFLAGS) $(X_CPPFLAGS) $(T_CPPFLAGS)
+
+# f771 is so big, need to tell linker on m68k-next-nextstep* to make enough
+# room for it. On AIX, linking f771 overflows the linker TOC. -bbigtoc is
+# appropriate for the linker on AIX 4.1 and above.
+F771_LDFLAGS = `case "${target}" in\
+ m68k-next-nextstep*) echo -segaddr __DATA 6000000;;\
+ *-*-aix[4-9]*) \`$(CC) --print-prog-name=ld\` -v 2>&1 | grep BFD >/dev/null || echo -Wl,-bbigtoc;; esac`
+
+# Even if ALLOCA is set, don't use it if compiling with GCC.
+
+SUBDIR_OBSTACK = `if [ x$(OBSTACK) != x ]; then echo $(OBSTACK); else true; fi`
+SUBDIR_USE_ALLOCA = `case "${CC}" in "${OLDCC}") if [ x$(ALLOCA) != x ]; then echo $(ALLOCA); else true; fi ;; esac`
+SUBDIR_MALLOC = `if [ x$(MALLOC) != x ]; then echo $(MALLOC); else true; fi`
+
+# How to link with both our special library facilities
+# and the system's installed libraries.
+LIBS = $(SUBDIR_OBSTACK) $(SUBDIR_USE_ALLOCA) $(SUBDIR_MALLOC) $(CLIB)
+
+# Specify the directories to be searched for header files.
+# Both . and srcdir are used, in that order,
+# so that tm.h and config.h will be found in the compilation
+# directory rather than in the source directory.
+INCLUDES = -If -I$(srcdir)/f -I. -I$(srcdir) -I$(srcdir)/config
+
+# Flags_to_pass to recursive makes.
+# Note that we don't need to distinguish the `_FOR_TARGET' cross tools
+# as AR and RANLIB are set appropriately by configure iff cross compiling.
+FLAGS_TO_PASS = \
+ "CROSS=$(CROSS)" \
+ "AR_FLAGS=$(AR_FLAGS)" \
+ "AR=$(AR)" \
+ "BISON=$(BISON)" \
+ "BISONFLAGS=$(BISONFLAGS)" \
+ "CC=$(CC)" \
+ "CFLAGS=$(CFLAGS)" \
+ "GCCFLAGS=$(GCCFLAGS)" \
+ "GCC_FOR_TARGET=$(GCC_FOR_TARGET)" \
+ "LDFLAGS=$(LDFLAGS)" \
+ "LEX=$(LEX)" \
+ "LEXFLAGS=$(LEXFLAGS)" \
+ "MAKEINFO=$(MAKEINFO)" \
+ "MAKEINFOFLAGS=$(MAKEINFOFLAGS)" \
+ "RANLIB=$(RANLIB)" \
+ "RANLIB_TEST=$(RANLIB_TEST)" \
+ "SHELL=$(SHELL)" \
+ "exec_prefix=$(exec_prefix)" \
+ "prefix=$(prefix)" \
+ "tooldir=$(tooldir)" \
+ "bindir=$(bindir)" \
+ "libsubdir=$(libsubdir)"
+
+.c.o:
+ $(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $< -o $@
+
+# Lists of files for various purposes.
+
+# Language-specific object files for g77
+
+F77_OBJS = \
+ f/bad.o \
+ f/bit.o \
+ f/bld.o \
+ f/com.o \
+ f/data.o \
+ f/equiv.o \
+ f/expr.o \
+ f/global.o \
+ f/implic.o \
+ f/info.o \
+ f/intrin.o \
+ f/lab.o \
+ f/lex.o \
+ f/malloc.o \
+ f/name.o \
+ f/parse.o \
+ f/proj.o \
+ f/src.o \
+ f/st.o \
+ f/sta.o \
+ f/stb.o \
+ f/stc.o \
+ f/std.o \
+ f/ste.o \
+ f/storag.o \
+ f/stp.o \
+ f/str.o \
+ f/sts.o \
+ f/stt.o \
+ f/stu.o \
+ f/stv.o \
+ f/stw.o \
+ f/symbol.o \
+ f/target.o \
+ f/top.o \
+ f/type.o \
+ f/where.o \
+ f/zzz.o
+
+# Language-independent object files.
+OBJS = `cat stamp-objlist | sed -e "s: : :g" -e "s: : f/:g"`
+OBJDEPS = stamp-objlist
+
+compiler: f771
+# This is now meant to be built in the top level directory, not `f':
+f771: $(P) f/Makefile $(F77_OBJS) $(OBJDEPS) $(LIBDEPS)
+ rm -f f771$(exeext)
+ $(CC) $(ALL_CFLAGS) $(LDFLAGS) $(F771_LDFLAGS) -o $@ \
+ $(F77_OBJS) $(OBJS) $(LIBS)
+
+# Check in case anyone expects to build in this directory:
+f/Makefile:
+ @if test ! -f f/Makefile ; \
+ then echo "Build f771 only at the top level." 2>&1; exit 1; \
+ else true; fi
+
+Makefile: $(srcdir)/f/Makefile.in $(srcdir)/configure
+
+native: f771
+
+# Compiling object files from source files.
+
+# Note that dependencies on obstack.h are not written
+# because that file is not part of GCC.
+
+# F77 language-specific files.
+
+# These macros expand to the corresponding g77-source .j files plus
+# the gcc-source files involved (each file itself, plus whatever
+# files on which it depends, but without including stuff resulting
+# from configuration, since we can't guess at that). The files
+# that live in a distclean'd gcc source directory have "$(srcdir)/"
+# prefixes, while the others don't because they'll be created
+# only in the build directory.
+ASSERT_H = $(srcdir)/f/assert.j $(srcdir)/assert.h
+CONFIG_H = $(srcdir)/f/config.j config.h
+CONVERT_H = $(srcdir)/f/convert.j $(srcdir)/convert.h
+FLAGS_H = $(srcdir)/f/flags.j $(srcdir)/flags.h
+GLIMITS_H = $(srcdir)/f/glimits.j $(srcdir)/glimits.h
+HCONFIG_H = $(srcdir)/f/hconfig.j hconfig.h
+INPUT_H = $(srcdir)/f/input.j $(srcdir)/input.h
+RTL_H = $(srcdir)/f/rtl.j $(srcdir)/rtl.h $(srcdir)/rtl.def \
+ $(srcdir)/machmode.h $(srcdir)/machmode.def
+TCONFIG_H = $(srcdir)/f/tconfig.j tconfig.h
+TM_H = $(srcdir)/f/tm.j tm.h
+TREE_H = $(srcdir)/f/tree.j $(srcdir)/tree.h $(srcdir)/real.h \
+ $(srcdir)/tree.def $(srcdir)/machmode.h $(srcdir)/machmode.def
+
+#Build the first part of this list with the command line:
+# cd gcc/; make deps-kinda -f f/Makefile.in
+#Note that this command uses the host C compiler;
+# use HOST_CC="./xgcc -B./" to use GCC in the build directory, for example.
+#Also note that this particular build file seems to want to use
+# substitions: $(CONFIG_H) for config.h; $(TREE_H) for tree.h; and
+# $(RTL_H) for rtl.h. deps-kinda uses a sed script to do those
+# substitutions, plus others for elegance.
+
+f/bad.o: f/bad.c f/proj.h $(ASSERT_H) f/bad.h f/bad.def f/where.h $(GLIMITS_H) \
+ f/top.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h \
+ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/lex.h f/type.h \
+ f/intrin.h f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h \
+ f/global.h f/name.h
+f/bit.o: f/bit.c f/proj.h $(ASSERT_H) $(GLIMITS_H) f/bit.h f/malloc.h
+f/bld.o: f/bld.c f/proj.h $(ASSERT_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h \
+ f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h f/type.h \
+ f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h \
+ f/intrin.h f/intrin.def
+f/com.o: f/com.c $(CONFIG_H) $(FLAGS_H) $(RTL_H) $(TREE_H) $(CONVERT_H) f/proj.h \
+ $(ASSERT_H) f/com.h f/com-rt.def f/bld.h f/bld-op.def f/bit.h f/malloc.h \
+ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
+ f/where.h $(GLIMITS_H) f/top.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h \
+ f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h f/expr.h \
+ f/implic.h f/src.h f/st.h
+f/data.o: f/data.c f/proj.h $(ASSERT_H) f/data.h f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+ f/name.h f/intrin.h f/intrin.def f/expr.h f/st.h
+f/equiv.o: f/equiv.c f/proj.h $(ASSERT_H) f/equiv.h f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/global.h f/name.h \
+ f/intrin.h f/intrin.def f/data.h
+f/expr.o: f/expr.c f/proj.h $(ASSERT_H) f/expr.h f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+ f/name.h f/intrin.h f/intrin.def f/implic.h f/src.h f/st.h
+f/fini.o: f/fini.c f/proj.h $(ASSERT_H) f/malloc.h
+f/g77.o: f/g77.c $(CONFIG_H)
+f/global.o: f/global.c f/proj.h $(ASSERT_H) f/global.h f/lex.h f/top.h f/malloc.h \
+ f/where.h $(GLIMITS_H) f/name.h f/symbol.h f/symbol.def f/bad.h f/bad.def \
+ f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h f/storag.h \
+ f/intrin.h f/intrin.def f/equiv.h
+f/implic.o: f/implic.c f/proj.h $(ASSERT_H) f/implic.h f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def f/where.h \
+ $(GLIMITS_H) f/top.h f/malloc.h f/lex.h f/type.h f/symbol.h f/symbol.def f/bld.h \
+ f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h f/storag.h f/intrin.h \
+ f/intrin.def f/equiv.h f/global.h f/name.h f/src.h
+f/info.o: f/info.c f/proj.h $(ASSERT_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def f/where.h $(GLIMITS_H) \
+ f/top.h f/malloc.h f/lex.h f/type.h
+f/intrin.o: f/intrin.c f/proj.h $(ASSERT_H) f/intrin.h f/intrin.def f/bld.h \
+ f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h \
+ $(GLIMITS_H) f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
+ f/equiv.h f/global.h f/name.h f/src.h
+f/lab.o: f/lab.c f/proj.h $(ASSERT_H) f/lab.h f/com.h f/com-rt.def $(TREE_H) f/bld.h \
+ f/bld-op.def f/bit.h f/malloc.h f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/intrin.h f/intrin.def f/symbol.h f/symbol.def f/equiv.h f/storag.h \
+ f/global.h f/name.h
+f/lex.o: f/lex.c f/proj.h $(ASSERT_H) f/top.h f/malloc.h f/where.h $(GLIMITS_H) \
+ f/bad.h f/bad.def f/com.h f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h \
+ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/lex.h f/type.h \
+ f/intrin.h f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h \
+ f/global.h f/name.h f/src.h $(CONFIG_H) $(FLAGS_H) $(INPUT_H)
+f/malloc.o: f/malloc.c f/proj.h $(ASSERT_H) f/malloc.h
+f/name.o: f/name.c f/proj.h $(ASSERT_H) f/bad.h f/bad.def f/where.h $(GLIMITS_H) \
+ f/top.h f/malloc.h f/name.h f/global.h f/lex.h f/symbol.h f/symbol.def f/bld.h \
+ f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h f/storag.h f/intrin.h \
+ f/intrin.def f/equiv.h f/src.h
+f/parse.o: f/parse.c f/proj.h $(ASSERT_H) f/top.h f/malloc.h f/where.h $(GLIMITS_H) \
+ f/com.h f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/lex.h \
+ f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h \
+ f/storag.h f/global.h f/name.h f/zzz.h $(FLAGS_H)
+f/proj.o: f/proj.c f/proj.h $(ASSERT_H) $(GLIMITS_H)
+f/src.o: f/src.c f/proj.h $(ASSERT_H) f/src.h f/bad.h f/bad.def f/where.h \
+ $(GLIMITS_H) f/top.h f/malloc.h
+f/st.o: f/st.c f/proj.h $(ASSERT_H) f/st.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) \
+ f/top.h f/malloc.h f/lex.h f/symbol.h f/symbol.def f/bld.h f/bld-op.def f/bit.h \
+ f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/type.h f/lab.h f/storag.h f/intrin.h f/intrin.def f/equiv.h \
+ f/global.h f/name.h f/sta.h f/stamp-str f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h \
+ f/std.h f/stv.h f/stw.h f/ste.h f/sts.h f/stu.h
+f/sta.o: f/sta.c f/proj.h $(ASSERT_H) f/sta.h f/bad.h f/bad.def f/where.h \
+ $(GLIMITS_H) f/top.h f/malloc.h f/lex.h f/stamp-str f/symbol.h f/symbol.def f/bld.h \
+ f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h f/storag.h f/intrin.h \
+ f/intrin.def f/equiv.h f/global.h f/name.h f/implic.h f/stb.h f/expr.h f/stp.h \
+ f/stt.h f/stc.h f/std.h f/stv.h f/stw.h
+f/stb.o: f/stb.c f/proj.h $(ASSERT_H) f/stb.h f/bad.h f/bad.def f/where.h \
+ $(GLIMITS_H) f/top.h f/malloc.h f/expr.h f/bld.h f/bld-op.def f/bit.h f/com.h \
+ f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
+ f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h f/stt.h f/stamp-str \
+ f/src.h f/sta.h f/stc.h
+f/stc.o: f/stc.c f/proj.h $(ASSERT_H) f/stc.h f/bad.h f/bad.def f/where.h \
+ $(GLIMITS_H) f/top.h f/malloc.h f/bld.h f/bld-op.def f/bit.h f/com.h \
+ f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
+ f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/stp.h f/stt.h \
+ f/stamp-str f/data.h f/implic.h f/src.h f/sta.h f/std.h f/stv.h f/stw.h
+f/std.o: f/std.c f/proj.h $(ASSERT_H) f/std.h f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+ f/name.h f/intrin.h f/intrin.def f/stp.h f/stt.h f/stamp-str f/stv.h f/stw.h f/sta.h \
+ f/ste.h f/sts.h
+f/ste.o: f/ste.c $(CONFIG_H) $(RTL_H) f/proj.h $(ASSERT_H) f/ste.h f/bld.h \
+ f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h \
+ $(GLIMITS_H) f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
+ f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h f/stt.h f/stamp-str \
+ f/sts.h f/stv.h f/stw.h f/sta.h
+f/storag.o: f/storag.c f/proj.h $(ASSERT_H) f/storag.h f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/lab.h f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h \
+ f/intrin.h f/intrin.def f/data.h
+f/stp.o: f/stp.c f/proj.h $(ASSERT_H) f/stp.h f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+ f/name.h f/intrin.h f/intrin.def f/stt.h
+f/str.o: f/str.c f/proj.h $(ASSERT_H) f/src.h f/bad.h f/bad.def f/where.h \
+ $(GLIMITS_H) f/top.h f/malloc.h f/stamp-str f/lex.h
+f/sts.o: f/sts.c f/proj.h $(ASSERT_H) f/sts.h f/malloc.h f/com.h f/com-rt.def \
+ $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h \
+ f/storag.h f/global.h f/name.h
+f/stt.o: f/stt.c f/proj.h $(ASSERT_H) f/stt.h f/top.h f/malloc.h f/where.h \
+ $(GLIMITS_H) f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/lex.h \
+ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+ f/name.h f/intrin.h f/intrin.def f/stp.h f/expr.h f/sta.h f/stamp-str
+f/stu.o: f/stu.c f/proj.h $(ASSERT_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h \
+ f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h f/type.h \
+ f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h \
+ f/intrin.h f/intrin.def f/implic.h f/stu.h f/sta.h f/stamp-str
+f/stv.o: f/stv.c f/proj.h $(ASSERT_H) f/stv.h f/lab.h f/com.h f/com-rt.def $(TREE_H) \
+ f/bld.h f/bld-op.def f/bit.h f/malloc.h f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/intrin.h f/intrin.def f/symbol.h f/symbol.def f/equiv.h f/storag.h \
+ f/global.h f/name.h
+f/stw.o: f/stw.c f/proj.h $(ASSERT_H) f/stw.h f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h $(GLIMITS_H) f/top.h f/lex.h \
+ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+ f/name.h f/intrin.h f/intrin.def f/stv.h f/sta.h f/stamp-str
+f/symbol.o: f/symbol.c f/proj.h $(ASSERT_H) f/symbol.h f/symbol.def f/bad.h \
+ f/bad.def f/where.h $(GLIMITS_H) f/top.h f/malloc.h f/bld.h f/bld-op.def f/bit.h \
+ f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/intrin.h f/intrin.def \
+ f/equiv.h f/global.h f/name.h f/src.h f/st.h
+f/target.o: f/target.c f/proj.h $(ASSERT_H) $(GLIMITS_H) f/target.h $(TREE_H) f/bad.h \
+ f/bad.def f/where.h f/top.h f/malloc.h f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/type.h f/lex.h
+f/top.o: f/top.c f/proj.h $(ASSERT_H) f/top.h f/malloc.h f/where.h $(GLIMITS_H) \
+ f/bad.h f/bad.def f/bit.h f/bld.h f/bld-op.def f/com.h f/com-rt.def $(TREE_H) \
+ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/lex.h f/type.h \
+ f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h \
+ f/intrin.h f/intrin.def f/data.h f/expr.h f/implic.h f/src.h f/st.h $(FLAGS_H)
+f/type.o: f/type.c f/proj.h $(ASSERT_H) f/type.h f/malloc.h
+f/where.o: f/where.c f/proj.h $(ASSERT_H) f/where.h $(GLIMITS_H) f/top.h f/malloc.h \
+ f/lex.h
+f/zzz.o: f/zzz.c f/proj.h $(ASSERT_H) f/zzz.h
+
+# The rest of this list (Fortran 77 language-specific files) is hand-generated.
+
+f/stamp-str: f/str-1t.h f/str-1t.j f/str-2t.h f/str-2t.j \
+ f/str-fo.h f/str-fo.j f/str-io.h f/str-io.j f/str-nq.h f/str-nq.j \
+ f/str-op.h f/str-op.j f/str-ot.h f/str-ot.j
+ touch f/stamp-str
+
+f/str-1t.h f/str-1t.j: f/fini f/str-1t.fin
+ ./f/fini `echo $(srcdir)/f/str-1t.fin | sed 's,^\./,,'` f/str-1t.j f/str-1t.h
+
+f/str-2t.h f/str-2t.j: f/fini f/str-2t.fin
+ ./f/fini `echo $(srcdir)/f/str-2t.fin | sed 's,^\./,,'` f/str-2t.j f/str-2t.h
+
+f/str-fo.h f/str-fo.j: f/fini f/str-fo.fin
+ ./f/fini `echo $(srcdir)/f/str-fo.fin | sed 's,^\./,,'` f/str-fo.j f/str-fo.h
+
+f/str-io.h f/str-io.j: f/fini f/str-io.fin
+ ./f/fini `echo $(srcdir)/f/str-io.fin | sed 's,^\./,,'` f/str-io.j f/str-io.h
+
+f/str-nq.h f/str-nq.j: f/fini f/str-nq.fin
+ ./f/fini `echo $(srcdir)/f/str-nq.fin | sed 's,^\./,,'` f/str-nq.j f/str-nq.h
+
+f/str-op.h f/str-op.j: f/fini f/str-op.fin
+ ./f/fini `echo $(srcdir)/f/str-op.fin | sed 's,^\./,,'` f/str-op.j f/str-op.h
+
+f/str-ot.h f/str-ot.j: f/fini f/str-ot.fin
+ ./f/fini `echo $(srcdir)/f/str-ot.fin | sed 's,^\./,,'` f/str-ot.j f/str-ot.h
+
+f/fini: f/fini.o f/proj-h.o
+ $(HOST_CC) $(HOST_CFLAGS) -W -Wall $(HOST_LDFLAGS) -o f/fini f/fini.o f/proj-h.o
+
+f/fini.o:
+ $(HOST_CC) -c $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \
+ `echo $(srcdir)/f/fini.c | sed 's,^\./,,'` -o $@
+
+f/proj-h.o: f/proj.o
+ $(HOST_CC) -c $(HOST_CFLAGS) $(HOST_CPPFLAGS) $(INCLUDES) \
+ `echo $(srcdir)/f/proj.c | sed 's,^\./,,'` -o $@
+
+# Other than str-*.j, the *.j files are dummy #include files
+# that normally just #include the corresponding back-end *.h
+# files, but not if MAKING_DEPENDENCIES is #defined. The str-*.j
+# files also are not actually included if MAKING_DEPENDENCIES
+# is #defined. The point of all this is to come up with a clean
+# dependencies list whether working in a clean directory, such
+# that str-*.j and such do not exist, or in a directory full
+# of already-built files. Any dependency on a str-*.j file
+# implies a dependency on str.h, so we key on that to replace
+# it with stamp-str, and dependencies on the other *.j files
+# are generally left alone (modulo special macros like RTL_H)
+# because we might not want to recompile all of g77 just
+# because a back-end file changes. MG is usually "-MG" but
+# should be defined with "make MG= deps-kinda..." if using
+# a compiler that doesn't support -MG (gcc does as of 2.6) --
+# it prevents diagnostics when an #include file is missing,
+# as will be the case with proj.h in a clean directory.
+MG=-MG
+deps-kinda:
+ $(HOST_CC) -DMAKING_DEPENDENCIES -MM $(MG) -I -If f/*.c | \
+ sed -e 's: \([.]/\)*f/assert[.]j: $$(ASSERT_H):g' \
+ -e 's: \([.]/\)*f/config[.]j: $$(CONFIG_H):g' \
+ -e 's: \([.]/\)*f/convert[.]j: $$(CONVERT_H):g' \
+ -e 's: \([.]/\)*f/flags[.]j: $$(FLAGS_H):g' \
+ -e 's: \([.]/\)*f/glimits[.]j: $$(GLIMITS_H):g' \
+ -e 's: \([.]/\)*f/hconfig[.]j: $$(HCONFIG_H):g' \
+ -e 's: \([.]/\)*f/input[.]j: $$(INPUT_H):g' \
+ -e 's: \([.]/\)*f/rtl[.]j: $$(RTL_H):g' \
+ -e 's: \([.]/\)*f/tconfig[.]j: $$(TCONFIG_H):g' \
+ -e 's: \([.]/\)*f/tm[.]j: $$(TM_H):g' \
+ -e 's: \([.]/\)*f/tree[.]j: $$(TREE_H):g' \
+ -e 's: proj[.]h: f/proj.h:g' \
+ -e 's: \([.]/\)*f/str[.]h: f/stamp-str:g' \
+ -e 's%^\(.*\)[ ]*: %f/\1: %g'
+
+
+# These exist for maintenance purposes.
+
+# Update the tags table.
+TAGS: force
+ cd $(srcdir)/f ; \
+ etags *.c *.h ; \
+ echo 'l' | tr 'l' '\f' >> TAGS ; \
+ echo 'parse.y,0' >> TAGS ; \
+ etags -a ../*.h ../*.c;
+
+.PHONY: none all all.indirect f77.rebuilt compiler native deps-kinda TAGS g77-only
+
+force:
diff --git a/gcc/f/NEWS b/gcc/f/NEWS
new file mode 100644
index 00000000000..40fea330e5d
--- /dev/null
+++ b/gcc/f/NEWS
@@ -0,0 +1,1064 @@
+This file lists recent changes to the GNU Fortran compiler. Copyright
+(C) 1995, 1996 Free Software Foundation, Inc. You may copy,
+distribute, and modify it freely as long as you preserve this copyright
+notice and permission notice.
+
+News About GNU Fortran
+**********************
+
+ Changes made to recent versions of GNU Fortran are listed below,
+with the most recent version first.
+
+ The changes are generally listed with code-generation bugs first,
+followed by compiler crashes involving valid code, new features, fixes
+to existing features, new diagnostics, internal improvements, and
+miscellany. This order is not strict--for example, some items involve
+a combination of these elements.
+
+In 0.5.21:
+==========
+
+ * Fix a code-generation bug introduced by 0.5.20 caused by loop
+ unrolling (by specifying `-funroll-loops' or similar). This bug
+ afflicted all code compiled by version 2.7.2.2.f.2 of `gcc' (C,
+ C++, Fortran, and so on).
+
+ * Fix a code-generation bug manifested when combining local
+ `EQUIVALENCE' with a `DATA' statement that follows the first
+ executable statement (or is treated as an executable-context
+ statement as a result of using the `-fpedantic' option).
+
+ * Fix a compiler crash that occured when an integer division by a
+ constant zero is detected. Instead, when the `-W' option is
+ specified, the `gcc' back end issues a warning about such a case.
+ This bug afflicted all code compiled by version 2.7.2.2.f.2 of
+ `gcc' (C, C++, Fortran, and so on).
+
+ * Fix a compiler crash that occurred in some cases of procedure
+ inlining. (Such cases became more frequent in 0.5.20.)
+
+ * Fix a compiler crash resulting from using `DATA' or similar to
+ initialize a `COMPLEX' variable or array to zero.
+
+ * Fix compiler crashes involving use of `AND', `OR', or `XOR'
+ intrinsics.
+
+ * Fix compiler bug triggered when using a `COMMON' or `EQUIVALENCE'
+ variable as the target of an `ASSIGN' or assigned-`GOTO' statement.
+
+ * Fix compiler crashes due to using the name of a some non-standard
+ intrinsics (such as `FTELL' or `FPUTC') as such and as the name of
+ a procedure or common block. Such dual use of a name in a program
+ is allowed by the standard.
+
+ * Place automatic arrays on the stack, even if `SAVE' or the
+ `-fno-automatic' option is in effect. This avoids a compiler
+ crash in some cases.
+
+ * New option `-Wno-globals' disables warnings about "suspicious" use
+ of a name both as a global name and as the implicit name of an
+ intrinsic, and warnings about disagreements over the number or
+ natures of arguments passed to global procedures, or the natures
+ of the procedures themselves.
+
+ The default is to issue such warnings, which are new as of this
+ version of `g77'.
+
+ * New option `-fno-globals' disables diagnostics about potentially
+ fatal disagreements analysis problems, such as disagreements over
+ the number or natures of arguments passed to global procedures, or
+ the natures of those procedures themselves.
+
+ The default is to issue such diagnostics and flag the compilation
+ as unsuccessful. With this option, the diagnostics are issued as
+ warnings, or, if `-Wno-globals' is specified, are not issued at
+ all.
+
+ This option also disables inlining of global procedures, to avoid
+ compiler crashes resulting from coding errors that these
+ diagnostics normally would identify.
+
+ * Diagnose cases where a reference to a procedure disagrees with the
+ type of that procedure, or where disagreements about the number or
+ nature of arguments exist. This avoids a compiler crash.
+
+ * Improve performance of the `gcc' back end so certain complicated
+ expressions involving `COMPLEX' arithmetic (especially
+ multiplication) don't appear to take forever to compile.
+
+ * Fix a couple of profiling-related bugs in `gcc' back end.
+
+ * Integrate GNU Ada's (GNAT's) changes to the back end, which
+ consist almost entirely of bug fixes.
+
+ * Include some other `gcc' fixes that seem useful in `g77''s version
+ of `gcc'. (See `gcc/ChangeLog' for details--compare it to that
+ file in the vanilla `gcc-2.7.2.2.tar.gz' distribution.)
+
+ * Fix `libU77' routines that accept file and other names to strip
+ trailing blanks from them, for consistency with other
+ implementations. Blanks may be forcibly appended to such names by
+ appending a single null character (`CHAR(0)') to the significant
+ trailing blanks.
+
+ * Fix `CHMOD' intrinsic to work with file names that have embedded
+ blanks, commas, and so on.
+
+ * Fix `SIGNAL' intrinsic so it accepts an optional third `Status'
+ argument.
+
+ * Fix `IDATE()' intrinsic subroutine (VXT form) so it accepts
+ arguments in the correct order. Documentation fixed accordingly,
+ and for `GMTIME()' and `LTIME()' as well.
+
+ * Make many changes to `libU77' intrinsics to support existing code
+ more directly.
+
+ Such changes include allowing both subroutine and function forms
+ of many routines, changing `MCLOCK()' and `TIME()' to return
+ `INTEGER(KIND=1)' values, introducing `MCLOCK8()' and `TIME8()' to
+ return `INTEGER(KIND=2)' values, and placing functions that are
+ intended to perform side effects in a new intrinsic group,
+ `badu77'.
+
+ * Improve `libU77' so it is more portable.
+
+ * Add options `-fbadu77-intrinsics-delete',
+ `-fbadu77-intrinsics-hide', and so on.
+
+ * Fix crashes involving diagnosed or invalid code.
+
+ * `g77' and `gcc' now do a somewhat better job detecting and
+ diagnosing arrays that are too large to handle before these cause
+ diagnostics during the assembler or linker phase, a compiler
+ crash, or generation of incorrect code.
+
+ * Improve alias analysis code to properly handle output registers
+ (such as the `%o' registers on the SPARC).
+
+ * Add support for `restrict' keyword in `gcc' front end.
+
+ * Modify `make' rules and related code so that generation of Info
+ documentation doesn't require compilation using `gcc'.
+
+ * Add `INT2' and `INT8' intrinsics.
+
+ * Add `CPU_TIME' intrinsic.
+
+ * Add `ALARM' intrinsic.
+
+ * `CTIME' intrinsic now accepts any `INTEGER' argument, not just
+ `INTEGER(KIND=2)'.
+
+ * Warn when explicit type declaration disagrees with the type of an
+ intrinsic invocation.
+
+ * Support `*f771' entry in `gcc' `specs' file.
+
+ * Fix typo in `make' rule `g77-cross', used only for cross-compiling.
+
+ * Fix `libf2c' build procedure to re-archive library if previous
+ attempt to archive was interrupted.
+
+ * Fix `gcc' to more easily support configuring on Pentium Pro (686)
+ systems.
+
+ * Change `gcc' to unroll loops only during the last invocation (of
+ as many as two invocations) of loop optimization.
+
+ * Improve handling of `-fno-f2c' so that code that attempts to pass
+ an intrinsic as an actual argument, such as `CALL FOO(ABS)', is
+ rejected due to the fact that the run-time-library routine is,
+ effectively, compiled with `-ff2c' in effect.
+
+ * Fix `g77' driver to recognize `-fsyntax-only' as an option that
+ inhibits linking, just like `-c' or `-S', and to recognize and
+ properly handle the `-nostdlib', `-M', `-MM', `-nodefaultlibs',
+ and `-Xlinker' options.
+
+ * Upgrade to `libf2c' as of 1997-08-06.
+
+ * Modify `libf2c' to consistently and clearly diagnose recursive I/O
+ (at run time).
+
+ * `g77' driver now prints version information (such as produced by
+ `g77 -v') to `stderr' instead of `stdout'.
+
+ * The `.r' suffix now designates a Ratfor source file, to be
+ preprocessed via the `ratfor' command, available separately.
+
+ * Fix some aspects of how `gcc' determines what kind of system is
+ being configured and what kinds are supported. For example, GNU
+ Linux/Alpha ELF systems now are directly supported.
+
+ * Improve diagnostics.
+
+ * Improve documentation and indexing.
+
+ * Include all pertinent files for `libf2c' that come from
+ `netlib.bell-labs.com'; give any such files that aren't quite
+ accurate in `g77''s version of `libf2c' the suffix `.netlib'.
+
+ * Reserve `INTEGER(KIND=0)' for future use.
+
+In 0.5.20:
+==========
+
+ * The `-fno-typeless-boz' option is now the default.
+
+ This option specifies that non-decimal-radix constants using the
+ prefixed-radix form (such as `Z'1234'') are to be interpreted as
+ `INTEGER' constants. Specify `-ftypeless-boz' to cause such
+ constants to be interpreted as typeless.
+
+ (Version 0.5.19 introduced `-fno-typeless-boz' and its inverse.)
+
+ * Options `-ff90-intrinsics-enable' and `-fvxt-intrinsics-enable'
+ now are the defaults.
+
+ Some programs might use names that clash with intrinsic names
+ defined (and now enabled) by these options or by the new `libU77'
+ intrinsics. Users of such programs might need to compile them
+ differently (using, for example, `-ff90-intrinsics-disable') or,
+ better yet, insert appropriate `EXTERNAL' statements specifying
+ that these names are not intended to be names of intrinsics.
+
+ * The `ALWAYS_FLUSH' macro is no longer defined when building
+ `libf2c', which should result in improved I/O performance,
+ especially over NFS.
+
+ *Note:* If you have code that depends on the behavior of `libf2c'
+ when built with `ALWAYS_FLUSH' defined, you will have to modify
+ `libf2c' accordingly before building it from this and future
+ versions of `g77'.
+
+ * Dave Love's implementation of `libU77' has been added to the
+ version of `libf2c' distributed with and built as part of `g77'.
+ `g77' now knows about the routines in this library as intrinsics.
+
+ * New option `-fvxt' specifies that the source file is written in
+ VXT Fortran, instead of GNU Fortran.
+
+ * The `-fvxt-not-f90' option has been deleted, along with its
+ inverse, `-ff90-not-vxt'.
+
+ If you used one of these deleted options, you should re-read the
+ pertinent documentation to determine which options, if any, are
+ appropriate for compiling your code with this version of `g77'.
+
+ * The `-fugly' option now issues a warning, as it likely will be
+ removed in a future version.
+
+ (Enabling all the `-fugly-*' options is unlikely to be feasible,
+ or sensible, in the future, so users should learn to specify only
+ those `-fugly-*' options they really need for a particular source
+ file.)
+
+ * The `-fugly-assumed' option, introduced in version 0.5.19, has
+ been changed to better accommodate old and new code.
+
+ * Make a number of fixes to the `g77' front end and the `gcc' back
+ end to better support Alpha (AXP) machines. This includes
+ providing at least one bug-fix to the `gcc' back end for Alphas.
+
+ * Related to supporting Alpha (AXP) machines, the `LOC()' intrinsic
+ and `%LOC()' construct now return values of integer type that is
+ the same width (holds the same number of bits) as the pointer type
+ on the machine.
+
+ On most machines, this won't make a difference, whereas on Alphas,
+ the type these constructs return is `INTEGER*8' instead of the
+ more common `INTEGER*4'.
+
+ * Emulate `COMPLEX' arithmetic in the `g77' front end, to avoid bugs
+ in `complex' support in the `gcc' back end. New option
+ `-fno-emulate-complex' causes `g77' to revert the 0.5.19 behavior.
+
+ * Fix bug whereby `REAL A(1)', for example, caused a compiler crash
+ if `-fugly-assumed' was in effect and A was a local (automatic)
+ array. That case is no longer affected by the new handling of
+ `-fugly-assumed'.
+
+ * Fix `g77' command driver so that `g77 -o foo.f' no longer deletes
+ `foo.f' before issuing other diagnostics, and so the `-x' option
+ is properly handled.
+
+ * Enable inlining of subroutines and functions by the `gcc' back end.
+ This works as it does for `gcc' itself--program units may be
+ inlined for invocations that follow them in the same program unit,
+ as long as the appropriate compile-time options are specified.
+
+ * Dummy arguments are no longer assumed to potentially alias
+ (overlap) other dummy arguments or `COMMON' areas when any of
+ these are defined (assigned to) by Fortran code.
+
+ This can result in faster and/or smaller programs when compiling
+ with optimization enabled, though on some systems this effect is
+ observed only when `-fforce-addr' also is specified.
+
+ New options `-falias-check', `-fargument-alias',
+ `-fargument-noalias', and `-fno-argument-noalias-global' control
+ the way `g77' handles potential aliasing.
+
+ * The `CONJG()' and `DCONJG()' intrinsics now are compiled in-line.
+
+ * The bug-fix for 0.5.19.1 has been re-done. The `g77' compiler has
+ been changed back to assume `libf2c' has no aliasing problems in
+ its implementations of the `COMPLEX' (and `DOUBLE COMPLEX')
+ intrinsics. The `libf2c' has been changed to have no such
+ problems.
+
+ As a result, 0.5.20 is expected to offer improved performance over
+ 0.5.19.1, perhaps as good as 0.5.19 in most or all cases, due to
+ this change alone.
+
+ *Note:* This change requires version 0.5.20 of `libf2c', at least,
+ when linking code produced by any versions of `g77' other than
+ 0.5.19.1. Use `g77 -v' to determine the version numbers of the
+ `libF77', `libI77', and `libU77' components of the `libf2c'
+ library. (If these version numbers are not printed--in
+ particular, if the linker complains about unresolved references to
+ names like `g77__fvers__'--that strongly suggests your
+ installation has an obsolete version of `libf2c'.)
+
+ * New option `-fugly-assign' specifies that the same memory
+ locations are to be used to hold the values assigned by both
+ statements `I = 3' and `ASSIGN 10 TO I', for example. (Normally,
+ `g77' uses a separate memory location to hold assigned statement
+ labels.)
+
+ * `FORMAT' and `ENTRY' statements now are allowed to precede
+ `IMPLICIT NONE' statements.
+
+ * Produce diagnostic for unsupported `SELECT CASE' on `CHARACTER'
+ type, instead of crashing, at compile time.
+
+ * Fix crashes involving diagnosed or invalid code.
+
+ * Change approach to building `libf2c' archive (`libf2c.a') so that
+ members are added to it only when truly necessary, so the user
+ that installs an already-built `g77' doesn't need to have write
+ access to the build tree (whereas the user doing the build might
+ not have access to install new software on the system).
+
+ * Support `gcc' version 2.7.2.2 (modified by `g77' into version
+ 2.7.2.2.f.2), and remove support for prior versions of `gcc'.
+
+ * Upgrade to `libf2c' as of 1997-02-08, and fix up some of the build
+ procedures.
+
+ * Improve general build procedures for `g77', fixing minor bugs
+ (such as deletion of any file named `f771' in the parent directory
+ of `gcc/').
+
+ * Enable full support of `INTEGER*8' available in `libf2c' and
+ `f2c.h' so that `f2c' users may make full use of its features via
+ the `g77' version of `f2c.h' and the `INTEGER*8' support routines
+ in the `g77' version of `libf2c'.
+
+ * Improve `g77' driver and `libf2c' so that `g77 -v' yields version
+ information on the library.
+
+ * The `SNGL' and `FLOAT' intrinsics now are specific intrinsics,
+ instead of synonyms for the generic intrinsic `REAL'.
+
+ * New intrinsics have been added. These are `REALPART', `IMAGPART',
+ `COMPLEX', `LONG', and `SHORT'.
+
+ * A new group of intrinsics, `gnu', has been added to contain the
+ new `REALPART', `IMAGPART', and `COMPLEX' intrinsics. An old
+ group, `dcp', has been removed.
+
+ * Complain about industry-wide ambiguous references `REAL(EXPR)' and
+ `AIMAG(EXPR)', where EXPR is `DOUBLE COMPLEX' (or any complex type
+ other than `COMPLEX'), unless `-ff90' option specifies Fortran 90
+ interpretation or new `-fugly-complex' option, in conjunction with
+ `-fnot-f90', specifies `f2c' interpretation.
+
+ * Make improvements to diagnostics.
+
+ * Speed up compiler a bit.
+
+ * Improvements to documentation and indexing, including a new
+ chapter containing information on one, later more, diagnostics
+ that users are directed to pull up automatically via a message in
+ the diagnostic itself.
+
+ (Hence the menu item `M' for the node `Diagnostics' in the
+ top-level menu of the Info documentation.)
+
+In 0.5.19.1:
+============
+
+ * Code-generation bugs afflicting operations on complex data have
+ been fixed.
+
+ These bugs occurred when assigning the result of an operation to a
+ complex variable (or array element) that also served as an input
+ to that operation.
+
+ The operations affected by this bug were: `CONJG()', `DCONJG()',
+ `CCOS()', `CDCOS()', `CLOG()', `CDLOG()', `CSIN()', `CDSIN()',
+ `CSQRT()', `CDSQRT()', complex division, and raising a `DOUBLE
+ COMPLEX' operand to an `INTEGER' power. (The related generic and
+ `Z'-prefixed intrinsics, such as `ZSIN()', also were affected.)
+
+ For example, `C = CSQRT(C)', `Z = Z/C', and `Z = Z**I' (where `C'
+ is `COMPLEX' and `Z' is `DOUBLE COMPLEX') have been fixed.
+
+In 0.5.19:
+==========
+
+ * Fix `FORMAT' statement parsing so negative values for specifiers
+ such as `P' (e.g. `FORMAT(-1PF8.1)') are correctly processed as
+ negative.
+
+ * Fix `SIGNAL' intrinsic so it once again accepts a procedure as its
+ second argument.
+
+ * A temporary kludge option provides bare-bones information on
+ `COMMON' and `EQUIVALENCE' members at debug time.
+
+ * New `-fonetrip' option specifies FORTRAN-66-style one-trip `DO'
+ loops.
+
+ * New `-fno-silent' option causes names of program units to be
+ printed as they are compiled, in a fashion similar to UNIX `f77'
+ and `f2c'.
+
+ * New `-fugly-assumed' option specifies that arrays dimensioned via
+ `DIMENSION X(1)', for example, are to be treated as assumed-size.
+
+ * New `-fno-typeless-boz' option specifies that non-decimal-radix
+ constants using the prefixed-radix form (such as `Z'1234'') are to
+ be interpreted as `INTEGER' constants.
+
+ * New `-ff66' option is a "shorthand" option that specifies
+ behaviors considered appropriate for FORTRAN 66 programs.
+
+ * New `-ff77' option is a "shorthand" option that specifies
+ behaviors considered appropriate for UNIX `f77' programs.
+
+ * New `-fugly-comma' and `-fugly-logint' options provided to perform
+ some of what `-fugly' used to do. `-fugly' and `-fno-ugly' are
+ now "shorthand" options, in that they do nothing more than enable
+ (or disable) other `-fugly-*' options.
+
+ * Fix parsing of assignment statements involving targets that are
+ substrings of elements of `CHARACTER' arrays having names such as
+ `READ', `WRITE', `GOTO', and `REALFUNCTIONFOO'.
+
+ * Fix crashes involving diagnosed code.
+
+ * Fix handling of local `EQUIVALENCE' areas so certain cases of
+ valid Fortran programs are not misdiagnosed as improperly
+ extending the area backwards.
+
+ * Support `gcc' version 2.7.2.1.
+
+ * Upgrade to `libf2c' as of 1996-09-26, and fix up some of the build
+ procedures.
+
+ * Change code generation for list-directed I/O so it allows for new
+ versions of `libf2c' that might return non-zero status codes for
+ some operations previously assumed to always return zero.
+
+ This change not only affects how `IOSTAT=' variables are set by
+ list-directed I/O, it also affects whether `END=' and `ERR='
+ labels are reached by these operations.
+
+ * Add intrinsic support for new `FTELL' and `FSEEK' procedures in
+ `libf2c'.
+
+ * Modify `fseek_()' in `libf2c' to be more portable (though, in
+ practice, there might be no systems where this matters) and to
+ catch invalid `whence' arguments.
+
+ * Some useless warnings from the `-Wunused' option have been
+ eliminated.
+
+ * Fix a problem building the `f771' executable on AIX systems by
+ linking with the `-bbigtoc' option.
+
+ * Abort configuration if `gcc' has not been patched using the patch
+ file provided in the `gcc/f/gbe/' subdirectory.
+
+ * Add options `--help' and `--version' to the `g77' command, to
+ conform to GNU coding guidelines. Also add printing of `g77'
+ version number when the `--verbose' (`-v') option is used.
+
+ * Change internally generated name for local `EQUIVALENCE' areas to
+ one based on the alphabetically sorted first name in the list of
+ names for entities placed at the beginning of the areas.
+
+ * Improvements to documentation and indexing.
+
+In 0.5.18:
+==========
+
+ * Add some rudimentary support for `INTEGER*1', `INTEGER*2',
+ `INTEGER*8', and their `LOGICAL' equivalents. (This support works
+ on most, maybe all, `gcc' targets.)
+
+ Thanks to Scott Snyder (<snyder@d0sgif.fnal.gov>) for providing
+ the patch for this!
+
+ Among the missing elements from the support for these features are
+ full intrinsic support and constants.
+
+ * Add some rudimentary support for the `BYTE' and `WORD'
+ type-declaration statements. `BYTE' corresponds to `INTEGER*1',
+ while `WORD' corresponds to `INTEGER*2'.
+
+ Thanks to Scott Snyder (<snyder@d0sgif.fnal.gov>) for providing
+ the patch for this!
+
+ * The compiler code handling intrinsics has been largely rewritten
+ to accommodate the new types. No new intrinsics or arguments for
+ existing intrinsics have been added, so there is, at this point,
+ no intrinsic to convert to `INTEGER*8', for example.
+
+ * Support automatic arrays in procedures.
+
+ * Reduce space/time requirements for handling large *sparsely*
+ initialized aggregate arrays. This improvement applies to only a
+ subset of the general problem to be addressed in 0.6.
+
+ * Treat initial values of zero as if they weren't specified (in DATA
+ and type-declaration statements). The initial values will be set
+ to zero anyway, but the amount of compile time processing them
+ will be reduced, in some cases significantly (though, again, this
+ is only a subset of the general problem to be addressed in 0.6).
+
+ A new option, `-fzeros', is introduced to enable the traditional
+ treatment of zeros as any other value.
+
+ * With `-ff90' in force, `g77' incorrectly interpreted `REAL(Z)' as
+ returning a `REAL' result, instead of as a `DOUBLE PRECISION'
+ result. (Here, `Z' is `DOUBLE COMPLEX'.)
+
+ With `-fno-f90' in force, the interpretation remains unchanged,
+ since this appears to be how at least some F77 code using the
+ `DOUBLE COMPLEX' extension expected it to work.
+
+ Essentially, `REAL(Z)' in F90 is the same as `DBLE(Z)', while in
+ extended F77, it appears to be the same as `REAL(REAL(Z))'.
+
+ * An expression involving exponentiation, where both operands were
+ type `INTEGER' and the right-hand operand was negative, was
+ erroneously evaluated.
+
+ * Fix bugs involving `DATA' implied-`DO' constructs (these involved
+ an errant diagnostic and a crash, both on good code, one involving
+ subsequent statement-function definition).
+
+ * Close `INCLUDE' files after processing them, so compiling source
+ files with lots of `INCLUDE' statements does not result in being
+ unable to open `INCLUDE' files after all the available file
+ descriptors are used up.
+
+ * Speed up compiling, especially of larger programs, and perhaps
+ slightly reduce memory utilization while compiling (this is *not*
+ the improvement planned for 0.6 involving large aggregate
+ areas)--these improvements result from simply turning off some
+ low-level code to do self-checking that hasn't been triggered in a
+ long time.
+
+ * Introduce three new options that implement optimizations in the
+ `gcc' back end (GBE). These options are `-fmove-all-movables',
+ `-freduce-all-givs', and `-frerun-loop-opt', which are enabled, by
+ default, for Fortran compilations. These optimizations are
+ intended to help toon Fortran programs.
+
+ * Patch the GBE to do a better job optimizing certain kinds of
+ references to array elements.
+
+ * Due to patches to the GBE, the version number of `gcc' also is
+ patched to make it easier to manage installations, especially
+ useful if it turns out a `g77' change to the GBE has a bug.
+
+ The `g77'-modified version number is the `gcc' version number with
+ the string `.f.N' appended, where `f' identifies the version as
+ enhanced for Fortran, and N is `1' for the first Fortran patch for
+ that version of `gcc', `2' for the second, and so on.
+
+ So, this introduces version 2.7.2.f.1 of `gcc'.
+
+ * Make several improvements and fixes to diagnostics, including the
+ removal of two that were inappropriate or inadequate.
+
+ * Warning about two successive arithmetic operators, produced by
+ `-Wsurprising', now produced *only* when both operators are,
+ indeed, arithmetic (not relational/boolean).
+
+ * `-Wsurprising' now warns about the remaining cases of using
+ non-integral variables for implied-`DO' loops, instead of these
+ being rejected unless `-fpedantic' or `-fugly' specified.
+
+ * Allow `SAVE' of a local variable or array, even after it has been
+ given an initial value via `DATA', for example.
+
+ * Introduce an Info version of `g77' documentation, which supercedes
+ `gcc/f/CREDITS', `gcc/f/DOC', and `gcc/f/PROJECTS'. These files
+ will be removed in a future release. The files `gcc/f/BUGS',
+ `gcc/f/INSTALL', and `gcc/f/NEWS' now are automatically built from
+ the texinfo source when distributions are made.
+
+ This effort was inspired by a first pass at translating
+ `g77-0.5.16/f/DOC' that was contributed to Craig by David Ronis
+ (<ronis@onsager.chem.mcgill.ca>).
+
+ * New `-fno-second-underscore' option to specify that, when
+ `-funderscoring' is in effect, a second underscore is not to be
+ appended to Fortran names already containing an underscore.
+
+ * Change the way iterative `DO' loops work to follow the F90
+ standard. In particular, calculation of the iteration count is
+ still done by converting the start, end, and increment parameters
+ to the type of the `DO' variable, but the result of the
+ calculation is always converted to the default `INTEGER' type.
+
+ (This should have no effect on existing code compiled by `g77',
+ but code written to assume that use of a *wider* type for the `DO'
+ variable will result in an iteration count being fully calculated
+ using that wider type (wider than default `INTEGER') must be
+ rewritten.)
+
+ * Support `gcc' version 2.7.2.
+
+ * Upgrade to `libf2c' as of 1996-03-23, and fix up some of the build
+ procedures.
+
+ Note that the email addresses related to `f2c' have changed--the
+ distribution site now is named `netlib.bell-labs.com', and the
+ maintainer's new address is <dmg@bell-labs.com>.
+
+In 0.5.17:
+==========
+
+ * *Fix serious bug* in `g77 -v' command that can cause removal of a
+ system's `/dev/null' special file if run by user `root'.
+
+ *All users* of version 0.5.16 should ensure that they have not
+ removed `/dev/null' or replaced it with an ordinary file (e.g. by
+ comparing the output of `ls -l /dev/null' with `ls -l /dev/zero'.
+ If the output isn't basically the same, contact your system
+ administrator about restoring `/dev/null' to its proper status).
+
+ This bug is particularly insidious because removing `/dev/null' as
+ a special file can go undetected for quite a while, aside from
+ various applications and programs exhibiting sudden, strange
+ behaviors.
+
+ I sincerely apologize for not realizing the implications of the
+ fact that when `g77 -v' runs the `ld' command with `-o /dev/null'
+ that `ld' tries to *remove* the executable it is supposed to build
+ (especially if it reports unresolved references, which it should
+ in this case)!
+
+ * Fix crash on `CHARACTER*(*) FOO' in a main or block data program
+ unit.
+
+ * Fix crash that can occur when diagnostics given outside of any
+ program unit (such as when input file contains `@foo').
+
+ * Fix crashes, infinite loops (hangs), and such involving diagnosed
+ code.
+
+ * Fix `ASSIGN''ed variables so they can be `SAVE''d or dummy
+ arguments, and issue clearer error message in cases where target
+ of `ASSIGN' or `ASSIGN'ed `GOTO'/`FORMAT' is too small (which
+ should never happen).
+
+ * Make `libf2c' build procedures work on more systems again by
+ eliminating unnecessary invocations of `ld -r -x' and `mv'.
+
+ * Fix omission of `-funix-intrinsics-...' options in list of
+ permitted options to compiler.
+
+ * Fix failure to always diagnose missing type declaration for
+ `IMPLICIT NONE'.
+
+ * Fix compile-time performance problem (which could sometimes crash
+ the compiler, cause a hang, or whatever, due to a bug in the back
+ end) involving exponentiation with a large `INTEGER' constant for
+ the right-hand operator (e.g. `I**32767').
+
+ * Fix build procedures so cross-compiling `g77' (the `fini' utility
+ in particular) is properly built using the host compiler.
+
+ * Add new `-Wsurprising' option to warn about constructs that are
+ interpreted by the Fortran standard (and `g77') in ways that are
+ surprising to many programmers.
+
+ * Add `ERF()' and `ERFC()' as generic intrinsics mapping to existing
+ `ERF'/`DERF' and `ERFC'/`DERFC' specific intrinsics.
+
+ *Note:* You should specify `INTRINSIC ERF,ERFC' in any code where
+ you might use these as generic intrinsics, to improve likelihood
+ of diagnostics (instead of subtle run-time bugs) when using a
+ compiler that doesn't support these as intrinsics (e.g. `f2c').
+
+ * Remove from `-fno-pedantic' the diagnostic about `DO' with
+ non-`INTEGER' index variable; issue that under `-Wsurprising'
+ instead.
+
+ * Clarify some diagnostics that say things like "ignored" when that's
+ misleading.
+
+ * Clarify diagnostic on use of `.EQ.'/`.NE.' on `LOGICAL' operands.
+
+ * Minor improvements to code generation for various operations on
+ `LOGICAL' operands.
+
+ * Minor improvement to code generation for some `DO' loops on some
+ machines.
+
+ * Support `gcc' version 2.7.1.
+
+ * Upgrade to `libf2c' as of 1995-11-15.
+
+In 0.5.16:
+==========
+
+ * Fix a code-generation bug involving complicated `EQUIVALENCE'
+ statements not involving `COMMON'.
+
+ * Fix code-generation bugs involving invoking "gratis" library
+ procedures in `libf2c' from code compiled with `-fno-f2c' by
+ making these procedures known to `g77' as intrinsics (not affected
+ by -fno-f2c). This is known to fix code invoking `ERF()',
+ `ERFC()', `DERF()', and `DERFC()'.
+
+ * Update `libf2c' to include netlib patches through 1995-08-16, and
+ `#define' `WANT_LEAD_0' to 1 to make `g77'-compiled code more
+ consistent with other Fortran implementations by outputting
+ leading zeros in formatted and list-directed output.
+
+ * Fix a code-generation bug involving adjustable dummy arrays with
+ high bounds whose primaries are changed during procedure
+ execution, and which might well improve code-generation
+ performance for such arrays compared to `f2c' plus `gcc' (but
+ apparently only when using `gcc-2.7.0' or later).
+
+ * Fix a code-generation bug involving invocation of `COMPLEX' and
+ `DOUBLE COMPLEX' `FUNCTION's and doing `COMPLEX' and `DOUBLE
+ COMPLEX' divides, when the result of the invocation or divide is
+ assigned directly to a variable that overlaps one or more of the
+ arguments to the invocation or divide.
+
+ * Fix crash by not generating new optimal code for `X**I' if `I' is
+ nonconstant and the expression is used to dimension a dummy array,
+ since the `gcc' back end does not support the necessary mechanics
+ (and the `gcc' front end rejects the equivalent construct, as it
+ turns out).
+
+ * Fix crash on expressions like `COMPLEX**INTEGER'.
+
+ * Fix crash on expressions like `(1D0,2D0)**2', i.e. raising a
+ `DOUBLE COMPLEX' constant to an `INTEGER' constant power.
+
+ * Fix crashes and such involving diagnosed code.
+
+ * Diagnose, instead of crashing on, statement function definitions
+ having duplicate dummy argument names.
+
+ * Fix bug causing rejection of good code involving statement function
+ definitions.
+
+ * Fix bug resulting in debugger not knowing size of local equivalence
+ area when any member of area has initial value (via `DATA', for
+ example).
+
+ * Fix installation bug that prevented installation of `g77' driver.
+ Provide for easy selection of whether to install copy of `g77' as
+ `f77' to replace the broken code.
+
+ * Fix `gcc' driver (affects `g77' thereby) to not gratuitously
+ invoke the `f771' program (e.g. when `-E' is specified).
+
+ * Fix diagnostic to point to correct source line when it immediately
+ follows an `INCLUDE' statement.
+
+ * Support more compiler options in `gcc'/`g77' when compiling
+ Fortran files. These options include `-p', `-pg', `-aux-info',
+ `-P', correct setting of version-number macros for preprocessing,
+ full recognition of `-O0', and automatic insertion of
+ configuration-specific linker specs.
+
+ * Add new intrinsics that interface to existing routines in `libf2c':
+ `ABORT', `DERF', `DERFC', `ERF', `ERFC', `EXIT', `FLUSH',
+ `GETARG', `GETENV', `IARGC', `SIGNAL', and `SYSTEM'. Note that
+ `ABORT', `EXIT', `FLUSH', `SIGNAL', and `SYSTEM' are intrinsic
+ subroutines, not functions (since they have side effects), so to
+ get the return values from `SIGNAL' and `SYSTEM', append a final
+ argument specifying an `INTEGER' variable or array element (e.g.
+ `CALL SYSTEM('rm foo',ISTAT)').
+
+ * Add new intrinsic group named `unix' to contain the new intrinsics,
+ and by default enable this new group.
+
+ * Move `LOC()' intrinsic out of the `vxt' group to the new `unix'
+ group.
+
+ * Improve `g77' so that `g77 -v' by itself (or with certain other
+ options, including `-B', `-b', `-i', `-nostdlib', and `-V')
+ reports lots more useful version info, and so that long-form
+ options `gcc' accepts are understood by `g77' as well (even in
+ truncated, unambiguous forms).
+
+ * Add new `g77' option `--driver=name' to specify driver when
+ default, `gcc', isn't appropriate.
+
+ * Add support for `#' directives (as output by the preprocessor) in
+ the compiler, and enable generation of those directives by the
+ preprocessor (when compiling `.F' files) so diagnostics and
+ debugging info are more useful to users of the preprocessor.
+
+ * Produce better diagnostics, more like `gcc', with info such as `In
+ function `foo':' and `In file included from...:'.
+
+ * Support `gcc''s `-fident' and `-fno-ident' options.
+
+ * When `-Wunused' in effect, don't warn about local variables used as
+ statement-function dummy arguments or `DATA' implied-`DO' iteration
+ variables, even though, strictly speaking, these are not uses of
+ the variables themselves.
+
+ * When `-W -Wunused' in effect, don't warn about unused dummy
+ arguments at all, since there's no way to turn this off for
+ individual cases (`g77' might someday start warning about
+ these)--applies to `gcc' versions 2.7.0 and later, since earlier
+ versions didn't warn about unused dummy arguments.
+
+ * New option `-fno-underscoring' that inhibits transformation of
+ names (by appending one or two underscores) so users may experiment
+ with implications of such an environment.
+
+ * Minor improvement to `gcc/f/info' module to make it easier to build
+ `g77' using the native (non-`gcc') compiler on certain machines
+ (but definitely not all machines nor all non-`gcc' compilers).
+ Please do not report bugs showing problems compilers have with
+ macros defined in `gcc/f/target.h' and used in places like
+ `gcc/f/expr.c'.
+
+ * Add warning to be printed for each invocation of the compiler if
+ the target machine `INTEGER', `REAL', or `LOGICAL' size is not 32
+ bits, since `g77' is known to not work well for such cases (to be
+ fixed in Version 0.6--*note Actual Bugs We Haven't Fixed Yet:
+ Actual Bugs.).
+
+ * Lots of new documentation (though work is still needed to put it
+ into canonical GNU format).
+
+ * Build `libf2c' with `-g0', not `-g2', in effect (by default), to
+ produce smaller library without lots of debugging clutter.
+
+In 0.5.15:
+==========
+
+ * Fix bad code generation involving `X**I' and temporary, internal
+ variables generated by `g77' and the back end (such as for `DO'
+ loops).
+
+ * Fix crash given `CHARACTER A;DATA A/.TRUE./'.
+
+ * Replace crash with diagnostic given `CHARACTER A;DATA A/1.0/'.
+
+ * Fix crash or other erratic behavior when null character constant
+ (`''') is encountered.
+
+ * Fix crash or other erratic behavior involving diagnosed code.
+
+ * Fix code generation for external functions returning type `REAL'
+ when the `-ff2c' option is in force (which it is by default) so
+ that `f2c' compatibility is indeed provided.
+
+ * Disallow `COMMON I(10)' if `I' has previously been specified with
+ an array declarator.
+
+ * New `-ffixed-line-length-N' option, where N is the maximum length
+ of a typical fixed-form line, defaulting to 72 columns, such that
+ characters beyond column N are ignored, or N is `none', meaning no
+ characters are ignored. does not affect lines with `&' in column
+ 1, which are always processed as if `-ffixed-line-length-none' was
+ in effect.
+
+ * No longer generate better code for some kinds of array references,
+ as `gcc' back end is to be fixed to do this even better, and it
+ turned out to slow down some code in some cases after all.
+
+ * In `COMMON' and `EQUIVALENCE' areas with any members given initial
+ values (e.g. via `DATA'), uninitialized members now always
+ initialized to binary zeros (though this is not required by the
+ standard, and might not be done in future versions of `g77').
+ Previously, in some `COMMON'/`EQUIVALENCE' areas (essentially
+ those with members of more than one type), the uninitialized
+ members were initialized to spaces, to cater to `CHARACTER' types,
+ but it seems no existing code expects that, while much existing
+ code expects binary zeros.
+
+In 0.5.14:
+==========
+
+ * Don't emit bad code when low bound of adjustable array is
+ nonconstant and thus might vary as an expression at run time.
+
+ * Emit correct code for calculation of number of trips in `DO' loops
+ for cases where the loop should not execute at all. (This bug
+ affected cases where the difference between the begin and end
+ values was less than the step count, though probably not for
+ floating-point cases.)
+
+ * Fix crash when extra parentheses surround item in `DATA'
+ implied-`DO' list.
+
+ * Fix crash over minor internal inconsistencies in handling
+ diagnostics, just substitute dummy strings where necessary.
+
+ * Fix crash on some systems when compiling call to `MVBITS()'
+ intrinsic.
+
+ * Fix crash on array assignment `TYPEDDD(...)=...', where DDD is a
+ string of one or more digits.
+
+ * Fix crash on `DCMPLX()' with a single `INTEGER' argument.
+
+ * Fix various crashes involving code with diagnosed errors.
+
+ * Support `-I' option for `INCLUDE' statement, plus `gcc''s
+ `header.gcc' facility for handling systems like MS-DOS.
+
+ * Allow `INCLUDE' statement to be continued across multiple lines,
+ even allow it to coexist with other statements on the same line.
+
+ * Incorporate Bellcore fixes to `libf2c' through 1995-03-15--this
+ fixes a bug involving infinite loops reading EOF with empty
+ list-directed I/O list.
+
+ * Remove all the `g77'-specific auto-configuration scripts, code,
+ and so on, except for temporary substitutes for bsearch() and
+ strtoul(), as too many configure/build problems were reported in
+ these areas. People will have to fix their systems' problems
+ themselves, or at least somewhere other than `g77', which expects
+ a working ANSI C environment (and, for now, a GNU C compiler to
+ compile `g77' itself).
+
+ * Complain if initialized common redeclared as larger in subsequent
+ program unit.
+
+ * Warn if blank common initialized, since its size can vary and hence
+ related warnings that might be helpful won't be seen.
+
+ * New `-fbackslash' option, on by default, that causes `\' within
+ `CHARACTER' and Hollerith constants to be interpreted a la GNU C.
+ Note that this behavior is somewhat different from `f2c''s, which
+ supports only a limited subset of backslash (escape) sequences.
+
+ * Make `-fugly-args' the default.
+
+ * New `-fugly-init' option, on by default, that allows
+ typeless/Hollerith to be specified as initial values for variables
+ or named constants (`PARAMETER'), and also allows
+ character<->numeric conversion in those contexts--turn off via
+ `-fno-ugly-init'.
+
+ * New `-finit-local-zero' option to initialize local variables to
+ binary zeros. This does not affect whether they are `SAVE'd, i.e.
+ made automatic or static.
+
+ * New `-Wimplicit' option to warn about implicitly typed variables,
+ arrays, and functions. (Basically causes all program units to
+ default to `IMPLICIT NONE'.)
+
+ * `-Wall' now implies `-Wuninitialized' as with `gcc' (i.e. unless
+ `-O' not specified, since `-Wuninitialized' requires `-O'), and
+ implies `-Wunused' as well.
+
+ * `-Wunused' no longer gives spurious messages for unused `EXTERNAL'
+ names (since they are assumed to refer to block data program
+ units, to make use of libraries more reliable).
+
+ * Support `%LOC()' and `LOC()' of character arguments.
+
+ * Support null (zero-length) character constants and expressions.
+
+ * Support `f2c''s `IMAG()' generic intrinsic.
+
+ * Support `ICHAR()', `IACHAR()', and `LEN()' of character
+ expressions that are valid in assignments but not normally as
+ actual arguments.
+
+ * Support `f2c'-style `&' in column 1 to mean continuation line.
+
+ * Allow `NAMELIST', `EXTERNAL', `INTRINSIC', and `VOLATILE' in
+ `BLOCK DATA', even though these are not allowed by the standard.
+
+ * Allow `RETURN' in main program unit.
+
+ * Changes to Hollerith-constant support to obey Appendix C of the
+ standard:
+
+ - Now padded on the right with zeros, not spaces.
+
+ - Hollerith "format specifications" in the form of arrays of
+ non-character allowed.
+
+ - Warnings issued when non-space truncation occurs when
+ converting to another type.
+
+ - When specified as actual argument, now passed by reference to
+ `INTEGER' (padded on right with spaces if constant too small,
+ otherwise fully intact if constant wider the `INTEGER' type)
+ instead of by value.
+
+ *Warning:* `f2c' differs on the interpretation of `CALL FOO(1HX)',
+ which it treats exactly the same as `CALL FOO('X')', but which the
+ standard and `g77' treat as `CALL FOO(%REF('X '))' (padded with
+ as many spaces as necessary to widen to `INTEGER'), essentially.
+
+ * Changes and fixes to typeless-constant support:
+
+ - Now treated as a typeless double-length `INTEGER' value.
+
+ - Warnings issued when overflow occurs.
+
+ - Padded on the left with zeros when converting to a larger
+ type.
+
+ - Should be properly aligned and ordered on the target machine
+ for whatever type it is turned into.
+
+ - When specified as actual argument, now passed as reference to
+ a default `INTEGER' constant.
+
+ * `%DESCR()' of a non-`CHARACTER' expression now passes a pointer to
+ the expression plus a length for the expression just as if it were
+ a `CHARACTER' expression. For example, `CALL FOO(%DESCR(D))',
+ where `D' is `REAL*8', is the same as `CALL FOO(D,%VAL(8)))'.
+
+ * Name of multi-entrypoint master function changed to incorporate
+ the name of the primary entry point instead of a decimal value, so
+ the name of the master function for `SUBROUTINE X' with alternate
+ entry points is now `__g77_masterfun_x'.
+
+ * Remove redundant message about zero-step-count `DO' loops.
+
+ * Clean up diagnostic messages, shortening many of them.
+
+ * Fix typo in `g77' man page.
+
+ * Clarify implications of constant-handling bugs in `f/BUGS'.
+
+ * Generate better code for `**' operator with a right-hand operand of
+ type `INTEGER'.
+
+ * Generate better code for `SQRT()' and `DSQRT()', also when
+ `-ffast-math' specified, enable better code generation for `SIN()'
+ and `COS()'.
+
+ * Generate better code for some kinds of array references.
+
+ * Speed up lexing somewhat (this makes the compilation phase
+ noticeably faster).
+
diff --git a/gcc/f/README b/gcc/f/README
new file mode 100644
index 00000000000..fdebfdca176
--- /dev/null
+++ b/gcc/f/README
@@ -0,0 +1,7 @@
+1995-02-15
+
+This directory is the f/ subdirectory, which is designed to
+be a subdirectory in a gcc development tree, i.e. named gcc/f/.
+
+Please see gcc/README.g77 for information on the contents of this
+directory.
diff --git a/gcc/f/assert.j b/gcc/f/assert.j
new file mode 100644
index 00000000000..fe95676ea53
--- /dev/null
+++ b/gcc/f/assert.j
@@ -0,0 +1,27 @@
+/* assert.j -- Wrapper for GCC's assert.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_assert
+#define _J_f_assert
+#include "assert.h"
+#endif
+#endif
diff --git a/gcc/f/bad.c b/gcc/f/bad.c
new file mode 100644
index 00000000000..3db782f9259
--- /dev/null
+++ b/gcc/f/bad.c
@@ -0,0 +1,543 @@
+/* bad.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Handles the displaying of diagnostic messages regarding the user's source
+ files.
+
+ Modifications:
+*/
+
+/* If there's a %E or %4 in the messages, set this to at least 5,
+ for example. */
+
+#define FFEBAD_MAX_ 6
+
+/* Include files. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "bad.h"
+#include "com.h"
+#include "where.h"
+
+/* Externals defined here. */
+
+bool ffebad_is_inhibited_ = FALSE;
+
+/* Simple definitions and enumerations. */
+
+#define FFEBAD_LONG_MSGS_ 1 /* 0 to use short (or same) messages. */
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffebad_message_
+ {
+ ffebadSeverity severity;
+ char *message;
+ };
+
+/* Static objects accessed by functions in this module. */
+
+static struct _ffebad_message_ ffebad_messages_[]
+=
+{
+#define FFEBAD_MSGS1(KWD,SEV,MSG) { SEV, MSG },
+#if FFEBAD_LONG_MSGS_ == 0
+#define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) { SEV, SMSG },
+#else
+#define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) { SEV, LMSG },
+#endif
+#include "bad.def"
+#undef FFEBAD_MSGS1
+#undef FFEBAD_MSGS2
+};
+
+static struct
+ {
+ ffewhereLine line;
+ ffewhereColumn col;
+ ffebadIndex tag;
+ }
+
+ffebad_here_[FFEBAD_MAX_];
+static char *ffebad_string_[FFEBAD_MAX_];
+static ffebadIndex ffebad_order_[FFEBAD_MAX_];
+static ffebad ffebad_errnum_;
+static ffebadSeverity ffebad_severity_;
+static char *ffebad_message_;
+static unsigned char ffebad_index_;
+static ffebadIndex ffebad_places_;
+static bool ffebad_is_temp_inhibited_; /* Effective setting of
+ _is_inhibited_ for this
+ _start/_finish invocation. */
+
+/* Static functions (internal). */
+
+static int ffebad_bufputs_ (char buf[], int bufi, char *s);
+
+/* Internal macros. */
+
+#define ffebad_bufflush_(buf, bufi) \
+ (((buf)[bufi] = '\0'), fputs ((buf), stderr), 0)
+#define ffebad_bufputc_(buf, bufi, c) \
+ (((bufi) == ARRAY_SIZE (buf)) \
+ ? (ffebad_bufflush_ ((buf), (bufi)), ((buf)[0] = (c)), 1) \
+ : (((buf)[bufi] = (c)), (bufi) + 1))
+
+
+static int
+ffebad_bufputs_ (char buf[], int bufi, char *s)
+{
+ for (; *s != '\0'; ++s)
+ bufi = ffebad_bufputc_ (buf, bufi, *s);
+ return bufi;
+}
+
+/* ffebad_init_0 -- Initialize
+
+ ffebad_init_0(); */
+
+void
+ffebad_init_0 ()
+{
+ assert (FFEBAD == ARRAY_SIZE (ffebad_messages_));
+}
+
+ffebadSeverity
+ffebad_severity (ffebad errnum)
+{
+ return ffebad_messages_[errnum].severity;
+}
+
+/* ffebad_start_ -- Start displaying an error message
+
+ ffebad_start(FFEBAD_SOME_ERROR_CODE);
+
+ Call ffebad_start to establish the message, ffebad_here and ffebad_string
+ to send run-time data to it as necessary, then ffebad_finish when through
+ to actually get it to print (to stderr).
+
+ Note: ffebad_start(errnum) turns into ffebad_start_(FALSE,errnum). No
+ outside caller should call ffebad_start_ directly (as indicated by the
+ trailing underscore).
+
+ Call ffebad_start to start a normal message, one that might be inhibited
+ by the current state of statement guessing. Call ffebad_start_lex
+ instead to start a message that is global to all statement guesses and
+ happens only once for all guesses (i.e. the lexer).
+
+ sev and message are overrides for the severity and messages when errnum
+ is FFEBAD, meaning the caller didn't want to have to put a message in
+ bad.def to produce a diagnostic. */
+
+bool
+ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
+ char *message)
+{
+ unsigned char i;
+
+ if (ffebad_is_inhibited_ && !lex_override)
+ {
+ ffebad_is_temp_inhibited_ = TRUE;
+ return FALSE;
+ }
+
+ if (errnum != FFEBAD)
+ {
+ ffebad_severity_ = ffebad_messages_[errnum].severity;
+ ffebad_message_ = ffebad_messages_[errnum].message;
+ }
+ else
+ {
+ ffebad_severity_ = sev;
+ ffebad_message_ = message;
+ }
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ extern int inhibit_warnings; /* From toplev.c. */
+
+ switch (ffebad_severity_)
+ { /* Tell toplev.c about this message. */
+ case FFEBAD_severityINFORMATIONAL:
+ case FFEBAD_severityTRIVIAL:
+ if (inhibit_warnings)
+ { /* User wants no warnings. */
+ ffebad_is_temp_inhibited_ = TRUE;
+ return FALSE;
+ }
+ /* Fall through. */
+ case FFEBAD_severityWARNING:
+ case FFEBAD_severityPECULIAR:
+ case FFEBAD_severityPEDANTIC:
+ if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
+ || !flag_pedantic_errors)
+ {
+ if (count_error (1) == 0)
+ { /* User wants no warnings. */
+ ffebad_is_temp_inhibited_ = TRUE;
+ return FALSE;
+ }
+ break;
+ }
+ /* Fall through (PEDANTIC && flag_pedantic_errors). */
+ case FFEBAD_severityFATAL:
+ case FFEBAD_severityWEIRD:
+ case FFEBAD_severitySEVERE:
+ case FFEBAD_severityDISASTER:
+ count_error (0);
+ break;
+
+ default:
+ break;
+ }
+ }
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+ ffebad_is_temp_inhibited_ = FALSE;
+ ffebad_errnum_ = errnum;
+ ffebad_index_ = 0;
+ ffebad_places_ = 0;
+ for (i = 0; i < FFEBAD_MAX_; ++i)
+ {
+ ffebad_string_[i] = NULL;
+ ffebad_here_[i].line = ffewhere_line_unknown ();
+ ffebad_here_[i].col = ffewhere_column_unknown ();
+ }
+
+ return TRUE;
+}
+
+/* ffebad_here -- Establish source location of some diagnostic concern
+
+ ffebad_here(ffebadIndex i,ffewhereLine line,ffewhereColumn col);
+
+ Call ffebad_start to establish the message, ffebad_here and ffebad_string
+ to send run-time data to it as necessary, then ffebad_finish when through
+ to actually get it to print (to stderr). */
+
+void
+ffebad_here (ffebadIndex index, ffewhereLine line, ffewhereColumn col)
+{
+ ffewhereLineNumber line_num;
+ ffewhereLineNumber ln;
+ ffewhereColumnNumber col_num;
+ ffewhereColumnNumber cn;
+ ffebadIndex i;
+ ffebadIndex j;
+
+ if (ffebad_is_temp_inhibited_)
+ return;
+
+ assert (index < FFEBAD_MAX_);
+ ffebad_here_[index].line = ffewhere_line_use (line);
+ ffebad_here_[index].col = ffewhere_column_use (col);
+ if (ffewhere_line_is_unknown (line)
+ || ffewhere_column_is_unknown (col))
+ {
+ ffebad_here_[index].tag = FFEBAD_MAX_;
+ return;
+ }
+ ffebad_here_[index].tag = 0; /* For now, though it shouldn't matter. */
+
+ /* Sort the source line/col points into the order they occur in the source
+ file. Deal with duplicates appropriately. */
+
+ line_num = ffewhere_line_number (line);
+ col_num = ffewhere_column_number (col);
+
+ /* Determine where in the ffebad_order_ array this new place should go. */
+
+ for (i = 0; i < ffebad_places_; ++i)
+ {
+ ln = ffewhere_line_number (ffebad_here_[ffebad_order_[i]].line);
+ cn = ffewhere_column_number (ffebad_here_[ffebad_order_[i]].col);
+ if (line_num < ln)
+ break;
+ if (line_num == ln)
+ {
+ if (col_num == cn)
+ {
+ ffebad_here_[index].tag = i;
+ return; /* Shouldn't go in, has equivalent. */
+ }
+ else if (col_num < cn)
+ break;
+ }
+ }
+
+ /* Before putting new place in ffebad_order_[i], first increment all tags
+ that are i or greater. */
+
+ if (i != ffebad_places_)
+ {
+ for (j = 0; j < FFEBAD_MAX_; ++j)
+ {
+ if (ffebad_here_[j].tag >= i)
+ ++ffebad_here_[j].tag;
+ }
+ }
+
+ /* Then slide all ffebad_order_[] entries at and above i up one entry. */
+
+ for (j = ffebad_places_; j > i; --j)
+ ffebad_order_[j] = ffebad_order_[j - 1];
+
+ /* Finally can put new info in ffebad_order_[i]. */
+
+ ffebad_order_[i] = index;
+ ffebad_here_[index].tag = i;
+ ++ffebad_places_;
+}
+
+/* Establish string for next index (always in order) of message
+
+ ffebad_string(char *string);
+
+ Call ffebad_start to establish the message, ffebad_here and ffebad_string
+ to send run-time data to it as necessary, then ffebad_finish when through
+ to actually get it to print (to stderr). Note: don't trash the string
+ until after calling ffebad_finish, since we just maintain a pointer to
+ the argument passed in until then. */
+
+void
+ffebad_string (char *string)
+{
+ if (ffebad_is_temp_inhibited_)
+ return;
+
+ assert (ffebad_index_ != FFEBAD_MAX_);
+ ffebad_string_[ffebad_index_++] = string;
+}
+
+/* ffebad_finish -- Display error message with where & run-time info
+
+ ffebad_finish();
+
+ Call ffebad_start to establish the message, ffebad_here and ffebad_string
+ to send run-time data to it as necessary, then ffebad_finish when through
+ to actually get it to print (to stderr). */
+
+void
+ffebad_finish ()
+{
+#define MAX_SPACES 132
+ static char *spaces
+ = "...>\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040"; /* MAX_SPACES - 1 spaces. */
+ ffewhereLineNumber last_line_num;
+ ffewhereLineNumber ln;
+ ffewhereLineNumber rn;
+ ffewhereColumnNumber last_col_num;
+ ffewhereColumnNumber cn;
+ ffewhereColumnNumber cnt;
+ ffewhereLine l;
+ ffebadIndex bi;
+ unsigned short i;
+ char pointer;
+ char c;
+ char *s;
+ char *fn;
+ static char buf[1024];
+ int bufi;
+ int index;
+
+ if (ffebad_is_temp_inhibited_)
+ return;
+
+ switch (ffebad_severity_)
+ {
+ case FFEBAD_severityINFORMATIONAL:
+ s = "note:";
+ break;
+
+ case FFEBAD_severityWARNING:
+ s = "warning:";
+ break;
+
+ case FFEBAD_severitySEVERE:
+ s = "fatal:";
+ break;
+
+ default:
+ s = "";
+ break;
+ }
+
+ /* Display the annoying source references. */
+
+ last_line_num = 0;
+ last_col_num = 0;
+
+ for (bi = 0; bi < ffebad_places_; ++bi)
+ {
+ if (ffebad_places_ == 1)
+ pointer = '^';
+ else
+ pointer = '1' + bi;
+
+ l = ffebad_here_[ffebad_order_[bi]].line;
+ ln = ffewhere_line_number (l);
+ rn = ffewhere_line_filelinenum (l);
+ cn = ffewhere_column_number (ffebad_here_[ffebad_order_[bi]].col);
+ fn = ffewhere_line_filename (l);
+ if (ln != last_line_num)
+ {
+ if (bi != 0)
+ fputc ('\n', stderr);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ report_error_function (fn);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+ fprintf (stderr,
+#if 0
+ "Line %" ffewhereLineNumber_f "u of %s:\n %s\n %s%c",
+ rn, fn,
+#else
+ /* the trailing space on the <file>:<line>: line
+ fools emacs19 compilation mode into finding the
+ report */
+ "%s:%" ffewhereLineNumber_f "u: %s\n %s\n %s%c",
+ fn, rn,
+#endif
+ s,
+ ffewhere_line_content (l),
+ &spaces[cn > MAX_SPACES ? 0 : MAX_SPACES - cn + 4],
+ pointer);
+ last_line_num = ln;
+ last_col_num = cn;
+ s = "(continued):";
+ }
+ else
+ {
+ cnt = cn - last_col_num;
+ fprintf (stderr,
+ "%s%c", &spaces[cnt > MAX_SPACES
+ ? 0 : MAX_SPACES - cnt + 4],
+ pointer);
+ last_col_num = cn;
+ }
+ }
+ if (ffebad_places_ == 0)
+ {
+ /* Didn't output "warning:" string, capitalize it for message. */
+ if ((s[0] != '\0') && isalpha (s[0]) && islower (s[0]))
+ {
+ char c;
+
+ c = toupper (s[0]);
+ fprintf (stderr, "%c%s ", c, &s[1]);
+ }
+ else if (s[0] != '\0')
+ fprintf (stderr, "%s ", s);
+ }
+ else
+ fputc ('\n', stderr);
+
+ /* Release the ffewhere info. */
+
+ for (bi = 0; bi < FFEBAD_MAX_; ++bi)
+ {
+ ffewhere_line_kill (ffebad_here_[bi].line);
+ ffewhere_column_kill (ffebad_here_[bi].col);
+ }
+
+ /* Now display the message. */
+
+ bufi = 0;
+ for (i = 0; (c = ffebad_message_[i]) != '\0'; ++i)
+ {
+ if (c == '%')
+ {
+ c = ffebad_message_[++i];
+ if (isalpha (c) && isupper (c))
+ {
+ index = c - 'A';
+
+ if ((index < 0) || (index >= FFEBAD_MAX_))
+ {
+ bufi = ffebad_bufputs_ (buf, bufi, "[REPORT BUG!!] %");
+ bufi = ffebad_bufputc_ (buf, bufi, c);
+ }
+ else
+ {
+ s = ffebad_string_[index];
+ if (s == NULL)
+ bufi = ffebad_bufputs_ (buf, bufi, "[REPORT BUG!!]");
+ else
+ bufi = ffebad_bufputs_ (buf, bufi, s);
+ }
+ }
+ else if (isdigit (c))
+ {
+ index = c - '0';
+
+ if ((index < 0) || (index >= FFEBAD_MAX_))
+ {
+ bufi = ffebad_bufputs_ (buf, bufi, "[REPORT BUG!!] %");
+ bufi = ffebad_bufputc_ (buf, bufi, c);
+ }
+ else
+ {
+ pointer = ffebad_here_[index].tag + '1';
+ if (pointer == FFEBAD_MAX_ + '1')
+ pointer = '?';
+ else if (ffebad_places_ == 1)
+ pointer = '^';
+ bufi = ffebad_bufputc_ (buf, bufi, '(');
+ bufi = ffebad_bufputc_ (buf, bufi, pointer);
+ bufi = ffebad_bufputc_ (buf, bufi, ')');
+ }
+ }
+ else if (c == '\0')
+ break;
+ else if (c == '%')
+ bufi = ffebad_bufputc_ (buf, bufi, '%');
+ else
+ {
+ bufi = ffebad_bufputs_ (buf, bufi, "[REPORT BUG!!]");
+ bufi = ffebad_bufputc_ (buf, bufi, '%');
+ bufi = ffebad_bufputc_ (buf, bufi, c);
+ }
+ }
+ else
+ bufi = ffebad_bufputc_ (buf, bufi, c);
+ }
+ bufi = ffebad_bufputc_ (buf, bufi, '\n');
+ bufi = ffebad_bufflush_ (buf, bufi);
+}
diff --git a/gcc/f/bad.def b/gcc/f/bad.def
new file mode 100644
index 00000000000..507bfed55b0
--- /dev/null
+++ b/gcc/f/bad.def
@@ -0,0 +1,705 @@
+/* bad.def -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ bad.c
+
+ Modifications:
+*/
+
+#define INFORM FFEBAD_severityINFORMATIONAL
+#define TRIVIAL FFEBAD_severityTRIVIAL
+#define WARN FFEBAD_severityWARNING
+#define PECULIAR FFEBAD_severityPECULIAR
+#define FATAL FFEBAD_severityFATAL
+#define WEIRD FFEBAD_severityWEIRD
+#define SEVERE FFEBAD_severitySEVERE
+#define DISASTER FFEBAD_severityDISASTER
+
+FFEBAD_MSGS1 (FFEBAD_MISSING_FIRST_BINARY_OPERAND, FATAL,
+"Missing first operand for binary operator at %0")
+FFEBAD_MSGS1 (FFEBAD_NULL_CHAR_CONST, WARN,
+"Zero-length character constant at %0")
+FFEBAD_MSGS1 (FFEBAD_INVALID_TOKEN_IN_EXPRESSION, FATAL,
+"Invalid token at %0 in expression or subexpression at %1")
+FFEBAD_MSGS1 (FFEBAD_MISSING_OPERAND_FOR_OPERATOR, FATAL,
+"Missing operand for operator at %1 at end of expression at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_ALREADY_DEFINED, FATAL,
+"Label %A already defined at %1 when redefined at %0")
+FFEBAD_MSGS1 (FFEBAD_UNRECOGNIZED_CHARACTER, FATAL,
+"Unrecognized character at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LABEL_WITHOUT_STMT, WARN,
+"Label definition %A at %0 on empty statement (as of %1)")
+FFEBAD_MSGS2 (FFEBAD_EXTRA_LABEL_DEF, FATAL,
+"Extra label definition %A at %0 -- perhaps previous label definition %B at %1 should have CONTINUE statement?",
+"Extra label definition %A at %0 following label definition %B at %1")
+FFEBAD_MSGS1 (FFEBAD_FIRST_CHAR_INVALID, FATAL,
+"Invalid first character at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LINE_TOO_LONG, FATAL,
+"Line too long as of %0 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LABEL_FIELD_NOT_NUMERIC, FATAL,
+"Non-numeric character at %0 in label field [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LABEL_NUMBER_INVALID, FATAL,
+"Label number at %0 not in range 1-99999")
+FFEBAD_MSGS1 (FFEBAD_NON_ANSI_COMMENT, WARN,
+"At %0, '!' and '/*' are not valid comment delimiters")
+FFEBAD_MSGS1 (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, WARN,
+"Continuation indicator at %0 must appear in column 6 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_LABEL_ON_CONTINUATION, FATAL,
+"Label at %0 invalid with continuation line indicator at %1 [info -f g77 M LEX]")
+FFEBAD_MSGS2 (FFEBAD_INVALID_CONTINUATION, FATAL,
+"Continuation indicator at %0 invalid on first non-comment line of file or following END or INCLUDE [info -f g77 M LEX]",
+"Continuation indicator at %0 invalid here [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_NO_CLOSING_APOSTROPHE, FATAL,
+"Character constant at %0 has no closing apostrophe at %1")
+FFEBAD_MSGS1 (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS, FATAL,
+"Hollerith constant at %0 specified %A more characters than are present as of %1")
+FFEBAD_MSGS1 (FFEBAD_MISSING_CLOSE_PAREN, FATAL,
+"Missing close parenthese at %0 needed to match open parenthese at %1")
+FFEBAD_MSGS1 (FFEBAD_INTEGER_TOO_LARGE, FATAL,
+"Integer at %0 too large")
+FFEBAD_MSGS2 (FFEBAD_BAD_MAGICAL, WARN,
+"Integer at %0 too large except as negative number (preceded by unary minus sign)",
+"Non-negative integer at %0 too large")
+FFEBAD_MSGS2 (FFEBAD_BAD_MAGICAL_PRECEDENCE, WARN,
+"Integer at %0 too large; even though preceded by unary minus sign at %1, subsequent operator at %2 has precedence over unary minus -- enclose unary minus sign and integer in parentheses to force precedence",
+"Integer at %0 too large (%2 has precedence over %1)")
+FFEBAD_MSGS2 (FFEBAD_BAD_MAGICAL_BINARY, WARN,
+"Integer at %0 too large; even though preceded by minus sign at %1, because minus sign is a binary, not unary, operator -- insert plus sign before minus sign to change it to a unary minus sign",
+"Integer at %0 too large (needs unary, not binary, minus at %1)")
+FFEBAD_MSGS2 (FFEBAD_BAD_MAGICAL_PRECEDENCE_BINARY, WARN,
+"Integer at %0 too large; even though preceded by minus sign at %1, subsequent operator at %2 has precedence over minus, and that minus sign should be a unary minus rather than a binary minus -- insert plus sign before minus sign to change it to a unary minus sign, and enclose unary minus sign and integer in parentheses to force precedence",
+"Integer at %0 too large (%2 has precedence over %1, which needs to be unary, not binary, minus)")
+FFEBAD_MSGS1 (FFEBAD_IGNORING_PERIOD, FATAL,
+"Period at %0 not followed by digits for floating-point number or by `NOT.', `TRUE.', or `FALSE.'")
+FFEBAD_MSGS1 (FFEBAD_INSERTING_PERIOD, FATAL,
+"Missing close-period between `.%A' at %0 and %1")
+FFEBAD_MSGS1 (FFEBAD_INVALID_EXPONENT, FATAL,
+"Invalid exponent at %0 for real constant at %1; nondigit `%A' in exponent field")
+FFEBAD_MSGS1 (FFEBAD_MISSING_EXPONENT_VALUE, FATAL,
+"Missing value at %1 for real-number exponent at %0")
+FFEBAD_MSGS1 (FFEBAD_MISSING_BINARY_OPERATOR, FATAL,
+"Expected binary operator between expressions at %0 and at %1")
+FFEBAD_MSGS2 (FFEBAD_INVALID_DOTDOT, FATAL,
+"Period at %0 not followed by valid keyword forming a valid binary operator; `.%A.' is not a valid binary operator",
+"`.%A.' at %0 not a binary operator")
+FFEBAD_MSGS2 (FFEBAD_QUOTE_MISSES_DIGITS, FATAL,
+"Double-quote at %0 not followed by a string of valid octal digits at %1",
+"Invalid octal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_BINARY_DIGIT, FATAL,
+"Invalid binary digit(s) found in string of digits at %0",
+"Invalid binary constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_HEX_DIGIT, FATAL,
+"Invalid hexadecimal digit(s) found in string of digits at %0",
+"Invalid hexadecimal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_OCTAL_DIGIT, FATAL,
+"Invalid octal digit(s) found in string of digits at %0",
+"Invalid octal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_RADIX_SPECIFIER, FATAL,
+"Invalid radix specifier `%A' at %0 for typeless constant at %1",
+"Invalid typeless constant at %1")
+FFEBAD_MSGS2 (FFEBAD_INVALID_TYPELESS_BINARY_DIGIT, FATAL,
+"Invalid binary digit(s) found in string of digits at %0",
+"Invalid binary constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_TYPELESS_OCTAL_DIGIT, FATAL,
+"Invalid octal digit(s) found in string of digits at %0",
+"Invalid octal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_TYPELESS_HEX_DIGIT, FATAL,
+"Invalid hexadecimal digit(s) found in string of digits at %0",
+"Invalid hexadecimal constant at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_COMPLEX_PART, FATAL,
+"%A part of complex constant at %0 must be a real or integer constant -- otherwise use CMPLX() or COMPLEX() in place of ()",
+"%A part of complex constant at %0 not a real or integer constant")
+FFEBAD_MSGS2 (FFEBAD_INVALID_PERCENT, FATAL,
+"Invalid keyword `%%%A' at %0 in this context",
+"Invalid keyword `%%%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_NULL_EXPRESSION, FATAL,
+"Null expression between %0 and %1 invalid in this context",
+"Invalid null expression between %0 and %1")
+FFEBAD_MSGS2 (FFEBAD_CONCAT_ARGS_TYPE, FATAL,
+"Concatenation operator at %0 must operate on two subexpressions of character type, but neither subexpression at %1 or %2 is of character type",
+"Invalid operands at %1 and %2 for concatenation operator at %0")
+FFEBAD_MSGS2 (FFEBAD_CONCAT_ARG_TYPE, FATAL,
+"Concatenation operator at %0 must operate on two subexpressions of character type, but the subexpression at %1 is not of character type",
+"Invalid operand at %1 for concatenation operator at %0")
+FFEBAD_MSGS2 (FFEBAD_CONCAT_ARG_KIND, FATAL,
+"Concatenation operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning character scalars, or a combination of both -- but the subexpression at %1 is %A",
+"Invalid operand (is %A) at %1 for concatenation operator at %0")
+FFEBAD_MSGS2 (FFEBAD_MATH_ARGS_TYPE, FATAL,
+"Arithmetic operator at %0 must operate on two subexpressions of arithmetic type, but neither subexpression at %1 or %2 is of arithmetic type",
+"Invalid operands at %1 and %2 for arithmetic operator at %0")
+FFEBAD_MSGS2 (FFEBAD_MATH_ARG_TYPE, FATAL,
+"Arithmetic operator at %0 must operate on two subexpressions of arithmetic type, but the subexpression at %1 is not of arithmetic type",
+"Invalid operand at %1 for arithmetic operator at %0")
+FFEBAD_MSGS2 (FFEBAD_MATH_ARG_KIND, FATAL,
+"Arithmetic operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning arithmetic scalars, or a combination of both -- but the subexpression at %1 is %A",
+"Invalid operand (is %A) at %1 for arithmetic operator at %0")
+FFEBAD_MSGS2 (FFEBAD_NO_CLOSING_QUOTE, FATAL,
+"Character constant at %0 has no closing quote at %1 [info -f g77 M LEX]",
+"Unterminated character constant at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS2 (FFEBAD_BAD_CHAR_CONTINUE, FATAL,
+"Continuation line at %0 must have initial `&' since it continues a character context [info -f g77 M LEX]",
+"Missing initial `&' on continuation line at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS2 (FFEBAD_BAD_LEXTOK_CONTINUE, FATAL,
+"Continuation line at %0 must have initial `&' since it continues a split lexical token [info -f g77 M LEX]",
+"Missing initial `&' on continuation line at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS2 (FFEBAD_BAD_FREE_CONTINUE, FATAL,
+"Continuation line at %0 invalid because it consists only of a single `&' as the only nonblank character",
+"Invalid continuation line at %0")
+FFEBAD_MSGS2 (FFEBAD_STMT_BEGINS_BAD, FATAL,
+"Statement at %0 begins with invalid token [info -f g77 M LEX]",
+"Invalid statement at %0 [info -f g77 M LEX]")
+FFEBAD_MSGS1 (FFEBAD_SEMICOLON, FATAL,
+"Semicolon at %0 is an invalid token")
+FFEBAD_MSGS2 (FFEBAD_UNREC_STMT, FATAL,
+"Unrecognized statement name at %0 and invalid form for assignment or statement-function definition at %1",
+"Invalid statement at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_STMT_FORM, FATAL,
+"Invalid form for %A statement at %0",
+"Invalid %A statement at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_HOLL_IN_STMT, FATAL,
+"Invalid use of hollerith constant in statement at %0 -- enclose the constant in parentheses (for example, change BACKSPACE 2HAB to BACKSPACE (2HAB))",
+"Enclose hollerith constant in statement at %0 in parentheses")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_EXTRA_COMMA, FATAL,
+"Extraneous comma in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_MISSING_COMMA, WARN,
+"Missing comma in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_SPURIOUS_SIGN, FATAL,
+"Spurious sign in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_SPURIOUS_NUMBER, FATAL,
+"Spurious number in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_TEXT_IN_NUMBER, FATAL,
+"Spurious text trailing number in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_P_NOCOMMA, FATAL,
+"nP control edit descriptor not followed by comma but followed by edit descriptor at %0 other than D, E, EN, F, or G",
+"Invalid edit descriptor at %0 following nP control edit descriptor")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_BAD_SPEC, FATAL,
+"Unrecognized FORMAT specifier at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_I_SPEC, FATAL,
+"Invalid I specifier in FORMAT statement at %0 -- correct form: [r]Iw.[m]",
+"Invalid I specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_B_SPEC, FATAL,
+"Invalid B specifier in FORMAT statement at %0 -- correct form: [r]Bw.[m]",
+"Invalid B specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_O_SPEC, FATAL,
+"Invalid O specifier in FORMAT statement at %0 -- correct form: [r]Ow.[m]",
+"Invalid O specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_Z_SPEC, FATAL,
+"Invalid Z specifier in FORMAT statement at %0 -- correct form: [r]Zw.[m]",
+"Invalid Z specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_F_SPEC, FATAL,
+"Invalid F specifier in FORMAT statement at %0 -- correct form: [r]Fw.d",
+"Invalid F specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_E_SPEC, FATAL,
+"Invalid E specifier in FORMAT statement at %0 -- correct form: [r]Ew.d[Ee]",
+"Invalid E specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_EN_SPEC, FATAL,
+"Invalid EN specifier in FORMAT statement at %0 -- correct form: [r]ENw.d[Ee]",
+"Invalid EN specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_G_SPEC, FATAL,
+"Invalid G specifier in FORMAT statement at %0 -- correct form: [r]Gw.d[Ee]",
+"Invalid G specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_L_SPEC, FATAL,
+"Invalid L specifier in FORMAT statement at %0 -- correct form: [r]Lw",
+"Invalid L specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_A_SPEC, FATAL,
+"Invalid A specifier in FORMAT statement at %0 -- correct form: [r]A[w]",
+"Invalid A specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_D_SPEC, FATAL,
+"Invalid D specifier in FORMAT statement at %0 -- correct form: [r]Dw.d",
+"Invalid D specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_Q_SPEC, FATAL,
+"Invalid Q specifier in FORMAT statement at %0 -- correct form: Q",
+"Invalid Q specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_DOLLAR_SPEC, FATAL,
+"Invalid $ specifier in FORMAT statement at %0 -- correct form: $",
+"Invalid $ specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_P_SPEC, FATAL,
+"Invalid P specifier in FORMAT statement at %0 -- correct form: kP",
+"Invalid P specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_T_SPEC, FATAL,
+"Invalid T specifier in FORMAT statement at %0 -- correct form: Tn",
+"Invalid T specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_TL_SPEC, FATAL,
+"Invalid TL specifier in FORMAT statement at %0 -- correct form: TLn",
+"Invalid TL specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_TR_SPEC, FATAL,
+"Invalid TR specifier in FORMAT statement at %0 -- correct form: TRn",
+"Invalid TR specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_X_SPEC, FATAL,
+"Invalid X specifier in FORMAT statement at %0 -- correct form: nX",
+"Invalid X specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_S_SPEC, FATAL,
+"Invalid S specifier in FORMAT statement at %0 -- correct form: S",
+"Invalid S specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_SP_SPEC, FATAL,
+"Invalid SP specifier in FORMAT statement at %0 -- correct form: SP",
+"Invalid SP specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_SS_SPEC, FATAL,
+"Invalid SS specifier in FORMAT statement at %0 -- correct form: SS",
+"Invalid SS specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_BN_SPEC, FATAL,
+"Invalid BN specifier in FORMAT statement at %0 -- correct form: BN",
+"Invalid BN specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_BZ_SPEC, FATAL,
+"Invalid BZ specifier in FORMAT statement at %0 -- correct form: BZ",
+"Invalid BZ specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_COLON_SPEC, FATAL,
+"Invalid : specifier in FORMAT statement at %0 -- correct form: :",
+"Invalid : specifier in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_BAD_H_SPEC, FATAL,
+"Invalid H specifier in FORMAT statement at %0 -- correct form: nHcharacters !where n is an unsigned decimal constant, and characters !contains exactly n characters (including spaces)",
+"Invalid H specifier in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_MISSING_PAREN, FATAL,
+"Missing close-parenthese(s) in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_MISSING_DOT, FATAL,
+"Missing number following period in FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_MISSING_EXP, FATAL,
+"Missing number following `E' in FORMAT statement at %0")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_EXPR_TOKEN, FATAL,
+"Invalid token with FORMAT run-time expression at %0 -- use the traditional operators .LT., .LE., .GT., .GE., .EQ., and .NE. in place of the newer tokens <, <=, >, >=, ==, and !=, because > ends an expression within a FORMAT statement",
+"Invalid token with FORMAT run-time expression at %0")
+FFEBAD_MSGS1 (FFEBAD_TRAILING_COMMA, WARN,
+"Spurious trailing comma preceding terminator at %0")
+FFEBAD_MSGS1 (FFEBAD_INTERFACE_ASSIGNMENT, WARN,
+"At %0, specify OPERATOR instead of ASSIGNMENT for INTERFACE statement not specifying the assignment operator (=)")
+FFEBAD_MSGS1 (FFEBAD_INTERFACE_OPERATOR, WARN,
+"At %0, specify ASSIGNMENT instead of OPERATOR for INTERFACE statement specifying the assignment operator (=)")
+FFEBAD_MSGS2 (FFEBAD_INTERFACE_NONLETTER, FATAL,
+"Defined operator at %0 contains a nonletter -- must contain only letters A-Z (or a-z)",
+"Nonletter in defined operator at %0")
+FFEBAD_MSGS2 (FFEBAD_INVALID_TYPEDECL_ATTR, FATAL,
+"Invalid type-declaration attribute at %0 -- must be one of: DIMENSION(array-spec), EXTERNAL, INTRINSIC, PARAMETER, or SAVE",
+"Invalid type-declaration attribute at %0")
+FFEBAD_MSGS1 (FFEBAD_INVALID_TYPEDECL_INIT, FATAL,
+"Cannot specify =initialization-expr at %0 unless `::' appears before list of objects")
+FFEBAD_MSGS1 (FFEBAD_LABEL_USE_DEF, FATAL,
+"Reference to label at %1 inconsistent with its definition at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_USE_USE, FATAL,
+"Reference to label at %1 inconsistent with earlier reference at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_DEF_DO, FATAL,
+"DO-statement reference to label at %1 follows its definition at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_BLOCK, WARN,
+"Reference to label at %1 is outside block containing definition at %0")
+FFEBAD_MSGS1 (FFEBAD_LABEL_DO_BLOCK_DO, FATAL,
+"DO-statement references to label at %0 and %2 separated by unterminated block starting at %1")
+FFEBAD_MSGS1 (FFEBAD_LABEL_DO_BLOCK_END, FATAL,
+"DO-statement reference to label at %0 and label definition at %2 separated by unterminated block starting at %1")
+FFEBAD_MSGS1 (FFEBAD_INVALID_LABEL_DEF, FATAL,
+"Label definition at %0 invalid on this kind of statement")
+FFEBAD_MSGS1 (FFEBAD_ORDER_1, FATAL,
+"Statement at %0 invalid in this context")
+FFEBAD_MSGS1 (FFEBAD_ORDER_2, FATAL,
+"Statement at %0 invalid in context established by statement at %1")
+FFEBAD_MSGS1 (FFEBAD_CONSTRUCT_NAMED, FATAL,
+"Statement at %0 must specify construct name specified at %1")
+FFEBAD_MSGS1 (FFEBAD_CONSTRUCT_NOT_NAMED, FATAL,
+"Construct name at %0 superfluous, no construct name specified at %1")
+FFEBAD_MSGS1 (FFEBAD_CONSTRUCT_WRONG_NAME, FATAL,
+"Construct name at %0 not the same as construct name at %1")
+FFEBAD_MSGS1 (FFEBAD_CONSTRUCT_NO_DO_NAME, FATAL,
+"Construct name at %0 does not match construct name for any containing DO constructs")
+FFEBAD_MSGS1 (FFEBAD_DO_HAD_LABEL, FATAL,
+"Label definition missing at %0 for DO construct specifying label at %1")
+FFEBAD_MSGS1 (FFEBAD_AFTER_ELSE, FATAL,
+"Statement at %0 follows ELSE block for IF construct at %1")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_NO_LABEL_DEF, FATAL,
+"No label definition for FORMAT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_SECOND_ELSE_WHERE, FATAL,
+"Second occurrence of ELSE WHERE at %0 within WHERE at %1")
+FFEBAD_MSGS1 (FFEBAD_END_WO, WARN,
+"END statement at %0 missing `%A' keyword required for internal or module procedure(s) bounded by %1")
+FFEBAD_MSGS1 (FFEBAD_INVALID_MODULE_PROCEDURE, FATAL,
+"MODULE PROCEDURE statement at %0 disallowed because INTERFACE at %1 specifies no generic name, operator, or assignment")
+FFEBAD_MSGS1 (FFEBAD_BLOCKDATA_NOT_NAMED, FATAL,
+"BLOCK DATA name at %0 superfluous, no name specified at %1")
+FFEBAD_MSGS1 (FFEBAD_PROGRAM_NOT_NAMED, FATAL,
+"Program name at %0 superfluous, no PROGRAM statement specified at %1")
+FFEBAD_MSGS1 (FFEBAD_UNIT_WRONG_NAME, FATAL,
+"Program unit name at %0 not the same as name at %1")
+FFEBAD_MSGS1 (FFEBAD_TYPE_WRONG_NAME, FATAL,
+"Type name at %0 not the same as name at %1")
+FFEBAD_MSGS1 (FFEBAD_EOF_BEFORE_BLOCK_END, FATAL,
+"End of source file before end of block started at %0")
+FFEBAD_MSGS1 (FFEBAD_UNDEF_LABEL, FATAL,
+"Undefined label, first referenced at %0")
+FFEBAD_MSGS1 (FFEBAD_CONFLICTING_SAVES, WARN,
+"SAVE statement or attribute at %1 cannot be specified along with SAVE statement or attribute at %0")
+FFEBAD_MSGS1 (FFEBAD_CONFLICTING_ACCESSES, FATAL,
+"PUBLIC or PRIVATE statement at %1 cannot be specified along with PUBLIC or PRIVATE statement at %0")
+FFEBAD_MSGS1 (FFEBAD_RETURN_IN_MAIN, WARN,
+"RETURN statement at %0 invalid within a main program unit")
+FFEBAD_MSGS1 (FFEBAD_ALTRETURN_IN_PROGRAM, FATAL,
+"Alternate return specifier at %0 invalid within a main program unit")
+FFEBAD_MSGS1 (FFEBAD_ALTRETURN_IN_FUNCTION, FATAL,
+"Alternate return specifier at %0 invalid within a function")
+FFEBAD_MSGS1 (FFEBAD_DERIVTYP_ACCESS, FATAL,
+"Access specifier or PRIVATE statement at %0 invalid for derived-type definition within other than the specification part of a module")
+FFEBAD_MSGS1 (FFEBAD_DERIVTYP_ACCESS_FIRST, FATAL,
+"Access specifier at %0 must immediately follow derived-type statement at %1 with no intervening statements")
+FFEBAD_MSGS1 (FFEBAD_DERIVTYP_NO_COMPONENTS, FATAL,
+"No components specified as of %0 for derived-type definition beginning at %1")
+FFEBAD_MSGS1 (FFEBAD_STRUCT_NO_COMPONENTS, FATAL,
+"No components specified as of %0 for structure definition beginning at %1")
+FFEBAD_MSGS1 (FFEBAD_STRUCT_MISSING_NAME, FATAL,
+"Missing structure name for outer structure definition at %0")
+FFEBAD_MSGS1 (FFEBAD_STRUCT_IGNORING_FIELD, FATAL,
+"Field names at %0 for outer structure definition -- specify them in a subsequent RECORD statement instead")
+FFEBAD_MSGS1 (FFEBAD_STRUCT_MISSING_FIELD, FATAL,
+"Missing field name(s) for structure definition at %0 within structure definition at %1")
+FFEBAD_MSGS1 (FFEBAD_MAP_NO_COMPONENTS, FATAL,
+"No components specified as of %0 for map beginning at %1")
+FFEBAD_MSGS1 (FFEBAD_UNION_NO_TWO_MAPS, FATAL,
+"Zero or one maps specified as of %0 for union beginning at %1 -- at least two are required")
+FFEBAD_MSGS1 (FFEBAD_MISSING_SPECIFIER, FATAL,
+"Missing %A specifier in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_NAMELIST_ITEMS, FATAL,
+"Items in I/O list starting at %0 invalid for namelist-directed I/O")
+FFEBAD_MSGS1 (FFEBAD_CONFLICTING_SPECS, FATAL,
+"Conflicting I/O control specifications at %0 and %1")
+FFEBAD_MSGS1 (FFEBAD_NO_UNIT_SPEC, FATAL,
+"No UNIT= specifier in I/O control list at %0")
+FFEBAD_MSGS1 (FFEBAD_MISSING_ADVANCE_SPEC, FATAL,
+"Specification at %0 requires ADVANCE=`NO' specification in same I/O control list")
+FFEBAD_MSGS1 (FFEBAD_MISSING_FORMAT_SPEC, FATAL,
+"Specification at %0 requires explicit FMT= specification in same I/O control list")
+FFEBAD_MSGS2 (FFEBAD_SPEC_VALUE, FATAL,
+"Unrecognized value for character constant at %0 -- expecting %A",
+"Unrecognized value for character constant at %0")
+FFEBAD_MSGS1 (FFEBAD_CASE_SECOND_DEFAULT, FATAL,
+"Second occurrence of CASE DEFAULT at %0 within SELECT CASE at %1")
+FFEBAD_MSGS1 (FFEBAD_CASE_DUPLICATE, FATAL,
+"Duplicate or overlapping case values/ranges at %0 and %1")
+FFEBAD_MSGS1 (FFEBAD_CASE_TYPE_DISAGREE, FATAL,
+"Type and/or kind-type parameter disagreement between CASE value or value within range at %0 and SELECT CASE at %1")
+FFEBAD_MSGS1 (FFEBAD_CASE_LOGICAL_RANGE, FATAL,
+"Range specification at %0 invalid for CASE statement within logical-type SELECT CASE statement")
+FFEBAD_MSGS2 (FFEBAD_CASE_BAD_RANGE, FATAL,
+"Range specification at %0 invalid -- at least one expression must be specified, or use CASE DEFAULT",
+"Range specification at %0 invalid")
+FFEBAD_MSGS2 (FFEBAD_CASE_RANGE_USELESS, INFORM,
+"Range specification at %0 useless; first expression greater than second expression in range, so range can never be matched by any selection expression",
+"Useless range at %0")
+FFEBAD_MSGS1 (FFEBAD_F90, FATAL,
+"Fortran 90 feature at %0 unsupported")
+FFEBAD_MSGS2 (FFEBAD_KINDTYPE, FATAL,
+"Invalid kind at %0 for type at %1 -- unsupported or not permitted",
+"Invalid kind at %0 for type at %1")
+FFEBAD_MSGS2 (FFEBAD_BAD_IMPLICIT, FATAL,
+"Cannot establish implicit type for initial letter `%A' at %0 -- already explicitly established or used to set implicit type of some name, or backwards order of letters in letter range",
+"Cannot establish implicit type for initial letter `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_SYMERR, FATAL,
+"Invalid declaration of or reference to symbol `%A' at %0 [initially seen at %1]")
+FFEBAD_MSGS2 (FFEBAD_LABEL_WRONG_PLACE, FATAL,
+"Label definition %A (at %0) invalid -- must be in columns 1-5",
+"Invalid label definition %A (at %0)")
+FFEBAD_MSGS1 (FFEBAD_NULL_ELEMENT, FATAL,
+"Null element at %0 for array reference at %1")
+FFEBAD_MSGS1 (FFEBAD_TOO_FEW_ELEMENTS, FATAL,
+"Too few elements (%A missing) as of %0 for array reference at %1")
+FFEBAD_MSGS1 (FFEBAD_TOO_MANY_ELEMENTS, FATAL,
+"Too many elements as of %0 for array reference at %1")
+FFEBAD_MSGS1 (FFEBAD_MISSING_COLON_IN_SUBSTR, FATAL,
+"Missing colon as of %0 in substring reference for %1")
+FFEBAD_MSGS1 (FFEBAD_BAD_SUBSTR, FATAL,
+"Invalid use at %0 of substring operator on %1")
+FFEBAD_MSGS1 (FFEBAD_RANGE_SUBSTR, WARN,
+"Substring begin/end point at %0 out of defined range")
+FFEBAD_MSGS1 (FFEBAD_RANGE_ARRAY, WARN,
+"Array element value at %0 out of defined range")
+FFEBAD_MSGS1 (FFEBAD_EXPR_WRONG, FATAL,
+"Expression at %0 has incorrect data type or rank for its context")
+FFEBAD_MSGS1 (FFEBAD_DIV_BY_ZERO, WARN,
+"Division by 0 (zero) at %0 (IEEE not yet supported)")
+FFEBAD_MSGS1 (FFEBAD_DO_STEP_ZERO, FATAL,
+"%A step count known to be 0 (zero) at %0")
+FFEBAD_MSGS1 (FFEBAD_DO_END_OVERFLOW, WARN,
+"%A end value plus step count known to overflow at %0")
+FFEBAD_MSGS1 (FFEBAD_DO_IMP_OVERFLOW, WARN,
+"%A begin, end, and step-count values known to result in implementation-dependent behavior due to overflow(s) in intermediate calculations at %0")
+FFEBAD_MSGS1 (FFEBAD_DO_NULL, WARN,
+"%A begin, end, and step-count values known to result in no iterations at %0")
+FFEBAD_MSGS1 (FFEBAD_BAD_TYPES, FATAL,
+"Type disagreement between expressions at %0 and %1")
+FFEBAD_MSGS2 (FFEBAD_FORMAT_EXPR_SPEC, FATAL,
+"Run-time expression at %0 in FORMAT statement that does not follow the first executable statement in the program unit -- move the statement",
+"FORMAT at %0 with run-time expression must follow first executable statement")
+FFEBAD_MSGS2 (FFEBAD_BAD_IMPDO, FATAL,
+"Unexpected token at %0 in implied-DO construct at %1 -- form of implied-DO is `(item-list,do-var=start,end[,incr])'",
+"Unexpected token at %0 in implied-DO construct at %1")
+FFEBAD_MSGS1 (FFEBAD_BAD_IMPDCL, FATAL,
+"No specification for implied-DO iterator `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_IMPDO_PAREN, WARN,
+"Gratuitous parentheses surround implied-DO construct at %0")
+FFEBAD_MSGS1 (FFEBAD_ZERO_SIZE, FATAL,
+"Zero-size specification invalid at %0")
+FFEBAD_MSGS1 (FFEBAD_ZERO_ARRAY, FATAL,
+"Zero-size array at %0")
+FFEBAD_MSGS1 (FFEBAD_BAD_COMPLEX, FATAL,
+"Target machine does not support complex entity of kind specified at %0")
+FFEBAD_MSGS1 (FFEBAD_BAD_DBLCMPLX, FATAL,
+"Target machine does not support DOUBLE COMPLEX, specified at %0")
+FFEBAD_MSGS1 (FFEBAD_BAD_POWER, WARN,
+"Attempt to raise constant zero to a power at %0")
+FFEBAD_MSGS2 (FFEBAD_BOOL_ARGS_TYPE, FATAL,
+"Boolean/logical operator at %0 must operate on two subexpressions of logical type, but neither subexpression at %1 or %2 is of logical type",
+"Invalid operands at %1 and %2 for boolean operator at %0")
+FFEBAD_MSGS2 (FFEBAD_BOOL_ARG_TYPE, FATAL,
+"Boolean/logical operator at %0 must operate on two subexpressions of logical type, but the subexpression at %1 is not of logical type",
+"Invalid operand at %1 for boolean operator at %0")
+FFEBAD_MSGS2 (FFEBAD_BOOL_ARG_KIND, FATAL,
+"Boolean/logical operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning logical scalars, or a combination of both -- but the subexpression at %1 is %A",
+"Invalid operand (is %A) at %1 for boolean operator at %0")
+FFEBAD_MSGS2 (FFEBAD_NOT_ARG_TYPE, FATAL,
+".NOT. operator at %0 must operate on subexpression of logical type, but the subexpression at %1 is not of logical type",
+"Invalid operand at %1 for .NOT. operator at %0")
+FFEBAD_MSGS2 (FFEBAD_NOT_ARG_KIND, FATAL,
+".NOT. operator at %0 must operate on scalar subexpressions -- but the subexpression at %1 is %A",
+"Invalid operand (is %A) at %1 for .NOT. operator at %0")
+FFEBAD_MSGS2 (FFEBAD_EQOP_ARGS_TYPE, FATAL,
+"Equality operator at %0 must operate on two subexpressions of arithmetic or character type, but neither subexpression at %1 or %2 is of arithmetic or character type",
+"Invalid operands at %1 and %2 for equality operator at %0")
+FFEBAD_MSGS2 (FFEBAD_EQOP_ARG_TYPE, FATAL,
+"Equality operator at %0 must operate on two subexpressions of arithmetic or character type, but the subexpression at %1 is not of arithmetic or character type",
+"Invalid operand at %1 for equality operator at %0")
+FFEBAD_MSGS2 (FFEBAD_EQOP_ARG_KIND, FATAL,
+"Equality operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning arithmetic or character scalars, or a combination of both -- but the subexpression at %1 is %A",
+"Invalid operand (is %A) at %1 for equality operator at %0")
+FFEBAD_MSGS2 (FFEBAD_RELOP_ARGS_TYPE, FATAL,
+"Relational operator at %0 must operate on two subexpressions of integer, real, or character type, but neither subexpression at %1 or %2 is of integer, real, or character type",
+"Invalid operands at %1 and %2 for relational operator at %0")
+FFEBAD_MSGS2 (FFEBAD_RELOP_ARG_TYPE, FATAL,
+"Relational operator at %0 must operate on two subexpressions of integer, real, or character type, but the subexpression at %1 is not of integer, real, or character type",
+"Invalid operand at %1 for relational operator at %0")
+FFEBAD_MSGS2 (FFEBAD_RELOP_ARG_KIND, FATAL,
+"Relational operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning integer, real, or character scalars, or a combination of both -- but the subexpression at %1 is %A",
+"Invalid operand (is %A) at %1 for relational operator at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_REF, FATAL,
+"Reference to intrinsic `%A' at %0 invalid -- one or more arguments have incorrect type",
+"Invalid reference to intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_TOOFEW, FATAL,
+"Too few arguments passed to intrinsic `%A' at %0",
+"Too few arguments for intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_TOOMANY, FATAL,
+"Too many arguments passed to intrinsic `%A' at %0",
+"Too many arguments for intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_DISABLED, FATAL,
+"Reference to disabled intrinsic `%A' at %0",
+"Disabled intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_IS_SUBR, FATAL,
+"Reference to intrinsic subroutine `%A' as if it were a function at %0",
+"Function reference to intrinsic subroutine `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_IS_FUNC, FATAL,
+"Reference to intrinsic function `%A' as if it were a subroutine at %0",
+"Subroutine reference to intrinsic function `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_UNIMPL, FATAL,
+"Reference to unimplemented intrinsic `%A' at %0 -- use EXTERNAL to reference user-written procedure with this name",
+"Unimplemented intrinsic `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_INTRINSIC_UNIMPLW, WARN,
+"Reference to unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)",
+"Unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_AMBIG, FATAL,
+"Reference to generic intrinsic `%A' at %0 could be to form %B or %C")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_CMPAMBIG, FATAL,
+"Ambiguous use of intrinsic `%A' at %0 [info -f g77 M CMPAMBIG]")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_EXPIMP, WARN,
+"Intrinsic `%A' referenced %Bly at %0, %Cly at %1 [info -f g77 M EXPIMP]")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_GLOBAL, WARN,
+"Same name `%A' used for %B at %0 and %C at %1 [info -f g77 M INTGLOB]")
+FFEBAD_MSGS1 (FFEBAD_INTRINSIC_TYPE, WARN,
+"Explicit type declaration for intrinsic `%A' disagrees with invocation at %0")
+FFEBAD_MSGS1 (FFEBAD_OPEN_INCLUDE, FATAL,
+"Unable to open INCLUDE file `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_DOITER, FATAL,
+"Attempt to modify variable `%A' at %0 while it serves as DO-loop iterator at %1",
+"Modification of DO-loop iterator `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_DOITER_IMPDO, FATAL,
+"Attempt to modify variable `%A' via item #%B in list at %0 while it serves as implied-DO iterator at %1",
+"Modification of DO-loop iterator `%A' at %0")
+FFEBAD_MSGS2 (FFEBAD_TOO_MANY_DIMS, FATAL,
+"Array has too many dimensions, as of dimension specifier at %0",
+"Too many dimensions at %0")
+FFEBAD_MSGS1 (FFEBAD_NULL_ARGUMENT, FATAL,
+"Null argument at %0 for statement function reference at %1")
+FFEBAD_MSGS1 (FFEBAD_TOO_FEW_ARGUMENTS, FATAL,
+"%A too few arguments (starting with dummy argument `%B') as of %0 for statement function reference at %1")
+FFEBAD_MSGS1 (FFEBAD_TOO_MANY_ARGUMENTS, FATAL,
+"%A too many arguments as of %0 for statement function reference at %1")
+FFEBAD_MSGS1 (FFEBAD_ARRAY_AS_SFARG, FATAL,
+"Array supplied at %1 for dummy argument `%A' in statement function reference at %0")
+FFEBAD_MSGS1 (FFEBAD_FORMAT_UNSUPPORTED, FATAL,
+"Unsupported FORMAT specifier at %0")
+FFEBAD_MSGS2 (FFEBAD_OPEN_UNSUPPORTED, WARN,
+"Unsupported OPEN control item at %0 -- ACTION=, ASSOCIATEVARIABLE=, BLOCKSIZE=, BUFFERCOUNT=, CARRIAGECONTROL=, DEFAULTFILE=, DELIM=, DISPOSE=, EXTENDSIZE=, INITIALSIZE=, KEY=, MAXREC=, NOSPANBLOCKS, ORGANIZATION=, PAD=, POSITION=, READONLY=, RECORDTYPE=, SHARED=, and USEROPEN= are not supported",
+"Unsupported OPEN control item at %0")
+FFEBAD_MSGS2 (FFEBAD_INQUIRE_UNSUPPORTED, WARN,
+"Unsupported INQUIRE control item at %0 -- ACTION=, CARRIAGECONTROL=, DEFAULTFILE=, DELIM=, KEYED=, ORGANIZATION=, PAD=, POSITION=, READ=, READWRITE=, RECORDTYPE=, and WRITE= are not supported",
+"Unsupported INQUIRE control item at %0")
+FFEBAD_MSGS2 (FFEBAD_READ_UNSUPPORTED, WARN,
+"Unsupported READ control item at %0 -- ADVANCE=, EOR=, KEYEQ=, KEYGE=, KEYGT=, KEYID=, NULLS=, and SIZE= are not supported",
+"Unsupported READ control item at %0")
+FFEBAD_MSGS2 (FFEBAD_WRITE_UNSUPPORTED, WARN,
+"Unsupported WRITE control item at %0 -- ADVANCE= and EOR= are not supported",
+"Unsupported WRITE control item at %0")
+FFEBAD_MSGS1 (FFEBAD_VXT_UNSUPPORTED, FATAL,
+"Unsupported VXT statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_REINIT, FATAL,
+"Attempt to specify second initial value for `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_TOOFEW, FATAL,
+"Too few initial values in list of initializers for `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_TOOMANY, FATAL,
+"Too many initial values in list of initializers starting at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_RANGE, FATAL,
+"Array or substring specification for `%A' out of range in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_SUBSCRIPT, FATAL,
+"Array subscript #%B out of range for initialization of `%A' in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_ZERO, FATAL,
+"Implied do-loop step count of 0 (zero) for iteration variable `%A' in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_EMPTY, FATAL,
+"Implied do-loop iteration count of 0 (zero) for iteration variable `%A' in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_EVAL, FATAL,
+"Not an integer constant expression in implied do-loop in statement at %0")
+FFEBAD_MSGS1 (FFEBAD_DATA_MULTIPLE, FATAL,
+"Attempt to specify second initial value for element of `%A' at %0")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_COMMON, FATAL,
+"Attempt to EQUIVALENCE common areas `%A' and `%B' at %0")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_ALIGN, FATAL,
+"Can't place `%A' as directed by EQUIVALENCE due to alignment restrictions")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_MISMATCH, FATAL,
+"Mismatched EQUIVALENCE requirements for placement of `%A' at both %C and %D bytes offset from `%B'")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_RANGE, FATAL,
+"Array or substring specification for `%A' out of range in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_SUBSTR, FATAL,
+"Substring of non-CHARACTER entity `%A' in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_ARRAY, FATAL,
+"Array reference to scalar variable `%A' in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_SUBSCRIPT, WARN,
+"Array subscript #%B out of range for EQUIVALENCE of `%A'")
+FFEBAD_MSGS2 (FFEBAD_COMMON_PAD, WARN,
+"Padding of %A %D required before `%B' in common block `%C' at %0 -- consider reordering members, largest-type-size first",
+"Padding of %A %D required before `%B' in common block `%C' at %0")
+FFEBAD_MSGS1 (FFEBAD_COMMON_NEG, FATAL,
+"Attempt to extend COMMON area beyond its starting point via EQUIVALENCE of `%A'")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_FEW, FATAL,
+"Too few elements in reference to array `%A' in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_EQUIV_MANY, FATAL,
+"Too many elements in reference to array `%A' in EQUIVALENCE statement")
+FFEBAD_MSGS1 (FFEBAD_MIXED_TYPES, WARN,
+"Mixed CHARACTER and non-CHARACTER types via COMMON/EQUIVALENCE -- for example, `%A' and `%B'")
+FFEBAD_MSGS2 (FFEBAD_IMPLICIT_ADJLEN, FATAL,
+"Invalid length specification at %0 for IMPLICIT statement -- must be integer constant expression",
+"Invalid length specification at %0")
+FFEBAD_MSGS2 (FFEBAD_ENTRY_CONFLICTS, FATAL,
+"Type of ENTRY point at %0 to function conflicts with type(s) of previous entrypoint(s) -- must all be identical-length CHARACTER or none be CHARACTER type",
+"Type of ENTRY point at %0 to function conflicts with type(s) of previous entrypoint(s)")
+FFEBAD_MSGS1 (FFEBAD_RETURN_VALUE_UNSET, WARN,
+"Return value `%A' for FUNCTION at %0 not referenced in subprogram")
+FFEBAD_MSGS2 (FFEBAD_COMMON_ALREADY_INIT, FATAL,
+"Common block `%A' initialized at %0 already initialized at %1 -- only one program unit may specify initial values for a particular common block",
+"Common block `%A' initialized at %0 already initialized at %1")
+FFEBAD_MSGS2 (FFEBAD_COMMON_INIT_PAD, WARN,
+"Initial padding for common block `%A' is %B %C at %0 -- consider reordering members, largest-type-size first",
+"Initial padding for common block `%A' is %B %C at %0")
+FFEBAD_MSGS2 (FFEBAD_COMMON_DIFF_PAD, FATAL,
+"Initial padding for common block `%A' is %B %D at %0 but %C %E at %1 -- consider reordering members, largest-type-size first",
+"Initial padding for common block `%A' is %B %D at %0 but %C %E at %1")
+FFEBAD_MSGS1 (FFEBAD_COMMON_DIFF_SAVE, WARN,
+"Common block `%A' is SAVEd, explicitly or implicitly, at %0 but not SAVEd at %1")
+FFEBAD_MSGS1 (FFEBAD_COMMON_DIFF_SIZE, WARN,
+"Common block `%A' is %B %D in length at %0 but %C %E at %1")
+FFEBAD_MSGS2 (FFEBAD_COMMON_ENLARGED, FATAL,
+"Common block `%A' is initialized to %B %D long at %0 but enlarged to %C %E at %1 -- use consistent definitions or reorder program units in source file",
+"Common block `%A' is initialized to %B %D long at %0 but enlarged to %C %E at %1")
+FFEBAD_MSGS1 (FFEBAD_COMMON_BLANK_INIT, WARN,
+"Blank common initialized at %0")
+FFEBAD_MSGS1 (FFEBAD_NEED_INTRINSIC, WARN,
+"Intrinsic `%A' is passed as actual argument at %0 but not explicitly declared INTRINSIC")
+FFEBAD_MSGS1 (FFEBAD_NEED_EXTERNAL, WARN,
+"External procedure `%A' is passed as actual argument at %0 but not explicitly declared EXTERNAL")
+FFEBAD_MSGS1 (FFEBAD_SYMBOL_UPPER_CASE, WARN,
+"Character `%A' (for example) is upper-case in symbol name at %0")
+FFEBAD_MSGS1 (FFEBAD_SYMBOL_LOWER_CASE, WARN,
+"Character `%A' (for example) is lower-case in symbol name at %0")
+FFEBAD_MSGS1 (FFEBAD_SYMBOL_NOLOWER_INITCAP, WARN,
+"Character `%A' not followed at some point by lower-case character in symbol name at %0")
+FFEBAD_MSGS1 (FFEBAD_SYMBOL_LOWER_INITCAP, WARN,
+"Initial character `%A' is lower-case in symbol name at %0")
+FFEBAD_MSGS2 (FFEBAD_DO_REAL, WARN,
+"DO-variable `%A' is type REAL or DOUBLE PRECISION at %0 -- unexpected behavior likely",
+"DO-variable `%A' is type REAL or DOUBLE PRECISION at %0")
+FFEBAD_MSGS1 (FFEBAD_NAMELIST_CASE, WARN,
+"NAMELIST not adequately supported by run-time library for source files with case preserved")
+FFEBAD_MSGS1 (FFEBAD_NESTED_PERCENT, WARN,
+"Nested %% construct (%%VAL, %%REF, or %%DESCR) at %0")
+FFEBAD_MSGS2 (FFEBAD_ACTUALARG, WARN,
+"Invalid actual argument at %0 -- replace hollerith constants with %%REF('string') and typeless constants with INTEGER constant equivalents, or use -fugly-args or -fugly",
+"Invalid actual argument at %0")
+FFEBAD_MSGS2 (FFEBAD_QUAD_UNSUPPORTED, WARN,
+"Quadruple-precision floating-point unsupported -- treating constant at %0 as double-precision",
+"Quadruple-precision floating-point unsupported")
+FFEBAD_MSGS2 (FFEBAD_TOO_BIG_INIT, WARN,
+"Initialization of large (%B-unit) aggregate area `%A' at %0 currently very slow and takes lots of memory during g77 compile -- to be improved in 0.6",
+"This could take a while (initializing `%A' at %0)...")
+FFEBAD_MSGS1 (FFEBAD_BLOCKDATA_STMT, WARN,
+"Statement at %0 invalid in BLOCK DATA program unit at %1")
+FFEBAD_MSGS1 (FFEBAD_TRUNCATING_CHARACTER, WARN,
+"Truncating characters on right side of character constant at %0")
+FFEBAD_MSGS1 (FFEBAD_TRUNCATING_HOLLERITH, WARN,
+"Truncating characters on right side of hollerith constant at %0")
+FFEBAD_MSGS1 (FFEBAD_TRUNCATING_NUMERIC, WARN,
+"Truncating non-zero data on left side of numeric constant at %0")
+FFEBAD_MSGS1 (FFEBAD_TRUNCATING_TYPELESS, WARN,
+"Truncating non-zero data on left side of typeless constant at %0")
+FFEBAD_MSGS1 (FFEBAD_TYPELESS_OVERFLOW, WARN,
+"Typeless constant at %0 too large")
+FFEBAD_MSGS1 (FFEBAD_AMPERSAND, WARN,
+"First-column ampersand continuation at %0")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ALREADY_SEEN, FATAL,
+"Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ALREADY_SEEN_W, WARN,
+"Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_DISAGREEMENT, FATAL,
+"Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_DISAGREEMENT_W, WARN,
+"Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_TYPE_MISMATCH, FATAL,
+"Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_TYPE_MISMATCH_W, WARN,
+"Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_NARGS, FATAL,
+"Too %B arguments passed to `%A' at %0 versus definition at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_NARGS_W, WARN,
+"Too %B arguments for `%A' at %0 versus invocation at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ARG, FATAL,
+"Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_FILEWIDE_ARG_W, WARN,
+"Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSGS1 (FFEBAD_ARRAY_LARGE, FATAL,
+"Array `%A' at %0 is too large to handle")
+
+#undef INFORM
+#undef TRIVIAL
+#undef WARN
+#undef PECULIAR
+#undef FATAL
+#undef WEIRD
+#undef SEVERE
+#undef DISASTER
diff --git a/gcc/f/bad.h b/gcc/f/bad.h
new file mode 100644
index 00000000000..cdbf32c007c
--- /dev/null
+++ b/gcc/f/bad.h
@@ -0,0 +1,108 @@
+/* bad.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ bad.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_bad
+#define _H_f_bad
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+#define FFEBAD_MSGS1(KWD,SEV,MSG) KWD,
+#define FFEBAD_MSGS2(KWD,SEV,LMSG,SMSG) KWD,
+#include "bad.def"
+#undef FFEBAD_MSGS1
+#undef FFEBAD_MSGS2
+ FFEBAD
+ } ffebad;
+
+typedef enum
+ {
+
+ /* Order important; must be increasing severity. */
+
+ FFEBAD_severityINFORMATIONAL, /* User notice. */
+ FFEBAD_severityTRIVIAL, /* Internal notice. */
+ FFEBAD_severityWARNING, /* User warning. */
+ FFEBAD_severityPECULIAR, /* Internal warning. */
+ FFEBAD_severityPEDANTIC, /* Pedantic, could be warning or error. */
+ FFEBAD_severityFATAL, /* User error. */
+ FFEBAD_severityWEIRD, /* Internal error. */
+ FFEBAD_severitySEVERE, /* User error, cannot continue. */
+ FFEBAD_severityDISASTER, /* Internal error, cannot continue. */
+ FFEBAD_severity
+ } ffebadSeverity;
+
+/* Typedefs. */
+
+typedef unsigned char ffebadIndex;
+
+/* Include files needed by this one. */
+
+#include "where.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+extern bool ffebad_is_inhibited_;
+
+/* Declare functions with prototypes. */
+
+void ffebad_finish (void);
+void ffebad_here (ffebadIndex i, ffewhereLine wl, ffewhereColumn wc);
+void ffebad_init_0 (void);
+bool ffebad_is_fatal (ffebad errnum);
+ffebadSeverity ffebad_severity (ffebad errnum);
+bool ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
+ char *message);
+void ffebad_string (char *string);
+
+/* Define macros. */
+
+#define ffebad_inhibit() (ffebad_is_inhibited_)
+#define ffebad_init_1()
+#define ffebad_init_2()
+#define ffebad_init_3()
+#define ffebad_init_4()
+#define ffebad_set_inhibit(f) (ffebad_is_inhibited_ = (f))
+#define ffebad_start(e) ffebad_start_ (FALSE, (e), FFEBAD_severity, NULL)
+#define ffebad_start_lex(e) ffebad_start_ (TRUE, (e), FFEBAD_severity, NULL)
+#define ffebad_start_msg(m,s) ffebad_start_ (FALSE, FFEBAD, (s), (m))
+#define ffebad_start_msg_lex(m,s) ffebad_start_ (TRUE, FFEBAD, (s), (m))
+#define ffebad_terminate_0()
+#define ffebad_terminate_1()
+#define ffebad_terminate_2()
+#define ffebad_terminate_3()
+#define ffebad_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/bit.c b/gcc/f/bit.c
new file mode 100644
index 00000000000..864d601665b
--- /dev/null
+++ b/gcc/f/bit.c
@@ -0,0 +1,201 @@
+/* bit.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Tracks arrays of booleans in useful ways.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "glimits.j"
+#include "bit.h"
+#include "malloc.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffebit_count -- Count # of bits set a particular way
+
+ ffebit b; // the ffebit object
+ ffebitCount offset; // 0..size-1
+ bool value; // FALSE (0), TRUE (1)
+ ffebitCount range; // # bits to test
+ ffebitCount number; // # bits equal to value
+ ffebit_count(b,offset,value,range,&number);
+
+ Sets <number> to # bits at <offset> through <offset + range - 1> set to
+ <value>. If <range> is 0, <number> is set to 0. */
+
+void
+ffebit_count (ffebit b, ffebitCount offset, bool value, ffebitCount range,
+ ffebitCount *number)
+{
+ ffebitCount element;
+ ffebitCount bitno;
+
+ assert (offset + range <= b->size);
+
+ for (*number = 0; range != 0; --range, ++offset)
+ {
+ element = offset / CHAR_BIT;
+ bitno = offset % CHAR_BIT;
+ if (value
+ == ((b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE))
+ ++ * number;
+ }
+}
+
+/* ffebit_new -- Create a new ffebit object
+
+ ffebit b;
+ ffebit_kill(b);
+
+ Destroys an ffebit object obtained via ffebit_new. */
+
+void
+ffebit_kill (ffebit b)
+{
+ malloc_kill_ks (b->pool, b,
+ offsetof (struct _ffebit_, bits)
+ + (b->size + CHAR_BIT - 1) / CHAR_BIT);
+}
+
+/* ffebit_new -- Create a new ffebit object
+
+ ffebit b;
+ mallocPool pool;
+ ffebitCount size;
+ b = ffebit_new(pool,size);
+
+ Allocates an ffebit object that holds the values of <size> bits in pool
+ <pool>. */
+
+ffebit
+ffebit_new (mallocPool pool, ffebitCount size)
+{
+ ffebit b;
+
+ b = malloc_new_zks (pool, "ffebit",
+ offsetof (struct _ffebit_, bits)
+ + (size + CHAR_BIT - 1) / CHAR_BIT,
+ 0);
+ b->pool = pool;
+ b->size = size;
+
+ return b;
+}
+
+/* ffebit_set -- Set value of # of bits
+
+ ffebit b; // the ffebit object
+ ffebitCount offset; // 0..size-1
+ bool value; // FALSE (0), TRUE (1)
+ ffebitCount length; // # bits to set starting at offset (usually 1)
+ ffebit_set(b,offset,value,length);
+
+ Sets bit #s <offset> through <offset + length - 1> to <value>. */
+
+void
+ffebit_set (ffebit b, ffebitCount offset, bool value, ffebitCount length)
+{
+ ffebitCount i;
+ ffebitCount element;
+ ffebitCount bitno;
+
+ assert (offset + length <= b->size);
+
+ for (i = 0; i < length; ++i, ++offset)
+ {
+ element = offset / CHAR_BIT;
+ bitno = offset % CHAR_BIT;
+ b->bits[element] = (((unsigned char) (value ? 1 : 0)) << bitno)
+ | (b->bits[element] & ~((unsigned char) 1 << bitno));
+ }
+}
+
+/* ffebit_test -- Test value of # of bits
+
+ ffebit b; // the ffebit object
+ ffebitCount offset; // 0..size-1
+ bool value; // FALSE (0), TRUE (1)
+ ffebitCount length; // # bits with same value
+ ffebit_test(b,offset,&value,&length);
+
+ Returns value of bits at <offset> through <offset + length - 1> in
+ <value>. If <offset> is already at the end of the bit array (if
+ offset == ffebit_size(b)), <length> is set to 0 and <value> is
+ undefined. */
+
+void
+ffebit_test (ffebit b, ffebitCount offset, bool *value, ffebitCount *length)
+{
+ ffebitCount i;
+ ffebitCount element;
+ ffebitCount bitno;
+
+ if (offset >= b->size)
+ {
+ assert (offset == b->size);
+ *length = 0;
+ return;
+ }
+
+ element = offset / CHAR_BIT;
+ bitno = offset % CHAR_BIT;
+ *value = (b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE;
+ *length = 1;
+
+ for (i = b->size - offset - 1, ++offset; i != 0; --i, ++offset, ++*length)
+ {
+ element = offset / CHAR_BIT;
+ bitno = offset % CHAR_BIT;
+ if (*value
+ != ((b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE))
+ break;
+ }
+}
diff --git a/gcc/f/bit.h b/gcc/f/bit.h
new file mode 100644
index 00000000000..cb7357fa1bb
--- /dev/null
+++ b/gcc/f/bit.h
@@ -0,0 +1,84 @@
+/* bit.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ bit.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_bit
+#define _H_f_bit
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+typedef struct _ffebit_ *ffebit;
+typedef unsigned long ffebitCount;
+#define ffebitCount_f "l"
+
+/* Include files needed by this one. */
+
+#include "malloc.h"
+
+/* Structure definitions. */
+
+struct _ffebit_
+ {
+ mallocPool pool;
+ ffebitCount size;
+ unsigned char bits[1];
+ };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffebit_count (ffebit b, ffebitCount offset, bool value, ffebitCount range,
+ ffebitCount *number);
+void ffebit_kill (ffebit b);
+ffebit ffebit_new (mallocPool pool, ffebitCount size);
+void ffebit_set (ffebit b, ffebitCount offset, bool value, ffebitCount length);
+void ffebit_test (ffebit b, ffebitCount offset, bool *value, ffebitCount *length);
+
+/* Define macros. */
+
+#define ffebit_init_0()
+#define ffebit_init_1()
+#define ffebit_init_2()
+#define ffebit_init_3()
+#define ffebit_init_4()
+#define ffebit_pool(b) ((b)->pool)
+#define ffebit_size(b) ((b)->size)
+#define ffebit_terminate_0()
+#define ffebit_terminate_1()
+#define ffebit_terminate_2()
+#define ffebit_terminate_3()
+#define ffebit_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/bld-op.def b/gcc/f/bld-op.def
new file mode 100644
index 00000000000..adaec06673c
--- /dev/null
+++ b/gcc/f/bld-op.def
@@ -0,0 +1,69 @@
+/* bld-op.def -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ bad.c
+
+ Modifications:
+*/
+
+FFEBLD_OP (FFEBLD_opANY, "ANY", 0)
+FFEBLD_OP (FFEBLD_opSTAR, "STAR", 0) /* For adjustable arrays, alternate return dummies, etc. */
+FFEBLD_OP (FFEBLD_opCONTER, "CONTER", 0)
+FFEBLD_OP (FFEBLD_opARRTER, "ARRTER", 0) /* Array of constants (DATA...). */
+FFEBLD_OP (FFEBLD_opACCTER, "ACCTER", 0) /* Accreting ARRTER. */
+FFEBLD_OP (FFEBLD_opSYMTER, "SYMTER", 0)
+FFEBLD_OP (FFEBLD_opITEM, "ITEM", 0)
+FFEBLD_OP (FFEBLD_opUPLUS, "UPLUS", 1)
+FFEBLD_OP (FFEBLD_opUMINUS, "UMINUS", 1)
+FFEBLD_OP (FFEBLD_opADD, "ADD", 2)
+FFEBLD_OP (FFEBLD_opSUBTRACT, "SUBTRACT", 2)
+FFEBLD_OP (FFEBLD_opMULTIPLY, "MULTIPLY", 2)
+FFEBLD_OP (FFEBLD_opDIVIDE, "DIVIDE", 2)
+FFEBLD_OP (FFEBLD_opPOWER, "POWER", 2)
+FFEBLD_OP (FFEBLD_opCONCATENATE, "CONCATENATE", 2)
+FFEBLD_OP (FFEBLD_opNOT, "NOT", 1)
+FFEBLD_OP (FFEBLD_opLT, "LT", 2)
+FFEBLD_OP (FFEBLD_opLE, "LE", 2)
+FFEBLD_OP (FFEBLD_opEQ, "EQ", 2)
+FFEBLD_OP (FFEBLD_opNE, "NE", 2)
+FFEBLD_OP (FFEBLD_opGT, "GT", 2)
+FFEBLD_OP (FFEBLD_opGE, "GE", 2)
+FFEBLD_OP (FFEBLD_opAND, "AND", 2)
+FFEBLD_OP (FFEBLD_opOR, "OR", 2)
+FFEBLD_OP (FFEBLD_opXOR, "XOR", 2)
+FFEBLD_OP (FFEBLD_opEQV, "EQV", 2)
+FFEBLD_OP (FFEBLD_opNEQV, "NEQV", 2)
+FFEBLD_OP (FFEBLD_opPAREN, "PAREN", 1)
+FFEBLD_OP (FFEBLD_opPERCENT_LOC, "%LOC", 1)
+FFEBLD_OP (FFEBLD_opPERCENT_VAL, "%VAL", 1)
+FFEBLD_OP (FFEBLD_opPERCENT_REF, "%REF", 1)
+FFEBLD_OP (FFEBLD_opPERCENT_DESCR, "%DESCR", 1)
+FFEBLD_OP (FFEBLD_opCONVERT, "CONVERT", 1)
+FFEBLD_OP (FFEBLD_opREPEAT, "REPEAT", 2)
+FFEBLD_OP (FFEBLD_opBOUNDS, "BOUNDS", 2) /* For low:high in dimension lists. */
+FFEBLD_OP (FFEBLD_opFUNCREF, "FUNCREF", 2)
+FFEBLD_OP (FFEBLD_opSUBRREF, "SUBRREF", 2)
+FFEBLD_OP (FFEBLD_opARRAYREF, "ARRAYREF", 2)
+FFEBLD_OP (FFEBLD_opSUBSTR, "SUBSTR", 2)
+FFEBLD_OP (FFEBLD_opLABTER, "LABTER", 0)
+FFEBLD_OP (FFEBLD_opLABTOK, "LABTOK", 0) /* Like LABTER but contains ffelexToken instead. */
+FFEBLD_OP (FFEBLD_opIMPDO, "IMPDO", 2)
diff --git a/gcc/f/bld.c b/gcc/f/bld.c
new file mode 100644
index 00000000000..3a95727adc1
--- /dev/null
+++ b/gcc/f/bld.c
@@ -0,0 +1,5782 @@
+/* bld.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ The primary "output" of the FFE includes ffebld objects, which
+ connect expressions, operators, and operands together, along with
+ connecting lists of expressions together for argument or dimension
+ lists.
+
+ Modifications:
+ 30-Aug-92 JCB 1.1
+ Change names of some things for consistency.
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "bld.h"
+#include "bit.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "target.h"
+#include "where.h"
+
+/* Externals defined here. */
+
+ffebldArity ffebld_arity_op_[]
+=
+{
+#define FFEBLD_OP(KWD,NAME,ARITY) ARITY,
+#include "bld-op.def"
+#undef FFEBLD_OP
+};
+struct _ffebld_pool_stack_ ffebld_pool_stack_;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+#if FFEBLD_BLANK_
+static struct _ffebld_ ffebld_blank_
+=
+{
+ 0,
+ {FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, FFEINFO_kindNONE,
+ FFEINFO_whereNONE, FFETARGET_charactersizeNONE},
+ {NULL, NULL}
+};
+#endif
+#if FFETARGET_okCHARACTER1
+static ffebldConstant ffebld_constant_character1_;
+#endif
+#if FFETARGET_okCHARACTER2
+static ffebldConstant ffebld_constant_character2_;
+#endif
+#if FFETARGET_okCHARACTER3
+static ffebldConstant ffebld_constant_character3_;
+#endif
+#if FFETARGET_okCHARACTER4
+static ffebldConstant ffebld_constant_character4_;
+#endif
+#if FFETARGET_okCHARACTER5
+static ffebldConstant ffebld_constant_character5_;
+#endif
+#if FFETARGET_okCHARACTER6
+static ffebldConstant ffebld_constant_character6_;
+#endif
+#if FFETARGET_okCHARACTER7
+static ffebldConstant ffebld_constant_character7_;
+#endif
+#if FFETARGET_okCHARACTER8
+static ffebldConstant ffebld_constant_character8_;
+#endif
+#if FFETARGET_okCOMPLEX1
+static ffebldConstant ffebld_constant_complex1_;
+#endif
+#if FFETARGET_okCOMPLEX2
+static ffebldConstant ffebld_constant_complex2_;
+#endif
+#if FFETARGET_okCOMPLEX3
+static ffebldConstant ffebld_constant_complex3_;
+#endif
+#if FFETARGET_okCOMPLEX4
+static ffebldConstant ffebld_constant_complex4_;
+#endif
+#if FFETARGET_okCOMPLEX5
+static ffebldConstant ffebld_constant_complex5_;
+#endif
+#if FFETARGET_okCOMPLEX6
+static ffebldConstant ffebld_constant_complex6_;
+#endif
+#if FFETARGET_okCOMPLEX7
+static ffebldConstant ffebld_constant_complex7_;
+#endif
+#if FFETARGET_okCOMPLEX8
+static ffebldConstant ffebld_constant_complex8_;
+#endif
+#if FFETARGET_okINTEGER1
+static ffebldConstant ffebld_constant_integer1_;
+#endif
+#if FFETARGET_okINTEGER2
+static ffebldConstant ffebld_constant_integer2_;
+#endif
+#if FFETARGET_okINTEGER3
+static ffebldConstant ffebld_constant_integer3_;
+#endif
+#if FFETARGET_okINTEGER4
+static ffebldConstant ffebld_constant_integer4_;
+#endif
+#if FFETARGET_okINTEGER5
+static ffebldConstant ffebld_constant_integer5_;
+#endif
+#if FFETARGET_okINTEGER6
+static ffebldConstant ffebld_constant_integer6_;
+#endif
+#if FFETARGET_okINTEGER7
+static ffebldConstant ffebld_constant_integer7_;
+#endif
+#if FFETARGET_okINTEGER8
+static ffebldConstant ffebld_constant_integer8_;
+#endif
+#if FFETARGET_okLOGICAL1
+static ffebldConstant ffebld_constant_logical1_;
+#endif
+#if FFETARGET_okLOGICAL2
+static ffebldConstant ffebld_constant_logical2_;
+#endif
+#if FFETARGET_okLOGICAL3
+static ffebldConstant ffebld_constant_logical3_;
+#endif
+#if FFETARGET_okLOGICAL4
+static ffebldConstant ffebld_constant_logical4_;
+#endif
+#if FFETARGET_okLOGICAL5
+static ffebldConstant ffebld_constant_logical5_;
+#endif
+#if FFETARGET_okLOGICAL6
+static ffebldConstant ffebld_constant_logical6_;
+#endif
+#if FFETARGET_okLOGICAL7
+static ffebldConstant ffebld_constant_logical7_;
+#endif
+#if FFETARGET_okLOGICAL8
+static ffebldConstant ffebld_constant_logical8_;
+#endif
+#if FFETARGET_okREAL1
+static ffebldConstant ffebld_constant_real1_;
+#endif
+#if FFETARGET_okREAL2
+static ffebldConstant ffebld_constant_real2_;
+#endif
+#if FFETARGET_okREAL3
+static ffebldConstant ffebld_constant_real3_;
+#endif
+#if FFETARGET_okREAL4
+static ffebldConstant ffebld_constant_real4_;
+#endif
+#if FFETARGET_okREAL5
+static ffebldConstant ffebld_constant_real5_;
+#endif
+#if FFETARGET_okREAL6
+static ffebldConstant ffebld_constant_real6_;
+#endif
+#if FFETARGET_okREAL7
+static ffebldConstant ffebld_constant_real7_;
+#endif
+#if FFETARGET_okREAL8
+static ffebldConstant ffebld_constant_real8_;
+#endif
+static ffebldConstant ffebld_constant_hollerith_;
+static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
+ - FFEBLD_constTYPELESS_FIRST + 1];
+
+static char *ffebld_op_string_[]
+=
+{
+#define FFEBLD_OP(KWD,NAME,ARITY) NAME,
+#include "bld-op.def"
+#undef FFEBLD_OP
+};
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+#define integerdefault_ CATX(integer,FFETARGET_ktINTEGERDEFAULT)
+#define logicaldefault_ CATX(logical,FFETARGET_ktLOGICALDEFAULT)
+#define realdefault_ CATX(real,FFETARGET_ktREALDEFAULT)
+#define realdouble_ CATX(real,FFETARGET_ktREALDOUBLE)
+#define realquad_ CATX(real,FFETARGET_ktREALQUAD)
+
+/* ffebld_constant_cmp -- Compare two constants a la strcmp
+
+ ffebldConstant c1, c2;
+ if (ffebld_constant_cmp(c1,c2) == 0)
+ // they're equal, else they're not.
+
+ Returns -1 if c1 < c2, 0 if c1 == c2, +1 if c1 == c2. */
+
+int
+ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2)
+{
+ if (c1 == c2)
+ return 0;
+
+ assert (ffebld_constant_type (c1) == ffebld_constant_type (c2));
+
+ switch (ffebld_constant_type (c1))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEBLD_constINTEGER1:
+ return ffetarget_cmp_integer1 (ffebld_constant_integer1 (c1),
+ ffebld_constant_integer1 (c2));
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEBLD_constINTEGER2:
+ return ffetarget_cmp_integer2 (ffebld_constant_integer2 (c1),
+ ffebld_constant_integer2 (c2));
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEBLD_constINTEGER3:
+ return ffetarget_cmp_integer3 (ffebld_constant_integer3 (c1),
+ ffebld_constant_integer3 (c2));
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEBLD_constINTEGER4:
+ return ffetarget_cmp_integer4 (ffebld_constant_integer4 (c1),
+ ffebld_constant_integer4 (c2));
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEBLD_constINTEGER5:
+ return ffetarget_cmp_integer5 (ffebld_constant_integer5 (c1),
+ ffebld_constant_integer5 (c2));
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEBLD_constINTEGER6:
+ return ffetarget_cmp_integer6 (ffebld_constant_integer6 (c1),
+ ffebld_constant_integer6 (c2));
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEBLD_constINTEGER7:
+ return ffetarget_cmp_integer7 (ffebld_constant_integer7 (c1),
+ ffebld_constant_integer7 (c2));
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEBLD_constINTEGER8:
+ return ffetarget_cmp_integer8 (ffebld_constant_integer8 (c1),
+ ffebld_constant_integer8 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL1
+ case FFEBLD_constLOGICAL1:
+ return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1),
+ ffebld_constant_logical1 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEBLD_constLOGICAL2:
+ return ffetarget_cmp_logical2 (ffebld_constant_logical2 (c1),
+ ffebld_constant_logical2 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEBLD_constLOGICAL3:
+ return ffetarget_cmp_logical3 (ffebld_constant_logical3 (c1),
+ ffebld_constant_logical3 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEBLD_constLOGICAL4:
+ return ffetarget_cmp_logical4 (ffebld_constant_logical4 (c1),
+ ffebld_constant_logical4 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEBLD_constLOGICAL5:
+ return ffetarget_cmp_logical5 (ffebld_constant_logical5 (c1),
+ ffebld_constant_logical5 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEBLD_constLOGICAL6:
+ return ffetarget_cmp_logical6 (ffebld_constant_logical6 (c1),
+ ffebld_constant_logical6 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEBLD_constLOGICAL7:
+ return ffetarget_cmp_logical7 (ffebld_constant_logical7 (c1),
+ ffebld_constant_logical7 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEBLD_constLOGICAL8:
+ return ffetarget_cmp_logical8 (ffebld_constant_logical8 (c1),
+ ffebld_constant_logical8 (c2));
+#endif
+
+#if FFETARGET_okREAL1
+ case FFEBLD_constREAL1:
+ return ffetarget_cmp_real1 (ffebld_constant_real1 (c1),
+ ffebld_constant_real1 (c2));
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEBLD_constREAL2:
+ return ffetarget_cmp_real2 (ffebld_constant_real2 (c1),
+ ffebld_constant_real2 (c2));
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEBLD_constREAL3:
+ return ffetarget_cmp_real3 (ffebld_constant_real3 (c1),
+ ffebld_constant_real3 (c2));
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEBLD_constREAL4:
+ return ffetarget_cmp_real4 (ffebld_constant_real4 (c1),
+ ffebld_constant_real4 (c2));
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEBLD_constREAL5:
+ return ffetarget_cmp_real5 (ffebld_constant_real5 (c1),
+ ffebld_constant_real5 (c2));
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEBLD_constREAL6:
+ return ffetarget_cmp_real6 (ffebld_constant_real6 (c1),
+ ffebld_constant_real6 (c2));
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEBLD_constREAL7:
+ return ffetarget_cmp_real7 (ffebld_constant_real7 (c1),
+ ffebld_constant_real7 (c2));
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEBLD_constREAL8:
+ return ffetarget_cmp_real8 (ffebld_constant_real8 (c1),
+ ffebld_constant_real8 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER1
+ case FFEBLD_constCHARACTER1:
+ return ffetarget_cmp_character1 (ffebld_constant_character1 (c1),
+ ffebld_constant_character1 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEBLD_constCHARACTER2:
+ return ffetarget_cmp_character2 (ffebld_constant_character2 (c1),
+ ffebld_constant_character2 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEBLD_constCHARACTER3:
+ return ffetarget_cmp_character3 (ffebld_constant_character3 (c1),
+ ffebld_constant_character3 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEBLD_constCHARACTER4:
+ return ffetarget_cmp_character4 (ffebld_constant_character4 (c1),
+ ffebld_constant_character4 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEBLD_constCHARACTER5:
+ return ffetarget_cmp_character5 (ffebld_constant_character5 (c1),
+ ffebld_constant_character5 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEBLD_constCHARACTER6:
+ return ffetarget_cmp_character6 (ffebld_constant_character6 (c1),
+ ffebld_constant_character6 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEBLD_constCHARACTER7:
+ return ffetarget_cmp_character7 (ffebld_constant_character7 (c1),
+ ffebld_constant_character7 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEBLD_constCHARACTER8:
+ return ffetarget_cmp_character8 (ffebld_constant_character8 (c1),
+ ffebld_constant_character8 (c2));
+#endif
+
+ default:
+ assert ("bad constant type" == NULL);
+ return 0;
+ }
+}
+
+/* ffebld_constant_dump -- Display summary of constant's contents
+
+ ffebldConstant c;
+ ffebld_constant_dump(c);
+
+ Displays the constant in summary form. */
+
+void
+ffebld_constant_dump (ffebldConstant c)
+{
+ switch (ffebld_constant_type (c))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEBLD_constINTEGER1:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER1);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEBLD_constINTEGER2:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER2);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEBLD_constINTEGER3:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER3);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEBLD_constINTEGER4:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER4);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEBLD_constINTEGER5:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER5);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER5);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEBLD_constINTEGER6:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER6);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER6);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEBLD_constINTEGER7:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER7);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER7);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEBLD_constINTEGER8:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER8);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER8);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL1
+ case FFEBLD_constLOGICAL1:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICAL1);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEBLD_constLOGICAL2:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICAL2);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEBLD_constLOGICAL3:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICAL3);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEBLD_constLOGICAL4:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICAL4);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEBLD_constLOGICAL5:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICAL5);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL5);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEBLD_constLOGICAL6:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICAL6);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL6);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEBLD_constLOGICAL7:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICAL7);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL7);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEBLD_constLOGICAL8:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICAL8);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL8);
+ break;
+#endif
+
+#if FFETARGET_okREAL1
+ case FFEBLD_constREAL1:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREAL1);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEBLD_constREAL2:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREAL2);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL2);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEBLD_constREAL3:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREAL3);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL3);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEBLD_constREAL4:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREAL4);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL4);
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEBLD_constREAL5:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREAL5);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL5);
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEBLD_constREAL6:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREAL6);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL6);
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEBLD_constREAL7:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREAL7);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL7);
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEBLD_constREAL8:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREAL8);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL8);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX1
+ case FFEBLD_constCOMPLEX1:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREAL1);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEBLD_constCOMPLEX2:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREAL2);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL2);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEBLD_constCOMPLEX3:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREAL3);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL3);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEBLD_constCOMPLEX4:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREAL4);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL4);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEBLD_constCOMPLEX5:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREAL5);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL5);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEBLD_constCOMPLEX6:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREAL6);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL6);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEBLD_constCOMPLEX7:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREAL7);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL7);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEBLD_constCOMPLEX8:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREAL8);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL8);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER1
+ case FFEBLD_constCHARACTER1:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER1);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER1);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEBLD_constCHARACTER2:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER2);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER2);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEBLD_constCHARACTER3:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER3);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER3);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEBLD_constCHARACTER4:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER4);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER4);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEBLD_constCHARACTER5:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER5);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER5);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEBLD_constCHARACTER6:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER6);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER6);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEBLD_constCHARACTER7:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER7);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER7);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEBLD_constCHARACTER8:
+ ffebld_dump_prefix (dmpout, FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER8);
+ ffebld_constantunion_dump (ffebld_constant_union (c),
+ FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTER8);
+ break;
+#endif
+
+ case FFEBLD_constHOLLERITH:
+ fprintf (dmpout, "H%" ffetargetHollerithSize_f "u/",
+ ffebld_constant_hollerith (c).length);
+ ffetarget_print_hollerith (dmpout, ffebld_constant_hollerith (c));
+ break;
+
+ case FFEBLD_constBINARY_MIL:
+ fprintf (dmpout, "BM/");
+ ffetarget_print_binarymil (dmpout, ffebld_constant_typeless (c));
+ break;
+
+ case FFEBLD_constBINARY_VXT:
+ fprintf (dmpout, "BV/");
+ ffetarget_print_binaryvxt (dmpout, ffebld_constant_typeless (c));
+ break;
+
+ case FFEBLD_constOCTAL_MIL:
+ fprintf (dmpout, "OM/");
+ ffetarget_print_octalmil (dmpout, ffebld_constant_typeless (c));
+ break;
+
+ case FFEBLD_constOCTAL_VXT:
+ fprintf (dmpout, "OV/");
+ ffetarget_print_octalvxt (dmpout, ffebld_constant_typeless (c));
+ break;
+
+ case FFEBLD_constHEX_X_MIL:
+ fprintf (dmpout, "XM/");
+ ffetarget_print_hexxmil (dmpout, ffebld_constant_typeless (c));
+ break;
+
+ case FFEBLD_constHEX_X_VXT:
+ fprintf (dmpout, "XV/");
+ ffetarget_print_hexxvxt (dmpout, ffebld_constant_typeless (c));
+ break;
+
+ case FFEBLD_constHEX_Z_MIL:
+ fprintf (dmpout, "ZM/");
+ ffetarget_print_hexzmil (dmpout, ffebld_constant_typeless (c));
+ break;
+
+ case FFEBLD_constHEX_Z_VXT:
+ fprintf (dmpout, "ZV/");
+ ffetarget_print_hexzvxt (dmpout, ffebld_constant_typeless (c));
+ break;
+
+ default:
+ assert ("bad constant type" == NULL);
+ fprintf (dmpout, "?/?");
+ break;
+ }
+}
+
+/* ffebld_constant_is_magical -- Determine if integer is "magical"
+
+ ffebldConstant c;
+ if (ffebld_constant_is_magical(c))
+ // it is 2**(n-1), where n is # bits in ffetargetIntegerDefault type
+ // (this test is important for 2's-complement machines only). */
+
+bool
+ffebld_constant_is_magical (ffebldConstant c)
+{
+ switch (ffebld_constant_type (c))
+ {
+ case FFEBLD_constINTEGERDEFAULT:
+ return ffetarget_integerdefault_is_magical (ffebld_constant_integer1 (c));
+
+ default:
+ return FALSE;
+ }
+}
+
+/* Determine if constant is zero. Used to ensure step count
+ for DO loops isn't zero, also to determine if values will
+ be binary zeros, so not entirely portable at this point. */
+
+bool
+ffebld_constant_is_zero (ffebldConstant c)
+{
+ switch (ffebld_constant_type (c))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEBLD_constINTEGER1:
+ return ffebld_constant_integer1 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEBLD_constINTEGER2:
+ return ffebld_constant_integer2 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEBLD_constINTEGER3:
+ return ffebld_constant_integer3 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEBLD_constINTEGER4:
+ return ffebld_constant_integer4 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEBLD_constINTEGER5:
+ return ffebld_constant_integer5 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEBLD_constINTEGER6:
+ return ffebld_constant_integer6 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEBLD_constINTEGER7:
+ return ffebld_constant_integer7 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEBLD_constINTEGER8:
+ return ffebld_constant_integer8 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL1
+ case FFEBLD_constLOGICAL1:
+ return ffebld_constant_logical1 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEBLD_constLOGICAL2:
+ return ffebld_constant_logical2 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEBLD_constLOGICAL3:
+ return ffebld_constant_logical3 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEBLD_constLOGICAL4:
+ return ffebld_constant_logical4 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEBLD_constLOGICAL5:
+ return ffebld_constant_logical5 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEBLD_constLOGICAL6:
+ return ffebld_constant_logical6 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEBLD_constLOGICAL7:
+ return ffebld_constant_logical7 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEBLD_constLOGICAL8:
+ return ffebld_constant_logical8 (c) == 0;
+#endif
+
+#if FFETARGET_okREAL1
+ case FFEBLD_constREAL1:
+ return ffetarget_iszero_real1 (ffebld_constant_real1 (c));
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEBLD_constREAL2:
+ return ffetarget_iszero_real2 (ffebld_constant_real2 (c));
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEBLD_constREAL3:
+ return ffetarget_iszero_real3 (ffebld_constant_real3 (c));
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEBLD_constREAL4:
+ return ffetarget_iszero_real4 (ffebld_constant_real4 (c));
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEBLD_constREAL5:
+ return ffetarget_iszero_real5 (ffebld_constant_real5 (c));
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEBLD_constREAL6:
+ return ffetarget_iszero_real6 (ffebld_constant_real6 (c));
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEBLD_constREAL7:
+ return ffetarget_iszero_real7 (ffebld_constant_real7 (c));
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEBLD_constREAL8:
+ return ffetarget_iszero_real8 (ffebld_constant_real8 (c));
+#endif
+
+#if FFETARGET_okCOMPLEX1
+ case FFEBLD_constCOMPLEX1:
+ return ffetarget_iszero_real1 (ffebld_constant_complex1 (c).real)
+ && ffetarget_iszero_real1 (ffebld_constant_complex1 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEBLD_constCOMPLEX2:
+ return ffetarget_iszero_real2 (ffebld_constant_complex2 (c).real)
+ && ffetarget_iszero_real2 (ffebld_constant_complex2 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEBLD_constCOMPLEX3:
+ return ffetarget_iszero_real3 (ffebld_constant_complex3 (c).real)
+ && ffetarget_iszero_real3 (ffebld_constant_complex3 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEBLD_constCOMPLEX4:
+ return ffetarget_iszero_real4 (ffebld_constant_complex4 (c).real)
+ && ffetarget_iszero_real4 (ffebld_constant_complex4 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEBLD_constCOMPLEX5:
+ return ffetarget_iszero_real5 (ffebld_constant_complex5 (c).real)
+ && ffetarget_iszero_real5 (ffebld_constant_complex5 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEBLD_constCOMPLEX6:
+ return ffetarget_iszero_real6 (ffebld_constant_complex6 (c).real)
+ && ffetarget_iszero_real6 (ffebld_constant_complex6 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEBLD_constCOMPLEX7:
+ return ffetarget_iszero_real7 (ffebld_constant_complex7 (c).real)
+ && ffetarget_iszero_real7 (ffebld_constant_complex7 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEBLD_constCOMPLEX8:
+ return ffetarget_iszero_real8 (ffebld_constant_complex8 (c).real)
+ && ffetarget_iszero_real8 (ffebld_constant_complex8 (c).imaginary);
+#endif
+
+#if FFETARGET_okCHARACTER1
+ case FFEBLD_constCHARACTER1:
+ return ffetarget_iszero_character1 (ffebld_constant_character1 (c));
+#endif
+
+#if FFETARGET_okCHARACTER2 || FFETARGET_okCHARACTER3 /* ... */
+#error "no support for these!!"
+#endif
+
+ case FFEBLD_constHOLLERITH:
+ return ffetarget_iszero_hollerith (ffebld_constant_hollerith (c));
+
+ case FFEBLD_constBINARY_MIL:
+ case FFEBLD_constBINARY_VXT:
+ case FFEBLD_constOCTAL_MIL:
+ case FFEBLD_constOCTAL_VXT:
+ case FFEBLD_constHEX_X_MIL:
+ case FFEBLD_constHEX_X_VXT:
+ case FFEBLD_constHEX_Z_MIL:
+ case FFEBLD_constHEX_Z_VXT:
+ return ffetarget_iszero_typeless (ffebld_constant_typeless (c));
+
+ default:
+ return FALSE;
+ }
+}
+
+/* ffebld_constant_new_character1 -- Return character1 constant object from token
+
+ See prototype. */
+
+#if FFETARGET_okCHARACTER1
+ffebldConstant
+ffebld_constant_new_character1 (ffelexToken t)
+{
+ ffetargetCharacter1 val;
+
+ ffetarget_character1 (&val, t, ffebld_constant_pool());
+ return ffebld_constant_new_character1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_character1_val -- Return an character1 constant object
+
+ See prototype. */
+
+#if FFETARGET_okCHARACTER1
+ffebldConstant
+ffebld_constant_new_character1_val (ffetargetCharacter1 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ ffetarget_verify_character1 (ffebld_constant_pool(), val);
+
+ for (c = (ffebldConstant) &ffebld_constant_character1_;
+ c->next != NULL;
+ c = c->next)
+ {
+ malloc_verify_kp (ffebld_constant_pool(),
+ c->next,
+ sizeof (*(c->next)));
+ ffetarget_verify_character1 (ffebld_constant_pool(),
+ ffebld_constant_character1 (c->next));
+ cmp = ffetarget_cmp_character1 (val,
+ ffebld_constant_character1 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constCHARACTER1",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constCHARACTER1;
+ nc->u.character1 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_complex1 -- Return complex1 constant object from token
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEX1
+ffebldConstant
+ffebld_constant_new_complex1 (ffebldConstant real,
+ ffebldConstant imaginary)
+{
+ ffetargetComplex1 val;
+
+ val.real = ffebld_constant_real1 (real);
+ val.imaginary = ffebld_constant_real1 (imaginary);
+ return ffebld_constant_new_complex1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_complex1_val -- Return a complex1 constant object
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEX1
+ffebldConstant
+ffebld_constant_new_complex1_val (ffetargetComplex1 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_complex1_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_real1 (val.real, ffebld_constant_complex1 (c->next).real);
+ if (cmp == 0)
+ cmp = ffetarget_cmp_real1 (val.imaginary,
+ ffebld_constant_complex1 (c->next).imaginary);
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constCOMPLEX1",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constCOMPLEX1;
+ nc->u.complex1 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_complex2 -- Return complex2 constant object from token
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEX2
+ffebldConstant
+ffebld_constant_new_complex2 (ffebldConstant real,
+ ffebldConstant imaginary)
+{
+ ffetargetComplex2 val;
+
+ val.real = ffebld_constant_real2 (real);
+ val.imaginary = ffebld_constant_real2 (imaginary);
+ return ffebld_constant_new_complex2_val (val);
+}
+
+#endif
+/* ffebld_constant_new_complex2_val -- Return a complex2 constant object
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEX2
+ffebldConstant
+ffebld_constant_new_complex2_val (ffetargetComplex2 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_complex2_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_real2 (val.real, ffebld_constant_complex2 (c->next).real);
+ if (cmp == 0)
+ cmp = ffetarget_cmp_real2 (val.imaginary,
+ ffebld_constant_complex2 (c->next).imaginary);
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constCOMPLEX2",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constCOMPLEX2;
+ nc->u.complex2 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_hollerith -- Return hollerith constant object from token
+
+ See prototype. */
+
+ffebldConstant
+ffebld_constant_new_hollerith (ffelexToken t)
+{
+ ffetargetHollerith val;
+
+ ffetarget_hollerith (&val, t, ffebld_constant_pool());
+ return ffebld_constant_new_hollerith_val (val);
+}
+
+/* ffebld_constant_new_hollerith_val -- Return an hollerith constant object
+
+ See prototype. */
+
+ffebldConstant
+ffebld_constant_new_hollerith_val (ffetargetHollerith val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_hollerith_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_hollerith (val, ffebld_constant_hollerith (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constHOLLERITH",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constHOLLERITH;
+ nc->u.hollerith = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+/* ffebld_constant_new_integer1 -- Return integer1 constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+#if FFETARGET_okINTEGER1
+ffebldConstant
+ffebld_constant_new_integer1 (ffelexToken t)
+{
+ ffetargetInteger1 val;
+
+ assert (ffelex_token_type (t) == FFELEX_typeNUMBER);
+
+ ffetarget_integer1 (&val, t);
+ return ffebld_constant_new_integer1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_integer1_val -- Return an integer1 constant object
+
+ See prototype. */
+
+#if FFETARGET_okINTEGER1
+ffebldConstant
+ffebld_constant_new_integer1_val (ffetargetInteger1 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_integer1_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_integer1 (val, ffebld_constant_integer1 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constINTEGER1",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constINTEGER1;
+ nc->u.integer1 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_integer2_val -- Return an integer2 constant object
+
+ See prototype. */
+
+#if FFETARGET_okINTEGER2
+ffebldConstant
+ffebld_constant_new_integer2_val (ffetargetInteger2 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_integer2_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_integer2 (val, ffebld_constant_integer2 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constINTEGER2",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constINTEGER2;
+ nc->u.integer2 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_integer3_val -- Return an integer3 constant object
+
+ See prototype. */
+
+#if FFETARGET_okINTEGER3
+ffebldConstant
+ffebld_constant_new_integer3_val (ffetargetInteger3 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_integer3_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_integer3 (val, ffebld_constant_integer3 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constINTEGER3",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constINTEGER3;
+ nc->u.integer3 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_integer4_val -- Return an integer4 constant object
+
+ See prototype. */
+
+#if FFETARGET_okINTEGER4
+ffebldConstant
+ffebld_constant_new_integer4_val (ffetargetInteger4 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_integer4_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_integer4 (val, ffebld_constant_integer4 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constINTEGER4",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constINTEGER4;
+ nc->u.integer4 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_integerbinary -- Return binary constant object from token
+
+ See prototype.
+
+ Parses the token as a binary integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_integerbinary (ffelexToken t)
+{
+ ffetargetIntegerDefault val;
+
+ assert ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNUMBER));
+
+ ffetarget_integerbinary (&val, t);
+ return ffebld_constant_new_integerdefault_val (val);
+}
+
+/* ffebld_constant_new_integerhex -- Return hex constant object from token
+
+ See prototype.
+
+ Parses the token as a hex integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_integerhex (ffelexToken t)
+{
+ ffetargetIntegerDefault val;
+
+ assert ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNUMBER));
+
+ ffetarget_integerhex (&val, t);
+ return ffebld_constant_new_integerdefault_val (val);
+}
+
+/* ffebld_constant_new_integeroctal -- Return octal constant object from token
+
+ See prototype.
+
+ Parses the token as a octal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_integeroctal (ffelexToken t)
+{
+ ffetargetIntegerDefault val;
+
+ assert ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNUMBER));
+
+ ffetarget_integeroctal (&val, t);
+ return ffebld_constant_new_integerdefault_val (val);
+}
+
+/* ffebld_constant_new_logical1 -- Return logical1 constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal logical constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+#if FFETARGET_okLOGICAL1
+ffebldConstant
+ffebld_constant_new_logical1 (bool truth)
+{
+ ffetargetLogical1 val;
+
+ ffetarget_logical1 (&val, truth);
+ return ffebld_constant_new_logical1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_logical1_val -- Return a logical1 constant object
+
+ See prototype. */
+
+#if FFETARGET_okLOGICAL1
+ffebldConstant
+ffebld_constant_new_logical1_val (ffetargetLogical1 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_logical1_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_logical1 (val, ffebld_constant_logical1 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constLOGICAL1",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constLOGICAL1;
+ nc->u.logical1 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_logical2_val -- Return a logical2 constant object
+
+ See prototype. */
+
+#if FFETARGET_okLOGICAL2
+ffebldConstant
+ffebld_constant_new_logical2_val (ffetargetLogical2 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_logical2_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_logical2 (val, ffebld_constant_logical2 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constLOGICAL2",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constLOGICAL2;
+ nc->u.logical2 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_logical3_val -- Return a logical3 constant object
+
+ See prototype. */
+
+#if FFETARGET_okLOGICAL3
+ffebldConstant
+ffebld_constant_new_logical3_val (ffetargetLogical3 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_logical3_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_logical3 (val, ffebld_constant_logical3 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constLOGICAL3",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constLOGICAL3;
+ nc->u.logical3 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_logical4_val -- Return a logical4 constant object
+
+ See prototype. */
+
+#if FFETARGET_okLOGICAL4
+ffebldConstant
+ffebld_constant_new_logical4_val (ffetargetLogical4 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_logical4_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_logical4 (val, ffebld_constant_logical4 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constLOGICAL4",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constLOGICAL4;
+ nc->u.logical4 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_real1 -- Return real1 constant object from token
+
+ See prototype. */
+
+#if FFETARGET_okREAL1
+ffebldConstant
+ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal,
+ ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits)
+{
+ ffetargetReal1 val;
+
+ ffetarget_real1 (&val,
+ integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
+ return ffebld_constant_new_real1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_real1_val -- Return an real1 constant object
+
+ See prototype. */
+
+#if FFETARGET_okREAL1
+ffebldConstant
+ffebld_constant_new_real1_val (ffetargetReal1 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_real1_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_real1 (val, ffebld_constant_real1 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constREAL1",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constREAL1;
+ nc->u.real1 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_real2 -- Return real2 constant object from token
+
+ See prototype. */
+
+#if FFETARGET_okREAL2
+ffebldConstant
+ffebld_constant_new_real2 (ffelexToken integer, ffelexToken decimal,
+ ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits)
+{
+ ffetargetReal2 val;
+
+ ffetarget_real2 (&val,
+ integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
+ return ffebld_constant_new_real2_val (val);
+}
+
+#endif
+/* ffebld_constant_new_real2_val -- Return an real2 constant object
+
+ See prototype. */
+
+#if FFETARGET_okREAL2
+ffebldConstant
+ffebld_constant_new_real2_val (ffetargetReal2 val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_real2_;
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_real2 (val, ffebld_constant_real2 (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constREAL2",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = FFEBLD_constREAL2;
+ nc->u.real2 = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+#endif
+/* ffebld_constant_new_typeless_bm -- Return typeless constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_typeless_bm (ffelexToken t)
+{
+ ffetargetTypeless val;
+
+ ffetarget_binarymil (&val, t);
+ return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_MIL, val);
+}
+
+/* ffebld_constant_new_typeless_bv -- Return typeless constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_typeless_bv (ffelexToken t)
+{
+ ffetargetTypeless val;
+
+ ffetarget_binaryvxt (&val, t);
+ return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_VXT, val);
+}
+
+/* ffebld_constant_new_typeless_hxm -- Return typeless constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_typeless_hxm (ffelexToken t)
+{
+ ffetargetTypeless val;
+
+ ffetarget_hexxmil (&val, t);
+ return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_MIL, val);
+}
+
+/* ffebld_constant_new_typeless_hxv -- Return typeless constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_typeless_hxv (ffelexToken t)
+{
+ ffetargetTypeless val;
+
+ ffetarget_hexxvxt (&val, t);
+ return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_VXT, val);
+}
+
+/* ffebld_constant_new_typeless_hzm -- Return typeless constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_typeless_hzm (ffelexToken t)
+{
+ ffetargetTypeless val;
+
+ ffetarget_hexzmil (&val, t);
+ return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_MIL, val);
+}
+
+/* ffebld_constant_new_typeless_hzv -- Return typeless constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_typeless_hzv (ffelexToken t)
+{
+ ffetargetTypeless val;
+
+ ffetarget_hexzvxt (&val, t);
+ return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_VXT, val);
+}
+
+/* ffebld_constant_new_typeless_om -- Return typeless constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_typeless_om (ffelexToken t)
+{
+ ffetargetTypeless val;
+
+ ffetarget_octalmil (&val, t);
+ return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_MIL, val);
+}
+
+/* ffebld_constant_new_typeless_ov -- Return typeless constant object from token
+
+ See prototype.
+
+ Parses the token as a decimal integer constant, thus it must be an
+ FFELEX_typeNUMBER. */
+
+ffebldConstant
+ffebld_constant_new_typeless_ov (ffelexToken t)
+{
+ ffetargetTypeless val;
+
+ ffetarget_octalvxt (&val, t);
+ return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_VXT, val);
+}
+
+/* ffebld_constant_new_typeless_val -- Return a typeless constant object
+
+ See prototype. */
+
+ffebldConstant
+ffebld_constant_new_typeless_val (ffebldConst type, ffetargetTypeless val)
+{
+ ffebldConstant c;
+ ffebldConstant nc;
+ int cmp;
+
+ for (c = (ffebldConstant) &ffebld_constant_typeless_[type
+ - FFEBLD_constTYPELESS_FIRST];
+ c->next != NULL;
+ c = c->next)
+ {
+ cmp = ffetarget_cmp_typeless (val, ffebld_constant_typeless (c->next));
+ if (cmp == 0)
+ return c->next;
+ if (cmp > 0)
+ break;
+ }
+
+ nc = malloc_new_kp (ffebld_constant_pool(),
+ "FFEBLD_constTYPELESS",
+ sizeof (*nc));
+ nc->next = c->next;
+ nc->consttype = type;
+ nc->u.typeless = val;
+#ifdef FFECOM_constantHOOK
+ nc->hook = FFECOM_constantNULL;
+#endif
+ c->next = nc;
+
+ return nc;
+}
+
+/* ffebld_constantarray_dump -- Display summary of array's contents
+
+ ffebldConstantArray a;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffetargetOffset size;
+ ffebld_constant_dump(a,bt,kt,size,NULL);
+
+ Displays the constant array in summary form. The fifth argument, if
+ supplied, is an ffebit object that is consulted as to whether the
+ constant at a particular offset is valid. */
+
+void
+ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset size, ffebit bits)
+{
+ ffetargetOffset i;
+ ffebitCount j;
+
+ ffebld_dump_prefix (dmpout, bt, kt);
+
+ fprintf (dmpout, "\\(");
+
+ if (bits == NULL)
+ {
+ for (i = 0; i < size; ++i)
+ {
+ ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt, i), bt,
+ kt);
+ if (i != size - 1)
+ fputc (',', dmpout);
+ }
+ }
+ else
+ {
+ bool value;
+ ffebitCount length;
+ ffetargetOffset offset = 0;
+
+ do
+ {
+ ffebit_test (bits, offset, &value, &length);
+ if (value && (length != 0))
+ {
+ if (length == 1)
+ fprintf (dmpout, "[%" ffetargetOffset_f "d]:", offset);
+ else
+ fprintf (dmpout,
+ "[%" ffetargetOffset_f "u..%" ffetargetOffset_f "d]:",
+ offset, offset + (ffetargetOffset) length - 1);
+ for (j = 0; j < length; ++j, ++offset)
+ {
+ ffebld_constantunion_dump (ffebld_constantarray_get (array, bt, kt,
+ offset), bt, kt);
+ if (j != length - 1)
+ fputc (',', dmpout);
+ }
+ fprintf (dmpout, ";");
+ }
+ else
+ offset += length;
+ }
+ while (length != 0);
+ }
+ fprintf (dmpout, "\\)");
+
+}
+
+/* ffebld_constantarray_get -- Get a value from an array of constants
+
+ See prototype. */
+
+ffebldConstantUnion
+ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset offset)
+{
+ ffebldConstantUnion u;
+
+ switch (bt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (kt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ u.integer1 = *(array.integer1 + offset);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ u.integer2 = *(array.integer2 + offset);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ u.integer3 = *(array.integer3 + offset);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ u.integer4 = *(array.integer4 + offset);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ u.integer5 = *(array.integer5 + offset);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ u.integer6 = *(array.integer6 + offset);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ u.integer7 = *(array.integer7 + offset);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ u.integer8 = *(array.integer8 + offset);
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ u.logical1 = *(array.logical1 + offset);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ u.logical2 = *(array.logical2 + offset);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ u.logical3 = *(array.logical3 + offset);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ u.logical4 = *(array.logical4 + offset);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ u.logical5 = *(array.logical5 + offset);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ u.logical6 = *(array.logical6 + offset);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ u.logical7 = *(array.logical7 + offset);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ u.logical8 = *(array.logical8 + offset);
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ u.real1 = *(array.real1 + offset);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ u.real2 = *(array.real2 + offset);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ u.real3 = *(array.real3 + offset);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ u.real4 = *(array.real4 + offset);
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ u.real5 = *(array.real5 + offset);
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ u.real6 = *(array.real6 + offset);
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ u.real7 = *(array.real7 + offset);
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ u.real8 = *(array.real8 + offset);
+ break;
+#endif
+
+ default:
+ assert ("bad REAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ u.complex1 = *(array.complex1 + offset);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ u.complex2 = *(array.complex2 + offset);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ u.complex3 = *(array.complex3 + offset);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ u.complex4 = *(array.complex4 + offset);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ u.complex5 = *(array.complex5 + offset);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ u.complex6 = *(array.complex6 + offset);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ u.complex7 = *(array.complex7 + offset);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ u.complex8 = *(array.complex8 + offset);
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (kt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ u.character1.length = 1;
+ u.character1.text = array.character1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ u.character2.length = 1;
+ u.character2.text = array.character2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ u.character3.length = 1;
+ u.character3.text = array.character3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ u.character4.length = 1;
+ u.character4.text = array.character4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ u.character5.length = 1;
+ u.character5.text = array.character5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ u.character6.length = 1;
+ u.character6.text = array.character6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ u.character7.length = 1;
+ u.character7.text = array.character7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ u.character8.length = 1;
+ u.character8.text = array.character8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad basictype" == NULL);
+ break;
+ }
+
+ return u;
+}
+
+/* ffebld_constantarray_new -- Make an array of constants
+
+ See prototype. */
+
+ffebldConstantArray
+ffebld_constantarray_new (ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset size)
+{
+ ffebldConstantArray ptr;
+
+ switch (bt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (kt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ ptr.integer1 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetInteger1),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ ptr.integer2 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetInteger2),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ ptr.integer3 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetInteger3),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ ptr.integer4 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetInteger4),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ ptr.integer5 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetInteger5),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ ptr.integer6 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetInteger6),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ ptr.integer7 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetInteger7),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ ptr.integer8 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetInteger8),
+ 0);
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ ptr.logical1 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetLogical1),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ ptr.logical2 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetLogical2),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ ptr.logical3 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetLogical3),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ ptr.logical4 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetLogical4),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ ptr.logical5 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetLogical5),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ ptr.logical6 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetLogical6),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ ptr.logical7 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetLogical7),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ ptr.logical8 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetLogical8),
+ 0);
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ ptr.real1 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetReal1),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ ptr.real2 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetReal2),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ ptr.real3 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetReal3),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ ptr.real4 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetReal4),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ ptr.real5 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetReal5),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ ptr.real6 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetReal6),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ ptr.real7 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetReal7),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ ptr.real8 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetReal8),
+ 0);
+ break;
+#endif
+
+ default:
+ assert ("bad REAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ ptr.complex1 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetComplex1),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ ptr.complex2 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetComplex2),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ ptr.complex3 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetComplex3),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ ptr.complex4 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetComplex4),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ ptr.complex5 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetComplex5),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ ptr.complex6 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetComplex6),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ ptr.complex7 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetComplex7),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ ptr.complex8 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size *= sizeof (ffetargetComplex8),
+ 0);
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (kt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ ptr.character1 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size
+ *= sizeof (ffetargetCharacterUnit1),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ ptr.character2 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size
+ *= sizeof (ffetargetCharacterUnit2),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ ptr.character3 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size
+ *= sizeof (ffetargetCharacterUnit3),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ ptr.character4 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size
+ *= sizeof (ffetargetCharacterUnit4),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ ptr.character5 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size
+ *= sizeof (ffetargetCharacterUnit5),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ ptr.character6 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size
+ *= sizeof (ffetargetCharacterUnit6),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ ptr.character7 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size
+ *= sizeof (ffetargetCharacterUnit7),
+ 0);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ ptr.character8 = malloc_new_zkp (ffebld_constant_pool(),
+ "ffebldConstantArray",
+ size
+ *= sizeof (ffetargetCharacterUnit8),
+ 0);
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad basictype" == NULL);
+ break;
+ }
+
+ return ptr;
+}
+
+/* ffebld_constantarray_preparray -- Prepare for copy between arrays
+
+ See prototype.
+
+ Like _prepare, but the source is an array instead of a single-value
+ constant. */
+
+void
+ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
+ ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
+ ffetargetOffset offset, ffebldConstantArray source_array,
+ ffeinfoBasictype cbt, ffeinfoKindtype ckt)
+{
+ switch (abt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (akt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ *aptr = array.integer1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ *aptr = array.integer2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ *aptr = array.integer3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ *aptr = array.integer4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ *aptr = array.integer5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ *aptr = array.integer6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ *aptr = array.integer7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ *aptr = array.integer8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER akindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (akt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ *aptr = array.logical1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ *aptr = array.logical2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ *aptr = array.logical3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ *aptr = array.logical4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ *aptr = array.logical5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ *aptr = array.logical6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ *aptr = array.logical7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ *aptr = array.logical8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL akindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (akt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ *aptr = array.real1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ *aptr = array.real2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ *aptr = array.real3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ *aptr = array.real4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ *aptr = array.real5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ *aptr = array.real6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ *aptr = array.real7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ *aptr = array.real8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad REAL akindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (akt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ *aptr = array.complex1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ *aptr = array.complex2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ *aptr = array.complex3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ *aptr = array.complex4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ *aptr = array.complex5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ *aptr = array.complex6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ *aptr = array.complex7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ *aptr = array.complex8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX akindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (akt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ *aptr = array.character1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ *aptr = array.character2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ *aptr = array.character3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ *aptr = array.character4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ *aptr = array.character5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ *aptr = array.character6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ *aptr = array.character7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ *aptr = array.character8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER akindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad abasictype" == NULL);
+ break;
+ }
+
+ switch (cbt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ckt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ *cptr = source_array.integer1;
+ *size = sizeof (*source_array.integer1);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ *cptr = source_array.integer2;
+ *size = sizeof (*source_array.integer2);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ *cptr = source_array.integer3;
+ *size = sizeof (*source_array.integer3);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ *cptr = source_array.integer4;
+ *size = sizeof (*source_array.integer4);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ *cptr = source_array.integer5;
+ *size = sizeof (*source_array.integer5);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ *cptr = source_array.integer6;
+ *size = sizeof (*source_array.integer6);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ *cptr = source_array.integer7;
+ *size = sizeof (*source_array.integer7);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ *cptr = source_array.integer8;
+ *size = sizeof (*source_array.integer8);
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (ckt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ *cptr = source_array.logical1;
+ *size = sizeof (*source_array.logical1);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ *cptr = source_array.logical2;
+ *size = sizeof (*source_array.logical2);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ *cptr = source_array.logical3;
+ *size = sizeof (*source_array.logical3);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ *cptr = source_array.logical4;
+ *size = sizeof (*source_array.logical4);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ *cptr = source_array.logical5;
+ *size = sizeof (*source_array.logical5);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ *cptr = source_array.logical6;
+ *size = sizeof (*source_array.logical6);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ *cptr = source_array.logical7;
+ *size = sizeof (*source_array.logical7);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ *cptr = source_array.logical8;
+ *size = sizeof (*source_array.logical8);
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ckt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ *cptr = source_array.real1;
+ *size = sizeof (*source_array.real1);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ *cptr = source_array.real2;
+ *size = sizeof (*source_array.real2);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ *cptr = source_array.real3;
+ *size = sizeof (*source_array.real3);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ *cptr = source_array.real4;
+ *size = sizeof (*source_array.real4);
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ *cptr = source_array.real5;
+ *size = sizeof (*source_array.real5);
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ *cptr = source_array.real6;
+ *size = sizeof (*source_array.real6);
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ *cptr = source_array.real7;
+ *size = sizeof (*source_array.real7);
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ *cptr = source_array.real8;
+ *size = sizeof (*source_array.real8);
+ break;
+#endif
+
+ default:
+ assert ("bad REAL ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ckt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ *cptr = source_array.complex1;
+ *size = sizeof (*source_array.complex1);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ *cptr = source_array.complex2;
+ *size = sizeof (*source_array.complex2);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ *cptr = source_array.complex3;
+ *size = sizeof (*source_array.complex3);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ *cptr = source_array.complex4;
+ *size = sizeof (*source_array.complex4);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ *cptr = source_array.complex5;
+ *size = sizeof (*source_array.complex5);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ *cptr = source_array.complex6;
+ *size = sizeof (*source_array.complex6);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ *cptr = source_array.complex7;
+ *size = sizeof (*source_array.complex7);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ *cptr = source_array.complex8;
+ *size = sizeof (*source_array.complex8);
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ckt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ *cptr = source_array.character1;
+ *size = sizeof (*source_array.character1);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ *cptr = source_array.character2;
+ *size = sizeof (*source_array.character2);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ *cptr = source_array.character3;
+ *size = sizeof (*source_array.character3);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ *cptr = source_array.character4;
+ *size = sizeof (*source_array.character4);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ *cptr = source_array.character5;
+ *size = sizeof (*source_array.character5);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ *cptr = source_array.character6;
+ *size = sizeof (*source_array.character6);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ *cptr = source_array.character7;
+ *size = sizeof (*source_array.character7);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ *cptr = source_array.character8;
+ *size = sizeof (*source_array.character8);
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad cbasictype" == NULL);
+ break;
+ }
+}
+
+/* ffebld_constantarray_prepare -- Prepare for copy between value and array
+
+ See prototype.
+
+ Like _put, but just returns the pointers to the beginnings of the
+ array and the constant and returns the size (the amount of info to
+ copy). The idea is that the caller can use memcpy to accomplish the
+ same thing as _put (though slower), or the caller can use a different
+ function that swaps bytes, words, etc for a different target machine.
+ Also, the type of the array may be different from the type of the
+ constant; the array type is used to determine the meaning (scale) of
+ the offset field (to calculate the array pointer), the constant type is
+ used to determine the constant pointer and the size (amount of info to
+ copy). */
+
+void
+ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
+ ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
+ ffetargetOffset offset, ffebldConstantUnion *constant,
+ ffeinfoBasictype cbt, ffeinfoKindtype ckt)
+{
+ switch (abt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (akt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ *aptr = array.integer1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ *aptr = array.integer2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ *aptr = array.integer3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ *aptr = array.integer4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ *aptr = array.integer5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ *aptr = array.integer6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ *aptr = array.integer7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ *aptr = array.integer8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER akindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (akt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ *aptr = array.logical1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ *aptr = array.logical2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ *aptr = array.logical3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ *aptr = array.logical4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ *aptr = array.logical5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ *aptr = array.logical6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ *aptr = array.logical7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ *aptr = array.logical8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL akindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (akt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ *aptr = array.real1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ *aptr = array.real2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ *aptr = array.real3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ *aptr = array.real4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ *aptr = array.real5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ *aptr = array.real6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ *aptr = array.real7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ *aptr = array.real8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad REAL akindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (akt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ *aptr = array.complex1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ *aptr = array.complex2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ *aptr = array.complex3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ *aptr = array.complex4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ *aptr = array.complex5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ *aptr = array.complex6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ *aptr = array.complex7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ *aptr = array.complex8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX akindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (akt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ *aptr = array.character1 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ *aptr = array.character2 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ *aptr = array.character3 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ *aptr = array.character4 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ *aptr = array.character5 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ *aptr = array.character6 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ *aptr = array.character7 + offset;
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ *aptr = array.character8 + offset;
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER akindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad abasictype" == NULL);
+ break;
+ }
+
+ switch (cbt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ckt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ *cptr = &constant->integer1;
+ *size = sizeof (constant->integer1);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ *cptr = &constant->integer2;
+ *size = sizeof (constant->integer2);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ *cptr = &constant->integer3;
+ *size = sizeof (constant->integer3);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ *cptr = &constant->integer4;
+ *size = sizeof (constant->integer4);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ *cptr = &constant->integer5;
+ *size = sizeof (constant->integer5);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ *cptr = &constant->integer6;
+ *size = sizeof (constant->integer6);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ *cptr = &constant->integer7;
+ *size = sizeof (constant->integer7);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ *cptr = &constant->integer8;
+ *size = sizeof (constant->integer8);
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (ckt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ *cptr = &constant->logical1;
+ *size = sizeof (constant->logical1);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ *cptr = &constant->logical2;
+ *size = sizeof (constant->logical2);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ *cptr = &constant->logical3;
+ *size = sizeof (constant->logical3);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ *cptr = &constant->logical4;
+ *size = sizeof (constant->logical4);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ *cptr = &constant->logical5;
+ *size = sizeof (constant->logical5);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ *cptr = &constant->logical6;
+ *size = sizeof (constant->logical6);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ *cptr = &constant->logical7;
+ *size = sizeof (constant->logical7);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ *cptr = &constant->logical8;
+ *size = sizeof (constant->logical8);
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ckt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ *cptr = &constant->real1;
+ *size = sizeof (constant->real1);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ *cptr = &constant->real2;
+ *size = sizeof (constant->real2);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ *cptr = &constant->real3;
+ *size = sizeof (constant->real3);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ *cptr = &constant->real4;
+ *size = sizeof (constant->real4);
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ *cptr = &constant->real5;
+ *size = sizeof (constant->real5);
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ *cptr = &constant->real6;
+ *size = sizeof (constant->real6);
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ *cptr = &constant->real7;
+ *size = sizeof (constant->real7);
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ *cptr = &constant->real8;
+ *size = sizeof (constant->real8);
+ break;
+#endif
+
+ default:
+ assert ("bad REAL ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ckt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ *cptr = &constant->complex1;
+ *size = sizeof (constant->complex1);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ *cptr = &constant->complex2;
+ *size = sizeof (constant->complex2);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ *cptr = &constant->complex3;
+ *size = sizeof (constant->complex3);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ *cptr = &constant->complex4;
+ *size = sizeof (constant->complex4);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ *cptr = &constant->complex5;
+ *size = sizeof (constant->complex5);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ *cptr = &constant->complex6;
+ *size = sizeof (constant->complex6);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ *cptr = &constant->complex7;
+ *size = sizeof (constant->complex7);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ *cptr = &constant->complex8;
+ *size = sizeof (constant->complex8);
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ckt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ *cptr = ffetarget_text_character1 (constant->character1);
+ *size = ffetarget_length_character1 (constant->character1);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ *cptr = ffetarget_text_character2 (constant->character2);
+ *size = ffetarget_length_character2 (constant->character2);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ *cptr = ffetarget_text_character3 (constant->character3);
+ *size = ffetarget_length_character3 (constant->character3);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ *cptr = ffetarget_text_character4 (constant->character4);
+ *size = ffetarget_length_character4 (constant->character4);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ *cptr = ffetarget_text_character5 (constant->character5);
+ *size = ffetarget_length_character5 (constant->character5);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ *cptr = ffetarget_text_character6 (constant->character6);
+ *size = ffetarget_length_character6 (constant->character6);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ *cptr = ffetarget_text_character7 (constant->character7);
+ *size = ffetarget_length_character7 (constant->character7);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ *cptr = ffetarget_text_character8 (constant->character8);
+ *size = ffetarget_length_character8 (constant->character8);
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER ckindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad cbasictype" == NULL);
+ break;
+ }
+}
+
+/* ffebld_constantarray_put -- Put a value into an array of constants
+
+ See prototype. */
+
+void
+ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant)
+{
+ switch (bt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (kt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ *(array.integer1 + offset) = constant.integer1;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ *(array.integer2 + offset) = constant.integer2;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ *(array.integer3 + offset) = constant.integer3;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ *(array.integer4 + offset) = constant.integer4;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ *(array.integer5 + offset) = constant.integer5;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ *(array.integer6 + offset) = constant.integer6;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ *(array.integer7 + offset) = constant.integer7;
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ *(array.integer8 + offset) = constant.integer8;
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ *(array.logical1 + offset) = constant.logical1;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ *(array.logical2 + offset) = constant.logical2;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ *(array.logical3 + offset) = constant.logical3;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ *(array.logical4 + offset) = constant.logical4;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ *(array.logical5 + offset) = constant.logical5;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ *(array.logical6 + offset) = constant.logical6;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ *(array.logical7 + offset) = constant.logical7;
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ *(array.logical8 + offset) = constant.logical8;
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ *(array.real1 + offset) = constant.real1;
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ *(array.real2 + offset) = constant.real2;
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ *(array.real3 + offset) = constant.real3;
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ *(array.real4 + offset) = constant.real4;
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ *(array.real5 + offset) = constant.real5;
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ *(array.real6 + offset) = constant.real6;
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ *(array.real7 + offset) = constant.real7;
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ *(array.real8 + offset) = constant.real8;
+ break;
+#endif
+
+ default:
+ assert ("bad REAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ *(array.complex1 + offset) = constant.complex1;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ *(array.complex2 + offset) = constant.complex2;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ *(array.complex3 + offset) = constant.complex3;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ *(array.complex4 + offset) = constant.complex4;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ *(array.complex5 + offset) = constant.complex5;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ *(array.complex6 + offset) = constant.complex6;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ *(array.complex7 + offset) = constant.complex7;
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ *(array.complex8 + offset) = constant.complex8;
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (kt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ memcpy (array.character1 + offset,
+ ffetarget_text_character1 (constant.character1),
+ ffetarget_length_character1 (constant.character1));
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ memcpy (array.character2 + offset,
+ ffetarget_text_character2 (constant.character2),
+ ffetarget_length_character2 (constant.character2));
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ memcpy (array.character3 + offset,
+ ffetarget_text_character3 (constant.character3),
+ ffetarget_length_character3 (constant.character3));
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ memcpy (array.character4 + offset,
+ ffetarget_text_character4 (constant.character4),
+ ffetarget_length_character4 (constant.character4));
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ memcpy (array.character5 + offset,
+ ffetarget_text_character5 (constant.character5),
+ ffetarget_length_character5 (constant.character5));
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ memcpy (array.character6 + offset,
+ ffetarget_text_character6 (constant.character6),
+ ffetarget_length_character6 (constant.character6));
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ memcpy (array.character7 + offset,
+ ffetarget_text_character7 (constant.character7),
+ ffetarget_length_character7 (constant.character7));
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ memcpy (array.character8 + offset,
+ ffetarget_text_character8 (constant.character8),
+ ffetarget_length_character8 (constant.character8));
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad basictype" == NULL);
+ break;
+ }
+}
+
+/* ffebld_constantunion_dump -- Dump a constant
+
+ See prototype. */
+
+void
+ffebld_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt,
+ ffeinfoKindtype kt)
+{
+ switch (bt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (kt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ ffetarget_print_integer1 (dmpout, u.integer1);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ ffetarget_print_integer2 (dmpout, u.integer2);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ ffetarget_print_integer3 (dmpout, u.integer3);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ ffetarget_print_integer4 (dmpout, u.integer4);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ ffetarget_print_integer5 (dmpout, u.integer5);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ ffetarget_print_integer6 (dmpout, u.integer6);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ ffetarget_print_integer7 (dmpout, u.integer7);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ ffetarget_print_integer8 (dmpout, u.integer8);
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ ffetarget_print_logical1 (dmpout, u.logical1);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ ffetarget_print_logical2 (dmpout, u.logical2);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ ffetarget_print_logical3 (dmpout, u.logical3);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ ffetarget_print_logical4 (dmpout, u.logical4);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ ffetarget_print_logical5 (dmpout, u.logical5);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ ffetarget_print_logical6 (dmpout, u.logical6);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ ffetarget_print_logical7 (dmpout, u.logical7);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ ffetarget_print_logical8 (dmpout, u.logical8);
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ ffetarget_print_real1 (dmpout, u.real1);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ ffetarget_print_real2 (dmpout, u.real2);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ ffetarget_print_real3 (dmpout, u.real3);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ ffetarget_print_real4 (dmpout, u.real4);
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ ffetarget_print_real5 (dmpout, u.real5);
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ ffetarget_print_real6 (dmpout, u.real6);
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ ffetarget_print_real7 (dmpout, u.real7);
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ ffetarget_print_real8 (dmpout, u.real8);
+ break;
+#endif
+
+ default:
+ assert ("bad REAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ fprintf (dmpout, "(");
+ ffetarget_print_real1 (dmpout, u.complex1.real);
+ fprintf (dmpout, ",");
+ ffetarget_print_real1 (dmpout, u.complex1.imaginary);
+ fprintf (dmpout, ")");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ fprintf (dmpout, "(");
+ ffetarget_print_real2 (dmpout, u.complex2.real);
+ fprintf (dmpout, ",");
+ ffetarget_print_real2 (dmpout, u.complex2.imaginary);
+ fprintf (dmpout, ")");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ fprintf (dmpout, "(");
+ ffetarget_print_real3 (dmpout, u.complex3.real);
+ fprintf (dmpout, ",");
+ ffetarget_print_real3 (dmpout, u.complex3.imaginary);
+ fprintf (dmpout, ")");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ fprintf (dmpout, "(");
+ ffetarget_print_real4 (dmpout, u.complex4.real);
+ fprintf (dmpout, ",");
+ ffetarget_print_real4 (dmpout, u.complex4.imaginary);
+ fprintf (dmpout, ")");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ fprintf (dmpout, "(");
+ ffetarget_print_real5 (dmpout, u.complex5.real);
+ fprintf (dmpout, ",");
+ ffetarget_print_real5 (dmpout, u.complex5.imaginary);
+ fprintf (dmpout, ")");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ fprintf (dmpout, "(");
+ ffetarget_print_real6 (dmpout, u.complex6.real);
+ fprintf (dmpout, ",");
+ ffetarget_print_real6 (dmpout, u.complex6.imaginary);
+ fprintf (dmpout, ")");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ fprintf (dmpout, "(");
+ ffetarget_print_real7 (dmpout, u.complex7.real);
+ fprintf (dmpout, ",");
+ ffetarget_print_real7 (dmpout, u.complex7.imaginary);
+ fprintf (dmpout, ")");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ fprintf (dmpout, "(");
+ ffetarget_print_real8 (dmpout, u.complex8.real);
+ fprintf (dmpout, ",");
+ ffetarget_print_real8 (dmpout, u.complex8.imaginary);
+ fprintf (dmpout, ")");
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (kt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ ffetarget_print_character1 (dmpout, u.character1);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ ffetarget_print_character2 (dmpout, u.character2);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ ffetarget_print_character3 (dmpout, u.character3);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ ffetarget_print_character4 (dmpout, u.character4);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ ffetarget_print_character5 (dmpout, u.character5);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ ffetarget_print_character6 (dmpout, u.character6);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ ffetarget_print_character7 (dmpout, u.character7);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ ffetarget_print_character8 (dmpout, u.character8);
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad basictype" == NULL);
+ break;
+ }
+}
+
+/* ffebld_dump -- Dump expression tree in concise form
+
+ ffebld b;
+ ffebld_dump(b); */
+
+void
+ffebld_dump (ffebld b)
+{
+ ffeinfoKind k;
+ ffeinfoWhere w;
+
+ if (b == NULL)
+ {
+ fprintf (dmpout, "(null)");
+ return;
+ }
+
+ switch (ffebld_op (b))
+ {
+ case FFEBLD_opITEM:
+ fputs ("[", dmpout);
+ while (b != NULL)
+ {
+ ffebld_dump (ffebld_head (b));
+ if ((b = ffebld_trail (b)) != NULL)
+ fputs (",", dmpout);
+ }
+ fputs ("]", dmpout);
+ return;
+
+ case FFEBLD_opSTAR:
+ case FFEBLD_opBOUNDS:
+ case FFEBLD_opREPEAT:
+ case FFEBLD_opLABTER:
+ case FFEBLD_opLABTOK:
+ case FFEBLD_opIMPDO:
+ fputs (ffebld_op_string (ffebld_op (b)), dmpout);
+ break;
+
+ default:
+ if (ffeinfo_size (ffebld_info (b)) != FFETARGET_charactersizeNONE)
+ fprintf (dmpout, "%s%d%s%s*%" ffetargetCharacterSize_f "u",
+ ffebld_op_string (ffebld_op (b)),
+ (int) ffeinfo_rank (ffebld_info (b)),
+ ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))),
+ ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))),
+ ffeinfo_size (ffebld_info (b)));
+ else
+ fprintf (dmpout, "%s%d%s%s", ffebld_op_string (ffebld_op (b)),
+ (int) ffeinfo_rank (ffebld_info (b)),
+ ffeinfo_basictype_string (ffeinfo_basictype (ffebld_info (b))),
+ ffeinfo_kindtype_string (ffeinfo_kindtype (ffebld_info (b))));
+ if ((k = ffeinfo_kind (ffebld_info (b))) != FFEINFO_kindNONE)
+ fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
+ if ((w = ffeinfo_where (ffebld_info (b))) != FFEINFO_whereNONE)
+ fprintf (dmpout, "@%s", ffeinfo_where_string (w));
+ break;
+ }
+
+ switch (ffebld_arity (b))
+ {
+ case 2:
+ fputs ("(", dmpout);
+ ffebld_dump (ffebld_left (b));
+ fputs (",", dmpout);
+ ffebld_dump (ffebld_right (b));
+ fputs (")", dmpout);
+ break;
+
+ case 1:
+ fputs ("(", dmpout);
+ ffebld_dump (ffebld_left (b));
+ fputs (")", dmpout);
+ break;
+
+ default:
+ switch (ffebld_op (b))
+ {
+ case FFEBLD_opCONTER:
+ fprintf (dmpout, "<");
+ ffebld_constant_dump (b->u.conter.expr);
+ fprintf (dmpout, ">");
+ break;
+
+ case FFEBLD_opACCTER:
+ fprintf (dmpout, "<");
+ ffebld_constantarray_dump (b->u.accter.array,
+ ffeinfo_basictype (ffebld_info (b)),
+ ffeinfo_kindtype (ffebld_info (b)),
+ ffebit_size (b->u.accter.bits), b->u.accter.bits);
+ fprintf (dmpout, ">");
+ break;
+
+ case FFEBLD_opARRTER:
+ fprintf (dmpout, "<");
+ ffebld_constantarray_dump (b->u.arrter.array,
+ ffeinfo_basictype (ffebld_info (b)),
+ ffeinfo_kindtype (ffebld_info (b)),
+ b->u.arrter.size, NULL);
+ fprintf (dmpout, ">");
+ break;
+
+ case FFEBLD_opLABTER:
+ if (b->u.labter == NULL)
+ fprintf (dmpout, "<>");
+ else
+ fprintf (dmpout, "<%" ffelabValue_f "u>", ffelab_value (b->u.labter));
+ break;
+
+ case FFEBLD_opLABTOK:
+ fprintf (dmpout, "<%s>", ffelex_token_text (b->u.labtok));
+ break;
+
+ case FFEBLD_opSYMTER:
+ fprintf (dmpout, "<");
+ ffesymbol_dump (b->u.symter.symbol);
+ if ((b->u.symter.generic != FFEINTRIN_genNONE)
+ || (b->u.symter.specific != FFEINTRIN_specNONE))
+ fprintf (dmpout, "{%s:%s:%s}",
+ ffeintrin_name_generic (b->u.symter.generic),
+ ffeintrin_name_specific (b->u.symter.specific),
+ ffeintrin_name_implementation (b->u.symter.implementation));
+ if (b->u.symter.do_iter)
+ fprintf (dmpout, "{/do-iter}");
+ fprintf (dmpout, ">");
+ break;
+
+ default:
+ break;
+ }
+ }
+}
+
+/* ffebld_dump_prefix -- Dump the prefix for a constant of a given type
+
+ ffebld_dump_prefix(dmpout,FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGER1); */
+
+void
+ffebld_dump_prefix (FILE *out, ffeinfoBasictype bt, ffeinfoKindtype kt)
+{
+ switch (bt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (kt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ fprintf (out, "I" STRX (FFETARGET_kindINTEGER1) "/");
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ fprintf (out, "I" STRX (FFETARGET_kindINTEGER2) "/");
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ fprintf (out, "I" STRX (FFETARGET_kindINTEGER3) "/");
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ fprintf (out, "I" STRX (FFETARGET_kindINTEGER4) "/");
+ break;
+#endif
+
+#if FFETARGET_okINTEGER5
+ case FFEINFO_kindtypeINTEGER5:
+ fprintf (out, "I" STRX (FFETARGET_kindINTEGER5) "/");
+ break;
+#endif
+
+#if FFETARGET_okINTEGER6
+ case FFEINFO_kindtypeINTEGER6:
+ fprintf (out, "I" STRX (FFETARGET_kindINTEGER6) "/");
+ break;
+#endif
+
+#if FFETARGET_okINTEGER7
+ case FFEINFO_kindtypeINTEGER7:
+ fprintf (out, "I" STRX (FFETARGET_kindINTEGER7) "/");
+ break;
+#endif
+
+#if FFETARGET_okINTEGER8
+ case FFEINFO_kindtypeINTEGER8:
+ fprintf (out, "I" STRX (FFETARGET_kindINTEGER8) "/");
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ fprintf (out, "L" STRX (FFETARGET_kindLOGICAL1) "/");
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ fprintf (out, "L" STRX (FFETARGET_kindLOGICAL2) "/");
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ fprintf (out, "L" STRX (FFETARGET_kindLOGICAL3) "/");
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ fprintf (out, "L" STRX (FFETARGET_kindLOGICAL4) "/");
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL5
+ case FFEINFO_kindtypeLOGICAL5:
+ fprintf (out, "L" STRX (FFETARGET_kindLOGICAL5) "/");
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL6
+ case FFEINFO_kindtypeLOGICAL6:
+ fprintf (out, "L" STRX (FFETARGET_kindLOGICAL6) "/");
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL7
+ case FFEINFO_kindtypeLOGICAL7:
+ fprintf (out, "L" STRX (FFETARGET_kindLOGICAL7) "/");
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL8
+ case FFEINFO_kindtypeLOGICAL8:
+ fprintf (out, "L" STRX (FFETARGET_kindLOGICAL8) "/");
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ fprintf (out, "R" STRX (FFETARGET_kindREAL1) "/");
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ fprintf (out, "R" STRX (FFETARGET_kindREAL2) "/");
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ fprintf (out, "R" STRX (FFETARGET_kindREAL3) "/");
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ fprintf (out, "R" STRX (FFETARGET_kindREAL4) "/");
+ break;
+#endif
+
+#if FFETARGET_okREAL5
+ case FFEINFO_kindtypeREAL5:
+ fprintf (out, "R" STRX (FFETARGET_kindREAL5) "/");
+ break;
+#endif
+
+#if FFETARGET_okREAL6
+ case FFEINFO_kindtypeREAL6:
+ fprintf (out, "R" STRX (FFETARGET_kindREAL6) "/");
+ break;
+#endif
+
+#if FFETARGET_okREAL7
+ case FFEINFO_kindtypeREAL7:
+ fprintf (out, "R" STRX (FFETARGET_kindREAL7) "/");
+ break;
+#endif
+
+#if FFETARGET_okREAL8
+ case FFEINFO_kindtypeREAL8:
+ fprintf (out, "R" STRX (FFETARGET_kindREAL8) "/");
+ break;
+#endif
+
+ default:
+ assert ("bad REAL kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX1) "/");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX2) "/");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX3) "/");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX4) "/");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX5
+ case FFEINFO_kindtypeREAL5:
+ fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX5) "/");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX6
+ case FFEINFO_kindtypeREAL6:
+ fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX6) "/");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX7
+ case FFEINFO_kindtypeREAL7:
+ fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX7) "/");
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX8
+ case FFEINFO_kindtypeREAL8:
+ fprintf (out, "C" STRX (FFETARGET_kindCOMPLEX8) "/");
+ break;
+#endif
+
+ default:
+ assert ("bad COMPLEX kindtype" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (kt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ fprintf (out, "A" STRX (FFETARGET_kindCHARACTER1) "/");
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ fprintf (out, "A" STRX (FFETARGET_kindCHARACTER2) "/");
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ fprintf (out, "A" STRX (FFETARGET_kindCHARACTER3) "/");
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ fprintf (out, "A" STRX (FFETARGET_kindCHARACTER4) "/");
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER5
+ case FFEINFO_kindtypeCHARACTER5:
+ fprintf (out, "A" STRX (FFETARGET_kindCHARACTER5) "/");
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER6
+ case FFEINFO_kindtypeCHARACTER6:
+ fprintf (out, "A" STRX (FFETARGET_kindCHARACTER6) "/");
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER7
+ case FFEINFO_kindtypeCHARACTER7:
+ fprintf (out, "A" STRX (FFETARGET_kindCHARACTER7) "/");
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER8
+ case FFEINFO_kindtypeCHARACTER8:
+ fprintf (out, "A" STRX (FFETARGET_kindCHARACTER8) "/");
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER kindtype" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad basictype" == NULL);
+ fprintf (out, "?/?");
+ break;
+ }
+}
+
+/* ffebld_init_0 -- Initialize the module
+
+ ffebld_init_0(); */
+
+void
+ffebld_init_0 ()
+{
+ assert (FFEBLD_op == ARRAY_SIZE (ffebld_op_string_));
+ assert (FFEBLD_op == ARRAY_SIZE (ffebld_arity_op_));
+}
+
+/* ffebld_init_1 -- Initialize the module for a file
+
+ ffebld_init_1(); */
+
+void
+ffebld_init_1 ()
+{
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
+ int i;
+
+#if FFETARGET_okCHARACTER1
+ ffebld_constant_character1_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER2
+ ffebld_constant_character2_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER3
+ ffebld_constant_character3_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER4
+ ffebld_constant_character4_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER5
+ ffebld_constant_character5_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER6
+ ffebld_constant_character6_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER7
+ ffebld_constant_character7_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER8
+ ffebld_constant_character8_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX1
+ ffebld_constant_complex1_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX2
+ ffebld_constant_complex2_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX3
+ ffebld_constant_complex3_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX4
+ ffebld_constant_complex4_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX5
+ ffebld_constant_complex5_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX6
+ ffebld_constant_complex6_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX7
+ ffebld_constant_complex7_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX8
+ ffebld_constant_complex8_ = NULL;
+#endif
+#if FFETARGET_okINTEGER1
+ ffebld_constant_integer1_ = NULL;
+#endif
+#if FFETARGET_okINTEGER2
+ ffebld_constant_integer2_ = NULL;
+#endif
+#if FFETARGET_okINTEGER3
+ ffebld_constant_integer3_ = NULL;
+#endif
+#if FFETARGET_okINTEGER4
+ ffebld_constant_integer4_ = NULL;
+#endif
+#if FFETARGET_okINTEGER5
+ ffebld_constant_integer5_ = NULL;
+#endif
+#if FFETARGET_okINTEGER6
+ ffebld_constant_integer6_ = NULL;
+#endif
+#if FFETARGET_okINTEGER7
+ ffebld_constant_integer7_ = NULL;
+#endif
+#if FFETARGET_okINTEGER8
+ ffebld_constant_integer8_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL1
+ ffebld_constant_logical1_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL2
+ ffebld_constant_logical2_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL3
+ ffebld_constant_logical3_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL4
+ ffebld_constant_logical4_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL5
+ ffebld_constant_logical5_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL6
+ ffebld_constant_logical6_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL7
+ ffebld_constant_logical7_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL8
+ ffebld_constant_logical8_ = NULL;
+#endif
+#if FFETARGET_okREAL1
+ ffebld_constant_real1_ = NULL;
+#endif
+#if FFETARGET_okREAL2
+ ffebld_constant_real2_ = NULL;
+#endif
+#if FFETARGET_okREAL3
+ ffebld_constant_real3_ = NULL;
+#endif
+#if FFETARGET_okREAL4
+ ffebld_constant_real4_ = NULL;
+#endif
+#if FFETARGET_okREAL5
+ ffebld_constant_real5_ = NULL;
+#endif
+#if FFETARGET_okREAL6
+ ffebld_constant_real6_ = NULL;
+#endif
+#if FFETARGET_okREAL7
+ ffebld_constant_real7_ = NULL;
+#endif
+#if FFETARGET_okREAL8
+ ffebld_constant_real8_ = NULL;
+#endif
+ ffebld_constant_hollerith_ = NULL;
+ for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
+ ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
+#endif
+}
+
+/* ffebld_init_2 -- Initialize the module
+
+ ffebld_init_2(); */
+
+void
+ffebld_init_2 ()
+{
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
+ int i;
+#endif
+
+ ffebld_pool_stack_.next = NULL;
+ ffebld_pool_stack_.pool = ffe_pool_program_unit ();
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
+#if FFETARGET_okCHARACTER1
+ ffebld_constant_character1_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER2
+ ffebld_constant_character2_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER3
+ ffebld_constant_character3_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER4
+ ffebld_constant_character4_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER5
+ ffebld_constant_character5_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER6
+ ffebld_constant_character6_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER7
+ ffebld_constant_character7_ = NULL;
+#endif
+#if FFETARGET_okCHARACTER8
+ ffebld_constant_character8_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX1
+ ffebld_constant_complex1_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX2
+ ffebld_constant_complex2_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX3
+ ffebld_constant_complex3_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX4
+ ffebld_constant_complex4_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX5
+ ffebld_constant_complex5_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX6
+ ffebld_constant_complex6_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX7
+ ffebld_constant_complex7_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX8
+ ffebld_constant_complex8_ = NULL;
+#endif
+#if FFETARGET_okINTEGER1
+ ffebld_constant_integer1_ = NULL;
+#endif
+#if FFETARGET_okINTEGER2
+ ffebld_constant_integer2_ = NULL;
+#endif
+#if FFETARGET_okINTEGER3
+ ffebld_constant_integer3_ = NULL;
+#endif
+#if FFETARGET_okINTEGER4
+ ffebld_constant_integer4_ = NULL;
+#endif
+#if FFETARGET_okINTEGER5
+ ffebld_constant_integer5_ = NULL;
+#endif
+#if FFETARGET_okINTEGER6
+ ffebld_constant_integer6_ = NULL;
+#endif
+#if FFETARGET_okINTEGER7
+ ffebld_constant_integer7_ = NULL;
+#endif
+#if FFETARGET_okINTEGER8
+ ffebld_constant_integer8_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL1
+ ffebld_constant_logical1_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL2
+ ffebld_constant_logical2_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL3
+ ffebld_constant_logical3_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL4
+ ffebld_constant_logical4_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL5
+ ffebld_constant_logical5_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL6
+ ffebld_constant_logical6_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL7
+ ffebld_constant_logical7_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL8
+ ffebld_constant_logical8_ = NULL;
+#endif
+#if FFETARGET_okREAL1
+ ffebld_constant_real1_ = NULL;
+#endif
+#if FFETARGET_okREAL2
+ ffebld_constant_real2_ = NULL;
+#endif
+#if FFETARGET_okREAL3
+ ffebld_constant_real3_ = NULL;
+#endif
+#if FFETARGET_okREAL4
+ ffebld_constant_real4_ = NULL;
+#endif
+#if FFETARGET_okREAL5
+ ffebld_constant_real5_ = NULL;
+#endif
+#if FFETARGET_okREAL6
+ ffebld_constant_real6_ = NULL;
+#endif
+#if FFETARGET_okREAL7
+ ffebld_constant_real7_ = NULL;
+#endif
+#if FFETARGET_okREAL8
+ ffebld_constant_real8_ = NULL;
+#endif
+ ffebld_constant_hollerith_ = NULL;
+ for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
+ ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
+#endif
+}
+
+/* ffebld_list_length -- Return # of opITEMs in list
+
+ ffebld list; // Must be NULL or opITEM
+ ffebldListLength length;
+ length = ffebld_list_length(list);
+
+ Returns 0 if list is NULL, 1 if it's ffebld_trail is NULL, and so on. */
+
+ffebldListLength
+ffebld_list_length (ffebld list)
+{
+ ffebldListLength length;
+
+ for (length = 0; list != NULL; ++length, list = ffebld_trail (list))
+ ;
+
+ return length;
+}
+
+/* ffebld_new_accter -- Create an ffebld object that is an array
+
+ ffebld x;
+ ffebldConstantArray a;
+ ffebit b;
+ x = ffebld_new_accter(a,b); */
+
+ffebld
+ffebld_new_accter (ffebldConstantArray a, ffebit b)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = FFEBLD_opACCTER;
+ x->u.accter.array = a;
+ x->u.accter.bits = b;
+ return x;
+}
+
+/* ffebld_new_arrter -- Create an ffebld object that is an array
+
+ ffebld x;
+ ffebldConstantArray a;
+ ffetargetOffset size;
+ x = ffebld_new_arrter(a,size); */
+
+ffebld
+ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = FFEBLD_opARRTER;
+ x->u.arrter.array = a;
+ x->u.arrter.size = size;
+ return x;
+}
+
+/* ffebld_new_conter_with_orig -- Create an ffebld object that is a constant
+
+ ffebld x;
+ ffebldConstant c;
+ x = ffebld_new_conter_with_orig(c,NULL); */
+
+ffebld
+ffebld_new_conter_with_orig (ffebldConstant c, ffebld o)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = FFEBLD_opCONTER;
+ x->u.conter.expr = c;
+ x->u.conter.orig = o;
+ return x;
+}
+
+/* ffebld_new_item -- Create an ffebld item object
+
+ ffebld x,y,z;
+ x = ffebld_new_item(y,z); */
+
+ffebld
+ffebld_new_item (ffebld head, ffebld trail)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = FFEBLD_opITEM;
+ x->u.item.head = head;
+ x->u.item.trail = trail;
+ return x;
+}
+
+/* ffebld_new_labter -- Create an ffebld object that is a label
+
+ ffebld x;
+ ffelab l;
+ x = ffebld_new_labter(c); */
+
+ffebld
+ffebld_new_labter (ffelab l)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = FFEBLD_opLABTER;
+ x->u.labter = l;
+ return x;
+}
+
+/* ffebld_new_labtok -- Create object that is a label's NUMBER token
+
+ ffebld x;
+ ffelexToken t;
+ x = ffebld_new_labter(c);
+
+ Like the other ffebld_new_ functions, the
+ supplied argument is stored exactly as is: ffelex_token_use is NOT
+ called, so the token is "consumed", if one is indeed supplied (it may
+ be NULL). */
+
+ffebld
+ffebld_new_labtok (ffelexToken t)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = FFEBLD_opLABTOK;
+ x->u.labtok = t;
+ return x;
+}
+
+/* ffebld_new_none -- Create an ffebld object with no arguments
+
+ ffebld x;
+ x = ffebld_new_none(FFEBLD_opWHATEVER); */
+
+ffebld
+ffebld_new_none (ffebldOp o)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = o;
+ return x;
+}
+
+/* ffebld_new_one -- Create an ffebld object with one argument
+
+ ffebld x,y;
+ x = ffebld_new_one(FFEBLD_opWHATEVER,y); */
+
+ffebld
+ffebld_new_one (ffebldOp o, ffebld left)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = o;
+ x->u.nonter.left = left;
+ return x;
+}
+
+/* ffebld_new_symter -- Create an ffebld object that is a symbol
+
+ ffebld x;
+ ffesymbol s;
+ ffeintrinGen gen; // Generic intrinsic id, if any
+ ffeintrinSpec spec; // Specific intrinsic id, if any
+ ffeintrinImp imp; // Implementation intrinsic id, if any
+ x = ffebld_new_symter (s, gen, spec, imp); */
+
+ffebld
+ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
+ ffeintrinImp imp)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = FFEBLD_opSYMTER;
+ x->u.symter.symbol = s;
+ x->u.symter.generic = gen;
+ x->u.symter.specific = spec;
+ x->u.symter.implementation = imp;
+ x->u.symter.do_iter = FALSE;
+ return x;
+}
+
+/* ffebld_new_two -- Create an ffebld object with two arguments
+
+ ffebld x,y,z;
+ x = ffebld_new_two(FFEBLD_opWHATEVER,y,z); */
+
+ffebld
+ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
+{
+ ffebld x;
+
+ x = ffebld_new ();
+#if FFEBLD_BLANK_
+ *x = ffebld_blank_;
+#endif
+ x->op = o;
+ x->u.nonter.left = left;
+ x->u.nonter.right = right;
+ return x;
+}
+
+/* ffebld_pool_pop -- Pop ffebld's pool stack
+
+ ffebld_pool_pop(); */
+
+void
+ffebld_pool_pop ()
+{
+ ffebldPoolstack_ ps;
+
+ assert (ffebld_pool_stack_.next != NULL);
+ ps = ffebld_pool_stack_.next;
+ ffebld_pool_stack_.next = ps->next;
+ ffebld_pool_stack_.pool = ps->pool;
+ malloc_kill_ks (malloc_pool_image (), ps, sizeof (*ps));
+}
+
+/* ffebld_pool_push -- Push ffebld's pool stack
+
+ ffebld_pool_push(); */
+
+void
+ffebld_pool_push (mallocPool pool)
+{
+ ffebldPoolstack_ ps;
+
+ ps = malloc_new_ks (malloc_pool_image (), "Pool stack", sizeof (*ps));
+ ps->next = ffebld_pool_stack_.next;
+ ps->pool = ffebld_pool_stack_.pool;
+ ffebld_pool_stack_.next = ps;
+ ffebld_pool_stack_.pool = pool;
+}
+
+/* ffebld_op_string -- Return short string describing op
+
+ ffebldOp o;
+ ffebld_op_string(o);
+
+ Returns a short string (uppercase) containing the name of the op. */
+
+char *
+ffebld_op_string (ffebldOp o)
+{
+ if (o >= ARRAY_SIZE (ffebld_op_string_))
+ return "?\?\?";
+ return ffebld_op_string_[o];
+}
+
+/* ffebld_size_max -- Return maximum possible size of CHARACTER-type expr
+
+ ffetargetCharacterSize sz;
+ ffebld b;
+ sz = ffebld_size_max (b);
+
+ Like ffebld_size_known, but if that would return NONE and the expression
+ is opSUBSTR, opCONVERT, opPAREN, or opCONCATENATE, returns ffebld_size_max
+ of the subexpression(s). */
+
+ffetargetCharacterSize
+ffebld_size_max (ffebld b)
+{
+ ffetargetCharacterSize sz;
+
+recurse: /* :::::::::::::::::::: */
+
+ sz = ffebld_size_known (b);
+
+ if (sz != FFETARGET_charactersizeNONE)
+ return sz;
+
+ switch (ffebld_op (b))
+ {
+ case FFEBLD_opSUBSTR:
+ case FFEBLD_opCONVERT:
+ case FFEBLD_opPAREN:
+ b = ffebld_left (b);
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFEBLD_opCONCATENATE:
+ sz = ffebld_size_max (ffebld_left (b))
+ + ffebld_size_max (ffebld_right (b));
+ return sz;
+
+ default:
+ return sz;
+ }
+}
diff --git a/gcc/f/bld.h b/gcc/f/bld.h
new file mode 100644
index 00000000000..a9dbe9f2e03
--- /dev/null
+++ b/gcc/f/bld.h
@@ -0,0 +1,1009 @@
+/* bld.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ bld.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_bld
+#define _H_f_bld
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFEBLD_constNONE,
+ FFEBLD_constINTEGER1,
+ FFEBLD_constINTEGER2,
+ FFEBLD_constINTEGER3,
+ FFEBLD_constINTEGER4,
+ FFEBLD_constINTEGER5,
+ FFEBLD_constINTEGER6,
+ FFEBLD_constINTEGER7,
+ FFEBLD_constINTEGER8,
+ FFEBLD_constLOGICAL1,
+ FFEBLD_constLOGICAL2,
+ FFEBLD_constLOGICAL3,
+ FFEBLD_constLOGICAL4,
+ FFEBLD_constLOGICAL5,
+ FFEBLD_constLOGICAL6,
+ FFEBLD_constLOGICAL7,
+ FFEBLD_constLOGICAL8,
+ FFEBLD_constREAL1,
+ FFEBLD_constREAL2,
+ FFEBLD_constREAL3,
+ FFEBLD_constREAL4,
+ FFEBLD_constREAL5,
+ FFEBLD_constREAL6,
+ FFEBLD_constREAL7,
+ FFEBLD_constREAL8,
+ FFEBLD_constCOMPLEX1,
+ FFEBLD_constCOMPLEX2,
+ FFEBLD_constCOMPLEX3,
+ FFEBLD_constCOMPLEX4,
+ FFEBLD_constCOMPLEX5,
+ FFEBLD_constCOMPLEX6,
+ FFEBLD_constCOMPLEX7,
+ FFEBLD_constCOMPLEX8,
+ FFEBLD_constCHARACTER1,
+ FFEBLD_constCHARACTER2,
+ FFEBLD_constCHARACTER3,
+ FFEBLD_constCHARACTER4,
+ FFEBLD_constCHARACTER5,
+ FFEBLD_constCHARACTER6,
+ FFEBLD_constCHARACTER7,
+ FFEBLD_constCHARACTER8,
+ FFEBLD_constHOLLERITH,
+ FFEBLD_constTYPELESS_FIRST,
+ FFEBLD_constBINARY_MIL = FFEBLD_constTYPELESS_FIRST,
+ FFEBLD_constBINARY_VXT,
+ FFEBLD_constOCTAL_MIL,
+ FFEBLD_constOCTAL_VXT,
+ FFEBLD_constHEX_X_MIL,
+ FFEBLD_constHEX_X_VXT,
+ FFEBLD_constHEX_Z_MIL,
+ FFEBLD_constHEX_Z_VXT,
+ FFEBLD_constTYPELESS_LAST = FFEBLD_constHEX_Z_VXT,
+ FFEBLD_const
+ } ffebldConst;
+
+typedef enum
+ {
+#define FFEBLD_OP(KWD,NAME,ARITY) KWD,
+#include "bld-op.def"
+#undef FFEBLD_OP
+ FFEBLD_op
+ } ffebldOp;
+
+/* Typedefs. */
+
+typedef struct _ffebld_ *ffebld;
+typedef unsigned char ffebldArity;
+typedef union _ffebld_constant_array_ ffebldConstantArray;
+typedef struct _ffebld_constant_ *ffebldConstant;
+typedef union _ffebld_constant_union_ ffebldConstantUnion;
+typedef ffebld *ffebldListBottom;
+typedef unsigned int ffebldListLength;
+#define ffebldListLength_f ""
+typedef struct _ffebld_pool_stack_ *ffebldPoolstack_;
+
+/* Include files needed by this one. */
+
+#include "bit.h"
+#include "com.h"
+#include "info.h"
+#include "intrin.h"
+#include "lab.h"
+#include "lex.h"
+#include "malloc.h"
+#include "symbol.h"
+#include "target.h"
+
+#define FFEBLD_whereconstPROGUNIT_ 1
+#define FFEBLD_whereconstFILE_ 2
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstPROGUNIT_
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_
+#else
+#error
+#endif
+
+/* Structure definitions. */
+
+#define FFEBLD_constINTEGERDEFAULT FFEBLD_constINTEGER1
+#define FFEBLD_constLOGICALDEFAULT FFEBLD_constLOGICAL1
+#define FFEBLD_constREALDEFAULT FFEBLD_constREAL1
+#define FFEBLD_constREALDOUBLE FFEBLD_constREAL2
+#define FFEBLD_constREALQUAD FFEBLD_constREAL3
+#define FFEBLD_constCOMPLEX FFEBLD_constCOMPLEX1
+#define FFEBLD_constCOMPLEXDOUBLE FFEBLD_constCOMPLEX2
+#define FFEBLD_constCOMPLEXQUAD FFEBLD_constCOMPLEX3
+#define FFEBLD_constCHARACTERDEFAULT FFEBLD_constCHARACTER1
+
+union _ffebld_constant_union_
+ {
+ ffetargetTypeless typeless;
+ ffetargetHollerith hollerith;
+#if FFETARGET_okINTEGER1
+ ffetargetInteger1 integer1;
+#endif
+#if FFETARGET_okINTEGER2
+ ffetargetInteger2 integer2;
+#endif
+#if FFETARGET_okINTEGER3
+ ffetargetInteger3 integer3;
+#endif
+#if FFETARGET_okINTEGER4
+ ffetargetInteger4 integer4;
+#endif
+#if FFETARGET_okINTEGER5
+ ffetargetInteger5 integer5;
+#endif
+#if FFETARGET_okINTEGER6
+ ffetargetInteger6 integer6;
+#endif
+#if FFETARGET_okINTEGER7
+ ffetargetInteger7 integer7;
+#endif
+#if FFETARGET_okINTEGER8
+ ffetargetInteger8 integer8;
+#endif
+#if FFETARGET_okLOGICAL1
+ ffetargetLogical1 logical1;
+#endif
+#if FFETARGET_okLOGICAL2
+ ffetargetLogical2 logical2;
+#endif
+#if FFETARGET_okLOGICAL3
+ ffetargetLogical3 logical3;
+#endif
+#if FFETARGET_okLOGICAL4
+ ffetargetLogical4 logical4;
+#endif
+#if FFETARGET_okLOGICAL5
+ ffetargetLogical5 logical5;
+#endif
+#if FFETARGET_okLOGICAL6
+ ffetargetLogical6 logical6;
+#endif
+#if FFETARGET_okLOGICAL7
+ ffetargetLogical7 logical7;
+#endif
+#if FFETARGET_okLOGICAL8
+ ffetargetLogical8 logical8;
+#endif
+#if FFETARGET_okREAL1
+ ffetargetReal1 real1;
+#endif
+#if FFETARGET_okREAL2
+ ffetargetReal2 real2;
+#endif
+#if FFETARGET_okREAL3
+ ffetargetReal3 real3;
+#endif
+#if FFETARGET_okREAL4
+ ffetargetReal4 real4;
+#endif
+#if FFETARGET_okREAL5
+ ffetargetReal5 real5;
+#endif
+#if FFETARGET_okREAL6
+ ffetargetReal6 real6;
+#endif
+#if FFETARGET_okREAL7
+ ffetargetReal7 real7;
+#endif
+#if FFETARGET_okREAL8
+ ffetargetReal8 real8;
+#endif
+#if FFETARGET_okCOMPLEX1
+ ffetargetComplex1 complex1;
+#endif
+#if FFETARGET_okCOMPLEX2
+ ffetargetComplex2 complex2;
+#endif
+#if FFETARGET_okCOMPLEX3
+ ffetargetComplex3 complex3;
+#endif
+#if FFETARGET_okCOMPLEX4
+ ffetargetComplex4 complex4;
+#endif
+#if FFETARGET_okCOMPLEX5
+ ffetargetComplex5 complex5;
+#endif
+#if FFETARGET_okCOMPLEX6
+ ffetargetComplex6 complex6;
+#endif
+#if FFETARGET_okCOMPLEX7
+ ffetargetComplex7 complex7;
+#endif
+#if FFETARGET_okCOMPLEX8
+ ffetargetComplex8 complex8;
+#endif
+#if FFETARGET_okCHARACTER1
+ ffetargetCharacter1 character1;
+#endif
+#if FFETARGET_okCHARACTER2
+ ffetargetCharacter2 character2;
+#endif
+#if FFETARGET_okCHARACTER3
+ ffetargetCharacter3 character3;
+#endif
+#if FFETARGET_okCHARACTER4
+ ffetargetCharacter4 character4;
+#endif
+#if FFETARGET_okCHARACTER5
+ ffetargetCharacter5 character5;
+#endif
+#if FFETARGET_okCHARACTER6
+ ffetargetCharacter6 character6;
+#endif
+#if FFETARGET_okCHARACTER7
+ ffetargetCharacter7 character7;
+#endif
+#if FFETARGET_okCHARACTER8
+ ffetargetCharacter8 character8;
+#endif
+ };
+
+union _ffebld_constant_array_
+ {
+#if FFETARGET_okINTEGER1
+ ffetargetInteger1 *integer1;
+#endif
+#if FFETARGET_okINTEGER2
+ ffetargetInteger2 *integer2;
+#endif
+#if FFETARGET_okINTEGER3
+ ffetargetInteger3 *integer3;
+#endif
+#if FFETARGET_okINTEGER4
+ ffetargetInteger4 *integer4;
+#endif
+#if FFETARGET_okINTEGER5
+ ffetargetInteger5 *integer5;
+#endif
+#if FFETARGET_okINTEGER6
+ ffetargetInteger6 *integer6;
+#endif
+#if FFETARGET_okINTEGER7
+ ffetargetInteger7 *integer7;
+#endif
+#if FFETARGET_okINTEGER8
+ ffetargetInteger8 *integer8;
+#endif
+#if FFETARGET_okLOGICAL1
+ ffetargetLogical1 *logical1;
+#endif
+#if FFETARGET_okLOGICAL2
+ ffetargetLogical2 *logical2;
+#endif
+#if FFETARGET_okLOGICAL3
+ ffetargetLogical3 *logical3;
+#endif
+#if FFETARGET_okLOGICAL4
+ ffetargetLogical4 *logical4;
+#endif
+#if FFETARGET_okLOGICAL5
+ ffetargetLogical5 *logical5;
+#endif
+#if FFETARGET_okLOGICAL6
+ ffetargetLogical6 *logical6;
+#endif
+#if FFETARGET_okLOGICAL7
+ ffetargetLogical7 *logical7;
+#endif
+#if FFETARGET_okLOGICAL8
+ ffetargetLogical8 *logical8;
+#endif
+#if FFETARGET_okREAL1
+ ffetargetReal1 *real1;
+#endif
+#if FFETARGET_okREAL2
+ ffetargetReal2 *real2;
+#endif
+#if FFETARGET_okREAL3
+ ffetargetReal3 *real3;
+#endif
+#if FFETARGET_okREAL4
+ ffetargetReal4 *real4;
+#endif
+#if FFETARGET_okREAL5
+ ffetargetReal5 *real5;
+#endif
+#if FFETARGET_okREAL6
+ ffetargetReal6 *real6;
+#endif
+#if FFETARGET_okREAL7
+ ffetargetReal7 *real7;
+#endif
+#if FFETARGET_okREAL8
+ ffetargetReal8 *real8;
+#endif
+#if FFETARGET_okCOMPLEX1
+ ffetargetComplex1 *complex1;
+#endif
+#if FFETARGET_okCOMPLEX2
+ ffetargetComplex2 *complex2;
+#endif
+#if FFETARGET_okCOMPLEX3
+ ffetargetComplex3 *complex3;
+#endif
+#if FFETARGET_okCOMPLEX4
+ ffetargetComplex4 *complex4;
+#endif
+#if FFETARGET_okCOMPLEX5
+ ffetargetComplex5 *complex5;
+#endif
+#if FFETARGET_okCOMPLEX6
+ ffetargetComplex6 *complex6;
+#endif
+#if FFETARGET_okCOMPLEX7
+ ffetargetComplex7 *complex7;
+#endif
+#if FFETARGET_okCOMPLEX8
+ ffetargetComplex8 *complex8;
+#endif
+#if FFETARGET_okCHARACTER1
+ ffetargetCharacterUnit1 *character1;
+#endif
+#if FFETARGET_okCHARACTER2
+ ffetargetCharacterUnit2 *character2;
+#endif
+#if FFETARGET_okCHARACTER3
+ ffetargetCharacterUnit3 *character3;
+#endif
+#if FFETARGET_okCHARACTER4
+ ffetargetCharacterUnit4 *character4;
+#endif
+#if FFETARGET_okCHARACTER5
+ ffetargetCharacterUnit5 *character5;
+#endif
+#if FFETARGET_okCHARACTER6
+ ffetargetCharacterUnit6 *character6;
+#endif
+#if FFETARGET_okCHARACTER7
+ ffetargetCharacterUnit7 *character7;
+#endif
+#if FFETARGET_okCHARACTER8
+ ffetargetCharacterUnit8 *character8;
+#endif
+ };
+
+struct _ffebld_
+ {
+ ffebldOp op;
+ ffeinfo info; /* Not used or valid for
+ op=={STAR,ITEM,BOUNDS,REPEAT,LABTER,
+ LABTOK,IMPDO}. */
+ union
+ {
+ struct
+ {
+ ffebld left;
+ ffebld right;
+ }
+ nonter;
+ struct
+ {
+ ffebld head;
+ ffebld trail;
+ }
+ item;
+ struct
+ {
+ ffebldConstant expr;
+ ffebld orig; /* Original expression, or NULL if none. */
+ }
+ conter;
+ struct
+ {
+ ffebldConstantArray array;
+ ffetargetOffset size;
+ }
+ arrter;
+ struct
+ {
+ ffebldConstantArray array;
+ ffebit bits;
+ }
+ accter;
+ struct
+ {
+ ffesymbol symbol;
+ ffeintrinGen generic; /* Id for generic intrinsic. */
+ ffeintrinSpec specific; /* Id for specific intrinsic. */
+ ffeintrinImp implementation; /* Id for implementation. */
+ bool do_iter; /* TRUE if this ref is a read-only ref by
+ definition (ref within DO loop using this
+ var as iterator). */
+ }
+ symter;
+ ffelab labter;
+ ffelexToken labtok;
+ }
+ u;
+ };
+
+struct _ffebld_constant_
+ {
+ ffebldConstant next;
+ ffebldConstant first_complex; /* First complex const with me as
+ real. */
+ ffebldConstant negated; /* We point to each other through here. */
+ ffebldConst consttype;
+#ifdef FFECOM_constantHOOK
+ ffecomConstant hook; /* Whatever the compiler/backend wants! */
+#endif
+ bool numeric; /* A numeric kind of constant. */
+ ffebldConstantUnion u;
+ };
+
+struct _ffebld_pool_stack_
+ {
+ ffebldPoolstack_ next;
+ mallocPool pool;
+ };
+
+/* Global objects accessed by users of this module. */
+
+extern ffebldArity ffebld_arity_op_[];
+extern struct _ffebld_pool_stack_ ffebld_pool_stack_;
+
+/* Declare functions with prototypes. */
+
+int ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2);
+void ffebld_constant_dump (ffebldConstant c);
+bool ffebld_constant_is_magical (ffebldConstant c);
+bool ffebld_constant_is_zero (ffebldConstant c);
+#if FFETARGET_okCHARACTER1
+ffebldConstant ffebld_constant_new_character1 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character1_val (ffetargetCharacter1 val);
+#endif
+#if FFETARGET_okCHARACTER2
+ffebldConstant ffebld_constant_new_character2 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character2_val (ffetargetCharacter2 val);
+#endif
+#if FFETARGET_okCHARACTER3
+ffebldConstant ffebld_constant_new_character3 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character3_val (ffetargetCharacter3 val);
+#endif
+#if FFETARGET_okCHARACTER4
+ffebldConstant ffebld_constant_new_character4 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character4_val (ffetargetCharacter4 val);
+#endif
+#if FFETARGET_okCHARACTER5
+ffebldConstant ffebld_constant_new_character5 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character5_val (ffetargetCharacter5 val);
+#endif
+#if FFETARGET_okCHARACTER6
+ffebldConstant ffebld_constant_new_character6 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character6_val (ffetargetCharacter6 val);
+#endif
+#if FFETARGET_okCHARACTER7
+ffebldConstant ffebld_constant_new_character7 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character7_val (ffetargetCharacter7 val);
+#endif
+#if FFETARGET_okCHARACTER8
+ffebldConstant ffebld_constant_new_character8 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character8_val (ffetargetCharacter8 val);
+#endif
+#if FFETARGET_okCOMPLEX1
+ffebldConstant ffebld_constant_new_complex1 (ffebldConstant real,
+ ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex1_val (ffetargetComplex1 val);
+#endif
+#if FFETARGET_okCOMPLEX2
+ffebldConstant ffebld_constant_new_complex2 (ffebldConstant real,
+ ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex2_val (ffetargetComplex2 val);
+#endif
+#if FFETARGET_okCOMPLEX3
+ffebldConstant ffebld_constant_new_complex3 (ffebldConstant real,
+ ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex3_val (ffetargetComplex3 val);
+#endif
+#if FFETARGET_okCOMPLEX4
+ffebldConstant ffebld_constant_new_complex4 (ffebldConstant real,
+ ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex4_val (ffetargetComplex4 val);
+#endif
+#if FFETARGET_okCOMPLEX5
+ffebldConstant ffebld_constant_new_complex5 (ffebldConstant real,
+ ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex5_val (ffetargetComplex5 val);
+#endif
+#if FFETARGET_okCOMPLEX6
+ffebldConstant ffebld_constant_new_complex6 (ffebldConstant real,
+ ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex6_val (ffetargetComplex6 val);
+#endif
+#if FFETARGET_okCOMPLEX7
+ffebldConstant ffebld_constant_new_complex7 (ffebldConstant real,
+ ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex7_val (ffetargetComplex7 val);
+#endif
+#if FFETARGET_okCOMPLEX8
+ffebldConstant ffebld_constant_new_complex8 (ffebldConstant real,
+ ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex8_val (ffetargetComplex8 val);
+#endif
+ffebldConstant ffebld_constant_new_hollerith (ffelexToken t);
+ffebldConstant ffebld_constant_new_hollerith_val (ffetargetHollerith val);
+#if FFETARGET_okINTEGER1
+ffebldConstant ffebld_constant_new_integer1 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer1_val (ffetargetInteger1 val);
+#endif
+#if FFETARGET_okINTEGER2
+ffebldConstant ffebld_constant_new_integer2 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer2_val (ffetargetInteger2 val);
+#endif
+#if FFETARGET_okINTEGER3
+ffebldConstant ffebld_constant_new_integer3 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer3_val (ffetargetInteger3 val);
+#endif
+#if FFETARGET_okINTEGER4
+ffebldConstant ffebld_constant_new_integer4 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer4_val (ffetargetInteger4 val);
+#endif
+#if FFETARGET_okINTEGER5
+ffebldConstant ffebld_constant_new_integer5 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer5_val (ffetargetInteger5 val);
+#endif
+#if FFETARGET_okINTEGER6
+ffebldConstant ffebld_constant_new_integer6 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer6_val (ffetargetInteger6 val);
+#endif
+#if FFETARGET_okINTEGER7
+ffebldConstant ffebld_constant_new_integer7 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer7_val (ffetargetInteger7 val);
+#endif
+#if FFETARGET_okINTEGER8
+ffebldConstant ffebld_constant_new_integer8 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer8_val (ffetargetInteger8 val);
+#endif
+ffebldConstant ffebld_constant_new_integerbinary (ffelexToken t);
+ffebldConstant ffebld_constant_new_integerhex (ffelexToken t);
+ffebldConstant ffebld_constant_new_integeroctal (ffelexToken t);
+#if FFETARGET_okLOGICAL1
+ffebldConstant ffebld_constant_new_logical1 (bool truth);
+ffebldConstant ffebld_constant_new_logical1_val (ffetargetLogical1 val);
+#endif
+#if FFETARGET_okLOGICAL2
+ffebldConstant ffebld_constant_new_logical2 (bool truth);
+ffebldConstant ffebld_constant_new_logical2_val (ffetargetLogical2 val);
+#endif
+#if FFETARGET_okLOGICAL3
+ffebldConstant ffebld_constant_new_logical3 (bool truth);
+ffebldConstant ffebld_constant_new_logical3_val (ffetargetLogical3 val);
+#endif
+#if FFETARGET_okLOGICAL4
+ffebldConstant ffebld_constant_new_logical4 (bool truth);
+ffebldConstant ffebld_constant_new_logical4_val (ffetargetLogical4 val);
+#endif
+#if FFETARGET_okLOGICAL5
+ffebldConstant ffebld_constant_new_logical5 (bool truth);
+ffebldConstant ffebld_constant_new_logical5_val (ffetargetLogical5 val);
+#endif
+#if FFETARGET_okLOGICAL6
+ffebldConstant ffebld_constant_new_logical6 (bool truth);
+ffebldConstant ffebld_constant_new_logical6_val (ffetargetLogical6 val);
+#endif
+#if FFETARGET_okLOGICAL7
+ffebldConstant ffebld_constant_new_logical7 (bool truth);
+ffebldConstant ffebld_constant_new_logical7_val (ffetargetLogical7 val);
+#endif
+#if FFETARGET_okLOGICAL8
+ffebldConstant ffebld_constant_new_logical8 (bool truth);
+ffebldConstant ffebld_constant_new_logical8_val (ffetargetLogical8 val);
+#endif
+#if FFETARGET_okREAL1
+ffebldConstant ffebld_constant_new_real1 (ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real1_val (ffetargetReal1 val);
+#endif
+#if FFETARGET_okREAL2
+ffebldConstant ffebld_constant_new_real2 (ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real2_val (ffetargetReal2 val);
+#endif
+#if FFETARGET_okREAL3
+ffebldConstant ffebld_constant_new_real3 (ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real3_val (ffetargetReal3 val);
+#endif
+#if FFETARGET_okREAL4
+ffebldConstant ffebld_constant_new_real4 (ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real4_val (ffetargetReal4 val);
+#endif
+#if FFETARGET_okREAL5
+ffebldConstant ffebld_constant_new_real5 (ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real5_val (ffetargetReal5 val);
+#endif
+#if FFETARGET_okREAL6
+ffebldConstant ffebld_constant_new_real6 (ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real6_val (ffetargetReal6 val);
+#endif
+#if FFETARGET_okREAL7
+ffebldConstant ffebld_constant_new_real7 (ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real7_val (ffetargetReal7 val);
+#endif
+#if FFETARGET_okREAL8
+ffebldConstant ffebld_constant_new_real8 (ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real8_val (ffetargetReal8 val);
+#endif
+ffebldConstant ffebld_constant_new_typeless_bm (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_bv (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hxm (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hxv (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hzm (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hzv (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_om (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_ov (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_val (ffebldConst type,
+ ffetargetTypeless val);
+ffebldConstant ffebld_constant_negated (ffebldConstant c);
+void ffebld_constantarray_dump (ffebldConstantArray array, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset size, ffebit bits);
+ffebldConstantUnion ffebld_constantarray_get (ffebldConstantArray array,
+ ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetOffset offset);
+void ffebld_constantarray_kill (ffebldConstantArray array, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset size);
+ffebldConstantArray ffebld_constantarray_new (ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset size);
+void ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
+ ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
+ ffetargetOffset offset, ffebldConstantUnion *constant,
+ ffeinfoBasictype cbt, ffeinfoKindtype ckt);
+void ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
+ ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
+ ffetargetOffset offset, ffebldConstantArray source_array,
+ ffeinfoBasictype cbt, ffeinfoKindtype ckt);
+void ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant);
+void ffebld_constantunion_dump (ffebldConstantUnion u, ffeinfoBasictype bt,
+ ffeinfoKindtype kt);
+void ffebld_dump (ffebld b);
+void ffebld_dump_prefix (FILE *out, ffeinfoBasictype bt, ffeinfoKindtype kt);
+void ffebld_init_0 (void);
+void ffebld_init_1 (void);
+void ffebld_init_2 (void);
+ffebldListLength ffebld_list_length (ffebld l);
+ffebld ffebld_new_accter (ffebldConstantArray array, ffebit b);
+ffebld ffebld_new_arrter (ffebldConstantArray array, ffetargetOffset size);
+ffebld ffebld_new_conter_with_orig (ffebldConstant c, ffebld orig);
+ffebld ffebld_new_item (ffebld head, ffebld trail);
+ffebld ffebld_new_labter (ffelab l);
+ffebld ffebld_new_labtok (ffelexToken t);
+ffebld ffebld_new_none (ffebldOp o);
+ffebld ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
+ ffeintrinImp imp);
+ffebld ffebld_new_one (ffebldOp o, ffebld left);
+ffebld ffebld_new_two (ffebldOp o, ffebld left, ffebld right);
+char *ffebld_op_string (ffebldOp o);
+void ffebld_pool_pop (void);
+void ffebld_pool_push (mallocPool pool);
+ffetargetCharacterSize ffebld_size_max (ffebld b);
+
+/* Define macros. */
+
+#define ffebld_accter(b) ((b)->u.accter.array)
+#define ffebld_accter_bits(b) ((b)->u.accter.bits)
+#define ffebld_accter_set_bits(b,bt) ((b)->u.accter.bits = (bt))
+#define ffebld_accter_size(b) ffebit_size((b)->u.accter.bits)
+#define ffebld_append_item(b,i) (**(b) = ffebld_new_item((i),NULL), \
+ *(b) = &((**(b))->u.item.trail))
+#define ffebld_arity(b) ffebld_arity_op(ffebld_op(b))
+#define ffebld_arity_op(o) (ffebld_arity_op_[o])
+#define ffebld_arrter(b) ((b)->u.arrter.array)
+#define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s))
+#define ffebld_arrter_size(b) ((b)->u.arrter.size)
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
+#define ffebld_constant_pool() ffe_pool_program_unit()
+#elif FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
+#define ffebld_constant_pool() ffe_pool_file()
+#else
+#error
+#endif
+#define ffebld_constant_character1(c) ((c)->u.character1)
+#define ffebld_constant_character2(c) ((c)->u.character2)
+#define ffebld_constant_character3(c) ((c)->u.character3)
+#define ffebld_constant_character4(c) ((c)->u.character4)
+#define ffebld_constant_character5(c) ((c)->u.character5)
+#define ffebld_constant_character6(c) ((c)->u.character6)
+#define ffebld_constant_character7(c) ((c)->u.character7)
+#define ffebld_constant_character8(c) ((c)->u.character8)
+#define ffebld_constant_characterdefault ffebld_constant_character1
+#define ffebld_constant_complex1(c) ((c)->u.complex1)
+#define ffebld_constant_complex2(c) ((c)->u.complex2)
+#define ffebld_constant_complex3(c) ((c)->u.complex3)
+#define ffebld_constant_complex4(c) ((c)->u.complex4)
+#define ffebld_constant_complex5(c) ((c)->u.complex5)
+#define ffebld_constant_complex6(c) ((c)->u.complex6)
+#define ffebld_constant_complex7(c) ((c)->u.complex7)
+#define ffebld_constant_complex8(c) ((c)->u.complex8)
+#define ffebld_constant_complexdefault ffebld_constant_complex1
+#define ffebld_constant_complexdouble ffebld_constant_complex2
+#define ffebld_constant_complexquad ffebld_constant_complex3
+#define ffebld_constant_copy(c) (c)
+#define ffebld_constant_hollerith(c) ((c)->u.hollerith)
+#define ffebld_constant_hook(c) ((c)->hook)
+#define ffebld_constant_integer1(c) ((c)->u.integer1)
+#define ffebld_constant_integer2(c) ((c)->u.integer2)
+#define ffebld_constant_integer3(c) ((c)->u.integer3)
+#define ffebld_constant_integer4(c) ((c)->u.integer4)
+#define ffebld_constant_integer5(c) ((c)->u.integer5)
+#define ffebld_constant_integer6(c) ((c)->u.integer6)
+#define ffebld_constant_integer7(c) ((c)->u.integer7)
+#define ffebld_constant_integer8(c) ((c)->u.integer8)
+#define ffebld_constant_integerdefault ffebld_constant_integer1
+#define ffebld_constant_is_numeric(c) ((c)->numeric)
+#define ffebld_constant_logical1(c) ((c)->u.logical1)
+#define ffebld_constant_logical2(c) ((c)->u.logical2)
+#define ffebld_constant_logical3(c) ((c)->u.logical3)
+#define ffebld_constant_logical4(c) ((c)->u.logical4)
+#define ffebld_constant_logical5(c) ((c)->u.logical5)
+#define ffebld_constant_logical6(c) ((c)->u.logical6)
+#define ffebld_constant_logical7(c) ((c)->u.logical7)
+#define ffebld_constant_logical8(c) ((c)->u.logical8)
+#define ffebld_constant_logicaldefault ffebld_constant_logical1
+#define ffebld_constant_new_characterdefault ffebld_constant_new_character1
+#define ffebld_constant_new_characterdefault_val ffebld_constant_new_character1_val
+#define ffebld_constant_new_complexdefault ffebld_constant_new_complex1
+#define ffebld_constant_new_complexdefault_val ffebld_constant_new_complex1_val
+#define ffebld_constant_new_complexdouble ffebld_constant_new_complex2
+#define ffebld_constant_new_complexdouble_val ffebld_constant_new_complex2_val
+#define ffebld_constant_new_complexquad ffebld_constant_new_complex3
+#define ffebld_constant_new_complexquad_valffebld_constant_new_complex3_val
+#define ffebld_constant_new_integerdefault ffebld_constant_new_integer1
+#define ffebld_constant_new_integerdefault_val ffebld_constant_new_integer1_val
+#define ffebld_constant_new_logicaldefault ffebld_constant_new_logical1
+#define ffebld_constant_new_logicaldefault_val ffebld_constant_new_logical1_val
+#define ffebld_constant_new_realdefault ffebld_constant_new_real1
+#define ffebld_constant_new_realdefault_val ffebld_constant_new_real1_val
+#define ffebld_constant_new_realdouble ffebld_constant_new_real2
+#define ffebld_constant_new_realdouble_val ffebld_constant_new_real2_val
+#define ffebld_constant_new_realquad ffebld_constant_new_real3
+#define ffebld_constant_new_realquad_val ffebld_constant_new_real3_val
+#define ffebld_constant_ptr_to_union(c) (&(c)->u)
+#define ffebld_constant_real1(c) ((c)->u.real1)
+#define ffebld_constant_real2(c) ((c)->u.real2)
+#define ffebld_constant_real3(c) ((c)->u.real3)
+#define ffebld_constant_real4(c) ((c)->u.real4)
+#define ffebld_constant_real5(c) ((c)->u.real5)
+#define ffebld_constant_real6(c) ((c)->u.real6)
+#define ffebld_constant_real7(c) ((c)->u.real7)
+#define ffebld_constant_real8(c) ((c)->u.real8)
+#define ffebld_constant_realdefault ffebld_constant_real1
+#define ffebld_constant_realdouble ffebld_constant_real2
+#define ffebld_constant_realquad ffebld_constant_real3
+#define ffebld_constant_set_hook(c,h) ((c)->hook = (h))
+#define ffebld_constant_set_union(c,un) ((c)->u = (un))
+#define ffebld_constant_type(c) ((c)->consttype)
+#define ffebld_constant_typeless(c) ((c)->u.typeless)
+#define ffebld_constant_union(c) ((c)->u)
+#define ffebld_conter(b) ((b)->u.conter.expr)
+#define ffebld_conter_orig(b) ((b)->u.conter.orig)
+#define ffebld_conter_set_orig(b,o) ((b)->u.conter.orig = (o))
+#define ffebld_copy(b) (b) /* ~~~Someday really make a copy. */
+#define ffebld_cu_ptr_typeless(u) &(u).typeless
+#define ffebld_cu_ptr_hollerith(u) &(u).hollerith
+#define ffebld_cu_ptr_integer1(u) &(u).integer1
+#define ffebld_cu_ptr_integer2(u) &(u).integer2
+#define ffebld_cu_ptr_integer3(u) &(u).integer3
+#define ffebld_cu_ptr_integer4(u) &(u).integer4
+#define ffebld_cu_ptr_integer5(u) &(u).integer5
+#define ffebld_cu_ptr_integer6(u) &(u).integer6
+#define ffebld_cu_ptr_integer7(u) &(u).integer7
+#define ffebld_cu_ptr_integer8(u) &(u).integer8
+#define ffebld_cu_ptr_integerdefault ffebld_cu_ptr_integer1
+#define ffebld_cu_ptr_logical1(u) &(u).logical1
+#define ffebld_cu_ptr_logical2(u) &(u).logical2
+#define ffebld_cu_ptr_logical3(u) &(u).logical3
+#define ffebld_cu_ptr_logical4(u) &(u).logical4
+#define ffebld_cu_ptr_logical5(u) &(u).logical5
+#define ffebld_cu_ptr_logical6(u) &(u).logical6
+#define ffebld_cu_ptr_logical7(u) &(u).logical7
+#define ffebld_cu_ptr_logical8(u) &(u).logical8
+#define ffebld_cu_ptr_logicaldefault ffebld_cu_ptr_logical1
+#define ffebld_cu_ptr_real1(u) &(u).real1
+#define ffebld_cu_ptr_real2(u) &(u).real2
+#define ffebld_cu_ptr_real3(u) &(u).real3
+#define ffebld_cu_ptr_real4(u) &(u).real4
+#define ffebld_cu_ptr_real5(u) &(u).real5
+#define ffebld_cu_ptr_real6(u) &(u).real6
+#define ffebld_cu_ptr_real7(u) &(u).real7
+#define ffebld_cu_ptr_real8(u) &(u).real8
+#define ffebld_cu_ptr_realdefault ffebld_cu_ptr_real1
+#define ffebld_cu_ptr_realdouble ffebld_cu_ptr_real2
+#define ffebld_cu_ptr_realquad ffebld_cu_ptr_real3
+#define ffebld_cu_ptr_complex1(u) &(u).complex1
+#define ffebld_cu_ptr_complex2(u) &(u).complex2
+#define ffebld_cu_ptr_complex3(u) &(u).complex3
+#define ffebld_cu_ptr_complex4(u) &(u).complex4
+#define ffebld_cu_ptr_complex5(u) &(u).complex5
+#define ffebld_cu_ptr_complex6(u) &(u).complex6
+#define ffebld_cu_ptr_complex7(u) &(u).complex7
+#define ffebld_cu_ptr_complex8(u) &(u).complex8
+#define ffebld_cu_ptr_complexdefault ffebld_cu_ptr_complex1
+#define ffebld_cu_ptr_complexdouble ffebld_cu_ptr_complex2
+#define ffebld_cu_ptr_complexquad ffebld_cu_ptr_complex3
+#define ffebld_cu_ptr_character1(u) &(u).character1
+#define ffebld_cu_ptr_character2(u) &(u).character2
+#define ffebld_cu_ptr_character3(u) &(u).character3
+#define ffebld_cu_ptr_character4(u) &(u).character4
+#define ffebld_cu_ptr_character5(u) &(u).character5
+#define ffebld_cu_ptr_character6(u) &(u).character6
+#define ffebld_cu_ptr_character7(u) &(u).character7
+#define ffebld_cu_ptr_character8(u) &(u).character8
+#define ffebld_cu_val_typeless(u) (u).typeless
+#define ffebld_cu_val_hollerith(u) (u).hollerith
+#define ffebld_cu_val_integer1(u) (u).integer1
+#define ffebld_cu_val_integer2(u) (u).integer2
+#define ffebld_cu_val_integer3(u) (u).integer3
+#define ffebld_cu_val_integer4(u) (u).integer4
+#define ffebld_cu_val_integer5(u) (u).integer5
+#define ffebld_cu_val_integer6(u) (u).integer6
+#define ffebld_cu_val_integer7(u) (u).integer7
+#define ffebld_cu_val_integer8(u) (u).integer8
+#define ffebld_cu_val_integerdefault ffebld_cu_val_integer1
+#define ffebld_cu_val_logical1(u) (u).logical1
+#define ffebld_cu_val_logical2(u) (u).logical2
+#define ffebld_cu_val_logical3(u) (u).logical3
+#define ffebld_cu_val_logical4(u) (u).logical4
+#define ffebld_cu_val_logical5(u) (u).logical5
+#define ffebld_cu_val_logical6(u) (u).logical6
+#define ffebld_cu_val_logical7(u) (u).logical7
+#define ffebld_cu_val_logical8(u) (u).logical8
+#define ffebld_cu_val_logicaldefault ffebld_cu_val_logical
+#define ffebld_cu_val_real1(u) (u).real1
+#define ffebld_cu_val_real2(u) (u).real2
+#define ffebld_cu_val_real3(u) (u).real3
+#define ffebld_cu_val_real4(u) (u).real4
+#define ffebld_cu_val_real5(u) (u).real5
+#define ffebld_cu_val_real6(u) (u).real6
+#define ffebld_cu_val_real7(u) (u).real7
+#define ffebld_cu_val_real8(u) (u).real8
+#define ffebld_cu_val_realdefault ffebld_cu_val_real1
+#define ffebld_cu_val_realdouble ffebld_cu_val_real2
+#define ffebld_cu_val_realquad ffebld_cu_val_real3
+#define ffebld_cu_val_complex1(u) (u).complex1
+#define ffebld_cu_val_complex2(u) (u).complex2
+#define ffebld_cu_val_complex3(u) (u).complex3
+#define ffebld_cu_val_complex4(u) (u).complex4
+#define ffebld_cu_val_complex5(u) (u).complex5
+#define ffebld_cu_val_complex6(u) (u).complex6
+#define ffebld_cu_val_complex7(u) (u).complex7
+#define ffebld_cu_val_complex8(u) (u).complex8
+#define ffebld_cu_val_complexdefault ffebld_cu_val_complex1
+#define ffebld_cu_val_complexdouble ffebld_cu_val_complex2
+#define ffebld_cu_val_complexquad ffebld_cu_val_complex3
+#define ffebld_cu_val_character1(u) (u).character1
+#define ffebld_cu_val_character2(u) (u).character2
+#define ffebld_cu_val_character3(u) (u).character3
+#define ffebld_cu_val_character4(u) (u).character4
+#define ffebld_cu_val_character5(u) (u).character5
+#define ffebld_cu_val_character6(u) (u).character6
+#define ffebld_cu_val_character7(u) (u).character7
+#define ffebld_cu_val_character8(u) (u).character8
+#define ffebld_end_list(b) (*(b) = NULL)
+#define ffebld_head(b) ((b)->u.item.head)
+#define ffebld_info(b) ((b)->info)
+#define ffebld_init_3()
+#define ffebld_init_4()
+#define ffebld_init_list(l,b) (*(l) = NULL, *(b) = (l))
+#define ffebld_labter(b) ((b)->u.labter)
+#define ffebld_labtok(b) ((b)->u.labtok)
+#define ffebld_left(b) ((b)->u.nonter.left)
+#define ffebld_name_string(n) ((n)->name)
+#define ffebld_new() \
+ ((ffebld) malloc_new_kp(ffebld_pool(), "FFEBLD",sizeof(struct _ffebld_)))
+#define ffebld_new_any() ffebld_new_none(FFEBLD_opANY)
+#define ffebld_new_conter(c) ffebld_new_conter_with_orig((c),NULL)
+#define ffebld_new_star() ffebld_new_none(FFEBLD_opSTAR)
+#define ffebld_new_uplus(l) ffebld_new_one(FFEBLD_opUPLUS,(l))
+#define ffebld_new_uminus(l) ffebld_new_one(FFEBLD_opUMINUS,(l))
+#define ffebld_new_add(l,r) ffebld_new_two(FFEBLD_opADD,(l),(r))
+#define ffebld_new_subtract(l,r) ffebld_new_two(FFEBLD_opSUBTRACT,(l),(r))
+#define ffebld_new_multiply(l,r) ffebld_new_two(FFEBLD_opMULTIPLY,(l),(r))
+#define ffebld_new_divide(l,r) ffebld_new_two(FFEBLD_opDIVIDE,(l),(r))
+#define ffebld_new_power(l,r) ffebld_new_two(FFEBLD_opPOWER,(l),(r))
+#define ffebld_new_bounds(l,r) ffebld_new_two(FFEBLD_opBOUNDS,(l),(r))
+#define ffebld_new_concatenate(l,r) ffebld_new_two(FFEBLD_opCONCATENATE,(l),(r))
+#define ffebld_new_not(l) ffebld_new_one(FFEBLD_opNOT,(l))
+#define ffebld_new_lt(l,r) ffebld_new_two(FFEBLD_opLT,(l),(r))
+#define ffebld_new_le(l,r) ffebld_new_two(FFEBLD_opLE,(l),(r))
+#define ffebld_new_eq(l,r) ffebld_new_two(FFEBLD_opEQ,(l),(r))
+#define ffebld_new_ne(l,r) ffebld_new_two(FFEBLD_opNE,(l),(r))
+#define ffebld_new_gt(l,r) ffebld_new_two(FFEBLD_opGT,(l),(r))
+#define ffebld_new_ge(l,r) ffebld_new_two(FFEBLD_opGE,(l),(r))
+#define ffebld_new_and(l,r) ffebld_new_two(FFEBLD_opAND,(l),(r))
+#define ffebld_new_or(l,r) ffebld_new_two(FFEBLD_opOR,(l),(r))
+#define ffebld_new_xor(l,r) ffebld_new_two(FFEBLD_opXOR,(l),(r))
+#define ffebld_new_eqv(l,r) ffebld_new_two(FFEBLD_opEQV,(l),(r))
+#define ffebld_new_neqv(l,r) ffebld_new_two(FFEBLD_opNEQV,(l),(r))
+#define ffebld_new_paren(l) ffebld_new_one(FFEBLD_opPAREN,(l))
+#define ffebld_new_repeat(l,r) ffebld_new_two(FFEBLD_opREPEAT,(l),(r))
+#define ffebld_new_percent_descr(l) ffebld_new_one(FFEBLD_opPERCENT_DESCR,(l))
+#define ffebld_new_percent_loc(l) ffebld_new_one(FFEBLD_opPERCENT_LOC,(l))
+#define ffebld_new_percent_ref(l) ffebld_new_one(FFEBLD_opPERCENT_REF,(l))
+#define ffebld_new_percent_val(l) ffebld_new_one(FFEBLD_opPERCENT_VAL,(l))
+#define ffebld_new_complex(l,r) ffebld_new_two(FFEBLD_opCOMPLEX,(l),(r))
+#define ffebld_new_convert(l) ffebld_new_one(FFEBLD_opCONVERT,(l))
+#define ffebld_new_funcref(l,r) ffebld_new_two(FFEBLD_opFUNCREF,(l),(r))
+#define ffebld_new_subrref(l,r) ffebld_new_two(FFEBLD_opSUBRREF,(l),(r))
+#define ffebld_new_arrayref(l,r) ffebld_new_two(FFEBLD_opARRAYREF,(l),(r))
+#define ffebld_new_substr(l,r) ffebld_new_two(FFEBLD_opSUBSTR,(l),(r))
+#define ffebld_new_impdo(l,r) ffebld_new_two(FFEBLD_opIMPDO,(l),(r))
+#define ffebld_op(b) ((b)->op)
+#define ffebld_pool() (ffebld_pool_stack_.pool)
+#define ffebld_right(b) ((b)->u.nonter.right)
+#define ffebld_set_accter(b,a) ((b)->u.accter.array = (a))
+#define ffebld_set_arrter(b,a) ((b)->u.arrter.array = (a))
+#define ffebld_set_conter(b,c) ((b)->u.conter.expr = (c))
+#define ffebld_set_info(b,i) ((b)->info = (i))
+#define ffebld_set_labter(b,l) ((b)->u.labter = (l))
+#define ffebld_set_op(b,o) ((b)->op = (o))
+#define ffebld_set_head(b,h) ((b)->u.item.head = (h))
+#define ffebld_set_left(b,l) ((b)->u.nonter.left = (l))
+#define ffebld_set_right(b,r) ((b)->u.nonter.right = (r))
+#define ffebld_set_trail(b,t) ((b)->u.item.trail = (t))
+#define ffebld_size(b) (ffeinfo_size((b)->info))
+#define ffebld_size_known(b) ffebld_size(b)
+#define ffebld_symter(b) ((b)->u.symter.symbol)
+#define ffebld_symter_generic(b) ((b)->u.symter.generic)
+#define ffebld_symter_doiter(b) ((b)->u.symter.do_iter)
+#define ffebld_symter_implementation(b) ((b)->u.symter.implementation)
+#define ffebld_symter_specific(b) ((b)->u.symter.specific)
+#define ffebld_symter_set_generic(b,g) ((b)->u.symter.generic = (g))
+#define ffebld_symter_set_implementation(b,i) \
+ ((b)->u.symter.implementation = (i))
+#define ffebld_symter_set_is_doiter(b,f) ((b)->u.symter.do_iter = (f))
+#define ffebld_symter_set_specific(b,s) ((b)->u.symter.specific = (s))
+#define ffebld_terminate_0()
+#define ffebld_terminate_1()
+#define ffebld_terminate_2()
+#define ffebld_terminate_3()
+#define ffebld_terminate_4()
+#define ffebld_trail(b) ((b)->u.item.trail)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/bugs.texi b/gcc/f/bugs.texi
new file mode 100644
index 00000000000..692e1b3a12f
--- /dev/null
+++ b/gcc/f/bugs.texi
@@ -0,0 +1,287 @@
+@c Copyright (C) 1995-1997 Free Software Foundation, Inc.
+@c This is part of the G77 manual.
+@c For copying conditions, see the file g77.texi.
+
+@c The text of this file appears in the file BUGS
+@c in the G77 distribution, as well as in the G77 manual.
+
+@c 1996-06-24
+
+@ifclear BUGSONLY
+@node Actual Bugs
+@section Actual Bugs We Haven't Fixed Yet
+@end ifclear
+
+This section identifies bugs that @code{g77} @emph{users}
+might run into.
+This includes bugs that are actually in the @code{gcc}
+back end (GBE) or in @code{libf2c}, because those
+sets of code are at least somewhat under the control
+of (and necessarily intertwined with) @code{g77}, so it
+isn't worth separating them out.
+
+For information on bugs that might afflict people who
+configure, port, build, and install @code{g77},
+@ref{Problems Installing}.
+
+@itemize @bullet
+@cindex SIGNAL() intrinsic
+@cindex intrinsics, SIGNAL()
+@item
+Work is needed on the @code{SIGNAL()} intrinsic to ensure
+that pointers and integers are properly handled on all
+targets, including 64-bit machines.
+
+@cindex -fugly-comma option
+@cindex options, -fugly-comma
+@item
+When using @samp{-fugly-comma}, @code{g77} assumes an extra
+@samp{%VAL(0)} argument is to be passed to intrinsics
+taking no arguments, such as @code{IARGC()}, which in
+turn reject such a call.
+Although this has been worked around for 0.5.18 due
+to changes in the handling of intrinsics,
+@code{g77} needs to do the ugly-argument-appending trick
+only for external-function invocation, as this would
+probably be more consistent with compilers that default
+to using that trick.
+
+@item
+Something about @code{g77}'s straightforward handling of
+label references and definitions sometimes prevents the GBE
+from unrolling loops.
+Until this is solved, try inserting or removing @code{CONTINUE}
+statements as the terminal statement, using the @code{END DO}
+form instead, and so on.
+(Probably improved, but not wholly fixed, in 0.5.21.)
+
+@item
+The @code{g77} command itself should more faithfully process
+options the way the @code{gcc} command does.
+For example, @code{gcc} accepts abbreviated forms of long options,
+@code{g77} generally doesn't.
+
+@item
+Some confusion in diagnostics concerning failing @code{INCLUDE}
+statements from within @code{INCLUDE}'d or @code{#include}'d files.
+
+@cindex integer constants
+@cindex constants, integer
+@item
+@code{g77} assumes that @code{INTEGER(KIND=1)} constants range
+from @samp{-2**31} to @samp{2**31-1} (the range for
+two's-complement 32-bit values),
+instead of determining their range from the actual range of the
+type for the configuration (and, someday, for the constant).
+
+Further, it generally doesn't implement the handling
+of constants very well in that it makes assumptions about the
+configuration that it no longer makes regarding variables (types).
+
+Included with this item is the fact that @code{g77} doesn't recognize
+that, on IEEE-754/854-compliant systems, @samp{0./0.} should produce a NaN
+and no warning instead of the value @samp{0.} and a warning.
+This is to be fixed in version 0.6, when @code{g77} will use the
+@code{gcc} back end's constant-handling mechanisms to replace its own.
+
+@cindex compiler speed
+@cindex speed, of compiler
+@cindex compiler memory usage
+@cindex memory usage, of compiler
+@cindex large aggregate areas
+@cindex initialization
+@cindex DATA statement
+@cindex statements, DATA
+@item
+@code{g77} uses way too much memory and CPU time to process large aggregate
+areas having any initialized elements.
+
+For example, @samp{REAL A(1000000)} followed by @samp{DATA A(1)/1/}
+takes up way too much time and space, including
+the size of the generated assembler file.
+This is to be mitigated somewhat in version 0.6.
+
+Version 0.5.18 improves cases like this---specifically,
+cases of @emph{sparse} initialization that leave large, contiguous
+areas uninitialized---significantly.
+However, even with the improvements, these cases still
+require too much memory and CPU time.
+
+(Version 0.5.18 also improves cases where the initial values are
+zero to a much greater degree, so if the above example
+ends with @samp{DATA A(1)/0/}, the compile-time performance
+will be about as good as it will ever get, aside from unrelated
+improvements to the compiler.)
+
+Note that @code{g77} does display a warning message to
+notify the user before the compiler appears to hang.
+@xref{Large Initialization,,Initialization of Large Aggregate Areas},
+for information on how to change the point at which
+@code{g77} decides to issue this warning.
+
+@cindex debugging
+@cindex common blocks
+@cindex equivalence areas
+@cindex local equivalence areas
+@item
+@code{g77} doesn't emit variable and array members of common blocks for use
+with a debugger (the @samp{-g} command-line option).
+The code is present to do this, but doesn't work with at least
+one debug format---perhaps it works with others.
+And it turns out there's a similar bug for
+local equivalence areas, so that has been disabled as well.
+
+As of Version 0.5.19, a temporary kludge solution is provided whereby
+some rudimentary information on a member is written as a string that
+is the member's value as a character string.
+
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for information on the @samp{-fdebug-kludge} option.
+
+@cindex code, displaying main source
+@cindex displaying main source code
+@cindex debugging main source code
+@cindex printing main source
+@item
+When debugging, after starting up the debugger but before being able
+to see the source code for the main program unit, the user must currently
+set a breakpoint at @samp{MAIN__} (or @samp{MAIN___} or @samp{MAIN_} if
+@samp{MAIN__} doesn't exist)
+and run the program until it hits the breakpoint.
+At that point, the
+main program unit is activated and about to execute its first
+executable statement, but that's the state in which the debugger should
+start up, as is the case for languages like C.
+
+@cindex debugger
+@item
+Debugging @code{g77}-compiled code using debuggers other than
+@code{gdb} is likely not to work.
+
+Getting @code{g77} and @code{gdb} to work together is a known
+problem---getting @code{g77} to work properly with other
+debuggers, for which source code often is unavailable to @code{g77}
+developers, seems like a much larger, unknown problem,
+and is a lower priority than making @code{g77} and @code{gdb}
+work together properly.
+
+On the other hand, information about problems other debuggers
+have with @code{g77} output might make it easier to properly
+fix @code{g77}, and perhaps even improve @code{gdb}, so it
+is definitely welcome.
+Such information might even lead to all relevant products
+working together properly sooner.
+
+@cindex padding
+@cindex structures
+@cindex common blocks
+@cindex equivalence areas
+@item
+@code{g77} currently inserts needless padding for things like
+@samp{COMMON A,IPAD} where @samp{A} is @code{CHARACTER*1} and @samp{IPAD}
+is @code{INTEGER(KIND=1)} on machines like x86, because
+the back end insists that @samp{IPAD} be aligned to a 4-byte boundary, but
+the processor has no such requirement (though it's good for
+performance).
+
+It is possible that this is not a real bug, and could be considered
+a performance feature, but it might be important to provide
+the ability to Fortran code to specify minimum padding for
+aggregate areas such as common blocks---and, certainly, there
+is the potential, with the current setup, for interface differences
+in the way such areas are laid out between @code{g77} and other
+compilers.
+
+@item
+Some crashes occur when compiling under Solaris on x86
+machines.
+
+Nothing has been heard about any such problems for some time,
+so this is considering a closed item as of 0.5.20.
+Please submit any bug reports pertinent to @code{g77}'s support
+for Solaris/x86 systems.
+
+@cindex RS/6000 support
+@cindex support, RS/6000
+@item
+RS/6000 support is not complete as of the gcc 2.6.3 back end.
+The 2.7.0 back end appears to fix this problem, or at least mitigate
+it significantly, but there is at least one known problem that is
+likely to be a code-generation bug in @file{gcc-2.7.0} plus
+@file{g77-0.5.16}.
+This problem shows up only when compiling the Fortran program with @samp{-O}.
+
+Nothing has been heard about any RS/6000 problems for some time,
+so this is considering a closed item as of 0.5.20.
+Please submit any bug reports pertinent to @code{g77}'s support
+for RS/6000 systems.
+
+@cindex SGI support
+@cindex support, SGI
+@item
+SGI support is known to be a bit buggy.
+The known problem shows up only when compiling the Fortran program with
+@samp{-O}.
+
+It is possible these problems have all been fixed in 0.5.20 by
+emulating complex arithmetic in the front end.
+Please submit any bug reports pertinent to @code{g77}'s support
+for SGI systems.
+
+@cindex Alpha, support
+@cindex support, Alpha
+@item
+@code{g77} doesn't work perfectly on 64-bit configurations such as the Alpha.
+This problem is expected to be largely resolved as of version 0.5.20,
+and further addressed by 0.5.21.
+Version 0.6 should solve most or all related problems (such as
+64-bit machines other than Digital Semiconductor (``DEC'') Alphas).
+
+One known bug that causes a compile-time crash occurs when compiling
+code such as the following with optimization:
+
+@example
+SUBROUTINE CRASH (TEMP)
+INTEGER*2 HALF(2)
+REAL TEMP
+HALF(1) = NINT (TEMP)
+END
+@end example
+
+It is expected that a future version of @code{g77} will have a fix for this
+problem, almost certainly by the time @code{g77} supports the forthcoming
+version 2.8.0 of @code{gcc}.
+
+@cindex COMPLEX support
+@cindex support, COMPLEX
+@item
+Maintainers of gcc report that the back end definitely has ``broken''
+support for @code{COMPLEX} types.
+Based on their input, it seems many of
+the problems affect only the more-general facilities for gcc's
+@code{__complex__} type, such as @code{__complex__ int}
+(where the real and imaginary parts are integers) that GNU
+Fortran does not use.
+
+Version 0.5.20 of @code{g77} works around this
+problem by not using the back end's support for @code{COMPLEX}.
+The new option @samp{-fno-emulate-complex} avoids the work-around,
+reverting to using the same ``broken'' mechanism as that used
+by versions of @code{g77} prior to 0.5.20.
+
+@cindex ELF support
+@cindex support, ELF
+@cindex -fPIC option
+@cindex options, -fPIC
+@item
+There seem to be some problems with passing constants, and perhaps
+general expressions (other than simple variables/arrays), to procedures
+when compiling on some systems (such as i386) with @samp{-fPIC}, as in
+when compiling for ELF targets.
+The symptom is that the assembler complains about invalid opcodes.
+More investigation is needed, but the problem is almost certainly
+in the gcc back end, and it apparently occurs only when
+compiling sufficiently complicated functions @emph{without} the
+@samp{-O} option.
+@end itemize
+
diff --git a/gcc/f/bugs0.texi b/gcc/f/bugs0.texi
new file mode 100644
index 00000000000..e8f6d22e339
--- /dev/null
+++ b/gcc/f/bugs0.texi
@@ -0,0 +1,17 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename BUGS
+@set BUGSONLY
+@c %**end of header
+
+@c The immediately following lines apply to the BUGS file
+@c which is generated using this file.
+This file lists known bugs in the GNU Fortran compiler.
+Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+You may copy, distribute, and modify it freely as long as you preserve
+this copyright notice and permission notice.
+
+@node Top,,, (dir)
+@chapter Bugs in GNU Fortran
+@include bugs.texi
+@bye
diff --git a/gcc/f/com-rt.def b/gcc/f/com-rt.def
new file mode 100644
index 00000000000..eb2fed5f530
--- /dev/null
+++ b/gcc/f/com-rt.def
@@ -0,0 +1,281 @@
+/* com-rt.def -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ com.c
+
+ Modifications:
+*/
+
+/* DEFGFRT(CODE,NAME,TYPE,VOLATILE,COMPLEX):
+
+ CODE -- the #define name to use to refer to the function in g77 code
+
+ NAME -- the name as seen by the back end and, with whatever massaging
+ is normal, the linker
+
+ TYPE -- a code for the tree for the type, assigned when first encountered
+ (NOTE: There's a distinction made between the semantic return
+ value for the function, and the actual return mechanism; e.g.
+ `r_abs()' computes a single-precision `float' return value
+ but returns it as a `double'. This distinction is important
+ and is flagged via the _F2C_ versus _GNU_ suffix.)
+
+ ARGS -- a string of codes representing the types of the arguments; the
+ last type specifies the type for that and all following args,
+ and the null pointer (0) means the same as "0":
+
+ 0 Not applicable at and beyond this point
+ & Pointer to type that follows
+ a char
+ c complex
+ d doublereal
+ e doublecomplex
+ f real
+ i integer
+ j longint
+
+ VOLATILE -- TRUE if the function never returns (gen's emit_barrier in
+ g77 back end)
+
+ COMPLEX -- TRUE if the return value is COMPLEX or DOUBLE COMPLEX and
+ thus might need to be returned as ptr-to-1st-arg
+
+*/
+
+DEFGFRT (FFECOM_gfrtCAT, "s_cat", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCMP, "s_cmp", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCOPY, "s_copy", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPAUSE, "s_paus", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSTOP, "s_stop", FFECOM_rttypeVOID_, 0, TRUE, FALSE)
+
+DEFGFRT (FFECOM_gfrtSRDUE, "s_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERDUE, "e_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSUE, "s_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSUE, "e_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRDFE, "s_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERDFE, "e_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSFI, "s_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSFI, "e_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSFE, "s_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSFE, "e_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSLI, "s_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSLI, "e_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSLE, "s_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSLE, "e_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSNE, "s_rsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtSWDUE, "s_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWDUE, "e_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSUE, "s_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSUE, "e_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWDFE, "s_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWDFE, "e_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSFI, "s_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSFI, "e_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSFE, "s_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSFE, "e_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSLI, "s_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSLI, "e_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSLE, "s_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSLE, "e_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSNE, "s_wsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtDOFIO, "do_fio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDOLIO, "do_lio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDOUIO, "do_uio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtFOPEN, "f_open", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFCLOS, "f_clos", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFINQU, "f_inqu", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtFBACK, "f_back", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFEND, "f_end", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFREW, "f_rew", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtABORT, "G77_abort_0", FFECOM_rttypeVOID_, 0, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtABS, "r_abs", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtACCESS, "G77_access_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtACOS, "r_acos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAIMAG, "r_imag", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAINT, "r_int", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALARM, "G77_alarm_0", FFECOM_rttypeVOID_, "&i0", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALOG, "r_log", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALOG10, "r_lg10", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAMOD, "r_mod", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtANINT, "r_nint", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtASIN, "r_asin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtATAN, "r_atan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtATAN2, "r_atn2", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCABS, "c_abs", FFECOM_rttypeREAL_F2C_, "&c", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCCOS, "c_cos", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCEXP, "c_exp", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCHDIR, "G77_chdir_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCLOG, "c_log", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCHMOD, "G77_chmod_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCONJG, "r_cnjg", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCOS, "r_cos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCOSH, "r_cosh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCSIN, "c_sin", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCSQRT, "c_sqrt", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCTIME, "G77_ctime_0", FFECOM_rttypeCHARACTER_, "&j", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDABS, "d_abs", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDACOS, "d_acos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDASIN, "d_asin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATE, "G77_date_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESJN, "jn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESY0, "y0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESY1, "y1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESYN, "yn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDCOS, "d_cos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDCOSH, "d_cosh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDDIM, "d_dim", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDERF, "G77_derf_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDERFC, "G77_derfc_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDEXP, "d_exp", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDIM, "r_dim", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDINT, "d_int", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDLOG, "d_log", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDLOG10, "d_lg10", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDMOD, "d_mod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDNINT, "d_nint", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDPROD, "d_prod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSIGN, "d_sign", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSIN, "d_sin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSINH, "d_sinh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSQRT, "d_sqrt", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTAN, "d_tan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTANH, "d_tanh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTIME, "G77_dtime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERF, "G77_erf_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERFC, "G77_erfc_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtETIME, "G77_etime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEXIT, "G77_exit_0", FFECOM_rttypeVOID_, "&i", TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtEXP, "r_exp", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFDATE, "G77_fdate_0", FFECOM_rttypeCHARACTER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFGET, "G77_fget_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFGETC, "G77_fgetc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFLUSH, "G77_flush_0", FFECOM_rttypeVOID_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFLUSH1, "G77_flush1_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFNUM, "G77_fnum_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFPUT, "G77_fput_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFPUTC, "G77_fputc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFSTAT, "G77_fstat_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFTELL, "G77_ftell_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFSEEK, "G77_fseek_0", FFECOM_rttypeINTEGER_, "&i&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGERROR, "G77_gerror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETARG, "G77_getarg_0", FFECOM_rttypeVOID_, "&i&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETCWD, "G77_getcwd_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETGID, "G77_getgid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETLOG, "G77_getlog_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETPID, "G77_getpid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETUID, "G77_getuid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETENV, "G77_getenv_0", FFECOM_rttypeVOID_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGMTIME, "G77_gmtime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtHOSTNM, "G77_hostnm_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIABS, "i_abs", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIARGC, "G77_iargc_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDATE, "G77_idate_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDIM, "i_dim", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDNINT, "i_dnnt", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIERRNO, "G77_ierrno_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtINDEX, "i_indx", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIRAND, "G77_irand_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtISIGN, "i_sign", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtISATTY, "G77_isatty_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtITIME, "G77_itime_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtKILL, "G77_kill_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLEN, "i_len", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLGE, "l_ge", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLGT, "l_gt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLINK, "G77_link_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLLE, "l_le", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLLT, "l_lt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLNBLNK, "G77_lnblnk_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLSTAT, "G77_lstat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLTIME, "G77_ltime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtMCLOCK, "G77_mclock_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtMOD, "i_mod", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtNINT, "i_nint", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPERROR, "G77_perror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtRAND, "G77_rand_0", FFECOM_rttypeREAL_F2C_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtRENAME, "G77_rename_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSECNDS, "G77_secnds_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSECOND, "G77_second_0", FFECOM_rttypeREAL_F2C_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SIGNAL, "G77_signal_0", FFECOM_rttypeINTEGER_, "&i0", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSLEEP, "G77_sleep_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSQRT, "r_sqrt", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRAND, "G77_srand_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSTAT, "G77_stat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYMLNK, "G77_symlnk_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYSTEM, "G77_system_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYSTEM_CLOCK, "system_clock_", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTAN, "r_tan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTANH, "r_tanh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTIME, "G77_time_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTTYNAM, "G77_ttynam_0", FFECOM_rttypeCHARACTER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtUNLINK, "G77_unlink_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtUMASK, "G77_umask_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtVXTIDATE, "G77_vxtidate_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtVXTTIME, "G77_vxttime_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCDEXP, "z_exp", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCDLOG, "z_log", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDCONJG, "d_cnjg", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCDSIN, "z_sin", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtCDSQRT, "z_sqrt", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDIMAG, "d_imag", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtL_ACOS, "acos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ASIN, "asin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ATAN, "atan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ATAN2, "atan2", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_COS, "__builtin_cos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_COSH, "cosh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ERF, "erf", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_ERFC, "erfc", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_EXP, "exp", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_FLOOR, "floor", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_LOG, "log", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SIN, "__builtin_sin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SINH, "sinh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SQRT, "__builtin_fsqrt", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_TAN, "tan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_TANH, "tanh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtPOW_CI, "pow_ci", FFECOM_rttypeCOMPLEX_F2C_, "&c&i", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtPOW_DD, "pow_dd", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_DI, "pow_di", FFECOM_rttypeDOUBLE_, "&d&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_II, "pow_ii", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_QQ, "pow_qq", FFECOM_rttypeLONGINT_, "&j&j", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_RI, "pow_ri", FFECOM_rttypeREAL_F2C_, "&f&i", FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_ZI, "pow_zi", FFECOM_rttypeDBLCMPLX_F2C_, "&e&i", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtPOW_ZZ, "pow_zz", FFECOM_rttypeDBLCMPLX_F2C_, "&e&e", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDIV_CC, "c_div", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDIV_ZZ, "z_div", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE)
diff --git a/gcc/f/com.c b/gcc/f/com.c
new file mode 100644
index 00000000000..65a6ea9c282
--- /dev/null
+++ b/gcc/f/com.c
@@ -0,0 +1,16225 @@
+/* com.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Contains compiler-specific functions.
+
+ Modifications:
+*/
+
+/* Understanding this module means understanding the interface between
+ the g77 front end and the gcc back end (or, perhaps, some other
+ back end). In here are the functions called by the front end proper
+ to notify whatever back end is in place about certain things, and
+ also the back-end-specific functions. It's a bear to deal with, so
+ lately I've been trying to simplify things, especially with regard
+ to the gcc-back-end-specific stuff.
+
+ Building expressions generally seems quite easy, but building decls
+ has been challenging and is undergoing revision. gcc has several
+ kinds of decls:
+
+ TYPE_DECL -- a type (int, float, struct, function, etc.)
+ CONST_DECL -- a constant of some type other than function
+ LABEL_DECL -- a variable or a constant?
+ PARM_DECL -- an argument to a function (a variable that is a dummy)
+ RESULT_DECL -- the return value of a function (a variable)
+ VAR_DECL -- other variable (can hold a ptr-to-function, struct, int, etc.)
+ FUNCTION_DECL -- a function (either the actual function or an extern ref)
+ FIELD_DECL -- a field in a struct or union (goes into types)
+
+ g77 has a set of functions that somewhat parallels the gcc front end
+ when it comes to building decls:
+
+ Internal Function (one we define, not just declare as extern):
+ int yes;
+ yes = suspend_momentary ();
+ if (is_nested) push_f_function_context ();
+ start_function (get_identifier ("function_name"), function_type,
+ is_nested, is_public);
+ // for each arg, build PARM_DECL and call push_parm_decl (decl) with it;
+ store_parm_decls (is_main_program);
+ ffecom_start_compstmt_ ();
+ // for stmts and decls inside function, do appropriate things;
+ ffecom_end_compstmt_ ();
+ finish_function (is_nested);
+ if (is_nested) pop_f_function_context ();
+ if (is_nested) resume_momentary (yes);
+
+ Everything Else:
+ int yes;
+ tree d;
+ tree init;
+ yes = suspend_momentary ();
+ // fill in external, public, static, &c for decl, and
+ // set DECL_INITIAL to error_mark_node if going to initialize
+ // set is_top_level TRUE only if not at top level and decl
+ // must go in top level (i.e. not within current function decl context)
+ d = start_decl (decl, is_top_level);
+ init = ...; // if have initializer
+ finish_decl (d, init, is_top_level);
+ resume_momentary (yes);
+
+*/
+
+/* Include files. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "config.j"
+#include "flags.j"
+#include "rtl.j"
+#include "tree.j"
+#include "convert.j"
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+#define FFECOM_GCC_INCLUDE 1 /* Enable -I. */
+
+/* BEGIN stuff from gcc/cccp.c. */
+
+/* The following symbols should be autoconfigured:
+ HAVE_FCNTL_H
+ HAVE_STDLIB_H
+ HAVE_SYS_TIME_H
+ HAVE_UNISTD_H
+ STDC_HEADERS
+ TIME_WITH_SYS_TIME
+ In the mean time, we'll get by with approximations based
+ on existing GCC configuration symbols. */
+
+#ifdef POSIX
+# ifndef HAVE_STDLIB_H
+# define HAVE_STDLIB_H 1
+# endif
+# ifndef HAVE_UNISTD_H
+# define HAVE_UNISTD_H 1
+# endif
+# ifndef STDC_HEADERS
+# define STDC_HEADERS 1
+# endif
+#endif /* defined (POSIX) */
+
+#if defined (POSIX) || (defined (USG) && !defined (VMS))
+# ifndef HAVE_FCNTL_H
+# define HAVE_FCNTL_H 1
+# endif
+#endif
+
+#ifndef RLIMIT_STACK
+# include <time.h>
+#else
+# if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+# else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+# endif
+# include <sys/resource.h>
+#endif
+
+#if HAVE_FCNTL_H
+# include <fcntl.h>
+#endif
+
+/* This defines "errno" properly for VMS, and gives us EACCES. */
+#include <errno.h>
+
+#if HAVE_STDLIB_H
+# include <stdlib.h>
+#else
+char *getenv ();
+#endif
+
+char *index ();
+char *rindex ();
+
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+/* VMS-specific definitions */
+#ifdef VMS
+#include <descrip.h>
+#define O_RDONLY 0 /* Open arg for Read/Only */
+#define O_WRONLY 1 /* Open arg for Write/Only */
+#define read(fd,buf,size) VMS_read (fd,buf,size)
+#define write(fd,buf,size) VMS_write (fd,buf,size)
+#define open(fname,mode,prot) VMS_open (fname,mode,prot)
+#define fopen(fname,mode) VMS_fopen (fname,mode)
+#define freopen(fname,mode,ofile) VMS_freopen (fname,mode,ofile)
+#define strncat(dst,src,cnt) VMS_strncat (dst,src,cnt)
+#define fstat(fd,stbuf) VMS_fstat (fd,stbuf)
+static int VMS_fstat (), VMS_stat ();
+static char * VMS_strncat ();
+static int VMS_read ();
+static int VMS_write ();
+static int VMS_open ();
+static FILE * VMS_fopen ();
+static FILE * VMS_freopen ();
+static void hack_vms_include_specification ();
+typedef struct { unsigned :16, :16, :16; } vms_ino_t;
+#define ino_t vms_ino_t
+#define INCLUDE_LEN_FUDGE 10 /* leave room for VMS syntax conversion */
+#ifdef __GNUC__
+#define BSTRING /* VMS/GCC supplies the bstring routines */
+#endif /* __GNUC__ */
+#endif /* VMS */
+
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#endif
+
+/* END stuff from gcc/cccp.c. */
+
+#include "proj.h"
+#define FFECOM_DETERMINE_TYPES 1 /* for com.h */
+#include "com.h"
+#include "bad.h"
+#include "bld.h"
+#include "equiv.h"
+#include "expr.h"
+#include "implic.h"
+#include "info.h"
+#include "malloc.h"
+#include "src.h"
+#include "st.h"
+#include "storag.h"
+#include "symbol.h"
+#include "target.h"
+#include "top.h"
+#include "type.h"
+
+/* Externals defined here. */
+
+#define FFECOM_FASTER_ARRAY_REFS 0 /* Generates faster code? */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+
+/* tree.h declares a bunch of stuff that it expects the front end to
+ define. Here are the definitions, which in the C front end are
+ found in the file c-decl.c. */
+
+tree integer_zero_node;
+tree integer_one_node;
+tree null_pointer_node;
+tree error_mark_node;
+tree void_type_node;
+tree integer_type_node;
+tree unsigned_type_node;
+tree char_type_node;
+tree current_function_decl;
+
+/* ~~tree.h SHOULD declare this, because toplev.c and dwarfout.c reference
+ it. */
+
+char *language_string = "GNU F77";
+
+/* These definitions parallel those in c-decl.c so that code from that
+ module can be used pretty much as is. Much of these defs aren't
+ otherwise used, i.e. by g77 code per se, except some of them are used
+ to build some of them that are. The ones that are global (i.e. not
+ "static") are those that ste.c and such might use (directly
+ or by using com macros that reference them in their definitions). */
+
+static tree short_integer_type_node;
+tree long_integer_type_node;
+static tree long_long_integer_type_node;
+
+static tree short_unsigned_type_node;
+static tree long_unsigned_type_node;
+static tree long_long_unsigned_type_node;
+
+static tree unsigned_char_type_node;
+static tree signed_char_type_node;
+
+static tree float_type_node;
+static tree double_type_node;
+static tree complex_float_type_node;
+tree complex_double_type_node;
+static tree long_double_type_node;
+static tree complex_integer_type_node;
+static tree complex_long_double_type_node;
+
+tree string_type_node;
+
+static tree double_ftype_double;
+static tree float_ftype_float;
+static tree ldouble_ftype_ldouble;
+
+/* The rest of these are inventions for g77, though there might be
+ similar things in the C front end. As they are found, these
+ inventions should be renamed to be canonical. Note that only
+ the ones currently required to be global are so. */
+
+static tree ffecom_tree_fun_type_void;
+static tree ffecom_tree_ptr_to_fun_type_void;
+
+tree ffecom_integer_type_node; /* Abbrev for _tree_type[blah][blah]. */
+tree ffecom_integer_zero_node; /* Like *_*_* with g77's integer type. */
+tree ffecom_integer_one_node; /* " */
+tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
+
+/* _fun_type things are the f2c-specific versions. For -fno-f2c,
+ just use build_function_type and build_pointer_type on the
+ appropriate _tree_type array element. */
+
+static tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static tree ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static tree ffecom_tree_subr_type;
+static tree ffecom_tree_ptr_to_subr_type;
+static tree ffecom_tree_blockdata_type;
+
+static tree ffecom_tree_xargc_;
+
+ffecomSymbol ffecom_symbol_null_
+=
+{
+ NULL_TREE,
+ NULL_TREE,
+ NULL_TREE,
+};
+ffeinfoKindtype ffecom_pointer_kind_ = FFEINFO_basictypeNONE;
+ffeinfoKindtype ffecom_label_kind_ = FFEINFO_basictypeNONE;
+
+int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
+tree ffecom_f2c_integer_type_node;
+tree ffecom_f2c_ptr_to_integer_type_node;
+tree ffecom_f2c_address_type_node;
+tree ffecom_f2c_real_type_node;
+tree ffecom_f2c_ptr_to_real_type_node;
+tree ffecom_f2c_doublereal_type_node;
+tree ffecom_f2c_complex_type_node;
+tree ffecom_f2c_doublecomplex_type_node;
+tree ffecom_f2c_longint_type_node;
+tree ffecom_f2c_logical_type_node;
+tree ffecom_f2c_flag_type_node;
+tree ffecom_f2c_ftnlen_type_node;
+tree ffecom_f2c_ftnlen_zero_node;
+tree ffecom_f2c_ftnlen_one_node;
+tree ffecom_f2c_ftnlen_two_node;
+tree ffecom_f2c_ptr_to_ftnlen_type_node;
+tree ffecom_f2c_ftnint_type_node;
+tree ffecom_f2c_ptr_to_ftnint_type_node;
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Simple definitions and enumerations. */
+
+#ifndef FFECOM_sizeMAXSTACKITEM
+#define FFECOM_sizeMAXSTACKITEM 32*1024 /* Keep user-declared things
+ larger than this # bytes
+ off stack if possible. */
+#endif
+
+/* For systems that have large enough stacks, they should define
+ this to 0, and here, for ease of use later on, we just undefine
+ it if it is 0. */
+
+#if FFECOM_sizeMAXSTACKITEM == 0
+#undef FFECOM_sizeMAXSTACKITEM
+#endif
+
+typedef enum
+ {
+ FFECOM_rttypeVOID_,
+ FFECOM_rttypeINT_, /* C's `int' type, for libF77/system_.c? */
+ FFECOM_rttypeINTEGER_,
+ FFECOM_rttypeLONGINT_, /* C's `long long int' type. */
+ FFECOM_rttypeLOGICAL_,
+ FFECOM_rttypeREAL_F2C_, /* f2c's `float' returned as `double'. */
+ FFECOM_rttypeREAL_GNU_, /* `float' returned as such. */
+ FFECOM_rttypeCOMPLEX_F2C_, /* f2c's `complex' returned via 1st arg. */
+ FFECOM_rttypeCOMPLEX_GNU_, /* gcc's `complex float' returned as such. */
+ FFECOM_rttypeDOUBLE_, /* C's `double' type. */
+ FFECOM_rttypeDOUBLEREAL_,
+ FFECOM_rttypeDBLCMPLX_F2C_, /* f2c's `doublecomplex' returned via 1st arg. */
+ FFECOM_rttypeDBLCMPLX_GNU_, /* gcc's `complex double' returned as such. */
+ FFECOM_rttypeCHARACTER_, /* f2c `char *'/`ftnlen' pair. */
+ FFECOM_rttype_
+ } ffecomRttype_;
+
+/* Internal typedefs. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+typedef struct _ffecom_concat_list_ ffecomConcatList_;
+typedef struct _ffecom_temp_ *ffecomTemp_;
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+struct _ffecom_concat_list_
+ {
+ ffebld *exprs;
+ int count;
+ int max;
+ ffetargetCharacterSize minlen;
+ ffetargetCharacterSize maxlen;
+ };
+
+struct _ffecom_temp_
+ {
+ ffecomTemp_ next;
+ tree type; /* Base type (w/o size/array applied). */
+ tree t;
+ ffetargetCharacterSize size;
+ int elements;
+ bool in_use;
+ bool auto_pop;
+ };
+
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Static functions (internal). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree ffecom_arglist_expr_ (char *argstring, ffebld args);
+static tree ffecom_widest_expr_type_ (ffebld list);
+static bool ffecom_overlap_ (tree dest_decl, tree dest_offset,
+ tree dest_size, tree source_tree,
+ ffebld source, bool scalar_arg);
+static bool ffecom_args_overlapping_ (tree dest_tree, ffebld dest,
+ tree args, tree callee_commons,
+ bool scalar_args);
+static tree ffecom_build_f2c_string_ (int i, char *s);
+static tree ffecom_call_ (tree fn, ffeinfoKindtype kt,
+ bool is_f2c_complex, tree type,
+ tree args, tree dest_tree,
+ ffebld dest, bool *dest_used,
+ tree callee_commons, bool scalar_args);
+static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt,
+ bool is_f2c_complex, tree type,
+ ffebld left, ffebld right,
+ tree dest_tree, ffebld dest,
+ bool *dest_used, tree callee_commons,
+ bool scalar_args);
+static void ffecom_char_args_ (tree *xitem, tree *length,
+ ffebld expr);
+static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy);
+static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s);
+static ffecomConcatList_
+ ffecom_concat_list_gather_ (ffecomConcatList_ catlist,
+ ffebld expr,
+ ffetargetCharacterSize max);
+static void ffecom_concat_list_kill_ (ffecomConcatList_ catlist);
+static ffecomConcatList_ ffecom_concat_list_new_ (ffebld expr,
+ ffetargetCharacterSize max);
+static void ffecom_debug_kludge_ (tree aggr, char *aggr_type, ffesymbol member,
+ tree member_type, ffetargetOffset offset);
+static void ffecom_do_entry_ (ffesymbol fn, int entrynum);
+static tree ffecom_expr_ (ffebld expr, tree dest_tree,
+ ffebld dest, bool *dest_used,
+ bool assignp);
+static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
+ ffebld dest, bool *dest_used);
+static tree ffecom_expr_power_integer_ (ffebld left, ffebld right);
+static void ffecom_expr_transform_ (ffebld expr);
+static void ffecom_f2c_make_type_ (tree *type, int tcode, char *name);
+static void ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size,
+ int code);
+static ffeglobal ffecom_finish_global_ (ffeglobal global);
+static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s);
+static tree ffecom_get_appended_identifier_ (char us, char *text);
+static tree ffecom_get_external_identifier_ (ffesymbol s);
+static tree ffecom_get_identifier_ (char *text);
+static tree ffecom_gen_sfuncdef_ (ffesymbol s,
+ ffeinfoBasictype bt,
+ ffeinfoKindtype kt);
+static char *ffecom_gfrt_args_ (ffecomGfrt ix);
+static tree ffecom_gfrt_tree_ (ffecomGfrt ix);
+static tree ffecom_init_zero_ (tree decl);
+static tree ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg,
+ tree *maybe_tree);
+static tree ffecom_intrinsic_len_ (ffebld expr);
+static void ffecom_let_char_ (tree dest_tree,
+ tree dest_length,
+ ffetargetCharacterSize dest_size,
+ ffebld source);
+static void ffecom_make_gfrt_ (ffecomGfrt ix);
+static void ffecom_member_phase1_ (ffestorag mst, ffestorag st);
+#ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING
+static void ffecom_member_phase2_ (ffestorag mst, ffestorag st);
+#endif
+static void ffecom_push_dummy_decls_ (ffebld dumlist,
+ bool stmtfunc);
+static void ffecom_start_progunit_ (void);
+static ffesymbol ffecom_sym_transform_ (ffesymbol s);
+static ffesymbol ffecom_sym_transform_assign_ (ffesymbol s);
+static void ffecom_transform_common_ (ffesymbol s);
+static void ffecom_transform_equiv_ (ffestorag st);
+static tree ffecom_transform_namelist_ (ffesymbol s);
+static void ffecom_tree_canonize_ptr_ (tree *decl, tree *offset,
+ tree t);
+static void ffecom_tree_canonize_ref_ (tree *decl, tree *offset,
+ tree *size, tree tree);
+static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right,
+ tree dest_tree, ffebld dest,
+ bool *dest_used);
+static tree ffecom_type_localvar_ (ffesymbol s,
+ ffeinfoBasictype bt,
+ ffeinfoKindtype kt);
+static tree ffecom_type_namelist_ (void);
+#if 0
+static tree ffecom_type_permanent_copy_ (tree t);
+#endif
+static tree ffecom_type_vardesc_ (void);
+static tree ffecom_vardesc_ (ffebld expr);
+static tree ffecom_vardesc_array_ (ffesymbol s);
+static tree ffecom_vardesc_dims_ (ffesymbol s);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* These are static functions that parallel those found in the C front
+ end and thus have the same names. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void bison_rule_compstmt_ (void);
+static void bison_rule_pushlevel_ (void);
+static tree builtin_function (char *name, tree type,
+ enum built_in_function function_code,
+ char *library_name);
+static int duplicate_decls (tree newdecl, tree olddecl);
+static void finish_decl (tree decl, tree init, bool is_top_level);
+static void finish_function (int nested);
+static char *lang_printable_name (tree decl, char **kind);
+static tree lookup_name_current_level (tree name);
+static struct binding_level *make_binding_level (void);
+static void pop_f_function_context (void);
+static void push_f_function_context (void);
+static void push_parm_decl (tree parm);
+static tree pushdecl_top_level (tree decl);
+static tree storedecls (tree decls);
+static void store_parm_decls (int is_main_program);
+static tree start_decl (tree decl, bool is_top_level);
+static void start_function (tree name, tree type, int nested, int public);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+#if FFECOM_GCC_INCLUDE
+static void ffecom_file_ (char *name);
+static void ffecom_initialize_char_syntax_ (void);
+static void ffecom_close_include_ (FILE *f);
+static int ffecom_decode_include_option_ (char *spec);
+static FILE *ffecom_open_include_ (char *name, ffewhereLine l,
+ ffewhereColumn c);
+#endif /* FFECOM_GCC_INCLUDE */
+
+/* Static objects accessed by functions in this module. */
+
+static ffesymbol ffecom_primary_entry_ = NULL;
+static ffesymbol ffecom_nested_entry_ = NULL;
+static ffeinfoKind ffecom_primary_entry_kind_;
+static bool ffecom_primary_entry_is_proc_;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree ffecom_outer_function_decl_;
+static tree ffecom_previous_function_decl_;
+static tree ffecom_which_entrypoint_decl_;
+static ffecomTemp_ ffecom_latest_temp_;
+static int ffecom_pending_calls_ = 0;
+static tree ffecom_float_zero_ = NULL_TREE;
+static tree ffecom_float_half_ = NULL_TREE;
+static tree ffecom_double_zero_ = NULL_TREE;
+static tree ffecom_double_half_ = NULL_TREE;
+static tree ffecom_func_result_;/* For functions. */
+static tree ffecom_func_length_;/* For CHARACTER fns. */
+static ffebld ffecom_list_blockdata_;
+static ffebld ffecom_list_common_;
+static ffebld ffecom_master_arglist_;
+static ffeinfoBasictype ffecom_master_bt_;
+static ffeinfoKindtype ffecom_master_kt_;
+static ffetargetCharacterSize ffecom_master_size_;
+static int ffecom_num_fns_ = 0;
+static int ffecom_num_entrypoints_ = 0;
+static bool ffecom_is_altreturning_ = FALSE;
+static tree ffecom_multi_type_node_;
+static tree ffecom_multi_retval_;
+static tree
+ ffecom_multi_fields_[FFEINFO_basictype][FFEINFO_kindtype];
+static bool ffecom_member_namelisted_; /* _member_phase1_ namelisted? */
+static bool ffecom_doing_entry_ = FALSE;
+static bool ffecom_transform_only_dummies_ = FALSE;
+
+/* Holds pointer-to-function expressions. */
+
+static tree ffecom_gfrt_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) NULL_TREE,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Holds the external names of the functions. */
+
+static char *ffecom_gfrt_name_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) NAME,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Whether the function returns. */
+
+static bool ffecom_gfrt_volatile_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) VOLATILE,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Whether the function returns type complex. */
+
+static bool ffecom_gfrt_complex_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) COMPLEX,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Type code for the function return value. */
+
+static ffecomRttype_ ffecom_gfrt_type_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) TYPE,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* String of codes for the function's arguments. */
+
+static char *ffecom_gfrt_argstring_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) ARGS,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Internal macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+
+/* We let tm.h override the types used here, to handle trivial differences
+ such as the choice of unsigned int or long unsigned int for size_t.
+ When machines start needing nontrivial differences in the size type,
+ it would be best to do something here to figure out automatically
+ from other information what type to use. */
+
+/* NOTE: g77 currently doesn't use these; see setting of sizetype and
+ change that if you need to. -- jcb 09/01/91. */
+
+#ifndef SIZE_TYPE
+#define SIZE_TYPE "long unsigned int"
+#endif
+
+#ifndef WCHAR_TYPE
+#define WCHAR_TYPE "int"
+#endif
+
+#define ffecom_concat_list_count_(catlist) ((catlist).count)
+#define ffecom_concat_list_expr_(catlist,i) ((catlist).exprs[(i)])
+#define ffecom_concat_list_maxlen_(catlist) ((catlist).maxlen)
+#define ffecom_concat_list_minlen_(catlist) ((catlist).minlen)
+
+#define ffecom_start_compstmt_ bison_rule_pushlevel_
+#define ffecom_end_compstmt_ bison_rule_compstmt_
+
+/* For each binding contour we allocate a binding_level structure
+ * which records the names defined in that contour.
+ * Contours include:
+ * 0) the global one
+ * 1) one for each function definition,
+ * where internal declarations of the parameters appear.
+ *
+ * The current meaning of a name can be found by searching the levels from
+ * the current one out to the global one.
+ */
+
+/* Note that the information in the `names' component of the global contour
+ is duplicated in the IDENTIFIER_GLOBAL_VALUEs of all identifiers. */
+
+struct binding_level
+ {
+ /* A chain of _DECL nodes for all variables, constants, functions, and
+ typedef types. These are in the reverse of the order supplied. */
+ tree names;
+
+ /* For each level (except not the global one), a chain of BLOCK nodes for
+ all the levels that were entered and exited one level down. */
+ tree blocks;
+
+ /* The BLOCK node for this level, if one has been preallocated. If 0, the
+ BLOCK is allocated (if needed) when the level is popped. */
+ tree this_block;
+
+ /* The binding level which this one is contained in (inherits from). */
+ struct binding_level *level_chain;
+ };
+
+#define NULL_BINDING_LEVEL (struct binding_level *) NULL
+
+/* The binding level currently in effect. */
+
+static struct binding_level *current_binding_level;
+
+/* A chain of binding_level structures awaiting reuse. */
+
+static struct binding_level *free_binding_level;
+
+/* The outermost binding level, for names of file scope.
+ This is created when the compiler is started and exists
+ through the entire run. */
+
+static struct binding_level *global_binding_level;
+
+/* Binding level structures are initialized by copying this one. */
+
+static struct binding_level clear_binding_level
+=
+{NULL, NULL, NULL, NULL_BINDING_LEVEL};
+
+/* Language-dependent contents of an identifier. */
+
+struct lang_identifier
+ {
+ struct tree_identifier ignore;
+ tree global_value, local_value, label_value;
+ bool invented;
+ };
+
+/* Macros for access to language-specific slots in an identifier. */
+/* Each of these slots contains a DECL node or null. */
+
+/* This represents the value which the identifier has in the
+ file-scope namespace. */
+#define IDENTIFIER_GLOBAL_VALUE(NODE) \
+ (((struct lang_identifier *)(NODE))->global_value)
+/* This represents the value which the identifier has in the current
+ scope. */
+#define IDENTIFIER_LOCAL_VALUE(NODE) \
+ (((struct lang_identifier *)(NODE))->local_value)
+/* This represents the value which the identifier has as a label in
+ the current label scope. */
+#define IDENTIFIER_LABEL_VALUE(NODE) \
+ (((struct lang_identifier *)(NODE))->label_value)
+/* This is nonzero if the identifier was "made up" by g77 code. */
+#define IDENTIFIER_INVENTED(NODE) \
+ (((struct lang_identifier *)(NODE))->invented)
+
+/* In identifiers, C uses the following fields in a special way:
+ TREE_PUBLIC to record that there was a previous local extern decl.
+ TREE_USED to record that such a decl was used.
+ TREE_ADDRESSABLE to record that the address of such a decl was used. */
+
+/* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function
+ that have names. Here so we can clear out their names' definitions
+ at the end of the function. */
+
+static tree named_labels;
+
+/* A list of LABEL_DECLs from outer contexts that are currently shadowed. */
+
+static tree shadowed_labels;
+
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+
+/* This is like gcc's stabilize_reference -- in fact, most of the code
+ comes from that -- but it handles the situation where the reference
+ is going to have its subparts picked at, and it shouldn't change
+ (or trigger extra invocations of functions in the subtrees) due to
+ this. save_expr is a bit overzealous, because we don't need the
+ entire thing calculated and saved like a temp. So, for DECLs, no
+ change is needed, because these are stable aggregates, and ARRAY_REF
+ and such might well be stable too, but for things like calculations,
+ we do need to calculate a snapshot of a value before picking at it. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_stabilize_aggregate_ (tree ref)
+{
+ tree result;
+ enum tree_code code = TREE_CODE (ref);
+
+ switch (code)
+ {
+ case VAR_DECL:
+ case PARM_DECL:
+ case RESULT_DECL:
+ /* No action is needed in this case. */
+ return ref;
+
+ case NOP_EXPR:
+ case CONVERT_EXPR:
+ case FLOAT_EXPR:
+ case FIX_TRUNC_EXPR:
+ case FIX_FLOOR_EXPR:
+ case FIX_ROUND_EXPR:
+ case FIX_CEIL_EXPR:
+ result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
+ break;
+
+ case INDIRECT_REF:
+ result = build_nt (INDIRECT_REF,
+ stabilize_reference_1 (TREE_OPERAND (ref, 0)));
+ break;
+
+ case COMPONENT_REF:
+ result = build_nt (COMPONENT_REF,
+ stabilize_reference (TREE_OPERAND (ref, 0)),
+ TREE_OPERAND (ref, 1));
+ break;
+
+ case BIT_FIELD_REF:
+ result = build_nt (BIT_FIELD_REF,
+ stabilize_reference (TREE_OPERAND (ref, 0)),
+ stabilize_reference_1 (TREE_OPERAND (ref, 1)),
+ stabilize_reference_1 (TREE_OPERAND (ref, 2)));
+ break;
+
+ case ARRAY_REF:
+ result = build_nt (ARRAY_REF,
+ stabilize_reference (TREE_OPERAND (ref, 0)),
+ stabilize_reference_1 (TREE_OPERAND (ref, 1)));
+ break;
+
+ case COMPOUND_EXPR:
+ result = build_nt (COMPOUND_EXPR,
+ stabilize_reference_1 (TREE_OPERAND (ref, 0)),
+ stabilize_reference (TREE_OPERAND (ref, 1)));
+ break;
+
+ case RTL_EXPR:
+ result = build1 (INDIRECT_REF, TREE_TYPE (ref),
+ save_expr (build1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (ref)),
+ ref)));
+ break;
+
+
+ default:
+ return save_expr (ref);
+
+ case ERROR_MARK:
+ return error_mark_node;
+ }
+
+ TREE_TYPE (result) = TREE_TYPE (ref);
+ TREE_READONLY (result) = TREE_READONLY (ref);
+ TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
+ TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
+ TREE_RAISES (result) = TREE_RAISES (ref);
+
+ return result;
+}
+#endif
+
+/* A rip-off of gcc's convert.c convert_to_complex function,
+ reworked to handle complex implemented as C structures
+ (RECORD_TYPE with two fields, real and imaginary `r' and `i'). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_convert_to_complex_ (tree type, tree expr)
+{
+ register enum tree_code form = TREE_CODE (TREE_TYPE (expr));
+ tree subtype;
+
+ assert (TREE_CODE (type) == RECORD_TYPE);
+
+ subtype = TREE_TYPE (TYPE_FIELDS (type));
+
+ if (form == REAL_TYPE || form == INTEGER_TYPE || form == ENUMERAL_TYPE)
+ {
+ expr = convert (subtype, expr);
+ return ffecom_2 (COMPLEX_EXPR, type, expr,
+ convert (subtype, integer_zero_node));
+ }
+
+ if (form == RECORD_TYPE)
+ {
+ tree elt_type = TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr)));
+ if (TYPE_MAIN_VARIANT (elt_type) == TYPE_MAIN_VARIANT (subtype))
+ return expr;
+ else
+ {
+ expr = save_expr (expr);
+ return ffecom_2 (COMPLEX_EXPR,
+ type,
+ convert (subtype,
+ ffecom_1 (REALPART_EXPR,
+ TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr))),
+ expr)),
+ convert (subtype,
+ ffecom_1 (IMAGPART_EXPR,
+ TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr))),
+ expr)));
+ }
+ }
+
+ if (form == POINTER_TYPE || form == REFERENCE_TYPE)
+ error ("pointer value used where a complex was expected");
+ else
+ error ("aggregate value used where a complex was expected");
+
+ return ffecom_2 (COMPLEX_EXPR, type,
+ convert (subtype, integer_zero_node),
+ convert (subtype, integer_zero_node));
+}
+#endif
+
+/* Like gcc's convert(), but crashes if widening might happen. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_convert_narrow_ (type, expr)
+ tree type, expr;
+{
+ register tree e = expr;
+ register enum tree_code code = TREE_CODE (type);
+
+ if (type == TREE_TYPE (e)
+ || TREE_CODE (e) == ERROR_MARK)
+ return e;
+ if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
+ return fold (build1 (NOP_EXPR, type, e));
+ if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
+ || code == ERROR_MARK)
+ return error_mark_node;
+ if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
+ {
+ assert ("void value not ignored as it ought to be" == NULL);
+ return error_mark_node;
+ }
+ assert (code != VOID_TYPE);
+ if ((code != RECORD_TYPE)
+ && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
+ assert ("converting COMPLEX to REAL" == NULL);
+ assert (code != ENUMERAL_TYPE);
+ if (code == INTEGER_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == INTEGER_TYPE);
+ assert (TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e)));
+ return fold (convert_to_integer (type, e));
+ }
+ if (code == POINTER_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE);
+ return fold (convert_to_pointer (type, e));
+ }
+ if (code == REAL_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == REAL_TYPE);
+ assert (TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e)));
+ return fold (convert_to_real (type, e));
+ }
+ if (code == COMPLEX_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == COMPLEX_TYPE);
+ assert (TYPE_PRECISION (TREE_TYPE (type)) <= TYPE_PRECISION (TREE_TYPE (TREE_TYPE (e))));
+ return fold (convert_to_complex (type, e));
+ }
+ if (code == RECORD_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE);
+ assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
+ <= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))));
+ return fold (ffecom_convert_to_complex_ (type, e));
+ }
+
+ assert ("conversion to non-scalar type requested" == NULL);
+ return error_mark_node;
+}
+#endif
+
+/* Like gcc's convert(), but crashes if narrowing might happen. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_convert_widen_ (type, expr)
+ tree type, expr;
+{
+ register tree e = expr;
+ register enum tree_code code = TREE_CODE (type);
+
+ if (type == TREE_TYPE (e)
+ || TREE_CODE (e) == ERROR_MARK)
+ return e;
+ if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
+ return fold (build1 (NOP_EXPR, type, e));
+ if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
+ || code == ERROR_MARK)
+ return error_mark_node;
+ if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
+ {
+ assert ("void value not ignored as it ought to be" == NULL);
+ return error_mark_node;
+ }
+ assert (code != VOID_TYPE);
+ if ((code != RECORD_TYPE)
+ && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
+ assert ("narrowing COMPLEX to REAL" == NULL);
+ assert (code != ENUMERAL_TYPE);
+ if (code == INTEGER_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == INTEGER_TYPE);
+ assert (TYPE_PRECISION (type) >= TYPE_PRECISION (TREE_TYPE (e)));
+ return fold (convert_to_integer (type, e));
+ }
+ if (code == POINTER_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE);
+ return fold (convert_to_pointer (type, e));
+ }
+ if (code == REAL_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == REAL_TYPE);
+ assert (TYPE_PRECISION (type) >= TYPE_PRECISION (TREE_TYPE (e)));
+ return fold (convert_to_real (type, e));
+ }
+ if (code == COMPLEX_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == COMPLEX_TYPE);
+ assert (TYPE_PRECISION (TREE_TYPE (type)) >= TYPE_PRECISION (TREE_TYPE (TREE_TYPE (e))));
+ return fold (convert_to_complex (type, e));
+ }
+ if (code == RECORD_TYPE)
+ {
+ assert (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE);
+ assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
+ >= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))));
+ return fold (ffecom_convert_to_complex_ (type, e));
+ }
+
+ assert ("conversion to non-scalar type requested" == NULL);
+ return error_mark_node;
+}
+#endif
+
+/* Handles making a COMPLEX type, either the standard
+ (but buggy?) gbe way, or the safer (but less elegant?)
+ f2c way. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_make_complex_type_ (tree subtype)
+{
+ tree type;
+ tree realfield;
+ tree imagfield;
+
+ if (ffe_is_emulate_complex ())
+ {
+ type = make_node (RECORD_TYPE);
+ realfield = ffecom_decl_field (type, NULL_TREE, "r", subtype);
+ imagfield = ffecom_decl_field (type, realfield, "i", subtype);
+ TYPE_FIELDS (type) = realfield;
+ layout_type (type);
+ }
+ else
+ {
+ type = make_node (COMPLEX_TYPE);
+ TREE_TYPE (type) = subtype;
+ layout_type (type);
+ }
+
+ return type;
+}
+#endif
+
+/* Chooses either the gbe or the f2c way to build a
+ complex constant. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart)
+{
+ tree bothparts;
+
+ if (ffe_is_emulate_complex ())
+ {
+ bothparts = build_tree_list (TYPE_FIELDS (type), realpart);
+ TREE_CHAIN (bothparts) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), imagpart);
+ bothparts = build (CONSTRUCTOR, type, NULL_TREE, bothparts);
+ }
+ else
+ {
+ bothparts = build_complex (type, realpart, imagpart);
+ }
+
+ return bothparts;
+}
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_arglist_expr_ (char *c, ffebld expr)
+{
+ tree list;
+ tree *plist = &list;
+ tree trail = NULL_TREE; /* Append char length args here. */
+ tree *ptrail = &trail;
+ tree length;
+ ffebld exprh;
+ tree item;
+ bool ptr = FALSE;
+ tree wanted = NULL_TREE;
+
+ while (expr != NULL)
+ {
+ if (*c != '\0')
+ {
+ ptr = FALSE;
+ if (*c == '&')
+ {
+ ptr = TRUE;
+ ++c;
+ }
+ switch (*(c++))
+ {
+ case '\0':
+ ptr = TRUE;
+ wanted = NULL_TREE;
+ break;
+
+ case 'a':
+ assert (ptr);
+ wanted = NULL_TREE;
+ break;
+
+ case 'c':
+ wanted = ffecom_f2c_complex_type_node;
+ break;
+
+ case 'd':
+ wanted = ffecom_f2c_doublereal_type_node;
+ break;
+
+ case 'e':
+ wanted = ffecom_f2c_doublecomplex_type_node;
+ break;
+
+ case 'f':
+ wanted = ffecom_f2c_real_type_node;
+ break;
+
+ case 'i':
+ wanted = ffecom_f2c_integer_type_node;
+ break;
+
+ case 'j':
+ wanted = ffecom_f2c_longint_type_node;
+ break;
+
+ default:
+ assert ("bad argstring code" == NULL);
+ wanted = NULL_TREE;
+ break;
+ }
+ }
+
+ exprh = ffebld_head (expr);
+ if (exprh == NULL)
+ wanted = NULL_TREE;
+
+ if ((wanted == NULL_TREE)
+ || (ptr
+ && (TYPE_MODE
+ (ffecom_tree_type[ffeinfo_basictype (ffebld_info (exprh))]
+ [ffeinfo_kindtype (ffebld_info (exprh))])
+ == TYPE_MODE (wanted))))
+ *plist
+ = build_tree_list (NULL_TREE,
+ ffecom_arg_ptr_to_expr (exprh,
+ &length));
+ else
+ {
+ item = ffecom_arg_expr (exprh, &length);
+ item = ffecom_convert_widen_ (wanted, item);
+ if (ptr)
+ {
+ item = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (item)),
+ item);
+ }
+ *plist
+ = build_tree_list (NULL_TREE,
+ item);
+ }
+
+ plist = &TREE_CHAIN (*plist);
+ expr = ffebld_trail (expr);
+ if (length != NULL_TREE)
+ {
+ *ptrail = build_tree_list (NULL_TREE, length);
+ ptrail = &TREE_CHAIN (*ptrail);
+ }
+ }
+
+ *plist = trail;
+
+ return list;
+}
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_widest_expr_type_ (ffebld list)
+{
+ ffebld item;
+ ffebld widest = NULL;
+ ffetype type;
+ ffetype widest_type = NULL;
+ tree t;
+
+ for (; list != NULL; list = ffebld_trail (list))
+ {
+ item = ffebld_head (list);
+ if (item == NULL)
+ continue;
+ if ((widest != NULL)
+ && (ffeinfo_basictype (ffebld_info (item))
+ != ffeinfo_basictype (ffebld_info (widest))))
+ continue;
+ type = ffeinfo_type (ffeinfo_basictype (ffebld_info (item)),
+ ffeinfo_kindtype (ffebld_info (item)));
+ if ((widest == FFEINFO_kindtypeNONE)
+ || (ffetype_size (type)
+ > ffetype_size (widest_type)))
+ {
+ widest = item;
+ widest_type = type;
+ }
+ }
+
+ assert (widest != NULL);
+ t = ffecom_tree_type[ffeinfo_basictype (ffebld_info (widest))]
+ [ffeinfo_kindtype (ffebld_info (widest))];
+ assert (t != NULL_TREE);
+ return t;
+}
+#endif
+
+/* Check whether dest and source might overlap. ffebld versions of these
+ might or might not be passed, will be NULL if not.
+
+ The test is really whether source_tree is modifiable and, if modified,
+ might overlap destination such that the value(s) in the destination might
+ change before it is finally modified. dest_* are the canonized
+ destination itself. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static bool
+ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size,
+ tree source_tree, ffebld source UNUSED,
+ bool scalar_arg)
+{
+ tree source_decl;
+ tree source_offset;
+ tree source_size;
+ tree t;
+
+ if (source_tree == NULL_TREE)
+ return FALSE;
+
+ switch (TREE_CODE (source_tree))
+ {
+ case ERROR_MARK:
+ case IDENTIFIER_NODE:
+ case INTEGER_CST:
+ case REAL_CST:
+ case COMPLEX_CST:
+ case STRING_CST:
+ case CONST_DECL:
+ case VAR_DECL:
+ case RESULT_DECL:
+ case FIELD_DECL:
+ case MINUS_EXPR:
+ case MULT_EXPR:
+ case TRUNC_DIV_EXPR:
+ case CEIL_DIV_EXPR:
+ case FLOOR_DIV_EXPR:
+ case ROUND_DIV_EXPR:
+ case TRUNC_MOD_EXPR:
+ case CEIL_MOD_EXPR:
+ case FLOOR_MOD_EXPR:
+ case ROUND_MOD_EXPR:
+ case RDIV_EXPR:
+ case EXACT_DIV_EXPR:
+ case FIX_TRUNC_EXPR:
+ case FIX_CEIL_EXPR:
+ case FIX_FLOOR_EXPR:
+ case FIX_ROUND_EXPR:
+ case FLOAT_EXPR:
+ case EXPON_EXPR:
+ case NEGATE_EXPR:
+ case MIN_EXPR:
+ case MAX_EXPR:
+ case ABS_EXPR:
+ case FFS_EXPR:
+ case LSHIFT_EXPR:
+ case RSHIFT_EXPR:
+ case LROTATE_EXPR:
+ case RROTATE_EXPR:
+ case BIT_IOR_EXPR:
+ case BIT_XOR_EXPR:
+ case BIT_AND_EXPR:
+ case BIT_ANDTC_EXPR:
+ case BIT_NOT_EXPR:
+ case TRUTH_ANDIF_EXPR:
+ case TRUTH_ORIF_EXPR:
+ case TRUTH_AND_EXPR:
+ case TRUTH_OR_EXPR:
+ case TRUTH_XOR_EXPR:
+ case TRUTH_NOT_EXPR:
+ case LT_EXPR:
+ case LE_EXPR:
+ case GT_EXPR:
+ case GE_EXPR:
+ case EQ_EXPR:
+ case NE_EXPR:
+ case COMPLEX_EXPR:
+ case CONJ_EXPR:
+ case REALPART_EXPR:
+ case IMAGPART_EXPR:
+ case LABEL_EXPR:
+ case COMPONENT_REF:
+ return FALSE;
+
+ case COMPOUND_EXPR:
+ return ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+ TREE_OPERAND (source_tree, 1), NULL,
+ scalar_arg);
+
+ case MODIFY_EXPR:
+ return ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+ TREE_OPERAND (source_tree, 0), NULL,
+ scalar_arg);
+
+ case CONVERT_EXPR:
+ case NOP_EXPR:
+ case NON_LVALUE_EXPR:
+ case PLUS_EXPR:
+ if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE)
+ return TRUE;
+
+ ffecom_tree_canonize_ptr_ (&source_decl, &source_offset,
+ source_tree);
+ source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree)));
+ break;
+
+ case COND_EXPR:
+ return
+ ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+ TREE_OPERAND (source_tree, 1), NULL,
+ scalar_arg)
+ || ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+ TREE_OPERAND (source_tree, 2), NULL,
+ scalar_arg);
+
+
+ case ADDR_EXPR:
+ ffecom_tree_canonize_ref_ (&source_decl, &source_offset,
+ &source_size,
+ TREE_OPERAND (source_tree, 0));
+ break;
+
+ case PARM_DECL:
+ if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE)
+ return TRUE;
+
+ source_decl = source_tree;
+ source_offset = size_zero_node;
+ source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree)));
+ break;
+
+ case SAVE_EXPR:
+ case REFERENCE_EXPR:
+ case PREDECREMENT_EXPR:
+ case PREINCREMENT_EXPR:
+ case POSTDECREMENT_EXPR:
+ case POSTINCREMENT_EXPR:
+ case INDIRECT_REF:
+ case ARRAY_REF:
+ case CALL_EXPR:
+ default:
+ return TRUE;
+ }
+
+ /* Come here when source_decl, source_offset, and source_size filled
+ in appropriately. */
+
+ if (source_decl == NULL_TREE)
+ return FALSE; /* No decl involved, so no overlap. */
+
+ if (source_decl != dest_decl)
+ return FALSE; /* Different decl, no overlap. */
+
+ if (TREE_CODE (dest_size) == ERROR_MARK)
+ return TRUE; /* Assignment into entire assumed-size
+ array? Shouldn't happen.... */
+
+ t = ffecom_2 (LE_EXPR, integer_type_node,
+ ffecom_2 (PLUS_EXPR, TREE_TYPE (dest_offset),
+ dest_offset,
+ convert (TREE_TYPE (dest_offset),
+ dest_size)),
+ convert (TREE_TYPE (dest_offset),
+ source_offset));
+
+ if (integer_onep (t))
+ return FALSE; /* Destination precedes source. */
+
+ if (!scalar_arg
+ || (source_size == NULL_TREE)
+ || (TREE_CODE (source_size) == ERROR_MARK)
+ || integer_zerop (source_size))
+ return TRUE; /* No way to tell if dest follows source. */
+
+ t = ffecom_2 (LE_EXPR, integer_type_node,
+ ffecom_2 (PLUS_EXPR, TREE_TYPE (source_offset),
+ source_offset,
+ convert (TREE_TYPE (source_offset),
+ source_size)),
+ convert (TREE_TYPE (source_offset),
+ dest_offset));
+
+ if (integer_onep (t))
+ return FALSE; /* Destination follows source. */
+
+ return TRUE; /* Destination and source overlap. */
+}
+#endif
+
+/* Check whether dest might overlap any of a list of arguments or is
+ in a COMMON area the callee might know about (and thus modify). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static bool
+ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED,
+ tree args, tree callee_commons,
+ bool scalar_args)
+{
+ tree arg;
+ tree dest_decl;
+ tree dest_offset;
+ tree dest_size;
+
+ ffecom_tree_canonize_ref_ (&dest_decl, &dest_offset, &dest_size,
+ dest_tree);
+
+ if (dest_decl == NULL_TREE)
+ return FALSE; /* Seems unlikely! */
+
+ /* If the decl cannot be determined reliably, or if its in COMMON
+ and the callee isn't known to not futz with COMMON via other
+ means, overlap might happen. */
+
+ if ((TREE_CODE (dest_decl) == ERROR_MARK)
+ || ((callee_commons != NULL_TREE)
+ && TREE_PUBLIC (dest_decl)))
+ return TRUE;
+
+ for (; args != NULL_TREE; args = TREE_CHAIN (args))
+ {
+ if (((arg = TREE_VALUE (args)) != NULL_TREE)
+ && ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+ arg, NULL, scalar_args))
+ return TRUE;
+ }
+
+ return FALSE;
+}
+#endif
+
+/* Build a string for a variable name as used by NAMELIST. This means that
+ if we're using the f2c library, we build an uppercase string, since
+ f2c does this. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_build_f2c_string_ (int i, char *s)
+{
+ if (!ffe_is_f2c_library ())
+ return build_string (i, s);
+
+ {
+ char *tmp;
+ char *p;
+ char *q;
+ char space[34];
+ tree t;
+
+ if (((size_t) i) > ARRAY_SIZE (space))
+ tmp = malloc_new_ks (malloc_pool_image (), "f2c_string", i);
+ else
+ tmp = &space[0];
+
+ for (p = s, q = tmp; *p != '\0'; ++p, ++q)
+ *q = ffesrc_toupper (*p);
+ *q = '\0';
+
+ t = build_string (i, tmp);
+
+ if (((size_t) i) > ARRAY_SIZE (space))
+ malloc_kill_ks (malloc_pool_image (), tmp, i);
+
+ return t;
+ }
+}
+
+#endif
+/* Returns CALL_EXPR or equivalent with given type (pass NULL_TREE for
+ type to just get whatever the function returns), handling the
+ f2c value-returning convention, if required, by prepending
+ to the arglist a pointer to a temporary to receive the return value. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
+ tree type, tree args, tree dest_tree,
+ ffebld dest, bool *dest_used, tree callee_commons,
+ bool scalar_args)
+{
+ tree item;
+ tree tempvar;
+
+ if (dest_used != NULL)
+ *dest_used = FALSE;
+
+ if (is_f2c_complex)
+ {
+ if ((dest_used == NULL)
+ || (dest == NULL)
+ || (ffeinfo_basictype (ffebld_info (dest))
+ != FFEINFO_basictypeCOMPLEX)
+ || (ffeinfo_kindtype (ffebld_info (dest)) != kt)
+ || ((type != NULL_TREE) && (TREE_TYPE (dest_tree) != type))
+ || ffecom_args_overlapping_ (dest_tree, dest, args,
+ callee_commons,
+ scalar_args))
+ {
+ tempvar = ffecom_push_tempvar (ffecom_tree_type
+ [FFEINFO_basictypeCOMPLEX][kt],
+ FFETARGET_charactersizeNONE,
+ -1, TRUE);
+ }
+ else
+ {
+ *dest_used = TRUE;
+ tempvar = dest_tree;
+ type = NULL_TREE;
+ }
+
+ item
+ = build_tree_list (NULL_TREE,
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (tempvar)),
+ tempvar));
+ TREE_CHAIN (item) = args;
+
+ item = ffecom_3s (CALL_EXPR, TREE_TYPE (TREE_TYPE (TREE_TYPE (fn))), fn,
+ item, NULL_TREE);
+
+ if (tempvar != dest_tree)
+ item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), item, tempvar);
+ }
+ else
+ item = ffecom_3s (CALL_EXPR, TREE_TYPE (TREE_TYPE (TREE_TYPE (fn))), fn,
+ args, NULL_TREE);
+
+ if ((type != NULL_TREE) && (TREE_TYPE (item) != type))
+ item = ffecom_convert_narrow_ (type, item);
+
+ return item;
+}
+#endif
+
+/* Given two arguments, transform them and make a call to the given
+ function via ffecom_call_. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
+ tree type, ffebld left, ffebld right,
+ tree dest_tree, ffebld dest, bool *dest_used,
+ tree callee_commons, bool scalar_args)
+{
+ tree left_tree;
+ tree right_tree;
+ tree left_length;
+ tree right_length;
+
+ ffecom_push_calltemps ();
+ left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
+ right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
+ ffecom_pop_calltemps ();
+
+ left_tree = build_tree_list (NULL_TREE, left_tree);
+ right_tree = build_tree_list (NULL_TREE, right_tree);
+ TREE_CHAIN (left_tree) = right_tree;
+
+ if (left_length != NULL_TREE)
+ {
+ left_length = build_tree_list (NULL_TREE, left_length);
+ TREE_CHAIN (right_tree) = left_length;
+ }
+
+ if (right_length != NULL_TREE)
+ {
+ right_length = build_tree_list (NULL_TREE, right_length);
+ if (left_length != NULL_TREE)
+ TREE_CHAIN (left_length) = right_length;
+ else
+ TREE_CHAIN (right_tree) = right_length;
+ }
+
+ return ffecom_call_ (fn, kt, is_f2c_complex, type, left_tree,
+ dest_tree, dest, dest_used, callee_commons,
+ scalar_args);
+}
+#endif
+
+/* ffecom_char_args_ -- Return ptr/length args for char subexpression
+
+ tree ptr_arg;
+ tree length_arg;
+ ffebld expr;
+ ffecom_char_args_(&ptr_arg,&length_arg,expr);
+
+ Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
+ subexpressions by constructing the appropriate trees for the ptr-to-
+ character-text and length-of-character-text arguments in a calling
+ sequence. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_char_args_ (tree *xitem, tree *length, ffebld expr)
+{
+ tree item;
+ tree high;
+ ffetargetCharacter1 val;
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opCONTER:
+ val = ffebld_constant_character1 (ffebld_conter (expr));
+ *length = build_int_2 (ffetarget_length_character1 (val), 0);
+ TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+ high = build_int_2 (ffetarget_length_character1 (val),
+ 0);
+ TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
+ item = build_string (ffetarget_length_character1 (val),
+ ffetarget_text_character1 (val));
+ TREE_TYPE (item)
+ = build_type_variant
+ (build_array_type
+ (char_type_node,
+ build_range_type
+ (ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ high)),
+ 1, 0);
+ TREE_CONSTANT (item) = 1;
+ TREE_STATIC (item) = 1;
+ item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
+ item);
+ break;
+
+ case FFEBLD_opSYMTER:
+ {
+ ffesymbol s = ffebld_symter (expr);
+
+ item = ffesymbol_hook (s).decl_tree;
+ if (item == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ item = ffesymbol_hook (s).decl_tree;
+ }
+ if (ffesymbol_kind (s) == FFEINFO_kindENTITY)
+ {
+ if (ffesymbol_size (s) == FFETARGET_charactersizeNONE)
+ *length = ffesymbol_hook (s).length_tree;
+ else
+ {
+ *length = build_int_2 (ffesymbol_size (s), 0);
+ TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+ }
+ }
+ else if (item == error_mark_node)
+ *length = error_mark_node;
+ else /* FFEINFO_kindFUNCTION: */
+ *length = NULL_TREE;
+ if (!ffesymbol_hook (s).addr
+ && (item != error_mark_node))
+ item = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (item)),
+ item);
+ }
+ break;
+
+ case FFEBLD_opARRAYREF:
+ {
+ ffebld dims[FFECOM_dimensionsMAX];
+ tree array;
+ int i;
+
+ ffecom_push_calltemps ();
+ ffecom_char_args_ (&item, length, ffebld_left (expr));
+ ffecom_pop_calltemps ();
+
+ if (item == error_mark_node || *length == error_mark_node)
+ {
+ item = *length = error_mark_node;
+ break;
+ }
+
+ /* Build up ARRAY_REFs in reverse order (since we're column major
+ here in Fortran land). */
+
+ for (i = 0, expr = ffebld_right (expr);
+ expr != NULL;
+ expr = ffebld_trail (expr))
+ dims[i++] = ffebld_head (expr);
+
+ for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
+ i >= 0;
+ --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
+ {
+ item = ffecom_2 (PLUS_EXPR, build_pointer_type (TREE_TYPE (array)),
+ item,
+ size_binop (MULT_EXPR,
+ size_in_bytes (TREE_TYPE (array)),
+ size_binop (MINUS_EXPR,
+ ffecom_expr (dims[i]),
+ TYPE_MIN_VALUE (TYPE_DOMAIN (array)))));
+ }
+ }
+ break;
+
+ case FFEBLD_opSUBSTR:
+ {
+ ffebld start;
+ ffebld end;
+ ffebld thing = ffebld_right (expr);
+ tree start_tree;
+ tree end_tree;
+
+ assert (ffebld_op (thing) == FFEBLD_opITEM);
+ start = ffebld_head (thing);
+ thing = ffebld_trail (thing);
+ assert (ffebld_trail (thing) == NULL);
+ end = ffebld_head (thing);
+
+ ffecom_push_calltemps ();
+ ffecom_char_args_ (&item, length, ffebld_left (expr));
+ ffecom_pop_calltemps ();
+
+ if (item == error_mark_node || *length == error_mark_node)
+ {
+ item = *length = error_mark_node;
+ break;
+ }
+
+ if (start == NULL)
+ {
+ if (end == NULL)
+ ;
+ else
+ {
+ end_tree = convert (ffecom_f2c_ftnlen_type_node,
+ ffecom_expr (end));
+
+ if (end_tree == error_mark_node)
+ {
+ item = *length = error_mark_node;
+ break;
+ }
+
+ *length = end_tree;
+ }
+ }
+ else
+ {
+ start_tree = convert (ffecom_f2c_ftnlen_type_node,
+ ffecom_expr (start));
+
+ if (start_tree == error_mark_node)
+ {
+ item = *length = error_mark_node;
+ break;
+ }
+
+ start_tree = ffecom_save_tree (start_tree);
+
+ item = ffecom_2 (PLUS_EXPR, TREE_TYPE (item),
+ item,
+ ffecom_2 (MINUS_EXPR,
+ TREE_TYPE (start_tree),
+ start_tree,
+ ffecom_f2c_ftnlen_one_node));
+
+ if (end == NULL)
+ {
+ *length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ ffecom_2 (MINUS_EXPR,
+ ffecom_f2c_ftnlen_type_node,
+ *length,
+ start_tree));
+ }
+ else
+ {
+ end_tree = convert (ffecom_f2c_ftnlen_type_node,
+ ffecom_expr (end));
+
+ if (end_tree == error_mark_node)
+ {
+ item = *length = error_mark_node;
+ break;
+ }
+
+ *length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ ffecom_2 (MINUS_EXPR,
+ ffecom_f2c_ftnlen_type_node,
+ end_tree, start_tree));
+ }
+ }
+ }
+ break;
+
+ case FFEBLD_opFUNCREF:
+ {
+ ffesymbol s = ffebld_symter (ffebld_left (expr));
+ tree tempvar;
+ tree args;
+ ffetargetCharacterSize size = ffeinfo_size (ffebld_info (expr));
+ ffecomGfrt ix;
+
+ if (size == FFETARGET_charactersizeNONE)
+ size = 24; /* ~~~~ Kludge alert! This should someday be fixed. */
+
+ *length = build_int_2 (size, 0);
+ TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+
+ if (ffeinfo_where (ffebld_info (ffebld_left (expr)))
+ == FFEINFO_whereINTRINSIC)
+ {
+ if (size == 1)
+ { /* Invocation of an intrinsic returning CHARACTER*1. */
+ item = ffecom_expr_intrinsic_ (expr, NULL_TREE,
+ NULL, NULL);
+ break;
+ }
+ ix = ffeintrin_gfrt_direct (ffebld_symter_implementation (ffebld_left (expr)));
+ assert (ix != FFECOM_gfrt);
+ item = ffecom_gfrt_tree_ (ix);
+ }
+ else
+ {
+ ix = FFECOM_gfrt;
+ item = ffesymbol_hook (s).decl_tree;
+ if (item == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ item = ffesymbol_hook (s).decl_tree;
+ }
+ if (item == error_mark_node)
+ {
+ item = *length = error_mark_node;
+ break;
+ }
+
+ if (!ffesymbol_hook (s).addr)
+ item = ffecom_1_fn (item);
+ }
+
+ assert (ffecom_pending_calls_ != 0);
+ tempvar = ffecom_push_tempvar (char_type_node, size, -1, TRUE);
+ tempvar = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (tempvar)),
+ tempvar);
+
+ ffecom_push_calltemps ();
+
+ args = build_tree_list (NULL_TREE, tempvar);
+
+ if (ffesymbol_where (s) == FFEINFO_whereCONSTANT) /* Sfunc args by value. */
+ TREE_CHAIN (args) = ffecom_list_expr (ffebld_right (expr));
+ else
+ {
+ TREE_CHAIN (args) = build_tree_list (NULL_TREE, *length);
+ if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+ {
+ TREE_CHAIN (TREE_CHAIN (args))
+ = ffecom_arglist_expr_ (ffecom_gfrt_args_ (ix),
+ ffebld_right (expr));
+ }
+ else
+ {
+ TREE_CHAIN (TREE_CHAIN (args))
+ = ffecom_list_ptr_to_expr (ffebld_right (expr));
+ }
+ }
+
+ item = ffecom_3s (CALL_EXPR,
+ TREE_TYPE (TREE_TYPE (TREE_TYPE (item))),
+ item, args, NULL_TREE);
+ item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), item,
+ tempvar);
+
+ ffecom_pop_calltemps ();
+ }
+ break;
+
+ case FFEBLD_opCONVERT:
+
+ ffecom_push_calltemps ();
+ ffecom_char_args_ (&item, length, ffebld_left (expr));
+ ffecom_pop_calltemps ();
+
+ if (item == error_mark_node || *length == error_mark_node)
+ {
+ item = *length = error_mark_node;
+ break;
+ }
+
+ if ((ffebld_size_known (ffebld_left (expr))
+ == FFETARGET_charactersizeNONE)
+ || (ffebld_size_known (ffebld_left (expr)) < (ffebld_size (expr))))
+ { /* Possible blank-padding needed, copy into
+ temporary. */
+ tree tempvar;
+ tree args;
+ tree newlen;
+
+ assert (ffecom_pending_calls_ != 0);
+ tempvar = ffecom_push_tempvar (char_type_node,
+ ffebld_size (expr), -1, TRUE);
+ tempvar = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (tempvar)),
+ tempvar);
+
+ newlen = build_int_2 (ffebld_size (expr), 0);
+ TREE_TYPE (newlen) = ffecom_f2c_ftnlen_type_node;
+
+ args = build_tree_list (NULL_TREE, tempvar);
+ TREE_CHAIN (args) = build_tree_list (NULL_TREE, item);
+ TREE_CHAIN (TREE_CHAIN (args)) = build_tree_list (NULL_TREE, newlen);
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args)))
+ = build_tree_list (NULL_TREE, *length);
+
+ item = ffecom_call_gfrt (FFECOM_gfrtCOPY, args);
+ TREE_SIDE_EFFECTS (item) = 1;
+ item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), fold (item),
+ tempvar);
+ *length = newlen;
+ }
+ else
+ { /* Just truncate the length. */
+ *length = build_int_2 (ffebld_size (expr), 0);
+ TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+ }
+ break;
+
+ default:
+ assert ("bad op for single char arg expr" == NULL);
+ item = NULL_TREE;
+ break;
+ }
+
+ *xitem = item;
+}
+#endif
+
+/* Check the size of the type to be sure it doesn't overflow the
+ "portable" capacities of the compiler back end. `dummy' types
+ can generally overflow the normal sizes as long as the computations
+ themselves don't overflow. A particular target of the back end
+ must still enforce its size requirements, though, and the back
+ end takes care of this in stor-layout.c. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy)
+{
+ if (TREE_CODE (type) == ERROR_MARK)
+ return type;
+
+ if (TYPE_SIZE (type) == NULL_TREE)
+ return type;
+
+ if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
+ return type;
+
+ if ((tree_int_cst_sgn (TYPE_SIZE (type)) < 0)
+ || (!dummy && (TREE_INT_CST_HIGH (TYPE_SIZE (type)) != 0))
+ || TREE_OVERFLOW (TYPE_SIZE (type)))
+ {
+ ffebad_start (FFEBAD_ARRAY_LARGE);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
+ ffebad_finish ();
+
+ return error_mark_node;
+ }
+
+ return type;
+}
+#endif
+
+/* Builds a length argument (PARM_DECL). Also wraps type in an array type
+ where the dimension info is (1:size) where <size> is ffesymbol_size(s) if
+ known, length_arg if not known (FFETARGET_charactersizeNONE). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s)
+{
+ ffetargetCharacterSize sz = ffesymbol_size (s);
+ tree highval;
+ tree tlen;
+ tree type = *xtype;
+
+ if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+ tlen = NULL_TREE; /* A statement function, no length passed. */
+ else
+ {
+ if (ffesymbol_where (s) == FFEINFO_whereDUMMY)
+ tlen = ffecom_get_invented_identifier ("__g77_length_%s",
+ ffesymbol_text (s), 0);
+ else
+ tlen = ffecom_get_invented_identifier ("__g77_%s",
+ "length", 0);
+ tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node);
+#if BUILT_FOR_270
+ DECL_ARTIFICIAL (tlen) = 1;
+#endif
+ }
+
+ if (sz == FFETARGET_charactersizeNONE)
+ {
+ assert (tlen != NULL_TREE);
+ highval = tlen;
+ }
+ else
+ {
+ highval = build_int_2 (sz, 0);
+ TREE_TYPE (highval) = ffecom_f2c_ftnlen_type_node;
+ }
+
+ type = build_array_type (type,
+ build_range_type (ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ highval));
+
+ *xtype = type;
+ return tlen;
+}
+
+#endif
+/* ffecom_concat_list_gather_ -- Gather list of concatenated string exprs
+
+ ffecomConcatList_ catlist;
+ ffebld expr; // expr of CHARACTER basictype.
+ ffetargetCharacterSize max; // max chars to gather or _...NONE if no max
+ catlist = ffecom_concat_list_gather_(catlist,expr,max);
+
+ Scans expr for character subexpressions, updates and returns catlist
+ accordingly. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffecomConcatList_
+ffecom_concat_list_gather_ (ffecomConcatList_ catlist, ffebld expr,
+ ffetargetCharacterSize max)
+{
+ ffetargetCharacterSize sz;
+
+recurse: /* :::::::::::::::::::: */
+
+ if (expr == NULL)
+ return catlist;
+
+ if ((max != FFETARGET_charactersizeNONE) && (catlist.minlen >= max))
+ return catlist; /* Don't append any more items. */
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opCONTER:
+ case FFEBLD_opSYMTER:
+ case FFEBLD_opARRAYREF:
+ case FFEBLD_opFUNCREF:
+ case FFEBLD_opSUBSTR:
+ case FFEBLD_opCONVERT: /* Callers should strip this off beforehand
+ if they don't need to preserve it. */
+ if (catlist.count == catlist.max)
+ { /* Make a (larger) list. */
+ ffebld *newx;
+ int newmax;
+
+ newmax = (catlist.max == 0) ? 8 : catlist.max * 2;
+ newx = malloc_new_ks (malloc_pool_image (), "catlist",
+ newmax * sizeof (newx[0]));
+ if (catlist.max != 0)
+ {
+ memcpy (newx, catlist.exprs, catlist.max * sizeof (newx[0]));
+ malloc_kill_ks (malloc_pool_image (), catlist.exprs,
+ catlist.max * sizeof (newx[0]));
+ }
+ catlist.max = newmax;
+ catlist.exprs = newx;
+ }
+ if ((sz = ffebld_size_known (expr)) != FFETARGET_charactersizeNONE)
+ catlist.minlen += sz;
+ else
+ ++catlist.minlen; /* Not true for F90; can be 0 length. */
+ if ((sz = ffebld_size_max (expr)) == FFETARGET_charactersizeNONE)
+ catlist.maxlen = sz;
+ else
+ catlist.maxlen += sz;
+ if ((max != FFETARGET_charactersizeNONE) && (catlist.minlen > max))
+ { /* This item overlaps (or is beyond) the end
+ of the destination. */
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opCONTER:
+ case FFEBLD_opSYMTER:
+ case FFEBLD_opARRAYREF:
+ case FFEBLD_opFUNCREF:
+ case FFEBLD_opSUBSTR:
+ break; /* ~~Do useful truncations here. */
+
+ default:
+ assert ("op changed or inconsistent switches!" == NULL);
+ break;
+ }
+ }
+ catlist.exprs[catlist.count++] = expr;
+ return catlist;
+
+ case FFEBLD_opPAREN:
+ expr = ffebld_left (expr);
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFEBLD_opCONCATENATE:
+ catlist = ffecom_concat_list_gather_ (catlist, ffebld_left (expr), max);
+ expr = ffebld_right (expr);
+ goto recurse; /* :::::::::::::::::::: */
+
+#if 0 /* Breaks passing small actual arg to larger
+ dummy arg of sfunc */
+ case FFEBLD_opCONVERT:
+ expr = ffebld_left (expr);
+ {
+ ffetargetCharacterSize cmax;
+
+ cmax = catlist.len + ffebld_size_known (expr);
+
+ if ((max == FFETARGET_charactersizeNONE) || (max > cmax))
+ max = cmax;
+ }
+ goto recurse; /* :::::::::::::::::::: */
+#endif
+
+ case FFEBLD_opANY:
+ return catlist;
+
+ default:
+ assert ("bad op in _gather_" == NULL);
+ return catlist;
+ }
+}
+
+#endif
+/* ffecom_concat_list_kill_ -- Kill list of concatenated string exprs
+
+ ffecomConcatList_ catlist;
+ ffecom_concat_list_kill_(catlist);
+
+ Anything allocated within the list info is deallocated. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_concat_list_kill_ (ffecomConcatList_ catlist)
+{
+ if (catlist.max != 0)
+ malloc_kill_ks (malloc_pool_image (), catlist.exprs,
+ catlist.max * sizeof (catlist.exprs[0]));
+}
+
+#endif
+/* ffecom_concat_list_new_ -- Make list of concatenated string exprs
+
+ ffecomConcatList_ catlist;
+ ffebld expr; // Root expr of CHARACTER basictype.
+ ffetargetCharacterSize max; // max chars to gather or _...NONE if no max
+ catlist = ffecom_concat_list_new_(expr,max);
+
+ Returns a flattened list of concatenated subexpressions given a
+ tree of such expressions. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffecomConcatList_
+ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max)
+{
+ ffecomConcatList_ catlist;
+
+ catlist.maxlen = catlist.minlen = catlist.max = catlist.count = 0;
+ return ffecom_concat_list_gather_ (catlist, expr, max);
+}
+
+#endif
+
+/* Provide some kind of useful info on member of aggregate area,
+ since current g77/gcc technology does not provide debug info
+ on these members. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_debug_kludge_ (tree aggr, char *aggr_type, ffesymbol member,
+ tree member_type UNUSED, ffetargetOffset offset)
+{
+ tree value;
+ tree decl;
+ int len;
+ char *buff;
+ char space[120];
+#if 0
+ tree type_id;
+
+ for (type_id = member_type;
+ TREE_CODE (type_id) != IDENTIFIER_NODE;
+ )
+ {
+ switch (TREE_CODE (type_id))
+ {
+ case INTEGER_TYPE:
+ case REAL_TYPE:
+ type_id = TYPE_NAME (type_id);
+ break;
+
+ case ARRAY_TYPE:
+ case COMPLEX_TYPE:
+ type_id = TREE_TYPE (type_id);
+ break;
+
+ default:
+ assert ("no IDENTIFIER_NODE for type!" == NULL);
+ type_id = error_mark_node;
+ break;
+ }
+ }
+#endif
+
+ if (ffecom_transform_only_dummies_
+ || !ffe_is_debug_kludge ())
+ return; /* Can't do this yet, maybe later. */
+
+ len = 60
+ + strlen (aggr_type)
+ + IDENTIFIER_LENGTH (DECL_NAME (aggr));
+#if 0
+ + IDENTIFIER_LENGTH (type_id);
+#endif
+
+ if (((size_t) len) >= ARRAY_SIZE (space))
+ buff = malloc_new_ks (malloc_pool_image (), "debug_kludge", len + 1);
+ else
+ buff = &space[0];
+
+ sprintf (&buff[0], "At (%s) `%s' plus %ld bytes",
+ aggr_type,
+ IDENTIFIER_POINTER (DECL_NAME (aggr)),
+ (long int) offset);
+
+ value = build_string (len, buff);
+ TREE_TYPE (value)
+ = build_type_variant (build_array_type (char_type_node,
+ build_range_type
+ (integer_type_node,
+ integer_one_node,
+ build_int_2 (strlen (buff), 0))),
+ 1, 0);
+ decl = build_decl (VAR_DECL,
+ ffecom_get_identifier_ (ffesymbol_text (member)),
+ TREE_TYPE (value));
+ TREE_CONSTANT (decl) = 1;
+ TREE_STATIC (decl) = 1;
+ DECL_INITIAL (decl) = error_mark_node;
+ DECL_IN_SYSTEM_HEADER (decl) = 1; /* Don't let -Wunused complain. */
+ decl = start_decl (decl, FALSE);
+ finish_decl (decl, value, FALSE);
+
+ if (buff != &space[0])
+ malloc_kill_ks (malloc_pool_image (), buff, len + 1);
+}
+#endif
+
+/* ffecom_do_entry_ -- Do compilation of a particular entrypoint
+
+ ffesymbol fn; // the SUBROUTINE, FUNCTION, or ENTRY symbol itself
+ int i; // entry# for this entrypoint (used by master fn)
+ ffecom_do_entrypoint_(s,i);
+
+ Makes a public entry point that calls our private master fn (already
+ compiled). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_do_entry_ (ffesymbol fn, int entrynum)
+{
+ ffebld item;
+ tree type; /* Type of function. */
+ tree multi_retval; /* Var holding return value (union). */
+ tree result; /* Var holding result. */
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffeglobal g;
+ ffeglobalType gt;
+ bool charfunc; /* All entry points return same type
+ CHARACTER. */
+ bool cmplxfunc; /* Use f2c way of returning COMPLEX. */
+ bool multi; /* Master fn has multiple return types. */
+ bool altreturning = FALSE; /* This entry point has alternate returns. */
+ int yes;
+
+ /* c-parse.y indeed does call suspend_momentary and not only ignores the
+ return value, but also never calls resume_momentary, when starting an
+ outer function (see "fndef:", "setspecs:", and so on). So g77 does the
+ same thing. It shouldn't be a problem since start_function calls
+ temporary_allocation, but it might be necessary. If it causes a problem
+ here, then maybe there's a bug lurking in gcc. NOTE: This identical
+ comment appears twice in thist file. */
+
+ suspend_momentary ();
+
+ ffecom_doing_entry_ = TRUE; /* Don't bother with array dimensions. */
+
+ switch (ffecom_primary_entry_kind_)
+ {
+ case FFEINFO_kindFUNCTION:
+
+ /* Determine actual return type for function. */
+
+ gt = FFEGLOBAL_typeFUNC;
+ bt = ffesymbol_basictype (fn);
+ kt = ffesymbol_kindtype (fn);
+ if (bt == FFEINFO_basictypeNONE)
+ {
+ ffeimplic_establish_symbol (fn);
+ if (ffesymbol_funcresult (fn) != NULL)
+ ffeimplic_establish_symbol (ffesymbol_funcresult (fn));
+ bt = ffesymbol_basictype (fn);
+ kt = ffesymbol_kindtype (fn);
+ }
+
+ if (bt == FFEINFO_basictypeCHARACTER)
+ charfunc = TRUE, cmplxfunc = FALSE;
+ else if ((bt == FFEINFO_basictypeCOMPLEX)
+ && ffesymbol_is_f2c (fn))
+ charfunc = FALSE, cmplxfunc = TRUE;
+ else
+ charfunc = cmplxfunc = FALSE;
+
+ if (charfunc)
+ type = ffecom_tree_fun_type_void;
+ else if (ffesymbol_is_f2c (fn))
+ type = ffecom_tree_fun_type[bt][kt];
+ else
+ type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
+
+ if ((type == NULL_TREE)
+ || (TREE_TYPE (type) == NULL_TREE))
+ type = ffecom_tree_fun_type_void; /* _sym_exec_transition. */
+
+ multi = (ffecom_master_bt_ == FFEINFO_basictypeNONE);
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ gt = FFEGLOBAL_typeSUBR;
+ bt = FFEINFO_basictypeNONE;
+ kt = FFEINFO_kindtypeNONE;
+ if (ffecom_is_altreturning_)
+ { /* Am _I_ altreturning? */
+ for (item = ffesymbol_dummyargs (fn);
+ item != NULL;
+ item = ffebld_trail (item))
+ {
+ if (ffebld_op (ffebld_head (item)) == FFEBLD_opSTAR)
+ {
+ altreturning = TRUE;
+ break;
+ }
+ }
+ if (altreturning)
+ type = ffecom_tree_subr_type;
+ else
+ type = ffecom_tree_fun_type_void;
+ }
+ else
+ type = ffecom_tree_fun_type_void;
+ charfunc = FALSE;
+ cmplxfunc = FALSE;
+ multi = FALSE;
+ break;
+
+ default:
+ assert ("say what??" == NULL);
+ /* Fall through. */
+ case FFEINFO_kindANY:
+ gt = FFEGLOBAL_typeANY;
+ bt = FFEINFO_basictypeNONE;
+ kt = FFEINFO_kindtypeNONE;
+ type = error_mark_node;
+ charfunc = FALSE;
+ cmplxfunc = FALSE;
+ multi = FALSE;
+ break;
+ }
+
+ /* build_decl uses the current lineno and input_filename to set the decl
+ source info. So, I've putzed with ffestd and ffeste code to update that
+ source info to point to the appropriate statement just before calling
+ ffecom_do_entrypoint (which calls this fn). */
+
+ start_function (ffecom_get_external_identifier_ (fn),
+ type,
+ 0, /* nested/inline */
+ 1); /* TREE_PUBLIC */
+
+ if (((g = ffesymbol_global (fn)) != NULL)
+ && ((ffeglobal_type (g) == gt)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+ {
+ ffeglobal_set_hook (g, current_function_decl);
+ }
+
+ /* Reset args in master arg list so they get retransitioned. */
+
+ for (item = ffecom_master_arglist_;
+ item != NULL;
+ item = ffebld_trail (item))
+ {
+ ffebld arg;
+ ffesymbol s;
+
+ arg = ffebld_head (item);
+ if (ffebld_op (arg) != FFEBLD_opSYMTER)
+ continue; /* Alternate return or some such thing. */
+ s = ffebld_symter (arg);
+ ffesymbol_hook (s).decl_tree = NULL_TREE;
+ ffesymbol_hook (s).length_tree = NULL_TREE;
+ }
+
+ /* Build dummy arg list for this entry point. */
+
+ yes = suspend_momentary ();
+
+ if (charfunc || cmplxfunc)
+ { /* Prepend arg for where result goes. */
+ tree type;
+ tree length;
+
+ if (charfunc)
+ type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
+ else
+ type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];
+
+ result = ffecom_get_invented_identifier ("__g77_%s",
+ "result", 0);
+
+ /* Make length arg _and_ enhance type info for CHAR arg itself. */
+
+ if (charfunc)
+ length = ffecom_char_enhance_arg_ (&type, fn);
+ else
+ length = NULL_TREE; /* Not ref'd if !charfunc. */
+
+ type = build_pointer_type (type);
+ result = build_decl (PARM_DECL, result, type);
+
+ push_parm_decl (result);
+ ffecom_func_result_ = result;
+
+ if (charfunc)
+ {
+ push_parm_decl (length);
+ ffecom_func_length_ = length;
+ }
+ }
+ else
+ result = DECL_RESULT (current_function_decl);
+
+ ffecom_push_dummy_decls_ (ffesymbol_dummyargs (fn), FALSE);
+
+ resume_momentary (yes);
+
+ store_parm_decls (0);
+
+ ffecom_start_compstmt_ ();
+
+ /* Make local var to hold return type for multi-type master fn. */
+
+ if (multi)
+ {
+ yes = suspend_momentary ();
+
+ multi_retval = ffecom_get_invented_identifier ("__g77_%s",
+ "multi_retval", 0);
+ multi_retval = build_decl (VAR_DECL, multi_retval,
+ ffecom_multi_type_node_);
+ multi_retval = start_decl (multi_retval, FALSE);
+ finish_decl (multi_retval, NULL_TREE, FALSE);
+
+ resume_momentary (yes);
+ }
+ else
+ multi_retval = NULL_TREE; /* Not actually ref'd if !multi. */
+
+ /* Here we emit the actual code for the entry point. */
+
+ {
+ ffebld list;
+ ffebld arg;
+ ffesymbol s;
+ tree arglist = NULL_TREE;
+ tree *plist = &arglist;
+ tree prepend;
+ tree call;
+ tree actarg;
+ tree master_fn;
+
+ /* Prepare actual arg list based on master arg list. */
+
+ for (list = ffecom_master_arglist_;
+ list != NULL;
+ list = ffebld_trail (list))
+ {
+ arg = ffebld_head (list);
+ if (ffebld_op (arg) != FFEBLD_opSYMTER)
+ continue;
+ s = ffebld_symter (arg);
+ if (ffesymbol_hook (s).decl_tree == NULL_TREE)
+ actarg = null_pointer_node; /* We don't have this arg. */
+ else
+ actarg = ffesymbol_hook (s).decl_tree;
+ *plist = build_tree_list (NULL_TREE, actarg);
+ plist = &TREE_CHAIN (*plist);
+ }
+
+ /* This code appends the length arguments for character
+ variables/arrays. */
+
+ for (list = ffecom_master_arglist_;
+ list != NULL;
+ list = ffebld_trail (list))
+ {
+ arg = ffebld_head (list);
+ if (ffebld_op (arg) != FFEBLD_opSYMTER)
+ continue;
+ s = ffebld_symter (arg);
+ if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER)
+ continue; /* Only looking for CHARACTER arguments. */
+ if (ffesymbol_kind (s) != FFEINFO_kindENTITY)
+ continue; /* Only looking for variables and arrays. */
+ if (ffesymbol_hook (s).length_tree == NULL_TREE)
+ actarg = ffecom_f2c_ftnlen_zero_node; /* We don't have this arg. */
+ else
+ actarg = ffesymbol_hook (s).length_tree;
+ *plist = build_tree_list (NULL_TREE, actarg);
+ plist = &TREE_CHAIN (*plist);
+ }
+
+ /* Prepend character-value return info to actual arg list. */
+
+ if (charfunc)
+ {
+ prepend = build_tree_list (NULL_TREE, ffecom_func_result_);
+ TREE_CHAIN (prepend)
+ = build_tree_list (NULL_TREE, ffecom_func_length_);
+ TREE_CHAIN (TREE_CHAIN (prepend)) = arglist;
+ arglist = prepend;
+ }
+
+ /* Prepend multi-type return value to actual arg list. */
+
+ if (multi)
+ {
+ prepend
+ = build_tree_list (NULL_TREE,
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (multi_retval)),
+ multi_retval));
+ TREE_CHAIN (prepend) = arglist;
+ arglist = prepend;
+ }
+
+ /* Prepend my entry-point number to the actual arg list. */
+
+ prepend = build_tree_list (NULL_TREE, build_int_2 (entrynum, 0));
+ TREE_CHAIN (prepend) = arglist;
+ arglist = prepend;
+
+ /* Build the call to the master function. */
+
+ master_fn = ffecom_1_fn (ffecom_previous_function_decl_);
+ call = ffecom_3s (CALL_EXPR,
+ TREE_TYPE (TREE_TYPE (TREE_TYPE (master_fn))),
+ master_fn, arglist, NULL_TREE);
+
+ /* Decide whether the master function is a function or subroutine, and
+ handle the return value for my entry point. */
+
+ if (charfunc || ((ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)
+ && !altreturning))
+ {
+ expand_expr_stmt (call);
+ expand_null_return ();
+ }
+ else if (multi && cmplxfunc)
+ {
+ expand_expr_stmt (call);
+ result
+ = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (result))),
+ result);
+ result = ffecom_modify (NULL_TREE, result,
+ ffecom_2 (COMPONENT_REF, TREE_TYPE (result),
+ multi_retval,
+ ffecom_multi_fields_[bt][kt]));
+ expand_expr_stmt (result);
+ expand_null_return ();
+ }
+ else if (multi)
+ {
+ expand_expr_stmt (call);
+ result
+ = ffecom_modify (NULL_TREE, result,
+ convert (TREE_TYPE (result),
+ ffecom_2 (COMPONENT_REF,
+ ffecom_tree_type[bt][kt],
+ multi_retval,
+ ffecom_multi_fields_[bt][kt])));
+ expand_return (result);
+ }
+ else if (cmplxfunc)
+ {
+ result
+ = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (result))),
+ result);
+ result = ffecom_modify (NULL_TREE, result, call);
+ expand_expr_stmt (result);
+ expand_null_return ();
+ }
+ else
+ {
+ result = ffecom_modify (NULL_TREE,
+ result,
+ convert (TREE_TYPE (result),
+ call));
+ expand_return (result);
+ }
+
+ clear_momentary ();
+ }
+
+ ffecom_end_compstmt_ ();
+
+ finish_function (0);
+
+ ffecom_doing_entry_ = FALSE;
+}
+
+#endif
+/* Transform expr into gcc tree with possible destination
+
+ Recursive descent on expr while making corresponding tree nodes and
+ attaching type info and such. If destination supplied and compatible
+ with temporary that would be made in certain cases, temporary isn't
+ made, destination used instead, and dest_used flag set TRUE. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_expr_ (ffebld expr, tree dest_tree,
+ ffebld dest, bool *dest_used,
+ bool assignp)
+{
+ tree item;
+ tree list;
+ tree args;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ tree t;
+ tree tree_type;
+ tree dt; /* decl_tree for an ffesymbol. */
+ ffesymbol s;
+ enum tree_code code;
+
+ assert (expr != NULL);
+
+ if (dest_used != NULL)
+ *dest_used = FALSE;
+
+ bt = ffeinfo_basictype (ffebld_info (expr));
+ kt = ffeinfo_kindtype (ffebld_info (expr));
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opACCTER:
+ tree_type = ffecom_tree_type[bt][kt];
+ {
+ ffebitCount i;
+ ffebit bits = ffebld_accter_bits (expr);
+ ffetargetOffset source_offset = 0;
+ size_t size;
+ tree purpose;
+
+ size = ffetype_size (ffeinfo_type (bt, kt));
+
+ list = item = NULL;
+ for (;;)
+ {
+ ffebldConstantUnion cu;
+ ffebitCount length;
+ bool value;
+ ffebldConstantArray ca = ffebld_accter (expr);
+
+ ffebit_test (bits, source_offset, &value, &length);
+ if (length == 0)
+ break;
+
+ if (value)
+ {
+ for (i = 0; i < length; ++i)
+ {
+ cu = ffebld_constantarray_get (ca, bt, kt,
+ source_offset + i);
+
+ t = ffecom_constantunion (&cu, bt, kt, tree_type);
+
+ if (i == 0)
+ purpose = build_int_2 (source_offset, 0);
+ else
+ purpose = NULL_TREE;
+
+ if (list == NULL_TREE)
+ list = item = build_tree_list (purpose, t);
+ else
+ {
+ TREE_CHAIN (item) = build_tree_list (purpose, t);
+ item = TREE_CHAIN (item);
+ }
+ }
+ }
+ source_offset += length;
+ }
+ }
+
+ item = build_int_2 (ffebld_accter_size (expr), 0);
+ ffebit_kill (ffebld_accter_bits (expr));
+ TREE_TYPE (item) = ffecom_integer_type_node;
+ item
+ = build_array_type
+ (tree_type,
+ build_range_type (ffecom_integer_type_node,
+ ffecom_integer_zero_node,
+ item));
+ list = build (CONSTRUCTOR, item, NULL_TREE, list);
+ TREE_CONSTANT (list) = 1;
+ TREE_STATIC (list) = 1;
+ return list;
+
+ case FFEBLD_opARRTER:
+ tree_type = ffecom_tree_type[bt][kt];
+ {
+ ffetargetOffset i;
+
+ list = item = NULL_TREE;
+ for (i = 0; i < ffebld_arrter_size (expr); ++i)
+ {
+ ffebldConstantUnion cu
+ = ffebld_constantarray_get (ffebld_arrter (expr), bt, kt, i);
+
+ t = ffecom_constantunion (&cu, bt, kt, tree_type);
+
+ if (list == NULL_TREE)
+ list = item = build_tree_list (NULL_TREE, t);
+ else
+ {
+ TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
+ item = TREE_CHAIN (item);
+ }
+ }
+ }
+
+ item = build_int_2 (ffebld_arrter_size (expr), 0);
+ TREE_TYPE (item) = ffecom_integer_type_node;
+ item
+ = build_array_type
+ (tree_type,
+ build_range_type (ffecom_integer_type_node,
+ ffecom_integer_one_node,
+ item));
+ list = build (CONSTRUCTOR, item, NULL_TREE, list);
+ TREE_CONSTANT (list) = 1;
+ TREE_STATIC (list) = 1;
+ return list;
+
+ case FFEBLD_opCONTER:
+ tree_type = ffecom_tree_type[bt][kt];
+ item
+ = ffecom_constantunion (&ffebld_constant_union (ffebld_conter (expr)),
+ bt, kt, tree_type);
+ return item;
+
+ case FFEBLD_opSYMTER:
+ if ((ffebld_symter_generic (expr) != FFEINTRIN_genNONE)
+ || (ffebld_symter_specific (expr) != FFEINTRIN_specNONE))
+ return ffecom_ptr_to_expr (expr); /* Same as %REF(intrinsic). */
+ s = ffebld_symter (expr);
+ t = ffesymbol_hook (s).decl_tree;
+
+ if (assignp)
+ { /* ASSIGN'ed-label expr. */
+ if (ffe_is_ugly_assign ())
+ {
+ /* User explicitly wants ASSIGN'ed variables to be at the same
+ memory address as the variables when used in non-ASSIGN
+ contexts. That can make old, arcane, non-standard code
+ work, but don't try to do it when a pointer wouldn't fit
+ in the normal variable (take other approach, and warn,
+ instead). */
+
+ if (t == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ t = ffesymbol_hook (s).decl_tree;
+ assert (t != NULL_TREE);
+ }
+
+ if (t == error_mark_node)
+ return t;
+
+ if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
+ >= GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+ {
+ if (ffesymbol_hook (s).addr)
+ t = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), t);
+ return t;
+ }
+
+ if (ffesymbol_hook (s).assign_tree == NULL_TREE)
+ {
+ ffebad_start_msg ("ASSIGN'ed label cannot fit into `%A' at %0 -- using wider sibling",
+ FFEBAD_severityWARNING);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_here (0, ffesymbol_where_line (s),
+ ffesymbol_where_column (s));
+ ffebad_finish ();
+ }
+ }
+
+ /* Don't use the normal variable's tree for ASSIGN, though mark
+ it as in the system header (housekeeping). Use an explicit,
+ specially created sibling that is known to be wide enough
+ to hold pointers to labels. */
+
+ if (t != NULL_TREE
+ && TREE_CODE (t) == VAR_DECL)
+ DECL_IN_SYSTEM_HEADER (t) = 1; /* Don't let -Wunused complain. */
+
+ t = ffesymbol_hook (s).assign_tree;
+ if (t == NULL_TREE)
+ {
+ s = ffecom_sym_transform_assign_ (s);
+ t = ffesymbol_hook (s).assign_tree;
+ assert (t != NULL_TREE);
+ }
+ }
+ else
+ {
+ if (t == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ t = ffesymbol_hook (s).decl_tree;
+ assert (t != NULL_TREE);
+ }
+ if (ffesymbol_hook (s).addr)
+ t = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), t);
+ }
+ return t;
+
+ case FFEBLD_opARRAYREF:
+ {
+ ffebld dims[FFECOM_dimensionsMAX];
+#if FFECOM_FASTER_ARRAY_REFS
+ tree array;
+#endif
+ int i;
+
+#if FFECOM_FASTER_ARRAY_REFS
+ t = ffecom_ptr_to_expr (ffebld_left (expr));
+#else
+ t = ffecom_expr (ffebld_left (expr));
+#endif
+ if (t == error_mark_node)
+ return t;
+
+ if ((ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING)
+ && !mark_addressable (t))
+ return error_mark_node; /* Make sure non-const ref is to
+ non-reg. */
+
+ /* Build up ARRAY_REFs in reverse order (since we're column major
+ here in Fortran land). */
+
+ for (i = 0, expr = ffebld_right (expr);
+ expr != NULL;
+ expr = ffebld_trail (expr))
+ dims[i++] = ffebld_head (expr);
+
+#if FFECOM_FASTER_ARRAY_REFS
+ for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t)));
+ i >= 0;
+ --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
+ t = ffecom_2 (PLUS_EXPR,
+ build_pointer_type (TREE_TYPE (array)),
+ t,
+ size_binop (MULT_EXPR,
+ size_in_bytes (TREE_TYPE (array)),
+ size_binop (MINUS_EXPR,
+ ffecom_expr (dims[i]),
+ TYPE_MIN_VALUE (TYPE_DOMAIN (array)))));
+ t = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))),
+ t);
+#else
+ while (i > 0)
+ t = ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))),
+ t,
+ ffecom_expr (dims[--i]));
+#endif
+
+ return t;
+ }
+
+ case FFEBLD_opUPLUS:
+ tree_type = ffecom_tree_type[bt][kt];
+ return ffecom_1 (NOP_EXPR, tree_type, ffecom_expr (ffebld_left (expr)));
+
+ case FFEBLD_opPAREN: /* ~~~Make sure Fortran rules respected here */
+ tree_type = ffecom_tree_type[bt][kt];
+ return ffecom_1 (NOP_EXPR, tree_type, ffecom_expr (ffebld_left (expr)));
+
+ case FFEBLD_opUMINUS:
+ tree_type = ffecom_tree_type[bt][kt];
+ return ffecom_1 (NEGATE_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)));
+
+ case FFEBLD_opADD:
+ tree_type = ffecom_tree_type[bt][kt];
+ return ffecom_2 (PLUS_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opSUBTRACT:
+ tree_type = ffecom_tree_type[bt][kt];
+ return ffecom_2 (MINUS_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+
+ case FFEBLD_opMULTIPLY:
+ tree_type = ffecom_tree_type[bt][kt];
+ return ffecom_2 (MULT_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+
+ case FFEBLD_opDIVIDE:
+ tree_type = ffecom_tree_type[bt][kt];
+ return
+ ffecom_tree_divide_ (tree_type,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)),
+ dest_tree, dest, dest_used);
+
+ case FFEBLD_opPOWER:
+ tree_type = ffecom_tree_type[bt][kt];
+ {
+ ffebld left = ffebld_left (expr);
+ ffebld right = ffebld_right (expr);
+ ffecomGfrt code;
+ ffeinfoKindtype rtkt;
+
+ switch (ffeinfo_basictype (ffebld_info (right)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ if (1 || optimize)
+ {
+ item = ffecom_expr_power_integer_ (left, right);
+ if (item != NULL_TREE)
+ return item;
+ }
+
+ rtkt = FFEINFO_kindtypeINTEGER1;
+ switch (ffeinfo_basictype (ffebld_info (left)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ if ((ffeinfo_kindtype (ffebld_info (left))
+ == FFEINFO_kindtypeINTEGER4)
+ || (ffeinfo_kindtype (ffebld_info (right))
+ == FFEINFO_kindtypeINTEGER4))
+ {
+ code = FFECOM_gfrtPOW_QQ;
+ rtkt = FFEINFO_kindtypeINTEGER4;
+ }
+ else
+ code = FFECOM_gfrtPOW_II;
+ break;
+
+ case FFEINFO_basictypeREAL:
+ if (ffeinfo_kindtype (ffebld_info (left))
+ == FFEINFO_kindtypeREAL1)
+ code = FFECOM_gfrtPOW_RI;
+ else
+ code = FFECOM_gfrtPOW_DI;
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffeinfo_kindtype (ffebld_info (left))
+ == FFEINFO_kindtypeREAL1)
+ code = FFECOM_gfrtPOW_CI; /* Overlapping result okay. */
+ else
+ code = FFECOM_gfrtPOW_ZI; /* Overlapping result okay. */
+ break;
+
+ default:
+ assert ("bad pow_*i" == NULL);
+ code = FFECOM_gfrtPOW_CI; /* Overlapping result okay. */
+ break;
+ }
+ if (ffeinfo_kindtype (ffebld_info (left)) != rtkt)
+ left = ffeexpr_convert (left, NULL, NULL,
+ FFEINFO_basictypeINTEGER,
+ rtkt, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ if (ffeinfo_kindtype (ffebld_info (right)) != rtkt)
+ right = ffeexpr_convert (right, NULL, NULL,
+ FFEINFO_basictypeINTEGER,
+ rtkt, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeREAL:
+ if (ffeinfo_kindtype (ffebld_info (left)) == FFEINFO_kindtypeREAL1)
+ left = ffeexpr_convert (left, NULL, NULL, FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREALDOUBLE, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ if (ffeinfo_kindtype (ffebld_info (right))
+ == FFEINFO_kindtypeREAL1)
+ right = ffeexpr_convert (right, NULL, NULL,
+ FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREALDOUBLE, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ code = FFECOM_gfrtPOW_DD;
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffeinfo_kindtype (ffebld_info (left)) == FFEINFO_kindtypeREAL1)
+ left = ffeexpr_convert (left, NULL, NULL,
+ FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREALDOUBLE, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ if (ffeinfo_kindtype (ffebld_info (right))
+ == FFEINFO_kindtypeREAL1)
+ right = ffeexpr_convert (right, NULL, NULL,
+ FFEINFO_basictypeCOMPLEX,
+ FFEINFO_kindtypeREALDOUBLE, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ code = FFECOM_gfrtPOW_ZZ; /* Overlapping result okay. */
+ break;
+
+ default:
+ assert ("bad pow_x*" == NULL);
+ code = FFECOM_gfrtPOW_II;
+ break;
+ }
+ return ffecom_call_binop_ (ffecom_gfrt_tree_ (code),
+ ffecom_gfrt_kindtype (code),
+ (ffe_is_f2c_library ()
+ && ffecom_gfrt_complex_[code]),
+ tree_type, left, right,
+ dest_tree, dest, dest_used,
+ NULL_TREE, FALSE);
+ }
+
+ case FFEBLD_opNOT:
+ tree_type = ffecom_tree_type[bt][kt];
+ switch (bt)
+ {
+ case FFEINFO_basictypeLOGICAL:
+ item
+ = ffecom_truth_value_invert (ffecom_expr (ffebld_left (expr)));
+ return convert (tree_type, item);
+
+ case FFEINFO_basictypeINTEGER:
+ return ffecom_1 (BIT_NOT_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)));
+
+ default:
+ assert ("NOT bad basictype" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+ break;
+
+ case FFEBLD_opFUNCREF:
+ assert (ffeinfo_basictype (ffebld_info (expr))
+ != FFEINFO_basictypeCHARACTER);
+ /* Fall through. */
+ case FFEBLD_opSUBRREF:
+ tree_type = ffecom_tree_type[bt][kt];
+ if (ffeinfo_where (ffebld_info (ffebld_left (expr)))
+ == FFEINFO_whereINTRINSIC)
+ { /* Invocation of an intrinsic. */
+ item = ffecom_expr_intrinsic_ (expr, dest_tree, dest,
+ dest_used);
+ return item;
+ }
+ s = ffebld_symter (ffebld_left (expr));
+ dt = ffesymbol_hook (s).decl_tree;
+ if (dt == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ dt = ffesymbol_hook (s).decl_tree;
+ }
+ if (dt == error_mark_node)
+ return dt;
+
+ if (ffesymbol_hook (s).addr)
+ item = dt;
+ else
+ item = ffecom_1_fn (dt);
+
+ ffecom_push_calltemps ();
+ if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+ args = ffecom_list_expr (ffebld_right (expr));
+ else
+ args = ffecom_list_ptr_to_expr (ffebld_right (expr));
+ ffecom_pop_calltemps ();
+
+ item = ffecom_call_ (item, kt,
+ ffesymbol_is_f2c (s)
+ && (bt == FFEINFO_basictypeCOMPLEX)
+ && (ffesymbol_where (s)
+ != FFEINFO_whereCONSTANT),
+ tree_type,
+ args,
+ dest_tree, dest, dest_used,
+ error_mark_node, FALSE);
+ TREE_SIDE_EFFECTS (item) = 1;
+ return item;
+
+ case FFEBLD_opAND:
+ tree_type = ffecom_tree_type[bt][kt];
+ switch (bt)
+ {
+ case FFEINFO_basictypeLOGICAL:
+ item
+ = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+ ffecom_truth_value (ffecom_expr (ffebld_left (expr))),
+ ffecom_truth_value (ffecom_expr (ffebld_right (expr))));
+ return convert (tree_type, item);
+
+ case FFEINFO_basictypeINTEGER:
+ return ffecom_2 (BIT_AND_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+
+ default:
+ assert ("AND bad basictype" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+ break;
+
+ case FFEBLD_opOR:
+ tree_type = ffecom_tree_type[bt][kt];
+ switch (bt)
+ {
+ case FFEINFO_basictypeLOGICAL:
+ item
+ = ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
+ ffecom_truth_value (ffecom_expr (ffebld_left (expr))),
+ ffecom_truth_value (ffecom_expr (ffebld_right (expr))));
+ return convert (tree_type, item);
+
+ case FFEINFO_basictypeINTEGER:
+ return ffecom_2 (BIT_IOR_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+
+ default:
+ assert ("OR bad basictype" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+ break;
+
+ case FFEBLD_opXOR:
+ case FFEBLD_opNEQV:
+ tree_type = ffecom_tree_type[bt][kt];
+ switch (bt)
+ {
+ case FFEINFO_basictypeLOGICAL:
+ item
+ = ffecom_2 (NE_EXPR, integer_type_node,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+ return convert (tree_type, ffecom_truth_value (item));
+
+ case FFEINFO_basictypeINTEGER:
+ return ffecom_2 (BIT_XOR_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+
+ default:
+ assert ("XOR/NEQV bad basictype" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+ break;
+
+ case FFEBLD_opEQV:
+ tree_type = ffecom_tree_type[bt][kt];
+ switch (bt)
+ {
+ case FFEINFO_basictypeLOGICAL:
+ item
+ = ffecom_2 (EQ_EXPR, integer_type_node,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+ return convert (tree_type, ffecom_truth_value (item));
+
+ case FFEINFO_basictypeINTEGER:
+ return
+ ffecom_1 (BIT_NOT_EXPR, tree_type,
+ ffecom_2 (BIT_XOR_EXPR, tree_type,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr))));
+
+ default:
+ assert ("EQV bad basictype" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+ break;
+
+ case FFEBLD_opCONVERT:
+ if (ffebld_op (ffebld_left (expr)) == FFEBLD_opANY)
+ return error_mark_node;
+
+ tree_type = ffecom_tree_type[bt][kt];
+ switch (bt)
+ {
+ case FFEINFO_basictypeLOGICAL:
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeREAL:
+ return convert (tree_type, ffecom_expr (ffebld_left (expr)));
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeLOGICAL:
+ case FFEINFO_basictypeREAL:
+ item = ffecom_expr (ffebld_left (expr));
+ if (item == error_mark_node)
+ return error_mark_node;
+ /* convert() takes care of converting to the subtype first,
+ at least in gcc-2.7.2. */
+ item = convert (tree_type, item);
+ return item;
+
+ case FFEINFO_basictypeCOMPLEX:
+ return convert (tree_type, ffecom_expr (ffebld_left (expr)));
+
+ default:
+ assert ("CONVERT COMPLEX bad basictype" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+ break;
+
+ default:
+ assert ("CONVERT bad basictype" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+ break;
+
+ case FFEBLD_opLT:
+ code = LT_EXPR;
+ goto relational; /* :::::::::::::::::::: */
+
+ case FFEBLD_opLE:
+ code = LE_EXPR;
+ goto relational; /* :::::::::::::::::::: */
+
+ case FFEBLD_opEQ:
+ code = EQ_EXPR;
+ goto relational; /* :::::::::::::::::::: */
+
+ case FFEBLD_opNE:
+ code = NE_EXPR;
+ goto relational; /* :::::::::::::::::::: */
+
+ case FFEBLD_opGT:
+ code = GT_EXPR;
+ goto relational; /* :::::::::::::::::::: */
+
+ case FFEBLD_opGE:
+ code = GE_EXPR;
+
+ relational: /* :::::::::::::::::::: */
+
+ tree_type = ffecom_tree_type[bt][kt];
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeREAL:
+ item = ffecom_2 (code, integer_type_node,
+ ffecom_expr (ffebld_left (expr)),
+ ffecom_expr (ffebld_right (expr)));
+ return convert (tree_type, item);
+
+ case FFEINFO_basictypeCOMPLEX:
+ assert (code == EQ_EXPR || code == NE_EXPR);
+ {
+ tree real_type;
+ tree arg1 = ffecom_expr (ffebld_left (expr));
+ tree arg2 = ffecom_expr (ffebld_right (expr));
+
+ if (arg1 == error_mark_node || arg2 == error_mark_node)
+ return error_mark_node;
+
+ arg1 = ffecom_save_tree (arg1);
+ arg2 = ffecom_save_tree (arg2);
+
+ if (TREE_CODE (TREE_TYPE (arg1)) == COMPLEX_TYPE)
+ {
+ real_type = TREE_TYPE (TREE_TYPE (arg1));
+ assert (real_type == TREE_TYPE (TREE_TYPE (arg2)));
+ }
+ else
+ {
+ real_type = TREE_TYPE (TYPE_FIELDS (TREE_TYPE (arg1)));
+ assert (real_type == TREE_TYPE (TYPE_FIELDS (TREE_TYPE (arg2))));
+ }
+
+ item
+ = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+ ffecom_2 (EQ_EXPR, integer_type_node,
+ ffecom_1 (REALPART_EXPR, real_type, arg1),
+ ffecom_1 (REALPART_EXPR, real_type, arg2)),
+ ffecom_2 (EQ_EXPR, integer_type_node,
+ ffecom_1 (IMAGPART_EXPR, real_type, arg1),
+ ffecom_1 (IMAGPART_EXPR, real_type,
+ arg2)));
+ if (code == EQ_EXPR)
+ item = ffecom_truth_value (item);
+ else
+ item = ffecom_truth_value_invert (item);
+ return convert (tree_type, item);
+ }
+
+ case FFEINFO_basictypeCHARACTER:
+ ffecom_push_calltemps (); /* Even though we might not call. */
+
+ {
+ ffebld left = ffebld_left (expr);
+ ffebld right = ffebld_right (expr);
+ tree left_tree;
+ tree right_tree;
+ tree left_length;
+ tree right_length;
+
+ /* f2c run-time functions do the implicit blank-padding for us,
+ so we don't usually have to implement blank-padding ourselves.
+ (The exception is when we pass an argument to a separately
+ compiled statement function -- if we know the arg is not the
+ same length as the dummy, we must truncate or extend it. If
+ we "inline" statement functions, that necessity goes away as
+ well.)
+
+ Strip off the CONVERT operators that blank-pad. (Truncation by
+ CONVERT shouldn't happen here, but it can happen in
+ assignments.) */
+
+ while (ffebld_op (left) == FFEBLD_opCONVERT)
+ left = ffebld_left (left);
+ while (ffebld_op (right) == FFEBLD_opCONVERT)
+ right = ffebld_left (right);
+
+ left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
+ right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
+
+ if (left_tree == error_mark_node || left_length == error_mark_node
+ || right_tree == error_mark_node
+ || right_length == error_mark_node)
+ {
+ ffecom_pop_calltemps ();
+ return error_mark_node;
+ }
+
+ if ((ffebld_size_known (left) == 1)
+ && (ffebld_size_known (right) == 1))
+ {
+ left_tree
+ = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (left_tree))),
+ left_tree);
+ right_tree
+ = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (right_tree))),
+ right_tree);
+
+ item
+ = ffecom_2 (code, integer_type_node,
+ ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (left_tree))),
+ left_tree,
+ integer_one_node),
+ ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (right_tree))),
+ right_tree,
+ integer_one_node));
+ }
+ else
+ {
+ item = build_tree_list (NULL_TREE, left_tree);
+ TREE_CHAIN (item) = build_tree_list (NULL_TREE, right_tree);
+ TREE_CHAIN (TREE_CHAIN (item)) = build_tree_list (NULL_TREE,
+ left_length);
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item)))
+ = build_tree_list (NULL_TREE, right_length);
+ item = ffecom_call_gfrt (FFECOM_gfrtCMP, item);
+ item = ffecom_2 (code, integer_type_node,
+ item,
+ convert (TREE_TYPE (item),
+ integer_zero_node));
+ }
+ item = convert (tree_type, item);
+ }
+
+ ffecom_pop_calltemps ();
+ return item;
+
+ default:
+ assert ("relational bad basictype" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+ break;
+
+ case FFEBLD_opPERCENT_LOC:
+ tree_type = ffecom_tree_type[bt][kt];
+ item = ffecom_arg_ptr_to_expr (ffebld_left (expr), &list);
+ return convert (tree_type, item);
+
+ case FFEBLD_opITEM:
+ case FFEBLD_opSTAR:
+ case FFEBLD_opBOUNDS:
+ case FFEBLD_opREPEAT:
+ case FFEBLD_opLABTER:
+ case FFEBLD_opLABTOK:
+ case FFEBLD_opIMPDO:
+ case FFEBLD_opCONCATENATE:
+ case FFEBLD_opSUBSTR:
+ default:
+ assert ("bad op" == NULL);
+ /* Fall through. */
+ case FFEBLD_opANY:
+ return error_mark_node;
+ }
+
+#if 1
+ assert ("didn't think anything got here anymore!!" == NULL);
+#else
+ switch (ffebld_arity (expr))
+ {
+ case 2:
+ TREE_OPERAND (item, 0) = ffecom_expr (ffebld_left (expr));
+ TREE_OPERAND (item, 1) = ffecom_expr (ffebld_right (expr));
+ if (TREE_OPERAND (item, 0) == error_mark_node
+ || TREE_OPERAND (item, 1) == error_mark_node)
+ return error_mark_node;
+ break;
+
+ case 1:
+ TREE_OPERAND (item, 0) = ffecom_expr (ffebld_left (expr));
+ if (TREE_OPERAND (item, 0) == error_mark_node)
+ return error_mark_node;
+ break;
+
+ default:
+ break;
+ }
+
+ return fold (item);
+#endif
+}
+
+#endif
+/* Returns the tree that does the intrinsic invocation.
+
+ Note: this function applies only to intrinsics returning
+ CHARACTER*1 or non-CHARACTER results, and to intrinsic
+ subroutines. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
+ ffebld dest, bool *dest_used)
+{
+ tree expr_tree;
+ tree saved_expr1; /* For those who need it. */
+ tree saved_expr2; /* For those who need it. */
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ tree tree_type;
+ tree arg1_type;
+ tree real_type; /* REAL type corresponding to COMPLEX. */
+ tree tempvar;
+ ffebld list = ffebld_right (expr); /* List of (some) args. */
+ ffebld arg1; /* For handy reference. */
+ ffebld arg2;
+ ffebld arg3;
+ ffeintrinImp codegen_imp;
+ ffecomGfrt gfrt;
+
+ assert (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER);
+
+ if (dest_used != NULL)
+ *dest_used = FALSE;
+
+ bt = ffeinfo_basictype (ffebld_info (expr));
+ kt = ffeinfo_kindtype (ffebld_info (expr));
+ tree_type = ffecom_tree_type[bt][kt];
+
+ if (list != NULL)
+ {
+ arg1 = ffebld_head (list);
+ if (arg1 != NULL && ffebld_op (arg1) == FFEBLD_opANY)
+ return error_mark_node;
+ if ((list = ffebld_trail (list)) != NULL)
+ {
+ arg2 = ffebld_head (list);
+ if (arg2 != NULL && ffebld_op (arg2) == FFEBLD_opANY)
+ return error_mark_node;
+ if ((list = ffebld_trail (list)) != NULL)
+ {
+ arg3 = ffebld_head (list);
+ if (arg3 != NULL && ffebld_op (arg3) == FFEBLD_opANY)
+ return error_mark_node;
+ }
+ else
+ arg3 = NULL;
+ }
+ else
+ arg2 = arg3 = NULL;
+ }
+ else
+ arg1 = arg2 = arg3 = NULL;
+
+ /* <list> ends up at the opITEM of the 3rd arg, or NULL if there are < 3
+ args. This is used by the MAX/MIN expansions. */
+
+ if (arg1 != NULL)
+ arg1_type = ffecom_tree_type
+ [ffeinfo_basictype (ffebld_info (arg1))]
+ [ffeinfo_kindtype (ffebld_info (arg1))];
+ else
+ arg1_type = NULL_TREE; /* Really not needed, but might catch bugs
+ here. */
+
+ /* There are several ways for each of the cases in the following switch
+ statements to exit (from simplest to use to most complicated):
+
+ break; (when expr_tree == NULL)
+
+ A standard call is made to the specific intrinsic just as if it had been
+ passed in as a dummy procedure and called as any old procedure. This
+ method can produce slower code but in some cases it's the easiest way for
+ now. However, if a (presumably faster) direct call is available,
+ that is used, so this is the easiest way in many more cases now.
+
+ gfrt = FFECOM_gfrtWHATEVER;
+ break;
+
+ gfrt contains the gfrt index of a library function to call, passing the
+ argument(s) by value rather than by reference. Used when a more
+ careful choice of library function is needed than that provided
+ by the vanilla `break;'.
+
+ return expr_tree;
+
+ The expr_tree has been completely set up and is ready to be returned
+ as is. No further actions are taken. Use this when the tree is not
+ in the simple form for one of the arity_n labels. */
+
+ /* For info on how the switch statement cases were written, see the files
+ enclosed in comments below the switch statement. */
+
+ codegen_imp = ffebld_symter_implementation (ffebld_left (expr));
+ gfrt = ffeintrin_gfrt_direct (codegen_imp);
+ if (gfrt == FFECOM_gfrt)
+ gfrt = ffeintrin_gfrt_indirect (codegen_imp);
+
+ switch (codegen_imp)
+ {
+ case FFEINTRIN_impABS:
+ case FFEINTRIN_impCABS:
+ case FFEINTRIN_impCDABS:
+ case FFEINTRIN_impDABS:
+ case FFEINTRIN_impIABS:
+ if (ffeinfo_basictype (ffebld_info (arg1))
+ == FFEINFO_basictypeCOMPLEX)
+ {
+ if (kt == FFEINFO_kindtypeREAL1)
+ gfrt = FFECOM_gfrtCABS;
+ else if (kt == FFEINFO_kindtypeREAL2)
+ gfrt = FFECOM_gfrtCDABS;
+ break;
+ }
+ return ffecom_1 (ABS_EXPR, tree_type,
+ convert (tree_type, ffecom_expr (arg1)));
+
+ case FFEINTRIN_impACOS:
+ case FFEINTRIN_impDACOS:
+ break;
+
+ case FFEINTRIN_impAIMAG:
+ case FFEINTRIN_impDIMAG:
+ case FFEINTRIN_impIMAGPART:
+ if (TREE_CODE (arg1_type) == COMPLEX_TYPE)
+ arg1_type = TREE_TYPE (arg1_type);
+ else
+ arg1_type = TREE_TYPE (TYPE_FIELDS (arg1_type));
+
+ return
+ convert (tree_type,
+ ffecom_1 (IMAGPART_EXPR, arg1_type,
+ ffecom_expr (arg1)));
+
+ case FFEINTRIN_impAINT:
+ case FFEINTRIN_impDINT:
+#if 0 /* ~~ someday implement FIX_TRUNC_EXPR
+ yielding same type as arg */
+ return ffecom_1 (FIX_TRUNC_EXPR, tree_type, ffecom_expr (arg1));
+#else /* in the meantime, must use floor to avoid range problems with ints */
+ /* r__1 = r1 >= 0 ? floor(r1) : -floor(-r1); */
+ saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
+ return
+ convert (tree_type,
+ ffecom_3 (COND_EXPR, double_type_node,
+ ffecom_truth_value
+ (ffecom_2 (GE_EXPR, integer_type_node,
+ saved_expr1,
+ convert (arg1_type,
+ ffecom_float_zero_))),
+ ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
+ build_tree_list (NULL_TREE,
+ convert (double_type_node,
+ saved_expr1))),
+ ffecom_1 (NEGATE_EXPR, double_type_node,
+ ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
+ build_tree_list (NULL_TREE,
+ convert (double_type_node,
+ ffecom_1 (NEGATE_EXPR,
+ arg1_type,
+ saved_expr1))))
+ ))
+ );
+#endif
+
+ case FFEINTRIN_impANINT:
+ case FFEINTRIN_impDNINT:
+#if 0 /* This way of doing it won't handle real
+ numbers of large magnitudes. */
+ saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
+ expr_tree = convert (tree_type,
+ convert (integer_type_node,
+ ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (GE_EXPR,
+ integer_type_node,
+ saved_expr1,
+ ffecom_float_zero_)),
+ ffecom_2 (PLUS_EXPR,
+ tree_type,
+ saved_expr1,
+ ffecom_float_half_),
+ ffecom_2 (MINUS_EXPR,
+ tree_type,
+ saved_expr1,
+ ffecom_float_half_))));
+ return expr_tree;
+#else /* So we instead call floor. */
+ /* r__1 = r1 >= 0 ? floor(r1 + .5) : -floor(.5 - r1) */
+ saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
+ return
+ convert (tree_type,
+ ffecom_3 (COND_EXPR, double_type_node,
+ ffecom_truth_value
+ (ffecom_2 (GE_EXPR, integer_type_node,
+ saved_expr1,
+ convert (arg1_type,
+ ffecom_float_zero_))),
+ ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
+ build_tree_list (NULL_TREE,
+ convert (double_type_node,
+ ffecom_2 (PLUS_EXPR,
+ arg1_type,
+ saved_expr1,
+ convert (arg1_type,
+ ffecom_float_half_))))),
+ ffecom_1 (NEGATE_EXPR, double_type_node,
+ ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
+ build_tree_list (NULL_TREE,
+ convert (double_type_node,
+ ffecom_2 (MINUS_EXPR,
+ arg1_type,
+ convert (arg1_type,
+ ffecom_float_half_),
+ saved_expr1)))))
+ )
+ );
+#endif
+
+ case FFEINTRIN_impASIN:
+ case FFEINTRIN_impDASIN:
+ case FFEINTRIN_impATAN:
+ case FFEINTRIN_impDATAN:
+ case FFEINTRIN_impATAN2:
+ case FFEINTRIN_impDATAN2:
+ break;
+
+ case FFEINTRIN_impCHAR:
+ case FFEINTRIN_impACHAR:
+ assert (ffecom_pending_calls_ != 0);
+ tempvar = ffecom_push_tempvar (char_type_node,
+ 1, -1, TRUE);
+ {
+ tree tmv = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (tempvar)));
+
+ expr_tree = ffecom_modify (tmv,
+ ffecom_2 (ARRAY_REF, tmv, tempvar,
+ integer_one_node),
+ convert (tmv, ffecom_expr (arg1)));
+ }
+ expr_tree = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar),
+ expr_tree,
+ tempvar);
+ expr_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (expr_tree)),
+ expr_tree);
+ return expr_tree;
+
+ case FFEINTRIN_impCMPLX:
+ case FFEINTRIN_impDCMPLX:
+ if (arg2 == NULL)
+ return
+ convert (tree_type, ffecom_expr (arg1));
+
+ real_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
+ return
+ ffecom_2 (COMPLEX_EXPR, tree_type,
+ convert (real_type, ffecom_expr (arg1)),
+ convert (real_type,
+ ffecom_expr (arg2)));
+
+ case FFEINTRIN_impCOMPLEX:
+ return
+ ffecom_2 (COMPLEX_EXPR, tree_type,
+ ffecom_expr (arg1),
+ ffecom_expr (arg2));
+
+ case FFEINTRIN_impCONJG:
+ case FFEINTRIN_impDCONJG:
+ {
+ tree arg1_tree;
+
+ real_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
+ arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
+ return
+ ffecom_2 (COMPLEX_EXPR, tree_type,
+ ffecom_1 (REALPART_EXPR, real_type, arg1_tree),
+ ffecom_1 (NEGATE_EXPR, real_type,
+ ffecom_1 (IMAGPART_EXPR, real_type, arg1_tree)));
+ }
+
+ case FFEINTRIN_impCOS:
+ case FFEINTRIN_impCCOS:
+ case FFEINTRIN_impCDCOS:
+ case FFEINTRIN_impDCOS:
+ if (bt == FFEINFO_basictypeCOMPLEX)
+ {
+ if (kt == FFEINFO_kindtypeREAL1)
+ gfrt = FFECOM_gfrtCCOS; /* Overlapping result okay. */
+ else if (kt == FFEINFO_kindtypeREAL2)
+ gfrt = FFECOM_gfrtCDCOS; /* Overlapping result okay. */
+ }
+ break;
+
+ case FFEINTRIN_impCOSH:
+ case FFEINTRIN_impDCOSH:
+ break;
+
+ case FFEINTRIN_impDBLE:
+ case FFEINTRIN_impDFLOAT:
+ case FFEINTRIN_impDREAL:
+ case FFEINTRIN_impFLOAT:
+ case FFEINTRIN_impIDINT:
+ case FFEINTRIN_impIFIX:
+ case FFEINTRIN_impINT2:
+ case FFEINTRIN_impINT8:
+ case FFEINTRIN_impINT:
+ case FFEINTRIN_impLONG:
+ case FFEINTRIN_impREAL:
+ case FFEINTRIN_impSHORT:
+ case FFEINTRIN_impSNGL:
+ return convert (tree_type, ffecom_expr (arg1));
+
+ case FFEINTRIN_impDIM:
+ case FFEINTRIN_impDDIM:
+ case FFEINTRIN_impIDIM:
+ saved_expr1 = ffecom_save_tree (convert (tree_type,
+ ffecom_expr (arg1)));
+ saved_expr2 = ffecom_save_tree (convert (tree_type,
+ ffecom_expr (arg2)));
+ return
+ ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (GT_EXPR, integer_type_node,
+ saved_expr1,
+ saved_expr2)),
+ ffecom_2 (MINUS_EXPR, tree_type,
+ saved_expr1,
+ saved_expr2),
+ convert (tree_type, ffecom_float_zero_));
+
+ case FFEINTRIN_impDPROD:
+ return
+ ffecom_2 (MULT_EXPR, tree_type,
+ convert (tree_type, ffecom_expr (arg1)),
+ convert (tree_type, ffecom_expr (arg2)));
+
+ case FFEINTRIN_impEXP:
+ case FFEINTRIN_impCDEXP:
+ case FFEINTRIN_impCEXP:
+ case FFEINTRIN_impDEXP:
+ if (bt == FFEINFO_basictypeCOMPLEX)
+ {
+ if (kt == FFEINFO_kindtypeREAL1)
+ gfrt = FFECOM_gfrtCEXP; /* Overlapping result okay. */
+ else if (kt == FFEINFO_kindtypeREAL2)
+ gfrt = FFECOM_gfrtCDEXP; /* Overlapping result okay. */
+ }
+ break;
+
+ case FFEINTRIN_impICHAR:
+ case FFEINTRIN_impIACHAR:
+#if 0 /* The simple approach. */
+ ffecom_char_args_ (&expr_tree, &saved_expr1 /* Ignored */ , arg1);
+ expr_tree
+ = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
+ expr_tree);
+ expr_tree
+ = ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
+ expr_tree,
+ integer_one_node);
+ return convert (tree_type, expr_tree);
+#else /* The more interesting (and more optimal) approach. */
+ expr_tree = ffecom_intrinsic_ichar_ (tree_type, arg1, &saved_expr1);
+ expr_tree = ffecom_3 (COND_EXPR, tree_type,
+ saved_expr1,
+ expr_tree,
+ convert (tree_type, integer_zero_node));
+ return expr_tree;
+#endif
+
+ case FFEINTRIN_impINDEX:
+ break;
+
+ case FFEINTRIN_impLEN:
+#if 0
+ break; /* The simple approach. */
+#else
+ return ffecom_intrinsic_len_ (arg1); /* The more optimal approach. */
+#endif
+
+ case FFEINTRIN_impLGE:
+ case FFEINTRIN_impLGT:
+ case FFEINTRIN_impLLE:
+ case FFEINTRIN_impLLT:
+ break;
+
+ case FFEINTRIN_impLOG:
+ case FFEINTRIN_impALOG:
+ case FFEINTRIN_impCDLOG:
+ case FFEINTRIN_impCLOG:
+ case FFEINTRIN_impDLOG:
+ if (bt == FFEINFO_basictypeCOMPLEX)
+ {
+ if (kt == FFEINFO_kindtypeREAL1)
+ gfrt = FFECOM_gfrtCLOG; /* Overlapping result okay. */
+ else if (kt == FFEINFO_kindtypeREAL2)
+ gfrt = FFECOM_gfrtCDLOG; /* Overlapping result okay. */
+ }
+ break;
+
+ case FFEINTRIN_impLOG10:
+ case FFEINTRIN_impALOG10:
+ case FFEINTRIN_impDLOG10:
+ if (gfrt != FFECOM_gfrt)
+ break; /* Already picked one, stick with it. */
+
+ if (kt == FFEINFO_kindtypeREAL1)
+ gfrt = FFECOM_gfrtALOG10;
+ else if (kt == FFEINFO_kindtypeREAL2)
+ gfrt = FFECOM_gfrtDLOG10;
+ break;
+
+ case FFEINTRIN_impMAX:
+ case FFEINTRIN_impAMAX0:
+ case FFEINTRIN_impAMAX1:
+ case FFEINTRIN_impDMAX1:
+ case FFEINTRIN_impMAX0:
+ case FFEINTRIN_impMAX1:
+ if (bt != ffeinfo_basictype (ffebld_info (arg1)))
+ arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr));
+ else
+ arg1_type = tree_type;
+ expr_tree = ffecom_2 (MAX_EXPR, arg1_type,
+ convert (arg1_type, ffecom_expr (arg1)),
+ convert (arg1_type, ffecom_expr (arg2)));
+ for (; list != NULL; list = ffebld_trail (list))
+ {
+ if ((ffebld_head (list) == NULL)
+ || (ffebld_op (ffebld_head (list)) == FFEBLD_opANY))
+ continue;
+ expr_tree = ffecom_2 (MAX_EXPR, arg1_type,
+ expr_tree,
+ convert (arg1_type,
+ ffecom_expr (ffebld_head (list))));
+ }
+ return convert (tree_type, expr_tree);
+
+ case FFEINTRIN_impMIN:
+ case FFEINTRIN_impAMIN0:
+ case FFEINTRIN_impAMIN1:
+ case FFEINTRIN_impDMIN1:
+ case FFEINTRIN_impMIN0:
+ case FFEINTRIN_impMIN1:
+ if (bt != ffeinfo_basictype (ffebld_info (arg1)))
+ arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr));
+ else
+ arg1_type = tree_type;
+ expr_tree = ffecom_2 (MIN_EXPR, arg1_type,
+ convert (arg1_type, ffecom_expr (arg1)),
+ convert (arg1_type, ffecom_expr (arg2)));
+ for (; list != NULL; list = ffebld_trail (list))
+ {
+ if ((ffebld_head (list) == NULL)
+ || (ffebld_op (ffebld_head (list)) == FFEBLD_opANY))
+ continue;
+ expr_tree = ffecom_2 (MIN_EXPR, arg1_type,
+ expr_tree,
+ convert (arg1_type,
+ ffecom_expr (ffebld_head (list))));
+ }
+ return convert (tree_type, expr_tree);
+
+ case FFEINTRIN_impMOD:
+ case FFEINTRIN_impAMOD:
+ case FFEINTRIN_impDMOD:
+ if (bt != FFEINFO_basictypeREAL)
+ return ffecom_2 (TRUNC_MOD_EXPR, tree_type,
+ convert (tree_type, ffecom_expr (arg1)),
+ convert (tree_type, ffecom_expr (arg2)));
+
+ if (kt == FFEINFO_kindtypeREAL1)
+ gfrt = FFECOM_gfrtAMOD;
+ else if (kt == FFEINFO_kindtypeREAL2)
+ gfrt = FFECOM_gfrtDMOD;
+ break;
+
+ case FFEINTRIN_impNINT:
+ case FFEINTRIN_impIDNINT:
+#if 0 /* ~~ ideally FIX_ROUND_EXPR would be
+ implemented, but it ain't yet */
+ return ffecom_1 (FIX_ROUND_EXPR, tree_type, ffecom_expr (arg1));
+#else
+ /* i__1 = r1 >= 0 ? floor(r1 + .5) : -floor(.5 - r1); */
+ saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
+ return
+ convert (ffecom_integer_type_node,
+ ffecom_3 (COND_EXPR, arg1_type,
+ ffecom_truth_value
+ (ffecom_2 (GE_EXPR, integer_type_node,
+ saved_expr1,
+ convert (arg1_type,
+ ffecom_float_zero_))),
+ ffecom_2 (PLUS_EXPR, arg1_type,
+ saved_expr1,
+ convert (arg1_type,
+ ffecom_float_half_)),
+ ffecom_2 (MINUS_EXPR, arg1_type,
+ saved_expr1,
+ convert (arg1_type,
+ ffecom_float_half_))));
+#endif
+
+ case FFEINTRIN_impSIGN:
+ case FFEINTRIN_impDSIGN:
+ case FFEINTRIN_impISIGN:
+ {
+ tree arg2_tree = ffecom_expr (arg2);
+
+ saved_expr1
+ = ffecom_save_tree
+ (ffecom_1 (ABS_EXPR, tree_type,
+ convert (tree_type,
+ ffecom_expr (arg1))));
+ expr_tree
+ = ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (GE_EXPR, integer_type_node,
+ arg2_tree,
+ convert (TREE_TYPE (arg2_tree),
+ integer_zero_node))),
+ saved_expr1,
+ ffecom_1 (NEGATE_EXPR, tree_type, saved_expr1));
+ /* Make sure SAVE_EXPRs get referenced early enough. */
+ expr_tree
+ = ffecom_2 (COMPOUND_EXPR, tree_type,
+ convert (void_type_node, saved_expr1),
+ expr_tree);
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impSIN:
+ case FFEINTRIN_impCDSIN:
+ case FFEINTRIN_impCSIN:
+ case FFEINTRIN_impDSIN:
+ if (bt == FFEINFO_basictypeCOMPLEX)
+ {
+ if (kt == FFEINFO_kindtypeREAL1)
+ gfrt = FFECOM_gfrtCSIN; /* Overlapping result okay. */
+ else if (kt == FFEINFO_kindtypeREAL2)
+ gfrt = FFECOM_gfrtCDSIN; /* Overlapping result okay. */
+ }
+ break;
+
+ case FFEINTRIN_impSINH:
+ case FFEINTRIN_impDSINH:
+ break;
+
+ case FFEINTRIN_impSQRT:
+ case FFEINTRIN_impCDSQRT:
+ case FFEINTRIN_impCSQRT:
+ case FFEINTRIN_impDSQRT:
+ if (bt == FFEINFO_basictypeCOMPLEX)
+ {
+ if (kt == FFEINFO_kindtypeREAL1)
+ gfrt = FFECOM_gfrtCSQRT; /* Overlapping result okay. */
+ else if (kt == FFEINFO_kindtypeREAL2)
+ gfrt = FFECOM_gfrtCDSQRT; /* Overlapping result okay. */
+ }
+ break;
+
+ case FFEINTRIN_impTAN:
+ case FFEINTRIN_impDTAN:
+ case FFEINTRIN_impTANH:
+ case FFEINTRIN_impDTANH:
+ break;
+
+ case FFEINTRIN_impREALPART:
+ if (TREE_CODE (arg1_type) == COMPLEX_TYPE)
+ arg1_type = TREE_TYPE (arg1_type);
+ else
+ arg1_type = TREE_TYPE (TYPE_FIELDS (arg1_type));
+
+ return
+ convert (tree_type,
+ ffecom_1 (REALPART_EXPR, arg1_type,
+ ffecom_expr (arg1)));
+
+ case FFEINTRIN_impIAND:
+ case FFEINTRIN_impAND:
+ return ffecom_2 (BIT_AND_EXPR, tree_type,
+ convert (tree_type,
+ ffecom_expr (arg1)),
+ convert (tree_type,
+ ffecom_expr (arg2)));
+
+ case FFEINTRIN_impIOR:
+ case FFEINTRIN_impOR:
+ return ffecom_2 (BIT_IOR_EXPR, tree_type,
+ convert (tree_type,
+ ffecom_expr (arg1)),
+ convert (tree_type,
+ ffecom_expr (arg2)));
+
+ case FFEINTRIN_impIEOR:
+ case FFEINTRIN_impXOR:
+ return ffecom_2 (BIT_XOR_EXPR, tree_type,
+ convert (tree_type,
+ ffecom_expr (arg1)),
+ convert (tree_type,
+ ffecom_expr (arg2)));
+
+ case FFEINTRIN_impLSHIFT:
+ return ffecom_2 (LSHIFT_EXPR, tree_type,
+ ffecom_expr (arg1),
+ convert (integer_type_node,
+ ffecom_expr (arg2)));
+
+ case FFEINTRIN_impRSHIFT:
+ return ffecom_2 (RSHIFT_EXPR, tree_type,
+ ffecom_expr (arg1),
+ convert (integer_type_node,
+ ffecom_expr (arg2)));
+
+ case FFEINTRIN_impNOT:
+ return ffecom_1 (BIT_NOT_EXPR, tree_type, ffecom_expr (arg1));
+
+ case FFEINTRIN_impBIT_SIZE:
+ return convert (tree_type, TYPE_SIZE (arg1_type));
+
+ case FFEINTRIN_impBTEST:
+ {
+ ffetargetLogical1 true;
+ ffetargetLogical1 false;
+ tree true_tree;
+ tree false_tree;
+
+ ffetarget_logical1 (&true, TRUE);
+ ffetarget_logical1 (&false, FALSE);
+ if (true == 1)
+ true_tree = convert (tree_type, integer_one_node);
+ else
+ true_tree = convert (tree_type, build_int_2 (true, 0));
+ if (false == 0)
+ false_tree = convert (tree_type, integer_zero_node);
+ else
+ false_tree = convert (tree_type, build_int_2 (false, 0));
+
+ return
+ ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (EQ_EXPR, integer_type_node,
+ ffecom_2 (BIT_AND_EXPR, arg1_type,
+ ffecom_expr (arg1),
+ ffecom_2 (LSHIFT_EXPR, arg1_type,
+ convert (arg1_type,
+ integer_one_node),
+ convert (integer_type_node,
+ ffecom_expr (arg2)))),
+ convert (arg1_type,
+ integer_zero_node))),
+ false_tree,
+ true_tree);
+ }
+
+ case FFEINTRIN_impIBCLR:
+ return
+ ffecom_2 (BIT_AND_EXPR, tree_type,
+ ffecom_expr (arg1),
+ ffecom_1 (BIT_NOT_EXPR, tree_type,
+ ffecom_2 (LSHIFT_EXPR, tree_type,
+ convert (tree_type,
+ integer_one_node),
+ convert (integer_type_node,
+ ffecom_expr (arg2)))));
+
+ case FFEINTRIN_impIBITS:
+ {
+ tree arg3_tree = ffecom_save_tree (convert (integer_type_node,
+ ffecom_expr (arg3)));
+ tree uns_type
+ = ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+
+ expr_tree
+ = ffecom_2 (BIT_AND_EXPR, tree_type,
+ ffecom_2 (RSHIFT_EXPR, tree_type,
+ ffecom_expr (arg1),
+ convert (integer_type_node,
+ ffecom_expr (arg2))),
+ convert (tree_type,
+ ffecom_2 (RSHIFT_EXPR, uns_type,
+ ffecom_1 (BIT_NOT_EXPR,
+ uns_type,
+ convert (uns_type,
+ integer_zero_node)),
+ ffecom_2 (MINUS_EXPR,
+ integer_type_node,
+ TYPE_SIZE (uns_type),
+ arg3_tree))));
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+ expr_tree
+ = ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (NE_EXPR, integer_type_node,
+ arg3_tree,
+ integer_zero_node)),
+ expr_tree,
+ convert (tree_type, integer_zero_node));
+#endif
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impIBSET:
+ return
+ ffecom_2 (BIT_IOR_EXPR, tree_type,
+ ffecom_expr (arg1),
+ ffecom_2 (LSHIFT_EXPR, tree_type,
+ convert (tree_type, integer_one_node),
+ convert (integer_type_node,
+ ffecom_expr (arg2))));
+
+ case FFEINTRIN_impISHFT:
+ {
+ tree arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
+ tree arg2_tree = ffecom_save_tree (convert (integer_type_node,
+ ffecom_expr (arg2)));
+ tree uns_type
+ = ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+
+ expr_tree
+ = ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (GE_EXPR, integer_type_node,
+ arg2_tree,
+ integer_zero_node)),
+ ffecom_2 (LSHIFT_EXPR, tree_type,
+ arg1_tree,
+ arg2_tree),
+ convert (tree_type,
+ ffecom_2 (RSHIFT_EXPR, uns_type,
+ convert (uns_type, arg1_tree),
+ ffecom_1 (NEGATE_EXPR,
+ integer_type_node,
+ arg2_tree))));
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+ expr_tree
+ = ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (NE_EXPR, integer_type_node,
+ arg2_tree,
+ TYPE_SIZE (uns_type))),
+ expr_tree,
+ convert (tree_type, integer_zero_node));
+#endif
+ /* Make sure SAVE_EXPRs get referenced early enough. */
+ expr_tree
+ = ffecom_2 (COMPOUND_EXPR, tree_type,
+ convert (void_type_node, arg1_tree),
+ ffecom_2 (COMPOUND_EXPR, tree_type,
+ convert (void_type_node, arg2_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impISHFTC:
+ {
+ tree arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
+ tree arg2_tree = ffecom_save_tree (convert (integer_type_node,
+ ffecom_expr (arg2)));
+ tree arg3_tree = (arg3 == NULL) ? TYPE_SIZE (tree_type)
+ : ffecom_save_tree (convert (integer_type_node, ffecom_expr (arg3)));
+ tree shift_neg;
+ tree shift_pos;
+ tree mask_arg1;
+ tree masked_arg1;
+ tree uns_type
+ = ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+
+ mask_arg1
+ = ffecom_2 (LSHIFT_EXPR, tree_type,
+ ffecom_1 (BIT_NOT_EXPR, tree_type,
+ convert (tree_type, integer_zero_node)),
+ arg3_tree);
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+ mask_arg1
+ = ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (NE_EXPR, integer_type_node,
+ arg3_tree,
+ TYPE_SIZE (uns_type))),
+ mask_arg1,
+ convert (tree_type, integer_zero_node));
+#endif
+ mask_arg1 = ffecom_save_tree (mask_arg1);
+ masked_arg1
+ = ffecom_2 (BIT_AND_EXPR, tree_type,
+ arg1_tree,
+ ffecom_1 (BIT_NOT_EXPR, tree_type,
+ mask_arg1));
+ masked_arg1 = ffecom_save_tree (masked_arg1);
+ shift_neg
+ = ffecom_2 (BIT_IOR_EXPR, tree_type,
+ convert (tree_type,
+ ffecom_2 (RSHIFT_EXPR, uns_type,
+ convert (uns_type, masked_arg1),
+ ffecom_1 (NEGATE_EXPR,
+ integer_type_node,
+ arg2_tree))),
+ ffecom_2 (LSHIFT_EXPR, tree_type,
+ arg1_tree,
+ ffecom_2 (PLUS_EXPR, integer_type_node,
+ arg2_tree,
+ arg3_tree)));
+ shift_pos
+ = ffecom_2 (BIT_IOR_EXPR, tree_type,
+ ffecom_2 (LSHIFT_EXPR, tree_type,
+ arg1_tree,
+ arg2_tree),
+ convert (tree_type,
+ ffecom_2 (RSHIFT_EXPR, uns_type,
+ convert (uns_type, masked_arg1),
+ ffecom_2 (MINUS_EXPR,
+ integer_type_node,
+ arg3_tree,
+ arg2_tree))));
+ expr_tree
+ = ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (LT_EXPR, integer_type_node,
+ arg2_tree,
+ integer_zero_node)),
+ shift_neg,
+ shift_pos);
+ expr_tree
+ = ffecom_2 (BIT_IOR_EXPR, tree_type,
+ ffecom_2 (BIT_AND_EXPR, tree_type,
+ mask_arg1,
+ arg1_tree),
+ ffecom_2 (BIT_AND_EXPR, tree_type,
+ ffecom_1 (BIT_NOT_EXPR, tree_type,
+ mask_arg1),
+ expr_tree));
+ expr_tree
+ = ffecom_3 (COND_EXPR, tree_type,
+ ffecom_truth_value
+ (ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
+ ffecom_2 (EQ_EXPR, integer_type_node,
+ ffecom_1 (ABS_EXPR,
+ integer_type_node,
+ arg2_tree),
+ arg3_tree),
+ ffecom_2 (EQ_EXPR, integer_type_node,
+ arg2_tree,
+ integer_zero_node))),
+ arg1_tree,
+ expr_tree);
+ /* Make sure SAVE_EXPRs get referenced early enough. */
+ expr_tree
+ = ffecom_2 (COMPOUND_EXPR, tree_type,
+ convert (void_type_node, arg1_tree),
+ ffecom_2 (COMPOUND_EXPR, tree_type,
+ convert (void_type_node, arg2_tree),
+ ffecom_2 (COMPOUND_EXPR, tree_type,
+ convert (void_type_node,
+ mask_arg1),
+ ffecom_2 (COMPOUND_EXPR, tree_type,
+ convert (void_type_node,
+ masked_arg1),
+ expr_tree))));
+ expr_tree
+ = ffecom_2 (COMPOUND_EXPR, tree_type,
+ convert (void_type_node,
+ arg3_tree),
+ expr_tree);
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impLOC:
+ {
+ tree arg1_tree = ffecom_expr (arg1);
+
+ expr_tree
+ = convert (tree_type,
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg1_tree)),
+ arg1_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impMVBITS:
+ {
+ tree arg1_tree;
+ tree arg2_tree;
+ tree arg3_tree;
+ ffebld arg4 = ffebld_head (ffebld_trail (list));
+ tree arg4_tree;
+ tree arg4_type;
+ ffebld arg5 = ffebld_head (ffebld_trail (ffebld_trail (list)));
+ tree arg5_tree;
+ tree prep_arg1;
+ tree prep_arg4;
+ tree arg5_plus_arg3;
+
+ ffecom_push_calltemps ();
+
+ arg2_tree = convert (integer_type_node,
+ ffecom_expr (arg2));
+ arg3_tree = ffecom_save_tree (convert (integer_type_node,
+ ffecom_expr (arg3)));
+ arg4_tree = ffecom_expr_rw (arg4);
+ arg4_type = TREE_TYPE (arg4_tree);
+
+ arg1_tree = ffecom_save_tree (convert (arg4_type,
+ ffecom_expr (arg1)));
+
+ arg5_tree = ffecom_save_tree (convert (integer_type_node,
+ ffecom_expr (arg5)));
+
+ ffecom_pop_calltemps ();
+
+ prep_arg1
+ = ffecom_2 (LSHIFT_EXPR, arg4_type,
+ ffecom_2 (BIT_AND_EXPR, arg4_type,
+ ffecom_2 (RSHIFT_EXPR, arg4_type,
+ arg1_tree,
+ arg2_tree),
+ ffecom_1 (BIT_NOT_EXPR, arg4_type,
+ ffecom_2 (LSHIFT_EXPR, arg4_type,
+ ffecom_1 (BIT_NOT_EXPR,
+ arg4_type,
+ convert
+ (arg4_type,
+ integer_zero_node)),
+ arg3_tree))),
+ arg5_tree);
+ arg5_plus_arg3
+ = ffecom_save_tree (ffecom_2 (PLUS_EXPR, arg4_type,
+ arg5_tree,
+ arg3_tree));
+ prep_arg4
+ = ffecom_2 (LSHIFT_EXPR, arg4_type,
+ ffecom_1 (BIT_NOT_EXPR, arg4_type,
+ convert (arg4_type,
+ integer_zero_node)),
+ arg5_plus_arg3);
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+ prep_arg4
+ = ffecom_3 (COND_EXPR, arg4_type,
+ ffecom_truth_value
+ (ffecom_2 (NE_EXPR, integer_type_node,
+ arg5_plus_arg3,
+ convert (TREE_TYPE (arg5_plus_arg3),
+ TYPE_SIZE (arg4_type)))),
+ prep_arg4,
+ convert (arg4_type, integer_zero_node));
+#endif
+ prep_arg4
+ = ffecom_2 (BIT_AND_EXPR, arg4_type,
+ arg4_tree,
+ ffecom_2 (BIT_IOR_EXPR, arg4_type,
+ prep_arg4,
+ ffecom_1 (BIT_NOT_EXPR, arg4_type,
+ ffecom_2 (LSHIFT_EXPR, arg4_type,
+ ffecom_1 (BIT_NOT_EXPR,
+ arg4_type,
+ convert
+ (arg4_type,
+ integer_zero_node)),
+ arg5_tree))));
+ prep_arg1
+ = ffecom_2 (BIT_IOR_EXPR, arg4_type,
+ prep_arg1,
+ prep_arg4);
+#if !defined(TREE_SHIFT_FULLWIDTH) || !TREE_SHIFT_FULLWIDTH
+ prep_arg1
+ = ffecom_3 (COND_EXPR, arg4_type,
+ ffecom_truth_value
+ (ffecom_2 (NE_EXPR, integer_type_node,
+ arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ integer_zero_node))),
+ prep_arg1,
+ arg4_tree);
+ prep_arg1
+ = ffecom_3 (COND_EXPR, arg4_type,
+ ffecom_truth_value
+ (ffecom_2 (NE_EXPR, integer_type_node,
+ arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ TYPE_SIZE (arg4_type)))),
+ prep_arg1,
+ arg1_tree);
+#endif
+ expr_tree
+ = ffecom_2s (MODIFY_EXPR, void_type_node,
+ arg4_tree,
+ prep_arg1);
+ /* Make sure SAVE_EXPRs get referenced early enough. */
+ expr_tree
+ = ffecom_2 (COMPOUND_EXPR, void_type_node,
+ arg1_tree,
+ ffecom_2 (COMPOUND_EXPR, void_type_node,
+ arg3_tree,
+ ffecom_2 (COMPOUND_EXPR, void_type_node,
+ arg5_tree,
+ ffecom_2 (COMPOUND_EXPR, void_type_node,
+ arg5_plus_arg3,
+ expr_tree))));
+ expr_tree
+ = ffecom_2 (COMPOUND_EXPR, void_type_node,
+ arg4_tree,
+ expr_tree);
+
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impDERF:
+ case FFEINTRIN_impERF:
+ case FFEINTRIN_impDERFC:
+ case FFEINTRIN_impERFC:
+ break;
+
+ case FFEINTRIN_impIARGC:
+ /* extern int xargc; i__1 = xargc - 1; */
+ expr_tree = ffecom_2 (MINUS_EXPR, TREE_TYPE (ffecom_tree_xargc_),
+ ffecom_tree_xargc_,
+ convert (TREE_TYPE (ffecom_tree_xargc_),
+ integer_one_node));
+ return expr_tree;
+
+ case FFEINTRIN_impSIGNAL_func:
+ case FFEINTRIN_impSIGNAL_subr:
+ {
+ tree arg1_tree;
+ tree arg2_tree;
+ tree arg3_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = convert (ffecom_f2c_integer_type_node,
+ ffecom_expr (arg1));
+ arg1_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg1_tree)),
+ arg1_tree);
+
+ /* Pass procedure as a pointer to it, anything else by value. */
+ if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY)
+ arg2_tree = convert (integer_type_node, ffecom_expr (arg2));
+ else
+ arg2_tree = ffecom_ptr_to_expr (arg2);
+ arg2_tree = convert (TREE_TYPE (null_pointer_node),
+ arg2_tree);
+
+ if (arg3 != NULL)
+ arg3_tree = ffecom_expr_rw (arg3);
+ else
+ arg3_tree = NULL_TREE;
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+ TREE_CHAIN (arg1_tree) = arg2_tree;
+
+ expr_tree
+ = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ ((codegen_imp == FFEINTRIN_impSIGNAL_subr) ?
+ NULL_TREE :
+ tree_type),
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+
+ if (arg3_tree != NULL_TREE)
+ expr_tree
+ = ffecom_modify (NULL_TREE, arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impALARM:
+ {
+ tree arg1_tree;
+ tree arg2_tree;
+ tree arg3_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = convert (ffecom_f2c_integer_type_node,
+ ffecom_expr (arg1));
+ arg1_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg1_tree)),
+ arg1_tree);
+
+ /* Pass procedure as a pointer to it, anything else by value. */
+ if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY)
+ arg2_tree = convert (integer_type_node, ffecom_expr (arg2));
+ else
+ arg2_tree = ffecom_ptr_to_expr (arg2);
+ arg2_tree = convert (TREE_TYPE (null_pointer_node),
+ arg2_tree);
+
+ if (arg3 != NULL)
+ arg3_tree = ffecom_expr_rw (arg3);
+ else
+ arg3_tree = NULL_TREE;
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+ TREE_CHAIN (arg1_tree) = arg2_tree;
+
+ expr_tree
+ = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+
+ if (arg3_tree != NULL_TREE)
+ expr_tree
+ = ffecom_modify (NULL_TREE, arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impCHDIR_subr:
+ case FFEINTRIN_impFDATE_subr:
+ case FFEINTRIN_impFGET_subr:
+ case FFEINTRIN_impFPUT_subr:
+ case FFEINTRIN_impGETCWD_subr:
+ case FFEINTRIN_impHOSTNM_subr:
+ case FFEINTRIN_impSYSTEM_subr:
+ case FFEINTRIN_impUNLINK_subr:
+ {
+ tree arg1_len = integer_zero_node;
+ tree arg1_tree;
+ tree arg2_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+
+ if (arg2 != NULL)
+ arg2_tree = ffecom_expr_rw (arg2);
+ else
+ arg2_tree = NULL_TREE;
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg1_len = build_tree_list (NULL_TREE, arg1_len);
+ TREE_CHAIN (arg1_tree) = arg1_len;
+
+ expr_tree
+ = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+
+ if (arg2_tree != NULL_TREE)
+ expr_tree
+ = ffecom_modify (NULL_TREE, arg2_tree,
+ convert (TREE_TYPE (arg2_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impEXIT:
+ if (arg1 != NULL)
+ break;
+
+ expr_tree = build_tree_list (NULL_TREE,
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type
+ (ffecom_integer_type_node),
+ integer_zero_node));
+
+ return
+ ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ void_type_node,
+ expr_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+
+ case FFEINTRIN_impFLUSH:
+ if (arg1 == NULL)
+ gfrt = FFECOM_gfrtFLUSH;
+ else
+ gfrt = FFECOM_gfrtFLUSH1;
+ break;
+
+ case FFEINTRIN_impCHMOD_subr:
+ case FFEINTRIN_impLINK_subr:
+ case FFEINTRIN_impRENAME_subr:
+ case FFEINTRIN_impSYMLNK_subr:
+ {
+ tree arg1_len = integer_zero_node;
+ tree arg1_tree;
+ tree arg2_len = integer_zero_node;
+ tree arg2_tree;
+ tree arg3_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+ arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
+ if (arg3 != NULL)
+ arg3_tree = ffecom_expr_rw (arg3);
+ else
+ arg3_tree = NULL_TREE;
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg1_len = build_tree_list (NULL_TREE, arg1_len);
+ arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+ arg2_len = build_tree_list (NULL_TREE, arg2_len);
+ TREE_CHAIN (arg1_tree) = arg2_tree;
+ TREE_CHAIN (arg2_tree) = arg1_len;
+ TREE_CHAIN (arg1_len) = arg2_len;
+ expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+ if (arg3_tree != NULL_TREE)
+ expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impLSTAT_subr:
+ case FFEINTRIN_impSTAT_subr:
+ {
+ tree arg1_len = integer_zero_node;
+ tree arg1_tree;
+ tree arg2_tree;
+ tree arg3_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+
+ arg2_tree = ffecom_ptr_to_expr (arg2);
+
+ if (arg3 != NULL)
+ arg3_tree = ffecom_expr_rw (arg3);
+ else
+ arg3_tree = NULL_TREE;
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg1_len = build_tree_list (NULL_TREE, arg1_len);
+ arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+ TREE_CHAIN (arg1_tree) = arg2_tree;
+ TREE_CHAIN (arg2_tree) = arg1_len;
+ expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+ if (arg3_tree != NULL_TREE)
+ expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impFGETC_subr:
+ case FFEINTRIN_impFPUTC_subr:
+ {
+ tree arg1_tree;
+ tree arg2_tree;
+ tree arg2_len = integer_zero_node;
+ tree arg3_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = convert (ffecom_f2c_integer_type_node,
+ ffecom_expr (arg1));
+ arg1_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg1_tree)),
+ arg1_tree);
+
+ arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
+ arg3_tree = ffecom_expr_rw (arg3);
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+ arg2_len = build_tree_list (NULL_TREE, arg2_len);
+ TREE_CHAIN (arg1_tree) = arg2_tree;
+ TREE_CHAIN (arg2_tree) = arg2_len;
+
+ expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+ expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impFSTAT_subr:
+ {
+ tree arg1_tree;
+ tree arg2_tree;
+ tree arg3_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = convert (ffecom_f2c_integer_type_node,
+ ffecom_expr (arg1));
+ arg1_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg1_tree)),
+ arg1_tree);
+
+ arg2_tree = convert (ffecom_f2c_ptr_to_integer_type_node,
+ ffecom_ptr_to_expr (arg2));
+
+ if (arg3 == NULL)
+ arg3_tree = NULL_TREE;
+ else
+ arg3_tree = ffecom_expr_rw (arg3);
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+ TREE_CHAIN (arg1_tree) = arg2_tree;
+ expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+ if (arg3_tree != NULL_TREE) {
+ expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ expr_tree));
+ }
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impKILL_subr:
+ {
+ tree arg1_tree;
+ tree arg2_tree;
+ tree arg3_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = convert (ffecom_f2c_integer_type_node,
+ ffecom_expr (arg1));
+ arg1_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg1_tree)),
+ arg1_tree);
+
+ arg2_tree = convert (ffecom_f2c_integer_type_node,
+ ffecom_expr (arg2));
+ arg2_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg2_tree)),
+ arg2_tree);
+
+ if (arg3 == NULL)
+ arg3_tree = NULL_TREE;
+ else
+ arg3_tree = ffecom_expr_rw (arg3);
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+ TREE_CHAIN (arg1_tree) = arg2_tree;
+ expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+ if (arg3_tree != NULL_TREE) {
+ expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+ convert (TREE_TYPE (arg3_tree),
+ expr_tree));
+ }
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impCTIME_subr:
+ case FFEINTRIN_impTTYNAM_subr:
+ {
+ tree arg1_len = integer_zero_node;
+ tree arg1_tree;
+ tree arg2_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+
+ arg2_tree = convert (((gfrt == FFEINTRIN_impCTIME_subr) ?
+ ffecom_f2c_longint_type_node :
+ ffecom_f2c_integer_type_node),
+ ffecom_expr (arg2));
+ arg2_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg2_tree)),
+ arg2_tree);
+
+ ffecom_pop_calltemps ();
+
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+ arg1_len = build_tree_list (NULL_TREE, arg1_len);
+ arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+ TREE_CHAIN (arg1_len) = arg2_tree;
+ TREE_CHAIN (arg1_tree) = arg1_len;
+
+ expr_tree
+ = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ arg1_tree,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impIRAND:
+ case FFEINTRIN_impRAND:
+ /* Arg defaults to 0 (normal random case) */
+ {
+ tree arg1_tree;
+
+ if (arg1 == NULL)
+ arg1_tree = ffecom_integer_zero_node;
+ else
+ arg1_tree = ffecom_expr (arg1);
+ arg1_tree = convert (ffecom_f2c_integer_type_node,
+ arg1_tree);
+ arg1_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg1_tree)),
+ arg1_tree);
+ arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+
+ expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ ((codegen_imp == FFEINTRIN_impIRAND) ?
+ ffecom_f2c_integer_type_node :
+ ffecom_f2c_doublereal_type_node),
+ arg1_tree,
+ dest_tree, dest, dest_used,
+ NULL_TREE, TRUE);
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impFTELL_subr:
+ case FFEINTRIN_impUMASK_subr:
+ {
+ tree arg1_tree;
+ tree arg2_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = convert (ffecom_f2c_integer_type_node,
+ ffecom_expr (arg1));
+ arg1_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (arg1_tree)),
+ arg1_tree);
+
+ if (arg2 == NULL)
+ arg2_tree = NULL_TREE;
+ else
+ arg2_tree = ffecom_expr_rw (arg2);
+
+ ffecom_pop_calltemps ();
+
+ expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ build_tree_list (NULL_TREE, arg1_tree),
+ NULL_TREE, NULL, NULL, NULL_TREE,
+ TRUE);
+ if (arg2_tree != NULL_TREE) {
+ expr_tree = ffecom_modify (NULL_TREE, arg2_tree,
+ convert (TREE_TYPE (arg2_tree),
+ expr_tree));
+ }
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impCPU_TIME:
+ case FFEINTRIN_impSECOND_subr:
+ {
+ tree arg1_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = ffecom_expr_rw (arg1);
+
+ ffecom_pop_calltemps ();
+
+ expr_tree
+ = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ NULL_TREE,
+ NULL_TREE, NULL, NULL, NULL_TREE, TRUE);
+
+ expr_tree
+ = ffecom_modify (NULL_TREE, arg1_tree,
+ convert (TREE_TYPE (arg1_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ case FFEINTRIN_impDTIME_subr:
+ case FFEINTRIN_impETIME_subr:
+ {
+ tree arg1_tree;
+ tree arg2_tree;
+
+ ffecom_push_calltemps ();
+
+ arg1_tree = ffecom_expr_rw (arg1);
+
+ arg2_tree = ffecom_ptr_to_expr (arg2);
+
+ ffecom_pop_calltemps ();
+
+ expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+ ffecom_gfrt_kindtype (gfrt),
+ FALSE,
+ NULL_TREE,
+ build_tree_list (NULL_TREE, arg2_tree),
+ NULL_TREE, NULL, NULL, NULL_TREE,
+ TRUE);
+ expr_tree = ffecom_modify (NULL_TREE, arg1_tree,
+ convert (TREE_TYPE (arg1_tree),
+ expr_tree));
+ }
+ return expr_tree;
+
+ /* Straightforward calls of libf2c routines: */
+ case FFEINTRIN_impABORT:
+ case FFEINTRIN_impACCESS:
+ case FFEINTRIN_impBESJ0:
+ case FFEINTRIN_impBESJ1:
+ case FFEINTRIN_impBESJN:
+ case FFEINTRIN_impBESY0:
+ case FFEINTRIN_impBESY1:
+ case FFEINTRIN_impBESYN:
+ case FFEINTRIN_impCHDIR_func:
+ case FFEINTRIN_impCHMOD_func:
+ case FFEINTRIN_impDATE:
+ case FFEINTRIN_impDBESJ0:
+ case FFEINTRIN_impDBESJ1:
+ case FFEINTRIN_impDBESJN:
+ case FFEINTRIN_impDBESY0:
+ case FFEINTRIN_impDBESY1:
+ case FFEINTRIN_impDBESYN:
+ case FFEINTRIN_impDTIME_func:
+ case FFEINTRIN_impETIME_func:
+ case FFEINTRIN_impFGETC_func:
+ case FFEINTRIN_impFGET_func:
+ case FFEINTRIN_impFNUM:
+ case FFEINTRIN_impFPUTC_func:
+ case FFEINTRIN_impFPUT_func:
+ case FFEINTRIN_impFSEEK:
+ case FFEINTRIN_impFSTAT_func:
+ case FFEINTRIN_impFTELL_func:
+ case FFEINTRIN_impGERROR:
+ case FFEINTRIN_impGETARG:
+ case FFEINTRIN_impGETCWD_func:
+ case FFEINTRIN_impGETENV:
+ case FFEINTRIN_impGETGID:
+ case FFEINTRIN_impGETLOG:
+ case FFEINTRIN_impGETPID:
+ case FFEINTRIN_impGETUID:
+ case FFEINTRIN_impGMTIME:
+ case FFEINTRIN_impHOSTNM_func:
+ case FFEINTRIN_impIDATE_unix:
+ case FFEINTRIN_impIDATE_vxt:
+ case FFEINTRIN_impIERRNO:
+ case FFEINTRIN_impISATTY:
+ case FFEINTRIN_impITIME:
+ case FFEINTRIN_impKILL_func:
+ case FFEINTRIN_impLINK_func:
+ case FFEINTRIN_impLNBLNK:
+ case FFEINTRIN_impLSTAT_func:
+ case FFEINTRIN_impLTIME:
+ case FFEINTRIN_impMCLOCK8:
+ case FFEINTRIN_impMCLOCK:
+ case FFEINTRIN_impPERROR:
+ case FFEINTRIN_impRENAME_func:
+ case FFEINTRIN_impSECNDS:
+ case FFEINTRIN_impSECOND_func:
+ case FFEINTRIN_impSLEEP:
+ case FFEINTRIN_impSRAND:
+ case FFEINTRIN_impSTAT_func:
+ case FFEINTRIN_impSYMLNK_func:
+ case FFEINTRIN_impSYSTEM_CLOCK:
+ case FFEINTRIN_impSYSTEM_func:
+ case FFEINTRIN_impTIME8:
+ case FFEINTRIN_impTIME_unix:
+ case FFEINTRIN_impTIME_vxt:
+ case FFEINTRIN_impUMASK_func:
+ case FFEINTRIN_impUNLINK_func:
+ break;
+
+ case FFEINTRIN_impCTIME_func: /* CHARACTER functions not handled here. */
+ case FFEINTRIN_impFDATE_func: /* CHARACTER functions not handled here. */
+ case FFEINTRIN_impTTYNAM_func: /* CHARACTER functions not handled here. */
+ case FFEINTRIN_impNONE:
+ case FFEINTRIN_imp: /* Hush up gcc warning. */
+ fprintf (stderr, "No %s implementation.\n",
+ ffeintrin_name_implementation (ffebld_symter_implementation (ffebld_left (expr))));
+ assert ("unimplemented intrinsic" == NULL);
+ return error_mark_node;
+ }
+
+ assert (gfrt != FFECOM_gfrt); /* Must have an implementation! */
+
+ ffecom_push_calltemps ();
+ expr_tree = ffecom_arglist_expr_ (ffecom_gfrt_args_ (gfrt),
+ ffebld_right (expr));
+ ffecom_pop_calltemps ();
+
+ return ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt),
+ (ffe_is_f2c_library () && ffecom_gfrt_complex_[gfrt]),
+ tree_type,
+ expr_tree, dest_tree, dest, dest_used,
+ NULL_TREE, TRUE);
+
+ /**INDENT* (Do not reformat this comment even with -fca option.)
+ Data-gathering files: Given the source file listed below, compiled with
+ f2c I obtained the output file listed after that, and from the output
+ file I derived the above code.
+
+-------- (begin input file to f2c)
+ implicit none
+ character*10 A1,A2
+ complex C1,C2
+ integer I1,I2
+ real R1,R2
+ double precision D1,D2
+C
+ call getem(A1,A2,C1,C2,I1,I2,R1,R2,D1,D2)
+c /
+ call fooI(I1/I2)
+ call fooR(R1/I1)
+ call fooD(D1/I1)
+ call fooC(C1/I1)
+ call fooR(R1/R2)
+ call fooD(R1/D1)
+ call fooD(D1/D2)
+ call fooD(D1/R1)
+ call fooC(C1/C2)
+ call fooC(C1/R1)
+ call fooZ(C1/D1)
+c **
+ call fooI(I1**I2)
+ call fooR(R1**I1)
+ call fooD(D1**I1)
+ call fooC(C1**I1)
+ call fooR(R1**R2)
+ call fooD(R1**D1)
+ call fooD(D1**D2)
+ call fooD(D1**R1)
+ call fooC(C1**C2)
+ call fooC(C1**R1)
+ call fooZ(C1**D1)
+c FFEINTRIN_impABS
+ call fooR(ABS(R1))
+c FFEINTRIN_impACOS
+ call fooR(ACOS(R1))
+c FFEINTRIN_impAIMAG
+ call fooR(AIMAG(C1))
+c FFEINTRIN_impAINT
+ call fooR(AINT(R1))
+c FFEINTRIN_impALOG
+ call fooR(ALOG(R1))
+c FFEINTRIN_impALOG10
+ call fooR(ALOG10(R1))
+c FFEINTRIN_impAMAX0
+ call fooR(AMAX0(I1,I2))
+c FFEINTRIN_impAMAX1
+ call fooR(AMAX1(R1,R2))
+c FFEINTRIN_impAMIN0
+ call fooR(AMIN0(I1,I2))
+c FFEINTRIN_impAMIN1
+ call fooR(AMIN1(R1,R2))
+c FFEINTRIN_impAMOD
+ call fooR(AMOD(R1,R2))
+c FFEINTRIN_impANINT
+ call fooR(ANINT(R1))
+c FFEINTRIN_impASIN
+ call fooR(ASIN(R1))
+c FFEINTRIN_impATAN
+ call fooR(ATAN(R1))
+c FFEINTRIN_impATAN2
+ call fooR(ATAN2(R1,R2))
+c FFEINTRIN_impCABS
+ call fooR(CABS(C1))
+c FFEINTRIN_impCCOS
+ call fooC(CCOS(C1))
+c FFEINTRIN_impCEXP
+ call fooC(CEXP(C1))
+c FFEINTRIN_impCHAR
+ call fooA(CHAR(I1))
+c FFEINTRIN_impCLOG
+ call fooC(CLOG(C1))
+c FFEINTRIN_impCONJG
+ call fooC(CONJG(C1))
+c FFEINTRIN_impCOS
+ call fooR(COS(R1))
+c FFEINTRIN_impCOSH
+ call fooR(COSH(R1))
+c FFEINTRIN_impCSIN
+ call fooC(CSIN(C1))
+c FFEINTRIN_impCSQRT
+ call fooC(CSQRT(C1))
+c FFEINTRIN_impDABS
+ call fooD(DABS(D1))
+c FFEINTRIN_impDACOS
+ call fooD(DACOS(D1))
+c FFEINTRIN_impDASIN
+ call fooD(DASIN(D1))
+c FFEINTRIN_impDATAN
+ call fooD(DATAN(D1))
+c FFEINTRIN_impDATAN2
+ call fooD(DATAN2(D1,D2))
+c FFEINTRIN_impDCOS
+ call fooD(DCOS(D1))
+c FFEINTRIN_impDCOSH
+ call fooD(DCOSH(D1))
+c FFEINTRIN_impDDIM
+ call fooD(DDIM(D1,D2))
+c FFEINTRIN_impDEXP
+ call fooD(DEXP(D1))
+c FFEINTRIN_impDIM
+ call fooR(DIM(R1,R2))
+c FFEINTRIN_impDINT
+ call fooD(DINT(D1))
+c FFEINTRIN_impDLOG
+ call fooD(DLOG(D1))
+c FFEINTRIN_impDLOG10
+ call fooD(DLOG10(D1))
+c FFEINTRIN_impDMAX1
+ call fooD(DMAX1(D1,D2))
+c FFEINTRIN_impDMIN1
+ call fooD(DMIN1(D1,D2))
+c FFEINTRIN_impDMOD
+ call fooD(DMOD(D1,D2))
+c FFEINTRIN_impDNINT
+ call fooD(DNINT(D1))
+c FFEINTRIN_impDPROD
+ call fooD(DPROD(R1,R2))
+c FFEINTRIN_impDSIGN
+ call fooD(DSIGN(D1,D2))
+c FFEINTRIN_impDSIN
+ call fooD(DSIN(D1))
+c FFEINTRIN_impDSINH
+ call fooD(DSINH(D1))
+c FFEINTRIN_impDSQRT
+ call fooD(DSQRT(D1))
+c FFEINTRIN_impDTAN
+ call fooD(DTAN(D1))
+c FFEINTRIN_impDTANH
+ call fooD(DTANH(D1))
+c FFEINTRIN_impEXP
+ call fooR(EXP(R1))
+c FFEINTRIN_impIABS
+ call fooI(IABS(I1))
+c FFEINTRIN_impICHAR
+ call fooI(ICHAR(A1))
+c FFEINTRIN_impIDIM
+ call fooI(IDIM(I1,I2))
+c FFEINTRIN_impIDNINT
+ call fooI(IDNINT(D1))
+c FFEINTRIN_impINDEX
+ call fooI(INDEX(A1,A2))
+c FFEINTRIN_impISIGN
+ call fooI(ISIGN(I1,I2))
+c FFEINTRIN_impLEN
+ call fooI(LEN(A1))
+c FFEINTRIN_impLGE
+ call fooL(LGE(A1,A2))
+c FFEINTRIN_impLGT
+ call fooL(LGT(A1,A2))
+c FFEINTRIN_impLLE
+ call fooL(LLE(A1,A2))
+c FFEINTRIN_impLLT
+ call fooL(LLT(A1,A2))
+c FFEINTRIN_impMAX0
+ call fooI(MAX0(I1,I2))
+c FFEINTRIN_impMAX1
+ call fooI(MAX1(R1,R2))
+c FFEINTRIN_impMIN0
+ call fooI(MIN0(I1,I2))
+c FFEINTRIN_impMIN1
+ call fooI(MIN1(R1,R2))
+c FFEINTRIN_impMOD
+ call fooI(MOD(I1,I2))
+c FFEINTRIN_impNINT
+ call fooI(NINT(R1))
+c FFEINTRIN_impSIGN
+ call fooR(SIGN(R1,R2))
+c FFEINTRIN_impSIN
+ call fooR(SIN(R1))
+c FFEINTRIN_impSINH
+ call fooR(SINH(R1))
+c FFEINTRIN_impSQRT
+ call fooR(SQRT(R1))
+c FFEINTRIN_impTAN
+ call fooR(TAN(R1))
+c FFEINTRIN_impTANH
+ call fooR(TANH(R1))
+c FFEINTRIN_imp_CMPLX_C
+ call fooC(cmplx(C1,C2))
+c FFEINTRIN_imp_CMPLX_D
+ call fooZ(cmplx(D1,D2))
+c FFEINTRIN_imp_CMPLX_I
+ call fooC(cmplx(I1,I2))
+c FFEINTRIN_imp_CMPLX_R
+ call fooC(cmplx(R1,R2))
+c FFEINTRIN_imp_DBLE_C
+ call fooD(dble(C1))
+c FFEINTRIN_imp_DBLE_D
+ call fooD(dble(D1))
+c FFEINTRIN_imp_DBLE_I
+ call fooD(dble(I1))
+c FFEINTRIN_imp_DBLE_R
+ call fooD(dble(R1))
+c FFEINTRIN_imp_INT_C
+ call fooI(int(C1))
+c FFEINTRIN_imp_INT_D
+ call fooI(int(D1))
+c FFEINTRIN_imp_INT_I
+ call fooI(int(I1))
+c FFEINTRIN_imp_INT_R
+ call fooI(int(R1))
+c FFEINTRIN_imp_REAL_C
+ call fooR(real(C1))
+c FFEINTRIN_imp_REAL_D
+ call fooR(real(D1))
+c FFEINTRIN_imp_REAL_I
+ call fooR(real(I1))
+c FFEINTRIN_imp_REAL_R
+ call fooR(real(R1))
+c
+c FFEINTRIN_imp_INT_D:
+c
+c FFEINTRIN_specIDINT
+ call fooI(IDINT(D1))
+c
+c FFEINTRIN_imp_INT_R:
+c
+c FFEINTRIN_specIFIX
+ call fooI(IFIX(R1))
+c FFEINTRIN_specINT
+ call fooI(INT(R1))
+c
+c FFEINTRIN_imp_REAL_D:
+c
+c FFEINTRIN_specSNGL
+ call fooR(SNGL(D1))
+c
+c FFEINTRIN_imp_REAL_I:
+c
+c FFEINTRIN_specFLOAT
+ call fooR(FLOAT(I1))
+c FFEINTRIN_specREAL
+ call fooR(REAL(I1))
+c
+ end
+-------- (end input file to f2c)
+
+-------- (begin output from providing above input file as input to:
+-------- `f2c | gcc -E -C - | sed -e "s:/[*]*://:g" -e "s:[*]*[/]://:g" \
+-------- -e "s:^#.*$::g"')
+
+// -- translated by f2c (version 19950223).
+ You must link the resulting object file with the libraries:
+ -lf2c -lm (in that order)
+//
+
+
+// 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) //
+
+
+
+
+// F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems //
+// we assume short, float are OK //
+typedef long int // long int // integer;
+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 long int // long int // logical;
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+// typedef long long longint; // // system-dependent //
+
+
+
+
+// Extern is for use with -E //
+
+
+
+
+// I/O stuff //
+
+
+
+
+
+
+
+
+typedef long int // int or long int // flag;
+typedef long int // int or long int // ftnlen;
+typedef long int // int or long int // ftnint;
+
+
+//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;
+
+
+
+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 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;
+
+
+
+
+
+
+
+
+// procedure parameter types for -A and -C++ //
+
+
+
+
+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)();
+
+// 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.: //
+
+
+// (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].) //
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+// Main program // MAIN__()
+{
+ // System generated locals //
+ integer i__1;
+ real r__1, r__2;
+ doublereal d__1, d__2;
+ complex q__1;
+ doublecomplex z__1, z__2, z__3;
+ logical L__1;
+ char ch__1[1];
+
+ // Builtin functions //
+ void c_div();
+ integer pow_ii();
+ double pow_ri(), pow_di();
+ void pow_ci();
+ double pow_dd();
+ void pow_zz();
+ double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(),
+ asin(), atan(), atan2(), c_abs();
+ void c_cos(), c_exp(), c_log(), r_cnjg();
+ double cos(), cosh();
+ void c_sin(), c_sqrt();
+ double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(),
+ d_sign(), sin(), sinh(), sqrt(), tan(), tanh();
+ integer i_dim(), i_dnnt(), i_indx(), i_sign(), i_len();
+ logical l_ge(), l_gt(), l_le(), l_lt();
+ integer i_nint();
+ double r_sign();
+
+ // Local variables //
+ extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(),
+ fool_(), fooz_(), getem_();
+ static char a1[10], a2[10];
+ static complex c1, c2;
+ static doublereal d1, d2;
+ static integer i1, i2;
+ static real r1, r2;
+
+
+ getem_(a1, a2, &c1, &c2, &i1, &i2, &r1, &r2, &d1, &d2, 10L, 10L);
+// / //
+ i__1 = i1 / i2;
+ fooi_(&i__1);
+ r__1 = r1 / i1;
+ foor_(&r__1);
+ d__1 = d1 / i1;
+ food_(&d__1);
+ d__1 = (doublereal) i1;
+ q__1.r = c1.r / d__1, q__1.i = c1.i / d__1;
+ fooc_(&q__1);
+ r__1 = r1 / r2;
+ foor_(&r__1);
+ d__1 = r1 / d1;
+ food_(&d__1);
+ d__1 = d1 / d2;
+ food_(&d__1);
+ d__1 = d1 / r1;
+ food_(&d__1);
+ c_div(&q__1, &c1, &c2);
+ fooc_(&q__1);
+ q__1.r = c1.r / r1, q__1.i = c1.i / r1;
+ fooc_(&q__1);
+ z__1.r = c1.r / d1, z__1.i = c1.i / d1;
+ fooz_(&z__1);
+// ** //
+ i__1 = pow_ii(&i1, &i2);
+ fooi_(&i__1);
+ r__1 = pow_ri(&r1, &i1);
+ foor_(&r__1);
+ d__1 = pow_di(&d1, &i1);
+ food_(&d__1);
+ pow_ci(&q__1, &c1, &i1);
+ fooc_(&q__1);
+ d__1 = (doublereal) r1;
+ d__2 = (doublereal) r2;
+ r__1 = pow_dd(&d__1, &d__2);
+ foor_(&r__1);
+ d__2 = (doublereal) r1;
+ d__1 = pow_dd(&d__2, &d1);
+ food_(&d__1);
+ d__1 = pow_dd(&d1, &d2);
+ food_(&d__1);
+ d__2 = (doublereal) r1;
+ d__1 = pow_dd(&d1, &d__2);
+ food_(&d__1);
+ z__2.r = c1.r, z__2.i = c1.i;
+ z__3.r = c2.r, z__3.i = c2.i;
+ pow_zz(&z__1, &z__2, &z__3);
+ q__1.r = z__1.r, q__1.i = z__1.i;
+ fooc_(&q__1);
+ z__2.r = c1.r, z__2.i = c1.i;
+ z__3.r = r1, z__3.i = 0.;
+ pow_zz(&z__1, &z__2, &z__3);
+ q__1.r = z__1.r, q__1.i = z__1.i;
+ fooc_(&q__1);
+ z__2.r = c1.r, z__2.i = c1.i;
+ z__3.r = d1, z__3.i = 0.;
+ pow_zz(&z__1, &z__2, &z__3);
+ fooz_(&z__1);
+// FFEINTRIN_impABS //
+ r__1 = (doublereal)(( r1 ) >= 0 ? ( r1 ) : -( r1 )) ;
+ foor_(&r__1);
+// FFEINTRIN_impACOS //
+ r__1 = acos(r1);
+ foor_(&r__1);
+// FFEINTRIN_impAIMAG //
+ r__1 = r_imag(&c1);
+ foor_(&r__1);
+// FFEINTRIN_impAINT //
+ r__1 = r_int(&r1);
+ foor_(&r__1);
+// FFEINTRIN_impALOG //
+ r__1 = log(r1);
+ foor_(&r__1);
+// FFEINTRIN_impALOG10 //
+ r__1 = r_lg10(&r1);
+ foor_(&r__1);
+// FFEINTRIN_impAMAX0 //
+ r__1 = (real) (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ;
+ foor_(&r__1);
+// FFEINTRIN_impAMAX1 //
+ r__1 = (doublereal)(( r1 ) >= ( r2 ) ? ( r1 ) : ( r2 )) ;
+ foor_(&r__1);
+// FFEINTRIN_impAMIN0 //
+ r__1 = (real) (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ;
+ foor_(&r__1);
+// FFEINTRIN_impAMIN1 //
+ r__1 = (doublereal)(( r1 ) <= ( r2 ) ? ( r1 ) : ( r2 )) ;
+ foor_(&r__1);
+// FFEINTRIN_impAMOD //
+ r__1 = r_mod(&r1, &r2);
+ foor_(&r__1);
+// FFEINTRIN_impANINT //
+ r__1 = r_nint(&r1);
+ foor_(&r__1);
+// FFEINTRIN_impASIN //
+ r__1 = asin(r1);
+ foor_(&r__1);
+// FFEINTRIN_impATAN //
+ r__1 = atan(r1);
+ foor_(&r__1);
+// FFEINTRIN_impATAN2 //
+ r__1 = atan2(r1, r2);
+ foor_(&r__1);
+// FFEINTRIN_impCABS //
+ r__1 = c_abs(&c1);
+ foor_(&r__1);
+// FFEINTRIN_impCCOS //
+ c_cos(&q__1, &c1);
+ fooc_(&q__1);
+// FFEINTRIN_impCEXP //
+ c_exp(&q__1, &c1);
+ fooc_(&q__1);
+// FFEINTRIN_impCHAR //
+ *(unsigned char *)&ch__1[0] = i1;
+ fooa_(ch__1, 1L);
+// FFEINTRIN_impCLOG //
+ c_log(&q__1, &c1);
+ fooc_(&q__1);
+// FFEINTRIN_impCONJG //
+ r_cnjg(&q__1, &c1);
+ fooc_(&q__1);
+// FFEINTRIN_impCOS //
+ r__1 = cos(r1);
+ foor_(&r__1);
+// FFEINTRIN_impCOSH //
+ r__1 = cosh(r1);
+ foor_(&r__1);
+// FFEINTRIN_impCSIN //
+ c_sin(&q__1, &c1);
+ fooc_(&q__1);
+// FFEINTRIN_impCSQRT //
+ c_sqrt(&q__1, &c1);
+ fooc_(&q__1);
+// FFEINTRIN_impDABS //
+ d__1 = (( d1 ) >= 0 ? ( d1 ) : -( d1 )) ;
+ food_(&d__1);
+// FFEINTRIN_impDACOS //
+ d__1 = acos(d1);
+ food_(&d__1);
+// FFEINTRIN_impDASIN //
+ d__1 = asin(d1);
+ food_(&d__1);
+// FFEINTRIN_impDATAN //
+ d__1 = atan(d1);
+ food_(&d__1);
+// FFEINTRIN_impDATAN2 //
+ d__1 = atan2(d1, d2);
+ food_(&d__1);
+// FFEINTRIN_impDCOS //
+ d__1 = cos(d1);
+ food_(&d__1);
+// FFEINTRIN_impDCOSH //
+ d__1 = cosh(d1);
+ food_(&d__1);
+// FFEINTRIN_impDDIM //
+ d__1 = d_dim(&d1, &d2);
+ food_(&d__1);
+// FFEINTRIN_impDEXP //
+ d__1 = exp(d1);
+ food_(&d__1);
+// FFEINTRIN_impDIM //
+ r__1 = r_dim(&r1, &r2);
+ foor_(&r__1);
+// FFEINTRIN_impDINT //
+ d__1 = d_int(&d1);
+ food_(&d__1);
+// FFEINTRIN_impDLOG //
+ d__1 = log(d1);
+ food_(&d__1);
+// FFEINTRIN_impDLOG10 //
+ d__1 = d_lg10(&d1);
+ food_(&d__1);
+// FFEINTRIN_impDMAX1 //
+ d__1 = (( d1 ) >= ( d2 ) ? ( d1 ) : ( d2 )) ;
+ food_(&d__1);
+// FFEINTRIN_impDMIN1 //
+ d__1 = (( d1 ) <= ( d2 ) ? ( d1 ) : ( d2 )) ;
+ food_(&d__1);
+// FFEINTRIN_impDMOD //
+ d__1 = d_mod(&d1, &d2);
+ food_(&d__1);
+// FFEINTRIN_impDNINT //
+ d__1 = d_nint(&d1);
+ food_(&d__1);
+// FFEINTRIN_impDPROD //
+ d__1 = (doublereal) r1 * r2;
+ food_(&d__1);
+// FFEINTRIN_impDSIGN //
+ d__1 = d_sign(&d1, &d2);
+ food_(&d__1);
+// FFEINTRIN_impDSIN //
+ d__1 = sin(d1);
+ food_(&d__1);
+// FFEINTRIN_impDSINH //
+ d__1 = sinh(d1);
+ food_(&d__1);
+// FFEINTRIN_impDSQRT //
+ d__1 = sqrt(d1);
+ food_(&d__1);
+// FFEINTRIN_impDTAN //
+ d__1 = tan(d1);
+ food_(&d__1);
+// FFEINTRIN_impDTANH //
+ d__1 = tanh(d1);
+ food_(&d__1);
+// FFEINTRIN_impEXP //
+ r__1 = exp(r1);
+ foor_(&r__1);
+// FFEINTRIN_impIABS //
+ i__1 = (( i1 ) >= 0 ? ( i1 ) : -( i1 )) ;
+ fooi_(&i__1);
+// FFEINTRIN_impICHAR //
+ i__1 = *(unsigned char *)a1;
+ fooi_(&i__1);
+// FFEINTRIN_impIDIM //
+ i__1 = i_dim(&i1, &i2);
+ fooi_(&i__1);
+// FFEINTRIN_impIDNINT //
+ i__1 = i_dnnt(&d1);
+ fooi_(&i__1);
+// FFEINTRIN_impINDEX //
+ i__1 = i_indx(a1, a2, 10L, 10L);
+ fooi_(&i__1);
+// FFEINTRIN_impISIGN //
+ i__1 = i_sign(&i1, &i2);
+ fooi_(&i__1);
+// FFEINTRIN_impLEN //
+ i__1 = i_len(a1, 10L);
+ fooi_(&i__1);
+// FFEINTRIN_impLGE //
+ L__1 = l_ge(a1, a2, 10L, 10L);
+ fool_(&L__1);
+// FFEINTRIN_impLGT //
+ L__1 = l_gt(a1, a2, 10L, 10L);
+ fool_(&L__1);
+// FFEINTRIN_impLLE //
+ L__1 = l_le(a1, a2, 10L, 10L);
+ fool_(&L__1);
+// FFEINTRIN_impLLT //
+ L__1 = l_lt(a1, a2, 10L, 10L);
+ fool_(&L__1);
+// FFEINTRIN_impMAX0 //
+ i__1 = (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ;
+ fooi_(&i__1);
+// FFEINTRIN_impMAX1 //
+ i__1 = (integer) (doublereal)(( r1 ) >= ( r2 ) ? ( r1 ) : ( r2 )) ;
+ fooi_(&i__1);
+// FFEINTRIN_impMIN0 //
+ i__1 = (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ;
+ fooi_(&i__1);
+// FFEINTRIN_impMIN1 //
+ i__1 = (integer) (doublereal)(( r1 ) <= ( r2 ) ? ( r1 ) : ( r2 )) ;
+ fooi_(&i__1);
+// FFEINTRIN_impMOD //
+ i__1 = i1 % i2;
+ fooi_(&i__1);
+// FFEINTRIN_impNINT //
+ i__1 = i_nint(&r1);
+ fooi_(&i__1);
+// FFEINTRIN_impSIGN //
+ r__1 = r_sign(&r1, &r2);
+ foor_(&r__1);
+// FFEINTRIN_impSIN //
+ r__1 = sin(r1);
+ foor_(&r__1);
+// FFEINTRIN_impSINH //
+ r__1 = sinh(r1);
+ foor_(&r__1);
+// FFEINTRIN_impSQRT //
+ r__1 = sqrt(r1);
+ foor_(&r__1);
+// FFEINTRIN_impTAN //
+ r__1 = tan(r1);
+ foor_(&r__1);
+// FFEINTRIN_impTANH //
+ r__1 = tanh(r1);
+ foor_(&r__1);
+// FFEINTRIN_imp_CMPLX_C //
+ r__1 = c1.r;
+ r__2 = c2.r;
+ q__1.r = r__1, q__1.i = r__2;
+ fooc_(&q__1);
+// FFEINTRIN_imp_CMPLX_D //
+ z__1.r = d1, z__1.i = d2;
+ fooz_(&z__1);
+// FFEINTRIN_imp_CMPLX_I //
+ r__1 = (real) i1;
+ r__2 = (real) i2;
+ q__1.r = r__1, q__1.i = r__2;
+ fooc_(&q__1);
+// FFEINTRIN_imp_CMPLX_R //
+ q__1.r = r1, q__1.i = r2;
+ fooc_(&q__1);
+// FFEINTRIN_imp_DBLE_C //
+ d__1 = (doublereal) c1.r;
+ food_(&d__1);
+// FFEINTRIN_imp_DBLE_D //
+ d__1 = d1;
+ food_(&d__1);
+// FFEINTRIN_imp_DBLE_I //
+ d__1 = (doublereal) i1;
+ food_(&d__1);
+// FFEINTRIN_imp_DBLE_R //
+ d__1 = (doublereal) r1;
+ food_(&d__1);
+// FFEINTRIN_imp_INT_C //
+ i__1 = (integer) c1.r;
+ fooi_(&i__1);
+// FFEINTRIN_imp_INT_D //
+ i__1 = (integer) d1;
+ fooi_(&i__1);
+// FFEINTRIN_imp_INT_I //
+ i__1 = i1;
+ fooi_(&i__1);
+// FFEINTRIN_imp_INT_R //
+ i__1 = (integer) r1;
+ fooi_(&i__1);
+// FFEINTRIN_imp_REAL_C //
+ r__1 = c1.r;
+ foor_(&r__1);
+// FFEINTRIN_imp_REAL_D //
+ r__1 = (real) d1;
+ foor_(&r__1);
+// FFEINTRIN_imp_REAL_I //
+ r__1 = (real) i1;
+ foor_(&r__1);
+// FFEINTRIN_imp_REAL_R //
+ r__1 = r1;
+ foor_(&r__1);
+
+// FFEINTRIN_imp_INT_D: //
+
+// FFEINTRIN_specIDINT //
+ i__1 = (integer) d1;
+ fooi_(&i__1);
+
+// FFEINTRIN_imp_INT_R: //
+
+// FFEINTRIN_specIFIX //
+ i__1 = (integer) r1;
+ fooi_(&i__1);
+// FFEINTRIN_specINT //
+ i__1 = (integer) r1;
+ fooi_(&i__1);
+
+// FFEINTRIN_imp_REAL_D: //
+
+// FFEINTRIN_specSNGL //
+ r__1 = (real) d1;
+ foor_(&r__1);
+
+// FFEINTRIN_imp_REAL_I: //
+
+// FFEINTRIN_specFLOAT //
+ r__1 = (real) i1;
+ foor_(&r__1);
+// FFEINTRIN_specREAL //
+ r__1 = (real) i1;
+ foor_(&r__1);
+
+} // MAIN__ //
+
+-------- (end output file from f2c)
+
+*/
+}
+
+#endif
+/* For power (exponentiation) where right-hand operand is type INTEGER,
+ generate in-line code to do it the fast way (which, if the operand
+ is a constant, might just mean a series of multiplies). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_expr_power_integer_ (ffebld left, ffebld right)
+{
+ tree l = ffecom_expr (left);
+ tree r = ffecom_expr (right);
+ tree ltype = TREE_TYPE (l);
+ tree rtype = TREE_TYPE (r);
+ tree result = NULL_TREE;
+
+ if (l == error_mark_node
+ || r == error_mark_node)
+ return error_mark_node;
+
+ if (TREE_CODE (r) == INTEGER_CST)
+ {
+ int sgn = tree_int_cst_sgn (r);
+
+ if (sgn == 0)
+ return convert (ltype, integer_one_node);
+
+ if ((TREE_CODE (ltype) == INTEGER_TYPE)
+ && (sgn < 0))
+ {
+ /* Reciprocal of integer is either 0, -1, or 1, so after
+ calculating that (which we leave to the back end to do
+ or not do optimally), don't bother with any multiplying. */
+
+ result = ffecom_tree_divide_ (ltype,
+ convert (ltype, integer_one_node),
+ l,
+ NULL_TREE, NULL, NULL);
+ r = ffecom_1 (NEGATE_EXPR,
+ rtype,
+ r);
+ if ((TREE_INT_CST_LOW (r) & 1) == 0)
+ result = ffecom_1 (ABS_EXPR, rtype,
+ result);
+ }
+
+ /* Generate appropriate series of multiplies, preceded
+ by divide if the exponent is negative. */
+
+ l = save_expr (l);
+
+ if (sgn < 0)
+ {
+ l = ffecom_tree_divide_ (ltype,
+ convert (ltype, integer_one_node),
+ l,
+ NULL_TREE, NULL, NULL);
+ r = ffecom_1 (NEGATE_EXPR, rtype, r);
+ assert (TREE_CODE (r) == INTEGER_CST);
+
+ if (tree_int_cst_sgn (r) < 0)
+ { /* The "most negative" number. */
+ r = ffecom_1 (NEGATE_EXPR, rtype,
+ ffecom_2 (RSHIFT_EXPR, rtype,
+ r,
+ integer_one_node));
+ l = save_expr (l);
+ l = ffecom_2 (MULT_EXPR, ltype,
+ l,
+ l);
+ }
+ }
+
+ for (;;)
+ {
+ if (TREE_INT_CST_LOW (r) & 1)
+ {
+ if (result == NULL_TREE)
+ result = l;
+ else
+ result = ffecom_2 (MULT_EXPR, ltype,
+ result,
+ l);
+ }
+
+ r = ffecom_2 (RSHIFT_EXPR, rtype,
+ r,
+ integer_one_node);
+ if (integer_zerop (r))
+ break;
+ assert (TREE_CODE (r) == INTEGER_CST);
+
+ l = save_expr (l);
+ l = ffecom_2 (MULT_EXPR, ltype,
+ l,
+ l);
+ }
+ return result;
+ }
+
+ /* Though rhs isn't a constant, in-line code cannot be expanded
+ while transforming dummies
+ because the back end cannot be easily convinced to generate
+ stores (MODIFY_EXPR), handle temporaries, and so on before
+ all the appropriate rtx's have been generated for things like
+ dummy args referenced in rhs -- which doesn't happen until
+ store_parm_decls() is called (expand_function_start, I believe,
+ does the actual rtx-stuffing of PARM_DECLs).
+
+ So, in this case, let the caller generate the call to the
+ run-time-library function to evaluate the power for us. */
+
+ if (ffecom_transform_only_dummies_)
+ return NULL_TREE;
+
+ /* Right-hand operand not a constant, expand in-line code to figure
+ out how to do the multiplies, &c.
+
+ The returned expression is expressed this way in GNU C, where l and
+ r are the "inputs":
+
+ ({ typeof (r) rtmp = r;
+ typeof (l) ltmp = l;
+ typeof (l) result;
+
+ if (rtmp == 0)
+ result = 1;
+ else
+ {
+ if ((basetypeof (l) == basetypeof (int))
+ && (rtmp < 0))
+ {
+ result = ((typeof (l)) 1) / ltmp;
+ if ((ltmp < 0) && (((-rtmp) & 1) == 0))
+ result = -result;
+ }
+ else
+ {
+ result = 1;
+ if ((basetypeof (l) != basetypeof (int))
+ && (rtmp < 0))
+ {
+ ltmp = ((typeof (l)) 1) / ltmp;
+ rtmp = -rtmp;
+ if (rtmp < 0)
+ {
+ rtmp = -(rtmp >> 1);
+ ltmp *= ltmp;
+ }
+ }
+ for (;;)
+ {
+ if (rtmp & 1)
+ result *= ltmp;
+ if ((rtmp >>= 1) == 0)
+ break;
+ ltmp *= ltmp;
+ }
+ }
+ }
+ result;
+ })
+
+ Note that some of the above is compile-time collapsable, such as
+ the first part of the if statements that checks the base type of
+ l against int. The if statements are phrased that way to suggest
+ an easy way to generate the if/else constructs here, knowing that
+ the back end should (and probably does) eliminate the resulting
+ dead code (either the int case or the non-int case), something
+ it couldn't do without the redundant phrasing, requiring explicit
+ dead-code elimination here, which would be kind of difficult to
+ read. */
+
+ {
+ tree rtmp;
+ tree ltmp;
+ tree basetypeof_l_is_int;
+ tree se;
+
+ basetypeof_l_is_int
+ = build_int_2 ((TREE_CODE (ltype) == INTEGER_TYPE), 0);
+
+ se = expand_start_stmt_expr ();
+ ffecom_push_calltemps ();
+
+ rtmp = ffecom_push_tempvar (rtype, FFETARGET_charactersizeNONE, -1,
+ TRUE);
+ ltmp = ffecom_push_tempvar (ltype, FFETARGET_charactersizeNONE, -1,
+ TRUE);
+ result = ffecom_push_tempvar (ltype, FFETARGET_charactersizeNONE, -1,
+ TRUE);
+
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ rtmp,
+ r));
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ ltmp,
+ l));
+ expand_start_cond (ffecom_truth_value
+ (ffecom_2 (EQ_EXPR, integer_type_node,
+ rtmp,
+ convert (rtype, integer_zero_node))),
+ 0);
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ result,
+ convert (ltype, integer_one_node)));
+ expand_start_else ();
+ if (!integer_zerop (basetypeof_l_is_int))
+ {
+ expand_start_cond (ffecom_2 (LT_EXPR, integer_type_node,
+ rtmp,
+ convert (rtype,
+ integer_zero_node)),
+ 0);
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ result,
+ ffecom_tree_divide_
+ (ltype,
+ convert (ltype, integer_one_node),
+ ltmp,
+ NULL_TREE, NULL, NULL)));
+ expand_start_cond (ffecom_truth_value
+ (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+ ffecom_2 (LT_EXPR, integer_type_node,
+ ltmp,
+ convert (ltype,
+ integer_zero_node)),
+ ffecom_2 (EQ_EXPR, integer_type_node,
+ ffecom_2 (BIT_AND_EXPR,
+ rtype,
+ ffecom_1 (NEGATE_EXPR,
+ rtype,
+ rtmp),
+ convert (rtype,
+ integer_one_node)),
+ convert (rtype,
+ integer_zero_node)))),
+ 0);
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ result,
+ ffecom_1 (NEGATE_EXPR,
+ ltype,
+ result)));
+ expand_end_cond ();
+ expand_start_else ();
+ }
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ result,
+ convert (ltype, integer_one_node)));
+ expand_start_cond (ffecom_truth_value
+ (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+ ffecom_truth_value_invert
+ (basetypeof_l_is_int),
+ ffecom_2 (LT_EXPR, integer_type_node,
+ rtmp,
+ convert (rtype,
+ integer_zero_node)))),
+ 0);
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ ltmp,
+ ffecom_tree_divide_
+ (ltype,
+ convert (ltype, integer_one_node),
+ ltmp,
+ NULL_TREE, NULL, NULL)));
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ rtmp,
+ ffecom_1 (NEGATE_EXPR, rtype,
+ rtmp)));
+ expand_start_cond (ffecom_truth_value
+ (ffecom_2 (LT_EXPR, integer_type_node,
+ rtmp,
+ convert (rtype, integer_zero_node))),
+ 0);
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ rtmp,
+ ffecom_1 (NEGATE_EXPR, rtype,
+ ffecom_2 (RSHIFT_EXPR,
+ rtype,
+ rtmp,
+ integer_one_node))));
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ ltmp,
+ ffecom_2 (MULT_EXPR, ltype,
+ ltmp,
+ ltmp)));
+ expand_end_cond ();
+ expand_end_cond ();
+ expand_start_loop (1);
+ expand_start_cond (ffecom_truth_value
+ (ffecom_2 (BIT_AND_EXPR, rtype,
+ rtmp,
+ convert (rtype, integer_one_node))),
+ 0);
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ result,
+ ffecom_2 (MULT_EXPR, ltype,
+ result,
+ ltmp)));
+ expand_end_cond ();
+ expand_exit_loop_if_false (NULL,
+ ffecom_truth_value
+ (ffecom_modify (rtype,
+ rtmp,
+ ffecom_2 (RSHIFT_EXPR,
+ rtype,
+ rtmp,
+ integer_one_node))));
+ expand_expr_stmt (ffecom_modify (void_type_node,
+ ltmp,
+ ffecom_2 (MULT_EXPR, ltype,
+ ltmp,
+ ltmp)));
+ expand_end_loop ();
+ expand_end_cond ();
+ if (!integer_zerop (basetypeof_l_is_int))
+ expand_end_cond ();
+ expand_expr_stmt (result);
+
+ ffecom_pop_calltemps ();
+ result = expand_end_stmt_expr (se);
+ TREE_SIDE_EFFECTS (result) = 1;
+ }
+
+ return result;
+}
+
+#endif
+/* ffecom_expr_transform_ -- Transform symbols in expr
+
+ ffebld expr; // FFE expression.
+ ffecom_expr_transform_ (expr);
+
+ Recursive descent on expr while transforming any untransformed SYMTERs. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_expr_transform_ (ffebld expr)
+{
+ tree t;
+ ffesymbol s;
+
+tail_recurse: /* :::::::::::::::::::: */
+
+ if (expr == NULL)
+ return;
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opSYMTER:
+ s = ffebld_symter (expr);
+ t = ffesymbol_hook (s).decl_tree;
+ if ((t == NULL_TREE)
+ && ((ffesymbol_kind (s) != FFEINFO_kindNONE)
+ || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+ && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC))))
+ {
+ s = ffecom_sym_transform_ (s);
+ t = ffesymbol_hook (s).decl_tree; /* Sfunc expr non-dummy,
+ DIMENSION expr? */
+ }
+ break; /* Ok if (t == NULL) here. */
+
+ case FFEBLD_opITEM:
+ ffecom_expr_transform_ (ffebld_head (expr));
+ expr = ffebld_trail (expr);
+ goto tail_recurse; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+
+ switch (ffebld_arity (expr))
+ {
+ case 2:
+ ffecom_expr_transform_ (ffebld_left (expr));
+ expr = ffebld_right (expr);
+ goto tail_recurse; /* :::::::::::::::::::: */
+
+ case 1:
+ expr = ffebld_left (expr);
+ goto tail_recurse; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+
+ return;
+}
+
+#endif
+/* Make a type based on info in live f2c.h file. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_f2c_make_type_ (tree *type, int tcode, char *name)
+{
+ switch (tcode)
+ {
+ case FFECOM_f2ccodeCHAR:
+ *type = make_signed_type (CHAR_TYPE_SIZE);
+ break;
+
+ case FFECOM_f2ccodeSHORT:
+ *type = make_signed_type (SHORT_TYPE_SIZE);
+ break;
+
+ case FFECOM_f2ccodeINT:
+ *type = make_signed_type (INT_TYPE_SIZE);
+ break;
+
+ case FFECOM_f2ccodeLONG:
+ *type = make_signed_type (LONG_TYPE_SIZE);
+ break;
+
+ case FFECOM_f2ccodeLONGLONG:
+ *type = make_signed_type (LONG_LONG_TYPE_SIZE);
+ break;
+
+ case FFECOM_f2ccodeCHARPTR:
+ *type = build_pointer_type (DEFAULT_SIGNED_CHAR
+ ? signed_char_type_node
+ : unsigned_char_type_node);
+ break;
+
+ case FFECOM_f2ccodeFLOAT:
+ *type = make_node (REAL_TYPE);
+ TYPE_PRECISION (*type) = FLOAT_TYPE_SIZE;
+ layout_type (*type);
+ break;
+
+ case FFECOM_f2ccodeDOUBLE:
+ *type = make_node (REAL_TYPE);
+ TYPE_PRECISION (*type) = DOUBLE_TYPE_SIZE;
+ layout_type (*type);
+ break;
+
+ case FFECOM_f2ccodeLONGDOUBLE:
+ *type = make_node (REAL_TYPE);
+ TYPE_PRECISION (*type) = LONG_DOUBLE_TYPE_SIZE;
+ layout_type (*type);
+ break;
+
+ case FFECOM_f2ccodeTWOREALS:
+ *type = ffecom_make_complex_type_ (ffecom_f2c_real_type_node);
+ break;
+
+ case FFECOM_f2ccodeTWODOUBLEREALS:
+ *type = ffecom_make_complex_type_ (ffecom_f2c_doublereal_type_node);
+ break;
+
+ default:
+ assert ("unexpected FFECOM_f2ccodeXYZZY!" == NULL);
+ *type = error_mark_node;
+ return;
+ }
+
+ pushdecl (build_decl (TYPE_DECL,
+ ffecom_get_invented_identifier ("__g77_f2c_%s",
+ name, 0),
+ *type));
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+/* Set the f2c list-directed-I/O code for whatever (integral) type has the
+ given size. */
+
+static void
+ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size,
+ int code)
+{
+ int j;
+ tree t;
+
+ for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+ if (((t = ffecom_tree_type[bt][j]) != NULL_TREE)
+ && (TREE_INT_CST_LOW (TYPE_SIZE (t)) == size))
+ {
+ assert (code != -1);
+ ffecom_f2c_typecode_[bt][j] = code;
+ code = -1;
+ }
+}
+
+#endif
+/* Finish up globals after doing all program units in file
+
+ Need to handle only uninitialized COMMON areas. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffeglobal
+ffecom_finish_global_ (ffeglobal global)
+{
+ tree cbtype;
+ tree cbt;
+ tree size;
+
+ if (ffeglobal_type (global) != FFEGLOBAL_typeCOMMON)
+ return global;
+
+ if (ffeglobal_common_init (global))
+ return global;
+
+ cbt = ffeglobal_hook (global);
+ if ((cbt == NULL_TREE)
+ || !ffeglobal_common_have_size (global))
+ return global; /* No need to make common, never ref'd. */
+
+ suspend_momentary ();
+
+ DECL_EXTERNAL (cbt) = 0;
+
+ /* Give the array a size now. */
+
+ size = build_int_2 (ffeglobal_common_size (global), 0);
+
+ cbtype = TREE_TYPE (cbt);
+ TYPE_DOMAIN (cbtype) = build_range_type (integer_type_node,
+ integer_one_node,
+ size);
+ if (!TREE_TYPE (size))
+ TREE_TYPE (size) = TYPE_DOMAIN (cbtype);
+ layout_type (cbtype);
+
+ cbt = start_decl (cbt, FALSE);
+ assert (cbt == ffeglobal_hook (global));
+
+ finish_decl (cbt, NULL_TREE, FALSE);
+
+ return global;
+}
+
+#endif
+/* Finish up any untransformed symbols. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffesymbol
+ffecom_finish_symbol_transform_ (ffesymbol s)
+{
+ if (s == NULL)
+ return s;
+
+ /* It's easy to know to transform an untransformed symbol, to make sure
+ we put out debugging info for it. But COMMON variables, unlike
+ EQUIVALENCE ones, aren't given declarations in addition to the
+ tree expressions that specify offsets, because COMMON variables
+ can be referenced in the outer scope where only dummy arguments
+ (PARM_DECLs) should really be seen. To be safe, just don't do any
+ VAR_DECLs for COMMON variables when we transform them for real
+ use, and therefore we do all the VAR_DECL creating here. */
+
+ if ((ffesymbol_hook (s).decl_tree == NULL_TREE)
+ && ((ffesymbol_kind (s) != FFEINFO_kindNONE)
+ || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+ && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC)))
+ && (ffesymbol_where (s) != FFEINFO_whereDUMMY))
+ /* Not transformed, and not CHARACTER*(*), and not a dummy
+ argument, which can happen only if the entry point names
+ it "rides in on" are all invalidated for other reasons. */
+ s = ffecom_sym_transform_ (s);
+
+ if ((ffesymbol_where (s) == FFEINFO_whereCOMMON)
+ && (ffesymbol_hook (s).decl_tree != error_mark_node))
+ {
+#ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING
+ int yes = suspend_momentary ();
+
+ /* This isn't working, at least for dbxout. The .s file looks
+ okay to me (burley), but in gdb 4.9 at least, the variables
+ appear to reside somewhere outside of the common area, so
+ it doesn't make sense to mislead anyone by generating the info
+ on those variables until this is fixed. NOTE: Same problem
+ with EQUIVALENCE, sadly...see similar #if later. */
+ ffecom_member_phase2_ (ffesymbol_storage (ffesymbol_common (s)),
+ ffesymbol_storage (s));
+
+ resume_momentary (yes);
+#endif
+ }
+
+ return s;
+}
+
+#endif
+/* Append underscore(s) to name before calling get_identifier. "us"
+ is nonzero if the name already contains an underscore and thus
+ needs two underscores appended. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_get_appended_identifier_ (char us, char *name)
+{
+ int i;
+ char *newname;
+ tree id;
+
+ newname = xmalloc ((i = strlen (name)) + 1
+ + ffe_is_underscoring ()
+ + us);
+ memcpy (newname, name, i);
+ newname[i] = '_';
+ newname[i + us] = '_';
+ newname[i + 1 + us] = '\0';
+ id = get_identifier (newname);
+
+ free (newname);
+
+ return id;
+}
+
+#endif
+/* Decide whether to append underscore to name before calling
+ get_identifier. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_get_external_identifier_ (ffesymbol s)
+{
+ char us;
+ char *name = ffesymbol_text (s);
+
+ /* If name is a built-in name, just return it as is. */
+
+ if (!ffe_is_underscoring ()
+ || (strcmp (name, FFETARGET_nameBLANK_COMMON) == 0)
+#if FFETARGET_isENFORCED_MAIN_NAME
+ || (strcmp (name, FFETARGET_nameENFORCED_NAME) == 0)
+#else
+ || (strcmp (name, FFETARGET_nameUNNAMED_MAIN) == 0)
+#endif
+ || (strcmp (name, FFETARGET_nameUNNAMED_BLOCK_DATA) == 0))
+ return get_identifier (name);
+
+ us = ffe_is_second_underscore ()
+ ? (strchr (name, '_') != NULL)
+ : 0;
+
+ return ffecom_get_appended_identifier_ (us, name);
+}
+
+#endif
+/* Decide whether to append underscore to internal name before calling
+ get_identifier.
+
+ This is for non-external, top-function-context names only. Transform
+ identifier so it doesn't conflict with the transformed result
+ of using a _different_ external name. E.g. if "CALL FOO" is
+ transformed into "FOO_();", then the variable in "FOO_ = 3"
+ must be transformed into something that does not conflict, since
+ these two things should be independent.
+
+ The transformation is as follows. If the name does not contain
+ an underscore, there is no possible conflict, so just return.
+ If the name does contain an underscore, then transform it just
+ like we transform an external identifier. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_get_identifier_ (char *name)
+{
+ /* If name does not contain an underscore, just return it as is. */
+
+ if (!ffe_is_underscoring ()
+ || (strchr (name, '_') == NULL))
+ return get_identifier (name);
+
+ return ffecom_get_appended_identifier_ (ffe_is_second_underscore (),
+ name);
+}
+
+#endif
+/* ffecom_gen_sfuncdef_ -- Generate definition of statement function
+
+ tree t;
+ ffesymbol s; // kindFUNCTION, whereIMMEDIATE.
+ t = ffecom_gen_sfuncdef_(s,ffesymbol_basictype(s),
+ ffesymbol_kindtype(s));
+
+ Call after setting up containing function and getting trees for all
+ other symbols. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
+{
+ ffebld expr = ffesymbol_sfexpr (s);
+ tree type;
+ tree func;
+ tree result;
+ bool charfunc = (bt == FFEINFO_basictypeCHARACTER);
+ static bool recurse = FALSE;
+ int yes;
+ int old_lineno = lineno;
+ char *old_input_filename = input_filename;
+
+ ffecom_nested_entry_ = s;
+
+ /* For now, we don't have a handy pointer to where the sfunc is actually
+ defined, though that should be easy to add to an ffesymbol. (The
+ token/where info available might well point to the place where the type
+ of the sfunc is declared, especially if that precedes the place where
+ the sfunc itself is defined, which is typically the case.) We should
+ put out a null pointer rather than point somewhere wrong, but I want to
+ see how it works at this point. */
+
+ input_filename = ffesymbol_where_filename (s);
+ lineno = ffesymbol_where_filelinenum (s);
+
+ /* Pretransform the expression so any newly discovered things belong to the
+ outer program unit, not to the statement function. */
+
+ ffecom_expr_transform_ (expr);
+
+ /* Make sure no recursive invocation of this fn (a specific case of failing
+ to pretransform an sfunc's expression, i.e. where its expression
+ references another untransformed sfunc) happens. */
+
+ assert (!recurse);
+ recurse = TRUE;
+
+ yes = suspend_momentary ();
+
+ push_f_function_context ();
+
+ ffecom_push_calltemps ();
+
+ if (charfunc)
+ type = void_type_node;
+ else
+ {
+ type = ffecom_tree_type[bt][kt];
+ if (type == NULL_TREE)
+ type = integer_type_node; /* _sym_exec_transition reports
+ error. */
+ }
+
+ start_function (ffecom_get_identifier_ (ffesymbol_text (s)),
+ build_function_type (type, NULL_TREE),
+ 1, /* nested/inline */
+ 0); /* TREE_PUBLIC */
+
+ /* We don't worry about COMPLEX return values here, because this is
+ entirely internal to our code, and gcc has the ability to return COMPLEX
+ directly as a value. */
+
+ yes = suspend_momentary ();
+
+ if (charfunc)
+ { /* Prepend arg for where result goes. */
+ tree type;
+
+ type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
+
+ result = ffecom_get_invented_identifier ("__g77_%s",
+ "result", 0);
+
+ ffecom_char_enhance_arg_ (&type, s); /* Ignore returned length. */
+
+ type = build_pointer_type (type);
+ result = build_decl (PARM_DECL, result, type);
+
+ push_parm_decl (result);
+ }
+ else
+ result = NULL_TREE; /* Not ref'd if !charfunc. */
+
+ ffecom_push_dummy_decls_ (ffesymbol_dummyargs (s), TRUE);
+
+ resume_momentary (yes);
+
+ store_parm_decls (0);
+
+ ffecom_start_compstmt_ ();
+
+ if (expr != NULL)
+ {
+ if (charfunc)
+ {
+ ffetargetCharacterSize sz = ffesymbol_size (s);
+ tree result_length;
+
+ result_length = build_int_2 (sz, 0);
+ TREE_TYPE (result_length) = ffecom_f2c_ftnlen_type_node;
+
+ ffecom_let_char_ (result, result_length, sz, expr);
+ expand_null_return ();
+ }
+ else
+ expand_return (ffecom_modify (NULL_TREE,
+ DECL_RESULT (current_function_decl),
+ ffecom_expr (expr)));
+
+ clear_momentary ();
+ }
+
+ ffecom_end_compstmt_ ();
+
+ func = current_function_decl;
+ finish_function (1);
+
+ ffecom_pop_calltemps ();
+
+ pop_f_function_context ();
+
+ resume_momentary (yes);
+
+ recurse = FALSE;
+
+ lineno = old_lineno;
+ input_filename = old_input_filename;
+
+ ffecom_nested_entry_ = NULL;
+
+ return func;
+}
+
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static char *
+ffecom_gfrt_args_ (ffecomGfrt ix)
+{
+ return ffecom_gfrt_argstring_[ix];
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_gfrt_tree_ (ffecomGfrt ix)
+{
+ if (ffecom_gfrt_[ix] == NULL_TREE)
+ ffecom_make_gfrt_ (ix);
+
+ return ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (ffecom_gfrt_[ix])),
+ ffecom_gfrt_[ix]);
+}
+
+#endif
+/* Return initialize-to-zero expression for this VAR_DECL. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_init_zero_ (tree decl)
+{
+ tree init;
+ int incremental = TREE_STATIC (decl);
+ tree type = TREE_TYPE (decl);
+
+ if (incremental)
+ {
+ int momentary = suspend_momentary ();
+ push_obstacks_nochange ();
+ if (TREE_PERMANENT (decl))
+ end_temporary_allocation ();
+ make_decl_rtl (decl, NULL, TREE_PUBLIC (decl) ? 1 : 0);
+ assemble_variable (decl, TREE_PUBLIC (decl) ? 1 : 0, 0, 1);
+ pop_obstacks ();
+ resume_momentary (momentary);
+ }
+
+ push_momentary ();
+
+ if ((TREE_CODE (type) != ARRAY_TYPE)
+ && (TREE_CODE (type) != RECORD_TYPE)
+ && (TREE_CODE (type) != UNION_TYPE)
+ && !incremental)
+ init = convert (type, integer_zero_node);
+ else if (!incremental)
+ {
+ int momentary = suspend_momentary ();
+
+ init = build (CONSTRUCTOR, type, NULL_TREE, NULL_TREE);
+ TREE_CONSTANT (init) = 1;
+ TREE_STATIC (init) = 1;
+
+ resume_momentary (momentary);
+ }
+ else
+ {
+ int momentary = suspend_momentary ();
+
+ assemble_zeros (int_size_in_bytes (type));
+ init = error_mark_node;
+
+ resume_momentary (momentary);
+ }
+
+ pop_momentary_nofree ();
+
+ return init;
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg,
+ tree *maybe_tree)
+{
+ tree expr_tree;
+ tree length_tree;
+
+ switch (ffebld_op (arg))
+ {
+ case FFEBLD_opCONTER: /* For F90, check 0-length. */
+ if (ffetarget_length_character1
+ (ffebld_constant_character1
+ (ffebld_conter (arg))) == 0)
+ {
+ *maybe_tree = integer_zero_node;
+ return convert (tree_type, integer_zero_node);
+ }
+
+ *maybe_tree = integer_one_node;
+ expr_tree = build_int_2 (*ffetarget_text_character1
+ (ffebld_constant_character1
+ (ffebld_conter (arg))),
+ 0);
+ TREE_TYPE (expr_tree) = tree_type;
+ return expr_tree;
+
+ case FFEBLD_opSYMTER:
+ case FFEBLD_opARRAYREF:
+ case FFEBLD_opFUNCREF:
+ case FFEBLD_opSUBSTR:
+ ffecom_push_calltemps ();
+ ffecom_char_args_ (&expr_tree, &length_tree, arg);
+ ffecom_pop_calltemps ();
+
+ if ((expr_tree == error_mark_node)
+ || (length_tree == error_mark_node))
+ {
+ *maybe_tree = error_mark_node;
+ return error_mark_node;
+ }
+
+ if (integer_zerop (length_tree))
+ {
+ *maybe_tree = integer_zero_node;
+ return convert (tree_type, integer_zero_node);
+ }
+
+ expr_tree
+ = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
+ expr_tree);
+ expr_tree
+ = ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
+ expr_tree,
+ integer_one_node);
+ expr_tree = convert (tree_type, expr_tree);
+
+ if (TREE_CODE (length_tree) == INTEGER_CST)
+ *maybe_tree = integer_one_node;
+ else /* Must check length at run time. */
+ *maybe_tree
+ = ffecom_truth_value
+ (ffecom_2 (GT_EXPR, integer_type_node,
+ length_tree,
+ ffecom_f2c_ftnlen_zero_node));
+ return expr_tree;
+
+ case FFEBLD_opPAREN:
+ case FFEBLD_opCONVERT:
+ if (ffeinfo_size (ffebld_info (arg)) == 0)
+ {
+ *maybe_tree = integer_zero_node;
+ return convert (tree_type, integer_zero_node);
+ }
+ return ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg),
+ maybe_tree);
+
+ case FFEBLD_opCONCATENATE:
+ {
+ tree maybe_left;
+ tree maybe_right;
+ tree expr_left;
+ tree expr_right;
+
+ expr_left = ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg),
+ &maybe_left);
+ expr_right = ffecom_intrinsic_ichar_ (tree_type, ffebld_right (arg),
+ &maybe_right);
+ *maybe_tree = ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
+ maybe_left,
+ maybe_right);
+ expr_tree = ffecom_3 (COND_EXPR, tree_type,
+ maybe_left,
+ expr_left,
+ expr_right);
+ return expr_tree;
+ }
+
+ default:
+ assert ("bad op in ICHAR" == NULL);
+ return error_mark_node;
+ }
+}
+
+#endif
+/* ffecom_intrinsic_len_ -- Return length info for char arg (LEN())
+
+ tree length_arg;
+ ffebld expr;
+ length_arg = ffecom_intrinsic_len_ (expr);
+
+ Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
+ subexpressions by constructing the appropriate tree for the
+ length-of-character-text argument in a calling sequence. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_intrinsic_len_ (ffebld expr)
+{
+ ffetargetCharacter1 val;
+ tree length;
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opCONTER:
+ val = ffebld_constant_character1 (ffebld_conter (expr));
+ length = build_int_2 (ffetarget_length_character1 (val), 0);
+ TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
+ break;
+
+ case FFEBLD_opSYMTER:
+ {
+ ffesymbol s = ffebld_symter (expr);
+ tree item;
+
+ item = ffesymbol_hook (s).decl_tree;
+ if (item == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ item = ffesymbol_hook (s).decl_tree;
+ }
+ if (ffesymbol_kind (s) == FFEINFO_kindENTITY)
+ {
+ if (ffesymbol_size (s) == FFETARGET_charactersizeNONE)
+ length = ffesymbol_hook (s).length_tree;
+ else
+ {
+ length = build_int_2 (ffesymbol_size (s), 0);
+ TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
+ }
+ }
+ else if (item == error_mark_node)
+ length = error_mark_node;
+ else /* FFEINFO_kindFUNCTION: */
+ length = NULL_TREE;
+ }
+ break;
+
+ case FFEBLD_opARRAYREF:
+ length = ffecom_intrinsic_len_ (ffebld_left (expr));
+ break;
+
+ case FFEBLD_opSUBSTR:
+ {
+ ffebld start;
+ ffebld end;
+ ffebld thing = ffebld_right (expr);
+ tree start_tree;
+ tree end_tree;
+
+ assert (ffebld_op (thing) == FFEBLD_opITEM);
+ start = ffebld_head (thing);
+ thing = ffebld_trail (thing);
+ assert (ffebld_trail (thing) == NULL);
+ end = ffebld_head (thing);
+
+ length = ffecom_intrinsic_len_ (ffebld_left (expr));
+
+ if (length == error_mark_node)
+ break;
+
+ if (start == NULL)
+ {
+ if (end == NULL)
+ ;
+ else
+ {
+ length = convert (ffecom_f2c_ftnlen_type_node,
+ ffecom_expr (end));
+ }
+ }
+ else
+ {
+ start_tree = convert (ffecom_f2c_ftnlen_type_node,
+ ffecom_expr (start));
+
+ if (start_tree == error_mark_node)
+ {
+ length = error_mark_node;
+ break;
+ }
+
+ if (end == NULL)
+ {
+ length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ ffecom_2 (MINUS_EXPR,
+ ffecom_f2c_ftnlen_type_node,
+ length,
+ start_tree));
+ }
+ else
+ {
+ end_tree = convert (ffecom_f2c_ftnlen_type_node,
+ ffecom_expr (end));
+
+ if (end_tree == error_mark_node)
+ {
+ length = error_mark_node;
+ break;
+ }
+
+ length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ ffecom_2 (MINUS_EXPR,
+ ffecom_f2c_ftnlen_type_node,
+ end_tree, start_tree));
+ }
+ }
+ }
+ break;
+
+ case FFEBLD_opCONCATENATE:
+ length
+ = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+ ffecom_intrinsic_len_ (ffebld_left (expr)),
+ ffecom_intrinsic_len_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opFUNCREF:
+ case FFEBLD_opCONVERT:
+ length = build_int_2 (ffebld_size (expr), 0);
+ TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
+ break;
+
+ default:
+ assert ("bad op for single char arg expr" == NULL);
+ length = ffecom_f2c_ftnlen_zero_node;
+ break;
+ }
+
+ assert (length != NULL_TREE);
+
+ return length;
+}
+
+#endif
+/* ffecom_let_char_ -- Do assignment stuff for character type
+
+ tree dest_tree; // destination (ADDR_EXPR)
+ tree dest_length; // length (INT_CST/INDIRECT_REF(PARM_DECL))
+ ffetargetCharacterSize dest_size; // length
+ ffebld source; // source expression
+ ffecom_let_char_(dest_tree,dest_length,dest_size,source);
+
+ Generates code to do the assignment. Used by ordinary assignment
+ statement handler ffecom_let_stmt and by statement-function
+ handler to generate code for a statement function. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_let_char_ (tree dest_tree, tree dest_length,
+ ffetargetCharacterSize dest_size, ffebld source)
+{
+ ffecomConcatList_ catlist;
+ tree source_length;
+ tree source_tree;
+ tree expr_tree;
+
+ if ((dest_tree == error_mark_node)
+ || (dest_length == error_mark_node))
+ return;
+
+ assert (dest_tree != NULL_TREE);
+ assert (dest_length != NULL_TREE);
+
+ /* Source might be an opCONVERT, which just means it is a different size
+ than the destination. Since the underlying implementation here handles
+ that (directly or via the s_copy or s_cat run-time-library functions),
+ we don't need the "convenience" of an opCONVERT that tells us to
+ truncate or blank-pad, particularly since the resulting implementation
+ would probably be slower than otherwise. */
+
+ while (ffebld_op (source) == FFEBLD_opCONVERT)
+ source = ffebld_left (source);
+
+ catlist = ffecom_concat_list_new_ (source, dest_size);
+ switch (ffecom_concat_list_count_ (catlist))
+ {
+ case 0: /* Shouldn't happen, but in case it does... */
+ ffecom_concat_list_kill_ (catlist);
+ source_tree = null_pointer_node;
+ source_length = ffecom_f2c_ftnlen_zero_node;
+ expr_tree = build_tree_list (NULL_TREE, dest_tree);
+ TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree);
+ TREE_CHAIN (TREE_CHAIN (expr_tree))
+ = build_tree_list (NULL_TREE, dest_length);
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
+ = build_tree_list (NULL_TREE, source_length);
+
+ expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree);
+ TREE_SIDE_EFFECTS (expr_tree) = 1;
+
+ expand_expr_stmt (expr_tree);
+
+ return;
+
+ case 1: /* The (fairly) easy case. */
+ ffecom_char_args_ (&source_tree, &source_length,
+ ffecom_concat_list_expr_ (catlist, 0));
+ ffecom_concat_list_kill_ (catlist);
+ assert (source_tree != NULL_TREE);
+ assert (source_length != NULL_TREE);
+
+ if ((source_tree == error_mark_node)
+ || (source_length == error_mark_node))
+ return;
+
+ if (dest_size == 1)
+ {
+ dest_tree
+ = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
+ (dest_tree))),
+ dest_tree);
+ dest_tree
+ = ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
+ (dest_tree))),
+ dest_tree,
+ integer_one_node);
+ source_tree
+ = ffecom_1 (INDIRECT_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
+ (source_tree))),
+ source_tree);
+ source_tree
+ = ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
+ (source_tree))),
+ source_tree,
+ integer_one_node);
+
+ expr_tree = ffecom_modify (void_type_node, dest_tree, source_tree);
+
+ expand_expr_stmt (expr_tree);
+
+ return;
+ }
+
+ expr_tree = build_tree_list (NULL_TREE, dest_tree);
+ TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree);
+ TREE_CHAIN (TREE_CHAIN (expr_tree))
+ = build_tree_list (NULL_TREE, dest_length);
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
+ = build_tree_list (NULL_TREE, source_length);
+
+ expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree);
+ TREE_SIDE_EFFECTS (expr_tree) = 1;
+
+ expand_expr_stmt (expr_tree);
+
+ return;
+
+ default: /* Must actually concatenate things. */
+ break;
+ }
+
+ /* Heavy-duty concatenation. */
+
+ {
+ int count = ffecom_concat_list_count_ (catlist);
+ int i;
+ tree lengths;
+ tree items;
+ tree length_array;
+ tree item_array;
+ tree citem;
+ tree clength;
+
+ length_array
+ = lengths
+ = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node,
+ FFETARGET_charactersizeNONE, count, TRUE);
+ item_array = items = ffecom_push_tempvar (ffecom_f2c_address_type_node,
+ FFETARGET_charactersizeNONE,
+ count, TRUE);
+
+ for (i = 0; i < count; ++i)
+ {
+ ffecom_char_args_ (&citem, &clength,
+ ffecom_concat_list_expr_ (catlist, i));
+ if ((citem == error_mark_node)
+ || (clength == error_mark_node))
+ {
+ ffecom_concat_list_kill_ (catlist);
+ return;
+ }
+
+ items
+ = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items),
+ ffecom_modify (void_type_node,
+ ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))),
+ item_array,
+ build_int_2 (i, 0)),
+ citem),
+ items);
+ lengths
+ = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths),
+ ffecom_modify (void_type_node,
+ ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))),
+ length_array,
+ build_int_2 (i, 0)),
+ clength),
+ lengths);
+ }
+
+ expr_tree = build_tree_list (NULL_TREE, dest_tree);
+ TREE_CHAIN (expr_tree)
+ = build_tree_list (NULL_TREE,
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (items)),
+ items));
+ TREE_CHAIN (TREE_CHAIN (expr_tree))
+ = build_tree_list (NULL_TREE,
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (lengths)),
+ lengths));
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
+ = build_tree_list
+ (NULL_TREE,
+ ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+ convert (ffecom_f2c_ftnlen_type_node,
+ build_int_2 (count, 0))));
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))))
+ = build_tree_list (NULL_TREE, dest_length);
+
+ expr_tree = ffecom_call_gfrt (FFECOM_gfrtCAT, expr_tree);
+ TREE_SIDE_EFFECTS (expr_tree) = 1;
+
+ expand_expr_stmt (expr_tree);
+ }
+
+ ffecom_concat_list_kill_ (catlist);
+}
+
+#endif
+/* ffecom_make_gfrt_ -- Make initial info for run-time routine
+
+ ffecomGfrt ix;
+ ffecom_make_gfrt_(ix);
+
+ Assumes gfrt_[ix] is NULL_TREE, and replaces it with the FUNCTION_DECL
+ for the indicated run-time routine (ix). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_make_gfrt_ (ffecomGfrt ix)
+{
+ tree t;
+ tree ttype;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ switch (ffecom_gfrt_type_[ix])
+ {
+ case FFECOM_rttypeVOID_:
+ ttype = void_type_node;
+ break;
+
+ case FFECOM_rttypeINT_:
+ ttype = integer_type_node;
+ break;
+
+ case FFECOM_rttypeINTEGER_:
+ ttype = ffecom_f2c_integer_type_node;
+ break;
+
+ case FFECOM_rttypeLONGINT_:
+ ttype = ffecom_f2c_longint_type_node;
+ break;
+
+ case FFECOM_rttypeLOGICAL_:
+ ttype = ffecom_f2c_logical_type_node;
+ break;
+
+ case FFECOM_rttypeREAL_F2C_:
+ ttype = ffecom_f2c_real_type_node;
+ break;
+
+ case FFECOM_rttypeREAL_GNU_:
+ ttype = ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1];
+ break;
+
+ case FFECOM_rttypeCOMPLEX_F2C_:
+ ttype = void_type_node;
+ break;
+
+ case FFECOM_rttypeCOMPLEX_GNU_:
+ ttype = ffecom_f2c_complex_type_node;
+ break;
+
+ case FFECOM_rttypeDOUBLE_:
+ ttype = double_type_node;
+ break;
+
+ case FFECOM_rttypeDBLCMPLX_F2C_:
+ ttype = void_type_node;
+ break;
+
+ case FFECOM_rttypeDBLCMPLX_GNU_:
+ ttype = ffecom_f2c_doublecomplex_type_node;
+ break;
+
+ case FFECOM_rttypeCHARACTER_:
+ ttype = void_type_node;
+ break;
+
+ default:
+ ttype = NULL;
+ assert ("bad rttype" == NULL);
+ break;
+ }
+
+ ttype = build_function_type (ttype, NULL_TREE);
+ t = build_decl (FUNCTION_DECL,
+ get_identifier (ffecom_gfrt_name_[ix]),
+ ttype);
+ DECL_EXTERNAL (t) = 1;
+ TREE_PUBLIC (t) = 1;
+ TREE_THIS_VOLATILE (t) = ffecom_gfrt_volatile_[ix] ? 1 : 0;
+
+ t = start_decl (t, TRUE);
+
+ finish_decl (t, NULL_TREE, TRUE);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ ffecom_gfrt_[ix] = t;
+}
+
+#endif
+/* Phase 1 pass over each member of a COMMON/EQUIVALENCE group. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st)
+{
+ ffesymbol s = ffestorag_symbol (st);
+
+ if (ffesymbol_namelisted (s))
+ ffecom_member_namelisted_ = TRUE;
+}
+
+#endif
+/* Phase 2 pass over each member of a COMMON/EQUIVALENCE group. Declare
+ the member so debugger will see it. Otherwise nobody should be
+ referencing the member. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING
+static void
+ffecom_member_phase2_ (ffestorag mst, ffestorag st)
+{
+ ffesymbol s;
+ tree t;
+ tree mt;
+ tree type;
+
+ if ((mst == NULL)
+ || ((mt = ffestorag_hook (mst)) == NULL)
+ || (mt == error_mark_node))
+ return;
+
+ if ((st == NULL)
+ || ((s = ffestorag_symbol (st)) == NULL))
+ return;
+
+ type = ffecom_type_localvar_ (s,
+ ffesymbol_basictype (s),
+ ffesymbol_kindtype (s));
+ if (type == error_mark_node)
+ return;
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_identifier_ (ffesymbol_text (s)),
+ type);
+
+ TREE_STATIC (t) = TREE_STATIC (mt);
+ DECL_INITIAL (t) = NULL_TREE;
+ TREE_ASM_WRITTEN (t) = 1;
+
+ DECL_RTL (t)
+ = gen_rtx (MEM, TYPE_MODE (type),
+ plus_constant (XEXP (DECL_RTL (mt), 0),
+ ffestorag_modulo (mst)
+ + ffestorag_offset (st)
+ - ffestorag_offset (mst)));
+
+ t = start_decl (t, FALSE);
+
+ finish_decl (t, NULL_TREE, FALSE);
+}
+
+#endif
+#endif
+/* ffecom_push_dummy_decls_ -- Transform dummy args, push parm decls in order
+
+ Ignores STAR (alternate-return) dummies. All other get exec-transitioned
+ (which generates their trees) and then their trees get push_parm_decl'd.
+
+ The second arg is TRUE if the dummies are for a statement function, in
+ which case lengths are not pushed for character arguments (since they are
+ always known by both the caller and the callee, though the code allows
+ for someday permitting CHAR*(*) stmtfunc dummies). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc)
+{
+ ffebld dummy;
+ ffebld dumlist;
+ ffesymbol s;
+ tree parm;
+
+ ffecom_transform_only_dummies_ = TRUE;
+
+ /* First push the parms corresponding to actual dummy "contents". */
+
+ for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist))
+ {
+ dummy = ffebld_head (dumlist);
+ switch (ffebld_op (dummy))
+ {
+ case FFEBLD_opSTAR:
+ case FFEBLD_opANY:
+ continue; /* Forget alternate returns. */
+
+ default:
+ break;
+ }
+ assert (ffebld_op (dummy) == FFEBLD_opSYMTER);
+ s = ffebld_symter (dummy);
+ parm = ffesymbol_hook (s).decl_tree;
+ if (parm == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ parm = ffesymbol_hook (s).decl_tree;
+ assert (parm != NULL_TREE);
+ }
+ if (parm != error_mark_node)
+ push_parm_decl (parm);
+ }
+
+ /* Then, for CHARACTER dummies, push the parms giving their lengths. */
+
+ for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist))
+ {
+ dummy = ffebld_head (dumlist);
+ switch (ffebld_op (dummy))
+ {
+ case FFEBLD_opSTAR:
+ case FFEBLD_opANY:
+ continue; /* Forget alternate returns, they mean
+ NOTHING! */
+
+ default:
+ break;
+ }
+ s = ffebld_symter (dummy);
+ if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER)
+ continue; /* Only looking for CHARACTER arguments. */
+ if (stmtfunc && (ffesymbol_size (s) != FFETARGET_charactersizeNONE))
+ continue; /* Stmtfunc arg with known size needs no
+ length param. */
+ if (ffesymbol_kind (s) != FFEINFO_kindENTITY)
+ continue; /* Only looking for variables and arrays. */
+ parm = ffesymbol_hook (s).length_tree;
+ assert (parm != NULL_TREE);
+ if (parm != error_mark_node)
+ push_parm_decl (parm);
+ }
+
+ ffecom_transform_only_dummies_ = FALSE;
+}
+
+#endif
+/* ffecom_start_progunit_ -- Beginning of program unit
+
+ Does GNU back end stuff necessary to teach it about the start of its
+ equivalent of a Fortran program unit. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_start_progunit_ ()
+{
+ ffesymbol fn = ffecom_primary_entry_;
+ ffebld arglist;
+ tree id; /* Identifier (name) of function. */
+ tree type; /* Type of function. */
+ tree result; /* Result of function. */
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffeglobal g;
+ ffeglobalType gt;
+ ffeglobalType egt = FFEGLOBAL_type;
+ bool charfunc;
+ bool cmplxfunc;
+ bool altentries = (ffecom_num_entrypoints_ != 0);
+ bool multi
+ = altentries
+ && (ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION)
+ && (ffecom_master_bt_ == FFEINFO_basictypeNONE);
+ bool main_program = FALSE;
+ int old_lineno = lineno;
+ char *old_input_filename = input_filename;
+ int yes;
+
+ assert (fn != NULL);
+ assert (ffesymbol_hook (fn).decl_tree == NULL_TREE);
+
+ input_filename = ffesymbol_where_filename (fn);
+ lineno = ffesymbol_where_filelinenum (fn);
+
+ /* c-parse.y indeed does call suspend_momentary and not only ignores the
+ return value, but also never calls resume_momentary, when starting an
+ outer function (see "fndef:", "setspecs:", and so on). So g77 does the
+ same thing. It shouldn't be a problem since start_function calls
+ temporary_allocation, but it might be necessary. If it causes a problem
+ here, then maybe there's a bug lurking in gcc. NOTE: This identical
+ comment appears twice in thist file. */
+
+ suspend_momentary ();
+
+ switch (ffecom_primary_entry_kind_)
+ {
+ case FFEINFO_kindPROGRAM:
+ main_program = TRUE;
+ gt = FFEGLOBAL_typeMAIN;
+ bt = FFEINFO_basictypeNONE;
+ kt = FFEINFO_kindtypeNONE;
+ type = ffecom_tree_fun_type_void;
+ charfunc = FALSE;
+ cmplxfunc = FALSE;
+ break;
+
+ case FFEINFO_kindBLOCKDATA:
+ gt = FFEGLOBAL_typeBDATA;
+ bt = FFEINFO_basictypeNONE;
+ kt = FFEINFO_kindtypeNONE;
+ type = ffecom_tree_fun_type_void;
+ charfunc = FALSE;
+ cmplxfunc = FALSE;
+ break;
+
+ case FFEINFO_kindFUNCTION:
+ gt = FFEGLOBAL_typeFUNC;
+ egt = FFEGLOBAL_typeEXT;
+ bt = ffesymbol_basictype (fn);
+ kt = ffesymbol_kindtype (fn);
+ if (bt == FFEINFO_basictypeNONE)
+ {
+ ffeimplic_establish_symbol (fn);
+ if (ffesymbol_funcresult (fn) != NULL)
+ ffeimplic_establish_symbol (ffesymbol_funcresult (fn));
+ bt = ffesymbol_basictype (fn);
+ kt = ffesymbol_kindtype (fn);
+ }
+
+ if (multi)
+ charfunc = cmplxfunc = FALSE;
+ else if (bt == FFEINFO_basictypeCHARACTER)
+ charfunc = TRUE, cmplxfunc = FALSE;
+ else if ((bt == FFEINFO_basictypeCOMPLEX)
+ && ffesymbol_is_f2c (fn)
+ && !altentries)
+ charfunc = FALSE, cmplxfunc = TRUE;
+ else
+ charfunc = cmplxfunc = FALSE;
+
+ if (multi || charfunc)
+ type = ffecom_tree_fun_type_void;
+ else if (ffesymbol_is_f2c (fn) && !altentries)
+ type = ffecom_tree_fun_type[bt][kt];
+ else
+ type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
+
+ if ((type == NULL_TREE)
+ || (TREE_TYPE (type) == NULL_TREE))
+ type = ffecom_tree_fun_type_void; /* _sym_exec_transition. */
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ gt = FFEGLOBAL_typeSUBR;
+ egt = FFEGLOBAL_typeEXT;
+ bt = FFEINFO_basictypeNONE;
+ kt = FFEINFO_kindtypeNONE;
+ if (ffecom_is_altreturning_)
+ type = ffecom_tree_subr_type;
+ else
+ type = ffecom_tree_fun_type_void;
+ charfunc = FALSE;
+ cmplxfunc = FALSE;
+ break;
+
+ default:
+ assert ("say what??" == NULL);
+ /* Fall through. */
+ case FFEINFO_kindANY:
+ gt = FFEGLOBAL_typeANY;
+ bt = FFEINFO_basictypeNONE;
+ kt = FFEINFO_kindtypeNONE;
+ type = error_mark_node;
+ charfunc = FALSE;
+ cmplxfunc = FALSE;
+ break;
+ }
+
+ if (altentries)
+ id = ffecom_get_invented_identifier ("__g77_masterfun_%s",
+ ffesymbol_text (fn),
+ 0);
+#if FFETARGET_isENFORCED_MAIN
+ else if (main_program)
+ id = get_identifier (FFETARGET_nameENFORCED_MAIN_NAME);
+#endif
+ else
+ id = ffecom_get_external_identifier_ (fn);
+
+ start_function (id,
+ type,
+ 0, /* nested/inline */
+ !altentries); /* TREE_PUBLIC */
+
+ if (!altentries
+ && ((g = ffesymbol_global (fn)) != NULL)
+ && ((ffeglobal_type (g) == gt)
+ || (ffeglobal_type (g) == egt)))
+ {
+ ffeglobal_set_hook (g, current_function_decl);
+ }
+
+ yes = suspend_momentary ();
+
+ /* Arg handling needs exec-transitioned ffesymbols to work with. But
+ exec-transitioning needs current_function_decl to be filled in. So we
+ do these things in two phases. */
+
+ if (altentries)
+ { /* 1st arg identifies which entrypoint. */
+ ffecom_which_entrypoint_decl_
+ = build_decl (PARM_DECL,
+ ffecom_get_invented_identifier ("__g77_%s",
+ "which_entrypoint",
+ 0),
+ integer_type_node);
+ push_parm_decl (ffecom_which_entrypoint_decl_);
+ }
+
+ if (charfunc
+ || cmplxfunc
+ || multi)
+ { /* Arg for result (return value). */
+ tree type;
+ tree length;
+
+ if (charfunc)
+ type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
+ else if (cmplxfunc)
+ type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];
+ else
+ type = ffecom_multi_type_node_;
+
+ result = ffecom_get_invented_identifier ("__g77_%s",
+ "result", 0);
+
+ /* Make length arg _and_ enhance type info for CHAR arg itself. */
+
+ if (charfunc)
+ length = ffecom_char_enhance_arg_ (&type, fn);
+ else
+ length = NULL_TREE; /* Not ref'd if !charfunc. */
+
+ type = build_pointer_type (type);
+ result = build_decl (PARM_DECL, result, type);
+
+ push_parm_decl (result);
+ if (multi)
+ ffecom_multi_retval_ = result;
+ else
+ ffecom_func_result_ = result;
+
+ if (charfunc)
+ {
+ push_parm_decl (length);
+ ffecom_func_length_ = length;
+ }
+ }
+
+ if (ffecom_primary_entry_is_proc_)
+ {
+ if (altentries)
+ arglist = ffecom_master_arglist_;
+ else
+ arglist = ffesymbol_dummyargs (fn);
+ ffecom_push_dummy_decls_ (arglist, FALSE);
+ }
+
+ resume_momentary (yes);
+
+ store_parm_decls (main_program ? 1 : 0);
+
+ ffecom_start_compstmt_ ();
+
+ lineno = old_lineno;
+ input_filename = old_input_filename;
+
+ /* This handles any symbols still untransformed, in case -g specified.
+ This used to be done in ffecom_finish_progunit, but it turns out to
+ be necessary to do it here so that statement functions are
+ expanded before code. But don't bother for BLOCK DATA. */
+
+ if (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA)
+ ffesymbol_drive (ffecom_finish_symbol_transform_);
+}
+
+#endif
+/* ffecom_sym_transform_ -- Transform FFE sym into backend sym
+
+ ffesymbol s;
+ ffecom_sym_transform_(s);
+
+ The ffesymbol_hook info for s is updated with appropriate backend info
+ on the symbol. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffesymbol
+ffecom_sym_transform_ (ffesymbol s)
+{
+ tree t; /* Transformed thingy. */
+ tree tlen; /* Length if CHAR*(*). */
+ bool addr; /* Is t the address of the thingy? */
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffeglobal g;
+ int yes;
+ int old_lineno = lineno;
+ char *old_input_filename = input_filename;
+
+ if (ffesymbol_sfdummyparent (s) == NULL)
+ {
+ input_filename = ffesymbol_where_filename (s);
+ lineno = ffesymbol_where_filelinenum (s);
+ }
+ else
+ {
+ ffesymbol sf = ffesymbol_sfdummyparent (s);
+
+ input_filename = ffesymbol_where_filename (sf);
+ lineno = ffesymbol_where_filelinenum (sf);
+ }
+
+ bt = ffeinfo_basictype (ffebld_info (s));
+ kt = ffeinfo_kindtype (ffebld_info (s));
+
+ t = NULL_TREE;
+ tlen = NULL_TREE;
+ addr = FALSE;
+
+ switch (ffesymbol_kind (s))
+ {
+ case FFEINFO_kindNONE:
+ switch (ffesymbol_where (s))
+ {
+ case FFEINFO_whereDUMMY: /* Subroutine or function. */
+ assert (ffecom_transform_only_dummies_);
+
+ /* Before 0.4, this could be ENTITY/DUMMY, but see
+ ffestu_sym_end_transition -- no longer true (in particular, if
+ it could be an ENTITY, it _will_ be made one, so that
+ possibility won't come through here). So we never make length
+ arg for CHARACTER type. */
+
+ t = build_decl (PARM_DECL,
+ ffecom_get_identifier_ (ffesymbol_text (s)),
+ ffecom_tree_ptr_to_subr_type);
+#if BUILT_FOR_270
+ DECL_ARTIFICIAL (t) = 1;
+#endif
+ addr = TRUE;
+ break;
+
+ case FFEINFO_whereGLOBAL: /* Subroutine or function. */
+ assert (!ffecom_transform_only_dummies_);
+
+ if (((g = ffesymbol_global (s)) != NULL)
+ && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
+ && (ffeglobal_hook (g) != NULL_TREE)
+ && ffe_is_globals ())
+ {
+ t = ffeglobal_hook (g);
+ break;
+ }
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ t = build_decl (FUNCTION_DECL,
+ ffecom_get_external_identifier_ (s),
+ ffecom_tree_subr_type); /* Assume subr. */
+ DECL_EXTERNAL (t) = 1;
+ TREE_PUBLIC (t) = 1;
+
+ t = start_decl (t, FALSE);
+ finish_decl (t, NULL_TREE, FALSE);
+
+ if ((g != NULL)
+ && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+ ffeglobal_set_hook (g, t);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ break;
+
+ default:
+ assert ("NONE where unexpected" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ break;
+ }
+ break;
+
+ case FFEINFO_kindENTITY:
+ switch (ffeinfo_where (ffesymbol_info (s)))
+ {
+
+ case FFEINFO_whereCONSTANT: /* ~~debugging info needed? */
+ assert (!ffecom_transform_only_dummies_);
+ t = error_mark_node; /* Shouldn't ever see this in expr. */
+ break;
+
+ case FFEINFO_whereLOCAL:
+ assert (!ffecom_transform_only_dummies_);
+
+ {
+ ffestorag st = ffesymbol_storage (s);
+ tree type;
+
+ if ((st != NULL)
+ && (ffestorag_size (st) == 0))
+ {
+ t = error_mark_node;
+ break;
+ }
+
+ yes = suspend_momentary ();
+ type = ffecom_type_localvar_ (s, bt, kt);
+ resume_momentary (yes);
+
+ if (type == error_mark_node)
+ {
+ t = error_mark_node;
+ break;
+ }
+
+ if ((st != NULL)
+ && (ffestorag_parent (st) != NULL))
+ { /* Child of EQUIVALENCE parent. */
+ ffestorag est;
+ tree et;
+ int yes;
+ ffetargetOffset offset;
+
+ est = ffestorag_parent (st);
+ ffecom_transform_equiv_ (est);
+
+ et = ffestorag_hook (est);
+ assert (et != NULL_TREE);
+
+ if (! TREE_STATIC (et))
+ put_var_into_stack (et);
+
+ yes = suspend_momentary ();
+
+ offset = ffestorag_modulo (est)
+ + ffestorag_offset (ffesymbol_storage (s))
+ - ffestorag_offset (est);
+
+ ffecom_debug_kludge_ (et, "EQUIVALENCE", s, type, offset);
+
+ /* (t_type *) (((char *) &et) + offset) */
+
+ t = convert (string_type_node, /* (char *) */
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (et)),
+ et));
+ t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t),
+ t,
+ build_int_2 (offset, 0));
+ t = convert (build_pointer_type (type),
+ t);
+
+ addr = TRUE;
+
+ resume_momentary (yes);
+ }
+ else
+ {
+ tree initexpr;
+ bool init = ffesymbol_is_init (s);
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_identifier_ (ffesymbol_text (s)),
+ type);
+
+ if (init
+ || ffesymbol_namelisted (s)
+#ifdef FFECOM_sizeMAXSTACKITEM
+ || ((st != NULL)
+ && (ffestorag_size (st) > FFECOM_sizeMAXSTACKITEM))
+#endif
+ || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
+ && (ffecom_primary_entry_kind_
+ != FFEINFO_kindBLOCKDATA)
+ && (ffesymbol_is_save (s) || ffe_is_saveall ())))
+ TREE_STATIC (t) = !ffesymbol_attr (s, FFESYMBOL_attrADJUSTABLE);
+ else
+ TREE_STATIC (t) = 0; /* No need to make static. */
+
+ if (init || ffe_is_init_local_zero ())
+ DECL_INITIAL (t) = error_mark_node;
+
+ /* Keep -Wunused from complaining about var if it
+ is used as sfunc arg or DATA implied-DO. */
+ if (ffesymbol_attrs (s) & FFESYMBOL_attrsSFARG)
+ DECL_IN_SYSTEM_HEADER (t) = 1;
+
+ t = start_decl (t, FALSE);
+
+ if (init)
+ {
+ if (ffesymbol_init (s) != NULL)
+ initexpr = ffecom_expr (ffesymbol_init (s));
+ else
+ initexpr = ffecom_init_zero_ (t);
+ }
+ else if (ffe_is_init_local_zero ())
+ initexpr = ffecom_init_zero_ (t);
+ else
+ initexpr = NULL_TREE; /* Not ref'd if !init. */
+
+ finish_decl (t, initexpr, FALSE);
+
+ if ((st != NULL) && (DECL_SIZE (t) != error_mark_node))
+ {
+ tree size_tree;
+
+ size_tree = size_binop (CEIL_DIV_EXPR,
+ DECL_SIZE (t),
+ size_int (BITS_PER_UNIT));
+ assert (TREE_INT_CST_HIGH (size_tree) == 0);
+ assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (st));
+ }
+
+ resume_momentary (yes);
+ }
+ }
+ break;
+
+ case FFEINFO_whereRESULT:
+ assert (!ffecom_transform_only_dummies_);
+
+ if (bt == FFEINFO_basictypeCHARACTER)
+ { /* Result is already in list of dummies, use
+ it (& length). */
+ t = ffecom_func_result_;
+ tlen = ffecom_func_length_;
+ addr = TRUE;
+ break;
+ }
+ if ((ffecom_num_entrypoints_ == 0)
+ && (bt == FFEINFO_basictypeCOMPLEX)
+ && (ffesymbol_is_f2c (ffecom_primary_entry_)))
+ { /* Result is already in list of dummies, use
+ it. */
+ t = ffecom_func_result_;
+ addr = TRUE;
+ break;
+ }
+ if (ffecom_func_result_ != NULL_TREE)
+ {
+ t = ffecom_func_result_;
+ break;
+ }
+ if ((ffecom_num_entrypoints_ != 0)
+ && (ffecom_master_bt_ == FFEINFO_basictypeNONE))
+ {
+ yes = suspend_momentary ();
+
+ assert (ffecom_multi_retval_ != NULL_TREE);
+ t = ffecom_1 (INDIRECT_REF, ffecom_multi_type_node_,
+ ffecom_multi_retval_);
+ t = ffecom_2 (COMPONENT_REF, ffecom_tree_type[bt][kt],
+ t, ffecom_multi_fields_[bt][kt]);
+
+ resume_momentary (yes);
+ break;
+ }
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_identifier_ (ffesymbol_text (s)),
+ ffecom_tree_type[bt][kt]);
+ TREE_STATIC (t) = 0; /* Put result on stack. */
+ t = start_decl (t, FALSE);
+ finish_decl (t, NULL_TREE, FALSE);
+
+ ffecom_func_result_ = t;
+
+ resume_momentary (yes);
+ break;
+
+ case FFEINFO_whereDUMMY:
+ {
+ tree type;
+ ffebld dl;
+ ffebld dim;
+ tree low;
+ tree high;
+ tree old_sizes;
+ bool adjustable = FALSE; /* Conditionally adjustable? */
+
+ type = ffecom_tree_type[bt][kt];
+ if (ffesymbol_sfdummyparent (s) != NULL)
+ {
+ if (current_function_decl == ffecom_outer_function_decl_)
+ { /* Exec transition before sfunc
+ context; get it later. */
+ break;
+ }
+ t = ffecom_get_identifier_ (ffesymbol_text
+ (ffesymbol_sfdummyparent (s)));
+ }
+ else
+ t = ffecom_get_identifier_ (ffesymbol_text (s));
+
+ assert (ffecom_transform_only_dummies_);
+
+ old_sizes = get_pending_sizes ();
+ put_pending_sizes (old_sizes);
+
+ if (bt == FFEINFO_basictypeCHARACTER)
+ tlen = ffecom_char_enhance_arg_ (&type, s);
+ type = ffecom_check_size_overflow_ (s, type, TRUE);
+
+ for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl))
+ {
+ if (type == error_mark_node)
+ break;
+
+ dim = ffebld_head (dl);
+ assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
+ if ((ffebld_left (dim) == NULL) || ffecom_doing_entry_)
+ low = ffecom_integer_one_node;
+ else
+ low = ffecom_expr (ffebld_left (dim));
+ assert (ffebld_right (dim) != NULL);
+ if ((ffebld_op (ffebld_right (dim)) == FFEBLD_opSTAR)
+ || ffecom_doing_entry_)
+ /* Used to just do high=low. But for ffecom_tree_
+ canonize_ref_, it probably is important to correctly
+ assess the size. E.g. given COMPLEX C(*),CFUNC and
+ C(2)=CFUNC(C), overlap can happen, while it can't
+ for, say, C(1)=CFUNC(C(2)). */
+ high = convert (TREE_TYPE (low),
+ TYPE_MAX_VALUE (TREE_TYPE (low)));
+ else
+ high = ffecom_expr (ffebld_right (dim));
+
+ /* Determine whether array is conditionally adjustable,
+ to decide whether back-end magic is needed.
+
+ Normally the front end uses the back-end function
+ variable_size to wrap SAVE_EXPR's around expressions
+ affecting the size/shape of an array so that the
+ size/shape info doesn't change during execution
+ of the compiled code even though variables and
+ functions referenced in those expressions might.
+
+ variable_size also makes sure those saved expressions
+ get evaluated immediately upon entry to the
+ compiled procedure -- the front end normally doesn't
+ have to worry about that.
+
+ However, there is a problem with this that affects
+ g77's implementation of entry points, and that is
+ that it is _not_ true that each invocation of the
+ compiled procedure is permitted to evaluate
+ array size/shape info -- because it is possible
+ that, for some invocations, that info is invalid (in
+ which case it is "promised" -- i.e. a violation of
+ the Fortran standard -- that the compiled code
+ won't reference the array or its size/shape
+ during that particular invocation).
+
+ To phrase this in C terms, consider this gcc function:
+
+ void foo (int *n, float (*a)[*n])
+ {
+ // a is "pointer to array ...", fyi.
+ }
+
+ Suppose that, for some invocations, it is permitted
+ for a caller of foo to do this:
+
+ foo (NULL, NULL);
+
+ Now the _written_ code for foo can take such a call
+ into account by either testing explicitly for whether
+ (a == NULL) || (n == NULL) -- presumably it is
+ not permitted to reference *a in various fashions
+ if (n == NULL) I suppose -- or it can avoid it by
+ looking at other info (other arguments, static/global
+ data, etc.).
+
+ However, this won't work in gcc 2.5.8 because it'll
+ automatically emit the code to save the "*n"
+ expression, which'll yield a NULL dereference for
+ the "foo (NULL, NULL)" call, something the code
+ for foo cannot prevent.
+
+ g77 definitely needs to avoid executing such
+ code anytime the pointer to the adjustable array
+ is NULL, because even if its bounds expressions
+ don't have any references to possible "absent"
+ variables like "*n" -- say all variable references
+ are to COMMON variables, i.e. global (though in C,
+ local static could actually make sense) -- the
+ expressions could yield other run-time problems
+ for allowably "dead" values in those variables.
+
+ For example, let's consider a more complicated
+ version of foo:
+
+ extern int i;
+ extern int j;
+
+ void foo (float (*a)[i/j])
+ {
+ ...
+ }
+
+ The above is (essentially) quite valid for Fortran
+ but, again, for a call like "foo (NULL);", it is
+ permitted for i and j to be undefined when the
+ call is made. If j happened to be zero, for
+ example, emitting the code to evaluate "i/j"
+ could result in a run-time error.
+
+ Offhand, though I don't have my F77 or F90
+ standards handy, it might even be valid for a
+ bounds expression to contain a function reference,
+ in which case I doubt it is permitted for an
+ implementation to invoke that function in the
+ Fortran case involved here (invocation of an
+ alternate ENTRY point that doesn't have the adjustable
+ array as one of its arguments).
+
+ So, the code that the compiler would normally emit
+ to preevaluate the size/shape info for an
+ adjustable array _must not_ be executed at run time
+ in certain cases. Specifically, for Fortran,
+ the case is when the pointer to the adjustable
+ array == NULL. (For gnu-ish C, it might be nice
+ for the source code itself to specify an expression
+ that, if TRUE, inhibits execution of the code. Or
+ reverse the sense for elegance.)
+
+ (Note that g77 could use a different test than NULL,
+ actually, since it happens to always pass an
+ integer to the called function that specifies which
+ entry point is being invoked. Hmm, this might
+ solve the next problem.)
+
+ One way a user could, I suppose, write "foo" so
+ it works is to insert COND_EXPR's for the
+ size/shape info so the dangerous stuff isn't
+ actually done, as in:
+
+ void foo (int *n, float (*a)[(a == NULL) ? 0 : *n])
+ {
+ ...
+ }
+
+ The next problem is that the front end needs to
+ be able to tell the back end about the array's
+ decl _before_ it tells it about the conditional
+ expression to inhibit evaluation of size/shape info,
+ as shown above.
+
+ To solve this, the front end needs to be able
+ to give the back end the expression to inhibit
+ generation of the preevaluation code _after_
+ it makes the decl for the adjustable array.
+
+ Until then, the above example using the COND_EXPR
+ doesn't pass muster with gcc because the "(a == NULL)"
+ part has a reference to "a", which is still
+ undefined at that point.
+
+ g77 will therefore use a different mechanism in the
+ meantime. */
+
+ if (!adjustable
+ && ((TREE_CODE (low) != INTEGER_CST)
+ || (TREE_CODE (high) != INTEGER_CST)))
+ adjustable = TRUE;
+
+#if 0 /* Old approach -- see below. */
+ if (TREE_CODE (low) != INTEGER_CST)
+ low = ffecom_3 (COND_EXPR, integer_type_node,
+ ffecom_adjarray_passed_ (s),
+ low,
+ ffecom_integer_zero_node);
+
+ if (TREE_CODE (high) != INTEGER_CST)
+ high = ffecom_3 (COND_EXPR, integer_type_node,
+ ffecom_adjarray_passed_ (s),
+ high,
+ ffecom_integer_zero_node);
+#endif
+
+ /* ~~~gcc/stor-layout.c/layout_type should do this,
+ probably. Fixes 950302-1.f. */
+
+ if (TREE_CODE (low) != INTEGER_CST)
+ low = variable_size (low);
+
+ /* ~~~similarly, this fixes dumb0.f. The C front end
+ does this, which is why dumb0.c would work. */
+
+ if (TREE_CODE (high) != INTEGER_CST)
+ high = variable_size (high);
+
+ type
+ = build_array_type
+ (type,
+ build_range_type (ffecom_integer_type_node,
+ low, high));
+ type = ffecom_check_size_overflow_ (s, type, TRUE);
+ }
+
+ if (type == error_mark_node)
+ {
+ t = error_mark_node;
+ break;
+ }
+
+ if ((ffesymbol_sfdummyparent (s) == NULL)
+ || (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER))
+ {
+ type = build_pointer_type (type);
+ addr = TRUE;
+ }
+
+ t = build_decl (PARM_DECL, t, type);
+#if BUILT_FOR_270
+ DECL_ARTIFICIAL (t) = 1;
+#endif
+
+ /* If this arg is present in every entry point's list of
+ dummy args, then we're done. */
+
+ if (ffesymbol_numentries (s)
+ == (ffecom_num_entrypoints_ + 1))
+ break;
+
+#if 1
+
+ /* If variable_size in stor-layout has been called during
+ the above, then get_pending_sizes should have the
+ yet-to-be-evaluated saved expressions pending.
+ Make the whole lot of them get emitted, conditionally
+ on whether the array decl ("t" above) is not NULL. */
+
+ {
+ tree sizes = get_pending_sizes ();
+ tree tem;
+
+ for (tem = sizes;
+ tem != old_sizes;
+ tem = TREE_CHAIN (tem))
+ {
+ tree temv = TREE_VALUE (tem);
+
+ if (sizes == tem)
+ sizes = temv;
+ else
+ sizes
+ = ffecom_2 (COMPOUND_EXPR,
+ TREE_TYPE (sizes),
+ temv,
+ sizes);
+ }
+
+ if (sizes != tem)
+ {
+ sizes
+ = ffecom_3 (COND_EXPR,
+ TREE_TYPE (sizes),
+ ffecom_2 (NE_EXPR,
+ integer_type_node,
+ t,
+ null_pointer_node),
+ sizes,
+ convert (TREE_TYPE (sizes),
+ integer_zero_node));
+ sizes = ffecom_save_tree (sizes);
+
+ sizes
+ = tree_cons (NULL_TREE, sizes, tem);
+ }
+
+ if (sizes)
+ put_pending_sizes (sizes);
+ }
+
+#else
+#if 0
+ if (adjustable
+ && (ffesymbol_numentries (s)
+ != ffecom_num_entrypoints_ + 1))
+ DECL_SOMETHING (t)
+ = ffecom_2 (NE_EXPR, integer_type_node,
+ t,
+ null_pointer_node);
+#else
+#if 0
+ if (adjustable
+ && (ffesymbol_numentries (s)
+ != ffecom_num_entrypoints_ + 1))
+ {
+ ffebad_start (FFEBAD_MISSING_ADJARRAY_UNSUPPORTED);
+ ffebad_here (0, ffesymbol_where_line (s),
+ ffesymbol_where_column (s));
+ ffebad_string (ffesymbol_text (s));
+ ffebad_finish ();
+ }
+#endif
+#endif
+#endif
+ }
+ break;
+
+ case FFEINFO_whereCOMMON:
+ {
+ ffesymbol cs;
+ ffeglobal cg;
+ tree ct;
+ ffestorag st = ffesymbol_storage (s);
+ tree type;
+ int yes;
+
+ cs = ffesymbol_common (s); /* The COMMON area itself. */
+ if (st != NULL) /* Else not laid out. */
+ {
+ ffecom_transform_common_ (cs);
+ st = ffesymbol_storage (s);
+ }
+
+ yes = suspend_momentary ();
+
+ type = ffecom_type_localvar_ (s, bt, kt);
+
+ cg = ffesymbol_global (cs); /* The global COMMON info. */
+ if ((cg == NULL)
+ || (ffeglobal_type (cg) != FFEGLOBAL_typeCOMMON))
+ ct = NULL_TREE;
+ else
+ ct = ffeglobal_hook (cg); /* The common area's tree. */
+
+ if ((ct == NULL_TREE)
+ || (st == NULL)
+ || (type == error_mark_node))
+ t = error_mark_node;
+ else
+ {
+ ffetargetOffset offset;
+ ffestorag cst;
+
+ cst = ffestorag_parent (st);
+ assert (cst == ffesymbol_storage (cs));
+
+ offset = ffestorag_modulo (cst)
+ + ffestorag_offset (st)
+ - ffestorag_offset (cst);
+
+ ffecom_debug_kludge_ (ct, "COMMON", s, type, offset);
+
+ /* (t_type *) (((char *) &ct) + offset) */
+
+ t = convert (string_type_node, /* (char *) */
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (ct)),
+ ct));
+ t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t),
+ t,
+ build_int_2 (offset, 0));
+ t = convert (build_pointer_type (type),
+ t);
+
+ addr = TRUE;
+ }
+
+ resume_momentary (yes);
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ case FFEINFO_whereGLOBAL:
+ case FFEINFO_whereFLEETING:
+ case FFEINFO_whereFLEETING_CADDR:
+ case FFEINFO_whereFLEETING_IADDR:
+ case FFEINFO_whereINTRINSIC:
+ case FFEINFO_whereCONSTANT_SUBOBJECT:
+ default:
+ assert ("ENTITY where unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ t = error_mark_node;
+ break;
+ }
+ break;
+
+ case FFEINFO_kindFUNCTION:
+ switch (ffeinfo_where (ffesymbol_info (s)))
+ {
+ case FFEINFO_whereLOCAL: /* Me. */
+ assert (!ffecom_transform_only_dummies_);
+ t = current_function_decl;
+ break;
+
+ case FFEINFO_whereGLOBAL:
+ assert (!ffecom_transform_only_dummies_);
+
+ if (((g = ffesymbol_global (s)) != NULL)
+ && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
+ && (ffeglobal_hook (g) != NULL_TREE)
+ && ffe_is_globals ())
+ {
+ t = ffeglobal_hook (g);
+ break;
+ }
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ if (ffesymbol_is_f2c (s)
+ && (ffesymbol_where (s) != FFEINFO_whereCONSTANT))
+ t = ffecom_tree_fun_type[bt][kt];
+ else
+ t = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
+
+ t = build_decl (FUNCTION_DECL,
+ ffecom_get_external_identifier_ (s),
+ t);
+ DECL_EXTERNAL (t) = 1;
+ TREE_PUBLIC (t) = 1;
+
+ t = start_decl (t, FALSE);
+ finish_decl (t, NULL_TREE, FALSE);
+
+ if ((g != NULL)
+ && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+ ffeglobal_set_hook (g, t);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ break;
+
+ case FFEINFO_whereDUMMY:
+ assert (ffecom_transform_only_dummies_);
+
+ if (ffesymbol_is_f2c (s)
+ && (ffesymbol_where (s) != FFEINFO_whereCONSTANT))
+ t = ffecom_tree_ptr_to_fun_type[bt][kt];
+ else
+ t = build_pointer_type
+ (build_function_type (ffecom_tree_type[bt][kt], NULL_TREE));
+
+ t = build_decl (PARM_DECL,
+ ffecom_get_identifier_ (ffesymbol_text (s)),
+ t);
+#if BUILT_FOR_270
+ DECL_ARTIFICIAL (t) = 1;
+#endif
+ addr = TRUE;
+ break;
+
+ case FFEINFO_whereCONSTANT: /* Statement function. */
+ assert (!ffecom_transform_only_dummies_);
+ t = ffecom_gen_sfuncdef_ (s, bt, kt);
+ break;
+
+ case FFEINFO_whereINTRINSIC:
+ assert (!ffecom_transform_only_dummies_);
+ break; /* Let actual references generate their
+ decls. */
+
+ default:
+ assert ("FUNCTION where unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ t = error_mark_node;
+ break;
+ }
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ switch (ffeinfo_where (ffesymbol_info (s)))
+ {
+ case FFEINFO_whereLOCAL: /* Me. */
+ assert (!ffecom_transform_only_dummies_);
+ t = current_function_decl;
+ break;
+
+ case FFEINFO_whereGLOBAL:
+ assert (!ffecom_transform_only_dummies_);
+
+ if (((g = ffesymbol_global (s)) != NULL)
+ && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
+ && (ffeglobal_hook (g) != NULL_TREE)
+ && ffe_is_globals ())
+ {
+ t = ffeglobal_hook (g);
+ break;
+ }
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ t = build_decl (FUNCTION_DECL,
+ ffecom_get_external_identifier_ (s),
+ ffecom_tree_subr_type);
+ DECL_EXTERNAL (t) = 1;
+ TREE_PUBLIC (t) = 1;
+
+ t = start_decl (t, FALSE);
+ finish_decl (t, NULL_TREE, FALSE);
+
+ if ((g != NULL)
+ && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+ || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+ ffeglobal_set_hook (g, t);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ break;
+
+ case FFEINFO_whereDUMMY:
+ assert (ffecom_transform_only_dummies_);
+
+ t = build_decl (PARM_DECL,
+ ffecom_get_identifier_ (ffesymbol_text (s)),
+ ffecom_tree_ptr_to_subr_type);
+#if BUILT_FOR_270
+ DECL_ARTIFICIAL (t) = 1;
+#endif
+ addr = TRUE;
+ break;
+
+ case FFEINFO_whereINTRINSIC:
+ assert (!ffecom_transform_only_dummies_);
+ break; /* Let actual references generate their
+ decls. */
+
+ default:
+ assert ("SUBROUTINE where unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ t = error_mark_node;
+ break;
+ }
+ break;
+
+ case FFEINFO_kindPROGRAM:
+ switch (ffeinfo_where (ffesymbol_info (s)))
+ {
+ case FFEINFO_whereLOCAL: /* Me. */
+ assert (!ffecom_transform_only_dummies_);
+ t = current_function_decl;
+ break;
+
+ case FFEINFO_whereCOMMON:
+ case FFEINFO_whereDUMMY:
+ case FFEINFO_whereGLOBAL:
+ case FFEINFO_whereRESULT:
+ case FFEINFO_whereFLEETING:
+ case FFEINFO_whereFLEETING_CADDR:
+ case FFEINFO_whereFLEETING_IADDR:
+ case FFEINFO_whereIMMEDIATE:
+ case FFEINFO_whereINTRINSIC:
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereCONSTANT_SUBOBJECT:
+ default:
+ assert ("PROGRAM where unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ t = error_mark_node;
+ break;
+ }
+ break;
+
+ case FFEINFO_kindBLOCKDATA:
+ switch (ffeinfo_where (ffesymbol_info (s)))
+ {
+ case FFEINFO_whereLOCAL: /* Me. */
+ assert (!ffecom_transform_only_dummies_);
+ t = current_function_decl;
+ break;
+
+ case FFEINFO_whereGLOBAL:
+ assert (!ffecom_transform_only_dummies_);
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ t = build_decl (FUNCTION_DECL,
+ ffecom_get_external_identifier_ (s),
+ ffecom_tree_blockdata_type);
+ DECL_EXTERNAL (t) = 1;
+ TREE_PUBLIC (t) = 1;
+
+ t = start_decl (t, FALSE);
+ finish_decl (t, NULL_TREE, FALSE);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ break;
+
+ case FFEINFO_whereCOMMON:
+ case FFEINFO_whereDUMMY:
+ case FFEINFO_whereRESULT:
+ case FFEINFO_whereFLEETING:
+ case FFEINFO_whereFLEETING_CADDR:
+ case FFEINFO_whereFLEETING_IADDR:
+ case FFEINFO_whereIMMEDIATE:
+ case FFEINFO_whereINTRINSIC:
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereCONSTANT_SUBOBJECT:
+ default:
+ assert ("BLOCKDATA where unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ t = error_mark_node;
+ break;
+ }
+ break;
+
+ case FFEINFO_kindCOMMON:
+ switch (ffeinfo_where (ffesymbol_info (s)))
+ {
+ case FFEINFO_whereLOCAL:
+ assert (!ffecom_transform_only_dummies_);
+ ffecom_transform_common_ (s);
+ break;
+
+ case FFEINFO_whereNONE:
+ case FFEINFO_whereCOMMON:
+ case FFEINFO_whereDUMMY:
+ case FFEINFO_whereGLOBAL:
+ case FFEINFO_whereRESULT:
+ case FFEINFO_whereFLEETING:
+ case FFEINFO_whereFLEETING_CADDR:
+ case FFEINFO_whereFLEETING_IADDR:
+ case FFEINFO_whereIMMEDIATE:
+ case FFEINFO_whereINTRINSIC:
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereCONSTANT_SUBOBJECT:
+ default:
+ assert ("COMMON where unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ t = error_mark_node;
+ break;
+ }
+ break;
+
+ case FFEINFO_kindCONSTRUCT:
+ switch (ffeinfo_where (ffesymbol_info (s)))
+ {
+ case FFEINFO_whereLOCAL:
+ assert (!ffecom_transform_only_dummies_);
+ break;
+
+ case FFEINFO_whereNONE:
+ case FFEINFO_whereCOMMON:
+ case FFEINFO_whereDUMMY:
+ case FFEINFO_whereGLOBAL:
+ case FFEINFO_whereRESULT:
+ case FFEINFO_whereFLEETING:
+ case FFEINFO_whereFLEETING_CADDR:
+ case FFEINFO_whereFLEETING_IADDR:
+ case FFEINFO_whereIMMEDIATE:
+ case FFEINFO_whereINTRINSIC:
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereCONSTANT_SUBOBJECT:
+ default:
+ assert ("CONSTRUCT where unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ t = error_mark_node;
+ break;
+ }
+ break;
+
+ case FFEINFO_kindNAMELIST:
+ switch (ffeinfo_where (ffesymbol_info (s)))
+ {
+ case FFEINFO_whereLOCAL:
+ assert (!ffecom_transform_only_dummies_);
+ t = ffecom_transform_namelist_ (s);
+ break;
+
+ case FFEINFO_whereNONE:
+ case FFEINFO_whereCOMMON:
+ case FFEINFO_whereDUMMY:
+ case FFEINFO_whereGLOBAL:
+ case FFEINFO_whereRESULT:
+ case FFEINFO_whereFLEETING:
+ case FFEINFO_whereFLEETING_CADDR:
+ case FFEINFO_whereFLEETING_IADDR:
+ case FFEINFO_whereIMMEDIATE:
+ case FFEINFO_whereINTRINSIC:
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereCONSTANT_SUBOBJECT:
+ default:
+ assert ("NAMELIST where unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_whereANY:
+ t = error_mark_node;
+ break;
+ }
+ break;
+
+ default:
+ assert ("kind unheard of" == NULL);
+ /* Fall through. */
+ case FFEINFO_kindANY:
+ t = error_mark_node;
+ break;
+ }
+
+ ffesymbol_hook (s).decl_tree = t;
+ ffesymbol_hook (s).length_tree = tlen;
+ ffesymbol_hook (s).addr = addr;
+
+ lineno = old_lineno;
+ input_filename = old_input_filename;
+
+ return s;
+}
+
+#endif
+/* Transform into ASSIGNable symbol.
+
+ Symbol has already been transformed, but for whatever reason, the
+ resulting decl_tree has been deemed not usable for an ASSIGN target.
+ (E.g. it isn't wide enough to hold a pointer.) So, here we invent
+ another local symbol of type void * and stuff that in the assign_tree
+ argument. The F77/F90 standards allow this implementation. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffesymbol
+ffecom_sym_transform_assign_ (ffesymbol s)
+{
+ tree t; /* Transformed thingy. */
+ int yes;
+ int old_lineno = lineno;
+ char *old_input_filename = input_filename;
+
+ if (ffesymbol_sfdummyparent (s) == NULL)
+ {
+ input_filename = ffesymbol_where_filename (s);
+ lineno = ffesymbol_where_filelinenum (s);
+ }
+ else
+ {
+ ffesymbol sf = ffesymbol_sfdummyparent (s);
+
+ input_filename = ffesymbol_where_filename (sf);
+ lineno = ffesymbol_where_filelinenum (sf);
+ }
+
+ assert (!ffecom_transform_only_dummies_);
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_ASSIGN_%s",
+ ffesymbol_text (s),
+ 0),
+ TREE_TYPE (null_pointer_node));
+
+ switch (ffesymbol_where (s))
+ {
+ case FFEINFO_whereLOCAL:
+ /* Unlike for regular vars, SAVE status is easy to determine for
+ ASSIGNed vars, since there's no initialization, there's no
+ effective storage association (so "SAVE J" does not apply to
+ K even given "EQUIVALENCE (J,K)"), there's no size issue
+ to worry about, etc. */
+ if ((ffesymbol_is_save (s) || ffe_is_saveall ())
+ && (ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
+ && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA))
+ TREE_STATIC (t) = 1; /* SAVEd in proc, make static. */
+ else
+ TREE_STATIC (t) = 0; /* No need to make static. */
+ break;
+
+ case FFEINFO_whereCOMMON:
+ TREE_STATIC (t) = 1; /* Assume COMMONs always SAVEd. */
+ break;
+
+ case FFEINFO_whereDUMMY:
+ /* Note that twinning a DUMMY means the caller won't see
+ the ASSIGNed value. But both F77 and F90 allow implementations
+ to do this, i.e. disallow Fortran code that would try and
+ take advantage of actually putting a label into a variable
+ via a dummy argument (or any other storage association, for
+ that matter). */
+ TREE_STATIC (t) = 0;
+ break;
+
+ default:
+ TREE_STATIC (t) = 0;
+ break;
+ }
+
+ t = start_decl (t, FALSE);
+ finish_decl (t, NULL_TREE, FALSE);
+
+ resume_momentary (yes);
+
+ ffesymbol_hook (s).assign_tree = t;
+
+ lineno = old_lineno;
+ input_filename = old_input_filename;
+
+ return s;
+}
+
+#endif
+/* Implement COMMON area in back end.
+
+ Because COMMON-based variables can be referenced in the dimension
+ expressions of dummy (adjustable) arrays, and because dummies
+ (in the gcc back end) need to be put in the outer binding level
+ of a function (which has two binding levels, the outer holding
+ the dummies and the inner holding the other vars), special care
+ must be taken to handle COMMON areas.
+
+ The current strategy is basically to always tell the back end about
+ the COMMON area as a top-level external reference to just a block
+ of storage of the master type of that area (e.g. integer, real,
+ character, whatever -- not a structure). As a distinct action,
+ if initial values are provided, tell the back end about the area
+ as a top-level non-external (initialized) area and remember not to
+ allow further initialization or expansion of the area. Meanwhile,
+ if no initialization happens at all, tell the back end about
+ the largest size we've seen declared so the space does get reserved.
+ (This function doesn't handle all that stuff, but it does some
+ of the important things.)
+
+ Meanwhile, for COMMON variables themselves, just keep creating
+ references like *((float *) (&common_area + offset)) each time
+ we reference the variable. In other words, don't make a VAR_DECL
+ or any kind of component reference (like we used to do before 0.4),
+ though we might do that as well just for debugging purposes (and
+ stuff the rtl with the appropriate offset expression). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_transform_common_ (ffesymbol s)
+{
+ ffestorag st = ffesymbol_storage (s);
+ ffeglobal g = ffesymbol_global (s);
+ tree cbt;
+ tree cbtype;
+ tree init;
+ bool is_init = ffestorag_is_init (st);
+
+ assert (st != NULL);
+
+ if ((g == NULL)
+ || (ffeglobal_type (g) != FFEGLOBAL_typeCOMMON))
+ return;
+
+ /* First update the size of the area in global terms. */
+
+ ffeglobal_size_common (s, ffestorag_size (st));
+
+ if (!ffeglobal_common_init (g))
+ is_init = FALSE; /* No explicit init, don't let erroneous joins init. */
+
+ cbt = ffeglobal_hook (g);
+
+ /* If we already have declared this common block for a previous program
+ unit, and either we already initialized it or we don't have new
+ initialization for it, just return what we have without changing it. */
+
+ if ((cbt != NULL_TREE)
+ && (!is_init
+ || !DECL_EXTERNAL (cbt)))
+ return;
+
+ /* Process inits. */
+
+ if (is_init)
+ {
+ if (ffestorag_init (st) != NULL)
+ {
+ init = ffecom_expr (ffestorag_init (st));
+ if (init == error_mark_node)
+ { /* Hopefully the back end complained! */
+ init = NULL_TREE;
+ if (cbt != NULL_TREE)
+ return;
+ }
+ }
+ else
+ init = error_mark_node;
+ }
+ else
+ init = NULL_TREE;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ /* cbtype must be permanently allocated! */
+
+ if (init)
+ cbtype = build_array_type (char_type_node,
+ build_range_type (integer_type_node,
+ integer_one_node,
+ build_int_2
+ (ffeglobal_common_size (g),
+ 0)));
+ else
+ cbtype = build_array_type (char_type_node, NULL_TREE);
+
+ if (cbt == NULL_TREE)
+ {
+ cbt
+ = build_decl (VAR_DECL,
+ ffecom_get_external_identifier_ (s),
+ cbtype);
+ TREE_STATIC (cbt) = 1;
+ TREE_PUBLIC (cbt) = 1;
+ }
+ else
+ {
+ assert (is_init);
+ TREE_TYPE (cbt) = cbtype;
+ }
+ DECL_EXTERNAL (cbt) = init ? 0 : 1;
+ DECL_INITIAL (cbt) = init ? error_mark_node : NULL_TREE;
+
+ cbt = start_decl (cbt, TRUE);
+ if (ffeglobal_hook (g) != NULL)
+ assert (cbt == ffeglobal_hook (g));
+
+ assert (!init || !DECL_EXTERNAL (cbt));
+
+ /* Make sure that any type can live in COMMON and be referenced
+ without getting a bus error. We could pick the most restrictive
+ alignment of all entities actually placed in the COMMON, but
+ this seems easy enough. */
+
+ DECL_ALIGN (cbt) = BIGGEST_ALIGNMENT;
+
+ if (is_init && (ffestorag_init (st) == NULL))
+ init = ffecom_init_zero_ (cbt);
+
+ finish_decl (cbt, init, TRUE);
+
+ if (is_init)
+ ffestorag_set_init (st, ffebld_new_any ());
+
+ if (init)
+ {
+ tree size_tree;
+
+ assert (DECL_SIZE (cbt) != NULL_TREE);
+ assert (TREE_CODE (DECL_SIZE (cbt)) == INTEGER_CST);
+ size_tree = size_binop (CEIL_DIV_EXPR,
+ DECL_SIZE (cbt),
+ size_int (BITS_PER_UNIT));
+ assert (TREE_INT_CST_HIGH (size_tree) == 0);
+ assert (TREE_INT_CST_LOW (size_tree) == ffeglobal_common_size (g));
+ }
+
+ ffeglobal_set_hook (g, cbt);
+
+ ffestorag_set_hook (st, cbt);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+}
+
+#endif
+/* Make master area for local EQUIVALENCE. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_transform_equiv_ (ffestorag eqst)
+{
+ tree eqt;
+ tree eqtype;
+ tree init;
+ tree high;
+ bool is_init = ffestorag_is_init (eqst);
+ int yes;
+
+ assert (eqst != NULL);
+
+ eqt = ffestorag_hook (eqst);
+
+ if (eqt != NULL_TREE)
+ return;
+
+ /* Process inits. */
+
+ if (is_init)
+ {
+ if (ffestorag_init (eqst) != NULL)
+ {
+ init = ffecom_expr (ffestorag_init (eqst));
+ if (init == error_mark_node)
+ init = NULL_TREE; /* Hopefully the back end complained! */
+ }
+ else
+ init = error_mark_node;
+ }
+ else if (ffe_is_init_local_zero ())
+ init = error_mark_node;
+ else
+ init = NULL_TREE;
+
+ ffecom_member_namelisted_ = FALSE;
+ ffestorag_drive (ffestorag_list_equivs (eqst),
+ &ffecom_member_phase1_,
+ eqst);
+
+ yes = suspend_momentary ();
+
+ high = build_int_2 (ffestorag_size (eqst), 0);
+ TREE_TYPE (high) = ffecom_integer_type_node;
+
+ eqtype = build_array_type (char_type_node,
+ build_range_type (ffecom_integer_type_node,
+ ffecom_integer_one_node,
+ high));
+
+ eqt = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_equiv_%s",
+ ffesymbol_text
+ (ffestorag_symbol
+ (eqst)),
+ 0),
+ eqtype);
+ DECL_EXTERNAL (eqt) = 0;
+ if (is_init
+ || ffecom_member_namelisted_
+#ifdef FFECOM_sizeMAXSTACKITEM
+ || (ffestorag_size (eqst) > FFECOM_sizeMAXSTACKITEM)
+#endif
+ || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
+ && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA)
+ && (ffestorag_is_save (eqst) || ffe_is_saveall ())))
+ TREE_STATIC (eqt) = 1;
+ else
+ TREE_STATIC (eqt) = 0;
+ TREE_PUBLIC (eqt) = 0;
+ DECL_CONTEXT (eqt) = current_function_decl;
+ if (init)
+ DECL_INITIAL (eqt) = error_mark_node;
+ else
+ DECL_INITIAL (eqt) = NULL_TREE;
+
+ eqt = start_decl (eqt, FALSE);
+
+ /* Make sure this shows up as a debug symbol, which is not normally
+ the case for invented identifiers. */
+
+ DECL_IGNORED_P (eqt) = 0;
+
+ /* Make sure that any type can live in EQUIVALENCE and be referenced
+ without getting a bus error. We could pick the most restrictive
+ alignment of all entities actually placed in the EQUIVALENCE, but
+ this seems easy enough. */
+
+ DECL_ALIGN (eqt) = BIGGEST_ALIGNMENT;
+
+ if ((!is_init && ffe_is_init_local_zero ())
+ || (is_init && (ffestorag_init (eqst) == NULL)))
+ init = ffecom_init_zero_ (eqt);
+
+ finish_decl (eqt, init, FALSE);
+
+ if (is_init)
+ ffestorag_set_init (eqst, ffebld_new_any ());
+
+ {
+ tree size_tree;
+
+ size_tree = size_binop (CEIL_DIV_EXPR,
+ DECL_SIZE (eqt),
+ size_int (BITS_PER_UNIT));
+ assert (TREE_INT_CST_HIGH (size_tree) == 0);
+ assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (eqst));
+ }
+
+ ffestorag_set_hook (eqst, eqt);
+
+#ifdef SOMEONE_GETS_DEBUG_SUPPORT_WORKING
+ ffestorag_drive (ffestorag_list_equivs (eqst),
+ &ffecom_member_phase2_,
+ eqst);
+#endif
+
+ resume_momentary (yes);
+}
+
+#endif
+/* Implement NAMELIST in back end. See f2c/format.c for more info. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_transform_namelist_ (ffesymbol s)
+{
+ tree nmlt;
+ tree nmltype = ffecom_type_namelist_ ();
+ tree nmlinits;
+ tree nameinit;
+ tree varsinit;
+ tree nvarsinit;
+ tree field;
+ tree high;
+ int yes;
+ int i;
+ static int mynumber = 0;
+
+ yes = suspend_momentary ();
+
+ nmlt = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_namelist_%d",
+ NULL, mynumber++),
+ nmltype);
+ TREE_STATIC (nmlt) = 1;
+ DECL_INITIAL (nmlt) = error_mark_node;
+
+ nmlt = start_decl (nmlt, FALSE);
+
+ /* Process inits. */
+
+ i = strlen (ffesymbol_text (s));
+
+ high = build_int_2 (i, 0);
+ TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
+
+ nameinit = ffecom_build_f2c_string_ (i + 1,
+ ffesymbol_text (s));
+ TREE_TYPE (nameinit)
+ = build_type_variant
+ (build_array_type
+ (char_type_node,
+ build_range_type (ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ high)),
+ 1, 0);
+ TREE_CONSTANT (nameinit) = 1;
+ TREE_STATIC (nameinit) = 1;
+ nameinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (nameinit)),
+ nameinit);
+
+ varsinit = ffecom_vardesc_array_ (s);
+ varsinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (varsinit)),
+ varsinit);
+ TREE_CONSTANT (varsinit) = 1;
+ TREE_STATIC (varsinit) = 1;
+
+ {
+ ffebld b;
+
+ for (i = 0, b = ffesymbol_namelist (s); b != NULL; b = ffebld_trail (b))
+ ++i;
+ }
+ nvarsinit = build_int_2 (i, 0);
+ TREE_TYPE (nvarsinit) = integer_type_node;
+ TREE_CONSTANT (nvarsinit) = 1;
+ TREE_STATIC (nvarsinit) = 1;
+
+ nmlinits = build_tree_list ((field = TYPE_FIELDS (nmltype)), nameinit);
+ TREE_CHAIN (nmlinits) = build_tree_list ((field = TREE_CHAIN (field)),
+ varsinit);
+ TREE_CHAIN (TREE_CHAIN (nmlinits))
+ = build_tree_list ((field = TREE_CHAIN (field)), nvarsinit);
+
+ nmlinits = build (CONSTRUCTOR, nmltype, NULL_TREE, nmlinits);
+ TREE_CONSTANT (nmlinits) = 1;
+ TREE_STATIC (nmlinits) = 1;
+
+ finish_decl (nmlt, nmlinits, FALSE);
+
+ nmlt = ffecom_1 (ADDR_EXPR, build_pointer_type (nmltype), nmlt);
+
+ resume_momentary (yes);
+
+ return nmlt;
+}
+
+#endif
+
+/* A subroutine of ffecom_tree_canonize_ref_. The incoming tree is
+ analyzed on the assumption it is calculating a pointer to be
+ indirected through. It must return the proper decl and offset,
+ taking into account different units of measurements for offsets. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_tree_canonize_ptr_ (tree *decl, tree *offset,
+ tree t)
+{
+ switch (TREE_CODE (t))
+ {
+ case NOP_EXPR:
+ case CONVERT_EXPR:
+ case NON_LVALUE_EXPR:
+ ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0));
+ break;
+
+ case PLUS_EXPR:
+ ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0));
+ if ((*decl == NULL_TREE)
+ || (*decl == error_mark_node))
+ break;
+
+ if (TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST)
+ {
+ /* An offset into COMMON. */
+ *offset = size_binop (PLUS_EXPR,
+ *offset,
+ TREE_OPERAND (t, 1));
+ /* Convert offset (presumably in bytes) into canonical units
+ (presumably bits). */
+ *offset = size_binop (MULT_EXPR,
+ *offset,
+ TYPE_SIZE (TREE_TYPE (TREE_TYPE (t))));
+ break;
+ }
+ /* Not a COMMON reference, so an unrecognized pattern. */
+ *decl = error_mark_node;
+ break;
+
+ case PARM_DECL:
+ *decl = t;
+ *offset = size_zero_node;
+ break;
+
+ case ADDR_EXPR:
+ if (TREE_CODE (TREE_OPERAND (t, 0)) == VAR_DECL)
+ {
+ /* A reference to COMMON. */
+ *decl = TREE_OPERAND (t, 0);
+ *offset = size_zero_node;
+ break;
+ }
+ /* Fall through. */
+ default:
+ /* Not a COMMON reference, so an unrecognized pattern. */
+ *decl = error_mark_node;
+ break;
+ }
+}
+#endif
+
+/* Given a tree that is possibly intended for use as an lvalue, return
+ information representing a canonical view of that tree as a decl, an
+ offset into that decl, and a size for the lvalue.
+
+ If there's no applicable decl, NULL_TREE is returned for the decl,
+ and the other fields are left undefined.
+
+ If the tree doesn't fit the recognizable forms, an ERROR_MARK node
+ is returned for the decl, and the other fields are left undefined.
+
+ Otherwise, the decl returned currently is either a VAR_DECL or a
+ PARM_DECL.
+
+ The offset returned is always valid, but of course not necessarily
+ a constant, and not necessarily converted into the appropriate
+ type, leaving that up to the caller (so as to avoid that overhead
+ if the decls being looked at are different anyway).
+
+ If the size cannot be determined (e.g. an adjustable array),
+ an ERROR_MARK node is returned for the size. Otherwise, the
+ size returned is valid, not necessarily a constant, and not
+ necessarily converted into the appropriate type as with the
+ offset.
+
+ Note that the offset and size expressions are expressed in the
+ base storage units (usually bits) rather than in the units of
+ the type of the decl, because two decls with different types
+ might overlap but with apparently non-overlapping array offsets,
+ whereas converting the array offsets to consistant offsets will
+ reveal the overlap. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffecom_tree_canonize_ref_ (tree *decl, tree *offset,
+ tree *size, tree t)
+{
+ /* The default path is to report a nonexistant decl. */
+ *decl = NULL_TREE;
+
+ if (t == NULL_TREE)
+ return;
+
+ switch (TREE_CODE (t))
+ {
+ case ERROR_MARK:
+ case IDENTIFIER_NODE:
+ case INTEGER_CST:
+ case REAL_CST:
+ case COMPLEX_CST:
+ case STRING_CST:
+ case CONST_DECL:
+ case PLUS_EXPR:
+ case MINUS_EXPR:
+ case MULT_EXPR:
+ case TRUNC_DIV_EXPR:
+ case CEIL_DIV_EXPR:
+ case FLOOR_DIV_EXPR:
+ case ROUND_DIV_EXPR:
+ case TRUNC_MOD_EXPR:
+ case CEIL_MOD_EXPR:
+ case FLOOR_MOD_EXPR:
+ case ROUND_MOD_EXPR:
+ case RDIV_EXPR:
+ case EXACT_DIV_EXPR:
+ case FIX_TRUNC_EXPR:
+ case FIX_CEIL_EXPR:
+ case FIX_FLOOR_EXPR:
+ case FIX_ROUND_EXPR:
+ case FLOAT_EXPR:
+ case EXPON_EXPR:
+ case NEGATE_EXPR:
+ case MIN_EXPR:
+ case MAX_EXPR:
+ case ABS_EXPR:
+ case FFS_EXPR:
+ case LSHIFT_EXPR:
+ case RSHIFT_EXPR:
+ case LROTATE_EXPR:
+ case RROTATE_EXPR:
+ case BIT_IOR_EXPR:
+ case BIT_XOR_EXPR:
+ case BIT_AND_EXPR:
+ case BIT_ANDTC_EXPR:
+ case BIT_NOT_EXPR:
+ case TRUTH_ANDIF_EXPR:
+ case TRUTH_ORIF_EXPR:
+ case TRUTH_AND_EXPR:
+ case TRUTH_OR_EXPR:
+ case TRUTH_XOR_EXPR:
+ case TRUTH_NOT_EXPR:
+ case LT_EXPR:
+ case LE_EXPR:
+ case GT_EXPR:
+ case GE_EXPR:
+ case EQ_EXPR:
+ case NE_EXPR:
+ case COMPLEX_EXPR:
+ case CONJ_EXPR:
+ case REALPART_EXPR:
+ case IMAGPART_EXPR:
+ case LABEL_EXPR:
+ case COMPONENT_REF:
+ case COMPOUND_EXPR:
+ case ADDR_EXPR:
+ return;
+
+ case VAR_DECL:
+ case PARM_DECL:
+ *decl = t;
+ *offset = size_zero_node;
+ *size = TYPE_SIZE (TREE_TYPE (t));
+ return;
+
+ case ARRAY_REF:
+ {
+ tree array = TREE_OPERAND (t, 0);
+ tree element = TREE_OPERAND (t, 1);
+ tree init_offset;
+
+ if ((array == NULL_TREE)
+ || (element == NULL_TREE))
+ {
+ *decl = error_mark_node;
+ return;
+ }
+
+ ffecom_tree_canonize_ref_ (decl, &init_offset, size,
+ array);
+ if ((*decl == NULL_TREE)
+ || (*decl == error_mark_node))
+ return;
+
+ *offset = size_binop (MULT_EXPR,
+ TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))),
+ size_binop (MINUS_EXPR,
+ element,
+ TYPE_MIN_VALUE
+ (TYPE_DOMAIN
+ (TREE_TYPE (array)))));
+
+ *offset = size_binop (PLUS_EXPR,
+ init_offset,
+ *offset);
+
+ *size = TYPE_SIZE (TREE_TYPE (t));
+ return;
+ }
+
+ case INDIRECT_REF:
+
+ /* Most of this code is to handle references to COMMON. And so
+ far that is useful only for calling library functions, since
+ external (user) functions might reference common areas. But
+ even calling an external function, it's worthwhile to decode
+ COMMON references because if not storing into COMMON, we don't
+ want COMMON-based arguments to gratuitously force use of a
+ temporary. */
+
+ *size = TYPE_SIZE (TREE_TYPE (t));
+
+ ffecom_tree_canonize_ptr_ (decl, offset,
+ TREE_OPERAND (t, 0));
+
+ return;
+
+ case CONVERT_EXPR:
+ case NOP_EXPR:
+ case MODIFY_EXPR:
+ case NON_LVALUE_EXPR:
+ case RESULT_DECL:
+ case FIELD_DECL:
+ case COND_EXPR: /* More cases than we can handle. */
+ case SAVE_EXPR:
+ case REFERENCE_EXPR:
+ case PREDECREMENT_EXPR:
+ case PREINCREMENT_EXPR:
+ case POSTDECREMENT_EXPR:
+ case POSTINCREMENT_EXPR:
+ case CALL_EXPR:
+ default:
+ *decl = error_mark_node;
+ return;
+ }
+}
+#endif
+
+/* Do divide operation appropriate to type of operands. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_tree_divide_ (tree tree_type, tree left, tree right,
+ tree dest_tree, ffebld dest, bool *dest_used)
+{
+ if ((left == error_mark_node)
+ || (right == error_mark_node))
+ return error_mark_node;
+
+ switch (TREE_CODE (tree_type))
+ {
+ case INTEGER_TYPE:
+ return ffecom_2 (TRUNC_DIV_EXPR, tree_type,
+ left,
+ right);
+
+ case COMPLEX_TYPE:
+ {
+ ffecomGfrt ix;
+
+ if (TREE_TYPE (tree_type)
+ == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1])
+ ix = FFECOM_gfrtDIV_CC; /* Overlapping result okay. */
+ else
+ ix = FFECOM_gfrtDIV_ZZ; /* Overlapping result okay. */
+
+ left = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (left)),
+ left);
+ left = build_tree_list (NULL_TREE, left);
+ right = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (right)),
+ right);
+ right = build_tree_list (NULL_TREE, right);
+ TREE_CHAIN (left) = right;
+
+ return ffecom_call_ (ffecom_gfrt_tree_ (ix),
+ ffecom_gfrt_kindtype (ix),
+ ffe_is_f2c_library (),
+ tree_type,
+ left,
+ dest_tree, dest, dest_used,
+ NULL_TREE, TRUE);
+ }
+ break;
+
+ case RECORD_TYPE:
+ {
+ ffecomGfrt ix;
+
+ if (TREE_TYPE (TYPE_FIELDS (tree_type))
+ == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1])
+ ix = FFECOM_gfrtDIV_CC; /* Overlapping result okay. */
+ else
+ ix = FFECOM_gfrtDIV_ZZ; /* Overlapping result okay. */
+
+ left = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (left)),
+ left);
+ left = build_tree_list (NULL_TREE, left);
+ right = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (right)),
+ right);
+ right = build_tree_list (NULL_TREE, right);
+ TREE_CHAIN (left) = right;
+
+ return ffecom_call_ (ffecom_gfrt_tree_ (ix),
+ ffecom_gfrt_kindtype (ix),
+ ffe_is_f2c_library (),
+ tree_type,
+ left,
+ dest_tree, dest, dest_used,
+ NULL_TREE, TRUE);
+ }
+ break;
+
+ default:
+ return ffecom_2 (RDIV_EXPR, tree_type,
+ left,
+ right);
+ }
+}
+
+#endif
+/* ffecom_type_localvar_ -- Build type info for non-dummy variable
+
+ tree type;
+ ffesymbol s; // the variable's symbol
+ ffeinfoBasictype bt; // it's basictype
+ ffeinfoKindtype kt; // it's kindtype
+
+ type = ffecom_type_localvar_(s,bt,kt);
+
+ Handles static arrays, CHARACTER type, etc. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt,
+ ffeinfoKindtype kt)
+{
+ tree type;
+ ffebld dl;
+ ffebld dim;
+ tree lowt;
+ tree hight;
+
+ type = ffecom_tree_type[bt][kt];
+ if (bt == FFEINFO_basictypeCHARACTER)
+ {
+ hight = build_int_2 (ffesymbol_size (s), 0);
+ TREE_TYPE (hight) = ffecom_f2c_ftnlen_type_node;
+
+ type
+ = build_array_type
+ (type,
+ build_range_type (ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ hight));
+ type = ffecom_check_size_overflow_ (s, type, FALSE);
+ }
+
+ for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl))
+ {
+ if (type == error_mark_node)
+ break;
+
+ dim = ffebld_head (dl);
+ assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
+
+ if (ffebld_left (dim) == NULL)
+ lowt = integer_one_node;
+ else
+ lowt = ffecom_expr (ffebld_left (dim));
+
+ if (TREE_CODE (lowt) != INTEGER_CST)
+ lowt = variable_size (lowt);
+
+ assert (ffebld_right (dim) != NULL);
+ hight = ffecom_expr (ffebld_right (dim));
+
+ if (TREE_CODE (hight) != INTEGER_CST)
+ hight = variable_size (hight);
+
+ type = build_array_type (type,
+ build_range_type (ffecom_integer_type_node,
+ lowt, hight));
+ type = ffecom_check_size_overflow_ (s, type, FALSE);
+ }
+
+ return type;
+}
+
+#endif
+/* Build Namelist type. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_type_namelist_ ()
+{
+ static tree type = NULL_TREE;
+
+ if (type == NULL_TREE)
+ {
+ static tree namefield, varsfield, nvarsfield;
+ tree vardesctype;
+
+ vardesctype = ffecom_type_vardesc_ ();
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ type = make_node (RECORD_TYPE);
+
+ vardesctype = build_pointer_type (build_pointer_type (vardesctype));
+
+ namefield = ffecom_decl_field (type, NULL_TREE, "name",
+ string_type_node);
+ varsfield = ffecom_decl_field (type, namefield, "vars", vardesctype);
+ nvarsfield = ffecom_decl_field (type, varsfield, "nvars",
+ integer_type_node);
+
+ TYPE_FIELDS (type) = namefield;
+ layout_type (type);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+ }
+
+ return type;
+}
+
+#endif
+
+/* Make a copy of a type, assuming caller has switched to the permanent
+ obstacks and that the type is for an aggregate (array) initializer. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC && 0 /* Not used now. */
+static tree
+ffecom_type_permanent_copy_ (tree t)
+{
+ tree domain;
+ tree max;
+
+ assert (TREE_TYPE (t) != NULL_TREE);
+
+ domain = TYPE_DOMAIN (t);
+
+ assert (TREE_CODE (t) == ARRAY_TYPE);
+ assert (TREE_PERMANENT (TREE_TYPE (t)));
+ assert (TREE_PERMANENT (TREE_TYPE (domain)));
+ assert (TREE_PERMANENT (TYPE_MIN_VALUE (domain)));
+
+ max = TYPE_MAX_VALUE (domain);
+ if (!TREE_PERMANENT (max))
+ {
+ assert (TREE_CODE (max) == INTEGER_CST);
+
+ max = build_int_2 (TREE_INT_CST_LOW (max), TREE_INT_CST_HIGH (max));
+ TREE_TYPE (max) = TREE_TYPE (TYPE_MIN_VALUE (domain));
+ }
+
+ return build_array_type (TREE_TYPE (t),
+ build_range_type (TREE_TYPE (domain),
+ TYPE_MIN_VALUE (domain),
+ max));
+}
+#endif
+
+/* Build Vardesc type. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_type_vardesc_ ()
+{
+ static tree type = NULL_TREE;
+ static tree namefield, addrfield, dimsfield, typefield;
+
+ if (type == NULL_TREE)
+ {
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ type = make_node (RECORD_TYPE);
+
+ namefield = ffecom_decl_field (type, NULL_TREE, "name",
+ string_type_node);
+ addrfield = ffecom_decl_field (type, namefield, "addr",
+ string_type_node);
+ dimsfield = ffecom_decl_field (type, addrfield, "dims",
+ ffecom_f2c_ftnlen_type_node);
+ typefield = ffecom_decl_field (type, dimsfield, "type",
+ integer_type_node);
+
+ TYPE_FIELDS (type) = namefield;
+ layout_type (type);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+ }
+
+ return type;
+}
+
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_vardesc_ (ffebld expr)
+{
+ ffesymbol s;
+
+ assert (ffebld_op (expr) == FFEBLD_opSYMTER);
+ s = ffebld_symter (expr);
+
+ if (ffesymbol_hook (s).vardesc_tree == NULL_TREE)
+ {
+ int i;
+ tree vardesctype = ffecom_type_vardesc_ ();
+ tree var;
+ tree nameinit;
+ tree dimsinit;
+ tree addrinit;
+ tree typeinit;
+ tree field;
+ tree varinits;
+ int yes;
+ static int mynumber = 0;
+
+ yes = suspend_momentary ();
+
+ var = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_vardesc_%d",
+ NULL, mynumber++),
+ vardesctype);
+ TREE_STATIC (var) = 1;
+ DECL_INITIAL (var) = error_mark_node;
+
+ var = start_decl (var, FALSE);
+
+ /* Process inits. */
+
+ nameinit = ffecom_build_f2c_string_ ((i = strlen (ffesymbol_text (s)))
+ + 1,
+ ffesymbol_text (s));
+ TREE_TYPE (nameinit)
+ = build_type_variant
+ (build_array_type
+ (char_type_node,
+ build_range_type (integer_type_node,
+ integer_one_node,
+ build_int_2 (i, 0))),
+ 1, 0);
+ TREE_CONSTANT (nameinit) = 1;
+ TREE_STATIC (nameinit) = 1;
+ nameinit = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (nameinit)),
+ nameinit);
+
+ addrinit = ffecom_arg_ptr_to_expr (expr, &typeinit);
+
+ dimsinit = ffecom_vardesc_dims_ (s);
+
+ if (typeinit == NULL_TREE)
+ {
+ ffeinfoBasictype bt = ffesymbol_basictype (s);
+ ffeinfoKindtype kt = ffesymbol_kindtype (s);
+ int tc = ffecom_f2c_typecode (bt, kt);
+
+ assert (tc != -1);
+ typeinit = build_int_2 (tc, (tc < 0) ? -1 : 0);
+ }
+ else
+ typeinit = ffecom_1 (NEGATE_EXPR, TREE_TYPE (typeinit), typeinit);
+
+ varinits = build_tree_list ((field = TYPE_FIELDS (vardesctype)),
+ nameinit);
+ TREE_CHAIN (varinits) = build_tree_list ((field = TREE_CHAIN (field)),
+ addrinit);
+ TREE_CHAIN (TREE_CHAIN (varinits))
+ = build_tree_list ((field = TREE_CHAIN (field)), dimsinit);
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (varinits)))
+ = build_tree_list ((field = TREE_CHAIN (field)), typeinit);
+
+ varinits = build (CONSTRUCTOR, vardesctype, NULL_TREE, varinits);
+ TREE_CONSTANT (varinits) = 1;
+ TREE_STATIC (varinits) = 1;
+
+ finish_decl (var, varinits, FALSE);
+
+ var = ffecom_1 (ADDR_EXPR, build_pointer_type (vardesctype), var);
+
+ resume_momentary (yes);
+
+ ffesymbol_hook (s).vardesc_tree = var;
+ }
+
+ return ffesymbol_hook (s).vardesc_tree;
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_vardesc_array_ (ffesymbol s)
+{
+ ffebld b;
+ tree list;
+ tree item = NULL_TREE;
+ tree var;
+ int i;
+ int yes;
+ static int mynumber = 0;
+
+ for (i = 0, list = NULL_TREE, b = ffesymbol_namelist (s);
+ b != NULL;
+ b = ffebld_trail (b), ++i)
+ {
+ tree t;
+
+ t = ffecom_vardesc_ (ffebld_head (b));
+
+ if (list == NULL_TREE)
+ list = item = build_tree_list (NULL_TREE, t);
+ else
+ {
+ TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
+ item = TREE_CHAIN (item);
+ }
+ }
+
+ yes = suspend_momentary ();
+
+ item = build_array_type (build_pointer_type (ffecom_type_vardesc_ ()),
+ build_range_type (integer_type_node,
+ integer_one_node,
+ build_int_2 (i, 0)));
+ list = build (CONSTRUCTOR, item, NULL_TREE, list);
+ TREE_CONSTANT (list) = 1;
+ TREE_STATIC (list) = 1;
+
+ var = ffecom_get_invented_identifier ("__g77_vardesc_array_%d", NULL,
+ mynumber++);
+ var = build_decl (VAR_DECL, var, item);
+ TREE_STATIC (var) = 1;
+ DECL_INITIAL (var) = error_mark_node;
+ var = start_decl (var, FALSE);
+ finish_decl (var, list, FALSE);
+
+ resume_momentary (yes);
+
+ return var;
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffecom_vardesc_dims_ (ffesymbol s)
+{
+ if (ffesymbol_dims (s) == NULL)
+ return convert (ffecom_f2c_ptr_to_ftnlen_type_node,
+ integer_zero_node);
+
+ {
+ ffebld b;
+ ffebld e;
+ tree list;
+ tree backlist;
+ tree item = NULL_TREE;
+ tree var;
+ int yes;
+ tree numdim;
+ tree numelem;
+ tree baseoff = NULL_TREE;
+ static int mynumber = 0;
+
+ numdim = build_int_2 ((int) ffesymbol_rank (s), 0);
+ TREE_TYPE (numdim) = ffecom_f2c_ftnlen_type_node;
+
+ numelem = ffecom_expr (ffesymbol_arraysize (s));
+ TREE_TYPE (numelem) = ffecom_f2c_ftnlen_type_node;
+
+ list = NULL_TREE;
+ backlist = NULL_TREE;
+ for (b = ffesymbol_dims (s), e = ffesymbol_extents (s);
+ b != NULL;
+ b = ffebld_trail (b), e = ffebld_trail (e))
+ {
+ tree t;
+ tree low;
+ tree back;
+
+ if (ffebld_trail (b) == NULL)
+ t = NULL_TREE;
+ else
+ {
+ t = convert (ffecom_f2c_ftnlen_type_node,
+ ffecom_expr (ffebld_head (e)));
+
+ if (list == NULL_TREE)
+ list = item = build_tree_list (NULL_TREE, t);
+ else
+ {
+ TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
+ item = TREE_CHAIN (item);
+ }
+ }
+
+ if (ffebld_left (ffebld_head (b)) == NULL)
+ low = ffecom_integer_one_node;
+ else
+ low = ffecom_expr (ffebld_left (ffebld_head (b)));
+ low = convert (ffecom_f2c_ftnlen_type_node, low);
+
+ back = build_tree_list (low, t);
+ TREE_CHAIN (back) = backlist;
+ backlist = back;
+ }
+
+ for (item = backlist; item != NULL_TREE; item = TREE_CHAIN (item))
+ {
+ if (TREE_VALUE (item) == NULL_TREE)
+ baseoff = TREE_PURPOSE (item);
+ else
+ baseoff = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+ TREE_PURPOSE (item),
+ ffecom_2 (MULT_EXPR,
+ ffecom_f2c_ftnlen_type_node,
+ TREE_VALUE (item),
+ baseoff));
+ }
+
+ /* backlist now dead, along with all TREE_PURPOSEs on it. */
+
+ baseoff = build_tree_list (NULL_TREE, baseoff);
+ TREE_CHAIN (baseoff) = list;
+
+ numelem = build_tree_list (NULL_TREE, numelem);
+ TREE_CHAIN (numelem) = baseoff;
+
+ numdim = build_tree_list (NULL_TREE, numdim);
+ TREE_CHAIN (numdim) = numelem;
+
+ yes = suspend_momentary ();
+
+ item = build_array_type (ffecom_f2c_ftnlen_type_node,
+ build_range_type (integer_type_node,
+ integer_zero_node,
+ build_int_2
+ ((int) ffesymbol_rank (s)
+ + 2, 0)));
+ list = build (CONSTRUCTOR, item, NULL_TREE, numdim);
+ TREE_CONSTANT (list) = 1;
+ TREE_STATIC (list) = 1;
+
+ var = ffecom_get_invented_identifier ("__g77_dims_%d", NULL,
+ mynumber++);
+ var = build_decl (VAR_DECL, var, item);
+ TREE_STATIC (var) = 1;
+ DECL_INITIAL (var) = error_mark_node;
+ var = start_decl (var, FALSE);
+ finish_decl (var, list, FALSE);
+
+ var = ffecom_1 (ADDR_EXPR, build_pointer_type (item), var);
+
+ resume_momentary (yes);
+
+ return var;
+ }
+}
+
+#endif
+/* Essentially does a "fold (build1 (code, type, node))" while checking
+ for certain housekeeping things.
+
+ NOTE: for building an ADDR_EXPR around a FUNCTION_DECL, use
+ ffecom_1_fn instead. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_1 (enum tree_code code, tree type, tree node)
+{
+ tree item;
+
+ if ((node == error_mark_node)
+ || (type == error_mark_node))
+ return error_mark_node;
+
+ if (code == ADDR_EXPR)
+ {
+ if (!mark_addressable (node))
+ assert ("can't mark_addressable this node!" == NULL);
+ }
+
+ switch (ffe_is_emulate_complex () ? code : NOP_EXPR)
+ {
+ tree realtype;
+
+ case REALPART_EXPR:
+ item = build (COMPONENT_REF, type, node, TYPE_FIELDS (TREE_TYPE (node)));
+ break;
+
+ case IMAGPART_EXPR:
+ item = build (COMPONENT_REF, type, node, TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (node))));
+ break;
+
+
+ case NEGATE_EXPR:
+ if (TREE_CODE (type) != RECORD_TYPE)
+ {
+ item = build1 (code, type, node);
+ break;
+ }
+ node = ffecom_stabilize_aggregate_ (node);
+ realtype = TREE_TYPE (TYPE_FIELDS (type));
+ item =
+ ffecom_2 (COMPLEX_EXPR, type,
+ ffecom_1 (NEGATE_EXPR, realtype,
+ ffecom_1 (REALPART_EXPR, realtype,
+ node)),
+ ffecom_1 (NEGATE_EXPR, realtype,
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node)));
+ break;
+
+ default:
+ item = build1 (code, type, node);
+ break;
+ }
+
+ if (TREE_SIDE_EFFECTS (node))
+ TREE_SIDE_EFFECTS (item) = 1;
+ if ((code == ADDR_EXPR) && staticp (node))
+ TREE_CONSTANT (item) = 1;
+ return fold (item);
+}
+#endif
+
+/* Like ffecom_1 (ADDR_EXPR, TREE_TYPE (node), node), except
+ handles TREE_CODE (node) == FUNCTION_DECL. In particular,
+ does not set TREE_ADDRESSABLE (because calling an inline
+ function does not mean the function needs to be separately
+ compiled). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_1_fn (tree node)
+{
+ tree item;
+ tree type;
+
+ if (node == error_mark_node)
+ return error_mark_node;
+
+ type = build_type_variant (TREE_TYPE (node),
+ TREE_READONLY (node),
+ TREE_THIS_VOLATILE (node));
+ item = build1 (ADDR_EXPR,
+ build_pointer_type (type), node);
+ if (TREE_SIDE_EFFECTS (node))
+ TREE_SIDE_EFFECTS (item) = 1;
+ if (staticp (node))
+ TREE_CONSTANT (item) = 1;
+ return fold (item);
+}
+#endif
+
+/* Essentially does a "fold (build (code, type, node1, node2))" while
+ checking for certain housekeeping things. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_2 (enum tree_code code, tree type, tree node1,
+ tree node2)
+{
+ tree item;
+
+ if ((node1 == error_mark_node)
+ || (node2 == error_mark_node)
+ || (type == error_mark_node))
+ return error_mark_node;
+
+ switch (ffe_is_emulate_complex () ? code : NOP_EXPR)
+ {
+ tree a, b, c, d, realtype;
+
+ case CONJ_EXPR:
+ assert ("no CONJ_EXPR support yet" == NULL);
+ return error_mark_node;
+
+ case COMPLEX_EXPR:
+ item = build_tree_list (TYPE_FIELDS (type), node1);
+ TREE_CHAIN (item) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), node2);
+ item = build (CONSTRUCTOR, type, NULL_TREE, item);
+ break;
+
+ case PLUS_EXPR:
+ if (TREE_CODE (type) != RECORD_TYPE)
+ {
+ item = build (code, type, node1, node2);
+ break;
+ }
+ node1 = ffecom_stabilize_aggregate_ (node1);
+ node2 = ffecom_stabilize_aggregate_ (node2);
+ realtype = TREE_TYPE (TYPE_FIELDS (type));
+ item =
+ ffecom_2 (COMPLEX_EXPR, type,
+ ffecom_2 (PLUS_EXPR, realtype,
+ ffecom_1 (REALPART_EXPR, realtype,
+ node1),
+ ffecom_1 (REALPART_EXPR, realtype,
+ node2)),
+ ffecom_2 (PLUS_EXPR, realtype,
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node1),
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node2)));
+ break;
+
+ case MINUS_EXPR:
+ if (TREE_CODE (type) != RECORD_TYPE)
+ {
+ item = build (code, type, node1, node2);
+ break;
+ }
+ node1 = ffecom_stabilize_aggregate_ (node1);
+ node2 = ffecom_stabilize_aggregate_ (node2);
+ realtype = TREE_TYPE (TYPE_FIELDS (type));
+ item =
+ ffecom_2 (COMPLEX_EXPR, type,
+ ffecom_2 (MINUS_EXPR, realtype,
+ ffecom_1 (REALPART_EXPR, realtype,
+ node1),
+ ffecom_1 (REALPART_EXPR, realtype,
+ node2)),
+ ffecom_2 (MINUS_EXPR, realtype,
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node1),
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node2)));
+ break;
+
+ case MULT_EXPR:
+ if (TREE_CODE (type) != RECORD_TYPE)
+ {
+ item = build (code, type, node1, node2);
+ break;
+ }
+ node1 = ffecom_stabilize_aggregate_ (node1);
+ node2 = ffecom_stabilize_aggregate_ (node2);
+ realtype = TREE_TYPE (TYPE_FIELDS (type));
+ a = save_expr (ffecom_1 (REALPART_EXPR, realtype,
+ node1));
+ b = save_expr (ffecom_1 (IMAGPART_EXPR, realtype,
+ node1));
+ c = save_expr (ffecom_1 (REALPART_EXPR, realtype,
+ node2));
+ d = save_expr (ffecom_1 (IMAGPART_EXPR, realtype,
+ node2));
+ item =
+ ffecom_2 (COMPLEX_EXPR, type,
+ ffecom_2 (MINUS_EXPR, realtype,
+ ffecom_2 (MULT_EXPR, realtype,
+ a,
+ c),
+ ffecom_2 (MULT_EXPR, realtype,
+ b,
+ d)),
+ ffecom_2 (PLUS_EXPR, realtype,
+ ffecom_2 (MULT_EXPR, realtype,
+ a,
+ d),
+ ffecom_2 (MULT_EXPR, realtype,
+ c,
+ b)));
+ break;
+
+ case EQ_EXPR:
+ if ((TREE_CODE (node1) != RECORD_TYPE)
+ && (TREE_CODE (node2) != RECORD_TYPE))
+ {
+ item = build (code, type, node1, node2);
+ break;
+ }
+ assert (TREE_CODE (node1) == RECORD_TYPE);
+ assert (TREE_CODE (node2) == RECORD_TYPE);
+ node1 = ffecom_stabilize_aggregate_ (node1);
+ node2 = ffecom_stabilize_aggregate_ (node2);
+ realtype = TREE_TYPE (TYPE_FIELDS (type));
+ item =
+ ffecom_2 (TRUTH_ANDIF_EXPR, type,
+ ffecom_2 (code, type,
+ ffecom_1 (REALPART_EXPR, realtype,
+ node1),
+ ffecom_1 (REALPART_EXPR, realtype,
+ node2)),
+ ffecom_2 (code, type,
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node1),
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node2)));
+ break;
+
+ case NE_EXPR:
+ if ((TREE_CODE (node1) != RECORD_TYPE)
+ && (TREE_CODE (node2) != RECORD_TYPE))
+ {
+ item = build (code, type, node1, node2);
+ break;
+ }
+ assert (TREE_CODE (node1) == RECORD_TYPE);
+ assert (TREE_CODE (node2) == RECORD_TYPE);
+ node1 = ffecom_stabilize_aggregate_ (node1);
+ node2 = ffecom_stabilize_aggregate_ (node2);
+ realtype = TREE_TYPE (TYPE_FIELDS (type));
+ item =
+ ffecom_2 (TRUTH_ORIF_EXPR, type,
+ ffecom_2 (code, type,
+ ffecom_1 (REALPART_EXPR, realtype,
+ node1),
+ ffecom_1 (REALPART_EXPR, realtype,
+ node2)),
+ ffecom_2 (code, type,
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node1),
+ ffecom_1 (IMAGPART_EXPR, realtype,
+ node2)));
+ break;
+
+ default:
+ item = build (code, type, node1, node2);
+ break;
+ }
+
+ if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2))
+ TREE_SIDE_EFFECTS (item) = 1;
+ return fold (item);
+}
+
+#endif
+/* ffecom_2pass_advise_entrypoint -- Advise that there's this entrypoint
+
+ ffesymbol s; // the ENTRY point itself
+ if (ffecom_2pass_advise_entrypoint(s))
+ // the ENTRY point has been accepted
+
+ Does whatever compiler needs to do when it learns about the entrypoint,
+ like determine the return type of the master function, count the
+ number of entrypoints, etc. Returns FALSE if the return type is
+ not compatible with the return type(s) of other entrypoint(s).
+
+ NOTE: for every call to this fn that returns TRUE, _do_entrypoint must
+ later (after _finish_progunit) be called with the same entrypoint(s)
+ as passed to this fn for which TRUE was returned.
+
+ 03-Jan-92 JCB 2.0
+ Return FALSE if the return type conflicts with previous entrypoints. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+bool
+ffecom_2pass_advise_entrypoint (ffesymbol entry)
+{
+ ffebld list; /* opITEM. */
+ ffebld mlist; /* opITEM. */
+ ffebld plist; /* opITEM. */
+ ffebld arg; /* ffebld_head(opITEM). */
+ ffebld item; /* opITEM. */
+ ffesymbol s; /* ffebld_symter(arg). */
+ ffeinfoBasictype bt = ffesymbol_basictype (entry);
+ ffeinfoKindtype kt = ffesymbol_kindtype (entry);
+ ffetargetCharacterSize size = ffesymbol_size (entry);
+ bool ok;
+
+ if (ffecom_num_entrypoints_ == 0)
+ { /* First entrypoint, make list of main
+ arglist's dummies. */
+ assert (ffecom_primary_entry_ != NULL);
+
+ ffecom_master_bt_ = ffesymbol_basictype (ffecom_primary_entry_);
+ ffecom_master_kt_ = ffesymbol_kindtype (ffecom_primary_entry_);
+ ffecom_master_size_ = ffesymbol_size (ffecom_primary_entry_);
+
+ for (plist = NULL, list = ffesymbol_dummyargs (ffecom_primary_entry_);
+ list != NULL;
+ list = ffebld_trail (list))
+ {
+ arg = ffebld_head (list);
+ if (ffebld_op (arg) != FFEBLD_opSYMTER)
+ continue; /* Alternate return or some such thing. */
+ item = ffebld_new_item (arg, NULL);
+ if (plist == NULL)
+ ffecom_master_arglist_ = item;
+ else
+ ffebld_set_trail (plist, item);
+ plist = item;
+ }
+ }
+
+ /* If necessary, scan entry arglist for alternate returns. Do this scan
+ apparently redundantly (it's done below to UNIONize the arglists) so
+ that we don't complain about RETURN 1 if an offending ENTRY is the only
+ one with an alternate return. */
+
+ if (!ffecom_is_altreturning_)
+ {
+ for (list = ffesymbol_dummyargs (entry);
+ list != NULL;
+ list = ffebld_trail (list))
+ {
+ arg = ffebld_head (list);
+ if (ffebld_op (arg) == FFEBLD_opSTAR)
+ {
+ ffecom_is_altreturning_ = TRUE;
+ break;
+ }
+ }
+ }
+
+ /* Now check type compatibility. */
+
+ switch (ffecom_master_bt_)
+ {
+ case FFEINFO_basictypeNONE:
+ ok = (bt != FFEINFO_basictypeCHARACTER);
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ ok
+ = (bt == FFEINFO_basictypeCHARACTER)
+ && (kt == ffecom_master_kt_)
+ && (size == ffecom_master_size_);
+ break;
+
+ case FFEINFO_basictypeANY:
+ return FALSE; /* Just don't bother. */
+
+ default:
+ if (bt == FFEINFO_basictypeCHARACTER)
+ {
+ ok = FALSE;
+ break;
+ }
+ ok = TRUE;
+ if ((bt != ffecom_master_bt_) || (kt != ffecom_master_kt_))
+ {
+ ffecom_master_bt_ = FFEINFO_basictypeNONE;
+ ffecom_master_kt_ = FFEINFO_kindtypeNONE;
+ }
+ break;
+ }
+
+ if (!ok)
+ {
+ ffebad_start (FFEBAD_ENTRY_CONFLICTS);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_finish ();
+ return FALSE; /* Can't handle entrypoint. */
+ }
+
+ /* Entrypoint type compatible with previous types. */
+
+ ++ffecom_num_entrypoints_;
+
+ /* Master-arg-list = UNION(Master-arg-list,entry-arg-list). */
+
+ for (list = ffesymbol_dummyargs (entry);
+ list != NULL;
+ list = ffebld_trail (list))
+ {
+ arg = ffebld_head (list);
+ if (ffebld_op (arg) != FFEBLD_opSYMTER)
+ continue; /* Alternate return or some such thing. */
+ s = ffebld_symter (arg);
+ for (plist = NULL, mlist = ffecom_master_arglist_;
+ mlist != NULL;
+ plist = mlist, mlist = ffebld_trail (mlist))
+ { /* plist points to previous item for easy
+ appending of arg. */
+ if (ffebld_symter (ffebld_head (mlist)) == s)
+ break; /* Already have this arg in the master list. */
+ }
+ if (mlist != NULL)
+ continue; /* Already have this arg in the master list. */
+
+ /* Append this arg to the master list. */
+
+ item = ffebld_new_item (arg, NULL);
+ if (plist == NULL)
+ ffecom_master_arglist_ = item;
+ else
+ ffebld_set_trail (plist, item);
+ }
+
+ return TRUE;
+}
+
+#endif
+/* ffecom_2pass_do_entrypoint -- Do compilation of entrypoint
+
+ ffesymbol s; // the ENTRY point itself
+ ffecom_2pass_do_entrypoint(s);
+
+ Does whatever compiler needs to do to make the entrypoint actually
+ happen. Must be called for each entrypoint after
+ ffecom_finish_progunit is called. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_2pass_do_entrypoint (ffesymbol entry)
+{
+ static int mfn_num = 0;
+ static int ent_num;
+
+ if (mfn_num != ffecom_num_fns_)
+ { /* First entrypoint for this program unit. */
+ ent_num = 1;
+ mfn_num = ffecom_num_fns_;
+ ffecom_do_entry_ (ffecom_primary_entry_, 0);
+ }
+ else
+ ++ent_num;
+
+ --ffecom_num_entrypoints_;
+
+ ffecom_do_entry_ (entry, ent_num);
+}
+
+#endif
+
+/* Essentially does a "fold (build (code, type, node1, node2))" while
+ checking for certain housekeeping things. Always sets
+ TREE_SIDE_EFFECTS. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_2s (enum tree_code code, tree type, tree node1,
+ tree node2)
+{
+ tree item;
+
+ if ((node1 == error_mark_node)
+ || (node2 == error_mark_node)
+ || (type == error_mark_node))
+ return error_mark_node;
+
+ item = build (code, type, node1, node2);
+ TREE_SIDE_EFFECTS (item) = 1;
+ return fold (item);
+}
+
+#endif
+/* Essentially does a "fold (build (code, type, node1, node2, node3))" while
+ checking for certain housekeeping things. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_3 (enum tree_code code, tree type, tree node1,
+ tree node2, tree node3)
+{
+ tree item;
+
+ if ((node1 == error_mark_node)
+ || (node2 == error_mark_node)
+ || (node3 == error_mark_node)
+ || (type == error_mark_node))
+ return error_mark_node;
+
+ item = build (code, type, node1, node2, node3);
+ if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2)
+ || (node3 != NULL_TREE && TREE_SIDE_EFFECTS (node3)))
+ TREE_SIDE_EFFECTS (item) = 1;
+ return fold (item);
+}
+
+#endif
+/* Essentially does a "fold (build (code, type, node1, node2, node3))" while
+ checking for certain housekeeping things. Always sets
+ TREE_SIDE_EFFECTS. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_3s (enum tree_code code, tree type, tree node1,
+ tree node2, tree node3)
+{
+ tree item;
+
+ if ((node1 == error_mark_node)
+ || (node2 == error_mark_node)
+ || (node3 == error_mark_node)
+ || (type == error_mark_node))
+ return error_mark_node;
+
+ item = build (code, type, node1, node2, node3);
+ TREE_SIDE_EFFECTS (item) = 1;
+ return fold (item);
+}
+
+#endif
+/* ffecom_arg_expr -- Transform argument expr into gcc tree
+
+ See use by ffecom_list_expr.
+
+ If expression is NULL, returns an integer zero tree. If it is not
+ a CHARACTER expression, returns whatever ffecom_expr
+ returns and sets the length return value to NULL_TREE. Otherwise
+ generates code to evaluate the character expression, returns the proper
+ pointer to the result, but does NOT set the length return value to a tree
+ that specifies the length of the result. (In other words, the length
+ variable is always set to NULL_TREE, because a length is never passed.)
+
+ 21-Dec-91 JCB 1.1
+ Don't set returned length, since nobody needs it (yet; someday if
+ we allow CHARACTER*(*) dummies to statement functions, we'll need
+ it). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_arg_expr (ffebld expr, tree *length)
+{
+ tree ign;
+
+ *length = NULL_TREE;
+
+ if (expr == NULL)
+ return integer_zero_node;
+
+ if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+ return ffecom_expr (expr);
+
+ return ffecom_arg_ptr_to_expr (expr, &ign);
+}
+
+#endif
+/* ffecom_arg_ptr_to_expr -- Transform argument expr into gcc tree
+
+ See use by ffecom_list_ptr_to_expr.
+
+ If expression is NULL, returns an integer zero tree. If it is not
+ a CHARACTER expression, returns whatever ffecom_ptr_to_expr
+ returns and sets the length return value to NULL_TREE. Otherwise
+ generates code to evaluate the character expression, returns the proper
+ pointer to the result, AND sets the length return value to a tree that
+ specifies the length of the result. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
+{
+ tree item;
+ tree ign_length;
+ ffecomConcatList_ catlist;
+
+ *length = NULL_TREE;
+
+ if (expr == NULL)
+ return integer_zero_node;
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opPERCENT_VAL:
+ if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+ return ffecom_expr (ffebld_left (expr));
+ {
+ tree temp_exp;
+ tree temp_length;
+
+ temp_exp = ffecom_arg_ptr_to_expr (ffebld_left (expr), &temp_length);
+ return ffecom_1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (temp_exp)),
+ temp_exp);
+ }
+
+ case FFEBLD_opPERCENT_REF:
+ if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+ return ffecom_ptr_to_expr (ffebld_left (expr));
+ ign_length = NULL_TREE;
+ length = &ign_length;
+ expr = ffebld_left (expr);
+ break;
+
+ case FFEBLD_opPERCENT_DESCR:
+ switch (ffeinfo_basictype (ffebld_info (expr)))
+ {
+#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
+ case FFEINFO_basictypeHOLLERITH:
+#endif
+ case FFEINFO_basictypeCHARACTER:
+ break; /* Passed by descriptor anyway. */
+
+ default:
+ item = ffecom_ptr_to_expr (expr);
+ if (item != error_mark_node)
+ *length = TYPE_SIZE (TREE_TYPE (TREE_TYPE (item)));
+ break;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
+ if (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH)
+ { /* Pass Hollerith by descriptor. */
+ ffetargetHollerith h;
+
+ assert (ffebld_op (expr) == FFEBLD_opCONTER);
+ h = ffebld_cu_val_hollerith (ffebld_constant_union
+ (ffebld_conter (expr)));
+ *length
+ = build_int_2 (h.length, 0);
+ TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+ }
+#endif
+
+ if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+ return ffecom_ptr_to_expr (expr);
+
+ assert (ffeinfo_kindtype (ffebld_info (expr))
+ == FFEINFO_kindtypeCHARACTER1);
+
+ catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE);
+ switch (ffecom_concat_list_count_ (catlist))
+ {
+ case 0: /* Shouldn't happen, but in case it does... */
+ *length = ffecom_f2c_ftnlen_zero_node;
+ TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+ ffecom_concat_list_kill_ (catlist);
+ return null_pointer_node;
+
+ case 1: /* The (fairly) easy case. */
+ ffecom_char_args_ (&item, length,
+ ffecom_concat_list_expr_ (catlist, 0));
+ ffecom_concat_list_kill_ (catlist);
+ assert (item != NULL_TREE);
+ return item;
+
+ default: /* Must actually concatenate things. */
+ break;
+ }
+
+ {
+ int count = ffecom_concat_list_count_ (catlist);
+ int i;
+ tree lengths;
+ tree items;
+ tree length_array;
+ tree item_array;
+ tree citem;
+ tree clength;
+ tree temporary;
+ tree num;
+ tree known_length;
+ ffetargetCharacterSize sz;
+
+ length_array
+ = lengths
+ = ffecom_push_tempvar (ffecom_f2c_ftnlen_type_node,
+ FFETARGET_charactersizeNONE, count, TRUE);
+ item_array
+ = items
+ = ffecom_push_tempvar (ffecom_f2c_address_type_node,
+ FFETARGET_charactersizeNONE, count, TRUE);
+
+ known_length = ffecom_f2c_ftnlen_zero_node;
+
+ for (i = 0; i < count; ++i)
+ {
+ ffecom_char_args_ (&citem, &clength,
+ ffecom_concat_list_expr_ (catlist, i));
+ if ((citem == error_mark_node)
+ || (clength == error_mark_node))
+ {
+ ffecom_concat_list_kill_ (catlist);
+ *length = error_mark_node;
+ return error_mark_node;
+ }
+
+ items
+ = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items),
+ ffecom_modify (void_type_node,
+ ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))),
+ item_array,
+ build_int_2 (i, 0)),
+ citem),
+ items);
+ clength = ffecom_save_tree (clength);
+ known_length
+ = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+ known_length,
+ clength);
+ lengths
+ = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths),
+ ffecom_modify (void_type_node,
+ ffecom_2 (ARRAY_REF,
+ TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))),
+ length_array,
+ build_int_2 (i, 0)),
+ clength),
+ lengths);
+ }
+
+ sz = ffecom_concat_list_maxlen_ (catlist);
+ assert (sz != FFETARGET_charactersizeNONE);
+
+ temporary = ffecom_push_tempvar (char_type_node,
+ sz, -1, TRUE);
+ temporary = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (temporary)),
+ temporary);
+
+ item = build_tree_list (NULL_TREE, temporary);
+ TREE_CHAIN (item)
+ = build_tree_list (NULL_TREE,
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (items)),
+ items));
+ TREE_CHAIN (TREE_CHAIN (item))
+ = build_tree_list (NULL_TREE,
+ ffecom_1 (ADDR_EXPR,
+ build_pointer_type (TREE_TYPE (lengths)),
+ lengths));
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item)))
+ = build_tree_list
+ (NULL_TREE,
+ ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+ convert (ffecom_f2c_ftnlen_type_node,
+ build_int_2 (count, 0))));
+ num = build_int_2 (sz, 0);
+ TREE_TYPE (num) = ffecom_f2c_ftnlen_type_node;
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item))))
+ = build_tree_list (NULL_TREE, num);
+
+ item = ffecom_call_gfrt (FFECOM_gfrtCAT, item);
+ TREE_SIDE_EFFECTS (item) = 1;
+ item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (temporary),
+ item,
+ temporary);
+
+ *length = known_length;
+ }
+
+ ffecom_concat_list_kill_ (catlist);
+ assert (item != NULL_TREE);
+ return item;
+}
+
+#endif
+/* ffecom_call_gfrt -- Generate call to run-time function
+
+ tree expr;
+ expr = ffecom_call_gfrt(FFECOM_gfrtSTOPNIL,NULL_TREE);
+
+ The first arg is the GNU Fortran Run-Time function index, the second
+ arg is the list of arguments to pass to it. Returned is the expression
+ (WITHOUT TREE_SIDE_EFFECTS set!) that makes the call and returns the
+ result (which may be void). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_call_gfrt (ffecomGfrt ix, tree args)
+{
+ return ffecom_call_ (ffecom_gfrt_tree_ (ix),
+ ffecom_gfrt_kindtype (ix),
+ ffe_is_f2c_library () && ffecom_gfrt_complex_[ix],
+ NULL_TREE, args, NULL_TREE, NULL,
+ NULL, NULL_TREE, TRUE);
+}
+#endif
+
+/* ffecom_constantunion -- Transform constant-union to tree
+
+ ffebldConstantUnion cu; // the constant to transform
+ ffeinfoBasictype bt; // its basic type
+ ffeinfoKindtype kt; // its kind type
+ tree tree_type; // ffecom_tree_type[bt][kt]
+ ffecom_constantunion(&cu,bt,kt,tree_type); */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, tree tree_type)
+{
+ tree item;
+
+ switch (bt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ {
+ int val;
+
+ switch (kt)
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ val = ffebld_cu_val_integer1 (*cu);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ val = ffebld_cu_val_integer2 (*cu);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ val = ffebld_cu_val_integer3 (*cu);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ val = ffebld_cu_val_integer4 (*cu);
+ break;
+#endif
+
+ default:
+ assert ("bad INTEGER constant kind type" == NULL);
+ /* Fall through. */
+ case FFEINFO_kindtypeANY:
+ return error_mark_node;
+ }
+ item = build_int_2 (val, (val < 0) ? -1 : 0);
+ TREE_TYPE (item) = tree_type;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ {
+ int val;
+
+ switch (kt)
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ val = ffebld_cu_val_logical1 (*cu);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ val = ffebld_cu_val_logical2 (*cu);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ val = ffebld_cu_val_logical3 (*cu);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ val = ffebld_cu_val_logical4 (*cu);
+ break;
+#endif
+
+ default:
+ assert ("bad LOGICAL constant kind type" == NULL);
+ /* Fall through. */
+ case FFEINFO_kindtypeANY:
+ return error_mark_node;
+ }
+ item = build_int_2 (val, (val < 0) ? -1 : 0);
+ TREE_TYPE (item) = tree_type;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ {
+ REAL_VALUE_TYPE val;
+
+ switch (kt)
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ val = ffetarget_value_real1 (ffebld_cu_val_real1 (*cu));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ val = ffetarget_value_real2 (ffebld_cu_val_real2 (*cu));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ val = ffetarget_value_real3 (ffebld_cu_val_real3 (*cu));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ val = ffetarget_value_real4 (ffebld_cu_val_real4 (*cu));
+ break;
+#endif
+
+ default:
+ assert ("bad REAL constant kind type" == NULL);
+ /* Fall through. */
+ case FFEINFO_kindtypeANY:
+ return error_mark_node;
+ }
+ item = build_real (tree_type, val);
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ {
+ REAL_VALUE_TYPE real;
+ REAL_VALUE_TYPE imag;
+ tree el_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
+
+ switch (kt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ real = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).real);
+ imag = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).imaginary);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ real = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).real);
+ imag = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).imaginary);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ real = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).real);
+ imag = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).imaginary);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ real = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).real);
+ imag = ffetarget_value_real4 (ffebld_cu_val_complex4 (*cu).imaginary);
+ break;
+#endif
+
+ default:
+ assert ("bad REAL constant kind type" == NULL);
+ /* Fall through. */
+ case FFEINFO_kindtypeANY:
+ return error_mark_node;
+ }
+ item = ffecom_build_complex_constant_ (tree_type,
+ build_real (el_type, real),
+ build_real (el_type, imag));
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ { /* Happens only in DATA and similar contexts. */
+ ffetargetCharacter1 val;
+
+ switch (kt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeLOGICAL1:
+ val = ffebld_cu_val_character1 (*cu);
+ break;
+#endif
+
+ default:
+ assert ("bad CHARACTER constant kind type" == NULL);
+ /* Fall through. */
+ case FFEINFO_kindtypeANY:
+ return error_mark_node;
+ }
+ item = build_string (ffetarget_length_character1 (val),
+ ffetarget_text_character1 (val));
+ TREE_TYPE (item)
+ = build_type_variant (build_array_type (char_type_node,
+ build_range_type
+ (integer_type_node,
+ integer_one_node,
+ build_int_2
+ (ffetarget_length_character1
+ (val), 0))),
+ 1, 0);
+ }
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ {
+ ffetargetHollerith h;
+
+ h = ffebld_cu_val_hollerith (*cu);
+
+ /* If not at least as wide as default INTEGER, widen it. */
+ if (h.length >= FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE)
+ item = build_string (h.length, h.text);
+ else
+ {
+ char str[FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE];
+
+ memcpy (str, h.text, h.length);
+ memset (&str[h.length], ' ',
+ FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE
+ - h.length);
+ item = build_string (FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE,
+ str);
+ }
+ TREE_TYPE (item)
+ = build_type_variant (build_array_type (char_type_node,
+ build_range_type
+ (integer_type_node,
+ integer_one_node,
+ build_int_2
+ (h.length, 0))),
+ 1, 0);
+ }
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ {
+ ffetargetInteger1 ival;
+ ffetargetTypeless tless;
+ ffebad error;
+
+ tless = ffebld_cu_val_typeless (*cu);
+ error = ffetarget_convert_integer1_typeless (&ival, tless);
+ assert (error == FFEBAD);
+
+ item = build_int_2 ((int) ival, 0);
+ }
+ break;
+
+ default:
+ assert ("not yet on constant type" == NULL);
+ /* Fall through. */
+ case FFEINFO_basictypeANY:
+ return error_mark_node;
+ }
+
+ TREE_CONSTANT (item) = 1;
+
+ return item;
+}
+
+#endif
+
+/* Handy way to make a field in a struct/union. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_decl_field (tree context, tree prevfield,
+ char *name, tree type)
+{
+ tree field;
+
+ field = build_decl (FIELD_DECL, get_identifier (name), type);
+ DECL_CONTEXT (field) = context;
+ DECL_FRAME_SIZE (field) = 0;
+ if (prevfield != NULL_TREE)
+ TREE_CHAIN (prevfield) = field;
+
+ return field;
+}
+
+#endif
+
+void
+ffecom_close_include (FILE *f)
+{
+#if FFECOM_GCC_INCLUDE
+ ffecom_close_include_ (f);
+#endif
+}
+
+int
+ffecom_decode_include_option (char *spec)
+{
+#if FFECOM_GCC_INCLUDE
+ return ffecom_decode_include_option_ (spec);
+#else
+ return 1;
+#endif
+}
+
+/* ffecom_end_transition -- Perform end transition on all symbols
+
+ ffecom_end_transition();
+
+ Calls ffecom_sym_end_transition for each global and local symbol. */
+
+void
+ffecom_end_transition ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffebld item;
+#endif
+
+ if (ffe_is_ffedebug ())
+ fprintf (dmpout, "; end_stmt_transition\n");
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffecom_list_blockdata_ = NULL;
+ ffecom_list_common_ = NULL;
+#endif
+
+ ffesymbol_drive (ffecom_sym_end_transition);
+ if (ffe_is_ffedebug ())
+ {
+ ffestorag_report ();
+ ffesymbol_report_all ();
+ }
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffecom_start_progunit_ ();
+
+ for (item = ffecom_list_blockdata_;
+ item != NULL;
+ item = ffebld_trail (item))
+ {
+ ffebld callee;
+ ffesymbol s;
+ tree dt;
+ tree t;
+ tree var;
+ int yes;
+ static int number = 0;
+
+ callee = ffebld_head (item);
+ s = ffebld_symter (callee);
+ t = ffesymbol_hook (s).decl_tree;
+ if (t == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ t = ffesymbol_hook (s).decl_tree;
+ }
+
+ yes = suspend_momentary ();
+
+ dt = build_pointer_type (TREE_TYPE (t));
+
+ var = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_forceload_%d",
+ NULL, number++),
+ dt);
+ DECL_EXTERNAL (var) = 0;
+ TREE_STATIC (var) = 1;
+ TREE_PUBLIC (var) = 0;
+ DECL_INITIAL (var) = error_mark_node;
+ TREE_USED (var) = 1;
+
+ var = start_decl (var, FALSE);
+
+ t = ffecom_1 (ADDR_EXPR, dt, t);
+
+ finish_decl (var, t, FALSE);
+
+ resume_momentary (yes);
+ }
+
+ /* This handles any COMMON areas that weren't referenced but have, for
+ example, important initial data. */
+
+ for (item = ffecom_list_common_;
+ item != NULL;
+ item = ffebld_trail (item))
+ ffecom_transform_common_ (ffebld_symter (ffebld_head (item)));
+
+ ffecom_list_common_ = NULL;
+#endif
+}
+
+/* ffecom_exec_transition -- Perform exec transition on all symbols
+
+ ffecom_exec_transition();
+
+ Calls ffecom_sym_exec_transition for each global and local symbol.
+ Make sure error updating not inhibited. */
+
+void
+ffecom_exec_transition ()
+{
+ bool inhibited;
+
+ if (ffe_is_ffedebug ())
+ fprintf (dmpout, "; exec_stmt_transition\n");
+
+ inhibited = ffebad_inhibit ();
+ ffebad_set_inhibit (FALSE);
+
+ ffesymbol_drive (ffecom_sym_exec_transition); /* Don't retract! */
+ ffeequiv_exec_transition (); /* Handle all pending EQUIVALENCEs. */
+ if (ffe_is_ffedebug ())
+ {
+ ffestorag_report ();
+ ffesymbol_report_all ();
+ }
+
+ if (inhibited)
+ ffebad_set_inhibit (TRUE);
+}
+
+/* ffecom_expand_let_stmt -- Compile let (assignment) statement
+
+ ffebld dest;
+ ffebld source;
+ ffecom_expand_let_stmt(dest,source);
+
+ Convert dest and source using ffecom_expr, then join them
+ with an ASSIGN op and pass the whole thing to expand_expr_stmt. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_expand_let_stmt (ffebld dest, ffebld source)
+{
+ tree dest_tree;
+ tree dest_length;
+ tree source_tree;
+ tree expr_tree;
+
+ if (ffeinfo_basictype (ffebld_info (dest)) != FFEINFO_basictypeCHARACTER)
+ {
+ bool dest_used;
+
+ dest_tree = ffecom_expr_rw (dest);
+ if (dest_tree == error_mark_node)
+ return;
+
+ if ((TREE_CODE (dest_tree) != VAR_DECL)
+ || TREE_ADDRESSABLE (dest_tree))
+ source_tree = ffecom_expr_ (source, dest_tree, dest,
+ &dest_used, FALSE);
+ else
+ {
+ source_tree = ffecom_expr (source);
+ dest_used = FALSE;
+ }
+ if (source_tree == error_mark_node)
+ return;
+
+ if (dest_used)
+ expr_tree = source_tree;
+ else
+ expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
+ dest_tree,
+ source_tree);
+
+ expand_expr_stmt (expr_tree);
+ return;
+ }
+
+ ffecom_push_calltemps ();
+ ffecom_char_args_ (&dest_tree, &dest_length, dest);
+ ffecom_let_char_ (dest_tree, dest_length, ffebld_size_known (dest),
+ source);
+ ffecom_pop_calltemps ();
+}
+
+#endif
+/* ffecom_expr -- Transform expr into gcc tree
+
+ tree t;
+ ffebld expr; // FFE expression.
+ tree = ffecom_expr(expr);
+
+ Recursive descent on expr while making corresponding tree nodes and
+ attaching type info and such. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr (ffebld expr)
+{
+ return ffecom_expr_ (expr, NULL_TREE, NULL, NULL,
+ FALSE);
+}
+
+#endif
+/* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr_assign (ffebld expr)
+{
+ return ffecom_expr_ (expr, NULL_TREE, NULL, NULL,
+ TRUE);
+}
+
+#endif
+/* Like ffecom_expr_rw, but return tree usable for ASSIGN. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr_assign_w (ffebld expr)
+{
+ return ffecom_expr_ (expr, NULL_TREE, NULL, NULL,
+ TRUE);
+}
+
+#endif
+/* Transform expr for use as into read/write tree and stabilize the
+ reference. Not for use on CHARACTER expressions.
+
+ Recursive descent on expr while making corresponding tree nodes and
+ attaching type info and such. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_expr_rw (ffebld expr)
+{
+ assert (expr != NULL);
+
+ return stabilize_reference (ffecom_expr (expr));
+}
+
+#endif
+/* Do global stuff. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_finish_compile ()
+{
+ assert (ffecom_outer_function_decl_ == NULL_TREE);
+ assert (current_function_decl == NULL_TREE);
+
+ ffeglobal_drive (ffecom_finish_global_);
+}
+
+#endif
+/* Public entry point for front end to access finish_decl. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_finish_decl (tree decl, tree init, bool is_top_level)
+{
+ assert (!is_top_level);
+ finish_decl (decl, init, FALSE);
+}
+
+#endif
+/* Finish a program unit. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_finish_progunit ()
+{
+ ffecom_end_compstmt_ ();
+
+ ffecom_previous_function_decl_ = current_function_decl;
+ ffecom_which_entrypoint_decl_ = NULL_TREE;
+
+ finish_function (0);
+}
+
+#endif
+/* Wrapper for get_identifier. pattern is like "...%s...", text is
+ inserted into final name in place of "%s", or if text is NULL,
+ pattern is like "...%d..." and text form of number is inserted
+ in place of "%d". */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_get_invented_identifier (char *pattern, char *text, int number)
+{
+ tree decl;
+ char *nam;
+ mallocSize lenlen;
+ char space[66];
+
+ if (text == NULL)
+ lenlen = strlen (pattern) + 20;
+ else
+ lenlen = strlen (pattern) + strlen (text) - 1;
+ if (lenlen > ARRAY_SIZE (space))
+ nam = malloc_new_ks (malloc_pool_image (), pattern, lenlen);
+ else
+ nam = &space[0];
+ if (text == NULL)
+ sprintf (&nam[0], pattern, number);
+ else
+ sprintf (&nam[0], pattern, text);
+ decl = get_identifier (nam);
+ if (lenlen > ARRAY_SIZE (space))
+ malloc_kill_ks (malloc_pool_image (), nam, lenlen);
+
+ IDENTIFIER_INVENTED (decl) = 1;
+
+ return decl;
+}
+
+ffeinfoBasictype
+ffecom_gfrt_basictype (ffecomGfrt gfrt)
+{
+ assert (gfrt < FFECOM_gfrt);
+
+ switch (ffecom_gfrt_type_[gfrt])
+ {
+ case FFECOM_rttypeVOID_:
+ return FFEINFO_basictypeNONE;
+
+ case FFECOM_rttypeINT_:
+ return FFEINFO_basictypeINTEGER;
+
+ case FFECOM_rttypeINTEGER_:
+ return FFEINFO_basictypeINTEGER;
+
+ case FFECOM_rttypeLONGINT_:
+ return FFEINFO_basictypeINTEGER;
+
+ case FFECOM_rttypeLOGICAL_:
+ return FFEINFO_basictypeLOGICAL;
+
+ case FFECOM_rttypeREAL_F2C_:
+ case FFECOM_rttypeREAL_GNU_:
+ return FFEINFO_basictypeREAL;
+
+ case FFECOM_rttypeCOMPLEX_F2C_:
+ case FFECOM_rttypeCOMPLEX_GNU_:
+ return FFEINFO_basictypeCOMPLEX;
+
+ case FFECOM_rttypeDOUBLE_:
+ return FFEINFO_basictypeREAL;
+
+ case FFECOM_rttypeDBLCMPLX_F2C_:
+ case FFECOM_rttypeDBLCMPLX_GNU_:
+ return FFEINFO_basictypeCOMPLEX;
+
+ case FFECOM_rttypeCHARACTER_:
+ return FFEINFO_basictypeCHARACTER;
+
+ default:
+ return FFEINFO_basictypeANY;
+ }
+}
+
+ffeinfoKindtype
+ffecom_gfrt_kindtype (ffecomGfrt gfrt)
+{
+ assert (gfrt < FFECOM_gfrt);
+
+ switch (ffecom_gfrt_type_[gfrt])
+ {
+ case FFECOM_rttypeVOID_:
+ return FFEINFO_kindtypeNONE;
+
+ case FFECOM_rttypeINT_:
+ return FFEINFO_kindtypeINTEGER1;
+
+ case FFECOM_rttypeINTEGER_:
+ return FFEINFO_kindtypeINTEGER1;
+
+ case FFECOM_rttypeLONGINT_:
+ return FFEINFO_kindtypeINTEGER4;
+
+ case FFECOM_rttypeLOGICAL_:
+ return FFEINFO_kindtypeLOGICAL1;
+
+ case FFECOM_rttypeREAL_F2C_:
+ case FFECOM_rttypeREAL_GNU_:
+ return FFEINFO_kindtypeREAL1;
+
+ case FFECOM_rttypeCOMPLEX_F2C_:
+ case FFECOM_rttypeCOMPLEX_GNU_:
+ return FFEINFO_kindtypeREAL1;
+
+ case FFECOM_rttypeDOUBLE_:
+ return FFEINFO_kindtypeREAL2;
+
+ case FFECOM_rttypeDBLCMPLX_F2C_:
+ case FFECOM_rttypeDBLCMPLX_GNU_:
+ return FFEINFO_kindtypeREAL2;
+
+ case FFECOM_rttypeCHARACTER_:
+ return FFEINFO_kindtypeCHARACTER1;
+
+ default:
+ return FFEINFO_kindtypeANY;
+ }
+}
+
+void
+ffecom_init_0 ()
+{
+ tree endlink;
+ int i;
+ int j;
+ tree t;
+ tree field;
+ ffetype type;
+ ffetype base_type;
+
+ /* This block of code comes from the now-obsolete cktyps.c. It checks
+ whether the compiler environment is buggy in known ways, some of which
+ would, if not explicitly checked here, result in subtle bugs in g77. */
+
+ if (ffe_is_do_internal_checks ())
+ {
+ static char names[][12]
+ =
+ {"bar", "bletch", "foo", "foobar"};
+ char *name;
+ unsigned long ul;
+ double fl;
+
+ name = bsearch ("foo", &names[0], ARRAY_SIZE (names), sizeof (names[0]),
+ (int (*)()) strcmp);
+ if (name != (char *) &names[2])
+ {
+ assert ("bsearch doesn't work, #define FFEPROJ_BSEARCH 0 in proj.h"
+ == NULL);
+ abort ();
+ }
+
+ ul = strtoul ("123456789", NULL, 10);
+ if (ul != 123456789L)
+ {
+ assert ("strtoul doesn't have enough range, #define FFEPROJ_STRTOUL 0\
+ in proj.h" == NULL);
+ abort ();
+ }
+
+ fl = atof ("56.789");
+ if ((fl < 56.788) || (fl > 56.79))
+ {
+ assert ("atof not type double, fix your #include <stdio.h>"
+ == NULL);
+ abort ();
+ }
+ }
+
+#if FFECOM_GCC_INCLUDE
+ ffecom_initialize_char_syntax_ ();
+#endif
+
+ ffecom_outer_function_decl_ = NULL_TREE;
+ current_function_decl = NULL_TREE;
+ named_labels = NULL_TREE;
+ current_binding_level = NULL_BINDING_LEVEL;
+ free_binding_level = NULL_BINDING_LEVEL;
+ pushlevel (0); /* make the binding_level structure for
+ global names */
+ global_binding_level = current_binding_level;
+
+ /* Define `int' and `char' first so that dbx will output them first. */
+
+ integer_type_node = make_signed_type (INT_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("int"),
+ integer_type_node));
+
+ char_type_node = make_unsigned_type (CHAR_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("char"),
+ char_type_node));
+
+ long_integer_type_node = make_signed_type (LONG_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("long int"),
+ long_integer_type_node));
+
+ unsigned_type_node = make_unsigned_type (INT_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"),
+ unsigned_type_node));
+
+ long_unsigned_type_node = make_unsigned_type (LONG_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("long unsigned int"),
+ long_unsigned_type_node));
+
+ long_long_integer_type_node = make_signed_type (LONG_LONG_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("long long int"),
+ long_long_integer_type_node));
+
+ long_long_unsigned_type_node = make_unsigned_type (LONG_LONG_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("long long unsigned int"),
+ long_long_unsigned_type_node));
+
+ sizetype
+ = TREE_TYPE (IDENTIFIER_GLOBAL_VALUE (get_identifier (SIZE_TYPE)));
+
+ TREE_TYPE (TYPE_SIZE (integer_type_node)) = sizetype;
+ TREE_TYPE (TYPE_SIZE (char_type_node)) = sizetype;
+ TREE_TYPE (TYPE_SIZE (unsigned_type_node)) = sizetype;
+ TREE_TYPE (TYPE_SIZE (long_unsigned_type_node)) = sizetype;
+ TREE_TYPE (TYPE_SIZE (long_integer_type_node)) = sizetype;
+ TREE_TYPE (TYPE_SIZE (long_long_integer_type_node)) = sizetype;
+ TREE_TYPE (TYPE_SIZE (long_long_unsigned_type_node)) = sizetype;
+
+ error_mark_node = make_node (ERROR_MARK);
+ TREE_TYPE (error_mark_node) = error_mark_node;
+
+ short_integer_type_node = make_signed_type (SHORT_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("short int"),
+ short_integer_type_node));
+
+ short_unsigned_type_node = make_unsigned_type (SHORT_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("short unsigned int"),
+ short_unsigned_type_node));
+
+ /* Define both `signed char' and `unsigned char'. */
+ signed_char_type_node = make_signed_type (CHAR_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("signed char"),
+ signed_char_type_node));
+
+ unsigned_char_type_node = make_unsigned_type (CHAR_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
+ unsigned_char_type_node));
+
+ float_type_node = make_node (REAL_TYPE);
+ TYPE_PRECISION (float_type_node) = FLOAT_TYPE_SIZE;
+ layout_type (float_type_node);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("float"),
+ float_type_node));
+
+ double_type_node = make_node (REAL_TYPE);
+ TYPE_PRECISION (double_type_node) = DOUBLE_TYPE_SIZE;
+ layout_type (double_type_node);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("double"),
+ double_type_node));
+
+ long_double_type_node = make_node (REAL_TYPE);
+ TYPE_PRECISION (long_double_type_node) = LONG_DOUBLE_TYPE_SIZE;
+ layout_type (long_double_type_node);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("long double"),
+ long_double_type_node));
+
+ complex_integer_type_node = ffecom_make_complex_type_ (integer_type_node);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("complex int"),
+ complex_integer_type_node));
+
+ complex_float_type_node = ffecom_make_complex_type_ (float_type_node);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("complex float"),
+ complex_float_type_node));
+
+ complex_double_type_node = ffecom_make_complex_type_ (double_type_node);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("complex double"),
+ complex_double_type_node));
+
+ complex_long_double_type_node = ffecom_make_complex_type_ (long_double_type_node);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("complex long double"),
+ complex_long_double_type_node));
+
+ integer_zero_node = build_int_2 (0, 0);
+ TREE_TYPE (integer_zero_node) = integer_type_node;
+ integer_one_node = build_int_2 (1, 0);
+ TREE_TYPE (integer_one_node) = integer_type_node;
+
+ size_zero_node = build_int_2 (0, 0);
+ TREE_TYPE (size_zero_node) = sizetype;
+ size_one_node = build_int_2 (1, 0);
+ TREE_TYPE (size_one_node) = sizetype;
+
+ void_type_node = make_node (VOID_TYPE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
+ void_type_node));
+ layout_type (void_type_node); /* Uses integer_zero_node */
+ /* We are not going to have real types in C with less than byte alignment,
+ so we might as well not have any types that claim to have it. */
+ TYPE_ALIGN (void_type_node) = BITS_PER_UNIT;
+
+ null_pointer_node = build_int_2 (0, 0);
+ TREE_TYPE (null_pointer_node) = build_pointer_type (void_type_node);
+ layout_type (TREE_TYPE (null_pointer_node));
+
+ string_type_node = build_pointer_type (char_type_node);
+
+ ffecom_tree_fun_type_void
+ = build_function_type (void_type_node, NULL_TREE);
+
+ ffecom_tree_ptr_to_fun_type_void
+ = build_pointer_type (ffecom_tree_fun_type_void);
+
+ endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+
+ float_ftype_float
+ = build_function_type (float_type_node,
+ tree_cons (NULL_TREE, float_type_node, endlink));
+
+ double_ftype_double
+ = build_function_type (double_type_node,
+ tree_cons (NULL_TREE, double_type_node, endlink));
+
+ ldouble_ftype_ldouble
+ = build_function_type (long_double_type_node,
+ tree_cons (NULL_TREE, long_double_type_node,
+ endlink));
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
+ for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+ {
+ ffecom_tree_type[i][j] = NULL_TREE;
+ ffecom_tree_fun_type[i][j] = NULL_TREE;
+ ffecom_tree_ptr_to_fun_type[i][j] = NULL_TREE;
+ ffecom_f2c_typecode_[i][j] = -1;
+ }
+
+ /* Set up standard g77 types. Note that INTEGER and LOGICAL are set
+ to size FLOAT_TYPE_SIZE because they have to be the same size as
+ REAL, which also is FLOAT_TYPE_SIZE, according to the standard.
+ Compiler options and other such stuff that change the ways these
+ types are set should not affect this particular setup. */
+
+ ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1]
+ = t = make_signed_type (FLOAT_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
+ t));
+ type = ffetype_new ();
+ base_type = type;
+ ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 1, type);
+ assert (ffetype_size (type) == sizeof (ffetargetInteger1));
+
+ ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER1]
+ = t = make_unsigned_type (FLOAT_TYPE_SIZE); /* HOLLERITH means unsigned. */
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned"),
+ t));
+
+ ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER2]
+ = t = make_signed_type (CHAR_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("byte"),
+ t));
+ type = ffetype_new ();
+ ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 3, type);
+ assert (ffetype_size (type) == sizeof (ffetargetInteger2));
+
+ ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER2]
+ = t = make_unsigned_type (CHAR_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned byte"),
+ t));
+
+ ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER3]
+ = t = make_signed_type (CHAR_TYPE_SIZE * 2);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("word"),
+ t));
+ type = ffetype_new ();
+ ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 6, type);
+ assert (ffetype_size (type) == sizeof (ffetargetInteger3));
+
+ ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER3]
+ = t = make_unsigned_type (CHAR_TYPE_SIZE * 2);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned word"),
+ t));
+
+ ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER4]
+ = t = make_signed_type (FLOAT_TYPE_SIZE * 2);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("integer4"),
+ t));
+ type = ffetype_new ();
+ ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 2, type);
+ assert (ffetype_size (type) == sizeof (ffetargetInteger4));
+
+ ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER4]
+ = t = make_unsigned_type (FLOAT_TYPE_SIZE * 2);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned4"),
+ t));
+
+#if 0
+ if (ffe_is_do_internal_checks ()
+ && LONG_TYPE_SIZE != FLOAT_TYPE_SIZE
+ && LONG_TYPE_SIZE != CHAR_TYPE_SIZE
+ && LONG_TYPE_SIZE != SHORT_TYPE_SIZE
+ && LONG_TYPE_SIZE != LONG_LONG_TYPE_SIZE)
+ {
+ fprintf (stderr, "Sorry, no g77 support for LONG_TYPE_SIZE (%d bits) yet.\n",
+ LONG_TYPE_SIZE);
+ }
+#endif
+
+ ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL1]
+ = t = make_signed_type (FLOAT_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("logical"),
+ t));
+ type = ffetype_new ();
+ base_type = type;
+ ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 1, type);
+ assert (ffetype_size (type) == sizeof (ffetargetLogical1));
+
+ ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL2]
+ = t = make_signed_type (CHAR_TYPE_SIZE);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("logical2"),
+ t));
+ type = ffetype_new ();
+ ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 3, type);
+ assert (ffetype_size (type) == sizeof (ffetargetLogical2));
+
+ ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL3]
+ = t = make_signed_type (CHAR_TYPE_SIZE * 2);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("logical3"),
+ t));
+ type = ffetype_new ();
+ ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 6, type);
+ assert (ffetype_size (type) == sizeof (ffetargetLogical3));
+
+ ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL4]
+ = t = make_signed_type (FLOAT_TYPE_SIZE * 2);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("logical4"),
+ t));
+ type = ffetype_new ();
+ ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 2, type);
+ assert (ffetype_size (type) == sizeof (ffetargetLogical4));
+
+ ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]
+ = t = make_node (REAL_TYPE);
+ TYPE_PRECISION (t) = FLOAT_TYPE_SIZE;
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("real"),
+ t));
+ layout_type (t);
+ type = ffetype_new ();
+ base_type = type;
+ ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 1, type);
+ ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]
+ = FFETARGET_f2cTYREAL;
+ assert (ffetype_size (type) == sizeof (ffetargetReal1));
+
+ ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREALDOUBLE]
+ = t = make_node (REAL_TYPE);
+ TYPE_PRECISION (t) = FLOAT_TYPE_SIZE * 2; /* Always twice REAL. */
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("double precision"),
+ t));
+ layout_type (t);
+ type = ffetype_new ();
+ ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALDOUBLE,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 2, type);
+ ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]
+ = FFETARGET_f2cTYDREAL;
+ assert (ffetype_size (type) == sizeof (ffetargetReal2));
+
+ ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1]
+ = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("complex"),
+ t));
+ type = ffetype_new ();
+ base_type = type;
+ ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 1, type);
+ ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1]
+ = FFETARGET_f2cTYCOMPLEX;
+ assert (ffetype_size (type) == sizeof (ffetargetComplex1));
+
+ ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREALDOUBLE]
+ = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]);
+ pushdecl (build_decl (TYPE_DECL, get_identifier ("double complex"),
+ t));
+ type = ffetype_new ();
+ ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREALDOUBLE,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_star (base_type,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+ type);
+ ffetype_set_kind (base_type, 2,
+ type);
+ ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL2]
+ = FFETARGET_f2cTYDCOMPLEX;
+ assert (ffetype_size (type) == sizeof (ffetargetComplex2));
+
+ /* Make function and ptr-to-function types for non-CHARACTER types. */
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
+ for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+ {
+ if ((t = ffecom_tree_type[i][j]) != NULL_TREE)
+ {
+ if (i == FFEINFO_basictypeINTEGER)
+ {
+ /* Figure out the smallest INTEGER type that can hold
+ a pointer on this machine. */
+ if (GET_MODE_SIZE (TYPE_MODE (t))
+ >= GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+ {
+ if ((ffecom_pointer_kind_ == FFEINFO_kindtypeNONE)
+ || (GET_MODE_SIZE (TYPE_MODE (ffecom_tree_type[i][ffecom_pointer_kind_]))
+ > GET_MODE_SIZE (TYPE_MODE (t))))
+ ffecom_pointer_kind_ = j;
+ }
+ }
+ else if (i == FFEINFO_basictypeCOMPLEX)
+ t = void_type_node;
+ /* For f2c compatibility, REAL functions are really
+ implemented as DOUBLE PRECISION. */
+ else if ((i == FFEINFO_basictypeREAL)
+ && (j == FFEINFO_kindtypeREAL1))
+ t = ffecom_tree_type
+ [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2];
+
+ t = ffecom_tree_fun_type[i][j] = build_function_type (t,
+ NULL_TREE);
+ ffecom_tree_ptr_to_fun_type[i][j] = build_pointer_type (t);
+ }
+ }
+
+ /* Set up pointer types. */
+
+ if (ffecom_pointer_kind_ == FFEINFO_basictypeNONE)
+ fatal ("no INTEGER type can hold a pointer on this configuration");
+ else if (0 && ffe_is_do_internal_checks ())
+ fprintf (stderr, "Pointer type kt=%d\n", ffecom_pointer_kind_);
+ type = ffetype_new ();
+ ffetype_set_kind (ffeinfo_type (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT),
+ 7, type);
+
+ if (ffe_is_ugly_assign ())
+ ffecom_label_kind_ = ffecom_pointer_kind_; /* Require ASSIGN etc to this. */
+ else
+ ffecom_label_kind_ = FFEINFO_kindtypeINTEGERDEFAULT;
+ if (0 && ffe_is_do_internal_checks ())
+ fprintf (stderr, "Label type kt=%d\n", ffecom_label_kind_);
+
+ ffecom_integer_type_node
+ = ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1];
+ ffecom_integer_zero_node = convert (ffecom_integer_type_node,
+ integer_zero_node);
+ ffecom_integer_one_node = convert (ffecom_integer_type_node,
+ integer_one_node);
+
+ /* Yes, the "FLOAT_TYPE_SIZE" references below are intentional.
+ Turns out that by TYLONG, runtime/libI77/lio.h really means
+ "whatever size an ftnint is". For consistency and sanity,
+ com.h and runtime/f2c.h.in agree that flag, ftnint, and ftlen
+ all are INTEGER, which we also make out of whatever back-end
+ integer type is FLOAT_TYPE_SIZE bits wide. This change, from
+ LONG_TYPE_SIZE, for TYLONG and TYLOGICAL, was necessary to
+ accommodate machines like the Alpha. Note that this suggests
+ f2c and libf2c are missing a distinction perhaps needed on
+ some machines between "int" and "long int". -- burley 0.5.5 950215 */
+
+ ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, FLOAT_TYPE_SIZE,
+ FFETARGET_f2cTYLONG);
+ ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, SHORT_TYPE_SIZE,
+ FFETARGET_f2cTYSHORT);
+ ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, CHAR_TYPE_SIZE,
+ FFETARGET_f2cTYINT1);
+ ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, LONG_LONG_TYPE_SIZE,
+ FFETARGET_f2cTYQUAD);
+ ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, FLOAT_TYPE_SIZE,
+ FFETARGET_f2cTYLOGICAL);
+ ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, SHORT_TYPE_SIZE,
+ FFETARGET_f2cTYLOGICAL2);
+ ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, CHAR_TYPE_SIZE,
+ FFETARGET_f2cTYLOGICAL1);
+ ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, LONG_LONG_TYPE_SIZE,
+ FFETARGET_f2cTYQUAD /* ~~~ */);
+
+ /* CHARACTER stuff is all special-cased, so it is not handled in the above
+ loop. CHARACTER items are built as arrays of unsigned char. */
+
+ ffecom_tree_type[FFEINFO_basictypeCHARACTER]
+ [FFEINFO_kindtypeCHARACTER1] = t = char_type_node;
+ type = ffetype_new ();
+ base_type = type;
+ ffeinfo_set_type (FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTER1,
+ type);
+ ffetype_set_ams (type,
+ TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+ TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+ ffetype_set_kind (base_type, 1, type);
+ assert (ffetype_size (type)
+ == sizeof (((ffetargetCharacter1) { 0, NULL }).text[0]));
+
+ ffecom_tree_fun_type[FFEINFO_basictypeCHARACTER]
+ [FFEINFO_kindtypeCHARACTER1] = ffecom_tree_fun_type_void;
+ ffecom_tree_ptr_to_fun_type[FFEINFO_basictypeCHARACTER]
+ [FFEINFO_kindtypeCHARACTER1]
+ = ffecom_tree_ptr_to_fun_type_void;
+ ffecom_f2c_typecode_[FFEINFO_basictypeCHARACTER][FFEINFO_kindtypeCHARACTER1]
+ = FFETARGET_f2cTYCHAR;
+
+ ffecom_f2c_typecode_[FFEINFO_basictypeANY][FFEINFO_kindtypeANY]
+ = 0;
+
+ /* Make multi-return-value type and fields. */
+
+ ffecom_multi_type_node_ = make_node (UNION_TYPE);
+
+ field = NULL_TREE;
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
+ for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+ {
+ char name[30];
+
+ if (ffecom_tree_type[i][j] == NULL_TREE)
+ continue; /* Not supported. */
+ sprintf (&name[0], "bt_%s_kt_%s",
+ ffeinfo_basictype_string ((ffeinfoBasictype) i),
+ ffeinfo_kindtype_string ((ffeinfoKindtype) j));
+ ffecom_multi_fields_[i][j] = build_decl (FIELD_DECL,
+ get_identifier (name),
+ ffecom_tree_type[i][j]);
+ DECL_CONTEXT (ffecom_multi_fields_[i][j])
+ = ffecom_multi_type_node_;
+ DECL_FRAME_SIZE (ffecom_multi_fields_[i][j]) = 0;
+ TREE_CHAIN (ffecom_multi_fields_[i][j]) = field;
+ field = ffecom_multi_fields_[i][j];
+ }
+
+ TYPE_FIELDS (ffecom_multi_type_node_) = field;
+ layout_type (ffecom_multi_type_node_);
+
+ /* Subroutines usually return integer because they might have alternate
+ returns. */
+
+ ffecom_tree_subr_type
+ = build_function_type (integer_type_node, NULL_TREE);
+ ffecom_tree_ptr_to_subr_type
+ = build_pointer_type (ffecom_tree_subr_type);
+ ffecom_tree_blockdata_type
+ = build_function_type (void_type_node, NULL_TREE);
+
+ builtin_function ("__builtin_sqrtf", float_ftype_float,
+ BUILT_IN_FSQRT, "sqrtf");
+ builtin_function ("__builtin_fsqrt", double_ftype_double,
+ BUILT_IN_FSQRT, "sqrt");
+ builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble,
+ BUILT_IN_FSQRT, "sqrtl");
+ builtin_function ("__builtin_sinf", float_ftype_float,
+ BUILT_IN_SIN, "sinf");
+ builtin_function ("__builtin_sin", double_ftype_double,
+ BUILT_IN_SIN, "sin");
+ builtin_function ("__builtin_sinl", ldouble_ftype_ldouble,
+ BUILT_IN_SIN, "sinl");
+ builtin_function ("__builtin_cosf", float_ftype_float,
+ BUILT_IN_COS, "cosf");
+ builtin_function ("__builtin_cos", double_ftype_double,
+ BUILT_IN_COS, "cos");
+ builtin_function ("__builtin_cosl", ldouble_ftype_ldouble,
+ BUILT_IN_COS, "cosl");
+
+#if BUILT_FOR_270
+ pedantic_lvalues = FALSE;
+#endif
+
+ ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node,
+ FFECOM_f2cINTEGER,
+ "integer");
+ ffecom_f2c_make_type_ (&ffecom_f2c_address_type_node,
+ FFECOM_f2cADDRESS,
+ "address");
+ ffecom_f2c_make_type_ (&ffecom_f2c_real_type_node,
+ FFECOM_f2cREAL,
+ "real");
+ ffecom_f2c_make_type_ (&ffecom_f2c_doublereal_type_node,
+ FFECOM_f2cDOUBLEREAL,
+ "doublereal");
+ ffecom_f2c_make_type_ (&ffecom_f2c_complex_type_node,
+ FFECOM_f2cCOMPLEX,
+ "complex");
+ ffecom_f2c_make_type_ (&ffecom_f2c_doublecomplex_type_node,
+ FFECOM_f2cDOUBLECOMPLEX,
+ "doublecomplex");
+ ffecom_f2c_make_type_ (&ffecom_f2c_longint_type_node,
+ FFECOM_f2cLONGINT,
+ "longint");
+ ffecom_f2c_make_type_ (&ffecom_f2c_logical_type_node,
+ FFECOM_f2cLOGICAL,
+ "logical");
+ ffecom_f2c_make_type_ (&ffecom_f2c_flag_type_node,
+ FFECOM_f2cFLAG,
+ "flag");
+ ffecom_f2c_make_type_ (&ffecom_f2c_ftnlen_type_node,
+ FFECOM_f2cFTNLEN,
+ "ftnlen");
+ ffecom_f2c_make_type_ (&ffecom_f2c_ftnint_type_node,
+ FFECOM_f2cFTNINT,
+ "ftnint");
+
+ ffecom_f2c_ftnlen_zero_node
+ = convert (ffecom_f2c_ftnlen_type_node, integer_zero_node);
+
+ ffecom_f2c_ftnlen_one_node
+ = convert (ffecom_f2c_ftnlen_type_node, integer_one_node);
+
+ ffecom_f2c_ftnlen_two_node = build_int_2 (2, 0);
+ TREE_TYPE (ffecom_f2c_ftnlen_two_node) = ffecom_integer_type_node;
+
+ ffecom_f2c_ptr_to_ftnlen_type_node
+ = build_pointer_type (ffecom_f2c_ftnlen_type_node);
+
+ ffecom_f2c_ptr_to_ftnint_type_node
+ = build_pointer_type (ffecom_f2c_ftnint_type_node);
+
+ ffecom_f2c_ptr_to_integer_type_node
+ = build_pointer_type (ffecom_f2c_integer_type_node);
+
+ ffecom_f2c_ptr_to_real_type_node
+ = build_pointer_type (ffecom_f2c_real_type_node);
+
+ ffecom_float_zero_ = build_real (float_type_node, dconst0);
+ ffecom_double_zero_ = build_real (double_type_node, dconst0);
+ {
+ REAL_VALUE_TYPE point_5;
+
+#ifdef REAL_ARITHMETIC
+ REAL_ARITHMETIC (point_5, RDIV_EXPR, dconst1, dconst2);
+#else
+ point_5 = .5;
+#endif
+ ffecom_float_half_ = build_real (float_type_node, point_5);
+ ffecom_double_half_ = build_real (double_type_node, point_5);
+ }
+
+ /* Do "extern int xargc;". */
+
+ ffecom_tree_xargc_ = build_decl (VAR_DECL,
+ get_identifier ("xargc"),
+ integer_type_node);
+ DECL_EXTERNAL (ffecom_tree_xargc_) = 1;
+ TREE_STATIC (ffecom_tree_xargc_) = 1;
+ TREE_PUBLIC (ffecom_tree_xargc_) = 1;
+ ffecom_tree_xargc_ = start_decl (ffecom_tree_xargc_, FALSE);
+ finish_decl (ffecom_tree_xargc_, NULL_TREE, FALSE);
+
+#if 0 /* This is being fixed, and seems to be working now. */
+ if ((FLOAT_TYPE_SIZE != 32)
+ || (TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node))) != 32))
+ {
+ warning ("configuration: REAL, INTEGER, and LOGICAL are %d bits wide,",
+ (int) FLOAT_TYPE_SIZE);
+ warning ("and pointers are %d bits wide, but g77 doesn't yet work",
+ (int) TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node))));
+ warning ("properly unless they all are 32 bits wide.");
+ warning ("Please keep this in mind before you report bugs. g77 should");
+ warning ("support non-32-bit machines better as of version 0.6.");
+ }
+#endif
+
+#if 0 /* Code in ste.c that would crash has been commented out. */
+ if (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
+ < TYPE_PRECISION (string_type_node))
+ /* I/O will probably crash. */
+ warning ("configuration: char * holds %d bits, but ftnlen only %d",
+ TYPE_PRECISION (string_type_node),
+ TYPE_PRECISION (ffecom_f2c_ftnlen_type_node));
+#endif
+
+#if 0 /* ASSIGN-related stuff has been changed to accommodate this. */
+ if (TYPE_PRECISION (ffecom_integer_type_node)
+ < TYPE_PRECISION (string_type_node))
+ /* ASSIGN 10 TO I will crash. */
+ warning ("configuration: char * holds %d bits, but INTEGER only %d --\n\
+ ASSIGN statement might fail",
+ TYPE_PRECISION (string_type_node),
+ TYPE_PRECISION (ffecom_integer_type_node));
+#endif
+}
+
+#endif
+/* ffecom_init_2 -- Initialize
+
+ ffecom_init_2(); */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_init_2 ()
+{
+ assert (ffecom_outer_function_decl_ == NULL_TREE);
+ assert (current_function_decl == NULL_TREE);
+ assert (ffecom_which_entrypoint_decl_ == NULL_TREE);
+
+ ffecom_master_arglist_ = NULL;
+ ++ffecom_num_fns_;
+ ffecom_latest_temp_ = NULL;
+ ffecom_primary_entry_ = NULL;
+ ffecom_is_altreturning_ = FALSE;
+ ffecom_func_result_ = NULL_TREE;
+ ffecom_multi_retval_ = NULL_TREE;
+}
+
+#endif
+/* ffecom_list_expr -- Transform list of exprs into gcc tree
+
+ tree t;
+ ffebld expr; // FFE opITEM list.
+ tree = ffecom_list_expr(expr);
+
+ List of actual args is transformed into corresponding gcc backend list. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_list_expr (ffebld expr)
+{
+ tree list;
+ tree *plist = &list;
+ tree trail = NULL_TREE; /* Append char length args here. */
+ tree *ptrail = &trail;
+ tree length;
+
+ while (expr != NULL)
+ {
+ *plist
+ = build_tree_list (NULL_TREE, ffecom_arg_expr (ffebld_head (expr),
+ &length));
+ plist = &TREE_CHAIN (*plist);
+ expr = ffebld_trail (expr);
+ if (length != NULL_TREE)
+ {
+ *ptrail = build_tree_list (NULL_TREE, length);
+ ptrail = &TREE_CHAIN (*ptrail);
+ }
+ }
+
+ *plist = trail;
+
+ return list;
+}
+
+#endif
+/* ffecom_list_ptr_to_expr -- Transform list of exprs into gcc tree
+
+ tree t;
+ ffebld expr; // FFE opITEM list.
+ tree = ffecom_list_ptr_to_expr(expr);
+
+ List of actual args is transformed into corresponding gcc backend list for
+ use in calling an external procedure (vs. a statement function). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_list_ptr_to_expr (ffebld expr)
+{
+ tree list;
+ tree *plist = &list;
+ tree trail = NULL_TREE; /* Append char length args here. */
+ tree *ptrail = &trail;
+ tree length;
+
+ while (expr != NULL)
+ {
+ *plist
+ = build_tree_list (NULL_TREE,
+ ffecom_arg_ptr_to_expr (ffebld_head (expr),
+ &length));
+ plist = &TREE_CHAIN (*plist);
+ expr = ffebld_trail (expr);
+ if (length != NULL_TREE)
+ {
+ *ptrail = build_tree_list (NULL_TREE, length);
+ ptrail = &TREE_CHAIN (*ptrail);
+ }
+ }
+
+ *plist = trail;
+
+ return list;
+}
+
+#endif
+/* Obtain gcc's LABEL_DECL tree for label. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_lookup_label (ffelab label)
+{
+ tree glabel;
+
+ if (ffelab_hook (label) == NULL_TREE)
+ {
+ char labelname[16];
+
+ switch (ffelab_type (label))
+ {
+ case FFELAB_typeLOOPEND:
+ case FFELAB_typeNOTLOOP:
+ case FFELAB_typeENDIF:
+ sprintf (labelname, "%" ffelabValue_f "u", ffelab_value (label));
+ glabel = build_decl (LABEL_DECL, get_identifier (labelname),
+ void_type_node);
+ DECL_CONTEXT (glabel) = current_function_decl;
+ DECL_MODE (glabel) = VOIDmode;
+ break;
+
+ case FFELAB_typeFORMAT:
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ glabel = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier
+ ("__g77_format_%d", NULL,
+ (int) ffelab_value (label)),
+ build_type_variant (build_array_type
+ (char_type_node,
+ NULL_TREE),
+ 1, 0));
+ TREE_CONSTANT (glabel) = 1;
+ TREE_STATIC (glabel) = 1;
+ DECL_CONTEXT (glabel) = 0;
+ DECL_INITIAL (glabel) = NULL;
+ make_decl_rtl (glabel, NULL, 0);
+ expand_decl (glabel);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ break;
+
+ case FFELAB_typeANY:
+ glabel = error_mark_node;
+ break;
+
+ default:
+ assert ("bad label type" == NULL);
+ glabel = NULL;
+ break;
+ }
+ ffelab_set_hook (label, glabel);
+ }
+ else
+ {
+ glabel = ffelab_hook (label);
+ }
+
+ return glabel;
+}
+
+#endif
+/* Stabilizes the arguments. Don't use this if the lhs and rhs come from
+ a single source specification (as in the fourth argument of MVBITS).
+ If the type is NULL_TREE, the type of lhs is used to make the type of
+ the MODIFY_EXPR. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_modify (tree newtype, tree lhs,
+ tree rhs)
+{
+ if (lhs == error_mark_node || rhs == error_mark_node)
+ return error_mark_node;
+
+ if (newtype == NULL_TREE)
+ newtype = TREE_TYPE (lhs);
+
+ if (TREE_SIDE_EFFECTS (lhs))
+ lhs = stabilize_reference (lhs);
+
+ return ffecom_2s (MODIFY_EXPR, newtype, lhs, rhs);
+}
+
+#endif
+
+/* Register source file name. */
+
+void
+ffecom_file (char *name)
+{
+#if FFECOM_GCC_INCLUDE
+ ffecom_file_ (name);
+#endif
+}
+
+/* ffecom_notify_init_storage -- An aggregate storage is now fully init'ed
+
+ ffestorag st;
+ ffecom_notify_init_storage(st);
+
+ Gets called when all possible units in an aggregate storage area (a LOCAL
+ with equivalences or a COMMON) have been initialized. The initialization
+ info either is in ffestorag_init or, if that is NULL,
+ ffestorag_accretion:
+
+ ffestorag_init may contain an opCONTER or opARRTER. opCONTER may occur
+ even for an array if the array is one element in length!
+
+ ffestorag_accretion will contain an opACCTER. It is much like an
+ opARRTER except it has an ffebit object in it instead of just a size.
+ The back end can use the info in the ffebit object, if it wants, to
+ reduce the amount of actual initialization, but in any case it should
+ kill the ffebit object when done. Also, set accretion to NULL but
+ init to a non-NULL value.
+
+ After performing initialization, DO NOT set init to NULL, because that'll
+ tell the front end it is ok for more initialization to happen. Instead,
+ set init to an opANY expression or some such thing that you can use to
+ tell that you've already initialized the object.
+
+ 27-Oct-91 JCB 1.1
+ Support two-pass FFE. */
+
+void
+ffecom_notify_init_storage (ffestorag st)
+{
+ ffebld init; /* The initialization expression. */
+#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffetargetOffset size; /* The size of the entity. */
+#endif
+
+ if (ffestorag_init (st) == NULL)
+ {
+ init = ffestorag_accretion (st);
+ assert (init != NULL);
+ ffestorag_set_accretion (st, NULL);
+ ffestorag_set_accretes (st, 0);
+
+#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
+ /* For GNU backend, just turn ACCTER into ARRTER and proceed. */
+ size = ffebld_accter_size (init);
+ ffebit_kill (ffebld_accter_bits (init));
+ ffebld_set_op (init, FFEBLD_opARRTER);
+ ffebld_set_arrter (init, ffebld_accter (init));
+ ffebld_arrter_set_size (init, size);
+#endif
+
+#if FFECOM_TWOPASS
+ ffestorag_set_init (st, init);
+#endif
+ }
+#if FFECOM_ONEPASS
+ else
+ init = ffestorag_init (st);
+#endif
+
+#if FFECOM_ONEPASS /* Process the inits, wipe 'em out. */
+ ffestorag_set_init (st, ffebld_new_any ());
+
+ if (ffebld_op (init) == FFEBLD_opANY)
+ return; /* Oh, we already did this! */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ {
+ ffesymbol s;
+
+ if (ffestorag_symbol (st) != NULL)
+ s = ffestorag_symbol (st);
+ else
+ s = ffestorag_typesymbol (st);
+
+ fprintf (dmpout, "= initialize_storage \"%s\" ",
+ (s != NULL) ? ffesymbol_text (s) : "(unnamed)");
+ ffebld_dump (init);
+ fputc ('\n', dmpout);
+ }
+#endif
+
+#endif /* if FFECOM_ONEPASS */
+}
+
+/* ffecom_notify_init_symbol -- A symbol is now fully init'ed
+
+ ffesymbol s;
+ ffecom_notify_init_symbol(s);
+
+ Gets called when all possible units in a symbol (not placed in COMMON
+ or involved in EQUIVALENCE, unless it as yet has no ffestorag object)
+ have been initialized. The initialization info either is in
+ ffesymbol_init or, if that is NULL, ffesymbol_accretion:
+
+ ffesymbol_init may contain an opCONTER or opARRTER. opCONTER may occur
+ even for an array if the array is one element in length!
+
+ ffesymbol_accretion will contain an opACCTER. It is much like an
+ opARRTER except it has an ffebit object in it instead of just a size.
+ The back end can use the info in the ffebit object, if it wants, to
+ reduce the amount of actual initialization, but in any case it should
+ kill the ffebit object when done. Also, set accretion to NULL but
+ init to a non-NULL value.
+
+ After performing initialization, DO NOT set init to NULL, because that'll
+ tell the front end it is ok for more initialization to happen. Instead,
+ set init to an opANY expression or some such thing that you can use to
+ tell that you've already initialized the object.
+
+ 27-Oct-91 JCB 1.1
+ Support two-pass FFE. */
+
+void
+ffecom_notify_init_symbol (ffesymbol s)
+{
+ ffebld init; /* The initialization expression. */
+#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffetargetOffset size; /* The size of the entity. */
+#endif
+
+ if (ffesymbol_storage (s) == NULL)
+ return; /* Do nothing until COMMON/EQUIVALENCE
+ possibilities checked. */
+
+ if ((ffesymbol_init (s) == NULL)
+ && ((init = ffesymbol_accretion (s)) != NULL))
+ {
+ ffesymbol_set_accretion (s, NULL);
+ ffesymbol_set_accretes (s, 0);
+
+#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
+ /* For GNU backend, just turn ACCTER into ARRTER and proceed. */
+ size = ffebld_accter_size (init);
+ ffebit_kill (ffebld_accter_bits (init));
+ ffebld_set_op (init, FFEBLD_opARRTER);
+ ffebld_set_arrter (init, ffebld_accter (init));
+ ffebld_arrter_set_size (init, size);
+#endif
+
+#if FFECOM_TWOPASS
+ ffesymbol_set_init (s, init);
+#endif
+ }
+#if FFECOM_ONEPASS
+ else
+ init = ffesymbol_init (s);
+#endif
+
+#if FFECOM_ONEPASS
+ ffesymbol_set_init (s, ffebld_new_any ());
+
+ if (ffebld_op (init) == FFEBLD_opANY)
+ return; /* Oh, we already did this! */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "= initialize_symbol \"%s\" ", ffesymbol_text (s));
+ ffebld_dump (init);
+ fputc ('\n', dmpout);
+#endif
+
+#endif /* if FFECOM_ONEPASS */
+}
+
+/* ffecom_notify_primary_entry -- Learn which is the primary entry point
+
+ ffesymbol s;
+ ffecom_notify_primary_entry(s);
+
+ Gets called when implicit or explicit PROGRAM statement seen or when
+ FUNCTION, SUBROUTINE, or BLOCK DATA statement seen, with the primary
+ global symbol that serves as the entry point. */
+
+void
+ffecom_notify_primary_entry (ffesymbol s)
+{
+ ffecom_primary_entry_ = s;
+ ffecom_primary_entry_kind_ = ffesymbol_kind (s);
+
+ if ((ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION)
+ || (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE))
+ ffecom_primary_entry_is_proc_ = TRUE;
+ else
+ ffecom_primary_entry_is_proc_ = FALSE;
+
+ if (!ffe_is_silent ())
+ {
+ if (ffecom_primary_entry_kind_ == FFEINFO_kindPROGRAM)
+ fprintf (stderr, "%s:\n", ffesymbol_text (s));
+ else
+ fprintf (stderr, " %s:\n", ffesymbol_text (s));
+ }
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)
+ {
+ ffebld list;
+ ffebld arg;
+
+ for (list = ffesymbol_dummyargs (s);
+ list != NULL;
+ list = ffebld_trail (list))
+ {
+ arg = ffebld_head (list);
+ if (ffebld_op (arg) == FFEBLD_opSTAR)
+ {
+ ffecom_is_altreturning_ = TRUE;
+ break;
+ }
+ }
+ }
+#endif
+}
+
+FILE *
+ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c)
+{
+#if FFECOM_GCC_INCLUDE
+ return ffecom_open_include_ (name, l, c);
+#else
+ return fopen (name, "r");
+#endif
+}
+
+/* Clean up after making automatically popped call-arg temps.
+
+ Call this in pairs with push_calltemps around calls to
+ ffecom_arg_ptr_to_expr if the latter might use temporaries.
+ Any temporaries made within the outermost sequence of
+ push_calltemps and pop_calltemps, that are marked as "auto-pop"
+ meaning they won't be explicitly popped (freed), are popped
+ at this point so they can be reused later.
+
+ NOTE: when called by ffecom_gen_sfuncdef_, ffecom_pending_calls_
+ should come in == 1, and all of the in-use auto-pop temps
+ should have DECL_CONTEXT (temp->t) == current_function_decl.
+ Moreover, these temps should _never_ be re-used in future
+ calls to ffecom_push_tempvar -- since current_function_decl will
+ never be the same again.
+
+ SO, it could be a minor win in terms of compile time to just
+ strip these temps off the list. That is, if the above assumptions
+ are correct, just remove from the list of temps any temp
+ that is both in-use and has DECL_CONTEXT (temp->t)
+ == current_function_decl, when called from ffecom_gen_sfuncdef_. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_pop_calltemps ()
+{
+ ffecomTemp_ temp;
+
+ assert (ffecom_pending_calls_ > 0);
+
+ if (--ffecom_pending_calls_ == 0)
+ for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next)
+ if (temp->auto_pop)
+ temp->in_use = FALSE;
+}
+
+#endif
+/* Mark latest temp with given tree as no longer in use. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_pop_tempvar (tree t)
+{
+ ffecomTemp_ temp;
+
+ for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next)
+ if (temp->in_use && (temp->t == t))
+ {
+ assert (!temp->auto_pop);
+ temp->in_use = FALSE;
+ return;
+ }
+ else
+ assert (temp->t != t);
+
+ assert ("couldn't ffecom_pop_tempvar!" != NULL);
+}
+
+#endif
+/* ffecom_ptr_to_expr -- Transform expr into gcc tree with & in front
+
+ tree t;
+ ffebld expr; // FFE expression.
+ tree = ffecom_ptr_to_expr(expr);
+
+ Like ffecom_expr, but sticks address-of in front of most things. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_ptr_to_expr (ffebld expr)
+{
+ tree item;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffesymbol s;
+
+ assert (expr != NULL);
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opSYMTER:
+ s = ffebld_symter (expr);
+ if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+ {
+ ffecomGfrt ix;
+
+ ix = ffeintrin_gfrt_indirect (ffebld_symter_implementation (expr));
+ assert (ix != FFECOM_gfrt);
+ if ((item = ffecom_gfrt_[ix]) == NULL_TREE)
+ {
+ ffecom_make_gfrt_ (ix);
+ item = ffecom_gfrt_[ix];
+ }
+ }
+ else
+ {
+ item = ffesymbol_hook (s).decl_tree;
+ if (item == NULL_TREE)
+ {
+ s = ffecom_sym_transform_ (s);
+ item = ffesymbol_hook (s).decl_tree;
+ }
+ }
+ assert (item != NULL);
+ if (item == error_mark_node)
+ return item;
+ if (!ffesymbol_hook (s).addr)
+ item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
+ item);
+ return item;
+
+ case FFEBLD_opARRAYREF:
+ {
+ ffebld dims[FFECOM_dimensionsMAX];
+ tree array;
+ int i;
+
+ item = ffecom_ptr_to_expr (ffebld_left (expr));
+
+ if (item == error_mark_node)
+ return item;
+
+ if ((ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING)
+ && !mark_addressable (item))
+ return error_mark_node; /* Make sure non-const ref is to
+ non-reg. */
+
+ /* Build up ARRAY_REFs in reverse order (since we're column major
+ here in Fortran land). */
+
+ for (i = 0, expr = ffebld_right (expr);
+ expr != NULL;
+ expr = ffebld_trail (expr))
+ dims[i++] = ffebld_head (expr);
+
+ for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
+ i >= 0;
+ --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
+ {
+ item
+ = ffecom_2 (PLUS_EXPR,
+ build_pointer_type (TREE_TYPE (array)),
+ item,
+ size_binop (MULT_EXPR,
+ size_in_bytes (TREE_TYPE (array)),
+ size_binop (MINUS_EXPR,
+ ffecom_expr (dims[i]),
+ TYPE_MIN_VALUE (TYPE_DOMAIN (array)))));
+ }
+ }
+ return item;
+
+ case FFEBLD_opCONTER:
+
+ bt = ffeinfo_basictype (ffebld_info (expr));
+ kt = ffeinfo_kindtype (ffebld_info (expr));
+
+ item = ffecom_constantunion (&ffebld_constant_union
+ (ffebld_conter (expr)), bt, kt,
+ ffecom_tree_type[bt][kt]);
+ if (item == error_mark_node)
+ return error_mark_node;
+ item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
+ item);
+ return item;
+
+ case FFEBLD_opANY:
+ return error_mark_node;
+
+ default:
+ assert (ffecom_pending_calls_ > 0);
+
+ bt = ffeinfo_basictype (ffebld_info (expr));
+ kt = ffeinfo_kindtype (ffebld_info (expr));
+
+ item = ffecom_expr (expr);
+ if (item == error_mark_node)
+ return error_mark_node;
+
+ /* The back end currently optimizes a bit too zealously for us, in that
+ we fail JCB001 if the following block of code is omitted. It checks
+ to see if the transformed expression is a symbol or array reference,
+ and encloses it in a SAVE_EXPR if that is the case. */
+
+ STRIP_NOPS (item);
+ if ((TREE_CODE (item) == VAR_DECL)
+ || (TREE_CODE (item) == PARM_DECL)
+ || (TREE_CODE (item) == RESULT_DECL)
+ || (TREE_CODE (item) == INDIRECT_REF)
+ || (TREE_CODE (item) == ARRAY_REF)
+ || (TREE_CODE (item) == COMPONENT_REF)
+#ifdef OFFSET_REF
+ || (TREE_CODE (item) == OFFSET_REF)
+#endif
+ || (TREE_CODE (item) == BUFFER_REF)
+ || (TREE_CODE (item) == REALPART_EXPR)
+ || (TREE_CODE (item) == IMAGPART_EXPR))
+ {
+ item = ffecom_save_tree (item);
+ }
+
+ item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
+ item);
+ return item;
+ }
+
+ assert ("fall-through error" == NULL);
+ return error_mark_node;
+}
+
+#endif
+/* Prepare to make call-arg temps.
+
+ Call this in pairs with pop_calltemps around calls to
+ ffecom_arg_ptr_to_expr if the latter might use temporaries. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_push_calltemps ()
+{
+ ffecom_pending_calls_++;
+}
+
+#endif
+/* Obtain a temp var with given data type.
+
+ Returns a VAR_DECL tree of a currently (that is, at the current
+ statement being compiled) not in use and having the given data type,
+ making a new one if necessary. size is FFETARGET_charactersizeNONE
+ for a non-CHARACTER type or >= 0 for a CHARACTER type. elements is
+ -1 for a scalar or > 0 for an array of type. auto_pop is TRUE if
+ ffecom_pop_tempvar won't be called, meaning temp will be freed
+ when #pending calls goes to zero. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_push_tempvar (tree type, ffetargetCharacterSize size, int elements,
+ bool auto_pop)
+{
+ ffecomTemp_ temp;
+ int yes;
+ tree t;
+ static int mynumber;
+
+ assert (!auto_pop || (ffecom_pending_calls_ > 0));
+
+ if (type == error_mark_node)
+ return error_mark_node;
+
+ for (temp = ffecom_latest_temp_; temp != NULL; temp = temp->next)
+ {
+ if (temp->in_use
+ || (temp->type != type)
+ || (temp->size != size)
+ || (temp->elements != elements)
+ || (DECL_CONTEXT (temp->t) != current_function_decl))
+ continue;
+
+ temp->in_use = TRUE;
+ temp->auto_pop = auto_pop;
+ return temp->t;
+ }
+
+ /* Create a new temp. */
+
+ yes = suspend_momentary ();
+
+ if (size != FFETARGET_charactersizeNONE)
+ type = build_array_type (type,
+ build_range_type (ffecom_f2c_ftnlen_type_node,
+ ffecom_f2c_ftnlen_one_node,
+ build_int_2 (size, 0)));
+ if (elements != -1)
+ type = build_array_type (type,
+ build_range_type (integer_type_node,
+ integer_zero_node,
+ build_int_2 (elements - 1,
+ 0)));
+ t = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_expr_%d", NULL,
+ mynumber++),
+ type);
+ { /* ~~~~ kludge alert here!!! else temp gets reused outside
+ a compound-statement sequence.... */
+ extern tree sequence_rtl_expr;
+ tree back_end_bug = sequence_rtl_expr;
+
+ sequence_rtl_expr = NULL_TREE;
+
+ t = start_decl (t, FALSE);
+ finish_decl (t, NULL_TREE, FALSE);
+
+ sequence_rtl_expr = back_end_bug;
+ }
+
+ resume_momentary (yes);
+
+ temp = malloc_new_kp (ffe_pool_program_unit (), "ffecomTemp_",
+ sizeof (*temp));
+
+ temp->next = ffecom_latest_temp_;
+ temp->type = type;
+ temp->t = t;
+ temp->size = size;
+ temp->elements = elements;
+ temp->in_use = TRUE;
+ temp->auto_pop = auto_pop;
+
+ ffecom_latest_temp_ = temp;
+
+ return t;
+}
+
+#endif
+/* ffecom_return_expr -- Returns return-value expr given alt return expr
+
+ tree rtn; // NULL_TREE means use expand_null_return()
+ ffebld expr; // NULL if no alt return expr to RETURN stmt
+ rtn = ffecom_return_expr(expr);
+
+ Based on the program unit type and other info (like return function
+ type, return master function type when alternate ENTRY points,
+ whether subroutine has any alternate RETURN points, etc), returns the
+ appropriate expression to be returned to the caller, or NULL_TREE
+ meaning no return value or the caller expects it to be returned somewhere
+ else (which is handled by other parts of this module). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_return_expr (ffebld expr)
+{
+ tree rtn;
+
+ switch (ffecom_primary_entry_kind_)
+ {
+ case FFEINFO_kindPROGRAM:
+ case FFEINFO_kindBLOCKDATA:
+ rtn = NULL_TREE;
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ if (!ffecom_is_altreturning_)
+ rtn = NULL_TREE; /* No alt returns, never an expr. */
+ else if (expr == NULL)
+ rtn = integer_zero_node;
+ else
+ rtn = ffecom_expr (expr);
+ break;
+
+ case FFEINFO_kindFUNCTION:
+ if ((ffecom_multi_retval_ != NULL_TREE)
+ || (ffesymbol_basictype (ffecom_primary_entry_)
+ == FFEINFO_basictypeCHARACTER)
+ || ((ffesymbol_basictype (ffecom_primary_entry_)
+ == FFEINFO_basictypeCOMPLEX)
+ && (ffecom_num_entrypoints_ == 0)
+ && ffesymbol_is_f2c (ffecom_primary_entry_)))
+ { /* Value is returned by direct assignment
+ into (implicit) dummy. */
+ rtn = NULL_TREE;
+ break;
+ }
+ rtn = ffecom_func_result_;
+#if 0
+ /* Spurious error if RETURN happens before first reference! So elide
+ this code. In particular, for debugging registry, rtn should always
+ be non-null after all, but TREE_USED won't be set until we encounter
+ a reference in the code. Perfectly okay (but weird) code that,
+ e.g., has "GOTO 20;10 RETURN;20 RTN=0;GOTO 10", would result in
+ this diagnostic for no reason. Have people use -O -Wuninitialized
+ and leave it to the back end to find obviously weird cases. */
+
+ /* Used to "assert(rtn != NULL_TREE);" here, but it's kind of a valid
+ situation; if the return value has never been referenced, it won't
+ have a tree under 2pass mode. */
+ if ((rtn == NULL_TREE)
+ || !TREE_USED (rtn))
+ {
+ ffebad_start (FFEBAD_RETURN_VALUE_UNSET);
+ ffebad_here (0, ffesymbol_where_line (ffecom_primary_entry_),
+ ffesymbol_where_column (ffecom_primary_entry_));
+ ffebad_string (ffesymbol_text (ffesymbol_funcresult
+ (ffecom_primary_entry_)));
+ ffebad_finish ();
+ }
+#endif
+ break;
+
+ default:
+ assert ("bad unit kind" == NULL);
+ case FFEINFO_kindANY:
+ rtn = error_mark_node;
+ break;
+ }
+
+ return rtn;
+}
+
+#endif
+/* Do save_expr only if tree is not error_mark_node. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree ffecom_save_tree (tree t)
+{
+ return save_expr (t);
+}
+#endif
+
+/* Public entry point for front end to access start_decl. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_start_decl (tree decl, bool is_initialized)
+{
+ DECL_INITIAL (decl) = is_initialized ? error_mark_node : NULL_TREE;
+ return start_decl (decl, FALSE);
+}
+
+#endif
+/* ffecom_sym_commit -- Symbol's state being committed to reality
+
+ ffesymbol s;
+ ffecom_sym_commit(s);
+
+ Does whatever the backend needs when a symbol is committed after having
+ been backtrackable for a period of time. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_sym_commit (ffesymbol s UNUSED)
+{
+ assert (!ffesymbol_retractable ());
+}
+
+#endif
+/* ffecom_sym_end_transition -- Perform end transition on all symbols
+
+ ffecom_sym_end_transition();
+
+ Does backend-specific stuff and also calls ffest_sym_end_transition
+ to do the necessary FFE stuff.
+
+ Backtracking is never enabled when this fn is called, so don't worry
+ about it. */
+
+ffesymbol
+ffecom_sym_end_transition (ffesymbol s)
+{
+ ffestorag st;
+
+ assert (!ffesymbol_retractable ());
+
+ s = ffest_sym_end_transition (s);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ if ((ffesymbol_kind (s) == FFEINFO_kindBLOCKDATA)
+ && (ffesymbol_where (s) == FFEINFO_whereGLOBAL))
+ {
+ ffecom_list_blockdata_
+ = ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE,
+ FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE),
+ ffecom_list_blockdata_);
+ }
+#endif
+
+ /* This is where we finally notice that a symbol has partial initialization
+ and finalize it. */
+
+ if (ffesymbol_accretion (s) != NULL)
+ {
+ assert (ffesymbol_init (s) == NULL);
+ ffecom_notify_init_symbol (s);
+ }
+ else if (((st = ffesymbol_storage (s)) != NULL)
+ && ((st = ffestorag_parent (st)) != NULL)
+ && (ffestorag_accretion (st) != NULL))
+ {
+ assert (ffestorag_init (st) == NULL);
+ ffecom_notify_init_storage (st);
+ }
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ if ((ffesymbol_kind (s) == FFEINFO_kindCOMMON)
+ && (ffesymbol_where (s) == FFEINFO_whereLOCAL)
+ && (ffesymbol_storage (s) != NULL))
+ {
+ ffecom_list_common_
+ = ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE,
+ FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE),
+ ffecom_list_common_);
+ }
+#endif
+
+ return s;
+}
+
+/* ffecom_sym_exec_transition -- Perform exec transition on all symbols
+
+ ffecom_sym_exec_transition();
+
+ Does backend-specific stuff and also calls ffest_sym_exec_transition
+ to do the necessary FFE stuff.
+
+ See the long-winded description in ffecom_sym_learned for info
+ on handling the situation where backtracking is inhibited. */
+
+ffesymbol
+ffecom_sym_exec_transition (ffesymbol s)
+{
+ s = ffest_sym_exec_transition (s);
+
+ return s;
+}
+
+/* ffecom_sym_learned -- Initial or more info gained on symbol after exec
+
+ ffesymbol s;
+ s = ffecom_sym_learned(s);
+
+ Called when a new symbol is seen after the exec transition or when more
+ info (perhaps) is gained for an UNCERTAIN symbol. The symbol state when
+ it arrives here is that all its latest info is updated already, so its
+ state may be UNCERTAIN or UNDERSTOOD, it might already have the hook
+ field filled in if its gone through here or exec_transition first, and
+ so on.
+
+ The backend probably wants to check ffesymbol_retractable() to see if
+ backtracking is in effect. If so, the FFE's changes to the symbol may
+ be retracted (undone) or committed (ratified), at which time the
+ appropriate ffecom_sym_retract or _commit function will be called
+ for that function.
+
+ If the backend has its own backtracking mechanism, great, use it so that
+ committal is a simple operation. Though it doesn't make much difference,
+ I suppose: the reason for tentative symbol evolution in the FFE is to
+ enable error detection in weird incorrect statements early and to disable
+ incorrect error detection on a correct statement. The backend is not
+ likely to introduce any information that'll get involved in these
+ considerations, so it is probably just fine that the implementation
+ model for this fn and for _exec_transition is to not do anything
+ (besides the required FFE stuff) if ffesymbol_retractable() returns TRUE
+ and instead wait until ffecom_sym_commit is called (which it never
+ will be as long as we're using ambiguity-detecting statement analysis in
+ the FFE, which we are initially to shake out the code, but don't depend
+ on this), otherwise go ahead and do whatever is needed.
+
+ In essence, then, when this fn and _exec_transition get called while
+ backtracking is enabled, a general mechanism would be to flag which (or
+ both) of these were called (and in what order? neat question as to what
+ might happen that I'm too lame to think through right now) and then when
+ _commit is called reproduce the original calling sequence, if any, for
+ the two fns (at which point backtracking will, of course, be disabled). */
+
+ffesymbol
+ffecom_sym_learned (ffesymbol s)
+{
+ ffestorag_exec_layout (s);
+
+ return s;
+}
+
+/* ffecom_sym_retract -- Symbol's state being retracted from reality
+
+ ffesymbol s;
+ ffecom_sym_retract(s);
+
+ Does whatever the backend needs when a symbol is retracted after having
+ been backtrackable for a period of time. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffecom_sym_retract (ffesymbol s UNUSED)
+{
+ assert (!ffesymbol_retractable ());
+
+#if 0 /* GCC doesn't commit any backtrackable sins,
+ so nothing needed here. */
+ switch (ffesymbol_hook (s).state)
+ {
+ case 0: /* nothing happened yet. */
+ break;
+
+ case 1: /* exec transition happened. */
+ break;
+
+ case 2: /* learned happened. */
+ break;
+
+ case 3: /* learned then exec. */
+ break;
+
+ case 4: /* exec then learned. */
+ break;
+
+ default:
+ assert ("bad hook state" == NULL);
+ break;
+ }
+#endif
+}
+
+#endif
+/* Create temporary gcc label. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_temp_label ()
+{
+ tree glabel;
+ static int mynumber = 0;
+
+ glabel = build_decl (LABEL_DECL,
+ ffecom_get_invented_identifier ("__g77_label_%d",
+ NULL,
+ mynumber++),
+ void_type_node);
+ DECL_CONTEXT (glabel) = current_function_decl;
+ DECL_MODE (glabel) = VOIDmode;
+
+ return glabel;
+}
+
+#endif
+/* Return an expression that is usable as an arg in a conditional context
+ (IF, DO WHILE, .NOT., and so on).
+
+ Use the one provided for the back end as of >2.6.0. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_truth_value (tree expr)
+{
+ return truthvalue_conversion (expr);
+}
+
+#endif
+/* Return the inversion of a truth value (the inversion of what
+ ffecom_truth_value builds).
+
+ Apparently invert_truthvalue, which is properly in the back end, is
+ enough for now, so just use it. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_truth_value_invert (tree expr)
+{
+ return invert_truthvalue (ffecom_truth_value (expr));
+}
+
+#endif
+/* Return PARM_DECL for arg#1 of master fn containing alternate ENTRY points
+
+ If the PARM_DECL already exists, return it, else create it. It's an
+ integer_type_node argument for the master function that implements a
+ subroutine or function with more than one entrypoint and is bound at
+ run time with the entrypoint number (0 for SUBROUTINE/FUNCTION, 1 for
+ first ENTRY statement, and so on). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree
+ffecom_which_entrypoint_decl ()
+{
+ assert (ffecom_which_entrypoint_decl_ != NULL_TREE);
+
+ return ffecom_which_entrypoint_decl_;
+}
+
+#endif
+
+/* The following sections consists of private and public functions
+ that have the same names and perform roughly the same functions
+ as counterparts in the C front end. Changes in the C front end
+ might affect how things should be done here. Only functions
+ needed by the back end should be public here; the rest should
+ be private (static in the C sense). Functions needed by other
+ g77 front-end modules should be accessed by them via public
+ ffecom_* names, which should themselves call private versions
+ in this section so the private versions are easy to recognize
+ when upgrading to a new gcc and finding interesting changes
+ in the front end.
+
+ Functions named after rule "foo:" in c-parse.y are named
+ "bison_rule_foo_" so they are easy to find. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+
+static void
+bison_rule_compstmt_ ()
+{
+ emit_line_note (input_filename, lineno);
+ expand_end_bindings (getdecls (), 1, 1);
+ poplevel (1, 1, 0);
+ pop_momentary ();
+}
+
+static void
+bison_rule_pushlevel_ ()
+{
+ emit_line_note (input_filename, lineno);
+ pushlevel (0);
+ clear_last_expr ();
+ push_momentary ();
+ expand_start_bindings (0);
+}
+
+/* Return a definition for a builtin function named NAME and whose data type
+ is TYPE. TYPE should be a function type with argument types.
+ FUNCTION_CODE tells later passes how to compile calls to this function.
+ See tree.h for its possible values.
+
+ If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+ the name to be called if we can't opencode the function. */
+
+static tree
+builtin_function (char *name, tree type,
+ enum built_in_function function_code, char *library_name)
+{
+ tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
+ DECL_EXTERNAL (decl) = 1;
+ TREE_PUBLIC (decl) = 1;
+ if (library_name)
+ DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name);
+ make_decl_rtl (decl, NULL_PTR, 1);
+ pushdecl (decl);
+ if (function_code != NOT_BUILT_IN)
+ {
+ DECL_BUILT_IN (decl) = 1;
+ DECL_FUNCTION_CODE (decl) = function_code;
+ }
+
+ return decl;
+}
+
+/* Handle when a new declaration NEWDECL
+ has the same name as an old one OLDDECL
+ in the same binding contour.
+ Prints an error message if appropriate.
+
+ If safely possible, alter OLDDECL to look like NEWDECL, and return 1.
+ Otherwise, return 0. */
+
+static int
+duplicate_decls (tree newdecl, tree olddecl)
+{
+ int types_match = 1;
+ int new_is_definition = (TREE_CODE (newdecl) == FUNCTION_DECL
+ && DECL_INITIAL (newdecl) != 0);
+ tree oldtype = TREE_TYPE (olddecl);
+ tree newtype = TREE_TYPE (newdecl);
+
+ if (olddecl == newdecl)
+ return 1;
+
+ if (TREE_CODE (newtype) == ERROR_MARK
+ || TREE_CODE (oldtype) == ERROR_MARK)
+ types_match = 0;
+
+ /* New decl is completely inconsistent with the old one =>
+ tell caller to replace the old one.
+ This is always an error except in the case of shadowing a builtin. */
+ if (TREE_CODE (olddecl) != TREE_CODE (newdecl))
+ return 0;
+
+ /* For real parm decl following a forward decl,
+ return 1 so old decl will be reused. */
+ if (types_match && TREE_CODE (newdecl) == PARM_DECL
+ && TREE_ASM_WRITTEN (olddecl) && ! TREE_ASM_WRITTEN (newdecl))
+ return 1;
+
+ /* The new declaration is the same kind of object as the old one.
+ The declarations may partially match. Print warnings if they don't
+ match enough. Ultimately, copy most of the information from the new
+ decl to the old one, and keep using the old one. */
+
+ if (TREE_CODE (olddecl) == FUNCTION_DECL
+ && DECL_BUILT_IN (olddecl))
+ {
+ /* A function declaration for a built-in function. */
+ if (!TREE_PUBLIC (newdecl))
+ return 0;
+ else if (!types_match)
+ {
+ /* Accept the return type of the new declaration if same modes. */
+ tree oldreturntype = TREE_TYPE (TREE_TYPE (olddecl));
+ tree newreturntype = TREE_TYPE (TREE_TYPE (newdecl));
+
+ /* Make sure we put the new type in the same obstack as the old ones.
+ If the old types are not both in the same obstack, use the
+ permanent one. */
+ if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype))
+ push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype));
+ else
+ {
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+ }
+
+ if (TYPE_MODE (oldreturntype) == TYPE_MODE (newreturntype))
+ {
+ /* Function types may be shared, so we can't just modify
+ the return type of olddecl's function type. */
+ tree newtype
+ = build_function_type (newreturntype,
+ TYPE_ARG_TYPES (TREE_TYPE (olddecl)));
+
+ types_match = 1;
+ if (types_match)
+ TREE_TYPE (olddecl) = newtype;
+ }
+
+ pop_obstacks ();
+ }
+ if (!types_match)
+ return 0;
+ }
+ else if (TREE_CODE (olddecl) == FUNCTION_DECL
+ && DECL_SOURCE_LINE (olddecl) == 0)
+ {
+ /* A function declaration for a predeclared function
+ that isn't actually built in. */
+ if (!TREE_PUBLIC (newdecl))
+ return 0;
+ else if (!types_match)
+ {
+ /* If the types don't match, preserve volatility indication.
+ Later on, we will discard everything else about the
+ default declaration. */
+ TREE_THIS_VOLATILE (newdecl) |= TREE_THIS_VOLATILE (olddecl);
+ }
+ }
+
+ /* Copy all the DECL_... slots specified in the new decl
+ except for any that we copy here from the old type.
+
+ Past this point, we don't change OLDTYPE and NEWTYPE
+ even if we change the types of NEWDECL and OLDDECL. */
+
+ if (types_match)
+ {
+ /* Make sure we put the new type in the same obstack as the old ones.
+ If the old types are not both in the same obstack, use the permanent
+ one. */
+ if (TYPE_OBSTACK (oldtype) == TYPE_OBSTACK (newtype))
+ push_obstacks (TYPE_OBSTACK (oldtype), TYPE_OBSTACK (oldtype));
+ else
+ {
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+ }
+
+ /* Merge the data types specified in the two decls. */
+ if (TREE_CODE (newdecl) != FUNCTION_DECL || !DECL_BUILT_IN (olddecl))
+ TREE_TYPE (newdecl)
+ = TREE_TYPE (olddecl)
+ = TREE_TYPE (newdecl);
+
+ /* Lay the type out, unless already done. */
+ if (oldtype != TREE_TYPE (newdecl))
+ {
+ if (TREE_TYPE (newdecl) != error_mark_node)
+ layout_type (TREE_TYPE (newdecl));
+ if (TREE_CODE (newdecl) != FUNCTION_DECL
+ && TREE_CODE (newdecl) != TYPE_DECL
+ && TREE_CODE (newdecl) != CONST_DECL)
+ layout_decl (newdecl, 0);
+ }
+ else
+ {
+ /* Since the type is OLDDECL's, make OLDDECL's size go with. */
+ DECL_SIZE (newdecl) = DECL_SIZE (olddecl);
+ if (TREE_CODE (olddecl) != FUNCTION_DECL)
+ if (DECL_ALIGN (olddecl) > DECL_ALIGN (newdecl))
+ DECL_ALIGN (newdecl) = DECL_ALIGN (olddecl);
+ }
+
+ /* Keep the old rtl since we can safely use it. */
+ DECL_RTL (newdecl) = DECL_RTL (olddecl);
+
+ /* Merge the type qualifiers. */
+ if (DECL_BUILT_IN_NONANSI (olddecl) && TREE_THIS_VOLATILE (olddecl)
+ && !TREE_THIS_VOLATILE (newdecl))
+ TREE_THIS_VOLATILE (olddecl) = 0;
+ if (TREE_READONLY (newdecl))
+ TREE_READONLY (olddecl) = 1;
+ if (TREE_THIS_VOLATILE (newdecl))
+ {
+ TREE_THIS_VOLATILE (olddecl) = 1;
+ if (TREE_CODE (newdecl) == VAR_DECL)
+ make_var_volatile (newdecl);
+ }
+
+ /* Keep source location of definition rather than declaration.
+ Likewise, keep decl at outer scope. */
+ if ((DECL_INITIAL (newdecl) == 0 && DECL_INITIAL (olddecl) != 0)
+ || (DECL_CONTEXT (newdecl) != 0 && DECL_CONTEXT (olddecl) == 0))
+ {
+ DECL_SOURCE_LINE (newdecl) = DECL_SOURCE_LINE (olddecl);
+ DECL_SOURCE_FILE (newdecl) = DECL_SOURCE_FILE (olddecl);
+
+ if (DECL_CONTEXT (olddecl) == 0
+ && TREE_CODE (newdecl) != FUNCTION_DECL)
+ DECL_CONTEXT (newdecl) = 0;
+ }
+
+ /* Merge the unused-warning information. */
+ if (DECL_IN_SYSTEM_HEADER (olddecl))
+ DECL_IN_SYSTEM_HEADER (newdecl) = 1;
+ else if (DECL_IN_SYSTEM_HEADER (newdecl))
+ DECL_IN_SYSTEM_HEADER (olddecl) = 1;
+
+ /* Merge the initialization information. */
+ if (DECL_INITIAL (newdecl) == 0)
+ DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl);
+
+ /* Merge the section attribute.
+ We want to issue an error if the sections conflict but that must be
+ done later in decl_attributes since we are called before attributes
+ are assigned. */
+ if (DECL_SECTION_NAME (newdecl) == NULL_TREE)
+ DECL_SECTION_NAME (newdecl) = DECL_SECTION_NAME (olddecl);
+
+#if BUILT_FOR_270
+ if (TREE_CODE (newdecl) == FUNCTION_DECL)
+ {
+ DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl);
+ DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl);
+ }
+#endif
+
+ pop_obstacks ();
+ }
+ /* If cannot merge, then use the new type and qualifiers,
+ and don't preserve the old rtl. */
+ else
+ {
+ TREE_TYPE (olddecl) = TREE_TYPE (newdecl);
+ TREE_READONLY (olddecl) = TREE_READONLY (newdecl);
+ TREE_THIS_VOLATILE (olddecl) = TREE_THIS_VOLATILE (newdecl);
+ TREE_SIDE_EFFECTS (olddecl) = TREE_SIDE_EFFECTS (newdecl);
+ }
+
+ /* Merge the storage class information. */
+ /* For functions, static overrides non-static. */
+ if (TREE_CODE (newdecl) == FUNCTION_DECL)
+ {
+ TREE_PUBLIC (newdecl) &= TREE_PUBLIC (olddecl);
+ /* This is since we don't automatically
+ copy the attributes of NEWDECL into OLDDECL. */
+ TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl);
+ /* If this clears `static', clear it in the identifier too. */
+ if (! TREE_PUBLIC (olddecl))
+ TREE_PUBLIC (DECL_NAME (olddecl)) = 0;
+ }
+ if (DECL_EXTERNAL (newdecl))
+ {
+ TREE_STATIC (newdecl) = TREE_STATIC (olddecl);
+ DECL_EXTERNAL (newdecl) = DECL_EXTERNAL (olddecl);
+ /* An extern decl does not override previous storage class. */
+ TREE_PUBLIC (newdecl) = TREE_PUBLIC (olddecl);
+ }
+ else
+ {
+ TREE_STATIC (olddecl) = TREE_STATIC (newdecl);
+ TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl);
+ }
+
+ /* If either decl says `inline', this fn is inline,
+ unless its definition was passed already. */
+ if (DECL_INLINE (newdecl) && DECL_INITIAL (olddecl) == 0)
+ DECL_INLINE (olddecl) = 1;
+ DECL_INLINE (newdecl) = DECL_INLINE (olddecl);
+
+ /* Get rid of any built-in function if new arg types don't match it
+ or if we have a function definition. */
+ if (TREE_CODE (newdecl) == FUNCTION_DECL
+ && DECL_BUILT_IN (olddecl)
+ && (!types_match || new_is_definition))
+ {
+ TREE_TYPE (olddecl) = TREE_TYPE (newdecl);
+ DECL_BUILT_IN (olddecl) = 0;
+ }
+
+ /* If redeclaring a builtin function, and not a definition,
+ it stays built in.
+ Also preserve various other info from the definition. */
+ if (TREE_CODE (newdecl) == FUNCTION_DECL && !new_is_definition)
+ {
+ if (DECL_BUILT_IN (olddecl))
+ {
+ DECL_BUILT_IN (newdecl) = 1;
+ DECL_FUNCTION_CODE (newdecl) = DECL_FUNCTION_CODE (olddecl);
+ }
+ else
+ DECL_FRAME_SIZE (newdecl) = DECL_FRAME_SIZE (olddecl);
+
+ DECL_RESULT (newdecl) = DECL_RESULT (olddecl);
+ DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl);
+ DECL_SAVED_INSNS (newdecl) = DECL_SAVED_INSNS (olddecl);
+ DECL_ARGUMENTS (newdecl) = DECL_ARGUMENTS (olddecl);
+ }
+
+ /* Copy most of the decl-specific fields of NEWDECL into OLDDECL.
+ But preserve olddecl's DECL_UID. */
+ {
+ register unsigned olddecl_uid = DECL_UID (olddecl);
+
+ bcopy ((char *) newdecl + sizeof (struct tree_common),
+ (char *) olddecl + sizeof (struct tree_common),
+ sizeof (struct tree_decl) - sizeof (struct tree_common));
+ DECL_UID (olddecl) = olddecl_uid;
+ }
+
+ return 1;
+}
+
+/* Finish processing of a declaration;
+ install its initial value.
+ If the length of an array type is not known before,
+ it must be determined now, from the initial value, or it is an error. */
+
+static void
+finish_decl (tree decl, tree init, bool is_top_level)
+{
+ register tree type = TREE_TYPE (decl);
+ int was_incomplete = (DECL_SIZE (decl) == 0);
+ int temporary = allocation_temporary_p ();
+ bool at_top_level = (current_binding_level == global_binding_level);
+ bool top_level = is_top_level || at_top_level;
+
+ /* Caller should pass TRUE for is_top_level only if we wouldn't be at top
+ level anyway. */
+ assert (!is_top_level || !at_top_level);
+
+ if (TREE_CODE (decl) == PARM_DECL)
+ assert (init == NULL_TREE);
+ /* Remember that PARM_DECL doesn't have a DECL_INITIAL field per se -- it
+ overlaps DECL_ARG_TYPE. */
+ else if (init == NULL_TREE)
+ assert (DECL_INITIAL (decl) == NULL_TREE);
+ else
+ assert (DECL_INITIAL (decl) == error_mark_node);
+
+ if (init != NULL_TREE)
+ {
+ if (TREE_CODE (decl) != TYPE_DECL)
+ DECL_INITIAL (decl) = init;
+ else
+ {
+ /* typedef foo = bar; store the type of bar as the type of foo. */
+ TREE_TYPE (decl) = TREE_TYPE (init);
+ DECL_INITIAL (decl) = init = 0;
+ }
+ }
+
+ /* Pop back to the obstack that is current for this binding level. This is
+ because MAXINDEX, rtl, etc. to be made below must go in the permanent
+ obstack. But don't discard the temporary data yet. */
+ pop_obstacks ();
+
+ /* Deduce size of array from initialization, if not already known */
+
+ if (TREE_CODE (type) == ARRAY_TYPE
+ && TYPE_DOMAIN (type) == 0
+ && TREE_CODE (decl) != TYPE_DECL)
+ {
+ assert (top_level);
+ assert (was_incomplete);
+
+ layout_decl (decl, 0);
+ }
+
+ if (TREE_CODE (decl) == VAR_DECL)
+ {
+ if (DECL_SIZE (decl) == NULL_TREE
+ && TYPE_SIZE (TREE_TYPE (decl)) != NULL_TREE)
+ layout_decl (decl, 0);
+
+ if (DECL_SIZE (decl) == NULL_TREE
+ && (TREE_STATIC (decl)
+ ?
+ /* A static variable with an incomplete type is an error if it is
+ initialized. Also if it is not file scope. Otherwise, let it
+ through, but if it is not `extern' then it may cause an error
+ message later. */
+ (DECL_INITIAL (decl) != 0 || DECL_CONTEXT (decl) != 0)
+ :
+ /* An automatic variable with an incomplete type is an error. */
+ !DECL_EXTERNAL (decl)))
+ {
+ assert ("storage size not known" == NULL);
+ abort ();
+ }
+
+ if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl))
+ && (DECL_SIZE (decl) != 0)
+ && (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST))
+ {
+ assert ("storage size not constant" == NULL);
+ abort ();
+ }
+ }
+
+ /* Output the assembler code and/or RTL code for variables and functions,
+ unless the type is an undefined structure or union. If not, it will get
+ done when the type is completed. */
+
+ if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL)
+ {
+ rest_of_decl_compilation (decl, NULL,
+ DECL_CONTEXT (decl) == 0,
+ 0);
+
+ if (DECL_CONTEXT (decl) != 0)
+ {
+ /* Recompute the RTL of a local array now if it used to be an
+ incomplete type. */
+ if (was_incomplete
+ && !TREE_STATIC (decl) && !DECL_EXTERNAL (decl))
+ {
+ /* If we used it already as memory, it must stay in memory. */
+ TREE_ADDRESSABLE (decl) = TREE_USED (decl);
+ /* If it's still incomplete now, no init will save it. */
+ if (DECL_SIZE (decl) == 0)
+ DECL_INITIAL (decl) = 0;
+ expand_decl (decl);
+ }
+ /* Compute and store the initial value. */
+ if (TREE_CODE (decl) != FUNCTION_DECL)
+ expand_decl_init (decl);
+ }
+ }
+ else if (TREE_CODE (decl) == TYPE_DECL)
+ {
+ rest_of_decl_compilation (decl, NULL_PTR,
+ DECL_CONTEXT (decl) == 0,
+ 0);
+ }
+
+ /* This test used to include TREE_PERMANENT, however, we have the same
+ problem with initializers at the function level. Such initializers get
+ saved until the end of the function on the momentary_obstack. */
+ if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl))
+ && temporary
+ /* DECL_INITIAL is not defined in PARM_DECLs, since it shares space with
+ DECL_ARG_TYPE. */
+ && TREE_CODE (decl) != PARM_DECL)
+ {
+ /* We need to remember that this array HAD an initialization, but
+ discard the actual temporary nodes, since we can't have a permanent
+ node keep pointing to them. */
+ /* We make an exception for inline functions, since it's normal for a
+ local extern redeclaration of an inline function to have a copy of
+ the top-level decl's DECL_INLINE. */
+ if ((DECL_INITIAL (decl) != 0)
+ && (DECL_INITIAL (decl) != error_mark_node))
+ {
+ /* If this is a const variable, then preserve the
+ initializer instead of discarding it so that we can optimize
+ references to it. */
+ /* This test used to include TREE_STATIC, but this won't be set
+ for function level initializers. */
+ if (TREE_READONLY (decl))
+ {
+ preserve_initializer ();
+ /* Hack? Set the permanent bit for something that is
+ permanent, but not on the permenent obstack, so as to
+ convince output_constant_def to make its rtl on the
+ permanent obstack. */
+ TREE_PERMANENT (DECL_INITIAL (decl)) = 1;
+
+ /* The initializer and DECL must have the same (or equivalent
+ types), but if the initializer is a STRING_CST, its type
+ might not be on the right obstack, so copy the type
+ of DECL. */
+ TREE_TYPE (DECL_INITIAL (decl)) = type;
+ }
+ else
+ DECL_INITIAL (decl) = error_mark_node;
+ }
+ }
+
+ /* If requested, warn about definitions of large data objects. */
+
+ if (warn_larger_than
+ && (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == PARM_DECL)
+ && !DECL_EXTERNAL (decl))
+ {
+ register tree decl_size = DECL_SIZE (decl);
+
+ if (decl_size && TREE_CODE (decl_size) == INTEGER_CST)
+ {
+ unsigned units = TREE_INT_CST_LOW (decl_size) / BITS_PER_UNIT;
+
+ if (units > larger_than_size)
+ warning_with_decl (decl, "size of `%s' is %u bytes", units);
+ }
+ }
+
+ /* If we have gone back from temporary to permanent allocation, actually
+ free the temporary space that we no longer need. */
+ if (temporary && !allocation_temporary_p ())
+ permanent_allocation (0);
+
+ /* At the end of a declaration, throw away any variable type sizes of types
+ defined inside that declaration. There is no use computing them in the
+ following function definition. */
+ if (current_binding_level == global_binding_level)
+ get_pending_sizes ();
+}
+
+/* Finish up a function declaration and compile that function
+ all the way to assembler language output. The free the storage
+ for the function definition.
+
+ This is called after parsing the body of the function definition.
+
+ NESTED is nonzero if the function being finished is nested in another. */
+
+static void
+finish_function (int nested)
+{
+ register tree fndecl = current_function_decl;
+
+ assert (fndecl != NULL_TREE);
+ if (nested)
+ assert (DECL_CONTEXT (fndecl) != NULL_TREE);
+ else
+ assert (DECL_CONTEXT (fndecl) == NULL_TREE);
+
+/* TREE_READONLY (fndecl) = 1;
+ This caused &foo to be of type ptr-to-const-function
+ which then got a warning when stored in a ptr-to-function variable. */
+
+ poplevel (1, 0, 1);
+ BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+ /* Must mark the RESULT_DECL as being in this function. */
+
+ DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+
+ /* Obey `register' declarations if `setjmp' is called in this fn. */
+ /* Generate rtl for function exit. */
+ expand_function_end (input_filename, lineno, 0);
+
+ /* So we can tell if jump_optimize sets it to 1. */
+ can_reach_end = 0;
+
+ /* Run the optimizers and output the assembler code for this function. */
+ rest_of_compilation (fndecl);
+
+ /* Free all the tree nodes making up this function. */
+ /* Switch back to allocating nodes permanently until we start another
+ function. */
+ if (!nested)
+ permanent_allocation (1);
+
+ if (DECL_SAVED_INSNS (fndecl) == 0 && !nested)
+ {
+ /* Stop pointing to the local nodes about to be freed. */
+ /* But DECL_INITIAL must remain nonzero so we know this was an actual
+ function definition. */
+ /* For a nested function, this is done in pop_f_function_context. */
+ /* If rest_of_compilation set this to 0, leave it 0. */
+ if (DECL_INITIAL (fndecl) != 0)
+ DECL_INITIAL (fndecl) = error_mark_node;
+ DECL_ARGUMENTS (fndecl) = 0;
+ }
+
+ if (!nested)
+ {
+ /* Let the error reporting routines know that we're outside a function.
+ For a nested function, this value is used in pop_c_function_context
+ and then reset via pop_function_context. */
+ ffecom_outer_function_decl_ = current_function_decl = NULL;
+ }
+}
+
+/* Plug-in replacement for identifying the name of a decl and, for a
+ function, what we call it in diagnostics. For now, "program unit"
+ should suffice, since it's a bit of a hassle to figure out which
+ of several kinds of things it is. Note that it could conceivably
+ be a statement function, which probably isn't really a program unit
+ per se, but if that comes up, it should be easy to check (being a
+ nested function and all). */
+
+static char *
+lang_printable_name (tree decl, char **kind)
+{
+ *kind = "program unit";
+ return IDENTIFIER_POINTER (DECL_NAME (decl));
+}
+
+/* g77's function to print out name of current function that caused
+ an error. */
+
+#if BUILT_FOR_270
+void
+lang_print_error_function (file)
+ char *file;
+{
+ static ffesymbol last_s = NULL;
+ ffesymbol s;
+ char *kind;
+
+ if (ffecom_primary_entry_ == NULL)
+ {
+ s = NULL;
+ kind = NULL;
+ }
+ else if (ffecom_nested_entry_ == NULL)
+ {
+ s = ffecom_primary_entry_;
+ switch (ffesymbol_kind (s))
+ {
+ case FFEINFO_kindFUNCTION:
+ kind = "function";
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ kind = "subroutine";
+ break;
+
+ case FFEINFO_kindPROGRAM:
+ kind = "program";
+ break;
+
+ case FFEINFO_kindBLOCKDATA:
+ kind = "block-data";
+ break;
+
+ default:
+ kind = ffeinfo_kind_message (ffesymbol_kind (s));
+ break;
+ }
+ }
+ else
+ {
+ s = ffecom_nested_entry_;
+ kind = "statement function";
+ }
+
+ if (last_s != s)
+ {
+ if (file)
+ fprintf (stderr, "%s: ", file);
+
+ if (s == NULL)
+ fprintf (stderr, "Outside of any program unit:\n");
+ else
+ {
+ char *name = ffesymbol_text (s);
+
+ fprintf (stderr, "In %s `%s':\n", kind, name);
+ }
+
+ last_s = s;
+ }
+}
+#endif
+
+/* Similar to `lookup_name' but look only at current binding level. */
+
+static tree
+lookup_name_current_level (tree name)
+{
+ register tree t;
+
+ if (current_binding_level == global_binding_level)
+ return IDENTIFIER_GLOBAL_VALUE (name);
+
+ if (IDENTIFIER_LOCAL_VALUE (name) == 0)
+ return 0;
+
+ for (t = current_binding_level->names; t; t = TREE_CHAIN (t))
+ if (DECL_NAME (t) == name)
+ break;
+
+ return t;
+}
+
+/* Create a new `struct binding_level'. */
+
+static struct binding_level *
+make_binding_level ()
+{
+ /* NOSTRICT */
+ return (struct binding_level *) xmalloc (sizeof (struct binding_level));
+}
+
+/* Save and restore the variables in this file and elsewhere
+ that keep track of the progress of compilation of the current function.
+ Used for nested functions. */
+
+struct f_function
+{
+ struct f_function *next;
+ tree named_labels;
+ tree shadowed_labels;
+ struct binding_level *binding_level;
+};
+
+struct f_function *f_function_chain;
+
+/* Restore the variables used during compilation of a C function. */
+
+static void
+pop_f_function_context ()
+{
+ struct f_function *p = f_function_chain;
+ tree link;
+
+ /* Bring back all the labels that were shadowed. */
+ for (link = shadowed_labels; link; link = TREE_CHAIN (link))
+ if (DECL_NAME (TREE_VALUE (link)) != 0)
+ IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link)))
+ = TREE_VALUE (link);
+
+ if (DECL_SAVED_INSNS (current_function_decl) == 0)
+ {
+ /* Stop pointing to the local nodes about to be freed. */
+ /* But DECL_INITIAL must remain nonzero so we know this was an actual
+ function definition. */
+ DECL_INITIAL (current_function_decl) = error_mark_node;
+ DECL_ARGUMENTS (current_function_decl) = 0;
+ }
+
+ pop_function_context ();
+
+ f_function_chain = p->next;
+
+ named_labels = p->named_labels;
+ shadowed_labels = p->shadowed_labels;
+ current_binding_level = p->binding_level;
+
+ free (p);
+}
+
+/* Save and reinitialize the variables
+ used during compilation of a C function. */
+
+static void
+push_f_function_context ()
+{
+ struct f_function *p
+ = (struct f_function *) xmalloc (sizeof (struct f_function));
+
+ push_function_context ();
+
+ p->next = f_function_chain;
+ f_function_chain = p;
+
+ p->named_labels = named_labels;
+ p->shadowed_labels = shadowed_labels;
+ p->binding_level = current_binding_level;
+}
+
+static void
+push_parm_decl (tree parm)
+{
+ int old_immediate_size_expand = immediate_size_expand;
+
+ /* Don't try computing parm sizes now -- wait till fn is called. */
+
+ immediate_size_expand = 0;
+
+ push_obstacks_nochange ();
+
+ /* Fill in arg stuff. */
+
+ DECL_ARG_TYPE (parm) = TREE_TYPE (parm);
+ DECL_ARG_TYPE_AS_WRITTEN (parm) = TREE_TYPE (parm);
+ TREE_READONLY (parm) = 1; /* All implementation args are read-only. */
+
+ parm = pushdecl (parm);
+
+ immediate_size_expand = old_immediate_size_expand;
+
+ finish_decl (parm, NULL_TREE, FALSE);
+}
+
+/* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL, if appropriate. */
+
+static tree
+pushdecl_top_level (x)
+ tree x;
+{
+ register tree t;
+ register struct binding_level *b = current_binding_level;
+ register tree f = current_function_decl;
+
+ current_binding_level = global_binding_level;
+ current_function_decl = NULL_TREE;
+ t = pushdecl (x);
+ current_binding_level = b;
+ current_function_decl = f;
+ return t;
+}
+
+/* Store the list of declarations of the current level.
+ This is done for the parameter declarations of a function being defined,
+ after they are modified in the light of any missing parameters. */
+
+static tree
+storedecls (decls)
+ tree decls;
+{
+ return current_binding_level->names = decls;
+}
+
+/* Store the parameter declarations into the current function declaration.
+ This is called after parsing the parameter declarations, before
+ digesting the body of the function.
+
+ For an old-style definition, modify the function's type
+ to specify at least the number of arguments. */
+
+static void
+store_parm_decls (int is_main_program UNUSED)
+{
+ register tree fndecl = current_function_decl;
+
+ /* This is a chain of PARM_DECLs from old-style parm declarations. */
+ DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ()));
+
+ /* Initialize the RTL code for the function. */
+
+ init_function_start (fndecl, input_filename, lineno);
+
+ /* Set up parameters and prepare for return, for the function. */
+
+ expand_function_start (fndecl, 0);
+}
+
+static tree
+start_decl (tree decl, bool is_top_level)
+{
+ register tree tem;
+ bool at_top_level = (current_binding_level == global_binding_level);
+ bool top_level = is_top_level || at_top_level;
+
+ /* Caller should pass TRUE for is_top_level only if we wouldn't be at top
+ level anyway. */
+ assert (!is_top_level || !at_top_level);
+
+ /* The corresponding pop_obstacks is in finish_decl. */
+ push_obstacks_nochange ();
+
+ if (DECL_INITIAL (decl) != NULL_TREE)
+ {
+ assert (DECL_INITIAL (decl) == error_mark_node);
+ assert (!DECL_EXTERNAL (decl));
+ }
+ else if (top_level)
+ assert ((TREE_STATIC (decl) == 1) || DECL_EXTERNAL (decl) == 1);
+
+ /* For Fortran, we by default put things in .common when possible. */
+ DECL_COMMON (decl) = 1;
+
+ /* Add this decl to the current binding level. TEM may equal DECL or it may
+ be a previous decl of the same name. */
+ if (is_top_level)
+ tem = pushdecl_top_level (decl);
+ else
+ tem = pushdecl (decl);
+
+ /* For a local variable, define the RTL now. */
+ if (!top_level
+ /* But not if this is a duplicate decl and we preserved the rtl from the
+ previous one (which may or may not happen). */
+ && DECL_RTL (tem) == 0)
+ {
+ if (TYPE_SIZE (TREE_TYPE (tem)) != 0)
+ expand_decl (tem);
+ else if (TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE
+ && DECL_INITIAL (tem) != 0)
+ expand_decl (tem);
+ }
+
+ if (DECL_INITIAL (tem) != NULL_TREE)
+ {
+ /* When parsing and digesting the initializer, use temporary storage.
+ Do this even if we will ignore the value. */
+ if (at_top_level)
+ temporary_allocation ();
+ }
+
+ return tem;
+}
+
+/* Create the FUNCTION_DECL for a function definition.
+ DECLSPECS and DECLARATOR are the parts of the declaration;
+ they describe the function's name and the type it returns,
+ but twisted together in a fashion that parallels the syntax of C.
+
+ This function creates a binding context for the function body
+ as well as setting up the FUNCTION_DECL in current_function_decl.
+
+ Returns 1 on success. If the DECLARATOR is not suitable for a function
+ (it defines a datum instead), we return 0, which tells
+ yyparse to report a parse error.
+
+ NESTED is nonzero for a function nested within another function. */
+
+static void
+start_function (tree name, tree type, int nested, int public)
+{
+ tree decl1;
+ tree restype;
+ int old_immediate_size_expand = immediate_size_expand;
+
+ named_labels = 0;
+ shadowed_labels = 0;
+
+ /* Don't expand any sizes in the return type of the function. */
+ immediate_size_expand = 0;
+
+ if (nested)
+ {
+ assert (!public);
+ assert (current_function_decl != NULL_TREE);
+ assert (DECL_CONTEXT (current_function_decl) == NULL_TREE);
+ }
+ else
+ {
+ assert (current_function_decl == NULL_TREE);
+ }
+
+ decl1 = build_decl (FUNCTION_DECL,
+ name,
+ type);
+ TREE_PUBLIC (decl1) = public ? 1 : 0;
+ if (nested)
+ DECL_INLINE (decl1) = 1;
+ TREE_STATIC (decl1) = 1;
+ DECL_EXTERNAL (decl1) = 0;
+
+ announce_function (decl1);
+
+ /* Make the init_value nonzero so pushdecl knows this is not tentative.
+ error_mark_node is replaced below (in poplevel) with the BLOCK. */
+ DECL_INITIAL (decl1) = error_mark_node;
+
+ /* Record the decl so that the function name is defined. If we already have
+ a decl for this name, and it is a FUNCTION_DECL, use the old decl. */
+
+ current_function_decl = pushdecl (decl1);
+ if (!nested)
+ ffecom_outer_function_decl_ = current_function_decl;
+
+ pushlevel (0);
+
+ make_function_rtl (current_function_decl);
+
+ restype = TREE_TYPE (TREE_TYPE (current_function_decl));
+ DECL_RESULT (current_function_decl)
+ = build_decl (RESULT_DECL, NULL_TREE, restype);
+
+ if (!nested)
+ /* Allocate further tree nodes temporarily during compilation of this
+ function only. */
+ temporary_allocation ();
+
+ if (!nested)
+ TREE_ADDRESSABLE (current_function_decl) = 1;
+
+ immediate_size_expand = old_immediate_size_expand;
+}
+
+/* Here are the public functions the GNU back end needs. */
+
+/* This is used by the `assert' macro. It is provided in libgcc.a,
+ which `cc' doesn't know how to link. Note that the C++ front-end
+ no longer actually uses the `assert' macro (instead, it calls
+ my_friendly_assert). But all of the back-end files still need this. */
+void
+__eprintf (string, expression, line, filename)
+#ifdef __STDC__
+ const char *string;
+ const char *expression;
+ unsigned line;
+ const char *filename;
+#else
+ char *string;
+ char *expression;
+ unsigned line;
+ char *filename;
+#endif
+{
+ fprintf (stderr, string, expression, line, filename);
+ fflush (stderr);
+ abort ();
+}
+
+tree
+convert (type, expr)
+ tree type, expr;
+{
+ register tree e = expr;
+ register enum tree_code code = TREE_CODE (type);
+
+ if (type == TREE_TYPE (e)
+ || TREE_CODE (e) == ERROR_MARK)
+ return e;
+ if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
+ return fold (build1 (NOP_EXPR, type, e));
+ if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
+ || code == ERROR_MARK)
+ return error_mark_node;
+ if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
+ {
+ assert ("void value not ignored as it ought to be" == NULL);
+ return error_mark_node;
+ }
+ if (code == VOID_TYPE)
+ return build1 (CONVERT_EXPR, type, e);
+ if ((code != RECORD_TYPE)
+ && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
+ e = ffecom_1 (REALPART_EXPR, TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e))),
+ e);
+ if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+ return fold (convert_to_integer (type, e));
+ if (code == POINTER_TYPE)
+ return fold (convert_to_pointer (type, e));
+ if (code == REAL_TYPE)
+ return fold (convert_to_real (type, e));
+ if (code == COMPLEX_TYPE)
+ return fold (convert_to_complex (type, e));
+ if (code == RECORD_TYPE)
+ return fold (ffecom_convert_to_complex_ (type, e));
+
+ assert ("conversion to non-scalar type requested" == NULL);
+ return error_mark_node;
+}
+
+/* integrate_decl_tree calls this function, but since we don't use the
+ DECL_LANG_SPECIFIC field, this is a no-op. */
+
+void
+copy_lang_decl (node)
+ tree node UNUSED;
+{
+}
+
+/* Return the list of declarations of the current level.
+ Note that this list is in reverse order unless/until
+ you nreverse it; and when you do nreverse it, you must
+ store the result back using `storedecls' or you will lose. */
+
+tree
+getdecls ()
+{
+ return current_binding_level->names;
+}
+
+/* Nonzero if we are currently in the global binding level. */
+
+int
+global_bindings_p ()
+{
+ return current_binding_level == global_binding_level;
+}
+
+/* Insert BLOCK at the end of the list of subblocks of the
+ current binding level. This is used when a BIND_EXPR is expanded,
+ to handle the BLOCK node inside the BIND_EXPR. */
+
+void
+incomplete_type_error (value, type)
+ tree value UNUSED;
+ tree type;
+{
+ if (TREE_CODE (type) == ERROR_MARK)
+ return;
+
+ assert ("incomplete type?!?" == NULL);
+}
+
+void
+init_decl_processing ()
+{
+ malloc_init ();
+ ffe_init_0 ();
+}
+
+void
+init_lex ()
+{
+#if BUILT_FOR_270
+ extern void (*print_error_function) (char *);
+#endif
+
+ /* Make identifier nodes long enough for the language-specific slots. */
+ set_identifier_size (sizeof (struct lang_identifier));
+ decl_printable_name = lang_printable_name;
+#if BUILT_FOR_270
+ print_error_function = lang_print_error_function;
+#endif
+}
+
+void
+insert_block (block)
+ tree block;
+{
+ TREE_USED (block) = 1;
+ current_binding_level->blocks
+ = chainon (current_binding_level->blocks, block);
+}
+
+int
+lang_decode_option (p)
+ char *p;
+{
+ return ffe_decode_option (p);
+}
+
+void
+lang_finish ()
+{
+ ffe_terminate_0 ();
+
+ if (ffe_is_ffedebug ())
+ malloc_pool_display (malloc_pool_image ());
+}
+
+char *
+lang_identify ()
+{
+ return "f77";
+}
+
+void
+lang_init ()
+{
+ extern FILE *finput; /* Don't pollute com.h with this. */
+
+ /* If the file is output from cpp, it should contain a first line
+ `# 1 "real-filename"', and the current design of gcc (toplev.c
+ in particular and the way it sets up information relied on by
+ INCLUDE) requires that we read this now, and store the
+ "real-filename" info in master_input_filename. Ask the lexer
+ to try doing this. */
+ ffelex_hash_kludge (finput);
+}
+
+int
+mark_addressable (exp)
+ tree exp;
+{
+ register tree x = exp;
+ while (1)
+ switch (TREE_CODE (x))
+ {
+ case ADDR_EXPR:
+ case COMPONENT_REF:
+ case ARRAY_REF:
+ x = TREE_OPERAND (x, 0);
+ break;
+
+ case CONSTRUCTOR:
+ TREE_ADDRESSABLE (x) = 1;
+ return 1;
+
+ case VAR_DECL:
+ case CONST_DECL:
+ case PARM_DECL:
+ case RESULT_DECL:
+ if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)
+ && DECL_NONLOCAL (x))
+ {
+ if (TREE_PUBLIC (x))
+ {
+ assert ("address of global register var requested" == NULL);
+ return 0;
+ }
+ assert ("address of register variable requested" == NULL);
+ }
+ else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
+ {
+ if (TREE_PUBLIC (x))
+ {
+ assert ("address of global register var requested" == NULL);
+ return 0;
+ }
+ assert ("address of register var requested" == NULL);
+ }
+ put_var_into_stack (x);
+
+ /* drops in */
+ case FUNCTION_DECL:
+ TREE_ADDRESSABLE (x) = 1;
+#if 0 /* poplevel deals with this now. */
+ if (DECL_CONTEXT (x) == 0)
+ TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x)) = 1;
+#endif
+
+ default:
+ return 1;
+ }
+}
+
+/* If DECL has a cleanup, build and return that cleanup here.
+ This is a callback called by expand_expr. */
+
+tree
+maybe_build_cleanup (decl)
+ tree decl UNUSED;
+{
+ /* There are no cleanups in Fortran. */
+ return NULL_TREE;
+}
+
+/* Exit a binding level.
+ Pop the level off, and restore the state of the identifier-decl mappings
+ that were in effect when this level was entered.
+
+ If KEEP is nonzero, this level had explicit declarations, so
+ and create a "block" (a BLOCK node) for the level
+ to record its declarations and subblocks for symbol table output.
+
+ If FUNCTIONBODY is nonzero, this level is the body of a function,
+ so create a block as if KEEP were set and also clear out all
+ label names.
+
+ If REVERSE is nonzero, reverse the order of decls before putting
+ them into the BLOCK. */
+
+tree
+poplevel (keep, reverse, functionbody)
+ int keep;
+ int reverse;
+ int functionbody;
+{
+ register tree link;
+ /* The chain of decls was accumulated in reverse order. Put it into forward
+ order, just for cleanliness. */
+ tree decls;
+ tree subblocks = current_binding_level->blocks;
+ tree block = 0;
+ tree decl;
+ int block_previously_created;
+
+ /* Get the decls in the order they were written. Usually
+ current_binding_level->names is in reverse order. But parameter decls
+ were previously put in forward order. */
+
+ if (reverse)
+ current_binding_level->names
+ = decls = nreverse (current_binding_level->names);
+ else
+ decls = current_binding_level->names;
+
+ /* Output any nested inline functions within this block if they weren't
+ already output. */
+
+ for (decl = decls; decl; decl = TREE_CHAIN (decl))
+ if (TREE_CODE (decl) == FUNCTION_DECL
+ && !TREE_ASM_WRITTEN (decl)
+ && DECL_INITIAL (decl) != 0
+ && TREE_ADDRESSABLE (decl))
+ {
+ /* If this decl was copied from a file-scope decl on account of a
+ block-scope extern decl, propagate TREE_ADDRESSABLE to the
+ file-scope decl. */
+ if (DECL_ABSTRACT_ORIGIN (decl) != 0)
+ TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
+ else
+ {
+ push_function_context ();
+ output_inline_function (decl);
+ pop_function_context ();
+ }
+ }
+
+ /* If there were any declarations or structure tags in that level, or if
+ this level is a function body, create a BLOCK to record them for the
+ life of this function. */
+
+ block = 0;
+ block_previously_created = (current_binding_level->this_block != 0);
+ if (block_previously_created)
+ block = current_binding_level->this_block;
+ else if (keep || functionbody)
+ block = make_node (BLOCK);
+ if (block != 0)
+ {
+ BLOCK_VARS (block) = decls;
+ BLOCK_SUBBLOCKS (block) = subblocks;
+ remember_end_note (block);
+ }
+
+ /* In each subblock, record that this is its superior. */
+
+ for (link = subblocks; link; link = TREE_CHAIN (link))
+ BLOCK_SUPERCONTEXT (link) = block;
+
+ /* Clear out the meanings of the local variables of this level. */
+
+ for (link = decls; link; link = TREE_CHAIN (link))
+ {
+ if (DECL_NAME (link) != 0)
+ {
+ /* If the ident. was used or addressed via a local extern decl,
+ don't forget that fact. */
+ if (DECL_EXTERNAL (link))
+ {
+ if (TREE_USED (link))
+ TREE_USED (DECL_NAME (link)) = 1;
+ if (TREE_ADDRESSABLE (link))
+ TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (link)) = 1;
+ }
+ IDENTIFIER_LOCAL_VALUE (DECL_NAME (link)) = 0;
+ }
+ }
+
+ /* If the level being exited is the top level of a function, check over all
+ the labels, and clear out the current (function local) meanings of their
+ names. */
+
+ if (functionbody)
+ {
+ /* If this is the top level block of a function, the vars are the
+ function's parameters. Don't leave them in the BLOCK because they
+ are found in the FUNCTION_DECL instead. */
+
+ BLOCK_VARS (block) = 0;
+ }
+
+ /* Pop the current level, and free the structure for reuse. */
+
+ {
+ register struct binding_level *level = current_binding_level;
+ current_binding_level = current_binding_level->level_chain;
+
+ level->level_chain = free_binding_level;
+ free_binding_level = level;
+ }
+
+ /* Dispose of the block that we just made inside some higher level. */
+ if (functionbody)
+ DECL_INITIAL (current_function_decl) = block;
+ else if (block)
+ {
+ if (!block_previously_created)
+ current_binding_level->blocks
+ = chainon (current_binding_level->blocks, block);
+ }
+ /* If we did not make a block for the level just exited, any blocks made
+ for inner levels (since they cannot be recorded as subblocks in that
+ level) must be carried forward so they will later become subblocks of
+ something else. */
+ else if (subblocks)
+ current_binding_level->blocks
+ = chainon (current_binding_level->blocks, subblocks);
+
+ /* Set the TYPE_CONTEXTs for all of the tagged types belonging to this
+ binding contour so that they point to the appropriate construct, i.e.
+ either to the current FUNCTION_DECL node, or else to the BLOCK node we
+ just constructed.
+
+ Note that for tagged types whose scope is just the formal parameter list
+ for some function type specification, we can't properly set their
+ TYPE_CONTEXTs here, because we don't have a pointer to the appropriate
+ FUNCTION_TYPE node readily available to us. For those cases, the
+ TYPE_CONTEXTs of the relevant tagged type nodes get set in
+ `grokdeclarator' as soon as we have created the FUNCTION_TYPE node which
+ will represent the "scope" for these "parameter list local" tagged
+ types. */
+
+ if (block)
+ TREE_USED (block) = 1;
+ return block;
+}
+
+void
+print_lang_decl (file, node, indent)
+ FILE *file UNUSED;
+ tree node UNUSED;
+ int indent UNUSED;
+{
+}
+
+void
+print_lang_identifier (file, node, indent)
+ FILE *file;
+ tree node;
+ int indent;
+{
+ print_node (file, "global", IDENTIFIER_GLOBAL_VALUE (node), indent + 4);
+ print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4);
+}
+
+void
+print_lang_statistics ()
+{
+}
+
+void
+print_lang_type (file, node, indent)
+ FILE *file UNUSED;
+ tree node UNUSED;
+ int indent UNUSED;
+{
+}
+
+/* Record a decl-node X as belonging to the current lexical scope.
+ Check for errors (such as an incompatible declaration for the same
+ name already seen in the same scope).
+
+ Returns either X or an old decl for the same name.
+ If an old decl is returned, it may have been smashed
+ to agree with what X says. */
+
+tree
+pushdecl (x)
+ tree x;
+{
+ register tree t;
+ register tree name = DECL_NAME (x);
+ register struct binding_level *b = current_binding_level;
+
+ if ((TREE_CODE (x) == FUNCTION_DECL)
+ && (DECL_INITIAL (x) == 0)
+ && DECL_EXTERNAL (x))
+ DECL_CONTEXT (x) = NULL_TREE;
+ else
+ DECL_CONTEXT (x) = current_function_decl;
+
+ if (name)
+ {
+ if (IDENTIFIER_INVENTED (name))
+ {
+#if BUILT_FOR_270
+ DECL_ARTIFICIAL (x) = 1;
+#endif
+ DECL_IN_SYSTEM_HEADER (x) = 1;
+ DECL_IGNORED_P (x) = 1;
+ TREE_USED (x) = 1;
+ if (TREE_CODE (x) == TYPE_DECL)
+ TYPE_DECL_SUPPRESS_DEBUG (x) = 1;
+ }
+
+ t = lookup_name_current_level (name);
+
+ assert ((t == NULL_TREE) || (DECL_CONTEXT (x) == NULL_TREE));
+
+ /* Don't push non-parms onto list for parms until we understand
+ why we're doing this and whether it works. */
+
+ assert ((b == global_binding_level)
+ || !ffecom_transform_only_dummies_
+ || TREE_CODE (x) == PARM_DECL);
+
+ if ((t != NULL_TREE) && duplicate_decls (x, t))
+ return t;
+
+ /* If we are processing a typedef statement, generate a whole new
+ ..._TYPE node (which will be just an variant of the existing
+ ..._TYPE node with identical properties) and then install the
+ TYPE_DECL node generated to represent the typedef name as the
+ TYPE_NAME of this brand new (duplicate) ..._TYPE node.
+
+ The whole point here is to end up with a situation where each and every
+ ..._TYPE node the compiler creates will be uniquely associated with
+ AT MOST one node representing a typedef name. This way, even though
+ the compiler substitutes corresponding ..._TYPE nodes for TYPE_DECL
+ (i.e. "typedef name") nodes very early on, later parts of the
+ compiler can always do the reverse translation and get back the
+ corresponding typedef name. For example, given:
+
+ typedef struct S MY_TYPE; MY_TYPE object;
+
+ Later parts of the compiler might only know that `object' was of type
+ `struct S' if if were not for code just below. With this code
+ however, later parts of the compiler see something like:
+
+ struct S' == struct S typedef struct S' MY_TYPE; struct S' object;
+
+ And they can then deduce (from the node for type struct S') that the
+ original object declaration was:
+
+ MY_TYPE object;
+
+ Being able to do this is important for proper support of protoize, and
+ also for generating precise symbolic debugging information which
+ takes full account of the programmer's (typedef) vocabulary.
+
+ Obviously, we don't want to generate a duplicate ..._TYPE node if the
+ TYPE_DECL node that we are now processing really represents a
+ standard built-in type.
+
+ Since all standard types are effectively declared at line zero in the
+ source file, we can easily check to see if we are working on a
+ standard type by checking the current value of lineno. */
+
+ if (TREE_CODE (x) == TYPE_DECL)
+ {
+ if (DECL_SOURCE_LINE (x) == 0)
+ {
+ if (TYPE_NAME (TREE_TYPE (x)) == 0)
+ TYPE_NAME (TREE_TYPE (x)) = x;
+ }
+ else if (TREE_TYPE (x) != error_mark_node)
+ {
+ tree tt = TREE_TYPE (x);
+
+ tt = build_type_copy (tt);
+ TYPE_NAME (tt) = x;
+ TREE_TYPE (x) = tt;
+ }
+ }
+
+ /* This name is new in its binding level. Install the new declaration
+ and return it. */
+ if (b == global_binding_level)
+ IDENTIFIER_GLOBAL_VALUE (name) = x;
+ else
+ IDENTIFIER_LOCAL_VALUE (name) = x;
+ }
+
+ /* Put decls on list in reverse order. We will reverse them later if
+ necessary. */
+ TREE_CHAIN (x) = b->names;
+ b->names = x;
+
+ return x;
+}
+
+/* Enter a new binding level.
+ If TAG_TRANSPARENT is nonzero, do so only for the name space of variables,
+ not for that of tags. */
+
+void
+pushlevel (tag_transparent)
+ int tag_transparent;
+{
+ register struct binding_level *newlevel = NULL_BINDING_LEVEL;
+
+ assert (!tag_transparent);
+
+ /* Reuse or create a struct for this binding level. */
+
+ if (free_binding_level)
+ {
+ newlevel = free_binding_level;
+ free_binding_level = free_binding_level->level_chain;
+ }
+ else
+ {
+ newlevel = make_binding_level ();
+ }
+
+ /* Add this level to the front of the chain (stack) of levels that are
+ active. */
+
+ *newlevel = clear_binding_level;
+ newlevel->level_chain = current_binding_level;
+ current_binding_level = newlevel;
+}
+
+/* Set the BLOCK node for the innermost scope
+ (the one we are currently in). */
+
+void
+set_block (block)
+ register tree block;
+{
+ current_binding_level->this_block = block;
+}
+
+/* ~~tree.h SHOULD declare this, because toplev.c references it. */
+
+/* Can't 'yydebug' a front end not generated by yacc/bison! */
+
+void
+set_yydebug (value)
+ int value;
+{
+ if (value)
+ fprintf (stderr, "warning: no yacc/bison-generated output to debug!\n");
+}
+
+tree
+signed_or_unsigned_type (unsignedp, type)
+ int unsignedp;
+ tree type;
+{
+ tree type2;
+
+ if (! INTEGRAL_TYPE_P (type))
+ return type;
+ if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node))
+ return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+ if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node))
+ return unsignedp ? unsigned_type_node : integer_type_node;
+ if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node))
+ return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+ if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node))
+ return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+ if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node))
+ return (unsignedp ? long_long_unsigned_type_node
+ : long_long_integer_type_node);
+
+ type2 = type_for_size (TYPE_PRECISION (type), unsignedp);
+ if (type2 == NULL_TREE)
+ return type;
+
+ return type2;
+}
+
+tree
+signed_type (type)
+ tree type;
+{
+ tree type1 = TYPE_MAIN_VARIANT (type);
+ ffeinfoKindtype kt;
+ tree type2;
+
+ if (type1 == unsigned_char_type_node || type1 == char_type_node)
+ return signed_char_type_node;
+ if (type1 == unsigned_type_node)
+ return integer_type_node;
+ if (type1 == short_unsigned_type_node)
+ return short_integer_type_node;
+ if (type1 == long_unsigned_type_node)
+ return long_integer_type_node;
+ if (type1 == long_long_unsigned_type_node)
+ return long_long_integer_type_node;
+#if 0 /* gcc/c-* files only */
+ if (type1 == unsigned_intDI_type_node)
+ return intDI_type_node;
+ if (type1 == unsigned_intSI_type_node)
+ return intSI_type_node;
+ if (type1 == unsigned_intHI_type_node)
+ return intHI_type_node;
+ if (type1 == unsigned_intQI_type_node)
+ return intQI_type_node;
+#endif
+
+ type2 = type_for_size (TYPE_PRECISION (type1), 0);
+ if (type2 != NULL_TREE)
+ return type2;
+
+ for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
+ {
+ type2 = ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+
+ if (type1 == type2)
+ return ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
+ }
+
+ return type;
+}
+
+/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
+ or validate its data type for an `if' or `while' statement or ?..: exp.
+
+ This preparation consists of taking the ordinary
+ representation of an expression expr and producing a valid tree
+ boolean expression describing whether expr is nonzero. We could
+ simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1),
+ but we optimize comparisons, &&, ||, and !.
+
+ The resulting type should always be `integer_type_node'. */
+
+tree
+truthvalue_conversion (expr)
+ tree expr;
+{
+ if (TREE_CODE (expr) == ERROR_MARK)
+ return expr;
+
+#if 0 /* This appears to be wrong for C++. */
+ /* These really should return error_mark_node after 2.4 is stable.
+ But not all callers handle ERROR_MARK properly. */
+ switch (TREE_CODE (TREE_TYPE (expr)))
+ {
+ case RECORD_TYPE:
+ error ("struct type value used where scalar is required");
+ return integer_zero_node;
+
+ case UNION_TYPE:
+ error ("union type value used where scalar is required");
+ return integer_zero_node;
+
+ case ARRAY_TYPE:
+ error ("array type value used where scalar is required");
+ return integer_zero_node;
+
+ default:
+ break;
+ }
+#endif /* 0 */
+
+ switch (TREE_CODE (expr))
+ {
+ /* It is simpler and generates better code to have only TRUTH_*_EXPR
+ or comparison expressions as truth values at this level. */
+#if 0
+ case COMPONENT_REF:
+ /* A one-bit unsigned bit-field is already acceptable. */
+ if (1 == TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (expr, 1)))
+ && TREE_UNSIGNED (TREE_OPERAND (expr, 1)))
+ return expr;
+ break;
+#endif
+
+ case EQ_EXPR:
+ /* It is simpler and generates better code to have only TRUTH_*_EXPR
+ or comparison expressions as truth values at this level. */
+#if 0
+ if (integer_zerop (TREE_OPERAND (expr, 1)))
+ return build_unary_op (TRUTH_NOT_EXPR, TREE_OPERAND (expr, 0), 0);
+#endif
+ case NE_EXPR: case LE_EXPR: case GE_EXPR: case LT_EXPR: case GT_EXPR:
+ case TRUTH_ANDIF_EXPR:
+ case TRUTH_ORIF_EXPR:
+ case TRUTH_AND_EXPR:
+ case TRUTH_OR_EXPR:
+ case TRUTH_XOR_EXPR:
+ TREE_TYPE (expr) = integer_type_node;
+ return expr;
+
+ case ERROR_MARK:
+ return expr;
+
+ case INTEGER_CST:
+ return integer_zerop (expr) ? integer_zero_node : integer_one_node;
+
+ case REAL_CST:
+ return real_zerop (expr) ? integer_zero_node : integer_one_node;
+
+ case ADDR_EXPR:
+ if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 0)))
+ return build (COMPOUND_EXPR, integer_type_node,
+ TREE_OPERAND (expr, 0), integer_one_node);
+ else
+ return integer_one_node;
+
+ case COMPLEX_EXPR:
+ return ffecom_2 ((TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1))
+ ? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR),
+ integer_type_node,
+ truthvalue_conversion (TREE_OPERAND (expr, 0)),
+ truthvalue_conversion (TREE_OPERAND (expr, 1)));
+
+ case NEGATE_EXPR:
+ case ABS_EXPR:
+ case FLOAT_EXPR:
+ case FFS_EXPR:
+ /* These don't change whether an object is non-zero or zero. */
+ return truthvalue_conversion (TREE_OPERAND (expr, 0));
+
+ case LROTATE_EXPR:
+ case RROTATE_EXPR:
+ /* These don't change whether an object is zero or non-zero, but
+ we can't ignore them if their second arg has side-effects. */
+ if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1)))
+ return build (COMPOUND_EXPR, integer_type_node, TREE_OPERAND (expr, 1),
+ truthvalue_conversion (TREE_OPERAND (expr, 0)));
+ else
+ return truthvalue_conversion (TREE_OPERAND (expr, 0));
+
+ case COND_EXPR:
+ /* Distribute the conversion into the arms of a COND_EXPR. */
+ return fold (build (COND_EXPR, integer_type_node, TREE_OPERAND (expr, 0),
+ truthvalue_conversion (TREE_OPERAND (expr, 1)),
+ truthvalue_conversion (TREE_OPERAND (expr, 2))));
+
+ case CONVERT_EXPR:
+ /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE,
+ since that affects how `default_conversion' will behave. */
+ if (TREE_CODE (TREE_TYPE (expr)) == REFERENCE_TYPE
+ || TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == REFERENCE_TYPE)
+ break;
+ /* fall through... */
+ case NOP_EXPR:
+ /* If this is widening the argument, we can ignore it. */
+ if (TYPE_PRECISION (TREE_TYPE (expr))
+ >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (expr, 0))))
+ return truthvalue_conversion (TREE_OPERAND (expr, 0));
+ break;
+
+ case MINUS_EXPR:
+ /* With IEEE arithmetic, x - x may not equal 0, so we can't optimize
+ this case. */
+ if (TARGET_FLOAT_FORMAT == IEEE_FLOAT_FORMAT
+ && TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE)
+ break;
+ /* fall through... */
+ case BIT_XOR_EXPR:
+ /* This and MINUS_EXPR can be changed into a comparison of the
+ two objects. */
+ if (TREE_TYPE (TREE_OPERAND (expr, 0))
+ == TREE_TYPE (TREE_OPERAND (expr, 1)))
+ return ffecom_2 (NE_EXPR, integer_type_node,
+ TREE_OPERAND (expr, 0),
+ TREE_OPERAND (expr, 1));
+ return ffecom_2 (NE_EXPR, integer_type_node,
+ TREE_OPERAND (expr, 0),
+ fold (build1 (NOP_EXPR,
+ TREE_TYPE (TREE_OPERAND (expr, 0)),
+ TREE_OPERAND (expr, 1))));
+
+ case BIT_AND_EXPR:
+ if (integer_onep (TREE_OPERAND (expr, 1)))
+ return expr;
+ break;
+
+ case MODIFY_EXPR:
+#if 0 /* No such thing in Fortran. */
+ if (warn_parentheses && C_EXP_ORIGINAL_CODE (expr) == MODIFY_EXPR)
+ warning ("suggest parentheses around assignment used as truth value");
+#endif
+ break;
+
+ default:
+ break;
+ }
+
+ if (TREE_CODE (TREE_TYPE (expr)) == COMPLEX_TYPE)
+ return (ffecom_2
+ ((TREE_SIDE_EFFECTS (expr)
+ ? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR),
+ integer_type_node,
+ truthvalue_conversion (ffecom_1 (REALPART_EXPR,
+ TREE_TYPE (TREE_TYPE (expr)),
+ expr)),
+ truthvalue_conversion (ffecom_1 (IMAGPART_EXPR,
+ TREE_TYPE (TREE_TYPE (expr)),
+ expr))));
+
+ return ffecom_2 (NE_EXPR, integer_type_node,
+ expr,
+ convert (TREE_TYPE (expr), integer_zero_node));
+}
+
+tree
+type_for_mode (mode, unsignedp)
+ enum machine_mode mode;
+ int unsignedp;
+{
+ int i;
+ int j;
+ tree t;
+
+ if (mode == TYPE_MODE (integer_type_node))
+ return unsignedp ? unsigned_type_node : integer_type_node;
+
+ if (mode == TYPE_MODE (signed_char_type_node))
+ return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+ if (mode == TYPE_MODE (short_integer_type_node))
+ return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+ if (mode == TYPE_MODE (long_integer_type_node))
+ return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+ if (mode == TYPE_MODE (long_long_integer_type_node))
+ return unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node;
+
+ if (mode == TYPE_MODE (float_type_node))
+ return float_type_node;
+
+ if (mode == TYPE_MODE (double_type_node))
+ return double_type_node;
+
+ if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
+ return build_pointer_type (char_type_node);
+
+ if (mode == TYPE_MODE (build_pointer_type (integer_type_node)))
+ return build_pointer_type (integer_type_node);
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
+ for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+ {
+ if (((t = ffecom_tree_type[i][j]) != NULL_TREE)
+ && (mode == TYPE_MODE (t)))
+ if ((i == FFEINFO_basictypeINTEGER) && unsignedp)
+ return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][j];
+ else
+ return t;
+ }
+
+ return 0;
+}
+
+tree
+type_for_size (bits, unsignedp)
+ unsigned bits;
+ int unsignedp;
+{
+ ffeinfoKindtype kt;
+ tree type_node;
+
+ if (bits == TYPE_PRECISION (integer_type_node))
+ return unsignedp ? unsigned_type_node : integer_type_node;
+
+ if (bits == TYPE_PRECISION (signed_char_type_node))
+ return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+ if (bits == TYPE_PRECISION (short_integer_type_node))
+ return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+ if (bits == TYPE_PRECISION (long_integer_type_node))
+ return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+ if (bits == TYPE_PRECISION (long_long_integer_type_node))
+ return (unsignedp ? long_long_unsigned_type_node
+ : long_long_integer_type_node);
+
+ for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
+ {
+ type_node = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
+
+ if ((type_node != NULL_TREE) && (bits == TYPE_PRECISION (type_node)))
+ return unsignedp ? ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt]
+ : type_node;
+ }
+
+ return 0;
+}
+
+tree
+unsigned_type (type)
+ tree type;
+{
+ tree type1 = TYPE_MAIN_VARIANT (type);
+ ffeinfoKindtype kt;
+ tree type2;
+
+ if (type1 == signed_char_type_node || type1 == char_type_node)
+ return unsigned_char_type_node;
+ if (type1 == integer_type_node)
+ return unsigned_type_node;
+ if (type1 == short_integer_type_node)
+ return short_unsigned_type_node;
+ if (type1 == long_integer_type_node)
+ return long_unsigned_type_node;
+ if (type1 == long_long_integer_type_node)
+ return long_long_unsigned_type_node;
+#if 0 /* gcc/c-* files only */
+ if (type1 == intDI_type_node)
+ return unsigned_intDI_type_node;
+ if (type1 == intSI_type_node)
+ return unsigned_intSI_type_node;
+ if (type1 == intHI_type_node)
+ return unsigned_intHI_type_node;
+ if (type1 == intQI_type_node)
+ return unsigned_intQI_type_node;
+#endif
+
+ type2 = type_for_size (TYPE_PRECISION (type1), 1);
+ if (type2 != NULL_TREE)
+ return type2;
+
+ for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
+ {
+ type2 = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
+
+ if (type1 == type2)
+ return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+ }
+
+ return type;
+}
+
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+#if FFECOM_GCC_INCLUDE
+
+/* From gcc/cccp.c, the code to handle -I. */
+
+/* Skip leading "./" from a directory name.
+ This may yield the empty string, which represents the current directory. */
+
+static char *
+skip_redundant_dir_prefix (char *dir)
+{
+ while (dir[0] == '.' && dir[1] == '/')
+ for (dir += 2; *dir == '/'; dir++)
+ continue;
+ if (dir[0] == '.' && !dir[1])
+ dir++;
+ return dir;
+}
+
+/* The file_name_map structure holds a mapping of file names for a
+ particular directory. This mapping is read from the file named
+ FILE_NAME_MAP_FILE in that directory. Such a file can be used to
+ map filenames on a file system with severe filename restrictions,
+ such as DOS. The format of the file name map file is just a series
+ of lines with two tokens on each line. The first token is the name
+ to map, and the second token is the actual name to use. */
+
+struct file_name_map
+{
+ struct file_name_map *map_next;
+ char *map_from;
+ char *map_to;
+};
+
+#define FILE_NAME_MAP_FILE "header.gcc"
+
+/* Current maximum length of directory names in the search path
+ for include files. (Altered as we get more of them.) */
+
+static int max_include_len = 0;
+
+struct file_name_list
+ {
+ struct file_name_list *next;
+ char *fname;
+ /* Mapping of file names for this directory. */
+ struct file_name_map *name_map;
+ /* Non-zero if name_map is valid. */
+ int got_name_map;
+ };
+
+static struct file_name_list *include = NULL; /* First dir to search */
+static struct file_name_list *last_include = NULL; /* Last in chain */
+
+/* I/O buffer structure.
+ The `fname' field is nonzero for source files and #include files
+ and for the dummy text used for -D and -U.
+ It is zero for rescanning results of macro expansion
+ and for expanding macro arguments. */
+#define INPUT_STACK_MAX 400
+static struct file_buf {
+ char *fname;
+ /* Filename specified with #line command. */
+ char *nominal_fname;
+ /* Record where in the search path this file was found.
+ For #include_next. */
+ struct file_name_list *dir;
+ ffewhereLine line;
+ ffewhereColumn column;
+} instack[INPUT_STACK_MAX];
+
+static int last_error_tick = 0; /* Incremented each time we print it. */
+static int input_file_stack_tick = 0; /* Incremented when status changes. */
+
+/* Current nesting level of input sources.
+ `instack[indepth]' is the level currently being read. */
+static int indepth = -1;
+
+typedef struct file_buf FILE_BUF;
+
+typedef unsigned char U_CHAR;
+
+/* table to tell if char can be part of a C identifier. */
+U_CHAR is_idchar[256];
+/* table to tell if char can be first char of a c identifier. */
+U_CHAR is_idstart[256];
+/* table to tell if c is horizontal space. */
+U_CHAR is_hor_space[256];
+/* table to tell if c is horizontal or vertical space. */
+static U_CHAR is_space[256];
+
+#define SKIP_WHITE_SPACE(p) do { while (is_hor_space[*p]) p++; } while (0)
+#define SKIP_ALL_WHITE_SPACE(p) do { while (is_space[*p]) p++; } while (0)
+
+/* Nonzero means -I- has been seen,
+ so don't look for #include "foo" the source-file directory. */
+static int ignore_srcdir;
+
+#ifndef INCLUDE_LEN_FUDGE
+#define INCLUDE_LEN_FUDGE 0
+#endif
+
+static void append_include_chain (struct file_name_list *first,
+ struct file_name_list *last);
+static FILE *open_include_file (char *filename,
+ struct file_name_list *searchptr);
+static void print_containing_files (ffebadSeverity sev);
+static char *skip_redundant_dir_prefix (char *);
+static char *read_filename_string (int ch, FILE *f);
+static struct file_name_map *read_name_map (char *dirname);
+static char *savestring (char *input);
+
+/* Append a chain of `struct file_name_list's
+ to the end of the main include chain.
+ FIRST is the beginning of the chain to append, and LAST is the end. */
+
+static void
+append_include_chain (first, last)
+ struct file_name_list *first, *last;
+{
+ struct file_name_list *dir;
+
+ if (!first || !last)
+ return;
+
+ if (include == 0)
+ include = first;
+ else
+ last_include->next = first;
+
+ for (dir = first; ; dir = dir->next) {
+ int len = strlen (dir->fname) + INCLUDE_LEN_FUDGE;
+ if (len > max_include_len)
+ max_include_len = len;
+ if (dir == last)
+ break;
+ }
+
+ last->next = NULL;
+ last_include = last;
+}
+
+/* Try to open include file FILENAME. SEARCHPTR is the directory
+ being tried from the include file search path. This function maps
+ filenames on file systems based on information read by
+ read_name_map. */
+
+static FILE *
+open_include_file (filename, searchptr)
+ char *filename;
+ struct file_name_list *searchptr;
+{
+ register struct file_name_map *map;
+ register char *from;
+ char *p, *dir;
+
+ if (searchptr && ! searchptr->got_name_map)
+ {
+ searchptr->name_map = read_name_map (searchptr->fname
+ ? searchptr->fname : ".");
+ searchptr->got_name_map = 1;
+ }
+
+ /* First check the mapping for the directory we are using. */
+ if (searchptr && searchptr->name_map)
+ {
+ from = filename;
+ if (searchptr->fname)
+ from += strlen (searchptr->fname) + 1;
+ for (map = searchptr->name_map; map; map = map->map_next)
+ {
+ if (! strcmp (map->map_from, from))
+ {
+ /* Found a match. */
+ return fopen (map->map_to, "r");
+ }
+ }
+ }
+
+ /* Try to find a mapping file for the particular directory we are
+ looking in. Thus #include <sys/types.h> will look up sys/types.h
+ in /usr/include/header.gcc and look up types.h in
+ /usr/include/sys/header.gcc. */
+ p = rindex (filename, '/');
+#ifdef DIR_SEPARATOR
+ if (! p) p = rindex (filename, DIR_SEPARATOR);
+ else {
+ char *tmp = rindex (filename, DIR_SEPARATOR);
+ if (tmp != NULL && tmp > p) p = tmp;
+ }
+#endif
+ if (! p)
+ p = filename;
+ if (searchptr
+ && searchptr->fname
+ && strlen (searchptr->fname) == (size_t) (p - filename)
+ && ! strncmp (searchptr->fname, filename, (int) (p - filename)))
+ {
+ /* FILENAME is in SEARCHPTR, which we've already checked. */
+ return fopen (filename, "r");
+ }
+
+ if (p == filename)
+ {
+ from = filename;
+ map = read_name_map (".");
+ }
+ else
+ {
+ dir = (char *) xmalloc (p - filename + 1);
+ bcopy (filename, dir, p - filename);
+ dir[p - filename] = '\0';
+ from = p + 1;
+ map = read_name_map (dir);
+ free (dir);
+ }
+ for (; map; map = map->map_next)
+ if (! strcmp (map->map_from, from))
+ return fopen (map->map_to, "r");
+
+ return fopen (filename, "r");
+}
+
+/* Print the file names and line numbers of the #include
+ commands which led to the current file. */
+
+static void
+print_containing_files (ffebadSeverity sev)
+{
+ FILE_BUF *ip = NULL;
+ int i;
+ int first = 1;
+ char *str1;
+ char *str2;
+
+ /* If stack of files hasn't changed since we last printed
+ this info, don't repeat it. */
+ if (last_error_tick == input_file_stack_tick)
+ return;
+
+ for (i = indepth; i >= 0; i--)
+ if (instack[i].fname != NULL) {
+ ip = &instack[i];
+ break;
+ }
+
+ /* Give up if we don't find a source file. */
+ if (ip == NULL)
+ return;
+
+ /* Find the other, outer source files. */
+ for (i--; i >= 0; i--)
+ if (instack[i].fname != NULL)
+ {
+ ip = &instack[i];
+ if (first)
+ {
+ first = 0;
+ str1 = "In file included";
+ }
+ else
+ {
+ str1 = "... ...";
+ }
+
+ if (i == 1)
+ str2 = ":";
+ else
+ str2 = "";
+
+ ffebad_start_msg ("%A from %B at %0%C", sev);
+ ffebad_here (0, ip->line, ip->column);
+ ffebad_string (str1);
+ ffebad_string (ip->nominal_fname);
+ ffebad_string (str2);
+ ffebad_finish ();
+ }
+
+ /* Record we have printed the status as of this time. */
+ last_error_tick = input_file_stack_tick;
+}
+
+/* Read a space delimited string of unlimited length from a stdio
+ file. */
+
+static char *
+read_filename_string (ch, f)
+ int ch;
+ FILE *f;
+{
+ char *alloc, *set;
+ int len;
+
+ len = 20;
+ set = alloc = xmalloc (len + 1);
+ if (! is_space[ch])
+ {
+ *set++ = ch;
+ while ((ch = getc (f)) != EOF && ! is_space[ch])
+ {
+ if (set - alloc == len)
+ {
+ len *= 2;
+ alloc = xrealloc (alloc, len + 1);
+ set = alloc + len / 2;
+ }
+ *set++ = ch;
+ }
+ }
+ *set = '\0';
+ ungetc (ch, f);
+ return alloc;
+}
+
+/* Read the file name map file for DIRNAME. */
+
+static struct file_name_map *
+read_name_map (dirname)
+ char *dirname;
+{
+ /* This structure holds a linked list of file name maps, one per
+ directory. */
+ struct file_name_map_list
+ {
+ struct file_name_map_list *map_list_next;
+ char *map_list_name;
+ struct file_name_map *map_list_map;
+ };
+ static struct file_name_map_list *map_list;
+ register struct file_name_map_list *map_list_ptr;
+ char *name;
+ FILE *f;
+ size_t dirlen;
+ int separator_needed;
+
+ dirname = skip_redundant_dir_prefix (dirname);
+
+ for (map_list_ptr = map_list; map_list_ptr;
+ map_list_ptr = map_list_ptr->map_list_next)
+ if (! strcmp (map_list_ptr->map_list_name, dirname))
+ return map_list_ptr->map_list_map;
+
+ map_list_ptr = ((struct file_name_map_list *)
+ xmalloc (sizeof (struct file_name_map_list)));
+ map_list_ptr->map_list_name = savestring (dirname);
+ map_list_ptr->map_list_map = NULL;
+
+ dirlen = strlen (dirname);
+ separator_needed = dirlen != 0 && dirname[dirlen - 1] != '/';
+ name = (char *) xmalloc (dirlen + strlen (FILE_NAME_MAP_FILE) + 2);
+ strcpy (name, dirname);
+ name[dirlen] = '/';
+ strcpy (name + dirlen + separator_needed, FILE_NAME_MAP_FILE);
+ f = fopen (name, "r");
+ free (name);
+ if (!f)
+ map_list_ptr->map_list_map = NULL;
+ else
+ {
+ int ch;
+
+ while ((ch = getc (f)) != EOF)
+ {
+ char *from, *to;
+ struct file_name_map *ptr;
+
+ if (is_space[ch])
+ continue;
+ from = read_filename_string (ch, f);
+ while ((ch = getc (f)) != EOF && is_hor_space[ch])
+ ;
+ to = read_filename_string (ch, f);
+
+ ptr = ((struct file_name_map *)
+ xmalloc (sizeof (struct file_name_map)));
+ ptr->map_from = from;
+
+ /* Make the real filename absolute. */
+ if (*to == '/')
+ ptr->map_to = to;
+ else
+ {
+ ptr->map_to = xmalloc (dirlen + strlen (to) + 2);
+ strcpy (ptr->map_to, dirname);
+ ptr->map_to[dirlen] = '/';
+ strcpy (ptr->map_to + dirlen + separator_needed, to);
+ free (to);
+ }
+
+ ptr->map_next = map_list_ptr->map_list_map;
+ map_list_ptr->map_list_map = ptr;
+
+ while ((ch = getc (f)) != '\n')
+ if (ch == EOF)
+ break;
+ }
+ fclose (f);
+ }
+
+ map_list_ptr->map_list_next = map_list;
+ map_list = map_list_ptr;
+
+ return map_list_ptr->map_list_map;
+}
+
+static char *
+savestring (input)
+ char *input;
+{
+ unsigned size = strlen (input);
+ char *output = xmalloc (size + 1);
+ strcpy (output, input);
+ return output;
+}
+
+static void
+ffecom_file_ (char *name)
+{
+ FILE_BUF *fp;
+
+ /* Do partial setup of input buffer for the sake of generating
+ early #line directives (when -g is in effect). */
+
+ fp = &instack[++indepth];
+ bzero ((char *) fp, sizeof (FILE_BUF));
+ if (name == NULL)
+ name = "";
+ fp->nominal_fname = fp->fname = name;
+}
+
+/* Initialize syntactic classifications of characters. */
+
+static void
+ffecom_initialize_char_syntax_ ()
+{
+ register int i;
+
+ /*
+ * Set up is_idchar and is_idstart tables. These should be
+ * faster than saying (is_alpha (c) || c == '_'), etc.
+ * Set up these things before calling any routines tthat
+ * refer to them.
+ */
+ for (i = 'a'; i <= 'z'; i++) {
+ is_idchar[i - 'a' + 'A'] = 1;
+ is_idchar[i] = 1;
+ is_idstart[i - 'a' + 'A'] = 1;
+ is_idstart[i] = 1;
+ }
+ for (i = '0'; i <= '9'; i++)
+ is_idchar[i] = 1;
+ is_idchar['_'] = 1;
+ is_idstart['_'] = 1;
+
+ /* horizontal space table */
+ is_hor_space[' '] = 1;
+ is_hor_space['\t'] = 1;
+ is_hor_space['\v'] = 1;
+ is_hor_space['\f'] = 1;
+ is_hor_space['\r'] = 1;
+
+ is_space[' '] = 1;
+ is_space['\t'] = 1;
+ is_space['\v'] = 1;
+ is_space['\f'] = 1;
+ is_space['\n'] = 1;
+ is_space['\r'] = 1;
+}
+
+static void
+ffecom_close_include_ (FILE *f)
+{
+ fclose (f);
+
+ indepth--;
+ input_file_stack_tick++;
+
+ ffewhere_line_kill (instack[indepth].line);
+ ffewhere_column_kill (instack[indepth].column);
+}
+
+static int
+ffecom_decode_include_option_ (char *spec)
+{
+ struct file_name_list *dirtmp;
+
+ if (! ignore_srcdir && !strcmp (spec, "-"))
+ ignore_srcdir = 1;
+ else
+ {
+ dirtmp = (struct file_name_list *)
+ xmalloc (sizeof (struct file_name_list));
+ dirtmp->next = 0; /* New one goes on the end */
+ if (spec[0] != 0)
+ dirtmp->fname = spec;
+ else
+ fatal ("Directory name must immediately follow -I option with no intervening spaces, as in `-Idir', not `-I dir'");
+ dirtmp->got_name_map = 0;
+ append_include_chain (dirtmp, dirtmp);
+ }
+ return 1;
+}
+
+/* Open INCLUDEd file. */
+
+static FILE *
+ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c)
+{
+ char *fbeg = name;
+ size_t flen = strlen (fbeg);
+ struct file_name_list *search_start = include; /* Chain of dirs to search */
+ struct file_name_list dsp[1]; /* First in chain, if #include "..." */
+ struct file_name_list *searchptr = 0;
+ char *fname; /* Dynamically allocated fname buffer */
+ FILE *f;
+ FILE_BUF *fp;
+
+ if (flen == 0)
+ return NULL;
+
+ dsp[0].fname = NULL;
+
+ /* If -I- was specified, don't search current dir, only spec'd ones. */
+ if (!ignore_srcdir)
+ {
+ for (fp = &instack[indepth]; fp >= instack; fp--)
+ {
+ int n;
+ char *ep;
+ char *nam;
+
+ if ((nam = fp->nominal_fname) != NULL)
+ {
+ /* Found a named file. Figure out dir of the file,
+ and put it in front of the search list. */
+ dsp[0].next = search_start;
+ search_start = dsp;
+#ifndef VMS
+ ep = rindex (nam, '/');
+#ifdef DIR_SEPARATOR
+ if (ep == NULL) ep = rindex (nam, DIR_SEPARATOR);
+ else {
+ char *tmp = rindex (nam, DIR_SEPARATOR);
+ if (tmp != NULL && tmp > ep) ep = tmp;
+ }
+#endif
+#else /* VMS */
+ ep = rindex (nam, ']');
+ if (ep == NULL) ep = rindex (nam, '>');
+ if (ep == NULL) ep = rindex (nam, ':');
+ if (ep != NULL) ep++;
+#endif /* VMS */
+ if (ep != NULL)
+ {
+ n = ep - nam;
+ dsp[0].fname = (char *) xmalloc (n + 1);
+ strncpy (dsp[0].fname, nam, n);
+ dsp[0].fname[n] = '\0';
+ if (n + INCLUDE_LEN_FUDGE > max_include_len)
+ max_include_len = n + INCLUDE_LEN_FUDGE;
+ }
+ else
+ dsp[0].fname = NULL; /* Current directory */
+ dsp[0].got_name_map = 0;
+ break;
+ }
+ }
+ }
+
+ /* Allocate this permanently, because it gets stored in the definitions
+ of macros. */
+ fname = xmalloc (max_include_len + flen + 4);
+ /* + 2 above for slash and terminating null. */
+ /* + 2 added for '.h' on VMS (to support '#include filename') (NOT USED
+ for g77 yet). */
+
+ /* If specified file name is absolute, just open it. */
+
+ if (*fbeg == '/'
+#ifdef DIR_SEPARATOR
+ || *fbeg == DIR_SEPARATOR
+#endif
+ )
+ {
+ strncpy (fname, (char *) fbeg, flen);
+ fname[flen] = 0;
+ f = open_include_file (fname, NULL_PTR);
+ }
+ else
+ {
+ f = NULL;
+
+ /* Search directory path, trying to open the file.
+ Copy each filename tried into FNAME. */
+
+ for (searchptr = search_start; searchptr; searchptr = searchptr->next)
+ {
+ if (searchptr->fname)
+ {
+ /* The empty string in a search path is ignored.
+ This makes it possible to turn off entirely
+ a standard piece of the list. */
+ if (searchptr->fname[0] == 0)
+ continue;
+ strcpy (fname, skip_redundant_dir_prefix (searchptr->fname));
+ if (fname[0] && fname[strlen (fname) - 1] != '/')
+ strcat (fname, "/");
+ fname[strlen (fname) + flen] = 0;
+ }
+ else
+ fname[0] = 0;
+
+ strncat (fname, fbeg, flen);
+#ifdef VMS
+ /* Change this 1/2 Unix 1/2 VMS file specification into a
+ full VMS file specification */
+ if (searchptr->fname && (searchptr->fname[0] != 0))
+ {
+ /* Fix up the filename */
+ hack_vms_include_specification (fname);
+ }
+ else
+ {
+ /* This is a normal VMS filespec, so use it unchanged. */
+ strncpy (fname, (char *) fbeg, flen);
+ fname[flen] = 0;
+#if 0 /* Not for g77. */
+ /* if it's '#include filename', add the missing .h */
+ if (index (fname, '.') == NULL)
+ strcat (fname, ".h");
+#endif
+ }
+#endif /* VMS */
+ f = open_include_file (fname, searchptr);
+#ifdef EACCES
+ if (f == NULL && errno == EACCES)
+ {
+ print_containing_files (FFEBAD_severityWARNING);
+ ffebad_start_msg ("At %0, INCLUDE file %A exists, but is not readable",
+ FFEBAD_severityWARNING);
+ ffebad_string (fname);
+ ffebad_here (0, l, c);
+ ffebad_finish ();
+ }
+#endif
+ if (f != NULL)
+ break;
+ }
+ }
+
+ if (f == NULL)
+ {
+ /* A file that was not found. */
+
+ strncpy (fname, (char *) fbeg, flen);
+ fname[flen] = 0;
+ print_containing_files (ffebad_severity (FFEBAD_OPEN_INCLUDE));
+ ffebad_start (FFEBAD_OPEN_INCLUDE);
+ ffebad_here (0, l, c);
+ ffebad_string (fname);
+ ffebad_finish ();
+ }
+
+ if (dsp[0].fname != NULL)
+ free (dsp[0].fname);
+
+ if (f == NULL)
+ return NULL;
+
+ if (indepth >= (INPUT_STACK_MAX - 1))
+ {
+ print_containing_files (FFEBAD_severityFATAL);
+ ffebad_start_msg ("At %0, INCLUDE nesting too deep",
+ FFEBAD_severityFATAL);
+ ffebad_string (fname);
+ ffebad_here (0, l, c);
+ ffebad_finish ();
+ return NULL;
+ }
+
+ instack[indepth].line = ffewhere_line_use (l);
+ instack[indepth].column = ffewhere_column_use (c);
+
+ fp = &instack[indepth + 1];
+ bzero ((char *) fp, sizeof (FILE_BUF));
+ fp->nominal_fname = fp->fname = fname;
+ fp->dir = searchptr;
+
+ indepth++;
+ input_file_stack_tick++;
+
+ return f;
+}
+#endif /* FFECOM_GCC_INCLUDE */
diff --git a/gcc/f/com.h b/gcc/f/com.h
new file mode 100644
index 00000000000..477e0860f40
--- /dev/null
+++ b/gcc/f/com.h
@@ -0,0 +1,419 @@
+/* com.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ com.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_com
+#define _H_f_com
+
+/* Simple definitions and enumerations. */
+
+#define FFECOM_dimensionsMAX 7 /* Max # dimensions (quick hack). */
+
+#define FFECOM_targetFFE 1
+#define FFECOM_targetGCC 2
+
+#ifndef FFE_STANDALONE
+#define FFECOM_targetCURRENT FFECOM_targetGCC /* Backend! */
+#define FFECOM_ONEPASS 0
+#else
+#define FFECOM_targetCURRENT FFECOM_targetFFE
+#define FFECOM_ONEPASS 0
+#endif
+
+#if FFECOM_ONEPASS
+#define FFECOM_TWOPASS 0
+#else
+#define FFECOM_TWOPASS 1
+#endif
+
+#define FFECOM_SIZE_UNIT "byte" /* Singular form. */
+#define FFECOM_SIZE_UNITS "bytes" /* Plural form. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define FFECOM_constantNULL NULL_TREE
+#define FFECOM_globalNULL NULL_TREE
+#define FFECOM_labelNULL NULL_TREE
+#define FFECOM_storageNULL NULL_TREE
+#define FFECOM_symbolNULL ffecom_symbol_null_
+
+/* Shorthand for types used in f2c.h and that g77 perhaps allows some
+ flexibility regarding in the section below. I.e. the actual numbers
+ below aren't important, as long as they're unique. */
+
+#define FFECOM_f2ccodeCHAR 1
+#define FFECOM_f2ccodeSHORT 2
+#define FFECOM_f2ccodeINT 3
+#define FFECOM_f2ccodeLONG 4
+#define FFECOM_f2ccodeLONGLONG 5
+#define FFECOM_f2ccodeCHARPTR 6 /* char * */
+#define FFECOM_f2ccodeFLOAT 7
+#define FFECOM_f2ccodeDOUBLE 8
+#define FFECOM_f2ccodeLONGDOUBLE 9
+#define FFECOM_f2ccodeTWOREALS 10
+#define FFECOM_f2ccodeTWODOUBLEREALS 11
+
+#if FFECOM_DETERMINE_TYPES /* only for com.c and configure */
+
+/* Begin f2c.h information. This must match the info in the f2c.h used
+ to build the libf2c with which g77-generated code is linked, or there
+ will probably be bugs, some of them difficult to detect or even trigger. */
+
+#include "config.j"
+
+/* Do we need int (for 32-bit or 64-bit systems) or long (16-bit or
+ normally 32-bit) for f2c-type integers? */
+
+#ifndef BITS_PER_WORD
+#define BITS_PER_WORD 32
+#endif
+
+#ifndef CHAR_TYPE_SIZE
+#define CHAR_TYPE_SIZE BITS_PER_UNIT
+#endif
+
+#ifndef SHORT_TYPE_SIZE
+#define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2))
+#endif
+
+#ifndef INT_TYPE_SIZE
+#define INT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef LONG_TYPE_SIZE
+#define LONG_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef LONG_LONG_TYPE_SIZE
+#define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#ifndef WCHAR_UNSIGNED
+#define WCHAR_UNSIGNED 0
+#endif
+
+#ifndef FLOAT_TYPE_SIZE
+#define FLOAT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef DOUBLE_TYPE_SIZE
+#define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#ifndef LONG_DOUBLE_TYPE_SIZE
+#define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#if LONG_TYPE_SIZE == FLOAT_TYPE_SIZE
+# define FFECOM_f2cINTEGER FFECOM_f2ccodeLONG
+# define FFECOM_f2cLOGICAL FFECOM_f2ccodeLONG
+#elif INT_TYPE_SIZE == FLOAT_TYPE_SIZE
+# define FFECOM_f2cINTEGER FFECOM_f2ccodeINT
+# define FFECOM_f2cLOGICAL FFECOM_f2ccodeINT
+#else
+# error Cannot find a suitable type for FFECOM_f2cINTEGER
+#endif
+
+#if LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)
+# define FFECOM_f2cLONGINT FFECOM_f2ccodeLONG
+#elif LONG_LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)
+# define FFECOM_f2cLONGINT FFECOM_f2ccodeLONGLONG
+#else
+# error Cannot find a suitable type for FFECOM_f2cLONGINT
+#endif
+
+#define FFECOM_f2cADDRESS FFECOM_f2ccodeCHARPTR
+#define FFECOM_f2cSHORTINT FFECOM_f2ccodeSHORT
+#define FFECOM_f2cREAL FFECOM_f2ccodeFLOAT
+#define FFECOM_f2cDOUBLEREAL FFECOM_f2ccodeDOUBLE
+#define FFECOM_f2cCOMPLEX FFECOM_f2ccodeTWOREALS
+#define FFECOM_f2cDOUBLECOMPLEX FFECOM_f2ccodeTWODOUBLEREALS
+#define FFECOM_f2cSHORTLOGICAL FFECOM_f2ccodeSHORT
+#define FFECOM_f2cLOGICAL1 FFECOM_f2ccodeCHAR
+#define FFECOM_f2cINTEGER1 FFECOM_f2ccodeCHAR
+
+/* These must be f2c's INTEGER type, to match runtime/f2c.h.in. */
+
+#define FFECOM_f2cFLAG FFECOM_f2cINTEGER
+#define FFECOM_f2cFTNINT FFECOM_f2cINTEGER
+#define FFECOM_f2cFTNLEN FFECOM_f2cINTEGER
+
+#endif /* #if FFECOM_DETERMINE_TYPES */
+
+/* Everything else in f2c.h, specifically the structures used in
+ interfacing compiled code with the library, must remain exactly
+ as delivered, or g77 internals (mostly com.c and ste.c) must
+ be modified accordingly to compensate. Or there will be...trouble. */
+
+typedef enum
+ {
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) CODE,
+#include "com-rt.def"
+#undef DEFGFRT
+ FFECOM_gfrt
+ } ffecomGfrt;
+
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Typedefs. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#ifndef TREE_CODE
+#include "tree.j"
+#endif
+
+#ifndef BUILT_FOR_270
+#ifdef DECL_STATIC_CONSTRUCTOR /* In gcc/tree.h. */
+#define BUILT_FOR_270 1
+#else
+#define BUILT_FOR_270 0
+#endif
+#endif /* !defined (BUILT_FOR_270) */
+
+#ifndef BUILT_FOR_280
+#ifdef DECL_ONE_ONLY /* In gcc/tree.h. */
+#define BUILT_FOR_280 1
+#else
+#define BUILT_FOR_280 0
+#endif
+#endif /* !defined (BUILT_FOR_280) */
+
+typedef tree ffecomConstant;
+#define FFECOM_constantHOOK
+typedef tree ffecomLabel;
+#define FFECOM_globalHOOK
+typedef tree ffecomGlobal;
+#define FFECOM_labelHOOK
+typedef tree ffecomStorage;
+#define FFECOM_storageHOOK
+typedef struct _ffecom_symbol_ ffecomSymbol;
+#define FFECOM_symbolHOOK
+
+struct _ffecom_symbol_
+ {
+ tree decl_tree;
+ tree length_tree; /* For CHARACTER dummies. */
+ tree vardesc_tree; /* For NAMELIST. */
+ tree assign_tree; /* For ASSIGN'ed vars. */
+ bool addr; /* Is address of item instead of item. */
+ };
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "info.h"
+#include "lab.h"
+#include "storag.h"
+#include "symbol.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+extern tree long_integer_type_node;
+extern tree complex_double_type_node;
+extern tree string_type_node;
+extern tree ffecom_integer_type_node;
+extern tree ffecom_integer_zero_node;
+extern tree ffecom_integer_one_node;
+extern tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
+extern ffecomSymbol ffecom_symbol_null_;
+extern ffeinfoKindtype ffecom_pointer_kind_;
+extern ffeinfoKindtype ffecom_label_kind_;
+
+extern int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
+extern tree ffecom_f2c_integer_type_node;
+extern tree ffecom_f2c_address_type_node;
+extern tree ffecom_f2c_real_type_node;
+extern tree ffecom_f2c_doublereal_type_node;
+extern tree ffecom_f2c_complex_type_node;
+extern tree ffecom_f2c_doublecomplex_type_node;
+extern tree ffecom_f2c_longint_type_node;
+extern tree ffecom_f2c_logical_type_node;
+extern tree ffecom_f2c_flag_type_node;
+extern tree ffecom_f2c_ftnlen_type_node;
+extern tree ffecom_f2c_ftnlen_zero_node;
+extern tree ffecom_f2c_ftnlen_one_node;
+extern tree ffecom_f2c_ftnlen_two_node;
+extern tree ffecom_f2c_ptr_to_ftnlen_type_node;
+extern tree ffecom_f2c_ftnint_type_node;
+extern tree ffecom_f2c_ptr_to_ftnint_type_node;
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Declare functions with prototypes. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree ffecom_1 (enum tree_code code, tree type, tree node);
+tree ffecom_1_fn (tree node);
+tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2);
+bool ffecom_2pass_advise_entrypoint (ffesymbol entry);
+void ffecom_2pass_do_entrypoint (ffesymbol entry);
+tree ffecom_2s (enum tree_code code, tree type, tree node1, tree node2);
+tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2,
+ tree node3);
+tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2,
+ tree node3);
+tree ffecom_arg_expr (ffebld expr, tree *length);
+tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length);
+tree ffecom_call_gfrt (ffecomGfrt ix, tree args);
+tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, tree tree_type);
+tree ffecom_decl_field (tree context, tree prevfield, char *name,
+ tree type);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+void ffecom_close_include (FILE *f);
+int ffecom_decode_include_option (char *spec);
+void ffecom_end_transition (void);
+void ffecom_exec_transition (void);
+void ffecom_expand_let_stmt (ffebld dest, ffebld source);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+tree ffecom_expr (ffebld expr);
+tree ffecom_expr_assign (ffebld expr);
+tree ffecom_expr_assign_w (ffebld expr);
+tree ffecom_expr_rw (ffebld expr);
+void ffecom_finish_compile (void);
+void ffecom_finish_decl (tree decl, tree init, bool is_top_level);
+void ffecom_finish_progunit (void);
+tree ffecom_get_invented_identifier (char *pattern, char *text,
+ int number);
+ffeinfoKindtype ffecom_gfrt_basictype (ffecomGfrt ix);
+ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix);
+void ffecom_init_0 (void);
+void ffecom_init_2 (void);
+tree ffecom_list_expr (ffebld list);
+tree ffecom_list_ptr_to_expr (ffebld list);
+tree ffecom_lookup_label (ffelab label);
+tree ffecom_modify (tree newtype, tree lhs, tree rhs);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+void ffecom_file (char *name);
+void ffecom_notify_init_storage (ffestorag st);
+void ffecom_notify_init_symbol (ffesymbol s);
+void ffecom_notify_primary_entry (ffesymbol fn);
+FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void ffecom_pop_calltemps (void);
+void ffecom_pop_tempvar (tree var);
+tree ffecom_ptr_to_expr (ffebld expr);
+void ffecom_push_calltemps (void);
+tree ffecom_push_tempvar (tree type, ffetargetCharacterSize size,
+ int elements, bool auto_pop);
+tree ffecom_return_expr (ffebld expr);
+tree ffecom_save_tree (tree t);
+tree ffecom_start_decl (tree decl, bool is_init);
+void ffecom_sym_commit (ffesymbol s);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+ffesymbol ffecom_sym_end_transition (ffesymbol s);
+ffesymbol ffecom_sym_exec_transition (ffesymbol s);
+ffesymbol ffecom_sym_learned (ffesymbol s);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void ffecom_sym_retract (ffesymbol s);
+tree ffecom_temp_label (void);
+tree ffecom_truth_value (tree expr);
+tree ffecom_truth_value_invert (tree expr);
+tree ffecom_which_entrypoint_decl (void);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* ~~~Eliminate these when possible, since the back end should be
+ declaring them in some .h file. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+extern int flag_pedantic_errors;
+void emit_nop (void);
+void announce_function (tree decl);
+extern FILE *asm_out_file;
+void assemble_variable (tree decl, int top_level, int at_end,
+ int dont_output_data);
+void assemble_zeros (int size);
+int count_error (int warningp);
+void error (char *s, ...);
+void expand_decl (tree decl);
+void expand_computed_goto (tree exp);
+void expand_function_end (char *filename, int line, int end_bindings);
+void expand_function_start (tree subr, int parms_have_cleanups);
+void expand_main_function (void);
+void fatal (char *s, ...);
+void init_function_start (tree subr, char *filename, int line);
+void make_function_rtl (tree decl);
+void make_decl_rtl (tree decl, char *asmspec, int top_level);
+void make_var_volatile (tree var);
+int mark_addressable (tree expr);
+void output_inline_function (tree fndecl);
+void pedwarn (char *s, ...);
+void pop_function_context (void);
+void pop_momentary_nofree (void);
+void preserve_initializer (void);
+void print_node (FILE *file, char *prefix, tree node, int indent);
+void push_function_context (void);
+void push_obstacks (struct obstack *current, struct obstack *saveable);
+void put_var_into_stack (tree decl);
+void remember_end_note (tree block);
+void report_error_function (char *file);
+void rest_of_compilation (tree decl);
+void rest_of_decl_compilation (tree decl, char *asmspec, int top_level,
+ int at_end);
+void resume_temporary_allocation (void);
+void set_identifier_size (int size);
+void temporary_allocation (void);
+tree truthvalue_conversion (tree expr);
+void warning_with_decl (tree decl, char *s, ...);
+void warning (char *s, ...);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* Define macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#define ffecom_expr(e) (e)
+#define ffecom_init_0()
+#define ffecom_init_2()
+#define ffecom_label_kind() FFEINFO_kindtypeINTEGERDEFAULT
+#define ffecom_pointer_kind() FFEINFO_kindtypeINTEGERDEFAULT
+#define ffecom_ptr_to_expr(e) (e)
+#define ffecom_sym_commit(s)
+#define ffecom_sym_retract(s)
+#endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
+#define ffecom_label_kind() ffecom_label_kind_
+#define ffecom_pointer_kind() ffecom_pointer_kind_
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+#define ffecom_init_1()
+#define ffecom_init_3()
+#define ffecom_init_4()
+#define ffecom_terminate_0()
+#define ffecom_terminate_1()
+#define ffecom_terminate_2()
+#define ffecom_terminate_3()
+#define ffecom_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/config-lang.in b/gcc/f/config-lang.in
new file mode 100644
index 00000000000..74626241d8c
--- /dev/null
+++ b/gcc/f/config-lang.in
@@ -0,0 +1,100 @@
+# Top level configure fragment for GNU FORTRAN.
+# 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 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.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+#
+# language - name of language as it would appear in $(LANGUAGES)
+# compilers - value to add to $(COMPILERS)
+# stagestuff - files to add to $(STAGESTUFF)
+# diff_excludes - files to ignore when building diffs between two versions.
+
+if grep DECL_STATIC_CONSTRUCTOR $srcdir/tree.h >/dev/null; then
+ if grep flag_move_all_movables $srcdir/toplev.c >/dev/null; then true
+ else
+ echo "You haven't applied the patches to the GCC 2.7.x distribution in"
+ echo "$srcdir as described in g77/README.g77 and gcc/f/gbe/README."
+ echo ""
+ exit 1
+ fi
+else
+ if grep put_pending_sizes $srcdir/stor-layout.c >/dev/null; then true
+ else
+ echo "You haven't applied the patches to the GCC 2.6.x distribution in"
+ echo "$srcdir as described in g77/README.g77 and gcc/f/gbe/README."
+ echo ""
+ exit 1
+ fi
+fi
+
+language="f77"
+
+compilers="f771\$(exeext)"
+
+case "$arguments" in
+# *--enable-f2c* | *-enable-f2c*)
+# echo "f77: enabling f2c."
+# stagestuff="g77 g77-cross f771 libf2c.a f2c fc" ;;
+# stagestuff="g77 g77-cross f771 libf2c.a f2c" ;;
+*)
+ stagestuff="g77\$(exeext) g77-cross\$(exeext) f771\$(exeext) libf2c.a" ;;
+esac
+
+diff_excludes="-x \"f/g77.info*\""
+
+# Create the runtime library directory tree if necessary.
+test -d f || mkdir f
+test -d f/runtime || mkdir f/runtime
+test -d f/runtime/libF77 || mkdir f/runtime/libF77
+test -d f/runtime/libI77 || mkdir f/runtime/libI77
+test -d f/runtime/libU77 || mkdir f/runtime/libU77
+
+# Need to make top-level stageN directory trees, else if needed
+# later by gcc/Makefile, it'll make only the first levels and
+# the language subdirectory levels, not the runtime stuff.
+for stageN in stage1 stage2 stage3 stage4
+do
+ test -d $stageN || mkdir $stageN
+ test -d $stageN/f || mkdir $stageN/f
+ test -d $stageN/f/runtime || mkdir $stageN/f/runtime
+ test -d $stageN/f/runtime/libF77 || mkdir $stageN/f/runtime/libF77
+ test -d $stageN/f/runtime/libI77 || mkdir $stageN/f/runtime/libI77
+ test -d $stageN/f/runtime/libU77 || mkdir $stageN/f/runtime/libU77
+done
+
+# Make links into top-level stageN from target trees.
+for stageN in stage1 stage2 stage3 stage4 include
+do
+ $remove -f f/$stageN f/runtime/$stageN f/runtime/libF77/$stageN \
+ f/runtime/libI77/$stageN f/runtime/libU77/$stageN
+ (cd f; $symbolic_link ../$stageN . 2>/dev/null)
+ (cd f/runtime; $symbolic_link ../$stageN . 2>/dev/null)
+ (cd f/runtime/libF77; $symbolic_link ../$stageN . 2>/dev/null)
+ (cd f/runtime/libI77; $symbolic_link ../$stageN . 2>/dev/null)
+ (cd f/runtime/libU77; $symbolic_link ../$stageN . 2>/dev/null)
+done
+
+case "$srcdir" in
+.) ;;
+*) echo
+ echo "Building f77 outside the source directory is likely to not work"
+ echo "unless you are using GNU make or a compatible VPATH mechanism."
+ echo ;;
+esac
diff --git a/gcc/f/config.j b/gcc/f/config.j
new file mode 100644
index 00000000000..b70c3c07b34
--- /dev/null
+++ b/gcc/f/config.j
@@ -0,0 +1,27 @@
+/* config.j -- Wrapper for GCC's config.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_config
+#define _J_f_config
+#include "config.h"
+#endif
+#endif
diff --git a/gcc/f/convert.j b/gcc/f/convert.j
new file mode 100644
index 00000000000..c2e1e4f85d9
--- /dev/null
+++ b/gcc/f/convert.j
@@ -0,0 +1,28 @@
+/* convert.j -- Wrapper for GCC's convert.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_convert
+#define _J_f_convert
+#include "tree.j"
+#include "convert.h"
+#endif
+#endif
diff --git a/gcc/f/data.c b/gcc/f/data.c
new file mode 100644
index 00000000000..15bf3b00cbb
--- /dev/null
+++ b/gcc/f/data.c
@@ -0,0 +1,1810 @@
+/* data.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+
+ Description:
+ Do the tough things for DATA statement (and INTEGER FOO/.../-style
+ initializations), like implied-DO and suchlike.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "data.h"
+#include "bit.h"
+#include "bld.h"
+#include "com.h"
+#include "expr.h"
+#include "global.h"
+#include "malloc.h"
+#include "st.h"
+#include "storag.h"
+#include "top.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+/* I picked this value as one that, when plugged into a couple of small
+ but nearly identical test cases I have called BIG-0.f and BIG-1.f,
+ causes BIG-1.f to take about 10 times as long (elapsed) to compile
+ (in f771 only) as BIG-0.f. These test cases differ in that BIG-0.f
+ doesn't put the one initialized variable in a common area that has
+ a large uninitialized array in it, while BIG-1.f does. The size of
+ the array is this many elements, as long as they all are INTEGER
+ type. Note that, as of 0.5.18, sparse cases are better handled,
+ so BIG-2.f now is used; it provides nonzero initial
+ values for all elements of the same array BIG-0 has. */
+#ifndef FFEDATA_sizeTOO_BIG_INIT_
+#define FFEDATA_sizeTOO_BIG_INIT_ 75*1024
+#endif
+
+/* Internal typedefs. */
+
+typedef struct _ffedata_convert_cache_ *ffedataConvertCache_;
+typedef struct _ffedata_impdo_ *ffedataImpdo_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffedata_convert_cache_
+ {
+ ffebld converted; /* Results of converting expr to following
+ type. */
+ ffeinfoBasictype basic_type;
+ ffeinfoKindtype kind_type;
+ ffetargetCharacterSize size;
+ ffeinfoRank rank;
+ };
+
+struct _ffedata_impdo_
+ {
+ ffedataImpdo_ outer; /* Enclosing IMPDO construct. */
+ ffebld outer_list; /* Item after my IMPDO on the outer list. */
+ ffebld my_list; /* Beginning of list in my IMPDO. */
+ ffesymbol itervar; /* Iteration variable. */
+ ffetargetIntegerDefault increment;
+ ffetargetIntegerDefault final;
+ };
+
+/* Static objects accessed by functions in this module. */
+
+static ffedataImpdo_ ffedata_stack_ = NULL;
+static ffebld ffedata_list_ = NULL;
+static bool ffedata_reinit_; /* value_ should report REINIT error. */
+static bool ffedata_reported_error_; /* Error has been reported. */
+static ffesymbol ffedata_symbol_ = NULL; /* Symbol being initialized. */
+static ffeinfoBasictype ffedata_basictype_; /* Info on symbol. */
+static ffeinfoKindtype ffedata_kindtype_;
+static ffestorag ffedata_storage_; /* If non-NULL, inits go into this parent. */
+static ffeinfoBasictype ffedata_storage_bt_; /* Info on storage. */
+static ffeinfoKindtype ffedata_storage_kt_;
+static ffetargetOffset ffedata_storage_size_; /* Size of entire storage. */
+static ffetargetAlign ffedata_storage_units_; /* #units per storage unit. */
+static ffetargetOffset ffedata_arraysize_; /* Size of array being
+ inited. */
+static ffetargetOffset ffedata_expected_; /* Number of elements to
+ init. */
+static ffetargetOffset ffedata_number_; /* #elements inited so far. */
+static ffetargetOffset ffedata_offset_; /* Offset of next element. */
+static ffetargetOffset ffedata_symbolsize_; /* Size of entire sym. */
+static ffetargetCharacterSize ffedata_size_; /* Size of an element. */
+static ffetargetCharacterSize ffedata_charexpected_; /* #char to init. */
+static ffetargetCharacterSize ffedata_charnumber_; /* #chars inited. */
+static ffetargetCharacterSize ffedata_charoffset_; /* Offset of next char. */
+static ffedataConvertCache_ ffedata_convert_cache_; /* Fewer conversions. */
+static int ffedata_convert_cache_max_ = 0; /* #entries available. */
+static int ffedata_convert_cache_use_ = 0; /* #entries in use. */
+
+/* Static functions (internal). */
+
+static bool ffedata_advance_ (void);
+static ffebld ffedata_convert_ (ffebld source, ffelexToken source_token,
+ ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt,
+ ffeinfoRank rk, ffetargetCharacterSize sz);
+static ffetargetInteger1 ffedata_eval_integer1_ (ffebld expr);
+static ffetargetOffset ffedata_eval_offset_ (ffebld subscripts,
+ ffebld dims);
+static ffetargetCharacterSize ffedata_eval_substr_begin_ (ffebld expr);
+static ffetargetCharacterSize ffedata_eval_substr_end_ (ffebld expr,
+ ffetargetCharacterSize min, ffetargetCharacterSize max);
+static void ffedata_gather_ (ffestorag mst, ffestorag st);
+static void ffedata_pop_ (void);
+static void ffedata_push_ (void);
+static bool ffedata_value_ (ffebld value, ffelexToken token);
+
+/* Internal macros. */
+
+
+/* ffedata_begin -- Initialize with list of targets
+
+ ffebld list;
+ ffedata_begin(list); // ITEM... list of SYMTERs, ARRAYs, SUBSTRs, ...
+
+ Remember the list. After this call, 0...n calls to ffedata_value must
+ follow, and then a single call to ffedata_end. */
+
+void
+ffedata_begin (ffebld list)
+{
+ assert (ffedata_list_ == NULL);
+ ffedata_list_ = list;
+ ffedata_symbol_ = NULL;
+ ffedata_reported_error_ = FALSE;
+ ffedata_reinit_ = FALSE;
+ ffedata_advance_ ();
+}
+
+/* ffedata_end -- End of initialization sequence
+
+ if (ffedata_end(FALSE))
+ // everything's ok
+
+ Make sure the end of the list is valid here. */
+
+bool
+ffedata_end (bool reported_error, ffelexToken t)
+{
+ reported_error |= ffedata_reported_error_;
+
+ /* If still targets to initialize, too few initializers, so complain. */
+
+ if ((ffedata_symbol_ != NULL) && !reported_error)
+ {
+ reported_error = TRUE;
+ ffebad_start (FFEBAD_DATA_TOOFEW);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ }
+
+ /* Pop off any impdo stacks (present only if ffedata_symbol_ != NULL). */
+
+ while (ffedata_stack_ != NULL)
+ ffedata_pop_ ();
+
+ if (ffedata_list_ != NULL)
+ {
+ assert (reported_error);
+ ffedata_list_ = NULL;
+ }
+
+ return TRUE;
+}
+
+/* ffedata_gather -- Gather previously disparate initializations into one place
+
+ ffestorag st; // A typeCBLOCK or typeLOCAL aggregate.
+ ffedata_gather(st);
+
+ Prior to this call, st has no init or accretion info, but (presumably
+ at least one of) its subordinate storage areas has init or accretion
+ info. After this call, none of the subordinate storage areas has inits,
+ because they've all been moved into the newly created init/accretion
+ info for st. During this call, conflicting inits produce only one
+ error message. */
+
+void
+ffedata_gather (ffestorag st)
+{
+ ffesymbol s;
+ ffebld b;
+
+ /* Prepare info on the storage area we're putting init info into. */
+
+ ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
+ &ffedata_storage_units_, ffestorag_basictype (st),
+ ffestorag_kindtype (st));
+ ffedata_storage_size_ = ffestorag_size (st) / ffedata_storage_units_;
+ assert (ffestorag_size (st) % ffedata_storage_units_ == 0);
+
+ /* If a CBLOCK, gather all the init info for its explicit members. */
+
+ if ((ffestorag_type (st) == FFESTORAG_typeCBLOCK)
+ && (ffestorag_symbol (st) != NULL))
+ {
+ s = ffestorag_symbol (st);
+ for (b = ffesymbol_commonlist (s); b != NULL; b = ffebld_trail (b))
+ ffedata_gather_ (st,
+ ffesymbol_storage (ffebld_symter (ffebld_head (b))));
+ }
+
+ /* For CBLOCK or LOCAL, gather all the init info for equivalenced members. */
+
+ ffestorag_drive (ffestorag_list_equivs (st), ffedata_gather_, st);
+}
+
+/* ffedata_value -- Provide some number of initial values
+
+ ffebld value;
+ ffelexToken t; // Points to the value.
+ if (ffedata_value(1,value,t))
+ // Everything's ok
+
+ Makes sure the value is ok, then remembers it according to the list
+ provided to ffedata_begin. As many instances of the value may be
+ supplied as desired, as indicated by the first argument. */
+
+bool
+ffedata_value (ffetargetIntegerDefault rpt, ffebld value, ffelexToken token)
+{
+ ffetargetIntegerDefault i;
+
+ /* Maybe ignore zero values, to speed up compiling, even though we lose
+ checking for multiple initializations for now. */
+
+ if (!ffe_is_zeros ()
+ && (value != NULL)
+ && (ffebld_op (value) == FFEBLD_opCONTER)
+ && ffebld_constant_is_zero (ffebld_conter (value)))
+ value = NULL;
+ else if ((value != NULL)
+ && (ffebld_op (value) == FFEBLD_opANY))
+ value = NULL;
+ else
+ {
+ /* Must be a constant. */
+ assert (value != NULL);
+ assert (ffebld_op (value) == FFEBLD_opCONTER);
+ }
+
+ /* Later we can optimize certain cases by seeing that the target array can
+ take some number of values, and provide this number to _value_. */
+
+ if (rpt == 1)
+ ffedata_convert_cache_use_ = -1; /* Don't bother caching. */
+ else
+ ffedata_convert_cache_use_ = 0; /* Maybe use the cache. */
+
+ for (i = 0; i < rpt; ++i)
+ {
+ if ((ffedata_symbol_ != NULL)
+ && !ffesymbol_is_init (ffedata_symbol_))
+ {
+ ffesymbol_signal_change (ffedata_symbol_);
+ ffesymbol_update_init (ffedata_symbol_);
+ if (1 || ffe_is_90 ())
+ ffesymbol_update_save (ffedata_symbol_);
+#if FFEGLOBAL_ENABLED
+ if (ffesymbol_common (ffedata_symbol_) != NULL)
+ ffeglobal_init_common (ffesymbol_common (ffedata_symbol_),
+ token);
+#endif
+ ffesymbol_signal_unreported (ffedata_symbol_);
+ }
+ if (!ffedata_value_ (value, token))
+ return FALSE;
+ }
+
+ return TRUE;
+}
+
+/* ffedata_advance_ -- Advance initialization target to next item in list
+
+ if (ffedata_advance_())
+ // everything's ok
+
+ Sets common info to characterize the next item in the list. Handles
+ IMPDO constructs accordingly. Does not handle advances within a single
+ item, as in the common extension "DATA CHARTYPE/33,34,35/", where
+ CHARTYPE is CHARACTER*3, for example. */
+
+static bool
+ffedata_advance_ ()
+{
+ ffebld next;
+
+ /* Come here after handling an IMPDO. */
+
+tail_recurse: /* :::::::::::::::::::: */
+
+ /* Assume we're not going to find a new target for now. */
+
+ ffedata_symbol_ = NULL;
+
+ /* If at the end of the list, we're done. */
+
+ if (ffedata_list_ == NULL)
+ {
+ ffetargetIntegerDefault newval;
+
+ if (ffedata_stack_ == NULL)
+ return TRUE; /* No IMPDO in progress, we is done! */
+
+ /* Iterate the IMPDO. */
+
+ newval = ffesymbol_value (ffedata_stack_->itervar)
+ + ffedata_stack_->increment;
+
+ /* See if we're still in the loop. */
+
+ if (((ffedata_stack_->increment > 0)
+ ? newval > ffedata_stack_->final
+ : newval < ffedata_stack_->final)
+ || (((ffesymbol_value (ffedata_stack_->itervar) < 0)
+ == (ffedata_stack_->increment < 0))
+ && ((ffesymbol_value (ffedata_stack_->itervar) < 0)
+ != (newval < 0)))) /* Overflow/underflow? */
+ { /* Done with the loop. */
+ ffedata_list_ = ffedata_stack_->outer_list; /* Restore list. */
+ ffedata_pop_ (); /* Pop me off the impdo stack. */
+ }
+ else
+ { /* Still in the loop, reset the list and
+ update the iter var. */
+ ffedata_list_ = ffedata_stack_->my_list; /* Reset list. */
+ ffesymbol_set_value (ffedata_stack_->itervar, newval);
+ }
+ goto tail_recurse; /* :::::::::::::::::::: */
+ }
+
+ /* Move to the next item in the list. */
+
+ next = ffebld_head (ffedata_list_);
+ ffedata_list_ = ffebld_trail (ffedata_list_);
+
+ /* Really shouldn't happen. */
+
+ if (next == NULL)
+ return TRUE;
+
+ /* See what kind of target this is. */
+
+ switch (ffebld_op (next))
+ {
+ case FFEBLD_opSYMTER: /* Simple reference to scalar or array. */
+ ffedata_symbol_ = ffebld_symter (next);
+ ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
+ : ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
+ if (ffedata_storage_ != NULL)
+ {
+ ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
+ &ffedata_storage_units_,
+ ffestorag_basictype (ffedata_storage_),
+ ffestorag_kindtype (ffedata_storage_));
+ ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
+ / ffedata_storage_units_;
+ assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
+ }
+
+ if ((ffesymbol_init (ffedata_symbol_) != NULL)
+ || (ffesymbol_accretion (ffedata_symbol_) != NULL)
+ || ((ffedata_storage_ != NULL)
+ && (ffestorag_init (ffedata_storage_) != NULL)))
+ {
+#if 0
+ ffebad_start (FFEBAD_DATA_REINIT);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+#else
+ ffedata_reinit_ = TRUE;
+ return TRUE;
+#endif
+ }
+ ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
+ ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
+ if (ffesymbol_rank (ffedata_symbol_) == 0)
+ ffedata_arraysize_ = 1;
+ else
+ {
+ ffebld size = ffesymbol_arraysize (ffedata_symbol_);
+
+ assert (size != NULL);
+ assert (ffebld_op (size) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (size))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (size))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
+ (size));
+ }
+ ffedata_expected_ = ffedata_arraysize_;
+ ffedata_number_ = 0;
+ ffedata_offset_ = 0;
+ ffedata_size_ = (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+ ? ffesymbol_size (ffedata_symbol_) : 1;
+ ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
+ ffedata_charexpected_ = ffedata_size_;
+ ffedata_charnumber_ = 0;
+ ffedata_charoffset_ = 0;
+ break;
+
+ case FFEBLD_opARRAYREF: /* Reference to element of array. */
+ ffedata_symbol_ = ffebld_symter (ffebld_left (next));
+ ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
+ : ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
+ if (ffedata_storage_ != NULL)
+ {
+ ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
+ &ffedata_storage_units_,
+ ffestorag_basictype (ffedata_storage_),
+ ffestorag_kindtype (ffedata_storage_));
+ ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
+ / ffedata_storage_units_;
+ assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
+ }
+
+ if ((ffesymbol_init (ffedata_symbol_) != NULL)
+ || ((ffedata_storage_ != NULL)
+ && (ffestorag_init (ffedata_storage_) != NULL)))
+ {
+#if 0
+ ffebad_start (FFEBAD_DATA_REINIT);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+#else
+ ffedata_reinit_ = TRUE;
+ return TRUE;
+#endif
+ }
+ ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
+ ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
+ if (ffesymbol_rank (ffedata_symbol_) == 0)
+ ffedata_arraysize_ = 1; /* Shouldn't happen in this case... */
+ else
+ {
+ ffebld size = ffesymbol_arraysize (ffedata_symbol_);
+
+ assert (size != NULL);
+ assert (ffebld_op (size) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (size))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (size))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
+ (size));
+ }
+ ffedata_expected_ = 1;
+ ffedata_number_ = 0;
+ ffedata_offset_ = ffedata_eval_offset_ (ffebld_right (next),
+ ffesymbol_dims (ffedata_symbol_));
+ ffedata_size_ = (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+ ? ffesymbol_size (ffedata_symbol_) : 1;
+ ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
+ ffedata_charexpected_ = ffedata_size_;
+ ffedata_charnumber_ = 0;
+ ffedata_charoffset_ = 0;
+ break;
+
+ case FFEBLD_opSUBSTR: /* Substring reference to scalar or array
+ element. */
+ {
+ bool arrayref = ffebld_op (ffebld_left (next)) == FFEBLD_opARRAYREF;
+ ffebld colon = ffebld_right (next);
+
+ assert (colon != NULL);
+
+ ffedata_symbol_ = ffebld_symter (ffebld_left (arrayref
+ ? ffebld_left (next) : next));
+ ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
+ : ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
+ if (ffedata_storage_ != NULL)
+ {
+ ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
+ &ffedata_storage_units_,
+ ffestorag_basictype (ffedata_storage_),
+ ffestorag_kindtype (ffedata_storage_));
+ ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
+ / ffedata_storage_units_;
+ assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
+ }
+
+ if ((ffesymbol_init (ffedata_symbol_) != NULL)
+ || ((ffedata_storage_ != NULL)
+ && (ffestorag_init (ffedata_storage_) != NULL)))
+ {
+#if 0
+ ffebad_start (FFEBAD_DATA_REINIT);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+#else
+ ffedata_reinit_ = TRUE;
+ return TRUE;
+#endif
+ }
+ ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
+ ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
+ if (ffesymbol_rank (ffedata_symbol_) == 0)
+ ffedata_arraysize_ = 1;
+ else
+ {
+ ffebld size = ffesymbol_arraysize (ffedata_symbol_);
+
+ assert (size != NULL);
+ assert (ffebld_op (size) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (size))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (size))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
+ (size));
+ }
+ ffedata_expected_ = arrayref ? 1 : ffedata_arraysize_;
+ ffedata_number_ = 0;
+ ffedata_offset_ = arrayref ? ffedata_eval_offset_ (ffebld_right
+ (ffebld_left (next)), ffesymbol_dims (ffedata_symbol_)) : 0;
+ ffedata_size_ = ffesymbol_size (ffedata_symbol_);
+ ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
+ ffedata_charnumber_ = 0;
+ ffedata_charoffset_ = ffedata_eval_substr_begin_ (ffebld_head (colon));
+ ffedata_charexpected_ = ffedata_eval_substr_end_ (ffebld_head
+ (ffebld_trail (colon)), ffedata_charoffset_,
+ ffedata_size_) - ffedata_charoffset_ + 1;
+ }
+ break;
+
+ case FFEBLD_opIMPDO: /* Implied-DO construct. */
+ {
+ ffebld itervar;
+ ffebld start;
+ ffebld end;
+ ffebld incr;
+ ffebld item = ffebld_right (next);
+
+ itervar = ffebld_head (item);
+ item = ffebld_trail (item);
+ start = ffebld_head (item);
+ item = ffebld_trail (item);
+ end = ffebld_head (item);
+ item = ffebld_trail (item);
+ incr = ffebld_head (item);
+
+ ffedata_push_ ();
+ ffedata_stack_->outer_list = ffedata_list_;
+ ffedata_stack_->my_list = ffedata_list_ = ffebld_left (next);
+
+ assert (ffeinfo_basictype (ffebld_info (itervar))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (itervar))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ ffedata_stack_->itervar = ffebld_symter (itervar);
+
+ assert (ffeinfo_basictype (ffebld_info (start))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (start))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ ffesymbol_set_value (ffedata_stack_->itervar, ffedata_eval_integer1_ (start));
+
+ assert (ffeinfo_basictype (ffebld_info (end))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (end))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ ffedata_stack_->final = ffedata_eval_integer1_ (end);
+
+ if (incr == NULL)
+ ffedata_stack_->increment = 1;
+ else
+ {
+ assert (ffeinfo_basictype (ffebld_info (incr))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (incr))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ ffedata_stack_->increment = ffedata_eval_integer1_ (incr);
+ if (ffedata_stack_->increment == 0)
+ {
+ ffebad_start (FFEBAD_DATA_ZERO);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_stack_->itervar));
+ ffebad_finish ();
+ ffedata_pop_ ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+ }
+ }
+
+ if ((ffedata_stack_->increment > 0)
+ ? ffesymbol_value (ffedata_stack_->itervar)
+ > ffedata_stack_->final
+ : ffesymbol_value (ffedata_stack_->itervar)
+ < ffedata_stack_->final)
+ {
+ ffedata_reported_error_ = TRUE;
+ ffebad_start (FFEBAD_DATA_EMPTY);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_stack_->itervar));
+ ffebad_finish ();
+ ffedata_pop_ ();
+ return FALSE;
+ }
+ }
+ goto tail_recurse; /* :::::::::::::::::::: */
+
+ case FFEBLD_opANY:
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+
+ default:
+ assert ("bad op" == NULL);
+ break;
+ }
+
+ return TRUE;
+}
+
+/* ffedata_convert_ -- Convert source expression to given type using cache
+
+ ffebld source;
+ ffelexToken source_token;
+ ffelexToken dest_token; // Any appropriate token for "destination".
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffetargetCharactersize sz;
+ source = ffedata_convert_(source,source_token,dest_token,bt,kt,sz);
+
+ Like ffeexpr_convert, but calls it only if necessary (if the converted
+ expression doesn't already exist in the cache) and then puts the result
+ in the cache. */
+
+ffebld
+ffedata_convert_ (ffebld source, ffelexToken source_token,
+ ffelexToken dest_token, ffeinfoBasictype bt,
+ ffeinfoKindtype kt, ffeinfoRank rk,
+ ffetargetCharacterSize sz)
+{
+ ffebld converted;
+ int i;
+ int max;
+ ffedataConvertCache_ cache;
+
+ for (i = 0; i < ffedata_convert_cache_use_; ++i)
+ if ((bt == ffedata_convert_cache_[i].basic_type)
+ && (kt == ffedata_convert_cache_[i].kind_type)
+ && (sz == ffedata_convert_cache_[i].size)
+ && (rk == ffedata_convert_cache_[i].rank))
+ return ffedata_convert_cache_[i].converted;
+
+ converted = ffeexpr_convert (source, source_token, dest_token, bt, kt, rk,
+ sz, FFEEXPR_contextDATA);
+
+ if (ffedata_convert_cache_use_ >= ffedata_convert_cache_max_)
+ {
+ if (ffedata_convert_cache_max_ == 0)
+ max = 4;
+ else
+ max = ffedata_convert_cache_max_ << 1;
+
+ if (max > ffedata_convert_cache_max_)
+ {
+ cache = (ffedataConvertCache_) malloc_new_ks (malloc_pool_image (),
+ "FFEDATA cache", max * sizeof (*cache));
+ if (ffedata_convert_cache_max_ != 0)
+ {
+ memcpy (cache, ffedata_convert_cache_,
+ ffedata_convert_cache_max_ * sizeof (*cache));
+ malloc_kill_ks (malloc_pool_image (), ffedata_convert_cache_,
+ ffedata_convert_cache_max_ * sizeof (*cache));
+ }
+ ffedata_convert_cache_ = cache;
+ ffedata_convert_cache_max_ = max;
+ }
+ else
+ return converted; /* In case int overflows! */
+ }
+
+ i = ffedata_convert_cache_use_++;
+
+ ffedata_convert_cache_[i].converted = converted;
+ ffedata_convert_cache_[i].basic_type = bt;
+ ffedata_convert_cache_[i].kind_type = kt;
+ ffedata_convert_cache_[i].size = sz;
+ ffedata_convert_cache_[i].rank = rk;
+
+ return converted;
+}
+
+/* ffedata_eval_integer1_ -- Evaluate expression
+
+ ffetargetIntegerDefault result;
+ ffebld expr; // must be kindtypeINTEGER1.
+
+ result = ffedata_eval_integer1_(expr);
+
+ Evalues the expression (which yields a kindtypeINTEGER1 result) and
+ returns the result. */
+
+static ffetargetIntegerDefault
+ffedata_eval_integer1_ (ffebld expr)
+{
+ ffetargetInteger1 result;
+ ffebad error;
+
+ assert (expr != NULL);
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opCONTER:
+ return ffebld_constant_integer1 (ffebld_conter (expr));
+
+ case FFEBLD_opSYMTER:
+ return ffesymbol_value (ffebld_symter (expr));
+
+ case FFEBLD_opUPLUS:
+ return ffedata_eval_integer1_ (ffebld_left (expr));
+
+ case FFEBLD_opUMINUS:
+ error = ffetarget_uminus_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)));
+ break;
+
+ case FFEBLD_opADD:
+ error = ffetarget_add_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opSUBTRACT:
+ error = ffetarget_subtract_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opMULTIPLY:
+ error = ffetarget_multiply_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opDIVIDE:
+ error = ffetarget_divide_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opPOWER:
+ {
+ ffebld r = ffebld_right (expr);
+
+ if ((ffeinfo_basictype (ffebld_info (r)) != FFEINFO_basictypeINTEGER)
+ || (ffeinfo_kindtype (ffebld_info (r)) != FFEINFO_kindtypeINTEGERDEFAULT))
+ error = FFEBAD_DATA_EVAL;
+ else
+ error = ffetarget_power_integerdefault_integerdefault (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (r));
+ }
+ break;
+
+#if 0 /* Only for character basictype. */
+ case FFEBLD_opCONCATENATE:
+ error =;
+ break;
+#endif
+
+ case FFEBLD_opNOT:
+ error = ffetarget_not_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)));
+ break;
+
+#if 0 /* Only for logical basictype. */
+ case FFEBLD_opLT:
+ error =;
+ break;
+
+ case FFEBLD_opLE:
+ error =;
+ break;
+
+ case FFEBLD_opEQ:
+ error =;
+ break;
+
+ case FFEBLD_opNE:
+ error =;
+ break;
+
+ case FFEBLD_opGT:
+ error =;
+ break;
+
+ case FFEBLD_opGE:
+ error =;
+ break;
+#endif
+
+ case FFEBLD_opAND:
+ error = ffetarget_and_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opOR:
+ error = ffetarget_or_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opXOR:
+ error = ffetarget_xor_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opEQV:
+ error = ffetarget_eqv_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opNEQV:
+ error = ffetarget_neqv_integer1 (&result,
+ ffedata_eval_integer1_ (ffebld_left (expr)),
+ ffedata_eval_integer1_ (ffebld_right (expr)));
+ break;
+
+ case FFEBLD_opPAREN:
+ return ffedata_eval_integer1_ (ffebld_left (expr));
+
+#if 0 /* ~~ no idea how to do this */
+ case FFEBLD_opPERCENT_LOC:
+ error =;
+ break;
+#endif
+
+#if 0 /* not allowed by ANSI, but perhaps as an
+ extension someday? */
+ case FFEBLD_opCONVERT:
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+ default:
+ error = FFEBAD_DATA_EVAL;
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+ default:
+ error = FFEBAD_DATA_EVAL;
+ break;
+ }
+ break;
+ }
+ break;
+#endif
+
+#if 0 /* not valid ops */
+ case FFEBLD_opREPEAT:
+ error =;
+ break;
+
+ case FFEBLD_opBOUNDS:
+ error =;
+ break;
+#endif
+
+#if 0 /* not allowed by ANSI, but perhaps as an
+ extension someday? */
+ case FFEBLD_opFUNCREF:
+ error =;
+ break;
+#endif
+
+#if 0 /* not valid ops */
+ case FFEBLD_opSUBRREF:
+ error =;
+ break;
+
+ case FFEBLD_opARRAYREF:
+ error =;
+ break;
+#endif
+
+#if 0 /* not valid for integer1 */
+ case FFEBLD_opSUBSTR:
+ error =;
+ break;
+#endif
+
+ default:
+ error = FFEBAD_DATA_EVAL;
+ break;
+ }
+
+ if (error != FFEBAD)
+ {
+ ffebad_start (error);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_finish ();
+ result = 0;
+ }
+
+ return result;
+}
+
+/* ffedata_eval_offset_ -- Evaluate offset info array
+
+ ffetargetOffset offset; // 0...max-1.
+ ffebld subscripts; // an opITEM list of subscript exprs.
+ ffebld dims; // an opITEM list of opBOUNDS exprs.
+
+ result = ffedata_eval_offset_(expr);
+
+ Evalues the expression (which yields a kindtypeINTEGER1 result) and
+ returns the result. */
+
+static ffetargetOffset
+ffedata_eval_offset_ (ffebld subscripts, ffebld dims)
+{
+ ffetargetIntegerDefault offset = 0;
+ ffetargetIntegerDefault width = 1;
+ ffetargetIntegerDefault value;
+ ffetargetIntegerDefault lowbound;
+ ffetargetIntegerDefault highbound;
+ ffetargetOffset final;
+ ffebld subscript;
+ ffebld dim;
+ ffebld low;
+ ffebld high;
+ int rank = 0;
+ bool ok;
+
+ while (subscripts != NULL)
+ {
+ ++rank;
+ assert (dims != NULL);
+
+ subscript = ffebld_head (subscripts);
+ dim = ffebld_head (dims);
+
+ assert (ffeinfo_basictype (ffebld_info (subscript)) == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (subscript)) == FFEINFO_kindtypeINTEGER1);
+ value = ffedata_eval_integer1_ (subscript);
+
+ assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
+ low = ffebld_left (dim);
+ high = ffebld_right (dim);
+
+ if (low == NULL)
+ lowbound = 1;
+ else
+ {
+ assert (ffeinfo_basictype (ffebld_info (low)) == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (low)) == FFEINFO_kindtypeINTEGERDEFAULT);
+ lowbound = ffedata_eval_integer1_ (low);
+ }
+
+ assert (ffeinfo_basictype (ffebld_info (high)) == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (high)) == FFEINFO_kindtypeINTEGERDEFAULT);
+ highbound = ffedata_eval_integer1_ (high);
+
+ if ((value < lowbound) || (value > highbound))
+ {
+ char rankstr[10];
+
+ sprintf (rankstr, "%d", rank);
+ value = lowbound;
+ ffebad_start (FFEBAD_DATA_SUBSCRIPT);
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_string (rankstr);
+ ffebad_finish ();
+ }
+
+ subscripts = ffebld_trail (subscripts);
+ dims = ffebld_trail (dims);
+
+ offset += width * (value - lowbound);
+ if (subscripts != NULL)
+ width *= highbound - lowbound + 1;
+ }
+
+ assert (dims == NULL);
+
+ ok = ffetarget_offset (&final, offset);
+ assert (ok);
+
+ return final;
+}
+
+/* ffedata_eval_substr_begin_ -- Evaluate begin-point of substr reference
+
+ ffetargetCharacterSize beginpoint;
+ ffebld endval; // head(colon).
+
+ beginpoint = ffedata_eval_substr_end_(endval);
+
+ If beginval is NULL, returns 0. Otherwise makes sure beginval is
+ kindtypeINTEGERDEFAULT, makes sure its value is > 0,
+ and returns its value minus one, or issues an error message. */
+
+static ffetargetCharacterSize
+ffedata_eval_substr_begin_ (ffebld expr)
+{
+ ffetargetIntegerDefault val;
+
+ if (expr == NULL)
+ return 0;
+
+ assert (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGERDEFAULT);
+
+ val = ffedata_eval_integer1_ (expr);
+
+ if (val < 1)
+ {
+ val = 1;
+ ffebad_start (FFEBAD_DATA_RANGE);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ }
+
+ return val - 1;
+}
+
+/* ffedata_eval_substr_end_ -- Evaluate end-point of substr reference
+
+ ffetargetCharacterSize endpoint;
+ ffebld endval; // head(trail(colon)).
+ ffetargetCharacterSize min; // beginpoint of substr reference.
+ ffetargetCharacterSize max; // size of entity.
+
+ endpoint = ffedata_eval_substr_end_(endval,dflt);
+
+ If endval is NULL, returns max. Otherwise makes sure endval is
+ kindtypeINTEGERDEFAULT, makes sure its value is > min and <= max,
+ and returns its value minus one, or issues an error message. */
+
+static ffetargetCharacterSize
+ffedata_eval_substr_end_ (ffebld expr, ffetargetCharacterSize min,
+ ffetargetCharacterSize max)
+{
+ ffetargetIntegerDefault val;
+
+ if (expr == NULL)
+ return max - 1;
+
+ assert (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER1);
+
+ val = ffedata_eval_integer1_ (expr);
+
+ if ((val < (ffetargetIntegerDefault) min)
+ || (val > (ffetargetIntegerDefault) max))
+ {
+ val = 1;
+ ffebad_start (FFEBAD_DATA_RANGE);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ }
+
+ return val - 1;
+}
+
+/* ffedata_gather_ -- Gather initial values for sym into master sym inits
+
+ ffestorag mst; // A typeCBLOCK or typeLOCAL aggregate.
+ ffestorag st; // A typeCOMMON or typeEQUIV member.
+ ffedata_gather_(mst,st);
+
+ If st has any initialization info, transfer that info into mst and
+ clear st's info. */
+
+void
+ffedata_gather_ (ffestorag mst, ffestorag st)
+{
+ ffesymbol s;
+ ffesymbol s_whine; /* Symbol to complain about in diagnostics. */
+ ffebld b;
+ ffetargetOffset offset;
+ ffetargetOffset units_expected;
+ ffebitCount actual;
+ ffebldConstantArray array;
+ ffebld accter;
+ ffetargetCopyfunc fn;
+ void *ptr1;
+ void *ptr2;
+ size_t size;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffeinfoBasictype ign_bt;
+ ffeinfoKindtype ign_kt;
+ ffetargetAlign units;
+ ffebit bits;
+ ffetargetOffset source_offset;
+ bool whine = FALSE;
+
+ if (st == NULL)
+ return; /* Nothing to do. */
+
+ s = ffestorag_symbol (st);
+
+ assert (s != NULL); /* Must have a corresponding symbol (else how
+ inited?). */
+ assert (ffestorag_init (st) == NULL); /* No init info on storage itself. */
+ assert (ffestorag_accretion (st) == NULL);
+
+ if ((((b = ffesymbol_init (s)) == NULL)
+ && ((b = ffesymbol_accretion (s)) == NULL))
+ || (ffebld_op (b) == FFEBLD_opANY)
+ || ((ffebld_op (b) == FFEBLD_opCONVERT)
+ && (ffebld_op (ffebld_left (b)) == FFEBLD_opANY)))
+ return; /* Nothing to do. */
+
+ /* b now holds the init/accretion expr. */
+
+ ffesymbol_set_init (s, NULL);
+ ffesymbol_set_accretion (s, NULL);
+ ffesymbol_set_accretes (s, 0);
+
+ s_whine = ffestorag_symbol (mst);
+ if (s_whine == NULL)
+ s_whine = s;
+
+ /* Make sure we haven't fully accreted during an array init. */
+
+ if (ffestorag_init (mst) != NULL)
+ {
+ ffebad_start (FFEBAD_DATA_MULTIPLE);
+ ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
+ ffebad_string (ffesymbol_text (s_whine));
+ ffebad_finish ();
+ return;
+ }
+
+ bt = ffeinfo_basictype (ffebld_info (b));
+ kt = ffeinfo_kindtype (ffebld_info (b));
+
+ /* Calculate offset for aggregate area. */
+
+ ffedata_charexpected_ = (bt == FFEINFO_basictypeCHARACTER)
+ ? ffebld_size (b) : 1;
+ ffetarget_aggregate_info (&ign_bt, &ign_kt, &units, bt,
+ kt);/* Find out unit size of source datum. */
+ assert (units % ffedata_storage_units_ == 0);
+ units_expected = ffedata_charexpected_ * units / ffedata_storage_units_;
+ offset = (ffestorag_offset (st) - ffestorag_offset (mst))
+ / ffedata_storage_units_;
+
+ /* Does an accretion array exist? If not, create it. */
+
+ if (ffestorag_accretion (mst) == NULL)
+ {
+#if FFEDATA_sizeTOO_BIG_INIT_ != 0
+ if (ffedata_storage_size_ >= FFEDATA_sizeTOO_BIG_INIT_)
+ {
+ char bignum[40];
+
+ sprintf (&bignum[0], "%ld", (long) ffedata_storage_size_);
+ ffebad_start (FFEBAD_TOO_BIG_INIT);
+ ffebad_here (0, ffesymbol_where_line (s_whine),
+ ffesymbol_where_column (s_whine));
+ ffebad_string (ffesymbol_text (s_whine));
+ ffebad_string (bignum);
+ ffebad_finish ();
+ }
+#endif
+ array = ffebld_constantarray_new (ffedata_storage_bt_,
+ ffedata_storage_kt_, ffedata_storage_size_);
+ accter = ffebld_new_accter (array, ffebit_new (ffe_pool_program_unit (),
+ ffedata_storage_size_));
+ ffebld_set_info (accter, ffeinfo_new
+ (ffedata_storage_bt_,
+ ffedata_storage_kt_,
+ 1,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+ ? 1 : FFETARGET_charactersizeNONE));
+ ffestorag_set_accretion (mst, accter);
+ ffestorag_set_accretes (mst, ffedata_storage_size_);
+ }
+ else
+ {
+ accter = ffestorag_accretion (mst);
+ assert (ffedata_storage_size_ == (ffetargetOffset) ffebld_accter_size (accter));
+ array = ffebld_accter (accter);
+ }
+
+ /* Put value in accretion array at desired offset. */
+
+ fn = ffetarget_aggregate_ptr_memcpy (ffedata_storage_bt_, ffedata_storage_kt_,
+ bt, kt);
+
+ switch (ffebld_op (b))
+ {
+ case FFEBLD_opCONTER:
+ ffebld_constantarray_prepare (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
+ ffedata_storage_kt_, offset,
+ ffebld_constant_ptr_to_union (ffebld_conter (b)),
+ bt, kt);
+ (*fn) (ptr1, ptr2, size); /* Does the appropriate memcpy-like
+ operation. */
+ ffebit_count (ffebld_accter_bits (accter),
+ offset, FALSE, units_expected, &actual); /* How many FALSE? */
+ if (units_expected != (ffetargetOffset) actual)
+ {
+ ffebad_start (FFEBAD_DATA_MULTIPLE);
+ ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
+ ffebad_string (ffesymbol_text (s));
+ ffebad_finish ();
+ }
+ ffestorag_set_accretes (mst,
+ ffestorag_accretes (mst)
+ - actual); /* Decrement # of values
+ actually accreted. */
+ ffebit_set (ffebld_accter_bits (accter), offset, 1, units_expected);
+
+ /* If done accreting for this storage area, establish as initialized. */
+
+ if (ffestorag_accretes (mst) == 0)
+ {
+ ffestorag_set_init (mst, accter);
+ ffestorag_set_accretion (mst, NULL);
+ ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
+ ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
+ ffebld_set_arrter (ffestorag_init (mst),
+ ffebld_accter (ffestorag_init (mst)));
+ ffebld_arrter_set_size (ffestorag_init (mst),
+ ffedata_storage_size_);
+ ffecom_notify_init_storage (mst);
+ }
+
+ return;
+
+ case FFEBLD_opARRTER:
+ ffebld_constantarray_preparray (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
+ ffedata_storage_kt_, offset, ffebld_arrter (b),
+ bt, kt);
+ size *= ffebld_arrter_size (b);
+ units_expected *= ffebld_arrter_size (b);
+ (*fn) (ptr1, ptr2, size); /* Does the appropriate memcpy-like
+ operation. */
+ ffebit_count (ffebld_accter_bits (accter),
+ offset, FALSE, units_expected, &actual); /* How many FALSE? */
+ if (units_expected != (ffetargetOffset) actual)
+ {
+ ffebad_start (FFEBAD_DATA_MULTIPLE);
+ ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
+ ffebad_string (ffesymbol_text (s));
+ ffebad_finish ();
+ }
+ ffestorag_set_accretes (mst,
+ ffestorag_accretes (mst)
+ - actual); /* Decrement # of values
+ actually accreted. */
+ ffebit_set (ffebld_accter_bits (accter), offset, 1, units_expected);
+
+ /* If done accreting for this storage area, establish as initialized. */
+
+ if (ffestorag_accretes (mst) == 0)
+ {
+ ffestorag_set_init (mst, accter);
+ ffestorag_set_accretion (mst, NULL);
+ ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
+ ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
+ ffebld_set_arrter (ffestorag_init (mst),
+ ffebld_accter (ffestorag_init (mst)));
+ ffebld_arrter_set_size (ffestorag_init (mst),
+ ffedata_storage_size_);
+ ffecom_notify_init_storage (mst);
+ }
+
+ return;
+
+ case FFEBLD_opACCTER:
+ ffebld_constantarray_preparray (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
+ ffedata_storage_kt_, offset, ffebld_accter (b),
+ bt, kt);
+ bits = ffebld_accter_bits (b);
+ source_offset = 0;
+
+ for (;;)
+ {
+ ffetargetOffset unexp;
+ ffetargetOffset siz;
+ ffebitCount length;
+ bool value;
+
+ ffebit_test (bits, source_offset, &value, &length);
+ if (length == 0)
+ break; /* Exit the loop early. */
+ siz = size * length;
+ unexp = units_expected * length;
+ if (value)
+ {
+ (*fn) (ptr1, ptr2, siz); /* Does memcpy-like operation. */
+ ffebit_count (ffebld_accter_bits (accter), /* How many FALSE? */
+ offset, FALSE, unexp, &actual);
+ if (!whine && (unexp != (ffetargetOffset) actual))
+ {
+ whine = TRUE; /* Don't whine more than once for one gather. */
+ ffebad_start (FFEBAD_DATA_MULTIPLE);
+ ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
+ ffebad_string (ffesymbol_text (s));
+ ffebad_finish ();
+ }
+ ffestorag_set_accretes (mst,
+ ffestorag_accretes (mst)
+ - actual); /* Decrement # of values
+ actually accreted. */
+ ffebit_set (ffebld_accter_bits (accter), offset, 1, unexp);
+ }
+ source_offset += length;
+ offset += unexp;
+ ptr1 = ((char *) ptr1) + siz;
+ ptr2 = ((char *) ptr2) + siz;
+ }
+
+ /* If done accreting for this storage area, establish as initialized. */
+
+ if (ffestorag_accretes (mst) == 0)
+ {
+ ffestorag_set_init (mst, accter);
+ ffestorag_set_accretion (mst, NULL);
+ ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
+ ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
+ ffebld_set_arrter (ffestorag_init (mst),
+ ffebld_accter (ffestorag_init (mst)));
+ ffebld_arrter_set_size (ffestorag_init (mst),
+ ffedata_storage_size_);
+ ffecom_notify_init_storage (mst);
+ }
+
+ return;
+
+ default:
+ assert ("bad init op in gather_" == NULL);
+ return;
+ }
+}
+
+/* ffedata_pop_ -- Pop an impdo stack entry
+
+ ffedata_pop_(); */
+
+static void
+ffedata_pop_ ()
+{
+ ffedataImpdo_ victim = ffedata_stack_;
+
+ assert (victim != NULL);
+
+ ffedata_stack_ = ffedata_stack_->outer;
+
+ malloc_kill_ks (ffe_pool_program_unit (), victim, sizeof (*victim));
+}
+
+/* ffedata_push_ -- Push an impdo stack entry
+
+ ffedata_push_(); */
+
+static void
+ffedata_push_ ()
+{
+ ffedataImpdo_ baby;
+
+ baby = malloc_new_ks (ffe_pool_program_unit (), "ffedataImpdo_", sizeof (*baby));
+
+ baby->outer = ffedata_stack_;
+ ffedata_stack_ = baby;
+}
+
+/* ffedata_value_ -- Provide an initial value
+
+ ffebld value;
+ ffelexToken t; // Points to the value.
+ if (ffedata_value(value,t))
+ // Everything's ok
+
+ Makes sure the value is ok, then remembers it according to the list
+ provided to ffedata_begin. */
+
+static bool
+ffedata_value_ (ffebld value, ffelexToken token)
+{
+
+ /* If already reported an error, don't do anything. */
+
+ if (ffedata_reported_error_)
+ return FALSE;
+
+ /* If the value is an error marker, remember we've seen one and do nothing
+ else. */
+
+ if ((value != NULL)
+ && (ffebld_op (value) == FFEBLD_opANY))
+ {
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+ }
+
+ /* If too many values (no more targets), complain. */
+
+ if (ffedata_symbol_ == NULL)
+ {
+ ffebad_start (FFEBAD_DATA_TOOMANY);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+ }
+
+ /* If ffedata_advance_ wanted to register a complaint, do it now
+ that we have the token to point at instead of just the start
+ of the whole statement. */
+
+ if (ffedata_reinit_)
+ {
+ ffebad_start (FFEBAD_DATA_REINIT);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+ }
+
+#if FFEGLOBAL_ENABLED
+ if (ffesymbol_common (ffedata_symbol_) != NULL)
+ ffeglobal_init_common (ffesymbol_common (ffedata_symbol_), token);
+#endif
+
+ /* Convert value to desired type. */
+
+ if (value != NULL)
+ {
+ if (ffedata_convert_cache_use_ == -1)
+ value = ffeexpr_convert
+ (value, token, NULL, ffedata_basictype_,
+ ffedata_kindtype_, 0,
+ (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+ ? ffedata_charexpected_ : FFETARGET_charactersizeNONE,
+ FFEEXPR_contextDATA);
+ else /* Use the cache. */
+ value = ffedata_convert_
+ (value, token, NULL, ffedata_basictype_,
+ ffedata_kindtype_, 0,
+ (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+ ? ffedata_charexpected_ : FFETARGET_charactersizeNONE);
+ }
+
+ /* If we couldn't, bug out. */
+
+ if ((value != NULL) && (ffebld_op (value) == FFEBLD_opANY))
+ {
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+ }
+
+ /* Handle the case where initializes go to a parent's storage area. */
+
+ if (ffedata_storage_ != NULL)
+ {
+ ffetargetOffset offset;
+ ffetargetOffset units_expected;
+ ffebitCount actual;
+ ffebldConstantArray array;
+ ffebld accter;
+ ffetargetCopyfunc fn;
+ void *ptr1;
+ void *ptr2;
+ size_t size;
+ ffeinfoBasictype ign_bt;
+ ffeinfoKindtype ign_kt;
+ ffetargetAlign units;
+
+ /* Make sure we haven't fully accreted during an array init. */
+
+ if (ffestorag_init (ffedata_storage_) != NULL)
+ {
+ ffebad_start (FFEBAD_DATA_MULTIPLE);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+ }
+
+ /* Calculate offset. */
+
+ offset = ffedata_offset_ * ffedata_size_ + ffedata_charoffset_;
+
+ /* Is offset within range? If not, whine, but don't do anything else. */
+
+ if (offset + ffedata_charexpected_ - 1 > ffedata_symbolsize_)
+ {
+ ffebad_start (FFEBAD_DATA_RANGE);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+ }
+
+ /* Now calculate offset for aggregate area. */
+
+ ffetarget_aggregate_info (&ign_bt, &ign_kt, &units, ffedata_basictype_,
+ ffedata_kindtype_); /* Find out unit size of
+ source datum. */
+ assert (units % ffedata_storage_units_ == 0);
+ units_expected = ffedata_charexpected_ * units / ffedata_storage_units_;
+ offset *= units / ffedata_storage_units_;
+ offset += (ffestorag_offset (ffesymbol_storage (ffedata_symbol_))
+ - ffestorag_offset (ffedata_storage_))
+ / ffedata_storage_units_;
+
+ assert (offset + units_expected - 1 <= ffedata_storage_size_);
+
+ /* Does an accretion array exist? If not, create it. */
+
+ if (value != NULL)
+ {
+ if (ffestorag_accretion (ffedata_storage_) == NULL)
+ {
+#if FFEDATA_sizeTOO_BIG_INIT_ != 0
+ if (ffedata_storage_size_ >= FFEDATA_sizeTOO_BIG_INIT_)
+ {
+ char bignum[40];
+
+ sprintf (&bignum[0], "%ld", (long) ffedata_storage_size_);
+ ffebad_start (FFEBAD_TOO_BIG_INIT);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_string (bignum);
+ ffebad_finish ();
+ }
+#endif
+ array = ffebld_constantarray_new
+ (ffedata_storage_bt_, ffedata_storage_kt_,
+ ffedata_storage_size_);
+ accter = ffebld_new_accter (array,
+ ffebit_new (ffe_pool_program_unit (),
+ ffedata_storage_size_));
+ ffebld_set_info (accter, ffeinfo_new
+ (ffedata_storage_bt_,
+ ffedata_storage_kt_,
+ 1,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ (ffedata_basictype_
+ == FFEINFO_basictypeCHARACTER)
+ ? 1 : FFETARGET_charactersizeNONE));
+ ffestorag_set_accretion (ffedata_storage_, accter);
+ ffestorag_set_accretes (ffedata_storage_, ffedata_storage_size_);
+ }
+ else
+ {
+ accter = ffestorag_accretion (ffedata_storage_);
+ assert (ffedata_storage_size_ == (ffetargetOffset) ffebld_accter_size (accter));
+ array = ffebld_accter (accter);
+ }
+
+ /* Put value in accretion array at desired offset. */
+
+ fn = ffetarget_aggregate_ptr_memcpy
+ (ffedata_storage_bt_, ffedata_storage_kt_,
+ ffedata_basictype_, ffedata_kindtype_);
+ ffebld_constantarray_prepare
+ (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
+ ffedata_storage_kt_, offset,
+ ffebld_constant_ptr_to_union (ffebld_conter (value)),
+ ffedata_basictype_, ffedata_kindtype_);
+ (*fn) (ptr1, ptr2, size); /* Does the appropriate memcpy-like
+ operation. */
+ ffebit_count (ffebld_accter_bits (accter),
+ offset, FALSE, units_expected,
+ &actual); /* How many FALSE? */
+ if (units_expected != (ffetargetOffset) actual)
+ {
+ ffebad_start (FFEBAD_DATA_MULTIPLE);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ }
+ ffestorag_set_accretes (ffedata_storage_,
+ ffestorag_accretes (ffedata_storage_)
+ - actual); /* Decrement # of values
+ actually accreted. */
+ ffebit_set (ffebld_accter_bits (accter), offset,
+ 1, units_expected);
+
+ /* If done accreting for this storage area, establish as
+ initialized. */
+
+ if (ffestorag_accretes (ffedata_storage_) == 0)
+ {
+ ffestorag_set_init (ffedata_storage_, accter);
+ ffestorag_set_accretion (ffedata_storage_, NULL);
+ ffebit_kill (ffebld_accter_bits
+ (ffestorag_init (ffedata_storage_)));
+ ffebld_set_op (ffestorag_init (ffedata_storage_),
+ FFEBLD_opARRTER);
+ ffebld_set_arrter
+ (ffestorag_init (ffedata_storage_),
+ ffebld_accter (ffestorag_init (ffedata_storage_)));
+ ffebld_arrter_set_size (ffestorag_init (ffedata_storage_),
+ ffedata_storage_size_);
+ ffecom_notify_init_storage (ffedata_storage_);
+ }
+ }
+
+ /* If still accreting, adjust specs accordingly and return. */
+
+ if (++ffedata_number_ < ffedata_expected_)
+ {
+ ++ffedata_offset_;
+ return TRUE;
+ }
+
+ return ffedata_advance_ ();
+ }
+
+ /* Figure out where the value goes -- in an accretion array or directly
+ into the final initial-value slot for the symbol. */
+
+ if ((ffedata_number_ != 0)
+ || (ffedata_arraysize_ > 1)
+ || (ffedata_charnumber_ != 0)
+ || (ffedata_size_ > ffedata_charexpected_))
+ { /* Accrete this value. */
+ ffetargetOffset offset;
+ ffebitCount actual;
+ ffebldConstantArray array;
+ ffebld accter = NULL;
+
+ /* Calculate offset. */
+
+ offset = ffedata_offset_ * ffedata_size_ + ffedata_charoffset_;
+
+ /* Is offset within range? If not, whine, but don't do anything else. */
+
+ if (offset + ffedata_charexpected_ - 1 > ffedata_symbolsize_)
+ {
+ ffebad_start (FFEBAD_DATA_RANGE);
+ ffest_ffebad_here_current_stmt (0);
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ ffedata_reported_error_ = TRUE;
+ return FALSE;
+ }
+
+ /* Does an accretion array exist? If not, create it. */
+
+ if (value != NULL)
+ {
+ if (ffesymbol_accretion (ffedata_symbol_) == NULL)
+ {
+#if FFEDATA_sizeTOO_BIG_INIT_ != 0
+ if (ffedata_symbolsize_ >= FFEDATA_sizeTOO_BIG_INIT_ )
+ {
+ char bignum[40];
+
+ sprintf (&bignum[0], "%ld", (long) ffedata_symbolsize_);
+ ffebad_start (FFEBAD_TOO_BIG_INIT);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_string (bignum);
+ ffebad_finish ();
+ }
+#endif
+ array = ffebld_constantarray_new
+ (ffedata_basictype_, ffedata_kindtype_,
+ ffedata_symbolsize_);
+ accter = ffebld_new_accter (array,
+ ffebit_new (ffe_pool_program_unit (),
+ ffedata_symbolsize_));
+ ffebld_set_info (accter, ffeinfo_new
+ (ffedata_basictype_,
+ ffedata_kindtype_,
+ 1,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ (ffedata_basictype_
+ == FFEINFO_basictypeCHARACTER)
+ ? 1 : FFETARGET_charactersizeNONE));
+ ffesymbol_set_accretion (ffedata_symbol_, accter);
+ ffesymbol_set_accretes (ffedata_symbol_, ffedata_symbolsize_);
+ }
+ else
+ {
+ accter = ffesymbol_accretion (ffedata_symbol_);
+ assert (ffedata_symbolsize_
+ == (ffetargetOffset) ffebld_accter_size (accter));
+ array = ffebld_accter (accter);
+ }
+
+ /* Put value in accretion array at desired offset. */
+
+ ffebld_constantarray_put
+ (array, ffedata_basictype_, ffedata_kindtype_,
+ offset, ffebld_constant_union (ffebld_conter (value)));
+ ffebit_count (ffebld_accter_bits (accter), offset, FALSE,
+ ffedata_charexpected_,
+ &actual); /* How many FALSE? */
+ if (actual != (unsigned long int) ffedata_charexpected_)
+ {
+ ffebad_start (FFEBAD_DATA_MULTIPLE);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_string (ffesymbol_text (ffedata_symbol_));
+ ffebad_finish ();
+ }
+ ffesymbol_set_accretes (ffedata_symbol_,
+ ffesymbol_accretes (ffedata_symbol_)
+ - actual); /* Decrement # of values
+ actually accreted. */
+ ffebit_set (ffebld_accter_bits (accter), offset,
+ 1, ffedata_charexpected_);
+ ffesymbol_signal_unreported (ffedata_symbol_);
+ }
+
+ /* If still accreting, adjust specs accordingly and return. */
+
+ if (++ffedata_number_ < ffedata_expected_)
+ {
+ ++ffedata_offset_;
+ return TRUE;
+ }
+
+ /* Else, if done accreting for this symbol, establish as initialized. */
+
+ if ((value != NULL)
+ && (ffesymbol_accretes (ffedata_symbol_) == 0))
+ {
+ ffesymbol_set_init (ffedata_symbol_, accter);
+ ffesymbol_set_accretion (ffedata_symbol_, NULL);
+ ffebit_kill (ffebld_accter_bits (ffesymbol_init (ffedata_symbol_)));
+ ffebld_set_op (ffesymbol_init (ffedata_symbol_), FFEBLD_opARRTER);
+ ffebld_set_arrter (ffesymbol_init (ffedata_symbol_),
+ ffebld_accter (ffesymbol_init (ffedata_symbol_)));
+ ffebld_arrter_set_size (ffesymbol_init (ffedata_symbol_),
+ ffedata_symbolsize_);
+ ffecom_notify_init_symbol (ffedata_symbol_);
+ }
+ }
+ else if (value != NULL)
+ {
+ /* Simple, direct, one-shot assignment. */
+ ffesymbol_set_init (ffedata_symbol_, value);
+ ffecom_notify_init_symbol (ffedata_symbol_);
+ }
+
+ /* Call on advance function to get next target in list. */
+
+ return ffedata_advance_ ();
+}
diff --git a/gcc/f/data.h b/gcc/f/data.h
new file mode 100644
index 00000000000..a17aa2f8b27
--- /dev/null
+++ b/gcc/f/data.h
@@ -0,0 +1,74 @@
+/* data.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ data.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_data
+#define _H_f_data
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lex.h"
+#include "storag.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffedata_begin (ffebld list);
+bool ffedata_end (bool report_errors, ffelexToken t);
+void ffedata_gather (ffestorag st);
+bool ffedata_value (ffetargetIntegerDefault rpt, ffebld value,
+ ffelexToken value_token);
+
+/* Define macros. */
+
+#define ffedata_init_0()
+#define ffedata_init_1()
+#define ffedata_init_2()
+#define ffedata_init_3()
+#define ffedata_init_4()
+#define ffedata_terminate_0()
+#define ffedata_terminate_1()
+#define ffedata_terminate_2()
+#define ffedata_terminate_3()
+#define ffedata_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/equiv.c b/gcc/f/equiv.c
new file mode 100644
index 00000000000..7dd2344cecb
--- /dev/null
+++ b/gcc/f/equiv.c
@@ -0,0 +1,1444 @@
+/* equiv.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Handles the EQUIVALENCE relationships in a program unit.
+
+ Modifications:
+*/
+
+#define FFEEQUIV_DEBUG 0
+
+/* Include files. */
+
+#include "proj.h"
+#include "equiv.h"
+#include "bad.h"
+#include "bld.h"
+#include "com.h"
+#include "data.h"
+#include "global.h"
+#include "lex.h"
+#include "malloc.h"
+#include "symbol.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffeequiv_list_
+ {
+ ffeequiv first;
+ ffeequiv last;
+ };
+
+/* Static objects accessed by functions in this module. */
+
+static struct _ffeequiv_list_ ffeequiv_list_;
+
+/* Static functions (internal). */
+
+static void ffeequiv_destroy_ (ffeequiv eq);
+static void ffeequiv_layout_local_ (ffeequiv eq);
+static bool ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s,
+ ffebld expr, bool subtract,
+ ffetargetOffset adjust, bool no_precede);
+
+/* Internal macros. */
+
+
+static void
+ffeequiv_destroy_ (ffeequiv victim)
+{
+ ffebld list;
+ ffebld item;
+ ffebld expr;
+
+ for (list = victim->list; list != NULL; list = ffebld_trail (list))
+ {
+ for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
+ {
+ ffesymbol sym;
+
+ expr = ffebld_head (item);
+ sym = ffeequiv_symbol (expr);
+ if (sym == NULL)
+ continue;
+ if (ffesymbol_equiv (sym) != NULL)
+ ffesymbol_set_equiv (sym, NULL);
+ }
+ }
+ ffeequiv_kill (victim);
+}
+
+/* ffeequiv_layout_local_ -- Lay out storage for local equivalenced vars
+
+ ffeequiv eq;
+ ffeequiv_layout_local_(eq);
+
+ Makes a single master ffestorag object that contains all the vars
+ in the equivalence, and makes subordinate ffestorag objects for the
+ vars with the correct offsets.
+
+ The resulting var offsets are relative not necessarily to 0 -- the
+ are relative to the offset of the master area, which might be 0 or
+ negative, but should never be positive. */
+
+static void
+ffeequiv_layout_local_ (ffeequiv eq)
+{
+ ffestorag st; /* Equivalence storage area. */
+ ffebld list; /* List of list of equivalences. */
+ ffebld item; /* List of equivalences. */
+ ffebld root_exp; /* Expression for root sym. */
+ ffestorag root_st; /* Storage for root. */
+ ffesymbol root_sym; /* Root itself. */
+ ffebld rooted_exp; /* Expression for rooted sym in an eqlist. */
+ ffestorag rooted_st; /* Storage for rooted. */
+ ffesymbol rooted_sym; /* Rooted symbol itself. */
+ ffetargetOffset eqlist_offset;/* Offset for eqlist from rooted sym. */
+ ffetargetAlign alignment;
+ ffetargetAlign modulo;
+ ffetargetAlign pad;
+ ffetargetOffset size;
+ ffetargetOffset num_elements;
+ bool new_storage; /* Established new storage info. */
+ bool need_storage; /* Have need for more storage info. */
+ bool init;
+
+ assert (eq != NULL);
+
+ if (ffeequiv_common (eq) != NULL)
+ { /* Put in common due to programmer error. */
+ ffeequiv_destroy_ (eq);
+ return;
+ }
+
+ /* Find the symbol for the first valid item in the list of lists, use that
+ as the root symbol. Doesn't matter if it won't end up at the beginning
+ of the list, though. */
+
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, "Equiv1:\n");
+#endif
+
+ root_sym = NULL;
+ root_exp = NULL;
+
+ for (list = ffeequiv_list (eq);
+ list != NULL;
+ list = ffebld_trail (list))
+ { /* For every equivalence list in the list of
+ equivs */
+ for (item = ffebld_head (list);
+ item != NULL;
+ item = ffebld_trail (item))
+ { /* For every equivalence item in the list */
+ ffetargetOffset ign; /* Ignored. */
+
+ root_exp = ffebld_head (item);
+ root_sym = ffeequiv_symbol (root_exp);
+ if (root_sym == NULL)
+ continue; /* Ignore me. */
+
+ assert (ffesymbol_storage (root_sym) == NULL); /* No storage yet. */
+
+ if (!ffeequiv_offset_ (&ign, root_sym, root_exp, FALSE, 0, FALSE))
+ {
+ /* We can't just eliminate this one symbol from the list
+ of candidates, because it might be the only one that
+ ties all these equivs together. So just destroy the
+ whole list. */
+
+ ffeequiv_destroy_ (eq);
+ return;
+ }
+
+ break; /* Use first valid eqv expr for root exp/sym. */
+ }
+ if (root_sym != NULL)
+ break;
+ }
+
+ if (root_sym == NULL)
+ {
+ ffeequiv_destroy_ (eq);
+ return;
+ }
+
+
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, " Root: `%s'\n", ffesymbol_text (root_sym));
+#endif
+
+ /* We've got work to do, so make the LOCAL storage object that'll hold all
+ the equivalenced vars inside it. */
+
+ st = ffestorag_new (ffestorag_list_master ());
+ ffestorag_set_parent (st, NULL); /* Initializations happen here. */
+ ffestorag_set_init (st, NULL);
+ ffestorag_set_accretion (st, NULL);
+ ffestorag_set_offset (st, 0); /* Assume equiv will be at root offset 0 for now. */
+ ffestorag_set_alignment (st, 1);
+ ffestorag_set_modulo (st, 0);
+ ffestorag_set_type (st, FFESTORAG_typeLOCAL);
+ ffestorag_set_basictype (st, ffesymbol_basictype (root_sym));
+ ffestorag_set_kindtype (st, ffesymbol_kindtype (root_sym));
+ ffestorag_set_typesymbol (st, root_sym);
+ ffestorag_set_is_save (st, ffeequiv_is_save (eq));
+ if (ffesymbol_is_save (root_sym))
+ ffestorag_update_save (st);
+ ffestorag_set_is_init (st, ffeequiv_is_init (eq));
+ if (ffesymbol_is_init (root_sym))
+ ffestorag_update_init (st);
+ ffestorag_set_symbol (st, root_sym); /* Assume this will be the root until
+ we know better (used only to generate
+ the internal name for the aggregate area,
+ e.g. for debugging). */
+
+ /* Make the EQUIV storage object for the root symbol. */
+
+ if (ffesymbol_rank (root_sym) == 0)
+ num_elements = 1;
+ else
+ num_elements = ffebld_constant_integerdefault (ffebld_conter
+ (ffesymbol_arraysize (root_sym)));
+ ffetarget_layout (ffesymbol_text (root_sym), &alignment, &modulo, &size,
+ ffesymbol_basictype (root_sym), ffesymbol_kindtype (root_sym),
+ ffesymbol_size (root_sym), num_elements);
+ ffestorag_set_size (st, size); /* Set initial size of aggregate area. */
+
+ pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
+ ffestorag_ptr_to_modulo (st), 0, alignment,
+ modulo);
+ assert (pad == 0);
+
+ root_st = ffestorag_new (ffestorag_list_equivs (st));
+ ffestorag_set_parent (root_st, st); /* Initializations happen there. */
+ ffestorag_set_init (root_st, NULL);
+ ffestorag_set_accretion (root_st, NULL);
+ ffestorag_set_symbol (root_st, root_sym);
+ ffestorag_set_size (root_st, size);
+ ffestorag_set_offset (root_st, 0); /* Will not change; always 0 relative to itself! */
+ ffestorag_set_alignment (root_st, alignment);
+ ffestorag_set_modulo (root_st, modulo);
+ ffestorag_set_type (root_st, FFESTORAG_typeEQUIV);
+ ffestorag_set_basictype (root_st, ffesymbol_basictype (root_sym));
+ ffestorag_set_kindtype (root_st, ffesymbol_kindtype (root_sym));
+ ffestorag_set_typesymbol (root_st, root_sym);
+ ffestorag_set_is_save (root_st, FALSE); /* Assume FALSE, then... */
+ if (ffestorag_is_save (st)) /* ...update to TRUE if needed. */
+ ffestorag_update_save (root_st);
+ ffestorag_set_is_init (root_st, FALSE); /* Assume FALSE, then... */
+ if (ffestorag_is_init (st)) /* ...update to TRUE if needed. */
+ ffestorag_update_init (root_st);
+ ffesymbol_set_storage (root_sym, root_st);
+ ffesymbol_signal_unreported (root_sym);
+ init = ffesymbol_is_init (root_sym);
+
+ /* Now that we know the root (offset=0) symbol, revisit all the lists and
+ do the actual storage allocation. Keep doing this until we've gone
+ through them all without making any new storage objects. */
+
+ do
+ {
+ new_storage = FALSE;
+ need_storage = FALSE;
+ for (list = ffeequiv_list (eq);
+ list != NULL;
+ list = ffebld_trail (list))
+ { /* For every equivalence list in the list of
+ equivs */
+ /* Now find a "rooted" symbol in this list. That is, find the
+ first item we can that is valid and whose symbol already
+ has a storage area, because that means we know where it
+ belongs in the equivalence area and can then allocate the
+ rest of the items in the list accordingly. */
+
+ rooted_sym = NULL;
+ rooted_exp = NULL;
+ eqlist_offset = 0;
+
+ for (item = ffebld_head (list);
+ item != NULL;
+ item = ffebld_trail (item))
+ { /* For every equivalence item in the list */
+ rooted_exp = ffebld_head (item);
+ rooted_sym = ffeequiv_symbol (rooted_exp);
+ if ((rooted_sym == NULL)
+ || ((rooted_st = ffesymbol_storage (rooted_sym)) == NULL))
+ {
+ rooted_sym = NULL;
+ continue; /* Ignore me. */
+ }
+
+ need_storage = TRUE; /* Somebody is likely to need
+ storage. */
+
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, " Rooted: `%s' at %" ffetargetOffset_f "d\n",
+ ffesymbol_text (rooted_sym),
+ ffestorag_offset (rooted_st));
+#endif
+
+ /* The offset of this symbol from the equiv's root symbol
+ is already known, and the size of this symbol is already
+ incorporated in the size of the equiv's aggregate area.
+ What we now determine is the offset of this equivalence
+ _list_ from the equiv's root symbol.
+
+ For example, if we know that A is at offset 16 from the
+ root symbol, given EQUIVALENCE (B(24),A(2)), we're looking
+ at A(2), meaning that the offset for this equivalence list
+ is 20 (4 bytes beyond the beginning of A, assuming typical
+ array types, dimensions, and type info). */
+
+ if (!ffeequiv_offset_ (&eqlist_offset, rooted_sym, rooted_exp, FALSE,
+ ffestorag_offset (rooted_st), FALSE))
+
+ { /* Can't use this one. */
+ ffesymbol_set_equiv (rooted_sym, NULL);/* Equiv area slated for
+ death. */
+ rooted_sym = NULL;
+ continue; /* Something's wrong with eqv expr, try another. */
+ }
+
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, " Eqlist offset: %" ffetargetOffset_f "d\n",
+ eqlist_offset);
+#endif
+
+ break;
+ }
+
+ /* If no rooted symbol, it means this list has no roots -- yet.
+ So, forget this list this time around, but we'll get back
+ to it after the outer loop iterates at least one more time,
+ and, ultimately, it will have a root. */
+
+ if (rooted_sym == NULL)
+ {
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, "No roots.\n");
+#endif
+ continue;
+ }
+
+ /* We now have a rooted symbol/expr and the offset of this equivalence
+ list from the root symbol. The other expressions in this
+ list all identify an initial storage unit that must have the
+ same offset. */
+
+ for (item = ffebld_head (list);
+ item != NULL;
+ item = ffebld_trail (item))
+ { /* For every equivalence item in the list */
+ ffebld item_exp; /* Expression for equivalence. */
+ ffestorag item_st; /* Storage for var. */
+ ffesymbol item_sym; /* Var itself. */
+ ffetargetOffset item_offset; /* Offset for var from root. */
+
+ item_exp = ffebld_head (item);
+ item_sym = ffeequiv_symbol (item_exp);
+ if ((item_sym == NULL)
+ || (ffesymbol_equiv (item_sym) == NULL))
+ continue; /* Ignore me. */
+
+ if (item_sym == rooted_sym)
+ continue; /* Rooted sym already set up. */
+
+ if (!ffeequiv_offset_ (&item_offset, item_sym, item_exp, TRUE,
+ eqlist_offset, FALSE))
+ {
+ ffesymbol_set_equiv (item_sym, NULL); /* Don't bother with me anymore. */
+ continue;
+ }
+
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, " Item `%s' at %" ffetargetOffset_f "d",
+ ffesymbol_text (item_sym), item_offset);
+#endif
+
+ if (ffesymbol_rank (item_sym) == 0)
+ num_elements = 1;
+ else
+ num_elements = ffebld_constant_integerdefault (ffebld_conter
+ (ffesymbol_arraysize (item_sym)));
+ ffetarget_layout (ffesymbol_text (item_sym), &alignment, &modulo,
+ &size, ffesymbol_basictype (item_sym),
+ ffesymbol_kindtype (item_sym), ffesymbol_size (item_sym),
+ num_elements);
+ pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
+ ffestorag_ptr_to_modulo (st),
+ item_offset, alignment, modulo);
+ if (pad != 0)
+ {
+ ffebad_start (FFEBAD_EQUIV_ALIGN);
+ ffebad_string (ffesymbol_text (item_sym));
+ ffebad_finish ();
+ ffesymbol_set_equiv (item_sym, NULL); /* Don't bother with me anymore. */
+ continue;
+ }
+
+ /* If the variable's offset is less than the offset for the
+ aggregate storage area, it means it has to expand backwards
+ -- i.e. the new known starting point of the area precedes the
+ old one. This can't happen with COMMON areas (the standard,
+ and common sense, disallow it), but it is normal for local
+ EQUIVALENCE areas.
+
+ Also handle choosing the "documented" rooted symbol for this
+ area here. It's the symbol at the bottom (lowest offset)
+ of the aggregate area, with ties going to the name that would
+ sort to the top of the list of ties. */
+
+ if (item_offset == ffestorag_offset (st))
+ {
+ if ((item_sym != ffestorag_symbol (st))
+ && (strcmp (ffesymbol_text (item_sym),
+ ffesymbol_text (ffestorag_symbol (st)))
+ < 0))
+ ffestorag_set_symbol (st, item_sym);
+ }
+ else if (item_offset < ffestorag_offset (st))
+ {
+ ffetargetOffset new_size;
+
+ /* Increase size of equiv area to start for lower offset relative
+ to root symbol. */
+
+ if (!ffetarget_offset_add (&new_size,
+ ffestorag_offset (st) - item_offset,
+ ffestorag_size (st)))
+ ffetarget_offset_overflow (ffesymbol_text (s));
+ else
+ ffestorag_set_size (st, new_size);
+
+ ffestorag_set_symbol (st, item_sym);
+ ffestorag_set_offset (st, item_offset);
+
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, " [eq offset=%" ffetargetOffset_f
+ "d, size=%" ffetargetOffset_f "d]",
+ item_offset, new_size);
+#endif
+ }
+
+ if ((item_st = ffesymbol_storage (item_sym)) == NULL)
+ { /* Create new ffestorag object, extend equiv
+ area. */
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, ".\n");
+#endif
+ new_storage = TRUE;
+ item_st = ffestorag_new (ffestorag_list_equivs (st));
+ ffestorag_set_parent (item_st, st); /* Initializations
+ happen there. */
+ ffestorag_set_init (item_st, NULL);
+ ffestorag_set_accretion (item_st, NULL);
+ ffestorag_set_symbol (item_st, item_sym);
+ ffestorag_set_size (item_st, size);
+ ffestorag_set_offset (item_st, item_offset);
+ ffestorag_set_alignment (item_st, alignment);
+ ffestorag_set_modulo (item_st, modulo);
+ ffestorag_set_type (item_st, FFESTORAG_typeEQUIV);
+ ffestorag_set_basictype (item_st, ffesymbol_basictype (item_sym));
+ ffestorag_set_kindtype (item_st, ffesymbol_kindtype (item_sym));
+ ffestorag_set_typesymbol (item_st, item_sym);
+ ffestorag_set_is_save (item_st, FALSE); /* Assume FALSE... */
+ if (ffestorag_is_save (st)) /* ...update TRUE */
+ ffestorag_update_save (item_st); /* if needed. */
+ ffestorag_set_is_init (item_st, FALSE); /* Assume FALSE... */
+ if (ffestorag_is_init (st)) /* ...update TRUE */
+ ffestorag_update_init (item_st); /* if needed. */
+ ffesymbol_set_storage (item_sym, item_st);
+ ffesymbol_signal_unreported (item_sym);
+ if (ffesymbol_is_init (item_sym))
+ init = TRUE;
+
+ /* Determine new size of equiv area, complain if overflow. */
+
+ if (!ffetarget_offset_add (&size, item_offset, size)
+ || !ffetarget_offset_add (&size, -ffestorag_offset (st), size))
+ ffetarget_offset_overflow (ffesymbol_text (s));
+ else if (size > ffestorag_size (st))
+ ffestorag_set_size (st, size);
+ ffestorag_update (st, item_sym, ffesymbol_basictype (item_sym),
+ ffesymbol_kindtype (item_sym));
+ }
+ else
+ {
+#if FFEEQUIV_DEBUG
+ fprintf (stderr, " (was %" ffetargetOffset_f "d).\n",
+ ffestorag_offset (item_st));
+#endif
+ /* Make sure offset agrees with known offset. */
+ if (item_offset != ffestorag_offset (item_st))
+ {
+ char io1[40];
+ char io2[40];
+
+ sprintf (&io1[0], "%" ffetargetOffset_f "d", item_offset);
+ sprintf (&io2[0], "%" ffetargetOffset_f "d", ffestorag_offset (item_st));
+ ffebad_start (FFEBAD_EQUIV_MISMATCH);
+ ffebad_string (ffesymbol_text (item_sym));
+ ffebad_string (ffesymbol_text (root_sym));
+ ffebad_string (io1);
+ ffebad_string (io2);
+ ffebad_finish ();
+ }
+ }
+ ffesymbol_set_equiv (item_sym, NULL); /* Don't bother with me anymore. */
+ } /* (For every equivalence item in the list) */
+ ffebld_set_head (list, NULL); /* Don't do this list again. */
+ } /* (For every equivalence list in the list of
+ equivs) */
+ } while (new_storage && need_storage);
+
+ ffesymbol_set_equiv (root_sym, NULL); /* This one has storage now. */
+
+ ffeequiv_kill (eq); /* Fully processed, no longer needed. */
+
+ if (init)
+ ffedata_gather (st); /* Gather subordinate inits into one init. */
+}
+
+/* ffeequiv_offset_ -- Determine offset from start of symbol
+
+ ffetargetOffset offset;
+ ffesymbol s; // Symbol for error reporting.
+ ffebld expr; // opSUBSTR, opARRAYREF, opSYMTER, opANY.
+ bool subtract; // FALSE means add to adjust, TRUE means subtract from it.
+ ffetargetOffset adjust; // Helps keep answer in pos range (unsigned).
+ if (!ffeequiv_offset_(&offset,s,expr,subtract,adjust))
+ // error doing the calculation, message already printed
+
+ Returns the offset represented by the SUBSTR, ARRAYREF, or SUBSTR/ARRAYREF
+ combination added-to/subtracted-from the adjustment specified. If there
+ is an error of some kind, returns FALSE, else returns TRUE. Note that
+ only the first storage unit specified is considered; A(1:1) and A(1:2000)
+ have the same first storage unit and so return the same offset. */
+
+static bool
+ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s UNUSED,
+ ffebld expr, bool subtract, ffetargetOffset adjust,
+ bool no_precede)
+{
+ ffetargetIntegerDefault value = 0;
+ ffetargetOffset cval; /* Converted value. */
+ ffesymbol sym;
+
+ if (expr == NULL)
+ return FALSE;
+
+again: /* :::::::::::::::::::: */
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opANY:
+ return FALSE;
+
+ case FFEBLD_opSYMTER:
+ {
+ ffetargetOffset size; /* Size of a single unit. */
+ ffetargetAlign a; /* Ignored. */
+ ffetargetAlign m; /* Ignored. */
+
+ sym = ffebld_symter (expr);
+ if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)
+ return FALSE;
+
+ ffetarget_layout (ffesymbol_text (sym), &a, &m, &size,
+ ffesymbol_basictype (sym),
+ ffesymbol_kindtype (sym), 1, 1);
+
+ if (value < 0)
+ { /* Really invalid, as in A(-2:5), but in case
+ it's wanted.... */
+ if (!ffetarget_offset (&cval, -value))
+ return FALSE;
+
+ if (!ffetarget_offset_multiply (&cval, cval, size))
+ return FALSE;
+
+ if (subtract)
+ return ffetarget_offset_add (offset, cval, adjust);
+
+ if (no_precede && (cval > adjust))
+ {
+ neg: /* :::::::::::::::::::: */
+ ffebad_start (FFEBAD_COMMON_NEG);
+ ffebad_string (ffesymbol_text (sym));
+ ffebad_finish ();
+ return FALSE;
+ }
+ return ffetarget_offset_add (offset, -cval, adjust);
+ }
+
+ if (!ffetarget_offset (&cval, value))
+ return FALSE;
+
+ if (!ffetarget_offset_multiply (&cval, cval, size))
+ return FALSE;
+
+ if (!subtract)
+ return ffetarget_offset_add (offset, cval, adjust);
+
+ if (no_precede && (cval > adjust))
+ goto neg; /* :::::::::::::::::::: */
+
+ return ffetarget_offset_add (offset, -cval, adjust);
+ }
+
+ case FFEBLD_opARRAYREF:
+ {
+ ffebld symexp = ffebld_left (expr);
+ ffebld subscripts = ffebld_right (expr);
+ ffebld dims;
+ ffetargetIntegerDefault width;
+ ffetargetIntegerDefault arrayval;
+ ffetargetIntegerDefault lowbound;
+ ffetargetIntegerDefault highbound;
+ ffebld subscript;
+ ffebld dim;
+ ffebld low;
+ ffebld high;
+ int rank = 0;
+
+ if (ffebld_op (symexp) != FFEBLD_opSYMTER)
+ return FALSE;
+
+ sym = ffebld_symter (symexp);
+ if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)
+ return FALSE;
+
+ if (ffesymbol_size (sym) == FFETARGET_charactersizeNONE)
+ width = 1;
+ else
+ width = ffesymbol_size (sym);
+ dims = ffesymbol_dims (sym);
+
+ while (subscripts != NULL)
+ {
+ ++rank;
+ if (dims == NULL)
+ {
+ ffebad_start (FFEBAD_EQUIV_MANY);
+ ffebad_string (ffesymbol_text (sym));
+ ffebad_finish ();
+ return FALSE;
+ }
+
+ subscript = ffebld_head (subscripts);
+ dim = ffebld_head (dims);
+
+ assert (ffebld_op (subscript) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (subscript))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (subscript))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ arrayval = ffebld_constant_integerdefault (ffebld_conter
+ (subscript));
+
+ assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
+ low = ffebld_left (dim);
+ high = ffebld_right (dim);
+
+ if (low == NULL)
+ lowbound = 1;
+ else
+ {
+ assert (ffeinfo_basictype (ffebld_info (low))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (low))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ lowbound
+ = ffebld_constant_integerdefault (ffebld_conter (low));
+ }
+
+ assert (ffebld_op (high) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (high))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (high))
+ == FFEINFO_kindtypeINTEGER1);
+ highbound
+ = ffebld_constant_integerdefault (ffebld_conter (high));
+
+ if ((arrayval < lowbound) || (arrayval > highbound))
+ {
+ char rankstr[10];
+
+ sprintf (rankstr, "%d", rank);
+ ffebad_start (FFEBAD_EQUIV_SUBSCRIPT);
+ ffebad_string (ffesymbol_text (sym));
+ ffebad_string (rankstr);
+ ffebad_finish ();
+ }
+
+ subscripts = ffebld_trail (subscripts);
+ dims = ffebld_trail (dims);
+
+ value += width * (arrayval - lowbound);
+ if (subscripts != NULL)
+ width *= highbound - lowbound + 1;
+ }
+
+ if (dims != NULL)
+ {
+ ffebad_start (FFEBAD_EQUIV_FEW);
+ ffebad_string (ffesymbol_text (sym));
+ ffebad_finish ();
+ return FALSE;
+ }
+
+ expr = symexp;
+ }
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEBLD_opSUBSTR:
+ {
+ ffebld begin = ffebld_head (ffebld_right (expr));
+
+ expr = ffebld_left (expr);
+ if (ffebld_op (expr) == FFEBLD_opARRAYREF)
+ sym = ffebld_symter (ffebld_left (expr));
+ else if (ffebld_op (expr) == FFEBLD_opSYMTER)
+ sym = ffebld_symter (expr);
+ else
+ sym = NULL;
+
+ if ((sym != NULL)
+ && (ffesymbol_basictype (sym) == FFEINFO_basictypeANY))
+ return FALSE;
+
+ if (begin == NULL)
+ value = 0;
+ else
+ {
+ assert (ffebld_op (begin) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (begin))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (begin))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+
+ value = ffebld_constant_integerdefault (ffebld_conter (begin));
+
+ if ((value < 1)
+ || ((sym != NULL)
+ && (value > ffesymbol_size (sym))))
+ {
+ ffebad_start (FFEBAD_EQUIV_RANGE);
+ ffebad_string (ffesymbol_text (sym));
+ ffebad_finish ();
+ }
+
+ --value;
+ }
+ if ((sym != NULL)
+ && (ffesymbol_basictype (sym) != FFEINFO_basictypeCHARACTER))
+ {
+ ffebad_start (FFEBAD_EQUIV_SUBSTR);
+ ffebad_string (ffesymbol_text (sym));
+ ffebad_finish ();
+ value = 0;
+ }
+ }
+ goto again; /* :::::::::::::::::::: */
+
+ default:
+ assert ("bad op" == NULL);
+ return FALSE;
+ }
+
+}
+
+/* ffeequiv_add -- Add list of equivalences to list of lists for eq object
+
+ ffeequiv eq;
+ ffebld list;
+ ffelexToken t; // points to first item in equivalence list
+ ffeequiv_add(eq,list,t);
+
+ Check the list to make sure only one common symbol is involved (even
+ if multiple times) and agrees with the common symbol for the equivalence
+ object (or it has no common symbol until now). Prepend (or append, it
+ doesn't matter) the list to the list of lists for the equivalence object.
+ Otherwise report an error and return. */
+
+void
+ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t)
+{
+ ffebld item;
+ ffesymbol symbol;
+ ffesymbol common = ffeequiv_common (eq);
+
+ for (item = list; item != NULL; item = ffebld_trail (item))
+ {
+ symbol = ffeequiv_symbol (ffebld_head (item));
+
+ if (ffesymbol_common (symbol) != NULL) /* Is symbol known in COMMON yet? */
+ {
+ if (common == NULL)
+ common = ffesymbol_common (symbol);
+ else if (common != ffesymbol_common (symbol))
+ {
+ /* Yes, and symbol disagrees with others on the COMMON area. */
+ ffebad_start (FFEBAD_EQUIV_COMMON);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (ffesymbol_text (common));
+ ffebad_string (ffesymbol_text (ffesymbol_common (symbol)));
+ ffebad_finish ();
+ return;
+ }
+ }
+ }
+
+ if ((common != NULL)
+ && (ffeequiv_common (eq) == NULL)) /* Is COMMON involved already? */
+ ffeequiv_set_common (eq, common); /* No, but it is now. */
+
+ for (item = list; item != NULL; item = ffebld_trail (item))
+ {
+ symbol = ffeequiv_symbol (ffebld_head (item));
+
+ if (ffesymbol_equiv (symbol) == NULL)
+ ffesymbol_set_equiv (symbol, eq);
+ else
+ assert (ffesymbol_equiv (symbol) == eq);
+
+ if (ffesymbol_common (symbol) == NULL) /* Is symbol in a COMMON
+ area? */
+ { /* No (at least not yet). */
+ if (ffesymbol_is_save (symbol))
+ ffeequiv_update_save (eq); /* EQUIVALENCE has >=1 SAVEd entity. */
+ if (ffesymbol_is_init (symbol))
+ ffeequiv_update_init (eq); /* EQUIVALENCE has >=1 init'd entity. */
+ continue; /* Nothing more to do here. */
+ }
+
+#if FFEGLOBAL_ENABLED
+ if (ffesymbol_is_init (symbol))
+ ffeglobal_init_common (ffesymbol_common (symbol), t);
+#endif
+
+ if (ffesymbol_is_save (ffesymbol_common (symbol)))
+ ffeequiv_update_save (eq); /* EQUIVALENCE is in a SAVEd COMMON block. */
+ if (ffesymbol_is_init (ffesymbol_common (symbol)))
+ ffeequiv_update_init (eq); /* EQUIVALENCE is in a init'd COMMON block. */
+ }
+
+ ffeequiv_set_list (eq, ffebld_new_item (list, ffeequiv_list (eq)));
+}
+
+/* ffeequiv_dump -- Dump info on equivalence object
+
+ ffeequiv eq;
+ ffeequiv_dump(eq); */
+
+void
+ffeequiv_dump (ffeequiv eq)
+{
+ if (ffeequiv_common (eq) != NULL)
+ fprintf (dmpout, "(common %s) ", ffesymbol_text (ffeequiv_common (eq)));
+ ffebld_dump (ffeequiv_list (eq));
+}
+
+/* ffeequiv_exec_transition -- Do the hard work on all the equivalence objects
+
+ ffeequiv_exec_transition(); */
+
+void
+ffeequiv_exec_transition ()
+{
+ while (ffeequiv_list_.first != (ffeequiv) &ffeequiv_list_.first)
+ ffeequiv_layout_local_ (ffeequiv_list_.first);
+}
+
+/* ffeequiv_init_2 -- Initialize for new program unit
+
+ ffeequiv_init_2();
+
+ Initializes the list of equivalences. */
+
+void
+ffeequiv_init_2 ()
+{
+ ffeequiv_list_.first = (ffeequiv) &ffeequiv_list_.first;
+ ffeequiv_list_.last = (ffeequiv) &ffeequiv_list_.first;
+}
+
+/* ffeequiv_kill -- Kill equivalence object after removing from list
+
+ ffeequiv eq;
+ ffeequiv_kill(eq);
+
+ Removes equivalence object from master list, then kills it. */
+
+void
+ffeequiv_kill (ffeequiv victim)
+{
+ victim->next->previous = victim->previous;
+ victim->previous->next = victim->next;
+ if (ffe_is_do_internal_checks ())
+ {
+ ffebld list;
+ ffebld item;
+ ffebld expr;
+
+ /* Assert that nobody our victim points to still points to it. */
+
+ assert ((victim->common == NULL)
+ || (ffesymbol_equiv (victim->common) == NULL));
+
+ for (list = victim->list; list != NULL; list = ffebld_trail (list))
+ {
+ for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
+ {
+ ffesymbol sym;
+
+ expr = ffebld_head (item);
+ sym = ffeequiv_symbol (expr);
+ if (sym == NULL)
+ continue;
+ assert (ffesymbol_equiv (sym) != victim);
+ }
+ }
+ }
+ malloc_kill_ks (ffe_pool_program_unit (), victim, sizeof (*victim));
+}
+
+/* ffeequiv_layout_cblock -- Lay out storage for common area
+
+ ffestorag st;
+ if (ffeequiv_layout_cblock(st))
+ // at least one equiv'd symbol has init/accretion expr.
+
+ Now that the explicitly COMMONed variables in the common area (whose
+ ffestorag object is passed) have been laid out, lay out the storage
+ for all variables equivalenced into the area by making subordinate
+ ffestorag objects for them. */
+
+bool
+ffeequiv_layout_cblock (ffestorag st)
+{
+ ffesymbol s = ffestorag_symbol (st); /* CBLOCK symbol. */
+ ffebld list; /* List of explicit common vars, in order, in
+ s. */
+ ffebld item; /* List of list of equivalences in a given
+ explicit common var. */
+ ffebld root; /* Expression for (1st) explicit common var
+ in list of eqs. */
+ ffestorag rst; /* Storage for root. */
+ ffetargetOffset root_offset; /* Offset for root into common area. */
+ ffesymbol sr; /* Root itself. */
+ ffeequiv seq; /* Its equivalence object, if any. */
+ ffebld var; /* Expression for equivalence. */
+ ffestorag vst; /* Storage for var. */
+ ffetargetOffset var_offset; /* Offset for var into common area. */
+ ffesymbol sv; /* Var itself. */
+ ffebld altroot; /* Alternate root. */
+ ffesymbol altrootsym; /* Alternate root symbol. */
+ ffetargetAlign alignment;
+ ffetargetAlign modulo;
+ ffetargetAlign pad;
+ ffetargetOffset size;
+ ffetargetOffset num_elements;
+ bool new_storage; /* Established new storage info. */
+ bool need_storage; /* Have need for more storage info. */
+ bool ok;
+ bool init = FALSE;
+
+ assert (st != NULL);
+ assert (ffestorag_type (st) == FFESTORAG_typeCBLOCK);
+ assert (ffesymbol_kind (ffestorag_symbol (st)) == FFEINFO_kindCOMMON);
+
+ for (list = ffesymbol_commonlist (ffestorag_symbol (st));
+ list != NULL;
+ list = ffebld_trail (list))
+ { /* For every variable in the common area */
+ assert (ffebld_op (ffebld_head (list)) == FFEBLD_opSYMTER);
+ sr = ffebld_symter (ffebld_head (list));
+ if ((seq = ffesymbol_equiv (sr)) == NULL)
+ continue; /* No equivalences to process. */
+ rst = ffesymbol_storage (sr);
+ if (rst == NULL)
+ {
+ assert (ffesymbol_kind (sr) == FFEINFO_kindANY);
+ continue;
+ }
+ ffesymbol_set_equiv (sr, NULL); /* Cancel ref to equiv obj. */
+ do
+ {
+ new_storage = FALSE;
+ need_storage = FALSE;
+ for (item = ffeequiv_list (seq); /* Get list of equivs. */
+ item != NULL;
+ item = ffebld_trail (item))
+ { /* For every eqv list in the list of equivs
+ for the variable */
+ altroot = NULL;
+ altrootsym = NULL;
+ for (root = ffebld_head (item);
+ root != NULL;
+ root = ffebld_trail (root))
+ { /* For every equivalence item in the list */
+ sv = ffeequiv_symbol (ffebld_head (root));
+ if (sv == sr)
+ break; /* Found first mention of "rooted" symbol. */
+ if (ffesymbol_storage (sv) != NULL)
+ {
+ altroot = root; /* If no mention, use this guy
+ instead. */
+ altrootsym = sv;
+ }
+ }
+ if (root != NULL)
+ {
+ root = ffebld_head (root); /* Lose its opITEM. */
+ ok = ffeequiv_offset_ (&root_offset, sr, root, FALSE,
+ ffestorag_offset (rst), TRUE);
+ /* Equiv point prior to start of common area? */
+ }
+ else if (altroot != NULL)
+ {
+ /* Equiv point prior to start of common area? */
+ root = ffebld_head (altroot);
+ ok = ffeequiv_offset_ (&root_offset, altrootsym, root,
+ FALSE,
+ ffestorag_offset (ffesymbol_storage (altrootsym)),
+ TRUE);
+ ffesymbol_set_equiv (altrootsym, NULL);
+ }
+ else
+ /* No rooted symbol in list of equivalences! */
+ { /* Assume this was due to opANY and ignore
+ this list for now. */
+ need_storage = TRUE;
+ continue;
+ }
+
+ /* We now know the root symbol and the operating offset of that
+ root into the common area. The other expressions in the
+ list all identify an initial storage unit that must have the
+ same offset. */
+
+ for (var = ffebld_head (item);
+ var != NULL;
+ var = ffebld_trail (var))
+ { /* For every equivalence item in the list */
+ if (ffebld_head (var) == root)
+ continue; /* Except root, of course. */
+ sv = ffeequiv_symbol (ffebld_head (var));
+ if (sv == NULL)
+ continue; /* Except erroneous stuff (opANY). */
+ ffesymbol_set_equiv (sv, NULL); /* Don't need this ref
+ anymore. */
+ if (!ok
+ || !ffeequiv_offset_ (&var_offset, sv,
+ ffebld_head (var), TRUE,
+ root_offset, TRUE))
+ continue; /* Can't do negative offset wrt COMMON. */
+
+ if (ffesymbol_rank (sv) == 0)
+ num_elements = 1;
+ else
+ num_elements = ffebld_constant_integerdefault
+ (ffebld_conter (ffesymbol_arraysize (sv)));
+ ffetarget_layout (ffesymbol_text (sv), &alignment,
+ &modulo, &size,
+ ffesymbol_basictype (sv),
+ ffesymbol_kindtype (sv),
+ ffesymbol_size (sv), num_elements);
+ pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
+ ffestorag_ptr_to_modulo (st),
+ var_offset, alignment, modulo);
+ if (pad != 0)
+ {
+ ffebad_start (FFEBAD_EQUIV_ALIGN);
+ ffebad_string (ffesymbol_text (sv));
+ ffebad_finish ();
+ continue;
+ }
+
+ if ((vst = ffesymbol_storage (sv)) == NULL)
+ { /* Create new ffestorag object, extend
+ cblock. */
+ new_storage = TRUE;
+ vst = ffestorag_new (ffestorag_list_equivs (st));
+ ffestorag_set_parent (vst, st); /* Initializations
+ happen there. */
+ ffestorag_set_init (vst, NULL);
+ ffestorag_set_accretion (vst, NULL);
+ ffestorag_set_symbol (vst, sv);
+ ffestorag_set_size (vst, size);
+ ffestorag_set_offset (vst, var_offset);
+ ffestorag_set_alignment (vst, alignment);
+ ffestorag_set_modulo (vst, modulo);
+ ffestorag_set_type (vst, FFESTORAG_typeEQUIV);
+ ffestorag_set_basictype (vst, ffesymbol_basictype (sv));
+ ffestorag_set_kindtype (vst, ffesymbol_kindtype (sv));
+ ffestorag_set_typesymbol (vst, sv);
+ ffestorag_set_is_save (vst, FALSE); /* Assume FALSE... */
+ if (ffestorag_is_save (st)) /* ...update TRUE */
+ ffestorag_update_save (vst); /* if needed. */
+ ffestorag_set_is_init (vst, FALSE); /* Assume FALSE... */
+ if (ffestorag_is_init (st)) /* ...update TRUE */
+ ffestorag_update_init (vst); /* if needed. */
+ if (!ffetarget_offset_add (&size, var_offset, size))
+ /* Find one size of common block, complain if
+ overflow. */
+ ffetarget_offset_overflow (ffesymbol_text (s));
+ else if (size > ffestorag_size (st))
+ /* Extend common. */
+ ffestorag_set_size (st, size);
+ ffesymbol_set_storage (sv, vst);
+ ffesymbol_set_common (sv, s);
+ ffesymbol_signal_unreported (sv);
+ ffestorag_update (st, sv, ffesymbol_basictype (sv),
+ ffesymbol_kindtype (sv));
+ if (ffesymbol_is_init (sv))
+ init = TRUE;
+ }
+ else
+ {
+ /* Make sure offset agrees with known offset. */
+ if (var_offset != ffestorag_offset (vst))
+ {
+ char io1[40];
+ char io2[40];
+
+ sprintf (&io1[0], "%" ffetargetOffset_f "d", var_offset);
+ sprintf (&io2[0], "%" ffetargetOffset_f "d", ffestorag_offset (vst));
+ ffebad_start (FFEBAD_EQUIV_MISMATCH);
+ ffebad_string (ffesymbol_text (sv));
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string (io1);
+ ffebad_string (io2);
+ ffebad_finish ();
+ }
+ }
+ } /* (For every equivalence item in the list) */
+ } /* (For every eqv list in the list of equivs
+ for the variable) */
+ }
+ while (new_storage && need_storage);
+
+ ffeequiv_kill (seq); /* Kill equiv obj. */
+ } /* (For every variable in the common area) */
+
+ return init;
+}
+
+/* ffeequiv_merge -- Merge two equivalence objects, return the merged result
+
+ ffeequiv eq1;
+ ffeequiv eq2;
+ ffelexToken t; // points to current equivalence item forcing the merge.
+ eq1 = ffeequiv_merge(eq1,eq2,t);
+
+ If the two equivalence objects can be merged, they are, all the
+ ffesymbols in their lists of lists are adjusted to point to the merged
+ equivalence object, and the merged object is returned.
+
+ Otherwise, the two equivalence objects have different non-NULL common
+ symbols, so the merge cannot take place. An error message is issued and
+ NULL is returned. */
+
+ffeequiv
+ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t)
+{
+ ffebld list;
+ ffebld eqs;
+ ffesymbol symbol;
+ ffebld last = NULL;
+
+ /* If both equivalence objects point to different common-based symbols,
+ complain. Of course, one or both might have NULL common symbols now,
+ and get COMMONed later, but the COMMON statement handler checks for
+ this. */
+
+ if ((ffeequiv_common (eq1) != NULL) && (ffeequiv_common (eq2) != NULL)
+ && (ffeequiv_common (eq1) != ffeequiv_common (eq2)))
+ {
+ ffebad_start (FFEBAD_EQUIV_COMMON);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (ffesymbol_text (ffeequiv_common (eq1)));
+ ffebad_string (ffesymbol_text (ffeequiv_common (eq2)));
+ ffebad_finish ();
+ return NULL;
+ }
+
+ /* Make eq1 the new, merged object (arbitrarily). */
+
+ if (ffeequiv_common (eq1) == NULL)
+ ffeequiv_set_common (eq1, ffeequiv_common (eq2));
+
+ /* If the victim object has any init'ed entities, so does the new object. */
+
+ if (eq2->is_init)
+ eq1->is_init = TRUE;
+
+#if FFEGLOBAL_ENABLED
+ if (eq1->is_init && (ffeequiv_common (eq1) != NULL))
+ ffeglobal_init_common (ffeequiv_common (eq1), t);
+#endif
+
+ /* If the victim object has any SAVEd entities, then the new object has
+ some. */
+
+ if (ffeequiv_is_save (eq2))
+ ffeequiv_update_save (eq1);
+
+ /* If the victim object has any init'd entities, then the new object has
+ some. */
+
+ if (ffeequiv_is_init (eq2))
+ ffeequiv_update_init (eq1);
+
+ /* Adjust all the symbols in the list of lists of equivalences for the
+ victim equivalence object so they point to the new merged object
+ instead. */
+
+ for (list = ffeequiv_list (eq2); list != NULL; list = ffebld_trail (list))
+ {
+ for (eqs = ffebld_head (list); eqs != NULL; eqs = ffebld_trail (eqs))
+ {
+ symbol = ffeequiv_symbol (ffebld_head (eqs));
+ if (ffesymbol_equiv (symbol) == eq2)
+ ffesymbol_set_equiv (symbol, eq1);
+ else
+ assert (ffesymbol_equiv (symbol) == eq1); /* Can see a sym > once. */
+ }
+
+ /* For convenience, remember where the last ITEM in the outer list is. */
+
+ if (ffebld_trail (list) == NULL)
+ {
+ last = list;
+ break;
+ }
+ }
+
+ /* Append the list of lists in the new, merged object to the list of lists
+ in the victim object, then use the new combined list in the new merged
+ object. */
+
+ ffebld_set_trail (last, ffeequiv_list (eq1));
+ ffeequiv_set_list (eq1, ffeequiv_list (eq2));
+
+ /* Unlink and kill the victim object. */
+
+ ffeequiv_kill (eq2);
+
+ return eq1; /* Return the new merged object. */
+}
+
+/* ffeequiv_new -- Create new equivalence object, put in list
+
+ ffeequiv eq;
+ eq = ffeequiv_new();
+
+ Creates a new equivalence object and adds it to the list of equivalence
+ objects. */
+
+ffeequiv
+ffeequiv_new ()
+{
+ ffeequiv eq;
+
+ eq = malloc_new_ks (ffe_pool_program_unit (), "ffeequiv", sizeof (*eq));
+ eq->next = (ffeequiv) &ffeequiv_list_.first;
+ eq->previous = ffeequiv_list_.last;
+ ffeequiv_set_common (eq, NULL); /* No COMMON area yet. */
+ ffeequiv_set_list (eq, NULL); /* No list of lists of equivalences yet. */
+ ffeequiv_set_is_save (eq, FALSE);
+ ffeequiv_set_is_init (eq, FALSE);
+ eq->next->previous = eq;
+ eq->previous->next = eq;
+
+ return eq;
+}
+
+/* ffeequiv_symbol -- Return symbol for equivalence expression
+
+ ffesymbol symbol;
+ ffebld expr;
+ symbol = ffeequiv_symbol(expr);
+
+ Finds the terminal SYMTER in an equivalence expression and returns the
+ ffesymbol for it. */
+
+ffesymbol
+ffeequiv_symbol (ffebld expr)
+{
+ assert (expr != NULL);
+
+again: /* :::::::::::::::::::: */
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opARRAYREF:
+ case FFEBLD_opSUBSTR:
+ expr = ffebld_left (expr);
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEBLD_opSYMTER:
+ return ffebld_symter (expr);
+
+ case FFEBLD_opANY:
+ return NULL;
+
+ default:
+ assert ("bad eq expr" == NULL);
+ return NULL;
+ }
+}
+
+/* ffeequiv_update_init -- Update the INIT flag for the area to TRUE
+
+ ffeequiv eq;
+ ffeequiv_update_init(eq);
+
+ If the INIT flag for the <eq> object is already set, return. Else,
+ set it TRUE and call ffe*_update_init for all objects contained in
+ this one. */
+
+void
+ffeequiv_update_init (ffeequiv eq)
+{
+ ffebld list; /* Current list in list of lists. */
+ ffebld item; /* Current item in current list. */
+ ffebld expr; /* Expression in head of current item. */
+
+ if (eq->is_init)
+ return;
+
+ eq->is_init = TRUE;
+
+ if ((eq->common != NULL)
+ && !ffesymbol_is_init (eq->common))
+ ffesymbol_update_init (eq->common); /* Shouldn't be needed. */
+
+ for (list = eq->list; list != NULL; list = ffebld_trail (list))
+ {
+ for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
+ {
+ expr = ffebld_head (item);
+
+ again: /* :::::::::::::::::::: */
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opANY:
+ break;
+
+ case FFEBLD_opSYMTER:
+ if (!ffesymbol_is_init (ffebld_symter (expr)))
+ ffesymbol_update_init (ffebld_symter (expr));
+ break;
+
+ case FFEBLD_opARRAYREF:
+ expr = ffebld_left (expr);
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEBLD_opSUBSTR:
+ expr = ffebld_left (expr);
+ goto again; /* :::::::::::::::::::: */
+
+ default:
+ assert ("bad op for ffeequiv_update_init" == NULL);
+ break;
+ }
+ }
+ }
+}
+
+/* ffeequiv_update_save -- Update the SAVE flag for the area to TRUE
+
+ ffeequiv eq;
+ ffeequiv_update_save(eq);
+
+ If the SAVE flag for the <eq> object is already set, return. Else,
+ set it TRUE and call ffe*_update_save for all objects contained in
+ this one. */
+
+void
+ffeequiv_update_save (ffeequiv eq)
+{
+ ffebld list; /* Current list in list of lists. */
+ ffebld item; /* Current item in current list. */
+ ffebld expr; /* Expression in head of current item. */
+
+ if (eq->is_save)
+ return;
+
+ eq->is_save = TRUE;
+
+ if ((eq->common != NULL)
+ && !ffesymbol_is_save (eq->common))
+ ffesymbol_update_save (eq->common); /* Shouldn't be needed. */
+
+ for (list = eq->list; list != NULL; list = ffebld_trail (list))
+ {
+ for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
+ {
+ expr = ffebld_head (item);
+
+ again: /* :::::::::::::::::::: */
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opANY:
+ break;
+
+ case FFEBLD_opSYMTER:
+ if (!ffesymbol_is_save (ffebld_symter (expr)))
+ ffesymbol_update_save (ffebld_symter (expr));
+ break;
+
+ case FFEBLD_opARRAYREF:
+ expr = ffebld_left (expr);
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEBLD_opSUBSTR:
+ expr = ffebld_left (expr);
+ goto again; /* :::::::::::::::::::: */
+
+ default:
+ assert ("bad op for ffeequiv_update_save" == NULL);
+ break;
+ }
+ }
+ }
+}
diff --git a/gcc/f/equiv.h b/gcc/f/equiv.h
new file mode 100644
index 00000000000..225cafded1b
--- /dev/null
+++ b/gcc/f/equiv.h
@@ -0,0 +1,101 @@
+/* equiv.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ equiv.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_equiv
+#define _H_f_equiv
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+typedef struct _ffeequiv_ *ffeequiv;
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lex.h"
+#include "storag.h"
+#include "symbol.h"
+
+/* Structure definitions. */
+
+struct _ffeequiv_
+ {
+ ffeequiv next;
+ ffeequiv previous;
+ ffesymbol common; /* Common area for this equiv, if any. */
+ ffebld list; /* List of lists of equiv exprs. */
+ bool is_save; /* Any SAVEd members? */
+ bool is_init; /* Any initialized members? */
+ };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t);
+void ffeequiv_dump (ffeequiv eq);
+void ffeequiv_exec_transition (void);
+void ffeequiv_init_2 (void);
+void ffeequiv_kill (ffeequiv victim);
+bool ffeequiv_layout_cblock (ffestorag st);
+ffeequiv ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t);
+ffeequiv ffeequiv_new (void);
+ffesymbol ffeequiv_symbol (ffebld expr);
+void ffeequiv_update_init (ffeequiv eq);
+void ffeequiv_update_save (ffeequiv eq);
+
+/* Define macros. */
+
+#define ffeequiv_common(e) ((e)->common)
+#define ffeequiv_init_0()
+#define ffeequiv_init_1()
+#define ffeequiv_init_3()
+#define ffeequiv_init_4()
+#define ffeequiv_is_init(e) ((e)->is_init)
+#define ffeequiv_is_save(e) ((e)->is_save)
+#define ffeequiv_list(e) ((e)->list)
+#define ffeequiv_next(e) ((e)->next)
+#define ffeequiv_previous(e) ((e)->previous)
+#define ffeequiv_set_common(e,c) ((e)->common = (c))
+#define ffeequiv_set_init(e,i) ((e)->init = (i))
+#define ffeequiv_set_is_init(e,in) ((e)->is_init = (in))
+#define ffeequiv_set_is_save(e,sa) ((e)->is_save = (sa))
+#define ffeequiv_set_list(e,l) ((e)->list = (l))
+#define ffeequiv_terminate_0()
+#define ffeequiv_terminate_1()
+#define ffeequiv_terminate_2()
+#define ffeequiv_terminate_3()
+#define ffeequiv_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/expr.c b/gcc/f/expr.c
new file mode 100644
index 00000000000..057293b0eef
--- /dev/null
+++ b/gcc/f/expr.c
@@ -0,0 +1,19405 @@
+/* expr.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None.
+
+ Description:
+ Handles syntactic and semantic analysis of Fortran expressions.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "expr.h"
+#include "bad.h"
+#include "bld.h"
+#include "com.h"
+#include "global.h"
+#include "implic.h"
+#include "intrin.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#include "st.h"
+#include "symbol.h"
+#include "target.h"
+#include "where.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFEEXPR_dotdotNONE_,
+ FFEEXPR_dotdotTRUE_,
+ FFEEXPR_dotdotFALSE_,
+ FFEEXPR_dotdotNOT_,
+ FFEEXPR_dotdotAND_,
+ FFEEXPR_dotdotOR_,
+ FFEEXPR_dotdotXOR_,
+ FFEEXPR_dotdotEQV_,
+ FFEEXPR_dotdotNEQV_,
+ FFEEXPR_dotdotLT_,
+ FFEEXPR_dotdotLE_,
+ FFEEXPR_dotdotEQ_,
+ FFEEXPR_dotdotNE_,
+ FFEEXPR_dotdotGT_,
+ FFEEXPR_dotdotGE_,
+ FFEEXPR_dotdot
+ } ffeexprDotdot_;
+
+typedef enum
+ {
+ FFEEXPR_exprtypeUNKNOWN_,
+ FFEEXPR_exprtypeOPERAND_,
+ FFEEXPR_exprtypeUNARY_,
+ FFEEXPR_exprtypeBINARY_,
+ FFEEXPR_exprtype_
+ } ffeexprExprtype_;
+
+typedef enum
+ {
+ FFEEXPR_operatorPOWER_,
+ FFEEXPR_operatorMULTIPLY_,
+ FFEEXPR_operatorDIVIDE_,
+ FFEEXPR_operatorADD_,
+ FFEEXPR_operatorSUBTRACT_,
+ FFEEXPR_operatorCONCATENATE_,
+ FFEEXPR_operatorLT_,
+ FFEEXPR_operatorLE_,
+ FFEEXPR_operatorEQ_,
+ FFEEXPR_operatorNE_,
+ FFEEXPR_operatorGT_,
+ FFEEXPR_operatorGE_,
+ FFEEXPR_operatorNOT_,
+ FFEEXPR_operatorAND_,
+ FFEEXPR_operatorOR_,
+ FFEEXPR_operatorXOR_,
+ FFEEXPR_operatorEQV_,
+ FFEEXPR_operatorNEQV_,
+ FFEEXPR_operator_
+ } ffeexprOperator_;
+
+typedef enum
+ {
+ FFEEXPR_operatorprecedenceHIGHEST_ = 1,
+ FFEEXPR_operatorprecedencePOWER_ = 1,
+ FFEEXPR_operatorprecedenceMULTIPLY_ = 2,
+ FFEEXPR_operatorprecedenceDIVIDE_ = 2,
+ FFEEXPR_operatorprecedenceADD_ = 3,
+ FFEEXPR_operatorprecedenceSUBTRACT_ = 3,
+ FFEEXPR_operatorprecedenceLOWARITH_ = 3,
+ FFEEXPR_operatorprecedenceCONCATENATE_ = 3,
+ FFEEXPR_operatorprecedenceLT_ = 4,
+ FFEEXPR_operatorprecedenceLE_ = 4,
+ FFEEXPR_operatorprecedenceEQ_ = 4,
+ FFEEXPR_operatorprecedenceNE_ = 4,
+ FFEEXPR_operatorprecedenceGT_ = 4,
+ FFEEXPR_operatorprecedenceGE_ = 4,
+ FFEEXPR_operatorprecedenceNOT_ = 5,
+ FFEEXPR_operatorprecedenceAND_ = 6,
+ FFEEXPR_operatorprecedenceOR_ = 7,
+ FFEEXPR_operatorprecedenceXOR_ = 8,
+ FFEEXPR_operatorprecedenceEQV_ = 8,
+ FFEEXPR_operatorprecedenceNEQV_ = 8,
+ FFEEXPR_operatorprecedenceLOWEST_ = 8,
+ FFEEXPR_operatorprecedence_
+ } ffeexprOperatorPrecedence_;
+
+#define FFEEXPR_operatorassociativityL2R_ TRUE
+#define FFEEXPR_operatorassociativityR2L_ FALSE
+#define FFEEXPR_operatorassociativityPOWER_ FFEEXPR_operatorassociativityR2L_
+#define FFEEXPR_operatorassociativityMULTIPLY_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityDIVIDE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityADD_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativitySUBTRACT_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityCONCATENATE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityLT_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityLE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityEQ_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityNE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityGT_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityGE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityNOT_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityAND_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityOR_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityXOR_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityEQV_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityNEQV_ FFEEXPR_operatorassociativityL2R_
+
+typedef enum
+ {
+ FFEEXPR_parentypeFUNCTION_,
+ FFEEXPR_parentypeSUBROUTINE_,
+ FFEEXPR_parentypeARRAY_,
+ FFEEXPR_parentypeSUBSTRING_,
+ FFEEXPR_parentypeFUNSUBSTR_,/* Ambig: check for colon after first expr. */
+ FFEEXPR_parentypeEQUIVALENCE_, /* Ambig: ARRAY_ or SUBSTRING_. */
+ FFEEXPR_parentypeANY_, /* Allow basically anything. */
+ FFEEXPR_parentype_
+ } ffeexprParenType_;
+
+typedef enum
+ {
+ FFEEXPR_percentNONE_,
+ FFEEXPR_percentLOC_,
+ FFEEXPR_percentVAL_,
+ FFEEXPR_percentREF_,
+ FFEEXPR_percentDESCR_,
+ FFEEXPR_percent_
+ } ffeexprPercent_;
+
+/* Internal typedefs. */
+
+typedef struct _ffeexpr_expr_ *ffeexprExpr_;
+typedef bool ffeexprOperatorAssociativity_;
+typedef struct _ffeexpr_stack_ *ffeexprStack_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffeexpr_expr_
+ {
+ ffeexprExpr_ previous;
+ ffelexToken token;
+ ffeexprExprtype_ type;
+ union
+ {
+ struct
+ {
+ ffeexprOperator_ op;
+ ffeexprOperatorPrecedence_ prec;
+ ffeexprOperatorAssociativity_ as;
+ }
+ operator;
+ ffebld operand;
+ }
+ u;
+ };
+
+struct _ffeexpr_stack_
+ {
+ ffeexprStack_ previous;
+ mallocPool pool;
+ ffeexprContext context;
+ ffeexprCallback callback;
+ ffelexToken first_token;
+ ffeexprExpr_ exprstack;
+ ffelexToken tokens[10]; /* Used in certain cases, like (unary)
+ open-paren. */
+ ffebld expr; /* For first of
+ complex/implied-do/substring/array-elements
+ / actual-args expression. */
+ ffebld bound_list; /* For tracking dimension bounds list of
+ array. */
+ ffebldListBottom bottom; /* For building lists. */
+ ffeinfoRank rank; /* For elements in an array reference. */
+ bool constant; /* TRUE while elements seen so far are
+ constants. */
+ bool immediate; /* TRUE while elements seen so far are
+ immediate/constants. */
+ ffebld next_dummy; /* Next SFUNC dummy arg in arg list. */
+ ffebldListLength num_args; /* Number of dummy args expected in arg list. */
+ bool is_rhs; /* TRUE if rhs context, FALSE otherwise. */
+ ffeexprPercent_ percent; /* Current %FOO keyword. */
+ };
+
+struct _ffeexpr_find_
+ {
+ ffelexToken t;
+ ffelexHandler after;
+ int level;
+ };
+
+/* Static objects accessed by functions in this module. */
+
+static ffeexprStack_ ffeexpr_stack_; /* Expression stack for semantic. */
+static ffelexToken ffeexpr_tokens_[10]; /* Scratchpad tokens for syntactic. */
+static ffeexprDotdot_ ffeexpr_current_dotdot_; /* Current .FOO. keyword. */
+static long ffeexpr_hollerith_count_; /* ffeexpr_token_number_ and caller. */
+static int ffeexpr_level_; /* Level of DATA implied-DO construct. */
+static bool ffeexpr_is_substr_ok_; /* If OPEN_PAREN as binary "op" ok. */
+static struct _ffeexpr_find_ ffeexpr_find_;
+
+/* Static functions (internal). */
+
+static ffelexHandler ffeexpr_cb_close_paren_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_close_paren_ambig_ (ffelexToken ft,
+ ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_close_paren_ambig_1_ (ffelexToken t);
+static ffelexHandler ffeexpr_cb_close_paren_c_ (ffelexToken ft,
+ ffebld expr, ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_c_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_close_paren_ci_ (ffelexToken ft,
+ ffebld expr, ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_ci_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_3_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_5_ (ffelexToken t);
+static ffelexHandler ffeexpr_cb_end_loc_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_end_notloc_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_cb_end_notloc_1_ (ffelexToken t);
+static ffesymbol ffeexpr_check_impctrl_ (ffesymbol s);
+static void ffeexpr_check_impdo_ (ffebld list, ffelexToken list_t,
+ ffebld dovar, ffelexToken dovar_t);
+static void ffeexpr_update_impdo_ (ffebld expr, ffebld dovar);
+static void ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar);
+static ffeexprContext ffeexpr_context_outer_ (ffeexprStack_ s);
+static ffeexprDotdot_ ffeexpr_dotdot_ (ffelexToken t);
+static ffeexprExpr_ ffeexpr_expr_new_ (void);
+static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t);
+static bool ffeexpr_isdigits_ (char *p);
+static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_lhs_1_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_1_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_2_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_3_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_4_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_5_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_6_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_namelist_ (ffelexToken t);
+static void ffeexpr_expr_kill_ (ffeexprExpr_ e);
+static void ffeexpr_exprstack_push_ (ffeexprExpr_ e);
+static void ffeexpr_exprstack_push_binary_ (ffeexprExpr_ e);
+static void ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e);
+static void ffeexpr_exprstack_push_unary_ (ffeexprExpr_ e);
+static void ffeexpr_reduce_ (void);
+static ffebld ffeexpr_reduced_bool1_ (ffebld reduced, ffeexprExpr_ op,
+ ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_bool2_ (ffebld reduced, ffeexprExpr_ l,
+ ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l,
+ ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_eqop2_ (ffebld reduced, ffeexprExpr_ l,
+ ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_math1_ (ffebld reduced, ffeexprExpr_ op,
+ ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_math2_ (ffebld reduced, ffeexprExpr_ l,
+ ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_power_ (ffebld reduced, ffeexprExpr_ l,
+ ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_relop2_ (ffebld reduced, ffeexprExpr_ l,
+ ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_ugly1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_ugly1log_ (ffebld reduced, ffeexprExpr_ op,
+ ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l,
+ ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l,
+ ffeexprExpr_ op, ffeexprExpr_ r);
+static ffelexHandler ffeexpr_find_close_paren_ (ffelexToken t,
+ ffelexHandler after);
+static ffelexHandler ffeexpr_nil_finished_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_end_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_swallow_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_real_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_real_exponent_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_real_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_exponent_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_per_exp_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_real_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_num_per_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_real_exp_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_num_real_exp_sn_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_binary_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_binary_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_binary_end_per_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_binary_sw_per_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_quote_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_apostrophe_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_apos_char_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_name_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_name_apos_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_name_apos_name_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_percent_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_percent_name_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_substrp_ (ffelexToken t);
+static ffelexHandler ffeexpr_finished_ (ffelexToken t);
+static ffebld ffeexpr_finished_ambig_ (ffelexToken t, ffebld expr);
+static ffelexHandler ffeexpr_token_lhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_binary_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_end_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_swallow_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_real_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_real_exponent_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_real_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_exponent_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_per_exp_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_real_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_num_per_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_real_exp_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_num_real_exp_sn_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_binary_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_binary_end_per_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_binary_sw_per_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_quote_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_apostrophe_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_apos_char_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_lhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_arg_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_apos_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_apos_name_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_percent_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_percent_name_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_arguments_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_token_elements_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_token_equivalence_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_token_substring_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_token_substring_1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_token_substrp_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_intrincheck_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_funsubstr_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffeexpr_token_anything_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static void ffeexpr_make_float_const_ (char exp_letter, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+ ffelexToken exponent_sign, ffelexToken exponent_digits);
+static ffesymbol ffeexpr_declare_unadorned_ (ffelexToken t, bool maybe_intrin);
+static ffesymbol ffeexpr_sym_impdoitem_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_call_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_data_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_equivalence_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_extfunc_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_impdoctrl_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_parameter_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_rhs_actualarg_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_rhs_dimlist_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_rhs_let_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_declare_parenthesized_ (ffelexToken t,
+ bool maybe_intrin,
+ ffeexprParenType_ *paren_type);
+static ffesymbol ffeexpr_paren_rhs_let_ (ffesymbol s, ffelexToken t);
+
+/* Internal macros. */
+
+#define ffeexpr_paren_lhs_let_(s,t) ffeexpr_sym_rhs_let_(s,t)
+#define ffeexpr_sym_lhs_let_(s,t) ffeexpr_sym_rhs_let_(s,t)
+
+/* ffeexpr_collapse_convert -- Collapse convert expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_convert(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_convert (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize sz;
+ ffetargetCharacterSize sz2;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ sz = FFETARGET_charactersizeNONE;
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_integer1_integer2
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_integer1_integer3
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_integer1_integer4
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER1/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_integer1_real1
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_integer1_real2
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_integer1_real3
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_integer1_real4
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER1/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_integer1_complex1
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_integer1_complex2
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_integer1_complex3
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_integer1_complex4
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER1/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_convert_integer1_logical1
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_convert_integer1_logical2
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_convert_integer1_logical3
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_convert_integer1_logical4
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER1/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_integer1_character1
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_integer1_hollerith
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_integer1_typeless
+ (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("INTEGER1 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_integer2_integer1
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_integer2_integer3
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_integer2_integer4
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER2/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_integer2_real1
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_integer2_real2
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_integer2_real3
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_integer2_real4
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER2/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_integer2_complex1
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_integer2_complex2
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_integer2_complex3
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_integer2_complex4
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER2/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_convert_integer2_logical1
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_convert_integer2_logical2
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_convert_integer2_logical3
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_convert_integer2_logical4
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER2/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_integer2_character1
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_integer2_hollerith
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_integer2_typeless
+ (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("INTEGER2 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_integer3_integer1
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_integer3_integer2
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_integer3_integer4
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER3/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_integer3_real1
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_integer3_real2
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_integer3_real3
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_integer3_real4
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER3/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_integer3_complex1
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_integer3_complex2
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_integer3_complex3
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_integer3_complex4
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_convert_integer3_logical1
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_convert_integer3_logical2
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_convert_integer3_logical3
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_convert_integer3_logical4
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER3/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_integer3_character1
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_integer3_hollerith
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_integer3_typeless
+ (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("INTEGER3 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_integer4_integer1
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_integer4_integer2
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_integer4_integer3
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER4/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_integer4_real1
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_integer4_real2
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_integer4_real3
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_integer4_real4
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER4/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_integer4_complex1
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_integer4_complex2
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_integer4_complex3
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_integer4_complex4
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_convert_integer4_logical1
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_convert_integer4_logical2
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_convert_integer4_logical3
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_convert_integer4_logical4
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("INTEGER4/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_integer4_character1
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_integer4_hollerith
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_integer4_typeless
+ (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("INTEGER4 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ sz = FFETARGET_charactersizeNONE;
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_convert_logical1_logical2
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_convert_logical1_logical3
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_convert_logical1_logical4
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("LOGICAL1/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_logical1_integer1
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_logical1_integer2
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_logical1_integer3
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_logical1_integer4
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("LOGICAL1/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_logical1_character1
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_logical1_hollerith
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_logical1_typeless
+ (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("LOGICAL1 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logical1_val
+ (ffebld_cu_val_logical1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_convert_logical2_logical1
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_convert_logical2_logical3
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_convert_logical2_logical4
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("LOGICAL2/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_logical2_integer1
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_logical2_integer2
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_logical2_integer3
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_logical2_integer4
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("LOGICAL2/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_logical2_character1
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_logical2_hollerith
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_logical2_typeless
+ (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("LOGICAL2 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logical2_val
+ (ffebld_cu_val_logical2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_convert_logical3_logical1
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_convert_logical3_logical2
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_convert_logical3_logical4
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("LOGICAL3/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_logical3_integer1
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_logical3_integer2
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_logical3_integer3
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_logical3_integer4
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("LOGICAL3/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_logical3_character1
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_logical3_hollerith
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_logical3_typeless
+ (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("LOGICAL3 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logical3_val
+ (ffebld_cu_val_logical3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_convert_logical4_logical1
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_convert_logical4_logical2
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_convert_logical4_logical3
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("LOGICAL4/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_logical4_integer1
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_logical4_integer2
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_logical4_integer3
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_logical4_integer4
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("LOGICAL4/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_logical4_character1
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_logical4_hollerith
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_logical4_typeless
+ (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("LOGICAL4 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logical4_val
+ (ffebld_cu_val_logical4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad logical kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ sz = FFETARGET_charactersizeNONE;
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_real1_integer1
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_real1_integer2
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_real1_integer3
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_real1_integer4
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL1/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_real1_real2
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_real1_real3
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_real1_real4
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL1/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_real1_complex1
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_real1_complex2
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_real1_complex3
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_real1_complex4
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL1/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_real1_character1
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_real1_hollerith
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_real1_typeless
+ (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("REAL1 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_real1_val
+ (ffebld_cu_val_real1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_real2_integer1
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_real2_integer2
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_real2_integer3
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_real2_integer4
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL2/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_real2_real1
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_real2_real3
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_real2_real4
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL2/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_real2_complex1
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_real2_complex2
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_real2_complex3
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_real2_complex4
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL2/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_real2_character1
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_real2_hollerith
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_real2_typeless
+ (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("REAL2 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_real2_val
+ (ffebld_cu_val_real2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_real3_integer1
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_real3_integer2
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_real3_integer3
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_real3_integer4
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL3/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_real3_real1
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_real3_real2
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_real3_real4
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL3/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_real3_complex1
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_real3_complex2
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_real3_complex3
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_real3_complex4
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL3/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_real3_character1
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_real3_hollerith
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_real3_typeless
+ (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("REAL3 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_real3_val
+ (ffebld_cu_val_real3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_real4_integer1
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_real4_integer2
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_real4_integer3
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_real4_integer4
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL4/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_real4_real1
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_real4_real2
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_real4_real3
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL4/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_real4_complex1
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_real4_complex2
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_real4_complex3
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_real4_complex4
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("REAL4/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_real4_character1
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_real4_hollerith
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_real4_typeless
+ (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("REAL4 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_real4_val
+ (ffebld_cu_val_real4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ sz = FFETARGET_charactersizeNONE;
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_complex1_integer1
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_complex1_integer2
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_complex1_integer3
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_complex1_integer4
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX1/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_complex1_real1
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_complex1_real2
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_complex1_real3
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_complex1_real4
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX1/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_complex1_complex2
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_complex1_complex3
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_complex1_complex4
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX1/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_complex1_character1
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_complex1_hollerith
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_complex1_typeless
+ (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("COMPLEX1 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_complex1_val
+ (ffebld_cu_val_complex1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_complex2_integer1
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_complex2_integer2
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_complex2_integer3
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_complex2_integer4
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX2/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_complex2_real1
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_complex2_real2
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_complex2_real3
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_complex2_real4
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX2/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_complex2_complex1
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_complex2_complex3
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_complex2_complex4
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX2/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_complex2_character1
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_complex2_hollerith
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_complex2_typeless
+ (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("COMPLEX2 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_complex2_val
+ (ffebld_cu_val_complex2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_complex3_integer1
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_complex3_integer2
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_complex3_integer3
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_complex3_integer4
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX3/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_complex3_real1
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_complex3_real2
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_complex3_real3
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_complex3_real4
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX3/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_complex3_complex1
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_complex3_complex2
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_complex3_complex4
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX3/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_complex3_character1
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_complex3_hollerith
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_complex3_typeless
+ (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("COMPLEX3 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_complex3_val
+ (ffebld_cu_val_complex3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_convert_complex4_integer1
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_convert_complex4_integer2
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_convert_complex4_integer3
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_convert_complex4_integer4
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX4/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_complex4_real1
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_real1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_complex4_real2
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_real2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_complex4_real3
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_real3 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_convert_complex4_real4
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_real4 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX4/REAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_convert_complex4_complex1
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_convert_complex4_complex2
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_convert_complex4_complex3
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)));
+ break;
+#endif
+
+ default:
+ assert ("COMPLEX4/COMPLEX bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = ffetarget_convert_complex4_character1
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_character1 (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error = ffetarget_convert_complex4_hollerith
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_hollerith (ffebld_conter (l)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error = ffetarget_convert_complex4_typeless
+ (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_typeless (ffebld_conter (l)));
+ break;
+
+ default:
+ assert ("COMPLEX4 bad type" == NULL);
+ break;
+ }
+
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_complex4_val
+ (ffebld_cu_val_complex4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ if ((sz = ffebld_size (expr)) == FFETARGET_charactersizeNONE)
+ return expr;
+ kt = ffeinfo_kindtype (ffebld_info (expr));
+ switch (kt)
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ switch (ffeinfo_basictype (ffebld_info (l)))
+ {
+ case FFEINFO_basictypeCHARACTER:
+ if ((sz2 = ffebld_size (l)) == FFETARGET_charactersizeNONE)
+ return expr;
+ assert (kt == ffeinfo_kindtype (ffebld_info (l)));
+ assert (sz2 == ffetarget_length_character1
+ (ffebld_constant_character1
+ (ffebld_conter (l))));
+ error
+ = ffetarget_convert_character1_character1
+ (ffebld_cu_ptr_character1 (u), sz,
+ ffebld_constant_character1 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error
+ = ffetarget_convert_character1_integer1
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error
+ = ffetarget_convert_character1_integer2
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error
+ = ffetarget_convert_character1_integer3
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error
+ = ffetarget_convert_character1_integer4
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+#endif
+
+ default:
+ assert ("CHARACTER1/INTEGER bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (ffeinfo_kindtype (ffebld_info (l)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error
+ = ffetarget_convert_character1_logical1
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_logical1 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error
+ = ffetarget_convert_character1_logical2
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_logical2 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error
+ = ffetarget_convert_character1_logical3
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_logical3 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error
+ = ffetarget_convert_character1_logical4
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_logical4 (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+#endif
+
+ default:
+ assert ("CHARACTER1/LOGICAL bad source kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ error
+ = ffetarget_convert_character1_hollerith
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_hollerith (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ error
+ = ffetarget_convert_character1_typeless
+ (ffebld_cu_ptr_character1 (u),
+ sz,
+ ffebld_constant_typeless (ffebld_conter (l)),
+ ffebld_constant_pool ());
+ break;
+
+ default:
+ assert ("CHARACTER1 bad type" == NULL);
+ }
+
+ expr
+ = ffebld_new_conter_with_orig
+ (ffebld_constant_new_character1_val
+ (ffebld_cu_val_character1 (u)),
+ expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ sz));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ assert (t != NULL);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_paren -- Collapse paren expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_paren(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_paren (ffebld expr, ffelexToken t UNUSED)
+{
+ ffebld r;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize len;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ r = ffebld_left (expr);
+
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ bt = ffeinfo_basictype (ffebld_info (r));
+ kt = ffeinfo_kindtype (ffebld_info (r));
+ len = ffebld_size (r);
+
+ expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
+ expr);
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ len));
+
+ return expr;
+}
+
+/* ffeexpr_collapse_uplus -- Collapse uplus expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_uplus(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_uplus (ffebld expr, ffelexToken t UNUSED)
+{
+ ffebld r;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize len;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ r = ffebld_left (expr);
+
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ bt = ffeinfo_basictype (ffebld_info (r));
+ kt = ffeinfo_kindtype (ffebld_info (r));
+ len = ffebld_size (r);
+
+ expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
+ expr);
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ len));
+
+ return expr;
+}
+
+/* ffeexpr_collapse_uminus -- Collapse uminus expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_uminus(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_uminus (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ r = ffebld_left (expr);
+
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_uminus_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_uminus_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_uminus_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_uminus_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_uminus_real1 (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+ (ffebld_cu_val_real1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_uminus_real2 (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+ (ffebld_cu_val_real2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_uminus_real3 (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+ (ffebld_cu_val_real3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_uminus_real4 (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+ (ffebld_cu_val_real4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_uminus_complex1 (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_complex1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+ (ffebld_cu_val_complex1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_uminus_complex2 (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_complex2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+ (ffebld_cu_val_complex2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_uminus_complex3 (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_complex3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+ (ffebld_cu_val_complex3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_uminus_complex4 (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_complex4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+ (ffebld_cu_val_complex4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_not -- Collapse not expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_not(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_not (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ r = ffebld_left (expr);
+
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_not_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_not_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_not_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_not_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_not_logical1 (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+ (ffebld_cu_val_logical1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_not_logical2 (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+ (ffebld_cu_val_logical2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_not_logical3 (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+ (ffebld_cu_val_logical3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_not_logical4 (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+ (ffebld_cu_val_logical4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad logical kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_add -- Collapse add expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_add(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_add (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_add_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_add_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_add_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_add_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_add_real1 (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+ (ffebld_cu_val_real1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_add_real2 (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+ (ffebld_cu_val_real2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_add_real3 (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+ (ffebld_cu_val_real3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_add_real4 (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+ (ffebld_cu_val_real4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_add_complex1 (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)),
+ ffebld_constant_complex1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+ (ffebld_cu_val_complex1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_add_complex2 (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)),
+ ffebld_constant_complex2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+ (ffebld_cu_val_complex2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_add_complex3 (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)),
+ ffebld_constant_complex3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+ (ffebld_cu_val_complex3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_add_complex4 (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)),
+ ffebld_constant_complex4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+ (ffebld_cu_val_complex4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_subtract -- Collapse subtract expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_subtract(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_subtract (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_subtract_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_subtract_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_subtract_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_subtract_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_subtract_real1 (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+ (ffebld_cu_val_real1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_subtract_real2 (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+ (ffebld_cu_val_real2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_subtract_real3 (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+ (ffebld_cu_val_real3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_subtract_real4 (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+ (ffebld_cu_val_real4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_subtract_complex1 (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)),
+ ffebld_constant_complex1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+ (ffebld_cu_val_complex1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_subtract_complex2 (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)),
+ ffebld_constant_complex2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+ (ffebld_cu_val_complex2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_subtract_complex3 (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)),
+ ffebld_constant_complex3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+ (ffebld_cu_val_complex3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_subtract_complex4 (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)),
+ ffebld_constant_complex4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+ (ffebld_cu_val_complex4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_multiply -- Collapse multiply expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_multiply(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_multiply (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_multiply_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_multiply_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_multiply_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_multiply_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_multiply_real1 (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+ (ffebld_cu_val_real1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_multiply_real2 (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+ (ffebld_cu_val_real2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_multiply_real3 (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+ (ffebld_cu_val_real3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_multiply_real4 (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+ (ffebld_cu_val_real4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_multiply_complex1 (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)),
+ ffebld_constant_complex1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+ (ffebld_cu_val_complex1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_multiply_complex2 (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)),
+ ffebld_constant_complex2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+ (ffebld_cu_val_complex2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_multiply_complex3 (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)),
+ ffebld_constant_complex3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+ (ffebld_cu_val_complex3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_multiply_complex4 (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)),
+ ffebld_constant_complex4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+ (ffebld_cu_val_complex4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_divide -- Collapse divide expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_divide(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_divide (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_divide_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_divide_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_divide_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_divide_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_divide_real1 (ffebld_cu_ptr_real1 (u),
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+ (ffebld_cu_val_real1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_divide_real2 (ffebld_cu_ptr_real2 (u),
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+ (ffebld_cu_val_real2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_divide_real3 (ffebld_cu_ptr_real3 (u),
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+ (ffebld_cu_val_real3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_divide_real4 (ffebld_cu_ptr_real4 (u),
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_real4_val
+ (ffebld_cu_val_real4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_divide_complex1 (ffebld_cu_ptr_complex1 (u),
+ ffebld_constant_complex1 (ffebld_conter (l)),
+ ffebld_constant_complex1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+ (ffebld_cu_val_complex1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_divide_complex2 (ffebld_cu_ptr_complex2 (u),
+ ffebld_constant_complex2 (ffebld_conter (l)),
+ ffebld_constant_complex2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+ (ffebld_cu_val_complex2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_divide_complex3 (ffebld_cu_ptr_complex3 (u),
+ ffebld_constant_complex3 (ffebld_conter (l)),
+ ffebld_constant_complex3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+ (ffebld_cu_val_complex3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_divide_complex4 (ffebld_cu_ptr_complex4 (u),
+ ffebld_constant_complex4 (ffebld_conter (l)),
+ ffebld_constant_complex4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex4_val
+ (ffebld_cu_val_complex4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_power -- Collapse power expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_power(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_power (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ if ((ffeinfo_basictype (ffebld_info (r)) != FFEINFO_basictypeINTEGER)
+ || (ffeinfo_kindtype (ffebld_info (r)) != FFEINFO_kindtypeINTEGERDEFAULT))
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+ case FFEINFO_kindtypeINTEGERDEFAULT:
+ error = ffetarget_power_integerdefault_integerdefault
+ (ffebld_cu_ptr_integerdefault (u),
+ ffebld_constant_integerdefault (ffebld_conter (l)),
+ ffebld_constant_integerdefault (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_integerdefault_val
+ (ffebld_cu_val_integerdefault (u)), expr);
+ break;
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+ case FFEINFO_kindtypeREALDEFAULT:
+ error = ffetarget_power_realdefault_integerdefault
+ (ffebld_cu_ptr_realdefault (u),
+ ffebld_constant_realdefault (ffebld_conter (l)),
+ ffebld_constant_integerdefault (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_realdefault_val
+ (ffebld_cu_val_realdefault (u)), expr);
+ break;
+
+ case FFEINFO_kindtypeREALDOUBLE:
+ error = ffetarget_power_realdouble_integerdefault
+ (ffebld_cu_ptr_realdouble (u),
+ ffebld_constant_realdouble (ffebld_conter (l)),
+ ffebld_constant_integerdefault (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_realdouble_val
+ (ffebld_cu_val_realdouble (u)), expr);
+ break;
+
+#if FFETARGET_okREALQUAD
+ case FFEINFO_kindtypeREALQUAD:
+ error = ffetarget_power_realquad_integerdefault
+ (ffebld_cu_ptr_realquad (u),
+ ffebld_constant_realquad (ffebld_conter (l)),
+ ffebld_constant_integerdefault (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_realquad_val
+ (ffebld_cu_val_realquad (u)), expr);
+ break;
+#endif
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+ case FFEINFO_kindtypeREALDEFAULT:
+ error = ffetarget_power_complexdefault_integerdefault
+ (ffebld_cu_ptr_complexdefault (u),
+ ffebld_constant_complexdefault (ffebld_conter (l)),
+ ffebld_constant_integerdefault (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_complexdefault_val
+ (ffebld_cu_val_complexdefault (u)), expr);
+ break;
+
+#if FFETARGET_okCOMPLEXDOUBLE
+ case FFEINFO_kindtypeREALDOUBLE:
+ error = ffetarget_power_complexdouble_integerdefault
+ (ffebld_cu_ptr_complexdouble (u),
+ ffebld_constant_complexdouble (ffebld_conter (l)),
+ ffebld_constant_integerdefault (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_complexdouble_val
+ (ffebld_cu_val_complexdouble (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEXQUAD
+ case FFEINFO_kindtypeREALQUAD:
+ error = ffetarget_power_complexquad_integerdefault
+ (ffebld_cu_ptr_complexquad (u),
+ ffebld_constant_complexquad (ffebld_conter (l)),
+ ffebld_constant_integerdefault (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_complexquad_val
+ (ffebld_cu_val_complexquad (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_concatenate -- Collapse concatenate expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_concatenate(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize len;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ error = ffetarget_concatenate_character1 (ffebld_cu_ptr_character1 (u),
+ ffebld_constant_character1 (ffebld_conter (l)),
+ ffebld_constant_character1 (ffebld_conter (r)),
+ ffebld_constant_pool (), &len);
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val
+ (ffebld_cu_val_character1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ error = ffetarget_concatenate_character2 (ffebld_cu_ptr_character2 (u),
+ ffebld_constant_character2 (ffebld_conter (l)),
+ ffebld_constant_character2 (ffebld_conter (r)),
+ ffebld_constant_pool (), &len);
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val
+ (ffebld_cu_val_character2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ error = ffetarget_concatenate_character3 (ffebld_cu_ptr_character3 (u),
+ ffebld_constant_character3 (ffebld_conter (l)),
+ ffebld_constant_character3 (ffebld_conter (r)),
+ ffebld_constant_pool (), &len);
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val
+ (ffebld_cu_val_character3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ error = ffetarget_concatenate_character4 (ffebld_cu_ptr_character4 (u),
+ ffebld_constant_character4 (ffebld_conter (l)),
+ ffebld_constant_character4 (ffebld_conter (r)),
+ ffebld_constant_pool (), &len);
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val
+ (ffebld_cu_val_character4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeCHARACTER,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ len));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_eq -- Collapse eq expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_eq(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_eq (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ bool val;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_eq_integer1 (&val,
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_eq_integer2 (&val,
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_eq_integer3 (&val,
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_eq_integer4 (&val,
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_eq_real1 (&val,
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_eq_real2 (&val,
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_eq_real3 (&val,
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_eq_real4 (&val,
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_eq_complex1 (&val,
+ ffebld_constant_complex1 (ffebld_conter (l)),
+ ffebld_constant_complex1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_eq_complex2 (&val,
+ ffebld_constant_complex2 (ffebld_conter (l)),
+ ffebld_constant_complex2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_eq_complex3 (&val,
+ ffebld_constant_complex3 (ffebld_conter (l)),
+ ffebld_constant_complex3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_eq_complex4 (&val,
+ ffebld_constant_complex4 (ffebld_conter (l)),
+ ffebld_constant_complex4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ error = ffetarget_eq_character1 (&val,
+ ffebld_constant_character1 (ffebld_conter (l)),
+ ffebld_constant_character1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ error = ffetarget_eq_character2 (&val,
+ ffebld_constant_character2 (ffebld_conter (l)),
+ ffebld_constant_character2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ error = ffetarget_eq_character3 (&val,
+ ffebld_constant_character3 (ffebld_conter (l)),
+ ffebld_constant_character3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ error = ffetarget_eq_character4 (&val,
+ ffebld_constant_character4 (ffebld_conter (l)),
+ ffebld_constant_character4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_ne -- Collapse ne expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_ne(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_ne (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ bool val;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_ne_integer1 (&val,
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_ne_integer2 (&val,
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_ne_integer3 (&val,
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_ne_integer4 (&val,
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_ne_real1 (&val,
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_ne_real2 (&val,
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_ne_real3 (&val,
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_ne_real4 (&val,
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCOMPLEX:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_ne_complex1 (&val,
+ ffebld_constant_complex1 (ffebld_conter (l)),
+ ffebld_constant_complex1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_ne_complex2 (&val,
+ ffebld_constant_complex2 (ffebld_conter (l)),
+ ffebld_constant_complex2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_ne_complex3 (&val,
+ ffebld_constant_complex3 (ffebld_conter (l)),
+ ffebld_constant_complex3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_ne_complex4 (&val,
+ ffebld_constant_complex4 (ffebld_conter (l)),
+ ffebld_constant_complex4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad complex kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ error = ffetarget_ne_character1 (&val,
+ ffebld_constant_character1 (ffebld_conter (l)),
+ ffebld_constant_character1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ error = ffetarget_ne_character2 (&val,
+ ffebld_constant_character2 (ffebld_conter (l)),
+ ffebld_constant_character2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ error = ffetarget_ne_character3 (&val,
+ ffebld_constant_character3 (ffebld_conter (l)),
+ ffebld_constant_character3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ error = ffetarget_ne_character4 (&val,
+ ffebld_constant_character4 (ffebld_conter (l)),
+ ffebld_constant_character4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_ge -- Collapse ge expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_ge(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_ge (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ bool val;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_ge_integer1 (&val,
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_ge_integer2 (&val,
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_ge_integer3 (&val,
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_ge_integer4 (&val,
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_ge_real1 (&val,
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_ge_real2 (&val,
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_ge_real3 (&val,
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_ge_real4 (&val,
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ error = ffetarget_ge_character1 (&val,
+ ffebld_constant_character1 (ffebld_conter (l)),
+ ffebld_constant_character1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ error = ffetarget_ge_character2 (&val,
+ ffebld_constant_character2 (ffebld_conter (l)),
+ ffebld_constant_character2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ error = ffetarget_ge_character3 (&val,
+ ffebld_constant_character3 (ffebld_conter (l)),
+ ffebld_constant_character3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ error = ffetarget_ge_character4 (&val,
+ ffebld_constant_character4 (ffebld_conter (l)),
+ ffebld_constant_character4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_gt -- Collapse gt expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_gt(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_gt (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ bool val;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_gt_integer1 (&val,
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_gt_integer2 (&val,
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_gt_integer3 (&val,
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_gt_integer4 (&val,
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_gt_real1 (&val,
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_gt_real2 (&val,
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_gt_real3 (&val,
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_gt_real4 (&val,
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ error = ffetarget_gt_character1 (&val,
+ ffebld_constant_character1 (ffebld_conter (l)),
+ ffebld_constant_character1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ error = ffetarget_gt_character2 (&val,
+ ffebld_constant_character2 (ffebld_conter (l)),
+ ffebld_constant_character2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ error = ffetarget_gt_character3 (&val,
+ ffebld_constant_character3 (ffebld_conter (l)),
+ ffebld_constant_character3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ error = ffetarget_gt_character4 (&val,
+ ffebld_constant_character4 (ffebld_conter (l)),
+ ffebld_constant_character4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_le -- Collapse le expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_le(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_le (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ bool val;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_le_integer1 (&val,
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_le_integer2 (&val,
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_le_integer3 (&val,
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_le_integer4 (&val,
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_le_real1 (&val,
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_le_real2 (&val,
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_le_real3 (&val,
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_le_real4 (&val,
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ error = ffetarget_le_character1 (&val,
+ ffebld_constant_character1 (ffebld_conter (l)),
+ ffebld_constant_character1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ error = ffetarget_le_character2 (&val,
+ ffebld_constant_character2 (ffebld_conter (l)),
+ ffebld_constant_character2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ error = ffetarget_le_character3 (&val,
+ ffebld_constant_character3 (ffebld_conter (l)),
+ ffebld_constant_character3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ error = ffetarget_le_character4 (&val,
+ ffebld_constant_character4 (ffebld_conter (l)),
+ ffebld_constant_character4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_lt -- Collapse lt expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_lt(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_lt (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ bool val;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_lt_integer1 (&val,
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_lt_integer2 (&val,
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_lt_integer3 (&val,
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_lt_integer4 (&val,
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okREAL1
+ case FFEINFO_kindtypeREAL1:
+ error = ffetarget_lt_real1 (&val,
+ ffebld_constant_real1 (ffebld_conter (l)),
+ ffebld_constant_real1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL2
+ case FFEINFO_kindtypeREAL2:
+ error = ffetarget_lt_real2 (&val,
+ ffebld_constant_real2 (ffebld_conter (l)),
+ ffebld_constant_real2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL3
+ case FFEINFO_kindtypeREAL3:
+ error = ffetarget_lt_real3 (&val,
+ ffebld_constant_real3 (ffebld_conter (l)),
+ ffebld_constant_real3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okREAL4
+ case FFEINFO_kindtypeREAL4:
+ error = ffetarget_lt_real4 (&val,
+ ffebld_constant_real4 (ffebld_conter (l)),
+ ffebld_constant_real4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad real kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ error = ffetarget_lt_character1 (&val,
+ ffebld_constant_character1 (ffebld_conter (l)),
+ ffebld_constant_character1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ error = ffetarget_lt_character2 (&val,
+ ffebld_constant_character2 (ffebld_conter (l)),
+ ffebld_constant_character2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ error = ffetarget_lt_character3 (&val,
+ ffebld_constant_character3 (ffebld_conter (l)),
+ ffebld_constant_character3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ error = ffetarget_lt_character4 (&val,
+ ffebld_constant_character4 (ffebld_conter (l)),
+ ffebld_constant_character4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig
+ (ffebld_constant_new_logicaldefault (val), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_and -- Collapse and expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_and(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_and (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_and_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_and_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_and_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_and_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_and_logical1 (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)),
+ ffebld_constant_logical1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+ (ffebld_cu_val_logical1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_and_logical2 (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)),
+ ffebld_constant_logical2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+ (ffebld_cu_val_logical2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_and_logical3 (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)),
+ ffebld_constant_logical3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+ (ffebld_cu_val_logical3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_and_logical4 (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)),
+ ffebld_constant_logical4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+ (ffebld_cu_val_logical4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad logical kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_or -- Collapse or expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_or(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_or (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_or_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_or_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_or_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_or_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_or_logical1 (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)),
+ ffebld_constant_logical1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+ (ffebld_cu_val_logical1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_or_logical2 (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)),
+ ffebld_constant_logical2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+ (ffebld_cu_val_logical2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_or_logical3 (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)),
+ ffebld_constant_logical3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+ (ffebld_cu_val_logical3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_or_logical4 (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)),
+ ffebld_constant_logical4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+ (ffebld_cu_val_logical4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad logical kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_xor -- Collapse xor expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_xor(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_xor (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_xor_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_xor_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_xor_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_xor_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_xor_logical1 (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)),
+ ffebld_constant_logical1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+ (ffebld_cu_val_logical1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_xor_logical2 (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)),
+ ffebld_constant_logical2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+ (ffebld_cu_val_logical2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_xor_logical3 (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)),
+ ffebld_constant_logical3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+ (ffebld_cu_val_logical3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_xor_logical4 (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)),
+ ffebld_constant_logical4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+ (ffebld_cu_val_logical4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad logical kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_eqv -- Collapse eqv expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_eqv(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_eqv (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_eqv_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_eqv_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_eqv_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_eqv_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_eqv_logical1 (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)),
+ ffebld_constant_logical1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+ (ffebld_cu_val_logical1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_eqv_logical2 (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)),
+ ffebld_constant_logical2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+ (ffebld_cu_val_logical2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_eqv_logical3 (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)),
+ ffebld_constant_logical3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+ (ffebld_cu_val_logical3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_eqv_logical4 (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)),
+ ffebld_constant_logical4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+ (ffebld_cu_val_logical4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad logical kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_neqv -- Collapse neqv expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_neqv(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_neqv (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebldConstantUnion u;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr);
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+ if (ffebld_op (r) != FFEBLD_opCONTER)
+ return expr;
+
+ switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okINTEGER1
+ case FFEINFO_kindtypeINTEGER1:
+ error = ffetarget_neqv_integer1 (ffebld_cu_ptr_integer1 (u),
+ ffebld_constant_integer1 (ffebld_conter (l)),
+ ffebld_constant_integer1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+ (ffebld_cu_val_integer1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER2
+ case FFEINFO_kindtypeINTEGER2:
+ error = ffetarget_neqv_integer2 (ffebld_cu_ptr_integer2 (u),
+ ffebld_constant_integer2 (ffebld_conter (l)),
+ ffebld_constant_integer2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+ (ffebld_cu_val_integer2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER3
+ case FFEINFO_kindtypeINTEGER3:
+ error = ffetarget_neqv_integer3 (ffebld_cu_ptr_integer3 (u),
+ ffebld_constant_integer3 (ffebld_conter (l)),
+ ffebld_constant_integer3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+ (ffebld_cu_val_integer3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okINTEGER4
+ case FFEINFO_kindtypeINTEGER4:
+ error = ffetarget_neqv_integer4 (ffebld_cu_ptr_integer4 (u),
+ ffebld_constant_integer4 (ffebld_conter (l)),
+ ffebld_constant_integer4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+ (ffebld_cu_val_integer4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad integer kind type" == NULL);
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okLOGICAL1
+ case FFEINFO_kindtypeLOGICAL1:
+ error = ffetarget_neqv_logical1 (ffebld_cu_ptr_logical1 (u),
+ ffebld_constant_logical1 (ffebld_conter (l)),
+ ffebld_constant_logical1 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+ (ffebld_cu_val_logical1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+ case FFEINFO_kindtypeLOGICAL2:
+ error = ffetarget_neqv_logical2 (ffebld_cu_ptr_logical2 (u),
+ ffebld_constant_logical2 (ffebld_conter (l)),
+ ffebld_constant_logical2 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+ (ffebld_cu_val_logical2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+ case FFEINFO_kindtypeLOGICAL3:
+ error = ffetarget_neqv_logical3 (ffebld_cu_ptr_logical3 (u),
+ ffebld_constant_logical3 (ffebld_conter (l)),
+ ffebld_constant_logical3 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+ (ffebld_cu_val_logical3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+ case FFEINFO_kindtypeLOGICAL4:
+ error = ffetarget_neqv_logical4 (ffebld_cu_ptr_logical4 (u),
+ ffebld_constant_logical4 (ffebld_conter (l)),
+ ffebld_constant_logical4 (ffebld_conter (r)));
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+ (ffebld_cu_val_logical4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad logical kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_collapse_symter -- Collapse symter expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_symter(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_symter (ffebld expr, ffelexToken t UNUSED)
+{
+ ffebld r;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize len;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ if ((r = ffesymbol_init (ffebld_symter (expr))) == NULL)
+ return expr; /* A PARAMETER lhs in progress. */
+
+ switch (ffebld_op (r))
+ {
+ case FFEBLD_opCONTER:
+ break;
+
+ case FFEBLD_opANY:
+ return r;
+
+ default:
+ return expr;
+ }
+
+ bt = ffeinfo_basictype (ffebld_info (r));
+ kt = ffeinfo_kindtype (ffebld_info (r));
+ len = ffebld_size (r);
+
+ expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
+ expr);
+
+ ffebld_set_info (expr, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ len));
+
+ return expr;
+}
+
+/* ffeexpr_collapse_funcref -- Collapse funcref expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_funcref(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_funcref (ffebld expr, ffelexToken t UNUSED)
+{
+ return expr; /* ~~someday go ahead and collapse these,
+ though not required */
+}
+
+/* ffeexpr_collapse_arrayref -- Collapse arrayref expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_arrayref(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t UNUSED)
+{
+ return expr;
+}
+
+/* ffeexpr_collapse_substr -- Collapse substr expr
+
+ ffebld expr;
+ ffelexToken token;
+ expr = ffeexpr_collapse_substr(expr,token);
+
+ If the result of the expr is a constant, replaces the expr with the
+ computed constant. */
+
+ffebld
+ffeexpr_collapse_substr (ffebld expr, ffelexToken t)
+{
+ ffebad error = FFEBAD;
+ ffebld l;
+ ffebld r;
+ ffebld start;
+ ffebld stop;
+ ffebldConstantUnion u;
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize len;
+ ffetargetIntegerDefault first;
+ ffetargetIntegerDefault last;
+
+ if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+ return expr;
+
+ l = ffebld_left (expr);
+ r = ffebld_right (expr); /* opITEM. */
+
+ if (ffebld_op (l) != FFEBLD_opCONTER)
+ return expr;
+
+ kt = ffeinfo_kindtype (ffebld_info (l));
+ len = ffebld_size (l);
+
+ start = ffebld_head (r);
+ stop = ffebld_head (ffebld_trail (r));
+ if (start == NULL)
+ first = 1;
+ else
+ {
+ if ((ffebld_op (start) != FFEBLD_opCONTER)
+ || (ffeinfo_basictype (ffebld_info (start)) != FFEINFO_basictypeINTEGER)
+ || (ffeinfo_kindtype (ffebld_info (start))
+ != FFEINFO_kindtypeINTEGERDEFAULT))
+ return expr;
+ first = ffebld_constant_integerdefault (ffebld_conter (start));
+ }
+ if (stop == NULL)
+ last = len;
+ else
+ {
+ if ((ffebld_op (stop) != FFEBLD_opCONTER)
+ || (ffeinfo_basictype (ffebld_info (stop)) != FFEINFO_basictypeINTEGER)
+ || (ffeinfo_kindtype (ffebld_info (stop))
+ != FFEINFO_kindtypeINTEGERDEFAULT))
+ return expr;
+ last = ffebld_constant_integerdefault (ffebld_conter (stop));
+ }
+
+ /* Handle problems that should have already been diagnosed, but
+ left in the expression tree. */
+
+ if (first <= 0)
+ first = 1;
+ if (last < first)
+ last = first + len - 1;
+
+ if ((first == 1) && (last == len))
+ { /* Same as original. */
+ expr = ffebld_new_conter_with_orig (ffebld_constant_copy
+ (ffebld_conter (l)), expr);
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeCHARACTER,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ len));
+
+ return expr;
+ }
+
+ switch (ffeinfo_basictype (ffebld_info (expr)))
+ {
+ case FFEINFO_basictypeANY:
+ return expr;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+ {
+#if FFETARGET_okCHARACTER1
+ case FFEINFO_kindtypeCHARACTER1:
+ error = ffetarget_substr_character1 (ffebld_cu_ptr_character1 (u),
+ ffebld_constant_character1 (ffebld_conter (l)), first, last,
+ ffebld_constant_pool (), &len);
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val
+ (ffebld_cu_val_character1 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER2
+ case FFEINFO_kindtypeCHARACTER2:
+ error = ffetarget_substr_character2 (ffebld_cu_ptr_character2 (u),
+ ffebld_constant_character2 (ffebld_conter (l)), first, last,
+ ffebld_constant_pool (), &len);
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_character2_val
+ (ffebld_cu_val_character2 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER3
+ case FFEINFO_kindtypeCHARACTER3:
+ error = ffetarget_substr_character3 (ffebld_cu_ptr_character3 (u),
+ ffebld_constant_character3 (ffebld_conter (l)), first, last,
+ ffebld_constant_pool (), &len);
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_character3_val
+ (ffebld_cu_val_character3 (u)), expr);
+ break;
+#endif
+
+#if FFETARGET_okCHARACTER4
+ case FFEINFO_kindtypeCHARACTER4:
+ error = ffetarget_substr_character4 (ffebld_cu_ptr_character4 (u),
+ ffebld_constant_character4 (ffebld_conter (l)), first, last,
+ ffebld_constant_pool (), &len);
+ expr = ffebld_new_conter_with_orig (ffebld_constant_new_character4_val
+ (ffebld_cu_val_character4 (u)), expr);
+ break;
+#endif
+
+ default:
+ assert ("bad character kind type" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad type" == NULL);
+ return expr;
+ }
+
+ ffebld_set_info (expr, ffeinfo_new
+ (FFEINFO_basictypeCHARACTER,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ len));
+
+ if ((error != FFEBAD)
+ && ffebad_start (error))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ return expr;
+}
+
+/* ffeexpr_convert -- Convert source expression to given type
+
+ ffebld source;
+ ffelexToken source_token;
+ ffelexToken dest_token; // Any appropriate token for "destination".
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffetargetCharactersize sz;
+ ffeexprContext context; // Mainly LET or DATA.
+ source = ffeexpr_convert(source,source_token,dest_token,bt,kt,sz,context);
+
+ If the expression conforms, returns the source expression. Otherwise
+ returns source wrapped in a convert node doing the conversion, or
+ ANY wrapped in convert if there is a conversion error (and issues an
+ error message). Be sensitive to the context for certain aspects of
+ the conversion. */
+
+ffebld
+ffeexpr_convert (ffebld source, ffelexToken source_token, ffelexToken dest_token,
+ ffeinfoBasictype bt, ffeinfoKindtype kt, ffeinfoRank rk,
+ ffetargetCharacterSize sz, ffeexprContext context)
+{
+ bool bad;
+ ffeinfo info;
+ ffeinfoWhere wh;
+
+ info = ffebld_info (source);
+ if ((bt != ffeinfo_basictype (info))
+ || (kt != ffeinfo_kindtype (info))
+ || (rk != 0) /* Can't convert from or to arrays yet. */
+ || (ffeinfo_rank (info) != 0)
+ || (sz != ffebld_size_known (source)))
+#if 0 /* Nobody seems to need this spurious CONVERT node. */
+ || ((context != FFEEXPR_contextLET)
+ && (bt == FFEINFO_basictypeCHARACTER)
+ && (sz == FFETARGET_charactersizeNONE)))
+#endif
+ {
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ switch (bt)
+ {
+ case FFEINFO_basictypeLOGICAL:
+ bad = FALSE;
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ bad = !ffe_is_ugly_logint ();
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ bad = ffe_is_pedantic ()
+ || !(ffe_is_ugly_init ()
+ && (context == FFEEXPR_contextDATA));
+ break;
+
+ default:
+ bad = TRUE;
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ switch (bt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ bad = FALSE;
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ bad = !ffe_is_ugly_logint ();
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ bad = ffe_is_pedantic ()
+ || !(ffe_is_ugly_init ()
+ && (context == FFEEXPR_contextDATA));
+ break;
+
+ default:
+ bad = TRUE;
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ switch (bt)
+ {
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ bad = FALSE;
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ bad = TRUE;
+ break;
+
+ default:
+ bad = TRUE;
+ break;
+ }
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ bad = (bt != FFEINFO_basictypeCHARACTER)
+ && (ffe_is_pedantic ()
+ || (bt != FFEINFO_basictypeINTEGER)
+ || !(ffe_is_ugly_init ()
+ && (context == FFEEXPR_contextDATA)));
+ break;
+
+ case FFEINFO_basictypeTYPELESS:
+ case FFEINFO_basictypeHOLLERITH:
+ bad = ffe_is_pedantic ()
+ || !(ffe_is_ugly_init ()
+ && ((context == FFEEXPR_contextDATA)
+ || (context == FFEEXPR_contextLET)));
+ break;
+
+ default:
+ bad = TRUE;
+ break;
+ }
+
+ if (!bad && ((rk != 0) || (ffeinfo_rank (info) != 0)))
+ bad = TRUE;
+
+ if (bad && (bt != FFEINFO_basictypeANY) && (kt != FFEINFO_kindtypeANY)
+ && (ffeinfo_basictype (info) != FFEINFO_basictypeANY)
+ && (ffeinfo_kindtype (info) != FFEINFO_kindtypeANY)
+ && (ffeinfo_where (info) != FFEINFO_whereANY))
+ {
+ if (ffebad_start (FFEBAD_BAD_TYPES))
+ {
+ if (dest_token == NULL)
+ ffebad_here (0, ffewhere_line_unknown (),
+ ffewhere_column_unknown ());
+ else
+ ffebad_here (0, ffelex_token_where_line (dest_token),
+ ffelex_token_where_column (dest_token));
+ assert (source_token != NULL);
+ ffebad_here (1, ffelex_token_where_line (source_token),
+ ffelex_token_where_column (source_token));
+ ffebad_finish ();
+ }
+
+ source = ffebld_new_any ();
+ ffebld_set_info (source, ffeinfo_new_any ());
+ }
+ else
+ {
+ switch (ffeinfo_where (info))
+ {
+ case FFEINFO_whereCONSTANT:
+ wh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ wh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ wh = FFEINFO_whereFLEETING;
+ break;
+ }
+ source = ffebld_new_convert (source);
+ ffebld_set_info (source, ffeinfo_new
+ (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ wh,
+ sz));
+ source = ffeexpr_collapse_convert (source, source_token);
+ }
+ }
+
+ return source;
+}
+
+/* ffeexpr_convert_expr -- Convert source expr to conform to dest expr
+
+ ffebld source;
+ ffebld dest;
+ ffelexToken source_token;
+ ffelexToken dest_token;
+ ffeexprContext context;
+ source = ffeexpr_convert_expr(source,source_token,dest,dest_token,context);
+
+ If the expressions conform, returns the source expression. Otherwise
+ returns source wrapped in a convert node doing the conversion, or
+ ANY wrapped in convert if there is a conversion error (and issues an
+ error message). Be sensitive to the context, such as LET or DATA. */
+
+ffebld
+ffeexpr_convert_expr (ffebld source, ffelexToken source_token, ffebld dest,
+ ffelexToken dest_token, ffeexprContext context)
+{
+ ffeinfo info;
+
+ info = ffebld_info (dest);
+ return ffeexpr_convert (source, source_token, dest_token,
+ ffeinfo_basictype (info),
+ ffeinfo_kindtype (info),
+ ffeinfo_rank (info),
+ ffebld_size_known (dest),
+ context);
+}
+
+/* ffeexpr_convert_to_sym -- Convert source expression to conform to symbol
+
+ ffebld source;
+ ffesymbol dest;
+ ffelexToken source_token;
+ ffelexToken dest_token;
+ source = ffeexpr_convert_to_sym(source,source_token,dest,dest_token);
+
+ If the expressions conform, returns the source expression. Otherwise
+ returns source wrapped in a convert node doing the conversion, or
+ ANY wrapped in convert if there is a conversion error (and issues an
+ error message). */
+
+ffebld
+ffeexpr_convert_to_sym (ffebld source, ffelexToken source_token,
+ ffesymbol dest, ffelexToken dest_token)
+{
+ return ffeexpr_convert (source, source_token, dest_token, ffesymbol_basictype (dest),
+ ffesymbol_kindtype (dest), ffesymbol_rank (dest), ffesymbol_size (dest),
+ FFEEXPR_contextLET);
+}
+
+/* Initializes the module. */
+
+void
+ffeexpr_init_2 ()
+{
+ ffeexpr_stack_ = NULL;
+ ffeexpr_level_ = 0;
+}
+
+/* ffeexpr_lhs -- Begin processing left-hand-side-context expression
+
+ Prepares cluster for delivery of lexer tokens representing an expression
+ in a left-hand-side context (A in A=B, for example). ffebld is used
+ to build expressions in the given pool. The appropriate lexer-token
+ handling routine within ffeexpr is returned. When the end of the
+ expression is detected, mycallbackroutine is called with the resulting
+ single ffebld object specifying the entire expression and the first
+ lexer token that is not considered part of the expression. This caller-
+ supplied routine itself returns a lexer-token handling routine. Thus,
+ if necessary, ffeexpr can return several tokens as end-of-expression
+ tokens if it needs to scan forward more than one in any instance. */
+
+ffelexHandler
+ffeexpr_lhs (mallocPool pool, ffeexprContext context, ffeexprCallback callback)
+{
+ ffeexprStack_ s;
+
+ ffebld_pool_push (pool);
+ s = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR stack", sizeof (*s));
+ s->previous = ffeexpr_stack_;
+ s->pool = pool;
+ s->context = context;
+ s->callback = callback;
+ s->first_token = NULL;
+ s->exprstack = NULL;
+ s->is_rhs = FALSE;
+ ffeexpr_stack_ = s;
+ return (ffelexHandler) ffeexpr_token_first_lhs_;
+}
+
+/* ffeexpr_rhs -- Begin processing right-hand-side-context expression
+
+ return ffeexpr_rhs(malloc_pool_image(),mycallbackroutine); // to lexer.
+
+ Prepares cluster for delivery of lexer tokens representing an expression
+ in a right-hand-side context (B in A=B, for example). ffebld is used
+ to build expressions in the given pool. The appropriate lexer-token
+ handling routine within ffeexpr is returned. When the end of the
+ expression is detected, mycallbackroutine is called with the resulting
+ single ffebld object specifying the entire expression and the first
+ lexer token that is not considered part of the expression. This caller-
+ supplied routine itself returns a lexer-token handling routine. Thus,
+ if necessary, ffeexpr can return several tokens as end-of-expression
+ tokens if it needs to scan forward more than one in any instance. */
+
+ffelexHandler
+ffeexpr_rhs (mallocPool pool, ffeexprContext context, ffeexprCallback callback)
+{
+ ffeexprStack_ s;
+
+ ffebld_pool_push (pool);
+ s = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR stack", sizeof (*s));
+ s->previous = ffeexpr_stack_;
+ s->pool = pool;
+ s->context = context;
+ s->callback = callback;
+ s->first_token = NULL;
+ s->exprstack = NULL;
+ s->is_rhs = TRUE;
+ ffeexpr_stack_ = s;
+ return (ffelexHandler) ffeexpr_token_first_rhs_;
+}
+
+/* ffeexpr_cb_close_paren_ -- OPEN_PAREN expr
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Makes sure the end token is close-paren and swallows it, else issues
+ an error message and doesn't swallow the token (passing it along instead).
+ In either case wraps up subexpression construction by enclosing the
+ ffebld expression in a paren. */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprExpr_ e;
+
+ if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+ {
+ /* Oops, naughty user didn't specify the close paren! */
+
+ if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_finish ();
+ }
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->u.operand = ffebld_new_any ();
+ ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+ ffeexpr_exprstack_push_operand_ (e);
+
+ return
+ (ffelexHandler) ffeexpr_find_close_paren_ (t,
+ (ffelexHandler)
+ ffeexpr_token_binary_);
+ }
+
+ if (expr->op == FFEBLD_opIMPDO)
+ {
+ if (ffest_ffebad_start (FFEBAD_IMPDO_PAREN))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ expr = ffebld_new_paren (expr);
+ ffebld_set_info (expr, ffeinfo_use (ffebld_info (ffebld_left (expr))));
+ }
+
+ /* Now push the (parenthesized) expression as an operand onto the
+ expression stack. */
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->u.operand = expr;
+ e->u.operand = ffeexpr_collapse_paren (e->u.operand, ft);
+ e->token = ffeexpr_stack_->tokens[0];
+ ffeexpr_exprstack_push_operand_ (e);
+
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_cb_close_paren_ambig_ -- OPEN_PAREN expr
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ We get here in the READ/BACKEND/ENDFILE/REWIND case "READ(expr)"
+ with the next token in t. If the next token is possibly a binary
+ operator, continue processing the outer expression. If the next
+ token is COMMA, then the expression is a unit specifier, and
+ parentheses should not be added to it because it surrounds the
+ I/O control list that starts with the unit specifier (and continues
+ on from here -- we haven't seen the CLOSE_PAREN that matches the
+ OPEN_PAREN, it is up to the callback function to expect to see it
+ at some point). In this case, we notify the callback function that
+ the COMMA is inside, not outside, the parens by wrapping the expression
+ in an opITEM (with a NULL trail) -- the callback function presumably
+ unwraps it after seeing this kludgey indicator.
+
+ If the next token is CLOSE_PAREN, then we go to the _1_ state to
+ decide what to do with the token after that.
+
+ 15-Feb-91 JCB 1.1
+ Use an extra state for the CLOSE_PAREN case to make READ &co really
+ work right. */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_ambig_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ { /* Need to see the next token before we
+ decide anything. */
+ ffeexpr_stack_->expr = expr;
+ ffeexpr_tokens_[0] = ffelex_token_use (ft);
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_cb_close_paren_ambig_1_;
+ }
+
+ expr = ffeexpr_finished_ambig_ (ft, expr);
+
+ /* Let the callback function handle the case where t isn't COMMA. */
+
+ /* Here is a kludge whereby we tell the callback function the OPEN_PAREN
+ that preceded the expression starts a list of expressions, and the expr
+ hasn't been wrapped in a corresponding (and possibly collapsed) opPAREN
+ node. The callback function should extract the real expr from the head
+ of this opITEM node after testing it. */
+
+ expr = ffebld_new_item (expr, NULL);
+
+ ffebld_pool_pop ();
+ callback = ffeexpr_stack_->callback;
+ ffelex_token_kill (ffeexpr_stack_->first_token);
+ s = ffeexpr_stack_->previous;
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+ return (ffelexHandler) (*callback) (ft, expr, t);
+}
+
+/* ffeexpr_cb_close_paren_ambig_1_ -- OPEN_PAREN expr CLOSE_PAREN
+
+ See ffeexpr_cb_close_paren_ambig_.
+
+ We get here in the READ/BACKEND/ENDFILE/REWIND case "READ(expr)"
+ with the next token in t. If the next token is possibly a binary
+ operator, continue processing the outer expression. If the next
+ token is COMMA, the expression is a parenthesized format specifier.
+ If the next token is not EOS or SEMICOLON, then because it is not a
+ binary operator (it is NAME, OPEN_PAREN, &c), the expression is
+ a unit specifier, and parentheses should not be added to it because
+ they surround the I/O control list that consists of only the unit
+ specifier. If the next token is EOS or SEMICOLON, the statement
+ must be disambiguated by looking at the type of the expression -- a
+ character expression is a parenthesized format specifier, while a
+ non-character expression is a unit specifier.
+
+ Another issue is how to do the callback so the recipient of the
+ next token knows how to handle it if it is a COMMA. In all other
+ cases, disambiguation is straightforward: the same approach as the
+ above is used.
+
+ EXTENSION: in COMMA case, if not pedantic, use same disambiguation
+ as for EOS/SEMICOLON case; f2c allows "READ (cilist) [[,]iolist]"
+ and apparently other compilers do, as well, and some code out there
+ uses this "feature".
+
+ 19-Feb-91 JCB 1.1
+ Extend to allow COMMA as nondisambiguating by itself. Remember
+ to not try and check info field for opSTAR, since that expr doesn't
+ have a valid info field. */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_ambig_1_ (ffelexToken t)
+{
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+ ffelexHandler next;
+ ffelexToken orig_ft = ffeexpr_tokens_[0]; /* In case callback clobbers
+ these. */
+ ffelexToken orig_t = ffeexpr_tokens_[1];
+ ffebld expr = ffeexpr_stack_->expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA: /* Subexpr is parenthesized format specifier. */
+ if (ffe_is_pedantic ())
+ goto pedantic_comma; /* :::::::::::::::::::: */
+ /* Fall through. */
+ case FFELEX_typeEOS: /* Ambiguous; use type of expr to
+ disambiguate. */
+ case FFELEX_typeSEMICOLON:
+ if ((expr == NULL) || (ffebld_op (expr) == FFEBLD_opANY)
+ || (ffebld_op (expr) == FFEBLD_opSTAR)
+ || (ffeinfo_basictype (ffebld_info (expr))
+ != FFEINFO_basictypeCHARACTER))
+ break; /* Not a valid CHARACTER entity, can't be a
+ format spec. */
+ /* Fall through. */
+ default: /* Binary op (we assume; error otherwise);
+ format specifier. */
+
+ pedantic_comma: /* :::::::::::::::::::: */
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFILENUMAMBIG:
+ ffeexpr_stack_->context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFEEXPR_contextFILEUNITAMBIG:
+ ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ default:
+ assert ("bad context" == NULL);
+ break;
+ }
+
+ ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
+ next = (ffelexHandler) ffeexpr_cb_close_paren_ (orig_ft, expr, orig_t);
+ ffelex_token_kill (orig_ft);
+ ffelex_token_kill (orig_t);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeOPEN_PAREN:/* Non-binary op; beginning of I/O list. */
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ expr = ffeexpr_finished_ambig_ (orig_ft, expr);
+
+ /* Here is a kludge whereby we tell the callback function the OPEN_PAREN
+ that preceded the expression starts a list of expressions, and the expr
+ hasn't been wrapped in a corresponding (and possibly collapsed) opPAREN
+ node. The callback function should extract the real expr from the head
+ of this opITEM node after testing it. */
+
+ expr = ffebld_new_item (expr, NULL);
+
+ ffebld_pool_pop ();
+ callback = ffeexpr_stack_->callback;
+ ffelex_token_kill (ffeexpr_stack_->first_token);
+ s = ffeexpr_stack_->previous;
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+ next = (ffelexHandler) (*callback) (orig_ft, expr, orig_t);
+ ffelex_token_kill (orig_ft);
+ ffelex_token_kill (orig_t);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffeexpr_cb_close_paren_c_ -- OPEN_PAREN expr (possible complex)
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Makes sure the end token is close-paren and swallows it, or a comma
+ and handles complex/implied-do possibilities, else issues
+ an error message and doesn't swallow the token (passing it along instead). */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_c_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ /* First check to see if this is a possible complex entity. It is if the
+ token is a comma. */
+
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ {
+ ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
+ ffeexpr_stack_->expr = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextPAREN_, ffeexpr_cb_comma_c_);
+ }
+
+ return (ffelexHandler) ffeexpr_cb_close_paren_ (ft, expr, t);
+}
+
+/* ffeexpr_cb_comma_c_ -- OPEN_PAREN expr COMMA expr
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ If this token is not a comma, we have a complex constant (or an attempt
+ at one), so handle it accordingly, displaying error messages if the token
+ is not a close-paren. */
+
+static ffelexHandler
+ffeexpr_cb_comma_c_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprExpr_ e;
+ ffeinfoBasictype lty = ffeinfo_basictype (ffebld_info (ffeexpr_stack_->expr));
+ ffeinfoBasictype rty = ffeinfo_basictype (ffebld_info (expr));
+ ffeinfoKindtype lkt;
+ ffeinfoKindtype rkt;
+ ffeinfoKindtype nkt;
+ bool ok = TRUE;
+ ffebld orig;
+
+ if ((expr == NULL)
+ || (ffebld_op (ffeexpr_stack_->expr) != FFEBLD_opCONTER)
+ || (((orig = ffebld_conter_orig (ffeexpr_stack_->expr)) != NULL)
+ && (((ffebld_op (orig) != FFEBLD_opUMINUS)
+ && (ffebld_op (orig) != FFEBLD_opUPLUS))
+ || (ffebld_conter_orig (ffebld_left (orig)) != NULL)))
+ || ((lty != FFEINFO_basictypeINTEGER)
+ && (lty != FFEINFO_basictypeREAL)))
+ {
+ if ((lty != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_INVALID_COMPLEX_PART))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+ ffebad_string ("Real");
+ ffebad_finish ();
+ }
+ ok = FALSE;
+ }
+ if ((expr == NULL)
+ || (ffebld_op (expr) != FFEBLD_opCONTER)
+ || (((orig = ffebld_conter_orig (expr)) != NULL)
+ && (((ffebld_op (orig) != FFEBLD_opUMINUS)
+ && (ffebld_op (orig) != FFEBLD_opUPLUS))
+ || (ffebld_conter_orig (ffebld_left (orig)) != NULL)))
+ || ((rty != FFEINFO_basictypeINTEGER)
+ && (rty != FFEINFO_basictypeREAL)))
+ {
+ if ((rty != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_INVALID_COMPLEX_PART))
+ {
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_string ("Imaginary");
+ ffebad_finish ();
+ }
+ ok = FALSE;
+ }
+
+ ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+
+ /* Push the (parenthesized) expression as an operand onto the expression
+ stack. */
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_stack_->tokens[0];
+
+ if (ok)
+ {
+ if (lty == FFEINFO_basictypeINTEGER)
+ lkt = FFEINFO_kindtypeREALDEFAULT;
+ else
+ lkt = ffeinfo_kindtype (ffebld_info (ffeexpr_stack_->expr));
+ if (rty == FFEINFO_basictypeINTEGER)
+ rkt = FFEINFO_kindtypeREALDEFAULT;
+ else
+ rkt = ffeinfo_kindtype (ffebld_info (expr));
+
+ nkt = ffeinfo_kindtype_max (FFEINFO_basictypeCOMPLEX, lkt, rkt);
+ ffeexpr_stack_->expr = ffeexpr_convert (ffeexpr_stack_->expr,
+ ffeexpr_stack_->tokens[1], ffeexpr_stack_->tokens[0],
+ FFEINFO_basictypeREAL, nkt, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ expr = ffeexpr_convert (expr,
+ ffeexpr_stack_->tokens[1], ffeexpr_stack_->tokens[0],
+ FFEINFO_basictypeREAL, nkt, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ }
+ else
+ nkt = FFEINFO_kindtypeANY;
+
+ switch (nkt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_complex1
+ (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr)));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0,
+ FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_complex2
+ (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr)));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0,
+ FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_complex3
+ (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr)));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0,
+ FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ break;
+#endif
+
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_complex4
+ (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr)));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0,
+ FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ break;
+#endif
+
+ default:
+ if (ffebad_start ((nkt == FFEINFO_kindtypeREALDOUBLE)
+ ? FFEBAD_BAD_DBLCMPLX : FFEBAD_BAD_COMPLEX))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_finish ();
+ }
+ /* Fall through. */
+ case FFEINFO_kindtypeANY:
+ e->u.operand = ffebld_new_any ();
+ ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+ break;
+ }
+ ffeexpr_exprstack_push_operand_ (e);
+
+ /* Now, if the token is a close parenthese, we're in great shape so return
+ the next handler. */
+
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ return (ffelexHandler) ffeexpr_token_binary_;
+
+ /* Oops, naughty user didn't specify the close paren! */
+
+ if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_finish ();
+ }
+
+ return
+ (ffelexHandler) ffeexpr_find_close_paren_ (t,
+ (ffelexHandler)
+ ffeexpr_token_binary_);
+}
+
+/* ffeexpr_cb_close_paren_ci_ -- OPEN_PAREN expr (possible complex or
+ implied-DO construct)
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Makes sure the end token is close-paren and swallows it, or a comma
+ and handles complex/implied-do possibilities, else issues
+ an error message and doesn't swallow the token (passing it along instead). */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_ci_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprContext ctx;
+
+ /* First check to see if this is a possible complex or implied-DO entity.
+ It is if the token is a comma. */
+
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ {
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIMPDOITEM_:
+ ctx = FFEEXPR_contextIMPDOITEM_;
+ break;
+
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ ctx = FFEEXPR_contextIMPDOITEMDF_;
+ break;
+
+ default:
+ assert ("bad context" == NULL);
+ ctx = FFEEXPR_contextIMPDOITEM_;
+ break;
+ }
+
+ ffeexpr_stack_->tokens[0] = ffelex_token_use (ft);
+ ffeexpr_stack_->expr = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ ctx, ffeexpr_cb_comma_ci_);
+ }
+
+ ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
+ return (ffelexHandler) ffeexpr_cb_close_paren_ (ft, expr, t);
+}
+
+/* ffeexpr_cb_comma_ci_ -- OPEN_PAREN expr COMMA expr
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ If this token is not a comma, we have a complex constant (or an attempt
+ at one), so handle it accordingly, displaying error messages if the token
+ is not a close-paren. If we have a comma here, it is an attempt at an
+ implied-DO, so start making a list accordingly. Oh, it might be an
+ equal sign also, meaning an implied-DO with only one item in its list. */
+
+static ffelexHandler
+ffeexpr_cb_comma_ci_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffebld fexpr;
+
+ /* First check to see if this is a possible complex constant. It is if the
+ token is not a comma or an equals sign, in which case it should be a
+ close-paren. */
+
+ if ((ffelex_token_type (t) != FFELEX_typeCOMMA)
+ && (ffelex_token_type (t) != FFELEX_typeEQUALS))
+ {
+ ffeexpr_stack_->tokens[1] = ffeexpr_stack_->tokens[0];
+ ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
+ return (ffelexHandler) ffeexpr_cb_comma_c_ (ft, expr, t);
+ }
+
+ /* Here we have either EQUALS or COMMA, meaning we are in an implied-DO
+ construct. Make a list and handle accordingly. */
+
+ ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+ fexpr = ffeexpr_stack_->expr;
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ ffebld_append_item (&ffeexpr_stack_->bottom, fexpr);
+ return (ffelexHandler) ffeexpr_cb_comma_i_1_ (ft, expr, t);
+}
+
+/* ffeexpr_cb_comma_i_ -- OPEN_PAREN expr
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Handle first item in an implied-DO construct. */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeCOMMA)
+ {
+ if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+ ffelex_token_where_column (ffeexpr_stack_->first_token));
+ ffebad_finish ();
+ }
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+ ffeexpr_stack_->expr = ffebld_new_any ();
+ ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+ if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+ }
+
+ return (ffelexHandler) ffeexpr_cb_comma_i_1_ (ft, expr, t);
+}
+
+/* ffeexpr_cb_comma_i_1_ -- OPEN_PAREN expr
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Handle first item in an implied-DO construct. */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprContext ctxi;
+ ffeexprContext ctxc;
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextDATA:
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ ctxi = FFEEXPR_contextDATAIMPDOITEM_;
+ ctxc = FFEEXPR_contextDATAIMPDOCTRL_;
+ break;
+
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIMPDOITEM_:
+ ctxi = FFEEXPR_contextIMPDOITEM_;
+ ctxc = FFEEXPR_contextIMPDOCTRL_;
+ break;
+
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ ctxi = FFEEXPR_contextIMPDOITEMDF_;
+ ctxc = FFEEXPR_contextIMPDOCTRL_;
+ break;
+
+ default:
+ assert ("bad context" == NULL);
+ ctxi = FFEEXPR_context;
+ ctxc = FFEEXPR_context;
+ break;
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ if (ffeexpr_stack_->is_rhs)
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ ctxi, ffeexpr_cb_comma_i_1_);
+ return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+ ctxi, ffeexpr_cb_comma_i_1_);
+
+ case FFELEX_typeEQUALS:
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+
+ /* Complain if implied-DO variable in list of items to be read. */
+
+ if ((ctxc == FFEEXPR_contextIMPDOCTRL_) && !ffeexpr_stack_->is_rhs)
+ ffeexpr_check_impdo_ (ffeexpr_stack_->expr,
+ ffeexpr_stack_->first_token, expr, ft);
+
+ /* Set doiter flag for all appropriate SYMTERs. */
+
+ ffeexpr_update_impdo_ (ffeexpr_stack_->expr, expr);
+
+ ffeexpr_stack_->expr = ffebld_new_impdo (ffeexpr_stack_->expr, NULL);
+ ffebld_set_info (ffeexpr_stack_->expr,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ FFETARGET_charactersizeNONE));
+ ffebld_init_list (&(ffebld_right (ffeexpr_stack_->expr)),
+ &ffeexpr_stack_->bottom);
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ ctxc, ffeexpr_cb_comma_i_2_);
+
+ default:
+ if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+ ffelex_token_where_column (ffeexpr_stack_->first_token));
+ ffebad_finish ();
+ }
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+ ffeexpr_stack_->expr = ffebld_new_any ();
+ ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+ if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+ }
+}
+
+/* ffeexpr_cb_comma_i_2_ -- OPEN_PAREN expr-list EQUALS expr
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Handle start-value in an implied-DO construct. */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ ffeexprContext ctx;
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextDATA:
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ ctx = FFEEXPR_contextDATAIMPDOCTRL_;
+ break;
+
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextIMPDOITEM_:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ ctx = FFEEXPR_contextIMPDOCTRL_;
+ break;
+
+ default:
+ assert ("bad context" == NULL);
+ ctx = FFEEXPR_context;
+ break;
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ ctx, ffeexpr_cb_comma_i_3_);
+ break;
+
+ default:
+ if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+ ffelex_token_where_column (ffeexpr_stack_->first_token));
+ ffebad_finish ();
+ }
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+ ffeexpr_stack_->expr = ffebld_new_any ();
+ ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+ if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+ }
+}
+
+/* ffeexpr_cb_comma_i_3_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Handle end-value in an implied-DO construct. */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_3_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ ffeexprContext ctx;
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextDATA:
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ ctx = FFEEXPR_contextDATAIMPDOCTRL_;
+ break;
+
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextIMPDOITEM_:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ ctx = FFEEXPR_contextIMPDOCTRL_;
+ break;
+
+ default:
+ assert ("bad context" == NULL);
+ ctx = FFEEXPR_context;
+ break;
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ ctx, ffeexpr_cb_comma_i_4_);
+ break;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ return (ffelexHandler) ffeexpr_cb_comma_i_4_ (NULL, NULL, t);
+ break;
+
+ default:
+ if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+ ffelex_token_where_column (ffeexpr_stack_->first_token));
+ ffebad_finish ();
+ }
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+ ffeexpr_stack_->expr = ffebld_new_any ();
+ ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+ if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+ }
+}
+
+/* ffeexpr_cb_comma_i_4_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
+ [COMMA expr]
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Handle incr-value in an implied-DO construct. */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_4_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+ {
+ ffebld item;
+
+ for (item = ffebld_left (ffeexpr_stack_->expr);
+ item != NULL;
+ item = ffebld_trail (item))
+ if (ffebld_op (ffebld_head (item)) == FFEBLD_opANY)
+ goto replace_with_any; /* :::::::::::::::::::: */
+
+ for (item = ffebld_right (ffeexpr_stack_->expr);
+ item != NULL;
+ item = ffebld_trail (item))
+ if ((ffebld_head (item) != NULL) /* Increment may be NULL. */
+ && (ffebld_op (ffebld_head (item)) == FFEBLD_opANY))
+ goto replace_with_any; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+ ffelex_token_where_column (ffeexpr_stack_->first_token));
+ ffebad_finish ();
+ }
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+
+ replace_with_any: /* :::::::::::::::::::: */
+
+ ffeexpr_stack_->expr = ffebld_new_any ();
+ ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+ break;
+ }
+
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+ return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+}
+
+/* ffeexpr_cb_comma_i_5_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
+ [COMMA expr] CLOSE_PAREN
+
+ Pass it to ffeexpr_rhs as the callback routine.
+
+ Collects token following implied-DO construct for callback function. */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_5_ (ffelexToken t)
+{
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+ ffelexHandler next;
+ ffelexToken ft;
+ ffebld expr;
+ bool terminate;
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextDATA:
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ terminate = TRUE;
+ break;
+
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextIMPDOITEM_:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ terminate = FALSE;
+ break;
+
+ default:
+ assert ("bad context" == NULL);
+ terminate = FALSE;
+ break;
+ }
+
+ ffebld_pool_pop ();
+ callback = ffeexpr_stack_->callback;
+ ft = ffeexpr_stack_->first_token;
+ expr = ffeexpr_stack_->expr;
+ s = ffeexpr_stack_->previous;
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
+ sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+ next = (ffelexHandler) (*callback) (ft, expr, t);
+ ffelex_token_kill (ft);
+ if (terminate)
+ {
+ ffesymbol_drive_sfnames (ffeexpr_check_impctrl_);
+ --ffeexpr_level_;
+ if (ffeexpr_level_ == 0)
+ ffe_terminate_4 ();
+ }
+ return (ffelexHandler) next;
+}
+
+/* ffeexpr_cb_end_loc_ -- Handle end of %LOC subexpression
+
+ Makes sure the end token is close-paren and swallows it, else issues
+ an error message and doesn't swallow the token (passing it along instead).
+ In either case wraps up subexpression construction by enclosing the
+ ffebld expression in a %LOC. */
+
+static ffelexHandler
+ffeexpr_cb_end_loc_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ ffeexprExpr_ e;
+
+ /* First push the (%LOC) expression as an operand onto the expression
+ stack. */
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_stack_->tokens[0];
+ e->u.operand = ffebld_new_percent_loc (expr);
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ ffecom_pointer_kind (),
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereFLEETING,
+ FFETARGET_charactersizeNONE));
+#if 0 /* ~~ */
+ e->u.operand = ffeexpr_collapse_percent_loc (e->u.operand, ft);
+#endif
+ ffeexpr_exprstack_push_operand_ (e);
+
+ /* Now, if the token is a close parenthese, we're in great shape so return
+ the next handler. */
+
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ {
+ ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+ }
+
+ /* Oops, naughty user didn't specify the close paren! */
+
+ if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+ ffebad_finish ();
+ }
+
+ ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+ return
+ (ffelexHandler) ffeexpr_find_close_paren_ (t,
+ (ffelexHandler)
+ ffeexpr_token_binary_);
+}
+
+/* ffeexpr_cb_end_notloc_ -- PERCENT NAME(VAL,REF,DESCR) OPEN_PAREN expr
+
+ Should be CLOSE_PAREN, and make sure expr isn't a %(VAL,REF,DESCR). */
+
+static ffelexHandler
+ffeexpr_cb_end_notloc_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprExpr_ e;
+ ffebldOp op;
+
+ /* If expression is itself a %(VAL,REF,DESCR), complain and strip off all
+ such things until the lowest-level expression is reached. */
+
+ op = ffebld_op (expr);
+ if ((op == FFEBLD_opPERCENT_VAL) || (op == FFEBLD_opPERCENT_REF)
+ || (op == FFEBLD_opPERCENT_DESCR))
+ {
+ if (ffebad_start (FFEBAD_NESTED_PERCENT))
+ {
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ }
+
+ do
+ {
+ expr = ffebld_left (expr);
+ op = ffebld_op (expr);
+ }
+ while ((op == FFEBLD_opPERCENT_VAL) || (op == FFEBLD_opPERCENT_REF)
+ || (op == FFEBLD_opPERCENT_DESCR));
+ }
+
+ /* Push the expression as an operand onto the expression stack. */
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_stack_->tokens[0];
+ switch (ffeexpr_stack_->percent)
+ {
+ case FFEEXPR_percentVAL_:
+ e->u.operand = ffebld_new_percent_val (expr);
+ break;
+
+ case FFEEXPR_percentREF_:
+ e->u.operand = ffebld_new_percent_ref (expr);
+ break;
+
+ case FFEEXPR_percentDESCR_:
+ e->u.operand = ffebld_new_percent_descr (expr);
+ break;
+
+ default:
+ assert ("%lossage" == NULL);
+ e->u.operand = expr;
+ break;
+ }
+ ffebld_set_info (e->u.operand, ffebld_info (expr));
+#if 0 /* ~~ */
+ e->u.operand = ffeexpr_collapse_percent_ ? ? ? (e->u.operand, ft);
+#endif
+ ffeexpr_exprstack_push_operand_ (e);
+
+ /* Now, if the token is a close parenthese, we're in great shape so return
+ the next handler. */
+
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ return (ffelexHandler) ffeexpr_cb_end_notloc_1_;
+
+ /* Oops, naughty user didn't specify the close paren! */
+
+ if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+ ffebad_finish ();
+ }
+
+ ffebld_set_op (e->u.operand, FFEBLD_opPERCENT_LOC);
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ default:
+ assert ("bad context?!?!" == NULL);
+ break;
+ }
+
+ ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+ return
+ (ffelexHandler) ffeexpr_find_close_paren_ (t,
+ (ffelexHandler)
+ ffeexpr_cb_end_notloc_1_);
+}
+
+/* ffeexpr_cb_end_notloc_1_ -- PERCENT NAME(VAL,REF,DESCR) OPEN_PAREN expr
+ CLOSE_PAREN
+
+ Should be COMMA or CLOSE_PAREN, else change back to %LOC. */
+
+static ffelexHandler
+ffeexpr_cb_end_notloc_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
+ break;
+
+ default:
+ assert ("bad context?!?!" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ if (ffebad_start (FFEBAD_INVALID_PERCENT))
+ {
+ ffebad_here (0,
+ ffelex_token_where_line (ffeexpr_stack_->first_token),
+ ffelex_token_where_column (ffeexpr_stack_->first_token));
+ ffebad_string (ffelex_token_text (ffeexpr_stack_->tokens[1]));
+ ffebad_finish ();
+ }
+
+ ffebld_set_op (ffeexpr_stack_->exprstack->u.operand,
+ FFEBLD_opPERCENT_LOC);
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ default:
+ assert ("bad context?!?!" == NULL);
+ break;
+ }
+ }
+
+ ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+ return
+ (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* Process DATA implied-DO iterator variables as this implied-DO level
+ terminates. At this point, ffeexpr_level_ == 1 when we see the
+ last right-paren in "DATA (A(I),I=1,10)/.../". */
+
+static ffesymbol
+ffeexpr_check_impctrl_ (ffesymbol s)
+{
+ assert (s != NULL);
+ assert (ffesymbol_sfdummyparent (s) != NULL);
+
+ switch (ffesymbol_state (s))
+ {
+ case FFESYMBOL_stateNONE: /* Used as iterator already. Now let symbol
+ be used as iterator at any level at or
+ innermore than the outermost of the
+ current level and the symbol's current
+ level. */
+ if (ffeexpr_level_ < ffesymbol_maxentrynum (s))
+ {
+ ffesymbol_signal_change (s);
+ ffesymbol_set_maxentrynum (s, ffeexpr_level_);
+ ffesymbol_signal_unreported (s);
+ }
+ break;
+
+ case FFESYMBOL_stateSEEN: /* Seen already in this or other implied-DO.
+ Error if at outermost level, else it can
+ still become an iterator. */
+ if ((ffeexpr_level_ == 1)
+ && ffebad_start (FFEBAD_BAD_IMPDCL))
+ {
+ ffebad_string (ffesymbol_text (s));
+ ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
+ ffebad_finish ();
+ }
+ break;
+
+ case FFESYMBOL_stateUNCERTAIN: /* Iterator. */
+ assert (ffeexpr_level_ <= ffesymbol_maxentrynum (s));
+ ffesymbol_signal_change (s);
+ ffesymbol_set_state (s, FFESYMBOL_stateNONE);
+ ffesymbol_signal_unreported (s);
+ break;
+
+ case FFESYMBOL_stateUNDERSTOOD:
+ break; /* ANY. */
+
+ default:
+ assert ("Sasha Foo!!" == NULL);
+ break;
+ }
+
+ return s;
+}
+
+/* Issue diagnostic if implied-DO variable appears in list of lhs
+ expressions (as in "READ *, (I,I=1,10)"). */
+
+static void
+ffeexpr_check_impdo_ (ffebld list, ffelexToken list_t,
+ ffebld dovar, ffelexToken dovar_t)
+{
+ ffebld item;
+ ffesymbol dovar_sym;
+ int itemnum;
+
+ if (ffebld_op (dovar) != FFEBLD_opSYMTER)
+ return; /* Presumably opANY. */
+
+ dovar_sym = ffebld_symter (dovar);
+
+ for (itemnum = 1; list != NULL; list = ffebld_trail (list), ++itemnum)
+ {
+ if (((item = ffebld_head (list)) != NULL)
+ && (ffebld_op (item) == FFEBLD_opSYMTER)
+ && (ffebld_symter (item) == dovar_sym))
+ {
+ char itemno[20];
+
+ sprintf (&itemno[0], "%d", itemnum);
+ if (ffebad_start (FFEBAD_DOITER_IMPDO))
+ {
+ ffebad_here (0, ffelex_token_where_line (list_t),
+ ffelex_token_where_column (list_t));
+ ffebad_here (1, ffelex_token_where_line (dovar_t),
+ ffelex_token_where_column (dovar_t));
+ ffebad_string (ffesymbol_text (dovar_sym));
+ ffebad_string (itemno);
+ ffebad_finish ();
+ }
+ }
+ }
+}
+
+/* Decorate any SYMTERs referencing the DO variable with the "doiter"
+ flag. */
+
+static void
+ffeexpr_update_impdo_ (ffebld list, ffebld dovar)
+{
+ ffesymbol dovar_sym;
+
+ if (ffebld_op (dovar) != FFEBLD_opSYMTER)
+ return; /* Presumably opANY. */
+
+ dovar_sym = ffebld_symter (dovar);
+
+ ffeexpr_update_impdo_sym_ (list, dovar_sym); /* Recurse! */
+}
+
+/* Recursive function to update any expr so SYMTERs have "doiter" flag
+ if they refer to the given variable. */
+
+static void
+ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar)
+{
+ tail_recurse: /* :::::::::::::::::::: */
+
+ if (expr == NULL)
+ return;
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opSYMTER:
+ if (ffebld_symter (expr) == dovar)
+ ffebld_symter_set_is_doiter (expr, TRUE);
+ break;
+
+ case FFEBLD_opITEM:
+ ffeexpr_update_impdo_sym_ (ffebld_head (expr), dovar);
+ expr = ffebld_trail (expr);
+ goto tail_recurse; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+
+ switch (ffebld_arity (expr))
+ {
+ case 2:
+ ffeexpr_update_impdo_sym_ (ffebld_left (expr), dovar);
+ expr = ffebld_right (expr);
+ goto tail_recurse; /* :::::::::::::::::::: */
+
+ case 1:
+ expr = ffebld_left (expr);
+ goto tail_recurse; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+
+ return;
+}
+
+/* ffeexpr_context_outer_ -- Determine context of stack entry, skipping PARENs
+
+ if (ffeexpr_context_outer_(ffeexpr_stack_) == FFEEXPR_contextIF)
+ // After zero or more PAREN_ contexts, an IF context exists */
+
+static ffeexprContext
+ffeexpr_context_outer_ (ffeexprStack_ s)
+{
+ assert (s != NULL);
+
+ for (;;)
+ {
+ switch (s->context)
+ {
+ case FFEEXPR_contextPAREN_:
+ case FFEEXPR_contextPARENFILENUM_:
+ case FFEEXPR_contextPARENFILEUNIT_:
+ break;
+
+ default:
+ return s->context;
+ }
+ s = s->previous;
+ assert (s != NULL);
+ }
+}
+
+/* ffeexpr_dotdot_ -- Look up name in list of .FOO. possibilities
+
+ ffeexprDotdot_ d;
+ ffelexToken t;
+ d = ffeexpr_dotdot_(t);
+
+ Returns the identifier for the name, or the NONE identifier. */
+
+static ffeexprDotdot_
+ffeexpr_dotdot_ (ffelexToken t)
+{
+ char *p;
+
+ switch (ffelex_token_length (t))
+ {
+ case 2:
+ switch (*(p = ffelex_token_text (t)))
+ {
+ case FFESRC_CASE_MATCH_INIT ('E', 'e', match_2e, no_match_2):
+ if (ffesrc_char_match_noninit (*++p, 'Q', 'q'))
+ return FFEEXPR_dotdotEQ_;
+ return FFEEXPR_dotdotNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('G', 'g', match_2g, no_match_2):
+ if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
+ return FFEEXPR_dotdotGE_;
+ if (ffesrc_char_match_noninit (*p, 'T', 't'))
+ return FFEEXPR_dotdotGT_;
+ return FFEEXPR_dotdotNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('L', 'l', match_2l, no_match_2):
+ if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
+ return FFEEXPR_dotdotLE_;
+ if (ffesrc_char_match_noninit (*p, 'T', 't'))
+ return FFEEXPR_dotdotLT_;
+ return FFEEXPR_dotdotNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('N', 'n', match_2n, no_match_2):
+ if (ffesrc_char_match_noninit (*++p, 'E', 'e'))
+ return FFEEXPR_dotdotNE_;
+ return FFEEXPR_dotdotNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('O', 'o', match_2o, no_match_2):
+ if (ffesrc_char_match_noninit (*++p, 'R', 'r'))
+ return FFEEXPR_dotdotOR_;
+ return FFEEXPR_dotdotNONE_;
+
+ default:
+ no_match_2: /* :::::::::::::::::::: */
+ return FFEEXPR_dotdotNONE_;
+ }
+
+ case 3:
+ switch (*(p = ffelex_token_text (t)))
+ {
+ case FFESRC_CASE_MATCH_INIT ('A', 'a', match_3a, no_match_3):
+ if ((ffesrc_char_match_noninit (*++p, 'N', 'n'))
+ && (ffesrc_char_match_noninit (*++p, 'D', 'd')))
+ return FFEEXPR_dotdotAND_;
+ return FFEEXPR_dotdotNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('E', 'e', match_3e, no_match_3):
+ if ((ffesrc_char_match_noninit (*++p, 'Q', 'q'))
+ && (ffesrc_char_match_noninit (*++p, 'V', 'v')))
+ return FFEEXPR_dotdotEQV_;
+ return FFEEXPR_dotdotNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('N', 'n', match_3n, no_match_3):
+ if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
+ && (ffesrc_char_match_noninit (*++p, 'T', 't')))
+ return FFEEXPR_dotdotNOT_;
+ return FFEEXPR_dotdotNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('X', 'x', match_3x, no_match_3):
+ if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
+ && (ffesrc_char_match_noninit (*++p, 'R', 'r')))
+ return FFEEXPR_dotdotXOR_;
+ return FFEEXPR_dotdotNONE_;
+
+ default:
+ no_match_3: /* :::::::::::::::::::: */
+ return FFEEXPR_dotdotNONE_;
+ }
+
+ case 4:
+ switch (*(p = ffelex_token_text (t)))
+ {
+ case FFESRC_CASE_MATCH_INIT ('N', 'n', match_4n, no_match_4):
+ if ((ffesrc_char_match_noninit (*++p, 'E', 'e'))
+ && (ffesrc_char_match_noninit (*++p, 'Q', 'q'))
+ && (ffesrc_char_match_noninit (*++p, 'V', 'v')))
+ return FFEEXPR_dotdotNEQV_;
+ return FFEEXPR_dotdotNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('T', 't', match_4t, no_match_4):
+ if ((ffesrc_char_match_noninit (*++p, 'R', 'r'))
+ && (ffesrc_char_match_noninit (*++p, 'U', 'u'))
+ && (ffesrc_char_match_noninit (*++p, 'E', 'e')))
+ return FFEEXPR_dotdotTRUE_;
+ return FFEEXPR_dotdotNONE_;
+
+ default:
+ no_match_4: /* :::::::::::::::::::: */
+ return FFEEXPR_dotdotNONE_;
+ }
+
+ case 5:
+ if (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "FALSE",
+ "false", "False")
+ == 0)
+ return FFEEXPR_dotdotFALSE_;
+ return FFEEXPR_dotdotNONE_;
+
+ default:
+ return FFEEXPR_dotdotNONE_;
+ }
+}
+
+/* ffeexpr_percent_ -- Look up name in list of %FOO possibilities
+
+ ffeexprPercent_ p;
+ ffelexToken t;
+ p = ffeexpr_percent_(t);
+
+ Returns the identifier for the name, or the NONE identifier. */
+
+static ffeexprPercent_
+ffeexpr_percent_ (ffelexToken t)
+{
+ char *p;
+
+ switch (ffelex_token_length (t))
+ {
+ case 3:
+ switch (*(p = ffelex_token_text (t)))
+ {
+ case FFESRC_CASE_MATCH_INIT ('L', 'l', match_3l, no_match_3):
+ if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
+ && (ffesrc_char_match_noninit (*++p, 'C', 'c')))
+ return FFEEXPR_percentLOC_;
+ return FFEEXPR_percentNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('R', 'r', match_3r, no_match_3):
+ if ((ffesrc_char_match_noninit (*++p, 'E', 'e'))
+ && (ffesrc_char_match_noninit (*++p, 'F', 'f')))
+ return FFEEXPR_percentREF_;
+ return FFEEXPR_percentNONE_;
+
+ case FFESRC_CASE_MATCH_INIT ('V', 'v', match_3v, no_match_3):
+ if ((ffesrc_char_match_noninit (*++p, 'A', 'a'))
+ && (ffesrc_char_match_noninit (*++p, 'L', 'l')))
+ return FFEEXPR_percentVAL_;
+ return FFEEXPR_percentNONE_;
+
+ default:
+ no_match_3: /* :::::::::::::::::::: */
+ return FFEEXPR_percentNONE_;
+ }
+
+ case 5:
+ if (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DESCR",
+ "descr", "Descr") == 0)
+ return FFEEXPR_percentDESCR_;
+ return FFEEXPR_percentNONE_;
+
+ default:
+ return FFEEXPR_percentNONE_;
+ }
+}
+
+/* ffeexpr_type_combine -- Binop combine types, check for mythical new COMPLEX
+
+ See prototype.
+
+ If combining the two basictype/kindtype pairs produces a COMPLEX with an
+ unsupported kind type, complain and use the default kind type for
+ COMPLEX. */
+
+void
+ffeexpr_type_combine (ffeinfoBasictype *xnbt, ffeinfoKindtype *xnkt,
+ ffeinfoBasictype lbt, ffeinfoKindtype lkt,
+ ffeinfoBasictype rbt, ffeinfoKindtype rkt,
+ ffelexToken t)
+{
+ ffeinfoBasictype nbt;
+ ffeinfoKindtype nkt;
+
+ nbt = ffeinfo_basictype_combine (lbt, rbt);
+ if ((nbt == FFEINFO_basictypeCOMPLEX)
+ && ((lbt == nbt) || (lbt == FFEINFO_basictypeREAL))
+ && ((rbt == nbt) || (rbt == FFEINFO_basictypeREAL)))
+ {
+ nkt = ffeinfo_kindtype_max (nbt, lkt, rkt);
+ if (ffe_is_pedantic_not_90 () && (nkt == FFEINFO_kindtypeREALDOUBLE))
+ nkt = FFEINFO_kindtypeNONE; /* Force error. */
+ switch (nkt)
+ {
+#if FFETARGET_okCOMPLEX1
+ case FFEINFO_kindtypeREAL1:
+#endif
+#if FFETARGET_okCOMPLEX2
+ case FFEINFO_kindtypeREAL2:
+#endif
+#if FFETARGET_okCOMPLEX3
+ case FFEINFO_kindtypeREAL3:
+#endif
+#if FFETARGET_okCOMPLEX4
+ case FFEINFO_kindtypeREAL4:
+#endif
+ break; /* Fine and dandy. */
+
+ default:
+ if (t != NULL)
+ {
+ ffebad_start ((nkt == FFEINFO_kindtypeREALDOUBLE)
+ ? FFEBAD_BAD_DBLCMPLX : FFEBAD_BAD_COMPLEX);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ nbt = FFEINFO_basictypeNONE;
+ nkt = FFEINFO_kindtypeNONE;
+ break;
+
+ case FFEINFO_kindtypeANY:
+ nkt = FFEINFO_kindtypeREALDEFAULT;
+ break;
+ }
+ }
+ else
+ { /* The normal stuff. */
+ if (nbt == lbt)
+ if (nbt == rbt)
+ nkt = ffeinfo_kindtype_max (nbt, lkt, rkt);
+ else
+ nkt = lkt;
+ else if (nbt == rbt)
+ nkt = rkt;
+ else
+ { /* Let the caller do the complaining. */
+ nbt = FFEINFO_basictypeNONE;
+ nkt = FFEINFO_kindtypeNONE;
+ }
+ }
+
+ /* Always a good idea to avoid aliasing problems. */
+
+ *xnbt = nbt;
+ *xnkt = nkt;
+}
+
+/* ffeexpr_token_first_lhs_ -- First state for lhs expression
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Record line and column of first token in expression, then invoke the
+ initial-state lhs handler. */
+
+static ffelexHandler
+ffeexpr_token_first_lhs_ (ffelexToken t)
+{
+ ffeexpr_stack_->first_token = ffelex_token_use (t);
+
+ /* When changing the list of valid initial lhs tokens, check whether to
+ update a corresponding list in ffeexpr_cb_close_paren_ambig_1_ for the
+ READ (expr) <token> case -- it assumes it knows which tokens <token> can
+ be to indicate an lhs (or implied DO), which right now is the set
+ {NAME,OPEN_PAREN}.
+
+ This comment also appears in ffeexpr_token_lhs_. */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextDATA:
+ ffe_init_4 ();
+ ffeexpr_level_ = 1; /* Level of DATA implied-DO construct. */
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextDATAIMPDOITEM_, ffeexpr_cb_comma_i_);
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ ++ffeexpr_level_; /* Level of DATA implied-DO construct. */
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextDATAIMPDOITEM_, ffeexpr_cb_comma_i_);
+
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIMPDOITEM_:
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextIMPDOITEM_, ffeexpr_cb_comma_i_);
+
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextIMPDOITEMDF_, ffeexpr_cb_comma_i_);
+
+ case FFEEXPR_contextFILEEXTFUNC:
+ assert (ffeexpr_stack_->exprstack == NULL);
+ return (ffelexHandler) ffeexpr_token_first_lhs_1_;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typeNAME:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFILENAMELIST:
+ assert (ffeexpr_stack_->exprstack == NULL);
+ return (ffelexHandler) ffeexpr_token_namelist_;
+
+ case FFEEXPR_contextFILEEXTFUNC:
+ assert (ffeexpr_stack_->exprstack == NULL);
+ return (ffelexHandler) ffeexpr_token_first_lhs_1_;
+
+ default:
+ break;
+ }
+ break;
+
+ default:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFILEEXTFUNC:
+ assert (ffeexpr_stack_->exprstack == NULL);
+ return (ffelexHandler) ffeexpr_token_first_lhs_1_;
+
+ default:
+ break;
+ }
+ break;
+ }
+
+ return (ffelexHandler) ffeexpr_token_lhs_ (t);
+}
+
+/* ffeexpr_token_first_lhs_1_ -- NAME
+
+ return ffeexpr_token_first_lhs_1_; // to lexer
+
+ Handle NAME as an external function (USEROPEN= VXT extension to OPEN
+ statement). */
+
+static ffelexHandler
+ffeexpr_token_first_lhs_1_ (ffelexToken t)
+{
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+ ffelexHandler next;
+ ffelexToken ft;
+ ffesymbol sy = NULL;
+ ffebld expr;
+
+ ffebld_pool_pop ();
+ callback = ffeexpr_stack_->callback;
+ ft = ffeexpr_stack_->first_token;
+ s = ffeexpr_stack_->previous;
+
+ if ((ffelex_token_type (ft) != FFELEX_typeNAME)
+ || (ffesymbol_attrs (sy = ffeexpr_declare_unadorned_ (ft, FALSE))
+ & FFESYMBOL_attrANY))
+ {
+ if ((ffelex_token_type (ft) != FFELEX_typeNAME)
+ || !(ffesymbol_attrs (sy) & FFESYMBOL_attrsANY))
+ {
+ ffebad_start (FFEBAD_EXPR_WRONG);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ }
+ expr = ffebld_new_any ();
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ }
+ else
+ {
+ expr = ffebld_new_symter (sy, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE);
+ ffebld_set_info (expr, ffesymbol_info (sy));
+ }
+
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
+ sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+
+ next = (ffelexHandler) (*callback) (ft, expr, t);
+ ffelex_token_kill (ft);
+ return (ffelexHandler) next;
+}
+
+/* ffeexpr_token_first_rhs_ -- First state for rhs expression
+
+ Record line and column of first token in expression, then invoke the
+ initial-state rhs handler.
+
+ 19-Feb-91 JCB 1.1
+ Allow ASTERISK in PARENFILEUNIT_ case, but only on second level only
+ (i.e. only as in READ(*), not READ((*))). */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_ (ffelexToken t)
+{
+ ffesymbol s;
+
+ ffeexpr_stack_->first_token = ffelex_token_use (t);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFILEFORMATNML:
+ ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+ /* Fall through. */
+ case FFEEXPR_contextFILEUNIT:
+ case FFEEXPR_contextDIMLIST:
+ case FFEEXPR_contextFILEFORMAT:
+ case FFEEXPR_contextCHARACTERSIZE:
+ if (ffeexpr_stack_->previous != NULL)
+ break; /* Valid only on first level. */
+ assert (ffeexpr_stack_->exprstack == NULL);
+ return (ffelexHandler) ffeexpr_token_first_rhs_1_;
+
+ case FFEEXPR_contextPARENFILEUNIT_:
+ if (ffeexpr_stack_->previous->previous != NULL)
+ break; /* Valid only on second level. */
+ assert (ffeexpr_stack_->exprstack == NULL);
+ return (ffelexHandler) ffeexpr_token_first_rhs_1_;
+
+ case FFEEXPR_contextACTUALARG_:
+ if (ffeexpr_stack_->previous->context
+ != FFEEXPR_contextSUBROUTINEREF)
+ {
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+ }
+ assert (ffeexpr_stack_->exprstack == NULL);
+ return (ffelexHandler) ffeexpr_token_first_rhs_3_;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFILENUMAMBIG:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextPARENFILENUM_,
+ ffeexpr_cb_close_paren_ambig_);
+
+ case FFEEXPR_contextFILEUNITAMBIG:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextPARENFILEUNIT_,
+ ffeexpr_cb_close_paren_ambig_);
+
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIMPDOITEM_:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextIMPDOITEM_,
+ ffeexpr_cb_close_paren_ci_);
+
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextIMPDOITEMDF_,
+ ffeexpr_cb_close_paren_ci_);
+
+ case FFEEXPR_contextFILEFORMATNML:
+ ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ case FFEEXPR_contextACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typeNUMBER:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFILEFORMATNML:
+ ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+ /* Fall through. */
+ case FFEEXPR_contextFILEFORMAT:
+ if (ffeexpr_stack_->previous != NULL)
+ break; /* Valid only on first level. */
+ assert (ffeexpr_stack_->exprstack == NULL);
+ return (ffelexHandler) ffeexpr_token_first_rhs_2_;
+
+ case FFEEXPR_contextACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typeNAME:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFILEFORMATNML:
+ assert (ffeexpr_stack_->exprstack == NULL);
+ s = ffesymbol_lookup_local (t);
+ if ((s != NULL) && (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
+ return (ffelexHandler) ffeexpr_token_namelist_;
+ ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typePERCENT:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ return (ffelexHandler) ffeexpr_token_first_rhs_5_;
+
+ case FFEEXPR_contextFILEFORMATNML:
+ ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ default:
+ break;
+ }
+
+ default:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextFILEFORMATNML:
+ ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ default:
+ break;
+ }
+ break;
+ }
+
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+}
+
+/* ffeexpr_token_first_rhs_1_ -- ASTERISK
+
+ return ffeexpr_token_first_rhs_1_; // to lexer
+
+ Return STAR as expression. */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_1_ (ffelexToken t)
+{
+ ffebld expr;
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+ ffelexHandler next;
+ ffelexToken ft;
+
+ expr = ffebld_new_star ();
+ ffebld_pool_pop ();
+ callback = ffeexpr_stack_->callback;
+ ft = ffeexpr_stack_->first_token;
+ s = ffeexpr_stack_->previous;
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+ next = (ffelexHandler) (*callback) (ft, expr, t);
+ ffelex_token_kill (ft);
+ return (ffelexHandler) next;
+}
+
+/* ffeexpr_token_first_rhs_2_ -- NUMBER
+
+ return ffeexpr_token_first_rhs_2_; // to lexer
+
+ Return NULL as expression; NUMBER as first (and only) token, unless the
+ current token is not a terminating token, in which case run normal
+ expression handling. */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_2_ (ffelexToken t)
+{
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+ ffelexHandler next;
+ ffelexToken ft;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+
+ default:
+ next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ ffebld_pool_pop ();
+ callback = ffeexpr_stack_->callback;
+ ft = ffeexpr_stack_->first_token;
+ s = ffeexpr_stack_->previous;
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
+ sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+ next = (ffelexHandler) (*callback) (ft, NULL, t);
+ ffelex_token_kill (ft);
+ return (ffelexHandler) next;
+}
+
+/* ffeexpr_token_first_rhs_3_ -- ASTERISK
+
+ return ffeexpr_token_first_rhs_3_; // to lexer
+
+ Expect NUMBER, make LABTOK (with copy of token if not inhibited after
+ confirming, else NULL). */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ { /* An error, but let normal processing handle
+ it. */
+ next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ /* Special case: when we see "*10" as an argument to a subroutine
+ reference, we confirm the current statement and, if not inhibited at
+ this point, put a copy of the token into a LABTOK node. We do this
+ instead of just resolving the label directly via ffelab and putting it
+ into a LABTER simply to improve error reporting and consistency in
+ ffestc. We put NULL in the LABTOK if we're still inhibited, so ffestb
+ doesn't have to worry about killing off any tokens when retracting. */
+
+ ffest_confirmed ();
+ if (ffest_is_inhibited ())
+ ffeexpr_stack_->expr = ffebld_new_labtok (NULL);
+ else
+ ffeexpr_stack_->expr = ffebld_new_labtok (ffelex_token_use (t));
+ ffebld_set_info (ffeexpr_stack_->expr,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ FFETARGET_charactersizeNONE));
+
+ return (ffelexHandler) ffeexpr_token_first_rhs_4_;
+}
+
+/* ffeexpr_token_first_rhs_4_ -- ASTERISK NUMBER
+
+ return ffeexpr_token_first_rhs_4_; // to lexer
+
+ Collect/flush appropriate stuff, send token to callback function. */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_4_ (ffelexToken t)
+{
+ ffebld expr;
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+ ffelexHandler next;
+ ffelexToken ft;
+
+ expr = ffeexpr_stack_->expr;
+ ffebld_pool_pop ();
+ callback = ffeexpr_stack_->callback;
+ ft = ffeexpr_stack_->first_token;
+ s = ffeexpr_stack_->previous;
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+ next = (ffelexHandler) (*callback) (ft, expr, t);
+ ffelex_token_kill (ft);
+ return (ffelexHandler) next;
+}
+
+/* ffeexpr_token_first_rhs_5_ -- PERCENT
+
+ Should be NAME, or pass through original mechanism. If NAME is LOC,
+ pass through original mechanism, otherwise must be VAL, REF, or DESCR,
+ in which case handle the argument (in parentheses), etc. */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_5_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ {
+ ffeexprPercent_ p = ffeexpr_percent_ (t);
+
+ switch (p)
+ {
+ case FFEEXPR_percentNONE_:
+ case FFEEXPR_percentLOC_:
+ break; /* Treat %LOC as any other expression. */
+
+ case FFEEXPR_percentVAL_:
+ case FFEEXPR_percentREF_:
+ case FFEEXPR_percentDESCR_:
+ ffeexpr_stack_->percent = p;
+ ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_first_rhs_6_;
+
+ default:
+ assert ("bad percent?!?" == NULL);
+ break;
+ }
+ }
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ default:
+ assert ("bad context?!?!" == NULL);
+ break;
+ }
+
+ next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffeexpr_token_first_rhs_6_ -- PERCENT NAME(VAL,REF,DESCR)
+
+ Should be OPEN_PAREN, or pass through original mechanism. */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_6_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken ft;
+
+ if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
+ {
+ ffeexpr_stack_->tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ ffeexpr_stack_->context,
+ ffeexpr_cb_end_notloc_);
+ }
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ default:
+ assert ("bad context?!?!" == NULL);
+ break;
+ }
+
+ ft = ffeexpr_stack_->tokens[0];
+ next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
+ next = (ffelexHandler) (*next) (ft);
+ ffelex_token_kill (ft);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffeexpr_token_namelist_ -- NAME
+
+ return ffeexpr_token_namelist_; // to lexer
+
+ Make sure NAME was a valid namelist object, wrap it in a SYMTER and
+ return. */
+
+static ffelexHandler
+ffeexpr_token_namelist_ (ffelexToken t)
+{
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+ ffelexHandler next;
+ ffelexToken ft;
+ ffesymbol sy;
+ ffebld expr;
+
+ ffebld_pool_pop ();
+ callback = ffeexpr_stack_->callback;
+ ft = ffeexpr_stack_->first_token;
+ s = ffeexpr_stack_->previous;
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+
+ sy = ffesymbol_lookup_local (ft);
+ if ((sy == NULL) || (ffesymbol_kind (sy) != FFEINFO_kindNAMELIST))
+ {
+ ffebad_start (FFEBAD_EXPR_WRONG);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ expr = ffebld_new_any ();
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ }
+ else
+ {
+ expr = ffebld_new_symter (sy, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE);
+ ffebld_set_info (expr, ffesymbol_info (sy));
+ }
+ next = (ffelexHandler) (*callback) (ft, expr, t);
+ ffelex_token_kill (ft);
+ return (ffelexHandler) next;
+}
+
+/* ffeexpr_expr_kill_ -- Kill an existing internal expression object
+
+ ffeexprExpr_ e;
+ ffeexpr_expr_kill_(e);
+
+ Kills the ffewhere info, if necessary, then kills the object. */
+
+static void
+ffeexpr_expr_kill_ (ffeexprExpr_ e)
+{
+ if (e->token != NULL)
+ ffelex_token_kill (e->token);
+ malloc_kill_ks (ffe_pool_program_unit (), e, sizeof (*e));
+}
+
+/* ffeexpr_expr_new_ -- Make a new internal expression object
+
+ ffeexprExpr_ e;
+ e = ffeexpr_expr_new_();
+
+ Allocates and initializes a new expression object, returns it. */
+
+static ffeexprExpr_
+ffeexpr_expr_new_ ()
+{
+ ffeexprExpr_ e;
+
+ e = (ffeexprExpr_) malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR expr",
+ sizeof (*e));
+ e->previous = NULL;
+ e->type = FFEEXPR_exprtypeUNKNOWN_;
+ e->token = NULL;
+ return e;
+}
+
+/* Verify that call to global is valid, and register whatever
+ new information about a global might be discoverable by looking
+ at the call. */
+
+static void
+ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t)
+{
+ int n_args;
+ ffebld list;
+ ffebld item;
+ ffesymbol s;
+
+ assert ((ffebld_op (*expr) == FFEBLD_opSUBRREF)
+ || (ffebld_op (*expr) == FFEBLD_opFUNCREF));
+
+ if (ffebld_op (ffebld_left (*expr)) != FFEBLD_opSYMTER)
+ return;
+
+ if (ffesymbol_retractable ())
+ return;
+
+ s = ffebld_symter (ffebld_left (*expr));
+ if (ffesymbol_global (s) == NULL)
+ return;
+
+ for (n_args = 0, list = ffebld_right (*expr);
+ list != NULL;
+ list = ffebld_trail (list), ++n_args)
+ ;
+
+ if (ffeglobal_proc_ref_nargs (s, n_args, t))
+ {
+ ffeglobalArgSummary as;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ bool array;
+ bool fail = FALSE;
+
+ for (n_args = 0, list = ffebld_right (*expr);
+ list != NULL;
+ list = ffebld_trail (list), ++n_args)
+ {
+ item = ffebld_head (list);
+ if (item != NULL)
+ {
+ bt = ffeinfo_basictype (ffebld_info (item));
+ kt = ffeinfo_kindtype (ffebld_info (item));
+ array = (ffeinfo_rank (ffebld_info (item)) > 0);
+ switch (ffebld_op (item))
+ {
+ case FFEBLD_opLABTOK:
+ case FFEBLD_opLABTER:
+ as = FFEGLOBAL_argsummaryALTRTN;
+ break;
+
+ case FFEBLD_opPERCENT_LOC:
+ as = FFEGLOBAL_argsummaryPTR;
+ break;
+
+ case FFEBLD_opPERCENT_VAL:
+ as = FFEGLOBAL_argsummaryVAL;
+ break;
+
+ case FFEBLD_opPERCENT_REF:
+ as = FFEGLOBAL_argsummaryREF;
+ break;
+
+ case FFEBLD_opPERCENT_DESCR:
+ as = FFEGLOBAL_argsummaryDESCR;
+ break;
+
+ case FFEBLD_opFUNCREF:
+ if ((ffebld_op (ffebld_left (item)) == FFEBLD_opSYMTER)
+ && (ffesymbol_specific (ffebld_symter (ffebld_left (item)))
+ == FFEINTRIN_specLOC))
+ {
+ as = FFEGLOBAL_argsummaryPTR;
+ break;
+ }
+ /* Fall through. */
+ default:
+ if (ffebld_op (item) == FFEBLD_opSYMTER)
+ {
+ as = FFEGLOBAL_argsummaryNONE;
+
+ switch (ffeinfo_kind (ffebld_info (item)))
+ {
+ case FFEINFO_kindFUNCTION:
+ as = FFEGLOBAL_argsummaryFUNC;
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ as = FFEGLOBAL_argsummarySUBR;
+ break;
+
+ case FFEINFO_kindNONE:
+ as = FFEGLOBAL_argsummaryPROC;
+ break;
+
+ default:
+ break;
+ }
+
+ if (as != FFEGLOBAL_argsummaryNONE)
+ break;
+ }
+
+ if (bt == FFEINFO_basictypeCHARACTER)
+ as = FFEGLOBAL_argsummaryDESCR;
+ else
+ as = FFEGLOBAL_argsummaryREF;
+ break;
+ }
+ }
+ else
+ {
+ array = FALSE;
+ as = FFEGLOBAL_argsummaryNONE;
+ bt = FFEINFO_basictypeNONE;
+ kt = FFEINFO_kindtypeNONE;
+ }
+
+ if (! ffeglobal_proc_ref_arg (s, n_args, as, bt, kt, array, t))
+ fail = TRUE;
+ }
+ if (! fail)
+ return;
+ }
+
+ *expr = ffebld_new_any ();
+ ffebld_set_info (*expr, ffeinfo_new_any ());
+}
+
+/* Check whether rest of string is all decimal digits. */
+
+static bool
+ffeexpr_isdigits_ (char *p)
+{
+ for (; *p != '\0'; ++p)
+ if (!isdigit (*p))
+ return FALSE;
+ return TRUE;
+}
+
+/* ffeexpr_exprstack_push_ -- Push an arbitrary expression object onto the stack
+
+ ffeexprExpr_ e;
+ ffeexpr_exprstack_push_(e);
+
+ Pushes the expression onto the stack without any analysis of the existing
+ contents of the stack. */
+
+static void
+ffeexpr_exprstack_push_ (ffeexprExpr_ e)
+{
+ e->previous = ffeexpr_stack_->exprstack;
+ ffeexpr_stack_->exprstack = e;
+}
+
+/* ffeexpr_exprstack_push_operand_ -- Push an operand onto the stack, reduce?
+
+ ffeexprExpr_ e;
+ ffeexpr_exprstack_push_operand_(e);
+
+ Pushes the expression already containing an operand (a constant, variable,
+ or more complicated expression that has already been fully resolved) after
+ analyzing the stack and checking for possible reduction (which will never
+ happen here since the highest precedence operator is ** and it has right-
+ to-left associativity). */
+
+static void
+ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e)
+{
+ ffeexpr_exprstack_push_ (e);
+#ifdef WEIRD_NONFORTRAN_RULES
+ if ((ffeexpr_stack_->exprstack != NULL)
+ && (ffeexpr_stack_->exprstack->expr->type == FFEEXPR_exprtypeBINARY_)
+ && (ffeexpr_stack_->exprstack->expr->u.operator.prec
+ == FFEEXPR_operatorprecedenceHIGHEST_)
+ && (ffeexpr_stack_->exprstack->expr->u.operator.as
+ == FFEEXPR_operatorassociativityL2R_))
+ ffeexpr_reduce_ ();
+#endif
+}
+
+/* ffeexpr_exprstack_push_unary_ -- Push a unary operator onto the stack
+
+ ffeexprExpr_ e;
+ ffeexpr_exprstack_push_unary_(e);
+
+ Pushes the expression already containing a unary operator. Reduction can
+ never happen since unary operators are themselves always R-L; that is, the
+ top of the expression stack is not an operand, in that it is either empty,
+ has a binary operator at the top, or a unary operator at the top. In any
+ of these cases, reduction is impossible. */
+
+static void
+ffeexpr_exprstack_push_unary_ (ffeexprExpr_ e)
+{
+ if ((ffe_is_pedantic ()
+ || ffe_is_warn_surprising ())
+ && (ffeexpr_stack_->exprstack != NULL)
+ && (ffeexpr_stack_->exprstack->type != FFEEXPR_exprtypeOPERAND_)
+ && (ffeexpr_stack_->exprstack->u.operator.prec
+ <= FFEEXPR_operatorprecedenceLOWARITH_)
+ && (e->u.operator.prec <= FFEEXPR_operatorprecedenceLOWARITH_))
+ {
+ ffebad_start_msg ("Two arithmetic operators in a row at %0 and %1 -- use parentheses",
+ ffe_is_pedantic ()
+ ? FFEBAD_severityPEDANTIC
+ : FFEBAD_severityWARNING);
+ ffebad_here (0,
+ ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+ ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+ ffebad_here (1,
+ ffelex_token_where_line (e->token),
+ ffelex_token_where_column (e->token));
+ ffebad_finish ();
+ }
+
+ ffeexpr_exprstack_push_ (e);
+}
+
+/* ffeexpr_exprstack_push_binary_ -- Push a binary operator onto the stack, reduce?
+
+ ffeexprExpr_ e;
+ ffeexpr_exprstack_push_binary_(e);
+
+ Pushes the expression already containing a binary operator after checking
+ whether reduction is possible. If the stack is not empty, the top of the
+ stack must be an operand or syntactic analysis has failed somehow. If
+ the operand is preceded by a unary operator of higher (or equal and L-R
+ associativity) precedence than the new binary operator, then reduce that
+ preceding operator and its operand(s) before pushing the new binary
+ operator. */
+
+static void
+ffeexpr_exprstack_push_binary_ (ffeexprExpr_ e)
+{
+ ffeexprExpr_ ce;
+
+ if (ffe_is_warn_surprising ()
+ /* These next two are always true (see assertions below). */
+ && (ffeexpr_stack_->exprstack != NULL)
+ && (ffeexpr_stack_->exprstack->type == FFEEXPR_exprtypeOPERAND_)
+ /* If the previous operator is a unary minus, and the binary op
+ is of higher precedence, might not do what user expects,
+ e.g. "-2**2" is "-(2**2)", i.e. "-4", not "(-2)**2", which would
+ yield "4". */
+ && (ffeexpr_stack_->exprstack->previous != NULL)
+ && (ffeexpr_stack_->exprstack->previous->type == FFEEXPR_exprtypeUNARY_)
+ && (ffeexpr_stack_->exprstack->previous->u.operator.op
+ == FFEEXPR_operatorSUBTRACT_)
+ && (e->u.operator.prec
+ < ffeexpr_stack_->exprstack->previous->u.operator.prec))
+ {
+ ffebad_start_msg ("Operator at %0 has lower precedence than that at %1 -- use parentheses", FFEBAD_severityWARNING);
+ ffebad_here (0,
+ ffelex_token_where_line (ffeexpr_stack_->exprstack->previous->token),
+ ffelex_token_where_column (ffeexpr_stack_->exprstack->previous->token));
+ ffebad_here (1,
+ ffelex_token_where_line (e->token),
+ ffelex_token_where_column (e->token));
+ ffebad_finish ();
+ }
+
+again:
+ assert (ffeexpr_stack_->exprstack != NULL);
+ assert (ffeexpr_stack_->exprstack->type == FFEEXPR_exprtypeOPERAND_);
+ if ((ce = ffeexpr_stack_->exprstack->previous) != NULL)
+ {
+ assert (ce->type != FFEEXPR_exprtypeOPERAND_);
+ if ((ce->u.operator.prec < e->u.operator.prec)
+ || ((ce->u.operator.prec == e->u.operator.prec)
+ && (e->u.operator.as == FFEEXPR_operatorassociativityL2R_)))
+ {
+ ffeexpr_reduce_ ();
+ goto again; /* :::::::::::::::::::: */
+ }
+ }
+
+ ffeexpr_exprstack_push_ (e);
+}
+
+/* ffeexpr_reduce_ -- Reduce highest operator w/operands on stack
+
+ ffeexpr_reduce_();
+
+ Converts operand binop operand or unop operand at top of stack to a
+ single operand having the appropriate ffebld expression, and makes
+ sure that the expression is proper (like not trying to add two character
+ variables, not trying to concatenate two numbers). Also does the
+ requisite type-assignment. */
+
+static void
+ffeexpr_reduce_ ()
+{
+ ffeexprExpr_ operand; /* This is B in -B or A+B. */
+ ffeexprExpr_ left_operand; /* When operator is binary, this is A in A+B. */
+ ffeexprExpr_ operator; /* This is + in A+B. */
+ ffebld reduced; /* This is +(A,B) in A+B or u-(B) in -B. */
+ ffebldConstant constnode; /* For checking magical numbers (where mag ==
+ -mag). */
+ ffebld expr;
+ ffebld left_expr;
+ bool submag = FALSE;
+
+ operand = ffeexpr_stack_->exprstack;
+ assert (operand != NULL);
+ assert (operand->type == FFEEXPR_exprtypeOPERAND_);
+ operator = operand->previous;
+ assert (operator != NULL);
+ assert (operator->type != FFEEXPR_exprtypeOPERAND_);
+ if (operator->type == FFEEXPR_exprtypeUNARY_)
+ {
+ expr = operand->u.operand;
+ switch (operator->u.operator.op)
+ {
+ case FFEEXPR_operatorADD_:
+ reduced = ffebld_new_uplus (expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly1_ (reduced, operator, operand);
+ reduced = ffeexpr_reduced_math1_ (reduced, operator, operand);
+ reduced = ffeexpr_collapse_uplus (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorSUBTRACT_:
+ submag = TRUE; /* Ok to negate a magic number. */
+ reduced = ffebld_new_uminus (expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly1_ (reduced, operator, operand);
+ reduced = ffeexpr_reduced_math1_ (reduced, operator, operand);
+ reduced = ffeexpr_collapse_uminus (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorNOT_:
+ reduced = ffebld_new_not (expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly1log_ (reduced, operator, operand);
+ reduced = ffeexpr_reduced_bool1_ (reduced, operator, operand);
+ reduced = ffeexpr_collapse_not (reduced, operator->token);
+ break;
+
+ default:
+ assert ("unexpected unary op" != NULL);
+ reduced = NULL;
+ break;
+ }
+ if (!submag
+ && (ffebld_op (expr) == FFEBLD_opCONTER)
+ && (ffebld_conter_orig (expr) == NULL)
+ && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
+ {
+ ffetarget_integer_bad_magical (operand->token);
+ }
+ ffeexpr_stack_->exprstack = operator->previous; /* Pops unary-op operand
+ off stack. */
+ ffeexpr_expr_kill_ (operand);
+ operator->type = FFEEXPR_exprtypeOPERAND_; /* Convert operator, but
+ save */
+ operator->u.operand = reduced; /* the line/column ffewhere info. */
+ ffeexpr_exprstack_push_operand_ (operator); /* Push it back on
+ stack. */
+ }
+ else
+ {
+ assert (operator->type == FFEEXPR_exprtypeBINARY_);
+ left_operand = operator->previous;
+ assert (left_operand != NULL);
+ assert (left_operand->type == FFEEXPR_exprtypeOPERAND_);
+ expr = operand->u.operand;
+ left_expr = left_operand->u.operand;
+ switch (operator->u.operator.op)
+ {
+ case FFEEXPR_operatorADD_:
+ reduced = ffebld_new_add (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_add (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorSUBTRACT_:
+ submag = TRUE; /* Just to pick the right error if magic
+ number. */
+ reduced = ffebld_new_subtract (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_subtract (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorMULTIPLY_:
+ reduced = ffebld_new_multiply (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_multiply (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorDIVIDE_:
+ reduced = ffebld_new_divide (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_divide (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorPOWER_:
+ reduced = ffebld_new_power (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_power_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_power (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorCONCATENATE_:
+ reduced = ffebld_new_concatenate (left_expr, expr);
+ reduced = ffeexpr_reduced_concatenate_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_concatenate (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorLT_:
+ reduced = ffebld_new_lt (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_lt (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorLE_:
+ reduced = ffebld_new_le (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_le (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorEQ_:
+ reduced = ffebld_new_eq (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_eqop2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_eq (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorNE_:
+ reduced = ffebld_new_ne (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_eqop2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_ne (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorGT_:
+ reduced = ffebld_new_gt (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_gt (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorGE_:
+ reduced = ffebld_new_ge (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_ge (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorAND_:
+ reduced = ffebld_new_and (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_and (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorOR_:
+ reduced = ffebld_new_or (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_or (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorXOR_:
+ reduced = ffebld_new_xor (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_xor (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorEQV_:
+ reduced = ffebld_new_eqv (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_eqv (reduced, operator->token);
+ break;
+
+ case FFEEXPR_operatorNEQV_:
+ reduced = ffebld_new_neqv (left_expr, expr);
+ if (ffe_is_ugly_logint ())
+ reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+ operand);
+ reduced = ffeexpr_collapse_neqv (reduced, operator->token);
+ break;
+
+ default:
+ assert ("bad bin op" == NULL);
+ reduced = expr;
+ break;
+ }
+ if ((ffebld_op (left_expr) == FFEBLD_opCONTER)
+ && (ffebld_conter_orig (expr) == NULL)
+ && ffebld_constant_is_magical (constnode = ffebld_conter (left_expr)))
+ {
+ if ((left_operand->previous != NULL)
+ && (left_operand->previous->type != FFEEXPR_exprtypeOPERAND_)
+ && (left_operand->previous->u.operator.op
+ == FFEEXPR_operatorSUBTRACT_))
+ if (left_operand->previous->type == FFEEXPR_exprtypeUNARY_)
+ ffetarget_integer_bad_magical_precedence (left_operand->token,
+ left_operand->previous->token,
+ operator->token);
+ else
+ ffetarget_integer_bad_magical_precedence_binary
+ (left_operand->token,
+ left_operand->previous->token,
+ operator->token);
+ else
+ ffetarget_integer_bad_magical (left_operand->token);
+ }
+ if ((ffebld_op (expr) == FFEBLD_opCONTER)
+ && (ffebld_conter_orig (expr) == NULL)
+ && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
+ if (submag)
+ ffetarget_integer_bad_magical_binary (operand->token,
+ operator->token);
+ else
+ ffetarget_integer_bad_magical (operand->token);
+ ffeexpr_stack_->exprstack = left_operand->previous; /* Pops binary-op
+ operands off stack. */
+ ffeexpr_expr_kill_ (left_operand);
+ ffeexpr_expr_kill_ (operand);
+ operator->type = FFEEXPR_exprtypeOPERAND_; /* Convert operator, but
+ save */
+ operator->u.operand = reduced; /* the line/column ffewhere info. */
+ ffeexpr_exprstack_push_operand_ (operator); /* Push it back on
+ stack. */
+ }
+}
+
+/* ffeexpr_reduced_bool1_ -- Wrap up reduction of NOT operator
+
+ reduced = ffeexpr_reduced_bool1_(reduced,op,r);
+
+ Makes sure the argument for reduced has basictype of
+ LOGICAL or (ugly) INTEGER. If
+ argument has where of CONSTANT, assign where CONSTANT to
+ reduced, else assign where FLEETING.
+
+ If these requirements cannot be met, generate error message. */
+
+static ffebld
+ffeexpr_reduced_bool1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
+{
+ ffeinfo rinfo, ninfo;
+ ffeinfoBasictype rbt;
+ ffeinfoKindtype rkt;
+ ffeinfoRank rrk;
+ ffeinfoKind rkd;
+ ffeinfoWhere rwh, nwh;
+
+ rinfo = ffebld_info (ffebld_left (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ if (((rbt == FFEINFO_basictypeLOGICAL)
+ || (ffe_is_ugly_logint () && (rbt == FFEINFO_basictypeINTEGER)))
+ && (rrk == 0))
+ {
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ nwh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ ninfo = ffeinfo_new (rbt, rkt, 0, FFEINFO_kindENTITY, nwh,
+ FFETARGET_charactersizeNONE);
+ ffebld_set_info (reduced, ninfo);
+ return reduced;
+ }
+
+ if ((rbt != FFEINFO_basictypeLOGICAL)
+ && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
+ {
+ if ((rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_NOT_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((rkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_NOT_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ return reduced;
+}
+
+/* ffeexpr_reduced_bool2_ -- Wrap up reduction of boolean operators
+
+ reduced = ffeexpr_reduced_bool2_(reduced,l,op,r);
+
+ Makes sure the left and right arguments for reduced have basictype of
+ LOGICAL or (ugly) INTEGER. Determine common basictype and
+ size for reduction (flag expression for combined hollerith/typeless
+ situations for later determination of effective basictype). If both left
+ and right arguments have where of CONSTANT, assign where CONSTANT to
+ reduced, else assign where FLEETING. Create CONVERT ops for args where
+ needed. Convert typeless
+ constants to the desired type/size explicitly.
+
+ If these requirements cannot be met, generate error message. */
+
+static ffebld
+ffeexpr_reduced_bool2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+ ffeexprExpr_ r)
+{
+ ffeinfo linfo, rinfo, ninfo;
+ ffeinfoBasictype lbt, rbt, nbt;
+ ffeinfoKindtype lkt, rkt, nkt;
+ ffeinfoRank lrk, rrk;
+ ffeinfoKind lkd, rkd;
+ ffeinfoWhere lwh, rwh, nwh;
+
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+ if (((nbt == FFEINFO_basictypeLOGICAL)
+ || (ffe_is_ugly_logint () && (nbt == FFEINFO_basictypeINTEGER)))
+ && (lrk == 0) && (rrk == 0))
+ {
+ switch (lwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ nwh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
+ FFETARGET_charactersizeNONE);
+ ffebld_set_info (reduced, ninfo);
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ return reduced;
+ }
+
+ if ((lbt != FFEINFO_basictypeLOGICAL)
+ && (!ffe_is_ugly_logint () || (lbt != FFEINFO_basictypeINTEGER)))
+ {
+ if ((rbt != FFEINFO_basictypeLOGICAL)
+ && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
+ {
+ if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_BOOL_ARGS_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((lbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_BOOL_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_finish ();
+ }
+ }
+ }
+ else if ((rbt != FFEINFO_basictypeLOGICAL)
+ && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
+ {
+ if ((rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_BOOL_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else if (lrk != 0)
+ {
+ if ((lkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_BOOL_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((rkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_BOOL_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ return reduced;
+}
+
+/* ffeexpr_reduced_concatenate_ -- Wrap up reduction of concatenate operator
+
+ reduced = ffeexpr_reduced_concatenate_(reduced,l,op,r);
+
+ Makes sure the left and right arguments for reduced have basictype of
+ CHARACTER and kind of SCALAR, FUNCTION, or STATEMENT FUNCTION. Assign
+ basictype of CHARACTER and kind of SCALAR to reduced. Calculate effective
+ size of concatenation and assign that size to reduced. If both left and
+ right arguments have where of CONSTANT, assign where CONSTANT to reduced,
+ else assign where FLEETING.
+
+ If these requirements cannot be met, generate error message using the
+ info in l, op, and r arguments and assign basictype, size, kind, and where
+ of ANY. */
+
+static ffebld
+ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+ ffeexprExpr_ r)
+{
+ ffeinfo linfo, rinfo, ninfo;
+ ffeinfoBasictype lbt, rbt, nbt;
+ ffeinfoKindtype lkt, rkt, nkt;
+ ffeinfoRank lrk, rrk;
+ ffeinfoKind lkd, rkd, nkd;
+ ffeinfoWhere lwh, rwh, nwh;
+ ffetargetCharacterSize lszm, lszk, rszm, rszk, nszk;
+
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+ lszk = ffeinfo_size (linfo); /* Known size. */
+ lszm = ffebld_size_max (ffebld_left (reduced));
+
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+ rszk = ffeinfo_size (rinfo); /* Known size. */
+ rszm = ffebld_size_max (ffebld_right (reduced));
+
+ if ((lbt == FFEINFO_basictypeCHARACTER) && (rbt == FFEINFO_basictypeCHARACTER)
+ && (lkt == rkt) && (lrk == 0) && (rrk == 0)
+ && (((lszm != FFETARGET_charactersizeNONE)
+ && (rszm != FFETARGET_charactersizeNONE))
+ || (ffeexpr_context_outer_ (ffeexpr_stack_)
+ == FFEEXPR_contextLET)
+ || (ffeexpr_context_outer_ (ffeexpr_stack_)
+ == FFEEXPR_contextSFUNCDEF)))
+ {
+ nbt = FFEINFO_basictypeCHARACTER;
+ nkd = FFEINFO_kindENTITY;
+ if ((lszk == FFETARGET_charactersizeNONE)
+ || (rszk == FFETARGET_charactersizeNONE))
+ nszk = FFETARGET_charactersizeNONE; /* Ok only in rhs of LET
+ stmt. */
+ else
+ nszk = lszk + rszk;
+
+ switch (lwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ nwh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ nkt = lkt;
+ ninfo = ffeinfo_new (nbt, nkt, 0, nkd, nwh, nszk);
+ ffebld_set_info (reduced, ninfo);
+ return reduced;
+ }
+
+ if ((lbt != FFEINFO_basictypeCHARACTER) && (rbt != FFEINFO_basictypeCHARACTER))
+ {
+ if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_CONCAT_ARGS_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else if (lbt != FFEINFO_basictypeCHARACTER)
+ {
+ if ((lbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_CONCAT_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_finish ();
+ }
+ }
+ else if (rbt != FFEINFO_basictypeCHARACTER)
+ {
+ if ((rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_CONCAT_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else if ((lrk != 0) || (lszm == FFETARGET_charactersizeNONE))
+ {
+ if ((lkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_CONCAT_ARG_KIND))
+ {
+ char *what;
+
+ if (lrk != 0)
+ what = "an array";
+ else
+ what = "of indeterminate length";
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_string (what);
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if (ffebad_start (FFEBAD_CONCAT_ARG_KIND))
+ {
+ char *what;
+
+ if (rrk != 0)
+ what = "an array";
+ else
+ what = "of indeterminate length";
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_string (what);
+ ffebad_finish ();
+ }
+ }
+
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ return reduced;
+}
+
+/* ffeexpr_reduced_eqop2_ -- Wrap up reduction of EQ and NE operators
+
+ reduced = ffeexpr_reduced_eqop2_(reduced,l,op,r);
+
+ Makes sure the left and right arguments for reduced have basictype of
+ INTEGER, REAL, COMPLEX, or CHARACTER. Determine common basictype and
+ size for reduction. If both left
+ and right arguments have where of CONSTANT, assign where CONSTANT to
+ reduced, else assign where FLEETING. Create CONVERT ops for args where
+ needed. Convert typeless
+ constants to the desired type/size explicitly.
+
+ If these requirements cannot be met, generate error message. */
+
+static ffebld
+ffeexpr_reduced_eqop2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+ ffeexprExpr_ r)
+{
+ ffeinfo linfo, rinfo, ninfo;
+ ffeinfoBasictype lbt, rbt, nbt;
+ ffeinfoKindtype lkt, rkt, nkt;
+ ffeinfoRank lrk, rrk;
+ ffeinfoKind lkd, rkd;
+ ffeinfoWhere lwh, rwh, nwh;
+ ffetargetCharacterSize lsz, rsz;
+
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+ lsz = ffebld_size_known (ffebld_left (reduced));
+
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+ rsz = ffebld_size_known (ffebld_right (reduced));
+
+ ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+ if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
+ || (nbt == FFEINFO_basictypeCOMPLEX) || (nbt == FFEINFO_basictypeCHARACTER))
+ && (lrk == 0) && (rrk == 0))
+ {
+ switch (lwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ nwh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ if ((lsz != FFETARGET_charactersizeNONE)
+ && (rsz != FFETARGET_charactersizeNONE))
+ lsz = rsz = (lsz > rsz) ? lsz : rsz;
+
+ ninfo = ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
+ 0, FFEINFO_kindENTITY, nwh, FFETARGET_charactersizeNONE);
+ ffebld_set_info (reduced, ninfo);
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, nbt, nkt, 0, lsz,
+ FFEEXPR_contextLET));
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, nbt, nkt, 0, rsz,
+ FFEEXPR_contextLET));
+ return reduced;
+ }
+
+ if ((lbt == FFEINFO_basictypeLOGICAL)
+ && (rbt == FFEINFO_basictypeLOGICAL))
+ {
+ if (ffebad_start_msg ("Use .EQV./.NEQV. instead of .EQ./.NE. at %0 for LOGICAL operands at %1 and %2",
+ FFEBAD_severityFATAL))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
+ && (lbt != FFEINFO_basictypeCOMPLEX) && (lbt != FFEINFO_basictypeCHARACTER))
+ {
+ if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+ && (rbt != FFEINFO_basictypeCOMPLEX) && (lbt != FFEINFO_basictypeCHARACTER))
+ {
+ if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_EQOP_ARGS_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((lbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_EQOP_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_finish ();
+ }
+ }
+ }
+ else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+ && (rbt != FFEINFO_basictypeCOMPLEX) && (rbt != FFEINFO_basictypeCHARACTER))
+ {
+ if ((rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_EQOP_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else if (lrk != 0)
+ {
+ if ((lkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_EQOP_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((rkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_EQOP_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ return reduced;
+}
+
+/* ffeexpr_reduced_math1_ -- Wrap up reduction of + - unary operators
+
+ reduced = ffeexpr_reduced_math1_(reduced,op,r);
+
+ Makes sure the argument for reduced has basictype of
+ INTEGER, REAL, or COMPLEX. If the argument has where of CONSTANT,
+ assign where CONSTANT to
+ reduced, else assign where FLEETING.
+
+ If these requirements cannot be met, generate error message. */
+
+static ffebld
+ffeexpr_reduced_math1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
+{
+ ffeinfo rinfo, ninfo;
+ ffeinfoBasictype rbt;
+ ffeinfoKindtype rkt;
+ ffeinfoRank rrk;
+ ffeinfoKind rkd;
+ ffeinfoWhere rwh, nwh;
+
+ rinfo = ffebld_info (ffebld_left (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ if (((rbt == FFEINFO_basictypeINTEGER) || (rbt == FFEINFO_basictypeREAL)
+ || (rbt == FFEINFO_basictypeCOMPLEX)) && (rrk == 0))
+ {
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ nwh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ ninfo = ffeinfo_new (rbt, rkt, 0, FFEINFO_kindENTITY, nwh,
+ FFETARGET_charactersizeNONE);
+ ffebld_set_info (reduced, ninfo);
+ return reduced;
+ }
+
+ if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+ && (rbt != FFEINFO_basictypeCOMPLEX))
+ {
+ if ((rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((rkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_MATH_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ return reduced;
+}
+
+/* ffeexpr_reduced_math2_ -- Wrap up reduction of + - * / operators
+
+ reduced = ffeexpr_reduced_math2_(reduced,l,op,r);
+
+ Makes sure the left and right arguments for reduced have basictype of
+ INTEGER, REAL, or COMPLEX. Determine common basictype and
+ size for reduction (flag expression for combined hollerith/typeless
+ situations for later determination of effective basictype). If both left
+ and right arguments have where of CONSTANT, assign where CONSTANT to
+ reduced, else assign where FLEETING. Create CONVERT ops for args where
+ needed. Convert typeless
+ constants to the desired type/size explicitly.
+
+ If these requirements cannot be met, generate error message. */
+
+static ffebld
+ffeexpr_reduced_math2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+ ffeexprExpr_ r)
+{
+ ffeinfo linfo, rinfo, ninfo;
+ ffeinfoBasictype lbt, rbt, nbt;
+ ffeinfoKindtype lkt, rkt, nkt;
+ ffeinfoRank lrk, rrk;
+ ffeinfoKind lkd, rkd;
+ ffeinfoWhere lwh, rwh, nwh;
+
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+ if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
+ || (nbt == FFEINFO_basictypeCOMPLEX)) && (lrk == 0) && (rrk == 0))
+ {
+ switch (lwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ nwh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
+ FFETARGET_charactersizeNONE);
+ ffebld_set_info (reduced, ninfo);
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ return reduced;
+ }
+
+ if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
+ && (lbt != FFEINFO_basictypeCOMPLEX))
+ {
+ if ((rbt != FFEINFO_basictypeINTEGER)
+ && (rbt != FFEINFO_basictypeREAL) && (rbt != FFEINFO_basictypeCOMPLEX))
+ {
+ if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_MATH_ARGS_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((lbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_finish ();
+ }
+ }
+ }
+ else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+ && (rbt != FFEINFO_basictypeCOMPLEX))
+ {
+ if ((rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else if (lrk != 0)
+ {
+ if ((lkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_MATH_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((rkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_MATH_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ return reduced;
+}
+
+/* ffeexpr_reduced_power_ -- Wrap up reduction of ** operator
+
+ reduced = ffeexpr_reduced_power_(reduced,l,op,r);
+
+ Makes sure the left and right arguments for reduced have basictype of
+ INTEGER, REAL, or COMPLEX. Determine common basictype and
+ size for reduction (flag expression for combined hollerith/typeless
+ situations for later determination of effective basictype). If both left
+ and right arguments have where of CONSTANT, assign where CONSTANT to
+ reduced, else assign where FLEETING. Create CONVERT ops for args where
+ needed. Note that real**int or complex**int
+ comes out as int = real**int etc with no conversions.
+
+ If these requirements cannot be met, generate error message using the
+ info in l, op, and r arguments and assign basictype, size, kind, and where
+ of ANY. */
+
+static ffebld
+ffeexpr_reduced_power_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+ ffeexprExpr_ r)
+{
+ ffeinfo linfo, rinfo, ninfo;
+ ffeinfoBasictype lbt, rbt, nbt;
+ ffeinfoKindtype lkt, rkt, nkt;
+ ffeinfoRank lrk, rrk;
+ ffeinfoKind lkd, rkd;
+ ffeinfoWhere lwh, rwh, nwh;
+
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ if ((rbt == FFEINFO_basictypeINTEGER)
+ && ((lbt == FFEINFO_basictypeREAL)
+ || (lbt == FFEINFO_basictypeCOMPLEX)))
+ {
+ nbt = lbt;
+ nkt = ffeinfo_kindtype_max (nbt, lkt, FFEINFO_kindtypeREALDEFAULT);
+ if (nkt != FFEINFO_kindtypeREALDEFAULT)
+ {
+ nkt = ffeinfo_kindtype_max (nbt, lkt, FFEINFO_kindtypeREALDOUBLE);
+ if (nkt != FFEINFO_kindtypeREALDOUBLE)
+ nkt = FFEINFO_kindtypeREALDOUBLE; /* Highest kt we can power! */
+ }
+ if (rkt == FFEINFO_kindtypeINTEGER4)
+ {
+ ffebad_start_msg ("Unsupported operand for ** at %1 -- converting to default INTEGER",
+ FFEBAD_severityWARNING);
+ ffebad_here (0, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ if (rkt != FFEINFO_kindtypeINTEGERDEFAULT)
+ {
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token,
+ FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ rkt = FFEINFO_kindtypeINTEGERDEFAULT;
+ }
+ }
+ else
+ {
+ ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+#if 0 /* INTEGER4**INTEGER4 works now. */
+ if ((nbt == FFEINFO_basictypeINTEGER)
+ && (nkt != FFEINFO_kindtypeINTEGERDEFAULT))
+ nkt = FFEINFO_kindtypeINTEGERDEFAULT; /* Highest kt we can power! */
+#endif
+ if (((nbt == FFEINFO_basictypeREAL)
+ || (nbt == FFEINFO_basictypeCOMPLEX))
+ && (nkt != FFEINFO_kindtypeREALDEFAULT))
+ {
+ nkt = ffeinfo_kindtype_max (nbt, nkt, FFEINFO_kindtypeREALDOUBLE);
+ if (nkt != FFEINFO_kindtypeREALDOUBLE)
+ nkt = FFEINFO_kindtypeREALDOUBLE; /* Highest kt we can power! */
+ }
+ /* else Gonna turn into an error below. */
+ }
+
+ if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
+ || (nbt == FFEINFO_basictypeCOMPLEX)) && (lrk == 0) && (rrk == 0))
+ {
+ switch (lwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ nwh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
+ FFETARGET_charactersizeNONE);
+ ffebld_set_info (reduced, ninfo);
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ if (rbt != FFEINFO_basictypeINTEGER)
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ return reduced;
+ }
+
+ if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
+ && (lbt != FFEINFO_basictypeCOMPLEX))
+ {
+ if ((rbt != FFEINFO_basictypeINTEGER)
+ && (rbt != FFEINFO_basictypeREAL) && (rbt != FFEINFO_basictypeCOMPLEX))
+ {
+ if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_MATH_ARGS_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((lbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_finish ();
+ }
+ }
+ }
+ else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+ && (rbt != FFEINFO_basictypeCOMPLEX))
+ {
+ if ((rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else if (lrk != 0)
+ {
+ if ((lkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_MATH_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((rkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_MATH_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ return reduced;
+}
+
+/* ffeexpr_reduced_relop2_ -- Wrap up reduction of LT, LE, GE, and GT operators
+
+ reduced = ffeexpr_reduced_relop2_(reduced,l,op,r);
+
+ Makes sure the left and right arguments for reduced have basictype of
+ INTEGER, REAL, or CHARACTER. Determine common basictype and
+ size for reduction. If both left
+ and right arguments have where of CONSTANT, assign where CONSTANT to
+ reduced, else assign where FLEETING. Create CONVERT ops for args where
+ needed. Convert typeless
+ constants to the desired type/size explicitly.
+
+ If these requirements cannot be met, generate error message. */
+
+static ffebld
+ffeexpr_reduced_relop2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+ ffeexprExpr_ r)
+{
+ ffeinfo linfo, rinfo, ninfo;
+ ffeinfoBasictype lbt, rbt, nbt;
+ ffeinfoKindtype lkt, rkt, nkt;
+ ffeinfoRank lrk, rrk;
+ ffeinfoKind lkd, rkd;
+ ffeinfoWhere lwh, rwh, nwh;
+ ffetargetCharacterSize lsz, rsz;
+
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+ lsz = ffebld_size_known (ffebld_left (reduced));
+
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+ rsz = ffebld_size_known (ffebld_right (reduced));
+
+ ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+ if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
+ || (nbt == FFEINFO_basictypeCHARACTER))
+ && (lrk == 0) && (rrk == 0))
+ {
+ switch (lwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ nwh = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereIMMEDIATE:
+ nwh = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ default:
+ nwh = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ if ((lsz != FFETARGET_charactersizeNONE)
+ && (rsz != FFETARGET_charactersizeNONE))
+ lsz = rsz = (lsz > rsz) ? lsz : rsz;
+
+ ninfo = ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
+ 0, FFEINFO_kindENTITY, nwh, FFETARGET_charactersizeNONE);
+ ffebld_set_info (reduced, ninfo);
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, nbt, nkt, 0, lsz,
+ FFEEXPR_contextLET));
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, nbt, nkt, 0, rsz,
+ FFEEXPR_contextLET));
+ return reduced;
+ }
+
+ if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
+ && (lbt != FFEINFO_basictypeCHARACTER))
+ {
+ if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+ && (lbt != FFEINFO_basictypeCHARACTER))
+ {
+ if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_RELOP_ARGS_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((lbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_RELOP_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_finish ();
+ }
+ }
+ }
+ else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+ && (rbt != FFEINFO_basictypeCHARACTER))
+ {
+ if ((rbt != FFEINFO_basictypeANY)
+ && ffebad_start (FFEBAD_RELOP_ARG_TYPE))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_finish ();
+ }
+ }
+ else if (lrk != 0)
+ {
+ if ((lkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_RELOP_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if ((rkd != FFEINFO_kindANY)
+ && ffebad_start (FFEBAD_RELOP_ARG_KIND))
+ {
+ ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+ ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+ ffebad_string ("an array");
+ ffebad_finish ();
+ }
+ }
+
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ return reduced;
+}
+
+/* ffeexpr_reduced_ugly1_ -- Deal with TYPELESS, HOLLERITH, and LOGICAL
+
+ reduced = ffeexpr_reduced_ugly1_(reduced,op,r);
+
+ Sigh. */
+
+static ffebld
+ffeexpr_reduced_ugly1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
+{
+ ffeinfo rinfo;
+ ffeinfoBasictype rbt;
+ ffeinfoKindtype rkt;
+ ffeinfoRank rrk;
+ ffeinfoKind rkd;
+ ffeinfoWhere rwh;
+
+ rinfo = ffebld_info (ffebld_left (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ if ((rbt == FFEINFO_basictypeTYPELESS)
+ || (rbt == FFEINFO_basictypeHOLLERITH))
+ {
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ r->token, op->token, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ rinfo = ffebld_info (ffebld_left (reduced));
+ rbt = FFEINFO_basictypeINTEGER;
+ rkt = FFEINFO_kindtypeINTEGERDEFAULT;
+ rrk = 0;
+ rkd = FFEINFO_kindENTITY;
+ rwh = ffeinfo_where (rinfo);
+ }
+
+ if (rbt == FFEINFO_basictypeLOGICAL)
+ {
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ r->token, op->token, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ }
+
+ return reduced;
+}
+
+/* ffeexpr_reduced_ugly1log_ -- Deal with TYPELESS and HOLLERITH
+
+ reduced = ffeexpr_reduced_ugly1log_(reduced,op,r);
+
+ Sigh. */
+
+static ffebld
+ffeexpr_reduced_ugly1log_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
+{
+ ffeinfo rinfo;
+ ffeinfoBasictype rbt;
+ ffeinfoKindtype rkt;
+ ffeinfoRank rrk;
+ ffeinfoKind rkd;
+ ffeinfoWhere rwh;
+
+ rinfo = ffebld_info (ffebld_left (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ if ((rbt == FFEINFO_basictypeTYPELESS)
+ || (rbt == FFEINFO_basictypeHOLLERITH))
+ {
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ r->token, op->token, FFEINFO_basictypeLOGICAL, 0,
+ FFEINFO_kindtypeLOGICALDEFAULT,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ rinfo = ffebld_info (ffebld_left (reduced));
+ rbt = FFEINFO_basictypeLOGICAL;
+ rkt = FFEINFO_kindtypeLOGICALDEFAULT;
+ rrk = 0;
+ rkd = FFEINFO_kindENTITY;
+ rwh = ffeinfo_where (rinfo);
+ }
+
+ return reduced;
+}
+
+/* ffeexpr_reduced_ugly2_ -- Deal with TYPELESS, HOLLERITH, and LOGICAL
+
+ reduced = ffeexpr_reduced_ugly2_(reduced,l,op,r);
+
+ Sigh. */
+
+static ffebld
+ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+ ffeexprExpr_ r)
+{
+ ffeinfo linfo, rinfo;
+ ffeinfoBasictype lbt, rbt;
+ ffeinfoKindtype lkt, rkt;
+ ffeinfoRank lrk, rrk;
+ ffeinfoKind lkd, rkd;
+ ffeinfoWhere lwh, rwh;
+
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ if ((lbt == FFEINFO_basictypeTYPELESS)
+ || (lbt == FFEINFO_basictypeHOLLERITH))
+ {
+ if ((rbt == FFEINFO_basictypeTYPELESS)
+ || (rbt == FFEINFO_basictypeHOLLERITH))
+ {
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, FFEINFO_basictypeINTEGER, 0,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ linfo = ffebld_info (ffebld_left (reduced));
+ rinfo = ffebld_info (ffebld_right (reduced));
+ lbt = rbt = FFEINFO_basictypeINTEGER;
+ lkt = rkt = FFEINFO_kindtypeINTEGERDEFAULT;
+ lrk = rrk = 0;
+ lkd = rkd = FFEINFO_kindENTITY;
+ lwh = ffeinfo_where (linfo);
+ rwh = ffeinfo_where (rinfo);
+ }
+ else
+ {
+ ffebld_set_left (reduced, ffeexpr_convert_expr (ffebld_left (reduced),
+ l->token, ffebld_right (reduced), r->token,
+ FFEEXPR_contextLET));
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+ }
+ }
+ else
+ {
+ if ((rbt == FFEINFO_basictypeTYPELESS)
+ || (rbt == FFEINFO_basictypeHOLLERITH))
+ {
+ ffebld_set_right (reduced, ffeexpr_convert_expr (ffebld_right (reduced),
+ r->token, ffebld_left (reduced), l->token,
+ FFEEXPR_contextLET));
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+ }
+ /* else Leave it alone. */
+ }
+
+ if (lbt == FFEINFO_basictypeLOGICAL)
+ {
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ }
+
+ if (rbt == FFEINFO_basictypeLOGICAL)
+ {
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ }
+
+ return reduced;
+}
+
+/* ffeexpr_reduced_ugly2log_ -- Deal with TYPELESS and HOLLERITH
+
+ reduced = ffeexpr_reduced_ugly2log_(reduced,l,op,r);
+
+ Sigh. */
+
+static ffebld
+ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+ ffeexprExpr_ r)
+{
+ ffeinfo linfo, rinfo;
+ ffeinfoBasictype lbt, rbt;
+ ffeinfoKindtype lkt, rkt;
+ ffeinfoRank lrk, rrk;
+ ffeinfoKind lkd, rkd;
+ ffeinfoWhere lwh, rwh;
+
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+
+ if ((lbt == FFEINFO_basictypeTYPELESS)
+ || (lbt == FFEINFO_basictypeHOLLERITH))
+ {
+ if ((rbt == FFEINFO_basictypeTYPELESS)
+ || (rbt == FFEINFO_basictypeHOLLERITH))
+ {
+ ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+ l->token, op->token, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+ r->token, op->token, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET));
+ linfo = ffebld_info (ffebld_left (reduced));
+ rinfo = ffebld_info (ffebld_right (reduced));
+ lbt = rbt = FFEINFO_basictypeLOGICAL;
+ lkt = rkt = FFEINFO_kindtypeLOGICALDEFAULT;
+ lrk = rrk = 0;
+ lkd = rkd = FFEINFO_kindENTITY;
+ lwh = ffeinfo_where (linfo);
+ rwh = ffeinfo_where (rinfo);
+ }
+ else
+ {
+ ffebld_set_left (reduced, ffeexpr_convert_expr (ffebld_left (reduced),
+ l->token, ffebld_right (reduced), r->token,
+ FFEEXPR_contextLET));
+ linfo = ffebld_info (ffebld_left (reduced));
+ lbt = ffeinfo_basictype (linfo);
+ lkt = ffeinfo_kindtype (linfo);
+ lrk = ffeinfo_rank (linfo);
+ lkd = ffeinfo_kind (linfo);
+ lwh = ffeinfo_where (linfo);
+ }
+ }
+ else
+ {
+ if ((rbt == FFEINFO_basictypeTYPELESS)
+ || (rbt == FFEINFO_basictypeHOLLERITH))
+ {
+ ffebld_set_right (reduced, ffeexpr_convert_expr (ffebld_right (reduced),
+ r->token, ffebld_left (reduced), l->token,
+ FFEEXPR_contextLET));
+ rinfo = ffebld_info (ffebld_right (reduced));
+ rbt = ffeinfo_basictype (rinfo);
+ rkt = ffeinfo_kindtype (rinfo);
+ rrk = ffeinfo_rank (rinfo);
+ rkd = ffeinfo_kind (rinfo);
+ rwh = ffeinfo_where (rinfo);
+ }
+ /* else Leave it alone. */
+ }
+
+ return reduced;
+}
+
+/* Fumble through tokens until a nonmatching CLOSE_PAREN, EOS, or SEMICOLON
+ is found.
+
+ The idea is to process the tokens as they would be done by normal
+ expression processing, with the key things being telling the lexer
+ when hollerith/character constants are about to happen, until the
+ true closing token is found. */
+
+static ffelexHandler
+ffeexpr_find_close_paren_ (ffelexToken t,
+ ffelexHandler after)
+{
+ ffeexpr_find_.after = after;
+ ffeexpr_find_.level = 1;
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+}
+
+static ffelexHandler
+ffeexpr_nil_finished_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (--ffeexpr_find_.level == 0)
+ return (ffelexHandler) ffeexpr_find_.after;
+ return (ffelexHandler) ffeexpr_nil_binary_;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLON:
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+
+ default:
+ if (--ffeexpr_find_.level == 0)
+ return (ffelexHandler) ffeexpr_find_.after (t);
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+ }
+}
+
+static ffelexHandler
+ffeexpr_nil_rhs_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeQUOTE:
+ if (ffe_is_vxt ())
+ return (ffelexHandler) ffeexpr_nil_quote_;
+ ffelex_set_expecting_hollerith (-1, '\"',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ return (ffelexHandler) ffeexpr_nil_apostrophe_;
+
+ case FFELEX_typeAPOSTROPHE:
+ ffelex_set_expecting_hollerith (-1, '\'',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ return (ffelexHandler) ffeexpr_nil_apostrophe_;
+
+ case FFELEX_typePERCENT:
+ return (ffelexHandler) ffeexpr_nil_percent_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ++ffeexpr_find_.level;
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+
+ case FFELEX_typePLUS:
+ case FFELEX_typeMINUS:
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+
+ case FFELEX_typePERIOD:
+ return (ffelexHandler) ffeexpr_nil_period_;
+
+ case FFELEX_typeNUMBER:
+ ffeexpr_hollerith_count_ = atol (ffelex_token_text (t));
+ if (ffeexpr_hollerith_count_ > 0)
+ ffelex_set_expecting_hollerith (ffeexpr_hollerith_count_,
+ '\0',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ return (ffelexHandler) ffeexpr_nil_number_;
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ return (ffelexHandler) ffeexpr_nil_name_rhs_;
+
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSLASH:
+ case FFELEX_typePOWER:
+ case FFELEX_typeCONCAT:
+ case FFELEX_typeREL_EQ:
+ case FFELEX_typeREL_NE:
+ case FFELEX_typeREL_LE:
+ case FFELEX_typeREL_GE:
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_finished_ (t);
+ }
+}
+
+static ffelexHandler
+ffeexpr_nil_period_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t);
+ switch (ffeexpr_current_dotdot_)
+ {
+ case FFEEXPR_dotdotNONE_:
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+
+ case FFEEXPR_dotdotTRUE_:
+ case FFEEXPR_dotdotFALSE_:
+ case FFEEXPR_dotdotNOT_:
+ return (ffelexHandler) ffeexpr_nil_end_period_;
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_swallow_period_;
+ }
+ break; /* Nothing really reaches here. */
+
+ case FFELEX_typeNUMBER:
+ return (ffelexHandler) ffeexpr_nil_real_;
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+ }
+}
+
+static ffelexHandler
+ffeexpr_nil_end_period_ (ffelexToken t)
+{
+ switch (ffeexpr_current_dotdot_)
+ {
+ case FFEEXPR_dotdotNOT_:
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+
+ case FFEEXPR_dotdotTRUE_:
+ case FFEEXPR_dotdotFALSE_:
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+ return (ffelexHandler) ffeexpr_nil_binary_;
+
+ default:
+ assert ("Bad [nil] unary dotdot in ffeexpr_current_dotdot_" == NULL);
+ exit (0);
+ return NULL;
+ }
+}
+
+static ffelexHandler
+ffeexpr_nil_swallow_period_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+}
+
+static ffelexHandler
+ffeexpr_nil_real_ (ffelexToken t)
+{
+ char d;
+ char *p;
+
+ if (((ffelex_token_type (t) != FFELEX_typeNAME)
+ && (ffelex_token_type (t) != FFELEX_typeNAMES))
+ || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+ 'D', 'd')
+ || ffesrc_char_match_init (d, 'E', 'e')
+ || ffesrc_char_match_init (d, 'Q', 'q')))
+ && ffeexpr_isdigits_ (++p)))
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+ if (*p == '\0')
+ return (ffelexHandler) ffeexpr_nil_real_exponent_;
+ return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_real_exponent_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) != FFELEX_typePLUS)
+ && (ffelex_token_type (t) != FFELEX_typeMINUS))
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+ return (ffelexHandler) ffeexpr_nil_real_exp_sign_;
+}
+
+static ffelexHandler
+ffeexpr_nil_real_exp_sign_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+ return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_number_ (ffelexToken t)
+{
+ char d;
+ char *p;
+
+ if (ffeexpr_hollerith_count_ > 0)
+ ffelex_set_expecting_hollerith (0, '\0',
+ ffewhere_line_unknown (),
+ ffewhere_column_unknown ());
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+ 'D', 'd')
+ || ffesrc_char_match_init (d, 'E', 'e')
+ || ffesrc_char_match_init (d, 'Q', 'q'))
+ && ffeexpr_isdigits_ (++p))
+ {
+ if (*p == '\0')
+ {
+ ffeexpr_find_.t = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_nil_number_exponent_;
+ }
+ return (ffelexHandler) ffeexpr_nil_binary_;
+ }
+ break;
+
+ case FFELEX_typePERIOD:
+ ffeexpr_find_.t = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_nil_number_period_;
+
+ case FFELEX_typeHOLLERITH:
+ return (ffelexHandler) ffeexpr_nil_binary_;
+
+ default:
+ break;
+ }
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+}
+
+/* Expects ffeexpr_find_.t. */
+
+static ffelexHandler
+ffeexpr_nil_number_exponent_ (ffelexToken t)
+{
+ ffelexHandler nexthandler;
+
+ if ((ffelex_token_type (t) != FFELEX_typePLUS)
+ && (ffelex_token_type (t) != FFELEX_typeMINUS))
+ {
+ nexthandler
+ = (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) (*nexthandler) (t);
+ }
+
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) ffeexpr_nil_number_exp_sign_;
+}
+
+static ffelexHandler
+ffeexpr_nil_number_exp_sign_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+ return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+/* Expects ffeexpr_find_.t. */
+
+static ffelexHandler
+ffeexpr_nil_number_period_ (ffelexToken t)
+{
+ ffelexHandler nexthandler;
+ char d;
+ char *p;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+ 'D', 'd')
+ || ffesrc_char_match_init (d, 'E', 'e')
+ || ffesrc_char_match_init (d, 'Q', 'q'))
+ && ffeexpr_isdigits_ (++p))
+ {
+ if (*p == '\0')
+ return (ffelexHandler) ffeexpr_nil_number_per_exp_;
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) ffeexpr_nil_binary_;
+ }
+ nexthandler
+ = (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) (*nexthandler) (t);
+
+ case FFELEX_typeNUMBER:
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) ffeexpr_nil_number_real_;
+
+ default:
+ break;
+ }
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+}
+
+/* Expects ffeexpr_find_.t. */
+
+static ffelexHandler
+ffeexpr_nil_number_per_exp_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) != FFELEX_typePLUS)
+ && (ffelex_token_type (t) != FFELEX_typeMINUS))
+ {
+ ffelexHandler nexthandler;
+
+ nexthandler
+ = (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) (*nexthandler) (t);
+ }
+
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) ffeexpr_nil_num_per_exp_sign_;
+}
+
+static ffelexHandler
+ffeexpr_nil_number_real_ (ffelexToken t)
+{
+ char d;
+ char *p;
+
+ if (((ffelex_token_type (t) != FFELEX_typeNAME)
+ && (ffelex_token_type (t) != FFELEX_typeNAMES))
+ || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+ 'D', 'd')
+ || ffesrc_char_match_init (d, 'E', 'e')
+ || ffesrc_char_match_init (d, 'Q', 'q')))
+ && ffeexpr_isdigits_ (++p)))
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+ if (*p == '\0')
+ return (ffelexHandler) ffeexpr_nil_number_real_exp_;
+
+ return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_num_per_exp_sign_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+ return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_number_real_exp_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) != FFELEX_typePLUS)
+ && (ffelex_token_type (t) != FFELEX_typeMINUS))
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+ return (ffelexHandler) ffeexpr_nil_num_real_exp_sn_;
+}
+
+static ffelexHandler
+ffeexpr_nil_num_real_exp_sn_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+ return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_binary_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePLUS:
+ case FFELEX_typeMINUS:
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSLASH:
+ case FFELEX_typePOWER:
+ case FFELEX_typeCONCAT:
+ case FFELEX_typeOPEN_ANGLE:
+ case FFELEX_typeCLOSE_ANGLE:
+ case FFELEX_typeREL_EQ:
+ case FFELEX_typeREL_NE:
+ case FFELEX_typeREL_GE:
+ case FFELEX_typeREL_LE:
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+
+ case FFELEX_typePERIOD:
+ return (ffelexHandler) ffeexpr_nil_binary_period_;
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_finished_ (t);
+ }
+}
+
+static ffelexHandler
+ffeexpr_nil_binary_period_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t);
+ switch (ffeexpr_current_dotdot_)
+ {
+ case FFEEXPR_dotdotTRUE_:
+ case FFEEXPR_dotdotFALSE_:
+ case FFEEXPR_dotdotNOT_:
+ return (ffelexHandler) ffeexpr_nil_binary_sw_per_;
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_binary_end_per_;
+ }
+ break; /* Nothing really reaches here. */
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+ }
+}
+
+static ffelexHandler
+ffeexpr_nil_binary_end_per_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+}
+
+static ffelexHandler
+ffeexpr_nil_binary_sw_per_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+ return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_quote_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+ return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_apostrophe_ (ffelexToken t)
+{
+ assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
+ return (ffelexHandler) ffeexpr_nil_apos_char_;
+}
+
+static ffelexHandler
+ffeexpr_nil_apos_char_ (ffelexToken t)
+{
+ char c;
+
+ if ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNAMES))
+ {
+ if ((ffelex_token_length (t) == 1)
+ && (ffesrc_char_match_init ((c = ffelex_token_text (t)[0]),
+ 'B', 'b')
+ || ffesrc_char_match_init (c, 'O', 'o')
+ || ffesrc_char_match_init (c, 'X', 'x')
+ || ffesrc_char_match_init (c, 'Z', 'z')))
+ return (ffelexHandler) ffeexpr_nil_binary_;
+ }
+ if ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNAMES))
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+ return (ffelexHandler) ffeexpr_nil_substrp_ (t);
+}
+
+static ffelexHandler
+ffeexpr_nil_name_rhs_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeQUOTE:
+ case FFELEX_typeAPOSTROPHE:
+ ffelex_set_hexnum (TRUE);
+ return (ffelexHandler) ffeexpr_nil_name_apos_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ++ffeexpr_find_.level;
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+ }
+}
+
+static ffelexHandler
+ffeexpr_nil_name_apos_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ return (ffelexHandler) ffeexpr_nil_name_apos_name_;
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+}
+
+static ffelexHandler
+ffeexpr_nil_name_apos_name_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ return (ffelexHandler) ffeexpr_nil_finished_;
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_finished_ (t);
+ }
+}
+
+static ffelexHandler
+ffeexpr_nil_percent_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffeexpr_stack_->percent = ffeexpr_percent_ (t);
+ ffeexpr_find_.t = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_nil_percent_name_;
+
+ default:
+ return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+ }
+}
+
+/* Expects ffeexpr_find_.t. */
+
+static ffelexHandler
+ffeexpr_nil_percent_name_ (ffelexToken t)
+{
+ ffelexHandler nexthandler;
+
+ if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
+ {
+ nexthandler
+ = (ffelexHandler) ffeexpr_nil_rhs_ (ffeexpr_find_.t);
+ ffelex_token_kill (ffeexpr_find_.t);
+ return (ffelexHandler) (*nexthandler) (t);
+ }
+
+ ffelex_token_kill (ffeexpr_find_.t);
+ ++ffeexpr_find_.level;
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+}
+
+static ffelexHandler
+ffeexpr_nil_substrp_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
+ return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+ ++ffeexpr_find_.level;
+ return (ffelexHandler) ffeexpr_nil_rhs_;
+}
+
+/* ffeexpr_finished_ -- Reduce expression stack to one expr, finish
+
+ ffelexToken t;
+ return ffeexpr_finished_(t);
+
+ Reduces expression stack to one (or zero) elements by repeatedly reducing
+ the top operator on the stack (or, if the top element on the stack is
+ itself an operator, issuing an error message and discarding it). Calls
+ finishing routine with the expression, returning the ffelexHandler it
+ returns to the caller. */
+
+static ffelexHandler
+ffeexpr_finished_ (ffelexToken t)
+{
+ ffeexprExpr_ operand; /* This is B in -B or A+B. */
+ ffebld expr;
+ ffeexprCallback callback;
+ ffeexprStack_ s;
+ ffebldConstant constnode; /* For detecting magical number. */
+ ffelexToken ft; /* Temporary copy of first token in
+ expression. */
+ ffelexHandler next;
+ ffeinfo info;
+ bool error = FALSE;
+
+ while (((operand = ffeexpr_stack_->exprstack) != NULL)
+ && ((operand->previous != NULL) || (operand->type != FFEEXPR_exprtypeOPERAND_)))
+ {
+ if (operand->type == FFEEXPR_exprtypeOPERAND_)
+ ffeexpr_reduce_ ();
+ else
+ {
+ if (ffest_ffebad_start (FFEBAD_MISSING_OPERAND_FOR_OPERATOR))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+ ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+ ffebad_finish ();
+ }
+ ffeexpr_stack_->exprstack = operand->previous; /* Pop the useless
+ operator. */
+ ffeexpr_expr_kill_ (operand);
+ }
+ }
+
+ assert ((operand == NULL) || (operand->previous == NULL));
+
+ ffebld_pool_pop ();
+ if (operand == NULL)
+ expr = NULL;
+ else
+ {
+ expr = operand->u.operand;
+ info = ffebld_info (expr);
+ if ((ffebld_op (expr) == FFEBLD_opCONTER)
+ && (ffebld_conter_orig (expr) == NULL)
+ && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
+ {
+ ffetarget_integer_bad_magical (operand->token);
+ }
+ ffeexpr_expr_kill_ (operand);
+ ffeexpr_stack_->exprstack = NULL;
+ }
+
+ ft = ffeexpr_stack_->first_token;
+
+again: /* :::::::::::::::::::: */
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextLET:
+ case FFEEXPR_contextSFUNCDEF:
+ error = (expr == NULL)
+ || (ffeinfo_rank (info) != 0);
+ break;
+
+ case FFEEXPR_contextPAREN_:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextPARENFILENUM_:
+ if (ffelex_token_type (t) != FFELEX_typeCOMMA)
+ ffeexpr_stack_->context = FFEEXPR_contextPAREN_;
+ else
+ ffeexpr_stack_->context = FFEEXPR_contextFILENUM;
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextPARENFILEUNIT_:
+ if (ffelex_token_type (t) != FFELEX_typeCOMMA)
+ ffeexpr_stack_->context = FFEEXPR_contextPAREN_;
+ else
+ ffeexpr_stack_->context = FFEEXPR_contextFILEUNIT;
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ if (!ffe_is_ugly_args ()
+ && ffebad_start (FFEBAD_ACTUALARG))
+ {
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ }
+ break;
+
+ default:
+ break;
+ }
+ error = ((expr == NULL) && ffe_is_pedantic ())
+ || ((expr != NULL) && (ffeinfo_rank (info) != 0));
+ break;
+
+ case FFEEXPR_contextACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+#if 0 /* Should never get here. */
+ expr = ffeexpr_convert (expr, ft, ft,
+ FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+#else
+ assert ("why hollerith/typeless in actualarg_?" == NULL);
+#endif
+ break;
+
+ default:
+ break;
+ }
+ switch ((expr == NULL) ? FFEBLD_opANY : ffebld_op (expr))
+ {
+ case FFEBLD_opSYMTER:
+ case FFEBLD_opPERCENT_LOC:
+ case FFEBLD_opPERCENT_VAL:
+ case FFEBLD_opPERCENT_REF:
+ case FFEBLD_opPERCENT_DESCR:
+ error = FALSE;
+ break;
+
+ default:
+ error = (expr != NULL) && (ffeinfo_rank (info) != 0);
+ break;
+ }
+ {
+ ffesymbol s;
+ ffeinfoWhere where;
+ ffeinfoKind kind;
+
+ if (!error
+ && (expr != NULL)
+ && (ffebld_op (expr) == FFEBLD_opSYMTER)
+ && ((s = ffebld_symter (expr)), (where = ffesymbol_where (s)),
+ (where == FFEINFO_whereINTRINSIC)
+ || (where == FFEINFO_whereGLOBAL)
+ || ((where == FFEINFO_whereDUMMY)
+ && ((kind = ffesymbol_kind (s)),
+ (kind == FFEINFO_kindFUNCTION)
+ || (kind == FFEINFO_kindSUBROUTINE))))
+ && !ffesymbol_explicitwhere (s))
+ {
+ ffebad_start (where == FFEINFO_whereINTRINSIC
+ ? FFEBAD_NEED_INTRINSIC : FFEBAD_NEED_EXTERNAL);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_string (ffesymbol_text (s));
+ ffebad_finish ();
+ ffesymbol_signal_change (s);
+ ffesymbol_set_explicitwhere (s, TRUE);
+ ffesymbol_signal_unreported (s);
+ }
+ }
+ break;
+
+ case FFEEXPR_contextINDEX_:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextRETURN:
+ if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+ break;
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeNONE:
+ error = FALSE;
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break; /* expr==NULL ok for substring; element case
+ caught by callback. */
+
+ case FFEEXPR_contextDO:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ error = !ffe_is_ugly_logint ();
+ if (!ffeexpr_stack_->is_rhs)
+ break; /* Don't convert lhs variable. */
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ ffeinfo_kindtype (ffebld_info (expr)), 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ if (!ffeexpr_stack_->is_rhs)
+ {
+ error = TRUE;
+ break; /* Don't convert lhs variable. */
+ }
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeREAL:
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if (!ffeexpr_stack_->is_rhs
+ && (ffebld_op (expr) != FFEBLD_opSYMTER))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextDOWHILE:
+ case FFEEXPR_contextIF:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeINTEGER:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeLOGICAL:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextASSIGN:
+ case FFEEXPR_contextAGOTO:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeINTEGER:
+ error = (ffeinfo_kindtype (info) != ffecom_label_kind ());
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ error = !ffe_is_ugly_logint ()
+ || (ffeinfo_kindtype (info) != ffecom_label_kind ());
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr == NULL) || (ffeinfo_rank (info) != 0)
+ || (ffebld_op (expr) != FFEBLD_opSYMTER))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextCGOTO:
+ case FFEEXPR_contextFORMAT:
+ case FFEEXPR_contextDIMLIST:
+ case FFEEXPR_contextFILENUM: /* See equiv code in _ambig_. */
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextARITHIF:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeREAL:
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextSTOP:
+ if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+ break;
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeINTEGER:
+ error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT);
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeNONE:
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr != NULL) && ((ffebld_op (expr) != FFEBLD_opCONTER)
+ || (ffebld_conter_orig (expr) != NULL)))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextINCLUDE:
+ error = (expr == NULL) || (ffeinfo_rank (info) != 0)
+ || (ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER)
+ || (ffebld_op (expr) != FFEBLD_opCONTER)
+ || (ffebld_conter_orig (expr) != NULL);
+ break;
+
+ case FFEEXPR_contextSELECTCASE:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeCHARACTER:
+ case FFEINFO_basictypeLOGICAL:
+ error = FALSE;
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextCASE:
+ if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+ break;
+ switch ((expr == NULL) ? FFEINFO_basictypeINTEGER
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeCHARACTER:
+ case FFEINFO_basictypeLOGICAL:
+ error = FALSE;
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextCHARACTERSIZE:
+ case FFEEXPR_contextKINDTYPE:
+ case FFEEXPR_contextDIMLISTCOMMON:
+ if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+ break;
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextEQVINDEX_:
+ if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+ break;
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeNONE:
+ error = FALSE;
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextPARAMETER:
+ if (ffeexpr_stack_->is_rhs)
+ error = (expr == NULL) || (ffeinfo_rank (info) != 0)
+ || (ffebld_op (expr) != FFEBLD_opCONTER);
+ else
+ error = (expr == NULL) || (ffeinfo_rank (info) != 0)
+ || (ffebld_op (expr) != FFEBLD_opSYMTER);
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ if (ffelex_token_type (t) == FFELEX_typeCOLON)
+ ffeexpr_stack_->context = FFEEXPR_contextINDEX_;
+ else
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+ if (ffelex_token_type (t) == FFELEX_typeCOLON)
+ ffeexpr_stack_->context = FFEEXPR_contextINDEX_;
+ else
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ if (ffelex_token_type (t) == FFELEX_typeCOLON)
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEX_;
+ else
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ if (ffelex_token_type (t) == FFELEX_typeCOLON)
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEX_;
+ else
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ goto again; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextIMPDOCTRL_:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ if (!ffeexpr_stack_->is_rhs
+ && (ffebld_op (expr) != FFEBLD_opSYMTER))
+ error = TRUE;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ error = error && !ffe_is_ugly_logint ();
+ if (!ffeexpr_stack_->is_rhs)
+ break; /* Don't convert lhs variable. */
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ ffeinfo_kindtype (ffebld_info (expr)), 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ break;
+
+ case FFEINFO_basictypeREAL:
+ if (!ffeexpr_stack_->is_rhs
+ && ffe_is_warn_surprising ()
+ && !error)
+ {
+ ffebad_start (FFEBAD_DO_REAL); /* See error message!!! */
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_string (ffelex_token_text (ft));
+ ffebad_finish ();
+ }
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextDATAIMPDOCTRL_:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ if (ffeexpr_stack_->is_rhs)
+ {
+ if ((ffebld_op (expr) != FFEBLD_opCONTER)
+ && (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
+ error = TRUE;
+ }
+ else if ((ffebld_op (expr) != FFEBLD_opSYMTER)
+ || (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
+ error = TRUE;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ error = error
+ && (ffeinfo_kindtype (info) != FFEINFO_kindtypeLOGICALDEFAULT);
+ if (!ffeexpr_stack_->is_rhs)
+ break; /* Don't convert lhs variable. */
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ error = error &&
+ (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
+ break;
+
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeREAL:
+ if (!ffeexpr_stack_->is_rhs
+ && ffe_is_warn_surprising ()
+ && !error)
+ {
+ ffebad_start (FFEBAD_DO_REAL); /* See error message!!! */
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_string (ffelex_token_text (ft));
+ ffebad_finish ();
+ }
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextIMPDOITEM_:
+ if (ffelex_token_type (t) == FFELEX_typeEQUALS)
+ {
+ ffeexpr_stack_->is_rhs = FALSE;
+ ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
+ goto again; /* :::::::::::::::::::: */
+ }
+ /* Fall through. */
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextFILEVXTCODE:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ break;
+ }
+ error = (expr == NULL)
+ || ((ffeinfo_rank (info) != 0)
+ && ((ffebld_op (expr) != FFEBLD_opSYMTER)
+ || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
+ || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
+ == FFEBLD_opSTAR))); /* Bad if null expr, or if
+ array that is not a SYMTER
+ (can't happen yet, I
+ think) or has a NULL or
+ STAR (assumed) array
+ size. */
+ break;
+
+ case FFEEXPR_contextIMPDOITEMDF_:
+ if (ffelex_token_type (t) == FFELEX_typeEQUALS)
+ {
+ ffeexpr_stack_->is_rhs = FALSE;
+ ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
+ goto again; /* :::::::::::::::::::: */
+ }
+ /* Fall through. */
+ case FFEEXPR_contextIOLISTDF:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ break;
+ }
+ error
+ = (expr == NULL)
+ || ((ffeinfo_basictype (info) == FFEINFO_basictypeCHARACTER)
+ && (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT))
+ || ((ffeinfo_rank (info) != 0)
+ && ((ffebld_op (expr) != FFEBLD_opSYMTER)
+ || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
+ || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
+ == FFEBLD_opSTAR))); /* Bad if null expr,
+ non-default-kindtype
+ character expr, or if
+ array that is not a SYMTER
+ (can't happen yet, I
+ think) or has a NULL or
+ STAR (assumed) array
+ size. */
+ break;
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ error = (expr == NULL)
+ || (ffebld_op (expr) != FFEBLD_opARRAYREF)
+ || ((ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR)
+ && (ffeinfo_where (info) != FFEINFO_whereFLEETING_IADDR));
+ break;
+
+ case FFEEXPR_contextDATAIMPDOINDEX_:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((ffeinfo_where (info) != FFEINFO_whereCONSTANT)
+ && (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextDATA:
+ if (expr == NULL)
+ error = TRUE;
+ else if (ffeexpr_stack_->is_rhs)
+ error = (ffebld_op (expr) != FFEBLD_opCONTER);
+ else if (ffebld_op (expr) == FFEBLD_opSYMTER)
+ error = FALSE;
+ else
+ error = (ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR);
+ break;
+
+ case FFEEXPR_contextINITVAL:
+ error = (expr == NULL) || (ffebld_op (expr) != FFEBLD_opCONTER);
+ break;
+
+ case FFEEXPR_contextEQUIVALENCE:
+ if (expr == NULL)
+ error = TRUE;
+ else if (ffebld_op (expr) == FFEBLD_opSYMTER)
+ error = FALSE;
+ else
+ error = (ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR);
+ break;
+
+ case FFEEXPR_contextFILEASSOC:
+ case FFEEXPR_contextFILEINT:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeINTEGER:
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextFILEDFINT:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeINTEGER:
+ error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextFILELOG:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextFILECHAR:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeCHARACTER:
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextFILENUMCHAR:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeCHARACTER:
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextFILEDFCHAR:
+ if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+ break;
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeCHARACTER:
+ error
+ = (ffeinfo_kindtype (info)
+ != FFEINFO_kindtypeCHARACTERDEFAULT);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if (!ffeexpr_stack_->is_rhs
+ && (ffebld_op (expr) == FFEBLD_opSUBSTR))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextFILEUNIT: /* See equiv code in _ambig_. */
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ if ((error = (ffeinfo_rank (info) != 0)))
+ break;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if ((error = (ffeinfo_rank (info) != 0)))
+ break;
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ if ((error = (ffeinfo_rank (info) != 0)))
+ break;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ffebld_op (expr))
+ { /* As if _lhs had been called instead of
+ _rhs. */
+ case FFEBLD_opSYMTER:
+ error
+ = (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereCONSTANT);
+ break;
+
+ case FFEBLD_opSUBSTR:
+ error = (ffeinfo_where (ffebld_info (expr))
+ == FFEINFO_whereCONSTANT_SUBOBJECT);
+ break;
+
+ case FFEBLD_opARRAYREF:
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if (!error
+ && ((ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
+ || ((ffeinfo_rank (info) != 0)
+ && ((ffebld_op (expr) != FFEBLD_opSYMTER)
+ || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
+ || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
+ == FFEBLD_opSTAR))))) /* Bad if
+ non-default-kindtype
+ character expr, or if
+ array that is not a SYMTER
+ (can't happen yet, I
+ think), or has a NULL or
+ STAR (assumed) array
+ size. */
+ error = TRUE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextFILEFORMAT:
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeINTEGER:
+ error = (expr == NULL)
+ || ((ffeinfo_rank (info) != 0) ?
+ ffe_is_pedantic () /* F77 C5. */
+ : (ffeinfo_kindtype (info) != ffecom_label_kind ()))
+ || (ffebld_op (expr) != FFEBLD_opSYMTER);
+ break;
+
+ case FFEINFO_basictypeLOGICAL:
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ /* F77 C5 -- must be an array of hollerith. */
+ error
+ = ffe_is_pedantic ()
+ || (ffeinfo_rank (info) == 0);
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ if ((ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
+ || ((ffeinfo_rank (info) != 0)
+ && ((ffebld_op (expr) != FFEBLD_opSYMTER)
+ || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
+ || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
+ == FFEBLD_opSTAR)))) /* Bad if
+ non-default-kindtype
+ character expr, or if
+ array that is not a SYMTER
+ (can't happen yet, I
+ think), or has a NULL or
+ STAR (assumed) array
+ size. */
+ error = TRUE;
+ else
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextLOC_:
+ /* See also ffeintrin_check_loc_. */
+ if ((expr == NULL)
+ || (ffeinfo_kind (info) != FFEINFO_kindENTITY)
+ || ((ffebld_op (expr) != FFEBLD_opSYMTER)
+ && (ffebld_op (expr) != FFEBLD_opSUBSTR)
+ && (ffebld_op (expr) != FFEBLD_opARRAYREF)))
+ error = TRUE;
+ break;
+
+ default:
+ error = FALSE;
+ break;
+ }
+
+ if (error && ((expr == NULL) || (ffebld_op (expr) != FFEBLD_opANY)))
+ {
+ ffebad_start (FFEBAD_EXPR_WRONG);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ expr = ffebld_new_any ();
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ }
+
+ callback = ffeexpr_stack_->callback;
+ s = ffeexpr_stack_->previous;
+ malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
+ sizeof (*ffeexpr_stack_));
+ ffeexpr_stack_ = s;
+ next = (ffelexHandler) (*callback) (ft, expr, t);
+ ffelex_token_kill (ft);
+ return (ffelexHandler) next;
+}
+
+/* ffeexpr_finished_ambig_ -- Check validity of ambiguous unit/form spec
+
+ ffebld expr;
+ expr = ffeexpr_finished_ambig_(expr);
+
+ Replicates a bit of ffeexpr_finished_'s task when in a context
+ of UNIT or FORMAT. */
+
+static ffebld
+ffeexpr_finished_ambig_ (ffelexToken ft, ffebld expr)
+{
+ ffeinfo info = ffebld_info (expr);
+ bool error;
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFILENUMAMBIG: /* Same as FILENUM in _finished_. */
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = FALSE;
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+ error = TRUE;
+ break;
+
+ case FFEEXPR_contextFILEUNITAMBIG: /* Same as FILEUNIT in _finished_. */
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ {
+ error = FALSE;
+ break;
+ }
+ switch ((expr == NULL) ? FFEINFO_basictypeNONE
+ : ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeLOGICAL:
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+ FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ /* Fall through. */
+ case FFEINFO_basictypeREAL:
+ case FFEINFO_basictypeCOMPLEX:
+ if (ffe_is_pedantic ())
+ {
+ error = TRUE;
+ break;
+ }
+ /* Fall through. */
+ case FFEINFO_basictypeINTEGER:
+ case FFEINFO_basictypeHOLLERITH:
+ case FFEINFO_basictypeTYPELESS:
+ error = (ffeinfo_rank (info) != 0);
+ expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ break;
+
+ case FFEINFO_basictypeCHARACTER:
+ switch (ffebld_op (expr))
+ { /* As if _lhs had been called instead of
+ _rhs. */
+ case FFEBLD_opSYMTER:
+ error
+ = (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereCONSTANT);
+ break;
+
+ case FFEBLD_opSUBSTR:
+ error = (ffeinfo_where (ffebld_info (expr))
+ == FFEINFO_whereCONSTANT_SUBOBJECT);
+ break;
+
+ case FFEBLD_opARRAYREF:
+ error = FALSE;
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ default:
+ error = TRUE;
+ break;
+ }
+ break;
+
+ default:
+ assert ("bad context" == NULL);
+ error = TRUE;
+ break;
+ }
+
+ if (error && ((expr == NULL) || (ffebld_op (expr) != FFEBLD_opANY)))
+ {
+ ffebad_start (FFEBAD_EXPR_WRONG);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ expr = ffebld_new_any ();
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ }
+
+ return expr;
+}
+
+/* ffeexpr_token_lhs_ -- Initial state for lhs expression
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Basically a smaller version of _rhs_; keep them both in sync, of course. */
+
+static ffelexHandler
+ffeexpr_token_lhs_ (ffelexToken t)
+{
+
+ /* When changing the list of valid initial lhs tokens, check whether to
+ update a corresponding list in ffeexpr_cb_close_paren_ambig_1_ for the
+ READ (expr) <token> case -- it assumes it knows which tokens <token> can
+ be to indicate an lhs (or implied DO), which right now is the set
+ {NAME,OPEN_PAREN}.
+
+ This comment also appears in ffeexpr_token_first_lhs_. */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_name_lhs_;
+
+ default:
+ return (ffelexHandler) ffeexpr_finished_ (t);
+ }
+}
+
+/* ffeexpr_token_rhs_ -- Initial state for rhs expression
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ The initial state and the post-binary-operator state are the same and
+ both handled here, with the expression stack used to distinguish
+ between them. Binary operators are invalid here; unary operators,
+ constants, subexpressions, and name references are valid. */
+
+static ffelexHandler
+ffeexpr_token_rhs_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeQUOTE:
+ if (ffe_is_vxt ())
+ {
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_quote_;
+ }
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ ffelex_set_expecting_hollerith (-1, '\"',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ /* Don't have to unset this one. */
+ return (ffelexHandler) ffeexpr_token_apostrophe_;
+
+ case FFELEX_typeAPOSTROPHE:
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ ffelex_set_expecting_hollerith (-1, '\'',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ /* Don't have to unset this one. */
+ return (ffelexHandler) ffeexpr_token_apostrophe_;
+
+ case FFELEX_typePERCENT:
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_percent_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextPAREN_,
+ ffeexpr_cb_close_paren_c_);
+
+ case FFELEX_typePLUS:
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeUNARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorADD_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceADD_;
+ e->u.operator.as = FFEEXPR_operatorassociativityADD_;
+ ffeexpr_exprstack_push_unary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeMINUS:
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeUNARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorSUBTRACT_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceSUBTRACT_;
+ e->u.operator.as = FFEEXPR_operatorassociativitySUBTRACT_;
+ ffeexpr_exprstack_push_unary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typePERIOD:
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_period_;
+
+ case FFELEX_typeNUMBER:
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ ffeexpr_hollerith_count_ = atol (ffelex_token_text (t));
+ if (ffeexpr_hollerith_count_ > 0)
+ ffelex_set_expecting_hollerith (ffeexpr_hollerith_count_,
+ '\0',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ return (ffelexHandler) ffeexpr_token_number_;
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ return (ffelexHandler) ffeexpr_token_name_arg_;
+
+ default:
+ return (ffelexHandler) ffeexpr_token_name_rhs_;
+ }
+
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSLASH:
+ case FFELEX_typePOWER:
+ case FFELEX_typeCONCAT:
+ case FFELEX_typeREL_EQ:
+ case FFELEX_typeREL_NE:
+ case FFELEX_typeREL_LE:
+ case FFELEX_typeREL_GE:
+ if (ffest_ffebad_start (FFEBAD_MISSING_FIRST_BINARY_OPERAND))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+#if 0
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCLOSE_ANGLE:
+ case FFELEX_typeCLOSE_PAREN:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+#endif
+ default:
+ return (ffelexHandler) ffeexpr_finished_ (t);
+ }
+}
+
+/* ffeexpr_token_period_ -- Rhs PERIOD
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle a period detected at rhs (expecting unary op or operand) state.
+ Must begin a floating-point value (as in .12) or a dot-dot name, of
+ which only .NOT., .TRUE., and .FALSE. are truly valid. Other sort-of-
+ valid names represent binary operators, which are invalid here because
+ there isn't an operand at the top of the stack. */
+
+static ffelexHandler
+ffeexpr_token_period_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t);
+ switch (ffeexpr_current_dotdot_)
+ {
+ case FFEEXPR_dotdotNONE_:
+ if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+
+ case FFEEXPR_dotdotTRUE_:
+ case FFEEXPR_dotdotFALSE_:
+ case FFEEXPR_dotdotNOT_:
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_end_period_;
+
+ default:
+ if (ffest_ffebad_start (FFEBAD_MISSING_FIRST_BINARY_OPERAND))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ return (ffelexHandler) ffeexpr_token_swallow_period_;
+ }
+ break; /* Nothing really reaches here. */
+
+ case FFELEX_typeNUMBER:
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_real_;
+
+ default:
+ if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+ }
+}
+
+/* ffeexpr_token_end_period_ -- Rhs PERIOD NAME(NOT, TRUE, or FALSE)
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Expecting a period to close a .NOT, .TRUE, or .FALSE at rhs (unary op
+ or operator) state. If period isn't found, issue a diagnostic but
+ pretend we saw one. ffeexpr_current_dotdot_ must already contained the
+ dotdot representation of the name in between the two PERIOD tokens. */
+
+static ffelexHandler
+ffeexpr_token_end_period_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ {
+ if (ffest_ffebad_start (FFEBAD_INSERTING_PERIOD))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+ ffebad_finish ();
+ }
+ }
+
+ ffelex_token_kill (ffeexpr_tokens_[1]); /* Kill "NOT"/"TRUE"/"FALSE"
+ token. */
+
+ e = ffeexpr_expr_new_ ();
+ e->token = ffeexpr_tokens_[0];
+
+ switch (ffeexpr_current_dotdot_)
+ {
+ case FFEEXPR_dotdotNOT_:
+ e->type = FFEEXPR_exprtypeUNARY_;
+ e->u.operator.op = FFEEXPR_operatorNOT_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceNOT_;
+ e->u.operator.as = FFEEXPR_operatorassociativityNOT_;
+ ffeexpr_exprstack_push_unary_ (e);
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFEEXPR_dotdotTRUE_:
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->u.operand
+ = ffebld_new_conter (ffebld_constant_new_logicaldefault (TRUE));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+ ffeexpr_exprstack_push_operand_ (e);
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ return (ffelexHandler) ffeexpr_token_binary_;
+
+ case FFEEXPR_dotdotFALSE_:
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->u.operand
+ = ffebld_new_conter (ffebld_constant_new_logicaldefault (FALSE));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+ ffeexpr_exprstack_push_operand_ (e);
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ return (ffelexHandler) ffeexpr_token_binary_;
+
+ default:
+ assert ("Bad unary dotdot in ffeexpr_current_dotdot_" == NULL);
+ exit (0);
+ return NULL;
+ }
+}
+
+/* ffeexpr_token_swallow_period_ -- Rhs PERIOD NAME(not NOT, TRUE, or FALSE)
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ A diagnostic has already been issued; just swallow a period if there is
+ one, then continue with ffeexpr_token_rhs_. */
+
+static ffelexHandler
+ffeexpr_token_swallow_period_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+
+ return (ffelexHandler) ffeexpr_token_rhs_;
+}
+
+/* ffeexpr_token_real_ -- Rhs PERIOD NUMBER
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ After a period and a string of digits, check next token for possible
+ exponent designation (D, E, or Q as first/only character) and continue
+ real-number handling accordingly. Else form basic real constant, push
+ onto expression stack, and enter binary state using current token (which,
+ if it is a name not beginning with D, E, or Q, will certainly result
+ in an error, but that's not for this routine to deal with). */
+
+static ffelexHandler
+ffeexpr_token_real_ (ffelexToken t)
+{
+ char d;
+ char *p;
+
+ if (((ffelex_token_type (t) != FFELEX_typeNAME)
+ && (ffelex_token_type (t) != FFELEX_typeNAMES))
+ || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+ 'D', 'd')
+ || ffesrc_char_match_init (d, 'E', 'e')
+ || ffesrc_char_match_init (d, 'Q', 'q')))
+ && ffeexpr_isdigits_ (++p)))
+ {
+#if 0
+ /* This code has been removed because it seems inconsistent to
+ produce a diagnostic in this case, but not all of the other
+ ones that look for an exponent and cannot recognize one. */
+ if (((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNAMES))
+ && ffest_ffebad_start (FFEBAD_INVALID_EXPONENT))
+ {
+ char bad[2];
+
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ bad[0] = *(p - 1);
+ bad[1] = '\0';
+ ffebad_string (bad);
+ ffebad_finish ();
+ }
+#endif
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+
+ /* Just exponent character by itself? In which case, PLUS or MINUS must
+ surely be next, followed by a NUMBER token. */
+
+ if (*p == '\0')
+ {
+ ffeexpr_tokens_[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_real_exponent_;
+ }
+
+ ffeexpr_make_float_const_ (d, NULL, ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ t, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_real_exponent_ -- Rhs PERIOD NUMBER NAME(D, E, or Q)
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Ensures this token is PLUS or MINUS, preserves it, goes to final state
+ for real number (exponent digits). Else issues diagnostic, assumes a
+ zero exponent field for number, passes token on to binary state as if
+ previous token had been "E0" instead of "E", for example. */
+
+static ffelexHandler
+ffeexpr_token_real_exponent_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) != FFELEX_typePLUS)
+ && (ffelex_token_type (t) != FFELEX_typeMINUS))
+ {
+ if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
+ ffelex_token_where_column (ffeexpr_tokens_[2]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+
+ ffeexpr_tokens_[3] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_real_exp_sign_;
+}
+
+/* ffeexpr_token_real_exp_sign_ -- Rhs PERIOD NUMBER NAME(D,E,Q) PLUS/MINUS
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Make sure token is a NUMBER, make a real constant out of all we have and
+ push it onto the expression stack. Else issue diagnostic and pretend
+ exponent field was a zero. */
+
+static ffelexHandler
+ffeexpr_token_real_exp_sign_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ {
+ if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
+ ffelex_token_where_column (ffeexpr_tokens_[2]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ ffelex_token_kill (ffeexpr_tokens_[3]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+
+ ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[2])[0], NULL,
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1], ffeexpr_tokens_[2],
+ ffeexpr_tokens_[3], t);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ ffelex_token_kill (ffeexpr_tokens_[3]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_number_ -- Rhs NUMBER
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ If the token is a period, we may have a floating-point number, or an
+ integer followed by a dotdot binary operator. If the token is a name
+ beginning with D, E, or Q, we definitely have a floating-point number.
+ If the token is a hollerith constant, that's what we've got, so push
+ it onto the expression stack and continue with the binary state.
+
+ Otherwise, we have an integer followed by something the binary state
+ should be able to swallow. */
+
+static ffelexHandler
+ffeexpr_token_number_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+ ffeinfo ni;
+ char d;
+ char *p;
+
+ if (ffeexpr_hollerith_count_ > 0)
+ ffelex_set_expecting_hollerith (0, '\0',
+ ffewhere_line_unknown (),
+ ffewhere_column_unknown ());
+
+ /* See if we've got a floating-point number here. */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+ 'D', 'd')
+ || ffesrc_char_match_init (d, 'E', 'e')
+ || ffesrc_char_match_init (d, 'Q', 'q'))
+ && ffeexpr_isdigits_ (++p))
+ {
+
+ /* Just exponent character by itself? In which case, PLUS or MINUS
+ must surely be next, followed by a NUMBER token. */
+
+ if (*p == '\0')
+ {
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_number_exponent_;
+ }
+ ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], NULL, NULL, t,
+ NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+ }
+ break;
+
+ case FFELEX_typePERIOD:
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_number_period_;
+
+ case FFELEX_typeHOLLERITH:
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_hollerith (t));
+ ni = ffeinfo_new (FFEINFO_basictypeHOLLERITH, FFEINFO_kindtypeNONE,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ ffelex_token_length (t));
+ ffebld_set_info (e->u.operand, ni);
+ ffeexpr_exprstack_push_operand_ (e);
+ return (ffelexHandler) ffeexpr_token_binary_;
+
+ default:
+ break;
+ }
+
+ /* Nothing specific we were looking for, so make an integer and pass the
+ current token to the binary state. */
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
+ (ffeexpr_tokens_[0]));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ ffeexpr_exprstack_push_operand_ (e);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* ffeexpr_token_number_exponent_ -- Rhs NUMBER NAME(D, E, or Q)
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Ensures this token is PLUS or MINUS, preserves it, goes to final state
+ for real number (exponent digits). Else treats number as integer, passes
+ name to binary, passes current token to subsequent handler. */
+
+static ffelexHandler
+ffeexpr_token_number_exponent_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) != FFELEX_typePLUS)
+ && (ffelex_token_type (t) != FFELEX_typeMINUS))
+ {
+ ffeexprExpr_ e;
+ ffelexHandler nexthandler;
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
+ (ffeexpr_tokens_[0]));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGERDEFAULT,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+ ffeexpr_exprstack_push_operand_ (e);
+ nexthandler = (ffelexHandler) ffeexpr_token_binary_ (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ return (ffelexHandler) (*nexthandler) (t);
+ }
+
+ ffeexpr_tokens_[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_number_exp_sign_;
+}
+
+/* ffeexpr_token_number_exp_sign_ -- Rhs NUMBER NAME(D,E,Q) PLUS/MINUS
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Make sure token is a NUMBER, make a real constant out of all we have and
+ push it onto the expression stack. Else issue diagnostic and pretend
+ exponent field was a zero. */
+
+static ffelexHandler
+ffeexpr_token_number_exp_sign_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ {
+ if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[1]),
+ ffelex_token_where_column (ffeexpr_tokens_[1]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[1])[0],
+ ffeexpr_tokens_[0], NULL, NULL,
+ ffeexpr_tokens_[1], ffeexpr_tokens_[2],
+ NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+
+ ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[1])[0],
+ ffeexpr_tokens_[0], NULL, NULL,
+ ffeexpr_tokens_[1], ffeexpr_tokens_[2], t);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_number_period_ -- Rhs NUMBER PERIOD
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle a period detected following a number at rhs state. Must begin a
+ floating-point value (as in 1., 1.2, 1.E3, or 1.E+3) or a dot-dot name. */
+
+static ffelexHandler
+ffeexpr_token_number_period_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+ ffelexHandler nexthandler;
+ char *p;
+ char d;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+ 'D', 'd')
+ || ffesrc_char_match_init (d, 'E', 'e')
+ || ffesrc_char_match_init (d, 'Q', 'q'))
+ && ffeexpr_isdigits_ (++p))
+ {
+
+ /* Just exponent character by itself? In which case, PLUS or MINUS
+ must surely be next, followed by a NUMBER token. */
+
+ if (*p == '\0')
+ {
+ ffeexpr_tokens_[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_number_per_exp_;
+ }
+ ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0],
+ ffeexpr_tokens_[1], NULL, t, NULL,
+ NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+ }
+ /* A name not representing an exponent, so assume it will be something
+ like EQ, make an integer from the number, pass the period to binary
+ state and the current token to the resulting state. */
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
+ (ffeexpr_tokens_[0]));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ ffeexpr_exprstack_push_operand_ (e);
+ nexthandler = (ffelexHandler) ffeexpr_token_binary_
+ (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ return (ffelexHandler) (*nexthandler) (t);
+
+ case FFELEX_typeNUMBER:
+ ffeexpr_tokens_[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_number_real_;
+
+ default:
+ break;
+ }
+
+ /* Nothing specific we were looking for, so make a real number and pass the
+ period and then the current token to the binary state. */
+
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ NULL, NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* ffeexpr_token_number_per_exp_ -- Rhs NUMBER PERIOD NAME(D, E, or Q)
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Ensures this token is PLUS or MINUS, preserves it, goes to final state
+ for real number (exponent digits). Else treats number as real, passes
+ name to binary, passes current token to subsequent handler. */
+
+static ffelexHandler
+ffeexpr_token_number_per_exp_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) != FFELEX_typePLUS)
+ && (ffelex_token_type (t) != FFELEX_typeMINUS))
+ {
+ ffelexHandler nexthandler;
+
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ NULL, NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ nexthandler = (ffelexHandler) ffeexpr_token_binary_ (ffeexpr_tokens_[2]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ return (ffelexHandler) (*nexthandler) (t);
+ }
+
+ ffeexpr_tokens_[3] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_num_per_exp_sign_;
+}
+
+/* ffeexpr_token_number_real_ -- Rhs NUMBER PERIOD NUMBER
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ After a number, period, and number, check next token for possible
+ exponent designation (D, E, or Q as first/only character) and continue
+ real-number handling accordingly. Else form basic real constant, push
+ onto expression stack, and enter binary state using current token (which,
+ if it is a name not beginning with D, E, or Q, will certainly result
+ in an error, but that's not for this routine to deal with). */
+
+static ffelexHandler
+ffeexpr_token_number_real_ (ffelexToken t)
+{
+ char d;
+ char *p;
+
+ if (((ffelex_token_type (t) != FFELEX_typeNAME)
+ && (ffelex_token_type (t) != FFELEX_typeNAMES))
+ || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+ 'D', 'd')
+ || ffesrc_char_match_init (d, 'E', 'e')
+ || ffesrc_char_match_init (d, 'Q', 'q')))
+ && ffeexpr_isdigits_ (++p)))
+ {
+#if 0
+ /* This code has been removed because it seems inconsistent to
+ produce a diagnostic in this case, but not all of the other
+ ones that look for an exponent and cannot recognize one. */
+ if (((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNAMES))
+ && ffest_ffebad_start (FFEBAD_INVALID_EXPONENT))
+ {
+ char bad[2];
+
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ bad[0] = *(p - 1);
+ bad[1] = '\0';
+ ffebad_string (bad);
+ ffebad_finish ();
+ }
+#endif
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ ffeexpr_tokens_[2], NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+
+ /* Just exponent character by itself? In which case, PLUS or MINUS must
+ surely be next, followed by a NUMBER token. */
+
+ if (*p == '\0')
+ {
+ ffeexpr_tokens_[3] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_number_real_exp_;
+ }
+
+ ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ ffeexpr_tokens_[2], t, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_num_per_exp_sign_ -- Rhs NUMBER PERIOD NAME(D,E,Q) PLUS/MINUS
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Make sure token is a NUMBER, make a real constant out of all we have and
+ push it onto the expression stack. Else issue diagnostic and pretend
+ exponent field was a zero. */
+
+static ffelexHandler
+ffeexpr_token_num_per_exp_sign_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ {
+ if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
+ ffelex_token_where_column (ffeexpr_tokens_[2]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ NULL, NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ ffelex_token_kill (ffeexpr_tokens_[3]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+
+ ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[2])[0],
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1], NULL,
+ ffeexpr_tokens_[2], ffeexpr_tokens_[3], t);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ ffelex_token_kill (ffeexpr_tokens_[3]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_number_real_exp_ -- Rhs NUMBER PERIOD NUMBER NAME(D, E, or Q)
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Ensures this token is PLUS or MINUS, preserves it, goes to final state
+ for real number (exponent digits). Else issues diagnostic, assumes a
+ zero exponent field for number, passes token on to binary state as if
+ previous token had been "E0" instead of "E", for example. */
+
+static ffelexHandler
+ffeexpr_token_number_real_exp_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) != FFELEX_typePLUS)
+ && (ffelex_token_type (t) != FFELEX_typeMINUS))
+ {
+ if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[3]),
+ ffelex_token_where_column (ffeexpr_tokens_[3]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ ffeexpr_tokens_[2], NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ ffelex_token_kill (ffeexpr_tokens_[3]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+
+ ffeexpr_tokens_[4] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_num_real_exp_sn_;
+}
+
+/* ffeexpr_token_num_real_exp_sn_ -- Rhs NUMBER PERIOD NUMBER NAME(D,E,Q)
+ PLUS/MINUS
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Make sure token is a NUMBER, make a real constant out of all we have and
+ push it onto the expression stack. Else issue diagnostic and pretend
+ exponent field was a zero. */
+
+static ffelexHandler
+ffeexpr_token_num_real_exp_sn_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ {
+ if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[3]),
+ ffelex_token_where_column (ffeexpr_tokens_[3]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ ffeexpr_tokens_[2], NULL, NULL, NULL);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ ffelex_token_kill (ffeexpr_tokens_[3]);
+ ffelex_token_kill (ffeexpr_tokens_[4]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+
+ ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[3])[0],
+ ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+ ffeexpr_tokens_[2], ffeexpr_tokens_[3],
+ ffeexpr_tokens_[4], t);
+
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ ffelex_token_kill (ffeexpr_tokens_[3]);
+ ffelex_token_kill (ffeexpr_tokens_[4]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_binary_ -- Handle binary operator possibility
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ The possibility of a binary operator is handled here, meaning the previous
+ token was an operand. */
+
+static ffelexHandler
+ffeexpr_token_binary_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+
+ if (!ffeexpr_stack_->is_rhs)
+ return (ffelexHandler) ffeexpr_finished_ (t); /* For now. */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePLUS:
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorADD_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceADD_;
+ e->u.operator.as = FFEEXPR_operatorassociativityADD_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeMINUS:
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorSUBTRACT_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceSUBTRACT_;
+ e->u.operator.as = FFEEXPR_operatorassociativitySUBTRACT_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeASTERISK:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextDATA:
+ return (ffelexHandler) ffeexpr_finished_ (t);
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorMULTIPLY_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceMULTIPLY_;
+ e->u.operator.as = FFEEXPR_operatorassociativityMULTIPLY_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeSLASH:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextDATA:
+ return (ffelexHandler) ffeexpr_finished_ (t);
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorDIVIDE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceDIVIDE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityDIVIDE_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typePOWER:
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorPOWER_;
+ e->u.operator.prec = FFEEXPR_operatorprecedencePOWER_;
+ e->u.operator.as = FFEEXPR_operatorassociativityPOWER_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeCONCAT:
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorCONCATENATE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceCONCATENATE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityCONCATENATE_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeOPEN_ANGLE:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFORMAT:
+ ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ break;
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorLT_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceLT_;
+ e->u.operator.as = FFEEXPR_operatorassociativityLT_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeCLOSE_ANGLE:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFORMAT:
+ return ffeexpr_finished_ (t);
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorGT_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceGT_;
+ e->u.operator.as = FFEEXPR_operatorassociativityGT_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeREL_EQ:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFORMAT:
+ ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ break;
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorEQ_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
+ e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeREL_NE:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFORMAT:
+ ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ break;
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorNE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceNE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityNE_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeREL_LE:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFORMAT:
+ ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ break;
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorLE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceLE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityLE_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typeREL_GE:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextFORMAT:
+ ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ break;
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorGE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceGE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityGE_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+
+ case FFELEX_typePERIOD:
+ ffeexpr_tokens_[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_binary_period_;
+
+#if 0
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeCLOSE_PAREN:
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+#endif
+ default:
+ return (ffelexHandler) ffeexpr_finished_ (t);
+ }
+}
+
+/* ffeexpr_token_binary_period_ -- Binary PERIOD
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle a period detected at binary (expecting binary op or end) state.
+ Must begin a dot-dot name, of which .NOT., .TRUE., and .FALSE. are not
+ valid. */
+
+static ffelexHandler
+ffeexpr_token_binary_period_ (ffelexToken t)
+{
+ ffeexprExpr_ operand;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffeexpr_current_dotdot_ = ffeexpr_dotdot_ (t);
+ switch (ffeexpr_current_dotdot_)
+ {
+ case FFEEXPR_dotdotTRUE_:
+ case FFEEXPR_dotdotFALSE_:
+ case FFEEXPR_dotdotNOT_:
+ if (ffest_ffebad_start (FFEBAD_MISSING_BINARY_OPERATOR))
+ {
+ operand = ffeexpr_stack_->exprstack;
+ assert (operand != NULL);
+ assert (operand->type == FFEEXPR_exprtypeOPERAND_);
+ ffebad_here (0, ffelex_token_where_line (operand->token), ffelex_token_where_column (operand->token));
+ ffebad_here (1, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ return (ffelexHandler) ffeexpr_token_binary_sw_per_;
+
+ case FFEEXPR_dotdotNONE_:
+ if (ffest_ffebad_start (FFEBAD_INVALID_DOTDOT))
+ {
+ ffebad_string (ffelex_token_text (t));
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_finish ();
+ }
+ ffeexpr_current_dotdot_ = FFEEXPR_dotdotEQ_;
+ /* Fall through here, pretending we got a .EQ. operator. */
+ default:
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_binary_end_per_;
+ }
+ break; /* Nothing really reaches here. */
+
+ default:
+ if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+}
+
+/* ffeexpr_token_binary_end_per_ -- Binary PERIOD NAME(not NOT, TRUE, or FALSE)
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Expecting a period to close a dot-dot at binary (binary op
+ or operator) state. If period isn't found, issue a diagnostic but
+ pretend we saw one. ffeexpr_current_dotdot_ must already contained the
+ dotdot representation of the name in between the two PERIOD tokens. */
+
+static ffelexHandler
+ffeexpr_token_binary_end_per_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ {
+ if (ffest_ffebad_start (FFEBAD_INSERTING_PERIOD))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+ ffebad_finish ();
+ }
+ }
+
+ ffelex_token_kill (ffeexpr_tokens_[1]); /* Kill dot-dot token. */
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffeexpr_tokens_[0];
+
+ switch (ffeexpr_current_dotdot_)
+ {
+ case FFEEXPR_dotdotAND_:
+ e->u.operator.op = FFEEXPR_operatorAND_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceAND_;
+ e->u.operator.as = FFEEXPR_operatorassociativityAND_;
+ break;
+
+ case FFEEXPR_dotdotOR_:
+ e->u.operator.op = FFEEXPR_operatorOR_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceOR_;
+ e->u.operator.as = FFEEXPR_operatorassociativityOR_;
+ break;
+
+ case FFEEXPR_dotdotXOR_:
+ e->u.operator.op = FFEEXPR_operatorXOR_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceXOR_;
+ e->u.operator.as = FFEEXPR_operatorassociativityXOR_;
+ break;
+
+ case FFEEXPR_dotdotEQV_:
+ e->u.operator.op = FFEEXPR_operatorEQV_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceEQV_;
+ e->u.operator.as = FFEEXPR_operatorassociativityEQV_;
+ break;
+
+ case FFEEXPR_dotdotNEQV_:
+ e->u.operator.op = FFEEXPR_operatorNEQV_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceNEQV_;
+ e->u.operator.as = FFEEXPR_operatorassociativityNEQV_;
+ break;
+
+ case FFEEXPR_dotdotLT_:
+ e->u.operator.op = FFEEXPR_operatorLT_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceLT_;
+ e->u.operator.as = FFEEXPR_operatorassociativityLT_;
+ break;
+
+ case FFEEXPR_dotdotLE_:
+ e->u.operator.op = FFEEXPR_operatorLE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceLE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityLE_;
+ break;
+
+ case FFEEXPR_dotdotEQ_:
+ e->u.operator.op = FFEEXPR_operatorEQ_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
+ e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
+ break;
+
+ case FFEEXPR_dotdotNE_:
+ e->u.operator.op = FFEEXPR_operatorNE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceNE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityNE_;
+ break;
+
+ case FFEEXPR_dotdotGT_:
+ e->u.operator.op = FFEEXPR_operatorGT_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceGT_;
+ e->u.operator.as = FFEEXPR_operatorassociativityGT_;
+ break;
+
+ case FFEEXPR_dotdotGE_:
+ e->u.operator.op = FFEEXPR_operatorGE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceGE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityGE_;
+ break;
+
+ default:
+ assert ("Bad unary dotdot in ffeexpr_current_dotdot_" == NULL);
+ }
+
+ ffeexpr_exprstack_push_binary_ (e);
+
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+ return (ffelexHandler) ffeexpr_token_rhs_;
+}
+
+/* ffeexpr_token_binary_sw_per_ -- Rhs PERIOD NAME(NOT, TRUE, or FALSE)
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ A diagnostic has already been issued; just swallow a period if there is
+ one, then continue with ffeexpr_token_binary_. */
+
+static ffelexHandler
+ffeexpr_token_binary_sw_per_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) != FFELEX_typePERIOD)
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_quote_ -- Rhs QUOTE
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Expecting a NUMBER that we'll treat as an octal integer. */
+
+static ffelexHandler
+ffeexpr_token_quote_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+ ffebld anyexpr;
+
+ if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+ {
+ if (ffest_ffebad_start (FFEBAD_QUOTE_MISSES_DIGITS))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+ }
+
+ /* This is kind of a kludge to prevent any whining about magical numbers
+ that start out as these octal integers, so "20000000000 (on a 32-bit
+ 2's-complement machine) by itself won't produce an error. */
+
+ anyexpr = ffebld_new_any ();
+ ffebld_set_info (anyexpr, ffeinfo_new_any ());
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ e->u.operand = ffebld_new_conter_with_orig
+ (ffebld_constant_new_integeroctal (t), anyexpr);
+ ffebld_set_info (e->u.operand, ffeinfo_new (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+ ffeexpr_exprstack_push_operand_ (e);
+ return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_apostrophe_ -- Rhs APOSTROPHE
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle an open-apostrophe, which begins either a character ('char-const'),
+ typeless octal ('octal-const'O), or typeless hexadecimal ('hex-const'Z or
+ 'hex-const'X) constant. */
+
+static ffelexHandler
+ffeexpr_token_apostrophe_ (ffelexToken t)
+{
+ assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
+ if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
+ {
+ ffebad_start (FFEBAD_NULL_CHAR_CONST);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_apos_char_;
+}
+
+/* ffeexpr_token_apos_char_ -- Rhs APOSTROPHE CHARACTER
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Close-apostrophe is implicit; if this token is NAME, it is a possible
+ typeless-constant radix specifier. */
+
+static ffelexHandler
+ffeexpr_token_apos_char_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+ ffeinfo ni;
+ char c;
+ ffetargetCharacterSize size;
+
+ if ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNAMES))
+ {
+ if ((ffelex_token_length (t) == 1)
+ && (ffesrc_char_match_init ((c = ffelex_token_text (t)[0]), 'B',
+ 'b')
+ || ffesrc_char_match_init (c, 'O', 'o')
+ || ffesrc_char_match_init (c, 'X', 'x')
+ || ffesrc_char_match_init (c, 'Z', 'z')))
+ {
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ switch (c)
+ {
+ case FFESRC_CASE_MATCH_INIT ('B', 'b', match_b, no_match):
+ e->u.operand = ffebld_new_conter
+ (ffebld_constant_new_typeless_bv (ffeexpr_tokens_[1]));
+ size = ffetarget_size_typeless_binary (ffeexpr_tokens_[1]);
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('O', 'o', match_o, no_match):
+ e->u.operand = ffebld_new_conter
+ (ffebld_constant_new_typeless_ov (ffeexpr_tokens_[1]));
+ size = ffetarget_size_typeless_octal (ffeexpr_tokens_[1]);
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('X', 'x', match_x, no_match):
+ e->u.operand = ffebld_new_conter
+ (ffebld_constant_new_typeless_hxv (ffeexpr_tokens_[1]));
+ size = ffetarget_size_typeless_hex (ffeexpr_tokens_[1]);
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('Z', 'z', match_z, no_match):
+ e->u.operand = ffebld_new_conter
+ (ffebld_constant_new_typeless_hzv (ffeexpr_tokens_[1]));
+ size = ffetarget_size_typeless_hex (ffeexpr_tokens_[1]);
+ break;
+
+ default:
+ no_match: /* :::::::::::::::::::: */
+ assert ("not BOXZ!" == NULL);
+ size = 0;
+ break;
+ }
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeTYPELESS, FFEINFO_kindtypeNONE,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, size));
+ ffeexpr_exprstack_push_operand_ (e);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+ }
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_characterdefault
+ (ffeexpr_tokens_[1]));
+ ni = ffeinfo_new (FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTERDEFAULT,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ ffelex_token_length (ffeexpr_tokens_[1]));
+ ffebld_set_info (e->u.operand, ni);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffeexpr_exprstack_push_operand_ (e);
+ if ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNAMES))
+ {
+ if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
+ {
+ ffebad_string (ffelex_token_text (t));
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_finish ();
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeBINARY_;
+ e->token = ffelex_token_use (t);
+ e->u.operator.op = FFEEXPR_operatorCONCATENATE_;
+ e->u.operator.prec = FFEEXPR_operatorprecedenceCONCATENATE_;
+ e->u.operator.as = FFEEXPR_operatorassociativityCONCATENATE_;
+ ffeexpr_exprstack_push_binary_ (e);
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+ }
+ ffeexpr_is_substr_ok_ = !ffe_is_pedantic_not_90 (); /* Allow "'hello'(3:5)". */
+ return (ffelexHandler) ffeexpr_token_substrp_ (t);
+}
+
+/* ffeexpr_token_name_lhs_ -- Lhs NAME
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle a name followed by open-paren, period (RECORD.MEMBER), percent
+ (RECORD%MEMBER), or nothing at all. */
+
+static ffelexHandler
+ffeexpr_token_name_lhs_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+ ffeexprParenType_ paren_type;
+ ffesymbol s;
+ ffebld expr;
+ ffeinfo info;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextASSIGN:
+ case FFEEXPR_contextAGOTO:
+ case FFEEXPR_contextFILEUNIT_DF:
+ goto just_name; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffelex_token_use (ffeexpr_tokens_[0]);
+ s = ffeexpr_declare_parenthesized_ (ffeexpr_tokens_[0], FALSE,
+ &paren_type);
+
+ switch (ffesymbol_where (s))
+ {
+ case FFEINFO_whereLOCAL:
+ if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
+ ffesymbol_error (s, ffeexpr_tokens_[0]); /* Recursion. */
+ break;
+
+ case FFEINFO_whereINTRINSIC:
+ case FFEINFO_whereGLOBAL:
+ if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
+ ffesymbol_error (s, ffeexpr_tokens_[0]); /* Can call intrin. */
+ break;
+
+ case FFEINFO_whereCOMMON:
+ case FFEINFO_whereDUMMY:
+ case FFEINFO_whereRESULT:
+ break;
+
+ case FFEINFO_whereNONE:
+ case FFEINFO_whereANY:
+ break;
+
+ default:
+ ffesymbol_error (s, ffeexpr_tokens_[0]);
+ break;
+ }
+
+ if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
+ {
+ e->u.operand = ffebld_new_any ();
+ ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+ }
+ else
+ {
+ e->u.operand = ffebld_new_symter (s,
+ ffesymbol_generic (s),
+ ffesymbol_specific (s),
+ ffesymbol_implementation (s));
+ ffebld_set_info (e->u.operand, ffesymbol_info (s));
+ }
+ ffeexpr_exprstack_push_ (e); /* Not a complete operand yet. */
+ ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
+ switch (paren_type)
+ {
+ case FFEEXPR_parentypeSUBROUTINE_:
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextACTUALARG_,
+ ffeexpr_token_arguments_);
+
+ case FFEEXPR_parentypeARRAY_:
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ ffeexpr_stack_->bound_list = ffesymbol_dims (s);
+ ffeexpr_stack_->rank = 0;
+ ffeexpr_stack_->constant = TRUE;
+ ffeexpr_stack_->immediate = TRUE;
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextDATAIMPDOINDEX_,
+ ffeexpr_token_elements_);
+
+ case FFEEXPR_contextEQUIVALENCE:
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextEQVINDEX_,
+ ffeexpr_token_elements_);
+
+ default:
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextINDEX_,
+ ffeexpr_token_elements_);
+ }
+
+ case FFEEXPR_parentypeSUBSTRING_:
+ e->u.operand = ffeexpr_collapse_symter (e->u.operand,
+ ffeexpr_tokens_[0]);
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextINDEX_,
+ ffeexpr_token_substring_);
+
+ case FFEEXPR_parentypeEQUIVALENCE_:
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ ffeexpr_stack_->bound_list = ffesymbol_dims (s);
+ ffeexpr_stack_->rank = 0;
+ ffeexpr_stack_->constant = TRUE;
+ ffeexpr_stack_->immediate = TRUE;
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextEQVINDEX_,
+ ffeexpr_token_equivalence_);
+
+ case FFEEXPR_parentypeFUNCTION_: /* Invalid case. */
+ case FFEEXPR_parentypeFUNSUBSTR_: /* Invalid case. */
+ ffesymbol_error (s, ffeexpr_tokens_[0]);
+ /* Fall through. */
+ case FFEEXPR_parentypeANY_:
+ e->u.operand = ffebld_new_any ();
+ ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextACTUALARG_,
+ ffeexpr_token_anything_);
+
+ default:
+ assert ("bad paren type" == NULL);
+ break;
+ }
+
+ case FFELEX_typeEQUALS: /* As in "VAR=". */
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextIMPDOITEM_: /* within
+ "(,VAR=start,end[,incr])". */
+ case FFEEXPR_contextIMPDOITEMDF_:
+ ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
+ break;
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ ffeexpr_stack_->context = FFEEXPR_contextDATAIMPDOCTRL_;
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+#if 0
+ case FFELEX_typePERIOD:
+ case FFELEX_typePERCENT:
+ assert ("FOO%, FOO. not yet supported!~~" == NULL);
+ break;
+#endif
+
+ default:
+ break;
+ }
+
+just_name: /* :::::::::::::::::::: */
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ s = ffeexpr_declare_unadorned_ (ffeexpr_tokens_[0],
+ (ffeexpr_stack_->context
+ == FFEEXPR_contextSUBROUTINEREF));
+
+ switch (ffesymbol_where (s))
+ {
+ case FFEINFO_whereCONSTANT:
+ if ((ffeexpr_stack_->context != FFEEXPR_contextPARAMETER)
+ || (ffesymbol_kind (s) != FFEINFO_kindENTITY))
+ ffesymbol_error (s, ffeexpr_tokens_[0]);
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ if ((ffeexpr_stack_->context != FFEEXPR_contextDATAIMPDOCTRL_)
+ && (ffeexpr_stack_->context != FFEEXPR_contextDATAIMPDOINDEX_))
+ ffesymbol_error (s, ffeexpr_tokens_[0]);
+ break;
+
+ case FFEINFO_whereLOCAL:
+ if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
+ ffesymbol_error (s, ffeexpr_tokens_[0]); /* Recurse!. */
+ break;
+
+ case FFEINFO_whereINTRINSIC:
+ if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
+ ffesymbol_error (s, ffeexpr_tokens_[0]); /* Can call intrin. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
+ {
+ expr = ffebld_new_any ();
+ info = ffeinfo_new_any ();
+ ffebld_set_info (expr, info);
+ }
+ else
+ {
+ expr = ffebld_new_symter (s,
+ ffesymbol_generic (s),
+ ffesymbol_specific (s),
+ ffesymbol_implementation (s));
+ info = ffesymbol_info (s);
+ ffebld_set_info (expr, info);
+ if (ffesymbol_is_doiter (s))
+ {
+ ffebad_start (FFEBAD_DOITER);
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffest_ffebad_here_doiter (1, s);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_finish ();
+ }
+ expr = ffeexpr_collapse_symter (expr, ffeexpr_tokens_[0]);
+ }
+
+ if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
+ {
+ if (ffebld_op (expr) == FFEBLD_opANY)
+ {
+ expr = ffebld_new_any ();
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ }
+ else
+ {
+ expr = ffebld_new_subrref (expr, NULL); /* No argument list. */
+ if (ffesymbol_generic (s) != FFEINTRIN_genNONE)
+ ffeintrin_fulfill_generic (&expr, &info, e->token);
+ else if (ffesymbol_specific (s) != FFEINTRIN_specNONE)
+ ffeintrin_fulfill_specific (&expr, &info, NULL, e->token);
+ else
+ ffeexpr_fulfill_call_ (&expr, e->token);
+
+ if (ffebld_op (expr) != FFEBLD_opANY)
+ ffebld_set_info (expr,
+ ffeinfo_new (ffeinfo_basictype (info),
+ ffeinfo_kindtype (info),
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereFLEETING,
+ ffeinfo_size (info)));
+ else
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ }
+ }
+
+ e->u.operand = expr;
+ ffeexpr_exprstack_push_operand_ (e);
+ return (ffelexHandler) ffeexpr_finished_ (t);
+}
+
+/* ffeexpr_token_name_arg_ -- Rhs NAME
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle first token in an actual-arg (or possible actual-arg) context
+ being a NAME, and use second token to refine the context. */
+
+static ffelexHandler
+ffeexpr_token_name_arg_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ case FFELEX_typeCOMMA:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ default:
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ ffeexpr_stack_->context
+ = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+ break;
+
+ default:
+ assert ("bad context in _name_arg_" == NULL);
+ break;
+ }
+ break;
+ }
+
+ return (ffelexHandler) ffeexpr_token_name_rhs_ (t);
+}
+
+/* ffeexpr_token_name_rhs_ -- Rhs NAME
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle a name followed by open-paren, apostrophe (O'octal-const',
+ Z'hex-const', or X'hex-const'), period (RECORD.MEMBER).
+
+ 26-Nov-91 JCB 1.2
+ When followed by apostrophe or quote, set lex hexnum flag on so
+ [0-9] as first char of next token seen as starting a potentially
+ hex number (NAME).
+ 04-Oct-91 JCB 1.1
+ In case of intrinsic, decorate its SYMTER with the type info for
+ the specific intrinsic. */
+
+static ffelexHandler
+ffeexpr_token_name_rhs_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+ ffeexprParenType_ paren_type;
+ ffesymbol s;
+ bool sfdef;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeQUOTE:
+ case FFELEX_typeAPOSTROPHE:
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ ffelex_set_hexnum (TRUE);
+ return (ffelexHandler) ffeexpr_token_name_apos_;
+
+ case FFELEX_typeOPEN_PAREN:
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffelex_token_use (ffeexpr_tokens_[0]);
+ s = ffeexpr_declare_parenthesized_ (ffeexpr_tokens_[0], TRUE,
+ &paren_type);
+ if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
+ e->u.operand = ffebld_new_any ();
+ else
+ e->u.operand = ffebld_new_symter (s, ffesymbol_generic (s),
+ ffesymbol_specific (s),
+ ffesymbol_implementation (s));
+ ffeexpr_exprstack_push_ (e); /* Not a complete operand yet. */
+ ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ sfdef = TRUE;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ assert ("weird context!" == NULL);
+ sfdef = FALSE;
+ break;
+
+ default:
+ sfdef = FALSE;
+ break;
+ }
+ switch (paren_type)
+ {
+ case FFEEXPR_parentypeFUNCTION_:
+ ffebld_set_info (e->u.operand, ffesymbol_info (s));
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+ { /* A statement function. */
+ ffeexpr_stack_->num_args
+ = ffebld_list_length
+ (ffeexpr_stack_->next_dummy
+ = ffesymbol_dummyargs (s));
+ ffeexpr_stack_->tokens[1] = NULL; /* !=NULL when > num_args. */
+ }
+ else if ((ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+ && !ffe_is_pedantic_not_90 ()
+ && ((ffesymbol_implementation (s)
+ == FFEINTRIN_impICHAR)
+ || (ffesymbol_implementation (s)
+ == FFEINTRIN_impIACHAR)
+ || (ffesymbol_implementation (s)
+ == FFEINTRIN_impLEN)))
+ { /* Allow arbitrary concatenations. */
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ sfdef
+ ? FFEEXPR_contextSFUNCDEF
+ : FFEEXPR_contextLET,
+ ffeexpr_token_arguments_);
+ }
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ sfdef
+ ? FFEEXPR_contextSFUNCDEFACTUALARG_
+ : FFEEXPR_contextACTUALARG_,
+ ffeexpr_token_arguments_);
+
+ case FFEEXPR_parentypeARRAY_:
+ ffebld_set_info (e->u.operand,
+ ffesymbol_info (ffebld_symter (e->u.operand)));
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ ffeexpr_stack_->bound_list = ffesymbol_dims (s);
+ ffeexpr_stack_->rank = 0;
+ ffeexpr_stack_->constant = TRUE;
+ ffeexpr_stack_->immediate = TRUE;
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ sfdef
+ ? FFEEXPR_contextSFUNCDEFINDEX_
+ : FFEEXPR_contextINDEX_,
+ ffeexpr_token_elements_);
+
+ case FFEEXPR_parentypeSUBSTRING_:
+ ffebld_set_info (e->u.operand,
+ ffesymbol_info (ffebld_symter (e->u.operand)));
+ e->u.operand = ffeexpr_collapse_symter (e->u.operand,
+ ffeexpr_tokens_[0]);
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ sfdef
+ ? FFEEXPR_contextSFUNCDEFINDEX_
+ : FFEEXPR_contextINDEX_,
+ ffeexpr_token_substring_);
+
+ case FFEEXPR_parentypeFUNSUBSTR_:
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ sfdef
+ ? FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_
+ : FFEEXPR_contextINDEXORACTUALARG_,
+ ffeexpr_token_funsubstr_);
+
+ case FFEEXPR_parentypeANY_:
+ ffebld_set_info (e->u.operand, ffesymbol_info (s));
+ return
+ (ffelexHandler)
+ ffeexpr_rhs (ffeexpr_stack_->pool,
+ sfdef
+ ? FFEEXPR_contextSFUNCDEFACTUALARG_
+ : FFEEXPR_contextACTUALARG_,
+ ffeexpr_token_anything_);
+
+ default:
+ assert ("bad paren type" == NULL);
+ break;
+ }
+
+ case FFELEX_typeEQUALS: /* As in "VAR=". */
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextIMPDOITEM_: /* "(,VAR=start,end[,incr])". */
+ case FFEEXPR_contextIMPDOITEMDF_:
+ ffeexpr_stack_->is_rhs = FALSE; /* Really an lhs construct. */
+ ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+#if 0
+ case FFELEX_typePERIOD:
+ case FFELEX_typePERCENT:
+ ~~Support these two someday, though not required
+ assert ("FOO%, FOO. not yet supported!~~" == NULL);
+ break;
+#endif
+
+ default:
+ break;
+ }
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ assert ("strange context" == NULL);
+ break;
+
+ default:
+ break;
+ }
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+ s = ffeexpr_declare_unadorned_ (ffeexpr_tokens_[0], FALSE);
+ if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
+ {
+ e->u.operand = ffebld_new_any ();
+ ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+ }
+ else
+ {
+ e->u.operand = ffebld_new_symter (s, FFEINTRIN_genNONE,
+ ffesymbol_specific (s),
+ ffesymbol_implementation (s));
+ if (ffesymbol_specific (s) == FFEINTRIN_specNONE)
+ ffebld_set_info (e->u.operand, ffeinfo_use (ffesymbol_info (s)));
+ else
+ { /* Decorate the SYMTER with the actual type
+ of the intrinsic. */
+ ffebld_set_info (e->u.operand, ffeinfo_new
+ (ffeintrin_basictype (ffesymbol_specific (s)),
+ ffeintrin_kindtype (ffesymbol_specific (s)),
+ 0,
+ ffesymbol_kind (s),
+ ffesymbol_where (s),
+ FFETARGET_charactersizeNONE));
+ }
+ if (ffesymbol_is_doiter (s))
+ ffebld_symter_set_is_doiter (e->u.operand, TRUE);
+ e->u.operand = ffeexpr_collapse_symter (e->u.operand,
+ ffeexpr_tokens_[0]);
+ }
+ ffeexpr_exprstack_push_operand_ (e);
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* ffeexpr_token_name_apos_ -- Rhs NAME APOSTROPHE
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Expecting a NAME token, analyze the previous NAME token to see what kind,
+ if any, typeless constant we've got.
+
+ 01-Sep-90 JCB 1.1
+ Expect a NAME instead of CHARACTER in this situation. */
+
+static ffelexHandler
+ffeexpr_token_name_apos_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+
+ ffelex_set_hexnum (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffeexpr_tokens_[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_name_apos_name_;
+
+ default:
+ break;
+ }
+
+ if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
+ {
+ ffebad_string (ffelex_token_text (ffeexpr_tokens_[0]));
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_here (1, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->u.operand = ffebld_new_any ();
+ ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+ e->token = ffeexpr_tokens_[0];
+ ffeexpr_exprstack_push_operand_ (e);
+
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* ffeexpr_token_name_apos_name_ -- Rhs NAME APOSTROPHE NAME
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Expecting an APOSTROPHE token, analyze the previous NAME token to see
+ what kind, if any, typeless constant we've got. */
+
+static ffelexHandler
+ffeexpr_token_name_apos_name_ (ffelexToken t)
+{
+ ffeexprExpr_ e;
+ char c;
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->token = ffeexpr_tokens_[0];
+
+ if ((ffelex_token_type (t) == ffelex_token_type (ffeexpr_tokens_[1]))
+ && (ffelex_token_length (ffeexpr_tokens_[0]) == 1)
+ && (ffesrc_char_match_init ((c = ffelex_token_text (ffeexpr_tokens_[0])[0]),
+ 'B', 'b')
+ || ffesrc_char_match_init (c, 'O', 'o')
+ || ffesrc_char_match_init (c, 'X', 'x')
+ || ffesrc_char_match_init (c, 'Z', 'z')))
+ {
+ ffetargetCharacterSize size;
+
+ if (!ffe_is_typeless_boz ()) {
+
+ switch (c)
+ {
+ case FFESRC_CASE_MATCH_INIT ('B', 'b', imatch_b, no_imatch):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_integerbinary
+ (ffeexpr_tokens_[2]));
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('O', 'o', imatch_o, no_imatch):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_integeroctal
+ (ffeexpr_tokens_[2]));
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('X', 'x', imatch_x, no_imatch):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_integerhex
+ (ffeexpr_tokens_[2]));
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('Z', 'z', imatch_z, no_imatch):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_integerhex
+ (ffeexpr_tokens_[2]));
+ break;
+
+ default:
+ no_imatch: /* :::::::::::::::::::: */
+ assert ("not BOXZ!" == NULL);
+ abort ();
+ }
+
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ ffeexpr_exprstack_push_operand_ (e);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+ }
+
+ switch (c)
+ {
+ case FFESRC_CASE_MATCH_INIT ('B', 'b', match_b, no_match):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_bm
+ (ffeexpr_tokens_[2]));
+ size = ffetarget_size_typeless_binary (ffeexpr_tokens_[2]);
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('O', 'o', match_o, no_match):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_om
+ (ffeexpr_tokens_[2]));
+ size = ffetarget_size_typeless_octal (ffeexpr_tokens_[2]);
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('X', 'x', match_x, no_match):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hxm
+ (ffeexpr_tokens_[2]));
+ size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('Z', 'z', match_z, no_match):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hzm
+ (ffeexpr_tokens_[2]));
+ size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
+ break;
+
+ default:
+ no_match: /* :::::::::::::::::::: */
+ assert ("not BOXZ!" == NULL);
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hzm
+ (ffeexpr_tokens_[2]));
+ size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
+ break;
+ }
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeTYPELESS, FFEINFO_kindtypeNONE,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, size));
+ ffeexpr_exprstack_push_operand_ (e);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+ return (ffelexHandler) ffeexpr_token_binary_;
+ }
+
+ if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
+ {
+ ffebad_string (ffelex_token_text (ffeexpr_tokens_[0]));
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[2]);
+
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ e->u.operand = ffebld_new_any ();
+ ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+ e->token = ffeexpr_tokens_[0];
+ ffeexpr_exprstack_push_operand_ (e);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ return (ffelexHandler) ffeexpr_token_binary_;
+
+ default:
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+ }
+}
+
+/* ffeexpr_token_percent_ -- Rhs PERCENT
+
+ Handle a percent sign possibly followed by "LOC". If followed instead
+ by "VAL", "REF", or "DESCR", issue an error message and substitute
+ "LOC". If followed by something else, treat the percent sign as a
+ spurious incorrect token and reprocess the token via _rhs_. */
+
+static ffelexHandler
+ffeexpr_token_percent_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffeexpr_stack_->percent = ffeexpr_percent_ (t);
+ ffeexpr_tokens_[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_token_percent_name_;
+
+ default:
+ if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+ ffelex_token_where_column (ffeexpr_stack_->first_token));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ return (ffelexHandler) ffeexpr_token_rhs_ (t);
+ }
+}
+
+/* ffeexpr_token_percent_name_ -- Rhs PERCENT NAME
+
+ Make sure the token is OPEN_PAREN and prepare for the one-item list of
+ LHS expressions. Else display an error message. */
+
+static ffelexHandler
+ffeexpr_token_percent_name_ (ffelexToken t)
+{
+ ffelexHandler nexthandler;
+
+ if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
+ {
+ if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+ ffelex_token_where_column (ffeexpr_stack_->first_token));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_tokens_[0]);
+ nexthandler = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_tokens_[1]);
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ return (ffelexHandler) (*nexthandler) (t);
+ }
+
+ switch (ffeexpr_stack_->percent)
+ {
+ default:
+ if (ffest_ffebad_start (FFEBAD_INVALID_PERCENT))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+ ffelex_token_where_column (ffeexpr_tokens_[0]));
+ ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+ ffebad_finish ();
+ }
+ ffeexpr_stack_->percent = FFEEXPR_percentLOC_;
+ /* Fall through. */
+ case FFEEXPR_percentLOC_:
+ ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
+ ffelex_token_kill (ffeexpr_tokens_[1]);
+ ffeexpr_stack_->tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextLOC_,
+ ffeexpr_cb_end_loc_);
+ }
+}
+
+/* ffeexpr_make_float_const_ -- Make a floating-point constant
+
+ See prototype.
+
+ Pass 'E', 'D', or 'Q' for exponent letter. */
+
+static void
+ffeexpr_make_float_const_ (char exp_letter, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits)
+{
+ ffeexprExpr_ e;
+
+ e = ffeexpr_expr_new_ ();
+ e->type = FFEEXPR_exprtypeOPERAND_;
+ if (integer != NULL)
+ e->token = ffelex_token_use (integer);
+ else
+ {
+ assert (decimal != NULL);
+ e->token = ffelex_token_use (decimal);
+ }
+
+ switch (exp_letter)
+ {
+#if !FFETARGET_okREALQUAD
+ case FFESRC_CASE_MATCH_INIT ('Q', 'q', match_q, no_match):
+ if (ffebad_start (FFEBAD_QUAD_UNSUPPORTED))
+ {
+ ffebad_here (0, ffelex_token_where_line (e->token),
+ ffelex_token_where_column (e->token));
+ ffebad_finish ();
+ }
+ goto match_d; /* The FFESRC_CASE_* macros don't
+ allow fall-through! */
+#endif
+
+ case FFESRC_CASE_MATCH_INIT ('D', 'd', match_d, no_match):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_realdouble
+ (integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALDOUBLE,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+ break;
+
+ case FFESRC_CASE_MATCH_INIT ('E', 'e', match_e, no_match):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_realdefault
+ (integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
+ ffebld_set_info (e->u.operand, ffeinfo_new (FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREALDEFAULT, 0, FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+ break;
+
+#if FFETARGET_okREALQUAD
+ case FFESRC_CASE_MATCH_INIT ('Q', 'q', match_q, no_match):
+ e->u.operand = ffebld_new_conter (ffebld_constant_new_realquad
+ (integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
+ ffebld_set_info (e->u.operand,
+ ffeinfo_new (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALQUAD,
+ 0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+ break;
+#endif
+
+ default:
+ no_match: /* :::::::::::::::::::: */
+ assert ("Lost the exponent letter!" == NULL);
+ }
+
+ ffeexpr_exprstack_push_operand_ (e);
+}
+
+/* Just like ffesymbol_declare_local, except performs any implicit info
+ assignment necessary. */
+
+static ffesymbol
+ffeexpr_declare_unadorned_ (ffelexToken t, bool maybe_intrin)
+{
+ ffesymbol s;
+ ffeinfoKind k;
+ bool bad;
+
+ s = ffesymbol_declare_local (t, maybe_intrin);
+
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ /* Special-case these since they can involve a different concept
+ of "state" (in the stmtfunc name space). */
+ {
+ case FFEEXPR_contextDATAIMPDOINDEX_:
+ case FFEEXPR_contextDATAIMPDOCTRL_:
+ if (ffeexpr_context_outer_ (ffeexpr_stack_)
+ == FFEEXPR_contextDATAIMPDOINDEX_)
+ s = ffeexpr_sym_impdoitem_ (s, t);
+ else
+ if (ffeexpr_stack_->is_rhs)
+ s = ffeexpr_sym_impdoitem_ (s, t);
+ else
+ s = ffeexpr_sym_lhs_impdoctrl_ (s, t);
+ bad = (ffesymbol_kind (s) != FFEINFO_kindENTITY)
+ || ((ffesymbol_where (s) != FFEINFO_whereCONSTANT)
+ && (ffesymbol_where (s) != FFEINFO_whereIMMEDIATE));
+ if (bad && (ffesymbol_kind (s) != FFEINFO_kindANY))
+ ffesymbol_error (s, t);
+ return s;
+
+ default:
+ break;
+ }
+
+ switch ((ffesymbol_sfdummyparent (s) == NULL)
+ ? ffesymbol_state (s)
+ : FFESYMBOL_stateUNDERSTOOD)
+ {
+ case FFESYMBOL_stateNONE: /* Before first exec, not seen in expr
+ context. */
+ if (!ffest_seen_first_exec ())
+ goto seen; /* :::::::::::::::::::: */
+ /* Fall through. */
+ case FFESYMBOL_stateUNCERTAIN: /* Unseen since first exec. */
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextSUBROUTINEREF:
+ s = ffeexpr_sym_lhs_call_ (s, t);
+ break;
+
+ case FFEEXPR_contextFILEEXTFUNC:
+ s = ffeexpr_sym_lhs_extfunc_ (s, t);
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ /* Fall through. */
+ case FFEEXPR_contextACTUALARG_:
+ s = ffeexpr_sym_rhs_actualarg_ (s, t);
+ break;
+
+ case FFEEXPR_contextDATA:
+ if (ffeexpr_stack_->is_rhs)
+ s = ffeexpr_sym_rhs_let_ (s, t);
+ else
+ s = ffeexpr_sym_lhs_data_ (s, t);
+ break;
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ s = ffeexpr_sym_lhs_data_ (s, t);
+ break;
+
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ /* Fall through. */
+ case FFEEXPR_contextLET:
+ case FFEEXPR_contextPAREN_:
+ case FFEEXPR_contextACTUALARGEXPR_:
+ case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextASSIGN:
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextDO:
+ case FFEEXPR_contextDOWHILE:
+ case FFEEXPR_contextAGOTO:
+ case FFEEXPR_contextCGOTO:
+ case FFEEXPR_contextIF:
+ case FFEEXPR_contextARITHIF:
+ case FFEEXPR_contextFORMAT:
+ case FFEEXPR_contextSTOP:
+ case FFEEXPR_contextRETURN:
+ case FFEEXPR_contextSELECTCASE:
+ case FFEEXPR_contextCASE:
+ case FFEEXPR_contextFILEASSOC:
+ case FFEEXPR_contextFILEINT:
+ case FFEEXPR_contextFILEDFINT:
+ case FFEEXPR_contextFILELOG:
+ case FFEEXPR_contextFILENUM:
+ case FFEEXPR_contextFILENUMAMBIG:
+ case FFEEXPR_contextFILECHAR:
+ case FFEEXPR_contextFILENUMCHAR:
+ case FFEEXPR_contextFILEDFCHAR:
+ case FFEEXPR_contextFILEKEY:
+ case FFEEXPR_contextFILEUNIT:
+ case FFEEXPR_contextFILEUNIT_DF:
+ case FFEEXPR_contextFILEUNITAMBIG:
+ case FFEEXPR_contextFILEFORMAT:
+ case FFEEXPR_contextFILENAMELIST:
+ case FFEEXPR_contextFILEVXTCODE:
+ case FFEEXPR_contextINDEX_:
+ case FFEEXPR_contextIMPDOITEM_:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ case FFEEXPR_contextIMPDOCTRL_:
+ case FFEEXPR_contextLOC_:
+ if (ffeexpr_stack_->is_rhs)
+ s = ffeexpr_sym_rhs_let_ (s, t);
+ else
+ s = ffeexpr_sym_lhs_let_ (s, t);
+ break;
+
+ case FFEEXPR_contextCHARACTERSIZE:
+ case FFEEXPR_contextEQUIVALENCE:
+ case FFEEXPR_contextINCLUDE:
+ case FFEEXPR_contextPARAMETER:
+ case FFEEXPR_contextDIMLIST:
+ case FFEEXPR_contextDIMLISTCOMMON:
+ case FFEEXPR_contextKINDTYPE:
+ case FFEEXPR_contextINITVAL:
+ case FFEEXPR_contextEQVINDEX_:
+ break; /* Will turn into errors below. */
+
+ default:
+ ffesymbol_error (s, t);
+ break;
+ }
+ /* Fall through. */
+ case FFESYMBOL_stateUNDERSTOOD: /* Nothing much more to learn. */
+ understood: /* :::::::::::::::::::: */
+ k = ffesymbol_kind (s);
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextSUBROUTINEREF:
+ bad = ((k != FFEINFO_kindSUBROUTINE)
+ && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
+ || (k != FFEINFO_kindNONE)));
+ break;
+
+ case FFEEXPR_contextFILEEXTFUNC:
+ bad = (k != FFEINFO_kindFUNCTION)
+ || (ffesymbol_where (s) != FFEINFO_whereGLOBAL);
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextACTUALARG_:
+ switch (k)
+ {
+ case FFEINFO_kindENTITY:
+ bad = FALSE;
+ break;
+
+ case FFEINFO_kindFUNCTION:
+ case FFEINFO_kindSUBROUTINE:
+ bad
+ = ((ffesymbol_where (s) != FFEINFO_whereGLOBAL)
+ && (ffesymbol_where (s) != FFEINFO_whereDUMMY)
+ && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
+ || !ffeintrin_is_actualarg (ffesymbol_specific (s))));
+ break;
+
+ case FFEINFO_kindNONE:
+ if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+ {
+ bad = !(ffeintrin_is_actualarg (ffesymbol_specific (s)));
+ break;
+ }
+
+ /* If state is UNDERSTOOD here, it's CHAR*(*) or attrsANY,
+ and in the former case, attrsTYPE is set, so we
+ see this as an error as we should, since CHAR*(*)
+ cannot be actually referenced in a main/block data
+ program unit. */
+
+ if ((ffesymbol_attrs (s) & (FFESYMBOL_attrsANY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE))
+ == FFESYMBOL_attrsEXTERNAL)
+ bad = FALSE;
+ else
+ bad = TRUE;
+ break;
+
+ default:
+ bad = TRUE;
+ break;
+ }
+ break;
+
+ case FFEEXPR_contextDATA:
+ if (ffeexpr_stack_->is_rhs)
+ bad = (k != FFEINFO_kindENTITY)
+ || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
+ else
+ bad = (k != FFEINFO_kindENTITY)
+ || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+ && (ffesymbol_where (s) != FFEINFO_whereLOCAL)
+ && (ffesymbol_where (s) != FFEINFO_whereCOMMON));
+ break;
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ bad = TRUE; /* Unadorned item never valid. */
+ break;
+
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextLET:
+ case FFEEXPR_contextPAREN_:
+ case FFEEXPR_contextACTUALARGEXPR_:
+ case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextASSIGN:
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextDO:
+ case FFEEXPR_contextDOWHILE:
+ case FFEEXPR_contextAGOTO:
+ case FFEEXPR_contextCGOTO:
+ case FFEEXPR_contextIF:
+ case FFEEXPR_contextARITHIF:
+ case FFEEXPR_contextFORMAT:
+ case FFEEXPR_contextSTOP:
+ case FFEEXPR_contextRETURN:
+ case FFEEXPR_contextSELECTCASE:
+ case FFEEXPR_contextCASE:
+ case FFEEXPR_contextFILEASSOC:
+ case FFEEXPR_contextFILEINT:
+ case FFEEXPR_contextFILEDFINT:
+ case FFEEXPR_contextFILELOG:
+ case FFEEXPR_contextFILENUM:
+ case FFEEXPR_contextFILENUMAMBIG:
+ case FFEEXPR_contextFILECHAR:
+ case FFEEXPR_contextFILENUMCHAR:
+ case FFEEXPR_contextFILEDFCHAR:
+ case FFEEXPR_contextFILEKEY:
+ case FFEEXPR_contextFILEUNIT:
+ case FFEEXPR_contextFILEUNIT_DF:
+ case FFEEXPR_contextFILEUNITAMBIG:
+ case FFEEXPR_contextFILEFORMAT:
+ case FFEEXPR_contextFILENAMELIST:
+ case FFEEXPR_contextFILEVXTCODE:
+ case FFEEXPR_contextINDEX_:
+ case FFEEXPR_contextIMPDOITEM_:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ case FFEEXPR_contextIMPDOCTRL_:
+ case FFEEXPR_contextLOC_:
+ bad = (k != FFEINFO_kindENTITY); /* This catches "SUBROUTINE
+ X(A);EXTERNAL A;CALL
+ Y(A);B=A", for example. */
+ break;
+
+ case FFEEXPR_contextCHARACTERSIZE:
+ case FFEEXPR_contextEQUIVALENCE:
+ case FFEEXPR_contextPARAMETER:
+ case FFEEXPR_contextDIMLIST:
+ case FFEEXPR_contextDIMLISTCOMMON:
+ case FFEEXPR_contextKINDTYPE:
+ case FFEEXPR_contextINITVAL:
+ case FFEEXPR_contextEQVINDEX_:
+ bad = (k != FFEINFO_kindENTITY)
+ || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
+ break;
+
+ case FFEEXPR_contextINCLUDE:
+ bad = TRUE;
+ break;
+
+ default:
+ bad = TRUE;
+ break;
+ }
+ if (bad && (k != FFEINFO_kindANY))
+ ffesymbol_error (s, t);
+ return s;
+
+ case FFESYMBOL_stateSEEN: /* Seen but not yet in exec portion. */
+ seen: /* :::::::::::::::::::: */
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextPARAMETER:
+ if (ffeexpr_stack_->is_rhs)
+ ffesymbol_error (s, t);
+ else
+ s = ffeexpr_sym_lhs_parameter_ (s, t);
+ break;
+
+ case FFEEXPR_contextDATA:
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ if (ffeexpr_stack_->is_rhs)
+ ffesymbol_error (s, t);
+ else
+ s = ffeexpr_sym_lhs_data_ (s, t);
+ goto understood; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ s = ffeexpr_sym_lhs_data_ (s, t);
+ goto understood; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextEQUIVALENCE:
+ s = ffeexpr_sym_lhs_equivalence_ (s, t);
+ break;
+
+ case FFEEXPR_contextDIMLIST:
+ s = ffeexpr_sym_rhs_dimlist_ (s, t);
+ break;
+
+ case FFEEXPR_contextCHARACTERSIZE:
+ case FFEEXPR_contextKINDTYPE:
+ case FFEEXPR_contextDIMLISTCOMMON:
+ case FFEEXPR_contextINITVAL:
+ case FFEEXPR_contextEQVINDEX_:
+ ffesymbol_error (s, t);
+ break;
+
+ case FFEEXPR_contextINCLUDE:
+ ffesymbol_error (s, t);
+ break;
+
+ case FFEEXPR_contextACTUALARG_: /* E.g. I in REAL A(Y(I)). */
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ s = ffeexpr_sym_rhs_actualarg_ (s, t);
+ goto understood; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextINDEX_:
+ case FFEEXPR_contextACTUALARGEXPR_:
+ case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ assert (ffeexpr_stack_->is_rhs);
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ s = ffeexpr_sym_rhs_let_ (s, t);
+ goto understood; /* :::::::::::::::::::: */
+
+ default:
+ ffesymbol_error (s, t);
+ break;
+ }
+ return s;
+
+ default:
+ assert ("bad symbol state" == NULL);
+ return NULL;
+ break;
+ }
+}
+
+/* Have FOO in DATA (XYZ(FOO),...)/.../ or DATA (...,XYZ=FOO,BAR,BLETCH).
+ Could be found via the "statement-function" name space (in which case
+ it should become an iterator) or the local name space (in which case
+ it should be either a named constant, or a variable that will have an
+ sfunc name space sibling that should become an iterator). */
+
+static ffesymbol
+ffeexpr_sym_impdoitem_ (ffesymbol sp, ffelexToken t)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffesymbolState ss;
+ ffesymbolState ns;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+
+ ss = ffesymbol_state (sp);
+
+ if (ffesymbol_sfdummyparent (sp) != NULL)
+ { /* Have symbol in sfunc name space. */
+ switch (ss)
+ {
+ case FFESYMBOL_stateNONE: /* Used as iterator already. */
+ if (ffeexpr_level_ < ffesymbol_maxentrynum (sp))
+ ffesymbol_error (sp, t); /* Can't use dead iterator. */
+ else
+ { /* Can use dead iterator because we're at at
+ least an innermore (higher-numbered) level
+ than the iterator's outermost
+ (lowest-numbered) level. */
+ ffesymbol_signal_change (sp);
+ ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
+ ffesymbol_set_maxentrynum (sp, ffeexpr_level_);
+ ffesymbol_signal_unreported (sp);
+ }
+ break;
+
+ case FFESYMBOL_stateSEEN: /* Seen already in this or other
+ implied-DO. Set symbol level
+ number to outermost value, as that
+ tells us we can see it as iterator
+ at that level at the innermost. */
+ if (ffeexpr_level_ < ffesymbol_maxentrynum (sp))
+ {
+ ffesymbol_signal_change (sp);
+ ffesymbol_set_maxentrynum (sp, ffeexpr_level_);
+ ffesymbol_signal_unreported (sp);
+ }
+ break;
+
+ case FFESYMBOL_stateUNCERTAIN: /* Iterator. */
+ assert (ffeexpr_level_ == ffesymbol_maxentrynum (sp));
+ ffesymbol_error (sp, t); /* (,,,I=I,10). */
+ break;
+
+ case FFESYMBOL_stateUNDERSTOOD:
+ break; /* ANY. */
+
+ default:
+ assert ("Foo Bar!!" == NULL);
+ break;
+ }
+
+ return sp;
+ }
+
+ /* Got symbol in local name space, so we haven't seen it in impdo yet.
+ First, if it is brand-new and we're in executable statements, set the
+ attributes and exec-transition it to set state UNCERTAIN or UNDERSTOOD.
+ Second, if it is now a constant (PARAMETER), then just return it, it
+ can't be an implied-do iterator. If it is understood, complain if it is
+ not a valid variable, but make the inner name space iterator anyway and
+ return that. If it is not understood, improve understanding of the
+ symbol accordingly, complain accordingly, in either case make the inner
+ name space iterator and return that. */
+
+ sa = ffesymbol_attrs (sp);
+
+ if (ffesymbol_state_is_specable (ss)
+ && ffest_seen_first_exec ())
+ {
+ assert (sa == FFESYMBOL_attrsetNONE);
+ ffesymbol_signal_change (sp);
+ ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
+ ffesymbol_resolve_intrin (sp);
+ if (ffeimplic_establish_symbol (sp))
+ ffesymbol_set_attr (sp, FFESYMBOL_attrSFARG);
+ else
+ ffesymbol_error (sp, t);
+
+ /* After the exec transition, the state will either be UNCERTAIN (could
+ be a dummy or local var) or UNDERSTOOD (local var, because this is a
+ PROGRAM/BLOCKDATA program unit). */
+
+ sp = ffecom_sym_exec_transition (sp);
+ sa = ffesymbol_attrs (sp);
+ ss = ffesymbol_state (sp);
+ }
+
+ ns = ss;
+ kind = ffesymbol_kind (sp);
+ where = ffesymbol_where (sp);
+
+ if (ss == FFESYMBOL_stateUNDERSTOOD)
+ {
+ if (kind != FFEINFO_kindENTITY)
+ ffesymbol_error (sp, t);
+ if (where == FFEINFO_whereCONSTANT)
+ return sp;
+ }
+ else
+ {
+ /* Enhance understanding of local symbol. This used to imply exec
+ transition, but that doesn't seem necessary, since the local symbol
+ doesn't actually get put into an ffebld tree here -- we just learn
+ more about it, just like when we see a local symbol's name in the
+ dummy-arg list of a statement function. */
+
+ if (ss != FFESYMBOL_stateUNCERTAIN)
+ {
+ /* Figure out what kind of object we've got based on previous
+ declarations of or references to the object. */
+
+ ns = FFESYMBOL_stateSEEN;
+
+ if (sa & FFESYMBOL_attrsANY)
+ na = sa;
+ else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsANY
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsRESULT
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsSFARG;
+ else
+ na = FFESYMBOL_attrsetNONE;
+ }
+ else
+ { /* stateUNCERTAIN. */
+ na = sa | FFESYMBOL_attrsSFARG;
+ ns = FFESYMBOL_stateUNDERSTOOD;
+
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ na = FFESYMBOL_attrsetNONE;
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = FFEINFO_kindENTITY;
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsTYPE)));
+
+ na = FFESYMBOL_attrsetNONE;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ ns = FFESYMBOL_stateUNCERTAIN;
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsTYPE
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG)));
+
+ kind = FFEINFO_kindENTITY;
+
+ if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
+ na = FFESYMBOL_attrsetNONE;
+ else if (ffest_is_entry_valid ())
+ ns = FFESYMBOL_stateUNCERTAIN; /* Could be DUMMY or LOCAL. */
+ else
+ where = FFEINFO_whereLOCAL;
+ }
+ else
+ na = FFESYMBOL_attrsetNONE; /* Error. */
+ }
+
+ /* Now see what we've got for a new object: NONE means a new error
+ cropped up; ANY means an old error to be ignored; otherwise,
+ everything's ok, update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (sp, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (sp); /* May need to back up to previous
+ version. */
+ if (!ffeimplic_establish_symbol (sp))
+ ffesymbol_error (sp, t);
+ ffesymbol_set_info (sp,
+ ffeinfo_new (ffesymbol_basictype (sp),
+ ffesymbol_kindtype (sp),
+ ffesymbol_rank (sp),
+ kind,
+ where,
+ ffesymbol_size (sp)));
+ ffesymbol_set_attrs (sp, na);
+ ffesymbol_set_state (sp, ns);
+ ffesymbol_resolve_intrin (sp);
+ if (!ffesymbol_state_is_specable (ns))
+ sp = ffecom_sym_learned (sp);
+ ffesymbol_signal_unreported (sp); /* For debugging purposes. */
+ }
+ }
+
+ /* Here we create the sfunc-name-space symbol representing what should
+ become an iterator in this name space at this or an outermore (lower-
+ numbered) expression level, else the implied-DO construct is in error. */
+
+ s = ffesymbol_declare_sfdummy (t); /* Sets maxentrynum to 0 for new obj;
+ also sets sfa_dummy_parent to
+ parent symbol. */
+ assert (sp == ffesymbol_sfdummyparent (s));
+
+ ffesymbol_signal_change (s);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_set_maxentrynum (s, ffeexpr_level_);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereIMMEDIATE,
+ FFETARGET_charactersizeNONE));
+ ffesymbol_signal_unreported (s);
+
+ if (((ffesymbol_basictype (sp) != FFEINFO_basictypeINTEGER)
+ && (ffesymbol_basictype (sp) != FFEINFO_basictypeANY))
+ || ((ffesymbol_kindtype (sp) != FFEINFO_kindtypeINTEGERDEFAULT)
+ && (ffesymbol_kindtype (sp) != FFEINFO_kindtypeANY)))
+ ffesymbol_error (s, t);
+
+ return s;
+}
+
+/* Have FOO in CALL FOO. Local name space, executable context only. */
+
+static ffesymbol
+ffeexpr_sym_lhs_call_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ ffeintrinGen gen;
+ ffeintrinSpec spec;
+ ffeintrinImp imp;
+ bool error = FALSE;
+
+ assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+ na = sa = ffesymbol_attrs (s);
+
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = ffesymbol_kind (s);
+ where = ffesymbol_where (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsTYPE)
+ error = TRUE;
+ else
+ /* Not TYPE. */
+ {
+ kind = FFEINFO_kindSUBROUTINE;
+
+ if (sa & FFESYMBOL_attrsDUMMY)
+ ; /* Not TYPE. */
+ else if (sa & FFESYMBOL_attrsACTUALARG)
+ ; /* Not DUMMY or TYPE. */
+ else /* Not ACTUALARG, DUMMY, or TYPE. */
+ where = FFEINFO_whereGLOBAL;
+ }
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsTYPE)
+ error = TRUE;
+ else
+ kind = FFEINFO_kindSUBROUTINE;
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsTYPE)));
+
+ error = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ error = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsTYPE
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG)));
+
+ error = TRUE;
+ }
+ else if (sa == FFESYMBOL_attrsetNONE)
+ {
+ assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+
+ if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
+ &gen, &spec, &imp))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ ffesymbol_set_generic (s, gen);
+ ffesymbol_set_specific (s, spec);
+ ffesymbol_set_implementation (s, imp);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindSUBROUTINE,
+ FFEINFO_whereINTRINSIC,
+ FFETARGET_charactersizeNONE));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_reference (s, t, FALSE);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+
+ return s;
+ }
+
+ kind = FFEINFO_kindSUBROUTINE;
+ where = FFEINFO_whereGLOBAL;
+ }
+ else
+ error = TRUE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (error)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind, /* SUBROUTINE. */
+ where, /* GLOBAL or DUMMY. */
+ ffesymbol_size (s)));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_reference (s, t, FALSE);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* Have FOO in DATA FOO/.../. Local name space and executable context
+ only. (This will change in the future when DATA FOO may be followed
+ by COMMON FOO or even INTEGER FOO(10), etc.) */
+
+static ffesymbol
+ffeexpr_sym_lhs_data_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ bool error = FALSE;
+
+ assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+ na = sa = ffesymbol_attrs (s);
+
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = ffesymbol_kind (s);
+ where = ffesymbol_where (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ error = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ error = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsADJUSTABLE)
+ error = TRUE;
+ where = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ where = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsTYPE
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG)));
+
+ if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
+ error = TRUE;
+ else
+ {
+ kind = FFEINFO_kindENTITY;
+ where = FFEINFO_whereLOCAL;
+ }
+ }
+ else if (sa == FFESYMBOL_attrsetNONE)
+ {
+ assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+ kind = FFEINFO_kindENTITY;
+ where = FFEINFO_whereLOCAL;
+ }
+ else
+ error = TRUE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (error)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ if (!ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, t);
+ return s;
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind, /* ENTITY. */
+ where, /* LOCAL. */
+ ffesymbol_size (s)));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* Have FOO in EQUIVALENCE (...,FOO,...). Does not include
+ EQUIVALENCE (...,BAR(FOO),...). */
+
+static ffesymbol
+ffeexpr_sym_lhs_equivalence_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+
+ na = sa = ffesymbol_attrs (s);
+ kind = FFEINFO_kindENTITY;
+ where = ffesymbol_where (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsEQUIV;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Don't know why we're bothering to set kind and where in this code, but
+ added the following to make it complete, in case it's really important.
+ Generally this is left up to symbol exec transition. */
+
+ if (where == FFEINFO_whereNONE)
+ {
+ if (na & (FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsCOMMON))
+ where = FFEINFO_whereCOMMON;
+ else if (na & FFESYMBOL_attrsSAVE)
+ where = FFEINFO_whereLOCAL;
+ }
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind, /* Always ENTITY. */
+ where, /* NONE, COMMON, or LOCAL. */
+ ffesymbol_size (s)));
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* Have FOO in OPEN(...,USEROPEN=FOO,...). Executable context only.
+
+ Note that I think this should be considered semantically similar to
+ doing CALL XYZ(FOO), in that it should be considered like an
+ ACTUALARG context. In particular, without EXTERNAL being specified,
+ it should not be allowed. */
+
+static ffesymbol
+ffeexpr_sym_lhs_extfunc_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ bool needs_type = FALSE;
+ bool error = FALSE;
+
+ assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+ na = sa = ffesymbol_attrs (s);
+
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = ffesymbol_kind (s);
+ where = ffesymbol_where (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsTYPE)
+ where = FFEINFO_whereGLOBAL;
+ else
+ /* Not TYPE. */
+ {
+ kind = FFEINFO_kindFUNCTION;
+ needs_type = TRUE;
+
+ if (sa & FFESYMBOL_attrsDUMMY)
+ ; /* Not TYPE. */
+ else if (sa & FFESYMBOL_attrsACTUALARG)
+ ; /* Not DUMMY or TYPE. */
+ else /* Not ACTUALARG, DUMMY, or TYPE. */
+ where = FFEINFO_whereGLOBAL;
+ }
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = FFEINFO_kindFUNCTION;
+ if (!(sa & FFESYMBOL_attrsTYPE))
+ needs_type = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsTYPE)));
+
+ error = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ error = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsTYPE
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG)));
+
+ if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
+ error = TRUE;
+ else
+ {
+ kind = FFEINFO_kindFUNCTION;
+ where = FFEINFO_whereGLOBAL;
+ }
+ }
+ else if (sa == FFESYMBOL_attrsetNONE)
+ {
+ assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+ kind = FFEINFO_kindFUNCTION;
+ where = FFEINFO_whereGLOBAL;
+ needs_type = TRUE;
+ }
+ else
+ error = TRUE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (error)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ if (needs_type && !ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, t);
+ return s;
+ }
+ if (!ffesymbol_explicitwhere (s))
+ {
+ ffebad_start (FFEBAD_NEED_EXTERNAL);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_string (ffesymbol_text (s));
+ ffebad_finish ();
+ ffesymbol_set_explicitwhere (s, TRUE);
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind, /* FUNCTION. */
+ where, /* GLOBAL or DUMMY. */
+ ffesymbol_size (s)));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_reference (s, t, FALSE);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* Have FOO in DATA (stuff,FOO=1,10)/.../. */
+
+static ffesymbol
+ffeexpr_sym_lhs_impdoctrl_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolState ss;
+
+ /* If the symbol isn't in the sfunc name space, pretend as though we saw a
+ reference to it already within the imp-DO construct at this level, so as
+ to get a symbol that is in the sfunc name space. But this is an
+ erroneous construct, and should be caught elsewhere. */
+
+ if (ffesymbol_sfdummyparent (s) == NULL)
+ {
+ s = ffeexpr_sym_impdoitem_ (s, t);
+ if (ffesymbol_sfdummyparent (s) == NULL)
+ { /* PARAMETER FOO...DATA (A(I),FOO=...). */
+ ffesymbol_error (s, t);
+ return s;
+ }
+ }
+
+ ss = ffesymbol_state (s);
+
+ switch (ss)
+ {
+ case FFESYMBOL_stateNONE: /* Used as iterator already. */
+ if (ffeexpr_level_ < ffesymbol_maxentrynum (s))
+ ffesymbol_error (s, t); /* Can't reuse dead iterator. F90 disallows
+ this; F77 allows it but it is a stupid
+ feature. */
+ else
+ { /* Can use dead iterator because we're at at
+ least a innermore (higher-numbered) level
+ than the iterator's outermost
+ (lowest-numbered) level. This should be
+ diagnosed later, because it means an item
+ in this list didn't reference this
+ iterator. */
+#if 1
+ ffesymbol_error (s, t); /* For now, complain. */
+#else /* Someday will detect all cases where initializer doesn't reference
+ all applicable iterators, in which case reenable this code. */
+ ffesymbol_signal_change (s);
+ ffesymbol_set_state (s, FFESYMBOL_stateUNCERTAIN);
+ ffesymbol_set_maxentrynum (s, ffeexpr_level_);
+ ffesymbol_signal_unreported (s);
+#endif
+ }
+ break;
+
+ case FFESYMBOL_stateSEEN: /* Seen already in this or other implied-DO.
+ If seen in outermore level, can't be an
+ iterator here, so complain. If not seen
+ at current level, complain for now,
+ because that indicates something F90
+ rejects (though we currently don't detect
+ all such cases for now). */
+ if (ffeexpr_level_ <= ffesymbol_maxentrynum (s))
+ {
+ ffesymbol_signal_change (s);
+ ffesymbol_set_state (s, FFESYMBOL_stateUNCERTAIN);
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ ffesymbol_error (s, t);
+ break;
+
+ case FFESYMBOL_stateUNCERTAIN: /* Already iterator! */
+ assert ("DATA implied-DO control var seen twice!!" == NULL);
+ ffesymbol_error (s, t);
+ break;
+
+ case FFESYMBOL_stateUNDERSTOOD:
+ break; /* ANY. */
+
+ default:
+ assert ("Foo Bletch!!" == NULL);
+ break;
+ }
+
+ return s;
+}
+
+/* Have FOO in PARAMETER (FOO=...). */
+
+static ffesymbol
+ffeexpr_sym_lhs_parameter_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (sa & ~(FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsTYPE))
+ {
+ if (!(sa & FFESYMBOL_attrsANY))
+ ffesymbol_error (s, t);
+ }
+ else
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ if (!ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, t);
+ return s;
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ ffesymbol_size (s)));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* Have FOO in CALL XYZ(...,FOO,...). Does not include any other
+ embedding of FOO, such as CALL XYZ((FOO)) or CALL XYZ(FOO+1). */
+
+static ffesymbol
+ffeexpr_sym_rhs_actualarg_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ ffesymbolState ns;
+ bool needs_type = FALSE;
+
+ assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+ na = sa = ffesymbol_attrs (s);
+
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = ffesymbol_kind (s);
+ where = ffesymbol_where (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ ns = FFESYMBOL_stateUNDERSTOOD;
+
+ if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsTYPE)
+ where = FFEINFO_whereGLOBAL;
+ else
+ /* Not TYPE. */
+ {
+ ns = FFESYMBOL_stateUNCERTAIN;
+
+ if (sa & FFESYMBOL_attrsDUMMY)
+ assert (kind == FFEINFO_kindNONE); /* FUNCTION, SUBROUTINE. */
+ else if (sa & FFESYMBOL_attrsACTUALARG)
+ ; /* Not DUMMY or TYPE. */
+ else
+ /* Not ACTUALARG, DUMMY, or TYPE. */
+ {
+ assert (kind == FFEINFO_kindNONE); /* FUNCTION, SUBROUTINE. */
+ na |= FFESYMBOL_attrsACTUALARG;
+ where = FFEINFO_whereGLOBAL;
+ }
+ }
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = FFEINFO_kindENTITY;
+ if (!(sa & FFESYMBOL_attrsTYPE))
+ needs_type = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsTYPE)));
+
+ where = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ where = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsTYPE
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG)));
+
+ if (sa & FFESYMBOL_attrsANYLEN)
+ ns = FFESYMBOL_stateNONE;
+ else
+ {
+ kind = FFEINFO_kindENTITY;
+ where = FFEINFO_whereLOCAL;
+ }
+ }
+ else if (sa == FFESYMBOL_attrsetNONE)
+ {
+ /* New state is left empty because there isn't any state flag to
+ set for this case, and it's UNDERSTOOD after all. */
+ assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+ kind = FFEINFO_kindENTITY;
+ where = FFEINFO_whereLOCAL;
+ needs_type = TRUE;
+ }
+ else
+ ns = FFESYMBOL_stateNONE; /* Error. */
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (ns == FFESYMBOL_stateNONE)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ if (needs_type && !ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, t);
+ return s;
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind,
+ where,
+ ffesymbol_size (s)));
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, ns);
+ s = ffecom_sym_learned (s);
+ ffesymbol_reference (s, t, FALSE);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* Have FOO in DIMENSION XYZ(FOO) or any array declarator containing
+ a reference to FOO. */
+
+static ffesymbol
+ffeexpr_sym_rhs_dimlist_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+
+ na = sa = ffesymbol_attrs (s);
+ kind = FFEINFO_kindENTITY;
+ where = ffesymbol_where (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsADJUSTS;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Since this symbol definitely is going into an expression (the
+ dimension-list for some dummy array, presumably), figure out WHERE if
+ possible. */
+
+ if (where == FFEINFO_whereNONE)
+ {
+ if (na & (FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST))
+ where = FFEINFO_whereCOMMON;
+ else if (na & FFESYMBOL_attrsDUMMY)
+ where = FFEINFO_whereDUMMY;
+ }
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ if (!ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, t);
+ return s;
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind, /* Always ENTITY. */
+ where, /* NONE, COMMON, or DUMMY. */
+ ffesymbol_size (s)));
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* Have FOO in XYZ = ...FOO.... Does not include cases like FOO in
+ XYZ = BAR(FOO), as such cases are handled elsewhere. */
+
+static ffesymbol
+ffeexpr_sym_rhs_let_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ bool error = FALSE;
+
+ assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+ na = sa = ffesymbol_attrs (s);
+
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = ffesymbol_kind (s);
+ where = ffesymbol_where (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ error = TRUE;
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = FFEINFO_kindENTITY;
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsTYPE)));
+
+ where = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ where = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsTYPE
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG)));
+
+ if (sa & FFESYMBOL_attrsANYLEN)
+ error = TRUE;
+ else
+ {
+ kind = FFEINFO_kindENTITY;
+ where = FFEINFO_whereLOCAL;
+ }
+ }
+ else if (sa == FFESYMBOL_attrsetNONE)
+ {
+ assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+ kind = FFEINFO_kindENTITY;
+ where = FFEINFO_whereLOCAL;
+ }
+ else
+ error = TRUE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (error)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ if (!ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, t);
+ return s;
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind, /* ENTITY. */
+ where, /* LOCAL. */
+ ffesymbol_size (s)));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* ffeexpr_declare_parenthesized_ -- ffesymbol wrapper for NAME(...) operand
+
+ ffelexToken t;
+ bool maybe_intrin;
+ ffeexprParenType_ paren_type;
+ ffesymbol s;
+ s = ffeexpr_declare_parenthesized_ (t, maybe_intrin, &paren_type);
+
+ Just like ffesymbol_declare_local, except performs any implicit info
+ assignment necessary, and it returns the type of the parenthesized list
+ (list of function args, list of array args, or substring spec). */
+
+static ffesymbol
+ffeexpr_declare_parenthesized_ (ffelexToken t, bool maybe_intrin,
+ ffeexprParenType_ *paren_type)
+{
+ ffesymbol s;
+ ffesymbolState st; /* Effective state. */
+ ffeinfoKind k;
+ bool bad;
+
+ if (maybe_intrin && ffesrc_check_symbol ())
+ { /* Knock off some easy cases. */
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextSUBROUTINEREF:
+ case FFEEXPR_contextDATA:
+ case FFEEXPR_contextDATAIMPDOINDEX_:
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextLET:
+ case FFEEXPR_contextPAREN_:
+ case FFEEXPR_contextACTUALARGEXPR_:
+ case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextDO:
+ case FFEEXPR_contextDOWHILE:
+ case FFEEXPR_contextACTUALARG_:
+ case FFEEXPR_contextCGOTO:
+ case FFEEXPR_contextIF:
+ case FFEEXPR_contextARITHIF:
+ case FFEEXPR_contextFORMAT:
+ case FFEEXPR_contextSTOP:
+ case FFEEXPR_contextRETURN:
+ case FFEEXPR_contextSELECTCASE:
+ case FFEEXPR_contextCASE:
+ case FFEEXPR_contextFILEASSOC:
+ case FFEEXPR_contextFILEINT:
+ case FFEEXPR_contextFILEDFINT:
+ case FFEEXPR_contextFILELOG:
+ case FFEEXPR_contextFILENUM:
+ case FFEEXPR_contextFILENUMAMBIG:
+ case FFEEXPR_contextFILECHAR:
+ case FFEEXPR_contextFILENUMCHAR:
+ case FFEEXPR_contextFILEDFCHAR:
+ case FFEEXPR_contextFILEKEY:
+ case FFEEXPR_contextFILEUNIT:
+ case FFEEXPR_contextFILEUNIT_DF:
+ case FFEEXPR_contextFILEUNITAMBIG:
+ case FFEEXPR_contextFILEFORMAT:
+ case FFEEXPR_contextFILENAMELIST:
+ case FFEEXPR_contextFILEVXTCODE:
+ case FFEEXPR_contextINDEX_:
+ case FFEEXPR_contextIMPDOITEM_:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ case FFEEXPR_contextIMPDOCTRL_:
+ case FFEEXPR_contextDATAIMPDOCTRL_:
+ case FFEEXPR_contextCHARACTERSIZE:
+ case FFEEXPR_contextPARAMETER:
+ case FFEEXPR_contextDIMLIST:
+ case FFEEXPR_contextDIMLISTCOMMON:
+ case FFEEXPR_contextKINDTYPE:
+ case FFEEXPR_contextINITVAL:
+ case FFEEXPR_contextEQVINDEX_:
+ break; /* These could be intrinsic invocations. */
+
+ case FFEEXPR_contextAGOTO:
+ case FFEEXPR_contextFILEFORMATNML:
+ case FFEEXPR_contextALLOCATE:
+ case FFEEXPR_contextDEALLOCATE:
+ case FFEEXPR_contextHEAPSTAT:
+ case FFEEXPR_contextNULLIFY:
+ case FFEEXPR_contextINCLUDE:
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ case FFEEXPR_contextLOC_:
+ case FFEEXPR_contextINDEXORACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ case FFEEXPR_contextPARENFILENUM_:
+ case FFEEXPR_contextPARENFILEUNIT_:
+ maybe_intrin = FALSE;
+ break; /* Can't be intrinsic invocation. */
+
+ default:
+ assert ("blah! blah! waaauuggh!" == NULL);
+ break;
+ }
+ }
+
+ s = ffesymbol_declare_local (t, maybe_intrin);
+
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ /* Special-case these since they can involve a different concept
+ of "state" (in the stmtfunc name space). */
+ {
+ case FFEEXPR_contextDATAIMPDOINDEX_:
+ case FFEEXPR_contextDATAIMPDOCTRL_:
+ if (ffeexpr_context_outer_ (ffeexpr_stack_)
+ == FFEEXPR_contextDATAIMPDOINDEX_)
+ s = ffeexpr_sym_impdoitem_ (s, t);
+ else
+ if (ffeexpr_stack_->is_rhs)
+ s = ffeexpr_sym_impdoitem_ (s, t);
+ else
+ s = ffeexpr_sym_lhs_impdoctrl_ (s, t);
+ if (ffesymbol_kind (s) != FFEINFO_kindANY)
+ ffesymbol_error (s, t);
+ return s;
+
+ default:
+ break;
+ }
+
+ switch ((ffesymbol_sfdummyparent (s) == NULL)
+ ? ffesymbol_state (s)
+ : FFESYMBOL_stateUNDERSTOOD)
+ {
+ case FFESYMBOL_stateNONE: /* Before first exec, not seen in expr
+ context. */
+ if (!ffest_seen_first_exec ())
+ goto seen; /* :::::::::::::::::::: */
+ /* Fall through. */
+ case FFESYMBOL_stateUNCERTAIN: /* Unseen since first exec. */
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextSUBROUTINEREF:
+ s = ffeexpr_sym_lhs_call_ (s, t); /* "CALL FOO"=="CALL
+ FOO(...)". */
+ break;
+
+ case FFEEXPR_contextDATA:
+ if (ffeexpr_stack_->is_rhs)
+ s = ffeexpr_sym_rhs_let_ (s, t);
+ else
+ s = ffeexpr_sym_lhs_data_ (s, t);
+ break;
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ s = ffeexpr_sym_lhs_data_ (s, t);
+ break;
+
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ /* Fall through. */
+ case FFEEXPR_contextLET:
+ case FFEEXPR_contextPAREN_:
+ case FFEEXPR_contextACTUALARGEXPR_:
+ case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextDO:
+ case FFEEXPR_contextDOWHILE:
+ case FFEEXPR_contextACTUALARG_:
+ case FFEEXPR_contextCGOTO:
+ case FFEEXPR_contextIF:
+ case FFEEXPR_contextARITHIF:
+ case FFEEXPR_contextFORMAT:
+ case FFEEXPR_contextSTOP:
+ case FFEEXPR_contextRETURN:
+ case FFEEXPR_contextSELECTCASE:
+ case FFEEXPR_contextCASE:
+ case FFEEXPR_contextFILEASSOC:
+ case FFEEXPR_contextFILEINT:
+ case FFEEXPR_contextFILEDFINT:
+ case FFEEXPR_contextFILELOG:
+ case FFEEXPR_contextFILENUM:
+ case FFEEXPR_contextFILENUMAMBIG:
+ case FFEEXPR_contextFILECHAR:
+ case FFEEXPR_contextFILENUMCHAR:
+ case FFEEXPR_contextFILEDFCHAR:
+ case FFEEXPR_contextFILEKEY:
+ case FFEEXPR_contextFILEUNIT:
+ case FFEEXPR_contextFILEUNIT_DF:
+ case FFEEXPR_contextFILEUNITAMBIG:
+ case FFEEXPR_contextFILEFORMAT:
+ case FFEEXPR_contextFILENAMELIST:
+ case FFEEXPR_contextFILEVXTCODE:
+ case FFEEXPR_contextINDEX_:
+ case FFEEXPR_contextIMPDOITEM_:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ case FFEEXPR_contextIMPDOCTRL_:
+ case FFEEXPR_contextLOC_:
+ if (ffeexpr_stack_->is_rhs)
+ s = ffeexpr_paren_rhs_let_ (s, t);
+ else
+ s = ffeexpr_paren_lhs_let_ (s, t);
+ break;
+
+ case FFEEXPR_contextASSIGN:
+ case FFEEXPR_contextAGOTO:
+ case FFEEXPR_contextCHARACTERSIZE:
+ case FFEEXPR_contextEQUIVALENCE:
+ case FFEEXPR_contextINCLUDE:
+ case FFEEXPR_contextPARAMETER:
+ case FFEEXPR_contextDIMLIST:
+ case FFEEXPR_contextDIMLISTCOMMON:
+ case FFEEXPR_contextKINDTYPE:
+ case FFEEXPR_contextINITVAL:
+ case FFEEXPR_contextEQVINDEX_:
+ break; /* Will turn into errors below. */
+
+ default:
+ ffesymbol_error (s, t);
+ break;
+ }
+ /* Fall through. */
+ case FFESYMBOL_stateUNDERSTOOD: /* Nothing much more to learn. */
+ understood: /* :::::::::::::::::::: */
+
+ /* State might have changed, update it. */
+ st = ((ffesymbol_sfdummyparent (s) == NULL)
+ ? ffesymbol_state (s)
+ : FFESYMBOL_stateUNDERSTOOD);
+
+ k = ffesymbol_kind (s);
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextSUBROUTINEREF:
+ bad = ((k != FFEINFO_kindSUBROUTINE)
+ && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
+ || (k != FFEINFO_kindNONE)));
+ break;
+
+ case FFEEXPR_contextDATA:
+ if (ffeexpr_stack_->is_rhs)
+ bad = (k != FFEINFO_kindENTITY)
+ || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
+ else
+ bad = (k != FFEINFO_kindENTITY)
+ || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+ && (ffesymbol_where (s) != FFEINFO_whereLOCAL)
+ && (ffesymbol_where (s) != FFEINFO_whereCOMMON));
+ break;
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ bad = (k != FFEINFO_kindENTITY) || (ffesymbol_rank (s) == 0)
+ || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+ && (ffesymbol_where (s) != FFEINFO_whereLOCAL)
+ && (ffesymbol_where (s) != FFEINFO_whereCOMMON));
+ break;
+
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextLET:
+ case FFEEXPR_contextPAREN_:
+ case FFEEXPR_contextACTUALARGEXPR_:
+ case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextIOLIST:
+ case FFEEXPR_contextIOLISTDF:
+ case FFEEXPR_contextDO:
+ case FFEEXPR_contextDOWHILE:
+ case FFEEXPR_contextACTUALARG_:
+ case FFEEXPR_contextCGOTO:
+ case FFEEXPR_contextIF:
+ case FFEEXPR_contextARITHIF:
+ case FFEEXPR_contextFORMAT:
+ case FFEEXPR_contextSTOP:
+ case FFEEXPR_contextRETURN:
+ case FFEEXPR_contextSELECTCASE:
+ case FFEEXPR_contextCASE:
+ case FFEEXPR_contextFILEASSOC:
+ case FFEEXPR_contextFILEINT:
+ case FFEEXPR_contextFILEDFINT:
+ case FFEEXPR_contextFILELOG:
+ case FFEEXPR_contextFILENUM:
+ case FFEEXPR_contextFILENUMAMBIG:
+ case FFEEXPR_contextFILECHAR:
+ case FFEEXPR_contextFILENUMCHAR:
+ case FFEEXPR_contextFILEDFCHAR:
+ case FFEEXPR_contextFILEKEY:
+ case FFEEXPR_contextFILEUNIT:
+ case FFEEXPR_contextFILEUNIT_DF:
+ case FFEEXPR_contextFILEUNITAMBIG:
+ case FFEEXPR_contextFILEFORMAT:
+ case FFEEXPR_contextFILENAMELIST:
+ case FFEEXPR_contextFILEVXTCODE:
+ case FFEEXPR_contextINDEX_:
+ case FFEEXPR_contextIMPDOITEM_:
+ case FFEEXPR_contextIMPDOITEMDF_:
+ case FFEEXPR_contextIMPDOCTRL_:
+ case FFEEXPR_contextLOC_:
+ bad = FALSE; /* Let paren-switch handle the cases. */
+ break;
+
+ case FFEEXPR_contextASSIGN:
+ case FFEEXPR_contextAGOTO:
+ case FFEEXPR_contextCHARACTERSIZE:
+ case FFEEXPR_contextEQUIVALENCE:
+ case FFEEXPR_contextPARAMETER:
+ case FFEEXPR_contextDIMLIST:
+ case FFEEXPR_contextDIMLISTCOMMON:
+ case FFEEXPR_contextKINDTYPE:
+ case FFEEXPR_contextINITVAL:
+ case FFEEXPR_contextEQVINDEX_:
+ bad = (k != FFEINFO_kindENTITY)
+ || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
+ break;
+
+ case FFEEXPR_contextINCLUDE:
+ bad = TRUE;
+ break;
+
+ default:
+ bad = TRUE;
+ break;
+ }
+
+ switch (bad ? FFEINFO_kindANY : k)
+ {
+ case FFEINFO_kindNONE: /* Case "CHARACTER X,Y; Y=X(?". */
+ if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+ {
+ if (ffeexpr_context_outer_ (ffeexpr_stack_)
+ == FFEEXPR_contextSUBROUTINEREF)
+ *paren_type = FFEEXPR_parentypeSUBROUTINE_;
+ else
+ *paren_type = FFEEXPR_parentypeFUNCTION_;
+ break;
+ }
+ if (st == FFESYMBOL_stateUNDERSTOOD)
+ {
+ bad = TRUE;
+ *paren_type = FFEEXPR_parentypeANY_;
+ }
+ else
+ *paren_type = FFEEXPR_parentypeFUNSUBSTR_;
+ break;
+
+ case FFEINFO_kindFUNCTION:
+ *paren_type = FFEEXPR_parentypeFUNCTION_;
+ switch (ffesymbol_where (s))
+ {
+ case FFEINFO_whereLOCAL:
+ bad = TRUE; /* Attempt to recurse! */
+ break;
+
+ case FFEINFO_whereCONSTANT:
+ bad = ((ffesymbol_sfexpr (s) == NULL)
+ || (ffebld_op (ffesymbol_sfexpr (s))
+ == FFEBLD_opANY)); /* Attempt to recurse! */
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ if ((ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
+ || (ffeexpr_stack_->previous != NULL))
+ {
+ bad = TRUE;
+ *paren_type = FFEEXPR_parentypeANY_;
+ break;
+ }
+
+ *paren_type = FFEEXPR_parentypeSUBROUTINE_;
+ switch (ffesymbol_where (s))
+ {
+ case FFEINFO_whereLOCAL:
+ case FFEINFO_whereCONSTANT:
+ bad = TRUE; /* Attempt to recurse! */
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFEINFO_kindENTITY:
+ if (ffesymbol_rank (s) == 0)
+ if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+ *paren_type = FFEEXPR_parentypeSUBSTRING_;
+ else
+ {
+ bad = TRUE;
+ *paren_type = FFEEXPR_parentypeANY_;
+ }
+ else
+ *paren_type = FFEEXPR_parentypeARRAY_;
+ break;
+
+ default:
+ case FFEINFO_kindANY:
+ bad = TRUE;
+ *paren_type = FFEEXPR_parentypeANY_;
+ break;
+ }
+
+ if (bad)
+ {
+ if (k == FFEINFO_kindANY)
+ ffest_shutdown ();
+ else
+ ffesymbol_error (s, t);
+ }
+
+ return s;
+
+ case FFESYMBOL_stateSEEN: /* Seen but not yet in exec portion. */
+ seen: /* :::::::::::::::::::: */
+ bad = TRUE;
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextPARAMETER:
+ if (ffeexpr_stack_->is_rhs)
+ ffesymbol_error (s, t);
+ else
+ s = ffeexpr_sym_lhs_parameter_ (s, t);
+ break;
+
+ case FFEEXPR_contextDATA:
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ if (ffeexpr_stack_->is_rhs)
+ ffesymbol_error (s, t);
+ else
+ s = ffeexpr_sym_lhs_data_ (s, t);
+ goto understood; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ s = ffeexpr_sym_lhs_data_ (s, t);
+ goto understood; /* :::::::::::::::::::: */
+
+ case FFEEXPR_contextEQUIVALENCE:
+ s = ffeexpr_sym_lhs_equivalence_ (s, t);
+ bad = FALSE;
+ break;
+
+ case FFEEXPR_contextDIMLIST:
+ s = ffeexpr_sym_rhs_dimlist_ (s, t);
+ break;
+
+ case FFEEXPR_contextCHARACTERSIZE:
+ case FFEEXPR_contextKINDTYPE:
+ case FFEEXPR_contextDIMLISTCOMMON:
+ case FFEEXPR_contextINITVAL:
+ case FFEEXPR_contextEQVINDEX_:
+ break;
+
+ case FFEEXPR_contextINCLUDE:
+ break;
+
+ case FFEEXPR_contextINDEX_:
+ case FFEEXPR_contextACTUALARGEXPR_:
+ case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ assert (ffeexpr_stack_->is_rhs);
+ s = ffecom_sym_exec_transition (s);
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ goto understood; /* :::::::::::::::::::: */
+ s = ffeexpr_paren_rhs_let_ (s, t);
+ goto understood; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+ k = ffesymbol_kind (s);
+ switch (bad ? FFEINFO_kindANY : k)
+ {
+ case FFEINFO_kindNONE: /* Case "CHARACTER X,Y; Y=X(?". */
+ *paren_type = FFEEXPR_parentypeFUNSUBSTR_;
+ break;
+
+ case FFEINFO_kindFUNCTION:
+ *paren_type = FFEEXPR_parentypeFUNCTION_;
+ switch (ffesymbol_where (s))
+ {
+ case FFEINFO_whereLOCAL:
+ bad = TRUE; /* Attempt to recurse! */
+ break;
+
+ case FFEINFO_whereCONSTANT:
+ bad = ((ffesymbol_sfexpr (s) == NULL)
+ || (ffebld_op (ffesymbol_sfexpr (s))
+ == FFEBLD_opANY)); /* Attempt to recurse! */
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ *paren_type = FFEEXPR_parentypeANY_;
+ bad = TRUE; /* Cannot possibly be in
+ contextSUBROUTINEREF. */
+ break;
+
+ case FFEINFO_kindENTITY:
+ if (ffesymbol_rank (s) == 0)
+ if (ffeexpr_stack_->context == FFEEXPR_contextEQUIVALENCE)
+ *paren_type = FFEEXPR_parentypeEQUIVALENCE_;
+ else if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+ *paren_type = FFEEXPR_parentypeSUBSTRING_;
+ else
+ {
+ bad = TRUE;
+ *paren_type = FFEEXPR_parentypeANY_;
+ }
+ else
+ *paren_type = FFEEXPR_parentypeARRAY_;
+ break;
+
+ default:
+ case FFEINFO_kindANY:
+ bad = TRUE;
+ *paren_type = FFEEXPR_parentypeANY_;
+ break;
+ }
+
+ if (bad)
+ {
+ if (k == FFEINFO_kindANY)
+ ffest_shutdown ();
+ else
+ ffesymbol_error (s, t);
+ }
+
+ return s;
+
+ default:
+ assert ("bad symbol state" == NULL);
+ return NULL;
+ }
+}
+
+/* Have FOO in XYZ = ...FOO(...).... Executable context only. */
+
+static ffesymbol
+ffeexpr_paren_rhs_let_ (ffesymbol s, ffelexToken t)
+{
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ ffeintrinGen gen;
+ ffeintrinSpec spec;
+ ffeintrinImp imp;
+ bool maybe_ambig = FALSE;
+ bool error = FALSE;
+
+ assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+ na = sa = ffesymbol_attrs (s);
+
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = ffesymbol_kind (s);
+ where = ffesymbol_where (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsTYPE)
+ where = FFEINFO_whereGLOBAL;
+ else
+ /* Not TYPE. */
+ {
+ kind = FFEINFO_kindFUNCTION;
+
+ if (sa & FFESYMBOL_attrsDUMMY)
+ ; /* Not TYPE. */
+ else if (sa & FFESYMBOL_attrsACTUALARG)
+ ; /* Not DUMMY or TYPE. */
+ else /* Not ACTUALARG, DUMMY, or TYPE. */
+ where = FFEINFO_whereGLOBAL;
+ }
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ kind = FFEINFO_kindFUNCTION;
+ maybe_ambig = TRUE; /* If basictypeCHARACTER, can't be sure; kind
+ could be ENTITY w/substring ref. */
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsTYPE)));
+
+ where = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ where = FFEINFO_whereLOCAL; /* Actually an error, but at least we
+ know it's a local var. */
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsTYPE
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG)));
+
+ if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
+ &gen, &spec, &imp))
+ {
+ if (!(sa & FFESYMBOL_attrsANYLEN)
+ && (ffeimplic_peek_symbol_type (s, NULL)
+ == FFEINFO_basictypeCHARACTER))
+ return s; /* Haven't learned anything yet. */
+
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ ffesymbol_set_generic (s, gen);
+ ffesymbol_set_specific (s, spec);
+ ffesymbol_set_implementation (s, imp);
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ 0,
+ FFEINFO_kindFUNCTION,
+ FFEINFO_whereINTRINSIC,
+ ffesymbol_size (s)));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_reference (s, t, FALSE);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+
+ return s;
+ }
+ if (sa & FFESYMBOL_attrsANYLEN)
+ error = TRUE; /* Error, since the only way we can,
+ given CHARACTER*(*) FOO, accept
+ FOO(...) is for FOO to be a dummy
+ arg or constant, but it can't
+ become either now. */
+ else if (sa & FFESYMBOL_attrsADJUSTABLE)
+ {
+ kind = FFEINFO_kindENTITY;
+ where = FFEINFO_whereLOCAL;
+ }
+ else
+ {
+ kind = FFEINFO_kindFUNCTION;
+ where = FFEINFO_whereGLOBAL;
+ maybe_ambig = TRUE; /* If basictypeCHARACTER, can't be sure;
+ could be ENTITY/LOCAL w/substring ref. */
+ }
+ }
+ else if (sa == FFESYMBOL_attrsetNONE)
+ {
+ assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+
+ if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
+ &gen, &spec, &imp))
+ {
+ if (ffeimplic_peek_symbol_type (s, NULL)
+ == FFEINFO_basictypeCHARACTER)
+ return s; /* Haven't learned anything yet. */
+
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ ffesymbol_set_generic (s, gen);
+ ffesymbol_set_specific (s, spec);
+ ffesymbol_set_implementation (s, imp);
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ 0,
+ FFEINFO_kindFUNCTION,
+ FFEINFO_whereINTRINSIC,
+ ffesymbol_size (s)));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_reference (s, t, FALSE);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ return s;
+ }
+
+ kind = FFEINFO_kindFUNCTION;
+ where = FFEINFO_whereGLOBAL;
+ maybe_ambig = TRUE; /* If basictypeCHARACTER, can't be sure;
+ could be ENTITY/LOCAL w/substring ref. */
+ }
+ else
+ error = TRUE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (error)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s); /* May need to back up to previous
+ version. */
+ if (!ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, t);
+ return s;
+ }
+ if (maybe_ambig
+ && (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER))
+ return s; /* Still not sure, let caller deal with it
+ based on (...). */
+
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind,
+ where,
+ ffesymbol_size (s)));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_reference (s, t, FALSE);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* ffeexpr_token_arguments_ -- OPEN_PAREN [expr COMMA]...expr
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle expression (which might be null) and COMMA or CLOSE_PAREN. */
+
+static ffelexHandler
+ffeexpr_token_arguments_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprExpr_ procedure;
+ ffebld reduced;
+ ffeinfo info;
+ ffeexprContext ctx;
+ bool check_intrin = FALSE; /* Set TRUE if intrinsic is REAL(Z) or AIMAG(Z). */
+
+ procedure = ffeexpr_stack_->exprstack;
+ info = ffebld_info (procedure->u.operand);
+
+ if (ffeinfo_where (info) == FFEINFO_whereCONSTANT)
+ { /* Statement function (or subroutine, if
+ there was such a thing). */
+ if ((expr == NULL)
+ && ((ffe_is_pedantic ()
+ && (ffeexpr_stack_->expr != NULL))
+ || (ffelex_token_type (t) == FFELEX_typeCOMMA)))
+ {
+ if (ffebad_start (FFEBAD_NULL_ARGUMENT))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_here (1, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ if (ffeexpr_stack_->next_dummy != NULL)
+ { /* Don't bother if we're going to complain
+ later! */
+ expr = ffebld_new_conter
+ (ffebld_constant_new_integerdefault_val (0));
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ }
+ }
+
+ if (expr == NULL)
+ ;
+ else
+ {
+ if (ffeexpr_stack_->next_dummy == NULL)
+ { /* Report later which was the first extra
+ argument. */
+ if (ffeexpr_stack_->tokens[1] == NULL)
+ {
+ ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
+ ffeexpr_stack_->num_args = 0;
+ }
+ ++ffeexpr_stack_->num_args; /* Count # of extra
+ arguments. */
+ }
+ else
+ {
+ if (ffeinfo_rank (ffebld_info (expr)) != 0)
+ {
+ if (ffebad_start (FFEBAD_ARRAY_AS_SFARG))
+ {
+ ffebad_here (0,
+ ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_here (1, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_string (ffesymbol_text (ffesymbol_sfdummyparent
+ (ffebld_symter (ffebld_head
+ (ffeexpr_stack_->next_dummy)))));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ expr = ffeexpr_convert_expr (expr, ft,
+ ffebld_head (ffeexpr_stack_->next_dummy),
+ ffeexpr_stack_->tokens[0],
+ FFEEXPR_contextLET);
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ }
+ --ffeexpr_stack_->num_args; /* Count down # of args. */
+ ffeexpr_stack_->next_dummy
+ = ffebld_trail (ffeexpr_stack_->next_dummy);
+ }
+ }
+ }
+ else if ((expr != NULL) || ffe_is_ugly_comma ()
+ || (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+ ctx = FFEEXPR_contextSFUNCDEFACTUALARG_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ assert ("bad context" == NULL);
+ ctx = FFEEXPR_context;
+ break;
+
+ default:
+ ctx = FFEEXPR_contextACTUALARG_;
+ break;
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
+ ffeexpr_token_arguments_);
+
+ default:
+ break;
+ }
+
+ if ((ffeinfo_where (info) == FFEINFO_whereCONSTANT)
+ && (ffeexpr_stack_->next_dummy != NULL))
+ { /* Too few arguments. */
+ if (ffebad_start (FFEBAD_TOO_FEW_ARGUMENTS))
+ {
+ char num[10];
+
+ sprintf (num, "%" ffebldListLength_f "u", ffeexpr_stack_->num_args);
+
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_string (num);
+ ffebad_string (ffesymbol_text (ffesymbol_sfdummyparent (ffebld_symter
+ (ffebld_head (ffeexpr_stack_->next_dummy)))));
+ ffebad_finish ();
+ }
+ for (;
+ ffeexpr_stack_->next_dummy != NULL;
+ ffeexpr_stack_->next_dummy
+ = ffebld_trail (ffeexpr_stack_->next_dummy))
+ {
+ expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (0));
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ }
+ }
+
+ if ((ffeinfo_where (info) == FFEINFO_whereCONSTANT)
+ && (ffeexpr_stack_->tokens[1] != NULL))
+ { /* Too many arguments to statement function. */
+ if (ffebad_start (FFEBAD_TOO_MANY_ARGUMENTS))
+ {
+ char num[10];
+
+ sprintf (num, "%" ffebldListLength_f "u", ffeexpr_stack_->num_args);
+
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_string (num);
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+ }
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+
+ if (ffebld_op (procedure->u.operand) == FFEBLD_opANY)
+ {
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ }
+ else
+ {
+ if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
+ reduced = ffebld_new_funcref (procedure->u.operand,
+ ffeexpr_stack_->expr);
+ else
+ reduced = ffebld_new_subrref (procedure->u.operand,
+ ffeexpr_stack_->expr);
+ if (ffebld_symter_generic (procedure->u.operand) != FFEINTRIN_genNONE)
+ ffeintrin_fulfill_generic (&reduced, &info, ffeexpr_stack_->tokens[0]);
+ else if (ffebld_symter_specific (procedure->u.operand)
+ != FFEINTRIN_specNONE)
+ ffeintrin_fulfill_specific (&reduced, &info, &check_intrin,
+ ffeexpr_stack_->tokens[0]);
+ else
+ ffeexpr_fulfill_call_ (&reduced, ffeexpr_stack_->tokens[0]);
+
+ if (ffebld_op (reduced) != FFEBLD_opANY)
+ ffebld_set_info (reduced,
+ ffeinfo_new (ffeinfo_basictype (info),
+ ffeinfo_kindtype (info),
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereFLEETING,
+ ffeinfo_size (info)));
+ else
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ }
+ if (ffebld_op (reduced) == FFEBLD_opFUNCREF)
+ reduced = ffeexpr_collapse_funcref (reduced, ffeexpr_stack_->tokens[0]);
+ ffeexpr_stack_->exprstack = procedure->previous; /* Pops
+ not-quite-operand off
+ stack. */
+ procedure->u.operand = reduced; /* Save the line/column ffewhere
+ info. */
+ ffeexpr_exprstack_push_operand_ (procedure); /* Push it back on stack. */
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ {
+ ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+ ffeexpr_is_substr_ok_ = FALSE; /* Nobody likes "FUNC(3)(1:1)".... */
+
+ /* If the intrinsic needs checking (is REAL(Z) or AIMAG(Z), where
+ Z is DOUBLE COMPLEX), and a command-line option doesn't already
+ establish interpretation, probably complain. */
+
+ if (check_intrin
+ && !ffe_is_90 ()
+ && !ffe_is_ugly_complex ())
+ {
+ /* If the outer expression is REAL(me...), issue diagnostic
+ only if next token isn't the close-paren for REAL(me). */
+
+ if ((ffeexpr_stack_->previous != NULL)
+ && (ffeexpr_stack_->previous->exprstack->type == FFEEXPR_exprtypeOPERAND_)
+ && ((reduced = ffeexpr_stack_->previous->exprstack->u.operand) != NULL)
+ && (ffebld_op (reduced) == FFEBLD_opSYMTER)
+ && (ffebld_symter_implementation (reduced) == FFEINTRIN_impREAL))
+ return (ffelexHandler) ffeexpr_token_intrincheck_;
+
+ /* Diagnose the ambiguity now. */
+
+ if (ffebad_start (FFEBAD_INTRINSIC_CMPAMBIG))
+ {
+ ffebad_string (ffeintrin_name_implementation
+ (ffebld_symter_implementation
+ (ffebld_left
+ (ffeexpr_stack_->exprstack->u.operand))));
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+ ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+ ffebad_finish ();
+ }
+ }
+ return (ffelexHandler) ffeexpr_token_substrp_;
+ }
+
+ if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+ ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FUNC(3)(1:1)".... */
+ return
+ (ffelexHandler) ffeexpr_find_close_paren_ (t,
+ (ffelexHandler)
+ ffeexpr_token_substrp_);
+}
+
+/* ffeexpr_token_elements_ -- OPEN_PAREN [expr COMMA]...expr
+
+ Return a pointer to this array to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle expression and COMMA or CLOSE_PAREN. */
+
+static ffelexHandler
+ffeexpr_token_elements_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprExpr_ array;
+ ffebld reduced;
+ ffeinfo info;
+ ffeinfoWhere where;
+ ffetargetIntegerDefault val;
+ ffetargetIntegerDefault lval = 0;
+ ffetargetIntegerDefault uval = 0;
+ ffebld lbound;
+ ffebld ubound;
+ bool lcheck;
+ bool ucheck;
+
+ array = ffeexpr_stack_->exprstack;
+ info = ffebld_info (array->u.operand);
+
+ if ((expr == NULL) /* && ((ffeexpr_stack_->rank != 0) ||
+ (ffelex_token_type(t) ==
+ FFELEX_typeCOMMA)) */ )
+ {
+ if (ffebad_start (FFEBAD_NULL_ELEMENT))
+ {
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_here (1, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ if (ffeexpr_stack_->rank < ffeinfo_rank (info))
+ { /* Don't bother if we're going to complain
+ later! */
+ expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+ ffebld_set_info (expr, ffeinfo_new_any ());
+ }
+ }
+
+ if (expr == NULL)
+ ;
+ else if (ffeinfo_rank (info) == 0)
+ { /* In EQUIVALENCE context, ffeinfo_rank(info)
+ may == 0. */
+ ++ffeexpr_stack_->rank; /* Track anyway, may need for new VXT
+ feature. */
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ }
+ else
+ {
+ ++ffeexpr_stack_->rank;
+ if (ffeexpr_stack_->rank > ffeinfo_rank (info))
+ { /* Report later which was the first extra
+ element. */
+ if (ffeexpr_stack_->rank == ffeinfo_rank (info) + 1)
+ ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
+ }
+ else
+ {
+ switch (ffeinfo_where (ffebld_info (expr)))
+ {
+ case FFEINFO_whereCONSTANT:
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ ffeexpr_stack_->constant = FALSE;
+ break;
+
+ default:
+ ffeexpr_stack_->constant = FALSE;
+ ffeexpr_stack_->immediate = FALSE;
+ break;
+ }
+ if (ffebld_op (expr) == FFEBLD_opCONTER)
+ {
+ val = ffebld_constant_integerdefault (ffebld_conter (expr));
+
+ lbound = ffebld_left (ffebld_head (ffeexpr_stack_->bound_list));
+ if (lbound == NULL)
+ {
+ lcheck = TRUE;
+ lval = 1;
+ }
+ else if (ffebld_op (lbound) == FFEBLD_opCONTER)
+ {
+ lcheck = TRUE;
+ lval = ffebld_constant_integerdefault (ffebld_conter (lbound));
+ }
+ else
+ lcheck = FALSE;
+
+ ubound = ffebld_right (ffebld_head (ffeexpr_stack_->bound_list));
+ assert (ubound != NULL);
+ if (ffebld_op (ubound) == FFEBLD_opCONTER)
+ {
+ ucheck = TRUE;
+ uval = ffebld_constant_integerdefault (ffebld_conter (ubound));
+ }
+ else
+ ucheck = FALSE;
+
+ if ((lcheck && (val < lval)) || (ucheck && (val > uval)))
+ {
+ ffebad_start (FFEBAD_RANGE_ARRAY);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ }
+ }
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ ffeexpr_stack_->bound_list = ffebld_trail (ffeexpr_stack_->bound_list);
+ }
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+ {
+ case FFEEXPR_contextDATAIMPDOITEM_:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextDATAIMPDOINDEX_,
+ ffeexpr_token_elements_);
+
+ case FFEEXPR_contextEQUIVALENCE:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextEQVINDEX_,
+ ffeexpr_token_elements_);
+
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextSFUNCDEFINDEX_,
+ ffeexpr_token_elements_);
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ assert ("bad context" == NULL);
+ break;
+
+ default:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextINDEX_,
+ ffeexpr_token_elements_);
+ }
+
+ default:
+ break;
+ }
+
+ if ((ffeexpr_stack_->rank != ffeinfo_rank (info))
+ && (ffeinfo_rank (info) != 0))
+ {
+ char num[10];
+
+ if (ffeexpr_stack_->rank < ffeinfo_rank (info))
+ {
+ if (ffebad_start (FFEBAD_TOO_FEW_ELEMENTS))
+ {
+ sprintf (num, "%d",
+ (int) (ffeinfo_rank (info) - ffeexpr_stack_->rank));
+
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1,
+ ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_string (num);
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if (ffebad_start (FFEBAD_TOO_MANY_ELEMENTS))
+ {
+ sprintf (num, "%d",
+ (int) (ffeexpr_stack_->rank - ffeinfo_rank (info)));
+
+ ffebad_here (0,
+ ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+ ffebad_here (1,
+ ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_string (num);
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+ }
+ while (ffeexpr_stack_->rank++ < ffeinfo_rank (info))
+ {
+ expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+ ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ 0, FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+ }
+ }
+ ffebld_end_list (&ffeexpr_stack_->bottom);
+
+ if (ffebld_op (array->u.operand) == FFEBLD_opANY)
+ {
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ }
+ else
+ {
+ reduced = ffebld_new_arrayref (array->u.operand, ffeexpr_stack_->expr);
+ if (ffeexpr_stack_->constant)
+ where = FFEINFO_whereFLEETING_CADDR;
+ else if (ffeexpr_stack_->immediate)
+ where = FFEINFO_whereFLEETING_IADDR;
+ else
+ where = FFEINFO_whereFLEETING;
+ ffebld_set_info (reduced,
+ ffeinfo_new (ffeinfo_basictype (info),
+ ffeinfo_kindtype (info),
+ 0,
+ FFEINFO_kindENTITY,
+ where,
+ ffeinfo_size (info)));
+ reduced = ffeexpr_collapse_arrayref (reduced, ffeexpr_stack_->tokens[0]);
+ }
+
+ ffeexpr_stack_->exprstack = array->previous; /* Pops not-quite-operand off
+ stack. */
+ array->u.operand = reduced; /* Save the line/column ffewhere info. */
+ ffeexpr_exprstack_push_operand_ (array); /* Push it back on stack. */
+
+ switch (ffeinfo_basictype (info))
+ {
+ case FFEINFO_basictypeCHARACTER:
+ ffeexpr_is_substr_ok_ = TRUE; /* Everyone likes "FOO(3)(1:1)".... */
+ break;
+
+ case FFEINFO_basictypeNONE:
+ ffeexpr_is_substr_ok_ = TRUE;
+ assert (ffeexpr_stack_->context == FFEEXPR_contextEQUIVALENCE);
+ break;
+
+ default:
+ ffeexpr_is_substr_ok_ = FALSE;
+ break;
+ }
+
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ {
+ ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+ return (ffelexHandler) ffeexpr_token_substrp_;
+ }
+
+ if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_finish ();
+ }
+ ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+ return
+ (ffelexHandler) ffeexpr_find_close_paren_ (t,
+ (ffelexHandler)
+ ffeexpr_token_substrp_);
+}
+
+/* ffeexpr_token_equivalence_ -- OPEN_PAREN expr
+
+ Return a pointer to this array to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ If token is COLON, pass off to _substr_, else init list and pass off
+ to _elements_. This handles the case "EQUIVALENCE (FOO(expr?", where
+ ? marks the token, and where FOO's rank/type has not yet been established,
+ meaning we could be in a list of indices or in a substring
+ specification. */
+
+static ffelexHandler
+ffeexpr_token_equivalence_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ if (ffelex_token_type (t) == FFELEX_typeCOLON)
+ return ffeexpr_token_substring_ (ft, expr, t);
+
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ return ffeexpr_token_elements_ (ft, expr, t);
+}
+
+/* ffeexpr_token_substring_ -- NAME(of kindENTITY) OPEN_PAREN expr
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle expression (which may be null) and COLON. */
+
+static ffelexHandler
+ffeexpr_token_substring_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeexprExpr_ string;
+ ffeinfo info;
+ ffetargetIntegerDefault i;
+ ffeexprContext ctx;
+ ffetargetCharacterSize size;
+
+ string = ffeexpr_stack_->exprstack;
+ info = ffebld_info (string->u.operand);
+ size = ffebld_size_max (string->u.operand);
+
+ if (ffelex_token_type (t) == FFELEX_typeCOLON)
+ {
+ if ((expr != NULL)
+ && (ffebld_op (expr) == FFEBLD_opCONTER)
+ && (((i = ffebld_constant_integerdefault (ffebld_conter (expr)))
+ < 1)
+ || ((size != FFETARGET_charactersizeNONE) && (i > size))))
+ {
+ ffebad_start (FFEBAD_RANGE_SUBSTR);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ }
+ ffeexpr_stack_->expr = expr;
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ ctx = FFEEXPR_contextSFUNCDEFINDEX_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ assert ("bad context" == NULL);
+ ctx = FFEEXPR_context;
+ break;
+
+ default:
+ ctx = FFEEXPR_contextINDEX_;
+ break;
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
+ ffeexpr_token_substring_1_);
+ }
+
+ if (ffest_ffebad_start (FFEBAD_MISSING_COLON_IN_SUBSTR))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_finish ();
+ }
+
+ ffeexpr_stack_->expr = NULL;
+ return (ffelexHandler) ffeexpr_token_substring_1_ (ft, expr, t);
+}
+
+/* ffeexpr_token_substring_1_ -- NAME OPEN_PAREN [expr COMMA]...expr
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ Handle expression (which might be null) and CLOSE_PAREN. */
+
+static ffelexHandler
+ffeexpr_token_substring_1_ (ffelexToken ft, ffebld last, ffelexToken t)
+{
+ ffeexprExpr_ string;
+ ffebld reduced;
+ ffebld substrlist;
+ ffebld first = ffeexpr_stack_->expr;
+ ffebld strop;
+ ffeinfo info;
+ ffeinfoWhere lwh;
+ ffeinfoWhere rwh;
+ ffeinfoWhere where;
+ ffeinfoKindtype first_kt;
+ ffeinfoKindtype last_kt;
+ ffetargetIntegerDefault first_val;
+ ffetargetIntegerDefault last_val;
+ ffetargetCharacterSize size;
+ ffetargetCharacterSize strop_size_max;
+
+ string = ffeexpr_stack_->exprstack;
+ strop = string->u.operand;
+ info = ffebld_info (strop);
+
+ if ((first == NULL) || (ffebld_op (first) == FFEBLD_opCONTER))
+ { /* The starting point is known. */
+ first_val = (first == NULL) ? 1
+ : ffebld_constant_integerdefault (ffebld_conter (first));
+ }
+ else
+ { /* Assume start of the entity. */
+ first_val = 1;
+ }
+
+ if ((last != NULL) && (ffebld_op (last) == FFEBLD_opCONTER))
+ { /* The ending point is known. */
+ last_val = ffebld_constant_integerdefault (ffebld_conter (last));
+
+ if ((first == NULL) || (ffebld_op (first) == FFEBLD_opCONTER))
+ { /* The beginning point is a constant. */
+ if (first_val <= last_val)
+ size = last_val - first_val + 1;
+ else
+ {
+ if (0 && ffe_is_90 ())
+ size = 0;
+ else
+ {
+ size = 1;
+ ffebad_start (FFEBAD_ZERO_SIZE);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ }
+ }
+ }
+ else
+ size = FFETARGET_charactersizeNONE;
+
+ strop_size_max = ffebld_size_max (strop);
+
+ if ((strop_size_max != FFETARGET_charactersizeNONE)
+ && (last_val > strop_size_max))
+ { /* Beyond maximum possible end of string. */
+ ffebad_start (FFEBAD_RANGE_SUBSTR);
+ ffebad_here (0, ffelex_token_where_line (ft),
+ ffelex_token_where_column (ft));
+ ffebad_finish ();
+ }
+ }
+ else
+ size = FFETARGET_charactersizeNONE; /* The size is not known. */
+
+#if 0 /* Don't do this, or "is size of target
+ known?" would no longer be easily
+ answerable. To see if there is a max
+ size, use ffebld_size_max; to get only the
+ known size, else NONE, use
+ ffebld_size_known; use ffebld_size if
+ values are sure to be the same (not
+ opSUBSTR or opCONCATENATE or known to have
+ known length). By getting rid of this
+ "useful info" stuff, we don't end up
+ blank-padding the constant in the
+ assignment "A(I:J)='XYZ'" to the known
+ length of A. */
+ if (size == FFETARGET_charactersizeNONE)
+ size = strop_size_max; /* Assume we use the entire string. */
+#endif
+
+ substrlist
+ = ffebld_new_item
+ (first,
+ ffebld_new_item
+ (last,
+ NULL
+ )
+ )
+ ;
+
+ if (first == NULL)
+ lwh = FFEINFO_whereCONSTANT;
+ else
+ lwh = ffeinfo_where (ffebld_info (first));
+ if (last == NULL)
+ rwh = FFEINFO_whereCONSTANT;
+ else
+ rwh = ffeinfo_where (ffebld_info (last));
+
+ switch (lwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ where = FFEINFO_whereCONSTANT;
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ where = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ where = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ switch (rwh)
+ {
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereIMMEDIATE:
+ where = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ where = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+
+ default:
+ where = FFEINFO_whereFLEETING;
+ break;
+ }
+
+ if (first == NULL)
+ first_kt = FFEINFO_kindtypeINTEGERDEFAULT;
+ else
+ first_kt = ffeinfo_kindtype (ffebld_info (first));
+ if (last == NULL)
+ last_kt = FFEINFO_kindtypeINTEGERDEFAULT;
+ else
+ last_kt = ffeinfo_kindtype (ffebld_info (last));
+
+ switch (where)
+ {
+ case FFEINFO_whereCONSTANT:
+ switch (ffeinfo_where (info))
+ {
+ case FFEINFO_whereCONSTANT:
+ break;
+
+ case FFEINFO_whereIMMEDIATE: /* Not possible, actually. */
+ where = FFEINFO_whereIMMEDIATE;
+ break;
+
+ default:
+ where = FFEINFO_whereFLEETING_CADDR;
+ break;
+ }
+ break;
+
+ case FFEINFO_whereIMMEDIATE:
+ switch (ffeinfo_where (info))
+ {
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereIMMEDIATE: /* Not possible, actually. */
+ break;
+
+ default:
+ where = FFEINFO_whereFLEETING_IADDR;
+ break;
+ }
+ break;
+
+ default:
+ switch (ffeinfo_where (info))
+ {
+ case FFEINFO_whereCONSTANT:
+ where = FFEINFO_whereCONSTANT_SUBOBJECT; /* An F90 concept. */
+ break;
+
+ case FFEINFO_whereIMMEDIATE: /* Not possible, actually. */
+ default:
+ where = FFEINFO_whereFLEETING;
+ break;
+ }
+ break;
+ }
+
+ if (ffebld_op (strop) == FFEBLD_opANY)
+ {
+ reduced = ffebld_new_any ();
+ ffebld_set_info (reduced, ffeinfo_new_any ());
+ }
+ else
+ {
+ reduced = ffebld_new_substr (strop, substrlist);
+ ffebld_set_info (reduced, ffeinfo_new
+ (FFEINFO_basictypeCHARACTER,
+ ffeinfo_kindtype (info),
+ 0,
+ FFEINFO_kindENTITY,
+ where,
+ size));
+ reduced = ffeexpr_collapse_substr (reduced, ffeexpr_stack_->tokens[0]);
+ }
+
+ ffeexpr_stack_->exprstack = string->previous; /* Pops not-quite-operand off
+ stack. */
+ string->u.operand = reduced; /* Save the line/column ffewhere info. */
+ ffeexpr_exprstack_push_operand_ (string); /* Push it back on stack. */
+
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ {
+ ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+ ffeexpr_is_substr_ok_ = FALSE; /* Nobody likes "FOO(3:5)(1:1)".... */
+ return (ffelexHandler) ffeexpr_token_substrp_;
+ }
+
+ if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+ ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+ ffebad_finish ();
+ }
+
+ ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+ ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FOO(3:5)(1:1)".... */
+ return
+ (ffelexHandler) ffeexpr_find_close_paren_ (t,
+ (ffelexHandler)
+ ffeexpr_token_substrp_);
+}
+
+/* ffeexpr_token_substrp_ -- Rhs <character entity>
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ If OPEN_PAREN, treat as start of a substring ("(3:4)") construct, and
+ issue error message if flag (serves as argument) is set. Else, just
+ forward token to binary_. */
+
+static ffelexHandler
+ffeexpr_token_substrp_ (ffelexToken t)
+{
+ ffeexprContext ctx;
+
+ if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
+ return (ffelexHandler) ffeexpr_token_binary_ (t);
+
+ ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
+
+ switch (ffeexpr_stack_->context)
+ {
+ case FFEEXPR_contextSFUNCDEF:
+ case FFEEXPR_contextSFUNCDEFINDEX_:
+ ctx = FFEEXPR_contextSFUNCDEFINDEX_;
+ break;
+
+ case FFEEXPR_contextSFUNCDEFACTUALARG_:
+ case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+ assert ("bad context" == NULL);
+ ctx = FFEEXPR_context;
+ break;
+
+ default:
+ ctx = FFEEXPR_contextINDEX_;
+ break;
+ }
+
+ if (!ffeexpr_is_substr_ok_)
+ {
+ if (ffebad_start (FFEBAD_BAD_SUBSTR))
+ {
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+ ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+ ffebad_finish ();
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
+ ffeexpr_token_anything_);
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
+ ffeexpr_token_substring_);
+}
+
+static ffelexHandler
+ffeexpr_token_intrincheck_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+ && ffebad_start (FFEBAD_INTRINSIC_CMPAMBIG))
+ {
+ ffebad_string (ffeintrin_name_implementation
+ (ffebld_symter_implementation
+ (ffebld_left
+ (ffeexpr_stack_->exprstack->u.operand))));
+ ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+ ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+ ffebad_finish ();
+ }
+
+ return (ffelexHandler) ffeexpr_token_substrp_ (t);
+}
+
+/* ffeexpr_token_funsubstr_ -- NAME OPEN_PAREN expr
+
+ Return a pointer to this function to the lexer (ffelex), which will
+ invoke it for the next token.
+
+ If COLON, do everything we would have done since _parenthesized_ if
+ we had known NAME represented a kindENTITY instead of a kindFUNCTION.
+ If not COLON, do likewise for kindFUNCTION instead. */
+
+static ffelexHandler
+ffeexpr_token_funsubstr_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffeinfoWhere where;
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffebld symter = ffeexpr_stack_->exprstack->u.operand;
+ bool needs_type;
+ ffeintrinGen gen;
+ ffeintrinSpec spec;
+ ffeintrinImp imp;
+
+ s = ffebld_symter (symter);
+ sa = ffesymbol_attrs (s);
+ where = ffesymbol_where (s);
+
+ /* We get here only if we don't already know enough about FOO when seeing a
+ FOO(stuff) reference, and FOO might turn out to be a CHARACTER type. If
+ "stuff" is a substring reference, then FOO is a CHARACTER scalar type.
+ Else FOO is a function, either intrinsic or external. If intrinsic, it
+ wouldn't necessarily be CHARACTER type, so unless it has already been
+ declared DUMMY, it hasn't had its type established yet. It can't be
+ CHAR*(*) in any case, though it can have an explicit CHAR*n type. */
+
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsTYPE)));
+
+ needs_type = !(ffesymbol_attrs (s) & FFESYMBOL_attrsDUMMY);
+
+ ffesymbol_signal_change (s); /* Probably already done, but in case.... */
+
+ if (ffelex_token_type (t) == FFELEX_typeCOLON)
+ { /* Definitely an ENTITY (char substring). */
+ if (needs_type && !ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, ffeexpr_stack_->tokens[0]);
+ return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
+ }
+
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ FFEINFO_kindENTITY,
+ (where == FFEINFO_whereNONE)
+ ? FFEINFO_whereLOCAL
+ : where,
+ ffesymbol_size (s)));
+ ffebld_set_info (symter, ffeinfo_use (ffesymbol_info (s)));
+
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+
+ ffeexpr_stack_->exprstack->u.operand
+ = ffeexpr_collapse_symter (symter, ffeexpr_tokens_[0]);
+
+ return (ffelexHandler) ffeexpr_token_substring_ (ft, expr, t);
+ }
+
+ /* The "stuff" isn't a substring notation, so we now know the overall
+ reference is to a function. */
+
+ if (ffeintrin_is_intrinsic (ffesymbol_text (s), ffeexpr_stack_->tokens[0],
+ FALSE, &gen, &spec, &imp))
+ {
+ ffebld_symter_set_generic (symter, gen);
+ ffebld_symter_set_specific (symter, spec);
+ ffebld_symter_set_implementation (symter, imp);
+ ffesymbol_set_generic (s, gen);
+ ffesymbol_set_specific (s, spec);
+ ffesymbol_set_implementation (s, imp);
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ 0,
+ FFEINFO_kindFUNCTION,
+ FFEINFO_whereINTRINSIC,
+ ffesymbol_size (s)));
+ }
+ else
+ { /* Not intrinsic, now needs CHAR type. */
+ if (!ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, ffeexpr_stack_->tokens[0]);
+ return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
+ }
+
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ FFEINFO_kindFUNCTION,
+ (where == FFEINFO_whereNONE)
+ ? FFEINFO_whereGLOBAL
+ : where,
+ ffesymbol_size (s)));
+ }
+
+ ffebld_set_info (symter, ffeinfo_use (ffesymbol_info (s)));
+
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_reference (s, ffeexpr_stack_->tokens[0], FALSE);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+ return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
+}
+
+/* ffeexpr_token_anything_ -- NAME OPEN_PAREN any-expr
+
+ Handle basically any expression, looking for CLOSE_PAREN. */
+
+static ffelexHandler
+ffeexpr_token_anything_ (ffelexToken ft UNUSED, ffebld expr UNUSED,
+ ffelexToken t)
+{
+ ffeexprExpr_ e = ffeexpr_stack_->exprstack;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLON:
+ return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+ FFEEXPR_contextACTUALARG_,
+ ffeexpr_token_anything_);
+
+ default:
+ e->u.operand = ffebld_new_any ();
+ ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+ ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+ ffeexpr_is_substr_ok_ = FALSE;
+ if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+ return (ffelexHandler) ffeexpr_token_substrp_;
+ return (ffelexHandler) ffeexpr_token_substrp_ (t);
+ }
+}
+
+/* Terminate module. */
+
+void
+ffeexpr_terminate_2 ()
+{
+ assert (ffeexpr_stack_ == NULL);
+ assert (ffeexpr_level_ == 0);
+}
diff --git a/gcc/f/expr.h b/gcc/f/expr.h
new file mode 100644
index 00000000000..db7d9fa78e7
--- /dev/null
+++ b/gcc/f/expr.h
@@ -0,0 +1,194 @@
+/* expr.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ expr.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_expr
+#define _H_f_expr
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFEEXPR_contextLET,
+ FFEEXPR_contextASSIGN,
+ FFEEXPR_contextIOLIST,
+ FFEEXPR_contextPARAMETER,
+ FFEEXPR_contextSUBROUTINEREF,
+ FFEEXPR_contextDATA,
+ FFEEXPR_contextIF,
+ FFEEXPR_contextARITHIF,
+ FFEEXPR_contextDO,
+ FFEEXPR_contextDOWHILE,
+ FFEEXPR_contextFORMAT,
+ FFEEXPR_contextAGOTO,
+ FFEEXPR_contextCGOTO,
+ FFEEXPR_contextCHARACTERSIZE,
+ FFEEXPR_contextEQUIVALENCE,
+ FFEEXPR_contextSTOP,
+ FFEEXPR_contextRETURN,
+ FFEEXPR_contextSFUNCDEF,
+ FFEEXPR_contextINCLUDE,
+ FFEEXPR_contextWHERE,
+ FFEEXPR_contextSELECTCASE,
+ FFEEXPR_contextCASE,
+ FFEEXPR_contextDIMLIST,
+ FFEEXPR_contextDIMLISTCOMMON, /* Dim list in COMMON stmt. */
+ FFEEXPR_contextFILEASSOC, /* ASSOCIATEVARIABLE=. */
+ FFEEXPR_contextFILEINT, /* IOSTAT=. */
+ FFEEXPR_contextFILEDFINT, /* NEXTREC=. */
+ FFEEXPR_contextFILELOG, /* NAMED=. */
+ FFEEXPR_contextFILENUM, /* Numerical expression. */
+ FFEEXPR_contextFILECHAR, /* Character expression. */
+ FFEEXPR_contextFILENUMCHAR, /* READ KEYxyz=. */
+ FFEEXPR_contextFILEDFCHAR, /* Default kind character expression. */
+ FFEEXPR_contextFILEKEY, /* OPEN KEY=. */
+ FFEEXPR_contextFILEEXTFUNC, /* USEROPEN=. */
+ FFEEXPR_contextFILEUNIT, /* READ/WRITE UNIT=. */
+ FFEEXPR_contextFILEUNIT_DF, /* DEFINE FILE unit (no "(" after it). */
+ FFEEXPR_contextFILEFORMATNML, /* [FMT=] or [NML=]. */
+ FFEEXPR_contextFILEFORMAT, /* FMT=. */
+ FFEEXPR_contextFILENAMELIST,/* NML=. */
+ FFEEXPR_contextFILENUMAMBIG,/* BACKSPACE, ENDFILE, REWIND, UNLOCK...
+ where at e.g. BACKSPACE(, if COMMA seen
+ before ), it is ok. */
+ FFEEXPR_contextFILEUNITAMBIG, /* READ(, if COMMA seen before ), ok. */
+ FFEEXPR_contextFILEVXTCODE, /* ENCODE/DECODE third arg (scalar/array). */
+ FFEEXPR_contextALLOCATE, /* ALLOCATE objects (weird). */
+ FFEEXPR_contextDEALLOCATE, /* DEALLOCATE objects (weird). */
+ FFEEXPR_contextHEAPSTAT, /* ALLOCATE/DEALLOCATE STAT= variable. */
+ FFEEXPR_contextKINDTYPE, /* KIND=. */
+ FFEEXPR_contextINITVAL, /* R426 =initialization-expr. */
+ FFEEXPR_contextNULLIFY, /* Pointer names only (F90) or pointers. */
+ FFEEXPR_contextIOLISTDF, /* IOLIST w/internal file (V112 9-14 30,31). */
+ FFEEXPR_contextINDEX_, /* Element dimension or substring value. */
+ FFEEXPR_contextEQVINDEX_, /* EQUIVALENCE element dimension. */
+ FFEEXPR_contextDATAIMPDOINDEX_, /* INDEX in DATAIMPDO context. */
+ FFEEXPR_contextIMPDOITEM_,
+ FFEEXPR_contextIMPDOITEMDF_,/* to ...ITEM_ as IOLISTDF is to IOLIST. */
+ FFEEXPR_contextIMPDOCTRL_,
+ FFEEXPR_contextDATAIMPDOITEM_,
+ FFEEXPR_contextDATAIMPDOCTRL_,
+ FFEEXPR_contextLOC_,
+ FFEEXPR_contextACTUALARG_, /* Actual arg to function or subroutine;
+ turns into ACTUALARGEXPR_ if tokens not
+ NAME (CLOSE_PAREN/COMMA) or PERCENT.... */
+ FFEEXPR_contextACTUALARGEXPR_, /* Like LET but disallow CHAR*(*)
+ concats. */
+ FFEEXPR_contextINDEXORACTUALARG_, /* "CHARACTER FOO; PRINT *,FOO(?". */
+ FFEEXPR_contextINDEXORACTUALARGEXPR_, /* ? not NAME
+ (CLOSE_PAREN/COMMA). */
+ FFEEXPR_contextSFUNCDEFINDEX_, /* INDEX_ within stmt-func def. */
+ FFEEXPR_contextSFUNCDEFACTUALARG_,
+ FFEEXPR_contextSFUNCDEFACTUALARGEXPR_,
+ FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_,
+ FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_,
+ FFEEXPR_contextPAREN_, /* Rhs paren except in LET context. */
+ FFEEXPR_contextPARENFILENUM_, /* Either PAREN or FILENUM context. */
+ FFEEXPR_contextPARENFILEUNIT_, /* Either PAREN or FILEUNIT context. */
+ FFEEXPR_context
+ } ffeexprContext;
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lex.h"
+#include "malloc.h"
+
+/* Structure definitions. */
+
+typedef ffelexHandler (*ffeexprCallback) (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+ffebld ffeexpr_collapse_convert (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_paren (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_uplus (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_uminus (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_not (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_add (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_subtract (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_multiply (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_divide (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_power (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_lt (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_le (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_eq (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_ne (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_gt (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_ge (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_and (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_or (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_xor (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_eqv (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_neqv (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_symter (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_funcref (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_substr (ffebld expr, ffelexToken t);
+ffebld ffeexpr_convert (ffebld source, ffelexToken source_token,
+ ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt,
+ ffeinfoRank rk, ffetargetCharacterSize sz,
+ ffeexprContext context);
+ffebld ffeexpr_convert_expr (ffebld source, ffelexToken source_token,
+ ffebld dest, ffelexToken dest_token,
+ ffeexprContext context);
+ffebld ffeexpr_convert_to_sym (ffebld source, ffelexToken source_token,
+ ffesymbol dest, ffelexToken dest_token);
+void ffeexpr_init_2 (void);
+ffelexHandler ffeexpr_rhs (mallocPool pool, ffeexprContext context,
+ ffeexprCallback callback);
+ffelexHandler ffeexpr_lhs (mallocPool pool, ffeexprContext context,
+ ffeexprCallback callback);
+void ffeexpr_terminate_2 (void);
+void ffeexpr_type_combine (ffeinfoBasictype *nbt, ffeinfoKindtype *nkt,
+ ffeinfoBasictype lbt, ffeinfoKindtype lkt,
+ ffeinfoBasictype rbt, ffeinfoKindtype rkt,
+ ffelexToken t);
+
+/* Define macros. */
+
+#define ffeexpr_init_0()
+#define ffeexpr_init_1()
+#define ffeexpr_init_3()
+#define ffeexpr_init_4()
+#define ffeexpr_terminate_0()
+#define ffeexpr_terminate_1()
+#define ffeexpr_terminate_3()
+#define ffeexpr_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/fini.c b/gcc/f/fini.c
new file mode 100644
index 00000000000..6e324b64602
--- /dev/null
+++ b/gcc/f/fini.c
@@ -0,0 +1,774 @@
+/* fini.c
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "malloc.h"
+
+#define MAXNAMELEN 100
+
+typedef struct _name_ *name;
+
+struct _name_
+ {
+ name next;
+ name previous;
+ name next_alpha;
+ name previous_alpha;
+ int namelen;
+ int kwlen;
+ char kwname[MAXNAMELEN];
+ char name_uc[MAXNAMELEN];
+ char name_lc[MAXNAMELEN];
+ char name_ic[MAXNAMELEN];
+ };
+
+struct _name_root_
+ {
+ name first;
+ name last;
+ };
+
+struct _name_alpha_
+ {
+ name ign1;
+ name ign2;
+ name first;
+ name last;
+ };
+
+static FILE *in;
+static FILE *out;
+static char prefix[32];
+static char postfix[32];
+static char storage[32];
+static char *spaces[]
+=
+{
+ "", /* 0 */
+ " ", /* 1 */
+ " ", /* 2 */
+ " ", /* 3 */
+ " ", /* 4 */
+ " ", /* 5 */
+ " ", /* 6 */
+ " ", /* 7 */
+ "\t", /* 8 */
+ "\t ", /* 9 */
+ "\t ", /* 10 */
+ "\t ", /* 11 */
+ "\t ", /* 12 */
+ "\t ", /* 13 */
+ "\t ", /* 14 */
+ "\t ", /* 15 */
+ "\t\t", /* 16 */
+ "\t\t ", /* 17 */
+ "\t\t ", /* 18 */
+ "\t\t ", /* 19 */
+ "\t\t ", /* 20 */
+ "\t\t ", /* 21 */
+ "\t\t ", /* 22 */
+ "\t\t ", /* 23 */
+ "\t\t\t", /* 24 */
+ "\t\t\t ", /* 25 */
+ "\t\t\t ", /* 26 */
+ "\t\t\t ", /* 27 */
+ "\t\t\t ", /* 28 */
+ "\t\t\t ", /* 29 */
+ "\t\t\t ", /* 30 */
+ "\t\t\t ", /* 31 */
+ "\t\t\t\t", /* 32 */
+ "\t\t\t\t ", /* 33 */
+ "\t\t\t\t ", /* 34 */
+ "\t\t\t\t ", /* 35 */
+ "\t\t\t\t ", /* 36 */
+ "\t\t\t\t ", /* 37 */
+ "\t\t\t\t ", /* 38 */
+ "\t\t\t\t ", /* 39 */
+ "\t\t\t\t\t", /* 40 */
+ "\t\t\t\t\t ", /* 41 */
+ "\t\t\t\t\t ", /* 42 */
+ "\t\t\t\t\t ", /* 43 */
+ "\t\t\t\t\t ", /* 44 */
+ "\t\t\t\t\t ", /* 45 */
+ "\t\t\t\t\t ", /* 46 */
+ "\t\t\t\t\t ", /* 47 */
+ "\t\t\t\t\t\t", /* 48 */
+ "\t\t\t\t\t\t ", /* 49 */
+ "\t\t\t\t\t\t ", /* 50 */
+ "\t\t\t\t\t\t ", /* 51 */
+ "\t\t\t\t\t\t ", /* 52 */
+ "\t\t\t\t\t\t ", /* 53 */
+ "\t\t\t\t\t\t ", /* 54 */
+ "\t\t\t\t\t\t ", /* 55 */
+ "\t\t\t\t\t\t\t", /* 56 */
+ "\t\t\t\t\t\t\t ", /* 57 */
+ "\t\t\t\t\t\t\t ", /* 58 */
+ "\t\t\t\t\t\t\t ", /* 59 */
+ "\t\t\t\t\t\t\t ", /* 60 */
+ "\t\t\t\t\t\t\t ", /* 61 */
+ "\t\t\t\t\t\t\t ", /* 62 */
+ "\t\t\t\t\t\t\t ", /* 63 */
+ "\t\t\t\t\t\t\t\t", /* 64 */
+ "\t\t\t\t\t\t\t\t ", /* 65 */
+ "\t\t\t\t\t\t\t\t ", /* 66 */
+ "\t\t\t\t\t\t\t\t ", /* 67 */
+ "\t\t\t\t\t\t\t\t ", /* 68 */
+ "\t\t\t\t\t\t\t\t ", /* 69 */
+ "\t\t\t\t\t\t\t\t ", /* 70 */
+ "\t\t\t\t\t\t\t\t ", /* 71 */
+ "\t\t\t\t\t\t\t\t\t", /* 72 */
+ "\t\t\t\t\t\t\t\t\t ", /* 73 */
+ "\t\t\t\t\t\t\t\t\t ", /* 74 */
+ "\t\t\t\t\t\t\t\t\t ", /* 75 */
+ "\t\t\t\t\t\t\t\t\t ", /* 76 */
+ "\t\t\t\t\t\t\t\t\t ", /* 77 */
+ "\t\t\t\t\t\t\t\t\t ", /* 78 */
+ "\t\t\t\t\t\t\t\t\t ", /* 79 */
+ "\t\t\t\t\t\t\t\t\t\t", /* 80 */
+ "\t\t\t\t\t\t\t\t\t\t ", /* 81 */
+ "\t\t\t\t\t\t\t\t\t\t ", /* 82 */
+ "\t\t\t\t\t\t\t\t\t\t ", /* 83 */
+ "\t\t\t\t\t\t\t\t\t\t ", /* 84 */
+ "\t\t\t\t\t\t\t\t\t\t ", /* 85 */
+ "\t\t\t\t\t\t\t\t\t\t ", /* 86 */
+ "\t\t\t\t\t\t\t\t\t\t ",/* 87 */
+ "\t\t\t\t\t\t\t\t\t\t\t", /* 88 */
+ "\t\t\t\t\t\t\t\t\t\t\t ", /* 89 */
+ "\t\t\t\t\t\t\t\t\t\t\t ", /* 90 */
+ "\t\t\t\t\t\t\t\t\t\t\t ", /* 91 */
+ "\t\t\t\t\t\t\t\t\t\t\t ", /* 92 */
+ "\t\t\t\t\t\t\t\t\t\t\t ",/* 93 */
+ "\t\t\t\t\t\t\t\t\t\t\t ", /* 94 */
+ "\t\t\t\t\t\t\t\t\t\t\t ", /* 95 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t", /* 96 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 97 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 98 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t ",/* 99 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 100 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 101 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 102 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 103 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 104 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t ",/* 105 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 106 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 107 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 108 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 109 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 110 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 111 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 112 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 113 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 114 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 115 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 116 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 117 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 118 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 119 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 120 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 121 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 122 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 123 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 124 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 125 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 126 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 127 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 128 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 129 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 130 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 131 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 132 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 133 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 134 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 135 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 136 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 137 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 138 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 139 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 140 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 141 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 142 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 143 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 144 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 145 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 146 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 147 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 148 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 149 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 150 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 151 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 152 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 153 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 154 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 155 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 156 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 157 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 158 */
+ "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 159 */
+};
+
+void testname (bool nested, int indent, name first, name last);
+void testnames (bool nested, int indent, int len, name first, name last);
+
+void
+main (int argc, char **argv)
+{
+ char buf[MAXNAMELEN];
+ char last_buf[MAXNAMELEN] = "";
+ char kwname[MAXNAMELEN];
+ char routine[32];
+ char type[32];
+ int i;
+ int count;
+ int len;
+ struct _name_root_ names[200];
+ struct _name_alpha_ names_alpha;
+ name n;
+ name newname;
+ char *input_name;
+ char *output_name;
+ char *include_name;
+ FILE *incl;
+ int fixlengths;
+ int total_length;
+ int do_name; /* TRUE if token may be NAME. */
+ int do_names; /* TRUE if token may be NAMES. */
+ int cc;
+ bool do_exit = FALSE;
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
+ { /* Initialize length/name ordered list roots. */
+ names[i].first = (name) &names[i];
+ names[i].last = (name) &names[i];
+ }
+ names_alpha.first = (name) &names_alpha; /* Initialize name order. */
+ names_alpha.last = (name) &names_alpha;
+
+ if (argc != 4)
+ {
+ fprintf (stderr, "Command form: fini input output-code output-include\n");
+ exit (1);
+ }
+
+ input_name = argv[1];
+ output_name = argv[2];
+ include_name = argv[3];
+
+ in = fopen (input_name, "r");
+ if (in == NULL)
+ {
+ fprintf (stderr, "Cannot open \"%s\"\n", input_name);
+ exit (1);
+ }
+ out = fopen (output_name, "w");
+ if (out == NULL)
+ {
+ fclose (in);
+ fprintf (stderr, "Cannot open \"%s\"\n", output_name);
+ exit (1);
+ }
+ incl = fopen (include_name, "w");
+ if (incl == NULL)
+ {
+ fclose (in);
+ fprintf (stderr, "Cannot open \"%s\"\n", include_name);
+ exit (1);
+ }
+
+ /* Get past the initial block-style comment (man, this parsing code is just
+ _so_ lame, but I'm too lazy to improve it). */
+
+ for (;;)
+ {
+ cc = getc (in);
+ if (cc == '{')
+ {
+ while (((cc = getc (in)) != '}') && (cc != EOF))
+ ;
+ }
+ else if (cc != EOF)
+ {
+ while (((cc = getc (in)) != EOF) && (!isalnum (cc)))
+ ;
+ ungetc (cc, in);
+ break;
+ }
+ else
+ {
+ assert ("EOF too soon!" == NULL);
+ exit (1);
+ }
+ }
+
+ fscanf (in, "%s %s %s %s %s %d %d", prefix, postfix, storage, type, routine,
+ &do_name, &do_names);
+
+ if (storage[0] == '\0')
+ storage[1] = '\0';
+ else
+ /* Assume string is quoted somehow, replace ending quote with space. */
+ {
+ if (storage[2] == '\0')
+ storage[1] = '\0';
+ else
+ storage[strlen (storage) - 1] = ' ';
+ }
+
+ if (postfix[0] == '\0')
+ postfix[1] = '\0';
+ else /* Assume string is quoted somehow, strip off
+ ending quote. */
+ postfix[strlen (postfix) - 1] = '\0';
+
+ for (i = 1; storage[i] != '\0'; ++i)
+ storage[i - 1] = storage[i];
+ storage[i - 1] = '\0';
+
+ for (i = 1; postfix[i] != '\0'; ++i)
+ postfix[i - 1] = postfix[i];
+ postfix[i - 1] = '\0';
+
+ fixlengths = strlen (prefix) + strlen (postfix);
+
+ while (TRUE)
+ {
+ count = fscanf (in, "%s %s", buf, kwname);
+ if (count == EOF)
+ break;
+ len = strlen (buf);
+ if (len == 0)
+ continue; /* Skip empty lines. */
+ if (buf[0] == ';')
+ continue; /* Skip commented-out lines. */
+ for (i = strlen (buf) - 1; i > 0; --i)
+ cc = buf[i];
+
+ /* Make new name object to store name and its keyword. */
+
+ newname = (name) malloc (sizeof (*newname));
+ newname->namelen = strlen (buf);
+ newname->kwlen = strlen (kwname);
+ total_length = newname->kwlen + fixlengths;
+ if (total_length >= 32) /* Else resulting keyword name too long. */
+ {
+ fprintf (stderr, "%s: %s%s%s is 31+%d chars long\n", input_name,
+ prefix, kwname, postfix, total_length - 31);
+ do_exit = TRUE;
+ }
+ strcpy (newname->kwname, kwname);
+ for (i = 0; i < newname->namelen; ++i)
+ {
+ cc = buf[i];
+ if (isascii (cc) && isalpha (cc))
+ {
+ newname->name_uc[i] = toupper (cc);
+ newname->name_lc[i] = tolower (cc);
+ newname->name_ic[i] = cc;
+ }
+ else
+ newname->name_uc[i] = newname->name_lc[i] = newname->name_ic[i]
+ = cc;
+ }
+ newname->name_uc[i] = newname->name_lc[i] = newname->name_ic[i] = '\0';
+
+ /* Warn user if names aren't alphabetically ordered. */
+
+ if ((last_buf[0] != '\0')
+ && (strcmp (last_buf, newname->name_uc) >= 0))
+ {
+ fprintf (stderr, "%s: \"%s\" precedes \"%s\"\n", input_name,
+ last_buf, newname->name_uc);
+ do_exit = TRUE;
+ }
+ strcpy (last_buf, newname->name_uc);
+
+ /* Append name to end of alpha-sorted list (assumes names entered in
+ alpha order wrt name, not kwname, even though kwname is output from
+ this list). */
+
+ n = names_alpha.last;
+ newname->next_alpha = n->next_alpha;
+ newname->previous_alpha = n;
+ n->next_alpha->previous_alpha = newname;
+ n->next_alpha = newname;
+
+ /* Insert name in appropriate length/name ordered list. */
+
+ n = (name) &names[len];
+ while ((n->next != (name) &names[len])
+ && (strcmp (buf, n->next->name_uc) > 0))
+ n = n->next;
+ if (strcmp (buf, n->next->name_uc) == 0)
+ {
+ fprintf (stderr, "%s: extraneous \"%s\"\n", input_name, buf);
+ do_exit = TRUE;
+ }
+ newname->next = n->next;
+ newname->previous = n;
+ n->next->previous = newname;
+ n->next = newname;
+ }
+
+#if 0
+ for (len = 0; len < ARRAY_SIZE (name); ++len)
+ {
+ if (names[len].first == (name) &names[len])
+ continue;
+ printf ("Length %d:\n", len);
+ for (n = names[len].first; n != (name) &names[len]; n = n->next)
+ printf (" %s %s %s\n", n->name_uc, n->name_lc, n->name_ic);
+ }
+#endif
+
+ if (do_exit)
+ exit (1);
+
+ /* First output the #include file. */
+
+ for (n = names_alpha.first; n != (name) &names_alpha; n = n->next_alpha)
+ {
+ fprintf (incl, "#define %sl%s%s %d\n", prefix, n->kwname, postfix,
+ n->namelen);
+ }
+
+ fprintf (incl,
+ "\
+\n\
+enum %s_\n\
+{\n\
+%sNone%s,\n\
+",
+ type, prefix, postfix);
+
+ for (n = names_alpha.first; n != (name) &names_alpha; n = n->next_alpha)
+ {
+ fprintf (incl,
+ "\
+%s%s%s,\n\
+",
+ prefix, n->kwname, postfix);
+ }
+
+ fprintf (incl,
+ "\
+%s%s\n\
+};\n\
+typedef enum %s_ %s;\n\
+",
+ prefix, postfix, type, type);
+
+ /* Now output the C program. */
+
+ fprintf (out,
+ "\
+%s%s\n\
+%s (ffelexToken t)\n\
+%c\n\
+ char *p;\n\
+ int c;\n\
+\n\
+ p = ffelex_token_text (t);\n\
+\n\
+",
+ storage, type, routine, '{');
+
+ if (do_name)
+ {
+ if (do_names)
+ fprintf (out,
+ "\
+ if (ffelex_token_type (t) == FFELEX_typeNAME)\n\
+ {\n\
+ switch (ffelex_token_length (t))\n\
+\t{\n\
+"
+ );
+ else
+ fprintf (out,
+ "\
+ assert (ffelex_token_type (t) == FFELEX_typeNAME);\n\
+\n\
+ switch (ffelex_token_length (t))\n\
+ {\n\
+"
+ );
+
+/* Now output the length as a case, followed by the binary search within that length. */
+
+ for (len = 0; ((size_t) len) < ARRAY_SIZE (names); ++len)
+ {
+ if (names[len].first != (name) &names[len])
+ {
+ if (do_names)
+ fprintf (out,
+ "\
+\tcase %d:\n\
+",
+ len);
+ else
+ fprintf (out,
+ "\
+ case %d:\n\
+",
+ len);
+ testname (FALSE, do_names ? 10 : 6, names[len].first, names[len].last);
+ if (do_names)
+ fprintf (out,
+ "\
+\t break;\n\
+"
+ );
+ else
+ fprintf (out,
+ "\
+ break;\n\
+"
+ );
+ }
+ }
+
+ if (do_names)
+ fprintf (out,
+ "\
+\t}\n\
+ return %sNone%s;\n\
+ }\n\
+\n\
+",
+ prefix, postfix);
+ else
+ fprintf (out,
+ "\
+ }\n\
+\n\
+ return %sNone%s;\n\
+}\n\
+",
+ prefix, postfix);
+ }
+
+ if (do_names)
+ {
+ fputs ("\
+ assert (ffelex_token_type (t) == FFELEX_typeNAMES);\n\
+\n\
+ switch (ffelex_token_length (t))\n\
+ {\n\
+ default:\n\
+",
+ out);
+
+ /* Find greatest non-empty length list. */
+
+ for (len = ARRAY_SIZE (names) - 1;
+ names[len].first == (name) &names[len];
+ --len)
+ ;
+
+/* Now output the length as a case, followed by the binary search within that length. */
+
+ if (len > 0)
+ {
+ for (; len != 0; --len)
+ {
+ fprintf (out,
+ "\
+ case %d:\n\
+",
+ len);
+ if (names[len].first != (name) &names[len])
+ testnames (FALSE, 6, len, names[len].first, names[len].last);
+ }
+ if (names[1].first == (name) &names[1])
+ fprintf (out,
+ "\
+ ;\n\
+"
+ ); /* Need empty statement after an empty case
+ 1: */
+ }
+
+ fprintf (out,
+ "\
+ }\n\
+\n\
+ return %sNone%s;\n\
+}\n\
+",
+ prefix, postfix);
+ }
+
+ if (out != stdout)
+ fclose (out);
+ if (incl != stdout)
+ fclose (incl);
+ if (in != stdin)
+ fclose (in);
+ exit (0);
+}
+
+void
+testname (bool nested, int indent, name first, name last)
+{
+ name n;
+ name nhalf;
+ int num;
+ int numhalf;
+
+ assert (!nested || indent >= 2);
+ assert (((size_t) indent) + 4 < ARRAY_SIZE (spaces));
+
+ num = 0;
+ numhalf = 0;
+ for (n = first, nhalf = first; n != last->next; n = n->next)
+ {
+ if ((++num & 1) == 0)
+ {
+ nhalf = nhalf->next;
+ ++numhalf;
+ }
+ }
+
+ if (nested)
+ fprintf (out,
+ "\
+%s{\n\
+",
+ spaces[indent - 2]);
+
+ fprintf (out,
+ "\
+%sif ((c = ffesrc_strcmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\")) == 0)\n\
+%sreturn %s%s%s;\n\
+",
+ spaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
+ spaces[indent + 2], prefix, nhalf->kwname, postfix);
+
+ if (num != 1)
+ {
+ fprintf (out,
+ "\
+%selse if (c < 0)\n\
+",
+ spaces[indent]);
+
+ if (numhalf == 0)
+ fprintf (out,
+ "\
+%s;\n\
+",
+ spaces[indent + 2]);
+ else
+ testname (TRUE, indent + 4, first, nhalf->previous);
+
+ if (num - numhalf > 1)
+ {
+ fprintf (out,
+ "\
+%selse\n\
+",
+ spaces[indent]);
+
+ testname (TRUE, indent + 4, nhalf->next, last);
+ }
+ }
+
+ if (nested)
+ fprintf (out,
+ "\
+%s}\n\
+",
+ spaces[indent - 2]);
+}
+
+void
+testnames (bool nested, int indent, int len, name first, name last)
+{
+ name n;
+ name nhalf;
+ int num;
+ int numhalf;
+
+ assert (!nested || indent >= 2);
+ assert (((size_t) indent) + 4 < ARRAY_SIZE (spaces));
+
+ num = 0;
+ numhalf = 0;
+ for (n = first, nhalf = first; n != last->next; n = n->next)
+ {
+ if ((++num & 1) == 0)
+ {
+ nhalf = nhalf->next;
+ ++numhalf;
+ }
+ }
+
+ if (nested)
+ fprintf (out,
+ "\
+%s{\n\
+",
+ spaces[indent - 2]);
+
+ fprintf (out,
+ "\
+%sif ((c = ffesrc_strncmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\", %d)) == 0)\n\
+%sreturn %s%s%s;\n\
+",
+ spaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
+ len, spaces[indent + 2], prefix, nhalf->kwname, postfix);
+
+ if (num != 1)
+ {
+ fprintf (out,
+ "\
+%selse if (c < 0)\n\
+",
+ spaces[indent]);
+
+ if (numhalf == 0)
+ fprintf (out,
+ "\
+%s;\n\
+",
+ spaces[indent + 2]);
+ else
+ testnames (TRUE, indent + 4, len, first, nhalf->previous);
+
+ if (num - numhalf > 1)
+ {
+ fprintf (out,
+ "\
+%selse\n\
+",
+ spaces[indent]);
+
+ testnames (TRUE, indent + 4, len, nhalf->next, last);
+ }
+ }
+
+ if (nested)
+ fprintf (out,
+ "\
+%s}\n\
+",
+ spaces[indent - 2]);
+}
diff --git a/gcc/f/flags.j b/gcc/f/flags.j
new file mode 100644
index 00000000000..67966b9448e
--- /dev/null
+++ b/gcc/f/flags.j
@@ -0,0 +1,27 @@
+/* flags.j -- Wrapper for GCC's flags.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_flags
+#define _J_f_flags
+#include "flags.h"
+#endif
+#endif
diff --git a/gcc/f/g77.1 b/gcc/f/g77.1
new file mode 100644
index 00000000000..fe8b897266f
--- /dev/null
+++ b/gcc/f/g77.1
@@ -0,0 +1,364 @@
+.\" Copyright (c) 1995, 1996 Free Software Foundation -*-Text-*-
+.\" See section COPYING for conditions for redistribution
+.\" FIXME: no info here on predefines. Should there be? extra for F77...
+.TH G77 1 "1997-06-20" "GNU Tools" "GNU Tools"
+.de BP
+.sp
+.ti \-.2i
+\(**
+..
+.SH NAME
+g77 \- GNU project F77 Compiler (v0.5.18)
+.SH SYNOPSIS
+.RB g77 " [" \c
+.IR option " | " "filename " ].\|.\|.
+.SH WARNING
+The information in this man page is an extract from the full
+documentation of the GNU Fortran compiler (version 0.5.18),
+and is limited to the meaning of the options.
+.PP
+This man page is not up to date, since no volunteers want to
+maintain it. If you find a discrepancy between the man page and the
+software, please check the Info file, which is the authoritative
+documentation.
+.PP
+The version of GNU Fortran documented by the Info file is 0.5.21,
+which includes substantial improvements and changes since 0.5.18,
+the version documented in this man page.
+.PP
+If we find that the things in this man page that are out of date cause
+significant confusion or complaints, we will stop distributing the man
+page. The alternative, updating the man page when we update the Info
+file, is impractical because the rest of the work of maintaining GNU Fortran
+leaves us no time for that. The GNU project regards man pages as
+obsolete and should not let them take time away from other things.
+.PP
+For complete and current documentation, refer to the Info file `\|\c
+.B g77\c
+\&\|' or the manual
+.I
+Using and Porting GNU Fortran (for version 0.5.18)\c
+\&. Both are made from the Texinfo source file
+.BR g77.texi .
+.PP
+If your system has the `\|\c
+.B info\c
+\&\|' command installed, the command `\|\c
+.B info g77\c
+\&\|' should work, unless
+.B g77
+has not been properly installed.
+If your system lacks `\|\c
+.B info\c
+\&\|', or you wish to avoid using it for now,
+the command `\|\c
+.B more /usr/info/g77.info*\c
+\&\|' should work, unless
+.B g77
+has not been properly installed.
+.PP
+If
+.B g77
+has not been properly installed, so that you
+cannot easily access the Info file for it,
+ask your system administrator, or the installer
+of
+.B g77
+(if you know who that is) to fix the problem.
+.SH DESCRIPTION
+The C and F77 compilers are integrated;
+.B g77
+is a program to call
+.B gcc with options to recognize F77.
+.B gcc
+processes input files
+through one or more of four stages: preprocessing, compilation,
+assembly, and linking. This man page contains full descriptions for
+.I only
+F77 specific aspects of the compiler, though it also contains
+summaries of some general-purpose options. For a fuller explanation
+of the compiler, see
+.BR gcc ( 1 ).
+
+For complete documentation on GNU Fortran, type
+.BR info g77
+
+F77 source files use the suffix `\|\c
+.B .f\c
+\&\|'; F77 files to be preprocessed by
+.BR cpp ( 1 )
+use the suffix `\|\c
+.B .F\c
+\&\|'.
+.SH OPTIONS
+There are many command-line options, including options to control
+details of optimization, warnings, and code generation, which are
+common to both
+.B gcc
+and
+.B g77\c
+\&. For full information on all options, see
+.BR gcc ( 1 ).
+
+Options must be separate: `\|\c
+.B \-dr\c
+\&\|' is quite different from `\|\c
+.B \-d \-r
+\&\|'.
+
+Most `\|\c
+.B \-f\c
+\&\|' and `\|\c
+.B \-W\c
+\&\|' options have two contrary forms:
+.BI \-f name
+and
+.BI \-fno\- name\c
+\& (or
+.BI \-W name
+and
+.BI \-Wno\- name\c
+\&). Only the non-default forms are shown here.
+
+.TP
+.B \-c
+Compile or assemble the source files, but do not link. The compiler
+output is an object file corresponding to each source file.
+.TP
+.BI \-D macro
+Define macro \c
+.I macro\c
+\& with the string `\|\c
+.B 1\c
+\&\|' as its definition.
+.TP
+.BI \-D macro = defn
+Define macro \c
+.I macro\c
+\& as \c
+.I defn\c
+\&.
+.TP
+.BI \-\-driver= command
+Specifies that
+.IR command ,
+rather than
+.RB ` gcc ',
+is to be invoked by
+.RB ` g77 '
+to do its job. Example: Within the gcc build directory after building
+GNU Fortran (but without having to install it),
+.nf
+ ./g77 \-\-driver=./xgcc -B./ foo.f
+.fi
+.TP
+.B \-E
+Stop after the preprocessing stage; do not run the compiler proper. The
+output is preprocessed source code, which is sent to the
+standard output.
+.TP
+.B \-g
+Produce debugging information in the operating system's native format
+(for DBX or SDB or DWARF). GDB also can work with this debugging
+information. On most systems that use DBX format, `\|\c
+.B \-g\c
+\&\|' enables use
+of extra debugging information that only GDB can use.
+
+Unlike most other Fortran compilers, GNU Fortran allows you to use `\|\c
+.B \-g\c
+\&\|' with
+`\|\c
+.B \-O\c
+\&\|'. The shortcuts taken by optimized code may occasionally
+produce surprising results: some variables you declared may not exist
+at all; flow of control may briefly move where you did not expect it;
+some statements may not be executed because they compute constant
+results or their values were already at hand; some statements may
+execute in different places because they were moved out of loops.
+
+Nevertheless it proves possible to debug optimized output. This makes
+it reasonable to use the optimizer for programs that might have bugs.
+.TP
+.BI "\-I" "dir"\c
+\&
+Append directory \c
+.I dir\c
+\& to the list of directories searched for include files.
+.TP
+.BI "\-L" "dir"\c
+\&
+Add directory \c
+.I dir\c
+\& to the list of directories to be searched
+for `\|\c
+.B \-l\c
+\&\|'.
+.TP
+.BI \-l library\c
+\&
+Use the library named \c
+.I library\c
+\& when linking.
+.TP
+.B \-nostdinc
+Do not search the standard system directories for header files. Only
+the directories you have specified with
+.B \-I
+options (and the current directory, if appropriate) are searched.
+.TP
+.B \-O
+Optimize. Optimizing compilation takes somewhat more time, and a lot
+more memory for a large function. See the GCC documentation for
+further optimisation options. Loop unrolling, in particular, may be
+worth investigating for typical numerical Fortran programs.
+.TP
+.BI "\-o " file\c
+\&
+Place output in file \c
+.I file\c
+\&.
+.TP
+.B \-S
+Stop after the stage of compilation proper; do not assemble. The output
+is an assembler code file for each non-assembler input
+file specified.
+.TP
+.BI \-U macro
+Undefine macro \c
+.I macro\c
+\&.
+.TP
+.B \-v
+Print (on standard error output) the commands executed to run the
+stages of compilation. Also print the version number of the compiler
+driver program and of the preprocessor and the compiler proper. The
+version numbers of g77 itself and the GCC distribution on which it is
+based are distinct. Use
+.RB ` \-\-driver=true '
+to disable actual invocation of
+.RB ` gcc '
+(since
+.RB ` true '
+is the name of a UNIX command that simply returns success status).
+The command
+.RB ` "gcc -v" '
+is the appropriate one to determine the g77 and GCC version numbers;
+it will produce an irrelevant error message from
+.RB ` ld '.
+.TP
+.B \-Wall
+Issue warnings for conditions which pertain to usage that we recommend
+avoiding and that we believe is easy to avoid, even in conjunction
+with macros.
+.PP
+
+.SH FILES
+.ta \w'LIBDIR/g77\-include 'u
+file.h C header (preprocessor) file
+.br
+file.f Fortran source file
+.br
+file.for Fortran source file
+.br
+file.F preprocessed Fortran source file
+.br
+file.fpp preprocessed Fortran source file
+.br
+file.s assembly language file
+.br
+file.o object file
+.br
+a.out link edited output
+.br
+\fITMPDIR\fR/cc\(** temporary files
+.br
+\fILIBDIR\fR/cpp preprocessor
+.br
+\fILIBDIR\fR/f771 compiler
+.br
+\fILIBDIR\fR/libf2c.a Fortran run-time library
+.br
+\fILIBDIR\fR/libgcc.a GCC subroutine library
+.br
+/lib/crt[01n].o start-up routine
+.br
+/lib/libc.a standard C library, see
+.IR intro (3)
+.br
+/usr/include standard directory for
+.B #include
+files
+.br
+\fILIBDIR\fR/include standard gcc directory for
+.B #include
+files
+.I LIBDIR
+is usually
+.B /usr/local/lib/\c
+.IR machine / version .
+.br
+.I TMPDIR
+comes from the environment variable
+.B TMPDIR
+(default
+.B /usr/tmp
+if available, else
+.B /tmp\c
+\&).
+.SH "SEE ALSO"
+gcc(1), cpp(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1).
+.br
+.RB "`\|" g77 "\|', `\|" gcc "\|', `\|" cpp \|',
+.RB `\| as \|', `\| ld \|',
+and
+.RB `\| gdb \|'
+entries in
+.B info\c
+\&.
+.br
+.I
+Using and Porting GNU Fortran (for version 0.5.18)\c
+, James Craig Burley;
+.I
+Using and Porting GNU CC (for version 2.0)\c
+, Richard M. Stallman;
+.I
+The C Preprocessor\c
+, Richard M. Stallman;
+.I
+Debugging with GDB: the GNU Source-Level Debugger\c
+, Richard M. Stallman and Roland H. Pesch;
+.I
+Using as: the GNU Assembler\c
+, Dean Elsner, Jay Fenlason & friends;
+.I
+gld: the GNU linker\c
+, Steve Chamberlain and Roland Pesch.
+
+.SH BUGS
+For instructions on how to report bugs, see the file
+.B DOC
+in the g77 distribution.
+
+.SH COPYING
+Copyright (c) 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+.PP
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+.PP
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+.PP
+Permission is granted to copy and distribute translations of this
+manual into another language, under the above conditions for modified
+versions, except that this permission notice may be included in
+translations approved by the Free Software Foundation instead of in
+the original English.
+.SH AUTHORS
+See the GNU CC Manual for the contributors to GNU CC.
+See the GNU Fortran Manual for the contributors to
+GNU Fortran.
diff --git a/gcc/f/g77.c b/gcc/f/g77.c
new file mode 100644
index 00000000000..0d6f07fae30
--- /dev/null
+++ b/gcc/f/g77.c
@@ -0,0 +1,1557 @@
+/* G77 preliminary semantic processing for the compiler driver.
+ Copyright (C) 1993-1997 Free Software Foundation, Inc.
+ Contributed by Brendan Kehoe (brendan@cygnus.com), with significant
+ modifications for GNU Fortran by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+/* This program is a wrapper to the main `gcc' driver. The generic
+ goal of this program is to be basically identical to gcc (in that
+ it faithfully passes all of the original arguments to gcc) but,
+ unless explicitly overridden by the user in certain ways, ensure
+ that the needs of the language supported by this wrapper are met.
+
+ For GNU Fortran (g77), we do the following to the argument list
+ before passing it to `gcc':
+
+ 1. Put `-xf77', `-xf77-cpp-input' or `-xratfor' before each list
+ of foo.f, foo.F or foo.r source files and put `-xnone' after
+ that list, if necessary. This shouldn't normally be necessary,
+ but it is done in case gcc.c normally treats .f/.F files as,
+ say, to be compiled by f2c.
+
+ 2. Make sure `-lf2c -lm' is at the end of the list.
+
+ 3. Make sure each time `-lf2c' or `-lm' is seen, it forms
+ part of the series `-lf2c -lm'.
+
+ #1 is not done if `-xfoo' is in effect (where foo is not "none").
+ #2 and #3 are not done if `-nostdlib' or any option that disables
+ the linking phase is present, or if `-xfoo' is in effect. Note that
+ -v by itself disables linking.
+
+ This program was originally made out of gcc/cp/g++.c, but the
+ way it builds the new argument list was rewritten so it is much
+ easier to maintain, improve the way it decides to add or not add
+ extra arguments, etc. And several improvements were made in the
+ handling of arguments, primarily to make it more consistent with
+ `gcc' itself. */
+
+#ifndef LANGUAGE_F77
+#define LANGUAGE_F77 1 /* Assume f77 language wanted. */
+#endif
+
+#if LANGUAGE_F77 != 1
+#include <stdio.h>
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ fprintf (stderr, "\
+g77: `f77' language not included in list of languages\n\
+ built with this installation of gcc.\n");
+ exit (1);
+}
+
+#else /* LANGUAGE_F77 == 1 */
+#include "config.j"
+#include "zzz.h"
+#include <sys/types.h>
+#include <errno.h>
+
+#ifndef _WIN32
+#include <sys/file.h> /* May get R_OK, etc. on some systems. */
+#else
+#include <process.h>
+#endif
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+#include <stdio.h>
+
+/* Include multi-lib information. */
+#include "multilib.h"
+
+#ifndef R_OK
+#define R_OK 4
+#define W_OK 2
+#define X_OK 1
+#endif
+
+#ifndef WIFSIGNALED
+#define WIFSIGNALED(S) (((S) & 0xff) != 0 && ((S) & 0xff) != 0x7f)
+#endif
+#ifndef WTERMSIG
+#define WTERMSIG(S) ((S) & 0x7f)
+#endif
+#ifndef WIFEXITED
+#define WIFEXITED(S) (((S) & 0xff) == 0)
+#endif
+#ifndef WEXITSTATUS
+#define WEXITSTATUS(S) (((S) & 0xff00) >> 8)
+#endif
+
+/* Defined to the name of the compiler; if using a cross compiler, the
+ Makefile should compile this file with the proper name
+ (e.g., "i386-aout-gcc"). */
+#ifndef GCC_NAME
+#define GCC_NAME "gcc"
+#endif
+
+/* On MSDOS, write temp files in current dir
+ because there's no place else we can expect to use. */
+#ifdef __MSDOS__
+#ifndef P_tmpdir
+#define P_tmpdir "."
+#endif
+#ifndef R_OK
+#define R_OK 4
+#define W_OK 2
+#define X_OK 1
+#endif
+#endif
+
+/* Add prototype support. */
+#ifndef PROTO
+#if defined (USE_PROTOTYPES) ? USE_PROTOTYPES : defined (__STDC__)
+#define PROTO(ARGS) ARGS
+#else
+#define PROTO(ARGS) ()
+#endif
+#endif
+
+#ifndef VPROTO
+#ifdef __STDC__
+#define PVPROTO(ARGS) ARGS
+#define VPROTO(ARGS) ARGS
+#define VA_START(va_list,var) va_start(va_list,var)
+#else
+#define PVPROTO(ARGS) ()
+#define VPROTO(ARGS) (va_alist) va_dcl
+#define VA_START(va_list,var) va_start(va_list)
+#endif
+#endif
+
+/* Define a generic NULL if one hasn't already been defined. */
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+/* Define O_RDONLY if the system hasn't defined it for us. */
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#endif
+
+#ifndef GENERIC_PTR
+#if defined (USE_PROTOTYPES) ? USE_PROTOTYPES : defined (__STDC__)
+#define GENERIC_PTR void *
+#else
+#define GENERIC_PTR char *
+#endif
+#endif
+
+#ifndef NULL_PTR
+#define NULL_PTR ((GENERIC_PTR)0)
+#endif
+
+#ifdef USG
+#define vfork fork
+#endif /* USG */
+
+/* On MSDOS, write temp files in current dir
+ because there's no place else we can expect to use. */
+#ifdef __MSDOS__
+#ifndef P_tmpdir
+#define P_tmpdir "."
+#endif
+#endif
+
+/* By default there is no special suffix for executables. */
+#ifndef EXECUTABLE_SUFFIX
+#define EXECUTABLE_SUFFIX ""
+#endif
+
+/* By default, colon separates directories in a path. */
+#ifndef PATH_SEPARATOR
+#define PATH_SEPARATOR ':'
+#endif
+
+#ifndef DIR_SEPARATOR
+#define DIR_SEPARATOR '/'
+#endif
+
+static char dir_separator_str[] = {DIR_SEPARATOR, 0};
+
+extern char *getenv ();
+
+#ifndef errno
+extern int errno;
+#endif
+
+extern int sys_nerr;
+#ifndef HAVE_STRERROR
+#if defined(bsd4_4)
+extern const char *const sys_errlist[];
+#else
+extern char *sys_errlist[];
+#endif
+#else
+extern char *strerror();
+#endif
+
+/* Name with which this program was invoked. */
+static char *programname;
+
+/* argc, argv from main(). */
+static int xargc;
+static char **xargv;
+
+/* The new argument list will be contained in these, though if identical
+ to the original list, these will be == xargc, xargv. */
+static int newargc;
+static char **newargv;
+
+/* Options this driver needs to recognize, not just know how to
+ skip over. */
+typedef enum
+{
+ OPTION_b, /* Aka --prefix. */
+ OPTION_B, /* Aka --target. */
+ OPTION_c, /* Aka --compile. */
+ OPTION_driver, /* Wrapper-specific option. */
+ OPTION_E, /* Aka --preprocess. */
+ OPTION_for_linker, /* Aka `-Xlinker' and `-Wl,'. */
+ OPTION_help, /* --help. */
+ OPTION_i, /* -imacros, -include, -include-*. */
+ OPTION_l,
+ OPTION_L, /* Aka --library-directory. */
+ OPTION_M, /* Aka --dependencies. */
+ OPTION_MM, /* Aka --user-dependencies. */
+ OPTION_nostdlib, /* Aka --no-standard-libraries, or
+ -nodefaultlibs. */
+ OPTION_o, /* Aka --output. */
+ OPTION_P, /* Aka --print-*-name. */
+ OPTION_S, /* Aka --assemble. */
+ OPTION_syntax_only, /* -fsyntax-only. */
+ OPTION_v, /* Aka --verbose. */
+ OPTION_version, /* --version. */
+ OPTION_V, /* Aka --use-version. */
+ OPTION_x, /* Aka --language. */
+ OPTION_ /* Unrecognized or unimportant. */
+} Option;
+
+/* THE FOLLOWING COMES STRAIGHT FROM prerelease gcc-2.8.0/gcc.c: */
+
+/* This defines which switch letters take arguments. */
+
+#define DEFAULT_SWITCH_TAKES_ARG(CHAR) \
+ ((CHAR) == 'D' || (CHAR) == 'U' || (CHAR) == 'o' \
+ || (CHAR) == 'e' || (CHAR) == 'T' || (CHAR) == 'u' \
+ || (CHAR) == 'I' || (CHAR) == 'm' || (CHAR) == 'x' \
+ || (CHAR) == 'L' || (CHAR) == 'A')
+
+#ifndef SWITCH_TAKES_ARG
+#define SWITCH_TAKES_ARG(CHAR) DEFAULT_SWITCH_TAKES_ARG(CHAR)
+#endif
+
+/* This defines which multi-letter switches take arguments. */
+
+#define DEFAULT_WORD_SWITCH_TAKES_ARG(STR) \
+ (!strcmp (STR, "Tdata") || !strcmp (STR, "Ttext") \
+ || !strcmp (STR, "Tbss") || !strcmp (STR, "include") \
+ || !strcmp (STR, "imacros") || !strcmp (STR, "aux-info") \
+ || !strcmp (STR, "idirafter") || !strcmp (STR, "iprefix") \
+ || !strcmp (STR, "iwithprefix") || !strcmp (STR, "iwithprefixbefore") \
+ || !strcmp (STR, "isystem"))
+
+#ifndef WORD_SWITCH_TAKES_ARG
+#define WORD_SWITCH_TAKES_ARG(STR) DEFAULT_WORD_SWITCH_TAKES_ARG (STR)
+#endif
+
+/* This is the common prefix we use to make temp file names.
+ It is chosen once for each run of this program.
+ It is substituted into a spec by %g.
+ Thus, all temp file names contain this prefix.
+ In practice, all temp file names start with this prefix.
+
+ This prefix comes from the envvar TMPDIR if it is defined;
+ otherwise, from the P_tmpdir macro if that is defined;
+ otherwise, in /usr/tmp or /tmp. */
+
+static char *temp_filename;
+static char *temp_filename_f; /* Same with ".f" appended. */
+
+/* Length of the prefix. */
+
+static int temp_filename_length;
+
+/* The number of errors that have occurred; the link phase will not be
+ run if this is non-zero. */
+static int error_count = 0;
+
+/* Number of commands that exited with a signal. */
+
+static int signal_count = 0;
+
+/* END OF STUFF FROM gcc-2.7.0/gcc.c. */
+
+char *
+my_strerror(e)
+ int e;
+{
+
+#ifdef HAVE_STRERROR
+ return strerror(e);
+
+#else
+
+ static char buffer[30];
+ if (!e)
+ return "";
+
+ if (e > 0 && e < sys_nerr)
+ return sys_errlist[e];
+
+ sprintf (buffer, "Unknown error %d", e);
+ return buffer;
+#endif
+}
+
+#ifdef HAVE_VPRINTF
+/* Output an error message and exit */
+
+static void
+fatal VPROTO((char *format, ...))
+{
+#ifndef __STDC__
+ char *format;
+#endif
+ va_list ap;
+
+ VA_START (ap, format);
+
+#ifndef __STDC__
+ format = va_arg (ap, char*);
+#endif
+
+ fprintf (stderr, "%s: ", programname);
+ vfprintf (stderr, format, ap);
+ va_end (ap);
+ fprintf (stderr, "\n");
+#if 0
+ /* XXX Not needed for g77 driver. */
+ delete_temp_files ();
+#endif
+ exit (1);
+}
+
+static void
+error VPROTO((char *format, ...))
+{
+#ifndef __STDC__
+ char *format;
+#endif
+ va_list ap;
+
+ VA_START (ap, format);
+
+#ifndef __STDC__
+ format = va_arg (ap, char*);
+#endif
+
+ fprintf (stderr, "%s: ", programname);
+ vfprintf (stderr, format, ap);
+ va_end (ap);
+
+ fprintf (stderr, "\n");
+}
+
+#else /* not HAVE_VPRINTF */
+
+static void
+error (msg, arg1, arg2)
+ char *msg, *arg1, *arg2;
+{
+ fprintf (stderr, "%s: ", programname);
+ fprintf (stderr, msg, arg1, arg2);
+ fprintf (stderr, "\n");
+}
+
+static void
+fatal (msg, arg1, arg2)
+ char *msg, *arg1, *arg2;
+{
+ error (msg, arg1, arg2);
+#if 0
+ /* XXX Not needed for g77 driver. */
+ delete_temp_files ();
+#endif
+ exit (1);
+}
+
+#endif /* not HAVE_VPRINTF */
+
+/* More 'friendly' abort that prints the line and file.
+ config.h can #define abort fancy_abort if you like that sort of thing. */
+
+void
+fancy_abort ()
+{
+ fatal ("Internal g77 abort.");
+}
+
+char *
+xmalloc (size)
+ unsigned size;
+{
+ register char *value = (char *) malloc (size);
+ if (value == 0)
+ fatal ("virtual memory exhausted");
+ return value;
+}
+
+static char *
+concat (s1, s2)
+ char *s1, *s2;
+{
+ int len1 = strlen (s1);
+ int len2 = strlen (s2);
+ char *result = xmalloc (len1 + len2 + 1);
+
+ strcpy (result, s1);
+ strcpy (result + len1, s2);
+ *(result + len1 + len2) = 0;
+
+ return result;
+}
+
+static char *
+concat3 (s1, s2, s3)
+ char *s1, *s2, *s3;
+{
+ return concat (concat (s1, s2), s3);
+}
+
+static char *
+concat4 (s1, s2, s3, s4)
+ char *s1, *s2, *s3, *s4;
+{
+ return concat (concat (s1, s2), concat (s3, s4));
+}
+
+static char *
+concat6 (s1, s2, s3, s4, s5, s6)
+ char *s1, *s2, *s3, *s4, *s5, *s6;
+{
+ return concat3 (concat (s1, s2), concat (s3, s4), concat (s5, s6));
+}
+
+static void
+pfatal_with_name (name)
+ char *name;
+{
+ char *s;
+
+ if (errno < sys_nerr)
+ s = concat ("%s: ", my_strerror (errno));
+ else
+ s = "cannot open `%s'";
+ fatal (s, name);
+}
+
+static void
+perror_exec (name)
+ char *name;
+{
+ char *s;
+
+ if (errno < sys_nerr)
+ s = concat ("installation problem, cannot exec `%s': ",
+ my_strerror (errno));
+ else
+ s = "installation problem, cannot exec `%s'";
+ error (s, name);
+}
+
+/* Compute a string to use as the base of all temporary file names.
+ It is substituted for %g. */
+
+static char *
+choose_temp_base_try (try, base)
+ char *try;
+ char *base;
+{
+ char *rv;
+ if (base)
+ rv = base;
+ else if (try == (char *)0)
+ rv = 0;
+ else if (access (try, R_OK | W_OK) != 0)
+ rv = 0;
+ else
+ rv = try;
+ return rv;
+}
+
+static void
+choose_temp_base ()
+{
+ char *base = 0;
+ int len;
+
+ base = choose_temp_base_try (getenv ("TMPDIR"), base);
+ base = choose_temp_base_try (getenv ("TMP"), base);
+ base = choose_temp_base_try (getenv ("TEMP"), base);
+
+#ifdef P_tmpdir
+ base = choose_temp_base_try (P_tmpdir, base);
+#endif
+
+ base = choose_temp_base_try (concat4 (dir_separator_str, "usr",
+ dir_separator_str, "tmp"),
+ base);
+ base = choose_temp_base_try (concat (dir_separator_str, "tmp"), base);
+
+ /* If all else fails, use the current directory! */
+ if (base == (char *)0)
+ base = concat (".", dir_separator_str);
+
+ len = strlen (base);
+ temp_filename = xmalloc (len + strlen (concat (dir_separator_str,
+ "gfXXXXXX")) + 1);
+ strcpy (temp_filename, base);
+ if (len > 0 && temp_filename[len-1] != '/'
+ && temp_filename[len-1] != DIR_SEPARATOR)
+ temp_filename[len++] = DIR_SEPARATOR;
+ strcpy (temp_filename + len, "gfXXXXXX");
+
+ mktemp (temp_filename);
+ temp_filename_length = strlen (temp_filename);
+ if (temp_filename_length == 0)
+ abort ();
+
+ temp_filename_f = xmalloc (temp_filename_length + 2);
+ strcpy (temp_filename_f, temp_filename);
+ temp_filename_f[temp_filename_length] = '.';
+ temp_filename_f[temp_filename_length + 1] = 'f';
+ temp_filename_f[temp_filename_length + 2] = '\0';
+}
+
+/* This structure describes one mapping. */
+struct option_map
+{
+ /* The long option's name. */
+ char *name;
+ /* The equivalent short option. */
+ char *equivalent;
+ /* Argument info. A string of flag chars; NULL equals no options.
+ a => argument required.
+ o => argument optional.
+ j => join argument to equivalent, making one word.
+ * => require other text after NAME as an argument. */
+ char *arg_info;
+};
+
+/* This is the table of mappings. Mappings are tried sequentially
+ for each option encountered; the first one that matches, wins. */
+
+struct option_map option_map[] =
+ {
+ {"--all-warnings", "-Wall", 0},
+ {"--ansi", "-ansi", 0},
+ {"--assemble", "-S", 0},
+ {"--assert", "-A", "a"},
+ {"--comments", "-C", 0},
+ {"--compile", "-c", 0},
+ {"--debug", "-g", "oj"},
+ {"--define-macro", "-D", "a"},
+ {"--dependencies", "-M", 0},
+ {"--driver", "", 0}, /* Wrapper-specific. */
+ {"--dump", "-d", "a"},
+ {"--dumpbase", "-dumpbase", "a"},
+ {"--entry", "-e", 0},
+ {"--extra-warnings", "-W", 0},
+ {"--for-assembler", "-Wa", "a"},
+ {"--for-linker", "-Xlinker", "a"},
+ {"--force-link", "-u", "a"},
+ {"--imacros", "-imacros", "a"},
+ {"--include", "-include", "a"},
+ {"--include-barrier", "-I-", 0},
+ {"--include-directory", "-I", "a"},
+ {"--include-directory-after", "-idirafter", "a"},
+ {"--include-prefix", "-iprefix", "a"},
+ {"--include-with-prefix", "-iwithprefix", "a"},
+ {"--include-with-prefix-before", "-iwithprefixbefore", "a"},
+ {"--include-with-prefix-after", "-iwithprefix", "a"},
+ {"--language", "-x", "a"},
+ {"--library-directory", "-L", "a"},
+ {"--machine", "-m", "aj"},
+ {"--machine-", "-m", "*j"},
+ {"--no-line-commands", "-P", 0},
+ {"--no-precompiled-includes", "-noprecomp", 0},
+ {"--no-standard-includes", "-nostdinc", 0},
+ {"--no-standard-libraries", "-nostdlib", 0},
+ {"--no-warnings", "-w", 0},
+ {"--optimize", "-O", "oj"},
+ {"--output", "-o", "a"},
+ {"--pedantic", "-pedantic", 0},
+ {"--pedantic-errors", "-pedantic-errors", 0},
+ {"--pipe", "-pipe", 0},
+ {"--prefix", "-B", "a"},
+ {"--preprocess", "-E", 0},
+ {"--print-file-name", "-print-file-name=", "aj"},
+ {"--print-libgcc-file-name", "-print-libgcc-file-name", 0},
+ {"--print-missing-file-dependencies", "-MG", 0},
+ {"--print-multi-lib", "-print-multi-lib", 0},
+ {"--print-multi-directory", "-print-multi-directory", 0},
+ {"--print-prog-name", "-print-prog-name=", "aj"},
+ {"--profile", "-p", 0},
+ {"--profile-blocks", "-a", 0},
+ {"--quiet", "-q", 0},
+ {"--save-temps", "-save-temps", 0},
+ {"--shared", "-shared", 0},
+ {"--silent", "-q", 0},
+ {"--static", "-static", 0},
+ {"--symbolic", "-symbolic", 0},
+ {"--target", "-b", "a"},
+ {"--trace-includes", "-H", 0},
+ {"--traditional", "-traditional", 0},
+ {"--traditional-cpp", "-traditional-cpp", 0},
+ {"--trigraphs", "-trigraphs", 0},
+ {"--undefine-macro", "-U", "a"},
+ {"--use-version", "-V", "a"},
+ {"--user-dependencies", "-MM", 0},
+ {"--verbose", "-v", 0},
+ {"--version", "-dumpversion", 0},
+ {"--warn-", "-W", "*j"},
+ {"--write-dependencies", "-MD", 0},
+ {"--write-user-dependencies", "-MMD", 0},
+ {"--", "-f", "*j"}
+ };
+
+/* Compares --options that take one arg. */
+
+static int
+opteq (xskip, xarg, opt, name)
+ int *xskip;
+ char **xarg;
+ char *opt;
+ char *name;
+{
+ int optlen;
+ int namelen;
+ int complen;
+ int i;
+ int cmp = strcmp (opt, name);
+ int skip = 1;
+ char *arg = NULL;
+
+ if (cmp == 0)
+ {
+ /* Easy, a straight match. */
+ *xskip = skip;
+ *xarg = arg;
+ return cmp;
+ }
+
+ optlen = strlen (opt);
+
+ for (i = 0; i < sizeof (option_map) / sizeof (option_map[0]); ++i)
+ {
+ char *arginfo;
+ int j;
+
+ arginfo = option_map[i].arg_info;
+ if (arginfo == NULL)
+ arginfo = "";
+
+ namelen = strlen (option_map[i].name);
+ complen = optlen > namelen ? namelen : optlen;
+
+ if (strncmp (opt, option_map[i].name, complen) == 0)
+ {
+ if (optlen < namelen)
+ {
+ for (j = i + 1;
+ j < sizeof (option_map) / sizeof (option_map[0]);
+ ++j)
+ if ((strlen (option_map[j].name) >= optlen)
+ && (strncmp (opt, option_map[j].name, optlen) == 0))
+ fatal ("Ambiguous abbreviation `%s'", opt);
+ }
+
+ if (optlen > namelen)
+ {
+ if (opt[namelen] == '=')
+ {
+ skip = 0;
+ arg = opt + namelen + 1;
+ }
+ else if (index (arginfo, '*') != 0)
+ ;
+ else
+ continue;
+ }
+ else if (index (arginfo, '*') != 0)
+ fatal ("Incomplete `%s' option", option_map[i].name);
+
+ if (strcmp (name, option_map[i].name) != 0)
+ return 1; /* Not what is being looked for. */
+
+ *xskip = skip;
+ *xarg = arg;
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/* Assumes text[0] == '-'. Returns number of argv items that belong to
+ (and follow) this one, an option id for options important to the
+ caller, and a pointer to the first char of the arg, if embedded (else
+ returns NULL, meaning no arg or it's the next argv). */
+
+static void
+lookup_option (xopt, xskip, xarg, text)
+ Option *xopt;
+ int *xskip;
+ char **xarg;
+ char *text;
+{
+ Option opt = OPTION_;
+ int skip;
+ char *arg = NULL;
+
+ if ((skip = SWITCH_TAKES_ARG (text[1])) > (text[2] != '\0'))
+ skip -= (text[2] != '\0'); /* Usually one of "DUoeTuImLA". */
+
+ if (text[1] == 'B')
+ opt = OPTION_B, skip = (text[2] == '\0'), arg = text + 2;
+ else if (text[1] == 'b')
+ opt = OPTION_b, skip = (text[2] == '\0'), arg = text + 2;
+ else if ((text[1] == 'c') && (text[2] == '\0'))
+ opt = OPTION_c, skip = 0;
+ else if ((text[1] == 'E') && (text[2] == '\0'))
+ opt = OPTION_E, skip = 0;
+ else if (text[1] == 'i')
+ opt = OPTION_i, skip = 0;
+ else if (text[1] == 'l')
+ opt = OPTION_l;
+ else if (text[1] == 'L')
+ opt = OPTION_L, skip = (text[2] == '\0'), arg = text + 2;
+ else if (text[1] == 'o')
+ opt = OPTION_o;
+ else if ((text[1] == 'S') && (text[2] == '\0'))
+ opt = OPTION_S, skip = 0;
+ else if (text[1] == 'V')
+ opt = OPTION_V, skip = (text[2] == '\0');
+ else if ((text[1] == 'v') && (text[2] == '\0'))
+ opt = OPTION_v, skip = 0;
+ else if ((text[1] == 'W') && (text[2] == 'l') && (text[3] == ','))
+ opt = OPTION_for_linker, skip = 0;
+ else if (text[1] == 'x')
+ opt = OPTION_x, skip = (text[2] == '\0'), arg = text + 2;
+ else
+ {
+ if ((skip = WORD_SWITCH_TAKES_ARG (text + 1)) != 0)
+ /* Usually one of "Tdata", "Ttext", "Tbss", "include",
+ "imacros", "aux-info", "idirafter", "iprefix",
+ "iwithprefix", "iwithprefixbefore", "isystem". */
+ ;
+
+ if (strcmp (text, "--assemble") == 0)
+ opt = OPTION_S;
+ else if (strcmp (text, "--compile") == 0)
+ opt = OPTION_c;
+ else if (opteq (&skip, &arg, text, "--driver") == 0)
+ opt = OPTION_driver;
+ else if (strcmp (text, "--help") == 0)
+ opt = OPTION_help;
+ else if ((opteq (&skip, &arg, text, "--imacros") == 0)
+ || (opteq (&skip, &arg, text, "--include") == 0)
+ || (opteq (&skip, &arg, text, "--include-directory-after") == 0)
+ || (opteq (&skip, &arg, text, "--include-prefix") == 0)
+ || (opteq (&skip, &arg, text, "--include-with-prefix") == 0)
+ || (opteq (&skip, &arg, text, "--include-with-prefix-before") == 0)
+ || (opteq (&skip, &arg, text, "--include-with-prefix-after") == 0))
+ opt = OPTION_i;
+ else if (opteq (&skip, &arg, text, "--language") == 0)
+ opt = OPTION_x;
+ else if (opteq (&skip, &arg, text, "--library-directory") == 0)
+ opt = OPTION_L;
+ else if ((strcmp (text, "-M") == 0)
+ || (strcmp (text, "--dependencies") == 0))
+ opt = OPTION_M;
+ else if ((strcmp (text, "-MM") == 0)
+ || (strcmp (text, "--user-dependencies") == 0))
+ opt = OPTION_MM;
+ else if (strcmp (text, "--output") == 0)
+ opt = OPTION_o;
+ else if (opteq (&skip, &arg, text, "--prefix") == 0)
+ opt = OPTION_B;
+ else if (strcmp (text, "--preprocess") == 0)
+ opt = OPTION_E;
+ else if ((opteq (&skip, &arg, text, "--print-file-name") == 0)
+ || (strcmp (text, "--print-libgcc-file-name") == 0)
+ || (strcmp (text, "--print-multi-lib") == 0)
+ || (strcmp (text, "--print-multi-directory") == 0)
+ || (opteq (&skip, &arg, text, "--print-prog-name") == 0))
+ opt = OPTION_P;
+ else if ((strcmp (text, "-nostdlib") == 0)
+ || (strcmp (text, "--no-standard-libraries") == 0)
+ || (strcmp (text, "-nodefaultlibs") == 0))
+ opt = OPTION_nostdlib;
+ else if (strcmp (text, "-fsyntax-only") == 0)
+ opt = OPTION_syntax_only;
+ else if (opteq (&skip, &arg, text, "--use-version") == 0)
+ opt = OPTION_V;
+ else if (strcmp (text, "--verbose") == 0)
+ opt = OPTION_v;
+ else if (strcmp (text, "--version") == 0)
+ opt = OPTION_version;
+ else if (strcmp (text, "-Xlinker") == 0)
+ skip = 1;
+ else if ((opteq (&skip, &arg, text, "--assert") == 0)
+ || (opteq (&skip, &arg, text, "--define-macro") == 0)
+ || (opteq (&skip, &arg, text, "--dump") == 0)
+ || (opteq (&skip, &arg, text, "--dumpbase") == 0)
+ || (opteq (&skip, &arg, text, "--for-assembler") == 0)
+ || (opteq (&skip, &arg, text, "--for-linker") == 0)
+ || (opteq (&skip, &arg, text, "--force-link") == 0)
+ || (opteq (&skip, &arg, text, "--machine") == 0)
+ || (opteq (&skip, &arg, text, "--target") == 0)
+ || (opteq (&skip, &arg, text, "--undefine-macro") == 0))
+ ;
+ else
+ skip = 0;
+ }
+
+ if (xopt != NULL)
+ *xopt = opt;
+ if (xskip != NULL)
+ *xskip = skip;
+ if (xarg != NULL)
+ {
+ if ((arg != NULL)
+ && (arg[0] == '\0'))
+ *xarg = NULL;
+ else
+ *xarg = arg;
+ }
+}
+
+static void
+append_arg (arg)
+ char *arg;
+{
+ static int newargsize;
+
+#if 0
+ fprintf (stderr, "`%s'\n", arg);
+#endif
+
+ if ((newargv == xargv)
+ && (arg == xargv[newargc]))
+ {
+ ++newargc;
+ return; /* Nothing new here. */
+ }
+
+ if (newargv == xargv)
+ { /* Make new arglist. */
+ int i;
+
+ newargsize = (xargc << 2) + 20;
+ newargv = (char **) malloc (newargsize * sizeof (char *));
+
+ /* Copy what has been done so far. */
+ for (i = 0; i < newargc; ++i)
+ newargv[i] = xargv[i];
+ }
+
+ if (newargc == newargsize)
+ fatal ("overflowed output arg list for `%s'", arg);
+ newargv[newargc++] = arg;
+}
+
+extern int execv (), execvp ();
+
+/* If a stage of compilation returns an exit status >= 1,
+ compilation of that file ceases. */
+
+#define MIN_FATAL_STATUS 1
+
+/* stdin file number. */
+#define STDIN_FILE_NO 0
+
+/* stdout file number. */
+#define STDOUT_FILE_NO 1
+
+/* value of `pipe': port index for reading. */
+#define READ_PORT 0
+
+/* value of `pipe': port index for writing. */
+#define WRITE_PORT 1
+
+/* Pipe waiting from last process, to be used as input for the next one.
+ Value is STDIN_FILE_NO if no pipe is waiting
+ (i.e. the next command is the first of a group). */
+
+static int last_pipe_input;
+
+/* Fork one piped subcommand. FUNC is the system call to use
+ (either execv or execvp). ARGV is the arg vector to use.
+ NOT_LAST is nonzero if this is not the last subcommand
+ (i.e. its output should be piped to the next one.) */
+
+#ifdef __MSDOS__
+
+#include <process.h>
+static int
+pexecute (search_flag, program, argv, not_last)
+ int search_flag;
+ char *program;
+ char *argv[];
+ int not_last;
+{
+#ifdef __GO32__
+ int i = (search_flag ? spawnv : spawnvp) (1, program, argv);
+#else
+ char *scmd, *rf;
+ FILE *argfile;
+ int i, el = search_flag ? 0 : 4;
+
+ scmd = (char *)malloc (strlen (program) + strlen (temp_filename) + 6 + el);
+ rf = scmd + strlen(program) + 2 + el;
+ sprintf (scmd, "%s%s @%s.gp", program,
+ (search_flag ? "" : ".exe"), temp_filename);
+ argfile = fopen (rf, "w");
+ if (argfile == 0)
+ pfatal_with_name (rf);
+
+ for (i=1; argv[i]; i++)
+ {
+ char *cp;
+ for (cp = argv[i]; *cp; cp++)
+ {
+ if (*cp == '"' || *cp == '\'' || *cp == '\\' || isspace (*cp))
+ fputc ('\\', argfile);
+ fputc (*cp, argfile);
+ }
+ fputc ('\n', argfile);
+ }
+ fclose (argfile);
+
+ i = system (scmd);
+
+ remove (rf);
+#endif
+
+ if (i == -1)
+ {
+ perror_exec (program);
+ return MIN_FATAL_STATUS << 8;
+ }
+ return i << 8;
+}
+
+#endif
+
+#if !defined(__MSDOS__) && !defined(OS2) && !defined(_WIN32)
+
+static int
+pexecute (search_flag, program, argv, not_last)
+ int search_flag;
+ char *program;
+ char *argv[];
+ int not_last;
+{
+ int (*func)() = (search_flag ? execv : execvp);
+ int pid;
+ int pdes[2];
+ int input_desc = last_pipe_input;
+ int output_desc = STDOUT_FILE_NO;
+ int retries, sleep_interval;
+
+ /* If this isn't the last process, make a pipe for its output,
+ and record it as waiting to be the input to the next process. */
+
+ if (not_last)
+ {
+ if (pipe (pdes) < 0)
+ pfatal_with_name ("pipe");
+ output_desc = pdes[WRITE_PORT];
+ last_pipe_input = pdes[READ_PORT];
+ }
+ else
+ last_pipe_input = STDIN_FILE_NO;
+
+ /* Fork a subprocess; wait and retry if it fails. */
+ sleep_interval = 1;
+ for (retries = 0; retries < 4; retries++)
+ {
+ pid = vfork ();
+ if (pid >= 0)
+ break;
+ sleep (sleep_interval);
+ sleep_interval *= 2;
+ }
+
+ switch (pid)
+ {
+ case -1:
+#ifdef vfork
+ pfatal_with_name ("fork");
+#else
+ pfatal_with_name ("vfork");
+#endif
+ /* NOTREACHED */
+ return 0;
+
+ case 0: /* child */
+ /* Move the input and output pipes into place, if nec. */
+ if (input_desc != STDIN_FILE_NO)
+ {
+ close (STDIN_FILE_NO);
+ dup (input_desc);
+ close (input_desc);
+ }
+ if (output_desc != STDOUT_FILE_NO)
+ {
+ close (STDOUT_FILE_NO);
+ dup (output_desc);
+ close (output_desc);
+ }
+
+ /* Close the parent's descs that aren't wanted here. */
+ if (last_pipe_input != STDIN_FILE_NO)
+ close (last_pipe_input);
+
+ /* Exec the program. */
+ (*func) (program, argv);
+ perror_exec (program);
+ exit (-1);
+ /* NOTREACHED */
+ return 0;
+
+ default:
+ /* In the parent, after forking.
+ Close the descriptors that we made for this child. */
+ if (input_desc != STDIN_FILE_NO)
+ close (input_desc);
+ if (output_desc != STDOUT_FILE_NO)
+ close (output_desc);
+
+ /* Return child's process number. */
+ return pid;
+ }
+}
+
+#endif /* not __MSDOS__ and not OS2 and not _WIN32 */
+
+#if defined(OS2)
+
+static int
+pexecute (search_flag, program, argv, not_last)
+ int search_flag;
+ char *program;
+ char *argv[];
+ int not_last;
+{
+ return (search_flag ? spawnv : spawnvp) (1, program, argv);
+}
+#endif /* OS2 */
+
+#if defined(_WIN32)
+
+static int
+pexecute (search_flag, program, argv, not_last)
+ int search_flag;
+ char *program;
+ char *argv[];
+ int not_last;
+{
+ return (search_flag ? __spawnv : __spawnvp) (1, program, argv);
+}
+#endif /* _WIN32 */
+
+static int
+doit (char *program, char **argv)
+{
+ int pid;
+ int status;
+ int ret_code = 0;
+
+ pid = pexecute (0, program, argv, 0);
+
+#ifdef __MSDOS__
+ status = pid;
+#else
+#ifdef _WIN32
+ pid = cwait (&status, pid, WAIT_CHILD);
+#else
+ pid = wait (&status);
+#endif
+#endif
+ if (pid < 0)
+ abort ();
+
+ if (status != 0)
+ {
+ if (WIFSIGNALED (status))
+ {
+ fatal ("Internal compiler error: program %s got fatal signal %d",
+ program, WTERMSIG (status));
+ signal_count++;
+ ret_code = -1;
+ }
+ else if (WIFEXITED (status)
+ && WEXITSTATUS (status) >= MIN_FATAL_STATUS)
+ ret_code = -1;
+ }
+
+ return ret_code;
+}
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ register int i = 0;
+ register char *p;
+ int verbose = 0;
+ Option opt;
+ int skip;
+ char *arg;
+ int n_infiles = 0;
+ int n_outfiles = 0;
+
+ /* This will be NULL if we encounter a situation where we should not
+ link in libf2c. */
+ char *library = "-lf2c";
+
+ /* This will become 0 if anything other than -v and kin (like -V)
+ is seen, meaning the user is trying to accomplish something.
+ If it remains nonzero, and the user wants version info, add stuff to
+ the command line to make gcc invoke all the appropriate phases
+ to get all the version info. */
+ int add_version_magic = 1;
+
+ /* The name of the compiler we will want to run---by default, it
+ will be the definition of `GCC_NAME', e.g., `gcc'. */
+ char *gcc = GCC_NAME;
+
+ /* 0 => -xnone in effect on input/output
+ 1 => -xfoo in effect on input/output
+ 2 => -xnone in effect on input, -xf77 on output
+ 3 => -xnone in effect on input, -xf77-cpp-input on output.
+ 4 => -xnone in effect on input, -xratfor on output. */
+ int saw_speclang = 0;
+
+ /* 0 => initial/reset state
+ 1 => last arg was -l<library>
+ 2 => last two args were -l<library> -lm. */
+ int saw_library = 0;
+
+ /* Initialize for append_arg(). */
+ xargc = argc;
+ newargv = xargv = argv;
+ newargc = 0;
+
+ append_arg (argv[0]);
+
+ p = argv[0] + strlen (argv[0]);
+ while (p != argv[0] && p[-1] != '/')
+ --p;
+ programname = p;
+
+ if (argc == 1)
+ fatal ("No input files specified.\n");
+
+#ifndef __MSDOS__
+ /* We do a little magic to find out where the main gcc executable
+ is. If they ran us as /usr/local/bin/g77, then we will look
+ for /usr/local/bin/gcc; similarly, if they just ran us as `g77',
+ we'll just look for `gcc'. */
+ if (p != argv[0])
+ {
+ *--p = '\0';
+ gcc = (char *) malloc ((strlen (argv[0]) + 1 + strlen (GCC_NAME) + 1)
+ * sizeof (char));
+ sprintf (gcc, "%s/%s", argv[0], GCC_NAME);
+ }
+#endif
+
+ /* First pass through arglist.
+
+ If -nostdlib or a "turn-off-linking" option is anywhere in the
+ command line, don't do any library-option processing (except
+ relating to -x). Also, if -v is specified, but no other options
+ that do anything special (allowing -V version, etc.), remember
+ to add special stuff to make gcc command actually invoke all
+ the different phases of the compilation process so all the version
+ numbers can be seen.
+
+ Also, here is where all problems with missing arguments to options
+ are caught. If this loop is exited normally, it means all options
+ have the appropriate number of arguments as far as the rest of this
+ program is concerned. */
+
+ for (i = 1; i < argc; ++i)
+ {
+ if ((argv[i][0] == '+') && (argv[i][1] == 'e'))
+ {
+ add_version_magic = 0;
+ continue;
+ }
+ else if ((argv[i][0] != '-') || (argv[i][1] == 0))
+ {
+ ++n_infiles;
+ add_version_magic = 0;
+ continue;
+ }
+
+ lookup_option (&opt, &skip, NULL, argv[i]);
+
+ switch (opt)
+ {
+ case OPTION_nostdlib:
+ case OPTION_c:
+ case OPTION_S:
+ case OPTION_syntax_only:
+ case OPTION_E:
+ case OPTION_M:
+ case OPTION_MM:
+ /* These options disable linking entirely or linking of the
+ standard libraries. */
+ library = NULL;
+ add_version_magic = 0;
+ break;
+
+ case OPTION_for_linker:
+ case OPTION_l:
+ ++n_infiles;
+ add_version_magic = 0;
+ break;
+
+ case OPTION_o:
+ ++n_outfiles;
+ add_version_magic = 0;
+ break;
+
+ case OPTION_v:
+ if (!verbose)
+ fprintf (stderr, "g77 version %s\n", ffezzz_version_string);
+ verbose = 1;
+ break;
+
+ case OPTION_b:
+ case OPTION_B:
+ case OPTION_L:
+ case OPTION_driver:
+ case OPTION_i:
+ case OPTION_V:
+ /* These options are useful in conjunction with -v to get
+ appropriate version info. */
+ break;
+
+ case OPTION_version:
+ printf ("\
+GNU Fortran %s\n\
+Copyright (C) 1997 Free Software Foundation, Inc.\n\
+For more version information on components of the GNU Fortran\n\
+compilation system, especially useful when reporting bugs,\n\
+type the command `g77 --verbose'.\n\
+\n\
+GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\
+You may redistribute copies of GNU Fortran\n\
+under the terms of the GNU General Public License.\n\
+For more information about these matters, see the file named COPYING\n\
+or type the command `info -f g77 Copying'.\n\
+", ffezzz_version_string);
+ exit (0);
+ break;
+
+ case OPTION_help:
+ printf ("\
+Usage: g77 [OPTION]... FORTRAN-SOURCE...\n\
+\n\
+Compile and link Fortran source code to produce an executable program,\n\
+which by default is named `a.out', and can be invoked with the UNIX\n\
+command `./a.out'.\n\
+\n\
+Options:\n\
+--debug include debugging information in executable.\n\
+--driver=COMMAND specify preprocessor/compiler/linker driver\n\
+ to use instead of the default `gcc'.\n\
+--help display this help and exit.\n\
+--optimize[=LEVEL] take extra time and memory to make generated\n\
+ executable run faster. LEVEL is 0 for no\n\
+ optimization, 1 for normal optimization, and\n\
+ increases through 3 for more optimization.\n\
+--output=PROGRAM name the executable PROGRAM instead of a.out;\n\
+ invoke with the command `./PROGRAM'.\n\
+--version display version information and exit.\n\
+\n\
+Many other options exist to tailor the compilation process, specify\n\
+the dialect of the Fortran source code, specify details of the\n\
+code-generation methodology, and so on.\n\
+\n\
+For more information on g77 and gcc, type the commands `info -f g77'\n\
+and `info -f gcc' to read the Info documentation on these commands.\n\
+\n\
+Report bugs to fortran@gnu.ai.mit.edu.\n");
+ exit (0);
+ break;
+
+ default:
+ add_version_magic = 0;
+ break;
+ }
+
+ /* This is the one place we check for missing arguments in the
+ program. */
+
+ if (i + skip < argc)
+ i += skip;
+ else
+ fatal ("argument to `%s' missing\n", argv[i]);
+ }
+
+ if ((n_outfiles != 0) && (n_infiles == 0))
+ fatal ("No input files; unwilling to write output files");
+
+ /* Second pass through arglist, transforming arguments as appropriate. */
+
+ for (i = 1; i < argc; ++i)
+ {
+ if (argv[i][0] == '\0')
+ append_arg (argv[i]); /* Interesting. Just append as is. */
+
+ else if ((argv[i][0] == '-') && (argv[i][1] != 'l'))
+ {
+ /* Not a filename or library. */
+
+ if (saw_library == 1) /* -l<library>. */
+ append_arg ("-lm");
+ saw_library = 0;
+
+ lookup_option (&opt, &skip, &arg, argv[i]);
+
+ if (argv[i][1] == '\0')
+ append_arg (argv[i]); /* "-" == Standard input. */
+
+ else if (opt == OPTION_x)
+ {
+ /* Track input language. */
+ char *lang;
+
+ if (arg == NULL)
+ lang = argv[i+1];
+ else
+ lang = arg;
+
+ saw_speclang = (strcmp (lang, "none") != 0);
+ }
+ else if (opt == OPTION_driver)
+ {
+ if (arg == NULL)
+ gcc = argv[i+1];
+ else
+ gcc = arg;
+ i += skip;
+ continue; /* Don't append args to new list. */
+ }
+ append_arg (argv[i]);
+ for (; skip != 0; --skip)
+ append_arg (argv[++i]);
+ }
+ else
+ { /* A filename/library, not an option. */
+ int len;
+ int want_speclang;
+
+ /* Here, always append the arg _after_ other stuff, possibly. */
+
+ if (saw_speclang == 1)
+ saw_library = 0; /* -xfoo currently active. */
+ /* Put -xf77 and -xnone around list of filenames ending in
+ .F or .f, but don't include other filenames or libraries
+ in that list. */
+ else if ((argv[i][0] != '-') /* Not a library. */
+ && (len = strlen (argv[i])) > 2
+ && ((argv[i][len - 1] == 'F')
+ || (argv[i][len - 1] == 'f')
+ || (argv[i][len - 1] == 'r'))
+ && argv[i][len - 2] == '.')
+ { /* filename.f or filename.F. or filename.r */
+ if (saw_library == 1) /* -l<library>. */
+ append_arg ("-lm");
+ saw_library = 0;
+ switch (argv[i][len - 1])
+ {
+ case 'f':
+ want_speclang = 2;
+ break;
+ case 'F':
+ want_speclang = 3;
+ break;
+ case 'r':
+ want_speclang = 4;
+ break;
+ default:
+ break;
+ }
+ if (saw_speclang != want_speclang)
+ {
+ switch (want_speclang)
+ {
+ case 2:
+ append_arg ("-xf77");
+ break;
+ case 3:
+ append_arg ("-xf77-cpp-input");
+ break;
+ case 4:
+ append_arg ("-xratfor");
+ break;
+ default:
+ break;
+ }
+ saw_speclang = want_speclang;
+ }
+ }
+ else
+ { /* -lfoo or "alien" filename. */
+ if (saw_speclang)
+ append_arg ("-xnone");
+ saw_speclang = 0;
+
+ if (strcmp (argv[i], "-lm") == 0
+ || strcmp (argv[i], "-lmath") == 0)
+ {
+ if (saw_library == 1)
+ saw_library = 2; /* -l<library> -lm. */
+ else if (library)
+ {
+ append_arg (library);
+ saw_library = 2; /* -l<library> -lm. */
+ }
+ }
+ else if ((library != NULL)
+ && (strcmp (argv[i], library) == 0))
+ saw_library = 1; /* -l<library>. */
+ else
+ { /* "Alien" library or filename. */
+ if (saw_library == 1)
+ append_arg ("-lm");
+ saw_library = 0;
+ }
+ }
+ append_arg (argv[i]);
+ }
+ }
+
+ /* Add -lf2c -lm as necessary. */
+
+ if (!add_version_magic && library)
+ { /* Doing a link and no -nostdlib. */
+ if (saw_speclang)
+ append_arg ("-xnone");
+ switch (saw_library)
+ {
+ case 0:
+ append_arg (library);
+ case 1:
+ append_arg ("-lm");
+ default:
+ break;
+ }
+ }
+ else if (add_version_magic && verbose)
+ {
+ FILE *fsrc;
+
+ choose_temp_base ();
+
+ append_arg ("-fnull-version");
+ append_arg ("-o");
+ append_arg (temp_filename);
+ append_arg ("-xf77-cpp-input");
+ append_arg (temp_filename_f);
+ append_arg ("-xnone");
+ if (library)
+ {
+ append_arg (library);
+ append_arg ("-lm");
+ }
+
+ fsrc = fopen (temp_filename_f, "w");
+ if (fsrc == 0)
+ pfatal_with_name (fsrc);
+ fputs (" call g77__fvers;call g77__ivers;call g77__uvers;end\n", fsrc);
+ fclose (fsrc);
+ }
+
+ append_arg (NULL);
+ --newargc; /* Don't count null arg at end. */
+
+ newargv[0] = gcc; /* This is safe even if newargv == xargv. */
+
+ if (verbose)
+ {
+#if 0
+ if (newargv == xargv)
+ fprintf (stderr, "[Original:]");
+#endif
+
+ for (i = 0; i < newargc; i++)
+ fprintf (stderr, " %s", newargv[i]);
+ fprintf (stderr, "\n");
+ }
+
+ if (doit (gcc, newargv) < 0)
+ ++error_count;
+ else if (add_version_magic && verbose)
+ {
+ char *outargv[2];
+
+ outargv[0] = temp_filename;
+ outargv[1] = 0;
+
+ if (doit (temp_filename, outargv) < 0)
+ ++error_count;
+
+ remove (temp_filename);
+ remove (temp_filename_f);
+ }
+
+ exit (error_count > 0 ? (signal_count ? 2 : 1) : 0);
+ /* NOTREACHED */
+ return 0;
+}
+
+#endif /* LANGUAGE_F77 == 1 */
diff --git a/gcc/f/g77.texi b/gcc/f/g77.texi
new file mode 100644
index 00000000000..134deb56ceb
--- /dev/null
+++ b/gcc/f/g77.texi
@@ -0,0 +1,13831 @@
+\input texinfo @c -*-texinfo-*-
+@c fix @set inside @example:
+@tex
+\gdef\set{\begingroup\catcode` =10 \parsearg\setxxx}
+\gdef\setyyy#1 #2\endsetyyy{%
+ \def\temp{#2}%
+ \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty
+ \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted.
+ \fi
+ \endgroup
+}
+@end tex
+
+@c %**start of header
+@setfilename g77.info
+@c @setfilename useg77.info
+@c @setfilename portg77.info
+@c To produce the full manual, use the "g77.info" setfilename, and
+@c make sure the following do NOT begin with '@c' (and the @clear lines DO)
+@set INTERNALS
+@set USING
+@c To produce a user-only manual, use the "useg77.info" setfilename, and
+@c make sure the following does NOT begin with '@c':
+@c @clear INTERNALS
+@c To produce a porter-only manual, use the "portg77.info" setfilename,
+@c and make sure the following does NOT begin with '@c':
+@c @clear USING
+
+@c (For FSF printing, turn on smallbook; that is all that is needed.)
+
+@c smallbook
+
+@ifset INTERNALS
+@ifset USING
+@settitle Using and Porting GNU Fortran
+@end ifset
+@end ifset
+@c seems reasonable to assume at least one of INTERNALS or USING is set...
+@ifclear INTERNALS
+@settitle Using GNU Fortran
+@end ifclear
+@ifclear USING
+@settitle Porting GNU Fortran
+@end ifclear
+@c then again, have some fun
+@ifclear INTERNALS
+@ifclear USING
+@settitle Doing Squat with GNU Fortran
+@end ifclear
+@end ifclear
+
+@syncodeindex fn cp
+@syncodeindex vr cp
+@c %**end of header
+@setchapternewpage odd
+
+@ifinfo
+This file explains how to use the GNU Fortran system.
+
+Published by the Free Software Foundation
+59 Temple Place - Suite 330
+Boston, MA 02111-1307 USA
+
+Copyright (C) 1995-1997 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through Tex and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+sections entitled ``GNU General Public License,'' ``Funding for Free
+Software,'' and ``Protect Your Freedom---Fight `Look And Feel'@w{}'' are
+included exactly as in the original, and provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that the sections entitled ``GNU General Public License,''
+``Funding for Free Software,'' and ``Protect Your Freedom---Fight `Look
+And Feel'@w{}'', and this permission notice, may be included in
+translations approved by the Free Software Foundation instead of in the
+original English.
+@end ifinfo
+
+Contributed by James Craig Burley (@email{burley@@gnu.ai.mit.edu}).
+Inspired by a first pass at translating @file{g77-0.5.16/f/DOC} that
+was contributed to Craig by David Ronis (@email{ronis@@onsager.chem.mcgill.ca}).
+
+@finalout
+@titlepage
+@comment The title is printed in a large font.
+@center @titlefont{Using GNU Fortran}
+@sp 2
+@center James Craig Burley
+@sp 3
+@center Last updated 1997-08-11
+@sp 1
+@c The version number appears some more times in this file.
+
+@center for version 0.5.21
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1995-1997 Free Software Foundation, Inc.
+@sp 2
+For GNU Fortran Version 0.5.21*
+@sp 1
+Published by the Free Software Foundation @*
+59 Temple Place - Suite 330@*
+Boston, MA 02111-1307, USA@*
+@c Last printed ??ber, 19??.@*
+@c Printed copies are available for $? each.@*
+@c ISBN ???
+@sp 1
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+sections entitled ``GNU General Public License,'' ``Funding for Free
+Software,'' and ``Protect Your Freedom---Fight `Look And Feel'@w{}'' are
+included exactly as in the original, and provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that the sections entitled ``GNU General Public License,''
+``Funding for Free Software,'' and ``Protect Your Freedom---Fight `Look
+And Feel'@w{}'', and this permission notice, may be included in
+translations approved by the Free Software Foundation instead of in the
+original English.
+@end titlepage
+@page
+
+@ifinfo
+
+@dircategory Fortran Programming
+@direntry
+* g77: (g77). The GNU Fortran compilation system.
+@end direntry
+@node Top, Copying,, (DIR)
+@top Introduction
+@cindex Introduction
+
+@ifset INTERNALS
+@ifset USING
+This manual documents how to run, install and port the GNU Fortran
+compiler, as well as its new features and incompatibilities, and how to
+report bugs. It corresponds to GNU Fortran version 0.5.21.
+@end ifset
+@end ifset
+
+@ifclear INTERNALS
+This manual documents how to run and install the GNU Fortran compiler,
+as well as its new features and incompatibilities, and how to report
+bugs. It corresponds to GNU Fortran version 0.5.21.
+@end ifclear
+@ifclear USING
+This manual documents how to port the GNU Fortran compiler,
+as well as its new features and incompatibilities, and how to report
+bugs. It corresponds to GNU Fortran version 0.5.21.
+@end ifclear
+
+@end ifinfo
+@menu
+* Copying:: GNU General Public License says
+ how you can copy and share GNU Fortran.
+* Contributors:: People who have contributed to GNU Fortran.
+* Funding:: How to help assure continued work for free software.
+* Funding GNU Fortran:: How to help assure continued work on GNU Fortran.
+* Look and Feel:: Protect your freedom---fight ``look and feel''.
+@ifset USING
+* Getting Started:: Finding your way around this manual.
+* What is GNU Fortran?:: How @code{g77} fits into the universe.
+* G77 and GCC:: You can compile Fortran, C, or other programs.
+* Invoking G77:: Command options supported by @code{g77}.
+* News:: News about recent releases of @code{g77}.
+* Changes:: User-visible changes to recent releases of @code{g77}.
+* Language:: The GNU Fortran language.
+* Compiler:: The GNU Fortran compiler.
+* Other Dialects:: Dialects of Fortran supported by @code{g77}.
+* Other Compilers:: Fortran compilers other than @code{g77}.
+* Other Languages:: Languages other than Fortran.
+* Installation:: How to configure, compile and install GNU Fortran.
+* Debugging and Interfacing:: How @code{g77} generates code.
+* Collected Fortran Wisdom:: How to avoid Trouble.
+* Trouble:: If you have trouble with GNU Fortran.
+* Open Questions:: Things we'd like to know.
+* Bugs:: How, why, and where to report bugs.
+* Service:: How to find suppliers of support for GNU Fortran.
+@end ifset
+@ifset INTERNALS
+* Adding Options:: Guidance on teaching @code{g77} about new options.
+* Projects:: Projects for @code{g77} internals hackers.
+@end ifset
+
+* M: Diagnostics. Diagnostics produced by @code{g77}.
+
+* Index:: Index of concepts and symbol names.
+@end menu
+@c yes, the "M: " @emph{is} intentional -- bad.def references it (CMPAMBIG)!
+
+@node Copying
+@unnumbered GNU GENERAL PUBLIC LICENSE
+@center Version 2, June 1991
+
+@display
+Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc.
+59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+@end display
+
+@unnumberedsec Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software---to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, 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 software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, 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 redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+@iftex
+@unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+@end iftex
+@ifinfo
+@center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+@end ifinfo
+
+@enumerate 0
+@item
+This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The ``Program'', below,
+refers to any such program or work, and a ``work based on the Program''
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term ``modification''.) Each licensee is addressed as ``you''.
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+@item
+You may copy and distribute verbatim copies of the Program's
+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 give any other recipients of the Program a copy of this License
+along with the Program.
+
+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.
+
+@item
+You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+@enumerate a
+@item
+You must cause the modified files to carry prominent notices
+stating that you changed the files and the date of any change.
+
+@item
+You must cause any work that you distribute or publish, that in
+whole or in part contains or is derived from the Program or any
+part thereof, to be licensed as a whole at no charge to all third
+parties under the terms of this License.
+
+@item
+If the modified program normally reads commands interactively
+when run, you must cause it, when started running for such
+interactive use in the most ordinary way, to print or display an
+announcement including an appropriate copyright notice and a
+notice that there is no warranty (or else, saying that you provide
+a warranty) and that users may redistribute the program under
+these conditions, and telling the user how to view a copy of this
+License. (Exception: if the Program itself is interactive but
+does not normally print such an announcement, your work based on
+the Program is not required to print an announcement.)
+@end enumerate
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+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 Program, 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 Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+@item
+You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+@enumerate a
+@item
+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; or,
+
+@item
+Accompany it with a written offer, valid for at least three
+years, to give any third party, for a charge no more than your
+cost of physically performing source distribution, a complete
+machine-readable copy of the corresponding source code, to be
+distributed under the terms of Sections 1 and 2 above on a medium
+customarily used for software interchange; or,
+
+@item
+Accompany it with the information you received as to the offer
+to distribute corresponding source code. (This alternative is
+allowed only for noncommercial distribution and only if you
+received the program in object code or executable form with such
+an offer, in accord with Subsection b above.)
+@end enumerate
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, 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 executable. 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.
+
+If distribution of executable or 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 counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+@item
+You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program 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.
+
+@item
+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 Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+@item
+Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program 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.
+
+@item
+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 Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program 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 Program.
+
+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.
+
+@item
+If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program 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.
+
+@item
+The Free Software Foundation may publish revised and/or new versions
+of the 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 Program
+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 Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+@item
+If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, 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.
+
+@iftex
+@heading NO WARRANTY
+@end iftex
+@ifinfo
+@center NO WARRANTY
+@end ifinfo
+
+@item
+BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM ``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 PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+@item
+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 PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+@end enumerate
+
+@iftex
+@heading END OF TERMS AND CONDITIONS
+@end iftex
+@ifinfo
+@center END OF TERMS AND CONDITIONS
+@end ifinfo
+
+@page
+@unnumberedsec How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. 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.
+
+@smallexample
+@var{one line to give the program's name and a brief idea of what it does.}
+Copyright (C) 19@var{yy} @var{name of author}
+
+This program 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 of the License, or
+(at your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+@end smallexample
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+@smallexample
+Gnomovision version 69, Copyright (C) 19@var{yy} @var{name of author}
+Gnomovision comes with ABSOLUTELY NO WARRANTY; for details
+type `show w'.
+This is free software, and you are welcome to redistribute it
+under certain conditions; type `show c' for details.
+@end smallexample
+
+The hypothetical commands @samp{show w} and @samp{show c} should show
+the appropriate parts of the General Public License. Of course, the
+commands you use may be called something other than @samp{show w} and
+@samp{show c}; they could even be mouse-clicks or menu items---whatever
+suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a ``copyright disclaimer'' for the program, if
+necessary. Here is a sample; alter the names:
+
+@smallexample
+Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+`Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+@var{signature of Ty Coon}, 1 April 1989
+Ty Coon, President of Vice
+@end smallexample
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
+
+@node Contributors
+@unnumbered Contributors to GNU Fortran
+@cindex contributors
+@cindex credits
+
+In addition to James Craig Burley, who wrote the front end,
+many people have helped create and improve GNU Fortran.
+
+@itemize @bullet
+@item
+The packaging and compiler portions of GNU Fortran are based largely
+on the GNU CC compiler.
+@xref{Contributors,,Contributors to GNU CC,gcc,Using and Porting GNU CC},
+for more information.
+
+@item
+The run-time library used by GNU Fortran is a repackaged version
+of the @code{libf2c} library (combined from the @code{libF77} and
+@code{libI77} libraries) provided as part of @code{f2c}, available for
+free from @code{netlib} sites on the Internet.
+
+@item
+Cygnus Support and The Free Software Foundation contributed
+significant money and/or equipment to Craig's efforts.
+
+@item
+The following individuals served as alpha testers prior to @code{g77}'s
+public release. This work consisted of testing, researching, sometimes
+debugging, and occasionally providing small amounts of code and fixes
+for @code{g77}, plus offering plenty of helpful advice to Craig:
+
+@itemize @w{}
+@item
+Jonathan Corbet
+@item
+Dr.@: Mark Fernyhough
+@item
+Takafumi Hayashi (The University of AIzu)---@email{takafumi@@u-aizu.ac.jp}
+@item
+Kate Hedstrom
+@item
+Michel Kern (INRIA and Rice University)---@email{Michel.Kern@@inria.fr}
+@item
+Dr.@: A. O. V. Le Blanc
+@item
+Dave Love
+@item
+Rick Lutowski
+@item
+Toon Moene
+@item
+Rick Niles
+@item
+Derk Reefman
+@item
+Wayne K. Schroll
+@item
+Bill Thorson
+@item
+Pedro A. M. Vazquez
+@item
+Ian Watson
+@end itemize
+
+@item
+Scott Snyder (@email{snyder@@d0sgif.fnal.gov})
+provided the patch to add rudimentary support
+for @code{INTEGER*1}, @code{INTEGER*2}, and
+@code{LOGICAL*1}.
+This inspired Craig to add further support,
+even though the resulting support
+would still be incomplete, because version 0.6 is still
+a ways off.
+
+@item
+David Ronis (@email{ronis@@onsager.chem.mcgill.ca}) inspired
+and encouraged Craig to rewrite the documentation in texinfo
+format by contributing a first pass at a translation of the
+old @file{g77-0.5.16/f/DOC} file.
+
+@item
+Toon Moene (@email{toon@@moene.indiv.nluug.nl}) performed
+some analysis of generated code as part of an overall project
+to improve @code{g77} code generation to at least be as good
+as @code{f2c} used in conjunction with @code{gcc}.
+So far, this has resulted in the three, somewhat
+experimental, options added by @code{g77} to the @code{gcc}
+compiler and its back end.
+
+@item
+John Carr (@email{jfc@@mit.edu}) wrote the alias analysis improvements.
+
+@item
+Thanks to Mary Cortani and the staff at Craftwork Solutions
+(@email{support@@craftwork.com}) for all of their support.
+
+@item
+Many other individuals have helped debug, test, and improve @code{g77}
+over the past several years, and undoubtedly more people
+will be doing so in the future.
+If you have done so, and would like
+to see your name listed in the above list, please ask!
+The default is that people wish to remain anonymous.
+@end itemize
+
+@node Funding
+@chapter Funding Free Software
+
+If you want to have more free software a few years from now, it makes
+sense for you to help encourage people to contribute funds for its
+development. The most effective approach known is to encourage
+commercial redistributors to donate.
+
+Users of free software systems can boost the pace of development by
+encouraging for-a-fee distributors to donate part of their selling price
+to free software developers---the Free Software Foundation, and others.
+
+The way to convince distributors to do this is to demand it and expect
+it from them. So when you compare distributors, judge them partly by
+how much they give to free software development. Show distributors
+they must compete to be the one who gives the most.
+
+To make this approach work, you must insist on numbers that you can
+compare, such as, ``We will donate ten dollars to the Frobnitz project
+for each disk sold.'' Don't be satisfied with a vague promise, such as
+``A portion of the profits are donated,'' since it doesn't give a basis
+for comparison.
+
+Even a precise fraction ``of the profits from this disk'' is not very
+meaningful, since creative accounting and unrelated business decisions
+can greatly alter what fraction of the sales price counts as profit.
+If the price you pay is $50, ten percent of the profit is probably
+less than a dollar; it might be a few cents, or nothing at all.
+
+Some redistributors do development work themselves. This is useful too;
+but to keep everyone honest, you need to inquire how much they do, and
+what kind. Some kinds of development make much more long-term
+difference than others. For example, maintaining a separate version of
+a program contributes very little; maintaining the standard version of a
+program for the whole community contributes much. Easy new ports
+contribute little, since someone else would surely do them; difficult
+ports such as adding a new CPU to the GNU C compiler contribute more;
+major new features or packages contribute the most.
+
+By establishing the idea that supporting further development is ``the
+proper thing to do'' when distributing free software for a fee, we can
+assure a steady flow of resources into making more free software.
+
+@display
+Copyright (C) 1994 Free Software Foundation, Inc.
+Verbatim copying and redistribution of this section is permitted
+without royalty; alteration is not permitted.
+@end display
+
+@node Funding GNU Fortran
+@chapter Funding GNU Fortran
+@cindex funding improvements
+@cindex improvements, funding
+
+Work on GNU Fortran is still being done mostly by its author,
+James Craig Burley (@email{burley@@gnu.ai.mit.edu}), who is a volunteer
+for, not an employee of, the Free Software Foundation (FSF).
+As with other GNU software, funding is important because it can pay for
+needed equipment, personnel, and so on.
+
+@cindex FSF, funding the
+@cindex funding the FSF
+The FSF provides information on the best way to fund ongoing
+development of GNU software (such as GNU Fortran) in documents
+such as the ``GNUS Bulletin''.
+Email @email{gnu@@prep.ai.mit.edu} for information on funding the FSF.
+
+To fund specific GNU Fortran work in particular, the FSF might
+provide a means for that, but the FSF does not provide direct funding
+to the author of GNU Fortran to continue his work. The FSF has
+employee salary restrictions that can be incompatible with the
+financial needs of some volunteers, who therefore choose to
+remain volunteers and thus be able to be free to do contract work
+and otherwise make their own schedules for doing GNU work.
+
+Still, funding the FSF at least indirectly benefits work
+on specific projects like GNU Fortran because it ensures the
+continuing operation of the FSF offices, their workstations, their
+network connections, and so on, which are invaluable to volunteers.
+(Similarly, hiring Cygnus Support can help a project like GNU
+Fortran---Cygnus has been a long-time donor of equipment usage to the author
+of GNU Fortran, and this too has been invaluable---@xref{Contributors}.)
+
+Currently, the only way to directly fund the author of GNU Fortran
+in his work on that project is to hire him for the work you want
+him to do, or donate money to him.
+Several people have done this
+already, with the result that he has not needed to immediately find
+contract work on a few occasions.
+If more people did this, he
+would be able to plan on not doing contract work for many months and
+could thus devote that time to work on projects (such as the planned
+changes for 0.6) that require longer timeframes to complete.
+For the latest information on the status of the author, do
+@kbd{finger -l burley@@gate.gnu.ai.mit.edu} on a UNIX system
+(or any system with a command like UNIX @code{finger}).
+
+Another important way to support work on GNU Fortran is to volunteer
+to help out.
+Work is needed on documentation, testing, porting
+to various machines, and in some cases, coding (although major
+changes planned for version 0.6 make it difficult to add manpower to this
+area).
+Email @email{fortran@@gnu.ai.mit.edu} to volunteer for this work.
+
+@xref{Funding,,Funding Free Software}, for more information.
+
+@node Look and Feel
+@chapter Protect Your Freedom---Fight ``Look And Feel''
+@c the above chapter heading overflows onto the next line. --mew 1/26/93
+
+To preserve the ability to write free software, including replacements
+for proprietary software, authors must be free to replicate the
+user interface to which users of existing software have become
+accustomed.
+
+@xref{Look and Feel,,Protect Your Freedom---Fight ``Look And Feel'',
+gcc,Using and Porting GNU CC}, for more information.
+
+@node Getting Started
+@chapter Getting Started
+@cindex getting started
+@cindex new users
+@cindex newbies
+@cindex beginners
+
+If you don't need help getting started reading the portions
+of this manual that are most important to you, you should skip
+this portion of the manual.
+
+If you are new to compilers, especially Fortran compilers, or
+new to how compilers are structured under UNIX and UNIX-like
+systems, you'll want to see @ref{What is GNU Fortran?}.
+
+If you are new to GNU compilers, or have used only one GNU
+compiler in the past and not had to delve into how it lets
+you manage various versions and configurations of @code{gcc},
+you should see @ref{G77 and GCC}.
+
+Everyone except experienced @code{g77} users should
+see @ref{Invoking G77}.
+
+If you're acquainted with previous versions of @code{g77},
+you should see @ref{News}.
+Further, if you've actually used previous versions of @code{g77},
+especially if you've written or modified Fortran code to
+be compiled by previous versions of @code{g77}, you
+should see @ref{Changes}.
+
+If you intend to write or otherwise compile code that is
+not already strictly conforming ANSI FORTRAN 77---and this
+is probably everyone---you should see @ref{Language}.
+
+If you don't already have @code{g77} installed on your
+system, you must see @ref{Installation}.
+
+If you run into trouble getting Fortran code to compile,
+link, run, or work properly, you might find answers
+if you see @ref{Debugging and Interfacing},
+see @ref{Collected Fortran Wisdom},
+and see @ref{Trouble}.
+You might also find that the problems you are encountering
+are bugs in @code{g77}---see @ref{Bugs}, for information on
+reporting them, after reading the other material.
+
+If you need further help with @code{g77}, or with
+freely redistributable software in general,
+see @ref{Service}.
+
+If you would like to help the @code{g77} project,
+see @ref{Funding GNU Fortran}, for information on
+helping financially, and see @ref{Projects}, for information
+on helping in other ways.
+
+If you're generally curious about the future of
+@code{g77}, see @ref{Projects}.
+If you're curious about its past,
+see @ref{Contributors},
+and see @ref{Funding GNU Fortran}.
+
+To see a few of the questions maintainers of @code{g77} have,
+and that you might be able to answer,
+see @ref{Open Questions}.
+
+@ifset USING
+@node What is GNU Fortran?
+@chapter What is GNU Fortran?
+@cindex concepts, basic
+@cindex basic concepts
+
+GNU Fortran, or @code{g77}, is designed initially as a free replacement
+for, or alternative to, the UNIX @code{f77} command.
+(Similarly, @code{gcc} is designed as a replacement
+for the UNIX @code{cc} command.)
+
+@code{g77} also is designed to fit in well with the other
+fine GNU compilers and tools.
+
+Sometimes these design goals conflict---in such cases, resolution
+often is made in favor of fitting in well with Project GNU.
+These cases are usually identified in the appropriate
+sections of this manual.
+
+@cindex compilers
+As compilers, @code{g77}, @code{gcc}, and @code{f77}
+share the following characteristics:
+
+@itemize @bullet
+@cindex source code
+@cindex file, source
+@cindex code, source
+@cindex source file
+@item
+They read a user's program, stored in a file and
+containing instructions written in the appropriate
+language (Fortran, C, and so on).
+This file contains @dfn{source code}.
+
+@cindex translation of user programs
+@cindex machine code
+@cindex code, machine
+@cindex mistakes
+@item
+They translate the user's program into instructions
+a computer can carry out more quickly than it takes
+to translate the instructions in the first place.
+These instructions are called @dfn{machine code}---code
+designed to be efficiently translated and processed
+by a machine such as a computer.
+Humans usually aren't as good writing machine code
+as they are at writing Fortran or C, because
+it is easy to make tiny mistakes writing machine code.
+When writing Fortran or C, it is easy
+to make big mistakes.
+
+@cindex debugger
+@cindex bugs, finding
+@cindex gdb command
+@cindex commands, gdb
+@item
+They provide information in the generated machine code
+that can make it easier to find bugs in the program
+(using a debugging tool, called a @dfn{debugger},
+such as @code{gdb}).
+
+@cindex libraries
+@cindex linking
+@cindex ld command
+@cindex commands, ld
+@item
+They locate and gather machine code already generated
+to perform actions requested by statements in
+the user's program.
+This machine code is organized
+into @dfn{libraries} and is located and gathered
+during the @dfn{link} phase of the compilation
+process.
+(Linking often is thought of as a separate
+step, because it can be directly invoked via the
+@code{ld} command.
+However, the @code{g77} and @code{gcc}
+commands, as with most compiler commands, automatically
+perform the linking step by calling on @code{ld}
+directly, unless asked to not do so by the user.)
+
+@cindex language, incorrect use of
+@cindex incorrect use of language
+@item
+They attempt to diagnose cases where the user's
+program contains incorrect usages of the language.
+The @dfn{diagnostics} produced by the compiler
+indicate the problem and the location in the user's
+source file where the problem was first noticed.
+The user can use this information to locate and
+fix the problem.
+@cindex diagnostics, incorrect
+@cindex incorrect diagnostics
+@cindex error messages, incorrect
+@cindex incorrect error messages
+(Sometimes an incorrect usage
+of the language leads to a situation where the
+compiler can no longer make any sense of what
+follows---while a human might be able to---and
+thus ends up complaining about many ``problems''
+it encounters that, in fact, stem from just one
+problem, usually the first one reported.)
+
+@cindex warnings
+@cindex questionable instructions
+@item
+They attempt to diagnose cases where the user's
+program contains a correct usage of the language,
+but instructs the computer to do something questionable.
+These diagnostics often are in the form of @dfn{warnings},
+instead of the @dfn{errors} that indicate incorrect
+usage of the language.
+@end itemize
+
+How these actions are performed is generally under the
+control of the user.
+Using command-line options, the user can specify
+how persnickety the compiler is to be regarding
+the program (whether to diagnose questionable usage
+of the language), how much time to spend making
+the generated machine code run faster, and so on.
+
+@cindex components of g77
+@cindex g77, components of
+@code{g77} consists of several components:
+
+@cindex gcc command
+@cindex commands, gcc
+@itemize @bullet
+@item
+A modified version of the @code{gcc} command, which also might be
+installed as the system's @code{cc} command.
+(In many cases, @code{cc} refers to the
+system's ``native'' C compiler, which
+might be a non-GNU compiler, or an older version
+of @code{gcc} considered more stable or that is
+used to build the operating system kernel.)
+
+@cindex g77 command
+@cindex commands, g77
+@item
+The @code{g77} command itself, which also might be installed as the
+system's @code{f77} command.
+
+@cindex libf2c library
+@cindex libraries, libf2c
+@cindex run-time library
+@item
+The @code{libf2c} run-time library.
+This library contains the machine code needed to support
+capabilities of the Fortran language that are not directly
+provided by the machine code generated by the @code{g77}
+compilation phase.
+
+@cindex f771 program
+@cindex programs, f771
+@cindex assembler
+@cindex as command
+@cindex commands, as
+@cindex assembly code
+@cindex code, assembly
+@item
+The compiler itself, internally named @code{f771}.
+
+Note that @code{f771} does not generate machine code directly---it
+generates @dfn{assembly code} that is a more readable form
+of machine code, leaving the conversion to actual machine code
+to an @dfn{assembler}, usually named @code{as}.
+@end itemize
+
+@code{gcc} is often thought of as ``the C compiler'' only,
+but it does more than that.
+Based on command-line options and the names given for files
+on the command line, @code{gcc} determines which actions to perform, including
+preprocessing, compiling (in a variety of possible languages), assembling,
+and linking.
+
+@cindex driver, gcc command as
+@cindex gcc command as driver
+@cindex executable file
+@cindex files, executable
+@cindex cc1 program
+@cindex programs, cc1
+@cindex preprocessor
+@cindex cpp program
+@cindex programs, cpp
+For example, the command @samp{gcc foo.c} @dfn{drives} the file
+@file{foo.c} through the preprocessor @code{cpp}, then
+the C compiler (internally named
+@code{cc1}), then the assembler (usually @code{as}), then the linker
+(@code{ld}), producing an executable program named @file{a.out} (on
+UNIX systems).
+
+@cindex cc1plus program
+@cindex programs, cc1plus
+As another example, the command @samp{gcc foo.cc} would do much the same as
+@samp{gcc foo.c}, but instead of using the C compiler named @code{cc1},
+@code{gcc} would use the C++ compiler (named @code{cc1plus}).
+
+@cindex f771 program
+@cindex programs, f771
+In a GNU Fortran installation, @code{gcc} recognizes Fortran source
+files by name just like it does C and C++ source files.
+It knows to use the Fortran compiler named @code{f771}, instead of
+@code{cc1} or @code{cc1plus}, to compile Fortran files.
+
+@cindex gcc not recognizing Fortran source
+@cindex unrecognized file format
+@cindex file format not recognized
+Non-Fortran-related operation of @code{gcc} is generally
+unaffected by installing the GNU Fortran version of @code{gcc}.
+However, without the installed version of @code{gcc} being the
+GNU Fortran version, @code{gcc} will not be able to compile
+and link Fortran programs---and since @code{g77} uses @code{gcc}
+to do most of the actual work, neither will @code{g77}!
+
+@cindex g77 command
+@cindex commands, g77
+The @code{g77} command is essentially just a front-end for
+the @code{gcc} command.
+Fortran users will normally use @code{g77} instead of @code{gcc},
+because @code{g77}
+knows how to specify the libraries needed to link with Fortran programs
+(@code{libf2c} and @code{lm}).
+@code{g77} can still compile and link programs and
+source files written in other languages, just like @code{gcc}.
+
+@cindex printing version information
+@cindex version information, printing
+The command @samp{g77 -v} is a quick
+way to display lots of version information for the various programs
+used to compile a typical preprocessed Fortran source file---this
+produces much more output than @samp{gcc -v} currently does.
+(If it produces an error message near the end of the output---diagnostics
+from the linker, usually @code{ld}---you might
+have an out-of-date @code{libf2c} that improperly handles
+complex arithmetic.)@
+In the output of this command, the line beginning @samp{GNU Fortran Front
+End} identifies the version number of GNU Fortran; immediately
+preceding that line is a line identifying the version of @code{gcc}
+with which that version of @code{g77} was built.
+
+@cindex libf2c library
+@cindex libraries, libf2c
+The @code{libf2c} library is distributed with GNU Fortran for
+the convenience of its users, but is not part of GNU Fortran.
+It contains the procedures
+needed by Fortran programs while they are running.
+
+@cindex in-line code
+@cindex code, in-line
+For example, while code generated by @code{g77} is likely
+to do additions, subtractions, and multiplications @dfn{in line}---in
+the actual compiled code---it is not likely to do trigonometric
+functions this way.
+
+Instead, operations like trigonometric
+functions are compiled by the @code{f771} compiler
+(invoked by @code{g77} when compiling Fortran code) into machine
+code that, when run, calls on functions in @code{libf2c}, so
+@code{libf2c} must be linked with almost every useful program
+having any component compiled by GNU Fortran.
+(As mentioned above, the @code{g77} command takes
+care of all this for you.)
+
+The @code{f771} program represents most of what is unique to GNU Fortran.
+While much of the @code{libf2c} component is really part of @code{f2c},
+a free Fortran-to-C converter distributed by Bellcore (AT&T),
+plus @code{libU77}, provided by Dave Love,
+and the @code{g77} command is just a small front-end to @code{gcc},
+@code{f771} is a combination of two rather
+large chunks of code.
+
+@cindex GNU Back End (GBE)
+@cindex GBE
+@cindex gcc back end
+@cindex back end, gcc
+@cindex code generator
+One chunk is the so-called @dfn{GNU Back End}, or GBE,
+which knows how to generate fast code for a wide variety of processors.
+The same GBE is used by the C, C++, and Fortran compiler programs @code{cc1},
+@code{cc1plus}, and @code{f771}, plus others.
+Often the GBE is referred to as the ``gcc back end'' or
+even just ``gcc''---in this manual, the term GBE is used
+whenever the distinction is important.
+
+@cindex GNU Fortran Front End (FFE)
+@cindex FFE
+@cindex g77 front end
+@cindex front end, g77
+The other chunk of @code{f771} is the
+majority of what is unique about GNU Fortran---the code that knows how
+to interpret Fortran programs to determine what they are intending to
+do, and then communicate that knowledge to the GBE for actual compilation
+of those programs.
+This chunk is called the @dfn{Fortran Front End} (FFE).
+The @code{cc1} and @code{cc1plus} programs have their own front ends,
+for the C and C++ languages, respectively.
+These fronts ends are responsible for diagnosing
+incorrect usage of their respective languages by the
+programs the process, and are responsible for most of
+the warnings about questionable constructs as well.
+(The GBE handles producing some warnings, like those
+concerning possible references to undefined variables.)
+
+Because so much is shared among the compilers for various languages,
+much of the behavior and many of the user-selectable options for these
+compilers are similar.
+For example, diagnostics (error messages and
+warnings) are similar in appearance; command-line
+options like @samp{-Wall} have generally similar effects; and the quality
+of generated code (in terms of speed and size) is roughly similar
+(since that work is done by the shared GBE).
+
+@node G77 and GCC
+@chapter Compile Fortran, C, or Other Programs
+@cindex compiling programs
+@cindex programs, compiling
+
+@cindex gcc command
+@cindex commands, gcc
+A GNU Fortran installation includes a modified version of the @code{gcc}
+command.
+
+In a non-Fortran installation, @code{gcc} recognizes C, C++,
+and Objective-C source files.
+
+In a GNU Fortran installation, @code{gcc} also recognizes Fortran source
+files and accepts Fortran-specific command-line options, plus some
+command-line options that are designed to cater to Fortran users
+but apply to other languages as well.
+
+@xref{G++ and GCC,,Compile C; C++; or Objective-C,gcc,Using and Porting GNU CC},
+for information on the way different languages are handled
+by the GNU CC compiler (@code{gcc}).
+
+@cindex g77 command
+@cindex commands, g77
+Also provided as part of GNU Fortran is the @code{g77} command.
+The @code{g77} command is designed to make compiling and linking Fortran
+programs somewhat easier than when using the @code{gcc} command for
+these tasks.
+It does this by analyzing the command line somewhat and changing it
+appropriately before submitting it to the @code{gcc} command.
+
+@cindex -v option
+@cindex g77 options, -v
+@cindex options, -v
+@cindex -@w{}-driver option
+@cindex g77 options, -@w{}-driver
+@cindex options, -@w{}-driver
+Use the @samp{-v} option with @code{g77}
+to see what is going on---the first line of output is the invocation
+of the @code{gcc} command.
+Use @samp{--driver=true} to disable actual invocation
+of @code{gcc} (this works because @samp{true} is the name of a
+UNIX command that simply returns success status).
+
+@node Invoking G77
+@chapter GNU Fortran Command Options
+@cindex GNU Fortran command options
+@cindex command options
+@cindex options, GNU Fortran command
+
+The @code{g77} command supports all the options supported by the
+@code{gcc} command.
+@xref{Invoking GCC,,GNU CC Command Options,gcc,Using and Porting GNU CC},
+for information
+on the non-Fortran-specific aspects of the @code{gcc} command (and,
+therefore, the @code{g77} command).
+
+The @code{g77} command supports one option not supported by
+the @code{gcc} command:
+
+@table @code
+@cindex -@w{}-driver option
+@cindex g77 options, -@w{}-driver
+@cindex options, -@w{}-driver
+@item --driver=@var{command}
+Specifies that @var{command}, rather than @code{gcc}, is to
+be invoked by @code{g77} to do its job.
+For example, within the @code{gcc} build directory after
+building GNU Fortran (but without having to install it),
+@kbd{./g77 --driver=./xgcc foo.f -B./}.
+@end table
+
+@cindex options, negative forms
+@cindex negative forms of options
+All other options are supported both by @code{g77} and by @code{gcc} as
+modified (and reinstalled) by the @code{g77} distribution.
+In some cases, options have positive and negative forms;
+the negative form of @samp{-ffoo} would be @samp{-fno-foo}.
+This manual documents only one of these two forms, whichever
+one is not the default.
+
+@menu
+* Option Summary:: Brief list of all @code{g77} options,
+ without explanations.
+* Overall Options:: Controlling the kind of output:
+ an executable, object files, assembler files,
+ or preprocessed source.
+* Shorthand Options:: Options that are shorthand for other options.
+* Fortran Dialect Options:: Controlling the variant of Fortran language
+ compiled.
+* Warning Options:: How picky should the compiler be?
+* Debugging Options:: Symbol tables, measurements, and debugging dumps.
+* Optimize Options:: How much optimization?
+* Preprocessor Options:: Controlling header files and macro definitions.
+ Also, getting dependency information for Make.
+* Directory Options:: Where to find header files and libraries.
+ Where to find the compiler executable files.
+* Code Gen Options:: Specifying conventions for function calls, data layout
+ and register usage.
+* Environment Variables:: Env vars that affect GNU Fortran.
+@end menu
+
+@node Option Summary
+@section Option Summary
+
+Here is a summary of all the options specific to GNU Fortran, grouped
+by type. Explanations are in the following sections.
+
+@table @emph
+@item Overall Options
+@xref{Overall Options,,Options Controlling the Kind of Output}.
+@smallexample
+--driver -fversion -fset-g77-defaults -fno-silent
+@end smallexample
+
+@item Shorthand Options
+@xref{Shorthand Options}.
+@smallexample
+-ff66 -fno-f66 -ff77 -fno-f77 -fugly -fno-ugly
+@end smallexample
+
+@item Fortran Language Options
+@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect}.
+@smallexample
+-ffree-form -fno-fixed-form -ff90
+-fvxt -fdollar-ok -fno-backslash
+-fno-ugly-args -fno-ugly-assign -fno-ugly-assumed
+-fugly-comma -fugly-complex -fugly-init -fugly-logint
+-fonetrip -ftypeless-boz
+-fintrin-case-initcap -fintrin-case-upper
+-fintrin-case-lower -fintrin-case-any
+-fmatch-case-initcap -fmatch-case-upper
+-fmatch-case-lower -fmatch-case-any
+-fsource-case-upper -fsource-case-lower -fsource-case-preserve
+-fsymbol-case-initcap -fsymbol-case-upper
+-fsymbol-case-lower -fsymbol-case-any
+-fcase-strict-upper -fcase-strict-lower
+-fcase-initcap -fcase-upper -fcase-lower -fcase-preserve
+-ff2c-intrinsics-delete -ff2c-intrinsics-hide
+-ff2c-intrinsics-disable -ff2c-intrinsics-enable
+-ff90-intrinsics-delete -ff90-intrinsics-hide
+-ff90-intrinsics-disable -ff90-intrinsics-enable
+-fgnu-intrinsics-delete -fgnu-intrinsics-hide
+-fgnu-intrinsics-disable -fgnu-intrinsics-enable
+-fmil-intrinsics-delete -fmil-intrinsics-hide
+-fmil-intrinsics-disable -fmil-intrinsics-enable
+-funix-intrinsics-delete -funix-intrinsics-hide
+-funix-intrinsics-disable -funix-intrinsics-enable
+-fvxt-intrinsics-delete -fvxt-intrinsics-hide
+-fvxt-intrinsics-disable -fvxt-intrinsics-enable
+-ffixed-line-length-@var{n} -ffixed-line-length-none
+@end smallexample
+
+@item Warning Options
+@xref{Warning Options,,Options to Request or Suppress Warnings}.
+@smallexample
+-fsyntax-only -pedantic -pedantic-errors -fpedantic
+-w -Wno-globals -Wimplicit -Wunused -Wuninitialized
+-Wall -Wsurprising
+-Werror -W
+@end smallexample
+
+@item Debugging Options
+@xref{Debugging Options,,Options for Debugging Your Program or GCC}.
+@smallexample
+-g
+@end smallexample
+
+@item Optimization Options
+@xref{Optimize Options,,Options that Control Optimization}.
+@smallexample
+-malign-double
+-ffloat-store -fforce-mem -fforce-addr -fno-inline
+-ffast-math -fstrength-reduce -frerun-cse-after-loop
+-fexpensive-optimizations -fdelayed-branch
+-fschedule-insns -fschedule-insn2 -fcaller-saves
+-funroll-loops -funroll-all-loops
+-fno-move-all-movables -fno-reduce-all-givs
+-fno-rerun-loop-opt
+@end smallexample
+
+@item Directory Options
+@xref{Directory Options,,Options for Directory Search}.
+@smallexample
+-I@var{dir} -I-
+@end smallexample
+
+@item Code Generation Options
+@xref{Code Gen Options,,Options for Code Generation Conventions}.
+@smallexample
+-fno-automatic -finit-local-zero -fno-f2c
+-ff2c-library -fno-underscoring -fno-ident
+-fpcc-struct-return -freg-struct-return
+-fshort-double -fno-common -fpack-struct
+-fzeros -fno-second-underscore
+-fdebug-kludge -fno-emulate-complex
+-falias-check -fargument-alias
+-fargument-noalias -fno-argument-noalias-global
+-fno-globals
+@end smallexample
+@end table
+
+@menu
+* Overall Options:: Controlling the kind of output:
+ an executable, object files, assembler files,
+ or preprocessed source.
+* Shorthand Options:: Options that are shorthand for other options.
+* Fortran Dialect Options:: Controlling the variant of Fortran language
+ compiled.
+* Warning Options:: How picky should the compiler be?
+* Debugging Options:: Symbol tables, measurements, and debugging dumps.
+* Optimize Options:: How much optimization?
+* Preprocessor Options:: Controlling header files and macro definitions.
+ Also, getting dependency information for Make.
+* Directory Options:: Where to find header files and libraries.
+ Where to find the compiler executable files.
+* Code Gen Options:: Specifying conventions for function calls, data layout
+ and register usage.
+@end menu
+
+@node Overall Options
+@section Options Controlling the Kind of Output
+@cindex overall options
+@cindex options, overall
+
+Compilation can involve as many as four stages: preprocessing, code
+generation (often what is really meant by the term ``compilation''),
+assembly, and linking, always in that order. The first three
+stages apply to an individual source file, and end by producing an
+object file; linking combines all the object files (those newly
+compiled, and those specified as input) into an executable file.
+
+@cindex file name suffix
+@cindex suffixes, file name
+@cindex file name extension
+@cindex extensions, file name
+@cindex file type
+@cindex types, file
+For any given input file, the file name suffix determines what kind of
+program is contained in the file---that is, the language in which the
+program is written is generally indicated by the suffix.
+Suffixes specific to GNU Fortran are listed below.
+@xref{Overall Options,,gcc,Using and Porting GNU CC}, for
+information on suffixes recognized by GNU CC.
+
+@table @code
+@item @var{file}.f
+@item @var{file}.for
+Fortran source code that should not be preprocessed.
+
+Such source code cannot contain any preprocessor directives, such
+as @code{#include}, @code{#define}, @code{#if}, and so on.
+
+@cindex preprocessor
+@cindex C preprocessor
+@cindex cpp preprocessor
+@cindex Fortran preprocessor
+@cindex cpp program
+@cindex programs, cpp
+@cindex .F filename suffix
+@cindex .fpp filename suffix
+@item @var{file}.F
+@item @var{file}.fpp
+Fortran source code that must be preprocessed (by the C preprocessor
+@code{cpp}, which is part of GNU CC).
+
+Note that preprocessing is not extended to the contents of
+files included by the @code{INCLUDE} directive---the @code{#include}
+preprocessor directive must be used instead.
+
+@cindex Ratfor preprocessor
+@cindex programs, ratfor
+@cindex .r filename suffix
+@item @var{file}.r
+Ratfor source code, which must be preprocessed by the @code{ratfor}
+command, which is available separately (as it is not yet part of
+the GNU Fortran distribution).
+@end table
+
+UNIX users typically use the @file{@var{file}.f} and @file{@var{file}.F}
+nomenclature.
+Users of other operating systems, especially those that cannot
+distinguish upper-case
+letters from lower-case letters in their file names, typically use
+the @file{@var{file}.for} and @file{@var{file}.fpp} nomenclature.
+
+@cindex #define
+@cindex #include
+@cindex #if
+Use of the preprocessor @code{cpp} allows use of C-like
+constructs such as @code{#define} and @code{#include}, but can
+lead to unexpected, even mistaken, results due to Fortran's source file
+format.
+It is recommended that use of the C preprocessor
+be limited to @code{#include} and, in
+conjunction with @code{#define}, only @code{#if} and related directives,
+thus avoiding in-line macro expansion entirely.
+This recommendation applies especially
+when using the traditional fixed source form.
+With free source form,
+fewer unexpected transformations are likely to happen, but use of
+constructs such as Hollerith and character constants can nevertheless
+present problems, especially when these are continued across multiple
+source lines.
+These problems result, primarily, from differences between the way
+such constants are interpreted by the C preprocessor and by a Fortran
+compiler.
+
+@emph{Note:} The @samp{-traditional} and @samp{-undef} flags are supplied
+to @code{cpp} by default, to avoid unpleasant surprises.
+@xref{Preprocessor Options,,Options Controlling the Preprocessor,
+gcc,Using and Porting GNU CC}.
+This means that ANSI C preprocessor features (such as the @samp{#}
+operator) aren't available, and only variables in the C reserved
+namespace (generally, names with a leading underscore) are liable to
+substitution by C predefines.
+Thus, if you want to do system-specific
+tests, use, for example, @samp{#ifdef __linux__} rather than @samp{#ifdef linux}.
+Use the @samp{-v} option to see exactly how the preprocessor is invoked.
+
+The following options that affect overall processing are recognized
+by the @code{g77} and @code{gcc} commands in a GNU Fortran installation:
+
+@table @code
+@item --driver=@var{command}
+This works when invoking only the @code{g77} command, not
+when invoking the @code{gcc} command.
+@xref{Invoking G77,,GNU Fortran Command Options}, for
+information on this option.
+
+@cindex -fversion option
+@cindex options, -fversion
+@cindex printing version information
+@cindex version information, printing
+@item -fversion
+Ensure that the @code{g77}-specific version of the compiler phase is reported,
+if run.
+(This is supplied automatically when @samp{-v} or @samp{--verbose}
+is specified as a command-line option for @code{g77} or @code{gcc}
+and when the resulting commands compile Fortran source files.)
+
+@cindex -fset-g77-defaults option
+@cindex options, -fset-g77-defaults
+@item -fset-g77-defaults
+Set up whatever @code{gcc} options are to apply to Fortran
+compilations, and avoid running internal consistency checks
+that might take some time.
+
+As of version 0.5.20, this is equivalent to @samp{-fmove-all-movables
+-freduce-all-givs -frerun-loop-opt -fargument-noalias-global}.
+
+This option is supplied automatically when compiling Fortran code
+via the @code{g77} or @code{gcc} command.
+The description of this option is provided so that users seeing
+it in the output of, say, @samp{g77 -v} understand why it is
+there.
+
+@cindex modifying g77
+@cindex code, modifying
+Also, developers who run @code{f771} directly might want to specify it
+by hand to get the same defaults as they would running @code{f771}
+via @code{g77} or @code{gcc}.
+However, such developers should, after linking a new @code{f771}
+executable, invoke it without this option once,
+e.g. via @kbd{./f771 -quiet < /dev/null},
+to ensure that they have not introduced any
+internal inconsistencies (such as in the table of
+intrinsics) before proceeding---@code{g77} will crash
+with a diagnostic if it detects an inconsistency.
+
+@cindex -fno-silent option
+@cindex options, -fno-silent
+@cindex @code{f2c} compatibility
+@cindex compatibility, @code{f2c}
+@cindex status, compilation
+@cindex compilation status
+@cindex reporting compilation status
+@cindex printing compilation status
+@item -fno-silent
+Print (to @code{stderr}) the names of the program units as
+they are compiled, in a form similar to that used by popular
+UNIX @code{f77} implementations and @code{f2c}.
+@end table
+
+@xref{Overall Options,,Options Controlling the Kind of Output,
+gcc,Using and Porting GNU CC}, for information
+on more options that control the overall operation of the @code{gcc} command
+(and, by extension, the @code{g77} command).
+
+@node Shorthand Options
+@section Shorthand Options
+@cindex shorthand options
+@cindex options, shorthand
+@cindex macro options
+@cindex options, macro
+
+The following options serve as ``shorthand''
+for other options accepted by the compiler:
+
+@table @code
+@cindex -fugly option
+@cindex options, -fugly
+@item -fugly
+@cindex ugly features
+@cindex features, ugly
+Specify that certain ``ugly'' constructs are to be quietly accepted.
+Same as:
+
+@smallexample
+-fugly-args -fugly-assign -fugly-assumed
+-fugly-comma -fugly-complex -fugly-init
+-fugly-logint
+@end smallexample
+
+These constructs are considered inappropriate to use in new
+or well-maintained portable Fortran code, but widely used
+in old code.
+@xref{Distensions}, for more information.
+
+@emph{Note:} The @samp{-fugly} option is likely to
+be removed in a future version.
+Implicitly enabling all the @samp{-fugly-*} options
+is unlikely to be feasible, or sensible, in the future,
+so users should learn to specify only those
+@samp{-fugly-*} options they really need for a
+particular source file.
+
+@cindex -fno-ugly option
+@cindex options, -fno-ugly
+@item -fno-ugly
+@cindex ugly features
+@cindex features, ugly
+Specify that all ``ugly'' constructs are to be noisily rejected.
+Same as:
+
+@smallexample
+-fno-ugly-args -fno-ugly-assign -fno-ugly-assumed
+-fno-ugly-comma -fno-ugly-complex -fno-ugly-init
+-fno-ugly-logint
+@end smallexample
+
+@xref{Distensions}, for more information.
+
+@cindex -ff66 option
+@cindex options, -ff66
+@item -ff66
+@cindex FORTRAN 66
+@cindex compatibility, FORTRAN 66
+Specify that the program is written in idiomatic FORTRAN 66.
+Same as @samp{-fonetrip -fugly-assumed}.
+
+The @samp{-fno-f66} option is the inverse of @samp{-ff66}.
+As such, it is the same as @samp{-fno-onetrip -fno-ugly-assumed}.
+
+The meaning of this option is likely to be refined as future
+versions of @code{g77} provide more compatibility with other
+existing and obsolete Fortran implementations.
+
+@cindex -ff77 option
+@cindex options, -ff77
+@item -ff77
+@cindex UNIX f77
+@cindex @code{f2c} compatibility
+@cindex compatibility, @code{f2c}
+@cindex @code{f77} compatibility
+@cindex compatibility, @code{f77}
+Specify that the program is written in idiomatic UNIX FORTRAN 77
+and/or the dialect accepted by the @code{f2c} product.
+Same as @samp{-fbackslash -fno-typeless-boz}.
+
+The meaning of this option is likely to be refined as future
+versions of @code{g77} provide more compatibility with other
+existing and obsolete Fortran implementations.
+
+@cindex -fno-f77 option
+@cindex options, -fno-f77
+@item -fno-f77
+@cindex UNIX f77
+The @samp{-fno-f77} option is @emph{not} the inverse
+of @samp{-ff77}.
+It specifies that the program is not written in idiomatic UNIX
+FORTRAN 77 or @code{f2c}, but in a more widely portable dialect.
+@samp{-fno-f77} is the same as @samp{-fno-backslash}.
+
+The meaning of this option is likely to be refined as future
+versions of @code{g77} provide more compatibility with other
+existing and obsolete Fortran implementations.
+@end table
+
+@node Fortran Dialect Options
+@section Options Controlling Fortran Dialect
+@cindex dialect options
+@cindex language dialect options
+@cindex options, dialect
+
+The following options control the dialect of Fortran
+that the compiler accepts:
+
+@table @code
+@cindex -ffree-form option
+@cindex options, -ffree-form
+@cindex -fno-fixed-form option
+@cindex options, -fno-fixed-form
+@cindex source file form
+@cindex free form
+@cindex fixed form
+@cindex Fortran 90 features
+@item -ffree-form
+@item -fno-fixed-form
+Specify that the source file is written in free form
+(introduced in Fortran 90) instead of the more-traditional fixed form.
+
+@cindex -ff90 option
+@cindex options, -ff90
+@cindex Fortran 90 features
+@item -ff90
+Allow certain Fortran-90 constructs.
+
+This option controls whether certain
+Fortran 90 constructs are recognized.
+(Other Fortran 90 constructs
+might or might not be recognized depending on other options such as
+@samp{-fvxt}, @samp{-ff90-intrinsics-enable}, and the
+current level of support for Fortran 90.)
+
+@xref{Fortran 90}, for more information.
+
+@cindex -fvxt option
+@cindex options, -fvxt
+@item -fvxt
+@cindex Fortran 90 features
+@cindex VXT features
+Specify the treatment of certain constructs that have different
+meanings depending on whether the code is written in
+GNU Fortran (based on FORTRAN 77 and akin to Fortran 90)
+or VXT Fortran (more like VAX FORTRAN).
+
+The default is @samp{-fno-vxt}.
+@samp{-fvxt} specifies that the VXT Fortran interpretations
+for those constructs are to be chosen.
+
+@xref{VXT Fortran}, for more information.
+
+@cindex -fdollar-ok option
+@cindex options, -fdollar-ok
+@item -fdollar-ok
+@cindex dollar sign
+@cindex symbol names
+@cindex character set
+Allow @samp{$} as a valid character in a symbol name.
+
+@cindex -fno-backslash option
+@cindex options, -fno-backslash
+@item -fno-backslash
+@cindex backslash
+@cindex character constants
+@cindex Hollerith constants
+Specify that @samp{\} is not to be specially interpreted in character
+and Hollerith constants a la C and many UNIX Fortran compilers.
+
+For example, with @samp{-fbackslash} in effect, @samp{A\nB} specifies
+three characters, with the second one being newline.
+With @samp{-fno-backslash}, it specifies four characters,
+@samp{A}, @samp{\}, @samp{n}, and @samp{B}.
+
+Note that @code{g77} implements a fairly general form of backslash
+processing that is incompatible with the narrower forms supported
+by some other compilers.
+For example, @samp{'A\003B'} is a three-character string in @code{g77},
+whereas other compilers that support backslash might not support
+the three-octal-digit form, and thus treat that string as longer
+than three characters.
+
+@xref{Backslash in Constants}, for
+information on why @samp{-fbackslash} is the default
+instead of @samp{-fno-backslash}.
+
+@cindex -fno-ugly-args option
+@cindex options, -fno-ugly-args
+@item -fno-ugly-args
+Disallow passing Hollerith and typeless constants as actual
+arguments (for example, @samp{CALL FOO(4HABCD)}).
+
+@xref{Ugly Implicit Argument Conversion}, for more information.
+
+@cindex -fugly-assign option
+@cindex options, -fugly-assign
+@item -fugly-assign
+Use the same storage for a given variable regardless of
+whether it is used to hold an assigned-statement label
+(as in @samp{ASSIGN 10 TO I}) or used to hold numeric data
+(as in @samp{I = 3}).
+
+@xref{Ugly Assigned Labels}, for more information.
+
+@cindex -fugly-assumed option
+@cindex options, -fugly-assumed
+@item -fugly-assumed
+Assume any dummy array with a final dimension specified as @samp{1}
+is really an assumed-size array, as if @samp{*} had been specified
+for the final dimension instead of @samp{1}.
+
+For example, @samp{DIMENSION X(1)} is treated as if it
+had read @samp{DIMENSION X(*)}.
+
+@xref{Ugly Assumed-Size Arrays}, for more information.
+
+@cindex -fugly-comma option
+@cindex options, -fugly-comma
+@item -fugly-comma
+Treat a trailing comma in an argument list as specification
+of a trailing null argument, and treat an empty argument
+list as specification of a single null argument.
+
+For example, @samp{CALL FOO(,)} is treated as
+@samp{CALL FOO(%VAL(0), %VAL(0))}.
+That is, @emph{two} null arguments are specified
+by the procedure call when @samp{-fugly-comma} is in force.
+And @samp{F = FUNC()} is treated as @samp{F = FUNC(%VAL(0))}.
+
+The default behavior, @samp{-fno-ugly-comma}, is to ignore
+a single trailing comma in an argument list.
+
+@xref{Ugly Null Arguments}, for more information.
+
+@cindex -fugly-complex option
+@cindex options, -fugly-complex
+@item -fugly-complex
+Do not complain about @samp{REAL(@var{expr})} or
+@samp{AIMAG(@var{expr})} when @var{expr} is a @code{COMPLEX}
+type other than @code{COMPLEX(KIND=1)}---usually
+this is used to permit @code{COMPLEX(KIND=2)}
+(@code{DOUBLE COMPLEX}) operands.
+
+The @samp{-ff90} option controls the interpretation
+of this construct.
+
+@xref{Ugly Complex Part Extraction}, for more information.
+
+@cindex -fno-ugly-init option
+@cindex options, -fno-ugly-init
+@item -fno-ugly-init
+Disallow use of Hollerith and typeless constants as initial
+values (in @code{PARAMETER} and @code{DATA} statements), and
+use of character constants to
+initialize numeric types and vice versa.
+
+For example, @samp{DATA I/'F'/, CHRVAR/65/, J/4HABCD/} is disallowed by
+@samp{-fno-ugly-init}.
+
+@xref{Ugly Conversion of Initializers}, for more information.
+
+@cindex -fugly-logint option
+@cindex options, -fugly-logint
+@item -fugly-logint
+Treat @code{INTEGER} and @code{LOGICAL} variables and
+expressions as potential stand-ins for each other.
+
+For example, automatic conversion between @code{INTEGER} and
+@code{LOGICAL} is enabled, for many contexts, via this option.
+
+@xref{Ugly Integer Conversions}, for more information.
+
+@cindex -fonetrip option
+@cindex options, -fonetrip
+@item -fonetrip
+@cindex FORTRAN 66
+@cindex DO loops, one-trip
+@cindex one-trip DO loops
+@cindex compatibility, FORTRAN 66
+Imperative executable @code{DO} loops are to be executed at
+least once each time they are reached.
+
+ANSI FORTRAN 77 and more recent versions of the Fortran standard
+specify that the body of an imperative @code{DO} loop is not executed
+if the number of iterations calculated from the parameters of the
+loop is less than 1.
+(For example, @samp{DO 10 I = 1, 0}.)@
+Such a loop is called a @dfn{zero-trip loop}.
+
+Prior to ANSI FORTRAN 77, many compilers implemented @code{DO} loops
+such that the body of a loop would be executed at least once, even
+if the iteration count was zero.
+Fortran code written assuming this behavior is said to require
+@dfn{one-trip loops}.
+For example, some code written to the FORTRAN 66 standard
+expects this behavior from its @code{DO} loops, although that
+standard did not specify this behavior.
+
+The @samp{-fonetrip} option specifies that the source file(s) being
+compiled require one-trip loops.
+
+This option affects only those loops specified by the (imperative) @code{DO}
+statement and by implied-@code{DO} lists in I/O statements.
+Loops specified by implied-@code{DO} lists in @code{DATA} and
+specification (non-executable) statements are not affected.
+
+@cindex -ftypeless-boz option
+@cindex options, -ftypeless-boz
+@cindex prefix-radix constants
+@cindex constants, prefix-radix
+@cindex constants, types
+@cindex types, constants
+@item -ftypeless-boz
+Specifies that prefix-radix non-decimal constants, such as
+@samp{Z'ABCD'}, are typeless instead of @code{INTEGER(KIND=1)}.
+
+You can test for yourself whether a particular compiler treats
+the prefix form as @code{INTEGER(KIND=1)} or typeless by running the
+following program:
+
+@smallexample
+EQUIVALENCE (I, R)
+R = Z'ABCD1234'
+J = Z'ABCD1234'
+IF (J .EQ. I) PRINT *, 'Prefix form is TYPELESS'
+IF (J .NE. I) PRINT *, 'Prefix form is INTEGER'
+END
+@end smallexample
+
+Reports indicate that many compilers process this form as
+@code{INTEGER(KIND=1)}, though a few as typeless, and at least one
+based on a command-line option specifying some kind of
+compatibility.
+
+@cindex -fintrin-case-initcap option
+@cindex options, -fintrin-case-initcap
+@item -fintrin-case-initcap
+@cindex -fintrin-case-upper option
+@cindex options, -fintrin-case-upper
+@item -fintrin-case-upper
+@cindex -fintrin-case-lower option
+@cindex options, -fintrin-case-lower
+@item -fintrin-case-lower
+@cindex -fintrin-case-any option
+@cindex options, -fintrin-case-any
+@item -fintrin-case-any
+Specify expected case for intrinsic names.
+@samp{-fintrin-case-lower} is the default.
+
+@cindex -fmatch-case-initcap option
+@cindex options, -fmatch-case-initcap
+@item -fmatch-case-initcap
+@cindex -fmatch-case-upper option
+@cindex options, -fmatch-case-upper
+@item -fmatch-case-upper
+@cindex -fmatch-case-lower option
+@cindex options, -fmatch-case-lower
+@item -fmatch-case-lower
+@cindex -fmatch-case-any option
+@cindex options, -fmatch-case-any
+@item -fmatch-case-any
+Specify expected case for keywords.
+@samp{-fmatch-case-lower} is the default.
+
+@cindex -fsource-case-upper option
+@cindex options, -fsource-case-upper
+@item -fsource-case-upper
+@cindex -fsource-case-lower option
+@cindex options, -fsource-case-lower
+@item -fsource-case-lower
+@cindex -fsource-case-preserve option
+@cindex options, -fsource-case-preserve
+@item -fsource-case-preserve
+Specify whether source text other than character and Hollerith constants
+is to be translated to uppercase, to lowercase, or preserved as is.
+@samp{-fsource-case-lower} is the default.
+
+@cindex -fsymbol-case-initcap option
+@cindex options, -fsymbol-case-initcap
+@item -fsymbol-case-initcap
+@cindex -fsymbol-case-upper option
+@cindex options, -fsymbol-case-upper
+@item -fsymbol-case-upper
+@cindex -fsymbol-case-lower option
+@cindex options, -fsymbol-case-lower
+@item -fsymbol-case-lower
+@cindex -fsymbol-case-any option
+@cindex options, -fsymbol-case-any
+@item -fsymbol-case-any
+Specify valid cases for user-defined symbol names.
+@samp{-fsymbol-case-any} is the default.
+
+@cindex -fcase-strict-upper option
+@cindex options, -fcase-strict-upper
+@item -fcase-strict-upper
+Same as @samp{-fintrin-case-upper -fmatch-case-upper -fsource-case-preserve
+-fsymbol-case-upper}.
+(Requires all pertinent source to be in uppercase.)
+
+@cindex -fcase-strict-lower option
+@cindex options, -fcase-strict-lower
+@item -fcase-strict-lower
+Same as @samp{-fintrin-case-lower -fmatch-case-lower -fsource-case-preserve
+-fsymbol-case-lower}.
+(Requires all pertinent source to be in lowercase.)
+
+@cindex -fcase-initcap option
+@cindex options, -fcase-initcap
+@item -fcase-initcap
+Same as @samp{-fintrin-case-initcap -fmatch-case-initcap -fsource-case-preserve
+-fsymbol-case-initcap}.
+(Requires all pertinent source to be in initial capitals,
+as in @samp{Print *,SqRt(Value)}.)
+
+@cindex -fcase-upper option
+@cindex options, -fcase-upper
+@item -fcase-upper
+Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-upper
+-fsymbol-case-any}.
+(Maps all pertinent source to uppercase.)
+
+@cindex -fcase-lower option
+@cindex options, -fcase-lower
+@item -fcase-lower
+Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-lower
+-fsymbol-case-any}.
+(Maps all pertinent source to lowercase.)
+
+@cindex -fcase-preserve option
+@cindex options, -fcase-preserve
+@item -fcase-preserve
+Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-preserve
+-fsymbol-case-any}.
+(Preserves all case in user-defined symbols,
+while allowing any-case matching of intrinsics and keywords.
+For example, @samp{call Foo(i,I)} would pass two @emph{different}
+variables named @samp{i} and @samp{I} to a procedure named @samp{Foo}.)
+
+@cindex -ff2c-intrinsics-delete option
+@cindex options, -ff2c-intrinsics-delete
+@item -ff2c-intrinsics-delete
+@cindex -ff2c-intrinsics-hide option
+@cindex options, -ff2c-intrinsics-hide
+@item -ff2c-intrinsics-hide
+@cindex -ff2c-intrinsics-disable option
+@cindex options, -ff2c-intrinsics-disable
+@item -ff2c-intrinsics-disable
+@cindex -ff2c-intrinsics-enable option
+@cindex options, -ff2c-intrinsics-enable
+@item -ff2c-intrinsics-enable
+@cindex f2c intrinsics
+@cindex intrinsics, f2c
+Specify status of f2c-specific intrinsics.
+@samp{-ff2c-intrinsics-enable} is the default.
+
+@cindex -ff90-intrinsics-delete option
+@cindex options, -ff90-intrinsics-delete
+@item -ff90-intrinsics-delete
+@cindex -ff90-intrinsics-hide option
+@cindex options, -ff90-intrinsics-hide
+@item -ff90-intrinsics-hide
+@cindex -ff90-intrinsics-disable option
+@cindex options, -ff90-intrinsics-disable
+@item -ff90-intrinsics-disable
+@cindex -ff90-intrinsics-enable option
+@cindex options, -ff90-intrinsics-enable
+@item -ff90-intrinsics-enable
+@cindex Fortran 90 intrinsics
+@cindex intrinsics, Fortran 90
+Specify status of F90-specific intrinsics.
+@samp{-ff90-intrinsics-enable} is the default.
+
+@cindex -fgnu-intrinsics-delete option
+@cindex options, -fgnu-intrinsics-delete
+@item -fgnu-intrinsics-delete
+@cindex -fgnu-intrinsics-hide option
+@cindex options, -fgnu-intrinsics-hide
+@item -fgnu-intrinsics-hide
+@cindex -fgnu-intrinsics-disable option
+@cindex options, -fgnu-intrinsics-disable
+@item -fgnu-intrinsics-disable
+@cindex -fgnu-intrinsics-enable option
+@cindex options, -fgnu-intrinsics-enable
+@item -fgnu-intrinsics-enable
+@cindex Digital Fortran features
+@cindex COMPLEX intrinsics
+@cindex intrinsics, COMPLEX
+Specify status of Digital's COMPLEX-related intrinsics.
+@samp{-fgnu-intrinsics-enable} is the default.
+
+@cindex -fmil-intrinsics-delete option
+@cindex options, -fmil-intrinsics-delete
+@item -fmil-intrinsics-delete
+@cindex -fmil-intrinsics-hide option
+@cindex options, -fmil-intrinsics-hide
+@item -fmil-intrinsics-hide
+@cindex -fmil-intrinsics-disable option
+@cindex options, -fmil-intrinsics-disable
+@item -fmil-intrinsics-disable
+@cindex -fmil-intrinsics-enable option
+@cindex options, -fmil-intrinsics-enable
+@item -fmil-intrinsics-enable
+@cindex MIL-STD 1753
+@cindex intrinsics, MIL-STD 1753
+Specify status of MIL-STD-1753-specific intrinsics.
+@samp{-fmil-intrinsics-enable} is the default.
+
+@cindex -funix-intrinsics-delete option
+@cindex options, -funix-intrinsics-delete
+@item -funix-intrinsics-delete
+@cindex -funix-intrinsics-hide option
+@cindex options, -funix-intrinsics-hide
+@item -funix-intrinsics-hide
+@cindex -funix-intrinsics-disable option
+@cindex options, -funix-intrinsics-disable
+@item -funix-intrinsics-disable
+@cindex -funix-intrinsics-enable option
+@cindex options, -funix-intrinsics-enable
+@item -funix-intrinsics-enable
+@cindex UNIX intrinsics
+@cindex intrinsics, UNIX
+Specify status of UNIX intrinsics.
+@samp{-funix-intrinsics-enable} is the default.
+
+@cindex -fvxt-intrinsics-delete option
+@cindex options, -fvxt-intrinsics-delete
+@item -fvxt-intrinsics-delete
+@cindex -fvxt-intrinsics-hide option
+@cindex options, -fvxt-intrinsics-hide
+@item -fvxt-intrinsics-hide
+@cindex -fvxt-intrinsics-disable option
+@cindex options, -fvxt-intrinsics-disable
+@item -fvxt-intrinsics-disable
+@cindex -fvxt-intrinsics-enable option
+@cindex options, -fvxt-intrinsics-enable
+@item -fvxt-intrinsics-enable
+@cindex VXT intrinsics
+@cindex intrinsics, VXT
+Specify status of VXT intrinsics.
+@samp{-fvxt-intrinsics-enable} is the default.
+
+@cindex -ffixed-line-length-@var{n} option
+@cindex options, -ffixed-line-length-@var{n}
+@item -ffixed-line-length-@var{n}
+@cindex source file format
+@cindex line length
+@cindex length of source lines
+@cindex fixed-form line length
+Set column after which characters are ignored in typical fixed-form
+lines in the source file, and through which spaces are assumed (as
+if padded to that length) after the ends of short fixed-form lines.
+
+@cindex card image
+@cindex extended-source option
+Popular values for @var{n} include 72 (the
+standard and the default), 80 (card image), and 132 (corresponds
+to ``extended-source'' options in some popular compilers).
+@var{n} may be @samp{none}, meaning that the entire line is meaningful
+and that continued character constants never have implicit spaces appended
+to them to fill out the line.
+@samp{-ffixed-line-length-0} means the same thing as
+@samp{-ffixed-line-length-none}.
+
+@xref{Source Form}, for more information.
+@end table
+
+@node Warning Options
+@section Options to Request or Suppress Warnings
+@cindex options to control warnings
+@cindex warning messages
+@cindex messages, warning
+@cindex suppressing warnings
+
+Warnings are diagnostic messages that report constructions which
+are not inherently erroneous but which are risky or suggest there
+might have been an error.
+
+You can request many specific warnings with options beginning @samp{-W},
+for example @samp{-Wimplicit} to request warnings on implicit
+declarations. Each of these specific warning options also has a
+negative form beginning @samp{-Wno-} to turn off warnings;
+for example, @samp{-Wno-implicit}. This manual lists only one of the
+two forms, whichever is not the default.
+
+These options control the amount and kinds of warnings produced by GNU
+Fortran:
+
+@table @code
+@cindex syntax checking
+@cindex -fsyntax-only option
+@cindex options, -fsyntax-only
+@item -fsyntax-only
+Check the code for syntax errors, but don't do anything beyond that.
+
+@cindex -pedantic option
+@cindex options, -pedantic
+@item -pedantic
+Issue warnings for uses of extensions to ANSI FORTRAN 77.
+@samp{-pedantic} also applies to C-language constructs where they
+occur in GNU Fortran source files, such as use of @samp{\e} in a
+character constant within a directive like @samp{#include}.
+
+Valid ANSI FORTRAN 77 programs should compile properly with or without
+this option.
+However, without this option, certain GNU extensions and traditional
+Fortran features are supported as well.
+With this option, many of them are rejected.
+
+Some users try to use @samp{-pedantic} to check programs for strict ANSI
+conformance.
+They soon find that it does not do quite what they want---it finds some
+non-ANSI practices, but not all.
+However, improvements to @code{g77} in this area are welcome.
+
+@cindex -pedantic-errors option
+@cindex options, -pedantic-errors
+@item -pedantic-errors
+Like @samp{-pedantic}, except that errors are produced rather than
+warnings.
+
+@cindex -fpedantic option
+@cindex options, -fpedantic
+@item -fpedantic
+Like @samp{-pedantic}, but applies only to Fortran constructs.
+
+@cindex -w option
+@cindex options, -w
+@item -w
+Inhibit all warning messages.
+
+@cindex -Wno-globals option
+@cindex options, -Wno-globals
+@item -Wno-globals
+@cindex global names, warning
+@cindex warnings, global names
+Inhibit warnings about use of a name as both a global name
+(a subroutine, function, or block data program unit, or a
+common block) and implicitly as the name of an intrinsic
+in a source file.
+
+Also inhibit warnings about inconsistent invocations and/or
+definitions of global procedures (function and subroutines).
+Such inconsistencies include different numbers of arguments
+and different types of arguments.
+
+@cindex -Wimplicit option
+@cindex options, -Wimplicit
+@item -Wimplicit
+@cindex implicit declaration, warning
+@cindex warnings, implicit declaration
+@cindex -u option
+@cindex /WARNINGS=DECLARATIONS switch
+@cindex IMPLICIT NONE, similar effect
+@cindex effecting IMPLICIT NONE
+Warn whenever a variable, array, or function is implicitly
+declared.
+Has an effect similar to using the @code{IMPLICIT NONE} statement
+in every program unit.
+(Some Fortran compilers provide this feature by an option
+named @samp{-u} or @samp{/WARNINGS=DECLARATIONS}.)
+
+@cindex -Wunused option
+@cindex options, -Wunused
+@item -Wunused
+@cindex unused variables
+@cindex variables, unused
+Warn whenever a variable is unused aside from its declaration.
+
+@cindex -Wuninitialized option
+@cindex options, -Wuninitialized
+@item -Wuninitialized
+@cindex uninitialized variables
+@cindex variables, uninitialized
+Warn whenever an automatic variable is used without first being initialized.
+
+These warnings are possible only in optimizing compilation,
+because they require data-flow information that is computed only
+when optimizing. If you don't specify @samp{-O}, you simply won't
+get these warnings.
+
+These warnings occur only for variables that are candidates for
+register allocation. Therefore, they do not occur for a variable
+@c that is declared @code{VOLATILE}, or
+whose address is taken, or whose size
+is other than 1, 2, 4 or 8 bytes. Also, they do not occur for
+arrays, even when they are in registers.
+
+Note that there might be no warning about a variable that is used only
+to compute a value that itself is never used, because such
+computations may be deleted by data-flow analysis before the warnings
+are printed.
+
+These warnings are made optional because GNU Fortran is not smart
+enough to see all the reasons why the code might be correct
+despite appearing to have an error. Here is one example of how
+this can happen:
+
+@example
+SUBROUTINE DISPAT(J)
+IF (J.EQ.1) I=1
+IF (J.EQ.2) I=4
+IF (J.EQ.3) I=5
+CALL FOO(I)
+END
+@end example
+
+@noindent
+If the value of @code{J} is always 1, 2 or 3, then @code{I} is
+always initialized, but GNU Fortran doesn't know this. Here is
+another common case:
+
+@example
+SUBROUTINE MAYBE(FLAG)
+LOGICAL FLAG
+IF (FLAG) VALUE = 9.4
+@dots{}
+IF (FLAG) PRINT *, VALUE
+END
+@end example
+
+@noindent
+This has no bug because @code{VALUE} is used only if it is set.
+
+@cindex -Wall option
+@cindex options, -Wall
+@item -Wall
+@cindex all warnings
+@cindex warnings, all
+The @samp{-Wunused} and @samp{-Wuninitialized} options combined.
+These are all the
+options which pertain to usage that we recommend avoiding and that we
+believe is easy to avoid.
+(As more warnings are added to @code{g77}, some might
+be added to the list enabled by @samp{-Wall}.)
+@end table
+
+The remaining @samp{-W@dots{}} options are not implied by @samp{-Wall}
+because they warn about constructions that we consider reasonable to
+use, on occasion, in clean programs.
+
+@table @code
+@c @item -W
+@c Print extra warning messages for these events:
+@c
+@c @itemize @bullet
+@c @item
+@c If @samp{-Wall} or @samp{-Wunused} is also specified, warn about unused
+@c arguments.
+@c
+@c @end itemize
+@c
+@cindex -Wsurprising option
+@cindex options, -Wsurprising
+@item -Wsurprising
+Warn about ``suspicious'' constructs that are interpreted
+by the compiler in a way that might well be surprising to
+someone reading the code.
+These differences can result in subtle, compiler-dependent
+(even machine-dependent) behavioral differences.
+The constructs warned about include:
+
+@itemize @bullet
+@item
+Expressions having two arithmetic operators in a row, such
+as @samp{X*-Y}.
+Such a construct is nonstandard, and can produce
+unexpected results in more complicated situations such
+as @samp{X**-Y*Z}.
+@code{g77}, along with many other compilers, interprets
+this example differently than many programmers, and a few
+other compilers.
+Specifically, @code{g77} interprets @samp{X**-Y*Z} as
+@samp{(X**(-Y))*Z}, while others might think it should
+be interpreted as @samp{X**(-(Y*Z))}.
+
+A revealing example is the constant expression @samp{2**-2*1.},
+which @code{g77} evaluates to .25, while others might evaluate
+it to 0., the difference resulting from the way precedence affects
+type promotion.
+
+(The @samp{-fpedantic} option also warns about expressions
+having two arithmetic operators in a row.)
+
+@item
+Expressions with a unary minus followed by an operand and then
+a binary operator other than plus or minus.
+For example, @samp{-2**2} produces a warning, because
+the precedence is @samp{-(2**2)}, yielding -4, not
+@samp{(-2)**2}, which yields 4, and which might represent
+what a programmer expects.
+
+An example of an expression producing different results
+in a surprising way is @samp{-I*S}, where @var{I} holds
+the value @samp{-2147483648} and @var{S} holds @samp{0.5}.
+On many systems, negating @var{I} results in the same
+value, not a positive number, because it is already the
+lower bound of what an @code{INTEGER(KIND=1)} variable can hold.
+So, the expression evaluates to a positive number, while
+the ``expected'' interpretation, @samp{(-I)*S}, would
+evaluate to a negative number.
+
+Even cases such as @samp{-I*J} produce warnings,
+even though, in most configurations and situations,
+there is no computational difference between the
+results of the two interpretations---the purpose
+of this warning is to warn about differing interpretations
+and encourage a better style of coding, not to identify
+only those places where bugs might exist in the user's
+code.
+
+@cindex DO statement
+@cindex statements, DO
+@item
+@code{DO} loops with @code{DO} variables that are not
+of integral type---that is, using @code{REAL}
+variables as loop control variables.
+Although such loops can be written to work in the
+``obvious'' way, the way @code{g77} is required by the
+Fortran standard to interpret such code is likely to
+be quite different from the way many programmers expect.
+(This is true of all @code{DO} loops, but the differences
+are pronounced for non-integral loop control variables.)
+
+@xref{Loops}, for more information.
+@end itemize
+
+@cindex -Werror option
+@cindex options, -Werror
+@item -Werror
+Make all warnings into errors.
+
+@cindex -W option
+@cindex options, -W
+@item -W
+@cindex extra warnings
+@cindex warnings, extra
+Turns on ``extra warnings'' and, if optimization is specified
+via @samp{-O}, the @samp{-Wuninitialized} option.
+(This might change in future versions of @code{g77}.)
+
+``Extra warnings'' are issued for:
+
+@itemize @bullet
+@item
+@cindex unused parameters
+@cindex parameters, unused
+@cindex unused arguments
+@cindex arguments, unused
+@cindex unused dummies
+@cindex dummies, unused
+Unused parameters to a procedure (when @samp{-Wunused} also is
+specified).
+
+@item
+@cindex overflow
+Overflows involving floating-point constants (not available
+for certain configurations).
+@end itemize
+@end table
+
+@xref{Warning Options,,Options to Request or Suppress Warnings,
+gcc,Using and Porting GNU CC}, for information on more options offered
+by the GBE shared by @code{g77}, @code{gcc}, and other GNU compilers.
+
+Some of these have no effect when compiling programs written in Fortran:
+
+@table @code
+@cindex -Wcomment option
+@cindex options, -Wcomment
+@item -Wcomment
+@cindex -Wformat option
+@cindex options, -Wformat
+@item -Wformat
+@cindex -Wparentheses option
+@cindex options, -Wparentheses
+@item -Wparentheses
+@cindex -Wswitch option
+@cindex options, -Wswitch
+@item -Wswitch
+@cindex -Wtraditional option
+@cindex options, -Wtraditional
+@item -Wtraditional
+@cindex -Wshadow option
+@cindex options, -Wshadow
+@item -Wshadow
+@cindex -Wid-clash-@var{len} option
+@cindex options, -Wid-clash-@var{len}
+@item -Wid-clash-@var{len}
+@cindex -Wlarger-than-@var{len} option
+@cindex options, -Wlarger-than-@var{len}
+@item -Wlarger-than-@var{len}
+@cindex -Wconversion option
+@cindex options, -Wconversion
+@item -Wconversion
+@cindex -Waggregate-return option
+@cindex options, -Waggregate-return
+@item -Waggregate-return
+@cindex -Wredundant-decls option
+@cindex options, -Wredundant-decls
+@item -Wredundant-decls
+@cindex unsupported warnings
+@cindex warnings, unsupported
+These options all could have some relevant meaning for
+GNU Fortran programs, but are not yet supported.
+@end table
+
+@node Debugging Options
+@section Options for Debugging Your Program or GNU Fortran
+@cindex options, debugging
+@cindex debugging information options
+
+GNU Fortran has various special options that are used for debugging
+either your program or @code{g77}.
+
+@table @code
+@cindex -g option
+@cindex options, -g
+@item -g
+Produce debugging information in the operating system's native format
+(stabs, COFF, XCOFF, or DWARF). GDB can work with this debugging
+information.
+
+@cindex common blocks
+@cindex equivalence areas
+@cindex missing debug features
+Support for this option in Fortran programs is incomplete.
+In particular, names of variables and arrays in common blocks
+or that are storage-associated via @code{EQUIVALENCE} are
+unavailable to the debugger.
+
+However, version 0.5.19 of @code{g77} does provide this information
+in a rudimentary way, as controlled by the
+@samp{-fdebug-kludge} option.
+
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for more information.
+@end table
+
+@xref{Debugging Options,,Options for Debugging Your Program or GNU CC,
+gcc,Using and Porting GNU CC}, for more information on debugging options.
+
+@node Optimize Options
+@section Options That Control Optimization
+@cindex optimize options
+@cindex options, optimization
+
+Most Fortran users will want to use no optimization when
+developing and testing programs, and use @samp{-O} or @samp{-O2} when
+compiling programs for late-cycle testing and for production use.
+
+The following flags have particular applicability when
+compiling Fortran programs:
+
+@table @code
+@cindex -malign-double option
+@cindex options, -malign-double
+@item -malign-double
+(Intel 386 architecture only.)
+
+Noticeably improves performance of @code{g77} programs making
+heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) data
+on some systems.
+In particular, systems using Pentium, Pentium Pro, 586, and
+686 implementations
+of the i386 architecture execute programs faster when
+@code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) data are
+aligned on 64-bit boundaries
+in memory.
+
+This option can, at least, make benchmark results more consistent
+across various system configurations, versions of the program,
+and data sets.
+
+@emph{Note:} The warning in the @code{gcc} documentation about
+this option does not apply, generally speaking, to Fortran
+code compiled by @code{g77}.
+
+@emph{Also note:} Apparently due to a @code{gcc} backend bug,
+@samp{-malign-double} does not align stack-allocated data (such as
+local variables neither @code{SAVE}d nor reckoned to take up too
+much space to put on the stack).
+
+@emph{Also also note:} The negative form of @samp{-malign-double}
+is @samp{-mno-align-double}, not @samp{-benign-double}.
+
+@cindex -ffloat-store option
+@cindex options, -ffloat-store
+@item -ffloat-store
+@cindex IEEE conformance
+@cindex conformance, IEEE
+Might help a Fortran program that depends on exact IEEE conformance
+on some machines, but might slow down a program that doesn't.
+
+@cindex -fforce-mem option
+@cindex options, -fforce-mem
+@item -fforce-mem
+@cindex -fforce-addr option
+@cindex options, -fforce-addr
+@item -fforce-addr
+@cindex loops, speeding up
+@cindex speeding up loops
+Might improve optimization of loops.
+
+@cindex -fno-inline option
+@cindex options, -fno-inline
+@item -fno-inline
+@cindex in-line compilation
+@cindex compilation, in-line
+Don't compile statement functions inline.
+Might reduce the size of a program unit---which might be at
+expense of some speed (though it should compile faster).
+Note that if you are not optimizing, no functions can be expanded inline.
+
+@cindex -ffast-math option
+@cindex options, -ffast-math
+@item -ffast-math
+@cindex IEEE conformance
+@cindex conformance, IEEE
+Might allow some programs designed to not be too dependent
+on IEEE behavior for floating-point to run faster, or die trying.
+
+@cindex -fstrength-reduce option
+@cindex options, -fstrength-reduce
+@item -fstrength-reduce
+@cindex loops, speeding up
+@cindex speeding up loops
+Might make some loops run faster.
+
+@cindex -frerun-cse-after-loop option
+@cindex options, -frerun-cse-after-loop
+@item -frerun-cse-after-loop
+@cindex -fexpensive-optimizations option
+@cindex options, -fexpensive-optimizations
+@item -fexpensive-optimizations
+@cindex -fdelayed-branch option
+@cindex options, -fdelayed-branch
+@item -fdelayed-branch
+@cindex -fschedule-insns option
+@cindex options, -fschedule-insns
+@item -fschedule-insns
+@cindex -fschedule-insns2 option
+@cindex options, -fschedule-insns2
+@item -fschedule-insns2
+@cindex -fcaller-saves option
+@cindex options, -fcaller-saves
+@item -fcaller-saves
+Might improve performance on some code.
+
+@cindex -funroll-loops option
+@cindex options, -funroll-loops
+@item -funroll-loops
+@cindex loops, unrolling
+@cindex unrolling loops
+Definitely improves performance on some code.
+
+@cindex -funroll-all-loops option
+@cindex options, -funroll-all-loops
+@item -funroll-all-loops
+Definitely improves performance on some code.
+
+@item -fno-move-all-movables
+@cindex -fno-move-all-movables option
+@cindex options, -fno-move-all-movables
+@item -fno-reduce-all-givs
+@cindex -fno-reduce-all-givs option
+@cindex options, -fno-reduce-all-givs
+@item -fno-rerun-loop-opt
+@cindex -fno-rerun-loop-opt option
+@cindex options, -fno-rerun-loop-opt
+Each of these might improve performance on some code.
+
+Analysis of Fortran code optimization and the resulting
+optimizations triggered by the above options were
+contributed by Toon Moene (@email{toon@@moene.indiv.nluug.nl}).
+
+These three options are intended to be removed someday, once
+they have helped determine the efficacy of various
+approaches to improving the performance of Fortran code.
+
+Please let us know how use of these options affects
+the performance of your production code.
+We're particularly interested in code that runs faster
+when these options are @emph{disabled}, and in
+non-Fortran code that benefits when they are
+@emph{enabled} via the above @code{gcc} command-line options.
+@end table
+
+@xref{Optimize Options,,Options That Control Optimization,
+gcc,Using and Porting GNU CC}, for more information on options
+to optimize the generated machine code.
+
+@node Preprocessor Options
+@section Options Controlling the Preprocessor
+@cindex preprocessor options
+@cindex options, preprocessor
+@cindex cpp program
+@cindex programs, cpp
+
+These options control the C preprocessor, which is run on each C source
+file before actual compilation.
+
+@xref{Preprocessor Options,,Options Controlling the Preprocessor,
+gcc,Using and Porting GNU CC}, for information on C preprocessor options.
+
+@cindex INCLUDE directive
+@cindex directive, INCLUDE
+Some of these options also affect how @code{g77} processes the
+@code{INCLUDE} directive.
+Since this directive is processed even when preprocessing
+is not requested, it is not described in this section.
+@xref{Directory Options,,Options for Directory Search}, for
+information on how @code{g77} processes the @code{INCLUDE} directive.
+
+However, the @code{INCLUDE} directive does not apply
+preprocessing to the contents of the included file itself.
+
+Therefore, any file that contains preprocessor directives
+(such as @code{#include}, @code{#define}, and @code{#if})
+must be included via the @code{#include} directive, not
+via the @code{INCLUDE} directive.
+Therefore, any file containing preprocessor directives,
+if included, is necessarily included by a file that itself
+contains preprocessor directives.
+
+@node Directory Options
+@section Options for Directory Search
+@cindex directory options
+@cindex options, directory search
+@cindex search path
+
+These options affect how the @code{cpp} preprocessor searches
+for files specified via the @code{#include} directive.
+Therefore, when compiling Fortran programs, they are meaningful
+when the preproecssor is used.
+
+@cindex INCLUDE directive
+@cindex directive, INCLUDE
+Some of these options also affect how @code{g77} searches
+for files specified via the @code{INCLUDE} directive,
+although files included by that directive are not,
+themselves, preprocessed.
+These options are:
+
+@table @code
+@cindex -I- option
+@cindex options, -I-
+@item -I-
+@cindex -Idir option
+@cindex options, -Idir
+@item -I@var{dir}
+@cindex directory search paths for inclusion
+@cindex inclusion, directory search paths for
+@cindex searching for included files
+These affect interpretation of the @code{INCLUDE} directive
+(as well as of the @code{#include} directive of the @code{cpp}
+preprocessor).
+
+Note that @samp{-I@var{dir}} must be specified @emph{without} any
+spaces between @samp{-I} and the directory name---that is,
+@samp{-Ifoo/bar} is valid, but @samp{-I foo/bar}
+is rejected by the @code{g77} compiler (though the preprocessor supports
+the latter form).
+@c this is due to toplev.c's inflexible option processing
+Also note that the general behavior of @samp{-I} and
+@code{INCLUDE} is pretty much the same as of @samp{-I} with
+@code{#include} in the @code{cpp} preprocessor, with regard to
+looking for @file{header.gcc} files and other such things.
+
+@xref{Directory Options,,Options for Directory Search,
+gcc,Using and Porting GNU CC}, for information on the @samp{-I} option.
+@end table
+
+@node Code Gen Options
+@section Options for Code Generation Conventions
+@cindex code generation conventions
+@cindex options, code generation
+@cindex run-time options
+
+These machine-independent options control the interface conventions
+used in code generation.
+
+Most of them have both positive and negative forms; the negative form
+of @samp{-ffoo} would be @samp{-fno-foo}. In the table below, only
+one of the forms is listed---the one which is not the default. You
+can figure out the other form by either removing @samp{no-} or adding
+it.
+
+@table @code
+@cindex -fno-automatic option
+@cindex options, -fno-automatic
+@item -fno-automatic
+@cindex SAVE statement
+@cindex statements, SAVE
+Treat each program unit as if the @code{SAVE} statement was specified
+for every local variable and array referenced in it.
+Does not affect common blocks.
+(Some Fortran compilers provide this option under
+the name @samp{-static}.)
+
+@cindex -finit-local-zero option
+@cindex options, -finit-local-zero
+@item -finit-local-zero
+@cindex DATA statement
+@cindex statements, DATA
+@cindex initialization of local variables
+@cindex variables, initialization of
+@cindex uninitialized variables
+@cindex variables, uninitialized
+Specify that variables and arrays that are local to a program unit
+(not in a common block and not passed as an argument) are to be initialized
+to binary zeros.
+
+Since there is a run-time penalty for initialization of variables
+that are not given the @code{SAVE} attribute, it might be a
+good idea to also use @samp{-fno-automatic} with @samp{-finit-local-zero}.
+
+@cindex -fno-f2c option
+@cindex options, -fno-f2c
+@item -fno-f2c
+@cindex @code{f2c} compatibility
+@cindex compatibility, @code{f2c}
+Do not generate code designed to be compatible with code generated
+by @code{f2c}; use the GNU calling conventions instead.
+
+The @code{f2c} calling conventions require functions that return
+type @code{REAL(KIND=1)} to actually return the C type @code{double},
+and functions that return type @code{COMPLEX} to return the
+values via an extra argument in the calling sequence that points
+to where to store the return value.
+Under the GNU calling conventions, such functions simply return
+their results as they would in GNU C---@code{REAL(KIND=1)} functions
+return the C type @code{float}, and @code{COMPLEX} functions
+return the GNU C type @code{complex} (or its @code{struct}
+equivalent).
+
+This does not affect the generation of code that interfaces with the
+@code{libf2c} library.
+
+However, because the @code{libf2c} library uses @code{f2c}
+calling conventions, @code{g77} rejects attempts to pass
+intrinsics implemented by routines in this library as actual
+arguments when @samp{-fno-f2c} is used, to avoid bugs when
+they are actually called by code expecting the GNU calling
+conventions to work.
+
+For example, @samp{INTRINSIC ABS;CALL FOO(ABS)} is
+rejected when @samp{-fno-f2c} is in force.
+(Future versions of the @code{g77} run-time library might
+offer routines that provide GNU-callable versions of the
+routines that implement the @code{f2c}-callable intrinsics
+that may be passed as actual arguments, so that
+valid programs need not be rejected when @samp{-fno-f2c}
+is used.)
+
+@strong{Caution:} If @samp{-fno-f2c} is used when compiling any
+source file used in a program, it must be used when compiling
+@emph{all} Fortran source files used in that program.
+
+@c seems kinda dumb to tell people about an option they can't use -- jcb
+@c then again, we want users building future-compatible libraries with it.
+@cindex -ff2c-library option
+@cindex options, -ff2c-library
+@item -ff2c-library
+Specify that use of @code{libf2c} is required.
+This is the default for the current version of @code{g77}.
+
+Currently it is not
+valid to specify @samp{-fno-f2c-library}.
+This option is provided so users can specify it in shell
+scripts that build programs and libraries that require the
+@code{libf2c} library, even when being compiled by future
+versions of @code{g77} that might otherwise default to
+generating code for an incompatible library.
+
+@cindex -fno-underscoring option
+@cindex options, -fno-underscoring
+@item -fno-underscoring
+@cindex underscores
+@cindex symbol names, underscores
+@cindex transforming symbol names
+@cindex symbol names, transforming
+Do not transform names of entities specified in the Fortran
+source file by appending underscores to them.
+
+With @samp{-funderscoring} in effect, @code{g77} appends two underscores
+to names with underscores and one underscore to external names with
+no underscores. (@code{g77} also appends two underscores to internal
+names with underscores to avoid naming collisions with external names.
+The @samp{-fno-second-underscore} option disables appending of the
+second underscore in all cases.)
+
+This is done to ensure compatibility with code produced by many
+UNIX Fortran compilers, including @code{f2c}, which perform the
+same transformations.
+
+Use of @samp{-fno-underscoring} is not recommended unless you are
+experimenting with issues such as integration of (GNU) Fortran into
+existing system environments (vis-a-vis existing libraries, tools, and
+so on).
+
+For example, with @samp{-funderscoring}, and assuming other defaults like
+@samp{-fcase-lower} and that @samp{j()} and @samp{max_count()} are
+external functions while @samp{my_var} and @samp{lvar} are local variables,
+a statement like
+
+@smallexample
+I = J() + MAX_COUNT (MY_VAR, LVAR)
+@end smallexample
+
+@noindent
+is implemented as something akin to:
+
+@smallexample
+i = j_() + max_count__(&my_var__, &lvar);
+@end smallexample
+
+With @samp{-fno-underscoring}, the same statement is implemented as:
+
+@smallexample
+i = j() + max_count(&my_var, &lvar);
+@end smallexample
+
+Use of @samp{-fno-underscoring} allows direct specification of
+user-defined names while debugging and when interfacing @code{g77}-compiled
+code with other languages.
+
+Note that just because the names match does @emph{not} mean that the
+interface implemented by @code{g77} for an external name matches the
+interface implemented by some other language for that same name.
+That is, getting code produced by @code{g77} to link to code produced
+by some other compiler using this or any other method can be only a
+small part of the overall solution---getting the code generated by
+both compilers to agree on issues other than naming can require
+significant effort, and, unlike naming disagreements, linkers normally
+cannot detect disagreements in these other areas.
+
+Also, note that with @samp{-fno-underscoring}, the lack of appended
+underscores introduces the very real possibility that a user-defined
+external name will conflict with a name in a system library, which
+could make finding unresolved-reference bugs quite difficult in some
+cases---they might occur at program run time, and show up only as
+buggy behavior at run time.
+
+In future versions of @code{g77}, we hope to improve naming and linking
+issues so that debugging always involves using the names as they appear
+in the source, even if the names as seen by the linker are mangled to
+prevent accidental linking between procedures with incompatible
+interfaces.
+
+@cindex -fno-second-underscore option
+@cindex options, -fno-second-underscore
+@item -fno-second-underscore
+@cindex underscores
+@cindex symbol names, underscores
+@cindex transforming symbol names
+@cindex symbol names, transforming
+Do not append a second underscore to names of entities specified
+in the Fortran source file.
+
+This option has no effect if @samp{-fno-underscoring} is
+in effect.
+
+Otherwise, with this option, an external name such as @samp{MAX_COUNT}
+is implemented as a reference to the link-time external symbol
+@samp{max_count_}, instead of @samp{max_count__}.
+
+@cindex -fno-ident option
+@cindex options, -fno-ident
+@item -fno-ident
+Ignore the @samp{#ident} directive.
+
+@cindex -fzeros option
+@cindex options, -fzeros
+@item -fzeros
+Treat initial values of zero as if they were any other value.
+
+As of version 0.5.18, @code{g77} normally treats @code{DATA} and
+other statements that are used to specify initial values of zero
+for variables and arrays as if no values were actually specified,
+in the sense that no diagnostics regarding multiple initializations
+are produced.
+
+This is done to speed up compiling of programs that initialize
+large arrays to zeros.
+
+Use @samp{-fzeros} to revert to the simpler, slower behavior
+that can catch multiple initializations by keeping track of
+all initializations, zero or otherwise.
+
+@emph{Caution:} Future versions of @code{g77} might disregard this option
+(and its negative form, the default) or interpret it somewhat
+differently.
+The interpretation changes will affect only non-standard
+programs; standard-conforming programs should not be affected.
+
+@cindex -fdebug-kludge option
+@cindex options, -fdebug-kludge
+@item -fdebug-kludge
+Emit information on @code{COMMON} and @code{EQUIVALENCE} members
+that might help users of debuggers work around lack of proper debugging
+information on such members.
+
+As of version 0.5.19, @code{g77} offers this option to emit
+information on members of aggregate areas to help users while debugging.
+This information consists of establishing the type and contents of each
+such member so that, when a debugger is asked to print the contents,
+the printed information provides rudimentary debugging information.
+This information identifies the name of the aggregate area (either the
+@code{COMMON} block name, or the @code{g77}-assigned name for the
+@code{EQUIVALENCE} name) and the offset, in bytes, of the member from
+the beginning of the area.
+
+Using @code{gdb}, this information is not coherently displayed in the Fortran
+language mode, so temporarily switching to the C language mode to display the
+information is suggested.
+Use @samp{set language c} and @samp{set language fortran} to accomplish this.
+
+For example:
+
+@smallexample
+ COMMON /X/A,B
+ EQUIVALENCE (C,D)
+ CHARACTER XX*50
+ EQUIVALENCE (I,XX(20:20))
+ END
+
+GDB is free software and you are welcome to distribute copies of it
+ under certain conditions; type "show copying" to see the conditions.
+There is absolutely no warranty for GDB; type "show warranty" for details.
+GDB 4.16 (lm-gnits-dwim), Copyright 1996 Free Software Foundation, Inc...
+(gdb) b MAIN__
+Breakpoint 1 at 0t1200000201120112: file cd.f, line 5.
+(gdb) r
+Starting program: /home/user/a.out
+
+Breakpoint 1, MAIN__ () at cd.f:5
+Current language: auto; currently fortran
+(gdb) set language c
+Warning: the current language does not match this frame.
+(gdb) p a
+$2 = "At (COMMON) `x_' plus 0 bytes"
+(gdb) p b
+$3 = "At (COMMON) `x_' plus 4 bytes"
+(gdb) p c
+$4 = "At (EQUIVALENCE) `__g77_equiv_c' plus 0 bytes"
+(gdb) p d
+$5 = "At (EQUIVALENCE) `__g77_equiv_c' plus 0 bytes"
+(gdb) p i
+$6 = "At (EQUIVALENCE) `__g77_equiv_xx' plus 20 bytes"
+(gdb) p xx
+$7 = "At (EQUIVALENCE) `__g77_equiv_xx' plus 1 bytes"
+(gdb) set language fortran
+(gdb)
+@end smallexample
+
+@noindent
+Use @samp{-fdebug-kludge} to generate this information,
+which might make some programs noticeably larger.
+
+@emph{Caution:} Future versions of @code{g77} might disregard this option
+(and its negative form).
+Current plans call for this to happen when published versions of @code{g77}
+and @code{gdb} exist that provide proper access to debugging information on
+@code{COMMON} and @code{EQUIVALENCE} members.
+
+@cindex -fno-emulate-complex option
+@cindex options, -fno-emulate-complex
+@item -fno-emulate-complex
+Implement @code{COMPLEX} arithmetic using the facilities in
+the @code{gcc} back end that provide direct support of
+@code{complex} arithmetic, instead of emulating the arithmetic.
+
+@code{gcc} has some known problems in its back-end support
+for @code{complex} arithmetic, due primarily to the support not being
+completed as of version 2.7.2.2.
+Other front ends for the @code{gcc} back end avoid this problem
+by emulating @code{complex} arithmetic at a higher level, so the
+back end sees arithmetic on the real and imaginary components.
+To make @code{g77} more portable to systems where @code{complex}
+support in the @code{gcc} back end is particularly troublesome,
+@code{g77} now defaults to performing the same kinds of emulations
+done by these other front ends.
+
+Use @samp{-fno-emulate-complex} to try the @code{complex} support
+in the @code{gcc} back end, in case it works and produces faster
+programs.
+So far, all the known bugs seem to involve compile-time crashes,
+rather than the generation of incorrect code.
+
+Use of this option should not affect how Fortran code compiled
+by @code{g77} works in terms of its interfaces to other code,
+e.g. that compiled by @code{f2c}.
+
+@emph{Caution:} Future versions of @code{g77} are likely to change
+the default for this option to
+@samp{-fno-emulate-complex}, and perhaps someday ignore both forms
+of this option.
+
+Also, it is possible that use of the @samp{-fno-emulate-complex} option
+could result in incorrect code being silently produced by @code{g77}.
+But, this is generally true of compilers anyway, so, as usual, test
+the programs you compile before assuming they are working.
+
+@cindex -falias-check option
+@cindex options, -falias-check
+@cindex -fargument-alias option
+@cindex options, -fargument-alias
+@cindex -fargument-noalias option
+@cindex options, -fargument-noalias
+@cindex -fno-argument-noalias-global option
+@cindex options, -fno-argument-noalias-global
+@item -falias-check
+@item -fargument-alias
+@item -fargument-noalias
+@item -fno-argument-noalias-global
+These options specify to what degree aliasing
+(overlap)
+is permitted between
+arguments (passed as pointers) and @code{COMMON} (external, or
+public) storage.
+
+The default for Fortran code, as mandated by the FORTRAN 77 and
+Fortran 90 standards, is @samp{-fargument-noalias-global}.
+The default for code written in the C language family is
+@samp{-fargument-alias}.
+
+Note that, on some systems, compiling with @samp{-fforce-addr} in
+effect can produce more optimal code when the default aliasing
+options are in effect (and when optimization is enabled).
+
+@xref{Aliasing Assumed To Work}, for detailed information on the implications
+of compiling Fortran code that depends on the ability to alias dummy
+arguments.
+
+@cindex -fno-globals option
+@cindex options, -fno-globals
+@item -fno-globals
+@cindex global names, warning
+@cindex warnings, global names
+Disable diagnostics about inter-procedural
+analysis problems, such as disagreements about the
+type of a function or a procedure's argument,
+that might cause a compiler crash when attempting
+to inline a reference to a procedure within a
+program unit.
+(The diagnostics themselves are still produced, but
+as warnings, unless @samp{-Wno-globals} is specified,
+in which case no relevant diagnostics are produced.)
+
+Further, this option disables such inlining, to
+avoid compiler crashes resulting from incorrect
+code that would otherwise be diagnosed.
+
+As such, this option might be quite useful when
+compiling existing, ``working'' code that happens
+to have a few bugs that do not generally show
+themselves, but @code{g77} exposes via a
+diagnostic.
+
+Use of this option therefore has the effect of
+instructing @code{g77} to behave more like it did
+up through version 0.5.19.1, when it paid little or
+no attention to disagreements between program units
+about a procedure's type and argument information,
+and when it performed no inlining of procedures
+(except statement functions).
+
+Without this option, @code{g77} defaults to performing
+the potentially inlining procedures as it started doing
+in version 0.5.20, but as of version 0.5.21, it also
+diagnoses disagreements that might cause such inlining
+to crash the compiler.
+@end table
+
+@xref{Code Gen Options,,Options for Code Generation Conventions,
+gcc,Using and Porting GNU CC}, for information on more options
+offered by the GBE
+shared by @code{g77}, @code{gcc}, and other GNU compilers.
+
+Some of these do @emph{not} work when compiling programs written in Fortran:
+
+@table @code
+@cindex -fpcc-struct-return option
+@cindex options, -fpcc-struct-return
+@item -fpcc-struct-return
+@cindex -freg-struct-return option
+@cindex options, -freg-struct-return
+@item -freg-struct-return
+You should not use these except strictly the same way as you
+used them to build the version of @code{libf2c} with which
+you will be linking all code compiled by @code{g77} with the
+same option.
+
+@cindex -fshort-double option
+@cindex options, -fshort-double
+@item -fshort-double
+This probably either has no effect on Fortran programs, or
+makes them act loopy.
+
+@cindex -fno-common option
+@cindex options, -fno-common
+@item -fno-common
+Do not use this when compiling Fortran programs,
+or there will be Trouble.
+
+@cindex -fpack-struct option
+@cindex options, -fpack-struct
+@item -fpack-struct
+This probably will break any calls to the @code{libf2c} library,
+at the very least, even if it is built with the same option.
+@end table
+
+@node Environment Variables
+@section Environment Variables Affecting GNU Fortran
+@cindex environment variables
+
+GNU Fortran currently does not make use of any environment
+variables to control its operation above and beyond those
+that affect the operation of @code{gcc}.
+
+@xref{Environment Variables,,Environment Variables Affecting GNU CC,
+gcc,Using and Porting GNU CC}, for information on environment
+variables.
+
+@include news.texi
+
+@node Changes
+@chapter User-visible Changes
+@cindex versions, recent
+@cindex recent versions
+@cindex changes, user-visible
+@cindex user-visible changes
+
+This section describes changes to @code{g77} that are visible
+to the programmers who actually write and maintain Fortran
+code they compile with @code{g77}.
+Information on changes to installation procedures,
+changes to the documentation, and bug fixes is
+not provided here, unless it is likely to affect how
+users use @code{g77}.
+@xref{News,,News About GNU Fortran}, for information on
+such changes to @code{g77}.
+
+To find out about existing bugs and ongoing plans for GNU
+Fortran, retrieve @url{ftp://alpha.gnu.ai.mit.edu/g77.plan}
+or, if you cannot do that, email
+@email{fortran@@gnu.ai.mit.edu} asking for a recent copy of the
+GNU Fortran @file{.plan} file.
+
+@heading In 0.5.21:
+@itemize @bullet
+@item
+When the @samp{-W} option is specified, @code{gcc}, @code{g77},
+and other GNU compilers that incorporate the @code{gcc}
+back end as modified by @code{g77}, issue
+a warning about integer division by constant zero.
+
+@item
+New option @samp{-Wno-globals} disables warnings
+about ``suspicious'' use of a name both as a global
+name and as the implicit name of an intrinsic, and
+warnings about disagreements over the number or natures of
+arguments passed to global procedures, or the
+natures of the procedures themselves.
+
+The default is to issue such warnings, which are
+new as of this version of @code{g77}.
+
+@item
+New option @samp{-fno-globals} disables diagnostics
+about potentially fatal disagreements
+analysis problems, such as disagreements over the
+number or natures of arguments passed to global
+procedures, or the natures of those procedures themselves.
+
+The default is to issue such diagnostics and flag
+the compilation as unsuccessful.
+With this option, the diagnostics are issued as
+warnings, or, if @samp{-Wno-globals} is specified,
+are not issued at all.
+
+This option also disables inlining of global procedures,
+to avoid compiler crashes resulting from coding errors
+that these diagnostics normally would identify.
+
+@item
+Fix @code{libU77} routines that accept file names
+to strip trailing spaces from them, for consistency
+with other implementations.
+
+@item
+Fix @code{SIGNAL} intrinsic so it accepts an
+optional third @samp{Status} argument.
+
+@item
+Make many changes to @code{libU77} intrinsics to
+support existing code more directly.
+
+Such changes include allowing both subroutine and
+function forms of many routines, changing @code{MCLOCK()}
+and @code{TIME()} to return @code{INTEGER(KIND=1)} values,
+introducing @code{MCLOCK8()} and @code{TIME8()} to
+return @code{INTEGER(KIND=2)} values,
+and placing functions that are intended to perform
+side effects in a new intrinsic group, @code{badu77}.
+
+@item
+Add options @samp{-fbadu77-intrinsics-delete},
+@samp{-fbadu77-intrinsics-hide}, and so on.
+
+@item
+Add @code{INT2} and @code{INT8} intrinsics.
+
+@item
+Add @code{CPU_TIME} intrinsic.
+
+@item
+@code{CTIME} intrinsic now accepts any @code{INTEGER}
+argument, not just @code{INTEGER(KIND=2)}.
+@end itemize
+
+@heading In 0.5.20:
+@itemize @bullet
+@item
+The @samp{-fno-typeless-boz} option is now the default.
+
+This option specifies that non-decimal-radix
+constants using the prefixed-radix form (such as @samp{Z'1234'})
+are to be interpreted as @code{INTEGER(KIND=1)} constants.
+Specify @samp{-ftypeless-boz} to cause such
+constants to be interpreted as typeless.
+
+(Version 0.5.19 introduced @samp{-fno-typeless-boz} and
+its inverse.)
+
+@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect},
+for information on the @samp{-ftypeless-boz} option.
+
+@item
+Options @samp{-ff90-intrinsics-enable} and
+@samp{-fvxt-intrinsics-enable} now are the
+defaults.
+
+Some programs might use names that clash with
+intrinsic names defined (and now enabled) by these
+options or by the new @code{libU77} intrinsics.
+Users of such programs might need to compile them
+differently (using, for example, @samp{-ff90-intrinsics-disable})
+or, better yet, insert appropriate @code{EXTERNAL}
+statements specifying that these names are not intended
+to be names of intrinsics.
+
+@item
+The @samp{ALWAYS_FLUSH} macro is no longer defined when
+building @code{libf2c}, which should result in improved
+I/O performance, especially over NFS.
+
+@emph{Note:} If you have code that depends on the behavior
+of @code{libf2c} when built with @samp{ALWAYS_FLUSH} defined,
+you will have to modify @code{libf2c} accordingly before
+building it from this and future versions of @code{g77}.
+
+@xref{Output Assumed To Flush}, for more information.
+
+@item
+Dave Love's implementation of @code{libU77} has been
+added to the version of @code{libf2c} distributed with
+and built by @code{g77}.
+@code{g77} now knows about the routines in this library
+as intrinsics.
+
+@item
+New option @samp{-fvxt} specifies that the
+source file is written in VXT Fortran, instead of GNU Fortran.
+
+@xref{VXT Fortran}, for more information on the constructs
+recognized when the @samp{-fvxt} option is specified.
+
+@item
+The @samp{-fvxt-not-f90} option has been deleted,
+along with its inverse, @samp{-ff90-not-vxt}.
+
+If you used one of these deleted options, you should
+re-read the pertinent documentation to determine which
+options, if any, are appropriate for compiling your
+code with this version of @code{g77}.
+
+@xref{Other Dialects}, for more information.
+
+@item
+The @samp{-fugly} option now issues a warning, as it
+likely will be removed in a future version.
+
+(Enabling all the @samp{-fugly-*} options is unlikely
+to be feasible, or sensible, in the future,
+so users should learn to specify only those
+@samp{-fugly-*} options they really need for a
+particular source file.)
+
+@item
+The @samp{-fugly-assumed} option, introduced in
+version 0.5.19, has been changed to
+better accommodate old and new code.
+@xref{Ugly Assumed-Size Arrays}, for more information.
+
+@item
+Related to supporting Alpha (AXP) machines, the @code{LOC()}
+intrinsic and @code{%LOC()} construct now return
+values of @code{INTEGER(KIND=0)} type,
+as defined by the GNU Fortran language.
+
+This type is wide enough
+(holds the same number of bits)
+as the character-pointer type on the machine.
+
+On most systems, this won't make a noticable difference,
+whereas on Alphas and other systems with 64-bit pointers,
+the @code{INTEGER(KIND=0)} type is equivalent to @code{INTEGER(KIND=2)}
+(often referred to as @code{INTEGER*8})
+instead of the more common @code{INTEGER(KIND=1)}
+(often referred to as @code{INTEGER*4}).
+
+@item
+Emulate @code{COMPLEX} arithmetic in the @code{g77} front
+end, to avoid bugs in @code{complex} support in the
+@code{gcc} back end.
+New option @samp{-fno-emulate-complex}
+causes @code{g77} to revert the 0.5.19 behavior.
+
+@item
+Dummy arguments are no longer assumed to potentially alias
+(overlap)
+other dummy arguments or @code{COMMON} areas when any of
+these are defined (assigned to) by Fortran code.
+
+This can result in faster and/or smaller programs when
+compiling with optimization enabled, though on some
+systems this effect is observed only when @samp{-fforce-addr}
+also is specified.
+
+New options @samp{-falias-check}, @samp{-fargument-alias},
+@samp{-fargument-noalias},
+and @samp{-fno-argument-noalias-global} control the
+way @code{g77} handles potential aliasing.
+
+@xref{Aliasing Assumed To Work}, for detailed information on why the
+new defaults might result in some programs no longer working the way they
+did when compiled by previous versions of @code{g77}.
+
+@item
+New option @samp{-fugly-assign} specifies that the
+same memory locations are to be used to hold the
+values assigned by both statements @samp{I = 3} and
+@samp{ASSIGN 10 TO I}, for example.
+(Normally, @code{g77} uses a separate memory location
+to hold assigned statement labels.)
+
+@xref{Ugly Assigned Labels}, for more information.
+
+@item
+@code{FORMAT} and @code{ENTRY} statements now are allowed to
+precede @code{IMPLICIT NONE} statements.
+
+@item
+Enable full support of @code{INTEGER(KIND=2)}
+(often referred to as @code{INTEGER*8})
+available in
+@code{libf2c} and @file{f2c.h} so that @code{f2c} users
+may make full use of its features via the @code{g77}
+version of @file{f2c.h} and the @code{INTEGER(KIND=2)}
+support routines in the @code{g77} version of @code{libf2c}.
+
+@item
+Improve @code{g77} driver and @code{libf2c} so that @samp{g77 -v}
+yields version information on the library.
+
+@item
+The @code{SNGL} and @code{FLOAT} intrinsics now are
+specific intrinsics, instead of synonyms for the
+generic intrinsic @code{REAL}.
+
+@item
+New intrinsics have been added.
+These are @code{REALPART}, @code{IMAGPART},
+@code{COMPLEX},
+@code{LONG}, and @code{SHORT}.
+
+@item
+A new group of intrinsics, @samp{gnu}, has been added
+to contain the new @code{REALPART}, @code{IMAGPART},
+and @code{COMPLEX} intrinsics.
+An old group, @samp{dcp}, has been removed.
+@end itemize
+
+@heading In 0.5.19:
+
+@itemize @bullet
+@item
+A temporary kludge option provides bare-bones information on
+@code{COMMON} and @code{EQUIVALENCE} members at debug time.
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for information on the @samp{-fdebug-kludge} option.
+
+@item
+New @samp{-fonetrip} option specifies FORTRAN-66-style
+one-trip @code{DO} loops.
+
+@item
+New @samp{-fno-silent} option causes names of program units
+to be printed as they are compiled, in a fashion similar to
+UNIX @code{f77} and @code{f2c}.
+
+@item
+New @samp{-fugly-assumed} option specifies that arrays
+dimensioned via @samp{DIMENSION X(1)}, for example, are to be
+treated as assumed-size.
+
+@item
+New @samp{-fno-typeless-boz} option specifies that non-decimal-radix
+constants using the prefixed-radix form (such as @samp{Z'1234'})
+are to be interpreted as @code{INTEGER(KIND=1)} constants.
+
+@item
+New @samp{-ff66} option is a ``shorthand'' option that specifies
+behaviors considered appropriate for FORTRAN 66 programs.
+
+@item
+New @samp{-ff77} option is a ``shorthand'' option that specifies
+behaviors considered appropriate for UNIX @code{f77} programs.
+
+@item
+New @samp{-fugly-comma} and @samp{-fugly-logint} options provided
+to perform some of what @samp{-fugly} used to do.
+@samp{-fugly} and @samp{-fno-ugly} are now ``shorthand'' options,
+in that they do nothing more than enable (or disable) other
+@samp{-fugly-*} options.
+
+@item
+Change code generation for list-directed I/O so it allows
+for new versions of @code{libf2c} that might return non-zero
+status codes for some operations previously assumed to always
+return zero.
+
+This change not only affects how @code{IOSTAT=} variables
+are set by list-directed I/O, it also affects whether
+@code{END=} and @code{ERR=} labels are reached by these
+operations.
+
+@item
+Add intrinsic support for new @code{FTELL} and @code{FSEEK}
+procedures in @code{libf2c}.
+
+@item
+Add options @samp{--help} and @samp{--version} to the
+@code{g77} command, to conform to GNU coding guidelines.
+Also add printing of @code{g77} version number when
+the @samp{--verbose} (@samp{-v}) option is used.
+@end itemize
+
+@heading In 0.5.18:
+
+@itemize @bullet
+@item
+The @code{BYTE} and @code{WORD} statements now are supported,
+to a limited extent.
+
+@item
+@code{INTEGER*1}, @code{INTEGER*2}, @code{INTEGER*8},
+and their @code{LOGICAL}
+equivalents, now are supported to a limited extent.
+Among the missing elements are complete intrinsic and constant
+support.
+
+@item
+Support automatic arrays in procedures.
+For example, @samp{REAL A(N)}, where @samp{A} is
+not a dummy argument, specifies that @samp{A} is
+an automatic array.
+The size of @samp{A} is calculated from the value
+of @samp{N} each time the procedure is called,
+that amount of space is allocated, and that space
+is freed when the procedure returns to its caller.
+
+@item
+Add @samp{-fno-zeros} option, enabled by default,
+to reduce compile-time CPU and memory usage for
+code that provides initial zero values for variables
+and arrays.
+
+@item
+Introduce three new options that apply to all compilations
+by @code{g77}-aware GNU compilers---@samp{-fmove-all-movables},
+@samp{-freduce-all-givs}, and @samp{-frerun-loop-opt}---which
+can improve the run-time performance of some programs.
+
+@item
+Replace much of the existing documentation with a single
+Info document.
+
+@item
+New option @samp{-fno-second-underscore}.
+@end itemize
+
+@heading In 0.5.17:
+
+@itemize @bullet
+@item
+The @code{ERF()} and @code{ERFC()} intrinsics now are generic
+intrinsics, mapping to @code{ERF}/@code{DERF} and
+@code{ERFC}/@code{DERFC}, respectively.
+@emph{Note:} Use @samp{INTRINSIC ERF,ERFC} in any code that
+might reference these as generic intrinsics, to
+improve the likelihood of diagnostics (instead of subtle run-time
+bugs) when using compilers that don't support these as intrinsics.
+
+@item
+New option @samp{-Wsurprising}.
+
+@item
+DO loops with non-@code{INTEGER} variables now diagnosed only when
+@samp{-Wsurprising} specified.
+Previously, this was diagnosed @emph{unless} @samp{-fpedantic} or
+@samp{-fugly} was specified.
+@end itemize
+
+@heading In 0.5.16:
+
+@itemize @bullet
+@item
+@code{libf2c} changed to output a leading zero (0) digit for floating-point
+values output via list-directed and formatted output (to bring @code{g77}
+more into line with many existing Fortran implementations---the
+ANSI FORTRAN 77 standard leaves this choice to the implementation).
+
+@item
+@code{libf2c} no longer built with debugging information
+intact, making it much smaller.
+
+@item
+Automatic installation of the @code{g77} command now works.
+
+@item
+Diagnostic messages now more informative, a la @code{gcc},
+including messages like @samp{In function `foo':} and @samp{In file
+included from...:}.
+
+@item
+New group of intrinsics called @samp{unix}, including @code{ABORT},
+@code{DERF}, @code{DERFC}, @code{ERF}, @code{ERFC}, @code{EXIT},
+@code{FLUSH}, @code{GETARG}, @code{GETENV}, @code{SIGNAL}, and
+@code{SYSTEM}.
+
+@item
+@samp{-funix-intrinsics-@{delete,hide,disable,enable@}}
+options added.
+
+@item
+@samp{-fno-underscoring} option added.
+
+@item
+@samp{--driver} option added to the @code{g77} command.
+
+@item
+Support for the @code{gcc} options @samp{-fident} and @samp{-fno-ident}
+added.
+
+@item
+@samp{g77 -v} returns much more version info, making the submission
+of better bug reports easily.
+
+@item
+Many improvements to the @code{g77} command to better fulfill its role as
+a front-end to the @code{gcc} driver.
+For example, @code{g77} now
+recognizes @samp{--verbose} as a verbose way of specifying @samp{-v}.
+
+@item
+Compiling preprocessed (@file{*.F} and @file{*.fpp}) files now
+results in better diagnostics and debugging information, as the
+source-location info now is passed all the
+way through the compilation process instead of being lost.
+@end itemize
+
+@node Language
+@chapter The GNU Fortran Language
+
+@cindex standard, ANSI FORTRAN 77
+@cindex ANSI FORTRAN 77 standard
+@cindex reference works
+GNU Fortran supports a variety of extensions to, and dialects
+of, the Fortran language.
+Its primary base is the ANSI FORTRAN 77 standard, currently available on
+the network at @url{http://kumo.swcp.com/fortran/F77_std/f77_std.html}
+or in @url{ftp://ftp.ast.cam.ac.uk/pub/michael/}.
+It offers some extensions that are popular among users
+of UNIX @code{f77} and @code{f2c} compilers, some that
+are popular among users of other compilers (such as Digital
+products), some that are popular among users of the
+newer Fortran 90 standard, and some that are introduced
+by GNU Fortran.
+
+@cindex textbooks
+(If you need a text on Fortran,
+a few freely available electronic references have pointers from
+@url{http://www.fortran.com/fortran/Books/}.)
+
+Part of what defines a particular implementation of a Fortran
+system, such as @code{g77}, is the particular characteristics
+of how it supports types, constants, and so on.
+Much of this is left up to the implementation by the various
+Fortran standards and accepted practice in the industry.
+
+The GNU Fortran @emph{language} is described below.
+Much of the material is organized along the same lines
+as the ANSI FORTRAN 77 standard itself.
+
+@xref{Other Dialects}, for information on features @code{g77} supports
+that are not part of the GNU Fortran language.
+
+@emph{Note}: This portion of the documentation definitely needs a lot
+of work!
+
+@menu
+Relationship to the ANSI FORTRAN 77 standard:
+* Direction of Language Development:: Where GNU Fortran is headed.
+* Standard Support:: Degree of support for the standard.
+
+Extensions to the ANSI FORTRAN 77 standard:
+* Conformance::
+* Notation Used::
+* Terms and Concepts::
+* Characters Lines Sequence::
+* Data Types and Constants::
+* Expressions::
+* Specification Statements::
+* Control Statements::
+* Functions and Subroutines::
+* Scope and Classes of Names::
+@end menu
+
+@node Direction of Language Development
+@section Direction of Language Development
+@cindex direction of language development
+@cindex features, language
+@cindex language features
+
+The purpose of the following description of the GNU Fortran
+language is to promote wide portability of GNU Fortran programs.
+
+GNU Fortran is an evolving language, due to the
+fact that @code{g77} itself is in beta test.
+Some current features of the language might later
+be redefined as dialects of Fortran supported by @code{g77}
+when better ways to express these features are added to @code{g77},
+for example.
+Such features would still be supported by
+@code{g77}, but would be available only when
+one or more command-line options were used.
+
+The GNU Fortran @emph{language} is distinct from the
+GNU Fortran @emph{compilation system} (@code{g77}).
+
+For example, @code{g77} supports various dialects of
+Fortran---in a sense, these are languages other than
+GNU Fortran---though its primary
+purpose is to support the GNU Fortran language, which also is
+described in its documentation and by its implementation.
+
+On the other hand, non-GNU compilers might offer
+support for the GNU Fortran language, and are encouraged
+to do so.
+
+Currently, the GNU Fortran language is a fairly fuzzy object.
+It represents something of a cross between what @code{g77} accepts
+when compiling using the prevailing defaults and what this
+document describes as being part of the language.
+
+Future versions of @code{g77} are expected to clarify the
+definition of the language in the documentation.
+Often, this will mean adding new features to the language, in the form
+of both new documentation and new support in @code{g77}.
+However, it might occasionally mean removing a feature
+from the language itself to ``dialect'' status.
+In such a case, the documentation would be adjusted
+to reflect the change, and @code{g77} itself would likely be changed
+to require one or more command-line options to continue supporting
+the feature.
+
+The development of the GNU Fortran language is intended to strike
+a balance between:
+
+@itemize @bullet
+@item
+Serving as a mostly-upwards-compatible language from the
+de facto UNIX Fortran dialect as supported by @code{f77}.
+
+@item
+Offering new, well-designed language features.
+Attributes of such features include
+not making existing code any harder to read
+(for those who might be unaware that the new
+features are not in use) and
+not making state-of-the-art
+compilers take longer to issue diagnostics,
+among others.
+
+@item
+Supporting existing, well-written code without gratuitously
+rejecting non-standard constructs, regardless of the origin
+of the code (its dialect).
+
+@item
+Offering default behavior and command-line options to reduce
+and, where reasonable, eliminate the need for programmers to make
+any modifications to code that already works in existing
+production environments.
+
+@item
+Diagnosing constructs that have different meanings in different
+systems, languages, and dialects, while offering clear,
+less ambiguous ways to express each of the different meanings
+so programmers can change their code appropriately.
+@end itemize
+
+One of the biggest practical challenges for the developers of the
+GNU Fortran language is meeting the sometimes contradictory demands
+of the above items.
+
+For example, a feature might be widely used in one popular environment,
+but the exact same code that utilizes that feature might not work
+as expected---perhaps it might mean something entirely different---in
+another popular environment.
+
+Traditionally, Fortran compilers---even portable ones---have solved this
+problem by simply offering the appropriate feature to users of
+the respective systems.
+This approach treats users of various Fortran systems and dialects
+as remote ``islands'', or camps, of programmers, and assume that these
+camps rarely come into contact with each other (or,
+especially, with each other's code).
+
+Project GNU takes a radically different approach to software and language
+design, in that it assumes that users of GNU software do not necessarily
+care what kind of underlying system they are using, regardless
+of whether they are using software (at the user-interface
+level) or writing it (for example, writing Fortran or C code).
+
+As such, GNU users rarely need consider just what kind of underlying
+hardware (or, in many cases, operating system) they are using at any
+particular time.
+They can use and write software designed for a general-purpose,
+widely portable, heteregenous environment---the GNU environment.
+
+In line with this philosophy, GNU Fortran must evolve into a product
+that is widely ported and portable not only in the sense that it can
+be successfully built, installed, and run by users, but in the larger
+sense that its users can use it in the same way, and expect largely the
+same behaviors from it, regardless of the kind of system they are using
+at any particular time.
+
+This approach constrains the solutions @code{g77} can use to resolve
+conflicts between various camps of Fortran users.
+If these two camps disagree about what a particular construct should
+mean, @code{g77} cannot simply be changed to treat that particular construct as
+having one meaning without comment (such as a warning), lest the users
+expecting it to have the other meaning are unpleasantly surprised that
+their code misbehaves when executed.
+
+The use of the ASCII backslash character in character constants is
+an excellent (and still somewhat unresolved) example of this kind of
+controversy.
+@xref{Backslash in Constants}.
+Other examples are likely to arise in the future, as @code{g77} developers
+strive to improve its ability to accept an ever-wider variety of existing
+Fortran code without requiring significant modifications to said code.
+
+Development of GNU Fortran is further constrained by the desire
+to avoid requiring programmers to change their code.
+This is important because it allows programmers, administrators,
+and others to more faithfully evaluate and validate @code{g77}
+(as an overall product and as new versions are distributed)
+without having to support multiple versions of their programs
+so that they continue to work the same way on their existing
+systems (non-GNU perhaps, but possibly also earlier versions
+of @code{g77}).
+
+@node Standard Support
+@section ANSI FORTRAN 77 Standard Support
+@cindex ANSI FORTRAN 77 support
+@cindex standard support
+@cindex support for ANSI FORTRAN 77
+@cindex compatibility, FORTRAN 77
+@cindex FORTRAN 77 compatibility
+
+GNU Fortran supports ANSI FORTRAN 77 with the following caveats.
+In summary, the only ANSI FORTRAN 77 features @code{g77} doesn't
+support are those that are probably rarely used in actual code,
+some of which are explicitly disallowed by the Fortran 90 standard.
+
+@menu
+* No Passing External Assumed-length:: CHAR*(*) CFUNC restriction.
+* No Passing Dummy Assumed-length:: CHAR*(*) CFUNC restriction.
+* No Pathological Implied-DO:: No @samp{((@dots{}, I=@dots{}), I=@dots{})}.
+* No Useless Implied-DO:: No @samp{(A, I=1, 1)}.
+@end menu
+
+@node No Passing External Assumed-length
+@subsection No Passing External Assumed-length
+
+@code{g77} disallows passing of an external procedure
+as an actual argument if the procedure's
+type is declared @code{CHARACTER*(*)}. For example:
+
+@example
+CHARACTER*(*) CFUNC
+EXTERNAL CFUNC
+CALL FOO(CFUNC)
+END
+@end example
+
+@noindent
+It isn't clear whether the standard considers this conforming.
+
+@node No Passing Dummy Assumed-length
+@subsection No Passing Dummy Assumed-length
+
+@code{g77} disallows passing of a dummy procedure
+as an actual argument if the procedure's
+type is declared @code{CHARACTER*(*)}.
+
+@example
+SUBROUTINE BAR(CFUNC)
+CHARACTER*(*) CFUNC
+EXTERNAL CFUNC
+CALL FOO(CFUNC)
+END
+@end example
+
+@noindent
+It isn't clear whether the standard considers this conforming.
+
+@node No Pathological Implied-DO
+@subsection No Pathological Implied-DO
+
+The @code{DO} variable for an implied-@code{DO} construct in a
+@code{DATA} statement may not be used as the @code{DO} variable
+for an outer implied-@code{DO} construct. For example, this
+fragment is disallowed by @code{g77}:
+
+@smallexample
+DATA ((A(I, I), I= 1, 10), I= 1, 10) /@dots{}/
+@end smallexample
+
+@noindent
+This also is disallowed by Fortran 90, as it offers no additional
+capabilities and would have a variety of possible meanings.
+
+Note that it is @emph{very} unlikely that any production Fortran code
+tries to use this unsupported construct.
+
+@node No Useless Implied-DO
+@subsection No Useless Implied-DO
+
+An array element initializer in an implied-@code{DO} construct in a
+@code{DATA} statement must contain at least one reference to the @code{DO}
+variables of each outer implied-@code{DO} construct. For example,
+this fragment is disallowed by @code{g77}:
+
+@smallexample
+DATA (A, I= 1, 1) /1./
+@end smallexample
+
+@noindent
+This also is disallowed by Fortran 90, as FORTRAN 77's more permissive
+requirements offer no additional capabilities.
+However, @code{g77} doesn't necessarily diagnose all cases
+where this requirement is not met.
+
+Note that it is @emph{very} unlikely that any production Fortran code
+tries to use this unsupported construct.
+
+@node Conformance
+@section Conformance
+
+(The following information augments or overrides the information in
+Section 1.4 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 1 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+The definition of the GNU Fortran language is akin to that of
+the ANSI FORTRAN 77 language in that it does not generally require
+conforming implementations to diagnose cases where programs do
+not conform to the language.
+
+However, @code{g77} as a compiler is being developed in a way that
+is intended to enable it to diagnose such cases in an easy-to-understand
+manner.
+
+A program that conforms to the GNU Fortran language should, when
+compiled, linked, and executed using a properly installed @code{g77}
+system, perform as described by the GNU Fortran language definition.
+Reasons for different behavior include, among others:
+
+@itemize @bullet
+@item
+Use of resources (memory---heap, stack, and so on; disk space; CPU
+time; etc.) exceeds those of the system.
+
+@item
+Range and/or precision of calculations required by the program
+exceeds that of the system.
+
+@item
+Excessive reliance on behaviors that are system-dependent
+(non-portable Fortran code).
+
+@item
+Bugs in the program.
+
+@item
+Bug in @code{g77}.
+
+@item
+Bugs in the system.
+@end itemize
+
+Despite these ``loopholes'', the availability of a clear specification
+of the language of programs submitted to @code{g77}, as this document
+is intended to provide, is considered an important aspect of providing
+a robust, clean, predictable Fortran implementation.
+
+The definition of the GNU Fortran language, while having no special
+legal status, can therefore be viewed as a sort of contract, or agreement.
+This agreement says, in essence, ``if you write a program in this language,
+and run it in an environment (such as a @code{g77} system) that supports
+this language, the program should behave in a largely predictable way''.
+
+@node Notation Used
+@section Notation Used in This Chapter
+
+(The following information augments or overrides the information in
+Section 1.5 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 1 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+In this chapter, ``must'' denotes a requirement, ``may'' denotes permission,
+and ``must not'' and ``may not'' denote prohibition.
+Terms such as ``might'', ``should'', and ``can'' generally add little or
+nothing in the way of weight to the GNU Fortran language itself,
+but are used to explain or illustrate the language.
+
+For example:
+
+@display
+``The @code{FROBNITZ} statement must precede all executable
+statements in a program unit, and may not specify any dummy
+arguments. It may specify local or common variables and arrays.
+Its use should be limited to portions of the program designed to
+be non-portable and system-specific, because it might cause the
+containing program unit to behave quite differently on different
+systems.''
+@end display
+
+Insofar as the GNU Fortran language is specified,
+the requirements and permissions denoted by the above sample statement
+are limited to the placement of the statement and the kinds of
+things it may specify.
+The rest of the statement---the content regarding non-portable portions
+of the program and the differing behavior of program units containing
+the @code{FROBNITZ} statement---does not pertain the GNU Fortran
+language itself.
+That content offers advice and warnings about the @code{FROBNITZ}
+statement.
+
+@emph{Remember:} The GNU Fortran language definition specifies
+both what constitutes a valid GNU Fortran program and how,
+given such a program, a valid GNU Fortran implementation is
+to interpret that program.
+
+It is @emph{not} incumbent upon a valid GNU Fortran implementation
+to behave in any particular way, any consistent way, or any
+predictable way when it is asked to interpret input that is
+@emph{not} a valid GNU Fortran program.
+
+Such input is said to have @dfn{undefined} behavior when
+interpreted by a valid GNU Fortran implementation, though
+an implementation may choose to specify behaviors for some
+cases of inputs that are not valid GNU Fortran programs.
+
+Other notation used herein is that of the GNU texinfo format,
+which is used to generate printed hardcopy, on-line hypertext
+(Info), and on-line HTML versions, all from a single source
+document.
+This notation is used as follows:
+
+@itemize @bullet
+@item
+Keywords defined by the GNU Fortran language are shown
+in uppercase, as in: @code{COMMON}, @code{INTEGER}, and
+@code{BLOCK DATA}.
+
+Note that, in practice, many Fortran programs are written
+in lowercase---uppercase is used in this manual as a
+means to readily distinguish keywords and sample Fortran-related
+text from the prose in this document.
+
+@item
+Portions of actual sample program, input, or output text
+look like this: @samp{Actual program text}.
+
+Generally, uppercase is used for all Fortran-specific and
+Fortran-related text, though this does not always include
+literal text within Fortran code.
+
+For example: @samp{PRINT *, 'My name is Bob'}.
+
+@item
+A metasyntactic variable---that is, a name used in this document
+to serve as a placeholder for whatever text is used by the
+user or programmer--appears as shown in the following example:
+
+``The @code{INTEGER @var{ivar}} statement specifies that
+@var{ivar} is a variable or array of type @code{INTEGER}.''
+
+In the above example, any valid text may be substituted for
+the metasyntactic variable @var{ivar} to make the statement
+apply to a specific instance, as long as the same text is
+substituted for @emph{both} occurrences of @var{ivar}.
+
+@item
+Ellipses (``@dots{}'') are used to indicate further text that
+is either unimportant or expanded upon further, elsewhere.
+
+@item
+Names of data types are in the style of Fortran 90, in most
+cases.
+
+@xref{Kind Notation}, for information on the relationship
+between Fortran 90 nomenclature (such as @code{INTEGER(KIND=1)})
+and the more traditional, less portably concise nomenclature
+(such as @code{INTEGER*4}).
+@end itemize
+
+@node Terms and Concepts
+@section Fortran Terms and Concepts
+
+(The following information augments or overrides the information in
+Chapter 2 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 2 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* Syntactic Items::
+* Statements Comments Lines::
+* Scope of Names and Labels::
+@end menu
+
+@node Syntactic Items
+@subsection Syntactic Items
+
+(Corresponds to Section 2.2 of ANSI X3.9-1978 FORTRAN 77.)
+
+In GNU Fortran, a symbolic name is at least one character long,
+and has no arbitrary upper limit on length.
+However, names of entities requiring external linkage (such as
+external functions, external subroutines, and @code{COMMON} areas)
+might be restricted to some arbitrary length by the system.
+Such a restriction is no more constrained than that of one
+through six characters.
+
+Underscores (@samp{_}) are accepted in symbol names after the first
+character (which must be a letter).
+
+@node Statements Comments Lines
+@subsection Statements, Comments, and Lines
+
+(Corresponds to Section 2.3 of ANSI X3.9-1978 FORTRAN 77.)
+
+@cindex comments, trailing
+@cindex trailing comments
+Use of an exclamation point (@samp{!}) to begin a
+trailing comment (a comment that extends to the end of the same
+source line) is permitted under the following conditions:
+
+@itemize @bullet
+@item
+The exclamation point does not appear in column 6.
+Otherwise, it is treated as an indicator of a continuation
+line.
+
+@item
+The exclamation point appears outside a character or hollerith
+constant.
+Otherwise, the exclamation point is considered part of the
+constant.
+
+@item
+The exclamation point appears to the left of any other possible
+trailing comment.
+That is, a trailing comment may contain exclamation points
+in their commentary text.
+@end itemize
+
+@cindex semicolons
+@cindex statements, separated by semicolon
+Use of a semicolon (@samp{;}) as a statement separator
+is permitted under the following conditions:
+
+@itemize @bullet
+@item
+The semicolon appears outside a character or hollerith
+constant.
+Otherwise, the semicolon is considered part of the
+constant.
+
+@item
+The semicolon appears to the left of a trailing comment.
+Otherwise, the semicolon is considered part of that
+comment.
+
+@item
+Neither a logical @code{IF} statement nor a non-construct
+@code{WHERE} statement (a Fortran 90 feature) may be
+followed (in the same, possibly continued, line) by
+a semicolon used as a statement separator.
+
+This restriction avoids the confusion
+that can result when reading a line such as:
+
+@smallexample
+IF (VALIDP) CALL FOO; CALL BAR
+@end smallexample
+
+@noindent
+Some readers might think the @samp{CALL BAR} is executed
+only if @samp{VALIDP} is @code{.TRUE.}, while others might
+assume its execution is unconditional.
+
+(At present, @code{g77} does not diagnose code that
+violates this restriction.)
+@end itemize
+
+@node Scope of Names and Labels
+@subsection Scope of Symbolic Names and Statement Labels
+@cindex scope
+
+(Corresponds to Section 2.9 of ANSI X3.9-1978 FORTRAN 77.)
+
+Included in the list of entities that have a scope of a
+program unit are construct names (a Fortran 90 feature).
+@xref{Construct Names}, for more information.
+
+@node Characters Lines Sequence
+@section Characters, Lines, and Execution Sequence
+
+(The following information augments or overrides the information in
+Chapter 3 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 3 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* Character Set::
+* Lines::
+* Continuation Line::
+* Statements::
+* Statement Labels::
+* Order::
+* INCLUDE::
+@end menu
+
+@node Character Set
+@subsection GNU Fortran Character Set
+@cindex characters
+
+(Corresponds to Section 3.1 of ANSI X3.9-1978 FORTRAN 77.)
+
+Letters include uppercase letters (the twenty-six characters
+of the English alphabet) and lowercase letters (their lowercase
+equivalent).
+Generally, lowercase letters may be used in place of uppercase
+letters, though in character and hollerith constants, they
+are distinct.
+
+Special characters include:
+
+@itemize @bullet
+@item
+Semicolon (@samp{;})
+
+@item
+Exclamation point (@samp{!})
+
+@item
+Double quote (@samp{"})
+
+@item
+Backslash (@samp{\})
+
+@item
+Question mark (@samp{?})
+
+@item
+Hash mark (@samp{#})
+
+@item
+Ampersand (@samp{&})
+
+@item
+Percent sign (@samp{%})
+
+@item
+Underscore (@samp{_})
+
+@item
+Open angle (@samp{<})
+
+@item
+Close angle (@samp{>})
+
+@item
+The FORTRAN 77 special characters (@key{SPC}, @samp{=},
+@samp{+}, @samp{-}, @samp{*}, @samp{/}, @samp{(},
+@samp{)}, @samp{,}, @samp{.}, @samp{$}, @samp{'},
+and @samp{:})
+@end itemize
+
+@cindex blanks (spaces)
+Note that this document refers to @key{SPC} as @dfn{space},
+while X3.9-1978 FORTRAN 77 refers to it as @dfn{blank}.
+
+@node Lines
+@subsection Lines
+@cindex lines
+@cindex source file format
+@cindex source form
+@cindex files, source
+@cindex source code
+@cindex code, source
+@cindex fixed form
+@cindex free form
+
+(Corresponds to Section 3.2 of ANSI X3.9-1978 FORTRAN 77.)
+
+The way a Fortran compiler views source files depends entirely on the
+implementation choices made for the compiler, since those choices
+are explicitly left to the implementation by the published Fortran
+standards.
+
+The GNU Fortran language mandates a view applicable to UNIX-like
+text files---files that are made up of an arbitrary number of lines,
+each with an arbitrary number of characters (sometimes called stream-based
+files).
+
+This view does not apply to types of files that are specified as
+having a particular number of characters on every single line (sometimes
+referred to as record-based files).
+
+Because a ``line in a program unit is a sequence of 72 characters'',
+to quote X3.9-1978, the GNU Fortran language specifies that a
+stream-based text file is translated to GNU Fortran lines as follows:
+
+@itemize @bullet
+@item
+A newline in the file is the character that represents the end of
+a line of text to the underlying system.
+For example, on ASCII-based systems, a newline is the @key{NL}
+character, which has ASCII value 12 (decimal).
+
+@item
+Each newline in the file serves to end the line of text that precedes
+it (and that does not contain a newline).
+
+@item
+The end-of-file marker (@code{EOF}) also serves to end the line
+of text that precedes it (and that does not contain a newline).
+
+@item
+@cindex blanks (spaces)
+Any line of text that is shorter than 72 characters is padded to that length
+with spaces (called ``blanks'' in the standard).
+
+@item
+Any line of text that is longer than 72 characters is truncated to that
+length, but the truncated remainder must consist entirely of spaces.
+
+@item
+Characters other than newline and the GNU Fortran character set
+are invalid.
+@end itemize
+
+For the purposes of the remainder of this description of the GNU
+Fortran language, the translation described above has already
+taken place, unless otherwise specified.
+
+The result of the above translation is that the source file appears,
+in terms of the remainder of this description of the GNU Fortran language,
+as if it had an arbitrary
+number of 72-character lines, each character being among the GNU Fortran
+character set.
+
+For example, if the source file itself has two newlines in a row,
+the second newline becomes, after the above translation, a single
+line containing 72 spaces.
+
+@node Continuation Line
+@subsection Continuation Line
+@cindex continuation lines, number of
+@cindex lines, continuation
+@cindex number of continuation lines
+@cindex limits on continuation lines
+
+(Corresponds to Section 3.2.3 of ANSI X3.9-1978 FORTRAN 77.)
+
+A continuation line is any line that both
+
+@itemize @bullet
+@item
+Contains a continuation character, and
+
+@item
+Contains only spaces in columns 1 through 5
+@end itemize
+
+A continuation character is any character of the GNU Fortran character set
+other than space (@key{SPC}) or zero (@samp{0})
+in column 6, or a digit (@samp{0} through @samp{9}) in column
+7 through 72 of a line that has only spaces to the left of that
+digit.
+
+The continuation character is ignored as far as the content of
+the statement is concerned.
+
+The GNU Fortran language places no limit on the number of
+continuation lines in a statement.
+In practice, the limit depends on a variety of factors, such as
+available memory, statement content, and so on, but no
+GNU Fortran system may impose an arbitrary limit.
+
+@node Statements
+@subsection Statements
+
+(Corresponds to Section 3.3 of ANSI X3.9-1978 FORTRAN 77.)
+
+Statements may be written using an arbitrary number of continuation
+lines.
+
+Statements may be separated using the semicolon (@samp{;}), except
+that the logical @code{IF} and non-construct @code{WHERE} statements
+may not be separated from subsequent statements using only a semicolon
+as statement separator.
+
+The @code{END PROGRAM}, @code{END SUBROUTINE}, @code{END FUNCTION},
+and @code{END BLOCK DATA} statements are alternatives to the @code{END}
+statement.
+These alternatives may be written as normal statements---they are not
+subject to the restrictions of the @code{END} statement.
+
+However, no statement other than @code{END} may have an initial line
+that appears to be an @code{END} statement---even @code{END PROGRAM},
+for example, must not be written as:
+
+@example
+ END
+ &PROGRAM
+@end example
+
+@node Statement Labels
+@subsection Statement Labels
+
+(Corresponds to Section 3.4 of ANSI X3.9-1978 FORTRAN 77.)
+
+A statement separated from its predecessor via a semicolon may be
+labeled as follows:
+
+@itemize @bullet
+@item
+The semicolon is followed by the label for the statement,
+which in turn follows the label.
+
+@item
+The label must be no more than five digits in length.
+
+@item
+The first digit of the label for the statement is not
+the first non-space character on a line.
+Otherwise, that character is treated as a continuation
+character.
+@end itemize
+
+A statement may have only one label defined for it.
+
+@node Order
+@subsection Order of Statements and Lines
+
+(Corresponds to Section 3.5 of ANSI X3.9-1978 FORTRAN 77.)
+
+Generally, @code{DATA} statements may precede executable statements.
+However, specification statements pertaining to any entities
+initialized by a @code{DATA} statement must precede that @code{DATA}
+statement.
+For example,
+after @samp{DATA I/1/}, @samp{INTEGER I} is not permitted, but
+@samp{INTEGER J} is permitted.
+
+The last line of a program unit may be an @code{END} statement,
+or may be:
+
+@itemize @bullet
+@item
+An @code{END PROGRAM} statement, if the program unit is a main program.
+
+@item
+An @code{END SUBROUTINE} statement, if the program unit is a subroutine.
+
+@item
+An @code{END FUNCTION} statement, if the program unit is a function.
+
+@item
+An @code{END BLOCK DATA} statement, if the program unit is a block data.
+@end itemize
+
+@node INCLUDE
+@subsection Including Source Text
+@cindex INCLUDE
+
+Additional source text may be included in the processing of
+the source file via the @code{INCLUDE} directive:
+
+@example
+INCLUDE @var{filename}
+@end example
+
+@noindent
+The source text to be included is identified by @var{filename},
+which is a literal GNU Fortran character constant.
+The meaning and interpretation of @var{filename} depends on the
+implementation, but typically is a filename.
+
+(@code{g77} treats it as a filename that it searches for
+in the current directory and/or directories specified
+via the @samp{-I} command-line option.)
+
+The effect of the @code{INCLUDE} directive is as if the
+included text directly replaced the directive in the source
+file prior to interpretation of the program.
+Included text may itself use @code{INCLUDE}.
+The depth of nested @code{INCLUDE} references depends on
+the implementation, but typically is a positive integer.
+
+This virtual replacement treats the statements and @code{INCLUDE}
+directives in the included text as syntactically distinct from
+those in the including text.
+
+Therefore, the first non-comment line of the included text
+must not be a continuation line.
+The included text must therefore have, after the non-comment
+lines, either an initial line (statement), an @code{INCLUDE}
+directive, or nothing (the end of the included text).
+
+Similarly, the including text may end the @code{INCLUDE}
+directive with a semicolon or the end of the line, but it
+cannot follow an @code{INCLUDE} directive at the end of its
+line with a continuation line.
+Thus, the last statement in an included text may not be
+continued.
+
+Any statements between two @code{INCLUDE} directives on the
+same line are treated as if they appeared in between the
+respective included texts.
+For example:
+
+@smallexample
+INCLUDE 'A'; PRINT *, 'B'; INCLUDE 'C'; END PROGRAM
+@end smallexample
+
+@noindent
+If the text included by @samp{INCLUDE 'A'} constitutes
+a @samp{PRINT *, 'A'} statement and the text included by
+@samp{INCLUDE 'C'} constitutes a @samp{PRINT *, 'C'} statement,
+then the output of the above sample program would be
+
+@example
+A
+B
+C
+@end example
+
+@noindent
+(with suitable allowances for how an implementation defines
+its handling of output).
+
+Included text must not include itself directly or indirectly,
+regardless of whether the @var{filename} used to reference
+the text is the same.
+
+Note that @code{INCLUDE} is @emph{not} a statement.
+As such, it is neither a non-executable or executable
+statement.
+However, if the text it includes constitutes one or more
+executable statements, then the placement of @code{INCLUDE}
+is subject to effectively the same restrictions as those
+on executable statements.
+
+An @code{INCLUDE} directive may be continued across multiple
+lines as if it were a statement.
+This permits long names to be used for @var{filename}.
+
+@node Data Types and Constants
+@section Data Types and Constants
+
+(The following information augments or overrides the information in
+Chapter 4 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 4 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+To more concisely express the appropriate types for
+entities, this document uses the more concise
+Fortran 90 nomenclature such as @code{INTEGER(KIND=1)}
+instead of the more traditional, but less portably concise,
+byte-size-based nomenclature such as @code{INTEGER*4},
+wherever reasonable.
+
+When referring to generic types---in contexts where the
+specific precision and range of a type are not important---this
+document uses the generic type names @code{INTEGER}, @code{LOGICAL},
+@code{REAL}, @code{COMPLEX}, and @code{CHARACTER}.
+
+In some cases, the context requires specification of a
+particular type.
+This document uses the @samp{KIND=} notation to accomplish
+this throughout, sometimes supplying the more traditional
+notation for clarification, though the traditional notation
+might not work the same way on all GNU Fortran implementations.
+
+Use of @samp{KIND=} makes this document more concise because
+@code{g77} is able to define values for @samp{KIND=} that
+have the same meanings on all systems, due to the way the
+Fortran 90 standard specifies these values are to be used.
+
+(In particular, that standard permits an implementation to
+arbitrarily assign nonnegative values.
+There are four distinct sets of assignments: one to the @code{CHARACTER}
+type; one to the @code{INTEGER} type; one to the @code{LOGICAL} type;
+and the fourth to both the @code{REAL} and @code{COMPLEX} types.
+Implementations are free to assign these values in any order,
+leave gaps in the ordering of assignments, and assign more than
+one value to a representation.)
+
+This makes @samp{KIND=} values superior to the values used
+in non-standard statements such as @samp{INTEGER*4}, because
+the meanings of the values in those statements vary from machine
+to machine, compiler to compiler, even operating system to
+operating system.
+
+However, use of @samp{KIND=} is @emph{not} generally recommended
+when writing portable code (unless, for example, the code is
+going to be compiled only via @code{g77}, which is a widely
+ported compiler).
+GNU Fortran does not yet have adequate language constructs to
+permit use of @samp{KIND=} in a fashion that would make the
+code portable to Fortran 90 implementations; and, this construct
+is known to @emph{not} be accepted by many popular FORTRAN 77
+implementations, so it cannot be used in code that is to be ported
+to those.
+
+The distinction here is that this document is able to use
+specific values for @samp{KIND=} to concisely document the
+types of various operations and operands.
+
+A Fortran program should use the FORTRAN 77 designations for the
+appropriate GNU Fortran types---such as @code{INTEGER} for
+@code{INTEGER(KIND=1)}, @code{REAL} for @code{REAL(KIND=1)},
+and @code{DOUBLE COMPLEX} for @code{COMPLEX(KIND=2)}---and,
+where no such designations exist, make use of appropriate
+techniques (preprocessor macros, parameters, and so on)
+to specify the types in a fashion that may be easily adjusted
+to suit each particular implementation to which the program
+is ported.
+(These types generally won't need to be adjusted for ports of
+@code{g77}.)
+
+Further details regarding GNU Fortran data types and constants
+are provided below.
+
+@menu
+* Types::
+* Constants::
+* Integer Type::
+* Character Type::
+@end menu
+
+@node Types
+@subsection Data Types
+
+(Corresponds to Section 4.1 of ANSI X3.9-1978 FORTRAN 77.)
+
+GNU Fortran supports these types:
+
+@enumerate
+@item
+Integer (generic type @code{INTEGER})
+
+@item
+Real (generic type @code{REAL})
+
+@item
+Double precision
+
+@item
+Complex (generic type @code{COMPLEX})
+
+@item
+Logical (generic type @code{LOGICAL})
+
+@item
+Character (generic type @code{CHARACTER})
+
+@item
+Double Complex
+@end enumerate
+
+(The types numbered 1 through 6 above are standard FORTRAN 77 types.)
+
+The generic types shown above are referred to in this document
+using only their generic type names.
+Such references usually indicate that any specific type (kind)
+of that generic type is valid.
+
+For example, a context described in this document as accepting
+the @code{COMPLEX} type also is likely to accept the
+@code{DOUBLE COMPLEX} type.
+
+The GNU Fortran language supports three ways to specify
+a specific kind of a generic type.
+
+@menu
+* Double Notation:: As in @code{DOUBLE COMPLEX}.
+* Star Notation:: As in @code{INTEGER*4}.
+* Kind Notation:: As in @code{INTEGER(KIND=1)}.
+@end menu
+
+@node Double Notation
+@subsubsection Double Notation
+
+The GNU Fortran language supports two uses of the keyword
+@code{DOUBLE} to specify a specific kind of type:
+
+@itemize @bullet
+@item
+@code{DOUBLE PRECISION}, equivalent to @code{REAL(KIND=2)}
+
+@item
+@code{DOUBLE COMPLEX}, equivalent to @code{COMPLEX(KIND=2)}
+@end itemize
+
+Use one of the above forms where a type name is valid.
+
+While use of this notation is popular, it doesn't scale
+well in a language or dialect rich in intrinsic types,
+as is the case for the GNU Fortran language (especially
+planned future versions of it).
+
+After all, one rarely sees type names such as @samp{DOUBLE INTEGER},
+@samp{QUADRUPLE REAL}, or @samp{QUARTER INTEGER}.
+Instead, @code{INTEGER*8}, @code{REAL*16}, and @code{INTEGER*1}
+often are substituted for these, respectively, even though they
+do not always have the same meanings on all systems.
+(And, the fact that @samp{DOUBLE REAL} does not exist as such
+is an inconsistency.)
+
+Therefore, this document uses ``double notation'' only on occasion
+for the benefit of those readers who are accustomed to it.
+
+@node Star Notation
+@subsubsection Star Notation
+@cindex *@var{n} notation
+
+The following notation specifies the storage size for a type:
+
+@smallexample
+@var{generic-type}*@var{n}
+@end smallexample
+
+@noindent
+@var{generic-type} must be a generic type---one of
+@code{INTEGER}, @code{REAL}, @code{COMPLEX}, @code{LOGICAL},
+or @code{CHARACTER}.
+@var{n} must be one or more digits comprising a decimal
+integer number greater than zero.
+
+Use the above form where a type name is valid.
+
+The @samp{*@var{n}} notation specifies that the amount of storage
+occupied by variables and array elements of that type is @var{n}
+times the storage occupied by a @code{CHARACTER*1} variable.
+
+This notation might indicate a different degree of precision and/or
+range for such variables and array elements, and the functions that
+return values of types using this notation.
+It does not limit the precision or range of values of that type
+in any particular way---use explicit code to do that.
+
+Further, the GNU Fortran language requires no particular values
+for @var{n} to be supported by an implementation via the @samp{*@var{n}}
+notation.
+@code{g77} supports @code{INTEGER*1} (as @code{INTEGER(KIND=3)})
+on all systems, for example,
+but not all implementations are required to do so, and @code{g77}
+is known to not support @code{REAL*1} on most (or all) systems.
+
+As a result, except for @var{generic-type} of @code{CHARACTER},
+uses of this notation should be limited to isolated
+portions of a program that are intended to handle system-specific
+tasks and are expected to be non-portable.
+
+(Standard FORTRAN 77 supports the @samp{*@var{n}} notation for
+only @code{CHARACTER}, where it signifies not only the amount
+of storage occupied, but the number of characters in entities
+of that type.
+However, almost all Fortran compilers have supported this
+notation for generic types, though with a variety of meanings
+for @var{n}.)
+
+Specifications of types using the @samp{*@var{n}} notation
+always are interpreted as specifications of the appropriate
+types described in this document using the @samp{KIND=@var{n}}
+notation, described below.
+
+While use of this notation is popular, it doesn't serve well
+in the context of a widely portable dialect of Fortran, such as
+the GNU Fortran language.
+
+For example, even on one particular machine, two or more popular
+Fortran compilers might well disagree on the size of a type
+declared @code{INTEGER*2} or @code{REAL*16}.
+Certainly there
+is known to be disagreement over such things among Fortran
+compilers on @emph{different} systems.
+
+Further, this notation offers no elegant way to specify sizes
+that are not even multiples of the ``byte size'' typically
+designated by @code{INTEGER*1}.
+Use of ``absurd'' values (such as @code{INTEGER*1000}) would
+certainly be possible, but would perhaps be stretching the original
+intent of this notation beyond the breaking point in terms
+of widespread readability of documentation and code making use
+of it.
+
+Therefore, this document uses ``star notation'' only on occasion
+for the benefit of those readers who are accustomed to it.
+
+@node Kind Notation
+@subsubsection Kind Notation
+@cindex KIND= notation
+
+The following notation specifies the kind-type selector of a type:
+
+@smallexample
+@var{generic-type}(KIND=@var{n})
+@end smallexample
+
+@noindent
+Use the above form where a type name is valid.
+
+@var{generic-type} must be a generic type---one of
+@code{INTEGER}, @code{REAL}, @code{COMPLEX}, @code{LOGICAL},
+or @code{CHARACTER}.
+@var{n} must be an integer initialization expression that
+is a positive, nonzero value.
+
+Programmers are discouraged from writing these values directly
+into their code.
+Future versions of the GNU Fortran language will offer
+facilities that will make the writing of code portable
+to @code{g77} @emph{and} Fortran 90 implementations simpler.
+
+However, writing code that ports to existing FORTRAN 77
+implementations depends on avoiding the @samp{KIND=} construct.
+
+The @samp{KIND=} construct is thus useful in the context
+of GNU Fortran for two reasons:
+
+@itemize @bullet
+@item
+It provides a means to specify a type in a fashion that
+is portable across all GNU Fortran implementations (though
+not other FORTRAN 77 and Fortran 90 implementations).
+
+@item
+It provides a sort of Rosetta stone for this document to use
+to concisely describe the types of various operations and
+operands.
+@end itemize
+
+The values of @var{n} in the GNU Fortran language are
+assigned using a scheme that:
+
+@itemize @bullet
+@item
+Attempts to maximize the ability of readers
+of this document to quickly familiarize themselves
+with assignments for popular types
+
+@item
+Provides a unique value for each specific desired
+meaning
+
+@item
+Provides a means to automatically assign new values so
+they have a ``natural'' relationship to existing values,
+if appropriate, or, if no such relationship exists, will
+not interfere with future values assigned on the basis
+of such relationships
+
+@item
+Avoids using values that are similar to values used
+in the existing, popular @samp{*@var{n}} notation,
+to prevent readers from expecting that these implied
+correspondences work on all GNU Fortran implementations
+@end itemize
+
+The assignment system accomplishes this by assigning
+to each ``fundamental meaning'' of a specific type a
+unique prime number.
+Combinations of fundamental meanings---for example, a type
+that is two times the size of some other type---are assigned
+values of @var{n} that are the products of the values for
+those fundamental meanings.
+
+A prime value of @var{n} is never given more than one fundamental
+meaning, to avoid situations where some code or system
+cannot reasonably provide those meanings in the form of a
+single type.
+
+The values of @var{n} assigned so far are:
+
+@table @code
+@item KIND=0
+This value is reserved for future use.
+
+The planned future use is for this value to designate,
+explicitly, context-sensitive kind-type selection.
+For example, the expression @samp{1D0 * 0.1_0} would
+be equivalent to @samp{1D0 * 0.1D0}.
+
+@item KIND=1
+This corresponds to the default types for
+@code{REAL}, @code{INTEGER}, @code{LOGICAL}, @code{COMPLEX},
+and @code{CHARACTER}, as appropriate.
+
+These are the ``default'' types described in the Fortran 90 standard,
+though that standard does not assign any particular @samp{KIND=}
+value to these types.
+
+(Typically, these are @code{REAL*4}, @code{INTEGER*4},
+@code{LOGICAL*4}, and @code{COMPLEX*8}.)
+
+@item KIND=2
+This corresponds to types that occupy twice as much
+storage as the default types.
+@code{REAL(KIND=2)} is @code{DOUBLE PRECISION} (typically @code{REAL*8}),
+@code{COMPLEX(KIND=2)} is @code{DOUBLE COMPLEX} (typically @code{COMPLEX*16}),
+
+These are the ``double precision'' types described in the Fortran 90
+standard,
+though that standard does not assign any particular @samp{KIND=}
+value to these types.
+
+@var{n} of 4 thus corresponds to types that occupy four times
+as much storage as the default types, @var{n} of 8 to types that
+occupy eight times as much storage, and so on.
+
+The @code{INTEGER(KIND=2)} and @code{LOGICAL(KIND=2)} types
+are not necessarily supported by every GNU Fortran implementation.
+
+@item KIND=3
+This corresponds to types that occupy as much
+storage as the default @code{CHARACTER} type,
+which is the same effective type as @code{CHARACTER(KIND=1)}
+(making that type effectively the same as @code{CHARACTER(KIND=3)}).
+
+(Typically, these are @code{INTEGER*1} and @code{LOGICAL*1}.)
+
+@var{n} of 6 thus corresponds to types that occupy twice as
+much storage as the @var{n}=3 types, @var{n} of 12 to types
+that occupy four times as much storage, and so on.
+
+These are not necessarily supported by every GNU Fortran
+implementation.
+
+@item KIND=5
+This corresponds to types that occupy half the
+storage as the default (@var{n}=1) types.
+
+(Typically, these are @code{INTEGER*2} and @code{LOGICAL*2}.)
+
+@var{n} of 25 thus corresponds to types that occupy one-quarter
+as much storage as the default types.
+
+These are not necessarily supported by every GNU Fortran
+implementation.
+
+@item KIND=7
+This is valid only as @code{INTEGER(KIND=7)} and
+denotes the @code{INTEGER} type that has the smallest
+storage size that holds a pointer on the system.
+
+A pointer representable by this type is capable of uniquely
+addressing a @code{CHARACTER*1} variable, array, array element,
+or substring.
+
+(Typically this is equivalent to @code{INTEGER*4} or,
+on 64-bit systems, @code{INTEGER*8}.
+In a compatible C implementation, it typically would
+be the same size and semantics of the C type @code{void *}.)
+@end table
+
+Note that these are @emph{proposed} correspondences and might change
+in future versions of @code{g77}---avoid writing code depending
+on them while @code{g77}, and therefore the GNU Fortran language
+it defines, is in beta testing.
+
+Values not specified in the above list are reserved to
+future versions of the GNU Fortran language.
+
+Implementation-dependent meanings will be assigned new,
+unique prime numbers so as to not interfere with other
+implementation-dependent meanings, and offer the possibility
+of increasing the portability of code depending on such
+types by offering support for them in other GNU Fortran
+implementations.
+
+Other meanings that might be given unique values are:
+
+@itemize @bullet
+@item
+Types that make use of only half their storage size for
+representing precision and range.
+
+For example, some compilers offer options that cause
+@code{INTEGER} types to occupy the amount of storage
+that would be needed for @code{INTEGER(KIND=2)} types, but the
+range remains that of @code{INTEGER(KIND=1)}.
+
+@item
+The IEEE single floating-point type.
+
+@item
+Types with a specific bit pattern (endianness), such as the
+little-endian form of @code{INTEGER(KIND=1)}.
+These could permit, conceptually, use of portable code and
+implementations on data files written by existing systems.
+@end itemize
+
+Future @emph{prime} numbers should be given meanings in as incremental
+a fashion as possible, to allow for flexibility and
+expressiveness in combining types.
+
+For example, instead of defining a prime number for little-endian
+IEEE doubles, one prime number might be assigned the meaning
+``little-endian'', another the meaning ``IEEE double'', and the
+value of @var{n} for a little-endian IEEE double would thus
+naturally be the product of those two respective assigned values.
+(It could even be reasonable to have IEEE values result from the
+products of prime values denoting exponent and fraction sizes
+and meanings, hidden bit usage, availability and representations
+of special values such as subnormals, infinities, and Not-A-Numbers
+(NaNs), and so on.)
+
+This assignment mechanism, while not inherently required for
+future versions of the GNU Fortran language, is worth using
+because it could ease management of the ``space'' of supported
+types much easier in the long run.
+
+The above approach suggests a mechanism for specifying inheritance
+of intrinsic (built-in) types for an entire, widely portable
+product line.
+It is certainly reasonable that, unlike programmers of other languages
+offering inheritance mechanisms that employ verbose names for classes
+and subclasses, along with graphical browsers to elucidate the
+relationships, Fortran programmers would employ
+a mechanism that works by multiplying prime numbers together
+and finding the prime factors of such products.
+
+Most of the advantages for the above scheme have been explained
+above.
+One disadvantage is that it could lead to the defining,
+by the GNU Fortran language, of some fairly large prime numbers.
+This could lead to the GNU Fortran language being declared
+``munitions'' by the United States Department of Defense.
+
+@node Constants
+@subsection Constants
+@cindex constants
+@cindex types, constants
+
+(Corresponds to Section 4.2 of ANSI X3.9-1978 FORTRAN 77.)
+
+A @dfn{typeless constant} has one of the following forms:
+
+@smallexample
+'@var{binary-digits}'B
+'@var{octal-digits}'O
+'@var{hexadecimal-digits}'Z
+'@var{hexadecimal-digits}'X
+@end smallexample
+
+@noindent
+@var{binary-digits}, @var{octal-digits}, and @var{hexadecimal-digits}
+are nonempty strings of characters in the set @samp{01}, @samp{01234567},
+and @samp{0123456789ABCDEFabcdef}, respectively.
+(The value for @samp{A} (and @samp{a}) is 10, for @samp{B} and @samp{b}
+is 11, and so on.)
+
+Typeless constants have values that depend on the context in which
+they are used.
+
+All other constants, called @dfn{typed constants}, are interpreted---converted
+to internal form---according to their inherent type.
+Thus, context is @emph{never} a determining factor for the type, and hence
+the interpretation, of a typed constant.
+(All constants in the ANSI FORTRAN 77 language are typed constants.)
+
+For example, @samp{1} is always type @code{INTEGER(KIND=1)} in GNU
+Fortran (called default INTEGER in Fortran 90),
+@samp{9.435784839284958} is always type @code{REAL(KIND=1)} (even if the
+additional precision specified is lost, and even when used in a
+@code{REAL(KIND=2)} context), @samp{1E0} is always type @code{REAL(KIND=2)},
+and @samp{1D0} is always type @code{REAL(KIND=2)}.
+
+@node Integer Type
+@subsection Integer Type
+
+(Corresponds to Section 4.3 of ANSI X3.9-1978 FORTRAN 77.)
+
+An integer constant also may have one of the following forms:
+
+@smallexample
+B'@var{binary-digits}'
+O'@var{octal-digits}'
+Z'@var{hexadecimal-digits}'
+X'@var{hexadecimal-digits}'
+@end smallexample
+
+@noindent
+@var{binary-digits}, @var{octal-digits}, and @var{hexadecimal-digits}
+are nonempty strings of characters in the set @samp{01}, @samp{01234567},
+and @samp{0123456789ABCDEFabcdef}, respectively.
+(The value for @samp{A} (and @samp{a}) is 10, for @samp{B} and @samp{b}
+is 11, and so on.)
+
+@node Character Type
+@subsection Character Type
+
+(Corresponds to Section 4.8 of ANSI X3.9-1978 FORTRAN 77.)
+
+A character constant may be delimited by a pair of double quotes
+(@samp{"}) instead of apostrophes.
+In this case, an apostrophe within the constant represents
+a single apostrophe, while a double quote is represented in
+the source text of the constant by two consecutive double
+quotes with no intervening spaces.
+
+@cindex zero-length CHARACTER
+@cindex null CHARACTER strings
+@cindex empty CHARACTER strings
+@cindex strings, empty
+@cindex CHARACTER, null
+A character constant may be empty (have a length of zero).
+
+A character constant may include a substring specification,
+The value of such a constant is the value of the substring---for
+example, the value of @samp{'hello'(3:5)} is the same
+as the value of @samp{'llo'}.
+
+@node Expressions
+@section Expressions
+
+(The following information augments or overrides the information in
+Chapter 6 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 6 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* %LOC()::
+@end menu
+
+@node %LOC()
+@subsection The @code{%LOC()} Construct
+@cindex %LOC() construct
+
+@example
+%LOC(@var{arg})
+@end example
+
+The @code{%LOC()} construct is an expression
+that yields the value of the location of its argument,
+@var{arg}, in memory.
+The size of the type of the expression depends on the system---typically,
+it is equivalent to either @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=2)},
+though it is actually type @code{INTEGER(KIND=7)}.
+
+The argument to @code{%LOC()} must be suitable as the
+left-hand side of an assignment statement.
+That is, it may not be a general expression involving
+operators such as addition, subtraction, and so on,
+nor may it be a constant.
+
+Use of @code{%LOC()} is recommended only for code that
+is accessing facilities outside of GNU Fortran, such as
+operating system or windowing facilities.
+It is best to constrain such uses to isolated portions of
+a program---portions that deal specifically and exclusively
+with low-level, system-dependent facilities.
+Such portions might well provide a portable interface for
+use by the program as a whole, but are themselves not
+portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+Do not depend on @code{%LOC()} returning a pointer that
+can be safely used to @emph{define} (change) the argument.
+While this might work in some circumstances, it is hard
+to predict whether it will continue to work when a program
+(that works using this unsafe behavior)
+is recompiled using different command-line options or
+a different version of @code{g77}.
+
+Generally, @code{%LOC()} is safe when used as an argument
+to a procedure that makes use of the value of the corresponding
+dummy argument only during its activation, and only when
+such use is restricted to referencing (reading) the value
+of the argument to @code{%LOC()}.
+
+@emph{Implementation Note:} Currently, @code{g77} passes
+arguments (those not passed using a construct such as @code{%VAL()})
+by reference or descriptor, depending on the type of
+the actual argument.
+Thus, given @samp{INTEGER I}, @samp{CALL FOO(I)} would
+seem to mean the same thing as @samp{CALL FOO(%LOC(I))}, and
+in fact might compile to identical code.
+
+However, @samp{CALL FOO(%LOC(I))} emphatically means ``pass the
+address of @samp{I} in memory''.
+While @samp{CALL FOO(I)} might use that same approach in a
+particular version of @code{g77}, another version or compiler
+might choose a different implementation, such as copy-in/copy-out,
+to effect the desired behavior---and which will therefore not
+necessarily compile to the same code as would @samp{CALL FOO(%LOC(I))}
+using the same version or compiler.
+
+@xref{Debugging and Interfacing}, for detailed information on
+how this particular version of @code{g77} implements various
+constructs.
+
+@node Specification Statements
+@section Specification Statements
+
+(The following information augments or overrides the information in
+Chapter 8 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 8 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* NAMELIST::
+* DOUBLE COMPLEX::
+@end menu
+
+@node NAMELIST
+@subsection @code{NAMELIST} Statement
+@cindex NAMELIST statement
+@cindex statements, NAMELIST
+
+The @code{NAMELIST} statement, and related I/O constructs, are
+supported by the GNU Fortran language in essentially the same
+way as they are by @code{f2c}.
+
+@node DOUBLE COMPLEX
+@subsection @code{DOUBLE COMPLEX} Statement
+@cindex DOUBLE COMPLEX
+
+@code{DOUBLE COMPLEX} is a type-statement (and type) that
+specifies the type @code{COMPLEX(KIND=2)} in GNU Fortran.
+
+@node Control Statements
+@section Control Statements
+
+(The following information augments or overrides the information in
+Chapter 11 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 11 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* DO WHILE::
+* END DO::
+* Construct Names::
+* CYCLE and EXIT::
+@end menu
+
+@node DO WHILE
+@subsection DO WHILE
+@cindex DO WHILE
+@cindex MIL-STD 1753
+
+The @code{DO WHILE} statement, a feature of both the MIL-STD 1753 and
+Fortran 90 standards, is provided by the GNU Fortran language.
+
+@node END DO
+@subsection END DO
+@cindex END DO
+@cindex MIL-STD 1753
+
+The @code{END DO} statement is provided by the GNU Fortran language.
+
+This statement is used in one of two ways:
+
+@itemize @bullet
+@item
+The Fortran 90 meaning, in which it specifies the termination
+point of a single @code{DO} loop started with a @code{DO} statement
+that specifies no termination label.
+
+@item
+The MIL-STD 1753 meaning, in which it specifies the termination
+point of one or more @code{DO} loops, all of which start with a
+@code{DO} statement that specify the label defined for the
+@code{END DO} statement.
+
+This kind of @code{END DO} statement is merely a synonym for
+@code{CONTINUE}, except it is permitted only when the statement
+is labeled and a target of one or more labeled @code{DO} loops.
+
+It is expected that this use of @code{END DO} will be removed from
+the GNU Fortran language in the future, though it is likely that
+it will long be supported by @code{g77} as a dialect form.
+@end itemize
+
+@node Construct Names
+@subsection Construct Names
+@cindex construct names
+
+The GNU Fortran language supports construct names as defined
+by the Fortran 90 standard.
+These names are local to the program unit and are defined
+as follows:
+
+@smallexample
+@var{construct-name}: @var{block-statement}
+@end smallexample
+
+@noindent
+Here, @var{construct-name} is the construct name itself;
+its definition is connoted by the single colon (@samp{:}); and
+@var{block-statement} is an @code{IF}, @code{DO},
+or @code{SELECT CASE} statement that begins a block.
+
+A block that is given a construct name must also specify the
+same construct name in its termination statement:
+
+@example
+END @var{block} @var{construct-name}
+@end example
+
+@noindent
+Here, @var{block} must be @code{IF}, @code{DO}, or @code{SELECT},
+as appropriate.
+
+@node CYCLE and EXIT
+@subsection The @code{CYCLE} and @code{EXIT} Statements
+
+The @code{CYCLE} and @code{EXIT} statements specify that
+the remaining statements in the current iteration of a
+particular active (enclosing) @code{DO} loop are to be skipped.
+
+@code{CYCLE} specifies that these statements are skipped,
+but the @code{END DO} statement that marks the end of the
+@code{DO} loop be executed---that is, the next iteration,
+if any, is to be started.
+If the statement marking the end of the @code{DO} loop is
+not @code{END DO}---in other words, if the loop is not
+a block @code{DO}---the @code{CYCLE} statement does not
+execute that statement, but does start the next iteration (if any).
+
+@code{EXIT} specifies that the loop specified by the
+@code{DO} construct is terminated.
+
+The @code{DO} loop affected by @code{CYCLE} and @code{EXIT}
+is the innermost enclosing @code{DO} loop when the following
+forms are used:
+
+@example
+CYCLE
+EXIT
+@end example
+
+Otherwise, the following forms specify the construct name
+of the pertinent @code{DO} loop:
+
+@example
+CYCLE @var{construct-name}
+EXIT @var{construct-name}
+@end example
+
+@code{CYCLE} and @code{EXIT} can be viewed as glorified @code{GO TO}
+statements.
+However, they cannot be easily thought of as @code{GO TO} statements
+in obscure cases involving FORTRAN 77 loops.
+For example:
+
+@smallexample
+ DO 10 I = 1, 5
+ DO 10 J = 1, 5
+ IF (J .EQ. 5) EXIT
+ DO 10 K = 1, 5
+ IF (K .EQ. 3) CYCLE
+10 PRINT *, 'I=', I, ' J=', J, ' K=', K
+20 CONTINUE
+@end smallexample
+
+@noindent
+In particular, neither the @code{EXIT} nor @code{CYCLE} statements
+above are equivalent to a @code{GO TO} statement to either label
+@samp{10} or @samp{20}.
+
+To understand the effect of @code{CYCLE} and @code{EXIT} in the
+above fragment, it is helpful to first translate it to its equivalent
+using only block @code{DO} loops:
+
+@smallexample
+ DO I = 1, 5
+ DO J = 1, 5
+ IF (J .EQ. 5) EXIT
+ DO K = 1, 5
+ IF (K .EQ. 3) CYCLE
+10 PRINT *, 'I=', I, ' J=', J, ' K=', K
+ END DO
+ END DO
+ END DO
+20 CONTINUE
+@end smallexample
+
+Adding new labels allows translation of @code{CYCLE} and @code{EXIT}
+to @code{GO TO} so they may be more easily understood by programmers
+accustomed to FORTRAN coding:
+
+@smallexample
+ DO I = 1, 5
+ DO J = 1, 5
+ IF (J .EQ. 5) GOTO 18
+ DO K = 1, 5
+ IF (K .EQ. 3) GO TO 12
+10 PRINT *, 'I=', I, ' J=', J, ' K=', K
+12 END DO
+ END DO
+18 END DO
+20 CONTINUE
+@end smallexample
+
+@noindent
+Thus, the @code{CYCLE} statement in the innermost loop skips over
+the @code{PRINT} statement as it begins the next iteration of the
+loop, while the @code{EXIT} statement in the middle loop ends that
+loop but @emph{not} the outermost loop.
+
+@node Functions and Subroutines
+@section Functions and Subroutines
+
+(The following information augments or overrides the information in
+Chapter 15 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 15 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* %VAL()::
+* %REF()::
+* %DESCR()::
+* Generics and Specifics::
+* REAL() and AIMAG() of Complex::
+* CMPLX() of DOUBLE PRECISION::
+* MIL-STD 1753::
+* f77/f2c Intrinsics::
+* Table of Intrinsic Functions::
+@end menu
+
+@node %VAL()
+@subsection The @code{%VAL()} Construct
+@cindex %VAL() construct
+
+@example
+%VAL(@var{arg})
+@end example
+
+The @code{%VAL()} construct specifies that an argument,
+@var{arg}, is to be passed by value, instead of by reference
+or descriptor.
+
+@code{%VAL()} is restricted to actual arguments in
+invocations of external procedures.
+
+Use of @code{%VAL()} is recommended only for code that
+is accessing facilities outside of GNU Fortran, such as
+operating system or windowing facilities.
+It is best to constrain such uses to isolated portions of
+a program---portions the deal specifically and exclusively
+with low-level, system-dependent facilities.
+Such portions might well provide a portable interface for
+use by the program as a whole, but are themselves not
+portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+@emph{Implementation Note:} Currently, @code{g77} passes
+all arguments either by reference or by descriptor.
+
+Thus, use of @code{%VAL()} tends to be restricted to cases
+where the called procedure is written in a language other
+than Fortran that supports call-by-value semantics.
+(C is an example of such a language.)
+
+@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)},
+for detailed information on
+how this particular version of @code{g77} passes arguments
+to procedures.
+
+@node %REF()
+@subsection The @code{%REF()} Construct
+@cindex %REF() construct
+
+@example
+%REF(@var{arg})
+@end example
+
+The @code{%REF()} construct specifies that an argument,
+@var{arg}, is to be passed by reference, instead of by
+value or descriptor.
+
+@code{%REF()} is restricted to actual arguments in
+invocations of external procedures.
+
+Use of @code{%REF()} is recommended only for code that
+is accessing facilities outside of GNU Fortran, such as
+operating system or windowing facilities.
+It is best to constrain such uses to isolated portions of
+a program---portions the deal specifically and exclusively
+with low-level, system-dependent facilities.
+Such portions might well provide a portable interface for
+use by the program as a whole, but are themselves not
+portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+Do not depend on @code{%REF()} supplying a pointer to the
+procedure being invoked.
+While that is a likely implementation choice, other
+implementation choices are available that preserve Fortran
+pass-by-reference semantics without passing a pointer to
+the argument, @var{arg}.
+(For example, a copy-in/copy-out implementation.)
+
+@emph{Implementation Note:} Currently, @code{g77} passes
+all arguments
+(other than variables and arrays of type @code{CHARACTER})
+by reference.
+Future versions of, or dialects supported by, @code{g77} might
+not pass @code{CHARACTER} functions by reference.
+
+Thus, use of @code{%REF()} tends to be restricted to cases
+where @var{arg} is type @code{CHARACTER} but the called
+procedure accesses it via a means other than the method
+used for Fortran @code{CHARACTER} arguments.
+
+@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)}, for detailed information on
+how this particular version of @code{g77} passes arguments
+to procedures.
+
+@node %DESCR()
+@subsection The @code{%DESCR()} Construct
+@cindex %DESCR() construct
+
+@example
+%DESCR(@var{arg})
+@end example
+
+The @code{%DESCR()} construct specifies that an argument,
+@var{arg}, is to be passed by descriptor, instead of by
+value or reference.
+
+@code{%DESCR()} is restricted to actual arguments in
+invocations of external procedures.
+
+Use of @code{%DESCR()} is recommended only for code that
+is accessing facilities outside of GNU Fortran, such as
+operating system or windowing facilities.
+It is best to constrain such uses to isolated portions of
+a program---portions the deal specifically and exclusively
+with low-level, system-dependent facilities.
+Such portions might well provide a portable interface for
+use by the program as a whole, but are themselves not
+portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+Do not depend on @code{%DESCR()} supplying a pointer
+and/or a length passed by value
+to the procedure being invoked.
+While that is a likely implementation choice, other
+implementation choices are available that preserve the
+pass-by-reference semantics without passing a pointer to
+the argument, @var{arg}.
+(For example, a copy-in/copy-out implementation.)@
+And, future versions of @code{g77} might change the
+way descriptors are implemented, such as passing a
+single argument pointing to a record containing the
+pointer/length information instead of passing that same
+information via two arguments as it currently does.
+
+@emph{Implementation Note:} Currently, @code{g77} passes
+all variables and arrays of type @code{CHARACTER}
+by descriptor.
+Future versions of, or dialects supported by, @code{g77} might
+pass @code{CHARACTER} functions by descriptor as well.
+
+Thus, use of @code{%DESCR()} tends to be restricted to cases
+where @var{arg} is not type @code{CHARACTER} but the called
+procedure accesses it via a means similar to the method
+used for Fortran @code{CHARACTER} arguments.
+
+@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)}, for detailed information on
+how this particular version of @code{g77} passes arguments
+to procedures.
+
+@node Generics and Specifics
+@subsection Generics and Specifics
+@cindex generic intrinsics
+@cindex intrinsics, generic
+
+The ANSI FORTRAN 77 language defines generic and specific
+intrinsics.
+In short, the distinctions are:
+
+@itemize @bullet
+@item
+@emph{Specific} intrinsics have
+specific types for their arguments and a specific return
+type.
+
+@item
+@emph{Generic} intrinsics are treated,
+on a case-by-case basis in the program's source code,
+as one of several possible specific intrinsics.
+
+Typically, a generic intrinsic has a return type that
+is determined by the type of one or more of its arguments.
+@end itemize
+
+The GNU Fortran language generalizes these concepts somewhat,
+especially by providing intrinsic subroutines and generic
+intrinsics that are treated as either a specific intrinsic subroutine
+or a specific intrinsic function (e.g. @code{SECOND}).
+
+However, GNU Fortran avoids generalizing this concept to
+the point where existing code would be accepted as meaning
+something possibly different than what was intended.
+
+For example, @code{ABS} is a generic intrinsic, so all working
+code written using @code{ABS} of an @code{INTEGER} argument
+expects an @code{INTEGER} return value.
+Similarly, all such code expects that @code{ABS} of an @code{INTEGER*2}
+argument returns an @code{INTEGER*2} return value.
+
+Yet, @code{IABS} is a @emph{specific} intrinsic that accepts only
+an @code{INTEGER(KIND=1)} argument.
+Code that passes something other than an @code{INTEGER(KIND=1)}
+argument to @code{IABS} is not valid GNU Fortran code, because
+it is not clear what the author intended.
+
+For example, if @samp{J} is @code{INTEGER(KIND=6)}, @samp{IABS(J)}
+is not defined by the GNU Fortran language, because the programmer
+might have used that construct to mean any of the following, subtly
+different, things:
+
+@itemize @bullet
+@item
+Convert @samp{J} to @code{INTEGER(KIND=1)} first
+(as if @samp{IABS(INT(J))} had been written).
+
+@item
+Convert the result of the intrinsic to @code{INTEGER(KIND=1)}
+(as if @samp{INT(ABS(J))} had been written).
+
+@item
+No conversion (as if @samp{ABS(J)} had been written).
+@end itemize
+
+The distinctions matter especially when types and values wider than
+@code{INTEGER(KIND=1)} (such as @code{INTEGER(KIND=2)}), or when
+operations performing more ``arithmetic'' than absolute-value, are involved.
+
+The following sample program is not a valid GNU Fortran program, but
+might be accepted by other compilers.
+If so, the output is likely to be revealing in terms of how a given
+compiler treats intrinsics (that normally are specific) when they
+are given arguments that do not conform to their stated requirements:
+
+@cindex JCB002 program
+@smallexample
+ PROGRAM JCB002
+C Version 1:
+C Modified 1997-05-21 (Burley) to accommodate compilers that implement
+C INT(I1-I2) as INT(I1)-INT(I2) given INTEGER*2 I1,I2.
+C
+C Version 0:
+C Written by James Craig Burley 1997-02-20.
+C Contact via Internet email: burley@@gnu.ai.mit.edu
+C
+C Purpose:
+C Determine how compilers handle non-standard IDIM
+C on INTEGER*2 operands, which presumably can be
+C extrapolated into understanding how the compiler
+C generally treats specific intrinsics that are passed
+C arguments not of the correct types.
+C
+C If your compiler implements INTEGER*2 and INTEGER
+C as the same type, change all INTEGER*2 below to
+C INTEGER*1.
+C
+ INTEGER*2 I0, I4
+ INTEGER I1, I2, I3
+ INTEGER*2 ISMALL, ILARGE
+ INTEGER*2 ITOOLG, ITWO
+ INTEGER*2 ITMP
+ LOGICAL L2, L3, L4
+C
+C Find smallest INTEGER*2 number.
+C
+ ISMALL=0
+ 10 I0 = ISMALL-1
+ IF ((I0 .GE. ISMALL) .OR. (I0+1 .NE. ISMALL)) GOTO 20
+ ISMALL = I0
+ GOTO 10
+ 20 CONTINUE
+C
+C Find largest INTEGER*2 number.
+C
+ ILARGE=0
+ 30 I0 = ILARGE+1
+ IF ((I0 .LE. ILARGE) .OR. (I0-1 .NE. ILARGE)) GOTO 40
+ ILARGE = I0
+ GOTO 30
+ 40 CONTINUE
+C
+C Multiplying by two adds stress to the situation.
+C
+ ITWO = 2
+C
+C Need a number that, added to -2, is too wide to fit in I*2.
+C
+ ITOOLG = ISMALL
+C
+C Use IDIM the straightforward way.
+C
+ I1 = IDIM (ILARGE, ISMALL) * ITWO + ITOOLG
+C
+C Calculate result for first interpretation.
+C
+ I2 = (INT (ILARGE) - INT (ISMALL)) * ITWO + ITOOLG
+C
+C Calculate result for second interpretation.
+C
+ ITMP = ILARGE - ISMALL
+ I3 = (INT (ITMP)) * ITWO + ITOOLG
+C
+C Calculate result for third interpretation.
+C
+ I4 = (ILARGE - ISMALL) * ITWO + ITOOLG
+C
+C Print results.
+C
+ PRINT *, 'ILARGE=', ILARGE
+ PRINT *, 'ITWO=', ITWO
+ PRINT *, 'ITOOLG=', ITOOLG
+ PRINT *, 'ISMALL=', ISMALL
+ PRINT *, 'I1=', I1
+ PRINT *, 'I2=', I2
+ PRINT *, 'I3=', I3
+ PRINT *, 'I4=', I4
+ PRINT *
+ L2 = (I1 .EQ. I2)
+ L3 = (I1 .EQ. I3)
+ L4 = (I1 .EQ. I4)
+ IF (L2 .AND. .NOT.L3 .AND. .NOT.L4) THEN
+ PRINT *, 'Interp 1: IDIM(I*2,I*2) => IDIM(INT(I*2),INT(I*2))'
+ STOP
+ END IF
+ IF (L3 .AND. .NOT.L2 .AND. .NOT.L4) THEN
+ PRINT *, 'Interp 2: IDIM(I*2,I*2) => INT(DIM(I*2,I*2))'
+ STOP
+ END IF
+ IF (L4 .AND. .NOT.L2 .AND. .NOT.L3) THEN
+ PRINT *, 'Interp 3: IDIM(I*2,I*2) => DIM(I*2,I*2)'
+ STOP
+ END IF
+ PRINT *, 'Results need careful analysis.'
+ END
+@end smallexample
+
+No future version of the GNU Fortran language
+will likely permit specific intrinsic invocations with wrong-typed
+arguments (such as @code{IDIM} in the above example), since
+it has been determined that disagreements exist among
+many production compilers on the interpretation of
+such invocations.
+These disagreements strongly suggest that Fortran programmers,
+and certainly existing Fortran programs, disagree about the
+meaning of such invocations.
+
+The first version of @samp{JCB002} didn't accommodate some compilers'
+treatment of @samp{INT(I1-I2)} where @samp{I1} and @samp{I2} are
+@code{INTEGER*2}.
+In such a case, these compilers apparently convert both
+operands to @code{INTEGER*4} and then do an @code{INTEGER*4} subtraction,
+instead of doing an @code{INTEGER*2} subtraction on the
+original values in @samp{I1} and @samp{I2}.
+
+However, the results of the careful analyses done on the outputs
+of programs compiled by these various compilers show that they
+all implement either @samp{Interp 1} or @samp{Interp 2} above.
+
+Specifically, it is believed that the new version of @samp{JCB002}
+above will confirm that:
+
+@itemize @bullet
+@item
+Digital Semiconductor (``DEC'') Alpha OSF/1, HP-UX 10.0.1, AIX 3.2.5
+@code{f77} compilers all implement @samp{Interp 1}.
+
+@item
+IRIX 5.3 @code{f77} compiler implements @samp{Interp 2}.
+
+@item
+Solaris 2.5, SunOS 4.1.3, DECstation ULTRIX 4.3,
+and IRIX 6.1 @code{f77} compilers all implement @samp{Interp 3}.
+@end itemize
+
+If you get different results than the above for the stated
+compilers, or have results for other compilers that might be
+worth adding to the above list, please let us know the details
+(compiler product, version, machine, results, and so on).
+
+@node REAL() and AIMAG() of Complex
+@subsection @code{REAL()} and @code{AIMAG()} of Complex
+@cindex REAL intrinsic
+@cindex intrinsics, REAL
+@cindex AIMAG intrinsic
+@cindex intrinsics, AIMAG
+
+The GNU Fortran language disallows @code{REAL(@var{expr})}
+and @code{AIMAG(@var{expr})},
+where @var{expr} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},
+except when they are used in the following way:
+
+@example
+REAL(REAL(@var{expr}))
+REAL(AIMAG(@var{expr}))
+@end example
+
+@noindent
+The above forms explicitly specify that the desired effect
+is to convert the real or imaginary part of @var{expr}, which might
+be some @code{REAL} type other than @code{REAL(KIND=1)},
+to type @code{REAL(KIND=1)},
+and have that serve as the value of the expression.
+
+The GNU Fortran language offers clearly named intrinsics to extract the
+real and imaginary parts of a complex entity without any
+conversion:
+
+@example
+REALPART(@var{expr})
+IMAGPART(@var{expr})
+@end example
+
+To express the above using typical extended FORTRAN 77,
+use the following constructs
+(when @var{expr} is @code{COMPLEX(KIND=2)}):
+
+@example
+DBLE(@var{expr})
+DIMAG(@var{expr})
+@end example
+
+The FORTRAN 77 language offers no way
+to explicitly specify the real and imaginary parts of a complex expression of
+arbitrary type, apparently as a result of requiring support for
+only one @code{COMPLEX} type (@code{COMPLEX(KIND=1)}).
+The concepts of converting an expression to type @code{REAL(KIND=1)} and
+of extracting the real part of a complex expression were
+thus ``smooshed'' by FORTRAN 77 into a single intrinsic, since
+they happened to have the exact same effect in that language
+(due to having only one @code{COMPLEX} type).
+
+@emph{Note:} When @samp{-ff90} is in effect,
+@code{g77} treats @samp{REAL(@var{expr})}, where @var{expr} is of
+type @code{COMPLEX}, as @samp{REALPART(@var{expr})},
+whereas with @samp{-fugly-complex -fno-f90} in effect, it is
+treated as @samp{REAL(REALPART(@var{expr}))}.
+
+@xref{Ugly Complex Part Extraction}, for more information.
+
+@node CMPLX() of DOUBLE PRECISION
+@subsection @code{CMPLX()} of @code{DOUBLE PRECISION}
+@cindex CMPLX intrinsic
+@cindex intrinsics, CMPLX
+
+In accordance with Fortran 90 and at least some (perhaps all)
+other compilers, the GNU Fortran language defines @code{CMPLX()}
+as always returning a result that is type @code{COMPLEX(KIND=1)}.
+
+This means @samp{CMPLX(D1,D2)}, where @samp{D1} and @samp{D2}
+are @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}), is treated as:
+
+@example
+CMPLX(SNGL(D1), SNGL(D2))
+@end example
+
+(It was necessary for Fortran 90 to specify this behavior
+for @code{DOUBLE PRECISION} arguments, since that is
+the behavior mandated by FORTRAN 77.)
+
+The GNU Fortran language also provides the @code{DCMPLX()} intrinsic,
+which is provided by some FORTRAN 77 compilers to construct
+a @code{DOUBLE COMPLEX} entity from of @code{DOUBLE PRECISION}
+operands.
+However, this solution does not scale well when more @code{COMPLEX} types
+(having various precisions and ranges) are offered by Fortran implementations.
+
+Fortran 90 extends the @code{CMPLX()} intrinsic by adding
+an extra argument used to specify the desired kind of complex
+result.
+However, this solution is somewhat awkward to use, and
+@code{g77} currently does not support it.
+
+The GNU Fortran language provides a simple way to build a complex
+value out of two numbers, with the precise type of the value
+determined by the types of the two numbers (via the usual
+type-promotion mechanism):
+
+@example
+COMPLEX(@var{real}, @var{imag})
+@end example
+
+When @var{real} and @var{imag} are the same @code{REAL} types, @code{COMPLEX()}
+performs no conversion other than to put them together to form a
+complex result of the same (complex version of real) type.
+
+@xref{Complex Intrinsic}, for more information.
+
+@node MIL-STD 1753
+@subsection MIL-STD 1753 Support
+@cindex MIL-STD 1753
+
+The GNU Fortran language includes the MIL-STD 1753 intrinsics
+@code{BTEST}, @code{IAND}, @code{IBCLR}, @code{IBITS},
+@code{IBSET}, @code{IEOR}, @code{IOR}, @code{ISHFT},
+@code{ISHFTC}, @code{MVBITS}, and @code{NOT}.
+
+@node f77/f2c Intrinsics
+@subsection @code{f77}/@code{f2c} Intrinsics
+
+The bit-manipulation intrinsics supported by traditional
+@code{f77} and by @code{f2c} are available in the GNU Fortran language.
+These include @code{AND}, @code{LSHIFT}, @code{OR}, @code{RSHIFT},
+and @code{XOR}.
+
+Also supported are the intrinsics @code{CDABS},
+@code{CDCOS}, @code{CDEXP}, @code{CDLOG}, @code{CDSIN},
+@code{CDSQRT}, @code{DCMPLX}, @code{DCONJG}, @code{DFLOAT},
+@code{DIMAG}, @code{DREAL}, and @code{IMAG},
+@code{ZABS}, @code{ZCOS}, @code{ZEXP}, @code{ZLOG}, @code{ZSIN},
+and @code{ZSQRT}.
+
+@node Table of Intrinsic Functions
+@subsection Table of Intrinsic Functions
+@cindex intrinsics, table of
+@cindex table of intrinsics
+
+(Corresponds to Section 15.10 of ANSI X3.9-1978 FORTRAN 77.)
+
+The GNU Fortran language adds various functions, subroutines, types,
+and arguments to the set of intrinsic functions in ANSI FORTRAN 77.
+The complete set of intrinsics supported by the GNU Fortran language
+is described below.
+
+Note that a name is not treated as that of an intrinsic if it is
+specified in an @code{EXTERNAL} statement in the same program unit;
+if a command-line option is used to disable the groups to which
+the intrinsic belongs; or if the intrinsic is not named in an
+@code{INTRINSIC} statement and a command-line option is used to
+hide the groups to which the intrinsic belongs.
+
+So, it is recommended that any reference in a program unit to
+an intrinsic procedure that is not a standard FORTRAN 77
+intrinsic be accompanied by an appropriate @code{INTRINSIC}
+statement in that program unit.
+This sort of defensive programming makes it more
+likely that an implementation will issue a diagnostic rather
+than generate incorrect code for such a reference.
+
+The terminology used below is based on that of the Fortran 90
+standard, so that the text may be more concise and accurate:
+
+@itemize @bullet
+@item
+@code{OPTIONAL} means the argument may be omitted.
+
+@item
+@samp{A-1, A-2, @dots{}, A-n} means more than one argument
+(generally named @samp{A}) may be specified.
+
+@item
+@samp{scalar} means the argument must not be an array (must
+be a variable or array element, or perhaps a constant if expressions
+are permitted).
+
+@item
+@samp{DIMENSION(4)} means the argument must be an array having 4 elements.
+
+@item
+@code{INTENT(IN)} means the argument must be an expression
+(such as a constant or a variable that is defined upon invocation
+of the intrinsic).
+
+@item
+@code{INTENT(OUT)} means the argument must be definable by the
+invocation of the intrinsic (that is, must not be a constant nor
+an expression involving operators other than array reference and
+substring reference).
+
+@item
+@code{INTENT(INOUT)} means the argument must be defined prior to,
+and definable by, invocation of the intrinsic (a combination of
+the requirements of @code{INTENT(IN)} and @code{INTENT(OUT)}.
+
+@item
+@xref{Kind Notation} for explanation of @code{KIND}.
+@end itemize
+
+@ifinfo
+(Note that the empty lines appearing in the menu below
+are not intentional---they result from a bug in the
+GNU @code{makeinfo} program@dots{}a program that, if it
+did not exist, would leave this document in far worse shape!)
+@end ifinfo
+
+@c The actual documentation for intrinsics comes from
+@c intdoc.texi, which in turn is automatically generated
+@c from the internal g77 tables in intrin.def _and_ the
+@c largely hand-written text in intdoc.h. So, if you want
+@c to change or add to existing documentation on intrinsics,
+@c you probably want to edit intdoc.h.
+@c
+@set familyF77
+@set familyGNU
+@set familyASC
+@set familyMIL
+@set familyF90
+@clear familyVXT
+@clear familyFVZ
+@set familyF2C
+@set familyF2U
+@clear familyBADU77
+@include intdoc.texi
+
+@node Scope and Classes of Names
+@section Scope and Classes of Symbolic Names
+@cindex symbolic names
+@cindex scope
+
+(The following information augments or overrides the information in
+Chapter 18 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 18 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* Underscores in Symbol Names::
+@end menu
+
+@node Underscores in Symbol Names
+@subsection Underscores in Symbol Names
+@cindex underscores
+
+Underscores (@samp{_}) are accepted in symbol names after the first
+character (which must be a letter).
+
+@node Other Dialects
+@chapter Other Dialects
+
+GNU Fortran supports a variety of features that are not
+considered part of the GNU Fortran language itself, but
+are representative of various dialects of Fortran that
+@code{g77} supports in whole or in part.
+
+Any of the features listed below might be disallowed by
+@code{g77} unless some command-line option is specified.
+Currently, some of the features are accepted using the
+default invocation of @code{g77}, but that might change
+in the future.
+
+@emph{Note: This portion of the documentation definitely needs a lot
+of work!}
+
+@menu
+* Source Form:: Details of fixed-form and free-form source.
+* Trailing Comment:: Use of @samp{/*} to start a comment.
+* Debug Line:: Use of @samp{D} in column 1.
+* Dollar Signs:: Use of @samp{$} in symbolic names.
+* Case Sensitivity:: Uppercase and lowercase in source files.
+* VXT Fortran:: @dots{}versus the GNU Fortran language.
+* Fortran 90:: @dots{}versus the GNU Fortran language.
+* Pedantic Compilation:: Enforcing the standard.
+* Distensions:: Misfeatures supported by GNU Fortran.
+@end menu
+
+@node Source Form
+@section Source Form
+@cindex source file format
+@cindex source form
+@cindex files, source
+@cindex source code
+@cindex code, source
+@cindex fixed form
+@cindex free form
+
+GNU Fortran accepts programs written in either fixed form or
+free form.
+
+Fixed form
+corresponds to ANSI FORTRAN 77 (plus popular extensions, such as
+allowing tabs) and Fortran 90's fixed form.
+
+Free form corresponds to
+Fortran 90's free form (though possibly not entirely up-to-date, and
+without complaining about some things that for which Fortran 90 requires
+diagnostics, such as the spaces in the constant in @samp{R = 3 . 1}).
+
+The way a Fortran compiler views source files depends entirely on the
+implementation choices made for the compiler, since those choices
+are explicitly left to the implementation by the published Fortran
+standards.
+GNU Fortran currently tries to be somewhat like a few popular compilers
+(@code{f2c}, Digital (``DEC'') Fortran, and so on), though a cleaner default
+definition along with more
+flexibility offered by command-line options is likely to be offered
+in version 0.6.
+
+This section describes how @code{g77} interprets source lines.
+
+@menu
+* Carriage Returns:: Carriage returns ignored.
+* Tabs:: Tabs converted to spaces.
+* Short Lines:: Short lines padded with spaces (fixed-form only).
+* Long Lines:: Long lines truncated.
+* Ampersands:: Special Continuation Lines.
+@end menu
+
+@node Carriage Returns
+@subsection Carriage Returns
+@cindex carriage returns
+
+Carriage returns (@samp{\r}) in source lines are ignored.
+This is somewhat different from @code{f2c}, which seems to treat them as
+spaces outside character/Hollerith constants, and encodes them as @samp{\r}
+inside such constants.
+
+@node Tabs
+@subsection Tabs
+@cindex tab characters
+
+A source line with a @key{TAB} character anywhere in it is treated as
+entirely significant---however long it is---instead of ending in
+column 72 (for fixed-form source) or 132 (for free-form source).
+This also is different from @code{f2c}, which encodes tabs as
+@samp{\t} (the ASCII @key{TAB} character) inside character
+and Hollerith constants, but nevertheless seems to treat the column
+position as if it had been affected by the canonical tab positioning.
+
+@code{g77} effectively
+translates tabs to the appropriate number of spaces (a la the default
+for the UNIX @code{expand} command) before doing any other processing, other
+than (currently) noting whether a tab was found on a line and using this
+information to decide how to interpret the length of the line and continued
+constants.
+
+Note that this default behavior probably will change for version 0.6,
+when it will presumably be available via a command-line option.
+The default as of version 0.6 is planned to be a ``pure visual''
+model, where tabs are immediately
+converted to spaces and otherwise have no effect, so the way a typical
+user sees source lines produces a consistent result no matter how the
+spacing in those source lines is actually implemented via tabs, spaces,
+and trailing tabs/spaces before newline.
+Command-line options are likely to be added to specify whether all or
+just-tabbed lines are to be extended to 132 or full input-line length,
+and perhaps even an option will be added to specify the truncated-line
+behavior to which some Digital compilers default (and which affects
+the way continued character/Hollerith constants are interpreted).
+
+@node Short Lines
+@subsection Short Lines
+@cindex short source lines
+@cindex space-padding
+@cindex spaces
+@cindex source lines, short
+@cindex lines, short
+
+Source lines shorter than the applicable fixed-form length are treated as
+if they were padded with spaces to that length.
+(None of this is relevant to source files written in free form.)
+
+This affects only
+continued character and Hollerith constants, and is a different
+interpretation than provided by some other popular compilers
+(although a bit more consistent with the traditional punched-card
+basis of Fortran and the way the Fortran standard expressed fixed
+source form).
+
+@code{g77} might someday offer an option to warn about cases where differences
+might be seen as a result of this treatment, and perhaps an option to
+specify the alternate behavior as well.
+
+Note that this padding cannot apply to lines that are effectively of
+infinite length---such lines are specified using command-line options
+like @samp{-ffixed-line-length-none}, for example.
+
+@node Long Lines
+@subsection Long Lines
+@cindex long source lines
+@cindex truncation
+@cindex lines, long
+@cindex source lines, long
+
+Source lines longer than the applicable length are truncated to that
+length.
+Currently, @code{g77} does not warn if the truncated characters are
+not spaces, to accommodate existing code written for systems that
+treated truncated text as commentary (especially in columns 73 through 80).
+
+@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect},
+for information on the @samp{-ffixed-line-length-@var{n}} option,
+which can be used to set the line length applicable to fixed-form
+source files.
+
+@node Ampersands
+@subsection Ampersand Continuation Line
+@cindex ampersand continuation line
+@cindex continuation line, ampersand
+
+A @samp{&} in column 1 of fixed-form source denotes an arbitrary-length
+continuation line, imitating the behavior of @code{f2c}.
+
+@node Trailing Comment
+@section Trailing Comment
+
+@code{g77} supports use of @samp{/*} to start a trailing
+comment.
+In the GNU Fortran language, @samp{!} is used for this purpose.
+
+@samp{/*} is not in the GNU Fortran language
+because the use of @samp{/*} in a program might
+suggest to some readers that a block, not trailing, comment is
+started (and thus ended by @samp{*/}, not end of line),
+since that is the meaning of @samp{/*} in C.
+
+Also, such readers might think they can use @samp{//} to start
+a trailing comment as an alternative to @samp{/*}, but
+@samp{//} already denotes concatenation, and such a ``comment''
+might actually result in a program that compiles without
+error (though it would likely behave incorrectly).
+
+@node Debug Line
+@section Debug Line
+@cindex debug line
+
+Use of @samp{D} or @samp{d} as the first character (column 1) of
+a source line denotes a debug line.
+
+In turn, a debug line is treated as either a comment line
+or a normal line, depending on whether debug lines are enabled.
+
+When treated as a comment line, a line beginning with @samp{D} or
+@samp{d} is treated as if it the first character was @samp{C} or @samp{c}, respectively.
+When treated as a normal line, such a line is treated as if
+the first character was @key{SPC} (space).
+
+(Currently, @code{g77} provides no means for treating debug
+lines as normal lines.)
+
+@node Dollar Signs
+@section Dollar Signs in Symbol Names
+@cindex dollar sign
+@cindex $
+
+Dollar signs (@samp{$}) are allowed in symbol names (after the first character)
+when the @samp{-fdollar-ok} option is specified.
+
+@node Case Sensitivity
+@section Case Sensitivity
+@cindex case sensitivity
+@cindex source file format
+@cindex code, source
+@cindex source code
+@cindex uppercase letters
+@cindex lowercase letters
+@cindex letters, uppercase
+@cindex letters, lowercase
+
+GNU Fortran offers the programmer way too much flexibility in deciding
+how source files are to be treated vis-a-vis uppercase and lowercase
+characters.
+There are 66 useful settings that affect case sensitivity, plus 10
+settings that are nearly useless, with the remaining 116 settings
+being either redundant or useless.
+
+None of these settings have any effect on the contents of comments
+(the text after a @samp{c} or @samp{C} in Column 1, for example)
+or of character or Hollerith constants.
+Note that things like the @samp{E} in the statement
+@samp{CALL FOO(3.2E10)} and the @samp{TO} in @samp{ASSIGN 10 TO LAB}
+are considered built-in keywords, and so are affected by
+these settings.
+
+Low-level switches are identified in this section as follows:
+
+@itemize @w{}
+@item A
+Source Case Conversion:
+
+@itemize @w{}
+@item 0
+Preserve (see Note 1)
+@item 1
+Convert to Upper Case
+@item 2
+Convert to Lower Case
+@end itemize
+
+@item B
+Built-in Keyword Matching:
+
+@itemize @w{}
+@item 0
+Match Any Case (per-character basis)
+@item 1
+Match Upper Case Only
+@item 2
+Match Lower Case Only
+@item 3
+Match InitialCaps Only (see tables for spellings)
+@end itemize
+
+@item C
+Built-in Intrinsic Matching:
+
+@itemize @w{}
+@item 0
+Match Any Case (per-character basis)
+@item 1
+Match Upper Case Only
+@item 2
+Match Lower Case Only
+@item 3
+Match InitialCaps Only (see tables for spellings)
+@end itemize
+
+@item D
+User-defined Symbol Possibilities (warnings only):
+
+@itemize @w{}
+@item 0
+Allow Any Case (per-character basis)
+@item 1
+Allow Upper Case Only
+@item 2
+Allow Lower Case Only
+@item 3
+Allow InitialCaps Only (see Note 2)
+@end itemize
+@end itemize
+
+Note 1: @code{g77} eventually will support @code{NAMELIST} in a manner that is
+consistent with these source switches---in the sense that input will be
+expected to meet the same requirements as source code in terms
+of matching symbol names and keywords (for the exponent letters).
+
+Currently, however, @code{NAMELIST} is supported by @code{libf2c},
+which uppercases @code{NAMELIST} input and symbol names for matching.
+This means not only that @code{NAMELIST} output currently shows symbol
+(and keyword) names in uppercase even if lower-case source
+conversion (option A2) is selected, but that @code{NAMELIST} cannot be
+adequately supported when source case preservation (option A0)
+is selected.
+
+If A0 is selected, a warning message will be
+output for each @code{NAMELIST} statement to this effect.
+The behavior
+of the program is undefined at run time if two or more symbol names
+appear in a given @code{NAMELIST} such that the names are identical
+when converted to upper case (e.g. @samp{NAMELIST /X/ VAR, Var, var}).
+For complete and total elegance, perhaps there should be a warning
+when option A2 is selected, since the output of NAMELIST is currently
+in uppercase but will someday be lowercase (when a @code{libg77} is written),
+but that seems to be overkill for a product in beta test.
+
+Note 2: Rules for InitialCaps names are:
+
+@itemize --
+@item
+Must be a single uppercase letter, @strong{or}
+@item
+Must start with an uppercase letter and contain at least one
+lowercase letter.
+@end itemize
+
+So @samp{A}, @samp{Ab}, @samp{ABc}, @samp{AbC}, and @samp{Abc} are
+valid InitialCaps names, but @samp{AB}, @samp{A2}, and @samp{ABC} are
+not.
+Note that most, but not all, built-in names meet these
+requirements---the exceptions are some of the two-letter format
+specifiers, such as @samp{BN} and @samp{BZ}.
+
+Here are the names of the corresponding command-line options:
+
+@smallexample
+A0: -fsource-case-preserve
+A1: -fsource-case-upper
+A2: -fsource-case-lower
+
+B0: -fmatch-case-any
+B1: -fmatch-case-upper
+B2: -fmatch-case-lower
+B3: -fmatch-case-initcap
+
+C0: -fintrin-case-any
+C1: -fintrin-case-upper
+C2: -fintrin-case-lower
+C3: -fintrin-case-initcap
+
+D0: -fsymbol-case-any
+D1: -fsymbol-case-upper
+D2: -fsymbol-case-lower
+D3: -fsymbol-case-initcap
+@end smallexample
+
+Useful combinations of the above settings, along with abbreviated
+option names that set some of these combinations all at once:
+
+@smallexample
+ 1: A0-- B0--- C0--- D0--- -fcase-preserve
+ 2: A0-- B0--- C0--- D-1--
+ 3: A0-- B0--- C0--- D--2-
+ 4: A0-- B0--- C0--- D---3
+ 5: A0-- B0--- C-1-- D0---
+ 6: A0-- B0--- C-1-- D-1--
+ 7: A0-- B0--- C-1-- D--2-
+ 8: A0-- B0--- C-1-- D---3
+ 9: A0-- B0--- C--2- D0---
+10: A0-- B0--- C--2- D-1--
+11: A0-- B0--- C--2- D--2-
+12: A0-- B0--- C--2- D---3
+13: A0-- B0--- C---3 D0---
+14: A0-- B0--- C---3 D-1--
+15: A0-- B0--- C---3 D--2-
+16: A0-- B0--- C---3 D---3
+17: A0-- B-1-- C0--- D0---
+18: A0-- B-1-- C0--- D-1--
+19: A0-- B-1-- C0--- D--2-
+20: A0-- B-1-- C0--- D---3
+21: A0-- B-1-- C-1-- D0---
+22: A0-- B-1-- C-1-- D-1-- -fcase-strict-upper
+23: A0-- B-1-- C-1-- D--2-
+24: A0-- B-1-- C-1-- D---3
+25: A0-- B-1-- C--2- D0---
+26: A0-- B-1-- C--2- D-1--
+27: A0-- B-1-- C--2- D--2-
+28: A0-- B-1-- C--2- D---3
+29: A0-- B-1-- C---3 D0---
+30: A0-- B-1-- C---3 D-1--
+31: A0-- B-1-- C---3 D--2-
+32: A0-- B-1-- C---3 D---3
+33: A0-- B--2- C0--- D0---
+34: A0-- B--2- C0--- D-1--
+35: A0-- B--2- C0--- D--2-
+36: A0-- B--2- C0--- D---3
+37: A0-- B--2- C-1-- D0---
+38: A0-- B--2- C-1-- D-1--
+39: A0-- B--2- C-1-- D--2-
+40: A0-- B--2- C-1-- D---3
+41: A0-- B--2- C--2- D0---
+42: A0-- B--2- C--2- D-1--
+43: A0-- B--2- C--2- D--2- -fcase-strict-lower
+44: A0-- B--2- C--2- D---3
+45: A0-- B--2- C---3 D0---
+46: A0-- B--2- C---3 D-1--
+47: A0-- B--2- C---3 D--2-
+48: A0-- B--2- C---3 D---3
+49: A0-- B---3 C0--- D0---
+50: A0-- B---3 C0--- D-1--
+51: A0-- B---3 C0--- D--2-
+52: A0-- B---3 C0--- D---3
+53: A0-- B---3 C-1-- D0---
+54: A0-- B---3 C-1-- D-1--
+55: A0-- B---3 C-1-- D--2-
+56: A0-- B---3 C-1-- D---3
+57: A0-- B---3 C--2- D0---
+58: A0-- B---3 C--2- D-1--
+59: A0-- B---3 C--2- D--2-
+60: A0-- B---3 C--2- D---3
+61: A0-- B---3 C---3 D0---
+62: A0-- B---3 C---3 D-1--
+63: A0-- B---3 C---3 D--2-
+64: A0-- B---3 C---3 D---3 -fcase-initcap
+65: A-1- B01-- C01-- D01-- -fcase-upper
+66: A--2 B0-2- C0-2- D0-2- -fcase-lower
+@end smallexample
+
+Number 22 is the ``strict'' ANSI FORTRAN 77 model wherein all input
+(except comments, character constants, and Hollerith strings) must
+be entered in uppercase.
+Use @samp{-fcase-strict-upper} to specify this
+combination.
+
+Number 43 is like Number 22 except all input must be lowercase. Use
+@samp{-fcase-strict-lower} to specify this combination.
+
+Number 65 is the ``classic'' ANSI FORTRAN 77 model as implemented on many
+non-UNIX machines whereby all the source is translated to uppercase.
+Use @samp{-fcase-upper} to specify this combination.
+
+Number 66 is the ``canonical'' UNIX model whereby all the source is
+translated to lowercase.
+Use @samp{-fcase-lower} to specify this combination.
+
+There are a few nearly useless combinations:
+
+@smallexample
+67: A-1- B01-- C01-- D--2-
+68: A-1- B01-- C01-- D---3
+69: A-1- B01-- C--23 D01--
+70: A-1- B01-- C--23 D--2-
+71: A-1- B01-- C--23 D---3
+72: A--2 B01-- C0-2- D-1--
+73: A--2 B01-- C0-2- D---3
+74: A--2 B01-- C-1-3 D0-2-
+75: A--2 B01-- C-1-3 D-1--
+76: A--2 B01-- C-1-3 D---3
+@end smallexample
+
+The above allow some programs to be compiled but with restrictions that
+make most useful programs impossible: Numbers 67 and 72 warn about
+@emph{any} user-defined symbol names (such as @samp{SUBROUTINE FOO});
+Numbers
+68 and 73 warn about any user-defined symbol names longer than one
+character that don't have at least one non-alphabetic character after
+the first;
+Numbers 69 and 74 disallow any references to intrinsics;
+and Numbers 70, 71, 75, and 76 are combinations of the restrictions in
+67+69, 68+69, 72+74, and 73+74, respectively.
+
+All redundant combinations are shown in the above tables anyplace
+where more than one setting is shown for a low-level switch.
+For example, @samp{B0-2-} means either setting 0 or 2 is valid for switch B.
+The ``proper'' setting in such a case is the one that copies the setting
+of switch A---any other setting might slightly reduce the speed of
+the compiler, though possibly to an unmeasurable extent.
+
+All remaining combinations are useless in that they prevent successful
+compilation of non-null source files (source files with something other
+than comments).
+
+@node VXT Fortran
+@section VXT Fortran
+
+@cindex VXT extensions
+@cindex extensions, VXT
+@code{g77} supports certain constructs that
+have different meanings in VXT Fortran than they
+do in the GNU Fortran language.
+
+Generally, this manual uses the invented term VXT Fortran to refer
+VAX FORTRAN (circa v4).
+That compiler offered many popular features, though not necessarily
+those that are specific to the VAX processor architecture,
+the VMS operating system,
+or Digital Equipment Corporation's Fortran product line.
+(VAX and VMS probably are trademarks of Digital Equipment
+Corporation.)
+
+An extension offered by a Digital Fortran product that also is
+offered by several other Fortran products for different kinds of
+systems is probably going to be considered for inclusion in @code{g77}
+someday, and is considered a VXT Fortran feature.
+
+The @samp{-fvxt} option generally specifies that, where
+the meaning of a construct is ambiguous (means one thing
+in GNU Fortran and another in VXT Fortran), the VXT Fortran
+meaning is to be assumed.
+
+@menu
+* Double Quote Meaning:: @samp{"2000} as octal constant.
+* Exclamation Point:: @samp{!} in column 6.
+@end menu
+
+@node Double Quote Meaning
+@subsection Meaning of Double Quote
+@cindex double quotes
+@cindex character constants
+@cindex constants, character
+@cindex octal constants
+@cindex constants, octal
+
+@code{g77} treats double-quote (@samp{"})
+as beginning an octal constant of @code{INTEGER(KIND=1)} type
+when the @code{-fvxt} option is specified.
+The form of this octal constant is
+
+@example
+"@var{octal-digits}
+@end example
+
+@noindent
+where @var{octal-digits} is a nonempty string of characters in
+the set @samp{01234567}.
+
+For example, the @code{-fvxt} option permits this:
+
+@example
+PRINT *, "20
+END
+@end example
+
+@noindent
+The above program would print the value @samp{16}.
+
+@xref{Integer Type}, for information on the preferred construct
+for integer constants specified using GNU Fortran's octal notation.
+
+(In the GNU Fortran language, the double-quote character (@samp{"})
+delimits a character constant just as does apostrophe (@samp{'}).
+There is no way to allow
+both constructs in the general case, since statements like
+@samp{PRINT *,"2000 !comment?"} would be ambiguous.)
+
+@node Exclamation Point
+@subsection Meaning of Exclamation Point in Column 6
+@cindex exclamation points
+@cindex continuation character
+@cindex characters, continuation
+@cindex comment character
+@cindex characters, comment
+
+@code{g77} treats an exclamation point (@samp{!}) in column 6 of
+a fixed-form source file
+as a continuation character rather than
+as the beginning of a comment
+(as it does in any other column)
+when the @code{-fvxt} option is specified.
+
+The following program, when run, prints a message indicating
+whether it is interpreted according to GNU Fortran (and Fortran 90)
+rules or VXT Fortran rules:
+
+@smallexample
+C234567 (This line begins in column 1.)
+ I = 0
+ !1
+ IF (I.EQ.0) PRINT *, ' I am a VXT Fortran program'
+ IF (I.EQ.1) PRINT *, ' I am a Fortran 90 program'
+ IF (I.LT.0 .OR. I.GT.1) PRINT *, ' I am a HAL 9000 computer'
+ END
+@end smallexample
+
+(In the GNU Fortran and Fortran 90 languages, exclamation point is
+a valid character and, unlike space (@key{SPC}) or zero (@samp{0}),
+marks a line as a continuation line when it appears in column 6.)
+
+@node Fortran 90
+@section Fortran 90
+@cindex compatibility, Fortran 90
+@cindex Fortran 90 compatibility
+
+The GNU Fortran language includes a number of features that are
+part of Fortran 90, even when the @samp{-ff90} option is not specified.
+The features enabled by @samp{-ff90} are intended to be those that,
+when @samp{-ff90} is not specified, would have another
+meaning to @code{g77}---usually meaning something invalid in the
+GNU Fortran language.
+
+So, the purpose of @samp{-ff90} is not to specify whether @code{g77} is
+to gratuitously reject Fortran 90 constructs.
+The @samp{-pedantic} option specified with @samp{-fno-f90} is intended
+to do that, although its implementation is certainly incomplete at
+this point.
+
+When @samp{-ff90} is specified:
+
+@itemize @bullet
+@item
+The type of @samp{REAL(@var{expr})} and @samp{AIMAG(@var{expr})},
+where @var{expr} is @code{COMPLEX} type,
+is the same type as the real part of @var{expr}.
+
+For example, assuming @samp{Z} is type @code{COMPLEX(KIND=2)},
+@samp{REAL(Z)} would return a value of type @code{REAL(KIND=2)},
+not of type @code{REAL(KIND=1)}, since @samp{-ff90} is specified.
+@end itemize
+
+@node Pedantic Compilation
+@section Pedantic Compilation
+@cindex pedantic compilation
+@cindex compilation, pedantic
+
+The @samp{-fpedantic} command-line option specifies that @code{g77}
+is to warn about code that is not standard-conforming.
+This is useful for finding
+some extensions @code{g77} accepts that other compilers might not accept.
+(Note that the @samp{-pedantic} and @samp{-pedantic-errors} options
+always imply @samp{-fpedantic}.)
+
+With @samp{-fno-f90} in force, ANSI FORTRAN 77 is used as the standard
+for conforming code.
+With @samp{-ff90} in force, Fortran 90 is used.
+
+The constructs for which @code{g77} issues diagnostics when @samp{-fpedantic}
+and @samp{-fno-f90} are in force are:
+
+@itemize @bullet
+@item
+Automatic arrays, as in
+
+@example
+SUBROUTINE X(N)
+REAL A(N)
+@dots{}
+@end example
+
+@noindent
+where @samp{A} is not listed in any @code{ENTRY} statement,
+and thus is not a dummy argument.
+
+@item
+The commas in @samp{READ (5), I} and @samp{WRITE (10), J}.
+
+These commas are disallowed by FORTRAN 77, but, while strictly
+superfluous, are syntactically elegant,
+especially given that commas are required in statements such
+as @samp{READ 99, I} and @samp{PRINT *, J}.
+Many compilers permit the superfluous commas for this reason.
+
+@item
+@code{DOUBLE COMPLEX}, either explicitly or implicitly.
+
+An explicit use of this type is via a @code{DOUBLE COMPLEX} or
+@code{IMPLICIT DOUBLE COMPLEX} statement, for examples.
+
+An example of an implicit use is the expression @samp{C*D},
+where @samp{C} is @code{COMPLEX(KIND=1)}
+and @samp{D} is @code{DOUBLE PRECISION}.
+This expression is prohibited by ANSI FORTRAN 77
+because the rules of promotion would suggest that it
+produce a @code{DOUBLE COMPLEX} result---a type not
+provided for by that standard.
+
+@item
+Automatic conversion of numeric
+expressions to @code{INTEGER(KIND=1)} in contexts such as:
+
+@itemize --
+@item
+Array-reference indexes.
+@item
+Alternate-return values.
+@item
+Computed @code{GOTO}.
+@item
+@code{FORMAT} run-time expressions (not yet supported).
+@item
+Dimension lists in specification statements.
+@item
+Numbers for I/O statements (such as @samp{READ (UNIT=3.2), I})
+@item
+Sizes of @code{CHARACTER} entities in specification statements.
+@item
+Kind types in specification entities (a Fortran 90 feature).
+@item
+Initial, terminal, and incrementation parameters for implied-@code{DO}
+constructs in @code{DATA} statements.
+@end itemize
+
+@item
+Automatic conversion of @code{LOGICAL} expressions to @code{INTEGER}
+in contexts such as arithmetic @code{IF} (where @code{COMPLEX}
+expressions are disallowed anyway).
+
+@item
+Zero-size array dimensions, as in:
+
+@example
+INTEGER I(10,20,4:2)
+@end example
+
+@item
+Zero-length @code{CHARACTER} entities, as in:
+
+@example
+PRINT *, ''
+@end example
+
+@item
+Substring operators applied to character constants and named
+constants, as in:
+
+@example
+PRINT *, 'hello'(3:5)
+@end example
+
+@item
+Null arguments passed to statement function, as in:
+
+@example
+PRINT *, FOO(,3)
+@end example
+
+@item
+Disagreement among program units regarding whether a given @code{COMMON}
+area is @code{SAVE}d (for targets where program units in a single source
+file are ``glued'' together as they typically are for UNIX development
+environments).
+
+@item
+Disagreement among program units regarding the size of a
+named @code{COMMON} block.
+
+@item
+Specification statements following first @code{DATA} statement.
+
+(In the GNU Fortran language, @samp{DATA I/1/} may be followed by @samp{INTEGER J},
+but not @samp{INTEGER I}.
+The @samp{-fpedantic} option disallows both of these.)
+
+@item
+Semicolon as statement separator, as in:
+
+@example
+CALL FOO; CALL BAR
+@end example
+@c
+@c @item
+@c Comma before list of I/O items in @code{WRITE}
+@c @c, @code{ENCODE}, @code{DECODE}, and @code{REWRITE}
+@c statements, as with @code{READ} (as explained above).
+
+@item
+Use of @samp{&} in column 1 of fixed-form source (to indicate continuation).
+
+@item
+Use of @code{CHARACTER} constants to initialize numeric entities, and vice
+versa.
+
+@item
+Expressions having two arithmetic operators in a row, such
+as @samp{X*-Y}.
+@end itemize
+
+If @samp{-fpedantic} is specified along with @samp{-ff90}, the
+following constructs result in diagnostics:
+
+@itemize @bullet
+@item
+Use of semicolon as a statement separator on a line
+that has an @code{INCLUDE} directive.
+@end itemize
+
+@node Distensions
+@section Distensions
+@cindex distensions
+@cindex ugly features
+@cindex features, ugly
+
+The @samp{-fugly-*} command-line options determine whether certain
+features supported by VAX FORTRAN and other such compilers, but considered
+too ugly to be in code that can be changed to use safer and/or more
+portable constructs, are accepted.
+These are humorously referred to as ``distensions'',
+extensions that just plain look ugly in the harsh light of day.
+
+@emph{Note:} The @samp{-fugly} option, which currently serves
+as shorthand to enable all of the distensions below, is likely to
+be removed in a future version of @code{g77}.
+That's because it's likely new distensions will be added that
+conflict with existing ones in terms of assigning meaning to
+a given chunk of code.
+(Also, it's pretty clear that users should not use @samp{-fugly}
+as shorthand when the next release of @code{g77} might add a
+distension to that that causes their existing code, when recompiled,
+to behave differently---perhaps even fail to compile or run
+correctly.)
+
+@menu
+* Ugly Implicit Argument Conversion:: Disabled via @samp{-fno-ugly-args}.
+* Ugly Assumed-Size Arrays:: Enabled via @samp{-fugly-assumed}.
+* Ugly Null Arguments:: Enabled via @samp{-fugly-comma}.
+* Ugly Complex Part Extraction:: Enabled via @samp{-fugly-complex}.
+* Ugly Conversion of Initializers:: Disabled via @samp{-fno-ugly-init}.
+* Ugly Integer Conversions:: Enabled via @samp{-fugly-logint}.
+* Ugly Assigned Labels:: Enabled via @samp{-fugly-assign}.
+@end menu
+
+@node Ugly Implicit Argument Conversion
+@subsection Implicit Argument Conversion
+@cindex Hollerith constants
+@cindex constants, Hollerith
+
+The @samp{-fno-ugly-args} option disables
+passing typeless and Hollerith constants as actual arguments
+in procedure invocations.
+For example:
+
+@example
+CALL FOO(4HABCD)
+CALL BAR('123'O)
+@end example
+
+@noindent
+These constructs can be too easily used to create non-portable
+code, but are not considered as ``ugly'' as others.
+Further, they are widely used in existing Fortran source code
+in ways that often are quite portable.
+Therefore, they are enabled by default.
+
+@node Ugly Assumed-Size Arrays
+@subsection Ugly Assumed-Size Arrays
+@cindex arrays, assumed-size
+@cindex assumed-size arrays
+@cindex DIMENSION X(1)
+
+The @samp{-fugly-assumed} option enables
+the treatment of any array with a final dimension specified as @samp{1}
+as an assumed-size array, as if @samp{*} had been specified
+instead.
+
+For example, @samp{DIMENSION X(1)} is treated as if it
+had read @samp{DIMENSION X(*)} if @samp{X} is listed as
+a dummy argument in a preceding @code{SUBROUTINE}, @code{FUNCTION},
+or @code{ENTRY} statement in the same program unit.
+
+Use an explicit lower bound to avoid this interpretation.
+For example, @samp{DIMENSION X(1:1)} is never treated as if
+it had read @samp{DIMENSION X(*)} or @samp{DIMENSION X(1:*)}.
+Nor is @samp{DIMENSION X(2-1)} affected by this option,
+since that kind of expression is unlikely to have been
+intended to designate an assumed-size array.
+
+This option is used to prevent warnings being issued about apparent
+out-of-bounds reference such as @samp{X(2) = 99}.
+
+It also prevents the array from being used in contexts that
+disallow assumed-size arrays, such as @samp{PRINT *,X}.
+In such cases, a diagnostic is generated and the source file is
+not compiled.
+
+The construct affected by this option is used only in old code
+that pre-exists the widespread acceptance of adjustable and assumed-size
+arrays in the Fortran community.
+
+@emph{Note:} This option does not affect how @samp{DIMENSION X(1)} is
+treated if @samp{X} is listed as a dummy argument only
+@emph{after} the @code{DIMENSION} statement (presumably in
+an @code{ENTRY} statement).
+For example, @samp{-fugly-assumed} has no effect on the
+following program unit:
+
+@example
+SUBROUTINE X
+REAL A(1)
+RETURN
+ENTRY Y(A)
+PRINT *, A
+END
+@end example
+
+@node Ugly Complex Part Extraction
+@subsection Ugly Complex Part Extraction
+@cindex complex values
+@cindex real part
+@cindex imaginary part
+
+The @samp{-fugly-complex} option enables
+use of the @code{REAL()} and @code{AIMAG()}
+intrinsics with arguments that are
+@code{COMPLEX} types other than @code{COMPLEX(KIND=1)}.
+
+With @samp{-ff90} in effect, these intrinsics return
+the unconverted real and imaginary parts (respectively)
+of their argument.
+
+With @samp{-fno-f90} in effect, these intrinsics convert
+the real and imaginary parts to @code{REAL(KIND=1)}, and return
+the result of that conversion.
+
+Due to this ambiguity, the GNU Fortran language defines
+these constructs as invalid, except in the specific
+case where they are entirely and solely passed as an
+argument to an invocation of the @code{REAL()} intrinsic.
+For example,
+
+@example
+REAL(REAL(Z))
+@end example
+
+@noindent
+is permitted even when @samp{Z} is @code{COMPLEX(KIND=2)}
+and @samp{-fno-ugly-complex} is in effect, because the
+meaning is clear.
+
+@code{g77} enforces this restriction, unless @samp{-fugly-complex}
+is specified, in which case the appropriate interpretation is
+chosen and no diagnostic is issued.
+
+@xref{CMPAMBIG}, for information on how to cope with existing
+code with unclear expectations of @code{REAL()} and @code{AIMAG()}
+with @code{COMPLEX(KIND=2)} arguments.
+
+@xref{RealPart Intrinsic}, for information on the @code{REALPART()}
+intrinsic, used to extract the real part of a complex expression
+without conversion.
+@xref{ImagPart Intrinsic}, for information on the @code{IMAGPART()}
+intrinsic, used to extract the imaginary part of a complex expression
+without conversion.
+
+@node Ugly Null Arguments
+@subsection Ugly Null Arguments
+@cindex trailing commas
+@cindex commas, trailing
+@cindex null arguments
+@cindex arguments, null
+
+The @samp{-fugly-comma} option enables
+use of a single trailing comma to mean ``pass an extra trailing null
+argument'' in a list of actual arguments to a procedure other than a
+statement function, and use of an empty list of arguments to
+mean ``pass a single null argument''.
+
+@cindex omitting arguments
+@cindex arguments, omitting
+(Null arguments often are used in some procedure-calling
+schemes to indicate omitted arguments.)
+
+For example, @samp{CALL FOO(,)} means ``pass
+two null arguments'', rather than ``pass one null argument''.
+Also, @samp{CALL BAR()} means ``pass one null argument''.
+
+This construct is considered ``ugly'' because it does not
+provide an elegant way to pass a single null argument
+that is syntactically distinct from passing no arguments.
+That is, this construct changes the meaning of code that
+makes no use of the construct.
+
+So, with @samp{-fugly-comma} in force, @samp{CALL FOO()}
+and @samp{I = JFUNC()} pass a single null argument, instead
+of passing no arguments as required by the Fortran 77 and
+90 standards.
+
+@emph{Note:} Many systems gracefully allow the case
+where a procedure call passes one extra argument that the
+called procedure does not expect.
+
+So, in practice, there might be no difference in
+the behavior of a program that does @samp{CALL FOO()}
+or @samp{I = JFUNC()} and is compiled with @samp{-fugly-comma}
+in force as compared to its behavior when compiled
+with the default, @samp{-fno-ugly-comma}, in force,
+assuming @samp{FOO} and @samp{JFUNC} do not expect any
+arguments to be passed.
+
+@node Ugly Conversion of Initializers
+@subsection Ugly Conversion of Initializers
+
+The constructs disabled by @samp{-fno-ugly-init} are:
+
+@itemize @bullet
+@cindex Hollerith constants
+@cindex constants, Hollerith
+@item
+Use of Hollerith and typeless constants in contexts where they set
+initial (compile-time) values for variables, arrays, and named
+constants---that is, @code{DATA} and @code{PARAMETER} statements, plus
+type-declaration statements specifying initial values.
+
+Here are some sample initializations that are disabled by the
+@samp{-fno-ugly-init} option:
+
+@example
+PARAMETER (VAL='9A304FFE'X)
+REAL*8 STRING/8HOUTPUT00/
+DATA VAR/4HABCD/
+@end example
+
+@cindex character constants
+@cindex constants, character
+@item
+In the same contexts as above, use of character constants to initialize
+numeric items and vice versa (one constant per item).
+
+Here are more sample initializations that are disabled by the
+@samp{-fno-ugly-init} option:
+
+@example
+INTEGER IA
+CHARACTER BELL
+PARAMETER (IA = 'A')
+PARAMETER (BELL = 7)
+@end example
+
+@item
+Use of Hollerith and typeless constants on the right-hand side
+of assignment statements to numeric types, and in other
+contexts (such as passing arguments in invocations of
+intrinsic procedures and statement functions) that
+are treated as assignments to known types (the dummy
+arguments, in these cases).
+
+Here are sample statements that are disabled by the
+@samp{-fno-ugly-init} option:
+
+@example
+IVAR = 4HABCD
+PRINT *, IMAX0(2HAB, 2HBA)
+@end example
+@end itemize
+
+The above constructs, when used,
+can tend to result in non-portable code.
+But, they are widely used in existing Fortran code in ways
+that often are quite portable.
+Therefore, they are enabled by default.
+
+@node Ugly Integer Conversions
+@subsection Ugly Integer Conversions
+
+The constructs enabled via @samp{-fugly-logint} are:
+
+@itemize @bullet
+@item
+Automatic conversion between @code{INTEGER} and @code{LOGICAL} as
+dictated by
+context (typically implies nonportable dependencies on how a
+particular implementation encodes @code{.TRUE.} and @code{.FALSE.}).
+
+@item
+Use of a @code{LOGICAL} variable in @code{ASSIGN} and assigned-@code{GOTO}
+statements.
+@end itemize
+
+The above constructs are disabled by default because use
+of them tends to lead to non-portable code.
+Even existing Fortran code that uses that often turns out
+to be non-portable, if not outright buggy.
+
+Some of this is due to differences among implementations as
+far as how @code{.TRUE.} and @code{.FALSE.} are encoded as
+@code{INTEGER} values---Fortran code that assumes a particular
+coding is likely to use one of the above constructs, and is
+also likely to not work correctly on implementations using
+different encodings.
+
+@xref{Equivalence Versus Equality}, for more information.
+
+@node Ugly Assigned Labels
+@subsection Ugly Assigned Labels
+@cindex ASSIGN statement
+@cindex statements, ASSIGN
+@cindex assigned labels
+@cindex pointers
+
+The @samp{-fugly-assign} option forces @code{g77} to use the
+same storage for assigned labels as it would for a normal
+assignment to the same variable.
+
+For example, consider the following code fragment:
+
+@example
+I = 3
+ASSIGN 10 TO I
+@end example
+
+@noindent
+Normally, for portability and improved diagnostics, @code{g77}
+reserves distinct storage for a ``sibling'' of @samp{I}, used
+only for @code{ASSIGN} statements to that variable (along with
+the corresponding assigned-@code{GOTO} and assigned-@samp{FORMAT}-I/O
+statements that reference the variable).
+
+However, some code (that violates the ANSI FORTRAN 77 standard)
+attempts to copy assigned labels among variables involved with
+@code{ASSIGN} statements, as in:
+
+@example
+ASSIGN 10 TO I
+ISTATE(5) = I
+@dots{}
+J = ISTATE(ICUR)
+GOTO J
+@end example
+
+@noindent
+Such code doesn't work under @code{g77} unless @samp{-fugly-assign}
+is specified on the command-line, ensuring that the value of @code{I}
+referenced in the second line is whatever value @code{g77} uses
+to designate statement label @samp{10}, so the value may be
+copied into the @samp{ISTATE} array, later retrieved into a
+variable of the appropriate type (@samp{J}), and used as the target of
+an assigned-@code{GOTO} statement.
+
+@emph{Note:} To avoid subtle program bugs,
+when @samp{-fugly-assign} is specified,
+@code{g77} requires the type of variables
+specified in assigned-label contexts
+@emph{must} be the same type returned by @code{%LOC()}.
+On many systems, this type is effectively the same
+as @code{INTEGER(KIND=1)}, while, on others, it is
+effectively the same as @code{INTEGER(KIND=2)}.
+
+Do @emph{not} depend on @code{g77} actually writing valid pointers
+to these variables, however.
+While @code{g77} currently chooses that implementation, it might
+be changed in the future.
+
+@xref{Assigned Statement Labels,,Assigned Statement Labels (ASSIGN and GOTO)},
+for implementation details on assigned-statement labels.
+
+@node Compiler
+@chapter The GNU Fortran Compiler
+
+The GNU Fortran compiler, @code{g77}, supports programs written
+in the GNU Fortran language and in some other dialects of Fortran.
+
+Some aspects of how @code{g77} works are universal regardless
+of dialect, and yet are not properly part of the GNU Fortran
+language itself.
+These are described below.
+
+@emph{Note: This portion of the documentation definitely needs a lot
+of work!}
+
+@menu
+* Compiler Limits::
+* Compiler Types::
+* Compiler Constants::
+* Compiler Intrinsics::
+@end menu
+
+@node Compiler Limits
+@section Compiler Limits
+@cindex limits, compiler
+@cindex compiler limits
+
+@code{g77}, as with GNU tools in general, imposes few arbitrary restrictions
+on lengths of identifiers, number of continuation lines, number of external
+symbols in a program, and so on.
+
+@cindex options, -Nl
+@cindex -Nl option
+@cindex options, -Nx
+@cindex -Nx option
+For example, some other Fortran compiler have an option
+(such as @samp{-Nl@var{x}}) to increase the limit on the
+number of continuation lines.
+Also, some Fortran compilation systems have an option
+(such as @samp{-Nx@var{x}}) to increase the limit on the
+number of external symbols.
+
+@code{g77}, @code{gcc}, and GNU @code{ld} (the GNU linker) have
+no equivalent options, since they do not impose arbitrary
+limits in these areas.
+
+@cindex rank, maximum
+@cindex maximum rank
+@cindex number of dimensions, maximum
+@cindex maximum number of dimensions
+@code{g77} does currently limit the number of dimensions in an array
+to the same degree as do the Fortran standards---seven (7).
+This restriction might well be lifted in a future version.
+
+@node Compiler Types
+@section Compiler Types
+@cindex types, of data
+@cindex data types
+
+Fortran implementations have a fair amount of freedom given them by the
+standard as far as how much storage space is used and how much precision
+and range is offered by the various types such as @code{LOGICAL(KIND=1)},
+@code{INTEGER(KIND=1)}, @code{REAL(KIND=1)}, @code{REAL(KIND=2)},
+@code{COMPLEX(KIND=1)}, and @code{CHARACTER}.
+Further, many compilers offer so-called @samp{*@var{n}} notation, but
+the interpretation of @var{n} varies across compilers and target architectures.
+
+The standard requires that @code{LOGICAL(KIND=1)}, @code{INTEGER(KIND=1)},
+and @code{REAL(KIND=1)}
+occupy the same amount of storage space, and that @code{COMPLEX(KIND=1)}
+and @code{REAL(KIND=2)} take twice as much storage space as @code{REAL(KIND=1)}.
+Further, it requires that @code{COMPLEX(KIND=1)}
+entities be ordered such that when a @code{COMPLEX(KIND=1)} variable is
+storage-associated (such as via @code{EQUIVALENCE})
+with a two-element @code{REAL(KIND=1)} array named @samp{R}, @samp{R(1)}
+corresponds to the real element and @samp{R(2)} to the imaginary
+element of the @code{COMPLEX(KIND=1)} variable.
+
+(Few requirements as to precision or ranges of any of these are
+placed on the implementation, nor is the relationship of storage sizes of
+these types to the @code{CHARACTER} type specified, by the standard.)
+
+@code{g77} follows the above requirements, warning when compiling
+a program requires placement of items in memory that contradict the
+requirements of the target architecture.
+(For example, a program can require placement of a @code{REAL(KIND=2)}
+on a boundary that is not an even multiple of its size, but still an
+even multiple of the size of a @code{REAL(KIND=1)} variable.
+On some target architectures, using the canonical
+mapping of Fortran types to underlying architectural types, such
+placement is prohibited by the machine definition or
+the Application Binary Interface (ABI) in force for
+the configuration defined for building @code{gcc} and @code{g77}.
+@code{g77} warns about such
+situations when it encounters them.)
+
+@code{g77} follows consistent rules for configuring the mapping between Fortran
+types, including the @samp{*@var{n}} notation, and the underlying architectural
+types as accessed by a similarly-configured applicable version of the
+@code{gcc} compiler.
+These rules offer a widely portable, consistent Fortran/C
+environment, although they might well conflict with the expectations of
+users of Fortran compilers designed and written for particular
+architectures.
+
+These rules are based on the configuration that is in force for the
+version of @code{gcc} built in the same release as @code{g77} (and
+which was therefore used to build both the @code{g77} compiler
+components and the @code{libf2c} run-time library):
+
+@table @code
+@cindex REAL(KIND=1) type
+@cindex types, REAL(KIND=1)
+@item REAL(KIND=1)
+Same as @code{float} type.
+
+@cindex REAL(KIND=2) type
+@cindex types, REAL(KIND=2)
+@item REAL(KIND=2)
+Same as whatever floating-point type that is twice the size
+of a @code{float}---usually, this is a @code{double}.
+
+@cindex INTEGER(KIND=1) type
+@cindex types, INTEGER(KIND=1)
+@item INTEGER(KIND=1)
+Same as an integral type that is occupies the same amount
+of memory storage as @code{float}---usually, this is either
+an @code{int} or a @code{long int}.
+
+@cindex LOGICAL(KIND=1) type
+@cindex types, LOGICAL(KIND=1)
+@item LOGICAL(KIND=1)
+Same @code{gcc} type as @code{INTEGER(KIND=1)}.
+
+@cindex INTEGER(KIND=2) type
+@cindex types, INTEGER(KIND=2)
+@item INTEGER(KIND=2)
+Twice the size, and usually nearly twice the range,
+as @code{INTEGER(KIND=1)}---usually, this is either
+a @code{long int} or a @code{long long int}.
+
+@cindex LOGICAL(KIND=2) type
+@cindex types, LOGICAL(KIND=2)
+@item LOGICAL(KIND=2)
+Same @code{gcc} type as @code{INTEGER(KIND=2)}.
+
+@cindex INTEGER(KIND=3) type
+@cindex types, INTEGER(KIND=3)
+@item INTEGER(KIND=3)
+Same @code{gcc} type as signed @code{char}.
+
+@cindex LOGICAL(KIND=3) type
+@cindex types, LOGICAL(KIND=3)
+@item LOGICAL(KIND=3)
+Same @code{gcc} type as @code{INTEGER(KIND=3)}.
+
+@cindex INTEGER(KIND=6) type
+@cindex types, INTEGER(KIND=6)
+@item INTEGER(KIND=6)
+Twice the size, and usually nearly twice the range,
+as @code{INTEGER(KIND=3)}---usually, this is
+a @code{short}.
+
+@cindex LOGICAL(KIND=6) type
+@cindex types, LOGICAL(KIND=6)
+@item LOGICAL(KIND=6)
+Same @code{gcc} type as @code{INTEGER(KIND=6)}.
+
+@cindex COMPLEX(KIND=1) type
+@cindex types, COMPLEX(KIND=1)
+@item COMPLEX(KIND=1)
+Two @code{REAL(KIND=1)} scalars (one for the real part followed by
+one for the imaginary part).
+
+@cindex COMPLEX(KIND=2) type
+@cindex types, COMPLEX(KIND=2)
+@item COMPLEX(KIND=2)
+Two @code{REAL(KIND=2)} scalars.
+
+@cindex *@var{n} notation
+@item @var{numeric-type}*@var{n}
+(Where @var{numeric-type} is any type other than @code{CHARACTER}.)@
+Same as whatever @code{gcc} type occupies @var{n} times the storage
+space of a @code{gcc} @code{char} item.
+
+@cindex DOUBLE PRECISION type
+@cindex types, DOUBLE PRECISION
+@item DOUBLE PRECISION
+Same as @code{REAL(KIND=2)}.
+
+@cindex DOUBLE COMPLEX type
+@cindex types, DOUBLE COMPLEX
+@item DOUBLE COMPLEX
+Same as @code{COMPLEX(KIND=2)}.
+@end table
+
+Note that the above are proposed correspondences and might change
+in future versions of @code{g77}---avoid writing code depending
+on them.
+
+Other types supported by @code{g77}
+are derived from gcc types such as @code{char}, @code{short},
+@code{int}, @code{long int}, @code{long long int}, @code{long double},
+and so on.
+That is, whatever types @code{gcc} already supports, @code{g77} supports
+now or probably will support in a future version.
+The rules for the @samp{@var{numeric-type}*@var{n}} notation
+apply to these types,
+and new values for @samp{@var{numeric-type}(KIND=@var{n})} will be
+assigned in a way that encourages clarity, consistency, and portability.
+
+@node Compiler Constants
+@section Compiler Constants
+@cindex constants
+@cindex types, constants
+
+@code{g77} strictly assigns types to @emph{all} constants not
+documented as ``typeless'' (typeless constants including @samp{'1'Z},
+for example).
+Many other Fortran compilers attempt to assign types to typed constants
+based on their context.
+This results in hard-to-find bugs, nonportable
+code, and is not in the spirit (though it strictly follows the letter)
+of the 77 and 90 standards.
+
+@code{g77} might offer, in a future release, explicit constructs by
+which a wider variety of typeless constants may be specified, and/or
+user-requested warnings indicating places where @code{g77} might differ
+from how other compilers assign types to constants.
+
+@xref{Context-Sensitive Constants}, for more information on this issue.
+
+@node Compiler Intrinsics
+@section Compiler Intrinsics
+
+@code{g77} offers an ever-widening set of intrinsics.
+Currently these all are procedures (functions and subroutines).
+
+Some of these intrinsics are unimplemented, but their names reserved
+to reduce future problems with existing code as they are implemented.
+Others are implemented as part of the GNU Fortran language, while
+yet others are provided for compatibility with other dialects of
+Fortran but are not part of the GNU Fortran language.
+
+To manage these distinctions, @code{g77} provides intrinsic @emph{groups},
+a facility that is simply an extension of the intrinsic groups provided
+by the GNU Fortran language.
+
+@menu
+* Intrinsic Groups:: How intrinsics are grouped for easy management.
+* Other Intrinsics:: Intrinsics other than those in the GNU
+ Fortran language.
+@end menu
+
+@node Intrinsic Groups
+@subsection Intrinsic Groups
+@cindex groups of intrinsics
+@cindex intrinsics, groups
+
+A given specific intrinsic belongs in one or more groups.
+Each group is deleted, disabled, hidden, or enabled
+by default or a command-line option.
+The meaning of each term follows.
+
+@table @b
+@cindex deleted intrinsics
+@cindex intrinsics, deleted
+@item Deleted
+No intrinsics are recognized as belonging to that group.
+
+@cindex disabled intrinsics
+@cindex intrinsics, disabled
+@item Disabled
+Intrinsics are recognized as belonging to the group, but
+references to them (other than via the @code{INTRINSIC} statement)
+are disallowed through that group.
+
+@cindex hidden intrinsics
+@cindex intrinsics, hidden
+@item Hidden
+Intrinsics in that group are recognized and enabled (if implemented)
+@emph{only} if the first mention of the actual name of an intrinsic
+in a program unit is in an @code{INTRINSIC} statement.
+
+@cindex enabled intrinsics
+@cindex intrinsics, enabled
+@item Enabled
+Intrinsics in that group are recognized and enabled (if implemented).
+@end table
+
+The distinction between deleting and disabling a group is illustrated
+by the following example.
+Assume intrinsic @samp{FOO} belongs only to group @samp{FGR}.
+If group @samp{FGR} is deleted, the following program unit will
+successfully compile, because @samp{FOO()} will be seen as a
+reference to an external function named @samp{FOO}:
+
+@example
+PRINT *, FOO()
+END
+@end example
+
+@noindent
+If group @samp{FGR} is disabled, compiling the above program will produce
+diagnostics, either because the @samp{FOO} intrinsic is improperly invoked
+or, if properly invoked, it is not enabled.
+To change the above program so it references an external function @samp{FOO}
+instead of the disabled @samp{FOO} intrinsic,
+add the following line to the top:
+
+@example
+EXTERNAL FOO
+@end example
+
+@noindent
+So, deleting a group tells @code{g77} to pretend as though the intrinsics in
+that group do not exist at all, whereas disabling it tells @code{g77} to
+recognize them as (disabled) intrinsics in intrinsic-like contexts.
+
+Hiding a group is like enabling it, but the intrinsic must be first
+named in an @code{INTRINSIC} statement to be considered a reference to the
+intrinsic rather than to an external procedure.
+This might be the ``safest'' way to treat a new group of intrinsics
+when compiling old
+code, because it allows the old code to be generally written as if
+those new intrinsics never existed, but to be changed to use them
+by inserting @code{INTRINSIC} statements in the appropriate places.
+However, it should be the goal of development to use @code{EXTERNAL}
+for all names of external procedures that might be intrinsic names.
+
+If an intrinsic is in more than one group, it is enabled if any of its
+containing groups are enabled; if not so enabled, it is hidden if
+any of its containing groups are hidden; if not so hidden, it is disabled
+if any of its containing groups are disabled; if not so disabled, it is
+deleted.
+This extra complication is necessary because some intrinsics,
+such as @code{IBITS}, belong to more than one group, and hence should be
+enabled if any of the groups to which they belong are enabled, and so
+on.
+
+The groups are:
+
+@cindex intrinsics, groups of
+@cindex groups of intrinsics
+@table @code
+@item badu77
+UNIX intrinsics having inappropriate forms (usually functions that
+have intended side effects).
+
+@item gnu
+Intrinsics the GNU Fortran language supports that are extensions to
+the Fortran standards (77 and 90).
+
+@item f2c
+Intrinsics supported by AT&T's @code{f2c} converter and/or @code{libf2c}.
+
+@item f90
+Fortran 90 intrinsics.
+
+@item mil
+MIL-STD 1753 intrinsics (@code{MVBITS}, @code{IAND}, @code{BTEST}, and so on).
+
+@item unix
+UNIX intrinsics (@code{IARGC}, @code{EXIT}, @code{ERF}, and so on).
+
+@item vxt
+VAX/VMS FORTRAN (current as of v4) intrinsics.
+@end table
+
+@node Other Intrinsics
+@subsection Other Intrinsics
+@cindex intrinsics, others
+@cindex other intrinsics
+
+@code{g77} supports intrinsics other than those in the GNU Fortran
+language proper.
+This set of intrinsics is described below.
+
+@ifinfo
+(Note that the empty lines appearing in the menu below
+are not intentional---they result from a bug in the
+@code{makeinfo} program.)
+@end ifinfo
+
+@c The actual documentation for intrinsics comes from
+@c intdoc.texi, which in turn is automatically generated
+@c from the internal g77 tables in intrin.def _and_ the
+@c largely hand-written text in intdoc.h. So, if you want
+@c to change or add to existing documentation on intrinsics,
+@c you probably want to edit intdoc.h.
+@c
+@clear familyF77
+@clear familyGNU
+@clear familyASC
+@clear familyMIL
+@clear familyF90
+@set familyVXT
+@set familyFVZ
+@clear familyF2C
+@clear familyF2U
+@set familyBADU77
+@include intdoc.texi
+
+@node Other Compilers
+@chapter Other Compilers
+
+An individual Fortran source file can be compiled to
+an object (@file{*.o}) file instead of to the final
+program executable.
+This allows several portions of a program to be compiled
+at different times and linked together whenever a new
+version of the program is needed.
+However, it introduces the issue of @dfn{object compatibility}
+across the various object files (and libraries, or @file{*.a}
+files) that are linked together to produce any particular
+executable file.
+
+Object compatibility is an issue when combining, in one
+program, Fortran code compiled by more than one compiler
+(or more than one configuration of a compiler).
+If the compilers
+disagree on how to transform the names of procedures, there
+will normally be errors when linking such programs.
+Worse, if the compilers agree on naming, but disagree on issues
+like how to pass parameters, return arguments, and lay out
+@code{COMMON} areas, the earliest detected errors might be the
+incorrect results produced by the program (and that assumes
+these errors are detected, which is not always the case).
+
+Normally, @code{g77} generates code that is
+object-compatible with code generated by a version of
+@code{f2c} configured (with, for example, @file{f2c.h} definitions)
+to be generally compatible with @code{g77} as built by @code{gcc}.
+(Normally, @code{f2c} will, by default, conform to the appropriate
+configuration, but it is possible that older or perhaps even newer
+versions of @code{f2c}, or versions having certain configuration changes
+to @code{f2c} internals, will produce object files that are
+incompatible with @code{g77}.)
+
+For example, a Fortran string subroutine
+argument will become two arguments on the C side: a @code{char *}
+and an @code{int} length.
+
+Much of this compatibility results from the fact that
+@code{g77} uses the same run-time library, @code{libf2c}, used by
+@code{f2c}.
+
+Other compilers might or might not generate code that
+is object-compatible with @code{libf2c} and current @code{g77},
+and some might offer such compatibility only when explicitly
+selected via a command-line option to the compiler.
+
+@emph{Note: This portion of the documentation definitely needs a lot
+of work!}
+
+@menu
+* Dropping f2c Compatibility:: When speed is more important.
+* Compilers Other Than f2c:: Interoperation with code from other compilers.
+@end menu
+
+@node Dropping f2c Compatibility
+@section Dropping @code{f2c} Compatibility
+
+Specifying @samp{-fno-f2c} allows @code{g77} to generate, in
+some cases, faster code, by not needing to allow to the possibility
+of linking with code compiled by @code{f2c}.
+
+For example, this affects how @code{REAL(KIND=1)},
+@code{COMPLEX(KIND=1)}, and @code{COMPLEX(KIND=2)} functions are called.
+With @samp{-fno-f2c}, they are
+compiled as returning the appropriate @code{gcc} type
+(@code{float}, @code{__complex__ float}, @code{__complex__ double},
+in many configurations).
+
+With @samp{-ff2c} in force, they
+are compiled differently (with perhaps slower run-time performance)
+to accommodate the restrictions inherent in @code{f2c}'s use of K&R
+C as an intermediate language---@code{REAL(KIND=1)} functions
+return C's @code{double} type, while @code{COMPLEX} functions return
+@code{void} and use an extra argument pointing to a place for the functions to
+return their values.
+
+It is possible that, in some cases, leaving @samp{-ff2c} in force
+might produce faster code than using @samp{-fno-f2c}.
+Feel free to experiment, but remember to experiment with changing the way
+@emph{entire programs and their Fortran libraries are compiled} at
+a time, since this sort of experimentation affects the interface
+of code generated for a Fortran source file---that is, it affects
+object compatibility.
+
+Note that @code{f2c} compatibility is a fairly static target to achieve,
+though not necessarily perfectly so, since, like @code{g77}, it is
+still being improved.
+However, specifying @samp{-fno-f2c} causes @code{g77}
+to generate code that will probably be incompatible with code
+generated by future versions of @code{g77} when the same option
+is in force.
+You should make sure you are always able to recompile complete
+programs from source code when upgrading to new versions of @code{g77}
+or @code{f2c}, especially when using options such as @samp{-fno-f2c}.
+
+Therefore, if you are using @code{g77} to compile libraries and other
+object files for possible future use and you don't want to require
+recompilation for future use with subsequent versions of @code{g77},
+you might want to stick with @code{f2c} compatibility for now, and
+carefully watch for any announcements about changes to the
+@code{f2c}/@code{libf2c} interface that might affect existing programs
+(thus requiring recompilation).
+
+It is probable that a future version of @code{g77} will not,
+by default, generate object files compatible with @code{f2c},
+and that version probably would no longer use @code{libf2c}.
+If you expect to depend on this compatibility in the
+long term, use the options @samp{-ff2c -ff2c-library} when compiling
+all of the applicable code.
+This should cause future versions of @code{g77} either to produce
+compatible code (at the expense of the availability of some features and
+performance), or at the very least, to produce diagnostics.
+
+@node Compilers Other Than f2c
+@section Compilers Other Than @code{f2c}
+
+On systems with Fortran compilers other than @code{f2c} and @code{g77},
+code compiled by @code{g77} is not expected to work
+well with code compiled by the native compiler.
+(This is true for @code{f2c}-compiled objects as well.)@
+Libraries compiled with the native compiler probably will have
+to be recompiled with @code{g77} to be used with @code{g77}-compiled code.
+
+Reasons for such incompatibilities include:
+
+@itemize @bullet
+@item
+There might be differences in the way names of Fortran procedures
+are translated for use in the system's object-file format.
+For example, the statement @samp{CALL FOO} might be compiled
+by @code{g77} to call a procedure the linker @code{ld} sees
+given the name @samp{_foo_}, while the apparently corresponding
+statement @samp{SUBROUTINE FOO} might be compiled by the
+native compiler to define the linker-visible name @samp{_foo},
+or @samp{_FOO_}, and so on.
+
+@item
+There might be subtle type mismatches which cause subroutine arguments
+and function return values to get corrupted.
+
+This is why simply getting @code{g77} to
+transform procedure names the same way a native
+compiler does is not usually a good idea---unless
+some effort has been made to ensure that, aside
+from the way the two compilers transform procedure
+names, everything else about the way they generate
+code for procedure interfaces is identical.
+
+@item
+Native compilers
+use libraries of private I/O routines which will not be available
+at link time unless you have the native compiler---and you would
+have to explicitly ask for them.
+
+For example, on the Sun you
+would have to add @samp{-L/usr/lang/SCx.x -lF77 -lV77} to the link
+command.
+@end itemize
+
+@node Other Languages
+@chapter Other Languages
+
+@emph{Note: This portion of the documentation definitely needs a lot
+of work!}
+
+@menu
+* Interoperating with C and C++::
+@end menu
+
+@node Interoperating with C and C++
+@section Tools and advice for interoperating with C and C++
+
+@cindex C, linking with
+@cindex C++, linking with
+@cindex linking with C
+The following discussion assumes that you are running @code{g77} in @code{f2c}
+compatibility mode, i.e.@ not using @samp{-fno-f2c}.
+It provides some
+advice about quick and simple techniques for linking Fortran and C (or
+C++), the most common requirement.
+For the full story consult the
+description of code generation.
+@xref{Debugging and Interfacing}.
+
+When linking Fortran and C, it's usually best to use @code{g77} to do
+the linking so that the correct libraries are included (including the
+maths one).
+If you're linking with C++ you will want to add
+@samp{-lstdc++}, @samp{-lg++} or whatever.
+If you need to use another
+driver program (or @code{ld} directly),
+you can find out what linkage
+options @code{g77} passes by running @samp{g77 -v}.
+
+@menu
+* C Interfacing Tools::
+* C Access to Type Information::
+* f2c Skeletons and Prototypes::
+* C++ Considerations::
+* Startup Code::
+@end menu
+
+@node C Interfacing Tools
+@subsection C Interfacing Tools
+@pindex f2c
+@cindex cfortran.h
+@cindex Netlib
+Even if you don't actually use it as a compiler, @samp{f2c} from
+@url{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're
+interfacing (linking) Fortran and C@.
+@xref{f2c Skeletons and Prototypes,,Generating Skeletons and Prototypes with @code{f2c}}.
+
+To use @code{f2c} for this purpose you only need retrieve and
+build the @file{src} directory from the distribution, consult the
+@file{README} instructions there for machine-specifics, and install the
+@code{f2c} program on your path.
+
+Something else that might be useful is @samp{cfortran.h} from
+@url{ftp://zebra/desy.de/cfortran}.
+This is a fairly general tool which
+can be used to generate interfaces for calling in both directions
+between Fortran and C@.
+It can be used in @code{f2c} mode with
+@code{g77}---consult its documentation for details.
+
+@node C Access to Type Information
+@subsection Accessing Type Information in C
+
+@cindex types, Fortran/C
+Generally, C code written to link with
+@code{g77} code---calling and/or being
+called from Fortran---should @samp{#include <f2c.h>} to define the C
+versions of the Fortran types.
+Don't assume Fortran @code{INTEGER} types
+correspond to C @samp{int}s, for instance; instead, declare them as
+@code{integer}, a type defined by @file{f2c.h}.
+@file{f2c.h} is installed where @code{gcc} will find it by
+default, assuming you use a copy of @code{gcc} compatible with
+@code{g77}, probably built at the same time as @code{g77}.
+
+@node f2c Skeletons and Prototypes
+@subsection Generating Skeletons and Prototypes with @code{f2c}
+
+@pindex f2c
+@cindex -fno-second-underscore
+A simple and foolproof way to write @code{g77}-callable C routines---e.g.@ to
+interface with an existing library---is to write a file (named, for
+example, @file{fred.f}) of dummy Fortran
+skeletons comprising just the declaration of the routine(s) and dummy
+arguments plus @samp{END} statements.
+Then run @code{f2c} on file @file{fred.f} to produce @file{fred.c}
+into which you can edit
+useful code, confident the calling sequence is correct, at least.
+(There are some errors otherwise commonly made in generating C
+interfaces with f2c conventions, such as not using @code{doublereal} as
+the return type of a @code{REAL} @code{FUNCTION}.)
+
+@pindex ftnchek
+@code{f2c} also can help with calling Fortran from C, using its
+@samp{-P} option to generate C prototypes appropriate for calling the
+Fortran.@footnote{The files generated like this can also be used for
+inter-unit consistency checking of dummy and actual arguments, although
+the @samp{ftnchek} tool from @url{ftp://ftp.netlib.org/fortran} is
+probably better for this purpose.}
+If the Fortran code containing any
+routines to be called from C is in file @file{joe.f}, use the command
+@kbd{f2c -P joe.f} to generate the file @file{joe.P} containing
+prototype information.
+@code{#include} this in the C which has to call
+the Fortran routines to make sure you get it right.
+
+@xref{Arrays,,Arrays (DIMENSION}, for information on the differences
+between the way Fortran (including compilers like @code{g77}) and
+C handle arrays.
+
+@node C++ Considerations
+@subsection C++ Considerations
+
+@cindex C++
+@code{f2c} can be used to generate suitable code for compilation with a
+C++ system using the @samp{-C++} option.
+The important thing about linking @code{g77}-compiled
+code with C++ is that the prototypes for the @code{g77}
+routines must specify C linkage to avoid name mangling.
+So, use an @samp{extern "C"} declaration.
+@code{f2c}'s @samp{-C++} option will take care
+of this when generating skeletons or prototype files as above, and also
+avoid clashes with C++ reserved words in addition to those in C@.
+
+@node Startup Code
+@subsection Startup Code
+
+@cindex startup code
+@cindex runtime initialization
+@cindex initialization, runtime
+Unlike with some runtime systems, it shouldn't be necessary (unless there are
+bugs) to use a Fortran main program to ensure the
+runtime---specifically the i/o system---is initialized.
+However, to use
+the @code{g77} intrinsics @code{GETARG()} and @code{IARGC()} the
+@code{main()} routine from the @file{libf2c} library must be used, either
+explicitly or implicitly by using a Fortran main program.
+This
+@code{main()} program calls @code{MAIN__()} (where the names are C-type
+@code{extern} names, i.e.@ not mangled).
+You need to provide this
+nullary procedure as the entry point for your C code if using
+@file{libf2c}'s @code{main}.
+In some cases it might be necessary to
+provide a dummy version of this to avoid linkers complaining about
+failure to resolve @code{MAIN__()} if linking against @file{libf2c} and
+not using @code{main()} from it.
+
+@include install.texi
+
+@node Debugging and Interfacing
+@chapter Debugging and Interfacing
+@cindex debugging
+@cindex interfacing
+@cindex calling C routines
+@cindex C routines calling Fortran
+@cindex f2c compatibility
+
+GNU Fortran currently generates code that is object-compatible with
+the @code{f2c} converter.
+Also, it avoids limitations in the current GBE, such as the
+inability to generate a procedure with
+multiple entry points, by generating code that is structured
+differently (in terms of procedure names, scopes, arguments, and
+so on) than might be expected.
+
+As a result, writing code in other languages that calls on, is
+called by, or shares in-memory data with @code{g77}-compiled code generally
+requires some understanding of the way @code{g77} compiles code for
+various constructs.
+
+Similarly, using a debugger to debug @code{g77}-compiled
+code, even if that debugger supports native Fortran debugging, generally
+requires this sort of information.
+
+This section describes some of the basic information on how
+@code{g77} compiles code for constructs involving interfaces to other
+languages and to debuggers.
+
+@emph{Caution:} Much or all of this information pertains to only the current
+release of @code{g77}, sometimes even to using certain compiler options
+with @code{g77} (such as @samp{-fno-f2c}).
+Do not write code that depends on this
+information without clearly marking said code as nonportable and
+subject to review for every new release of @code{g77}.
+This information
+is provided primarily to make debugging of code generated by this
+particular release of @code{g77} easier for the user, and partly to make
+writing (generally nonportable) interface code easier.
+Both of these
+activities require tracking changes in new version of @code{g77} as they
+are installed, because new versions can change the behaviors
+described in this section.
+
+@menu
+* Main Program Unit:: How @code{g77} compiles a main program unit.
+* Procedures:: How @code{g77} constructs parameter lists
+ for procedures.
+* Functions:: Functions returning floating-point or character data.
+* Names:: Naming of user-defined variables, procedures, etc.
+* Common Blocks:: Accessing common variables while debugging.
+* Local Equivalence Areas:: Accessing @code{EQUIVALENCE} while debugging.
+* Complex Variables:: How @code{g77} performs complex arithmetic.
+* Arrays:: Dealing with (possibly multi-dimensional) arrays.
+* Adjustable Arrays:: Special consideration for adjustable arrays.
+* Alternate Entry Points:: How @code{g77} implements alternate @code{ENTRY}.
+* Alternate Returns:: How @code{g77} handles alternate returns.
+* Assigned Statement Labels:: How @code{g77} handles @code{ASSIGN}.
+* Run-time Library Errors:: Meanings of some @code{IOSTAT=} values.
+@end menu
+
+@node Main Program Unit
+@section Main Program Unit (PROGRAM)
+@cindex PROGRAM statement
+@cindex statements, PROGRAM
+
+When @code{g77} compiles a main program unit, it gives it the public
+procedure name @samp{MAIN__}.
+The @code{libf2c} library has the actual @code{main()} procedure
+as is typical of C-based environments, and
+it is this procedure that performs some initial start-up
+activity and then calls @samp{MAIN__}.
+
+Generally, @code{g77} and @code{libf2c} are designed so that you need not
+include a main program unit written in Fortran in your program---it
+can be written in C or some other language.
+Especially for I/O handling, this is the case, although @code{g77} version 0.5.16
+includes a bug fix for @code{libf2c} that solved a problem with using the
+@code{OPEN} statement as the first Fortran I/O activity in a program
+without a Fortran main program unit.
+
+However, if you don't intend to use @code{g77} (or @code{f2c}) to compile
+your main program unit---that is, if you intend to compile a @code{main()}
+procedure using some other language---you should carefully
+examine the code for @code{main()} in @code{libf2c}, found in the source
+file @file{gcc/f/runtime/libF77/main.c}, to see what kinds of things
+might need to be done by your @code{main()} in order to provide the
+Fortran environment your Fortran code is expecting.
+
+@cindex IARGC() intrinsic
+@cindex intrinsics, IARGC()
+@cindex GETARG() intrinsic
+@cindex intrinsics, GETARG()
+For example, @code{libf2c}'s @code{main()} sets up the information used by
+the @code{IARGC} and @code{GETARG} intrinsics.
+Bypassing @code{libf2c}'s @code{main()}
+without providing a substitute for this activity would mean
+that invoking @code{IARGC} and @code{GETARG} would produce undefined
+results.
+
+@cindex debugging
+@cindex main program unit, debugging
+@cindex main()
+@cindex MAIN__()
+@cindex .gdbinit
+When debugging, one implication of the fact that @code{main()}, which
+is the place where the debugged program ``starts'' from the
+debugger's point of view, is in @code{libf2c} is that you won't be
+starting your Fortran program at a point you recognize as your
+Fortran code.
+
+The standard way to get around this problem is to set a break
+point (a one-time, or temporary, break point will do) at
+the entrance to @samp{MAIN__}, and then run the program.
+A convenient way to do so is to add the @code{gdb} command
+
+@example
+tbreak MAIN__
+@end example
+
+@noindent
+to the file @file{.gdbinit} in the directory in which you're debugging
+(using @code{gdb}).
+
+After doing this, the debugger will see the current execution
+point of the program as at the beginning of the main program
+unit of your program.
+
+Of course, if you really want to set a break point at some
+other place in your program and just start the program
+running, without first breaking at @samp{MAIN__},
+that should work fine.
+
+@node Procedures
+@section Procedures (SUBROUTINE and FUNCTION)
+@cindex procedures
+@cindex SUBROUTINE statement
+@cindex statements, SUBROUTINE
+@cindex FUNCTION statement
+@cindex statements, FUNCTION
+@cindex signature of procedures
+
+Currently, @code{g77} passes arguments via reference---specifically,
+by passing a pointer to the location in memory of a variable, array,
+array element, a temporary location that holds the result of evaluating an
+expression, or a temporary or permanent location that holds the value
+of a constant.
+
+Procedures that accept @code{CHARACTER} arguments are implemented by
+@code{g77} so that each @code{CHARACTER} argument has two actual arguments.
+
+The first argument occupies the expected position in the
+argument list and has the user-specified name.
+This argument
+is a pointer to an array of characters, passed by the caller.
+
+The second argument is appended to the end of the user-specified
+calling sequence and is named @samp{__g77_length_@var{x}}, where @var{x}
+is the user-specified name.
+This argument is of the C type @code{ftnlen}
+(see @file{gcc/f/runtime/f2c.h.in} for information on that type) and
+is the number of characters the caller has allocated in the
+array pointed to by the first argument.
+
+A procedure will ignore the length argument if @samp{X} is not declared
+@code{CHARACTER*(*)}, because for other declarations, it knows the
+length.
+Not all callers necessarily ``know'' this, however, which
+is why they all pass the extra argument.
+
+The contents of the @code{CHARACTER} argument are specified by the
+address passed in the first argument (named after it).
+The procedure can read or write these contents as appropriate.
+
+When more than one @code{CHARACTER} argument is present in the argument
+list, the length arguments are appended in the order
+the original arguments appear.
+So @samp{CALL FOO('HI','THERE')} is implemented in
+C as @samp{foo("hi","there",2,5);}, ignoring the fact that @code{g77}
+does not provide the trailing null bytes on the constant
+strings (@code{f2c} does provide them, but they are unnecessary in
+a Fortran environment, and you should not expect them to be
+there).
+
+Note that the above information applies to @code{CHARACTER} variables and
+arrays @strong{only}.
+It does @strong{not} apply to external @code{CHARACTER}
+functions or to intrinsic @code{CHARACTER} functions.
+That is, no second length argument is passed to @samp{FOO} in this case:
+
+@example
+CHARACTER X
+EXTERNAL X
+CALL FOO(X)
+@end example
+
+@noindent
+Nor does @samp{FOO} expect such an argument in this case:
+
+@example
+SUBROUTINE FOO(X)
+CHARACTER X
+EXTERNAL X
+@end example
+
+Because of this implementation detail, if a program has a bug
+such that there is disagreement as to whether an argument is
+a procedure, and the type of the argument is @code{CHARACTER}, subtle
+symptoms might appear.
+
+@node Functions
+@section Functions (FUNCTION and RETURN)
+@cindex functions
+@cindex FUNCTION statement
+@cindex statements, FUNCTION
+@cindex RETURN statement
+@cindex statements, RETURN
+@cindex return type of functions
+
+@code{g77} handles in a special way functions that return the following
+types:
+
+@itemize @bullet
+@item
+@code{CHARACTER}
+@item
+@code{COMPLEX}
+@item
+@code{REAL(KIND=1)}
+@end itemize
+
+For @code{CHARACTER}, @code{g77} implements a subroutine (a C function
+returning @code{void})
+with two arguments prepended: @samp{__g77_result}, which the caller passes
+as a pointer to a @code{char} array expected to hold the return value,
+and @samp{__g77_length}, which the caller passes as an @code{ftnlen} value
+specifying the length of the return value as declared in the calling
+program.
+For @code{CHARACTER*(*)}, the called function uses @samp{__g77_length}
+to determine the size of the array that @samp{__g77_result} points to;
+otherwise, it ignores that argument.
+
+For @code{COMPLEX}, when @samp{-ff2c} is in
+force, @code{g77} implements
+a subroutine with one argument prepended: @samp{__g77_result}, which the
+caller passes as a pointer to a variable of the type of the function.
+The called function writes the return value into this variable instead
+of returning it as a function value.
+When @samp{-fno-f2c} is in force,
+@code{g77} implements a @code{COMPLEX} function as @code{gcc}'s
+@samp{__complex__ float} or @samp{__complex__ double} function
+(or an emulation thereof, when @samp{-femulate-complex} is in effect),
+returning the result of the function in the same way as @code{gcc} would.
+
+For @code{REAL(KIND=1)}, when @samp{-ff2c} is in force, @code{g77} implements
+a function that actually returns @code{REAL(KIND=2)} (typically
+C's @code{double} type).
+When @samp{-fno-f2c} is in force, @code{REAL(KIND=1)}
+functions return @code{float}.
+
+@node Names
+@section Names
+@cindex symbol names
+@cindex transformation of symbol names
+
+Fortran permits each implementation to decide how to represent
+names as far as how they're seen in other contexts, such as debuggers
+and when interfacing to other languages, and especially as far
+as how casing is handled.
+
+External names---names of entities that are public, or ``accessible'',
+to all modules in a program---normally have an underscore (@samp{_})
+appended by @code{g77}, to generate code that is compatible with f2c.
+External names include names of Fortran things like common blocks,
+external procedures (subroutines and functions, but not including
+statement functions, which are internal procedures), and entry point
+names.
+
+However, use of the @samp{-fno-underscoring} option
+disables this kind of transformation of external names (though inhibiting
+the transformation certainly improves the chances of colliding with
+incompatible externals written in other languages---but that
+might be intentional.
+
+@cindex -fno-underscoring option
+@cindex options, -fno-underscoring
+@cindex -fno-second-underscore option
+@cindex options, -fno-underscoring
+When @samp{-funderscoring} is in force, any name (external or local)
+that already has at least one underscore in it is
+implemented by @code{g77} by appending two underscores.
+(This second underscore can be disabled via the
+@samp{-fno-second-underscore} option.)@
+External names are changed this way for @code{f2c} compatibility.
+Local names are changed this way to avoid collisions with external names
+that are different in the source code---@code{f2c} does the same thing, but
+there's no compatibility issue there except for user expectations while
+debugging.
+
+For example:
+
+@example
+Max_Cost = 0
+@end example
+
+@cindex debugging
+@noindent
+Here, a user would, in the debugger, refer to this variable using the
+name @samp{max_cost__} (or @samp{MAX_COST__} or @samp{Max_Cost__},
+as described below).
+(We hope to improve @code{g77} in this regard in the future---don't
+write scripts depending on this behavior!
+Also, consider experimenting with the @samp{-fno-underscoring}
+option to try out debugging without having to massage names by
+hand like this.)
+
+@code{g77} provides a number of command-line options that allow the user
+to control how case mapping is handled for source files.
+The default is the traditional UNIX model for Fortran compilers---names
+are mapped to lower case.
+Other command-line options can be specified to map names to upper
+case, or to leave them exactly as written in the source file.
+
+For example:
+
+@example
+Foo = 9.436
+@end example
+
+@noindent
+Here, it is normally the case that the variable assigned will be named
+@samp{foo}.
+This would be the name to enter when using a debugger to
+access the variable.
+
+However, depending on the command-line options specified, the
+name implemented by @code{g77} might instead be @samp{FOO} or even
+@samp{Foo}, thus affecting how debugging is done.
+
+Also:
+
+@example
+Call Foo
+@end example
+
+@noindent
+This would normally call a procedure that, if it were in a separate C program,
+be defined starting with the line:
+
+@example
+void foo_()
+@end example
+
+@noindent
+However, @code{g77} command-line options could be used to change the casing
+of names, resulting in the name @samp{FOO_} or @samp{Foo_} being given to the
+procedure instead of @samp{foo_}, and the @samp{-fno-underscoring} option
+could be used to inhibit the appending of the underscore to the name.
+
+@node Common Blocks
+@section Common Blocks (COMMON)
+@cindex common blocks
+@cindex COMMON statement
+@cindex statements, COMMON
+
+@code{g77} names and lays out @code{COMMON} areas the same way f2c does,
+for compatibility with f2c.
+
+Currently, @code{g77} does not emit ``true'' debugging information for
+members of a @code{COMMON} area, due to an apparent bug in the GBE.
+
+(As of Version 0.5.19, @code{g77} emits debugging information for such
+members in the form of a constant string specifying the base name of
+the aggregate area and the offset of the member in bytes from the start
+of the area.
+Use the @samp{-fdebug-kludge} option to enable this behavior.
+In @code{gdb}, use @samp{set language c} before printing the value
+of the member, then @samp{set language fortran} to restore the default
+language, since @code{gdb} doesn't provide a way to print a readable
+version of a character string in Fortran language mode.
+
+This kludge will be removed in a future version of @code{g77} that,
+in conjunction with a contemporary version of @code{gdb},
+properly supports Fortran-language debugging, including access
+to members of @code{COMMON} areas.)
+
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for information on the @samp{-fdebug-kludge} option.
+
+Moreover, @code{g77} currently implements a @code{COMMON} area such that its
+type is an array of the C @code{char} data type.
+
+So, when debugging, you must know the offset into a @code{COMMON} area
+for a particular item in that area, and you have to take into
+account the appropriate multiplier for the respective sizes
+of the types (as declared in your code) for the items preceding
+the item in question as compared to the size of the @code{char} type.
+
+For example, using default implicit typing, the statement
+
+@example
+COMMON I(15), R(20), T
+@end example
+
+@noindent
+results in a public 144-byte @code{char} array named @samp{_BLNK__}
+with @samp{I} placed at @samp{_BLNK__[0]}, @samp{R} at @samp{_BLNK__[60]},
+and @samp{T} at @samp{_BLNK__[140]}.
+(This is assuming that the target machine for
+the compilation has 4-byte @code{INTEGER(KIND=1)} and @code{REAL(KIND=1)}
+types.)
+
+@node Local Equivalence Areas
+@section Local Equivalence Areas (EQUIVALENCE)
+@cindex equivalence areas
+@cindex local equivalence areas
+@cindex EQUIVALENCE statement
+@cindex statements, EQUIVALENCE
+
+@code{g77} treats storage-associated areas involving a @code{COMMON}
+block as explained in the section on common blocks.
+
+A local @code{EQUIVALENCE} area is a collection of variables and arrays
+connected to each other in any way via @code{EQUIVALENCE}, none of which are
+listed in a @code{COMMON} statement.
+
+Currently, @code{g77} does not emit ``true'' debugging information for
+members in a local @code{EQUIVALENCE} area, due to an apparent bug in the GBE.
+
+(As of Version 0.5.19, @code{g77} does emit debugging information for such
+members in the form of a constant string specifying the base name of
+the aggregate area and the offset of the member in bytes from the start
+of the area.
+Use the @samp{-fdebug-kludge} option to enable this behavior.
+In @code{gdb}, use @samp{set language c} before printing the value
+of the member, then @samp{set language fortran} to restore the default
+language, since @code{gdb} doesn't provide a way to print a readable
+version of a character string in Fortran language mode.
+
+This kludge will be removed in a future version of @code{g77} that,
+in conjunction with a contemporary version of @code{gdb},
+properly supports Fortran-language debugging, including access
+to members of @code{EQUIVALENCE} areas.)
+
+@xref{Code Gen Options,,Options for Code Generation Conventions},
+for information on the @samp{-fdebug-kludge} option.
+
+Moreover, @code{g77} implements a local @code{EQUIVALENCE} area such that its
+type is an array of the C @code{char} data type.
+
+The name @code{g77} gives this array of @code{char} type is @samp{__g77_equiv_@var{x}},
+where @var{x} is the name of the item that is placed at the beginning (offset 0)
+of this array.
+If more than one such item is placed at the beginning, @var{x} is
+the name that sorts to the top in an alphabetical sort of the list of
+such items.
+
+When debugging, you must therefore access members of @code{EQUIVALENCE}
+areas by specifying the appropriate @samp{__g77_equiv_@var{x}}
+array section with the appropriate offset.
+See the explanation of debugging @code{COMMON} blocks
+for info applicable to debugging local @code{EQUIVALENCE} areas.
+
+(@emph{Note:} @code{g77} version 0.5.18 and earlier chose the name
+for @var{x} using a different method when more than one name was
+in the list of names of entities placed at the beginning of the
+array.
+Though the documentation specified that the first name listed in
+the @code{EQUIVALENCE} statements was chosen for @var{x}, @code{g77}
+in fact chose the name using a method that was so complicated,
+it seemed easier to change it to an alphabetical sort than to describe the
+previous method in the documentation.)
+
+@node Complex Variables
+@section Complex Variables (COMPLEX)
+@cindex complex variables
+@cindex imaginary part of complex
+@cindex COMPLEX statement
+@cindex statements, COMPLEX
+
+As of 0.5.20, @code{g77} defaults to handling @code{COMPLEX} types
+(and related intrinsics, constants, functions, and so on)
+in a manner that
+makes direct debugging involving these types in Fortran
+language mode difficult.
+
+Essentially, @code{g77} implements these types using an
+internal construct similar to C's @code{struct}, at least
+as seen by the @code{gcc} back end.
+
+Currently, the back end, when outputting debugging info with
+the compiled code for the assembler to digest, does not detect
+these @code{struct} types as being substitutes for Fortran
+complex.
+As a result, the Fortran language modes of debuggers such as
+@code{gdb} see these types as C @code{struct} types, which
+they might or might not support.
+
+Until this is fixed, switch to C language mode to work with
+entities of @code{COMPLEX} type and then switch back to Fortran language
+mode afterward.
+(In @code{gdb}, this is accomplished via @samp{set lang c} and
+either @samp{set lang fortran} or @samp{set lang auto}.)
+
+@emph{Note:} Compiling with the @samp{-fno-emulate-complex} option
+avoids the debugging problem, but is known to cause other problems
+like compiler crashes and generation of incorrect code, so it is
+not recommended.
+
+@node Arrays
+@section Arrays (DIMENSION)
+@cindex DIMENSION statement
+@cindex statements, DIMENSION
+@cindex array ordering
+@cindex ordering, array
+@cindex column-major ordering
+@cindex row-major ordering
+@cindex arrays
+
+Fortran uses ``column-major ordering'' in its arrays.
+This differs from other languages, such as C, which use ``row-major ordering''.
+The difference is that, with Fortran, array elements adjacent to
+each other in memory differ in the @emph{first} subscript instead of
+the last; @samp{A(5,10,20)} immediately follows @samp{A(4,10,20)},
+whereas with row-major ordering it would follow @samp{A(5,10,19)}.
+
+This consideration
+affects not only interfacing with and debugging Fortran code,
+it can greatly affect how code is designed and written, especially
+when code speed and size is a concern.
+
+Fortran also differs from C, a popular language for interfacing and
+to support directly in debuggers, in the way arrays are treated.
+In C, arrays are single-dimensional and have interesting relationships
+to pointers, neither of which is true for Fortran.
+As a result, dealing with Fortran arrays from within
+an environment limited to C concepts can be challenging.
+
+For example, accessing the array element @samp{A(5,10,20)} is easy enough
+in Fortran (use @samp{A(5,10,20)}), but in C some difficult machinations
+are needed.
+First, C would treat the A array as a single-dimension array.
+Second, C does not understand low bounds for arrays as does Fortran.
+Third, C assumes a low bound of zero (0), while Fortran defaults to a
+low bound of one (1) and can supports an arbitrary low bound.
+Therefore, calculations must be done
+to determine what the C equivalent of @samp{A(5,10,20)} would be, and these
+calculations require knowing the dimensions of @samp{A}.
+
+For @samp{DIMENSION A(2:11,21,0:29)}, the calculation of the offset of
+@samp{A(5,10,20)} would be:
+
+@example
+ (5-2)
++ (10-1)*(11-2+1)
++ (20-0)*(11-2+1)*(21-1+1)
+= 4293
+@end example
+
+@noindent
+So the C equivalent in this case would be @samp{a[4293]}.
+
+When using a debugger directly on Fortran code, the C equivalent
+might not work, because some debuggers cannot understand the notion
+of low bounds other than zero. However, unlike @code{f2c}, @code{g77}
+does inform the GBE that a multi-dimensional array (like @samp{A}
+in the above example) is really multi-dimensional, rather than a
+single-dimensional array, so at least the dimensionality of the array
+is preserved.
+
+Debuggers that understand Fortran should have no trouble with
+non-zero low bounds, but for non-Fortran debuggers, especially
+C debuggers, the above example might have a C equivalent of
+@samp{a[4305]}.
+This calculation is arrived at by eliminating the subtraction
+of the lower bound in the first parenthesized expression on each
+line---that is, for @samp{(5-2)} substitute @samp{(5)}, for @samp{(10-1)}
+substitute @samp{(10)}, and for @samp{(20-0)} substitute @samp{(20)}.
+Actually, the implication of
+this can be that the expression @samp{*(&a[2][1][0] + 4293)} works fine,
+but that @samp{a[20][10][5]} produces the equivalent of
+@samp{*(&a[0][0][0] + 4305)} because of the missing lower bounds.
+
+Come to think of it, perhaps
+the behavior is due to the debugger internally compensating for
+the lower bounds by offsetting the base address of @samp{a}, leaving
+@samp{&a} set lower, in this case, than @samp{&a[2][1][0]} (the address of
+its first element as identified by subscripts equal to the
+corresponding lower bounds).
+
+You know, maybe nobody really needs to use arrays.
+
+@node Adjustable Arrays
+@section Adjustable Arrays (DIMENSION)
+@cindex arrays, adjustable
+@cindex adjustable arrays
+@cindex arrays, automatic
+@cindex automatic arrays
+@cindex DIMENSION statement
+@cindex statements, DIMENSION
+@cindex dimensioning arrays
+@cindex arrays, dimensioning
+
+Adjustable and automatic arrays in Fortran require the implementation
+(in this
+case, the @code{g77} compiler) to ``memorize'' the expressions that
+dimension the arrays each time the procedure is invoked.
+This is so that subsequent changes to variables used in those
+expressions, made during execution of the procedure, do not
+have any effect on the dimensions of those arrays.
+
+For example:
+
+@example
+REAL ARRAY(5)
+DATA ARRAY/5*2/
+CALL X(ARRAY, 5)
+END
+SUBROUTINE X(A, N)
+DIMENSION A(N)
+N = 20
+PRINT *, N, A
+END
+@end example
+
+@noindent
+Here, the implementation should, when running the program, print something
+like:
+
+@example
+20 2. 2. 2. 2. 2.
+@end example
+
+@noindent
+Note that this shows that while the value of @samp{N} was successfully
+changed, the size of the @samp{A} array remained at 5 elements.
+
+To support this, @code{g77} generates code that executes before any user
+code (and before the internally generated computed @code{GOTO} to handle
+alternate entry points, as described below) that evaluates each
+(nonconstant) expression in the list of subscripts for an
+array, and saves the result of each such evaluation to be used when
+determining the size of the array (instead of re-evaluating the
+expressions).
+
+So, in the above example, when @samp{X} is first invoked, code is
+executed that copies the value of @samp{N} to a temporary.
+And that same temporary serves as the actual high bound for the single
+dimension of the @samp{A} array (the low bound being the constant 1).
+Since the user program cannot (legitimately) change the value
+of the temporary during execution of the procedure, the size
+of the array remains constant during each invocation.
+
+For alternate entry points, the code @code{g77} generates takes into
+account the possibility that a dummy adjustable array is not actually
+passed to the actual entry point being invoked at that time.
+In that case, the public procedure implementing the entry point
+passes to the master private procedure implementing all the
+code for the entry points a @code{NULL} pointer where a pointer to that
+adjustable array would be expected.
+The @code{g77}-generated code
+doesn't attempt to evaluate any of the expressions in the subscripts
+for an array if the pointer to that array is @code{NULL} at run time in
+such cases.
+(Don't depend on this particular implementation
+by writing code that purposely passes @code{NULL} pointers where the
+callee expects adjustable arrays, even if you know the callee
+won't reference the arrays---nor should you pass @code{NULL} pointers
+for any dummy arguments used in calculating the bounds of such
+arrays or leave undefined any values used for that purpose in
+COMMON---because the way @code{g77} implements these things might
+change in the future!)
+
+@node Alternate Entry Points
+@section Alternate Entry Points (ENTRY)
+@cindex alternate entry points
+@cindex entry points
+@cindex ENTRY statement
+@cindex statements, ENTRY
+
+The GBE does not understand the general concept of
+alternate entry points as Fortran provides via the ENTRY statement.
+@code{g77} gets around this by using an approach to compiling procedures
+having at least one @code{ENTRY} statement that is almost identical to the
+approach used by @code{f2c}.
+(An alternate approach could be used that
+would probably generate faster, but larger, code that would also
+be a bit easier to debug.)
+
+Information on how @code{g77} implements @code{ENTRY} is provided for those
+trying to debug such code.
+The choice of implementation seems
+unlikely to affect code (compiled in other languages) that interfaces
+to such code.
+
+@code{g77} compiles exactly one public procedure for the primary entry
+point of a procedure plus each @code{ENTRY} point it specifies, as usual.
+That is, in terms of the public interface, there is no difference
+between
+
+@example
+SUBROUTINE X
+END
+SUBROUTINE Y
+END
+@end example
+
+@noindent
+and:
+
+@example
+SUBROUTINE X
+ENTRY Y
+END
+@end example
+
+The difference between the above two cases lies in the code compiled
+for the @samp{X} and @samp{Y} procedures themselves, plus the fact that,
+for the second case, an extra internal procedure is compiled.
+
+For every Fortran procedure with at least one @code{ENTRY}
+statement, @code{g77} compiles an extra procedure
+named @samp{__g77_masterfun_@var{x}}, where @var{x} is
+the name of the primary entry point (which, in the above case,
+using the standard compiler options, would be @samp{x_} in C).
+
+This extra procedure is compiled as a private procedure---that is,
+a procedure not accessible by name to separately compiled modules.
+It contains all the code in the program unit, including the code
+for the primary entry point plus for every entry point.
+(The code for each public procedure is quite short, and explained later.)
+
+The extra procedure has some other interesting characteristics.
+
+The argument list for this procedure is invented by @code{g77}.
+It contains
+a single integer argument named @samp{__g77_which_entrypoint},
+passed by value (as in Fortran's @samp{%VAL()} intrinsic), specifying the
+entry point index---0 for the primary entry point, 1 for the
+first entry point (the first @code{ENTRY} statement encountered), 2 for
+the second entry point, and so on.
+
+It also contains, for functions returning @code{CHARACTER} and
+(when @samp{-ff2c} is in effect) @code{COMPLEX} functions,
+and for functions returning different types among the
+@code{ENTRY} statements (e.g. @samp{REAL FUNCTION R()}
+containing @samp{ENTRY I()}), an argument named @samp{__g77_result} that
+is expected at run time to contain a pointer to where to store
+the result of the entry point.
+For @code{CHARACTER} functions, this
+storage area is an array of the appropriate number of characters;
+for @code{COMPLEX} functions, it is the appropriate area for the return
+type; for multiple-return-type functions, it is a union of all the supported return
+types (which cannot include @code{CHARACTER}, since combining @code{CHARACTER}
+and non-@code{CHARACTER} return types via @code{ENTRY} in a single function
+is not supported by @code{g77}).
+
+For @code{CHARACTER} functions, the @samp{__g77_result} argument is followed
+by yet another argument named @samp{__g77_length} that, at run time,
+specifies the caller's expected length of the returned value.
+Note that only @code{CHARACTER*(*)} functions and entry points actually
+make use of this argument, even though it is always passed by
+all callers of public @code{CHARACTER} functions (since the caller does not
+generally know whether such a function is @code{CHARACTER*(*)} or whether
+there are any other callers that don't have that information).
+
+The rest of the argument list is the union of all the arguments
+specified for all the entry points (in their usual forms, e.g.
+@code{CHARACTER} arguments have extra length arguments, all appended at
+the end of this list).
+This is considered the ``master list'' of
+arguments.
+
+The code for this procedure has, before the code for the first
+executable statement, code much like that for the following Fortran
+statement:
+
+@smallexample
+ GOTO (100000,100001,100002), __g77_which_entrypoint
+100000 @dots{}code for primary entry point@dots{}
+100001 @dots{}code immediately following first ENTRY statement@dots{}
+100002 @dots{}code immediately following second ENTRY statement@dots{}
+@end smallexample
+
+@noindent
+(Note that invalid Fortran statement labels and variable names
+are used in the above example to highlight the fact that it
+represents code generated by the @code{g77} internals, not code to be
+written by the user.)
+
+It is this code that, when the procedure is called, picks which
+entry point to start executing.
+
+Getting back to the public procedures (@samp{x} and @samp{Y} in the original
+example), those procedures are fairly simple.
+Their interfaces
+are just like they would be if they were self-contained procedures
+(without @code{ENTRY}), of course, since that is what the callers
+expect.
+Their code consists of simply calling the private
+procedure, described above, with the appropriate extra arguments
+(the entry point index, and perhaps a pointer to a multiple-type-
+return variable, local to the public procedure, that contains
+all the supported returnable non-character types).
+For arguments
+that are not listed for a given entry point that are listed for
+other entry points, and therefore that are in the ``master list''
+for the private procedure, null pointers (in C, the @code{NULL} macro)
+are passed.
+Also, for entry points that are part of a multiple-type-
+returning function, code is compiled after the call of the private
+procedure to extract from the multi-type union the appropriate result,
+depending on the type of the entry point in question, returning
+that result to the original caller.
+
+When debugging a procedure containing alternate entry points, you
+can either set a break point on the public procedure itself (e.g.
+a break point on @samp{X} or @samp{Y}) or on the private procedure that
+contains most of the pertinent code (e.g. @samp{__g77_masterfun_@var{x}}).
+If you do the former, you should use the debugger's command to
+``step into'' the called procedure to get to the actual code; with
+the latter approach, the break point leaves you right at the
+actual code, skipping over the public entry point and its call
+to the private procedure (unless you have set a break point there
+as well, of course).
+
+Further, the list of dummy arguments that is visible when the
+private procedure is active is going to be the expanded version
+of the list for whichever particular entry point is active,
+as explained above, and the way in which return values are
+handled might well be different from how they would be handled
+for an equivalent single-entry function.
+
+@node Alternate Returns
+@section Alternate Returns (SUBROUTINE and RETURN)
+@cindex subroutines
+@cindex alternate returns
+@cindex SUBROUTINE statement
+@cindex statements, SUBROUTINE
+@cindex RETURN statement
+@cindex statements, RETURN
+
+Subroutines with alternate returns (e.g. @samp{SUBROUTINE X(*)} and
+@samp{CALL X(*50)}) are implemented by @code{g77} as functions returning
+the C @code{int} type.
+The actual alternate-return arguments are omitted from the calling sequence.
+Instead, the caller uses
+the return value to do a rough equivalent of the Fortran
+computed-@code{GOTO} statement, as in @samp{GOTO (50), X()} in the
+example above (where @samp{X} is quietly declared as an @code{INTEGER(KIND=1)}
+function), and the callee just returns whatever integer
+is specified in the @code{RETURN} statement for the subroutine
+For example, @samp{RETURN 1} is implemented as @samp{X = 1} followed
+by @samp{RETURN}
+in C, and @samp{RETURN} by itself is @samp{X = 0} and @samp{RETURN}).
+
+@node Assigned Statement Labels
+@section Assigned Statement Labels (ASSIGN and GOTO)
+@cindex assigned statement labels
+@cindex statement labels, assigned
+@cindex ASSIGN statement
+@cindex statements, ASSIGN
+@cindex GOTO statement
+@cindex statements, GOTO
+
+For portability to machines where a pointer (such as to a label,
+which is how @code{g77} implements @code{ASSIGN} and its relatives,
+the assigned-@code{GOTO} and assigned-@code{FORMAT}-I/O statements)
+is wider (bitwise) than an @code{INTEGER(KIND=1)}, @code{g77}
+uses a different memory location to hold the @code{ASSIGN}ed value of a variable
+than it does the numerical value in that variable, unless the
+variable is wide enough (can hold enough bits).
+
+In particular, while @code{g77} implements
+
+@example
+I = 10
+@end example
+
+@noindent
+as, in C notation, @samp{i = 10;}, it implements
+
+@example
+ASSIGN 10 TO I
+@end example
+
+@noindent
+as, in GNU's extended C notation (for the label syntax),
+@samp{__g77_ASSIGN_I = &&L10;} (where @samp{L10} is just a massaging
+of the Fortran label @samp{10} to make the syntax C-like; @code{g77} doesn't
+actually generate the name @samp{L10} or any other name like that,
+since debuggers cannot access labels anyway).
+
+While this currently means that an @code{ASSIGN} statement does not
+overwrite the numeric contents of its target variable, @emph{do not}
+write any code depending on this feature.
+@code{g77} has already changed this implementation across
+versions and might do so in the future.
+This information is provided only to make debugging Fortran programs
+compiled with the current version of @code{g77} somewhat easier.
+If there's no debugger-visible variable named @samp{__g77_ASSIGN_I}
+in a program unit that does @samp{ASSIGN 10 TO I}, that probably
+means @code{g77} has decided it can store the pointer to the label directly
+into @samp{I} itself.
+
+@xref{Ugly Assigned Labels}, for information on a command-line option
+to force @code{g77} to use the same storage for both normal and
+assigned-label uses of a variable.
+
+@node Run-time Library Errors
+@section Run-time Library Errors
+@cindex IOSTAT=
+@cindex error values
+@cindex error messages
+@cindex messages, run-time
+@cindex I/O, errors
+
+The @code{libf2c} library currently has the following table to relate
+error code numbers, returned in @code{IOSTAT=} variables, to messages.
+This information should, in future versions of this document, be
+expanded upon to include detailed descriptions of each message.
+
+In line with good coding practices, any of the numbers in the
+list below should @emph{not} be directly written into Fortran
+code you write.
+Instead, make a separate @code{INCLUDE} file that defines
+@code{PARAMETER} names for them, and use those in your code,
+so you can more easily change the actual numbers in the future.
+
+The information below is culled from the definition
+of @samp{F_err} in @file{f/runtime/libI77/err.c} in the
+@code{g77} source tree.
+
+@smallexample
+100: "error in format"
+101: "illegal unit number"
+102: "formatted io not allowed"
+103: "unformatted io not allowed"
+104: "direct io not allowed"
+105: "sequential io not allowed"
+106: "can't backspace file"
+107: "null file name"
+108: "can't stat file"
+109: "unit not connected"
+110: "off end of record"
+111: "truncation failed in endfile"
+112: "incomprehensible list input"
+113: "out of free space"
+114: "unit not connected"
+115: "read unexpected character"
+116: "bad logical input field"
+117: "bad variable type"
+118: "bad namelist name"
+119: "variable not in namelist"
+120: "no end record"
+121: "variable count incorrect"
+122: "subscript for scalar variable"
+123: "invalid array section"
+124: "substring out of bounds"
+125: "subscript out of bounds"
+126: "can't read file"
+127: "can't write file"
+128: "'new' file exists"
+129: "can't append to file"
+130: "non-positive record number"
+131: "I/O started while already doing I/O"
+@end smallexample
+
+@node Collected Fortran Wisdom
+@chapter Collected Fortran Wisdom
+@cindex wisdom
+@cindex legacy code
+@cindex code, legacy
+@cindex writing code
+@cindex code, writing
+
+Most users of @code{g77} can be divided into two camps:
+
+@itemize @bullet
+@item
+Those writing new Fortran code to be compiled by @code{g77}.
+
+@item
+Those using @code{g77} to compile existing, ``legacy'' code.
+@end itemize
+
+Users writing new code generally understand most of the necessary
+aspects of Fortran to write ``mainstream'' code, but often need
+help deciding how to handle problems, such as the construction
+of libraries containing @code{BLOCK DATA}.
+
+Users dealing with ``legacy'' code sometimes don't have much
+experience with Fortran, but believe that the code they're compiling
+already works when compiled by other compilers (and might
+not understand why, as is sometimes the case, it doesn't work
+when compiled by @code{g77}).
+
+The following information is designed to help users do a better job
+coping with existing, ``legacy'' Fortran code, and with writing
+new code as well.
+
+@menu
+* Advantages Over f2c:: If @code{f2c} is so great, why @code{g77}?
+* Block Data and Libraries:: How @code{g77} solves a common problem.
+* Loops:: Fortran @code{DO} loops surprise many people.
+* Working Programs:: Getting programs to work should be done first.
+* Overly Convenient Options:: Temptations to avoid, habits to not form.
+* Faster Programs:: Everybody wants these, but at what cost?
+@end menu
+
+@node Advantages Over f2c
+@section Advantages Over f2c
+
+Without @code{f2c}, @code{g77} would have taken much longer to
+do and probably not been as good for quite a while.
+Sometimes people who notice how much @code{g77} depends on, and
+documents encouragement to use, @code{f2c} ask why @code{g77}
+was created if @code{f2c} already existed.
+
+This section gives some basic answers to these questions, though it
+is not intended to be comprehensive.
+
+@menu
+* Language Extensions:: Features used by Fortran code.
+* Compiler Options:: Features helpful during development.
+* Compiler Speed:: Speed of the compilation process.
+* Program Speed:: Speed of the generated, optimized code.
+* Ease of Debugging:: Debugging ease-of-use at the source level.
+* Character and Hollerith Constants:: A byte saved is a byte earned.
+@end menu
+
+@node Language Extensions
+@subsection Language Extensions
+
+@code{g77} offers several extensions to the Fortran language that @code{f2c}
+doesn't.
+
+However, @code{f2c} offers a few that @code{g77} doesn't, like
+fairly complete support for @code{INTEGER*2}.
+It is expected that @code{g77} will offer some or all of these missing
+features at some time in the future.
+(Version 0.5.18 of @code{g77} offers some rudimentary support for some
+of these features.)
+
+@node Compiler Options
+@subsection Compiler Options
+
+@code{g77} offers a whole bunch of compiler options that @code{f2c} doesn't.
+
+However, @code{f2c} offers a few that @code{g77} doesn't, like an
+option to generate code to check array subscripts at run time.
+It is expected that @code{g77} will offer some or all of these
+missing options at some time in the future.
+
+@node Compiler Speed
+@subsection Compiler Speed
+
+Saving the steps of writing and then rereading C code is a big reason
+why @code{g77} should be able to compile code much faster than using
+@code{f2c} in conjunction with the equivalent invocation of @code{gcc}.
+
+However, due to @code{g77}'s youth, lots of self-checking is still being
+performed.
+As a result, this improvement is as yet unrealized
+(though the potential seems to be there for quite a big speedup
+in the future).
+It is possible that, as of version 0.5.18, @code{g77}
+is noticeably faster compiling many Fortran source files than using
+@code{f2c} in conjunction with @code{gcc}.
+
+@node Program Speed
+@subsection Program Speed
+
+@code{g77} has the potential to better optimize code than @code{f2c},
+even when @code{gcc} is used to compile the output of @code{f2c},
+because @code{f2c} must necessarily
+translate Fortran into a somewhat lower-level language (C) that cannot
+preserve all the information that is potentially useful for optimization,
+while @code{g77} can gather, preserve, and transmit that information directly
+to the GBE.
+
+For example, @code{g77} implements @code{ASSIGN} and assigned
+@code{GOTO} using direct assignment of pointers to labels and direct
+jumps to labels, whereas @code{f2c} maps the assigned labels to
+integer values and then uses a C @code{switch} statement to encode
+the assigned @code{GOTO} statements.
+
+However, as is typical, theory and reality don't quite match, at least
+not in all cases, so it is still the case that @code{f2c} plus @code{gcc}
+can generate code that is faster than @code{g77}.
+
+Version 0.5.18 of @code{g77} offered default
+settings and options, via patches to the @code{gcc}
+back end, that allow for better program speed, though
+some of these improvements also affected the performance
+of programs translated by @code{f2c} and then compiled
+by @code{g77}'s version of @code{gcc}.
+
+Version 0.5.20 of @code{g77} offers further performance
+improvements, at least one of which (alias analysis) is
+not generally applicable to @code{f2c} (though @code{f2c}
+could presumably be changed to also take advantage of
+this new capability of the @code{gcc} back end, assuming
+this is made available in an upcoming release of @code{gcc}).
+
+@node Ease of Debugging
+@subsection Ease of Debugging
+
+Because @code{g77} compiles directly to assembler code like @code{gcc},
+instead of translating to an intermediate language (C) as does @code{f2c},
+support for debugging can be better for @code{g77} than @code{f2c}.
+
+However, although @code{g77} might be somewhat more ``native'' in terms of
+debugging support than @code{f2c} plus @code{gcc}, there still are a lot
+of things ``not quite right''.
+Many of the important ones should be resolved in the near future.
+
+For example, @code{g77} doesn't have to worry about reserved names
+like @code{f2c} does.
+Given @samp{FOR = WHILE}, @code{f2c} must necessarily
+translate this to something @emph{other} than
+@samp{for = while;}, because C reserves those words.
+
+However, @code{g77} does still uses things like an extra level of indirection
+for @code{ENTRY}-laden procedures---in this case, because the back end doesn't
+yet support multiple entry points.
+
+Another example is that, given
+
+@smallexample
+COMMON A, B
+EQUIVALENCE (B, C)
+@end smallexample
+
+@noindent
+the @code{g77} user should be able to access the variables directly, by name,
+without having to traverse C-like structures and unions, while @code{f2c}
+is unlikely to ever offer this ability (due to limitations in the
+C language).
+
+However, due to apparent bugs in the back end, @code{g77} currently doesn't
+take advantage of this facility at all---it doesn't emit any debugging
+information for @code{COMMON} and @code{EQUIVALENCE} areas,
+other than information
+on the array of @code{char} it creates (and, in the case
+of local @code{EQUIVALENCE}, names) for each such area.
+
+Yet another example is arrays.
+@code{g77} represents them to the debugger
+using the same ``dimensionality'' as in the source code, while @code{f2c}
+must necessarily convert them all to one-dimensional arrays to fit
+into the confines of the C language.
+However, the level of support
+offered by debuggers for interactive Fortran-style access to arrays
+as compiled by @code{g77} can vary widely.
+In some cases, it can actually
+be an advantage that @code{f2c} converts everything to widely supported
+C semantics.
+
+In fairness, @code{g77} could do many of the things @code{f2c} does
+to get things working at least as well as @code{f2c}---for now,
+the developers prefer making @code{g77} work the
+way they think it is supposed to, and finding help improving the
+other products (the back end of @code{gcc}; @code{gdb}; and so on)
+to get things working properly.
+
+@node Character and Hollerith Constants
+@subsection Character and Hollerith Constants
+@cindex character constants
+@cindex constants, character
+@cindex Hollerith constants
+@cindex constants, Hollerith
+@cindex trailing null byte
+@cindex null byte, trailing
+@cindex zero byte, trailing
+
+To avoid the extensive hassle that would be needed to avoid this,
+@code{f2c} uses C character constants to encode character and Hollerith
+constants.
+That means a constant like @samp{'HELLO'} is translated to
+@samp{"hello"} in C, which further means that an extra null byte is
+present at the end of the constant.
+This null byte is superfluous.
+
+@code{g77} does not generate such null bytes.
+This represents significant
+savings of resources, such as on systems where @file{/dev/null} or
+@file{/dev/zero} represent bottlenecks in the systems' performance,
+because @code{g77} simply asks for fewer zeros from the operating
+system than @code{f2c}.
+
+@node Block Data and Libraries
+@section Block Data and Libraries
+@cindex block data and libraries
+@cindex BLOCK DATA statement
+@cindex statements, BLOCK DATA
+@cindex libraries, containing BLOCK DATA
+@cindex @code{f2c} compatibility
+@cindex compatibility, @code{f2c}
+
+To ensure that block data program units are linked, especially a concern
+when they are put into libraries, give each one a name (as in
+@samp{BLOCK DATA FOO}) and make sure there is an @samp{EXTERNAL FOO}
+statement in every program unit that uses any common block
+initialized by the corresponding @code{BLOCK DATA}.
+@code{g77} currently compiles a @code{BLOCK DATA} as if it were a
+@code{SUBROUTINE},
+that is, it generates an actual procedure having the appropriate name.
+The procedure does nothing but return immediately if it happens to be
+called.
+For @samp{EXTERNAL FOO}, where @samp{FOO} is not otherwise referenced in the
+same program unit, @code{g77} assumes there exists a @samp{BLOCK DATA FOO}
+in the program and ensures that by generating a
+reference to it so the linker will make sure it is present.
+(Specifically, @code{g77} outputs in the data section a static pointer to the
+external name @samp{FOO}.)
+
+The implementation @code{g77} currently uses to make this work is
+one of the few things not compatible with @code{f2c} as currently
+shipped.
+@code{f2c} currently does nothing with @samp{EXTERNAL FOO} except
+issue a warning that @samp{FOO} is not otherwise referenced, and for
+@samp{BLOCK DATA FOO}, f2c doesn't generate a dummy procedure with the
+name @samp{FOO}.
+The upshot is that you shouldn't mix @code{f2c} and @code{g77} in
+this particular case.
+If you use f2c to compile @samp{BLOCK DATA FOO},
+then any @code{g77}-compiled program unit that says @samp{EXTERNAL FOO}
+will result in an unresolved reference when linked.
+If you do the
+opposite, then @samp{FOO} might not be linked in under various
+circumstances (such as when @samp{FOO} is in a library, or you're
+using a ``clever'' linker---so clever, it produces a broken program
+with little or no warning by omitting initializations of global data
+because they are contained in unreferenced procedures).
+
+The changes you make to your code to make @code{g77} handle this situation,
+however, appear to be a widely portable way to handle it.
+That is, many systems permit it (as they should, since the
+FORTRAN 77 standard permits @samp{EXTERNAL FOO} when @samp{FOO}
+is a block data program unit), and of the ones
+that might not link @samp{BLOCK DATA FOO} under some circumstances, most of
+them appear to do so once @samp{EXTERNAL FOO} is present in the appropriate
+program units.
+
+Here is the recommended approach to modifying a program containing
+a program unit such as the following:
+
+@smallexample
+BLOCK DATA FOO
+COMMON /VARS/ X, Y, Z
+DATA X, Y, Z / 3., 4., 5. /
+END
+@end smallexample
+
+@noindent
+If the above program unit might be placed in a library module, then
+ensure that every program unit in every program that references that
+particular @code{COMMON} area uses the @code{EXTERNAL} statement
+to force the area to be initialized.
+
+For example, change a program unit that starts with
+
+@smallexample
+INTEGER FUNCTION CURX()
+COMMON /VARS/ X, Y, Z
+CURX = X
+END
+@end smallexample
+
+@noindent
+so that it uses the @code{EXTERNAL} statement, as in:
+
+@smallexample
+INTEGER FUNCTION CURX()
+COMMON /VARS/ X, Y, Z
+EXTERNAL FOO
+CURX = X
+END
+@end smallexample
+
+@noindent
+That way, @samp{CURX} is compiled by @code{g77} (and many other
+compilers) so that the linker knows it must include @samp{FOO},
+the @code{BLOCK DATA} program unit that sets the initial values
+for the variables in @samp{VAR}, in the executable program.
+
+@node Loops
+@section Loops
+@cindex DO statement
+@cindex statements, DO
+@cindex trips, number of
+@cindex number of trips
+
+The meaning of a @code{DO} loop in Fortran is precisely specified
+in the Fortran standard@dots{}and is quite different from what
+many programmers might expect.
+
+In particular, Fortran @code{DO} loops are implemented as if
+the number of trips through the loop is calculated @emph{before}
+the loop is entered.
+
+The number of trips for a loop is calculated from the @var{start},
+@var{end}, and @var{increment} values specified in a statement such as:
+
+@smallexample
+DO @var{iter} = @var{start}, @var{end}, @var{increment}
+@end smallexample
+
+@noindent
+The trip count is evaluated using a fairly simple formula
+based on the three values following the @samp{=} in the
+statement, and it is that trip count that is effectively
+decremented during each iteration of the loop.
+If, at the beginning of an iteration of the loop, the
+trip count is zero or negative, the loop terminates.
+The per-loop-iteration modifications to @var{iter} are not
+related to determining whether to terminate the loop.
+
+There are two important things to remember about the trip
+count:
+
+@itemize @bullet
+@item
+It can be @emph{negative}, in which case it is
+treated as if it was zero---meaning the loop is
+not executed at all.
+
+@item
+The type used to @emph{calculate} the trip count
+is the same type as @var{iter}, but the final
+calculation, and thus the type of the trip
+count itself, always is @code{INTEGER(KIND=1)}.
+@end itemize
+
+These two items mean that there are loops that cannot
+be written in straightforward fashion using the Fortran @code{DO}.
+
+For example, on a system with the canonical 32-bit two's-complement
+implementation of @code{INTEGER(KIND=1)}, the following loop will not work:
+
+@smallexample
+DO I = -2000000000, 2000000000
+@end smallexample
+
+@noindent
+Although the @var{start} and @var{end} values are well within
+the range of @code{INTEGER(KIND=1)}, the @emph{trip count} is not.
+The expected trip count is 40000000001, which is outside
+the range of @code{INTEGER(KIND=1)} on many systems.
+
+Instead, the above loop should be constructed this way:
+
+@smallexample
+I = -2000000000
+DO
+ IF (I .GT. 2000000000) EXIT
+ @dots{}
+ I = I + 1
+END DO
+@end smallexample
+
+@noindent
+The simple @code{DO} construct and the @code{EXIT} statement
+(used to leave the innermost loop)
+are F90 features that @code{g77} supports.
+
+Some Fortran compilers have buggy implementations of @code{DO},
+in that they don't follow the standard.
+They implement @code{DO} as a straightforward translation
+to what, in C, would be a @code{for} statement.
+Instead of creating a temporary variable to hold the trip count
+as calculated at run time, these compilers
+use the iteration variable @var{iter} to control
+whether the loop continues at each iteration.
+
+The bug in such an implementation shows up when the
+trip count is within the range of the type of @var{iter},
+but the magnitude of @samp{ABS(@var{end}) + ABS(@var{incr})}
+exceeds that range. For example:
+
+@smallexample
+DO I = 2147483600, 2147483647
+@end smallexample
+
+@noindent
+A loop started by the above statement will work as implemented
+by @code{g77}, but the use, by some compilers, of a
+more C-like implementation akin to
+
+@smallexample
+for (i = 2147483600; i <= 2147483647; ++i)
+@end smallexample
+
+@noindent
+produces a loop that does not terminate, because @samp{i}
+can never be greater than 2147483647, since incrementing it
+beyond that value overflows @samp{i}, setting it to -2147483648.
+This is a large, negative number that still is less than 2147483647.
+
+Another example of unexpected behavior of @code{DO} involves
+using a nonintegral iteration variable @var{iter}, that is,
+a @code{REAL} variable.
+Consider the following program:
+
+@smallexample
+ DATA BEGIN, END, STEP /.1, .31, .007/
+ DO 10 R = BEGIN, END, STEP
+ IF (R .GT. END) PRINT *, R, ' .GT. ', END, '!!'
+ PRINT *,R
+10 CONTINUE
+ PRINT *,'LAST = ',R
+ IF (R .LE. END) PRINT *, R, ' .LE. ', END, '!!'
+ END
+@end smallexample
+
+@noindent
+A C-like view of @code{DO} would hold that the two ``exclamatory''
+@code{PRINT} statements are never executed.
+However, this is the output of running the above program
+as compiled by @code{g77} on a GNU/Linux ix86 system:
+
+@smallexample
+ .100000001
+ .107000001
+ .114
+ .120999999
+ @dots{}
+ .289000005
+ .296000004
+ .303000003
+LAST = .310000002
+ .310000002 .LE. .310000002!!
+@end smallexample
+
+Note that one of the two checks in the program turned up
+an apparent violation of the programmer's expectation---yet,
+the loop is correctly implemented by @code{g77}, in that
+it has 30 iterations.
+This trip count of 30 is correct when evaluated using
+the floating-point representations for the @var{begin},
+@var{end}, and @var{incr} values (.1, .31, .007) on GNU/Linux
+ix86 are used.
+On other systems, an apparently more accurate trip count
+of 31 might result, but, nevertheless, @code{g77} is
+faithfully following the Fortran standard, and the result
+is not what the author of the sample program above
+apparently expected.
+(Such other systems might, for different values in the @code{DATA}
+statement, violate the other programmer's expectation,
+for example.)
+
+Due to this combination of imprecise representation
+of floating-point values and the often-misunderstood
+interpretation of @code{DO} by standard-conforming
+compilers such as @code{g77}, use of @code{DO} loops
+with @code{REAL} iteration
+variables is not recommended.
+Such use can be caught by specifying @samp{-Wsurprising}.
+@xref{Warning Options}, for more information on this
+option.
+
+@node Working Programs
+@section Working Programs
+
+Getting Fortran programs to work in the first place can be
+quite a challenge---even when the programs already work on
+other systems, or when using other compilers.
+
+@code{g77} offers some facilities that might be useful for
+tracking down bugs in such programs.
+
+@menu
+* Not My Type::
+* Variables Assumed To Be Zero::
+* Variables Assumed To Be Saved::
+* Unwanted Variables::
+* Unused Arguments::
+* Surprising Interpretations of Code::
+* Aliasing Assumed To Work::
+* Output Assumed To Flush::
+* Large File Unit Numbers::
+@end menu
+
+@node Not My Type
+@subsection Not My Type
+@cindex mistyped variables
+@cindex variables, mistyped
+@cindex mistyped functions
+@cindex functions, mistyped
+@cindex implicit typing
+
+A fruitful source of bugs in Fortran source code is use, or
+mis-use, of Fortran's implicit-typing feature, whereby the
+type of a variable, array, or function is determined by the
+first character of its name.
+
+Simple cases of this include statements like @samp{LOGX=9.227},
+without a statement such as @samp{REAL LOGX}.
+In this case, @samp{LOGX} is implicitly given @code{INTEGER(KIND=1)}
+type, with the result of the assignment being that it is given
+the value @samp{9}.
+
+More involved cases include a function that is defined starting
+with a statement like @samp{DOUBLE PRECISION FUNCTION IPS(@dots{})}.
+Any caller of this function that does not also declare @samp{IPS}
+as type @code{DOUBLE PRECISION} (or, in GNU Fortran, @code{REAL(KIND=2)})
+is likely to assume it returns
+@code{INTEGER}, or some other type, leading to invalid results
+or even program crashes.
+
+The @samp{-Wimplicit} option might catch failures to
+properly specify the types of
+variables, arrays, and functions in the code.
+
+However, in code that makes heavy use of Fortran's
+implicit-typing facility, this option might produce so
+many warnings about cases that are working, it would be
+hard to find the one or two that represent bugs.
+This is why so many experienced Fortran programmers strongly
+recommend widespread use of the @code{IMPLICIT NONE} statement,
+despite it not being standard FORTRAN 77, to completely turn
+off implicit typing.
+(@code{g77} supports @code{IMPLICIT NONE}, as do almost all
+FORTRAN 77 compilers.)
+
+Note that @samp{-Wimplicit} catches only implicit typing of
+@emph{names}.
+It does not catch implicit typing of expressions such
+as @samp{X**(2/3)}.
+Such expressions can be buggy as well---in fact, @samp{X**(2/3)}
+is equivalent to @samp{X**0}, due to the way Fortran expressions
+are given types and then evaluated.
+(In this particular case, the programmer probably wanted
+@samp{X**(2./3.)}.)
+
+@node Variables Assumed To Be Zero
+@subsection Variables Assumed To Be Zero
+@cindex zero-initialized variables
+@cindex variables assumed to be zero
+@cindex uninitialized variables
+
+Many Fortran programs were developed on systems that provided
+automatic initialization of all, or some, variables and arrays
+to zero.
+As a result, many of these programs depend, sometimes
+inadvertently, on this behavior, though to do so violates
+the Fortran standards.
+
+You can ask @code{g77} for this behavior by specifying the
+@samp{-finit-local-zero} option when compiling Fortran code.
+(You might want to specify @samp{-fno-automatic} as well,
+to avoid code-size inflation for non-optimized compilations.)
+
+Note that a program that works better when compiled with the
+@samp{-finit-local-zero} option
+is almost certainly depending on a particular system's,
+or compiler's, tendency to initialize some variables to zero.
+It might be worthwhile finding such cases and fixing them,
+using techniques such as compiling with the @samp{-O -Wuninitialized}
+options using @code{g77}.
+
+@node Variables Assumed To Be Saved
+@subsection Variables Assumed To Be Saved
+@cindex variables retaining values across calls
+@cindex saved variables
+@cindex static variables
+
+Many Fortran programs were developed on systems that
+saved the values of all, or some, variables and arrays
+across procedure calls.
+As a result, many of these programs depend, sometimes
+inadvertently, on being able to assign a value to a
+variable, perform a @code{RETURN} to a calling procedure,
+and, upon subsequent invocation, reference the previously
+assigned variable to obtain the value.
+
+They expect this despite not using the @code{SAVE} statement
+to specify that the value in a variable is expected to survive
+procedure returns and calls.
+Depending on variables and arrays to retain values across
+procedure calls without using @code{SAVE} to require it violates
+the Fortran standards.
+
+You can ask @code{g77} to assume @code{SAVE} is specified for all
+relevant (local) variables and arrays by using the
+@samp{-fno-automatic} option.
+
+Note that a program that works better when compiled with the
+@samp{-fno-automatic} option
+is almost certainly depending on not having to use
+the @code{SAVE} statement as required by the Fortran standard.
+It might be worthwhile finding such cases and fixing them,
+using techniques such as compiling with the @samp{-O -Wuninitialized}
+options using @code{g77}.
+
+@node Unwanted Variables
+@subsection Unwanted Variables
+
+The @samp{-Wunused} option can find bugs involving
+implicit typing, sometimes
+more easily than using @samp{-Wimplicit} in code that makes
+heavy use of implicit typing.
+An unused variable or array might indicate that the
+spelling for its declaration is different from that of
+its intended uses.
+
+Other than cases involving typos, unused variables rarely
+indicate actual bugs in a program.
+However, investigating such cases thoroughly has, on occasion,
+led to the discovery of code that had not been completely
+written---where the programmer wrote declarations as needed
+for the whole algorithm, wrote some or even most of the code
+for that algorithm, then got distracted and forgot that the
+job was not complete.
+
+@node Unused Arguments
+@subsection Unused Arguments
+@cindex unused arguments
+@cindex arguments, unused
+
+As with unused variables, It is possible that unused arguments
+to a procedure might indicate a bug.
+Compile with @samp{-W -Wunused} option to catch cases of
+unused arguments.
+
+Note that @samp{-W} also enables warnings regarding overflow
+of floating-point constants under certain circumstances.
+
+@node Surprising Interpretations of Code
+@subsection Surprising Interpretations of Code
+
+The @samp{-Wsuprising} option can help find bugs involving
+expression evaluation or in
+the way @code{DO} loops with non-integral iteration variables
+are handled.
+Cases found by this option might indicate a difference of
+interpretation between the author of the code involved, and
+a standard-conforming compiler such as @code{g77}.
+Such a difference might produce actual bugs.
+
+In any case, changing the code to explicitly do what the
+programmer might have expected it to do, so @code{g77} and
+other compilers are more likely to follow the programmer's
+expectations, might be worthwhile, especially if such changes
+make the program work better.
+
+@node Aliasing Assumed To Work
+@subsection Aliasing Assumed To Work
+@cindex -falias-check option
+@cindex options, -falias-check
+@cindex -fargument-alias option
+@cindex options, -fargument-alias
+@cindex -fargument-noalias option
+@cindex options, -fargument-noalias
+@cindex -fno-argument-noalias-global option
+@cindex options, -fno-argument-noalias-global
+@cindex aliasing
+@cindex anti-aliasing
+@cindex overlapping arguments
+@cindex overlays
+@cindex association, storage
+@cindex storage association
+@cindex scheduling of reads and writes
+@cindex reads and writes, scheduling
+
+The @samp{-falias-check}, @samp{-fargument-alias},
+@samp{-fargument-noalias},
+and @samp{-fno-argument-noalias-global} options,
+introduced in version 0.5.20 and
+@code{g77}'s version 2.7.2.2.f.2 of @code{gcc},
+control the assumptions regarding aliasing
+(overlapping)
+of writes and reads to main memory (core) made
+by the @code{gcc} back end.
+
+They are effective only when compiling with @samp{-O} (specifying
+any level other than @samp{-O0}) or with @samp{-falias-check}.
+
+The default for Fortran code is @samp{-fargument-noalias-global}.
+(The default for C code and code written in other C-based languages
+is @samp{-fargument-alias}.
+These defaults apply regardless of whether you use @code{g77} or
+@code{gcc} to compile your code.)
+
+Note that, on some systems, compiling with @samp{-fforce-addr} in
+effect can produce more optimal code when the default aliasing
+options are in effect (and when optimization is enabled).
+
+If your program is not working when compiled with optimization,
+it is possible it is violating the Fortran standards (77 and 90)
+by relying on the ability to ``safely'' modify variables and
+arrays that are aliased, via procedure calls, to other variables
+and arrays, without using @code{EQUIVALENCE} to explicitly
+set up this kind of aliasing.
+
+(The FORTRAN 77 standard's prohibition of this sort of
+overlap, generally referred to therein as ``storage
+assocation'', appears in Sections 15.9.3.6.
+This prohibition allows implementations, such as @code{g77},
+to, for example, implement the passing of procedures and
+even values in @code{COMMON} via copy operations into local,
+perhaps more efficiently accessed temporaries at entry to a
+procedure, and, where appropriate, via copy operations back
+out to their original locations in memory at exit from that
+procedure, without having to take into consideration the
+order in which the local copies are updated by the code,
+among other things.)
+
+To test this hypothesis, try compiling your program with
+the @samp{-fargument-alias} option, which causes the
+compiler to revert to assumptions essentially the same as
+made by versions of @code{g77} prior to 0.5.20.
+
+If the program works using this option, that strongly suggests
+that the bug is in your program.
+Finding and fixing the bug(s) should result in a program that
+is more standard-conforming and that can be compiled by @code{g77}
+in a way that results in a faster executable.
+
+(You might want to try compiling with @samp{-fargument-noalias},
+a kind of half-way point, to see if the problem is limited to
+aliasing between dummy arguments and @code{COMMON} variables---this
+option assumes that such aliasing is not done, while still allowing
+aliasing among dummy arguments.)
+
+An example of aliasing that is invalid according to the standards
+is shown in the following program, which might @emph{not} produce
+the expected results when executed:
+
+@smallexample
+I = 1
+CALL FOO(I, I)
+PRINT *, I
+END
+
+SUBROUTINE FOO(J, K)
+J = J + K
+K = J * K
+PRINT *, J, K
+END
+@end smallexample
+
+The above program attempts to use the temporary aliasing of the
+@samp{J} and @samp{K} arguments in @samp{FOO} to effect a
+pathological behavior---the simultaneous changing of the values
+of @emph{both} @samp{J} and @samp{K} when either one of them
+is written.
+
+The programmer likely expects the program to print these values:
+
+@example
+2 4
+4
+@end example
+
+However, since the program is not standard-conforming, an
+implementation's behavior when running it is undefined, because
+subroutine @samp{FOO} modifies at least one of the arguments,
+and they are aliased with each other.
+(Even if one of the assignment statements was deleted, the
+program would still violate these rules.
+This kind of on-the-fly aliasing is permitted by the standard
+only when none of the aliased items are defined, or written,
+while the aliasing is in effect.)
+
+As a practical example, an optimizing compiler might schedule
+the @samp{J =} part of the second line of @samp{FOO} @emph{after}
+the reading of @samp{J} and @samp{K} for the @samp{J * K} expression,
+resulting in the following output:
+
+@example
+2 2
+2
+@end example
+
+Essentially, compilers are promised (by the standard and, therefore,
+by programmers who write code they claim to be standard-conforming)
+that if they cannot detect aliasing via static analysis of a single
+program unit's @code{EQUIVALENCE} and @code{COMMON} statements, no
+such aliasing exists.
+In such cases, compilers are free to assume that an assignment to
+one variable will not change the value of another variable, allowing
+it to avoid generating code to re-read the value of the other
+variable, to re-schedule reads and writes, and so on, to produce
+a faster executable.
+
+The same promise holds true for arrays (as seen by the called
+procedure)---an element of one dummy array cannot be aliased
+with, or overlap, any element of another dummy array or be
+in a @code{COMMON} area known to the procedure.
+
+(These restrictions apply only when the procedure defines, or
+writes to, one of the aliased variables or arrays.)
+
+Unfortunately, there is no way to find @emph{all} possible cases of
+violations of the prohibitions against aliasing in Fortran code.
+Static analysis is certainly imperfect, as is run-time analysis,
+since neither can catch all violations.
+(Static analysis can catch all likely violations, and some that
+might never actually happen, while run-time analysis can catch
+only those violations that actually happen during a particular
+run.
+Neither approach can cope with programs mixing Fortran code with
+routines written in other languages, however.)
+
+Currently, @code{g77} provides neither static nor run-time facilities
+to detect any cases of this problem, although other products might.
+Run-time facilities are more likely to be offered by future
+versions of @code{g77}, though patches improving @code{g77} so that
+it provides either form of detection are welcome.
+
+@node Output Assumed To Flush
+@subsection Output Assumed To Flush
+@cindex ALWAYS_FLUSH
+@cindex synchronous write errors
+@cindex disk full
+@cindex flushing output
+@cindex fflush()
+@cindex I/O, flushing
+@cindex output, flushing
+@cindex writes, flushing
+@cindex NFS
+@cindex network file system
+
+For several versions prior to 0.5.20, @code{g77} configured its
+version of the @code{libf2c} run-time library so that one of
+its configuration macros, @samp{ALWAYS_FLUSH}, was defined.
+
+This was done as a result of a belief that many programs expected
+output to be flushed to the operating system (under UNIX, via
+the @code{fflush()} library call) with the result that errors,
+such as disk full, would be immediately flagged via the
+relevant @code{ERR=} and @code{IOSTAT=} mechanism.
+
+Because of the adverse effects this approach had on the performance
+of many programs, @code{g77} no longer configures @code{libf2c}
+to always flush output.
+
+If your program depends on this behavior, either insert the
+appropriate @samp{CALL FLUSH} statements, or modify the sources
+to the @code{libf2c}, rebuild and reinstall @code{g77}, and
+relink your programs with the modified library.
+
+(Ideally, @code{libf2c} would offer the choice at run-time, so
+that a compile-time option to @code{g77} or @code{f2c} could
+result in generating the appropriate calls to flushing or
+non-flushing library routines.)
+
+@xref{Always Flush Output}, for information on how to modify
+the @code{g77} source tree so that a version of @code{libf2c}
+can be built and installed with the @samp{ALWAYS_FLUSH} macro defined.
+
+@node Large File Unit Numbers
+@subsection Large File Unit Numbers
+@cindex MXUNIT
+@cindex unit numbers
+@cindex maximum unit number
+@cindex illegal unit number
+@cindex increasing maximum unit number
+
+If your program crashes at run time with a message including
+the text @samp{illegal unit number}, that probably is
+a message from the run-time library, @code{libf2c}, used, and
+distributed with, @code{g77}.
+
+The message means that your program has attempted to use a
+file unit number that is out of the range accepted by
+@code{libf2c}.
+Normally, this range is 0 through 99, and the high end
+of the range is controlled by a @code{libf2c} source-file
+macro named @samp{MXUNIT}.
+
+If you can easily change your program to use unit numbers
+in the range 0 through 99, you should do so.
+
+Otherwise, see @ref{Larger File Unit Numbers}, for information on how
+to change @samp{MXUNIT} in @code{libf2c} so you can build and
+install a new version of @code{libf2c} that supports the larger
+unit numbers you need.
+
+@emph{Note:} While @code{libf2c} places a limit on the range
+of Fortran file-unit numbers, the underlying library and operating
+system might impose different kinds of limits.
+For example, some systems limit the number of files simultaneously
+open by a running program.
+Information on how to increase these limits should be found
+in your system's documentation.
+
+@node Overly Convenient Options
+@section Overly Convenient Command-line Options
+@cindex overly convenient options
+@cindex options, overly convenient
+
+These options should be used only as a quick-and-dirty way to determine
+how well your program will run under different compilation models
+without having to change the source.
+Some are more problematic
+than others, depending on how portable and maintainable you want the
+program to be (and, of course, whether you are allowed to change it
+at all is crucial).
+
+You should not continue to use these command-line options to compile
+a given program, but rather should make changes to the source code:
+
+@table @code
+@cindex -finit-local-zero option
+@cindex options, -finit-local-zero
+@item -finit-local-zero
+(This option specifies that any uninitialized local variables
+and arrays have default initialization to binary zeros.)
+
+Many other compilers do this automatically, which means lots of
+Fortran code developed with those compilers depends on it.
+
+It is safer (and probably
+would produce a faster program) to find the variables and arrays that
+need such initialization and provide it explicitly via @code{DATA}, so that
+@samp{-finit-local-zero} is not needed.
+
+Consider using @samp{-Wuninitialized} (which requires @samp{-O}) to
+find likely candidates, but
+do not specify @samp{-finit-local-zero} or @samp{-fno-automatic},
+or this technique won't work.
+
+@cindex -fno-automatic option
+@cindex options, -fno-automatic
+@item -fno-automatic
+(This option specifies that all local variables and arrays
+are to be treated as if they were named in @code{SAVE} statements.)
+
+Many other compilers do this automatically, which means lots of
+Fortran code developed with those compilers depends on it.
+
+The effect of this is that all non-automatic variables and arrays
+are made static, that is, not placed on the stack or in heap storage.
+This might cause a buggy program to appear to work better.
+If so, rather than relying on this command-line option (and hoping all
+compilers provide the equivalent one), add @code{SAVE}
+statements to some or all program unit sources, as appropriate.
+Consider using @samp{-Wuninitialized} (which requires @samp{-O})
+to find likely candidates, but
+do not specify @samp{-finit-local-zero} or @samp{-fno-automatic},
+or this technique won't work.
+
+The default is @samp{-fautomatic}, which tells @code{g77} to try
+and put variables and arrays on the stack (or in fast registers)
+where possible and reasonable.
+This tends to make programs faster.
+
+@cindex automatic arrays
+@cindex arrays, automatic
+@emph{Note:} Automatic variables and arrays are not affected
+by this option.
+These are variables and arrays that are @emph{necessarily} automatic,
+either due to explicit statements, or due to the way they are
+declared.
+Examples include local variables and arrays not given the
+@code{SAVE} attribute in procedures declared @code{RECURSIVE},
+and local arrays declared with non-constant bounds (automatic
+arrays).
+Currently, @code{g77} supports only automatic arrays, not
+@code{RECURSIVE} procedures or other means of explicitly
+specifying that variables or arrays are automatic.
+
+@cindex -fugly option
+@cindex options, -fugly
+@item -fugly
+Fix the source code so that @samp{-fno-ugly} will work.
+Note that, for many programs, it is difficult to practically
+avoid using the features enabled via @samp{-fugly-init}, and these
+features pose the lowest risk of writing nonportable code, among the
+various ``ugly'' features.
+
+@cindex -f@var{group}-intrinsics-hide option
+@cindex options, -f@var{group}-intrinsics-hide
+@item -f@var{group}-intrinsics-hide
+Change the source code to use @code{EXTERNAL} for any external procedure
+that might be the name of an intrinsic.
+It is easy to find these using @samp{-f@var{group}-intrinsics-disable}.
+@end table
+
+@node Faster Programs
+@section Faster Programs
+@cindex speeding up programs
+@cindex programs, speeding up
+
+Aside from the usual @code{gcc} options, such as @samp{-O},
+@samp{-ffast-math}, and so on, consider trying some of the
+following approaches to speed up your program (once you get
+it working).
+
+@menu
+* Aligned Data::
+* Prefer Automatic Uninitialized Variables::
+* Avoid f2c Compatibility::
+* Use Submodel Options::
+@end menu
+
+@node Aligned Data
+@subsection Aligned Data
+@cindex data, aligned
+@cindex stack, aligned
+@cindex aligned data
+@cindex aligned stack
+@cindex Pentium optimizations
+@cindex optimizations, Pentium
+
+On some systems, such as those with Pentium Pro CPUs, programs
+that make heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION})
+might run much slower
+than possible due to the compiler not aligning these 64-bit
+values to 64-bit boundaries in memory.
+(The effect also is present, though
+to a lesser extent, on the 586 (Pentium) architecture.)
+
+The Intel x86 architecture generally ensures that these programs will
+work on all its implementations,
+but particular implementations (such as Pentium Pro)
+perform better with more strict alignment.
+
+There are a variety of approaches to use to address this problem,
+in any combination:
+
+@itemize @bullet
+@item
+Order your @code{COMMON} and @code{EQUIVALENCE} areas such
+that the variables and arrays with the widest alignment
+guidelines come first.
+
+For example, on most systems, this would mean placing
+@code{COMPLEX(KIND=2)}, @code{REAL(KIND=2)}, and
+@code{INTEGER(KIND=2)} entities first, followed by @code{REAL(KIND=1)},
+@code{INTEGER(KIND=1)}, and @code{LOGICAL(KIND=1)} entities, then
+@code{INTEGER(KIND=6)} entities, and finally @code{CHARACTER}
+and @code{INTEGER(KIND=3)} entities.
+
+The reason to use such placement is it makes it more likely
+that your data will be aligned properly, without requiring
+you to do detailed analysis of each aggregate (@code{COMMON}
+and @code{EQUIVALENCE}) area.
+
+Specifically, on systems where the above guidelines are
+appropriate, placing @code{CHARACTER} entities before
+@code{REAL(KIND=2)} entities can work just as well,
+but only if the number of bytes occupied by the @code{CHARACTER}
+entities is divisible by the recommended alignment for
+@code{REAL(KIND=2)}.
+
+By ordering the placement of entities in aggregate
+areas according to the simple guidelines above, you
+avoid having to carefully count the number of bytes
+occupied by each entity to determine whether the
+actual alignment of each subsequent entity meets the
+alignment guidelines for the type of that entity.
+
+@item
+Use the (x86-specific) @samp{-malign-double} option when compiling
+programs.
+This will align only static data (entities in @code{COMMON} or
+local entities with the @code{SAVE} attribute),
+but it should probably always be
+used with Fortran code on the 586 and 686 architectures for best
+performance.
+
+This feature of @samp{-malign-double} means it may actually be best to
+use it with @samp{-fno-automatic} even though the latter usually
+produces worse code; at least, doing so will tend to produce more
+consistent run times.
+
+Using @samp{-malign-double} and @samp{-fno-automatic} together is
+apparently the only way to ensure that all doubles are correctly aligned
+on GNU x86 systems without having to change @code{g77} itself as
+described in the next item.
+(Note that the @code{gcc} C extension @samp{__attribute__ ((aligned (8))}
+also won't double-align the datum to which it is applied if that is allocated
+on the stack.)
+It isn't clear whether this deficiency also applies to
+non-GNU based x86 systems (Solaris, DGUX et al), but it probably does.
+
+@item
+Change the definition of the @samp{STACK_BOUNDARY} macro in
+@file{gcc/config/i386/i386.h} from @samp{32} to
+@samp{(TARGET_ALIGN_DOUBLE ? 64 : 32)}, and rebuild
+@code{g77}.
+@xref{Installation,,Installing GNU Fortran}, for more information.
+
+@item
+Ensure that @file{crt0.o} or @file{crt1.o}
+on your system guarantees a 64-bit
+aligned stack for @code{main()}.
+Some experimentation might be needed to determine this, and
+access to source code to fix this.
+While arranging this may typically
+get more data properly aligned, it won't, by itself,
+ensure they all are.
+
+One approach to testing this is to write a @code{main()} program
+in C or assembler that outputs the address of the stack pointer
+(and/or frame pointer), and visually inspect the output to see
+if the stack is 64-bit aligned.
+If it is, try renaming the executable to longer and shorter names
+and running the program again.
+If the name of the executable is placed on the stack by @file{crt0.o}
+or @file{crt1.o},
+the location of the stack should move, and this might help determine
+whether it is kept on a 64-bit boundary.
+@end itemize
+
+Yes, this is all more complicated than it should be.
+The problems are best solved in @code{gcc} and the
+libraries for the operating systems on such systems,
+which need to be continuously updated to provide the
+best alignment for newly released processors.
+Managing this while remaining compatible with ABIs
+on various systems can be challenging.
+
+@node Prefer Automatic Uninitialized Variables
+@subsection Prefer Automatic Uninitialized Variables
+
+If you're using @samp{-fno-automatic} already, you probably
+should change your code to allow compilation with @samp{-fautomatic}
+(the default), to allow the program to run faster.
+
+Similarly, you should be able to use @samp{-fno-init-local-zero}
+(the default) instead of @samp{-finit-local-zero}.
+This is because it is rare that every variable affected by these
+options in a given program actually needs to
+be so affected.
+
+For example, @samp{-fno-automatic}, which effectively @code{SAVE}s
+every local non-automatic variable and array, affects even things like
+@code{DO} iteration
+variables, which rarely need to be @code{SAVE}d, and this often reduces
+run-time performances.
+Similarly, @samp{-fno-init-local-zero} forces such
+variables to be initialized to zero---when @code{SAVE}d (such as when
+@samp{-fno-automatic}), this by itself generally affects only
+startup time for a program, but when not @code{SAVE}d,
+it can slow down the procedure every time it is called.
+
+@xref{Overly Convenient Options,,Overly Convenient Command-Line Options},
+for information on the @samp{-fno-automatic} and
+@samp{-finit-local-zero} options and how to convert
+their use into selective changes in your own code.
+
+@node Avoid f2c Compatibility
+@subsection Avoid f2c Compatibility
+@cindex -fno-f2c option
+@cindex options, -fno-f2c
+@cindex @code{f2c} compatibility
+@cindex compatibility, @code{f2c}
+
+If you aren't linking with any code compiled using
+@code{f2c}, try using the @samp{-fno-f2c} option when
+compiling @emph{all} the code in your program.
+(Note that @code{libf2c} is @emph{not} an example of code
+that is compiled using @code{f2c}---it is compiled by a C
+compiler, typically @code{gcc}.)
+
+@node Use Submodel Options
+@subsection Use Submodel Options
+@cindex Pentium optimizations
+@cindex optimizations, Pentium
+@cindex 586/686 CPUs
+@cindex submodels
+
+Using an appropriate @samp{-m} option to generate specific code for your
+CPU may be worthwhile, though it may mean the executable won't run on
+other versions of the CPU that don't support the same instruction set.
+@xref{Submodel Options,,Hardware Models and Configurations,gcc,Using and
+Porting GNU CC}.
+
+For recent CPUs that don't have explicit support in
+the released version of @code{gcc}, it may still be possible to get
+improvements.
+For instance, the flags recommended for 586/686
+(Pentium(Pro)) chips for building the Linux kernel are:
+
+@smallexample
+-m486 -malign-loops=2 -malign-jumps=2 -malign-functions=2
+-fomit-frame-pointer
+@end smallexample
+
+@noindent @samp{-fomit-frame-pointer} will, however, inhibit debugging
+on x86 systems.
+
+@node Trouble
+@chapter Known Causes of Trouble with GNU Fortran
+@cindex bugs, known
+@cindex installation trouble
+@cindex known causes of trouble
+
+This section describes known problems that affect users of GNU Fortran.
+Most of these are not GNU Fortran bugs per se---if they were, we would
+fix them.
+But the result for a user might be like the result of a bug.
+
+Some of these problems are due to bugs in other software, some are
+missing features that are too much work to add, and some are places
+where people's opinions differ as to what is best.
+
+Information on bugs that show up when configuring, porting, building,
+or installing @code{g77} is not provided here.
+@xref{Problems Installing}.
+
+To find out about major bugs discovered in the current release and
+possible workarounds for them, retrieve
+@url{ftp://alpha.gnu.ai.mit.edu/g77.plan}.
+
+(Note that some of this portion of the manual is lifted
+directly from the @code{gcc} manual, with minor modifications
+to tailor it to users of @code{g77}.
+Anytime a bug seems to have more to do with the @code{gcc}
+portion of @code{g77},
+@xref{Trouble,,Known Causes of Trouble with GNU CC,
+gcc,Using and Porting GNU CC}.)
+
+@menu
+* But-bugs:: Bugs really in other programs or elsewhere.
+* Actual Bugs:: Bugs and misfeatures we will fix later.
+* Missing Features:: Features we already know we want to add later.
+* Disappointments:: Regrettable things we can't change.
+* Non-bugs:: Things we think are right, but some others disagree.
+* Warnings and Errors:: Which problems in your code get warnings,
+ and which get errors.
+@end menu
+
+@node But-bugs
+@section Bugs Not In GNU Fortran
+@cindex but-bugs
+
+These are bugs to which the maintainers often have to reply,
+``but that isn't a bug in @code{g77}@dots{}''.
+Some of these already are fixed in new versions of other
+software; some still need to be fixed; some are problems
+with how @code{g77} is installed or is being used;
+some are the result of bad hardware that causes software
+to misbehave in sometimes bizarre ways;
+some just cannot be addressed at this time until more
+is known about the problem.
+
+Please don't re-report these bugs to the @code{g77} maintainers---if
+you must remind someone how important it is to you that the problem
+be fixed, talk to the people responsible for the other products
+identified below, but preferably only after you've tried the
+latest versions of those products.
+The @code{g77} maintainers have their hands full working on
+just fixing and improving @code{g77}, without serving as a
+clearinghouse for all bugs that happen to affect @code{g77}
+users.
+
+@xref{Collected Fortran Wisdom}, for information on behavior
+of Fortran programs, and the programs that compile them, that
+might be @emph{thought} to indicate bugs.
+
+@menu
+* Signal 11 and Friends:: Strange behavior by any software.
+* Cannot Link Fortran Programs:: Unresolved references.
+* Large Common Blocks:: Problems on older GNU/Linux systems.
+* Debugger Problems:: When the debugger crashes.
+* NeXTStep Problems:: Misbehaving executables.
+* Stack Overflow:: More misbehaving executables.
+* Nothing Happens:: Less behaving executables.
+* Strange Behavior at Run Time:: Executables misbehaving due to
+ bugs in your program.
+* Floating-point Errors:: The results look wrong, but@dots{}.
+@end menu
+
+@node Signal 11 and Friends
+@subsection Signal 11 and Friends
+@cindex signal 11
+@cindex hardware errors
+
+A whole variety of strange behaviors can occur when the
+software, or the way you are using the software,
+stresses the hardware in a way that triggers hardware bugs.
+This might seem hard to believe, but it happens frequently
+enough that there exist documents explaining in detail
+what the various causes of the problems are, what
+typical symptoms look like, and so on.
+
+Generally these problems are referred to in this document
+as ``signal 11'' crashes, because the Linux kernel, running
+on the most popular hardware (the Intel x86 line), often
+stresses the hardware more than other popular operating
+systems.
+When hardware problems do occur under GNU/Linux on x86
+systems, these often manifest themselves as ``signal 11''
+problems, as illustrated by the following diagnostic:
+
+@smallexample
+sh# @kbd{g77 myprog.f}
+gcc: Internal compiler error: program f771 got fatal signal 11
+sh#
+@end smallexample
+
+It is @emph{very} important to remember that the above
+message is @emph{not} the only one that indicates a
+hardware problem, nor does it always indicate a hardware
+problem.
+
+In particular, on systems other than those running the Linux
+kernel, the message might appear somewhat or very different,
+as it will if the error manifests itself while running a
+program other than the @code{g77} compiler.
+For example,
+it will appear somewhat different when running your program,
+when running Emacs, and so on.
+
+How to cope with such problems is well beyond the scope
+of this manual.
+
+However, users of Linux-based systems (such as GNU/Linux)
+should review @url{http://www.bitwizard.nl/sig11}, a source
+of detailed information on diagnosing hardware problems,
+by recognizing their common symptoms.
+
+Users of other operating systems and hardware might
+find this reference useful as well.
+If you know of similar material for another hardware/software
+combination, please let us know so we can consider including
+a reference to it in future versions of this manual.
+
+@node Cannot Link Fortran Programs
+@subsection Cannot Link Fortran Programs
+@cindex unresolved reference (various)
+@cindex linking error for user code
+@cindex code, user
+@cindex ld error for user code
+@cindex ld can't find strange names
+On some systems, perhaps just those with out-of-date (shared?)
+libraries, unresolved-reference errors happen when linking @code{g77}-compiled
+programs (which should be done using @code{g77}).
+
+If this happens to you, try appending @samp{-lc} to the command you
+use to link the program, e.g. @samp{g77 foo.f -lc}.
+@code{g77} already specifies @samp{-lf2c -lm} when it calls the linker,
+but it cannot also specify @samp{-lc} because not all systems have a
+file named @file{libc.a}.
+
+It is unclear at this point whether there are legitimately installed
+systems where @samp{-lf2c -lm} is insufficient to resolve code produced
+by @code{g77}.
+
+@cindex undefined reference (_main)
+@cindex linking error for user code
+@cindex ld error for user code
+@cindex code, user
+@cindex ld can't find _main
+If your program doesn't link due to unresolved references to names
+like @samp{_main}, make sure you're using the @code{g77} command to do the
+link, since this command ensures that the necessary libraries are
+loaded by specifying @samp{-lf2c -lm} when it invokes the @code{gcc}
+command to do the actual link.
+(Use the @samp{-v} option to discover
+more about what actually happens when you use the @code{g77} and @code{gcc}
+commands.)
+
+Also, try specifying @samp{-lc} as the last item on the @code{g77}
+command line, in case that helps.
+
+@node Large Common Blocks
+@subsection Large Common Blocks
+@cindex common blocks, large
+@cindex large common blocks
+@cindex linker errors
+@cindex ld errors
+@cindex errors, linker
+On some older GNU/Linux systems, programs with common blocks larger
+than 16MB cannot be linked without some kind of error
+message being produced.
+
+This is a bug in older versions of @code{ld}, fixed in
+more recent versions of @code{binutils}, such as version 2.6.
+
+@node Debugger Problems
+@subsection Debugger Problems
+@cindex @code{gdb} support
+@cindex support, @code{gdb}
+There are some known problems when using @code{gdb} on code
+compiled by @code{g77}.
+Inadequate investigation as of the release of 0.5.16 results in not
+knowing which products are the culprit, but @file{gdb-4.14} definitely
+crashes when, for example, an attempt is made to print the contents
+of a @code{COMPLEX(KIND=2)} dummy array, on at least some GNU/Linux machines, plus
+some others.
+
+@node NeXTStep Problems
+@subsection NeXTStep Problems
+@cindex NeXTStep problems
+@cindex bus error
+@cindex segmentation violation
+Developers of Fortran code on NeXTStep (all architectures) have to
+watch out for the following problem when writing programs with
+large, statically allocated (i.e. non-stack based) data structures
+(common blocks, saved arrays).
+
+Due to the way the native loader (@file{/bin/ld}) lays out
+data structures in virtual memory, it is very easy to create an
+executable wherein the @samp{__DATA} segment overlaps (has addresses in
+common) with the @samp{UNIX STACK} segment.
+
+This leads to all sorts of trouble, from the executable simply not
+executing, to bus errors.
+The NeXTStep command line tool @code{ebadexec} points to
+the problem as follows:
+
+@smallexample
+% @kbd{/bin/ebadexec a.out}
+/bin/ebadexec: __LINKEDIT segment (truncated address = 0x3de000
+rounded size = 0x2a000) of executable file: a.out overlaps with UNIX
+STACK segment (truncated address = 0x400000 rounded size =
+0x3c00000) of executable file: a.out
+@end smallexample
+
+(In the above case, it is the @samp{__LINKEDIT} segment that overlaps the
+stack segment.)
+
+This can be cured by assigning the @samp{__DATA} segment
+(virtual) addresses beyond the stack segment.
+A conservative
+estimate for this is from address 6000000 (hexadecimal) onwards---this
+has always worked for me [Toon Moene]:
+
+@smallexample
+% @kbd{g77 -segaddr __DATA 6000000 test.f}
+% @kbd{ebadexec a.out}
+ebadexec: file: a.out appears to be executable
+%
+@end smallexample
+
+Browsing through @file{gcc/f/Makefile.in},
+you will find that the @code{f771} program itself also has to be
+linked with these flags---it has large statically allocated
+data structures.
+(Version 0.5.18 reduces this somewhat, but probably
+not enough.)
+
+(The above item was contributed by Toon Moene
+(@email{toon@@moene.indiv.nluug.nl}).)
+
+@node Stack Overflow
+@subsection Stack Overflow
+@cindex stack overflow
+@cindex segmentation violation
+@code{g77} code might fail at runtime (probably with a ``segmentation
+violation'') due to overflowing the stack.
+This happens most often on systems with an environment
+that provides substantially more heap space (for use
+when arbitrarily allocating and freeing memory) than stack
+space.
+
+Often this can be cured by
+increasing or removing your shell's limit on stack usage, typically
+using @kbd{limit stacksize} (in @code{csh} and derivatives) or
+@kbd{ulimit -s} (in @code{sh} and derivatives).
+
+Increasing the allowed stack size might, however, require
+changing some operating system or system configuration parameters.
+
+You might be able to work around the problem by compiling with the
+@samp{-fno-automatic} option to reduce stack usage, probably at the
+expense of speed.
+
+@xref{Maximum Stackable Size}, for information on patching
+@code{g77} to use different criteria for placing local
+non-automatic variables and arrays on the stack.
+
+@cindex automatic arrays
+@cindex arrays, automatic
+However, if your program uses large automatic arrays
+(for example, has declarations like @samp{REAL A(N)} where
+@samp{A} is a local array and @samp{N} is a dummy or
+@code{COMMON} variable that can have a large value),
+neither use of @samp{-fno-automatic},
+nor changing the cut-off point for @code{g77} for using the stack,
+will solve the problem by changing the placement of these
+large arrays, as they are @emph{necessarily} automatic.
+
+@code{g77} currently provides no means to specify that
+automatic arrays are to be allocated on the heap instead
+of the stack.
+So, other than increasing the stack size, your best bet is to
+change your source code to avoid large automatic arrays.
+Methods for doing this currently are outside the scope of
+this document.
+
+(@emph{Note:} If your system puts stack and heap space in the
+same memory area, such that they are effectively combined, then
+a stack overflow probably indicates a program that is either
+simply too large for the system, or buggy.)
+
+@node Nothing Happens
+@subsection Nothing Happens
+@cindex nothing happens
+@cindex naming programs @samp{test}
+@cindex @samp{test} programs
+@cindex programs named @samp{test}
+It is occasionally reported that a ``simple'' program,
+such as a ``Hello, World!'' program, does nothing when
+it is run, even though the compiler reported no errors,
+despite the program containing nothing other than a
+simple @code{PRINT} statement.
+
+This most often happens because the program has been
+compiled and linked on a UNIX system and named @samp{test},
+though other names can lead to similarly unexpected
+run-time behavior on various systems.
+
+Essentially this problem boils down to giving
+your program a name that is already known to
+the shell you are using to identify some other program,
+which the shell continues to execute instead of your
+program when you invoke it via, for example:
+
+@smallexample
+sh# @kbd{test}
+sh#
+@end smallexample
+
+Under UNIX and many other system, a simple command name
+invokes a searching mechanism that might well not choose
+the program located in the current working directory if
+there is another alternative (such as the @code{test}
+command commonly installed on UNIX systems).
+
+The reliable way to invoke a program you just linked in
+the current directory under UNIX is to specify it using
+an explicit pathname, as in:
+
+@smallexample
+sh# @kbd{./test}
+ Hello, World!
+sh#
+@end smallexample
+
+Users who encounter this problem should take the time to
+read up on how their shell searches for commands, how to
+set their search path, and so on.
+The relevant UNIX commands to learn about include
+@code{man}, @code{info} (on GNU systems), @code{setenv} (or
+@code{set} and @code{env}), @code{which}, and @code{find}.
+
+@node Strange Behavior at Run Time
+@subsection Strange Behavior at Run Time
+@cindex segmentation violation
+@cindex bus error
+@cindex overwritten data
+@cindex data, overwritten
+@code{g77} code might fail at runtime with ``segmentation violation'',
+``bus error'', or even something as subtle as a procedure call
+overwriting a variable or array element that it is not supposed
+to touch.
+
+These can be symptoms of a wide variety of actual bugs that
+occurred earlier during the program's run, but manifested
+themselves as @emph{visible} problems some time later.
+
+Overflowing the bounds of an array---usually by writing beyond
+the end of it---is one of two kinds of bug that often occurs
+in Fortran code.
+
+The other kind of bug is a mismatch between the actual arguments
+passed to a procedure and the dummy arguments as declared by that
+procedure.
+
+Both of these kinds of bugs, and some others as well, can be
+difficult to track down, because the bug can change its behavior,
+or even appear to not occur, when using a debugger.
+
+That is, these bugs can be quite sensitive to data, including
+data representing the placement of other data in memory (that is,
+pointers, such as the placement of stack frames in memory).
+
+Plans call for improving @code{g77} so that it can offer the
+ability to catch and report some of these problems at compile, link, or
+run time, such as by generating code to detect references to
+beyond the bounds of an array, or checking for agreement between
+calling and called procedures.
+
+In the meantime, finding and fixing the programming
+bugs that lead to these behaviors is, ultimately, the user's
+responsibility, as difficult as that task can sometimes be.
+
+@cindex `infinite spaces' printed
+@cindex spaces, endless printing of
+@cindex libc, non-ANSI or non-default
+@cindex C library
+@cindex linking against non-standard library
+@cindex Solaris
+One runtime problem that has been observed might have a simple solution.
+If a formatted @code{WRITE} produces an endless stream of spaces, check
+that your program is linked against the correct version of the C library.
+The configuration process takes care to account for your
+system's normal @file{libc} not being ANSI-standard, which will
+otherwise cause this behaviour.
+If your system's default library is
+ANSI-standard and you subsequently link against a non-ANSI one, there
+might be problems such as this one.
+
+Specifically, on Solaris2 systems,
+avoid picking up the @code{BSD} library from @file{/usr/ucblib}.
+
+@node Floating-point Errors
+@subsection Floating-point Errors
+@cindex floating-point errors
+@cindex rounding errors
+@cindex inconsistent floating-point results
+@cindex results, inconsistent
+Some programs appear to produce inconsistent floating-point
+results compiled by @code{g77} versus by other compilers.
+
+Often the reason for this behavior is the fact that floating-point
+values are represented on almost all Fortran systems by
+@emph{approximations}, and these approximations are inexact
+even for apparently simple values like 0.1, 0.2, 0.3, 0.4, 0.6,
+0.7, 0.8, 0.9, 1.1, and so on.
+Most Fortran systems, including all current ports of @code{g77},
+use binary arithmetic to represent these approximations.
+
+Therefore, the exact value of any floating-point approximation
+as manipulated by @code{g77}-compiled code is representable by
+adding some combination of the values 1.0, 0.5, 0.25, 0.125, and
+so on (just keep dividing by two) through the precision of the
+fraction (typically around 23 bits for @code{REAL(KIND=1)}, 52 for
+@code{REAL(KIND=2)}), then multiplying the sum by a integral
+power of two (in Fortran, by @samp{2**N}) that typically is between
+-127 and +128 for @code{REAL(KIND=1)} and -1023 and +1024 for
+@code{REAL(KIND=2)}, then multiplying by -1 if the number
+is negative.
+
+So, a value like 0.2 is exactly represented in decimal---since
+it is a fraction, @samp{2/10}, with a denomenator that is compatible
+with the base of the number system (base 10).
+However, @samp{2/10} cannot be represented by any finite number
+of sums of any of 1.0, 0.5, 0.25, and so on, so 0.2 cannot
+be exactly represented in binary notation.
+
+(On the other hand, decimal notation can represent any binary
+number in a finite number of digits.
+Decimal notation cannot do so with ternary, or base-3,
+notation, which would represent floating-point numbers as
+sums of any of @samp{1/1}, @samp{1/3}, @samp{1/9}, and so on.
+After all, no finite number of decimal digits can exactly
+represent @samp{1/3}.
+Fortunately, few systems use ternary notation.)
+
+Moreover, differences in the way run-time I/O libraries convert
+between these approximations and the decimal representation often
+used by programmers and the programs they write can result in
+apparent differences between results that do not actually exist,
+or exist to such a small degree that they usually are not worth
+worrying about.
+
+For example, consider the following program:
+
+@smallexample
+PRINT *, 0.2
+END
+@end smallexample
+
+When compiled by @code{g77}, the above program might output
+@samp{0.20000003}, while another compiler might produce a
+executable that outputs @samp{0.2}.
+
+This particular difference is due to the fact that, currently,
+conversion of floating-point values by the @code{libf2c} library,
+used by @code{g77}, handles only double-precision values.
+
+Since @samp{0.2} in the program is a single-precision value, it
+is converted to double precision (still in binary notation)
+before being converted back to decimal.
+The conversion to binary appends _binary_ zero digits to the
+original value---which, again, is an inexact approximation of
+0.2---resulting in an approximation that is much less exact
+than is connoted by the use of double precision.
+
+(The appending of binary zero digits has essentially the same
+effect as taking a particular decimal approximation of
+@samp{1/3}, such as @samp{0.3333333}, and appending decimal
+zeros to it, producing @samp{0.33333330000000000}.
+Treating the resulting decimal approximation as if it really
+had 18 or so digits of valid precision would make it seem
+a very poor approximation of @samp{1/3}.)
+
+As a result of converting the single-precision approximation
+to double precision by appending binary zeros, the conversion
+of the resulting double-precision
+value to decimal produces what looks like an incorrect
+result, when in fact the result is @emph{inexact}, and
+is probably no less inaccurate or imprecise an approximation
+of 0.2 than is produced by other compilers that happen to output
+the converted value as ``exactly'' @samp{0.2}.
+(Some compilers behave in a way that can make them appear
+to retain more accuracy across a conversion of a single-precision
+constant to double precision.
+@xref{Context-Sensitive Constants}, to see why
+this practice is illusory and even dangerous.)
+
+Note that a more exact approximation of the constant is
+computed when the program is changed to specify a
+double-precision constant:
+
+@smallexample
+PRINT *, 0.2D0
+END
+@end smallexample
+
+Future versions of @code{g77} and/or @code{libf2c} might convert
+single-precision values directly to decimal,
+instead of converting them to double precision first.
+This would tend to result in output that is more consistent
+with that produced by some other Fortran implementations.
+
+@include bugs.texi
+
+@node Missing Features
+@section Missing Features
+
+This section lists features we know are missing from @code{g77},
+and which we want to add someday.
+(There is no priority implied in the ordering below.)
+
+@menu
+GNU Fortran language:
+* Better Source Model::
+* Fortran 90 Support::
+* Intrinsics in PARAMETER Statements::
+* SELECT CASE on CHARACTER Type::
+* RECURSIVE Keyword::
+* Popular Non-standard Types::
+* Full Support for Compiler Types::
+* Array Bounds Expressions::
+* POINTER Statements::
+* Sensible Non-standard Constructs::
+* FLUSH Statement::
+* Expressions in FORMAT Statements::
+* Explicit Assembler Code::
+* Q Edit Descriptor::
+
+GNU Fortran dialects:
+* Old-style PARAMETER Statements::
+* TYPE and ACCEPT I/O Statements::
+* STRUCTURE UNION RECORD MAP::
+* OPEN CLOSE and INQUIRE Keywords::
+* ENCODE and DECODE::
+* Suppressing Space Padding::
+* Fortran Preprocessor::
+* Bit Operations on Floating-point Data::
+
+New facilities:
+* POSIX Standard::
+* Floating-point Exception Handling::
+* Nonportable Conversions::
+* Large Automatic Arrays::
+* Support for Threads::
+* Increasing Precision/Range::
+
+Better diagnostics:
+* Gracefully Handle Sensible Bad Code::
+* Non-standard Conversions::
+* Non-standard Intrinsics::
+* Modifying DO Variable::
+* Better Pedantic Compilation::
+* Warn About Implicit Conversions::
+* Invalid Use of Hollerith Constant::
+* Dummy Array Without Dimensioning Dummy::
+* Invalid FORMAT Specifiers::
+* Ambiguous Dialects::
+* Unused Labels::
+* Informational Messages::
+
+Run-time facilities:
+* Uninitialized Variables at Run Time::
+* Bounds Checking at Run Time::
+
+Debugging:
+* Labels Visible to Debugger::
+@end menu
+
+@node Better Source Model
+@subsection Better Source Model
+
+@code{g77} needs to provide, as the default source-line model,
+a ``pure visual'' mode, where
+the interpretation of a source program in this mode can be accurately
+determined by a user looking at a traditionally displayed rendition
+of the program (assuming the user knows whether the program is fixed
+or free form).
+
+The design should assume the user cannot tell tabs from spaces
+and cannot see trailing spaces on lines, but has canonical tab stops
+and, for fixed-form source, has the ability to always know exactly
+where column 72 is (since the Fortran standard itself requires
+this for fixed-form source).
+
+This would change the default treatment of fixed-form source
+to not treat lines with tabs as if they were infinitely long---instead,
+they would end at column 72 just as if the tabs were replaced
+by spaces in the canonical way.
+
+As part of this, provide common alternate models (Digital, @code{f2c},
+and so on) via command-line options.
+This includes allowing arbitrarily long
+lines for free-form source as well as fixed-form source and providing
+various limits and diagnostics as appropriate.
+
+@cindex sequence numbers
+@cindex columns 73 through 80
+Also, @code{g77} should offer, perhaps even default to, warnings
+when characters beyond the last valid column are anything other
+than spaces.
+This would mean code with ``sequence numbers'' in columns 73 through 80
+would be rejected, and there's a lot of that kind of code around,
+but one of the most frequent bugs encountered by new users is
+accidentally writing fixed-form source code into and beyond
+column 73.
+So, maybe the users of old code would be able to more easily handle
+having to specify, say, a @code{-Wno-col73to80} option.
+
+@node Fortran 90 Support
+@subsection Fortran 90 Support
+@cindex Fortran 90 support
+@cindex support, Fortran 90
+
+@code{g77} does not support many of the features that
+distinguish Fortran 90 (and, now, Fortran 95) from
+ANSI FORTRAN 77.
+
+Some Fortran 90 features are supported, because they
+make sense to offer even to die-hard users of F77.
+For example, many of them codify various ways F77 has
+been extended to meet users' needs during its tenure,
+so @code{g77} might as well offer them as the primary
+way to meet those same needs, even if it offers compatibility
+with one or more of the ways those needs were met
+by other F77 compilers in the industry.
+
+Still, many important F90 features are not supported,
+because no attempt has been made to research each and
+every feature and assess its viability in @code{g77}.
+In the meantime, users who need those features must
+use Fortran 90 compilers anyway, and the best approach
+to adding some F90 features to GNU Fortran might well be
+to fund a comprehensive project to create GNU Fortran 95.
+
+@node Intrinsics in PARAMETER Statements
+@subsection Intrinsics in @code{PARAMETER} Statements
+@cindex PARAMETER statement
+@cindex statements, PARAMETER
+
+@code{g77} doesn't allow intrinsics in @code{PARAMETER} statements.
+This feature is considered to be absolutely vital, even though it
+is not standard-conforming, and is scheduled for version 0.6.
+
+Related to this, @code{g77} doesn't allow non-integral
+exponentiation in @code{PARAMETER} statements, such as
+@samp{PARAMETER (R=2**.25)}.
+It is unlikely @code{g77} will ever support this feature,
+as doing it properly requires complete emulation of
+a target computer's floating-point facilities when
+building @code{g77} as a cross-compiler.
+But, if the @code{gcc} back end is enhanced to provide
+such a facility, @code{g77} will likely use that facility
+in implementing this feature soon afterwards.
+
+@node SELECT CASE on CHARACTER Type
+@subsection @code{SELECT CASE} on @code{CHARACTER} Type
+
+Character-type selector/cases for @code{SELECT CASE} currently
+are not supported.
+
+@node RECURSIVE Keyword
+@subsection @code{RECURSIVE} Keyword
+@cindex RECURSIVE keyword
+@cindex keywords, RECURSIVE
+@cindex recursion, lack of
+@cindex lack of recursion
+
+@code{g77} doesn't support the @code{RECURSIVE} keyword that
+F90 compilers do.
+Nor does it provide any means for compiling procedures
+designed to do recursion.
+
+All recursive code can be rewritten to not use recursion,
+but the result is not pretty.
+
+@node Increasing Precision/Range
+@subsection Increasing Precision/Range
+@cindex -r8
+@cindex -i8
+@cindex f2c
+@cindex increasing precision
+@cindex precision, increasing
+@cindex increasing range
+@cindex range, increasing
+@cindex Toolpack
+@cindex Netlib
+
+Some compilers, such as @code{f2c}, have an option (@samp{-r8} or
+similar) that provides automatic treatment of @code{REAL}
+entities such that they have twice the storage size, and
+a corresponding increase in the range and precision, of what
+would normally be the @code{REAL(KIND=1)} (default @code{REAL}) type.
+(This affects @code{COMPLEX} the same way.)
+
+They also typically offer another option (@samp{-i8}) to increase
+@code{INTEGER} entities so they are twice as large
+(with roughly twice as much range).
+
+(There are potential pitfalls in using these options.)
+
+@code{g77} does not yet offer any option that performs these
+kinds of transformations.
+Part of the problem is the lack of detailed specifications regarding
+exactly how these options affect the interpretation of constants,
+intrinsics, and so on.
+
+Until @code{g77} addresses this need, programmers could improve
+the portability of their code by modifying it to not require
+compile-time options to produce correct results.
+Some free tools are available which may help, specifically
+in Toolpack (which one would expect to be sound) and the @file{fortran}
+section of the Netlib repository.
+
+Use of preprocessors can provide a fairly portable means
+to work around the lack of widely portable methods in the Fortran
+language itself (though increasing acceptance of Fortran 90 would
+alleviate this problem).
+
+@node Popular Non-standard Types
+@subsection Popular Non-standard Types
+@cindex INTEGER*2 support
+@cindex LOGICAL*1 support
+
+@code{g77} doesn't fully support @code{INTEGER*2}, @code{LOGICAL*1},
+and similar.
+Version 0.6 will provide full support for this very
+popular set of features.
+In the meantime, version 0.5.18 provides rudimentary support
+for them.
+
+@node Full Support for Compiler Types
+@subsection Full Support for Compiler Types
+
+@cindex REAL*16 support
+@code{g77} doesn't support @code{INTEGER}, @code{REAL}, and @code{COMPLEX} equivalents
+for @emph{all} applicable back-end-supported types (@code{char}, @code{short int},
+@code{int}, @code{long int}, @code{long long int}, and @code{long double}).
+This means providing intrinsic support, and maybe constant
+support (using F90 syntax) as well, and, for most
+machines will result in automatic support of @code{INTEGER*1},
+@code{INTEGER*2}, @code{INTEGER*8}, maybe even @code{REAL*16},
+and so on.
+This is scheduled for version 0.6.
+
+@node Array Bounds Expressions
+@subsection Array Bounds Expressions
+@cindex array elements, in adjustable array bounds
+@cindex function references, in adjustable array bounds
+@cindex array bounds, adjustable
+@cindex DIMENSION statement
+@cindex statements, DIMENSION
+
+@code{g77} doesn't support more general expressions to dimension
+arrays, such as array element references, function
+references, etc.
+
+For example, @code{g77} currently does not accept the following:
+
+@smallexample
+SUBROUTINE X(M, N)
+INTEGER N(10), M(N(2), N(1))
+@end smallexample
+
+@node POINTER Statements
+@subsection POINTER Statements
+@cindex POINTER statement
+@cindex statements, POINTER
+@cindex Cray pointers
+
+@code{g77} doesn't support pointers or allocatable objects
+(other than automatic arrays).
+This set of features is
+probably considered just behind intrinsics
+in @code{PARAMETER} statements on the list of large,
+important things to add to @code{g77}.
+
+@node Sensible Non-standard Constructs
+@subsection Sensible Non-standard Constructs
+
+@code{g77} rejects things other compilers accept,
+like @samp{INTRINSIC SQRT,SQRT}.
+As time permits in the future, some of these things that are easy for
+humans to read and write and unlikely to be intended to mean something
+else will be accepted by @code{g77} (though @samp{-fpedantic} should
+trigger warnings about such non-standard constructs).
+
+Until @code{g77} no longer gratuitously rejects sensible code,
+you might as well fix your code
+to be more standard-conforming and portable.
+
+The kind of case that is important to except from the
+recommendation to change your code is one where following
+good coding rules would force you to write non-standard
+code that nevertheless has a clear meaning.
+
+For example, when writing an @code{INCLUDE} file that
+defines a common block, it might be appropriate to
+include a @code{SAVE} statement for the common block
+(such as @samp{SAVE /CBLOCK/}), so that variables
+defined in the common block retain their values even
+when all procedures declaring the common block become
+inactive (return to their callers).
+
+However, putting @code{SAVE} statements in an @code{INCLUDE}
+file would prevent otherwise standard-conforming code
+from also specifying the @code{SAVE} statement, by itself,
+to indicate that all local variables and arrays are to
+have the @code{SAVE} attribute.
+
+For this reason, @code{g77} already has been changed to
+allow this combination, because although the general
+problem of gratuitously rejecting unambiguous and
+``safe'' constructs still exists in @code{g77}, this
+particular construct was deemed useful enough that
+it was worth fixing @code{g77} for just this case.
+
+So, while there is no need to change your code
+to avoid using this particular construct, there
+might be other, equally appropriate but non-standard
+constructs, that you shouldn't have to stop using
+just because @code{g77} (or any other compiler)
+gratuitously rejects it.
+
+Until the general problem is solved, if you have
+any such construct you believe is worthwhile
+using (e.g. not just an arbitrary, redundant
+specification of an attribute), please submit a
+bug report with an explanation, so we can consider
+fixing @code{g77} just for cases like yours.
+
+@node FLUSH Statement
+@subsection @code{FLUSH} Statement
+
+@code{g77} could perhaps use a @code{FLUSH} statement that
+does what @samp{CALL FLUSH} does,
+but that supports @samp{*} as the unit designator (same unit as for
+@code{PRINT}) and accepts @code{ERR=} and/or @code{IOSTAT=}
+specifiers.
+
+@node Expressions in FORMAT Statements
+@subsection Expressions in @code{FORMAT} Statements
+@cindex FORMAT statement
+@cindex statements, FORMAT
+
+@code{g77} doesn't support @samp{FORMAT(I<J>)} and the like.
+Supporting this requires a significant redesign or replacement
+of @code{libf2c}.
+
+However, a future version of @code{g77} might support
+this construct when the expression is constant. For
+example:
+
+@smallexample
+ PARAMETER (IWIDTH = 12)
+10 FORMAT (I<IWIDTH>)
+@end smallexample
+
+In the meantime, at least for output (@code{PRINT} and
+@code{WRITE}), Fortran code making use of this feature can
+be rewritten to avoid it by constructing the @code{FORMAT}
+string in a @code{CHARACTER} variable or array, then
+using that variable or array in place of the @code{FORMAT}
+statement label to do the original @code{PRINT} or @code{WRITE}.
+
+Many uses of this feature on input can be rewritten this way
+as well, but not all can.
+For example, this can be rewritten:
+
+@smallexample
+ READ 20, I
+20 FORMAT (I<J>)
+@end smallexample
+
+However, this cannot, in general, be rewritten, especially
+when @code{ERR=} and @code{END=} constructs are employed:
+
+@smallexample
+ READ 30, J, I
+30 FORMAT (I<J>)
+@end smallexample
+
+@node Explicit Assembler Code
+@subsection Explicit Assembler Code
+
+@code{g77} needs to provide some way, a la @code{gcc}, for @code{g77}
+code to specify explicit assembler code.
+
+@node Q Edit Descriptor
+@subsection Q Edit Descriptor
+@cindex FORMAT statement
+@cindex Q edit descriptor
+
+The @code{Q} edit descriptor in @code{FORMAT}s isn't supported.
+(This is meant to get the number of characters remaining in an input record.)
+Supporting this requires a significant redesign or replacement
+of @code{libf2c}.
+
+A workaround might be using internal I/O or the stream-based intrinsics.
+@xref{FGetC Intrinsic (subroutine)}.
+
+@node Old-style PARAMETER Statements
+@subsection Old-style PARAMETER Statements
+@cindex PARAMETER statement
+@cindex statements, PARAMETER
+
+@code{g77} doesn't accept @samp{PARAMETER I=1}.
+Supporting this obsolete form of
+the @code{PARAMETER} statement would not be particularly hard, as most of the
+parsing code is already in place and working.
+
+Until time/money is
+spent implementing it, you might as well fix your code to use the
+standard form, @samp{PARAMETER (I=1)} (possibly needing
+@samp{INTEGER I} preceding the @code{PARAMETER} statement as well,
+otherwise, in the obsolete form of @code{PARAMETER}, the
+type of the variable is set from the type of the constant being
+assigned to it).
+
+@node TYPE and ACCEPT I/O Statements
+@subsection @code{TYPE} and @code{ACCEPT} I/O Statements
+@cindex TYPE statement
+@cindex statements, TYPE
+@cindex ACCEPT statement
+@cindex statements, ACCEPT
+
+@code{g77} doesn't support the I/O statements @code{TYPE} and
+@code{ACCEPT}.
+These are common extensions that should be easy to support,
+but also are fairly easy to work around in user code.
+
+Generally, any @samp{TYPE fmt,list} I/O statement can be replaced
+by @samp{PRINT fmt,list}.
+And, any @samp{ACCEPT fmt,list} statement can be
+replaced by @samp{READ fmt,list}.
+
+@node STRUCTURE UNION RECORD MAP
+@subsection @code{STRUCTURE}, @code{UNION}, @code{RECORD}, @code{MAP}
+@cindex STRUCTURE statement
+@cindex statements, STRUCTURE
+@cindex UNION statement
+@cindex statements, UNION
+@cindex RECORD statement
+@cindex statements, RECORD
+@cindex MAP statement
+@cindex statements, MAP
+
+@code{g77} doesn't support @code{STRUCTURE}, @code{UNION}, @code{RECORD},
+@code{MAP}.
+This set of extensions is quite a bit
+lower on the list of large, important things to add to @code{g77}, partly
+because it requires a great deal of work either upgrading or
+replacing @code{libf2c}.
+
+@node OPEN CLOSE and INQUIRE Keywords
+@subsection @code{OPEN}, @code{CLOSE}, and @code{INQUIRE} Keywords
+@cindex disposition of files
+@cindex OPEN statement
+@cindex statements, OPEN
+@cindex CLOSE statement
+@cindex statements, CLOSE
+@cindex INQUIRE statement
+@cindex statements, INQUIRE
+
+@code{g77} doesn't have support for keywords such as @code{DISP='DELETE'} in
+the @code{OPEN}, @code{CLOSE}, and @code{INQUIRE} statements.
+These extensions are easy to add to @code{g77} itself, but
+require much more work on @code{libf2c}.
+
+@node ENCODE and DECODE
+@subsection @code{ENCODE} and @code{DECODE}
+@cindex ENCODE statement
+@cindex statements, ENCODE
+@cindex DECODE statement
+@cindex statements, DECODE
+
+@code{g77} doesn't support @code{ENCODE} or @code{DECODE}.
+
+These statements are best replaced by READ and WRITE statements
+involving internal files (CHARACTER variables and arrays).
+
+For example, replace a code fragment like
+
+@smallexample
+ INTEGER*1 LINE(80)
+@dots{}
+ DECODE (80, 9000, LINE) A, B, C
+@dots{}
+9000 FORMAT (1X, 3(F10.5))
+@end smallexample
+
+@noindent
+with:
+
+@smallexample
+ CHARACTER*80 LINE
+@dots{}
+ READ (UNIT=LINE, FMT=9000) A, B, C
+@dots{}
+9000 FORMAT (1X, 3(F10.5))
+@end smallexample
+
+Similarly, replace a code fragment like
+
+@smallexample
+ INTEGER*1 LINE(80)
+@dots{}
+ ENCODE (80, 9000, LINE) A, B, C
+@dots{}
+9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
+@end smallexample
+
+@noindent
+with:
+
+@smallexample
+ CHARACTER*80 LINE
+@dots{}
+ WRITE (UNIT=LINE, FMT=9000) A, B, C
+@dots{}
+9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
+@end smallexample
+
+It is entirely possible that @code{ENCODE} and @code{DECODE} will
+be supported by a future version of @code{g77}.
+
+@node Suppressing Space Padding
+@subsection Suppressing Space Padding of Source Lines
+
+@code{g77} should offer VXT-Fortran-style suppression of virtual
+spaces at the end of a source line
+if an appropriate command-line option is specified.
+
+This affects cases where
+a character constant is continued onto the next line in a fixed-form
+source file, as in the following example:
+
+@smallexample
+10 PRINT *,'HOW MANY
+ 1 SPACES?'
+@end smallexample
+
+@noindent
+@code{g77}, and many other compilers, virtually extend
+the continued line through column 72 with spaces that become part
+of the character constant, but Digital Fortran normally didn't,
+leaving only one space between @samp{MANY} and @samp{SPACES?}
+in the output of the above statement.
+
+Fairly recently, at least one version of Digital Fortran
+was enhanced to provide the other behavior when a
+command-line option is specified, apparently due to demand
+from readers of the USENET group @file{comp.lang.fortran}
+to offer conformance to this widespread practice in the
+industry.
+@code{g77} should return the favor by offering conformance
+to Digital's approach to handling the above example.
+
+@node Fortran Preprocessor
+@subsection Fortran Preprocessor
+
+@code{g77} should offer a preprocessor designed specifically
+for Fortran to replace @samp{cpp -traditional}.
+There are several out there worth evaluating, at least.
+
+Such a preprocessor would recognize Hollerith constants,
+properly parse comments and character constants, and so on.
+It might also recognize, process, and thus preprocess
+files included via the @code{INCLUDE} directive.
+
+@node Bit Operations on Floating-point Data
+@subsection Bit Operations on Floating-point Data
+@cindex AND intrinsic
+@cindex intrinsics, AND
+@cindex OR intrinsic
+@cindex intrinsics, OR
+@cindex SHIFT intrinsic
+@cindex intrinsics, SHIFT
+
+@code{g77} does not allow @code{REAL} and other non-integral types for
+arguments to intrinsics like @code{AND}, @code{OR}, and @code{SHIFT}.
+
+For example, this program is rejected by @code{g77}, because
+the intrinsic @code{IAND} does not accept @code{REAL} arguments:
+
+@smallexample
+DATA A/7.54/, B/9.112/
+PRINT *, IAND(A, B)
+END
+@end smallexample
+
+@node POSIX Standard
+@subsection @code{POSIX} Standard
+
+@code{g77} should support the POSIX standard for Fortran.
+
+@node Floating-point Exception Handling
+@subsection Floating-point Exception Handling
+@cindex floating point exceptions
+@cindex exceptions, floating point
+@cindex FPE handling
+@cindex NaN values
+
+The @code{gcc} backend and, consequently, @code{g77}, currently provides no
+control over whether or not floating-point exceptions are trapped or
+ignored.
+(Ignoring them typically results in NaN values being
+propagated in systems that conform to IEEE 754.)@
+The behaviour is inherited from the system-dependent startup code.
+
+Most systems provide some C-callable mechanism to change this; this can
+be invoked at startup using @code{gcc}'s @code{constructor} attribute.
+For example, just compiling and linking the following C code with your
+program will turn on exception trapping for the ``common'' exceptions
+on an x86-based GNU system:
+
+@smallexample
+#include <fpu_control.h>
+void __attribute__ ((constructor))
+trapfpe () @{
+ (void) __setfpucw (_FPU_DEFAULT &
+ ~(_FPU_MASK_IM | _FPU_MASK_ZM | _FPU_MASK_OM));
+@}
+@end smallexample
+
+@node Nonportable Conversions
+@subsection Nonportable Conversions
+@cindex nonportable conversions
+@cindex conversions, nonportable
+
+@code{g77} doesn't accept some particularly nonportable,
+silent data-type conversions such as @code{LOGICAL}
+to @code{REAL} (as in @samp{A=.FALSE.}, where @samp{A}
+is type @code{REAL}), that other compilers might
+quietly accept.
+
+Some of these conversions are accepted by @code{g77}
+when the @samp{-fugly} option is specified.
+Perhaps it should accept more or all of them.
+
+@node Large Automatic Arrays
+@subsection Large Automatic Arrays
+@cindex automatic arrays
+@cindex arrays, automatic
+
+Currently, automatic arrays always are allocated on the stack.
+For situations where the stack cannot be made large enough,
+@code{g77} should offer a compiler option that specifies
+allocation of automatic arrays in heap storage.
+
+@node Support for Threads
+@subsection Support for Threads
+@cindex threads
+@cindex parallel processing
+
+Neither the code produced by @code{g77} nor the @code{libf2c} library
+are thread-safe, nor does @code{g77} have support for parallel processing
+(other than the instruction-level parallelism available on some
+processors).
+A package such as PVM might help here.
+
+@node Gracefully Handle Sensible Bad Code
+@subsection Gracefully Handle Sensible Bad Code
+
+@code{g77} generally should continue processing for
+warnings and recoverable (user) errors whenever possible---that
+is, it shouldn't gratuitously make bad or useless code.
+
+For example:
+
+@smallexample
+INTRINSIC ZABS
+CALL FOO(ZABS)
+END
+@end smallexample
+
+@noindent
+When compiling the above with @samp{-ff2c-intrinsics-disable},
+@code{g77} should indeed complain about passing @code{ZABS},
+but it still should compile, instead of rejecting
+the entire @code{CALL} statement.
+(Some of this is related to improving
+the compiler internals to improve how statements are analyzed.)
+
+@node Non-standard Conversions
+@subsection Non-standard Conversions
+
+@samp{-Wconversion} and related should flag places where non-standard
+conversions are found.
+Perhaps much of this would be part of @samp{-Wugly*}.
+
+@node Non-standard Intrinsics
+@subsection Non-standard Intrinsics
+
+@code{g77} needs a new option, like @samp{-Wintrinsics}, to warn about use of
+non-standard intrinsics without explicit @code{INTRINSIC} statements for them.
+This would help find code that might fail silently when ported to another
+compiler.
+
+@node Modifying DO Variable
+@subsection Modifying @code{DO} Variable
+
+@code{g77} should warn about modifying @code{DO} variables
+via @code{EQUIVALENCE}.
+(The internal information gathered to produce this warning
+might also be useful in setting the
+internal ``doiter'' flag for a variable or even array
+reference within a loop, since that might produce faster code someday.)
+
+For example, this code is invalid, so @code{g77} should warn about
+the invalid assignment to @samp{NOTHER}:
+
+@smallexample
+EQUIVALENCE (I, NOTHER)
+DO I = 1, 100
+ IF (I.EQ. 10) NOTHER = 20
+END DO
+@end smallexample
+
+@node Better Pedantic Compilation
+@subsection Better Pedantic Compilation
+
+@code{g77} needs to support @samp{-fpedantic} more thoroughly,
+and use it only to generate
+warnings instead of rejecting constructs outright.
+Have it warn:
+if a variable that dimensions an array is not a dummy or placed
+explicitly in @code{COMMON} (F77 does not allow it to be
+placed in @code{COMMON} via @code{EQUIVALENCE}); if specification statements
+follow statement-function-definition statements; about all sorts of
+syntactic extensions.
+
+@node Warn About Implicit Conversions
+@subsection Warn About Implicit Conversions
+
+@code{g77} needs a @samp{-Wpromotions} option to warn if source code appears
+to expect automatic, silent, and
+somewhat dangerous compiler-assisted conversion of @code{REAL(KIND=1)}
+constants to @code{REAL(KIND=2)} based on context.
+
+For example, it would warn about cases like this:
+
+@smallexample
+DOUBLE PRECISION FOO
+PARAMETER (TZPHI = 9.435784839284958)
+FOO = TZPHI * 3D0
+@end smallexample
+
+@node Invalid Use of Hollerith Constant
+@subsection Invalid Use of Hollerith Constant
+
+@code{g77} should disallow statements like @samp{RETURN 2HAB},
+which are invalid in both source forms
+(unlike @samp{RETURN (2HAB)},
+which probably still makes no sense but at least can
+be reliably parsed).
+Fixed-form processing rejects it, but not free-form, except
+in a way that is a bit difficult to understand.
+
+@node Dummy Array Without Dimensioning Dummy
+@subsection Dummy Array Without Dimensioning Dummy
+
+@code{g77} should complain when a list of dummy arguments containing an
+adjustable dummy array does
+not also contain every variable listed in the dimension list of the
+adjustable array.
+
+Currently, @code{g77} does complain about a variable that
+dimensions an array but doesn't appear in any dummy list or @code{COMMON}
+area, but this needs to be extended to catch cases where it doesn't appear in
+every dummy list that also lists any arrays it dimensions.
+
+For example, @code{g77} should warn about the entry point @samp{ALT}
+below, since it includes @samp{ARRAY} but not @samp{ISIZE} in its
+list of arguments:
+
+@smallexample
+SUBROUTINE PRIMARY(ARRAY, ISIZE)
+REAL ARRAY(ISIZE)
+ENTRY ALT(ARRAY)
+@end smallexample
+
+@node Invalid FORMAT Specifiers
+@subsection Invalid FORMAT Specifiers
+
+@code{g77} should check @code{FORMAT} specifiers for validity
+as it does @code{FORMAT} statements.
+
+For example, a diagnostic would be produced for:
+
+@smallexample
+PRINT 'HI THERE!' !User meant PRINT *, 'HI THERE!'
+@end smallexample
+
+@node Ambiguous Dialects
+@subsection Ambiguous Dialects
+
+@code{g77} needs a set of options such as @samp{-Wugly*}, @samp{-Wautomatic},
+@samp{-Wvxt}, @samp{-Wf90}, and so on.
+These would warn about places in the user's source where ambiguities
+are found, helpful in resolving ambiguities in the program's
+dialect or dialects.
+
+@node Unused Labels
+@subsection Unused Labels
+
+@code{g77} should warn about unused labels when @samp{-Wunused} is in effect.
+
+@node Informational Messages
+@subsection Informational Messages
+
+@code{g77} needs an option to suppress information messages (notes).
+@samp{-w} does this but also suppresses warnings.
+The default should be to suppress info messages.
+
+Perhaps info messages should simply be eliminated.
+
+@node Uninitialized Variables at Run Time
+@subsection Uninitialized Variables at Run Time
+
+@code{g77} needs an option to initialize everything (not otherwise
+explicitly initialized) to ``weird''
+(machine-dependent) values, e.g. NaNs, bad (non-@code{NULL}) pointers, and
+largest-magnitude integers, would help track down references to
+some kinds of uninitialized variables at run time.
+
+Note that use of the options @samp{-O -Wuninitialized} can catch
+many such bugs at compile time.
+
+@node Bounds Checking at Run Time
+@subsection Bounds Checking at Run Time
+
+@code{g77} should offer run-time bounds-checking of array/subscript references
+in a fashion similar to @code{f2c}.
+
+Note that @code{g77} already warns about references to out-of-bounds
+elements of arrays when it detects these at compile time.
+
+@node Labels Visible to Debugger
+@subsection Labels Visible to Debugger
+
+@code{g77} should output debugging information for statements labels,
+for use by debuggers that know how to support them.
+Same with weirder things like construct names.
+It is not yet known if any debug formats or debuggers support these.
+
+@node Disappointments
+@section Disappointments and Misunderstandings
+
+These problems are perhaps regrettable, but we don't know any practical
+way around them for now.
+
+@menu
+* Mangling of Names:: @samp{SUBROUTINE FOO} is given
+ external name @samp{foo_}.
+* Multiple Definitions of External Names:: No doing both @samp{COMMON /FOO/}
+ and @samp{SUBROUTINE FOO}.
+* Limitation on Implicit Declarations:: No @samp{IMPLICIT CHARACTER*(*)}.
+@end menu
+
+@node Mangling of Names
+@subsection Mangling of Names in Source Code
+@cindex naming issues
+@cindex external names
+@cindex common blocks
+@cindex name space
+@cindex underscores
+
+The current external-interface design, which includes naming of
+external procedures, COMMON blocks, and the library interface,
+has various usability problems, including things like adding
+underscores where not really necessary (and preventing easier
+inter-language operability) and yet not providing complete
+namespace freedom for user C code linked with Fortran apps (due
+to the naming of functions in the library, among other things).
+
+Project GNU should at least get all this ``right'' for systems
+it fully controls, such as the Hurd, and provide defaults and
+options for compatibility with existing systems and interoperability
+with popular existing compilers.
+
+@node Multiple Definitions of External Names
+@subsection Multiple Definitions of External Names
+@cindex block data
+@cindex BLOCK DATA statement
+@cindex statements, BLOCK DATA
+@cindex COMMON statement
+@cindex statements, COMMON
+@cindex naming conflicts
+
+@code{g77} doesn't allow a common block and an external procedure or
+@code{BLOCK DATA} to have the same name.
+Some systems allow this, but @code{g77} does not,
+to be compatible with @code{f2c}.
+
+@code{g77} could special-case the way it handles
+@code{BLOCK DATA}, since it is not compatible with @code{f2c} in this
+particular area (necessarily, since @code{g77} offers an
+important feature here), but
+it is likely that such special-casing would be very annoying to people
+with programs that use @samp{EXTERNAL FOO}, with no other mention of
+@samp{FOO} in the same program unit, to refer to external procedures, since
+the result would be that @code{g77} would treat these references as requests to
+force-load BLOCK DATA program units.
+
+In that case, if @code{g77} modified
+names of @code{BLOCK DATA} so they could have the same names as
+@code{COMMON}, users
+would find that their programs wouldn't link because the @samp{FOO} procedure
+didn't have its name translated the same way.
+
+(Strictly speaking,
+@code{g77} could emit a null-but-externally-satisfying definition of
+@samp{FOO} with its name transformed as if it had been a
+@code{BLOCK DATA}, but that probably invites more trouble than it's
+worth.)
+
+@node Limitation on Implicit Declarations
+@subsection Limitation on Implicit Declarations
+@cindex IMPLICIT CHARACTER*(*) statement
+@cindex statements, IMPLICIT CHARACTER*(*)
+
+@code{g77} disallows @code{IMPLICIT CHARACTER*(*)}.
+This is not standard-conforming.
+
+@node Non-bugs
+@section Certain Changes We Don't Want to Make
+
+This section lists changes that people frequently request, but which
+we do not make because we think GNU Fortran is better without them.
+
+@menu
+* Backslash in Constants:: Why @samp{'\\'} is a constant that
+ is one, not two, characters long.
+* Initializing Before Specifying:: Why @samp{DATA VAR/1/} can't precede
+ @samp{COMMON VAR}.
+* Context-Sensitive Intrinsicness:: Why @samp{CALL SQRT} won't work.
+* Context-Sensitive Constants:: Why @samp{9.435784839284958} is a
+ single-precision constant,
+ and might be interpreted as
+ @samp{9.435785} or similar.
+* Equivalence Versus Equality:: Why @samp{.TRUE. .EQ. .TRUE.} won't work.
+* Order of Side Effects:: Why @samp{J = IFUNC() - IFUNC()} might
+ not behave as expected.
+@end menu
+
+@node Backslash in Constants
+@subsection Backslash in Constants
+@cindex backslash
+@cindex f77 support
+@cindex support, f77
+
+In the opinion of many experienced Fortran users,
+@samp{-fno-backslash} should be the default, not @samp{-fbackslash},
+as currently set by @code{g77}.
+
+First of all, you can always specify
+@samp{-fno-backslash} to turn off this processing.
+
+Despite not being within the spirit (though apparently within the
+letter) of the ANSI FORTRAN 77 standard, @code{g77} defaults to
+@samp{-fbackslash} because that is what most UNIX @code{f77} commands
+default to, and apparently lots of code depends on this feature.
+
+This is a particularly troubling issue.
+The use of a C construct in the midst of Fortran code
+is bad enough, worse when it makes existing Fortran
+programs stop working (as happens when programs written
+for non-UNIX systems are ported to UNIX systems with
+compilers that provide the @samp{-fbackslash} feature
+as the default---sometimes with no option to turn it off).
+
+The author of GNU Fortran wished, for reasons of linguistic
+purity, to make @samp{-fno-backslash} the default for GNU
+Fortran and thus require users of UNIX @code{f77} and @code{f2c}
+to specify @samp{-fbackslash} to get the UNIX behavior.
+
+However, the realization that @code{g77} is intended as
+a replacement for @emph{UNIX} @code{f77}, caused the author
+to choose to make @code{g77} as compatible with
+@code{f77} as feasible, which meant making @samp{-fbackslash}
+the default.
+
+The primary focus on compatibility is at the source-code
+level, and the question became ``What will users expect
+a replacement for @code{f77} to do, by default?''
+Although at least one UNIX @code{f77} does not provide
+@samp{-fbackslash} as a default, it appears that
+the majority of them do, which suggests that
+the majority of code that is compiled by UNIX @code{f77}
+compilers expects @samp{-fbackslash} to be the default.
+
+It is probably the case that more code exists
+that would @emph{not} work with @samp{-fbackslash}
+in force than code that requires it be in force.
+
+However, most of @emph{that} code is not being compiled
+with @code{f77},
+and when it is, new build procedures (shell scripts,
+makefiles, and so on) must be set up anyway so that
+they work under UNIX.
+That makes a much more natural and safe opportunity for
+non-UNIX users to adapt their build procedures for
+@code{g77}'s default of @samp{-fbackslash} than would
+exist for the majority of UNIX @code{f77} users who
+would have to modify existing, working build procedures
+to explicitly specify @samp{-fbackslash} if that was
+not the default.
+
+One suggestion has been to configure the default for
+@samp{-fbackslash} (and perhaps other options as well)
+based on the configuration of @code{g77}.
+
+This is technically quite straightforward, but will be avoided
+even in cases where not configuring defaults to be
+dependent on a particular configuration greatly inconveniences
+some users of legacy code.
+
+Many users appreciate the GNU compilers because they provide an
+environment that is uniform across machines.
+These users would be
+inconvenienced if the compiler treated things like the
+format of the source code differently on certain machines.
+
+Occasionally users write programs intended only for a particular machine
+type.
+On these occasions, the users would benefit if the GNU Fortran compiler
+were to support by default the same dialect as the other compilers on
+that machine.
+But such applications are rare.
+And users writing a
+program to run on more than one type of machine cannot possibly benefit
+from this kind of compatibility.
+(This is consistent with the design goals for @code{gcc}.
+To change them for @code{g77}, you must first change them
+for @code{gcc}.
+Do not ask the maintainers of @code{g77} to do this for you,
+or to disassociate @code{g77} from the widely understood, if
+not widely agreed-upon, goals for GNU compilers in general.)
+
+This is why GNU Fortran does and will treat backslashes in the same
+fashion on all types of machines (by default).
+@xref{Direction of Language Development}, for more information on
+this overall philosophy guiding the development of the GNU Fortran
+language.
+
+Of course, users strongly concerned about portability should indicate
+explicitly in their build procedures which options are expected
+by their source code, or write source code that has as few such
+expectations as possible.
+
+For example, avoid writing code that depends on backslash (@samp{\})
+being interpreted either way in particular, such as by
+starting a program unit with:
+
+@smallexample
+CHARACTER BACKSL
+PARAMETER (BACKSL = '\\')
+@end smallexample
+
+@noindent
+Then, use concatenation of @samp{BACKSL} anyplace a backslash
+is desired.
+In this way, users can write programs which have the same meaning
+in many Fortran dialects.
+
+(However, this technique does not work for Hollerith constants---which
+is just as well, since the only generally portable uses for Hollerith
+constants are in places where character constants can and should
+be used instead, for readability.)
+
+@node Initializing Before Specifying
+@subsection Initializing Before Specifying
+@cindex initialization, statement placement
+@cindex placing initialization statements
+
+@code{g77} does not allow @samp{DATA VAR/1/} to appear in the
+source code before @samp{COMMON VAR},
+@samp{DIMENSION VAR(10)}, @samp{INTEGER VAR}, and so on.
+In general, @code{g77} requires initialization of a variable
+or array to be specified @emph{after} all other specifications
+of attributes (type, size, placement, and so on) of that variable
+or array are specified (though @emph{confirmation} of data type is
+permitted).
+
+It is @emph{possible} @code{g77} will someday allow all of this,
+even though it is not allowed by the FORTRAN 77 standard.
+
+Then again, maybe it is better to have
+@code{g77} always require placement of @code{DATA}
+so that it can possibly immediately write constants
+to the output file, thus saving time and space.
+
+That is, @samp{DATA A/1000000*1/} should perhaps always
+be immediately writable to canonical assembler, unless it's already known
+to be in a @code{COMMON} area following as-yet-uninitialized stuff,
+and to do this it cannot be followed by @samp{COMMON A}.
+
+@node Context-Sensitive Intrinsicness
+@subsection Context-Sensitive Intrinsicness
+@cindex intrinsics, context-sensitive
+@cindex context-sensitive intrinsics
+
+@code{g77} treats procedure references to @emph{possible} intrinsic
+names as always enabling their intrinsic nature, regardless of
+whether the @emph{form} of the reference is valid for that
+intrinsic.
+
+For example, @samp{CALL SQRT} is interpreted by @code{g77} as
+an invalid reference to the @code{SQRT} intrinsic function,
+because the reference is a subroutine invocation.
+
+First, @code{g77} recognizes the statement @samp{CALL SQRT}
+as a reference to a @emph{procedure} named @samp{SQRT}, not
+to a @emph{variable} with that name (as it would for a statement
+such as @samp{V = SQRT}).
+
+Next, @code{g77} establishes that, in the program unit being compiled,
+@code{SQRT} is an intrinsic---not a subroutine that
+happens to have the same name as an intrinsic (as would be
+the case if, for example, @samp{EXTERNAL SQRT} was present).
+
+Finally, @code{g77} recognizes that the @emph{form} of the
+reference is invalid for that particular intrinsic.
+That is, it recognizes that it is invalid for an intrinsic
+@emph{function}, such as @code{SQRT}, to be invoked as
+a @emph{subroutine}.
+
+At that point, @code{g77} issues a diagnostic.
+
+Some users claim that it is ``obvious'' that @samp{CALL SQRT}
+references an external subroutine of their own, not an
+intrinsic function.
+
+However, @code{g77} knows about intrinsic
+subroutines, not just functions, and is able to support both having
+the same names, for example.
+
+As a result of this, @code{g77} rejects calls
+to intrinsics that are not subroutines, and function invocations
+of intrinsics that are not functions, just as it (and most compilers)
+rejects invocations of intrinsics with the wrong number (or types)
+of arguments.
+
+So, use the @samp{EXTERNAL SQRT} statement in a program unit that calls
+a user-written subroutine named @samp{SQRT}.
+
+@node Context-Sensitive Constants
+@subsection Context-Sensitive Constants
+@cindex constants, context-sensitive
+@cindex context-sensitive constants
+
+@code{g77} does not use context to determine the types of
+constants or named constants (@code{PARAMETER}), except
+for (non-standard) typeless constants such as @samp{'123'O}.
+
+For example, consider the following statement:
+
+@smallexample
+PRINT *, 9.435784839284958 * 2D0
+@end smallexample
+
+@noindent
+@code{g77} will interpret the (truncated) constant
+@samp{9.435784839284958} as a @code{REAL(KIND=1)}, not @code{REAL(KIND=2)},
+constant, because the suffix @code{D0} is not specified.
+
+As a result, the output of the above statement when
+compiled by @code{g77} will appear to have ``less precision''
+than when compiled by other compilers.
+
+In these and other cases, some compilers detect the
+fact that a single-precision constant is used in
+a double-precision context and therefore interpret the
+single-precision constant as if it was @emph{explicitly}
+specified as a double-precision constant.
+(This has the effect of appending @emph{decimal}, not
+@emph{binary}, zeros to the fractional part of the
+number---producing different computational results.)
+
+The reason this misfeature is dangerous is that a slight,
+apparently innocuous change to the source code can change
+the computational results. Consider:
+
+@smallexample
+REAL ALMOST, CLOSE
+DOUBLE PRECISION FIVE
+PARAMETER (ALMOST = 5.000000000001)
+FIVE = 5
+CLOSE = 5.000000000001
+PRINT *, 5.000000000001 - FIVE
+PRINT *, ALMOST - FIVE
+PRINT *, CLOSE - FIVE
+END
+@end smallexample
+
+@noindent
+Running the above program should
+result in the same value being
+printed three times.
+With @code{g77} as the compiler,
+it does.
+
+However, compiled by many other compilers,
+running the above program would print
+two or three distinct values, because
+in two or three of the statements, the
+constant @samp{5.000000000001}, which
+on most systems is exactly equal to @samp{5.}
+when interpreted as a single-precision constant,
+is instead interpreted as a double-precision
+constant, preserving the represented
+precision.
+However, this ``clever'' promotion of
+type does not extend to variables or,
+in some compilers, to named constants.
+
+Since programmers often are encouraged to replace manifest
+constants or permanently-assigned variables with named
+constants (@code{PARAMETER} in Fortran), and might need
+to replace some constants with variables having the same
+values for pertinent portions of code,
+it is important that compilers treat code so modified in the
+same way so that the results of such programs are the same.
+@code{g77} helps in this regard by treating constants just
+the same as variables in terms of determining their types
+in a context-independent way.
+
+Still, there is a lot of existing Fortran code that has
+been written to depend on the way other compilers freely
+interpret constants' types based on context, so anything
+@code{g77} can do to help flag cases of this in such code
+could be very helpful.
+
+@node Equivalence Versus Equality
+@subsection Equivalence Versus Equality
+@cindex .EQV., with integer operands
+@cindex comparing logical expressions
+@cindex logical expressions, comparing
+
+Use of @code{.EQ.} and @code{.NE.} on @code{LOGICAL} operands
+is not supported, except via @samp{-fugly}, which is not
+recommended except for legacy code (where the behavior expected
+by the @emph{code} is assumed).
+
+Legacy code should be changed, as resources permit, to use @code{.EQV.}
+and @code{.NEQV.} instead, as these are permitted by the various
+Fortran standards.
+
+New code should never be written expecting @code{.EQ.} or @code{.NE.}
+to work if either of its operands is @code{LOGICAL}.
+
+The problem with supporting this ``feature'' is that there is
+unlikely to be consensus on how it works, as illustrated by the
+following sample program:
+
+@smallexample
+LOGICAL L,M,N
+DATA L,M,N /3*.FALSE./
+IF (L.AND.M.EQ.N) PRINT *,'L.AND.M.EQ.N'
+END
+@end smallexample
+
+The issue raised by the above sample program is: what is the
+precedence of @code{.EQ.} (and @code{.NE.}) when applied to
+@code{LOGICAL} operands?
+
+Some programmers will argue that it is the same as the precedence
+for @code{.EQ.} when applied to numeric (such as @code{INTEGER})
+operands.
+By this interpretation, the subexpression @samp{M.EQ.N} must be
+evaluated first in the above program, resulting in a program that,
+when run, does not execute the @code{PRINT} statement.
+
+Other programmers will argue that the precedence is the same as
+the precedence for @code{.EQV.}, which is restricted by the standards
+to @code{LOGICAL} operands.
+By this interpretation, the subexpression @samp{L.AND.M} must be
+evaluated first, resulting in a program that @emph{does} execute
+the @code{PRINT} statement.
+
+Assigning arbitrary semantic interpretations to syntactic expressions
+that might legitimately have more than one ``obvious'' interpretation
+is generally unwise.
+
+The creators of the various Fortran standards have done a good job
+in this case, requiring a distinct set of operators (which have their
+own distinct precedence) to compare @code{LOGICAL} operands.
+This requirement results in expression syntax with more certain
+precedence (without requiring substantial context), making it easier
+for programmers to read existing code.
+@code{g77} will avoid muddying up elements of the Fortran language
+that were well-designed in the first place.
+
+(Ask C programmers about the precedence of expressions such as
+@samp{(a) & (b)} and @samp{(a) - (b)}---they cannot even tell
+you, without knowing more context, whether the @samp{&} and @samp{-}
+operators are infix (binary) or unary!)
+
+@node Order of Side Effects
+@subsection Order of Side Effects
+@cindex side effects, order of evaluation
+@cindex order of evaluation, side effects
+
+@code{g77} does not necessarily produce code that, when run, performs
+side effects (such as those performed by function invocations)
+in the same order as in some other compiler---or even in the same
+order as another version, port, or invocation (using different
+command-line options) of @code{g77}.
+
+It is never safe to depend on the order of evaluation of side effects.
+For example, an expression like this may very well behave differently
+from one compiler to another:
+
+@smallexample
+J = IFUNC() - IFUNC()
+@end smallexample
+
+@noindent
+There is no guarantee that @samp{IFUNC} will be evaluated in any particular
+order.
+Either invocation might happen first.
+If @samp{IFUNC} returns 5 the first time it is invoked, and
+returns 12 the second time, @samp{J} might end up with the
+value @samp{7}, or it might end up with @samp{-7}.
+
+Generally, in Fortran, procedures with side-effects intended to
+be visible to the caller are best designed as @emph{subroutines},
+not functions.
+Examples of such side-effects include:
+
+@itemize @bullet
+@item
+The generation of random numbers
+that are intended to influence return values.
+
+@item
+Performing I/O
+(other than internal I/O to local variables).
+
+@item
+Updating information in common blocks.
+@end itemize
+
+An example of a side-effect that is not intended to be visible
+to the caller is a function that maintains a cache of recently
+calculated results, intended solely to speed repeated invocations
+of the function with identical arguments.
+Such a function can be safely used in expressions, because
+if the compiler optimizes away one or more calls to the
+function, operation of the program is unaffected (aside
+from being speeded up).
+
+@node Warnings and Errors
+@section Warning Messages and Error Messages
+
+@cindex error messages
+@cindex warnings vs errors
+@cindex messages, warning and error
+The GNU compiler can produce two kinds of diagnostics: errors and
+warnings.
+Each kind has a different purpose:
+
+@itemize @w{}
+@item
+@emph{Errors} report problems that make it impossible to compile your
+program.
+GNU Fortran reports errors with the source file name, line
+number, and column within the line where the problem is apparent.
+
+@item
+@emph{Warnings} report other unusual conditions in your code that
+@emph{might} indicate a problem, although compilation can (and does)
+proceed.
+Warning messages also report the source file name, line number,
+and column information,
+but include the text @samp{warning:} to distinguish them
+from error messages.
+@end itemize
+
+Warnings might indicate danger points where you should check to make sure
+that your program really does what you intend; or the use of obsolete
+features; or the use of nonstandard features of GNU Fortran.
+Many warnings are issued only if you ask for them, with one of the
+@samp{-W} options (for instance, @samp{-Wall} requests a variety of
+useful warnings).
+
+@emph{Note:} Currently, the text of the line and a pointer to the column
+is printed in most @code{g77} diagnostics.
+Probably, as of version 0.6, @code{g77} will
+no longer print the text of the source line, instead printing
+the column number following the file name and line number in
+a form that GNU Emacs recognizes.
+This change is expected to speed up and reduce the memory usage
+of the @code{g77} compiler.
+@c
+@c Say this when it is true -- hopefully 0.6, maybe 0.7 or later. --burley
+@c
+@c GNU Fortran always tries to compile your program if possible; it never
+@c gratuitously rejects a program whose meaning is clear merely because
+@c (for instance) it fails to conform to a standard. In some cases,
+@c however, the Fortran standard specifies that certain extensions are
+@c forbidden, and a diagnostic @emph{must} be issued by a conforming
+@c compiler. The @samp{-pedantic} option tells GNU Fortran to issue warnings
+@c in such cases; @samp{-pedantic-errors} says to make them errors instead.
+@c This does not mean that @emph{all} non-ANSI constructs get warnings
+@c or errors.
+
+@xref{Warning Options,,Options to Request or Suppress Warnings}, for
+more detail on these and related command-line options.
+
+@node Open Questions
+@chapter Open Questions
+
+Please consider offering useful answers to these questions!
+
+@itemize @bullet
+@item
+How do system administrators and users manage multiple incompatible
+Fortran compilers on their systems?
+How can @code{g77} contribute to this, or at least avoiding
+intefering with it?
+
+Currently, @code{g77} provides rudimentary ways to choose whether to
+overwrite portions of other Fortran compilation systems
+(such as the @code{f77} command and the @code{libf2c} library).
+Is this sufficient?
+What happens when users choose not to overwrite these---does
+@code{g77} work properly in all such installations, picking
+up its own versions, or does it pick up the existing ``alien''
+versions it didn't overwrite with its own, possibly leading
+to subtle bugs?
+
+@item
+@code{LOC()} and other intrinsics are probably somewhat misclassified.
+Is the a need for more precise classification of intrinsics, and if so,
+what are the appropriate groupings?
+Is there a need to individually
+enable/disable/delete/hide intrinsics from the command line?
+@end itemize
+
+@node Bugs
+@chapter Reporting Bugs
+@cindex bugs
+@cindex reporting bugs
+
+Your bug reports play an essential role in making GNU Fortran reliable.
+
+When you encounter a problem, the first thing to do is to see if it is
+already known.
+@xref{Trouble}.
+If it isn't known, then you should report the problem.
+
+Reporting a bug might help you by bringing a solution to your problem, or
+it might not.
+(If it does not, look in the service directory; see
+@ref{Service}.)@
+In any case, the principal function of a bug report is
+to help the entire community by making the next version of GNU Fortran work
+better.
+Bug reports are your contribution to the maintenance of GNU Fortran.
+
+Since the maintainers are very overloaded, we cannot respond to every
+bug report.
+However, if the bug has not been fixed, we are likely to
+send you a patch and ask you to tell us whether it works.
+
+In order for a bug report to serve its purpose, you must include the
+information that makes for fixing the bug.
+
+@menu
+* Criteria: Bug Criteria. Have you really found a bug?
+* Where: Bug Lists. Where to send your bug report.
+* Reporting: Bug Reporting. How to report a bug effectively.
+* Patches: Sending Patches. How to send a patch for GNU Fortran.
+@end menu
+
+@xref{Trouble,,Known Causes of Trouble with GNU Fortran},
+for information on problems we already know about.
+
+@xref{Service,,How To Get Help with GNU Fortran},
+for information on where to ask for help.
+
+@node Bug Criteria
+@section Have You Found a Bug?
+@cindex bug criteria
+
+If you are not sure whether you have found a bug, here are some guidelines:
+
+@itemize @bullet
+@cindex fatal signal
+@cindex core dump
+@item
+If the compiler gets a fatal signal, for any input whatever, that is a
+compiler bug.
+Reliable compilers never crash---they just remain obsolete.
+
+@cindex invalid assembly code
+@cindex assembly code, invalid
+@item
+If the compiler produces invalid assembly code, for any input whatever,
+@c (except an @code{asm} statement),
+that is a compiler bug, unless the
+compiler reports errors (not just warnings) which would ordinarily
+prevent the assembler from being run.
+
+@cindex undefined behavior
+@cindex undefined function value
+@item
+If the compiler produces valid assembly code that does not correctly
+execute the input source code, that is a compiler bug.
+
+However, you must double-check to make sure, because you might have run
+into an incompatibility between GNU Fortran and traditional Fortran.
+@c (@pxref{Incompatibilities}).
+These incompatibilities might be considered
+bugs, but they are inescapable consequences of valuable features.
+
+Or you might have a program whose behavior is undefined, which happened
+by chance to give the desired results with another Fortran compiler.
+It is best to check the relevant Fortran standard thoroughly if
+it is possible that the program indeed does something undefined.
+
+After you have localized the error to a single source line, it should
+be easy to check for these things.
+If your program is correct and well defined, you have found
+a compiler bug.
+
+It might help if, in your submission, you identified the specific
+language in the relevant Fortran standard that specifies the
+desired behavior, if it isn't likely to be obvious and agreed-upon
+by all Fortran users.
+
+@item
+If the compiler produces an error message for valid input, that is a
+compiler bug.
+
+@cindex invalid input
+@item
+If the compiler does not produce an error message for invalid input,
+that is a compiler bug.
+However, you should note that your idea of
+``invalid input'' might be someone else's idea
+of ``an extension'' or ``support for traditional practice''.
+
+@item
+If you are an experienced user of Fortran compilers, your suggestions
+for improvement of GNU Fortran are welcome in any case.
+@end itemize
+
+@node Bug Lists
+@section Where to Report Bugs
+@cindex bug report mailing lists
+@kindex fortran@@gnu.ai.mit.edu
+Send bug reports for GNU Fortran to @email{fortran@@gnu.ai.mit.edu}.
+
+Often people think of posting bug reports to a newsgroup instead of
+mailing them.
+This sometimes appears to work, but it has one problem which can be
+crucial: a newsgroup posting does not contain a mail path back to the
+sender.
+Thus, if maintainers need more information, they might be unable
+to reach you. For this reason, you should always send bug reports by
+mail to the proper mailing list.
+
+As a last resort, send bug reports on paper to:
+
+@example
+GNU Compiler Bugs
+Free Software Foundation
+59 Temple Place - Suite 330
+Boston, MA 02111-1307, USA
+@end example
+
+@node Bug Reporting
+@section How to Report Bugs
+@cindex compiler bugs, reporting
+
+The fundamental principle of reporting bugs usefully is this:
+@strong{report all the facts}.
+If you are not sure whether to state a
+fact or leave it out, state it!
+
+Often people omit facts because they think they know what causes the
+problem and they conclude that some details don't matter.
+Thus, you might
+assume that the name of the variable you use in an example does not matter.
+Well, probably it doesn't, but one cannot be sure.
+Perhaps the bug is a
+stray memory reference which happens to fetch from the location where that
+name is stored in memory; perhaps, if the name were different, the contents
+of that location would fool the compiler into doing the right thing despite
+the bug.
+Play it safe and give a specific, complete example.
+That is the
+easiest thing for you to do, and the most helpful.
+
+Keep in mind that the purpose of a bug report is to enable someone to
+fix the bug if it is not known.
+It isn't very important what happens if
+the bug is already known.
+Therefore, always write your bug reports on
+the assumption that the bug is not known.
+
+Sometimes people give a few sketchy facts and ask, ``Does this ring a
+bell?''
+This cannot help us fix a bug, so it is rarely helpful.
+We respond by asking for enough details to enable us to investigate.
+You might as well expedite matters by sending them to begin with.
+(Besides, there are enough bells ringing around here as it is.)
+
+Try to make your bug report self-contained.
+If we have to ask you for
+more information, it is best if you include all the previous information
+in your response, as well as the information that was missing.
+
+Please report each bug in a separate message.
+This makes it easier for
+us to track which bugs have been fixed and to forward your bugs reports
+to the appropriate maintainer.
+
+Do not compress and encode any part of your bug report using programs
+such as @file{uuencode}.
+If you do so it will slow down the processing
+of your bug.
+If you must submit multiple large files, use @file{shar},
+which allows us to read your message without having to run any
+decompression programs.
+
+(As a special exception for GNU Fortran bug-reporting, at least
+for now, if you are sending more than a few lines of code, if
+your program's source file format contains ``interesting'' things
+like trailing spaces or strange characters, or if you need to
+include binary data files, it is acceptable to put all the
+files together in a @code{tar} archive, and, whether you need to
+do that, it is acceptable to then compress the single file (@code{tar}
+archive or source file)
+using @code{gzip} and encode it via @code{uuencode}.
+Do not use any MIME stuff---the current maintainer can't decode this.
+Using @code{compress} instead of @code{gzip} is acceptable, assuming
+you have licensed the use of the patented algorithm in
+@code{compress} from Unisys.)
+
+To enable someone to investigate the bug, you should include all these
+things:
+
+@itemize @bullet
+@item
+The version of GNU Fortran.
+You can get this by running @code{g77} with the @samp{-v} option.
+(Ignore any error messages that might be displayed
+when the linker is run.)
+
+Without this, we won't know whether there is any point in looking for
+the bug in the current version of GNU Fortran.
+
+@item
+@cindex preprocessor
+@cindex cpp program
+@cindex programs, cpp
+A complete input file that will reproduce the bug.
+If the bug is in the compiler proper (@file{f771}) and
+you are using the C preprocessor, run your
+source file through the C preprocessor by doing @samp{g77 -E
+@var{sourcefile} > @var{outfile}}, then include the contents of
+@var{outfile} in the bug report. (When you do this, use the same
+@samp{-I}, @samp{-D} or @samp{-U} options that you used in actual
+compilation.)
+
+A single statement is not enough of an example.
+In order to compile it,
+it must be embedded in a complete file of compiler input; and the bug
+might depend on the details of how this is done.
+
+Without a real example one can compile, all anyone can do about your bug
+report is wish you luck. It would be futile to try to guess how to
+provoke the bug. For example, bugs in register allocation and reloading
+frequently depend on every little detail of the function they happen in.
+
+@item
+@cindex included files
+@cindex INCLUDE directive
+@cindex directive, INCLUDE
+@cindex #include directive
+@cindex directive, #include
+Note that you should include with your bug report any files
+included by the source file
+(via the @code{#include} or @code{INCLUDE} directive)
+that you send, and any files they include, and so on.
+
+It is not necessary to replace
+the @code{#include} and @code{INCLUDE} directives
+with the actual files in the version of the source file that
+you send, but it might make submitting the bug report easier
+in the end.
+However, be sure to @emph{reproduce} the bug using the @emph{exact}
+version of the source material you submit, to avoid wild-goose
+chases.
+
+@item
+The command arguments you gave GNU Fortran to compile that example
+and observe the bug. For example, did you use @samp{-O}? To guarantee
+you won't omit something important, list all the options.
+
+If we were to try to guess the arguments, we would probably guess wrong
+and then we would not encounter the bug.
+
+@item
+The type of machine you are using, and the operating system name and
+version number.
+(Much of this information is printed by @samp{g77 -v}---if you
+include that, send along any additional info you have that you
+don't see clearly represented in that output.)
+
+@item
+The operands you gave to the @code{configure} command when you installed
+the compiler.
+
+@item
+A complete list of any modifications you have made to the compiler
+source. (We don't promise to investigate the bug unless it happens in
+an unmodified compiler. But if you've made modifications and don't tell
+us, then you are sending us on a wild-goose chase.)
+
+Be precise about these changes. A description in English is not
+enough---send a context diff for them.
+
+Adding files of your own (such as a machine description for a machine we
+don't support) is a modification of the compiler source.
+
+@item
+Details of any other deviations from the standard procedure for installing
+GNU Fortran.
+
+@item
+A description of what behavior you observe that you believe is
+incorrect. For example, ``The compiler gets a fatal signal,'' or,
+``The assembler instruction at line 208 in the output is incorrect.''
+
+Of course, if the bug is that the compiler gets a fatal signal, then one
+can't miss it. But if the bug is incorrect output, the maintainer might
+not notice unless it is glaringly wrong. None of us has time to study
+all the assembler code from a 50-line Fortran program just on the chance that
+one instruction might be wrong. We need @emph{you} to do this part!
+
+Even if the problem you experience is a fatal signal, you should still
+say so explicitly. Suppose something strange is going on, such as, your
+copy of the compiler is out of synch, or you have encountered a bug in
+the C library on your system. (This has happened!) Your copy might
+crash and the copy here would not. If you @i{said} to expect a crash,
+then when the compiler here fails to crash, we would know that the bug
+was not happening. If you don't say to expect a crash, then we would
+not know whether the bug was happening. We would not be able to draw
+any conclusion from our observations.
+
+If the problem is a diagnostic when building GNU Fortran with some other
+compiler, say whether it is a warning or an error.
+
+Often the observed symptom is incorrect output when your program is run.
+Sad to say, this is not enough information unless the program is short
+and simple. None of us has time to study a large program to figure out
+how it would work if compiled correctly, much less which line of it was
+compiled wrong. So you will have to do that. Tell us which source line
+it is, and what incorrect result happens when that line is executed. A
+person who understands the program can find this as easily as finding a
+bug in the program itself.
+
+@item
+If you send examples of assembler code output from GNU Fortran,
+please use @samp{-g} when you make them. The debugging information
+includes source line numbers which are essential for correlating the
+output with the input.
+
+@item
+If you wish to mention something in the GNU Fortran source, refer to it by
+context, not by line number.
+
+The line numbers in the development sources don't match those in your
+sources. Your line numbers would convey no convenient information to the
+maintainers.
+
+@item
+Additional information from a debugger might enable someone to find a
+problem on a machine which he does not have available. However, you
+need to think when you collect this information if you want it to have
+any chance of being useful.
+
+@cindex backtrace for bug reports
+For example, many people send just a backtrace, but that is never
+useful by itself. A simple backtrace with arguments conveys little
+about GNU Fortran because the compiler is largely data-driven; the same
+functions are called over and over for different RTL insns, doing
+different things depending on the details of the insn.
+
+Most of the arguments listed in the backtrace are useless because they
+are pointers to RTL list structure. The numeric values of the
+pointers, which the debugger prints in the backtrace, have no
+significance whatever; all that matters is the contents of the objects
+they point to (and most of the contents are other such pointers).
+
+In addition, most compiler passes consist of one or more loops that
+scan the RTL insn sequence. The most vital piece of information about
+such a loop---which insn it has reached---is usually in a local variable,
+not in an argument.
+
+@findex debug_rtx
+What you need to provide in addition to a backtrace are the values of
+the local variables for several stack frames up. When a local
+variable or an argument is an RTX, first print its value and then use
+the GDB command @code{pr} to print the RTL expression that it points
+to. (If GDB doesn't run on your machine, use your debugger to call
+the function @code{debug_rtx} with the RTX as an argument.) In
+general, whenever a variable is a pointer, its value is no use
+without the data it points to.
+@end itemize
+
+Here are some things that are not necessary:
+
+@itemize @bullet
+@item
+A description of the envelope of the bug.
+
+Often people who encounter a bug spend a lot of time investigating
+which changes to the input file will make the bug go away and which
+changes will not affect it.
+
+This is often time consuming and not very useful, because the way we
+will find the bug is by running a single example under the debugger with
+breakpoints, not by pure deduction from a series of examples. You might
+as well save your time for something else.
+
+Of course, if you can find a simpler example to report @emph{instead} of
+the original one, that is a convenience. Errors in the output will be
+easier to spot, running under the debugger will take less time, etc.
+Most GNU Fortran bugs involve just one function, so the most straightforward
+way to simplify an example is to delete all the function definitions
+except the one where the bug occurs. Those earlier in the file may be
+replaced by external declarations if the crucial function depends on
+them. (Exception: inline functions might affect compilation of functions
+defined later in the file.)
+
+However, simplification is not vital; if you don't want to do this,
+report the bug anyway and send the entire test case you used.
+
+@item
+In particular, some people insert conditionals @samp{#ifdef BUG} around
+a statement which, if removed, makes the bug not happen. These are just
+clutter; we won't pay any attention to them anyway. Besides, you should
+send us preprocessor output, and that can't have conditionals.
+
+@item
+A patch for the bug.
+
+A patch for the bug is useful if it is a good one. But don't omit the
+necessary information, such as the test case, on the assumption that a
+patch is all we need. We might see problems with your patch and decide
+to fix the problem another way, or we might not understand it at all.
+
+Sometimes with a program as complicated as GNU Fortran it is very hard to
+construct an example that will make the program follow a certain path
+through the code. If you don't send the example, we won't be able to
+construct one, so we won't be able to verify that the bug is fixed.
+
+And if we can't understand what bug you are trying to fix, or why your
+patch should be an improvement, we won't install it. A test case will
+help us to understand.
+
+@xref{Sending Patches}, for guidelines on how to make it easy for us to
+understand and install your patches.
+
+@item
+A guess about what the bug is or what it depends on.
+
+Such guesses are usually wrong. Even the maintainer can't guess right
+about such things without first using the debugger to find the facts.
+
+@item
+A core dump file.
+
+We have no way of examining a core dump for your type of machine
+unless we have an identical system---and if we do have one,
+we should be able to reproduce the crash ourselves.
+@end itemize
+
+@node Sending Patches
+@section Sending Patches for GNU Fortran
+
+If you would like to write bug fixes or improvements for the GNU Fortran
+compiler, that is very helpful.
+Send suggested fixes to the bug report
+mailing list, @email{fortran@@gnu.ai.mit.edu}.
+
+Please follow these guidelines so we can study your patches efficiently.
+If you don't follow these guidelines, your information might still be
+useful, but using it will take extra work. Maintaining GNU Fortran is a lot
+of work in the best of circumstances, and we can't keep up unless you do
+your best to help.
+
+@itemize @bullet
+@item
+Send an explanation with your changes of what problem they fix or what
+improvement they bring about. For a bug fix, just include a copy of the
+bug report, and explain why the change fixes the bug.
+
+(Referring to a bug report is not as good as including it, because then
+we will have to look it up, and we have probably already deleted it if
+we've already fixed the bug.)
+
+@item
+Always include a proper bug report for the problem you think you have
+fixed. We need to convince ourselves that the change is right before
+installing it. Even if it is right, we might have trouble judging it if
+we don't have a way to reproduce the problem.
+
+@item
+Include all the comments that are appropriate to help people reading the
+source in the future understand why this change was needed.
+
+@item
+Don't mix together changes made for different reasons.
+Send them @emph{individually}.
+
+If you make two changes for separate reasons, then we might not want to
+install them both. We might want to install just one. If you send them
+all jumbled together in a single set of diffs, we have to do extra work
+to disentangle them---to figure out which parts of the change serve
+which purpose. If we don't have time for this, we might have to ignore
+your changes entirely.
+
+If you send each change as soon as you have written it, with its own
+explanation, then the two changes never get tangled up, and we can
+consider each one properly without any extra work to disentangle them.
+
+Ideally, each change you send should be impossible to subdivide into
+parts that we might want to consider separately, because each of its
+parts gets its motivation from the other parts.
+
+@item
+Send each change as soon as that change is finished. Sometimes people
+think they are helping us by accumulating many changes to send them all
+together. As explained above, this is absolutely the worst thing you
+could do.
+
+Since you should send each change separately, you might as well send it
+right away. That gives us the option of installing it immediately if it
+is important.
+
+@item
+Use @samp{diff -c} to make your diffs. Diffs without context are hard
+for us to install reliably. More than that, they make it hard for us to
+study the diffs to decide whether we want to install them. Unidiff
+format is better than contextless diffs, but not as easy to read as
+@samp{-c} format.
+
+If you have GNU @code{diff}, use @samp{diff -cp}, which shows the name of the
+function that each change occurs in.
+(The maintainer of GNU Fortran currently uses @samp{diff -rcp2N}.)
+
+@item
+Write the change log entries for your changes. We get lots of changes,
+and we don't have time to do all the change log writing ourselves.
+
+Read the @file{ChangeLog} file to see what sorts of information to put
+in, and to learn the style that we use. The purpose of the change log
+is to show people where to find what was changed. So you need to be
+specific about what functions you changed; in large functions, it's
+often helpful to indicate where within the function the change was.
+
+On the other hand, once you have shown people where to find the change,
+you need not explain its purpose. Thus, if you add a new function, all
+you need to say about it is that it is new. If you feel that the
+purpose needs explaining, it probably does---but the explanation will be
+much more useful if you put it in comments in the code.
+
+If you would like your name to appear in the header line for who made
+the change, send us the header line.
+
+@item
+When you write the fix, keep in mind that we can't install a change that
+would break other systems.
+
+People often suggest fixing a problem by changing machine-independent
+files such as @file{toplev.c} to do something special that a particular
+system needs. Sometimes it is totally obvious that such changes would
+break GNU Fortran for almost all users. We can't possibly make a change like
+that. At best it might tell us how to write another patch that would
+solve the problem acceptably.
+
+Sometimes people send fixes that @emph{might} be an improvement in
+general---but it is hard to be sure of this. It's hard to install
+such changes because we have to study them very carefully. Of course,
+a good explanation of the reasoning by which you concluded the change
+was correct can help convince us.
+
+The safest changes are changes to the configuration files for a
+particular machine. These are safe because they can't create new bugs
+on other machines.
+
+Please help us keep up with the workload by designing the patch in a
+form that is good to install.
+@end itemize
+
+@node Service
+@chapter How To Get Help with GNU Fortran
+
+If you need help installing, using or changing GNU Fortran, there are two
+ways to find it:
+
+@itemize @bullet
+@item
+Look in the service directory for someone who might help you for a fee.
+The service directory is found in the file named @file{SERVICE} in the
+GNU CC distribution.
+
+@item
+Send a message to @email{fortran@@gnu.ai.mit.edu}.
+@end itemize
+
+@end ifset
+@ifset INTERNALS
+@node Adding Options
+@chapter Adding Options
+@cindex options, adding
+@cindex adding options
+
+To add a new command-line option to @code{g77}, first decide
+what kind of option you wish to add.
+Search the @code{g77} and @code{gcc} documentation for one
+or more options that is most closely like the one you want to add
+(in terms of what kind of effect it has, and so on) to
+help clarify its nature.
+
+@itemize @bullet
+@item
+@emph{Fortran options} are options that apply only
+when compiling Fortran programs.
+They are accepted by @code{g77} and @code{gcc}, but
+they apply only when compiling Fortran programs.
+
+@item
+@emph{Compiler options} are options that apply
+when compiling most any kind of program.
+@end itemize
+
+@emph{Fortran options} are listed in the file
+@file{gcc/f/lang-options.h},
+which is used during the build of @code{gcc} to
+build a list of all options that are accepted by
+at least one language's compiler.
+This list goes into the @samp{lang_options} array
+in @file{gcc/toplev.c}, which uses this array to
+determine whether a particular option should be
+offered to the linked-in front end for processing
+by calling @samp{lang_option_decode}, which, for
+@code{g77}, is in @file{gcc/f/com.c} and just
+calls @samp{ffe_decode_option}.
+
+If the linked-in front end ``rejects'' a
+particular option passed to it, @file{toplev.c}
+just ignores the option, because @emph{some}
+language's compiler is willing to accept it.
+
+This allows commands like @samp{gcc -fno-asm foo.c bar.f}
+to work, even though Fortran compilation does
+not currently support the @samp{-fno-asm} option;
+even though the @code{f771} version of @samp{lang_decode_option}
+rejects @samp{-fno-asm}, @file{toplev.c} doesn't
+produce a diagnostic because some other language (C)
+does accept it.
+
+This also means that commands like
+@samp{g77 -fno-asm foo.f} yield no diagnostics,
+despite the fact that no phase of the command was
+able to recognize and process @samp{-fno-asm}---perhaps
+a warning about this would be helpful if it were
+possible.
+
+Code that processes Fortran options is found in
+@file{gcc/f/top.c}, function @samp{ffe_decode_option}.
+This code needs to check positive and negative forms
+of each option.
+
+The defaults for Fortran options are set in their
+global definitions, also found in @file{gcc/f/top.c}.
+Many of these defaults are actually macros defined
+in @file{gcc/f/target.h}, since they might be
+machine-specific.
+However, since, in practice, GNU compilers
+should behave the same way on all configurations
+(especially when it comes to language constructs),
+the practice of setting defaults in @file{target.h}
+is likely to be deprecated and, ultimately, stopped
+in future versions of @code{g77}.
+
+Accessor macros for Fortran options, used by code
+in the @code{g77} FFE, are defined in @file{gcc/f/top.h}.
+
+@emph{Compiler options} are listed in @file{gcc/toplev.c}
+in the array @samp{f_options}.
+An option not listed in @samp{lang_options} is
+looked up in @samp{f_options} and handled from there.
+
+The defaults for compiler options are set in the
+global definitions for the corresponding variables,
+some of which are in @file{gcc/toplev.c}.
+
+You can set different defaults for @emph{Fortran-oriented}
+or @emph{Fortran-reticent} compiler options by changing
+the way @code{f771} handles the @samp{-fset-g77-defaults}
+option, which is always provided as the first option when
+called by @code{g77} or @code{gcc}.
+
+This code is in @samp{ffe_decode_options} in @file{gcc/f/top.c}.
+Have it change just the variables that you want to default
+to a different setting for Fortran compiles compared to
+compiles of other languages.
+
+The @samp{-fset-g77-defaults} option is passed to @code{f771}
+automatically because of the specification information
+kept in @file{gcc/f/lang-specs.h}.
+This file tells the @code{gcc} command how to recognize,
+in this case, Fortran source files (those to be preprocessed,
+and those that are not), and further, how to invoke the
+appropriate programs (including @code{f771}) to process
+those source files.
+
+It is in @file{gcc/f/lang-specs.h} that @samp{-fset-g77-defaults},
+@samp{-fversion}, and other options are passed, as appropriate,
+even when the user has not explicitly specified them.
+Other ``internal'' options such as @samp{-quiet} also
+are passed via this mechanism.
+
+@node Projects
+@chapter Projects
+@cindex projects
+
+If you want to contribute to @code{g77} by doing research,
+design, specification, documentation, coding, or testing,
+the following information should give you some ideas.
+
+@menu
+* Efficiency:: Make @code{g77} itself compile code faster.
+* Better Optimization:: Teach @code{g77} to generate faster code.
+* Simplify Porting:: Make @code{g77} easier to configure, build,
+ and install.
+* More Extensions:: Features many users won't know to ask for.
+* Machine Model:: @code{g77} should better leverage @code{gcc}.
+* Internals Documentation:: Make maintenance easier.
+* Internals Improvements:: Make internals more robust.
+* Better Diagnostics:: Make using @code{g77} on new code easier.
+@end menu
+
+@node Efficiency
+@section Improve Efficiency
+@cindex efficiency
+
+Don't bother doing any performance analysis until most of the
+following items are taken care of, because there's no question
+they represent serious space/time problems, although some of
+them show up only given certain kinds of (popular) input.
+
+@itemize @bullet
+@item
+Improve @samp{malloc} package and its uses to specify more info about
+memory pools and, where feasible, use obstacks to implement them.
+
+@item
+Skip over uninitialized portions of aggregate areas (arrays,
+@code{COMMON} areas, @code{EQUIVALENCE} areas) so zeros need not be output.
+This would reduce memory usage for large initialized aggregate
+areas, even ones with only one initialized element.
+
+As of version 0.5.18, a portion of this item has already been
+accomplished.
+
+@item
+Prescan the statement (in @file{sta.c}) so that the nature of the statement
+is determined as much as possible by looking entirely at its form,
+and not looking at any context (previous statements, including types
+of symbols).
+This would allow ripping out of the statement-confirmation,
+symbol retraction/confirmation, and diagnostic inhibition
+mechanisms.
+Plus, it would result in much-improved diagnostics.
+For example, @samp{CALL some-intrinsic(@dots{})}, where the intrinsic
+is not a subroutine intrinsic, would result actual error instead of the
+unimplemented-statement catch-all.
+
+@item
+Throughout @code{g77}, don't pass line/column pairs where
+a simple @samp{ffewhere} type, which points to the error as much as is
+desired by the configuration, will do, and don't pass @samp{ffelexToken} types
+where a simple @samp{ffewhere} type will do.
+Then, allow new default
+configuration of @samp{ffewhere} such that the source line text is not
+preserved, and leave it to things like Emacs' next-error function
+to point to them (now that @samp{next-error} supports column,
+or, perhaps, character-offset, numbers).
+The change in calling sequences should improve performance somewhat,
+as should not having to save source lines.
+(Whether this whole
+item will improve performance is questionable, but it should
+improve maintainability.)
+
+@item
+Handle @samp{DATA (A(I),I=1,1000000)/1000000*2/} more efficiently, especially
+as regards the assembly output.
+Some of this might require improving
+the back end, but lots of improvement in space/time required in @code{g77}
+itself can be fairly easily obtained without touching the back end.
+Maybe type-conversion, where necessary, can be speeded up as well in
+cases like the one shown (converting the @samp{2} into @samp{2.}).
+
+@item
+If analysis shows it to be worthwhile, optimize @file{lex.c}.
+
+@item
+Consider redesigning @file{lex.c} to not need any feedback
+during tokenization, by keeping track of enough parse state on its
+own.
+@end itemize
+
+@node Better Optimization
+@section Better Optimization
+@cindex optimization, better
+@cindex code generation, improving
+
+Much of this work should be put off until after @code{g77} has
+all the features necessary for its widespread acceptance as a
+useful F77 compiler.
+However, perhaps this work can be done in parallel during
+the feature-adding work.
+
+@itemize @bullet
+@item
+Do the equivalent of the trick of putting @samp{extern inline} in front
+of every function definition in @code{libf2c} and #include'ing the resulting
+file in @code{f2c}+@code{gcc}---that is, inline all run-time-library functions
+that are at all worth inlining.
+(Some of this has already been done, such as for integral exponentiation.)
+
+@item
+When doing @samp{CHAR_VAR = CHAR_FUNC(@dots{})},
+and it's clear that types line up
+and @samp{CHAR_VAR} is addressable or not a @samp{VAR_DECL},
+make @samp{CHAR_VAR}, not a
+temporary, be the receiver for @samp{CHAR_FUNC}.
+(This is now done for @code{COMPLEX} variables.)
+
+@item
+Design and implement Fortran-specific optimizations that don't
+really belong in the back end, or where the front end needs to
+give the back end more info than it currently does.
+
+@item
+Design and implement a new run-time library interface, with the
+code going into @code{libgcc} so no special linking is required to
+link Fortran programs using standard language features.
+This library
+would speed up lots of things, from I/O (using precompiled formats,
+doing just one, or, at most, very few, calls for arrays or array sections,
+and so on) to general computing (array/section implementations of
+various intrinsics, implementation of commonly performed loops that
+aren't likely to be optimally compiled otherwise, etc.).
+
+Among the important things the library would do are:
+
+@itemize @bullet
+@item
+Be a one-stop-shop-type
+library, hence shareable and usable by all, in that what are now
+library-build-time options in @code{libf2c} would be moved at least to the
+@code{g77} compile phase, if not to finer grains (such as choosing how
+list-directed I/O formatting is done by default at @code{OPEN} time, for
+preconnected units via options or even statements in the main program
+unit, maybe even on a per-I/O basis with appropriate pragma-like
+devices).
+@end itemize
+
+@item
+Probably requiring the new library design, change interface to
+normally have @code{COMPLEX} functions return their values in the way
+@code{gcc} would if they were declared @code{__complex__ float},
+rather than using
+the mechanism currently used by @code{CHARACTER} functions (whereby the
+functions are compiled as returning void and their first arg is
+a pointer to where to store the result).
+(Don't append underscores to
+external names for @code{COMPLEX} functions in some cases once @code{g77} uses
+@code{gcc} rather than @code{f2c} calling conventions.)
+
+@item
+Do something useful with @samp{doiter} references where possible.
+For example, @samp{CALL FOO(I)} cannot modify @samp{I} if within
+a @code{DO} loop that uses @samp{I} as the
+iteration variable, and the back end might find that info useful
+in determining whether it needs to read @samp{I} back into a register after
+the call.
+(It normally has to do that, unless it knows @samp{FOO} never
+modifies its passed-by-reference argument, which is rarely the case
+for Fortran-77 code.)
+@end itemize
+
+@node Simplify Porting
+@section Simplify Porting
+@cindex porting, simplify
+@cindex simplify porting
+
+Making @code{g77} easier to configure, port, build, and install, either
+as a single-system compiler or as a cross-compiler, would be
+very useful.
+
+@itemize @bullet
+@item
+A new library (replacing @code{libf2c}) should improve portability as well as
+produce more optimal code.
+Further, @code{g77} and the new library should
+conspire to simplify naming of externals, such as by removing unnecessarily
+added underscores, and to reduce/eliminate the possibility of naming
+conflicts, while making debugger more straightforward.
+
+Also, it should
+make multi-language applications more feasible, such as by providing
+Fortran intrinsics that get Fortran unit numbers given C @code{FILE *}
+descriptors.
+
+@item
+Possibly related to a new library, @code{g77} should produce the equivalent
+of a @code{gcc} @samp{main(argc, argv)} function when it compiles a
+main program unit, instead of compiling something that must be
+called by a library
+implementation of @code{main()}.
+
+This would do many useful things such as
+provide more flexibility in terms of setting up exception handling,
+not requiring programmers to start their debugging sessions with
+@kbd{breakpoint MAIN__} followed by @kbd{run}, and so on.
+
+@item
+The GBE needs to understand the difference between alignment
+requirements and desires.
+For example, on Intel x86 machines, @code{g77} currently imposes
+overly strict alignment requirements, due to the back end, but it
+would be useful for Fortran and C programmers to be able to override
+these @emph{recommendations} as long as they don't violate the actual
+processor @emph{requirements}.
+@end itemize
+
+@node More Extensions
+@section More Extensions
+@cindex extensions, more
+
+These extensions are not the sort of things users ask for ``by name'',
+but they might improve the usability of @code{g77}, and Fortran in
+general, in the long run.
+Some of these items really pertain to improving @code{g77} internals
+so that some popular extensions can be more easily supported.
+
+@itemize @bullet
+@item
+Look through all the documentation on the GNU Fortran language,
+dialects, compiler, missing features, bugs, and so on.
+Many mentions of incomplete or missing features are
+sprinkled throughout.
+It is not worth repeating them here.
+
+@item
+@cindex concatenation
+@cindex CHARACTER*(*)
+Support arbitrary operands for concatenation, even in contexts where
+run-time allocation is required.
+
+@item
+Consider adding a @code{NUMERIC} type to designate typeless numeric constants,
+named and unnamed.
+The idea is to provide a forward-looking, effective
+replacement for things like the old-style @code{PARAMETER} statement
+when people
+really need typelessness in a maintainable, portable, clearly documented
+way.
+Maybe @code{TYPELESS} would include @code{CHARACTER}, @code{POINTER},
+and whatever else might come along.
+(This is not really a call for polymorphism per se, just
+an ability to express limited, syntactic polymorphism.)
+
+@item
+Support @samp{OPEN(@dots{},KEY=(@dots{}),@dots{})}.
+
+@item
+Support arbitrary file unit numbers, instead of limiting them
+to 0 through @samp{MXUNIT-1}.
+(This is a @code{libf2c} issue.)
+
+@item
+@samp{OPEN(NOSPANBLOCKS,@dots{})} is treated as
+@samp{OPEN(UNIT=NOSPANBLOCKS,@dots{})}, so a
+later @code{UNIT=} in the first example is invalid.
+Make sure this is what users of this feature would expect.
+
+@item
+Currently @code{g77} disallows @samp{READ(1'10)} since
+it is an obnoxious syntax, but
+supporting it might be pretty easy if needed.
+More details are needed, such
+as whether general expressions separated by an apostrophe are supported,
+or maybe the record number can be a general expression, and so on.
+
+@item
+Support @code{STRUCTURE}, @code{UNION}, @code{MAP}, and @code{RECORD}
+fully.
+Currently there is no support at all
+for @code{%FILL} in @code{STRUCTURE} and related syntax,
+whereas the rest of the
+stuff has at least some parsing support.
+This requires either major
+changes to @code{libf2c} or its replacement.
+
+@item
+F90 and @code{g77} probably disagree about label scoping relative to
+@code{INTERFACE} and @code{END INTERFACE}, and their contained
+procedure interface bodies (blocks?).
+
+@item
+@code{ENTRY} doesn't support F90 @code{RESULT()} yet,
+since that was added after S8.112.
+
+@item
+Empty-statement handling (10 ;;CONTINUE;;) probably isn't consistent
+with the final form of the standard (it was vague at S8.112).
+
+@item
+It seems to be an ``open'' question whether a file, immediately after being
+@code{OPEN}ed,is positioned at the beginning, the end, or wherever---it
+might be nice to offer an option of opening to ``undefined'' status, requiring
+an explicit absolute-positioning operation to be performed before any
+other (besides @code{CLOSE}) to assist in making applications port to systems
+(some IBM?) that @code{OPEN} to the end of a file or some such thing.
+@end itemize
+
+@node Machine Model
+@section Machine Model
+
+This items pertain to generalizing @code{g77}'s view of
+the machine model to more fully accept whatever the GBE
+provides it via its configuration.
+
+@itemize @bullet
+@item
+Switch to using @samp{REAL_VALUE_TYPE} to represent floating-point constants
+exclusively so the target float format need not be required.
+This
+means changing the way @code{g77} handles initialization of aggregate areas
+having more than one type, such as @code{REAL} and @code{INTEGER},
+because currently
+it initializes them as if they were arrays of @code{char} and uses the
+bit patterns of the constants of the various types in them to determine
+what to stuff in elements of the arrays.
+
+@item
+Rely more and more on back-end info and capabilities, especially in the
+area of constants (where having the @code{g77} front-end's IL just store
+the appropriate tree nodes containing constants might be best).
+
+@item
+Suite of C and Fortran programs that a user/administrator can run on a
+machine to help determine the configuration for @code{g77} before building
+and help determine if the compiler works (especially with whatever
+libraries are installed) after building.
+@end itemize
+
+@node Internals Documentation
+@section Internals Documentation
+
+Better info on how @code{g77} works and how to port it is needed.
+Much of this should be done only after the redesign planned for
+0.6 is complete.
+
+@node Internals Improvements
+@section Internals Improvements
+
+Some more items that would make @code{g77} more reliable
+and easier to maintain:
+
+@itemize @bullet
+@item
+Generally make expression handling focus
+more on critical syntax stuff, leaving semantics to callers.
+For example,
+anything a caller can check, semantically, let it do so, rather
+than having @file{expr.c} do it.
+(Exceptions might include things like
+diagnosing @samp{FOO(I--K:)=BAR} where @samp{FOO} is a @code{PARAMETER}---if
+it seems
+important to preserve the left-to-right-in-source order of production
+of diagnostics.)
+
+@item
+Come up with better naming conventions for @samp{-D} to establish requirements
+to achieve desired implementation dialect via @file{proj.h}.
+
+@item
+Clean up used tokens and @samp{ffewhere}s in @samp{ffeglobal_terminate_1}.
+
+@item
+Replace @file{sta.c} @samp{outpooldisp} mechanism with @samp{malloc_pool_use}.
+
+@item
+Check for @samp{opANY} in more places in @file{com.c}, @file{std.c},
+and @file{ste.c}, and get rid of the @samp{opCONVERT(opANY)} kludge
+(after determining if there is indeed no real need for it).
+
+@item
+Utility to read and check @file{bad.def} messages and their references in the
+code, to make sure calls are consistent with message templates.
+
+@item
+Search and fix @samp{&ffe@dots{}} and similar so that
+@samp{ffe@dots{}ptr@dots{}} macros are
+available instead (a good argument for wishing this could have written all
+this stuff in C++, perhaps).
+On the other hand, it's questionable whether this sort of
+improvement is really necessary, given the availability of
+tools such as Emacs and Perl, which make finding any
+address-taking of structure members easy enough?
+
+@item
+Some modules truly export the member names of their structures (and the
+structures themselves), maybe fix this, and fix other modules that just
+appear to as well (by appending @samp{_}, though it'd be ugly and probably
+not worth the time).
+
+@item
+Implement C macros @samp{RETURNS(value)} and @samp{SETS(something,value)}
+in @file{proj.h}
+and use them throughout @code{g77} source code (especially in the definitions
+of access macros in @samp{.h} files) so they can be tailored
+to catch code writing into a @samp{RETURNS()} or reading from a @samp{SETS()}.
+
+@item
+Decorate throughout with @code{const} and other such stuff.
+
+@item
+All F90 notational derivations in the source code are still based
+on the S8.112 version of the draft standard.
+Probably should update
+to the official standard, or put documentation of the rules as used
+in the code@dots{}uh@dots{}in the code.
+
+@item
+Some @samp{ffebld_new} calls (those outside of @file{ffeexpr.c} or
+inside but invoked via paths not involving @samp{ffeexpr_lhs} or
+@samp{ffeexpr_rhs}) might be creating things
+in improper pools, leading to such things staying around too long or
+(doubtful, but possible and dangerous) not long enough.
+
+@item
+Some @samp{ffebld_list_new} (or whatever) calls might not be matched by
+@samp{ffebld_list_bottom} (or whatever) calls, which might someday matter.
+(It definitely is not a problem just yet.)
+
+@item
+Probably not doing clean things when we fail to @code{EQUIVALENCE} something
+due to alignment/mismatch or other problems---they end up without
+@samp{ffestorag} objects, so maybe the backend (and other parts of the front
+end) can notice that and handle like an @samp{opANY} (do what it wants, just
+don't complain or crash).
+Most of this seems to have been addressed
+by now, but a code review wouldn't hurt.
+@end itemize
+
+@node Better Diagnostics
+@section Better Diagnostics
+
+These are things users might not ask about, or that need to
+be looked into, before worrying about.
+Also here are items that involve reducing unnecessary diagnostic
+clutter.
+
+@itemize @bullet
+@item
+When @code{FUNCTION} and @code{ENTRY} point types disagree (@code{CHARACTER}
+lengths, type classes, and so on),
+@samp{ANY}-ize the offending @code{ENTRY} point and any @emph{new} dummies
+it specifies.
+
+@item
+Speed up and improve error handling for data when repeat-count is
+specified.
+For example, don't output 20 unnecessary messages after the
+first necessary one for:
+
+@smallexample
+INTEGER X(20)
+CONTINUE
+DATA (X(I), J= 1, 20) /20*5/
+END
+@end smallexample
+
+@noindent
+(The @code{CONTINUE} statement ensures the @code{DATA} statement
+is processed in the context of executable, not specification,
+statements.)
+@end itemize
+@end ifset
+
+@ifset USING
+@node Diagnostics
+@chapter Diagnostics
+@cindex diagnostics
+
+Some diagnostics produced by @code{g77} require sufficient explanation
+that the explanations are given below, and the diagnostics themselves
+identify the appropriate explanation.
+
+Identification uses the GNU Info format---specifically, the @code{info}
+command that displays the explanation is given in within square
+brackets in the diagnostic.
+For example:
+
+@smallexample
+foo.f:5: Invalid statement [info -f g77 M FOOEY]
+@end smallexample
+
+More details about the above diagnostic is found in the @code{g77} Info
+documentation, menu item @samp{M}, submenu item @samp{FOOEY},
+which is displayed by typing the UNIX command
+@samp{info -f g77 M FOOEY}.
+
+Other Info readers, such as EMACS, may be just as easily used to display
+the pertinent node.
+In the above example, @samp{g77} is the Info document name,
+@samp{M} is the top-level menu item to select,
+and, in that node (named @samp{Diagnostics}, the name of
+this chapter, which is the very text you're reading now),
+@samp{FOOEY} is the menu item to select.
+
+@iftex
+In this printed version of the @code{g77} manual, the above example
+points to a section, below, entitled @samp{FOOEY}---though, of course,
+as the above is just a sample, no such section exists.
+@end iftex
+
+@menu
+* CMPAMBIG:: Ambiguous use of intrinsic.
+* EXPIMP:: Intrinsic used explicitly and implicitly.
+* INTGLOB:: Intrinsic also used as name of global.
+* LEX:: Various lexer messages
+* GLOBALS:: Disagreements about globals.
+@end menu
+
+@node CMPAMBIG
+@section @code{CMPAMBIG}
+
+@noindent
+@smallexample
+Ambiguous use of intrinsic @var{intrinsic} @dots{}
+@end smallexample
+
+The type of the argument to the invocation of the @var{intrinsic}
+intrinsic is a @code{COMPLEX} type other than @code{COMPLEX(KIND=1)}.
+Typically, it is @code{COMPLEX(KIND=2)}, also known as
+@code{DOUBLE COMPLEX}.
+
+The interpretation of this invocation depends on the particular
+dialect of Fortran for which the code was written.
+Some dialects convert the real part of the argument to
+@code{REAL(KIND=1)}, thus losing precision; other dialects,
+and Fortran 90, do no such conversion.
+
+So, GNU Fortran rejects such invocations except under certain
+circumstances, to avoid making an incorrect assumption that results
+in generating the wrong code.
+
+To determine the dialect of the program unit, perhaps even whether
+that particular invocation is properly coded, determine how the
+result of the intrinsic is used.
+
+The result of @var{intrinsic} is expected (by the original programmer)
+to be @code{REAL(KIND=1)} (the non-Fortran-90 interpretation) if:
+
+@itemize @bullet
+@item
+It is passed as an argument to a procedure that explicitly or
+implicitly declares that argument @code{REAL(KIND=1)}.
+
+For example,
+a procedure with no @code{DOUBLE PRECISION} or @code{IMPLICIT DOUBLE PRECISION}
+statement specifying the dummy argument corresponding to an
+actual argument of @samp{REAL(Z)}, where @samp{Z} is declared
+@code{DOUBLE COMPLEX}, strongly suggests that the programmer
+expected @samp{REAL(Z)} to return @code{REAL(KIND=1)} instead
+of @code{REAL(KIND=2)}.
+
+@item
+It is used in a context that would otherwise not include
+any @code{REAL(KIND=2)} but where treating the @var{intrinsic}
+invocation as @code{REAL(KIND=2)} would result in unnecessary
+promotions and (typically) more expensive operations on the
+wider type.
+
+For example:
+
+@smallexample
+DOUBLE COMPLEX Z
+@dots{}
+R(1) = T * REAL(Z)
+@end smallexample
+
+The above example suggests the programmer expected the real part
+of @samp{Z} to be converted to @code{REAL(KIND=1)} before being
+multiplied by @samp{T} (presumed, along with @samp{R} above, to
+be type @code{REAL(KIND=1)}).
+
+Otherwise, the conversion would have to be delayed until after
+the multiplication, requiring not only an extra conversion
+(of @samp{T} to @code{REAL(KIND=2)}), but a (typically) more
+expensive multiplication (a double-precision multiplication instead
+of a single-precision one).
+@end itemize
+
+The result of @var{intrinsic} is expected (by the original programmer)
+to be @code{REAL(KIND=2)} (the Fortran 90 interpretation) if:
+
+@itemize @bullet
+@item
+It is passed as an argument to a procedure that explicitly or
+implicitly declares that argument @code{REAL(KIND=2)}.
+
+For example, a procedure specifying a @code{DOUBLE PRECISION}
+dummy argument corresponding to an
+actual argument of @samp{REAL(Z)}, where @samp{Z} is declared
+@code{DOUBLE COMPLEX}, strongly suggests that the programmer
+expected @samp{REAL(Z)} to return @code{REAL(KIND=2)} instead
+of @code{REAL(KIND=1)}.
+
+@item
+It is used in an expression context that includes
+other @code{REAL(KIND=2)} operands,
+or is assigned to a @code{REAL(KIND=2)} variable or array element.
+
+For example:
+
+@smallexample
+DOUBLE COMPLEX Z
+DOUBLE PRECISION R, T
+@dots{}
+R(1) = T * REAL(Z)
+@end smallexample
+
+The above example suggests the programmer expected the real part
+of @samp{Z} to @emph{not} be converted to @code{REAL(KIND=1)}
+by the @code{REAL()} intrinsic.
+
+Otherwise, the conversion would have to be immediately followed
+by a conversion back to @code{REAL(KIND=2)}, losing
+the original, full precision of the real part of @code{Z},
+before being multiplied by @samp{T}.
+@end itemize
+
+Once you have determined whether a particular invocation of @var{intrinsic}
+expects the Fortran 90 interpretation, you can:
+
+@itemize @bullet
+@item
+Change it to @samp{DBLE(@var{expr})} (if @var{intrinsic} is
+@samp{REAL}) or @samp{DIMAG(@var{expr})} (if @var{intrinsic}
+is @samp{AIMAG})
+if it expected the Fortran 90 interpretation.
+
+This assumes @var{expr} is @code{COMPLEX(KIND=2)}---if it is
+some other type, such as @code{COMPLEX*32}, you should use the
+appropriate intrinsic, such as the one to convert to @code{REAL*16}
+(perhaps @code{DBLEQ()} in place of @code{DBLE()}, and
+@code{QIMAG()} in place of @code{DIMAG()}).
+
+@item
+Change it to @samp{REAL(@var{intrinsic}(@var{expr}))},
+otherwise.
+This converts to @code{REAL(KIND=1)} in all working
+Fortran compilers.
+@end itemize
+
+If you don't want to change the code, and you are certain that all
+ambiguous invocations of @var{intrinsic} in the source file have
+the same expectation regarding interpretation, you can:
+
+@itemize @bullet
+@item
+Compile with the @code{g77} option @samp{-ff90}, to enable the
+Fortran 90 interpretation.
+
+@item
+Compile with the @code{g77} options @samp{-fno-f90 -fugly-complex},
+to enable the non-Fortran-90 interpretations.
+@end itemize
+
+@xref{REAL() and AIMAG() of Complex}, for more information on this
+issue.
+
+Note: If the above suggestions don't produce enough evidence
+as to whether a particular program expects the Fortran 90
+interpretation of this ambiguous invocation of @var{intrinsic},
+there is one more thing you can try.
+
+If you have access to most or all the compilers used on the
+program to create successfully tested and deployed executables,
+read the documentation for, and @emph{also} test out, each compiler
+to determine how it treats the @var{intrinsic} intrinsic in
+this case.
+(If all the compilers don't agree on an interpretation, there
+might be lurking bugs in the deployed versions of the program.)
+
+The following sample program might help:
+
+@cindex JCB003 program
+@smallexample
+ PROGRAM JCB003
+C
+C Written by James Craig Burley 1997-02-23.
+C Contact via Internet email: burley@@gnu.ai.mit.edu
+C
+C Determine how compilers handle non-standard REAL
+C and AIMAG on DOUBLE COMPLEX operands.
+C
+ DOUBLE COMPLEX Z
+ REAL R
+ Z = (3.3D0, 4.4D0)
+ R = Z
+ CALL DUMDUM(Z, R)
+ R = REAL(Z) - R
+ IF (R .NE. 0.) PRINT *, 'REAL() is Fortran 90'
+ IF (R .EQ. 0.) PRINT *, 'REAL() is not Fortran 90'
+ R = 4.4D0
+ CALL DUMDUM(Z, R)
+ R = AIMAG(Z) - R
+ IF (R .NE. 0.) PRINT *, 'AIMAG() is Fortran 90'
+ IF (R .EQ. 0.) PRINT *, 'AIMAG() is not Fortran 90'
+ END
+C
+C Just to make sure compiler doesn't use naive flow
+C analysis to optimize away careful work above,
+C which might invalidate results....
+C
+ SUBROUTINE DUMDUM(Z, R)
+ DOUBLE COMPLEX Z
+ REAL R
+ END
+@end smallexample
+
+If the above program prints contradictory results on a
+particular compiler, run away!
+
+@node EXPIMP
+@section @code{EXPIMP}
+
+@noindent
+@smallexample
+Intrinsic @var{intrinsic} referenced @dots{}
+@end smallexample
+
+The @var{intrinsic} is explicitly declared in one program
+unit in the source file and implicitly used as an intrinsic
+in another program unit in the same source file.
+
+This diagnostic is designed to catch cases where a program
+might depend on using the name @var{intrinsic} as an intrinsic
+in one program unit and as a global name (such as the name
+of a subroutine or function) in another, but @code{g77} recognizes
+the name as an intrinsic in both cases.
+
+After verifying that the program unit making implicit use
+of the intrinsic is indeed written expecting the intrinsic,
+add an @samp{INTRINSIC @var{intrinsic}} statement to that
+program unit to prevent this warning.
+
+This and related warnings are disabled by using
+the @samp{-Wno-globals} option when compiling.
+
+Note that this warning is not issued for standard intrinsics.
+Standard intrinsics include those described in the FORTRAN 77
+standard and, if @samp{-ff90} is specified, those described
+in the Fortran 90 standard.
+Such intrinsics are not as likely to be confused with user
+procedures as intrinsics provided as extensions to the
+standard by @code{g77}.
+
+@node INTGLOB
+@section @code{INTGLOB}
+
+@noindent
+@smallexample
+Same name `@var{intrinsic}' given @dots{}
+@end smallexample
+
+The name @var{intrinsic} is used for a global entity (a common
+block or a program unit) in one program unit and implicitly
+used as an intrinsic in another program unit.
+
+This diagnostic is designed to catch cases where a program
+intends to use a name entirely as a global name, but @code{g77}
+recognizes the name as an intrinsic in the program unit that
+references the name, a situation that would likely produce
+incorrect code.
+
+For example:
+
+@smallexample
+INTEGER FUNCTION TIME()
+@dots{}
+END
+@dots{}
+PROGRAM SAMP
+INTEGER TIME
+PRINT *, 'Time is ', TIME()
+END
+@end smallexample
+
+The above example defines a program unit named @samp{TIME}, but
+the reference to @samp{TIME} in the main program unit @samp{SAMP}
+is normally treated by @code{g77} as a reference to the intrinsic
+@code{TIME()} (unless a command-line option that prevents such
+treatment has been specified).
+
+As a result, the program @samp{SAMP} will @emph{not}
+invoke the @samp{TIME} function in the same source file.
+
+Since @code{g77} recognizes @code{libU77} procedures as
+intrinsics, and since some existing code uses the same names
+for its own procedures as used by some @code{libU77}
+procedures, this situation is expected to arise often enough
+to make this sort of warning worth issuing.
+
+After verifying that the program unit making implicit use
+of the intrinsic is indeed written expecting the intrinsic,
+add an @samp{INTRINSIC @var{intrinsic}} statement to that
+program unit to prevent this warning.
+
+Or, if you believe the program unit is designed to invoke the
+program-defined procedure instead of the intrinsic (as
+recognized by @code{g77}), add an @samp{EXTERNAL @var{intrinsic}}
+statement to the program unit that references the name to
+prevent this warning.
+
+This and related warnings are disabled by using
+the @samp{-Wno-globals} option when compiling.
+
+Note that this warning is not issued for standard intrinsics.
+Standard intrinsics include those described in the FORTRAN 77
+standard and, if @samp{-ff90} is specified, those described
+in the Fortran 90 standard.
+Such intrinsics are not as likely to be confused with user
+procedures as intrinsics provided as extensions to the
+standard by @code{g77}.
+
+@node LEX
+@section @code{LEX}
+
+@noindent
+@smallexample
+Unrecognized character @dots{}
+Invalid first character @dots{}
+Line too long @dots{}
+Non-numeric character @dots{}
+Continuation indicator @dots{}
+Label at @dots{} invalid with continuation line indicator @dots{}
+Character constant @dots{}
+Continuation line @dots{}
+Statement at @dots{} begins with invalid token
+@end smallexample
+
+Although the diagnostics identify specific problems, they can
+be produced when general problems such as the following occur:
+
+@itemize @bullet
+@item
+The source file contains something other than Fortran code.
+
+If the code in the file does not look like many of the examples
+elsewhere in this document, it might not be Fortran code.
+(Note that Fortran code often is written in lower case letters,
+while the examples in this document use upper case letters,
+for stylistic reasons.)
+
+For example, if the file contains lots of strange-looking
+characters, it might be APL source code; if it contains lots
+of parentheses, it might be Lisp source code; if it
+contains lots of bugs, it might be C++ source code.
+
+@item
+The source file contains free-form Fortran code, but @samp{-ffree-form}
+was not specified on the command line to compile it.
+
+Free form is a newer form for Fortran code.
+The older, classic form is called fixed form.
+
+Fixed-form code is visually fairly distinctive, because
+numerical labels and comments are all that appear in
+the first five columns of a line, the sixth column is
+reserved to denote continuation lines,
+and actual statements start at or beyond column 7.
+Spaces generally are not significant, so if you
+see statements such as @samp{REALX,Y} and @samp{DO10I=1,100},
+you are looking at fixed-form code.
+Comment lines are indicated by the letter @samp{C} or the symbol
+@samp{*} in column 1.
+(Some code uses @samp{!} or @samp{/*} to begin in-line comments,
+which many compilers support.)
+
+Free-form code is distinguished from fixed-form source
+primarily by the fact that statements may start anywhere.
+(If lots of statements start in columns 1 through 6,
+that's a strong indicator of free-form source.)
+Consecutive keywords must be separated by spaces, so
+@samp{REALX,Y} is not valid, while @samp{REAL X,Y} is.
+There are no comment lines per se, but @samp{!} starts a
+comment anywhere in a line (other than within a character or
+hollerith constant).
+
+@xref{Source Form}, for more information.
+
+@item
+The source file is in fixed form and has been edited without
+sensitivity to the column requirements.
+
+Statements in fixed-form code must be entirely contained within
+columns 7 through 72 on a given line.
+Starting them ``early'' is more likely to result in diagnostics
+than finishing them ``late'', though both kinds of errors are
+often caught at compile time.
+
+For example, if the following code fragment is edited by following
+the commented instructions literally, the result, shown afterward,
+would produce a diagnostic when compiled:
+
+@smallexample
+C On XYZZY systems, remove "C" on next line:
+C CALL XYZZY_RESET
+@end smallexample
+
+The result of editing the above line might be:
+
+@smallexample
+C On XYZZY systems, remove "C" on next line:
+ CALL XYZZY_RESET
+@end smallexample
+
+However, that leaves the first @samp{C} in the @samp{CALL}
+statement in column 6, making it a comment line, which is
+not really what the author intended, and which is likely
+to result in one of the above-listed diagnostics.
+
+@emph{Replacing} the @samp{C} in column 1 with a space
+is the proper change to make, to ensure the @samp{CALL}
+keyword starts in or after column 7.
+
+Another common mistake like this is to forget that fixed-form
+source lines are significant through only column 72, and that,
+normally, any text beyond column 72 is ignored or is diagnosed
+at compile time.
+
+@xref{Source Form}, for more information.
+
+@item
+The source file requires preprocessing, and the preprocessing
+is not being specified at compile time.
+
+A source file containing lines beginning with @code{#define},
+@code{#include}, @code{#if}, and so on is likely one that
+requires preprocessing.
+
+If the file's suffix is @samp{.f} or @samp{.for}, the file
+will normally be compiled @emph{without} preprocessing by @code{g77}.
+
+Change the file's suffix from @samp{.f} to @samp{.F} (or, on
+systems with case-insensitive file names, to @samp{.fpp}) or
+from @samp{.for} to @samp{.fpp}.
+@code{g77} compiles files with such names @emph{with}
+preprocessing.
+
+Or, learn how to use @code{gcc}'s @samp{-x} option to specify
+the language @samp{f77-cpp-input} for Fortran files that
+require preprocessing.
+@xref{Overall Options,,gcc,Using and Porting GNU CC}.
+
+@item
+The source file is preprocessed, and the results of preprocessing
+result in syntactic errors that are not necessarily obvious to
+someone examining the source file itself.
+
+Examples of errors resulting from preprocessor macro expansion
+include exceeding the line-length limit, improperly starting,
+terminating, or incorporating the apostrophe or double-quote in
+a character constant, improperly forming a hollerith constant,
+and so on.
+
+@xref{Overall Options,,Options Controlling the Kind of Output},
+for suggestions about how to use, and not use, preprocessing
+for Fortran code.
+@end itemize
+
+@node GLOBALS
+@section @code{GLOBALS}
+
+@noindent
+@smallexample
+Global name @var{name} defined at @dots{} already defined@dots{}
+Global name @var{name} at @dots{} has different type@dots{}
+Too many arguments passed to @var{name} at @dots{}
+Too few arguments passed to @var{name} at @dots{}
+Argument #@var{n} of @var{name} is @dots{}
+@end smallexample
+
+These messages all identify disagreements about the
+global procedure named @var{name} among different program
+units (usually including @var{name} itself).
+
+These disagreements, if not diagnosed, could result in a
+compiler crash if the compiler attempted to inline a reference
+to @var{name} within a calling program unit that disagreed
+with the @var{name} program unit regarding whether the
+procedure is a subroutine or function, the type of the
+return value of the procedure (if it is a function), the
+number of arguments the procedure accepts, or the type
+of each argument.
+
+Such disagreements @emph{should} be fixed in the Fortran
+code itself.
+However, if that is not immediately practical, and the code
+has been working for some time, it is possible it will work
+when compiled by @code{g77} with the @samp{-fno-globals} option.
+
+The @samp{-fno-globals} option disables these diagnostics, and
+also disables all inlining of references to global procedures
+to avoid compiler crashes.
+The diagnostics are actually produced, but as warnings, unless
+the @samp{-Wno-globals} option also is specified.
+
+After using @samp{-fno-globals} to work around these problems,
+it is wise to stop using that option and address them by fixing
+the Fortran code, because such problems, while they might not
+actually result in bugs on some systems, indicate that the code
+is not as portable as it could be.
+In particular, the code might appear to work on a particular
+system, but have bugs that affect the reliability of the data
+without exhibiting any other outward manifestations of the bugs.
+
+@end ifset
+
+@node Index
+@unnumbered Index
+
+@printindex cp
+@summarycontents
+@contents
+@bye
diff --git a/gcc/f/gbe/2.7.2.2.diff b/gcc/f/gbe/2.7.2.2.diff
new file mode 100644
index 00000000000..e99ba671741
--- /dev/null
+++ b/gcc/f/gbe/2.7.2.2.diff
@@ -0,0 +1,11296 @@
+IMPORTANT: After applying this patch, you must rebuild the
+Info documentation derived from the Texinfo files in the
+gcc distribution, as this patch does not include patches
+to any derived files (due to differences in the way gcc
+version 2.7.2.2 is obtained by users). Use the following
+command sequence after applying this patch:
+
+ cd gcc-2.7.2.2; make -f Makefile.in gcc.info
+
+If that fails due to `makeinfo' not being installed, obtain
+texinfo-3.11.tar.gz from a GNU distribution site, unpack,
+build, and install it, and try the above command sequence
+again.
+
+
+diff -rcp2N gcc-2.7.2.2/ChangeLog g77-new/ChangeLog
+*** gcc-2.7.2.2/ChangeLog Thu Feb 20 19:24:10 1997
+--- g77-new/ChangeLog Mon Aug 11 06:48:02 1997
+***************
+*** 1,2 ****
+--- 1,244 ----
++ Sun Aug 10 18:14:24 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ Integrate C front end part of patch for better alias
++ handling from John Carr <jfc@mit.edu>:
++ * c-decl.c (grokdeclarator): Check for RID_RESTRICT
++ flag; diagnose certain misuses; set DECL_RESTRICT as
++ appropriate.
++ * c-lex.c (init_lex): Set up RID_RESTRICT pointer.
++ Unset `restrict' as reserved word.
++ * c-lex.h: Replace RID_NOALIAS with RID_RESTRICT.
++ * c-parse.gperf: Add `restrict' and `__restrict'
++ keywords.
++ * tree.h: Add DECL_RESTRICT flag.
++
++ Sun Aug 10 14:50:30 1997 Jim Wilson <wilson@cygnus.com>
++
++ * sdbout.c (plain_type_1, case ARRAY_TYPE): Verify that TYPE_DOMAIN
++ has integer TYPE_{MAX,MIN}_VALUE before using them.
++
++ Mon Jul 28 15:35:38 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * combine.c (num_sign_bit_copies): Speed up the 961126-1.c
++ case of repeated (neg (neg (neg ...))) so c-torture runs
++ in less time.
++
++ * reload.c (find_reloads_toplev, find_reloads_address):
++ These now return whether replacement by a constant, so
++ caller can know to do other replacements. Currently if
++ caller doesn't want that info and such replacement would
++ happen, we crash so as to investigate the problem and
++ learn more about it. All callers updated.
++ (find_reloads): If pseudo replaced by constant, always
++ update duplicates of it.
++
++ Mon Jul 21 00:00:24 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * fold-const.c (size_binop): Make sure overflows
++ are flagged properly, so as to avoid silently generating
++ bad code for, e.g., a too-large array.
++
++ Sun Jul 13 22:23:14 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * stmt.c (expand_expr_stmt): Must generate code for
++ statements within an expression (gcc's `({ ... )}')
++ even if -fsyntax-only.
++
++ Mon Jun 30 17:23:07 1997 Michael Meissner <meissner@cygnus.com>
++
++ * gcc.c (process_command): If -save-temps and -pipe were specified
++ together, don't do -pipe.
++
++ Thu Jun 26 05:40:46 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * stor-layout.c (get_best_mode): Handle negative bitpos
++ correctly, so caller doesn't get into infinite recursion
++ trying to cope with a spurious VOIDmode.
++
++ Tue Jun 24 19:46:31 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * varasm.c (assemble_variable): If low part of size
++ doesn't fit in an int, variable is too large.
++
++ Sat Jun 21 12:09:00 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * toplev.c (rest_of_compilation): Also temporarily set
++ flag_unroll_all_loops to 0 during first of two calls
++ to loop_optimize, and clean up code a bit to make it
++ easier to read.
++
++ * expr.c (safe_from_p_1, safe_from_p): Fix these to use
++ TREE_SET_CODE instead of TREE_CODE.
++
++ Thu Jun 19 19:30:47 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * config/alpha/alpha.c: Don't include <stamp.h> on
++ GNU Linux machines.
++
++ * config/alpha/elf.c: New file for ELF systems.
++
++ * config/alpha/xm-alpha.h: Don't declare alloca()
++ if it's already a macro (probably defined in stdlib.h).
++
++ * config/alpha/xm-linux.h (HAVE_STRERROR): #define
++ this, according to what various people suggest.
++
++ * config.guess, configure: Make some (hopefully safe)
++ changes, based mostly on gcc-2.8.0-in-development,
++ in the hopes that these make some systems configure
++ "out of the box" more easily, especially Alpha systems.
++
++ Mon Jun 9 04:26:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * expr.c (safe_from_p): Don't examine a given SAVE_EXPR
++ node more than once, to avoid combinatorial explosion
++ in complex expressions. Fortran case that triggered
++ this had a complicated *and* complex expression with
++ 293 unique nodes, resulting in 28 minutes of compile
++ time mostly spent in a single top-level safe_from_p()
++ call due to all the redundant SAVE_EXPR traversals.
++ This change reduced the time to around 2 seconds.
++ (safe_from_p_1): New helper function that does almost
++ exactly what the old safe_from_p() did.
++
++ Sun May 18 21:18:48 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * fold-const.c (fold): Clarify why TRUNC_DIV_EXPR
++ and FLOOR_DIV_EXPR aren't rewritten to EXACT_DIV_EXPR,
++ clean up related code.
++
++ Sat May 3 13:53:00 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * config.sub: Change all `i[345]' to `i[3456]' to
++ support Pentium Pro (this change was already made
++ in configure for gcc-2.7.2.2).
++
++ From Toon Moene <toon@moene.indiv.nluug.nl>:
++ * toplev.c (rest_of_compilation): Unroll loops
++ only the final time through loop optimization.
++
++ Sun Apr 20 10:45:35 1997 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
++
++ * final.c (profile_function): Only call ASM_OUTPUT_REG_{PUSH,POP}
++ if defined.
++
++ Wed Apr 16 22:26:16 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * alias.c, cse.c, loop.c, rtl.c, rtl.h, sched.c:
++ Make changes submitted by <jfc@mit.edu>.
++
++ Sun Apr 13 19:32:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * fold-const.c (fold): If extra warnings enabled,
++ warn about integer division by zero.
++
++ Sun Apr 13 08:15:31 1997 Bernd Schmidt <crux@Pool.Informatik.RWTH-Aachen.DE>
++
++ * final.c (profile_function): Save the static chain register
++ around the call to the profiler function.
++
++ Sat Apr 12 14:56:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * unroll.c (find_splittable_givs): Permit more cases
++ of mult_val/add_val to agree by using rtx_equal_p
++ to compare them instead of requiring them to be
++ integers with the same value. Also don't bother
++ checking if ADDRESS_COST not defined (they will be
++ equal in that case).
++
++ Fri Apr 11 03:30:04 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * unroll.c (find_splittable_givs): Must create a new
++ register if the mult_val and add_val fields don't
++ agree.
++
++ Fri Apr 4 23:00:55 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * fold-const.c (fold): Don't call multiple_of_p if
++ arg1 is constant zero, to avoid crashing; simplify
++ code accordingly.
++
++ Wed Feb 26 13:09:33 1997 Michael Meissner <meissner@cygnus.com>
++
++ * reload.c (debug_reload): Fix format string to print
++ reload_nocombine[r].
++
++ Sun Feb 23 15:26:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * fold-const.c (multiple_of_p): Clean up and improve.
++ (fold): Clean up invocation of multiple_of_p.
++
++ Sat Feb 8 04:53:27 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ From <jfc@jfc.tiac.net> Fri, 07 Feb 1997 22:02:21 -0500:
++ * alias.c (init_alias_analysis): Reduce amount of time
++ needed to simplify the reg_base_value array in the
++ typical case (especially involving function inlining).
++
++ Fri Jan 10 17:22:17 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ Minor improvements/fixes to better alias handling:
++ * Makefile.in (alias.o): Fix typo in rule (was RLT_H).
++ * cse.c, sched.c: Fix up some indenting.
++ * toplev.c: Add -fargument-alias flag, so Fortran users
++ can turn C-style aliasing on once g77 defaults to
++ -fargument-noalias-global.
++
++ Integrate patch for better alias handling from
++ John Carr <jfc@mit.edu>:
++ * Makefile.in (OBJS, alias.o): New module and rule.
++ * alias.c: New source module.
++ * calls.c (expand_call): Recognize alias status of calls
++ to malloc().
++ * combine.c (distribute_notes): New REG_NOALIAS note.
++ * rtl.h (REG_NOALIAS): Ditto.
++ Many other changes for new alias.c module.
++ * cse.c: Many changes, and much code moved into alias.c.
++ * flags.h (flag_alias_check, flag_argument_noalias):
++ New flags.
++ * toplev.c: New flags and related options.
++ * local-alloc.c (validate_equiv_mem_from_store):
++ Caller of true_dependence changed.
++ * loop.c (NUM_STORES): Increase to 50 from 20.
++ (prescan_loop): "const" functions don't alter unknown addresses.
++ (invariant_p): Caller of true_dependence changed.
++ (record_giv): Zero new unrolled and shared flags.
++ (emit_iv_add_mult): Record base value for register.
++ * sched.c: Many changes, mostly moving code to alias.c.
++ (sched_note_set): SCHED_SORT macro def form, but not function,
++ inexplicably changed.
++ * unroll.c: Record base values for registers, etc.
++
++ Fri Jan 3 04:01:00 1997 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * loop.c (check_final_value): Handle insns with no luid's
++ appropriately, instead of crashing on INSN_LUID macro
++ invocations.
++
++ Mon Dec 23 00:49:19 1996 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * config/alpha/alpha.md: Fix pattern that matches if_then_else
++ involving DF target, DF comparison, SF source.
++
++ Fri Dec 20 15:42:52 1996 Craig Burley <burley@gnu.ai.mit.edu>
++
++ * fold-const.c (multiple_of_p): New function.
++ (fold): Use new function to turn *_DIV_EXPR into EXACT_DIV_EXPR.
++
++ Tue Oct 22 18:32:20 1996 Jim Wilson <wilson@cygnus.com>
++
++ * unroll.c (unroll_loop): Always reject loops with unbalanced blocks.
++
++ Tue Sep 24 19:37:00 1996 Jim Wilson <wilson@cygnus.com>
++
++ * reload.c (push_secondary_reload): Do strip paradoxical SUBREG
++ even if reload_class is CLASS_CANNOT_CHANGE_SIZE. Change reload_mode
++ to mode in SECONDARY_MEMORY_NEEDED and get_secondary_mem calls.
++
++ Mon Aug 5 16:53:36 1996 Doug Evans <dje@fallis.cygnus.com>
++
++ * stor-layout.c (layout_record): Correct overflow test for 0 sized
++ fields.
++
+ Sat Jun 29 12:33:39 1996 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
+
+*************** Tue Jun 11 20:18:03 1996 Per Bothner <b
+*** 8,11 ****
+--- 250,259 ----
+ * alpha.h (FIXPROTO_INIT): Define new macro.
+
++ Sat May 18 20:17:27 1996 Jim Wilson <wilson@cygnus.com>
++
++ * unroll.c (copy_loop_body): When update split DEST_ADDR giv,
++ check to make sure it was split.
++ (find_splittable_givs): Fix reversed test of verify_addresses result.
++
+ Fri May 10 18:35:00 1996 Richard Kenner (kenner@vlsi1.ultra.nyu.edu)
+
+*************** Mon Feb 19 07:35:07 1996 Torbjorn Granl
+*** 66,69 ****
+--- 314,322 ----
+ * rs6000.md (not:SI with assign and compare): Fix typo.
+
++ Tue Feb 13 17:43:46 1996 Jim Wilson <wilson@cygnus.com>
++
++ * integrate.c (save_constants_in_decl_trees): New function.
++ (save_for_inline_copying, save_for_inline_nocopy): Call it.
++
+ Wed Jan 24 18:00:12 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+*************** Tue Jan 16 06:01:28 1996 Thomas Graiche
+*** 81,88 ****
+--- 334,357 ----
+ * i386/freebsd.h (ASM_WEAKEN_LABEL): Deleted; not supported.
+
++ Mon Jan 15 07:22:59 1996 Michel Delval (mfd@ccv.fr)
++
++ * reload.c (find_equiv_reg): Apply single_set, not PATTERN, to WHERE.
++
+ Sun Jan 7 17:11:11 1996 David Edelsohn <edelsohn@mhpcc.edu>
+
+ * collect2.c (scan_libraries): Correct Import File ID interpretation.
+
++ Mon Jan 1 09:05:07 1996 Richard Kenner (kenner@vlsi1.ultra.nyu.edu)
++
++ * local-alloc.c (reg_equiv_replacement): New variable.
++ (memref_referenced_p, case REG): Check for reg_equiv_replacement.
++ (update_equiv_regs): reg_equiv_replacement now file-scope.
++
++ Fri Dec 22 17:29:42 1995 Richard Kenner (kenner@vlsi1.ultra.nyu.edu)
++
++ * reload.c (find_valid_class): New function.
++ (push_reload): Use it in cases where a SUBREG and its contents
++ both need to be reloaded.
++
+ Thu Dec 28 22:24:53 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+*************** Mon Dec 18 18:40:34 1995 Jim Wilson <w
+*** 99,102 ****
+--- 368,376 ----
+ above.
+
++ Sun Dec 17 06:37:00 1995 Richard Kenner (kenner@vlsi1.ultra.nyu.edu)
++
++ * reload.c (push_secondary_reload): Don't strip paradoxical SUBREG
++ if reload_class is CLASS_CANNOT_CHANGE_SIZE.
++
+ Sat Dec 16 07:03:33 1995 Philippe De Muyter (phdm@info.ucl.ac.be)
+
+*************** Sat Dec 9 18:05:03 1995 Jim Wilson <w
+*** 113,116 ****
+--- 387,395 ----
+ * expr.c (expand_expr, case INDIRECT_REF): Correct typo in May 8
+ change.
++
++ Fri Dec 8 19:17:30 1995 Mike Meissner <meissner@beauty.cygnus.com>
++
++ * rs6000/rs6000.c (input_operand): Allow any integer constant, not
++ just integers that fit in 1 instruction.
+
+ Sun Nov 26 14:47:42 1995 Richard Kenner <kenner@mole.gnu.ai.mit.edu>
+diff -rcp2N gcc-2.7.2.2/Makefile.in g77-new/Makefile.in
+*** gcc-2.7.2.2/Makefile.in Sun Nov 26 14:44:25 1995
+--- g77-new/Makefile.in Sun Aug 10 18:46:06 1997
+*************** OBJS = toplev.o version.o tree.o print-t
+*** 519,523 ****
+ integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \
+ regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \
+! insn-peep.o reorg.o sched.o final.o recog.o reg-stack.o \
+ insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \
+ insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS)
+--- 519,523 ----
+ integrate.o jump.o cse.o loop.o unroll.o flow.o stupid.o combine.o \
+ regclass.o local-alloc.o global.o reload.o reload1.o caller-save.o \
+! insn-peep.o reorg.o alias.o sched.o final.o recog.o reg-stack.o \
+ insn-opinit.o insn-recog.o insn-extract.o insn-output.o insn-emit.o \
+ insn-attrtab.o $(out_object_file) getpwd.o convert.o $(EXTRA_OBJS)
+*************** LIB2FUNCS = _muldi3 _divdi3 _moddi3 _udi
+*** 570,574 ****
+ _fixxfdi _fixunsxfdi _floatdixf _fixunsxfsi \
+ _fixtfdi _fixunstfdi _floatditf \
+! __gcc_bcmp _varargs _eprintf _op_new _op_vnew _new_handler _op_delete \
+ _op_vdel _bb _shtab _clear_cache _trampoline __main _exit _ctors _eh \
+ _pure
+--- 570,575 ----
+ _fixxfdi _fixunsxfdi _floatdixf _fixunsxfsi \
+ _fixtfdi _fixunstfdi _floatditf \
+! __gcc_bcmp _varargs __dummy _eprintf \
+! _op_new _op_vnew _new_handler _op_delete \
+ _op_vdel _bb _shtab _clear_cache _trampoline __main _exit _ctors _eh \
+ _pure
+*************** expr.o : expr.c $(CONFIG_H) $(RTL_H) $(T
+*** 1179,1183 ****
+ insn-flags.h insn-codes.h expr.h insn-config.h recog.h output.h \
+ typeclass.h bytecode.h bc-opcode.h bc-typecd.h bc-typecd.def bc-optab.h \
+! bc-emit.h modemap.def
+ calls.o : calls.c $(CONFIG_H) $(RTL_H) $(TREE_H) flags.h expr.h insn-codes.h \
+ insn-flags.h
+--- 1180,1184 ----
+ insn-flags.h insn-codes.h expr.h insn-config.h recog.h output.h \
+ typeclass.h bytecode.h bc-opcode.h bc-typecd.h bc-typecd.def bc-optab.h \
+! bc-emit.h modemap.def hard-reg-set.h
+ calls.o : calls.c $(CONFIG_H) $(RTL_H) $(TREE_H) flags.h expr.h insn-codes.h \
+ insn-flags.h
+*************** reorg.o : reorg.c $(CONFIG_H) $(RTL_H) c
+*** 1238,1241 ****
+--- 1239,1243 ----
+ basic-block.h regs.h insn-config.h insn-attr.h insn-flags.h recog.h \
+ flags.h output.h
++ alias.o : $(CONFIG_H) $(RTL_H) flags.h hard-reg-set.h regs.h
+ sched.o : sched.c $(CONFIG_H) $(RTL_H) basic-block.h regs.h hard-reg-set.h \
+ flags.h insn-config.h insn-attr.h
+diff -rcp2N gcc-2.7.2.2/alias.c g77-new/alias.c
+*** gcc-2.7.2.2/alias.c Wed Dec 31 19:00:00 1969
+--- g77-new/alias.c Thu Jul 10 20:08:43 1997
+***************
+*** 0 ****
+--- 1,996 ----
++ /* Alias analysis for GNU C, by John Carr (jfc@mit.edu).
++ Derived in part from sched.c */
++ #include "config.h"
++ #include "rtl.h"
++ #include "expr.h"
++ #include "regs.h"
++ #include "hard-reg-set.h"
++ #include "flags.h"
++
++ static rtx canon_rtx PROTO((rtx));
++ static int rtx_equal_for_memref_p PROTO((rtx, rtx));
++ static rtx find_symbolic_term PROTO((rtx));
++ static int memrefs_conflict_p PROTO((int, rtx, int, rtx,
++ HOST_WIDE_INT));
++
++ /* Set up all info needed to perform alias analysis on memory references. */
++
++ #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X)))
++
++ /* reg_base_value[N] gives an address to which register N is related.
++ If all sets after the first add or subtract to the current value
++ or otherwise modify it so it does not point to a different top level
++ object, reg_base_value[N] is equal to the address part of the source
++ of the first set. The value will be a SYMBOL_REF, a LABEL_REF, or
++ (address (reg)) to indicate that the address is derived from an
++ argument or fixed register. */
++ rtx *reg_base_value;
++ unsigned int reg_base_value_size; /* size of reg_base_value array */
++ #define REG_BASE_VALUE(X) \
++ (REGNO (X) < reg_base_value_size ? reg_base_value[REGNO (X)] : 0)
++
++ /* Vector indexed by N giving the initial (unchanging) value known
++ for pseudo-register N. */
++ rtx *reg_known_value;
++
++ /* Indicates number of valid entries in reg_known_value. */
++ static int reg_known_value_size;
++
++ /* Vector recording for each reg_known_value whether it is due to a
++ REG_EQUIV note. Future passes (viz., reload) may replace the
++ pseudo with the equivalent expression and so we account for the
++ dependences that would be introduced if that happens. */
++ /* ??? This is a problem only on the Convex. The REG_EQUIV notes created in
++ assign_parms mention the arg pointer, and there are explicit insns in the
++ RTL that modify the arg pointer. Thus we must ensure that such insns don't
++ get scheduled across each other because that would invalidate the REG_EQUIV
++ notes. One could argue that the REG_EQUIV notes are wrong, but solving
++ the problem in the scheduler will likely give better code, so we do it
++ here. */
++ char *reg_known_equiv_p;
++
++ /* Inside SRC, the source of a SET, find a base address. */
++
++ /* When copying arguments into pseudo-registers, record the (ADDRESS)
++ expression for the argument directly so that even if the argument
++ register is changed later (e.g. for a function call) the original
++ value is noted. */
++ static int copying_arguments;
++
++ static rtx
++ find_base_value (src)
++ register rtx src;
++ {
++ switch (GET_CODE (src))
++ {
++ case SYMBOL_REF:
++ case LABEL_REF:
++ return src;
++
++ case REG:
++ if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER)
++ return reg_base_value[REGNO (src)];
++ return src;
++
++ case MEM:
++ /* Check for an argument passed in memory. Only record in the
++ copying-arguments block; it is too hard to track changes
++ otherwise. */
++ if (copying_arguments
++ && (XEXP (src, 0) == arg_pointer_rtx
++ || (GET_CODE (XEXP (src, 0)) == PLUS
++ && XEXP (XEXP (src, 0), 0) == arg_pointer_rtx)))
++ return gen_rtx (ADDRESS, VOIDmode, src);
++ return 0;
++
++ case CONST:
++ src = XEXP (src, 0);
++ if (GET_CODE (src) != PLUS && GET_CODE (src) != MINUS)
++ break;
++ /* fall through */
++ case PLUS:
++ case MINUS:
++ /* Guess which operand to set the register equivalent to. */
++ /* If the first operand is a symbol or the second operand is
++ an integer, the first operand is the base address. */
++ if (GET_CODE (XEXP (src, 0)) == SYMBOL_REF
++ || GET_CODE (XEXP (src, 0)) == LABEL_REF
++ || GET_CODE (XEXP (src, 1)) == CONST_INT)
++ return XEXP (src, 0);
++ /* If an operand is a register marked as a pointer, it is the base. */
++ if (GET_CODE (XEXP (src, 0)) == REG
++ && REGNO_POINTER_FLAG (REGNO (XEXP (src, 0))))
++ src = XEXP (src, 0);
++ else if (GET_CODE (XEXP (src, 1)) == REG
++ && REGNO_POINTER_FLAG (REGNO (XEXP (src, 1))))
++ src = XEXP (src, 1);
++ else
++ return 0;
++ if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER)
++ return reg_base_value[REGNO (src)];
++ return src;
++
++ case AND:
++ /* If the second operand is constant set the base
++ address to the first operand. */
++ if (GET_CODE (XEXP (src, 1)) == CONST_INT
++ && GET_CODE (XEXP (src, 0)) == REG)
++ {
++ src = XEXP (src, 0);
++ if (copying_arguments && REGNO (src) < FIRST_PSEUDO_REGISTER)
++ return reg_base_value[REGNO (src)];
++ return src;
++ }
++ return 0;
++
++ case HIGH:
++ return XEXP (src, 0);
++ }
++
++ return 0;
++ }
++
++ /* Called from init_alias_analysis indirectly through note_stores. */
++
++ /* while scanning insns to find base values, reg_seen[N] is nonzero if
++ register N has been set in this function. */
++ static char *reg_seen;
++
++ static
++ void record_set (dest, set)
++ rtx dest, set;
++ {
++ register int regno;
++ rtx src;
++
++ if (GET_CODE (dest) != REG)
++ return;
++
++ regno = REGNO (dest);
++
++ if (set)
++ {
++ /* A CLOBBER wipes out any old value but does not prevent a previously
++ unset register from acquiring a base address (i.e. reg_seen is not
++ set). */
++ if (GET_CODE (set) == CLOBBER)
++ {
++ reg_base_value[regno] = 0;
++ return;
++ }
++ src = SET_SRC (set);
++ }
++ else
++ {
++ static int unique_id;
++ if (reg_seen[regno])
++ {
++ reg_base_value[regno] = 0;
++ return;
++ }
++ reg_seen[regno] = 1;
++ reg_base_value[regno] = gen_rtx (ADDRESS, Pmode,
++ GEN_INT (unique_id++));
++ return;
++ }
++
++ /* This is not the first set. If the new value is not related to the
++ old value, forget the base value. Note that the following code is
++ not detected:
++ extern int x, y; int *p = &x; p += (&y-&x);
++ ANSI C does not allow computing the difference of addresses
++ of distinct top level objects. */
++ if (reg_base_value[regno])
++ switch (GET_CODE (src))
++ {
++ case PLUS:
++ case MINUS:
++ if (XEXP (src, 0) != dest && XEXP (src, 1) != dest)
++ reg_base_value[regno] = 0;
++ break;
++ case AND:
++ if (XEXP (src, 0) != dest || GET_CODE (XEXP (src, 1)) != CONST_INT)
++ reg_base_value[regno] = 0;
++ break;
++ case LO_SUM:
++ if (XEXP (src, 0) != dest)
++ reg_base_value[regno] = 0;
++ break;
++ default:
++ reg_base_value[regno] = 0;
++ break;
++ }
++ /* If this is the first set of a register, record the value. */
++ else if ((regno >= FIRST_PSEUDO_REGISTER || ! fixed_regs[regno])
++ && ! reg_seen[regno] && reg_base_value[regno] == 0)
++ reg_base_value[regno] = find_base_value (src);
++
++ reg_seen[regno] = 1;
++ }
++
++ /* Called from loop optimization when a new pseudo-register is created. */
++ void
++ record_base_value (regno, val)
++ int regno;
++ rtx val;
++ {
++ if (!flag_alias_check || regno >= reg_base_value_size)
++ return;
++ if (GET_CODE (val) == REG)
++ {
++ if (REGNO (val) < reg_base_value_size)
++ reg_base_value[regno] = reg_base_value[REGNO (val)];
++ return;
++ }
++ reg_base_value[regno] = find_base_value (val);
++ }
++
++ static rtx
++ canon_rtx (x)
++ rtx x;
++ {
++ /* Recursively look for equivalences. */
++ if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER
++ && REGNO (x) < reg_known_value_size)
++ return reg_known_value[REGNO (x)] == x
++ ? x : canon_rtx (reg_known_value[REGNO (x)]);
++ else if (GET_CODE (x) == PLUS)
++ {
++ rtx x0 = canon_rtx (XEXP (x, 0));
++ rtx x1 = canon_rtx (XEXP (x, 1));
++
++ if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1))
++ {
++ /* We can tolerate LO_SUMs being offset here; these
++ rtl are used for nothing other than comparisons. */
++ if (GET_CODE (x0) == CONST_INT)
++ return plus_constant_for_output (x1, INTVAL (x0));
++ else if (GET_CODE (x1) == CONST_INT)
++ return plus_constant_for_output (x0, INTVAL (x1));
++ return gen_rtx (PLUS, GET_MODE (x), x0, x1);
++ }
++ }
++ /* This gives us much better alias analysis when called from
++ the loop optimizer. Note we want to leave the original
++ MEM alone, but need to return the canonicalized MEM with
++ all the flags with their original values. */
++ else if (GET_CODE (x) == MEM)
++ {
++ rtx addr = canon_rtx (XEXP (x, 0));
++ if (addr != XEXP (x, 0))
++ {
++ rtx new = gen_rtx (MEM, GET_MODE (x), addr);
++ MEM_VOLATILE_P (new) = MEM_VOLATILE_P (x);
++ RTX_UNCHANGING_P (new) = RTX_UNCHANGING_P (x);
++ MEM_IN_STRUCT_P (new) = MEM_IN_STRUCT_P (x);
++ x = new;
++ }
++ }
++ return x;
++ }
++
++ /* Return 1 if X and Y are identical-looking rtx's.
++
++ We use the data in reg_known_value above to see if two registers with
++ different numbers are, in fact, equivalent. */
++
++ static int
++ rtx_equal_for_memref_p (x, y)
++ rtx x, y;
++ {
++ register int i;
++ register int j;
++ register enum rtx_code code;
++ register char *fmt;
++
++ if (x == 0 && y == 0)
++ return 1;
++ if (x == 0 || y == 0)
++ return 0;
++ x = canon_rtx (x);
++ y = canon_rtx (y);
++
++ if (x == y)
++ return 1;
++
++ code = GET_CODE (x);
++ /* Rtx's of different codes cannot be equal. */
++ if (code != GET_CODE (y))
++ return 0;
++
++ /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent.
++ (REG:SI x) and (REG:HI x) are NOT equivalent. */
++
++ if (GET_MODE (x) != GET_MODE (y))
++ return 0;
++
++ /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */
++
++ if (code == REG)
++ return REGNO (x) == REGNO (y);
++ if (code == LABEL_REF)
++ return XEXP (x, 0) == XEXP (y, 0);
++ if (code == SYMBOL_REF)
++ return XSTR (x, 0) == XSTR (y, 0);
++
++ /* For commutative operations, the RTX match if the operand match in any
++ order. Also handle the simple binary and unary cases without a loop. */
++ if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c')
++ return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0))
++ && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1)))
++ || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1))
++ && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0))));
++ else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2')
++ return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0))
++ && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1)));
++ else if (GET_RTX_CLASS (code) == '1')
++ return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0));
++
++ /* Compare the elements. If any pair of corresponding elements
++ fail to match, return 0 for the whole things. */
++
++ fmt = GET_RTX_FORMAT (code);
++ for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
++ {
++ switch (fmt[i])
++ {
++ case 'w':
++ if (XWINT (x, i) != XWINT (y, i))
++ return 0;
++ break;
++
++ case 'n':
++ case 'i':
++ if (XINT (x, i) != XINT (y, i))
++ return 0;
++ break;
++
++ case 'V':
++ case 'E':
++ /* Two vectors must have the same length. */
++ if (XVECLEN (x, i) != XVECLEN (y, i))
++ return 0;
++
++ /* And the corresponding elements must match. */
++ for (j = 0; j < XVECLEN (x, i); j++)
++ if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0)
++ return 0;
++ break;
++
++ case 'e':
++ if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0)
++ return 0;
++ break;
++
++ case 'S':
++ case 's':
++ if (strcmp (XSTR (x, i), XSTR (y, i)))
++ return 0;
++ break;
++
++ case 'u':
++ /* These are just backpointers, so they don't matter. */
++ break;
++
++ case '0':
++ break;
++
++ /* It is believed that rtx's at this level will never
++ contain anything but integers and other rtx's,
++ except for within LABEL_REFs and SYMBOL_REFs. */
++ default:
++ abort ();
++ }
++ }
++ return 1;
++ }
++
++ /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within
++ X and return it, or return 0 if none found. */
++
++ static rtx
++ find_symbolic_term (x)
++ rtx x;
++ {
++ register int i;
++ register enum rtx_code code;
++ register char *fmt;
++
++ code = GET_CODE (x);
++ if (code == SYMBOL_REF || code == LABEL_REF)
++ return x;
++ if (GET_RTX_CLASS (code) == 'o')
++ return 0;
++
++ fmt = GET_RTX_FORMAT (code);
++ for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
++ {
++ rtx t;
++
++ if (fmt[i] == 'e')
++ {
++ t = find_symbolic_term (XEXP (x, i));
++ if (t != 0)
++ return t;
++ }
++ else if (fmt[i] == 'E')
++ break;
++ }
++ return 0;
++ }
++
++ static rtx
++ find_base_term (x)
++ register rtx x;
++ {
++ switch (GET_CODE (x))
++ {
++ case REG:
++ return REG_BASE_VALUE (x);
++
++ case HIGH:
++ return find_base_term (XEXP (x, 0));
++
++ case CONST:
++ x = XEXP (x, 0);
++ if (GET_CODE (x) != PLUS && GET_CODE (x) != MINUS)
++ return 0;
++ /* fall through */
++ case LO_SUM:
++ case PLUS:
++ case MINUS:
++ {
++ rtx tmp = find_base_term (XEXP (x, 0));
++ if (tmp)
++ return tmp;
++ return find_base_term (XEXP (x, 1));
++ }
++
++ case AND:
++ if (GET_CODE (XEXP (x, 0)) == REG && GET_CODE (XEXP (x, 1)) == CONST_INT)
++ return REG_BASE_VALUE (XEXP (x, 0));
++ return 0;
++
++ case SYMBOL_REF:
++ case LABEL_REF:
++ return x;
++
++ default:
++ return 0;
++ }
++ }
++
++ /* Return 0 if the addresses X and Y are known to point to different
++ objects, 1 if they might be pointers to the same object. */
++
++ static int
++ base_alias_check (x, y)
++ rtx x, y;
++ {
++ rtx x_base = find_base_term (x);
++ rtx y_base = find_base_term (y);
++
++ /* If either base address is unknown or the base addresses are equal,
++ nothing is known about aliasing. */
++
++ if (x_base == 0 || y_base == 0 || rtx_equal_p (x_base, y_base))
++ return 1;
++
++ /* The base addresses of the read and write are different
++ expressions. If they are both symbols there is no
++ conflict. */
++ if (GET_CODE (x_base) != ADDRESS && GET_CODE (y_base) != ADDRESS)
++ return 0;
++
++ /* If one address is a stack reference there can be no alias:
++ stack references using different base registers do not alias,
++ a stack reference can not alias a parameter, and a stack reference
++ can not alias a global. */
++ if ((GET_CODE (x_base) == ADDRESS && GET_MODE (x_base) == Pmode)
++ || (GET_CODE (y_base) == ADDRESS && GET_MODE (y_base) == Pmode))
++ return 0;
++
++ if (! flag_argument_noalias)
++ return 1;
++
++ if (flag_argument_noalias > 1)
++ return 0;
++
++ /* Weak noalias assertion (arguments are distinct, but may match globals). */
++ return ! (GET_MODE (x_base) == VOIDmode && GET_MODE (y_base) == VOIDmode);
++ }
++
++ /* Return nonzero if X and Y (memory addresses) could reference the
++ same location in memory. C is an offset accumulator. When
++ C is nonzero, we are testing aliases between X and Y + C.
++ XSIZE is the size in bytes of the X reference,
++ similarly YSIZE is the size in bytes for Y.
++
++ If XSIZE or YSIZE is zero, we do not know the amount of memory being
++ referenced (the reference was BLKmode), so make the most pessimistic
++ assumptions.
++
++ We recognize the following cases of non-conflicting memory:
++
++ (1) addresses involving the frame pointer cannot conflict
++ with addresses involving static variables.
++ (2) static variables with different addresses cannot conflict.
++
++ Nice to notice that varying addresses cannot conflict with fp if no
++ local variables had their addresses taken, but that's too hard now. */
++
++
++ static int
++ memrefs_conflict_p (xsize, x, ysize, y, c)
++ register rtx x, y;
++ int xsize, ysize;
++ HOST_WIDE_INT c;
++ {
++ if (GET_CODE (x) == HIGH)
++ x = XEXP (x, 0);
++ else if (GET_CODE (x) == LO_SUM)
++ x = XEXP (x, 1);
++ else
++ x = canon_rtx (x);
++ if (GET_CODE (y) == HIGH)
++ y = XEXP (y, 0);
++ else if (GET_CODE (y) == LO_SUM)
++ y = XEXP (y, 1);
++ else
++ y = canon_rtx (y);
++
++ if (rtx_equal_for_memref_p (x, y))
++ {
++ if (xsize == 0 || ysize == 0)
++ return 1;
++ if (c >= 0 && xsize > c)
++ return 1;
++ if (c < 0 && ysize+c > 0)
++ return 1;
++ return 0;
++ }
++
++ if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx
++ || y == stack_pointer_rtx)
++ {
++ rtx t = y;
++ int tsize = ysize;
++ y = x; ysize = xsize;
++ x = t; xsize = tsize;
++ }
++
++ if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx
++ || x == stack_pointer_rtx)
++ {
++ rtx y1;
++
++ if (CONSTANT_P (y))
++ return 0;
++
++ if (GET_CODE (y) == PLUS
++ && canon_rtx (XEXP (y, 0)) == x
++ && (y1 = canon_rtx (XEXP (y, 1)))
++ && GET_CODE (y1) == CONST_INT)
++ {
++ c += INTVAL (y1);
++ return (xsize == 0 || ysize == 0
++ || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
++ }
++
++ if (GET_CODE (y) == PLUS
++ && (y1 = canon_rtx (XEXP (y, 0)))
++ && CONSTANT_P (y1))
++ return 0;
++
++ return 1;
++ }
++
++ if (GET_CODE (x) == PLUS)
++ {
++ /* The fact that X is canonicalized means that this
++ PLUS rtx is canonicalized. */
++ rtx x0 = XEXP (x, 0);
++ rtx x1 = XEXP (x, 1);
++
++ if (GET_CODE (y) == PLUS)
++ {
++ /* The fact that Y is canonicalized means that this
++ PLUS rtx is canonicalized. */
++ rtx y0 = XEXP (y, 0);
++ rtx y1 = XEXP (y, 1);
++
++ if (rtx_equal_for_memref_p (x1, y1))
++ return memrefs_conflict_p (xsize, x0, ysize, y0, c);
++ if (rtx_equal_for_memref_p (x0, y0))
++ return memrefs_conflict_p (xsize, x1, ysize, y1, c);
++ if (GET_CODE (x1) == CONST_INT)
++ if (GET_CODE (y1) == CONST_INT)
++ return memrefs_conflict_p (xsize, x0, ysize, y0,
++ c - INTVAL (x1) + INTVAL (y1));
++ else
++ return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1));
++ else if (GET_CODE (y1) == CONST_INT)
++ return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1));
++
++ /* Handle case where we cannot understand iteration operators,
++ but we notice that the base addresses are distinct objects. */
++ /* ??? Is this still necessary? */
++ x = find_symbolic_term (x);
++ if (x == 0)
++ return 1;
++ y = find_symbolic_term (y);
++ if (y == 0)
++ return 1;
++ return rtx_equal_for_memref_p (x, y);
++ }
++ else if (GET_CODE (x1) == CONST_INT)
++ return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1));
++ }
++ else if (GET_CODE (y) == PLUS)
++ {
++ /* The fact that Y is canonicalized means that this
++ PLUS rtx is canonicalized. */
++ rtx y0 = XEXP (y, 0);
++ rtx y1 = XEXP (y, 1);
++
++ if (GET_CODE (y1) == CONST_INT)
++ return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1));
++ else
++ return 1;
++ }
++
++ if (GET_CODE (x) == GET_CODE (y))
++ switch (GET_CODE (x))
++ {
++ case MULT:
++ {
++ /* Handle cases where we expect the second operands to be the
++ same, and check only whether the first operand would conflict
++ or not. */
++ rtx x0, y0;
++ rtx x1 = canon_rtx (XEXP (x, 1));
++ rtx y1 = canon_rtx (XEXP (y, 1));
++ if (! rtx_equal_for_memref_p (x1, y1))
++ return 1;
++ x0 = canon_rtx (XEXP (x, 0));
++ y0 = canon_rtx (XEXP (y, 0));
++ if (rtx_equal_for_memref_p (x0, y0))
++ return (xsize == 0 || ysize == 0
++ || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
++
++ /* Can't properly adjust our sizes. */
++ if (GET_CODE (x1) != CONST_INT)
++ return 1;
++ xsize /= INTVAL (x1);
++ ysize /= INTVAL (x1);
++ c /= INTVAL (x1);
++ return memrefs_conflict_p (xsize, x0, ysize, y0, c);
++ }
++ }
++
++ /* Treat an access through an AND (e.g. a subword access on an Alpha)
++ as an access with indeterminate size. */
++ if (GET_CODE (x) == AND && GET_CODE (XEXP (x, 1)) == CONST_INT)
++ return memrefs_conflict_p (0, XEXP (x, 0), ysize, y, c);
++ if (GET_CODE (y) == AND && GET_CODE (XEXP (y, 1)) == CONST_INT)
++ return memrefs_conflict_p (xsize, x, 0, XEXP (y, 0), c);
++
++ if (CONSTANT_P (x))
++ {
++ if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT)
++ {
++ c += (INTVAL (y) - INTVAL (x));
++ return (xsize == 0 || ysize == 0
++ || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
++ }
++
++ if (GET_CODE (x) == CONST)
++ {
++ if (GET_CODE (y) == CONST)
++ return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)),
++ ysize, canon_rtx (XEXP (y, 0)), c);
++ else
++ return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)),
++ ysize, y, c);
++ }
++ if (GET_CODE (y) == CONST)
++ return memrefs_conflict_p (xsize, x, ysize,
++ canon_rtx (XEXP (y, 0)), c);
++
++ if (CONSTANT_P (y))
++ return (rtx_equal_for_memref_p (x, y)
++ && (xsize == 0 || ysize == 0
++ || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)));
++
++ return 1;
++ }
++ return 1;
++ }
++
++ /* Functions to compute memory dependencies.
++
++ Since we process the insns in execution order, we can build tables
++ to keep track of what registers are fixed (and not aliased), what registers
++ are varying in known ways, and what registers are varying in unknown
++ ways.
++
++ If both memory references are volatile, then there must always be a
++ dependence between the two references, since their order can not be
++ changed. A volatile and non-volatile reference can be interchanged
++ though.
++
++ A MEM_IN_STRUCT reference at a non-QImode varying address can never
++ conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must
++ allow QImode aliasing because the ANSI C standard allows character
++ pointers to alias anything. We are assuming that characters are
++ always QImode here. */
++
++ /* Read dependence: X is read after read in MEM takes place. There can
++ only be a dependence here if both reads are volatile. */
++
++ int
++ read_dependence (mem, x)
++ rtx mem;
++ rtx x;
++ {
++ return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem);
++ }
++
++ /* True dependence: X is read after store in MEM takes place. */
++
++ int
++ true_dependence (mem, mem_mode, x, varies)
++ rtx mem;
++ enum machine_mode mem_mode;
++ rtx x;
++ int (*varies)();
++ {
++ rtx x_addr, mem_addr;
++
++ if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
++ return 1;
++
++ x_addr = XEXP (x, 0);
++ mem_addr = XEXP (mem, 0);
++
++ if (flag_alias_check && ! base_alias_check (x_addr, mem_addr))
++ return 0;
++
++ /* If X is an unchanging read, then it can't possibly conflict with any
++ non-unchanging store. It may conflict with an unchanging write though,
++ because there may be a single store to this address to initialize it.
++ Just fall through to the code below to resolve the case where we have
++ both an unchanging read and an unchanging write. This won't handle all
++ cases optimally, but the possible performance loss should be
++ negligible. */
++ if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem))
++ return 0;
++
++ x_addr = canon_rtx (x_addr);
++ mem_addr = canon_rtx (mem_addr);
++ if (mem_mode == VOIDmode)
++ mem_mode = GET_MODE (mem);
++
++ if (! memrefs_conflict_p (mem_mode, mem_addr, SIZE_FOR_MODE (x), x_addr, 0))
++ return 0;
++
++ /* If both references are struct references, or both are not, nothing
++ is known about aliasing.
++
++ If either reference is QImode or BLKmode, ANSI C permits aliasing.
++
++ If both addresses are constant, or both are not, nothing is known
++ about aliasing. */
++ if (MEM_IN_STRUCT_P (x) == MEM_IN_STRUCT_P (mem)
++ || mem_mode == QImode || mem_mode == BLKmode
++ || GET_MODE (x) == QImode || GET_MODE (mem) == BLKmode
++ || varies (x_addr) == varies (mem_addr))
++ return 1;
++
++ /* One memory reference is to a constant address, one is not.
++ One is to a structure, the other is not.
++
++ If either memory reference is a variable structure the other is a
++ fixed scalar and there is no aliasing. */
++ if ((MEM_IN_STRUCT_P (mem) && varies (mem_addr))
++ || (MEM_IN_STRUCT_P (x) && varies (x)))
++ return 0;
++
++ return 1;
++ }
++
++ /* Anti dependence: X is written after read in MEM takes place. */
++
++ int
++ anti_dependence (mem, x)
++ rtx mem;
++ rtx x;
++ {
++ if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
++ return 1;
++
++ if (flag_alias_check && ! base_alias_check (XEXP (x, 0), XEXP (mem, 0)))
++ return 0;
++
++ /* If MEM is an unchanging read, then it can't possibly conflict with
++ the store to X, because there is at most one store to MEM, and it must
++ have occurred somewhere before MEM. */
++ x = canon_rtx (x);
++ mem = canon_rtx (mem);
++ if (RTX_UNCHANGING_P (mem))
++ return 0;
++
++ return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
++ SIZE_FOR_MODE (x), XEXP (x, 0), 0)
++ && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
++ && GET_MODE (mem) != QImode
++ && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
++ && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
++ && GET_MODE (x) != QImode
++ && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)));
++ }
++
++ /* Output dependence: X is written after store in MEM takes place. */
++
++ int
++ output_dependence (mem, x)
++ register rtx mem;
++ register rtx x;
++ {
++ if (MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
++ return 1;
++
++ if (flag_alias_check && !base_alias_check (XEXP (x, 0), XEXP (mem, 0)))
++ return 0;
++
++ x = canon_rtx (x);
++ mem = canon_rtx (mem);
++ return (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
++ SIZE_FOR_MODE (x), XEXP (x, 0), 0)
++ && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
++ && GET_MODE (mem) != QImode
++ && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
++ && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
++ && GET_MODE (x) != QImode
++ && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem)));
++ }
++
++ void
++ init_alias_analysis ()
++ {
++ int maxreg = max_reg_num ();
++ int changed;
++ register int i;
++ register rtx insn;
++ rtx note;
++ rtx set;
++
++ reg_known_value_size = maxreg;
++
++ reg_known_value
++ = (rtx *) oballoc ((maxreg - FIRST_PSEUDO_REGISTER) * sizeof (rtx))
++ - FIRST_PSEUDO_REGISTER;
++ reg_known_equiv_p =
++ oballoc (maxreg - FIRST_PSEUDO_REGISTER) - FIRST_PSEUDO_REGISTER;
++ bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER),
++ (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx));
++ bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER,
++ (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char));
++
++ if (flag_alias_check)
++ {
++ /* Overallocate reg_base_value to allow some growth during loop
++ optimization. Loop unrolling can create a large number of
++ registers. */
++ reg_base_value_size = maxreg * 2;
++ reg_base_value = (rtx *)oballoc (reg_base_value_size * sizeof (rtx));
++ reg_seen = (char *)alloca (reg_base_value_size);
++ bzero (reg_base_value, reg_base_value_size * sizeof (rtx));
++ bzero (reg_seen, reg_base_value_size);
++
++ /* Mark all hard registers which may contain an address.
++ The stack, frame and argument pointers may contain an address.
++ An argument register which can hold a Pmode value may contain
++ an address even if it is not in BASE_REGS.
++
++ The address expression is VOIDmode for an argument and
++ Pmode for other registers. */
++ #ifndef OUTGOING_REGNO
++ #define OUTGOING_REGNO(N) N
++ #endif
++ for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
++ /* Check whether this register can hold an incoming pointer
++ argument. FUNCTION_ARG_REGNO_P tests outgoing register
++ numbers, so translate if necessary due to register windows. */
++ if (FUNCTION_ARG_REGNO_P (OUTGOING_REGNO (i)) && HARD_REGNO_MODE_OK (i, Pmode))
++ reg_base_value[i] = gen_rtx (ADDRESS, VOIDmode,
++ gen_rtx (REG, Pmode, i));
++
++ reg_base_value[STACK_POINTER_REGNUM]
++ = gen_rtx (ADDRESS, Pmode, stack_pointer_rtx);
++ reg_base_value[ARG_POINTER_REGNUM]
++ = gen_rtx (ADDRESS, Pmode, arg_pointer_rtx);
++ reg_base_value[FRAME_POINTER_REGNUM]
++ = gen_rtx (ADDRESS, Pmode, frame_pointer_rtx);
++ reg_base_value[HARD_FRAME_POINTER_REGNUM]
++ = gen_rtx (ADDRESS, Pmode, hard_frame_pointer_rtx);
++ }
++
++ copying_arguments = 1;
++ /* Fill in the entries with known constant values. */
++ for (insn = get_insns (); insn; insn = NEXT_INSN (insn))
++ {
++ if (flag_alias_check && GET_RTX_CLASS (GET_CODE (insn)) == 'i')
++ {
++ /* If this insn has a noalias note, process it, Otherwise,
++ scan for sets. A simple set will have no side effects
++ which could change the base value of any other register. */
++ rtx noalias_note;
++ if (GET_CODE (PATTERN (insn)) == SET
++ && (noalias_note = find_reg_note (insn, REG_NOALIAS, NULL_RTX)))
++ record_set (SET_DEST (PATTERN (insn)), 0);
++ else
++ note_stores (PATTERN (insn), record_set);
++ }
++ else if (GET_CODE (insn) == NOTE
++ && NOTE_LINE_NUMBER (insn) == NOTE_INSN_FUNCTION_BEG)
++ copying_arguments = 0;
++
++ if ((set = single_set (insn)) != 0
++ && GET_CODE (SET_DEST (set)) == REG
++ && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER
++ && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0
++ && reg_n_sets[REGNO (SET_DEST (set))] == 1)
++ || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0)
++ && GET_CODE (XEXP (note, 0)) != EXPR_LIST)
++ {
++ int regno = REGNO (SET_DEST (set));
++ reg_known_value[regno] = XEXP (note, 0);
++ reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV;
++ }
++ }
++
++ /* Fill in the remaining entries. */
++ for (i = FIRST_PSEUDO_REGISTER; i < maxreg; i++)
++ if (reg_known_value[i] == 0)
++ reg_known_value[i] = regno_reg_rtx[i];
++
++ if (! flag_alias_check)
++ return;
++
++ /* Simplify the reg_base_value array so that no register refers to
++ another register, except to special registers indirectly through
++ ADDRESS expressions.
++
++ In theory this loop can take as long as O(registers^2), but unless
++ there are very long dependency chains it will run in close to linear
++ time. */
++ do
++ {
++ changed = 0;
++ for (i = FIRST_PSEUDO_REGISTER; i < reg_base_value_size; i++)
++ {
++ rtx base = reg_base_value[i];
++ if (base && GET_CODE (base) == REG)
++ {
++ int base_regno = REGNO (base);
++ if (base_regno == i) /* register set from itself */
++ reg_base_value[i] = 0;
++ else
++ reg_base_value[i] = reg_base_value[base_regno];
++ changed = 1;
++ }
++ }
++ }
++ while (changed);
++
++ reg_seen = 0;
++ }
++
++ void
++ end_alias_analysis ()
++ {
++ reg_known_value = 0;
++ reg_base_value = 0;
++ reg_base_value_size = 0;
++ }
+diff -rcp2N gcc-2.7.2.2/c-decl.c g77-new/c-decl.c
+*** gcc-2.7.2.2/c-decl.c Fri Oct 27 05:44:43 1995
+--- g77-new/c-decl.c Sun Aug 10 18:46:24 1997
+*************** init_decl_processing ()
+*** 3207,3210 ****
+--- 3207,3223 ----
+ builtin_function ("__builtin_cosl", ldouble_ftype_ldouble,
+ BUILT_IN_COS, "cosl");
++ builtin_function ("__builtin_setjmp",
++ build_function_type (integer_type_node,
++ tree_cons (NULL_TREE,
++ ptr_type_node, endlink)),
++ BUILT_IN_SETJMP, NULL_PTR);
++ builtin_function ("__builtin_longjmp",
++ build_function_type
++ (void_type_node,
++ tree_cons (NULL, ptr_type_node,
++ tree_cons (NULL_TREE,
++ integer_type_node,
++ endlink))),
++ BUILT_IN_LONGJMP, NULL_PTR);
+
+ /* In an ANSI C program, it is okay to supply built-in meanings
+*************** grokdeclarator (declarator, declspecs, d
+*** 4049,4052 ****
+--- 4062,4066 ----
+ int volatilep;
+ int inlinep;
++ int restrictp;
+ int explicit_int = 0;
+ int explicit_char = 0;
+*************** grokdeclarator (declarator, declspecs, d
+*** 4342,4349 ****
+--- 4356,4366 ----
+ volatilep = !! (specbits & 1 << (int) RID_VOLATILE) + TYPE_VOLATILE (type);
+ inlinep = !! (specbits & (1 << (int) RID_INLINE));
++ restrictp = !! (specbits & (1 << (int) RID_RESTRICT));
+ if (constp > 1)
+ pedwarn ("duplicate `const'");
+ if (volatilep > 1)
+ pedwarn ("duplicate `volatile'");
++ if (restrictp)
++ error ("`restrict' used in non-parameter or non-pointer type declaration");
+ if (! flag_gen_aux_info && (TYPE_READONLY (type) || TYPE_VOLATILE (type)))
+ type = TYPE_MAIN_VARIANT (type);
+*************** grokdeclarator (declarator, declspecs, d
+*** 4693,4696 ****
+--- 4710,4715 ----
+ else if (TREE_VALUE (typemodlist) == ridpointers[(int) RID_VOLATILE])
+ volatilep++;
++ else if (TREE_VALUE (typemodlist) == ridpointers[(int) RID_RESTRICT])
++ restrictp++;
+ else if (!erred)
+ {
+*************** grokdeclarator (declarator, declspecs, d
+*** 4703,4706 ****
+--- 4722,4727 ----
+ if (volatilep > 1)
+ pedwarn ("duplicate `volatile'");
++ if (restrictp > 1)
++ pedwarn ("duplicate `restrict'");
+ }
+
+*************** grokdeclarator (declarator, declspecs, d
+*** 4844,4847 ****
+--- 4865,4875 ----
+ }
+
++ if (restrictp)
++ {
++ if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE)
++ error ("`restrict' applied to non-pointer");
++ DECL_RESTRICT (decl) = 1;
++ }
++
+ DECL_ARG_TYPE_AS_WRITTEN (decl) = type_as_written;
+ }
+*************** start_struct (code, name)
+*** 5365,5368 ****
+--- 5393,5397 ----
+ pushtag (name, ref);
+ C_TYPE_BEING_DEFINED (ref) = 1;
++ TYPE_PACKED (ref) = flag_pack_struct;
+ return ref;
+ }
+*************** start_enum (name)
+*** 5806,5809 ****
+--- 5835,5841 ----
+ enum_overflow = 0;
+
++ if (flag_short_enums)
++ TYPE_PACKED (enumtype) = 1;
++
+ return enumtype;
+ }
+*************** finish_enum (enumtype, values, attribute
+*** 5862,5867 ****
+ precision = MAX (lowprec, highprec);
+
+! if (flag_short_enums || TYPE_PACKED (enumtype)
+! || precision > TYPE_PRECISION (integer_type_node))
+ /* Use the width of the narrowest normal C type which is wide enough. */
+ TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1));
+--- 5894,5898 ----
+ precision = MAX (lowprec, highprec);
+
+! if (TYPE_PACKED (enumtype) || precision > TYPE_PRECISION (integer_type_node))
+ /* Use the width of the narrowest normal C type which is wide enough. */
+ TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1));
+diff -rcp2N gcc-2.7.2.2/c-gperf.h g77-new/c-gperf.h
+*** gcc-2.7.2.2/c-gperf.h Fri Mar 4 14:15:53 1994
+--- g77-new/c-gperf.h Mon Aug 11 02:58:47 1997
+***************
+*** 1,15 ****
+ /* C code produced by gperf version 2.5 (GNU C++ version) */
+! /* Command-line: gperf -p -j1 -i 1 -g -o -t -G -N is_reserved_word -k1,3,$ c-parse.gperf */
+ struct resword { char *name; short token; enum rid rid; };
+
+! #define TOTAL_KEYWORDS 79
+ #define MIN_WORD_LENGTH 2
+ #define MAX_WORD_LENGTH 20
+! #define MIN_HASH_VALUE 10
+! #define MAX_HASH_VALUE 144
+! /* maximum key range = 135, duplicates = 0 */
+
+ #ifdef __GNUC__
+! __inline
+ #endif
+ static unsigned int
+--- 1,16 ----
+ /* C code produced by gperf version 2.5 (GNU C++ version) */
+! /* Command-line: gperf -p -j1 -i 1 -g -o -t -G -N is_reserved_word -k1,3,$ ../g77-new/c-parse.gperf */
+! /* Command-line: gperf -p -j1 -i 1 -g -o -t -N is_reserved_word -k1,3,$ c-parse.gperf */
+ struct resword { char *name; short token; enum rid rid; };
+
+! #define TOTAL_KEYWORDS 81
+ #define MIN_WORD_LENGTH 2
+ #define MAX_WORD_LENGTH 20
+! #define MIN_HASH_VALUE 11
+! #define MAX_HASH_VALUE 157
+! /* maximum key range = 147, duplicates = 0 */
+
+ #ifdef __GNUC__
+! inline
+ #endif
+ static unsigned int
+*************** hash (str, len)
+*** 20,36 ****
+ static unsigned char asso_values[] =
+ {
+! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 25, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 145, 145, 145, 145, 145, 145,
+! 145, 145, 145, 145, 145, 1, 145, 46, 8, 15,
+! 61, 6, 36, 48, 3, 5, 145, 18, 63, 25,
+! 29, 76, 1, 145, 13, 2, 1, 51, 37, 9,
+! 9, 1, 3, 145, 145, 145, 145, 145,
+ };
+ register int hval = len;
+--- 21,37 ----
+ static unsigned char asso_values[] =
+ {
+! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 2, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 158, 158, 158, 158, 158, 158,
+! 158, 158, 158, 158, 158, 1, 158, 18, 1, 58,
+! 56, 6, 44, 64, 13, 45, 158, 4, 26, 68,
+! 2, 74, 1, 158, 2, 13, 1, 33, 48, 5,
+! 5, 3, 12, 158, 158, 158, 158, 158,
+ };
+ register int hval = len;
+*************** hash (str, len)
+*** 44,47 ****
+--- 45,49 ----
+ case 1:
+ hval += asso_values[str[0]];
++ break;
+ }
+ return hval + asso_values[str[len - 1]];
+*************** hash (str, len)
+*** 50,166 ****
+ static struct resword wordlist[] =
+ {
+! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
+! {"",},
+! {"int", TYPESPEC, RID_INT},
+! {"",}, {"",},
+! {"__typeof__", TYPEOF, NORID},
+! {"__signed__", TYPESPEC, RID_SIGNED},
+! {"__imag__", IMAGPART, NORID},
+! {"switch", SWITCH, NORID},
+! {"__inline__", SCSPEC, RID_INLINE},
+! {"else", ELSE, NORID},
+! {"__iterator__", SCSPEC, RID_ITERATOR},
+! {"__inline", SCSPEC, RID_INLINE},
+! {"__extension__", EXTENSION, NORID},
+! {"struct", STRUCT, NORID},
+! {"__real__", REALPART, NORID},
+! {"__const", TYPE_QUAL, RID_CONST},
+! {"while", WHILE, NORID},
+! {"__const__", TYPE_QUAL, RID_CONST},
+! {"case", CASE, NORID},
+! {"__complex__", TYPESPEC, RID_COMPLEX},
+! {"__iterator", SCSPEC, RID_ITERATOR},
+! {"bycopy", TYPE_QUAL, RID_BYCOPY},
+! {"",}, {"",}, {"",},
+! {"__complex", TYPESPEC, RID_COMPLEX},
+! {"",},
+! {"in", TYPE_QUAL, RID_IN},
+! {"break", BREAK, NORID},
+! {"@defs", DEFS, NORID},
+! {"",}, {"",}, {"",},
+! {"extern", SCSPEC, RID_EXTERN},
+! {"if", IF, NORID},
+! {"typeof", TYPEOF, NORID},
+! {"typedef", SCSPEC, RID_TYPEDEF},
+! {"__typeof", TYPEOF, NORID},
+! {"sizeof", SIZEOF, NORID},
+! {"",},
+! {"return", RETURN, NORID},
+! {"const", TYPE_QUAL, RID_CONST},
+! {"__volatile__", TYPE_QUAL, RID_VOLATILE},
+! {"@private", PRIVATE, NORID},
+! {"@selector", SELECTOR, NORID},
+! {"__volatile", TYPE_QUAL, RID_VOLATILE},
+! {"__asm__", ASM_KEYWORD, NORID},
+! {"",}, {"",},
+! {"continue", CONTINUE, NORID},
+! {"__alignof__", ALIGNOF, NORID},
+! {"__imag", IMAGPART, NORID},
+! {"__attribute__", ATTRIBUTE, NORID},
+! {"",}, {"",},
+! {"__attribute", ATTRIBUTE, NORID},
+! {"for", FOR, NORID},
+! {"",},
+! {"@encode", ENCODE, NORID},
+! {"id", OBJECTNAME, RID_ID},
+! {"static", SCSPEC, RID_STATIC},
+! {"@interface", INTERFACE, NORID},
+! {"",},
+! {"__signed", TYPESPEC, RID_SIGNED},
+! {"",},
+! {"__label__", LABEL, NORID},
+! {"",}, {"",},
+! {"__asm", ASM_KEYWORD, NORID},
+! {"char", TYPESPEC, RID_CHAR},
+! {"",},
+! {"inline", SCSPEC, RID_INLINE},
+! {"out", TYPE_QUAL, RID_OUT},
+! {"register", SCSPEC, RID_REGISTER},
+! {"__real", REALPART, NORID},
+! {"short", TYPESPEC, RID_SHORT},
+! {"",},
+! {"enum", ENUM, NORID},
+! {"inout", TYPE_QUAL, RID_INOUT},
+! {"",},
+! {"oneway", TYPE_QUAL, RID_ONEWAY},
+! {"union", UNION, NORID},
+! {"",},
+! {"__alignof", ALIGNOF, NORID},
+! {"",},
+! {"@implementation", IMPLEMENTATION, NORID},
+! {"",},
+! {"@class", CLASS, NORID},
+! {"",},
+! {"@public", PUBLIC, NORID},
+! {"asm", ASM_KEYWORD, NORID},
+! {"",}, {"",}, {"",}, {"",}, {"",},
+! {"default", DEFAULT, NORID},
+! {"",},
+! {"void", TYPESPEC, RID_VOID},
+! {"",},
+! {"@protected", PROTECTED, NORID},
+! {"@protocol", PROTOCOL, NORID},
+! {"",}, {"",}, {"",},
+! {"volatile", TYPE_QUAL, RID_VOLATILE},
+! {"",}, {"",},
+! {"signed", TYPESPEC, RID_SIGNED},
+! {"float", TYPESPEC, RID_FLOAT},
+! {"@end", END, NORID},
+! {"",}, {"",},
+! {"unsigned", TYPESPEC, RID_UNSIGNED},
+! {"@compatibility_alias", ALIAS, NORID},
+! {"double", TYPESPEC, RID_DOUBLE},
+! {"",}, {"",},
+! {"auto", SCSPEC, RID_AUTO},
+! {"",},
+! {"goto", GOTO, NORID},
+! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
+! {"do", DO, NORID},
+! {"",}, {"",}, {"",}, {"",},
+! {"long", TYPESPEC, RID_LONG},
+ };
+
+ #ifdef __GNUC__
+! __inline
+ #endif
+ struct resword *
+--- 52,167 ----
+ static struct resword wordlist[] =
+ {
+! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
+! {"",}, {"",},
+! {"return", RETURN, NORID},
+! {"__real__", REALPART, NORID},
+! {"__typeof__", TYPEOF, NORID},
+! {"__restrict", TYPE_QUAL, RID_RESTRICT},
+! {"extern", SCSPEC, RID_EXTERN},
+! {"break", BREAK, NORID},
+! {"@encode", ENCODE, NORID},
+! {"@private", PRIVATE, NORID},
+! {"@selector", SELECTOR, NORID},
+! {"@interface", INTERFACE, NORID},
+! {"__extension__", EXTENSION, NORID},
+! {"struct", STRUCT, NORID},
+! {"",},
+! {"restrict", TYPE_QUAL, RID_RESTRICT},
+! {"__signed__", TYPESPEC, RID_SIGNED},
+! {"@defs", DEFS, NORID},
+! {"__asm__", ASM_KEYWORD, NORID},
+! {"",},
+! {"else", ELSE, NORID},
+! {"",},
+! {"__alignof__", ALIGNOF, NORID},
+! {"",},
+! {"__attribute__", ATTRIBUTE, NORID},
+! {"",},
+! {"__real", REALPART, NORID},
+! {"__attribute", ATTRIBUTE, NORID},
+! {"__label__", LABEL, NORID},
+! {"",},
+! {"@protocol", PROTOCOL, NORID},
+! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
+! {"@class", CLASS, NORID},
+! {"",},
+! {"in", TYPE_QUAL, RID_IN},
+! {"int", TYPESPEC, RID_INT},
+! {"for", FOR, NORID},
+! {"typeof", TYPEOF, NORID},
+! {"typedef", SCSPEC, RID_TYPEDEF},
+! {"__typeof", TYPEOF, NORID},
+! {"__imag__", IMAGPART, NORID},
+! {"",},
+! {"__inline__", SCSPEC, RID_INLINE},
+! {"__iterator", SCSPEC, RID_ITERATOR},
+! {"__iterator__", SCSPEC, RID_ITERATOR},
+! {"__inline", SCSPEC, RID_INLINE},
+! {"while", WHILE, NORID},
+! {"__volatile__", TYPE_QUAL, RID_VOLATILE},
+! {"",},
+! {"@end", END, NORID},
+! {"__volatile", TYPE_QUAL, RID_VOLATILE},
+! {"const", TYPE_QUAL, RID_CONST},
+! {"__const", TYPE_QUAL, RID_CONST},
+! {"bycopy", TYPE_QUAL, RID_BYCOPY},
+! {"__const__", TYPE_QUAL, RID_CONST},
+! {"@protected", PROTECTED, NORID},
+! {"__complex__", TYPESPEC, RID_COMPLEX},
+! {"__alignof", ALIGNOF, NORID},
+! {"__complex", TYPESPEC, RID_COMPLEX},
+! {"continue", CONTINUE, NORID},
+! {"sizeof", SIZEOF, NORID},
+! {"register", SCSPEC, RID_REGISTER},
+! {"switch", SWITCH, NORID},
+! {"__signed", TYPESPEC, RID_SIGNED},
+! {"out", TYPE_QUAL, RID_OUT},
+! {"",},
+! {"case", CASE, NORID},
+! {"char", TYPESPEC, RID_CHAR},
+! {"inline", SCSPEC, RID_INLINE},
+! {"",},
+! {"union", UNION, NORID},
+! {"",},
+! {"@implementation", IMPLEMENTATION, NORID},
+! {"volatile", TYPE_QUAL, RID_VOLATILE},
+! {"oneway", TYPE_QUAL, RID_ONEWAY},
+! {"",},
+! {"if", IF, NORID},
+! {"__asm", ASM_KEYWORD, NORID},
+! {"short", TYPESPEC, RID_SHORT},
+! {"",},
+! {"static", SCSPEC, RID_STATIC},
+! {"long", TYPESPEC, RID_LONG},
+! {"auto", SCSPEC, RID_AUTO},
+! {"",}, {"",},
+! {"@public", PUBLIC, NORID},
+! {"double", TYPESPEC, RID_DOUBLE},
+! {"",},
+! {"id", OBJECTNAME, RID_ID},
+! {"",}, {"",}, {"",}, {"",},
+! {"default", DEFAULT, NORID},
+! {"@compatibility_alias", ALIAS, NORID},
+! {"unsigned", TYPESPEC, RID_UNSIGNED},
+! {"enum", ENUM, NORID},
+! {"",}, {"",}, {"",}, {"",},
+! {"__imag", IMAGPART, NORID},
+! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
+! {"float", TYPESPEC, RID_FLOAT},
+! {"inout", TYPE_QUAL, RID_INOUT},
+! {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
+! {"do", DO, NORID},
+! {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
+! {"signed", TYPESPEC, RID_SIGNED},
+! {"",}, {"",}, {"",},
+! {"goto", GOTO, NORID},
+! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",},
+! {"void", TYPESPEC, RID_VOID},
+! {"",}, {"",}, {"",},
+! {"asm", ASM_KEYWORD, NORID},
+ };
+
+ #ifdef __GNUC__
+! inline
+ #endif
+ struct resword *
+diff -rcp2N gcc-2.7.2.2/c-lex.c g77-new/c-lex.c
+*** gcc-2.7.2.2/c-lex.c Thu Jun 15 07:11:39 1995
+--- g77-new/c-lex.c Sun Aug 10 18:46:49 1997
+*************** init_lex ()
+*** 173,176 ****
+--- 173,177 ----
+ ridpointers[(int) RID_CONST] = get_identifier ("const");
+ ridpointers[(int) RID_VOLATILE] = get_identifier ("volatile");
++ ridpointers[(int) RID_RESTRICT] = get_identifier ("restrict");
+ ridpointers[(int) RID_AUTO] = get_identifier ("auto");
+ ridpointers[(int) RID_STATIC] = get_identifier ("static");
+*************** init_lex ()
+*** 206,209 ****
+--- 207,211 ----
+ UNSET_RESERVED_WORD ("iterator");
+ UNSET_RESERVED_WORD ("complex");
++ UNSET_RESERVED_WORD ("restrict");
+ }
+ if (flag_no_asm)
+*************** init_lex ()
+*** 214,217 ****
+--- 216,220 ----
+ UNSET_RESERVED_WORD ("iterator");
+ UNSET_RESERVED_WORD ("complex");
++ UNSET_RESERVED_WORD ("restrict");
+ }
+ }
+*************** yylex ()
+*** 1433,1437 ****
+ /* Create a node with determined type and value. */
+ if (imag)
+! yylval.ttype = build_complex (convert (type, integer_zero_node),
+ build_real (type, value));
+ else
+--- 1436,1441 ----
+ /* Create a node with determined type and value. */
+ if (imag)
+! yylval.ttype = build_complex (NULL_TREE,
+! convert (type, integer_zero_node),
+ build_real (type, value));
+ else
+*************** yylex ()
+*** 1624,1629 ****
+ <= TYPE_PRECISION (integer_type_node))
+ yylval.ttype
+! = build_complex (integer_zero_node,
+! convert (integer_type_node, yylval.ttype));
+ else
+ error ("complex integer constant is too wide for `complex int'");
+--- 1628,1634 ----
+ <= TYPE_PRECISION (integer_type_node))
+ yylval.ttype
+! = build_complex (NULL_TREE, integer_zero_node,
+! convert (integer_type_node,
+! yylval.ttype));
+ else
+ error ("complex integer constant is too wide for `complex int'");
+diff -rcp2N gcc-2.7.2.2/c-lex.h g77-new/c-lex.h
+*** gcc-2.7.2.2/c-lex.h Thu Jun 15 07:12:22 1995
+--- g77-new/c-lex.h Sun Aug 10 18:10:55 1997
+*************** enum rid
+*** 43,47 ****
+ RID_VOLATILE,
+ RID_INLINE,
+! RID_NOALIAS,
+ RID_ITERATOR,
+ RID_COMPLEX,
+--- 43,47 ----
+ RID_VOLATILE,
+ RID_INLINE,
+! RID_RESTRICT,
+ RID_ITERATOR,
+ RID_COMPLEX,
+diff -rcp2N gcc-2.7.2.2/c-parse.gperf g77-new/c-parse.gperf
+*** gcc-2.7.2.2/c-parse.gperf Fri Apr 9 19:00:44 1993
+--- g77-new/c-parse.gperf Sun Aug 10 18:10:55 1997
+*************** __label__, LABEL, NORID
+*** 36,39 ****
+--- 36,40 ----
+ __real, REALPART, NORID
+ __real__, REALPART, NORID
++ __restrict, TYPE_QUAL, RID_RESTRICT
+ __signed, TYPESPEC, RID_SIGNED
+ __signed__, TYPESPEC, RID_SIGNED
+*************** oneway, TYPE_QUAL, RID_ONEWAY
+*** 69,72 ****
+--- 70,74 ----
+ out, TYPE_QUAL, RID_OUT
+ register, SCSPEC, RID_REGISTER
++ restrict, TYPE_QUAL, RID_RESTRICT
+ return, RETURN, NORID
+ short, TYPESPEC, RID_SHORT
+diff -rcp2N gcc-2.7.2.2/c-typeck.c g77-new/c-typeck.c
+*** gcc-2.7.2.2/c-typeck.c Thu Feb 20 19:24:11 1997
+--- g77-new/c-typeck.c Sun Aug 10 18:46:29 1997
+*************** pointer_int_sum (resultcode, ptrop, into
+*** 2681,2686 ****
+ so the multiply won't overflow spuriously. */
+
+! if (TYPE_PRECISION (TREE_TYPE (intop)) != POINTER_SIZE)
+! intop = convert (type_for_size (POINTER_SIZE, 0), intop);
+
+ /* Replace the integer argument with a suitable product by the object size.
+--- 2681,2688 ----
+ so the multiply won't overflow spuriously. */
+
+! if (TYPE_PRECISION (TREE_TYPE (intop)) != TYPE_PRECISION (sizetype)
+! || TREE_UNSIGNED (TREE_TYPE (intop)) != TREE_UNSIGNED (sizetype))
+! intop = convert (type_for_size (TYPE_PRECISION (sizetype),
+! TREE_UNSIGNED (sizetype)), intop);
+
+ /* Replace the integer argument with a suitable product by the object size.
+diff -rcp2N gcc-2.7.2.2/calls.c g77-new/calls.c
+*** gcc-2.7.2.2/calls.c Thu Oct 26 21:53:43 1995
+--- g77-new/calls.c Sun Aug 10 18:46:16 1997
+*************** expand_call (exp, target, ignore)
+*** 564,567 ****
+--- 564,569 ----
+ /* Nonzero if it is plausible that this is a call to alloca. */
+ int may_be_alloca;
++ /* Nonzero if this is a call to malloc or a related function. */
++ int is_malloc;
+ /* Nonzero if this is a call to setjmp or a related function. */
+ int returns_twice;
+*************** expand_call (exp, target, ignore)
+*** 741,745 ****
+ if (stack_arg_under_construction || i >= 0)
+ {
+! rtx insn = NEXT_INSN (before_call), seq;
+
+ /* Look for a call in the inline function code.
+--- 743,749 ----
+ if (stack_arg_under_construction || i >= 0)
+ {
+! rtx first_insn
+! = before_call ? NEXT_INSN (before_call) : get_insns ();
+! rtx insn, seq;
+
+ /* Look for a call in the inline function code.
+*************** expand_call (exp, target, ignore)
+*** 749,753 ****
+
+ if (OUTGOING_ARGS_SIZE (DECL_SAVED_INSNS (fndecl)) == 0)
+! for (; insn; insn = NEXT_INSN (insn))
+ if (GET_CODE (insn) == CALL_INSN)
+ break;
+--- 753,757 ----
+
+ if (OUTGOING_ARGS_SIZE (DECL_SAVED_INSNS (fndecl)) == 0)
+! for (insn = first_insn; insn; insn = NEXT_INSN (insn))
+ if (GET_CODE (insn) == CALL_INSN)
+ break;
+*************** expand_call (exp, target, ignore)
+*** 781,785 ****
+ seq = get_insns ();
+ end_sequence ();
+! emit_insns_before (seq, NEXT_INSN (before_call));
+ emit_stack_restore (SAVE_BLOCK, old_stack_level, NULL_RTX);
+ }
+--- 785,789 ----
+ seq = get_insns ();
+ end_sequence ();
+! emit_insns_before (seq, first_insn);
+ emit_stack_restore (SAVE_BLOCK, old_stack_level, NULL_RTX);
+ }
+*************** expand_call (exp, target, ignore)
+*** 852,855 ****
+--- 856,860 ----
+ returns_twice = 0;
+ is_longjmp = 0;
++ is_malloc = 0;
+
+ if (name != 0 && IDENTIFIER_LENGTH (DECL_NAME (fndecl)) <= 15)
+*************** expand_call (exp, target, ignore)
+*** 891,894 ****
+--- 896,903 ----
+ && ! strcmp (tname, "longjmp"))
+ is_longjmp = 1;
++ /* Only recognize malloc when alias analysis is enabled. */
++ else if (tname[0] == 'm' && flag_alias_check
++ && ! strcmp(tname, "malloc"))
++ is_malloc = 1;
+ }
+
+*************** expand_call (exp, target, ignore)
+*** 1087,1090 ****
+--- 1096,1100 ----
+
+ store_expr (args[i].tree_value, copy, 0);
++ is_const = 0;
+
+ args[i].tree_value = build1 (ADDR_EXPR,
+*************** expand_call (exp, target, ignore)
+*** 1363,1367 ****
+ /* Now we are about to start emitting insns that can be deleted
+ if a libcall is deleted. */
+! if (is_const)
+ start_sequence ();
+
+--- 1373,1377 ----
+ /* Now we are about to start emitting insns that can be deleted
+ if a libcall is deleted. */
+! if (is_const || is_malloc)
+ start_sequence ();
+
+*************** expand_call (exp, target, ignore)
+*** 1951,1954 ****
+--- 1961,1978 ----
+ end_sequence ();
+ emit_insns (insns);
++ }
++ else if (is_malloc)
++ {
++ rtx temp = gen_reg_rtx (GET_MODE (valreg));
++ rtx last, insns;
++
++ emit_move_insn (temp, valreg);
++ last = get_last_insn ();
++ REG_NOTES (last) =
++ gen_rtx (EXPR_LIST, REG_NOALIAS, temp, REG_NOTES (last));
++ insns = get_insns ();
++ end_sequence ();
++ emit_insns (insns);
++ valreg = temp;
+ }
+
+diff -rcp2N gcc-2.7.2.2/cccp.c g77-new/cccp.c
+*** gcc-2.7.2.2/cccp.c Thu Oct 26 18:07:26 1995
+--- g77-new/cccp.c Sun Aug 10 18:45:53 1997
+*************** initialize_builtins (inp, outp)
+*** 9626,9629 ****
+--- 9626,9630 ----
+ so that it is present only when truly compiling with GNU C. */
+ /* install ((U_CHAR *) "__GNUC__", -1, T_CONST, "2", -1); */
++ install ((U_CHAR *) "__HAVE_BUILTIN_SETJMP__", -1, T_CONST, "1", -1);
+
+ if (debug_output)
+diff -rcp2N gcc-2.7.2.2/combine.c g77-new/combine.c
+*** gcc-2.7.2.2/combine.c Sun Nov 26 14:32:07 1995
+--- g77-new/combine.c Mon Jul 28 21:44:17 1997
+*************** num_sign_bit_copies (x, mode)
+*** 7326,7329 ****
+--- 7326,7335 ----
+
+ case NEG:
++ while (GET_MODE (XEXP (x, 0)) == GET_MODE (x)
++ && GET_CODE (XEXP (x, 0)) == NEG
++ && GET_MODE (XEXP (XEXP (x, 0), 0)) == GET_MODE (x)
++ && GET_CODE (XEXP (XEXP (x, 0), 0)) == NEG)
++ x = XEXP (XEXP (x, 0), 0); /* Speed up 961126-1.c */
++
+ /* In general, this subtracts one sign bit copy. But if the value
+ is known to be positive, the number of sign bit copies is the
+*************** distribute_notes (notes, from_insn, i3,
+*** 10648,10651 ****
+--- 10654,10658 ----
+ case REG_EQUIV:
+ case REG_NONNEG:
++ case REG_NOALIAS:
+ /* These notes say something about results of an insn. We can
+ only support them if they used to be on I3 in which case they
+diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.c g77-new/config/alpha/alpha.c
+*** gcc-2.7.2.2/config/alpha/alpha.c Thu Feb 20 19:24:11 1997
+--- g77-new/config/alpha/alpha.c Thu Jul 10 20:08:47 1997
+*************** direct_return ()
+*** 1239,1243 ****
+ cross-compiler. Otherwise, use the versions in /usr/include/stamp.h. */
+
+! #if !defined(CROSS_COMPILE) && !defined(_WIN32)
+ #include <stamp.h>
+ #endif
+--- 1239,1243 ----
+ cross-compiler. Otherwise, use the versions in /usr/include/stamp.h. */
+
+! #if !defined(CROSS_COMPILE) && !defined(_WIN32) && !defined(__linux__)
+ #include <stamp.h>
+ #endif
+*************** output_prolog (file, size)
+*** 1370,1373 ****
+--- 1370,1378 ----
+
+ alpha_function_needs_gp = 0;
++ #ifdef __linux__
++ if(profile_flag) {
++ alpha_function_needs_gp = 1;
++ }
++ #endif
+ for (insn = get_insns (); insn; insn = NEXT_INSN (insn))
+ if ((GET_CODE (insn) == CALL_INSN)
+diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.h g77-new/config/alpha/alpha.h
+*** gcc-2.7.2.2/config/alpha/alpha.h Thu Feb 20 19:24:12 1997
+--- g77-new/config/alpha/alpha.h Sun Aug 10 19:21:39 1997
+*************** extern int target_flags;
+*** 112,116 ****
+--- 112,118 ----
+ {"", TARGET_DEFAULT | TARGET_CPU_DEFAULT} }
+
++ #ifndef TARGET_DEFAULT
+ #define TARGET_DEFAULT 3
++ #endif
+
+ #ifndef TARGET_CPU_DEFAULT
+*************** extern int target_flags;
+*** 252,255 ****
+--- 254,260 ----
+ /* No data type wants to be aligned rounder than this. */
+ #define BIGGEST_ALIGNMENT 64
++
++ /* For atomic access to objects, must have at least 32-bit alignment. */
++ #define MINIMUM_ATOMIC_ALIGNMENT 32
+
+ /* Make strings word-aligned so strcpy from constants will be faster. */
+diff -rcp2N gcc-2.7.2.2/config/alpha/alpha.md g77-new/config/alpha/alpha.md
+*** gcc-2.7.2.2/config/alpha/alpha.md Fri Oct 27 06:49:59 1995
+--- g77-new/config/alpha/alpha.md Thu Jul 10 20:08:48 1997
+***************
+*** 1746,1752 ****
+ (if_then_else:DF
+ (match_operator 3 "signed_comparison_operator"
+! [(match_operand:DF 1 "reg_or_fp0_operand" "fG,fG")
+ (match_operand:DF 2 "fp0_operand" "G,G")])
+! (float_extend:DF (match_operand:SF 4 "reg_or_fp0_operand" "fG,0"))
+ (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))]
+ "TARGET_FP"
+--- 1746,1752 ----
+ (if_then_else:DF
+ (match_operator 3 "signed_comparison_operator"
+! [(match_operand:DF 4 "reg_or_fp0_operand" "fG,fG")
+ (match_operand:DF 2 "fp0_operand" "G,G")])
+! (float_extend:DF (match_operand:SF 1 "reg_or_fp0_operand" "fG,0"))
+ (match_operand:DF 5 "reg_or_fp0_operand" "0,fG")))]
+ "TARGET_FP"
+diff -rcp2N gcc-2.7.2.2/config/alpha/elf.h g77-new/config/alpha/elf.h
+*** gcc-2.7.2.2/config/alpha/elf.h Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/elf.h Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,522 ----
++ /* Definitions of target machine for GNU compiler, for DEC Alpha w/ELF.
++ Copyright (C) 1996 Free Software Foundation, Inc.
++ Contributed by Richard Henderson (rth@tamu.edu).
++
++ This file is part of GNU CC.
++
++ GNU CC 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 CC 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 CC; see the file COPYING. If not, write to
++ the Free Software Foundation, 59 Temple Place - Suite 330,
++ Boston, MA 02111-1307, USA. */
++
++ /* This is used on Alpha platforms that use the ELF format.
++ Currently only Linux uses this. */
++
++ #include "alpha/linux.h"
++
++ #undef TARGET_VERSION
++ #define TARGET_VERSION fprintf (stderr, " (Alpha Linux/ELF)");
++
++ #undef OBJECT_FORMAT_COFF
++ #undef EXTENDED_COFF
++ #define OBJECT_FORMAT_ELF
++
++ #define SDB_DEBUGGING_INFO
++
++ #undef ASM_FINAL_SPEC
++
++ #undef CPP_PREDEFINES
++ #define CPP_PREDEFINES "\
++ -D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \
++ -Asystem(linux) -Acpu(alpha) -Amachine(alpha) -D__ELF__"
++
++ #undef LINK_SPEC
++ #define LINK_SPEC "-m elf64alpha -G 8 %{O*:-O3} %{!O*:-O1} \
++ %{shared:-shared} \
++ %{!shared: \
++ %{!static: \
++ %{rdynamic:-export-dynamic} \
++ %{!dynamic-linker:-dynamic-linker /lib/ld.so.1}} \
++ %{static:-static}}"
++
++ /* Output at beginning of assembler file. */
++
++ #undef ASM_FILE_START
++ #define ASM_FILE_START(FILE) \
++ { \
++ alpha_write_verstamp (FILE); \
++ output_file_directive (FILE, main_input_filename); \
++ fprintf (FILE, "\t.version\t\"01.01\"\n"); \
++ fprintf (FILE, "\t.set noat\n"); \
++ }
++
++ #define ASM_OUTPUT_SOURCE_LINE(STREAM, LINE) \
++ alpha_output_lineno (STREAM, LINE)
++ extern void alpha_output_lineno ();
++
++ extern void output_file_directive ();
++
++ /* Attach a special .ident directive to the end of the file to identify
++ the version of GCC which compiled this code. The format of the
++ .ident string is patterned after the ones produced by native svr4
++ C compilers. */
++
++ #define IDENT_ASM_OP ".ident"
++
++ #ifdef IDENTIFY_WITH_IDENT
++ #define ASM_IDENTIFY_GCC(FILE) /* nothing */
++ #define ASM_IDENTIFY_LANGUAGE(FILE) \
++ fprintf(FILE, "\t%s \"GCC (%s) %s\"\n", IDENT_ASM_OP, \
++ lang_identify(), version_string)
++ #else
++ #define ASM_FILE_END(FILE) \
++ do { \
++ fprintf ((FILE), "\t%s\t\"GCC: (GNU) %s\"\n", \
++ IDENT_ASM_OP, version_string); \
++ } while (0)
++ #endif
++
++ /* Allow #sccs in preprocessor. */
++
++ #define SCCS_DIRECTIVE
++
++ /* Output #ident as a .ident. */
++
++ #define ASM_OUTPUT_IDENT(FILE, NAME) \
++ fprintf (FILE, "\t%s\t\"%s\"\n", IDENT_ASM_OP, NAME);
++
++ /* This is how to allocate empty space in some section. The .zero
++ pseudo-op is used for this on most svr4 assemblers. */
++
++ #define SKIP_ASM_OP ".zero"
++
++ #undef ASM_OUTPUT_SKIP
++ #define ASM_OUTPUT_SKIP(FILE,SIZE) \
++ fprintf (FILE, "\t%s\t%u\n", SKIP_ASM_OP, (SIZE))
++
++ /* Output the label which precedes a jumptable. Note that for all svr4
++ systems where we actually generate jumptables (which is to say every
++ svr4 target except i386, where we use casesi instead) we put the jump-
++ tables into the .rodata section and since other stuff could have been
++ put into the .rodata section prior to any given jumptable, we have to
++ make sure that the location counter for the .rodata section gets pro-
++ perly re-aligned prior to the actual beginning of the jump table. */
++
++ #define ALIGN_ASM_OP ".align"
++
++ #ifndef ASM_OUTPUT_BEFORE_CASE_LABEL
++ #define ASM_OUTPUT_BEFORE_CASE_LABEL(FILE,PREFIX,NUM,TABLE) \
++ ASM_OUTPUT_ALIGN ((FILE), 2);
++ #endif
++
++ #undef ASM_OUTPUT_CASE_LABEL
++ #define ASM_OUTPUT_CASE_LABEL(FILE,PREFIX,NUM,JUMPTABLE) \
++ do { \
++ ASM_OUTPUT_BEFORE_CASE_LABEL (FILE, PREFIX, NUM, JUMPTABLE) \
++ ASM_OUTPUT_INTERNAL_LABEL (FILE, PREFIX, NUM); \
++ } while (0)
++
++ /* The standard SVR4 assembler seems to require that certain builtin
++ library routines (e.g. .udiv) be explicitly declared as .globl
++ in each assembly file where they are referenced. */
++
++ #define ASM_OUTPUT_EXTERNAL_LIBCALL(FILE, FUN) \
++ ASM_GLOBALIZE_LABEL (FILE, XSTR (FUN, 0))
++
++ /* This says how to output assembler code to declare an
++ uninitialized external linkage data object. Under SVR4,
++ the linker seems to want the alignment of data objects
++ to depend on their types. We do exactly that here. */
++
++ #define COMMON_ASM_OP ".comm"
++
++ #undef ASM_OUTPUT_ALIGNED_COMMON
++ #define ASM_OUTPUT_ALIGNED_COMMON(FILE, NAME, SIZE, ALIGN) \
++ do { \
++ fprintf ((FILE), "\t%s\t", COMMON_ASM_OP); \
++ assemble_name ((FILE), (NAME)); \
++ fprintf ((FILE), ",%u,%u\n", (SIZE), (ALIGN) / BITS_PER_UNIT); \
++ } while (0)
++
++ /* This says how to output assembler code to declare an
++ uninitialized internal linkage data object. Under SVR4,
++ the linker seems to want the alignment of data objects
++ to depend on their types. We do exactly that here. */
++
++ #define LOCAL_ASM_OP ".local"
++
++ #undef ASM_OUTPUT_ALIGNED_LOCAL
++ #define ASM_OUTPUT_ALIGNED_LOCAL(FILE, NAME, SIZE, ALIGN) \
++ do { \
++ fprintf ((FILE), "\t%s\t", LOCAL_ASM_OP); \
++ assemble_name ((FILE), (NAME)); \
++ fprintf ((FILE), "\n"); \
++ ASM_OUTPUT_ALIGNED_COMMON (FILE, NAME, SIZE, ALIGN); \
++ } while (0)
++
++ /* This is the pseudo-op used to generate a 64-bit word of data with a
++ specific value in some section. */
++
++ #define INT_ASM_OP ".quad"
++
++ /* This is the pseudo-op used to generate a contiguous sequence of byte
++ values from a double-quoted string WITHOUT HAVING A TERMINATING NUL
++ AUTOMATICALLY APPENDED. This is the same for most svr4 assemblers. */
++
++ #undef ASCII_DATA_ASM_OP
++ #define ASCII_DATA_ASM_OP ".ascii"
++
++ /* Support const sections and the ctors and dtors sections for g++.
++ Note that there appears to be two different ways to support const
++ sections at the moment. You can either #define the symbol
++ READONLY_DATA_SECTION (giving it some code which switches to the
++ readonly data section) or else you can #define the symbols
++ EXTRA_SECTIONS, EXTRA_SECTION_FUNCTIONS, SELECT_SECTION, and
++ SELECT_RTX_SECTION. We do both here just to be on the safe side. */
++
++ #define USE_CONST_SECTION 1
++
++ #define CONST_SECTION_ASM_OP ".section\t.rodata"
++
++ /* Define the pseudo-ops used to switch to the .ctors and .dtors sections.
++
++ Note that we want to give these sections the SHF_WRITE attribute
++ because these sections will actually contain data (i.e. tables of
++ addresses of functions in the current root executable or shared library
++ file) and, in the case of a shared library, the relocatable addresses
++ will have to be properly resolved/relocated (and then written into) by
++ the dynamic linker when it actually attaches the given shared library
++ to the executing process. (Note that on SVR4, you may wish to use the
++ `-z text' option to the ELF linker, when building a shared library, as
++ an additional check that you are doing everything right. But if you do
++ use the `-z text' option when building a shared library, you will get
++ errors unless the .ctors and .dtors sections are marked as writable
++ via the SHF_WRITE attribute.) */
++
++ #define CTORS_SECTION_ASM_OP ".section\t.ctors,\"aw\""
++ #define DTORS_SECTION_ASM_OP ".section\t.dtors,\"aw\""
++
++ /* On svr4, we *do* have support for the .init and .fini sections, and we
++ can put stuff in there to be executed before and after `main'. We let
++ crtstuff.c and other files know this by defining the following symbols.
++ The definitions say how to change sections to the .init and .fini
++ sections. This is the same for all known svr4 assemblers. */
++
++ #define INIT_SECTION_ASM_OP ".section\t.init"
++ #define FINI_SECTION_ASM_OP ".section\t.fini"
++
++ /* Support non-common, uninitialized data in the .bss section. */
++
++ #define BSS_SECTION_ASM_OP ".section\t.bss"
++
++ /* A default list of other sections which we might be "in" at any given
++ time. For targets that use additional sections (e.g. .tdesc) you
++ should override this definition in the target-specific file which
++ includes this file. */
++
++ #undef EXTRA_SECTIONS
++ #define EXTRA_SECTIONS in_const, in_ctors, in_dtors, in_bss
++
++ /* A default list of extra section function definitions. For targets
++ that use additional sections (e.g. .tdesc) you should override this
++ definition in the target-specific file which includes this file. */
++
++ #undef EXTRA_SECTION_FUNCTIONS
++ #define EXTRA_SECTION_FUNCTIONS \
++ CONST_SECTION_FUNCTION \
++ CTORS_SECTION_FUNCTION \
++ DTORS_SECTION_FUNCTION \
++ BSS_SECTION_FUNCTION
++
++ #undef READONLY_DATA_SECTION
++ #define READONLY_DATA_SECTION() const_section ()
++
++ extern void text_section ();
++
++ #define CONST_SECTION_FUNCTION \
++ void \
++ const_section () \
++ { \
++ if (!USE_CONST_SECTION) \
++ text_section(); \
++ else if (in_section != in_const) \
++ { \
++ fprintf (asm_out_file, "%s\n", CONST_SECTION_ASM_OP); \
++ in_section = in_const; \
++ } \
++ }
++
++ #define CTORS_SECTION_FUNCTION \
++ void \
++ ctors_section () \
++ { \
++ if (in_section != in_ctors) \
++ { \
++ fprintf (asm_out_file, "%s\n", CTORS_SECTION_ASM_OP); \
++ in_section = in_ctors; \
++ } \
++ }
++
++ #define DTORS_SECTION_FUNCTION \
++ void \
++ dtors_section () \
++ { \
++ if (in_section != in_dtors) \
++ { \
++ fprintf (asm_out_file, "%s\n", DTORS_SECTION_ASM_OP); \
++ in_section = in_dtors; \
++ } \
++ }
++
++ #define BSS_SECTION_FUNCTION \
++ void \
++ bss_section () \
++ { \
++ if (in_section != in_bss) \
++ { \
++ fprintf (asm_out_file, "%s\n", BSS_SECTION_ASM_OP); \
++ in_section = in_bss; \
++ } \
++ }
++
++
++ /* Switch into a generic section.
++ This is currently only used to support section attributes.
++
++ We make the section read-only and executable for a function decl,
++ read-only for a const data decl, and writable for a non-const data decl. */
++ #define ASM_OUTPUT_SECTION_NAME(FILE, DECL, NAME) \
++ fprintf (FILE, ".section\t%s,\"%s\",@progbits\n", NAME, \
++ (DECL) && TREE_CODE (DECL) == FUNCTION_DECL ? "ax" : \
++ (DECL) && TREE_READONLY (DECL) ? "a" : "aw")
++
++
++ /* A C statement (sans semicolon) to output an element in the table of
++ global constructors. */
++ #define ASM_OUTPUT_CONSTRUCTOR(FILE,NAME) \
++ do { \
++ ctors_section (); \
++ fprintf (FILE, "\t%s\t ", INT_ASM_OP); \
++ assemble_name (FILE, NAME); \
++ fprintf (FILE, "\n"); \
++ } while (0)
++
++ /* A C statement (sans semicolon) to output an element in the table of
++ global destructors. */
++ #define ASM_OUTPUT_DESTRUCTOR(FILE,NAME) \
++ do { \
++ dtors_section (); \
++ fprintf (FILE, "\t%s\t ", INT_ASM_OP); \
++ assemble_name (FILE, NAME); \
++ fprintf (FILE, "\n"); \
++ } while (0)
++
++ /* A C statement or statements to switch to the appropriate
++ section for output of DECL. DECL is either a `VAR_DECL' node
++ or a constant of some sort. RELOC indicates whether forming
++ the initial value of DECL requires link-time relocations. */
++
++ #define SELECT_SECTION(DECL,RELOC) \
++ { \
++ if (TREE_CODE (DECL) == STRING_CST) \
++ { \
++ if (! flag_writable_strings) \
++ const_section (); \
++ else \
++ data_section (); \
++ } \
++ else if (TREE_CODE (DECL) == VAR_DECL) \
++ { \
++ if ((flag_pic && RELOC) \
++ || !TREE_READONLY (DECL) || TREE_SIDE_EFFECTS (DECL) \
++ || !DECL_INITIAL (DECL) \
++ || (DECL_INITIAL (DECL) != error_mark_node \
++ && !TREE_CONSTANT (DECL_INITIAL (DECL)))) \
++ { \
++ if (DECL_COMMON (DECL) \
++ && !DECL_INITIAL (DECL)) \
++ /* || DECL_INITIAL (DECL) == error_mark_node)) */ \
++ bss_section(); \
++ else \
++ data_section (); \
++ } \
++ else \
++ const_section (); \
++ } \
++ else \
++ const_section (); \
++ }
++
++ /* A C statement or statements to switch to the appropriate
++ section for output of RTX in mode MODE. RTX is some kind
++ of constant in RTL. The argument MODE is redundant except
++ in the case of a `const_int' rtx. Currently, these always
++ go into the const section. */
++
++ #undef SELECT_RTX_SECTION
++ #define SELECT_RTX_SECTION(MODE,RTX) const_section()
++
++ /* Define the strings used for the special svr4 .type and .size directives.
++ These strings generally do not vary from one system running svr4 to
++ another, but if a given system (e.g. m88k running svr) needs to use
++ different pseudo-op names for these, they may be overridden in the
++ file which includes this one. */
++
++ #define TYPE_ASM_OP ".type"
++ #define SIZE_ASM_OP ".size"
++
++ /* This is how we tell the assembler that a symbol is weak. */
++
++ #define ASM_WEAKEN_LABEL(FILE,NAME) \
++ do { fputs ("\t.weak\t", FILE); assemble_name (FILE, NAME); \
++ fputc ('\n', FILE); } while (0)
++
++ /* This is how we tell the assembler that two symbols have the same value. */
++
++ #define ASM_OUTPUT_DEF(FILE,NAME1,NAME2) \
++ do { assemble_name(FILE, NAME1); \
++ fputs(" = ", FILE); \
++ assemble_name(FILE, NAME2); \
++ fputc('\n', FILE); } while (0)
++
++ /* The following macro defines the format used to output the second
++ operand of the .type assembler directive. Different svr4 assemblers
++ expect various different forms for this operand. The one given here
++ is just a default. You may need to override it in your machine-
++ specific tm.h file (depending upon the particulars of your assembler). */
++
++ #define TYPE_OPERAND_FMT "@%s"
++
++ /* Write the extra assembler code needed to declare a function's result.
++ Most svr4 assemblers don't require any special declaration of the
++ result value, but there are exceptions. */
++
++ #ifndef ASM_DECLARE_RESULT
++ #define ASM_DECLARE_RESULT(FILE, RESULT)
++ #endif
++
++ /* These macros generate the special .type and .size directives which
++ are used to set the corresponding fields of the linker symbol table
++ entries in an ELF object file under SVR4. These macros also output
++ the starting labels for the relevant functions/objects. */
++
++ /* Write the extra assembler code needed to declare an object properly. */
++
++ #define ASM_DECLARE_OBJECT_NAME(FILE, NAME, DECL) \
++ do { \
++ fprintf (FILE, "\t%s\t ", TYPE_ASM_OP); \
++ assemble_name (FILE, NAME); \
++ putc (',', FILE); \
++ fprintf (FILE, TYPE_OPERAND_FMT, "object"); \
++ putc ('\n', FILE); \
++ size_directive_output = 0; \
++ if (!flag_inhibit_size_directive && DECL_SIZE (DECL)) \
++ { \
++ size_directive_output = 1; \
++ fprintf (FILE, "\t%s\t ", SIZE_ASM_OP); \
++ assemble_name (FILE, NAME); \
++ fprintf (FILE, ",%d\n", int_size_in_bytes (TREE_TYPE (DECL))); \
++ } \
++ ASM_OUTPUT_LABEL(FILE, NAME); \
++ } while (0)
++
++ /* Output the size directive for a decl in rest_of_decl_compilation
++ in the case where we did not do so before the initializer.
++ Once we find the error_mark_node, we know that the value of
++ size_directive_output was set
++ by ASM_DECLARE_OBJECT_NAME when it was run for the same decl. */
++
++ #define ASM_FINISH_DECLARE_OBJECT(FILE, DECL, TOP_LEVEL, AT_END) \
++ do { \
++ char *name = XSTR (XEXP (DECL_RTL (DECL), 0), 0); \
++ if (!flag_inhibit_size_directive && DECL_SIZE (DECL) \
++ && ! AT_END && TOP_LEVEL \
++ && DECL_INITIAL (DECL) == error_mark_node \
++ && !size_directive_output) \
++ { \
++ size_directive_output = 1; \
++ fprintf (FILE, "\t%s\t ", SIZE_ASM_OP); \
++ assemble_name (FILE, name); \
++ fprintf (FILE, ",%d\n", int_size_in_bytes (TREE_TYPE (DECL))); \
++ } \
++ } while (0)
++
++ /* A table of bytes codes used by the ASM_OUTPUT_ASCII and
++ ASM_OUTPUT_LIMITED_STRING macros. Each byte in the table
++ corresponds to a particular byte value [0..255]. For any
++ given byte value, if the value in the corresponding table
++ position is zero, the given character can be output directly.
++ If the table value is 1, the byte must be output as a \ooo
++ octal escape. If the tables value is anything else, then the
++ byte value should be output as a \ followed by the value
++ in the table. Note that we can use standard UN*X escape
++ sequences for many control characters, but we don't use
++ \a to represent BEL because some svr4 assemblers (e.g. on
++ the i386) don't know about that. Also, we don't use \v
++ since some versions of gas, such as 2.2 did not accept it. */
++
++ #define ESCAPES \
++ "\1\1\1\1\1\1\1\1btn\1fr\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\
++ \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\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\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\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\1\
++ \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\
++ \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\
++ \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\
++ \1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1\1"
++
++ /* Some svr4 assemblers have a limit on the number of characters which
++ can appear in the operand of a .string directive. If your assembler
++ has such a limitation, you should define STRING_LIMIT to reflect that
++ limit. Note that at least some svr4 assemblers have a limit on the
++ actual number of bytes in the double-quoted string, and that they
++ count each character in an escape sequence as one byte. Thus, an
++ escape sequence like \377 would count as four bytes.
++
++ If your target assembler doesn't support the .string directive, you
++ should define this to zero.
++ */
++
++ #define STRING_LIMIT ((unsigned) 256)
++
++ #define STRING_ASM_OP ".string"
++
++ /*
++ * We always use gas here, so we don't worry about ECOFF assembler problems.
++ */
++ #undef TARGET_GAS
++ #define TARGET_GAS (1)
++
++ #undef PREFERRED_DEBUGGING_TYPE
++ #define PREFERRED_DEBUGGING_TYPE DBX_DEBUG
++
++ /* Provide a STARTFILE_SPEC appropriate for Linux. Here we add
++ the Linux magical crtbegin.o file (see crtstuff.c) which
++ provides part of the support for getting C++ file-scope static
++ object constructed before entering `main'. */
++
++ #undef STARTFILE_SPEC
++ #define STARTFILE_SPEC \
++ "%{!shared: \
++ %{pg:gcrt1.o%s} %{!pg:%{p:gcrt1.o%s} %{!p:crt1.o%s}}}\
++ crti.o%s crtbegin.o%s"
++
++ /* Provide a ENDFILE_SPEC appropriate for Linux. Here we tack on
++ the Linux magical crtend.o file (see crtstuff.c) which
++ provides part of the support for getting C++ file-scope static
++ object constructed before entering `main', followed by a normal
++ Linux "finalizer" file, `crtn.o'. */
++
++ #undef ENDFILE_SPEC
++ #define ENDFILE_SPEC \
++ "crtend.o%s crtn.o%s"
+diff -rcp2N gcc-2.7.2.2/config/alpha/linux.h g77-new/config/alpha/linux.h
+*** gcc-2.7.2.2/config/alpha/linux.h Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/linux.h Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,72 ----
++ /* Definitions of target machine for GNU compiler, for Alpha Linux,
++ using ECOFF.
++ Copyright (C) 1995 Free Software Foundation, Inc.
++ Contributed by Bob Manson.
++ Derived from work contributed by Cygnus Support,
++ (c) 1993 Free Software Foundation.
++
++ This file is part of GNU CC.
++
++ GNU CC 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 CC 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 CC; see the file COPYING. If not, write to
++ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
++
++ #define TARGET_DEFAULT (3 | MASK_GAS)
++
++ #include "alpha/alpha.h"
++
++ #undef TARGET_VERSION
++ #define TARGET_VERSION fprintf (stderr, " (Linux/Alpha)");
++
++ #undef CPP_PREDEFINES
++ #define CPP_PREDEFINES "\
++ -D__alpha -D__alpha__ -D__linux__ -D__linux -D_LONGLONG -Dlinux -Dunix \
++ -Asystem(linux) -Acpu(alpha) -Amachine(alpha)"
++
++ /* We don't actually need any of these; the MD_ vars are ignored
++ anyway for cross-compilers, and the other specs won't get picked up
++ 'coz the user is supposed to do ld -r (hmm, perhaps that should be
++ the default). In any case, setting them thus will catch some
++ common user errors. */
++
++ #undef MD_EXEC_PREFIX
++ #undef MD_STARTFILE_PREFIX
++
++ #undef LIB_SPEC
++ #define LIB_SPEC "%{pg:-lgmon} %{pg:-lc_p} %{!pg:-lc}"
++
++ #undef LINK_SPEC
++ #define LINK_SPEC \
++ "-G 8 %{O*:-O3} %{!O*:-O1}"
++
++ #undef ASM_SPEC
++ #define ASM_SPEC "-nocpp"
++
++ /* Can't do stabs */
++ #undef SDB_DEBUGGING_INFO
++
++ /* Prefer dbx. */
++ #undef PREFERRED_DEBUGGING_TYPE
++ #define PREFERRED_DEBUGGING_TYPE DBX_DEBUG
++
++ #undef FUNCTION_PROFILER
++
++ #define FUNCTION_PROFILER(FILE, LABELNO) \
++ do { \
++ fputs ("\tlda $27,_mcount\n", (FILE)); \
++ fputs ("\tjsr $26,($27),_mcount\n", (FILE)); \
++ fputs ("\tldgp $29,0($26)\n", (FILE)); \
++ } while (0);
++
++ /* Generate calls to memcpy, etc., not bcopy, etc. */
++ #define TARGET_MEM_FUNCTIONS
+diff -rcp2N gcc-2.7.2.2/config/alpha/t-linux g77-new/config/alpha/t-linux
+*** gcc-2.7.2.2/config/alpha/t-linux Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/t-linux Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,3 ----
++ # Our header files are supposed to be correct, nein?
++ FIXINCLUDES =
++ STMP_FIXPROTO =
+diff -rcp2N gcc-2.7.2.2/config/alpha/x-linux g77-new/config/alpha/x-linux
+*** gcc-2.7.2.2/config/alpha/x-linux Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/x-linux Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1 ----
++ CLIB=-lbfd -liberty
+diff -rcp2N gcc-2.7.2.2/config/alpha/xm-alpha.h g77-new/config/alpha/xm-alpha.h
+*** gcc-2.7.2.2/config/alpha/xm-alpha.h Thu Aug 31 17:52:27 1995
+--- g77-new/config/alpha/xm-alpha.h Thu Jul 10 20:08:49 1997
+*************** Boston, MA 02111-1307, USA. */
+*** 46,51 ****
+--- 46,53 ----
+ #include <alloca.h>
+ #else
++ #ifndef alloca
+ extern void *alloca ();
+ #endif
++ #endif
+
+ /* The host compiler has problems with enum bitfields since it makes
+*************** extern void *malloc (), *realloc (), *ca
+*** 68,72 ****
+--- 70,76 ----
+ /* OSF/1 has vprintf. */
+
++ #ifndef linux /* 1996/02/22 mauro@craftwork.com -- unreliable with Linux */
+ #define HAVE_VPRINTF
++ #endif
+
+ /* OSF/1 has putenv. */
+diff -rcp2N gcc-2.7.2.2/config/alpha/xm-linux.h g77-new/config/alpha/xm-linux.h
+*** gcc-2.7.2.2/config/alpha/xm-linux.h Wed Dec 31 19:00:00 1969
+--- g77-new/config/alpha/xm-linux.h Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,10 ----
++ #ifndef _XM_LINUX_H
++ #define _XM_LINUX_H
++
++ #include "xm-alpha.h"
++
++ #define HAVE_STRERROR
++
++ #define DONT_DECLARE_SYS_SIGLIST
++ #define USE_BFD
++ #endif
+diff -rcp2N gcc-2.7.2.2/config/i386/i386.c g77-new/config/i386/i386.c
+*** gcc-2.7.2.2/config/i386/i386.c Sun Oct 22 07:13:21 1995
+--- g77-new/config/i386/i386.c Sun Aug 10 18:46:09 1997
+*************** standard_80387_constant_p (x)
+*** 1290,1294 ****
+ set_float_handler (handler);
+ REAL_VALUE_FROM_CONST_DOUBLE (d, x);
+! is0 = REAL_VALUES_EQUAL (d, dconst0);
+ is1 = REAL_VALUES_EQUAL (d, dconst1);
+ set_float_handler (NULL_PTR);
+--- 1290,1294 ----
+ set_float_handler (handler);
+ REAL_VALUE_FROM_CONST_DOUBLE (d, x);
+! is0 = REAL_VALUES_EQUAL (d, dconst0) && !REAL_VALUE_MINUS_ZERO (d);
+ is1 = REAL_VALUES_EQUAL (d, dconst1);
+ set_float_handler (NULL_PTR);
+diff -rcp2N gcc-2.7.2.2/config/mips/mips.c g77-new/config/mips/mips.c
+*** gcc-2.7.2.2/config/mips/mips.c Thu Feb 20 19:24:13 1997
+--- g77-new/config/mips/mips.c Sun Aug 10 18:45:43 1997
+*************** expand_block_move (operands)
+*** 2360,2365 ****
+
+ else if (constp && bytes <= 2*MAX_MOVE_BYTES)
+! emit_insn (gen_movstrsi_internal (gen_rtx (MEM, BLKmode, dest_reg),
+! gen_rtx (MEM, BLKmode, src_reg),
+ bytes_rtx, align_rtx));
+
+--- 2360,2367 ----
+
+ else if (constp && bytes <= 2*MAX_MOVE_BYTES)
+! emit_insn (gen_movstrsi_internal (change_address (operands[0],
+! BLKmode, dest_reg),
+! change_address (orig_src, BLKmode,
+! src_reg),
+ bytes_rtx, align_rtx));
+
+diff -rcp2N gcc-2.7.2.2/config/mips/mips.h g77-new/config/mips/mips.h
+*** gcc-2.7.2.2/config/mips/mips.h Thu Nov 9 11:23:09 1995
+--- g77-new/config/mips/mips.h Sun Aug 10 18:46:44 1997
+*************** typedef struct mips_args {
+*** 2160,2170 ****
+ } \
+ \
+! /* Flush the instruction cache. */ \
+! /* ??? Are the modes right? Maybe they should depend on -mint64/-mlong64? */\
+ /* ??? Should check the return value for errors. */ \
+! emit_library_call (gen_rtx (SYMBOL_REF, Pmode, "cacheflush"), \
+ 0, VOIDmode, 3, addr, Pmode, \
+ GEN_INT (TRAMPOLINE_SIZE), SImode, \
+! GEN_INT (1), SImode); \
+ }
+
+--- 2160,2170 ----
+ } \
+ \
+! /* Flush both caches. We need to flush the data cache in case \
+! the system has a write-back cache. */ \
+ /* ??? Should check the return value for errors. */ \
+! emit_library_call (gen_rtx (SYMBOL_REF, Pmode, "_flush_cache"), \
+ 0, VOIDmode, 3, addr, Pmode, \
+ GEN_INT (TRAMPOLINE_SIZE), SImode, \
+! GEN_INT (3), TYPE_MODE (integer_type_node)); \
+ }
+
+*************** typedef struct mips_args {
+*** 2388,2392 ****
+ ((GET_CODE (X) != CONST_DOUBLE \
+ || mips_const_double_ok (X, GET_MODE (X))) \
+! && ! (GET_CODE (X) == CONST && ABI_64BIT))
+
+ /* A C compound statement that attempts to replace X with a valid
+--- 2388,2393 ----
+ ((GET_CODE (X) != CONST_DOUBLE \
+ || mips_const_double_ok (X, GET_MODE (X))) \
+! && ! (GET_CODE (X) == CONST \
+! && (ABI_64BIT || GET_CODE (XEXP (X, 0)) == MINUS)))
+
+ /* A C compound statement that attempts to replace X with a valid
+diff -rcp2N gcc-2.7.2.2/config/mips/sni-gas.h g77-new/config/mips/sni-gas.h
+*** gcc-2.7.2.2/config/mips/sni-gas.h Wed Dec 31 19:00:00 1969
+--- g77-new/config/mips/sni-gas.h Sun Aug 10 18:46:33 1997
+***************
+*** 0 ****
+--- 1,43 ----
++ #include "mips/sni-svr4.h"
++
++ /* Enable debugging. */
++ #define DBX_DEBUGGING_INFO
++ #define SDB_DEBUGGING_INFO
++ #define MIPS_DEBUGGING_INFO
++
++ #define DWARF_DEBUGGING_INFO
++ #undef PREFERRED_DEBUGGING_TYPE
++ #define PREFERRED_DEBUGGING_TYPE DWARF_DEBUG
++
++ /* We need to use .esize and .etype instead of .size and .type to
++ avoid conflicting with ELF directives. These are only recognized
++ by gas, anyhow, not the native assembler. */
++ #undef PUT_SDB_SIZE
++ #define PUT_SDB_SIZE(a) \
++ do { \
++ extern FILE *asm_out_text_file; \
++ fprintf (asm_out_text_file, "\t.esize\t%d;", (a)); \
++ } while (0)
++
++ #undef PUT_SDB_TYPE
++ #define PUT_SDB_TYPE(a) \
++ do { \
++ extern FILE *asm_out_text_file; \
++ fprintf (asm_out_text_file, "\t.etype\t0x%x;", (a)); \
++ } while (0)
++
++
++ /* This is how to equate one symbol to another symbol. The syntax used is
++ `SYM1=SYM2'. Note that this is different from the way equates are done
++ with most svr4 assemblers, where the syntax is `.set SYM1,SYM2'. */
++
++ #define ASM_OUTPUT_DEF(FILE,LABEL1,LABEL2) \
++ do { fprintf ((FILE), "\t"); \
++ assemble_name (FILE, LABEL1); \
++ fprintf (FILE, " = "); \
++ assemble_name (FILE, LABEL2); \
++ fprintf (FILE, "\n"); \
++ } while (0)
++
++
++
+diff -rcp2N gcc-2.7.2.2/config/mips/sni-svr4.h g77-new/config/mips/sni-svr4.h
+*** gcc-2.7.2.2/config/mips/sni-svr4.h Wed Dec 31 19:00:00 1969
+--- g77-new/config/mips/sni-svr4.h Sun Aug 10 18:46:33 1997
+***************
+*** 0 ****
+--- 1,103 ----
++ /* Definitions of target machine for GNU compiler. SNI SINIX version.
++ Copyright (C) 1996 Free Software Foundation, Inc.
++ Contributed by Marco Walther (Marco.Walther@mch.sni.de).
++
++ This file is part of GNU CC.
++
++ GNU CC 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 CC 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 CC; see the file COPYING. If not, write to
++ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
++
++ #define MIPS_SVR4
++
++ #define CPP_PREDEFINES "\
++ -Dmips -Dunix -Dhost_mips -DMIPSEB -DR3000 -DSYSTYPE_SVR4 \
++ -D_mips -D_unix -D_host_mips -D_MIPSEB -D_R3000 -D_SYSTYPE_SVR4 \
++ -Asystem(unix) -Asystem(svr4) -Acpu(mips) -Amachine(mips)"
++
++ #define CPP_SPEC "\
++ %{.cc: -D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \
++ %{.cxx: -D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \
++ %{.C: -D__LANGUAGE_C_PLUS_PLUS -D_LANGUAGE_C_PLUS_PLUS} \
++ %{.m: -D__LANGUAGE_OBJECTIVE_C -D_LANGUAGE_OBJECTIVE_C} \
++ %{.S: -D__LANGUAGE_ASSEMBLY -D_LANGUAGE_ASSEMBLY %{!ansi:-DLANGUAGE_ASSEMBLY}} \
++ %{.s: -D__LANGUAGE_ASSEMBLY -D_LANGUAGE_ASSEMBLY %{!ansi:-DLANGUAGE_ASSEMBLY}} \
++ %{!.S:%{!.s: -D__LANGUAGE_C -D_LANGUAGE_C %{!ansi:-DLANGUAGE_C}}} \
++ -D__SIZE_TYPE__=unsigned\\ int -D__PTRDIFF_TYPE__=int"
++
++ #define LINK_SPEC "\
++ %{G*} \
++ %{!mgas: \
++ %{dy} %{dn}}"
++
++ #define LIB_SPEC "\
++ %{p:-lprof1} \
++ %{!p:%{pg:-lprof1} \
++ %{!pg:-L/usr/ccs/lib/ -lc /usr/ccs/lib/crtn.o%s}}"
++
++ #define STARTFILE_SPEC "\
++ %{pg:gcrt0.o%s} \
++ %{!pg:%{p:mcrt0.o%s} \
++ %{!p:/usr/ccs/lib/crt1.o /usr/ccs/lib/crti.o /usr/ccs/lib/values-Xt.o%s}}"
++
++ /* Mips System V.4 doesn't have a getpagesize() function needed by the
++ trampoline code, so use the POSIX sysconf function to get it.
++ This is only done when compiling the trampoline code. */
++
++ #ifdef L_trampoline
++ #include <unistd.h>
++
++ #define getpagesize() sysconf(_SC_PAGE_SIZE)
++ #endif /* L_trampoline */
++
++ /* Use atexit for static constructors/destructors, instead of defining
++ our own exit function. */
++ #define HAVE_ATEXIT
++
++ /* Generate calls to memcpy, etc., not bcopy, etc. */
++ #define TARGET_MEM_FUNCTIONS
++
++ #define OBJECT_FORMAT_ELF
++
++ #define TARGET_DEFAULT MASK_ABICALLS
++ #define ABICALLS_ASM_OP ".option pic2"
++
++ #define MACHINE_TYPE "SNI running SINIX 5.42"
++
++ #define MIPS_DEFAULT_GVALUE 0
++
++ #define NM_FLAGS "-p"
++
++ /* wir haben ein Problem, wenn in einem Assembler-File keine .text-section
++ erzeugt wird. Dann landen diese Pseudo-Labels in irgendeiner anderen
++ section, z.B. .reginfo. Das macht den ld sehr ungluecklich. */
++
++ #define ASM_IDENTIFY_GCC(mw_stream) \
++ fprintf(mw_stream, "\t.ident \"gcc2_compiled.\"\n");
++
++ #define ASM_IDENTIFY_LANGUAGE(STREAM)
++
++ #define ASM_LONG ".word\t"
++ #define ASM_GLOBAL ".rdata\n\t\t.globl\t"
++
++ #include "mips/mips.h"
++
++ /* We do not want to run mips-tfile! */
++ #undef ASM_FINAL_SPEC
++
++ #undef OBJECT_FORMAT_COFF
++
++ /* We don't support debugging info for now. */
++ #undef DBX_DEBUGGING_INFO
++ #undef SDB_DEBUGGING_INFO
++ #undef MIPS_DEBUGGING_INFO
+diff -rcp2N gcc-2.7.2.2/config/mips/x-sni-svr4 g77-new/config/mips/x-sni-svr4
+*** gcc-2.7.2.2/config/mips/x-sni-svr4 Wed Dec 31 19:00:00 1969
+--- g77-new/config/mips/x-sni-svr4 Sun Aug 10 18:46:33 1997
+***************
+*** 0 ****
+--- 1,18 ----
++ # Define CC and OLDCC as the same, so that the tests:
++ # if [ x"$(OLDCC)" = x"$(CC)" ] ...
++ #
++ # will succeed (if OLDCC != CC, it is assumed that GCC is
++ # being used in secondary stage builds).
++ # -Olimit is so the user can use -O2. Down with fixed
++ # size tables!
++
++ CC = $(OLDCC)
++ OPT =
++ OLDCC = cc -Olimit 3000 $(OPT)
++
++ X_CFLAGS = -DNO_SYS_SIGLIST
++
++ # Show we need to use the C version of ALLOCA
++ # The SVR3 configurations have it, but the SVR4 configurations don't.
++ # For now, just try using it for all SVR* configurations.
++ ALLOCA = alloca.o
+diff -rcp2N gcc-2.7.2.2/config/msdos/configur.bat g77-new/config/msdos/configur.bat
+*** gcc-2.7.2.2/config/msdos/configur.bat Mon Aug 28 05:55:47 1995
+--- g77-new/config/msdos/configur.bat Sun Aug 10 19:08:05 1997
+*************** sed -f config/msdos/top.sed Makefile.in
+*** 18,21 ****
+--- 18,27 ----
+ set LANG=
+
++ if not exist ada\make-lang.in goto no_ada
++ sed -f config/msdos/top.sed ada\make-lang.in >> Makefile
++ sed -f config/msdos/top.sed ada\makefile.in > ada\Makefile
++ set LANG=%LANG% ada.&
++ :no_ada
++
+ if not exist cp\make-lang.in goto no_cp
+ sed -f config/msdos/top.sed cp\make-lang.in >> Makefile
+diff -rcp2N gcc-2.7.2.2/config/pa/pa.c g77-new/config/pa/pa.c
+*** gcc-2.7.2.2/config/pa/pa.c Sun Oct 22 07:45:20 1995
+--- g77-new/config/pa/pa.c Sun Aug 10 18:45:44 1997
+*************** output_move_double (operands)
+*** 1344,1369 ****
+ do them in the other order.
+
+! RMS says "This happens only for registers;
+! such overlap can't happen in memory unless the user explicitly
+! sets it up, and that is an undefined circumstance."
+!
+! but it happens on the HP-PA when loading parameter registers,
+! so I am going to define that circumstance, and make it work
+! as expected. */
+
+! if (optype0 == REGOP && (optype1 == MEMOP || optype1 == OFFSOP)
+! && reg_overlap_mentioned_p (operands[0], XEXP (operands[1], 0)))
+ {
+- /* XXX THIS PROBABLY DOESN'T WORK. */
+ /* Do the late half first. */
+ if (addreg1)
+ output_asm_insn ("ldo 4(%0),%0", &addreg1);
+ output_asm_insn (singlemove_string (latehalf), latehalf);
+ if (addreg1)
+ output_asm_insn ("ldo -4(%0),%0", &addreg1);
+- /* Then clobber. */
+ return singlemove_string (operands);
+ }
+
+ if (optype0 == REGOP && optype1 == REGOP
+ && REGNO (operands[0]) == REGNO (operands[1]) + 1)
+--- 1344,1377 ----
+ do them in the other order.
+
+! This can happen in two cases:
+
+! mem -> register where the first half of the destination register
+! is the same register used in the memory's address. Reload
+! can create such insns.
+!
+! mem in this case will be either register indirect or register
+! indirect plus a valid offset.
+!
+! register -> register move where REGNO(dst) == REGNO(src + 1)
+! someone (Tim/Tege?) claimed this can happen for parameter loads.
+!
+! Handle mem -> register case first. */
+! if (optype0 == REGOP
+! && (optype1 == MEMOP || optype1 == OFFSOP)
+! && refers_to_regno_p (REGNO (operands[0]), REGNO (operands[0]) + 1,
+! operands[1], 0))
+ {
+ /* Do the late half first. */
+ if (addreg1)
+ output_asm_insn ("ldo 4(%0),%0", &addreg1);
+ output_asm_insn (singlemove_string (latehalf), latehalf);
++
++ /* Then clobber. */
+ if (addreg1)
+ output_asm_insn ("ldo -4(%0),%0", &addreg1);
+ return singlemove_string (operands);
+ }
+
++ /* Now handle register -> register case. */
+ if (optype0 == REGOP && optype1 == REGOP
+ && REGNO (operands[0]) == REGNO (operands[1]) + 1)
+diff -rcp2N gcc-2.7.2.2/config/pa/pa.md g77-new/config/pa/pa.md
+*** gcc-2.7.2.2/config/pa/pa.md Mon Aug 14 09:00:49 1995
+--- g77-new/config/pa/pa.md Sun Aug 10 18:45:45 1997
+***************
+*** 1828,1832 ****
+ (define_insn ""
+ [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand"
+! "=f,*r,Q,?o,?Q,f,*&r,*&r")
+ (match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand"
+ "fG,*rG,f,*r,*r,Q,o,Q"))]
+--- 1828,1832 ----
+ (define_insn ""
+ [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand"
+! "=f,*r,Q,?o,?Q,f,*r,*r")
+ (match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand"
+ "fG,*rG,f,*r,*r,Q,o,Q"))]
+***************
+*** 1846,1850 ****
+ (define_insn ""
+ [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand"
+! "=r,?o,?Q,&r,&r")
+ (match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand"
+ "rG,r,r,o,Q"))]
+--- 1846,1850 ----
+ (define_insn ""
+ [(set (match_operand:DF 0 "reg_or_nonsymb_mem_operand"
+! "=r,?o,?Q,r,r")
+ (match_operand:DF 1 "reg_or_0_or_nonsymb_mem_operand"
+ "rG,r,r,o,Q"))]
+***************
+*** 2019,2023 ****
+ (define_insn ""
+ [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand"
+! "=r,o,Q,&r,&r,&r,f,f,*T")
+ (match_operand:DI 1 "general_operand"
+ "rM,r,r,o,Q,i,fM,*T,f"))]
+--- 2019,2023 ----
+ (define_insn ""
+ [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand"
+! "=r,o,Q,r,r,r,f,f,*T")
+ (match_operand:DI 1 "general_operand"
+ "rM,r,r,o,Q,i,fM,*T,f"))]
+***************
+*** 2037,2041 ****
+ (define_insn ""
+ [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand"
+! "=r,o,Q,&r,&r,&r")
+ (match_operand:DI 1 "general_operand"
+ "rM,r,r,o,Q,i"))]
+--- 2037,2041 ----
+ (define_insn ""
+ [(set (match_operand:DI 0 "reg_or_nonsymb_mem_operand"
+! "=r,o,Q,r,r,r")
+ (match_operand:DI 1 "general_operand"
+ "rM,r,r,o,Q,i"))]
+diff -rcp2N gcc-2.7.2.2/config/rs6000/rs6000.c g77-new/config/rs6000/rs6000.c
+*** gcc-2.7.2.2/config/rs6000/rs6000.c Thu Feb 20 19:24:14 1997
+--- g77-new/config/rs6000/rs6000.c Sun Aug 10 04:44:05 1997
+*************** input_operand (op, mode)
+*** 724,730 ****
+ return 1;
+
+! /* For HImode and QImode, any constant is valid. */
+! if ((mode == HImode || mode == QImode)
+! && GET_CODE (op) == CONST_INT)
+ return 1;
+
+--- 724,729 ----
+ return 1;
+
+! /* For integer modes, any constant is ok. */
+! if (GET_CODE (op) == CONST_INT)
+ return 1;
+
+diff -rcp2N gcc-2.7.2.2/config/sparc/sol2.h g77-new/config/sparc/sol2.h
+*** gcc-2.7.2.2/config/sparc/sol2.h Sat Aug 19 17:36:45 1995
+--- g77-new/config/sparc/sol2.h Sun Aug 10 18:45:53 1997
+*************** do { \
+*** 166,168 ****
+ /* Define for support of TFmode long double and REAL_ARITHMETIC.
+ Sparc ABI says that long double is 4 words. */
+! #define LONG_DOUBLE_TYPE_SIZE 128
+--- 166,168 ----
+ /* Define for support of TFmode long double and REAL_ARITHMETIC.
+ Sparc ABI says that long double is 4 words. */
+! #define LONG_DOUBLE_TYPE_SIZE 64
+diff -rcp2N gcc-2.7.2.2/config/sparc/sparc.c g77-new/config/sparc/sparc.c
+*** gcc-2.7.2.2/config/sparc/sparc.c Tue Sep 12 18:32:24 1995
+--- g77-new/config/sparc/sparc.c Sun Aug 10 18:46:03 1997
+*************** Boston, MA 02111-1307, USA. */
+*** 40,46 ****
+ /* 1 if the caller has placed an "unimp" insn immediately after the call.
+ This is used in v8 code when calling a function that returns a structure.
+! v9 doesn't have this. */
+
+! #define SKIP_CALLERS_UNIMP_P (!TARGET_V9 && current_function_returns_struct)
+
+ /* Global variables for machine-dependent things. */
+--- 40,51 ----
+ /* 1 if the caller has placed an "unimp" insn immediately after the call.
+ This is used in v8 code when calling a function that returns a structure.
+! v9 doesn't have this. Be careful to have this test be the same as that
+! used on the call. */
+
+! #define SKIP_CALLERS_UNIMP_P \
+! (!TARGET_V9 && current_function_returns_struct \
+! && ! integer_zerop (DECL_SIZE (DECL_RESULT (current_function_decl))) \
+! && (TREE_CODE (DECL_SIZE (DECL_RESULT (current_function_decl))) \
+! == INTEGER_CST))
+
+ /* Global variables for machine-dependent things. */
+diff -rcp2N gcc-2.7.2.2/config/sparc/sparc.h g77-new/config/sparc/sparc.h
+*** gcc-2.7.2.2/config/sparc/sparc.h Thu Feb 20 19:24:15 1997
+--- g77-new/config/sparc/sparc.h Sun Aug 10 18:46:13 1997
+*************** extern int leaf_function;
+*** 1526,1533 ****
+
+ /* Output assembler code to FILE to increment profiler label # LABELNO
+! for profiling a function entry. */
+
+ #define FUNCTION_PROFILER(FILE, LABELNO) \
+ do { \
+ fputs ("\tsethi %hi(", (FILE)); \
+ ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO); \
+--- 1526,1540 ----
+
+ /* Output assembler code to FILE to increment profiler label # LABELNO
+! for profiling a function entry.
+!
+! 32 bit sparc uses %g2 as the STATIC_CHAIN_REGNUM which gets clobbered
+! during profiling so we need to save/restore it around the call to mcount.
+! We're guaranteed that a save has just been done, and we use the space
+! allocated for intreg/fpreg value passing. */
+
+ #define FUNCTION_PROFILER(FILE, LABELNO) \
+ do { \
++ if (! TARGET_V9) \
++ fputs ("\tst %g2,[%fp-4]\n", FILE); \
+ fputs ("\tsethi %hi(", (FILE)); \
+ ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO); \
+*************** extern int leaf_function;
+*** 1539,1542 ****
+--- 1546,1551 ----
+ ASM_OUTPUT_INTERNAL_LABELREF (FILE, "LP", LABELNO); \
+ fputs ("),%o0,%o0\n", (FILE)); \
++ if (! TARGET_V9) \
++ fputs ("\tld [%fp-4],%g2\n", FILE); \
+ } while (0)
+
+diff -rcp2N gcc-2.7.2.2/config/sparc/sparc.md g77-new/config/sparc/sparc.md
+*** gcc-2.7.2.2/config/sparc/sparc.md Tue Sep 12 18:57:35 1995
+--- g77-new/config/sparc/sparc.md Sun Aug 10 18:46:27 1997
+***************
+*** 4799,4803 ****
+ abort ();
+
+! if (GET_CODE (XEXP (operands[0], 0)) == LABEL_REF)
+ {
+ /* This is really a PIC sequence. We want to represent
+--- 4799,4803 ----
+ abort ();
+
+! if (GET_CODE (XEXP (operands[0], 0)) == LABEL_REF)
+ {
+ /* This is really a PIC sequence. We want to represent
+***************
+*** 4809,4824 ****
+
+ if (! TARGET_V9 && INTVAL (operands[3]) != 0)
+! emit_jump_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (3,
+! gen_rtx (SET, VOIDmode, pc_rtx,
+! XEXP (operands[0], 0)),
+! operands[3],
+! gen_rtx (CLOBBER, VOIDmode,
+! gen_rtx (REG, Pmode, 15)))));
+ else
+! emit_jump_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (2,
+! gen_rtx (SET, VOIDmode, pc_rtx,
+! XEXP (operands[0], 0)),
+! gen_rtx (CLOBBER, VOIDmode,
+! gen_rtx (REG, Pmode, 15)))));
+ goto finish_call;
+ }
+--- 4809,4828 ----
+
+ if (! TARGET_V9 && INTVAL (operands[3]) != 0)
+! emit_jump_insn
+! (gen_rtx (PARALLEL, VOIDmode,
+! gen_rtvec (3,
+! gen_rtx (SET, VOIDmode, pc_rtx,
+! XEXP (operands[0], 0)),
+! GEN_INT (INTVAL (operands[3]) & 0xfff),
+! gen_rtx (CLOBBER, VOIDmode,
+! gen_rtx (REG, Pmode, 15)))));
+ else
+! emit_jump_insn
+! (gen_rtx (PARALLEL, VOIDmode,
+! gen_rtvec (2,
+! gen_rtx (SET, VOIDmode, pc_rtx,
+! XEXP (operands[0], 0)),
+! gen_rtx (CLOBBER, VOIDmode,
+! gen_rtx (REG, Pmode, 15)))));
+ goto finish_call;
+ }
+***************
+*** 4839,4852 ****
+
+ if (! TARGET_V9 && INTVAL (operands[3]) != 0)
+! emit_call_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (3,
+! gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx),
+! operands[3],
+! gen_rtx (CLOBBER, VOIDmode,
+! gen_rtx (REG, Pmode, 15)))));
+ else
+! emit_call_insn (gen_rtx (PARALLEL, VOIDmode, gen_rtvec (2,
+! gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx),
+! gen_rtx (CLOBBER, VOIDmode,
+! gen_rtx (REG, Pmode, 15)))));
+
+ finish_call:
+--- 4843,4858 ----
+
+ if (! TARGET_V9 && INTVAL (operands[3]) != 0)
+! emit_call_insn
+! (gen_rtx (PARALLEL, VOIDmode,
+! gen_rtvec (3, gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx),
+! GEN_INT (INTVAL (operands[3]) & 0xfff),
+! gen_rtx (CLOBBER, VOIDmode,
+! gen_rtx (REG, Pmode, 15)))));
+ else
+! emit_call_insn
+! (gen_rtx (PARALLEL, VOIDmode,
+! gen_rtvec (2, gen_rtx (CALL, VOIDmode, fn_rtx, nregs_rtx),
+! gen_rtx (CLOBBER, VOIDmode,
+! gen_rtx (REG, Pmode, 15)))));
+
+ finish_call:
+***************
+*** 4911,4915 ****
+ (clobber (reg:SI 15))]
+ ;;- Do not use operand 1 for most machines.
+! "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) > 0"
+ "call %a0,%1\;nop\;unimp %2"
+ [(set_attr "type" "call_no_delay_slot")])
+--- 4917,4921 ----
+ (clobber (reg:SI 15))]
+ ;;- Do not use operand 1 for most machines.
+! "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) >= 0"
+ "call %a0,%1\;nop\;unimp %2"
+ [(set_attr "type" "call_no_delay_slot")])
+***************
+*** 4923,4927 ****
+ (clobber (reg:SI 15))]
+ ;;- Do not use operand 1 for most machines.
+! "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) > 0"
+ "call %a0,%1\;nop\;unimp %2"
+ [(set_attr "type" "call_no_delay_slot")])
+--- 4929,4933 ----
+ (clobber (reg:SI 15))]
+ ;;- Do not use operand 1 for most machines.
+! "! TARGET_V9 && GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) >= 0"
+ "call %a0,%1\;nop\;unimp %2"
+ [(set_attr "type" "call_no_delay_slot")])
+***************
+*** 5178,5184 ****
+ emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx));
+ emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx));
+- emit_insn (gen_rtx (USE, VOIDmode, gen_rtx (REG, Pmode, 8)));
+ /* Return, restoring reg window and jumping to goto handler. */
+ emit_insn (gen_goto_handler_and_restore ());
+ DONE;
+ }")
+--- 5184,5190 ----
+ emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx));
+ emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx));
+ /* Return, restoring reg window and jumping to goto handler. */
+ emit_insn (gen_goto_handler_and_restore ());
++ emit_barrier ();
+ DONE;
+ }")
+***************
+*** 5192,5200 ****
+
+ (define_insn "goto_handler_and_restore"
+! [(unspec_volatile [(const_int 0)] 2)]
+ ""
+ "jmp %%o0+0\;restore"
+ [(set_attr "type" "misc")
+ (set_attr "length" "2")])
+
+ ;; Special pattern for the FLUSH instruction.
+--- 5198,5237 ----
+
+ (define_insn "goto_handler_and_restore"
+! [(unspec_volatile [(const_int 0)] 2)
+! (use (reg:SI 8))]
+ ""
+ "jmp %%o0+0\;restore"
+ [(set_attr "type" "misc")
+ (set_attr "length" "2")])
++
++ ;; Pattern for use after a setjmp to store FP and the return register
++ ;; into the stack area.
++
++ (define_expand "setjmp"
++ [(const_int 0)]
++ ""
++ "
++ {
++ if (TARGET_V9)
++ emit_insn (gen_setjmp_64 ());
++ else
++ emit_insn (gen_setjmp_32 ());
++
++ DONE;
++ }")
++
++ (define_expand "setjmp_32"
++ [(set (mem:SI (plus:SI (reg:SI 14) (const_int 56))) (match_dup 0))
++ (set (mem:SI (plus:SI (reg:SI 14) (const_int 60))) (reg:SI 31))]
++ ""
++ "
++ { operands[0] = frame_pointer_rtx; }")
++
++ (define_expand "setjmp_64"
++ [(set (mem:DI (plus:DI (reg:DI 14) (const_int 112))) (match_dup 0))
++ (set (mem:DI (plus:DI (reg:DI 14) (const_int 120))) (reg:DI 31))]
++ ""
++ "
++ { operands[0] = frame_pointer_rtx; }")
+
+ ;; Special pattern for the FLUSH instruction.
+diff -rcp2N gcc-2.7.2.2/config/x-linux g77-new/config/x-linux
+*** gcc-2.7.2.2/config/x-linux Tue Mar 28 07:43:37 1995
+--- g77-new/config/x-linux Thu Jul 10 20:08:49 1997
+*************** BOOT_CFLAGS = -O $(CFLAGS) -Iinclude
+*** 13,14 ****
+--- 13,17 ----
+ # Don't run fixproto
+ STMP_FIXPROTO =
++
++ # Don't install "assert.h" in gcc. We use the one in glibc.
++ INSTALL_ASSERT_H =
+diff -rcp2N gcc-2.7.2.2/config/x-linux-aout g77-new/config/x-linux-aout
+*** gcc-2.7.2.2/config/x-linux-aout Wed Dec 31 19:00:00 1969
+--- g77-new/config/x-linux-aout Thu Jul 10 20:08:49 1997
+***************
+*** 0 ****
+--- 1,14 ----
++ # It is defined in config/xm-linux.h.
++ # X_CFLAGS = -DPOSIX
++
++ # The following is needed when compiling stages 2 and 3 because gcc's
++ # limits.h must be picked up before /usr/include/limits.h. This is because
++ # each does an #include_next of the other if the other hasn't been included.
++ # /usr/include/limits.h loses if it gets found first because /usr/include is
++ # at the end of the search order. When a new version of gcc is released,
++ # gcc's limits.h hasn't been installed yet and hence isn't found.
++
++ BOOT_CFLAGS = -O $(CFLAGS) -Iinclude
++
++ # Don't run fixproto
++ STMP_FIXPROTO =
+diff -rcp2N gcc-2.7.2.2/config.guess g77-new/config.guess
+*** gcc-2.7.2.2/config.guess Thu Feb 20 19:24:32 1997
+--- g77-new/config.guess Thu Jul 10 20:08:50 1997
+*************** trap 'rm -f dummy.c dummy.o dummy; exit
+*** 52,63 ****
+
+ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+- alpha:OSF1:V*:*)
+- # After 1.2, OSF1 uses "V1.3" for uname -r.
+- echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^V//'`
+- exit 0 ;;
+ alpha:OSF1:*:*)
+ # 1.2 uses "1.2" for uname -r.
+! echo alpha-dec-osf${UNAME_RELEASE}
+! exit 0 ;;
+ 21064:Windows_NT:50:3)
+ echo alpha-dec-winnt3.5
+--- 52,62 ----
+
+ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ alpha:OSF1:*:*)
++ # A Vn.n version is a released version.
++ # A Tn.n version is a released field test version.
++ # A Xn.n version is an unreleased experimental baselevel.
+ # 1.2 uses "1.2" for uname -r.
+! echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//'`
+! exit 0 ;;
+ 21064:Windows_NT:50:3)
+ echo alpha-dec-winnt3.5
+*************** case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$
+*** 154,161 ****
+ echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+ exit 0 ;;
+! ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+ echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
+ exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+! i[34]86:AIX:*:*)
+ echo i386-ibm-aix
+ exit 0 ;;
+--- 153,160 ----
+ echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+ exit 0 ;;
+! ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+ echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
+ exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+! i?86:AIX:*:*)
+ echo i386-ibm-aix
+ exit 0 ;;
+*************** EOF
+*** 220,224 ****
+ 9000/31? ) HP_ARCH=m68000 ;;
+ 9000/[34]?? ) HP_ARCH=m68k ;;
+! 9000/7?? | 9000/8?[79] ) HP_ARCH=hppa1.1 ;;
+ 9000/8?? ) HP_ARCH=hppa1.0 ;;
+ esac
+--- 219,223 ----
+ 9000/31? ) HP_ARCH=m68000 ;;
+ 9000/[34]?? ) HP_ARCH=m68k ;;
+! 9000/7?? | 9000/8?[1679] ) HP_ARCH=hppa1.1 ;;
+ 9000/8?? ) HP_ARCH=hppa1.0 ;;
+ esac
+*************** EOF
+*** 304,308 ****
+ echo m68k-hp-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+! i[34]86:BSD/386:*:* | *:BSD/OS:*:*)
+ echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+--- 303,307 ----
+ echo m68k-hp-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+! i?86:BSD/386:*:* | *:BSD/OS:*:*)
+ echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+*************** EOF
+*** 314,318 ****
+ exit 0 ;;
+ *:GNU:*:*)
+! echo `echo ${UNAME_MACHINE}|sed -e 's,/.*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+ exit 0 ;;
+ *:Linux:*:*)
+--- 313,317 ----
+ exit 0 ;;
+ *:GNU:*:*)
+! echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+ exit 0 ;;
+ *:Linux:*:*)
+*************** EOF
+*** 320,330 ****
+ # first see if it will tell us.
+ ld_help_string=`ld --help 2>&1`
+! # if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: elf_i[345]86"; then
+ # echo "${UNAME_MACHINE}-unknown-linux" ; exit 0
+! if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i[345]86linux"; then
+ echo "${UNAME_MACHINE}-unknown-linuxaout" ; exit 0
+! elif echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i[345]86coff"; then
+ echo "${UNAME_MACHINE}-unknown-linuxcoff" ; exit 0
+ elif test "${UNAME_MACHINE}" = "alpha" ; then
+ echo alpha-unknown-linux ; exit 0
+ else
+--- 319,333 ----
+ # first see if it will tell us.
+ ld_help_string=`ld --help 2>&1`
+! # if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: elf_i?86"; then
+ # echo "${UNAME_MACHINE}-unknown-linux" ; exit 0
+! if echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i?86linux"; then
+ echo "${UNAME_MACHINE}-unknown-linuxaout" ; exit 0
+! elif echo $ld_help_string | grep >/dev/null 2>&1 "supported emulations: i?86coff"; then
+ echo "${UNAME_MACHINE}-unknown-linuxcoff" ; exit 0
+ elif test "${UNAME_MACHINE}" = "alpha" ; then
++ as_version_string=`as --version 2>&1`
++ if echo $as_version_string | grep >/dev/null 2>&1 " version 2.6 "; then
++ echo alpha-unknown-linuxoldas ; exit 0
++ fi
+ echo alpha-unknown-linux ; exit 0
+ else
+*************** EOF
+*** 363,370 ****
+ # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions
+ # are messed up and put the nodename in both sysname and nodename.
+! i[34]86:DYNIX/ptx:4*:*)
+ echo i386-sequent-sysv4
+ exit 0 ;;
+! i[34]86:*:4.*:* | i[34]86:SYSTEM_V:4.*:*)
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE}
+--- 366,373 ----
+ # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions
+ # are messed up and put the nodename in both sysname and nodename.
+! i?86:DYNIX/ptx:4*:*)
+ echo i386-sequent-sysv4
+ exit 0 ;;
+! i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*)
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE}
+*************** EOF
+*** 373,377 ****
+ fi
+ exit 0 ;;
+! i[34]86:*:3.2:*)
+ if test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+--- 376,380 ----
+ fi
+ exit 0 ;;
+! i?86:*:3.2:*)
+ if test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+*************** EOF
+*** 380,383 ****
+--- 383,388 ----
+ UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
++ (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \
++ && UNAME_MACHINE=i586
+ echo ${UNAME_MACHINE}-unknown-sco$UNAME_REL
+ else
+*************** EOF
+*** 402,406 ****
+ echo m68010-convergent-sysv
+ exit 0 ;;
+! M680[234]0:*:R3V[567]*:*)
+ test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
+ 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0)
+--- 407,411 ----
+ echo m68010-convergent-sysv
+ exit 0 ;;
+! M68*:*:R3V[567]*:*)
+ test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
+ 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0)
+*************** EOF
+*** 410,414 ****
+ uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4 && exit 0 ;;
+! m680[234]0:LynxOS:2.[23]*:*)
+ echo m68k-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+--- 415,419 ----
+ uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4 && exit 0 ;;
+! m68*:LynxOS:2.*:*)
+ echo m68k-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+*************** EOF
+*** 416,426 ****
+ echo m68k-atari-sysv4
+ exit 0 ;;
+! i[34]86:LynxOS:2.[23]*:*)
+ echo i386-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+! TSUNAMI:LynxOS:2.[23]*:*)
+ echo sparc-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+! rs6000:LynxOS:2.[23]*:*)
+ echo rs6000-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+--- 421,431 ----
+ echo m68k-atari-sysv4
+ exit 0 ;;
+! i?86:LynxOS:2.*:*)
+ echo i386-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+! TSUNAMI:LynxOS:2.*:*)
+ echo sparc-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+! rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*)
+ echo rs6000-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+*************** main ()
+*** 479,483 ****
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+! printf ("%s-next-nextstep%s\n", __ARCHITECTURE__, version==2 ? "2" : "3");
+ exit (0);
+ #endif
+--- 484,488 ----
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+! printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+ exit (0);
+ #endif
+diff -rcp2N gcc-2.7.2.2/config.sub g77-new/config.sub
+*** gcc-2.7.2.2/config.sub Thu Jun 15 17:01:49 1995
+--- g77-new/config.sub Thu Jul 10 20:08:50 1997
+*************** case $basic_machine in
+*** 130,134 ****
+ # Recognize the basic CPU types without company name.
+ # Some are omitted here because they have special meanings below.
+! tahoe | i[345]86 | i860 | m68k | m68000 | m88k | ns32k | arm \
+ | arme[lb] | pyramid \
+ | tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \
+--- 130,134 ----
+ # Recognize the basic CPU types without company name.
+ # Some are omitted here because they have special meanings below.
+! tahoe | i[3456]86 | i860 | m68k | m68000 | m88k | ns32k | arm \
+ | arme[lb] | pyramid \
+ | tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \
+*************** case $basic_machine in
+*** 145,149 ****
+ ;;
+ # Recognize the basic CPU types with company name.
+! vax-* | tahoe-* | i[345]86-* | i860-* | m68k-* | m68000-* | m88k-* \
+ | sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \
+ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* | power-* \
+--- 145,149 ----
+ ;;
+ # Recognize the basic CPU types with company name.
+! vax-* | tahoe-* | i[3456]86-* | i860-* | m68k-* | m68000-* | m88k-* \
+ | sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \
+ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* | power-* \
+*************** case $basic_machine in
+*** 309,325 ****
+ ;;
+ # I'm not sure what "Sysv32" means. Should this be sysv3.2?
+! i[345]86v32)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv32
+ ;;
+! i[345]86v4*)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv4
+ ;;
+! i[345]86v)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv
+ ;;
+! i[345]86sol2)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-solaris2
+--- 309,325 ----
+ ;;
+ # I'm not sure what "Sysv32" means. Should this be sysv3.2?
+! i[3456]86v32)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv32
+ ;;
+! i[3456]86v4*)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv4
+ ;;
+! i[3456]86v)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv
+ ;;
+! i[3456]86sol2)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-solaris2
+diff -rcp2N gcc-2.7.2.2/configure g77-new/configure
+*** gcc-2.7.2.2/configure Thu Feb 20 19:24:33 1997
+--- g77-new/configure Sun Aug 10 18:46:31 1997
+*************** exec_prefix='$(prefix)'
+*** 82,85 ****
+--- 82,86 ----
+ # The default g++ include directory is $(libdir)/g++-include.
+ gxx_include_dir='$(libdir)/g++-include'
++ #gxx_include_dir='$(exec_prefix)/include/g++'
+
+ # Default --program-transform-name to nothing.
+*************** for machine in $canon_build $canon_host
+*** 548,551 ****
+--- 549,578 ----
+ use_collect2=yes
+ ;;
++ alpha-*-linux*oldas*)
++ tm_file=alpha/linux.h
++ tmake_file=alpha/t-linux
++ xmake_file=alpha/x-linux
++ fixincludes=Makefile.in
++ xm_file=alpha/xm-linux.h
++ gas=yes gnu_ld=yes
++ ;;
++ alpha-*-linux*ecoff*)
++ tm_file=alpha/linux.h
++ tmake_file=alpha/t-linux
++ xmake_file=alpha/x-linux
++ fixincludes=Makefile.in
++ xm_file=alpha/xm-linux.h
++ extra_parts="crtbegin.o crtbeginS.o crtend.o crtendS.o"
++ gas=yes gnu_ld=yes
++ ;;
++ alpha-*-linux*)
++ tm_file=alpha/elf.h
++ tmake_file=alpha/t-linux
++ xmake_file=alpha/x-linux
++ fixincludes=Makefile.in
++ xm_file=alpha/xm-linux.h
++ extra_parts="crtbegin.o crtbeginS.o crtend.o crtendS.o"
++ gas=yes gnu_ld=yes
++ ;;
+ alpha-dec-osf[23456789]*)
+ tm_file=alpha/osf2.h
+*************** for machine in $canon_build $canon_host
+*** 985,989 ****
+ cpu_type=i386 # with a.out format using pre BFD linkers
+ xm_file=i386/xm-linux.h
+! xmake_file=x-linux
+ tm_file=i386/linux-oldld.h
+ fixincludes=Makefile.in # The headers are ok already.
+--- 1012,1016 ----
+ cpu_type=i386 # with a.out format using pre BFD linkers
+ xm_file=i386/xm-linux.h
+! xmake_file=x-linux-aout
+ tm_file=i386/linux-oldld.h
+ fixincludes=Makefile.in # The headers are ok already.
+*************** for machine in $canon_build $canon_host
+*** 994,998 ****
+ cpu_type=i386 # with a.out format
+ xm_file=i386/xm-linux.h
+! xmake_file=x-linux
+ tm_file=i386/linux-aout.h
+ fixincludes=Makefile.in # The headers are ok already.
+--- 1021,1025 ----
+ cpu_type=i386 # with a.out format
+ xm_file=i386/xm-linux.h
+! xmake_file=x-linux-aout
+ tm_file=i386/linux-aout.h
+ fixincludes=Makefile.in # The headers are ok already.
+*************** for machine in $canon_build $canon_host
+*** 1003,1007 ****
+ cpu_type=i386 # with ELF format, using GNU libc v1.
+ xm_file=i386/xm-linux.h
+! xmake_file=x-linux
+ tmake_file=t-linux-libc1
+ tm_file=i386/linux.h
+--- 1030,1034 ----
+ cpu_type=i386 # with ELF format, using GNU libc v1.
+ xm_file=i386/xm-linux.h
+! xmake_file=x-linux-aout
+ tmake_file=t-linux-libc1
+ tm_file=i386/linux.h
+*************** for machine in $canon_build $canon_host
+*** 1651,1654 ****
+--- 1678,1702 ----
+ use_collect2=yes
+ ;;
++ mips-sni-sysv4)
++ if [ x$gas = xyes ]
++ then
++ if [ x$stabs = xyes ]
++ then
++ tm_file=mips/iris5gdb.h
++ else
++ tm_file=mips/sni-gas.h
++ fi
++ else
++ tm_file=mips/sni-svr4.h
++ fi
++ xm_file=mips/xm-sysv.h
++ xmake_file=mips/x-sni-svr4
++ tmake_file=mips/t-mips-gas
++ if [ x$gnu_ld != xyes ]
++ then
++ use_collect2=yes
++ fi
++ broken_install=yes
++ ;;
+ mips-sgi-irix5*) # SGI System V.4., IRIX 5
+ if [ x$gas = xyes ]
+*************** MAYBE_TARGET_DEFAULT = -DTARGET_CPU_DEFA
+*** 2980,2984 ****
+ rm Makefile.sed
+ echo 's| ||' > Makefile.sed
+! echo "s|^target=.*$|target=${target}|" >> Makefile.sed
+ echo "s|^xmake_file=.*$|xmake_file=${dep_host_xmake_file}|" >> Makefile.sed
+ echo "s|^tmake_file=.*$|tmake_file=${dep_tmake_file}|" >> Makefile.sed
+--- 3028,3032 ----
+ rm Makefile.sed
+ echo 's| ||' > Makefile.sed
+! echo "s|^target=.*$|target=${canon_target}|" >> Makefile.sed
+ echo "s|^xmake_file=.*$|xmake_file=${dep_host_xmake_file}|" >> Makefile.sed
+ echo "s|^tmake_file=.*$|tmake_file=${dep_tmake_file}|" >> Makefile.sed
+diff -rcp2N gcc-2.7.2.2/cse.c g77-new/cse.c
+*** gcc-2.7.2.2/cse.c Sun Nov 26 14:47:05 1995
+--- g77-new/cse.c Sun Aug 10 18:46:37 1997
+*************** static struct table_elt *last_jump_equiv
+*** 520,544 ****
+ static int constant_pool_entries_cost;
+
+- /* Bits describing what kind of values in memory must be invalidated
+- for a particular instruction. If all three bits are zero,
+- no memory refs need to be invalidated. Each bit is more powerful
+- than the preceding ones, and if a bit is set then the preceding
+- bits are also set.
+-
+- Here is how the bits are set:
+- Pushing onto the stack invalidates only the stack pointer,
+- writing at a fixed address invalidates only variable addresses,
+- writing in a structure element at variable address
+- invalidates all but scalar variables,
+- and writing in anything else at variable address invalidates everything. */
+-
+- struct write_data
+- {
+- int sp : 1; /* Invalidate stack pointer. */
+- int var : 1; /* Invalidate variable addresses. */
+- int nonscalar : 1; /* Invalidate all but scalar variables. */
+- int all : 1; /* Invalidate all memory refs. */
+- };
+-
+ /* Define maximum length of a branch path. */
+
+--- 520,523 ----
+*************** static void merge_equiv_classes PROTO((s
+*** 626,632 ****
+ struct table_elt *));
+ static void invalidate PROTO((rtx, enum machine_mode));
+ static void remove_invalid_refs PROTO((int));
+ static void rehash_using_reg PROTO((rtx));
+! static void invalidate_memory PROTO((struct write_data *));
+ static void invalidate_for_call PROTO((void));
+ static rtx use_related_value PROTO((rtx, struct table_elt *));
+--- 605,612 ----
+ struct table_elt *));
+ static void invalidate PROTO((rtx, enum machine_mode));
++ static int cse_rtx_varies_p PROTO((rtx));
+ static void remove_invalid_refs PROTO((int));
+ static void rehash_using_reg PROTO((rtx));
+! static void invalidate_memory PROTO((void));
+ static void invalidate_for_call PROTO((void));
+ static rtx use_related_value PROTO((rtx, struct table_elt *));
+*************** static void set_nonvarying_address_compo
+*** 638,644 ****
+ HOST_WIDE_INT *));
+ static int refers_to_p PROTO((rtx, rtx));
+- static int refers_to_mem_p PROTO((rtx, rtx, HOST_WIDE_INT,
+- HOST_WIDE_INT));
+- static int cse_rtx_addr_varies_p PROTO((rtx));
+ static rtx canon_reg PROTO((rtx, rtx));
+ static void find_best_addr PROTO((rtx, rtx *));
+--- 618,621 ----
+*************** static void record_jump_cond PROTO((enum
+*** 656,661 ****
+ rtx, rtx, int));
+ static void cse_insn PROTO((rtx, int));
+! static void note_mem_written PROTO((rtx, struct write_data *));
+! static void invalidate_from_clobbers PROTO((struct write_data *, rtx));
+ static rtx cse_process_notes PROTO((rtx, rtx));
+ static void cse_around_loop PROTO((rtx));
+--- 633,638 ----
+ rtx, rtx, int));
+ static void cse_insn PROTO((rtx, int));
+! static int note_mem_written PROTO((rtx));
+! static void invalidate_from_clobbers PROTO((rtx));
+ static rtx cse_process_notes PROTO((rtx, rtx));
+ static void cse_around_loop PROTO((rtx));
+*************** invalidate (x, full_mode)
+*** 1512,1517 ****
+ register int i;
+ register struct table_elt *p;
+- rtx base;
+- HOST_WIDE_INT start, end;
+
+ /* If X is a register, dependencies on its contents
+--- 1489,1492 ----
+*************** invalidate (x, full_mode)
+*** 1605,1611 ****
+ full_mode = GET_MODE (x);
+
+- set_nonvarying_address_components (XEXP (x, 0), GET_MODE_SIZE (full_mode),
+- &base, &start, &end);
+-
+ for (i = 0; i < NBUCKETS; i++)
+ {
+--- 1580,1583 ----
+*************** invalidate (x, full_mode)
+*** 1614,1618 ****
+ {
+ next = p->next_same_hash;
+! if (refers_to_mem_p (p->exp, base, start, end))
+ remove_from_table (p, i);
+ }
+--- 1586,1594 ----
+ {
+ next = p->next_same_hash;
+! /* Invalidate ASM_OPERANDS which reference memory (this is easier
+! than checking all the aliases). */
+! if (p->in_memory
+! && (GET_CODE (p->exp) != MEM
+! || true_dependence (x, full_mode, p->exp, cse_rtx_varies_p)))
+ remove_from_table (p, i);
+ }
+*************** rehash_using_reg (x)
+*** 1695,1722 ****
+ }
+
+- /* Remove from the hash table all expressions that reference memory,
+- or some of them as specified by *WRITES. */
+-
+- static void
+- invalidate_memory (writes)
+- struct write_data *writes;
+- {
+- register int i;
+- register struct table_elt *p, *next;
+- int all = writes->all;
+- int nonscalar = writes->nonscalar;
+-
+- for (i = 0; i < NBUCKETS; i++)
+- for (p = table[i]; p; p = next)
+- {
+- next = p->next_same_hash;
+- if (p->in_memory
+- && (all
+- || (nonscalar && p->in_struct)
+- || cse_rtx_addr_varies_p (p->exp)))
+- remove_from_table (p, i);
+- }
+- }
+-
+ /* Remove from the hash table any expression that is a call-clobbered
+ register. Also update their TICK values. */
+--- 1671,1674 ----
+*************** invalidate_for_call ()
+*** 1756,1759 ****
+--- 1708,1717 ----
+ next = p->next_same_hash;
+
++ if (p->in_memory)
++ {
++ remove_from_table (p, hash);
++ continue;
++ }
++
+ if (GET_CODE (p->exp) != REG
+ || REGNO (p->exp) >= FIRST_PSEUDO_REGISTER)
+*************** canon_hash (x, mode)
+*** 1946,1950 ****
+ return 0;
+ }
+! if (! RTX_UNCHANGING_P (x))
+ {
+ hash_arg_in_memory = 1;
+--- 1904,1908 ----
+ return 0;
+ }
+! if (! RTX_UNCHANGING_P (x) || FIXED_BASE_PLUS_P (XEXP (x, 0)))
+ {
+ hash_arg_in_memory = 1;
+*************** set_nonvarying_address_components (addr,
+*** 2395,2477 ****
+ }
+
+! /* Return 1 iff any subexpression of X refers to memory
+! at an address of BASE plus some offset
+! such that any of the bytes' offsets fall between START (inclusive)
+! and END (exclusive).
+!
+! The value is undefined if X is a varying address (as determined by
+! cse_rtx_addr_varies_p). This function is not used in such cases.
+!
+! When used in the cse pass, `qty_const' is nonzero, and it is used
+! to treat an address that is a register with a known constant value
+! as if it were that constant value.
+! In the loop pass, `qty_const' is zero, so this is not done. */
+!
+! static int
+! refers_to_mem_p (x, base, start, end)
+! rtx x, base;
+! HOST_WIDE_INT start, end;
+! {
+! register HOST_WIDE_INT i;
+! register enum rtx_code code;
+! register char *fmt;
+!
+! repeat:
+! if (x == 0)
+! return 0;
+!
+! code = GET_CODE (x);
+! if (code == MEM)
+! {
+! register rtx addr = XEXP (x, 0); /* Get the address. */
+! rtx mybase;
+! HOST_WIDE_INT mystart, myend;
+!
+! set_nonvarying_address_components (addr, GET_MODE_SIZE (GET_MODE (x)),
+! &mybase, &mystart, &myend);
+!
+!
+! /* refers_to_mem_p is never called with varying addresses.
+! If the base addresses are not equal, there is no chance
+! of the memory addresses conflicting. */
+! if (! rtx_equal_p (mybase, base))
+! return 0;
+!
+! return myend > start && mystart < end;
+! }
+!
+! /* X does not match, so try its subexpressions. */
+!
+! fmt = GET_RTX_FORMAT (code);
+! for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
+! if (fmt[i] == 'e')
+! {
+! if (i == 0)
+! {
+! x = XEXP (x, 0);
+! goto repeat;
+! }
+! else
+! if (refers_to_mem_p (XEXP (x, i), base, start, end))
+! return 1;
+! }
+! else if (fmt[i] == 'E')
+! {
+! int j;
+! for (j = 0; j < XVECLEN (x, i); j++)
+! if (refers_to_mem_p (XVECEXP (x, i, j), base, start, end))
+! return 1;
+! }
+!
+! return 0;
+! }
+!
+! /* Nonzero if X refers to memory at a varying address;
+ except that a register which has at the moment a known constant value
+ isn't considered variable. */
+
+ static int
+! cse_rtx_addr_varies_p (x)
+! rtx x;
+ {
+ /* We need not check for X and the equivalence class being of the same
+--- 2353,2363 ----
+ }
+
+! /* Nonzero if X, a memory address, refers to a varying address;
+ except that a register which has at the moment a known constant value
+ isn't considered variable. */
+
+ static int
+! cse_rtx_varies_p (x)
+! register rtx x;
+ {
+ /* We need not check for X and the equivalence class being of the same
+*************** cse_rtx_addr_varies_p (x)
+*** 2479,2497 ****
+ doesn't vary in any mode. */
+
+! if (GET_CODE (x) == MEM
+! && GET_CODE (XEXP (x, 0)) == REG
+! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0)))
+! && GET_MODE (XEXP (x, 0)) == qty_mode[reg_qty[REGNO (XEXP (x, 0))]]
+! && qty_const[reg_qty[REGNO (XEXP (x, 0))]] != 0)
+ return 0;
+
+! if (GET_CODE (x) == MEM
+! && GET_CODE (XEXP (x, 0)) == PLUS
+! && GET_CODE (XEXP (XEXP (x, 0), 1)) == CONST_INT
+! && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG
+! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0)))
+! && (GET_MODE (XEXP (XEXP (x, 0), 0))
+! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]])
+! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]])
+ return 0;
+
+--- 2365,2381 ----
+ doesn't vary in any mode. */
+
+! if (GET_CODE (x) == REG
+! && REGNO_QTY_VALID_P (REGNO (x))
+! && GET_MODE (x) == qty_mode[reg_qty[REGNO (x)]]
+! && qty_const[reg_qty[REGNO (x)]] != 0)
+ return 0;
+
+! if (GET_CODE (x) == PLUS
+! && GET_CODE (XEXP (x, 1)) == CONST_INT
+! && GET_CODE (XEXP (x, 0)) == REG
+! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0)))
+! && (GET_MODE (XEXP (x, 0))
+! == qty_mode[reg_qty[REGNO (XEXP (x, 0))]])
+! && qty_const[reg_qty[REGNO (XEXP (x, 0))]])
+ return 0;
+
+*************** cse_rtx_addr_varies_p (x)
+*** 2501,2519 ****
+ load fp minus a constant into a register, then a MEM which is the
+ sum of the two `constant' registers. */
+! if (GET_CODE (x) == MEM
+! && GET_CODE (XEXP (x, 0)) == PLUS
+! && GET_CODE (XEXP (XEXP (x, 0), 0)) == REG
+! && GET_CODE (XEXP (XEXP (x, 0), 1)) == REG
+! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 0)))
+! && (GET_MODE (XEXP (XEXP (x, 0), 0))
+! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]])
+! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 0))]]
+! && REGNO_QTY_VALID_P (REGNO (XEXP (XEXP (x, 0), 1)))
+! && (GET_MODE (XEXP (XEXP (x, 0), 1))
+! == qty_mode[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]])
+! && qty_const[reg_qty[REGNO (XEXP (XEXP (x, 0), 1))]])
+ return 0;
+
+! return rtx_addr_varies_p (x);
+ }
+
+--- 2385,2402 ----
+ load fp minus a constant into a register, then a MEM which is the
+ sum of the two `constant' registers. */
+! if (GET_CODE (x) == PLUS
+! && GET_CODE (XEXP (x, 0)) == REG
+! && GET_CODE (XEXP (x, 1)) == REG
+! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 0)))
+! && (GET_MODE (XEXP (x, 0))
+! == qty_mode[reg_qty[REGNO (XEXP (x, 0))]])
+! && qty_const[reg_qty[REGNO (XEXP (x, 0))]]
+! && REGNO_QTY_VALID_P (REGNO (XEXP (x, 1)))
+! && (GET_MODE (XEXP (x, 1))
+! == qty_mode[reg_qty[REGNO (XEXP (x, 1))]])
+! && qty_const[reg_qty[REGNO (XEXP (x, 1))]])
+ return 0;
+
+! return rtx_varies_p (x);
+ }
+
+*************** cse_insn (insn, in_libcall_block)
+*** 6105,6110 ****
+ rtx this_insn_cc0 = 0;
+ enum machine_mode this_insn_cc0_mode;
+- struct write_data writes_memory;
+- static struct write_data init = {0, 0, 0, 0};
+
+ rtx src_eqv = 0;
+--- 5988,5991 ----
+*************** cse_insn (insn, in_libcall_block)
+*** 6118,6122 ****
+
+ this_insn = insn;
+- writes_memory = init;
+
+ /* Find all the SETs and CLOBBERs in this instruction.
+--- 5999,6002 ----
+*************** cse_insn (insn, in_libcall_block)
+*** 6220,6232 ****
+ else if (GET_CODE (y) == CLOBBER)
+ {
+! /* If we clobber memory, take note of that,
+! and canon the address.
+ This does nothing when a register is clobbered
+ because we have already invalidated the reg. */
+ if (GET_CODE (XEXP (y, 0)) == MEM)
+! {
+! canon_reg (XEXP (y, 0), NULL_RTX);
+! note_mem_written (XEXP (y, 0), &writes_memory);
+! }
+ }
+ else if (GET_CODE (y) == USE
+--- 6100,6108 ----
+ else if (GET_CODE (y) == CLOBBER)
+ {
+! /* If we clobber memory, canon the address.
+ This does nothing when a register is clobbered
+ because we have already invalidated the reg. */
+ if (GET_CODE (XEXP (y, 0)) == MEM)
+! canon_reg (XEXP (y, 0), NULL_RTX);
+ }
+ else if (GET_CODE (y) == USE
+*************** cse_insn (insn, in_libcall_block)
+*** 6247,6254 ****
+ {
+ if (GET_CODE (XEXP (x, 0)) == MEM)
+! {
+! canon_reg (XEXP (x, 0), NULL_RTX);
+! note_mem_written (XEXP (x, 0), &writes_memory);
+! }
+ }
+
+--- 6123,6127 ----
+ {
+ if (GET_CODE (XEXP (x, 0)) == MEM)
+! canon_reg (XEXP (x, 0), NULL_RTX);
+ }
+
+*************** cse_insn (insn, in_libcall_block)
+*** 6674,6678 ****
+ }
+ #endif /* LOAD_EXTEND_OP */
+!
+ if (src == src_folded)
+ src_folded = 0;
+--- 6547,6551 ----
+ }
+ #endif /* LOAD_EXTEND_OP */
+!
+ if (src == src_folded)
+ src_folded = 0;
+*************** cse_insn (insn, in_libcall_block)
+*** 6860,6864 ****
+ || (GET_CODE (src_folded) != MEM
+ && ! src_folded_force_flag))
+! && GET_MODE_CLASS (mode) != MODE_CC)
+ {
+ src_folded_force_flag = 1;
+--- 6733,6738 ----
+ || (GET_CODE (src_folded) != MEM
+ && ! src_folded_force_flag))
+! && GET_MODE_CLASS (mode) != MODE_CC
+! && mode != VOIDmode)
+ {
+ src_folded_force_flag = 1;
+*************** cse_insn (insn, in_libcall_block)
+*** 6983,6993 ****
+ if (GET_CODE (dest) == MEM)
+ {
+ dest = fold_rtx (dest, insn);
+-
+- /* Decide whether we invalidate everything in memory,
+- or just things at non-fixed places.
+- Writing a large aggregate must invalidate everything
+- because we don't know how long it is. */
+- note_mem_written (dest, &writes_memory);
+ }
+
+--- 6857,6869 ----
+ if (GET_CODE (dest) == MEM)
+ {
++ #ifdef PUSH_ROUNDING
++ /* Stack pushes invalidate the stack pointer. */
++ rtx addr = XEXP (dest, 0);
++ if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC
++ || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC)
++ && XEXP (addr, 0) == stack_pointer_rtx)
++ invalidate (stack_pointer_rtx, Pmode);
++ #endif
+ dest = fold_rtx (dest, insn);
+ }
+
+*************** cse_insn (insn, in_libcall_block)
+*** 7234,7238 ****
+ sets[i].src_elt = src_eqv_elt;
+
+! invalidate_from_clobbers (&writes_memory, x);
+
+ /* Some registers are invalidated by subroutine calls. Memory is
+--- 7110,7114 ----
+ sets[i].src_elt = src_eqv_elt;
+
+! invalidate_from_clobbers (x);
+
+ /* Some registers are invalidated by subroutine calls. Memory is
+*************** cse_insn (insn, in_libcall_block)
+*** 7241,7248 ****
+ if (GET_CODE (insn) == CALL_INSN)
+ {
+- static struct write_data everything = {0, 1, 1, 1};
+-
+ if (! CONST_CALL_P (insn))
+! invalidate_memory (&everything);
+ invalidate_for_call ();
+ }
+--- 7117,7122 ----
+ if (GET_CODE (insn) == CALL_INSN)
+ {
+ if (! CONST_CALL_P (insn))
+! invalidate_memory ();
+ invalidate_for_call ();
+ }
+*************** cse_insn (insn, in_libcall_block)
+*** 7265,7270 ****
+ we have just done an invalidate_memory that covers even those. */
+ if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG
+! || (GET_CODE (dest) == MEM && ! writes_memory.all
+! && ! cse_rtx_addr_varies_p (dest)))
+ invalidate (dest, VOIDmode);
+ else if (GET_CODE (dest) == STRICT_LOW_PART
+--- 7139,7143 ----
+ we have just done an invalidate_memory that covers even those. */
+ if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG
+! || GET_CODE (dest) == MEM)
+ invalidate (dest, VOIDmode);
+ else if (GET_CODE (dest) == STRICT_LOW_PART
+*************** cse_insn (insn, in_libcall_block)
+*** 7359,7363 ****
+ sets[i].dest_hash, GET_MODE (dest));
+ elt->in_memory = (GET_CODE (sets[i].inner_dest) == MEM
+! && ! RTX_UNCHANGING_P (sets[i].inner_dest));
+
+ if (elt->in_memory)
+--- 7232,7238 ----
+ sets[i].dest_hash, GET_MODE (dest));
+ elt->in_memory = (GET_CODE (sets[i].inner_dest) == MEM
+! && (! RTX_UNCHANGING_P (sets[i].inner_dest)
+! || FIXED_BASE_PLUS_P (XEXP (sets[i].inner_dest,
+! 0))));
+
+ if (elt->in_memory)
+*************** cse_insn (insn, in_libcall_block)
+*** 7532,7580 ****
+ }
+
+- /* Store 1 in *WRITES_PTR for those categories of memory ref
+- that must be invalidated when the expression WRITTEN is stored in.
+- If WRITTEN is null, say everything must be invalidated. */
+-
+ static void
+! note_mem_written (written, writes_ptr)
+! rtx written;
+! struct write_data *writes_ptr;
+! {
+! static struct write_data everything = {0, 1, 1, 1};
+!
+! if (written == 0)
+! *writes_ptr = everything;
+! else if (GET_CODE (written) == MEM)
+! {
+! /* Pushing or popping the stack invalidates just the stack pointer. */
+! rtx addr = XEXP (written, 0);
+! if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC
+! || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC)
+! && GET_CODE (XEXP (addr, 0)) == REG
+! && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM)
+! {
+! writes_ptr->sp = 1;
+! return;
+! }
+! else if (GET_MODE (written) == BLKmode)
+! *writes_ptr = everything;
+! /* (mem (scratch)) means clobber everything. */
+! else if (GET_CODE (addr) == SCRATCH)
+! *writes_ptr = everything;
+! else if (cse_rtx_addr_varies_p (written))
+! {
+! /* A varying address that is a sum indicates an array element,
+! and that's just as good as a structure element
+! in implying that we need not invalidate scalar variables.
+! However, we must allow QImode aliasing of scalars, because the
+! ANSI C standard allows character pointers to alias anything. */
+! if (! ((MEM_IN_STRUCT_P (written)
+! || GET_CODE (XEXP (written, 0)) == PLUS)
+! && GET_MODE (written) != QImode))
+! writes_ptr->all = 1;
+! writes_ptr->nonscalar = 1;
+! }
+! writes_ptr->var = 1;
+ }
+ }
+
+--- 7407,7450 ----
+ }
+
+ static void
+! invalidate_memory ()
+! {
+! register int i;
+! register struct table_elt *p, *next;
+!
+! for (i = 0; i < NBUCKETS; i++)
+! for (p = table[i]; p; p = next)
+! {
+! next = p->next_same_hash;
+! if (p->in_memory)
+! remove_from_table (p, i);
+! }
+! }
+!
+! static int
+! note_mem_written (mem)
+! register rtx mem;
+! {
+! if (mem == 0 || GET_CODE(mem) != MEM )
+! return 0;
+! else
+! {
+! register rtx addr = XEXP (mem, 0);
+! /* Pushing or popping the stack invalidates just the stack pointer. */
+! if ((GET_CODE (addr) == PRE_DEC || GET_CODE (addr) == PRE_INC
+! || GET_CODE (addr) == POST_DEC || GET_CODE (addr) == POST_INC)
+! && GET_CODE (XEXP (addr, 0)) == REG
+! && REGNO (XEXP (addr, 0)) == STACK_POINTER_REGNUM)
+! {
+! if (reg_tick[STACK_POINTER_REGNUM] >= 0)
+! reg_tick[STACK_POINTER_REGNUM]++;
+!
+! /* This should be *very* rare. */
+! if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM))
+! invalidate (stack_pointer_rtx, VOIDmode);
+! return 1;
+ }
++ return 0;
++ }
+ }
+
+*************** note_mem_written (written, writes_ptr)
+*** 7584,7612 ****
+ alias with something that is SET or CLOBBERed.
+
+- W points to the writes_memory for this insn, a struct write_data
+- saying which kinds of memory references must be invalidated.
+ X is the pattern of the insn. */
+
+ static void
+! invalidate_from_clobbers (w, x)
+! struct write_data *w;
+ rtx x;
+ {
+- /* If W->var is not set, W specifies no action.
+- If W->all is set, this step gets all memory refs
+- so they can be ignored in the rest of this function. */
+- if (w->var)
+- invalidate_memory (w);
+-
+- if (w->sp)
+- {
+- if (reg_tick[STACK_POINTER_REGNUM] >= 0)
+- reg_tick[STACK_POINTER_REGNUM]++;
+-
+- /* This should be *very* rare. */
+- if (TEST_HARD_REG_BIT (hard_regs_in_table, STACK_POINTER_REGNUM))
+- invalidate (stack_pointer_rtx, VOIDmode);
+- }
+-
+ if (GET_CODE (x) == CLOBBER)
+ {
+--- 7454,7463 ----
+ alias with something that is SET or CLOBBERed.
+
+ X is the pattern of the insn. */
+
+ static void
+! invalidate_from_clobbers (x)
+ rtx x;
+ {
+ if (GET_CODE (x) == CLOBBER)
+ {
+*************** invalidate_from_clobbers (w, x)
+*** 7615,7619 ****
+ {
+ if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG
+! || (GET_CODE (ref) == MEM && ! w->all))
+ invalidate (ref, VOIDmode);
+ else if (GET_CODE (ref) == STRICT_LOW_PART
+--- 7466,7470 ----
+ {
+ if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG
+! || GET_CODE (ref) == MEM)
+ invalidate (ref, VOIDmode);
+ else if (GET_CODE (ref) == STRICT_LOW_PART
+*************** invalidate_from_clobbers (w, x)
+*** 7631,7643 ****
+ {
+ rtx ref = XEXP (y, 0);
+! if (ref)
+! {
+! if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG
+! || (GET_CODE (ref) == MEM && !w->all))
+! invalidate (ref, VOIDmode);
+! else if (GET_CODE (ref) == STRICT_LOW_PART
+! || GET_CODE (ref) == ZERO_EXTRACT)
+! invalidate (XEXP (ref, 0), GET_MODE (ref));
+! }
+ }
+ }
+--- 7482,7491 ----
+ {
+ rtx ref = XEXP (y, 0);
+! if (GET_CODE (ref) == REG || GET_CODE (ref) == SUBREG
+! || GET_CODE (ref) == MEM)
+! invalidate (ref, VOIDmode);
+! else if (GET_CODE (ref) == STRICT_LOW_PART
+! || GET_CODE (ref) == ZERO_EXTRACT)
+! invalidate (XEXP (ref, 0), GET_MODE (ref));
+ }
+ }
+*************** cse_around_loop (loop_start)
+*** 7800,7807 ****
+ }
+
+- /* Variable used for communications between the next two routines. */
+-
+- static struct write_data skipped_writes_memory;
+-
+ /* Process one SET of an insn that was skipped. We ignore CLOBBERs
+ since they are done elsewhere. This function is called via note_stores. */
+--- 7648,7651 ----
+*************** invalidate_skipped_set (dest, set)
+*** 7812,7815 ****
+--- 7656,7675 ----
+ rtx dest;
+ {
++ enum rtx_code code = GET_CODE (dest);
++
++ if (code == MEM
++ && ! note_mem_written (dest) /* If this is not a stack push ... */
++ /* There are times when an address can appear varying and be a PLUS
++ during this scan when it would be a fixed address were we to know
++ the proper equivalences. So invalidate all memory if there is
++ a BLKmode or nonscalar memory reference or a reference to a
++ variable address. */
++ && (MEM_IN_STRUCT_P (dest) || GET_MODE (dest) == BLKmode
++ || cse_rtx_varies_p (XEXP (dest, 0))))
++ {
++ invalidate_memory ();
++ return;
++ }
++
+ if (GET_CODE (set) == CLOBBER
+ #ifdef HAVE_cc0
+*************** invalidate_skipped_set (dest, set)
+*** 7819,7837 ****
+ return;
+
+! if (GET_CODE (dest) == MEM)
+! note_mem_written (dest, &skipped_writes_memory);
+!
+! /* There are times when an address can appear varying and be a PLUS
+! during this scan when it would be a fixed address were we to know
+! the proper equivalences. So promote "nonscalar" to be "all". */
+! if (skipped_writes_memory.nonscalar)
+! skipped_writes_memory.all = 1;
+!
+! if (GET_CODE (dest) == REG || GET_CODE (dest) == SUBREG
+! || (! skipped_writes_memory.all && ! cse_rtx_addr_varies_p (dest)))
+! invalidate (dest, VOIDmode);
+! else if (GET_CODE (dest) == STRICT_LOW_PART
+! || GET_CODE (dest) == ZERO_EXTRACT)
+ invalidate (XEXP (dest, 0), GET_MODE (dest));
+ }
+
+--- 7679,7686 ----
+ return;
+
+! if (code == STRICT_LOW_PART || code == ZERO_EXTRACT)
+ invalidate (XEXP (dest, 0), GET_MODE (dest));
++ else if (code == REG || code == SUBREG || code == MEM)
++ invalidate (dest, VOIDmode);
+ }
+
+*************** invalidate_skipped_block (start)
+*** 7845,7850 ****
+ {
+ rtx insn;
+- static struct write_data init = {0, 0, 0, 0};
+- static struct write_data everything = {0, 1, 1, 1};
+
+ for (insn = start; insn && GET_CODE (insn) != CODE_LABEL;
+--- 7694,7697 ----
+*************** invalidate_skipped_block (start)
+*** 7854,7867 ****
+ continue;
+
+- skipped_writes_memory = init;
+-
+ if (GET_CODE (insn) == CALL_INSN)
+ {
+ invalidate_for_call ();
+- skipped_writes_memory = everything;
+ }
+
+ note_stores (PATTERN (insn), invalidate_skipped_set);
+- invalidate_from_clobbers (&skipped_writes_memory, PATTERN (insn));
+ }
+ }
+--- 7701,7712 ----
+ continue;
+
+ if (GET_CODE (insn) == CALL_INSN)
+ {
++ if (! CONST_CALL_P (insn))
++ invalidate_memory ();
+ invalidate_for_call ();
+ }
+
+ note_stores (PATTERN (insn), invalidate_skipped_set);
+ }
+ }
+*************** cse_set_around_loop (x, insn, loop_start
+*** 7913,7920 ****
+ {
+ struct table_elt *src_elt;
+- static struct write_data init = {0, 0, 0, 0};
+- struct write_data writes_memory;
+-
+- writes_memory = init;
+
+ /* If this is a SET, see if we can replace SET_SRC, but ignore SETs that
+--- 7758,7761 ----
+*************** cse_set_around_loop (x, insn, loop_start
+*** 7976,7991 ****
+
+ /* Now invalidate anything modified by X. */
+! note_mem_written (SET_DEST (x), &writes_memory);
+!
+! if (writes_memory.var)
+! invalidate_memory (&writes_memory);
+!
+! /* See comment on similar code in cse_insn for explanation of these tests. */
+ if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG
+! || (GET_CODE (SET_DEST (x)) == MEM && ! writes_memory.all
+! && ! cse_rtx_addr_varies_p (SET_DEST (x))))
+ invalidate (SET_DEST (x), VOIDmode);
+ else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART
+! || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT)
+ invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x)));
+ }
+--- 7817,7828 ----
+
+ /* Now invalidate anything modified by X. */
+! note_mem_written (SET_DEST (x));
+!
+! /* See comment on similar code in cse_insn for explanation of these tests. */
+ if (GET_CODE (SET_DEST (x)) == REG || GET_CODE (SET_DEST (x)) == SUBREG
+! || GET_CODE (SET_DEST (x)) == MEM)
+ invalidate (SET_DEST (x), VOIDmode);
+ else if (GET_CODE (SET_DEST (x)) == STRICT_LOW_PART
+! || GET_CODE (SET_DEST (x)) == ZERO_EXTRACT)
+ invalidate (XEXP (SET_DEST (x), 0), GET_MODE (SET_DEST (x)));
+ }
+*************** cse_main (f, nregs, after_loop, file)
+*** 8234,8237 ****
+--- 8071,8075 ----
+
+ init_recog ();
++ init_alias_analysis ();
+
+ max_reg = nregs;
+*************** cse_basic_block (from, to, next_branch,
+*** 8405,8408 ****
+--- 8243,8247 ----
+ int to_usage = 0;
+ int in_libcall_block = 0;
++ int num_insns = 0;
+
+ /* Each of these arrays is undefined before max_reg, so only allocate
+*************** cse_basic_block (from, to, next_branch,
+*** 8437,8440 ****
+--- 8276,8299 ----
+ {
+ register enum rtx_code code;
++ int i;
++ struct table_elt *p, *next;
++
++ /* If we have processed 1,000 insns, flush the hash table to avoid
++ extreme quadratic behavior. */
++ if (num_insns++ > 1000)
++ {
++ for (i = 0; i < NBUCKETS; i++)
++ for (p = table[i]; p; p = next)
++ {
++ next = p->next_same_hash;
++
++ if (GET_CODE (p->exp) == REG)
++ invalidate (p->exp, p->mode);
++ else
++ remove_from_table (p, i);
++ }
++
++ num_insns = 0;
++ }
+
+ /* See if this is a branch that is part of the path. If so, and it is
+diff -rcp2N gcc-2.7.2.2/dwarfout.c g77-new/dwarfout.c
+*** gcc-2.7.2.2/dwarfout.c Thu Oct 26 21:40:07 1995
+--- g77-new/dwarfout.c Sun Aug 10 18:47:19 1997
+*************** output_bound_representation (bound, dim_
+*** 1629,1705 ****
+ {
+
+! case ERROR_MARK:
+! return;
+
+ /* All fixed-bounds are represented by INTEGER_CST nodes. */
+
+! case INTEGER_CST:
+! ASM_OUTPUT_DWARF_DATA4 (asm_out_file,
+! (unsigned) TREE_INT_CST_LOW (bound));
+! break;
+!
+! /* Dynamic bounds may be represented by NOP_EXPR nodes containing
+! SAVE_EXPR nodes. */
+!
+! case NOP_EXPR:
+! bound = TREE_OPERAND (bound, 0);
+! /* ... fall thru... */
+!
+! case SAVE_EXPR:
+! {
+! char begin_label[MAX_ARTIFICIAL_LABEL_BYTES];
+! char end_label[MAX_ARTIFICIAL_LABEL_BYTES];
+!
+! sprintf (begin_label, BOUND_BEGIN_LABEL_FMT,
+! current_dienum, dim_num, u_or_l);
+
+! sprintf (end_label, BOUND_END_LABEL_FMT,
+! current_dienum, dim_num, u_or_l);
+
+! ASM_OUTPUT_DWARF_DELTA2 (asm_out_file, end_label, begin_label);
+! ASM_OUTPUT_LABEL (asm_out_file, begin_label);
+
+! /* If we are working on a bound for a dynamic dimension in C,
+! the dynamic dimension in question had better have a static
+! (zero) lower bound and a dynamic *upper* bound. */
+
+! if (u_or_l != 'u')
+! abort ();
+
+! /* If optimization is turned on, the SAVE_EXPRs that describe
+! how to access the upper bound values are essentially bogus.
+! They only describe (at best) how to get at these values at
+! the points in the generated code right after they have just
+! been computed. Worse yet, in the typical case, the upper
+! bound values will not even *be* computed in the optimized
+! code, so these SAVE_EXPRs are entirely bogus.
+!
+! In order to compensate for this fact, we check here to see
+! if optimization is enabled, and if so, we effectively create
+! an empty location description for the (unknown and unknowable)
+! upper bound.
+!
+! This should not cause too much trouble for existing (stupid?)
+! debuggers because they have to deal with empty upper bounds
+! location descriptions anyway in order to be able to deal with
+! incomplete array types.
+!
+! Of course an intelligent debugger (GDB?) should be able to
+! comprehend that a missing upper bound specification in a
+! array type used for a storage class `auto' local array variable
+! indicates that the upper bound is both unknown (at compile-
+! time) and unknowable (at run-time) due to optimization.
+! */
+!
+! if (! optimize)
+! output_loc_descriptor
+! (eliminate_regs (SAVE_EXPR_RTL (bound), 0, NULL_RTX));
+
+! ASM_OUTPUT_LABEL (asm_out_file, end_label);
+! }
+! break;
+
+- default:
+- abort ();
+ }
+ }
+--- 1629,1699 ----
+ {
+
+! case ERROR_MARK:
+! return;
+
+ /* All fixed-bounds are represented by INTEGER_CST nodes. */
+
+! case INTEGER_CST:
+! ASM_OUTPUT_DWARF_DATA4 (asm_out_file,
+! (unsigned) TREE_INT_CST_LOW (bound));
+! break;
+
+! default:
+
+! /* Dynamic bounds may be represented by NOP_EXPR nodes containing
+! SAVE_EXPR nodes, in which case we can do something, or as
+! an expression, which we cannot represent. */
+! {
+! char begin_label[MAX_ARTIFICIAL_LABEL_BYTES];
+! char end_label[MAX_ARTIFICIAL_LABEL_BYTES];
+
+! sprintf (begin_label, BOUND_BEGIN_LABEL_FMT,
+! current_dienum, dim_num, u_or_l);
+
+! sprintf (end_label, BOUND_END_LABEL_FMT,
+! current_dienum, dim_num, u_or_l);
+
+! ASM_OUTPUT_DWARF_DELTA2 (asm_out_file, end_label, begin_label);
+! ASM_OUTPUT_LABEL (asm_out_file, begin_label);
+!
+! /* If optimization is turned on, the SAVE_EXPRs that describe
+! how to access the upper bound values are essentially bogus.
+! They only describe (at best) how to get at these values at
+! the points in the generated code right after they have just
+! been computed. Worse yet, in the typical case, the upper
+! bound values will not even *be* computed in the optimized
+! code, so these SAVE_EXPRs are entirely bogus.
+!
+! In order to compensate for this fact, we check here to see
+! if optimization is enabled, and if so, we effectively create
+! an empty location description for the (unknown and unknowable)
+! upper bound.
+!
+! This should not cause too much trouble for existing (stupid?)
+! debuggers because they have to deal with empty upper bounds
+! location descriptions anyway in order to be able to deal with
+! incomplete array types.
+!
+! Of course an intelligent debugger (GDB?) should be able to
+! comprehend that a missing upper bound specification in a
+! array type used for a storage class `auto' local array variable
+! indicates that the upper bound is both unknown (at compile-
+! time) and unknowable (at run-time) due to optimization. */
+!
+! if (! optimize)
+! {
+! while (TREE_CODE (bound) == NOP_EXPR
+! || TREE_CODE (bound) == CONVERT_EXPR)
+! bound = TREE_OPERAND (bound, 0);
+!
+! if (TREE_CODE (bound) == SAVE_EXPR)
+! output_loc_descriptor
+! (eliminate_regs (SAVE_EXPR_RTL (bound), 0, NULL_RTX));
+! }
+
+! ASM_OUTPUT_LABEL (asm_out_file, end_label);
+! }
+! break;
+
+ }
+ }
+*************** type_attribute (type, decl_const, decl_v
+*** 2857,2861 ****
+ register int root_type_modified;
+
+! if (TREE_CODE (type) == ERROR_MARK)
+ return;
+
+--- 2851,2855 ----
+ register int root_type_modified;
+
+! if (code == ERROR_MARK)
+ return;
+
+*************** type_attribute (type, decl_const, decl_v
+*** 2864,2869 ****
+ type `void', so this only applies to function return types. */
+
+! if (TREE_CODE (type) == VOID_TYPE)
+ return;
+
+ root_type_modified = (code == POINTER_TYPE || code == REFERENCE_TYPE
+--- 2858,2869 ----
+ type `void', so this only applies to function return types. */
+
+! if (code == VOID_TYPE)
+ return;
++
++ /* If this is a subtype, find the underlying type. Eventually,
++ this should write out the appropriate subtype info. */
++ while ((code == INTEGER_TYPE || code == REAL_TYPE)
++ && TREE_TYPE (type) != 0)
++ type = TREE_TYPE (type), code = TREE_CODE (type);
+
+ root_type_modified = (code == POINTER_TYPE || code == REFERENCE_TYPE
+diff -rcp2N gcc-2.7.2.2/emit-rtl.c g77-new/emit-rtl.c
+*** gcc-2.7.2.2/emit-rtl.c Thu Sep 14 16:09:30 1995
+--- g77-new/emit-rtl.c Sun Aug 10 18:47:08 1997
+*************** max_label_num ()
+*** 545,548 ****
+--- 545,565 ----
+ }
+
++ /* Identify REG (which may be a CONCAT) as a user register. */
++
++ void
++ mark_user_reg (reg)
++ rtx reg;
++ {
++ if (GET_CODE (reg) == CONCAT)
++ {
++ REG_USERVAR_P (XEXP (reg, 0)) = 1;
++ REG_USERVAR_P (XEXP (reg, 1)) = 1;
++ }
++ else if (GET_CODE (reg) == REG)
++ REG_USERVAR_P (reg) = 1;
++ else
++ abort ();
++ }
++
+ /* Return first label number used in this function (if any were used). */
+
+*************** change_address (memref, mode, addr)
+*** 1315,1318 ****
+--- 1332,1338 ----
+ addr = memory_address (mode, addr);
+
++ if (rtx_equal_p (addr, XEXP (memref, 0)) && mode == GET_MODE (memref))
++ return memref;
++
+ new = gen_rtx (MEM, mode, addr);
+ MEM_VOLATILE_P (new) = MEM_VOLATILE_P (memref);
+diff -rcp2N gcc-2.7.2.2/explow.c g77-new/explow.c
+*** gcc-2.7.2.2/explow.c Thu Jun 15 07:30:10 1995
+--- g77-new/explow.c Sun Aug 10 18:46:30 1997
+*************** convert_memory_address (to_mode, x)
+*** 305,310 ****
+--- 305,313 ----
+ rtx x;
+ {
++ enum machine_mode from_mode = to_mode == ptr_mode ? Pmode : ptr_mode;
+ rtx temp;
+
++ /* Here we handle some special cases. If none of them apply, fall through
++ to the default case. */
+ switch (GET_CODE (x))
+ {
+*************** convert_memory_address (to_mode, x)
+*** 321,339 ****
+ return temp;
+
+- case PLUS:
+- case MULT:
+- return gen_rtx (GET_CODE (x), to_mode,
+- convert_memory_address (to_mode, XEXP (x, 0)),
+- convert_memory_address (to_mode, XEXP (x, 1)));
+-
+ case CONST:
+ return gen_rtx (CONST, to_mode,
+ convert_memory_address (to_mode, XEXP (x, 0)));
+
+! default:
+! return convert_modes (to_mode,
+! to_mode == ptr_mode ? Pmode : ptr_mode,
+! x, POINTERS_EXTEND_UNSIGNED);
+ }
+ }
+ #endif
+--- 324,348 ----
+ return temp;
+
+ case CONST:
+ return gen_rtx (CONST, to_mode,
+ convert_memory_address (to_mode, XEXP (x, 0)));
+
+! case PLUS:
+! case MULT:
+! /* For addition the second operand is a small constant, we can safely
+! permute the converstion and addition operation. We can always safely
+! permute them if we are making the address narrower. In addition,
+! always permute the operations if this is a constant. */
+! if (GET_MODE_SIZE (to_mode) < GET_MODE_SIZE (from_mode)
+! || (GET_CODE (x) == PLUS && GET_CODE (XEXP (x, 1)) == CONST_INT
+! && (INTVAL (XEXP (x, 1)) + 20000 < 40000
+! || CONSTANT_P (XEXP (x, 0)))))
+! return gen_rtx (GET_CODE (x), to_mode,
+! convert_memory_address (to_mode, XEXP (x, 0)),
+! convert_memory_address (to_mode, XEXP (x, 1)));
+ }
++
++ return convert_modes (to_mode, from_mode,
++ x, POINTERS_EXTEND_UNSIGNED);
+ }
+ #endif
+diff -rcp2N gcc-2.7.2.2/expmed.c g77-new/expmed.c
+*** gcc-2.7.2.2/expmed.c Thu Jul 13 19:25:37 1995
+--- g77-new/expmed.c Sun Aug 10 18:46:23 1997
+*************** store_bit_field (str_rtx, bitsize, bitnu
+*** 399,402 ****
+--- 399,403 ----
+ #ifdef HAVE_insv
+ if (HAVE_insv
++ && GET_MODE (value) != BLKmode
+ && !(bitsize == 1 && GET_CODE (value) == CONST_INT)
+ /* Ensure insv's size is wide enough for this field. */
+*************** store_split_bit_field (op0, bitsize, bit
+*** 777,781 ****
+ done in extract_bit_field, so that the two calls to
+ extract_fixed_bit_field will have comparable arguments. */
+! if (GET_CODE (value) != MEM)
+ total_bits = BITS_PER_WORD;
+ else
+--- 778,782 ----
+ done in extract_bit_field, so that the two calls to
+ extract_fixed_bit_field will have comparable arguments. */
+! if (GET_CODE (value) != MEM || GET_MODE (value) == BLKmode)
+ total_bits = BITS_PER_WORD;
+ else
+*************** store_split_bit_field (op0, bitsize, bit
+*** 790,797 ****
+ /* The args are chosen so that the last part includes the
+ lsb. Give extract_bit_field the value it needs (with
+! endianness compensation) to fetch the piece we want. */
+! part = extract_fixed_bit_field (word_mode, value, 0, thissize,
+! total_bits - bitsize + bitsdone,
+! NULL_RTX, 1, align);
+ }
+ else
+--- 791,807 ----
+ /* The args are chosen so that the last part includes the
+ lsb. Give extract_bit_field the value it needs (with
+! endianness compensation) to fetch the piece we want.
+!
+! ??? We have no idea what the alignment of VALUE is, so
+! we have to use a guess. */
+! part
+! = extract_fixed_bit_field
+! (word_mode, value, 0, thissize,
+! total_bits - bitsize + bitsdone, NULL_RTX, 1,
+! GET_MODE (value) == VOIDmode
+! ? UNITS_PER_WORD
+! : (GET_MODE (value) == BLKmode
+! ? 1
+! : GET_MODE_ALIGNMENT (GET_MODE (value)) / BITS_PER_UNIT));
+ }
+ else
+*************** store_split_bit_field (op0, bitsize, bit
+*** 803,808 ****
+ & (((HOST_WIDE_INT) 1 << thissize) - 1));
+ else
+! part = extract_fixed_bit_field (word_mode, value, 0, thissize,
+! bitsdone, NULL_RTX, 1, align);
+ }
+
+--- 813,824 ----
+ & (((HOST_WIDE_INT) 1 << thissize) - 1));
+ else
+! part
+! = extract_fixed_bit_field
+! (word_mode, value, 0, thissize, bitsdone, NULL_RTX, 1,
+! GET_MODE (value) == VOIDmode
+! ? UNITS_PER_WORD
+! : (GET_MODE (value) == BLKmode
+! ? 1
+! : GET_MODE_ALIGNMENT (GET_MODE (value)) / BITS_PER_UNIT));
+ }
+
+*************** extract_bit_field (str_rtx, bitsize, bit
+*** 876,882 ****
+ rtx spec_target_subreg = 0;
+
+- if (GET_CODE (str_rtx) == MEM && ! MEM_IN_STRUCT_P (str_rtx))
+- abort ();
+-
+ /* Discount the part of the structure before the desired byte.
+ We need to know how many bytes are safe to reference after it. */
+--- 892,895 ----
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3189,3193 ****
+ Notice that we compute also the final remainder value here,
+ and return the result right away. */
+! if (target == 0)
+ target = gen_reg_rtx (compute_mode);
+
+--- 3202,3206 ----
+ Notice that we compute also the final remainder value here,
+ and return the result right away. */
+! if (target == 0 || GET_MODE (target) != compute_mode)
+ target = gen_reg_rtx (compute_mode);
+
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3316,3320 ****
+ remainder. Notice that we compute also the final remainder
+ value here, and return the result right away. */
+! if (target == 0)
+ target = gen_reg_rtx (compute_mode);
+
+--- 3329,3333 ----
+ remainder. Notice that we compute also the final remainder
+ value here, and return the result right away. */
+! if (target == 0 || GET_MODE (target) != compute_mode)
+ target = gen_reg_rtx (compute_mode);
+
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3418,3422 ****
+ remainder. Notice that we compute also the final remainder
+ value here, and return the result right away. */
+! if (target == 0)
+ target = gen_reg_rtx (compute_mode);
+ if (rem_flag)
+--- 3431,3435 ----
+ remainder. Notice that we compute also the final remainder
+ value here, and return the result right away. */
+! if (target == 0 || GET_MODE (target) != compute_mode)
+ target = gen_reg_rtx (compute_mode);
+ if (rem_flag)
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3602,3605 ****
+--- 3615,3621 ----
+ if (quotient == 0)
+ {
++ if (target && GET_MODE (target) != compute_mode)
++ target = 0;
++
+ if (rem_flag)
+ {
+*************** expand_divmod (rem_flag, code, mode, op0
+*** 3653,3656 ****
+--- 3669,3675 ----
+ if (rem_flag)
+ {
++ if (target && GET_MODE (target) != compute_mode)
++ target = 0;
++
+ if (quotient == 0)
+ /* No divide instruction either. Use library for remainder. */
+diff -rcp2N gcc-2.7.2.2/expr.c g77-new/expr.c
+*** gcc-2.7.2.2/expr.c Thu Feb 20 19:24:17 1997
+--- g77-new/expr.c Sun Aug 10 18:47:21 1997
+*************** Boston, MA 02111-1307, USA. */
+*** 27,30 ****
+--- 27,31 ----
+ #include "flags.h"
+ #include "regs.h"
++ #include "hard-reg-set.h"
+ #include "function.h"
+ #include "insn-flags.h"
+*************** extern int stack_depth;
+*** 139,143 ****
+ extern int max_stack_depth;
+ extern struct obstack permanent_obstack;
+!
+
+ static rtx enqueue_insn PROTO((rtx, rtx));
+--- 140,144 ----
+ extern int max_stack_depth;
+ extern struct obstack permanent_obstack;
+! extern rtx arg_pointer_save_area;
+
+ static rtx enqueue_insn PROTO((rtx, rtx));
+*************** expand_assignment (to, from, want_value,
+*** 2498,2503 ****
+
+ push_temp_slots ();
+! tem = get_inner_reference (to, &bitsize, &bitpos, &offset,
+! &mode1, &unsignedp, &volatilep);
+
+ /* If we are going to use store_bit_field and extract_bit_field,
+--- 2499,2504 ----
+
+ push_temp_slots ();
+! tem = get_inner_reference (to, &bitsize, &bitpos, &offset, &mode1,
+! &unsignedp, &volatilep, &alignment);
+
+ /* If we are going to use store_bit_field and extract_bit_field,
+*************** expand_assignment (to, from, want_value,
+*** 2507,2511 ****
+ tem = stabilize_reference (tem);
+
+- alignment = TYPE_ALIGN (TREE_TYPE (tem)) / BITS_PER_UNIT;
+ to_rtx = expand_expr (tem, NULL_RTX, VOIDmode, 0);
+ if (offset != 0)
+--- 2508,2511 ----
+*************** expand_assignment (to, from, want_value,
+*** 2518,2529 ****
+ gen_rtx (PLUS, ptr_mode, XEXP (to_rtx, 0),
+ force_reg (ptr_mode, offset_rtx)));
+- /* If we have a variable offset, the known alignment
+- is only that of the innermost structure containing the field.
+- (Actually, we could sometimes do better by using the
+- align of an element of the innermost array, but no need.) */
+- if (TREE_CODE (to) == COMPONENT_REF
+- || TREE_CODE (to) == BIT_FIELD_REF)
+- alignment
+- = TYPE_ALIGN (TREE_TYPE (TREE_OPERAND (to, 0))) / BITS_PER_UNIT;
+ }
+ if (volatilep)
+--- 2518,2521 ----
+*************** store_expr (exp, target, want_value)
+*** 2775,2780 ****
+ which will often result in some optimizations. Do the conversion
+ in two steps: first change the signedness, if needed, then
+! the extend. */
+! if (! want_value)
+ {
+ if (TREE_UNSIGNED (TREE_TYPE (exp))
+--- 2767,2775 ----
+ which will often result in some optimizations. Do the conversion
+ in two steps: first change the signedness, if needed, then
+! the extend. But don't do this if the type of EXP is a subtype
+! of something else since then the conversion might involve
+! more than just converting modes. */
+! if (! want_value && INTEGRAL_TYPE_P (TREE_TYPE (exp))
+! && TREE_TYPE (TREE_TYPE (exp)) == 0)
+ {
+ if (TREE_UNSIGNED (TREE_TYPE (exp))
+*************** store_constructor (exp, target)
+*** 3071,3074 ****
+--- 3066,3077 ----
+ }
+
++ if (TREE_READONLY (field))
++ {
++ if (GET_CODE (to_rtx) == MEM)
++ to_rtx = change_address (to_rtx, GET_MODE (to_rtx),
++ XEXP (to_rtx, 0));
++ RTX_UNCHANGING_P (to_rtx) = 1;
++ }
++
+ store_field (to_rtx, bitsize, bitpos, mode, TREE_VALUE (elt),
+ /* The alignment of TARGET is
+*************** store_field (target, bitsize, bitpos, mo
+*** 3414,3417 ****
+--- 3417,3432 ----
+ rtx temp = expand_expr (exp, NULL_RTX, VOIDmode, 0);
+
++ /* If BITSIZE is narrower than the size of the type of EXP
++ we will be narrowing TEMP. Normally, what's wanted are the
++ low-order bits. However, if EXP's type is a record and this is
++ big-endian machine, we want the upper BITSIZE bits. */
++ if (BYTES_BIG_ENDIAN && GET_MODE_CLASS (GET_MODE (temp)) == MODE_INT
++ && bitsize < GET_MODE_BITSIZE (GET_MODE (temp))
++ && TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE)
++ temp = expand_shift (RSHIFT_EXPR, GET_MODE (temp), temp,
++ size_int (GET_MODE_BITSIZE (GET_MODE (temp))
++ - bitsize),
++ temp, 1);
++
+ /* Unless MODE is VOIDmode or BLKmode, convert TEMP to
+ MODE. */
+*************** store_field (target, bitsize, bitpos, mo
+*** 3420,3423 ****
+--- 3435,3459 ----
+ temp = convert_modes (mode, TYPE_MODE (TREE_TYPE (exp)), temp, 1);
+
++ /* If the modes of TARGET and TEMP are both BLKmode, both
++ must be in memory and BITPOS must be aligned on a byte
++ boundary. If so, we simply do a block copy. */
++ if (GET_MODE (target) == BLKmode && GET_MODE (temp) == BLKmode)
++ {
++ if (GET_CODE (target) != MEM || GET_CODE (temp) != MEM
++ || bitpos % BITS_PER_UNIT != 0)
++ abort ();
++
++ target = change_address (target, VOIDmode,
++ plus_constant (XEXP (target, 0),
++ bitpos / BITS_PER_UNIT));
++
++ emit_block_move (target, temp,
++ GEN_INT ((bitsize + BITS_PER_UNIT - 1)
++ / BITS_PER_UNIT),
++ 1);
++
++ return value_mode == VOIDmode ? const0_rtx : target;
++ }
++
+ /* Store the value in the bitfield. */
+ store_bit_field (target, bitsize, bitpos, mode, temp, align, total_size);
+*************** get_inner_unaligned_p (exp)
+*** 3515,3518 ****
+--- 3551,3557 ----
+ This offset is in addition to the bit position.
+ If the position is not variable, we store 0 in *POFFSET.
++ We set *PALIGNMENT to the alignment in bytes of the address that will be
++ computed. This is the alignment of the thing we return if *POFFSET
++ is zero, but can be more less strictly aligned if *POFFSET is nonzero.
+
+ If any of the extraction expressions is volatile,
+*************** get_inner_unaligned_p (exp)
+*** 3525,3533 ****
+ If the field describes a variable-sized object, *PMODE is set to
+ VOIDmode and *PBITSIZE is set to -1. An access cannot be made in
+! this case, but the address of the object can be found. */
+
+ tree
+ get_inner_reference (exp, pbitsize, pbitpos, poffset, pmode,
+! punsignedp, pvolatilep)
+ tree exp;
+ int *pbitsize;
+--- 3564,3572 ----
+ If the field describes a variable-sized object, *PMODE is set to
+ VOIDmode and *PBITSIZE is set to -1. An access cannot be made in
+! this case, but the address of the object can be found. */
+
+ tree
+ get_inner_reference (exp, pbitsize, pbitpos, poffset, pmode,
+! punsignedp, pvolatilep, palignment)
+ tree exp;
+ int *pbitsize;
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3537,3540 ****
+--- 3576,3580 ----
+ int *punsignedp;
+ int *pvolatilep;
++ int *palignment;
+ {
+ tree orig_exp = exp;
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3542,3545 ****
+--- 3582,3586 ----
+ enum machine_mode mode = VOIDmode;
+ tree offset = integer_zero_node;
++ int alignment = BIGGEST_ALIGNMENT;
+
+ if (TREE_CODE (exp) == COMPONENT_REF)
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3599,3607 ****
+
+ *pbitpos += TREE_INT_CST_LOW (constant);
+!
+! if (var)
+! offset = size_binop (PLUS_EXPR, offset,
+! size_binop (EXACT_DIV_EXPR, var,
+! size_int (BITS_PER_UNIT)));
+ }
+
+--- 3640,3646 ----
+
+ *pbitpos += TREE_INT_CST_LOW (constant);
+! offset = size_binop (PLUS_EXPR, offset,
+! size_binop (EXACT_DIV_EXPR, var,
+! size_int (BITS_PER_UNIT)));
+ }
+
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3629,3633 ****
+
+ index = fold (build (MULT_EXPR, index_type, index,
+! TYPE_SIZE (TREE_TYPE (exp))));
+
+ if (TREE_CODE (index) == INTEGER_CST
+--- 3668,3673 ----
+
+ index = fold (build (MULT_EXPR, index_type, index,
+! convert (index_type,
+! TYPE_SIZE (TREE_TYPE (exp)))));
+
+ if (TREE_CODE (index) == INTEGER_CST
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3652,3666 ****
+ if (TREE_THIS_VOLATILE (exp))
+ *pvolatilep = 1;
+ exp = TREE_OPERAND (exp, 0);
+ }
+
+! /* If this was a bit-field, see if there is a mode that allows direct
+! access in case EXP is in memory. */
+! if (mode == VOIDmode && *pbitsize != 0 && *pbitpos % *pbitsize == 0)
+! {
+! mode = mode_for_size (*pbitsize, MODE_INT, 0);
+! if (mode == BLKmode)
+! mode = VOIDmode;
+! }
+
+ if (integer_zerop (offset))
+--- 3692,3708 ----
+ if (TREE_THIS_VOLATILE (exp))
+ *pvolatilep = 1;
++
++ /* If the offset is non-constant already, then we can't assume any
++ alignment more than the alignment here. */
++ if (! integer_zerop (offset))
++ alignment = MIN (alignment, TYPE_ALIGN (TREE_TYPE (exp)));
++
+ exp = TREE_OPERAND (exp, 0);
+ }
+
+! if (TREE_CODE_CLASS (TREE_CODE (exp)) == 'd')
+! alignment = MIN (alignment, DECL_ALIGN (exp));
+! else if (TREE_TYPE (exp) != 0)
+! alignment = MIN (alignment, TYPE_ALIGN (TREE_TYPE (exp)));
+
+ if (integer_zerop (offset))
+*************** get_inner_reference (exp, pbitsize, pbit
+*** 3672,3675 ****
+--- 3714,3718 ----
+ *pmode = mode;
+ *poffset = offset;
++ *palignment = alignment / BITS_PER_UNIT;
+ return exp;
+ }
+*************** init_noncopied_parts (lhs, list)
+*** 3812,3820 ****
+ }
+
+! /* Subroutine of expand_expr: return nonzero iff there is no way that
+ EXP can reference X, which is being modified. */
+
+ static int
+! safe_from_p (x, exp)
+ rtx x;
+ tree exp;
+--- 3855,3867 ----
+ }
+
+! static int safe_from_p_count;
+! static int safe_from_p_size;
+! static tree *safe_from_p_rewritten;
+!
+! /* Subroutine of safe_from_p: return nonzero iff there is no way that
+ EXP can reference X, which is being modified. */
+
+ static int
+! safe_from_p_1 (x, exp)
+ rtx x;
+ tree exp;
+*************** safe_from_p (x, exp)
+*** 3822,3825 ****
+--- 3869,3873 ----
+ rtx exp_rtl = 0;
+ int i, nops;
++ int is_save_expr = 0;
+
+ if (x == 0
+*************** safe_from_p (x, exp)
+*** 3860,3878 ****
+
+ case 'x':
+! if (TREE_CODE (exp) == TREE_LIST)
+! return ((TREE_VALUE (exp) == 0
+! || safe_from_p (x, TREE_VALUE (exp)))
+! && (TREE_CHAIN (exp) == 0
+! || safe_from_p (x, TREE_CHAIN (exp))));
+! else
+! return 0;
+
+ case '1':
+! return safe_from_p (x, TREE_OPERAND (exp, 0));
+
+ case '2':
+ case '<':
+! return (safe_from_p (x, TREE_OPERAND (exp, 0))
+! && safe_from_p (x, TREE_OPERAND (exp, 1)));
+
+ case 'e':
+--- 3908,3933 ----
+
+ case 'x':
+! switch (TREE_CODE (exp))
+! {
+! case TREE_LIST:
+! return ((TREE_VALUE (exp) == 0
+! || safe_from_p_1 (x, TREE_VALUE (exp)))
+! && (TREE_CHAIN (exp) == 0
+! || safe_from_p_1 (x, TREE_CHAIN (exp))));
+!
+! case ERROR_MARK:
+! return 1;
+!
+! default:
+! return 0;
+! }
+
+ case '1':
+! return safe_from_p_1 (x, TREE_OPERAND (exp, 0));
+
+ case '2':
+ case '<':
+! return (safe_from_p_1 (x, TREE_OPERAND (exp, 0))
+! && safe_from_p_1 (x, TREE_OPERAND (exp, 1)));
+
+ case 'e':
+*************** safe_from_p (x, exp)
+*** 3887,3891 ****
+ case ADDR_EXPR:
+ return (staticp (TREE_OPERAND (exp, 0))
+! || safe_from_p (x, TREE_OPERAND (exp, 0)));
+
+ case INDIRECT_REF:
+--- 3942,3946 ----
+ case ADDR_EXPR:
+ return (staticp (TREE_OPERAND (exp, 0))
+! || safe_from_p_1 (x, TREE_OPERAND (exp, 0)));
+
+ case INDIRECT_REF:
+*************** safe_from_p (x, exp)
+*** 3922,3928 ****
+
+ case CLEANUP_POINT_EXPR:
+! return safe_from_p (x, TREE_OPERAND (exp, 0));
+
+ case SAVE_EXPR:
+ exp_rtl = SAVE_EXPR_RTL (exp);
+ break;
+--- 3977,3984 ----
+
+ case CLEANUP_POINT_EXPR:
+! return safe_from_p_1 (x, TREE_OPERAND (exp, 0));
+
+ case SAVE_EXPR:
++ is_save_expr = 1;
+ exp_rtl = SAVE_EXPR_RTL (exp);
+ break;
+*************** safe_from_p (x, exp)
+*** 3931,3935 ****
+ /* The only operand we look at is operand 1. The rest aren't
+ part of the expression. */
+! return safe_from_p (x, TREE_OPERAND (exp, 1));
+
+ case METHOD_CALL_EXPR:
+--- 3987,3991 ----
+ /* The only operand we look at is operand 1. The rest aren't
+ part of the expression. */
+! return safe_from_p_1 (x, TREE_OPERAND (exp, 1));
+
+ case METHOD_CALL_EXPR:
+*************** safe_from_p (x, exp)
+*** 3945,3949 ****
+ for (i = 0; i < nops; i++)
+ if (TREE_OPERAND (exp, i) != 0
+! && ! safe_from_p (x, TREE_OPERAND (exp, i)))
+ return 0;
+ }
+--- 4001,4005 ----
+ for (i = 0; i < nops; i++)
+ if (TREE_OPERAND (exp, i) != 0
+! && ! safe_from_p_1 (x, TREE_OPERAND (exp, i)))
+ return 0;
+ }
+*************** safe_from_p (x, exp)
+*** 3969,3975 ****
+--- 4025,4087 ----
+
+ /* If we reach here, it is safe. */
++ if (is_save_expr)
++ {
++ /* This SAVE_EXPR might appear many times in the top-level
++ safe_from_p() expression, and if it has a complex
++ subexpression, examining it multiple times could result
++ in a combinatorial explosion. E.g. on an Alpha Cabriolet
++ running at least 200MHz, a Fortran test case compiled with
++ optimization took about 28 minutes to compile -- even though
++ it was only a few lines long, and the complicated line causing
++ so much time to be spent in the earlier version of safe_from_p()
++ had only 293 or so unique nodes.
++
++ So, turn this SAVE_EXPR into an ERROR_MARK for now, but remember
++ where it is so we can turn it back in the top-level safe_from_p()
++ when we're done. */
++
++ if (safe_from_p_count > safe_from_p_size)
++ return 0; /* For now, don't bother re-sizing the array. */
++ safe_from_p_rewritten[safe_from_p_count++] = exp;
++ TREE_SET_CODE (exp, ERROR_MARK);
++ }
++
+ return 1;
+ }
+
++ /* Subroutine of expand_expr: return nonzero iff there is no way that
++ EXP can reference X, which is being modified. */
++
++ static int
++ safe_from_p (x, exp)
++ rtx x;
++ tree exp;
++ {
++ int rtn;
++ int i;
++ tree trees[128];
++
++ safe_from_p_count = 0;
++ safe_from_p_size = sizeof (trees) / sizeof (trees[0]);
++ safe_from_p_rewritten = &trees[0];
++
++ rtn = safe_from_p_1 (x, exp);
++
++ #if 0
++ if (safe_from_p_count != 0)
++ fprintf (stderr, "%s:%d: safe_from_p_count = %d\n",
++ input_filename, lineno, safe_from_p_count);
++ #endif
++
++ for (i = 0; i < safe_from_p_count; ++i)
++ {
++ if (TREE_CODE (trees [i]) != ERROR_MARK)
++ abort ();
++ TREE_SET_CODE (trees[i], SAVE_EXPR);
++ }
++
++ return rtn;
++ }
++
+ /* Subroutine of expand_expr: return nonzero iff EXP is an
+ expression whose type is statically determinable. */
+*************** expand_expr (exp, target, tmode, modifie
+*** 4534,4537 ****
+--- 4646,4658 ----
+ }
+ }
++
++ if (TREE_READONLY (exp))
++ {
++ if (GET_CODE (target) == MEM)
++ target = change_address (target, GET_MODE (target),
++ XEXP (target, 0));
++ RTX_UNCHANGING_P (target) = 1;
++ }
++
+ store_constructor (exp, target);
+ return target;
+*************** expand_expr (exp, target, tmode, modifie
+*** 4543,4567 ****
+ tree exp2;
+
+! /* A SAVE_EXPR as the address in an INDIRECT_EXPR is generated
+! for *PTR += ANYTHING where PTR is put inside the SAVE_EXPR.
+! This code has the same general effect as simply doing
+! expand_expr on the save expr, except that the expression PTR
+! is computed for use as a memory address. This means different
+! code, suitable for indexing, may be generated. */
+! if (TREE_CODE (exp1) == SAVE_EXPR
+! && SAVE_EXPR_RTL (exp1) == 0
+! && TYPE_MODE (TREE_TYPE (exp1)) == ptr_mode)
+! {
+! temp = expand_expr (TREE_OPERAND (exp1, 0), NULL_RTX,
+! VOIDmode, EXPAND_SUM);
+! op0 = memory_address (mode, temp);
+! op0 = copy_all_regs (op0);
+! SAVE_EXPR_RTL (exp1) = op0;
+! }
+! else
+! {
+! op0 = expand_expr (exp1, NULL_RTX, VOIDmode, EXPAND_SUM);
+! op0 = memory_address (mode, op0);
+! }
+
+ temp = gen_rtx (MEM, mode, op0);
+--- 4664,4669 ----
+ tree exp2;
+
+! op0 = expand_expr (exp1, NULL_RTX, VOIDmode, EXPAND_SUM);
+! op0 = memory_address (mode, op0);
+
+ temp = gen_rtx (MEM, mode, op0);
+*************** expand_expr (exp, target, tmode, modifie
+*** 4770,4776 ****
+ tree offset;
+ int volatilep = 0;
+- tree tem = get_inner_reference (exp, &bitsize, &bitpos, &offset,
+- &mode1, &unsignedp, &volatilep);
+ int alignment;
+
+ /* If we got back the original object, something is wrong. Perhaps
+--- 4872,4879 ----
+ tree offset;
+ int volatilep = 0;
+ int alignment;
++ tree tem = get_inner_reference (exp, &bitsize, &bitpos, &offset,
++ &mode1, &unsignedp, &volatilep,
++ &alignment);
+
+ /* If we got back the original object, something is wrong. Perhaps
+*************** expand_expr (exp, target, tmode, modifie
+*** 4793,4797 ****
+ != INTEGER_CST)
+ ? target : NULL_RTX),
+! VOIDmode, EXPAND_SUM);
+
+ /* If this is a constant, put it into a register if it is a
+--- 4896,4901 ----
+ != INTEGER_CST)
+ ? target : NULL_RTX),
+! VOIDmode,
+! modifier == EXPAND_INITIALIZER ? modifier : 0);
+
+ /* If this is a constant, put it into a register if it is a
+*************** expand_expr (exp, target, tmode, modifie
+*** 4806,4810 ****
+ }
+
+- alignment = TYPE_ALIGN (TREE_TYPE (tem)) / BITS_PER_UNIT;
+ if (offset != 0)
+ {
+--- 4910,4913 ----
+*************** expand_expr (exp, target, tmode, modifie
+*** 4816,4827 ****
+ gen_rtx (PLUS, ptr_mode, XEXP (op0, 0),
+ force_reg (ptr_mode, offset_rtx)));
+- /* If we have a variable offset, the known alignment
+- is only that of the innermost structure containing the field.
+- (Actually, we could sometimes do better by using the
+- size of an element of the innermost array, but no need.) */
+- if (TREE_CODE (exp) == COMPONENT_REF
+- || TREE_CODE (exp) == BIT_FIELD_REF)
+- alignment = (TYPE_ALIGN (TREE_TYPE (TREE_OPERAND (exp, 0)))
+- / BITS_PER_UNIT);
+ }
+
+--- 4919,4922 ----
+*************** expand_expr (exp, target, tmode, modifie
+*** 4844,4848 ****
+ && modifier != EXPAND_SUM
+ && modifier != EXPAND_INITIALIZER
+! && ((mode1 != BLKmode && ! direct_load[(int) mode1])
+ /* If the field isn't aligned enough to fetch as a memref,
+ fetch it as a bit field. */
+--- 4939,4945 ----
+ && modifier != EXPAND_SUM
+ && modifier != EXPAND_INITIALIZER
+! && ((mode1 != BLKmode && ! direct_load[(int) mode1]
+! && GET_MODE_CLASS (mode) != MODE_COMPLEX_INT
+! && GET_MODE_CLASS (mode) != MODE_COMPLEX_FLOAT)
+ /* If the field isn't aligned enough to fetch as a memref,
+ fetch it as a bit field. */
+*************** expand_expr (exp, target, tmode, modifie
+*** 4857,4861 ****
+
+ if (ext_mode == BLKmode)
+! abort ();
+
+ op0 = extract_bit_field (validize_mem (op0), bitsize, bitpos,
+--- 4954,4982 ----
+
+ if (ext_mode == BLKmode)
+! {
+! /* In this case, BITPOS must start at a byte boundary and
+! TARGET, if specified, must be a MEM. */
+! if (GET_CODE (op0) != MEM
+! || (target != 0 && GET_CODE (target) != MEM)
+! || bitpos % BITS_PER_UNIT != 0)
+! abort ();
+!
+! op0 = change_address (op0, VOIDmode,
+! plus_constant (XEXP (op0, 0),
+! bitpos / BITS_PER_UNIT));
+! if (target == 0)
+! {
+! target
+! = assign_stack_temp (mode, int_size_in_bytes (type), 0);
+! MEM_IN_STRUCT_P (target) = AGGREGATE_TYPE_P (type);
+! }
+!
+! emit_block_move (target, op0,
+! GEN_INT ((bitsize + BITS_PER_UNIT - 1)
+! / BITS_PER_UNIT),
+! 1);
+!
+! return target;
+! }
+
+ op0 = extract_bit_field (validize_mem (op0), bitsize, bitpos,
+*************** expand_expr (exp, target, tmode, modifie
+*** 4863,4866 ****
+--- 4984,4999 ----
+ alignment,
+ int_size_in_bytes (TREE_TYPE (tem)));
++
++ /* If the result is a record type and BITSIZE is narrower than
++ the mode of OP0, an integral mode, and this is a big endian
++ machine, we must put the field into the high-order bits. */
++ if (TREE_CODE (type) == RECORD_TYPE && BYTES_BIG_ENDIAN
++ && GET_MODE_CLASS (GET_MODE (op0)) == MODE_INT
++ && bitsize < GET_MODE_BITSIZE (GET_MODE (op0)))
++ op0 = expand_shift (LSHIFT_EXPR, GET_MODE (op0), op0,
++ size_int (GET_MODE_BITSIZE (GET_MODE (op0))
++ - bitsize),
++ op0, 1);
++
+ if (mode == BLKmode)
+ {
+*************** expand_expr (exp, target, tmode, modifie
+*** 4877,4880 ****
+--- 5010,5018 ----
+ }
+
++ /* If the result is BLKmode, use that to access the object
++ now as well. */
++ if (mode == BLKmode)
++ mode1 = BLKmode;
++
+ /* Get a reference to just this component. */
+ if (modifier == EXPAND_CONST_ADDRESS
+*************** expand_expr (exp, target, tmode, modifie
+*** 4888,4895 ****
+ MEM_IN_STRUCT_P (op0) = 1;
+ MEM_VOLATILE_P (op0) |= volatilep;
+! if (mode == mode1 || mode1 == BLKmode || mode1 == tmode)
+ return op0;
+! if (target == 0)
+ target = gen_reg_rtx (tmode != VOIDmode ? tmode : mode);
+ convert_move (target, op0, unsignedp);
+ return target;
+--- 5026,5036 ----
+ MEM_IN_STRUCT_P (op0) = 1;
+ MEM_VOLATILE_P (op0) |= volatilep;
+! if (mode == mode1 || mode1 == BLKmode || mode1 == tmode
+! || modifier == EXPAND_CONST_ADDRESS
+! || modifier == EXPAND_INITIALIZER)
+ return op0;
+! else if (target == 0)
+ target = gen_reg_rtx (tmode != VOIDmode ? tmode : mode);
++
+ convert_move (target, op0, unsignedp);
+ return target;
+*************** expand_builtin (exp, target, subtarget,
+*** 7986,7989 ****
+--- 8127,8365 ----
+ #endif
+
++ /* __builtin_setjmp is passed a pointer to an array of five words
++ (not all will be used on all machines). It operates similarly to
++ the C library function of the same name, but is more efficient.
++ Much of the code below (and for longjmp) is copied from the handling
++ of non-local gotos.
++
++ NOTE: This is intended for use by GNAT and will only work in
++ the method used by it. This code will likely NOT survive to
++ the GCC 2.8.0 release. */
++ case BUILT_IN_SETJMP:
++ if (arglist == 0
++ || TREE_CODE (TREE_TYPE (TREE_VALUE (arglist))) != POINTER_TYPE)
++ break;
++
++ {
++ rtx buf_addr = expand_expr (TREE_VALUE (arglist), subtarget,
++ VOIDmode, 0);
++ rtx lab1 = gen_label_rtx (), lab2 = gen_label_rtx ();
++ enum machine_mode sa_mode = Pmode;
++ rtx stack_save;
++ int old_inhibit_defer_pop = inhibit_defer_pop;
++ int return_pops = RETURN_POPS_ARGS (get_identifier ("__dummy"),
++ get_identifier ("__dummy"), 0);
++ rtx next_arg_reg;
++ CUMULATIVE_ARGS args_so_far;
++ int current_call_is_indirect = 1;
++ int i;
++
++ #ifdef POINTERS_EXTEND_UNSIGNED
++ buf_addr = convert_memory_address (Pmode, buf_addr);
++ #endif
++
++ buf_addr = force_reg (Pmode, buf_addr);
++
++ if (target == 0 || GET_CODE (target) != REG
++ || REGNO (target) < FIRST_PSEUDO_REGISTER)
++ target = gen_reg_rtx (value_mode);
++
++ emit_queue ();
++
++ CONST_CALL_P (emit_note (NULL_PTR, NOTE_INSN_SETJMP)) = 1;
++ current_function_calls_setjmp = 1;
++
++ /* We store the frame pointer and the address of lab1 in the buffer
++ and use the rest of it for the stack save area, which is
++ machine-dependent. */
++ emit_move_insn (gen_rtx (MEM, Pmode, buf_addr),
++ virtual_stack_vars_rtx);
++ emit_move_insn
++ (validize_mem (gen_rtx (MEM, Pmode,
++ plus_constant (buf_addr,
++ GET_MODE_SIZE (Pmode)))),
++ gen_rtx (LABEL_REF, Pmode, lab1));
++
++ #ifdef HAVE_save_stack_nonlocal
++ if (HAVE_save_stack_nonlocal)
++ sa_mode = insn_operand_mode[(int) CODE_FOR_save_stack_nonlocal][0];
++ #endif
++
++ current_function_has_nonlocal_goto = 1;
++
++ stack_save = gen_rtx (MEM, sa_mode,
++ plus_constant (buf_addr,
++ 2 * GET_MODE_SIZE (Pmode)));
++ emit_stack_save (SAVE_NONLOCAL, &stack_save, NULL_RTX);
++
++ #ifdef HAVE_setjmp
++ if (HAVE_setjmp)
++ emit_insn (gen_setjmp ());
++ #endif
++
++ /* Set TARGET to zero and branch around the other case. */
++ emit_move_insn (target, const0_rtx);
++ emit_jump_insn (gen_jump (lab2));
++ emit_barrier ();
++ emit_label (lab1);
++
++ /* Note that setjmp clobbers FP when we get here, so we have to
++ make sure it's marked as used by this function. */
++ emit_insn (gen_rtx (USE, VOIDmode, hard_frame_pointer_rtx));
++
++ /* Mark the static chain as clobbered here so life information
++ doesn't get messed up for it. */
++ emit_insn (gen_rtx (CLOBBER, VOIDmode, static_chain_rtx));
++
++ /* Now put in the code to restore the frame pointer, and argument
++ pointer, if needed. The code below is from expand_end_bindings
++ in stmt.c; see detailed documentation there. */
++ #ifdef HAVE_nonlocal_goto
++ if (! HAVE_nonlocal_goto)
++ #endif
++ emit_move_insn (virtual_stack_vars_rtx, hard_frame_pointer_rtx);
++
++ #if ARG_POINTER_REGNUM != HARD_FRAME_POINTER_REGNUM
++ if (fixed_regs[ARG_POINTER_REGNUM])
++ {
++ #ifdef ELIMINABLE_REGS
++ static struct elims {int from, to;} elim_regs[] = ELIMINABLE_REGS;
++
++ for (i = 0; i < sizeof elim_regs / sizeof elim_regs[0]; i++)
++ if (elim_regs[i].from == ARG_POINTER_REGNUM
++ && elim_regs[i].to == HARD_FRAME_POINTER_REGNUM)
++ break;
++
++ if (i == sizeof elim_regs / sizeof elim_regs [0])
++ #endif
++ {
++ /* Now restore our arg pointer from the address at which it
++ was saved in our stack frame.
++ If there hasn't be space allocated for it yet, make
++ some now. */
++ if (arg_pointer_save_area == 0)
++ arg_pointer_save_area
++ = assign_stack_local (Pmode, GET_MODE_SIZE (Pmode), 0);
++ emit_move_insn (virtual_incoming_args_rtx,
++ copy_to_reg (arg_pointer_save_area));
++ }
++ }
++ #endif
++
++ #ifdef HAVE_nonlocal_goto_receiver
++ if (HAVE_nonlocal_goto_receiver)
++ emit_insn (gen_nonlocal_goto_receiver ());
++ #endif
++ /* The static chain pointer contains the address of dummy function.
++ We need to call it here to handle some PIC cases of restoring
++ a global pointer. Then return 1. */
++ op0 = copy_to_mode_reg (Pmode, static_chain_rtx);
++
++ /* We can't actually call emit_library_call here, so do everything
++ it does, which isn't much for a libfunc with no args. */
++ op0 = memory_address (FUNCTION_MODE, op0);
++
++ INIT_CUMULATIVE_ARGS (args_so_far, NULL_TREE,
++ gen_rtx (SYMBOL_REF, Pmode, "__dummy"));
++ next_arg_reg = FUNCTION_ARG (args_so_far, VOIDmode, void_type_node, 1);
++
++ #ifndef ACCUMULATE_OUTGOING_ARGS
++ #ifdef HAVE_call_pop
++ if (HAVE_call_pop)
++ emit_call_insn (gen_call_pop (gen_rtx (MEM, FUNCTION_MODE, op0),
++ const0_rtx, next_arg_reg,
++ GEN_INT (return_pops)));
++ else
++ #endif
++ #endif
++
++ #ifdef HAVE_call
++ if (HAVE_call)
++ emit_call_insn (gen_call (gen_rtx (MEM, FUNCTION_MODE, op0),
++ const0_rtx, next_arg_reg, const0_rtx));
++ else
++ #endif
++ abort ();
++
++ emit_move_insn (target, const1_rtx);
++ emit_label (lab2);
++ return target;
++ }
++
++ /* __builtin_longjmp is passed a pointer to an array of five words
++ and a value, which is a dummy. It's similar to the C library longjmp
++ function but works with __builtin_setjmp above. */
++ case BUILT_IN_LONGJMP:
++ if (arglist == 0 || TREE_CHAIN (arglist) == 0
++ || TREE_CODE (TREE_TYPE (TREE_VALUE (arglist))) != POINTER_TYPE)
++ break;
++
++ {
++ tree dummy_id = get_identifier ("__dummy");
++ tree dummy_type = build_function_type (void_type_node, NULL_TREE);
++ tree dummy_decl = build_decl (FUNCTION_DECL, dummy_id, dummy_type);
++ #ifdef POINTERS_EXTEND_UNSIGNED
++ rtx buf_addr
++ = force_reg (Pmode,
++ convert_memory_address
++ (Pmode,
++ expand_expr (TREE_VALUE (arglist),
++ NULL_RTX, VOIDmode, 0)));
++ #else
++ rtx buf_addr
++ = force_reg (Pmode, expand_expr (TREE_VALUE (arglist),
++ NULL_RTX,
++ VOIDmode, 0));
++ #endif
++ rtx fp = gen_rtx (MEM, Pmode, buf_addr);
++ rtx lab = gen_rtx (MEM, Pmode,
++ plus_constant (buf_addr, GET_MODE_SIZE (Pmode)));
++ enum machine_mode sa_mode
++ #ifdef HAVE_save_stack_nonlocal
++ = (HAVE_save_stack_nonlocal
++ ? insn_operand_mode[(int) CODE_FOR_save_stack_nonlocal][0]
++ : Pmode);
++ #else
++ = Pmode;
++ #endif
++ rtx stack = gen_rtx (MEM, sa_mode,
++ plus_constant (buf_addr,
++ 2 * GET_MODE_SIZE (Pmode)));
++
++ DECL_EXTERNAL (dummy_decl) = 1;
++ TREE_PUBLIC (dummy_decl) = 1;
++ make_decl_rtl (dummy_decl, NULL_PTR, 1);
++
++ /* Expand the second expression just for side-effects. */
++ expand_expr (TREE_VALUE (TREE_CHAIN (arglist)),
++ const0_rtx, VOIDmode, 0);
++
++ assemble_external (dummy_decl);
++
++ /* Pick up FP, label, and SP from the block and jump. This code is
++ from expand_goto in stmt.c; see there for detailed comments. */
++ #if HAVE_nonlocal_goto
++ if (HAVE_nonlocal_goto)
++ emit_insn (gen_nonlocal_goto (fp, lab, stack,
++ XEXP (DECL_RTL (dummy_decl), 0)));
++ else
++ #endif
++ {
++ lab = copy_to_reg (lab);
++ emit_move_insn (hard_frame_pointer_rtx, fp);
++ emit_stack_restore (SAVE_NONLOCAL, stack, NULL_RTX);
++
++ /* Put in the static chain register the address of the dummy
++ function. */
++ emit_move_insn (static_chain_rtx, XEXP (DECL_RTL (dummy_decl), 0));
++ emit_insn (gen_rtx (USE, VOIDmode, hard_frame_pointer_rtx));
++ emit_insn (gen_rtx (USE, VOIDmode, stack_pointer_rtx));
++ emit_insn (gen_rtx (USE, VOIDmode, static_chain_rtx));
++ emit_indirect_jump (lab);
++ }
++
++ return const0_rtx;
++ }
++
+ default: /* just do library call, if unknown builtin */
+ error ("built-in function `%s' not currently supported",
+*************** preexpand_calls (exp)
+*** 8688,8701 ****
+ case CALL_EXPR:
+ /* Do nothing if already expanded. */
+! if (CALL_EXPR_RTL (exp) != 0)
+ return;
+
+! /* Do nothing to built-in functions. */
+! if (TREE_CODE (TREE_OPERAND (exp, 0)) != ADDR_EXPR
+! || TREE_CODE (TREE_OPERAND (TREE_OPERAND (exp, 0), 0)) != FUNCTION_DECL
+! || ! DECL_BUILT_IN (TREE_OPERAND (TREE_OPERAND (exp, 0), 0))
+! /* Do nothing if the call returns a variable-sized object. */
+! || TREE_CODE (TYPE_SIZE (TREE_TYPE(exp))) != INTEGER_CST)
+! CALL_EXPR_RTL (exp) = expand_call (exp, NULL_RTX, 0);
+ return;
+
+--- 9064,9078 ----
+ case CALL_EXPR:
+ /* Do nothing if already expanded. */
+! if (CALL_EXPR_RTL (exp) != 0
+! /* Do nothing if the call returns a variable-sized object. */
+! || TREE_CODE (TYPE_SIZE (TREE_TYPE(exp))) != INTEGER_CST
+! /* Do nothing to built-in functions. */
+! || (TREE_CODE (TREE_OPERAND (exp, 0)) == ADDR_EXPR
+! && (TREE_CODE (TREE_OPERAND (TREE_OPERAND (exp, 0), 0))
+! == FUNCTION_DECL)
+! && DECL_BUILT_IN (TREE_OPERAND (TREE_OPERAND (exp, 0), 0))))
+ return;
+
+! CALL_EXPR_RTL (exp) = expand_call (exp, NULL_RTX, 0);
+ return;
+
+*************** do_jump (exp, if_false_label, if_true_la
+*** 9087,9090 ****
+--- 9464,9468 ----
+ push_temp_slots ();
+ expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0);
++ preserve_temp_slots (NULL_RTX);
+ free_temp_slots ();
+ pop_temp_slots ();
+*************** do_jump (exp, if_false_label, if_true_la
+*** 9103,9111 ****
+ tree offset;
+ int volatilep = 0;
+
+ /* Get description of this reference. We don't actually care
+ about the underlying object here. */
+ get_inner_reference (exp, &bitsize, &bitpos, &offset,
+! &mode, &unsignedp, &volatilep);
+
+ type = type_for_size (bitsize, unsignedp);
+--- 9481,9491 ----
+ tree offset;
+ int volatilep = 0;
++ int alignment;
+
+ /* Get description of this reference. We don't actually care
+ about the underlying object here. */
+ get_inner_reference (exp, &bitsize, &bitpos, &offset,
+! &mode, &unsignedp, &volatilep,
+! &alignment);
+
+ type = type_for_size (bitsize, unsignedp);
+diff -rcp2N gcc-2.7.2.2/final.c g77-new/final.c
+*** gcc-2.7.2.2/final.c Sun Nov 26 13:50:00 1995
+--- g77-new/final.c Thu Jul 10 20:11:16 1997
+*************** profile_function (file)
+*** 983,991 ****
+ text_section ();
+
+! #ifdef STRUCT_VALUE_INCOMING_REGNUM
+ if (sval)
+ ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_INCOMING_REGNUM);
+ #else
+! #ifdef STRUCT_VALUE_REGNUM
+ if (sval)
+ ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_REGNUM);
+--- 983,991 ----
+ text_section ();
+
+! #if defined(STRUCT_VALUE_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+ if (sval)
+ ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_INCOMING_REGNUM);
+ #else
+! #if defined(STRUCT_VALUE_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+ if (sval)
+ ASM_OUTPUT_REG_PUSH (file, STRUCT_VALUE_REGNUM);
+*************** profile_function (file)
+*** 993,1027 ****
+ #endif
+
+! #if 0
+! #ifdef STATIC_CHAIN_INCOMING_REGNUM
+ if (cxt)
+ ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_INCOMING_REGNUM);
+ #else
+! #ifdef STATIC_CHAIN_REGNUM
+ if (cxt)
+ ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_REGNUM);
+ #endif
+ #endif
+- #endif /* 0 */
+
+ FUNCTION_PROFILER (file, profile_label_no);
+
+! #if 0
+! #ifdef STATIC_CHAIN_INCOMING_REGNUM
+ if (cxt)
+ ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_INCOMING_REGNUM);
+ #else
+! #ifdef STATIC_CHAIN_REGNUM
+ if (cxt)
+ ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_REGNUM);
+ #endif
+ #endif
+- #endif /* 0 */
+
+! #ifdef STRUCT_VALUE_INCOMING_REGNUM
+ if (sval)
+ ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_INCOMING_REGNUM);
+ #else
+! #ifdef STRUCT_VALUE_REGNUM
+ if (sval)
+ ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_REGNUM);
+--- 993,1023 ----
+ #endif
+
+! #if defined(STATIC_CHAIN_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+ if (cxt)
+ ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_INCOMING_REGNUM);
+ #else
+! #if defined(STATIC_CHAIN_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+ if (cxt)
+ ASM_OUTPUT_REG_PUSH (file, STATIC_CHAIN_REGNUM);
+ #endif
+ #endif
+
+ FUNCTION_PROFILER (file, profile_label_no);
+
+! #if defined(STATIC_CHAIN_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+ if (cxt)
+ ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_INCOMING_REGNUM);
+ #else
+! #if defined(STATIC_CHAIN_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+ if (cxt)
+ ASM_OUTPUT_REG_POP (file, STATIC_CHAIN_REGNUM);
+ #endif
+ #endif
+
+! #if defined(STRUCT_VALUE_INCOMING_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+ if (sval)
+ ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_INCOMING_REGNUM);
+ #else
+! #if defined(STRUCT_VALUE_REGNUM) && defined(ASM_OUTPUT_REG_PUSH)
+ if (sval)
+ ASM_OUTPUT_REG_POP (file, STRUCT_VALUE_REGNUM);
+diff -rcp2N gcc-2.7.2.2/flags.h g77-new/flags.h
+*** gcc-2.7.2.2/flags.h Thu Jun 15 07:34:11 1995
+--- g77-new/flags.h Thu Jul 10 20:08:56 1997
+*************** extern int flag_unroll_loops;
+*** 204,207 ****
+--- 204,221 ----
+ extern int flag_unroll_all_loops;
+
++ /* Nonzero forces all invariant computations in loops to be moved
++ outside the loop. */
++
++ extern int flag_move_all_movables;
++
++ /* Nonzero forces all general induction variables in loops to be
++ strength reduced. */
++
++ extern int flag_reduce_all_givs;
++
++ /* Nonzero gets another run of loop_optimize performed. */
++
++ extern int flag_rerun_loop_opt;
++
+ /* Nonzero for -fcse-follow-jumps:
+ have cse follow jumps to do a more extensive job. */
+*************** extern int flag_gnu_linker;
+*** 339,342 ****
+--- 353,369 ----
+ /* Tag all structures with __attribute__(packed) */
+ extern int flag_pack_struct;
++
++ /* 1 if alias checking is enabled: symbols do not alias each other
++ and parameters do not alias the current stack frame. */
++ extern int flag_alias_check;
++
++ /* This flag is only tested if alias checking is enabled.
++ 0 if pointer arguments may alias each other. True in C.
++ 1 if pointer arguments may not alias each other but may alias
++ global variables.
++ 2 if pointer arguments may not alias each other and may not
++ alias global variables. True in Fortran.
++ The value is ignored if flag_alias_check is 0. */
++ extern int flag_argument_noalias;
+
+ /* Other basic status info about current function. */
+diff -rcp2N gcc-2.7.2.2/flow.c g77-new/flow.c
+*** gcc-2.7.2.2/flow.c Mon Aug 28 06:23:34 1995
+--- g77-new/flow.c Sun Aug 10 18:46:11 1997
+*************** static HARD_REG_SET elim_reg_set;
+*** 288,292 ****
+ /* Forward declarations */
+ static void find_basic_blocks PROTO((rtx, rtx));
+! static int uses_reg_or_mem PROTO((rtx));
+ static void mark_label_ref PROTO((rtx, rtx, int));
+ static void life_analysis PROTO((rtx, int));
+--- 288,292 ----
+ /* Forward declarations */
+ static void find_basic_blocks PROTO((rtx, rtx));
+! static int jmp_uses_reg_or_mem PROTO((rtx));
+ static void mark_label_ref PROTO((rtx, rtx, int));
+ static void life_analysis PROTO((rtx, int));
+*************** find_basic_blocks (f, nonlocal_label_lis
+*** 554,563 ****
+ if (GET_CODE (XVECEXP (pat, 0, i)) == SET
+ && SET_DEST (XVECEXP (pat, 0, i)) == pc_rtx
+! && uses_reg_or_mem (SET_SRC (XVECEXP (pat, 0, i))))
+ computed_jump = 1;
+ }
+ else if (GET_CODE (pat) == SET
+ && SET_DEST (pat) == pc_rtx
+! && uses_reg_or_mem (SET_SRC (pat)))
+ computed_jump = 1;
+
+--- 554,563 ----
+ if (GET_CODE (XVECEXP (pat, 0, i)) == SET
+ && SET_DEST (XVECEXP (pat, 0, i)) == pc_rtx
+! && jmp_uses_reg_or_mem (SET_SRC (XVECEXP (pat, 0, i))))
+ computed_jump = 1;
+ }
+ else if (GET_CODE (pat) == SET
+ && SET_DEST (pat) == pc_rtx
+! && jmp_uses_reg_or_mem (SET_SRC (pat)))
+ computed_jump = 1;
+
+*************** find_basic_blocks (f, nonlocal_label_lis
+*** 760,767 ****
+ /* Subroutines of find_basic_blocks. */
+
+! /* Return 1 if X contain a REG or MEM that is not in the constant pool. */
+
+ static int
+! uses_reg_or_mem (x)
+ rtx x;
+ {
+--- 760,768 ----
+ /* Subroutines of find_basic_blocks. */
+
+! /* Return 1 if X, the SRC_SRC of SET of (pc) contain a REG or MEM that is
+! not in the constant pool and not in the condition of an IF_THEN_ELSE. */
+
+ static int
+! jmp_uses_reg_or_mem (x)
+ rtx x;
+ {
+*************** uses_reg_or_mem (x)
+*** 770,778 ****
+ char *fmt;
+
+! if (code == REG
+! || (code == MEM
+! && ! (GET_CODE (XEXP (x, 0)) == SYMBOL_REF
+! && CONSTANT_POOL_ADDRESS_P (XEXP (x, 0)))))
+! return 1;
+
+ fmt = GET_RTX_FORMAT (code);
+--- 771,796 ----
+ char *fmt;
+
+! switch (code)
+! {
+! case CONST:
+! case LABEL_REF:
+! case PC:
+! return 0;
+!
+! case REG:
+! return 1;
+!
+! case MEM:
+! return ! (GET_CODE (XEXP (x, 0)) == SYMBOL_REF
+! && CONSTANT_POOL_ADDRESS_P (XEXP (x, 0)));
+!
+! case IF_THEN_ELSE:
+! return (jmp_uses_reg_or_mem (XEXP (x, 1))
+! || jmp_uses_reg_or_mem (XEXP (x, 2)));
+!
+! case PLUS: case MINUS: case MULT:
+! return (jmp_uses_reg_or_mem (XEXP (x, 0))
+! || jmp_uses_reg_or_mem (XEXP (x, 1)));
+! }
+
+ fmt = GET_RTX_FORMAT (code);
+*************** uses_reg_or_mem (x)
+*** 780,789 ****
+ {
+ if (fmt[i] == 'e'
+! && uses_reg_or_mem (XEXP (x, i)))
+ return 1;
+
+ if (fmt[i] == 'E')
+ for (j = 0; j < XVECLEN (x, i); j++)
+! if (uses_reg_or_mem (XVECEXP (x, i, j)))
+ return 1;
+ }
+--- 798,807 ----
+ {
+ if (fmt[i] == 'e'
+! && jmp_uses_reg_or_mem (XEXP (x, i)))
+ return 1;
+
+ if (fmt[i] == 'E')
+ for (j = 0; j < XVECLEN (x, i); j++)
+! if (jmp_uses_reg_or_mem (XVECEXP (x, i, j)))
+ return 1;
+ }
+*************** propagate_block (old, first, last, final
+*** 1605,1614 ****
+
+ /* Each call clobbers all call-clobbered regs that are not
+! global. Note that the function-value reg is a
+ call-clobbered reg, and mark_set_regs has already had
+ a chance to handle it. */
+
+ for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+! if (call_used_regs[i] && ! global_regs[i])
+ dead[i / REGSET_ELT_BITS]
+ |= ((REGSET_ELT_TYPE) 1 << (i % REGSET_ELT_BITS));
+--- 1623,1633 ----
+
+ /* Each call clobbers all call-clobbered regs that are not
+! global or fixed. Note that the function-value reg is a
+ call-clobbered reg, and mark_set_regs has already had
+ a chance to handle it. */
+
+ for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+! if (call_used_regs[i] && ! global_regs[i]
+! && ! fixed_regs[i])
+ dead[i / REGSET_ELT_BITS]
+ |= ((REGSET_ELT_TYPE) 1 << (i % REGSET_ELT_BITS));
+diff -rcp2N gcc-2.7.2.2/fold-const.c g77-new/fold-const.c
+*** gcc-2.7.2.2/fold-const.c Fri Sep 15 18:26:12 1995
+--- g77-new/fold-const.c Sun Aug 10 18:47:18 1997
+*************** static tree unextend PROTO((tree, int, i
+*** 80,83 ****
+--- 80,84 ----
+ static tree fold_truthop PROTO((enum tree_code, tree, tree, tree));
+ static tree strip_compound_expr PROTO((tree, tree));
++ static int multiple_of_p PROTO((tree, tree, tree));
+
+ #ifndef BRANCH_COST
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1077,1080 ****
+--- 1078,1083 ----
+ if (int2h == 0 && int2l > 0
+ && TREE_TYPE (arg1) == sizetype
++ && ! TREE_CONSTANT_OVERFLOW (arg1)
++ && ! TREE_CONSTANT_OVERFLOW (arg2)
+ && int1h == 0 && int1l >= 0)
+ {
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1230,1233 ****
+--- 1233,1237 ----
+ if (TREE_CODE (arg1) == COMPLEX_CST)
+ {
++ register tree type = TREE_TYPE (arg1);
+ register tree r1 = TREE_REALPART (arg1);
+ register tree i1 = TREE_IMAGPART (arg1);
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1239,1253 ****
+ {
+ case PLUS_EXPR:
+! t = build_complex (const_binop (PLUS_EXPR, r1, r2, notrunc),
+ const_binop (PLUS_EXPR, i1, i2, notrunc));
+ break;
+
+ case MINUS_EXPR:
+! t = build_complex (const_binop (MINUS_EXPR, r1, r2, notrunc),
+ const_binop (MINUS_EXPR, i1, i2, notrunc));
+ break;
+
+ case MULT_EXPR:
+! t = build_complex (const_binop (MINUS_EXPR,
+ const_binop (MULT_EXPR,
+ r1, r2, notrunc),
+--- 1243,1260 ----
+ {
+ case PLUS_EXPR:
+! t = build_complex (type,
+! const_binop (PLUS_EXPR, r1, r2, notrunc),
+ const_binop (PLUS_EXPR, i1, i2, notrunc));
+ break;
+
+ case MINUS_EXPR:
+! t = build_complex (type,
+! const_binop (MINUS_EXPR, r1, r2, notrunc),
+ const_binop (MINUS_EXPR, i1, i2, notrunc));
+ break;
+
+ case MULT_EXPR:
+! t = build_complex (type,
+! const_binop (MINUS_EXPR,
+ const_binop (MULT_EXPR,
+ r1, r2, notrunc),
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1271,1293 ****
+ notrunc);
+
+! t = build_complex
+! (const_binop (INTEGRAL_TYPE_P (TREE_TYPE (r1))
+! ? TRUNC_DIV_EXPR : RDIV_EXPR,
+! const_binop (PLUS_EXPR,
+! const_binop (MULT_EXPR, r1, r2,
+! notrunc),
+! const_binop (MULT_EXPR, i1, i2,
+! notrunc),
+! notrunc),
+! magsquared, notrunc),
+! const_binop (INTEGRAL_TYPE_P (TREE_TYPE (r1))
+! ? TRUNC_DIV_EXPR : RDIV_EXPR,
+! const_binop (MINUS_EXPR,
+! const_binop (MULT_EXPR, i1, r2,
+! notrunc),
+! const_binop (MULT_EXPR, r1, i2,
+! notrunc),
+! notrunc),
+! magsquared, notrunc));
+ }
+ break;
+--- 1278,1302 ----
+ notrunc);
+
+! t = build_complex (type,
+! const_binop
+! (INTEGRAL_TYPE_P (TREE_TYPE (r1))
+! ? TRUNC_DIV_EXPR : RDIV_EXPR,
+! const_binop (PLUS_EXPR,
+! const_binop (MULT_EXPR, r1, r2,
+! notrunc),
+! const_binop (MULT_EXPR, i1, i2,
+! notrunc),
+! notrunc),
+! magsquared, notrunc),
+! const_binop
+! (INTEGRAL_TYPE_P (TREE_TYPE (r1))
+! ? TRUNC_DIV_EXPR : RDIV_EXPR,
+! const_binop (MINUS_EXPR,
+! const_binop (MULT_EXPR, i1, r2,
+! notrunc),
+! const_binop (MULT_EXPR, r1, i2,
+! notrunc),
+! notrunc),
+! magsquared, notrunc));
+ }
+ break;
+*************** const_binop (code, arg1, arg2, notrunc)
+*** 1296,1300 ****
+ abort ();
+ }
+- TREE_TYPE (t) = TREE_TYPE (arg1);
+ return t;
+ }
+--- 1305,1308 ----
+*************** size_binop (code, arg0, arg1)
+*** 1346,1363 ****
+ {
+ /* And some specific cases even faster than that. */
+! if (code == PLUS_EXPR
+! && TREE_INT_CST_LOW (arg0) == 0
+! && TREE_INT_CST_HIGH (arg0) == 0)
+ return arg1;
+! if (code == MINUS_EXPR
+! && TREE_INT_CST_LOW (arg1) == 0
+! && TREE_INT_CST_HIGH (arg1) == 0)
+ return arg0;
+! if (code == MULT_EXPR
+! && TREE_INT_CST_LOW (arg0) == 1
+! && TREE_INT_CST_HIGH (arg0) == 0)
+ return arg1;
+ /* Handle general case of two integer constants. */
+! return const_binop (code, arg0, arg1, 0);
+ }
+
+--- 1354,1367 ----
+ {
+ /* And some specific cases even faster than that. */
+! if (code == PLUS_EXPR && integer_zerop (arg0))
+ return arg1;
+! else if ((code == MINUS_EXPR || code == PLUS_EXPR)
+! && integer_zerop (arg1))
+ return arg0;
+! else if (code == MULT_EXPR && integer_onep (arg0))
+ return arg1;
++
+ /* Handle general case of two integer constants. */
+! return const_binop (code, arg0, arg1, 1);
+ }
+
+*************** fold_convert (t, arg1)
+*** 1482,1486 ****
+ {
+ if (REAL_VALUE_ISNAN (TREE_REAL_CST (arg1)))
+! return arg1;
+ else if (setjmp (float_error))
+ {
+--- 1486,1494 ----
+ {
+ if (REAL_VALUE_ISNAN (TREE_REAL_CST (arg1)))
+! {
+! t = arg1;
+! TREE_TYPE (arg1) = type;
+! return t;
+! }
+ else if (setjmp (float_error))
+ {
+*************** operand_equal_p (arg0, arg1, only_const)
+*** 1644,1687 ****
+ STRIP_NOPS (arg1);
+
+! /* If ARG0 and ARG1 are the same SAVE_EXPR, they are necessarily equal.
+! We don't care about side effects in that case because the SAVE_EXPR
+! takes care of that for us. */
+! if (TREE_CODE (arg0) == SAVE_EXPR && arg0 == arg1)
+! return ! only_const;
+!
+! if (TREE_SIDE_EFFECTS (arg0) || TREE_SIDE_EFFECTS (arg1))
+ return 0;
+
+! if (TREE_CODE (arg0) == TREE_CODE (arg1)
+! && TREE_CODE (arg0) == ADDR_EXPR
+! && TREE_OPERAND (arg0, 0) == TREE_OPERAND (arg1, 0))
+! return 1;
+!
+! if (TREE_CODE (arg0) == TREE_CODE (arg1)
+! && TREE_CODE (arg0) == INTEGER_CST
+! && TREE_INT_CST_LOW (arg0) == TREE_INT_CST_LOW (arg1)
+! && TREE_INT_CST_HIGH (arg0) == TREE_INT_CST_HIGH (arg1))
+ return 1;
+
+! /* Detect when real constants are equal. */
+! if (TREE_CODE (arg0) == TREE_CODE (arg1)
+! && TREE_CODE (arg0) == REAL_CST)
+! return !bcmp ((char *) &TREE_REAL_CST (arg0),
+! (char *) &TREE_REAL_CST (arg1),
+! sizeof (REAL_VALUE_TYPE));
+
+ if (only_const)
+ return 0;
+
+- if (arg0 == arg1)
+- return 1;
+-
+- if (TREE_CODE (arg0) != TREE_CODE (arg1))
+- return 0;
+- /* This is needed for conversions and for COMPONENT_REF.
+- Might as well play it safe and always test this. */
+- if (TYPE_MODE (TREE_TYPE (arg0)) != TYPE_MODE (TREE_TYPE (arg1)))
+- return 0;
+-
+ switch (TREE_CODE_CLASS (TREE_CODE (arg0)))
+ {
+--- 1652,1705 ----
+ STRIP_NOPS (arg1);
+
+! if (TREE_CODE (arg0) != TREE_CODE (arg1)
+! /* This is needed for conversions and for COMPONENT_REF.
+! Might as well play it safe and always test this. */
+! || TYPE_MODE (TREE_TYPE (arg0)) != TYPE_MODE (TREE_TYPE (arg1)))
+ return 0;
+
+! /* If ARG0 and ARG1 are the same SAVE_EXPR, they are necessarily equal.
+! We don't care about side effects in that case because the SAVE_EXPR
+! takes care of that for us. In all other cases, two expressions are
+! equal if they have no side effects. If we have two identical
+! expressions with side effects that should be treated the same due
+! to the only side effects being identical SAVE_EXPR's, that will
+! be detected in the recursive calls below. */
+! if (arg0 == arg1 && ! only_const
+! && (TREE_CODE (arg0) == SAVE_EXPR
+! || (! TREE_SIDE_EFFECTS (arg0) && ! TREE_SIDE_EFFECTS (arg1))))
+ return 1;
+
+! /* Next handle constant cases, those for which we can return 1 even
+! if ONLY_CONST is set. */
+! if (TREE_CONSTANT (arg0) && TREE_CONSTANT (arg1))
+! switch (TREE_CODE (arg0))
+! {
+! case INTEGER_CST:
+! return (TREE_INT_CST_LOW (arg0) == TREE_INT_CST_LOW (arg1)
+! && TREE_INT_CST_HIGH (arg0) == TREE_INT_CST_HIGH (arg1));
+!
+! case REAL_CST:
+! return REAL_VALUES_EQUAL (TREE_REAL_CST (arg0), TREE_REAL_CST (arg1));
+!
+! case COMPLEX_CST:
+! return (operand_equal_p (TREE_REALPART (arg0), TREE_REALPART (arg1),
+! only_const)
+! && operand_equal_p (TREE_IMAGPART (arg0), TREE_IMAGPART (arg1),
+! only_const));
+!
+! case STRING_CST:
+! return (TREE_STRING_LENGTH (arg0) == TREE_STRING_LENGTH (arg1)
+! && ! strncmp (TREE_STRING_POINTER (arg0),
+! TREE_STRING_POINTER (arg1),
+! TREE_STRING_LENGTH (arg0)));
+!
+! case ADDR_EXPR:
+! return operand_equal_p (TREE_OPERAND (arg0, 0), TREE_OPERAND (arg1, 0),
+! 0);
+! }
+
+ if (only_const)
+ return 0;
+
+ switch (TREE_CODE_CLASS (TREE_CODE (arg0)))
+ {
+*************** operand_equal_p (arg0, arg1, only_const)
+*** 1698,1705 ****
+ case '<':
+ case '2':
+! return (operand_equal_p (TREE_OPERAND (arg0, 0),
+! TREE_OPERAND (arg1, 0), 0)
+ && operand_equal_p (TREE_OPERAND (arg0, 1),
+! TREE_OPERAND (arg1, 1), 0));
+
+ case 'r':
+--- 1716,1735 ----
+ case '<':
+ case '2':
+! if (operand_equal_p (TREE_OPERAND (arg0, 0), TREE_OPERAND (arg1, 0), 0)
+! && operand_equal_p (TREE_OPERAND (arg0, 1), TREE_OPERAND (arg1, 1),
+! 0))
+! return 1;
+!
+! /* For commutative ops, allow the other order. */
+! return ((TREE_CODE (arg0) == PLUS_EXPR || TREE_CODE (arg0) == MULT_EXPR
+! || TREE_CODE (arg0) == MIN_EXPR || TREE_CODE (arg0) == MAX_EXPR
+! || TREE_CODE (arg0) == BIT_IOR_EXPR
+! || TREE_CODE (arg0) == BIT_XOR_EXPR
+! || TREE_CODE (arg0) == BIT_AND_EXPR
+! || TREE_CODE (arg0) == NE_EXPR || TREE_CODE (arg0) == EQ_EXPR)
+! && operand_equal_p (TREE_OPERAND (arg0, 0),
+! TREE_OPERAND (arg1, 1), 0)
+ && operand_equal_p (TREE_OPERAND (arg0, 1),
+! TREE_OPERAND (arg1, 0), 0));
+
+ case 'r':
+*************** optimize_bit_field_compare (code, compar
+*** 2212,2215 ****
+--- 2242,2246 ----
+ int lunsignedp, runsignedp;
+ int lvolatilep = 0, rvolatilep = 0;
++ int alignment;
+ tree linner, rinner;
+ tree mask;
+*************** optimize_bit_field_compare (code, compar
+*** 2220,2224 ****
+ extraction at all and so can do nothing. */
+ linner = get_inner_reference (lhs, &lbitsize, &lbitpos, &offset, &lmode,
+! &lunsignedp, &lvolatilep);
+ if (linner == lhs || lbitsize == GET_MODE_BITSIZE (lmode) || lbitsize < 0
+ || offset != 0)
+--- 2251,2255 ----
+ extraction at all and so can do nothing. */
+ linner = get_inner_reference (lhs, &lbitsize, &lbitpos, &offset, &lmode,
+! &lunsignedp, &lvolatilep, &alignment);
+ if (linner == lhs || lbitsize == GET_MODE_BITSIZE (lmode) || lbitsize < 0
+ || offset != 0)
+*************** optimize_bit_field_compare (code, compar
+*** 2229,2234 ****
+ /* If this is not a constant, we can only do something if bit positions,
+ sizes, and signedness are the same. */
+! rinner = get_inner_reference (rhs, &rbitsize, &rbitpos, &offset,
+! &rmode, &runsignedp, &rvolatilep);
+
+ if (rinner == rhs || lbitpos != rbitpos || lbitsize != rbitsize
+--- 2260,2265 ----
+ /* If this is not a constant, we can only do something if bit positions,
+ sizes, and signedness are the same. */
+! rinner = get_inner_reference (rhs, &rbitsize, &rbitpos, &offset, &rmode,
+! &runsignedp, &rvolatilep, &alignment);
+
+ if (rinner == rhs || lbitpos != rbitpos || lbitsize != rbitsize
+*************** decode_field_reference (exp, pbitsize, p
+*** 2403,2406 ****
+--- 2434,2438 ----
+ tree unsigned_type;
+ int precision;
++ int alignment;
+
+ /* All the optimizations using this function assume integer fields.
+*************** decode_field_reference (exp, pbitsize, p
+*** 2423,2427 ****
+
+ inner = get_inner_reference (exp, pbitsize, pbitpos, &offset, pmode,
+! punsignedp, pvolatilep);
+ if ((inner == exp && and_mask == 0)
+ || *pbitsize < 0 || offset != 0)
+--- 2455,2459 ----
+
+ inner = get_inner_reference (exp, pbitsize, pbitpos, &offset, pmode,
+! punsignedp, pvolatilep, &alignment);
+ if ((inner == exp && and_mask == 0)
+ || *pbitsize < 0 || offset != 0)
+*************** strip_compound_expr (t, s)
+*** 3065,3068 ****
+--- 3097,3200 ----
+ }
+
++ /* Determine if first argument is a multiple of second argument.
++ Return 0 if it is not, or is not easily determined to so be.
++
++ An example of the sort of thing we care about (at this point --
++ this routine could surely be made more general, and expanded
++ to do what the *_DIV_EXPR's fold() cases do now) is discovering
++ that
++
++ SAVE_EXPR (I) * SAVE_EXPR (J * 8)
++
++ is a multiple of
++
++ SAVE_EXPR (J * 8)
++
++ when we know that the two `SAVE_EXPR (J * 8)' nodes are the
++ same node (which means they will have the same value at run
++ time, even though we don't know when they'll be assigned).
++
++ This code also handles discovering that
++
++ SAVE_EXPR (I) * SAVE_EXPR (J * 8)
++
++ is a multiple of
++
++ 8
++
++ (of course) so we don't have to worry about dealing with a
++ possible remainder.
++
++ Note that we _look_ inside a SAVE_EXPR only to determine
++ how it was calculated; it is not safe for fold() to do much
++ of anything else with the internals of a SAVE_EXPR, since
++ fold() cannot know when it will be evaluated at run time.
++ For example, the latter example above _cannot_ be implemented
++ as
++
++ SAVE_EXPR (I) * J
++
++ or any variant thereof, since the value of J at evaluation time
++ of the original SAVE_EXPR is not necessarily the same at the time
++ the new expression is evaluated. The only optimization of this
++ sort that would be valid is changing
++
++ SAVE_EXPR (I) * SAVE_EXPR (SAVE_EXPR (J) * 8)
++ divided by
++ 8
++
++ to
++
++ SAVE_EXPR (I) * SAVE_EXPR (J)
++
++ (where the same SAVE_EXPR (J) is used in the original and the
++ transformed version). */
++
++ static int
++ multiple_of_p (type, top, bottom)
++ tree type;
++ tree top;
++ tree bottom;
++ {
++ if (operand_equal_p (top, bottom, 0))
++ return 1;
++
++ if (TREE_CODE (type) != INTEGER_TYPE)
++ return 0;
++
++ switch (TREE_CODE (top))
++ {
++ case MULT_EXPR:
++ return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom)
++ || multiple_of_p (type, TREE_OPERAND (top, 1), bottom));
++
++ case PLUS_EXPR:
++ case MINUS_EXPR:
++ return (multiple_of_p (type, TREE_OPERAND (top, 0), bottom)
++ && multiple_of_p (type, TREE_OPERAND (top, 1), bottom));
++
++ case NOP_EXPR:
++ /* Punt if conversion from non-integral or wider integral type. */
++ if ((TREE_CODE (TREE_TYPE (TREE_OPERAND (top, 0))) != INTEGER_TYPE)
++ || (TYPE_PRECISION (type)
++ < TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (top, 0)))))
++ return 0;
++ /* Fall through. */
++ case SAVE_EXPR:
++ return multiple_of_p (type, TREE_OPERAND (top, 0), bottom);
++
++ case INTEGER_CST:
++ if ((TREE_CODE (bottom) != INTEGER_CST)
++ || (tree_int_cst_sgn (top) < 0)
++ || (tree_int_cst_sgn (bottom) < 0))
++ return 0;
++ return integer_zerop (const_binop (TRUNC_MOD_EXPR,
++ top, bottom, 0));
++
++ default:
++ return 0;
++ }
++ }
++
+ /* Perform constant folding and related simplification of EXPR.
+ The related simplifications include x*1 => x, x*0 => 0, etc.,
+*************** fold (expr)
+*** 3611,3615 ****
+ TREE_OPERAND (arg0, 1))));
+ else if (TREE_CODE (arg0) == COMPLEX_CST)
+! return build_complex (TREE_OPERAND (arg0, 0),
+ fold (build1 (NEGATE_EXPR,
+ TREE_TYPE (TREE_TYPE (arg0)),
+--- 3743,3747 ----
+ TREE_OPERAND (arg0, 1))));
+ else if (TREE_CODE (arg0) == COMPLEX_CST)
+! return build_complex (type, TREE_OPERAND (arg0, 0),
+ fold (build1 (NEGATE_EXPR,
+ TREE_TYPE (TREE_TYPE (arg0)),
+*************** fold (expr)
+*** 4014,4018 ****
+ return non_lvalue (convert (type, arg0));
+ if (integer_zerop (arg1))
+! return t;
+
+ /* If we have ((a / C1) / C2) where both division are the same type, try
+--- 4146,4166 ----
+ return non_lvalue (convert (type, arg0));
+ if (integer_zerop (arg1))
+! {
+! if (extra_warnings)
+! warning ("integer division by zero");
+! return t;
+! }
+!
+! /* If arg0 is a multiple of arg1, then rewrite to the fastest div
+! operation, EXACT_DIV_EXPR. Otherwise, handle folding of
+! general divide. Note that only CEIL_DIV_EXPR is rewritten now,
+! only because the others seem to be faster in some cases, e.g. the
+! nonoptimized TRUNC_DIV_EXPR or FLOOR_DIV_EXPR on DEC Alpha. This
+! is probably just due to more work being done on it in expmed.c than
+! on EXACT_DIV_EXPR, and could presumably be fixed, since
+! EXACT_DIV_EXPR should _never_ be slower than *_DIV_EXPR. */
+! if ((code == CEIL_DIV_EXPR)
+! && multiple_of_p (type, arg0, arg1))
+! return fold (build (EXACT_DIV_EXPR, type, arg0, arg1));
+
+ /* If we have ((a / C1) / C2) where both division are the same type, try
+*************** fold (expr)
+*** 4049,4053 ****
+ tree xarg0 = arg0;
+
+! if (TREE_CODE (xarg0) == SAVE_EXPR)
+ have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0);
+
+--- 4197,4201 ----
+ tree xarg0 = arg0;
+
+! if (TREE_CODE (xarg0) == SAVE_EXPR && SAVE_EXPR_RTL (xarg0) == 0)
+ have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0);
+
+*************** fold (expr)
+*** 4067,4071 ****
+ }
+
+! if (TREE_CODE (xarg0) == SAVE_EXPR)
+ have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0);
+
+--- 4215,4219 ----
+ }
+
+! if (TREE_CODE (xarg0) == SAVE_EXPR && SAVE_EXPR_RTL (xarg0) == 0)
+ have_save_expr = 1, xarg0 = TREE_OPERAND (xarg0, 0);
+
+*************** fold (expr)
+*** 5050,5054 ****
+ case COMPLEX_EXPR:
+ if (wins)
+! return build_complex (arg0, arg1);
+ return t;
+
+--- 5198,5202 ----
+ case COMPLEX_EXPR:
+ if (wins)
+! return build_complex (type, arg0, arg1);
+ return t;
+
+diff -rcp2N gcc-2.7.2.2/function.c g77-new/function.c
+*** gcc-2.7.2.2/function.c Sun Nov 26 14:50:26 1995
+--- g77-new/function.c Sun Aug 10 18:47:24 1997
+*************** free_temps_for_rtl_expr (t)
+*** 1184,1187 ****
+--- 1184,1202 ----
+ }
+
++ /* Mark all temporaries ever allocated in this functon as not suitable
++ for reuse until the current level is exited. */
++
++ void
++ mark_all_temps_used ()
++ {
++ struct temp_slot *p;
++
++ for (p = temp_slots; p; p = p->next)
++ {
++ p->in_use = 1;
++ p->level = MIN (p->level, temp_slot_level);
++ }
++ }
++
+ /* Push deeper into the nesting level for stack temporaries. */
+
+*************** pop_temp_slots ()
+*** 1208,1211 ****
+--- 1223,1237 ----
+ temp_slot_level--;
+ }
++
++ /* Initialize temporary slots. */
++
++ void
++ init_temp_slots ()
++ {
++ /* We have not allocated any temporaries yet. */
++ temp_slots = 0;
++ temp_slot_level = 0;
++ target_temp_slot_level = 0;
++ }
+
+ /* Retroactively move an auto variable from a register to a stack slot.
+*************** instantiate_virtual_regs_1 (loc, object,
+*** 2838,2842 ****
+ case MEM:
+ /* Most cases of MEM that convert to valid addresses have already been
+! handled by our scan of regno_reg_rtx. The only special handling we
+ need here is to make a copy of the rtx to ensure it isn't being
+ shared if we have to change it to a pseudo.
+--- 2864,2868 ----
+ case MEM:
+ /* Most cases of MEM that convert to valid addresses have already been
+! handled by our scan of decls. The only special handling we
+ need here is to make a copy of the rtx to ensure it isn't being
+ shared if we have to change it to a pseudo.
+*************** instantiate_virtual_regs_1 (loc, object,
+*** 2896,2900 ****
+ has less restrictions on an address that some other insn.
+ In that case, we will modify the shared address. This case
+! doesn't seem very likely, though. */
+
+ if (instantiate_virtual_regs_1 (&XEXP (x, 0),
+--- 2922,2928 ----
+ has less restrictions on an address that some other insn.
+ In that case, we will modify the shared address. This case
+! doesn't seem very likely, though. One case where this could
+! happen is in the case of a USE or CLOBBER reference, but we
+! take care of that below. */
+
+ if (instantiate_virtual_regs_1 (&XEXP (x, 0),
+*************** instantiate_virtual_regs_1 (loc, object,
+*** 2909,2914 ****
+
+ /* Fall through to generic unary operation case. */
+- case USE:
+- case CLOBBER:
+ case SUBREG:
+ case STRICT_LOW_PART:
+--- 2937,2940 ----
+*************** instantiate_virtual_regs_1 (loc, object,
+*** 2927,2930 ****
+--- 2953,2973 ----
+ goto restart;
+
++ case USE:
++ case CLOBBER:
++ /* If the operand is a MEM, see if the change is a valid MEM. If not,
++ go ahead and make the invalid one, but do it to a copy. For a REG,
++ just make the recursive call, since there's no chance of a problem. */
++
++ if ((GET_CODE (XEXP (x, 0)) == MEM
++ && instantiate_virtual_regs_1 (&XEXP (XEXP (x, 0), 0), XEXP (x, 0),
++ 0))
++ || (GET_CODE (XEXP (x, 0)) == REG
++ && instantiate_virtual_regs_1 (&XEXP (x, 0), 0, 0)))
++ return 1;
++
++ XEXP (x, 0) = copy_rtx (XEXP (x, 0));
++ loc = &XEXP (x, 0);
++ goto restart;
++
+ case REG:
+ /* Try to replace with a PLUS. If that doesn't work, compute the sum
+*************** assign_parms (fndecl, second_time)
+*** 3404,3409 ****
+
+ /* If this is a memory ref that contains aggregate components,
+! mark it as such for cse and loop optimize. */
+ MEM_IN_STRUCT_P (stack_parm) = aggregate;
+ }
+
+--- 3447,3454 ----
+
+ /* If this is a memory ref that contains aggregate components,
+! mark it as such for cse and loop optimize. Likewise if it
+! is readonly. */
+ MEM_IN_STRUCT_P (stack_parm) = aggregate;
++ RTX_UNCHANGING_P (stack_parm) = TREE_READONLY (parm);
+ }
+
+*************** assign_parms (fndecl, second_time)
+*** 3627,3631 ****
+
+ parmreg = gen_reg_rtx (promoted_nominal_mode);
+! REG_USERVAR_P (parmreg) = 1;
+
+ /* If this was an item that we received a pointer to, set DECL_RTL
+--- 3672,3676 ----
+
+ parmreg = gen_reg_rtx (promoted_nominal_mode);
+! mark_user_reg (parmreg);
+
+ /* If this was an item that we received a pointer to, set DECL_RTL
+*************** assign_parms (fndecl, second_time)
+*** 3695,3699 ****
+ Pmode above. We must use the actual mode of the parm. */
+ parmreg = gen_reg_rtx (TYPE_MODE (TREE_TYPE (parm)));
+! REG_USERVAR_P (parmreg) = 1;
+ emit_move_insn (parmreg, DECL_RTL (parm));
+ DECL_RTL (parm) = parmreg;
+--- 3740,3744 ----
+ Pmode above. We must use the actual mode of the parm. */
+ parmreg = gen_reg_rtx (TYPE_MODE (TREE_TYPE (parm)));
+! mark_user_reg (parmreg);
+ emit_move_insn (parmreg, DECL_RTL (parm));
+ DECL_RTL (parm) = parmreg;
+*************** init_function_start (subr, filename, lin
+*** 4814,4821 ****
+ rtl_expr_chain = 0;
+
+! /* We have not allocated any temporaries yet. */
+! temp_slots = 0;
+! temp_slot_level = 0;
+! target_temp_slot_level = 0;
+
+ /* Within function body, compute a type's size as soon it is laid out. */
+--- 4859,4864 ----
+ rtl_expr_chain = 0;
+
+! /* Set up to allocate temporaries. */
+! init_temp_slots ();
+
+ /* Within function body, compute a type's size as soon it is laid out. */
+diff -rcp2N gcc-2.7.2.2/gcc.c g77-new/gcc.c
+*** gcc-2.7.2.2/gcc.c Tue Sep 12 17:15:11 1995
+--- g77-new/gcc.c Sun Aug 10 18:47:14 1997
+*************** static int is_directory PROTO((char *,
+*** 296,300 ****
+ static void validate_switches PROTO((char *));
+ static void validate_all_switches PROTO((void));
+! static void give_switch PROTO((int, int));
+ static int used_arg PROTO((char *, int));
+ static int default_arg PROTO((char *, int));
+--- 296,300 ----
+ static void validate_switches PROTO((char *));
+ static void validate_all_switches PROTO((void));
+! static void give_switch PROTO((int, int, int));
+ static int used_arg PROTO((char *, int));
+ static int default_arg PROTO((char *, int));
+*************** or with constant text in a single argume
+*** 405,408 ****
+--- 405,409 ----
+ name starts with `o'. %{o*} would substitute this text,
+ including the space; thus, two arguments would be generated.
++ %{^S*} likewise, but don't put a blank between a switch and any args.
+ %{S*:X} substitutes X if one or more switches whose names start with -S are
+ specified to CC. Note that the tail part of the -S option
+*************** process_command (argc, argv)
+*** 2828,2831 ****
+--- 2829,2835 ----
+ infiles[n_infiles++].name = argv[i];
+ }
++ /* -save-temps overrides -pipe, so that temp files are produced */
++ else if (save_temps_flag && strcmp (argv[i], "-pipe") == 0)
++ ;
+ else if (argv[i][0] == '-' && argv[i][1] != 0)
+ {
+*************** handle_braces (p)
+*** 3832,3835 ****
+--- 3836,3844 ----
+ int negate = 0;
+ int suffix = 0;
++ int include_blanks = 1;
++
++ if (*p == '^')
++ /* A '^' after the open-brace means to not give blanks before args. */
++ include_blanks = 0, ++p;
+
+ if (*p == '|')
+*************** handle_braces (p)
+*** 3897,3901 ****
+ if (!strncmp (switches[i].part1, filter, p - filter)
+ && check_live_switch (i, p - filter))
+! give_switch (i, 0);
+ }
+ else
+--- 3906,3910 ----
+ if (!strncmp (switches[i].part1, filter, p - filter)
+ && check_live_switch (i, p - filter))
+! give_switch (i, 0, include_blanks);
+ }
+ else
+*************** handle_braces (p)
+*** 3936,3940 ****
+ do_spec_1 (string, 0, &switches[i].part1[hard_match_len]);
+ /* Pass any arguments this switch has. */
+! give_switch (i, 1);
+ }
+
+--- 3945,3949 ----
+ do_spec_1 (string, 0, &switches[i].part1[hard_match_len]);
+ /* Pass any arguments this switch has. */
+! give_switch (i, 1, 1);
+ }
+
+*************** handle_braces (p)
+*** 3980,3984 ****
+ if (*p == '}')
+ {
+! give_switch (i, 0);
+ }
+ else
+--- 3989,3993 ----
+ if (*p == '}')
+ {
+! give_switch (i, 0, include_blanks);
+ }
+ else
+*************** check_live_switch (switchnum, prefix_len
+*** 4081,4090 ****
+ This cannot fail since it never finishes a command line.
+
+! If OMIT_FIRST_WORD is nonzero, then we omit .part1 of the argument. */
+
+ static void
+! give_switch (switchnum, omit_first_word)
+ int switchnum;
+ int omit_first_word;
+ {
+ if (!omit_first_word)
+--- 4090,4103 ----
+ This cannot fail since it never finishes a command line.
+
+! If OMIT_FIRST_WORD is nonzero, then we omit .part1 of the argument.
+!
+! If INCLUDE_BLANKS is nonzero, then we include blanks before each argument
+! of the switch. */
+
+ static void
+! give_switch (switchnum, omit_first_word, include_blanks)
+ int switchnum;
+ int omit_first_word;
++ int include_blanks;
+ {
+ if (!omit_first_word)
+*************** give_switch (switchnum, omit_first_word)
+*** 4093,4097 ****
+ do_spec_1 (switches[switchnum].part1, 1, NULL_PTR);
+ }
+! do_spec_1 (" ", 0, NULL_PTR);
+ if (switches[switchnum].args != 0)
+ {
+--- 4106,4110 ----
+ do_spec_1 (switches[switchnum].part1, 1, NULL_PTR);
+ }
+!
+ if (switches[switchnum].args != 0)
+ {
+*************** give_switch (switchnum, omit_first_word)
+*** 4099,4106 ****
+ for (p = switches[switchnum].args; *p; p++)
+ {
+ do_spec_1 (*p, 1, NULL_PTR);
+- do_spec_1 (" ", 0, NULL_PTR);
+ }
+ }
+ switches[switchnum].valid = 1;
+ }
+--- 4112,4122 ----
+ for (p = switches[switchnum].args; *p; p++)
+ {
++ if (include_blanks)
++ do_spec_1 (" ", 0, NULL_PTR);
+ do_spec_1 (*p, 1, NULL_PTR);
+ }
+ }
++
++ do_spec_1 (" ", 0, NULL_PTR);
+ switches[switchnum].valid = 1;
+ }
+diff -rcp2N gcc-2.7.2.2/gcc.texi g77-new/gcc.texi
+*** gcc-2.7.2.2/gcc.texi Thu Feb 20 19:24:19 1997
+--- g77-new/gcc.texi Thu Jul 10 20:08:58 1997
+*************** original English.
+*** 149,152 ****
+--- 149,153 ----
+ @sp 3
+ @center Last updated 29 June 1996
++ @center (Revised for GNU Fortran 1997-01-10)
+ @sp 1
+ @c The version number appears twice more in this file.
+diff -rcp2N gcc-2.7.2.2/glimits.h g77-new/glimits.h
+*** gcc-2.7.2.2/glimits.h Wed Sep 29 17:30:54 1993
+--- g77-new/glimits.h Thu Jul 10 20:08:58 1997
+***************
+*** 64,68 ****
+ (Same as `int'). */
+ #ifndef __LONG_MAX__
+! #define __LONG_MAX__ 2147483647L
+ #endif
+ #undef LONG_MIN
+--- 64,72 ----
+ (Same as `int'). */
+ #ifndef __LONG_MAX__
+! # ifndef __alpha__
+! # define __LONG_MAX__ 2147483647L
+! # else
+! # define __LONG_MAX__ 9223372036854775807LL
+! # endif /* __alpha__ */
+ #endif
+ #undef LONG_MIN
+diff -rcp2N gcc-2.7.2.2/integrate.c g77-new/integrate.c
+*** gcc-2.7.2.2/integrate.c Fri Oct 20 18:48:13 1995
+--- g77-new/integrate.c Sun Aug 10 18:46:31 1997
+*************** static rtx copy_for_inline PROTO((rtx));
+*** 67,70 ****
+--- 67,71 ----
+ static void integrate_parm_decls PROTO((tree, struct inline_remap *, rtvec));
+ static void integrate_decl_tree PROTO((tree, int, struct inline_remap *));
++ static void save_constants_in_decl_trees PROTO ((tree));
+ static void subst_constants PROTO((rtx *, rtx, struct inline_remap *));
+ static void restore_constants PROTO((rtx *));
+*************** save_for_inline_copying (fndecl)
+*** 435,438 ****
+--- 436,443 ----
+ }
+
++ /* Also scan all decls, and replace any constant pool references with the
++ actual constant. */
++ save_constants_in_decl_trees (DECL_INITIAL (fndecl));
++
+ /* Clear out the constant pool so that we can recreate it with the
+ copied constants below. */
+*************** save_for_inline_nocopy (fndecl)
+*** 781,784 ****
+--- 786,793 ----
+ }
+
++ /* Also scan all decls, and replace any constant pool references with the
++ actual constant. */
++ save_constants_in_decl_trees (DECL_INITIAL (fndecl));
++
+ /* We have now allocated all that needs to be allocated permanently
+ on the rtx obstack. Set our high-water mark, so that we
+*************** expand_inline_function (fndecl, parms, t
+*** 1571,1575 ****
+ if (GET_CODE (XEXP (loc, 0)) == REG)
+ {
+! temp = force_reg (Pmode, structure_value_addr);
+ map->reg_map[REGNO (XEXP (loc, 0))] = temp;
+ if ((CONSTANT_P (structure_value_addr)
+--- 1580,1585 ----
+ if (GET_CODE (XEXP (loc, 0)) == REG)
+ {
+! temp = force_reg (Pmode,
+! force_operand (structure_value_addr, NULL_RTX));
+ map->reg_map[REGNO (XEXP (loc, 0))] = temp;
+ if ((CONSTANT_P (structure_value_addr)
+*************** integrate_decl_tree (let, level, map)
+*** 2029,2032 ****
+--- 2039,2059 ----
+ }
+ }
++ }
++
++ /* Given a BLOCK node LET, search for all DECL_RTL fields, and pass them
++ through save_constants. */
++
++ static void
++ save_constants_in_decl_trees (let)
++ tree let;
++ {
++ tree t;
++
++ for (t = BLOCK_VARS (let); t; t = TREE_CHAIN (t))
++ if (DECL_RTL (t) != 0)
++ save_constants (&DECL_RTL (t));
++
++ for (t = BLOCK_SUBBLOCKS (let); t; t = TREE_CHAIN (t))
++ save_constants_in_decl_trees (t);
+ }
+
+diff -rcp2N gcc-2.7.2.2/invoke.texi g77-new/invoke.texi
+*** gcc-2.7.2.2/invoke.texi Tue Oct 3 11:40:43 1995
+--- g77-new/invoke.texi Thu Jul 10 20:09:00 1997
+***************
+*** 1,3 ****
+! @c Copyright (C) 1988, 89, 92, 93, 94, 1995 Free Software Foundation, Inc.
+ @c This is part of the GCC manual.
+ @c For copying conditions, see the file gcc.texi.
+--- 1,3 ----
+! @c Copyright (C) 1988, 89, 92-95, 1997 Free Software Foundation, Inc.
+ @c This is part of the GCC manual.
+ @c For copying conditions, see the file gcc.texi.
+*************** in the following sections.
+*** 149,152 ****
+--- 149,153 ----
+ -fschedule-insns2 -fstrength-reduce -fthread-jumps
+ -funroll-all-loops -funroll-loops
++ -fmove-all-movables -freduce-all-givs -frerun-loop-opt
+ -O -O0 -O1 -O2 -O3
+ @end smallexample
+*************** in addition to the above:
+*** 331,334 ****
+--- 332,337 ----
+ -fshort-double -fvolatile -fvolatile-global
+ -fverbose-asm -fpack-struct +e0 +e1
++ -fargument-alias -fargument-noalias
++ -fargument-noalias-global
+ @end smallexample
+ @end table
+*************** Print extra warning messages for these e
+*** 1253,1256 ****
+--- 1256,1304 ----
+
+ @itemize @bullet
++ @cindex division by zero
++ @cindex zero, division by
++ @item
++ An integer division by zero is detected.
++
++ Some cases of division by zero might occur as the result
++ of using so-called ``safe'' macros.
++ For example:
++
++ @smallexample
++ #define BUCKETS(b) (((b) != NULL) ? (b)->buckets : 0)
++ @dots{...}
++ i = j / BUCKETS(b);
++ @end smallexample
++
++ Although analysis of the context of the above code could
++ prove that @samp{b} is never null when it is executed,
++ the division-by-zero warning is still useful, because
++ @code{gcc} generates code to do the division by zero at
++ run time so as to generate a run-time fault,
++ and tidy programmers will want to find ways to prevent
++ this needless code from being generated.
++
++ Note that @code{gcc} transforms expressions so as to find
++ opportunities for performing expensive operations
++ (such as division) at compile time instead of generating
++ code to perform them at run time.
++ For example, @code{gcc} transforms:
++
++ @smallexample
++ 2 / (i == 0)
++ @end smallexample
++
++ into:
++
++ @smallexample
++ (i == 0) ? (2 / 1) : (2 / 0)
++ @end smallexample
++
++ As a result, the division-by-zero warning might occur
++ in contexts where the divisor seems to be a non-constant.
++ It is useful in this case as well, because programmers might want
++ to clean up the code so the compiled code does not include
++ dead code to divide by zero.
++
+ @cindex @code{longjmp} warnings
+ @item
+*************** and usually makes programs run more slow
+*** 1941,1944 ****
+--- 1989,2037 ----
+ implies @samp{-fstrength-reduce} as well as @samp{-frerun-cse-after-loop}.
+
++ @item -fmove-all-movables
++ Forces all invariant computations in loops to be moved
++ outside the loop.
++ This option is provided primarily to improve performance
++ for some Fortran code, though it might improve code written
++ in other languages.
++
++ @emph{Note:} When compiling programs written in Fortran,
++ this option is enabled by default.
++
++ Analysis of Fortran code optimization and the resulting
++ optimizations triggered by this option, and the
++ @samp{-freduce-all-givs} and @samp{-frerun-loop-opt}
++ options as well, were
++ contributed by Toon Moene (@code{toon@@moene.indiv.nluug.nl}).
++
++ These three options are intended to be removed someday, once
++ they have helped determine the efficacy of various
++ approaches to improving the performance of Fortran code.
++
++ Please let us (@code{fortran@@gnu.ai.mit.edu})
++ know how use of these options affects
++ the performance of your production code.
++ We're very interested in code that runs @emph{slower}
++ when these options are @emph{enabled}.
++
++ @item -freduce-all-givs
++ Forces all general-induction variables in loops to be
++ strength-reduced.
++ This option is provided primarily to improve performance
++ for some Fortran code, though it might improve code written
++ in other languages.
++
++ @emph{Note:} When compiling programs written in Fortran,
++ this option is enabled by default.
++
++ @item -frerun-loop-opt
++ Runs loop optimizations a second time.
++ This option is provided primarily to improve performance
++ for some Fortran code, though it might improve code written
++ in other languages.
++
++ @emph{Note:} When compiling programs written in Fortran,
++ this option is enabled by default.
++
+ @item -fno-peephole
+ Disable any machine-specific peephole optimizations.
+*************** compilation).
+*** 4229,4232 ****
+--- 4322,4397 ----
+ With @samp{+e1}, G++ actually generates the code implementing virtual
+ functions defined in the code, and makes them publicly visible.
++
++ @cindex aliasing of parameters
++ @cindex parameters, aliased
++ @item -fargument-alias
++ @item -fargument-noalias
++ @item -fargument-noalias-global
++ Specify the possible relationships among parameters and between
++ parameters and global data.
++
++ @samp{-fargument-alias} specifies that arguments (parameters) may
++ alias each other and may alias global storage.
++ @samp{-fargument-noalias} specifies that arguments do not alias
++ each other, but may alias global storage.
++ @samp{-fargument-noalias-global} specifies that arguments do not
++ alias each other and do not alias global storage.
++
++ For code written in C, C++, and Objective-C, @samp{-fargument-alias}
++ is the default.
++ For code written in Fortran, @samp{-fargument-noalias-global} is
++ the default, though this is pertinent only on systems where
++ @code{g77} is installed.
++ (See the documentation for other compilers for information on the
++ defaults for their respective languages.)
++
++ Normally, @code{gcc} assumes that a write through a pointer
++ passed as a parameter to the current function might modify a
++ value pointed to by another pointer passed as a parameter, or
++ in global storage.
++
++ For example, consider this code:
++
++ @example
++ void x(int *i, int *j)
++ @{
++ extern int k;
++
++ ++*i;
++ ++*j;
++ ++k;
++ @}
++ @end example
++
++ When compiling the above function, @code{gcc} assumes that @samp{i} might
++ be a pointer to the same variable as @samp{j}, and that either @samp{i},
++ @samp{j}, or both might be a pointer to @samp{k}.
++
++ Therefore, @code{gcc} does not assume it can generate code to read
++ @samp{*i}, @samp{*j}, and @samp{k} into separate registers, increment
++ each register, then write the incremented values back out.
++
++ Instead, @code{gcc} must generate code that reads @samp{*i},
++ increments it, and writes it back before reading @samp{*j},
++ in case @samp{i} and @samp{j} are aliased, and, similarly,
++ that writes @samp{*j} before reading @samp{k}.
++ The result is code that, on many systems, takes longer to execute,
++ due to the way many processors schedule instruction execution.
++
++ Compiling the above code with the @samp{-fargument-noalias} option
++ allows @code{gcc} to assume that @samp{i} and @samp{j} do not alias
++ each other, but either might alias @samp{k}.
++
++ Compiling the above code with the @samp{-fargument-noalias-global}
++ option allows @code{gcc} to assume that no combination of @samp{i},
++ @samp{j}, and @samp{k} are aliases for each other.
++
++ @emph{Note:} Use the @samp{-fargument-noalias} and
++ @samp{-fargument-noalias-global} options with care.
++ While they can result in faster executables, they can
++ also result in executables with subtle bugs, bugs that
++ show up only when compiled for specific target systems,
++ or bugs that show up only when compiled by specific versions
++ of @code{g77}.
+ @end table
+
+diff -rcp2N gcc-2.7.2.2/libgcc2.c g77-new/libgcc2.c
+*** gcc-2.7.2.2/libgcc2.c Sun Nov 26 14:39:21 1995
+--- g77-new/libgcc2.c Sun Aug 10 18:46:07 1997
+*************** __gcc_bcmp (s1, s2, size)
+*** 1193,1196 ****
+--- 1193,1201 ----
+ #endif
+
++ #ifdef L__dummy
++ void
++ __dummy () {}
++ #endif
++
+ #ifdef L_varargs
+ #ifdef __i860__
+diff -rcp2N gcc-2.7.2.2/local-alloc.c g77-new/local-alloc.c
+*** gcc-2.7.2.2/local-alloc.c Mon Aug 21 13:15:44 1995
+--- g77-new/local-alloc.c Sun Aug 10 18:46:10 1997
+*************** static int this_insn_number;
+*** 243,246 ****
+--- 243,250 ----
+ static rtx this_insn;
+
++ /* Used to communicate changes made by update_equiv_regs to
++ memref_referenced_p. */
++ static rtx *reg_equiv_replacement;
++
+ static void alloc_qty PROTO((int, enum machine_mode, int, int));
+ static void alloc_qty_for_scratch PROTO((rtx, int, rtx, int, int));
+*************** validate_equiv_mem_from_store (dest, set
+*** 545,549 ****
+ && reg_overlap_mentioned_p (dest, equiv_mem))
+ || (GET_CODE (dest) == MEM
+! && true_dependence (dest, equiv_mem)))
+ equiv_mem_modified = 1;
+ }
+--- 549,553 ----
+ && reg_overlap_mentioned_p (dest, equiv_mem))
+ || (GET_CODE (dest) == MEM
+! && true_dependence (dest, VOIDmode, equiv_mem, rtx_varies_p)))
+ equiv_mem_modified = 1;
+ }
+*************** memref_referenced_p (memref, x)
+*** 617,621 ****
+ switch (code)
+ {
+- case REG:
+ case CONST_INT:
+ case CONST:
+--- 621,624 ----
+*************** memref_referenced_p (memref, x)
+*** 629,634 ****
+ return 0;
+
+ case MEM:
+! if (true_dependence (memref, x))
+ return 1;
+ break;
+--- 632,642 ----
+ return 0;
+
++ case REG:
++ return (reg_equiv_replacement[REGNO (x)] == 0
++ || memref_referenced_p (memref,
++ reg_equiv_replacement[REGNO (x)]));
++
+ case MEM:
+! if (true_dependence (memref, VOIDmode, x, rtx_varies_p))
+ return 1;
+ break;
+*************** optimize_reg_copy_1 (insn, dest, src)
+*** 818,827 ****
+ if (sregno >= FIRST_PSEUDO_REGISTER)
+ {
+! reg_live_length[sregno] -= length;
+! /* reg_live_length is only an approximation after combine
+! if sched is not run, so make sure that we still have
+! a reasonable value. */
+! if (reg_live_length[sregno] < 2)
+! reg_live_length[sregno] = 2;
+ reg_n_calls_crossed[sregno] -= n_calls;
+ }
+--- 826,839 ----
+ if (sregno >= FIRST_PSEUDO_REGISTER)
+ {
+! if (reg_live_length[sregno] >= 0)
+! {
+! reg_live_length[sregno] -= length;
+! /* reg_live_length is only an approximation after
+! combine if sched is not run, so make sure that we
+! still have a reasonable value. */
+! if (reg_live_length[sregno] < 2)
+! reg_live_length[sregno] = 2;
+! }
+!
+ reg_n_calls_crossed[sregno] -= n_calls;
+ }
+*************** optimize_reg_copy_1 (insn, dest, src)
+*** 829,833 ****
+ if (dregno >= FIRST_PSEUDO_REGISTER)
+ {
+! reg_live_length[dregno] += d_length;
+ reg_n_calls_crossed[dregno] += d_n_calls;
+ }
+--- 841,847 ----
+ if (dregno >= FIRST_PSEUDO_REGISTER)
+ {
+! if (reg_live_length[dregno] >= 0)
+! reg_live_length[dregno] += d_length;
+!
+ reg_n_calls_crossed[dregno] += d_n_calls;
+ }
+*************** update_equiv_regs ()
+*** 948,953 ****
+ {
+ rtx *reg_equiv_init_insn = (rtx *) alloca (max_regno * sizeof (rtx *));
+- rtx *reg_equiv_replacement = (rtx *) alloca (max_regno * sizeof (rtx *));
+ rtx insn;
+
+ bzero ((char *) reg_equiv_init_insn, max_regno * sizeof (rtx *));
+--- 962,968 ----
+ {
+ rtx *reg_equiv_init_insn = (rtx *) alloca (max_regno * sizeof (rtx *));
+ rtx insn;
++
++ reg_equiv_replacement = (rtx *) alloca (max_regno * sizeof (rtx *));
+
+ bzero ((char *) reg_equiv_init_insn, max_regno * sizeof (rtx *));
+diff -rcp2N gcc-2.7.2.2/loop.c g77-new/loop.c
+*** gcc-2.7.2.2/loop.c Thu Feb 20 19:24:20 1997
+--- g77-new/loop.c Sun Aug 10 18:46:43 1997
+*************** int *loop_number_exit_count;
+*** 111,116 ****
+ unsigned HOST_WIDE_INT loop_n_iterations;
+
+! /* Nonzero if there is a subroutine call in the current loop.
+! (unknown_address_altered is also nonzero in this case.) */
+
+ static int loop_has_call;
+--- 111,115 ----
+ unsigned HOST_WIDE_INT loop_n_iterations;
+
+! /* Nonzero if there is a subroutine call in the current loop. */
+
+ static int loop_has_call;
+*************** static char *moved_once;
+*** 160,164 ****
+ here, we just turn on unknown_address_altered. */
+
+! #define NUM_STORES 20
+ static rtx loop_store_mems[NUM_STORES];
+
+--- 159,163 ----
+ here, we just turn on unknown_address_altered. */
+
+! #define NUM_STORES 30
+ static rtx loop_store_mems[NUM_STORES];
+
+*************** scan_loop (loop_start, end, nregs)
+*** 669,673 ****
+ {
+ temp = find_reg_note (p, REG_EQUAL, NULL_RTX);
+! if (temp && CONSTANT_P (XEXP (temp, 0)))
+ src = XEXP (temp, 0), move_insn = 1;
+ if (temp && find_reg_note (p, REG_RETVAL, NULL_RTX))
+--- 668,673 ----
+ {
+ temp = find_reg_note (p, REG_EQUAL, NULL_RTX);
+! if (temp && CONSTANT_P (XEXP (temp, 0))
+! && LEGITIMATE_CONSTANT_P (XEXP (temp, 0)))
+ src = XEXP (temp, 0), move_insn = 1;
+ if (temp && find_reg_note (p, REG_RETVAL, NULL_RTX))
+*************** move_movables (movables, threshold, insn
+*** 1629,1632 ****
+--- 1629,1633 ----
+
+ if (already_moved[regno]
++ || flag_move_all_movables
+ || (threshold * savings * m->lifetime) >= insn_count
+ || (m->forces && m->forces->done
+*************** prescan_loop (start, end)
+*** 2199,2203 ****
+ else if (GET_CODE (insn) == CALL_INSN)
+ {
+! unknown_address_altered = 1;
+ loop_has_call = 1;
+ }
+--- 2200,2205 ----
+ else if (GET_CODE (insn) == CALL_INSN)
+ {
+! if (! CONST_CALL_P (insn))
+! unknown_address_altered = 1;
+ loop_has_call = 1;
+ }
+*************** invariant_p (x)
+*** 2777,2781 ****
+ /* See if there is any dependence between a store and this load. */
+ for (i = loop_store_mems_idx - 1; i >= 0; i--)
+! if (true_dependence (loop_store_mems[i], x))
+ return 0;
+
+--- 2779,2783 ----
+ /* See if there is any dependence between a store and this load. */
+ for (i = loop_store_mems_idx - 1; i >= 0; i--)
+! if (true_dependence (loop_store_mems[i], VOIDmode, x, rtx_varies_p))
+ return 0;
+
+*************** strength_reduce (scan_start, end, loop_t
+*** 3821,3826 ****
+ exit. */
+
+! if (v->lifetime * threshold * benefit < insn_count
+! && ! bl->reversed)
+ {
+ if (loop_dump_stream)
+--- 3823,3828 ----
+ exit. */
+
+! if ( ! flag_reduce_all_givs && v->lifetime * threshold * benefit < insn_count
+! && ! bl->reversed )
+ {
+ if (loop_dump_stream)
+*************** record_giv (v, insn, src_reg, dest_reg,
+*** 4375,4378 ****
+--- 4377,4382 ----
+ v->final_value = 0;
+ v->same_insn = 0;
++ v->unrolled = 0;
++ v->shared = 0;
+
+ /* The v->always_computable field is used in update_giv_derive, to
+*************** check_final_value (v, loop_start, loop_e
+*** 4652,4657 ****
+ if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p)
+ && LABEL_NAME (JUMP_LABEL (p))
+! && ((INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn)
+! && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start))
+ || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use)
+ && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end))))
+--- 4656,4664 ----
+ if (GET_CODE (p) == JUMP_INSN && JUMP_LABEL (p)
+ && LABEL_NAME (JUMP_LABEL (p))
+! && ((INSN_UID (JUMP_LABEL (p)) >= max_uid_for_loop)
+! || (INSN_UID (v->insn) >= max_uid_for_loop)
+! || (INSN_UID (last_giv_use) >= max_uid_for_loop)
+! || (INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (v->insn)
+! && INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (loop_start))
+ || (INSN_LUID (JUMP_LABEL (p)) > INSN_LUID (last_giv_use)
+ && INSN_LUID (JUMP_LABEL (p)) < INSN_LUID (loop_end))))
+*************** emit_iv_add_mult (b, m, a, reg, insert_b
+*** 5560,5563 ****
+--- 5567,5572 ----
+
+ emit_insn_before (seq, insert_before);
++
++ record_base_value (REGNO (reg), b);
+ }
+
+diff -rcp2N gcc-2.7.2.2/loop.h g77-new/loop.h
+*** gcc-2.7.2.2/loop.h Fri Jul 14 08:23:28 1995
+--- g77-new/loop.h Thu Jul 10 20:09:03 1997
+*************** struct induction
+*** 89,92 ****
+--- 89,95 ----
+ we won't use it to eliminate a biv, it
+ would probably lose. */
++ unsigned unrolled : 1; /* 1 if new register has been allocated in
++ unrolled loop. */
++ unsigned shared : 1;
+ int lifetime; /* Length of life of this giv */
+ int times_used; /* # times this giv is used. */
+diff -rcp2N gcc-2.7.2.2/real.c g77-new/real.c
+*** gcc-2.7.2.2/real.c Tue Aug 15 17:57:18 1995
+--- g77-new/real.c Thu Jul 10 20:09:04 1997
+*************** make_nan (nan, sign, mode)
+*** 5625,5633 ****
+ }
+
+! /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE.
+! This is the inverse of the function `etarsingle' invoked by
+ REAL_VALUE_TO_TARGET_SINGLE. */
+
+ REAL_VALUE_TYPE
+ ereal_from_float (f)
+ HOST_WIDE_INT f;
+--- 5625,5699 ----
+ }
+
+! /* This is the inverse of the function `etarsingle' invoked by
+ REAL_VALUE_TO_TARGET_SINGLE. */
+
+ REAL_VALUE_TYPE
++ ereal_unto_float (f)
++ long f;
++ {
++ REAL_VALUE_TYPE r;
++ unsigned EMUSHORT s[2];
++ unsigned EMUSHORT e[NE];
++
++ /* Convert 32 bit integer to array of 16 bit pieces in target machine order.
++ This is the inverse operation to what the function `endian' does. */
++ if (REAL_WORDS_BIG_ENDIAN)
++ {
++ s[0] = (unsigned EMUSHORT) (f >> 16);
++ s[1] = (unsigned EMUSHORT) f;
++ }
++ else
++ {
++ s[0] = (unsigned EMUSHORT) f;
++ s[1] = (unsigned EMUSHORT) (f >> 16);
++ }
++ /* Convert and promote the target float to E-type. */
++ e24toe (s, e);
++ /* Output E-type to REAL_VALUE_TYPE. */
++ PUT_REAL (e, &r);
++ return r;
++ }
++
++
++ /* This is the inverse of the function `etardouble' invoked by
++ REAL_VALUE_TO_TARGET_DOUBLE. */
++
++ REAL_VALUE_TYPE
++ ereal_unto_double (d)
++ long d[];
++ {
++ REAL_VALUE_TYPE r;
++ unsigned EMUSHORT s[4];
++ unsigned EMUSHORT e[NE];
++
++ /* Convert array of HOST_WIDE_INT to equivalent array of 16-bit pieces. */
++ if (REAL_WORDS_BIG_ENDIAN)
++ {
++ s[0] = (unsigned EMUSHORT) (d[0] >> 16);
++ s[1] = (unsigned EMUSHORT) d[0];
++ s[2] = (unsigned EMUSHORT) (d[1] >> 16);
++ s[3] = (unsigned EMUSHORT) d[1];
++ }
++ else
++ {
++ /* Target float words are little-endian. */
++ s[0] = (unsigned EMUSHORT) d[0];
++ s[1] = (unsigned EMUSHORT) (d[0] >> 16);
++ s[2] = (unsigned EMUSHORT) d[1];
++ s[3] = (unsigned EMUSHORT) (d[1] >> 16);
++ }
++ /* Convert target double to E-type. */
++ e53toe (s, e);
++ /* Output E-type to REAL_VALUE_TYPE. */
++ PUT_REAL (e, &r);
++ return r;
++ }
++
++
++ /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE.
++ This is somewhat like ereal_unto_float, but the input types
++ for these are different. */
++
++ REAL_VALUE_TYPE
+ ereal_from_float (f)
+ HOST_WIDE_INT f;
+*************** ereal_from_float (f)
+*** 5658,5663 ****
+
+ /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE.
+! This is the inverse of the function `etardouble' invoked by
+! REAL_VALUE_TO_TARGET_DOUBLE.
+
+ The DFmode is stored as an array of HOST_WIDE_INT in the target's
+--- 5724,5729 ----
+
+ /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE.
+! This is somewhat like ereal_unto_double, but the input types
+! for these are different.
+
+ The DFmode is stored as an array of HOST_WIDE_INT in the target's
+diff -rcp2N gcc-2.7.2.2/real.h g77-new/real.h
+*** gcc-2.7.2.2/real.h Thu Jun 15 07:57:56 1995
+--- g77-new/real.h Thu Jul 10 20:09:05 1997
+*************** extern void ereal_to_decimal PROTO((REAL
+*** 152,155 ****
+--- 152,157 ----
+ extern int ereal_cmp PROTO((REAL_VALUE_TYPE, REAL_VALUE_TYPE));
+ extern int ereal_isneg PROTO((REAL_VALUE_TYPE));
++ extern REAL_VALUE_TYPE ereal_unto_float PROTO((long));
++ extern REAL_VALUE_TYPE ereal_unto_double PROTO((long *));
+ extern REAL_VALUE_TYPE ereal_from_float PROTO((HOST_WIDE_INT));
+ extern REAL_VALUE_TYPE ereal_from_double PROTO((HOST_WIDE_INT *));
+*************** extern REAL_VALUE_TYPE real_value_trunca
+*** 197,200 ****
+--- 199,208 ----
+ /* IN is a REAL_VALUE_TYPE. OUT is a long. */
+ #define REAL_VALUE_TO_TARGET_SINGLE(IN, OUT) ((OUT) = etarsingle ((IN)))
++
++ /* Inverse of REAL_VALUE_TO_TARGET_DOUBLE. */
++ #define REAL_VALUE_UNTO_TARGET_DOUBLE(d) (ereal_unto_double (d))
++
++ /* Inverse of REAL_VALUE_TO_TARGET_SINGLE. */
++ #define REAL_VALUE_UNTO_TARGET_SINGLE(f) (ereal_unto_float (f))
+
+ /* d is an array of HOST_WIDE_INT that holds a double precision
+diff -rcp2N gcc-2.7.2.2/recog.c g77-new/recog.c
+*** gcc-2.7.2.2/recog.c Sat Jul 1 06:52:35 1995
+--- g77-new/recog.c Sun Aug 10 18:46:55 1997
+*************** register_operand (op, mode)
+*** 872,876 ****
+ REGNO (SUBREG_REG (op)))
+ && (GET_MODE_SIZE (mode)
+! != GET_MODE_SIZE (GET_MODE (SUBREG_REG (op)))))
+ return 0;
+ #endif
+--- 872,878 ----
+ REGNO (SUBREG_REG (op)))
+ && (GET_MODE_SIZE (mode)
+! != GET_MODE_SIZE (GET_MODE (SUBREG_REG (op))))
+! && GET_MODE_CLASS (GET_MODE (SUBREG_REG (op))) != MODE_COMPLEX_INT
+! && GET_MODE_CLASS (GET_MODE (SUBREG_REG (op))) != MODE_COMPLEX_FLOAT)
+ return 0;
+ #endif
+diff -rcp2N gcc-2.7.2.2/reload.c g77-new/reload.c
+*** gcc-2.7.2.2/reload.c Sat Nov 11 08:23:54 1995
+--- g77-new/reload.c Sun Aug 10 04:58:03 1997
+***************
+*** 1,4 ****
+ /* Search an insn for pseudo regs that must be in hard regs and are not.
+! Copyright (C) 1987, 88, 89, 92, 93, 94, 1995 Free Software Foundation, Inc.
+
+ This file is part of GNU CC.
+--- 1,4 ----
+ /* Search an insn for pseudo regs that must be in hard regs and are not.
+! Copyright (C) 1987, 88, 89, 92-5, 1996 Free Software Foundation, Inc.
+
+ This file is part of GNU CC.
+*************** static int push_secondary_reload PROTO((
+*** 292,295 ****
+--- 292,296 ----
+ enum machine_mode, enum reload_type,
+ enum insn_code *));
++ static enum reg_class find_valid_class PROTO((enum machine_mode, int));
+ static int push_reload PROTO((rtx, rtx, rtx *, rtx *, enum reg_class,
+ enum machine_mode, enum machine_mode,
+*************** static struct decomposition decompose PR
+*** 305,312 ****
+ static int immune_p PROTO((rtx, rtx, struct decomposition));
+ static int alternative_allows_memconst PROTO((char *, int));
+! static rtx find_reloads_toplev PROTO((rtx, int, enum reload_type, int, int));
+ static rtx make_memloc PROTO((rtx, int));
+ static int find_reloads_address PROTO((enum machine_mode, rtx *, rtx, rtx *,
+! int, enum reload_type, int));
+ static rtx subst_reg_equivs PROTO((rtx));
+ static rtx subst_indexed_address PROTO((rtx));
+--- 306,313 ----
+ static int immune_p PROTO((rtx, rtx, struct decomposition));
+ static int alternative_allows_memconst PROTO((char *, int));
+! static rtx find_reloads_toplev PROTO((rtx, int, enum reload_type, int, int, short *));
+ static rtx make_memloc PROTO((rtx, int));
+ static int find_reloads_address PROTO((enum machine_mode, rtx *, rtx, rtx *,
+! int, enum reload_type, int, short *));
+ static rtx subst_reg_equivs PROTO((rtx));
+ static rtx subst_indexed_address PROTO((rtx));
+*************** push_secondary_reload (in_p, x, opnum, o
+*** 590,599 ****
+
+ if (in_p && icode == CODE_FOR_nothing
+! && SECONDARY_MEMORY_NEEDED (class, reload_class, reload_mode))
+! get_secondary_mem (x, reload_mode, opnum, type);
+
+ if (! in_p && icode == CODE_FOR_nothing
+! && SECONDARY_MEMORY_NEEDED (reload_class, class, reload_mode))
+! get_secondary_mem (x, reload_mode, opnum, type);
+ #endif
+ }
+--- 591,600 ----
+
+ if (in_p && icode == CODE_FOR_nothing
+! && SECONDARY_MEMORY_NEEDED (class, reload_class, mode))
+! get_secondary_mem (x, mode, opnum, type);
+
+ if (! in_p && icode == CODE_FOR_nothing
+! && SECONDARY_MEMORY_NEEDED (reload_class, class, mode))
+! get_secondary_mem (x, mode, opnum, type);
+ #endif
+ }
+*************** get_secondary_mem (x, mode, opnum, type)
+*** 673,677 ****
+
+ find_reloads_address (mode, NULL_PTR, XEXP (loc, 0), &XEXP (loc, 0),
+! opnum, type, 0);
+ }
+
+--- 674,678 ----
+
+ find_reloads_address (mode, NULL_PTR, XEXP (loc, 0), &XEXP (loc, 0),
+! opnum, type, 0, NULL);
+ }
+
+*************** clear_secondary_mem ()
+*** 689,692 ****
+--- 690,725 ----
+ #endif /* SECONDARY_MEMORY_NEEDED */
+
++ /* Find the largest class for which every register number plus N is valid in
++ M1 (if in range). Abort if no such class exists. */
++
++ static enum reg_class
++ find_valid_class (m1, n)
++ enum machine_mode m1;
++ int n;
++ {
++ int class;
++ int regno;
++ enum reg_class best_class;
++ int best_size = 0;
++
++ for (class = 1; class < N_REG_CLASSES; class++)
++ {
++ int bad = 0;
++ for (regno = 0; regno < FIRST_PSEUDO_REGISTER && ! bad; regno++)
++ if (TEST_HARD_REG_BIT (reg_class_contents[class], regno)
++ && TEST_HARD_REG_BIT (reg_class_contents[class], regno + n)
++ && ! HARD_REGNO_MODE_OK (regno + n, m1))
++ bad = 1;
++
++ if (! bad && reg_class_size[class] > best_size)
++ best_class = class, best_size = reg_class_size[class];
++ }
++
++ if (best_size == 0)
++ abort ();
++
++ return best_class;
++ }
++
+ /* Record one reload that needs to be performed.
+ IN is an rtx saying where the data are to be found before this instruction.
+*************** push_reload (in, out, inloc, outloc, cla
+*** 894,898 ****
+ && GET_CODE (SUBREG_REG (in)) == REG
+ && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER
+! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)), inmode)
+ || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD
+ && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in)))
+--- 927,932 ----
+ && GET_CODE (SUBREG_REG (in)) == REG
+ && REGNO (SUBREG_REG (in)) < FIRST_PSEUDO_REGISTER
+! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (in)) + SUBREG_WORD (in),
+! inmode)
+ || (GET_MODE_SIZE (inmode) <= UNITS_PER_WORD
+ && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (in)))
+*************** push_reload (in, out, inloc, outloc, cla
+*** 909,913 ****
+ output before the outer reload. */
+ push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR,
+! GENERAL_REGS, VOIDmode, VOIDmode, 0, 0, opnum, type);
+ dont_remove_subreg = 1;
+ }
+--- 943,948 ----
+ output before the outer reload. */
+ push_reload (SUBREG_REG (in), NULL_RTX, &SUBREG_REG (in), NULL_PTR,
+! find_valid_class (inmode, SUBREG_WORD (in)),
+! VOIDmode, VOIDmode, 0, 0, opnum, type);
+ dont_remove_subreg = 1;
+ }
+*************** push_reload (in, out, inloc, outloc, cla
+*** 982,986 ****
+ && GET_CODE (SUBREG_REG (out)) == REG
+ && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER
+! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)), outmode)
+ || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD
+ && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out)))
+--- 1017,1022 ----
+ && GET_CODE (SUBREG_REG (out)) == REG
+ && REGNO (SUBREG_REG (out)) < FIRST_PSEUDO_REGISTER
+! && (! HARD_REGNO_MODE_OK (REGNO (SUBREG_REG (out)) + SUBREG_WORD (out),
+! outmode)
+ || (GET_MODE_SIZE (outmode) <= UNITS_PER_WORD
+ && (GET_MODE_SIZE (GET_MODE (SUBREG_REG (out)))
+*************** push_reload (in, out, inloc, outloc, cla
+*** 998,1002 ****
+ dont_remove_subreg = 1;
+ push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out),
+! &SUBREG_REG (out), ALL_REGS, VOIDmode, VOIDmode, 0, 0,
+ opnum, RELOAD_OTHER);
+ }
+--- 1034,1040 ----
+ dont_remove_subreg = 1;
+ push_reload (SUBREG_REG (out), SUBREG_REG (out), &SUBREG_REG (out),
+! &SUBREG_REG (out),
+! find_valid_class (outmode, SUBREG_WORD (out)),
+! VOIDmode, VOIDmode, 0, 0,
+ opnum, RELOAD_OTHER);
+ }
+*************** find_reloads (insn, replace, ind_levels,
+*** 2241,2244 ****
+--- 2279,2283 ----
+ int goal_earlyclobber, this_earlyclobber;
+ enum machine_mode operand_mode[MAX_RECOG_OPERANDS];
++ short force_update[MAX_RECOG_OPERANDS];
+
+ this_insn = insn;
+*************** find_reloads (insn, replace, ind_levels,
+*** 2272,2275 ****
+--- 2311,2316 ----
+ #endif
+
++ bzero ((char *) force_update, sizeof force_update);
++
+ /* Find what kind of insn this is. NOPERANDS gets number of operands.
+ Make OPERANDS point to a vector of operand values.
+*************** find_reloads (insn, replace, ind_levels,
+*** 2469,2473 ****
+ find_reloads_address (VOIDmode, NULL_PTR,
+ recog_operand[i], recog_operand_loc[i],
+! i, operand_type[i], ind_levels);
+ substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+ }
+--- 2510,2515 ----
+ find_reloads_address (VOIDmode, NULL_PTR,
+ recog_operand[i], recog_operand_loc[i],
+! i, operand_type[i], ind_levels,
+! &force_update[i]);
+ substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+ }
+*************** find_reloads (insn, replace, ind_levels,
+*** 2478,2482 ****
+ XEXP (recog_operand[i], 0),
+ &XEXP (recog_operand[i], 0),
+! i, address_type[i], ind_levels))
+ address_reloaded[i] = 1;
+ substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+--- 2520,2525 ----
+ XEXP (recog_operand[i], 0),
+ &XEXP (recog_operand[i], 0),
+! i, address_type[i], ind_levels,
+! &force_update[i]))
+ address_reloaded[i] = 1;
+ substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+*************** find_reloads (insn, replace, ind_levels,
+*** 2487,2491 ****
+ ind_levels,
+ set != 0
+! && &SET_DEST (set) == recog_operand_loc[i]);
+ else if (code == PLUS)
+ /* We can get a PLUS as an "operand" as a result of
+--- 2530,2535 ----
+ ind_levels,
+ set != 0
+! && &SET_DEST (set) == recog_operand_loc[i],
+! &force_update[i]);
+ else if (code == PLUS)
+ /* We can get a PLUS as an "operand" as a result of
+*************** find_reloads (insn, replace, ind_levels,
+*** 2493,2497 ****
+ substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]
+ = find_reloads_toplev (recog_operand[i], i, address_type[i],
+! ind_levels, 0);
+ else if (code == REG)
+ {
+--- 2537,2541 ----
+ substed_operand[i] = recog_operand[i] = *recog_operand_loc[i]
+ = find_reloads_toplev (recog_operand[i], i, address_type[i],
+! ind_levels, 0, &force_update[i]);
+ else if (code == REG)
+ {
+*************** find_reloads (insn, replace, ind_levels,
+*** 2505,2510 ****
+ if (reg_equiv_constant[regno] != 0
+ && (set == 0 || &SET_DEST (set) != recog_operand_loc[i]))
+! substed_operand[i] = recog_operand[i]
+! = reg_equiv_constant[regno];
+ #if 0 /* This might screw code in reload1.c to delete prior output-reload
+ that feeds this insn. */
+--- 2549,2557 ----
+ if (reg_equiv_constant[regno] != 0
+ && (set == 0 || &SET_DEST (set) != recog_operand_loc[i]))
+! {
+! substed_operand[i] = recog_operand[i]
+! = reg_equiv_constant[regno];
+! force_update[i] = 1;
+! }
+ #if 0 /* This might screw code in reload1.c to delete prior output-reload
+ that feeds this insn. */
+*************** find_reloads (insn, replace, ind_levels,
+*** 2545,2549 ****
+ XEXP (recog_operand[i], 0),
+ &XEXP (recog_operand[i], 0),
+! i, address_type[i], ind_levels);
+ substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+ }
+--- 2592,2597 ----
+ XEXP (recog_operand[i], 0),
+ &XEXP (recog_operand[i], 0),
+! i, address_type[i], ind_levels,
+! &force_update[i]);
+ substed_operand[i] = recog_operand[i] = *recog_operand_loc[i];
+ }
+*************** find_reloads (insn, replace, ind_levels,
+*** 3415,3419 ****
+ = find_reloads_toplev (force_const_mem (operand_mode[i],
+ recog_operand[i]),
+! i, address_type[i], ind_levels, 0);
+ if (alternative_allows_memconst (constraints1[i],
+ goal_alternative_number))
+--- 3463,3467 ----
+ = find_reloads_toplev (force_const_mem (operand_mode[i],
+ recog_operand[i]),
+! i, address_type[i], ind_levels, 0, NULL);
+ if (alternative_allows_memconst (constraints1[i],
+ goal_alternative_number))
+*************** find_reloads (insn, replace, ind_levels,
+*** 3595,3609 ****
+ Don't do this if we aren't making replacements because we might be
+ propagating things allocated by frame pointer elimination into places
+! it doesn't expect. */
+
+! if (insn_code_number >= 0 && replace)
+! for (i = insn_n_dups[insn_code_number] - 1; i >= 0; i--)
+! {
+! int opno = recog_dup_num[i];
+! *recog_dup_loc[i] = *recog_operand_loc[opno];
+! if (operand_reloadnum[opno] >= 0)
+! push_replacement (recog_dup_loc[i], operand_reloadnum[opno],
+! insn_operand_mode[insn_code_number][opno]);
+! }
+
+ #if 0
+--- 3643,3664 ----
+ Don't do this if we aren't making replacements because we might be
+ propagating things allocated by frame pointer elimination into places
+! it doesn't expect. However, always do it for replaces of pseudos
+! by constants. */
+
+! for (i = insn_n_dups[insn_code_number] - 1; i >= 0; i--)
+! {
+! int opno = recog_dup_num[i];
+!
+! if (! (insn_code_number >= 0 && replace))
+! {
+! if (! force_update[opno])
+! continue;
+! }
+!
+! *recog_dup_loc[i] = *recog_operand_loc[opno];
+! if (operand_reloadnum[opno] >= 0)
+! push_replacement (recog_dup_loc[i], operand_reloadnum[opno],
+! insn_operand_mode[insn_code_number][opno]);
+! }
+
+ #if 0
+*************** find_reloads (insn, replace, ind_levels,
+*** 3829,3832 ****
+--- 3884,3888 ----
+ register RTX_CODE code = GET_CODE (recog_operand[i]);
+ int is_set_dest = GET_CODE (body) == SET && (i == 0);
++ short ign;
+
+ if (insn_code_number >= 0)
+*************** find_reloads (insn, replace, ind_levels,
+*** 3834,3838 ****
+ find_reloads_address (VOIDmode, NULL_PTR,
+ recog_operand[i], recog_operand_loc[i],
+! i, RELOAD_FOR_INPUT, ind_levels);
+
+ /* In these cases, we can't tell if the operand is an input
+--- 3890,3894 ----
+ find_reloads_address (VOIDmode, NULL_PTR,
+ recog_operand[i], recog_operand_loc[i],
+! i, RELOAD_FOR_INPUT, ind_levels, &ign);
+
+ /* In these cases, we can't tell if the operand is an input
+*************** find_reloads (insn, replace, ind_levels,
+*** 3845,3853 ****
+ XEXP (recog_operand[i], 0),
+ &XEXP (recog_operand[i], 0),
+! i, RELOAD_OTHER, ind_levels);
+ if (code == SUBREG)
+ recog_operand[i] = *recog_operand_loc[i]
+ = find_reloads_toplev (recog_operand[i], i, RELOAD_OTHER,
+! ind_levels, is_set_dest);
+ if (code == REG)
+ {
+--- 3901,3909 ----
+ XEXP (recog_operand[i], 0),
+ &XEXP (recog_operand[i], 0),
+! i, RELOAD_OTHER, ind_levels, &ign);
+ if (code == SUBREG)
+ recog_operand[i] = *recog_operand_loc[i]
+ = find_reloads_toplev (recog_operand[i], i, RELOAD_OTHER,
+! ind_levels, is_set_dest, &ign);
+ if (code == REG)
+ {
+*************** alternative_allows_memconst (constraint,
+*** 3908,3915 ****
+
+ IS_SET_DEST is true if X is the destination of a SET, which is not
+! appropriate to be replaced by a constant. */
+
+ static rtx
+! find_reloads_toplev (x, opnum, type, ind_levels, is_set_dest)
+ rtx x;
+ int opnum;
+--- 3964,3974 ----
+
+ IS_SET_DEST is true if X is the destination of a SET, which is not
+! appropriate to be replaced by a constant.
+!
+! FORCE_UPDATE, if non-NULL, is the address of a SHORT that is set to
+! 1 if X is replaced with something based on reg_equiv_constant. */
+
+ static rtx
+! find_reloads_toplev (x, opnum, type, ind_levels, is_set_dest, force_update)
+ rtx x;
+ int opnum;
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3917,3920 ****
+--- 3976,3980 ----
+ int ind_levels;
+ int is_set_dest;
++ short *force_update;
+ {
+ register RTX_CODE code = GET_CODE (x);
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3928,3932 ****
+ register int regno = REGNO (x);
+ if (reg_equiv_constant[regno] != 0 && !is_set_dest)
+! x = reg_equiv_constant[regno];
+ #if 0
+ /* This creates (subreg (mem...)) which would cause an unnecessary
+--- 3988,3998 ----
+ register int regno = REGNO (x);
+ if (reg_equiv_constant[regno] != 0 && !is_set_dest)
+! {
+! x = reg_equiv_constant[regno];
+! if (force_update)
+! *force_update = 1;
+! else
+! abort (); /* Learn why this happens. */
+! }
+ #if 0
+ /* This creates (subreg (mem...)) which would cause an unnecessary
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3951,3955 ****
+ find_reloads_address (GET_MODE (x), NULL_PTR,
+ XEXP (x, 0),
+! &XEXP (x, 0), opnum, type, ind_levels);
+ }
+ return x;
+--- 4017,4022 ----
+ find_reloads_address (GET_MODE (x), NULL_PTR,
+ XEXP (x, 0),
+! &XEXP (x, 0), opnum, type, ind_levels,
+! force_update);
+ }
+ return x;
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3959,3963 ****
+ rtx tem = x;
+ find_reloads_address (GET_MODE (x), &tem, XEXP (x, 0), &XEXP (x, 0),
+! opnum, type, ind_levels);
+ return tem;
+ }
+--- 4026,4030 ----
+ rtx tem = x;
+ find_reloads_address (GET_MODE (x), &tem, XEXP (x, 0), &XEXP (x, 0),
+! opnum, type, ind_levels, force_update);
+ return tem;
+ }
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3982,3986 ****
+ && (tem = gen_lowpart_common (GET_MODE (x),
+ reg_equiv_constant[regno])) != 0)
+! return tem;
+
+ if (GET_MODE_BITSIZE (GET_MODE (x)) == BITS_PER_WORD
+--- 4049,4059 ----
+ && (tem = gen_lowpart_common (GET_MODE (x),
+ reg_equiv_constant[regno])) != 0)
+! {
+! if (force_update)
+! *force_update = 1;
+! else
+! abort (); /* Learn why this happens. */
+! return tem;
+! }
+
+ if (GET_MODE_BITSIZE (GET_MODE (x)) == BITS_PER_WORD
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 3990,3994 ****
+ SUBREG_WORD (x), 0,
+ GET_MODE (SUBREG_REG (x)))) != 0)
+! return tem;
+
+ if (regno >= FIRST_PSEUDO_REGISTER && reg_renumber[regno] < 0
+--- 4063,4073 ----
+ SUBREG_WORD (x), 0,
+ GET_MODE (SUBREG_REG (x)))) != 0)
+! {
+! if (force_update)
+! *force_update = 1;
+! else
+! abort (); /* Learn why this happens. */
+! return tem;
+! }
+
+ if (regno >= FIRST_PSEUDO_REGISTER && reg_renumber[regno] < 0
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 4040,4044 ****
+ find_reloads_address (GET_MODE (x), NULL_PTR,
+ XEXP (x, 0),
+! &XEXP (x, 0), opnum, type, ind_levels);
+ }
+
+--- 4119,4124 ----
+ find_reloads_address (GET_MODE (x), NULL_PTR,
+ XEXP (x, 0),
+! &XEXP (x, 0), opnum, type, ind_levels,
+! force_update);
+ }
+
+*************** find_reloads_toplev (x, opnum, type, ind
+*** 4049,4053 ****
+ if (fmt[i] == 'e')
+ XEXP (x, i) = find_reloads_toplev (XEXP (x, i), opnum, type,
+! ind_levels, is_set_dest);
+ }
+ return x;
+--- 4129,4133 ----
+ if (fmt[i] == 'e')
+ XEXP (x, i) = find_reloads_toplev (XEXP (x, i), opnum, type,
+! ind_levels, is_set_dest, NULL);
+ }
+ return x;
+*************** make_memloc (ad, regno)
+*** 4110,4114 ****
+
+ static int
+! find_reloads_address (mode, memrefloc, ad, loc, opnum, type, ind_levels)
+ enum machine_mode mode;
+ rtx *memrefloc;
+--- 4190,4195 ----
+
+ static int
+! find_reloads_address (mode, memrefloc, ad, loc, opnum, type, ind_levels,
+! force_update)
+ enum machine_mode mode;
+ rtx *memrefloc;
+*************** find_reloads_address (mode, memrefloc, a
+*** 4118,4121 ****
+--- 4199,4203 ----
+ enum reload_type type;
+ int ind_levels;
++ short *force_update;
+ {
+ register int regno;
+*************** find_reloads_address (mode, memrefloc, a
+*** 4134,4137 ****
+--- 4216,4223 ----
+ {
+ *loc = ad = reg_equiv_constant[regno];
++ if (force_update)
++ *force_update = 1;
++ else
++ abort (); /* Learn why this happens. */
+ return 1;
+ }
+*************** find_reloads_address (mode, memrefloc, a
+*** 4141,4145 ****
+ tem = make_memloc (ad, regno);
+ find_reloads_address (GET_MODE (tem), NULL_PTR, XEXP (tem, 0),
+! &XEXP (tem, 0), opnum, type, ind_levels);
+ push_reload (tem, NULL_RTX, loc, NULL_PTR, BASE_REG_CLASS,
+ GET_MODE (ad), VOIDmode, 0, 0,
+--- 4227,4231 ----
+ tem = make_memloc (ad, regno);
+ find_reloads_address (GET_MODE (tem), NULL_PTR, XEXP (tem, 0),
+! &XEXP (tem, 0), opnum, type, ind_levels, NULL);
+ push_reload (tem, NULL_RTX, loc, NULL_PTR, BASE_REG_CLASS,
+ GET_MODE (ad), VOIDmode, 0, 0,
+*************** find_reloads_address (mode, memrefloc, a
+*** 4214,4218 ****
+ tem = ad;
+ find_reloads_address (GET_MODE (ad), &tem, XEXP (ad, 0), &XEXP (ad, 0),
+! opnum, type, ind_levels == 0 ? 0 : ind_levels - 1);
+
+ /* If tem was changed, then we must create a new memory reference to
+--- 4300,4305 ----
+ tem = ad;
+ find_reloads_address (GET_MODE (ad), &tem, XEXP (ad, 0), &XEXP (ad, 0),
+! opnum, type, ind_levels == 0 ? 0 : ind_levels - 1,
+! NULL);
+
+ /* If tem was changed, then we must create a new memory reference to
+*************** find_reloads_address_1 (x, context, loc,
+*** 4722,4726 ****
+ /* First reload the memory location's address. */
+ find_reloads_address (GET_MODE (tem), 0, XEXP (tem, 0),
+! &XEXP (tem, 0), opnum, type, ind_levels);
+ /* Put this inside a new increment-expression. */
+ x = gen_rtx (GET_CODE (x), GET_MODE (x), tem);
+--- 4809,4814 ----
+ /* First reload the memory location's address. */
+ find_reloads_address (GET_MODE (tem), 0, XEXP (tem, 0),
+! &XEXP (tem, 0), opnum, type, ind_levels,
+! NULL);
+ /* Put this inside a new increment-expression. */
+ x = gen_rtx (GET_CODE (x), GET_MODE (x), tem);
+*************** find_reloads_address_1 (x, context, loc,
+*** 4788,4792 ****
+ find_reloads_address (GET_MODE (x), &XEXP (x, 0),
+ XEXP (XEXP (x, 0), 0), &XEXP (XEXP (x, 0), 0),
+! opnum, type, ind_levels);
+
+ reloadnum = push_reload (x, NULL_RTX, loc, NULL_PTR,
+--- 4876,4880 ----
+ find_reloads_address (GET_MODE (x), &XEXP (x, 0),
+ XEXP (XEXP (x, 0), 0), &XEXP (XEXP (x, 0), 0),
+! opnum, type, ind_levels, NULL);
+
+ reloadnum = push_reload (x, NULL_RTX, loc, NULL_PTR,
+*************** find_reloads_address_1 (x, context, loc,
+*** 4818,4822 ****
+
+ find_reloads_address (GET_MODE (x), loc, XEXP (x, 0), &XEXP (x, 0),
+! opnum, type, ind_levels);
+ push_reload (*loc, NULL_RTX, loc, NULL_PTR,
+ context ? INDEX_REG_CLASS : BASE_REG_CLASS,
+--- 4906,4910 ----
+
+ find_reloads_address (GET_MODE (x), loc, XEXP (x, 0), &XEXP (x, 0),
+! opnum, type, ind_levels, NULL);
+ push_reload (*loc, NULL_RTX, loc, NULL_PTR,
+ context ? INDEX_REG_CLASS : BASE_REG_CLASS,
+*************** find_reloads_address_1 (x, context, loc,
+*** 4852,4856 ****
+ x = make_memloc (x, regno);
+ find_reloads_address (GET_MODE (x), 0, XEXP (x, 0), &XEXP (x, 0),
+! opnum, type, ind_levels);
+ }
+
+--- 4940,4944 ----
+ x = make_memloc (x, regno);
+ find_reloads_address (GET_MODE (x), 0, XEXP (x, 0), &XEXP (x, 0),
+! opnum, type, ind_levels, NULL);
+ }
+
+*************** find_reloads_address_part (x, loc, class
+*** 4965,4969 ****
+ rtx tem = x = force_const_mem (mode, x);
+ find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0),
+! opnum, type, ind_levels);
+ }
+
+--- 5053,5057 ----
+ rtx tem = x = force_const_mem (mode, x);
+ find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0),
+! opnum, type, ind_levels, NULL);
+ }
+
+*************** find_reloads_address_part (x, loc, class
+*** 4977,4981 ****
+ x = gen_rtx (PLUS, GET_MODE (x), XEXP (x, 0), tem);
+ find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0),
+! opnum, type, ind_levels);
+ }
+
+--- 5065,5069 ----
+ x = gen_rtx (PLUS, GET_MODE (x), XEXP (x, 0), tem);
+ find_reloads_address (mode, &tem, XEXP (tem, 0), &XEXP (tem, 0),
+! opnum, type, ind_levels, NULL);
+ }
+
+*************** find_equiv_reg (goal, insn, class, other
+*** 5518,5522 ****
+ and is also a register that appears in the address of GOAL. */
+
+! if (goal_mem && value == SET_DEST (PATTERN (where))
+ && refers_to_regno_for_reload_p (valueno,
+ (valueno
+--- 5606,5610 ----
+ and is also a register that appears in the address of GOAL. */
+
+! if (goal_mem && value == SET_DEST (single_set (where))
+ && refers_to_regno_for_reload_p (valueno,
+ (valueno
+*************** debug_reload()
+*** 5900,5904 ****
+
+ if (reload_nocombine[r])
+! fprintf (stderr, ", can combine", reload_nocombine[r]);
+
+ if (reload_secondary_p[r])
+--- 5988,5992 ----
+
+ if (reload_nocombine[r])
+! fprintf (stderr, ", can't combine %d", reload_nocombine[r]);
+
+ if (reload_secondary_p[r])
+diff -rcp2N gcc-2.7.2.2/reload1.c g77-new/reload1.c
+*** gcc-2.7.2.2/reload1.c Sun Nov 5 11:22:22 1995
+--- g77-new/reload1.c Sun Aug 10 18:47:00 1997
+*************** reload (first, global, dumpfile)
+*** 542,546 ****
+ Also find all paradoxical subregs and find largest such for each pseudo.
+ On machines with small register classes, record hard registers that
+! are used for user variables. These can never be used for spills. */
+
+ for (insn = first; insn; insn = NEXT_INSN (insn))
+--- 542,548 ----
+ Also find all paradoxical subregs and find largest such for each pseudo.
+ On machines with small register classes, record hard registers that
+! are used for user variables. These can never be used for spills.
+! Also look for a "constant" NOTE_INSN_SETJMP. This means that all
+! caller-saved registers must be marked live. */
+
+ for (insn = first; insn; insn = NEXT_INSN (insn))
+*************** reload (first, global, dumpfile)
+*** 548,551 ****
+--- 550,559 ----
+ rtx set = single_set (insn);
+
++ if (GET_CODE (insn) == NOTE && CONST_CALL_P (insn)
++ && NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP)
++ for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
++ if (! call_used_regs[i])
++ regs_ever_live[i] = 1;
++
+ if (set != 0 && GET_CODE (SET_DEST (set)) == REG)
+ {
+*************** reload (first, global, dumpfile)
+*** 564,568 ****
+ if (GET_CODE (x) == MEM)
+ reg_equiv_memory_loc[i] = x;
+! else if (CONSTANT_P (x))
+ {
+ if (LEGITIMATE_CONSTANT_P (x))
+--- 572,578 ----
+ if (GET_CODE (x) == MEM)
+ reg_equiv_memory_loc[i] = x;
+! else if (CONSTANT_P (x)
+! && ! (GET_CODE (x) == CONST
+! && GET_CODE (XEXP (x, 0)) == MINUS))
+ {
+ if (LEGITIMATE_CONSTANT_P (x))
+*************** eliminate_regs (x, mem_mode, insn)
+*** 2886,2890 ****
+
+ /* Fall through to generic unary operation case. */
+- case USE:
+ case STRICT_LOW_PART:
+ case NEG: case NOT:
+--- 2896,2899 ----
+*************** eliminate_regs (x, mem_mode, insn)
+*** 2975,2978 ****
+--- 2984,3000 ----
+ return x;
+
++ case USE:
++ /* If using a register that is the source of an eliminate we still
++ think can be performed, note it cannot be performed since we don't
++ know how this register is used. */
++ for (ep = reg_eliminate; ep < &reg_eliminate[NUM_ELIMINABLE_REGS]; ep++)
++ if (ep->from_rtx == XEXP (x, 0))
++ ep->can_eliminate = 0;
++
++ new = eliminate_regs (XEXP (x, 0), mem_mode, insn);
++ if (new != XEXP (x, 0))
++ return gen_rtx (code, GET_MODE (x), new);
++ return x;
++
+ case CLOBBER:
+ /* If clobbering a register that is the replacement register for an
+*************** gen_reload (out, in, opnum, type)
+*** 6736,6741 ****
+--- 6758,6765 ----
+ if (GET_CODE (in) == PLUS
+ && (GET_CODE (XEXP (in, 0)) == REG
++ || GET_CODE (XEXP (in, 0)) == SUBREG
+ || GET_CODE (XEXP (in, 0)) == MEM)
+ && (GET_CODE (XEXP (in, 1)) == REG
++ || GET_CODE (XEXP (in, 1)) == SUBREG
+ || CONSTANT_P (XEXP (in, 1))
+ || GET_CODE (XEXP (in, 1)) == MEM))
+*************** gen_reload (out, in, opnum, type)
+*** 6798,6807 ****
+ we emit below. */
+
+! if (CONSTANT_P (op1) || GET_CODE (op1) == MEM
+ || (GET_CODE (op1) == REG
+ && REGNO (op1) >= FIRST_PSEUDO_REGISTER))
+ tem = op0, op0 = op1, op1 = tem;
+
+! emit_insn (gen_move_insn (out, op0));
+
+ /* If OP0 and OP1 are the same, we can use OUT for OP1.
+--- 6822,6831 ----
+ we emit below. */
+
+! if (CONSTANT_P (op1) || GET_CODE (op1) == MEM || GET_CODE (op1) == SUBREG
+ || (GET_CODE (op1) == REG
+ && REGNO (op1) >= FIRST_PSEUDO_REGISTER))
+ tem = op0, op0 = op1, op1 = tem;
+
+! gen_reload (out, op0, opnum, type);
+
+ /* If OP0 and OP1 are the same, we can use OUT for OP1.
+*************** gen_reload (out, in, opnum, type)
+*** 6831,6835 ****
+ delete_insns_since (last);
+
+! emit_insn (gen_move_insn (out, op1));
+ emit_insn (gen_add2_insn (out, op0));
+ }
+--- 6855,6859 ----
+ delete_insns_since (last);
+
+! gen_reload (out, op1, opnum, type);
+ emit_insn (gen_add2_insn (out, op0));
+ }
+*************** gen_reload (out, in, opnum, type)
+*** 6852,6857 ****
+ in = gen_rtx (REG, GET_MODE (loc), REGNO (in));
+
+! emit_insn (gen_move_insn (loc, in));
+! emit_insn (gen_move_insn (out, loc));
+ }
+ #endif
+--- 6876,6881 ----
+ in = gen_rtx (REG, GET_MODE (loc), REGNO (in));
+
+! gen_reload (loc, in, opnum, type);
+! gen_reload (out, loc, opnum, type);
+ }
+ #endif
+diff -rcp2N gcc-2.7.2.2/rtl.c g77-new/rtl.c
+*** gcc-2.7.2.2/rtl.c Thu Jun 15 08:02:59 1995
+--- g77-new/rtl.c Thu Jul 10 20:09:06 1997
+*************** char *reg_note_name[] = { "", "REG_DEAD"
+*** 179,183 ****
+ "REG_NONNEG", "REG_NO_CONFLICT", "REG_UNUSED",
+ "REG_CC_SETTER", "REG_CC_USER", "REG_LABEL",
+! "REG_DEP_ANTI", "REG_DEP_OUTPUT" };
+
+ /* Allocate an rtx vector of N elements.
+--- 179,183 ----
+ "REG_NONNEG", "REG_NO_CONFLICT", "REG_UNUSED",
+ "REG_CC_SETTER", "REG_CC_USER", "REG_LABEL",
+! "REG_DEP_ANTI", "REG_DEP_OUTPUT", "REG_NOALIAS" };
+
+ /* Allocate an rtx vector of N elements.
+diff -rcp2N gcc-2.7.2.2/rtl.h g77-new/rtl.h
+*** gcc-2.7.2.2/rtl.h Thu Jun 15 08:03:16 1995
+--- g77-new/rtl.h Thu Jul 10 20:09:07 1997
+*************** enum reg_note { REG_DEAD = 1, REG_INC =
+*** 349,353 ****
+ REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10,
+ REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13,
+! REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15 };
+
+ /* Define macros to extract and insert the reg-note kind in an EXPR_LIST. */
+--- 349,353 ----
+ REG_NONNEG = 8, REG_NO_CONFLICT = 9, REG_UNUSED = 10,
+ REG_CC_SETTER = 11, REG_CC_USER = 12, REG_LABEL = 13,
+! REG_DEP_ANTI = 14, REG_DEP_OUTPUT = 15, REG_NOALIAS = 16 };
+
+ /* Define macros to extract and insert the reg-note kind in an EXPR_LIST. */
+*************** extern char *reg_note_name[];
+*** 432,436 ****
+ #define NOTE_INSN_FUNCTION_BEG -13
+
+-
+ #if 0 /* These are not used, and I don't know what they were for. --rms. */
+ #define NOTE_DECL_NAME(INSN) ((INSN)->fld[3].rtstr)
+--- 432,435 ----
+*************** extern char *note_insn_name[];
+*** 576,579 ****
+--- 575,579 ----
+ /* For a TRAP_IF rtx, TRAP_CONDITION is an expression. */
+ #define TRAP_CONDITION(RTX) ((RTX)->fld[0].rtx)
++ #define TRAP_CODE(RTX) ((RTX)->fld[1].rtint)
+
+ /* 1 in a SYMBOL_REF if it addresses this function's constants pool. */
+*************** extern rtx eliminate_constant_term PROTO
+*** 817,820 ****
+--- 817,830 ----
+ extern rtx expand_complex_abs PROTO((enum machine_mode, rtx, rtx, int));
+ extern enum machine_mode choose_hard_reg_mode PROTO((int, int));
++ extern int rtx_varies_p PROTO((rtx));
++ extern int may_trap_p PROTO((rtx));
++ extern int side_effects_p PROTO((rtx));
++ extern int volatile_refs_p PROTO((rtx));
++ extern int volatile_insn_p PROTO((rtx));
++ extern void remove_note PROTO((rtx, rtx));
++ extern void note_stores PROTO((rtx, void (*)()));
++ extern int refers_to_regno_p PROTO((int, int, rtx, rtx *));
++ extern int reg_overlap_mentioned_p PROTO((rtx, rtx));
++
+
+ /* Maximum number of parallel sets and clobbers in any insn in this fn.
+*************** extern rtx *regno_reg_rtx;
+*** 967,968 ****
+--- 977,987 ----
+
+ extern int rtx_to_tree_code PROTO((enum rtx_code));
++
++ extern int true_dependence PROTO((rtx, enum machine_mode, rtx, int (*)()));
++ extern int read_dependence PROTO((rtx, rtx));
++ extern int anti_dependence PROTO((rtx, rtx));
++ extern int output_dependence PROTO((rtx, rtx));
++ extern void init_alias_analysis PROTO((void));
++ extern void end_alias_analysis PROTO((void));
++ extern void mark_user_reg PROTO((rtx));
++ extern void mark_reg_pointer PROTO((rtx));
+diff -rcp2N gcc-2.7.2.2/sched.c g77-new/sched.c
+*** gcc-2.7.2.2/sched.c Thu Jun 15 08:06:39 1995
+--- g77-new/sched.c Sun Aug 10 18:46:13 1997
+*************** Boston, MA 02111-1307, USA. */
+*** 126,129 ****
+--- 126,132 ----
+ #include "insn-attr.h"
+
++ extern char *reg_known_equiv_p;
++ extern rtx *reg_known_value;
++
+ #ifdef INSN_SCHEDULING
+ /* Arrays set up by scheduling for the same respective purposes as
+*************** static int *sched_reg_live_length;
+*** 143,146 ****
+--- 146,150 ----
+ by splitting insns. */
+ static rtx *reg_last_uses;
++ static int reg_last_uses_size;
+ static rtx *reg_last_sets;
+ static regset reg_pending_sets;
+*************** struct sometimes
+*** 294,302 ****
+
+ /* Forward declarations. */
+- static rtx canon_rtx PROTO((rtx));
+- static int rtx_equal_for_memref_p PROTO((rtx, rtx));
+- static rtx find_symbolic_term PROTO((rtx));
+- static int memrefs_conflict_p PROTO((int, rtx, int, rtx,
+- HOST_WIDE_INT));
+ static void add_dependence PROTO((rtx, rtx, enum reg_note));
+ static void remove_dependence PROTO((rtx, rtx));
+--- 298,301 ----
+*************** static int priority PROTO((rtx));
+*** 314,318 ****
+ static void free_pending_lists PROTO((void));
+ static void add_insn_mem_dependence PROTO((rtx *, rtx *, rtx, rtx));
+! static void flush_pending_lists PROTO((rtx));
+ static void sched_analyze_1 PROTO((rtx, rtx));
+ static void sched_analyze_2 PROTO((rtx, rtx));
+--- 313,317 ----
+ static void free_pending_lists PROTO((void));
+ static void add_insn_mem_dependence PROTO((rtx *, rtx *, rtx, rtx));
+! static void flush_pending_lists PROTO((rtx, int));
+ static void sched_analyze_1 PROTO((rtx, rtx));
+ static void sched_analyze_2 PROTO((rtx, rtx));
+*************** void schedule_insns PROTO((FILE *));
+*** 346,885 ****
+ #endif /* INSN_SCHEDULING */
+
+- #define SIZE_FOR_MODE(X) (GET_MODE_SIZE (GET_MODE (X)))
+-
+- /* Vector indexed by N giving the initial (unchanging) value known
+- for pseudo-register N. */
+- static rtx *reg_known_value;
+-
+- /* Vector recording for each reg_known_value whether it is due to a
+- REG_EQUIV note. Future passes (viz., reload) may replace the
+- pseudo with the equivalent expression and so we account for the
+- dependences that would be introduced if that happens. */
+- /* ??? This is a problem only on the Convex. The REG_EQUIV notes created in
+- assign_parms mention the arg pointer, and there are explicit insns in the
+- RTL that modify the arg pointer. Thus we must ensure that such insns don't
+- get scheduled across each other because that would invalidate the REG_EQUIV
+- notes. One could argue that the REG_EQUIV notes are wrong, but solving
+- the problem in the scheduler will likely give better code, so we do it
+- here. */
+- static char *reg_known_equiv_p;
+-
+- /* Indicates number of valid entries in reg_known_value. */
+- static int reg_known_value_size;
+-
+- static rtx
+- canon_rtx (x)
+- rtx x;
+- {
+- if (GET_CODE (x) == REG && REGNO (x) >= FIRST_PSEUDO_REGISTER
+- && REGNO (x) <= reg_known_value_size)
+- return reg_known_value[REGNO (x)];
+- else if (GET_CODE (x) == PLUS)
+- {
+- rtx x0 = canon_rtx (XEXP (x, 0));
+- rtx x1 = canon_rtx (XEXP (x, 1));
+-
+- if (x0 != XEXP (x, 0) || x1 != XEXP (x, 1))
+- {
+- /* We can tolerate LO_SUMs being offset here; these
+- rtl are used for nothing other than comparisons. */
+- if (GET_CODE (x0) == CONST_INT)
+- return plus_constant_for_output (x1, INTVAL (x0));
+- else if (GET_CODE (x1) == CONST_INT)
+- return plus_constant_for_output (x0, INTVAL (x1));
+- return gen_rtx (PLUS, GET_MODE (x), x0, x1);
+- }
+- }
+- return x;
+- }
+-
+- /* Set up all info needed to perform alias analysis on memory references. */
+-
+- void
+- init_alias_analysis ()
+- {
+- int maxreg = max_reg_num ();
+- rtx insn;
+- rtx note;
+- rtx set;
+-
+- reg_known_value_size = maxreg;
+-
+- reg_known_value
+- = (rtx *) oballoc ((maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx))
+- - FIRST_PSEUDO_REGISTER;
+- bzero ((char *) (reg_known_value + FIRST_PSEUDO_REGISTER),
+- (maxreg-FIRST_PSEUDO_REGISTER) * sizeof (rtx));
+-
+- reg_known_equiv_p
+- = (char *) oballoc ((maxreg -FIRST_PSEUDO_REGISTER) * sizeof (char))
+- - FIRST_PSEUDO_REGISTER;
+- bzero (reg_known_equiv_p + FIRST_PSEUDO_REGISTER,
+- (maxreg - FIRST_PSEUDO_REGISTER) * sizeof (char));
+-
+- /* Fill in the entries with known constant values. */
+- for (insn = get_insns (); insn; insn = NEXT_INSN (insn))
+- if ((set = single_set (insn)) != 0
+- && GET_CODE (SET_DEST (set)) == REG
+- && REGNO (SET_DEST (set)) >= FIRST_PSEUDO_REGISTER
+- && (((note = find_reg_note (insn, REG_EQUAL, 0)) != 0
+- && reg_n_sets[REGNO (SET_DEST (set))] == 1)
+- || (note = find_reg_note (insn, REG_EQUIV, NULL_RTX)) != 0)
+- && GET_CODE (XEXP (note, 0)) != EXPR_LIST)
+- {
+- int regno = REGNO (SET_DEST (set));
+- reg_known_value[regno] = XEXP (note, 0);
+- reg_known_equiv_p[regno] = REG_NOTE_KIND (note) == REG_EQUIV;
+- }
+-
+- /* Fill in the remaining entries. */
+- while (--maxreg >= FIRST_PSEUDO_REGISTER)
+- if (reg_known_value[maxreg] == 0)
+- reg_known_value[maxreg] = regno_reg_rtx[maxreg];
+- }
+-
+- /* Return 1 if X and Y are identical-looking rtx's.
+-
+- We use the data in reg_known_value above to see if two registers with
+- different numbers are, in fact, equivalent. */
+-
+- static int
+- rtx_equal_for_memref_p (x, y)
+- rtx x, y;
+- {
+- register int i;
+- register int j;
+- register enum rtx_code code;
+- register char *fmt;
+-
+- if (x == 0 && y == 0)
+- return 1;
+- if (x == 0 || y == 0)
+- return 0;
+- x = canon_rtx (x);
+- y = canon_rtx (y);
+-
+- if (x == y)
+- return 1;
+-
+- code = GET_CODE (x);
+- /* Rtx's of different codes cannot be equal. */
+- if (code != GET_CODE (y))
+- return 0;
+-
+- /* (MULT:SI x y) and (MULT:HI x y) are NOT equivalent.
+- (REG:SI x) and (REG:HI x) are NOT equivalent. */
+-
+- if (GET_MODE (x) != GET_MODE (y))
+- return 0;
+-
+- /* REG, LABEL_REF, and SYMBOL_REF can be compared nonrecursively. */
+-
+- if (code == REG)
+- return REGNO (x) == REGNO (y);
+- if (code == LABEL_REF)
+- return XEXP (x, 0) == XEXP (y, 0);
+- if (code == SYMBOL_REF)
+- return XSTR (x, 0) == XSTR (y, 0);
+-
+- /* For commutative operations, the RTX match if the operand match in any
+- order. Also handle the simple binary and unary cases without a loop. */
+- if (code == EQ || code == NE || GET_RTX_CLASS (code) == 'c')
+- return ((rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0))
+- && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1)))
+- || (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 1))
+- && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 0))));
+- else if (GET_RTX_CLASS (code) == '<' || GET_RTX_CLASS (code) == '2')
+- return (rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0))
+- && rtx_equal_for_memref_p (XEXP (x, 1), XEXP (y, 1)));
+- else if (GET_RTX_CLASS (code) == '1')
+- return rtx_equal_for_memref_p (XEXP (x, 0), XEXP (y, 0));
+-
+- /* Compare the elements. If any pair of corresponding elements
+- fail to match, return 0 for the whole things. */
+-
+- fmt = GET_RTX_FORMAT (code);
+- for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
+- {
+- switch (fmt[i])
+- {
+- case 'w':
+- if (XWINT (x, i) != XWINT (y, i))
+- return 0;
+- break;
+-
+- case 'n':
+- case 'i':
+- if (XINT (x, i) != XINT (y, i))
+- return 0;
+- break;
+-
+- case 'V':
+- case 'E':
+- /* Two vectors must have the same length. */
+- if (XVECLEN (x, i) != XVECLEN (y, i))
+- return 0;
+-
+- /* And the corresponding elements must match. */
+- for (j = 0; j < XVECLEN (x, i); j++)
+- if (rtx_equal_for_memref_p (XVECEXP (x, i, j), XVECEXP (y, i, j)) == 0)
+- return 0;
+- break;
+-
+- case 'e':
+- if (rtx_equal_for_memref_p (XEXP (x, i), XEXP (y, i)) == 0)
+- return 0;
+- break;
+-
+- case 'S':
+- case 's':
+- if (strcmp (XSTR (x, i), XSTR (y, i)))
+- return 0;
+- break;
+-
+- case 'u':
+- /* These are just backpointers, so they don't matter. */
+- break;
+-
+- case '0':
+- break;
+-
+- /* It is believed that rtx's at this level will never
+- contain anything but integers and other rtx's,
+- except for within LABEL_REFs and SYMBOL_REFs. */
+- default:
+- abort ();
+- }
+- }
+- return 1;
+- }
+-
+- /* Given an rtx X, find a SYMBOL_REF or LABEL_REF within
+- X and return it, or return 0 if none found. */
+-
+- static rtx
+- find_symbolic_term (x)
+- rtx x;
+- {
+- register int i;
+- register enum rtx_code code;
+- register char *fmt;
+-
+- code = GET_CODE (x);
+- if (code == SYMBOL_REF || code == LABEL_REF)
+- return x;
+- if (GET_RTX_CLASS (code) == 'o')
+- return 0;
+-
+- fmt = GET_RTX_FORMAT (code);
+- for (i = GET_RTX_LENGTH (code) - 1; i >= 0; i--)
+- {
+- rtx t;
+-
+- if (fmt[i] == 'e')
+- {
+- t = find_symbolic_term (XEXP (x, i));
+- if (t != 0)
+- return t;
+- }
+- else if (fmt[i] == 'E')
+- break;
+- }
+- return 0;
+- }
+-
+- /* Return nonzero if X and Y (memory addresses) could reference the
+- same location in memory. C is an offset accumulator. When
+- C is nonzero, we are testing aliases between X and Y + C.
+- XSIZE is the size in bytes of the X reference,
+- similarly YSIZE is the size in bytes for Y.
+-
+- If XSIZE or YSIZE is zero, we do not know the amount of memory being
+- referenced (the reference was BLKmode), so make the most pessimistic
+- assumptions.
+-
+- We recognize the following cases of non-conflicting memory:
+-
+- (1) addresses involving the frame pointer cannot conflict
+- with addresses involving static variables.
+- (2) static variables with different addresses cannot conflict.
+-
+- Nice to notice that varying addresses cannot conflict with fp if no
+- local variables had their addresses taken, but that's too hard now. */
+-
+- /* ??? In Fortran, references to a array parameter can never conflict with
+- another array parameter. */
+-
+- static int
+- memrefs_conflict_p (xsize, x, ysize, y, c)
+- rtx x, y;
+- int xsize, ysize;
+- HOST_WIDE_INT c;
+- {
+- if (GET_CODE (x) == HIGH)
+- x = XEXP (x, 0);
+- else if (GET_CODE (x) == LO_SUM)
+- x = XEXP (x, 1);
+- else
+- x = canon_rtx (x);
+- if (GET_CODE (y) == HIGH)
+- y = XEXP (y, 0);
+- else if (GET_CODE (y) == LO_SUM)
+- y = XEXP (y, 1);
+- else
+- y = canon_rtx (y);
+-
+- if (rtx_equal_for_memref_p (x, y))
+- return (xsize == 0 || ysize == 0 ||
+- (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
+-
+- if (y == frame_pointer_rtx || y == hard_frame_pointer_rtx
+- || y == stack_pointer_rtx)
+- {
+- rtx t = y;
+- int tsize = ysize;
+- y = x; ysize = xsize;
+- x = t; xsize = tsize;
+- }
+-
+- if (x == frame_pointer_rtx || x == hard_frame_pointer_rtx
+- || x == stack_pointer_rtx)
+- {
+- rtx y1;
+-
+- if (CONSTANT_P (y))
+- return 0;
+-
+- if (GET_CODE (y) == PLUS
+- && canon_rtx (XEXP (y, 0)) == x
+- && (y1 = canon_rtx (XEXP (y, 1)))
+- && GET_CODE (y1) == CONST_INT)
+- {
+- c += INTVAL (y1);
+- return (xsize == 0 || ysize == 0
+- || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
+- }
+-
+- if (GET_CODE (y) == PLUS
+- && (y1 = canon_rtx (XEXP (y, 0)))
+- && CONSTANT_P (y1))
+- return 0;
+-
+- return 1;
+- }
+-
+- if (GET_CODE (x) == PLUS)
+- {
+- /* The fact that X is canonicalized means that this
+- PLUS rtx is canonicalized. */
+- rtx x0 = XEXP (x, 0);
+- rtx x1 = XEXP (x, 1);
+-
+- if (GET_CODE (y) == PLUS)
+- {
+- /* The fact that Y is canonicalized means that this
+- PLUS rtx is canonicalized. */
+- rtx y0 = XEXP (y, 0);
+- rtx y1 = XEXP (y, 1);
+-
+- if (rtx_equal_for_memref_p (x1, y1))
+- return memrefs_conflict_p (xsize, x0, ysize, y0, c);
+- if (rtx_equal_for_memref_p (x0, y0))
+- return memrefs_conflict_p (xsize, x1, ysize, y1, c);
+- if (GET_CODE (x1) == CONST_INT)
+- if (GET_CODE (y1) == CONST_INT)
+- return memrefs_conflict_p (xsize, x0, ysize, y0,
+- c - INTVAL (x1) + INTVAL (y1));
+- else
+- return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1));
+- else if (GET_CODE (y1) == CONST_INT)
+- return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1));
+-
+- /* Handle case where we cannot understand iteration operators,
+- but we notice that the base addresses are distinct objects. */
+- x = find_symbolic_term (x);
+- if (x == 0)
+- return 1;
+- y = find_symbolic_term (y);
+- if (y == 0)
+- return 1;
+- return rtx_equal_for_memref_p (x, y);
+- }
+- else if (GET_CODE (x1) == CONST_INT)
+- return memrefs_conflict_p (xsize, x0, ysize, y, c - INTVAL (x1));
+- }
+- else if (GET_CODE (y) == PLUS)
+- {
+- /* The fact that Y is canonicalized means that this
+- PLUS rtx is canonicalized. */
+- rtx y0 = XEXP (y, 0);
+- rtx y1 = XEXP (y, 1);
+-
+- if (GET_CODE (y1) == CONST_INT)
+- return memrefs_conflict_p (xsize, x, ysize, y0, c + INTVAL (y1));
+- else
+- return 1;
+- }
+-
+- if (GET_CODE (x) == GET_CODE (y))
+- switch (GET_CODE (x))
+- {
+- case MULT:
+- {
+- /* Handle cases where we expect the second operands to be the
+- same, and check only whether the first operand would conflict
+- or not. */
+- rtx x0, y0;
+- rtx x1 = canon_rtx (XEXP (x, 1));
+- rtx y1 = canon_rtx (XEXP (y, 1));
+- if (! rtx_equal_for_memref_p (x1, y1))
+- return 1;
+- x0 = canon_rtx (XEXP (x, 0));
+- y0 = canon_rtx (XEXP (y, 0));
+- if (rtx_equal_for_memref_p (x0, y0))
+- return (xsize == 0 || ysize == 0
+- || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
+-
+- /* Can't properly adjust our sizes. */
+- if (GET_CODE (x1) != CONST_INT)
+- return 1;
+- xsize /= INTVAL (x1);
+- ysize /= INTVAL (x1);
+- c /= INTVAL (x1);
+- return memrefs_conflict_p (xsize, x0, ysize, y0, c);
+- }
+- }
+-
+- if (CONSTANT_P (x))
+- {
+- if (GET_CODE (x) == CONST_INT && GET_CODE (y) == CONST_INT)
+- {
+- c += (INTVAL (y) - INTVAL (x));
+- return (xsize == 0 || ysize == 0
+- || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0));
+- }
+-
+- if (GET_CODE (x) == CONST)
+- {
+- if (GET_CODE (y) == CONST)
+- return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)),
+- ysize, canon_rtx (XEXP (y, 0)), c);
+- else
+- return memrefs_conflict_p (xsize, canon_rtx (XEXP (x, 0)),
+- ysize, y, c);
+- }
+- if (GET_CODE (y) == CONST)
+- return memrefs_conflict_p (xsize, x, ysize,
+- canon_rtx (XEXP (y, 0)), c);
+-
+- if (CONSTANT_P (y))
+- return (rtx_equal_for_memref_p (x, y)
+- && (xsize == 0 || ysize == 0
+- || (c >= 0 && xsize > c) || (c < 0 && ysize+c > 0)));
+-
+- return 1;
+- }
+- return 1;
+- }
+-
+- /* Functions to compute memory dependencies.
+-
+- Since we process the insns in execution order, we can build tables
+- to keep track of what registers are fixed (and not aliased), what registers
+- are varying in known ways, and what registers are varying in unknown
+- ways.
+-
+- If both memory references are volatile, then there must always be a
+- dependence between the two references, since their order can not be
+- changed. A volatile and non-volatile reference can be interchanged
+- though.
+-
+- A MEM_IN_STRUCT reference at a non-QImode varying address can never
+- conflict with a non-MEM_IN_STRUCT reference at a fixed address. We must
+- allow QImode aliasing because the ANSI C standard allows character
+- pointers to alias anything. We are assuming that characters are
+- always QImode here. */
+-
+- /* Read dependence: X is read after read in MEM takes place. There can
+- only be a dependence here if both reads are volatile. */
+-
+- int
+- read_dependence (mem, x)
+- rtx mem;
+- rtx x;
+- {
+- return MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem);
+- }
+-
+- /* True dependence: X is read after store in MEM takes place. */
+-
+- int
+- true_dependence (mem, x)
+- rtx mem;
+- rtx x;
+- {
+- /* If X is an unchanging read, then it can't possibly conflict with any
+- non-unchanging store. It may conflict with an unchanging write though,
+- because there may be a single store to this address to initialize it.
+- Just fall through to the code below to resolve the case where we have
+- both an unchanging read and an unchanging write. This won't handle all
+- cases optimally, but the possible performance loss should be
+- negligible. */
+- if (RTX_UNCHANGING_P (x) && ! RTX_UNCHANGING_P (mem))
+- return 0;
+-
+- return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
+- || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
+- SIZE_FOR_MODE (x), XEXP (x, 0), 0)
+- && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
+- && GET_MODE (mem) != QImode
+- && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
+- && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
+- && GET_MODE (x) != QImode
+- && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))));
+- }
+-
+- /* Anti dependence: X is written after read in MEM takes place. */
+-
+- int
+- anti_dependence (mem, x)
+- rtx mem;
+- rtx x;
+- {
+- /* If MEM is an unchanging read, then it can't possibly conflict with
+- the store to X, because there is at most one store to MEM, and it must
+- have occurred somewhere before MEM. */
+- if (RTX_UNCHANGING_P (mem))
+- return 0;
+-
+- return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
+- || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
+- SIZE_FOR_MODE (x), XEXP (x, 0), 0)
+- && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
+- && GET_MODE (mem) != QImode
+- && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
+- && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
+- && GET_MODE (x) != QImode
+- && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))));
+- }
+-
+- /* Output dependence: X is written after store in MEM takes place. */
+-
+- int
+- output_dependence (mem, x)
+- rtx mem;
+- rtx x;
+- {
+- return ((MEM_VOLATILE_P (x) && MEM_VOLATILE_P (mem))
+- || (memrefs_conflict_p (SIZE_FOR_MODE (mem), XEXP (mem, 0),
+- SIZE_FOR_MODE (x), XEXP (x, 0), 0)
+- && ! (MEM_IN_STRUCT_P (mem) && rtx_addr_varies_p (mem)
+- && GET_MODE (mem) != QImode
+- && ! MEM_IN_STRUCT_P (x) && ! rtx_addr_varies_p (x))
+- && ! (MEM_IN_STRUCT_P (x) && rtx_addr_varies_p (x)
+- && GET_MODE (x) != QImode
+- && ! MEM_IN_STRUCT_P (mem) && ! rtx_addr_varies_p (mem))));
+- }
+-
+ /* Helper functions for instruction scheduling. */
+
+--- 345,348 ----
+*************** add_insn_mem_dependence (insn_list, mem_
+*** 1609,1621 ****
+
+ /* Make a dependency between every memory reference on the pending lists
+! and INSN, thus flushing the pending lists. */
+
+ static void
+! flush_pending_lists (insn)
+ rtx insn;
+ {
+ rtx link;
+
+! while (pending_read_insns)
+ {
+ add_dependence (insn, XEXP (pending_read_insns, 0), REG_DEP_ANTI);
+--- 1072,1086 ----
+
+ /* Make a dependency between every memory reference on the pending lists
+! and INSN, thus flushing the pending lists. If ONLY_WRITE, don't flush
+! the read list. */
+
+ static void
+! flush_pending_lists (insn, only_write)
+ rtx insn;
++ int only_write;
+ {
+ rtx link;
+
+! while (pending_read_insns && ! only_write)
+ {
+ add_dependence (insn, XEXP (pending_read_insns, 0), REG_DEP_ANTI);
+*************** sched_analyze_1 (x, insn)
+*** 1746,1750 ****
+ this flush occurs 8 times for sparc, and 10 times for m88k using
+ the number 32. */
+! flush_pending_lists (insn);
+ }
+ else
+--- 1211,1215 ----
+ this flush occurs 8 times for sparc, and 10 times for m88k using
+ the number 32. */
+! flush_pending_lists (insn, 0);
+ }
+ else
+*************** sched_analyze_2 (x, insn)
+*** 1922,1926 ****
+ /* If a dependency already exists, don't create a new one. */
+ if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn)))
+! if (true_dependence (XEXP (pending_mem, 0), x))
+ add_dependence (insn, XEXP (pending, 0), 0);
+
+--- 1387,1392 ----
+ /* If a dependency already exists, don't create a new one. */
+ if (! find_insn_list (XEXP (pending, 0), LOG_LINKS (insn)))
+! if (true_dependence (XEXP (pending_mem, 0), VOIDmode,
+! x, rtx_varies_p))
+ add_dependence (insn, XEXP (pending, 0), 0);
+
+*************** sched_analyze_2 (x, insn)
+*** 1968,1972 ****
+ reg_pending_sets_all = 1;
+
+! flush_pending_lists (insn);
+ }
+
+--- 1434,1438 ----
+ reg_pending_sets_all = 1;
+
+! flush_pending_lists (insn, 0);
+ }
+
+*************** sched_analyze_insn (x, insn, loop_notes)
+*** 2021,2025 ****
+ register RTX_CODE code = GET_CODE (x);
+ rtx link;
+! int maxreg = max_reg_num ();
+ int i;
+
+--- 1487,1491 ----
+ register RTX_CODE code = GET_CODE (x);
+ rtx link;
+! int maxreg = reg_last_uses_size;
+ int i;
+
+*************** sched_analyze_insn (x, insn, loop_notes)
+*** 2058,2062 ****
+ if (loop_notes)
+ {
+! int max_reg = max_reg_num ();
+ rtx link;
+
+--- 1524,1528 ----
+ if (loop_notes)
+ {
+! int max_reg = reg_last_uses_size;
+ rtx link;
+
+*************** sched_analyze_insn (x, insn, loop_notes)
+*** 2072,2076 ****
+ reg_pending_sets_all = 1;
+
+! flush_pending_lists (insn);
+
+ link = loop_notes;
+--- 1538,1542 ----
+ reg_pending_sets_all = 1;
+
+! flush_pending_lists (insn, 0);
+
+ link = loop_notes;
+*************** sched_analyze (head, tail)
+*** 2202,2207 ****
+ && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP)
+ {
+! int max_reg = max_reg_num ();
+! for (i = 0; i < max_reg; i++)
+ {
+ for (u = reg_last_uses[i]; u; u = XEXP (u, 1))
+--- 1668,1672 ----
+ && NOTE_LINE_NUMBER (NEXT_INSN (insn)) == NOTE_INSN_SETJMP)
+ {
+! for (i = 0; i < reg_last_uses_size; i++)
+ {
+ for (u = reg_last_uses[i]; u; u = XEXP (u, 1))
+*************** sched_analyze (head, tail)
+*** 2247,2259 ****
+ loop_notes = 0;
+
+! /* We don't need to flush memory for a function call which does
+! not involve memory. */
+! if (! CONST_CALL_P (insn))
+! {
+! /* In the absence of interprocedural alias analysis,
+! we must flush all pending reads and writes, and
+! start new dependencies starting from here. */
+! flush_pending_lists (insn);
+! }
+
+ /* Depend this function call (actually, the user of this
+--- 1712,1720 ----
+ loop_notes = 0;
+
+! /* In the absence of interprocedural alias analysis, we must flush
+! all pending reads and writes, and start new dependencies starting
+! from here. But only flush writes for constant calls (which may
+! be passed a pointer to something we haven't written yet). */
+! flush_pending_lists (insn, CONST_CALL_P (insn));
+
+ /* Depend this function call (actually, the user of this
+*************** sched_analyze (head, tail)
+*** 2264,2270 ****
+ else if (GET_CODE (insn) == NOTE
+ && (NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_BEG
+! || NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_END))
+! loop_notes = gen_rtx (EXPR_LIST, REG_DEAD,
+! GEN_INT (NOTE_LINE_NUMBER (insn)), loop_notes);
+
+ if (insn == tail)
+--- 1725,1736 ----
+ else if (GET_CODE (insn) == NOTE
+ && (NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_BEG
+! || NOTE_LINE_NUMBER (insn) == NOTE_INSN_LOOP_END
+! || (NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP
+! && GET_CODE (PREV_INSN (insn)) != CALL_INSN)))
+! {
+! loop_notes = gen_rtx (EXPR_LIST, REG_DEAD,
+! GEN_INT (NOTE_LINE_NUMBER (insn)), loop_notes);
+! CONST_CALL_P (loop_notes) = CONST_CALL_P (insn);
+! }
+
+ if (insn == tail)
+*************** sched_note_set (b, x, death)
+*** 2372,2380 ****
+
+ #define SCHED_SORT(READY, NEW_READY, OLD_READY) \
+! do { if ((NEW_READY) - (OLD_READY) == 1) \
+! swap_sort (READY, NEW_READY); \
+! else if ((NEW_READY) - (OLD_READY) > 1) \
+! qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); } \
+! while (0)
+
+ /* Returns a positive value if y is preferred; returns a negative value if
+--- 1838,1845 ----
+
+ #define SCHED_SORT(READY, NEW_READY, OLD_READY) \
+! if ((NEW_READY) - (OLD_READY) == 1) \
+! swap_sort (READY, NEW_READY); \
+! else if ((NEW_READY) - (OLD_READY) > 1) \
+! qsort (READY, NEW_READY, sizeof (rtx), rank_for_schedule); else \
+
+ /* Returns a positive value if y is preferred; returns a negative value if
+*************** reemit_notes (insn, last)
+*** 3128,3132 ****
+ {
+ if (INTVAL (XEXP (note, 0)) == NOTE_INSN_SETJMP)
+! emit_note_after (INTVAL (XEXP (note, 0)), insn);
+ else
+ last = emit_note_before (INTVAL (XEXP (note, 0)), last);
+--- 2593,2598 ----
+ {
+ if (INTVAL (XEXP (note, 0)) == NOTE_INSN_SETJMP)
+! CONST_CALL_P (emit_note_after (INTVAL (XEXP (note, 0)), insn))
+! = CONST_CALL_P (note);
+ else
+ last = emit_note_before (INTVAL (XEXP (note, 0)), last);
+*************** schedule_block (b, file)
+*** 3174,3178 ****
+ b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b]));
+
+! i = max_reg_num ();
+ reg_last_uses = (rtx *) alloca (i * sizeof (rtx));
+ bzero ((char *) reg_last_uses, i * sizeof (rtx));
+--- 2640,2644 ----
+ b, INSN_UID (basic_block_head[b]), INSN_UID (basic_block_end[b]));
+
+! reg_last_uses_size = i = max_reg_num ();
+ reg_last_uses = (rtx *) alloca (i * sizeof (rtx));
+ bzero ((char *) reg_last_uses, i * sizeof (rtx));
+*************** schedule_block (b, file)
+*** 3800,3804 ****
+ made live again later. */
+ for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+! if (call_used_regs[i] || global_regs[i])
+ {
+ register int offset = i / REGSET_ELT_BITS;
+--- 3266,3271 ----
+ made live again later. */
+ for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+! if ((call_used_regs[i] && ! fixed_regs[i])
+! || global_regs[i])
+ {
+ register int offset = i / REGSET_ELT_BITS;
+*************** schedule_insns (dump_file)
+*** 4717,4721 ****
+ bcopy ((char *) reg_n_deaths, (char *) sched_reg_n_deaths,
+ max_regno * sizeof (short));
+- init_alias_analysis ();
+ }
+ else
+--- 4184,4187 ----
+*************** schedule_insns (dump_file)
+*** 4726,4732 ****
+ bb_dead_regs = 0;
+ bb_live_regs = 0;
+- if (! flag_schedule_insns)
+- init_alias_analysis ();
+ }
+
+ if (write_symbols != NO_DEBUG)
+--- 4192,4213 ----
+ bb_dead_regs = 0;
+ bb_live_regs = 0;
+ }
++ init_alias_analysis ();
++ #if 0
++ if (dump_file)
++ {
++ extern rtx *reg_base_value;
++ extern int reg_base_value_size;
++ int i;
++ for (i = 0; i < reg_base_value_size; i++)
++ if (reg_base_value[i])
++ {
++ fprintf (dump_file, ";; reg_base_value[%d] = ", i);
++ print_rtl (dump_file, reg_base_value[i]);
++ fputc ('\n', dump_file);
++ }
++ }
++ #endif
++
+
+ if (write_symbols != NO_DEBUG)
+diff -rcp2N gcc-2.7.2.2/sdbout.c g77-new/sdbout.c
+*** gcc-2.7.2.2/sdbout.c Thu Jun 15 08:07:11 1995
+--- g77-new/sdbout.c Mon Aug 11 01:42:22 1997
+*************** plain_type_1 (type, level)
+*** 539,543 ****
+ sdb_dims[sdb_n_dims++]
+ = (TYPE_DOMAIN (type)
+! ? TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) + 1
+ : 0);
+ return PUSH_DERIVED_LEVEL (DT_ARY, m);
+--- 539,546 ----
+ sdb_dims[sdb_n_dims++]
+ = (TYPE_DOMAIN (type)
+! && TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INTEGER_CST
+! && TREE_CODE (TYPE_MIN_VALUE (TYPE_DOMAIN (type))) == INTEGER_CST
+! ? (TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))
+! - TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (type))) + 1)
+ : 0);
+ return PUSH_DERIVED_LEVEL (DT_ARY, m);
+diff -rcp2N gcc-2.7.2.2/stmt.c g77-new/stmt.c
+*** gcc-2.7.2.2/stmt.c Tue Sep 12 19:01:54 1995
+--- g77-new/stmt.c Sun Aug 10 18:46:56 1997
+*************** fixup_gotos (thisblock, stack_level, cle
+*** 1244,1249 ****
+ poplevel (1, 0, 0);
+ end_sequence ();
+! f->before_jump
+! = emit_insns_after (cleanup_insns, f->before_jump);
+
+ f->cleanup_list_list = TREE_CHAIN (lists);
+--- 1244,1250 ----
+ poplevel (1, 0, 0);
+ end_sequence ();
+! if (cleanup_insns != 0)
+! f->before_jump
+! = emit_insns_after (cleanup_insns, f->before_jump);
+
+ f->cleanup_list_list = TREE_CHAIN (lists);
+*************** expand_expr_stmt (exp)
+*** 1721,1725 ****
+
+ last_expr_type = TREE_TYPE (exp);
+! if (! flag_syntax_only)
+ last_expr_value = expand_expr (exp,
+ (expr_stmts_for_value
+--- 1722,1726 ----
+
+ last_expr_type = TREE_TYPE (exp);
+! if (! flag_syntax_only || expr_stmts_for_value)
+ last_expr_value = expand_expr (exp,
+ (expr_stmts_for_value
+*************** expand_end_bindings (vars, mark_ends, do
+*** 3160,3163 ****
+--- 3161,3169 ----
+ #endif
+
++ #ifdef HAVE_nonlocal_goto_receiver
++ if (HAVE_nonlocal_goto_receiver)
++ emit_insn (gen_nonlocal_goto_receiver ());
++ #endif
++
+ /* The handler expects the desired label address in the static chain
+ register. It tests the address and does an appropriate jump
+*************** expand_decl (decl)
+*** 3369,3393 ****
+ = promote_mode (type, DECL_MODE (decl), &unsignedp, 0);
+
+! if (TREE_CODE (type) == COMPLEX_TYPE)
+! {
+! rtx realpart, imagpart;
+! enum machine_mode partmode = TYPE_MODE (TREE_TYPE (type));
+
+! /* For a complex type variable, make a CONCAT of two pseudos
+! so that the real and imaginary parts
+! can be allocated separately. */
+! realpart = gen_reg_rtx (partmode);
+! REG_USERVAR_P (realpart) = 1;
+! imagpart = gen_reg_rtx (partmode);
+! REG_USERVAR_P (imagpart) = 1;
+! DECL_RTL (decl) = gen_rtx (CONCAT, reg_mode, realpart, imagpart);
+! }
+! else
+! {
+! DECL_RTL (decl) = gen_reg_rtx (reg_mode);
+! if (TREE_CODE (type) == POINTER_TYPE)
+! mark_reg_pointer (DECL_RTL (decl));
+! REG_USERVAR_P (DECL_RTL (decl)) = 1;
+! }
+ }
+ else if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
+--- 3375,3383 ----
+ = promote_mode (type, DECL_MODE (decl), &unsignedp, 0);
+
+! DECL_RTL (decl) = gen_reg_rtx (reg_mode);
+! mark_user_reg (DECL_RTL (decl));
+
+! if (TREE_CODE (type) == POINTER_TYPE)
+! mark_reg_pointer (DECL_RTL (decl));
+ }
+ else if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
+*************** expand_decl (decl)
+*** 3462,3468 ****
+ free_temp_slots ();
+
+! /* Allocate space on the stack for the variable. */
+ address = allocate_dynamic_stack_space (size, NULL_RTX,
+! DECL_ALIGN (decl));
+
+ /* Reference the variable indirect through that rtx. */
+--- 3452,3461 ----
+ free_temp_slots ();
+
+! /* Allocate space on the stack for the variable. Note that
+! DECL_ALIGN says how the variable is to be aligned and we
+! cannot use it to conclude anything about the alignment of
+! the size. */
+ address = allocate_dynamic_stack_space (size, NULL_RTX,
+! TYPE_ALIGN (TREE_TYPE (decl)));
+
+ /* Reference the variable indirect through that rtx. */
+diff -rcp2N gcc-2.7.2.2/stor-layout.c g77-new/stor-layout.c
+*** gcc-2.7.2.2/stor-layout.c Thu Feb 20 19:24:20 1997
+--- g77-new/stor-layout.c Mon Aug 11 06:47:50 1997
+*************** layout_decl (decl, known_align)
+*** 255,259 ****
+ if (maximum_field_alignment != 0)
+ DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), maximum_field_alignment);
+! else if (flag_pack_struct)
+ DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), BITS_PER_UNIT);
+ }
+--- 255,259 ----
+ if (maximum_field_alignment != 0)
+ DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), maximum_field_alignment);
+! else if (DECL_PACKED (decl))
+ DECL_ALIGN (decl) = MIN (DECL_ALIGN (decl), BITS_PER_UNIT);
+ }
+*************** layout_decl (decl, known_align)
+*** 261,265 ****
+ if (DECL_BIT_FIELD (decl)
+ && TYPE_SIZE (type) != 0
+! && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST)
+ {
+ register enum machine_mode xmode
+--- 261,266 ----
+ if (DECL_BIT_FIELD (decl)
+ && TYPE_SIZE (type) != 0
+! && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST
+! && GET_MODE_CLASS (TYPE_MODE (type)) == MODE_INT)
+ {
+ register enum machine_mode xmode
+*************** layout_decl (decl, known_align)
+*** 278,281 ****
+--- 279,291 ----
+ }
+
++ /* Turn off DECL_BIT_FIELD if we won't need it set. */
++ if (DECL_BIT_FIELD (decl) && TYPE_MODE (type) == BLKmode
++ && known_align % TYPE_ALIGN (type) == 0
++ && DECL_SIZE (decl) != 0
++ && (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST
++ || (TREE_INT_CST_LOW (DECL_SIZE (decl)) % BITS_PER_UNIT) == 0)
++ && DECL_ALIGN (decl) >= TYPE_ALIGN (type))
++ DECL_BIT_FIELD (decl) = 0;
++
+ /* Evaluate nonconstant size only once, either now or as soon as safe. */
+ if (DECL_SIZE (decl) != 0 && TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST)
+*************** layout_record (rec)
+*** 380,384 ****
+ if (maximum_field_alignment != 0)
+ type_align = MIN (type_align, maximum_field_alignment);
+! else if (flag_pack_struct)
+ type_align = MIN (type_align, BITS_PER_UNIT);
+
+--- 390,394 ----
+ if (maximum_field_alignment != 0)
+ type_align = MIN (type_align, maximum_field_alignment);
+! else if (TYPE_PACKED (rec))
+ type_align = MIN (type_align, BITS_PER_UNIT);
+
+*************** layout_record (rec)
+*** 422,428 ****
+ && DECL_BIT_FIELD_TYPE (field)
+ && !DECL_PACKED (field)
+- /* If #pragma pack is in effect, turn off this feature. */
+ && maximum_field_alignment == 0
+- && !flag_pack_struct
+ && !integer_zerop (DECL_SIZE (field)))
+ {
+--- 432,436 ----
+*************** layout_record (rec)
+*** 459,463 ****
+ if (maximum_field_alignment != 0)
+ type_align = MIN (type_align, maximum_field_alignment);
+! else if (flag_pack_struct)
+ type_align = MIN (type_align, BITS_PER_UNIT);
+
+--- 467,471 ----
+ if (maximum_field_alignment != 0)
+ type_align = MIN (type_align, maximum_field_alignment);
+! else if (TYPE_PACKED (rec))
+ type_align = MIN (type_align, BITS_PER_UNIT);
+
+*************** layout_record (rec)
+*** 500,505 ****
+ /* Do nothing. */;
+ else if (TREE_CODE (dsize) == INTEGER_CST
+ && TREE_INT_CST_HIGH (dsize) == 0
+! && TREE_INT_CST_LOW (dsize) + const_size > const_size)
+ /* Use const_size if there's no overflow. */
+ const_size += TREE_INT_CST_LOW (dsize);
+--- 508,514 ----
+ /* Do nothing. */;
+ else if (TREE_CODE (dsize) == INTEGER_CST
++ && ! TREE_CONSTANT_OVERFLOW (dsize)
+ && TREE_INT_CST_HIGH (dsize) == 0
+! && TREE_INT_CST_LOW (dsize) + const_size >= const_size)
+ /* Use const_size if there's no overflow. */
+ const_size += TREE_INT_CST_LOW (dsize);
+*************** get_best_mode (bitsize, bitpos, align, l
+*** 1172,1175 ****
+--- 1181,1192 ----
+ enum machine_mode mode;
+ int unit;
++
++ if (bitpos < 0)
++ {
++ /* For correct calculations and convenience, bias negative bitpos
++ to become a non-negative value that is [1,bitsize], such that
++ the relative bit offset to a multiple of bitsize is preserved. */
++ bitpos = bitsize - ((-bitpos) % bitsize);
++ }
+
+ /* Find the narrowest integer mode that contains the bit field. */
+diff -rcp2N gcc-2.7.2.2/stupid.c g77-new/stupid.c
+*** gcc-2.7.2.2/stupid.c Sun Oct 29 07:45:22 1995
+--- g77-new/stupid.c Sun Aug 10 18:46:01 1997
+*************** static int *uid_suid;
+*** 66,69 ****
+--- 66,74 ----
+ static int last_call_suid;
+
++ /* Record the suid of the last NOTE_INSN_SETJMP
++ so we can tell whether a pseudo reg crosses any setjmp. */
++
++ static int last_setjmp_suid;
++
+ /* Element N is suid of insn where life span of pseudo reg N ends.
+ Element is 0 if register N has not been seen yet on backward scan. */
+*************** static char *regs_live;
+*** 89,92 ****
+--- 94,101 ----
+ static char *regs_change_size;
+
++ /* Indexed by reg number, nonzero if reg crosses a setjmp. */
++
++ static char *regs_crosses_setjmp;
++
+ /* Indexed by insn's suid, the set of hard regs live after that insn. */
+
+*************** stupid_life_analysis (f, nregs, file)
+*** 149,152 ****
+--- 158,162 ----
+
+ last_call_suid = i + 1;
++ last_setjmp_suid = i + 1;
+ max_suid = i + 1;
+
+*************** stupid_life_analysis (f, nregs, file)
+*** 167,170 ****
+--- 177,183 ----
+ bzero ((char *) regs_change_size, nregs * sizeof (char));
+
++ regs_crosses_setjmp = (char *) alloca (nregs * sizeof (char));
++ bzero ((char *) regs_crosses_setjmp, nregs * sizeof (char));
++
+ reg_renumber = (short *) oballoc (nregs * sizeof (short));
+ for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+*************** stupid_life_analysis (f, nregs, file)
+*** 216,219 ****
+--- 229,236 ----
+ stupid_mark_refs (PATTERN (insn), insn);
+
++ if (GET_CODE (insn) == NOTE
++ && NOTE_LINE_NUMBER (insn) == NOTE_INSN_SETJMP)
++ last_setjmp_suid = INSN_SUID (insn);
++
+ /* Mark all call-clobbered regs as live after each call insn
+ so that a pseudo whose life span includes this insn
+*************** stupid_life_analysis (f, nregs, file)
+*** 254,259 ****
+ register int r = reg_order[i];
+
+! /* Some regnos disappear from the rtl. Ignore them to avoid crash. */
+! if (regno_reg_rtx[r] == 0)
+ continue;
+
+--- 271,277 ----
+ register int r = reg_order[i];
+
+! /* Some regnos disappear from the rtl. Ignore them to avoid crash.
+! Also don't allocate registers that cross a setjmp. */
+! if (regno_reg_rtx[r] == 0 || regs_crosses_setjmp[r])
+ continue;
+
+*************** stupid_reg_compare (r1p, r2p)
+*** 309,314 ****
+ that can hold a value of machine-mode MODE
+ (but actually we test only the first of the block for holding MODE)
+! currently free from after insn whose suid is BIRTH
+! through the insn whose suid is DEATH,
+ and return the number of the first of them.
+ Return -1 if such a block cannot be found.
+--- 327,332 ----
+ that can hold a value of machine-mode MODE
+ (but actually we test only the first of the block for holding MODE)
+! currently free from after insn whose suid is BORN_INSN
+! through the insn whose suid is DEAD_INSN,
+ and return the number of the first of them.
+ Return -1 if such a block cannot be found.
+*************** stupid_find_reg (call_preserved, class,
+*** 338,341 ****
+--- 356,366 ----
+ #endif
+
++ /* If this register's life is more than 5,000 insns, we probably
++ can't allocate it, so don't waste the time trying. This avoid
++ quadratic behavior on programs that have regularly-occurring
++ SAVE_EXPRs. */
++ if (dead_insn > born_insn + 5000)
++ return -1;
++
+ COPY_HARD_REG_SET (used,
+ call_preserved ? call_used_reg_set : fixed_reg_set);
+*************** stupid_mark_refs (x, insn)
+*** 488,491 ****
+--- 513,519 ----
+ if (last_call_suid < reg_where_dead[regno])
+ reg_n_calls_crossed[regno] += 1;
++
++ if (last_setjmp_suid < reg_where_dead[regno])
++ regs_crosses_setjmp[regno] = 1;
+ }
+ }
+diff -rcp2N gcc-2.7.2.2/toplev.c g77-new/toplev.c
+*** gcc-2.7.2.2/toplev.c Fri Oct 20 17:56:35 1995
+--- g77-new/toplev.c Sun Aug 10 18:43:36 1997
+*************** int flag_unroll_loops;
+*** 388,391 ****
+--- 388,405 ----
+ int flag_unroll_all_loops;
+
++ /* Nonzero forces all invariant computations in loops to be moved
++ outside the loop. */
++
++ int flag_move_all_movables = 0;
++
++ /* Nonzero forces all general induction variables in loops to be
++ strength reduced. */
++
++ int flag_reduce_all_givs = 0;
++
++ /* Nonzero gets another run of loop_optimize performed. */
++
++ int flag_rerun_loop_opt = 0;
++
+ /* Nonzero for -fwritable-strings:
+ store string constants in data segment and don't uniquize them. */
+*************** int flag_gnu_linker = 1;
+*** 522,525 ****
+--- 536,550 ----
+ int flag_pack_struct = 0;
+
++ /* 1 if alias checking is on (by default, when -O). */
++ int flag_alias_check = 0;
++
++ /* 0 if pointer arguments may alias each other. True in C.
++ 1 if pointer arguments may not alias each other but may alias
++ global variables.
++ 2 if pointer arguments may not alias each other and may not
++ alias global variables. True in Fortran.
++ This defaults to 0 for C. */
++ int flag_argument_noalias = 0;
++
+ /* Table of language-independent -f options.
+ STRING is the option name. VARIABLE is the address of the variable.
+*************** struct { char *string; int *variable; in
+*** 542,545 ****
+--- 567,573 ----
+ {"unroll-loops", &flag_unroll_loops, 1},
+ {"unroll-all-loops", &flag_unroll_all_loops, 1},
++ {"move-all-movables", &flag_move_all_movables, 1},
++ {"reduce-all-givs", &flag_reduce_all_givs, 1},
++ {"rerun-loop-opt", &flag_rerun_loop_opt, 1},
+ {"writable-strings", &flag_writable_strings, 1},
+ {"peephole", &flag_no_peephole, 0},
+*************** struct { char *string; int *variable; in
+*** 568,572 ****
+ {"gnu-linker", &flag_gnu_linker, 1},
+ {"pack-struct", &flag_pack_struct, 1},
+! {"bytecode", &output_bytecode, 1}
+ };
+
+--- 596,604 ----
+ {"gnu-linker", &flag_gnu_linker, 1},
+ {"pack-struct", &flag_pack_struct, 1},
+! {"bytecode", &output_bytecode, 1},
+! {"alias-check", &flag_alias_check, 1},
+! {"argument-alias", &flag_argument_noalias, 0},
+! {"argument-noalias", &flag_argument_noalias, 1},
+! {"argument-noalias-global", &flag_argument_noalias, 2}
+ };
+
+*************** rest_of_compilation (decl)
+*** 2715,2725 ****
+ finish_compilation will call rest_of_compilation again
+ for those functions that need to be output. Also defer those
+! functions that we are supposed to defer. */
+!
+! if (DECL_DEFER_OUTPUT (decl)
+! || ((specd || DECL_INLINE (decl))
+! && ((! TREE_PUBLIC (decl) && ! TREE_ADDRESSABLE (decl)
+! && ! flag_keep_inline_functions)
+! || DECL_EXTERNAL (decl))))
+ {
+ DECL_DEFER_OUTPUT (decl) = 1;
+--- 2747,2760 ----
+ finish_compilation will call rest_of_compilation again
+ for those functions that need to be output. Also defer those
+! functions that we are supposed to defer. We cannot defer
+! functions containing nested functions since the nested function
+! data is in our non-saved obstack. */
+!
+! if (! current_function_contains_functions
+! && (DECL_DEFER_OUTPUT (decl)
+! || ((specd || DECL_INLINE (decl))
+! && ((! TREE_PUBLIC (decl) && ! TREE_ADDRESSABLE (decl)
+! && ! flag_keep_inline_functions)
+! || DECL_EXTERNAL (decl)))))
+ {
+ DECL_DEFER_OUTPUT (decl) = 1;
+*************** rest_of_compilation (decl)
+*** 2893,2897 ****
+--- 2928,2951 ----
+ TIMEVAR (loop_time,
+ {
++ int save_unroll_flag;
++ int save_unroll_all_flag;
++
++ if (flag_rerun_loop_opt)
++ {
++ save_unroll_flag = flag_unroll_loops;
++ save_unroll_all_flag = flag_unroll_all_loops;
++ flag_unroll_loops = 0;
++ flag_unroll_all_loops = 0;
++ }
++
+ loop_optimize (insns, loop_dump_file);
++
++ if (flag_rerun_loop_opt)
++ {
++ flag_unroll_loops = save_unroll_flag;
++ flag_unroll_all_loops = save_unroll_all_flag;
++
++ loop_optimize (insns, loop_dump_file);
++ }
+ });
+ }
+*************** rest_of_compilation (decl)
+*** 3280,3283 ****
+--- 3334,3341 ----
+ resume_temporary_allocation ();
+
++ /* Show no temporary slots allocated. */
++
++ init_temp_slots ();
++
+ /* The parsing time is all the time spent in yyparse
+ *except* what is spent in this function. */
+*************** main (argc, argv, envp)
+*** 3383,3386 ****
+--- 3441,3445 ----
+ flag_omit_frame_pointer = 1;
+ #endif
++ flag_alias_check = 1;
+ }
+
+diff -rcp2N gcc-2.7.2.2/tree.c g77-new/tree.c
+*** gcc-2.7.2.2/tree.c Sun Oct 1 21:26:56 1995
+--- g77-new/tree.c Sun Aug 10 18:47:23 1997
+*************** build_string (len, str)
+*** 1428,1436 ****
+ /* Return a newly constructed COMPLEX_CST node whose value is
+ specified by the real and imaginary parts REAL and IMAG.
+! Both REAL and IMAG should be constant nodes.
+! The TREE_TYPE is not initialized. */
+
+ tree
+! build_complex (real, imag)
+ tree real, imag;
+ {
+--- 1428,1437 ----
+ /* Return a newly constructed COMPLEX_CST node whose value is
+ specified by the real and imaginary parts REAL and IMAG.
+! Both REAL and IMAG should be constant nodes. TYPE, if specified,
+! will be the type of the COMPLEX_CST; otherwise a new type will be made. */
+
+ tree
+! build_complex (type, real, imag)
+! tree type;
+ tree real, imag;
+ {
+*************** build_complex (real, imag)
+*** 1439,1443 ****
+ TREE_REALPART (t) = real;
+ TREE_IMAGPART (t) = imag;
+! TREE_TYPE (t) = build_complex_type (TREE_TYPE (real));
+ TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag);
+ TREE_CONSTANT_OVERFLOW (t)
+--- 1440,1444 ----
+ TREE_REALPART (t) = real;
+ TREE_IMAGPART (t) = imag;
+! TREE_TYPE (t) = type ? type : build_complex_type (TREE_TYPE (real));
+ TREE_OVERFLOW (t) = TREE_OVERFLOW (real) | TREE_OVERFLOW (imag);
+ TREE_CONSTANT_OVERFLOW (t)
+*************** integer_zerop (expr)
+*** 1484,1487 ****
+--- 1485,1489 ----
+
+ return ((TREE_CODE (expr) == INTEGER_CST
++ && ! TREE_CONSTANT_OVERFLOW (expr)
+ && TREE_INT_CST_LOW (expr) == 0
+ && TREE_INT_CST_HIGH (expr) == 0)
+*************** integer_onep (expr)
+*** 1501,1504 ****
+--- 1503,1507 ----
+
+ return ((TREE_CODE (expr) == INTEGER_CST
++ && ! TREE_CONSTANT_OVERFLOW (expr)
+ && TREE_INT_CST_LOW (expr) == 1
+ && TREE_INT_CST_HIGH (expr) == 0)
+*************** integer_all_onesp (expr)
+*** 1525,1529 ****
+ return 1;
+
+! else if (TREE_CODE (expr) != INTEGER_CST)
+ return 0;
+
+--- 1528,1533 ----
+ return 1;
+
+! else if (TREE_CODE (expr) != INTEGER_CST
+! || TREE_CONSTANT_OVERFLOW (expr))
+ return 0;
+
+*************** integer_pow2p (expr)
+*** 1574,1578 ****
+ return 1;
+
+! if (TREE_CODE (expr) != INTEGER_CST)
+ return 0;
+
+--- 1578,1582 ----
+ return 1;
+
+! if (TREE_CODE (expr) != INTEGER_CST || TREE_CONSTANT_OVERFLOW (expr))
+ return 0;
+
+*************** real_zerop (expr)
+*** 1596,1599 ****
+--- 1600,1604 ----
+
+ return ((TREE_CODE (expr) == REAL_CST
++ && ! TREE_CONSTANT_OVERFLOW (expr)
+ && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst0))
+ || (TREE_CODE (expr) == COMPLEX_CST
+*************** real_onep (expr)
+*** 1611,1614 ****
+--- 1616,1620 ----
+
+ return ((TREE_CODE (expr) == REAL_CST
++ && ! TREE_CONSTANT_OVERFLOW (expr)
+ && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst1))
+ || (TREE_CODE (expr) == COMPLEX_CST
+*************** real_twop (expr)
+*** 1626,1629 ****
+--- 1632,1636 ----
+
+ return ((TREE_CODE (expr) == REAL_CST
++ && ! TREE_CONSTANT_OVERFLOW (expr)
+ && REAL_VALUES_EQUAL (TREE_REAL_CST (expr), dconst2))
+ || (TREE_CODE (expr) == COMPLEX_CST
+*************** staticp (arg)
+*** 2055,2061 ****
+ return 1;
+
+ case COMPONENT_REF:
+ case BIT_FIELD_REF:
+! return staticp (TREE_OPERAND (arg, 0));
+
+ #if 0
+--- 2062,2073 ----
+ return 1;
+
++ /* If we are referencing a bitfield, we can't evaluate an
++ ADDR_EXPR at compile time and so it isn't a constant. */
+ case COMPONENT_REF:
++ return (! DECL_BIT_FIELD (TREE_OPERAND (arg, 1))
++ && staticp (TREE_OPERAND (arg, 0)));
++
+ case BIT_FIELD_REF:
+! return 0;
+
+ #if 0
+*************** contains_placeholder_p (exp)
+*** 2157,2160 ****
+--- 2169,2174 ----
+ if (code == WITH_RECORD_EXPR)
+ return 0;
++ else if (code == PLACEHOLDER_EXPR)
++ return 1;
+
+ switch (TREE_CODE_CLASS (code))
+*************** substitute_in_expr (exp, f, r)
+*** 2204,2207 ****
+--- 2218,2222 ----
+ {
+ enum tree_code code = TREE_CODE (exp);
++ tree op0, op1, op2;
+ tree new = 0;
+ tree inner;
+*************** substitute_in_expr (exp, f, r)
+*** 2225,2231 ****
+ {
+ case 1:
+! new = fold (build1 (code, TREE_TYPE (exp),
+! substitute_in_expr (TREE_OPERAND (exp, 0),
+! f, r)));
+ break;
+
+--- 2240,2248 ----
+ {
+ case 1:
+! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! if (op0 == TREE_OPERAND (exp, 0))
+! return exp;
+!
+! new = fold (build1 (code, TREE_TYPE (exp), op0));
+ break;
+
+*************** substitute_in_expr (exp, f, r)
+*** 2238,2245 ****
+ abort ();
+
+! new = fold (build (code, TREE_TYPE (exp),
+! substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+! substitute_in_expr (TREE_OPERAND (exp, 1),
+! f, r)));
+ break;
+
+--- 2255,2264 ----
+ abort ();
+
+! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
+! if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
+! return exp;
+!
+! new = fold (build (code, TREE_TYPE (exp), op0, op1));
+ break;
+
+*************** substitute_in_expr (exp, f, r)
+*** 2253,2261 ****
+ abort ();
+
+! new = fold (build (code, TREE_TYPE (exp),
+! substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+! substitute_in_expr (TREE_OPERAND (exp, 1), f, r),
+! substitute_in_expr (TREE_OPERAND (exp, 2),
+! f, r)));
+ }
+
+--- 2272,2283 ----
+ abort ();
+
+! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
+! op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
+! if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
+! && op2 == TREE_OPERAND (exp, 2))
+! return exp;
+!
+! new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
+ }
+
+*************** substitute_in_expr (exp, f, r)
+*** 2276,2302 ****
+ return r;
+
+! new = fold (build (code, TREE_TYPE (exp),
+! substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+ TREE_OPERAND (exp, 1)));
+ break;
+
+ case BIT_FIELD_REF:
+! new = fold (build (code, TREE_TYPE (exp),
+! substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+! substitute_in_expr (TREE_OPERAND (exp, 1), f, r),
+! substitute_in_expr (TREE_OPERAND (exp, 2), f, r)));
+ break;
+
+ case INDIRECT_REF:
+ case BUFFER_REF:
+! new = fold (build1 (code, TREE_TYPE (exp),
+! substitute_in_expr (TREE_OPERAND (exp, 0),
+! f, r)));
+ break;
+
+ case OFFSET_REF:
+! new = fold (build (code, TREE_TYPE (exp),
+! substitute_in_expr (TREE_OPERAND (exp, 0), f, r),
+! substitute_in_expr (TREE_OPERAND (exp, 1), f, r)));
+ break;
+ }
+--- 2298,2342 ----
+ return r;
+
+! /* If this expression hasn't been completed let, leave it
+! alone. */
+! if (TREE_CODE (inner) == PLACEHOLDER_EXPR
+! && TREE_TYPE (inner) == 0)
+! return exp;
+!
+! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! if (op0 == TREE_OPERAND (exp, 0))
+! return exp;
+!
+! new = fold (build (code, TREE_TYPE (exp), op0,
+ TREE_OPERAND (exp, 1)));
+ break;
+
+ case BIT_FIELD_REF:
+! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
+! op2 = substitute_in_expr (TREE_OPERAND (exp, 2), f, r);
+! if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)
+! && op2 == TREE_OPERAND (exp, 2))
+! return exp;
+!
+! new = fold (build (code, TREE_TYPE (exp), op0, op1, op2));
+ break;
+
+ case INDIRECT_REF:
+ case BUFFER_REF:
+! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! if (op0 == TREE_OPERAND (exp, 0))
+! return exp;
+!
+! new = fold (build1 (code, TREE_TYPE (exp), op0));
+ break;
+
+ case OFFSET_REF:
+! op0 = substitute_in_expr (TREE_OPERAND (exp, 0), f, r);
+! op1 = substitute_in_expr (TREE_OPERAND (exp, 1), f, r);
+! if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
+! return exp;
+!
+! new = fold (build (code, TREE_TYPE (exp), op0, op1));
+ break;
+ }
+*************** substitute_in_expr (exp, f, r)
+*** 2311,2454 ****
+ }
+
+- /* Given a type T, a FIELD_DECL F, and a replacement value R,
+- return a new type with all size expressions that contain F
+- updated by replacing F with R. */
+-
+- tree
+- substitute_in_type (t, f, r)
+- tree t, f, r;
+- {
+- switch (TREE_CODE (t))
+- {
+- case POINTER_TYPE:
+- case VOID_TYPE:
+- return t;
+- case INTEGER_TYPE:
+- case ENUMERAL_TYPE:
+- case BOOLEAN_TYPE:
+- case CHAR_TYPE:
+- if ((TREE_CODE (TYPE_MIN_VALUE (t)) != INTEGER_CST
+- && contains_placeholder_p (TYPE_MIN_VALUE (t)))
+- || (TREE_CODE (TYPE_MAX_VALUE (t)) != INTEGER_CST
+- && contains_placeholder_p (TYPE_MAX_VALUE (t))))
+- return build_range_type (t,
+- substitute_in_expr (TYPE_MIN_VALUE (t), f, r),
+- substitute_in_expr (TYPE_MAX_VALUE (t), f, r));
+- return t;
+-
+- case REAL_TYPE:
+- if ((TYPE_MIN_VALUE (t) != 0
+- && TREE_CODE (TYPE_MIN_VALUE (t)) != REAL_CST
+- && contains_placeholder_p (TYPE_MIN_VALUE (t)))
+- || (TYPE_MAX_VALUE (t) != 0
+- && TREE_CODE (TYPE_MAX_VALUE (t)) != REAL_CST
+- && contains_placeholder_p (TYPE_MAX_VALUE (t))))
+- {
+- t = build_type_copy (t);
+-
+- if (TYPE_MIN_VALUE (t))
+- TYPE_MIN_VALUE (t) = substitute_in_expr (TYPE_MIN_VALUE (t), f, r);
+- if (TYPE_MAX_VALUE (t))
+- TYPE_MAX_VALUE (t) = substitute_in_expr (TYPE_MAX_VALUE (t), f, r);
+- }
+- return t;
+-
+- case COMPLEX_TYPE:
+- return build_complex_type (substitute_in_type (TREE_TYPE (t), f, r));
+-
+- case OFFSET_TYPE:
+- case METHOD_TYPE:
+- case REFERENCE_TYPE:
+- case FILE_TYPE:
+- case SET_TYPE:
+- case FUNCTION_TYPE:
+- case LANG_TYPE:
+- /* Don't know how to do these yet. */
+- abort ();
+-
+- case ARRAY_TYPE:
+- t = build_array_type (substitute_in_type (TREE_TYPE (t), f, r),
+- substitute_in_type (TYPE_DOMAIN (t), f, r));
+- TYPE_SIZE (t) = 0;
+- layout_type (t);
+- return t;
+-
+- case RECORD_TYPE:
+- case UNION_TYPE:
+- case QUAL_UNION_TYPE:
+- {
+- tree new = copy_node (t);
+- tree field;
+- tree last_field = 0;
+-
+- /* Start out with no fields, make new fields, and chain them
+- in. */
+-
+- TYPE_FIELDS (new) = 0;
+- TYPE_SIZE (new) = 0;
+-
+- for (field = TYPE_FIELDS (t); field;
+- field = TREE_CHAIN (field))
+- {
+- tree new_field = copy_node (field);
+-
+- TREE_TYPE (new_field)
+- = substitute_in_type (TREE_TYPE (new_field), f, r);
+-
+- /* If this is an anonymous field and the type of this field is
+- a UNION_TYPE or RECORD_TYPE with no elements, ignore it. If
+- the type just has one element, treat that as the field.
+- But don't do this if we are processing a QUAL_UNION_TYPE. */
+- if (TREE_CODE (t) != QUAL_UNION_TYPE && DECL_NAME (new_field) == 0
+- && (TREE_CODE (TREE_TYPE (new_field)) == UNION_TYPE
+- || TREE_CODE (TREE_TYPE (new_field)) == RECORD_TYPE))
+- {
+- if (TYPE_FIELDS (TREE_TYPE (new_field)) == 0)
+- continue;
+-
+- if (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_field))) == 0)
+- new_field = TYPE_FIELDS (TREE_TYPE (new_field));
+- }
+-
+- DECL_CONTEXT (new_field) = new;
+- DECL_SIZE (new_field) = 0;
+-
+- if (TREE_CODE (t) == QUAL_UNION_TYPE)
+- {
+- /* Do the substitution inside the qualifier and if we find
+- that this field will not be present, omit it. */
+- DECL_QUALIFIER (new_field)
+- = substitute_in_expr (DECL_QUALIFIER (field), f, r);
+- if (integer_zerop (DECL_QUALIFIER (new_field)))
+- continue;
+- }
+-
+- if (last_field == 0)
+- TYPE_FIELDS (new) = new_field;
+- else
+- TREE_CHAIN (last_field) = new_field;
+-
+- last_field = new_field;
+-
+- /* If this is a qualified type and this field will always be
+- present, we are done. */
+- if (TREE_CODE (t) == QUAL_UNION_TYPE
+- && integer_onep (DECL_QUALIFIER (new_field)))
+- break;
+- }
+-
+- /* If this used to be a qualified union type, but we now know what
+- field will be present, make this a normal union. */
+- if (TREE_CODE (new) == QUAL_UNION_TYPE
+- && (TYPE_FIELDS (new) == 0
+- || integer_onep (DECL_QUALIFIER (TYPE_FIELDS (new)))))
+- TREE_SET_CODE (new, UNION_TYPE);
+-
+- layout_type (new);
+- return new;
+- }
+- }
+- }
+-
+ /* Stabilize a reference so that we can use it any number of times
+ without causing its operands to be evaluated more than once.
+--- 2351,2354 ----
+*************** build_type_variant (type, constp, volati
+*** 3141,3145 ****
+ preserve the TYPE_NAME, since there is code that depends on this. */
+
+! for (t = TYPE_MAIN_VARIANT(type); t; t = TYPE_NEXT_VARIANT (t))
+ if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
+ && TYPE_NAME (t) == TYPE_NAME (type))
+--- 3041,3045 ----
+ preserve the TYPE_NAME, since there is code that depends on this. */
+
+! for (t = TYPE_MAIN_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
+ if (constp == TYPE_READONLY (t) && volatilep == TYPE_VOLATILE (t)
+ && TYPE_NAME (t) == TYPE_NAME (type))
+*************** get_unwidened (op, for_type)
+*** 4051,4055 ****
+ if (TREE_CODE (op) == COMPONENT_REF
+ /* Since type_for_size always gives an integer type. */
+! && TREE_CODE (type) != REAL_TYPE)
+ {
+ unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
+--- 3951,3957 ----
+ if (TREE_CODE (op) == COMPONENT_REF
+ /* Since type_for_size always gives an integer type. */
+! && TREE_CODE (type) != REAL_TYPE
+! /* Don't crash if field not layed out yet. */
+! && DECL_SIZE (TREE_OPERAND (op, 1)) != 0)
+ {
+ unsigned innerprec = TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (op, 1)));
+diff -rcp2N gcc-2.7.2.2/tree.h g77-new/tree.h
+*** gcc-2.7.2.2/tree.h Mon Sep 25 17:49:40 1995
+--- g77-new/tree.h Sun Aug 10 18:47:08 1997
+*************** enum built_in_function
+*** 98,101 ****
+--- 98,103 ----
+ BUILT_IN_APPLY,
+ BUILT_IN_RETURN,
++ BUILT_IN_SETJMP,
++ BUILT_IN_LONGJMP,
+
+ /* C++ extensions */
+*************** struct tree_int_cst
+*** 408,411 ****
+--- 410,415 ----
+ {
+ char common[sizeof (struct tree_common)];
++ struct rtx_def *rtl; /* acts as link to register transfer language
++ (rtl) info */
+ HOST_WIDE_INT int_cst_low;
+ HOST_WIDE_INT int_cst_high;
+*************** struct tree_type
+*** 957,960 ****
+--- 961,967 ----
+ #define DECL_STATIC_DESTRUCTOR(NODE) ((NODE)->decl.static_dtor_flag)
+
++ /* In a PARM_DECL, nonzero if this is a restricted pointer. */
++ #define DECL_RESTRICT(NODE) (NODE)->decl.static_ctor_flag
++
+ /* Used to indicate that this DECL represents a compiler-generated entity. */
+ #define DECL_ARTIFICIAL(NODE) ((NODE)->decl.artificial_flag)
+*************** extern tree build_int_2_wide PROTO((HOS
+*** 1176,1180 ****
+ extern tree build_real PROTO((tree, REAL_VALUE_TYPE));
+ extern tree build_real_from_int_cst PROTO((tree, tree));
+! extern tree build_complex PROTO((tree, tree));
+ extern tree build_string PROTO((int, char *));
+ extern tree build1 PROTO((enum tree_code, tree, tree));
+--- 1183,1187 ----
+ extern tree build_real PROTO((tree, REAL_VALUE_TYPE));
+ extern tree build_real_from_int_cst PROTO((tree, tree));
+! extern tree build_complex PROTO((tree, tree, tree));
+ extern tree build_string PROTO((int, char *));
+ extern tree build1 PROTO((enum tree_code, tree, tree));
+*************** extern int contains_placeholder_p PROTO(
+*** 1378,1387 ****
+ extern tree substitute_in_expr PROTO((tree, tree, tree));
+
+- /* Given a type T, a FIELD_DECL F, and a replacement value R,
+- return a new type with all size expressions that contain F
+- updated by replacing the reference to F with R. */
+-
+- extern tree substitute_in_type PROTO((tree, tree, tree));
+-
+ /* variable_size (EXP) is like save_expr (EXP) except that it
+ is for the special case of something that is part of a
+--- 1385,1388 ----
+*************** extern tree maybe_build_cleanup PROTO((
+*** 1456,1460 ****
+ and find the ultimate containing object, which is returned. */
+
+! extern tree get_inner_reference PROTO((tree, int *, int *, tree *, enum machine_mode *, int *, int *));
+
+ /* Return the FUNCTION_DECL which provides this _DECL with its context,
+--- 1457,1463 ----
+ and find the ultimate containing object, which is returned. */
+
+! extern tree get_inner_reference PROTO((tree, int *, int *, tree *,
+! enum machine_mode *, int *,
+! int *, int *));
+
+ /* Return the FUNCTION_DECL which provides this _DECL with its context,
+diff -rcp2N gcc-2.7.2.2/unroll.c g77-new/unroll.c
+*** gcc-2.7.2.2/unroll.c Sat Aug 19 17:33:26 1995
+--- g77-new/unroll.c Thu Jul 10 20:09:10 1997
+*************** unroll_loop (loop_end, insn_count, loop_
+*** 268,273 ****
+ structure of the function. This can happen as a result of the
+ "if (foo) bar; else break;" optimization in jump.c. */
+
+! if (write_symbols != NO_DEBUG)
+ {
+ int block_begins = 0;
+--- 268,277 ----
+ structure of the function. This can happen as a result of the
+ "if (foo) bar; else break;" optimization in jump.c. */
++ /* ??? Gcc has a general policy that -g is never supposed to change the code
++ that the compiler emits, so we must disable this optimization always,
++ even if debug info is not being output. This is rare, so this should
++ not be a significant performance problem. */
+
+! if (1 /* write_symbols != NO_DEBUG */)
+ {
+ int block_begins = 0;
+*************** unroll_loop (loop_end, insn_count, loop_
+*** 633,636 ****
+--- 637,657 ----
+ }
+
++ if (unroll_type == UNROLL_NAIVE
++ && GET_CODE (last_loop_insn) == JUMP_INSN
++ && start_label != JUMP_LABEL (last_loop_insn))
++ {
++ /* ??? The loop ends with a conditional branch that does not branch back
++ to the loop start label. In this case, we must emit an unconditional
++ branch to the loop exit after emitting the final branch.
++ copy_loop_body does not have support for this currently, so we
++ give up. It doesn't seem worthwhile to unroll anyways since
++ unrolling would increase the number of branch instructions
++ executed. */
++ if (loop_dump_stream)
++ fprintf (loop_dump_stream,
++ "Unrolling failure: final conditional branch not to loop start\n");
++ return;
++ }
++
+ /* Allocate a translation table for the labels and insn numbers.
+ They will be filled in as we copy the insns in the loop. */
+*************** unroll_loop (loop_end, insn_count, loop_
+*** 995,999 ****
+ for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++)
+ if (local_regno[j])
+! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j]));
+
+ /* The last copy needs the compare/branch insns at the end,
+--- 1016,1024 ----
+ for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++)
+ if (local_regno[j])
+! {
+! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j]));
+! record_base_value (REGNO (map->reg_map[j]),
+! regno_reg_rtx[j]);
+! }
+
+ /* The last copy needs the compare/branch insns at the end,
+*************** unroll_loop (loop_end, insn_count, loop_
+*** 1136,1140 ****
+ for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++)
+ if (local_regno[j])
+! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j]));
+
+ /* If loop starts with a branch to the test, then fix it so that
+--- 1161,1169 ----
+ for (j = FIRST_PSEUDO_REGISTER; j < max_reg_before_loop; j++)
+ if (local_regno[j])
+! {
+! map->reg_map[j] = gen_reg_rtx (GET_MODE (regno_reg_rtx[j]));
+! record_base_value (REGNO (map->reg_map[j]),
+! regno_reg_rtx[j]);
+! }
+
+ /* If loop starts with a branch to the test, then fix it so that
+*************** copy_loop_body (copy_start, copy_end, ma
+*** 1605,1608 ****
+--- 1634,1641 ----
+ int this_giv_inc = INTVAL (giv_inc);
+
++ /* If this DEST_ADDR giv was not split, then ignore it. */
++ if (*tv->location != tv->dest_reg)
++ continue;
++
+ /* Scale this_giv_inc if the multiplicative factors of
+ the two givs are different. */
+*************** copy_loop_body (copy_start, copy_end, ma
+*** 1631,1635 ****
+ incrementing the shared pseudo reg more than
+ once. */
+! if (! tv->same_insn)
+ {
+ /* tv->dest_reg may actually be a (PLUS (REG)
+--- 1664,1668 ----
+ incrementing the shared pseudo reg more than
+ once. */
+! if (! tv->same_insn && ! tv->shared)
+ {
+ /* tv->dest_reg may actually be a (PLUS (REG)
+*************** copy_loop_body (copy_start, copy_end, ma
+*** 1757,1760 ****
+--- 1790,1794 ----
+ giv_dest_reg = tem;
+ map->reg_map[regno] = tem;
++ record_base_value (REGNO (tem), giv_src_reg);
+ }
+ else
+*************** iteration_info (iteration_var, initial_v
+*** 2220,2231 ****
+ return;
+ }
+! /* Reject iteration variables larger than the host long size, since they
+ could result in a number of iterations greater than the range of our
+! `unsigned long' variable loop_n_iterations. */
+! else if (GET_MODE_BITSIZE (GET_MODE (iteration_var)) > HOST_BITS_PER_LONG)
+ {
+ if (loop_dump_stream)
+ fprintf (loop_dump_stream,
+! "Loop unrolling: Iteration var rejected because mode larger than host long.\n");
+ return;
+ }
+--- 2254,2266 ----
+ return;
+ }
+! /* Reject iteration variables larger than the host wide int size, since they
+ could result in a number of iterations greater than the range of our
+! `unsigned HOST_WIDE_INT' variable loop_n_iterations. */
+! else if ((GET_MODE_BITSIZE (GET_MODE (iteration_var))
+! > HOST_BITS_PER_WIDE_INT))
+ {
+ if (loop_dump_stream)
+ fprintf (loop_dump_stream,
+! "Loop unrolling: Iteration var rejected because mode too large.\n");
+ return;
+ }
+*************** find_splittable_regs (unroll_type, loop_
+*** 2443,2447 ****
+ {
+ rtx tem = gen_reg_rtx (bl->biv->mode);
+!
+ emit_insn_before (gen_move_insn (tem, bl->biv->src_reg),
+ loop_start);
+--- 2478,2483 ----
+ {
+ rtx tem = gen_reg_rtx (bl->biv->mode);
+!
+! record_base_value (REGNO (tem), bl->biv->add_val);
+ emit_insn_before (gen_move_insn (tem, bl->biv->src_reg),
+ loop_start);
+*************** find_splittable_regs (unroll_type, loop_
+*** 2500,2503 ****
+--- 2536,2541 ----
+ exits. */
+ rtx tem = gen_reg_rtx (bl->biv->mode);
++ record_base_value (REGNO (tem), bl->biv->add_val);
++
+ emit_insn_before (gen_move_insn (tem, bl->biv->src_reg),
+ loop_start);
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2675,2678 ****
+--- 2713,2717 ----
+ rtx tem = gen_reg_rtx (bl->biv->mode);
+
++ record_base_value (REGNO (tem), bl->biv->add_val);
+ emit_insn_before (gen_move_insn (tem, bl->biv->src_reg),
+ loop_start);
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2716,2719 ****
+--- 2755,2759 ----
+ {
+ rtx tem = gen_reg_rtx (v->mode);
++ record_base_value (REGNO (tem), v->add_val);
+ emit_iv_add_mult (bl->initial_value, v->mult_val,
+ v->add_val, tem, loop_start);
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2734,2747 ****
+ register for the split addr giv, just to be safe. */
+
+! /* ??? If there are multiple address givs which have been
+! combined with the same dest_reg giv, then we may only need
+! one new register for them. Pulling out constants below will
+! catch some of the common cases of this. Currently, I leave
+! the work of simplifying multiple address givs to the
+! following cse pass. */
+!
+! /* As a special case, if we have multiple identical address givs
+! within a single instruction, then we do use a single pseudo
+! reg for both. This is necessary in case one is a match_dup
+ of the other. */
+
+--- 2774,2780 ----
+ register for the split addr giv, just to be safe. */
+
+! /* If we have multiple identical address givs within a
+! single instruction, then use a single pseudo reg for
+! both. This is necessary in case one is a match_dup
+ of the other. */
+
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2756,2759 ****
+--- 2789,2812 ----
+ INSN_UID (v->insn));
+ }
++ /* If multiple address GIVs have been combined with the
++ same dest_reg GIV, do not create a new register for
++ each. */
++ else if (unroll_type != UNROLL_COMPLETELY
++ && v->giv_type == DEST_ADDR
++ && v->same && v->same->giv_type == DEST_ADDR
++ && v->same->unrolled
++ #ifdef ADDRESS_COST
++ /* combine_givs_p may return true when ADDRESS_COST is
++ defined even if the multiply and add values are
++ not equal. To share a register here, the values
++ must be equal, as well as related. */
++ && rtx_equal_p (v->mult_val, v->same->mult_val)
++ && rtx_equal_p (v->add_val, v->same->add_val)
++ #endif
++ )
++ {
++ v->dest_reg = v->same->dest_reg;
++ v->shared = 1;
++ }
+ else if (unroll_type != UNROLL_COMPLETELY)
+ {
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2761,2765 ****
+ register to hold the split value of the DEST_ADDR giv.
+ Emit insn to initialize its value before loop start. */
+! tem = gen_reg_rtx (v->mode);
+
+ /* If the address giv has a constant in its new_reg value,
+--- 2814,2821 ----
+ register to hold the split value of the DEST_ADDR giv.
+ Emit insn to initialize its value before loop start. */
+!
+! rtx tem = gen_reg_rtx (v->mode);
+! record_base_value (REGNO (tem), v->add_val);
+! v->unrolled = 1;
+
+ /* If the address giv has a constant in its new_reg value,
+*************** find_splittable_givs (bl, unroll_type, l
+*** 2772,2781 ****
+ v->dest_reg
+ = plus_constant (tem, INTVAL (XEXP (v->new_reg,1)));
+!
+ /* Only succeed if this will give valid addresses.
+ Try to validate both the first and the last
+ address resulting from loop unrolling, if
+ one fails, then can't do const elim here. */
+! if (! verify_addresses (v, giv_inc, unroll_number))
+ {
+ /* Save the negative of the eliminated const, so
+--- 2828,2837 ----
+ v->dest_reg
+ = plus_constant (tem, INTVAL (XEXP (v->new_reg,1)));
+!
+ /* Only succeed if this will give valid addresses.
+ Try to validate both the first and the last
+ address resulting from loop unrolling, if
+ one fails, then can't do const elim here. */
+! if (verify_addresses (v, giv_inc, unroll_number))
+ {
+ /* Save the negative of the eliminated const, so
+*************** final_biv_value (bl, loop_start, loop_en
+*** 3061,3064 ****
+--- 3117,3121 ----
+
+ tem = gen_reg_rtx (bl->biv->mode);
++ record_base_value (REGNO (tem), bl->biv->add_val);
+ /* Make sure loop_end is not the last insn. */
+ if (NEXT_INSN (loop_end) == 0)
+*************** final_giv_value (v, loop_start, loop_end
+*** 3154,3157 ****
+--- 3211,3215 ----
+ /* Put the final biv value in tem. */
+ tem = gen_reg_rtx (bl->biv->mode);
++ record_base_value (REGNO (tem), bl->biv->add_val);
+ emit_iv_add_mult (increment, GEN_INT (loop_n_iterations),
+ bl->initial_value, tem, insert_before);
+diff -rcp2N gcc-2.7.2.2/varasm.c g77-new/varasm.c
+*** gcc-2.7.2.2/varasm.c Thu Aug 31 19:02:53 1995
+--- g77-new/varasm.c Sun Aug 10 22:26:32 1997
+*************** assemble_variable (decl, top_level, at_e
+*** 1067,1070 ****
+--- 1067,1072 ----
+ if (! dont_output_data)
+ {
++ int size;
++
+ if (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST)
+ goto finish;
+*************** assemble_variable (decl, top_level, at_e
+*** 1072,1078 ****
+ /* This is better than explicit arithmetic, since it avoids overflow. */
+ size_tree = size_binop (CEIL_DIV_EXPR,
+! DECL_SIZE (decl), size_int (BITS_PER_UNIT));
+
+! if (TREE_INT_CST_HIGH (size_tree) != 0)
+ {
+ error_with_decl (decl, "size of variable `%s' is too large");
+--- 1074,1082 ----
+ /* This is better than explicit arithmetic, since it avoids overflow. */
+ size_tree = size_binop (CEIL_DIV_EXPR,
+! DECL_SIZE (decl), size_int (BITS_PER_UNIT));
+
+! size = TREE_INT_CST_LOW (size_tree);
+! if (TREE_INT_CST_HIGH (size_tree) != 0
+! || size != TREE_INT_CST_LOW (size_tree))
+ {
+ error_with_decl (decl, "size of variable `%s' is too large");
+*************** decode_addr_const (exp, value)
+*** 2132,2135 ****
+--- 2136,2140 ----
+ case COMPLEX_CST:
+ case CONSTRUCTOR:
++ case INTEGER_CST:
+ x = TREE_CST_RTL (target);
+ break;
+*************** const_hash (exp)
+*** 2247,2251 ****
+ return const_hash (TREE_OPERAND (exp, 0)) * 9
+ + const_hash (TREE_OPERAND (exp, 1));
+! else if (code == NOP_EXPR || code == CONVERT_EXPR)
+ return const_hash (TREE_OPERAND (exp, 0)) * 7 + 2;
+
+--- 2252,2256 ----
+ return const_hash (TREE_OPERAND (exp, 0)) * 9
+ + const_hash (TREE_OPERAND (exp, 1));
+! else if (code == NOP_EXPR || code == CONVERT_EXPR || code == NON_LVALUE_EXPR)
+ return const_hash (TREE_OPERAND (exp, 0)) * 7 + 2;
+
+*************** compare_constant_1 (exp, p)
+*** 2401,2405 ****
+ return p;
+ }
+! else if (code == NOP_EXPR || code == CONVERT_EXPR)
+ {
+ p = compare_constant_1 (TREE_OPERAND (exp, 0), p);
+--- 2406,2410 ----
+ return p;
+ }
+! else if (code == NOP_EXPR || code == CONVERT_EXPR || code == NON_LVALUE_EXPR)
+ {
+ p = compare_constant_1 (TREE_OPERAND (exp, 0), p);
+*************** copy_constant (exp)
+*** 2633,2637 ****
+
+ case COMPLEX_CST:
+! return build_complex (copy_constant (TREE_REALPART (exp)),
+ copy_constant (TREE_IMAGPART (exp)));
+
+--- 2638,2643 ----
+
+ case COMPLEX_CST:
+! return build_complex (TREE_TYPE (exp),
+! copy_constant (TREE_REALPART (exp)),
+ copy_constant (TREE_IMAGPART (exp)));
+
+*************** copy_constant (exp)
+*** 2644,2647 ****
+--- 2650,2654 ----
+ case NOP_EXPR:
+ case CONVERT_EXPR:
++ case NON_LVALUE_EXPR:
+ return build1 (TREE_CODE (exp), TREE_TYPE (exp),
+ copy_constant (TREE_OPERAND (exp, 0)));
+*************** output_constant_def (exp)
+*** 2690,2696 ****
+ register rtx def;
+
+- if (TREE_CODE (exp) == INTEGER_CST)
+- abort (); /* No TREE_CST_RTL slot in these. */
+-
+ if (TREE_CST_RTL (exp))
+ return TREE_CST_RTL (exp);
+--- 2697,2700 ----
+*************** bc_assemble_integer (exp, size)
+*** 3620,3624 ****
+ exp = fold (exp);
+
+! while (TREE_CODE (exp) == NOP_EXPR || TREE_CODE (exp) == CONVERT_EXPR)
+ exp = TREE_OPERAND (exp, 0);
+ if (TREE_CODE (exp) == INTEGER_CST)
+--- 3624,3629 ----
+ exp = fold (exp);
+
+! while (TREE_CODE (exp) == NOP_EXPR || TREE_CODE (exp) == CONVERT_EXPR
+! || TREE_CODE (exp) == NON_LVALUE_EXPR)
+ exp = TREE_OPERAND (exp, 0);
+ if (TREE_CODE (exp) == INTEGER_CST)
+*************** bc_assemble_integer (exp, size)
+*** 3631,3639 ****
+ const_part = TREE_OPERAND (exp, 0);
+ while (TREE_CODE (const_part) == NOP_EXPR
+! || TREE_CODE (const_part) == CONVERT_EXPR)
+ const_part = TREE_OPERAND (const_part, 0);
+ addr_part = TREE_OPERAND (exp, 1);
+ while (TREE_CODE (addr_part) == NOP_EXPR
+! || TREE_CODE (addr_part) == CONVERT_EXPR)
+ addr_part = TREE_OPERAND (addr_part, 0);
+ if (TREE_CODE (const_part) != INTEGER_CST)
+--- 3636,3646 ----
+ const_part = TREE_OPERAND (exp, 0);
+ while (TREE_CODE (const_part) == NOP_EXPR
+! || TREE_CODE (const_part) == CONVERT_EXPR
+! || TREE_CODE (const_part) == NON_LVALUE_EXPR)
+ const_part = TREE_OPERAND (const_part, 0);
+ addr_part = TREE_OPERAND (exp, 1);
+ while (TREE_CODE (addr_part) == NOP_EXPR
+! || TREE_CODE (addr_part) == CONVERT_EXPR
+! || TREE_CODE (addr_part) == NON_LVALUE_EXPR)
+ addr_part = TREE_OPERAND (addr_part, 0);
+ if (TREE_CODE (const_part) != INTEGER_CST)
+diff -rcp2N gcc-2.7.2.2/version.c g77-new/version.c
+*** gcc-2.7.2.2/version.c Thu Feb 20 19:24:33 1997
+--- g77-new/version.c Sun Aug 10 19:28:55 1997
+***************
+*** 1 ****
+! char *version_string = "2.7.2.2";
+--- 1 ----
+! char *version_string = "2.7.2.2.f.3b";
diff --git a/gcc/f/gbe/README b/gcc/f/gbe/README
new file mode 100644
index 00000000000..f03069048da
--- /dev/null
+++ b/gcc/f/gbe/README
@@ -0,0 +1,45 @@
+970811
+
+This directory contains .diff files for various GNU CC distributions
+supported by this version of GNU Fortran.
+
+The name of a file includes which gcc version to which it applies.
+For example, 2.7.2.2.diff is the patch file for gcc version 2.7.2.2.
+
+To apply a .diff file to, say, gcc 2.7.2.2, one might use the following
+command (where the current directory contains the gcc source distribution
+after merging into it the g77 source distribution, which would be
+named gcc-2.7.2.2 in this example):
+
+ patch -p1 -d gcc-2.7.2.2 < gcc-2.7.2.2/f/gbe/2.7.2.2.diff
+
+
+This version of g77 is best combined with gcc versions 2.7.2.2.
+
+However, note that applying any of these patches does _not_ update
+the gcc.info* files that constitute the Info documentation for gcc.
+Therefore, after applying the patch, you must rebuild the Info
+documentation yourself via:
+
+ cd gcc; make -f Makefile.in gcc.info
+
+If the above command doesn't work because you don't have makeinfo
+installed, you are STRONGLY encouraged to obtain the most recent
+version of the GNU texinfo package (texinfo-3.11.tar.gz as of this
+writing), build, and install it, then try the above command (as
+makeinfo is part of texinfo).
+
+This distribution of g77 is not supported for versions of gcc prior
+to 2.7.2.2.
+
+If you are using a version of gcc more recent than the most
+recent .diff file's version, try the most recent .diff ONLY
+if the difference is in the third field. E.g. the above
+patch might work on gcc-2.7.3 or gcc-2.7.4 if these were
+released. On the other hand, it probably wouldn't work for
+a more major release like gcc-2.8.0 or gcc-3.0.0, and you
+shouldn't try it. If the .diff file is missing, don't bother
+asking <fortran@gnu.ai.mit.edu> for it -- it is certainly
+being worked on. In the meantime, watch our progress at
+<ftp://alpha.gnu.ai.mit.edu/g77.plan> for information on support
+for the recent versions of gcc.
diff --git a/gcc/f/glimits.j b/gcc/f/glimits.j
new file mode 100644
index 00000000000..9a30bdbfba1
--- /dev/null
+++ b/gcc/f/glimits.j
@@ -0,0 +1,28 @@
+/* glimits.j -- Wrapper for GCC's glimits.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#if !USE_HOST_LIMITS
+#include "glimits.h"
+#else
+#include <limits.h>
+#endif
+#endif
diff --git a/gcc/f/global.c b/gcc/f/global.c
new file mode 100644
index 00000000000..033448deaa4
--- /dev/null
+++ b/gcc/f/global.c
@@ -0,0 +1,1490 @@
+/* global.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+
+ Description:
+ Manages information kept across individual program units within a single
+ source file. This includes reporting errors when a name is defined
+ multiple times (for example, two program units named FOO) and when a
+ COMMON block is given initial data in more than one program unit.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "global.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "name.h"
+#include "symbol.h"
+#include "top.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+#if FFEGLOBAL_ENABLED
+static ffenameSpace ffeglobal_filewide_ = NULL;
+static char *ffeglobal_type_string_[] =
+{
+ [FFEGLOBAL_typeNONE] "??",
+ [FFEGLOBAL_typeMAIN] "main program",
+ [FFEGLOBAL_typeEXT] "external",
+ [FFEGLOBAL_typeSUBR] "subroutine",
+ [FFEGLOBAL_typeFUNC] "function",
+ [FFEGLOBAL_typeBDATA] "block data",
+ [FFEGLOBAL_typeCOMMON] "common block",
+ [FFEGLOBAL_typeANY] "?any?"
+};
+#endif
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* Call given fn with all globals
+
+ ffeglobal (*fn)(ffeglobal g);
+ ffeglobal_drive(fn); */
+
+#if FFEGLOBAL_ENABLED
+void
+ffeglobal_drive (ffeglobal (*fn) ())
+{
+ if (ffeglobal_filewide_ != NULL)
+ ffename_space_drive_global (ffeglobal_filewide_, fn);
+}
+
+#endif
+/* ffeglobal_new_ -- Make new global
+
+ ffename n;
+ ffeglobal g;
+ g = ffeglobal_new_(n); */
+
+#if FFEGLOBAL_ENABLED
+static ffeglobal
+ffeglobal_new_ (ffename n)
+{
+ ffeglobal g;
+
+ assert (n != NULL);
+
+ g = (ffeglobal) malloc_new_ks (malloc_pool_image (), "FFEGLOBAL",
+ sizeof (*g));
+ g->n = n;
+#ifdef FFECOM_globalHOOK
+ g->hook = FFECOM_globalNULL;
+#endif
+ g->tick = 0;
+
+ ffename_set_global (n, g);
+
+ return g;
+}
+
+#endif
+/* ffeglobal_init_1 -- Initialize per file
+
+ ffeglobal_init_1(); */
+
+void
+ffeglobal_init_1 ()
+{
+#if FFEGLOBAL_ENABLED
+ if (ffeglobal_filewide_ != NULL)
+ ffename_space_kill (ffeglobal_filewide_);
+ ffeglobal_filewide_ = ffename_space_new (malloc_pool_image ());
+#endif
+}
+
+/* ffeglobal_init_common -- Initial value specified for common block
+
+ ffesymbol s; // the ffesymbol for the common block
+ ffelexToken t; // the token with the point of initialization
+ ffeglobal_init_common(s,t);
+
+ For back ends where file-wide global symbols are not maintained, does
+ nothing. Otherwise, makes sure this common block hasn't already been
+ initialized in a previous program unit, and flag that it's been
+ initialized in this one. */
+
+void
+ffeglobal_init_common (ffesymbol s, ffelexToken t)
+{
+#if FFEGLOBAL_ENABLED
+ ffeglobal g;
+
+ g = ffesymbol_global (s);
+
+ if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
+ return;
+ if (g->type == FFEGLOBAL_typeANY)
+ return;
+
+ if (g->tick == ffe_count_2)
+ return;
+
+ if (g->tick != 0)
+ {
+ if (g->u.common.initt != NULL)
+ {
+ ffebad_start (FFEBAD_COMMON_ALREADY_INIT);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->u.common.initt),
+ ffelex_token_where_column (g->u.common.initt));
+ ffebad_finish ();
+ }
+
+ /* Complain about just one attempt to reinit per program unit, but
+ continue referring back to the first such successful attempt. */
+ }
+ else
+ {
+ if (g->u.common.blank)
+ {
+ ffebad_start (FFEBAD_COMMON_BLANK_INIT);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ g->u.common.initt = ffelex_token_use (t);
+ }
+
+ g->tick = ffe_count_2;
+#endif
+}
+
+/* ffeglobal_new_common -- New common block
+
+ ffesymbol s; // the ffesymbol for the new common block
+ ffelexToken t; // the token with the name of the common block
+ bool blank; // TRUE if blank common
+ ffeglobal_new_common(s,t,blank);
+
+ For back ends where file-wide global symbols are not maintained, does
+ nothing. Otherwise, makes sure this symbol hasn't been seen before or
+ is known as a common block. */
+
+void
+ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank)
+{
+#if FFEGLOBAL_ENABLED
+ ffename n;
+ ffeglobal g;
+
+ if (ffesymbol_global (s) == NULL)
+ {
+ n = ffename_find (ffeglobal_filewide_, t);
+ g = ffename_global (n);
+ }
+ else
+ {
+ g = ffesymbol_global (s);
+ n = NULL;
+ }
+
+ if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
+ return;
+
+ if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE))
+ {
+ if (g->type == FFEGLOBAL_typeCOMMON)
+ {
+ assert (g->u.common.blank == blank);
+ }
+ else
+ {
+ if (ffe_is_globals () || ffe_is_warn_globals ())
+ {
+ ffebad_start (ffe_is_globals ()
+ ? FFEBAD_FILEWIDE_ALREADY_SEEN
+ : FFEBAD_FILEWIDE_ALREADY_SEEN_W);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ g->type = FFEGLOBAL_typeANY;
+ }
+ }
+ else
+ {
+ if (g == NULL)
+ {
+ g = ffeglobal_new_ (n);
+ g->intrinsic = FALSE;
+ }
+ else if (g->intrinsic
+ && !g->explicit_intrinsic
+ && ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_string ("common block");
+ ffebad_string ("intrinsic");
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ g->t = ffelex_token_use (t);
+ g->type = FFEGLOBAL_typeCOMMON;
+ g->u.common.have_pad = FALSE;
+ g->u.common.have_save = FALSE;
+ g->u.common.have_size = FALSE;
+ g->u.common.blank = blank;
+ }
+
+ ffesymbol_set_global (s, g);
+#endif
+}
+
+/* ffeglobal_new_progunit_ -- New program unit
+
+ ffesymbol s; // the ffesymbol for the new unit
+ ffelexToken t; // the token with the name of the unit
+ ffeglobalType type; // the type of the new unit
+ ffeglobal_new_progunit_(s,t,type);
+
+ For back ends where file-wide global symbols are not maintained, does
+ nothing. Otherwise, makes sure this symbol hasn't been seen before. */
+
+void
+ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
+{
+#if FFEGLOBAL_ENABLED
+ ffename n;
+ ffeglobal g;
+
+ n = ffename_find (ffeglobal_filewide_, t);
+ g = ffename_global (n);
+ if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
+ return;
+
+ if ((g != NULL)
+ && (g->type != FFEGLOBAL_typeNONE)
+ && (g->type != FFEGLOBAL_typeEXT)
+ && ((g->type != type)
+ || (g->u.proc.defined)))
+ {
+ if (ffe_is_globals () || ffe_is_warn_globals ())
+ {
+ ffebad_start (ffe_is_globals ()
+ ? FFEBAD_FILEWIDE_ALREADY_SEEN
+ : FFEBAD_FILEWIDE_ALREADY_SEEN_W);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ g->type = FFEGLOBAL_typeANY;
+ }
+ else
+ {
+ if (g == NULL)
+ {
+ g = ffeglobal_new_ (n);
+ g->intrinsic = FALSE;
+ g->u.proc.n_args = -1;
+ g->u.proc.other_t = NULL;
+ }
+ else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+ && ((ffesymbol_basictype (s) != g->u.proc.bt)
+ || (ffesymbol_kindtype (s) != g->u.proc.kt)
+ || ((ffesymbol_size (s) != FFETARGET_charactersizeNONE)
+ && (ffesymbol_size (s) != g->u.proc.sz))))
+ {
+ if (ffe_is_globals () || ffe_is_warn_globals ())
+ {
+ ffebad_start (ffe_is_globals ()
+ ? FFEBAD_FILEWIDE_TYPE_MISMATCH
+ : FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ g->type = FFEGLOBAL_typeANY;
+ return;
+ }
+ if (g->intrinsic
+ && !g->explicit_intrinsic
+ && ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_string ("global");
+ ffebad_string ("intrinsic");
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ g->t = ffelex_token_use (t);
+ if ((g->tick == 0)
+ || (g->u.proc.bt == FFEINFO_basictypeNONE)
+ || (g->u.proc.kt == FFEINFO_kindtypeNONE))
+ {
+ g->u.proc.bt = ffesymbol_basictype (s);
+ g->u.proc.kt = ffesymbol_kindtype (s);
+ g->u.proc.sz = ffesymbol_size (s);
+ }
+ g->tick = ffe_count_2;
+ if ((g->tick != 0)
+ && (g->type != type))
+ g->u.proc.n_args = -1;
+ g->type = type;
+ g->u.proc.defined = TRUE;
+ }
+
+ ffesymbol_set_global (s, g);
+#endif
+}
+
+/* ffeglobal_pad_common -- Check initial padding of common area
+
+ ffesymbol s; // the common area
+ ffetargetAlign pad; // the initial padding
+ ffeglobal_pad_common(s,pad,ffesymbol_where_line(s),
+ ffesymbol_where_column(s));
+
+ In global-enabled mode, make sure the padding agrees with any existing
+ padding established for the common area, otherwise complain.
+ In global-disabled mode, warn about nonzero padding. */
+
+void
+ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
+ ffewhereColumn wc)
+{
+#if FFEGLOBAL_ENABLED
+ ffeglobal g;
+
+ g = ffesymbol_global (s);
+ if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
+ return; /* Let someone else catch this! */
+ if (g->type == FFEGLOBAL_typeANY)
+ return;
+
+ if (!g->u.common.have_pad)
+ {
+ g->u.common.have_pad = TRUE;
+ g->u.common.pad = pad;
+ g->u.common.pad_where_line = ffewhere_line_use (wl);
+ g->u.common.pad_where_col = ffewhere_column_use (wc);
+ }
+ else
+ {
+ if (g->u.common.pad != pad)
+ {
+ char padding_1[20];
+ char padding_2[20];
+
+ sprintf (&padding_1[0], "%" ffetargetAlign_f "u", pad);
+ sprintf (&padding_2[0], "%" ffetargetAlign_f "u", g->u.common.pad);
+ ffebad_start (FFEBAD_COMMON_DIFF_PAD);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string (padding_1);
+ ffebad_here (0, wl, wc);
+ ffebad_string (padding_2);
+ ffebad_string ((pad == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_string ((g->u.common.pad == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_here (1, g->u.common.pad_where_line, g->u.common.pad_where_col);
+ ffebad_finish ();
+ }
+ }
+#endif
+
+ if (pad != 0)
+ { /* Warn about initial padding in common area. */
+ char padding[20];
+
+ sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
+ ffebad_start (FFEBAD_COMMON_INIT_PAD);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string (padding);
+ ffebad_string ((pad == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_here (0, wl, wc);
+ ffebad_finish ();
+ }
+}
+
+/* Collect info for a global's argument. */
+
+void
+ffeglobal_proc_def_arg (ffesymbol s, int argno, char *name, ffeglobalArgSummary as,
+ ffeinfoBasictype bt, ffeinfoKindtype kt,
+ bool array)
+{
+ ffeglobal g = ffesymbol_global (s);
+ ffeglobalArgInfo_ ai;
+
+ assert (g != NULL);
+
+ if (g->type == FFEGLOBAL_typeANY)
+ return;
+
+ assert (g->u.proc.n_args >= 0);
+
+ if (argno >= g->u.proc.n_args)
+ return; /* Already complained about this discrepancy. */
+
+ ai = &g->u.proc.arg_info[argno];
+
+ /* Maybe warn about previous references. */
+
+ if ((ai->t != NULL)
+ && ffe_is_warn_globals ())
+ {
+ char *refwhy = NULL;
+ char *defwhy = NULL;
+ bool warn = FALSE;
+
+ switch (as)
+ {
+ case FFEGLOBAL_argsummaryREF:
+ if ((ai->as != FFEGLOBAL_argsummaryREF)
+ && (ai->as != FFEGLOBAL_argsummaryNONE)
+ && ((ai->as != FFEGLOBAL_argsummaryDESCR) /* Choose better message. */
+ || (ai->bt != FFEINFO_basictypeCHARACTER)
+ || (ai->bt == bt)))
+ {
+ warn = TRUE;
+ refwhy = "passed by reference";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryDESCR:
+ if ((ai->as != FFEGLOBAL_argsummaryDESCR)
+ && (ai->as != FFEGLOBAL_argsummaryNONE)
+ && ((ai->as != FFEGLOBAL_argsummaryREF) /* Choose better message. */
+ || (bt != FFEINFO_basictypeCHARACTER)
+ || (ai->bt == bt)))
+ {
+ warn = TRUE;
+ refwhy = "passed by descriptor";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryPROC:
+ if ((ai->as != FFEGLOBAL_argsummaryPROC)
+ && (ai->as != FFEGLOBAL_argsummarySUBR)
+ && (ai->as != FFEGLOBAL_argsummaryFUNC)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ warn = TRUE;
+ refwhy = "a procedure";
+ }
+ break;
+
+ case FFEGLOBAL_argsummarySUBR:
+ if ((ai->as != FFEGLOBAL_argsummaryPROC)
+ && (ai->as != FFEGLOBAL_argsummarySUBR)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ warn = TRUE;
+ refwhy = "a subroutine";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryFUNC:
+ if ((ai->as != FFEGLOBAL_argsummaryPROC)
+ && (ai->as != FFEGLOBAL_argsummaryFUNC)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ warn = TRUE;
+ refwhy = "a function";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryALTRTN:
+ if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ warn = TRUE;
+ refwhy = "an alternate-return label";
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if ((refwhy != NULL) && (defwhy == NULL))
+ {
+ /* Fill in the def info. */
+
+ switch (ai->as)
+ {
+ case FFEGLOBAL_argsummaryNONE:
+ defwhy = "omitted";
+ break;
+
+ case FFEGLOBAL_argsummaryVAL:
+ defwhy = "passed by value";
+ break;
+
+ case FFEGLOBAL_argsummaryREF:
+ defwhy = "passed by reference";
+ break;
+
+ case FFEGLOBAL_argsummaryDESCR:
+ defwhy = "passed by descriptor";
+ break;
+
+ case FFEGLOBAL_argsummaryPROC:
+ defwhy = "a procedure";
+ break;
+
+ case FFEGLOBAL_argsummarySUBR:
+ defwhy = "a subroutine";
+ break;
+
+ case FFEGLOBAL_argsummaryFUNC:
+ defwhy = "a function";
+ break;
+
+ case FFEGLOBAL_argsummaryALTRTN:
+ defwhy = "an alternate-return label";
+ break;
+
+ case FFEGLOBAL_argsummaryPTR:
+ defwhy = "a pointer";
+ break;
+
+ default:
+ defwhy = "???";
+ break;
+ }
+ }
+
+ if (!warn
+ && (bt != FFEINFO_basictypeHOLLERITH)
+ && (bt != FFEINFO_basictypeTYPELESS)
+ && (bt != FFEINFO_basictypeNONE)
+ && (ai->bt != FFEINFO_basictypeHOLLERITH)
+ && (ai->bt != FFEINFO_basictypeTYPELESS)
+ && (ai->bt != FFEINFO_basictypeNONE))
+ {
+ /* Check types. */
+
+ if ((bt != ai->bt)
+ && ((bt != FFEINFO_basictypeREAL)
+ || (ai->bt != FFEINFO_basictypeCOMPLEX))
+ && ((bt != FFEINFO_basictypeCOMPLEX)
+ || (ai->bt != FFEINFO_basictypeREAL)))
+ {
+ warn = TRUE; /* We can cope with these differences. */
+ refwhy = "one type";
+ defwhy = "some other type";
+ }
+
+ if (!warn && (kt != ai->kt))
+ {
+ warn = TRUE;
+ refwhy = "one precision";
+ defwhy = "some other precision";
+ }
+ }
+
+ if (warn)
+ {
+ char num[60];
+
+ if (name == NULL)
+ sprintf (&num[0], "%d", argno + 1);
+ else
+ {
+ if (strlen (name) < 30)
+ sprintf (&num[0], "%d (named `%s')", argno + 1, name);
+ else
+ sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, name);
+ }
+ ffebad_start (FFEBAD_FILEWIDE_ARG_W);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string (num);
+ ffebad_string (refwhy);
+ ffebad_string (defwhy);
+ ffebad_here (0, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t));
+ ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
+ ffebad_finish ();
+ }
+ }
+
+ /* Define this argument. */
+
+ if (ai->t != NULL)
+ ffelex_token_kill (ai->t);
+ if ((as != FFEGLOBAL_argsummaryPROC)
+ || (ai->t == NULL))
+ ai->as = as; /* Otherwise leave SUBR/FUNC info intact. */
+ ai->t = ffelex_token_use (g->t);
+ if (name == NULL)
+ ai->name = NULL;
+ else
+ {
+ ai->name = malloc_new_ks (malloc_pool_image (),
+ "ffeglobalArgInfo_ name",
+ strlen (name) + 1);
+ strcpy (ai->name, name);
+ }
+ ai->bt = bt;
+ ai->kt = kt;
+ ai->array = array;
+}
+
+/* Collect info on #args a global accepts. */
+
+void
+ffeglobal_proc_def_nargs (ffesymbol s, int n_args)
+{
+ ffeglobal g = ffesymbol_global (s);
+
+ assert (g != NULL);
+
+ if (g->type == FFEGLOBAL_typeANY)
+ return;
+
+ if (g->u.proc.n_args >= 0)
+ {
+ if (g->u.proc.n_args == n_args)
+ return;
+
+ if (ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
+ ffebad_string (ffesymbol_text (s));
+ if (g->u.proc.n_args > n_args)
+ ffebad_string ("few");
+ else
+ ffebad_string ("many");
+ ffebad_here (0, ffelex_token_where_line (g->u.proc.other_t),
+ ffelex_token_where_column (g->u.proc.other_t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ }
+
+ /* This is new info we can use in cross-checking future references
+ and a possible future definition. */
+
+ g->u.proc.n_args = n_args;
+ g->u.proc.other_t = NULL; /* No other reference yet. */
+
+ if (n_args == 0)
+ {
+ g->u.proc.arg_info = NULL;
+ return;
+ }
+
+ g->u.proc.arg_info
+ = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (),
+ "ffeglobalArgInfo_",
+ n_args * sizeof (g->u.proc.arg_info[0]));
+ while (n_args-- > 0)
+ g->u.proc.arg_info[n_args].t = NULL;
+}
+
+/* Verify that the info for a global's argument is valid. */
+
+bool
+ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
+ ffeinfoBasictype bt, ffeinfoKindtype kt,
+ bool array, ffelexToken t)
+{
+ ffeglobal g = ffesymbol_global (s);
+ ffeglobalArgInfo_ ai;
+
+ assert (g != NULL);
+
+ if (g->type == FFEGLOBAL_typeANY)
+ return FALSE;
+
+ assert (g->u.proc.n_args >= 0);
+
+ if (argno >= g->u.proc.n_args)
+ return TRUE; /* Already complained about this discrepancy. */
+
+ ai = &g->u.proc.arg_info[argno];
+
+ /* Warn about previous references. */
+
+ if (ai->t != NULL)
+ {
+ char *refwhy = NULL;
+ char *defwhy = NULL;
+ bool fail = FALSE;
+ bool warn = FALSE;
+
+ switch (as)
+ {
+ case FFEGLOBAL_argsummaryNONE:
+ if (g->u.proc.defined)
+ {
+ fail = TRUE;
+ refwhy = "omitted";
+ defwhy = "not optional";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryVAL:
+ if (ai->as != FFEGLOBAL_argsummaryVAL)
+ {
+ fail = TRUE;
+ refwhy = "passed by value";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryREF:
+ if ((ai->as != FFEGLOBAL_argsummaryREF)
+ && (ai->as != FFEGLOBAL_argsummaryNONE)
+ && ((ai->as != FFEGLOBAL_argsummaryDESCR) /* Choose better message. */
+ || (ai->bt != FFEINFO_basictypeCHARACTER)
+ || (ai->bt == bt)))
+ {
+ fail = TRUE;
+ refwhy = "passed by reference";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryDESCR:
+ if ((ai->as != FFEGLOBAL_argsummaryDESCR)
+ && (ai->as != FFEGLOBAL_argsummaryNONE)
+ && ((ai->as != FFEGLOBAL_argsummaryREF) /* Choose better message. */
+ || (bt != FFEINFO_basictypeCHARACTER)
+ || (ai->bt == bt)))
+ {
+ fail = TRUE;
+ refwhy = "passed by descriptor";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryPROC:
+ if ((ai->as != FFEGLOBAL_argsummaryPROC)
+ && (ai->as != FFEGLOBAL_argsummarySUBR)
+ && (ai->as != FFEGLOBAL_argsummaryFUNC)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ fail = TRUE;
+ refwhy = "a procedure";
+ }
+ break;
+
+ case FFEGLOBAL_argsummarySUBR:
+ if ((ai->as != FFEGLOBAL_argsummaryPROC)
+ && (ai->as != FFEGLOBAL_argsummarySUBR)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ fail = TRUE;
+ refwhy = "a subroutine";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryFUNC:
+ if ((ai->as != FFEGLOBAL_argsummaryPROC)
+ && (ai->as != FFEGLOBAL_argsummaryFUNC)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ fail = TRUE;
+ refwhy = "a function";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryALTRTN:
+ if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ fail = TRUE;
+ refwhy = "an alternate-return label";
+ }
+ break;
+
+ case FFEGLOBAL_argsummaryPTR:
+ if ((ai->as != FFEGLOBAL_argsummaryPTR)
+ && (ai->as != FFEGLOBAL_argsummaryNONE))
+ {
+ fail = TRUE;
+ refwhy = "a pointer";
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if ((refwhy != NULL) && (defwhy == NULL))
+ {
+ /* Fill in the def info. */
+
+ switch (ai->as)
+ {
+ case FFEGLOBAL_argsummaryNONE:
+ defwhy = "omitted";
+ break;
+
+ case FFEGLOBAL_argsummaryVAL:
+ defwhy = "passed by value";
+ break;
+
+ case FFEGLOBAL_argsummaryREF:
+ defwhy = "passed by reference";
+ break;
+
+ case FFEGLOBAL_argsummaryDESCR:
+ defwhy = "passed by descriptor";
+ break;
+
+ case FFEGLOBAL_argsummaryPROC:
+ defwhy = "a procedure";
+ break;
+
+ case FFEGLOBAL_argsummarySUBR:
+ defwhy = "a subroutine";
+ break;
+
+ case FFEGLOBAL_argsummaryFUNC:
+ defwhy = "a function";
+ break;
+
+ case FFEGLOBAL_argsummaryALTRTN:
+ defwhy = "an alternate-return label";
+ break;
+
+ case FFEGLOBAL_argsummaryPTR:
+ defwhy = "a pointer";
+ break;
+
+ default:
+ defwhy = "???";
+ break;
+ }
+ }
+
+ if (!fail && !warn
+ && (bt != FFEINFO_basictypeHOLLERITH)
+ && (bt != FFEINFO_basictypeTYPELESS)
+ && (bt != FFEINFO_basictypeNONE)
+ && (ai->bt != FFEINFO_basictypeHOLLERITH)
+ && (ai->bt != FFEINFO_basictypeNONE)
+ && (ai->bt != FFEINFO_basictypeTYPELESS))
+ {
+ /* Check types. */
+
+ if ((bt != ai->bt)
+ && ((bt != FFEINFO_basictypeREAL)
+ || (ai->bt != FFEINFO_basictypeCOMPLEX))
+ && ((bt != FFEINFO_basictypeCOMPLEX)
+ || (ai->bt != FFEINFO_basictypeREAL)))
+ {
+ if (((bt == FFEINFO_basictypeINTEGER)
+ && (ai->bt == FFEINFO_basictypeLOGICAL))
+ || ((bt == FFEINFO_basictypeLOGICAL)
+ && (ai->bt == FFEINFO_basictypeINTEGER)))
+ warn = TRUE; /* We can cope with these differences. */
+ else
+ fail = TRUE;
+ refwhy = "one type";
+ defwhy = "some other type";
+ }
+
+ if (!fail && !warn && (kt != ai->kt))
+ {
+ fail = TRUE;
+ refwhy = "one precision";
+ defwhy = "some other precision";
+ }
+ }
+
+ if (fail && ! g->u.proc.defined)
+ {
+ /* No point failing if we're worried only about invocations. */
+ fail = FALSE;
+ warn = TRUE;
+ }
+
+ if (fail && ! ffe_is_globals ())
+ {
+ warn = TRUE;
+ fail = FALSE;
+ }
+
+ if (fail || (warn && ffe_is_warn_globals ()))
+ {
+ char num[60];
+
+ if (ai->name == NULL)
+ sprintf (&num[0], "%d", argno + 1);
+ else
+ {
+ if (strlen (ai->name) < 30)
+ sprintf (&num[0], "%d (named `%s')", argno + 1, ai->name);
+ else
+ sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, ai->name);
+ }
+ ffebad_start (fail ? FFEBAD_FILEWIDE_ARG : FFEBAD_FILEWIDE_ARG_W);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string (num);
+ ffebad_string (refwhy);
+ ffebad_string (defwhy);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
+ ffebad_finish ();
+ return (fail ? FALSE : TRUE);
+ }
+
+ if (warn)
+ return TRUE;
+ }
+
+ /* Define this argument. */
+
+ if (ai->t != NULL)
+ ffelex_token_kill (ai->t);
+ if ((as != FFEGLOBAL_argsummaryPROC)
+ || (ai->t == NULL))
+ ai->as = as;
+ ai->t = ffelex_token_use (g->t);
+ ai->name = NULL;
+ ai->bt = bt;
+ ai->kt = kt;
+ ai->array = array;
+ return TRUE;
+}
+
+bool
+ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t)
+{
+ ffeglobal g = ffesymbol_global (s);
+
+ assert (g != NULL);
+
+ if (g->type == FFEGLOBAL_typeANY)
+ return FALSE;
+
+ if (g->u.proc.n_args >= 0)
+ {
+ if (g->u.proc.n_args == n_args)
+ return TRUE;
+
+ if (g->u.proc.defined && ffe_is_globals ())
+ {
+ ffebad_start (FFEBAD_FILEWIDE_NARGS);
+ ffebad_string (ffesymbol_text (s));
+ if (g->u.proc.n_args > n_args)
+ ffebad_string ("few");
+ else
+ ffebad_string ("many");
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ return FALSE;
+ }
+
+ if (ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
+ ffebad_string (ffesymbol_text (s));
+ if (g->u.proc.n_args > n_args)
+ ffebad_string ("few");
+ else
+ ffebad_string ("many");
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+
+ return TRUE; /* Don't replace the info we already have. */
+ }
+
+ /* This is new info we can use in cross-checking future references
+ and a possible future definition. */
+
+ g->u.proc.n_args = n_args;
+ g->u.proc.other_t = ffelex_token_use (t);
+
+ /* Make this "the" place we found the global, since it has the most info. */
+
+ if (g->t != NULL)
+ ffelex_token_kill (g->t);
+ g->t = ffelex_token_use (t);
+
+ if (n_args == 0)
+ {
+ g->u.proc.arg_info = NULL;
+ return TRUE;
+ }
+
+ g->u.proc.arg_info
+ = (ffeglobalArgInfo_) malloc_new_ks (malloc_pool_image (),
+ "ffeglobalArgInfo_",
+ n_args * sizeof (g->u.proc.arg_info[0]));
+ while (n_args-- > 0)
+ g->u.proc.arg_info[n_args].t = NULL;
+
+ return TRUE;
+}
+
+/* Return a global for a promoted symbol (one that has heretofore
+ been assumed to be local, but since discovered to be global). */
+
+ffeglobal
+ffeglobal_promoted (ffesymbol s)
+{
+#if FFEGLOBAL_ENABLED
+ ffename n;
+ ffeglobal g;
+
+ assert (ffesymbol_global (s) == NULL);
+
+ n = ffename_find (ffeglobal_filewide_, ffename_token (ffesymbol_name (s)));
+ g = ffename_global (n);
+
+ return g;
+#else
+ return NULL;
+#endif
+}
+
+/* Register a reference to an intrinsic. Such a reference is always
+ valid, though a warning might be in order if the same name has
+ already been used for a global. */
+
+void
+ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit)
+{
+#if FFEGLOBAL_ENABLED
+ ffename n;
+ ffeglobal g;
+
+ if (ffesymbol_global (s) == NULL)
+ {
+ n = ffename_find (ffeglobal_filewide_, t);
+ g = ffename_global (n);
+ }
+ else
+ {
+ g = ffesymbol_global (s);
+ n = NULL;
+ }
+
+ if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
+ return;
+
+ if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE))
+ {
+ if (! explicit
+ && ! g->intrinsic
+ && ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_string ("intrinsic");
+ ffebad_string ("global");
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if (g == NULL)
+ {
+ g = ffeglobal_new_ (n);
+ g->tick = ffe_count_2;
+ g->type = FFEGLOBAL_typeNONE;
+ g->intrinsic = TRUE;
+ g->explicit_intrinsic = explicit;
+ g->t = ffelex_token_use (t);
+ }
+ else if (g->intrinsic
+ && (explicit != g->explicit_intrinsic)
+ && (g->tick != ffe_count_2)
+ && ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_INTRINSIC_EXPIMP);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_string (explicit ? "explicit" : "implicit");
+ ffebad_string (explicit ? "implicit" : "explicit");
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ }
+
+ g->intrinsic = TRUE;
+ if (explicit)
+ g->explicit_intrinsic = TRUE;
+
+ ffesymbol_set_global (s, g);
+#endif
+}
+
+/* Register a reference to a global. Returns TRUE if the reference
+ is valid. */
+
+bool
+ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
+{
+#if FFEGLOBAL_ENABLED
+ ffename n = NULL;
+ ffeglobal g;
+
+ g = ffesymbol_global (s);
+ if (g == NULL)
+ {
+ n = ffename_find (ffeglobal_filewide_, t);
+ g = ffename_global (n);
+ if (g != NULL)
+ ffesymbol_set_global (s, g);
+ }
+
+ if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
+ return TRUE;
+
+ if ((g != NULL)
+ && (g->type != FFEGLOBAL_typeNONE)
+ && (g->type != type)
+ && (g->type != FFEGLOBAL_typeEXT)
+ && (type != FFEGLOBAL_typeEXT))
+ {
+ if ((((type == FFEGLOBAL_typeBDATA)
+ && (g->type != FFEGLOBAL_typeCOMMON))
+ || ((g->type == FFEGLOBAL_typeBDATA)
+ && (type != FFEGLOBAL_typeCOMMON)
+ && ! g->u.proc.defined)))
+ {
+#if 0 /* This is likely to just annoy people. */
+ if (ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_FILEWIDE_TIFF);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_string (ffeglobal_type_string_[type]);
+ ffebad_string (ffeglobal_type_string_[g->type]);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+#endif
+ /* It is never really _known_ that an EXTERNAL statement
+ names a BLOCK DATA by just looking at the program unit,
+ so don't override a different notion. */
+ if (type == FFEGLOBAL_typeBDATA)
+ type = FFEGLOBAL_typeEXT;
+ }
+ else if (ffe_is_globals ())
+ {
+ ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_string (ffeglobal_type_string_[type]);
+ ffebad_string (ffeglobal_type_string_[g->type]);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ g->type = FFEGLOBAL_typeANY;
+ return FALSE;
+ }
+ else if (ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_FILEWIDE_DISAGREEMENT_W);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_string (ffeglobal_type_string_[type]);
+ ffebad_string (ffeglobal_type_string_[g->type]);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ g->type = FFEGLOBAL_typeANY;
+ return TRUE;
+ }
+ }
+
+ if ((g != NULL)
+ && (type == FFEGLOBAL_typeFUNC))
+ {
+ /* If just filling in this function's type, do so. */
+ if ((g->tick == ffe_count_2)
+ && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+ && (ffesymbol_kindtype (s) != FFEINFO_kindtypeNONE))
+ {
+ g->u.proc.bt = ffesymbol_basictype (s);
+ g->u.proc.kt = ffesymbol_kindtype (s);
+ g->u.proc.sz = ffesymbol_size (s);
+ }
+ /* Else, make sure there is type agreement. */
+ else if ((g->u.proc.bt != FFEINFO_basictypeNONE)
+ && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+ && ((ffesymbol_basictype (s) != g->u.proc.bt)
+ || (ffesymbol_kindtype (s) != g->u.proc.kt)
+ || ((ffesymbol_size (s) != g->u.proc.sz)
+ && (g->u.proc.sz != FFETARGET_charactersizeNONE))))
+ {
+ if (ffe_is_globals ())
+ {
+ ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ g->type = FFEGLOBAL_typeANY;
+ return FALSE;
+ }
+ if (ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+ g->type = FFEGLOBAL_typeANY;
+ return TRUE;
+ }
+ }
+
+ if (g == NULL)
+ {
+ g = ffeglobal_new_ (n);
+ g->t = ffelex_token_use (t);
+ g->tick = ffe_count_2;
+ g->intrinsic = FALSE;
+ g->type = type;
+ g->u.proc.defined = FALSE;
+ g->u.proc.bt = ffesymbol_basictype (s);
+ g->u.proc.kt = ffesymbol_kindtype (s);
+ g->u.proc.sz = ffesymbol_size (s);
+ g->u.proc.n_args = -1;
+ ffesymbol_set_global (s, g);
+ }
+ else if (g->intrinsic
+ && !g->explicit_intrinsic
+ && (g->tick != ffe_count_2)
+ && ffe_is_warn_globals ())
+ {
+ ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
+ ffebad_string (ffelex_token_text (t));
+ ffebad_string ("global");
+ ffebad_string ("intrinsic");
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_here (1, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_finish ();
+ }
+
+ if ((g->type != type)
+ && (type != FFEGLOBAL_typeEXT))
+ {
+ /* We've learned more, so point to where we learned it. */
+ g->t = ffelex_token_use (t);
+ g->type = type;
+ g->u.proc.n_args = -1;
+ }
+
+ return TRUE;
+#endif
+}
+
+/* ffeglobal_save_common -- Check SAVE status of common area
+
+ ffesymbol s; // the common area
+ bool save; // TRUE if SAVEd, FALSE otherwise
+ ffeglobal_save_common(s,save,ffesymbol_where_line(s),
+ ffesymbol_where_column(s));
+
+ In global-enabled mode, make sure the save info agrees with any existing
+ info established for the common area, otherwise complain.
+ In global-disabled mode, do nothing. */
+
+void
+ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
+ ffewhereColumn wc)
+{
+#if FFEGLOBAL_ENABLED
+ ffeglobal g;
+
+ g = ffesymbol_global (s);
+ if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
+ return; /* Let someone else catch this! */
+ if (g->type == FFEGLOBAL_typeANY)
+ return;
+
+ if (!g->u.common.have_save)
+ {
+ g->u.common.have_save = TRUE;
+ g->u.common.save = save;
+ g->u.common.save_where_line = ffewhere_line_use (wl);
+ g->u.common.save_where_col = ffewhere_column_use (wc);
+ }
+ else
+ {
+ if ((g->u.common.save != save) && ffe_is_pedantic ())
+ {
+ ffebad_start (FFEBAD_COMMON_DIFF_SAVE);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_here (save ? 0 : 1, wl, wc);
+ ffebad_here (save ? 1 : 0, g->u.common.pad_where_line, g->u.common.pad_where_col);
+ ffebad_finish ();
+ }
+ }
+#endif
+}
+
+/* ffeglobal_size_common -- Establish size of COMMON area
+
+ ffesymbol s; // the common area
+ long size; // size in units
+ if (ffeglobal_size_common(s,size)) // new size is largest seen
+
+ In global-enabled mode, set the size if it current size isn't known or is
+ smaller than new size, and for non-blank common, complain if old size
+ is different from new. Return TRUE if the new size is the largest seen
+ for this COMMON area (or if no size was known for it previously).
+ In global-disabled mode, do nothing. */
+
+#if FFEGLOBAL_ENABLED
+bool
+ffeglobal_size_common (ffesymbol s, long size)
+{
+ ffeglobal g;
+
+ g = ffesymbol_global (s);
+ if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
+ return FALSE;
+ if (g->type == FFEGLOBAL_typeANY)
+ return FALSE;
+
+ if (!g->u.common.have_size)
+ {
+ g->u.common.have_size = TRUE;
+ g->u.common.size = size;
+ return TRUE;
+ }
+
+ if ((g->u.common.size < size) && (g->tick > 0) && (g->tick < ffe_count_2))
+ {
+ char oldsize[40];
+ char newsize[40];
+
+ sprintf (&oldsize[0], "%ld", g->u.common.size);
+ sprintf (&newsize[0], "%ld", size);
+
+ ffebad_start (FFEBAD_COMMON_ENLARGED);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string (oldsize);
+ ffebad_string (newsize);
+ ffebad_string ((g->u.common.size == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_string ((size == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_here (0, ffelex_token_where_line (g->u.common.initt),
+ ffelex_token_where_column (g->u.common.initt));
+ ffebad_here (1, ffesymbol_where_line (s),
+ ffesymbol_where_column (s));
+ ffebad_finish ();
+ }
+ else if ((g->u.common.size != size) && !g->u.common.blank)
+ {
+ char oldsize[40];
+ char newsize[40];
+
+ /* Warn about this even if not -pedantic, because putting all
+ program units in a single source file is the only way to
+ detect this. Apparently UNIX-model linkers neither handle
+ nor report when they make a common unit smaller than
+ requested, such as when the smaller-declared version is
+ initialized and the larger-declared version is not. So
+ if people complain about strange overwriting, we can tell
+ them to put all their code in a single file and compile
+ that way. Warnings about differing sizes must therefore
+ always be issued. */
+
+ sprintf (&oldsize[0], "%ld", g->u.common.size);
+ sprintf (&newsize[0], "%ld", size);
+
+ ffebad_start (FFEBAD_COMMON_DIFF_SIZE);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string (oldsize);
+ ffebad_string (newsize);
+ ffebad_string ((g->u.common.size == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_string ((size == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_here (0, ffelex_token_where_line (g->t),
+ ffelex_token_where_column (g->t));
+ ffebad_here (1, ffesymbol_where_line (s),
+ ffesymbol_where_column (s));
+ ffebad_finish ();
+ }
+
+ if (size > g->u.common.size)
+ {
+ g->u.common.size = size;
+ return TRUE;
+ }
+ return FALSE;
+}
+
+#endif
+void
+ffeglobal_terminate_1 ()
+{
+}
diff --git a/gcc/f/global.h b/gcc/f/global.h
new file mode 100644
index 00000000000..fe0be038d21
--- /dev/null
+++ b/gcc/f/global.h
@@ -0,0 +1,201 @@
+/* global.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ global.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_global
+#define _H_f_global
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFEGLOBAL_typeNONE,
+ FFEGLOBAL_typeMAIN,
+ FFEGLOBAL_typeEXT, /* EXTERNAL is all we know. */
+ FFEGLOBAL_typeSUBR,
+ FFEGLOBAL_typeFUNC,
+ FFEGLOBAL_typeBDATA,
+ FFEGLOBAL_typeCOMMON,
+ FFEGLOBAL_typeANY, /* Confusion reigns, so just ignore. */
+ FFEGLOBAL_type
+ } ffeglobalType;
+
+typedef enum
+ {
+ FFEGLOBAL_argsummaryNONE, /* No arg present. */
+ FFEGLOBAL_argsummaryVAL, /* Pass-by-value. */
+ FFEGLOBAL_argsummaryREF, /* Pass-by-reference. */
+ FFEGLOBAL_argsummaryDESCR, /* Pass-by-descriptor. */
+ FFEGLOBAL_argsummaryPROC, /* Procedure (intrinsic, external). */
+ FFEGLOBAL_argsummarySUBR, /* Subroutine (intrinsic, external). */
+ FFEGLOBAL_argsummaryFUNC, /* Function (intrinsic, external). */
+ FFEGLOBAL_argsummaryALTRTN, /* Alternate-return (label). */
+ FFEGLOBAL_argsummaryPTR, /* Pointer (%LOC, LOC()). */
+ FFEGLOBAL_argsummaryANY,
+ FFEGLOBAL_argsummary
+ } ffeglobalArgSummary;
+
+/* Typedefs. */
+
+typedef struct _ffeglobal_arginfo_ *ffeglobalArgInfo_;
+typedef struct _ffeglobal_ *ffeglobal;
+
+/* Include files needed by this one. */
+
+#include "info.h"
+#include "lex.h"
+#include "name.h"
+#include "symbol.h"
+#include "target.h"
+#include "top.h"
+
+/* Structure definitions. */
+
+struct _ffeglobal_arginfo_
+{
+ ffelexToken t; /* Different from master token when difference is important. */
+ char *name; /* Name of dummy arg, or NULL if not yet known. */
+ ffeglobalArgSummary as;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ bool array;
+};
+
+struct _ffeglobal_
+{
+ ffelexToken t;
+ ffename n;
+#ifdef FFECOM_globalHOOK
+ ffecomGlobal hook;
+#endif
+ ffeCounter tick; /* Recent transition in this progunit. */
+ ffeglobalType type;
+ bool intrinsic; /* Known as intrinsic? */
+ bool explicit_intrinsic; /* Explicit intrinsic? */
+ union {
+ struct {
+ ffelexToken initt; /* First initial value. */
+ bool have_pad; /* Padding info avail for COMMON? */
+ ffetargetAlign pad; /* Initial padding for COMMON. */
+ ffewhereLine pad_where_line;
+ ffewhereColumn pad_where_col;
+ bool have_save; /* Save info avail for COMMON? */
+ bool save; /* Save info for COMMON. */
+ ffewhereLine save_where_line;
+ ffewhereColumn save_where_col;
+ bool have_size; /* Size info avail for COMMON? */
+ long size; /* Size info for COMMON. */
+ bool blank; /* TRUE if blank COMMON. */
+ } common;
+ struct {
+ bool defined; /* Seen actual code yet? */
+ ffeinfoBasictype bt; /* NONE for non-function. */
+ ffeinfoKindtype kt; /* NONE for non-function. */
+ ffetargetCharacterSize sz;
+ int n_args; /* 0 for main/blockdata. */
+ ffelexToken other_t; /* Location of reference. */
+ ffeglobalArgInfo_ arg_info; /* Info on each argument. */
+ } proc;
+ } u;
+};
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffeglobal_drive (ffeglobal (*fn) ());
+void ffeglobal_init_1 (void);
+void ffeglobal_init_common (ffesymbol s, ffelexToken t);
+void ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
+void ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank);
+void ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
+ ffewhereColumn wc);
+void ffeglobal_proc_def_arg (ffesymbol s, int argno, char *name, ffeglobalArgSummary as,
+ ffeinfoBasictype bt, ffeinfoKindtype kt,
+ bool array);
+void ffeglobal_proc_def_nargs (ffesymbol s, int n_args);
+bool ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
+ ffeinfoBasictype bt, ffeinfoKindtype kt,
+ bool array, ffelexToken t);
+bool ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t);
+ffeglobal ffeglobal_promoted (ffesymbol s);
+void ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit);
+bool ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
+void ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
+ ffewhereColumn wc);
+bool ffeglobal_size_common (ffesymbol s, long size);
+void ffeglobal_terminate_1 (void);
+
+/* Define macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#define FFEGLOBAL_ENABLED 0
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#define FFEGLOBAL_ENABLED 1
+#else
+#error
+#endif
+
+#define ffeglobal_common_init(g) ((g)->tick != 0)
+#define ffeglobal_common_have_pad(g) ((g)->u.common.have_pad)
+#define ffeglobal_common_have_size(g) ((g)->u.common.have_size)
+#define ffeglobal_common_size(g) ((g)->u.common.size)
+#define ffeglobal_hook(g) ((g)->hook)
+#define ffeglobal_init_0()
+#define ffeglobal_init_2()
+#define ffeglobal_init_3()
+#define ffeglobal_init_4()
+#define ffeglobal_new_blockdata(s,t) \
+ ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeBDATA)
+#define ffeglobal_new_function(s,t) \
+ ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeFUNC)
+#define ffeglobal_new_program(s,t) \
+ ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeMAIN)
+#define ffeglobal_new_subroutine(s,t) \
+ ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeSUBR)
+#define ffeglobal_pad(g) ((g)->pad)
+#define ffeglobal_ref_blockdata(s,t) \
+ ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeBDATA)
+#define ffeglobal_ref_external(s,t) \
+ ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeEXT)
+#define ffeglobal_ref_function(s,t) \
+ ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeFUNC)
+#define ffeglobal_ref_subroutine(s,t) \
+ ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeSUBR)
+#define ffeglobal_set_hook(g,h) ((g)->hook = (h))
+#define ffeglobal_terminate_0()
+#define ffeglobal_terminate_2()
+#define ffeglobal_terminate_3()
+#define ffeglobal_terminate_4()
+#define ffeglobal_text(g) ffename_text((g)->n)
+#define ffeglobal_type(g) ((g)->type)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/hconfig.j b/gcc/f/hconfig.j
new file mode 100644
index 00000000000..b777b68b92d
--- /dev/null
+++ b/gcc/f/hconfig.j
@@ -0,0 +1,27 @@
+/* hconfig.j -- Wrapper for GCC's hconfig.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_hconfig
+#define _J_f_hconfig
+#include "hconfig.h"
+#endif
+#endif
diff --git a/gcc/f/implic.c b/gcc/f/implic.c
new file mode 100644
index 00000000000..292f88f7410
--- /dev/null
+++ b/gcc/f/implic.c
@@ -0,0 +1,383 @@
+/* implic.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None.
+
+ Description:
+ The GNU Fortran Front End.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "implic.h"
+#include "info.h"
+#include "src.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFEIMPLIC_stateINITIAL_,
+ FFEIMPLIC_stateASSUMED_,
+ FFEIMPLIC_stateESTABLISHED_,
+ FFEIMPLIC_state
+ } ffeimplicState_;
+
+/* Internal typedefs. */
+
+typedef struct _ffeimplic_ *ffeimplic_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffeimplic_
+ {
+ ffeimplicState_ state;
+ ffeinfo info;
+ };
+
+/* Static objects accessed by functions in this module. */
+
+/* NOTE: This is definitely ASCII-specific!! */
+
+static struct _ffeimplic_ ffeimplic_table_['z' - 'A' + 1];
+
+/* Static functions (internal). */
+
+static ffeimplic_ ffeimplic_lookup_ (char c);
+
+/* Internal macros. */
+
+
+/* ffeimplic_lookup_ -- Look up implicit descriptor for initial character
+
+ ffeimplic_ imp;
+ if ((imp = ffeimplic_lookup_('A')) == NULL)
+ // error
+
+ Returns a pointer to an implicit descriptor block based on the character
+ passed, or NULL if it is not a valid initial character for an implicit
+ data type. */
+
+static ffeimplic_
+ffeimplic_lookup_ (char c)
+{
+ /* NOTE: This is definitely ASCII-specific!! */
+ if (isalpha (c) || (c == '_'))
+ return &ffeimplic_table_[c - 'A'];
+ return NULL;
+}
+
+/* ffeimplic_establish_initial -- Establish type of implicit initial letter
+
+ ffesymbol s;
+ if (!ffeimplic_establish_initial(s))
+ // error
+
+ Assigns implicit type information to the symbol based on the first
+ character of the symbol's name. */
+
+bool
+ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type,
+ ffeinfoKindtype kind_type, ffetargetCharacterSize size)
+{
+ ffeimplic_ imp;
+
+ imp = ffeimplic_lookup_ (c);
+ if (imp == NULL)
+ return FALSE; /* Character not A-Z or some such thing. */
+ if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE)
+ return FALSE; /* IMPLICIT NONE in effect here. */
+
+ switch (imp->state)
+ {
+ case FFEIMPLIC_stateINITIAL_:
+ imp->info = ffeinfo_new (basic_type,
+ kind_type,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ size);
+ imp->state = FFEIMPLIC_stateESTABLISHED_;
+ return TRUE;
+
+ case FFEIMPLIC_stateASSUMED_:
+ if ((ffeinfo_basictype (imp->info) != basic_type)
+ || (ffeinfo_kindtype (imp->info) != kind_type)
+ || (ffeinfo_size (imp->info) != size))
+ return FALSE;
+ imp->state = FFEIMPLIC_stateESTABLISHED_;
+ return TRUE;
+
+ case FFEIMPLIC_stateESTABLISHED_:
+ return FALSE;
+
+ default:
+ assert ("Weird state for implicit object" == NULL);
+ return FALSE;
+ }
+}
+
+/* ffeimplic_establish_symbol -- Establish implicit type of a symbol
+
+ ffesymbol s;
+ if (!ffeimplic_establish_symbol(s))
+ // error
+
+ Assigns implicit type information to the symbol based on the first
+ character of the symbol's name.
+
+ If symbol already has a type, return TRUE.
+ Get first character of symbol's name.
+ Get ffeimplic_ object for it (return FALSE if NULL returned).
+ Return FALSE if object has no assigned type (IMPLICIT NONE).
+ Copy the type information from the object to the symbol.
+ If the object is state "INITIAL", set to state "ASSUMED" so no
+ subsequent IMPLICIT statement may change the state.
+ Return TRUE. */
+
+bool
+ffeimplic_establish_symbol (ffesymbol s)
+{
+ char c;
+ ffeimplic_ imp;
+
+ if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+ return TRUE;
+
+ c = *(ffesymbol_text (s));
+ imp = ffeimplic_lookup_ (c);
+ if (imp == NULL)
+ return FALSE; /* First character not A-Z or some such
+ thing. */
+ if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE)
+ return FALSE; /* IMPLICIT NONE in effect here. */
+
+ ffesymbol_signal_change (s); /* Gonna change, save existing? */
+
+ /* Establish basictype, kindtype, size; preserve rank, kind, where. */
+
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffeinfo_basictype (imp->info),
+ ffeinfo_kindtype (imp->info),
+ ffesymbol_rank (s),
+ ffesymbol_kind (s),
+ ffesymbol_where (s),
+ ffeinfo_size (imp->info)));
+
+ if (imp->state == FFEIMPLIC_stateINITIAL_)
+ imp->state = FFEIMPLIC_stateASSUMED_;
+
+ if (ffe_is_warn_implicit ())
+ {
+ ffebad_start_msg ("Implicit declaration of `%A' at %0",
+ FFEBAD_severityWARNING);
+ ffebad_here (0, ffesymbol_where_line (s),
+ ffesymbol_where_column (s));
+ ffebad_string (ffesymbol_text (s));
+ ffebad_finish ();
+ }
+
+ return TRUE;
+}
+
+/* ffeimplic_init_2 -- Initialize table
+
+ ffeimplic_init_2();
+
+ Assigns initial type information to all initial letters.
+
+ Allows for holes in the sequence of letters (i.e. EBCDIC). */
+
+void
+ffeimplic_init_2 ()
+{
+ ffeimplic_ imp;
+ char c;
+
+ for (c = 'A'; c <= 'z'; ++c)
+ {
+ imp = &ffeimplic_table_[c - 'A'];
+ imp->state = FFEIMPLIC_stateINITIAL_;
+ switch (c)
+ {
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ case 'G':
+ case 'H':
+ case 'O':
+ case 'P':
+ case 'Q':
+ case 'R':
+ case 'S':
+ case 'T':
+ case 'U':
+ case 'V':
+ case 'W':
+ case 'X':
+ case 'Y':
+ case 'Z':
+ case '_':
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ case 'g':
+ case 'h':
+ case 'o':
+ case 'p':
+ case 'q':
+ case 'r':
+ case 's':
+ case 't':
+ case 'u':
+ case 'v':
+ case 'w':
+ case 'x':
+ case 'y':
+ case 'z':
+ imp->info = ffeinfo_new (FFEINFO_basictypeREAL,
+ FFEINFO_kindtypeREALDEFAULT,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ FFETARGET_charactersizeNONE);
+ break;
+
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'L':
+ case 'M':
+ case 'N':
+ case 'i':
+ case 'j':
+ case 'k':
+ case 'l':
+ case 'm':
+ case 'n':
+ imp->info = ffeinfo_new (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0, FFEINFO_kindNONE, FFEINFO_whereNONE,
+ FFETARGET_charactersizeNONE);
+ break;
+
+ default:
+ imp->info = ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0,
+ FFEINFO_kindNONE, FFEINFO_whereNONE, FFETARGET_charactersizeNONE);
+ break;
+ }
+ }
+}
+
+/* ffeimplic_none -- Implement IMPLICIT NONE statement
+
+ ffeimplic_none();
+
+ Assigns null type information to all initial letters. */
+
+void
+ffeimplic_none ()
+{
+ ffeimplic_ imp;
+
+ for (imp = &ffeimplic_table_[0];
+ imp != &ffeimplic_table_[ARRAY_SIZE (ffeimplic_table_)];
+ imp++)
+ {
+ imp->info = ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ FFETARGET_charactersizeNONE);
+ }
+}
+
+/* ffeimplic_peek_symbol_type -- Determine implicit type of a symbol
+
+ ffesymbol s;
+ char *name; // name for s in case it is NULL, or NULL if s never NULL
+ if (ffeimplic_peek_symbol_type(s,name) == FFEINFO_basictypeCHARACTER)
+ // is or will be a CHARACTER-typed name
+
+ Like establish_symbol, but doesn't change anything.
+
+ If symbol is non-NULL and already has a type, return it.
+ Get first character of symbol's name or from name arg if symbol is NULL.
+ Get ffeimplic_ object for it (return FALSE if NULL returned).
+ Return NONE if object has no assigned type (IMPLICIT NONE).
+ Return the data type indicated in the object.
+
+ 24-Oct-91 JCB 2.0
+ Take a char * instead of ffelexToken, since the latter isn't always
+ needed anyway (as when ffecom calls it). */
+
+ffeinfoBasictype
+ffeimplic_peek_symbol_type (ffesymbol s, char *name)
+{
+ char c;
+ ffeimplic_ imp;
+
+ if (s == NULL)
+ c = *name;
+ else
+ {
+ if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+ return ffesymbol_basictype (s);
+
+ c = *(ffesymbol_text (s));
+ }
+
+ imp = ffeimplic_lookup_ (c);
+ if (imp == NULL)
+ return FFEINFO_basictypeNONE; /* First character not A-Z or
+ something. */
+ return ffeinfo_basictype (imp->info);
+}
+
+/* ffeimplic_terminate_2 -- Terminate table
+
+ ffeimplic_terminate_2();
+
+ Kills info object for each entry in table. */
+
+void
+ffeimplic_terminate_2 ()
+{
+}
diff --git a/gcc/f/implic.h b/gcc/f/implic.h
new file mode 100644
index 00000000000..2c03ab2cde1
--- /dev/null
+++ b/gcc/f/implic.h
@@ -0,0 +1,74 @@
+/* implic.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ implic.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_implic
+#define _H_f_implic
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "info.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+bool ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type,
+ ffeinfoKindtype kind_type, ffetargetCharacterSize size);
+bool ffeimplic_establish_symbol (ffesymbol s);
+void ffeimplic_init_2 (void);
+void ffeimplic_none (void);
+ffeinfoBasictype ffeimplic_peek_symbol_type (ffesymbol s, char *name);
+void ffeimplic_terminate_2 (void);
+
+/* Define macros. */
+
+#define ffeimplic_init_0()
+#define ffeimplic_init_1()
+#define ffeimplic_init_3()
+#define ffeimplic_init_4()
+#define ffeimplic_terminate_0()
+#define ffeimplic_terminate_1()
+#define ffeimplic_terminate_3()
+#define ffeimplic_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/info-b.def b/gcc/f/info-b.def
new file mode 100644
index 00000000000..0084f7afc99
--- /dev/null
+++ b/gcc/f/info-b.def
@@ -0,0 +1,36 @@
+/* info-b.def -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ info.c
+
+ Modifications:
+*/
+
+FFEINFO_BASICTYPE (FFEINFO_basictypeNONE, "None", "")
+FFEINFO_BASICTYPE (FFEINFO_basictypeINTEGER, "INTEGER", "i")
+FFEINFO_BASICTYPE (FFEINFO_basictypeLOGICAL, "LOGICAL", "l")
+FFEINFO_BASICTYPE (FFEINFO_basictypeREAL, "REAL", "r")
+FFEINFO_BASICTYPE (FFEINFO_basictypeCOMPLEX, "COMPLEX", "c")
+FFEINFO_BASICTYPE (FFEINFO_basictypeCHARACTER, "CHARACTER", "a")
+FFEINFO_BASICTYPE (FFEINFO_basictypeHOLLERITH, "Hollerith", "h")
+FFEINFO_BASICTYPE (FFEINFO_basictypeTYPELESS, "Typeless", "t")
+FFEINFO_BASICTYPE (FFEINFO_basictypeANY, "Any", "~")
diff --git a/gcc/f/info-k.def b/gcc/f/info-k.def
new file mode 100644
index 00000000000..46e32b27e50
--- /dev/null
+++ b/gcc/f/info-k.def
@@ -0,0 +1,37 @@
+/* info-k.def -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ info.c
+
+ Modifications:
+*/
+
+FFEINFO_KIND (FFEINFO_kindNONE, "an unknown kind", "")
+FFEINFO_KIND (FFEINFO_kindENTITY, "an entity", "e")
+FFEINFO_KIND (FFEINFO_kindFUNCTION, "a function", "f")
+FFEINFO_KIND (FFEINFO_kindSUBROUTINE, "a subroutine", "u")
+FFEINFO_KIND (FFEINFO_kindPROGRAM, "a program", "p")
+FFEINFO_KIND (FFEINFO_kindBLOCKDATA, "a block-data unit", "b")
+FFEINFO_KIND (FFEINFO_kindCOMMON, "a common block", "c")
+FFEINFO_KIND (FFEINFO_kindCONSTRUCT, "a construct", ":")
+FFEINFO_KIND (FFEINFO_kindNAMELIST, "a namelist", "n")
+FFEINFO_KIND (FFEINFO_kindANY, "anything", "~")
diff --git a/gcc/f/info-w.def b/gcc/f/info-w.def
new file mode 100644
index 00000000000..14e8a583a68
--- /dev/null
+++ b/gcc/f/info-w.def
@@ -0,0 +1,41 @@
+/* info-w.def -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ info.c
+
+ Modifications:
+*/
+
+FFEINFO_WHERE (FFEINFO_whereNONE, "None", "")
+FFEINFO_WHERE (FFEINFO_whereLOCAL, "Local", "l") /* Defined locally. */
+FFEINFO_WHERE (FFEINFO_whereCOMMON, "Common", "c") /* In a common area. */
+FFEINFO_WHERE (FFEINFO_whereDUMMY, "Dummy", "d") /* A dummy argument. */
+FFEINFO_WHERE (FFEINFO_whereGLOBAL, "Global", "g") /* Reference to external global like FUNCTION, SUBR. */
+FFEINFO_WHERE (FFEINFO_whereRESULT, "Result", "r") /* Result of this function. */
+FFEINFO_WHERE (FFEINFO_whereFLEETING, "Fleeting", "f") /* Result of "X*Y", "FUNCREF(5,1.3)", "ARRAY(X)", etc. */
+FFEINFO_WHERE (FFEINFO_whereFLEETING_CADDR, "Fleet-Const", "fp") /* "A(3)", "CHARS(4:5)". */
+FFEINFO_WHERE (FFEINFO_whereFLEETING_IADDR, "Fleet-Immed", "fi") /* A(IX) in "DATA (A(IX),IX=1,100)/.../". */
+FFEINFO_WHERE (FFEINFO_whereIMMEDIATE, "Immediate", "i") /* IX in "DATA (A(IX),IX=1,100)/.../". */
+FFEINFO_WHERE (FFEINFO_whereINTRINSIC, "Intrinsic", "b")
+FFEINFO_WHERE (FFEINFO_whereCONSTANT, "Constant", "p") /* For kindFUNCTION, means statement function! */
+FFEINFO_WHERE (FFEINFO_whereCONSTANT_SUBOBJECT, "Const-subobj", "q") /* As in "'FOO'(I:J)". */
+FFEINFO_WHERE (FFEINFO_whereANY, "Any", "~")
diff --git a/gcc/f/info.c b/gcc/f/info.c
new file mode 100644
index 00000000000..7c1ca9b0155
--- /dev/null
+++ b/gcc/f/info.c
@@ -0,0 +1,305 @@
+/* info.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ An abstraction for information maintained on a per-operator and per-
+ operand basis in expression trees.
+
+ Modifications:
+ 30-Aug-90 JCB 2.0
+ Extensive rewrite for new cleaner approach.
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "info.h"
+#include "target.h"
+#include "type.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+static char *ffeinfo_basictype_string_[]
+=
+{
+#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
+#include "info-b.def"
+#undef FFEINFO_BASICTYPE
+};
+static char *ffeinfo_kind_message_[]
+=
+{
+#define FFEINFO_KIND(KWD,LNAM,SNAM) LNAM,
+#include "info-k.def"
+#undef FFEINFO_KIND
+};
+static char *ffeinfo_kind_string_[]
+=
+{
+#define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM,
+#include "info-k.def"
+#undef FFEINFO_KIND
+};
+static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype];
+static char *ffeinfo_kindtype_string_[]
+=
+{
+ "",
+ "1",
+ "2",
+ "3",
+ "4",
+ "5",
+ "6",
+ "7",
+ "8",
+ "*",
+};
+static char *ffeinfo_where_string_[]
+=
+{
+#define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM,
+#include "info-w.def"
+#undef FFEINFO_WHERE
+};
+static ffetype ffeinfo_types_[FFEINFO_basictype][FFEINFO_kindtype]
+ = { { NULL } };
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffeinfo_basictype_combine -- Combine two basictypes into highest rank type
+
+ ffeinfoBasictype i, j, k;
+ k = ffeinfo_basictype_combine(i,j);
+
+ Returns a type based on "standard" operation between two given types. */
+
+ffeinfoBasictype
+ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r)
+{
+ assert (l < FFEINFO_basictype);
+ assert (r < FFEINFO_basictype);
+ return ffeinfo_combine_[l][r];
+}
+
+/* ffeinfo_basictype_string -- Return tiny string showing the basictype
+
+ ffeinfoBasictype i;
+ printf("%s",ffeinfo_basictype_string(dt));
+
+ Returns the string based on the basic type. */
+
+char *
+ffeinfo_basictype_string (ffeinfoBasictype basictype)
+{
+ if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_))
+ return "?\?\?";
+ return ffeinfo_basictype_string_[basictype];
+}
+
+/* ffeinfo_init_0 -- Initialize
+
+ ffeinfo_init_0(); */
+
+void
+ffeinfo_init_0 ()
+{
+ ffeinfoBasictype i;
+ ffeinfoBasictype j;
+
+ assert (FFEINFO_basictype == ARRAY_SIZE (ffeinfo_basictype_string_));
+ assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_message_));
+ assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_string_));
+ assert (FFEINFO_kindtype == ARRAY_SIZE (ffeinfo_kindtype_string_));
+ assert (FFEINFO_where == ARRAY_SIZE (ffeinfo_where_string_));
+
+ /* Make array that, given two basic types, produces resulting basic type. */
+
+ for (i = 0; i < FFEINFO_basictype; ++i)
+ for (j = 0; j < FFEINFO_basictype; ++j)
+ if ((i == FFEINFO_basictypeANY) || (j == FFEINFO_basictypeANY))
+ ffeinfo_combine_[i][j] = FFEINFO_basictypeANY;
+ else
+ ffeinfo_combine_[i][j] = FFEINFO_basictypeNONE;
+
+#define same(bt) ffeinfo_combine_[bt][bt] = bt
+#define use2(bt1,bt2) ffeinfo_combine_[bt1][bt2] \
+ = ffeinfo_combine_[bt2][bt1] = bt2
+
+ same (FFEINFO_basictypeINTEGER);
+ same (FFEINFO_basictypeLOGICAL);
+ same (FFEINFO_basictypeREAL);
+ same (FFEINFO_basictypeCOMPLEX);
+ same (FFEINFO_basictypeCHARACTER);
+ use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeREAL);
+ use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeCOMPLEX);
+ use2 (FFEINFO_basictypeREAL, FFEINFO_basictypeCOMPLEX);
+
+#undef same
+#undef use2
+}
+
+/* ffeinfo_kind_message -- Return helpful string showing the kind
+
+ ffeinfoKind kind;
+ printf("%s",ffeinfo_kind_message(kind));
+
+ Returns the string based on the kind. */
+
+char *
+ffeinfo_kind_message (ffeinfoKind kind)
+{
+ if (kind >= ARRAY_SIZE (ffeinfo_kind_message_))
+ return "?\?\?";
+ return ffeinfo_kind_message_[kind];
+}
+
+/* ffeinfo_kind_string -- Return tiny string showing the kind
+
+ ffeinfoKind kind;
+ printf("%s",ffeinfo_kind_string(kind));
+
+ Returns the string based on the kind. */
+
+char *
+ffeinfo_kind_string (ffeinfoKind kind)
+{
+ if (kind >= ARRAY_SIZE (ffeinfo_kind_string_))
+ return "?\?\?";
+ return ffeinfo_kind_string_[kind];
+}
+
+ffeinfoKindtype
+ffeinfo_kindtype_max(ffeinfoBasictype bt,
+ ffeinfoKindtype k1,
+ ffeinfoKindtype k2)
+{
+ if ((bt == FFEINFO_basictypeANY)
+ || (k1 == FFEINFO_kindtypeANY)
+ || (k2 == FFEINFO_kindtypeANY))
+ return FFEINFO_kindtypeANY;
+
+ if (ffetype_size (ffeinfo_types_[bt][k1])
+ > ffetype_size (ffeinfo_types_[bt][k2]))
+ return k1;
+ return k2;
+}
+
+/* ffeinfo_kindtype_string -- Return tiny string showing the kind type
+
+ ffeinfoKindtype kind_type;
+ printf("%s",ffeinfo_kindtype_string(kind));
+
+ Returns the string based on the kind type. */
+
+char *
+ffeinfo_kindtype_string (ffeinfoKindtype kind_type)
+{
+ if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_))
+ return "?\?\?";
+ return ffeinfo_kindtype_string_[kind_type];
+}
+
+void
+ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
+ ffetype type)
+{
+ assert (basictype < FFEINFO_basictype);
+ assert (kindtype < FFEINFO_kindtype);
+ assert (ffeinfo_types_[basictype][kindtype] == NULL);
+
+ ffeinfo_types_[basictype][kindtype] = type;
+}
+
+ffetype
+ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype)
+{
+ assert (basictype < FFEINFO_basictype);
+ assert (kindtype < FFEINFO_kindtype);
+ assert (ffeinfo_types_[basictype][kindtype] != NULL);
+
+ return ffeinfo_types_[basictype][kindtype];
+}
+
+/* ffeinfo_where_string -- Return tiny string showing the where
+
+ ffeinfoWhere where;
+ printf("%s",ffeinfo_where_string(where));
+
+ Returns the string based on the where. */
+
+char *
+ffeinfo_where_string (ffeinfoWhere where)
+{
+ if (where >= ARRAY_SIZE (ffeinfo_where_string_))
+ return "?\?\?";
+ return ffeinfo_where_string_[where];
+}
+
+/* ffeinfo_new -- Return object representing datatype, kind, and where info
+
+ ffeinfo i;
+ i = ffeinfo_new(FFEINFO_datatypeINTEGER,FFEINFO_kindSCALAR,
+ FFEINFO_whereLOCAL);
+
+ Returns the string based on the data type. */
+
+#ifndef __GNUC__
+ffeinfo
+ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
+ ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
+ ffetargetCharacterSize size)
+{
+ ffeinfo i;
+
+ i.basictype = basictype;
+ i.kindtype = kindtype;
+ i.rank = rank;
+ i.size = size;
+ i.kind = kind;
+ i.where = where;
+ i.size = size;
+
+ return i;
+}
+#endif
diff --git a/gcc/f/info.h b/gcc/f/info.h
new file mode 100644
index 00000000000..33f1aa9e61e
--- /dev/null
+++ b/gcc/f/info.h
@@ -0,0 +1,186 @@
+/* info.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ info.c
+
+ Modifications:
+ 30-Aug-90 JCB 2.0
+ Extensive rewrite for new cleaner approach.
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_info
+#define _H_f_info
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) KWD,
+#include "info-b.def"
+#undef FFEINFO_BASICTYPE
+ FFEINFO_basictype
+ } ffeinfoBasictype;
+
+typedef enum
+ { /* If these kindtypes aren't in size order,
+ change _kindtype_max. */
+ FFEINFO_kindtypeNONE,
+ FFEINFO_kindtypeINTEGER1,
+ FFEINFO_kindtypeINTEGER2,
+ FFEINFO_kindtypeINTEGER3,
+ FFEINFO_kindtypeINTEGER4,
+ FFEINFO_kindtypeINTEGER5,
+ FFEINFO_kindtypeINTEGER6,
+ FFEINFO_kindtypeINTEGER7,
+ FFEINFO_kindtypeINTEGER8,
+ FFEINFO_kindtypeLOGICAL1 = 1, /* Ok to omit, but ok to overlap. */
+ FFEINFO_kindtypeLOGICAL2,
+ FFEINFO_kindtypeLOGICAL3,
+ FFEINFO_kindtypeLOGICAL4,
+ FFEINFO_kindtypeLOGICAL5,
+ FFEINFO_kindtypeLOGICAL6,
+ FFEINFO_kindtypeLOGICAL7,
+ FFEINFO_kindtypeLOGICAL8,
+ FFEINFO_kindtypeREAL1 = 1, /* Ok to omit, but ok to overlap. */
+ FFEINFO_kindtypeREAL2,
+ FFEINFO_kindtypeREAL3,
+ FFEINFO_kindtypeREAL4,
+ FFEINFO_kindtypeREAL5,
+ FFEINFO_kindtypeREAL6,
+ FFEINFO_kindtypeREAL7,
+ FFEINFO_kindtypeREAL8,
+ FFEINFO_kindtypeCHARACTER1 = 1, /* Ok to omit, but ok to overlap. */
+ FFEINFO_kindtypeCHARACTER2,
+ FFEINFO_kindtypeCHARACTER3,
+ FFEINFO_kindtypeCHARACTER4,
+ FFEINFO_kindtypeCHARACTER5,
+ FFEINFO_kindtypeCHARACTER6,
+ FFEINFO_kindtypeCHARACTER7,
+ FFEINFO_kindtypeCHARACTER8,
+ FFEINFO_kindtypeANY,
+ FFEINFO_kindtype
+ } ffeinfoKindtype;
+
+typedef enum
+ {
+#define FFEINFO_KIND(KWD,LNAM,SNAM) KWD,
+#include "info-k.def"
+#undef FFEINFO_KIND
+ FFEINFO_kind
+ } ffeinfoKind;
+
+typedef enum
+ {
+#define FFEINFO_WHERE(KWD,LNAM,SNAM) KWD,
+#include "info-w.def"
+#undef FFEINFO_WHERE
+ FFEINFO_where
+ } ffeinfoWhere;
+
+/* Typedefs. */
+
+typedef struct _ffeinfo_ ffeinfo;
+typedef char ffeinfoRank;
+
+/* Include files needed by this one. */
+
+#include "target.h"
+#include "type.h"
+
+/* Structure definitions. */
+
+struct _ffeinfo_
+ {
+ ffeinfoBasictype basictype;
+ ffeinfoKindtype kindtype;
+ ffeinfoRank rank;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ ffetargetCharacterSize size;
+ };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+ffeinfoBasictype ffeinfo_basictype_combine (ffeinfoBasictype l,
+ ffeinfoBasictype r);
+char *ffeinfo_basictype_string (ffeinfoBasictype basictype);
+void ffeinfo_init_0 (void);
+char *ffeinfo_kind_message (ffeinfoKind kind);
+char *ffeinfo_kind_string (ffeinfoKind kind);
+ffeinfoKindtype ffeinfo_kindtype_max(ffeinfoBasictype bt,
+ ffeinfoKindtype k1,
+ ffeinfoKindtype k2);
+char *ffeinfo_kindtype_string (ffeinfoKindtype kind_type);
+char *ffeinfo_where_string (ffeinfoWhere where);
+ffeinfo ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
+ ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
+ ffetargetCharacterSize size);
+void ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
+ ffetype type);
+ffetype ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype);
+
+/* Define macros. */
+
+#define ffeinfo_basictype(i) (i.basictype)
+#define ffeinfo_init_1()
+#define ffeinfo_init_2()
+#define ffeinfo_init_3()
+#define ffeinfo_init_4()
+#define ffeinfo_kind(i) (i.kind)
+#define ffeinfo_kindtype(i) (i.kindtype)
+#ifdef __GNUC__
+#define ffeinfo_new(bt,kt,r,k,w,sz) \
+ ((ffeinfo) {(bt), (kt), (r), (k), (w), (sz)})
+#endif
+#define ffeinfo_new_any() \
+ ffeinfo_new (FFEINFO_basictypeANY, FFEINFO_kindtypeANY, 0, \
+ FFEINFO_kindANY, FFEINFO_whereANY, \
+ FFETARGET_charactersizeNONE)
+#define ffeinfo_new_null() \
+ ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, \
+ FFEINFO_kindNONE, FFEINFO_whereNONE, \
+ FFETARGET_charactersizeNONE)
+#define ffeinfo_rank(i) (i.rank)
+#define ffeinfo_size(i) (i.size)
+#define ffeinfo_terminate_0()
+#define ffeinfo_terminate_1()
+#define ffeinfo_terminate_2()
+#define ffeinfo_terminate_3()
+#define ffeinfo_terminate_4()
+#define ffeinfo_use(i) i
+#define ffeinfo_where(i) (i.where)
+
+#define FFEINFO_kindtypeINTEGERDEFAULT FFEINFO_kindtypeINTEGER1
+#define FFEINFO_kindtypeLOGICALDEFAULT FFEINFO_kindtypeLOGICAL1
+#define FFEINFO_kindtypeREALDEFAULT FFEINFO_kindtypeREAL1
+#define FFEINFO_kindtypeREALDOUBLE FFEINFO_kindtypeREAL2
+#define FFEINFO_kindtypeREALQUAD FFEINFO_kindtypeREAL3
+#define FFEINFO_kindtypeCHARACTERDEFAULT FFEINFO_kindtypeCHARACTER1
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/input.j b/gcc/f/input.j
new file mode 100644
index 00000000000..c7ec5b690ff
--- /dev/null
+++ b/gcc/f/input.j
@@ -0,0 +1,27 @@
+/* input.j -- Wrapper for GCC's input.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_input
+#define _J_f_input
+#include "input.h"
+#endif
+#endif
diff --git a/gcc/f/install.texi b/gcc/f/install.texi
new file mode 100644
index 00000000000..f6f403ddfdd
--- /dev/null
+++ b/gcc/f/install.texi
@@ -0,0 +1,2036 @@
+@c Copyright (C) 1995-1997 Free Software Foundation, Inc.
+@c This is part of the G77 manual.
+@c For copying conditions, see the file g77.texi.
+
+@c The text of this file appears in the file INSTALL
+@c in the G77 distribution, as well as in the G77 manual.
+
+@c 1997-08-11
+
+@ifclear INSTALLONLY
+@node Installation
+@chapter Installing GNU Fortran
+@end ifclear
+@cindex installing GNU Fortran
+
+The following information describes how to install @code{g77}.
+
+The information in this file generally pertains to dealing
+with @emph{source} distributions of @code{g77} and @code{gcc}.
+It is possible that some of this information will be applicable
+to some @emph{binary} distributions of these products---however,
+since these distributions are not made by the maintainers of
+@code{g77}, responsibility for binary distributions rests with
+whoever built and first distributed them.
+
+Nevertheless, efforts to make @code{g77} easier to both build
+and install from source and package up as a binary distribution
+are ongoing.
+
+@menu
+* Prerequisites:: Make sure your system is ready for @code{g77}.
+* Problems Installing:: Known trouble areas.
+* Settings:: Changing @code{g77} internals before building.
+* Quick Start:: The easier procedure for non-experts.
+* Complete Installation:: For experts, or those who want to be: the details.
+* Distributing Binaries:: If you plan on distributing your @code{g77}.
+@end menu
+
+@node Prerequisites
+@section Prerequisites
+@cindex prerequisites
+
+The procedures described to unpack, configure, build, and
+install @code{g77} assume your system has certain programs
+already installed.
+
+The following prerequisites should be met by your
+system before you follow the @code{g77} installation instructions:
+
+@table @asis
+@item @code{gzip}
+To unpack the @code{gcc} and @code{g77} distributions,
+you'll need the @code{gunzip} utility in the @code{gzip}
+distribution.
+Most UNIX systems already have @code{gzip} installed.
+If yours doesn't, you can get it from the FSF.
+
+Note that you'll need @code{tar} and other utilities
+as well, but all UNIX systems have these.
+There are GNU versions of all these available---in fact,
+a complete GNU UNIX system can be put together on
+most systems, if desired.
+
+@item @file{gcc-2.7.2.2.tar.gz}
+You need to have this, or some other applicable, version
+of @code{gcc} on your system.
+The version should be an exact copy of a distribution
+from the FSF.
+It is approximately 7MB large.
+
+If you've already unpacked @file{gcc-2.7.2.2.tar.gz} into a
+directory (named @file{gcc-2.7.2.2}) called the @dfn{source tree}
+for @code{gcc}, you can delete the distribution
+itself, but you'll need to remember to skip any instructions to unpack
+this distribution.
+
+Without an applicable @code{gcc} source tree, you cannot
+build @code{g77}.
+You can obtain an FSF distribution of @code{gcc} from the FSF.
+
+@item @file{g77-0.5.21.tar.gz}
+You probably have already unpacked this distribution,
+or you are reading an advanced copy of this manual,
+which is contained in this distribution.
+This distribution approximately 1MB large.
+
+You can obtain an FSF distribution of @code{g77} from the FSF,
+the same way you obtained @code{gcc}.
+
+@item 100MB disk space
+For a complete @dfn{bootstrap} build, about 100MB
+of disk space is required for @code{g77} by the author's
+current GNU/Linux system.
+
+Some juggling can reduce the amount of space needed;
+during the bootstrap process, once Stage 3 starts,
+during which the version of @code{gcc} that has been copied
+into the @file{stage2/} directory is used to rebuild the
+system, you can delete the @file{stage1/} directory
+to free up some space.
+
+It is likely that many systems don't require the complete
+bootstrap build, as they already have a recent version of
+@code{gcc} installed.
+Such systems might be able to build @code{g77} with only
+about 75MB of free space.
+
+@item @code{patch}
+Although you can do everything @code{patch} does yourself,
+by hand, without much trouble, having @code{patch} installed
+makes installation of new versions of GNU utilities such as
+@code{g77} so much easier that it is worth getting.
+You can obtain @code{patch} the same way you obtained
+@code{gcc} and @code{g77}.
+
+In any case, you can apply patches by hand---patch files
+are designed for humans to read them.
+
+@item @code{make}
+Your system must have @code{make}, and you will probably save
+yourself a lot of trouble if it is GNU @code{make} (sometimes
+referred to as @code{gmake}).
+
+@item @code{cc}
+Your system must have a working C compiler.
+
+@xref{Installation,,Installing GNU CC,gcc,Using and Porting GNU CC},
+for more information on prerequisites for installing @code{gcc}.
+
+@item @code{bison}
+If you do not have @code{bison} installed, you can usually
+work around any need for it, since @code{g77} itself does
+not use it, and @code{gcc} normally includes all files
+generated by running it in its distribution.
+You can obtain @code{bison} the same way you obtained
+@code{gcc} and @code{g77}.
+
+@xref{Missing bison?},
+for information on how to work around not having @code{bison}.
+
+@item @code{makeinfo}
+If you are missing @code{makeinfo}, you can usually work
+around any need for it.
+You can obtain @code{makeinfo} the same way you obtained
+@code{gcc} and @code{g77}.
+
+@xref{Missing makeinfo?},
+for information on getting around the lack of @code{makeinfo}.
+
+@item @code{root} access
+To perform the complete installation procedures on a system,
+you need to have @code{root} access to that system, or
+equivalent access.
+
+Portions of the procedure (such as configuring and building
+@code{g77}) can be performed by any user with enough disk
+space and virtual memory.
+
+However, these instructions are oriented towards less-experienced
+users who want to install @code{g77} on their own personal
+systems.
+
+System administrators with more experience will want to
+determine for themselves how they want to modify the
+procedures described below to suit the needs of their
+installation.
+@end table
+
+@node Problems Installing
+@section Problems Installing
+@cindex problems installing
+@cindex installation problems
+
+This is a list of problems (and some apparent problems which don't
+really mean anything is wrong) that show up when configuring,
+building, installing, or porting GNU Fortran.
+
+@xref{Installation Problems,,,gcc,Using and Porting GNU CC},
+for more information on installation problems that can afflict
+either @code{gcc} or @code{g77}.
+
+@menu
+* General Problems:: Problems afflicting most or all systems.
+* Cross-compiler Problems:: Problems afflicting cross-compilation setups.
+@end menu
+
+@node General Problems
+@subsection General Problems
+
+These problems can occur on most or all systems.
+
+@menu
+* GNU C Required:: Why even ANSI C is not enough.
+* Patching GNU CC Necessary:: Why @code{gcc} must be patched first.
+* Building GNU CC Necessary:: Why you can't build @emph{just} Fortran.
+* Missing strtoul:: If linking @code{f771} fails due to an
+ unresolved reference to @code{strtoul}.
+* Object File Differences:: It's okay that @samp{make compare} will
+ flag @file{f/zzz.o}.
+* Cleanup Kills Stage Directories:: A minor nit for @code{g77} developers.
+* Missing gperf?:: When building requires @code{gperf}.
+@end menu
+
+@node GNU C Required
+@subsubsection GNU C Required
+@cindex GNU C required
+@cindex requirements, GNU C
+
+Compiling @code{g77} requires GNU C, not just ANSI C.
+Fixing this wouldn't
+be very hard (just tedious), but the code using GNU extensions to
+the C language is expected to be rewritten for 0.6 anyway,
+so there are no plans for an interim fix.
+
+This requirement does not mean you must already have @code{gcc}
+installed to build @code{g77}.
+As long as you have a working C compiler, you can use a
+bootstrap build to automate the process of first building
+@code{gcc} using the working C compiler you have, then building
+@code{g77} and rebuilding @code{gcc} using that just-built @code{gcc},
+and so on.
+
+@node Patching GNU CC Necessary
+@subsubsection Patching GNU CC Necessary
+@cindex patch files
+@cindex GBE
+
+@code{g77} currently requires application of a patch file to the gcc compiler
+tree.
+The necessary patches should be folded in to the mainline gcc distribution.
+
+Some combinations
+of versions of @code{g77} and @code{gcc} might actually @emph{require} no
+patches, but the patch files will be provided anyway as long as
+there are more changes expected in subsequent releases.
+These patch files might contain
+unnecessary, but possibly helpful, patches.
+As a result, it is possible this issue might never be
+resolved, except by eliminating the need for the person
+configuring @code{g77} to apply a patch by hand, by going
+to a more automated approach (such as configure-time patching).
+
+@node Building GNU CC Necessary
+@subsubsection Building GNU CC Necessary
+@cindex gcc, building
+@cindex building gcc
+
+It should be possible to build the runtime without building @code{cc1}
+and other non-Fortran items, but, for now, an easy way to do that
+is not yet established.
+
+@node Missing strtoul
+@subsubsection Missing strtoul
+@cindex strtoul
+@cindex _strtoul
+@cindex undefined reference (_strtoul)
+@cindex f771, linking error for
+@cindex linking error for f771
+@cindex ld error for f771
+@cindex ld can't find _strtoul
+@cindex SunOS4
+
+On SunOS4 systems, linking the @code{f771} program produces
+an error message concerning an undefined symbol named
+@samp{_strtoul}.
+
+This is not a @code{g77} bug.
+@xref{Patching GNU Fortran}, for information on
+a workaround provided by @code{g77}.
+
+The proper fix is either to upgrade your system to one that
+provides a complete ANSI C environment, or improve @code{gcc} so
+that it provides one for all the languages and configurations it supports.
+
+@emph{Note:} In earlier versions of @code{g77}, an automated
+workaround for this problem was attempted.
+It worked for systems without @samp{_strtoul}, substituting
+the incomplete-yet-sufficient version supplied with @code{g77}
+for those systems.
+However, the automated workaround failed mysteriously for systems
+that appeared to have conforming ANSI C environments, and it
+was decided that, lacking resources to more fully investigate
+the problem, it was better to not punish users of those systems
+either by requiring them to work around the problem by hand or
+by always substituting an incomplete @code{strtoul()} implementation
+when their systems had a complete, working one.
+Unfortunately, this meant inconveniencing users of systems not
+having @code{strtoul()}, but they're using obsolete (and generally
+unsupported) systems anyway.
+
+@node Object File Differences
+@subsubsection Object File Differences
+@cindex zzz.o
+@cindex zzz.c
+@cindex object file, differences
+@cindex differences between object files
+@cindex make compare
+
+A comparison of object files after building Stage 3 during a
+bootstrap build will result in @file{gcc/f/zzz.o} being flagged
+as different from the Stage 2 version.
+That is because it
+contains a string with an expansion of the @code{__TIME__} macro,
+which expands to the current time of day.
+It is nothing to worry about, since
+@file{gcc/f/zzz.c} doesn't contain any actual code.
+It does allow you to override its use of @code{__DATE__} and
+@code{__TIME__} by defining macros for the compilation---see the
+source code for details.
+
+@node Cleanup Kills Stage Directories
+@subsubsection Cleanup Kills Stage Directories
+@cindex stage directories
+@cindex make clean
+
+It'd be helpful if @code{g77}'s @file{Makefile.in} or @file{Make-lang.in}
+would create the various @file{stage@var{n}} directories and their
+subdirectories, so developers and expert installers wouldn't have to
+reconfigure after cleaning up.
+
+@node Missing gperf?
+@subsubsection Missing @code{gperf}?
+@cindex @code{gperf}
+@cindex missing @code{gperf}
+
+If a build aborts trying to invoke @code{gperf}, that
+strongly suggests an improper method was used to
+create the @code{gcc} source directory,
+such as the UNIX @samp{cp -r} command instead
+of @samp{cp -pr}, since this problem very likely
+indicates that the date-time-modified information on
+the @code{gcc} source files is incorrect.
+
+The proper solution is to recreate the @code{gcc} source
+directory from a @code{gcc} distribution known to be
+provided by the FSF.
+
+It is possible you might be able to temporarily
+work around the problem, however, by trying these
+commands:
+
+@example
+sh# @kbd{cd gcc}
+sh# @kbd{touch c-gperf.h}
+sh#
+@end example
+
+These commands update the date-time-modified information for
+the file produced by the invocation of @code{gperf}
+in the current versions of @code{gcc}, so that @code{make} no
+longer believes it needs to update it.
+This file should already exist in a @code{gcc}
+distribution, but mistakes made when copying the @code{gcc}
+directory can leave the modification information
+set such that the @code{gperf} input files look more ``recent''
+than the corresponding output files.
+
+If the above does not work, definitely start from scratch
+and avoid copying the @code{gcc} using any method that does
+not reliably preserve date-time-modified information, such
+as the UNIX @samp{cp -r} command.
+
+@node Cross-compiler Problems
+@subsection Cross-compiler Problems
+@cindex cross-compiler, problems
+
+@code{g77} has been in alpha testing since September of
+1992, and in public beta testing since February of 1995.
+Alpha testing was done by a small number of people worldwide on a fairly
+wide variety of machines, involving self-compilation in most or
+all cases.
+Beta testing has been done primarily via self-compilation,
+but in more and more cases, cross-compilation (and ``criss-cross
+compilation'', where a version of a compiler is built on one machine
+to run on a second and generate code that runs on a third) has
+been tried and has succeeded, to varying extents.
+
+Generally, @code{g77} can be ported to any configuration to which
+@code{gcc}, @code{f2c}, and @code{libf2c} can be ported and made
+to work together, aside from the known problems described in this
+manual.
+If you want to port @code{g77} to a particular configuration,
+you should first make sure @code{gcc} and @code{libf2c} can be
+ported to that configuration before focusing on @code{g77}, because
+@code{g77} is so dependent on them.
+
+Even for cases where @code{gcc} and @code{libf2c} work,
+you might run into problems with cross-compilation on certain machines,
+for several reasons.
+
+@itemize @bullet
+@item
+There is one known bug
+(a design bug to be fixed in 0.6) that prevents configuration of
+@code{g77} as a cross-compiler in some cases,
+though there are assumptions made during
+configuration that probably make doing non-self-hosting builds
+a hassle, requiring manual intervention.
+
+@item
+@code{gcc} might still have some trouble being configured
+for certain combinations of machines.
+For example, it might not know how to handle floating-point
+constants.
+
+@item
+Improvements to the way @code{libf2c} is built could make
+building @code{g77} as a cross-compiler easier---for example,
+passing and using @samp{LD} and @samp{AR} in the appropriate
+ways.
+
+@item
+There are still some challenges putting together the right
+run-time libraries (needed by @code{libf2c}) for a target
+system, depending on the systems involved in the configuration.
+(This is a general problem with cross-compilation, and with
+@code{gcc} in particular.)
+@end itemize
+
+@node Settings
+@section Changing Settings Before Building
+
+Here are some internal @code{g77} settings that can be changed
+by editing source files in @file{gcc/f/} before building.
+
+This information, and perhaps even these settings, represent
+stop-gap solutions to problems people doing various ports
+of @code{g77} have encountered.
+As such, none of the following information is expected to
+be pertinent in future versions of @code{g77}.
+
+@menu
+* Larger File Unit Numbers:: Raising @samp{MXUNIT}.
+* Always Flush Output:: Synchronizing write errors.
+* Maximum Stackable Size:: Large arrays are forced off the stack frame.
+* Floating-point Bit Patterns:: Possible programs building cross-compiler.
+* Large Initialization:: Large arrays with @code{DATA} initialization.
+* Alpha Problems Fixed:: Problems 64-bit systems like Alphas now fixed?
+@end menu
+
+@node Larger File Unit Numbers
+@subsection Larger File Unit Numbers
+@cindex MXUNIT
+@cindex unit numbers
+@cindex maximum unit number
+@cindex illegal unit number
+@cindex increasing maximum unit number
+
+As distributed, whether as part of @code{f2c} or @code{g77},
+@code{libf2c} accepts file unit numbers only in the range
+0 through 99.
+For example, a statement such as @samp{WRITE (UNIT=100)} causes
+a run-time crash in @code{libf2c}, because the unit number,
+100, is out of range.
+
+If you know that Fortran programs at your installation require
+the use of unit numbers higher than 99, you can change the
+value of the @samp{MXUNIT} macro, which represents the maximum unit
+number, to an appropriately higher value.
+
+To do this, edit the file @file{f/runtime/libI77/fio.h} in your
+@code{g77} source tree, changing the following line:
+
+@example
+#define MXUNIT 100
+@end example
+
+Change the line so that the value of @samp{MXUNIT} is defined to be
+at least one @emph{greater} than the maximum unit number used by
+the Fortran programs on your system.
+
+(For example, a program that does @samp{WRITE (UNIT=255)} would require
+@samp{MXUNIT} set to at least 256 to avoid crashing.)
+
+Then build or rebuild @code{g77} as appropriate.
+
+@emph{Note:} Changing this macro has @emph{no} effect on other limits
+your system might place on the number of files open at the same time.
+That is, the macro might allow a program to do @samp{WRITE (UNIT=100)},
+but the library and operating system underlying @code{libf2c} might
+disallow it if many other files have already been opened (via @code{OPEN} or
+implicitly via @code{READ}, @code{WRITE}, and so on).
+Information on how to increase these other limits should be found
+in your system's documentation.
+
+@node Always Flush Output
+@subsection Always Flush Output
+@cindex ALWAYS_FLUSH
+@cindex synchronous write errors
+@cindex disk full
+@cindex flushing output
+@cindex fflush()
+@cindex I/O, flushing
+@cindex output, flushing
+@cindex writes, flushing
+@cindex NFS
+@cindex network file system
+
+Some Fortran programs require output
+(writes) to be flushed to the operating system (under UNIX,
+via the @code{fflush()} library call) so that errors,
+such as disk full, are immediately flagged via the relevant
+@code{ERR=} and @code{IOSTAT=} mechanism, instead of such
+errors being flagged later as subsequent writes occur, forcing
+the previously written data to disk, or when the file is
+closed.
+
+Essentially, the difference can be viewed as synchronous error
+reporting (immediate flagging of errors during writes) versus
+asynchronous, or, more precisely, buffered error reporting
+(detection of errors might be delayed).
+
+@code{libf2c} supports flagging write errors immediately when
+it is built with the @samp{ALWAYS_FLUSH} macro defined.
+This results in a @code{libf2c} that runs slower, sometimes
+quite a bit slower, under certain circumstances---for example,
+accessing files via the networked file system NFS---but the
+effect can be more reliable, robust file I/O.
+
+If you know that Fortran programs requiring this level of precision
+of error reporting are to be compiled using the
+version of @code{g77} you are building, you might wish to
+modify the @code{g77} source tree so that the version of
+@code{libf2c} is built with the @samp{ALWAYS_FLUSH} macro
+defined, enabling this behavior.
+
+To do this, find this line in @file{f/runtime/configure.in} in
+your @code{g77} source tree:
+
+@example
+dnl AC_DEFINE(ALWAYS_FLUSH)
+@end example
+
+Remove the leading @samp{dnl@w{ }}, so the line begins with
+@samp{AC_DEFINE(}, and run @code{autoconf} in that file's directory.
+(Or, if you don't have @code{autoconf}, you can modify @file{f2c.h.in}
+in the same directory to include the line @samp{#define ALWAYS_FLUSH}
+after @samp{#define F2C_INCLUDE}.)
+
+Then build or rebuild @code{g77} as appropriate.
+
+@node Maximum Stackable Size
+@subsection Maximum Stackable Size
+@vindex FFECOM_sizeMAXSTACKITEM
+@cindex code, stack variables
+@cindex maximum stackable size
+@cindex stack allocation
+@cindex segmentation violation
+@code{g77}, on most machines, puts many variables and arrays on the stack
+where possible, and can be configured (by changing
+@samp{FFECOM_sizeMAXSTACKITEM} in @file{gcc/f/com.c}) to force
+smaller-sized entities into static storage (saving
+on stack space) or permit larger-sized entities to be put on the
+stack (which can improve run-time performance, as it presents
+more opportunities for the GBE to optimize the generated code).
+
+@emph{Note:} Putting more variables and arrays on the stack
+might cause problems due to system-dependent limits on stack size.
+Also, the value of @samp{FFECOM_sizeMAXSTACKITEM} has no
+effect on automatic variables and arrays.
+@xref{But-bugs}, for more information.
+
+@node Floating-point Bit Patterns
+@subsection Floating-point Bit Patterns
+
+@cindex cross-compiler, building
+@cindex floating-point bit patterns
+@cindex bit patterns
+The @code{g77} build will crash if an attempt is made to build
+it as a cross-compiler
+for a target when @code{g77} cannot reliably determine the bit pattern of
+floating-point constants for the target.
+Planned improvements for g77-0.6
+will give it the capabilities it needs to not have to crash the build
+but rather generate correct code for the target.
+(Currently, @code{g77}
+would generate bad code under such circumstances if it didn't crash
+during the build, e.g. when compiling a source file that does
+something like @samp{EQUIVALENCE (I,R)} and @samp{DATA R/9.43578/}.)
+
+@node Large Initialization
+@subsection Initialization of Large Aggregate Areas
+
+@cindex speed, compiler
+@cindex slow compiler
+@cindex memory utilization
+@cindex large initialization
+@cindex aggregate initialization
+A warning message is issued when @code{g77} sees code that provides
+initial values (e.g. via @code{DATA}) to an aggregate area (@code{COMMON}
+or @code{EQUIVALENCE}, or even a large enough array or @code{CHARACTER}
+variable)
+that is large enough to increase @code{g77}'s compile time by roughly
+a factor of 10.
+
+This size currently is quite small, since @code{g77}
+currently has a known bug requiring too much memory
+and time to handle such cases.
+In @file{gcc/f/data.c}, the macro
+@samp{FFEDATA_sizeTOO_BIG_INIT_} is defined
+to the minimum size for the warning to appear.
+The size is specified in storage units,
+which can be bytes, words, or whatever, on a case-by-case basis.
+
+After changing this macro definition, you must
+(of course) rebuild and reinstall @code{g77} for
+the change to take effect.
+
+Note that, as of version 0.5.18, improvements have
+reduced the scope of the problem for @emph{sparse}
+initialization of large arrays, especially those
+with large, contiguous uninitialized areas.
+However, the warning is issued at a point prior to
+when @code{g77} knows whether the initialization is sparse,
+and delaying the warning could mean it is produced
+too late to be helpful.
+
+Therefore, the macro definition should not be adjusted to
+reflect sparse cases.
+Instead, adjust it to generate the warning when densely
+initialized arrays begin to cause responses noticeably slower
+than linear performance would suggest.
+
+@node Alpha Problems Fixed
+@subsection Alpha Problems Fixed
+
+@cindex Alpha, support
+@cindex 64-bit systems
+@code{g77} used to warn when it was used to compile Fortran code
+for a target configuration that is not basically a 32-bit
+machine (such as an Alpha, which is a 64-bit machine, especially
+if it has a 64-bit operating system running on it).
+That was because @code{g77} was known to not work
+properly on such configurations.
+
+As of version 0.5.20, @code{g77} is believed to work well
+enough on such systems.
+So, the warning is no longer needed or provided.
+
+However, support for 64-bit systems, especially in
+areas such as cross-compilation and handling of
+intrinsics, is still incomplete.
+The symptoms
+are believed to be compile-time diagnostics rather
+than the generation of bad code.
+It is hoped that version 0.6 will completely support 64-bit
+systems.
+
+@node Quick Start
+@section Quick Start
+@cindex quick start
+
+This procedure configures, builds, and installs @code{g77}
+``out of the box'' and works on most UNIX systems.
+Each command is identified by a unique number,
+used in the explanatory text that follows.
+For the most part, the output of each command is not shown,
+though indications of the types of responses are given in a
+few cases.
+
+To perform this procedure, the installer must be logged
+in as user @code{root}.
+Much of it can be done while not logged in as @code{root},
+and users experienced with UNIX administration should be
+able to modify the procedure properly to do so.
+
+Following traditional UNIX conventions, it is assumed that
+the source trees for @code{g77} and @code{gcc} will be
+placed in @file{/usr/src}.
+It also is assumed that the source distributions themselves
+already reside in @file{/usr/FSF}, a naming convention
+used by the author of @code{g77} on his own system:
+
+@example
+/usr/FSF/gcc-2.7.2.2.tar.gz
+/usr/FSF/g77-0.5.21.tar.gz
+@end example
+
+@c (You can use @file{gcc-2.7.2.1.tar.gz} instead, or
+@c the equivalent of it obtained by applying the
+@c patch distributed as @file{gcc-2.7.2-2.7.2.1.diff.gz}
+@c to version 2.7.2 of @code{gcc},
+@c if you remember to make the appropriate adjustments in the
+@c instructions below.)
+
+@cindex SunOS4
+Users of the following systems should not blindly follow
+these quick-start instructions, because of problems their
+systems have coping with straightforward installation of
+@code{g77}:
+
+@itemize @bullet
+@item
+SunOS4
+@end itemize
+
+Instead, see @ref{Complete Installation}, for detailed information
+on how to configure, build, and install @code{g77} for your
+particular system.
+Also, see @ref{Trouble,,Known Causes of Trouble with GNU Fortran},
+for information on bugs and other problems known to afflict the
+installation process, and how to report newly discovered ones.
+
+If your system is @emph{not} on the above list, and @emph{is}
+a UNIX system or one of its variants, you should be able to
+follow the instructions below.
+If you vary @emph{any} of the steps below, you might run into
+trouble, including possibly breaking existing programs for
+other users of your system.
+Before doing so, it is wise to review the explanations of some
+of the steps.
+These explanations follow this list of steps.
+
+@example
+sh[ 1]# @kbd{cd /usr/src}
+@set source-dir 1
+sh[ 2]# @kbd{gunzip -c < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -}
+[Might say "Broken pipe"...that is normal on some systems.]
+@set unpack-gcc 2
+sh[ 3]# @kbd{gunzip -c < /usr/FSF/g77-0.5.21.tar.gz | tar xf -}
+["Broken pipe" again possible.]
+@set unpack-g77 3
+sh[ 4]# @kbd{ln -s gcc-2.7.2.2 gcc}
+@set link-gcc 4
+sh[ 5]# @kbd{ln -s g77-0.5.21 g77}
+@set link-g77 5
+sh[ 6]# @kbd{mv -i g77/* gcc}
+[No questions should be asked by mv here; or, you made a mistake.]
+@set merge-g77 6
+sh[ 7]# @kbd{patch -p1 -V t -d gcc < gcc/f/gbe/2.7.2.2.diff}
+[Unless patch complains about rejected patches, this step worked.]
+@set apply-patch 7
+sh[ 8]# @kbd{cd gcc}
+sh[ 9]# @kbd{touch f77-install-ok}
+[Do not do the above if your system already has an f77
+command, unless you've checked that overwriting it
+is okay.]
+@set f77-install-ok 9
+sh[10]# @kbd{touch f2c-install-ok}
+[Do not do the above if your system already has an f2c
+command, unless you've checked that overwriting it
+is okay. Else, @kbd{touch f2c-exists-ok}.]
+@set f2c-install-ok 10
+sh[11]# @kbd{./configure --prefix=/usr}
+[Do not do the above if gcc is not installed in /usr/bin.
+You might need a different @kbd{--prefix=@dots{}}, as
+described below.]
+@set configure-gcc 11
+sh[12]# @kbd{make bootstrap}
+[This takes a long time, and is where most problems occur.]
+@set build-gcc 12
+sh[13]# @kbd{make compare}
+[This verifies that the compiler is `sane'. Only
+the file `f/zzz.o' (aka `tmp-foo1' and `tmp-foo2')
+should be in the list of object files this command
+prints as having different contents. If other files
+are printed, you have likely found a g77 bug.]
+@set compare-gcc 13
+sh[14]# @kbd{rm -fr stage1}
+@set rm-stage1 14
+sh[15]# @kbd{make -k install}
+[The actual installation.]
+@set install-g77 15
+sh[16]# @kbd{g77 -v}
+[Verify that g77 is installed, obtain version info.]
+@set show-version 16
+sh[17]#
+@set end-procedure 17
+@end example
+
+@xref{Updating Documentation,,Updating Your Info Directory}, for
+information on how to update your system's top-level @code{info}
+directory to contain a reference to this manual, so that
+users of @code{g77} can easily find documentation instead
+of having to ask you for it.
+
+Elaborations of many of the above steps follows:
+
+@table @asis
+@item Step @value{source-dir}: @kbd{cd /usr/src}
+You can build @code{g77} pretty much anyplace.
+By convention, this manual assumes @file{/usr/src}.
+It might be helpful if other users on your system
+knew where to look for the source code for the
+installed version of @code{g77} and @code{gcc} in any case.
+
+@c @item Step @value{unpack-gcc}: @kbd{gunzip -d @dots{}}
+@c Here, you might wish to use @file{gcc-2.7.2.1.tar.gz}
+@c instead, or apply @file{gcc-2.7.2-2.7.2.1.diff.gz} to achieve
+@c similar results.
+
+@item Step @value{unpack-g77}: @kbd{gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -}
+It is not always necessary to obtain the latest version of
+@code{g77} as a complete @file{.tar.gz} file if you have
+a complete, earlier distribution of @code{g77}.
+If appropriate, you can unpack that earlier
+version of @code{g77}, and then apply the appropriate patches
+to achieve the same result---a source tree containing version
+0.5.21 of @code{g77}.
+
+@item Step @value{link-gcc}: @kbd{ln -s gcc-2.7.2.2 gcc}
+@item Step @value{link-g77}: @kbd{ln -s g77-0.5.21 g77}
+These commands mainly help reduce typing,
+and help reduce visual clutter in examples
+in this manual showing what to type to install @code{g77}.
+
+@c Of course, if appropriate, @kbd{ln -s gcc-2.7.2.1 gcc} or
+@c similar.
+
+@xref{Unpacking}, for information on
+using distributions of @code{g77} made by organizations
+other than the FSF.
+
+@item Step @value{merge-g77}: @kbd{mv -i g77/* gcc}
+After doing this, you can, if you like, type
+@samp{rm g77} and @samp{rmdir g77-0.5.21} to remove
+the empty directory and the symbol link to it.
+But, it might be helpful to leave them around as
+quick reminders of which version(s) of @code{g77} are
+installed on your system.
+
+@xref{Unpacking}, for information
+on the contents of the @file{g77} directory (as merged
+into the @file{gcc} directory).
+
+@item Step @value{apply-patch}: @kbd{patch -p1 @dots{}}
+@c (Or `@kbd{@dots{} < gcc/f/gbe/2.7.2.1.diff}', if appropriate.)
+@c
+This can produce a wide variety of printed output,
+from @samp{Hmm, I can't seem to find a patch in there anywhere...}
+to long lists of messages indicated that patches are
+being found, applied successfully, and so on.
+
+If messages about ``fuzz'', ``offset'', or
+especially ``reject files'' are printed, it might
+mean you applied the wrong patch file.
+If you believe this is the case, it is best to restart
+the sequence after deleting (or at least renaming to unused
+names) the top-level directories for @code{g77} and @code{gcc}
+and their symbolic links.
+
+After this command finishes, the @code{gcc} directory might
+have old versions of several files as saved by @code{patch}.
+To remove these, after @kbd{cd gcc}, type @kbd{rm -i *.~*~}.
+
+@xref{Merging Distributions}, for more information.
+
+@item Step @value{f77-install-ok}: @kbd{touch f77-install-ok}
+Don't do this if you don't want to overwrite an existing
+version of @code{f77} (such as a native compiler, or a
+script that invokes @code{f2c}).
+Otherwise, installation will overwrite the @code{f77} command
+and the @code{f77} man pages with copies of the corresponding
+@code{g77} material.
+
+@xref{Installing f77,,Installing @code{f77}}, for more
+information.
+
+@item Step @value{f2c-install-ok}: @kbd{touch f2c-install-ok}
+Don't do this if you don't want to overwrite an existing
+installation of @code{libf2c} (though, chances are, you do).
+Instead, @kbd{touch f2c-exists-ok} to allow the installation
+to continue without any error messages about @file{/usr/lib/libf2c.a}
+already existing.
+
+@xref{Installing f2c,,Installing @code{f2c}}, for more
+information.
+
+@item Step @value{configure-gcc}: @kbd{./configure --prefix=/usr}
+This is where you specify that the @file{g77} executable is to be
+installed in @file{/usr/bin/}, the @file{libf2c.a} library is
+to be installed in @file{/usr/lib/}, and so on.
+
+You should ensure that any existing installation of the @file{gcc}
+executable is in @file{/usr/bin/}.
+Otherwise, installing @code{g77} so that it does not fully
+replace the existing installation of @code{gcc} is likely
+to result in the inability to compile Fortran programs.
+
+@xref{Where to Install,,Where in the World Does Fortran (and GNU CC) Go?},
+for more information on determining where to install @code{g77}.
+@xref{Configuring gcc}, for more information on the
+configuration process triggered by invoking the @file{./configure}
+script.
+
+@item Step @value{build-gcc}: @kbd{make bootstrap}
+@xref{Installation,,Installing GNU CC,
+gcc,Using and Porting GNU CC}, for information
+on the kinds of diagnostics you should expect during
+this procedure.
+
+@xref{Building gcc}, for complete @code{g77}-specific
+information on this step.
+
+@item Step @value{compare-gcc}: @kbd{make compare}
+@xref{Bug Lists,,Where to Port Bugs}, for information
+on where to report that you observed more than
+@file{f/zzz.o} having different contents during this
+phase.
+
+@xref{Bug Reporting,,How to Report Bugs}, for
+information on @emph{how} to report bugs like this.
+
+@item Step @value{rm-stage1}: @kbd{rm -fr stage1}
+You don't need to do this, but it frees up disk space.
+
+@item Step @value{install-g77}: @kbd{make -k install}
+If this doesn't seem to work, try:
+
+@example
+make -k install install-libf77 install-f2c-all
+@end example
+
+@xref{Installation of Binaries}, for more information.
+
+@xref{Updating Documentation,,Updating Your Info Directory},
+for information on entering this manual into your
+system's list of texinfo manuals.
+
+@item Step @value{show-version}: @kbd{g77 -v}
+If this command prints approximately 25 lines of output,
+including the GNU Fortran Front End version number (which
+should be the same as the version number for the version
+of @code{g77} you just built and installed) and the
+version numbers for the three parts of the @code{libf2c}
+library (@code{libF77}, @code{libI77}, @code{libU77}), and
+those version numbers are all in agreement, then there is
+a high likelihood that the installation has been successfully
+completed.
+
+You might consider doing further testing.
+For example, log in as a non-privileged user, then create
+a small Fortran program, such as:
+
+@example
+ PROGRAM SMTEST
+ DO 10 I=1, 10
+ PRINT *, 'Hello World #', I
+10 CONTINUE
+ END
+@end example
+
+Compile, link, and run the above program, and, assuming you named
+the source file @file{smtest.f}, the session should look like this:
+
+@example
+sh# @kbd{g77 -o smtest smtest.f}
+sh# @kbd{./smtest}
+ Hello World # 1
+ Hello World # 2
+ Hello World # 3
+ Hello World # 4
+ Hello World # 5
+ Hello World # 6
+ Hello World # 7
+ Hello World # 8
+ Hello World # 9
+ Hello World # 10
+sh#
+@end example
+
+After proper installation, you don't
+need to keep your gcc and g77 source and build directories
+around anymore.
+Removing them can free up a lot of disk space.
+@end table
+
+@node Complete Installation
+@section Complete Installation
+
+Here is the complete @code{g77}-specific information on how
+to configure, build, and install @code{g77}.
+
+@menu
+* Unpacking::
+* Merging Distributions::
+* f77: Installing f77.
+* f2c: Installing f2c.
+* Patching GNU Fortran::
+* Where to Install::
+* Configuring gcc::
+* Building gcc::
+* Pre-installation Checks::
+* Installation of Binaries::
+* Updating Documentation::
+* bison: Missing bison?.
+* makeinfo: Missing makeinfo?.
+@end menu
+
+@node Unpacking
+@subsection Unpacking
+@cindex unpacking distributions
+@cindex distributions, unpacking
+@cindex code, source
+@cindex source code
+@cindex source tree
+@cindex packages
+
+The @code{gcc} source distribution is a stand-alone distribution.
+It is designed to be unpacked (producing the @code{gcc}
+source tree) and built as is, assuming certain
+prerequisites are met (including the availability of compatible
+UNIX programs such as @code{make}, @code{cc}, and so on).
+
+However, before building @code{gcc}, you will want to unpack
+and merge the @code{g77} distribution in with it, so that you
+build a Fortran-capable version of @code{gcc}, which includes
+the @code{g77} command, the necessary run-time libraries,
+and this manual.
+
+Unlike @code{gcc}, the @code{g77} source distribution
+is @emph{not} a stand-alone distribution.
+It is designed to be unpacked and, afterwards, immediately merged
+into an applicable @code{gcc} source tree.
+That is, the @code{g77} distribution @emph{augments} a
+@code{gcc} distribution---without @code{gcc}, generally
+only the documentation is immediately usable.
+
+A sequence of commands typically used to unpack @code{gcc}
+and @code{g77} is:
+
+@example
+sh# @kbd{cd /usr/src}
+sh# @kbd{gunzip -d < /usr/FSF/gcc-2.7.2.2.tar.gz | tar xf -}
+sh# @kbd{gunzip -d < /usr/FSF/g77-0.5.21.tar.gz | tar xf -}
+sh# @kbd{ln -s gcc-2.7.2.2 gcc}
+sh# @kbd{ln -s g77-0.5.21 g77}
+sh# @kbd{mv -i g77/* gcc}
+@end example
+
+@emph{Notes:} The commands beginning with @samp{gunzip@dots{}} might
+print @samp{Broken pipe@dots{}} as they complete.
+That is nothing to worry about, unless you actually
+@emph{hear} a pipe breaking.
+The @code{ln} commands are helpful in reducing typing
+and clutter in installation examples in this manual.
+Hereafter, the top level of @code{gcc} source tree is referred to
+as @file{gcc}, and the top level of just the @code{g77}
+source tree (prior to issuing the @code{mv} command, above)
+is referred to as @file{g77}.
+
+There are three top-level names in a @code{g77} distribution:
+
+@example
+g77/COPYING.g77
+g77/README.g77
+g77/f
+@end example
+
+All three entries should be moved (or copied) into a @code{gcc}
+source tree (typically named after its version number and
+as it appears in the FSF distributions---e.g. @file{gcc-2.7.2.2}).
+
+@file{g77/f} is the subdirectory containing all of the
+code, documentation, and other information that is specific
+to @code{g77}.
+The other two files exist to provide information on @code{g77}
+to someone encountering a @code{gcc} source tree with @code{g77}
+already present, who has not yet read these installation
+instructions and thus needs help understanding that the
+source tree they are looking at does not come from a single
+FSF distribution.
+They also help people encountering an unmerged @code{g77} source
+tree for the first time.
+
+@cindex modifying @code{g77}
+@cindex code, modifying
+@cindex Pentium optimizations
+@cindex optimizations, Pentium
+@emph{Note:} Please use @strong{only} @code{gcc} and @code{g77}
+source trees as distributed by the FSF.
+Use of modified versions, such as the Pentium-specific-optimization
+port of @code{gcc}, is likely to result in problems that appear to be
+in the @code{g77} code but, in fact, are not.
+Do not use such modified versions
+unless you understand all the differences between them and the versions
+the FSF distributes---in which case you should be able to modify the
+@code{g77} (or @code{gcc}) source trees appropriately so @code{g77}
+and @code{gcc} can coexist as they do in the stock FSF distributions.
+
+@node Merging Distributions
+@subsection Merging Distributions
+@cindex merging distributions
+@cindex @code{gcc} versions supported by @code{g77}
+@cindex versions of @code{gcc}
+@cindex support for @code{gcc} versions
+
+After merging the @code{g77} source tree into the @code{gcc}
+source tree, the final merge step is done by applying the
+pertinent patches the @code{g77} distribution provides for
+the @code{gcc} source tree.
+
+Read the file @file{gcc/f/gbe/README}, and apply the appropriate
+patch file for the version of the GNU CC compiler you have, if
+that exists.
+If the directory exists but the appropriate file
+does not exist, you are using either an old, unsupported version,
+or a release one that is newer than the newest @code{gcc} version
+supported by the version of @code{g77} you have.
+
+@cindex gcc version numbering
+@cindex version numbering
+@cindex g77 version number
+@cindex GNU version numbering
+As of version 0.5.18, @code{g77} modifies the version number
+of @code{gcc} via the pertinent patches.
+This is done because the resulting version of @code{gcc} is
+deemed sufficiently different from the vanilla distribution
+to make it worthwhile to present, to the user, information
+signaling the fact that there are some differences.
+
+GNU version numbers make it easy to figure out whether a
+particular version of a distribution is newer or older than
+some other version of that distribution.
+The format is,
+generally, @var{major}.@var{minor}.@var{patch}, with
+each field being a decimal number.
+(You can safely ignore
+leading zeros; for example, 1.5.3 is the same as 1.5.03.)@
+The @var{major} field only increases with time.
+The other two fields are reset to 0 when the field to
+their left is incremented; otherwise, they, too, only
+increase with time.
+So, version 2.6.2 is newer than version 2.5.8, and
+version 3.0 is newer than both.
+(Trailing @samp{.0} fields often are omitted in
+announcements and in names for distributions and
+the directories they create.)
+
+If your version of @code{gcc} is older than the oldest version
+supported by @code{g77} (as casually determined by listing
+the contents of @file{gcc/f/gbe/}), you should obtain a newer,
+supported version of @code{gcc}.
+(You could instead obtain an older version of @code{g77},
+or try and get your @code{g77} to work with the old
+@code{gcc}, but neither approach is recommended, and
+you shouldn't bother reporting any bugs you find if you
+take either approach, because they're probably already
+fixed in the newer versions you're not using.)
+
+If your version of @code{gcc} is newer than the newest version
+supported by @code{g77}, it is possible that your @code{g77}
+will work with it anyway.
+If the version number for @code{gcc} differs only in the
+@var{patch} field, you might as well try applying the @code{g77} patch
+that is for the newest version of @code{gcc} having the same
+@var{major} and @var{minor} fields, as this is likely to work.
+
+So, for example, if a particular version of @code{g77} has support for
+@code{gcc} versions 2.7.0 and 2.7.1,
+it is likely that @file{gcc-2.7.2} would work well with @code{g77}
+by using the @file{2.7.1.diff} patch file provided
+with @code{g77} (aside from some offsets reported by @code{patch},
+which usually are harmless).
+
+However, @file{gcc-2.8.0} would almost certainly
+not work with that version of @code{g77} no matter which patch file was
+used, so a new version of @code{g77} would be needed (and you should
+wait for it rather than bothering the maintainers---@pxref{Changes,,
+User-Visible Changes}).
+
+@cindex distributions, why separate
+@cindex separate distributions
+@cindex why separate distributions
+This complexity is the result of @code{gcc} and @code{g77} being
+separate distributions.
+By keeping them separate, each product is able to be independently
+improved and distributed to its user base more frequently.
+
+However, @code{g77} often requires changes to contemporary
+versions of @code{gcc}.
+Also, the GBE interface defined by @code{gcc} typically
+undergoes some incompatible changes at least every time the
+@var{minor} field of the version number is incremented,
+and such changes require corresponding changes to
+the @code{g77} front end (FFE).
+
+It is hoped that the GBE interface, and the @code{gcc} and
+@code{g77} products in general, will stabilize sufficiently
+for the need for hand-patching to disappear.
+
+Invoking @code{patch} as described in @file{gcc/f/gbe/README}
+can produce a wide variety of printed output,
+from @samp{Hmm, I can't seem to find a patch in there anywhere...}
+to long lists of messages indicated that patches are
+being found, applied successfully, and so on.
+
+If messages about ``fuzz'', ``offset'', or
+especially ``reject files'' are printed, it might
+mean you applied the wrong patch file.
+If you believe this is the case, it is best to restart
+the sequence after deleting (or at least renaming to unused
+names) the top-level directories for @code{g77} and @code{gcc}
+and their symbolic links.
+That is because @code{patch} might have partially patched
+some @code{gcc} source files, so reapplying the correct
+patch file might result in the correct patches being
+applied incorrectly (due to the way @code{patch} necessarily
+works).
+
+After @code{patch} finishes, the @code{gcc} directory might
+have old versions of several files as saved by @code{patch}.
+To remove these, after @kbd{cd gcc}, type @kbd{rm -i *.~*~}.
+
+@pindex config-lang.in
+@emph{Note:} @code{g77}'s configuration file @file{gcc/f/config-lang.in}
+ensures that the source code for the version of @code{gcc}
+being configured has at least one indication of being patched
+as required specifically by @code{g77}.
+This configuration-time
+checking should catch failure to apply the correct patch and,
+if so caught, should abort the configuration with an explanation.
+@emph{Please} do not try to disable the check,
+otherwise @code{g77} might well appear to build
+and install correctly, and even appear to compile correctly,
+but could easily produce broken code.
+
+@cindex creating patch files
+@cindex patch files, creating
+@pindex gcc/f/gbe/
+@samp{diff -rcp2N} is used to create the patch files
+in @file{gcc/f/gbe/}.
+
+@node Installing f77
+@subsection Installing @code{f77}
+@cindex f77 command
+@cindex commands, f77
+@cindex native compiler
+
+You should decide whether you want installation of @code{g77}
+to also install an @code{f77} command.
+On systems with a native @code{f77}, this is not
+normally desired, so @code{g77} does not do this by
+default.
+
+@pindex f77-install-ok
+@vindex F77_INSTALL_FLAG
+If you want @code{f77} installed, create the file @file{f77-install-ok}
+(e.g. via the UNIX command @samp{touch f77-install-ok}) in the
+source or build top-level directory (the same directory in
+which the @code{g77} @file{f} directory resides, not the @file{f} directory
+itself), or edit @file{gcc/f/Make-lang.in} and change the definition
+of the @samp{F77_INSTALL_FLAG} macro appropriately.
+
+Usually, this means that, after typing @samp{cd gcc}, you
+would type @samp{touch f77-install-ok}.
+
+When you enable installation of @code{f77}, either a link to or a
+direct copy of the @code{g77} command is made.
+Similarly, @file{f77.1} is installed as a man page.
+
+(The @code{uninstall} target in the @file{gcc/Makefile} also tests
+this macro and file, when invoked, to determine whether to delete the
+installed copies of @code{f77} and @file{f77.1}.)
+
+@emph{Note:} No attempt is yet made
+to install a program (like a shell script) that provides
+compatibility with any other @code{f77} programs.
+Only the most rudimentary invocations of @code{f77} will
+work the same way with @code{g77}.
+
+@node Installing f2c
+@subsection Installing @code{f2c}
+
+Currently, @code{g77} does not include @code{f2c} itself in its
+distribution.
+However, it does include a modified version of the @code{libf2c}.
+This version is normally compatible with @code{f2c}, but has been
+modified to meet the needs of @code{g77} in ways that might possibly
+be incompatible with some versions or configurations of @code{f2c}.
+
+Decide how installation of @code{g77} should affect any existing installation
+of @code{f2c} on your system.
+
+@pindex f2c
+@pindex f2c.h
+@pindex libf2c.a
+@pindex libF77.a
+@pindex libI77.a
+If you do not have @code{f2c} on your system (e.g. no @file{/usr/bin/f2c},
+no @file{/usr/include/f2c.h}, and no @file{/usr/lib/libf2c.a},
+@file{/usr/lib/libF77.a}, or @file{/usr/lib/libI77.a}), you don't need to
+be concerned with this item.
+
+If you do have @code{f2c} on your system, you need to decide how users
+of @code{f2c} will be affected by your installing @code{g77}.
+Since @code{g77} is
+currently designed to be object-code-compatible with @code{f2c} (with
+very few, clear exceptions), users of @code{f2c} might want to combine
+@code{f2c}-compiled object files with @code{g77}-compiled object files in a
+single executable.
+
+To do this, users of @code{f2c} should use the same copies of @file{f2c.h} and
+@file{libf2c.a} that @code{g77} uses (and that get built as part of
+@code{g77}).
+
+If you do nothing here, the @code{g77} installation process will not
+overwrite the @file{include/f2c.h} and @file{lib/libf2c.a} files with its
+own versions, and in fact will not even install @file{libf2c.a} for use
+with the newly installed versions of @code{gcc} and @code{g77} if it sees
+that @file{lib/libf2c.a} exists---instead, it will print an explanatory
+message and skip this part of the installation.
+
+@pindex f2c-install-ok
+@vindex F2C_INSTALL_FLAG
+To install @code{g77}'s versions of @file{f2c.h} and @file{libf2c.a}
+in the appropriate
+places, create the file @file{f2c-install-ok} (e.g. via the UNIX
+command @samp{touch f2c-install-ok}) in the source or build top-level
+directory (the same directory in which the @code{g77} @file{f} directory
+resides, not the @file{f} directory itself), or edit @file{gcc/f/Make-lang.in}
+and change the definition of the @samp{F2C_INSTALL_FLAG} macro appropriately.
+
+Usually, this means that, after typing @samp{cd gcc}, you
+would type @samp{touch f2c-install-ok}.
+
+Make sure that when you enable the overwriting of @file{f2c.h}
+and @file{libf2c.a}
+as used by @code{f2c}, you have a recent and properly configured version of
+@file{bin/f2c} so that it generates code that is compatible with @code{g77}.
+
+@pindex f2c-exists-ok
+@vindex F2CLIBOK
+If you don't want installation of @code{g77} to overwrite @code{f2c}'s existing
+installation, but you do want @code{g77} installation to proceed with
+installation of its own versions of @file{f2c.h} and @file{libf2c.a} in places
+where @code{g77} will pick them up (even when linking @code{f2c}-compiled
+object files---which might lead to incompatibilities), create
+the file @file{f2c-exists-ok} (e.g. via the UNIX command
+@samp{touch f2c-exists-ok}) in the source or build top-level directory,
+or edit @file{gcc/f/Make-lang.in} and change the definition of the
+@samp{F2CLIBOK} macro appropriately.
+
+@node Patching GNU Fortran
+@subsection Patching GNU Fortran
+
+If you're using a SunOS4 system, you'll need to make the following
+change to @file{gcc/f/proj.h}: edit the line reading
+
+@example
+#define FFEPROJ_STRTOUL 1 @dots{}
+@end example
+
+@noindent
+by replacing the @samp{1} with @samp{0}.
+Or, you can avoid editing the source by adding
+@example
+CFLAGS='-DFFEPROJ_STRTOUL=0 -g -O'
+@end example
+to the command line for @code{make} when you invoke it.
+(@samp{-g} is the default for @samp{CFLAGS}.)
+
+This causes a minimal version of @code{strtoul()} provided
+as part of the @code{g77} distribution to be compiled and
+linked into whatever @code{g77} programs need it, since
+some systems (like SunOS4 with only the bundled compiler and its
+runtime) do not provide this function in their system libraries.
+
+Similarly, a minimal version of @code{bsearch()} is available
+and can be enabled by editing a line similar to the one
+for @code{strtoul()} above in @file{gcc/f/proj.h}, if
+your system libraries lack @code{bsearch()}.
+The method of overriding @samp{X_CFLAGS} may also be used.
+
+These are not problems with @code{g77}, which requires an
+ANSI C environment.
+You should upgrade your system to one that provides
+a full ANSI C environment, or encourage the maintainers
+of @code{gcc} to provide one to all @code{gcc}-based
+compilers in future @code{gcc} distributions.
+
+@xref{Problems Installing}, for more information on
+why @code{strtoul()} comes up missing and on approaches
+to dealing with this problem that have already been tried.
+
+@node Where to Install
+@subsection Where in the World Does Fortran (and GNU CC) Go?
+@cindex language f77 not recognized
+@cindex gcc will not compile Fortran programs
+
+Before configuring, you should make sure you know
+where you want the @code{g77} and @code{gcc}
+binaries to be installed after they're built,
+because this information is given to the configuration
+tool and used during the build itself.
+
+A @code{g77} installation necessarily requires installation of
+a @code{g77}-aware version of @code{gcc}, so that the @code{gcc}
+command recognizes Fortran source files and knows how to compile
+them.
+
+For this to work, the version of @code{gcc} that you will be building
+as part of @code{g77} @strong{must} be installed as the ``active''
+version of @code{gcc} on the system.
+
+Sometimes people make the mistake of installing @code{gcc} as
+@file{/usr/local/bin/gcc},
+leaving an older, non-Fortran-aware version in @file{/usr/bin/gcc}.
+(Or, the opposite happens.)@
+This can result in @code{g77} being unable to compile Fortran
+source files, because when it calls on @code{gcc} to do the
+actual compilation, @code{gcc} complains that it does not
+recognize the language, or the file name suffix.
+
+So, determine whether @code{gcc} already is installed on your system,
+and, if so, @emph{where} it is installed, and prepare to configure the
+new version of @code{gcc} you'll be building so that it installs
+over the existing version of @code{gcc}.
+
+You might want to back up your existing copy of @file{bin/gcc}, and
+the entire @file{lib/} directory, before
+you perform the actual installation (as described in this manual).
+
+Existing @code{gcc} installations typically are
+found in @file{/usr} or @file{/usr/local}.
+If you aren't certain where the currently
+installed version of @code{gcc} and its
+related programs reside, look at the output
+of this command:
+
+@example
+gcc -v -o /tmp/delete-me -xc /dev/null -xnone
+@end example
+
+All sorts of interesting information on the locations of various
+@code{gcc}-related programs and data files should be visible
+in the output of the above command.
+(The output also is likely to include a diagnostic from
+the linker, since there's no @samp{main_()} function.)
+However, you do have to sift through it yourself; @code{gcc}
+currently provides no easy way to ask it where it is installed
+and where it looks for the various programs and data files it
+calls on to do its work.
+
+Just @emph{building} @code{g77} should not overwrite any installed
+programs---but, usually, after you build @code{g77}, you will want
+to install it, so backing up anything it might overwrite is
+a good idea.
+(This is true for any package, not just @code{g77},
+though in this case it is intentional that @code{g77} overwrites
+@code{gcc} if it is already installed---it is unusual that
+the installation process for one distribution intentionally
+overwrites a program or file installed by another distribution.)
+
+Another reason to back up the existing version first,
+or make sure you can restore it easily, is that it might be
+an older version on which other users have come to depend
+for certain behaviors.
+However, even the new version of @code{gcc} you install
+will offer users the ability to specify an older version of
+the actual compilation programs if desired, and these
+older versions need not include any @code{g77} components.
+@xref{Target Options,,Specifying Target Machine and Compiler Version,
+gcc,Using and Porting GNU CC}, for information on the @samp{-V}
+option of @code{gcc}.
+
+@node Configuring gcc
+@subsection Configuring GNU CC
+
+@code{g77} is configured automatically when you configure
+@code{gcc}.
+There are two parts of @code{g77} that are configured in two
+different ways---@code{g77}, which ``camps on'' to the
+@code{gcc} configuration mechanism, and @code{libf2c}, which
+uses a variation of the GNU @code{autoconf} configuration
+system.
+
+Generally, you shouldn't have to be concerned with
+either @code{g77} or @code{libf2c} configuration, unless
+you're configuring @code{g77} as a cross-compiler.
+In this case, the @code{libf2c} configuration, and possibly the
+@code{g77} and @code{gcc} configurations as well,
+might need special attention.
+(This also might be the case if you're porting @code{gcc} to
+a whole new system---even if it is just a new operating system
+on an existing, supported CPU.)
+
+To configure the system, see
+@ref{Installation,,Installing GNU CC,gcc,Using and Porting GNU CC},
+following the instructions for running @file{./configure}.
+Pay special attention to the @samp{--prefix=} option, which
+you almost certainly will need to specify.
+
+(Note that @code{gcc} installation information is provided
+as a straight text file in @file{gcc/INSTALL}.)
+
+The information printed by the invocation of @file{./configure}
+should show that the @file{f} directory (the Fortran language)
+has been configured.
+If it does not, there is a problem.
+
+@emph{Note:} Configuring with the @samp{--srcdir} argument is known
+to work with GNU @code{make}, but it is not known to work with
+other variants of @code{make}.
+Irix5.2 and SunOS4.1 versions of @code{make} definitely
+won't work outside the source directory at present.
+@code{g77}'s
+portion of the @file{configure} script issues a warning message
+about this when you configure for building binaries outside
+the source directory.
+
+@node Building gcc
+@subsection Building GNU CC
+@cindex building @code{gcc}
+@cindex building @code{g77}
+
+@vindex LANGUAGES
+Building @code{g77} requires building enough of @code{gcc} that
+these instructions assume you're going to build all of
+@code{gcc}, including @code{g++}, @code{protoize}, and so on.
+You can save a little time and disk space by changes the
+@samp{LANGUAGES} macro definition in @code{gcc/Makefile.in}
+or @code{gcc/Makefile}, but if you do that, you're on your own.
+One change is almost @emph{certainly} going to cause failures:
+removing @samp{c} or @samp{f77} from the definition of the
+@samp{LANGUAGES} macro.
+
+After configuring @code{gcc}, which configures @code{g77} and
+@code{libf2c} automatically, you're ready to start the actual
+build by invoking @code{make}.
+
+@pindex configure
+@emph{Note:} You @strong{must} have run @file{./configure}
+before you run @code{make}, even if you're
+using an already existing @code{gcc} development directory, because
+@file{./configure} does the work to recognize that you've added
+@code{g77} to the configuration.
+
+There are two general approaches to building GNU CC from
+scratch:
+
+@table @dfn
+@item bootstrap
+This method uses minimal native system facilities to
+build a barebones, unoptimized @code{gcc}, that is then
+used to compile (``bootstrap'') the entire system.
+
+@item straight
+This method assumes a more complete native system
+exists, and uses that just once to build the entire
+system.
+@end table
+
+On all systems without a recent version of @code{gcc}
+already installed, the @i{bootstrap} method must be
+used.
+In particular, @code{g77} uses extensions to the C
+language offered, apparently, only by @code{gcc}.
+
+On most systems with a recent version of @code{gcc}
+already installed, the @i{straight} method can be
+used.
+This is an advantage, because it takes less CPU time
+and disk space for the build.
+However, it does require that the system have fairly
+recent versions of many GNU programs and other
+programs, which are not enumerated here.
+
+@menu
+* Bootstrap Build:: For all systems.
+* Straight Build:: For systems with a recent version of @code{gcc}.
+@end menu
+
+@node Bootstrap Build
+@subsubsection Bootstrap Build
+@cindex bootstrap build
+@cindex build, bootstrap
+
+A complete bootstrap build is done by issuing a command
+beginning with @samp{make bootstrap @dots{}}, as
+described in @ref{Installation,,Installing GNU CC,
+gcc,Using and Porting GNU CC}.
+This is the most reliable form of build, but it does require
+the most disk space and CPU time, since the complete system
+is built twice (in Stages 2 and 3), after an initial build
+(during Stage 1) of a minimal @code{gcc} compiler using
+the native compiler and libraries.
+
+You might have to, or want to, control the way a bootstrap
+build is done by entering the @code{make} commands to build
+each stage one at a time, as described in the @code{gcc}
+manual.
+For example, to save time or disk space, you might want
+to not bother doing the Stage 3 build, in which case you
+are assuming that the @code{gcc} compiler you have built
+is basically sound (because you are giving up the opportunity
+to compare a large number of object files to ensure they're
+identical).
+
+To save some disk space during installation, after Stage 2
+is built, you can type @samp{rm -fr stage1} to remove the
+binaries built during Stage 1.
+
+@emph{Note:} @xref{Object File Differences}, for information on
+expected differences in object files produced during Stage 2 and
+Stage 3 of a bootstrap build.
+These differences will be encountered as a result of using
+the @samp{make compare} or similar command sequence recommended
+by the GNU CC installation documentation.
+
+Also, @xref{Installation,,Installing GNU CC,gcc,Using and Porting GNU CC},
+for important information on building @code{gcc} that is
+not described in this @code{g77} manual.
+For example, explanations of diagnostic messages
+and whether they're expected, or indicate trouble,
+are found there.
+
+@node Straight Build
+@subsubsection Straight Build
+@cindex straight build
+@cindex build, straight
+
+If you have a recent version of @code{gcc}
+already installed on your system, and if you're
+reasonably certain it produces code that is
+object-compatible with the version of @code{gcc}
+you want to build as part of building @code{g77},
+you can save time and disk space by doing a straight
+build.
+
+To build just the C and Fortran compilers and the
+necessary run-time libraries, issue the following
+command:
+
+@example
+make -k CC=gcc LANGUAGES=f77 all g77
+@end example
+
+(The @samp{g77} target is necessary because the @code{gcc}
+build procedures apparently do not automatically build
+command drivers for languages in subdirectories.
+It's the @samp{all} target that triggers building
+everything except, apparently, the @code{g77} command
+itself.)
+
+If you run into problems using this method, you have
+two options:
+
+@itemize @bullet
+@item
+Abandon this approach and do a bootstrap build.
+
+@item
+Try to make this approach work by diagnosing the
+problems you're running into and retrying.
+@end itemize
+
+Especially if you do the latter, you might consider
+submitting any solutions as bug/fix reports.
+@xref{Trouble,,Known Causes of Trouble with GNU Fortran}.
+
+However, understand that many problems preventing a
+straight build from working are not @code{g77} problems,
+and, in such cases, are not likely to be addressed in
+future versions of @code{g77}.
+
+@node Pre-installation Checks
+@subsection Pre-installation Checks
+@cindex pre-installation checks
+@cindex installing, checking before
+
+Before installing the system, which includes installing
+@code{gcc}, you might want to do some minimum checking
+to ensure that some basic things work.
+
+Here are some commands you can try, and output typically
+printed by them when they work:
+
+@example
+sh# @kbd{cd /usr/src/gcc}
+sh# @kbd{./g77 --driver=./xgcc -B./ -v}
+g77 version 0.5.21
+ ./xgcc -B./ -v -fnull-version -o /tmp/gfa18047 @dots{}
+Reading specs from ./specs
+gcc version 2.7.2.2.f.3
+ ./cpp -lang-c -v -isystem ./include -undef @dots{}
+GNU CPP version 2.7.2.2.f.3 (Linux/Alpha)
+#include "..." search starts here:
+#include <...> search starts here:
+ ./include
+ /usr/local/include
+ /usr/alpha-unknown-linux/include
+ /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.3/include
+ /usr/include
+End of search list.
+ ./f771 /tmp/cca18048.i -fset-g77-defaults -quiet -dumpbase @dots{}
+GNU F77 version 2.7.2.2.f.3 (Linux/Alpha) compiled @dots{}
+GNU Fortran Front End version 0.5.21 compiled: @dots{}
+ as -nocpp -o /tmp/cca180481.o /tmp/cca18048.s
+ ld -G 8 -O1 -o /tmp/gfa18047 /usr/lib/crt0.o -L. @dots{}
+__G77_LIBF77_VERSION__: 0.5.21
+@@(#)LIBF77 VERSION 19970404
+__G77_LIBI77_VERSION__: 0.5.21
+@@(#) LIBI77 VERSION pjw,dmg-mods 19970527
+__G77_LIBU77_VERSION__: 0.5.21
+@@(#) LIBU77 VERSION 19970609
+sh# @kbd{./xgcc -B./ -v -o /tmp/delete-me -xc /dev/null -xnone}
+Reading specs from ./specs
+gcc version 2.7.2.2.f.3
+ ./cpp -lang-c -v -isystem ./include -undef @dots{}
+GNU CPP version 2.7.2.2.f.3 (Linux/Alpha)
+#include "..." search starts here:
+#include <...> search starts here:
+ ./include
+ /usr/local/include
+ /usr/alpha-unknown-linux/include
+ /usr/lib/gcc-lib/alpha-unknown-linux/2.7.2.2.f.3/include
+ /usr/include
+End of search list.
+ ./cc1 /tmp/cca18063.i -quiet -dumpbase null.c -version @dots{}
+GNU C version 2.7.2.2.f.3 (Linux/Alpha) compiled @dots{}
+ as -nocpp -o /tmp/cca180631.o /tmp/cca18063.s
+ ld -G 8 -O1 -o /tmp/delete-me /usr/lib/crt0.o -L. @dots{}
+/usr/lib/crt0.o: In function `__start':
+crt0.S:110: undefined reference to `main'
+/usr/lib/crt0.o(.lita+0x28): undefined reference to `main'
+sh#
+@end example
+
+(Note that long lines have been truncated, and @samp{@dots{}}
+used to indicate such truncations.)
+
+The above two commands test whether @code{g77} and @code{gcc},
+respectively, are able to compile empty (null) source files,
+whether invocation of the C preprocessor works, whether libraries
+can be linked, and so on.
+
+If the output you get from either of the above two commands
+is noticeably different, especially if it is shorter or longer
+in ways that do not look consistent with the above sample
+output, you probably should not install @code{gcc} and @code{g77}
+until you have investigated further.
+
+For example, you could try compiling actual applications and
+seeing how that works.
+(You might want to do that anyway, even if the above tests
+work.)
+
+To compile using the not-yet-installed versions of @code{gcc}
+and @code{g77}, use the following commands to invoke them.
+
+To invoke @code{g77}, type:
+
+@example
+/usr/src/gcc/g77 --driver=/usr/src/gcc/xgcc -B/usr/src/gcc/ @dots{}
+@end example
+
+To invoke @code{gcc}, type:
+
+@example
+/usr/src/gcc/xgcc -B/usr/src/gcc/ @dots{}
+@end example
+
+@node Installation of Binaries
+@subsection Installation of Binaries
+@cindex installation of binaries
+@cindex @code{g77}, installation of
+@cindex @code{gcc}, installation of
+
+After configuring, building, and testing @code{g77} and @code{gcc},
+when you are ready to install them on your system, type:
+
+@example
+make -k CC=gcc LANGUAGES=f77 install
+@end example
+
+As described in @ref{Installation,,Installing GNU CC,
+gcc,Using and Porting GNU CC}, the values for
+the @samp{CC} and @samp{LANGUAGES} macros should
+be the same as those you supplied for the build
+itself.
+
+So, the details of the above command might vary
+if you used a bootstrap build (where you might be
+able to omit both definitions, or might have to
+supply the same definitions you used when building
+the final stage) or if you deviated from the
+instructions for a straight build.
+
+If the above command does not install @file{libf2c.a}
+as expected, try this:
+
+@example
+make -k @dots{} install install-libf77 install-f2c-all
+@end example
+
+We don't know why some non-GNU versions of @code{make} sometimes
+require this alternate command, but they do.
+(Remember to supply the appropriate definitions for @samp{CC} and
+@samp{LANGUAGES} where you see @samp{@dots{}} in the above command.)
+
+Note that using the @samp{-k} option tells @code{make} to
+continue after some installation problems, like not having
+@code{makeinfo} installed on your system.
+It might not be necessary for your system.
+
+@node Updating Documentation
+@subsection Updating Your Info Directory
+@cindex updating info directory
+@cindex info, updating directory
+@cindex directory, updating info
+@pindex /usr/info/dir
+@pindex g77.info
+@cindex texinfo
+@cindex documentation
+
+As part of installing @code{g77}, you should make sure users
+of @code{info} can easily access this manual on-line.
+Do this by making sure a line such as the following exists
+in @file{/usr/info/dir}, or in whatever file is the top-level
+file in the @code{info} directory on your system (perhaps
+@file{/usr/local/info/dir}:
+
+@example
+* g77: (g77). The GNU Fortran programming language.
+@end example
+
+If the menu in @file{dir} is organized into sections, @code{g77}
+probably belongs in a section with a name such as one of
+the following:
+
+@itemize @bullet
+@item
+Fortran Programming
+
+@item
+Writing Programs
+
+@item
+Programming Languages
+
+@item
+Languages Other Than C
+
+@item
+Scientific/Engineering Tools
+
+@item
+GNU Compilers
+@end itemize
+
+@node Missing bison?
+@subsection Missing @code{bison}?
+@cindex @code{bison}
+@cindex missing @code{bison}
+
+If you cannot install @code{bison}, make sure you have started
+with a @emph{fresh} distribution of @code{gcc}, do @emph{not}
+do @samp{make maintainer-clean} (in other versions of @code{gcc},
+this was called @samp{make realclean}), and, to ensure that
+@code{bison} is not invoked by @code{make} during the build,
+type these commands:
+
+@example
+sh# @kbd{cd gcc}
+sh# @kbd{touch bi-parser.c bi-parser.h c-parse.c c-parse.h cexp.c}
+sh# @kbd{touch cp/parse.c cp/parse.h objc-parse.c}
+sh#
+@end example
+
+These commands update the date-time-modified information for
+all the files produced by the various invocations of @code{bison}
+in the current versions of @code{gcc}, so that @code{make} no
+longer believes it needs to update them.
+All of these files should already exist in a @code{gcc}
+distribution, but the application of patches to upgrade
+to a newer version can leave the modification information
+set such that the @code{bison} input files look more ``recent''
+than the corresponding output files.
+
+@emph{Note:} New versions of @code{gcc} might change the set of
+files it generates by invoking @code{bison}---if you cannot figure
+out for yourself how to handle such a situation, try an
+older version of @code{gcc} until you find someone who can
+(or until you obtain and install @code{bison}).
+
+@node Missing makeinfo?
+@subsection Missing @code{makeinfo}?
+@cindex @code{makeinfo}
+@cindex missing @code{makeinfo}
+
+If you cannot install @code{makeinfo}, either use the @code{-k} option when
+invoking make to specify any of the @samp{install} or related targets,
+or specify @samp{MAKEINFO=echo} on the @code{make} command line.
+
+If you fail to do one of these things, some files, like @file{libf2c.a},
+might not be installed, because the failed attempt by @code{make} to
+invoke @code{makeinfo} causes it to cancel any further processing.
+
+@node Distributing Binaries
+@section Distributing Binaries
+@cindex binaries, distributing
+@cindex code, distributing
+
+If you are building @code{g77} for distribution to others in binary form,
+first make sure you are aware of your legal responsibilities (read
+the file @file{gcc/COPYING} thoroughly).
+
+Then, consider your target audience and decide where @code{g77} should
+be installed.
+
+For systems like GNU/Linux that have no native Fortran compiler (or
+where @code{g77} could be considered the native compiler for Fortran and
+@code{gcc} for C, etc.), you should definitely configure
+@code{g77} for installation
+in @file{/usr/bin} instead of @file{/usr/local/bin}.
+Specify the
+@samp{--prefix=/usr} option when running @file{./configure}.
+You might
+also want to set up the distribution so the @code{f77} command is a
+link to @code{g77}---just make an empty file named @file{f77-install-ok} in
+the source or build directory (the one in which the @file{f} directory
+resides, not the @file{f} directory itself) when you specify one of the
+@file{install} or @file{uninstall} targets in a @code{make} command.
+
+For a system that might already have @code{f2c} installed, you definitely
+will want to make another empty file (in the same directory) named
+either @file{f2c-exists-ok} or @file{f2c-install-ok}.
+Use the former if you
+don't want your distribution to overwrite @code{f2c}-related files in existing
+systems; use the latter if you want to improve the likelihood that
+users will be able to use both @code{f2c} and @code{g77} to compile code for a
+single program without encountering link-time or run-time
+incompatibilities.
+
+(Make sure you clearly document, in the ``advertising'' for
+your distribution, how installation of your distribution will
+affect existing installations of @code{gcc}, @code{f2c},
+@code{f77}, @file{libf2c.a}, and so on.
+Similarly, you should clearly document any requirements
+you assume are met by users of your distribution.)
+
+For other systems with native @code{f77} (and @code{cc}) compilers,
+configure @code{g77} as you (or most of your audience) would
+configure @code{gcc} for their installations.
+Typically this is for installation in
+@file{/usr/local}, and would not include a copy of
+@code{g77} named @code{f77}, so
+users could still use the native @code{f77}.
+
+In any case, for @code{g77} to work properly, you @strong{must} ensure
+that the binaries you distribute include:
+
+@table @file
+@item bin/g77
+This is the command most users use to compile Fortran.
+
+@item bin/gcc
+This is the command all users use to compile Fortran, either
+directly or indirectly via the @code{g77} command.
+The @file{bin/gcc} executable file must have been built
+from a @code{gcc} source tree into which a @code{g77} source
+tree was merged and configured, or it will not know how
+to compile Fortran programs.
+
+@item bin/f77
+In installations with no non-GNU native Fortran
+compiler, this is the same as @file{bin/g77}.
+Otherwise, it should be omitted from the distribution,
+so the one on already on a particular system does
+not get overwritten.
+
+@item info/g77.info*
+This is the documentation for @code{g77}.
+If it is not included, users will have trouble understanding
+diagnostics messages and other such things, and will send
+you a lot of email asking questions.
+
+Please edit this documentation (by editing @file{gcc/f/*.texi}
+and doing @samp{make doc} from the @file{/usr/src/gcc} directory)
+to reflect any changes you've made to @code{g77}, or at
+least to encourage users of your binary distribution to
+report bugs to you first.
+
+Also, whether you distribute binaries or install @code{g77}
+on your own system, it might be helpful for everyone to
+add a line listing this manual by name and topic to the
+top-level @code{info} node in @file{/usr/info/dir}.
+That way, users can find @code{g77} documentation more
+easily.
+@xref{Updating Documentation,,Updating Your Info Directory}.
+
+@item man/man1/g77.1
+This is the short man page for @code{g77}.
+It is out of date, but you might as well include it
+for people who really like man pages.
+
+@item man/man1/f77.1
+In installations where @code{f77} is the same as @code{g77},
+this is the same as @file{man/man1/g77.1}.
+Otherwise, it should be omitted from the distribution,
+so the one already on a particular system does not
+get overwritten.
+
+@item lib/gcc-lib/@dots{}/f771
+This is the actual Fortran compiler.
+
+@item lib/gcc-lib/@dots{}/libf2c.a
+This is the run-time library for @code{g77}-compiled programs.
+@end table
+
+Whether you want to include the slightly updated (and possibly
+improved) versions of @code{cc1}, @code{cc1plus}, and whatever other
+binaries get rebuilt with the changes the GNU Fortran distribution
+makes to the GNU back end, is up to you.
+These changes are
+highly unlikely to break any compilers, and it is possible
+they'll fix back-end bugs that can be demonstrated using front
+ends other than GNU Fortran's.
+
+Please assure users that unless
+they have a specific need for their existing,
+older versions of @code{gcc} command,
+they are unlikely to experience any problems by overwriting
+it with your version---though they could certainly protect
+themselves by making backup copies first!
+Otherwise, users might try and install your binaries
+in a ``safe'' place, find they cannot compile Fortran
+programs with your distribution (because, perhaps, they're
+picking up their old version of the @code{gcc} command,
+which does not recognize Fortran programs), and assume
+that your binaries (or, more generally, GNU Fortran
+distributions in general) are broken, at least for their
+system.
+
+Finally, @strong{please} ask for bug reports to go to you first, at least
+until you're sure your distribution is widely used and has been
+well tested.
+This especially goes for those of you making any
+changes to the @code{g77} sources to port @code{g77}, e.g. to OS/2.
+@email{fortran@@gnu.ai.mit.edu} has received a fair number of bug
+reports that turned out to be problems with other peoples' ports
+and distributions, about which nothing could be done for the
+user.
+Once you are quite certain a bug report does not involve
+your efforts, you can forward it to us.
diff --git a/gcc/f/install0.texi b/gcc/f/install0.texi
new file mode 100644
index 00000000000..cfb59bf0219
--- /dev/null
+++ b/gcc/f/install0.texi
@@ -0,0 +1,14 @@
+@setfilename INSTALL
+@set INSTALLONLY
+
+@c The immediately following lines apply to the INSTALL file
+@c which is generated using this file.
+This file contains installation information for the GNU Fortran compiler.
+Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+You may copy, distribute, and modify it freely as long as you preserve
+this copyright notice and permission notice.
+
+@node Top,,, (dir)
+@chapter Installing GNU Fortran
+@include install.texi
+@bye
diff --git a/gcc/f/intdoc.c b/gcc/f/intdoc.c
new file mode 100644
index 00000000000..ff9a6f9bb4f
--- /dev/null
+++ b/gcc/f/intdoc.c
@@ -0,0 +1,1339 @@
+/* intdoc.c
+ Copyright (C) 1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+/* From f/proj.h, which uses #error -- not all C compilers
+ support that, and we want _this_ program to be compilable
+ by pretty much any C compiler. */
+
+#include "assert.j" /* Use gcc's assert.h. */
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#define FFEINTRIN_DOC 1
+#include "intrin.h"
+
+typedef enum
+ {
+#if !defined(false) || !defined(true)
+ false = 0, true = 1,
+#endif
+#if !defined(FALSE) || !defined(TRUE)
+ FALSE = 0, TRUE = 1,
+#endif
+ Doggone_Trailing_Comma_Dont_Work = 1
+ } bool;
+
+#define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0]))
+
+char *family_name (ffeintrinFamily family);
+static void dumpif (ffeintrinFamily fam);
+static void dumpendif (void);
+static void dumpclearif (void);
+static void dumpem (void);
+static void dumpgen (int menu, char *name, char *name_uc,
+ ffeintrinGen gen);
+static void dumpspec (int menu, char *name, char *name_uc,
+ ffeintrinSpec spec);
+static void dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family,
+ ffeintrinImp imp, ffeintrinSpec spec);
+static char *argument_info_ptr (ffeintrinImp imp, int argno);
+static char *argument_info_string (ffeintrinImp imp, int argno);
+static char *argument_name_ptr (ffeintrinImp imp, int argno);
+static char *argument_name_string (ffeintrinImp imp, int argno);
+#if 0
+static char *elaborate_if_complex (ffeintrinImp imp, int argno);
+static char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno);
+static char *elaborate_if_real (ffeintrinImp imp, int argno);
+#endif
+static void print_type_string (char *c);
+
+int
+main (int argc, char **argv __attribute__ ((unused)))
+{
+ if (argc != 1)
+ {
+ fprintf (stderr, "\
+Usage: intdoc > intdoc.texi
+ Collects and dumps documentation on g77 intrinsics
+ to the file named intdoc.texi.\n");
+ exit (1);
+ }
+
+ dumpem ();
+ return 0;
+}
+
+struct _ffeintrin_name_
+ {
+ char *name_uc;
+ char *name_lc;
+ char *name_ic;
+ ffeintrinGen generic;
+ ffeintrinSpec specific;
+ };
+
+struct _ffeintrin_gen_
+ {
+ char *name; /* Name as seen in program. */
+ ffeintrinSpec specs[2];
+ };
+
+struct _ffeintrin_spec_
+ {
+ char *name; /* Uppercase name as seen in source code,
+ lowercase if no source name, "none" if no
+ name at all (NONE case). */
+ bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */
+ ffeintrinFamily family;
+ ffeintrinImp implementation;
+ };
+
+struct _ffeintrin_imp_
+ {
+ char *name; /* Name of implementation. */
+#if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+ ffecomGfrt gfrt; /* gfrt index in library. */
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+ char *control;
+ };
+
+static struct _ffeintrin_name_ names[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
+ { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static struct _ffeintrin_gen_ gens[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
+ { NAME, { SPEC1, SPEC2, }, },
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static struct _ffeintrin_imp_ imps[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+ { NAME, FFECOM_gfrt ## GFRT, CONTROL },
+#elif 1 /* FFECOM_targetCURRENT == FFECOM_targetFFE */
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+ { NAME, CONTROL },
+#else
+#error
+#endif
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static struct _ffeintrin_spec_ specs[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
+ { NAME, CALLABLE, FAMILY, IMP, },
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#include "intrin.def"
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+struct cc_pair { ffeintrinImp imp; char *text; };
+
+static char *descriptions[FFEINTRIN_imp] = { 0 };
+static struct cc_pair cc_descriptions[] = {
+#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION },
+#include "intdoc.h"
+#undef DEFDOC
+};
+
+static char *summaries[FFEINTRIN_imp] = { 0 };
+static struct cc_pair cc_summaries[] = {
+#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY },
+#include "intdoc.h"
+#undef DEFDOC
+};
+
+char *
+family_name (ffeintrinFamily family)
+{
+ switch (family)
+ {
+ case FFEINTRIN_familyF77:
+ return "familyF77";
+
+ case FFEINTRIN_familyASC:
+ return "familyASC";
+
+ case FFEINTRIN_familyMIL:
+ return "familyMIL";
+
+ case FFEINTRIN_familyGNU:
+ return "familyGNU";
+
+ case FFEINTRIN_familyF90:
+ return "familyF90";
+
+ case FFEINTRIN_familyVXT:
+ return "familyVXT";
+
+ case FFEINTRIN_familyFVZ:
+ return "familyFVZ";
+
+ case FFEINTRIN_familyF2C:
+ return "familyF2C";
+
+ case FFEINTRIN_familyF2U:
+ return "familyF2U";
+
+ case FFEINTRIN_familyBADU77:
+ return "familyBADU77";
+
+ default:
+ assert ("bad family" == NULL);
+ return "??";
+ }
+}
+
+static int in_ifset = 0;
+static ffeintrinFamily latest_family = FFEINTRIN_familyNONE;
+
+static void
+dumpif (ffeintrinFamily fam)
+{
+ assert (fam != FFEINTRIN_familyNONE);
+ if ((in_ifset != 2)
+ || (fam != latest_family))
+ {
+ if (in_ifset == 2)
+ printf ("@end ifset\n");
+ latest_family = fam;
+ printf ("@ifset %s\n", family_name (fam));
+ }
+ in_ifset = 1;
+}
+
+static void
+dumpendif ()
+{
+ in_ifset = 2;
+}
+
+static void
+dumpclearif ()
+{
+ if ((in_ifset == 2)
+ || (latest_family != FFEINTRIN_familyNONE))
+ printf ("@end ifset\n");
+ latest_family = FFEINTRIN_familyNONE;
+ in_ifset = 0;
+}
+
+static void
+dumpem ()
+{
+ int i;
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_descriptions); ++i)
+ {
+ assert (descriptions[cc_descriptions[i].imp] == NULL);
+ descriptions[cc_descriptions[i].imp] = cc_descriptions[i].text;
+ }
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_summaries); ++i)
+ {
+ assert (summaries[cc_summaries[i].imp] == NULL);
+ summaries[cc_summaries[i].imp] = cc_summaries[i].text;
+ }
+
+ printf ("@menu\n");
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
+ {
+ if (names[i].generic != FFEINTRIN_genNONE)
+ dumpgen (1, names[i].name_ic, names[i].name_uc,
+ names[i].generic);
+ if (names[i].specific != FFEINTRIN_specNONE)
+ dumpspec (1, names[i].name_ic, names[i].name_uc,
+ names[i].specific);
+ }
+ dumpclearif ();
+
+ printf ("@end menu\n\n");
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
+ {
+ if (names[i].generic != FFEINTRIN_genNONE)
+ dumpgen (0, names[i].name_ic, names[i].name_uc,
+ names[i].generic);
+ if (names[i].specific != FFEINTRIN_specNONE)
+ dumpspec (0, names[i].name_ic, names[i].name_uc,
+ names[i].specific);
+ }
+ dumpclearif ();
+}
+
+static void
+dumpgen (int menu, char *name, char *name_uc, ffeintrinGen gen)
+{
+ size_t i;
+ int total;
+
+ if (!menu)
+ {
+ for (total = 0, i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
+ {
+ if (gens[gen].specs[i] != FFEINTRIN_specNONE)
+ ++total;
+ }
+ }
+
+ for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
+ {
+ ffeintrinSpec spec;
+ size_t j;
+
+ if ((spec = gens[gen].specs[i]) == FFEINTRIN_specNONE)
+ continue;
+
+ dumpif (specs[spec].family);
+ dumpimp (menu, name, name_uc, i, specs[spec].family, specs[spec].implementation,
+ spec);
+ if (!menu && (total > 0))
+ {
+ if (total == 1)
+ {
+ printf ("\
+For information on another intrinsic with the same name:\n");
+ }
+ else
+ {
+ printf ("\
+For information on other intrinsics with the same name:\n");
+ }
+ for (j = 0; j < ARRAY_SIZE (gens[gen].specs); ++j)
+ {
+ if (j == i)
+ continue;
+ if ((spec = gens[gen].specs[j]) == FFEINTRIN_specNONE)
+ continue;
+ printf ("@xref{%s Intrinsic (%s)}.\n",
+ name, specs[spec].name);
+ }
+ printf ("\n");
+ }
+ dumpendif ();
+ }
+}
+
+static void
+dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec)
+{
+ dumpif (specs[spec].family);
+ dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation,
+ FFEINTRIN_specNONE);
+ dumpendif ();
+}
+
+static void
+dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp,
+ ffeintrinSpec spec)
+{
+ char *c;
+ bool subr;
+ char *argc;
+ char *argi;
+ int colon;
+ int argno;
+
+ assert ((imp != FFEINTRIN_impNONE) || !genno);
+
+ if (menu)
+ {
+ printf ("* %s Intrinsic",
+ name);
+ if (spec != FFEINTRIN_specNONE)
+ printf (" (%s)", specs[spec].name); /* See XYZZY1 below */
+ printf ("::");
+#define INDENT_SUMMARY 24
+ if ((imp == FFEINTRIN_impNONE)
+ || (summaries[imp] != NULL))
+ {
+ int spaces = INDENT_SUMMARY - 14 - strlen (name);
+ char *c;
+
+ if (spec != FFEINTRIN_specNONE)
+ spaces -= (3 + strlen (specs[spec].name)); /* See XYZZY1 above */
+ if (spaces < 1)
+ spaces = 1;
+ while (spaces--)
+ fputc (' ', stdout);
+
+ if (imp == FFEINTRIN_impNONE)
+ {
+ printf ("(Reserved for future use.)\n");
+ return;
+ }
+
+ for (c = summaries[imp]; c[0] != '\0'; ++c)
+ {
+ if ((c[0] == '@')
+ && (c[1] >= '0')
+ && (c[1] <= '9'))
+ {
+ int argno = c[1] - '0';
+
+ c += 2;
+ while ((c[0] >= '0')
+ && (c[0] <= '9'))
+ {
+ argno = 10 * argno + (c[0] - '0');
+ ++c;
+ }
+ assert (c[0] == '@');
+ if (argno == 0)
+ printf ("%s", name);
+ else if (argno == 99)
+ { /* Yeah, this is a major kludge. */
+ printf ("\n");
+ spaces = INDENT_SUMMARY + 1;
+ while (spaces--)
+ fputc (' ', stdout);
+ }
+ else
+ printf ("%s", argument_name_string (imp, argno - 1));
+ }
+ else
+ fputc (c[0], stdout);
+ }
+ }
+ printf ("\n");
+ return;
+ }
+
+ printf ("@node %s Intrinsic", name);
+ if (spec != FFEINTRIN_specNONE)
+ printf (" (%s)", specs[spec].name);
+ printf ("\n@subsubsection %s Intrinsic", name);
+ if (spec != FFEINTRIN_specNONE)
+ printf (" (%s)", specs[spec].name);
+ printf ("\n@cindex %s intrinsic\n@cindex intrinsics, %s\n",
+ name, name);
+
+ if (imp == FFEINTRIN_impNONE)
+ {
+ printf ("
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL %s} to use this name for an
+external procedure.
+
+",
+ name);
+ return;
+ }
+
+ c = imps[imp].control;
+ subr = (c[0] == '-');
+ colon = (c[2] == ':') ? 2 : 3;
+
+ printf ("
+@noindent
+@example
+%s%s(",
+ (subr ? "CALL " : ""), name);
+
+ fflush (stdout);
+
+ for (argno = 0; ; ++argno)
+ {
+ argc = argument_name_ptr (imp, argno);
+ if (argc == NULL)
+ break;
+ if (argno > 0)
+ printf (", ");
+ printf ("@var{%s}", argc);
+ argi = argument_info_string (imp, argno);
+ if ((argi[0] == '*')
+ || (argi[0] == 'n')
+ || (argi[0] == '+')
+ || (argi[0] == 'p'))
+ printf ("-1, @var{%s}-2, @dots{}, @var{%s}-n",
+ argc, argc);
+ }
+
+ printf (")
+@end example\n
+");
+
+ if (!subr)
+ {
+ int other_arg;
+ char *arg_string;
+ char *arg_info;
+
+ if ((c[colon + 1] >= '0')
+ && (c[colon + 1] <= '9'))
+ {
+ other_arg = c[colon + 1] - '0';
+ arg_string = argument_name_string (imp, other_arg);
+ arg_info = argument_info_string (imp, other_arg);
+ }
+ else
+ {
+ other_arg = -1;
+ arg_string = NULL;
+ arg_info = NULL;
+ }
+
+ printf ("\
+@noindent
+%s: ", name);
+ print_type_string (c);
+ printf (" function");
+
+ if ((c[0] == 'R')
+ && (c[1] == 'C'))
+ {
+ assert (other_arg >= 0);
+
+ if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
+ || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
+ ++arg_info;
+ if ((arg_info[0] == 'F') || (arg_info[0] == 'N'))
+ printf (".
+The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is
+any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.
+When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},
+this intrinsic is valid only when used as the argument to
+@code{REAL()}, as explained below.\n\n",
+ arg_string,
+ arg_string);
+ else
+ printf (".
+This intrinsic is valid when argument @var{%s} is
+@code{COMPLEX(KIND=1)}.
+When @var{%s} is any other @code{COMPLEX} type,
+this intrinsic is valid only when used as the argument to
+@code{REAL()}, as explained below.\n\n",
+ arg_string,
+ arg_string);
+ }
+#if 0
+ else if ((c[0] == 'I')
+ && (c[1] == 'p'))
+ printf (", the exact type being wide enough to hold a pointer
+on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n");
+#endif
+ else if ((c[1] == '=')
+ && (c[colon + 1] >= '0')
+ && (c[colon + 1] <= '9'))
+ {
+ assert (other_arg >= 0);
+
+ if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
+ || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
+ ++arg_info;
+
+ if (((c[0] == arg_info[0])
+ && ((c[0] == 'A') || (c[0] == 'C') || (c[0] == 'I')
+ || (c[0] == 'L') || (c[0] == 'R')))
+ || ((c[0] == 'R')
+ && (arg_info[0] == 'C'))
+ || ((c[0] == 'C')
+ && (arg_info[0] == 'R')))
+ printf (", the @samp{KIND=} value of the type being that of argument @var{%s}.\n\n",
+ arg_string);
+ else if ((c[0] == 'S')
+ && ((arg_info[0] == 'C')
+ || (arg_info[0] == 'F')
+ || (arg_info[0] == 'N')))
+ printf (".
+The exact type depends on that of argument @var{%s}---if @var{%s} is
+@code{COMPLEX}, this function's type is @code{REAL}
+with the same @samp{KIND=} value as the type of @var{%s}.
+Otherwise, this function's type is the same as that of @var{%s}.\n\n",
+ arg_string, arg_string, arg_string, arg_string);
+ else
+ printf (", the exact type being that of argument @var{%s}.\n\n",
+ arg_string);
+ }
+ else if ((c[1] == '=')
+ && (c[colon + 1] == '*'))
+ printf (", the exact type being the result of cross-promoting the
+types of all the arguments.\n\n");
+ else if (c[1] == '=')
+ assert ("?0:?:" == NULL);
+ else
+ printf (".\n\n");
+ }
+
+ for (argno = 0, argc = &c[colon + 3]; *argc != '\0'; ++argno)
+ {
+ char optionality = '\0';
+ char extra = '\0';
+ char basic;
+ char kind;
+ int length;
+ int elements;
+
+ printf ("\
+@noindent
+@var{");
+ for (; ; ++argc)
+ {
+ if (argc[0] == '=')
+ break;
+ printf ("%c", *argc);
+ }
+ printf ("}: ");
+
+ ++argc;
+ if ((*argc == '?')
+ || (*argc == '!')
+ || (*argc == '*')
+ || (*argc == '+')
+ || (*argc == 'n')
+ || (*argc == 'p'))
+ optionality = *(argc++);
+ basic = *(argc++);
+ kind = *(argc++);
+ if (*argc == '[')
+ {
+ length = *++argc - '0';
+ if (*++argc != ']')
+ length = 10 * length + (*(argc++) - '0');
+ ++argc;
+ }
+ else
+ length = -1;
+ if (*argc == '(')
+ {
+ elements = *++argc - '0';
+ if (*++argc != ')')
+ elements = 10 * elements + (*(argc++) - '0');
+ ++argc;
+ }
+ else if (*argc == '&')
+ {
+ elements = -1;
+ ++argc;
+ }
+ else
+ elements = 0;
+ if ((*argc == '&')
+ || (*argc == 'i')
+ || (*argc == 'w')
+ || (*argc == 'x'))
+ extra = *(argc++);
+ if (*argc == ',')
+ ++argc;
+
+ switch (basic)
+ {
+ case '-':
+ switch (kind)
+ {
+ case '*':
+ printf ("Any type");
+ break;
+
+ default:
+ assert ("kind arg" == NULL);
+ break;
+ }
+ break;
+
+ case 'A':
+ assert ((kind == '1') || (kind == '*'));
+ printf ("@code{CHARACTER");
+ if (length != -1)
+ printf ("*%d", length);
+ printf ("}");
+ break;
+
+ case 'C':
+ switch (kind)
+ {
+ case '*':
+ printf ("@code{COMPLEX}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
+ break;
+
+ case 'A':
+ printf ("Same @samp{KIND=} value as for @var{%s}",
+ argument_name_string (imp, 0));
+ break;
+
+ default:
+ assert ("Ca" == NULL);
+ break;
+ }
+ break;
+
+ case 'I':
+ switch (kind)
+ {
+ case '*':
+ printf ("@code{INTEGER}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
+ break;
+
+ case 'A':
+ printf ("@code{INTEGER} with same @samp{KIND=} value as for @var{%s}",
+ argument_name_string (imp, 0));
+ break;
+
+ case 'p':
+ printf ("@code{INTEGER} wide enough to hold a pointer");
+ break;
+
+ default:
+ assert ("Ia" == NULL);
+ break;
+ }
+ break;
+
+ case 'L':
+ switch (kind)
+ {
+ case '*':
+ printf ("@code{LOGICAL}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
+ break;
+
+ case 'A':
+ printf ("@code{LOGICAL} with same @samp{KIND=} value as for @var{%s}",
+ argument_name_string (imp, 0));
+ break;
+
+ default:
+ assert ("La" == NULL);
+ break;
+ }
+ break;
+
+ case 'R':
+ switch (kind)
+ {
+ case '*':
+ printf ("@code{REAL}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{REAL(KIND=%d)}", (kind - '0'));
+ break;
+
+ case 'A':
+ printf ("@code{REAL} with same @samp{KIND=} value as for @var{%s}",
+ argument_name_string (imp, 0));
+ break;
+
+ default:
+ assert ("Ra" == NULL);
+ break;
+ }
+ break;
+
+ case 'B':
+ switch (kind)
+ {
+ case '*':
+ printf ("@code{INTEGER} or @code{LOGICAL}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
+ (kind - '0'), (kind - '0'));
+ break;
+
+ case 'A':
+ printf ("Same type and @samp{KIND=} value as for @var{%s}",
+ argument_name_string (imp, 0));
+ break;
+
+ default:
+ assert ("Ba" == NULL);
+ break;
+ }
+ break;
+
+ case 'F':
+ switch (kind)
+ {
+ case '*':
+ printf ("@code{REAL} or @code{COMPLEX}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
+ (kind - '0'), (kind - '0'));
+ break;
+
+ case 'A':
+ printf ("Same type as @var{%s}",
+ argument_name_string (imp, 0));
+ break;
+
+ default:
+ assert ("Fa" == NULL);
+ break;
+ }
+ break;
+
+ case 'N':
+ switch (kind)
+ {
+ case '*':
+ printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
+ (kind - '0'), (kind - '0'), (kind - '0'));
+ break;
+
+ default:
+ assert ("N1" == NULL);
+ break;
+ }
+ break;
+
+ case 'S':
+ switch (kind)
+ {
+ case '*':
+ printf ("@code{INTEGER} or @code{REAL}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
+ (kind - '0'), (kind - '0'));
+ break;
+
+ case 'A':
+ printf ("@code{INTEGER} or @code{REAL} with same @samp{KIND=} value as for @var{%s}",
+ argument_name_string (imp, 0));
+ break;
+
+ default:
+ assert ("Sa" == NULL);
+ break;
+ }
+ break;
+
+ case 'g':
+ printf ("@samp{*@var{label}}, where @var{label} is the label
+of an executable statement");
+ break;
+
+ case 's':
+ printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+or dummy/global @code{INTEGER(KIND=1)} scalar");
+ break;
+
+ default:
+ assert ("arg type?" == NULL);
+ break;
+ }
+
+ switch (optionality)
+ {
+ case '\0':
+ break;
+
+ case '!':
+ printf ("; OPTIONAL (must be omitted if @var{%s} is @code{COMPLEX})",
+ argument_name_string (imp, argno-1));
+ break;
+
+ case '?':
+ printf ("; OPTIONAL");
+ break;
+
+ case '*':
+ printf ("; OPTIONAL");
+ break;
+
+ case 'n':
+ case '+':
+ break;
+
+ case 'p':
+ printf ("; at least two such arguments must be provided");
+ break;
+
+ default:
+ assert ("optionality!" == NULL);
+ break;
+ }
+
+ switch (elements)
+ {
+ case -1:
+ break;
+
+ case 0:
+ if ((basic != 'g')
+ && (basic != 's'))
+ printf ("; scalar");
+ break;
+
+ default:
+ assert (extra != '\0');
+ printf ("; DIMENSION(%d)", elements);
+ break;
+ }
+
+ switch (extra)
+ {
+ case '\0':
+ if ((basic != 'g')
+ && (basic != 's'))
+ printf ("; INTENT(IN)");
+ break;
+
+ case 'i':
+ break;
+
+ case '&':
+ printf ("; cannot be a constant or expression");
+ break;
+
+ case 'w':
+ printf ("; INTENT(OUT)");
+ break;
+
+ case 'x':
+ printf ("; INTENT(INOUT)");
+ break;
+ }
+
+ printf (".\n\n");
+ }
+
+ printf ("\
+@noindent
+Intrinsic groups: ");
+ switch (family)
+ {
+ case FFEINTRIN_familyF77:
+ printf ("(standard FORTRAN 77).");
+ break;
+
+ case FFEINTRIN_familyGNU:
+ printf ("@code{gnu}.");
+ break;
+
+ case FFEINTRIN_familyASC:
+ printf ("@code{f2c}, @code{f90}.");
+ break;
+
+ case FFEINTRIN_familyMIL:
+ printf ("@code{mil}, @code{f90}, @code{vxt}.");
+ break;
+
+ case FFEINTRIN_familyF90:
+ printf ("@code{f90}.");
+ break;
+
+ case FFEINTRIN_familyVXT:
+ printf ("@code{vxt}.");
+ break;
+
+ case FFEINTRIN_familyFVZ:
+ printf ("@code{f2c}, @code{vxt}.");
+ break;
+
+ case FFEINTRIN_familyF2C:
+ printf ("@code{f2c}.");
+ break;
+
+ case FFEINTRIN_familyF2U:
+ printf ("@code{unix}.");
+ break;
+
+ case FFEINTRIN_familyBADU77:
+ printf ("@code{badu77}.");
+ break;
+
+ default:
+ assert ("bad family" == NULL);
+ printf ("@code{???}.");
+ break;
+ }
+ printf ("\n\n");
+
+ if (descriptions[imp] != NULL)
+ {
+ char *c = descriptions[imp];
+
+ printf ("\
+@noindent
+Description:
+\n");
+
+ while (c[0] != '\0')
+ {
+ if ((c[0] == '@')
+ && (c[1] >= '0')
+ && (c[1] <= '9'))
+ {
+ int argno = c[1] - '0';
+
+ c += 2;
+ while ((c[0] >= '0')
+ && (c[0] <= '9'))
+ {
+ argno = 10 * argno + (c[0] - '0');
+ ++c;
+ }
+ assert (c[0] == '@');
+ if (argno == 0)
+ printf ("%s", name_uc);
+ else
+ printf ("%s", argument_name_string (imp, argno - 1));
+ }
+ else
+ fputc (c[0], stdout);
+ ++c;
+ }
+
+ printf ("\n");
+ }
+}
+
+static char *
+argument_info_ptr (ffeintrinImp imp, int argno)
+{
+ char *c = imps[imp].control;
+ static char arginfos[8][32];
+ static int argx = 0;
+ int i;
+
+ if (c[2] == ':')
+ c += 5;
+ else
+ c += 6;
+
+ while (argno--)
+ {
+ while ((c[0] != ',') && (c[0] != '\0'))
+ ++c;
+ if (c[0] != ',')
+ break;
+ ++c;
+ }
+
+ if (c[0] == '\0')
+ return NULL;
+
+ for (; (c[0] != '=') && (c[0] != '\0'); ++c)
+ ;
+
+ assert (c[0] == '=');
+
+ for (i = 0, ++c; (c[0] != ',') && (c[0] != '\0'); ++c, ++i)
+ arginfos[argx][i] = c[0];
+
+ arginfos[argx][i] = '\0';
+
+ c = &arginfos[argx][0];
+ ++argx;
+ if (((size_t) argx) >= ARRAY_SIZE (arginfos))
+ argx = 0;
+
+ return c;
+}
+
+static char *
+argument_info_string (ffeintrinImp imp, int argno)
+{
+ char *p;
+
+ p = argument_info_ptr (imp, argno);
+ assert (p != NULL);
+ return p;
+}
+
+static char *
+argument_name_ptr (ffeintrinImp imp, int argno)
+{
+ char *c = imps[imp].control;
+ static char argnames[8][32];
+ static int argx = 0;
+ int i;
+
+ if (c[2] == ':')
+ c += 5;
+ else
+ c += 6;
+
+ while (argno--)
+ {
+ while ((c[0] != ',') && (c[0] != '\0'))
+ ++c;
+ if (c[0] != ',')
+ break;
+ ++c;
+ }
+
+ if (c[0] == '\0')
+ return NULL;
+
+ for (i = 0; (c[0] != '=') && (c[0] != '\0'); ++c, ++i)
+ argnames[argx][i] = c[0];
+
+ assert (c[0] == '=');
+ argnames[argx][i] = '\0';
+
+ c = &argnames[argx][0];
+ ++argx;
+ if (((size_t) argx) >= ARRAY_SIZE (argnames))
+ argx = 0;
+
+ return c;
+}
+
+static char *
+argument_name_string (ffeintrinImp imp, int argno)
+{
+ char *p;
+
+ p = argument_name_ptr (imp, argno);
+ assert (p != NULL);
+ return p;
+}
+
+static void
+print_type_string (char *c)
+{
+ char basic = c[0];
+ char kind = c[1];
+
+ switch (basic)
+ {
+ case 'A':
+ assert ((kind == '1') || (kind == '='));
+ if (c[2] == ':')
+ printf ("@code{CHARACTER*1}");
+ else
+ {
+ assert (c[2] == '*');
+ printf ("@code{CHARACTER*(*)}");
+ }
+ break;
+
+ case 'C':
+ switch (kind)
+ {
+ case '=':
+ printf ("@code{COMPLEX}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
+ break;
+
+ default:
+ assert ("Ca" == NULL);
+ break;
+ }
+ break;
+
+ case 'I':
+ switch (kind)
+ {
+ case '=':
+ printf ("@code{INTEGER}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
+ break;
+
+ case 'p':
+ printf ("@code{INTEGER(KIND=0)}");
+ break;
+
+ default:
+ assert ("Ia" == NULL);
+ break;
+ }
+ break;
+
+ case 'L':
+ switch (kind)
+ {
+ case '=':
+ printf ("@code{LOGICAL}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
+ break;
+
+ default:
+ assert ("La" == NULL);
+ break;
+ }
+ break;
+
+ case 'R':
+ switch (kind)
+ {
+ case '=':
+ printf ("@code{REAL}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{REAL(KIND=%d)}", (kind - '0'));
+ break;
+
+ case 'C':
+ printf ("@code{REAL}");
+ break;
+
+ default:
+ assert ("Ra" == NULL);
+ break;
+ }
+ break;
+
+ case 'B':
+ switch (kind)
+ {
+ case '=':
+ printf ("@code{INTEGER} or @code{LOGICAL}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
+ (kind - '0'), (kind - '0'));
+ break;
+
+ default:
+ assert ("Ba" == NULL);
+ break;
+ }
+ break;
+
+ case 'F':
+ switch (kind)
+ {
+ case '=':
+ printf ("@code{REAL} or @code{COMPLEX}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
+ (kind - '0'), (kind - '0'));
+ break;
+
+ default:
+ assert ("Fa" == NULL);
+ break;
+ }
+ break;
+
+ case 'N':
+ switch (kind)
+ {
+ case '=':
+ printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
+ (kind - '0'), (kind - '0'), (kind - '0'));
+ break;
+
+ default:
+ assert ("N1" == NULL);
+ break;
+ }
+ break;
+
+ case 'S':
+ switch (kind)
+ {
+ case '=':
+ printf ("@code{INTEGER} or @code{REAL}");
+ break;
+
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
+ (kind - '0'), (kind - '0'));
+ break;
+
+ default:
+ assert ("Sa" == NULL);
+ break;
+ }
+ break;
+
+ default:
+ assert ("arg type?" == NULL);
+ break;
+ }
+}
diff --git a/gcc/f/intdoc.h b/gcc/f/intdoc.h
new file mode 100644
index 00000000000..58b4007f7d5
--- /dev/null
+++ b/gcc/f/intdoc.h
@@ -0,0 +1,2370 @@
+/* Copyright (C) 1997 Free Software Foundation, Inc.
+ * This is part of the G77 manual.
+ * For copying conditions, see the file g77.texi. */
+
+/* This is the file containing the verbage for the
+ intrinsics. It consists of a data base built up
+ via DEFDOC macros of the form:
+
+ DEFDOC (IMP, SUMMARY, DESCRIPTION)
+
+ IMP is the implementation keyword used in the intrin module.
+ SUMMARY is the short summary to go in the "* Menu:" section
+ of the Info document. DESCRIPTION is the longer description
+ to go in the documentation itself.
+
+ Note that IMP is leveraged across multiple intrinsic names.
+
+ To make for more accurate and consistent documentation,
+ the translation made by intdoc.c of the text in SUMMARY
+ and DESCRIPTION includes the special sequence
+
+ @ARGNO@
+
+ where ARGNO is a series of digits forming a number that
+ is substituted by intdoc.c as follows:
+
+ 0 The initial-caps form of the intrinsic name (e.g. Float).
+ 1-98 The initial-caps form of the ARGNO'th argument.
+ 99 (SUMMARY only) a newline plus the appropriate # of spaces.
+
+ Hope this info is enough to encourage people to feel free to
+ add documentation to this file!
+
+*/
+
+/* ~~~~~ to do:
+ ALARM
+*/
+
+#define ARCHAIC(upper,mixed) \
+ "Archaic form of @code{" #upper "()} that is specific\n\
+to one type for @var{@1@}.\n\
+@xref{" #mixed " Intrinsic}.\n"
+
+#define ARCHAIC_2nd(upper,mixed) \
+ "Archaic form of @code{" #upper "()} that is specific\n\
+to one type for @var{@2@}.\n\
+@xref{" #mixed " Intrinsic}.\n"
+
+#define ARCHAIC_2(upper,mixed) \
+ "Archaic form of @code{" #upper "()} that is specific\n\
+to one type for @var{@1@} and @var{@2@}.\n\
+@xref{" #mixed " Intrinsic}.\n"
+
+DEFDOC (ABS, "Absolute value.", "\
+Returns the absolute value of @var{@1@}.
+
+If @var{@1@} is type @code{COMPLEX}, the absolute
+value is computed as:
+
+@example
+SQRT(REALPART(@var{@1@})**2, IMAGPART(@var{@1@})**2)
+@end example
+
+@noindent
+Otherwise, it is computed by negating the @var{@1@} if
+it is negative, or returning @var{@1@}.
+
+@xref{Sign Intrinsic}, for how to explicitly
+compute the positive or negative form of the absolute
+value of an expression.
+")
+
+DEFDOC (CABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
+
+DEFDOC (DABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
+
+DEFDOC (IABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
+
+DEFDOC (CDABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
+
+DEFDOC (ACHAR, "ASCII character from code.", "\
+Returns the ASCII character corresponding to the
+code specified by @var{@1@}.
+
+@xref{IAChar Intrinsic}, for the inverse of this function.
+
+@xref{Char Intrinsic}, for the function corresponding
+to the system's native character set.
+")
+
+DEFDOC (IACHAR, "ASCII code for character.", "\
+Returns the code for the ASCII character in the
+first character position of @var{@1@}.
+
+@xref{AChar Intrinsic}, for the inverse of this function.
+
+@xref{IChar Intrinsic}, for the function corresponding
+to the system's native character set.
+")
+
+DEFDOC (CHAR, "Character from code.", "\
+Returns the character corresponding to the
+code specified by @var{@1@}, using the system's
+native character set.
+
+Because the system's native character set is used,
+the correspondence between character and their codes
+is not necessarily the same between GNU Fortran
+implementations.
+
+Note that no intrinsic exists to convert a numerical
+value to a printable character string.
+For example, there is no intrinsic that, given
+an @code{INTEGER} or @code{REAL} argument with the
+value @samp{154}, returns the @code{CHARACTER}
+result @samp{'154'}.
+
+Instead, you can use internal-file I/O to do this kind
+of conversion.
+For example:
+
+@smallexample
+INTEGER VALUE
+CHARACTER*10 STRING
+VALUE = 154
+WRITE (STRING, '(I10)'), VALUE
+PRINT *, STRING
+END
+@end smallexample
+
+The above program, when run, prints:
+
+@smallexample
+ 154
+@end smallexample
+
+@xref{IChar Intrinsic}, for the inverse of the @code{@0@} function.
+
+@xref{AChar Intrinsic}, for the function corresponding
+to the ASCII character set.
+")
+
+DEFDOC (ICHAR, "Code for character.", "\
+Returns the code for the character in the
+first character position of @var{@1@}.
+
+Because the system's native character set is used,
+the correspondence between character and their codes
+is not necessarily the same between GNU Fortran
+implementations.
+
+Note that no intrinsic exists to convert a printable
+character string to a numerical value.
+For example, there is no intrinsic that, given
+the @code{CHARACTER} value @samp{'154'}, returns an
+@code{INTEGER} or @code{REAL} value with the value @samp{154}.
+
+Instead, you can use internal-file I/O to do this kind
+of conversion.
+For example:
+
+@smallexample
+INTEGER VALUE
+CHARACTER*10 STRING
+STRING = '154'
+READ (STRING, '(I10)'), VALUE
+PRINT *, VALUE
+END
+@end smallexample
+
+The above program, when run, prints:
+
+@smallexample
+ 154
+@end smallexample
+
+@xref{Char Intrinsic}, for the inverse of the @code{@0@} function.
+
+@xref{IAChar Intrinsic}, for the function corresponding
+to the ASCII character set.
+")
+
+DEFDOC (ACOS, "Arc cosine.", "\
+Returns the arc-cosine (inverse cosine) of @var{@1@}
+in radians.
+
+@xref{Cos Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DACOS, "Arc cosine (archaic).", ARCHAIC (ACOS, ACos))
+
+DEFDOC (AIMAG, "Convert/extract imaginary part of complex.", "\
+Returns the (possibly converted) imaginary part of @var{@1@}.
+
+Use of @code{@0@()} with an argument of a type
+other than @code{COMPLEX(KIND=1)} is restricted to the following case:
+
+@example
+REAL(AIMAG(@1@))
+@end example
+
+@noindent
+This expression converts the imaginary part of @1@ to
+@code{REAL(KIND=1)}.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+")
+
+DEFDOC (DIMAG, "Convert/extract imaginary part of complex (archaic).", ARCHAIC (AIMAG, AImag))
+
+DEFDOC (AINT, "Truncate to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved.
+(Also called ``truncation towards zero''.)
+
+@xref{ANInt Intrinsic}, for how to round to nearest
+whole number.
+
+@xref{Int Intrinsic}, for how to truncate and then convert
+number to @code{INTEGER}.
+")
+
+DEFDOC (DINT, "Truncate to whole number (archaic).", ARCHAIC (AINT, AInt))
+
+DEFDOC (INT, "Convert to @code{INTEGER} value truncated@99@to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=1)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part is
+truncated and converted, and its imaginary part is disregarded.
+
+@xref{NInt Intrinsic}, for how to convert, rounded to nearest
+whole number.
+
+@xref{AInt Intrinsic}, for how to truncate to whole number
+without converting.
+")
+
+DEFDOC (IDINT, "Convert to @code{INTEGER} value truncated@99@to whole number (archaic).", ARCHAIC (INT, Int))
+
+DEFDOC (ANINT, "Round to nearest whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude eliminated by rounding to the nearest whole
+number and with its sign preserved.
+
+A fractional portion exactly equal to
+@samp{.5} is rounded to the whole number that
+is larger in magnitude.
+(Also called ``Fortran round''.)
+
+@xref{AInt Intrinsic}, for how to truncate to
+whole number.
+
+@xref{NInt Intrinsic}, for how to round and then convert
+number to @code{INTEGER}.
+")
+
+DEFDOC (DNINT, "Round to nearest whole number (archaic).", ARCHAIC (ANINT, ANInt))
+
+DEFDOC (NINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude eliminated by rounding to the nearest whole
+number and with its sign preserved, converted
+to type @code{INTEGER(KIND=1)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part is
+rounded and converted.
+
+A fractional portion exactly equal to
+@samp{.5} is rounded to the whole number that
+is larger in magnitude.
+(Also called ``Fortran round''.)
+
+@xref{Int Intrinsic}, for how to convert, truncate to
+whole number.
+
+@xref{ANInt Intrinsic}, for how to round to nearest whole number
+without converting.
+")
+
+DEFDOC (IDNINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number (archaic).", ARCHAIC (NINT, NInt))
+
+DEFDOC (LOG, "Natural logarithm.", "\
+Returns the natural logarithm of @var{@1@}, which must
+be greater than zero or, if type @code{COMPLEX}, must not
+be zero.
+
+@xref{Exp Intrinsic}, for the inverse of this function.
+
+@xref{Log10 Intrinsic}, for the base-10 logarithm function.
+")
+
+DEFDOC (ALOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
+
+DEFDOC (CLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
+
+DEFDOC (DLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
+
+DEFDOC (CDLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
+
+DEFDOC (LOG10, "Natural logarithm.", "\
+Returns the natural logarithm of @var{@1@}, which must
+be greater than zero or, if type @code{COMPLEX}, must not
+be zero.
+
+The inverse of this function is @samp{10. ** LOG10(@var{@1@})}.
+
+@xref{Log Intrinsic}, for the natural logarithm function.
+")
+
+DEFDOC (ALOG10, "Natural logarithm (archaic).", ARCHAIC (LOG10, Log10))
+
+DEFDOC (DLOG10, "Natural logarithm (archaic).", ARCHAIC (LOG10, Log10))
+
+DEFDOC (MAX, "Maximum value.", "\
+Returns the argument with the largest value.
+
+@xref{Min Intrinsic}, for the opposite function.
+")
+
+DEFDOC (AMAX0, "Maximum value (archaic).", "\
+Archaic form of @code{MAX()} that is specific
+to one type for @var{@1@} and a different return type.
+@xref{Max Intrinsic}.
+")
+
+DEFDOC (AMAX1, "Maximum value (archaic).", ARCHAIC (MAX, Max))
+
+DEFDOC (DMAX1, "Maximum value (archaic).", ARCHAIC (MAX, Max))
+
+DEFDOC (MAX0, "Maximum value (archaic).", ARCHAIC (MAX, Max))
+
+DEFDOC (MAX1, "Maximum value (archaic).", "\
+Archaic form of @code{MAX()} that is specific
+to one type for @var{@1@} and a different return type.
+@xref{Max Intrinsic}.
+")
+
+DEFDOC (MIN, "Minimum value.", "\
+Returns the argument with the smallest value.
+
+@xref{Max Intrinsic}, for the opposite function.
+")
+
+DEFDOC (AMIN0, "Minimum value (archaic).", "\
+Archaic form of @code{MIN()} that is specific
+to one type for @var{@1@} and a different return type.
+@xref{Min Intrinsic}.
+")
+
+DEFDOC (AMIN1, "Minimum value (archaic).", ARCHAIC (MIN, Min))
+
+DEFDOC (DMIN1, "Minimum value (archaic).", ARCHAIC (MIN, Min))
+
+DEFDOC (MIN0, "Minimum value (archaic).", ARCHAIC (MIN, Min))
+
+DEFDOC (MIN1, "Minimum value (archaic).", "\
+Archaic form of @code{MIN()} that is specific
+to one type for @var{@1@} and a different return type.
+@xref{Min Intrinsic}.
+")
+
+DEFDOC (MOD, "Remainder.", "\
+Returns remainder calculated as:
+
+@smallexample
+@var{@1@} - (INT(@var{@1@} / @var{@2@}) * @var{@2@})
+@end smallexample
+
+@var{@2@} must not be zero.
+")
+
+DEFDOC (AMOD, "Remainder (archaic).", ARCHAIC (MOD, Mod))
+
+DEFDOC (DMOD, "Remainder (archaic).", ARCHAIC (MOD, Mod))
+
+DEFDOC (AND, "Boolean AND.", "\
+Returns value resulting from boolean AND of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (IAND, "Boolean AND.", "\
+Returns value resulting from boolean AND of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (OR, "Boolean OR.", "\
+Returns value resulting from boolean OR of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (IOR, "Boolean OR.", "\
+Returns value resulting from boolean OR of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (XOR, "Boolean XOR.", "\
+Returns value resulting from boolean exclusive-OR of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (IEOR, "Boolean XOR.", "\
+Returns value resulting from boolean exclusive-OR of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (NOT, "Boolean NOT.", "\
+Returns value resulting from boolean NOT of each bit
+in @var{@1@}.
+")
+
+DEFDOC (ASIN, "Arc sine.", "\
+Returns the arc-sine (inverse sine) of @var{@1@}
+in radians.
+
+@xref{Sin Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DASIN, "Arc sine (archaic).", ARCHAIC (ASIN, ASin))
+
+DEFDOC (ATAN, "Arc tangent.", "\
+Returns the arc-tangent (inverse tangent) of @var{@1@}
+in radians.
+
+@xref{Tan Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DATAN, "Arc tangent (archaic).", ARCHAIC (ATAN, ATan))
+
+DEFDOC (ATAN2, "Arc tangent.", "\
+Returns the arc-tangent (inverse tangent) of the complex
+number (@var{@1@}, @var{@2@}) in radians.
+
+@xref{Tan Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DATAN2, "Arc tangent (archaic).", ARCHAIC_2 (ATAN2, ATan2))
+
+DEFDOC (BIT_SIZE, "Number of bits in argument's type.", "\
+Returns the number of bits (integer precision plus sign bit)
+represented by the type for @var{@1@}.
+
+@xref{BTest Intrinsic}, for how to test the value of a
+bit in a variable or array.
+
+@xref{IBSet Intrinsic}, for how to set a bit in a variable to 1.
+
+@xref{IBClr Intrinsic}, for how to set a bit in a variable to 0.
+
+")
+
+DEFDOC (BTEST, "Test bit.", "\
+Returns @code{.TRUE.} if bit @var{@2@} in @var{@1@} is
+1, @code{.FALSE.} otherwise.
+
+(Bit 0 is the low-order (rightmost) bit, adding the value
+@ifinfo
+2**0,
+@end ifinfo
+@iftex
+@tex
+$2^0$,
+@end tex
+@end iftex
+or 1,
+to the number if set to 1;
+bit 1 is the next-higher-order bit, adding
+@ifinfo
+2**1,
+@end ifinfo
+@iftex
+@tex
+$2^1$,
+@end tex
+@end iftex
+or 2;
+bit 2 adds
+@ifinfo
+2**2,
+@end ifinfo
+@iftex
+@tex
+$2^2$,
+@end tex
+@end iftex
+or 4; and so on.)
+
+@xref{Bit_Size Intrinsic}, for how to obtain the number of bits
+in a type.
+The leftmost bit of @var{@1@} is @samp{BIT_SIZE(@var{@1@}-1}.
+")
+
+DEFDOC (CMPLX, "Construct @code{COMPLEX(KIND=1)} value.", "\
+If @var{@1@} is not type @code{COMPLEX},
+constructs a value of type @code{COMPLEX(KIND=1)} from the
+real and imaginary values specified by @var{@1@} and
+@var{@2@}, respectively.
+If @var{@2@} is omitted, @samp{0.} is assumed.
+
+If @var{@1@} is type @code{COMPLEX},
+converts it to type @code{COMPLEX(KIND=1)}.
+
+@xref{Complex Intrinsic}, for information on easily constructing
+a @code{COMPLEX} value of arbitrary precision from @code{REAL}
+arguments.
+")
+
+DEFDOC (DCMPLX, "Construct @code{COMPLEX(KIND=2)} value.", "\
+If @var{@1@} is not type @code{COMPLEX},
+constructs a value of type @code{COMPLEX(KIND=2)} from the
+real and imaginary values specified by @var{@1@} and
+@var{@2@}, respectively.
+If @var{@2@} is omitted, @samp{0D0} is assumed.
+
+If @var{@1@} is type @code{COMPLEX},
+converts it to type @code{COMPLEX(KIND=2)}.
+
+Although this intrinsic is not standard Fortran,
+it is a popular extension offered by many compilers
+that support @code{DOUBLE COMPLEX}, since it offers
+the easiest way to convert to @code{DOUBLE COMPLEX}
+without using Fortran 90 features (such as the @samp{KIND=}
+argument to the @code{CMPLX()} intrinsic).
+
+(@samp{CMPLX(0D0, 0D0)} returns a single-precision
+@code{COMPLEX} result, as required by standard FORTRAN 77.
+That's why so many compilers provide @code{DCMPLX()}, since
+@samp{DCMPLX(0D0, 0D0)} returns a @code{DOUBLE COMPLEX}
+result.
+Still, @code{DCMPLX()} converts even @code{REAL*16} arguments
+to their @code{REAL*8} equivalents in most dialects of
+Fortran, so neither it nor @code{CMPLX()} allow easy
+construction of arbitrary-precision values without
+potentially forcing a conversion involving extending or
+reducing precision.
+GNU Fortran provides such an intrinsic, called @code{COMPLEX()}.)
+
+@xref{Complex Intrinsic}, for information on easily constructing
+a @code{COMPLEX} value of arbitrary precision from @code{REAL}
+arguments.
+")
+
+DEFDOC (CONJG, "Complex conjugate.", "\
+Returns the complex conjugate:
+
+@example
+COMPLEX(REALPART(@var{@1@}), -IMAGPART(@var{@1@}))
+@end example
+")
+
+DEFDOC (DCONJG, "Complex conjugate (archaic).", ARCHAIC (CONJG, ATan2))
+
+DEFDOC (COS, "Cosine.", "\
+Returns the cosine of @var{@1@}, an angle measured
+in radians.
+
+@xref{ACos Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (CCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
+
+DEFDOC (DCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
+
+DEFDOC (CDCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
+
+DEFDOC (COSH, "Hyperbolic cosine.", "\
+Returns the hyperbolic cosine of @var{@1@}.
+")
+
+DEFDOC (DCOSH, "Hyperbolic cosine (archaic).", ARCHAIC (COSH, CosH))
+
+DEFDOC (SQRT, "Square root.", "\
+Returns the square root of @var{@1@}, which must
+not be negative.
+
+To calculate and represent the square root of a negative
+number, complex arithmetic must be used.
+For example, @samp{SQRT(COMPLEX(@var{@1@}))}.
+
+The inverse of this function is @samp{SQRT(@var{@1@}) * SQRT(@var{@1@})}.
+")
+
+DEFDOC (CSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
+
+DEFDOC (DSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
+
+DEFDOC (CDSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
+
+DEFDOC (DBLE, "Convert to double precision.", "\
+Returns @var{@1@} converted to double precision
+(@code{REAL(KIND=2)}).
+If @var{@1@} is @code{COMPLEX}, the real part of
+@var{@1@} is used for the conversion
+and the imaginary part disregarded.
+
+@xref{Sngl Intrinsic}, for the function that converts
+to single precision.
+
+@xref{Int Intrinsic}, for the function that converts
+to @code{INTEGER}.
+
+@xref{Complex Intrinsic}, for the function that converts
+to @code{COMPLEX}.
+")
+
+DEFDOC (DIM, "Difference magnitude (non-negative subtract).", "\
+Returns @samp{@var{@1@}-@var{@2@}} if @var{@1@} is greater than
+@var{@2@}; otherwise returns zero.
+")
+
+DEFDOC (DDIM, "Difference magnitude (archaic).", ARCHAIC_2 (DIM, DiM))
+DEFDOC (IDIM, "Difference magnitude (archaic).", ARCHAIC_2 (IDIM, IDiM))
+
+DEFDOC (DPROD, "Double-precision product.", "\
+Returns @samp{DBLE(@var{@1@})*DBLE(@var{@2@})}.
+")
+
+DEFDOC (EXP, "Exponential.", "\
+Returns @samp{@var{e}**@var{@1@}}, where
+@var{e} is approximately 2.7182818.
+
+@xref{Log Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (CEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
+
+DEFDOC (DEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
+
+DEFDOC (CDEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
+
+DEFDOC (FLOAT, "Conversion (archaic).", ARCHAIC (REAL, Real))
+DEFDOC (DFLOAT, "Conversion (archaic).", ARCHAIC (REAL, Real))
+
+DEFDOC (IFIX, "Conversion (archaic).", ARCHAIC (INT, Int))
+
+DEFDOC (LONG, "Conversion to @code{INTEGER(KIND=1)} (archaic).", "\
+Archaic form of @code{INT()} that is specific
+to one type for @var{@1@}.
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+")
+
+DEFDOC (SHORT, "Convert to @code{INTEGER(KIND=6)} value@99@truncated to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=6)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disgregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+")
+
+DEFDOC (INT2, "Convert to @code{INTEGER(KIND=6)} value@99@truncated to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=6)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disgregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+")
+
+DEFDOC (INT8, "Convert to @code{INTEGER(KIND=2)} value@99@truncated to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=2)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disgregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+")
+
+DEFDOC (LEN, "Length of character entity.", "\
+Returns the length of @var{@1@}.
+
+If @var{@1@} is an array, the length of an element
+of @var{@1@} is returned.
+
+Note that @var{@1@} need not be defined when this
+intrinsic is invoked, since only the length, not
+the content, of @var{@1@} is needed.
+
+@xref{Bit_Size Intrinsic}, for the function that determines
+the size of its argument in bits.
+")
+
+DEFDOC (TAN, "Tangent.", "\
+Returns the tangent of @var{@1@}, an angle measured
+in radians.
+
+@xref{ATan Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DTAN, "Tangent (archaic).", ARCHAIC (TAN, Tan))
+
+DEFDOC (TANH, "Hyperbolic tangent.", "\
+Returns the hyperbolic tangent of @var{@1@}.
+")
+
+DEFDOC (DTANH, "Hyperbolic tangent (archaic).", ARCHAIC (TANH, TanH))
+
+DEFDOC (SNGL, "Convert (archaic).", ARCHAIC (REAL, Real))
+
+DEFDOC (SIN, "Sine.", "\
+Returns the sine of @var{@1@}, an angle measured
+in radians.
+
+@xref{ASin Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (CSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
+
+DEFDOC (DSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
+
+DEFDOC (CDSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
+
+DEFDOC (SINH, "Hyperbolic sine.", "\
+Returns the hyperbolic sine of @var{@1@}.
+")
+
+DEFDOC (DSINH, "Hyperbolic sine (archaic).", ARCHAIC (SINH, SinH))
+
+DEFDOC (LSHIFT, "Left-shift bits.", "\
+Returns @var{@1@} shifted to the left
+@var{@2@} bits.
+
+Although similar to the expression
+@samp{@var{@1@}*(2**@var{@2@})}, there
+are important differences.
+For example, the sign of the result is
+not necessarily the same as the sign of
+@var{@1@}.
+
+Currently this intrinsic is defined assuming
+the underlying representation of @var{@1@}
+is as a two's-complement integer.
+It is unclear at this point whether that
+definition will apply when a different
+representation is involved.
+
+@xref{LShift Intrinsic}, for the inverse of this function.
+
+@xref{IShft Intrinsic}, for information
+on a more widely available left-shifting
+intrinsic that is also more precisely defined.
+")
+
+DEFDOC (RSHIFT, "Right-shift bits.", "\
+Returns @var{@1@} shifted to the right
+@var{@2@} bits.
+
+Although similar to the expression
+@samp{@var{@1@}/(2**@var{@2@})}, there
+are important differences.
+For example, the sign of the result is
+undefined.
+
+Currently this intrinsic is defined assuming
+the underlying representation of @var{@1@}
+is as a two's-complement integer.
+It is unclear at this point whether that
+definition will apply when a different
+representation is involved.
+
+@xref{RShift Intrinsic}, for the inverse of this function.
+
+@xref{IShft Intrinsic}, for information
+on a more widely available right-shifting
+intrinsic that is also more precisely defined.
+")
+
+DEFDOC (LGE, "Lexically greater than or equal.", "\
+Returns @samp{.TRUE.} if @samp{@var{@1@}.GE.@var{@2@}},
+@samp{.FALSE.} otherwise.
+@var{@1@} and @var{@2@} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{@1@} and @var{@2@} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+The lexical comparison intrinsics @code{LGe}, @code{LGt},
+@code{LLe}, and @code{LLt} differ from the corresponding
+intrinsic operators @code{.GE.}, @code{.GT.},
+@code{.LE.}, @code{.LT.}.
+Because the ASCII collating sequence is assumed,
+the following expressions always return @samp{.TRUE.}:
+
+@smallexample
+LGE ('0', ' ')
+LGE ('A', '0')
+LGE ('a', 'A')
+@end smallexample
+
+The following related expressions do @emph{not} always
+return @samp{.TRUE.}, as they are not necessarily evaluated
+assuming the arguments use ASCII encoding:
+
+@smallexample
+'0' .GE. ' '
+'A' .GE. '0'
+'a' .GE. 'A'
+@end smallexample
+
+The same difference exists
+between @code{LGt} and @code{.GT.};
+between @code{LLe} and @code{.LE.}; and
+between @code{LLt} and @code{.LT.}.
+")
+
+DEFDOC (LGT, "Lexically greater than.", "\
+Returns @samp{.TRUE.} if @samp{@var{@1@}.GT.@var{@2@}},
+@samp{.FALSE.} otherwise.
+@var{@1@} and @var{@2@} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{@1@} and @var{@2@} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{@0@} intrinsic and the @code{.GT.}
+operator.
+")
+
+DEFDOC (LLE, "Lexically less than or equal.", "\
+Returns @samp{.TRUE.} if @samp{@var{@1@}.LE.@var{@2@}},
+@samp{.FALSE.} otherwise.
+@var{@1@} and @var{@2@} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{@1@} and @var{@2@} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{@0@} intrinsic and the @code{.LE.}
+operator.
+")
+
+DEFDOC (LLT, "Lexically less than.", "\
+Returns @samp{.TRUE.} if @samp{@var{@1@}.LT.@var{@2@}},
+@samp{.FALSE.} otherwise.
+@var{@1@} and @var{@2@} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{@1@} and @var{@2@} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{@0@} intrinsic and the @code{.LT.}
+operator.
+")
+
+DEFDOC (SIGN, "Apply sign to magnitude.", "\
+Returns @samp{ABS(@var{@1@})*@var{s}}, where
+@var{s} is +1 if @samp{@var{@2@}.GE.0},
+-1 otherwise.
+
+@xref{Abs Intrinsic}, for the function that returns
+the magnitude of a value.
+")
+
+DEFDOC (DSIGN, "Apply sign to magnitude (archaic).", ARCHAIC_2 (SIGN, Sign))
+DEFDOC (ISIGN, "Apply sign to magnitude (archaic).", ARCHAIC_2 (ISIGN, ISign))
+
+DEFDOC (REAL, "Convert value to type @code{REAL(KIND=1)}.", "\
+Converts @var{@1@} to @code{REAL(KIND=1)}.
+
+Use of @code{@0@()} with a @code{COMPLEX} argument
+(other than @code{COMPLEX(KIND=1)}) is restricted to the following case:
+
+@example
+REAL(REAL(@1@))
+@end example
+
+@noindent
+This expression converts the real part of @1@ to
+@code{REAL(KIND=1)}.
+
+@xref{RealPart Intrinsic}, for information on a GNU Fortran
+intrinsic that extracts the real part of an arbitrary
+@code{COMPLEX} value.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+")
+
+DEFDOC (DREAL, "Convert value to type @code{REAL(KIND=2)}.", "\
+Converts @var{@1@} to @code{REAL(KIND=2)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part
+is converted (if necessary) to @code{REAL(KIND=2)},
+and its imaginary part is disregarded.
+
+Although this intrinsic is not standard Fortran,
+it is a popular extension offered by many compilers
+that support @code{DOUBLE COMPLEX}, since it offers
+the easiest way to extract the real part of a @code{DOUBLE COMPLEX}
+value without using the Fortran 90 @code{REAL()} intrinsic
+in a way that produces a return value inconsistent with
+the way many FORTRAN 77 compilers handle @code{REAL()} of
+a @code{DOUBLE COMPLEX} value.
+
+@xref{RealPart Intrinsic}, for information on a GNU Fortran
+intrinsic that avoids these areas of confusion.
+
+@xref{REAL() and AIMAG() of Complex}, for more information on
+this issue.
+")
+
+DEFDOC (IMAGPART, "Extract imaginary part of complex.", "\
+The imaginary part of @var{@1@} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{AIMAG(@var{@1@})}.
+However, when, for example, @var{@1@} is @code{DOUBLE COMPLEX},
+@samp{AIMAG(@var{@1@})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{@0@()} is that, while not necessarily
+more or less portable than @code{AIMAG()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+")
+
+DEFDOC (COMPLEX, "Build complex value from real and@99@imaginary parts.", "\
+Returns a @code{COMPLEX} value that has @samp{@1@} and @samp{@2@} as its
+real and imaginary parts, respectively.
+
+If @var{@1@} and @var{@2@} are the same type, and that type is not
+@code{INTEGER}, no data conversion is performed, and the type of
+the resulting value has the same kind value as the types
+of @var{@1@} and @var{@2@}.
+
+If @var{@1@} and @var{@2@} are not the same type, the usual type-promotion
+rules are applied to both, converting either or both to the
+appropriate @code{REAL} type.
+The type of the resulting value has the same kind value as the
+type to which both @var{@1@} and @var{@2@} were converted, in this case.
+
+If @var{@1@} and @var{@2@} are both @code{INTEGER}, they are both converted
+to @code{REAL(KIND=1)}, and the result of the @code{@0@()}
+invocation is type @code{COMPLEX(KIND=1)}.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is too hairy to describe here, but it is important to
+note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)}
+result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}.
+Hence the availability of @code{COMPLEX()} in GNU Fortran.
+")
+
+DEFDOC (LOC, "Address of entity in core.", "\
+The @code{LOC()} intrinsic works the
+same way as the @code{%LOC()} construct.
+@xref{%LOC(),,The @code{%LOC()} Construct}, for
+more information.
+")
+
+DEFDOC (REALPART, "Extract real part of complex.", "\
+The real part of @var{@1@} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{REAL(@var{@1@})}.
+However, when, for example, @var{@1@} is @code{COMPLEX(KIND=2)},
+@samp{REAL(@var{@1@})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{@0@()} is that, while not necessarily
+more or less portable than @code{REAL()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+")
+
+DEFDOC (GETARG, "Obtain command-line argument.", "\
+Sets @var{@2@} to the @var{@1@}-th command-line argument (or to all
+blanks if there are fewer than @var{@2@} command-line arguments);
+@code{CALL @0@(0, @var{value})} sets @var{value} to the name of the
+program (on systems that support this feature).
+
+@xref{IArgC Intrinsic}, for information on how to get the number
+of arguments.
+")
+
+DEFDOC (ABORT, "Abort the program.", "\
+Prints a message and potentially causes a core dump via @code{abort(3)}.
+")
+
+DEFDOC (EXIT, "Terminate the program.", "\
+Exit the program with status @var{@1@} after closing open Fortran
+I/O units and otherwise behaving as @code{exit(2)}.
+If @var{@1@} is omitted the canonical `success' value
+will be returned to the system.
+")
+
+DEFDOC (IARGC, "Obtain count of command-line arguments.", "\
+Returns the number of command-line arguments.
+
+This count does not include the specification of the program
+name itself.
+")
+
+DEFDOC (CTIME_func, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\
+Converts @var{@1@}, a system time value, such as returned by
+@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
+and returns that string as the function value.
+
+@xref{Time8 Intrinsic}.
+")
+
+DEFDOC (CTIME_subr, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\
+Converts @var{@2@}, a system time value, such as returned by
+@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
+and returns that string in @var{@1@}.
+
+@xref{Time8 Intrinsic}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (DATE, "Get current date as dd-Mon-yy.", "\
+Returns @var{@1@} in the form @samp{@var{dd}-@var{mmm}-@var{yy}},
+representing the numeric day of the month @var{dd}, a three-character
+abbreviation of the month name @var{mmm} and the last two digits of
+the year @var{yy}, e.g.@ @samp{25-Nov-96}.
+
+This intrinsic is not recommended, due to the year 2000 approaching.
+@xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits
+for the current (or any) date.
+")
+
+DEFDOC (DTIME_func, "Get elapsed time since last time.", "\
+Initially, return the number of seconds of runtime
+since the start of the process's execution
+as the function value,
+and the user and system components of this in @samp{@var{@1@}(1)}
+and @samp{@var{@1@}(2)} respectively.
+The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
+
+Subsequent invocations of @samp{@0@()} return values accumulated since the
+previous invocation.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (DTIME_subr, "Get elapsed time since last time.", "\
+Initially, return the number of seconds of runtime
+since the start of the process's execution
+in @var{@1@},
+and the user and system components of this in @samp{@var{@2@}(1)}
+and @samp{@var{@2@}(2)} respectively.
+The value of @var{@1@} is equal to @samp{@var{@2@}(1) + @var{@2@}(2)}.
+
+Subsequent invocations of @samp{@0@()} set values based on accumulations
+since the previous invocation.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (ETIME_func, "Get elapsed time for process.", "\
+Return the number of seconds of runtime
+since the start of the process's execution
+as the function value,
+and the user and system components of this in @samp{@var{@1@}(1)}
+and @samp{@var{@1@}(2)} respectively.
+The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
+")
+
+DEFDOC (ETIME_subr, "Get elapsed time for process.", "\
+Return the number of seconds of runtime
+since the start of the process's execution
+in @var{@1@},
+and the user and system components of this in @samp{@var{@2@}(1)}
+and @samp{@var{@2@}(2)} respectively.
+The value of @var{@1@} is equal to @samp{@var{@2@}(1) + @var{@2@}(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (FDATE_func, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\
+Returns the current date (using the same format as @code{CTIME()}).
+
+Equivalent to:
+
+@example
+CTIME(TIME8())
+@end example
+
+@xref{CTime Intrinsic (function)}.
+")
+
+DEFDOC (FDATE_subr, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\
+Returns the current date (using the same format as @code{CTIME()})
+in @var{@1@}.
+
+Equivalent to:
+
+@example
+CALL CTIME(@var{@1@}, TIME8())
+@end example
+
+@xref{CTime Intrinsic (subroutine)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (GMTIME, "Convert time to GMT time info.", "\
+Given a system time value @var{@1@}, fills @var{@2@} with values
+extracted from it appropriate to the GMT time zone using
+@code{gmtime(3)}.
+
+The array elements are as follows:
+
+@enumerate
+@item
+Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+
+@item
+Minutes after the hour, range 0--59
+
+@item
+Hours past midnight, range 0--23
+
+@item
+Day of month, range 0--31
+
+@item
+Number of months since January, range 0--12
+
+@item
+Years since 1900
+
+@item
+Number of days since Sunday, range 0--6
+
+@item
+Days since January 1
+
+@item
+Daylight savings indicator: positive if daylight savings is in effect,
+zero if not, and negative if the information isn't available.
+@end enumerate
+")
+
+DEFDOC (LTIME, "Convert time to local time info.", "\
+Given a system time value @var{@1@}, fills @var{@2@} with values
+extracted from it appropriate to the GMT time zone using
+@code{localtime(3)}.
+
+The array elements are as follows:
+
+@enumerate
+@item
+Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+
+@item
+Minutes after the hour, range 0--59
+
+@item
+Hours past midnight, range 0--23
+
+@item
+Day of month, range 0--31
+
+@item
+Number of months since January, range 0--12
+
+@item
+Years since 1900
+
+@item
+Number of days since Sunday, range 0--6
+
+@item
+Days since January 1
+
+@item
+Daylight savings indicator: positive if daylight savings is in effect,
+zero if not, and negative if the information isn't available.
+@end enumerate
+")
+
+DEFDOC (IDATE_unix, "Get local time info.", "\
+Fills @var{@1@} with the numerical values at the current local time
+of day, month (in the range 1--12), and year in elements 1, 2, and 3,
+respectively.
+The year has four significant digits.
+")
+
+DEFDOC (IDATE_vxt, "Get local time info (VAX/VMS).", "\
+Returns the numerical values of the current local time.
+The month (in the range 1--12) is returned in @var{@1@},
+the day (in the range 1--7) in @var{@2@},
+and the year in @var{@3@} (in the range 0--99).
+
+This intrinsic is not recommended, due to the year 2000 approaching.
+")
+
+DEFDOC (ITIME, "Get local time of day.", "\
+Returns the current local time hour, minutes, and seconds in elements
+1, 2, and 3 of @var{@1@}, respectively.
+")
+
+DEFDOC (MCLOCK, "Get number of clock ticks for process.", "\
+Returns the number of clock ticks since the start of the process.
+Supported on systems with @code{clock(3)} (q.v.).
+
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+@xref{MClock8 Intrinsic}, for information on a
+similar intrinsic that might be portable to more
+GNU Fortran implementations, though to fewer
+Fortran compilers.
+
+If the system does not support @code{clock(3)},
+-1 is returned.
+")
+
+DEFDOC (MCLOCK8, "Get number of clock ticks for process.", "\
+Returns the number of clock ticks since the start of the process.
+Supported on systems with @code{clock(3)} (q.v.).
+
+No Fortran implementations other than GNU Fortran are
+known to support this intrinsic at the time of this
+writing.
+@xref{MClock Intrinsic}, for information on a
+similar intrinsic that might be portable to more Fortran
+compilers, though to fewer GNU Fortran implementations.
+
+If the system does not support @code{clock(3)},
+-1 is returned.
+")
+
+DEFDOC (SECNDS, "Get local time offset since midnight.", "\
+Returns the local time in seconds since midnight minus the value
+@var{@1@}.
+")
+
+DEFDOC (SECOND_func, "Get CPU time for process in seconds.", "\
+Returns the process's runtime in seconds---the same value as the
+UNIX function @code{etime} returns.
+
+This routine is known from Cray Fortran.
+")
+
+DEFDOC (SECOND_subr, "Get CPU time for process@99@in seconds.", "\
+Returns the process's runtime in seconds in @var{@1@}---the same value
+as the UNIX function @code{etime} returns.
+
+This routine is known from Cray Fortran. @xref{Cpu_Time Intrinsic}
+for a standard equivalent.
+")
+
+DEFDOC (SYSTEM_CLOCK, "Get current system clock value.", "\
+Returns in @var{@1@} the current value of the system clock; this is
+the value returned by the UNIX function @code{times(2)}
+in this implementation, but
+isn't in general.
+@var{@2@} is the number of clock ticks per second and
+@var{@3@} is the maximum value this can take, which isn't very useful
+in this implementation since it's just the maximum C @code{unsigned
+int} value.
+")
+
+DEFDOC (CPU_TIME, "Get current CPU time.", "\
+Returns in @var{@1@} the current value of the system time.
+This implementation of the Fortran 95 intrinsic is just an alias for
+@code{second} @xref{Second Intrinsic (subroutine)}.
+")
+
+DEFDOC (TIME8, "Get current time as time value.", "\
+Returns the current time encoded as a long integer
+(in the manner of the UNIX function @code{time(3)}).
+This value is suitable for passing to @code{CTIME},
+@code{GMTIME}, and @code{LTIME}.
+
+No Fortran implementations other than GNU Fortran are
+known to support this intrinsic at the time of this
+writing.
+@xref{Time Intrinsic (UNIX)}, for information on a
+similar intrinsic that might be portable to more Fortran
+compilers, though to fewer GNU Fortran implementations.
+")
+
+DEFDOC (TIME_unix, "Get current time as time value.", "\
+Returns the current time encoded as an integer
+(in the manner of the UNIX function @code{time(3)}).
+This value is suitable for passing to @code{CTIME},
+@code{GMTIME}, and @code{LTIME}.
+
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+@xref{Time8 Intrinsic}, for information on a
+similar intrinsic that might be portable to more
+GNU Fortran implementations, though to fewer
+Fortran compilers.
+")
+
+#define BES(num,n,val) "\
+Calculates the Bessel function of the " #num " kind of \
+order " #n " of @var{@" #val "@}.\n\
+See @code{bessel(3m)}, on whose implementation the \
+function depends.\
+"
+
+DEFDOC (BESJ0, "Bessel function.", BES (first, 0, 1))
+DEFDOC (BESJ1, "Bessel function.", BES (first, 1, 1))
+DEFDOC (BESJN, "Bessel function.", BES (first, @var{N}, 2))
+DEFDOC (BESY0, "Bessel function.", BES (second, 0, 1))
+DEFDOC (BESY1, "Bessel function.", BES (second, 1, 1))
+DEFDOC (BESYN, "Bessel function.", BES (second, @var{N}, 2))
+DEFDOC (DBESJ0, "Bessel function (archaic).", ARCHAIC (BESJ0, BesJ0))
+DEFDOC (DBESJ1, "Bessel function (archaic).", ARCHAIC (BESJ1, BesJ1))
+DEFDOC (DBESJN, "Bessel function (archaic).", ARCHAIC_2nd (BESJN, BesJN))
+DEFDOC (DBESY0, "Bessel function (archaic).", ARCHAIC (BESY0, BesY0))
+DEFDOC (DBESY1, "Bessel function (archaic).", ARCHAIC (BESY1, BesY1))
+DEFDOC (DBESYN, "Bessel function (archaic).", ARCHAIC_2nd (BESYN, BesYN))
+
+DEFDOC (ERF, "Error function.", "\
+Returns the error function of @var{@1@}.
+See @code{erf(3m)}, which provides the implementation.
+")
+
+DEFDOC (ERFC, "Complementary error function.", "\
+Returns the complementary error function of @var{@1@}:
+@samp{ERFC(R) = 1 - ERF(R)} (except that the result may be more
+accurate than explicitly evaluating that formulae would give).
+See @code{erfc(3m)}, which provides the implementation.
+")
+
+DEFDOC (DERF, "Error function (archaic).", ARCHAIC (ERF, ErF))
+DEFDOC (DERFC, "Complementary error function (archaic).", ARCHAIC (ERFC, ErFC))
+
+DEFDOC (IRAND, "Random number.", "\
+Returns a uniform quasi-random number up to a system-dependent limit.
+If @var{@1@} is 0, the next number in sequence is returned; if
+@var{@1@} is 1, the generator is restarted by calling the UNIX function
+@samp{srand(0)}; if @var{@1@} has any other value,
+it is used as a new seed with @code{srand()}.
+
+@xref{SRand Intrinsic}.
+
+@emph{Note:} As typically implemented (by the routine of the same
+name in the C library), this random number generator is a very poor
+one, though the BSD and GNU libraries provide a much better
+implementation than the `traditional' one.
+On a different system you almost certainly want to use something better.
+")
+
+DEFDOC (RAND, "Random number.", "\
+Returns a uniform quasi-random number between 0 and 1.
+If @var{@1@} is 0, the next number in sequence is returned; if
+@var{@1@} is 1, the generator is restarted by calling @samp{srand(0)};
+if @var{@1@} has any other value, it is used as a new seed with
+@code{srand}.
+
+@xref{SRand Intrinsic}.
+
+@emph{Note:} As typically implemented (by the routine of the same
+name in the C library), this random number generator is a very poor
+one, though the BSD and GNU libraries provide a much better
+implementation than the `traditional' one.
+On a different system you
+almost certainly want to use something better.
+")
+
+DEFDOC (SRAND, "Random seed.", "\
+Reinitialises the generator with the seed in @var{@1@}.
+@xref{IRand Intrinsic}.
+@xref{Rand Intrinsic}.
+")
+
+DEFDOC (ACCESS, "Check file accessibility.", "\
+Checks file @var{@1@} for accessibility in the mode specified by @var{@2@} and
+returns 0 if the file is accessible in that mode, otherwise an error
+code if the file is inaccessible or @var{@2@} is invalid.
+See @code{access(2)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+@var{@2@} may be a concatenation of any of the following characters:
+
+@table @samp
+@item r
+Read permission
+
+@item w
+Write permission
+
+@item x
+Execute permission
+
+@item @kbd{SPC}
+Existence
+@end table
+")
+
+DEFDOC (CHDIR_subr, "Change directory.", "\
+Sets the current working directory to be @var{@1@}.
+If the @var{@2@} argument is supplied, it contains 0
+on success or a non-zero error code otherwise upon return.
+See @code{chdir(3)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+DEFDOC (CHDIR_func, "Change directory.", "\
+Sets the current working directory to be @var{@1@}.
+Returns 0 on success or a non-zero error code.
+See @code{chdir(3)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (CHMOD_func, "Change file modes.", "\
+Changes the access mode of file @var{@1@} according to the
+specification @var{@2@}, which is given in the format of
+@code{chmod(1)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+Currently, @var{@1@} must not contain the single quote
+character.
+
+Returns 0 on success or a non-zero error code otherwise.
+
+Note that this currently works
+by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
+the library was configured) and so may fail in some circumstances and
+will, anyway, be slow.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (CHMOD_subr, "Change file modes.", "\
+Changes the access mode of file @var{@1@} according to the
+specification @var{@2@}, which is given in the format of
+@code{chmod(1)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+Currently, @var{@1@} must not contain the single quote
+character.
+
+If the @var{@3@} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+
+Note that this currently works
+by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
+the library was configured) and so may fail in some circumstances and
+will, anyway, be slow.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (GETCWD_func, "Get current working directory.", "\
+Places the current working directory in @var{@1@}.
+Returns 0 on
+success, otherwise a non-zero error code
+(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
+or @code{getwd(3)}).
+")
+
+DEFDOC (GETCWD_subr, "Get current working directory.", "\
+Places the current working directory in @var{@1@}.
+If the @var{@2@} argument is supplied, it contains 0
+success or a non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
+or @code{getwd(3)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+DEFDOC (FSTAT_func, "Get file information.", "\
+Obtains data about the file open on Fortran I/O unit @var{@1@} and
+places them in the array @var{@2@}.
+The values in this array are
+extracted from the @code{stat} structure as returned by
+@code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a non-zero error code.
+")
+
+DEFDOC (FSTAT_subr, "Get file information.", "\
+Obtains data about the file open on Fortran I/O unit @var{@1@} and
+places them in the array @var{@2@}.
+The values in this array are
+extracted from the @code{stat} structure as returned by
+@code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{@3@} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (LSTAT_func, "Get file information.", "\
+Obtains data about the given file @var{@1@} and places them in the array
+@var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+If @var{@1@} is a symbolic link it returns data on the
+link itself, so the routine is available only on systems that support
+symbolic links.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a non-zero error code
+(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
+")
+
+DEFDOC (LSTAT_subr, "Get file information.", "\
+Obtains data about the given file @var{@1@} and places them in the array
+@var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+If @var{@1@} is a symbolic link it returns data on the
+link itself, so the routine is available only on systems that support
+symbolic links.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{@3@} argument is supplied, it contains
+0 on success or a non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (STAT_func, "Get file information.", "\
+Obtains data about the given file @var{@1@} and places them in the array
+@var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a non-zero error code.
+")
+
+DEFDOC (STAT_subr, "Get file information.", "\
+Obtains data about the given file @var{@1@} and places them in the array
+@var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{@3@} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (LINK_subr, "Make hard link in file system.", "\
+Makes a (hard) link from file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+If the @var{@3@} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+See @code{link(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (LINK_func, "Make hard link in file system.", "\
+Makes a (hard) link from file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+Returns 0 on success or a non-zero error code.
+See @code{link(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (SYMLNK_subr, "Make symbolic link in file system.", "\
+Makes a symbolic link from file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+If the @var{@3@} argument is supplied, it contains
+0 on success or a non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (SYMLNK_func, "Make symbolic link in file system.", "\
+Makes a symbolic link from file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+Returns 0 on success or a non-zero error code
+(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (RENAME_subr, "Rename file.", "\
+Renames the file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+See @code{rename(2)}.
+If the @var{@3@} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (RENAME_func, "Rename file.", "\
+Renames the file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+See @code{rename(2)}.
+Returns 0 on success or a non-zero error code.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (UMASK_subr, "Set file creation permissions mask.", "\
+Sets the file creation mask to @var{@1@} and returns the old value in
+argument @var{@2@} if it is supplied.
+See @code{umask(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (UMASK_func, "Set file creation permissions mask.", "\
+Sets the file creation mask to @var{@1@} and returns the old value.
+See @code{umask(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (UNLINK_subr, "Unlink file.", "\
+Unlink the file @var{@1@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+If the @var{@2@} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+See @code{unlink(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+DEFDOC (UNLINK_func, "Unlink file.", "\
+Unlink the file @var{@1@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+Returns 0 on success or a non-zero error code.
+See @code{unlink(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (GERROR, "Get error message for last error.", "\
+Returns the system error message corresponding to the last system
+error (C @code{errno}).
+")
+
+DEFDOC (IERRNO, "Get error number for last error.", "\
+Returns the last system error number (corresponding to the C
+@code{errno}).
+")
+
+DEFDOC (PERROR, "Print error message for last error.", "\
+Prints (on the C @code{stderr} stream) a newline-terminated error
+message corresponding to the last system error.
+This is prefixed by @var{@1@}, a colon and a space.
+See @code{perror(3)}.
+")
+
+DEFDOC (GETGID, "Get process group id.", "\
+Returns the group id for the current process.
+")
+
+DEFDOC (GETUID, "Get process user id.", "\
+Returns the user id for the current process.
+")
+
+DEFDOC (GETPID, "Get process id.", "\
+Returns the process id for the current process.
+")
+
+DEFDOC (GETENV, "Get environment variable.", "\
+Sets @var{@2@} to the value of environment variable given by the
+value of @var{@1@} (@code{$name} in shell terms) or to blanks if
+@code{$name} has not been set.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+")
+
+DEFDOC (GETLOG, "Get login name.", "\
+Returns the login name for the process in @var{@1@}.
+")
+
+DEFDOC (HOSTNM_func, "Get host name.", "\
+Fills @var{@1@} with the system's host name returned by
+@code{gethostname(2)}, returning 0 on success or a non-zero error code
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+This intrinsic is not available on all systems.
+")
+
+DEFDOC (HOSTNM_subr, "Get host name.", "\
+Fills @var{@1@} with the system's host name returned by
+@code{gethostname(2)}.
+If the @var{@2@} argument is supplied, it contains
+0 on success or a non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+This intrinsic is not available on all systems.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+/* Fixme: stream I/O */
+
+DEFDOC (FLUSH, "Flush buffered output.", "\
+Flushes Fortran unit(s) currently open for output.
+Without the optional argument, all such units are flushed,
+otherwise just the unit specified by @var{@1@}.
+
+Some non-GNU implementations of Fortran provide this intrinsic
+as a library procedure that might or might not support the
+(optional) @var{@1@} argument.
+")
+
+DEFDOC (FNUM, "Get file descriptor from Fortran unit number.", "\
+Returns the Unix file descriptor number corresponding to the open
+Fortran I/O unit @var{@1@}.
+This could be passed to an interface to C I/O routines.
+")
+
+#define IOWARN "
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+"
+
+DEFDOC (FGET_func, "Read a character from unit 5 stream-wise.", "\
+Reads a single character into @var{@1@} in stream mode from unit 5
+(by-passing normal formatted input) using @code{getc(3)}.
+Returns 0 on
+success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FGET_subr, "Read a character from unit 5 stream-wise.", "\
+Reads a single character into @var{@1@} in stream mode from unit 5
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns in
+@var{@2@} 0 on success, @minus{}1 on end-of-file, and the error code
+from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FGETC_func, "Read a character stream-wise.", "\
+Reads a single character into @var{@2@} in stream mode from unit @var{@1@}
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns 0 on
+success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FGETC_subr, "Read a character stream-wise.", "\
+Reads a single character into @var{@2@} in stream mode from unit @var{@1@}
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns in
+@var{@3@} 0 on success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FPUT_func, "Write a character to unit 6 stream-wise.", "\
+Writes the single character @var{@1@} in stream mode to unit 6
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns 0 on
+success, the error code from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FPUT_subr, "Write a character to unit 6 stream-wise.", "\
+Writes the single character @var{@1@} in stream mode to unit 6
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns in
+@var{@2@} 0 on success, the error code from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FPUTC_func, "Write a character stream-wise.", "\
+Writes the single character @var{@2@} in stream mode to unit @var{@1@}
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns 0 on
+success, the error code from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FPUTC_subr, "Write a character stream-wise.", "\
+Writes the single character @var{@1@} in stream mode to unit 6
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns in
+@var{@2@} 0 on success, the error code from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FSEEK, "Position file (low-level).", "\
+Attempts to move Fortran unit @var{@1@} to the specified
+@var{Offset}: absolute offset if @var{@2@}=0; relative to the
+current offset if @var{@2@}=1; relative to the end of the file if
+@var{@2@}=2.
+It branches to label @var{@3@} if @var{@1@} is
+not open or if the call otherwise fails.
+")
+
+DEFDOC (FTELL_func, "Get file position (low-level).", "\
+Returns the current offset of Fortran unit @var{@1@}
+(or @minus{}1 if @var{@1@} is not open).
+")
+
+DEFDOC (FTELL_subr, "Get file position (low-level).", "\
+Sets @var{@2@} to the current offset of Fortran unit @var{@1@}
+(or to @minus{}1 if @var{@1@} is not open).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (ISATTY, "Is unit connected to a terminal?", "\
+Returns @code{.TRUE.} if and only if the Fortran I/O unit
+specified by @var{@1@} is connected
+to a terminal device.
+See @code{isatty(3)}.
+")
+
+DEFDOC (TTYNAM_func, "Get name of terminal device for unit.", "\
+Returns the name of the terminal device open on logical unit
+@var{@1@} or a blank string if @var{@1@} is not connected to a
+terminal.
+")
+
+DEFDOC (TTYNAM_subr, "Get name of terminal device for unit.", "\
+Sets @var{@1@} to the name of the terminal device open on logical unit
+@var{@2@} or a blank string if @var{@2@} is not connected to a
+terminal.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (SIGNAL_subr, "Muck with signal handling.", "\
+If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be
+invoked with a single integer argument (of system-dependent length)
+when signal @var{@1@} occurs.
+If @var{@1@} is an integer, it can be
+used to turn off handling of signal @var{@2@} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{@2@} will be called using C conventions, so its value in
+Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it.
+
+The value returned by @code{signal(2)} is written to @var{@3@}, if
+that argument is supplied.
+Otherwise the return value is ignored.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (SIGNAL_func, "Muck with signal handling.", "\
+If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be
+invoked with a single integer argument (of system-dependent length)
+when signal @var{@1@} occurs.
+If @var{@1@} is an integer, it can be
+used to turn off handling of signal @var{@2@} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{@2@} will be called using C conventions, so its value in
+Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it.
+
+The value returned by @code{signal(2)} is returned.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (KILL_func, "Signal a process.", "\
+Sends the signal specified by @var{@2@} to the process @var{@1@}.
+Returns 0 on success or a non-zero error code.
+See @code{kill(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (KILL_subr, "Signal a process.", "\
+Sends the signal specified by @var{@2@} to the process @var{@1@}.
+If the @var{@3@} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+See @code{kill(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (LNBLNK, "Get last non-blank character in string.", "\
+Returns the index of the last non-blank character in @var{@1@}.
+@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
+")
+
+DEFDOC (SLEEP, "Sleep for a specified time.", "\
+Causes the process to pause for @var{@1@} seconds.
+See @code{sleep(2)}.
+")
+
+DEFDOC (SYSTEM_subr, "Invoke shell (system) command.", "\
+Passes the command @var{@1@} to a shell (see @code{system(3)}).
+If argument @var{@2@} is present, it contains the value returned by
+@code{system(3)}, presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+DEFDOC (SYSTEM_func, "Invoke shell (system) command.", "\
+Passes the command @var{@1@} to a shell (see @code{system(3)}).
+Returns the value returned by
+@code{system(3)}, presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+However, the function form can be valid in cases where the
+actual side effects performed by the call are unimportant to
+the application.
+
+For example, on a UNIX system, @samp{SAME = SYSTEM('cmp a b')}
+does not perform any side effects likely to be important to the
+program, so the programmer would not care if the actual system
+call (and invocation of @code{cmp}) was optimized away in a situation
+where the return value could be determined otherwise, or was not
+actually needed (@samp{SAME} not actually referenced after the
+sample assignment statement).
+")
+
+DEFDOC (TIME_vxt, "Get the time as a character value.", "\
+Returns in @var{@1@} a character representation of the current time as
+obtained from @code{ctime(3)}.
+
+@xref{Fdate Intrinsic (subroutine)} for an equivalent routine.
+")
+
+DEFDOC (IBCLR, "Clear a bit.", "\
+Returns the value of @var{@1@} with bit @var{@2@} cleared (set to
+zero).
+@xref{BTest Intrinsic} for information on bit positions.
+")
+
+DEFDOC (IBSET, "Set a bit.", "\
+Returns the value of @var{@1@} with bit @var{@2@} set (to one).
+@xref{BTest Intrinsic} for information on bit positions.
+")
+
+DEFDOC (IBITS, "Extract a bit subfield of a variable.", "\
+Extracts a subfield of length @var{@3@} from @var{@1@}, starting from
+bit position @var{@2@} and extending left for @var{@3@} bits.
+The result is right-justified and the remaining bits are zeroed.
+The value
+of @samp{@var{@2@}+@var{@3@}} must be less than or equal to the value
+@samp{BIT_SIZE(@var{@1@})}.
+@xref{Bit_Size Intrinsic}.
+")
+
+DEFDOC (ISHFT, "Logical bit shift.", "\
+All bits representing @var{@1@} are shifted @var{@2@} places.
+@samp{@var{@2@}.GT.0} indicates a left shift, @samp{@var{@2@}.EQ.0}
+indicates no shift and @samp{@var{@2@}.LT.0} indicates a right shift.
+If the absolute value of the shift count is greater than
+@samp{BIT_SIZE(@var{@1@})}, the result is undefined.
+Bits shifted out from the left end or the right end, as the case may be,
+are lost.
+Zeros are shifted in from the opposite end.
+
+@xref{IShftC Intrinsic} for the circular-shift equivalent.
+")
+
+DEFDOC (ISHFTC, "Circular bit shift.", "\
+The rightmost @var{@3@} bits of the argument @var{@1@}
+are shifted circularly @var{@2@}
+places, i.e.@ the bits shifted out of one end are shifted into
+the opposite end.
+No bits are lost.
+The unshifted bits of the result are the same as
+the unshifted bits of @var{@1@}.
+The absolute value of the argument @var{@2@}
+must be less than or equal to @var{@3@}.
+The value of @var{@3@} must be greater than or equal to one and less than
+or equal to @samp{BIT_SIZE(@var{@1@})}.
+
+@xref{IShft Intrinsic} for the logical shift equivalent.
+")
+
+DEFDOC (MVBITS, "Moving a bit field.", "\
+Moves @var{@3@} bits from positions @var{@2@} through
+@samp{@var{@2@}+@var{@3@}-1} of @var{@1@} to positions @var{@5@} through
+@samp{@var{@2@}+@var{@3@}-1} of @var{@4@}. The portion of argument
+@var{@4@} not affected by the movement of bits is unchanged. Arguments
+@var{@1@} and @var{@4@} are permitted to be the same numeric storage
+unit. The values of @samp{@var{@2@}+@var{@3@}} and
+@samp{@var{@5@}+@var{@3@}} must be less than or equal to
+@samp{BIT_SIZE(@var{@1@})}.
+")
+
+DEFDOC (INDEX, "Locate a CHARACTER substring.", "\
+Returns the position of the start of the first occurrence of string
+@var{@2@} as a substring in @var{@1@}, counting from one.
+If @var{@2@} doesn't occur in @var{@1@}, zero is returned.
+")
+
diff --git a/gcc/f/intdoc.texi b/gcc/f/intdoc.texi
new file mode 100644
index 00000000000..1d961d83d92
--- /dev/null
+++ b/gcc/f/intdoc.texi
@@ -0,0 +1,10570 @@
+@menu
+@ifset familyF2U
+* Abort Intrinsic:: Abort the program.
+@end ifset
+@ifset familyF77
+* Abs Intrinsic:: Absolute value.
+@end ifset
+@ifset familyF2U
+* Access Intrinsic:: Check file accessibility.
+@end ifset
+@ifset familyASC
+* AChar Intrinsic:: ASCII character from code.
+@end ifset
+@ifset familyF77
+* ACos Intrinsic:: Arc cosine.
+@end ifset
+@ifset familyVXT
+* ACosD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* AdjustL Intrinsic:: (Reserved for future use.)
+* AdjustR Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* AImag Intrinsic:: Convert/extract imaginary part of complex.
+@end ifset
+@ifset familyVXT
+* AIMax0 Intrinsic:: (Reserved for future use.)
+* AIMin0 Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* AInt Intrinsic:: Truncate to whole number.
+@end ifset
+@ifset familyVXT
+* AJMax0 Intrinsic:: (Reserved for future use.)
+* AJMin0 Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Alarm Intrinsic::
+@end ifset
+@ifset familyF90
+* All Intrinsic:: (Reserved for future use.)
+* Allocated Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* ALog Intrinsic:: Natural logarithm (archaic).
+* ALog10 Intrinsic:: Natural logarithm (archaic).
+* AMax0 Intrinsic:: Maximum value (archaic).
+* AMax1 Intrinsic:: Maximum value (archaic).
+* AMin0 Intrinsic:: Minimum value (archaic).
+* AMin1 Intrinsic:: Minimum value (archaic).
+* AMod Intrinsic:: Remainder (archaic).
+@end ifset
+@ifset familyF2C
+* And Intrinsic:: Boolean AND.
+@end ifset
+@ifset familyF77
+* ANInt Intrinsic:: Round to nearest whole number.
+@end ifset
+@ifset familyF90
+* Any Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* ASin Intrinsic:: Arc sine.
+@end ifset
+@ifset familyVXT
+* ASinD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Associated Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* ATan Intrinsic:: Arc tangent.
+* ATan2 Intrinsic:: Arc tangent.
+@end ifset
+@ifset familyVXT
+* ATan2D Intrinsic:: (Reserved for future use.)
+* ATanD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* BesJ0 Intrinsic:: Bessel function.
+* BesJ1 Intrinsic:: Bessel function.
+* BesJN Intrinsic:: Bessel function.
+* BesY0 Intrinsic:: Bessel function.
+* BesY1 Intrinsic:: Bessel function.
+* BesYN Intrinsic:: Bessel function.
+@end ifset
+@ifset familyVXT
+* BITest Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Bit_Size Intrinsic:: Number of bits in argument's type.
+@end ifset
+@ifset familyVXT
+* BJTest Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyMIL
+* BTest Intrinsic:: Test bit.
+@end ifset
+@ifset familyF77
+* CAbs Intrinsic:: Absolute value (archaic).
+* CCos Intrinsic:: Cosine (archaic).
+@end ifset
+@ifset familyFVZ
+* CDAbs Intrinsic:: Absolute value (archaic).
+* CDCos Intrinsic:: Cosine (archaic).
+* CDExp Intrinsic:: Exponential (archaic).
+* CDLog Intrinsic:: Natural logarithm (archaic).
+* CDSin Intrinsic:: Sine (archaic).
+* CDSqRt Intrinsic:: Square root (archaic).
+@end ifset
+@ifset familyF90
+* Ceiling Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* CExp Intrinsic:: Exponential (archaic).
+* Char Intrinsic:: Character from code.
+@end ifset
+@ifset familyF2U
+* ChDir Intrinsic (subroutine):: Change directory.
+@end ifset
+@ifset familyBADU77
+* ChDir Intrinsic (function):: Change directory.
+@end ifset
+@ifset familyF2U
+* ChMod Intrinsic (subroutine):: Change file modes.
+@end ifset
+@ifset familyBADU77
+* ChMod Intrinsic (function):: Change file modes.
+@end ifset
+@ifset familyF77
+* CLog Intrinsic:: Natural logarithm (archaic).
+* Cmplx Intrinsic:: Construct @code{COMPLEX(KIND=1)} value.
+@end ifset
+@ifset familyGNU
+* Complex Intrinsic:: Build complex value from real and
+ imaginary parts.
+@end ifset
+@ifset familyF77
+* Conjg Intrinsic:: Complex conjugate.
+* Cos Intrinsic:: Cosine.
+@end ifset
+@ifset familyVXT
+* CosD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* CosH Intrinsic:: Hyperbolic cosine.
+@end ifset
+@ifset familyF90
+* Count Intrinsic:: (Reserved for future use.)
+* Cpu_Time Intrinsic:: Get current CPU time.
+* CShift Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* CSin Intrinsic:: Sine (archaic).
+* CSqRt Intrinsic:: Square root (archaic).
+@end ifset
+@ifset familyF2U
+* CTime Intrinsic (subroutine):: Convert time to Day Mon dd hh:mm:ss yyyy.
+* CTime Intrinsic (function):: Convert time to Day Mon dd hh:mm:ss yyyy.
+@end ifset
+@ifset familyF77
+* DAbs Intrinsic:: Absolute value (archaic).
+* DACos Intrinsic:: Arc cosine (archaic).
+@end ifset
+@ifset familyVXT
+* DACosD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DASin Intrinsic:: Arc sine (archaic).
+@end ifset
+@ifset familyVXT
+* DASinD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DATan Intrinsic:: Arc tangent (archaic).
+* DATan2 Intrinsic:: Arc tangent (archaic).
+@end ifset
+@ifset familyVXT
+* DATan2D Intrinsic:: (Reserved for future use.)
+* DATanD Intrinsic:: (Reserved for future use.)
+* Date Intrinsic:: Get current date as dd-Mon-yy.
+@end ifset
+@ifset familyF90
+* Date_and_Time Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* DbesJ0 Intrinsic:: Bessel function (archaic).
+* DbesJ1 Intrinsic:: Bessel function (archaic).
+* DbesJN Intrinsic:: Bessel function (archaic).
+* DbesY0 Intrinsic:: Bessel function (archaic).
+* DbesY1 Intrinsic:: Bessel function (archaic).
+* DbesYN Intrinsic:: Bessel function (archaic).
+@end ifset
+@ifset familyF77
+* Dble Intrinsic:: Convert to double precision.
+@end ifset
+@ifset familyVXT
+* DbleQ Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyFVZ
+* DCmplx Intrinsic:: Construct @code{COMPLEX(KIND=2)} value.
+* DConjg Intrinsic:: Complex conjugate (archaic).
+@end ifset
+@ifset familyF77
+* DCos Intrinsic:: Cosine (archaic).
+@end ifset
+@ifset familyVXT
+* DCosD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DCosH Intrinsic:: Hyperbolic cosine (archaic).
+* DDiM Intrinsic:: Difference magnitude (archaic).
+@end ifset
+@ifset familyF2U
+* DErF Intrinsic:: Error function (archaic).
+* DErFC Intrinsic:: Complementary error function (archaic).
+@end ifset
+@ifset familyF77
+* DExp Intrinsic:: Exponential (archaic).
+@end ifset
+@ifset familyFVZ
+* DFloat Intrinsic:: Conversion (archaic).
+@end ifset
+@ifset familyVXT
+* DFlotI Intrinsic:: (Reserved for future use.)
+* DFlotJ Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Digits Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DiM Intrinsic:: Difference magnitude (non-negative subtract).
+@end ifset
+@ifset familyFVZ
+* DImag Intrinsic:: Convert/extract imaginary part of complex (archaic).
+@end ifset
+@ifset familyF77
+* DInt Intrinsic:: Truncate to whole number (archaic).
+* DLog Intrinsic:: Natural logarithm (archaic).
+* DLog10 Intrinsic:: Natural logarithm (archaic).
+* DMax1 Intrinsic:: Maximum value (archaic).
+* DMin1 Intrinsic:: Minimum value (archaic).
+* DMod Intrinsic:: Remainder (archaic).
+* DNInt Intrinsic:: Round to nearest whole number (archaic).
+@end ifset
+@ifset familyF90
+* Dot_Product Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DProd Intrinsic:: Double-precision product.
+@end ifset
+@ifset familyVXT
+* DReal Intrinsic:: Convert value to type @code{REAL(KIND=2)}.
+@end ifset
+@ifset familyF77
+* DSign Intrinsic:: Apply sign to magnitude (archaic).
+* DSin Intrinsic:: Sine (archaic).
+@end ifset
+@ifset familyVXT
+* DSinD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DSinH Intrinsic:: Hyperbolic sine (archaic).
+* DSqRt Intrinsic:: Square root (archaic).
+* DTan Intrinsic:: Tangent (archaic).
+@end ifset
+@ifset familyVXT
+* DTanD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DTanH Intrinsic:: Hyperbolic tangent (archaic).
+@end ifset
+@ifset familyF2U
+* Dtime Intrinsic (subroutine):: Get elapsed time since last time.
+@end ifset
+@ifset familyBADU77
+* Dtime Intrinsic (function):: Get elapsed time since last time.
+@end ifset
+@ifset familyF90
+* EOShift Intrinsic:: (Reserved for future use.)
+* Epsilon Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* ErF Intrinsic:: Error function.
+* ErFC Intrinsic:: Complementary error function.
+* ETime Intrinsic (subroutine):: Get elapsed time for process.
+* ETime Intrinsic (function):: Get elapsed time for process.
+* Exit Intrinsic:: Terminate the program.
+@end ifset
+@ifset familyF77
+* Exp Intrinsic:: Exponential.
+@end ifset
+@ifset familyF90
+* Exponent Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Fdate Intrinsic (subroutine):: Get current time as Day Mon dd hh:mm:ss yyyy.
+* Fdate Intrinsic (function):: Get current time as Day Mon dd hh:mm:ss yyyy.
+* FGet Intrinsic (subroutine):: Read a character from unit 5 stream-wise.
+@end ifset
+@ifset familyBADU77
+* FGet Intrinsic (function):: Read a character from unit 5 stream-wise.
+@end ifset
+@ifset familyF2U
+* FGetC Intrinsic (subroutine):: Read a character stream-wise.
+@end ifset
+@ifset familyBADU77
+* FGetC Intrinsic (function):: Read a character stream-wise.
+@end ifset
+@ifset familyF77
+* Float Intrinsic:: Conversion (archaic).
+@end ifset
+@ifset familyVXT
+* FloatI Intrinsic:: (Reserved for future use.)
+* FloatJ Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Floor Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Flush Intrinsic:: Flush buffered output.
+* FNum Intrinsic:: Get file descriptor from Fortran unit number.
+* FPut Intrinsic (subroutine):: Write a character to unit 6 stream-wise.
+@end ifset
+@ifset familyBADU77
+* FPut Intrinsic (function):: Write a character to unit 6 stream-wise.
+@end ifset
+@ifset familyF2U
+* FPutC Intrinsic (subroutine):: Write a character stream-wise.
+@end ifset
+@ifset familyBADU77
+* FPutC Intrinsic (function):: Write a character stream-wise.
+@end ifset
+@ifset familyF90
+* Fraction Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* FSeek Intrinsic:: Position file (low-level).
+* FStat Intrinsic (subroutine):: Get file information.
+* FStat Intrinsic (function):: Get file information.
+* FTell Intrinsic (subroutine):: Get file position (low-level).
+* FTell Intrinsic (function):: Get file position (low-level).
+* GError Intrinsic:: Get error message for last error.
+* GetArg Intrinsic:: Obtain command-line argument.
+* GetCWD Intrinsic (subroutine):: Get current working directory.
+* GetCWD Intrinsic (function):: Get current working directory.
+* GetEnv Intrinsic:: Get environment variable.
+* GetGId Intrinsic:: Get process group id.
+* GetLog Intrinsic:: Get login name.
+* GetPId Intrinsic:: Get process id.
+* GetUId Intrinsic:: Get process user id.
+* GMTime Intrinsic:: Convert time to GMT time info.
+* HostNm Intrinsic (subroutine):: Get host name.
+* HostNm Intrinsic (function):: Get host name.
+@end ifset
+@ifset familyF90
+* Huge Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* IAbs Intrinsic:: Absolute value (archaic).
+@end ifset
+@ifset familyASC
+* IAChar Intrinsic:: ASCII code for character.
+@end ifset
+@ifset familyMIL
+* IAnd Intrinsic:: Boolean AND.
+@end ifset
+@ifset familyF2U
+* IArgC Intrinsic:: Obtain count of command-line arguments.
+@end ifset
+@ifset familyMIL
+* IBClr Intrinsic:: Clear a bit.
+* IBits Intrinsic:: Extract a bit subfield of a variable.
+* IBSet Intrinsic:: Set a bit.
+@end ifset
+@ifset familyF77
+* IChar Intrinsic:: Code for character.
+@end ifset
+@ifset familyF2U
+* IDate Intrinsic (UNIX):: Get local time info.
+@end ifset
+@ifset familyVXT
+* IDate Intrinsic (VXT):: Get local time info (VAX/VMS).
+@end ifset
+@ifset familyF77
+* IDiM Intrinsic:: Difference magnitude (archaic).
+* IDInt Intrinsic:: Convert to @code{INTEGER} value truncated
+ to whole number (archaic).
+* IDNInt Intrinsic:: Convert to @code{INTEGER} value rounded
+ to nearest whole number (archaic).
+@end ifset
+@ifset familyMIL
+* IEOr Intrinsic:: Boolean XOR.
+@end ifset
+@ifset familyF2U
+* IErrNo Intrinsic:: Get error number for last error.
+@end ifset
+@ifset familyF77
+* IFix Intrinsic:: Conversion (archaic).
+@end ifset
+@ifset familyVXT
+* IIAbs Intrinsic:: (Reserved for future use.)
+* IIAnd Intrinsic:: (Reserved for future use.)
+* IIBClr Intrinsic:: (Reserved for future use.)
+* IIBits Intrinsic:: (Reserved for future use.)
+* IIBSet Intrinsic:: (Reserved for future use.)
+* IIDiM Intrinsic:: (Reserved for future use.)
+* IIDInt Intrinsic:: (Reserved for future use.)
+* IIDNnt Intrinsic:: (Reserved for future use.)
+* IIEOr Intrinsic:: (Reserved for future use.)
+* IIFix Intrinsic:: (Reserved for future use.)
+* IInt Intrinsic:: (Reserved for future use.)
+* IIOr Intrinsic:: (Reserved for future use.)
+* IIQint Intrinsic:: (Reserved for future use.)
+* IIQNnt Intrinsic:: (Reserved for future use.)
+* IIShftC Intrinsic:: (Reserved for future use.)
+* IISign Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2C
+* Imag Intrinsic:: Extract imaginary part of complex.
+@end ifset
+@ifset familyGNU
+* ImagPart Intrinsic:: Extract imaginary part of complex.
+@end ifset
+@ifset familyVXT
+* IMax0 Intrinsic:: (Reserved for future use.)
+* IMax1 Intrinsic:: (Reserved for future use.)
+* IMin0 Intrinsic:: (Reserved for future use.)
+* IMin1 Intrinsic:: (Reserved for future use.)
+* IMod Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Index Intrinsic:: Locate a CHARACTER substring.
+@end ifset
+@ifset familyVXT
+* INInt Intrinsic:: (Reserved for future use.)
+* INot Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Int Intrinsic:: Convert to @code{INTEGER} value truncated
+ to whole number.
+@end ifset
+@ifset familyGNU
+* Int2 Intrinsic:: Convert to @code{INTEGER(KIND=6)} value
+ truncated to whole number.
+* Int8 Intrinsic:: Convert to @code{INTEGER(KIND=2)} value
+ truncated to whole number.
+@end ifset
+@ifset familyMIL
+* IOr Intrinsic:: Boolean OR.
+@end ifset
+@ifset familyF2U
+* IRand Intrinsic:: Random number.
+* IsaTty Intrinsic:: Is unit connected to a terminal?
+@end ifset
+@ifset familyMIL
+* IShft Intrinsic:: Logical bit shift.
+* IShftC Intrinsic:: Circular bit shift.
+@end ifset
+@ifset familyF77
+* ISign Intrinsic:: Apply sign to magnitude (archaic).
+@end ifset
+@ifset familyF2U
+* ITime Intrinsic:: Get local time of day.
+@end ifset
+@ifset familyVXT
+* IZExt Intrinsic:: (Reserved for future use.)
+* JIAbs Intrinsic:: (Reserved for future use.)
+* JIAnd Intrinsic:: (Reserved for future use.)
+* JIBClr Intrinsic:: (Reserved for future use.)
+* JIBits Intrinsic:: (Reserved for future use.)
+* JIBSet Intrinsic:: (Reserved for future use.)
+* JIDiM Intrinsic:: (Reserved for future use.)
+* JIDInt Intrinsic:: (Reserved for future use.)
+* JIDNnt Intrinsic:: (Reserved for future use.)
+* JIEOr Intrinsic:: (Reserved for future use.)
+* JIFix Intrinsic:: (Reserved for future use.)
+* JInt Intrinsic:: (Reserved for future use.)
+* JIOr Intrinsic:: (Reserved for future use.)
+* JIQint Intrinsic:: (Reserved for future use.)
+* JIQNnt Intrinsic:: (Reserved for future use.)
+* JIShft Intrinsic:: (Reserved for future use.)
+* JIShftC Intrinsic:: (Reserved for future use.)
+* JISign Intrinsic:: (Reserved for future use.)
+* JMax0 Intrinsic:: (Reserved for future use.)
+* JMax1 Intrinsic:: (Reserved for future use.)
+* JMin0 Intrinsic:: (Reserved for future use.)
+* JMin1 Intrinsic:: (Reserved for future use.)
+* JMod Intrinsic:: (Reserved for future use.)
+* JNInt Intrinsic:: (Reserved for future use.)
+* JNot Intrinsic:: (Reserved for future use.)
+* JZExt Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Kill Intrinsic (subroutine):: Signal a process.
+@end ifset
+@ifset familyBADU77
+* Kill Intrinsic (function):: Signal a process.
+@end ifset
+@ifset familyF90
+* Kind Intrinsic:: (Reserved for future use.)
+* LBound Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Len Intrinsic:: Length of character entity.
+@end ifset
+@ifset familyF90
+* Len_Trim Intrinsic:: Get last non-blank character in string.
+@end ifset
+@ifset familyF77
+* LGe Intrinsic:: Lexically greater than or equal.
+* LGt Intrinsic:: Lexically greater than.
+@end ifset
+@ifset familyF2U
+* Link Intrinsic (subroutine):: Make hard link in file system.
+@end ifset
+@ifset familyBADU77
+* Link Intrinsic (function):: Make hard link in file system.
+@end ifset
+@ifset familyF77
+* LLe Intrinsic:: Lexically less than or equal.
+* LLt Intrinsic:: Lexically less than.
+@end ifset
+@ifset familyF2U
+* LnBlnk Intrinsic:: Get last non-blank character in string.
+* Loc Intrinsic:: Address of entity in core.
+@end ifset
+@ifset familyF77
+* Log Intrinsic:: Natural logarithm.
+* Log10 Intrinsic:: Natural logarithm.
+@end ifset
+@ifset familyF90
+* Logical Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Long Intrinsic:: Conversion to @code{INTEGER(KIND=1)} (archaic).
+@end ifset
+@ifset familyF2C
+* LShift Intrinsic:: Left-shift bits.
+@end ifset
+@ifset familyF2U
+* LStat Intrinsic (subroutine):: Get file information.
+* LStat Intrinsic (function):: Get file information.
+* LTime Intrinsic:: Convert time to local time info.
+@end ifset
+@ifset familyF90
+* MatMul Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Max Intrinsic:: Maximum value.
+* Max0 Intrinsic:: Maximum value (archaic).
+* Max1 Intrinsic:: Maximum value (archaic).
+@end ifset
+@ifset familyF90
+* MaxExponent Intrinsic:: (Reserved for future use.)
+* MaxLoc Intrinsic:: (Reserved for future use.)
+* MaxVal Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* MClock Intrinsic:: Get number of clock ticks for process.
+* MClock8 Intrinsic:: Get number of clock ticks for process.
+@end ifset
+@ifset familyF90
+* Merge Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Min Intrinsic:: Minimum value.
+* Min0 Intrinsic:: Minimum value (archaic).
+* Min1 Intrinsic:: Minimum value (archaic).
+@end ifset
+@ifset familyF90
+* MinExponent Intrinsic:: (Reserved for future use.)
+* MinLoc Intrinsic:: (Reserved for future use.)
+* MinVal Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Mod Intrinsic:: Remainder.
+@end ifset
+@ifset familyF90
+* Modulo Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyMIL
+* MvBits Intrinsic:: Moving a bit field.
+@end ifset
+@ifset familyF90
+* Nearest Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* NInt Intrinsic:: Convert to @code{INTEGER} value rounded
+ to nearest whole number.
+@end ifset
+@ifset familyMIL
+* Not Intrinsic:: Boolean NOT.
+@end ifset
+@ifset familyF2C
+* Or Intrinsic:: Boolean OR.
+@end ifset
+@ifset familyF90
+* Pack Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* PError Intrinsic:: Print error message for last error.
+@end ifset
+@ifset familyF90
+* Precision Intrinsic:: (Reserved for future use.)
+* Present Intrinsic:: (Reserved for future use.)
+* Product Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyVXT
+* QAbs Intrinsic:: (Reserved for future use.)
+* QACos Intrinsic:: (Reserved for future use.)
+* QACosD Intrinsic:: (Reserved for future use.)
+* QASin Intrinsic:: (Reserved for future use.)
+* QASinD Intrinsic:: (Reserved for future use.)
+* QATan Intrinsic:: (Reserved for future use.)
+* QATan2 Intrinsic:: (Reserved for future use.)
+* QATan2D Intrinsic:: (Reserved for future use.)
+* QATanD Intrinsic:: (Reserved for future use.)
+* QCos Intrinsic:: (Reserved for future use.)
+* QCosD Intrinsic:: (Reserved for future use.)
+* QCosH Intrinsic:: (Reserved for future use.)
+* QDiM Intrinsic:: (Reserved for future use.)
+* QExp Intrinsic:: (Reserved for future use.)
+* QExt Intrinsic:: (Reserved for future use.)
+* QExtD Intrinsic:: (Reserved for future use.)
+* QFloat Intrinsic:: (Reserved for future use.)
+* QInt Intrinsic:: (Reserved for future use.)
+* QLog Intrinsic:: (Reserved for future use.)
+* QLog10 Intrinsic:: (Reserved for future use.)
+* QMax1 Intrinsic:: (Reserved for future use.)
+* QMin1 Intrinsic:: (Reserved for future use.)
+* QMod Intrinsic:: (Reserved for future use.)
+* QNInt Intrinsic:: (Reserved for future use.)
+* QSin Intrinsic:: (Reserved for future use.)
+* QSinD Intrinsic:: (Reserved for future use.)
+* QSinH Intrinsic:: (Reserved for future use.)
+* QSqRt Intrinsic:: (Reserved for future use.)
+* QTan Intrinsic:: (Reserved for future use.)
+* QTanD Intrinsic:: (Reserved for future use.)
+* QTanH Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Radix Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Rand Intrinsic:: Random number.
+@end ifset
+@ifset familyF90
+* Random_Number Intrinsic:: (Reserved for future use.)
+* Random_Seed Intrinsic:: (Reserved for future use.)
+* Range Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Real Intrinsic:: Convert value to type @code{REAL(KIND=1)}.
+@end ifset
+@ifset familyGNU
+* RealPart Intrinsic:: Extract real part of complex.
+@end ifset
+@ifset familyF2U
+* Rename Intrinsic (subroutine):: Rename file.
+@end ifset
+@ifset familyBADU77
+* Rename Intrinsic (function):: Rename file.
+@end ifset
+@ifset familyF90
+* Repeat Intrinsic:: (Reserved for future use.)
+* Reshape Intrinsic:: (Reserved for future use.)
+* RRSpacing Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2C
+* RShift Intrinsic:: Right-shift bits.
+@end ifset
+@ifset familyF90
+* Scale Intrinsic:: (Reserved for future use.)
+* Scan Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyVXT
+* Secnds Intrinsic:: Get local time offset since midnight.
+@end ifset
+@ifset familyF2U
+* Second Intrinsic (function):: Get CPU time for process in seconds.
+* Second Intrinsic (subroutine):: Get CPU time for process
+ in seconds.
+@end ifset
+@ifset familyF90
+* Selected_Int_Kind Intrinsic:: (Reserved for future use.)
+* Selected_Real_Kind Intrinsic:: (Reserved for future use.)
+* Set_Exponent Intrinsic:: (Reserved for future use.)
+* Shape Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Short Intrinsic:: Convert to @code{INTEGER(KIND=6)} value
+ truncated to whole number.
+@end ifset
+@ifset familyF77
+* Sign Intrinsic:: Apply sign to magnitude.
+@end ifset
+@ifset familyF2U
+* Signal Intrinsic (subroutine):: Muck with signal handling.
+@end ifset
+@ifset familyBADU77
+* Signal Intrinsic (function):: Muck with signal handling.
+@end ifset
+@ifset familyF77
+* Sin Intrinsic:: Sine.
+@end ifset
+@ifset familyVXT
+* SinD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* SinH Intrinsic:: Hyperbolic sine.
+@end ifset
+@ifset familyF2U
+* Sleep Intrinsic:: Sleep for a specified time.
+@end ifset
+@ifset familyF77
+* Sngl Intrinsic:: Convert (archaic).
+@end ifset
+@ifset familyVXT
+* SnglQ Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Spacing Intrinsic:: (Reserved for future use.)
+* Spread Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* SqRt Intrinsic:: Square root.
+@end ifset
+@ifset familyF2U
+* SRand Intrinsic:: Random seed.
+* Stat Intrinsic (subroutine):: Get file information.
+* Stat Intrinsic (function):: Get file information.
+@end ifset
+@ifset familyF90
+* Sum Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* SymLnk Intrinsic (subroutine):: Make symbolic link in file system.
+@end ifset
+@ifset familyBADU77
+* SymLnk Intrinsic (function):: Make symbolic link in file system.
+@end ifset
+@ifset familyF2U
+* System Intrinsic (subroutine):: Invoke shell (system) command.
+@end ifset
+@ifset familyBADU77
+* System Intrinsic (function):: Invoke shell (system) command.
+@end ifset
+@ifset familyF90
+* System_Clock Intrinsic:: Get current system clock value.
+@end ifset
+@ifset familyF77
+* Tan Intrinsic:: Tangent.
+@end ifset
+@ifset familyVXT
+* TanD Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* TanH Intrinsic:: Hyperbolic tangent.
+@end ifset
+@ifset familyF2U
+* Time Intrinsic (UNIX):: Get current time as time value.
+@end ifset
+@ifset familyVXT
+* Time Intrinsic (VXT):: Get the time as a character value.
+@end ifset
+@ifset familyF2U
+* Time8 Intrinsic:: Get current time as time value.
+@end ifset
+@ifset familyF90
+* Tiny Intrinsic:: (Reserved for future use.)
+* Transfer Intrinsic:: (Reserved for future use.)
+* Transpose Intrinsic:: (Reserved for future use.)
+* Trim Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* TtyNam Intrinsic (subroutine):: Get name of terminal device for unit.
+* TtyNam Intrinsic (function):: Get name of terminal device for unit.
+@end ifset
+@ifset familyF90
+* UBound Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* UMask Intrinsic (subroutine):: Set file creation permissions mask.
+@end ifset
+@ifset familyBADU77
+* UMask Intrinsic (function):: Set file creation permissions mask.
+@end ifset
+@ifset familyF2U
+* Unlink Intrinsic (subroutine):: Unlink file.
+@end ifset
+@ifset familyBADU77
+* Unlink Intrinsic (function):: Unlink file.
+@end ifset
+@ifset familyF90
+* Unpack Intrinsic:: (Reserved for future use.)
+* Verify Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2C
+* XOr Intrinsic:: Boolean XOR.
+* ZAbs Intrinsic:: Absolute value (archaic).
+* ZCos Intrinsic:: Cosine (archaic).
+* ZExp Intrinsic:: Exponential (archaic).
+@end ifset
+@ifset familyVXT
+* ZExt Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2C
+* ZLog Intrinsic:: Natural logarithm (archaic).
+* ZSin Intrinsic:: Sine (archaic).
+* ZSqRt Intrinsic:: Square root (archaic).
+@end ifset
+@end menu
+
+@ifset familyF2U
+@node Abort Intrinsic
+@subsubsection Abort Intrinsic
+@cindex Abort intrinsic
+@cindex intrinsics, Abort
+
+@noindent
+@example
+CALL Abort()
+@end example
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Prints a message and potentially causes a core dump via @code{abort(3)}.
+
+@end ifset
+@ifset familyF77
+@node Abs Intrinsic
+@subsubsection Abs Intrinsic
+@cindex Abs intrinsic
+@cindex intrinsics, Abs
+
+@noindent
+@example
+Abs(@var{A})
+@end example
+
+@noindent
+Abs: @code{INTEGER} or @code{REAL} function.
+The exact type depends on that of argument @var{A}---if @var{A} is
+@code{COMPLEX}, this function's type is @code{REAL}
+with the same @samp{KIND=} value as the type of @var{A}.
+Otherwise, this function's type is the same as that of @var{A}.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the absolute value of @var{A}.
+
+If @var{A} is type @code{COMPLEX}, the absolute
+value is computed as:
+
+@example
+SQRT(REALPART(@var{A})**2, IMAGPART(@var{A})**2)
+@end example
+
+@noindent
+Otherwise, it is computed by negating the @var{A} if
+it is negative, or returning @var{A}.
+
+@xref{Sign Intrinsic}, for how to explicitly
+compute the positive or negative form of the absolute
+value of an expression.
+
+@end ifset
+@ifset familyF2U
+@node Access Intrinsic
+@subsubsection Access Intrinsic
+@cindex Access intrinsic
+@cindex intrinsics, Access
+
+@noindent
+@example
+Access(@var{Name}, @var{Mode})
+@end example
+
+@noindent
+Access: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Checks file @var{Name} for accessibility in the mode specified by @var{Mode} and
+returns 0 if the file is accessible in that mode, otherwise an error
+code if the file is inaccessible or @var{Mode} is invalid.
+See @code{access(2)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{Name}---otherwise,
+trailing blanks in @var{Name} are ignored.
+@var{Mode} may be a concatenation of any of the following characters:
+
+@table @samp
+@item r
+Read permission
+
+@item w
+Write permission
+
+@item x
+Execute permission
+
+@item @kbd{SPC}
+Existence
+@end table
+
+@end ifset
+@ifset familyASC
+@node AChar Intrinsic
+@subsubsection AChar Intrinsic
+@cindex AChar intrinsic
+@cindex intrinsics, AChar
+
+@noindent
+@example
+AChar(@var{I})
+@end example
+
+@noindent
+AChar: @code{CHARACTER*1} function.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{f90}.
+
+@noindent
+Description:
+
+Returns the ASCII character corresponding to the
+code specified by @var{I}.
+
+@xref{IAChar Intrinsic}, for the inverse of this function.
+
+@xref{Char Intrinsic}, for the function corresponding
+to the system's native character set.
+
+@end ifset
+@ifset familyF77
+@node ACos Intrinsic
+@subsubsection ACos Intrinsic
+@cindex ACos intrinsic
+@cindex intrinsics, ACos
+
+@noindent
+@example
+ACos(@var{X})
+@end example
+
+@noindent
+ACos: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the arc-cosine (inverse cosine) of @var{X}
+in radians.
+
+@xref{Cos Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node ACosD Intrinsic
+@subsubsection ACosD Intrinsic
+@cindex ACosD intrinsic
+@cindex intrinsics, ACosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ACosD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node AdjustL Intrinsic
+@subsubsection AdjustL Intrinsic
+@cindex AdjustL intrinsic
+@cindex intrinsics, AdjustL
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AdjustL} to use this name for an
+external procedure.
+
+@node AdjustR Intrinsic
+@subsubsection AdjustR Intrinsic
+@cindex AdjustR intrinsic
+@cindex intrinsics, AdjustR
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AdjustR} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node AImag Intrinsic
+@subsubsection AImag Intrinsic
+@cindex AImag intrinsic
+@cindex intrinsics, AImag
+
+@noindent
+@example
+AImag(@var{Z})
+@end example
+
+@noindent
+AImag: @code{REAL} function.
+This intrinsic is valid when argument @var{Z} is
+@code{COMPLEX(KIND=1)}.
+When @var{Z} is any other @code{COMPLEX} type,
+this intrinsic is valid only when used as the argument to
+@code{REAL()}, as explained below.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the (possibly converted) imaginary part of @var{Z}.
+
+Use of @code{AIMAG()} with an argument of a type
+other than @code{COMPLEX(KIND=1)} is restricted to the following case:
+
+@example
+REAL(AIMAG(Z))
+@end example
+
+@noindent
+This expression converts the imaginary part of Z to
+@code{REAL(KIND=1)}.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyVXT
+@node AIMax0 Intrinsic
+@subsubsection AIMax0 Intrinsic
+@cindex AIMax0 intrinsic
+@cindex intrinsics, AIMax0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AIMax0} to use this name for an
+external procedure.
+
+@node AIMin0 Intrinsic
+@subsubsection AIMin0 Intrinsic
+@cindex AIMin0 intrinsic
+@cindex intrinsics, AIMin0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AIMin0} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node AInt Intrinsic
+@subsubsection AInt Intrinsic
+@cindex AInt intrinsic
+@cindex intrinsics, AInt
+
+@noindent
+@example
+AInt(@var{A})
+@end example
+
+@noindent
+AInt: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{A}.
+
+@noindent
+@var{A}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved.
+(Also called ``truncation towards zero''.)
+
+@xref{ANInt Intrinsic}, for how to round to nearest
+whole number.
+
+@xref{Int Intrinsic}, for how to truncate and then convert
+number to @code{INTEGER}.
+
+@end ifset
+@ifset familyVXT
+@node AJMax0 Intrinsic
+@subsubsection AJMax0 Intrinsic
+@cindex AJMax0 intrinsic
+@cindex intrinsics, AJMax0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AJMax0} to use this name for an
+external procedure.
+
+@node AJMin0 Intrinsic
+@subsubsection AJMin0 Intrinsic
+@cindex AJMin0 intrinsic
+@cindex intrinsics, AJMin0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AJMin0} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Alarm Intrinsic
+@subsubsection Alarm Intrinsic
+@cindex Alarm intrinsic
+@cindex intrinsics, Alarm
+
+@noindent
+@example
+CALL Alarm(@var{Seconds}, @var{Handler}, @var{Status})
+@end example
+
+@noindent
+@var{Seconds}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+or dummy/global @code{INTEGER(KIND=1)} scalar.
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@end ifset
+@ifset familyF90
+@node All Intrinsic
+@subsubsection All Intrinsic
+@cindex All intrinsic
+@cindex intrinsics, All
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL All} to use this name for an
+external procedure.
+
+@node Allocated Intrinsic
+@subsubsection Allocated Intrinsic
+@cindex Allocated intrinsic
+@cindex intrinsics, Allocated
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Allocated} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node ALog Intrinsic
+@subsubsection ALog Intrinsic
+@cindex ALog intrinsic
+@cindex intrinsics, ALog
+
+@noindent
+@example
+ALog(@var{X})
+@end example
+
+@noindent
+ALog: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node ALog10 Intrinsic
+@subsubsection ALog10 Intrinsic
+@cindex ALog10 intrinsic
+@cindex intrinsics, ALog10
+
+@noindent
+@example
+ALog10(@var{X})
+@end example
+
+@noindent
+ALog10: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG10()} that is specific
+to one type for @var{X}.
+@xref{Log10 Intrinsic}.
+
+@node AMax0 Intrinsic
+@subsubsection AMax0 Intrinsic
+@cindex AMax0 intrinsic
+@cindex intrinsics, AMax0
+
+@noindent
+@example
+AMax0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+AMax0: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A} and a different return type.
+@xref{Max Intrinsic}.
+
+@node AMax1 Intrinsic
+@subsubsection AMax1 Intrinsic
+@cindex AMax1 intrinsic
+@cindex intrinsics, AMax1
+
+@noindent
+@example
+AMax1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+AMax1: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A}.
+@xref{Max Intrinsic}.
+
+@node AMin0 Intrinsic
+@subsubsection AMin0 Intrinsic
+@cindex AMin0 intrinsic
+@cindex intrinsics, AMin0
+
+@noindent
+@example
+AMin0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+AMin0: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A} and a different return type.
+@xref{Min Intrinsic}.
+
+@node AMin1 Intrinsic
+@subsubsection AMin1 Intrinsic
+@cindex AMin1 intrinsic
+@cindex intrinsics, AMin1
+
+@noindent
+@example
+AMin1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+AMin1: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A}.
+@xref{Min Intrinsic}.
+
+@node AMod Intrinsic
+@subsubsection AMod Intrinsic
+@cindex AMod intrinsic
+@cindex intrinsics, AMod
+
+@noindent
+@example
+AMod(@var{A}, @var{P})
+@end example
+
+@noindent
+AMod: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{P}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MOD()} that is specific
+to one type for @var{A}.
+@xref{Mod Intrinsic}.
+
+@end ifset
+@ifset familyF2C
+@node And Intrinsic
+@subsubsection And Intrinsic
+@cindex And intrinsic
+@cindex intrinsics, And
+
+@noindent
+@example
+And(@var{I}, @var{J})
+@end example
+
+@noindent
+And: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean AND of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF77
+@node ANInt Intrinsic
+@subsubsection ANInt Intrinsic
+@cindex ANInt intrinsic
+@cindex intrinsics, ANInt
+
+@noindent
+@example
+ANInt(@var{A})
+@end example
+
+@noindent
+ANInt: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{A}.
+
+@noindent
+@var{A}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude eliminated by rounding to the nearest whole
+number and with its sign preserved.
+
+A fractional portion exactly equal to
+@samp{.5} is rounded to the whole number that
+is larger in magnitude.
+(Also called ``Fortran round''.)
+
+@xref{AInt Intrinsic}, for how to truncate to
+whole number.
+
+@xref{NInt Intrinsic}, for how to round and then convert
+number to @code{INTEGER}.
+
+@end ifset
+@ifset familyF90
+@node Any Intrinsic
+@subsubsection Any Intrinsic
+@cindex Any intrinsic
+@cindex intrinsics, Any
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Any} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node ASin Intrinsic
+@subsubsection ASin Intrinsic
+@cindex ASin intrinsic
+@cindex intrinsics, ASin
+
+@noindent
+@example
+ASin(@var{X})
+@end example
+
+@noindent
+ASin: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the arc-sine (inverse sine) of @var{X}
+in radians.
+
+@xref{Sin Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node ASinD Intrinsic
+@subsubsection ASinD Intrinsic
+@cindex ASinD intrinsic
+@cindex intrinsics, ASinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ASinD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Associated Intrinsic
+@subsubsection Associated Intrinsic
+@cindex Associated intrinsic
+@cindex intrinsics, Associated
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Associated} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node ATan Intrinsic
+@subsubsection ATan Intrinsic
+@cindex ATan intrinsic
+@cindex intrinsics, ATan
+
+@noindent
+@example
+ATan(@var{X})
+@end example
+
+@noindent
+ATan: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the arc-tangent (inverse tangent) of @var{X}
+in radians.
+
+@xref{Tan Intrinsic}, for the inverse of this function.
+
+@node ATan2 Intrinsic
+@subsubsection ATan2 Intrinsic
+@cindex ATan2 intrinsic
+@cindex intrinsics, ATan2
+
+@noindent
+@example
+ATan2(@var{Y}, @var{X})
+@end example
+
+@noindent
+ATan2: @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{Y}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the arc-tangent (inverse tangent) of the complex
+number (@var{Y}, @var{X}) in radians.
+
+@xref{Tan Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node ATan2D Intrinsic
+@subsubsection ATan2D Intrinsic
+@cindex ATan2D intrinsic
+@cindex intrinsics, ATan2D
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ATan2D} to use this name for an
+external procedure.
+
+@node ATanD Intrinsic
+@subsubsection ATanD Intrinsic
+@cindex ATanD intrinsic
+@cindex intrinsics, ATanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ATanD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node BesJ0 Intrinsic
+@subsubsection BesJ0 Intrinsic
+@cindex BesJ0 intrinsic
+@cindex intrinsics, BesJ0
+
+@noindent
+@example
+BesJ0(@var{X})
+@end example
+
+@noindent
+BesJ0: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the first kind of order 0 of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesJ1 Intrinsic
+@subsubsection BesJ1 Intrinsic
+@cindex BesJ1 intrinsic
+@cindex intrinsics, BesJ1
+
+@noindent
+@example
+BesJ1(@var{X})
+@end example
+
+@noindent
+BesJ1: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the first kind of order 1 of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesJN Intrinsic
+@subsubsection BesJN Intrinsic
+@cindex BesJN intrinsic
+@cindex intrinsics, BesJN
+
+@noindent
+@example
+BesJN(@var{N}, @var{X})
+@end example
+
+@noindent
+BesJN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{N}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the first kind of order @var{N} of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesY0 Intrinsic
+@subsubsection BesY0 Intrinsic
+@cindex BesY0 intrinsic
+@cindex intrinsics, BesY0
+
+@noindent
+@example
+BesY0(@var{X})
+@end example
+
+@noindent
+BesY0: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the second kind of order 0 of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesY1 Intrinsic
+@subsubsection BesY1 Intrinsic
+@cindex BesY1 intrinsic
+@cindex intrinsics, BesY1
+
+@noindent
+@example
+BesY1(@var{X})
+@end example
+
+@noindent
+BesY1: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the second kind of order 1 of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesYN Intrinsic
+@subsubsection BesYN Intrinsic
+@cindex BesYN intrinsic
+@cindex intrinsics, BesYN
+
+@noindent
+@example
+BesYN(@var{N}, @var{X})
+@end example
+
+@noindent
+BesYN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{N}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the second kind of order @var{N} of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@end ifset
+@ifset familyVXT
+@node BITest Intrinsic
+@subsubsection BITest Intrinsic
+@cindex BITest intrinsic
+@cindex intrinsics, BITest
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL BITest} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Bit_Size Intrinsic
+@subsubsection Bit_Size Intrinsic
+@cindex Bit_Size intrinsic
+@cindex intrinsics, Bit_Size
+
+@noindent
+@example
+Bit_Size(@var{I})
+@end example
+
+@noindent
+Bit_Size: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar.
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns the number of bits (integer precision plus sign bit)
+represented by the type for @var{I}.
+
+@xref{BTest Intrinsic}, for how to test the value of a
+bit in a variable or array.
+
+@xref{IBSet Intrinsic}, for how to set a bit in a variable to 1.
+
+@xref{IBClr Intrinsic}, for how to set a bit in a variable to 0.
+
+
+@end ifset
+@ifset familyVXT
+@node BJTest Intrinsic
+@subsubsection BJTest Intrinsic
+@cindex BJTest intrinsic
+@cindex intrinsics, BJTest
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL BJTest} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyMIL
+@node BTest Intrinsic
+@subsubsection BTest Intrinsic
+@cindex BTest intrinsic
+@cindex intrinsics, BTest
+
+@noindent
+@example
+BTest(@var{I}, @var{Pos})
+@end example
+
+@noindent
+BTest: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns @code{.TRUE.} if bit @var{Pos} in @var{I} is
+1, @code{.FALSE.} otherwise.
+
+(Bit 0 is the low-order (rightmost) bit, adding the value
+@ifinfo
+2**0,
+@end ifinfo
+@iftex
+@tex
+$2^0$,
+@end tex
+@end iftex
+or 1,
+to the number if set to 1;
+bit 1 is the next-higher-order bit, adding
+@ifinfo
+2**1,
+@end ifinfo
+@iftex
+@tex
+$2^1$,
+@end tex
+@end iftex
+or 2;
+bit 2 adds
+@ifinfo
+2**2,
+@end ifinfo
+@iftex
+@tex
+$2^2$,
+@end tex
+@end iftex
+or 4; and so on.)
+
+@xref{Bit_Size Intrinsic}, for how to obtain the number of bits
+in a type.
+The leftmost bit of @var{I} is @samp{BIT_SIZE(@var{I}-1}.
+
+@end ifset
+@ifset familyF77
+@node CAbs Intrinsic
+@subsubsection CAbs Intrinsic
+@cindex CAbs intrinsic
+@cindex intrinsics, CAbs
+
+@noindent
+@example
+CAbs(@var{A})
+@end example
+
+@noindent
+CAbs: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@node CCos Intrinsic
+@subsubsection CCos Intrinsic
+@cindex CCos intrinsic
+@cindex intrinsics, CCos
+
+@noindent
+@example
+CCos(@var{X})
+@end example
+
+@noindent
+CCos: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{COS()} that is specific
+to one type for @var{X}.
+@xref{Cos Intrinsic}.
+
+@end ifset
+@ifset familyFVZ
+@node CDAbs Intrinsic
+@subsubsection CDAbs Intrinsic
+@cindex CDAbs intrinsic
+@cindex intrinsics, CDAbs
+
+@noindent
+@example
+CDAbs(@var{A})
+@end example
+
+@noindent
+CDAbs: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@node CDCos Intrinsic
+@subsubsection CDCos Intrinsic
+@cindex CDCos intrinsic
+@cindex intrinsics, CDCos
+
+@noindent
+@example
+CDCos(@var{X})
+@end example
+
+@noindent
+CDCos: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{COS()} that is specific
+to one type for @var{X}.
+@xref{Cos Intrinsic}.
+
+@node CDExp Intrinsic
+@subsubsection CDExp Intrinsic
+@cindex CDExp intrinsic
+@cindex intrinsics, CDExp
+
+@noindent
+@example
+CDExp(@var{X})
+@end example
+
+@noindent
+CDExp: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{EXP()} that is specific
+to one type for @var{X}.
+@xref{Exp Intrinsic}.
+
+@node CDLog Intrinsic
+@subsubsection CDLog Intrinsic
+@cindex CDLog intrinsic
+@cindex intrinsics, CDLog
+
+@noindent
+@example
+CDLog(@var{X})
+@end example
+
+@noindent
+CDLog: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node CDSin Intrinsic
+@subsubsection CDSin Intrinsic
+@cindex CDSin intrinsic
+@cindex intrinsics, CDSin
+
+@noindent
+@example
+CDSin(@var{X})
+@end example
+
+@noindent
+CDSin: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{SIN()} that is specific
+to one type for @var{X}.
+@xref{Sin Intrinsic}.
+
+@node CDSqRt Intrinsic
+@subsubsection CDSqRt Intrinsic
+@cindex CDSqRt intrinsic
+@cindex intrinsics, CDSqRt
+
+@noindent
+@example
+CDSqRt(@var{X})
+@end example
+
+@noindent
+CDSqRt: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{SQRT()} that is specific
+to one type for @var{X}.
+@xref{SqRt Intrinsic}.
+
+@end ifset
+@ifset familyF90
+@node Ceiling Intrinsic
+@subsubsection Ceiling Intrinsic
+@cindex Ceiling intrinsic
+@cindex intrinsics, Ceiling
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Ceiling} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node CExp Intrinsic
+@subsubsection CExp Intrinsic
+@cindex CExp intrinsic
+@cindex intrinsics, CExp
+
+@noindent
+@example
+CExp(@var{X})
+@end example
+
+@noindent
+CExp: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{EXP()} that is specific
+to one type for @var{X}.
+@xref{Exp Intrinsic}.
+
+@node Char Intrinsic
+@subsubsection Char Intrinsic
+@cindex Char intrinsic
+@cindex intrinsics, Char
+
+@noindent
+@example
+Char(@var{I})
+@end example
+
+@noindent
+Char: @code{CHARACTER*1} function.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the character corresponding to the
+code specified by @var{I}, using the system's
+native character set.
+
+Because the system's native character set is used,
+the correspondence between character and their codes
+is not necessarily the same between GNU Fortran
+implementations.
+
+Note that no intrinsic exists to convert a numerical
+value to a printable character string.
+For example, there is no intrinsic that, given
+an @code{INTEGER} or @code{REAL} argument with the
+value @samp{154}, returns the @code{CHARACTER}
+result @samp{'154'}.
+
+Instead, you can use internal-file I/O to do this kind
+of conversion.
+For example:
+
+@smallexample
+INTEGER VALUE
+CHARACTER*10 STRING
+VALUE = 154
+WRITE (STRING, '(I10)'), VALUE
+PRINT *, STRING
+END
+@end smallexample
+
+The above program, when run, prints:
+
+@smallexample
+ 154
+@end smallexample
+
+@xref{IChar Intrinsic}, for the inverse of the @code{CHAR} function.
+
+@xref{AChar Intrinsic}, for the function corresponding
+to the ASCII character set.
+
+@end ifset
+@ifset familyF2U
+@node ChDir Intrinsic (subroutine)
+@subsubsection ChDir Intrinsic (subroutine)
+@cindex ChDir intrinsic
+@cindex intrinsics, ChDir
+
+@noindent
+@example
+CALL ChDir(@var{Dir}, @var{Status})
+@end example
+
+@noindent
+@var{Dir}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets the current working directory to be @var{Dir}.
+If the @var{Status} argument is supplied, it contains 0
+on success or a non-zero error code otherwise upon return.
+See @code{chdir(3)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{ChDir Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node ChDir Intrinsic (function)
+@subsubsection ChDir Intrinsic (function)
+@cindex ChDir intrinsic
+@cindex intrinsics, ChDir
+
+@noindent
+@example
+ChDir(@var{Dir})
+@end example
+
+@noindent
+ChDir: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Dir}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Sets the current working directory to be @var{Dir}.
+Returns 0 on success or a non-zero error code.
+See @code{chdir(3)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{ChDir Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node ChMod Intrinsic (subroutine)
+@subsubsection ChMod Intrinsic (subroutine)
+@cindex ChMod intrinsic
+@cindex intrinsics, ChMod
+
+@noindent
+@example
+CALL ChMod(@var{Name}, @var{Mode}, @var{Status})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Changes the access mode of file @var{Name} according to the
+specification @var{Mode}, which is given in the format of
+@code{chmod(1)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{Name}---otherwise,
+trailing blanks in @var{Name} are ignored.
+Currently, @var{Name} must not contain the single quote
+character.
+
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+
+Note that this currently works
+by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
+the library was configured) and so may fail in some circumstances and
+will, anyway, be slow.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{ChMod Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node ChMod Intrinsic (function)
+@subsubsection ChMod Intrinsic (function)
+@cindex ChMod intrinsic
+@cindex intrinsics, ChMod
+
+@noindent
+@example
+ChMod(@var{Name}, @var{Mode})
+@end example
+
+@noindent
+ChMod: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Changes the access mode of file @var{Name} according to the
+specification @var{Mode}, which is given in the format of
+@code{chmod(1)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{Name}---otherwise,
+trailing blanks in @var{Name} are ignored.
+Currently, @var{Name} must not contain the single quote
+character.
+
+Returns 0 on success or a non-zero error code otherwise.
+
+Note that this currently works
+by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
+the library was configured) and so may fail in some circumstances and
+will, anyway, be slow.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{ChMod Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node CLog Intrinsic
+@subsubsection CLog Intrinsic
+@cindex CLog intrinsic
+@cindex intrinsics, CLog
+
+@noindent
+@example
+CLog(@var{X})
+@end example
+
+@noindent
+CLog: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node Cmplx Intrinsic
+@subsubsection Cmplx Intrinsic
+@cindex Cmplx intrinsic
+@cindex intrinsics, Cmplx
+
+@noindent
+@example
+Cmplx(@var{X}, @var{Y})
+@end example
+
+@noindent
+Cmplx: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{INTEGER} or @code{REAL}; OPTIONAL (must be omitted if @var{X} is @code{COMPLEX}); scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+If @var{X} is not type @code{COMPLEX},
+constructs a value of type @code{COMPLEX(KIND=1)} from the
+real and imaginary values specified by @var{X} and
+@var{Y}, respectively.
+If @var{Y} is omitted, @samp{0.} is assumed.
+
+If @var{X} is type @code{COMPLEX},
+converts it to type @code{COMPLEX(KIND=1)}.
+
+@xref{Complex Intrinsic}, for information on easily constructing
+a @code{COMPLEX} value of arbitrary precision from @code{REAL}
+arguments.
+
+@end ifset
+@ifset familyGNU
+@node Complex Intrinsic
+@subsubsection Complex Intrinsic
+@cindex Complex intrinsic
+@cindex intrinsics, Complex
+
+@noindent
+@example
+Complex(@var{Real}, @var{Imag})
+@end example
+
+@noindent
+Complex: @code{COMPLEX} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{Real}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{Imag}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+Returns a @code{COMPLEX} value that has @samp{Real} and @samp{Imag} as its
+real and imaginary parts, respectively.
+
+If @var{Real} and @var{Imag} are the same type, and that type is not
+@code{INTEGER}, no data conversion is performed, and the type of
+the resulting value has the same kind value as the types
+of @var{Real} and @var{Imag}.
+
+If @var{Real} and @var{Imag} are not the same type, the usual type-promotion
+rules are applied to both, converting either or both to the
+appropriate @code{REAL} type.
+The type of the resulting value has the same kind value as the
+type to which both @var{Real} and @var{Imag} were converted, in this case.
+
+If @var{Real} and @var{Imag} are both @code{INTEGER}, they are both converted
+to @code{REAL(KIND=1)}, and the result of the @code{COMPLEX()}
+invocation is type @code{COMPLEX(KIND=1)}.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is too hairy to describe here, but it is important to
+note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)}
+result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}.
+Hence the availability of @code{COMPLEX()} in GNU Fortran.
+
+@end ifset
+@ifset familyF77
+@node Conjg Intrinsic
+@subsubsection Conjg Intrinsic
+@cindex Conjg intrinsic
+@cindex intrinsics, Conjg
+
+@noindent
+@example
+Conjg(@var{Z})
+@end example
+
+@noindent
+Conjg: @code{COMPLEX} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the complex conjugate:
+
+@example
+COMPLEX(REALPART(@var{Z}), -IMAGPART(@var{Z}))
+@end example
+
+@node Cos Intrinsic
+@subsubsection Cos Intrinsic
+@cindex Cos intrinsic
+@cindex intrinsics, Cos
+
+@noindent
+@example
+Cos(@var{X})
+@end example
+
+@noindent
+Cos: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the cosine of @var{X}, an angle measured
+in radians.
+
+@xref{ACos Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node CosD Intrinsic
+@subsubsection CosD Intrinsic
+@cindex CosD intrinsic
+@cindex intrinsics, CosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL CosD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node CosH Intrinsic
+@subsubsection CosH Intrinsic
+@cindex CosH intrinsic
+@cindex intrinsics, CosH
+
+@noindent
+@example
+CosH(@var{X})
+@end example
+
+@noindent
+CosH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the hyperbolic cosine of @var{X}.
+
+@end ifset
+@ifset familyF90
+@node Count Intrinsic
+@subsubsection Count Intrinsic
+@cindex Count intrinsic
+@cindex intrinsics, Count
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Count} to use this name for an
+external procedure.
+
+@node Cpu_Time Intrinsic
+@subsubsection Cpu_Time Intrinsic
+@cindex Cpu_Time intrinsic
+@cindex intrinsics, Cpu_Time
+
+@noindent
+@example
+CALL Cpu_Time(@var{Seconds})
+@end example
+
+@noindent
+@var{Seconds}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns in @var{Seconds} the current value of the system time.
+This implementation of the Fortran 95 intrinsic is just an alias for
+@code{second} @xref{Second Intrinsic (subroutine)}.
+
+@node CShift Intrinsic
+@subsubsection CShift Intrinsic
+@cindex CShift intrinsic
+@cindex intrinsics, CShift
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL CShift} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node CSin Intrinsic
+@subsubsection CSin Intrinsic
+@cindex CSin intrinsic
+@cindex intrinsics, CSin
+
+@noindent
+@example
+CSin(@var{X})
+@end example
+
+@noindent
+CSin: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SIN()} that is specific
+to one type for @var{X}.
+@xref{Sin Intrinsic}.
+
+@node CSqRt Intrinsic
+@subsubsection CSqRt Intrinsic
+@cindex CSqRt intrinsic
+@cindex intrinsics, CSqRt
+
+@noindent
+@example
+CSqRt(@var{X})
+@end example
+
+@noindent
+CSqRt: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SQRT()} that is specific
+to one type for @var{X}.
+@xref{SqRt Intrinsic}.
+
+@end ifset
+@ifset familyF2U
+@node CTime Intrinsic (subroutine)
+@subsubsection CTime Intrinsic (subroutine)
+@cindex CTime intrinsic
+@cindex intrinsics, CTime
+
+@noindent
+@example
+CALL CTime(@var{Result}, @var{STime})
+@end example
+
+@noindent
+@var{Result}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{STime}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Converts @var{STime}, a system time value, such as returned by
+@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
+and returns that string in @var{Result}.
+
+@xref{Time8 Intrinsic}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{CTime Intrinsic (function)}.
+
+@node CTime Intrinsic (function)
+@subsubsection CTime Intrinsic (function)
+@cindex CTime intrinsic
+@cindex intrinsics, CTime
+
+@noindent
+@example
+CTime(@var{STime})
+@end example
+
+@noindent
+CTime: @code{CHARACTER*(*)} function.
+
+@noindent
+@var{STime}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Converts @var{STime}, a system time value, such as returned by
+@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
+and returns that string as the function value.
+
+@xref{Time8 Intrinsic}.
+
+For information on other intrinsics with the same name:
+@xref{CTime Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node DAbs Intrinsic
+@subsubsection DAbs Intrinsic
+@cindex DAbs intrinsic
+@cindex intrinsics, DAbs
+
+@noindent
+@example
+DAbs(@var{A})
+@end example
+
+@noindent
+DAbs: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@node DACos Intrinsic
+@subsubsection DACos Intrinsic
+@cindex DACos intrinsic
+@cindex intrinsics, DACos
+
+@noindent
+@example
+DACos(@var{X})
+@end example
+
+@noindent
+DACos: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ACOS()} that is specific
+to one type for @var{X}.
+@xref{ACos Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DACosD Intrinsic
+@subsubsection DACosD Intrinsic
+@cindex DACosD intrinsic
+@cindex intrinsics, DACosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DACosD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DASin Intrinsic
+@subsubsection DASin Intrinsic
+@cindex DASin intrinsic
+@cindex intrinsics, DASin
+
+@noindent
+@example
+DASin(@var{X})
+@end example
+
+@noindent
+DASin: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ASIN()} that is specific
+to one type for @var{X}.
+@xref{ASin Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DASinD Intrinsic
+@subsubsection DASinD Intrinsic
+@cindex DASinD intrinsic
+@cindex intrinsics, DASinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DASinD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DATan Intrinsic
+@subsubsection DATan Intrinsic
+@cindex DATan intrinsic
+@cindex intrinsics, DATan
+
+@noindent
+@example
+DATan(@var{X})
+@end example
+
+@noindent
+DATan: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ATAN()} that is specific
+to one type for @var{X}.
+@xref{ATan Intrinsic}.
+
+@node DATan2 Intrinsic
+@subsubsection DATan2 Intrinsic
+@cindex DATan2 intrinsic
+@cindex intrinsics, DATan2
+
+@noindent
+@example
+DATan2(@var{Y}, @var{X})
+@end example
+
+@noindent
+DATan2: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{Y}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ATAN2()} that is specific
+to one type for @var{Y} and @var{X}.
+@xref{ATan2 Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DATan2D Intrinsic
+@subsubsection DATan2D Intrinsic
+@cindex DATan2D intrinsic
+@cindex intrinsics, DATan2D
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DATan2D} to use this name for an
+external procedure.
+
+@node DATanD Intrinsic
+@subsubsection DATanD Intrinsic
+@cindex DATanD intrinsic
+@cindex intrinsics, DATanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DATanD} to use this name for an
+external procedure.
+
+@node Date Intrinsic
+@subsubsection Date Intrinsic
+@cindex Date intrinsic
+@cindex intrinsics, Date
+
+@noindent
+@example
+CALL Date(@var{Date})
+@end example
+
+@noindent
+@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Returns @var{Date} in the form @samp{@var{dd}-@var{mmm}-@var{yy}},
+representing the numeric day of the month @var{dd}, a three-character
+abbreviation of the month name @var{mmm} and the last two digits of
+the year @var{yy}, e.g.@ @samp{25-Nov-96}.
+
+This intrinsic is not recommended, due to the year 2000 approaching.
+@xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits
+for the current (or any) date.
+
+@end ifset
+@ifset familyF90
+@node Date_and_Time Intrinsic
+@subsubsection Date_and_Time Intrinsic
+@cindex Date_and_Time intrinsic
+@cindex intrinsics, Date_and_Time
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Date_and_Time} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node DbesJ0 Intrinsic
+@subsubsection DbesJ0 Intrinsic
+@cindex DbesJ0 intrinsic
+@cindex intrinsics, DbesJ0
+
+@noindent
+@example
+DbesJ0(@var{X})
+@end example
+
+@noindent
+DbesJ0: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESJ0()} that is specific
+to one type for @var{X}.
+@xref{BesJ0 Intrinsic}.
+
+@node DbesJ1 Intrinsic
+@subsubsection DbesJ1 Intrinsic
+@cindex DbesJ1 intrinsic
+@cindex intrinsics, DbesJ1
+
+@noindent
+@example
+DbesJ1(@var{X})
+@end example
+
+@noindent
+DbesJ1: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESJ1()} that is specific
+to one type for @var{X}.
+@xref{BesJ1 Intrinsic}.
+
+@node DbesJN Intrinsic
+@subsubsection DbesJN Intrinsic
+@cindex DbesJN intrinsic
+@cindex intrinsics, DbesJN
+
+@noindent
+@example
+DbesJN(@var{N}, @var{X})
+@end example
+
+@noindent
+DbesJN: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{N}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESJN()} that is specific
+to one type for @var{X}.
+@xref{BesJN Intrinsic}.
+
+@node DbesY0 Intrinsic
+@subsubsection DbesY0 Intrinsic
+@cindex DbesY0 intrinsic
+@cindex intrinsics, DbesY0
+
+@noindent
+@example
+DbesY0(@var{X})
+@end example
+
+@noindent
+DbesY0: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESY0()} that is specific
+to one type for @var{X}.
+@xref{BesY0 Intrinsic}.
+
+@node DbesY1 Intrinsic
+@subsubsection DbesY1 Intrinsic
+@cindex DbesY1 intrinsic
+@cindex intrinsics, DbesY1
+
+@noindent
+@example
+DbesY1(@var{X})
+@end example
+
+@noindent
+DbesY1: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESY1()} that is specific
+to one type for @var{X}.
+@xref{BesY1 Intrinsic}.
+
+@node DbesYN Intrinsic
+@subsubsection DbesYN Intrinsic
+@cindex DbesYN intrinsic
+@cindex intrinsics, DbesYN
+
+@noindent
+@example
+DbesYN(@var{N}, @var{X})
+@end example
+
+@noindent
+DbesYN: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{N}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESYN()} that is specific
+to one type for @var{X}.
+@xref{BesYN Intrinsic}.
+
+@end ifset
+@ifset familyF77
+@node Dble Intrinsic
+@subsubsection Dble Intrinsic
+@cindex Dble intrinsic
+@cindex intrinsics, Dble
+
+@noindent
+@example
+Dble(@var{A})
+@end example
+
+@noindent
+Dble: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} converted to double precision
+(@code{REAL(KIND=2)}).
+If @var{A} is @code{COMPLEX}, the real part of
+@var{A} is used for the conversion
+and the imaginary part disregarded.
+
+@xref{Sngl Intrinsic}, for the function that converts
+to single precision.
+
+@xref{Int Intrinsic}, for the function that converts
+to @code{INTEGER}.
+
+@xref{Complex Intrinsic}, for the function that converts
+to @code{COMPLEX}.
+
+@end ifset
+@ifset familyVXT
+@node DbleQ Intrinsic
+@subsubsection DbleQ Intrinsic
+@cindex DbleQ intrinsic
+@cindex intrinsics, DbleQ
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DbleQ} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyFVZ
+@node DCmplx Intrinsic
+@subsubsection DCmplx Intrinsic
+@cindex DCmplx intrinsic
+@cindex intrinsics, DCmplx
+
+@noindent
+@example
+DCmplx(@var{X}, @var{Y})
+@end example
+
+@noindent
+DCmplx: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{INTEGER} or @code{REAL}; OPTIONAL (must be omitted if @var{X} is @code{COMPLEX}); scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+If @var{X} is not type @code{COMPLEX},
+constructs a value of type @code{COMPLEX(KIND=2)} from the
+real and imaginary values specified by @var{X} and
+@var{Y}, respectively.
+If @var{Y} is omitted, @samp{0D0} is assumed.
+
+If @var{X} is type @code{COMPLEX},
+converts it to type @code{COMPLEX(KIND=2)}.
+
+Although this intrinsic is not standard Fortran,
+it is a popular extension offered by many compilers
+that support @code{DOUBLE COMPLEX}, since it offers
+the easiest way to convert to @code{DOUBLE COMPLEX}
+without using Fortran 90 features (such as the @samp{KIND=}
+argument to the @code{CMPLX()} intrinsic).
+
+(@samp{CMPLX(0D0, 0D0)} returns a single-precision
+@code{COMPLEX} result, as required by standard FORTRAN 77.
+That's why so many compilers provide @code{DCMPLX()}, since
+@samp{DCMPLX(0D0, 0D0)} returns a @code{DOUBLE COMPLEX}
+result.
+Still, @code{DCMPLX()} converts even @code{REAL*16} arguments
+to their @code{REAL*8} equivalents in most dialects of
+Fortran, so neither it nor @code{CMPLX()} allow easy
+construction of arbitrary-precision values without
+potentially forcing a conversion involving extending or
+reducing precision.
+GNU Fortran provides such an intrinsic, called @code{COMPLEX()}.)
+
+@xref{Complex Intrinsic}, for information on easily constructing
+a @code{COMPLEX} value of arbitrary precision from @code{REAL}
+arguments.
+
+@node DConjg Intrinsic
+@subsubsection DConjg Intrinsic
+@cindex DConjg intrinsic
+@cindex intrinsics, DConjg
+
+@noindent
+@example
+DConjg(@var{Z})
+@end example
+
+@noindent
+DConjg: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{Z}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{CONJG()} that is specific
+to one type for @var{Z}.
+@xref{ATan2 Intrinsic}.
+
+@end ifset
+@ifset familyF77
+@node DCos Intrinsic
+@subsubsection DCos Intrinsic
+@cindex DCos intrinsic
+@cindex intrinsics, DCos
+
+@noindent
+@example
+DCos(@var{X})
+@end example
+
+@noindent
+DCos: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{COS()} that is specific
+to one type for @var{X}.
+@xref{Cos Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DCosD Intrinsic
+@subsubsection DCosD Intrinsic
+@cindex DCosD intrinsic
+@cindex intrinsics, DCosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DCosD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DCosH Intrinsic
+@subsubsection DCosH Intrinsic
+@cindex DCosH intrinsic
+@cindex intrinsics, DCosH
+
+@noindent
+@example
+DCosH(@var{X})
+@end example
+
+@noindent
+DCosH: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{COSH()} that is specific
+to one type for @var{X}.
+@xref{CosH Intrinsic}.
+
+@node DDiM Intrinsic
+@subsubsection DDiM Intrinsic
+@cindex DDiM intrinsic
+@cindex intrinsics, DDiM
+
+@noindent
+@example
+DDiM(@var{X}, @var{Y})
+@end example
+
+@noindent
+DDiM: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{DIM()} that is specific
+to one type for @var{X} and @var{Y}.
+@xref{DiM Intrinsic}.
+
+@end ifset
+@ifset familyF2U
+@node DErF Intrinsic
+@subsubsection DErF Intrinsic
+@cindex DErF intrinsic
+@cindex intrinsics, DErF
+
+@noindent
+@example
+DErF(@var{X})
+@end example
+
+@noindent
+DErF: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{ERF()} that is specific
+to one type for @var{X}.
+@xref{ErF Intrinsic}.
+
+@node DErFC Intrinsic
+@subsubsection DErFC Intrinsic
+@cindex DErFC intrinsic
+@cindex intrinsics, DErFC
+
+@noindent
+@example
+DErFC(@var{X})
+@end example
+
+@noindent
+DErFC: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{ERFC()} that is specific
+to one type for @var{X}.
+@xref{ErFC Intrinsic}.
+
+@end ifset
+@ifset familyF77
+@node DExp Intrinsic
+@subsubsection DExp Intrinsic
+@cindex DExp intrinsic
+@cindex intrinsics, DExp
+
+@noindent
+@example
+DExp(@var{X})
+@end example
+
+@noindent
+DExp: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{EXP()} that is specific
+to one type for @var{X}.
+@xref{Exp Intrinsic}.
+
+@end ifset
+@ifset familyFVZ
+@node DFloat Intrinsic
+@subsubsection DFloat Intrinsic
+@cindex DFloat intrinsic
+@cindex intrinsics, DFloat
+
+@noindent
+@example
+DFloat(@var{A})
+@end example
+
+@noindent
+DFloat: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{REAL()} that is specific
+to one type for @var{A}.
+@xref{Real Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DFlotI Intrinsic
+@subsubsection DFlotI Intrinsic
+@cindex DFlotI intrinsic
+@cindex intrinsics, DFlotI
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DFlotI} to use this name for an
+external procedure.
+
+@node DFlotJ Intrinsic
+@subsubsection DFlotJ Intrinsic
+@cindex DFlotJ intrinsic
+@cindex intrinsics, DFlotJ
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DFlotJ} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Digits Intrinsic
+@subsubsection Digits Intrinsic
+@cindex Digits intrinsic
+@cindex intrinsics, Digits
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Digits} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DiM Intrinsic
+@subsubsection DiM Intrinsic
+@cindex DiM intrinsic
+@cindex intrinsics, DiM
+
+@noindent
+@example
+DiM(@var{X}, @var{Y})
+@end example
+
+@noindent
+DiM: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{X}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{@var{X}-@var{Y}} if @var{X} is greater than
+@var{Y}; otherwise returns zero.
+
+@end ifset
+@ifset familyFVZ
+@node DImag Intrinsic
+@subsubsection DImag Intrinsic
+@cindex DImag intrinsic
+@cindex intrinsics, DImag
+
+@noindent
+@example
+DImag(@var{Z})
+@end example
+
+@noindent
+DImag: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{Z}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{AIMAG()} that is specific
+to one type for @var{Z}.
+@xref{AImag Intrinsic}.
+
+@end ifset
+@ifset familyF77
+@node DInt Intrinsic
+@subsubsection DInt Intrinsic
+@cindex DInt intrinsic
+@cindex intrinsics, DInt
+
+@noindent
+@example
+DInt(@var{A})
+@end example
+
+@noindent
+DInt: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{AINT()} that is specific
+to one type for @var{A}.
+@xref{AInt Intrinsic}.
+
+@node DLog Intrinsic
+@subsubsection DLog Intrinsic
+@cindex DLog intrinsic
+@cindex intrinsics, DLog
+
+@noindent
+@example
+DLog(@var{X})
+@end example
+
+@noindent
+DLog: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node DLog10 Intrinsic
+@subsubsection DLog10 Intrinsic
+@cindex DLog10 intrinsic
+@cindex intrinsics, DLog10
+
+@noindent
+@example
+DLog10(@var{X})
+@end example
+
+@noindent
+DLog10: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG10()} that is specific
+to one type for @var{X}.
+@xref{Log10 Intrinsic}.
+
+@node DMax1 Intrinsic
+@subsubsection DMax1 Intrinsic
+@cindex DMax1 intrinsic
+@cindex intrinsics, DMax1
+
+@noindent
+@example
+DMax1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+DMax1: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A}.
+@xref{Max Intrinsic}.
+
+@node DMin1 Intrinsic
+@subsubsection DMin1 Intrinsic
+@cindex DMin1 intrinsic
+@cindex intrinsics, DMin1
+
+@noindent
+@example
+DMin1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+DMin1: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A}.
+@xref{Min Intrinsic}.
+
+@node DMod Intrinsic
+@subsubsection DMod Intrinsic
+@cindex DMod intrinsic
+@cindex intrinsics, DMod
+
+@noindent
+@example
+DMod(@var{A}, @var{P})
+@end example
+
+@noindent
+DMod: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+@var{P}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MOD()} that is specific
+to one type for @var{A}.
+@xref{Mod Intrinsic}.
+
+@node DNInt Intrinsic
+@subsubsection DNInt Intrinsic
+@cindex DNInt intrinsic
+@cindex intrinsics, DNInt
+
+@noindent
+@example
+DNInt(@var{A})
+@end example
+
+@noindent
+DNInt: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ANINT()} that is specific
+to one type for @var{A}.
+@xref{ANInt Intrinsic}.
+
+@end ifset
+@ifset familyF90
+@node Dot_Product Intrinsic
+@subsubsection Dot_Product Intrinsic
+@cindex Dot_Product intrinsic
+@cindex intrinsics, Dot_Product
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Dot_Product} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DProd Intrinsic
+@subsubsection DProd Intrinsic
+@cindex DProd intrinsic
+@cindex intrinsics, DProd
+
+@noindent
+@example
+DProd(@var{X}, @var{Y})
+@end example
+
+@noindent
+DProd: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{DBLE(@var{X})*DBLE(@var{Y})}.
+
+@end ifset
+@ifset familyVXT
+@node DReal Intrinsic
+@subsubsection DReal Intrinsic
+@cindex DReal intrinsic
+@cindex intrinsics, DReal
+
+@noindent
+@example
+DReal(@var{A})
+@end example
+
+@noindent
+DReal: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Converts @var{A} to @code{REAL(KIND=2)}.
+
+If @var{A} is type @code{COMPLEX}, its real part
+is converted (if necessary) to @code{REAL(KIND=2)},
+and its imaginary part is disregarded.
+
+Although this intrinsic is not standard Fortran,
+it is a popular extension offered by many compilers
+that support @code{DOUBLE COMPLEX}, since it offers
+the easiest way to extract the real part of a @code{DOUBLE COMPLEX}
+value without using the Fortran 90 @code{REAL()} intrinsic
+in a way that produces a return value inconsistent with
+the way many FORTRAN 77 compilers handle @code{REAL()} of
+a @code{DOUBLE COMPLEX} value.
+
+@xref{RealPart Intrinsic}, for information on a GNU Fortran
+intrinsic that avoids these areas of confusion.
+
+@xref{REAL() and AIMAG() of Complex}, for more information on
+this issue.
+
+@end ifset
+@ifset familyF77
+@node DSign Intrinsic
+@subsubsection DSign Intrinsic
+@cindex DSign intrinsic
+@cindex intrinsics, DSign
+
+@noindent
+@example
+DSign(@var{A}, @var{B})
+@end example
+
+@noindent
+DSign: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+@var{B}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SIGN()} that is specific
+to one type for @var{A} and @var{B}.
+@xref{Sign Intrinsic}.
+
+@node DSin Intrinsic
+@subsubsection DSin Intrinsic
+@cindex DSin intrinsic
+@cindex intrinsics, DSin
+
+@noindent
+@example
+DSin(@var{X})
+@end example
+
+@noindent
+DSin: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SIN()} that is specific
+to one type for @var{X}.
+@xref{Sin Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DSinD Intrinsic
+@subsubsection DSinD Intrinsic
+@cindex DSinD intrinsic
+@cindex intrinsics, DSinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DSinD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DSinH Intrinsic
+@subsubsection DSinH Intrinsic
+@cindex DSinH intrinsic
+@cindex intrinsics, DSinH
+
+@noindent
+@example
+DSinH(@var{X})
+@end example
+
+@noindent
+DSinH: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SINH()} that is specific
+to one type for @var{X}.
+@xref{SinH Intrinsic}.
+
+@node DSqRt Intrinsic
+@subsubsection DSqRt Intrinsic
+@cindex DSqRt intrinsic
+@cindex intrinsics, DSqRt
+
+@noindent
+@example
+DSqRt(@var{X})
+@end example
+
+@noindent
+DSqRt: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SQRT()} that is specific
+to one type for @var{X}.
+@xref{SqRt Intrinsic}.
+
+@node DTan Intrinsic
+@subsubsection DTan Intrinsic
+@cindex DTan intrinsic
+@cindex intrinsics, DTan
+
+@noindent
+@example
+DTan(@var{X})
+@end example
+
+@noindent
+DTan: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{TAN()} that is specific
+to one type for @var{X}.
+@xref{Tan Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DTanD Intrinsic
+@subsubsection DTanD Intrinsic
+@cindex DTanD intrinsic
+@cindex intrinsics, DTanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DTanD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DTanH Intrinsic
+@subsubsection DTanH Intrinsic
+@cindex DTanH intrinsic
+@cindex intrinsics, DTanH
+
+@noindent
+@example
+DTanH(@var{X})
+@end example
+
+@noindent
+DTanH: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{TANH()} that is specific
+to one type for @var{X}.
+@xref{TanH Intrinsic}.
+
+@end ifset
+@ifset familyF2U
+@node Dtime Intrinsic (subroutine)
+@subsubsection Dtime Intrinsic (subroutine)
+@cindex Dtime intrinsic
+@cindex intrinsics, Dtime
+
+@noindent
+@example
+CALL Dtime(@var{Result}, @var{TArray})
+@end example
+
+@noindent
+@var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Initially, return the number of seconds of runtime
+since the start of the process's execution
+in @var{Result},
+and the user and system components of this in @samp{@var{TArray}(1)}
+and @samp{@var{TArray}(2)} respectively.
+The value of @var{Result} is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
+
+Subsequent invocations of @samp{DTIME()} set values based on accumulations
+since the previous invocation.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{Dtime Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Dtime Intrinsic (function)
+@subsubsection Dtime Intrinsic (function)
+@cindex Dtime intrinsic
+@cindex intrinsics, Dtime
+
+@noindent
+@example
+Dtime(@var{TArray})
+@end example
+
+@noindent
+Dtime: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Initially, return the number of seconds of runtime
+since the start of the process's execution
+as the function value,
+and the user and system components of this in @samp{@var{TArray}(1)}
+and @samp{@var{TArray}(2)} respectively.
+The functions' value is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
+
+Subsequent invocations of @samp{DTIME()} return values accumulated since the
+previous invocation.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Dtime Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node EOShift Intrinsic
+@subsubsection EOShift Intrinsic
+@cindex EOShift intrinsic
+@cindex intrinsics, EOShift
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL EOShift} to use this name for an
+external procedure.
+
+@node Epsilon Intrinsic
+@subsubsection Epsilon Intrinsic
+@cindex Epsilon intrinsic
+@cindex intrinsics, Epsilon
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Epsilon} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node ErF Intrinsic
+@subsubsection ErF Intrinsic
+@cindex ErF intrinsic
+@cindex intrinsics, ErF
+
+@noindent
+@example
+ErF(@var{X})
+@end example
+
+@noindent
+ErF: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the error function of @var{X}.
+See @code{erf(3m)}, which provides the implementation.
+
+@node ErFC Intrinsic
+@subsubsection ErFC Intrinsic
+@cindex ErFC intrinsic
+@cindex intrinsics, ErFC
+
+@noindent
+@example
+ErFC(@var{X})
+@end example
+
+@noindent
+ErFC: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the complementary error function of @var{X}:
+@samp{ERFC(R) = 1 - ERF(R)} (except that the result may be more
+accurate than explicitly evaluating that formulae would give).
+See @code{erfc(3m)}, which provides the implementation.
+
+@node ETime Intrinsic (subroutine)
+@subsubsection ETime Intrinsic (subroutine)
+@cindex ETime intrinsic
+@cindex intrinsics, ETime
+
+@noindent
+@example
+CALL ETime(@var{Result}, @var{TArray})
+@end example
+
+@noindent
+@var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Return the number of seconds of runtime
+since the start of the process's execution
+in @var{Result},
+and the user and system components of this in @samp{@var{TArray}(1)}
+and @samp{@var{TArray}(2)} respectively.
+The value of @var{Result} is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{ETime Intrinsic (function)}.
+
+@node ETime Intrinsic (function)
+@subsubsection ETime Intrinsic (function)
+@cindex ETime intrinsic
+@cindex intrinsics, ETime
+
+@noindent
+@example
+ETime(@var{TArray})
+@end example
+
+@noindent
+ETime: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Return the number of seconds of runtime
+since the start of the process's execution
+as the function value,
+and the user and system components of this in @samp{@var{TArray}(1)}
+and @samp{@var{TArray}(2)} respectively.
+The functions' value is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
+
+For information on other intrinsics with the same name:
+@xref{ETime Intrinsic (subroutine)}.
+
+@node Exit Intrinsic
+@subsubsection Exit Intrinsic
+@cindex Exit intrinsic
+@cindex intrinsics, Exit
+
+@noindent
+@example
+CALL Exit(@var{Status})
+@end example
+
+@noindent
+@var{Status}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Exit the program with status @var{Status} after closing open Fortran
+I/O units and otherwise behaving as @code{exit(2)}.
+If @var{Status} is omitted the canonical `success' value
+will be returned to the system.
+
+@end ifset
+@ifset familyF77
+@node Exp Intrinsic
+@subsubsection Exp Intrinsic
+@cindex Exp intrinsic
+@cindex intrinsics, Exp
+
+@noindent
+@example
+Exp(@var{X})
+@end example
+
+@noindent
+Exp: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{@var{e}**@var{X}}, where
+@var{e} is approximately 2.7182818.
+
+@xref{Log Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyF90
+@node Exponent Intrinsic
+@subsubsection Exponent Intrinsic
+@cindex Exponent intrinsic
+@cindex intrinsics, Exponent
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Exponent} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Fdate Intrinsic (subroutine)
+@subsubsection Fdate Intrinsic (subroutine)
+@cindex Fdate intrinsic
+@cindex intrinsics, Fdate
+
+@noindent
+@example
+CALL Fdate(@var{Date})
+@end example
+
+@noindent
+@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current date (using the same format as @code{CTIME()})
+in @var{Date}.
+
+Equivalent to:
+
+@example
+CALL CTIME(@var{Date}, TIME8())
+@end example
+
+@xref{CTime Intrinsic (subroutine)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{Fdate Intrinsic (function)}.
+
+@node Fdate Intrinsic (function)
+@subsubsection Fdate Intrinsic (function)
+@cindex Fdate intrinsic
+@cindex intrinsics, Fdate
+
+@noindent
+@example
+Fdate()
+@end example
+
+@noindent
+Fdate: @code{CHARACTER*(*)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current date (using the same format as @code{CTIME()}).
+
+Equivalent to:
+
+@example
+CTIME(TIME8())
+@end example
+
+@xref{CTime Intrinsic (function)}.
+
+For information on other intrinsics with the same name:
+@xref{Fdate Intrinsic (subroutine)}.
+
+@node FGet Intrinsic (subroutine)
+@subsubsection FGet Intrinsic (subroutine)
+@cindex FGet intrinsic
+@cindex intrinsics, FGet
+
+@noindent
+@example
+CALL FGet(@var{C}, @var{Status})
+@end example
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Reads a single character into @var{C} in stream mode from unit 5
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns in
+@var{Status} 0 on success, @minus{}1 on end-of-file, and the error code
+from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FGet Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node FGet Intrinsic (function)
+@subsubsection FGet Intrinsic (function)
+@cindex FGet intrinsic
+@cindex intrinsics, FGet
+
+@noindent
+@example
+FGet(@var{C})
+@end example
+
+@noindent
+FGet: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Reads a single character into @var{C} in stream mode from unit 5
+(by-passing normal formatted input) using @code{getc(3)}.
+Returns 0 on
+success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FGet Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node FGetC Intrinsic (subroutine)
+@subsubsection FGetC Intrinsic (subroutine)
+@cindex FGetC intrinsic
+@cindex intrinsics, FGetC
+
+@noindent
+@example
+CALL FGetC(@var{Unit}, @var{C}, @var{Status})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Reads a single character into @var{C} in stream mode from unit @var{Unit}
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns in
+@var{Status} 0 on success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FGetC Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node FGetC Intrinsic (function)
+@subsubsection FGetC Intrinsic (function)
+@cindex FGetC intrinsic
+@cindex intrinsics, FGetC
+
+@noindent
+@example
+FGetC(@var{Unit}, @var{C})
+@end example
+
+@noindent
+FGetC: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Reads a single character into @var{C} in stream mode from unit @var{Unit}
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns 0 on
+success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FGetC Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node Float Intrinsic
+@subsubsection Float Intrinsic
+@cindex Float intrinsic
+@cindex intrinsics, Float
+
+@noindent
+@example
+Float(@var{A})
+@end example
+
+@noindent
+Float: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{REAL()} that is specific
+to one type for @var{A}.
+@xref{Real Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node FloatI Intrinsic
+@subsubsection FloatI Intrinsic
+@cindex FloatI intrinsic
+@cindex intrinsics, FloatI
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL FloatI} to use this name for an
+external procedure.
+
+@node FloatJ Intrinsic
+@subsubsection FloatJ Intrinsic
+@cindex FloatJ intrinsic
+@cindex intrinsics, FloatJ
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL FloatJ} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Floor Intrinsic
+@subsubsection Floor Intrinsic
+@cindex Floor intrinsic
+@cindex intrinsics, Floor
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Floor} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Flush Intrinsic
+@subsubsection Flush Intrinsic
+@cindex Flush intrinsic
+@cindex intrinsics, Flush
+
+@noindent
+@example
+CALL Flush(@var{Unit})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Flushes Fortran unit(s) currently open for output.
+Without the optional argument, all such units are flushed,
+otherwise just the unit specified by @var{Unit}.
+
+Some non-GNU implementations of Fortran provide this intrinsic
+as a library procedure that might or might not support the
+(optional) @var{Unit} argument.
+
+@node FNum Intrinsic
+@subsubsection FNum Intrinsic
+@cindex FNum intrinsic
+@cindex intrinsics, FNum
+
+@noindent
+@example
+FNum(@var{Unit})
+@end example
+
+@noindent
+FNum: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the Unix file descriptor number corresponding to the open
+Fortran I/O unit @var{Unit}.
+This could be passed to an interface to C I/O routines.
+
+@node FPut Intrinsic (subroutine)
+@subsubsection FPut Intrinsic (subroutine)
+@cindex FPut intrinsic
+@cindex intrinsics, FPut
+
+@noindent
+@example
+CALL FPut(@var{C}, @var{Status})
+@end example
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Writes the single character @var{C} in stream mode to unit 6
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns in
+@var{Status} 0 on success, the error code from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FPut Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node FPut Intrinsic (function)
+@subsubsection FPut Intrinsic (function)
+@cindex FPut intrinsic
+@cindex intrinsics, FPut
+
+@noindent
+@example
+FPut(@var{C})
+@end example
+
+@noindent
+FPut: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Writes the single character @var{C} in stream mode to unit 6
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns 0 on
+success, the error code from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FPut Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node FPutC Intrinsic (subroutine)
+@subsubsection FPutC Intrinsic (subroutine)
+@cindex FPutC intrinsic
+@cindex intrinsics, FPutC
+
+@noindent
+@example
+CALL FPutC(@var{Unit}, @var{C}, @var{Status})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Writes the single character @var{Unit} in stream mode to unit 6
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns in
+@var{C} 0 on success, the error code from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FPutC Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node FPutC Intrinsic (function)
+@subsubsection FPutC Intrinsic (function)
+@cindex FPutC intrinsic
+@cindex intrinsics, FPutC
+
+@noindent
+@example
+FPutC(@var{Unit}, @var{C})
+@end example
+
+@noindent
+FPutC: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Writes the single character @var{C} in stream mode to unit @var{Unit}
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns 0 on
+success, the error code from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FPutC Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Fraction Intrinsic
+@subsubsection Fraction Intrinsic
+@cindex Fraction intrinsic
+@cindex intrinsics, Fraction
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Fraction} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node FSeek Intrinsic
+@subsubsection FSeek Intrinsic
+@cindex FSeek intrinsic
+@cindex intrinsics, FSeek
+
+@noindent
+@example
+CALL FSeek(@var{Unit}, @var{Offset}, @var{Whence}, @var{ErrLab})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Offset}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Whence}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{ErrLab}: @samp{*@var{label}}, where @var{label} is the label
+of an executable statement; OPTIONAL.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Attempts to move Fortran unit @var{Unit} to the specified
+@var{Offset}: absolute offset if @var{Offset}=0; relative to the
+current offset if @var{Offset}=1; relative to the end of the file if
+@var{Offset}=2.
+It branches to label @var{Whence} if @var{Unit} is
+not open or if the call otherwise fails.
+
+@node FStat Intrinsic (subroutine)
+@subsubsection FStat Intrinsic (subroutine)
+@cindex FStat intrinsic
+@cindex intrinsics, FStat
+
+@noindent
+@example
+CALL FStat(@var{Unit}, @var{SArray}, @var{Status})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the file open on Fortran I/O unit @var{Unit} and
+places them in the array @var{SArray}.
+The values in this array are
+extracted from the @code{stat} structure as returned by
+@code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{FStat Intrinsic (function)}.
+
+@node FStat Intrinsic (function)
+@subsubsection FStat Intrinsic (function)
+@cindex FStat intrinsic
+@cindex intrinsics, FStat
+
+@noindent
+@example
+FStat(@var{Unit}, @var{SArray})
+@end example
+
+@noindent
+FStat: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the file open on Fortran I/O unit @var{Unit} and
+places them in the array @var{SArray}.
+The values in this array are
+extracted from the @code{stat} structure as returned by
+@code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a non-zero error code.
+
+For information on other intrinsics with the same name:
+@xref{FStat Intrinsic (subroutine)}.
+
+@node FTell Intrinsic (subroutine)
+@subsubsection FTell Intrinsic (subroutine)
+@cindex FTell intrinsic
+@cindex intrinsics, FTell
+
+@noindent
+@example
+CALL FTell(@var{Unit}, @var{Offset})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Offset}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Offset} to the current offset of Fortran unit @var{Unit}
+(or to @minus{}1 if @var{Unit} is not open).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{FTell Intrinsic (function)}.
+
+@node FTell Intrinsic (function)
+@subsubsection FTell Intrinsic (function)
+@cindex FTell intrinsic
+@cindex intrinsics, FTell
+
+@noindent
+@example
+FTell(@var{Unit})
+@end example
+
+@noindent
+FTell: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current offset of Fortran unit @var{Unit}
+(or @minus{}1 if @var{Unit} is not open).
+
+For information on other intrinsics with the same name:
+@xref{FTell Intrinsic (subroutine)}.
+
+@node GError Intrinsic
+@subsubsection GError Intrinsic
+@cindex GError intrinsic
+@cindex intrinsics, GError
+
+@noindent
+@example
+CALL GError(@var{Message})
+@end example
+
+@noindent
+@var{Message}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the system error message corresponding to the last system
+error (C @code{errno}).
+
+@node GetArg Intrinsic
+@subsubsection GetArg Intrinsic
+@cindex GetArg intrinsic
+@cindex intrinsics, GetArg
+
+@noindent
+@example
+CALL GetArg(@var{Pos}, @var{Value})
+@end example
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Value}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Value} to the @var{Pos}-th command-line argument (or to all
+blanks if there are fewer than @var{Value} command-line arguments);
+@code{CALL GETARG(0, @var{value})} sets @var{value} to the name of the
+program (on systems that support this feature).
+
+@xref{IArgC Intrinsic}, for information on how to get the number
+of arguments.
+
+@node GetCWD Intrinsic (subroutine)
+@subsubsection GetCWD Intrinsic (subroutine)
+@cindex GetCWD intrinsic
+@cindex intrinsics, GetCWD
+
+@noindent
+@example
+CALL GetCWD(@var{Name}, @var{Status})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Places the current working directory in @var{Name}.
+If the @var{Status} argument is supplied, it contains 0
+success or a non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
+or @code{getwd(3)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{GetCWD Intrinsic (function)}.
+
+@node GetCWD Intrinsic (function)
+@subsubsection GetCWD Intrinsic (function)
+@cindex GetCWD intrinsic
+@cindex intrinsics, GetCWD
+
+@noindent
+@example
+GetCWD(@var{Name})
+@end example
+
+@noindent
+GetCWD: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Places the current working directory in @var{Name}.
+Returns 0 on
+success, otherwise a non-zero error code
+(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
+or @code{getwd(3)}).
+
+For information on other intrinsics with the same name:
+@xref{GetCWD Intrinsic (subroutine)}.
+
+@node GetEnv Intrinsic
+@subsubsection GetEnv Intrinsic
+@cindex GetEnv intrinsic
+@cindex intrinsics, GetEnv
+
+@noindent
+@example
+CALL GetEnv(@var{Name}, @var{Value})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Value}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Value} to the value of environment variable given by the
+value of @var{Name} (@code{$name} in shell terms) or to blanks if
+@code{$name} has not been set.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{Name}---otherwise,
+trailing blanks in @var{Name} are ignored.
+
+@node GetGId Intrinsic
+@subsubsection GetGId Intrinsic
+@cindex GetGId intrinsic
+@cindex intrinsics, GetGId
+
+@noindent
+@example
+GetGId()
+@end example
+
+@noindent
+GetGId: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the group id for the current process.
+
+@node GetLog Intrinsic
+@subsubsection GetLog Intrinsic
+@cindex GetLog intrinsic
+@cindex intrinsics, GetLog
+
+@noindent
+@example
+CALL GetLog(@var{Login})
+@end example
+
+@noindent
+@var{Login}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the login name for the process in @var{Login}.
+
+@node GetPId Intrinsic
+@subsubsection GetPId Intrinsic
+@cindex GetPId intrinsic
+@cindex intrinsics, GetPId
+
+@noindent
+@example
+GetPId()
+@end example
+
+@noindent
+GetPId: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the process id for the current process.
+
+@node GetUId Intrinsic
+@subsubsection GetUId Intrinsic
+@cindex GetUId intrinsic
+@cindex intrinsics, GetUId
+
+@noindent
+@example
+GetUId()
+@end example
+
+@noindent
+GetUId: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the user id for the current process.
+
+@node GMTime Intrinsic
+@subsubsection GMTime Intrinsic
+@cindex GMTime intrinsic
+@cindex intrinsics, GMTime
+
+@noindent
+@example
+CALL GMTime(@var{STime}, @var{TArray})
+@end example
+
+@noindent
+@var{STime}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(9); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Given a system time value @var{STime}, fills @var{TArray} with values
+extracted from it appropriate to the GMT time zone using
+@code{gmtime(3)}.
+
+The array elements are as follows:
+
+@enumerate
+@item
+Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+
+@item
+Minutes after the hour, range 0--59
+
+@item
+Hours past midnight, range 0--23
+
+@item
+Day of month, range 0--31
+
+@item
+Number of months since January, range 0--12
+
+@item
+Years since 1900
+
+@item
+Number of days since Sunday, range 0--6
+
+@item
+Days since January 1
+
+@item
+Daylight savings indicator: positive if daylight savings is in effect,
+zero if not, and negative if the information isn't available.
+@end enumerate
+
+@node HostNm Intrinsic (subroutine)
+@subsubsection HostNm Intrinsic (subroutine)
+@cindex HostNm intrinsic
+@cindex intrinsics, HostNm
+
+@noindent
+@example
+CALL HostNm(@var{Name}, @var{Status})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Fills @var{Name} with the system's host name returned by
+@code{gethostname(2)}.
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+This intrinsic is not available on all systems.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{HostNm Intrinsic (function)}.
+
+@node HostNm Intrinsic (function)
+@subsubsection HostNm Intrinsic (function)
+@cindex HostNm intrinsic
+@cindex intrinsics, HostNm
+
+@noindent
+@example
+HostNm(@var{Name})
+@end example
+
+@noindent
+HostNm: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Fills @var{Name} with the system's host name returned by
+@code{gethostname(2)}, returning 0 on success or a non-zero error code
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+This intrinsic is not available on all systems.
+
+For information on other intrinsics with the same name:
+@xref{HostNm Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Huge Intrinsic
+@subsubsection Huge Intrinsic
+@cindex Huge intrinsic
+@cindex intrinsics, Huge
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Huge} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node IAbs Intrinsic
+@subsubsection IAbs Intrinsic
+@cindex IAbs intrinsic
+@cindex intrinsics, IAbs
+
+@noindent
+@example
+IAbs(@var{A})
+@end example
+
+@noindent
+IAbs: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@end ifset
+@ifset familyASC
+@node IAChar Intrinsic
+@subsubsection IAChar Intrinsic
+@cindex IAChar intrinsic
+@cindex intrinsics, IAChar
+
+@noindent
+@example
+IAChar(@var{C})
+@end example
+
+@noindent
+IAChar: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{f90}.
+
+@noindent
+Description:
+
+Returns the code for the ASCII character in the
+first character position of @var{C}.
+
+@xref{AChar Intrinsic}, for the inverse of this function.
+
+@xref{IChar Intrinsic}, for the function corresponding
+to the system's native character set.
+
+@end ifset
+@ifset familyMIL
+@node IAnd Intrinsic
+@subsubsection IAnd Intrinsic
+@cindex IAnd intrinsic
+@cindex intrinsics, IAnd
+
+@noindent
+@example
+IAnd(@var{I}, @var{J})
+@end example
+
+@noindent
+IAnd: @code{INTEGER} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean AND of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF2U
+@node IArgC Intrinsic
+@subsubsection IArgC Intrinsic
+@cindex IArgC intrinsic
+@cindex intrinsics, IArgC
+
+@noindent
+@example
+IArgC()
+@end example
+
+@noindent
+IArgC: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the number of command-line arguments.
+
+This count does not include the specification of the program
+name itself.
+
+@end ifset
+@ifset familyMIL
+@node IBClr Intrinsic
+@subsubsection IBClr Intrinsic
+@cindex IBClr intrinsic
+@cindex intrinsics, IBClr
+
+@noindent
+@example
+IBClr(@var{I}, @var{Pos})
+@end example
+
+@noindent
+IBClr: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns the value of @var{I} with bit @var{Pos} cleared (set to
+zero).
+@xref{BTest Intrinsic} for information on bit positions.
+
+@node IBits Intrinsic
+@subsubsection IBits Intrinsic
+@cindex IBits intrinsic
+@cindex intrinsics, IBits
+
+@noindent
+@example
+IBits(@var{I}, @var{Pos}, @var{Len})
+@end example
+
+@noindent
+IBits: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Len}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Extracts a subfield of length @var{Len} from @var{I}, starting from
+bit position @var{Pos} and extending left for @var{Len} bits.
+The result is right-justified and the remaining bits are zeroed.
+The value
+of @samp{@var{Pos}+@var{Len}} must be less than or equal to the value
+@samp{BIT_SIZE(@var{I})}.
+@xref{Bit_Size Intrinsic}.
+
+@node IBSet Intrinsic
+@subsubsection IBSet Intrinsic
+@cindex IBSet intrinsic
+@cindex intrinsics, IBSet
+
+@noindent
+@example
+IBSet(@var{I}, @var{Pos})
+@end example
+
+@noindent
+IBSet: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns the value of @var{I} with bit @var{Pos} set (to one).
+@xref{BTest Intrinsic} for information on bit positions.
+
+@end ifset
+@ifset familyF77
+@node IChar Intrinsic
+@subsubsection IChar Intrinsic
+@cindex IChar intrinsic
+@cindex intrinsics, IChar
+
+@noindent
+@example
+IChar(@var{C})
+@end example
+
+@noindent
+IChar: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the code for the character in the
+first character position of @var{C}.
+
+Because the system's native character set is used,
+the correspondence between character and their codes
+is not necessarily the same between GNU Fortran
+implementations.
+
+Note that no intrinsic exists to convert a printable
+character string to a numerical value.
+For example, there is no intrinsic that, given
+the @code{CHARACTER} value @samp{'154'}, returns an
+@code{INTEGER} or @code{REAL} value with the value @samp{154}.
+
+Instead, you can use internal-file I/O to do this kind
+of conversion.
+For example:
+
+@smallexample
+INTEGER VALUE
+CHARACTER*10 STRING
+STRING = '154'
+READ (STRING, '(I10)'), VALUE
+PRINT *, VALUE
+END
+@end smallexample
+
+The above program, when run, prints:
+
+@smallexample
+ 154
+@end smallexample
+
+@xref{Char Intrinsic}, for the inverse of the @code{ICHAR} function.
+
+@xref{IAChar Intrinsic}, for the function corresponding
+to the ASCII character set.
+
+@end ifset
+@ifset familyF2U
+@node IDate Intrinsic (UNIX)
+@subsubsection IDate Intrinsic (UNIX)
+@cindex IDate intrinsic
+@cindex intrinsics, IDate
+
+@noindent
+@example
+CALL IDate(@var{TArray})
+@end example
+
+@noindent
+@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(3); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Fills @var{TArray} with the numerical values at the current local time
+of day, month (in the range 1--12), and year in elements 1, 2, and 3,
+respectively.
+The year has four significant digits.
+
+For information on other intrinsics with the same name:
+@xref{IDate Intrinsic (VXT)}.
+
+@end ifset
+@ifset familyVXT
+@node IDate Intrinsic (VXT)
+@subsubsection IDate Intrinsic (VXT)
+@cindex IDate intrinsic
+@cindex intrinsics, IDate
+
+@noindent
+@example
+CALL IDate(@var{M}, @var{D}, @var{Y})
+@end example
+
+@noindent
+@var{M}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{D}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{Y}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Returns the numerical values of the current local time.
+The month (in the range 1--12) is returned in @var{M},
+the day (in the range 1--7) in @var{D},
+and the year in @var{Y} (in the range 0--99).
+
+This intrinsic is not recommended, due to the year 2000 approaching.
+
+For information on other intrinsics with the same name:
+@xref{IDate Intrinsic (UNIX)}.
+
+@end ifset
+@ifset familyF77
+@node IDiM Intrinsic
+@subsubsection IDiM Intrinsic
+@cindex IDiM intrinsic
+@cindex intrinsics, IDiM
+
+@noindent
+@example
+IDiM(@var{X}, @var{Y})
+@end example
+
+@noindent
+IDiM: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{X}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{IDIM()} that is specific
+to one type for @var{X} and @var{Y}.
+@xref{IDiM Intrinsic}.
+
+@node IDInt Intrinsic
+@subsubsection IDInt Intrinsic
+@cindex IDInt intrinsic
+@cindex intrinsics, IDInt
+
+@noindent
+@example
+IDInt(@var{A})
+@end example
+
+@noindent
+IDInt: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{INT()} that is specific
+to one type for @var{A}.
+@xref{Int Intrinsic}.
+
+@node IDNInt Intrinsic
+@subsubsection IDNInt Intrinsic
+@cindex IDNInt intrinsic
+@cindex intrinsics, IDNInt
+
+@noindent
+@example
+IDNInt(@var{A})
+@end example
+
+@noindent
+IDNInt: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{NINT()} that is specific
+to one type for @var{A}.
+@xref{NInt Intrinsic}.
+
+@end ifset
+@ifset familyMIL
+@node IEOr Intrinsic
+@subsubsection IEOr Intrinsic
+@cindex IEOr intrinsic
+@cindex intrinsics, IEOr
+
+@noindent
+@example
+IEOr(@var{I}, @var{J})
+@end example
+
+@noindent
+IEOr: @code{INTEGER} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean exclusive-OR of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF2U
+@node IErrNo Intrinsic
+@subsubsection IErrNo Intrinsic
+@cindex IErrNo intrinsic
+@cindex intrinsics, IErrNo
+
+@noindent
+@example
+IErrNo()
+@end example
+
+@noindent
+IErrNo: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the last system error number (corresponding to the C
+@code{errno}).
+
+@end ifset
+@ifset familyF77
+@node IFix Intrinsic
+@subsubsection IFix Intrinsic
+@cindex IFix intrinsic
+@cindex intrinsics, IFix
+
+@noindent
+@example
+IFix(@var{A})
+@end example
+
+@noindent
+IFix: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{INT()} that is specific
+to one type for @var{A}.
+@xref{Int Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node IIAbs Intrinsic
+@subsubsection IIAbs Intrinsic
+@cindex IIAbs intrinsic
+@cindex intrinsics, IIAbs
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIAbs} to use this name for an
+external procedure.
+
+@node IIAnd Intrinsic
+@subsubsection IIAnd Intrinsic
+@cindex IIAnd intrinsic
+@cindex intrinsics, IIAnd
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIAnd} to use this name for an
+external procedure.
+
+@node IIBClr Intrinsic
+@subsubsection IIBClr Intrinsic
+@cindex IIBClr intrinsic
+@cindex intrinsics, IIBClr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIBClr} to use this name for an
+external procedure.
+
+@node IIBits Intrinsic
+@subsubsection IIBits Intrinsic
+@cindex IIBits intrinsic
+@cindex intrinsics, IIBits
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIBits} to use this name for an
+external procedure.
+
+@node IIBSet Intrinsic
+@subsubsection IIBSet Intrinsic
+@cindex IIBSet intrinsic
+@cindex intrinsics, IIBSet
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIBSet} to use this name for an
+external procedure.
+
+@node IIDiM Intrinsic
+@subsubsection IIDiM Intrinsic
+@cindex IIDiM intrinsic
+@cindex intrinsics, IIDiM
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIDiM} to use this name for an
+external procedure.
+
+@node IIDInt Intrinsic
+@subsubsection IIDInt Intrinsic
+@cindex IIDInt intrinsic
+@cindex intrinsics, IIDInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIDInt} to use this name for an
+external procedure.
+
+@node IIDNnt Intrinsic
+@subsubsection IIDNnt Intrinsic
+@cindex IIDNnt intrinsic
+@cindex intrinsics, IIDNnt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIDNnt} to use this name for an
+external procedure.
+
+@node IIEOr Intrinsic
+@subsubsection IIEOr Intrinsic
+@cindex IIEOr intrinsic
+@cindex intrinsics, IIEOr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIEOr} to use this name for an
+external procedure.
+
+@node IIFix Intrinsic
+@subsubsection IIFix Intrinsic
+@cindex IIFix intrinsic
+@cindex intrinsics, IIFix
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIFix} to use this name for an
+external procedure.
+
+@node IInt Intrinsic
+@subsubsection IInt Intrinsic
+@cindex IInt intrinsic
+@cindex intrinsics, IInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IInt} to use this name for an
+external procedure.
+
+@node IIOr Intrinsic
+@subsubsection IIOr Intrinsic
+@cindex IIOr intrinsic
+@cindex intrinsics, IIOr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIOr} to use this name for an
+external procedure.
+
+@node IIQint Intrinsic
+@subsubsection IIQint Intrinsic
+@cindex IIQint intrinsic
+@cindex intrinsics, IIQint
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIQint} to use this name for an
+external procedure.
+
+@node IIQNnt Intrinsic
+@subsubsection IIQNnt Intrinsic
+@cindex IIQNnt intrinsic
+@cindex intrinsics, IIQNnt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIQNnt} to use this name for an
+external procedure.
+
+@node IIShftC Intrinsic
+@subsubsection IIShftC Intrinsic
+@cindex IIShftC intrinsic
+@cindex intrinsics, IIShftC
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIShftC} to use this name for an
+external procedure.
+
+@node IISign Intrinsic
+@subsubsection IISign Intrinsic
+@cindex IISign intrinsic
+@cindex intrinsics, IISign
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IISign} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2C
+@node Imag Intrinsic
+@subsubsection Imag Intrinsic
+@cindex Imag intrinsic
+@cindex intrinsics, Imag
+
+@noindent
+@example
+Imag(@var{Z})
+@end example
+
+@noindent
+Imag: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+The imaginary part of @var{Z} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{AIMAG(@var{Z})}.
+However, when, for example, @var{Z} is @code{DOUBLE COMPLEX},
+@samp{AIMAG(@var{Z})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{IMAG()} is that, while not necessarily
+more or less portable than @code{AIMAG()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyGNU
+@node ImagPart Intrinsic
+@subsubsection ImagPart Intrinsic
+@cindex ImagPart intrinsic
+@cindex intrinsics, ImagPart
+
+@noindent
+@example
+ImagPart(@var{Z})
+@end example
+
+@noindent
+ImagPart: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+The imaginary part of @var{Z} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{AIMAG(@var{Z})}.
+However, when, for example, @var{Z} is @code{DOUBLE COMPLEX},
+@samp{AIMAG(@var{Z})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{IMAGPART()} is that, while not necessarily
+more or less portable than @code{AIMAG()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyVXT
+@node IMax0 Intrinsic
+@subsubsection IMax0 Intrinsic
+@cindex IMax0 intrinsic
+@cindex intrinsics, IMax0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMax0} to use this name for an
+external procedure.
+
+@node IMax1 Intrinsic
+@subsubsection IMax1 Intrinsic
+@cindex IMax1 intrinsic
+@cindex intrinsics, IMax1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMax1} to use this name for an
+external procedure.
+
+@node IMin0 Intrinsic
+@subsubsection IMin0 Intrinsic
+@cindex IMin0 intrinsic
+@cindex intrinsics, IMin0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMin0} to use this name for an
+external procedure.
+
+@node IMin1 Intrinsic
+@subsubsection IMin1 Intrinsic
+@cindex IMin1 intrinsic
+@cindex intrinsics, IMin1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMin1} to use this name for an
+external procedure.
+
+@node IMod Intrinsic
+@subsubsection IMod Intrinsic
+@cindex IMod intrinsic
+@cindex intrinsics, IMod
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMod} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Index Intrinsic
+@subsubsection Index Intrinsic
+@cindex Index intrinsic
+@cindex intrinsics, Index
+
+@noindent
+@example
+Index(@var{String}, @var{Substring})
+@end example
+
+@noindent
+Index: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Substring}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the position of the start of the first occurrence of string
+@var{Substring} as a substring in @var{String}, counting from one.
+If @var{Substring} doesn't occur in @var{String}, zero is returned.
+
+@end ifset
+@ifset familyVXT
+@node INInt Intrinsic
+@subsubsection INInt Intrinsic
+@cindex INInt intrinsic
+@cindex intrinsics, INInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL INInt} to use this name for an
+external procedure.
+
+@node INot Intrinsic
+@subsubsection INot Intrinsic
+@cindex INot intrinsic
+@cindex intrinsics, INot
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL INot} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Int Intrinsic
+@subsubsection Int Intrinsic
+@cindex Int intrinsic
+@cindex intrinsics, Int
+
+@noindent
+@example
+Int(@var{A})
+@end example
+
+@noindent
+Int: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=1)}.
+
+If @var{A} is type @code{COMPLEX}, its real part is
+truncated and converted, and its imaginary part is disregarded.
+
+@xref{NInt Intrinsic}, for how to convert, rounded to nearest
+whole number.
+
+@xref{AInt Intrinsic}, for how to truncate to whole number
+without converting.
+
+@end ifset
+@ifset familyGNU
+@node Int2 Intrinsic
+@subsubsection Int2 Intrinsic
+@cindex Int2 intrinsic
+@cindex intrinsics, Int2
+
+@noindent
+@example
+Int2(@var{A})
+@end example
+
+@noindent
+Int2: @code{INTEGER(KIND=6)} function.
+
+@noindent
+@var{A}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=6)}.
+
+If @var{A} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disgregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+
+@node Int8 Intrinsic
+@subsubsection Int8 Intrinsic
+@cindex Int8 intrinsic
+@cindex intrinsics, Int8
+
+@noindent
+@example
+Int8(@var{A})
+@end example
+
+@noindent
+Int8: @code{INTEGER(KIND=2)} function.
+
+@noindent
+@var{A}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=2)}.
+
+If @var{A} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disgregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+
+@end ifset
+@ifset familyMIL
+@node IOr Intrinsic
+@subsubsection IOr Intrinsic
+@cindex IOr intrinsic
+@cindex intrinsics, IOr
+
+@noindent
+@example
+IOr(@var{I}, @var{J})
+@end example
+
+@noindent
+IOr: @code{INTEGER} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean OR of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF2U
+@node IRand Intrinsic
+@subsubsection IRand Intrinsic
+@cindex IRand intrinsic
+@cindex intrinsics, IRand
+
+@noindent
+@example
+IRand(@var{Flag})
+@end example
+
+@noindent
+IRand: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Flag}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns a uniform quasi-random number up to a system-dependent limit.
+If @var{Flag} is 0, the next number in sequence is returned; if
+@var{Flag} is 1, the generator is restarted by calling the UNIX function
+@samp{srand(0)}; if @var{Flag} has any other value,
+it is used as a new seed with @code{srand()}.
+
+@xref{SRand Intrinsic}.
+
+@emph{Note:} As typically implemented (by the routine of the same
+name in the C library), this random number generator is a very poor
+one, though the BSD and GNU libraries provide a much better
+implementation than the `traditional' one.
+On a different system you almost certainly want to use something better.
+
+@node IsaTty Intrinsic
+@subsubsection IsaTty Intrinsic
+@cindex IsaTty intrinsic
+@cindex intrinsics, IsaTty
+
+@noindent
+@example
+IsaTty(@var{Unit})
+@end example
+
+@noindent
+IsaTty: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns @code{.TRUE.} if and only if the Fortran I/O unit
+specified by @var{Unit} is connected
+to a terminal device.
+See @code{isatty(3)}.
+
+@end ifset
+@ifset familyMIL
+@node IShft Intrinsic
+@subsubsection IShft Intrinsic
+@cindex IShft intrinsic
+@cindex intrinsics, IShft
+
+@noindent
+@example
+IShft(@var{I}, @var{Shift})
+@end example
+
+@noindent
+IShft: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+All bits representing @var{I} are shifted @var{Shift} places.
+@samp{@var{Shift}.GT.0} indicates a left shift, @samp{@var{Shift}.EQ.0}
+indicates no shift and @samp{@var{Shift}.LT.0} indicates a right shift.
+If the absolute value of the shift count is greater than
+@samp{BIT_SIZE(@var{I})}, the result is undefined.
+Bits shifted out from the left end or the right end, as the case may be,
+are lost.
+Zeros are shifted in from the opposite end.
+
+@xref{IShftC Intrinsic} for the circular-shift equivalent.
+
+@node IShftC Intrinsic
+@subsubsection IShftC Intrinsic
+@cindex IShftC intrinsic
+@cindex intrinsics, IShftC
+
+@noindent
+@example
+IShftC(@var{I}, @var{Shift}, @var{Size})
+@end example
+
+@noindent
+IShftC: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Size}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+The rightmost @var{Size} bits of the argument @var{I}
+are shifted circularly @var{Shift}
+places, i.e.@ the bits shifted out of one end are shifted into
+the opposite end.
+No bits are lost.
+The unshifted bits of the result are the same as
+the unshifted bits of @var{I}.
+The absolute value of the argument @var{Shift}
+must be less than or equal to @var{Size}.
+The value of @var{Size} must be greater than or equal to one and less than
+or equal to @samp{BIT_SIZE(@var{I})}.
+
+@xref{IShft Intrinsic} for the logical shift equivalent.
+
+@end ifset
+@ifset familyF77
+@node ISign Intrinsic
+@subsubsection ISign Intrinsic
+@cindex ISign intrinsic
+@cindex intrinsics, ISign
+
+@noindent
+@example
+ISign(@var{A}, @var{B})
+@end example
+
+@noindent
+ISign: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{B}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ISIGN()} that is specific
+to one type for @var{A} and @var{B}.
+@xref{ISign Intrinsic}.
+
+@end ifset
+@ifset familyF2U
+@node ITime Intrinsic
+@subsubsection ITime Intrinsic
+@cindex ITime intrinsic
+@cindex intrinsics, ITime
+
+@noindent
+@example
+CALL ITime(@var{TArray})
+@end example
+
+@noindent
+@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(3); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current local time hour, minutes, and seconds in elements
+1, 2, and 3 of @var{TArray}, respectively.
+
+@end ifset
+@ifset familyVXT
+@node IZExt Intrinsic
+@subsubsection IZExt Intrinsic
+@cindex IZExt intrinsic
+@cindex intrinsics, IZExt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IZExt} to use this name for an
+external procedure.
+
+@node JIAbs Intrinsic
+@subsubsection JIAbs Intrinsic
+@cindex JIAbs intrinsic
+@cindex intrinsics, JIAbs
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIAbs} to use this name for an
+external procedure.
+
+@node JIAnd Intrinsic
+@subsubsection JIAnd Intrinsic
+@cindex JIAnd intrinsic
+@cindex intrinsics, JIAnd
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIAnd} to use this name for an
+external procedure.
+
+@node JIBClr Intrinsic
+@subsubsection JIBClr Intrinsic
+@cindex JIBClr intrinsic
+@cindex intrinsics, JIBClr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIBClr} to use this name for an
+external procedure.
+
+@node JIBits Intrinsic
+@subsubsection JIBits Intrinsic
+@cindex JIBits intrinsic
+@cindex intrinsics, JIBits
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIBits} to use this name for an
+external procedure.
+
+@node JIBSet Intrinsic
+@subsubsection JIBSet Intrinsic
+@cindex JIBSet intrinsic
+@cindex intrinsics, JIBSet
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIBSet} to use this name for an
+external procedure.
+
+@node JIDiM Intrinsic
+@subsubsection JIDiM Intrinsic
+@cindex JIDiM intrinsic
+@cindex intrinsics, JIDiM
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIDiM} to use this name for an
+external procedure.
+
+@node JIDInt Intrinsic
+@subsubsection JIDInt Intrinsic
+@cindex JIDInt intrinsic
+@cindex intrinsics, JIDInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIDInt} to use this name for an
+external procedure.
+
+@node JIDNnt Intrinsic
+@subsubsection JIDNnt Intrinsic
+@cindex JIDNnt intrinsic
+@cindex intrinsics, JIDNnt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIDNnt} to use this name for an
+external procedure.
+
+@node JIEOr Intrinsic
+@subsubsection JIEOr Intrinsic
+@cindex JIEOr intrinsic
+@cindex intrinsics, JIEOr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIEOr} to use this name for an
+external procedure.
+
+@node JIFix Intrinsic
+@subsubsection JIFix Intrinsic
+@cindex JIFix intrinsic
+@cindex intrinsics, JIFix
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIFix} to use this name for an
+external procedure.
+
+@node JInt Intrinsic
+@subsubsection JInt Intrinsic
+@cindex JInt intrinsic
+@cindex intrinsics, JInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JInt} to use this name for an
+external procedure.
+
+@node JIOr Intrinsic
+@subsubsection JIOr Intrinsic
+@cindex JIOr intrinsic
+@cindex intrinsics, JIOr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIOr} to use this name for an
+external procedure.
+
+@node JIQint Intrinsic
+@subsubsection JIQint Intrinsic
+@cindex JIQint intrinsic
+@cindex intrinsics, JIQint
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIQint} to use this name for an
+external procedure.
+
+@node JIQNnt Intrinsic
+@subsubsection JIQNnt Intrinsic
+@cindex JIQNnt intrinsic
+@cindex intrinsics, JIQNnt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIQNnt} to use this name for an
+external procedure.
+
+@node JIShft Intrinsic
+@subsubsection JIShft Intrinsic
+@cindex JIShft intrinsic
+@cindex intrinsics, JIShft
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIShft} to use this name for an
+external procedure.
+
+@node JIShftC Intrinsic
+@subsubsection JIShftC Intrinsic
+@cindex JIShftC intrinsic
+@cindex intrinsics, JIShftC
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIShftC} to use this name for an
+external procedure.
+
+@node JISign Intrinsic
+@subsubsection JISign Intrinsic
+@cindex JISign intrinsic
+@cindex intrinsics, JISign
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JISign} to use this name for an
+external procedure.
+
+@node JMax0 Intrinsic
+@subsubsection JMax0 Intrinsic
+@cindex JMax0 intrinsic
+@cindex intrinsics, JMax0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMax0} to use this name for an
+external procedure.
+
+@node JMax1 Intrinsic
+@subsubsection JMax1 Intrinsic
+@cindex JMax1 intrinsic
+@cindex intrinsics, JMax1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMax1} to use this name for an
+external procedure.
+
+@node JMin0 Intrinsic
+@subsubsection JMin0 Intrinsic
+@cindex JMin0 intrinsic
+@cindex intrinsics, JMin0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMin0} to use this name for an
+external procedure.
+
+@node JMin1 Intrinsic
+@subsubsection JMin1 Intrinsic
+@cindex JMin1 intrinsic
+@cindex intrinsics, JMin1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMin1} to use this name for an
+external procedure.
+
+@node JMod Intrinsic
+@subsubsection JMod Intrinsic
+@cindex JMod intrinsic
+@cindex intrinsics, JMod
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMod} to use this name for an
+external procedure.
+
+@node JNInt Intrinsic
+@subsubsection JNInt Intrinsic
+@cindex JNInt intrinsic
+@cindex intrinsics, JNInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JNInt} to use this name for an
+external procedure.
+
+@node JNot Intrinsic
+@subsubsection JNot Intrinsic
+@cindex JNot intrinsic
+@cindex intrinsics, JNot
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JNot} to use this name for an
+external procedure.
+
+@node JZExt Intrinsic
+@subsubsection JZExt Intrinsic
+@cindex JZExt intrinsic
+@cindex intrinsics, JZExt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JZExt} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Kill Intrinsic (subroutine)
+@subsubsection Kill Intrinsic (subroutine)
+@cindex Kill intrinsic
+@cindex intrinsics, Kill
+
+@noindent
+@example
+CALL Kill(@var{Pid}, @var{Signal}, @var{Status})
+@end example
+
+@noindent
+@var{Pid}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Signal}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sends the signal specified by @var{Signal} to the process @var{Pid}.
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+See @code{kill(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Kill Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Kill Intrinsic (function)
+@subsubsection Kill Intrinsic (function)
+@cindex Kill intrinsic
+@cindex intrinsics, Kill
+
+@noindent
+@example
+Kill(@var{Pid}, @var{Signal})
+@end example
+
+@noindent
+Kill: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Pid}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Signal}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Sends the signal specified by @var{Signal} to the process @var{Pid}.
+Returns 0 on success or a non-zero error code.
+See @code{kill(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Kill Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Kind Intrinsic
+@subsubsection Kind Intrinsic
+@cindex Kind intrinsic
+@cindex intrinsics, Kind
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Kind} to use this name for an
+external procedure.
+
+@node LBound Intrinsic
+@subsubsection LBound Intrinsic
+@cindex LBound intrinsic
+@cindex intrinsics, LBound
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL LBound} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Len Intrinsic
+@subsubsection Len Intrinsic
+@cindex Len intrinsic
+@cindex intrinsics, Len
+
+@noindent
+@example
+Len(@var{String})
+@end example
+
+@noindent
+Len: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar.
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the length of @var{String}.
+
+If @var{String} is an array, the length of an element
+of @var{String} is returned.
+
+Note that @var{String} need not be defined when this
+intrinsic is invoked, since only the length, not
+the content, of @var{String} is needed.
+
+@xref{Bit_Size Intrinsic}, for the function that determines
+the size of its argument in bits.
+
+@end ifset
+@ifset familyF90
+@node Len_Trim Intrinsic
+@subsubsection Len_Trim Intrinsic
+@cindex Len_Trim intrinsic
+@cindex intrinsics, Len_Trim
+
+@noindent
+@example
+Len_Trim(@var{String})
+@end example
+
+@noindent
+Len_Trim: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns the index of the last non-blank character in @var{String}.
+@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
+
+@end ifset
+@ifset familyF77
+@node LGe Intrinsic
+@subsubsection LGe Intrinsic
+@cindex LGe intrinsic
+@cindex intrinsics, LGe
+
+@noindent
+@example
+LGe(@var{String_A}, @var{String_B})
+@end example
+
+@noindent
+LGe: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{.TRUE.} if @samp{@var{String_A}.GE.@var{String_B}},
+@samp{.FALSE.} otherwise.
+@var{String_A} and @var{String_B} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{String_A} and @var{String_B} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+The lexical comparison intrinsics @code{LGe}, @code{LGt},
+@code{LLe}, and @code{LLt} differ from the corresponding
+intrinsic operators @code{.GE.}, @code{.GT.},
+@code{.LE.}, @code{.LT.}.
+Because the ASCII collating sequence is assumed,
+the following expressions always return @samp{.TRUE.}:
+
+@smallexample
+LGE ('0', ' ')
+LGE ('A', '0')
+LGE ('a', 'A')
+@end smallexample
+
+The following related expressions do @emph{not} always
+return @samp{.TRUE.}, as they are not necessarily evaluated
+assuming the arguments use ASCII encoding:
+
+@smallexample
+'0' .GE. ' '
+'A' .GE. '0'
+'a' .GE. 'A'
+@end smallexample
+
+The same difference exists
+between @code{LGt} and @code{.GT.};
+between @code{LLe} and @code{.LE.}; and
+between @code{LLt} and @code{.LT.}.
+
+@node LGt Intrinsic
+@subsubsection LGt Intrinsic
+@cindex LGt intrinsic
+@cindex intrinsics, LGt
+
+@noindent
+@example
+LGt(@var{String_A}, @var{String_B})
+@end example
+
+@noindent
+LGt: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{.TRUE.} if @samp{@var{String_A}.GT.@var{String_B}},
+@samp{.FALSE.} otherwise.
+@var{String_A} and @var{String_B} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{String_A} and @var{String_B} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{LGT} intrinsic and the @code{.GT.}
+operator.
+
+@end ifset
+@ifset familyF2U
+@node Link Intrinsic (subroutine)
+@subsubsection Link Intrinsic (subroutine)
+@cindex Link intrinsic
+@cindex intrinsics, Link
+
+@noindent
+@example
+CALL Link(@var{Path1}, @var{Path2}, @var{Status})
+@end example
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Makes a (hard) link from file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+See @code{link(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Link Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Link Intrinsic (function)
+@subsubsection Link Intrinsic (function)
+@cindex Link intrinsic
+@cindex intrinsics, Link
+
+@noindent
+@example
+Link(@var{Path1}, @var{Path2})
+@end example
+
+@noindent
+Link: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Makes a (hard) link from file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+Returns 0 on success or a non-zero error code.
+See @code{link(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Link Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node LLe Intrinsic
+@subsubsection LLe Intrinsic
+@cindex LLe intrinsic
+@cindex intrinsics, LLe
+
+@noindent
+@example
+LLe(@var{String_A}, @var{String_B})
+@end example
+
+@noindent
+LLe: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{.TRUE.} if @samp{@var{String_A}.LE.@var{String_B}},
+@samp{.FALSE.} otherwise.
+@var{String_A} and @var{String_B} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{String_A} and @var{String_B} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{LLE} intrinsic and the @code{.LE.}
+operator.
+
+@node LLt Intrinsic
+@subsubsection LLt Intrinsic
+@cindex LLt intrinsic
+@cindex intrinsics, LLt
+
+@noindent
+@example
+LLt(@var{String_A}, @var{String_B})
+@end example
+
+@noindent
+LLt: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{.TRUE.} if @samp{@var{String_A}.LT.@var{String_B}},
+@samp{.FALSE.} otherwise.
+@var{String_A} and @var{String_B} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{String_A} and @var{String_B} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{LLT} intrinsic and the @code{.LT.}
+operator.
+
+@end ifset
+@ifset familyF2U
+@node LnBlnk Intrinsic
+@subsubsection LnBlnk Intrinsic
+@cindex LnBlnk intrinsic
+@cindex intrinsics, LnBlnk
+
+@noindent
+@example
+LnBlnk(@var{String})
+@end example
+
+@noindent
+LnBlnk: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the index of the last non-blank character in @var{String}.
+@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
+
+@node Loc Intrinsic
+@subsubsection Loc Intrinsic
+@cindex Loc intrinsic
+@cindex intrinsics, Loc
+
+@noindent
+@example
+Loc(@var{Entity})
+@end example
+
+@noindent
+Loc: @code{INTEGER(KIND=0)} function.
+
+@noindent
+@var{Entity}: Any type; cannot be a constant or expression.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+The @code{LOC()} intrinsic works the
+same way as the @code{%LOC()} construct.
+@xref{%LOC(),,The @code{%LOC()} Construct}, for
+more information.
+
+@end ifset
+@ifset familyF77
+@node Log Intrinsic
+@subsubsection Log Intrinsic
+@cindex Log intrinsic
+@cindex intrinsics, Log
+
+@noindent
+@example
+Log(@var{X})
+@end example
+
+@noindent
+Log: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the natural logarithm of @var{X}, which must
+be greater than zero or, if type @code{COMPLEX}, must not
+be zero.
+
+@xref{Exp Intrinsic}, for the inverse of this function.
+
+@xref{Log10 Intrinsic}, for the base-10 logarithm function.
+
+@node Log10 Intrinsic
+@subsubsection Log10 Intrinsic
+@cindex Log10 intrinsic
+@cindex intrinsics, Log10
+
+@noindent
+@example
+Log10(@var{X})
+@end example
+
+@noindent
+Log10: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the natural logarithm of @var{X}, which must
+be greater than zero or, if type @code{COMPLEX}, must not
+be zero.
+
+The inverse of this function is @samp{10. ** LOG10(@var{X})}.
+
+@xref{Log Intrinsic}, for the natural logarithm function.
+
+@end ifset
+@ifset familyF90
+@node Logical Intrinsic
+@subsubsection Logical Intrinsic
+@cindex Logical intrinsic
+@cindex intrinsics, Logical
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Logical} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Long Intrinsic
+@subsubsection Long Intrinsic
+@cindex Long intrinsic
+@cindex intrinsics, Long
+
+@noindent
+@example
+Long(@var{A})
+@end example
+
+@noindent
+Long: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=6)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{INT()} that is specific
+to one type for @var{A}.
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+
+@end ifset
+@ifset familyF2C
+@node LShift Intrinsic
+@subsubsection LShift Intrinsic
+@cindex LShift intrinsic
+@cindex intrinsics, LShift
+
+@noindent
+@example
+LShift(@var{I}, @var{Shift})
+@end example
+
+@noindent
+LShift: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns @var{I} shifted to the left
+@var{Shift} bits.
+
+Although similar to the expression
+@samp{@var{I}*(2**@var{Shift})}, there
+are important differences.
+For example, the sign of the result is
+not necessarily the same as the sign of
+@var{I}.
+
+Currently this intrinsic is defined assuming
+the underlying representation of @var{I}
+is as a two's-complement integer.
+It is unclear at this point whether that
+definition will apply when a different
+representation is involved.
+
+@xref{LShift Intrinsic}, for the inverse of this function.
+
+@xref{IShft Intrinsic}, for information
+on a more widely available left-shifting
+intrinsic that is also more precisely defined.
+
+@end ifset
+@ifset familyF2U
+@node LStat Intrinsic (subroutine)
+@subsubsection LStat Intrinsic (subroutine)
+@cindex LStat intrinsic
+@cindex intrinsics, LStat
+
+@noindent
+@example
+CALL LStat(@var{File}, @var{SArray}, @var{Status})
+@end example
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the given file @var{File} and places them in the array
+@var{SArray}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+If @var{File} is a symbolic link it returns data on the
+link itself, so the routine is available only on systems that support
+symbolic links.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{LStat Intrinsic (function)}.
+
+@node LStat Intrinsic (function)
+@subsubsection LStat Intrinsic (function)
+@cindex LStat intrinsic
+@cindex intrinsics, LStat
+
+@noindent
+@example
+LStat(@var{File}, @var{SArray})
+@end example
+
+@noindent
+LStat: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the given file @var{File} and places them in the array
+@var{SArray}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+If @var{File} is a symbolic link it returns data on the
+link itself, so the routine is available only on systems that support
+symbolic links.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a non-zero error code
+(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
+
+For information on other intrinsics with the same name:
+@xref{LStat Intrinsic (subroutine)}.
+
+@node LTime Intrinsic
+@subsubsection LTime Intrinsic
+@cindex LTime intrinsic
+@cindex intrinsics, LTime
+
+@noindent
+@example
+CALL LTime(@var{STime}, @var{TArray})
+@end example
+
+@noindent
+@var{STime}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(9); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Given a system time value @var{STime}, fills @var{TArray} with values
+extracted from it appropriate to the GMT time zone using
+@code{localtime(3)}.
+
+The array elements are as follows:
+
+@enumerate
+@item
+Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+
+@item
+Minutes after the hour, range 0--59
+
+@item
+Hours past midnight, range 0--23
+
+@item
+Day of month, range 0--31
+
+@item
+Number of months since January, range 0--12
+
+@item
+Years since 1900
+
+@item
+Number of days since Sunday, range 0--6
+
+@item
+Days since January 1
+
+@item
+Daylight savings indicator: positive if daylight savings is in effect,
+zero if not, and negative if the information isn't available.
+@end enumerate
+
+@end ifset
+@ifset familyF90
+@node MatMul Intrinsic
+@subsubsection MatMul Intrinsic
+@cindex MatMul intrinsic
+@cindex intrinsics, MatMul
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MatMul} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Max Intrinsic
+@subsubsection Max Intrinsic
+@cindex Max intrinsic
+@cindex intrinsics, Max
+
+@noindent
+@example
+Max(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Max: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{A}: @code{INTEGER} or @code{REAL}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the argument with the largest value.
+
+@xref{Min Intrinsic}, for the opposite function.
+
+@node Max0 Intrinsic
+@subsubsection Max0 Intrinsic
+@cindex Max0 intrinsic
+@cindex intrinsics, Max0
+
+@noindent
+@example
+Max0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Max0: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A}.
+@xref{Max Intrinsic}.
+
+@node Max1 Intrinsic
+@subsubsection Max1 Intrinsic
+@cindex Max1 intrinsic
+@cindex intrinsics, Max1
+
+@noindent
+@example
+Max1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Max1: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A} and a different return type.
+@xref{Max Intrinsic}.
+
+@end ifset
+@ifset familyF90
+@node MaxExponent Intrinsic
+@subsubsection MaxExponent Intrinsic
+@cindex MaxExponent intrinsic
+@cindex intrinsics, MaxExponent
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MaxExponent} to use this name for an
+external procedure.
+
+@node MaxLoc Intrinsic
+@subsubsection MaxLoc Intrinsic
+@cindex MaxLoc intrinsic
+@cindex intrinsics, MaxLoc
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MaxLoc} to use this name for an
+external procedure.
+
+@node MaxVal Intrinsic
+@subsubsection MaxVal Intrinsic
+@cindex MaxVal intrinsic
+@cindex intrinsics, MaxVal
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MaxVal} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node MClock Intrinsic
+@subsubsection MClock Intrinsic
+@cindex MClock intrinsic
+@cindex intrinsics, MClock
+
+@noindent
+@example
+MClock()
+@end example
+
+@noindent
+MClock: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the number of clock ticks since the start of the process.
+Supported on systems with @code{clock(3)} (q.v.).
+
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+@xref{MClock8 Intrinsic}, for information on a
+similar intrinsic that might be portable to more
+GNU Fortran implementations, though to fewer
+Fortran compilers.
+
+If the system does not support @code{clock(3)},
+-1 is returned.
+
+@node MClock8 Intrinsic
+@subsubsection MClock8 Intrinsic
+@cindex MClock8 intrinsic
+@cindex intrinsics, MClock8
+
+@noindent
+@example
+MClock8()
+@end example
+
+@noindent
+MClock8: @code{INTEGER(KIND=2)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the number of clock ticks since the start of the process.
+Supported on systems with @code{clock(3)} (q.v.).
+
+No Fortran implementations other than GNU Fortran are
+known to support this intrinsic at the time of this
+writing.
+@xref{MClock Intrinsic}, for information on a
+similar intrinsic that might be portable to more Fortran
+compilers, though to fewer GNU Fortran implementations.
+
+If the system does not support @code{clock(3)},
+-1 is returned.
+
+@end ifset
+@ifset familyF90
+@node Merge Intrinsic
+@subsubsection Merge Intrinsic
+@cindex Merge intrinsic
+@cindex intrinsics, Merge
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Merge} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Min Intrinsic
+@subsubsection Min Intrinsic
+@cindex Min intrinsic
+@cindex intrinsics, Min
+
+@noindent
+@example
+Min(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Min: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{A}: @code{INTEGER} or @code{REAL}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the argument with the smallest value.
+
+@xref{Max Intrinsic}, for the opposite function.
+
+@node Min0 Intrinsic
+@subsubsection Min0 Intrinsic
+@cindex Min0 intrinsic
+@cindex intrinsics, Min0
+
+@noindent
+@example
+Min0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Min0: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A}.
+@xref{Min Intrinsic}.
+
+@node Min1 Intrinsic
+@subsubsection Min1 Intrinsic
+@cindex Min1 intrinsic
+@cindex intrinsics, Min1
+
+@noindent
+@example
+Min1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Min1: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A} and a different return type.
+@xref{Min Intrinsic}.
+
+@end ifset
+@ifset familyF90
+@node MinExponent Intrinsic
+@subsubsection MinExponent Intrinsic
+@cindex MinExponent intrinsic
+@cindex intrinsics, MinExponent
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MinExponent} to use this name for an
+external procedure.
+
+@node MinLoc Intrinsic
+@subsubsection MinLoc Intrinsic
+@cindex MinLoc intrinsic
+@cindex intrinsics, MinLoc
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MinLoc} to use this name for an
+external procedure.
+
+@node MinVal Intrinsic
+@subsubsection MinVal Intrinsic
+@cindex MinVal intrinsic
+@cindex intrinsics, MinVal
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MinVal} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Mod Intrinsic
+@subsubsection Mod Intrinsic
+@cindex Mod intrinsic
+@cindex intrinsics, Mod
+
+@noindent
+@example
+Mod(@var{A}, @var{P})
+@end example
+
+@noindent
+Mod: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{A}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{P}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns remainder calculated as:
+
+@smallexample
+@var{A} - (INT(@var{A} / @var{P}) * @var{P})
+@end smallexample
+
+@var{P} must not be zero.
+
+@end ifset
+@ifset familyF90
+@node Modulo Intrinsic
+@subsubsection Modulo Intrinsic
+@cindex Modulo intrinsic
+@cindex intrinsics, Modulo
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Modulo} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyMIL
+@node MvBits Intrinsic
+@subsubsection MvBits Intrinsic
+@cindex MvBits intrinsic
+@cindex intrinsics, MvBits
+
+@noindent
+@example
+CALL MvBits(@var{From}, @var{FromPos}, @var{Len}, @var{TO}, @var{ToPos})
+@end example
+
+@noindent
+@var{From}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{FromPos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Len}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{TO}: @code{INTEGER} with same @samp{KIND=} value as for @var{From}; scalar; INTENT(INOUT).
+
+@noindent
+@var{ToPos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Moves @var{Len} bits from positions @var{FromPos} through
+@samp{@var{FromPos}+@var{Len}-1} of @var{From} to positions @var{ToPos} through
+@samp{@var{FromPos}+@var{Len}-1} of @var{TO}. The portion of argument
+@var{TO} not affected by the movement of bits is unchanged. Arguments
+@var{From} and @var{TO} are permitted to be the same numeric storage
+unit. The values of @samp{@var{FromPos}+@var{Len}} and
+@samp{@var{ToPos}+@var{Len}} must be less than or equal to
+@samp{BIT_SIZE(@var{From})}.
+
+@end ifset
+@ifset familyF90
+@node Nearest Intrinsic
+@subsubsection Nearest Intrinsic
+@cindex Nearest intrinsic
+@cindex intrinsics, Nearest
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Nearest} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node NInt Intrinsic
+@subsubsection NInt Intrinsic
+@cindex NInt intrinsic
+@cindex intrinsics, NInt
+
+@noindent
+@example
+NInt(@var{A})
+@end example
+
+@noindent
+NInt: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude eliminated by rounding to the nearest whole
+number and with its sign preserved, converted
+to type @code{INTEGER(KIND=1)}.
+
+If @var{A} is type @code{COMPLEX}, its real part is
+rounded and converted.
+
+A fractional portion exactly equal to
+@samp{.5} is rounded to the whole number that
+is larger in magnitude.
+(Also called ``Fortran round''.)
+
+@xref{Int Intrinsic}, for how to convert, truncate to
+whole number.
+
+@xref{ANInt Intrinsic}, for how to round to nearest whole number
+without converting.
+
+@end ifset
+@ifset familyMIL
+@node Not Intrinsic
+@subsubsection Not Intrinsic
+@cindex Not intrinsic
+@cindex intrinsics, Not
+
+@noindent
+@example
+Not(@var{I})
+@end example
+
+@noindent
+Not: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean NOT of each bit
+in @var{I}.
+
+@end ifset
+@ifset familyF2C
+@node Or Intrinsic
+@subsubsection Or Intrinsic
+@cindex Or intrinsic
+@cindex intrinsics, Or
+
+@noindent
+@example
+Or(@var{I}, @var{J})
+@end example
+
+@noindent
+Or: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean OR of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF90
+@node Pack Intrinsic
+@subsubsection Pack Intrinsic
+@cindex Pack intrinsic
+@cindex intrinsics, Pack
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Pack} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node PError Intrinsic
+@subsubsection PError Intrinsic
+@cindex PError intrinsic
+@cindex intrinsics, PError
+
+@noindent
+@example
+CALL PError(@var{String})
+@end example
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Prints (on the C @code{stderr} stream) a newline-terminated error
+message corresponding to the last system error.
+This is prefixed by @var{String}, a colon and a space.
+See @code{perror(3)}.
+
+@end ifset
+@ifset familyF90
+@node Precision Intrinsic
+@subsubsection Precision Intrinsic
+@cindex Precision intrinsic
+@cindex intrinsics, Precision
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Precision} to use this name for an
+external procedure.
+
+@node Present Intrinsic
+@subsubsection Present Intrinsic
+@cindex Present intrinsic
+@cindex intrinsics, Present
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Present} to use this name for an
+external procedure.
+
+@node Product Intrinsic
+@subsubsection Product Intrinsic
+@cindex Product intrinsic
+@cindex intrinsics, Product
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Product} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyVXT
+@node QAbs Intrinsic
+@subsubsection QAbs Intrinsic
+@cindex QAbs intrinsic
+@cindex intrinsics, QAbs
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QAbs} to use this name for an
+external procedure.
+
+@node QACos Intrinsic
+@subsubsection QACos Intrinsic
+@cindex QACos intrinsic
+@cindex intrinsics, QACos
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QACos} to use this name for an
+external procedure.
+
+@node QACosD Intrinsic
+@subsubsection QACosD Intrinsic
+@cindex QACosD intrinsic
+@cindex intrinsics, QACosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QACosD} to use this name for an
+external procedure.
+
+@node QASin Intrinsic
+@subsubsection QASin Intrinsic
+@cindex QASin intrinsic
+@cindex intrinsics, QASin
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QASin} to use this name for an
+external procedure.
+
+@node QASinD Intrinsic
+@subsubsection QASinD Intrinsic
+@cindex QASinD intrinsic
+@cindex intrinsics, QASinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QASinD} to use this name for an
+external procedure.
+
+@node QATan Intrinsic
+@subsubsection QATan Intrinsic
+@cindex QATan intrinsic
+@cindex intrinsics, QATan
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QATan} to use this name for an
+external procedure.
+
+@node QATan2 Intrinsic
+@subsubsection QATan2 Intrinsic
+@cindex QATan2 intrinsic
+@cindex intrinsics, QATan2
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QATan2} to use this name for an
+external procedure.
+
+@node QATan2D Intrinsic
+@subsubsection QATan2D Intrinsic
+@cindex QATan2D intrinsic
+@cindex intrinsics, QATan2D
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QATan2D} to use this name for an
+external procedure.
+
+@node QATanD Intrinsic
+@subsubsection QATanD Intrinsic
+@cindex QATanD intrinsic
+@cindex intrinsics, QATanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QATanD} to use this name for an
+external procedure.
+
+@node QCos Intrinsic
+@subsubsection QCos Intrinsic
+@cindex QCos intrinsic
+@cindex intrinsics, QCos
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QCos} to use this name for an
+external procedure.
+
+@node QCosD Intrinsic
+@subsubsection QCosD Intrinsic
+@cindex QCosD intrinsic
+@cindex intrinsics, QCosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QCosD} to use this name for an
+external procedure.
+
+@node QCosH Intrinsic
+@subsubsection QCosH Intrinsic
+@cindex QCosH intrinsic
+@cindex intrinsics, QCosH
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QCosH} to use this name for an
+external procedure.
+
+@node QDiM Intrinsic
+@subsubsection QDiM Intrinsic
+@cindex QDiM intrinsic
+@cindex intrinsics, QDiM
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QDiM} to use this name for an
+external procedure.
+
+@node QExp Intrinsic
+@subsubsection QExp Intrinsic
+@cindex QExp intrinsic
+@cindex intrinsics, QExp
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QExp} to use this name for an
+external procedure.
+
+@node QExt Intrinsic
+@subsubsection QExt Intrinsic
+@cindex QExt intrinsic
+@cindex intrinsics, QExt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QExt} to use this name for an
+external procedure.
+
+@node QExtD Intrinsic
+@subsubsection QExtD Intrinsic
+@cindex QExtD intrinsic
+@cindex intrinsics, QExtD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QExtD} to use this name for an
+external procedure.
+
+@node QFloat Intrinsic
+@subsubsection QFloat Intrinsic
+@cindex QFloat intrinsic
+@cindex intrinsics, QFloat
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QFloat} to use this name for an
+external procedure.
+
+@node QInt Intrinsic
+@subsubsection QInt Intrinsic
+@cindex QInt intrinsic
+@cindex intrinsics, QInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QInt} to use this name for an
+external procedure.
+
+@node QLog Intrinsic
+@subsubsection QLog Intrinsic
+@cindex QLog intrinsic
+@cindex intrinsics, QLog
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QLog} to use this name for an
+external procedure.
+
+@node QLog10 Intrinsic
+@subsubsection QLog10 Intrinsic
+@cindex QLog10 intrinsic
+@cindex intrinsics, QLog10
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QLog10} to use this name for an
+external procedure.
+
+@node QMax1 Intrinsic
+@subsubsection QMax1 Intrinsic
+@cindex QMax1 intrinsic
+@cindex intrinsics, QMax1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QMax1} to use this name for an
+external procedure.
+
+@node QMin1 Intrinsic
+@subsubsection QMin1 Intrinsic
+@cindex QMin1 intrinsic
+@cindex intrinsics, QMin1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QMin1} to use this name for an
+external procedure.
+
+@node QMod Intrinsic
+@subsubsection QMod Intrinsic
+@cindex QMod intrinsic
+@cindex intrinsics, QMod
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QMod} to use this name for an
+external procedure.
+
+@node QNInt Intrinsic
+@subsubsection QNInt Intrinsic
+@cindex QNInt intrinsic
+@cindex intrinsics, QNInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QNInt} to use this name for an
+external procedure.
+
+@node QSin Intrinsic
+@subsubsection QSin Intrinsic
+@cindex QSin intrinsic
+@cindex intrinsics, QSin
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QSin} to use this name for an
+external procedure.
+
+@node QSinD Intrinsic
+@subsubsection QSinD Intrinsic
+@cindex QSinD intrinsic
+@cindex intrinsics, QSinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QSinD} to use this name for an
+external procedure.
+
+@node QSinH Intrinsic
+@subsubsection QSinH Intrinsic
+@cindex QSinH intrinsic
+@cindex intrinsics, QSinH
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QSinH} to use this name for an
+external procedure.
+
+@node QSqRt Intrinsic
+@subsubsection QSqRt Intrinsic
+@cindex QSqRt intrinsic
+@cindex intrinsics, QSqRt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QSqRt} to use this name for an
+external procedure.
+
+@node QTan Intrinsic
+@subsubsection QTan Intrinsic
+@cindex QTan intrinsic
+@cindex intrinsics, QTan
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QTan} to use this name for an
+external procedure.
+
+@node QTanD Intrinsic
+@subsubsection QTanD Intrinsic
+@cindex QTanD intrinsic
+@cindex intrinsics, QTanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QTanD} to use this name for an
+external procedure.
+
+@node QTanH Intrinsic
+@subsubsection QTanH Intrinsic
+@cindex QTanH intrinsic
+@cindex intrinsics, QTanH
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QTanH} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Radix Intrinsic
+@subsubsection Radix Intrinsic
+@cindex Radix intrinsic
+@cindex intrinsics, Radix
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Radix} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Rand Intrinsic
+@subsubsection Rand Intrinsic
+@cindex Rand intrinsic
+@cindex intrinsics, Rand
+
+@noindent
+@example
+Rand(@var{Flag})
+@end example
+
+@noindent
+Rand: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{Flag}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns a uniform quasi-random number between 0 and 1.
+If @var{Flag} is 0, the next number in sequence is returned; if
+@var{Flag} is 1, the generator is restarted by calling @samp{srand(0)};
+if @var{Flag} has any other value, it is used as a new seed with
+@code{srand}.
+
+@xref{SRand Intrinsic}.
+
+@emph{Note:} As typically implemented (by the routine of the same
+name in the C library), this random number generator is a very poor
+one, though the BSD and GNU libraries provide a much better
+implementation than the `traditional' one.
+On a different system you
+almost certainly want to use something better.
+
+@end ifset
+@ifset familyF90
+@node Random_Number Intrinsic
+@subsubsection Random_Number Intrinsic
+@cindex Random_Number intrinsic
+@cindex intrinsics, Random_Number
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Random_Number} to use this name for an
+external procedure.
+
+@node Random_Seed Intrinsic
+@subsubsection Random_Seed Intrinsic
+@cindex Random_Seed intrinsic
+@cindex intrinsics, Random_Seed
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Random_Seed} to use this name for an
+external procedure.
+
+@node Range Intrinsic
+@subsubsection Range Intrinsic
+@cindex Range intrinsic
+@cindex intrinsics, Range
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Range} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Real Intrinsic
+@subsubsection Real Intrinsic
+@cindex Real intrinsic
+@cindex intrinsics, Real
+
+@noindent
+@example
+Real(@var{A})
+@end example
+
+@noindent
+Real: @code{REAL} function.
+The exact type is @samp{REAL(KIND=1)} when argument @var{A} is
+any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.
+When @var{A} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},
+this intrinsic is valid only when used as the argument to
+@code{REAL()}, as explained below.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Converts @var{A} to @code{REAL(KIND=1)}.
+
+Use of @code{REAL()} with a @code{COMPLEX} argument
+(other than @code{COMPLEX(KIND=1)}) is restricted to the following case:
+
+@example
+REAL(REAL(A))
+@end example
+
+@noindent
+This expression converts the real part of A to
+@code{REAL(KIND=1)}.
+
+@xref{RealPart Intrinsic}, for information on a GNU Fortran
+intrinsic that extracts the real part of an arbitrary
+@code{COMPLEX} value.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyGNU
+@node RealPart Intrinsic
+@subsubsection RealPart Intrinsic
+@cindex RealPart intrinsic
+@cindex intrinsics, RealPart
+
+@noindent
+@example
+RealPart(@var{Z})
+@end example
+
+@noindent
+RealPart: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+The real part of @var{Z} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{REAL(@var{Z})}.
+However, when, for example, @var{Z} is @code{COMPLEX(KIND=2)},
+@samp{REAL(@var{Z})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{REALPART()} is that, while not necessarily
+more or less portable than @code{REAL()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyF2U
+@node Rename Intrinsic (subroutine)
+@subsubsection Rename Intrinsic (subroutine)
+@cindex Rename intrinsic
+@cindex intrinsics, Rename
+
+@noindent
+@example
+CALL Rename(@var{Path1}, @var{Path2}, @var{Status})
+@end example
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Renames the file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+See @code{rename(2)}.
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Rename Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Rename Intrinsic (function)
+@subsubsection Rename Intrinsic (function)
+@cindex Rename intrinsic
+@cindex intrinsics, Rename
+
+@noindent
+@example
+Rename(@var{Path1}, @var{Path2})
+@end example
+
+@noindent
+Rename: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Renames the file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+See @code{rename(2)}.
+Returns 0 on success or a non-zero error code.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Rename Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Repeat Intrinsic
+@subsubsection Repeat Intrinsic
+@cindex Repeat intrinsic
+@cindex intrinsics, Repeat
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Repeat} to use this name for an
+external procedure.
+
+@node Reshape Intrinsic
+@subsubsection Reshape Intrinsic
+@cindex Reshape intrinsic
+@cindex intrinsics, Reshape
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Reshape} to use this name for an
+external procedure.
+
+@node RRSpacing Intrinsic
+@subsubsection RRSpacing Intrinsic
+@cindex RRSpacing intrinsic
+@cindex intrinsics, RRSpacing
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL RRSpacing} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2C
+@node RShift Intrinsic
+@subsubsection RShift Intrinsic
+@cindex RShift intrinsic
+@cindex intrinsics, RShift
+
+@noindent
+@example
+RShift(@var{I}, @var{Shift})
+@end example
+
+@noindent
+RShift: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns @var{I} shifted to the right
+@var{Shift} bits.
+
+Although similar to the expression
+@samp{@var{I}/(2**@var{Shift})}, there
+are important differences.
+For example, the sign of the result is
+undefined.
+
+Currently this intrinsic is defined assuming
+the underlying representation of @var{I}
+is as a two's-complement integer.
+It is unclear at this point whether that
+definition will apply when a different
+representation is involved.
+
+@xref{RShift Intrinsic}, for the inverse of this function.
+
+@xref{IShft Intrinsic}, for information
+on a more widely available right-shifting
+intrinsic that is also more precisely defined.
+
+@end ifset
+@ifset familyF90
+@node Scale Intrinsic
+@subsubsection Scale Intrinsic
+@cindex Scale intrinsic
+@cindex intrinsics, Scale
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Scale} to use this name for an
+external procedure.
+
+@node Scan Intrinsic
+@subsubsection Scan Intrinsic
+@cindex Scan intrinsic
+@cindex intrinsics, Scan
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Scan} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyVXT
+@node Secnds Intrinsic
+@subsubsection Secnds Intrinsic
+@cindex Secnds intrinsic
+@cindex intrinsics, Secnds
+
+@noindent
+@example
+Secnds(@var{T})
+@end example
+
+@noindent
+Secnds: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{T}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Returns the local time in seconds since midnight minus the value
+@var{T}.
+
+@end ifset
+@ifset familyF2U
+@node Second Intrinsic (function)
+@subsubsection Second Intrinsic (function)
+@cindex Second intrinsic
+@cindex intrinsics, Second
+
+@noindent
+@example
+Second()
+@end example
+
+@noindent
+Second: @code{REAL(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the process's runtime in seconds---the same value as the
+UNIX function @code{etime} returns.
+
+This routine is known from Cray Fortran.
+
+For information on other intrinsics with the same name:
+@xref{Second Intrinsic (subroutine)}.
+
+@node Second Intrinsic (subroutine)
+@subsubsection Second Intrinsic (subroutine)
+@cindex Second intrinsic
+@cindex intrinsics, Second
+
+@noindent
+@example
+CALL Second(@var{Seconds})
+@end example
+
+@noindent
+@var{Seconds}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the process's runtime in seconds in @var{Seconds}---the same value
+as the UNIX function @code{etime} returns.
+
+This routine is known from Cray Fortran. @xref{Cpu_Time Intrinsic}
+for a standard equivalent.
+
+For information on other intrinsics with the same name:
+@xref{Second Intrinsic (function)}.
+
+@end ifset
+@ifset familyF90
+@node Selected_Int_Kind Intrinsic
+@subsubsection Selected_Int_Kind Intrinsic
+@cindex Selected_Int_Kind intrinsic
+@cindex intrinsics, Selected_Int_Kind
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Selected_Int_Kind} to use this name for an
+external procedure.
+
+@node Selected_Real_Kind Intrinsic
+@subsubsection Selected_Real_Kind Intrinsic
+@cindex Selected_Real_Kind intrinsic
+@cindex intrinsics, Selected_Real_Kind
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Selected_Real_Kind} to use this name for an
+external procedure.
+
+@node Set_Exponent Intrinsic
+@subsubsection Set_Exponent Intrinsic
+@cindex Set_Exponent intrinsic
+@cindex intrinsics, Set_Exponent
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Set_Exponent} to use this name for an
+external procedure.
+
+@node Shape Intrinsic
+@subsubsection Shape Intrinsic
+@cindex Shape intrinsic
+@cindex intrinsics, Shape
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Shape} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Short Intrinsic
+@subsubsection Short Intrinsic
+@cindex Short intrinsic
+@cindex intrinsics, Short
+
+@noindent
+@example
+Short(@var{A})
+@end example
+
+@noindent
+Short: @code{INTEGER(KIND=6)} function.
+
+@noindent
+@var{A}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=6)}.
+
+If @var{A} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disgregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+
+@end ifset
+@ifset familyF77
+@node Sign Intrinsic
+@subsubsection Sign Intrinsic
+@cindex Sign intrinsic
+@cindex intrinsics, Sign
+
+@noindent
+@example
+Sign(@var{A}, @var{B})
+@end example
+
+@noindent
+Sign: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{A}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{B}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{ABS(@var{A})*@var{s}}, where
+@var{s} is +1 if @samp{@var{B}.GE.0},
+-1 otherwise.
+
+@xref{Abs Intrinsic}, for the function that returns
+the magnitude of a value.
+
+@end ifset
+@ifset familyF2U
+@node Signal Intrinsic (subroutine)
+@subsubsection Signal Intrinsic (subroutine)
+@cindex Signal intrinsic
+@cindex intrinsics, Signal
+
+@noindent
+@example
+CALL Signal(@var{Number}, @var{Handler}, @var{Status})
+@end example
+
+@noindent
+@var{Number}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+or dummy/global @code{INTEGER(KIND=1)} scalar.
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+If @var{Handler} is a an @code{EXTERNAL} routine, arranges for it to be
+invoked with a single integer argument (of system-dependent length)
+when signal @var{Number} occurs.
+If @var{Number} is an integer, it can be
+used to turn off handling of signal @var{Handler} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{Handler} will be called using C conventions, so its value in
+Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it.
+
+The value returned by @code{signal(2)} is written to @var{Status}, if
+that argument is supplied.
+Otherwise the return value is ignored.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Signal Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Signal Intrinsic (function)
+@subsubsection Signal Intrinsic (function)
+@cindex Signal intrinsic
+@cindex intrinsics, Signal
+
+@noindent
+@example
+Signal(@var{Number}, @var{Handler})
+@end example
+
+@noindent
+Signal: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Number}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+or dummy/global @code{INTEGER(KIND=1)} scalar.
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+If @var{Handler} is a an @code{EXTERNAL} routine, arranges for it to be
+invoked with a single integer argument (of system-dependent length)
+when signal @var{Number} occurs.
+If @var{Number} is an integer, it can be
+used to turn off handling of signal @var{Handler} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{Handler} will be called using C conventions, so its value in
+Fortran terms is obtained by applying @code{%LOC()} (or @var{LOC()}) to it.
+
+The value returned by @code{signal(2)} is returned.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Signal Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node Sin Intrinsic
+@subsubsection Sin Intrinsic
+@cindex Sin intrinsic
+@cindex intrinsics, Sin
+
+@noindent
+@example
+Sin(@var{X})
+@end example
+
+@noindent
+Sin: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the sine of @var{X}, an angle measured
+in radians.
+
+@xref{ASin Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node SinD Intrinsic
+@subsubsection SinD Intrinsic
+@cindex SinD intrinsic
+@cindex intrinsics, SinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL SinD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node SinH Intrinsic
+@subsubsection SinH Intrinsic
+@cindex SinH intrinsic
+@cindex intrinsics, SinH
+
+@noindent
+@example
+SinH(@var{X})
+@end example
+
+@noindent
+SinH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the hyperbolic sine of @var{X}.
+
+@end ifset
+@ifset familyF2U
+@node Sleep Intrinsic
+@subsubsection Sleep Intrinsic
+@cindex Sleep intrinsic
+@cindex intrinsics, Sleep
+
+@noindent
+@example
+CALL Sleep(@var{Seconds})
+@end example
+
+@noindent
+@var{Seconds}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Causes the process to pause for @var{Seconds} seconds.
+See @code{sleep(2)}.
+
+@end ifset
+@ifset familyF77
+@node Sngl Intrinsic
+@subsubsection Sngl Intrinsic
+@cindex Sngl intrinsic
+@cindex intrinsics, Sngl
+
+@noindent
+@example
+Sngl(@var{A})
+@end example
+
+@noindent
+Sngl: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{REAL()} that is specific
+to one type for @var{A}.
+@xref{Real Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node SnglQ Intrinsic
+@subsubsection SnglQ Intrinsic
+@cindex SnglQ intrinsic
+@cindex intrinsics, SnglQ
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL SnglQ} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Spacing Intrinsic
+@subsubsection Spacing Intrinsic
+@cindex Spacing intrinsic
+@cindex intrinsics, Spacing
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Spacing} to use this name for an
+external procedure.
+
+@node Spread Intrinsic
+@subsubsection Spread Intrinsic
+@cindex Spread intrinsic
+@cindex intrinsics, Spread
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Spread} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node SqRt Intrinsic
+@subsubsection SqRt Intrinsic
+@cindex SqRt intrinsic
+@cindex intrinsics, SqRt
+
+@noindent
+@example
+SqRt(@var{X})
+@end example
+
+@noindent
+SqRt: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the square root of @var{X}, which must
+not be negative.
+
+To calculate and represent the square root of a negative
+number, complex arithmetic must be used.
+For example, @samp{SQRT(COMPLEX(@var{X}))}.
+
+The inverse of this function is @samp{SQRT(@var{X}) * SQRT(@var{X})}.
+
+@end ifset
+@ifset familyF2U
+@node SRand Intrinsic
+@subsubsection SRand Intrinsic
+@cindex SRand intrinsic
+@cindex intrinsics, SRand
+
+@noindent
+@example
+CALL SRand(@var{Seed})
+@end example
+
+@noindent
+@var{Seed}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Reinitialises the generator with the seed in @var{Seed}.
+@xref{IRand Intrinsic}.
+@xref{Rand Intrinsic}.
+
+@node Stat Intrinsic (subroutine)
+@subsubsection Stat Intrinsic (subroutine)
+@cindex Stat intrinsic
+@cindex intrinsics, Stat
+
+@noindent
+@example
+CALL Stat(@var{File}, @var{SArray}, @var{Status})
+@end example
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the given file @var{File} and places them in the array
+@var{SArray}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Stat Intrinsic (function)}.
+
+@node Stat Intrinsic (function)
+@subsubsection Stat Intrinsic (function)
+@cindex Stat intrinsic
+@cindex intrinsics, Stat
+
+@noindent
+@example
+Stat(@var{File}, @var{SArray})
+@end example
+
+@noindent
+Stat: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the given file @var{File} and places them in the array
+@var{SArray}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+File mode
+
+@item
+Inode number
+
+@item
+ID of device containing directory entry for file
+
+@item
+Device id (if relevant)
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size
+
+@item
+Number of blocks allocated
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a non-zero error code.
+
+For information on other intrinsics with the same name:
+@xref{Stat Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Sum Intrinsic
+@subsubsection Sum Intrinsic
+@cindex Sum intrinsic
+@cindex intrinsics, Sum
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Sum} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node SymLnk Intrinsic (subroutine)
+@subsubsection SymLnk Intrinsic (subroutine)
+@cindex SymLnk intrinsic
+@cindex intrinsics, SymLnk
+
+@noindent
+@example
+CALL SymLnk(@var{Path1}, @var{Path2}, @var{Status})
+@end example
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Makes a symbolic link from file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return
+(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{SymLnk Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node SymLnk Intrinsic (function)
+@subsubsection SymLnk Intrinsic (function)
+@cindex SymLnk intrinsic
+@cindex intrinsics, SymLnk
+
+@noindent
+@example
+SymLnk(@var{Path1}, @var{Path2})
+@end example
+
+@noindent
+SymLnk: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Makes a symbolic link from file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+Returns 0 on success or a non-zero error code
+(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{SymLnk Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node System Intrinsic (subroutine)
+@subsubsection System Intrinsic (subroutine)
+@cindex System intrinsic
+@cindex intrinsics, System
+
+@noindent
+@example
+CALL System(@var{Command}, @var{Status})
+@end example
+
+@noindent
+@var{Command}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Passes the command @var{Command} to a shell (see @code{system(3)}).
+If argument @var{Status} is present, it contains the value returned by
+@code{system(3)}, presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{System Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node System Intrinsic (function)
+@subsubsection System Intrinsic (function)
+@cindex System intrinsic
+@cindex intrinsics, System
+
+@noindent
+@example
+System(@var{Command})
+@end example
+
+@noindent
+System: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Command}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Passes the command @var{Command} to a shell (see @code{system(3)}).
+Returns the value returned by
+@code{system(3)}, presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+However, the function form can be valid in cases where the
+actual side effects performed by the call are unimportant to
+the application.
+
+For example, on a UNIX system, @samp{SAME = SYSTEM('cmp a b')}
+does not perform any side effects likely to be important to the
+program, so the programmer would not care if the actual system
+call (and invocation of @code{cmp}) was optimized away in a situation
+where the return value could be determined otherwise, or was not
+actually needed (@samp{SAME} not actually referenced after the
+sample assignment statement).
+
+For information on other intrinsics with the same name:
+@xref{System Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node System_Clock Intrinsic
+@subsubsection System_Clock Intrinsic
+@cindex System_Clock intrinsic
+@cindex intrinsics, System_Clock
+
+@noindent
+@example
+CALL System_Clock(@var{Count}, @var{Rate}, @var{Max})
+@end example
+
+@noindent
+@var{Count}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{Rate}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{Max}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns in @var{Count} the current value of the system clock; this is
+the value returned by the UNIX function @code{times(2)}
+in this implementation, but
+isn't in general.
+@var{Rate} is the number of clock ticks per second and
+@var{Max} is the maximum value this can take, which isn't very useful
+in this implementation since it's just the maximum C @code{unsigned
+int} value.
+
+@end ifset
+@ifset familyF77
+@node Tan Intrinsic
+@subsubsection Tan Intrinsic
+@cindex Tan intrinsic
+@cindex intrinsics, Tan
+
+@noindent
+@example
+Tan(@var{X})
+@end example
+
+@noindent
+Tan: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the tangent of @var{X}, an angle measured
+in radians.
+
+@xref{ATan Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node TanD Intrinsic
+@subsubsection TanD Intrinsic
+@cindex TanD intrinsic
+@cindex intrinsics, TanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL TanD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node TanH Intrinsic
+@subsubsection TanH Intrinsic
+@cindex TanH intrinsic
+@cindex intrinsics, TanH
+
+@noindent
+@example
+TanH(@var{X})
+@end example
+
+@noindent
+TanH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the hyperbolic tangent of @var{X}.
+
+@end ifset
+@ifset familyF2U
+@node Time Intrinsic (UNIX)
+@subsubsection Time Intrinsic (UNIX)
+@cindex Time intrinsic
+@cindex intrinsics, Time
+
+@noindent
+@example
+Time()
+@end example
+
+@noindent
+Time: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current time encoded as an integer
+(in the manner of the UNIX function @code{time(3)}).
+This value is suitable for passing to @code{CTIME},
+@code{GMTIME}, and @code{LTIME}.
+
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+@xref{Time8 Intrinsic}, for information on a
+similar intrinsic that might be portable to more
+GNU Fortran implementations, though to fewer
+Fortran compilers.
+
+For information on other intrinsics with the same name:
+@xref{Time Intrinsic (VXT)}.
+
+@end ifset
+@ifset familyVXT
+@node Time Intrinsic (VXT)
+@subsubsection Time Intrinsic (VXT)
+@cindex Time intrinsic
+@cindex intrinsics, Time
+
+@noindent
+@example
+CALL Time(@var{Time})
+@end example
+
+@noindent
+@var{Time}: @code{CHARACTER*8}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Returns in @var{Time} a character representation of the current time as
+obtained from @code{ctime(3)}.
+
+@xref{Fdate Intrinsic (subroutine)} for an equivalent routine.
+
+For information on other intrinsics with the same name:
+@xref{Time Intrinsic (UNIX)}.
+
+@end ifset
+@ifset familyF2U
+@node Time8 Intrinsic
+@subsubsection Time8 Intrinsic
+@cindex Time8 intrinsic
+@cindex intrinsics, Time8
+
+@noindent
+@example
+Time8()
+@end example
+
+@noindent
+Time8: @code{INTEGER(KIND=2)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current time encoded as a long integer
+(in the manner of the UNIX function @code{time(3)}).
+This value is suitable for passing to @code{CTIME},
+@code{GMTIME}, and @code{LTIME}.
+
+No Fortran implementations other than GNU Fortran are
+known to support this intrinsic at the time of this
+writing.
+@xref{Time Intrinsic (UNIX)}, for information on a
+similar intrinsic that might be portable to more Fortran
+compilers, though to fewer GNU Fortran implementations.
+
+@end ifset
+@ifset familyF90
+@node Tiny Intrinsic
+@subsubsection Tiny Intrinsic
+@cindex Tiny intrinsic
+@cindex intrinsics, Tiny
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Tiny} to use this name for an
+external procedure.
+
+@node Transfer Intrinsic
+@subsubsection Transfer Intrinsic
+@cindex Transfer intrinsic
+@cindex intrinsics, Transfer
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Transfer} to use this name for an
+external procedure.
+
+@node Transpose Intrinsic
+@subsubsection Transpose Intrinsic
+@cindex Transpose intrinsic
+@cindex intrinsics, Transpose
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Transpose} to use this name for an
+external procedure.
+
+@node Trim Intrinsic
+@subsubsection Trim Intrinsic
+@cindex Trim intrinsic
+@cindex intrinsics, Trim
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Trim} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node TtyNam Intrinsic (subroutine)
+@subsubsection TtyNam Intrinsic (subroutine)
+@cindex TtyNam intrinsic
+@cindex intrinsics, TtyNam
+
+@noindent
+@example
+CALL TtyNam(@var{Name}, @var{Unit})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Name} to the name of the terminal device open on logical unit
+@var{Unit} or a blank string if @var{Unit} is not connected to a
+terminal.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{TtyNam Intrinsic (function)}.
+
+@node TtyNam Intrinsic (function)
+@subsubsection TtyNam Intrinsic (function)
+@cindex TtyNam intrinsic
+@cindex intrinsics, TtyNam
+
+@noindent
+@example
+TtyNam(@var{Unit})
+@end example
+
+@noindent
+TtyNam: @code{CHARACTER*(*)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the name of the terminal device open on logical unit
+@var{Unit} or a blank string if @var{Unit} is not connected to a
+terminal.
+
+For information on other intrinsics with the same name:
+@xref{TtyNam Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node UBound Intrinsic
+@subsubsection UBound Intrinsic
+@cindex UBound intrinsic
+@cindex intrinsics, UBound
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL UBound} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node UMask Intrinsic (subroutine)
+@subsubsection UMask Intrinsic (subroutine)
+@cindex UMask intrinsic
+@cindex intrinsics, UMask
+
+@noindent
+@example
+CALL UMask(@var{Mask}, @var{Old})
+@end example
+
+@noindent
+@var{Mask}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Old}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets the file creation mask to @var{Mask} and returns the old value in
+argument @var{Old} if it is supplied.
+See @code{umask(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{UMask Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node UMask Intrinsic (function)
+@subsubsection UMask Intrinsic (function)
+@cindex UMask intrinsic
+@cindex intrinsics, UMask
+
+@noindent
+@example
+UMask(@var{Mask})
+@end example
+
+@noindent
+UMask: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Mask}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Sets the file creation mask to @var{Mask} and returns the old value.
+See @code{umask(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{UMask Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node Unlink Intrinsic (subroutine)
+@subsubsection Unlink Intrinsic (subroutine)
+@cindex Unlink intrinsic
+@cindex intrinsics, Unlink
+
+@noindent
+@example
+CALL Unlink(@var{File}, @var{Status})
+@end example
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Unlink the file @var{File}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+If the @var{Status} argument is supplied, it contains
+0 on success or a non-zero error code upon return.
+See @code{unlink(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Unlink Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Unlink Intrinsic (function)
+@subsubsection Unlink Intrinsic (function)
+@cindex Unlink intrinsic
+@cindex intrinsics, Unlink
+
+@noindent
+@example
+Unlink(@var{File})
+@end example
+
+@noindent
+Unlink: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Unlink the file @var{File}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+Returns 0 on success or a non-zero error code.
+See @code{unlink(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Unlink Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Unpack Intrinsic
+@subsubsection Unpack Intrinsic
+@cindex Unpack intrinsic
+@cindex intrinsics, Unpack
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Unpack} to use this name for an
+external procedure.
+
+@node Verify Intrinsic
+@subsubsection Verify Intrinsic
+@cindex Verify intrinsic
+@cindex intrinsics, Verify
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Verify} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2C
+@node XOr Intrinsic
+@subsubsection XOr Intrinsic
+@cindex XOr intrinsic
+@cindex intrinsics, XOr
+
+@noindent
+@example
+XOr(@var{I}, @var{J})
+@end example
+
+@noindent
+XOr: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean exclusive-OR of
+pair of bits in each of @var{I} and @var{J}.
+
+@node ZAbs Intrinsic
+@subsubsection ZAbs Intrinsic
+@cindex ZAbs intrinsic
+@cindex intrinsics, ZAbs
+
+@noindent
+@example
+ZAbs(@var{A})
+@end example
+
+@noindent
+ZAbs: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@node ZCos Intrinsic
+@subsubsection ZCos Intrinsic
+@cindex ZCos intrinsic
+@cindex intrinsics, ZCos
+
+@noindent
+@example
+ZCos(@var{X})
+@end example
+
+@noindent
+ZCos: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{COS()} that is specific
+to one type for @var{X}.
+@xref{Cos Intrinsic}.
+
+@node ZExp Intrinsic
+@subsubsection ZExp Intrinsic
+@cindex ZExp intrinsic
+@cindex intrinsics, ZExp
+
+@noindent
+@example
+ZExp(@var{X})
+@end example
+
+@noindent
+ZExp: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{EXP()} that is specific
+to one type for @var{X}.
+@xref{Exp Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node ZExt Intrinsic
+@subsubsection ZExt Intrinsic
+@cindex ZExt intrinsic
+@cindex intrinsics, ZExt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ZExt} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2C
+@node ZLog Intrinsic
+@subsubsection ZLog Intrinsic
+@cindex ZLog intrinsic
+@cindex intrinsics, ZLog
+
+@noindent
+@example
+ZLog(@var{X})
+@end example
+
+@noindent
+ZLog: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node ZSin Intrinsic
+@subsubsection ZSin Intrinsic
+@cindex ZSin intrinsic
+@cindex intrinsics, ZSin
+
+@noindent
+@example
+ZSin(@var{X})
+@end example
+
+@noindent
+ZSin: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{SIN()} that is specific
+to one type for @var{X}.
+@xref{Sin Intrinsic}.
+
+@node ZSqRt Intrinsic
+@subsubsection ZSqRt Intrinsic
+@cindex ZSqRt intrinsic
+@cindex intrinsics, ZSqRt
+
+@noindent
+@example
+ZSqRt(@var{X})
+@end example
+
+@noindent
+ZSqRt: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{SQRT()} that is specific
+to one type for @var{X}.
+@xref{SqRt Intrinsic}.
+
+@end ifset
diff --git a/gcc/f/intrin.c b/gcc/f/intrin.c
new file mode 100644
index 00000000000..16f36fbdb3c
--- /dev/null
+++ b/gcc/f/intrin.c
@@ -0,0 +1,2047 @@
+/* intrin.c -- Recognize references to intrinsics
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+*/
+
+#include "proj.h"
+#include <ctype.h>
+#include "intrin.h"
+#include "expr.h"
+#include "info.h"
+#include "src.h"
+#include "symbol.h"
+#include "target.h"
+#include "top.h"
+
+struct _ffeintrin_name_
+ {
+ char *name_uc;
+ char *name_lc;
+ char *name_ic;
+ ffeintrinGen generic;
+ ffeintrinSpec specific;
+ };
+
+struct _ffeintrin_gen_
+ {
+ char *name; /* Name as seen in program. */
+ ffeintrinSpec specs[2];
+ };
+
+struct _ffeintrin_spec_
+ {
+ char *name; /* Uppercase name as seen in source code,
+ lowercase if no source name, "none" if no
+ name at all (NONE case). */
+ bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */
+ ffeintrinFamily family;
+ ffeintrinImp implementation;
+ };
+
+struct _ffeintrin_imp_
+ {
+ char *name; /* Name of implementation. */
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffecomGfrt gfrt_direct; /* library routine, direct-callable form. */
+ ffecomGfrt gfrt_f2c; /* library routine, f2c-callable form. */
+ ffecomGfrt gfrt_gnu; /* library routine, gnu-callable form. */
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+ char *control;
+ };
+
+static ffebad ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
+ ffebld args, ffeinfoBasictype *xbt,
+ ffeinfoKindtype *xkt,
+ ffetargetCharacterSize *xsz,
+ bool *check_intrin,
+ ffelexToken t,
+ bool commit);
+static bool ffeintrin_check_any_ (ffebld arglist);
+static int ffeintrin_cmp_name_ (const void *name, const void *intrinsic);
+
+static struct _ffeintrin_name_ ffeintrin_names_[]
+=
+{ /* Alpha order. */
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
+ { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static struct _ffeintrin_gen_ ffeintrin_gens_[]
+=
+{
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
+ { NAME, { SPEC1, SPEC2, }, },
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static struct _ffeintrin_imp_ ffeintrin_imps_[]
+=
+{
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+ { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
+ FFECOM_gfrt ## GFRTGNU, CONTROL },
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+ { NAME, CONTROL },
+#else
+#error
+#endif
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+static struct _ffeintrin_spec_ ffeintrin_specs_[]
+=
+{
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
+ { NAME, CALLABLE, FAMILY, IMP, },
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#include "intrin.def"
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+};
+
+
+static ffebad
+ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
+ ffebld args, ffeinfoBasictype *xbt,
+ ffeinfoKindtype *xkt,
+ ffetargetCharacterSize *xsz,
+ bool *check_intrin,
+ ffelexToken t,
+ bool commit)
+{
+ char *c = ffeintrin_imps_[imp].control;
+ bool subr = (c[0] == '-');
+ char *argc;
+ ffebld arg;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
+ ffeinfoKindtype firstarg_kt;
+ bool need_col;
+ ffeinfoBasictype col_bt = FFEINFO_basictypeNONE;
+ ffeinfoKindtype col_kt = FFEINFO_kindtypeNONE;
+ int colon = (c[2] == ':') ? 2 : 3;
+ int argno;
+
+ /* Check procedure type (function vs. subroutine) against
+ invocation. */
+
+ if (op == FFEBLD_opSUBRREF)
+ {
+ if (!subr)
+ return FFEBAD_INTRINSIC_IS_FUNC;
+ }
+ else if (op == FFEBLD_opFUNCREF)
+ {
+ if (subr)
+ return FFEBAD_INTRINSIC_IS_SUBR;
+ }
+ else
+ return FFEBAD_INTRINSIC_REF;
+
+ /* Check the arglist for validity. */
+
+ if ((args != NULL)
+ && (ffebld_head (args) != NULL))
+ firstarg_kt = ffeinfo_kindtype (ffebld_info (ffebld_head (args)));
+ else
+ firstarg_kt = FFEINFO_kindtype;
+
+ for (argc = &c[colon + 3],
+ arg = args;
+ *argc != '\0';
+ )
+ {
+ char optional = '\0';
+ char required = '\0';
+ char extra = '\0';
+ char basic;
+ char kind;
+ int length;
+ int elements;
+ bool lastarg_complex = FALSE;
+
+ /* We don't do anything with keywords yet. */
+ do
+ {
+ } while (*(++argc) != '=');
+
+ ++argc;
+ if ((*argc == '?')
+ || (*argc == '!')
+ || (*argc == '*'))
+ optional = *(argc++);
+ if ((*argc == '+')
+ || (*argc == 'n')
+ || (*argc == 'p'))
+ required = *(argc++);
+ basic = *(argc++);
+ kind = *(argc++);
+ if (*argc == '[')
+ {
+ length = *++argc - '0';
+ if (*++argc != ']')
+ length = 10 * length + (*(argc++) - '0');
+ ++argc;
+ }
+ else
+ length = -1;
+ if (*argc == '(')
+ {
+ elements = *++argc - '0';
+ if (*++argc != ')')
+ elements = 10 * elements + (*(argc++) - '0');
+ ++argc;
+ }
+ else if (*argc == '&')
+ {
+ elements = -1;
+ ++argc;
+ }
+ else
+ elements = 0;
+ if ((*argc == '&')
+ || (*argc == 'i')
+ || (*argc == 'w')
+ || (*argc == 'x'))
+ extra = *(argc++);
+ if (*argc == ',')
+ ++argc;
+
+ /* Break out of this loop only when current arg spec completely
+ processed. */
+
+ do
+ {
+ bool okay;
+ ffebld a;
+ ffeinfo i;
+ bool anynum;
+ ffeinfoBasictype abt = FFEINFO_basictypeNONE;
+ ffeinfoKindtype akt = FFEINFO_kindtypeNONE;
+
+ if ((arg == NULL)
+ || (ffebld_head (arg) == NULL))
+ {
+ if (required != '\0')
+ return FFEBAD_INTRINSIC_TOOFEW;
+ if (optional == '\0')
+ return FFEBAD_INTRINSIC_TOOFEW;
+ if (arg != NULL)
+ arg = ffebld_trail (arg);
+ break; /* Try next argspec. */
+ }
+
+ a = ffebld_head (arg);
+ i = ffebld_info (a);
+ anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
+
+ /* See how well the arg matches up to the spec. */
+
+ switch (basic)
+ {
+ case 'A':
+ okay = (ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER)
+ && ((length == -1)
+ || (ffeinfo_size (i) == (ffetargetCharacterSize) length));
+ break;
+
+ case 'C':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
+ abt = FFEINFO_basictypeCOMPLEX;
+ break;
+
+ case 'I':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);
+ abt = FFEINFO_basictypeINTEGER;
+ break;
+
+ case 'L':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
+ abt = FFEINFO_basictypeLOGICAL;
+ break;
+
+ case 'R':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+ abt = FFEINFO_basictypeREAL;
+ break;
+
+ case 'B':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
+ break;
+
+ case 'F':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+ break;
+
+ case 'N':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+ break;
+
+ case 'S':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+ break;
+
+ case 'g':
+ okay = ((ffebld_op (a) == FFEBLD_opLABTER)
+ || (ffebld_op (a) == FFEBLD_opLABTOK));
+ elements = -1;
+ extra = '-';
+ break;
+
+ case 's':
+ okay = (((((ffeinfo_basictype (i) == FFEINFO_basictypeNONE)
+ && (ffeinfo_kindtype (i) == FFEINFO_kindtypeNONE)
+ && (ffeinfo_kind (i) == FFEINFO_kindSUBROUTINE))
+ || ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ && (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGERDEFAULT)
+ && (ffeinfo_kind (i) == FFEINFO_kindFUNCTION))
+ || (ffeinfo_kind (i) == FFEINFO_kindNONE))
+ && ((ffeinfo_where (i) == FFEINFO_whereDUMMY)
+ || (ffeinfo_where (i) == FFEINFO_whereGLOBAL)))
+ || ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ && (ffeinfo_kind (i) == FFEINFO_kindENTITY)));
+ elements = -1;
+ extra = '-';
+ break;
+
+ case '-':
+ default:
+ okay = TRUE;
+ break;
+ }
+
+ switch (kind)
+ {
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ akt = (kind - '0');
+ if ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL))
+ {
+ switch (akt)
+ { /* Translate to internal kinds for now! */
+ default:
+ break;
+
+ case 2:
+ akt = 4;
+ break;
+
+ case 3:
+ akt = 2;
+ break;
+
+ case 4:
+ akt = 5;
+ break;
+
+ case 6:
+ akt = 3;
+ break;
+ }
+ }
+ okay &= anynum || (ffeinfo_kindtype (i) == akt);
+ break;
+
+ case 'A':
+ okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);
+ akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE
+ : firstarg_kt;
+ break;
+
+ case '*':
+ default:
+ break;
+ }
+
+ switch (elements)
+ {
+ ffebld b;
+
+ case -1:
+ break;
+
+ case 0:
+ if (ffeinfo_rank (i) != 0)
+ okay = FALSE;
+ break;
+
+ default:
+ if ((ffeinfo_rank (i) != 1)
+ || (ffebld_op (a) != FFEBLD_opSYMTER)
+ || ((b = ffesymbol_arraysize (ffebld_symter (a))) == NULL)
+ || (ffebld_op (b) != FFEBLD_opCONTER)
+ || (ffeinfo_basictype (ffebld_info (b)) != FFEINFO_basictypeINTEGER)
+ || (ffeinfo_kindtype (ffebld_info (b)) != FFEINFO_kindtypeINTEGERDEFAULT)
+ || (ffebld_constant_integer1 (ffebld_conter (b)) != elements))
+ okay = FALSE;
+ break;
+ }
+
+ switch (extra)
+ {
+ case '&':
+ if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
+ || ((ffebld_op (a) != FFEBLD_opSYMTER)
+ && (ffebld_op (a) != FFEBLD_opSUBSTR)
+ && (ffebld_op (a) != FFEBLD_opARRAYREF)))
+ okay = FALSE;
+ break;
+
+ case 'w':
+ case 'x':
+ if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
+ || ((ffebld_op (a) != FFEBLD_opSYMTER)
+ && (ffebld_op (a) != FFEBLD_opARRAYREF)
+ && (ffebld_op (a) != FFEBLD_opSUBSTR)))
+ okay = FALSE;
+ break;
+
+ case '-':
+ case 'i':
+ break;
+
+ default:
+ if (ffeinfo_kind (i) != FFEINFO_kindENTITY)
+ okay = FALSE;
+ break;
+ }
+
+ if ((optional == '!')
+ && lastarg_complex)
+ okay = FALSE;
+
+ if (!okay)
+ {
+ /* If it wasn't optional, it's an error,
+ else maybe it could match a later argspec. */
+ if (optional == '\0')
+ return FFEBAD_INTRINSIC_REF;
+ break; /* Try next argspec. */
+ }
+
+ lastarg_complex
+ = (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
+
+ if (anynum)
+ {
+ /* If we know dummy arg type, convert to that now. */
+
+ if ((abt != FFEINFO_basictypeNONE)
+ && (akt != FFEINFO_kindtypeNONE)
+ && commit)
+ {
+ /* We have a known type, convert hollerith/typeless
+ to it. */
+
+ a = ffeexpr_convert (a, t, NULL,
+ abt, akt, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ ffebld_set_head (arg, a);
+ }
+ }
+
+ arg = ffebld_trail (arg); /* Arg accepted, now move on. */
+
+ if (optional == '*')
+ continue; /* Go ahead and try another arg. */
+ if (required == '\0')
+ break;
+ if ((required == 'n')
+ || (required == '+'))
+ {
+ optional = '*';
+ required = '\0';
+ }
+ else if (required == 'p')
+ required = 'n';
+ } while (TRUE);
+ }
+
+ /* Ignore explicit trailing omitted args. */
+
+ while ((arg != NULL) && (ffebld_head (arg) == NULL))
+ arg = ffebld_trail (arg);
+
+ if (arg != NULL)
+ return FFEBAD_INTRINSIC_TOOMANY;
+
+ /* Set up the initial type for the return value of the function. */
+
+ need_col = FALSE;
+ switch (c[0])
+ {
+ case 'A':
+ bt = FFEINFO_basictypeCHARACTER;
+ sz = (c[2] == '*') ? FFETARGET_charactersizeNONE : 1;
+ break;
+
+ case 'C':
+ bt = FFEINFO_basictypeCOMPLEX;
+ break;
+
+ case 'I':
+ bt = FFEINFO_basictypeINTEGER;
+ break;
+
+ case 'L':
+ bt = FFEINFO_basictypeLOGICAL;
+ break;
+
+ case 'R':
+ bt = FFEINFO_basictypeREAL;
+ break;
+
+ case 'B':
+ case 'F':
+ case 'N':
+ case 'S':
+ need_col = TRUE;
+ /* Fall through. */
+ case '-':
+ default:
+ bt = FFEINFO_basictypeNONE;
+ break;
+ }
+
+ switch (c[1])
+ {
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ kt = (c[1] - '0');
+ if ((bt == FFEINFO_basictypeINTEGER)
+ || (bt == FFEINFO_basictypeLOGICAL))
+ {
+ switch (kt)
+ { /* Translate to internal kinds for now! */
+ default:
+ break;
+
+ case 2:
+ kt = 4;
+ break;
+
+ case 3:
+ kt = 2;
+ break;
+
+ case 4:
+ kt = 5;
+ break;
+
+ case 6:
+ kt = 3;
+ break;
+ }
+ }
+ break;
+
+ case 'C':
+ if (ffe_is_90 ())
+ need_col = TRUE;
+ kt = 1;
+ break;
+
+ case 'p':
+ kt = ffecom_pointer_kind ();
+ break;
+
+ case '=':
+ need_col = TRUE;
+ /* Fall through. */
+ case '-':
+ default:
+ kt = FFEINFO_kindtypeNONE;
+ break;
+ }
+
+ /* Determine collective type of COL, if there is one. */
+
+ if (need_col || c[colon + 1] != '-')
+ {
+ bool okay = TRUE;
+ bool have_anynum = FALSE;
+
+ for (arg = args;
+ arg != NULL;
+ arg = (c[colon + 1] == '*') ? ffebld_trail (arg) : NULL)
+ {
+ ffebld a = ffebld_head (arg);
+ ffeinfo i;
+ bool anynum;
+
+ if (a == NULL)
+ continue;
+ i = ffebld_info (a);
+
+ anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
+ if (anynum)
+ {
+ have_anynum = TRUE;
+ continue;
+ }
+
+ if ((col_bt == FFEINFO_basictypeNONE)
+ && (col_kt == FFEINFO_kindtypeNONE))
+ {
+ col_bt = ffeinfo_basictype (i);
+ col_kt = ffeinfo_kindtype (i);
+ }
+ else
+ {
+ ffeexpr_type_combine (&col_bt, &col_kt,
+ col_bt, col_kt,
+ ffeinfo_basictype (i),
+ ffeinfo_kindtype (i),
+ NULL);
+ if ((col_bt == FFEINFO_basictypeNONE)
+ || (col_kt == FFEINFO_kindtypeNONE))
+ return FFEBAD_INTRINSIC_REF;
+ }
+ }
+
+ if (have_anynum
+ && ((col_bt == FFEINFO_basictypeNONE)
+ || (col_kt == FFEINFO_kindtypeNONE)))
+ {
+ /* No type, but have hollerith/typeless. Use type of return
+ value to determine type of COL. */
+
+ switch (c[0])
+ {
+ case 'A':
+ return FFEBAD_INTRINSIC_REF;
+
+ case 'B':
+ case 'I':
+ case 'L':
+ if ((col_bt != FFEINFO_basictypeNONE)
+ && (col_bt != FFEINFO_basictypeINTEGER))
+ return FFEBAD_INTRINSIC_REF;
+ /* Fall through. */
+ case 'N':
+ case 'S':
+ case '-':
+ default:
+ col_bt = FFEINFO_basictypeINTEGER;
+ col_kt = FFEINFO_kindtypeINTEGER1;
+ break;
+
+ case 'C':
+ if ((col_bt != FFEINFO_basictypeNONE)
+ && (col_bt != FFEINFO_basictypeCOMPLEX))
+ return FFEBAD_INTRINSIC_REF;
+ col_bt = FFEINFO_basictypeCOMPLEX;
+ col_kt = FFEINFO_kindtypeREAL1;
+ break;
+
+ case 'R':
+ if ((col_bt != FFEINFO_basictypeNONE)
+ && (col_bt != FFEINFO_basictypeREAL))
+ return FFEBAD_INTRINSIC_REF;
+ /* Fall through. */
+ case 'F':
+ col_bt = FFEINFO_basictypeREAL;
+ col_kt = FFEINFO_kindtypeREAL1;
+ break;
+ }
+ }
+
+ switch (c[0])
+ {
+ case 'B':
+ okay = (col_bt == FFEINFO_basictypeINTEGER)
+ || (col_bt == FFEINFO_basictypeLOGICAL);
+ if (need_col)
+ bt = col_bt;
+ break;
+
+ case 'F':
+ okay = (col_bt == FFEINFO_basictypeCOMPLEX)
+ || (col_bt == FFEINFO_basictypeREAL);
+ if (need_col)
+ bt = col_bt;
+ break;
+
+ case 'N':
+ okay = (col_bt == FFEINFO_basictypeCOMPLEX)
+ || (col_bt == FFEINFO_basictypeINTEGER)
+ || (col_bt == FFEINFO_basictypeREAL);
+ if (need_col)
+ bt = col_bt;
+ break;
+
+ case 'S':
+ okay = (col_bt == FFEINFO_basictypeINTEGER)
+ || (col_bt == FFEINFO_basictypeREAL)
+ || (col_bt == FFEINFO_basictypeCOMPLEX);
+ if (need_col)
+ bt = ((col_bt != FFEINFO_basictypeCOMPLEX) ? col_bt
+ : FFEINFO_basictypeREAL);
+ break;
+ }
+
+ switch (c[1])
+ {
+ case '=':
+ if (need_col)
+ kt = col_kt;
+ break;
+
+ case 'C':
+ if (col_bt == FFEINFO_basictypeCOMPLEX)
+ {
+ if (col_kt != FFEINFO_kindtypeREALDEFAULT)
+ *check_intrin = TRUE;
+ if (need_col)
+ kt = col_kt;
+ }
+ break;
+ }
+
+ if (!okay)
+ return FFEBAD_INTRINSIC_REF;
+ }
+
+ /* Now, convert args in the arglist to the final type of the COL. */
+
+ for (argno = 0, argc = &c[colon + 3],
+ arg = args;
+ *argc != '\0';
+ ++argno)
+ {
+ char optional = '\0';
+ char required = '\0';
+ char extra = '\0';
+ char basic;
+ char kind;
+ int length;
+ int elements;
+ bool lastarg_complex = FALSE;
+
+ /* We don't do anything with keywords yet. */
+ do
+ {
+ } while (*(++argc) != '=');
+
+ ++argc;
+ if ((*argc == '?')
+ || (*argc == '!')
+ || (*argc == '*'))
+ optional = *(argc++);
+ if ((*argc == '+')
+ || (*argc == 'n')
+ || (*argc == 'p'))
+ required = *(argc++);
+ basic = *(argc++);
+ kind = *(argc++);
+ if (*argc == '[')
+ {
+ length = *++argc - '0';
+ if (*++argc != ']')
+ length = 10 * length + (*(argc++) - '0');
+ ++argc;
+ }
+ else
+ length = -1;
+ if (*argc == '(')
+ {
+ elements = *++argc - '0';
+ if (*++argc != ')')
+ elements = 10 * elements + (*(argc++) - '0');
+ ++argc;
+ }
+ else if (*argc == '&')
+ {
+ elements = -1;
+ ++argc;
+ }
+ else
+ elements = 0;
+ if ((*argc == '&')
+ || (*argc == 'i')
+ || (*argc == 'w')
+ || (*argc == 'x'))
+ extra = *(argc++);
+ if (*argc == ',')
+ ++argc;
+
+ /* Break out of this loop only when current arg spec completely
+ processed. */
+
+ do
+ {
+ bool okay;
+ ffebld a;
+ ffeinfo i;
+ bool anynum;
+ ffeinfoBasictype abt = FFEINFO_basictypeNONE;
+ ffeinfoKindtype akt = FFEINFO_kindtypeNONE;
+
+ if ((arg == NULL)
+ || (ffebld_head (arg) == NULL))
+ {
+ if (arg != NULL)
+ arg = ffebld_trail (arg);
+ break; /* Try next argspec. */
+ }
+
+ a = ffebld_head (arg);
+ i = ffebld_info (a);
+ anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
+
+ /* Determine what the default type for anynum would be. */
+
+ if (anynum)
+ {
+ switch (c[colon + 1])
+ {
+ case '-':
+ break;
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ if (argno != (c[colon + 1] - '0'))
+ break;
+ case '*':
+ abt = col_bt;
+ akt = col_kt;
+ break;
+ }
+ }
+
+ /* Again, match arg up to the spec. We go through all of
+ this again to properly follow the contour of optional
+ arguments. Probably this level of flexibility is not
+ needed, perhaps it's even downright naughty. */
+
+ switch (basic)
+ {
+ case 'A':
+ okay = (ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER)
+ && ((length == -1)
+ || (ffeinfo_size (i) == (ffetargetCharacterSize) length));
+ break;
+
+ case 'C':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
+ abt = FFEINFO_basictypeCOMPLEX;
+ break;
+
+ case 'I':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);
+ abt = FFEINFO_basictypeINTEGER;
+ break;
+
+ case 'L':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
+ abt = FFEINFO_basictypeLOGICAL;
+ break;
+
+ case 'R':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+ abt = FFEINFO_basictypeREAL;
+ break;
+
+ case 'B':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
+ break;
+
+ case 'F':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+ break;
+
+ case 'N':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+ break;
+
+ case 'S':
+ okay = anynum
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+ break;
+
+ case 'g':
+ okay = ((ffebld_op (a) == FFEBLD_opLABTER)
+ || (ffebld_op (a) == FFEBLD_opLABTOK));
+ elements = -1;
+ extra = '-';
+ break;
+
+ case 's':
+ okay = (((((ffeinfo_basictype (i) == FFEINFO_basictypeNONE)
+ && (ffeinfo_kindtype (i) == FFEINFO_kindtypeNONE)
+ && (ffeinfo_kind (i) == FFEINFO_kindSUBROUTINE))
+ || ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ && (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGERDEFAULT)
+ && (ffeinfo_kind (i) == FFEINFO_kindFUNCTION))
+ || (ffeinfo_kind (i) == FFEINFO_kindNONE))
+ && ((ffeinfo_where (i) == FFEINFO_whereDUMMY)
+ || (ffeinfo_where (i) == FFEINFO_whereGLOBAL)))
+ || ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ && (ffeinfo_kind (i) == FFEINFO_kindENTITY)));
+ elements = -1;
+ extra = '-';
+ break;
+
+ case '-':
+ default:
+ okay = TRUE;
+ break;
+ }
+
+ switch (kind)
+ {
+ case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9':
+ akt = (kind - '0');
+ if ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+ || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL))
+ {
+ switch (akt)
+ { /* Translate to internal kinds for now! */
+ default:
+ break;
+
+ case 2:
+ akt = 4;
+ break;
+
+ case 3:
+ akt = 2;
+ break;
+
+ case 4:
+ akt = 5;
+ break;
+
+ case 6:
+ akt = 3;
+ break;
+ }
+ }
+ okay &= anynum || (ffeinfo_kindtype (i) == akt);
+ break;
+
+ case 'A':
+ okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);
+ akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE
+ : firstarg_kt;
+ break;
+
+ case '*':
+ default:
+ break;
+ }
+
+ switch (elements)
+ {
+ ffebld b;
+
+ case -1:
+ break;
+
+ case 0:
+ if (ffeinfo_rank (i) != 0)
+ okay = FALSE;
+ break;
+
+ default:
+ if ((ffeinfo_rank (i) != 1)
+ || (ffebld_op (a) != FFEBLD_opSYMTER)
+ || ((b = ffesymbol_arraysize (ffebld_symter (a))) == NULL)
+ || (ffebld_op (b) != FFEBLD_opCONTER)
+ || (ffeinfo_basictype (ffebld_info (b)) != FFEINFO_basictypeINTEGER)
+ || (ffeinfo_kindtype (ffebld_info (b)) != FFEINFO_kindtypeINTEGERDEFAULT)
+ || (ffebld_constant_integer1 (ffebld_conter (b)) != elements))
+ okay = FALSE;
+ break;
+ }
+
+ switch (extra)
+ {
+ case '&':
+ if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
+ || ((ffebld_op (a) != FFEBLD_opSYMTER)
+ && (ffebld_op (a) != FFEBLD_opSUBSTR)
+ && (ffebld_op (a) != FFEBLD_opARRAYREF)))
+ okay = FALSE;
+ break;
+
+ case 'w':
+ case 'x':
+ if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
+ || ((ffebld_op (a) != FFEBLD_opSYMTER)
+ && (ffebld_op (a) != FFEBLD_opARRAYREF)
+ && (ffebld_op (a) != FFEBLD_opSUBSTR)))
+ okay = FALSE;
+ break;
+
+ case '-':
+ case 'i':
+ break;
+
+ default:
+ if (ffeinfo_kind (i) != FFEINFO_kindENTITY)
+ okay = FALSE;
+ break;
+ }
+
+ if ((optional == '!')
+ && lastarg_complex)
+ okay = FALSE;
+
+ if (!okay)
+ {
+ /* If it wasn't optional, it's an error,
+ else maybe it could match a later argspec. */
+ if (optional == '\0')
+ return FFEBAD_INTRINSIC_REF;
+ break; /* Try next argspec. */
+ }
+
+ lastarg_complex
+ = (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
+
+ if (anynum && commit)
+ {
+ /* If we know dummy arg type, convert to that now. */
+
+ if (abt == FFEINFO_basictypeNONE)
+ abt = FFEINFO_basictypeINTEGER;
+ if (akt == FFEINFO_kindtypeNONE)
+ akt = FFEINFO_kindtypeINTEGER1;
+
+ /* We have a known type, convert hollerith/typeless to it. */
+
+ a = ffeexpr_convert (a, t, NULL,
+ abt, akt, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ ffebld_set_head (arg, a);
+ }
+ else if ((c[colon + 1] == '*') && commit)
+ {
+ /* This is where we promote types to the consensus
+ type for the COL. Maybe this is where -fpedantic
+ should issue a warning as well. */
+
+ a = ffeexpr_convert (a, t, NULL,
+ col_bt, col_kt, 0,
+ ffeinfo_size (i),
+ FFEEXPR_contextLET);
+ ffebld_set_head (arg, a);
+ }
+
+ arg = ffebld_trail (arg); /* Arg accepted, now move on. */
+
+ if (optional == '*')
+ continue; /* Go ahead and try another arg. */
+ if (required == '\0')
+ break;
+ if ((required == 'n')
+ || (required == '+'))
+ {
+ optional = '*';
+ required = '\0';
+ }
+ else if (required == 'p')
+ required = 'n';
+ } while (TRUE);
+ }
+
+ *xbt = bt;
+ *xkt = kt;
+ *xsz = sz;
+ return FFEBAD;
+}
+
+static bool
+ffeintrin_check_any_ (ffebld arglist)
+{
+ ffebld item;
+
+ for (; arglist != NULL; arglist = ffebld_trail (arglist))
+ {
+ item = ffebld_head (arglist);
+ if ((item != NULL)
+ && (ffebld_op (item) == FFEBLD_opANY))
+ return TRUE;
+ }
+
+ return FALSE;
+}
+
+/* Compare name to intrinsic's name. Uses strcmp on arguments' names. */
+
+static int
+ffeintrin_cmp_name_ (const void *name, const void *intrinsic)
+{
+ char *uc = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_uc;
+ char *lc = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_lc;
+ char *ic = (char *) ((struct _ffeintrin_name_ *) intrinsic)->name_ic;
+
+ return ffesrc_strcmp_2c (ffe_case_intrin (), name, uc, lc, ic);
+}
+
+/* Return basic type of intrinsic implementation, based on its
+ run-time implementation *only*. (This is used only when
+ the type of an intrinsic name is needed without having a
+ list of arguments, i.e. an interface signature, such as when
+ passing the intrinsic itself, or really the run-time-library
+ function, as an argument.)
+
+ If there's no eligible intrinsic implementation, there must be
+ a bug somewhere else; no such reference should have been permitted
+ to go this far. (Well, this might be wrong.) */
+
+ffeinfoBasictype
+ffeintrin_basictype (ffeintrinSpec spec)
+{
+ ffeintrinImp imp;
+ ffecomGfrt gfrt;
+
+ assert (spec < FFEINTRIN_spec);
+ imp = ffeintrin_specs_[spec].implementation;
+ assert (imp < FFEINTRIN_imp);
+
+ if (ffe_is_f2c ())
+ gfrt = ffeintrin_imps_[imp].gfrt_f2c;
+ else
+ gfrt = ffeintrin_imps_[imp].gfrt_gnu;
+
+ assert (gfrt != FFECOM_gfrt);
+
+ return ffecom_gfrt_basictype (gfrt);
+}
+
+/* Return family to which specific intrinsic belongs. */
+
+ffeintrinFamily
+ffeintrin_family (ffeintrinSpec spec)
+{
+ if (spec >= FFEINTRIN_spec)
+ return FALSE;
+ return ffeintrin_specs_[spec].family;
+}
+
+/* Check and fill in info on func/subr ref node.
+
+ ffebld expr; // FUNCREF or SUBRREF with no info (caller
+ // gets it from the modified info structure).
+ ffeinfo info; // Already filled in, will be overwritten.
+ ffelexToken token; // Used for error message.
+ ffeintrin_fulfill_generic (&expr, &info, token);
+
+ Based on the generic id, figure out which specific procedure is meant and
+ pick that one. Else return an error, a la _specific. */
+
+void
+ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t)
+{
+ ffebld symter;
+ ffebldOp op;
+ ffeintrinGen gen;
+ ffeintrinSpec spec = FFEINTRIN_specNONE;
+ ffeinfoBasictype bt = FFEINFO_basictypeNONE;
+ ffeinfoKindtype kt = FFEINFO_kindtypeNONE;
+ ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
+ ffeintrinImp imp;
+ ffeintrinSpec tspec;
+ ffeintrinImp nimp = FFEINTRIN_impNONE;
+ ffebad error;
+ bool any = FALSE;
+ bool highly_specific = FALSE;
+ int i;
+
+ op = ffebld_op (*expr);
+ assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
+ assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER);
+
+ gen = ffebld_symter_generic (ffebld_left (*expr));
+ assert (gen != FFEINTRIN_genNONE);
+
+ imp = FFEINTRIN_impNONE;
+ error = FFEBAD;
+
+ any = ffeintrin_check_any_ (ffebld_right (*expr));
+
+ for (i = 0;
+ (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
+ && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE)
+ && !any;
+ ++i)
+ {
+ ffeintrinImp timp = ffeintrin_specs_[tspec].implementation;
+ ffeinfoBasictype tbt;
+ ffeinfoKindtype tkt;
+ ffetargetCharacterSize tsz;
+ ffeIntrinsicState state
+ = ffeintrin_state_family (ffeintrin_specs_[tspec].family);
+ ffebad terror;
+
+ if (state == FFE_intrinsicstateDELETED)
+ continue;
+
+ if (timp != FFEINTRIN_impNONE)
+ {
+ if (!(ffeintrin_imps_[timp].control[0] == '-')
+ != !(ffebld_op (*expr) == FFEBLD_opSUBRREF))
+ continue; /* Form of reference must match form of specific. */
+ }
+
+ if (state == FFE_intrinsicstateDISABLED)
+ terror = FFEBAD_INTRINSIC_DISABLED;
+ else if (timp == FFEINTRIN_impNONE)
+ terror = FFEBAD_INTRINSIC_UNIMPL;
+ else
+ {
+ terror = ffeintrin_check_ (timp, ffebld_op (*expr),
+ ffebld_right (*expr),
+ &tbt, &tkt, &tsz, NULL, t, FALSE);
+ if (terror == FFEBAD)
+ {
+ if (imp != FFEINTRIN_impNONE)
+ {
+ ffebad_start (FFEBAD_INTRINSIC_AMBIG);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_string (ffeintrin_gens_[gen].name);
+ ffebad_string (ffeintrin_specs_[spec].name);
+ ffebad_string (ffeintrin_specs_[tspec].name);
+ ffebad_finish ();
+ }
+ else
+ {
+ if (ffebld_symter_specific (ffebld_left (*expr))
+ == tspec)
+ highly_specific = TRUE;
+ imp = timp;
+ spec = tspec;
+ bt = tbt;
+ kt = tkt;
+ sz = tkt;
+ error = terror;
+ }
+ }
+ else if (terror != FFEBAD)
+ { /* This error has precedence over others. */
+ if ((error == FFEBAD_INTRINSIC_DISABLED)
+ || (error == FFEBAD_INTRINSIC_UNIMPL))
+ error = FFEBAD;
+ }
+ }
+
+ if (error == FFEBAD)
+ error = terror;
+ }
+
+ if (any || (imp == FFEINTRIN_impNONE))
+ {
+ if (!any)
+ {
+ if (error == FFEBAD)
+ error = FFEBAD_INTRINSIC_REF;
+ ffebad_start (error);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_string (ffeintrin_gens_[gen].name);
+ ffebad_finish ();
+ }
+
+ *expr = ffebld_new_any ();
+ *info = ffeinfo_new_any ();
+ }
+ else
+ {
+ if (!highly_specific && (nimp != FFEINTRIN_impNONE))
+ {
+ fprintf (stderr, "lineno=%ld, gen=%s, imp=%s, timp=%s\n",
+ (long) lineno,
+ ffeintrin_gens_[gen].name,
+ ffeintrin_imps_[imp].name,
+ ffeintrin_imps_[nimp].name);
+ assert ("Ambiguous generic reference" == NULL);
+ abort ();
+ }
+ error = ffeintrin_check_ (imp, ffebld_op (*expr),
+ ffebld_right (*expr),
+ &bt, &kt, &sz, NULL, t, TRUE);
+ assert (error == FFEBAD);
+ *info = ffeinfo_new (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereFLEETING,
+ sz);
+ symter = ffebld_left (*expr);
+ ffebld_symter_set_specific (symter, spec);
+ ffebld_symter_set_implementation (symter, imp);
+ ffebld_set_info (symter,
+ ffeinfo_new (bt,
+ kt,
+ 0,
+ (bt == FFEINFO_basictypeNONE)
+ ? FFEINFO_kindSUBROUTINE
+ : FFEINFO_kindFUNCTION,
+ FFEINFO_whereINTRINSIC,
+ sz));
+
+ if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE)
+ && (((bt != ffesymbol_basictype (ffebld_symter (symter)))
+ || (kt != ffesymbol_kindtype (ffebld_symter (symter)))
+ || (sz != ffesymbol_size (ffebld_symter (symter))))))
+ {
+ ffebad_start (FFEBAD_INTRINSIC_TYPE);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_string (ffeintrin_gens_[gen].name);
+ ffebad_finish ();
+ }
+ }
+}
+
+/* Check and fill in info on func/subr ref node.
+
+ ffebld expr; // FUNCREF or SUBRREF with no info (caller
+ // gets it from the modified info structure).
+ ffeinfo info; // Already filled in, will be overwritten.
+ bool check_intrin; // May be omitted, else set TRUE if intrinsic needs checking.
+ ffelexToken token; // Used for error message.
+ ffeintrin_fulfill_specific (&expr, &info, &check_intrin, token);
+
+ Based on the specific id, determine whether the arg list is valid
+ (number, type, rank, and kind of args) and fill in the info structure
+ accordingly. Currently don't rewrite the expression, but perhaps
+ someday do so for constant collapsing, except when an error occurs,
+ in which case it is overwritten with ANY and info is also overwritten
+ accordingly. */
+
+void
+ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
+ bool *check_intrin, ffelexToken t)
+{
+ ffebld symter;
+ ffebldOp op;
+ ffeintrinGen gen;
+ ffeintrinSpec spec;
+ ffeintrinImp imp;
+ ffeinfoBasictype bt = FFEINFO_basictypeNONE;
+ ffeinfoKindtype kt = FFEINFO_kindtypeNONE;
+ ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
+ ffeIntrinsicState state;
+ ffebad error;
+ bool any = FALSE;
+ char *name;
+
+ op = ffebld_op (*expr);
+ assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
+ assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER);
+
+ gen = ffebld_symter_generic (ffebld_left (*expr));
+ spec = ffebld_symter_specific (ffebld_left (*expr));
+ assert (spec != FFEINTRIN_specNONE);
+
+ if (gen != FFEINTRIN_genNONE)
+ name = ffeintrin_gens_[gen].name;
+ else
+ name = ffeintrin_specs_[spec].name;
+
+ state = ffeintrin_state_family (ffeintrin_specs_[spec].family);
+
+ imp = ffeintrin_specs_[spec].implementation;
+ if (check_intrin != NULL)
+ *check_intrin = FALSE;
+
+ any = ffeintrin_check_any_ (ffebld_right (*expr));
+
+ if (state == FFE_intrinsicstateDISABLED)
+ error = FFEBAD_INTRINSIC_DISABLED;
+ else if (imp == FFEINTRIN_impNONE)
+ error = FFEBAD_INTRINSIC_UNIMPL;
+ else if (!any)
+ {
+ error = ffeintrin_check_ (imp, ffebld_op (*expr),
+ ffebld_right (*expr),
+ &bt, &kt, &sz, check_intrin, t, TRUE);
+ }
+ else
+ error = FFEBAD; /* Not really needed, but quiet -Wuninitialized. */
+
+ if (any || (error != FFEBAD))
+ {
+ if (!any)
+ {
+
+ ffebad_start (error);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_string (name);
+ ffebad_finish ();
+ }
+
+ *expr = ffebld_new_any ();
+ *info = ffeinfo_new_any ();
+ }
+ else
+ {
+ *info = ffeinfo_new (bt,
+ kt,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereFLEETING,
+ sz);
+ symter = ffebld_left (*expr);
+ ffebld_set_info (symter,
+ ffeinfo_new (bt,
+ kt,
+ 0,
+ (bt == FFEINFO_basictypeNONE)
+ ? FFEINFO_kindSUBROUTINE
+ : FFEINFO_kindFUNCTION,
+ FFEINFO_whereINTRINSIC,
+ sz));
+
+ if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE)
+ && (((bt != ffesymbol_basictype (ffebld_symter (symter)))
+ || (kt != ffesymbol_kindtype (ffebld_symter (symter)))
+ || (sz != ffesymbol_size (ffebld_symter (symter))))))
+ {
+ ffebad_start (FFEBAD_INTRINSIC_TYPE);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_string (name);
+ ffebad_finish ();
+ }
+ }
+}
+
+/* Return run-time index of intrinsic implementation as direct call. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ffecomGfrt
+ffeintrin_gfrt_direct (ffeintrinImp imp)
+{
+ assert (imp < FFEINTRIN_imp);
+
+ return ffeintrin_imps_[imp].gfrt_direct;
+}
+#endif
+
+/* Return run-time index of intrinsic implementation as actual argument. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ffecomGfrt
+ffeintrin_gfrt_indirect (ffeintrinImp imp)
+{
+ assert (imp < FFEINTRIN_imp);
+
+ if (! ffe_is_f2c ())
+ return ffeintrin_imps_[imp].gfrt_gnu;
+ return ffeintrin_imps_[imp].gfrt_f2c;
+}
+#endif
+
+void
+ffeintrin_init_0 ()
+{
+ int i;
+ char *p1;
+ char *p2;
+ char *p3;
+ int colon;
+
+ if (!ffe_is_do_internal_checks ())
+ return;
+
+ assert (FFEINTRIN_gen == ARRAY_SIZE (ffeintrin_gens_));
+ assert (FFEINTRIN_imp == ARRAY_SIZE (ffeintrin_imps_));
+ assert (FFEINTRIN_spec == ARRAY_SIZE (ffeintrin_specs_));
+
+ for (i = 1; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i)
+ { /* Make sure binary-searched list is in alpha
+ order. */
+ if (strcmp (ffeintrin_names_[i - 1].name_uc,
+ ffeintrin_names_[i].name_uc) >= 0)
+ assert ("name list out of order" == NULL);
+ }
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i)
+ {
+ assert ((ffeintrin_names_[i].generic == FFEINTRIN_genNONE)
+ || (ffeintrin_names_[i].specific == FFEINTRIN_specNONE));
+
+ p1 = ffeintrin_names_[i].name_uc;
+ p2 = ffeintrin_names_[i].name_lc;
+ p3 = ffeintrin_names_[i].name_ic;
+ for (; *p1 != '\0' && *p2 != '\0' && *p3 != '\0'; ++p1, ++p2, ++p3)
+ {
+ if (!isascii (*p1) || !isascii (*p2) || !isascii (*p3))
+ break;
+ if ((isdigit (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3))
+ continue;
+ if (!isupper (*p1) || !islower (*p2)
+ || (*p1 != toupper (*p2)) || ((*p3 != *p1) && (*p3 != *p2)))
+ break;
+ }
+ assert ((*p1 == *p2) && (*p1 == *p3) && (*p1 == '\0'));
+ }
+
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_imps_); ++i)
+ {
+ char *c = ffeintrin_imps_[i].control;
+
+ if (c[0] == '\0')
+ continue;
+
+ if ((c[0] != '-')
+ && (c[0] != 'A')
+ && (c[0] != 'C')
+ && (c[0] != 'I')
+ && (c[0] != 'L')
+ && (c[0] != 'R')
+ && (c[0] != 'B')
+ && (c[0] != 'F')
+ && (c[0] != 'N')
+ && (c[0] != 'S'))
+ {
+ fprintf (stderr, "%s: bad return-base-type\n",
+ ffeintrin_imps_[i].name);
+ continue;
+ }
+ if ((c[1] != '-')
+ && (c[1] != '=')
+ && ((c[1] < '1')
+ || (c[1] > '9'))
+ && (c[1] != 'C')
+ && (c[1] != 'p'))
+ {
+ fprintf (stderr, "%s: bad return-kind-type\n",
+ ffeintrin_imps_[i].name);
+ continue;
+ }
+ if (c[2] == ':')
+ colon = 2;
+ else
+ {
+ if (c[2] != '*')
+ {
+ fprintf (stderr, "%s: bad return-modifier\n",
+ ffeintrin_imps_[i].name);
+ continue;
+ }
+ colon = 3;
+ }
+ if ((c[colon] != ':') || (c[colon + 2] != ':'))
+ {
+ fprintf (stderr, "%s: bad control\n",
+ ffeintrin_imps_[i].name);
+ continue;
+ }
+ if ((c[colon + 1] != '-')
+ && (c[colon + 1] != '*')
+ && ((c[colon + 1] < '0')
+ || (c[colon + 1] > '9')))
+ {
+ fprintf (stderr, "%s: bad COL-spec\n",
+ ffeintrin_imps_[i].name);
+ continue;
+ }
+ c += (colon + 3);
+ while (c[0] != '\0')
+ {
+ while ((c[0] != '=')
+ && (c[0] != ',')
+ && (c[0] != '\0'))
+ ++c;
+ if (c[0] != '=')
+ {
+ fprintf (stderr, "%s: bad keyword\n",
+ ffeintrin_imps_[i].name);
+ break;
+ }
+ if ((c[1] == '?')
+ || (c[1] == '!')
+ || (c[1] == '!')
+ || (c[1] == '+')
+ || (c[1] == '*')
+ || (c[1] == 'n')
+ || (c[1] == 'p'))
+ ++c;
+ if (((c[1] != '-')
+ && (c[1] != 'A')
+ && (c[1] != 'C')
+ && (c[1] != 'I')
+ && (c[1] != 'L')
+ && (c[1] != 'R')
+ && (c[1] != 'B')
+ && (c[1] != 'F')
+ && (c[1] != 'N')
+ && (c[1] != 'S')
+ && (c[1] != 'g')
+ && (c[1] != 's'))
+ || ((c[2] != '*')
+ && ((c[2] < '1')
+ || (c[2] > '9'))
+ && (c[2] != 'A')))
+ {
+ fprintf (stderr, "%s: bad arg-type\n",
+ ffeintrin_imps_[i].name);
+ break;
+ }
+ if (c[3] == '[')
+ {
+ if (((c[4] < '0') || (c[4] > '9'))
+ || ((c[5] != ']')
+ && (++c, (c[4] < '0') || (c[4] > '9')
+ || (c[5] != ']'))))
+ {
+ fprintf (stderr, "%s: bad arg-len\n",
+ ffeintrin_imps_[i].name);
+ break;
+ }
+ c += 3;
+ }
+ if (c[3] == '(')
+ {
+ if (((c[4] < '0') || (c[4] > '9'))
+ || ((c[5] != ')')
+ && (++c, (c[4] < '0') || (c[4] > '9')
+ || (c[5] != ')'))))
+ {
+ fprintf (stderr, "%s: bad arg-rank\n",
+ ffeintrin_imps_[i].name);
+ break;
+ }
+ c += 3;
+ }
+ else if ((c[3] == '&')
+ && (c[4] == '&'))
+ ++c;
+ if ((c[3] == '&')
+ || (c[3] == 'i')
+ || (c[3] == 'w')
+ || (c[3] == 'x'))
+ ++c;
+ if (c[3] == ',')
+ {
+ c += 4;
+ break;
+ }
+ if (c[3] != '\0')
+ {
+ fprintf (stderr, "%s: bad arg-list\n",
+ ffeintrin_imps_[i].name);
+ }
+ break;
+ }
+ }
+}
+
+/* Determine whether intrinsic is okay as an actual argument. */
+
+bool
+ffeintrin_is_actualarg (ffeintrinSpec spec)
+{
+ ffeIntrinsicState state;
+
+ if (spec >= FFEINTRIN_spec)
+ return FALSE;
+
+ state = ffeintrin_state_family (ffeintrin_specs_[spec].family);
+
+ return (!ffe_is_pedantic () || ffeintrin_specs_[spec].is_actualarg)
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ && (ffe_is_f2c ()
+ ? (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_f2c
+ != FFECOM_gfrt)
+ : (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_gnu
+ != FFECOM_gfrt))
+#endif
+ && ((state == FFE_intrinsicstateENABLED)
+ || (state == FFE_intrinsicstateHIDDEN));
+}
+
+/* Determine if name is intrinsic, return info.
+
+ char *name; // C-string name of possible intrinsic.
+ ffelexToken t; // NULL if no diagnostic to be given.
+ bool explicit; // TRUE if INTRINSIC name.
+ ffeintrinGen gen; // (TRUE only) Generic id of intrinsic.
+ ffeintrinSpec spec; // (TRUE only) Specific id of intrinsic.
+ ffeintrinImp imp; // (TRUE only) Implementation id of intrinsic.
+ if (ffeintrin_is_intrinsic (name, t, explicit,
+ &gen, &spec, &imp))
+ // is an intrinsic, use gen, spec, imp, and
+ // kind accordingly. */
+
+bool
+ffeintrin_is_intrinsic (char *name, ffelexToken t, bool explicit,
+ ffeintrinGen *xgen, ffeintrinSpec *xspec,
+ ffeintrinImp *ximp)
+{
+ struct _ffeintrin_name_ *intrinsic;
+ ffeintrinGen gen;
+ ffeintrinSpec spec;
+ ffeintrinImp imp;
+ ffeIntrinsicState state;
+ bool disabled = FALSE;
+ bool unimpl = FALSE;
+
+ intrinsic = bsearch (name, &ffeintrin_names_[0],
+ ARRAY_SIZE (ffeintrin_names_),
+ sizeof (struct _ffeintrin_name_),
+ (void *) ffeintrin_cmp_name_);
+
+ if (intrinsic == NULL)
+ return FALSE;
+
+ gen = intrinsic->generic;
+ spec = intrinsic->specific;
+ imp = ffeintrin_specs_[spec].implementation;
+
+ /* Generic is okay only if at least one of its specifics is okay. */
+
+ if (gen != FFEINTRIN_genNONE)
+ {
+ int i;
+ ffeintrinSpec tspec;
+ bool ok = FALSE;
+
+ name = ffeintrin_gens_[gen].name;
+
+ for (i = 0;
+ (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
+ && ((tspec
+ = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
+ ++i)
+ {
+ state = ffeintrin_state_family (ffeintrin_specs_[tspec].family);
+
+ if (state == FFE_intrinsicstateDELETED)
+ continue;
+
+ if (state == FFE_intrinsicstateDISABLED)
+ {
+ disabled = TRUE;
+ continue;
+ }
+
+ if (ffeintrin_specs_[tspec].implementation == FFEINTRIN_impNONE)
+ {
+ unimpl = TRUE;
+ continue;
+ }
+
+ if ((state == FFE_intrinsicstateENABLED)
+ || (explicit
+ && (state == FFE_intrinsicstateHIDDEN)))
+ {
+ ok = TRUE;
+ break;
+ }
+ }
+ if (!ok)
+ gen = FFEINTRIN_genNONE;
+ }
+
+ /* Specific is okay only if not: unimplemented, disabled, deleted, or
+ hidden and not explicit. */
+
+ if (spec != FFEINTRIN_specNONE)
+ {
+ if (gen != FFEINTRIN_genNONE)
+ name = ffeintrin_gens_[gen].name;
+ else
+ name = ffeintrin_specs_[spec].name;
+
+ if (((state = ffeintrin_state_family (ffeintrin_specs_[spec].family))
+ == FFE_intrinsicstateDELETED)
+ || (!explicit
+ && (state == FFE_intrinsicstateHIDDEN)))
+ spec = FFEINTRIN_specNONE;
+ else if (state == FFE_intrinsicstateDISABLED)
+ {
+ disabled = TRUE;
+ spec = FFEINTRIN_specNONE;
+ }
+ else if (imp == FFEINTRIN_impNONE)
+ {
+ unimpl = TRUE;
+ spec = FFEINTRIN_specNONE;
+ }
+ }
+
+ /* If neither is okay, not an intrinsic. */
+
+ if ((gen == FFEINTRIN_genNONE) && (spec == FFEINTRIN_specNONE))
+ {
+ /* Here is where we produce a diagnostic about a reference to a
+ disabled or unimplemented intrinsic, if the diagnostic is desired. */
+
+ if ((disabled || unimpl)
+ && (t != NULL))
+ {
+ ffebad_start (disabled
+ ? FFEBAD_INTRINSIC_DISABLED
+ : FFEBAD_INTRINSIC_UNIMPLW);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (name);
+ ffebad_finish ();
+ }
+
+ return FALSE;
+ }
+
+ /* Determine whether intrinsic is function or subroutine. If no specific
+ id, scan list of possible specifics for generic to get consensus. If
+ not unanimous, or clear from the context, return NONE. */
+
+ if (spec == FFEINTRIN_specNONE)
+ {
+ int i;
+ ffeintrinSpec tspec;
+ ffeintrinImp timp;
+ bool at_least_one_ok = FALSE;
+
+ for (i = 0;
+ (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
+ && ((tspec
+ = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
+ ++i)
+ {
+ if (((state = ffeintrin_state_family (ffeintrin_specs_[tspec].family))
+ == FFE_intrinsicstateDELETED)
+ || (state == FFE_intrinsicstateDISABLED))
+ continue;
+
+ if ((timp = ffeintrin_specs_[tspec].implementation)
+ == FFEINTRIN_impNONE)
+ continue;
+
+ at_least_one_ok = TRUE;
+ break;
+ }
+
+ if (!at_least_one_ok)
+ {
+ *xgen = FFEINTRIN_genNONE;
+ *xspec = FFEINTRIN_specNONE;
+ *ximp = FFEINTRIN_impNONE;
+ return FALSE;
+ }
+ }
+
+ *xgen = gen;
+ *xspec = spec;
+ *ximp = imp;
+ return TRUE;
+}
+
+/* Return TRUE if intrinsic is standard F77 (or, if -ff90, F90). */
+
+bool
+ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec)
+{
+ if (spec == FFEINTRIN_specNONE)
+ {
+ if (gen == FFEINTRIN_genNONE)
+ return FALSE;
+
+ spec = ffeintrin_gens_[gen].specs[0];
+ if (spec == FFEINTRIN_specNONE)
+ return FALSE;
+ }
+
+ if ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF77)
+ || (ffe_is_90 ()
+ && ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF90)
+ || (ffeintrin_specs_[spec].family == FFEINTRIN_familyMIL)
+ || (ffeintrin_specs_[spec].family == FFEINTRIN_familyASC))))
+ return TRUE;
+ return FALSE;
+}
+
+/* Return kind type of intrinsic implementation. See ffeintrin_basictype,
+ its sibling. */
+
+ffeinfoKindtype
+ffeintrin_kindtype (ffeintrinSpec spec)
+{
+ ffeintrinImp imp;
+ ffecomGfrt gfrt;
+
+ assert (spec < FFEINTRIN_spec);
+ imp = ffeintrin_specs_[spec].implementation;
+ assert (imp < FFEINTRIN_imp);
+
+ if (ffe_is_f2c ())
+ gfrt = ffeintrin_imps_[imp].gfrt_f2c;
+ else
+ gfrt = ffeintrin_imps_[imp].gfrt_gnu;
+
+ assert (gfrt != FFECOM_gfrt);
+
+ return ffecom_gfrt_kindtype (gfrt);
+}
+
+/* Return name of generic intrinsic. */
+
+char *
+ffeintrin_name_generic (ffeintrinGen gen)
+{
+ assert (gen < FFEINTRIN_gen);
+ return ffeintrin_gens_[gen].name;
+}
+
+/* Return name of intrinsic implementation. */
+
+char *
+ffeintrin_name_implementation (ffeintrinImp imp)
+{
+ assert (imp < FFEINTRIN_imp);
+ return ffeintrin_imps_[imp].name;
+}
+
+/* Return external/internal name of specific intrinsic. */
+
+char *
+ffeintrin_name_specific (ffeintrinSpec spec)
+{
+ assert (spec < FFEINTRIN_spec);
+ return ffeintrin_specs_[spec].name;
+}
+
+/* Return state of family. */
+
+ffeIntrinsicState
+ffeintrin_state_family (ffeintrinFamily family)
+{
+ ffeIntrinsicState state;
+
+ switch (family)
+ {
+ case FFEINTRIN_familyNONE:
+ return FFE_intrinsicstateDELETED;
+
+ case FFEINTRIN_familyF77:
+ return FFE_intrinsicstateENABLED;
+
+ case FFEINTRIN_familyASC:
+ state = ffe_intrinsic_state_f2c ();
+ state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
+ return state;
+
+ case FFEINTRIN_familyMIL:
+ state = ffe_intrinsic_state_vxt ();
+ state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
+ state = ffe_state_max (state, ffe_intrinsic_state_mil ());
+ return state;
+
+ case FFEINTRIN_familyGNU:
+ state = ffe_intrinsic_state_gnu ();
+ return state;
+
+ case FFEINTRIN_familyF90:
+ state = ffe_intrinsic_state_f90 ();
+ return state;
+
+ case FFEINTRIN_familyVXT:
+ state = ffe_intrinsic_state_vxt ();
+ return state;
+
+ case FFEINTRIN_familyFVZ:
+ state = ffe_intrinsic_state_f2c ();
+ state = ffe_state_max (state, ffe_intrinsic_state_vxt ());
+ return state;
+
+ case FFEINTRIN_familyF2C:
+ state = ffe_intrinsic_state_f2c ();
+ return state;
+
+ case FFEINTRIN_familyF2U:
+ state = ffe_intrinsic_state_unix ();
+ return state;
+
+ case FFEINTRIN_familyBADU77:
+ state = ffe_intrinsic_state_badu77 ();
+ return state;
+
+ default:
+ assert ("bad family" == NULL);
+ return FFE_intrinsicstateDELETED;
+ }
+}
diff --git a/gcc/f/intrin.def b/gcc/f/intrin.def
new file mode 100644
index 00000000000..66ca3c0a215
--- /dev/null
+++ b/gcc/f/intrin.def
@@ -0,0 +1,3350 @@
+/* intrin.def -- Public #include File (module.h template V1.0)
+ The Free Software Foundation has released this file into the
+ public domain.
+
+ Owning Modules:
+ intrin.c
+
+ Modifications:
+*/
+
+/* Intrinsic names listed in alphabetical order, sorted by uppercase name.
+ This list is keyed to the names of intrinsics as seen in source code. */
+
+DEFNAME ("ABORT", "abort", "Abort", genNONE, specABORT) /* UNIX */
+DEFNAME ("ABS", "abs", "Abs", genNONE, specABS)
+DEFNAME ("ACCESS", "access", "Access", genNONE, specACCESS) /* UNIX */
+DEFNAME ("ACHAR", "achar", "AChar", genNONE, specACHAR) /* F90, F2C */
+DEFNAME ("ACOS", "acos", "ACos", genNONE, specACOS)
+DEFNAME ("ACOSD", "acosd", "ACosD", genNONE, specACOSD) /* VXT */
+DEFNAME ("ADJUSTL", "adjustl", "AdjustL", genNONE, specADJUSTL) /* F90 */
+DEFNAME ("ADJUSTR", "adjustr", "AdjustR", genNONE, specADJUSTR) /* F90 */
+DEFNAME ("AIMAG", "aimag", "AImag", genNONE, specAIMAG)
+DEFNAME ("AIMAX0", "aimax0", "AIMax0", genNONE, specAIMAX0) /* VXT */
+DEFNAME ("AIMIN0", "aimin0", "AIMin0", genNONE, specAIMIN0) /* VXT */
+DEFNAME ("AINT", "aint", "AInt", genNONE, specAINT)
+DEFNAME ("AJMAX0", "ajmax0", "AJMax0", genNONE, specAJMAX0) /* VXT */
+DEFNAME ("AJMIN0", "ajmin0", "AJMin0", genNONE, specAJMIN0) /* VXT */
+DEFNAME ("ALARM", "alarm", "Alarm", genNONE, specALARM) /* UNIX */
+DEFNAME ("ALL", "all", "All", genNONE, specALL) /* F90 */
+DEFNAME ("ALLOCATED", "allocated", "Allocated", genNONE, specALLOCATED) /* F90 */
+DEFNAME ("ALOG", "alog", "ALog", genNONE, specALOG)
+DEFNAME ("ALOG10", "alog10", "ALog10", genNONE, specALOG10)
+DEFNAME ("AMAX0", "amax0", "AMax0", genNONE, specAMAX0)
+DEFNAME ("AMAX1", "amax1", "AMax1", genNONE, specAMAX1)
+DEFNAME ("AMIN0", "amin0", "AMin0", genNONE, specAMIN0)
+DEFNAME ("AMIN1", "amin1", "AMin1", genNONE, specAMIN1)
+DEFNAME ("AMOD", "amod", "AMod", genNONE, specAMOD)
+DEFNAME ("AND", "and", "And", genNONE, specAND) /* F2C */
+DEFNAME ("ANINT", "anint", "ANInt", genNONE, specANINT)
+DEFNAME ("ANY", "any", "Any", genNONE, specANY) /* F90 */
+DEFNAME ("ASIN", "asin", "ASin", genNONE, specASIN)
+DEFNAME ("ASIND", "asind", "ASinD", genNONE, specASIND) /* VXT */
+DEFNAME ("ASSOCIATED", "associated", "Associated", genNONE, specASSOCIATED) /* F90 */
+DEFNAME ("ATAN", "atan", "ATan", genNONE, specATAN)
+DEFNAME ("ATAN2", "atan2", "ATan2", genNONE, specATAN2)
+DEFNAME ("ATAN2D", "atan2d", "ATan2D", genNONE, specATAN2D) /* VXT */
+DEFNAME ("ATAND", "atand", "ATanD", genNONE, specATAND) /* VXT */
+DEFNAME ("BESJ0", "besj0", "BesJ0", genNONE, specBESJ0) /* UNIX */
+DEFNAME ("BESJ1", "besj1", "BesJ1", genNONE, specBESJ1) /* UNIX */
+DEFNAME ("BESJN", "besjn", "BesJN", genNONE, specBESJN) /* UNIX */
+DEFNAME ("BESY0", "besy0", "BesY0", genNONE, specBESY0) /* UNIX */
+DEFNAME ("BESY1", "besy1", "BesY1", genNONE, specBESY1) /* UNIX */
+DEFNAME ("BESYN", "besyn", "BesYN", genNONE, specBESYN) /* UNIX */
+DEFNAME ("BITEST", "bitest", "BITest", genNONE, specBITEST) /* VXT */
+DEFNAME ("BIT_SIZE", "bit_size", "Bit_Size", genNONE, specBIT_SIZE) /* F90 */
+DEFNAME ("BJTEST", "bjtest", "BJTest", genNONE, specBJTEST) /* VXT */
+DEFNAME ("BTEST", "btest", "BTest", genNONE, specBTEST) /* F90, VXT */
+DEFNAME ("CABS", "cabs", "CAbs", genNONE, specCABS)
+DEFNAME ("CCOS", "ccos", "CCos", genNONE, specCCOS)
+DEFNAME ("CDABS", "cdabs", "CDAbs", genNONE, specCDABS) /* VXT */
+DEFNAME ("CDCOS", "cdcos", "CDCos", genNONE, specCDCOS) /* VXT */
+DEFNAME ("CDEXP", "cdexp", "CDExp", genNONE, specCDEXP) /* VXT */
+DEFNAME ("CDLOG", "cdlog", "CDLog", genNONE, specCDLOG) /* VXT */
+DEFNAME ("CDSIN", "cdsin", "CDSin", genNONE, specCDSIN) /* VXT */
+DEFNAME ("CDSQRT", "cdsqrt", "CDSqRt", genNONE, specCDSQRT) /* VXT */
+DEFNAME ("CEILING", "ceiling", "Ceiling", genNONE, specCEILING) /* F90 */
+DEFNAME ("CEXP", "cexp", "CExp", genNONE, specCEXP)
+DEFNAME ("CHAR", "char", "Char", genNONE, specCHAR)
+DEFNAME ("CHDIR", "chdir", "ChDir", genCHDIR, specNONE) /* UNIX */
+DEFNAME ("CHMOD", "chmod", "ChMod", genCHMOD, specNONE) /* UNIX */
+DEFNAME ("CLOG", "clog", "CLog", genNONE, specCLOG)
+DEFNAME ("CMPLX", "cmplx", "Cmplx", genNONE, specCMPLX)
+DEFNAME ("COMPLEX", "complex", "Complex", genNONE, specCOMPLEX)
+DEFNAME ("CONJG", "conjg", "Conjg", genNONE, specCONJG)
+DEFNAME ("COS", "cos", "Cos", genNONE, specCOS)
+DEFNAME ("COSD", "cosd", "CosD", genNONE, specCOSD) /* VXT */
+DEFNAME ("COSH", "cosh", "CosH", genNONE, specCOSH)
+DEFNAME ("COUNT", "count", "Count", genNONE, specCOUNT) /* F90 */
+DEFNAME ("CPU_TIME", "cpu_time", "Cpu_Time", genNONE, specCPU_TIME) /* F95 */
+DEFNAME ("CSHIFT", "cshift", "CShift", genNONE, specCSHIFT) /* F90 */
+DEFNAME ("CSIN", "csin", "CSin", genNONE, specCSIN)
+DEFNAME ("CSQRT", "csqrt", "CSqRt", genNONE, specCSQRT)
+DEFNAME ("CTIME", "ctime", "CTime", genCTIME, specNONE) /* UNIX */
+DEFNAME ("DABS", "dabs", "DAbs", genNONE, specDABS)
+DEFNAME ("DACOS", "dacos", "DACos", genNONE, specDACOS)
+DEFNAME ("DACOSD", "dacosd", "DACosD", genNONE, specDACOSD) /* VXT */
+DEFNAME ("DASIN", "dasin", "DASin", genNONE, specDASIN)
+DEFNAME ("DASIND", "dasind", "DASinD", genNONE, specDASIND) /* VXT */
+DEFNAME ("DATAN", "datan", "DATan", genNONE, specDATAN)
+DEFNAME ("DATAN2", "datan2", "DATan2", genNONE, specDATAN2)
+DEFNAME ("DATAN2D", "datan2d", "DATan2D", genNONE, specDATAN2D) /* VXT */
+DEFNAME ("DATAND", "datand", "DATanD", genNONE, specDATAND) /* VXT */
+DEFNAME ("DATE", "date", "Date", genNONE, specDATE) /* VXT */
+DEFNAME ("DATE_AND_TIME", "date_and_time", "Date_and_Time", genNONE, specDATE_AND_TIME) /* F90 */
+DEFNAME ("DBESJ0", "dbesj0", "DbesJ0", genNONE, specDBESJ0) /* UNIX */
+DEFNAME ("DBESJ1", "dbesj1", "DbesJ1", genNONE, specDBESJ1) /* UNIX */
+DEFNAME ("DBESJN", "dbesjn", "DbesJN", genNONE, specDBESJN) /* UNIX */
+DEFNAME ("DBESY0", "dbesy0", "DbesY0", genNONE, specDBESY0) /* UNIX */
+DEFNAME ("DBESY1", "dbesy1", "DbesY1", genNONE, specDBESY1) /* UNIX */
+DEFNAME ("DBESYN", "dbesyn", "DbesYN", genNONE, specDBESYN) /* UNIX */
+DEFNAME ("DBLE", "dble", "Dble", genNONE, specDBLE)
+DEFNAME ("DBLEQ", "dbleq", "DbleQ", genNONE, specDBLEQ) /* VXT */
+DEFNAME ("DCMPLX", "dcmplx", "DCmplx", genNONE, specDCMPLX) /* F2C, VXT */
+DEFNAME ("DCONJG", "dconjg", "DConjg", genNONE, specDCONJG) /* F2C, VXT */
+DEFNAME ("DCOS", "dcos", "DCos", genNONE, specDCOS)
+DEFNAME ("DCOSD", "dcosd", "DCosD", genNONE, specDCOSD) /* VXT */
+DEFNAME ("DCOSH", "dcosh", "DCosH", genNONE, specDCOSH)
+DEFNAME ("DDIM", "ddim", "DDiM", genNONE, specDDIM)
+DEFNAME ("DERF", "derf", "DErF", genNONE, specDERF) /* UNIX */
+DEFNAME ("DERFC", "derfc", "DErFC", genNONE, specDERFC) /* UNIX */
+DEFNAME ("DEXP", "dexp", "DExp", genNONE, specDEXP)
+DEFNAME ("DFLOAT", "dfloat", "DFloat", genNONE, specDFLOAT) /* F2C, VXT */
+DEFNAME ("DFLOTI", "dfloti", "DFlotI", genNONE, specDFLOTI) /* VXT */
+DEFNAME ("DFLOTJ", "dflotj", "DFlotJ", genNONE, specDFLOTJ) /* VXT */
+DEFNAME ("DIGITS", "digits", "Digits", genNONE, specDIGITS) /* F90 */
+DEFNAME ("DIM", "dim", "DiM", genNONE, specDIM)
+DEFNAME ("DIMAG", "dimag", "DImag", genNONE, specDIMAG) /* F2C, VXT */
+DEFNAME ("DINT", "dint", "DInt", genNONE, specDINT)
+DEFNAME ("DLOG", "dlog", "DLog", genNONE, specDLOG)
+DEFNAME ("DLOG10", "dlog10", "DLog10", genNONE, specDLOG10)
+DEFNAME ("DMAX1", "dmax1", "DMax1", genNONE, specDMAX1)
+DEFNAME ("DMIN1", "dmin1", "DMin1", genNONE, specDMIN1)
+DEFNAME ("DMOD", "dmod", "DMod", genNONE, specDMOD)
+DEFNAME ("DNINT", "dnint", "DNInt", genNONE, specDNINT)
+DEFNAME ("DOT_PRODUCT", "dot_product", "Dot_Product", genNONE, specDOT_PRODUCT) /* F90 */
+DEFNAME ("DPROD", "dprod", "DProd", genNONE, specDPROD)
+DEFNAME ("DREAL", "dreal", "DReal", genNONE, specDREAL) /* VXT */
+DEFNAME ("DSIGN", "dsign", "DSign", genNONE, specDSIGN)
+DEFNAME ("DSIN", "dsin", "DSin", genNONE, specDSIN)
+DEFNAME ("DSIND", "dsind", "DSinD", genNONE, specDSIND) /* VXT */
+DEFNAME ("DSINH", "dsinh", "DSinH", genNONE, specDSINH)
+DEFNAME ("DSQRT", "dsqrt", "DSqRt", genNONE, specDSQRT)
+DEFNAME ("DTAN", "dtan", "DTan", genNONE, specDTAN)
+DEFNAME ("DTAND", "dtand", "DTanD", genNONE, specDTAND) /* VXT */
+DEFNAME ("DTANH", "dtanh", "DTanH", genNONE, specDTANH)
+DEFNAME ("DTIME", "dtime", "Dtime", genDTIME, specNONE) /* UNIX */
+DEFNAME ("EOSHIFT", "eoshift", "EOShift", genNONE, specEOSHIFT) /* F90 */
+DEFNAME ("EPSILON", "epsilon", "Epsilon", genNONE, specEPSILON) /* F90 */
+DEFNAME ("ERF", "erf", "ErF", genNONE, specERF) /* UNIX */
+DEFNAME ("ERFC", "erfc", "ErFC", genNONE, specERFC) /* UNIX */
+DEFNAME ("ETIME", "etime", "ETime", genETIME, specNONE) /* UNIX */
+DEFNAME ("EXIT", "exit", "Exit", genNONE, specEXIT) /* UNIX */
+DEFNAME ("EXP", "exp", "Exp", genNONE, specEXP)
+DEFNAME ("EXPONENT", "exponent", "Exponent", genNONE, specEXPONENT) /* F90 */
+DEFNAME ("FDATE", "fdate", "Fdate", genFDATE, specNONE) /* UNIX */
+DEFNAME ("FGET", "fget", "FGet", genFGET, specNONE) /* UNIX */
+DEFNAME ("FGETC", "fgetc", "FGetC", genFGETC, specNONE) /* UNIX */
+DEFNAME ("FLOAT", "float", "Float", genNONE, specFLOAT)
+DEFNAME ("FLOATI", "floati", "FloatI", genNONE, specFLOATI) /* VXT */
+DEFNAME ("FLOATJ", "floatj", "FloatJ", genNONE, specFLOATJ) /* VXT */
+DEFNAME ("FLOOR", "floor", "Floor", genNONE, specFLOOR) /* F90 */
+DEFNAME ("FLUSH", "flush", "Flush", genNONE, specFLUSH) /* UNIX */
+DEFNAME ("FNUM", "fnum", "FNum", genNONE, specFNUM) /* UNIX */
+DEFNAME ("FPABSP", "fpabsp", "FPAbsP", genFPABSP, specNONE) /* F2C */
+DEFNAME ("FPEXPN", "fpexpn", "FPExpn", genFPEXPN, specNONE) /* F2C */
+DEFNAME ("FPFRAC", "fpfrac", "FPFrac", genFPFRAC, specNONE) /* F2C */
+DEFNAME ("FPMAKE", "fpmake", "FPMake", genFPMAKE, specNONE) /* F2C */
+DEFNAME ("FPRRSP", "fprrsp", "FPRRSp", genFPRRSP, specNONE) /* F2C */
+DEFNAME ("FPSCAL", "fpscal", "FPScal", genFPSCAL, specNONE) /* F2C */
+DEFNAME ("FPUT", "fput", "FPut", genFPUT, specNONE) /* UNIX */
+DEFNAME ("FPUTC", "fputc", "FPutC", genFPUTC, specNONE) /* UNIX */
+DEFNAME ("FRACTION", "fraction", "Fraction", genNONE, specFRACTION) /* F90 */
+DEFNAME ("FSEEK", "fseek", "FSeek", genNONE, specFSEEK) /* UNIX */
+DEFNAME ("FSTAT", "fstat", "FStat", genFSTAT, specNONE) /* UNIX */
+DEFNAME ("FTELL", "ftell", "FTell", genFTELL, specNONE) /* UNIX */
+DEFNAME ("GERROR", "gerror", "GError", genNONE, specGERROR) /* UNIX */
+DEFNAME ("GETARG", "getarg", "GetArg", genNONE, specGETARG) /* UNIX */
+DEFNAME ("GETCWD", "getcwd", "GetCWD", genGETCWD, specNONE) /* UNIX */
+DEFNAME ("GETENV", "getenv", "GetEnv", genNONE, specGETENV) /* UNIX */
+DEFNAME ("GETGID", "getgid", "GetGId", genNONE, specGETGID) /* UNIX */
+DEFNAME ("GETLOG", "getlog", "GetLog", genNONE, specGETLOG) /* UNIX */
+DEFNAME ("GETPID", "getpid", "GetPId", genNONE, specGETPID) /* UNIX */
+DEFNAME ("GETUID", "getuid", "GetUId", genNONE, specGETUID) /* UNIX */
+DEFNAME ("GMTIME", "gmtime", "GMTime", genNONE, specGMTIME) /* UNIX */
+DEFNAME ("HOSTNM", "hostnm", "HostNm", genHOSTNM, specNONE) /* UNIX */
+DEFNAME ("HUGE", "huge", "Huge", genNONE, specHUGE) /* F90 */
+DEFNAME ("IABS", "iabs", "IAbs", genNONE, specIABS)
+DEFNAME ("IACHAR", "iachar", "IAChar", genNONE, specIACHAR) /* F90, F2C */
+DEFNAME ("IAND", "iand", "IAnd", genNONE, specIAND) /* F90, VXT */
+DEFNAME ("IARGC", "iargc", "IArgC", genNONE, specIARGC) /* UNIX */
+DEFNAME ("IBCLR", "ibclr", "IBClr", genNONE, specIBCLR) /* F90, VXT */
+DEFNAME ("IBITS", "ibits", "IBits", genNONE, specIBITS) /* F90, VXT */
+DEFNAME ("IBSET", "ibset", "IBSet", genNONE, specIBSET) /* F90, VXT */
+DEFNAME ("ICHAR", "ichar", "IChar", genNONE, specICHAR)
+DEFNAME ("IDATE", "idate", "IDate", genIDATE, specNONE) /* UNIX, VXT */
+DEFNAME ("IDIM", "idim", "IDiM", genNONE, specIDIM)
+DEFNAME ("IDINT", "idint", "IDInt", genNONE, specIDINT)
+DEFNAME ("IDNINT", "idnint", "IDNInt", genNONE, specIDNINT)
+DEFNAME ("IEOR", "ieor", "IEOr", genNONE, specIEOR) /* F90, VXT */
+DEFNAME ("IERRNO", "ierrno", "IErrNo", genNONE, specIERRNO) /* UNIX */
+DEFNAME ("IFIX", "ifix", "IFix", genNONE, specIFIX)
+DEFNAME ("IIABS", "iiabs", "IIAbs", genNONE, specIIABS) /* VXT */
+DEFNAME ("IIAND", "iiand", "IIAnd", genNONE, specIIAND) /* VXT */
+DEFNAME ("IIBCLR", "iibclr", "IIBClr", genNONE, specIIBCLR) /* VXT */
+DEFNAME ("IIBITS", "iibits", "IIBits", genNONE, specIIBITS) /* VXT */
+DEFNAME ("IIBSET", "iibset", "IIBSet", genNONE, specIIBSET) /* VXT */
+DEFNAME ("IIDIM", "iidim", "IIDiM", genNONE, specIIDIM) /* VXT */
+DEFNAME ("IIDINT", "iidint", "IIDInt", genNONE, specIIDINT) /* VXT */
+DEFNAME ("IIDNNT", "iidnnt", "IIDNnt", genNONE, specIIDNNT) /* VXT */
+DEFNAME ("IIEOR", "iieor", "IIEOr", genNONE, specIIEOR) /* VXT */
+DEFNAME ("IIFIX", "iifix", "IIFix", genNONE, specIIFIX) /* VXT */
+DEFNAME ("IINT", "iint", "IInt", genNONE, specIINT) /* VXT */
+DEFNAME ("IIOR", "iior", "IIOr", genNONE, specIIOR) /* VXT */
+DEFNAME ("IIQINT", "iiqint", "IIQint", genNONE, specIIQINT) /* VXT */
+DEFNAME ("IIQNNT", "iiqnnt", "IIQNnt", genNONE, specIIQNNT) /* VXT */
+DEFNAME ("IISHFT", "iishft", "IIShft", genNONE, specNONE) /* VXT */
+DEFNAME ("IISHFTC", "iishftc", "IIShftC", genNONE, specIISHFTC) /* VXT */
+DEFNAME ("IISIGN", "iisign", "IISign", genNONE, specIISIGN) /* VXT */
+DEFNAME ("IMAG", "imag", "Imag", genNONE, specIMAG) /* F2C */
+DEFNAME ("IMAGPART", "imagpart", "ImagPart", genNONE, specIMAGPART) /* GNU */
+DEFNAME ("IMAX0", "imax0", "IMax0", genNONE, specIMAX0) /* VXT */
+DEFNAME ("IMAX1", "imax1", "IMax1", genNONE, specIMAX1) /* VXT */
+DEFNAME ("IMIN0", "imin0", "IMin0", genNONE, specIMIN0) /* VXT */
+DEFNAME ("IMIN1", "imin1", "IMin1", genNONE, specIMIN1) /* VXT */
+DEFNAME ("IMOD", "imod", "IMod", genNONE, specIMOD) /* VXT */
+DEFNAME ("INDEX", "index", "Index", genNONE, specINDEX)
+DEFNAME ("ININT", "inint", "INInt", genNONE, specININT) /* VXT */
+DEFNAME ("INOT", "inot", "INot", genNONE, specINOT) /* VXT */
+DEFNAME ("INT", "int", "Int", genNONE, specINT)
+DEFNAME ("INT2", "int2", "Int2", genNONE, specINT2) /* MS */
+DEFNAME ("INT8", "int8", "Int8", genNONE, specINT8) /* GNU */
+DEFNAME ("IOR", "ior", "IOr", genNONE, specIOR) /* F90, VXT */
+DEFNAME ("IRAND", "irand", "IRand", genNONE, specIRAND) /* UNIX */
+DEFNAME ("ISATTY", "isatty", "IsaTty", genNONE, specISATTY) /* UNIX */
+DEFNAME ("ISHFT", "ishft", "IShft", genNONE, specISHFT) /* F90 */
+DEFNAME ("ISHFTC", "ishftc", "IShftC", genNONE, specISHFTC) /* F90, VXT */
+DEFNAME ("ISIGN", "isign", "ISign", genNONE, specISIGN)
+DEFNAME ("ITIME", "itime", "ITime", genNONE, specITIME) /* UNIX */
+DEFNAME ("IZEXT", "izext", "IZExt", genNONE, specIZEXT) /* VXT */
+DEFNAME ("JIABS", "jiabs", "JIAbs", genNONE, specJIABS) /* VXT */
+DEFNAME ("JIAND", "jiand", "JIAnd", genNONE, specJIAND) /* VXT */
+DEFNAME ("JIBCLR", "jibclr", "JIBClr", genNONE, specJIBCLR) /* VXT */
+DEFNAME ("JIBITS", "jibits", "JIBits", genNONE, specJIBITS) /* VXT */
+DEFNAME ("JIBSET", "jibset", "JIBSet", genNONE, specJIBSET) /* VXT */
+DEFNAME ("JIDIM", "jidim", "JIDiM", genNONE, specJIDIM) /* VXT */
+DEFNAME ("JIDINT", "jidint", "JIDInt", genNONE, specJIDINT) /* VXT */
+DEFNAME ("JIDNNT", "jidnnt", "JIDNnt", genNONE, specJIDNNT) /* VXT */
+DEFNAME ("JIEOR", "jieor", "JIEOr", genNONE, specJIEOR) /* VXT */
+DEFNAME ("JIFIX", "jifix", "JIFix", genNONE, specJIFIX) /* VXT */
+DEFNAME ("JINT", "jint", "JInt", genNONE, specJINT) /* VXT */
+DEFNAME ("JIOR", "jior", "JIOr", genNONE, specJIOR) /* VXT */
+DEFNAME ("JIQINT", "jiqint", "JIQint", genNONE, specJIQINT) /* VXT */
+DEFNAME ("JIQNNT", "jiqnnt", "JIQNnt", genNONE, specJIQNNT) /* VXT */
+DEFNAME ("JISHFT", "jishft", "JIShft", genNONE, specJISHFT) /* VXT */
+DEFNAME ("JISHFTC", "jishftc", "JIShftC", genNONE, specJISHFTC) /* VXT */
+DEFNAME ("JISIGN", "jisign", "JISign", genNONE, specJISIGN) /* VXT */
+DEFNAME ("JMAX0", "jmax0", "JMax0", genNONE, specJMAX0) /* VXT */
+DEFNAME ("JMAX1", "jmax1", "JMax1", genNONE, specJMAX1) /* VXT */
+DEFNAME ("JMIN0", "jmin0", "JMin0", genNONE, specJMIN0) /* VXT */
+DEFNAME ("JMIN1", "jmin1", "JMin1", genNONE, specJMIN1) /* VXT */
+DEFNAME ("JMOD", "jmod", "JMod", genNONE, specJMOD) /* VXT */
+DEFNAME ("JNINT", "jnint", "JNInt", genNONE, specJNINT) /* VXT */
+DEFNAME ("JNOT", "jnot", "JNot", genNONE, specJNOT) /* VXT */
+DEFNAME ("JZEXT", "jzext", "JZExt", genNONE, specJZEXT) /* VXT */
+DEFNAME ("KILL", "kill", "Kill", genKILL, specNONE) /* UNIX */
+DEFNAME ("KIND", "kind", "Kind", genNONE, specKIND) /* F90 */
+DEFNAME ("LBOUND", "lbound", "LBound", genNONE, specLBOUND) /* F90 */
+DEFNAME ("LEN", "len", "Len", genNONE, specLEN)
+DEFNAME ("LEN_TRIM", "len_trim", "Len_Trim", genNONE, specLEN_TRIM) /* F90 */
+DEFNAME ("LGE", "lge", "LGe", genNONE, specLGE)
+DEFNAME ("LGT", "lgt", "LGt", genNONE, specLGT)
+DEFNAME ("LINK", "link", "Link", genLINK, specNONE) /* UNIX */
+DEFNAME ("LLE", "lle", "LLe", genNONE, specLLE)
+DEFNAME ("LLT", "llt", "LLt", genNONE, specLLT)
+DEFNAME ("LNBLNK", "lnblnk", "LnBlnk", genNONE, specLNBLNK) /* UNIX */
+DEFNAME ("LOC", "loc", "Loc", genNONE, specLOC) /* VXT */
+DEFNAME ("LOG", "log", "Log", genNONE, specLOG)
+DEFNAME ("LOG10", "log10", "Log10", genNONE, specLOG10)
+DEFNAME ("LOGICAL", "logical", "Logical", genNONE, specLOGICAL) /* F90 */
+DEFNAME ("LONG", "long", "Long", genNONE, specLONG) /* UNIX */
+DEFNAME ("LSHIFT", "lshift", "LShift", genNONE, specLSHIFT) /* F2C */
+DEFNAME ("LSTAT", "lstat", "LStat", genLSTAT, specNONE) /* UNIX */
+DEFNAME ("LTIME", "ltime", "LTime", genNONE, specLTIME) /* UNIX */
+DEFNAME ("MATMUL", "matmul", "MatMul", genNONE, specMATMUL) /* F90 */
+DEFNAME ("MAX", "max", "Max", genNONE, specMAX)
+DEFNAME ("MAX0", "max0", "Max0", genNONE, specMAX0)
+DEFNAME ("MAX1", "max1", "Max1", genNONE, specMAX1)
+DEFNAME ("MAXEXPONENT", "maxexponent", "MaxExponent", genNONE, specMAXEXPONENT) /* F90 */
+DEFNAME ("MAXLOC", "maxloc", "MaxLoc", genNONE, specMAXLOC) /* F90 */
+DEFNAME ("MAXVAL", "maxval", "MaxVal", genNONE, specMAXVAL) /* F90 */
+DEFNAME ("MCLOCK", "mclock", "MClock", genNONE, specMCLOCK) /* UNIX */
+DEFNAME ("MCLOCK8", "mclock8", "MClock8", genNONE, specMCLOCK8) /* UNIX */
+DEFNAME ("MERGE", "merge", "Merge", genNONE, specMERGE) /* F90 */
+DEFNAME ("MIN", "min", "Min", genNONE, specMIN)
+DEFNAME ("MIN0", "min0", "Min0", genNONE, specMIN0)
+DEFNAME ("MIN1", "min1", "Min1", genNONE, specMIN1)
+DEFNAME ("MINEXPONENT", "minexponent", "MinExponent", genNONE, specMINEXPONENT) /* F90 */
+DEFNAME ("MINLOC", "minloc", "MinLoc", genNONE, specMINLOC) /* F90 */
+DEFNAME ("MINVAL", "minval", "MinVal", genNONE, specMINVAL) /* F90 */
+DEFNAME ("MOD", "mod", "Mod", genNONE, specMOD)
+DEFNAME ("MODULO", "modulo", "Modulo", genNONE, specMODULO) /* F90 */
+DEFNAME ("MVBITS", "mvbits", "MvBits", genNONE, specMVBITS) /* F90 */
+DEFNAME ("NEAREST", "nearest", "Nearest", genNONE, specNEAREST) /* F90 */
+DEFNAME ("NINT", "nint", "NInt", genNONE, specNINT)
+DEFNAME ("NOT", "not", "Not", genNONE, specNOT) /* F2C, F90, VXT */
+DEFNAME ("OR", "or", "Or", genNONE, specOR) /* F2C */
+DEFNAME ("PACK", "pack", "Pack", genNONE, specPACK) /* F90 */
+DEFNAME ("PERROR", "perror", "PError", genNONE, specPERROR) /* UNIX */
+DEFNAME ("PRECISION", "precision", "Precision", genNONE, specPRECISION) /* F90 */
+DEFNAME ("PRESENT", "present", "Present", genNONE, specPRESENT) /* F90 */
+DEFNAME ("PRODUCT", "product", "Product", genNONE, specPRODUCT) /* F90 */
+DEFNAME ("QABS", "qabs", "QAbs", genNONE, specQABS) /* VXT */
+DEFNAME ("QACOS", "qacos", "QACos", genNONE, specQACOS) /* VXT */
+DEFNAME ("QACOSD", "qacosd", "QACosD", genNONE, specQACOSD) /* VXT */
+DEFNAME ("QASIN", "qasin", "QASin", genNONE, specQASIN) /* VXT */
+DEFNAME ("QASIND", "qasind", "QASinD", genNONE, specQASIND) /* VXT */
+DEFNAME ("QATAN", "qatan", "QATan", genNONE, specQATAN) /* VXT */
+DEFNAME ("QATAN2", "qatan2", "QATan2", genNONE, specQATAN2) /* VXT */
+DEFNAME ("QATAN2D", "qatan2d", "QATan2D", genNONE, specQATAN2D) /* VXT */
+DEFNAME ("QATAND", "qatand", "QATanD", genNONE, specQATAND) /* VXT */
+DEFNAME ("QCOS", "qcos", "QCos", genNONE, specQCOS) /* VXT */
+DEFNAME ("QCOSD", "qcosd", "QCosD", genNONE, specQCOSD) /* VXT */
+DEFNAME ("QCOSH", "qcosh", "QCosH", genNONE, specQCOSH) /* VXT */
+DEFNAME ("QDIM", "qdim", "QDiM", genNONE, specQDIM) /* VXT */
+DEFNAME ("QEXP", "qexp", "QExp", genNONE, specQEXP) /* VXT */
+DEFNAME ("QEXT", "qext", "QExt", genNONE, specQEXT) /* VXT */
+DEFNAME ("QEXTD", "qextd", "QExtD", genNONE, specQEXTD) /* VXT */
+DEFNAME ("QFLOAT", "qfloat", "QFloat", genNONE, specQFLOAT) /* VXT */
+DEFNAME ("QINT", "qint", "QInt", genNONE, specQINT) /* VXT */
+DEFNAME ("QLOG", "qlog", "QLog", genNONE, specQLOG) /* VXT */
+DEFNAME ("QLOG10", "qlog10", "QLog10", genNONE, specQLOG10) /* VXT */
+DEFNAME ("QMAX1", "qmax1", "QMax1", genNONE, specQMAX1) /* VXT */
+DEFNAME ("QMIN1", "qmin1", "QMin1", genNONE, specQMIN1) /* VXT */
+DEFNAME ("QMOD", "qmod", "QMod", genNONE, specQMOD) /* VXT */
+DEFNAME ("QNINT", "qnint", "QNInt", genNONE, specQNINT) /* VXT */
+DEFNAME ("QSIN", "qsin", "QSin", genNONE, specQSIN) /* VXT */
+DEFNAME ("QSIND", "qsind", "QSinD", genNONE, specQSIND) /* VXT */
+DEFNAME ("QSINH", "qsinh", "QSinH", genNONE, specQSINH) /* VXT */
+DEFNAME ("QSQRT", "qsqrt", "QSqRt", genNONE, specQSQRT) /* VXT */
+DEFNAME ("QTAN", "qtan", "QTan", genNONE, specQTAN) /* VXT */
+DEFNAME ("QTAND", "qtand", "QTanD", genNONE, specQTAND) /* VXT */
+DEFNAME ("QTANH", "qtanh", "QTanH", genNONE, specQTANH) /* VXT */
+DEFNAME ("RADIX", "radix", "Radix", genNONE, specRADIX) /* F90 */
+DEFNAME ("RAND", "rand", "Rand", genNONE, specRAND) /* UNIX */
+DEFNAME ("RANDOM_NUMBER", "random_number", "Random_Number", genNONE, specRANDOM_NUMBER) /* F90 */
+DEFNAME ("RANDOM_SEED", "random_seed", "Random_Seed", genNONE, specRANDOM_SEED) /* F90 */
+DEFNAME ("RANGE", "range", "Range", genNONE, specRANGE) /* F90 */
+DEFNAME ("REAL", "real", "Real", genNONE, specREAL)
+DEFNAME ("REALPART", "realpart", "RealPart", genNONE, specREALPART) /* GNU */
+DEFNAME ("RENAME", "rename", "Rename", genRENAME, specNONE) /* UNIX */
+DEFNAME ("REPEAT", "repeat", "Repeat", genNONE, specREPEAT) /* F90 */
+DEFNAME ("RESHAPE", "reshape", "Reshape", genNONE, specRESHAPE) /* F90 */
+DEFNAME ("RRSPACING", "rrspacing", "RRSpacing", genNONE, specRRSPACING) /* F90 */
+DEFNAME ("RSHIFT", "rshift", "RShift", genNONE, specRSHIFT) /* F2C */
+DEFNAME ("SCALE", "scale", "Scale", genNONE, specSCALE) /* F90 */
+DEFNAME ("SCAN", "scan", "Scan", genNONE, specSCAN) /* F90 */
+DEFNAME ("SECNDS", "secnds", "Secnds", genNONE, specSECNDS) /* VXT */
+DEFNAME ("SECOND", "second", "Second", genSECOND, specNONE) /* UNIX */
+DEFNAME ("SELECTED_INT_KIND", "selected_int_kind", "Selected_Int_Kind", genNONE, specSEL_INT_KIND) /* F90 */
+DEFNAME ("SELECTED_REAL_KIND", "selected_real_kind", "Selected_Real_Kind", genNONE, specSEL_REAL_KIND) /* F90 */
+DEFNAME ("SET_EXPONENT", "set_exponent", "Set_Exponent", genNONE, specSET_EXPONENT) /* F90 */
+DEFNAME ("SHAPE", "shape", "Shape", genNONE, specSHAPE) /* F90 */
+DEFNAME ("SHORT", "short", "Short", genNONE, specSHORT) /* UNIX */
+DEFNAME ("SIGN", "sign", "Sign", genNONE, specSIGN)
+DEFNAME ("SIGNAL", "signal", "Signal", genSIGNAL, specNONE) /* UNIX */
+DEFNAME ("SIN", "sin", "Sin", genNONE, specSIN)
+DEFNAME ("SIND", "sind", "SinD", genNONE, specSIND) /* VXT */
+DEFNAME ("SINH", "sinh", "SinH", genNONE, specSINH)
+DEFNAME ("SLEEP", "sleep", "Sleep", genNONE, specSLEEP) /* UNIX */
+DEFNAME ("SNGL", "sngl", "Sngl", genNONE, specSNGL)
+DEFNAME ("SNGLQ", "snglq", "SnglQ", genNONE, specSNGLQ) /* VXT */
+DEFNAME ("SPACING", "spacing", "Spacing", genNONE, specSPACING) /* F90 */
+DEFNAME ("SPREAD", "spread", "Spread", genNONE, specSPREAD) /* F90 */
+DEFNAME ("SQRT", "sqrt", "SqRt", genNONE, specSQRT)
+DEFNAME ("SRAND", "srand", "SRand", genNONE, specSRAND) /* UNIX */
+DEFNAME ("STAT", "stat", "Stat", genSTAT, specNONE) /* UNIX */
+DEFNAME ("SUM", "sum", "Sum", genNONE, specSUM) /* F90 */
+DEFNAME ("SYMLNK", "symlnk", "SymLnk", genSYMLNK, specNONE) /* UNIX */
+DEFNAME ("SYSTEM", "system", "System", genSYSTEM, specNONE) /* UNIX */
+DEFNAME ("SYSTEM_CLOCK", "system_clock", "System_Clock", genNONE, specSYSTEM_CLOCK) /* F90 */
+DEFNAME ("TAN", "tan", "Tan", genNONE, specTAN)
+DEFNAME ("TAND", "tand", "TanD", genNONE, specTAND) /* VXT */
+DEFNAME ("TANH", "tanh", "TanH", genNONE, specTANH)
+DEFNAME ("TIME", "time", "Time", genTIME, specNONE) /* UNIX, VXT */
+DEFNAME ("TIME8", "time8", "Time8", genNONE, specTIME8) /* UNIX */
+DEFNAME ("TINY", "tiny", "Tiny", genNONE, specTINY) /* F90 */
+DEFNAME ("TRANSFER", "transfer", "Transfer", genNONE, specTRANSFER) /* F90 */
+DEFNAME ("TRANSPOSE", "transpose", "Transpose", genNONE, specTRANSPOSE) /* F90 */
+DEFNAME ("TRIM", "trim", "Trim", genNONE, specTRIM) /* F90 */
+DEFNAME ("TTYNAM", "ttynam", "TtyNam", genTTYNAM, specNONE) /* UNIX */
+DEFNAME ("UBOUND", "ubound", "UBound", genNONE, specUBOUND) /* F90 */
+DEFNAME ("UMASK", "umask", "UMask", genUMASK, specNONE) /* UNIX */
+DEFNAME ("UNLINK", "unlink", "Unlink", genUNLINK, specNONE) /* UNIX */
+DEFNAME ("UNPACK", "unpack", "Unpack", genNONE, specUNPACK) /* F90 */
+DEFNAME ("VERIFY", "verify", "Verify", genNONE, specVERIFY) /* F90 */
+DEFNAME ("XOR", "xor", "XOr", genNONE, specXOR) /* F2C */
+DEFNAME ("ZABS", "zabs", "ZAbs", genNONE, specZABS) /* F2C */
+DEFNAME ("ZCOS", "zcos", "ZCos", genNONE, specZCOS) /* F2C */
+DEFNAME ("ZEXP", "zexp", "ZExp", genNONE, specZEXP) /* F2C */
+DEFNAME ("ZEXT", "zext", "ZExt", genNONE, specZEXT) /* VXT */
+DEFNAME ("ZLOG", "zlog", "ZLog", genNONE, specZLOG) /* F2C */
+DEFNAME ("ZSIN", "zsin", "ZSin", genNONE, specZSIN) /* F2C */
+DEFNAME ("ZSQRT", "zsqrt", "ZSqRt", genNONE, specZSQRT) /* F2C */
+
+/* Internally generic intrinsics.
+
+ Should properly be called "mapped" intrinsics. These are intrinsics
+ that map to one or more generally different implementations -- e.g.
+ that have differing interpretations depending on the Fortran dialect
+ being used. Also, this includes the placeholder intrinsics that
+ have no specific versions, but we want to reserve the names for now. */
+
+DEFGEN (CTIME, "CTIME", /* UNIX */
+ FFEINTRIN_specCTIME_subr,
+ FFEINTRIN_specCTIME_func
+ )
+DEFGEN (CHDIR, "CHDIR", /* UNIX */
+ FFEINTRIN_specCHDIR_subr,
+ FFEINTRIN_specCHDIR_func
+ )
+DEFGEN (CHMOD, "CHMOD", /* UNIX */
+ FFEINTRIN_specCHMOD_subr,
+ FFEINTRIN_specCHMOD_func
+ )
+DEFGEN (DTIME, "DTIME", /* UNIX */
+ FFEINTRIN_specDTIME_subr,
+ FFEINTRIN_specDTIME_func
+ )
+DEFGEN (ETIME, "ETIME", /* UNIX */
+ FFEINTRIN_specETIME_subr,
+ FFEINTRIN_specETIME_func
+ )
+DEFGEN (FDATE, "FDATE", /* UNIX */
+ FFEINTRIN_specFDATE_subr,
+ FFEINTRIN_specFDATE_func
+ )
+DEFGEN (FGET, "FGET", /* UNIX */
+ FFEINTRIN_specFGET_subr,
+ FFEINTRIN_specFGET_func
+ )
+DEFGEN (FGETC, "FGETC", /* UNIX */
+ FFEINTRIN_specFGETC_subr,
+ FFEINTRIN_specFGETC_func
+ )
+DEFGEN (FPABSP, "FPABSP", /* F2C */
+ FFEINTRIN_specNONE,
+ FFEINTRIN_specNONE
+ )
+DEFGEN (FPEXPN, "FPEXPN", /* F2C */
+ FFEINTRIN_specNONE,
+ FFEINTRIN_specNONE
+ )
+DEFGEN (FPFRAC, "FPFRAC", /* F2C */
+ FFEINTRIN_specNONE,
+ FFEINTRIN_specNONE
+ )
+DEFGEN (FPMAKE, "FPMAKE", /* F2C */
+ FFEINTRIN_specNONE,
+ FFEINTRIN_specNONE
+ )
+DEFGEN (FPRRSP, "FPRRSP", /* F2C */
+ FFEINTRIN_specNONE,
+ FFEINTRIN_specNONE
+ )
+DEFGEN (FPSCAL, "FPSCAL", /* F2C */
+ FFEINTRIN_specNONE,
+ FFEINTRIN_specNONE
+ )
+DEFGEN (FPUT, "FPUT", /* UNIX */
+ FFEINTRIN_specFPUT_subr,
+ FFEINTRIN_specFPUT_func
+ )
+DEFGEN (FPUTC, "FPUTC", /* UNIX */
+ FFEINTRIN_specFPUTC_subr,
+ FFEINTRIN_specFPUTC_func
+ )
+DEFGEN (FSTAT, "FSTAT", /* UNIX */
+ FFEINTRIN_specFSTAT_subr,
+ FFEINTRIN_specFSTAT_func
+ )
+DEFGEN (FTELL, "FTELL", /* UNIX */
+ FFEINTRIN_specFTELL_subr,
+ FFEINTRIN_specFTELL_func
+ )
+DEFGEN (GETCWD, "GETCWD", /* UNIX */
+ FFEINTRIN_specGETCWD_subr,
+ FFEINTRIN_specGETCWD_func
+ )
+DEFGEN (HOSTNM, "HOSTNM", /* UNIX */
+ FFEINTRIN_specHOSTNM_subr,
+ FFEINTRIN_specHOSTNM_func
+ )
+DEFGEN (IDATE, "IDATE", /* UNIX/VXT */
+ FFEINTRIN_specIDATE_unix,
+ FFEINTRIN_specIDATE_vxt
+ )
+DEFGEN (KILL, "KILL", /* UNIX */
+ FFEINTRIN_specKILL_subr,
+ FFEINTRIN_specKILL_func
+ )
+DEFGEN (LINK, "LINK", /* UNIX */
+ FFEINTRIN_specLINK_subr,
+ FFEINTRIN_specLINK_func
+ )
+DEFGEN (LSTAT, "LSTAT", /* UNIX */
+ FFEINTRIN_specLSTAT_subr,
+ FFEINTRIN_specLSTAT_func
+ )
+DEFGEN (RENAME, "RENAME", /* UNIX */
+ FFEINTRIN_specRENAME_subr,
+ FFEINTRIN_specRENAME_func
+ )
+DEFGEN (SECOND, "SECOND", /* UNIX/CRAY */
+ FFEINTRIN_specSECOND_func,
+ FFEINTRIN_specSECOND_subr
+ )
+DEFGEN (SIGNAL, "SIGNAL", /* UNIX */
+ FFEINTRIN_specSIGNAL_subr,
+ FFEINTRIN_specSIGNAL_func
+ )
+DEFGEN (STAT, "STAT", /* UNIX */
+ FFEINTRIN_specSTAT_subr,
+ FFEINTRIN_specSTAT_func
+ )
+DEFGEN (SYMLNK, "SYMLNK", /* UNIX */
+ FFEINTRIN_specSYMLNK_subr,
+ FFEINTRIN_specSYMLNK_func
+ )
+DEFGEN (SYSTEM, "SYSTEM", /* UNIX */
+ FFEINTRIN_specSYSTEM_subr,
+ FFEINTRIN_specSYSTEM_func
+ )
+DEFGEN (TIME, "TIME", /* UNIX/VXT */
+ FFEINTRIN_specTIME_unix,
+ FFEINTRIN_specTIME_vxt
+ )
+DEFGEN (TTYNAM, "TTYNAM", /* UNIX/VXT */
+ FFEINTRIN_specTTYNAM_subr,
+ FFEINTRIN_specTTYNAM_func
+ )
+DEFGEN (UMASK, "UMASK", /* UNIX */
+ FFEINTRIN_specUMASK_subr,
+ FFEINTRIN_specUMASK_func
+ )
+DEFGEN (UNLINK, "UNLINK", /* UNIX */
+ FFEINTRIN_specUNLINK_subr,
+ FFEINTRIN_specUNLINK_func
+ )
+DEFGEN (NONE, "none",
+ FFEINTRIN_specNONE,
+ FFEINTRIN_specNONE
+ )
+
+/* Specific intrinsic information.
+
+ Currently this list starts with the list of F77-standard intrinsics
+ in alphabetical order, then continues with the list of all other
+ intrinsics.
+
+ The second boolean argument specifies whether the intrinsic is
+ allowed by the standard to be passed as an actual argument. */
+
+DEFSPEC (ABS,
+ "ABS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impABS
+ )
+DEFSPEC (ACOS,
+ "ACOS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impACOS
+ )
+DEFSPEC (AIMAG,
+ "AIMAG",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impAIMAG
+ )
+DEFSPEC (AINT,
+ "AINT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impAINT
+ )
+DEFSPEC (ALOG,
+ "ALOG",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impALOG
+ )
+DEFSPEC (ALOG10,
+ "ALOG10",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impALOG10
+ )
+DEFSPEC (AMAX0,
+ "AMAX0",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impAMAX0
+ )
+DEFSPEC (AMAX1,
+ "AMAX1",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impAMAX1
+ )
+DEFSPEC (AMIN0,
+ "AMIN0",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impAMIN0
+ )
+DEFSPEC (AMIN1,
+ "AMIN1",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impAMIN1
+ )
+DEFSPEC (AMOD,
+ "AMOD",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impAMOD
+ )
+DEFSPEC (ANINT,
+ "ANINT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impANINT
+ )
+DEFSPEC (ASIN,
+ "ASIN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impASIN
+ )
+DEFSPEC (ATAN,
+ "ATAN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impATAN
+ )
+DEFSPEC (ATAN2,
+ "ATAN2",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impATAN2
+ )
+DEFSPEC (CABS,
+ "CABS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCABS
+ )
+DEFSPEC (CCOS,
+ "CCOS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCCOS
+ )
+DEFSPEC (CEXP,
+ "CEXP",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCEXP
+ )
+DEFSPEC (CHAR,
+ "CHAR",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCHAR
+ )
+DEFSPEC (CLOG,
+ "CLOG",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCLOG
+ )
+DEFSPEC (CMPLX,
+ "CMPLX",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCMPLX
+ )
+DEFSPEC (CONJG,
+ "CONJG",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCONJG
+ )
+DEFSPEC (COS,
+ "COS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCOS
+ )
+DEFSPEC (COSH,
+ "COSH",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCOSH
+ )
+DEFSPEC (CSIN,
+ "CSIN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCSIN
+ )
+DEFSPEC (CSQRT,
+ "CSQRT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impCSQRT
+ )
+DEFSPEC (DABS,
+ "DABS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDABS
+ )
+DEFSPEC (DACOS,
+ "DACOS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDACOS
+ )
+DEFSPEC (DASIN,
+ "DASIN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDASIN
+ )
+DEFSPEC (DATAN,
+ "DATAN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDATAN
+ )
+DEFSPEC (DATAN2,
+ "DATAN2",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDATAN2
+ )
+DEFSPEC (DBLE,
+ "DBLE",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDBLE
+ )
+DEFSPEC (DCOS,
+ "DCOS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDCOS
+ )
+DEFSPEC (DCOSH,
+ "DCOSH",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDCOSH
+ )
+DEFSPEC (DDIM,
+ "DDIM",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDDIM
+ )
+DEFSPEC (DEXP,
+ "DEXP",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDEXP
+ )
+DEFSPEC (DIM,
+ "DIM",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDIM
+ )
+DEFSPEC (DINT,
+ "DINT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDINT
+ )
+DEFSPEC (DLOG,
+ "DLOG",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDLOG
+ )
+DEFSPEC (DLOG10,
+ "DLOG10",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDLOG10
+ )
+DEFSPEC (DMAX1,
+ "DMAX1",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDMAX1
+ )
+DEFSPEC (DMIN1,
+ "DMIN1",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDMIN1
+ )
+DEFSPEC (DMOD,
+ "DMOD",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDMOD
+ )
+DEFSPEC (DNINT,
+ "DNINT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDNINT
+ )
+DEFSPEC (DPROD,
+ "DPROD",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDPROD
+ )
+DEFSPEC (DSIGN,
+ "DSIGN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDSIGN
+ )
+DEFSPEC (DSIN,
+ "DSIN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDSIN
+ )
+DEFSPEC (DSINH,
+ "DSINH",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDSINH
+ )
+DEFSPEC (DSQRT,
+ "DSQRT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDSQRT
+ )
+DEFSPEC (DTAN,
+ "DTAN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDTAN
+ )
+DEFSPEC (DTANH,
+ "DTANH",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impDTANH
+ )
+DEFSPEC (EXP,
+ "EXP",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impEXP
+ )
+DEFSPEC (FLOAT,
+ "FLOAT",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impFLOAT
+ )
+DEFSPEC (IABS,
+ "IABS",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impIABS
+ )
+DEFSPEC (ICHAR,
+ "ICHAR",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impICHAR
+ )
+DEFSPEC (IDIM,
+ "IDIM",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impIDIM
+ )
+DEFSPEC (IDINT,
+ "IDINT",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impIDINT
+ )
+DEFSPEC (IDNINT,
+ "IDNINT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impIDNINT
+ )
+DEFSPEC (IFIX,
+ "IFIX",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impIFIX
+ )
+DEFSPEC (INDEX,
+ "INDEX",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impINDEX
+ )
+DEFSPEC (INT,
+ "INT",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impINT
+ )
+DEFSPEC (ISIGN,
+ "ISIGN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impISIGN
+ )
+DEFSPEC (LEN,
+ "LEN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impLEN
+ )
+DEFSPEC (LGE,
+ "LGE",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impLGE
+ )
+DEFSPEC (LGT,
+ "LGT",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impLGT
+ )
+DEFSPEC (LLE,
+ "LLE",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impLLE
+ )
+DEFSPEC (LLT,
+ "LLT",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impLLT
+ )
+DEFSPEC (LOG,
+ "LOG",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impLOG
+ )
+DEFSPEC (LOG10,
+ "LOG10",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impLOG10
+ )
+DEFSPEC (MAX,
+ "MAX",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impMAX
+ )
+DEFSPEC (MAX0,
+ "MAX0",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impMAX0
+ )
+DEFSPEC (MAX1,
+ "MAX1",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impMAX1
+ )
+DEFSPEC (MIN,
+ "MIN",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impMIN
+ )
+DEFSPEC (MIN0,
+ "MIN0",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impMIN0
+ )
+DEFSPEC (MIN1,
+ "MIN1",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impMIN1
+ )
+DEFSPEC (MOD,
+ "MOD",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impMOD
+ )
+DEFSPEC (NINT,
+ "NINT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impNINT
+ )
+DEFSPEC (REAL,
+ "REAL",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impREAL
+ )
+DEFSPEC (SIGN,
+ "SIGN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impSIGN
+ )
+DEFSPEC (SIN,
+ "SIN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impSIN
+ )
+DEFSPEC (SINH,
+ "SINH",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impSINH
+ )
+DEFSPEC (SNGL,
+ "SNGL",
+ FALSE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impSNGL
+ )
+DEFSPEC (SQRT,
+ "SQRT",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impSQRT
+ )
+DEFSPEC (TAN,
+ "TAN",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impTAN
+ )
+DEFSPEC (TANH,
+ "TANH",
+ TRUE,
+ FFEINTRIN_familyF77,
+ FFEINTRIN_impTANH
+ )
+
+DEFSPEC (ABORT,
+ "ABORT",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impABORT
+ )
+DEFSPEC (ACCESS,
+ "ACCESS",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impACCESS
+)
+DEFSPEC (ACHAR,
+ "ACHAR",
+ FALSE,
+ FFEINTRIN_familyASC,
+ FFEINTRIN_impACHAR
+ )
+DEFSPEC (ACOSD,
+ "ACOSD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ADJUSTL,
+ "ADJUSTL",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ADJUSTR,
+ "ADJUSTR",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (AIMAX0,
+ "AIMAX0",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (AIMIN0,
+ "AIMIN0",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (AJMAX0,
+ "AJMAX0",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (AJMIN0,
+ "AJMIN0",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ALARM,
+ "ALARM",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impALARM
+ )
+DEFSPEC (ALL,
+ "ALL",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ALLOCATED,
+ "ALLOCATED",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (AND,
+ "AND",
+ FALSE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impAND
+ )
+DEFSPEC (ANY,
+ "ANY",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ASIND,
+ "ASIND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ASSOCIATED,
+ "ASSOCIATED",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ATAN2D,
+ "ATAN2D",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ATAND,
+ "ATAND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (BESJ0,
+ "BESJ0",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impBESJ0
+)
+DEFSPEC (BESJ1,
+ "BESJ1",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impBESJ1
+)
+DEFSPEC (BESJN,
+ "BESJN",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impBESJN
+)
+DEFSPEC (BESY0,
+ "BESY0",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impBESY0
+)
+DEFSPEC (BESY1,
+ "BESY1",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impBESY1
+)
+DEFSPEC (BESYN,
+ "BESYN",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impBESYN
+)
+DEFSPEC (BIT_SIZE,
+ "BIT_SIZE",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impBIT_SIZE
+ )
+DEFSPEC (BITEST,
+ "BITEST",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (BJTEST,
+ "BJTEST",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (BTEST,
+ "BTEST",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impBTEST
+ )
+DEFSPEC (CDABS,
+ "CDABS",
+ TRUE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impCDABS
+ )
+DEFSPEC (CDCOS,
+ "CDCOS",
+ TRUE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impCDCOS
+ )
+DEFSPEC (CDEXP,
+ "CDEXP",
+ TRUE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impCDEXP
+ )
+DEFSPEC (CDLOG,
+ "CDLOG",
+ TRUE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impCDLOG
+ )
+DEFSPEC (CDSIN,
+ "CDSIN",
+ TRUE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impCDSIN
+ )
+DEFSPEC (CDSQRT,
+ "CDSQRT",
+ TRUE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impCDSQRT
+ )
+DEFSPEC (CEILING,
+ "CEILING",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (CHDIR_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impCHDIR_func
+)
+DEFSPEC (CHDIR_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impCHDIR_subr
+)
+DEFSPEC (CHMOD_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impCHMOD_func
+)
+DEFSPEC (CHMOD_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impCHMOD_subr
+)
+DEFSPEC (COMPLEX,
+ "COMPLEX",
+ FALSE,
+ FFEINTRIN_familyGNU,
+ FFEINTRIN_impCOMPLEX
+ )
+DEFSPEC (COSD,
+ "COSD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (COUNT,
+ "COUNT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (CSHIFT,
+ "CSHIFT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (CPU_TIME,
+ "CPU_TIME",
+ FALSE,
+ FFEINTRIN_familyF95,
+ FFEINTRIN_impCPU_TIME
+)
+DEFSPEC (CTIME_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impCTIME_func
+)
+DEFSPEC (CTIME_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impCTIME_subr
+)
+DEFSPEC (DACOSD,
+ "DACOSD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DASIND,
+ "DASIND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DATAN2D,
+ "DATAN2D",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DATAND,
+ "DATAND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DATE,
+ "DATE",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impDATE
+)
+DEFSPEC (DATE_AND_TIME,
+ "DATE_AND_TIME",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DBESJ0,
+ "DBESJ0",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDBESJ0
+)
+DEFSPEC (DBESJ1,
+ "DBESJ1",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDBESJ1
+)
+DEFSPEC (DBESJN,
+ "DBESJN",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDBESJN
+)
+DEFSPEC (DBESY0,
+ "DBESY0",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDBESY0
+)
+DEFSPEC (DBESY1,
+ "DBESY1",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDBESY1
+)
+DEFSPEC (DBESYN,
+ "DBESYN",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDBESYN
+)
+DEFSPEC (DBLEQ,
+ "DBLEQ",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DCMPLX,
+ "DCMPLX",
+ FALSE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impDCMPLX
+ )
+DEFSPEC (DCONJG,
+ "DCONJG",
+ TRUE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impDCONJG
+ )
+DEFSPEC (DCOSD,
+ "DCOSD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DERF,
+ "DERF",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDERF
+ )
+DEFSPEC (DERFC,
+ "DERFC",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDERFC
+ )
+DEFSPEC (DFLOAT,
+ "DFLOAT",
+ FALSE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impDFLOAT
+ )
+DEFSPEC (DFLOTI,
+ "DFLOTI",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DFLOTJ,
+ "DFLOTJ",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DIGITS,
+ "DIGITS",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DIMAG,
+ "DIMAG",
+ TRUE,
+ FFEINTRIN_familyFVZ,
+ FFEINTRIN_impDIMAG
+ )
+DEFSPEC (DOT_PRODUCT,
+ "DOT_PRODUCT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DREAL,
+ "DREAL",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impDREAL
+ )
+DEFSPEC (DSIND,
+ "DSIND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DTAND,
+ "DTAND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (DTIME_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impDTIME_func
+)
+DEFSPEC (DTIME_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impDTIME_subr
+)
+DEFSPEC (EOSHIFT,
+ "EOSHIFT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (EPSILON,
+ "EPSILON",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ERF,
+ "ERF",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impERF
+ )
+DEFSPEC (ERFC,
+ "ERFC",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impERFC
+ )
+DEFSPEC (ETIME_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impETIME_func
+)
+DEFSPEC (ETIME_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impETIME_subr
+)
+DEFSPEC (EXIT,
+ "EXIT",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impEXIT
+ )
+DEFSPEC (EXPONENT,
+ "EXPONENT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (FDATE_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFDATE_func
+)
+DEFSPEC (FDATE_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFDATE_subr
+)
+DEFSPEC (FGET_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impFGET_func
+)
+DEFSPEC (FGET_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFGET_subr
+)
+DEFSPEC (FGETC_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impFGETC_func
+)
+DEFSPEC (FGETC_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFGETC_subr
+)
+DEFSPEC (FLOATI,
+ "FLOATI",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (FLOATJ,
+ "FLOATJ",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (FLOOR,
+ "FLOOR",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (FLUSH,
+ "FLUSH",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFLUSH
+ )
+DEFSPEC (FNUM,
+ "FNUM",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFNUM
+)
+DEFSPEC (FPUT_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impFPUT_func
+)
+DEFSPEC (FPUT_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFPUT_subr
+)
+DEFSPEC (FPUTC_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impFPUTC_func
+)
+DEFSPEC (FPUTC_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFPUTC_subr
+)
+DEFSPEC (FRACTION,
+ "FRACTION",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (FSEEK,
+ "FSEEK",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFSEEK
+ )
+DEFSPEC (FSTAT_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFSTAT_func
+)
+DEFSPEC (FSTAT_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFSTAT_subr
+)
+DEFSPEC (FTELL_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFTELL_func
+ )
+DEFSPEC (FTELL_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impFTELL_subr
+ )
+DEFSPEC (GERROR,
+ "GERROR",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGERROR
+)
+DEFSPEC (GETARG,
+ "GETARG",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGETARG
+ )
+DEFSPEC (GETCWD_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGETCWD_func
+)
+DEFSPEC (GETCWD_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGETCWD_subr
+)
+DEFSPEC (GETENV,
+ "GETENV",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGETENV
+ )
+DEFSPEC (GETGID,
+ "GETGID",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGETGID
+)
+DEFSPEC (GETLOG,
+ "GETLOG",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGETLOG
+)
+DEFSPEC (GETPID,
+ "GETPID",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGETPID
+)
+DEFSPEC (GETUID,
+ "GETUID",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGETUID
+)
+DEFSPEC (GMTIME,
+ "GMTIME",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impGMTIME
+)
+DEFSPEC (HOSTNM_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impHOSTNM_func
+)
+DEFSPEC (HOSTNM_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impHOSTNM_subr
+)
+DEFSPEC (HUGE,
+ "HUGE",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IACHAR,
+ "IACHAR",
+ FALSE,
+ FFEINTRIN_familyASC,
+ FFEINTRIN_impIACHAR
+ )
+DEFSPEC (IAND,
+ "IAND",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impIAND
+ )
+DEFSPEC (IARGC,
+ "IARGC",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impIARGC
+ )
+DEFSPEC (IBCLR,
+ "IBCLR",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impIBCLR
+ )
+DEFSPEC (IBITS,
+ "IBITS",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impIBITS
+ )
+DEFSPEC (IBSET,
+ "IBSET",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impIBSET
+ )
+DEFSPEC (IDATE_unix,
+ "UNIX",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impIDATE_unix
+)
+DEFSPEC (IDATE_vxt,
+ "VXT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impIDATE_vxt
+)
+DEFSPEC (IEOR,
+ "IEOR",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impIEOR
+ )
+DEFSPEC (IERRNO,
+ "IERRNO",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impIERRNO
+)
+DEFSPEC (IIABS,
+ "IIABS",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIAND,
+ "IIAND",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIBCLR,
+ "IIBCLR",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIBITS,
+ "IIBITS",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIBSET,
+ "IIBSET",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIDIM,
+ "IIDIM",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIDINT,
+ "IIDINT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIDNNT,
+ "IIDNNT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIEOR,
+ "IIEOR",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIFIX,
+ "IIFIX",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IINT,
+ "IINT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIOR,
+ "IIOR",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIQINT,
+ "IIQINT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IIQNNT,
+ "IIQNNT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IISHFT,
+ "IISHFT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IISHFTC,
+ "IISHFTC",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IISIGN,
+ "IISIGN",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IMAG,
+ "IMAG",
+ FALSE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impIMAGPART
+ )
+DEFSPEC (IMAGPART,
+ "IMAGPART",
+ FALSE,
+ FFEINTRIN_familyGNU,
+ FFEINTRIN_impIMAGPART
+ )
+DEFSPEC (IMAX0,
+ "IMAX0",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IMAX1,
+ "IMAX1",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IMIN0,
+ "IMIN0",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IMIN1,
+ "IMIN1",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (IMOD,
+ "IMOD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ININT,
+ "ININT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (INOT,
+ "INOT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (INT2,
+ "INT2",
+ FALSE,
+ FFEINTRIN_familyGNU,
+ FFEINTRIN_impINT2
+ )
+DEFSPEC (INT8,
+ "INT8",
+ FALSE,
+ FFEINTRIN_familyGNU,
+ FFEINTRIN_impINT8
+ )
+DEFSPEC (IOR,
+ "IOR",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impIOR
+ )
+DEFSPEC (IRAND,
+ "IRAND",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impIRAND
+)
+DEFSPEC (ISATTY,
+ "ISATTY",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impISATTY
+)
+DEFSPEC (ISHFT,
+ "ISHFT",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impISHFT
+ )
+DEFSPEC (ISHFTC,
+ "ISHFTC",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impISHFTC
+ )
+DEFSPEC (ITIME,
+ "ITIME",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impITIME
+)
+DEFSPEC (IZEXT,
+ "IZEXT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIABS,
+ "JIABS",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIAND,
+ "JIAND",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIBCLR,
+ "JIBCLR",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIBITS,
+ "JIBITS",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIBSET,
+ "JIBSET",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIDIM,
+ "JIDIM",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIDINT,
+ "JIDINT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIDNNT,
+ "JIDNNT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIEOR,
+ "JIEOR",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIFIX,
+ "JIFIX",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JINT,
+ "JINT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIOR,
+ "JIOR",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIQINT,
+ "JIQINT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JIQNNT,
+ "JIQNNT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JISHFT,
+ "JISHFT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JISHFTC,
+ "JISHFTC",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JISIGN,
+ "JISIGN",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JMAX0,
+ "JMAX0",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JMAX1,
+ "JMAX1",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JMIN0,
+ "JMIN0",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JMIN1,
+ "JMIN1",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JMOD,
+ "JMOD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JNINT,
+ "JNINT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JNOT,
+ "JNOT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (JZEXT,
+ "JZEXT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (KILL_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impKILL_func
+)
+DEFSPEC (KILL_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impKILL_subr
+)
+DEFSPEC (KIND,
+ "KIND",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (LBOUND,
+ "LBOUND",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (LINK_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impLINK_func
+)
+DEFSPEC (LINK_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impLINK_subr
+)
+DEFSPEC (LEN_TRIM,
+ "LEN_TRIM",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impLNBLNK
+ )
+DEFSPEC (LNBLNK,
+ "LNBLNK",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impLNBLNK
+)
+DEFSPEC (LOC,
+ "LOC",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impLOC
+ )
+DEFSPEC (LOGICAL,
+ "LOGICAL",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (LONG,
+ "LONG",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impLONG
+ )
+DEFSPEC (LSHIFT,
+ "LSHIFT",
+ FALSE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impLSHIFT
+ )
+DEFSPEC (LSTAT_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impLSTAT_func
+)
+DEFSPEC (LSTAT_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impLSTAT_subr
+)
+DEFSPEC (LTIME,
+ "LTIME",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impLTIME
+)
+DEFSPEC (MATMUL,
+ "MATMUL",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MAXEXPONENT,
+ "MAXEXPONENT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MAXLOC,
+ "MAXLOC",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MAXVAL,
+ "MAXVAL",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MCLOCK,
+ "MCLOCK",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impMCLOCK
+)
+DEFSPEC (MCLOCK8,
+ "MCLOCK8",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impMCLOCK8
+)
+DEFSPEC (MERGE,
+ "MERGE",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MINEXPONENT,
+ "MINEXPONENT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MINLOC,
+ "MINLOC",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MINVAL,
+ "MINVAL",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MODULO,
+ "MODULO",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (MVBITS,
+ "MVBITS",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impMVBITS
+ )
+DEFSPEC (NEAREST,
+ "NEAREST",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (NOT,
+ "NOT",
+ FALSE,
+ FFEINTRIN_familyMIL,
+ FFEINTRIN_impNOT
+ )
+DEFSPEC (OR,
+ "OR",
+ FALSE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impOR
+ )
+DEFSPEC (PACK,
+ "PACK",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (PERROR,
+ "PERROR",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impPERROR
+)
+DEFSPEC (PRECISION,
+ "PRECISION",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (PRESENT,
+ "PRESENT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (PRODUCT,
+ "PRODUCT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QABS,
+ "QABS",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QACOS,
+ "QACOS",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QACOSD,
+ "QACOSD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QASIN,
+ "QASIN",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QASIND,
+ "QASIND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QATAN,
+ "QATAN",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QATAN2,
+ "QATAN2",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QATAN2D,
+ "QATAN2D",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QATAND,
+ "QATAND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QCOS,
+ "QCOS",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QCOSD,
+ "QCOSD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QCOSH,
+ "QCOSH",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QDIM,
+ "QDIM",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QEXP,
+ "QEXP",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QEXT,
+ "QEXT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QEXTD,
+ "QEXTD",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QFLOAT,
+ "QFLOAT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QINT,
+ "QINT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QLOG,
+ "QLOG",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QLOG10,
+ "QLOG10",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QMAX1,
+ "QMAX1",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QMIN1,
+ "QMIN1",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QMOD,
+ "QMOD",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QNINT,
+ "QNINT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QSIGN,
+ "QSIGN",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QSIN,
+ "QSIN",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QSIND,
+ "QSIND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QSINH,
+ "QSINH",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QSQRT,
+ "QSQRT",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QTAN,
+ "QTAN",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QTAND,
+ "QTAND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (QTANH,
+ "QTANH",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (RADIX,
+ "RADIX",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (RAND,
+ "RAND",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impRAND
+)
+DEFSPEC (RANDOM_NUMBER,
+ "RANDOM_NUMBER",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (RANDOM_SEED,
+ "RANDOM_SEED",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (RANGE,
+ "RANGE",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (REALPART,
+ "REALPART",
+ FALSE,
+ FFEINTRIN_familyGNU,
+ FFEINTRIN_impREALPART
+ )
+DEFSPEC (RENAME_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impRENAME_func
+)
+DEFSPEC (RENAME_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impRENAME_subr
+)
+DEFSPEC (REPEAT,
+ "REPEAT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (RESHAPE,
+ "RESHAPE",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (RRSPACING,
+ "RRSPACING",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (RSHIFT,
+ "RSHIFT",
+ FALSE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impRSHIFT
+ )
+DEFSPEC (SCALE,
+ "SCALE",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SCAN,
+ "SCAN",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SECNDS,
+ "SECNDS",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impSECNDS
+)
+DEFSPEC (SECOND_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSECOND_func
+)
+DEFSPEC (SECOND_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSECOND_subr
+)
+DEFSPEC (SEL_INT_KIND,
+ "SEL_INT_KIND",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SEL_REAL_KIND,
+ "SEL_REAL_KIND",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SET_EXPONENT,
+ "SET_EXPONENT",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SHAPE,
+ "SHAPE",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SHORT,
+ "SHORT",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSHORT
+ )
+DEFSPEC (SIGNAL_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impSIGNAL_func
+ )
+DEFSPEC (SIGNAL_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSIGNAL_subr
+ )
+DEFSPEC (SIND,
+ "SIND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SLEEP,
+ "SLEEP",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSLEEP
+)
+DEFSPEC (SNGLQ,
+ "SNGLQ",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SPACING,
+ "SPACING",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SPREAD,
+ "SPREAD",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SRAND,
+ "SRAND",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSRAND
+)
+DEFSPEC (STAT_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSTAT_func
+)
+DEFSPEC (STAT_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSTAT_subr
+)
+DEFSPEC (SUM,
+ "SUM",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (SYMLNK_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impSYMLNK_func
+)
+DEFSPEC (SYMLNK_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSYMLNK_subr
+)
+DEFSPEC (SYSTEM_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impSYSTEM_func
+ )
+DEFSPEC (SYSTEM_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impSYSTEM_subr
+ )
+DEFSPEC (SYSTEM_CLOCK,
+ "SYSTEM_CLOCK",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impSYSTEM_CLOCK
+ )
+DEFSPEC (TAND,
+ "TAND",
+ TRUE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (TIME8,
+ "UNIX",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impTIME8
+)
+DEFSPEC (TIME_unix,
+ "UNIX",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impTIME_unix
+)
+DEFSPEC (TIME_vxt,
+ "VXT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impTIME_vxt
+)
+DEFSPEC (TINY,
+ "TINY",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (TRANSFER,
+ "TRANSFER",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (TRANSPOSE,
+ "TRANSPOSE",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (TRIM,
+ "TRIM",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (TTYNAM_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impTTYNAM_func
+)
+DEFSPEC (TTYNAM_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impTTYNAM_subr
+)
+DEFSPEC (UBOUND,
+ "UBOUND",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (UMASK_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impUMASK_func
+)
+DEFSPEC (UMASK_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impUMASK_subr
+)
+DEFSPEC (UNLINK_func,
+ "function",
+ FALSE,
+ FFEINTRIN_familyBADU77,
+ FFEINTRIN_impUNLINK_func
+)
+DEFSPEC (UNLINK_subr,
+ "subroutine",
+ FALSE,
+ FFEINTRIN_familyF2U,
+ FFEINTRIN_impUNLINK_subr
+)
+DEFSPEC (UNPACK,
+ "UNPACK",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (VERIFY,
+ "VERIFY",
+ FALSE,
+ FFEINTRIN_familyF90,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (XOR,
+ "XOR",
+ FALSE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impXOR
+ )
+DEFSPEC (ZABS,
+ "ZABS",
+ TRUE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impCDABS
+ )
+DEFSPEC (ZCOS,
+ "ZCOS",
+ TRUE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impCDCOS
+ )
+DEFSPEC (ZEXP,
+ "ZEXP",
+ TRUE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impCDEXP
+ )
+DEFSPEC (ZEXT,
+ "ZEXT",
+ FALSE,
+ FFEINTRIN_familyVXT,
+ FFEINTRIN_impNONE
+ )
+DEFSPEC (ZLOG,
+ "ZLOG",
+ TRUE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impCDLOG
+ )
+DEFSPEC (ZSIN,
+ "ZSIN",
+ TRUE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impCDSIN
+ )
+DEFSPEC (ZSQRT,
+ "ZSQRT",
+ TRUE,
+ FFEINTRIN_familyF2C,
+ FFEINTRIN_impCDSQRT
+ )
+DEFSPEC (NONE,
+ "none",
+ FALSE,
+ FFEINTRIN_familyNONE,
+ FFEINTRIN_impNONE
+ )
+
+/* Intrinsic implementations ordered in two sections:
+ F77, then extensions; secondarily, alphabetical
+ ordering. */
+
+/* The DEFIMP macro specifies the following fields for an intrinsic:
+
+ CODE -- The internal name for this intrinsic; `FFEINTRIN_imp'
+ prepends this to form the `enum' name.
+
+ NAME -- The textual name to use when printing information on
+ this intrinsic.
+
+ GFRTDIRECT -- The run-time library routine that is suitable for
+ a call to implement a *direct* invocation of the
+ intrinsic (e.g. `ABS(10)').
+
+ GFRTF2C -- The run-time library routine that is suitable for
+ passing as an argument to a procedure that will
+ invoke the argument as an EXTERNAL procedure, when
+ f2c calling conventions will be used (e.g.
+ `CALL FOO(ABS)', when FOO compiled with -ff2c).
+
+ GFRTGNU -- The run-time library routine that is suitable for
+ passing as an argument to a procedure that will
+ invoke the argument as an EXTERNAL procedure, when
+ GNU calling conventions will be used (e.g.
+ `CALL FOO(ABS)', when FOO compiled with -fno-f2c).
+
+ CONTROL -- A control string, described below.
+
+*/
+
+/* The control string has the following format:
+
+ <return-type>:<arglist-info>:[<argitem-info>,...]
+
+ <return-type> is:
+
+ <return-base-type><return-kind-type>[<return-modifier>]
+
+ <return-base-type> is:
+
+ - Subroutine
+ A Character
+ C Complex
+ I Integer
+ L Logical
+ R Real
+ B Boolean (I or L), decided by co-operand list (COL)
+ F Floating-point (C or R), decided by COL
+ N Numeric (C, I, or R), decided by co-operand list (COL)
+ S Scalar numeric (I or R), decided by COL, which may be COMPLEX
+
+ <return-kind-type> is:
+
+ - Subroutine
+ = Decided by COL
+ 1 (Default)
+ 2 (Twice the size of 1)
+ 3 (Same size as CHARACTER*1)
+ 4 (Twice the size of 2)
+ 6 (Twice the size as 3)
+ C Like 1 (F77), except (F90), if COL is COMPLEX, uses kind type of COL
+ p ffecom_pointer_kind_
+
+ <return-modifier> is:
+
+ * Valid for <return-base-type> of `A' only, means program may
+ declare any length for return value, default being (*)
+
+ <arglist-info> is:
+
+ <COL-spec>
+
+ <COL-spec> is:
+
+ - No COL (return-base-type and return-kind-type must be definitive)
+ * All arguments form COL (must have more than one argument)
+ n Argument n (0 for first arg, 1 for second, etc.) forms COL
+
+ <argitem-info> is:
+
+ <name>=[<optionality>]<arg-base-type><arg-kind-type>[<arg-len>][<arg-rank>][<arg-extra>]
+
+ <name> is the standard keyword name for the argument.
+
+ <optionality> is:
+
+ ? Argument is optional
+ ! Like ?, but argument must be omitted if previous arg was COMPLEX
+ + One or more of these arguments must be specified
+ * Zero or more of these arguments must be specified
+ n Numbered names for arguments, one or more must be specified
+ p Like n, but two or more must be specified
+
+ <arg-base-type> is:
+
+ - Any is valid (arg-kind-type is 0)
+ A Character*(*)
+ C Complex
+ I Integer
+ L Logical
+ R Real
+ B Boolean (I or L)
+ F Floating-point (C or R)
+ N Numeric (C, I, or R)
+ S Scalar numeric (I or R)
+ g GOTO label (alternate-return form of CALL) (arg-kind-type is 0)
+ s Signal handler (INTEGER FUNCTION, SUBROUTINE or dummy/global
+ default INTEGER variable) (arg-kind-type is 0)
+
+ <arg-kind-type> is:
+
+ * Any is valid
+ 1 (Default)
+ 2 (Twice the size of 1)
+ 3 (Same size as CHARACTER*1)
+ 4 (Twice the size of 2)
+ 6 (Twice the size as 3)
+ A Same as first argument
+
+ <arg-len> is:
+
+ (Default) CHARACTER*(*)
+ [n] CHARACTER*n
+
+ <arg-rank> is:
+
+ (default) Rank-0 (variable or array element)
+ (n) Rank-1 array n elements long
+ & Any (arg-extra is &)
+
+ <arg-extra> is:
+
+ (default) Arg is INTENT(IN)
+ i Arg's attributes are all that matter (inquiry function)
+ w Arg is INTENT(OUT)
+ x Arg is INTENT(INOUT)
+ & Arg can have its address taken (LOC(), for example)
+
+*/
+
+DEFIMP (ABS, "ABS", ,ABS,, "S=:0:A=N*")
+DEFIMP (ACOS, "ACOS", L_ACOS,ACOS,, "R=:0:X=R*")
+DEFIMP (AIMAG, "AIMAG", ,AIMAG,, "RC:0:Z=C*")
+DEFIMP (AINT, "AINT", ,AINT,, "R=:0:A=R*")
+DEFIMP (ALOG, "ALOG", L_LOG,ALOG,, "R1:-:X=R1")
+DEFIMP (ALOG10, "ALOG10", ,ALOG10,, "R1:-:X=R1")
+DEFIMP (AMAX0, "AMAX0", ,,, "R1:*:A=pI1")
+DEFIMP (AMAX1, "AMAX1", ,,, "R1:*:A=pR1")
+DEFIMP (AMIN0, "AMIN0", ,,, "R1:*:A=pI1")
+DEFIMP (AMIN1, "AMIN1", ,,, "R1:*:A=pR1")
+DEFIMP (AMOD, "AMOD", ,AMOD,, "R1:*:A=R1,P=R1")
+DEFIMP (ANINT, "ANINT", ,ANINT,, "R=:0:A=R*")
+DEFIMP (ASIN, "ASIN", L_ASIN,ASIN,, "R=:0:X=R*")
+DEFIMP (ATAN, "ATAN", L_ATAN,ATAN,, "R=:0:X=R*")
+DEFIMP (ATAN2, "ATAN2", L_ATAN2,ATAN2,, "R=:*:Y=R*,X=R*")
+DEFIMP (CABS, "CABS", ,CABS,, "R1:-:A=C1")
+DEFIMP (CCOS, "CCOS", ,CCOS,, "C1:-:X=C1")
+DEFIMP (CEXP, "CEXP", ,CEXP,, "C1:-:X=C1")
+DEFIMP (CHAR, "CHAR", ,,, "A1:-:I=I*")
+DEFIMP (CLOG, "CLOG", ,CLOG,, "C1:-:X=C1")
+DEFIMP (CMPLX, "CMPLX", ,,, "C1:*:X=N*,Y=!S*")
+DEFIMP (CONJG, "CONJG", ,CONJG,, "C=:0:Z=C*")
+DEFIMP (COS, "COS", L_COS,COS,, "F=:0:X=F*")
+DEFIMP (COSH, "COSH", L_COSH,COSH,, "R=:0:X=R*")
+DEFIMP (CSIN, "CSIN", ,CSIN,, "C1:-:X=C1")
+DEFIMP (CSQRT, "CSQRT", ,CSQRT,, "C1:-:X=C1")
+DEFIMP (DABS, "DABS", ,DABS,, "R2:-:A=R2")
+DEFIMP (DACOS, "DACOS", L_ACOS,DACOS,, "R2:-:X=R2")
+DEFIMP (DASIN, "DASIN", L_ASIN,DASIN,, "R2:-:X=R2")
+DEFIMP (DATAN, "DATAN", L_ATAN,DATAN,, "R2:-:X=R2")
+DEFIMP (DATAN2, "DATAN2", L_ATAN2,DATAN2,,"R2:*:Y=R2,X=R2")
+DEFIMP (DBLE, "DBLE", ,,, "R2:-:A=N*")
+DEFIMP (DCMPLX, "DCMPLX", ,,, "C2:*:X=N*,Y=!S*")
+DEFIMP (DCOS, "DCOS", L_COS,DCOS,, "R2:-:X=R2")
+DEFIMP (DCOSH, "DCOSH", L_COSH,DCOSH,, "R2:-:X=R2")
+DEFIMP (DDIM, "DDIM", ,DDIM,, "R2:*:X=R2,Y=R2")
+DEFIMP (DEXP, "DEXP", L_EXP,DEXP,, "R2:-:X=R2")
+DEFIMP (DIM, "DIM", ,DIM,, "S=:*:X=S*,Y=S*")
+DEFIMP (DINT, "DINT", ,DINT,, "R2:-:A=R2")
+DEFIMP (DLOG, "DLOG", L_LOG,DLOG,, "R2:-:X=R2")
+DEFIMP (DLOG10, "DLOG10", ,DLOG10,, "R2:-:X=R2")
+DEFIMP (DMAX1, "DMAX1", ,,, "R2:*:A=pR2")
+DEFIMP (DMIN1, "DMIN1", ,,, "R2:*:A=pR2")
+DEFIMP (DMOD, "DMOD", ,DMOD,, "R2:*:A=R2,P=R2")
+DEFIMP (DNINT, "DNINT", ,DNINT,, "R2:-:A=R2")
+DEFIMP (DPROD, "DPROD", ,DPROD,, "R2:*:X=R1,Y=R1")
+DEFIMP (DSIGN, "DSIGN", ,DSIGN,, "R2:*:A=R2,B=R2")
+DEFIMP (DSIN, "DSIN", L_SIN,DSIN,, "R2:-:X=R2")
+DEFIMP (DSINH, "DSINH", L_SINH,DSINH,, "R2:-:X=R2")
+DEFIMP (DSQRT, "DSQRT", L_SQRT,DSQRT,, "R2:-:X=R2")
+DEFIMP (DTAN, "DTAN", L_TAN,DTAN,, "R2:-:X=R2")
+DEFIMP (DTANH, "DTANH", L_TANH,DTANH,, "R2:-:X=R2")
+DEFIMP (EXP, "EXP", L_EXP,EXP,, "F=:0:X=F*")
+DEFIMP (FLOAT, "FLOAT", ,,, "R1:-:A=I*")
+DEFIMP (IABS, "IABS", ,IABS,IABS, "I1:-:A=I1")
+DEFIMP (ICHAR, "ICHAR", ,,, "I1:-:C=A*")
+DEFIMP (IDIM, "IDIM", ,IDIM,IDIM, "I1:*:X=I1,Y=I1")
+DEFIMP (IDINT, "IDINT", ,,, "I1:-:A=R2")
+DEFIMP (IDNINT, "IDNINT", ,IDNINT,IDNINT, "I1:-:A=R2")
+DEFIMP (IFIX, "IFIX", ,,, "I1:-:A=R1")
+DEFIMP (INDEX, "INDEX", ,INDEX,INDEX, "I1:*:String=A*,Substring=A*")
+DEFIMP (INT, "INT", ,,, "I1:-:A=N*")
+DEFIMP (ISIGN, "ISIGN", ,ISIGN,ISIGN, "I1:*:A=I1,B=I1")
+DEFIMP (LEN, "LEN", ,LEN,LEN, "I1:-:String=A*i")
+DEFIMP (LGE, "LGE", ,LGE,LGE, "L1:*:String_A=A1,String_B=A1")
+DEFIMP (LGT, "LGT", ,LGT,LGT, "L1:*:String_A=A1,String_B=A1")
+DEFIMP (LLE, "LLE", ,LLE,LLE, "L1:*:String_A=A1,String_B=A1")
+DEFIMP (LLT, "LLT", ,LLT,LLT, "L1:*:String_A=A1,String_B=A1")
+DEFIMP (LOG, "LOG", L_LOG,ALOG,, "F=:0:X=F*")
+DEFIMP (LOG10, "LOG10", ,,, "R=:0:X=R*")
+DEFIMP (MAX, "MAX", ,,, "S=:*:A=pS*")
+DEFIMP (MIN, "MIN", ,,, "S=:*:A=pS*")
+DEFIMP (MAX0, "MAX0", ,,, "I1:*:A=pI1")
+DEFIMP (MAX1, "MAX1", ,,, "I1:*:A=pR1")
+DEFIMP (MIN0, "MIN0", ,,, "I1:*:A=pI1")
+DEFIMP (MIN1, "MIN1", ,,, "I1:*:A=pR1")
+DEFIMP (MOD, "MOD", ,MOD,MOD, "S=:*:A=S*,P=S*")
+DEFIMP (NINT, "NINT", ,NINT,NINT, "I1:-:A=R*")
+DEFIMP (REAL, "REAL", ,,, "RC:0:A=N*")
+DEFIMP (SIGN, "SIGN", ,SIGN,, "S=:*:A=S*,B=S*")
+DEFIMP (SIN, "SIN", L_SIN,SIN,, "F=:0:X=F*")
+DEFIMP (SINH, "SINH", L_SINH,SINH,, "R=:0:X=R*")
+DEFIMP (SNGL, "SNGL", ,,, "R1:-:A=R2")
+DEFIMP (SQRT, "SQRT", L_SQRT,SQRT,, "F=:0:X=F*")
+DEFIMP (TAN, "TAN", L_TAN,TAN,, "R=:0:X=R*")
+DEFIMP (TANH, "TANH", L_TANH,TANH,, "R=:0:X=R*")
+
+DEFIMP (ABORT, "ABORT", ABORT,,, "--:-:")
+DEFIMP (ACCESS, "ACCESS", ACCESS,,, "I1:-:Name=A1,Mode=A1")
+DEFIMP (ACHAR, "ACHAR", ,,, "A1:-:I=I*")
+DEFIMP (ALARM, "ALARM", ALARM,,, "--:-:Seconds=I*,Handler=s*,Status=?I1w")
+DEFIMP (AND, "AND", ,,, "B=:*:I=B*,J=B*")
+DEFIMP (BESJ0, "BESJ0", L_BESJ0,,, "R=:0:X=R*")
+DEFIMP (BESJ1, "BESJ1", L_BESJ1,,, "R=:0:X=R*")
+DEFIMP (BESJN, "BESJN", L_BESJN,,, "R=:1:N=I*,X=R*")
+DEFIMP (BESY0, "BESY0", L_BESY0,,, "R=:0:X=R*")
+DEFIMP (BESY1, "BESY1", L_BESY1,,, "R=:0:X=R*")
+DEFIMP (BESYN, "BESYN", L_BESYN,,, "R=:1:N=I*,X=R*")
+DEFIMP (BIT_SIZE, "BIT_SIZE", ,,, "I=:0:I=I*i")
+DEFIMP (BTEST, "BTEST", ,,, "L1:*:I=I*,Pos=I*")
+DEFIMP (CDABS, "CDABS", ,CDABS,, "R2:-:A=C2")
+DEFIMP (CDCOS, "CDCOS", ,CDCOS,, "C2:-:X=C2")
+DEFIMP (CDEXP, "CDEXP", ,CDEXP,, "C2:-:X=C2")
+DEFIMP (CDLOG, "CDLOG", ,CDLOG,, "C2:-:X=C2")
+DEFIMP (CDSIN, "CDSIN", ,CDSIN,, "C2:-:X=C2")
+DEFIMP (CDSQRT, "CDSQRT", ,CDSQRT,, "C2:-:X=C2")
+DEFIMP (CHDIR_func, "CHDIR_func", CHDIR,,, "I1:-:Dir=A1")
+DEFIMP (CHDIR_subr, "CHDIR_subr", CHDIR,,, "--:-:Dir=A1,Status=?I1w")
+DEFIMP (CHMOD_func, "CHMOD_func", CHMOD,,, "I1:-:Name=A1,Mode=A1")
+DEFIMP (CHMOD_subr, "CHMOD_subr", CHMOD,,, "--:-:Name=A1,Mode=A1,Status=?I1w")
+DEFIMP (COMPLEX, "COMPLEX", ,,, "C=:*:Real=S*,Imag=S*")
+DEFIMP (CPU_TIME, "CPU_TIME", ,,, "--:-:Seconds=R1w")
+DEFIMP (CTIME_func, "CTIME_func", CTIME,,, "A1*:-:STime=I*")
+DEFIMP (CTIME_subr, "CTIME_subr", CTIME,,, "--:-:Result=A1w,STime=I*")
+DEFIMP (DATE, "DATE", DATE,,, "--:-:Date=A1w")
+DEFIMP (DBESJ0, "DBESJ0", L_BESJ0,,, "R2:-:X=R2")
+DEFIMP (DBESJ1, "DBESJ1", L_BESJ1,,, "R2:-:X=R2")
+DEFIMP (DBESJN, "DBESJN", L_BESJN,,, "R2:-:N=I*,X=R2")
+DEFIMP (DBESY0, "DBESY0", L_BESY0,,, "R2:-:X=R2")
+DEFIMP (DBESY1, "DBESY1", L_BESY1,,, "R2:-:X=R2")
+DEFIMP (DBESYN, "DBESYN", L_BESYN,,, "R2:-:N=I*,X=R2")
+DEFIMP (DCONJG, "DCONJG", ,DCONJG,, "C2:-:Z=C2")
+DEFIMP (DERF, "DERF", L_ERF,DERF,, "R2:-:X=R2")
+DEFIMP (DERFC, "DERFC", L_ERFC,DERFC,, "R2:-:X=R2")
+DEFIMP (DFLOAT, "DFLOAT", ,,, "R2:-:A=I*")
+DEFIMP (DIMAG, "DIMAG", ,DIMAG,, "R2:-:Z=C2")
+DEFIMP (DREAL, "DREAL", ,,, "R2:-:A=N*")
+DEFIMP (DTIME_func, "DTIME_func", DTIME,,, "R1:-:TArray=R1(2)w")
+DEFIMP (DTIME_subr, "DTIME_subr", DTIME,,, "--:-:Result=R1w,TArray=R1(2)w")
+DEFIMP (ERF, "ERF", L_ERF,ERF,, "R=:0:X=R*")
+DEFIMP (ERFC, "ERFC", L_ERFC,ERFC,, "R=:0:X=R*")
+DEFIMP (ETIME_func, "ETIME_func", ETIME,,, "R1:-:TArray=R1(2)w")
+DEFIMP (ETIME_subr, "ETIME_subr", ETIME,,, "--:-:Result=R1w,TArray=R1(2)w")
+DEFIMP (EXIT, "EXIT", EXIT,,, "--:-:Status=?I*")
+DEFIMP (FDATE_func, "FDATE_func", FDATE,,, "A1*:-:")
+DEFIMP (FDATE_subr, "FDATE_subr", FDATE,,, "--:-:Date=A1w")
+DEFIMP (FGET_func, "FGET_func", FGET,,, "I1:-:C=A1w")
+DEFIMP (FGET_subr, "FGET_subr", FGET,,, "--:-:C=A1w,Status=?I1w")
+DEFIMP (FGETC_func, "FGETC_func", FGETC,,, "I1:-:Unit=I*,C=A1w")
+DEFIMP (FGETC_subr, "FGETC_subr", FGETC,,, "--:-:Unit=I*,C=A1w,Status=?I1w")
+DEFIMP (FLUSH, "FLUSH", ,,, "--:-:Unit=?I*")
+DEFIMP (FNUM, "FNUM", FNUM,,, "I1:-:Unit=I*")
+DEFIMP (FPUT_func, "FPUT_func", FPUT,,, "I1:-:C=A1")
+DEFIMP (FPUT_subr, "FPUT_subr", FPUT,,, "--:-:C=A1,Status=?I1w")
+DEFIMP (FPUTC_func, "FPUTC_func", FPUTC,,, "I1:-:Unit=I*,C=A1")
+DEFIMP (FPUTC_subr, "FPUTC_subr", FPUTC,,, "--:-:Unit=I*,C=A1,Status=?I1w")
+DEFIMP (FSEEK, "FSEEK", FSEEK,,, "--:-:Unit=I*,Offset=I*,Whence=I*,ErrLab=?g*")
+DEFIMP (FSTAT_func, "FSTAT_func", FSTAT,,, "I1:-:Unit=I*,SArray=I1(13)w")
+DEFIMP (FSTAT_subr, "FSTAT_subr", FSTAT,,, "--:-:Unit=I*,SArray=I1(13)w,Status=?I1w")
+DEFIMP (FTELL_func, "FTELL_func", FTELL,,, "I1:-:Unit=I*")
+DEFIMP (FTELL_subr, "FTELL_subr", FTELL,,, "--:-:Unit=I*,Offset=I1w")
+DEFIMP (GERROR, "GERROR", GERROR,,, "--:-:Message=A1w")
+DEFIMP (GETARG, "GETARG", GETARG,,, "--:-:Pos=I*,Value=A1w")
+DEFIMP (GETCWD_func, "GETCWD_func", GETCWD,,, "I1:-:Name=A1w")
+DEFIMP (GETCWD_subr, "GETCWD_subr", GETCWD,,, "--:-:Name=A1w,Status=?I1w")
+DEFIMP (GETGID, "GETGID", GETGID,,, "I1:-:")
+DEFIMP (GETLOG, "GETLOG", GETLOG,,, "--:-:Login=A1w")
+DEFIMP (GETPID, "GETPID", GETPID,,, "I1:-:")
+DEFIMP (GETUID, "GETUID", GETUID,,, "I1:-:")
+DEFIMP (GETENV, "GETENV", GETENV,,, "--:-:Name=A1,Value=A1w")
+DEFIMP (GMTIME, "GMTIME", GMTIME,,, "--:-:STime=I1,TArray=I1(9)w")
+DEFIMP (HOSTNM_func, "HOSTNM_func", HOSTNM,,, "I1:-:Name=A1w")
+DEFIMP (HOSTNM_subr, "HOSTNM_subr", HOSTNM,,, "--:-:Name=A1w,Status=?I1w")
+DEFIMP (IACHAR, "IACHAR", ,,, "I1:-:C=A*")
+DEFIMP (IAND, "IAND", ,,, "I=:*:I=I*,J=I*")
+DEFIMP (IARGC, "IARGC", IARGC,,, "I1:-:")
+DEFIMP (IBCLR, "IBCLR", ,,, "I=:0:I=I*,Pos=I*")
+DEFIMP (IBITS, "IBITS", ,,, "I=:0:I=I*,Pos=I*,Len=I*")
+DEFIMP (IBSET, "IBSET", ,,, "I=:0:I=I*,Pos=I*")
+DEFIMP (IDATE_unix, "IDATE_unix", IDATE,,, "--:-:TArray=I1(3)w")
+DEFIMP (IDATE_vxt, "IDATE_vxt", VXTIDATE,,, "--:-:M=I1w,D=I1w,Y=I1w")
+DEFIMP (IEOR, "IEOR", ,,, "I=:*:I=I*,J=I*")
+DEFIMP (IOR, "IOR", ,,, "I=:*:I=I*,J=I*")
+DEFIMP (IERRNO, "IERRNO", IERRNO,,, "I1:-:")
+DEFIMP (IMAGPART, "IMAGPART", ,,, "R=:0:Z=C*")
+DEFIMP (INT2, "INT2", ,,, "I6:-:A=I*")
+DEFIMP (INT8, "INT8", ,,, "I2:-:A=I*")
+DEFIMP (IRAND, "IRAND", IRAND,,, "I1:-:Flag=?I*")
+DEFIMP (ISATTY, "ISATTY", ISATTY,,, "L1:-:Unit=I*")
+DEFIMP (ISHFT, "ISHFT", ,,, "I=:0:I=I*,Shift=I*")
+DEFIMP (ISHFTC, "ISHFTC", ,,, "I=:0:I=I*,Shift=I*,Size=I*")
+DEFIMP (ITIME, "ITIME", ITIME,,, "--:-:TArray=I1(3)w")
+DEFIMP (KILL_func, "KILL_func", KILL,,, "I1:-:Pid=I*,Signal=I*")
+DEFIMP (KILL_subr, "KILL_subr", KILL,,, "--:-:Pid=I*,Signal=I*,Status=?I1w")
+DEFIMP (LINK_func, "LINK_func", LINK,,, "I1:-:Path1=A1,Path2=A1")
+DEFIMP (LINK_subr, "LINK_subr", LINK,,, "--:-:Path1=A1,Path2=A1,Status=?I1w")
+DEFIMP (LNBLNK, "LNBLNK", LNBLNK,,, "I1:-:String=A1")
+DEFIMP (LONG, "LONG", ,,, "I1:-:A=I6")
+DEFIMP (LSTAT_func, "LSTAT_func", LSTAT,,, "I1:-:File=A1,SArray=I1(13)w")
+DEFIMP (LSTAT_subr, "LSTAT_subr", LSTAT,,, "--:-:File=A1,SArray=I1(13)w,Status=?I1w")
+DEFIMP (LTIME, "LTIME", LTIME,,, "--:-:STime=I1,TArray=I1(9)w")
+DEFIMP (LOC, "LOC", ,,, "Ip:-:Entity=-*&&")
+DEFIMP (LSHIFT, "LSHIFT", ,,, "I=:0:I=I*,Shift=I*")
+DEFIMP (MCLOCK, "MCLOCK", MCLOCK,,, "I1:-:")
+DEFIMP (MCLOCK8, "MCLOCK8", MCLOCK,,, "I2:-:")
+DEFIMP (MVBITS, "MVBITS", ,,, "--:-:From=I*,FromPos=I*,Len=I*,TO=IAx,ToPos=I*")
+DEFIMP (NOT, "NOT", ,,, "I=:0:I=I*")
+DEFIMP (OR, "OR", ,,, "B=:*:I=B*,J=B*")
+DEFIMP (PERROR, "PERROR", PERROR,,, "--:-:String=A1")
+DEFIMP (RAND, "RAND", RAND,,, "R1:-:Flag=?I*")
+DEFIMP (REALPART, "REALPART", ,,, "R=:0:Z=C*")
+DEFIMP (RENAME_func, "RENAME_func", RENAME,,, "I1:-:Path1=A1,Path2=A1")
+DEFIMP (RENAME_subr, "RENAME_subr", RENAME,,, "--:-:Path1=A1,Path2=A1,Status=?I1w")
+DEFIMP (RSHIFT, "RSHIFT", ,,, "I=:0:I=I*,Shift=I*")
+DEFIMP (SECNDS, "SECNDS", SECNDS,,, "R1:-:T=R1")
+DEFIMP (SECOND_func, "SECOND_func", SECOND,SECOND,, "R1:-:")
+DEFIMP (SECOND_subr, "SECOND_subr", SECOND,,, "--:-:Seconds=R1w")
+DEFIMP (SHORT, "SHORT", ,,, "I6:-:A=I*")
+DEFIMP (SIGNAL_func, "SIGNAL_func", L_SIGNAL,,, "I1:-:Number=I*,Handler=s*")
+DEFIMP (SIGNAL_subr, "SIGNAL_subr", L_SIGNAL,,, "--:-:Number=I*,Handler=s*,Status=?I1w")
+DEFIMP (SLEEP, "SLEEP", SLEEP,,, "--:-:Seconds=I1")
+DEFIMP (SRAND, "SRAND", SRAND,,, "--:-:Seed=I*")
+DEFIMP (STAT_func, "STAT_func", STAT,,, "I1:-:File=A1,SArray=I1(13)w")
+DEFIMP (STAT_subr, "STAT_subr", STAT,,, "--:-:File=A1,SArray=I1(13)w,Status=?I1w")
+DEFIMP (SYMLNK_func, "SYMLNK_func", SYMLNK,,, "I1:-:Path1=A1,Path2=A1")
+DEFIMP (SYMLNK_subr, "SYMLNK_subr", SYMLNK,,, "--:-:Path1=A1,Path2=A1,Status=?I1w")
+DEFIMP (SYSTEM_func, "SYSTEM_func", SYSTEM,SYSTEM,SYSTEM,"I1:-:Command=A1")
+DEFIMP (SYSTEM_subr, "SYSTEM_subr", SYSTEM,,, "--:-:Command=A1,Status=?I1w")
+DEFIMP (SYSTEM_CLOCK, "SYSTEM_CLOCK", SYSTEM_CLOCK,,, "--:-:Count=I1w,Rate=I1w,Max=I1w")
+DEFIMP (TIME8, "TIME8", TIME,,, "I2:-:")
+DEFIMP (TIME_unix, "TIME_unix", TIME,,, "I1:-:")
+DEFIMP (TIME_vxt, "TIME_vxt", VXTTIME,,, "--:-:Time=A1[8]w")
+DEFIMP (TTYNAM_func, "TTYNAM_func", TTYNAM,,, "A1*:-:Unit=I*")
+DEFIMP (TTYNAM_subr, "TTYNAM_subr", TTYNAM,,, "--:-:Name=A1w,Unit=I*")
+DEFIMP (UMASK_func, "UMASK_func", UMASK,,, "I1:-:Mask=I*")
+DEFIMP (UMASK_subr, "UMASK_subr", UMASK,,, "--:-:Mask=I*,Old=?I1w")
+DEFIMP (UNLINK_func, "UNLINK_func", UNLINK,,, "I1:-:File=A1")
+DEFIMP (UNLINK_subr, "UNLINK_subr", UNLINK,,, "--:-:File=A1,Status=?I1w")
+DEFIMP (XOR, "XOR", ,,, "B=:*:I=B*,J=B*")
+DEFIMP (NONE, "none", ,,, "")
diff --git a/gcc/f/intrin.h b/gcc/f/intrin.h
new file mode 100644
index 00000000000..c19b0fd85dd
--- /dev/null
+++ b/gcc/f/intrin.h
@@ -0,0 +1,130 @@
+/* intrin.h -- Public interface for intrin.c
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+*/
+
+#ifndef _H_f_intrin
+#define _H_f_intrin
+
+#ifndef FFEINTRIN_DOC
+#define FFEINTRIN_DOC 0 /* 1 means intrinsic documentation only (intdoc.c). */
+#endif
+
+typedef enum
+ {
+ FFEINTRIN_familyNONE, /* Not in any family. */
+ FFEINTRIN_familyF77, /* ANSI FORTRAN 77. */
+ FFEINTRIN_familyGNU, /* GNU Fortran intrinsics. */
+ FFEINTRIN_familyF2C, /* f2c intrinsics. */
+ FFEINTRIN_familyF90, /* Fortran 90. */
+ FFEINTRIN_familyF95 = FFEINTRIN_familyF90,
+ FFEINTRIN_familyVXT, /* VAX/VMS FORTRAN. */
+ FFEINTRIN_familyMIL, /* MIL STD 1753 (MVBITS, etc), in mil, vxt, and f90. */
+ FFEINTRIN_familyASC, /* ASCII-related (ACHAR, IACHAR), both f2c and f90. */
+ FFEINTRIN_familyFVZ, /* in both f2c and VAX/VMS FORTRAN. */
+ FFEINTRIN_familyF2U, /* libf2c/libU77 UNIX system intrinsics. */
+ FFEINTRIN_familyBADU77, /* libU77 UNIX system intrinsics with bad form. */
+ FFEINTRIN_family,
+ } ffeintrinFamily;
+
+typedef enum
+ {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2) FFEINTRIN_gen ## CODE,
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+ FFEINTRIN_gen
+ } ffeintrinGen;
+
+typedef enum
+ {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) FFEINTRIN_spec ## CODE,
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+ FFEINTRIN_spec
+ } ffeintrinSpec;
+
+typedef enum
+ {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+ FFEINTRIN_imp ## CODE,
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+ FFEINTRIN_imp
+ } ffeintrinImp;
+
+#if !FFEINTRIN_DOC
+
+#include "bld.h"
+#include "info.h"
+
+ffeinfoBasictype ffeintrin_basictype (ffeintrinSpec spec);
+ffeintrinFamily ffeintrin_family (ffeintrinSpec spec);
+void ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t);
+void ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
+ bool *check_intrin, ffelexToken t);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ffecomGfrt ffeintrin_gfrt_direct (ffeintrinImp imp);
+ffecomGfrt ffeintrin_gfrt_indirect (ffeintrinImp imp);
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+void ffeintrin_init_0 (void);
+#define ffeintrin_init_1()
+#define ffeintrin_init_2()
+#define ffeintrin_init_3()
+#define ffeintrin_init_4()
+bool ffeintrin_is_actualarg (ffeintrinSpec spec);
+bool ffeintrin_is_intrinsic (char *name, ffelexToken t, bool explicit,
+ ffeintrinGen *gen, ffeintrinSpec *spec,
+ ffeintrinImp *imp);
+bool ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec);
+ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec);
+char *ffeintrin_name_generic (ffeintrinGen gen);
+char *ffeintrin_name_implementation (ffeintrinImp imp);
+char *ffeintrin_name_specific (ffeintrinSpec spec);
+ffeIntrinsicState ffeintrin_state_family (ffeintrinFamily family);
+#define ffeintrin_terminate_0()
+#define ffeintrin_terminate_1()
+#define ffeintrin_terminate_2()
+#define ffeintrin_terminate_3()
+#define ffeintrin_terminate_4()
+
+#endif /* !FFEINTRIN_DOC */
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/lab.c b/gcc/f/lab.c
new file mode 100644
index 00000000000..772553105cc
--- /dev/null
+++ b/gcc/f/lab.c
@@ -0,0 +1,159 @@
+/* lab.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+
+ Description:
+ Complex data abstraction for Fortran labels. Maintains a single master
+ list for all labels; it is expected initialization and termination of
+ this list will occur on program-unit boundaries.
+
+ Modifications:
+ 22-Aug-89 JCB 1.1
+ Change ffelab_new for new ffewhere interface.
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "lab.h"
+#include "malloc.h"
+
+/* Externals defined here. */
+
+ffelab ffelab_list_;
+ffelabNumber ffelab_num_news_;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffelab_find -- Find the ffelab object having the desired label value
+
+ ffelab l;
+ ffelabValue v;
+ l = ffelab_find(v);
+
+ If the desired ffelab object doesn't exist, returns NULL.
+
+ Straightforward search of list of ffelabs. */
+
+ffelab
+ffelab_find (ffelabValue v)
+{
+ ffelab l;
+
+ for (l = ffelab_list_; (l != NULL) && (ffelab_value (l) != v); l = l->next)
+ ;
+
+ return l;
+}
+
+/* ffelab_finish -- Shut down label management
+
+ ffelab_finish();
+
+ At the end of processing a program unit, call this routine to shut down
+ label management.
+
+ Kill all the labels on the list. */
+
+void
+ffelab_finish ()
+{
+ ffelab l;
+ ffelab pl;
+
+ for (pl = NULL, l = ffelab_list_; l != NULL; pl = l, l = l->next)
+ if (pl != NULL)
+ malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
+
+ if (pl != NULL)
+ malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
+}
+
+/* ffelab_init_3 -- Initialize label management system
+
+ ffelab_init_3();
+
+ Initialize the label management system. Do this before a new program
+ unit is going to be processed. */
+
+void
+ffelab_init_3 ()
+{
+ ffelab_list_ = NULL;
+ ffelab_num_news_ = 0;
+}
+
+/* ffelab_new -- Create an ffelab object.
+
+ ffelab l;
+ ffelabValue v;
+ l = ffelab_new(v);
+
+ Create a label having a given value. If the value isn't known, pass
+ FFELAB_valueNONE, and set it later with ffelab_set_value.
+
+ Allocate, initialize, and stick at top of label list.
+
+ 22-Aug-89 JCB 1.1
+ Change for new ffewhere interface. */
+
+ffelab
+ffelab_new (ffelabValue v)
+{
+ ffelab l;
+
+ ++ffelab_num_news_;
+ l = (ffelab) malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l));
+ l->next = ffelab_list_;
+#ifdef FFECOM_labelHOOK
+ l->hook = FFECOM_labelNULL;
+#endif
+ l->value = v;
+ l->firstref_line = ffewhere_line_unknown ();
+ l->firstref_col = ffewhere_column_unknown ();
+ l->doref_line = ffewhere_line_unknown ();
+ l->doref_col = ffewhere_column_unknown ();
+ l->definition_line = ffewhere_line_unknown ();
+ l->definition_col = ffewhere_column_unknown ();
+ l->type = FFELAB_typeUNKNOWN;
+ ffelab_list_ = l;
+ return l;
+}
diff --git a/gcc/f/lab.h b/gcc/f/lab.h
new file mode 100644
index 00000000000..d79e35b85ce
--- /dev/null
+++ b/gcc/f/lab.h
@@ -0,0 +1,154 @@
+/* lab.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ lab.c
+
+ Modifications:
+ 22-Aug-89 JCB 1.1
+ Change for new ffewhere interface.
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_lab
+#define _H_f_lab
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFELAB_typeUNKNOWN, /* No info yet on label. */
+ FFELAB_typeANY, /* Label valid for anything, no msgs. */
+ FFELAB_typeUSELESS, /* No valid way to reference this label. */
+ FFELAB_typeASSIGNABLE, /* Target of ASSIGN: so FORMAT or BRANCH. */
+ FFELAB_typeFORMAT, /* FORMAT label. */
+ FFELAB_typeLOOPEND, /* Target of a labeled DO statement. */
+ FFELAB_typeNOTLOOP, /* Branch target statement not valid DO
+ target. */
+ FFELAB_typeENDIF, /* END IF label. */
+ FFELAB_type
+ } ffelabType;
+
+#define FFELAB_valueNONE 0
+#define FFELAB_valueMAX 99999
+
+/* Typedefs. */
+
+typedef struct _ffelab_ *ffelab;
+typedef ffelab ffelabHandle;
+typedef unsigned long ffelabNumber; /* Count of new labels. */
+#define ffelabNumber_f "l"
+typedef unsigned long ffelabValue;
+#define ffelabValue_f "l"
+
+/* Include files needed by this one. */
+
+#include "com.h"
+#include "where.h"
+
+/* Structure definitions. */
+
+struct _ffelab_
+ {
+ ffelab next;
+#ifdef FFECOM_labelHOOK
+ ffecomLabel hook;
+#endif
+ ffelabValue value; /* 1 through 99999, or 100000+ for temp
+ labels. */
+ unsigned long blocknum; /* Managed entirely by user of module. */
+ ffewhereLine firstref_line;
+ ffewhereColumn firstref_col;
+ ffewhereLine doref_line;
+ ffewhereColumn doref_col;
+ ffewhereLine definition_line; /* ffewhere_line_unknown() if not
+ defined. */
+ ffewhereColumn definition_col;
+ ffelabType type;
+ };
+
+/* Global objects accessed by users of this module. */
+
+extern ffelab ffelab_list_;
+extern ffelabNumber ffelab_num_news_;
+
+/* Declare functions with prototypes. */
+
+ffelab ffelab_find (ffelabValue v);
+void ffelab_finish (void);
+void ffelab_init_3 (void);
+ffelab ffelab_new (ffelabValue v);
+
+/* Define macros. */
+
+#define ffelab_blocknum(l) ((l)->blocknum)
+#define ffelab_definition_column(l) ((l)->definition_col)
+#define ffelab_definition_filename(l) \
+ ffewhere_line_filename((l)->definition_line)
+#define ffelab_definition_filelinenum(l) \
+ ffewhere_line_filelinenum((l)->definition_line)
+#define ffelab_definition_line(l) ((l)->definition_line)
+#define ffelab_definition_line_number(l) \
+ ffewhere_line_number((l)->definition_line)
+#define ffelab_doref_column(l) ((l)->doref_col)
+#define ffelab_doref_filename(l) ffewhere_line_filename((l)->doref_line)
+#define ffelab_doref_filelinenum(l) ffewhere_line_filelinenum((l)->doref_line)
+#define ffelab_doref_line(l) ((l)->doref_line)
+#define ffelab_doref_line_number(l) ffewhere_line_number((l)->doref_line)
+#define ffelab_firstref_column(l) ((l)->firstref_col)
+#define ffelab_firstref_filename(l) ffewhere_line_filename((l)->firstref_line)
+#define ffelab_firstref_filelinenum(l) \
+ ffewhere_line_filelinenum((l)->firstref_line)
+#define ffelab_firstref_line(l) ((l)->firstref_line)
+#define ffelab_firstref_line_number(l) ffewhere_line_number((l)->firstref_line)
+#define ffelab_handle_done(h)
+#define ffelab_handle_first() ((ffelabHandle) ffelab_list_)
+#define ffelab_handle_next(h) ((ffelabHandle) (((ffelab) h)->next))
+#define ffelab_handle_target(h) ((ffelab) h)
+#define ffelab_hook(l) ((l)->hook)
+#define ffelab_init_0()
+#define ffelab_init_1()
+#define ffelab_init_2()
+#define ffelab_init_4()
+#define ffelab_kill(l) ffelab_set_value(l,FFELAB_valueNONE);
+#define ffelab_new_generated() (ffelab_new(ffelab_generated_++))
+#define ffelab_number() (ffelab_num_news_)
+#define ffelab_set_blocknum(l,b) ((l)->blocknum = (b))
+#define ffelab_set_definition_column(l,cn) ((l)->definition_col = (cn))
+#define ffelab_set_definition_line(l,ln) ((l)->definition_line = (ln))
+#define ffelab_set_doref_column(l,cn) ((l)->doref_col = (cn))
+#define ffelab_set_doref_line(l,ln) ((l)->doref_line = (ln))
+#define ffelab_set_firstref_column(l,cn) ((l)->firstref_col = (cn))
+#define ffelab_set_firstref_line(l,ln) ((l)->firstref_line = (ln))
+#define ffelab_set_hook(l,h) ((l)->hook = (h))
+#define ffelab_set_type(l,t) ((l)->type = (t))
+#define ffelab_terminate_0()
+#define ffelab_terminate_1()
+#define ffelab_terminate_2()
+#define ffelab_terminate_3()
+#define ffelab_terminate_4()
+#define ffelab_type(l) ((l)->type)
+#define ffelab_value(l) ((l)->value)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/lang-options.h b/gcc/f/lang-options.h
new file mode 100644
index 00000000000..a0e5c80596d
--- /dev/null
+++ b/gcc/f/lang-options.h
@@ -0,0 +1,152 @@
+/* lang-options.h file for Fortran
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+*/
+
+/* This is the contribution to the `lang_options' array in gcc.c for
+ g77. */
+
+#ifdef __STDC__ /* To be consistent with lang-specs.h. Maybe avoid
+ overflowing some old compiler's tables, etc. */
+
+ "-fversion",
+ "-fnull-version",
+ "-fset-g77-defaults",
+/*"-fident",*/
+/*"-fno-ident",*/
+ "-ff66",
+ "-fno-f66",
+ "-ff77",
+ "-fno-f77",
+ "-ff90",
+ "-fno-f90",
+ "-fautomatic",
+ "-fno-automatic",
+ "-fdollar-ok",
+ "-fno-dollar-ok",
+ "-ff2c",
+ "-fno-f2c",
+ "-ff2c-library",
+ "-fno-f2c-library",
+ "-ffree-form",
+ "-fno-free-form",
+ "-ffixed-form",
+ "-fno-fixed-form",
+ "-fpedantic",
+ "-fno-pedantic",
+ "-fvxt",
+ "-fno-vxt",
+ "-fugly",
+ "-fno-ugly",
+ "-fugly-args",
+ "-fno-ugly-args",
+ "-fugly-assign",
+ "-fno-ugly-assign",
+ "-fugly-assumed",
+ "-fno-ugly-assumed",
+ "-fugly-comma",
+ "-fno-ugly-comma",
+ "-fugly-complex",
+ "-fno-ugly-complex",
+ "-fugly-init",
+ "-fno-ugly-init",
+ "-fugly-logint",
+ "-fno-ugly-logint",
+ "-fxyzzy",
+ "-fno-xyzzy",
+ "-finit-local-zero",
+ "-fno-init-local-zero",
+ "-fbackslash",
+ "-fno-backslash",
+ "-femulate-complex",
+ "-fno-emulate-complex",
+ "-funderscoring",
+ "-fno-underscoring",
+ "-fsecond-underscore",
+ "-fno-second-underscore",
+ "-fintrin-case-initcap",
+ "-fintrin-case-upper",
+ "-fintrin-case-lower",
+ "-fintrin-case-any",
+ "-fmatch-case-initcap",
+ "-fmatch-case-upper",
+ "-fmatch-case-lower",
+ "-fmatch-case-any",
+ "-fsource-case-upper",
+ "-fsource-case-lower",
+ "-fsource-case-preserve",
+ "-fsymbol-case-initcap",
+ "-fsymbol-case-upper",
+ "-fsymbol-case-lower",
+ "-fsymbol-case-any",
+ "-fcase-strict-upper",
+ "-fcase-strict-lower",
+ "-fcase-initcap",
+ "-fcase-upper",
+ "-fcase-lower",
+ "-fcase-preserve",
+ "-fdcp-intrinsics-delete",
+ "-fdcp-intrinsics-hide",
+ "-fdcp-intrinsics-disable",
+ "-fdcp-intrinsics-enable",
+ "-ff2c-intrinsics-delete",
+ "-ff2c-intrinsics-hide",
+ "-ff2c-intrinsics-disable",
+ "-ff2c-intrinsics-enable",
+ "-ff90-intrinsics-delete",
+ "-ff90-intrinsics-hide",
+ "-ff90-intrinsics-disable",
+ "-ff90-intrinsics-enable",
+ "-fmil-intrinsics-delete",
+ "-fmil-intrinsics-hide",
+ "-fmil-intrinsics-disable",
+ "-fmil-intrinsics-enable",
+ "-funix-intrinsics-delete",
+ "-funix-intrinsics-hide",
+ "-funix-intrinsics-disable",
+ "-funix-intrinsics-enable",
+ "-fvxt-intrinsics-delete",
+ "-fvxt-intrinsics-hide",
+ "-fvxt-intrinsics-disable",
+ "-fvxt-intrinsics-enable",
+ "-fzeros",
+ "-fno-zeros",
+ "-fdebug-kludge",
+ "-fno-debug-kludge",
+ "-fonetrip",
+ "-fno-onetrip",
+ "-fsilent",
+ "-fno-silent",
+ "-fglobals",
+ "-fno-globals",
+ "-ftypeless-boz",
+ "-fno-typeless-boz",
+ "-Wglobals",
+ "-Wno-globals",
+/*"-Wimplicit",*/
+/*"-Wno-implicit",*/
+ "-Wsurprising",
+ "-Wno-surprising",
+/*"-Wall",*/
+/* Prefix options. */
+ "-I",
+ "-ffixed-line-length-",
+#endif
diff --git a/gcc/f/lang-specs.h b/gcc/f/lang-specs.h
new file mode 100644
index 00000000000..1e07aaf42f5
--- /dev/null
+++ b/gcc/f/lang-specs.h
@@ -0,0 +1,96 @@
+/* lang-specs.h file for Fortran
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+*/
+
+/* This is the contribution to the `default_compilers' array in gcc.c for
+ g77. */
+
+#ifdef __STDC__ /* Else stringizing of OO below won't work, but in
+ K&R case we're not building the f77 language. */
+
+#ifdef OBJECT_SUFFIX /* Not defined compiling gcc.c prior to 2.7.0. */
+#define OO "%O"
+#else
+#define OO ".o"
+#endif
+
+ {".F", "@f77-cpp-input"},
+ {".fpp", "@f77-cpp-input"},
+ {"@f77-cpp-input",
+ /* For f77 we want -traditional to avoid errors with, for
+ instance, mismatched '. Also, we avoid unpleasant surprises
+ with substitution of names not prefixed by `_' by using %P
+ rather than %p (although this isn't consistent with SGI and
+ Sun f77, at least) so you test `__unix' rather than `unix'.
+ -D_LANGUAGE_FORTRAN is used by some compilers like SGI and
+ might as well be in there. */
+ "cpp -lang-c %{nostdinc*} %{C} %{v} %{A*} %{I*} %{P} %I\
+ %{C:%{!E:%eGNU C does not support -C without using -E}}\
+ %{M} %{MM} %{MD:-MD %b.d} %{MMD:-MMD %b.d} %{MG}\
+ -undef -D__GNUC__=%v1 -D__GNUC_MINOR__=%v2\
+ %{ansi:-trigraphs -$ -D__STRICT_ANSI__}\
+ %{!undef:%P} -D_LANGUAGE_FORTRAN %{trigraphs} \
+ %c %{O*:%{!O0:-D__OPTIMIZE__}} -traditional\
+ %{g*} %{W*} %{w} %{pedantic*} %{H} %{d*} %C %{D*} %{U*} %{i*} %Z\
+ %i %{!M:%{!MM:%{!E:%{!pipe:%g.i}}}}%{E:%W{o*}}%{M:%W{o*}}%{MM:%W{o*}} |\n",
+ "%{!M:%{!MM:%{!E:f771 %{!pipe:%g.i} -fset-g77-defaults %(f771) \
+ %{!Q:-quiet} -dumpbase %b.F %{d*} %{m*} %{a}\
+ %{g*} %{O*} %{W*} %{w} %{pedantic*} \
+ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\
+ %{aux-info*}\
+ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
+ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\
+ %{!S:as %a %Y\
+ %{c:%W{o*}%{!o*:-o %w%b" OO "}}%{!c:-o %d%w%u" OO "}\
+ %{!pipe:%g.s} %A\n }}}}"},
+ {".r", "@ratfor"},
+ {"@ratfor",
+ "ratfor %{C} %{v}\
+ %{C:%{!E:%eGNU C does not support -C without using -E}}\
+ %{!E:%{!pipe:-o %g.f}}%{E:%W{o*}} %i |\n",
+ "%{!E:f771 %{!pipe:%g.f} -fset-g77-defaults %(f771) \
+ %{!Q:-quiet} -dumpbase %b.r %{d*} %{m*} %{a}\
+ %{g*} %{O*} %{W*} %{w} %{pedantic*} \
+ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\
+ %{aux-info*}\
+ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
+ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\
+ %{!S:as %a %Y\
+ %{c:%W{o*}%{!o*:-o %w%b" OO "}}%{!c:-o %d%w%u" OO "}\
+ %{!pipe:%g.s} %A\n }}"},
+ {".f", "@f77"},
+ {".for", "@f77"},
+ {"@f77",
+ "%{!M:%{!MM:%{!E:f771 %i -fset-g77-defaults %(f771) \
+ %{!Q:-quiet} -dumpbase %b.f %{d*} %{m*} %{a}\
+ %{g*} %{O*} %{W*} %{w} %{pedantic*}\
+ %{v:-version -fversion} %{pg:-p} %{p} %{f*} %{I*}\
+ %{aux-info*}\
+ %{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
+ %{S:%W{o*}%{!o*:-o %b.s}}%{!S:-o %{|!pipe:%g.s}} |\n\
+ %{!S:as %a %Y\
+ %{c:%W{o*}%{!o*:-o %w%b" OO "}}%{!c:-o %d%w%u" OO "}\
+ %{!pipe:%g.s} %A\n }}}}"},
+
+#undef OO
+
+#endif
diff --git a/gcc/f/lex.c b/gcc/f/lex.c
new file mode 100644
index 00000000000..acb439157af
--- /dev/null
+++ b/gcc/f/lex.c
@@ -0,0 +1,4697 @@
+/* Implementation of Fortran lexer
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "top.h"
+#include "bad.h"
+#include "com.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "config.j"
+#include "flags.j"
+#include "input.j"
+#include "tree.j"
+#endif
+
+#ifdef DWARF_DEBUGGING_INFO
+void dwarfout_resume_previous_source_file (register unsigned);
+void dwarfout_start_new_source_file (register char *);
+void dwarfout_define (register unsigned, register char *);
+void dwarfout_undef (register unsigned, register char *);
+#endif DWARF_DEBUGGING_INFO
+
+static void ffelex_append_to_token_ (char c);
+static int ffelex_backslash_ (int c, ffewhereColumnNumber col);
+static void ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0,
+ ffewhereColumnNumber cn0);
+static void ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0,
+ ffewhereColumnNumber cn0, ffewhereLineNumber ln1,
+ ffewhereColumnNumber cn1);
+static void ffelex_bad_here_ (int num, ffewhereLineNumber ln0,
+ ffewhereColumnNumber cn0);
+static void ffelex_finish_statement_ (void);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int ffelex_get_directive_line_ (char **text, FILE *finput);
+static int ffelex_hash_ (FILE *f);
+#endif
+static ffewhereColumnNumber ffelex_image_char_ (int c,
+ ffewhereColumnNumber col);
+static void ffelex_include_ (void);
+static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col);
+static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col);
+static void ffelex_next_line_ (void);
+static void ffelex_prepare_eos_ (void);
+static void ffelex_send_token_ (void);
+static ffelexHandler ffelex_swallow_tokens_ (ffelexToken t);
+static ffelexToken ffelex_token_new_ (void);
+
+/* Pertaining to the geometry of the input file. */
+
+/* Initial size for card image to be allocated. */
+#define FFELEX_columnINITIAL_SIZE_ 255
+
+/* The card image itself, which grows as source lines get longer. It
+ has room for ffelex_card_size_ + 8 characters, and the length of the
+ current image is ffelex_card_length_. (The + 8 characters are made
+ available for easy handling of tabs and such.) */
+static char *ffelex_card_image_;
+static ffewhereColumnNumber ffelex_card_size_;
+static ffewhereColumnNumber ffelex_card_length_;
+
+/* Max width for free-form lines (ISO F90). */
+#define FFELEX_FREE_MAX_COLUMNS_ 132
+
+/* True if we saw a tab on the current line, as this (currently) means
+ the line is therefore treated as though final_nontab_column_ were
+ infinite. */
+static bool ffelex_saw_tab_;
+
+/* TRUE if current line is known to be erroneous, so don't bother
+ expanding room for it just to display it. */
+static bool ffelex_bad_line_ = FALSE;
+
+/* Last column for vanilla, i.e. non-tabbed, line. Usually 72 or 132. */
+static ffewhereColumnNumber ffelex_final_nontab_column_;
+
+/* Array for quickly deciding what kind of line the current card has,
+ based on its first character. */
+static ffelexType ffelex_first_char_[256];
+
+/* Pertaining to file management. */
+
+/* The wf argument of the most recent active ffelex_file_(fixed,free)
+ function. */
+static ffewhereFile ffelex_current_wf_;
+
+/* TRUE if an INCLUDE statement can be processed (ffelex_set_include
+ can be called). */
+static bool ffelex_permit_include_;
+
+/* TRUE if an INCLUDE statement is pending (ffelex_set_include has been
+ called). */
+static bool ffelex_set_include_;
+
+/* Information on the pending INCLUDE file. */
+static FILE *ffelex_include_file_;
+static bool ffelex_include_free_form_;
+static ffewhereFile ffelex_include_wherefile_;
+
+/* Current master line count. */
+static ffewhereLineNumber ffelex_linecount_current_;
+/* Next master line count. */
+static ffewhereLineNumber ffelex_linecount_next_;
+
+/* ffewhere info on the latest (currently active) line read from the
+ active source file. */
+static ffewhereLine ffelex_current_wl_;
+static ffewhereColumn ffelex_current_wc_;
+
+/* Pertaining to tokens in general. */
+
+/* Initial capacity for text in a CHARACTER/HOLLERITH/NAME/NAMES/NUMBER
+ token. */
+#define FFELEX_columnTOKEN_SIZE_ 63
+#if FFELEX_columnTOKEN_SIZE_ < FFEWHERE_indexMAX
+#error "token size too small!"
+#endif
+
+/* Current token being lexed. */
+static ffelexToken ffelex_token_;
+
+/* Handler for current token. */
+static ffelexHandler ffelex_handler_;
+
+/* TRUE if fixed-form lexer is to generate NAMES instead of NAME tokens. */
+static bool ffelex_names_;
+
+/* TRUE if both lexers are to generate NAMES instead of NAME tokens. */
+static bool ffelex_names_pure_;
+
+/* TRUE if 0-9 starts a NAME token instead of NUMBER, for parsing hex
+ numbers. */
+static bool ffelex_hexnum_;
+
+/* For ffelex_swallow_tokens(). */
+static ffelexHandler ffelex_eos_handler_;
+
+/* Number of tokens sent since last EOS or beginning of input file
+ (include INCLUDEd files). */
+static unsigned long int ffelex_number_of_tokens_;
+
+/* Number of labels sent (as NUMBER tokens) since last reset of
+ ffelex_number_of_tokens_ to 0, should be 0 or 1 in most cases.
+ (Fixed-form source only.) */
+static unsigned long int ffelex_label_tokens_;
+
+/* Metering for token management, to catch token-memory leaks. */
+static long int ffelex_total_tokens_ = 0;
+static long int ffelex_old_total_tokens_ = 1;
+static long int ffelex_token_nextid_ = 0;
+
+/* Pertaining to lexing CHARACTER and HOLLERITH tokens. */
+
+/* >0 if a Hollerith constant of that length might be in mid-lex, used
+ when the next character seen is 'H' or 'h' to enter HOLLERITH lexing
+ mode (see ffelex_raw_mode_). */
+static long int ffelex_expecting_hollerith_;
+
+/* -3: Backslash (escape) sequence being lexed in CHARACTER.
+ -2: Possible closing apostrophe/quote seen in CHARACTER.
+ -1: Lexing CHARACTER.
+ 0: Not lexing CHARACTER or HOLLERITH.
+ >0: Lexing HOLLERITH, value is # chars remaining to expect. */
+static long int ffelex_raw_mode_;
+
+/* When lexing CHARACTER, open quote/apostrophe (either ' or "). */
+static char ffelex_raw_char_;
+
+/* TRUE when backslash processing had to use most recent character
+ to finish its state engine, but that character is not part of
+ the backslash sequence, so must be reconsidered as a "normal"
+ character in CHARACTER/HOLLERITH lexing. */
+static bool ffelex_backslash_reconsider_ = FALSE;
+
+/* Characters preread before lexing happened (might include EOF). */
+static int *ffelex_kludge_chars_ = NULL;
+
+/* Doing the kludge processing, so not initialized yet. */
+static bool ffelex_kludge_flag_ = FALSE;
+
+/* The beginning of a (possible) CHARACTER/HOLLERITH token. */
+static ffewhereLine ffelex_raw_where_line_;
+static ffewhereColumn ffelex_raw_where_col_;
+
+
+/* Call this to append another character to the current token. If it isn't
+ currently big enough for it, it will be enlarged. The current token
+ must be a CHARACTER, HOLLERITH, NAME, NAMES, or NUMBER. */
+
+static void
+ffelex_append_to_token_ (char c)
+{
+ if (ffelex_token_->text == NULL)
+ {
+ ffelex_token_->text
+ = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
+ FFELEX_columnTOKEN_SIZE_ + 1);
+ ffelex_token_->size = FFELEX_columnTOKEN_SIZE_;
+ ffelex_token_->length = 0;
+ }
+ else if (ffelex_token_->length >= ffelex_token_->size)
+ {
+ ffelex_token_->text
+ = malloc_resize_ksr (malloc_pool_image (),
+ ffelex_token_->text,
+ (ffelex_token_->size << 1) + 1,
+ ffelex_token_->size + 1);
+ ffelex_token_->size <<= 1;
+ assert (ffelex_token_->length < ffelex_token_->size);
+ }
+#ifdef MAP_CHARACTER
+Sorry, MAP_CHARACTER is not going to work as expected in GNU Fortran,
+please contact fortran@gnu.ai.mit.edu if you wish to fund work to
+port g77 to non-ASCII machines.
+#endif
+ ffelex_token_->text[ffelex_token_->length++] = c;
+}
+
+/* Do backslash (escape) processing for a CHARACTER/HOLLERITH token
+ being lexed. */
+
+static int
+ffelex_backslash_ (int c, ffewhereColumnNumber col)
+{
+ static int state = 0;
+ static unsigned int count;
+ static int code;
+ static unsigned int firstdig = 0;
+ static int nonnull;
+ static ffewhereLineNumber line;
+ static ffewhereColumnNumber column;
+
+ /* See gcc/c-lex.c readescape() for a straightforward version
+ of this state engine for handling backslashes in character/
+ hollerith constants. */
+
+#define wide_flag 0
+#define warn_traditional 0
+#define flag_traditional 0
+
+ switch (state)
+ {
+ case 0:
+ if ((c == '\\')
+ && (ffelex_raw_mode_ != 0)
+ && ffe_is_backslash ())
+ {
+ state = 1;
+ column = col + 1;
+ line = ffelex_linecount_current_;
+ return EOF;
+ }
+ return c;
+
+ case 1:
+ state = 0; /* Assume simple case. */
+ switch (c)
+ {
+ case 'x':
+ if (warn_traditional)
+ {
+ ffebad_start_msg_lex ("The meaning of `\\x' (at %0) varies with -traditional",
+ FFEBAD_severityWARNING);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_finish ();
+ }
+
+ if (flag_traditional)
+ return c;
+
+ code = 0;
+ count = 0;
+ nonnull = 0;
+ state = 2;
+ return EOF;
+
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7':
+ code = c - '0';
+ count = 1;
+ state = 3;
+ return EOF;
+
+ case '\\': case '\'': case '"':
+ return c;
+
+#if 0 /* Inappropriate for Fortran. */
+ case '\n':
+ ffelex_next_line_ ();
+ *ignore_ptr = 1;
+ return 0;
+#endif
+
+ case 'n':
+ return TARGET_NEWLINE;
+
+ case 't':
+ return TARGET_TAB;
+
+ case 'r':
+ return TARGET_CR;
+
+ case 'f':
+ return TARGET_FF;
+
+ case 'b':
+ return TARGET_BS;
+
+ case 'a':
+ if (warn_traditional)
+ {
+ ffebad_start_msg_lex ("The meaning of `\\a' (at %0) varies with -traditional",
+ FFEBAD_severityWARNING);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_finish ();
+ }
+
+ if (flag_traditional)
+ return c;
+ return TARGET_BELL;
+
+ case 'v':
+#if 0 /* Vertical tab is present in common usage compilers. */
+ if (flag_traditional)
+ return c;
+#endif
+ return TARGET_VT;
+
+ case 'e':
+ case 'E':
+ case '(':
+ case '{':
+ case '[':
+ case '%':
+ if (pedantic)
+ {
+ char m[2];
+
+ m[0] = c;
+ m[1] = '\0';
+ ffebad_start_msg_lex ("Non-ANSI-C-standard escape sequence `\\%A' at %0",
+ FFEBAD_severityPEDANTIC);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_string (m);
+ ffebad_finish ();
+ }
+ return (c == 'E' || c == 'e') ? 033 : c;
+
+ case '?':
+ return c;
+
+ default:
+ if (c >= 040 && c < 0177)
+ {
+ char m[2];
+
+ m[0] = c;
+ m[1] = '\0';
+ ffebad_start_msg_lex ("Unknown escape sequence `\\%A' at %0",
+ FFEBAD_severityPEDANTIC);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_string (m);
+ ffebad_finish ();
+ }
+ else if (c == EOF)
+ {
+ ffebad_start_msg_lex ("Unterminated escape sequence `\\' at %0",
+ FFEBAD_severityPEDANTIC);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_finish ();
+ }
+ else
+ {
+ char m[20];
+
+ sprintf (&m[0], "%x", c);
+ ffebad_start_msg_lex ("Unknown escape sequence `\\' followed by char code 0x%A at %0",
+ FFEBAD_severityPEDANTIC);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_string (m);
+ ffebad_finish ();
+ }
+ }
+ return c;
+
+ case 2:
+ if ((c >= 'a' && c <= 'f')
+ || (c >= 'A' && c <= 'F')
+ || (c >= '0' && c <= '9'))
+ {
+ code *= 16;
+ if (c >= 'a' && c <= 'f')
+ code += c - 'a' + 10;
+ if (c >= 'A' && c <= 'F')
+ code += c - 'A' + 10;
+ if (c >= '0' && c <= '9')
+ code += c - '0';
+ if (code != 0 || count != 0)
+ {
+ if (count == 0)
+ firstdig = code;
+ count++;
+ }
+ nonnull = 1;
+ return EOF;
+ }
+
+ state = 0;
+
+ if (! nonnull)
+ {
+ ffebad_start_msg_lex ("\\x used at %0 with no following hex digits",
+ FFEBAD_severityFATAL);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_finish ();
+ }
+ else if (count == 0)
+ /* Digits are all 0's. Ok. */
+ ;
+ else if ((count - 1) * 4 >= TYPE_PRECISION (integer_type_node)
+ || (count > 1
+ && ((1 << (TYPE_PRECISION (integer_type_node) - (count - 1) * 4))
+ <= (int) firstdig)))
+ {
+ ffebad_start_msg_lex ("Hex escape at %0 out of range",
+ FFEBAD_severityPEDANTIC);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_finish ();
+ }
+ break;
+
+ case 3:
+ if ((c <= '7') && (c >= '0') && (count++ < 3))
+ {
+ code = (code * 8) + (c - '0');
+ return EOF;
+ }
+ state = 0;
+ break;
+
+ default:
+ assert ("bad backslash state" == NULL);
+ abort ();
+ }
+
+ /* Come here when code has a built character, and c is the next
+ character that might (or might not) be the next one in the constant. */
+
+ /* Don't bother doing this check for each character going into
+ CHARACTER or HOLLERITH constants, just the escaped-value ones.
+ gcc apparently checks every single character, which seems
+ like it'd be kinda slow and not worth doing anyway. */
+
+ if (!wide_flag
+ && TYPE_PRECISION (char_type_node) < HOST_BITS_PER_INT
+ && code >= (1 << TYPE_PRECISION (char_type_node)))
+ {
+ ffebad_start_msg_lex ("Escape sequence at %0 out of range for character",
+ FFEBAD_severityFATAL);
+ ffelex_bad_here_ (0, line, column);
+ ffebad_finish ();
+ }
+
+ if (c == EOF)
+ {
+ /* Known end of constant, just append this character. */
+ ffelex_append_to_token_ (code);
+ if (ffelex_raw_mode_ > 0)
+ --ffelex_raw_mode_;
+ return EOF;
+ }
+
+ /* Have two characters to handle. Do the first, then leave it to the
+ caller to detect anything special about the second. */
+
+ ffelex_append_to_token_ (code);
+ if (ffelex_raw_mode_ > 0)
+ --ffelex_raw_mode_;
+ ffelex_backslash_reconsider_ = TRUE;
+ return c;
+}
+
+/* ffelex_bad_1_ -- Issue diagnostic with one source point
+
+ ffelex_bad_1_(FFEBAD_SOME_ERROR,ffelex_linecount_current_,column + 1);
+
+ Creates ffewhere line and column objects for the source point, sends them
+ along with the error code to ffebad, then kills the line and column
+ objects before returning. */
+
+static void
+ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0)
+{
+ ffewhereLine wl0;
+ ffewhereColumn wc0;
+
+ wl0 = ffewhere_line_new (ln0);
+ wc0 = ffewhere_column_new (cn0);
+ ffebad_start_lex (errnum);
+ ffebad_here (0, wl0, wc0);
+ ffebad_finish ();
+ ffewhere_line_kill (wl0);
+ ffewhere_column_kill (wc0);
+}
+
+/* ffelex_bad_2_ -- Issue diagnostic with two source points
+
+ ffelex_bad_2_(FFEBAD_SOME_ERROR,ffelex_linecount_current_,column + 1,
+ otherline,othercolumn);
+
+ Creates ffewhere line and column objects for the source points, sends them
+ along with the error code to ffebad, then kills the line and column
+ objects before returning. */
+
+static void
+ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0,
+ ffewhereLineNumber ln1, ffewhereColumnNumber cn1)
+{
+ ffewhereLine wl0, wl1;
+ ffewhereColumn wc0, wc1;
+
+ wl0 = ffewhere_line_new (ln0);
+ wc0 = ffewhere_column_new (cn0);
+ wl1 = ffewhere_line_new (ln1);
+ wc1 = ffewhere_column_new (cn1);
+ ffebad_start_lex (errnum);
+ ffebad_here (0, wl0, wc0);
+ ffebad_here (1, wl1, wc1);
+ ffebad_finish ();
+ ffewhere_line_kill (wl0);
+ ffewhere_column_kill (wc0);
+ ffewhere_line_kill (wl1);
+ ffewhere_column_kill (wc1);
+}
+
+static void
+ffelex_bad_here_ (int n, ffewhereLineNumber ln0,
+ ffewhereColumnNumber cn0)
+{
+ ffewhereLine wl0;
+ ffewhereColumn wc0;
+
+ wl0 = ffewhere_line_new (ln0);
+ wc0 = ffewhere_column_new (cn0);
+ ffebad_here (n, wl0, wc0);
+ ffewhere_line_kill (wl0);
+ ffewhere_column_kill (wc0);
+}
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int
+ffelex_getc_ (FILE *finput)
+{
+ int c;
+
+ if (ffelex_kludge_chars_ == NULL)
+ return getc (finput);
+
+ c = *ffelex_kludge_chars_++;
+ if (c != 0)
+ return c;
+
+ ffelex_kludge_chars_ = NULL;
+ return getc (finput);
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int
+ffelex_cfebackslash_ (int *use_d, int *d, FILE *finput)
+{
+ register int c = getc (finput);
+ register int code;
+ register unsigned count;
+ unsigned firstdig = 0;
+ int nonnull;
+
+ *use_d = 0;
+
+ switch (c)
+ {
+ case 'x':
+ if (warn_traditional)
+ warning ("the meaning of `\\x' varies with -traditional");
+
+ if (flag_traditional)
+ return c;
+
+ code = 0;
+ count = 0;
+ nonnull = 0;
+ while (1)
+ {
+ c = getc (finput);
+ if (!(c >= 'a' && c <= 'f')
+ && !(c >= 'A' && c <= 'F')
+ && !(c >= '0' && c <= '9'))
+ {
+ *use_d = 1;
+ *d = c;
+ break;
+ }
+ code *= 16;
+ if (c >= 'a' && c <= 'f')
+ code += c - 'a' + 10;
+ if (c >= 'A' && c <= 'F')
+ code += c - 'A' + 10;
+ if (c >= '0' && c <= '9')
+ code += c - '0';
+ if (code != 0 || count != 0)
+ {
+ if (count == 0)
+ firstdig = code;
+ count++;
+ }
+ nonnull = 1;
+ }
+ if (! nonnull)
+ error ("\\x used with no following hex digits");
+ else if (count == 0)
+ /* Digits are all 0's. Ok. */
+ ;
+ else if ((count - 1) * 4 >= TYPE_PRECISION (integer_type_node)
+ || (count > 1
+ && (((unsigned) 1
+ << (TYPE_PRECISION (integer_type_node) - (count - 1)
+ * 4))
+ <= firstdig)))
+ pedwarn ("hex escape out of range");
+ return code;
+
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7':
+ code = 0;
+ count = 0;
+ while ((c <= '7') && (c >= '0') && (count++ < 3))
+ {
+ code = (code * 8) + (c - '0');
+ c = getc (finput);
+ }
+ *use_d = 1;
+ *d = c;
+ return code;
+
+ case '\\': case '\'': case '"':
+ return c;
+
+ case '\n':
+ ffelex_next_line_ ();
+ *use_d = 2;
+ return 0;
+
+ case EOF:
+ *use_d = 1;
+ *d = EOF;
+ return EOF;
+
+ case 'n':
+ return TARGET_NEWLINE;
+
+ case 't':
+ return TARGET_TAB;
+
+ case 'r':
+ return TARGET_CR;
+
+ case 'f':
+ return TARGET_FF;
+
+ case 'b':
+ return TARGET_BS;
+
+ case 'a':
+ if (warn_traditional)
+ warning ("the meaning of `\\a' varies with -traditional");
+
+ if (flag_traditional)
+ return c;
+ return TARGET_BELL;
+
+ case 'v':
+#if 0 /* Vertical tab is present in common usage compilers. */
+ if (flag_traditional)
+ return c;
+#endif
+ return TARGET_VT;
+
+ case 'e':
+ case 'E':
+ if (pedantic)
+ pedwarn ("non-ANSI-standard escape sequence, `\\%c'", c);
+ return 033;
+
+ case '?':
+ return c;
+
+ /* `\(', etc, are used at beginning of line to avoid confusing Emacs. */
+ case '(':
+ case '{':
+ case '[':
+ /* `\%' is used to prevent SCCS from getting confused. */
+ case '%':
+ if (pedantic)
+ pedwarn ("non-ANSI escape sequence `\\%c'", c);
+ return c;
+ }
+ if (c >= 040 && c < 0177)
+ pedwarn ("unknown escape sequence `\\%c'", c);
+ else
+ pedwarn ("unknown escape sequence: `\\' followed by char code 0x%x", c);
+ return c;
+}
+
+#endif
+/* A miniature version of the C front-end lexer. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int
+ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c)
+{
+ ffelexToken token;
+ char buff[129];
+ char *p;
+ char *q;
+ char *r;
+ register unsigned buffer_length;
+
+ if ((*xtoken != NULL) && !ffelex_kludge_flag_)
+ ffelex_token_kill (*xtoken);
+
+ switch (c)
+ {
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ buffer_length = ARRAY_SIZE (buff);
+ p = &buff[0];
+ q = p;
+ r = &buff[buffer_length];
+ for (;;)
+ {
+ *p++ = c;
+ if (p >= r)
+ {
+ register unsigned bytes_used = (p - q);
+
+ buffer_length *= 2;
+ q = (char *)xrealloc (q, buffer_length);
+ p = &q[bytes_used];
+ r = &q[buffer_length];
+ }
+ c = ffelex_getc_ (finput);
+ if (!isdigit (c))
+ break;
+ }
+ *p = '\0';
+ token = ffelex_token_new_number (q, ffewhere_line_unknown (),
+ ffewhere_column_unknown ());
+
+ if (q != &buff[0])
+ free (q);
+
+ break;
+
+ case '\"':
+ buffer_length = ARRAY_SIZE (buff);
+ p = &buff[0];
+ q = p;
+ r = &buff[buffer_length];
+ c = ffelex_getc_ (finput);
+ for (;;)
+ {
+ bool done = FALSE;
+ int use_d = 0;
+ int d;
+
+ switch (c)
+ {
+ case '\"':
+ c = getc (finput);
+ done = TRUE;
+ break;
+
+ case '\\': /* ~~~~~ */
+ c = ffelex_cfebackslash_ (&use_d, &d, finput);
+ break;
+
+ case EOF:
+ case '\n':
+ fatal ("Badly formed directive -- no closing quote");
+ done = TRUE;
+ break;
+
+ default:
+ break;
+ }
+ if (done)
+ break;
+
+ if (use_d != 2) /* 0=>c, 1=>cd, 2=>nil. */
+ {
+ *p++ = c;
+ if (p >= r)
+ {
+ register unsigned bytes_used = (p - q);
+
+ buffer_length = bytes_used * 2;
+ q = (char *)xrealloc (q, buffer_length);
+ p = &q[bytes_used];
+ r = &q[buffer_length];
+ }
+ }
+ if (use_d == 1)
+ c = d;
+ else
+ c = getc (finput);
+ }
+ *p = '\0';
+ token = ffelex_token_new_character (q, ffewhere_line_unknown (),
+ ffewhere_column_unknown ());
+
+ if (q != &buff[0])
+ free (q);
+
+ break;
+
+ default:
+ token = NULL;
+ break;
+ }
+
+ *xtoken = token;
+ return c;
+}
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffelex_file_pop_ (char *input_filename)
+{
+ if (input_file_stack->next)
+ {
+ struct file_stack *p = input_file_stack;
+ input_file_stack = p->next;
+ free (p);
+ input_file_stack_tick++;
+#ifdef DWARF_DEBUGGING_INFO
+ if (debug_info_level == DINFO_LEVEL_VERBOSE
+ && write_symbols == DWARF_DEBUG)
+ dwarfout_resume_previous_source_file (input_file_stack->line);
+#endif /* DWARF_DEBUGGING_INFO */
+ }
+ else
+ error ("#-lines for entering and leaving files don't match");
+
+ /* Now that we've pushed or popped the input stack,
+ update the name in the top element. */
+ if (input_file_stack)
+ input_file_stack->name = input_filename;
+}
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffelex_file_push_ (int old_lineno, char *input_filename)
+{
+ struct file_stack *p
+ = (struct file_stack *) xmalloc (sizeof (struct file_stack));
+
+ input_file_stack->line = old_lineno;
+ p->next = input_file_stack;
+ p->name = input_filename;
+ input_file_stack = p;
+ input_file_stack_tick++;
+#ifdef DWARF_DEBUGGING_INFO
+ if (debug_info_level == DINFO_LEVEL_VERBOSE
+ && write_symbols == DWARF_DEBUG)
+ dwarfout_start_new_source_file (input_filename);
+#endif /* DWARF_DEBUGGING_INFO */
+
+ /* Now that we've pushed or popped the input stack,
+ update the name in the top element. */
+ if (input_file_stack)
+ input_file_stack->name = input_filename;
+}
+#endif
+
+/* Prepare to finish a statement-in-progress by sending the current
+ token, if any, then setting up EOS as the current token with the
+ appropriate current pointer. The caller can then move the current
+ pointer before actually sending EOS, if desired, as it is in
+ typical fixed-form cases. */
+
+static void
+ffelex_prepare_eos_ ()
+{
+ if (ffelex_token_->type != FFELEX_typeNONE)
+ {
+ ffelex_backslash_ (EOF, 0);
+
+ switch (ffelex_raw_mode_)
+ {
+ case -2:
+ break;
+
+ case -1:
+ ffebad_start_lex ((ffelex_raw_char_ == '\'') ? FFEBAD_NO_CLOSING_APOSTROPHE
+ : FFEBAD_NO_CLOSING_QUOTE);
+ ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
+ ffebad_here (1, ffelex_current_wl_, ffelex_current_wc_);
+ ffebad_finish ();
+ break;
+
+ case 0:
+ break;
+
+ default:
+ {
+ char num[20];
+
+ ffebad_start_lex (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS);
+ ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
+ ffebad_here (1, ffelex_current_wl_, ffelex_current_wc_);
+ sprintf (num, "%lu", (unsigned long) ffelex_raw_mode_);
+ ffebad_string (num);
+ ffebad_finish ();
+ /* Make sure the token has some text, might as well fill up with spaces. */
+ do
+ {
+ ffelex_append_to_token_ (' ');
+ } while (--ffelex_raw_mode_ > 0);
+ break;
+ }
+ }
+ ffelex_raw_mode_ = 0;
+ ffelex_send_token_ ();
+ }
+ ffelex_token_->type = FFELEX_typeEOS;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_use (ffelex_current_wc_);
+}
+
+static void
+ffelex_finish_statement_ ()
+{
+ if ((ffelex_number_of_tokens_ == 0)
+ && (ffelex_token_->type == FFELEX_typeNONE))
+ return; /* Don't have a statement pending. */
+
+ if (ffelex_token_->type != FFELEX_typeEOS)
+ ffelex_prepare_eos_ ();
+
+ ffelex_permit_include_ = TRUE;
+ ffelex_send_token_ ();
+ ffelex_permit_include_ = FALSE;
+ ffelex_number_of_tokens_ = 0;
+ ffelex_label_tokens_ = 0;
+ ffelex_names_ = TRUE;
+ ffelex_names_pure_ = FALSE; /* Probably not necessary. */
+ ffelex_hexnum_ = FALSE;
+
+ if (!ffe_is_ffedebug ())
+ return;
+
+ /* For debugging purposes only. */
+
+ if (ffelex_total_tokens_ != ffelex_old_total_tokens_)
+ {
+ fprintf (dmpout, "; token_track had %ld tokens, now have %ld.\n",
+ ffelex_old_total_tokens_, ffelex_total_tokens_);
+ ffelex_old_total_tokens_ = ffelex_total_tokens_;
+ }
+}
+
+/* Copied from gcc/c-common.c get_directive_line. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int
+ffelex_get_directive_line_ (char **text, FILE *finput)
+{
+ static char *directive_buffer = NULL;
+ static unsigned buffer_length = 0;
+ register char *p;
+ register char *buffer_limit;
+ register int looking_for = 0;
+ register int char_escaped = 0;
+
+ if (buffer_length == 0)
+ {
+ directive_buffer = (char *)xmalloc (128);
+ buffer_length = 128;
+ }
+
+ buffer_limit = &directive_buffer[buffer_length];
+
+ for (p = directive_buffer; ; )
+ {
+ int c;
+
+ /* Make buffer bigger if it is full. */
+ if (p >= buffer_limit)
+ {
+ register unsigned bytes_used = (p - directive_buffer);
+
+ buffer_length *= 2;
+ directive_buffer
+ = (char *)xrealloc (directive_buffer, buffer_length);
+ p = &directive_buffer[bytes_used];
+ buffer_limit = &directive_buffer[buffer_length];
+ }
+
+ c = getc (finput);
+
+ /* Discard initial whitespace. */
+ if ((c == ' ' || c == '\t') && p == directive_buffer)
+ continue;
+
+ /* Detect the end of the directive. */
+ if ((c == '\n' && looking_for == 0)
+ || c == EOF)
+ {
+ if (looking_for != 0)
+ fatal ("Bad directive -- missing close-quote");
+
+ *p++ = '\0';
+ *text = directive_buffer;
+ return c;
+ }
+
+ *p++ = c;
+ if (c == '\n')
+ ffelex_next_line_ ();
+
+ /* Handle string and character constant syntax. */
+ if (looking_for)
+ {
+ if (looking_for == c && !char_escaped)
+ looking_for = 0; /* Found terminator... stop looking. */
+ }
+ else
+ if (c == '\'' || c == '"')
+ looking_for = c; /* Don't stop buffering until we see another
+ another one of these (or an EOF). */
+
+ /* Handle backslash. */
+ char_escaped = (c == '\\' && ! char_escaped);
+ }
+}
+#endif
+
+/* Handle # directives that make it through (or are generated by) the
+ preprocessor. As much as reasonably possible, emulate the behavior
+ of the gcc compiler phase cc1, though interactions between #include
+ and INCLUDE might possibly produce bizarre results in terms of
+ error reporting and the generation of debugging info vis-a-vis the
+ locations of some things.
+
+ Returns the next character unhandled, which is always newline or EOF. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int
+ffelex_hash_ (FILE *finput)
+{
+ register int c;
+ ffelexToken token = NULL;
+
+ /* Read first nonwhite char after the `#'. */
+
+ c = ffelex_getc_ (finput);
+ while (c == ' ' || c == '\t')
+ c = ffelex_getc_ (finput);
+
+ /* If a letter follows, then if the word here is `line', skip
+ it and ignore it; otherwise, ignore the line, with an error
+ if the word isn't `pragma', `ident', `define', or `undef'. */
+
+ if ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))
+ {
+ if (c == 'p')
+ {
+ if (getc (finput) == 'r'
+ && getc (finput) == 'a'
+ && getc (finput) == 'g'
+ && getc (finput) == 'm'
+ && getc (finput) == 'a'
+ && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
+ || c == EOF))
+ {
+ goto skipline;
+#if 0 /* g77 doesn't handle pragmas, so ignores them FOR NOW. */
+#ifdef HANDLE_SYSV_PRAGMA
+ return handle_sysv_pragma (finput, c);
+#else /* !HANDLE_SYSV_PRAGMA */
+#ifdef HANDLE_PRAGMA
+ HANDLE_PRAGMA (finput);
+#endif /* HANDLE_PRAGMA */
+ goto skipline;
+#endif /* !HANDLE_SYSV_PRAGMA */
+#endif /* 0 */
+ }
+ }
+
+ else if (c == 'd')
+ {
+ if (getc (finput) == 'e'
+ && getc (finput) == 'f'
+ && getc (finput) == 'i'
+ && getc (finput) == 'n'
+ && getc (finput) == 'e'
+ && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
+ || c == EOF))
+ {
+ char *text;
+
+ c = ffelex_get_directive_line_ (&text, finput);
+
+#ifdef DWARF_DEBUGGING_INFO
+ if ((debug_info_level == DINFO_LEVEL_VERBOSE)
+ && (write_symbols == DWARF_DEBUG))
+ dwarfout_define (lineno, text);
+#endif /* DWARF_DEBUGGING_INFO */
+
+ goto skipline;
+ }
+ }
+ else if (c == 'u')
+ {
+ if (getc (finput) == 'n'
+ && getc (finput) == 'd'
+ && getc (finput) == 'e'
+ && getc (finput) == 'f'
+ && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
+ || c == EOF))
+ {
+ char *text;
+
+ c = ffelex_get_directive_line_ (&text, finput);
+
+#ifdef DWARF_DEBUGGING_INFO
+ if ((debug_info_level == DINFO_LEVEL_VERBOSE)
+ && (write_symbols == DWARF_DEBUG))
+ dwarfout_undef (lineno, text);
+#endif /* DWARF_DEBUGGING_INFO */
+
+ goto skipline;
+ }
+ }
+ else if (c == 'l')
+ {
+ if (getc (finput) == 'i'
+ && getc (finput) == 'n'
+ && getc (finput) == 'e'
+ && ((c = getc (finput)) == ' ' || c == '\t'))
+ goto linenum;
+ }
+ else if (c == 'i')
+ {
+ if (getc (finput) == 'd'
+ && getc (finput) == 'e'
+ && getc (finput) == 'n'
+ && getc (finput) == 't'
+ && ((c = getc (finput)) == ' ' || c == '\t'))
+ {
+ /* #ident. The pedantic warning is now in cccp.c. */
+
+ /* Here we have just seen `#ident '.
+ A string constant should follow. */
+
+ while (c == ' ' || c == '\t')
+ c = getc (finput);
+
+ /* If no argument, ignore the line. */
+ if (c == '\n' || c == EOF)
+ return c;
+
+ c = ffelex_cfelex_ (&token, finput, c);
+
+ if ((token == NULL)
+ || (ffelex_token_type (token) != FFELEX_typeCHARACTER))
+ {
+ error ("invalid #ident");
+ goto skipline;
+ }
+
+ if (ffe_is_ident ())
+ {
+#ifdef ASM_OUTPUT_IDENT
+ ASM_OUTPUT_IDENT (asm_out_file,
+ ffelex_token_text (token));
+#endif
+ }
+
+ /* Skip the rest of this line. */
+ goto skipline;
+ }
+ }
+
+ error ("undefined or invalid # directive");
+ goto skipline;
+ }
+
+ linenum:
+ /* Here we have either `#line' or `# <nonletter>'.
+ In either case, it should be a line number; a digit should follow. */
+
+ while (c == ' ' || c == '\t')
+ c = ffelex_getc_ (finput);
+
+ /* If the # is the only nonwhite char on the line,
+ just ignore it. Check the new newline. */
+ if (c == '\n' || c == EOF)
+ return c;
+
+ /* Something follows the #; read a token. */
+
+ c = ffelex_cfelex_ (&token, finput, c);
+
+ if ((token != NULL)
+ && (ffelex_token_type (token) == FFELEX_typeNUMBER))
+ {
+ int old_lineno = lineno;
+ char *old_input_filename = input_filename;
+ ffewhereFile wf;
+
+ /* subtract one, because it is the following line that
+ gets the specified number */
+ int l = atoi (ffelex_token_text (token)) - 1;
+
+ /* Is this the last nonwhite stuff on the line? */
+ while (c == ' ' || c == '\t')
+ c = ffelex_getc_ (finput);
+ if (c == '\n' || c == EOF)
+ {
+ /* No more: store the line number and check following line. */
+ lineno = l;
+ if (!ffelex_kludge_flag_)
+ {
+ ffewhere_file_set (NULL, TRUE, (ffewhereLineNumber) l);
+
+ if (token != NULL)
+ ffelex_token_kill (token);
+ }
+ return c;
+ }
+
+ /* More follows: it must be a string constant (filename). */
+
+ /* Read the string constant. */
+ c = ffelex_cfelex_ (&token, finput, c);
+
+ if ((token == NULL)
+ || (ffelex_token_type (token) != FFELEX_typeCHARACTER))
+ {
+ error ("invalid #line");
+ goto skipline;
+ }
+
+ lineno = l;
+
+ if (ffelex_kludge_flag_)
+ input_filename = ffelex_token_text (token);
+ else
+ {
+ wf = ffewhere_file_new (ffelex_token_text (token),
+ ffelex_token_length (token));
+ input_filename = ffewhere_file_name (wf);
+ ffewhere_file_set (wf, TRUE, (ffewhereLineNumber) l);
+ }
+
+#if 0 /* Not sure what g77 should do with this yet. */
+ /* Each change of file name
+ reinitializes whether we are now in a system header. */
+ in_system_header = 0;
+#endif
+
+ if (main_input_filename == 0)
+ main_input_filename = input_filename;
+
+ /* Is this the last nonwhite stuff on the line? */
+ while (c == ' ' || c == '\t')
+ c = getc (finput);
+ if (c == '\n' || c == EOF)
+ {
+ if (!ffelex_kludge_flag_)
+ {
+ /* Update the name in the top element of input_file_stack. */
+ if (input_file_stack)
+ input_file_stack->name = input_filename;
+
+ if (token != NULL)
+ ffelex_token_kill (token);
+ }
+ return c;
+ }
+
+ c = ffelex_cfelex_ (&token, finput, c);
+
+ /* `1' after file name means entering new file.
+ `2' after file name means just left a file. */
+
+ if ((token != NULL)
+ && (ffelex_token_type (token) == FFELEX_typeNUMBER))
+ {
+ int num = atoi (ffelex_token_text (token));
+
+ if (ffelex_kludge_flag_)
+ {
+ lineno = 1;
+ input_filename = old_input_filename;
+ fatal ("Use `#line ...' instead of `# ...' in first line");
+ }
+
+ if (num == 1)
+ {
+ /* Pushing to a new file. */
+ ffelex_file_push_ (old_lineno, input_filename);
+ }
+ else if (num == 2)
+ {
+ /* Popping out of a file. */
+ ffelex_file_pop_ (input_filename);
+ }
+
+ /* Is this the last nonwhite stuff on the line? */
+ while (c == ' ' || c == '\t')
+ c = getc (finput);
+ if (c == '\n' || c == EOF)
+ {
+ if (token != NULL)
+ ffelex_token_kill (token);
+ return c;
+ }
+
+ c = ffelex_cfelex_ (&token, finput, c);
+ }
+
+ /* `3' after file name means this is a system header file. */
+
+#if 0 /* Not sure what g77 should do with this yet. */
+ if ((token != NULL)
+ && (ffelex_token_type (token) == FFELEX_typeNUMBER)
+ && (atoi (ffelex_token_text (token)) == 3))
+ in_system_header = 1;
+#endif
+
+ while (c == ' ' || c == '\t')
+ c = getc (finput);
+ if (((token != NULL)
+ || (c != '\n' && c != EOF))
+ && ffelex_kludge_flag_)
+ {
+ lineno = 1;
+ input_filename = old_input_filename;
+ fatal ("Use `#line ...' instead of `# ...' in first line");
+ }
+ }
+ else
+ error ("invalid #-line");
+
+ /* skip the rest of this line. */
+ skipline:
+ if ((token != NULL) && !ffelex_kludge_flag_)
+ ffelex_token_kill (token);
+ while ((c = getc (finput)) != EOF && c != '\n')
+ ;
+ return c;
+}
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+/* "Image" a character onto the card image, return incremented column number.
+
+ Normally invoking this function as in
+ column = ffelex_image_char_ (c, column);
+ is the same as doing:
+ ffelex_card_image_[column++] = c;
+
+ However, tabs and carriage returns are handled specially, to preserve
+ the visual "image" of the input line (in most editors) in the card
+ image.
+
+ Carriage returns are ignored, as they are assumed to be followed
+ by newlines.
+
+ A tab is handled by first doing:
+ ffelex_card_image_[column++] = ' ';
+ That is, it translates to at least one space. Then, as many spaces
+ are imaged as necessary to bring the column number to the next tab
+ position, where tab positions start in the ninth column and each
+ eighth column afterwards. ALSO, a static var named ffelex_saw_tab_
+ is set to TRUE to notify the lexer that a tab was seen.
+
+ Columns are numbered and tab stops set as illustrated below:
+
+ 012345670123456701234567...
+ x y z
+ xx yy zz
+ ...
+ xxxxxxx yyyyyyy zzzzzzz
+ xxxxxxxx yyyyyyyy... */
+
+static ffewhereColumnNumber
+ffelex_image_char_ (int c, ffewhereColumnNumber column)
+{
+ ffewhereColumnNumber old_column = column;
+
+ if (column >= ffelex_card_size_)
+ {
+ ffewhereColumnNumber newmax = ffelex_card_size_ << 1;
+
+ if (ffelex_bad_line_)
+ return column;
+
+ if ((newmax >> 1) != ffelex_card_size_)
+ { /* Overflowed column number. */
+ overflow: /* :::::::::::::::::::: */
+
+ ffelex_bad_line_ = TRUE;
+ strcpy (&ffelex_card_image_[column - 3], "...");
+ ffelex_card_length_ = column;
+ ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG,
+ ffelex_linecount_current_, column + 1);
+ return column;
+ }
+
+ ffelex_card_image_
+ = malloc_resize_ksr (malloc_pool_image (),
+ ffelex_card_image_,
+ newmax + 9,
+ ffelex_card_size_ + 9);
+ ffelex_card_size_ = newmax;
+ }
+
+ switch (c)
+ {
+ case '\r':
+ break;
+
+ case '\t':
+ ffelex_saw_tab_ = TRUE;
+ ffelex_card_image_[column++] = ' ';
+ while ((column & 7) != 0)
+ ffelex_card_image_[column++] = ' ';
+ break;
+
+ case '\0':
+ if (!ffelex_bad_line_)
+ {
+ ffelex_bad_line_ = TRUE;
+ strcpy (&ffelex_card_image_[column], "[\\0]");
+ ffelex_card_length_ = column + 4;
+ ffebad_start_msg_lex ("Null character at %0 -- line ignored",
+ FFEBAD_severityFATAL);
+ ffelex_bad_here_ (0, ffelex_linecount_current_, column + 1);
+ ffebad_finish ();
+ column += 4;
+ }
+ break;
+
+ default:
+ ffelex_card_image_[column++] = c;
+ break;
+ }
+
+ if (column < old_column)
+ {
+ column = old_column;
+ goto overflow; /* :::::::::::::::::::: */
+ }
+
+ return column;
+}
+
+static void
+ffelex_include_ ()
+{
+ ffewhereFile include_wherefile = ffelex_include_wherefile_;
+ FILE *include_file = ffelex_include_file_;
+ /* The rest of this is to push, and after the INCLUDE file is processed,
+ pop, the static lexer state info that pertains to each particular
+ input file. */
+ char *card_image;
+ ffewhereColumnNumber card_size = ffelex_card_size_;
+ ffewhereColumnNumber card_length = ffelex_card_length_;
+ ffewhereLine current_wl = ffelex_current_wl_;
+ ffewhereColumn current_wc = ffelex_current_wc_;
+ bool saw_tab = ffelex_saw_tab_;
+ ffewhereColumnNumber final_nontab_column = ffelex_final_nontab_column_;
+ ffewhereFile current_wf = ffelex_current_wf_;
+ ffewhereLineNumber linecount_current = ffelex_linecount_current_;
+ ffewhereLineNumber linecount_offset
+ = ffewhere_line_filelinenum (current_wl);
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ int old_lineno = lineno;
+ char *old_input_filename = input_filename;
+#endif
+
+ if (card_length != 0)
+ {
+ card_image = malloc_new_ks (malloc_pool_image (),
+ "FFELEX saved card image",
+ card_length);
+ memcpy (card_image, ffelex_card_image_, card_length);
+ }
+ else
+ card_image = NULL;
+
+ ffelex_set_include_ = FALSE;
+
+ ffelex_next_line_ ();
+
+ ffewhere_file_set (include_wherefile, TRUE, 0);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffelex_file_push_ (old_lineno, ffewhere_file_name (include_wherefile));
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+ if (ffelex_include_free_form_)
+ ffelex_file_free (include_wherefile, include_file);
+ else
+ ffelex_file_fixed (include_wherefile, include_file);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffelex_file_pop_ (ffewhere_file_name (current_wf));
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
+
+ ffewhere_file_set (current_wf, TRUE, linecount_offset);
+
+ ffecom_close_include (include_file);
+
+ if (card_length != 0)
+ {
+#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */
+#error "need to handle possible reduction of card size here!!"
+#endif
+ assert (ffelex_card_size_ >= card_length); /* It shrunk?? */
+ memcpy (ffelex_card_image_, card_image, card_length);
+ }
+ ffelex_card_image_[card_length] = '\0';
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ input_filename = old_input_filename;
+ lineno = old_lineno;
+#endif
+ ffelex_linecount_current_ = linecount_current;
+ ffelex_current_wf_ = current_wf;
+ ffelex_final_nontab_column_ = final_nontab_column;
+ ffelex_saw_tab_ = saw_tab;
+ ffelex_current_wc_ = current_wc;
+ ffelex_current_wl_ = current_wl;
+ ffelex_card_length_ = card_length;
+ ffelex_card_size_ = card_size;
+}
+
+/* ffelex_is_free_char_ctx_contin_ -- Character Context Continuation?
+
+ ffewhereColumnNumber col;
+ int c; // Char at col.
+ if ((c == '&') && ffelex_is_free_char_ctx_contin_(col + 1))
+ // We have a continuation indicator.
+
+ If there are <n> spaces starting at ffelex_card_image_[col] up through
+ the null character, where <n> is 0 or greater, returns TRUE. */
+
+static bool
+ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col)
+{
+ while (ffelex_card_image_[col] != '\0')
+ {
+ if (ffelex_card_image_[col++] != ' ')
+ return FALSE;
+ }
+ return TRUE;
+}
+
+/* ffelex_is_free_nonc_ctx_contin_ -- Noncharacter Context Continuation?
+
+ ffewhereColumnNumber col;
+ int c; // Char at col.
+ if ((c == '&') && ffelex_is_free_nonc_ctx_contin_(col + 1))
+ // We have a continuation indicator.
+
+ If there are <n> spaces starting at ffelex_card_image_[col] up through
+ the null character or '!', where <n> is 0 or greater, returns TRUE. */
+
+static bool
+ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col)
+{
+ while ((ffelex_card_image_[col] != '\0') && (ffelex_card_image_[col] != '!'))
+ {
+ if (ffelex_card_image_[col++] != ' ')
+ return FALSE;
+ }
+ return TRUE;
+}
+
+static void
+ffelex_next_line_ ()
+{
+ ffelex_linecount_current_ = ffelex_linecount_next_;
+ ++ffelex_linecount_next_;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ++lineno;
+#endif
+}
+
+static void
+ffelex_send_token_ ()
+{
+ ++ffelex_number_of_tokens_;
+
+ ffelex_backslash_ (EOF, 0);
+
+ if (ffelex_token_->text == NULL)
+ {
+ if (ffelex_token_->type == FFELEX_typeCHARACTER)
+ {
+ ffelex_append_to_token_ ('\0');
+ ffelex_token_->length = 0;
+ }
+ }
+ else
+ ffelex_token_->text[ffelex_token_->length] = '\0';
+
+ assert (ffelex_raw_mode_ == 0);
+
+ if (ffelex_token_->type == FFELEX_typeNAMES)
+ {
+ ffewhere_line_kill (ffelex_token_->currentnames_line);
+ ffewhere_column_kill (ffelex_token_->currentnames_col);
+ }
+
+ assert (ffelex_handler_ != NULL);
+ ffelex_handler_ = (ffelexHandler) (*ffelex_handler_) (ffelex_token_);
+ assert (ffelex_handler_ != NULL);
+
+ ffelex_token_kill (ffelex_token_);
+
+ ffelex_token_ = ffelex_token_new_ ();
+ ffelex_token_->uses = 1;
+ ffelex_token_->text = NULL;
+ if (ffelex_raw_mode_ < 0)
+ {
+ ffelex_token_->type = FFELEX_typeCHARACTER;
+ ffelex_token_->where_line = ffelex_raw_where_line_;
+ ffelex_token_->where_col = ffelex_raw_where_col_;
+ ffelex_raw_where_line_ = ffewhere_line_unknown ();
+ ffelex_raw_where_col_ = ffewhere_column_unknown ();
+ }
+ else
+ {
+ ffelex_token_->type = FFELEX_typeNONE;
+ ffelex_token_->where_line = ffewhere_line_unknown ();
+ ffelex_token_->where_col = ffewhere_column_unknown ();
+ }
+
+ if (ffelex_set_include_)
+ ffelex_include_ ();
+}
+
+/* ffelex_swallow_tokens_ -- Eat all tokens delivered to me
+
+ return ffelex_swallow_tokens_;
+
+ Return this handler when you don't want to look at any more tokens in the
+ statement because you've encountered an unrecoverable error in the
+ statement. */
+
+static ffelexHandler
+ffelex_swallow_tokens_ (ffelexToken t)
+{
+ assert (ffelex_eos_handler_ != NULL);
+
+ if ((ffelex_token_type (t) == FFELEX_typeEOS)
+ || (ffelex_token_type (t) == FFELEX_typeSEMICOLON))
+ return (ffelexHandler) (*ffelex_eos_handler_) (t);
+
+ return (ffelexHandler) ffelex_swallow_tokens_;
+}
+
+static ffelexToken
+ffelex_token_new_ ()
+{
+ ffelexToken t;
+
+ ++ffelex_total_tokens_;
+
+ t = (ffelexToken) malloc_new_ks (malloc_pool_image (),
+ "FFELEX token", sizeof (*t));
+ t->id_ = ffelex_token_nextid_++;
+ return t;
+}
+
+static char *
+ffelex_type_string_ (ffelexType type)
+{
+ static char *types[] = {
+ "FFELEX_typeNONE",
+ "FFELEX_typeCOMMENT",
+ "FFELEX_typeEOS",
+ "FFELEX_typeEOF",
+ "FFELEX_typeERROR",
+ "FFELEX_typeRAW",
+ "FFELEX_typeQUOTE",
+ "FFELEX_typeDOLLAR",
+ "FFELEX_typeHASH",
+ "FFELEX_typePERCENT",
+ "FFELEX_typeAMPERSAND",
+ "FFELEX_typeAPOSTROPHE",
+ "FFELEX_typeOPEN_PAREN",
+ "FFELEX_typeCLOSE_PAREN",
+ "FFELEX_typeASTERISK",
+ "FFELEX_typePLUS",
+ "FFELEX_typeMINUS",
+ "FFELEX_typePERIOD",
+ "FFELEX_typeSLASH",
+ "FFELEX_typeNUMBER",
+ "FFELEX_typeOPEN_ANGLE",
+ "FFELEX_typeEQUALS",
+ "FFELEX_typeCLOSE_ANGLE",
+ "FFELEX_typeNAME",
+ "FFELEX_typeCOMMA",
+ "FFELEX_typePOWER",
+ "FFELEX_typeCONCAT",
+ "FFELEX_typeDEBUG",
+ "FFELEX_typeNAMES",
+ "FFELEX_typeHOLLERITH",
+ "FFELEX_typeCHARACTER",
+ "FFELEX_typeCOLON",
+ "FFELEX_typeSEMICOLON",
+ "FFELEX_typeUNDERSCORE",
+ "FFELEX_typeQUESTION",
+ "FFELEX_typeOPEN_ARRAY",
+ "FFELEX_typeCLOSE_ARRAY",
+ "FFELEX_typeCOLONCOLON",
+ "FFELEX_typeREL_LE",
+ "FFELEX_typeREL_NE",
+ "FFELEX_typeREL_EQ",
+ "FFELEX_typePOINTS",
+ "FFELEX_typeREL_GE"
+ };
+
+ if (type >= ARRAY_SIZE (types))
+ return "???";
+ return types[type];
+}
+
+void
+ffelex_display_token (ffelexToken t)
+{
+ if (t == NULL)
+ t = ffelex_token_;
+
+ fprintf (dmpout, "; Token #%lu is %s (line %" ffewhereLineNumber_f "u, col %"
+ ffewhereColumnNumber_f "u)",
+ t->id_,
+ ffelex_type_string_ (t->type),
+ ffewhere_line_number (t->where_line),
+ ffewhere_column_number (t->where_col));
+
+ if (t->text != NULL)
+ fprintf (dmpout, ": \"%.*s\"\n",
+ (int) t->length,
+ t->text);
+ else
+ fprintf (dmpout, ".\n");
+}
+
+/* ffelex_expecting_character -- Tells if next token expected to be CHARACTER
+
+ if (ffelex_expecting_character())
+ // next token delivered by lexer will be CHARACTER.
+
+ If the most recent call to ffelex_set_expecting_hollerith since the last
+ token was delivered by the lexer passed a length of -1, then we return
+ TRUE, because the next token we deliver will be typeCHARACTER, else we
+ return FALSE. */
+
+bool
+ffelex_expecting_character ()
+{
+ return (ffelex_raw_mode_ != 0);
+}
+
+/* ffelex_file_fixed -- Lex a given file in fixed source form
+
+ ffewhere wf;
+ FILE *f;
+ ffelex_file_fixed(wf,f);
+
+ Lexes the file according to Fortran 90 ANSI + VXT specifications. */
+
+ffelexHandler
+ffelex_file_fixed (ffewhereFile wf, FILE *f)
+{
+ register int c; /* Character currently under consideration. */
+ register ffewhereColumnNumber column; /* Not really; 0 means column 1... */
+ bool disallow_continuation_line;
+ bool ignore_disallowed_continuation;
+ int latest_char_in_file = 0; /* For getting back into comment-skipping
+ code. */
+ ffelexType lextype;
+ ffewhereColumnNumber first_label_char; /* First char of label --
+ column number. */
+ char label_string[6]; /* Text of label. */
+ int labi; /* Length of label text. */
+ bool finish_statement; /* Previous statement finished? */
+ bool have_content; /* This line have content? */
+ bool just_do_label; /* Nothing but label (and continuation?) on
+ line. */
+
+ /* Lex is called for a particular file, not for a particular program unit.
+ Yet the two events do share common characteristics. The first line in a
+ file or in a program unit cannot be a continuation line. No token can
+ be in mid-formation. No current label for the statement exists, since
+ there is no current statement. */
+
+ assert (ffelex_handler_ != NULL);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ lineno = 0;
+ input_filename = ffewhere_file_name (wf);
+#endif
+ ffelex_current_wf_ = wf;
+ disallow_continuation_line = TRUE;
+ ignore_disallowed_continuation = FALSE;
+ ffelex_token_->type = FFELEX_typeNONE;
+ ffelex_number_of_tokens_ = 0;
+ ffelex_label_tokens_ = 0;
+ ffelex_current_wl_ = ffewhere_line_unknown ();
+ ffelex_current_wc_ = ffewhere_column_unknown ();
+ latest_char_in_file = '\n';
+ goto first_line; /* :::::::::::::::::::: */
+
+ /* Come here to get a new line. */
+
+ beginning_of_line: /* :::::::::::::::::::: */
+
+ disallow_continuation_line = FALSE;
+
+ /* Come here directly when last line didn't clarify the continuation issue. */
+
+ beginning_of_line_again: /* :::::::::::::::::::: */
+
+#ifdef REDUCE_CARD_SIZE_AFTER_BIGGY /* Define if occasional large lines. */
+ if (ffelex_card_size_ != FFELEX_columnINITIAL_SIZE_)
+ {
+ ffelex_card_image_
+ = malloc_resize_ks (malloc_pool_image (),
+ ffelex_card_image_,
+ FFELEX_columnINITIAL_SIZE_ + 9,
+ ffelex_card_size_ + 9);
+ ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
+ }
+#endif
+
+ first_line: /* :::::::::::::::::::: */
+
+ c = latest_char_in_file;
+ if ((c == EOF) || ((c = ffelex_getc_ (f)) == EOF))
+ {
+
+ end_of_file: /* :::::::::::::::::::: */
+
+ /* Line ending in EOF instead of \n still counts as a whole line. */
+
+ ffelex_finish_statement_ ();
+ ffewhere_line_kill (ffelex_current_wl_);
+ ffewhere_column_kill (ffelex_current_wc_);
+ return (ffelexHandler) ffelex_handler_;
+ }
+
+ ffelex_next_line_ ();
+
+ ffelex_bad_line_ = FALSE;
+
+ /* Skip over comment (and otherwise ignored) lines as quickly as possible! */
+
+ while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT)
+ || (lextype == FFELEX_typeERROR)
+ || (lextype == FFELEX_typeSLASH)
+ || (lextype == FFELEX_typeHASH))
+ {
+ /* Test most frequent type of line first, etc. */
+ if ((lextype == FFELEX_typeCOMMENT)
+ || ((lextype == FFELEX_typeSLASH)
+ && ((c = getc (f)) == '*'))) /* NOTE SIDE-EFFECT. */
+ {
+ /* Typical case (straight comment), just ignore rest of line. */
+ comment_line: /* :::::::::::::::::::: */
+
+ while ((c != '\n') && (c != EOF))
+ c = getc (f);
+ }
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ else if (lextype == FFELEX_typeHASH)
+ c = ffelex_hash_ (f);
+#endif
+ else if (lextype == FFELEX_typeSLASH)
+ {
+ /* SIDE-EFFECT ABOVE HAS HAPPENED. */
+ ffelex_card_image_[0] = '/';
+ ffelex_card_image_[1] = c;
+ column = 2;
+ goto bad_first_character; /* :::::::::::::::::::: */
+ }
+ else
+ /* typeERROR or unsupported typeHASH. */
+ { /* Bad first character, get line and display
+ it with message. */
+ column = ffelex_image_char_ (c, 0);
+
+ bad_first_character: /* :::::::::::::::::::: */
+
+ ffelex_bad_line_ = TRUE;
+ while (((c = getc (f)) != '\n') && (c != EOF))
+ column = ffelex_image_char_ (c, column);
+ ffelex_card_image_[column] = '\0';
+ ffelex_card_length_ = column;
+ ffelex_bad_1_ (FFEBAD_FIRST_CHAR_INVALID,
+ ffelex_linecount_current_, 1);
+ }
+
+ /* Read past last char in line. */
+
+ if (c == EOF)
+ {
+ ffelex_next_line_ ();
+ goto end_of_file; /* :::::::::::::::::::: */
+ }
+
+ c = getc (f);
+
+ ffelex_next_line_ ();
+
+ if (c == EOF)
+ goto end_of_file; /* :::::::::::::::::::: */
+
+ ffelex_bad_line_ = FALSE;
+ } /* while [c, first char, means comment] */
+
+ ffelex_saw_tab_
+ = (c == '&')
+ || (ffelex_final_nontab_column_ == 0);
+
+ if (lextype == FFELEX_typeDEBUG)
+ c = ' '; /* A 'D' or 'd' in column 1 with the
+ debug-lines option on. */
+
+ column = ffelex_image_char_ (c, 0);
+
+ /* Read the entire line in as is (with whitespace processing). */
+
+ while (((c = getc (f)) != '\n') && (c != EOF))
+ column = ffelex_image_char_ (c, column);
+
+ if (ffelex_bad_line_)
+ {
+ ffelex_card_image_[column] = '\0';
+ ffelex_card_length_ = column;
+ goto comment_line; /* :::::::::::::::::::: */
+ }
+
+ /* If no tab, cut off line after column 72/132. */
+
+ if (!ffelex_saw_tab_ && (column > ffelex_final_nontab_column_))
+ {
+ /* Technically, we should now fill ffelex_card_image_ up thru column
+ 72/132 with spaces, since character/hollerith constants must count
+ them in that manner. To save CPU time in several ways (avoid a loop
+ here that would be used only when we actually end a line in
+ character-constant mode; avoid writing memory unnecessarily; avoid a
+ loop later checking spaces when not scanning for character-constant
+ characters), we don't do this, and we do the appropriate thing when
+ we encounter end-of-line while actually processing a character
+ constant. */
+
+ column = ffelex_final_nontab_column_;
+ }
+ ffelex_card_image_[column] = '\0';
+ ffelex_card_length_ = column;
+
+ /* Save next char in file so we can use register-based c while analyzing
+ line we just read. */
+
+ latest_char_in_file = c; /* Should be either '\n' or EOF. */
+
+ have_content = FALSE;
+
+ /* Handle label, if any. */
+
+ labi = 0;
+ first_label_char = FFEWHERE_columnUNKNOWN;
+ for (column = 0; column < 5; ++column)
+ {
+ switch (c = ffelex_card_image_[column])
+ {
+ case '\0':
+ case '!':
+ goto stop_looking; /* :::::::::::::::::::: */
+
+ case ' ':
+ break;
+
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ label_string[labi++] = c;
+ if (first_label_char == FFEWHERE_columnUNKNOWN)
+ first_label_char = column + 1;
+ break;
+
+ case '&':
+ if (column != 0)
+ {
+ ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC,
+ ffelex_linecount_current_,
+ column + 1);
+ goto beginning_of_line_again; /* :::::::::::::::::::: */
+ }
+ if (ffe_is_pedantic ())
+ ffelex_bad_1_ (FFEBAD_AMPERSAND,
+ ffelex_linecount_current_, 1);
+ finish_statement = FALSE;
+ just_do_label = FALSE;
+ goto got_a_continuation; /* :::::::::::::::::::: */
+
+ case '/':
+ if (ffelex_card_image_[column + 1] == '*')
+ goto stop_looking; /* :::::::::::::::::::: */
+ /* Fall through. */
+ default:
+ ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC,
+ ffelex_linecount_current_, column + 1);
+ goto beginning_of_line_again; /* :::::::::::::::::::: */
+ }
+ }
+
+ stop_looking: /* :::::::::::::::::::: */
+
+ label_string[labi] = '\0';
+
+ /* Find first nonblank char starting with continuation column. */
+
+ if (column == 5) /* In which case we didn't see end of line in
+ label field. */
+ while ((c = ffelex_card_image_[column]) == ' ')
+ ++column;
+
+ /* Now we're trying to figure out whether this is a continuation line and
+ whether there's anything else of substance on the line. The cases are
+ as follows:
+
+ 1. If a line has an explicit continuation character (other than the digit
+ zero), then if it also has a label, the label is ignored and an error
+ message is printed. Any remaining text on the line is passed to the
+ parser tasks, thus even an all-blank line (possibly with an ignored
+ label) aside from a positive continuation character might have meaning
+ in the midst of a character or hollerith constant.
+
+ 2. If a line has no explicit continuation character (that is, it has a
+ space in column 6 and the first non-space character past column 6 is
+ not a digit 0-9), then there are two possibilities:
+
+ A. A label is present and/or a non-space (and non-comment) character
+ appears somewhere after column 6. Terminate processing of the previous
+ statement, if any, send the new label for the next statement, if any,
+ and start processing a new statement with this non-blank character, if
+ any.
+
+ B. The line is essentially blank, except for a possible comment character.
+ Don't terminate processing of the previous statement and don't pass any
+ characters to the parser tasks, since the line is not flagged as a
+ continuation line. We treat it just like a completely blank line.
+
+ 3. If a line has a continuation character of zero (0), then we terminate
+ processing of the previous statement, if any, send the new label for the
+ next statement, if any, and start processing a new statement, if any
+ non-blank characters are present.
+
+ If, when checking to see if we should terminate the previous statement, it
+ is found that there is no previous statement but that there is an
+ outstanding label, substitute CONTINUE as the statement for the label
+ and display an error message. */
+
+ finish_statement = FALSE;
+ just_do_label = FALSE;
+
+ switch (c)
+ {
+ case '!': /* ANSI Fortran 90 says ! in column 6 is
+ continuation. */
+ /* VXT Fortran says ! anywhere is comment, even column 6. */
+ if (ffe_is_vxt () || (column != 5))
+ goto no_tokens_on_line; /* :::::::::::::::::::: */
+ goto got_a_continuation; /* :::::::::::::::::::: */
+
+ case '/':
+ if (ffelex_card_image_[column + 1] != '*')
+ goto some_other_character; /* :::::::::::::::::::: */
+ /* Fall through. */
+ if (column == 5)
+ {
+ /* This seems right to do. But it is close to call, since / * starting
+ in column 6 will thus be interpreted as a continuation line
+ beginning with '*'. */
+
+ goto got_a_continuation;/* :::::::::::::::::::: */
+ }
+ /* Fall through. */
+ case '\0':
+ /* End of line. Therefore may be continued-through line, so handle
+ pending label as possible to-be-continued and drive end-of-statement
+ for any previous statement, else treat as blank line. */
+
+ no_tokens_on_line: /* :::::::::::::::::::: */
+
+ if (ffe_is_pedantic () && (c == '/'))
+ ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
+ ffelex_linecount_current_, column + 1);
+ if (first_label_char != FFEWHERE_columnUNKNOWN)
+ { /* Can't be a continued-through line if it
+ has a label. */
+ finish_statement = TRUE;
+ have_content = TRUE;
+ just_do_label = TRUE;
+ break;
+ }
+ goto beginning_of_line_again; /* :::::::::::::::::::: */
+
+ case '0':
+ if (ffe_is_pedantic () && (column != 5))
+ ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN,
+ ffelex_linecount_current_, column + 1);
+ finish_statement = TRUE;
+ goto check_for_content; /* :::::::::::::::::::: */
+
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+
+ /* NOTE: This label can be reached directly from the code
+ that lexes the label field in columns 1-5. */
+ got_a_continuation: /* :::::::::::::::::::: */
+
+ if (first_label_char != FFEWHERE_columnUNKNOWN)
+ {
+ ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION,
+ ffelex_linecount_current_,
+ first_label_char,
+ ffelex_linecount_current_,
+ column + 1);
+ first_label_char = FFEWHERE_columnUNKNOWN;
+ }
+ if (disallow_continuation_line)
+ {
+ if (!ignore_disallowed_continuation)
+ ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION,
+ ffelex_linecount_current_, column + 1);
+ goto beginning_of_line_again; /* :::::::::::::::::::: */
+ }
+ if (ffe_is_pedantic () && (column != 5))
+ ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN,
+ ffelex_linecount_current_, column + 1);
+ if ((ffelex_raw_mode_ != 0)
+ && (((c = ffelex_card_image_[column + 1]) != '\0')
+ || !ffelex_saw_tab_))
+ {
+ ++column;
+ have_content = TRUE;
+ break;
+ }
+
+ check_for_content: /* :::::::::::::::::::: */
+
+ while ((c = ffelex_card_image_[++column]) == ' ')
+ ;
+ if ((c == '\0')
+ || (c == '!')
+ || ((c == '/')
+ && (ffelex_card_image_[column + 1] == '*')))
+ {
+ if (ffe_is_pedantic () && (c == '/'))
+ ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
+ ffelex_linecount_current_, column + 1);
+ just_do_label = TRUE;
+ }
+ else
+ have_content = TRUE;
+ break;
+
+ default:
+
+ some_other_character: /* :::::::::::::::::::: */
+
+ if (column == 5)
+ goto got_a_continuation;/* :::::::::::::::::::: */
+
+ /* Here is the very normal case of a regular character starting in
+ column 7 or beyond with a blank in column 6. */
+
+ finish_statement = TRUE;
+ have_content = TRUE;
+ break;
+ }
+
+ if (have_content
+ || (first_label_char != FFEWHERE_columnUNKNOWN))
+ {
+ /* The line has content of some kind, install new end-statement
+ point for error messages. Note that "content" includes cases
+ where there's little apparent content but enough to finish
+ a statement. That's because finishing a statement can trigger
+ an impending INCLUDE, and that requires accurate line info being
+ maintained by the lexer. */
+
+ if (finish_statement)
+ ffelex_prepare_eos_ (); /* Prepare EOS before we move current pointer. */
+
+ ffewhere_line_kill (ffelex_current_wl_);
+ ffewhere_column_kill (ffelex_current_wc_);
+ ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_);
+ ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1);
+ }
+
+ /* We delay this for a combination of reasons. Mainly, it can start
+ INCLUDE processing, and we want to delay that until the lexer's
+ info on the line is coherent. And we want to delay that until we're
+ sure there's a reason to make that info coherent, to avoid saving
+ lots of useless lines. */
+
+ if (finish_statement)
+ ffelex_finish_statement_ ();
+
+ /* If label is present, enclose it in a NUMBER token and send it along. */
+
+ if (first_label_char != FFEWHERE_columnUNKNOWN)
+ {
+ assert (ffelex_token_->type == FFELEX_typeNONE);
+ ffelex_token_->type = FFELEX_typeNUMBER;
+ ffelex_append_to_token_ ('\0'); /* Make room for label text. */
+ strcpy (ffelex_token_->text, label_string);
+ ffelex_token_->where_line
+ = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (first_label_char);
+ ffelex_token_->length = labi;
+ ffelex_send_token_ ();
+ ++ffelex_label_tokens_;
+ }
+
+ if (just_do_label)
+ goto beginning_of_line; /* :::::::::::::::::::: */
+
+ /* Here is the main engine for parsing. c holds the character at column.
+ It is already known that c is not a blank, end of line, or shriek,
+ unless ffelex_raw_mode_ is not 0 (indicating we are in a
+ character/hollerith constant). A partially filled token may already
+ exist in ffelex_token_. One special case: if, when the end of the line
+ is reached, continuation_line is FALSE and the only token on the line is
+ END, then it is indeed the last statement. We don't look for
+ continuation lines during this program unit in that case. This is
+ according to ANSI. */
+
+ if (ffelex_raw_mode_ != 0)
+ {
+
+ parse_raw_character: /* :::::::::::::::::::: */
+
+ if (c == '\0')
+ {
+ ffewhereColumnNumber i;
+
+ if (ffelex_saw_tab_ || (column >= ffelex_final_nontab_column_))
+ goto beginning_of_line; /* :::::::::::::::::::: */
+
+ /* Pad out line with "virtual" spaces. */
+
+ for (i = column; i < ffelex_final_nontab_column_; ++i)
+ ffelex_card_image_[i] = ' ';
+ ffelex_card_image_[i] = '\0';
+ ffelex_card_length_ = i;
+ c = ' ';
+ }
+
+ switch (ffelex_raw_mode_)
+ {
+ case -3:
+ c = ffelex_backslash_ (c, column);
+ if (c == EOF)
+ break;
+
+ if (!ffelex_backslash_reconsider_)
+ ffelex_append_to_token_ (c);
+ ffelex_raw_mode_ = -1;
+ break;
+
+ case -2:
+ if (c == ffelex_raw_char_)
+ {
+ ffelex_raw_mode_ = -1;
+ ffelex_append_to_token_ (c);
+ }
+ else
+ {
+ ffelex_raw_mode_ = 0;
+ ffelex_backslash_reconsider_ = TRUE;
+ }
+ break;
+
+ case -1:
+ if (c == ffelex_raw_char_)
+ ffelex_raw_mode_ = -2;
+ else
+ {
+ c = ffelex_backslash_ (c, column);
+ if (c == EOF)
+ {
+ ffelex_raw_mode_ = -3;
+ break;
+ }
+
+ ffelex_append_to_token_ (c);
+ }
+ break;
+
+ default:
+ c = ffelex_backslash_ (c, column);
+ if (c == EOF)
+ break;
+
+ if (!ffelex_backslash_reconsider_)
+ {
+ ffelex_append_to_token_ (c);
+ --ffelex_raw_mode_;
+ }
+ break;
+ }
+
+ if (ffelex_backslash_reconsider_)
+ ffelex_backslash_reconsider_ = FALSE;
+ else
+ c = ffelex_card_image_[++column];
+
+ if (ffelex_raw_mode_ == 0)
+ {
+ ffelex_send_token_ ();
+ assert (ffelex_raw_mode_ == 0);
+ while (c == ' ')
+ c = ffelex_card_image_[++column];
+ if ((c == '\0')
+ || (c == '!')
+ || ((c == '/')
+ && (ffelex_card_image_[column + 1] == '*')))
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ goto parse_nonraw_character; /* :::::::::::::::::::: */
+ }
+ goto parse_raw_character; /* :::::::::::::::::::: */
+ }
+
+ parse_nonraw_character: /* :::::::::::::::::::: */
+
+ switch (ffelex_token_->type)
+ {
+ case FFELEX_typeNONE:
+ switch (c)
+ {
+ case '\"':
+ ffelex_token_->type = FFELEX_typeQUOTE;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '$':
+ ffelex_token_->type = FFELEX_typeDOLLAR;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '%':
+ ffelex_token_->type = FFELEX_typePERCENT;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '&':
+ ffelex_token_->type = FFELEX_typeAMPERSAND;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '\'':
+ ffelex_token_->type = FFELEX_typeAPOSTROPHE;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '(':
+ ffelex_token_->type = FFELEX_typeOPEN_PAREN;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case ')':
+ ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '*':
+ ffelex_token_->type = FFELEX_typeASTERISK;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '+':
+ ffelex_token_->type = FFELEX_typePLUS;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case ',':
+ ffelex_token_->type = FFELEX_typeCOMMA;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '-':
+ ffelex_token_->type = FFELEX_typeMINUS;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '.':
+ ffelex_token_->type = FFELEX_typePERIOD;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '/':
+ ffelex_token_->type = FFELEX_typeSLASH;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ ffelex_token_->type
+ = ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_append_to_token_ (c);
+ break;
+
+ case ':':
+ ffelex_token_->type = FFELEX_typeCOLON;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case ';':
+ ffelex_token_->type = FFELEX_typeSEMICOLON;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_permit_include_ = TRUE;
+ ffelex_send_token_ ();
+ ffelex_permit_include_ = FALSE;
+ break;
+
+ case '<':
+ ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '=':
+ ffelex_token_->type = FFELEX_typeEQUALS;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '>':
+ ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '?':
+ ffelex_token_->type = FFELEX_typeQUESTION;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '_':
+ if (1 || ffe_is_90 ())
+ {
+ ffelex_token_->type = FFELEX_typeUNDERSCORE;
+ ffelex_token_->where_line
+ = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col
+ = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+ }
+ /* Fall through. */
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ case 'G':
+ case 'H':
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'L':
+ case 'M':
+ case 'N':
+ case 'O':
+ case 'P':
+ case 'Q':
+ case 'R':
+ case 'S':
+ case 'T':
+ case 'U':
+ case 'V':
+ case 'W':
+ case 'X':
+ case 'Y':
+ case 'Z':
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ case 'g':
+ case 'h':
+ case 'i':
+ case 'j':
+ case 'k':
+ case 'l':
+ case 'm':
+ case 'n':
+ case 'o':
+ case 'p':
+ case 'q':
+ case 'r':
+ case 's':
+ case 't':
+ case 'u':
+ case 'v':
+ case 'w':
+ case 'x':
+ case 'y':
+ case 'z':
+ c = ffesrc_char_source (c);
+
+ if (ffesrc_char_match_init (c, 'H', 'h')
+ && ffelex_expecting_hollerith_ != 0)
+ {
+ ffelex_raw_mode_ = ffelex_expecting_hollerith_;
+ ffelex_token_->type = FFELEX_typeHOLLERITH;
+ ffelex_token_->where_line = ffelex_raw_where_line_;
+ ffelex_token_->where_col = ffelex_raw_where_col_;
+ ffelex_raw_where_line_ = ffewhere_line_unknown ();
+ ffelex_raw_where_col_ = ffewhere_column_unknown ();
+ c = ffelex_card_image_[++column];
+ goto parse_raw_character; /* :::::::::::::::::::: */
+ }
+
+ if (ffelex_names_)
+ {
+ ffelex_token_->where_line
+ = ffewhere_line_use (ffelex_token_->currentnames_line
+ = ffewhere_line_use (ffelex_current_wl_));
+ ffelex_token_->where_col
+ = ffewhere_column_use (ffelex_token_->currentnames_col
+ = ffewhere_column_new (column + 1));
+ ffelex_token_->type = FFELEX_typeNAMES;
+ }
+ else
+ {
+ ffelex_token_->where_line
+ = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_token_->type = FFELEX_typeNAME;
+ }
+ ffelex_append_to_token_ (c);
+ break;
+
+ default:
+ ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER,
+ ffelex_linecount_current_, column + 1);
+ ffelex_finish_statement_ ();
+ disallow_continuation_line = TRUE;
+ ignore_disallowed_continuation = TRUE;
+ goto beginning_of_line_again; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeNAME:
+ switch (c)
+ {
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ case 'G':
+ case 'H':
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'L':
+ case 'M':
+ case 'N':
+ case 'O':
+ case 'P':
+ case 'Q':
+ case 'R':
+ case 'S':
+ case 'T':
+ case 'U':
+ case 'V':
+ case 'W':
+ case 'X':
+ case 'Y':
+ case 'Z':
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ case 'g':
+ case 'h':
+ case 'i':
+ case 'j':
+ case 'k':
+ case 'l':
+ case 'm':
+ case 'n':
+ case 'o':
+ case 'p':
+ case 'q':
+ case 'r':
+ case 's':
+ case 't':
+ case 'u':
+ case 'v':
+ case 'w':
+ case 'x':
+ case 'y':
+ case 'z':
+ c = ffesrc_char_source (c);
+ /* Fall through. */
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ case '_':
+ case '$':
+ if ((c == '$')
+ && !ffe_is_dollar_ok ())
+ {
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ ffelex_append_to_token_ (c);
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeNAMES:
+ switch (c)
+ {
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ case 'G':
+ case 'H':
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'L':
+ case 'M':
+ case 'N':
+ case 'O':
+ case 'P':
+ case 'Q':
+ case 'R':
+ case 'S':
+ case 'T':
+ case 'U':
+ case 'V':
+ case 'W':
+ case 'X':
+ case 'Y':
+ case 'Z':
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ case 'g':
+ case 'h':
+ case 'i':
+ case 'j':
+ case 'k':
+ case 'l':
+ case 'm':
+ case 'n':
+ case 'o':
+ case 'p':
+ case 'q':
+ case 'r':
+ case 's':
+ case 't':
+ case 'u':
+ case 'v':
+ case 'w':
+ case 'x':
+ case 'y':
+ case 'z':
+ c = ffesrc_char_source (c);
+ /* Fall through. */
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ case '_':
+ case '$':
+ if ((c == '$')
+ && !ffe_is_dollar_ok ())
+ {
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ if (ffelex_token_->length < FFEWHERE_indexMAX)
+ {
+ ffewhere_track (&ffelex_token_->currentnames_line,
+ &ffelex_token_->currentnames_col,
+ ffelex_token_->wheretrack,
+ ffelex_token_->length,
+ ffelex_linecount_current_,
+ column + 1);
+ }
+ ffelex_append_to_token_ (c);
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeNUMBER:
+ switch (c)
+ {
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ ffelex_append_to_token_ (c);
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeASTERISK:
+ switch (c)
+ {
+ case '*': /* ** */
+ ffelex_token_->type = FFELEX_typePOWER;
+ ffelex_send_token_ ();
+ break;
+
+ default: /* * not followed by another *. */
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeCOLON:
+ switch (c)
+ {
+ case ':': /* :: */
+ ffelex_token_->type = FFELEX_typeCOLONCOLON;
+ ffelex_send_token_ ();
+ break;
+
+ default: /* : not followed by another :. */
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeSLASH:
+ switch (c)
+ {
+ case '/': /* // */
+ ffelex_token_->type = FFELEX_typeCONCAT;
+ ffelex_send_token_ ();
+ break;
+
+ case ')': /* /) */
+ ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
+ ffelex_send_token_ ();
+ break;
+
+ case '=': /* /= */
+ ffelex_token_->type = FFELEX_typeREL_NE;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ switch (c)
+ {
+ case '/': /* (/ */
+ ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeOPEN_ANGLE:
+ switch (c)
+ {
+ case '=': /* <= */
+ ffelex_token_->type = FFELEX_typeREL_LE;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeEQUALS:
+ switch (c)
+ {
+ case '=': /* == */
+ ffelex_token_->type = FFELEX_typeREL_EQ;
+ ffelex_send_token_ ();
+ break;
+
+ case '>': /* => */
+ ffelex_token_->type = FFELEX_typePOINTS;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeCLOSE_ANGLE:
+ switch (c)
+ {
+ case '=': /* >= */
+ ffelex_token_->type = FFELEX_typeREL_GE;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ assert ("Serious error!!" == NULL);
+ abort ();
+ break;
+ }
+
+ c = ffelex_card_image_[++column];
+
+ parse_next_character: /* :::::::::::::::::::: */
+
+ if (ffelex_raw_mode_ != 0)
+ goto parse_raw_character; /* :::::::::::::::::::: */
+
+ while (c == ' ')
+ c = ffelex_card_image_[++column];
+
+ if ((c == '\0')
+ || (c == '!')
+ || ((c == '/')
+ && (ffelex_card_image_[column + 1] == '*')))
+ {
+ if ((ffelex_number_of_tokens_ == ffelex_label_tokens_)
+ && (ffelex_token_->type == FFELEX_typeNAMES)
+ && (ffelex_token_->length == 3)
+ && (ffesrc_strncmp_2c (ffe_case_match (),
+ ffelex_token_->text,
+ "END", "end", "End",
+ 3)
+ == 0))
+ {
+ ffelex_finish_statement_ ();
+ disallow_continuation_line = TRUE;
+ ignore_disallowed_continuation = FALSE;
+ goto beginning_of_line_again; /* :::::::::::::::::::: */
+ }
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ goto parse_nonraw_character; /* :::::::::::::::::::: */
+}
+
+/* ffelex_file_free -- Lex a given file in free source form
+
+ ffewhere wf;
+ FILE *f;
+ ffelex_file_free(wf,f);
+
+ Lexes the file according to Fortran 90 ANSI + VXT specifications. */
+
+ffelexHandler
+ffelex_file_free (ffewhereFile wf, FILE *f)
+{
+ register int c; /* Character currently under consideration. */
+ register ffewhereColumnNumber column; /* Not really; 0 means column 1... */
+ bool continuation_line;
+ ffewhereColumnNumber continuation_column;
+ int latest_char_in_file; /* For getting back into comment-skipping
+ code. */
+
+ /* Lex is called for a particular file, not for a particular program unit.
+ Yet the two events do share common characteristics. The first line in a
+ file or in a program unit cannot be a continuation line. No token can
+ be in mid-formation. No current label for the statement exists, since
+ there is no current statement. */
+
+ assert (ffelex_handler_ != NULL);
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ lineno = 0;
+ input_filename = ffewhere_file_name (wf);
+#endif
+ ffelex_current_wf_ = wf;
+ continuation_line = FALSE;
+ ffelex_token_->type = FFELEX_typeNONE;
+ ffelex_number_of_tokens_ = 0;
+ ffelex_current_wl_ = ffewhere_line_unknown ();
+ ffelex_current_wc_ = ffewhere_column_unknown ();
+ latest_char_in_file = '\n';
+
+ /* Come here to get a new line. */
+
+ beginning_of_line: /* :::::::::::::::::::: */
+
+ c = latest_char_in_file;
+ if ((c == EOF) || ((c = ffelex_getc_ (f)) == EOF))
+ {
+
+ end_of_file: /* :::::::::::::::::::: */
+
+ /* Line ending in EOF instead of \n still counts as a whole line. */
+
+ ffelex_finish_statement_ ();
+ ffewhere_line_kill (ffelex_current_wl_);
+ ffewhere_column_kill (ffelex_current_wc_);
+ return (ffelexHandler) ffelex_handler_;
+ }
+
+ ffelex_next_line_ ();
+
+ ffelex_bad_line_ = FALSE;
+
+ /* Skip over initial-comment and empty lines as quickly as possible! */
+
+ while ((c == '\n')
+ || (c == '!')
+ || (c == '#'))
+ {
+ if (c == '#')
+ {
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ c = ffelex_hash_ (f);
+#else
+ /* Don't skip over # line after all. */
+ break;
+#endif
+ }
+
+ comment_line: /* :::::::::::::::::::: */
+
+ while ((c != '\n') && (c != EOF))
+ c = getc (f);
+
+ if (c == EOF)
+ {
+ ffelex_next_line_ ();
+ goto end_of_file; /* :::::::::::::::::::: */
+ }
+
+ c = getc (f);
+
+ ffelex_next_line_ ();
+
+ if (c == EOF)
+ goto end_of_file; /* :::::::::::::::::::: */
+ }
+
+ ffelex_saw_tab_ = FALSE;
+
+ column = ffelex_image_char_ (c, 0);
+
+ /* Read the entire line in as is (with whitespace processing). */
+
+ while (((c = getc (f)) != '\n') && (c != EOF))
+ column = ffelex_image_char_ (c, column);
+
+ if (ffelex_bad_line_)
+ {
+ ffelex_card_image_[column] = '\0';
+ ffelex_card_length_ = column;
+ goto comment_line; /* :::::::::::::::::::: */
+ }
+
+ /* If no tab, cut off line after column 132. */
+
+ if (!ffelex_saw_tab_ && (column > FFELEX_FREE_MAX_COLUMNS_))
+ column = FFELEX_FREE_MAX_COLUMNS_;
+
+ ffelex_card_image_[column] = '\0';
+ ffelex_card_length_ = column;
+
+ /* Save next char in file so we can use register-based c while analyzing
+ line we just read. */
+
+ latest_char_in_file = c; /* Should be either '\n' or EOF. */
+
+ column = 0;
+ continuation_column = 0;
+
+ /* Skip over initial spaces to see if the first nonblank character
+ is exclamation point, newline, or EOF (line is therefore a comment) or
+ ampersand (line is therefore a continuation line). */
+
+ while ((c = ffelex_card_image_[column]) == ' ')
+ ++column;
+
+ switch (c)
+ {
+ case '!':
+ case '\0':
+ goto beginning_of_line; /* :::::::::::::::::::: */
+
+ case '&':
+ continuation_column = column + 1;
+ break;
+
+ default:
+ break;
+ }
+
+ /* The line definitely has content of some kind, install new end-statement
+ point for error messages. */
+
+ ffewhere_line_kill (ffelex_current_wl_);
+ ffewhere_column_kill (ffelex_current_wc_);
+ ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_);
+ ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1);
+
+ /* Figure out which column to start parsing at. */
+
+ if (continuation_line)
+ {
+ if (continuation_column == 0)
+ {
+ if (ffelex_raw_mode_ != 0)
+ {
+ ffelex_bad_1_ (FFEBAD_BAD_CHAR_CONTINUE,
+ ffelex_linecount_current_, column + 1);
+ }
+ else if (ffelex_token_->type != FFELEX_typeNONE)
+ {
+ ffelex_bad_1_ (FFEBAD_BAD_LEXTOK_CONTINUE,
+ ffelex_linecount_current_, column + 1);
+ }
+ }
+ else if (ffelex_is_free_char_ctx_contin_ (continuation_column))
+ { /* Line contains only a single "&" as only
+ nonblank character. */
+ ffelex_bad_1_ (FFEBAD_BAD_FREE_CONTINUE,
+ ffelex_linecount_current_, continuation_column);
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ column = continuation_column;
+ }
+ else
+ column = 0;
+
+ c = ffelex_card_image_[column];
+ continuation_line = FALSE;
+
+ /* Here is the main engine for parsing. c holds the character at column.
+ It is already known that c is not a blank, end of line, or shriek,
+ unless ffelex_raw_mode_ is not 0 (indicating we are in a
+ character/hollerith constant). A partially filled token may already
+ exist in ffelex_token_. */
+
+ if (ffelex_raw_mode_ != 0)
+ {
+
+ parse_raw_character: /* :::::::::::::::::::: */
+
+ switch (c)
+ {
+ case '&':
+ if (ffelex_is_free_char_ctx_contin_ (column + 1))
+ {
+ continuation_line = TRUE;
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case '\0':
+ ffelex_finish_statement_ ();
+ goto beginning_of_line; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+
+ switch (ffelex_raw_mode_)
+ {
+ case -3:
+ c = ffelex_backslash_ (c, column);
+ if (c == EOF)
+ break;
+
+ if (!ffelex_backslash_reconsider_)
+ ffelex_append_to_token_ (c);
+ ffelex_raw_mode_ = -1;
+ break;
+
+ case -2:
+ if (c == ffelex_raw_char_)
+ {
+ ffelex_raw_mode_ = -1;
+ ffelex_append_to_token_ (c);
+ }
+ else
+ {
+ ffelex_raw_mode_ = 0;
+ ffelex_backslash_reconsider_ = TRUE;
+ }
+ break;
+
+ case -1:
+ if (c == ffelex_raw_char_)
+ ffelex_raw_mode_ = -2;
+ else
+ {
+ c = ffelex_backslash_ (c, column);
+ if (c == EOF)
+ {
+ ffelex_raw_mode_ = -3;
+ break;
+ }
+
+ ffelex_append_to_token_ (c);
+ }
+ break;
+
+ default:
+ c = ffelex_backslash_ (c, column);
+ if (c == EOF)
+ break;
+
+ if (!ffelex_backslash_reconsider_)
+ {
+ ffelex_append_to_token_ (c);
+ --ffelex_raw_mode_;
+ }
+ break;
+ }
+
+ if (ffelex_backslash_reconsider_)
+ ffelex_backslash_reconsider_ = FALSE;
+ else
+ c = ffelex_card_image_[++column];
+
+ if (ffelex_raw_mode_ == 0)
+ {
+ ffelex_send_token_ ();
+ assert (ffelex_raw_mode_ == 0);
+ while (c == ' ')
+ c = ffelex_card_image_[++column];
+ if ((c == '\0') || (c == '!'))
+ {
+ ffelex_finish_statement_ ();
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
+ {
+ continuation_line = TRUE;
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ goto parse_nonraw_character_noncontin; /* :::::::::::::::::::: */
+ }
+ goto parse_raw_character; /* :::::::::::::::::::: */
+ }
+
+ parse_nonraw_character: /* :::::::::::::::::::: */
+
+ if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
+ {
+ continuation_line = TRUE;
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+
+ parse_nonraw_character_noncontin: /* :::::::::::::::::::: */
+
+ switch (ffelex_token_->type)
+ {
+ case FFELEX_typeNONE:
+ if (c == ' ')
+ { /* Otherwise
+ finish-statement/continue-statement
+ already checked. */
+ while (c == ' ')
+ c = ffelex_card_image_[++column];
+ if ((c == '\0') || (c == '!'))
+ {
+ ffelex_finish_statement_ ();
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
+ {
+ continuation_line = TRUE;
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ }
+
+ switch (c)
+ {
+ case '\"':
+ ffelex_token_->type = FFELEX_typeQUOTE;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '$':
+ ffelex_token_->type = FFELEX_typeDOLLAR;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '%':
+ ffelex_token_->type = FFELEX_typePERCENT;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '&':
+ ffelex_token_->type = FFELEX_typeAMPERSAND;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '\'':
+ ffelex_token_->type = FFELEX_typeAPOSTROPHE;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '(':
+ ffelex_token_->type = FFELEX_typeOPEN_PAREN;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case ')':
+ ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '*':
+ ffelex_token_->type = FFELEX_typeASTERISK;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '+':
+ ffelex_token_->type = FFELEX_typePLUS;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case ',':
+ ffelex_token_->type = FFELEX_typeCOMMA;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '-':
+ ffelex_token_->type = FFELEX_typeMINUS;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '.':
+ ffelex_token_->type = FFELEX_typePERIOD;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '/':
+ ffelex_token_->type = FFELEX_typeSLASH;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ ffelex_token_->type
+ = ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_append_to_token_ (c);
+ break;
+
+ case ':':
+ ffelex_token_->type = FFELEX_typeCOLON;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case ';':
+ ffelex_token_->type = FFELEX_typeSEMICOLON;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_permit_include_ = TRUE;
+ ffelex_send_token_ ();
+ ffelex_permit_include_ = FALSE;
+ break;
+
+ case '<':
+ ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '=':
+ ffelex_token_->type = FFELEX_typeEQUALS;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '>':
+ ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ break;
+
+ case '?':
+ ffelex_token_->type = FFELEX_typeQUESTION;
+ ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+
+ case '_':
+ if (1 || ffe_is_90 ())
+ {
+ ffelex_token_->type = FFELEX_typeUNDERSCORE;
+ ffelex_token_->where_line
+ = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col
+ = ffewhere_column_new (column + 1);
+ ffelex_send_token_ ();
+ break;
+ }
+ /* Fall through. */
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ case 'G':
+ case 'H':
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'L':
+ case 'M':
+ case 'N':
+ case 'O':
+ case 'P':
+ case 'Q':
+ case 'R':
+ case 'S':
+ case 'T':
+ case 'U':
+ case 'V':
+ case 'W':
+ case 'X':
+ case 'Y':
+ case 'Z':
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ case 'g':
+ case 'h':
+ case 'i':
+ case 'j':
+ case 'k':
+ case 'l':
+ case 'm':
+ case 'n':
+ case 'o':
+ case 'p':
+ case 'q':
+ case 'r':
+ case 's':
+ case 't':
+ case 'u':
+ case 'v':
+ case 'w':
+ case 'x':
+ case 'y':
+ case 'z':
+ c = ffesrc_char_source (c);
+
+ if (ffesrc_char_match_init (c, 'H', 'h')
+ && ffelex_expecting_hollerith_ != 0)
+ {
+ ffelex_raw_mode_ = ffelex_expecting_hollerith_;
+ ffelex_token_->type = FFELEX_typeHOLLERITH;
+ ffelex_token_->where_line = ffelex_raw_where_line_;
+ ffelex_token_->where_col = ffelex_raw_where_col_;
+ ffelex_raw_where_line_ = ffewhere_line_unknown ();
+ ffelex_raw_where_col_ = ffewhere_column_unknown ();
+ c = ffelex_card_image_[++column];
+ goto parse_raw_character; /* :::::::::::::::::::: */
+ }
+
+ if (ffelex_names_pure_)
+ {
+ ffelex_token_->where_line
+ = ffewhere_line_use (ffelex_token_->currentnames_line
+ = ffewhere_line_use (ffelex_current_wl_));
+ ffelex_token_->where_col
+ = ffewhere_column_use (ffelex_token_->currentnames_col
+ = ffewhere_column_new (column + 1));
+ ffelex_token_->type = FFELEX_typeNAMES;
+ }
+ else
+ {
+ ffelex_token_->where_line
+ = ffewhere_line_use (ffelex_current_wl_);
+ ffelex_token_->where_col = ffewhere_column_new (column + 1);
+ ffelex_token_->type = FFELEX_typeNAME;
+ }
+ ffelex_append_to_token_ (c);
+ break;
+
+ default:
+ ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER,
+ ffelex_linecount_current_, column + 1);
+ ffelex_finish_statement_ ();
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeNAME:
+ switch (c)
+ {
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ case 'G':
+ case 'H':
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'L':
+ case 'M':
+ case 'N':
+ case 'O':
+ case 'P':
+ case 'Q':
+ case 'R':
+ case 'S':
+ case 'T':
+ case 'U':
+ case 'V':
+ case 'W':
+ case 'X':
+ case 'Y':
+ case 'Z':
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ case 'g':
+ case 'h':
+ case 'i':
+ case 'j':
+ case 'k':
+ case 'l':
+ case 'm':
+ case 'n':
+ case 'o':
+ case 'p':
+ case 'q':
+ case 'r':
+ case 's':
+ case 't':
+ case 'u':
+ case 'v':
+ case 'w':
+ case 'x':
+ case 'y':
+ case 'z':
+ c = ffesrc_char_source (c);
+ /* Fall through. */
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ case '_':
+ case '$':
+ if ((c == '$')
+ && !ffe_is_dollar_ok ())
+ {
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ ffelex_append_to_token_ (c);
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeNAMES:
+ switch (c)
+ {
+ case 'A':
+ case 'B':
+ case 'C':
+ case 'D':
+ case 'E':
+ case 'F':
+ case 'G':
+ case 'H':
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'L':
+ case 'M':
+ case 'N':
+ case 'O':
+ case 'P':
+ case 'Q':
+ case 'R':
+ case 'S':
+ case 'T':
+ case 'U':
+ case 'V':
+ case 'W':
+ case 'X':
+ case 'Y':
+ case 'Z':
+ case 'a':
+ case 'b':
+ case 'c':
+ case 'd':
+ case 'e':
+ case 'f':
+ case 'g':
+ case 'h':
+ case 'i':
+ case 'j':
+ case 'k':
+ case 'l':
+ case 'm':
+ case 'n':
+ case 'o':
+ case 'p':
+ case 'q':
+ case 'r':
+ case 's':
+ case 't':
+ case 'u':
+ case 'v':
+ case 'w':
+ case 'x':
+ case 'y':
+ case 'z':
+ c = ffesrc_char_source (c);
+ /* Fall through. */
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ case '_':
+ case '$':
+ if ((c == '$')
+ && !ffe_is_dollar_ok ())
+ {
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ if (ffelex_token_->length < FFEWHERE_indexMAX)
+ {
+ ffewhere_track (&ffelex_token_->currentnames_line,
+ &ffelex_token_->currentnames_col,
+ ffelex_token_->wheretrack,
+ ffelex_token_->length,
+ ffelex_linecount_current_,
+ column + 1);
+ }
+ ffelex_append_to_token_ (c);
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeNUMBER:
+ switch (c)
+ {
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ ffelex_append_to_token_ (c);
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeASTERISK:
+ switch (c)
+ {
+ case '*': /* ** */
+ ffelex_token_->type = FFELEX_typePOWER;
+ ffelex_send_token_ ();
+ break;
+
+ default: /* * not followed by another *. */
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeCOLON:
+ switch (c)
+ {
+ case ':': /* :: */
+ ffelex_token_->type = FFELEX_typeCOLONCOLON;
+ ffelex_send_token_ ();
+ break;
+
+ default: /* : not followed by another :. */
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeSLASH:
+ switch (c)
+ {
+ case '/': /* // */
+ ffelex_token_->type = FFELEX_typeCONCAT;
+ ffelex_send_token_ ();
+ break;
+
+ case ')': /* /) */
+ ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
+ ffelex_send_token_ ();
+ break;
+
+ case '=': /* /= */
+ ffelex_token_->type = FFELEX_typeREL_NE;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ switch (c)
+ {
+ case '/': /* (/ */
+ ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeOPEN_ANGLE:
+ switch (c)
+ {
+ case '=': /* <= */
+ ffelex_token_->type = FFELEX_typeREL_LE;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeEQUALS:
+ switch (c)
+ {
+ case '=': /* == */
+ ffelex_token_->type = FFELEX_typeREL_EQ;
+ ffelex_send_token_ ();
+ break;
+
+ case '>': /* => */
+ ffelex_token_->type = FFELEX_typePOINTS;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ case FFELEX_typeCLOSE_ANGLE:
+ switch (c)
+ {
+ case '=': /* >= */
+ ffelex_token_->type = FFELEX_typeREL_GE;
+ ffelex_send_token_ ();
+ break;
+
+ default:
+ ffelex_send_token_ ();
+ goto parse_next_character; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ assert ("Serious error!" == NULL);
+ abort ();
+ break;
+ }
+
+ c = ffelex_card_image_[++column];
+
+ parse_next_character: /* :::::::::::::::::::: */
+
+ if (ffelex_raw_mode_ != 0)
+ goto parse_raw_character; /* :::::::::::::::::::: */
+
+ if ((c == '\0') || (c == '!'))
+ {
+ ffelex_finish_statement_ ();
+ goto beginning_of_line; /* :::::::::::::::::::: */
+ }
+ goto parse_nonraw_character; /* :::::::::::::::::::: */
+}
+
+/* See the code in com.c that calls this to understand why. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+void
+ffelex_hash_kludge (FILE *finput)
+{
+ /* If you change this constant string, you have to change whatever
+ code might thus be affected by it in terms of having to use
+ ffelex_getc_() instead of getc() in the lexers and _hash_. */
+ static char match[] = "# 1 \"";
+ static int kludge[ARRAY_SIZE (match) + 1];
+ int c;
+ char *p;
+ int *q;
+
+ /* Read chars as long as they match the target string.
+ Copy them into an array that will serve as a record
+ of what we read (essentially a multi-char ungetc(),
+ for code that uses ffelex_getc_ instead of getc() elsewhere
+ in the lexer. */
+ for (p = &match[0], q = &kludge[0], c = getc (finput);
+ (c == *p) && (*p != '\0') && (c != EOF);
+ ++p, ++q, c = getc (finput))
+ *q = c;
+
+ *q = c; /* Might be EOF, which requires int. */
+ *++q = 0;
+
+ ffelex_kludge_chars_ = &kludge[0];
+
+ if (*p == 0)
+ {
+ ffelex_kludge_flag_ = TRUE;
+ ++ffelex_kludge_chars_;
+ ffelex_hash_ (finput); /* Handle it NOW rather than later. */
+ ffelex_kludge_flag_ = FALSE;
+ }
+}
+
+#endif
+void
+ffelex_init_1 ()
+{
+ unsigned int i;
+
+ ffelex_final_nontab_column_ = ffe_fixed_line_length ();
+ ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
+ ffelex_card_image_ = malloc_new_ksr (malloc_pool_image (),
+ "FFELEX card image",
+ FFELEX_columnINITIAL_SIZE_ + 9);
+ ffelex_card_image_[0] = '\0';
+
+ for (i = 0; i < 256; ++i)
+ ffelex_first_char_[i] = FFELEX_typeERROR;
+
+ ffelex_first_char_['\t'] = FFELEX_typeRAW;
+ ffelex_first_char_['\n'] = FFELEX_typeCOMMENT;
+ ffelex_first_char_['\v'] = FFELEX_typeCOMMENT;
+ ffelex_first_char_['\f'] = FFELEX_typeCOMMENT;
+ ffelex_first_char_['\r'] = FFELEX_typeRAW;
+ ffelex_first_char_[' '] = FFELEX_typeRAW;
+ ffelex_first_char_['!'] = FFELEX_typeCOMMENT;
+ ffelex_first_char_['*'] = FFELEX_typeCOMMENT;
+ ffelex_first_char_['/'] = FFELEX_typeSLASH;
+ ffelex_first_char_['&'] = FFELEX_typeRAW;
+ ffelex_first_char_['#'] = FFELEX_typeHASH;
+
+ for (i = '0'; i <= '9'; ++i)
+ ffelex_first_char_[i] = FFELEX_typeRAW;
+
+ if ((ffe_case_match () == FFE_caseNONE)
+ || ((ffe_case_match () == FFE_caseUPPER)
+ && (ffe_case_source () != FFE_caseLOWER)) /* Idiot! :-) */
+ || ((ffe_case_match () == FFE_caseLOWER)
+ && (ffe_case_source () == FFE_caseLOWER)))
+ {
+ ffelex_first_char_['C'] = FFELEX_typeCOMMENT;
+ ffelex_first_char_['D'] = FFELEX_typeCOMMENT;
+ }
+ if ((ffe_case_match () == FFE_caseNONE)
+ || ((ffe_case_match () == FFE_caseLOWER)
+ && (ffe_case_source () != FFE_caseUPPER)) /* Idiot! :-) */
+ || ((ffe_case_match () == FFE_caseUPPER)
+ && (ffe_case_source () == FFE_caseUPPER)))
+ {
+ ffelex_first_char_['c'] = FFELEX_typeCOMMENT;
+ ffelex_first_char_['d'] = FFELEX_typeCOMMENT;
+ }
+
+ ffelex_linecount_current_ = 0;
+ ffelex_linecount_next_ = 1;
+ ffelex_raw_mode_ = 0;
+ ffelex_set_include_ = FALSE;
+ ffelex_permit_include_ = FALSE;
+ ffelex_names_ = TRUE; /* First token in program is a names. */
+ ffelex_names_pure_ = FALSE; /* Free-form lexer does NAMES only for
+ FORMAT. */
+ ffelex_hexnum_ = FALSE;
+ ffelex_expecting_hollerith_ = 0;
+ ffelex_raw_where_line_ = ffewhere_line_unknown ();
+ ffelex_raw_where_col_ = ffewhere_column_unknown ();
+
+ ffelex_token_ = ffelex_token_new_ ();
+ ffelex_token_->type = FFELEX_typeNONE;
+ ffelex_token_->uses = 1;
+ ffelex_token_->where_line = ffewhere_line_unknown ();
+ ffelex_token_->where_col = ffewhere_column_unknown ();
+ ffelex_token_->text = NULL;
+
+ ffelex_handler_ = NULL;
+}
+
+/* ffelex_is_names_expected -- Is the current parser expecting NAMES vs. NAME?
+
+ if (ffelex_is_names_expected())
+ // Deliver NAMES token
+ else
+ // Deliver NAME token
+
+ Must be called while lexer is active, obviously. */
+
+bool
+ffelex_is_names_expected ()
+{
+ return ffelex_names_;
+}
+
+/* Current card image, which has the master linecount number
+ ffelex_linecount_current_. */
+
+char *
+ffelex_line ()
+{
+ return ffelex_card_image_;
+}
+
+/* ffelex_line_length -- Return length of current lexer line
+
+ printf("Length is %lu\n",ffelex_line_length());
+
+ Must be called while lexer is active, obviously. */
+
+ffewhereColumnNumber
+ffelex_line_length ()
+{
+ return ffelex_card_length_;
+}
+
+/* Master line count of current card image, or 0 if no card image
+ is current. */
+
+ffewhereLineNumber
+ffelex_line_number ()
+{
+ return ffelex_linecount_current_;
+}
+
+/* ffelex_set_expecting_hollerith -- Set hollerith expectation status
+
+ ffelex_set_expecting_hollerith(0);
+
+ Lex initially assumes no hollerith constant is about to show up. If
+ syntactic analysis expects one, it should call this function with the
+ number of characters expected in the constant immediately after recognizing
+ the decimal number preceding the "H" and the constant itself. Then, if
+ the next character is indeed H, the lexer will interpret it as beginning
+ a hollerith constant and ship the token formed by reading the specified
+ number of characters (interpreting blanks and otherwise-comments too)
+ from the input file. It is up to syntactic analysis to call this routine
+ again with 0 to turn hollerith detection off immediately upon receiving
+ the token that might or might not be HOLLERITH.
+
+ Also call this after seeing an APOSTROPHE or QUOTE token that begins a
+ character constant. Pass the expected termination character (apostrophe
+ or quote).
+
+ Pass for length either the length of the hollerith (must be > 0), -1
+ meaning expecting a character constant, or 0 to cancel expectation of
+ a hollerith only after calling it with a length of > 0 and receiving the
+ next token (which may or may not have been a HOLLERITH token).
+
+ Pass for which either an apostrophe or quote when passing length of -1.
+ Else which is a don't-care.
+
+ Pass for line and column the line/column info for the token beginning the
+ character or hollerith constant, for use in error messages, when passing
+ a length of -1 -- this function will invoke ffewhere_line/column_use to
+ make its own copies. Else line and column are don't-cares (when length
+ is 0) and the outstanding copies of the previous line/column info, if
+ still around, are killed.
+
+ 21-Feb-90 JCB 3.1
+ When called with length of 0, also zero ffelex_raw_mode_. This is
+ so ffest_save_ can undo the effects of replaying tokens like
+ APOSTROPHE and QUOTE.
+ 25-Jan-90 JCB 3.0
+ New line, column arguments allow error messages to point to the true
+ beginning of a character/hollerith constant, rather than the beginning
+ of the content part, which makes them more consistent and helpful.
+ 05-Nov-89 JCB 2.0
+ New "which" argument allows caller to specify termination character,
+ which should be apostrophe or double-quote, to support Fortran 90. */
+
+void
+ffelex_set_expecting_hollerith (long length, char which,
+ ffewhereLine line, ffewhereColumn column)
+{
+
+ /* First kill the pending line/col info, if any (should only be pending
+ when this call has length==0, the previous call had length>0, and a
+ non-HOLLERITH token was sent in between the calls, but play it safe). */
+
+ ffewhere_line_kill (ffelex_raw_where_line_);
+ ffewhere_column_kill (ffelex_raw_where_col_);
+
+ /* Now handle the length function. */
+ switch (length)
+ {
+ case 0:
+ ffelex_expecting_hollerith_ = 0;
+ ffelex_raw_mode_ = 0;
+ ffelex_raw_where_line_ = ffewhere_line_unknown ();
+ ffelex_raw_where_col_ = ffewhere_column_unknown ();
+ return; /* Don't set new line/column info from args. */
+
+ case -1:
+ ffelex_raw_mode_ = -1;
+ ffelex_raw_char_ = which;
+ break;
+
+ default: /* length > 0 */
+ ffelex_expecting_hollerith_ = length;
+ break;
+ }
+
+ /* Now set new line/column information from passed args. */
+
+ ffelex_raw_where_line_ = ffewhere_line_use (line);
+ ffelex_raw_where_col_ = ffewhere_column_use (column);
+}
+
+/* ffelex_set_handler -- Set handler for tokens before calling _fixed or _free
+
+ ffelex_set_handler((ffelexHandler) my_first_handler);
+
+ Must be called before calling ffelex_file_fixed or ffelex_file_free or
+ after they return, but not while they are active. */
+
+void
+ffelex_set_handler (ffelexHandler first)
+{
+ ffelex_handler_ = first;
+}
+
+/* ffelex_set_hexnum -- Set hexnum flag
+
+ ffelex_set_hexnum(TRUE);
+
+ Lex normally interprets a token starting with [0-9] as a NUMBER token,
+ so if it sees a [A-Za-z] in it, it stops parsing the NUMBER and leaves
+ the character as the first of the next token. But when parsing a
+ hexadecimal number, by calling this function with TRUE before starting
+ the parse of the token itself, lex will interpret [0-9] as the start
+ of a NAME token. */
+
+void
+ffelex_set_hexnum (bool f)
+{
+ ffelex_hexnum_ = f;
+}
+
+/* ffelex_set_include -- Set INCLUDE file to be processed next
+
+ ffewhereFile wf; // The ffewhereFile object for the file.
+ bool free_form; // TRUE means read free-form file, FALSE fixed-form.
+ FILE *fi; // The file to INCLUDE.
+ ffelex_set_include(wf,free_form,fi);
+
+ Must be called only after receiving the EOS token following a valid
+ INCLUDE statement specifying a file that has already been successfully
+ opened. */
+
+void
+ffelex_set_include (ffewhereFile wf, bool free_form, FILE *fi)
+{
+ assert (ffelex_permit_include_);
+ assert (!ffelex_set_include_);
+ ffelex_set_include_ = TRUE;
+ ffelex_include_free_form_ = free_form;
+ ffelex_include_file_ = fi;
+ ffelex_include_wherefile_ = wf;
+}
+
+/* ffelex_set_names -- Set names/name flag, names = TRUE
+
+ ffelex_set_names(FALSE);
+
+ Lex initially assumes multiple names should be formed. If this function is
+ called with FALSE, then single names are formed instead. The differences
+ are a difference in the token type (FFELEX_typeNAMES vs. FFELEX_typeNAME)
+ and in whether full source-location tracking is performed (it is for
+ multiple names, not for single names), which is more expensive in terms of
+ CPU time. */
+
+void
+ffelex_set_names (bool f)
+{
+ ffelex_names_ = f;
+ if (!f)
+ ffelex_names_pure_ = FALSE;
+}
+
+/* ffelex_set_names_pure -- Set names/name (pure) flag, names = TRUE
+
+ ffelex_set_names_pure(FALSE);
+
+ Like ffelex_set_names, except affects both lexers. Normally, the
+ free-form lexer need not generate NAMES tokens because adjacent NAME
+ tokens must be separated by spaces which causes the lexer to generate
+ separate tokens for analysis (whereas in fixed-form the spaces are
+ ignored resulting in one long token). But in FORMAT statements, for
+ some reason, the Fortran 90 standard specifies that spaces can occur
+ anywhere within a format-item-list with no effect on the format spec
+ (except of course within character string edit descriptors), which means
+ that "1PE14.2" and "1 P E 1 4 . 2" are equivalent. For the FORMAT
+ statement handling, the existence of spaces makes it hard to deal with,
+ because each token is seen distinctly (i.e. seven tokens in the latter
+ example). But when no spaces are provided, as in the former example,
+ then only four tokens are generated, NUMBER("1"), NAME("PE14"), PERIOD,
+ NUMBER ("2"). By generating a NAMES instead of NAME, three things happen:
+ One, ffest_kw_format_ does a substring rather than full-string match,
+ and thus matches "PE14" to "PE"; two, ffelex_token_xyz_from_names functions
+ may be used to pull NAME/NAMES and NUMBER tokens out of the NAMES token;
+ and three, error reporting can point to the actual character rather than
+ at or prior to it. The first two things could be resolved by providing
+ alternate functions fairly easy, thus allowing FORMAT handling to expect
+ both lexers to generate NAME tokens instead of NAMES (with otherwise minor
+ changes to FORMAT parsing), but the third, error reporting, would suffer,
+ and when one makes mistakes in a FORMAT, believe me, one wants a pointer
+ to exactly where the compilers thinks the problem is, to even begin to get
+ a handle on it. So there. */
+
+void
+ffelex_set_names_pure (bool f)
+{
+ ffelex_names_pure_ = f;
+ ffelex_names_ = f;
+}
+
+/* ffelex_splice_tokens -- Splice off and send tokens from a NAMES
+
+ return (ffelexHandler) ffelex_splice_tokens(first_handler,master_token,
+ start_char_index);
+
+ Returns first_handler if start_char_index chars into master_token (which
+ must be a NAMES token) is '\0'. Else, creates a subtoken from that
+ char, either NUMBER (if it is a digit), a NAME (if a valid firstnamechar),
+ an UNDERSCORE (if an underscore), or DOLLAR (if a dollar sign)
+ and sends it to first_handler. If anything other than NAME is sent, the
+ character at the end of it in the master token is examined to see if it
+ begins a NAME, NUMBER, UNDERSCORE, or DOLLAR, and, if so,
+ the handler returned by first_handler is invoked with that token, and
+ this process is repeated until the end of the master token or a NAME
+ token is reached. */
+
+ffelexHandler
+ffelex_splice_tokens (ffelexHandler first, ffelexToken master,
+ ffeTokenLength start)
+{
+ char *p;
+ ffeTokenLength i;
+ ffelexToken t;
+
+ p = ffelex_token_text (master) + (i = start);
+
+ while (*p != '\0')
+ {
+ if (isdigit (*p))
+ {
+ t = ffelex_token_number_from_names (master, i);
+ p += ffelex_token_length (t);
+ i += ffelex_token_length (t);
+ }
+ else if (ffesrc_is_name_init (*p))
+ {
+ t = ffelex_token_name_from_names (master, i, 0);
+ p += ffelex_token_length (t);
+ i += ffelex_token_length (t);
+ }
+ else if (*p == '$')
+ {
+ t = ffelex_token_dollar_from_names (master, i);
+ ++p;
+ ++i;
+ }
+ else if (*p == '_')
+ {
+ t = ffelex_token_uscore_from_names (master, i);
+ ++p;
+ ++i;
+ }
+ else
+ {
+ assert ("not a valid NAMES character" == NULL);
+ t = NULL;
+ }
+ assert (first != NULL);
+ first = (ffelexHandler) (*first) (t);
+ ffelex_token_kill (t);
+ }
+
+ return first;
+}
+
+/* ffelex_swallow_tokens -- Eat all tokens delivered to me
+
+ return ffelex_swallow_tokens;
+
+ Return this handler when you don't want to look at any more tokens in the
+ statement because you've encountered an unrecoverable error in the
+ statement. */
+
+ffelexHandler
+ffelex_swallow_tokens (ffelexToken t, ffelexHandler handler)
+{
+ assert (handler != NULL);
+
+ if ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeEOS)
+ || (ffelex_token_type (t) == FFELEX_typeSEMICOLON)))
+ return (ffelexHandler) (*handler) (t);
+
+ ffelex_eos_handler_ = handler;
+ return (ffelexHandler) ffelex_swallow_tokens_;
+}
+
+/* ffelex_token_dollar_from_names -- Return a dollar from within a names token
+
+ ffelexToken t;
+ t = ffelex_token_dollar_from_names(t,6);
+
+ It's as if you made a new token of dollar type having the dollar
+ at, in the example above, the sixth character of the NAMES token. */
+
+ffelexToken
+ffelex_token_dollar_from_names (ffelexToken t, ffeTokenLength start)
+{
+ ffelexToken nt;
+
+ assert (t != NULL);
+ assert (ffelex_token_type (t) == FFELEX_typeNAMES);
+ assert (start < t->length);
+ assert (t->text[start] == '$');
+
+ /* Now make the token. */
+
+ nt = ffelex_token_new_ ();
+ nt->type = FFELEX_typeDOLLAR;
+ nt->length = 0;
+ nt->uses = 1;
+ ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
+ t->where_col, t->wheretrack, start);
+ nt->text = NULL;
+ return nt;
+}
+
+/* ffelex_token_kill -- Decrement use count for token, kill if no uses left
+
+ ffelexToken t;
+ ffelex_token_kill(t);
+
+ Complements a call to ffelex_token_use or ffelex_token_new_.... */
+
+void
+ffelex_token_kill (ffelexToken t)
+{
+ assert (t != NULL);
+
+ assert (t->uses > 0);
+
+ if (--t->uses != 0)
+ return;
+
+ --ffelex_total_tokens_;
+
+ if (t->type == FFELEX_typeNAMES)
+ ffewhere_track_kill (t->where_line, t->where_col,
+ t->wheretrack, t->length);
+ ffewhere_line_kill (t->where_line);
+ ffewhere_column_kill (t->where_col);
+ if (t->text != NULL)
+ malloc_kill_ksr (malloc_pool_image (), t->text, t->size + 1);
+ malloc_kill_ks (malloc_pool_image (), t, sizeof (*t));
+}
+
+/* Make a new NAME token that is a substring of a NAMES token. */
+
+ffelexToken
+ffelex_token_name_from_names (ffelexToken t, ffeTokenLength start,
+ ffeTokenLength len)
+{
+ ffelexToken nt;
+
+ assert (t != NULL);
+ assert (ffelex_token_type (t) == FFELEX_typeNAMES);
+ assert (start < t->length);
+ if (len == 0)
+ len = t->length - start;
+ else
+ {
+ assert (len > 0);
+ assert ((start + len) <= t->length);
+ }
+ assert (ffelex_is_firstnamechar (t->text[start]));
+
+ nt = ffelex_token_new_ ();
+ nt->type = FFELEX_typeNAME;
+ nt->size = len; /* Assume nobody's gonna fiddle with token
+ text. */
+ nt->length = len;
+ nt->uses = 1;
+ ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
+ t->where_col, t->wheretrack, start);
+ nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
+ len + 1);
+ strncpy (nt->text, t->text + start, len);
+ nt->text[len] = '\0';
+ return nt;
+}
+
+/* Make a new NAMES token that is a substring of another NAMES token. */
+
+ffelexToken
+ffelex_token_names_from_names (ffelexToken t, ffeTokenLength start,
+ ffeTokenLength len)
+{
+ ffelexToken nt;
+
+ assert (t != NULL);
+ assert (ffelex_token_type (t) == FFELEX_typeNAMES);
+ assert (start < t->length);
+ if (len == 0)
+ len = t->length - start;
+ else
+ {
+ assert (len > 0);
+ assert ((start + len) <= t->length);
+ }
+ assert (ffelex_is_firstnamechar (t->text[start]));
+
+ nt = ffelex_token_new_ ();
+ nt->type = FFELEX_typeNAMES;
+ nt->size = len; /* Assume nobody's gonna fiddle with token
+ text. */
+ nt->length = len;
+ nt->uses = 1;
+ ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
+ t->where_col, t->wheretrack, start);
+ ffewhere_track_copy (nt->wheretrack, t->wheretrack, start, len);
+ nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
+ len + 1);
+ strncpy (nt->text, t->text + start, len);
+ nt->text[len] = '\0';
+ return nt;
+}
+
+/* Make a new CHARACTER token. */
+
+ffelexToken
+ffelex_token_new_character (char *s, ffewhereLine l, ffewhereColumn c)
+{
+ ffelexToken t;
+
+ t = ffelex_token_new_ ();
+ t->type = FFELEX_typeCHARACTER;
+ t->length = t->size = strlen (s); /* Assume it won't get bigger. */
+ t->uses = 1;
+ t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
+ t->size + 1);
+ strcpy (t->text, s);
+ t->where_line = ffewhere_line_use (l);
+ t->where_col = ffewhere_column_new (c);
+ return t;
+}
+
+/* Make a new EOF token right after end of file. */
+
+ffelexToken
+ffelex_token_new_eof ()
+{
+ ffelexToken t;
+
+ t = ffelex_token_new_ ();
+ t->type = FFELEX_typeEOF;
+ t->uses = 1;
+ t->text = NULL;
+ t->where_line = ffewhere_line_new (ffelex_linecount_current_);
+ t->where_col = ffewhere_column_new (1);
+ return t;
+}
+
+/* Make a new NAME token. */
+
+ffelexToken
+ffelex_token_new_name (char *s, ffewhereLine l, ffewhereColumn c)
+{
+ ffelexToken t;
+
+ assert (ffelex_is_firstnamechar (*s));
+
+ t = ffelex_token_new_ ();
+ t->type = FFELEX_typeNAME;
+ t->length = t->size = strlen (s); /* Assume it won't get bigger. */
+ t->uses = 1;
+ t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
+ t->size + 1);
+ strcpy (t->text, s);
+ t->where_line = ffewhere_line_use (l);
+ t->where_col = ffewhere_column_new (c);
+ return t;
+}
+
+/* Make a new NAMES token. */
+
+ffelexToken
+ffelex_token_new_names (char *s, ffewhereLine l, ffewhereColumn c)
+{
+ ffelexToken t;
+
+ assert (ffelex_is_firstnamechar (*s));
+
+ t = ffelex_token_new_ ();
+ t->type = FFELEX_typeNAMES;
+ t->length = t->size = strlen (s); /* Assume it won't get bigger. */
+ t->uses = 1;
+ t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
+ t->size + 1);
+ strcpy (t->text, s);
+ t->where_line = ffewhere_line_use (l);
+ t->where_col = ffewhere_column_new (c);
+ ffewhere_track_clear (t->wheretrack, t->length); /* Assume contiguous
+ names. */
+ return t;
+}
+
+/* Make a new NUMBER token.
+
+ The first character of the string must be a digit, and only the digits
+ are copied into the new number. So this may be used to easily extract
+ a NUMBER token from within any text string. Then the length of the
+ resulting token may be used to calculate where the digits stopped
+ in the original string. */
+
+ffelexToken
+ffelex_token_new_number (char *s, ffewhereLine l, ffewhereColumn c)
+{
+ ffelexToken t;
+ ffeTokenLength len;
+
+ /* How long is the string of decimal digits at s? */
+
+ len = strspn (s, "0123456789");
+
+ /* Make sure there is at least one digit. */
+
+ assert (len != 0);
+
+ /* Now make the token. */
+
+ t = ffelex_token_new_ ();
+ t->type = FFELEX_typeNUMBER;
+ t->length = t->size = len; /* Assume it won't get bigger. */
+ t->uses = 1;
+ t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
+ len + 1);
+ strncpy (t->text, s, len);
+ t->text[len] = '\0';
+ t->where_line = ffewhere_line_use (l);
+ t->where_col = ffewhere_column_new (c);
+ return t;
+}
+
+/* Make a new token of any type that doesn't contain text. A private
+ function that is used by public macros in the interface file. */
+
+ffelexToken
+ffelex_token_new_simple_ (ffelexType type, ffewhereLine l, ffewhereColumn c)
+{
+ ffelexToken t;
+
+ t = ffelex_token_new_ ();
+ t->type = type;
+ t->uses = 1;
+ t->text = NULL;
+ t->where_line = ffewhere_line_use (l);
+ t->where_col = ffewhere_column_new (c);
+ return t;
+}
+
+/* Make a new NUMBER token from an existing NAMES token.
+
+ Like ffelex_token_new_number, this function calculates the length
+ of the digit string itself. */
+
+ffelexToken
+ffelex_token_number_from_names (ffelexToken t, ffeTokenLength start)
+{
+ ffelexToken nt;
+ ffeTokenLength len;
+
+ assert (t != NULL);
+ assert (ffelex_token_type (t) == FFELEX_typeNAMES);
+ assert (start < t->length);
+
+ /* How long is the string of decimal digits at s? */
+
+ len = strspn (t->text + start, "0123456789");
+
+ /* Make sure there is at least one digit. */
+
+ assert (len != 0);
+
+ /* Now make the token. */
+
+ nt = ffelex_token_new_ ();
+ nt->type = FFELEX_typeNUMBER;
+ nt->size = len; /* Assume nobody's gonna fiddle with token
+ text. */
+ nt->length = len;
+ nt->uses = 1;
+ ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
+ t->where_col, t->wheretrack, start);
+ nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
+ len + 1);
+ strncpy (nt->text, t->text + start, len);
+ nt->text[len] = '\0';
+ return nt;
+}
+
+/* Make a new UNDERSCORE token from a NAMES token. */
+
+ffelexToken
+ffelex_token_uscore_from_names (ffelexToken t, ffeTokenLength start)
+{
+ ffelexToken nt;
+
+ assert (t != NULL);
+ assert (ffelex_token_type (t) == FFELEX_typeNAMES);
+ assert (start < t->length);
+ assert (t->text[start] == '_');
+
+ /* Now make the token. */
+
+ nt = ffelex_token_new_ ();
+ nt->type = FFELEX_typeUNDERSCORE;
+ nt->uses = 1;
+ ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
+ t->where_col, t->wheretrack, start);
+ nt->text = NULL;
+ return nt;
+}
+
+/* ffelex_token_use -- Return another instance of a token
+
+ ffelexToken t;
+ t = ffelex_token_use(t);
+
+ In a sense, the new token is a copy of the old, though it might be the
+ same with just a new use count.
+
+ We use the use count method (easy). */
+
+ffelexToken
+ffelex_token_use (ffelexToken t)
+{
+ if (t == NULL)
+ assert ("_token_use: null token" == NULL);
+ t->uses++;
+ return t;
+}
diff --git a/gcc/f/lex.h b/gcc/f/lex.h
new file mode 100644
index 00000000000..bae1147dcc5
--- /dev/null
+++ b/gcc/f/lex.h
@@ -0,0 +1,202 @@
+/* lex.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ lex.c
+
+ Modifications:
+ 22-Aug-89 JCB 1.1
+ Change for new ffewhere interface.
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_lex
+#define _H_f_lex
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFELEX_typeNONE,
+ FFELEX_typeCOMMENT,
+ FFELEX_typeEOS,
+ FFELEX_typeEOF,
+ FFELEX_typeERROR,
+ FFELEX_typeRAW,
+ FFELEX_typeQUOTE,
+ FFELEX_typeDOLLAR,
+ FFELEX_typeHASH,
+ FFELEX_typePERCENT,
+ FFELEX_typeAMPERSAND,
+ FFELEX_typeAPOSTROPHE,
+ FFELEX_typeOPEN_PAREN,
+ FFELEX_typeCLOSE_PAREN,
+ FFELEX_typeASTERISK,
+ FFELEX_typePLUS,
+ FFELEX_typeMINUS,
+ FFELEX_typePERIOD,
+ FFELEX_typeSLASH,
+ FFELEX_typeNUMBER, /* Grep: [0-9][0-9]*. */
+ FFELEX_typeOPEN_ANGLE,
+ FFELEX_typeEQUALS,
+ FFELEX_typeCLOSE_ANGLE,
+ FFELEX_typeNAME, /* Grep: [A-Za-z][A-Za-z0-9_]*. */
+ FFELEX_typeCOMMA,
+ FFELEX_typePOWER, /* "**". */
+ FFELEX_typeCONCAT, /* "//". */
+ FFELEX_typeDEBUG,
+ FFELEX_typeNAMES, /* Same as FFELEX_typeNAME in initial
+ context. */
+ FFELEX_typeHOLLERITH, /* <text> part of <nn>H<text>. */
+ FFELEX_typeCHARACTER, /* <text> part of '<text>' or "<text>". */
+ FFELEX_typeCOLON,
+ FFELEX_typeSEMICOLON,
+ FFELEX_typeUNDERSCORE,
+ FFELEX_typeQUESTION,
+ FFELEX_typeOPEN_ARRAY, /* "(/". */
+ FFELEX_typeCLOSE_ARRAY, /* "/)". */
+ FFELEX_typeCOLONCOLON, /* "::". */
+ FFELEX_typeREL_LE, /* "<=". */
+ FFELEX_typeREL_NE, /* "<>". */
+ FFELEX_typeREL_EQ, /* "==". */
+ FFELEX_typePOINTS, /* "=>". */
+ FFELEX_typeREL_GE, /* ">=". */
+ FFELEX_type
+ } ffelexType;
+
+/* Typedefs. */
+
+typedef struct _lextoken_ *ffelexToken;
+typedef void *lex_sigh_;
+typedef lex_sigh_ (*lex_sigh__) (ffelexToken);
+typedef lex_sigh__ (*ffelexHandler) (ffelexToken);
+
+/* Include files needed by this one. */
+
+#include <ctype.h>
+#include "top.h"
+#include "where.h"
+
+/* Structure definitions. */
+
+struct _lextoken_
+ {
+ long int id_; /* DEBUG ONLY. */
+ ffeTokenLength size;
+ ffeTokenLength length;
+ unsigned short uses;
+ char *text;
+ ffelexType type;
+ ffewhereLine where_line;
+ ffewhereColumn where_col;
+ ffewhereLine currentnames_line; /* For tracking NAMES tokens. */
+ ffewhereColumn currentnames_col; /* For tracking NAMES tokens. */
+ ffewhereTrack wheretrack; /* For tracking NAMES tokens. */
+ };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffelex_display_token (ffelexToken t);
+bool ffelex_expecting_character (void);
+ffelexHandler ffelex_file_fixed (ffewhereFile wf, FILE *f);
+ffelexHandler ffelex_file_free (ffewhereFile wf, FILE *f);
+void ffelex_hash_kludge (FILE *f);
+void ffelex_init_1 (void);
+bool ffelex_is_names_expected (void);
+char *ffelex_line (void);
+ffewhereColumnNumber ffelex_line_length (void);
+ffewhereLineNumber ffelex_line_number (void);
+void ffelex_set_expecting_hollerith (long length, char which,
+ ffewhereLine line,
+ ffewhereColumn column);
+void ffelex_set_handler (ffelexHandler first);
+void ffelex_set_hexnum (bool on);
+void ffelex_set_include (ffewhereFile wf, bool free_form, FILE *fi);
+void ffelex_set_names (bool on);
+void ffelex_set_names_pure (bool on);
+ffelexHandler ffelex_splice_tokens (ffelexHandler first, ffelexToken master,
+ ffeTokenLength start);
+ffelexHandler ffelex_swallow_tokens (ffelexToken t, ffelexHandler handler);
+ffelexToken ffelex_token_dollar_from_names (ffelexToken t,
+ ffeTokenLength start);
+void ffelex_token_kill (ffelexToken t);
+ffelexToken ffelex_token_name_from_names (ffelexToken t,
+ ffeTokenLength start,
+ ffeTokenLength len);
+ffelexToken ffelex_token_names_from_names (ffelexToken t,
+ ffeTokenLength start,
+ ffeTokenLength len);
+ffelexToken ffelex_token_new (void);
+ffelexToken ffelex_token_new_character (char *s, ffewhereLine l,
+ ffewhereColumn c);
+ffelexToken ffelex_token_new_eof (void);
+ffelexToken ffelex_token_new_name (char *s, ffewhereLine l,
+ ffewhereColumn c);
+ffelexToken ffelex_token_new_names (char *s, ffewhereLine l,
+ ffewhereColumn c);
+ffelexToken ffelex_token_new_number (char *s, ffewhereLine l,
+ ffewhereColumn c);
+ffelexToken ffelex_token_new_simple_ (ffelexType type, ffewhereLine l,
+ ffewhereColumn c);
+ffelexToken ffelex_token_number_from_names (ffelexToken t,
+ ffeTokenLength start);
+ffelexToken ffelex_token_uscore_from_names (ffelexToken t,
+ ffeTokenLength start);
+ffelexToken ffelex_token_use (ffelexToken t);
+
+/* Define macros. */
+
+#define ffelex_init_0()
+#define ffelex_init_2()
+#define ffelex_init_3()
+#define ffelex_init_4()
+#define ffelex_is_firstnamechar(c) \
+ (isalpha ((c)) || ((c) == '_'))
+#define ffelex_terminate_0()
+#define ffelex_terminate_1()
+#define ffelex_terminate_2()
+#define ffelex_terminate_3()
+#define ffelex_terminate_4()
+#define ffelex_token_length(t) ((t)->length)
+#define ffelex_token_new_eos(l,c) \
+ ffelex_token_new_simple_ (FFELEX_typeEOS, (l), (c))
+#define ffelex_token_new_period(l,c) \
+ ffelex_token_new_simple_ (FFELEX_typePERIOD, (l), (c))
+#define ffelex_token_strcmp(t1,t2) strcmp ((t1)->text, (t2)->text)
+#define ffelex_token_text(t) ((t)->text)
+#define ffelex_token_type(t) ((t)->type)
+#define ffelex_token_where_column(t) ((t)->where_col)
+#define ffelex_token_where_filename(t) \
+ ffewhere_line_filename ((t)->where_line)
+#define ffelex_token_where_filelinenum(t) \
+ ffewhere_line_filelinenum((t)->where_line)
+#define ffelex_token_where_line(t) ((t)->where_line)
+#define ffelex_token_where_line_number(t) \
+ ffewhere_line_number ((t)->where_line)
+#define ffelex_token_wheretrack(t) ((t)->wheretrack)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/malloc.c b/gcc/f/malloc.c
new file mode 100644
index 00000000000..3b394ead563
--- /dev/null
+++ b/gcc/f/malloc.c
@@ -0,0 +1,565 @@
+/* malloc.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Fast pool-based memory allocation.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "malloc.h"
+
+/* For systems where <stdlib.h> is missing: */
+
+void *malloc (size_t size);
+void *realloc (void *ptr, size_t size);
+
+/* Externals defined here. */
+
+struct _malloc_root_ malloc_root_
+=
+{
+ {
+ &malloc_root_.malloc_pool_image_,
+ &malloc_root_.malloc_pool_image_,
+ (mallocPool) &malloc_root_.malloc_pool_image_.eldest,
+ (mallocPool) &malloc_root_.malloc_pool_image_.eldest,
+ (mallocArea_) &malloc_root_.malloc_pool_image_.first,
+ (mallocArea_) &malloc_root_.malloc_pool_image_.first,
+ 0,
+#if MALLOC_DEBUG
+ 0, 0, 0, 0, 0, 0, 0, '/'
+#endif
+ },
+};
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+static void *malloc_reserve_ = NULL; /* For crashes. */
+#if MALLOC_DEBUG
+static char *malloc_types_[] =
+{"KS", "KSR", "NF", "NFR", "US", "USR"};
+#endif
+
+/* Static functions (internal). */
+
+static void malloc_kill_area_ (mallocPool pool, mallocArea_ a);
+#if MALLOC_DEBUG
+static void malloc_verify_area_ (mallocPool pool, mallocArea_ a);
+#endif
+
+/* Internal macros. */
+
+#if MALLOC_DEBUG
+#define malloc_kill_(ptr,s) do {memset((ptr),127,(s));free((ptr));} while(0)
+#else
+#define malloc_kill_(ptr,s) free((ptr))
+#endif
+
+/* malloc_kill_area_ -- Kill storage area and its object
+
+ malloc_kill_area_(mallocPool pool,mallocArea_ area);
+
+ Does the actual killing of a storage area. */
+
+static void
+malloc_kill_area_ (mallocPool pool UNUSED, mallocArea_ a)
+{
+#if MALLOC_DEBUG
+ assert (strcmp (a->name, ((char *) (a->where)) + a->size) == 0);
+#endif
+ malloc_kill_ (a->where, a->size);
+ a->next->previous = a->previous;
+ a->previous->next = a->next;
+#if MALLOC_DEBUG
+ pool->freed += a->size;
+ pool->frees++;
+#endif
+ malloc_kill_ (a,
+ offsetof (struct _malloc_area_, name)
+ + strlen (a->name) + 1);
+}
+
+/* malloc_verify_area_ -- Verify storage area and its object
+
+ malloc_verify_area_(mallocPool pool,mallocArea_ area);
+
+ Does the actual verifying of a storage area. */
+
+#if MALLOC_DEBUG
+static void
+malloc_verify_area_ (mallocPool pool UNUSED, mallocArea_ a UNUSED)
+{
+ mallocSize s = a->size;
+
+ assert (strcmp (a->name, ((char *) (a->where)) + s) == 0);
+}
+#endif
+
+/* malloc_init -- Initialize malloc cluster
+
+ malloc_init();
+
+ Call malloc_init before you do anything else. */
+
+void
+malloc_init ()
+{
+ if (malloc_reserve_ != NULL)
+ return;
+ malloc_reserve_ = malloc (20 * 1024); /* In case of crash, free this first. */
+ assert (malloc_reserve_ != NULL);
+}
+
+/* malloc_pool_display -- Display a pool
+
+ mallocPool p;
+ malloc_pool_display(p);
+
+ Displays information associated with the pool and its subpools. */
+
+void
+malloc_pool_display (mallocPool p UNUSED)
+{
+#if MALLOC_DEBUG
+ mallocPool q;
+ mallocArea_ a;
+
+ fprintf (dmpout, "Pool \"%s\": bytes allocated=%lu, freed=%lu, old sizes=%lu, new sizes\
+=%lu,\n allocations=%lu, frees=%lu, resizes=%lu, uses=%lu\n Subpools:\n",
+ p->name, p->allocated, p->freed, p->old_sizes, p->new_sizes, p->allocations,
+ p->frees, p->resizes, p->uses);
+
+ for (q = p->eldest; q != (mallocPool) & p->eldest; q = q->next)
+ fprintf (dmpout, " \"%s\"\n", q->name);
+
+ fprintf (dmpout, " Storage areas:\n");
+
+ for (a = p->first; a != (mallocArea_) & p->first; a = a->next)
+ {
+ fprintf (dmpout, " ");
+ malloc_display_ (a);
+ }
+#endif
+}
+
+/* malloc_pool_kill -- Destroy a pool
+
+ mallocPool p;
+ malloc_pool_kill(p);
+
+ Releases all storage associated with the pool and its subpools. */
+
+void
+malloc_pool_kill (mallocPool p)
+{
+ mallocPool q;
+ mallocArea_ a;
+
+ if (--p->uses != 0)
+ return;
+
+#if 0
+ malloc_pool_display (p);
+#endif
+
+ assert (p->next->previous == p);
+ assert (p->previous->next == p);
+
+ /* Kill off all the subpools. */
+
+ while ((q = p->eldest) != (mallocPool) &p->eldest)
+ {
+ q->uses = 1; /* Force the kill. */
+ malloc_pool_kill (q);
+ }
+
+ /* Now free all the storage areas. */
+
+ while ((a = p->first) != (mallocArea_) & p->first)
+ {
+ malloc_kill_area_ (p, a);
+ }
+
+ /* Now remove from list of sibling pools. */
+
+ p->next->previous = p->previous;
+ p->previous->next = p->next;
+
+ /* Finally, free the pool itself. */
+
+ malloc_kill_ (p,
+ offsetof (struct _malloc_pool_, name)
+ + strlen (p->name) + 1);
+}
+
+/* malloc_pool_new -- Make a new pool
+
+ mallocPool p;
+ p = malloc_pool_new("My new pool",malloc_pool_image(),1024);
+
+ Makes a new pool with the given name and default new-chunk allocation. */
+
+mallocPool
+malloc_pool_new (char *name, mallocPool parent,
+ unsigned long chunks UNUSED)
+{
+ mallocPool p;
+
+ if (parent == NULL)
+ parent = malloc_pool_image ();
+
+ p = malloc_new_ (offsetof (struct _malloc_pool_, name)
+ + (MALLOC_DEBUG ? strlen (name) + 1 : 0));
+ p->next = (mallocPool) &(parent->eldest);
+ p->previous = parent->youngest;
+ parent->youngest->next = p;
+ parent->youngest = p;
+ p->eldest = (mallocPool) &(p->eldest);
+ p->youngest = (mallocPool) &(p->eldest);
+ p->first = (mallocArea_) &(p->first);
+ p->last = (mallocArea_) &(p->first);
+ p->uses = 1;
+#if MALLOC_DEBUG
+ p->allocated = p->freed = p->old_sizes = p->new_sizes = p->allocations
+ = p->frees = p->resizes = 0;
+ strcpy (p->name, name);
+#endif
+ return p;
+}
+
+/* malloc_pool_use -- Use an existing pool
+
+ mallocPool p;
+ p = malloc_pool_new(pool);
+
+ Increments use count for pool; means a matching malloc_pool_kill must
+ be performed before a subsequent one will actually kill the pool. */
+
+mallocPool
+malloc_pool_use (mallocPool pool)
+{
+ ++pool->uses;
+ return pool;
+}
+
+/* malloc_display_ -- Display info on a mallocArea_
+
+ mallocArea_ a;
+ malloc_display_(a);
+
+ Simple. */
+
+void
+malloc_display_ (mallocArea_ a UNUSED)
+{
+#if MALLOC_DEBUG
+ fprintf (dmpout, "At %08lX, size=%" mallocSize_f "u, type=%s, \"%s\"\n",
+ (unsigned long) a->where, a->size, malloc_types_[a->type], a->name);
+#endif
+}
+
+/* malloc_find_inpool_ -- Find mallocArea_ for object in pool
+
+ mallocPool pool;
+ void *ptr;
+ mallocArea_ a;
+ a = malloc_find_inpool_(pool,ptr);
+
+ Search for object in list of mallocArea_s, die if not found. */
+
+mallocArea_
+malloc_find_inpool_ (mallocPool pool, void *ptr)
+{
+ mallocArea_ a;
+ mallocArea_ b = (mallocArea_) &pool->first;
+ int n = 0;
+
+ for (a = pool->first; a != (mallocArea_) &pool->first; a = a->next)
+ {
+ assert (("Infinite loop detected" != NULL) && (a != b));
+ if (a->where == ptr)
+ return a;
+ ++n;
+ if (n & 1)
+ b = b->next;
+ }
+ assert ("Couldn't find object in pool!" == NULL);
+ return NULL;
+}
+
+/* malloc_kill_inpool_ -- Kill object
+
+ malloc_kill_inpool_(NULL,MALLOC_typeUS_,ptr,size_in_bytes);
+
+ Find the mallocArea_ for the pointer, make sure the type is proper, and
+ kill both of them. */
+
+void
+malloc_kill_inpool_ (mallocPool pool, mallocType_ type UNUSED,
+ void *ptr, mallocSize s UNUSED)
+{
+ mallocArea_ a;
+
+ if (pool == NULL)
+ pool = malloc_pool_image ();
+
+#if MALLOC_DEBUG
+ assert ((pool == malloc_pool_image ())
+ || malloc_pool_find_ (pool, malloc_pool_image ()));
+#endif
+
+ a = malloc_find_inpool_ (pool, ptr);
+#if MALLOC_DEBUG
+ assert (a->type == type);
+ if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
+ assert (a->size == s);
+#endif
+ malloc_kill_area_ (pool, a);
+}
+
+/* malloc_new_ -- Allocate new object, die if unable
+
+ ptr = malloc_new_(size_in_bytes);
+
+ Call malloc, bomb if it returns NULL. */
+
+void *
+malloc_new_ (mallocSize s)
+{
+ void *ptr;
+ size_t ss = s;
+
+#if MALLOC_DEBUG
+ assert (s == (mallocSize) ss);/* Else alloc is too big for this
+ library/sys. */
+#endif
+
+ ptr = malloc (ss);
+ if (ptr == NULL)
+ {
+ free (malloc_reserve_);
+ assert (ptr != NULL);
+ }
+#if MALLOC_DEBUG
+ memset (ptr, 126, ss); /* Catch some kinds of errors more
+ quickly/reliably. */
+#endif
+ return ptr;
+}
+
+/* malloc_new_inpool_ -- Allocate new object, die if unable
+
+ ptr = malloc_new_inpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes);
+
+ Allocate the structure and allocate a mallocArea_ to describe it, then
+ add it to the list of mallocArea_s for the pool. */
+
+void *
+malloc_new_inpool_ (mallocPool pool, mallocType_ type, char *name, mallocSize s)
+{
+ void *ptr;
+ mallocArea_ a;
+ unsigned short i;
+
+ if (pool == NULL)
+ pool = malloc_pool_image ();
+
+#if MALLOC_DEBUG
+ assert ((pool == malloc_pool_image ())
+ || malloc_pool_find_ (pool, malloc_pool_image ()));
+#endif
+
+ ptr = malloc_new_ (s + (i = (MALLOC_DEBUG ? strlen (name) + 1 : 0)));
+#if MALLOC_DEBUG
+ strcpy (((char *) (ptr)) + s, name);
+#endif
+ a = malloc_new_ (offsetof (struct _malloc_area_, name) + i);
+ switch (type)
+ { /* A little optimization to speed up killing
+ of non-permanent stuff. */
+ case MALLOC_typeKP_:
+ case MALLOC_typeKPR_:
+ a->next = (mallocArea_) &pool->first;
+ break;
+
+ default:
+ a->next = pool->first;
+ break;
+ }
+ a->previous = a->next->previous;
+ a->next->previous = a;
+ a->previous->next = a;
+ a->where = ptr;
+#if MALLOC_DEBUG
+ a->size = s;
+ a->type = type;
+ strcpy (a->name, name);
+ pool->allocated += s;
+ pool->allocations++;
+#endif
+ return ptr;
+}
+
+/* malloc_new_zinpool_ -- Allocate new zeroed object, die if unable
+
+ ptr = malloc_new_zinpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes,0);
+
+ Like malloc_new_inpool_, but zeros out all the bytes in the area (assuming
+ you pass it a 0). */
+
+void *
+malloc_new_zinpool_ (mallocPool pool, mallocType_ type, char *name, mallocSize s,
+ int z)
+{
+ void *ptr;
+
+ ptr = malloc_new_inpool_ (pool, type, name, s);
+ memset (ptr, z, s);
+ return ptr;
+}
+
+/* malloc_pool_find_ -- See if pool is a descendant of another pool
+
+ if (malloc_pool_find_(target_pool,parent_pool)) ...;
+
+ Recursive descent on each of the children of the parent pool, after
+ first checking the children themselves. */
+
+char
+malloc_pool_find_ (mallocPool pool, mallocPool parent)
+{
+ mallocPool p;
+
+ for (p = parent->eldest; p != (mallocPool) & parent->eldest; p = p->next)
+ {
+ if ((p == pool) || malloc_pool_find_ (pool, p))
+ return 1;
+ }
+ return 0;
+}
+
+/* malloc_resize_inpool_ -- Resize existing object in pool
+
+ ptr = malloc_resize_inpool_(NULL,MALLOC_typeUSR_,ptr,new_size,old_size);
+
+ Find the object's mallocArea_, check it out, then do the resizing. */
+
+void *
+malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED,
+ void *ptr, mallocSize ns, mallocSize os UNUSED)
+{
+ mallocArea_ a;
+
+ if (pool == NULL)
+ pool = malloc_pool_image ();
+
+#if MALLOC_DEBUG
+ assert ((pool == malloc_pool_image ())
+ || malloc_pool_find_ (pool, malloc_pool_image ()));
+#endif
+
+ a = malloc_find_inpool_ (pool, ptr);
+#if MALLOC_DEBUG
+ assert (a->type == type);
+ if ((type == MALLOC_typeKSR_) || (type == MALLOC_typeKPR_))
+ assert (a->size == os);
+ assert (strcmp (a->name, ((char *) (ptr)) + os) == 0);
+#endif
+ ptr = malloc_resize_ (ptr, ns + (MALLOC_DEBUG ? strlen (a->name) + 1: 0));
+ a->where = ptr;
+#if MALLOC_DEBUG
+ a->size = ns;
+ strcpy (((char *) (ptr)) + ns, a->name);
+ pool->old_sizes += os;
+ pool->new_sizes += ns;
+ pool->resizes++;
+#endif
+ return ptr;
+}
+
+/* malloc_resize_ -- Reallocate object, die if unable
+
+ ptr = malloc_resize_(ptr,size_in_bytes);
+
+ Call realloc, bomb if it returns NULL. */
+
+void *
+malloc_resize_ (void *ptr, mallocSize s)
+{
+ size_t ss = s;
+
+#if MALLOC_DEBUG
+ assert (s == (mallocSize) ss);/* Too big if failure here. */
+#endif
+
+ ptr = realloc (ptr, ss);
+ if (ptr == NULL)
+ {
+ free (malloc_reserve_);
+ assert (ptr != NULL);
+ }
+ return ptr;
+}
+
+/* malloc_verify_inpool_ -- Verify object
+
+ Find the mallocArea_ for the pointer, make sure the type is proper, and
+ verify both of them. */
+
+void
+malloc_verify_inpool_ (mallocPool pool UNUSED, mallocType_ type UNUSED,
+ void *ptr UNUSED, mallocSize s UNUSED)
+{
+#if MALLOC_DEBUG
+ mallocArea_ a;
+
+ if (pool == NULL)
+ pool = malloc_pool_image ();
+
+ assert ((pool == malloc_pool_image ())
+ || malloc_pool_find_ (pool, malloc_pool_image ()));
+
+ a = malloc_find_inpool_ (pool, ptr);
+ assert (a->type == type);
+ if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
+ assert (a->size == s);
+ malloc_verify_area_ (pool, a);
+#endif
+}
diff --git a/gcc/f/malloc.h b/gcc/f/malloc.h
new file mode 100644
index 00000000000..3d3cd50c404
--- /dev/null
+++ b/gcc/f/malloc.h
@@ -0,0 +1,183 @@
+/* malloc.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ malloc.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_malloc
+#define _H_f_malloc
+
+#ifndef MALLOC_DEBUG
+#define MALLOC_DEBUG 0 /* 1 means check caller's use of this module. */
+#endif
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ MALLOC_typeKS_,
+ MALLOC_typeKSR_,
+ MALLOC_typeKP_,
+ MALLOC_typeKPR_,
+ MALLOC_typeUS_,
+ MALLOC_typeUSR_,
+ MALLOC_type_
+ } mallocType_;
+
+/* Typedefs. */
+
+typedef struct _malloc_area_ *mallocArea_;
+typedef struct _malloc_pool_ *mallocPool;
+typedef unsigned long int mallocSize;
+#define mallocSize_f "l"
+
+/* Include files needed by this one. */
+
+
+/* Structure definitions. */
+
+struct _malloc_area_
+ {
+ mallocArea_ next;
+ mallocArea_ previous;
+ void *where;
+#if MALLOC_DEBUG
+ mallocSize size;
+ mallocType_ type;
+#endif
+ char name[1];
+ };
+
+struct _malloc_pool_
+ {
+ mallocPool next;
+ mallocPool previous;
+ mallocPool eldest;
+ mallocPool youngest;
+ mallocArea_ first;
+ mallocArea_ last;
+ unsigned long uses;
+#if MALLOC_DEBUG
+ mallocSize allocated;
+ mallocSize freed;
+ mallocSize old_sizes;
+ mallocSize new_sizes;
+ unsigned long allocations;
+ unsigned long frees;
+ unsigned long resizes;
+#endif
+ char name[1];
+ };
+
+struct _malloc_root_
+ {
+ struct _malloc_pool_ malloc_pool_image_;
+ };
+
+/* Global objects accessed by users of this module. */
+
+extern struct _malloc_root_ malloc_root_;
+
+/* Declare functions with prototypes. */
+
+void malloc_display_ (mallocArea_ a);
+mallocArea_ malloc_find_inpool_ (mallocPool pool, void *ptr);
+void malloc_init (void);
+void malloc_kill_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
+ mallocSize size);
+void *malloc_new_ (mallocSize size);
+void *malloc_new_inpool_ (mallocPool pool, mallocType_ type, char *name,
+ mallocSize size);
+void *malloc_new_zinpool_ (mallocPool pool, mallocType_ type, char *name,
+ mallocSize size, int z);
+void malloc_pool_display (mallocPool p);
+char malloc_pool_find_ (mallocPool p, mallocPool parent);
+void malloc_pool_kill (mallocPool p);
+mallocPool malloc_pool_new (char *name, mallocPool parent, unsigned long chunks);
+mallocPool malloc_pool_use (mallocPool p);
+void *malloc_resize_ (void *ptr, mallocSize new_size);
+void *malloc_resize_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
+ mallocSize new_size, mallocSize old_size);
+void malloc_verify_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
+ mallocSize size);
+
+/* Define macros. */
+
+#define malloc_new_ks(pool,name,size) \
+ malloc_new_inpool_ (pool,MALLOC_typeKS_,name,size)
+#define malloc_new_ksr(pool,name,size) \
+ malloc_new_inpool_ (pool,MALLOC_typeKSR_,name,size)
+#define malloc_new_kp(pool,name,size) \
+ malloc_new_inpool_ (pool,MALLOC_typeKP_,name,size)
+#define malloc_new_kpr(pool,name,size) \
+ malloc_new_inpool_ (pool,MALLOC_typeKPR_,name,size)
+#define malloc_new_us(pool,name,size) \
+ malloc_new_inpool_ (pool,MALLOC_typeUS_,name,size)
+#define malloc_new_usr(pool,name,size) \
+ malloc_new_inpool_ (pool,MALLOC_typeUSR_,name,size)
+#define malloc_new_zks(pool,name,size,z) \
+ malloc_new_zinpool_ (pool,MALLOC_typeKS_,name,size,z)
+#define malloc_new_zksr(pool,name,size,z) \
+ malloc_new_zinpool_ (pool,MALLOC_typeKSR_,name,size,z)
+#define malloc_new_zkp(pool,name,size,z) \
+ malloc_new_zinpool_ (pool,MALLOC_typeKP_,name,size,z)
+#define malloc_new_zkpr(pool,name,size,z) \
+ malloc_new_zinpool_ (pool,MALLOC_typeKPR_,name,size,z)
+#define malloc_new_zus(pool,name,size,z) \
+ malloc_new_zinpool_ (pool,MALLOC_typeUS_,name,size,z)
+#define malloc_new_zusr(pool,name,size,z) \
+ malloc_new_zinpool_ (pool,MALLOC_typeUSR_,name,size,z)
+#define malloc_kill_ks(pool,ptr,size) \
+ malloc_kill_inpool_ (pool,MALLOC_typeKS_,ptr,size)
+#define malloc_kill_ksr(pool,ptr,size) \
+ malloc_kill_inpool_ (pool,MALLOC_typeKSR_,ptr,size)
+#define malloc_kill_us(pool,ptr) \
+ malloc_kill_inpool_ (pool,MALLOC_typeUS_,ptr,0)
+#define malloc_kill_usr(pool,ptr) \
+ malloc_kill_inpool_ (pool,MALLOC_typeUSR_,ptr,0)
+#define malloc_pool_image() (&malloc_root_.malloc_pool_image_)
+#define malloc_resize_ksr(pool,ptr,new_size,old_size) \
+ malloc_resize_inpool_ (pool,MALLOC_typeKSR_,ptr,new_size,old_size)
+#define malloc_resize_kpr(pool,ptr,new_size,old_size) \
+ malloc_resize_inpool_ (pool,MALLOC_typeKPR_,ptr,new_size,old_size)
+#define malloc_resize_usr(pool,ptr,new_size) \
+ malloc_resize_inpool_ (pool,MALLOC_typeUSR_,ptr,new_size,0)
+#define malloc_verify_kp(pool,name,size) \
+ malloc_verify_inpool_ (pool,MALLOC_typeKP_,name,size)
+#define malloc_verify_kpr(pool,name,size) \
+ malloc_verify_inpool_ (pool,MALLOC_typeKPR_,name,size)
+#define malloc_verify_ks(pool,ptr,size) \
+ malloc_verify_inpool_ (pool,MALLOC_typeKS_,ptr,size)
+#define malloc_verify_ksr(pool,ptr,size) \
+ malloc_verify_inpool_ (pool,MALLOC_typeKSR_,ptr,size)
+#define malloc_verify_us(pool,ptr) \
+ malloc_verify_inpool_ (pool,MALLOC_typeUS_,ptr,0)
+#define malloc_verify_usr(pool,ptr) \
+ malloc_verify_inpool_ (pool,MALLOC_typeUSR_,ptr,0)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/name.c b/gcc/f/name.c
new file mode 100644
index 00000000000..0d85863611f
--- /dev/null
+++ b/gcc/f/name.c
@@ -0,0 +1,242 @@
+/* name.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None.
+
+ Description:
+ Name and name space abstraction.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "bad.h"
+#include "name.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#include "where.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+static ffename ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found);
+
+/* Internal macros. */
+
+
+/* Searches for and returns the matching ffename object, or returns a
+ pointer to the name before which the new name should go. */
+
+static ffename
+ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found)
+{
+ ffename n;
+
+ for (n = ns->first; n != (ffename) &ns->first; n = n->next)
+ {
+ if (ffelex_token_strcmp (t, n->t) == 0)
+ {
+ *found = TRUE;
+ return n;
+ }
+ }
+
+ *found = FALSE;
+ return n; /* (n == (ffename) &ns->first) */
+}
+
+/* Searches for and returns the matching ffename object, or creates a new
+ one (with a NULL ffesymbol) and returns that. If last arg is TRUE,
+ check whether token meets character-content requirements (such as
+ "all characters must be uppercase", as determined by
+ ffesrc_bad_char_symbol (), issue diagnostic if it doesn't. */
+
+ffename
+ffename_find (ffenameSpace ns, ffelexToken t)
+{
+ ffename n;
+ ffename newn;
+ bool found;
+
+ assert (ns != NULL);
+ assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNAMES)));
+
+ n = ffename_lookup_ (ns, t, &found);
+ if (found)
+ return n;
+
+ newn = (ffename) malloc_new_ks (ns->pool, "FFENAME name", sizeof (*n));
+ newn->next = n;
+ newn->previous = n->previous;
+ n->previous = newn;
+ newn->previous->next = newn;
+ newn->t = ffelex_token_use (t);
+ newn->u.s = NULL;
+
+ return newn;
+}
+
+/* ffename_kill -- Kill name from name space
+
+ ffenameSpace ns;
+ ffename s;
+ ffename_kill(ns,s);
+
+ Removes the name from the name space. */
+
+void
+ffename_kill (ffenameSpace ns, ffename n)
+{
+ assert (ns != NULL);
+ assert (n != NULL);
+
+ ffelex_token_kill (n->t);
+ n->next->previous = n->previous;
+ n->previous->next = n->next;
+ malloc_kill_ks (ns->pool, n, sizeof (*n));
+}
+
+/* ffename_lookup -- Look up name in name space
+
+ ffenameSpace ns;
+ ffelexToken t;
+ ffename s;
+ n = ffename_lookup(ns,t);
+
+ Searches for and returns the matching ffename object, or returns NULL. */
+
+ffename
+ffename_lookup (ffenameSpace ns, ffelexToken t)
+{
+ ffename n;
+ bool found;
+
+ assert (ns != NULL);
+ assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
+ || (ffelex_token_type (t) == FFELEX_typeNAMES)));
+
+ n = ffename_lookup_ (ns, t, &found);
+
+ return found ? n : NULL;
+}
+
+/* ffename_space_drive_global -- Call given fn for each global in name space
+
+ ffenameSpace ns;
+ ffeglobal (*fn)();
+ ffename_space_drive_global(ns,fn); */
+
+void
+ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) ())
+{
+ ffename n;
+
+ if (ns == NULL)
+ return;
+
+ for (n = ns->first; n != (ffename) &ns->first; n = n->next)
+ {
+ if (n->u.g != NULL)
+ n->u.g = (*fn) (n->u.g);
+ }
+}
+
+/* ffename_space_drive_symbol -- Call given fn for each symbol in name space
+
+ ffenameSpace ns;
+ ffesymbol (*fn)();
+ ffename_space_drive_symbol(ns,fn); */
+
+void
+ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) ())
+{
+ ffename n;
+
+ if (ns == NULL)
+ return;
+
+ for (n = ns->first; n != (ffename) &ns->first; n = n->next)
+ {
+ if (n->u.s != NULL)
+ n->u.s = (*fn) (n->u.s);
+ }
+}
+
+/* ffename_space_kill -- Kill name space
+
+ ffenameSpace ns;
+ ffename_space_kill(ns);
+
+ Removes the names from the name space; kills the name space. */
+
+void
+ffename_space_kill (ffenameSpace ns)
+{
+ assert (ns != NULL);
+
+ while (ns->first != (ffename) &ns->first)
+ ffename_kill (ns, ns->first);
+
+ malloc_kill_ks (ns->pool, ns, sizeof (*ns));
+}
+
+/* ffename_space_new -- Create name space
+
+ ffenameSpace ns;
+ ns = ffename_space_new(malloc_pool_image());
+
+ Create new name space. */
+
+ffenameSpace
+ffename_space_new (mallocPool pool)
+{
+ ffenameSpace ns;
+
+ ns = (ffenameSpace) malloc_new_ks (pool, "FFENAME space",
+ sizeof (*ns));
+ ns->first = (ffename) &ns->first;
+ ns->last = (ffename) &ns->first;
+ ns->pool = pool;
+
+ return ns;
+}
diff --git a/gcc/f/name.h b/gcc/f/name.h
new file mode 100644
index 00000000000..e73d9504aa1
--- /dev/null
+++ b/gcc/f/name.h
@@ -0,0 +1,109 @@
+/* name.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ name.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_name
+#define _H_f_name
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+typedef struct _ffename_ *ffename;
+typedef struct _ffename_space_ *ffenameSpace;
+
+/* Include files needed by this one. */
+
+#include "global.h"
+#include "lex.h"
+#include "malloc.h"
+#include "symbol.h"
+
+/* Structure definitions. */
+
+struct _ffename_
+ {
+ ffename next;
+ ffename previous;
+ ffelexToken t;
+ union
+ {
+ ffesymbol s;
+ ffeglobal g;
+ }
+ u;
+ };
+
+struct _ffename_space_
+ {
+ ffename first;
+ ffename last;
+ mallocPool pool;
+ };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+ffename ffename_find (ffenameSpace ns, ffelexToken t);
+void ffename_kill (ffenameSpace ns, ffename n);
+ffename ffename_lookup (ffenameSpace ns, ffelexToken t);
+void ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) ());
+void ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) ());
+void ffename_space_kill (ffenameSpace ns);
+ffenameSpace ffename_space_new (mallocPool pool);
+
+/* Define macros. */
+
+#define ffename_first_token(n) ((n)->t)
+#define ffename_global(n) ((n)->u.g)
+#define ffename_init_0()
+#define ffename_init_1()
+#define ffename_init_2()
+#define ffename_init_3()
+#define ffename_init_4()
+#define ffename_set_global(n,glob) ((n)->u.g = (glob))
+#define ffename_set_symbol(n,sym) ((n)->u.s = (sym))
+#define ffename_symbol(n) ((n)->u.s)
+#define ffename_terminate_0()
+#define ffename_terminate_1()
+#define ffename_terminate_2()
+#define ffename_terminate_3()
+#define ffename_terminate_4()
+#define ffename_text(n) ffelex_token_text((n)->t)
+#define ffename_token(n) ((n)->t)
+#define ffename_where_filename(n) ffelex_token_where_filename((n)->t)
+#define ffename_where_filelinenum(n) ffelex_token_where_filelinenum((n)->t)
+#define ffename_where_line(n) ffelex_token_where_line((n)->t)
+#define ffename_where_column(n) ffelex_token_where_column((n)->t)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/news.texi b/gcc/f/news.texi
new file mode 100644
index 00000000000..efb599645aa
--- /dev/null
+++ b/gcc/f/news.texi
@@ -0,0 +1,1468 @@
+@c Copyright (C) 1995-1997 Free Software Foundation, Inc.
+@c This is part of the G77 manual.
+@c For copying conditions, see the file g77.texi.
+
+@c The text of this file appears in the file BUGS
+@c in the G77 distribution, as well as in the G77 manual.
+
+@c 1997-08-11
+
+@ifclear NEWSONLY
+@node News
+@chapter News About GNU Fortran
+@end ifclear
+@cindex versions, recent
+@cindex recent versions
+
+Changes made to recent versions of GNU Fortran are listed
+below, with the most recent version first.
+
+The changes are generally listed with code-generation
+bugs first, followed by compiler crashes involving valid
+code, new features, fixes to existing features, new
+diagnostics, internal improvements, and miscellany.
+This order is not strict---for example, some items
+involve a combination of these elements.
+
+@heading In 0.5.21:
+@itemize @bullet
+@item
+Fix a code-generation bug introduced by 0.5.20
+caused by loop unrolling (by specifying
+@samp{-funroll-loops} or similar).
+This bug afflicted all code compiled by
+version 2.7.2.2.f.2 of @code{gcc} (C, C++,
+Fortran, and so on).
+
+@item
+Fix a code-generation bug manifested when
+combining local @code{EQUIVALENCE} with a
+@code{DATA} statement that follows
+the first executable statement (or is
+treated as an executable-context statement
+as a result of using the @samp{-fpedantic}
+option).
+
+@item
+Fix a compiler crash that occured when an
+integer division by a constant zero is detected.
+Instead, when the @samp{-W} option is specified,
+the @code{gcc} back end issues a warning about such a case.
+This bug afflicted all code compiled by
+version 2.7.2.2.f.2 of @code{gcc} (C, C++,
+Fortran, and so on).
+
+@item
+Fix a compiler crash that occurred in some cases
+of procedure inlining.
+(Such cases became more frequent in 0.5.20.)
+
+@item
+Fix a compiler crash resulting from using @code{DATA}
+or similar to initialize a @code{COMPLEX} variable or
+array to zero.
+
+@item
+Fix compiler crashes involving use of @code{AND}, @code{OR},
+or @code{XOR} intrinsics.
+
+@item
+Fix compiler bug triggered when using a @code{COMMON}
+or @code{EQUIVALENCE} variable
+as the target of an @code{ASSIGN}
+or assigned-@code{GOTO} statement.
+
+@item
+Fix compiler crashes due to using the name of a some
+non-standard intrinsics (such as @samp{FTELL} or
+@samp{FPUTC}) as such and as the name of a procedure
+or common block.
+Such dual use of a name in a program is allowed by
+the standard.
+
+@c @code{g77}'s version of @code{libf2c} has been modified
+@c so that the external names of library's procedures do not
+@c conflict with names used for Fortran procedures compiled
+@c by @code{g77}.
+@c An additional layer of jacket procedures has been added
+@c to @code{libf2c} to map the old names to the new names,
+@c for automatic use by programs that interface to the
+@c library procedures via the external-procedure mechanism.
+@c
+@c For example, the intrinsic @code{FPUTC} previously was
+@c implemented by @code{g77} as a call to the @code{libf2c}
+@c routine @samp{fputc_}.
+@c This would conflict with a Fortran procedure named @code{FPUTC}
+@c (using default compiler options), and this conflict
+@c would cause a crash under certain circumstances.
+@c
+@c Now, the intrinsic @code{FPUTC} calls @samp{G77_fputc_0},
+@c which does not conflict with the @samp{fputc_} external
+@c that implements a Fortran procedure named @code{FPUTC}.
+@c
+@c Programs that refer to @code{FPUTC} as an external procedure
+@c without supplying their own implementation will link to
+@c the new @code{libf2c} routine @samp{fputc_}, which is
+@c simply a jacket routine that calls @samp{G77_fputc_0}.
+
+@item
+Place automatic arrays on the stack, even if
+@code{SAVE} or the @samp{-fno-automatic} option
+is in effect.
+This avoids a compiler crash in some cases.
+
+@item
+New option @samp{-Wno-globals} disables warnings
+about ``suspicious'' use of a name both as a global
+name and as the implicit name of an intrinsic, and
+warnings about disagreements over the number or natures of
+arguments passed to global procedures, or the
+natures of the procedures themselves.
+
+The default is to issue such warnings, which are
+new as of this version of @code{g77}.
+
+@item
+New option @samp{-fno-globals} disables diagnostics
+about potentially fatal disagreements
+analysis problems, such as disagreements over the
+number or natures of arguments passed to global
+procedures, or the natures of those procedures themselves.
+
+The default is to issue such diagnostics and flag
+the compilation as unsuccessful.
+With this option, the diagnostics are issued as
+warnings, or, if @samp{-Wno-globals} is specified,
+are not issued at all.
+
+This option also disables inlining of global procedures,
+to avoid compiler crashes resulting from coding errors
+that these diagnostics normally would identify.
+
+@item
+Diagnose cases where a reference to a procedure
+disagrees with the type of that procedure, or
+where disagreements about the number or nature
+of arguments exist.
+This avoids a compiler crash.
+
+@item
+Improve performance of the @code{gcc} back end so
+certain complicated expressions involving @code{COMPLEX}
+arithmetic (especially multiplication) don't appear to
+take forever to compile.
+
+@item
+Fix a couple of profiling-related bugs in @code{gcc}
+back end.
+
+@item
+Integrate GNU Ada's (GNAT's) changes to the back end,
+which consist almost entirely of bug fixes.
+
+@item
+Include some other @code{gcc} fixes that seem useful in
+@code{g77}'s version of @code{gcc}.
+(See @file{gcc/ChangeLog} for details---compare it
+to that file in the vanilla @code{gcc-2.7.2.2.tar.gz}
+distribution.)
+
+@item
+Fix @code{libU77} routines that accept file and other names
+to strip trailing blanks from them, for consistency
+with other implementations.
+Blanks may be forcibly appended to such names by
+appending a single null character (@samp{CHAR(0)})
+to the significant trailing blanks.
+
+@item
+Fix @code{CHMOD} intrinsic to work with file names
+that have embedded blanks, commas, and so on.
+
+@item
+Fix @code{SIGNAL} intrinsic so it accepts an
+optional third @samp{Status} argument.
+
+@item
+Fix @code{IDATE()} intrinsic subroutine (VXT form)
+so it accepts arguments in the correct order.
+Documentation fixed accordingly, and for
+@code{GMTIME()} and @code{LTIME()} as well.
+
+@item
+Make many changes to @code{libU77} intrinsics to
+support existing code more directly.
+
+Such changes include allowing both subroutine and
+function forms of many routines, changing @code{MCLOCK()}
+and @code{TIME()} to return @code{INTEGER(KIND=1)} values,
+introducing @code{MCLOCK8()} and @code{TIME8()} to
+return @code{INTEGER(KIND=2)} values,
+and placing functions that are intended to perform
+side effects in a new intrinsic group, @code{badu77}.
+
+@item
+Improve @code{libU77} so it is more portable.
+
+@item
+Add options @samp{-fbadu77-intrinsics-delete},
+@samp{-fbadu77-intrinsics-hide}, and so on.
+
+@item
+Fix crashes involving diagnosed or invalid code.
+
+@item
+@code{g77} and @code{gcc} now do a somewhat better
+job detecting and diagnosing arrays that are too
+large to handle before these cause diagnostics
+during the assembler or linker phase, a compiler
+crash, or generation of incorrect code.
+
+@item
+Improve alias analysis code to properly handle
+output registers (such as the @samp{%o} registers
+on the SPARC).
+
+@item
+Add support for @code{restrict} keyword in @code{gcc}
+front end.
+
+@item
+Modify @code{make} rules and related code so that
+generation of Info documentation doesn't require
+compilation using @code{gcc}.
+
+@item
+Add @code{INT2} and @code{INT8} intrinsics.
+
+@item
+Add @code{CPU_TIME} intrinsic.
+
+@item
+Add @code{ALARM} intrinsic.
+
+@item
+@code{CTIME} intrinsic now accepts any @code{INTEGER}
+argument, not just @code{INTEGER(KIND=2)}.
+
+@item
+Warn when explicit type declaration disagrees with
+the type of an intrinsic invocation.
+
+@item
+Support @samp{*f771} entry in @code{gcc} @file{specs} file.
+
+@item
+Fix typo in @code{make} rule @samp{g77-cross}, used only for
+cross-compiling.
+
+@item
+Fix @code{libf2c} build procedure to re-archive library
+if previous attempt to archive was interrupted.
+
+@item
+Fix @code{gcc} to more easily support configuring on
+Pentium Pro (686) systems.
+
+@item
+Change @code{gcc} to unroll loops only during the last
+invocation (of as many as two invocations) of loop
+optimization.
+
+@item
+Improve handling of @samp{-fno-f2c} so that code that
+attempts to pass an intrinsic as an actual argument,
+such as @samp{CALL FOO(ABS)}, is rejected due to the fact
+that the run-time-library routine is, effectively,
+compiled with @samp{-ff2c} in effect.
+
+@item
+Fix @code{g77} driver to recognize @samp{-fsyntax-only}
+as an option that inhibits linking, just like @samp{-c} or
+@samp{-S}, and to recognize and properly handle the
+@samp{-nostdlib}, @samp{-M}, @samp{-MM}, @samp{-nodefaultlibs},
+and @samp{-Xlinker} options.
+
+@item
+Upgrade to @code{libf2c} as of 1997-08-06.
+
+@item
+Modify @code{libf2c} to consistently and clearly diagnose
+recursive I/O (at run time).
+
+@item
+@code{g77} driver now prints version information (such as produced
+by @kbd{g77 -v}) to @code{stderr} instead of @code{stdout}.
+
+@item
+The @samp{.r} suffix now designates a Ratfor source file,
+to be preprocessed via the @code{ratfor} command, available
+separately.
+
+@item
+Fix some aspects of how @code{gcc} determines what kind of
+system is being configured and what kinds are supported.
+For example, GNU Linux/Alpha ELF systems now are directly
+supported.
+
+@item
+Improve diagnostics.
+
+@item
+Improve documentation and indexing.
+
+@item
+Include all pertinent files for @code{libf2c} that come
+from @code{netlib.bell-labs.com}; give any such files
+that aren't quite accurate in @code{g77}'s version of
+@code{libf2c} the suffix @samp{.netlib}.
+
+@item
+Reserve @code{INTEGER(KIND=0)} for future use.
+@end itemize
+
+@heading In 0.5.20:
+@itemize @bullet
+@item
+The @samp{-fno-typeless-boz} option is now the default.
+
+This option specifies that non-decimal-radix
+constants using the prefixed-radix form (such as @samp{Z'1234'})
+are to be interpreted as @code{INTEGER} constants.
+Specify @samp{-ftypeless-boz} to cause such
+constants to be interpreted as typeless.
+
+(Version 0.5.19 introduced @samp{-fno-typeless-boz} and
+its inverse.)
+
+@item
+Options @samp{-ff90-intrinsics-enable} and
+@samp{-fvxt-intrinsics-enable} now are the
+defaults.
+
+Some programs might use names that clash with
+intrinsic names defined (and now enabled) by these
+options or by the new @code{libU77} intrinsics.
+Users of such programs might need to compile them
+differently (using, for example, @samp{-ff90-intrinsics-disable})
+or, better yet, insert appropriate @code{EXTERNAL}
+statements specifying that these names are not intended
+to be names of intrinsics.
+
+@item
+The @samp{ALWAYS_FLUSH} macro is no longer defined when
+building @code{libf2c}, which should result in improved
+I/O performance, especially over NFS.
+
+@emph{Note:} If you have code that depends on the behavior
+of @code{libf2c} when built with @samp{ALWAYS_FLUSH} defined,
+you will have to modify @code{libf2c} accordingly before
+building it from this and future versions of @code{g77}.
+
+@item
+Dave Love's implementation of @code{libU77} has been
+added to the version of @code{libf2c} distributed with
+and built as part of @code{g77}.
+@code{g77} now knows about the routines in this library
+as intrinsics.
+
+@item
+New option @samp{-fvxt} specifies that the
+source file is written in VXT Fortran, instead of GNU Fortran.
+
+@item
+The @samp{-fvxt-not-f90} option has been deleted,
+along with its inverse, @samp{-ff90-not-vxt}.
+
+If you used one of these deleted options, you should
+re-read the pertinent documentation to determine which
+options, if any, are appropriate for compiling your
+code with this version of @code{g77}.
+
+@item
+The @samp{-fugly} option now issues a warning, as it
+likely will be removed in a future version.
+
+(Enabling all the @samp{-fugly-*} options is unlikely
+to be feasible, or sensible, in the future,
+so users should learn to specify only those
+@samp{-fugly-*} options they really need for a
+particular source file.)
+
+@item
+The @samp{-fugly-assumed} option, introduced in
+version 0.5.19, has been changed to
+better accommodate old and new code.
+
+@item
+Make a number of fixes to the @code{g77} front end and
+the @code{gcc} back end to better support Alpha (AXP)
+machines.
+This includes providing at least one bug-fix to the
+@code{gcc} back end for Alphas.
+
+@item
+Related to supporting Alpha (AXP) machines, the @code{LOC()}
+intrinsic and @code{%LOC()} construct now return
+values of integer type that is the same width (holds
+the same number of bits) as the pointer type on the
+machine.
+
+On most machines, this won't make a difference, whereas
+on Alphas, the type these constructs return is
+@code{INTEGER*8} instead of the more common @code{INTEGER*4}.
+
+@item
+Emulate @code{COMPLEX} arithmetic in the @code{g77} front
+end, to avoid bugs in @code{complex} support in the
+@code{gcc} back end.
+New option @samp{-fno-emulate-complex}
+causes @code{g77} to revert the 0.5.19 behavior.
+
+@item
+Fix bug whereby @samp{REAL A(1)}, for example, caused
+a compiler crash if @samp{-fugly-assumed} was in effect
+and @var{A} was a local (automatic) array.
+That case is no longer affected by the new
+handling of @samp{-fugly-assumed}.
+
+@item
+Fix @code{g77} command driver so that @samp{g77 -o foo.f}
+no longer deletes @file{foo.f} before issuing other
+diagnostics, and so the @samp{-x} option is properly
+handled.
+
+@item
+Enable inlining of subroutines and functions by the @code{gcc}
+back end.
+This works as it does for @code{gcc} itself---program units
+may be inlined for invocations that follow them in the same
+program unit, as long as the appropriate compile-time
+options are specified.
+
+@item
+Dummy arguments are no longer assumed to potentially alias
+(overlap)
+other dummy arguments or @code{COMMON} areas when any of
+these are defined (assigned to) by Fortran code.
+
+This can result in faster and/or smaller programs when
+compiling with optimization enabled, though on some
+systems this effect is observed only when @samp{-fforce-addr}
+also is specified.
+
+New options @samp{-falias-check}, @samp{-fargument-alias},
+@samp{-fargument-noalias},
+and @samp{-fno-argument-noalias-global} control the
+way @code{g77} handles potential aliasing.
+
+@item
+The @code{CONJG()} and @code{DCONJG()} intrinsics now
+are compiled in-line.
+
+@item
+The bug-fix for 0.5.19.1 has been re-done.
+The @code{g77} compiler has been changed back to
+assume @code{libf2c} has no aliasing problems in
+its implementations of the @code{COMPLEX} (and
+@code{DOUBLE COMPLEX}) intrinsics.
+The @code{libf2c} has been changed to have no such
+problems.
+
+As a result, 0.5.20 is expected to offer improved performance
+over 0.5.19.1, perhaps as good as 0.5.19 in most
+or all cases, due to this change alone.
+
+@emph{Note:} This change requires version 0.5.20 of
+@code{libf2c}, at least, when linking code produced
+by any versions of @code{g77} other than 0.5.19.1.
+Use @samp{g77 -v} to determine the version numbers
+of the @code{libF77}, @code{libI77}, and @code{libU77}
+components of the @code{libf2c} library.
+(If these version numbers are not printed---in
+particular, if the linker complains about unresolved
+references to names like @samp{g77__fvers__}---that
+strongly suggests your installation has an obsolete
+version of @code{libf2c}.)
+
+@item
+New option @samp{-fugly-assign} specifies that the
+same memory locations are to be used to hold the
+values assigned by both statements @samp{I = 3} and
+@samp{ASSIGN 10 TO I}, for example.
+(Normally, @code{g77} uses a separate memory location
+to hold assigned statement labels.)
+
+@item
+@code{FORMAT} and @code{ENTRY} statements now are allowed to
+precede @code{IMPLICIT NONE} statements.
+
+@item
+Produce diagnostic for unsupported @code{SELECT CASE} on
+@code{CHARACTER} type, instead of crashing, at compile time.
+
+@item
+Fix crashes involving diagnosed or invalid code.
+
+@item
+Change approach to building @code{libf2c} archive
+(@file{libf2c.a}) so that members are added to it
+only when truly necessary, so the user that installs
+an already-built @code{g77} doesn't need to have write
+access to the build tree (whereas the user doing the
+build might not have access to install new software
+on the system).
+
+@item
+Support @code{gcc} version 2.7.2.2
+(modified by @code{g77} into version 2.7.2.2.f.2),
+and remove
+support for prior versions of @code{gcc}.
+
+@item
+Upgrade to @code{libf2c} as of 1997-02-08, and
+fix up some of the build procedures.
+
+@item
+Improve general build procedures for @code{g77},
+fixing minor bugs (such as deletion of any file
+named @file{f771} in the parent directory of @code{gcc/}).
+
+@item
+Enable full support of @code{INTEGER*8} available in
+@code{libf2c} and @file{f2c.h} so that @code{f2c} users
+may make full use of its features via the @code{g77}
+version of @file{f2c.h} and the @code{INTEGER*8}
+support routines in the @code{g77} version of @code{libf2c}.
+
+@item
+Improve @code{g77} driver and @code{libf2c} so that @samp{g77 -v}
+yields version information on the library.
+
+@item
+The @code{SNGL} and @code{FLOAT} intrinsics now are
+specific intrinsics, instead of synonyms for the
+generic intrinsic @code{REAL}.
+
+@item
+New intrinsics have been added.
+These are @code{REALPART}, @code{IMAGPART},
+@code{COMPLEX},
+@code{LONG}, and @code{SHORT}.
+
+@item
+A new group of intrinsics, @samp{gnu}, has been added
+to contain the new @code{REALPART}, @code{IMAGPART},
+and @code{COMPLEX} intrinsics.
+An old group, @samp{dcp}, has been removed.
+
+@item
+Complain about industry-wide ambiguous references
+@samp{REAL(@var{expr})} and @samp{AIMAG(@var{expr})},
+where @var{expr} is @code{DOUBLE COMPLEX} (or any
+complex type other than @code{COMPLEX}), unless
+@samp{-ff90} option specifies Fortran 90 interpretation
+or new @samp{-fugly-complex} option, in conjunction with
+@samp{-fnot-f90}, specifies @code{f2c} interpretation.
+
+@item
+Make improvements to diagnostics.
+
+@item
+Speed up compiler a bit.
+
+@item
+Improvements to documentation and indexing, including
+a new chapter containing information on one, later
+more, diagnostics that users are directed to pull
+up automatically via a message in the diagnostic itself.
+
+(Hence the menu item @samp{M} for the node
+@samp{Diagnostics} in the top-level menu of
+the Info documentation.)
+@end itemize
+
+@heading In 0.5.19.1:
+@itemize @bullet
+@item
+Code-generation bugs afflicting operations on complex
+data have been fixed.
+
+These bugs occurred when assigning the result of an
+operation to a complex variable (or array element)
+that also served as an input to that operation.
+
+The operations affected by this bug were: @samp{CONJG()},
+@samp{DCONJG()}, @samp{CCOS()}, @samp{CDCOS()},
+@samp{CLOG()}, @samp{CDLOG()}, @samp{CSIN()}, @samp{CDSIN()},
+@samp{CSQRT()}, @samp{CDSQRT()}, complex division, and
+raising a @code{DOUBLE COMPLEX} operand to an @code{INTEGER}
+power.
+(The related generic and @samp{Z}-prefixed intrinsics,
+such as @samp{ZSIN()}, also were affected.)
+
+For example, @samp{C = CSQRT(C)}, @samp{Z = Z/C}, and @samp{Z = Z**I}
+(where @samp{C} is @code{COMPLEX} and @samp{Z} is
+@code{DOUBLE COMPLEX}) have been fixed.
+@end itemize
+
+@heading In 0.5.19:
+@itemize @bullet
+@item
+Fix @code{FORMAT} statement parsing so negative values for
+specifiers such as @samp{P} (e.g. @samp{FORMAT(-1PF8.1)})
+are correctly processed as negative.
+
+@item
+Fix @code{SIGNAL} intrinsic so it once again accepts a
+procedure as its second argument.
+
+@item
+A temporary kludge option provides bare-bones information on
+@code{COMMON} and @code{EQUIVALENCE} members at debug time.
+
+@item
+New @samp{-fonetrip} option specifies FORTRAN-66-style
+one-trip @code{DO} loops.
+
+@item
+New @samp{-fno-silent} option causes names of program units
+to be printed as they are compiled, in a fashion similar to
+UNIX @code{f77} and @code{f2c}.
+
+@item
+New @samp{-fugly-assumed} option specifies that arrays
+dimensioned via @samp{DIMENSION X(1)}, for example, are to be
+treated as assumed-size.
+
+@item
+New @samp{-fno-typeless-boz} option specifies that non-decimal-radix
+constants using the prefixed-radix form (such as @samp{Z'1234'})
+are to be interpreted as @code{INTEGER} constants.
+
+@item
+New @samp{-ff66} option is a ``shorthand'' option that specifies
+behaviors considered appropriate for FORTRAN 66 programs.
+
+@item
+New @samp{-ff77} option is a ``shorthand'' option that specifies
+behaviors considered appropriate for UNIX @code{f77} programs.
+
+@item
+New @samp{-fugly-comma} and @samp{-fugly-logint} options provided
+to perform some of what @samp{-fugly} used to do.
+@samp{-fugly} and @samp{-fno-ugly} are now ``shorthand'' options,
+in that they do nothing more than enable (or disable) other
+@samp{-fugly-*} options.
+
+@item
+Fix parsing of assignment statements involving targets that
+are substrings of elements of @code{CHARACTER} arrays having
+names such as @samp{READ}, @samp{WRITE}, @samp{GOTO}, and
+@samp{REALFUNCTIONFOO}.
+
+@item
+Fix crashes involving diagnosed code.
+
+@item
+Fix handling of local @code{EQUIVALENCE} areas so certain cases
+of valid Fortran programs are not misdiagnosed as improperly
+extending the area backwards.
+
+@item
+Support @code{gcc} version 2.7.2.1.
+
+@item
+Upgrade to @code{libf2c} as of 1996-09-26, and
+fix up some of the build procedures.
+
+@item
+Change code generation for list-directed I/O so it allows
+for new versions of @code{libf2c} that might return non-zero
+status codes for some operations previously assumed to always
+return zero.
+
+This change not only affects how @code{IOSTAT=} variables
+are set by list-directed I/O, it also affects whether
+@code{END=} and @code{ERR=} labels are reached by these
+operations.
+
+@item
+Add intrinsic support for new @code{FTELL} and @code{FSEEK}
+procedures in @code{libf2c}.
+
+@item
+Modify @code{fseek_()} in @code{libf2c} to be more portable
+(though, in practice, there might be no systems where this
+matters) and to catch invalid @samp{whence} arguments.
+
+@item
+Some useless warnings from the @samp{-Wunused} option have
+been eliminated.
+
+@item
+Fix a problem building the @file{f771} executable
+on AIX systems by linking with the @samp{-bbigtoc} option.
+
+@item
+Abort configuration if @code{gcc} has not been patched
+using the patch file provided in the @samp{gcc/f/gbe/}
+subdirectory.
+
+@item
+Add options @samp{--help} and @samp{--version} to the
+@code{g77} command, to conform to GNU coding guidelines.
+Also add printing of @code{g77} version number when
+the @samp{--verbose} (@samp{-v}) option is used.
+
+@item
+Change internally generated name for local @code{EQUIVALENCE}
+areas to one based on the alphabetically sorted first name
+in the list of names for entities placed at the beginning
+of the areas.
+
+@item
+Improvements to documentation and indexing.
+@end itemize
+
+@heading In 0.5.18:
+@itemize @bullet
+@item
+Add some rudimentary support for @code{INTEGER*1},
+@code{INTEGER*2}, @code{INTEGER*8},
+and their @code{LOGICAL} equivalents.
+(This support works on most, maybe all, @code{gcc} targets.)
+
+Thanks to Scott Snyder (@email{snyder@@d0sgif.fnal.gov})
+for providing the patch for this!
+
+Among the missing elements from the support for these
+features are full intrinsic support and constants.
+
+@item
+Add some rudimentary support for the @code{BYTE} and
+@code{WORD} type-declaration statements.
+@code{BYTE} corresponds to @code{INTEGER*1},
+while @code{WORD} corresponds to @code{INTEGER*2}.
+
+Thanks to Scott Snyder (@email{snyder@@d0sgif.fnal.gov})
+for providing the patch for this!
+
+@item
+The compiler code handling intrinsics has been largely
+rewritten to accommodate the new types.
+No new intrinsics or arguments for existing
+intrinsics have been added, so there is, at this
+point, no intrinsic to convert to @code{INTEGER*8},
+for example.
+
+@item
+Support automatic arrays in procedures.
+
+@item
+Reduce space/time requirements for handling large
+@emph{sparsely} initialized aggregate arrays.
+This improvement applies to only a subset of
+the general problem to be addressed in 0.6.
+
+@item
+Treat initial values of zero as if they weren't
+specified (in DATA and type-declaration statements).
+The initial values will be set to zero anyway, but the amount
+of compile time processing them will be reduced,
+in some cases significantly (though, again, this
+is only a subset of the general problem to be
+addressed in 0.6).
+
+A new option, @samp{-fzeros}, is introduced to
+enable the traditional treatment of zeros as any
+other value.
+
+@item
+With @samp{-ff90} in force, @code{g77} incorrectly
+interpreted @samp{REAL(Z)} as returning a @code{REAL}
+result, instead of as a @code{DOUBLE PRECISION}
+result.
+(Here, @samp{Z} is @code{DOUBLE COMPLEX}.)
+
+With @samp{-fno-f90} in force, the interpretation remains
+unchanged, since this appears to be how at least some
+F77 code using the @code{DOUBLE COMPLEX} extension expected
+it to work.
+
+Essentially, @samp{REAL(Z)} in F90 is the same as
+@samp{DBLE(Z)}, while in extended F77, it appears to
+be the same as @samp{REAL(REAL(Z))}.
+
+@item
+An expression involving exponentiation, where both operands
+were type @code{INTEGER} and the right-hand operand
+was negative, was erroneously evaluated.
+
+@item
+Fix bugs involving @code{DATA} implied-@code{DO} constructs
+(these involved an errant diagnostic and a crash, both on good
+code, one involving subsequent statement-function definition).
+
+@item
+Close @code{INCLUDE} files after processing them, so compiling source
+files with lots of @code{INCLUDE} statements does not result in
+being unable to open @code{INCLUDE} files after all the available
+file descriptors are used up.
+
+@item
+Speed up compiling, especially of larger programs, and perhaps
+slightly reduce memory utilization while compiling (this is
+@emph{not} the improvement planned for 0.6 involving large aggregate
+areas)---these improvements result from simply turning
+off some low-level code to do self-checking that hasn't been
+triggered in a long time.
+
+@item
+Introduce three new options that
+implement optimizations in the @code{gcc} back end (GBE).
+These options are @samp{-fmove-all-movables}, @samp{-freduce-all-givs},
+and @samp{-frerun-loop-opt}, which are enabled, by default,
+for Fortran compilations.
+These optimizations are intended to help toon Fortran programs.
+
+@item
+Patch the GBE to do a better job optimizing certain
+kinds of references to array elements.
+
+@item
+Due to patches to the GBE, the version number of @code{gcc}
+also is patched to make it easier to manage installations,
+especially useful if it turns out a @code{g77} change to the
+GBE has a bug.
+
+The @code{g77}-modified version number is the @code{gcc}
+version number with the string @samp{.f.@var{n}} appended,
+where @samp{f} identifies the version as enhanced for
+Fortran, and @var{n} is @samp{1} for the first Fortran
+patch for that version of @code{gcc}, @samp{2} for the
+second, and so on.
+
+So, this introduces version 2.7.2.f.1 of @code{gcc}.
+
+@item
+Make several improvements and fixes to diagnostics, including
+the removal of two that were inappropriate or inadequate.
+
+@item
+Warning about two successive arithmetic operators, produced
+by @samp{-Wsurprising}, now produced @emph{only} when both
+operators are, indeed, arithmetic (not relational/boolean).
+
+@item
+@samp{-Wsurprising} now warns about the remaining cases
+of using non-integral variables for implied-@code{DO}
+loops, instead of these being rejected unless @samp{-fpedantic}
+or @samp{-fugly} specified.
+
+@item
+Allow @code{SAVE} of a local variable or array, even after
+it has been given an initial value via @code{DATA}, for example.
+
+@item
+Introduce an Info version of @code{g77} documentation, which
+supercedes @file{gcc/f/CREDITS}, @file{gcc/f/DOC}, and
+@file{gcc/f/PROJECTS}.
+These files will be removed in a future release.
+The files @file{gcc/f/BUGS}, @file{gcc/f/INSTALL}, and
+@file{gcc/f/NEWS} now are automatically built from
+the texinfo source when distributions are made.
+
+This effort was inspired by a first pass at translating
+@file{g77-0.5.16/f/DOC} that was contributed to Craig by
+David Ronis (@email{ronis@@onsager.chem.mcgill.ca}).
+
+@item
+New @samp{-fno-second-underscore} option to specify
+that, when @samp{-funderscoring} is in effect, a second
+underscore is not to be appended to Fortran names already
+containing an underscore.
+
+@item
+Change the way iterative @code{DO} loops work to follow
+the F90 standard.
+In particular, calculation of the iteration count is
+still done by converting the start, end, and increment
+parameters to the type of the @code{DO} variable, but
+the result of the calculation is always converted to
+the default @code{INTEGER} type.
+
+(This should have no effect on existing code compiled
+by @code{g77}, but code written to assume that use
+of a @emph{wider} type for the @code{DO} variable
+will result in an iteration count being fully calculated
+using that wider type (wider
+than default @code{INTEGER}) must be rewritten.)
+
+@item
+Support @code{gcc} version 2.7.2.
+
+@item
+Upgrade to @code{libf2c} as of 1996-03-23, and
+fix up some of the build procedures.
+
+Note that the email addresses related to @code{f2c}
+have changed---the distribution site now is
+named @code{netlib.bell-labs.com}, and the
+maintainer's new address is @email{dmg@@bell-labs.com}.
+@end itemize
+
+@heading In 0.5.17:
+@itemize @bullet
+@item
+@strong{Fix serious bug} in @samp{g77 -v} command that can cause removal of a
+system's @file{/dev/null} special file if run by user @samp{root}.
+
+@strong{All users} of version 0.5.16 should ensure that
+they have not removed @file{/dev/null} or replaced it with an ordinary
+file (e.g. by comparing the output of @samp{ls -l /dev/null} with
+@samp{ls -l /dev/zero}.
+If the output isn't basically the
+same, contact your system
+administrator about restoring @file{/dev/null} to its proper status).
+
+This bug is particularly insidious because removing @file{/dev/null} as
+a special file can go undetected for quite a while, aside from
+various applications and programs exhibiting sudden, strange
+behaviors.
+
+I sincerely apologize for not realizing the
+implications of the fact that when @samp{g77 -v} runs the @code{ld} command
+with @samp{-o /dev/null} that @code{ld} tries to @emph{remove} the executable
+it is supposed to build (especially if it reports unresolved
+references, which it should in this case)!
+
+@item
+Fix crash on @samp{CHARACTER*(*) FOO} in a main or block data program unit.
+
+@item
+Fix crash that can occur when diagnostics given outside of any
+program unit (such as when input file contains @samp{@@foo}).
+
+@item
+Fix crashes, infinite loops (hangs), and such involving diagnosed code.
+
+@item
+Fix @code{ASSIGN}'ed variables so they can be @code{SAVE}'d or dummy arguments,
+and issue clearer error message in cases where target of @code{ASSIGN}
+or @code{ASSIGN}ed @code{GOTO}/@code{FORMAT} is too small (which should
+never happen).
+
+@item
+Make @code{libf2c} build procedures work on more systems again by
+eliminating unnecessary invocations of @samp{ld -r -x} and @samp{mv}.
+
+@item
+Fix omission of @samp{-funix-intrinsics-@dots{}} options in list of permitted
+options to compiler.
+
+@item
+Fix failure to always diagnose missing type declaration for
+@code{IMPLICIT NONE}.
+
+@item
+Fix compile-time performance problem (which could sometimes
+crash the compiler, cause a hang, or whatever, due to a bug
+in the back end) involving exponentiation with a large @code{INTEGER}
+constant for the right-hand operator (e.g. @samp{I**32767}).
+
+@item
+Fix build procedures so cross-compiling @code{g77} (the @code{fini}
+utility in particular) is properly built using the host compiler.
+
+@item
+Add new @samp{-Wsurprising} option to warn about constructs that are
+interpreted by the Fortran standard (and @code{g77}) in ways that
+are surprising to many programmers.
+
+@item
+Add @code{ERF()} and @code{ERFC()} as generic intrinsics mapping to existing
+@code{ERF}/@code{DERF} and @code{ERFC}/@code{DERFC} specific intrinsics.
+
+@emph{Note:} You should
+specify @samp{INTRINSIC ERF,ERFC} in any code where you might use
+these as generic intrinsics, to improve likelihood of diagnostics
+(instead of subtle run-time bugs) when using a compiler that
+doesn't support these as intrinsics (e.g. @code{f2c}).
+
+@item
+Remove from @samp{-fno-pedantic} the diagnostic about @code{DO}
+with non-@code{INTEGER} index variable; issue that under
+@samp{-Wsurprising} instead.
+
+@item
+Clarify some diagnostics that say things like ``ignored'' when that's
+misleading.
+
+@item
+Clarify diagnostic on use of @code{.EQ.}/@code{.NE.} on @code{LOGICAL}
+operands.
+
+@item
+Minor improvements to code generation for various operations on
+@code{LOGICAL} operands.
+
+@item
+Minor improvement to code generation for some @code{DO} loops on some
+machines.
+
+@item
+Support @code{gcc} version 2.7.1.
+
+@item
+Upgrade to @code{libf2c} as of 1995-11-15.
+@end itemize
+
+@heading In 0.5.16:
+@itemize @bullet
+@item
+Fix a code-generation bug involving complicated @code{EQUIVALENCE} statements
+not involving @code{COMMON}.
+
+@item
+Fix code-generation bugs involving invoking ``gratis'' library procedures
+in @code{libf2c} from code compiled with @samp{-fno-f2c} by making these
+procedures known to @code{g77} as intrinsics (not affected by -fno-f2c).
+This is known to fix code invoking @code{ERF()}, @code{ERFC()},
+@code{DERF()}, and @code{DERFC()}.
+
+@item
+Update @code{libf2c} to include netlib patches through 1995-08-16, and
+@code{#define} @samp{WANT_LEAD_0} to 1 to make @code{g77}-compiled code more
+consistent with other Fortran implementations by outputting
+leading zeros in formatted and list-directed output.
+
+@item
+Fix a code-generation bug involving adjustable dummy arrays with high
+bounds whose primaries are changed during procedure execution, and
+which might well improve code-generation performance for such arrays
+compared to @code{f2c} plus @code{gcc} (but apparently only when using
+@file{gcc-2.7.0} or later).
+
+@item
+Fix a code-generation bug involving invocation of @code{COMPLEX} and
+@code{DOUBLE COMPLEX} @code{FUNCTION}s and doing @code{COMPLEX} and
+@code{DOUBLE COMPLEX} divides, when the result
+of the invocation or divide is assigned directly to a variable
+that overlaps one or more of the arguments to the invocation or divide.
+
+@item
+Fix crash by not generating new optimal code for @samp{X**I} if @samp{I} is
+nonconstant and the expression is used to dimension a dummy
+array, since the @code{gcc} back end does not support the necessary
+mechanics (and the @code{gcc} front end rejects the equivalent
+construct, as it turns out).
+
+@item
+Fix crash on expressions like @samp{COMPLEX**INTEGER}.
+
+@item
+Fix crash on expressions like @samp{(1D0,2D0)**2}, i.e. raising a
+@code{DOUBLE COMPLEX} constant to an @code{INTEGER} constant power.
+
+@item
+Fix crashes and such involving diagnosed code.
+
+@item
+Diagnose, instead of crashing on, statement function definitions
+having duplicate dummy argument names.
+
+@item
+Fix bug causing rejection of good code involving statement function
+definitions.
+
+@item
+Fix bug resulting in debugger not knowing size of local equivalence
+area when any member of area has initial value (via @code{DATA},
+for example).
+
+@item
+Fix installation bug that prevented installation of @code{g77} driver.
+Provide for easy selection of whether to install copy of @code{g77}
+as @code{f77} to replace the broken code.
+
+@item
+Fix @code{gcc} driver (affects @code{g77} thereby) to not
+gratuitously invoke the
+@code{f771} program (e.g. when @samp{-E} is specified).
+
+@item
+Fix diagnostic to point to correct source line when it immediately
+follows an @code{INCLUDE} statement.
+
+@item
+Support more compiler options in @code{gcc}/@code{g77} when
+compiling Fortran files.
+These options include @samp{-p}, @samp{-pg}, @samp{-aux-info}, @samp{-P},
+correct setting of version-number macros for preprocessing, full
+recognition of @samp{-O0}, and
+automatic insertion of configuration-specific linker specs.
+
+@item
+Add new intrinsics that interface to existing routines in @code{libf2c}:
+@code{ABORT}, @code{DERF}, @code{DERFC}, @code{ERF}, @code{ERFC}, @code{EXIT},
+@code{FLUSH}, @code{GETARG}, @code{GETENV}, @code{IARGC},
+@code{SIGNAL}, and @code{SYSTEM}.
+Note that @code{ABORT}, @code{EXIT}, @code{FLUSH}, @code{SIGNAL}, and
+@code{SYSTEM} are intrinsic subroutines, not functions (since they
+have side effects), so to get the return values from @code{SIGNAL}
+and @code{SYSTEM}, append a final argument specifying an @code{INTEGER}
+variable or array element (e.g. @samp{CALL SYSTEM('rm foo',ISTAT)}).
+
+@item
+Add new intrinsic group named @samp{unix} to contain the new intrinsics,
+and by default enable this new group.
+
+@item
+Move @code{LOC()} intrinsic out of the @samp{vxt} group to the new
+@samp{unix} group.
+
+@item
+Improve @code{g77} so that @samp{g77 -v} by itself (or with
+certain other options, including @samp{-B}, @samp{-b}, @samp{-i},
+@samp{-nostdlib}, and @samp{-V}) reports lots more useful
+version info, and so that long-form options @code{gcc} accepts are
+understood by @code{g77} as well (even in truncated, unambiguous forms).
+
+@item
+Add new @code{g77} option @samp{--driver=name} to specify driver when
+default, @code{gcc}, isn't appropriate.
+
+@item
+Add support for @samp{#} directives (as output by the preprocessor) in the
+compiler, and enable generation of those directives by the
+preprocessor (when compiling @samp{.F} files) so diagnostics and debugging
+info are more useful to users of the preprocessor.
+
+@item
+Produce better diagnostics, more like @code{gcc}, with info such as
+@samp{In function `foo':} and @samp{In file included from...:}.
+
+@item
+Support @code{gcc}'s @samp{-fident} and @samp{-fno-ident} options.
+
+@item
+When @samp{-Wunused} in effect, don't warn about local variables used as
+statement-function dummy arguments or @code{DATA} implied-@code{DO} iteration
+variables, even though, strictly speaking, these are not uses
+of the variables themselves.
+
+@item
+When @samp{-W -Wunused} in effect, don't warn about unused dummy arguments
+at all, since there's no way to turn this off for individual
+cases (@code{g77} might someday start warning about these)---applies
+to @code{gcc} versions 2.7.0 and later, since earlier versions didn't
+warn about unused dummy arguments.
+
+@item
+New option @samp{-fno-underscoring} that inhibits transformation of names
+(by appending one or two underscores) so users may experiment
+with implications of such an environment.
+
+@item
+Minor improvement to @file{gcc/f/info} module to make it easier to build
+@code{g77} using the native (non-@code{gcc}) compiler on certain machines
+(but definitely not all machines nor all non-@code{gcc} compilers).
+Please
+do not report bugs showing problems compilers have with
+macros defined in @file{gcc/f/target.h} and used in places like
+@file{gcc/f/expr.c}.
+
+@item
+Add warning to be printed for each invocation of the compiler
+if the target machine @code{INTEGER}, @code{REAL}, or @code{LOGICAL} size
+is not 32 bits,
+since @code{g77} is known to not work well for such cases (to be
+fixed in Version 0.6---@pxref{Actual Bugs,,Actual Bugs We Haven't Fixed Yet}).
+
+@item
+Lots of new documentation (though work is still needed to put it into
+canonical GNU format).
+
+@item
+Build @code{libf2c} with @samp{-g0}, not @samp{-g2}, in effect
+(by default), to produce
+smaller library without lots of debugging clutter.
+@end itemize
+
+@heading In 0.5.15:
+@itemize @bullet
+@item
+Fix bad code generation involving @samp{X**I} and temporary, internal variables
+generated by @code{g77} and the back end (such as for @code{DO} loops).
+
+@item
+Fix crash given @samp{CHARACTER A;DATA A/.TRUE./}.
+
+@item
+Replace crash with diagnostic given @samp{CHARACTER A;DATA A/1.0/}.
+
+@item
+Fix crash or other erratic behavior when null character constant
+(@samp{''}) is encountered.
+
+@item
+Fix crash or other erratic behavior involving diagnosed code.
+
+@item
+Fix code generation for external functions returning type @code{REAL} when
+the @samp{-ff2c} option is in force (which it is by default) so that
+@code{f2c} compatibility is indeed provided.
+
+@item
+Disallow @samp{COMMON I(10)} if @samp{I} has previously been specified
+with an array declarator.
+
+@item
+New @samp{-ffixed-line-length-@var{n}} option, where @var{n} is the
+maximum length
+of a typical fixed-form line, defaulting to 72 columns, such
+that characters beyond column @var{n} are ignored, or @var{n} is @samp{none},
+meaning no characters are ignored.
+does not affect lines
+with @samp{&} in column 1, which are always processed as if
+@samp{-ffixed-line-length-none} was in effect.
+
+@item
+No longer generate better code for some kinds of array references,
+as @code{gcc} back end is to be fixed to do this even better, and it
+turned out to slow down some code in some cases after all.
+
+@item
+In @code{COMMON} and @code{EQUIVALENCE} areas with any members given initial
+values (e.g. via @code{DATA}), uninitialized members now always
+initialized to binary zeros (though this is not required by
+the standard, and might not be done in future versions
+of @code{g77}).
+Previously, in some @code{COMMON}/@code{EQUIVALENCE} areas
+(essentially those with members of more than one type), the
+uninitialized members were initialized to spaces, to
+cater to @code{CHARACTER} types, but it seems no existing code expects
+that, while much existing code expects binary zeros.
+@end itemize
+
+@heading In 0.5.14:
+@itemize @bullet
+@item
+Don't emit bad code when low bound of adjustable array is nonconstant
+and thus might vary as an expression at run time.
+
+@item
+Emit correct code for calculation of number of trips in @code{DO} loops
+for cases
+where the loop should not execute at all.
+(This bug affected cases
+where the difference between the begin and end values was less
+than the step count, though probably not for floating-point cases.)
+
+@item
+Fix crash when extra parentheses surround item in
+@code{DATA} implied-@code{DO} list.
+
+@item
+Fix crash over minor internal inconsistencies in handling diagnostics,
+just substitute dummy strings where necessary.
+
+@item
+Fix crash on some systems when compiling call to @code{MVBITS()} intrinsic.
+
+@item
+Fix crash on array assignment @samp{TYPE@var{ddd}(@dots{})=@dots{}}, where @var{ddd}
+is a string of one or more digits.
+
+@item
+Fix crash on @code{DCMPLX()} with a single @code{INTEGER} argument.
+
+@item
+Fix various crashes involving code with diagnosed errors.
+
+@item
+Support @samp{-I} option for @code{INCLUDE} statement, plus @code{gcc}'s
+@file{header.gcc} facility for handling systems like MS-DOS.
+
+@item
+Allow @code{INCLUDE} statement to be continued across multiple lines,
+even allow it to coexist with other statements on the same line.
+
+@item
+Incorporate Bellcore fixes to @code{libf2c} through 1995-03-15---this
+fixes a bug involving infinite loops reading EOF with empty list-directed
+I/O list.
+
+@item
+Remove all the @code{g77}-specific auto-configuration scripts, code,
+and so on,
+except for temporary substitutes for bsearch() and strtoul(), as
+too many configure/build problems were reported in these areas.
+People will have to fix their systems' problems themselves, or at
+least somewhere other than @code{g77}, which expects a working ANSI C
+environment (and, for now, a GNU C compiler to compile @code{g77} itself).
+
+@item
+Complain if initialized common redeclared as larger in subsequent program
+unit.
+
+@item
+Warn if blank common initialized, since its size can vary and hence
+related warnings that might be helpful won't be seen.
+
+@item
+New @samp{-fbackslash} option, on by default, that causes @samp{\}
+within @code{CHARACTER}
+and Hollerith constants to be interpreted a la GNU C.
+Note that
+this behavior is somewhat different from @code{f2c}'s, which supports only
+a limited subset of backslash (escape) sequences.
+
+@item
+Make @samp{-fugly-args} the default.
+
+@item
+New @samp{-fugly-init} option, on by default, that allows typeless/Hollerith
+to be specified as initial values for variables or named constants
+(@code{PARAMETER}), and also allows character<->numeric conversion in
+those contexts---turn off via @samp{-fno-ugly-init}.
+
+@item
+New @samp{-finit-local-zero} option to initialize
+local variables to binary zeros.
+This does not affect whether they are @code{SAVE}d, i.e. made
+automatic or static.
+
+@item
+New @samp{-Wimplicit} option to warn about implicitly typed variables, arrays,
+and functions.
+(Basically causes all program units to default to @code{IMPLICIT NONE}.)
+
+@item
+@samp{-Wall} now implies @samp{-Wuninitialized} as with @code{gcc}
+(i.e. unless @samp{-O} not specified, since @samp{-Wuninitialized}
+requires @samp{-O}), and implies @samp{-Wunused} as well.
+
+@item
+@samp{-Wunused} no longer gives spurious messages for unused
+@code{EXTERNAL} names (since they are assumed to refer to block data
+program units, to make use of libraries more reliable).
+
+@item
+Support @code{%LOC()} and @code{LOC()} of character arguments.
+
+@item
+Support null (zero-length) character constants and expressions.
+
+@item
+Support @code{f2c}'s @code{IMAG()} generic intrinsic.
+
+@item
+Support @code{ICHAR()}, @code{IACHAR()}, and @code{LEN()} of
+character expressions that are valid in assignments but
+not normally as actual arguments.
+
+@item
+Support @code{f2c}-style @samp{&} in column 1 to mean continuation line.
+
+@item
+Allow @code{NAMELIST}, @code{EXTERNAL}, @code{INTRINSIC}, and @code{VOLATILE}
+in @code{BLOCK DATA}, even though these are not allowed by the standard.
+
+@item
+Allow @code{RETURN} in main program unit.
+
+@item
+Changes to Hollerith-constant support to obey Appendix C of the
+standard:
+
+@itemize --
+@item
+Now padded on the right with zeros, not spaces.
+
+@item
+Hollerith ``format specifications'' in the form of arrays of
+non-character allowed.
+
+@item
+Warnings issued when non-space truncation occurs when converting
+to another type.
+
+@item
+When specified as actual argument, now passed
+by reference to @code{INTEGER} (padded on right with spaces if constant
+too small, otherwise fully intact if constant wider the @code{INTEGER}
+type) instead of by value.
+@end itemize
+
+@strong{Warning:} @code{f2c} differs on the
+interpretation of @samp{CALL FOO(1HX)}, which it treats exactly the
+same as @samp{CALL FOO('X')}, but which the standard and @code{g77} treat
+as @samp{CALL FOO(%REF('X '))} (padded with as many spaces as necessary
+to widen to @code{INTEGER}), essentially.
+
+@item
+Changes and fixes to typeless-constant support:
+
+@itemize --
+@item
+Now treated as a typeless double-length @code{INTEGER} value.
+
+@item
+Warnings issued when overflow occurs.
+
+@item
+Padded on the left with zeros when converting
+to a larger type.
+
+@item
+Should be properly aligned and ordered on
+the target machine for whatever type it is turned into.
+
+@item
+When specified as actual argument, now passed as reference to
+a default @code{INTEGER} constant.
+@end itemize
+
+@item
+@code{%DESCR()} of a non-@code{CHARACTER} expression now passes a pointer to
+the expression plus a length for the expression just as if
+it were a @code{CHARACTER} expression.
+For example, @samp{CALL FOO(%DESCR(D))}, where
+@samp{D} is @code{REAL*8}, is the same as @samp{CALL FOO(D,%VAL(8)))}.
+
+@item
+Name of multi-entrypoint master function changed to incorporate
+the name of the primary entry point instead of a decimal
+value, so the name of the master function for @samp{SUBROUTINE X}
+with alternate entry points is now @samp{__g77_masterfun_x}.
+
+@item
+Remove redundant message about zero-step-count @code{DO} loops.
+
+@item
+Clean up diagnostic messages, shortening many of them.
+
+@item
+Fix typo in @code{g77} man page.
+
+@item
+Clarify implications of constant-handling bugs in @file{f/BUGS}.
+
+@item
+Generate better code for @samp{**} operator with a right-hand operand of
+type @code{INTEGER}.
+
+@item
+Generate better code for @code{SQRT()} and @code{DSQRT()},
+also when @samp{-ffast-math}
+specified, enable better code generation for @code{SIN()} and @code{COS()}.
+
+@item
+Generate better code for some kinds of array references.
+
+@item
+Speed up lexing somewhat (this makes the compilation phase noticeably
+faster).
+@end itemize
diff --git a/gcc/f/news0.texi b/gcc/f/news0.texi
new file mode 100644
index 00000000000..8fb85f456da
--- /dev/null
+++ b/gcc/f/news0.texi
@@ -0,0 +1,14 @@
+@setfilename NEW
+@set NEWSONLY
+
+@c The immediately following lines apply to the NEWS file
+@c which is generated using this file.
+This file lists recent changes to the GNU Fortran compiler.
+Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+You may copy, distribute, and modify it freely as long as you preserve
+this copyright notice and permission notice.
+
+@node Top,,, (dir)
+@chapter News About GNU Fortran
+@include news.texi
+@bye
diff --git a/gcc/f/parse.c b/gcc/f/parse.c
new file mode 100644
index 00000000000..7a48fbb58f5
--- /dev/null
+++ b/gcc/f/parse.c
@@ -0,0 +1,93 @@
+/* GNU Fortran
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#include "proj.h"
+#include <ctype.h>
+#include <signal.h>
+#include "top.h"
+#include "com.h"
+#include "where.h"
+#include "zzz.h"
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "flags.j"
+#endif
+
+#define NAME_OF_STDIN "<stdin>"
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+void
+main (int argc, char *argv[])
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+FILE *finput;
+
+int
+yyparse ()
+#else
+#error
+#endif
+{
+ ffewhereFile wf;
+
+ if (ffe_is_version ())
+ fprintf (stderr, "GNU Fortran Front End version %s compiled: %s %s\n",
+ ffezzz_version_string,
+ ffezzz_date,
+ ffezzz_time);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffe_init_0 ();
+
+ for (--argc, ++argv; argc > 0; --argc, ++argv)
+ {
+ if (!ffe_decode_option (argv[0]))
+ fprintf (stderr, "Unrecognized option: %s\n", argv[0]);
+ }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ if (!ffe_is_pedantic ())
+ ffe_set_is_pedantic (pedantic);
+#else
+#error
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ wf = ffewhere_file_new (NAME_OF_STDIN, strlen (NAME_OF_STDIN));
+ ffecom_file (NAME_OF_STDIN);
+ ffe_file (wf, stdin);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ wf = ffewhere_file_new (main_input_filename, strlen (main_input_filename));
+ ffecom_file (main_input_filename);
+ ffe_file (wf, finput);
+#else
+#error
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffecom_finish_compile ();
+
+ return 0;
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffe_terminate_0 ();
+
+ exit (0);
+#else
+#error
+#endif
+}
diff --git a/gcc/f/proj.c b/gcc/f/proj.c
new file mode 100644
index 00000000000..0e1ef2e8bcd
--- /dev/null
+++ b/gcc/f/proj.c
@@ -0,0 +1,71 @@
+/* proj.c file for GNU Fortran
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "glimits.j"
+
+#if !FFEPROJ_STRTOUL
+unsigned long int
+strtoul (const char *nptr, char **endptr, int base)
+{
+ unsigned long int number = 0;
+ unsigned long int old_number = 0;
+
+ assert (base == 10);
+ assert (endptr == NULL);
+
+ while (isdigit (*nptr))
+ {
+ number = old_number * 10 + (*(nptr++) - '0');
+ if ((number <= old_number) && (old_number != 0))
+ return ULONG_MAX;
+ old_number = number;
+ }
+
+ return number;
+}
+
+#endif
+
+#if !FFEPROJ_BSEARCH
+void *
+bsearch (const void *key, const void *base, size_t nmemb, size_t size,
+ int (*compar) (const void *, const void *))
+{
+ size_t i;
+ int cmp;
+
+ /* We do a dumb incremental search, not a binary search, for now. */
+
+ for (i = 0; i < nmemb; ++i)
+ {
+ if ((cmp = (*compar) (key, base)) == 0)
+ return base;
+ if (cmp < 0)
+ break;
+ base += size;
+ }
+
+ return NULL;
+}
+
+#endif
diff --git a/gcc/f/proj.h b/gcc/f/proj.h
new file mode 100644
index 00000000000..205130a49d1
--- /dev/null
+++ b/gcc/f/proj.h
@@ -0,0 +1,102 @@
+/* proj.h file for Gnu Fortran
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+*/
+
+#ifndef _H_f_proj
+#define _H_f_proj
+
+#if !defined (__GNUC__) || (__GNUC__ < 2)
+#error "You have to use gcc 2.x to build g77 (might be fixed in g77-0.6)."
+#endif
+
+#ifndef BUILT_WITH_270
+#if (__GNUC__ > 2) || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+#define BUILT_WITH_270 1
+#else
+#define BUILT_WITH_270 0
+#endif
+#endif /* !defined (BUILT_WITH_270) */
+
+/* This file used to attempt to allow for all sorts of broken systems.
+ Because the auto-configuration scripts in conf-proj(.in) didn't work
+ on all systems, and I received far too many bug reports about them,
+ I decided to stop trying to cater to broken systems at all, and
+ simply remove all but the simplest and most useful code (which is
+ still in proj.c).
+
+ So, if you find your system can't link because bsearch() or strtoul()
+ aren't found, please just fix your system, or hand-edit the code
+ below as appropriate. I DO NOT WANT ANY "BUG REPORTS" ABOUT THIS.
+ g77 requires a working ANSI C environment, and if bsearch() and strtoul()
+ do not exist, or if <assert.h> isn't found, etc., then you don't have
+ one, and it is not g77's fault. If it turns out g77 is simply
+ referring to the wrong system header file -- something I can verify
+ myself using my copy of the ANSI C standard -- I would like to know
+ about that. Otherwise, g77 is not the place to fix problems with your
+ ANSI C implementation, though perhaps gcc might be.
+ -- burley@gnu.ai.mit.edu 1995-03-24 */
+
+#ifndef FFEPROJ_BSEARCH
+#define FFEPROJ_BSEARCH 1 /* 0=>use slow code in proj.c. */
+#endif
+#ifndef FFEPROJ_STRTOUL
+#define FFEPROJ_STRTOUL 1 /* 0=>use untested code in proj.c. */
+#endif
+
+/* Include files everyone gets. */
+
+#include "assert.j" /* Use gcc's assert.h. */
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+
+/* Generally useful definitions. */
+
+typedef enum
+ {
+#if !defined(false) || !defined(true)
+ false = 0, true = 1,
+#endif
+#if !defined(FALSE) || !defined(TRUE)
+ FALSE = 0, TRUE = 1,
+#endif
+ Doggone_Trailing_Comma_Dont_Work = 1
+ } bool;
+
+#define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0]))
+#define STR(s) # s
+#define STRX(s) STR(s)
+
+#ifndef UNUSED /* Compile with -DUNUSED= if cc doesn't support this. */
+#if BUILT_WITH_270
+#define UNUSED __attribute__ ((unused))
+#else /* !BUILT_WITH_270 */
+#define UNUSED
+#endif /* !BUILT_WITH_270 */
+#endif /* !defined (UNUSED) */
+
+#ifndef dmpout
+#define dmpout stderr
+#endif
+
+#endif
diff --git a/gcc/f/rtl.j b/gcc/f/rtl.j
new file mode 100644
index 00000000000..646e1f6a404
--- /dev/null
+++ b/gcc/f/rtl.j
@@ -0,0 +1,28 @@
+/* rtl.j -- Wrapper for GCC's rtl.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_rtl
+#define _J_f_rtl
+#include "config.j"
+#include "rtl.h"
+#endif
+#endif
diff --git a/gcc/f/runtime/ChangeLog b/gcc/f/runtime/ChangeLog
new file mode 100644
index 00000000000..f5f79c899f7
--- /dev/null
+++ b/gcc/f/runtime/ChangeLog
@@ -0,0 +1,698 @@
+Mon Aug 11 20:12:42 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * libU77/vxtidate_.c: Correct day/month argument order.
+ * f2cext.c: Likewise.
+
+1997-07-07 Dave Love <d.love@dl.ac.uk>
+
+ * f2cext.c: Add alarm_.
+
+ * Makefile.in, libU77/Makefile.in: Add alarm_.
+
+ * libU77/alarm_.c: New file.
+
+1997-06-26 Dave Love <d.love@dl.ac.uk>
+
+ * configure.in: Generally use prefix `g77_' for cached values
+ we've invented, not `ac_'.
+
+Tue Jun 24 18:50:06 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ 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 <burley@gnu.ai.mit.edu>
+
+ * libU77/kill_.c (kill_): KR_headers version needed
+ `*' in front of args in decls.
+
+Sun May 25 03:16:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <dan.pettet@bchydro.bc.ca>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * libU77/stat_.c: Reverse KR/ANSI decls of g_char().
+
+Apr 18 1997 Daniel Pettet <dan.pettet@bchydro.bc.ca>
+
+ * 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 <dan.pettet@bchydro.bc.ca>
+
+ * 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 <dan.pettet@bchydro.bc.ca>
+
+ * libU77/symlnk_.c: Added a couple of (char*) casts to malloc
+ to silence the compiler.
+
+1997-03-17 Dave Love <d.love@dl.ac.uk>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * libI77/uio.c (do_ud) [PAD_UDread]: Add semicolon to err()
+ invocation when macro not defined (from Mumit Khan
+ <khan@xraylith.wisc.edu>).
+
+Fri Feb 28 13:16:50 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * Version 0.5.20 released.
+
+Wed Feb 26 20:28:53 1997 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ 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 <d.love@dl.ac.uk>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ Add libU77 library from Dave Love <d.love@dl.ac.uk>:
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * configure.in: No longer define ALWAYS_FLUSH, the
+ resulting performance is too low.
+
+Wed Dec 18 12:06:02 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ Patch from Mumit Khan <khan@xraylith.wisc.edu>:
+ * libF77/s_paus.c: Add __CYGWIN32__ to list of macros
+ controlling how to pause.
+
+Sun Dec 1 21:25:27 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * configure: Regenerated using autoconf-2.12.
+
+Mon Nov 25 21:16:15 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * configure: Regenerated using autoconf-2.11.
+
+1996-11-19 Dave Love <d.love@dl.ac.uk>
+
+ * libI77/backspace.c: Include sys/types.h for size_t.
+
+Wed Nov 6 14:17:27 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * 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 <d.love@dl.ac.uk>
+
+ Update to Netlib version of 1996-09-26.
+
+ * libI77/Version.c: Use <stdio.h>, not "stdio.h".
+ * libF77/Version.c: Likewise.
+
+Wed Aug 28 13:25:29 1996 Dave Love <d.love@dl.ac.uk>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * libI77/backspace.c (f_back): Cast fread arg to size_t.
+
+Tue Aug 27 19:11:30 1996 Dave Love <d.love@dl.ac.uk>
+
+ * libI77/Version.c: Supply */ to avoid apparent nested comment.
+
+Tue Aug 20 09:21:43 1996 Dave Love <d.love@dl.ac.uk>
+
+ * libF77/Makefile.in (ALL_CFLAGS): Fix missing ../ for include.
+ * libI77/Makefile.in (ALL_CFLAGS): Likewise.
+
+Sat Aug 17 13:00:47 1996 Dave Love <d.love@dl.ac.uk>
+
+ * (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 <d.love@dl.ac.uk>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * libI77/ftell_.c: Added from Netlib distribution.
+
+Sat Mar 30 20:57:24 1996 Dave Love <d.love@dl.ac.uk>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * Makefile.in: Eliminate explicit use of
+ {RANLIB,AR}_FOR_TARGET.
+
+Tue Mar 26 23:39:59 1996 Dave Love <d.love@dl.ac.uk>
+
+ * Makefile.in: Remove hardwired RANLIB and RANLIB_TEST (unnoted
+ change).
+
+Mon Mar 25 21:04:56 1996 Craig Burley <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * configure.in (ac_cpp): #include <stdio.h> instead
+ of <features.h>.
+
+Tue Mar 19 12:52:09 1996 Mumit Khan <khan@xraylith.wisc.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <burley@gnu.ai.mit.edu>
+
+ * 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 <d.love@dl.ac.uk>
+
+ * 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 <rawio.h> 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 <d.love@dl.ac.uk>
+
+ * 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/gcc/f/runtime/Makefile.in b/gcc/f/runtime/Makefile.in
new file mode 100644
index 00000000000..1a20476bd26
--- /dev/null
+++ b/gcc/f/runtime/Makefile.in
@@ -0,0 +1,251 @@
+# 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.
+
+#### Start of system configuration section. ####
+
+# $(srcdir) must be set to the g77 runtime source directory
+# (g77/f/runtime/).
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+top_srcdir = @top_srcdir@
+
+INSTALL = @INSTALL@ # installs aren't actually done from here
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+RANLIB = @RANLIB@
+RANLIB_TEST = @RANLIB_TEST@
+
+CFLAGS = @CFLAGS@
+CPPFLAGS = @CPPFLAGS@ @DEFS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+CGFLAGS = -g0
+
+GCC_FOR_TARGET = @CC@
+CC = $(GCC_FOR_TARGET)
+
+CROSS = @CROSS@
+
+objext = .o
+
+transform=@program_transform_name@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+AR = ar
+AR_FLAGS = rc
+
+# Directory in which to install scripts.
+bindir = $(exec_prefix)/bin
+
+# Directory in which to install library files.
+libdir = $(prefix)/lib
+
+# Directory in which to install documentation info files.
+infodir = $(prefix)/info
+
+#### End of system configuration section. ####
+
+SHELL = /bin/sh
+
+lib = ../../libf2c.a
+
+SUBDIRS = libI77 libF77 libU77
+
+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/system_clock_.o libU77/date_.o \
+ libU77/second_.o libU77/flush1_.o libU77/alarm_.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
+
+# flags_to_pass to recursive makes & configure (hence the quoting style)
+FLAGS_TO_PASS = \
+ CROSS="$(CROSS)" \
+ AR_FLAGS="$(AR_FLAGS)" \
+ AR="$(AR)" \
+ GCCFLAGS="$(GCCFLAGS)" \
+ GCC_FOR_TARGET="$(GCC_FOR_TARGET)" \
+ CC="$(GCC_FOR_TARGET)" \
+ LDFLAGS="$(LDFLAGS)" \
+ RANLIB="$(RANLIB)" \
+ RANLIB_TEST="$(RANLIB_TEST)" \
+ SHELL="$(SHELL)"
+
+CROSS_FLAGS_TO_PASS = \
+ CROSS="$(CROSS)" \
+ AR_FLAGS="$(AR_FLAGS)" \
+ AR="$(AR)" \
+ GCCFLAGS="$(GCCFLAGS)" \
+ GCC_FOR_TARGET="$(GCC_FOR_TARGET)" \
+ CC="$(GCC_FOR_TARGET)" \
+ LDFLAGS="$(LDFLAGS)" \
+ RANLIB="$(RANLIB)" \
+ RANLIB_TEST="$(RANLIB_TEST)" \
+ SHELL="$(SHELL)"
+
+all: ../../include/f2c.h libi77 libf77 libu77 $(lib)
+
+$(lib): stamp-lib ; @true
+stamp-lib: $(FOBJ) $(IOBJ) $(UOBJ)
+ rm -f stamp-lib
+ $(AR) $(AR_FLAGS) $(lib) $?
+ for name in $(F2CEXT); \
+ do \
+ echo $${name}; \
+ $(GCC_FOR_TARGET) -c -I. -I$(srcdir) -I../../include $(CPPFLAGS) $(CFLAGS) $(CGFLAGS) \
+ -DL$${name} $(srcdir)/f2cext.c; \
+ if [ $$? -eq 0 ] ; then true; else exit 1; fi; \
+ mv f2cext$(objext) L$${name}$(objext); \
+ $(AR) $(AR_FLAGS) $(lib) L$${name}$(objext); \
+ rm -f L$${name}$(objext); \
+ done
+ if $(RANLIB_TEST); then $(RANLIB) $(lib); \
+ else true; fi
+ touch stamp-lib
+
+libi77: libI77/Makefile
+ if test "$(CROSS)"; then \
+ cd libI77; $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
+ else \
+ cd libI77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
+ fi
+
+libf77: libF77/Makefile
+ if test "$(CROSS)"; then \
+ cd libF77; $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
+ else \
+ cd libF77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
+ fi
+
+libu77: libU77/Makefile
+ if test "$(CROSS)"; then \
+ cd libU77; $(MAKE) -f Makefile $(CROSS_FLAGS_TO_PASS) all ; \
+ else \
+ cd libU77; $(MAKE) -f Makefile $(FLAGS_TO_PASS) all ; \
+ fi
+
+${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
+#../include/f2c.h libI77/Makefile libF77/Makefile libU77/Makefile Makefile: ${srcdir}/Makefile.in \
+# config.status libU77/config.status
+# $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status
+# cd libU77; $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status
+
+# Extra dependencies for the targets above:
+libI77/Makefile: $(srcdir)/libI77/Makefile.in
+libF77/Makefile: $(srcdir)/libF77/Makefile.in
+libU77/Makefile: $(srcdir)/libU77/Makefile.in
+../../include/f2c.h: $(srcdir)/f2c.h.in
+
+#config.status: ${srcdir}/configure
+# $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status --recheck
+#libU77/config.status: ${srcdir}/libU77/configure
+# cd libU77; $(FLAGS_TO_PASS) CONFIG_SITE=/dev/null $(SHELL) config.status --recheck
+
+mostlyclean:
+ for i in libI77 libF77 libU77; do cd $$i; $(MAKE) -f Makefile mostlyclean; cd ..; done
+
+clean:
+ -rm -f config.log config.cache
+ for i in libI77 libF77 libU77; do cd $$i; $(MAKE) -f Makefile clean; cd ..; done
+
+distclean: clean
+ -rm -f Makefile lib?77/Makefile config.status libU77/config.status ../../include/f2c.h
+
+maintainer-clean: distclean
+ -rm -f $(srcdir)/configure $(srcdir)/libU77/configure
+
+uninstall:
+ rm ../../include/f2c.h
+
+rebuilt: ${srcdir}/configure ${srcdir}/libU77/configure
+
+.PHONY: libf77 libi77 libu77 rebuilt mostlyclean clean distclean maintainer-clean \
+ uninstall all
diff --git a/gcc/f/runtime/README b/gcc/f/runtime/README
new file mode 100644
index 00000000000..9419af77189
--- /dev/null
+++ b/gcc/f/runtime/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 <ftp:bell-labs.com/netlib/f2c/> and are maintained (excellently) by
+David M. Gay <dmg@bell-labs.com>. 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 <d.love@dl.ac.uk>.
+Minor changes have been made by James Craig Burley <burley@gnu.ai.mit.edu>,
+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/gcc/f/runtime/TODO b/gcc/f/runtime/TODO
new file mode 100644
index 00000000000..a44d1ed7f23
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/changes.netlib b/gcc/f/runtime/changes.netlib
new file mode 100644
index 00000000000..0edfba3a854
--- /dev/null
+++ b/gcc/f/runtime/changes.netlib
@@ -0,0 +1,2836 @@
+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 <string.h> in mem.c
+changed to #include "string.h" so BSD people can create a local
+string.h that simply says #include <strings.h> .
+
+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.
diff --git a/gcc/f/runtime/configure b/gcc/f/runtime/configure
new file mode 100755
index 00000000000..dcc60b6e656
--- /dev/null
+++ b/gcc/f/runtime/configure
@@ -0,0 +1,2048 @@
+#! /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 <<EOF
+#line 617 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:621: \"$ac_link\") 1>&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 <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:655: \"$ac_try\") 1>&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 :
+
+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:712: 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:745: 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 <<EOF
+#line 760 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:766: \"$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 <<EOF
+#line 777 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:783: \"$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:807: 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
+#line 812 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:817: \"$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:845: 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 <<EOF
+#line 850 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:858: \"$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
+#line 875 "configure"
+#include "confdefs.h"
+#include <string.h>
+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
+#line 893 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+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 <<EOF
+#line 914 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#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:925: \"$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:951: 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 <<EOF
+#line 956 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <unistd.h>
+#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:982: 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 <<EOF
+#line 987 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+#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:1011: 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 <<EOF
+#line 1016 "configure"
+#include "confdefs.h"
+#ifdef __CYGWIN32__
+ yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&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
+
+ac_safe=`echo "fcntl.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for fcntl.h""... $ac_c" 1>&6
+echo "configure:1039: 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
+#line 1044 "configure"
+#include "confdefs.h"
+#include <fcntl.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1049: \"$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:1082: 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 <<EOF
+#line 1087 "configure"
+#include "confdefs.h"
+
+int main() {
+
+/* Ultrix mips cc rejects this. */
+typedef int charset[2]; const charset x;
+/* SunOS 4.1.1 cc rejects this. */
+char const *const *ccp;
+char **p;
+/* NEC SVR4.0.2 mips cc rejects this. */
+struct point {int x, y;};
+static struct point const zero = {0,0};
+/* AIX XL C 1.02.0.0 rejects this.
+ It does not let you subtract one const X* pointer from another in an arm
+ of an if-expression whose if-part is not a constant expression */
+const char *g = "string";
+ccp = &g + (g ? g-g : 0);
+/* HPUX 7.0 cc rejects these. */
+++ccp;
+p = (char**) ccp;
+ccp = (char const *const *) p;
+{ /* SCO 3.2v4 cc rejects this. */
+ char *t;
+ char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+ *t++ = 0;
+}
+{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
+ int x[] = {25, 17};
+ const int *foo = &x[0];
+ ++foo;
+}
+{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+ typedef const int *iptr;
+ iptr p = 0;
+ ++p;
+}
+{ /* AIX XL C 1.02.0.0 rejects this saying
+ "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+ struct s { int j; const int *ap[3]; };
+ struct s *b; b->j = 5;
+}
+{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+ const int foo = 10;
+}
+
+; return 0; }
+EOF
+if { (eval echo configure:1136: \"$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:1157: 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 <<EOF
+#line 1162 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#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:1191: 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 <<EOF
+#line 1196 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <signal.h>
+#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:1213: \"$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 <<EOF
+#define RETSIGTYPE $ac_cv_type_signal
+EOF
+
+
+# we'll get atexit by default
+if test $ac_cv_header_stdc != yes; then
+echo $ac_n "checking for atexit""... $ac_c" 1>&6
+echo "configure:1234: 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 <<EOF
+#line 1239 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char atexit(); below. */
+#include <assert.h>
+/* 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:1262: \"$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:1287: 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 <<EOF
+#line 1292 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char onexit(); below. */
+#include <assert.h>
+/* 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:1315: \"$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:1333: 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 <<EOF
+#line 1338 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char on_exit(); below. */
+#include <assert.h>
+/* 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:1361: \"$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).
+echo $ac_n "checking for fstat""... $ac_c" 1>&6
+echo "configure:1394: 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 <<EOF
+#line 1399 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char fstat(); below. */
+#include <assert.h>
+/* 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:1422: \"$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:1442: checking need for NON_UNIX_STDIO" >&5
+if test $g77_cv_sys_cygwin32 = 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:1455: 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 <<EOF
+#line 1460 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+int main() {
+FILE s; s._ptr; s._base; s._flag;
+; return 0; }
+EOF
+if { (eval echo configure:1467: \"$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:1487: 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 <<EOF
+#line 1495 "configure"
+#include "confdefs.h"
+/* 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 drem();
+
+int main() {
+drem()
+; return 0; }
+EOF
+if { (eval echo configure:1506: \"$ac_link\") 1>&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:1536: checking for ansi/posix sprintf result" >&5
+if test "$cross_compiling" = yes; then
+ g77_cv_sys_sprintf_ansi=no
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1541 "configure"
+#include "confdefs.h"
+ #include <stdio.h>
+ /* 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:1548: \"$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:1582: checking NON_ANSI_RW_MODES" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1584 "configure"
+#include "confdefs.h"
+#ifdef unix
+ yes
+#endif
+#ifdef __unix
+ yes
+#endif
+#ifdef __unix__
+ yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&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; 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:1625: 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 <<EOF
+#line 1632 "configure"
+#include "confdefs.h"
+#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
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&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 <<EOF
+#line 1655 "configure"
+#include "confdefs.h"
+#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
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&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:1690: 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 <<EOF
+#line 1697 "configure"
+#include "confdefs.h"
+#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
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&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 <<EOF
+#line 1720 "configure"
+#include "confdefs.h"
+#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
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&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
+
+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 <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/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 ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > 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
+
+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 <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/Makefile"}
+EOF
+cat >> $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 <<EOF
+
+EOF
+cat >> $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/gcc/f/runtime/configure.in b/gcc/f/runtime/configure.in
new file mode 100644
index 00000000000..d2bcebae865
--- /dev/null
+++ b/gcc/f/runtime/configure.in
@@ -0,0 +1,371 @@
+# 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)
+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 <sys/types.h>
+#include <unistd.h>
+#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 <stdio.h>
+#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)
+
+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).
+AC_CHECK_FUNC(fstat)
+AC_MSG_CHECKING([need for NON_UNIX_STDIO])
+if test $g77_cv_sys_cygwin32 = 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 <stdio.h>],
+ [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 <stdio.h>
+ /* 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; 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_OUTPUT(Makefile ../../include/f2c.h:f2c.h.in libI77/Makefile libF77/Makefile libU77/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/gcc/f/runtime/disclaimer.netlib b/gcc/f/runtime/disclaimer.netlib
new file mode 100644
index 00000000000..a11108f83db
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/f2c.h.in b/gcc/f/runtime/f2c.h.in
new file mode 100644
index 00000000000..90374678100
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/f2cext.c b/gcc/f/runtime/f2cext.c
new file mode 100644
index 00000000000..199440975d4
--- /dev/null
+++ b/gcc/f/runtime/f2cext.c
@@ -0,0 +1,565 @@
+/* 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 <f2c.h>
+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
+
+/* Note that erf*_ and bes*_ return doublereal, not real, as this
+ is the f2c interface, which is based on K&R C. */
+
+#ifdef Lerf
+doublereal erf_ (real *x) {
+ extern double G77_erf_0 (real *x);
+ return G77_erf_0 (x);
+}
+#endif
+
+#ifdef Lerfc
+doublereal 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
+doublereal besj0_ (const real *x) {
+ return j0 (*x);
+}
+#endif
+
+#ifdef Lbesj1
+doublereal besj1_ (const real *x) {
+ return j1 (*x);
+}
+#endif
+
+#ifdef Lbesjn
+doublereal besjn_ (const integer *n, real *x) {
+ return jn (*n, *x);
+}
+#endif
+
+#ifdef Lbesy0
+doublereal besy0_ (const real *x) {
+ return y0 (*x);
+}
+#endif
+
+#ifdef Lbesy1
+doublereal besy1_ (const real *x) {
+ return y1 (*x);
+}
+#endif
+
+#ifdef Lbesyn
+doublereal 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
+doublereal dbesj0_ (const double *x) {
+ return j0 (*x);
+}
+#endif
+
+#ifdef Ldbesj1
+doublereal dbesj1_ (const double *x) {
+ return j1 (*x);
+}
+#endif
+
+#ifdef Ldbesjn
+doublereal dbesjn_ (const integer *n, double *x) {
+ return jn (*n, *x);
+}
+#endif
+
+#ifdef Ldbesy0
+doublereal dbesy0_ (const double *x) {
+ return y0 (*x);
+}
+#endif
+
+#ifdef Ldbesy1
+doublereal dbesy1_ (const double *x) {
+ return y1 (*x);
+}
+#endif
+
+#ifdef Ldbesyn
+doublereal dbesyn_ (const integer *n, double *x) {
+ return yn (*n, *x);
+}
+#endif
+
+#ifdef Ldtime
+doublereal dtime_ (real tarray[2]) {
+ extern doublereal G77_dtime_0 (real tarray[2]);
+ return G77_dtime_0 (tarray);
+}
+#endif
+
+#ifdef Letime
+doublereal etime_ (real tarray[2]) {
+ extern doublereal 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
+doublereal rand_ (integer *flag) {
+ extern doublereal 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
+doublereal secnds_ (real *r) {
+ extern doublereal G77_secnds_0 (real *r);
+ return G77_secnds_0 (r);
+}
+#endif
+
+#ifdef Lsecond
+doublereal second_ () {
+ extern doublereal 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/gcc/f/runtime/libF77/F77_aloc.c b/gcc/f/runtime/libF77/F77_aloc.c
new file mode 100644
index 00000000000..8754fe2ef70
--- /dev/null
+++ b/gcc/f/runtime/libF77/F77_aloc.c
@@ -0,0 +1,32 @@
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#include <stdio.h>
+
+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 <stdlib.h>
+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/gcc/f/runtime/libF77/Makefile.in b/gcc/f/runtime/libF77/Makefile.in
new file mode 100644
index 00000000000..208626cb4a0
--- /dev/null
+++ b/gcc/f/runtime/libF77/Makefile.in
@@ -0,0 +1,95 @@
+# 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. ####
+
+# The _FOR_TARGET things are appropriate for a cross-make, passed by the
+# superior makefile
+GCC_FOR_TARGET = @CC@
+CC = $(GCC_FOR_TARGET)
+CFLAGS = @CFLAGS@ $(GCC_FLAGS)
+CPPFLAGS = @CPPFLAGS@
+DEFS = @DEFS@
+CGFLAGS = -g0
+# 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../../../include $(CPPFLAGS) $(DEFS) $(CFLAGS)
+AR = @AR@
+AR_FLAGS = rc
+RANLIB = @RANLIB@
+RANLIB_TEST = @RANLIB_TEST@
+CROSS = @CROSS@
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+.c.o:
+ $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $(CGFLAGS) $<
+
+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 = ../../../include/f2c.h
+
+all: $(MISC) $(POW) $(CX) $(DCX) $(REAL) $(DBL) $(INT) \
+ $(HALF) $(CMP) $(EFL) $(CHAR) $(F90BIT)
+
+VersionF.o: Version.c
+ $(CC) -c $(CGFLAGS) -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/gcc/f/runtime/libF77/Notice b/gcc/f/runtime/libF77/Notice
new file mode 100644
index 00000000000..261b719bc57
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/README.netlib b/gcc/f/runtime/libF77/README.netlib
new file mode 100644
index 00000000000..76682152551
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/Version.c b/gcc/f/runtime/libF77/Version.c
new file mode 100644
index 00000000000..5d14f2a3f1d
--- /dev/null
+++ b/gcc/f/runtime/libF77/Version.c
@@ -0,0 +1,65 @@
+static char junk[] = "\n@(#)LIBF77 VERSION 19970404\n";
+
+/*
+*/
+
+char __G77_LIBF77_VERSION__[] = "0.5.21-19970811";
+
+/*
+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).
+*/
+
+#include <stdio.h>
+
+void
+g77__fvers__ ()
+{
+ fprintf (stderr, "__G77_LIBF77_VERSION__: %s", __G77_LIBF77_VERSION__);
+ fputs (junk, stderr);
+}
diff --git a/gcc/f/runtime/libF77/abort_.c b/gcc/f/runtime/libF77/abort_.c
new file mode 100644
index 00000000000..8efdc42f970
--- /dev/null
+++ b/gcc/f/runtime/libF77/abort_.c
@@ -0,0 +1,18 @@
+#include <stdio.h>
+#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/gcc/f/runtime/libF77/c_abs.c b/gcc/f/runtime/libF77/c_abs.c
new file mode 100644
index 00000000000..041fbd3d8bb
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/c_cos.c b/gcc/f/runtime/libF77/c_cos.c
new file mode 100644
index 00000000000..9e833c168b3
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+
+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/gcc/f/runtime/libF77/c_div.c b/gcc/f/runtime/libF77/c_div.c
new file mode 100644
index 00000000000..9568354bd53
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/c_exp.c b/gcc/f/runtime/libF77/c_exp.c
new file mode 100644
index 00000000000..8d3d33d0fe3
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+
+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/gcc/f/runtime/libF77/c_log.c b/gcc/f/runtime/libF77/c_log.c
new file mode 100644
index 00000000000..6715131ad1d
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libF77/c_sin.c b/gcc/f/runtime/libF77/c_sin.c
new file mode 100644
index 00000000000..7bf3e392bed
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+
+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/gcc/f/runtime/libF77/c_sqrt.c b/gcc/f/runtime/libF77/c_sqrt.c
new file mode 100644
index 00000000000..775977a87f7
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libF77/cabs.c b/gcc/f/runtime/libF77/cabs.c
new file mode 100644
index 00000000000..2fad044e884
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libF77/d_abs.c b/gcc/f/runtime/libF77/d_abs.c
new file mode 100644
index 00000000000..cb157e067b7
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/d_acos.c b/gcc/f/runtime/libF77/d_acos.c
new file mode 100644
index 00000000000..33da5369db2
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_acos(doublereal *x)
+#endif
+{
+return( acos(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_asin.c b/gcc/f/runtime/libF77/d_asin.c
new file mode 100644
index 00000000000..79b33ca1bd6
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_asin(doublereal *x)
+#endif
+{
+return( asin(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_atan.c b/gcc/f/runtime/libF77/d_atan.c
new file mode 100644
index 00000000000..caea4a406e0
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_atan(doublereal *x)
+#endif
+{
+return( atan(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_atn2.c b/gcc/f/runtime/libF77/d_atn2.c
new file mode 100644
index 00000000000..6748a55d56f
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_atn2(doublereal *x, doublereal *y)
+#endif
+{
+return( atan2(*x,*y) );
+}
diff --git a/gcc/f/runtime/libF77/d_cnjg.c b/gcc/f/runtime/libF77/d_cnjg.c
new file mode 100644
index 00000000000..1afa3bc4061
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/d_cos.c b/gcc/f/runtime/libF77/d_cos.c
new file mode 100644
index 00000000000..fa4d6ca406f
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_cos(doublereal *x)
+#endif
+{
+return( cos(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_cosh.c b/gcc/f/runtime/libF77/d_cosh.c
new file mode 100644
index 00000000000..edc0ebc1092
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_cosh(doublereal *x)
+#endif
+{
+return( cosh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_dim.c b/gcc/f/runtime/libF77/d_dim.c
new file mode 100644
index 00000000000..1d0ecb7bbb6
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/d_exp.c b/gcc/f/runtime/libF77/d_exp.c
new file mode 100644
index 00000000000..be12fd70551
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_exp(doublereal *x)
+#endif
+{
+return( exp(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_imag.c b/gcc/f/runtime/libF77/d_imag.c
new file mode 100644
index 00000000000..793a3f9c405
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/d_int.c b/gcc/f/runtime/libF77/d_int.c
new file mode 100644
index 00000000000..beff1e7d378
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_int(doublereal *x)
+#endif
+{
+return( (*x>0) ? floor(*x) : -floor(- *x) );
+}
diff --git a/gcc/f/runtime/libF77/d_lg10.c b/gcc/f/runtime/libF77/d_lg10.c
new file mode 100644
index 00000000000..c0892bd512a
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_lg10(doublereal *x)
+#endif
+{
+return( log10e * log(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_log.c b/gcc/f/runtime/libF77/d_log.c
new file mode 100644
index 00000000000..592015b2821
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_log(doublereal *x)
+#endif
+{
+return( log(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_mod.c b/gcc/f/runtime/libF77/d_mod.c
new file mode 100644
index 00000000000..23f19299168
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+#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/gcc/f/runtime/libF77/d_nint.c b/gcc/f/runtime/libF77/d_nint.c
new file mode 100644
index 00000000000..064beff669c
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_nint(doublereal *x)
+#endif
+{
+return( (*x)>=0 ?
+ floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/d_prod.c b/gcc/f/runtime/libF77/d_prod.c
new file mode 100644
index 00000000000..3d4cef7835c
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/d_sign.c b/gcc/f/runtime/libF77/d_sign.c
new file mode 100644
index 00000000000..514ff0bbff8
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/d_sin.c b/gcc/f/runtime/libF77/d_sin.c
new file mode 100644
index 00000000000..fdd699eede5
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_sin(doublereal *x)
+#endif
+{
+return( sin(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_sinh.c b/gcc/f/runtime/libF77/d_sinh.c
new file mode 100644
index 00000000000..77f36904f8e
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_sinh(doublereal *x)
+#endif
+{
+return( sinh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_sqrt.c b/gcc/f/runtime/libF77/d_sqrt.c
new file mode 100644
index 00000000000..b5cf83b946f
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_sqrt(doublereal *x)
+#endif
+{
+return( sqrt(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_tan.c b/gcc/f/runtime/libF77/d_tan.c
new file mode 100644
index 00000000000..af94a053223
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_tan(doublereal *x)
+#endif
+{
+return( tan(*x) );
+}
diff --git a/gcc/f/runtime/libF77/d_tanh.c b/gcc/f/runtime/libF77/d_tanh.c
new file mode 100644
index 00000000000..92a02d4fd6b
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double d_tanh(doublereal *x)
+#endif
+{
+return( tanh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/derf_.c b/gcc/f/runtime/libF77/derf_.c
new file mode 100644
index 00000000000..fba6b6b11f3
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/derfc_.c b/gcc/f/runtime/libF77/derfc_.c
new file mode 100644
index 00000000000..ae1ac740302
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/dtime_.c b/gcc/f/runtime/libF77/dtime_.c
new file mode 100644
index 00000000000..2e775c6b84e
--- /dev/null
+++ b/gcc/f/runtime/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
+
+ float
+#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/gcc/f/runtime/libF77/ef1asc_.c b/gcc/f/runtime/libF77/ef1asc_.c
new file mode 100644
index 00000000000..a922a1d9ba9
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/ef1cmc_.c b/gcc/f/runtime/libF77/ef1cmc_.c
new file mode 100644
index 00000000000..f471172935f
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/erf_.c b/gcc/f/runtime/libF77/erf_.c
new file mode 100644
index 00000000000..1ba4350ad05
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/erfc_.c b/gcc/f/runtime/libF77/erfc_.c
new file mode 100644
index 00000000000..f44b1d49d84
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/etime_.c b/gcc/f/runtime/libF77/etime_.c
new file mode 100644
index 00000000000..0fb658af43c
--- /dev/null
+++ b/gcc/f/runtime/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
+
+ float
+#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/gcc/f/runtime/libF77/exit_.c b/gcc/f/runtime/libF77/exit_.c
new file mode 100644
index 00000000000..4c0582add12
--- /dev/null
+++ b/gcc/f/runtime/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 <stdlib.h>
+#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/gcc/f/runtime/libF77/f2ch.add b/gcc/f/runtime/libF77/f2ch.add
new file mode 100644
index 00000000000..a2acc17a159
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/getarg_.c b/gcc/f/runtime/libF77/getarg_.c
new file mode 100644
index 00000000000..eaded2e4c9b
--- /dev/null
+++ b/gcc/f/runtime/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<xargc)
+ t = xargv[*n];
+else
+ t = "";
+for(i = 0; i<ls && *t!='\0' ; ++i)
+ *s++ = *t++;
+for( ; i<ls ; ++i)
+ *s++ = ' ';
+}
diff --git a/gcc/f/runtime/libF77/getenv_.c b/gcc/f/runtime/libF77/getenv_.c
new file mode 100644
index 00000000000..b9916e6065e
--- /dev/null
+++ b/gcc/f/runtime/libF77/getenv_.c
@@ -0,0 +1,51 @@
+#include "f2c.h"
+
+/*
+ * getenv - f77 subroutine to return environment variables
+ *
+ * called by:
+ * call getenv (ENV_NAME, char_var)
+ * where:
+ * ENV_NAME is the name of an environment variable
+ * char_var is a character variable which will receive
+ * the current value of ENV_NAME, or all blanks
+ * if ENV_NAME is not defined
+ */
+
+#ifdef KR_headers
+VOID G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen;
+#else
+void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen)
+#endif
+{
+extern char **environ;
+register char *ep, *fp, *flast;
+register char **env = environ;
+
+flast = fname + flen;
+for(fp = fname ; fp < flast ; ++fp)
+ if(*fp == ' ')
+ {
+ flast = fp;
+ break;
+ }
+
+while (ep = *env++)
+ {
+ for(fp = fname; fp<flast ; )
+ if(*fp++ != *ep++)
+ goto endloop;
+
+ if(*ep++ == '=') { /* copy right hand side */
+ while( *ep && --vlen>=0 )
+ *value++ = *ep++;
+
+ goto blank;
+ }
+endloop: ;
+ }
+
+blank:
+ while( --vlen >= 0 )
+ *value++ = ' ';
+}
diff --git a/gcc/f/runtime/libF77/h_abs.c b/gcc/f/runtime/libF77/h_abs.c
new file mode 100644
index 00000000000..73b82151ac1
--- /dev/null
+++ b/gcc/f/runtime/libF77/h_abs.c
@@ -0,0 +1,12 @@
+#include "f2c.h"
+
+#ifdef KR_headers
+shortint h_abs(x) shortint *x;
+#else
+shortint h_abs(shortint *x)
+#endif
+{
+if(*x >= 0)
+ return(*x);
+return(- *x);
+}
diff --git a/gcc/f/runtime/libF77/h_dim.c b/gcc/f/runtime/libF77/h_dim.c
new file mode 100644
index 00000000000..ceff660e26c
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/h_dnnt.c b/gcc/f/runtime/libF77/h_dnnt.c
new file mode 100644
index 00000000000..9d0aa25f1d3
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+shortint h_dnnt(doublereal *x)
+#endif
+{
+return( (*x)>=0 ?
+ floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/h_indx.c b/gcc/f/runtime/libF77/h_indx.c
new file mode 100644
index 00000000000..a211cc7fa0f
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/h_len.c b/gcc/f/runtime/libF77/h_len.c
new file mode 100644
index 00000000000..00a2151bfa1
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/h_mod.c b/gcc/f/runtime/libF77/h_mod.c
new file mode 100644
index 00000000000..43431c1c503
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/h_nint.c b/gcc/f/runtime/libF77/h_nint.c
new file mode 100644
index 00000000000..0af3735da42
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+shortint h_nint(real *x)
+#endif
+{
+return( (*x)>=0 ?
+ floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/h_sign.c b/gcc/f/runtime/libF77/h_sign.c
new file mode 100644
index 00000000000..7b06c157a74
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/hl_ge.c b/gcc/f/runtime/libF77/hl_ge.c
new file mode 100644
index 00000000000..4c29527065a
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/hl_gt.c b/gcc/f/runtime/libF77/hl_gt.c
new file mode 100644
index 00000000000..c4f345a0859
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/hl_le.c b/gcc/f/runtime/libF77/hl_le.c
new file mode 100644
index 00000000000..a9cce596c71
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/hl_lt.c b/gcc/f/runtime/libF77/hl_lt.c
new file mode 100644
index 00000000000..162d919c3b4
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/i_abs.c b/gcc/f/runtime/libF77/i_abs.c
new file mode 100644
index 00000000000..be21295aaa1
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/i_dim.c b/gcc/f/runtime/libF77/i_dim.c
new file mode 100644
index 00000000000..6e1b1707b55
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/i_dnnt.c b/gcc/f/runtime/libF77/i_dnnt.c
new file mode 100644
index 00000000000..8fcecb68200
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+integer i_dnnt(doublereal *x)
+#endif
+{
+return( (*x)>=0 ?
+ floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/i_indx.c b/gcc/f/runtime/libF77/i_indx.c
new file mode 100644
index 00000000000..96e7bc51ba8
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/i_len.c b/gcc/f/runtime/libF77/i_len.c
new file mode 100644
index 00000000000..4020fee4618
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/i_mod.c b/gcc/f/runtime/libF77/i_mod.c
new file mode 100644
index 00000000000..6937c421357
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/i_nint.c b/gcc/f/runtime/libF77/i_nint.c
new file mode 100644
index 00000000000..c0f6795171f
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+integer i_nint(real *x)
+#endif
+{
+return( (*x)>=0 ?
+ floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/i_sign.c b/gcc/f/runtime/libF77/i_sign.c
new file mode 100644
index 00000000000..94009b86e6f
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/iargc_.c b/gcc/f/runtime/libF77/iargc_.c
new file mode 100644
index 00000000000..7ce5e08d306
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/l_ge.c b/gcc/f/runtime/libF77/l_ge.c
new file mode 100644
index 00000000000..86b4a1f5a7f
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/l_gt.c b/gcc/f/runtime/libF77/l_gt.c
new file mode 100644
index 00000000000..c4b52f5bf7d
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/l_le.c b/gcc/f/runtime/libF77/l_le.c
new file mode 100644
index 00000000000..f2740a23814
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/l_lt.c b/gcc/f/runtime/libF77/l_lt.c
new file mode 100644
index 00000000000..c48dc946f9a
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/lbitbits.c b/gcc/f/runtime/libF77/lbitbits.c
new file mode 100644
index 00000000000..75e9f9c603f
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/lbitshft.c b/gcc/f/runtime/libF77/lbitshft.c
new file mode 100644
index 00000000000..81b0fdbeaba
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/main.c b/gcc/f/runtime/libF77/main.c
new file mode 100644
index 00000000000..469a64bdcb3
--- /dev/null
+++ b/gcc/f/runtime/libF77/main.c
@@ -0,0 +1,135 @@
+/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
+
+#include <stdio.h>
+#include "signal1.h"
+
+#ifndef SIGIOT
+#ifdef SIGABRT
+#define SIGIOT SIGABRT
+#endif
+#endif
+
+#ifndef KR_headers
+#undef VOID
+#include <stdlib.h>
+#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/gcc/f/runtime/libF77/makefile.netlib b/gcc/f/runtime/libF77/makefile.netlib
new file mode 100644
index 00000000000..230ca7e9f93
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/pow_ci.c b/gcc/f/runtime/libF77/pow_ci.c
new file mode 100644
index 00000000000..37e2ce0f2eb
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/pow_dd.c b/gcc/f/runtime/libF77/pow_dd.c
new file mode 100644
index 00000000000..d0dd0ff2744
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double pow_dd(doublereal *ap, doublereal *bp)
+#endif
+{
+return(pow(*ap, *bp) );
+}
diff --git a/gcc/f/runtime/libF77/pow_di.c b/gcc/f/runtime/libF77/pow_di.c
new file mode 100644
index 00000000000..affed625a91
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/pow_hh.c b/gcc/f/runtime/libF77/pow_hh.c
new file mode 100644
index 00000000000..24a019734da
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/pow_ii.c b/gcc/f/runtime/libF77/pow_ii.c
new file mode 100644
index 00000000000..84d1c7e0b5e
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/pow_qq.c b/gcc/f/runtime/libF77/pow_qq.c
new file mode 100644
index 00000000000..3bc80e05f7f
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/pow_ri.c b/gcc/f/runtime/libF77/pow_ri.c
new file mode 100644
index 00000000000..6e5816bbf10
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/pow_zi.c b/gcc/f/runtime/libF77/pow_zi.c
new file mode 100644
index 00000000000..898ea6be917
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/pow_zz.c b/gcc/f/runtime/libF77/pow_zz.c
new file mode 100644
index 00000000000..20faf29cfb8
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libF77/qbitbits.c b/gcc/f/runtime/libF77/qbitbits.c
new file mode 100644
index 00000000000..ad4ac963ce2
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/qbitshft.c b/gcc/f/runtime/libF77/qbitshft.c
new file mode 100644
index 00000000000..87fffb91ff8
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/r_abs.c b/gcc/f/runtime/libF77/r_abs.c
new file mode 100644
index 00000000000..7b222961d16
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/r_acos.c b/gcc/f/runtime/libF77/r_acos.c
new file mode 100644
index 00000000000..330f88a3092
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_acos(real *x)
+#endif
+{
+return( acos(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_asin.c b/gcc/f/runtime/libF77/r_asin.c
new file mode 100644
index 00000000000..45ece4b749e
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_asin(real *x)
+#endif
+{
+return( asin(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_atan.c b/gcc/f/runtime/libF77/r_atan.c
new file mode 100644
index 00000000000..36479c915b0
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_atan(real *x)
+#endif
+{
+return( atan(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_atn2.c b/gcc/f/runtime/libF77/r_atn2.c
new file mode 100644
index 00000000000..9347e1f13a9
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_atn2(real *x, real *y)
+#endif
+{
+return( atan2(*x,*y) );
+}
diff --git a/gcc/f/runtime/libF77/r_cnjg.c b/gcc/f/runtime/libF77/r_cnjg.c
new file mode 100644
index 00000000000..b6175eedfd7
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/r_cos.c b/gcc/f/runtime/libF77/r_cos.c
new file mode 100644
index 00000000000..5bda158cee9
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_cos(real *x)
+#endif
+{
+return( cos(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_cosh.c b/gcc/f/runtime/libF77/r_cosh.c
new file mode 100644
index 00000000000..7ae72cc0cef
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_cosh(real *x)
+#endif
+{
+return( cosh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_dim.c b/gcc/f/runtime/libF77/r_dim.c
new file mode 100644
index 00000000000..baca95cd9e4
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/r_exp.c b/gcc/f/runtime/libF77/r_exp.c
new file mode 100644
index 00000000000..d1dea75563f
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_exp(real *x)
+#endif
+{
+return( exp(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_imag.c b/gcc/f/runtime/libF77/r_imag.c
new file mode 100644
index 00000000000..d51252bbb79
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/r_int.c b/gcc/f/runtime/libF77/r_int.c
new file mode 100644
index 00000000000..8378e775726
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_int(real *x)
+#endif
+{
+return( (*x>0) ? floor(*x) : -floor(- *x) );
+}
diff --git a/gcc/f/runtime/libF77/r_lg10.c b/gcc/f/runtime/libF77/r_lg10.c
new file mode 100644
index 00000000000..51f84201711
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_lg10(real *x)
+#endif
+{
+return( log10e * log(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_log.c b/gcc/f/runtime/libF77/r_log.c
new file mode 100644
index 00000000000..4873fb418e8
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_log(real *x)
+#endif
+{
+return( log(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_mod.c b/gcc/f/runtime/libF77/r_mod.c
new file mode 100644
index 00000000000..faea344a7b7
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+#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/gcc/f/runtime/libF77/r_nint.c b/gcc/f/runtime/libF77/r_nint.c
new file mode 100644
index 00000000000..f5382af660a
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_nint(real *x)
+#endif
+{
+return( (*x)>=0 ?
+ floor(*x + .5) : -floor(.5 - *x) );
+}
diff --git a/gcc/f/runtime/libF77/r_sign.c b/gcc/f/runtime/libF77/r_sign.c
new file mode 100644
index 00000000000..df6d02af00a
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/r_sin.c b/gcc/f/runtime/libF77/r_sin.c
new file mode 100644
index 00000000000..095b9510de9
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_sin(real *x)
+#endif
+{
+return( sin(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_sinh.c b/gcc/f/runtime/libF77/r_sinh.c
new file mode 100644
index 00000000000..3bf4bb138be
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_sinh(real *x)
+#endif
+{
+return( sinh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_sqrt.c b/gcc/f/runtime/libF77/r_sqrt.c
new file mode 100644
index 00000000000..d0203d3d19b
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_sqrt(real *x)
+#endif
+{
+return( sqrt(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_tan.c b/gcc/f/runtime/libF77/r_tan.c
new file mode 100644
index 00000000000..fc0009e4774
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_tan(real *x)
+#endif
+{
+return( tan(*x) );
+}
diff --git a/gcc/f/runtime/libF77/r_tanh.c b/gcc/f/runtime/libF77/r_tanh.c
new file mode 100644
index 00000000000..818c6a8451b
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+double r_tanh(real *x)
+#endif
+{
+return( tanh(*x) );
+}
diff --git a/gcc/f/runtime/libF77/s_cat.c b/gcc/f/runtime/libF77/s_cat.c
new file mode 100644
index 00000000000..f462fd24945
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#undef abs
+#ifdef KR_headers
+ extern char *F77_aloc();
+ extern void free();
+ extern void G77_exit_0 ();
+#else
+#undef min
+#undef max
+#include <stdlib.h>
+ extern char *F77_aloc(ftnlen, char*);
+#endif
+#include <string.h>
+#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/gcc/f/runtime/libF77/s_cmp.c b/gcc/f/runtime/libF77/s_cmp.c
new file mode 100644
index 00000000000..1e052f28642
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/s_copy.c b/gcc/f/runtime/libF77/s_copy.c
new file mode 100644
index 00000000000..d1673510c62
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/s_paus.c b/gcc/f/runtime/libF77/s_paus.c
new file mode 100644
index 00000000000..1317008cb73
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_paus.c
@@ -0,0 +1,88 @@
+#include <stdio.h>
+#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 <stdlib.h>
+#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(__CYGWIN32__)
+ 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/gcc/f/runtime/libF77/s_rnge.c b/gcc/f/runtime/libF77/s_rnge.c
new file mode 100644
index 00000000000..189b5247ced
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_rnge.c
@@ -0,0 +1,26 @@
+#include <stdio.h>
+#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/gcc/f/runtime/libF77/s_stop.c b/gcc/f/runtime/libF77/s_stop.c
new file mode 100644
index 00000000000..2e3f1035b30
--- /dev/null
+++ b/gcc/f/runtime/libF77/s_stop.c
@@ -0,0 +1,37 @@
+#include <stdio.h>
+#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 <stdlib.h>
+#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<n ; ++i)
+ putc(*s++, stderr);
+ fprintf(stderr, " statement executed\n");
+ }
+#ifdef NO_ONEXIT
+f_exit();
+#endif
+exit(0);
+#ifdef __cplusplus
+return 0; /* NOT REACHED */
+}
+#endif
+}
diff --git a/gcc/f/runtime/libF77/sig_die.c b/gcc/f/runtime/libF77/sig_die.c
new file mode 100644
index 00000000000..bebb1e7b8f7
--- /dev/null
+++ b/gcc/f/runtime/libF77/sig_die.c
@@ -0,0 +1,45 @@
+#include <stdio.h>
+#include <signal.h>
+
+#ifndef SIGIOT
+#ifdef SIGABRT
+#define SIGIOT SIGABRT
+#endif
+#endif
+
+#ifdef KR_headers
+void sig_die(s, kill) register char *s; int kill;
+#else
+#include <stdlib.h>
+#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/gcc/f/runtime/libF77/signal1.h b/gcc/f/runtime/libF77/signal1.h
new file mode 100644
index 00000000000..b559211e8e4
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/signal1.h0 b/gcc/f/runtime/libF77/signal1.h0
new file mode 100644
index 00000000000..8800a18d77b
--- /dev/null
+++ b/gcc/f/runtime/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 <signal.h>
+
+#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/gcc/f/runtime/libF77/signal_.c b/gcc/f/runtime/libF77/signal_.c
new file mode 100644
index 00000000000..1ac81391aef
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/system_.c b/gcc/f/runtime/libF77/system_.c
new file mode 100644
index 00000000000..ed024a14ded
--- /dev/null
+++ b/gcc/f/runtime/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 <stdlib.h>
+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/gcc/f/runtime/libF77/z_abs.c b/gcc/f/runtime/libF77/z_abs.c
new file mode 100644
index 00000000000..7e67ad2957f
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/z_cos.c b/gcc/f/runtime/libF77/z_cos.c
new file mode 100644
index 00000000000..a811bbecc65
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libF77/z_div.c b/gcc/f/runtime/libF77/z_div.c
new file mode 100644
index 00000000000..4a987ab255a
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libF77/z_exp.c b/gcc/f/runtime/libF77/z_exp.c
new file mode 100644
index 00000000000..85fb63e4209
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libF77/z_log.c b/gcc/f/runtime/libF77/z_log.c
new file mode 100644
index 00000000000..48afca63d6d
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libF77/z_sin.c b/gcc/f/runtime/libF77/z_sin.c
new file mode 100644
index 00000000000..94456c9c30a
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libF77/z_sqrt.c b/gcc/f/runtime/libF77/z_sqrt.c
new file mode 100644
index 00000000000..f5db5651991
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+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/gcc/f/runtime/libI77/Makefile.in b/gcc/f/runtime/libI77/Makefile.in
new file mode 100644
index 00000000000..34bc5fa3997
--- /dev/null
+++ b/gcc/f/runtime/libI77/Makefile.in
@@ -0,0 +1,129 @@
+# 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. ####
+
+# The _FOR_TARGET things are appropriate for a cross-make, passed by the
+# superior makefile
+GCC_FOR_TARGET = @CC@
+CC = $(GCC_FOR_TARGET)
+CFLAGS = @CFLAGS@ $(GCC_FLAGS)
+CPPFLAGS = @CPPFLAGS@
+DEFS = @DEFS@
+CGFLAGS = -g0
+# 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../../../include $(CPPFLAGS) $(DEFS) $(CFLAGS)
+AR = @AR@
+AR_FLAGS = rc
+RANLIB = @RANLIB@
+RANLIB_TEST = @RANLIB_TEST@
+CROSS = @CROSS@
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+.c.o:
+ $(CC) -c -DSkip_f2c_Undefs -DAllow_TYQUAD $(ALL_CFLAGS) $(CGFLAGS) $<
+
+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 = ../../../include/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/gcc/f/runtime/libI77/Notice b/gcc/f/runtime/libI77/Notice
new file mode 100644
index 00000000000..261b719bc57
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/README.netlib b/gcc/f/runtime/libI77/README.netlib
new file mode 100644
index 00000000000..30dd5b5223d
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/Version.c b/gcc/f/runtime/libI77/Version.c
new file mode 100644
index 00000000000..36d4043c056
--- /dev/null
+++ b/gcc/f/runtime/libI77/Version.c
@@ -0,0 +1,272 @@
+static char junk[] = "\n@(#) LIBI77 VERSION pjw,dmg-mods 19970805\n";
+
+/*
+*/
+
+char __G77_LIBI77_VERSION__[] = "0.5.21-19970811";
+
+/*
+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. */
+/* 17 June 1997: detect recursive I/O and call f__fatal explaining it. */
+
+#include <stdio.h>
+
+void
+g77__ivers__ ()
+{
+ fprintf (stderr, "__G77_LIBI77_VERSION__: %s", __G77_LIBI77_VERSION__);
+ fputs (junk, stderr);
+}
diff --git a/gcc/f/runtime/libI77/backspace.c b/gcc/f/runtime/libI77/backspace.c
new file mode 100644
index 00000000000..8413d5f6821
--- /dev/null
+++ b/gcc/f/runtime/libI77/backspace.c
@@ -0,0 +1,101 @@
+#include <sys/types.h>
+#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, n, ndec;
+#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(int),SEEK_CUR);
+ (void) fread((char *)&n,sizeof(int),1,b->ufd);
+ (void) fseek(b->ufd,-(long)n-2*sizeof(int),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/gcc/f/runtime/libI77/close.c b/gcc/f/runtime/libI77/close.c
new file mode 100644
index 00000000000..40e15c175f4
--- /dev/null
+++ b/gcc/f/runtime/libI77/close.c
@@ -0,0 +1,99 @@
+#include "f2c.h"
+#include "fio.h"
+#ifdef KR_headers
+integer f_clos(a) cllist *a;
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#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. */
+ if (!xx.cerr) {
+ xx.cerr=1;
+ xx.csta=NULL;
+ for(i=0;i<MXUNIT;i++)
+ {
+ xx.cunit=i;
+ (void) f_clos(&xx);
+ }
+ }
+}
+ int
+#ifdef KR_headers
+G77_flush_0 ()
+#else
+G77_flush_0 (void)
+#endif
+{ int i;
+ for(i=0;i<MXUNIT;i++)
+ if(f__units[i].ufd != NULL && f__units[i].uwrt)
+ fflush(f__units[i].ufd);
+return 0;
+}
diff --git a/gcc/f/runtime/libI77/dfe.c b/gcc/f/runtime/libI77/dfe.c
new file mode 100644
index 00000000000..e229e0e3356
--- /dev/null
+++ b/gcc/f/runtime/libI77/dfe.c
@@ -0,0 +1,156 @@
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+
+y_rsk(Void)
+{
+ if(f__curunit->uend || 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__recpos<f__curunit->url)
+ (*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/gcc/f/runtime/libI77/dolio.c b/gcc/f/runtime/libI77/dolio.c
new file mode 100644
index 00000000000..4b5a2ca6588
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/due.c b/gcc/f/runtime/libI77/due.c
new file mode 100644
index 00000000000..dec58657b50
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/endfile.c b/gcc/f/runtime/libI77/endfile.c
new file mode 100644
index 00000000000..6050d1e3b30
--- /dev/null
+++ b/gcc/f/runtime/libI77/endfile.c
@@ -0,0 +1,195 @@
+#include "f2c.h"
+#include "fio.h"
+#include <sys/types.h>
+#include "rawio.h"
+
+#ifdef KR_headers
+extern char *strcpy();
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#include <string.h>
+#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/gcc/f/runtime/libI77/err.c b/gcc/f/runtime/libI77/err.c
new file mode 100644
index 00000000000..1d0188737be
--- /dev/null
+++ b/gcc/f/runtime/libI77/err.c
@@ -0,0 +1,298 @@
+#ifndef NON_UNIX_STDIO
+#include <sys/types.h>
+#include <sys/stat.h>
+#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 <stdlib.h>
+#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;
+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__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/gcc/f/runtime/libI77/f2ch.add b/gcc/f/runtime/libI77/f2ch.add
new file mode 100644
index 00000000000..a2acc17a159
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/fio.h b/gcc/f/runtime/libI77/fio.h
new file mode 100644
index 00000000000..769d360a626
--- /dev/null
+++ b/gcc/f/runtime/libI77/fio.h
@@ -0,0 +1,102 @@
+#include <stdio.h>
+#include <errno.h>
+#ifndef NULL
+/* ANSI C */
+#include <stddef.h>
+#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/gcc/f/runtime/libI77/fmt.c b/gcc/f/runtime/libI77/fmt.c
new file mode 100644
index 00000000000..a82f82153f6
--- /dev/null
+++ b/gcc/f/runtime/libI77/fmt.c
@@ -0,0 +1,516 @@
+#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*/
+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=c;
+ p->p3=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);
+ }
+ skip(s);
+ 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)];
+ *(char **)&sp->p2 = s + 1;
+ s+=n;
+ break;
+ }
+ break;
+ case GLITCH:
+ case '"':
+ case '\'':
+ sp = &f__syl[op_gen(APOS,0,0,0)];
+ *(char **)&sp->p2 = 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
+{
+ f__parenlvl=f__revloc=f__pc=0;
+ if(f_s(s,0) == NULL)
+ {
+ return(-1);
+ }
+ 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__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/gcc/f/runtime/libI77/fmt.h b/gcc/f/runtime/libI77/fmt.h
new file mode 100644
index 00000000000..509746e13b9
--- /dev/null
+++ b/gcc/f/runtime/libI77/fmt.h
@@ -0,0 +1,99 @@
+struct syl
+{ int op,p1,p2,p3;
+};
+#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 struct syl f__syl[];
+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__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/gcc/f/runtime/libI77/fmtlib.c b/gcc/f/runtime/libI77/fmtlib.c
new file mode 100644
index 00000000000..91483fc5290
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/fp.h b/gcc/f/runtime/libI77/fp.h
new file mode 100644
index 00000000000..40743d79f74
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/ftell_.c b/gcc/f/runtime/libI77/ftell_.c
new file mode 100644
index 00000000000..1bd03be325a
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/iio.c b/gcc/f/runtime/libI77/iio.c
new file mode 100644
index 00000000000..680524f6c1a
--- /dev/null
+++ b/gcc/f/runtime/libI77/iio.c
@@ -0,0 +1,147 @@
+#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)
+ return(n);
+ while(f__recpos++ < f__svic->icirlen)
+ *f__icptr++ = ' ';
+ return(n);
+}
diff --git a/gcc/f/runtime/libI77/ilnw.c b/gcc/f/runtime/libI77/ilnw.c
new file mode 100644
index 00000000000..08ea2be7831
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/inquire.c b/gcc/f/runtime/libI77/inquire.c
new file mode 100644
index 00000000000..963d4c3e5e8
--- /dev/null
+++ b/gcc/f/runtime/libI77/inquire.c
@@ -0,0 +1,108 @@
+#include "f2c.h"
+#include "fio.h"
+#include <string.h>
+#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;i<MXUNIT;i++)
+ if(f__units[i].ufd != NULL
+ && f__units[i].ufnm != NULL
+ && !strcmp(f__units[i].ufnm,buf)) {
+ p = &f__units[i];
+ break;
+ }
+#else
+ x=f__inode(buf, &n);
+ for(i=0,p=NULL;i<MXUNIT;i++)
+ if(f__units[i].uinode==x
+ && f__units[i].ufd!=NULL
+ && f__units[i].udev == n) {
+ p = &f__units[i];
+ break;
+ }
+#endif
+ }
+ else
+ {
+ byfile=0;
+ if(a->inunit<MXUNIT && a->inunit>=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/gcc/f/runtime/libI77/lio.h b/gcc/f/runtime/libI77/lio.h
new file mode 100644
index 00000000000..012317206aa
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/lread.c b/gcc/f/runtime/libI77/lread.c
new file mode 100644
index 00000000000..3f0642c24cd
--- /dev/null
+++ b/gcc/f/runtime/libI77/lread.c
@@ -0,0 +1,684 @@
+#include <ctype.h>
+#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;
+
+#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 <stdlib.h>
+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 && ++i<size) *p++ = ch;
+ if(i==size)
+ {
+ newone:
+ f__lchar= (char *)realloc(f__lchar,
+ (unsigned int)(size += BUFSIZE));
+ if(f__lchar == NULL)
+ errfl(f__elist->cierr,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(++i<size) *p++ = ch;
+ else goto newone;
+ }
+ else if(GETC(ch)==quote)
+ { if(++i<size) *p++ = ch;
+ else goto newone;
+ }
+ else
+ { (void) Ungetc(ch,f__cf);
+ *p = 0;
+ return(0);
+ }
+ }
+}
+#ifdef KR_headers
+c_le(a) cilist *a;
+#else
+c_le(cilist *a)
+#endif
+{
+ if(f__init != 1) f_init();
+ f__init = 3;
+ f__fmtbuf="list io";
+ if(a->ciunit>=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/gcc/f/runtime/libI77/lwrite.c b/gcc/f/runtime/libI77/lwrite.c
new file mode 100644
index 00000000000..5da7dfbb972
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/makefile.netlib b/gcc/f/runtime/libI77/makefile.netlib
new file mode 100644
index 00000000000..edba1fe8569
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/open.c b/gcc/f/runtime/libI77/open.c
new file mode 100644
index 00000000000..b08302b5b2c
--- /dev/null
+++ b/gcc/f/runtime/libI77/open.c
@@ -0,0 +1,245 @@
+#ifndef NON_UNIX_STDIO
+#include <sys/types.h>
+#include <sys/stat.h>
+#endif
+#include "f2c.h"
+#include "fio.h"
+#include <string.h>
+#include "rawio.h"
+
+#ifdef KR_headers
+extern char *malloc(), *mktemp();
+extern integer f_clos();
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+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/gcc/f/runtime/libI77/rawio.h b/gcc/f/runtime/libI77/rawio.h
new file mode 100644
index 00000000000..cc5cab8b7bb
--- /dev/null
+++ b/gcc/f/runtime/libI77/rawio.h
@@ -0,0 +1,45 @@
+#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);
+extern int read(int,void*,size_t), write(int,void*,size_t);
+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 <fcntl.h>
+#endif
+
+#ifndef O_WRONLY
+#define O_RDONLY 0
+#define O_WRONLY 1
+#endif
diff --git a/gcc/f/runtime/libI77/rdfmt.c b/gcc/f/runtime/libI77/rdfmt.c
new file mode 100644
index 00000000000..0d8c2b4d9ca
--- /dev/null
+++ b/gcc/f/runtime/libI77/rdfmt.c
@@ -0,0 +1,476 @@
+#include <ctype.h>
+#include "f2c.h"
+#include "fio.h"
+
+extern int f__cursor;
+#ifdef KR_headers
+extern double atof();
+#else
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#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;i++)
+ { GET(ch);
+ *p++=VAL(ch);
+ }
+ return(0);
+}
+ static int
+#ifdef KR_headers
+rd_AW(p,w,len) char *p; ftnlen len;
+#else
+rd_AW(char *p, int w, ftnlen len)
+#endif
+{ int i,ch;
+ if(w>=len)
+ { for(i=0;i<w-len;i++)
+ GET(ch);
+ for(i=0;i<len;i++)
+ { GET(ch);
+ *p++=VAL(ch);
+ }
+ return(0);
+ }
+ for(i=0;i<w;i++)
+ { GET(ch);
+ *p++=VAL(ch);
+ }
+ for(i=0;i<len-w;i++) *p++=' ';
+ return(0);
+}
+ static int
+#ifdef KR_headers
+rd_H(n,s) char *s;
+#else
+rd_H(int n, char *s)
+#endif
+{ int i,ch;
+ for(i=0;i<n;i++)
+ if((ch=(*f__getn)())<0) return(ch);
+ else *s++ = ch=='\n'?' ':ch;
+ return(1);
+}
+ static int
+#ifdef KR_headers
+rd_POS(s) char *s;
+#else
+rd_POS(char *s)
+#endif
+{ char quote;
+ int ch;
+ quote= *s++;
+ for(;*s;s++)
+ if(*s==quote && *(s+1)!=quote) break;
+ else if((ch=(*f__getn)())<0) return(ch);
+ else *s = ch=='\n'?' ':ch;
+ return(1);
+}
+#ifdef KR_headers
+rd_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
+#else
+rd_ed(struct syl *p, char *ptr, ftnlen len)
+#endif
+{ int ch;
+ for(;f__cursor>0;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,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(*(char **)&p->p2));
+ case H: return(rd_H(p->p1,*(char **)&p->p2));
+ 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/gcc/f/runtime/libI77/rewind.c b/gcc/f/runtime/libI77/rewind.c
new file mode 100644
index 00000000000..9ba4b239f32
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/rsfe.c b/gcc/f/runtime/libI77/rsfe.c
new file mode 100644
index 00000000000..02a9e6d4680
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/rsli.c b/gcc/f/runtime/libI77/rsli.c
new file mode 100644
index 00000000000..baf2ba54873
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/rsne.c b/gcc/f/runtime/libI77/rsne.c
new file mode 100644
index 00000000000..86bb2164f12
--- /dev/null
+++ b/gcc/f/runtime/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 <stdlib.h>
+#include <string.h>
+
+#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/gcc/f/runtime/libI77/sfe.c b/gcc/f/runtime/libI77/sfe.c
new file mode 100644
index 00000000000..1bb10d9052d
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/sue.c b/gcc/f/runtime/libI77/sue.c
new file mode 100644
index 00000000000..8f2ea314f30
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/typesize.c b/gcc/f/runtime/libI77/typesize.c
new file mode 100644
index 00000000000..1cb20ff2863
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/uio.c b/gcc/f/runtime/libI77/uio.c
new file mode 100644
index 00000000000..ea733cec06c
--- /dev/null
+++ b/gcc/f/runtime/libI77/uio.c
@@ -0,0 +1,69 @@
+#include "f2c.h"
+#include "fio.h"
+#include <sys/types.h>
+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/gcc/f/runtime/libI77/util.c b/gcc/f/runtime/libI77/util.c
new file mode 100644
index 00000000000..a24932533c1
--- /dev/null
+++ b/gcc/f/runtime/libI77/util.c
@@ -0,0 +1,51 @@
+#ifndef NON_UNIX_STDIO
+#include <sys/types.h>
+#include <sys/stat.h>
+#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<blen && *a!=0;i++) *b++= *a++;
+ for(;i<blen;i++) *b++=' ';
+}
+#ifndef NON_UNIX_STDIO
+#ifdef KR_headers
+long f__inode(a, dev) char *a; int *dev;
+#else
+long f__inode(char *a, int *dev)
+#endif
+{ struct stat x;
+ if(stat(a,&x)<0) return(-1);
+ *dev = x.st_dev;
+ return(x.st_ino);
+}
+#endif
diff --git a/gcc/f/runtime/libI77/wref.c b/gcc/f/runtime/libI77/wref.c
new file mode 100644
index 00000000000..a10bcaa1236
--- /dev/null
+++ b/gcc/f/runtime/libI77/wref.c
@@ -0,0 +1,276 @@
+#include "f2c.h"
+#include "fio.h"
+#ifndef VAX
+#include <ctype.h>
+#endif
+
+#ifndef KR_headers
+#undef abs
+#undef min
+#undef max
+#include <stdlib.h>
+#include <string.h>
+#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/gcc/f/runtime/libI77/wrtfmt.c b/gcc/f/runtime/libI77/wrtfmt.c
new file mode 100644
index 00000000000..e14efa85833
--- /dev/null
+++ b/gcc/f/runtime/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;i<w;i++) (*f__putn)('*');
+ else
+ { for(i=0;i<spare;i++) (*f__putn)(' ');
+ if(sign) (*f__putn)('-');
+ else if(f__cplus) (*f__putn)('+');
+ for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
+ }
+ return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base;
+#else
+wrt_IM(Uint *n, int w, int m, ftnlen len, int base)
+#endif
+{ int ndigit,sign,spare,i,xsign;
+ longint x;
+ char *ans;
+ if(sizeof(integer)==len) 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);
+ if(sign || f__cplus) xsign=1;
+ else xsign=0;
+ if(ndigit+xsign>w || m+xsign>w)
+ { for(i=0;i<w;i++) (*f__putn)('*');
+ return(0);
+ }
+ if(x==0 && m==0)
+ { for(i=0;i<w;i++) (*f__putn)(' ');
+ return(0);
+ }
+ if(ndigit>=m)
+ spare=w-ndigit-xsign;
+ else
+ spare=w-m-xsign;
+ for(i=0;i<spare;i++) (*f__putn)(' ');
+ if(sign) (*f__putn)('-');
+ else if(f__cplus) (*f__putn)('+');
+ for(i=0;i<m-ndigit;i++) (*f__putn)('0');
+ for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
+ return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_AP(s) char *s;
+#else
+wrt_AP(char *s)
+#endif
+{ char quote;
+ int i;
+
+ if(f__cursor && (i = mv_cur()))
+ return i;
+ quote = *s++;
+ for(;*s;s++)
+ { if(*s!=quote) (*f__putn)(*s);
+ else if(*++s==quote) (*f__putn)(*s);
+ else return(1);
+ }
+ return(1);
+}
+ static int
+#ifdef KR_headers
+wrt_H(a,s) char *s;
+#else
+wrt_H(int a, char *s)
+#endif
+{
+ int i;
+
+ if(f__cursor && (i = mv_cur()))
+ return i;
+ while(a--) (*f__putn)(*s++);
+ return(1);
+}
+#ifdef KR_headers
+wrt_L(n,len, sz) Uint *n; ftnlen sz;
+#else
+wrt_L(Uint *n, int len, ftnlen sz)
+#endif
+{ int i;
+ long x;
+ if(sizeof(long)==sz) x=n->il;
+ else if(sz == sizeof(char)) x = n->ic;
+ else x=n->is;
+ for(i=0;i<len-1;i++)
+ (*f__putn)(' ');
+ if(x) (*f__putn)('T');
+ else (*f__putn)('F');
+ return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_A(p,len) char *p; ftnlen len;
+#else
+wrt_A(char *p, ftnlen len)
+#endif
+{
+ while(len-- > 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;j<n;j++) (*f__putn)(' ');
+ f__scale=oldscale;
+ return(i);
+ }
+ return(wrt_E(p,w,d,e,len));
+}
+#ifdef KR_headers
+w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
+#else
+w_ed(struct syl *p, char *ptr, ftnlen len)
+#endif
+{
+ int i;
+
+ if(f__cursor && (i = mv_cur()))
+ return i;
+ switch(p->op)
+ {
+ 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,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,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,p->p3,len));
+ case G:
+ case GE:
+ return(wrt_G((ufloat *)ptr,p->p1,p->p2,p->p3,len));
+ case F: return(wrt_F((ufloat *)ptr,p->p1,p->p2,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,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(*(char **)&p->p2));
+ case H:
+ return(wrt_H(p->p1,*(char **)&p->p2));
+ }
+}
diff --git a/gcc/f/runtime/libI77/wsfe.c b/gcc/f/runtime/libI77/wsfe.c
new file mode 100644
index 00000000000..5adb1a49f08
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/wsle.c b/gcc/f/runtime/libI77/wsle.c
new file mode 100644
index 00000000000..d13f78f650b
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/wsne.c b/gcc/f/runtime/libI77/wsne.c
new file mode 100644
index 00000000000..0febd52634f
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libI77/xwsne.c b/gcc/f/runtime/libI77/xwsne.c
new file mode 100644
index 00000000000..71f6f1d5da5
--- /dev/null
+++ b/gcc/f/runtime/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 <string.h>
+
+ 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/gcc/f/runtime/libU77/COPYING.LIB b/gcc/f/runtime/libU77/COPYING.LIB
new file mode 100644
index 00000000000..eb685a5ec98
--- /dev/null
+++ b/gcc/f/runtime/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.
+
+ <one line to give the library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ 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.
+
+ <signature of Ty Coon>, 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
diff --git a/gcc/f/runtime/libU77/Makefile.in b/gcc/f/runtime/libU77/Makefile.in
new file mode 100644
index 00000000000..2e6846b23de
--- /dev/null
+++ b/gcc/f/runtime/libU77/Makefile.in
@@ -0,0 +1,155 @@
+# 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. ####
+
+# The _FOR_TARGET things are appropriate for a cross-make, passed by the
+# superior makefile
+GCC_FOR_TARGET = @CC@
+CC = $(GCC_FOR_TARGET)
+CFLAGS = @CFLAGS@ $(GCC_FLAGS)
+CPPFLAGS = @CPPFLAGS@
+DEFS = @DEFS@
+CGFLAGS = -g0
+# 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../../../include $(CPPFLAGS) $(DEFS) $(CFLAGS)
+AR = @AR@
+AR_FLAGS = rc
+RANLIB = @RANLIB@
+RANLIB_TEST = @RANLIB_TEST@
+CROSS = @CROSS@
+G77DIR = ../../../
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+.c.o:
+ $(CC) -c -DSkip_f2c_Undefs $(ALL_CFLAGS) $(CGFLAGS) $<
+
+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 system_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 system_clock_.c date_.c second_.c flush1_.c mclock_.c \
+ alarm_.c
+
+F2C_H = ../../../include/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 --driver=$(G77DIR)/xgcc -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
+system_clock_.o: system_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/gcc/f/runtime/libU77/PROJECTS b/gcc/f/runtime/libU77/PROJECTS
new file mode 100644
index 00000000000..0cf1383cbf9
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libU77/README b/gcc/f/runtime/libU77/README
new file mode 100644
index 00000000000..9033a495f1b
--- /dev/null
+++ b/gcc/f/runtime/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 <d.love@dl.ac.uk> Aug '95
+(minor changes by Craig Burley <burley@gnu.ai.mit.edu> Aug '97)
diff --git a/gcc/f/runtime/libU77/Version.c b/gcc/f/runtime/libU77/Version.c
new file mode 100644
index 00000000000..3251491815d
--- /dev/null
+++ b/gcc/f/runtime/libU77/Version.c
@@ -0,0 +1,12 @@
+static char junk[] = "\n@(#) LIBU77 VERSION 19970609\n";
+
+char __G77_LIBU77_VERSION__[] = "0.5.21-19970811";
+
+#include <stdio.h>
+
+void
+g77__uvers__ ()
+{
+ fprintf (stderr, "__G77_LIBU77_VERSION__: %s", __G77_LIBU77_VERSION__);
+ fputs (junk, stderr);
+}
diff --git a/gcc/f/runtime/libU77/access_.c b/gcc/f/runtime/libU77/access_.c
new file mode 100644
index 00000000000..1699ef065f2
--- /dev/null
+++ b/gcc/f/runtime/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 <unistd.h>
+#endif
+#if HAVE_STDLIB_H
+# include <stdlib.h>
+#else
+# include <stdio.h> /* for NULL */
+#endif
+
+#include <errno.h>
+#include <limits.h>
+#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 == NULL) return -1;
+ g_char (name, Lname, buff);
+ amode = 0;
+ for (i=0;i<Lmode;i++) {
+ switch (mode[i]) {
+ case 'r': amode |= R_OK; break;
+ case 'w': amode |= W_OK; break;
+ case 'x': amode |= X_OK; break;
+ case ' ': amode |= F_OK; break; /* as per Sun, at least */
+ default: return EINVAL;
+ }
+ }
+ i = access (buff, amode);
+ free (buff);
+ return i;
+}
diff --git a/gcc/f/runtime/libU77/acconfig.h b/gcc/f/runtime/libU77/acconfig.h
new file mode 100644
index 00000000000..12bba85b869
--- /dev/null
+++ b/gcc/f/runtime/libU77/acconfig.h
@@ -0,0 +1,2 @@
+/* Define as the path of the `chmod' program. */
+#undef CHMOD_PATH
diff --git a/gcc/f/runtime/libU77/alarm_.c b/gcc/f/runtime/libU77/alarm_.c
new file mode 100644
index 00000000000..cc869ff7898
--- /dev/null
+++ b/gcc/f/runtime/libU77/alarm_.c
@@ -0,0 +1,59 @@
+/* Copyright (C) 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 <unistd.h>
+#endif
+
+#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();
+
+int G77_alarm_0 (seconds, proc)
+ integer *seconds;
+ sig_type proc;
+#else
+#include <signal.h>
+typedef int (*sig_proc)(int);
+
+int G77_alarm_0 (integer *seconds, sig_proc proc)
+#endif
+{
+ int status;
+
+ if (signal(SIGALRM, (sig_type)proc) == SIG_ERR)
+ status = -1;
+ else
+ status = alarm (*seconds);
+ return status;
+}
diff --git a/gcc/f/runtime/libU77/bes.c b/gcc/f/runtime/libU77/bes.c
new file mode 100644
index 00000000000..c5ffdce59a3
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+
+doublereal G77_besj0_0 (const real *x) {
+ return j0 (*x);
+}
+
+doublereal G77_besj1_0 (const real *x) {
+ return j1 (*x);
+}
+
+doublereal G77_besjn_0 (const integer *n, real *x) {
+ return jn (*n, *x);
+ }
+
+doublereal G77_besy0_0 (const real *x) {
+ return y0 (*x);
+}
+
+doublereal G77_besy1_0 (const real *x) {
+ return y1 (*x);
+}
+
+doublereal G77_besyn_0 (const integer *n, real *x) {
+ return yn (*n, *x);
+}
+#endif
diff --git a/gcc/f/runtime/libU77/chdir_.c b/gcc/f/runtime/libU77/chdir_.c
new file mode 100644
index 00000000000..500be54fbe6
--- /dev/null
+++ b/gcc/f/runtime/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 <unistd.h>
+#endif
+#if HAVE_STDLIB_H
+# include <stdlib.h>
+#else
+# include <stdio.h>
+#endif
+
+#include <errno.h>
+#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 == NULL) return -1;
+ g_char (name, Lname, buff);
+ i = chdir (buff);
+ free (buff);
+ return i ? errno : 0;
+}
diff --git a/gcc/f/runtime/libU77/chmod_.c b/gcc/f/runtime/libU77/chmod_.c
new file mode 100644
index 00000000000..9797b80f3f5
--- /dev/null
+++ b/gcc/f/runtime/libU77/chmod_.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. */
+
+
+/* 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 <unistd.h>
+#endif
+#if HAVE_STDLIB_H
+# include <stdlib.h>
+#else
+# include <stdio.h> /* for NULL */
+#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 == NULL) 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/gcc/f/runtime/libU77/config.h.in b/gcc/f/runtime/libU77/config.h.in
new file mode 100644
index 00000000000..45ada20e236
--- /dev/null
+++ b/gcc/f/runtime/libU77/config.h.in
@@ -0,0 +1,73 @@
+/* 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 <sys/types.h> doesn't define. */
+#undef mode_t
+
+/* Define to `int' if <sys/types.h> doesn't define. */
+#undef pid_t
+
+/* Define to `unsigned' if <sys/types.h> 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 <sys/time.h> and <time.h>. */
+#undef TIME_WITH_SYS_TIME
+
+/* Define if your <sys/time.h> 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 <limits.h> header file. */
+#undef HAVE_LIMITS_H
+
+/* Define if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define if you have the <sys/time.h> header file. */
+#undef HAVE_SYS_TIME_H
+
+/* Define if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
diff --git a/gcc/f/runtime/libU77/configure b/gcc/f/runtime/libU77/configure
new file mode 100755
index 00000000000..63fb0e7844e
--- /dev/null
+++ b/gcc/f/runtime/libU77/configure
@@ -0,0 +1,1758 @@
+#! /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=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:529: 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:558: 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:606: 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 <<EOF
+#line 616 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:620: \"$ac_link\") 1>&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:640: 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:645: 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 <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:654: \"$ac_try\") 1>&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:669: 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:705: 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.
+ ;;
+ *)
+ 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 <<EOF
+#define CHMOD_PATH "$ac_cv_prog_chmod"
+EOF
+
+else
+ MAYBES=""
+fi
+
+if test "$ac_cv_c_cross" = yes; then
+ RANLIB=$RANLIB_FOR_TARGET
+ AR=$AR_FOR_TARGET
+
+else
+ # 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:752: 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:785: 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 <<EOF
+#line 800 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:806: \"$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 <<EOF
+#line 817 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:823: \"$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:846: 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 <<EOF
+#line 851 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:859: \"$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
+#line 876 "configure"
+#include "confdefs.h"
+#include <string.h>
+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
+#line 894 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+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 <<EOF
+#line 915 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#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:926: \"$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:951: 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 <<EOF
+#line 956 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+int main() {
+struct tm *tp;
+; return 0; }
+EOF
+if { (eval echo configure:965: \"$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
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:989: 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
+#line 994 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:999: \"$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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+echo $ac_n "checking for working const""... $ac_c" 1>&6
+echo "configure:1027: 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 <<EOF
+#line 1032 "configure"
+#include "confdefs.h"
+
+int main() {
+
+/* Ultrix mips cc rejects this. */
+typedef int charset[2]; const charset x;
+/* SunOS 4.1.1 cc rejects this. */
+char const *const *ccp;
+char **p;
+/* NEC SVR4.0.2 mips cc rejects this. */
+struct point {int x, y;};
+static struct point const zero = {0,0};
+/* AIX XL C 1.02.0.0 rejects this.
+ It does not let you subtract one const X* pointer from another in an arm
+ of an if-expression whose if-part is not a constant expression */
+const char *g = "string";
+ccp = &g + (g ? g-g : 0);
+/* HPUX 7.0 cc rejects these. */
+++ccp;
+p = (char**) ccp;
+ccp = (char const *const *) p;
+{ /* SCO 3.2v4 cc rejects this. */
+ char *t;
+ char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+ *t++ = 0;
+}
+{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
+ int x[] = {25, 17};
+ const int *foo = &x[0];
+ ++foo;
+}
+{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+ typedef const int *iptr;
+ iptr p = 0;
+ ++p;
+}
+{ /* AIX XL C 1.02.0.0 rejects this saying
+ "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+ struct s { int j; const int *ap[3]; };
+ struct s *b; b->j = 5;
+}
+{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+ const int foo = 10;
+}
+
+; return 0; }
+EOF
+if { (eval echo configure:1081: \"$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:1102: 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 <<EOF
+#line 1107 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#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:1135: 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 <<EOF
+#line 1140 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#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:1169: 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 <<EOF
+#line 1174 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#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:1202: 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 <<EOF
+#line 1207 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() {
+struct stat s; s.st_blksize;
+; return 0; }
+EOF
+if { (eval echo configure:1215: \"$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:1236: 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 <<EOF
+#line 1241 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() {
+struct stat s; s.st_blocks;
+; return 0; }
+EOF
+if { (eval echo configure:1249: \"$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:1272: 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 <<EOF
+#line 1277 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+int main() {
+struct stat s; s.st_rdev;
+; return 0; }
+EOF
+if { (eval echo configure:1285: \"$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:1306: 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 <<EOF
+#line 1311 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <time.h>
+int main() {
+struct tm *tp; tp->tm_sec;
+; return 0; }
+EOF
+if { (eval echo configure:1319: \"$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
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1344: 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 <<EOF
+#line 1349 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* 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:1372: \"$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 <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&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` 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 <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/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 config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > 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%@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 <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $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 <<EOF
+ CONFIG_HEADERS="config.h"
+EOF
+cat >> $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 <<CEOF' >> $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 <<EOF
+
+EOF
+cat >> $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/gcc/f/runtime/libU77/configure.in b/gcc/f/runtime/libU77/configure.in
new file mode 100644
index 00000000000..d50fa118e93
--- /dev/null
+++ b/gcc/f/runtime/libU77/configure.in
@@ -0,0 +1,111 @@
+# 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)
+
+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)
+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/gcc/f/runtime/libU77/ctime_.c b/gcc/f/runtime/libU77/ctime_.c
new file mode 100644
index 00000000000..af5813772af
--- /dev/null
+++ b/gcc/f/runtime/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 <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#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/gcc/f/runtime/libU77/date_.c b/gcc/f/runtime/libU77/date_.c
new file mode 100644
index 00000000000..8426edc4fb0
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libU77/dbes.c b/gcc/f/runtime/libU77/dbes.c
new file mode 100644
index 00000000000..2330b50489b
--- /dev/null
+++ b/gcc/f/runtime/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 <math.h>
+
+#if 0 /* Don't include these unless necessary -- dnp. */
+doublereal G77_dbesj0_0 (const double *x) {
+ return j0 (*x);
+}
+
+doublereal G77_dbesj1_0 (const double *x) {
+ return j1 (*x);
+}
+
+doublereal G77_dbesjn_0 (const integer *n, double *x) {
+ return jn (*n, *x);
+ }
+
+doublereal G77_dbesy0_0 (const double *x) {
+ return y0 (*x);
+}
+
+doublereal G77_dbesy1_0 (const double *x) {
+ return y1 (*x);
+}
+
+doublereal G77_dbesyn_0 (const integer *n, double *x) {
+ return yn (*n, *x);
+}
+#endif
diff --git a/gcc/f/runtime/libU77/dtime_.c b/gcc/f/runtime/libU77/dtime_.c
new file mode 100644
index 00000000000..e04ada1eca2
--- /dev/null
+++ b/gcc/f/runtime/libU77/dtime_.c
@@ -0,0 +1,82 @@
+/* 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 <unistd.h>
+#endif
+#include <sys/times.h>
+#if HAVE_GETRUSAGE
+# include <sys/time.h>
+# include <sys/resource.h>
+#endif
+#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
+doublereal G77_dtime_0 (tarray)
+ real tarray[2];
+#else
+doublereal G77_dtime_0 (real tarray[2])
+#endif
+{
+ time_t utime, stime;
+ static time_t old_utime = 0, old_stime = 0;
+ /* The getrusage version is only the default for convenience. */
+#ifdef HAVE_GETRUSAGE
+ 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 */
+ 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 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]);
+}
diff --git a/gcc/f/runtime/libU77/etime_.c b/gcc/f/runtime/libU77/etime_.c
new file mode 100644
index 00000000000..36e68133a24
--- /dev/null
+++ b/gcc/f/runtime/libU77/etime_.c
@@ -0,0 +1,78 @@
+/* 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 <unistd.h>
+#endif
+#include <sys/types.h>
+#include <sys/times.h>
+#include <sys/param.h>
+#if HAVE_GETRUSAGE
+# include <sys/time.h>
+# include <sys/resource.h>
+#endif
+#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
+doublereal G77_etime_0 (tarray)
+ real tarray[2];
+#else
+doublereal G77_etime_0 (real tarray[2])
+#endif
+{
+ /* 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 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]);
+}
diff --git a/gcc/f/runtime/libU77/fdate_.c b/gcc/f/runtime/libU77/fdate_.c
new file mode 100644
index 00000000000..afe8b24fc44
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#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/gcc/f/runtime/libU77/fgetc_.c b/gcc/f/runtime/libU77/fgetc_.c
new file mode 100644
index 00000000000..49f39830d2c
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#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/gcc/f/runtime/libU77/flush1_.c b/gcc/f/runtime/libU77/flush1_.c
new file mode 100644
index 00000000000..451915debac
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#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/gcc/f/runtime/libU77/fnum_.c b/gcc/f/runtime/libU77/fnum_.c
new file mode 100644
index 00000000000..0a3ba013e06
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libU77/fputc_.c b/gcc/f/runtime/libU77/fputc_.c
new file mode 100644
index 00000000000..5a1109e8d4f
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#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/gcc/f/runtime/libU77/fstat_.c b/gcc/f/runtime/libU77/fstat_.c
new file mode 100644
index 00000000000..da5434ad0b7
--- /dev/null
+++ b/gcc/f/runtime/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 <sys/types.h>
+#include <sys/stat.h>
+
+#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/gcc/f/runtime/libU77/gerror_.c b/gcc/f/runtime/libU77/gerror_.c
new file mode 100644
index 00000000000..6f5943c1dce
--- /dev/null
+++ b/gcc/f/runtime/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 <errno.h>
+#include <stddef.h>
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#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/gcc/f/runtime/libU77/getcwd_.c b/gcc/f/runtime/libU77/getcwd_.c
new file mode 100644
index 00000000000..e01b22c698d
--- /dev/null
+++ b/gcc/f/runtime/libU77/getcwd_.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
+#include <errno.h>
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#endif
+#include <stdio.h> /* for NULL */
+#include "f2c.h"
+
+#if HAVE_GETCWD
+
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#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<Lstr; i++)
+ str[i] = ' ';
+ return 0;
+}
+
+#elif HAVE_GETWD /* HAVE_GETCWD */
+
+/* getwd usage taken from SunOS4 man */
+
+# include <sys/param.h>
+ 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/gcc/f/runtime/libU77/getgid_.c b/gcc/f/runtime/libU77/getgid_.c
new file mode 100644
index 00000000000..02e8a4e4895
--- /dev/null
+++ b/gcc/f/runtime/libU77/getgid_.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 <unistd.h>
+#endif
+#include <sys/types.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_getgid_0 ()
+#else
+integer G77_getgid_0 (void)
+#endif
+{
+ return getgid ();
+}
diff --git a/gcc/f/runtime/libU77/getlog_.c b/gcc/f/runtime/libU77/getlog_.c
new file mode 100644
index 00000000000..a2c5f20f28b
--- /dev/null
+++ b/gcc/f/runtime/libU77/getlog_.c
@@ -0,0 +1,62 @@
+/* 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 <stdlib.h>
+#else
+# include <stdio.h>
+#endif
+#include <stdio.h>
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#endif
+#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;
+
+ p = getlogin ();
+ if (p != NULL) {
+ i = strlen (p);
+ s_copy (str, p, Lstr, i);
+ } else {
+ s_copy (str, " ", Lstr, 1);
+ }
+ return 0;
+}
diff --git a/gcc/f/runtime/libU77/getpid_.c b/gcc/f/runtime/libU77/getpid_.c
new file mode 100644
index 00000000000..fa484785957
--- /dev/null
+++ b/gcc/f/runtime/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 <unistd.h>
+#endif
+#include <sys/types.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_getpid_0 ()
+#else
+integer G77_getpid_0 (void)
+#endif
+{
+ return getpid ();
+}
diff --git a/gcc/f/runtime/libU77/getuid_.c b/gcc/f/runtime/libU77/getuid_.c
new file mode 100644
index 00000000000..421bb4c9362
--- /dev/null
+++ b/gcc/f/runtime/libU77/getuid_.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 <unistd.h>
+#endif
+#include <sys/types.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_getuid_0 ()
+#else
+integer G77_getuid_0 (void)
+#endif
+{
+ return getuid ();
+}
diff --git a/gcc/f/runtime/libU77/gmtime_.c b/gcc/f/runtime/libU77/gmtime_.c
new file mode 100644
index 00000000000..5f6f8ec6a0b
--- /dev/null
+++ b/gcc/f/runtime/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 <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# 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/gcc/f/runtime/libU77/hostnm_.c b/gcc/f/runtime/libU77/hostnm_.c
new file mode 100644
index 00000000000..2a7b590a358
--- /dev/null
+++ b/gcc/f/runtime/libU77/hostnm_.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
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#endif
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+#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/gcc/f/runtime/libU77/idate_.c b/gcc/f/runtime/libU77/idate_.c
new file mode 100644
index 00000000000..c4075767a4c
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# 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/gcc/f/runtime/libU77/ierrno_.c b/gcc/f/runtime/libU77/ierrno_.c
new file mode 100644
index 00000000000..557b53a4664
--- /dev/null
+++ b/gcc/f/runtime/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 <errno.h>
+#include "f2c.h"
+
+#ifdef KR_headers
+integer G77_ierrno_0 ()
+#else
+integer G77_ierrno_0 (void)
+#endif
+{
+ return errno;
+}
diff --git a/gcc/f/runtime/libU77/irand_.c b/gcc/f/runtime/libU77/irand_.c
new file mode 100644
index 00000000000..2bf14ccee26
--- /dev/null
+++ b/gcc/f/runtime/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 <stdlib.h>
+#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/gcc/f/runtime/libU77/isatty_.c b/gcc/f/runtime/libU77/isatty_.c
new file mode 100644
index 00000000000..92c33468f53
--- /dev/null
+++ b/gcc/f/runtime/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 <unistd.h>
+#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/gcc/f/runtime/libU77/itime_.c b/gcc/f/runtime/libU77/itime_.c
new file mode 100644
index 00000000000..50378d54426
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# 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/gcc/f/runtime/libU77/kill_.c b/gcc/f/runtime/libU77/kill_.c
new file mode 100644
index 00000000000..32afddf1e46
--- /dev/null
+++ b/gcc/f/runtime/libU77/kill_.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
+#include <sys/types.h>
+#include <signal.h>
+#include <errno.h>
+#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
+{
+ return kill ((pid_t) *pid, *signum) ? errno : 0;
+}
diff --git a/gcc/f/runtime/libU77/link_.c b/gcc/f/runtime/libU77/link_.c
new file mode 100644
index 00000000000..6892dcb7694
--- /dev/null
+++ b/gcc/f/runtime/libU77/link_.c
@@ -0,0 +1,58 @@
+/* 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 <stdlib.h>
+#else
+# include <stdio.h>
+#endif
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+#include <errno.h>
+#include <sys/param.h>
+#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
+{
+ 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;
+}
diff --git a/gcc/f/runtime/libU77/lnblnk_.c b/gcc/f/runtime/libU77/lnblnk_.c
new file mode 100644
index 00000000000..806eca293f1
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libU77/lstat_.c b/gcc/f/runtime/libU77/lstat_.c
new file mode 100644
index 00000000000..17f0c1a6b3a
--- /dev/null
+++ b/gcc/f/runtime/libU77/lstat_.c
@@ -0,0 +1,86 @@
+/* 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 <stdio.h>
+#if HAVE_STDLIB_H
+# include <stdlib.h>
+#endif
+#include <sys/types.h>
+#include <sys/stat.h>
+#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/gcc/f/runtime/libU77/ltime_.c b/gcc/f/runtime/libU77/ltime_.c
new file mode 100644
index 00000000000..151ac6c9b55
--- /dev/null
+++ b/gcc/f/runtime/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 <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# 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/gcc/f/runtime/libU77/mclock_.c b/gcc/f/runtime/libU77/mclock_.c
new file mode 100644
index 00000000000..6b7e81b1e04
--- /dev/null
+++ b/gcc/f/runtime/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 <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# 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/gcc/f/runtime/libU77/perror_.c b/gcc/f/runtime/libU77/perror_.c
new file mode 100644
index 00000000000..26d8582dbcc
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#include <errno.h>
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#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<blast && *str!='\0' ; )
+ *bp++ = *str++;
+ *bp = '\0';
+ perror (buff);
+ return 0;
+}
diff --git a/gcc/f/runtime/libU77/rand_.c b/gcc/f/runtime/libU77/rand_.c
new file mode 100644
index 00000000000..1c533a39fdd
--- /dev/null
+++ b/gcc/f/runtime/libU77/rand_.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
+#if HAVE_STDLIB_H
+# include <stdlib.h>
+#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
+doublereal G77_rand_0 (flag)
+ integer *flag;
+#else
+doublereal 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/gcc/f/runtime/libU77/rename_.c b/gcc/f/runtime/libU77/rename_.c
new file mode 100644
index 00000000000..e8a4bf6523c
--- /dev/null
+++ b/gcc/f/runtime/libU77/rename_.c
@@ -0,0 +1,53 @@
+/* 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 <stdlib.h>
+#endif
+#include <stdio.h>
+#include <errno.h>
+#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/gcc/f/runtime/libU77/secnds_.c b/gcc/f/runtime/libU77/secnds_.c
new file mode 100644
index 00000000000..64eb76e2fb9
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+#include <sys/types.h>
+
+#include "f2c.h"
+
+/* This is a VMS intrinsic. */
+
+doublereal 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/gcc/f/runtime/libU77/second_.c b/gcc/f/runtime/libU77/second_.c
new file mode 100644
index 00000000000..a984cf9e3d2
--- /dev/null
+++ b/gcc/f/runtime/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"
+
+doublereal G77_second_0 () {
+ extern doublereal G77_etime_0 ();
+ real tarray[2];
+
+ return G77_etime_0 (tarray);
+}
diff --git a/gcc/f/runtime/libU77/sleep_.c b/gcc/f/runtime/libU77/sleep_.c
new file mode 100644
index 00000000000..36e1b8d9a7b
--- /dev/null
+++ b/gcc/f/runtime/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 <unistd.h>
+#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/gcc/f/runtime/libU77/srand_.c b/gcc/f/runtime/libU77/srand_.c
new file mode 100644
index 00000000000..8edc62e4fe0
--- /dev/null
+++ b/gcc/f/runtime/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 <stdlib.h>
+#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/gcc/f/runtime/libU77/stat_.c b/gcc/f/runtime/libU77/stat_.c
new file mode 100644
index 00000000000..b24f3892221
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#if HAVE_STDLIB_H
+# include <stdlib.h>
+#endif
+#include <sys/types.h>
+#include <sys/stat.h>
+#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/gcc/f/runtime/libU77/symlnk_.c b/gcc/f/runtime/libU77/symlnk_.c
new file mode 100644
index 00000000000..d15e4528758
--- /dev/null
+++ b/gcc/f/runtime/libU77/symlnk_.c
@@ -0,0 +1,62 @@
+/* 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 <stdlib.h>
+#else
+# include <stdio.h>
+#endif
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+#include <errno.h>
+#include <sys/param.h>
+#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/gcc/f/runtime/libU77/system_clock_.c b/gcc/f/runtime/libU77/system_clock_.c
new file mode 100644
index 00000000000..d5cbaac0608
--- /dev/null
+++ b/gcc/f/runtime/libU77/system_clock_.c
@@ -0,0 +1,64 @@
+/* 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 <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+#include <sys/times.h>
+#include <limits.h>
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+#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
+{
+ 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;
+#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;
+}
diff --git a/gcc/f/runtime/libU77/time_.c b/gcc/f/runtime/libU77/time_.c
new file mode 100644
index 00000000000..73894b0b413
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# 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/gcc/f/runtime/libU77/ttynam_.c b/gcc/f/runtime/libU77/ttynam_.c
new file mode 100644
index 00000000000..f69aa43f564
--- /dev/null
+++ b/gcc/f/runtime/libU77/ttynam_.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 STDC_HEADERS
+# include <stdlib.h>
+#endif
+#if HAVE_UNISTD_H
+# include <unistd.h> /* POSIX for ttyname */
+#endif
+#include <stdio.h>
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#endif
+#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
+{
+ 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);
+ }
+}
diff --git a/gcc/f/runtime/libU77/u77-test.f b/gcc/f/runtime/libU77/u77-test.f
new file mode 100644
index 00000000000..11c5ecae449
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/libU77/umask_.c b/gcc/f/runtime/libU77/umask_.c
new file mode 100644
index 00000000000..203acfa916f
--- /dev/null
+++ b/gcc/f/runtime/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 <sys/types.h>
+#include <sys/stat.h>
+#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/gcc/f/runtime/libU77/unlink_.c b/gcc/f/runtime/libU77/unlink_.c
new file mode 100644
index 00000000000..5e7edf213bc
--- /dev/null
+++ b/gcc/f/runtime/libU77/unlink_.c
@@ -0,0 +1,55 @@
+/* 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 <stdlib.h>
+#else
+# include <stdio.h>
+#endif
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+#include <errno.h>
+#include <sys/param.h>
+#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/gcc/f/runtime/libU77/vxtidate_.c b/gcc/f/runtime/libU77/vxtidate_.c
new file mode 100644
index 00000000000..c517f29419e
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# 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/gcc/f/runtime/libU77/vxttime_.c b/gcc/f/runtime/libU77/vxttime_.c
new file mode 100644
index 00000000000..054bb45a89a
--- /dev/null
+++ b/gcc/f/runtime/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 <stdio.h>
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+#if HAVE_STRING_H
+# include <string.h>
+#else
+# include <strings.h>
+#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/gcc/f/runtime/permission.netlib b/gcc/f/runtime/permission.netlib
new file mode 100644
index 00000000000..261b719bc57
--- /dev/null
+++ b/gcc/f/runtime/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/gcc/f/runtime/readme.netlib b/gcc/f/runtime/readme.netlib
new file mode 100644
index 00000000000..22efbfe801e
--- /dev/null
+++ b/gcc/f/runtime/readme.netlib
@@ -0,0 +1,585 @@
+
+====== 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.
+
+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
diff --git a/gcc/f/src.c b/gcc/f/src.c
new file mode 100644
index 00000000000..095c0481af9
--- /dev/null
+++ b/gcc/f/src.c
@@ -0,0 +1,436 @@
+/* src.c -- Implementation File
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+
+ Description:
+ Source-file functions to handle various combinations of case sensitivity
+ and insensitivity at run time.
+
+ Modifications:
+*/
+
+#include "proj.h"
+#include <ctype.h>
+#include "src.h"
+#include "top.h"
+
+/* This array does a toupper (), but any valid char type is valid as an
+ index and returns identity if not a lower-case character. */
+
+char ffesrc_toupper_[256];
+
+/* This array does a tolower (), but any valid char type is valid as an
+ index and returns identity if not an upper-case character. */
+
+char ffesrc_tolower_[256];
+
+/* This array is set up so that, given a source-mapped character, the result
+ of indexing into this array will match an upper-cased character depending
+ on the source-mapped character's case and the established ffe_case_match()
+ setting. So the uppercase cells contain identies (e.g. ['A'] == 'A')
+ as long as uppercase matching is permitted (!FFE_caseLOWER) and the
+ lowercase cells contain uppercased identities (e.g. ['a'] == 'A') as long
+ as lowercase matching is permitted (!FFE_caseUPPER). Else the case
+ cells contain -1. _init_ is for the first character of a keyword,
+ and _noninit_ is for other characters. */
+
+char ffesrc_char_match_init_[256];
+char ffesrc_char_match_noninit_[256];
+
+/* This array is used to map input source according to the established
+ ffe_case_source() setting: for FFE_caseNONE, the array is all
+ identities; for FFE_caseUPPER, the lowercase cells contain
+ uppercased identities; and vice versa for FFE_caseLOWER. */
+
+char ffesrc_char_source_[256];
+
+/* This array is used to map an internally generated character so that it
+ will be accepted as an initial character in a keyword. The assumption
+ is that the incoming character is uppercase. */
+
+char ffesrc_char_internal_init_[256];
+
+/* This array is used to determine if a particular character is valid in
+ a symbol name according to the established ffe_case_symbol() setting:
+ for FFE_caseNONE, the array is all FFEBAD; for FFE_caseUPPER, the
+ lowercase cells contain a non-FFEBAD error code (FFEBAD_SYMBOL_UPPER_CASE);
+ and vice versa for FFE_caseLOWER. _init_ and _noninit_ distinguish
+ between initial and subsequent characters for the caseINITCAP case,
+ and their error codes are different for appropriate messages --
+ specifically, _noninit_ contains a non-FFEBAD error code for all
+ except lowercase characters for the caseINITCAP case.
+
+ See ffesrc_check_symbol_, it must be TRUE if this array is not all
+ FFEBAD. */
+
+ffebad ffesrc_bad_symbol_init_[256];
+ffebad ffesrc_bad_symbol_noninit_[256];
+
+/* Set TRUE if any element in ffesrc_bad_symbol (with an index representing
+ a character that can also be in the text of a token passed to
+ ffename_find, strictly speaking) is not FFEBAD. I.e., TRUE if it is
+ necessary to check token characters against the ffesrc_bad_symbol_
+ array. */
+
+bool ffesrc_check_symbol_;
+
+/* These are set TRUE if the kind of character (upper/lower) is ok as a match
+ in the context (initial/noninitial character of keyword). */
+
+bool ffesrc_ok_match_init_upper_;
+bool ffesrc_ok_match_init_lower_;
+bool ffesrc_ok_match_noninit_upper_;
+bool ffesrc_ok_match_noninit_lower_;
+
+/* Initialize table of alphabetic matches. */
+
+void
+ffesrc_init_1 ()
+{
+ int i;
+
+ for (i = 0; i < 256; ++i)
+ {
+ ffesrc_char_match_init_[i] = i;
+ ffesrc_char_match_noninit_[i] = i;
+ ffesrc_char_source_[i] = i;
+ ffesrc_char_internal_init_[i] = i;
+ ffesrc_toupper_[i] = i;
+ ffesrc_tolower_[i] = i;
+ ffesrc_bad_symbol_init_[i] = FFEBAD;
+ ffesrc_bad_symbol_noninit_[i] = FFEBAD;
+ }
+
+ for (i = 'A'; i <= 'Z'; ++i)
+ ffesrc_tolower_[i] = tolower (i);
+
+ for (i = 'a'; i <= 'z'; ++i)
+ ffesrc_toupper_[i] = toupper (i);
+
+ ffesrc_check_symbol_ = (ffe_case_symbol () != FFE_caseNONE);
+
+ ffesrc_ok_match_init_upper_ = (ffe_case_match () != FFE_caseLOWER);
+ ffesrc_ok_match_init_lower_ = (ffe_case_match () != FFE_caseUPPER)
+ && (ffe_case_match () != FFE_caseINITCAP);
+ ffesrc_ok_match_noninit_upper_ = (ffe_case_match () != FFE_caseLOWER)
+ && (ffe_case_match () != FFE_caseINITCAP);
+ ffesrc_ok_match_noninit_lower_ = (ffe_case_match () != FFE_caseUPPER);
+
+ /* Note that '-' is used to flag an invalid match character. '-' is
+ somewhat arbitrary, actually. -1 was used, but that's not wise on a
+ system with unsigned chars as default -- it'd turn into 255 or some such
+ large positive number, which would sort higher than the alphabetics and
+ thus possibly cause problems. So '-' is picked just because it's never
+ likely to be a symbol character in Fortran and because it's "less than"
+ any alphabetic character. EBCDIC might see things differently, I don't
+ remember it well enough, but that's just tough -- lots of other things
+ might have to change to support EBCDIC -- anyway, some other character
+ could easily be picked. */
+
+#define FFESRC_INVALID_SYMBOL_CHAR_ '-'
+
+ if (!ffesrc_ok_match_init_upper_)
+ for (i = 'A'; i <= 'Z'; ++i)
+ ffesrc_char_match_init_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
+
+ if (ffesrc_ok_match_init_lower_)
+ for (i = 'a'; i <= 'z'; ++i)
+ ffesrc_char_match_init_[i] = toupper (i);
+ else
+ for (i = 'a'; i <= 'z'; ++i)
+ ffesrc_char_match_init_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
+
+ if (!ffesrc_ok_match_noninit_upper_)
+ for (i = 'A'; i <= 'Z'; ++i)
+ ffesrc_char_match_noninit_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
+
+ if (ffesrc_ok_match_noninit_lower_)
+ for (i = 'a'; i <= 'z'; ++i)
+ ffesrc_char_match_noninit_[i] = toupper (i);
+ else
+ for (i = 'a'; i <= 'z'; ++i)
+ ffesrc_char_match_noninit_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
+
+ if (ffe_case_source () == FFE_caseLOWER)
+ for (i = 'A'; i <= 'Z'; ++i)
+ ffesrc_char_source_[i] = tolower (i);
+ else if (ffe_case_source () == FFE_caseUPPER)
+ for (i = 'a'; i <= 'z'; ++i)
+ ffesrc_char_source_[i] = toupper (i);
+
+ if (ffe_case_match () == FFE_caseLOWER)
+ for (i = 'A'; i <= 'Z'; ++i)
+ ffesrc_char_internal_init_[i] = tolower (i);
+
+ switch (ffe_case_symbol ())
+ {
+ case FFE_caseLOWER:
+ for (i = 'A'; i <= 'Z'; ++i)
+ {
+ ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_UPPER_CASE;
+ ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_UPPER_CASE;
+ }
+ break;
+
+ case FFE_caseUPPER:
+ for (i = 'a'; i <= 'z'; ++i)
+ {
+ ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_LOWER_CASE;
+ ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_LOWER_CASE;
+ }
+ break;
+
+ case FFE_caseINITCAP:
+ for (i = 0; i < 256; ++i)
+ ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_NOLOWER_INITCAP;
+ for (i = 'a'; i <= 'z'; ++i)
+ {
+ ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_LOWER_INITCAP;
+ ffesrc_bad_symbol_noninit_[i] = FFEBAD;
+ }
+ break;
+
+ default:
+ break;
+ }
+}
+
+/* Compare two strings a la strcmp, the first being a source string with its
+ length passed, and the second being a constant string passed
+ in InitialCaps form. Also, the return value is always -1, 0, or 1. */
+
+int
+ffesrc_strcmp_1ns2i (ffeCase mcase, const char *var, int len,
+ const char *str_ic)
+{
+ char c;
+ char d;
+
+ switch (mcase)
+ {
+ case FFE_caseNONE:
+ for (; len > 0; --len, ++var, ++str_ic)
+ {
+ c = ffesrc_char_source (*var); /* Transform source. */
+ c = ffesrc_toupper (c); /* Upcase source. */
+ d = ffesrc_toupper (*str_ic); /* Upcase InitialCaps char. */
+ if (c != d)
+ if ((d != '\0') && (c < d))
+ return -1;
+ else
+ return 1;
+ }
+ break;
+
+ case FFE_caseUPPER:
+ for (; len > 0; --len, ++var, ++str_ic)
+ {
+ c = ffesrc_char_source (*var); /* Transform source. */
+ d = ffesrc_toupper (*str_ic); /* Transform InitialCaps char. */
+ if (c != d)
+ if ((d != '\0') && (c < d))
+ return -1;
+ else
+ return 1;
+ }
+ break;
+
+ case FFE_caseLOWER:
+ for (; len > 0; --len, ++var, ++str_ic)
+ {
+ c = ffesrc_char_source (*var); /* Transform source. */
+ d = ffesrc_tolower (*str_ic); /* Transform InitialCaps char. */
+ if (c != d)
+ if ((d != '\0') && (c < d))
+ return -1;
+ else
+ return 1;
+ }
+ break;
+
+ case FFE_caseINITCAP:
+ for (; len > 0; --len, ++var, ++str_ic)
+ {
+ c = ffesrc_char_source (*var); /* Transform source. */
+ d = *str_ic; /* No transform of InitialCaps char. */
+ if (c != d)
+ {
+ c = ffesrc_toupper (c);
+ d = ffesrc_toupper (d);
+ while ((len > 0) && (c == d))
+ { /* Skip past equivalent (case-ins) chars. */
+ --len, ++var, ++str_ic;
+ if (len > 0)
+ c = ffesrc_toupper (*var);
+ d = ffesrc_toupper (*str_ic);
+ }
+ if ((d != '\0') && (c < d))
+ return -1;
+ else
+ return 1;
+ }
+ }
+ break;
+
+ default:
+ assert ("bad case value" == NULL);
+ return -1;
+ }
+
+ if (*str_ic == '\0')
+ return 0;
+ return -1;
+}
+
+/* Compare two strings a la strcmp, the second being a constant string passed
+ in both uppercase and lowercase form. If not equal, the uppercase string
+ is used to determine the sign of the return value. Also, the return
+ value is always -1, 0, or 1. */
+
+int
+ffesrc_strcmp_2c (ffeCase mcase, const char *var, const char *str_uc,
+ const char *str_lc, const char *str_ic)
+{
+ int i;
+ char c;
+
+ switch (mcase)
+ {
+ case FFE_caseNONE:
+ for (; *var != '\0'; ++var, ++str_uc)
+ {
+ c = ffesrc_toupper (*var); /* Upcase source. */
+ if (c != *str_uc)
+ if ((*str_uc != '\0') && (c < *str_uc))
+ return -1;
+ else
+ return 1;
+ }
+ if (*str_uc == '\0')
+ return 0;
+ return -1;
+
+ case FFE_caseUPPER:
+ i = strcmp (var, str_uc);
+ break;
+
+ case FFE_caseLOWER:
+ i = strcmp (var, str_lc);
+ break;
+
+ case FFE_caseINITCAP:
+ for (; *var != '\0'; ++var, ++str_ic, ++str_uc)
+ {
+ if (*var != *str_ic)
+ {
+ c = ffesrc_toupper (*var);
+ while ((c != '\0') && (c == *str_uc))
+ { /* Skip past equivalent (case-ins) chars. */
+ ++var, ++str_uc;
+ c = ffesrc_toupper (*var);
+ }
+ if ((*str_uc != '\0') && (c < *str_uc))
+ return -1;
+ else
+ return 1;
+ }
+ }
+ if (*str_ic == '\0')
+ return 0;
+ return -1;
+
+ default:
+ assert ("bad case value" == NULL);
+ return -1;
+ }
+
+ if (i == 0)
+ return 0;
+ else if (i < 0)
+ return -1;
+ return 1;
+}
+
+/* Compare two strings a la strncmp, the second being a constant string passed
+ in uppercase, lowercase, and InitialCaps form. If not equal, the
+ uppercase string is used to determine the sign of the return value. */
+
+int
+ffesrc_strncmp_2c (ffeCase mcase, const char *var, const char *str_uc,
+ const char *str_lc, const char *str_ic, int len)
+{
+ int i;
+ char c;
+
+ switch (mcase)
+ {
+ case FFE_caseNONE:
+ for (; len > 0; ++var, ++str_uc, --len)
+ {
+ c = ffesrc_toupper (*var); /* Upcase source. */
+ if (c != *str_uc)
+ if (c < *str_uc)
+ return -1;
+ else
+ return 1;
+ }
+ return 0;
+
+ case FFE_caseUPPER:
+ i = strncmp (var, str_uc, len);
+ break;
+
+ case FFE_caseLOWER:
+ i = strncmp (var, str_lc, len);
+ break;
+
+ case FFE_caseINITCAP:
+ for (; len > 0; ++var, ++str_ic, ++str_uc, --len)
+ {
+ if (*var != *str_ic)
+ {
+ c = ffesrc_toupper (*var);
+ while ((len > 0) && (c == *str_uc))
+ { /* Skip past equivalent (case-ins) chars. */
+ --len, ++var, ++str_uc;
+ if (len > 0)
+ c = ffesrc_toupper (*var);
+ }
+ if ((len > 0) && (c < *str_uc))
+ return -1;
+ else
+ return 1;
+ }
+ }
+ return 0;
+
+ default:
+ assert ("bad case value" == NULL);
+ return -1;
+ }
+
+ if (i == 0)
+ return 0;
+ else if (i < 0)
+ return -1;
+ return 1;
+}
diff --git a/gcc/f/src.h b/gcc/f/src.h
new file mode 100644
index 00000000000..02279154d28
--- /dev/null
+++ b/gcc/f/src.h
@@ -0,0 +1,144 @@
+/* src.h -- Public #include File
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ src.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_src
+#define _H_f_src
+
+#include "bad.h"
+#include "top.h"
+
+extern char ffesrc_toupper_[256];
+extern char ffesrc_tolower_[256];
+extern char ffesrc_char_match_init_[256];
+extern char ffesrc_char_match_noninit_[256];
+extern char ffesrc_char_source_[256];
+extern char ffesrc_char_internal_init_[256];
+extern ffebad ffesrc_bad_symbol_init_[256];
+extern ffebad ffesrc_bad_symbol_noninit_[256];
+extern bool ffesrc_check_symbol_;
+extern bool ffesrc_ok_match_init_upper_;
+extern bool ffesrc_ok_match_init_lower_;
+extern bool ffesrc_ok_match_noninit_upper_;
+extern bool ffesrc_ok_match_noninit_lower_;
+
+/* These C-language-syntax modifiers could avoid the match arg if gcc's
+ extension allowing macros to generate dynamic labels was used. They
+ could use the no_match arg (and the "caller's" label defs) if there
+ was a way to say "goto default" in a switch statement. Oh well.
+
+ NOTE: These macro assume "case FFESRC_CASE_MATCH_[NON]INIT(...):" is used
+ to invoke them, and thus assume the "above" case does not fall through to
+ this one. This syntax was chosen to keep indenting tools working. */
+
+#define FFESRC_CASE_MATCH_INIT(upper, lower, match, no_match) \
+ upper: if (!ffesrc_ok_match_init_upper_) goto no_match; \
+ else goto match; \
+ case lower: if (!ffesrc_ok_match_init_lower_) goto no_match; \
+ match
+
+#define FFESRC_CASE_MATCH_NONINIT(upper, lower, match, no_match) \
+ upper: if (!ffesrc_ok_match_noninit_upper_) goto no_match; \
+ else goto match; \
+ case lower: if (!ffesrc_ok_match_noninit_lower_) goto no_match; \
+ match
+
+/* If character is ok in a symbol name (not including intrinsic names),
+ returns FFEBAD, else returns something else, type ffebad. */
+
+#define ffesrc_bad_char_symbol_init(c) \
+ (ffesrc_bad_symbol_init_[(unsigned int) (c)])
+#define ffesrc_bad_char_symbol_noninit(c) \
+ (ffesrc_bad_symbol_noninit_[(unsigned int) (c)])
+
+/* Returns TRUE if character is ok in a symbol name (including
+ intrinsic names). Doesn't care about case settings, this is
+ used just for parsing (before semantic complaints about symbol-
+ name casing and such). One specific usage is to decide whether
+ an underscore is valid as the first or subsequent character in
+ some symbol name -- if not, an underscore is a separate token
+ (while lexing, for example). Note that ffesrc_is_name_init
+ must return TRUE for a (not necessarily proper) subset of
+ characters for which ffelex_is_firstnamechar returns TRUE. */
+
+#define ffesrc_is_name_init(c) \
+ ((isalpha ((c))) || (!(1 || ffe_is_90 ()) && ((c) == '_')))
+#define ffesrc_is_name_noninit(c) \
+ ((isalnum ((c))) || (!(1 || ffe_is_90 ()) && ((c) == '_')))
+
+/* Test if source-translated character matches given alphabetic character
+ (passed in both uppercase and lowercase, to allow for custom speedup
+ of compilation in environments where compile-time options aren't needed
+ for casing). */
+
+#define ffesrc_char_match_init(c, up, low) \
+ (ffesrc_char_match_init_[(unsigned int) (c)] == up)
+
+#define ffesrc_char_match_noninit(c, up, low) \
+ (ffesrc_char_match_noninit_[(unsigned int) (c)] == up)
+
+/* Translate character from input-file form to source form. */
+
+#define ffesrc_char_source(c) (ffesrc_char_source_[(unsigned int) (c)])
+
+/* Translate internal character (upper/lower) to source form in an
+ initial-character context (i.e. ffesrc_char_match_init of the result
+ will always succeed). */
+
+#define ffesrc_char_internal_init(up, low) \
+ (ffesrc_char_internal_init_[(unsigned int) (up)])
+
+/* Returns TRUE if a name representing a symbol should be checked for
+ validity according to compile-time options. That is, if it is possible
+ that ffesrc_bad_char_symbol(c) can return something other than FFEBAD
+ for any valid character in an ffelex NAME(S) token. */
+
+#define ffesrc_check_symbol() ffesrc_check_symbol_
+
+#define ffesrc_init_0()
+void ffesrc_init_1 (void);
+#define ffesrc_init_2()
+#define ffesrc_init_3()
+#define ffesrc_init_4()
+int ffesrc_strcmp_1ns2i (ffeCase mcase, const char *var, int len,
+ const char *str_ic);
+int ffesrc_strcmp_2c (ffeCase mcase, const char *var, const char *str_uc,
+ const char *str_lc, const char *str_ic);
+int ffesrc_strncmp_2c (ffeCase mcase, const char *var, const char *str_uc,
+ const char *str_lc, const char *str_ic, int len);
+#define ffesrc_terminate_0()
+#define ffesrc_terminate_1()
+#define ffesrc_terminate_2()
+#define ffesrc_terminate_3()
+#define ffesrc_terminate_4()
+#define ffesrc_toupper(c) (ffesrc_toupper_[(unsigned int) (c)])
+#define ffesrc_tolower(c) (ffesrc_tolower_[(unsigned int) (c)])
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/st.c b/gcc/f/st.c
new file mode 100644
index 00000000000..5406acdb5a7
--- /dev/null
+++ b/gcc/f/st.c
@@ -0,0 +1,554 @@
+/* st.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ The high-level input level to statement handling for the rest of the
+ FFE. ffest_first is the first state for the lexer to invoke to start
+ a statement. A statement normally starts with a NUMBER token (to indicate
+ a label def) followed by a NAME token (to indicate what kind of statement
+ it is), though of course the NUMBER token may be omitted. ffest_first
+ gathers the first NAME token and returns a state of ffest_second_,
+ where the trailing underscore means "internal to ffest" and thus outside
+ users should not depend on this. ffest_second_ then looks at the second
+ token in conjunction with the first, decides what possible statements are
+ meant, and tries each possible statement in turn, from most likely to
+ least likely. A successful attempt currently is recorded, and further
+ successful attempts by other possibilities raise an assertion error in
+ ffest_confirmed (this is to detect ambiguities). A failure in an
+ attempt is signaled by calling ffest_ffebad_start; this results in the
+ next token sent by ffest_save_ (the intermediary when more than one
+ possible statement exists) being EOS to shut down processing and the next
+ possibility tried.
+
+ When all possibilities have been tried, the successful one is retried with
+ inhibition turned off (FALSE) as reported by ffest_is_inhibited(). If
+ there is no successful one, the first one is retried so the user gets to
+ see the error messages.
+
+ In the future, after syntactic bugs have been reasonably shaken out and
+ ambiguities thus detected, the first successful possibility will be
+ enabled (inhibited goes FALSE) as soon as it confirms success by calling
+ ffest_confirmed, thus retrying the possibility will not be necessary.
+
+ The only complication in all this is that expression handling is
+ happening while possibilities are inhibited. It is up to the expression
+ handler, conceptually, to not make any changes to its knowledge base for
+ variable names and so on when inhibited that cannot be undone if
+ the current possibility fails (shuts down via ffest_ffebad_start). In
+ fact, this business is handled not be ffeexpr, but by lower levels.
+
+ ffesta functions serve only to provide information used in syntactic
+ processing of possible statements, and thus may not make changes to the
+ knowledge base for variables and such.
+
+ ffestb functions perform the syntactic analysis for possible statements,
+ and thus again may not make changes to the knowledge base except under the
+ auspices of ffeexpr and its subordinates, changes which can be undone when
+ necessary.
+
+ ffestc functions perform the semantic analysis for the chosen statement,
+ and thus may change the knowledge base as necessary since they are invoked
+ by ffestb functions only after a given statement is confirmed and
+ enabled. Note, however, that a few ffestc functions (identified by
+ their statement names rather than grammar numbers) indicate valid forms
+ that are, outside of any context, ambiguous, such as ELSE WHERE and
+ PRIVATE; these functions should make a quick decision as to what is
+ intended and dispatch to the appropriate specific ffestc function.
+
+ ffestd functions actually implement statements. When called, the
+ statement is considered valid and is either an executable statement or
+ a nonexecutable statement with direct-output results. For example, CALL,
+ GOTO, and assignment statements pass through ffestd because they are
+ executable; DATA statements pass through because they map directly to the
+ output file (or at least might so map); ENTRY statements also pass through
+ because they essentially affect code generation in an immediate way;
+ whereas INTEGER, SAVE, and SUBROUTINE statements do not go through
+ ffestd functions because they merely update the knowledge base.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "st.h"
+#include "bad.h"
+#include "lex.h"
+#include "sta.h"
+#include "stb.h"
+#include "stc.h"
+#include "std.h"
+#include "ste.h"
+#include "stp.h"
+#include "str.h"
+#include "sts.h"
+#include "stt.h"
+#include "stu.h"
+#include "stv.h"
+#include "stw.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffest_confirmed -- Confirm current possibility as only one
+
+ ffest_confirmed();
+
+ Sets the confirmation flag. During debugging for ambiguous constructs,
+ asserts that the confirmation flag for a previous possibility has not
+ yet been set. */
+
+void
+ffest_confirmed ()
+{
+ ffesta_confirmed ();
+}
+
+/* ffest_eof -- End of (non-INCLUDEd) source file
+
+ ffest_eof();
+
+ Call after piping tokens through ffest_first, where the most recent
+ token sent through must be EOS.
+
+ 20-Feb-91 JCB 1.1
+ Put new EOF token in ffesta_tokens[0], not NULL, because too much
+ code expects something there for error reporting and the like. Also,
+ do basically the same things ffest_second and ffesta_zero do for
+ processing a statement (make and destroy pools, et cetera). */
+
+void
+ffest_eof ()
+{
+ ffesta_eof ();
+}
+
+/* ffest_ffebad_here_current_stmt -- ffebad_here with ptr to current stmt
+
+ ffest_ffebad_here_current_stmt(0);
+
+ Outsiders can call this fn if they have no more convenient place to
+ point to (via a token or pair of ffewhere objects) and they know a
+ current, useful statement is being evaluted by ffest (i.e. they are
+ being called from ffestb, ffestc, ffestd, ... functions). */
+
+void
+ffest_ffebad_here_current_stmt (ffebadIndex i)
+{
+ ffesta_ffebad_here_current_stmt (i);
+}
+
+/* ffest_ffebad_here_doiter -- Calls ffebad_here with ptr to DO iter var
+
+ ffesymbol s;
+ // call ffebad_start first, of course.
+ ffest_ffebad_here_doiter(0,s);
+ // call ffebad_finish afterwards, naturally.
+
+ Searches the stack of blocks backwards for a DO loop that has s
+ as its iteration variable, then calls ffebad_here with pointers to
+ that particular reference to the variable. Crashes if the DO loop
+ can't be found. */
+
+void
+ffest_ffebad_here_doiter (ffebadIndex i, ffesymbol s)
+{
+ ffestc_ffebad_here_doiter (i, s);
+}
+
+/* ffest_ffebad_start -- Start a possibly inhibited error report
+
+ if (ffest_ffebad_start(FFEBAD_SOME_ERROR))
+ {
+ ffebad_here, ffebad_string ...;
+ ffebad_finish();
+ }
+
+ Call if the error might indicate that ffest is evaluating the wrong
+ statement form, instead of calling ffebad_start directly. If ffest
+ is choosing between forms, it will return FALSE, send an EOS/SEMICOLON
+ token through as the next token (if the current one isn't already one
+ of those), and try another possible form. Otherwise, ffebad_start is
+ called with the argument and TRUE returned. */
+
+bool
+ffest_ffebad_start (ffebad errnum)
+{
+ return ffesta_ffebad_start (errnum);
+}
+
+/* ffest_first -- Parse the first token in a statement
+
+ return ffest_first; // to lexer. */
+
+ffelexHandler
+ffest_first (ffelexToken t)
+{
+ return ffesta_first (t);
+}
+
+/* ffest_init_0 -- Initialize for entire image invocation
+
+ ffest_init_0();
+
+ Call just once per invocation of the compiler (not once per invocation
+ of the front end).
+
+ Gets memory for the list of possibles once and for all, since this
+ list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
+ and is not particularly large. Initializes the array of pointers to
+ this list. Initializes the executable and nonexecutable lists. */
+
+void
+ffest_init_0 ()
+{
+ ffesta_init_0 ();
+ ffestb_init_0 ();
+ ffestc_init_0 ();
+ ffestd_init_0 ();
+ ffeste_init_0 ();
+ ffestp_init_0 ();
+ ffestr_init_0 ();
+ ffests_init_0 ();
+ ffestt_init_0 ();
+ ffestu_init_0 ();
+ ffestv_init_0 ();
+ ffestw_init_0 ();
+}
+
+/* ffest_init_1 -- Initialize for entire image invocation
+
+ ffest_init_1();
+
+ Call just once per invocation of the compiler (not once per invocation
+ of the front end).
+
+ Gets memory for the list of possibles once and for all, since this
+ list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
+ and is not particularly large. Initializes the array of pointers to
+ this list. Initializes the executable and nonexecutable lists. */
+
+void
+ffest_init_1 ()
+{
+ ffesta_init_1 ();
+ ffestb_init_1 ();
+ ffestc_init_1 ();
+ ffestd_init_1 ();
+ ffeste_init_1 ();
+ ffestp_init_1 ();
+ ffestr_init_1 ();
+ ffests_init_1 ();
+ ffestt_init_1 ();
+ ffestu_init_1 ();
+ ffestv_init_1 ();
+ ffestw_init_1 ();
+}
+
+/* ffest_init_2 -- Initialize for entire image invocation
+
+ ffest_init_2();
+
+ Call just once per invocation of the compiler (not once per invocation
+ of the front end).
+
+ Gets memory for the list of possibles once and for all, since this
+ list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
+ and is not particularly large. Initializes the array of pointers to
+ this list. Initializes the executable and nonexecutable lists. */
+
+void
+ffest_init_2 ()
+{
+ ffesta_init_2 ();
+ ffestb_init_2 ();
+ ffestc_init_2 ();
+ ffestd_init_2 ();
+ ffeste_init_2 ();
+ ffestp_init_2 ();
+ ffestr_init_2 ();
+ ffests_init_2 ();
+ ffestt_init_2 ();
+ ffestu_init_2 ();
+ ffestv_init_2 ();
+ ffestw_init_2 ();
+}
+
+/* ffest_init_3 -- Initialize for any program unit
+
+ ffest_init_3(); */
+
+void
+ffest_init_3 ()
+{
+ ffesta_init_3 ();
+ ffestb_init_3 ();
+ ffestc_init_3 ();
+ ffestd_init_3 ();
+ ffeste_init_3 ();
+ ffestp_init_3 ();
+ ffestr_init_3 ();
+ ffests_init_3 ();
+ ffestt_init_3 ();
+ ffestu_init_3 ();
+ ffestv_init_3 ();
+ ffestw_init_3 ();
+
+ ffestw_display_state ();
+}
+
+/* ffest_init_4 -- Initialize for statement functions
+
+ ffest_init_4(); */
+
+void
+ffest_init_4 ()
+{
+ ffesta_init_4 ();
+ ffestb_init_4 ();
+ ffestc_init_4 ();
+ ffestd_init_4 ();
+ ffeste_init_4 ();
+ ffestp_init_4 ();
+ ffestr_init_4 ();
+ ffests_init_4 ();
+ ffestt_init_4 ();
+ ffestu_init_4 ();
+ ffestv_init_4 ();
+ ffestw_init_4 ();
+}
+
+/* Test whether ENTRY statement is valid.
+
+ Returns TRUE if current program unit is known to be FUNCTION or SUBROUTINE.
+ Else returns FALSE. */
+
+bool
+ffest_is_entry_valid ()
+{
+ return ffesta_is_entry_valid;
+}
+
+/* ffest_is_inhibited -- Test whether the current possibility is inhibited
+
+ if (!ffest_is_inhibited())
+ // implement the statement.
+
+ Just make sure the current possibility has been confirmed. If anyone
+ really needs to test whether the current possibility is inhibited prior
+ to confirming it, that indicates a need to begin statement processing
+ before it is certain that the given possibility is indeed the statement
+ to be processed. As of this writing, there does not appear to be such
+ a need. If there is, then when confirming a statement would normally
+ immediately disable the inhibition (whereas currently we leave the
+ confirmed statement disabled until we've tried the other possibilities,
+ to check for ambiguities), we must check to see if the possibility has
+ already tested for inhibition prior to confirmation and, if so, maintain
+ inhibition until the end of the statement (which may be forced right
+ away) and then rerun the entire statement from the beginning. Otherwise,
+ initial calls to ffestb functions won't have been made, but subsequent
+ calls (after confirmation) will, which is wrong. Of course, this all
+ applies only to those statements implemented via multiple calls to
+ ffestb, although if a statement requiring only a single ffestb call
+ tested for inhibition prior to confirmation, it would likely mean that
+ the ffestb call would be completely dropped without this mechanism. */
+
+bool
+ffest_is_inhibited ()
+{
+ return ffesta_is_inhibited ();
+}
+
+/* ffest_seen_first_exec -- Test whether first executable stmt has been seen
+
+ if (ffest_seen_first_exec())
+ // No more spec stmts can be seen.
+
+ In a case where, say, the first statement is PARAMETER(A)=B, FALSE
+ will be returned while the PARAMETER statement is being run, and TRUE
+ will be returned if it doesn't confirm and the assignment statement
+ is being run. */
+
+bool
+ffest_seen_first_exec ()
+{
+ return ffesta_seen_first_exec;
+}
+
+/* Shut down current parsing possibility, but without bothering the
+ user with a diagnostic if we're not inhibited. */
+
+void
+ffest_shutdown ()
+{
+ ffesta_shutdown ();
+}
+
+/* ffest_sym_end_transition -- Update symbol info just before end of unit
+
+ ffesymbol s;
+ ffest_sym_end_transition(s); */
+
+ffesymbol
+ffest_sym_end_transition (ffesymbol s)
+{
+ return ffestu_sym_end_transition (s);
+}
+
+/* ffest_sym_exec_transition -- Update symbol just before first exec stmt
+
+ ffesymbol s;
+ ffest_sym_exec_transition(s); */
+
+ffesymbol
+ffest_sym_exec_transition (ffesymbol s)
+{
+ return ffestu_sym_exec_transition (s);
+}
+
+/* ffest_terminate_0 -- Terminate for entire image invocation
+
+ ffest_terminate_0(); */
+
+void
+ffest_terminate_0 ()
+{
+ ffesta_terminate_0 ();
+ ffestb_terminate_0 ();
+ ffestc_terminate_0 ();
+ ffestd_terminate_0 ();
+ ffeste_terminate_0 ();
+ ffestp_terminate_0 ();
+ ffestr_terminate_0 ();
+ ffests_terminate_0 ();
+ ffestt_terminate_0 ();
+ ffestu_terminate_0 ();
+ ffestv_terminate_0 ();
+ ffestw_terminate_0 ();
+}
+
+/* ffest_terminate_1 -- Terminate for source file
+
+ ffest_terminate_1(); */
+
+void
+ffest_terminate_1 ()
+{
+ ffesta_terminate_1 ();
+ ffestb_terminate_1 ();
+ ffestc_terminate_1 ();
+ ffestd_terminate_1 ();
+ ffeste_terminate_1 ();
+ ffestp_terminate_1 ();
+ ffestr_terminate_1 ();
+ ffests_terminate_1 ();
+ ffestt_terminate_1 ();
+ ffestu_terminate_1 ();
+ ffestv_terminate_1 ();
+ ffestw_terminate_1 ();
+}
+
+/* ffest_terminate_2 -- Terminate for outer program unit
+
+ ffest_terminate_2(); */
+
+void
+ffest_terminate_2 ()
+{
+ ffesta_terminate_2 ();
+ ffestb_terminate_2 ();
+ ffestc_terminate_2 ();
+ ffestd_terminate_2 ();
+ ffeste_terminate_2 ();
+ ffestp_terminate_2 ();
+ ffestr_terminate_2 ();
+ ffests_terminate_2 ();
+ ffestt_terminate_2 ();
+ ffestu_terminate_2 ();
+ ffestv_terminate_2 ();
+ ffestw_terminate_2 ();
+}
+
+/* ffest_terminate_3 -- Terminate for any program unit
+
+ ffest_terminate_3(); */
+
+void
+ffest_terminate_3 ()
+{
+ ffesta_terminate_3 ();
+ ffestb_terminate_3 ();
+ ffestc_terminate_3 ();
+ ffestd_terminate_3 ();
+ ffeste_terminate_3 ();
+ ffestp_terminate_3 ();
+ ffestr_terminate_3 ();
+ ffests_terminate_3 ();
+ ffestt_terminate_3 ();
+ ffestu_terminate_3 ();
+ ffestv_terminate_3 ();
+ ffestw_terminate_3 ();
+}
+
+/* ffest_terminate_4 -- Terminate for statement functions
+
+ ffest_terminate_4(); */
+
+void
+ffest_terminate_4 ()
+{
+ ffesta_terminate_4 ();
+ ffestb_terminate_4 ();
+ ffestc_terminate_4 ();
+ ffestd_terminate_4 ();
+ ffeste_terminate_4 ();
+ ffestp_terminate_4 ();
+ ffestr_terminate_4 ();
+ ffests_terminate_4 ();
+ ffestt_terminate_4 ();
+ ffestu_terminate_4 ();
+ ffestv_terminate_4 ();
+ ffestw_terminate_4 ();
+}
diff --git a/gcc/f/st.h b/gcc/f/st.h
new file mode 100644
index 00000000000..d762f6c9253
--- /dev/null
+++ b/gcc/f/st.h
@@ -0,0 +1,81 @@
+/* st.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ st.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_st
+#define _H_f_st
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bad.h"
+#include "lex.h"
+#include "symbol.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffest_confirmed (void);
+void ffest_eof (void);
+bool ffest_ffebad_start (ffebad errnum);
+void ffest_ffebad_here_current_stmt (ffebadIndex i);
+void ffest_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
+ffelexHandler ffest_first (ffelexToken t);
+void ffest_init_0 (void);
+void ffest_init_1 (void);
+void ffest_init_2 (void);
+void ffest_init_3 (void);
+void ffest_init_4 (void);
+bool ffest_is_entry_valid (void);
+bool ffest_is_inhibited (void);
+bool ffest_seen_first_exec (void);
+void ffest_shutdown (void);
+ffesymbol ffest_sym_end_transition (ffesymbol s);
+ffesymbol ffest_sym_exec_transition (ffesymbol s);
+void ffest_terminate_0 (void);
+void ffest_terminate_1 (void);
+void ffest_terminate_2 (void);
+void ffest_terminate_3 (void);
+void ffest_terminate_4 (void);
+
+/* Define macros. */
+
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/sta.c b/gcc/f/sta.c
new file mode 100644
index 00000000000..328bfd0f662
--- /dev/null
+++ b/gcc/f/sta.c
@@ -0,0 +1,1993 @@
+/* sta.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Analyzes the first two tokens, figures out what statements are
+ possible, tries parsing the possible statements by calling on
+ the ffestb functions.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "sta.h"
+#include "bad.h"
+#include "implic.h"
+#include "lex.h"
+#include "malloc.h"
+#include "stb.h"
+#include "stc.h"
+#include "std.h"
+#include "str.h"
+#include "storag.h"
+#include "symbol.h"
+
+/* Externals defined here. */
+
+ffelexToken ffesta_tokens[FFESTA_tokensMAX]; /* For use by a possible. */
+ffestrFirst ffesta_first_kw; /* First NAME(S) looked up. */
+ffestrSecond ffesta_second_kw; /* Second NAME(S) looked up. */
+mallocPool ffesta_output_pool; /* Pool for results of stmt handling. */
+mallocPool ffesta_scratch_pool; /* Pool for stmt scratch handling. */
+ffelexToken ffesta_construct_name;
+ffelexToken ffesta_label_token; /* Pending label stuff. */
+bool ffesta_seen_first_exec;
+bool ffesta_is_entry_valid = FALSE; /* TRUE only in SUBROUTINE/FUNCTION. */
+bool ffesta_line_has_semicolons = FALSE;
+
+/* Simple definitions and enumerations. */
+
+#define FFESTA_ABORT_ON_CONFIRM_ 1 /* 0=slow, tested way; 1=faster way
+ that might not always work. Here's
+ the old description of what used
+ to not work with ==1: (try
+ "CONTINUE\10
+ FORMAT('hi',I11)\END"). Problem
+ is that the "topology" of the
+ confirmed stmt's tokens with
+ regard to CHARACTER, HOLLERITH,
+ NAME/NAMES/NUMBER tokens (like hex
+ numbers), isn't traced if we abort
+ early, then other stmts might get
+ their grubby hands on those
+ unprocessed tokens and commit them
+ improperly. Ideal fix is to rerun
+ the confirmed stmt and forget the
+ rest. */
+
+#define FFESTA_maxPOSSIBLES_ 8/* Never more than this # of possibles. */
+
+/* Internal typedefs. */
+
+typedef struct _ffesta_possible_ *ffestaPossible_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffesta_possible_
+ {
+ ffestaPossible_ next;
+ ffestaPossible_ previous;
+ ffelexHandler handler;
+ bool named;
+ };
+
+struct _ffesta_possible_root_
+ {
+ ffestaPossible_ first;
+ ffestaPossible_ last;
+ ffelexHandler nil;
+ };
+
+/* Static objects accessed by functions in this module. */
+
+static bool ffesta_is_inhibited_ = FALSE;
+static ffelexToken ffesta_token_0_; /* For use by ffest possibility
+ handling. */
+static ffestaPossible_ ffesta_possibles_[FFESTA_maxPOSSIBLES_];
+static int ffesta_num_possibles_ = 0; /* Number of possibilities. */
+static struct _ffesta_possible_root_ ffesta_possible_nonexecs_;
+static struct _ffesta_possible_root_ ffesta_possible_execs_;
+static ffestaPossible_ ffesta_current_possible_;
+static ffelexHandler ffesta_current_handler_;
+static bool ffesta_confirmed_current_ = FALSE;
+static bool ffesta_confirmed_other_ = FALSE;
+static ffestaPossible_ ffesta_confirmed_possible_;
+static bool ffesta_current_shutdown_ = FALSE;
+#if !FFESTA_ABORT_ON_CONFIRM_
+static bool ffesta_is_two_into_statement_ = FALSE; /* For IF, WHERE stmts. */
+static ffelexToken ffesta_twotokens_1_; /* For IF, WHERE stmts. */
+static ffelexToken ffesta_twotokens_2_; /* For IF, WHERE stmts. */
+#endif
+static ffestaPooldisp ffesta_outpooldisp_; /* After statement dealt
+ with. */
+static bool ffesta_inhibit_confirmation_ = FALSE;
+
+/* Static functions (internal). */
+
+static void ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named);
+static bool ffesta_inhibited_exec_transition_ (void);
+static void ffesta_reset_possibles_ (void);
+static ffelexHandler ffesta_save_ (ffelexToken t);
+static ffelexHandler ffesta_second_ (ffelexToken t);
+#if !FFESTA_ABORT_ON_CONFIRM_
+static ffelexHandler ffesta_send_two_ (ffelexToken t);
+#endif
+
+/* Internal macros. */
+
+#define ffesta_add_possible_exec_(fn) (ffesta_add_possible_ (fn, TRUE, TRUE))
+#define ffesta_add_possible_nonexec_(fn) (ffesta_add_possible_ (fn, FALSE, TRUE))
+#define ffesta_add_possible_unnamed_exec_(fn) (ffesta_add_possible_ (fn, TRUE, FALSE))
+#define ffesta_add_possible_unnamed_nonexec_(fn) (ffesta_add_possible_ (fn, FALSE, FALSE))
+
+/* Add possible statement to appropriate list. */
+
+static void
+ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named)
+{
+ ffestaPossible_ p;
+
+ assert (ffesta_num_possibles_ < FFESTA_maxPOSSIBLES_);
+
+ p = ffesta_possibles_[ffesta_num_possibles_++];
+
+ if (exec)
+ {
+ p->next = (ffestaPossible_) &ffesta_possible_execs_.first;
+ p->previous = ffesta_possible_execs_.last;
+ }
+ else
+ {
+ p->next = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
+ p->previous = ffesta_possible_nonexecs_.last;
+ }
+ p->next->previous = p;
+ p->previous->next = p;
+
+ p->handler = fn;
+ p->named = named;
+}
+
+/* ffesta_inhibited_exec_transition_ -- Do exec transition while inhibited
+
+ if (!ffesta_inhibited_exec_transition_()) // couldn't transition...
+
+ Invokes ffestc_exec_transition, but first enables ffebad and ffesta and
+ afterwards disables them again. Then returns the result of the
+ invocation of ffestc_exec_transition. */
+
+static bool
+ffesta_inhibited_exec_transition_ ()
+{
+ bool result;
+
+ assert (ffebad_inhibit ());
+ assert (ffesta_is_inhibited_);
+
+ ffebad_set_inhibit (FALSE);
+ ffesta_is_inhibited_ = FALSE;
+
+ result = ffestc_exec_transition ();
+
+ ffebad_set_inhibit (TRUE);
+ ffesta_is_inhibited_ = TRUE;
+
+ return result;
+}
+
+/* ffesta_reset_possibles_ -- Reset (clear) lists of possible statements
+
+ ffesta_reset_possibles_();
+
+ Clears the lists of executable and nonexecutable statements. */
+
+static void
+ffesta_reset_possibles_ ()
+{
+ ffesta_num_possibles_ = 0;
+
+ ffesta_possible_execs_.first = ffesta_possible_execs_.last
+ = (ffestaPossible_) &ffesta_possible_execs_.first;
+ ffesta_possible_nonexecs_.first = ffesta_possible_nonexecs_.last
+ = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
+}
+
+/* ffesta_save_ -- Save token on list, pass thru to current handler
+
+ return ffesta_save_; // to lexer.
+
+ Receives a token from the lexer. Saves it in the list of tokens. Calls
+ the current handler with the token.
+
+ If no shutdown error occurred (via
+ ffest_ffebad_start), then if the token was EOS or SEMICOLON, mark the
+ current possible as successful and confirmed but try the next possible
+ anyway until ambiguities in the form handling are ironed out. */
+
+static ffelexHandler
+ffesta_save_ (ffelexToken t)
+{
+ static ffelexToken *saved_tokens = NULL; /* A variable-sized array. */
+ static unsigned int num_saved_tokens = 0; /* Number currently saved. */
+ static unsigned int max_saved_tokens = 0; /* Maximum to be saved. */
+ unsigned int toknum; /* Index into saved_tokens array. */
+ ffelexToken eos; /* EOS created on-the-fly for shutdown
+ purposes. */
+ ffelexToken t2; /* Another temporary token (no intersect with
+ eos, btw). */
+
+ /* Save the current token. */
+
+ if (saved_tokens == NULL)
+ {
+ saved_tokens
+ = (ffelexToken *) malloc_new_ksr (malloc_pool_image (),
+ "FFEST Saved Tokens",
+ (max_saved_tokens = 8) * sizeof (ffelexToken));
+ /* Start off with 8. */
+ }
+ else if (num_saved_tokens >= max_saved_tokens)
+ {
+ toknum = max_saved_tokens;
+ max_saved_tokens <<= 1; /* Multiply by two. */
+ assert (max_saved_tokens > toknum);
+ saved_tokens
+ = (ffelexToken *) malloc_resize_ksr (malloc_pool_image (),
+ saved_tokens,
+ max_saved_tokens * sizeof (ffelexToken),
+ toknum * sizeof (ffelexToken));
+ }
+
+ *(saved_tokens + num_saved_tokens++) = ffelex_token_use (t);
+
+ /* Transmit the current token to the current handler. */
+
+ ffesta_current_handler_ = (ffelexHandler) (*ffesta_current_handler_) (t);
+
+ /* See if this possible has been shut down, or confirmed in which case we
+ might as well shut it down anyway to save time. */
+
+ if ((ffesta_current_shutdown_ || (FFESTA_ABORT_ON_CONFIRM_
+ && ffesta_confirmed_current_))
+ && !ffelex_expecting_character ())
+ {
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+
+ default:
+ eos = ffelex_token_new_eos (ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffesta_inhibit_confirmation_ = ffesta_current_shutdown_;
+ (*ffesta_current_handler_) (eos);
+ ffesta_inhibit_confirmation_ = FALSE;
+ ffelex_token_kill (eos);
+ break;
+ }
+ }
+ else
+ {
+
+ /* If this is an EOS or SEMICOLON token, switch to next handler, else
+ return self as next handler for lexer. */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+
+ default:
+ return (ffelexHandler) ffesta_save_;
+ }
+ }
+
+ next_handler: /* :::::::::::::::::::: */
+
+ /* Note that a shutdown also happens after seeing the first two tokens
+ after "IF (expr)" or "WHERE (expr)" where a statement follows, even
+ though there is no error. This causes the IF or WHERE form to be
+ implemented first before ffest_first is called for the first token in
+ the following statement. */
+
+ if (ffesta_current_shutdown_)
+ ffesta_current_shutdown_ = FALSE; /* Only after sending EOS! */
+ else
+ assert (ffesta_confirmed_current_);
+
+ if (ffesta_confirmed_current_)
+ {
+ ffesta_confirmed_current_ = FALSE;
+ ffesta_confirmed_other_ = TRUE;
+ }
+
+ /* Pick next handler. */
+
+ ffesta_current_possible_ = ffesta_current_possible_->next;
+ ffesta_current_handler_ = ffesta_current_possible_->handler;
+ if (ffesta_current_handler_ == NULL)
+ { /* No handler in this list, try exec list if
+ not tried yet. */
+ if (ffesta_current_possible_
+ == (ffestaPossible_) &ffesta_possible_nonexecs_)
+ {
+ ffesta_current_possible_ = ffesta_possible_execs_.first;
+ ffesta_current_handler_ = ffesta_current_possible_->handler;
+ }
+ if ((ffesta_current_handler_ == NULL)
+ || (!ffesta_seen_first_exec
+ && ((ffesta_confirmed_possible_ != NULL)
+ || !ffesta_inhibited_exec_transition_ ())))
+ /* Don't run execs if: (decoding the "if" ^^^ up here ^^^) - we
+ have no exec handler available, or - we haven't seen the first
+ executable statement yet, and - we've confirmed a nonexec
+ (otherwise even a nonexec would cause a transition), or - a
+ nonexec-to-exec transition can't be made at the statement context
+ level (as in an executable statement in the middle of a STRUCTURE
+ definition); if it can be made, ffestc_exec_transition makes the
+ corresponding transition at the statement state level so
+ specification statements are no longer accepted following an
+ unrecognized statement. (Note: it is valid for f_e_t_ to decide
+ to always return TRUE by "shrieking" away the statement state
+ stack until a transitionable state is reached. Or it can leave
+ the stack as is and return FALSE.)
+
+ If we decide not to run execs, enter this block to rerun the
+ confirmed statement, if any. */
+ { /* At end of both lists! Pick confirmed or
+ first possible. */
+ ffebad_set_inhibit (FALSE);
+ ffesta_is_inhibited_ = FALSE;
+ ffesta_confirmed_other_ = FALSE;
+ ffesta_tokens[0] = ffesta_token_0_;
+ if (ffesta_confirmed_possible_ == NULL)
+ { /* No confirmed success, just use first
+ named possible, or first possible if
+ no named possibles. */
+ ffestaPossible_ possible = ffesta_possible_nonexecs_.first;
+ ffestaPossible_ first = NULL;
+ ffestaPossible_ first_named = NULL;
+ ffestaPossible_ first_exec = NULL;
+
+ for (;;)
+ {
+ if (possible->handler == NULL)
+ {
+ if (possible == (ffestaPossible_) &ffesta_possible_nonexecs_)
+ {
+ possible = first_exec = ffesta_possible_execs_.first;
+ continue;
+ }
+ else
+ break;
+ }
+ if (first == NULL)
+ first = possible;
+ if (possible->named
+ && (first_named == NULL))
+ first_named = possible;
+
+ possible = possible->next;
+ }
+
+ if (first_named != NULL)
+ ffesta_current_possible_ = first_named;
+ else if (ffesta_seen_first_exec
+ && (first_exec != NULL))
+ ffesta_current_possible_ = first_exec;
+ else
+ ffesta_current_possible_ = first;
+
+ ffesta_current_handler_ = ffesta_current_possible_->handler;
+ assert (ffesta_current_handler_ != NULL);
+ }
+ else
+ { /* Confirmed success, use it. */
+ ffesta_current_possible_ = ffesta_confirmed_possible_;
+ ffesta_current_handler_ = ffesta_confirmed_possible_->handler;
+ }
+ ffesta_reset_possibles_ ();
+ }
+ else
+ { /* Switching from [empty?] list of nonexecs
+ to nonempty list of execs at this point. */
+ ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_);
+ ffesymbol_set_retractable (ffesta_scratch_pool);
+ }
+ }
+ else
+ {
+ ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_);
+ ffesymbol_set_retractable (ffesta_scratch_pool);
+ }
+
+ /* Send saved tokens to current handler until either shut down or all
+ tokens sent. */
+
+ for (toknum = 0; toknum < num_saved_tokens; ++toknum)
+ {
+ t = *(saved_tokens + toknum);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCHARACTER:
+ ffelex_set_expecting_hollerith (0, '\0',
+ ffewhere_line_unknown (),
+ ffewhere_column_unknown ());
+ ffesta_current_handler_
+ = (ffelexHandler) (*ffesta_current_handler_) (t);
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffelex_is_names_expected ())
+ ffesta_current_handler_
+ = (ffelexHandler) (*ffesta_current_handler_) (t);
+ else
+ {
+ t2 = ffelex_token_name_from_names (t, 0, 0);
+ ffesta_current_handler_
+ = (ffelexHandler) (*ffesta_current_handler_) (t2);
+ ffelex_token_kill (t2);
+ }
+ break;
+
+ default:
+ ffesta_current_handler_
+ = (ffelexHandler) (*ffesta_current_handler_) (t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited_)
+ ffelex_token_kill (t); /* Won't need this any more. */
+
+ /* See if this possible has been shut down. */
+
+ else if ((ffesta_current_shutdown_ || (FFESTA_ABORT_ON_CONFIRM_
+ && ffesta_confirmed_current_))
+ && !ffelex_expecting_character ())
+ {
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+
+ default:
+ eos = ffelex_token_new_eos (ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffesta_inhibit_confirmation_ = ffesta_current_shutdown_;
+ (*ffesta_current_handler_) (eos);
+ ffesta_inhibit_confirmation_ = FALSE;
+ ffelex_token_kill (eos);
+ break;
+ }
+ goto next_handler; /* :::::::::::::::::::: */
+ }
+ }
+
+ /* Finished sending all the tokens so far. If still trying possibilities,
+ then if we've just sent an EOS or SEMICOLON token through, go to the
+ next handler. Otherwise, return self so we can gather and process more
+ tokens. */
+
+ if (ffesta_is_inhibited_)
+ {
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ goto next_handler; /* :::::::::::::::::::: */
+
+ default:
+#if FFESTA_ABORT_ON_CONFIRM_
+ assert (!ffesta_confirmed_other_); /* Catch ambiguities. */
+#endif
+ return (ffelexHandler) ffesta_save_;
+ }
+ }
+
+ /* This was the one final possibility, uninhibited, so send the final
+ handler it sent. */
+
+ num_saved_tokens = 0;
+#if !FFESTA_ABORT_ON_CONFIRM_
+ if (ffesta_is_two_into_statement_)
+ { /* End of the line for the previous two
+ tokens, resurrect them. */
+ ffelexHandler next;
+
+ ffesta_is_two_into_statement_ = FALSE;
+ next = (ffelexHandler) ffesta_first (ffesta_twotokens_1_);
+ ffelex_token_kill (ffesta_twotokens_1_);
+ next = (ffelexHandler) (*next) (ffesta_twotokens_2_);
+ ffelex_token_kill (ffesta_twotokens_2_);
+ return (ffelexHandler) next;
+ }
+#endif
+
+ assert (ffesta_current_handler_ != NULL);
+ return (ffelexHandler) ffesta_current_handler_;
+}
+
+/* ffesta_second_ -- Parse the token after a NAME/NAMES in a statement
+
+ return ffesta_second_; // to lexer.
+
+ The second token cannot be a NAMES, since the first token is a NAME or
+ NAMES. If the second token is a NAME, look up its name in the list of
+ second names for use by whoever needs it.
+
+ Then make a list of all the possible statements this could be, based on
+ looking at the first two tokens. Two lists of possible statements are
+ created, one consisting of nonexecutable statements, the other consisting
+ of executable statements.
+
+ If the total number of possibilities is one, just fire up that
+ possibility by calling its handler function, passing the first two
+ tokens through it and so on.
+
+ Otherwise, start up a process whereby tokens are passed to the first
+ possibility on the list until EOS or SEMICOLON is reached or an error
+ is detected. But inhibit any actual reporting of errors; just record
+ their existence in the list. If EOS or SEMICOLON is reached with no
+ errors (other than non-form errors happening downstream, such as an
+ overflowing value for an integer or a GOTO statement identifying a label
+ on a FORMAT statement), then that is the only possible statement. Rerun
+ the statement with error-reporting turned on if any non-form errors were
+ generated, otherwise just use its results, then erase the list of tokens
+ memorized during the search process. If a form error occurs, immediately
+ cancel that possibility by sending EOS as the next token, remember the
+ error code for that possibility, and try the next possibility on the list,
+ first sending it the list of tokens memorized while handling the first
+ possibility, then continuing on as before.
+
+ Ultimately, either the end of the list of possibilities will be reached
+ without any successful forms being detected, in which case we pick one
+ based on hueristics (usually the first possibility) and rerun it with
+ error reporting turned on using the list of memorized tokens so the user
+ sees the error, or one of the possibilities will effectively succeed. */
+
+static ffelexHandler
+ffesta_second_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffesymbol s;
+
+ assert (ffelex_token_type (t) != FFELEX_typeNAMES);
+
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ ffesta_second_kw = ffestr_second (t);
+
+ /* Here we use switch on the first keyword name and handle each possible
+ recognizable name by looking at the second token, and building the list
+ of possible names accordingly. For now, just put every possible
+ statement on the list for ambiguity checking. */
+
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_VXT
+ case FFESTR_firstACCEPT:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V019);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstALLOCATABLE:
+ ffestb_args.dimlist.len = FFESTR_firstlALLOCATABLE;
+ ffestb_args.dimlist.badname = "ALLOCATABLE";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstALLOCATE:
+ ffestb_args.heap.len = FFESTR_firstlALLOCATE;
+ ffestb_args.heap.badname = "ALLOCATE";
+ ffestb_args.heap.ctx = FFEEXPR_contextALLOCATE;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_heap);
+ break;
+#endif
+
+ case FFESTR_firstASSIGN:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R838);
+ break;
+
+ case FFESTR_firstBACKSPACE:
+ ffestb_args.beru.len = FFESTR_firstlBACKSPACE;
+ ffestb_args.beru.badname = "BACKSPACE";
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
+ break;
+
+ case FFESTR_firstBLOCK:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_block);
+ break;
+
+ case FFESTR_firstBLOCKDATA:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_blockdata);
+ break;
+
+ case FFESTR_firstBYTE:
+ ffestb_args.decl.len = FFESTR_firstlBYTE;
+ ffestb_args.decl.type = FFESTP_typeBYTE;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
+ break;
+
+ case FFESTR_firstCALL:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1212);
+ break;
+
+ case FFESTR_firstCASE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R810);
+ break;
+
+ case FFESTR_firstCHRCTR:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_chartype);
+ break;
+
+ case FFESTR_firstCLOSE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R907);
+ break;
+
+ case FFESTR_firstCOMMON:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R547);
+ break;
+
+ case FFESTR_firstCMPLX:
+ ffestb_args.decl.len = FFESTR_firstlCMPLX;
+ ffestb_args.decl.type = FFESTP_typeCOMPLEX;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstCONTAINS:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1228);
+ break;
+#endif
+
+ case FFESTR_firstCONTINUE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R841);
+ break;
+
+ case FFESTR_firstCYCLE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R834);
+ break;
+
+ case FFESTR_firstDATA:
+ if (ffe_is_pedantic_not_90 ())
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R528);
+ else
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R528);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstDEALLOCATE:
+ ffestb_args.heap.len = FFESTR_firstlDEALLOCATE;
+ ffestb_args.heap.badname = "DEALLOCATE";
+ ffestb_args.heap.ctx = FFEEXPR_contextDEALLOCATE;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_heap);
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_firstDECODE:
+ ffestb_args.vxtcode.len = FFESTR_firstlDECODE;
+ ffestb_args.vxtcode.badname = "DECODE";
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_vxtcode);
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_firstDEFINEFILE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V025);
+ break;
+
+ case FFESTR_firstDELETE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V021);
+ break;
+#endif
+ case FFESTR_firstDIMENSION:
+ ffestb_args.R524.len = FFESTR_firstlDIMENSION;
+ ffestb_args.R524.badname = "DIMENSION";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R524);
+ break;
+
+ case FFESTR_firstDO:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_do);
+ break;
+
+ case FFESTR_firstDBL:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_double);
+ break;
+
+ case FFESTR_firstDBLCMPLX:
+ ffestb_args.decl.len = FFESTR_firstlDBLCMPLX;
+ ffestb_args.decl.type = FFESTP_typeDBLCMPLX;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_dbltype);
+ break;
+
+ case FFESTR_firstDBLPRCSN:
+ ffestb_args.decl.len = FFESTR_firstlDBLPRCSN;
+ ffestb_args.decl.type = FFESTP_typeDBLPRCSN;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_dbltype);
+ break;
+
+ case FFESTR_firstDOWHILE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_dowhile);
+ break;
+
+ case FFESTR_firstELSE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_else);
+ break;
+
+ case FFESTR_firstELSEIF:
+ ffestb_args.elsexyz.second = FFESTR_secondIF;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_elsexyz);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstELSEWHERE:
+ ffestb_args.elsexyz.second = FFESTR_secondWHERE;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_elsexyz);
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_firstENCODE:
+ ffestb_args.vxtcode.len = FFESTR_firstlENCODE;
+ ffestb_args.vxtcode.badname = "ENCODE";
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_vxtcode);
+ break;
+#endif
+
+ case FFESTR_firstEND:
+ if ((ffelex_token_type (ffesta_token_0_) == FFELEX_typeNAMES)
+ || (ffelex_token_type (t) != FFELEX_typeNAME))
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_end);
+ else
+ {
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondBLOCK:
+ case FFESTR_secondBLOCKDATA:
+ case FFESTR_secondDO:
+ case FFESTR_secondFILE:
+ case FFESTR_secondFUNCTION:
+ case FFESTR_secondIF:
+#if FFESTR_F90
+ case FFESTR_secondMODULE:
+#endif
+ case FFESTR_secondPROGRAM:
+ case FFESTR_secondSELECT:
+ case FFESTR_secondSUBROUTINE:
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+#endif
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_end);
+ break;
+
+ default:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_end);
+ break;
+ }
+ }
+ break;
+
+ case FFESTR_firstENDBLOCK:
+ ffestb_args.endxyz.len = FFESTR_firstlENDBLOCK;
+ ffestb_args.endxyz.second = FFESTR_secondBLOCK;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+
+ case FFESTR_firstENDBLOCKDATA:
+ ffestb_args.endxyz.len = FFESTR_firstlENDBLOCKDATA;
+ ffestb_args.endxyz.second = FFESTR_secondBLOCKDATA;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+
+ case FFESTR_firstENDDO:
+ ffestb_args.endxyz.len = FFESTR_firstlENDDO;
+ ffestb_args.endxyz.second = FFESTR_secondDO;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+
+ case FFESTR_firstENDFILE:
+ ffestb_args.beru.len = FFESTR_firstlENDFILE;
+ ffestb_args.beru.badname = "ENDFILE";
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
+ break;
+
+ case FFESTR_firstENDFUNCTION:
+ ffestb_args.endxyz.len = FFESTR_firstlENDFUNCTION;
+ ffestb_args.endxyz.second = FFESTR_secondFUNCTION;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+
+ case FFESTR_firstENDIF:
+ ffestb_args.endxyz.len = FFESTR_firstlENDIF;
+ ffestb_args.endxyz.second = FFESTR_secondIF;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstENDINTERFACE:
+ ffestb_args.endxyz.len = FFESTR_firstlENDINTERFACE;
+ ffestb_args.endxyz.second = FFESTR_secondINTERFACE;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_firstENDMAP:
+ ffestb_args.endxyz.len = FFESTR_firstlENDMAP;
+ ffestb_args.endxyz.second = FFESTR_secondMAP;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstENDMODULE:
+ ffestb_args.endxyz.len = FFESTR_firstlENDMODULE;
+ ffestb_args.endxyz.second = FFESTR_secondMODULE;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+#endif
+
+ case FFESTR_firstENDPROGRAM:
+ ffestb_args.endxyz.len = FFESTR_firstlENDPROGRAM;
+ ffestb_args.endxyz.second = FFESTR_secondPROGRAM;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+
+ case FFESTR_firstENDSELECT:
+ ffestb_args.endxyz.len = FFESTR_firstlENDSELECT;
+ ffestb_args.endxyz.second = FFESTR_secondSELECT;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstENDSTRUCTURE:
+ ffestb_args.endxyz.len = FFESTR_firstlENDSTRUCTURE;
+ ffestb_args.endxyz.second = FFESTR_secondSTRUCTURE;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+#endif
+
+ case FFESTR_firstENDSUBROUTINE:
+ ffestb_args.endxyz.len = FFESTR_firstlENDSUBROUTINE;
+ ffestb_args.endxyz.second = FFESTR_secondSUBROUTINE;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstENDTYPE:
+ ffestb_args.endxyz.len = FFESTR_firstlENDTYPE;
+ ffestb_args.endxyz.second = FFESTR_secondTYPE;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_firstENDUNION:
+ ffestb_args.endxyz.len = FFESTR_firstlENDUNION;
+ ffestb_args.endxyz.second = FFESTR_secondUNION;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstENDWHERE:
+ ffestb_args.endxyz.len = FFESTR_firstlENDWHERE;
+ ffestb_args.endxyz.second = FFESTR_secondWHERE;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
+ break;
+#endif
+
+ case FFESTR_firstENTRY:
+ ffestb_args.dummy.len = FFESTR_firstlENTRY;
+ ffestb_args.dummy.badname = "ENTRY";
+ ffestb_args.dummy.is_subr = ffestc_is_entry_in_subr ();
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy);
+ break;
+
+ case FFESTR_firstEQUIVALENCE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R544);
+ break;
+
+ case FFESTR_firstEXIT:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R835);
+ break;
+
+ case FFESTR_firstEXTERNAL:
+ ffestb_args.varlist.len = FFESTR_firstlEXTERNAL;
+ ffestb_args.varlist.badname = "EXTERNAL";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstFIND:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V026);
+ break;
+#endif
+
+ /* WARNING: don't put anything that might cause an item to precede
+ FORMAT in the list of possible statements (it's added below) without
+ making sure FORMAT still is first. It has to run with
+ ffelex_set_names_pure(TRUE), to make sure the lexer delivers NAMES
+ tokens. */
+
+ case FFESTR_firstFORMAT:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1001);
+ break;
+
+ case FFESTR_firstFUNCTION:
+ ffestb_args.dummy.len = FFESTR_firstlFUNCTION;
+ ffestb_args.dummy.badname = "FUNCTION";
+ ffestb_args.dummy.is_subr = FALSE;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy);
+ break;
+
+ case FFESTR_firstGOTO:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_goto);
+ break;
+
+ case FFESTR_firstIF:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_if);
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R840);
+ break;
+
+ case FFESTR_firstIMPLICIT:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_R539);
+ break;
+
+ case FFESTR_firstINCLUDE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_S3P4);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeNAME:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ break;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFESTR_firstINQUIRE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R923);
+ break;
+
+ case FFESTR_firstINTGR:
+ ffestb_args.decl.len = FFESTR_firstlINTGR;
+ ffestb_args.decl.type = FFESTP_typeINTEGER;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestb_args.varlist.len = FFESTR_firstlINTENT;
+ ffestb_args.varlist.badname = "INTENT";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstINTERFACE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1202);
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestb_args.varlist.len = FFESTR_firstlINTRINSIC;
+ ffestb_args.varlist.badname = "INTRINSIC";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+ break;
+
+ case FFESTR_firstLGCL:
+ ffestb_args.decl.len = FFESTR_firstlLGCL;
+ ffestb_args.decl.type = FFESTP_typeLOGICAL;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstMAP:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V012);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstMODULE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_module);
+ break;
+#endif
+
+ case FFESTR_firstNAMELIST:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R542);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstNULLIFY:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R624);
+ break;
+#endif
+
+ case FFESTR_firstOPEN:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R904);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestb_args.varlist.len = FFESTR_firstlOPTIONAL;
+ ffestb_args.varlist.badname = "OPTIONAL";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+ break;
+#endif
+
+ case FFESTR_firstPARAMETER:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R537);
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V027);
+ break;
+
+ case FFESTR_firstPAUSE:
+ ffestb_args.halt.len = FFESTR_firstlPAUSE;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstPOINTER:
+ ffestb_args.dimlist.len = FFESTR_firstlPOINTER;
+ ffestb_args.dimlist.badname = "POINTER";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist);
+ break;
+#endif
+
+ case FFESTR_firstPRINT:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R911);
+ break;
+
+#if HARD_F90
+ case FFESTR_firstPRIVATE:
+ ffestb_args.varlist.len = FFESTR_firstlPRIVATE;
+ ffestb_args.varlist.badname = "ACCESS";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+ break;
+#endif
+
+ case FFESTR_firstPROGRAM:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1102);
+ break;
+
+#if HARD_F90
+ case FFESTR_firstPUBLIC:
+ ffestb_args.varlist.len = FFESTR_firstlPUBLIC;
+ ffestb_args.varlist.badname = "ACCESS";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
+ break;
+#endif
+
+ case FFESTR_firstREAD:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R909);
+ break;
+
+ case FFESTR_firstREAL:
+ ffestb_args.decl.len = FFESTR_firstlREAL;
+ ffestb_args.decl.type = FFESTP_typeREAL;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstRECORD:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V016);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstRECURSIVE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_recursive);
+ break;
+#endif
+
+ case FFESTR_firstRETURN:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1227);
+ break;
+
+ case FFESTR_firstREWIND:
+ ffestb_args.beru.len = FFESTR_firstlREWIND;
+ ffestb_args.beru.badname = "REWIND";
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstREWRITE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V018);
+ break;
+#endif
+
+ case FFESTR_firstSAVE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R522);
+ break;
+
+ case FFESTR_firstSELECT:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809);
+ break;
+
+ case FFESTR_firstSELECTCASE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809);
+ break;
+
+#if HARD_F90
+ case FFESTR_firstSEQUENCE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R423B);
+ break;
+#endif
+
+ case FFESTR_firstSTOP:
+ ffestb_args.halt.len = FFESTR_firstlSTOP;
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt);
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstSTRUCTURE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V003);
+ break;
+#endif
+
+ case FFESTR_firstSUBROUTINE:
+ ffestb_args.dummy.len = FFESTR_firstlSUBROUTINE;
+ ffestb_args.dummy.badname = "SUBROUTINE";
+ ffestb_args.dummy.is_subr = TRUE;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstTARGET:
+ ffestb_args.dimlist.len = FFESTR_firstlTARGET;
+ ffestb_args.dimlist.badname = "TARGET";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dimlist);
+ break;
+#endif
+
+ case FFESTR_firstTYPE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V020);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstTYPE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_type);
+ break;
+#endif
+
+#if HARD_F90
+ case FFESTR_firstTYPE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_typetype);
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_firstUNLOCK:
+ ffestb_args.beru.len = FFESTR_firstlUNLOCK;
+ ffestb_args.beru.badname = "UNLOCK";
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_firstUNION:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V009);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstUSE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1107);
+ break;
+#endif
+
+ case FFESTR_firstVIRTUAL:
+ ffestb_args.R524.len = FFESTR_firstlVIRTUAL;
+ ffestb_args.R524.badname = "VIRTUAL";
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R524);
+ break;
+
+ case FFESTR_firstVOLATILE:
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V014);
+ break;
+
+#if HARD_F90
+ case FFESTR_firstWHERE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_where);
+ break;
+#endif
+
+ case FFESTR_firstWORD:
+ ffestb_args.decl.len = FFESTR_firstlWORD;
+ ffestb_args.decl.type = FFESTP_typeWORD;
+ ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
+ break;
+
+ case FFESTR_firstWRITE:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R910);
+ break;
+
+ default:
+ break;
+ }
+
+ /* Now check the default cases, which are always "live" (meaning that no
+ other possibility can override them). These are where the second token
+ is OPEN_PAREN, PERCENT, EQUALS, POINTS, or COLON. */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ s = ffesymbol_lookup_local (ffesta_token_0_);
+ if (((s == NULL) || (ffesymbol_dims (s) == NULL))
+ && !ffesta_seen_first_exec)
+ { /* Not known as array; may be stmt function. */
+ ffesta_add_possible_unnamed_nonexec_ ((ffelexHandler) ffestb_R1229);
+
+ /* If the symbol is (or will be due to implicit typing) of
+ CHARACTER type, then the statement might be an assignment
+ statement. If so, since it can't be a function invocation nor
+ an array element reference, the open paren following the symbol
+ name must be followed by an expression and a colon. Without the
+ colon (which cannot appear in a stmt function definition), the
+ let stmt rejects. So CHARACTER_NAME(...)=expr, unlike any other
+ type, is not ambiguous alone. */
+
+ if (ffeimplic_peek_symbol_type (s,
+ ffelex_token_text (ffesta_token_0_))
+ == FFEINFO_basictypeCHARACTER)
+ ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
+ }
+ else /* Not statement function if known as an
+ array. */
+ ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
+ break;
+
+#if FFESTR_F90
+ case FFELEX_typePERCENT:
+#endif
+ case FFELEX_typeEQUALS:
+#if FFESTR_F90
+ case FFELEX_typePOINTS:
+#endif
+ ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
+ break;
+
+ case FFELEX_typeCOLON:
+ ffesta_add_possible_exec_ ((ffelexHandler) ffestb_construct);
+ break;
+
+ default:
+ ;
+ }
+
+ /* Now see how many possibilities are on the list. */
+
+ switch (ffesta_num_possibles_)
+ {
+ case 0: /* None, so invalid statement. */
+ no_stmts: /* :::::::::::::::::::: */
+ ffesta_tokens[0] = ffesta_token_0_;
+ ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_token_0_, t);
+ next = (ffelexHandler) ffelex_swallow_tokens (NULL,
+ (ffelexHandler) ffesta_zero);
+ break;
+
+ case 1: /* One, so just do it! */
+ ffesta_tokens[0] = ffesta_token_0_;
+ next = ffesta_possible_execs_.first->handler;
+ if (next == NULL)
+ { /* Have a nonexec stmt. */
+ next = ffesta_possible_nonexecs_.first->handler;
+ assert (next != NULL);
+ }
+ else if (ffesta_seen_first_exec)
+ ; /* Have an exec stmt after exec transition. */
+ else if (!ffestc_exec_transition ())
+ /* 1 exec stmt only, but not valid in context, so pretend as though
+ statement is unrecognized. */
+ goto no_stmts; /* :::::::::::::::::::: */
+ break;
+
+ default: /* More than one, so try them in order. */
+ ffesta_confirmed_possible_ = NULL;
+ ffesta_current_possible_ = ffesta_possible_nonexecs_.first;
+ ffesta_current_handler_ = ffesta_current_possible_->handler;
+ if (ffesta_current_handler_ == NULL)
+ {
+ ffesta_current_possible_ = ffesta_possible_execs_.first;
+ ffesta_current_handler_ = ffesta_current_possible_->handler;
+ assert (ffesta_current_handler_ != NULL);
+ if (!ffesta_seen_first_exec)
+ { /* Need to do exec transition now. */
+ ffesta_tokens[0] = ffesta_token_0_;
+ if (!ffestc_exec_transition ())
+ goto no_stmts; /* :::::::::::::::::::: */
+ }
+ }
+ ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_);
+ next = (ffelexHandler) ffesta_save_;
+ ffebad_set_inhibit (TRUE);
+ ffesta_is_inhibited_ = TRUE;
+ break;
+ }
+
+ ffesta_output_pool
+ = malloc_pool_new ("Statement Output", ffe_pool_program_unit (), 1024);
+ ffesta_scratch_pool
+ = malloc_pool_new ("Statement Scratch", ffe_pool_program_unit (), 1024);
+ ffesta_outpooldisp_ = FFESTA_pooldispDISCARD;
+
+ if (ffesta_is_inhibited_)
+ ffesymbol_set_retractable (ffesta_scratch_pool);
+
+ ffelex_set_names (FALSE); /* Most handlers will want this. If not,
+ they have to set it TRUE again (its value
+ at the beginning of a statement). */
+
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffesta_send_two_ -- Send the two tokens saved by ffesta_two after all
+
+ return ffesta_send_two_; // to lexer.
+
+ Currently, if this function gets called, it means that the two tokens
+ saved by ffesta_two did not have their handlers derailed by
+ ffesta_save_, which probably means they weren't sent by ffesta_save_
+ but directly by the lexer, which probably means the original statement
+ (which should be IF (expr) or WHERE (expr)) somehow evaluated to only
+ one possibility in ffesta_second_ or somebody optimized FFEST to
+ immediately revert to one possibility upon confirmation but forgot to
+ change this function (and thus perhaps the entire resubmission
+ mechanism). */
+
+#if !FFESTA_ABORT_ON_CONFIRM_
+static ffelexHandler
+ffesta_send_two_ (ffelexToken t)
+{
+ assert ("what am I doing here?" == NULL);
+ return NULL;
+}
+
+#endif
+/* ffesta_confirmed -- Confirm current possibility as only one
+
+ ffesta_confirmed();
+
+ Sets the confirmation flag. During debugging for ambiguous constructs,
+ asserts that the confirmation flag for a previous possibility has not
+ yet been set. */
+
+void
+ffesta_confirmed ()
+{
+ if (ffesta_inhibit_confirmation_)
+ return;
+ ffesta_confirmed_current_ = TRUE;
+ assert (!ffesta_confirmed_other_
+ || (ffesta_confirmed_possible_ == ffesta_current_possible_));
+ ffesta_confirmed_possible_ = ffesta_current_possible_;
+}
+
+/* ffesta_eof -- End of (non-INCLUDEd) source file
+
+ ffesta_eof();
+
+ Call after piping tokens through ffest_first, where the most recent
+ token sent through must be EOS.
+
+ 20-Feb-91 JCB 1.1
+ Put new EOF token in ffesta_tokens[0], not NULL, because too much
+ code expects something there for error reporting and the like. Also,
+ do basically the same things ffest_second and ffesta_zero do for
+ processing a statement (make and destroy pools, et cetera). */
+
+void
+ffesta_eof ()
+{
+ ffesta_tokens[0] = ffelex_token_new_eof ();
+
+ ffesta_output_pool
+ = malloc_pool_new ("Statement Output", ffe_pool_program_unit (), 1024);
+ ffesta_scratch_pool
+ = malloc_pool_new ("Statement Scratch", ffe_pool_program_unit (), 1024);
+ ffesta_outpooldisp_ = FFESTA_pooldispDISCARD;
+
+ ffestc_eof ();
+
+ if (ffesta_tokens[0] != NULL)
+ ffelex_token_kill (ffesta_tokens[0]);
+
+ if (ffesta_output_pool != NULL)
+ {
+ if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
+ malloc_pool_kill (ffesta_output_pool);
+ ffesta_output_pool = NULL;
+ }
+
+ if (ffesta_scratch_pool != NULL)
+ {
+ malloc_pool_kill (ffesta_scratch_pool);
+ ffesta_scratch_pool = NULL;
+ }
+
+ if (ffesta_label_token != NULL)
+ {
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+ }
+
+ if (ffe_is_ffedebug ())
+ {
+ ffestorag_report ();
+ ffesymbol_report_all ();
+ }
+}
+
+/* ffesta_ffebad_here_current_stmt -- ffebad_here with ptr to current stmt
+
+ ffesta_ffebad_here_current_stmt(0);
+
+ Outsiders can call this fn if they have no more convenient place to
+ point to (via a token or pair of ffewhere objects) and they know a
+ current, useful statement is being evaluted by ffest (i.e. they are
+ being called from ffestb, ffestc, ffestd, ... functions). */
+
+void
+ffesta_ffebad_here_current_stmt (ffebadIndex i)
+{
+ assert (ffesta_tokens[0] != NULL);
+ ffebad_here (i, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+}
+
+/* ffesta_ffebad_start -- Start a possibly inhibited error report
+
+ if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))
+ {
+ ffebad_here, ffebad_string ...;
+ ffebad_finish();
+ }
+
+ Call if the error might indicate that ffest is evaluating the wrong
+ statement form, instead of calling ffebad_start directly. If ffest
+ is choosing between forms, it will return FALSE, send an EOS/SEMICOLON
+ token through as the next token (if the current one isn't already one
+ of those), and try another possible form. Otherwise, ffebad_start is
+ called with the argument and TRUE returned. */
+
+bool
+ffesta_ffebad_start (ffebad errnum)
+{
+ if (!ffesta_is_inhibited_)
+ {
+ ffebad_start (errnum);
+ return TRUE;
+ }
+
+ if (!ffesta_confirmed_current_)
+ ffesta_current_shutdown_ = TRUE;
+
+ return FALSE;
+}
+
+/* ffesta_first -- Parse the first token in a statement
+
+ return ffesta_first; // to lexer. */
+
+ffelexHandler
+ffesta_first (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeEOS:
+ ffesta_tokens[0] = ffelex_token_use (t);
+ if (ffesta_label_token != NULL)
+ {
+ ffebad_start (FFEBAD_LABEL_WITHOUT_STMT);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_string (ffelex_token_text (ffesta_label_token));
+ ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffesta_token_0_ = ffelex_token_use (t);
+ ffesta_first_kw = ffestr_first (t);
+ return (ffelexHandler) ffesta_second_;
+
+ case FFELEX_typeNUMBER:
+ if (ffesta_line_has_semicolons
+ && !ffe_is_free_form ()
+ && ffe_is_pedantic ())
+ {
+ ffebad_start (FFEBAD_LABEL_WRONG_PLACE);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (ffelex_token_text (t));
+ ffebad_finish ();
+ }
+ if (ffesta_label_token == NULL)
+ {
+ ffesta_label_token = ffelex_token_use (t);
+ return (ffelexHandler) ffesta_first;
+ }
+ else
+ {
+ ffebad_start (FFEBAD_EXTRA_LABEL_DEF);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_string (ffelex_token_text (t));
+ ffebad_here (1, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_string (ffelex_token_text (ffesta_label_token));
+ ffebad_finish ();
+
+ return (ffelexHandler) ffesta_first;
+ }
+
+ default: /* Invalid first token. */
+ ffesta_tokens[0] = ffelex_token_use (t);
+ ffebad_start (FFEBAD_STMT_BEGINS_BAD);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffesta_init_0 -- Initialize for entire image invocation
+
+ ffesta_init_0();
+
+ Call just once per invocation of the compiler (not once per invocation
+ of the front end).
+
+ Gets memory for the list of possibles once and for all, since this
+ list never gets larger than a certain size (FFESTA_maxPOSSIBLES_)
+ and is not particularly large. Initializes the array of pointers to
+ this list. Initializes the executable and nonexecutable lists. */
+
+void
+ffesta_init_0 ()
+{
+ ffestaPossible_ ptr;
+ int i;
+
+ ptr = (ffestaPossible_) malloc_new_kp (malloc_pool_image (),
+ "FFEST possibles",
+ FFESTA_maxPOSSIBLES_
+ * sizeof (*ptr));
+
+ for (i = 0; i < FFESTA_maxPOSSIBLES_; ++i)
+ ffesta_possibles_[i] = ptr++;
+
+ ffesta_possible_execs_.first = ffesta_possible_execs_.last
+ = (ffestaPossible_) &ffesta_possible_execs_.first;
+ ffesta_possible_nonexecs_.first = ffesta_possible_nonexecs_.last
+ = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
+ ffesta_possible_execs_.nil = ffesta_possible_nonexecs_.nil = NULL;
+}
+
+/* ffesta_init_3 -- Initialize for any program unit
+
+ ffesta_init_3(); */
+
+void
+ffesta_init_3 ()
+{
+ ffesta_output_pool = NULL; /* May be doing this just before reaching */
+ ffesta_scratch_pool = NULL; /* ffesta_zero or ffesta_two. */
+ /* NOTE: we let the ffe_terminate_2 action of killing the program_unit pool
+ handle the killing of the output and scratch pools for us, which is why
+ we don't have a terminate_3 action to do so. */
+ ffesta_construct_name = NULL;
+ ffesta_label_token = NULL;
+ ffesta_seen_first_exec = FALSE;
+}
+
+/* ffesta_is_inhibited -- Test whether the current possibility is inhibited
+
+ if (!ffesta_is_inhibited())
+ // implement the statement.
+
+ Just make sure the current possibility has been confirmed. If anyone
+ really needs to test whether the current possibility is inhibited prior
+ to confirming it, that indicates a need to begin statement processing
+ before it is certain that the given possibility is indeed the statement
+ to be processed. As of this writing, there does not appear to be such
+ a need. If there is, then when confirming a statement would normally
+ immediately disable the inhibition (whereas currently we leave the
+ confirmed statement disabled until we've tried the other possibilities,
+ to check for ambiguities), we must check to see if the possibility has
+ already tested for inhibition prior to confirmation and, if so, maintain
+ inhibition until the end of the statement (which may be forced right
+ away) and then rerun the entire statement from the beginning. Otherwise,
+ initial calls to ffestb functions won't have been made, but subsequent
+ calls (after confirmation) will, which is wrong. Of course, this all
+ applies only to those statements implemented via multiple calls to
+ ffestb, although if a statement requiring only a single ffestb call
+ tested for inhibition prior to confirmation, it would likely mean that
+ the ffestb call would be completely dropped without this mechanism. */
+
+bool
+ffesta_is_inhibited ()
+{
+ assert (ffesta_confirmed_current_ || ffesta_inhibit_confirmation_);
+ return ffesta_is_inhibited_;
+}
+
+/* ffesta_ffebad_1p -- Issue diagnostic with one source character
+
+ ffelexToken names_token;
+ ffeTokenLength index;
+ ffelexToken next_token;
+ ffesta_ffebad_1p(FFEBAD_SOME_ERROR,names_token,index,next_token);
+
+ Equivalent to "if (ffest_ffebad_start(FFEBAD_SOME_ERROR))" followed by
+ sending one argument, the location of index with names_token, if TRUE is
+ returned. If index is equal to the length of names_token, meaning it
+ points to the end of the token, then uses the location in next_token
+ (which should be the token sent by the lexer after it sent names_token)
+ instead. */
+
+void
+ffesta_ffebad_1p (ffebad errnum, ffelexToken names_token, ffeTokenLength index,
+ ffelexToken next_token)
+{
+ ffewhereLine line;
+ ffewhereColumn col;
+
+ assert (index <= ffelex_token_length (names_token));
+
+ if (ffesta_ffebad_start (errnum))
+ {
+ if (index == ffelex_token_length (names_token))
+ {
+ assert (next_token != NULL);
+ line = ffelex_token_where_line (next_token);
+ col = ffelex_token_where_column (next_token);
+ ffebad_here (0, line, col);
+ }
+ else
+ {
+ ffewhere_set_from_track (&line, &col,
+ ffelex_token_where_line (names_token),
+ ffelex_token_where_column (names_token),
+ ffelex_token_wheretrack (names_token),
+ index);
+ ffebad_here (0, line, col);
+ ffewhere_line_kill (line);
+ ffewhere_column_kill (col);
+ }
+ ffebad_finish ();
+ }
+}
+
+void
+ffesta_ffebad_1sp (ffebad errnum, char *s, ffelexToken names_token,
+ ffeTokenLength index, ffelexToken next_token)
+{
+ ffewhereLine line;
+ ffewhereColumn col;
+
+ assert (index <= ffelex_token_length (names_token));
+
+ if (ffesta_ffebad_start (errnum))
+ {
+ ffebad_string (s);
+ if (index == ffelex_token_length (names_token))
+ {
+ assert (next_token != NULL);
+ line = ffelex_token_where_line (next_token);
+ col = ffelex_token_where_column (next_token);
+ ffebad_here (0, line, col);
+ }
+ else
+ {
+ ffewhere_set_from_track (&line, &col,
+ ffelex_token_where_line (names_token),
+ ffelex_token_where_column (names_token),
+ ffelex_token_wheretrack (names_token),
+ index);
+ ffebad_here (0, line, col);
+ ffewhere_line_kill (line);
+ ffewhere_column_kill (col);
+ }
+ ffebad_finish ();
+ }
+}
+
+void
+ffesta_ffebad_1st (ffebad errnum, char *s, ffelexToken t)
+{
+ if (ffesta_ffebad_start (errnum))
+ {
+ ffebad_string (s);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+}
+
+/* ffesta_ffebad_1t -- Issue diagnostic with one source token
+
+ ffelexToken t;
+ ffesta_ffebad_1t(FFEBAD_SOME_ERROR,t);
+
+ Equivalent to "if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))" followed by
+ sending one argument, the location of the token t, if TRUE is returned. */
+
+void
+ffesta_ffebad_1t (ffebad errnum, ffelexToken t)
+{
+ if (ffesta_ffebad_start (errnum))
+ {
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+}
+
+void
+ffesta_ffebad_2st (ffebad errnum, char *s, ffelexToken t1, ffelexToken t2)
+{
+ if (ffesta_ffebad_start (errnum))
+ {
+ ffebad_string (s);
+ ffebad_here (0, ffelex_token_where_line (t1), ffelex_token_where_column (t1));
+ ffebad_here (1, ffelex_token_where_line (t2), ffelex_token_where_column (t2));
+ ffebad_finish ();
+ }
+}
+
+/* ffesta_ffebad_2t -- Issue diagnostic with two source tokens
+
+ ffelexToken t1, t2;
+ ffesta_ffebad_2t(FFEBAD_SOME_ERROR,t1,t2);
+
+ Equivalent to "if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))" followed by
+ sending two argument, the locations of the tokens t1 and t2, if TRUE is
+ returned. */
+
+void
+ffesta_ffebad_2t (ffebad errnum, ffelexToken t1, ffelexToken t2)
+{
+ if (ffesta_ffebad_start (errnum))
+ {
+ ffebad_here (0, ffelex_token_where_line (t1), ffelex_token_where_column (t1));
+ ffebad_here (1, ffelex_token_where_line (t2), ffelex_token_where_column (t2));
+ ffebad_finish ();
+ }
+}
+
+/* ffesta_set_outpooldisp -- Set disposition of statement output pool
+
+ ffesta_set_outpooldisp(FFESTA_pooldispPRESERVE); */
+
+void
+ffesta_set_outpooldisp (ffestaPooldisp d)
+{
+ ffesta_outpooldisp_ = d;
+}
+
+/* Shut down current parsing possibility, but without bothering the
+ user with a diagnostic if we're not inhibited. */
+
+void
+ffesta_shutdown ()
+{
+ if (ffesta_is_inhibited_)
+ ffesta_current_shutdown_ = TRUE;
+}
+
+/* ffesta_two -- Deal with the first two tokens after a swallowed statement
+
+ return ffesta_two(first_token,second_token); // to lexer.
+
+ Like ffesta_zero, except instead of expecting an EOS or SEMICOLON, it
+ expects the first two tokens of a statement that is part of another
+ statement: the first two tokens of statement in "IF (expr) statement" or
+ "WHERE (expr) statement", in particular. The first token must be a NAME
+ or NAMES, the second can be basically anything. The statement type MUST
+ be confirmed by now.
+
+ If we're not inhibited, just handle things as if we were ffesta_zero
+ and saw an EOS just before the two tokens.
+
+ If we're inhibited, set ffesta_current_shutdown_ to shut down the current
+ statement and continue with other possibilities, then (presumably) come
+ back to this one for real when not inhibited. */
+
+ffelexHandler
+ffesta_two (ffelexToken first, ffelexToken second)
+{
+#if FFESTA_ABORT_ON_CONFIRM_
+ ffelexHandler next;
+#endif
+
+ assert ((ffelex_token_type (first) == FFELEX_typeNAME)
+ || (ffelex_token_type (first) == FFELEX_typeNAMES));
+ assert (ffesta_tokens[0] != NULL);
+
+ if (ffesta_is_inhibited_) /* Oh, not really done with statement. */
+ {
+ ffesta_current_shutdown_ = TRUE;
+ /* To catch the EOS on shutdown. */
+ return (ffelexHandler) ffelex_swallow_tokens (second,
+ (ffelexHandler) ffesta_zero);
+ }
+
+ ffestw_display_state ();
+
+ ffelex_token_kill (ffesta_tokens[0]);
+
+ if (ffesta_output_pool != NULL)
+ {
+ if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
+ malloc_pool_kill (ffesta_output_pool);
+ ffesta_output_pool = NULL;
+ }
+
+ if (ffesta_scratch_pool != NULL)
+ {
+ malloc_pool_kill (ffesta_scratch_pool);
+ ffesta_scratch_pool = NULL;
+ }
+
+ ffesta_reset_possibles_ ();
+ ffesta_confirmed_current_ = FALSE;
+
+ /* What happens here is somewhat interesting. We effectively derail the
+ line of handlers for these two tokens, the first two in a statement, by
+ setting a flag to TRUE. This flag tells ffesta_save_ (or, conceivably,
+ the lexer via ffesta_second_'s case 1:, where it has only one possible
+ kind of statement -- someday this will be more likely, i.e. after
+ confirmation causes an immediate switch to only the one context rather
+ than just setting a flag and running through the remaining possibles to
+ look for ambiguities) that the last two tokens it sent did not reach the
+ truly desired targets (ffest_first and ffesta_second_) since that would
+ otherwise attempt to recursively invoke ffesta_save_ in most cases,
+ while the existing ffesta_save_ was still alive and making use of static
+ (nonrecursive) variables. Instead, ffesta_save_, upon seeing this flag
+ set TRUE, sets it to FALSE and resubmits the two tokens copied here to
+ ffest_first and, presumably, ffesta_second_, kills them, and returns the
+ handler returned by the handler for the second token. Thus, even though
+ ffesta_save_ is still (likely to be) recursively invoked, the former
+ invocation is past the use of any static variables possibly changed
+ during the first-two-token invocation of the latter invocation. */
+
+#if FFESTA_ABORT_ON_CONFIRM_
+ /* Shouldn't be in ffesta_save_ at all here. */
+
+ next = (ffelexHandler) ffesta_first (first);
+ return (ffelexHandler) (*next) (second);
+#else
+ ffesta_twotokens_1_ = ffelex_token_use (first);
+ ffesta_twotokens_2_ = ffelex_token_use (second);
+
+ ffesta_is_two_into_statement_ = TRUE;
+ return (ffelexHandler) ffesta_send_two_; /* Shouldn't get called. */
+#endif
+}
+
+/* ffesta_zero -- Deal with the end of a swallowed statement
+
+ return ffesta_zero; // to lexer.
+
+ NOTICE that this code is COPIED, largely, into a
+ similar function named ffesta_two that gets invoked in place of
+ _zero_ when the end of the statement happens before EOS or SEMICOLON and
+ to tokens into the next statement have been read (as is the case with the
+ logical-IF and WHERE-stmt statements). So any changes made here should
+ probably be made in _two_ at the same time. */
+
+ffelexHandler
+ffesta_zero (ffelexToken t)
+{
+ assert ((ffelex_token_type (t) == FFELEX_typeEOS)
+ || (ffelex_token_type (t) == FFELEX_typeSEMICOLON));
+ assert (ffesta_tokens[0] != NULL);
+
+ if (ffesta_is_inhibited_)
+ ffesymbol_retract (TRUE);
+ else
+ ffestw_display_state ();
+
+ /* Do CONTINUE if nothing else. This is done specifically so that "IF
+ (...) BLAH" causes the same things to happen as if "IF (...) CONTINUE"
+ was done, so that tracking of labels and such works. (Try a small
+ program like "DO 10 ...", "IF (...) BLAH", "10 CONTINUE", "END".)
+
+ But it turns out that just testing "!ffesta_confirmed_current_"
+ isn't enough, because then typing "GOTO" instead of "BLAH" above
+ doesn't work -- the statement is confirmed (we know the user
+ attempted a GOTO) but ffestc hasn't seen it. So, instead, just
+ always tell ffestc to do "any" statement it needs to to reset. */
+
+ if (!ffesta_is_inhibited_
+ && ffesta_seen_first_exec)
+ {
+ ffestc_any ();
+ }
+
+ ffelex_token_kill (ffesta_tokens[0]);
+
+ if (ffesta_is_inhibited_) /* Oh, not really done with statement. */
+ return (ffelexHandler) ffesta_zero; /* Call me again when done! */
+
+ if (ffesta_output_pool != NULL)
+ {
+ if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
+ malloc_pool_kill (ffesta_output_pool);
+ ffesta_output_pool = NULL;
+ }
+
+ if (ffesta_scratch_pool != NULL)
+ {
+ malloc_pool_kill (ffesta_scratch_pool);
+ ffesta_scratch_pool = NULL;
+ }
+
+ ffesta_reset_possibles_ ();
+ ffesta_confirmed_current_ = FALSE;
+
+ if (ffelex_token_type (t) == FFELEX_typeSEMICOLON)
+ {
+ ffesta_line_has_semicolons = TRUE;
+ if (ffe_is_pedantic_not_90 ())
+ {
+ ffebad_start (FFEBAD_SEMICOLON);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ }
+ else
+ ffesta_line_has_semicolons = FALSE;
+
+ if (ffesta_label_token != NULL)
+ {
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+ }
+
+ if (ffe_is_ffedebug ())
+ {
+ ffestorag_report ();
+ ffesymbol_report_all ();
+ }
+
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffesta_first;
+}
diff --git a/gcc/f/sta.h b/gcc/f/sta.h
new file mode 100644
index 00000000000..132d0e84d4b
--- /dev/null
+++ b/gcc/f/sta.h
@@ -0,0 +1,116 @@
+/* sta.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ sta.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_sta
+#define _H_f_sta
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFESTA_pooldispDISCARD, /* Default state. */
+ FFESTA_pooldispPRESERVE, /* Preserve through end of program unit. */
+ FFESTA_pooldisp
+ } ffestaPooldisp;
+
+#define FFESTA_tokensMAX 10 /* Max # tokens in fixed positions. */
+
+/* Typedefs. */
+
+/* Include files needed by this one. */
+
+#include "bad.h"
+#include "lex.h"
+#include "malloc.h"
+#include "str.h"
+#include "symbol.h"
+
+typedef mallocPool ffestaPool; /* No need for use count yet. */
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+extern ffelexToken ffesta_tokens[FFESTA_tokensMAX];
+extern ffestrFirst ffesta_first_kw;
+extern ffestrSecond ffesta_second_kw;
+extern mallocPool ffesta_output_pool;
+extern mallocPool ffesta_scratch_pool;
+extern ffelexToken ffesta_construct_name;
+extern ffelexToken ffesta_label_token;
+extern bool ffesta_seen_first_exec;
+extern bool ffesta_is_entry_valid;
+extern bool ffesta_line_has_semicolons;
+
+/* Declare functions with prototypes. */
+
+void ffesta_confirmed (void);
+void ffesta_eof (void);
+bool ffesta_ffebad_start (ffebad errnum);
+void ffesta_ffebad_here_current_stmt (ffebadIndex i);
+ffelexHandler ffesta_first (ffelexToken t);
+void ffesta_init_0 (void);
+void ffesta_init_3 (void);
+bool ffesta_is_inhibited (void);
+void ffesta_terminate_0 (void);
+void ffesta_terminate_1 (void);
+void ffesta_terminate_2 (void);
+void ffesta_terminate_3 (void);
+void ffesta_terminate_4 (void);
+void ffesta_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
+void ffesta_shutdown (void);
+ffesymbol ffesta_sym_end_transition (ffesymbol s);
+ffesymbol ffesta_sym_exec_transition (ffesymbol s);
+void ffesta_ffebad_1p (ffebad msg, ffelexToken names_token,
+ ffeTokenLength index, ffelexToken next_token);
+void ffesta_ffebad_1sp (ffebad msg, char *s, ffelexToken names_token,
+ ffeTokenLength index, ffelexToken next_token);
+void ffesta_ffebad_1st (ffebad msg, char *s, ffelexToken t);
+void ffesta_ffebad_1t (ffebad msg, ffelexToken t);
+void ffesta_ffebad_2st (ffebad msg, char *s, ffelexToken t1, ffelexToken t2);
+void ffesta_ffebad_2t (ffebad msg, ffelexToken t1, ffelexToken t2);
+ffelexHandler ffesta_zero (ffelexToken t);
+ffelexHandler ffesta_two (ffelexToken first, ffelexToken second);
+void ffesta_set_outpooldisp (ffestaPooldisp d);
+
+/* Define macros. */
+
+#define ffesta_init_1()
+#define ffesta_init_2()
+#define ffesta_init_4()
+#define ffesta_terminate_0()
+#define ffesta_terminate_1()
+#define ffesta_terminate_2()
+#define ffesta_terminate_3()
+#define ffesta_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/stb.c b/gcc/f/stb.c
new file mode 100644
index 00000000000..90ecc5f8f47
--- /dev/null
+++ b/gcc/f/stb.c
@@ -0,0 +1,25192 @@
+/* stb.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ st.c
+
+ Description:
+ Parses the proper form for statements, builds up expression trees for
+ them, but does not actually implement them. Uses ffebad (primarily via
+ ffesta_ffebad_start) to indicate errors in form. In many cases, an invalid
+ statement form indicates another possible statement needs to be looked at
+ by ffest. In a few cases, a valid statement form might not completely
+ determine the nature of the statement, as in REALFUNCTIONA(B), which is
+ a valid form for either the first statement of a function named A taking
+ an argument named B or for the declaration of a real array named FUNCTIONA
+ with an adjustable size of B. A similar (though somewhat easier) choice
+ must be made for the statement-function-def vs. assignment forms, as in
+ the case of FOO(A) = A+2.0.
+
+ A given parser consists of one or more state handlers, the first of which
+ is the initial state, and the last of which (for any given input) returns
+ control to a final state handler (ffesta_zero or ffesta_two, explained
+ below). The functions handling the states for a given parser usually have
+ the same names, differing only in the final number, as in ffestb_foo_
+ (handles the initial state), ffestb_foo_1_, ffestb_foo_2_ (handle
+ subsequent states), although liberties sometimes are taken with the "foo"
+ part either when keywords are clarified into given statements or are
+ transferred into other possible areas. (For example, the type-name
+ states can hop over to _dummy_ functions when the FUNCTION or RECURSIVE
+ keywords are seen, though this kind of thing is kept to a minimum.) Only
+ the names without numbers are exported to the rest of ffest; the others
+ are local (static).
+
+ Each initial state is provided with the first token in ffesta_tokens[0],
+ which will be killed upon return to the final state (ffesta_zero or
+ ffelex_swallow_tokens passed through to ffesta_zero), so while it may
+ be changed to another token, a valid token must be left there to be
+ killed. Also, a "convenient" array of tokens are left in
+ ffesta_tokens[1..FFESTA_tokensMAX]. The initial state of this set of
+ elements is undefined, thus, if tokens are stored here, they must be
+ killed before returning to the final state. Any parser may also use
+ cross-state local variables by sticking a structure containing storage
+ for those variables in the local union ffestb_local_ (unless the union
+ goes on strike). Furthermore, parsers that handle more than one first or
+ second tokens (like _varlist_, which handles EXTERNAL, INTENT, INTRINSIC,
+ OPTIONAL,
+ PUBLIC, or PRIVATE, and _endxyz_, which handles ENDBLOCK, ENDBLOCKDATA,
+ ENDDO, ENDIF, and so on) may expect arguments from ffest in the
+ ffest-wide union ffest_args_, the substructure specific to the parser.
+
+ A parser's responsibility is: to call either ffesta_confirmed or
+ ffest_ffebad_start before returning to the final state; to be the only
+ parser that can possibly call ffesta_confirmed for a given statement;
+ to call ffest_ffebad_start immediately upon recognizing a bad token
+ (specifically one that another statement parser might confirm upon);
+ to call ffestc functions only after calling ffesta_confirmed and only
+ when ffesta_is_inhibited returns FALSE; and to call ffesta_is_inhibited
+ only after calling ffesta_confirmed. Confirm as early as reasonably
+ possible, even when only one ffestc function is called for the statement
+ later on, because early confirmation can enhance the error-reporting
+ capabilities if a subsequent error is detected and this parser isn't
+ the first possibility for the statement.
+
+ To assist the parser, functions like ffesta_ffebad_1t and _1p_ have
+ been provided to make use of ffest_ffebad_start fairly easy.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "stb.h"
+#include "bad.h"
+#include "expr.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#include "sta.h"
+#include "stc.h"
+#include "stp.h"
+#include "str.h"
+
+/* Externals defined here. */
+
+struct _ffestb_args_ ffestb_args;
+
+/* Simple definitions and enumerations. */
+
+#define FFESTB_KILL_EASY_ 1 /* 1 for only one _subr_kill_xyz_ fn. */
+
+/* Internal typedefs. */
+
+union ffestb_subrargs_u_
+ {
+ struct
+ {
+ ffesttTokenList labels; /* Input arg, must not be NULL. */
+ ffelexHandler handler; /* Input arg, call me when done. */
+ bool ok; /* Output arg, TRUE if list ended in
+ CLOSE_PAREN. */
+ }
+ label_list;
+ struct
+ {
+ ffesttDimList dims; /* Input arg, must not be NULL. */
+ ffelexHandler handler; /* Input arg, call me when done. */
+ mallocPool pool; /* Pool to allocate into. */
+ bool ok; /* Output arg, TRUE if list ended in
+ CLOSE_PAREN. */
+ ffeexprContext ctx; /* DIMLIST or DIMLISTCOMMON. */
+#ifdef FFECOM_dimensionsMAX
+ int ndims; /* For backends that really can't have
+ infinite dims. */
+#endif
+ }
+ dim_list;
+ struct
+ {
+ ffesttTokenList args; /* Input arg, must not be NULL. */
+ ffelexHandler handler; /* Input arg, call me when done. */
+ ffelexToken close_paren;/* Output arg if ok, CLOSE_PAREN token. */
+ bool is_subr; /* Input arg, TRUE if list in subr-def
+ context. */
+ bool ok; /* Output arg, TRUE if list ended in
+ CLOSE_PAREN. */
+ bool names; /* Do ffelex_set_names(TRUE) before return. */
+ }
+ name_list;
+ };
+
+union ffestb_local_u_
+ {
+ struct
+ {
+ ffebld expr;
+ }
+ call_stmt;
+ struct
+ {
+ ffebld expr;
+ }
+ go_to;
+ struct
+ {
+ ffebld dest;
+ bool vxtparam; /* If assignment might really be VXT
+ PARAMETER stmt. */
+ }
+ let;
+ struct
+ {
+ ffebld expr;
+ }
+ if_stmt;
+ struct
+ {
+ ffebld expr;
+ }
+ else_stmt;
+ struct
+ {
+ ffebld expr;
+ }
+ dowhile;
+ struct
+ {
+ ffebld var;
+ ffebld start;
+ ffebld end;
+ }
+ do_stmt;
+ struct
+ {
+ bool is_cblock;
+ }
+ R522;
+ struct
+ {
+ ffebld expr;
+ bool started;
+ }
+ parameter;
+ struct
+ {
+ ffesttExprList exprs;
+ bool started;
+ }
+ equivalence;
+ struct
+ {
+ ffebld expr;
+ bool started;
+ }
+ data;
+ struct
+ {
+ ffestrOther kw;
+ }
+ varlist;
+#if FFESTR_F90
+ struct
+ {
+ ffestrOther kw;
+ }
+ type;
+#endif
+ struct
+ {
+ ffelexHandler next;
+ }
+ construct;
+ struct
+ {
+ ffesttFormatList f;
+ ffestpFormatType current; /* What we're currently working on. */
+ ffelexToken t; /* Token of what we're currently working on. */
+ ffesttFormatValue pre;
+ ffesttFormatValue post;
+ ffesttFormatValue dot;
+ ffesttFormatValue exp;
+ bool sign; /* _3_, pos/neg; elsewhere, signed/unsigned. */
+ bool complained; /* If run-time expr seen in nonexec context. */
+ }
+ format;
+#if FFESTR_F90
+ struct
+ {
+ bool started;
+ }
+ moduleprocedure;
+#endif
+ struct
+ {
+ ffebld expr;
+ }
+ selectcase;
+ struct
+ {
+ ffesttCaseList cases;
+ }
+ case_stmt;
+#if FFESTR_F90
+ struct
+ {
+ ffesttExprList exprs;
+ ffebld expr;
+ }
+ heap;
+#endif
+#if FFESTR_F90
+ struct
+ {
+ ffesttExprList exprs;
+ }
+ R624;
+#endif
+#if FFESTR_F90
+ struct
+ {
+ ffestpDefinedOperator operator;
+ bool assignment; /* TRUE for INTERFACE ASSIGNMENT, FALSE for
+ ...OPERATOR. */
+ bool slash; /* TRUE if OPEN_ARRAY, FALSE if OPEN_PAREN. */
+ }
+ interface;
+#endif
+ struct
+ {
+ bool is_cblock;
+ }
+ V014;
+#if FFESTR_VXT
+ struct
+ {
+ bool started;
+ ffebld u;
+ ffebld m;
+ ffebld n;
+ ffebld asv;
+ }
+ V025;
+#endif
+ struct
+ {
+ ffestpBeruIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ beru;
+ struct
+ {
+ ffestpCloseIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ close;
+ struct
+ {
+ ffestpDeleteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ delete;
+ struct
+ {
+ ffestpDeleteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ find;
+ struct
+ {
+ ffestpInquireIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ bool may_be_iolength;
+ }
+ inquire;
+ struct
+ {
+ ffestpOpenIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ open;
+ struct
+ {
+ ffestpReadIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ read;
+ struct
+ {
+ ffestpRewriteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ rewrite;
+ struct
+ {
+ ffestpWriteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ vxtcode;
+ struct
+ {
+ ffestpWriteIx ix;
+ bool label;
+ bool left;
+ ffeexprContext context;
+ }
+ write;
+#if FFESTR_F90
+ struct
+ {
+ bool started;
+ }
+ structure;
+#endif
+ struct
+ {
+ bool started;
+ }
+ common;
+ struct
+ {
+ bool started;
+ }
+ dimension;
+ struct
+ {
+ bool started;
+ }
+ dimlist;
+ struct
+ {
+ char *badname;
+ ffestrFirst first_kw;
+ bool is_subr;
+ }
+ dummy;
+ struct
+ {
+ ffebld kind; /* Kind type parameter, if any. */
+ ffelexToken kindt; /* Kind type first token, if any. */
+ ffebld len; /* Length type parameter, if any. */
+ ffelexToken lent; /* Length type parameter, if any. */
+ ffelexHandler handler;
+ ffelexToken recursive;
+ ffebld expr;
+ ffesttTokenList toklist;/* For ambiguity resolution. */
+ ffesttImpList imps; /* List of IMPLICIT letters. */
+ ffelexHandler imp_handler; /* Call if paren list wasn't letters. */
+ char *badname;
+ ffestrOther kw; /* INTENT(IN/OUT/INOUT). */
+ ffestpType type;
+ bool parameter; /* If PARAMETER attribute seen (governs =expr
+ context). */
+ bool coloncolon; /* If COLONCOLON seen (allows =expr). */
+ bool aster_after; /* "*" seen after, not before,
+ [RECURSIVE]FUNCTIONxyz. */
+ bool empty; /* Ambig function dummy arg list empty so
+ far? */
+ bool imp_started; /* Started IMPLICIT statement already. */
+ bool imp_seen_comma; /* TRUE if next COMMA within parens means not
+ R541. */
+ }
+ decl;
+ struct
+ {
+ bool started;
+ }
+ vxtparam;
+ }; /* Merge with the one in ffestb later. */
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+static union ffestb_subrargs_u_ ffestb_subrargs_;
+static union ffestb_local_u_ ffestb_local_;
+
+/* Static functions (internal). */
+
+static void ffestb_subr_ambig_to_ents_ (void);
+static ffelexHandler ffestb_subr_ambig_nope_ (ffelexToken t);
+static ffelexHandler ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_subr_name_list_ (ffelexToken t);
+static ffelexHandler ffestb_subr_name_list_1_ (ffelexToken t);
+static void ffestb_subr_R1001_append_p_ (void);
+static ffelexHandler ffestb_decl_kindparam_ (ffelexToken t);
+static ffelexHandler ffestb_decl_kindparam_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_starkind_ (ffelexToken t);
+static ffelexHandler ffestb_decl_starlen_ (ffelexToken t);
+static ffelexHandler ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_typeparams_ (ffelexToken t);
+static ffelexHandler ffestb_decl_typeparams_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_typetype1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_typetype2_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
+static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
+static ffelexHandler ffestb_do1_ (ffelexToken t);
+static ffelexHandler ffestb_do2_ (ffelexToken t);
+static ffelexHandler ffestb_do3_ (ffelexToken t);
+static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_do5_ (ffelexToken t);
+static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_else1_ (ffelexToken t);
+static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_else3_ (ffelexToken t);
+static ffelexHandler ffestb_else4_ (ffelexToken t);
+static ffelexHandler ffestb_else5_ (ffelexToken t);
+static ffelexHandler ffestb_end1_ (ffelexToken t);
+static ffelexHandler ffestb_end2_ (ffelexToken t);
+static ffelexHandler ffestb_end3_ (ffelexToken t);
+static ffelexHandler ffestb_goto1_ (ffelexToken t);
+static ffelexHandler ffestb_goto2_ (ffelexToken t);
+static ffelexHandler ffestb_goto3_ (ffelexToken t);
+static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_goto6_ (ffelexToken t);
+static ffelexHandler ffestb_goto7_ (ffelexToken t);
+static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_if2_ (ffelexToken t);
+static ffelexHandler ffestb_if3_ (ffelexToken t);
+static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_type1_ (ffelexToken t);
+static ffelexHandler ffestb_type2_ (ffelexToken t);
+static ffelexHandler ffestb_type3_ (ffelexToken t);
+static ffelexHandler ffestb_type4_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_varlist1_ (ffelexToken t);
+static ffelexHandler ffestb_varlist2_ (ffelexToken t);
+static ffelexHandler ffestb_varlist3_ (ffelexToken t);
+static ffelexHandler ffestb_varlist4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_varlist5_ (ffelexToken t);
+static ffelexHandler ffestb_varlist6_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_where1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_where2_ (ffelexToken t);
+static ffelexHandler ffestb_where3_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R5221_ (ffelexToken t);
+static ffelexHandler ffestb_R5222_ (ffelexToken t);
+static ffelexHandler ffestb_R5223_ (ffelexToken t);
+static ffelexHandler ffestb_R5224_ (ffelexToken t);
+static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5284_ (ffelexToken t);
+static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5373_ (ffelexToken t);
+static ffelexHandler ffestb_R5421_ (ffelexToken t);
+static ffelexHandler ffestb_R5422_ (ffelexToken t);
+static ffelexHandler ffestb_R5423_ (ffelexToken t);
+static ffelexHandler ffestb_R5424_ (ffelexToken t);
+static ffelexHandler ffestb_R5425_ (ffelexToken t);
+static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R5443_ (ffelexToken t);
+static ffelexHandler ffestb_R5444_ (ffelexToken t);
+static ffelexHandler ffestb_R8341_ (ffelexToken t);
+static ffelexHandler ffestb_R8351_ (ffelexToken t);
+static ffelexHandler ffestb_R8381_ (ffelexToken t);
+static ffelexHandler ffestb_R8382_ (ffelexToken t);
+static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R8402_ (ffelexToken t);
+static ffelexHandler ffestb_R8403_ (ffelexToken t);
+static ffelexHandler ffestb_R8404_ (ffelexToken t);
+static ffelexHandler ffestb_R8405_ (ffelexToken t);
+static ffelexHandler ffestb_R8406_ (ffelexToken t);
+static ffelexHandler ffestb_R8407_ (ffelexToken t);
+static ffelexHandler ffestb_R11021_ (ffelexToken t);
+static ffelexHandler ffestb_R1111_1_ (ffelexToken t);
+static ffelexHandler ffestb_R1111_2_ (ffelexToken t);
+static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_construct1_ (ffelexToken t);
+static ffelexHandler ffestb_construct2_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_heap1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_heap2_ (ffelexToken t);
+static ffelexHandler ffestb_heap3_ (ffelexToken t);
+static ffelexHandler ffestb_heap4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_heap5_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_module1_ (ffelexToken t);
+static ffelexHandler ffestb_module2_ (ffelexToken t);
+static ffelexHandler ffestb_module3_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R8091_ (ffelexToken t);
+static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R8093_ (ffelexToken t);
+static ffelexHandler ffestb_R8101_ (ffelexToken t);
+static ffelexHandler ffestb_R8102_ (ffelexToken t);
+static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R10011_ (ffelexToken t);
+static ffelexHandler ffestb_R10012_ (ffelexToken t);
+static ffelexHandler ffestb_R10013_ (ffelexToken t);
+static ffelexHandler ffestb_R10014_ (ffelexToken t);
+static ffelexHandler ffestb_R10015_ (ffelexToken t);
+static ffelexHandler ffestb_R10016_ (ffelexToken t);
+static ffelexHandler ffestb_R10017_ (ffelexToken t);
+static ffelexHandler ffestb_R10018_ (ffelexToken t);
+static ffelexHandler ffestb_R10019_ (ffelexToken t);
+static ffelexHandler ffestb_R100110_ (ffelexToken t);
+static ffelexHandler ffestb_R100111_ (ffelexToken t);
+static ffelexHandler ffestb_R100112_ (ffelexToken t);
+static ffelexHandler ffestb_R100113_ (ffelexToken t);
+static ffelexHandler ffestb_R100114_ (ffelexToken t);
+static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_R11071_ (ffelexToken t);
+static ffelexHandler ffestb_R11072_ (ffelexToken t);
+static ffelexHandler ffestb_R11073_ (ffelexToken t);
+static ffelexHandler ffestb_R11074_ (ffelexToken t);
+static ffelexHandler ffestb_R11075_ (ffelexToken t);
+static ffelexHandler ffestb_R11076_ (ffelexToken t);
+static ffelexHandler ffestb_R11077_ (ffelexToken t);
+static ffelexHandler ffestb_R11078_ (ffelexToken t);
+static ffelexHandler ffestb_R11079_ (ffelexToken t);
+static ffelexHandler ffestb_R110710_ (ffelexToken t);
+static ffelexHandler ffestb_R110711_ (ffelexToken t);
+static ffelexHandler ffestb_R110712_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_R12021_ (ffelexToken t);
+static ffelexHandler ffestb_R12022_ (ffelexToken t);
+static ffelexHandler ffestb_R12023_ (ffelexToken t);
+static ffelexHandler ffestb_R12024_ (ffelexToken t);
+static ffelexHandler ffestb_R12025_ (ffelexToken t);
+static ffelexHandler ffestb_R12026_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_S3P41_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0141_ (ffelexToken t);
+static ffelexHandler ffestb_V0142_ (ffelexToken t);
+static ffelexHandler ffestb_V0143_ (ffelexToken t);
+static ffelexHandler ffestb_V0144_ (ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0251_ (ffelexToken t);
+static ffelexHandler ffestb_V0252_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0253_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0254_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0255_ (ffelexToken t);
+static ffelexHandler ffestb_V0256_ (ffelexToken t);
+static ffelexHandler ffestb_V0257_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0258_ (ffelexToken t);
+#endif
+#if FFESTB_KILL_EASY_
+static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
+#else
+static void ffestb_subr_kill_accept_ (void);
+static void ffestb_subr_kill_beru_ (void);
+static void ffestb_subr_kill_close_ (void);
+static void ffestb_subr_kill_delete_ (void);
+static void ffestb_subr_kill_find_ (void); /* Not written yet. */
+static void ffestb_subr_kill_inquire_ (void);
+static void ffestb_subr_kill_open_ (void);
+static void ffestb_subr_kill_print_ (void);
+static void ffestb_subr_kill_read_ (void);
+static void ffestb_subr_kill_rewrite_ (void);
+static void ffestb_subr_kill_type_ (void);
+static void ffestb_subr_kill_vxtcode_ (void); /* Not written yet. */
+static void ffestb_subr_kill_write_ (void);
+#endif
+static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_beru2_ (ffelexToken t);
+static ffelexHandler ffestb_beru3_ (ffelexToken t);
+static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_beru5_ (ffelexToken t);
+static ffelexHandler ffestb_beru6_ (ffelexToken t);
+static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_beru8_ (ffelexToken t);
+static ffelexHandler ffestb_beru9_ (ffelexToken t);
+static ffelexHandler ffestb_beru10_ (ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_vxtcode1_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_vxtcode2_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_vxtcode3_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_vxtcode4_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode5_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode6_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_vxtcode7_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode8_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode9_ (ffelexToken t);
+static ffelexHandler ffestb_vxtcode10_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#endif
+static ffelexHandler ffestb_R9041_ (ffelexToken t);
+static ffelexHandler ffestb_R9042_ (ffelexToken t);
+static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9044_ (ffelexToken t);
+static ffelexHandler ffestb_R9045_ (ffelexToken t);
+static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9047_ (ffelexToken t);
+static ffelexHandler ffestb_R9048_ (ffelexToken t);
+static ffelexHandler ffestb_R9049_ (ffelexToken t);
+static ffelexHandler ffestb_R9071_ (ffelexToken t);
+static ffelexHandler ffestb_R9072_ (ffelexToken t);
+static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9074_ (ffelexToken t);
+static ffelexHandler ffestb_R9075_ (ffelexToken t);
+static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9077_ (ffelexToken t);
+static ffelexHandler ffestb_R9078_ (ffelexToken t);
+static ffelexHandler ffestb_R9079_ (ffelexToken t);
+static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9092_ (ffelexToken t);
+static ffelexHandler ffestb_R9093_ (ffelexToken t);
+static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9095_ (ffelexToken t);
+static ffelexHandler ffestb_R9096_ (ffelexToken t);
+static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9098_ (ffelexToken t);
+static ffelexHandler ffestb_R9099_ (ffelexToken t);
+static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R90911_ (ffelexToken t);
+static ffelexHandler ffestb_R90912_ (ffelexToken t);
+static ffelexHandler ffestb_R90913_ (ffelexToken t);
+static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9101_ (ffelexToken t);
+static ffelexHandler ffestb_R9102_ (ffelexToken t);
+static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9104_ (ffelexToken t);
+static ffelexHandler ffestb_R9105_ (ffelexToken t);
+static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9107_ (ffelexToken t);
+static ffelexHandler ffestb_R9108_ (ffelexToken t);
+static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R91010_ (ffelexToken t);
+static ffelexHandler ffestb_R91011_ (ffelexToken t);
+static ffelexHandler ffestb_R91012_ (ffelexToken t);
+static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9231_ (ffelexToken t);
+static ffelexHandler ffestb_R9232_ (ffelexToken t);
+static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9234_ (ffelexToken t);
+static ffelexHandler ffestb_R9235_ (ffelexToken t);
+static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R9237_ (ffelexToken t);
+static ffelexHandler ffestb_R9238_ (ffelexToken t);
+static ffelexHandler ffestb_R9239_ (ffelexToken t);
+static ffelexHandler ffestb_R92310_ (ffelexToken t);
+static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0181_ (ffelexToken t);
+static ffelexHandler ffestb_V0182_ (ffelexToken t);
+static ffelexHandler ffestb_V0183_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0184_ (ffelexToken t);
+static ffelexHandler ffestb_V0185_ (ffelexToken t);
+static ffelexHandler ffestb_V0186_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0187_ (ffelexToken t);
+static ffelexHandler ffestb_V0188_ (ffelexToken t);
+static ffelexHandler ffestb_V0189_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V01810_ (ffelexToken t);
+static ffelexHandler ffestb_V01811_ (ffelexToken t);
+static ffelexHandler ffestb_V01812_ (ffelexToken t);
+static ffelexHandler ffestb_V01813_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0191_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0192_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#endif
+static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0211_ (ffelexToken t);
+static ffelexHandler ffestb_V0212_ (ffelexToken t);
+static ffelexHandler ffestb_V0213_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0214_ (ffelexToken t);
+static ffelexHandler ffestb_V0215_ (ffelexToken t);
+static ffelexHandler ffestb_V0216_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0217_ (ffelexToken t);
+static ffelexHandler ffestb_V0218_ (ffelexToken t);
+static ffelexHandler ffestb_V0219_ (ffelexToken t);
+static ffelexHandler ffestb_V0261_ (ffelexToken t);
+static ffelexHandler ffestb_V0262_ (ffelexToken t);
+static ffelexHandler ffestb_V0263_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0264_ (ffelexToken t);
+static ffelexHandler ffestb_V0265_ (ffelexToken t);
+static ffelexHandler ffestb_V0266_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0267_ (ffelexToken t);
+static ffelexHandler ffestb_V0268_ (ffelexToken t);
+static ffelexHandler ffestb_V0269_ (ffelexToken t);
+#endif
+#if FFESTR_F90
+static ffelexHandler ffestb_dimlist1_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist2_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist3_ (ffelexToken t);
+static ffelexHandler ffestb_dimlist4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_dummy1_ (ffelexToken t);
+static ffelexHandler ffestb_dummy2_ (ffelexToken t);
+static ffelexHandler ffestb_R5241_ (ffelexToken t);
+static ffelexHandler ffestb_R5242_ (ffelexToken t);
+static ffelexHandler ffestb_R5243_ (ffelexToken t);
+static ffelexHandler ffestb_R5244_ (ffelexToken t);
+static ffelexHandler ffestb_R5471_ (ffelexToken t);
+static ffelexHandler ffestb_R5472_ (ffelexToken t);
+static ffelexHandler ffestb_R5473_ (ffelexToken t);
+static ffelexHandler ffestb_R5474_ (ffelexToken t);
+static ffelexHandler ffestb_R5475_ (ffelexToken t);
+static ffelexHandler ffestb_R5476_ (ffelexToken t);
+static ffelexHandler ffestb_R5477_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_R6241_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_R6242_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_R12291_ (ffelexToken t);
+static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_recursive1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_recursive4_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_attrs_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrs_6_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_6_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_entsp_8_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_func_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_6_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_7_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_8_ (ffelexToken t);
+static ffelexHandler ffestb_decl_funcname_9_ (ffelexToken t);
+#if FFESTR_VXT
+static ffelexHandler ffestb_V0031_ (ffelexToken t);
+static ffelexHandler ffestb_V0032_ (ffelexToken t);
+static ffelexHandler ffestb_V0033_ (ffelexToken t);
+static ffelexHandler ffestb_V0034_ (ffelexToken t);
+static ffelexHandler ffestb_V0035_ (ffelexToken t);
+static ffelexHandler ffestb_V0036_ (ffelexToken t);
+static ffelexHandler ffestb_V0161_ (ffelexToken t);
+static ffelexHandler ffestb_V0162_ (ffelexToken t);
+static ffelexHandler ffestb_V0163_ (ffelexToken t);
+static ffelexHandler ffestb_V0164_ (ffelexToken t);
+static ffelexHandler ffestb_V0165_ (ffelexToken t);
+static ffelexHandler ffestb_V0166_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_V0271_ (ffelexToken t);
+static ffelexHandler ffestb_V0272_ (ffelexToken ft, ffebld expr,
+ ffelexToken t);
+static ffelexHandler ffestb_V0273_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5391_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5392_ (ffelexToken t);
+#if FFESTR_F90
+static ffelexHandler ffestb_decl_R5393_ (ffelexToken t);
+#endif
+static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t);
+static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t);
+
+/* Internal macros. */
+
+#if FFESTB_KILL_EASY_
+#define ffestb_subr_kill_accept_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix)
+#define ffestb_subr_kill_beru_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix)
+#define ffestb_subr_kill_close_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix)
+#define ffestb_subr_kill_delete_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix)
+#define ffestb_subr_kill_find_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix)
+#define ffestb_subr_kill_inquire_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix)
+#define ffestb_subr_kill_open_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix)
+#define ffestb_subr_kill_print_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix)
+#define ffestb_subr_kill_read_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix)
+#define ffestb_subr_kill_rewrite_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix)
+#define ffestb_subr_kill_type_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix)
+#define ffestb_subr_kill_vxtcode_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
+#define ffestb_subr_kill_write_() \
+ ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix)
+#endif
+
+/* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming
+
+ ffestb_subr_ambig_nope_();
+
+ Switch from ambiguity handling in _entsp_ functions to handling entities
+ in _ents_ (perform housekeeping tasks). */
+
+static ffelexHandler
+ffestb_subr_ambig_nope_ (ffelexToken t)
+{
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl
+
+ ffestb_subr_ambig_to_ents_();
+
+ Switch from ambiguity handling in _entsp_ functions to handling entities
+ in _ents_ (perform housekeeping tasks). */
+
+static void
+ffestb_subr_ambig_to_ents_ ()
+{
+ ffelexToken nt;
+
+ nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_tokens[1] = nt;
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (!ffestb_local_.decl.aster_after)
+ {
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.kindt != NULL)
+ {
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ }
+ if (ffestb_local_.decl.lent != NULL)
+ {
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ }
+ }
+ else
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL,
+ NULL);
+ if (ffestb_local_.decl.kindt != NULL)
+ {
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ }
+ }
+ return;
+ }
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL);
+ if (ffestb_local_.decl.kindt != NULL)
+ {
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ }
+ }
+ else if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ /* NAME/NAMES token already in ffesta_tokens[1]. */
+}
+
+/* ffestb_subr_dimlist_ -- OPEN_PAREN expr
+
+ (ffestb_subr_dimlist_) // to expression handler
+
+ Deal with a dimension list.
+
+ 19-Dec-90 JCB 1.1
+ Detect too many dimensions if backend wants it. */
+
+static ffelexHandler
+ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+#ifdef FFECOM_dimensionsMAX
+ if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
+ {
+ ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
+ ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
+ }
+#endif
+ ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
+ ffelex_token_use (t));
+ ffestb_subrargs_.dim_list.ok = TRUE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
+
+ case FFELEX_typeCOMMA:
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ break;
+#ifdef FFECOM_dimensionsMAX
+ if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
+ {
+ ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_2_);
+ }
+#endif
+ ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOLON:
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ break;
+#ifdef FFECOM_dimensionsMAX
+ if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
+ {
+ ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_2_);
+ }
+#endif
+ ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
+ ffelex_token_use (t)); /* NULL second expr for
+ now, just plug in. */
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_1_);
+
+ default:
+ break;
+ }
+
+ ffestb_subrargs_.dim_list.ok = FALSE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
+}
+
+/* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr
+
+ (ffestb_subr_dimlist_1_) // to expression handler
+
+ Get the upper bound. */
+
+static ffelexHandler
+ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_subrargs_.dim_list.dims->previous->upper = expr;
+ ffestb_subrargs_.dim_list.ok = TRUE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
+
+ case FFELEX_typeCOMMA:
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ break;
+ ffestb_subrargs_.dim_list.dims->previous->upper = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ default:
+ break;
+ }
+
+ ffestb_subrargs_.dim_list.ok = FALSE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
+}
+
+/* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs
+
+ (ffestb_subr_dimlist_2_) // to expression handler
+
+ Get the upper bound. */
+
+static ffelexHandler
+ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_subrargs_.dim_list.ok = TRUE; /* Not a parse error, really. */
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLON:
+ if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+ break;
+ return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_2_);
+
+ default:
+ break;
+ }
+
+ ffestb_subrargs_.dim_list.ok = FALSE;
+ return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
+}
+
+/* ffestb_subr_name_list_ -- Collect a list of name args and close-paren
+
+ return ffestb_subr_name_list_; // to lexer after seeing OPEN_PAREN
+
+ This implements R1224 in the Fortran 90 spec. The arg list may be
+ empty, or be a comma-separated list (an optional trailing comma currently
+ results in a warning but no other effect) of arguments. For functions,
+ however, "*" is invalid (we implement dummy-arg-name, rather than R1224
+ dummy-arg, which itself is either dummy-arg-name or "*"). */
+
+static ffelexHandler
+ffestb_subr_name_list_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
+ { /* Trailing comma, warn. */
+ ffebad_start (FFEBAD_TRAILING_COMMA);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ ffestb_subrargs_.name_list.ok = TRUE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ if (ffestb_subrargs_.name_list.names)
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_subrargs_.name_list.handler;
+
+ case FFELEX_typeASTERISK:
+ if (!ffestb_subrargs_.name_list.is_subr)
+ break;
+
+ case FFELEX_typeNAME:
+ ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_subr_name_list_1_;
+
+ default:
+ break;
+ }
+
+ ffestb_subrargs_.name_list.ok = FALSE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ if (ffestb_subrargs_.name_list.names)
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
+}
+
+/* ffestb_subr_name_list_1_ -- NAME or ASTERISK
+
+ return ffestb_subr_name_list_1_; // to lexer
+
+ The next token must be COMMA or CLOSE_PAREN, either way go to original
+ state, but only after adding the appropriate name list item. */
+
+static ffelexHandler
+ffestb_subr_name_list_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_subr_name_list_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_subrargs_.name_list.ok = TRUE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ if (ffestb_subrargs_.name_list.names)
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_subrargs_.name_list.handler;
+
+ default:
+ ffestb_subrargs_.name_list.ok = FALSE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ if (ffestb_subrargs_.name_list.names)
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
+ }
+}
+
+static void
+ffestb_subr_R1001_append_p_ (void)
+{
+ ffesttFormatList f;
+
+ if (!ffestb_local_.format.pre.present)
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
+ ffelex_token_kill (ffestb_local_.format.t);
+ return;
+ }
+
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeP;
+ f->t = ffestb_local_.format.t;
+ f->u.R1010.val = ffestb_local_.format.pre;
+}
+
+/* ffestb_decl_kindparam_ -- "type" OPEN_PAREN
+
+ return ffestb_decl_kindparam_; // to lexer
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_kindparam_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_kindparam_1_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE,
+ (ffeexprCallback) ffestb_decl_kindparam_2_)))
+ (t);
+ }
+}
+
+/* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME
+
+ return ffestb_decl_kindparam_1_; // to lexer
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_kindparam_1_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
+ break;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr
+
+ (ffestb_decl_kindparam_2_) // to expression handler
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.decl.kind = expr;
+ ffestb_local_.decl.kindt = ffelex_token_use (ft);
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_starkind_ -- "type" ASTERISK
+
+ return ffestb_decl_starkind_; // to lexer
+
+ Handle NUMBER. */
+
+static ffelexHandler
+ffestb_decl_starkind_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK
+
+ return ffestb_decl_starlen_; // to lexer
+
+ Handle NUMBER. */
+
+static ffelexHandler
+ffestb_decl_starlen_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = ffelex_token_use (t);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_starlen_1_);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr
+
+ (ffestb_decl_starlen_1_) // to expression handler
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN
+
+ return ffestb_decl_typeparams_; // to lexer
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_typeparams_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_typeparams_1_;
+
+ default:
+ if (ffestb_local_.decl.lent == NULL)
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_typeparams_2_)))
+ (t);
+ if (ffestb_local_.decl.kindt != NULL)
+ break;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE,
+ (ffeexprCallback) ffestb_decl_typeparams_3_)))
+ (t);
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME
+
+ return ffestb_decl_typeparams_1_; // to lexer
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_typeparams_1_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ switch (ffestr_other (ffesta_tokens[1]))
+ {
+ case FFESTR_otherLEN:
+ if (ffestb_local_.decl.lent != NULL)
+ break;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_typeparams_2_);
+
+ case FFESTR_otherKIND:
+ if (ffestb_local_.decl.kindt != NULL)
+ break;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE,
+ (ffeexprCallback) ffestb_decl_typeparams_3_);
+
+ default:
+ break;
+ }
+ break;
+
+ default:
+ nt = ffesta_tokens[1];
+ if (ffestb_local_.decl.lent == NULL)
+ next = (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_typeparams_2_)))
+ (nt);
+ else if (ffestb_local_.decl.kindt == NULL)
+ next = (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextKINDTYPE,
+ (ffeexprCallback) ffestb_decl_typeparams_3_)))
+ (nt);
+ else
+ {
+ ffesta_tokens[1] = nt;
+ break;
+ }
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr
+
+ (ffestb_decl_typeparams_2_) // to expression handler
+
+ Handle "[LEN=]expr)". */
+
+static ffelexHandler
+ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ case FFELEX_typeCOMMA:
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_decl_typeparams_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr
+
+ (ffestb_decl_typeparams_3_) // to expression handler
+
+ Handle "[KIND=]expr)". */
+
+static ffelexHandler
+ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.decl.kind = expr;
+ ffestb_local_.decl.kindt = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ case FFELEX_typeCOMMA:
+ ffestb_local_.decl.kind = expr;
+ ffestb_local_.decl.kindt = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_decl_typeparams_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typetype1_ -- "TYPE" OPEN_PAREN
+
+ return ffestb_decl_typetype1_; // to lexer
+
+ Handle NAME. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_typetype1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_typetype2_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_typetype2_ -- "TYPE" OPEN_PAREN NAME
+
+ return ffestb_decl_typetype2_; // to lexer
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_typetype2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_local_.decl.handler;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ ffestb_local_.decl.badname,
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
+
+ return ffestb_subr_label_list_; // to lexer after seeing OPEN_PAREN
+
+ First token must be a NUMBER. Must be followed by zero or more COMMA
+ NUMBER pairs. Must then be followed by a CLOSE_PAREN. If all ok, put
+ the NUMBER tokens in a token list and return via the handler for the
+ token after CLOSE_PAREN. Else return via
+ same handler, but with the ok return value set FALSE. */
+
+static ffelexHandler
+ffestb_subr_label_list_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) == FFELEX_typeNUMBER)
+ {
+ ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_subr_label_list_1_;
+ }
+
+ ffestb_subrargs_.label_list.ok = FALSE;
+ return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
+}
+
+/* ffestb_subr_label_list_1_ -- NUMBER
+
+ return ffestb_subr_label_list_1_; // to lexer after seeing NUMBER
+
+ The next token must be COMMA, in which case go back to
+ ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
+ and go to the handler. */
+
+static ffelexHandler
+ffestb_subr_label_list_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_subr_label_list_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_subrargs_.label_list.ok = TRUE;
+ return (ffelexHandler) ffestb_subrargs_.label_list.handler;
+
+ default:
+ ffestb_subrargs_.label_list.ok = FALSE;
+ return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
+ }
+}
+
+/* ffestb_do -- Parse the DO statement
+
+ return ffestb_do; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_do (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+ ffestrSecond kw;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstDO)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_do1_;
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_do2_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_do3_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_do1_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDO)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDO);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN: /* Must be "DO" label "WHILE". */
+ if (!isdigit (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
+ i);
+ p += ffelex_token_length (ffesta_tokens[1]);
+ i += ffelex_token_length (ffesta_tokens[1]);
+ if (((*p) != 'W') && ((*p) != 'w'))
+ goto bad_i1; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ kw = ffestr_second (nt);
+ ffelex_token_kill (nt);
+ if (kw != FFESTR_secondWHILE)
+ goto bad_i1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (*p == '\0')
+ {
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_do2_;
+ }
+ if (!isdigit (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
+ i);
+ p += ffelex_token_length (ffesta_tokens[1]);
+ i += ffelex_token_length (ffesta_tokens[1]);
+ if (*p != '\0')
+ goto bad_i1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_do2_;
+
+ case FFELEX_typeEQUALS:
+ if (isdigit (*p))
+ {
+ ffesta_tokens[1]
+ = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (ffesta_tokens[1]);
+ i += ffelex_token_length (ffesta_tokens[1]);
+ }
+ else
+ ffesta_tokens[1] = NULL;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i1; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
+ (ffesta_output_pool, FFEEXPR_contextDO,
+ (ffeexprCallback) ffestb_do6_)))
+ (nt);
+ ffelex_token_kill (nt); /* Will get it back in _6_... */
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (isdigit (*p))
+ {
+ ffesta_tokens[1]
+ = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (ffesta_tokens[1]);
+ i += ffelex_token_length (ffesta_tokens[1]);
+ }
+ else
+ ffesta_tokens[1] = NULL;
+ if (*p != '\0')
+ goto bad_i1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_do1_ (t);
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i1: /* :::::::::::::::::::: */
+ if (ffesta_tokens[1])
+ ffelex_token_kill (ffesta_tokens[1]);
+
+bad_i: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dowhile -- Parse the DOWHILE statement
+
+ return ffestb_dowhile; // to lexer
+
+ Make sure the statement has a valid form for the DOWHILE statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_dowhile (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDOWHILE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDOWHILE);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
+
+ case FFELEX_typeEQUALS:/* Not really DOWHILE, but DOWHILExyz=.... */
+ ffesta_tokens[1] = NULL;
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlDO,
+ 0);
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
+ (ffesta_output_pool, FFEEXPR_contextDO,
+ (ffeexprCallback) ffestb_do6_)))
+ (nt);
+ ffelex_token_kill (nt); /* Will get it back in _6_... */
+ return (ffelexHandler) (*next) (t);
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do1_ -- "DO" [label]
+
+ return ffestb_do1_; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_do2_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffestc_R819B (ffesta_construct_name, ffesta_tokens[1], NULL,
+ NULL);
+ else
+ ffestc_R820B (ffesta_construct_name, NULL, NULL);
+ }
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ return (ffelexHandler) ffestb_do2_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do2_ -- "DO" [label] [,]
+
+ return ffestb_do2_; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_do3_;
+
+ default:
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do3_ -- "DO" [label] [,] NAME
+
+ return ffestb_do3_; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_)))
+ (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[2]); /* Will get it back in _6_... */
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffestr_second (ffesta_tokens[2]) != FFESTR_secondWHILE)
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid token. */
+ }
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do4_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr
+
+ (ffestb_do4_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[2] = ffelex_token_use (ft);
+ ffestb_local_.dowhile.expr = expr;
+ return (ffelexHandler) ffestb_do5_;
+
+ default:
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do5_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_do5_; // to lexer
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffestc_R819B (ffesta_construct_name, ffesta_tokens[1],
+ ffestb_local_.dowhile.expr, ffesta_tokens[2]);
+ else
+ ffestc_R820B (ffesta_construct_name, ffestb_local_.dowhile.expr,
+ ffesta_tokens[2]);
+ }
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do6_ -- "DO" [label] [,] var-expr
+
+ (ffestb_do6_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do6_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ /* _3_ already ensured that this would be an EQUALS token. If not, it is a
+ bug in the FFE. */
+
+ assert (ffelex_token_type (t) == FFELEX_typeEQUALS);
+
+ ffesta_tokens[2] = ffelex_token_use (ft);
+ ffestb_local_.do_stmt.var = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDO, (ffeexprCallback) ffestb_do7_);
+}
+
+/* ffestb_do7_ -- "DO" [label] [,] var-expr EQUALS expr
+
+ (ffestb_do7_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do7_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ ffesta_tokens[3] = ffelex_token_use (ft);
+ ffestb_local_.do_stmt.start = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDO, (ffeexprCallback) ffestb_do8_);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do8_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
+
+ (ffestb_do8_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do8_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[4] = ffelex_token_use (ft);
+ ffestb_local_.do_stmt.end = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDO, (ffeexprCallback) ffestb_do9_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[4] = ffelex_token_use (ft);
+ ffestb_local_.do_stmt.end = expr;
+ return (ffelexHandler) ffestb_do9_ (NULL, NULL, t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_do9_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
+ [COMMA expr]
+
+ (ffestb_do9_) // to expression handler
+
+ Make sure the statement has a valid form for the DO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_do9_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if ((expr == NULL) && (ft != NULL))
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffestc_R819A (ffesta_construct_name, ffesta_tokens[1],
+ ffestb_local_.do_stmt.var, ffesta_tokens[2],
+ ffestb_local_.do_stmt.start, ffesta_tokens[3],
+ ffestb_local_.do_stmt.end, ffesta_tokens[4], expr, ft);
+ else
+ ffestc_R820A (ffesta_construct_name, ffestb_local_.do_stmt.var,
+ ffesta_tokens[2], ffestb_local_.do_stmt.start,
+ ffesta_tokens[3], ffestb_local_.do_stmt.end,
+ ffesta_tokens[4], expr, ft);
+ }
+ ffelex_token_kill (ffesta_tokens[4]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[4]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else -- Parse the ELSE statement
+
+ return ffestb_else; // to lexer
+
+ Make sure the statement has a valid form for the ELSE statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_else (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstELSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ ffestb_args.elsexyz.second = FFESTR_secondNone;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_args.elsexyz.second = ffesta_second_kw;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_else1_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstELSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSE)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ else
+ ffesta_tokens[1] = NULL;
+ ffestb_args.elsexyz.second = FFESTR_secondNone;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_elsexyz -- Parse an ELSEIF/ELSEWHERE statement
+
+ return ffestb_elsexyz; // to lexer
+
+ Expects len and second to be set in ffestb_args.elsexyz to the length
+ of the ELSExyz keyword involved and the corresponding ffestrSecond value. */
+
+ffelexHandler
+ffestb_elsexyz (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (ffesta_first_kw == FFESTR_firstELSEIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffesta_first_kw != FFESTR_firstELSEIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffesta_first_kw != FFESTR_firstELSEIF)
+ goto bad_1; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSEIF)
+ {
+ i = FFESTR_firstlELSEIF;
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+#if FFESTR_F90
+ if ((ffestb_args.elsexyz.second == FFESTR_secondWHERE)
+ && (ffelex_token_length (ffesta_tokens[1]) != FFESTR_secondlWHERE))
+ ffestb_args.elsexyz.second = FFESTR_secondNone;
+#endif
+ return (ffelexHandler) ffestb_else1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else1_ -- "ELSE" (NAME)
+
+ return ffestb_else1_; // to lexer
+
+ If EOS/SEMICOLON, implement the appropriate statement (keep in mind that
+ "ELSE WHERE" is ambiguous at the syntactic level). If OPEN_PAREN, start
+ expression analysis with callback at _2_. */
+
+static ffelexHandler
+ffestb_else1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ if (ffestb_args.elsexyz.second == FFESTR_secondIF)
+ {
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIF, (ffeexprCallback) ffestb_else2_);
+ }
+ /* Fall through. */
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ }
+
+ switch (ffestb_args.elsexyz.second)
+ {
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ if (!ffesta_is_inhibited ())
+ if ((ffesta_first_kw == FFESTR_firstELSEWHERE)
+ && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
+ ffestc_R744 ();
+ else
+ ffestc_elsewhere (ffesta_tokens[1]); /* R744 or R805. */
+ break;
+#endif
+
+ default:
+ if (!ffesta_is_inhibited ())
+ ffestc_R805 (ffesta_tokens[1]);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+}
+
+/* ffestb_else2_ -- "ELSE" "IF" OPEN_PAREN expr
+
+ (ffestb_else2_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_else2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.else_stmt.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_else3_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else3_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_else3_; // to lexer
+
+ Make sure the next token is "THEN". */
+
+static ffelexHandler
+ffestb_else3_ (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (ffestr_first (t) == FFESTR_firstTHEN)
+ return (ffelexHandler) ffestb_else4_;
+ break;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ if (ffestr_first (t) != FFESTR_firstTHEN)
+ break;
+ if (ffelex_token_length (t) == FFESTR_firstlTHEN)
+ return (ffelexHandler) ffestb_else4_;
+ p = ffelex_token_text (t) + (i = FFESTR_firstlTHEN);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
+ return (ffelexHandler) ffestb_else5_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t, i, NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else4_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
+
+ return ffestb_else4_; // to lexer
+
+ Handle a NAME or EOS/SEMICOLON, then go to state _5_. */
+
+static ffelexHandler
+ffestb_else4_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[2] = NULL;
+ return (ffelexHandler) ffestb_else5_ (t);
+
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_else5_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_else5_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
+
+ return ffestb_else5_; // to lexer
+
+ Make sure the next token is EOS or SEMICOLON; implement R804. */
+
+static ffelexHandler
+ffestb_else5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R804 (ffestb_local_.else_stmt.expr, ffesta_tokens[1],
+ ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_tokens[2] != NULL)
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_tokens[2] != NULL)
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_end -- Parse the END statement
+
+ return ffestb_end; // to lexer
+
+ Make sure the statement has a valid form for the END statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_end (ffelexToken t)
+{
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstEND)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[1] = NULL;
+ ffestb_args.endxyz.second = FFESTR_secondNone;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_args.endxyz.second = ffesta_second_kw;
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondFILE:
+ ffestb_args.beru.badname = "ENDFILE";
+ return (ffelexHandler) ffestb_beru;
+
+ case FFESTR_secondBLOCK:
+ return (ffelexHandler) ffestb_end1_;
+
+#if FFESTR_F90
+ case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+ case FFESTR_secondMAP:
+ case FFESTR_secondSTRUCTURE:
+ case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_end3_;
+#endif
+
+ case FFESTR_secondNone:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ return (ffelexHandler) ffestb_end2_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstEND)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEND)
+ {
+ i = FFESTR_firstlEND;
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ ffesta_tokens[1] = NULL;
+ ffestb_args.endxyz.second = FFESTR_secondNone;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_endxyz -- Parse an ENDxyz statement
+
+ return ffestb_endxyz; // to lexer
+
+ Expects len and second to be set in ffestb_args.endxyz to the length
+ of the ENDxyz keyword involved and the corresponding ffestrSecond value. */
+
+ffelexHandler
+ffestb_endxyz (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ switch (ffestb_args.endxyz.second)
+ {
+#if FFESTR_F90
+ case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+ case FFESTR_secondMAP:
+ case FFESTR_secondSTRUCTURE:
+ case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ case FFESTR_secondBLOCK:
+ if (ffesta_second_kw != FFESTR_secondDATA)
+ goto bad_1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_end2_;
+
+ default:
+ return (ffelexHandler) ffestb_end2_ (t);
+ }
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ if (ffestb_args.endxyz.second == FFESTR_secondBLOCK)
+ {
+ i = FFESTR_firstlEND;
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.endxyz.len)
+ {
+ p = ffelex_token_text (ffesta_tokens[0])
+ + (i = ffestb_args.endxyz.len);
+ switch (ffestb_args.endxyz.second)
+ {
+#if FFESTR_F90
+ case FFESTR_secondINTERFACE:
+#endif
+#if FFESTR_VXT
+ case FFESTR_secondMAP:
+ case FFESTR_secondSTRUCTURE:
+ case FFESTR_secondUNION:
+#endif
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ goto bad_i; /* :::::::::::::::::::: */
+#endif
+
+ default:
+ break;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_end3_ (t);
+ }
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_end1_ -- "END" "BLOCK"
+
+ return ffestb_end1_; // to lexer
+
+ Make sure the next token is "DATA". */
+
+static ffelexHandler
+ffestb_end1_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) == FFELEX_typeNAME)
+ && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DATA",
+ "data", "Data")
+ == 0))
+ {
+ return (ffelexHandler) ffestb_end2_;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_end2_ -- "END" <unit-kind>
+
+ return ffestb_end2_; // to lexer
+
+ Make sure the next token is a NAME or EOS. */
+
+static ffelexHandler
+ffestb_end2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_end3_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_end3_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_end3_ -- "END" <unit-kind> (NAME)
+
+ return ffestb_end3_; // to lexer
+
+ Make sure the next token is an EOS, then implement the statement. */
+
+static ffelexHandler
+ffestb_end3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (ffestb_args.endxyz.second == FFESTR_secondNone)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_end ();
+ return (ffelexHandler) ffesta_zero (t);
+ }
+ break;
+ }
+
+ switch (ffestb_args.endxyz.second)
+ {
+#if FFESTR_F90
+ case FFESTR_secondTYPE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R425 (ffesta_tokens[1]);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_secondWHERE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R745 ();
+ break;
+#endif
+
+ case FFESTR_secondIF:
+ if (!ffesta_is_inhibited ())
+ ffestc_R806 (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_secondSELECT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R811 (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_secondDO:
+ if (!ffesta_is_inhibited ())
+ ffestc_R825 (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_secondPROGRAM:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1103 (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_secondMODULE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1106 (ffesta_tokens[1]);
+ break;
+#endif
+ case FFESTR_secondBLOCK:
+ case FFESTR_secondBLOCKDATA:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1112 (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_secondINTERFACE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1203 ();
+ break;
+#endif
+
+ case FFESTR_secondFUNCTION:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1221 (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_secondSUBROUTINE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1225 (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_secondSTRUCTURE:
+ if (!ffesta_is_inhibited ())
+ ffestc_V004 ();
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_secondUNION:
+ if (!ffesta_is_inhibited ())
+ ffestc_V010 ();
+ break;
+#endif
+
+#if FFESTR_VXT
+ case FFESTR_secondMAP:
+ if (!ffesta_is_inhibited ())
+ ffestc_V013 ();
+ break;
+#endif
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+}
+
+/* ffestb_goto -- Parse the GOTO statement
+
+ return ffestb_goto; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_goto (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstGO:
+ if ((ffelex_token_type (t) != FFELEX_typeNAME)
+ || (ffesta_second_kw != FFESTR_secondTO))
+ goto bad_1; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_goto1_;
+
+ case FFESTR_firstGOTO:
+ return (ffelexHandler) ffestb_goto1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstGOTO)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typePERCENT: /* Since GOTO I%J is apparently valid
+ in '90. */
+ case FFELEX_typeCOMMA:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlGOTO)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlGOTO);
+ if (isdigit (*p))
+ {
+ nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (nt);
+ i += ffelex_token_length (nt);
+ if (*p != '\0')
+ {
+ ffelex_token_kill (nt);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ }
+ else if (ffesrc_is_name_init (*p))
+ {
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ else
+ goto bad_i; /* :::::::::::::::::::: */
+ next = (ffelexHandler) ffestb_goto1_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+ return (ffelexHandler) ffestb_goto1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto1_ -- "GOTO" or "GO" "TO"
+
+ return ffestb_goto1_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_goto2_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
+ ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto3_;
+ return (ffelexHandler) ffestb_subr_label_list_;
+
+ case FFELEX_typeNAME:
+ if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
+ ffesta_confirmed ();
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextAGOTO,
+ (ffeexprCallback) ffestb_goto4_)))
+ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto2_ -- "GO/TO" NUMBER
+
+ return ffestb_goto2_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R836 (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto3_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN
+
+ return ffestb_goto3_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto3_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.label_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
+ (ffeexprCallback) ffestb_goto5_);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+
+ default:
+ ffesta_confirmed ();
+ /* Fall through. */
+ case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
+ (ffeexprCallback) ffestb_goto5_)))
+ (t);
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto4_ -- "GO/TO" expr
+
+ (ffestb_goto4_) // to expression handler
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffestb_local_.go_to.expr = expr;
+ return (ffelexHandler) ffestb_goto6_;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffestb_local_.go_to.expr = expr;
+ return (ffelexHandler) ffestb_goto6_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R839 (expr, ft, NULL);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto5_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN (COMMA) expr
+
+ (ffestb_goto5_) // to expression handler
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto5_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R837 (ffestb_subrargs_.label_list.labels, expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto6_ -- "GO/TO" expr (COMMA)
+
+ return ffestb_goto6_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto6_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
+ ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto7_;
+ return (ffelexHandler) ffestb_subr_label_list_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_goto7_ -- "GO/TO" expr (COMMA) OPEN_PAREN label-list CLOSE_PAREN
+
+ return ffestb_goto7_; // to lexer
+
+ Make sure the statement has a valid form for the GOTO statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_goto7_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.label_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R839 (ffestb_local_.go_to.expr, ffesta_tokens[1],
+ ffestb_subrargs_.label_list.labels);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_halt -- Parse the STOP/PAUSE statement
+
+ return ffestb_halt; // to lexer
+
+ Make sure the statement has a valid form for the STOP/PAUSE statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_halt (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ ffesta_confirmed ();
+ break;
+ }
+
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextSTOP,
+ (ffeexprCallback) ffestb_halt1_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ ffesta_confirmed ();
+ break;
+ }
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextSTOP,
+ (ffeexprCallback) ffestb_halt1_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ ffestb_args.halt.len);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ (ffesta_first_kw == FFESTR_firstSTOP)
+ ? "STOP" : "PAUSE",
+ ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ (ffesta_first_kw == FFESTR_firstSTOP)
+ ? "STOP" : "PAUSE",
+ t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_halt1_ -- "STOP/PAUSE" expr
+
+ (ffestb_halt1_) // to expression handler
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_halt1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstSTOP)
+ ffestc_R842 (expr, ft);
+ else
+ ffestc_R843 (expr, ft);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ (ffesta_first_kw == FFESTR_firstSTOP)
+ ? "STOP" : "PAUSE",
+ t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_if -- Parse an IF statement
+
+ return ffestb_if; // to lexer
+
+ Make sure the statement has a valid form for an IF statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_if (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextIF,
+ (ffeexprCallback) ffestb_if1_);
+
+bad_0: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_if1_ -- "IF" OPEN_PAREN expr
+
+ (ffestb_if1_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_if1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.if_stmt.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_if2_;
+
+ default:
+ break;
+ }
+
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_if2_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_if2_; // to lexer
+
+ Make sure the next token is NAME. */
+
+static ffelexHandler
+ffestb_if2_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_if3_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ if ((ffesta_construct_name == NULL)
+ || (ffelex_token_type (t) != FFELEX_typeNUMBER))
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
+ else
+ ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
+ ffesta_construct_name, t);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_if3_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NAME
+
+ return ffestb_if3_; // to lexer
+
+ If the next token is EOS or SEMICOLON and the preceding NAME was "THEN",
+ implement R803. Else, implement R807 and send the preceding NAME followed
+ by the current token. */
+
+static ffelexHandler
+ffestb_if3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (ffestr_first (ffesta_tokens[2]) == FFESTR_firstTHEN)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_R803 (ffesta_construct_name, ffestb_local_.if_stmt.expr,
+ ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return (ffelexHandler) ffesta_zero (t);
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffesta_construct_name != NULL)
+ {
+ if (!ffesta_is_inhibited ())
+ ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
+ ffesta_construct_name, ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R807 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ {
+ ffelexToken my_2 = ffesta_tokens[2];
+
+ next = (ffelexHandler) ffesta_two (my_2, t);
+ ffelex_token_kill (my_2);
+ }
+ return (ffelexHandler) next;
+}
+
+/* ffestb_where -- Parse a WHERE statement
+
+ return ffestb_where; // to lexer
+
+ Make sure the statement has a valid form for a WHERE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_where (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstWHERE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstWHERE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWHERE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextWHERE,
+ (ffeexprCallback) ffestb_where1_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+#endif
+/* ffestb_where1_ -- "WHERE" OPEN_PAREN expr
+
+ (ffestb_where1_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.if_stmt.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_where2_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_where2_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_where2_; // to lexer
+
+ Make sure the next token is NAME. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where2_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_where3_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R742 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WHERE", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_where3_ -- "WHERE" OPEN_PAREN expr CLOSE_PAREN NAME
+
+ return ffestb_where3_; // to lexer
+
+ Implement R742. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_where3_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken my_2 = ffesta_tokens[2];
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R740 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ next = (ffelexHandler) ffesta_two (my_2, t);
+ ffelex_token_kill (my_2);
+ return (ffelexHandler) next;
+}
+
+#endif
+/* ffestb_let -- Parse an assignment statement
+
+ return ffestb_let; // to lexer
+
+ Make sure the statement has a valid form for an assignment statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_let (ffelexToken t)
+{
+ ffelexHandler next;
+ bool vxtparam; /* TRUE if it might really be a VXT PARAMETER
+ stmt. */
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ vxtparam = FALSE;
+ break;
+
+ case FFELEX_typeNAMES:
+ vxtparam = TRUE;
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typePERCENT:
+ case FFELEX_typePOINTS:
+ ffestb_local_.let.vxtparam = FALSE;
+ break;
+
+ case FFELEX_typeEQUALS:
+ if (!vxtparam || (ffesta_first_kw != FFESTR_firstPARAMETER))
+ {
+ ffestb_local_.let.vxtparam = FALSE;
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + FFESTR_firstlPARAMETER;
+ ffestb_local_.let.vxtparam = ffesrc_is_name_init (*p);
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ next = (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextLET,
+ (ffeexprCallback) ffestb_let1_)))
+ (ffesta_tokens[0]);
+ return (ffelexHandler) (*next) (t);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_let1_ -- expr
+
+ (ffestb_let1_) // to expression handler
+
+ Make sure the next token is EQUALS or POINTS. */
+
+static ffelexHandler
+ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.let.dest = expr;
+
+ switch (ffelex_token_type (t))
+ {
+#if FFESTR_F90
+ case FFELEX_typePOINTS:
+#endif
+ case FFELEX_typeEQUALS:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextLET, (ffeexprCallback) ffestb_let2_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_let2_ -- expr EQUALS/POINTS expr
+
+ (ffestb_end2_) // to expression handler
+
+ Make sure the next token is EOS or SEMICOLON; implement the statement. */
+
+static ffelexHandler
+ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (ffestb_local_.let.vxtparam && !ffestc_is_let_not_V027 ())
+ break;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+#if FFESTR_F90
+ if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
+#endif
+ ffestc_let (ffestb_local_.let.dest, expr, ft);
+#if FFESTR_F90
+ else
+ ffestc_R738 (ffestb_local_.let.dest, expr, ft);
+#endif
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
+ (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
+ ? "assignment" : "pointer-assignment",
+ t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type -- Parse the TYPE statement
+
+ return ffestb_type; // to lexer
+
+ Make sure the statement has a valid form for the TYPE statement. If
+ it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_type (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_type1_;
+
+ case FFELEX_typeNAME: /* No confirm here, because ambig w/V020 VXT
+ TYPE. */
+ ffesta_tokens[1] = NULL;
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_type4_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_type1_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = NULL;
+ ffesta_tokens[2]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_type4_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type1_ -- "TYPE" COMMA
+
+ return ffestb_type1_; // to lexer
+
+ Make sure the next token is a NAME. */
+
+static ffelexHandler
+ffestb_type1_ (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_local_.type.kw = ffestr_other (t);
+ switch (ffestb_local_.varlist.kw)
+ {
+ case FFESTR_otherPUBLIC:
+ case FFESTR_otherPRIVATE:
+ return (ffelexHandler) ffestb_type2_;
+
+ default:
+ ffelex_token_kill (ffesta_tokens[1]);
+ break;
+ }
+ break;
+
+ case FFELEX_typeNAMES:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_local_.type.kw = ffestr_other (t);
+ switch (ffestb_local_.varlist.kw)
+ {
+ case FFESTR_otherPUBLIC:
+ p = ffelex_token_text (t) + (i = FFESTR_otherlPUBLIC);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_type2_;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i1; /* :::::::::::::::::::: */
+ ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
+ return (ffelexHandler) ffestb_type4_;
+
+ case FFESTR_otherPRIVATE:
+ p = ffelex_token_text (t) + (i = FFESTR_otherlPRIVATE);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_type2_;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i1; /* :::::::::::::::::::: */
+ ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
+ return (ffelexHandler) ffestb_type4_;
+
+ default:
+ ffelex_token_kill (ffesta_tokens[1]);
+ break;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_i1: /* :::::::::::::::::::: */
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "TYPE", t, i, NULL);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type2_ -- "TYPE" COMMA NAME
+
+ return ffestb_type2_; // to lexer
+
+ Handle COLONCOLON or NAME. */
+
+static ffelexHandler
+ffestb_type2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ return (ffelexHandler) ffestb_type3_;
+
+ case FFELEX_typeNAME:
+ return (ffelexHandler) ffestb_type3_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type3_ -- "TYPE" [COMMA NAME [COLONCOLON]]
+
+ return ffestb_type3_; // to lexer
+
+ Make sure the next token is a NAME. */
+
+static ffelexHandler
+ffestb_type3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_type4_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_type4_ -- "TYPE" [COMMA NAME [COLONCOLON]] NAME
+
+ return ffestb_type4_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_type4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R424 (ffesta_tokens[1], ffestb_local_.type.kw,
+ ffesta_tokens[2]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE
+ statement
+
+ return ffestb_varlist; // to lexer
+
+ Make sure the statement has a valid form. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_varlist (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521A ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_private (); /* Either R523A or R521B. */
+ return (ffelexHandler) ffesta_zero (t);
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R520_start ();
+ break;
+
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ return (ffelexHandler) ffestb_varlist5_;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ return (ffelexHandler) ffestb_varlist1_;
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1207_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1208_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R520_start ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ break;
+ }
+ return (ffelexHandler) ffestb_varlist5_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.varlist.len);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ default:
+ break;
+ }
+ if (*p != '\0')
+ break;
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521A ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_private (); /* Either R423A or R521B. */
+ return (ffelexHandler) ffesta_zero (t);
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ default:
+ break;
+ }
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R520_start ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ return (ffelexHandler) ffestb_varlist5_;
+
+ case FFELEX_typeOPEN_PAREN:
+ switch (ffesta_first_kw)
+ {
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ if (*p != '\0')
+ goto bad_1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_varlist1_;
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1207_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ goto bad_1; /* :::::::::::::::::::: */
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1208_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_R520_start ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ break;
+ }
+ return (ffelexHandler) ffestb_varlist5_ (t);
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ /* Here, we have at least one char after the first keyword and t is
+ COMMA or EOS/SEMICOLON. Also we know that this form is valid for
+ only the statements reaching here (specifically, INTENT won't reach
+ here). */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_start ();
+ break;
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_start ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_start ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Astart ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bstart ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ next = (ffelexHandler) ffestb_varlist5_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist1_ -- "INTENT" OPEN_PAREN
+
+ return ffestb_varlist1_; // to lexer
+
+ Handle NAME. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_varlist1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_local_.varlist.kw = ffestr_other (t);
+ switch (ffestb_local_.varlist.kw)
+ {
+ case FFESTR_otherIN:
+ return (ffelexHandler) ffestb_varlist2_;
+
+ case FFESTR_otherINOUT:
+ return (ffelexHandler) ffestb_varlist3_;
+
+ case FFESTR_otherOUT:
+ return (ffelexHandler) ffestb_varlist3_;
+
+ default:
+ ffelex_token_kill (ffesta_tokens[1]);
+ break;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist2_ -- "INTENT" OPEN_PAREN "IN"
+
+ return ffestb_varlist2_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_varlist2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_other (t))
+ {
+ case FFESTR_otherOUT:
+ ffestb_local_.varlist.kw = FFESTR_otherINOUT;
+ return (ffelexHandler) ffestb_varlist3_;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_varlist4_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist3_ -- "INTENT" OPEN_PAREN NAME ["OUT"]
+
+ return ffestb_varlist3_; // to lexer
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_varlist3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_varlist4_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist4_ -- "INTENT" OPEN_PAREN NAME ["OUT"] CLOSE_PAREN
+
+ return ffestb_varlist4_; // to lexer
+
+ Handle COLONCOLON or NAME. */
+
+static ffelexHandler
+ffestb_varlist4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_varlist5_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R519_start (ffesta_tokens[1], ffestb_local_.varlist.kw);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_varlist5_ (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_varlist5_ -- Handles the list of variable names
+
+ return ffestb_varlist5_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_varlist5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_varlist6_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestc_R519_finish ();
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_finish ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Afinish ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bfinish ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_varlist6_ -- (whatever) NAME
+
+ return ffestb_varlist6_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_varlist6_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_item (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestc_R519_item (ffesta_tokens[1]);
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_item (ffesta_tokens[1]);
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_item (ffesta_tokens[1]);
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Aitem (ffesta_tokens[1]);
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bitem (ffesta_tokens[1]);
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_varlist5_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_item (ffesta_tokens[1]);
+ ffestc_R1207_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestc_R519_item (ffesta_tokens[1]);
+ ffestc_R519_finish ();
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_item (ffesta_tokens[1]);
+ ffestc_R1208_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_item (ffesta_tokens[1]);
+ ffestc_R520_finish ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Aitem (ffesta_tokens[1]);
+ ffestc_R521Afinish ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bitem (ffesta_tokens[1]);
+ ffestc_R521Bfinish ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstEXTERNAL:
+ ffestc_R1207_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffestc_R519_finish ();
+ break;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ ffestc_R1208_finish ();
+ break;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ ffestc_R520_finish ();
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPUBLIC:
+ ffestc_R521Afinish ();
+ break;
+
+ case FFESTR_firstPRIVATE:
+ ffestc_R521Bfinish ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R423B -- Parse the SEQUENCE statement
+
+ return ffestb_R423B; // to lexer
+
+ Make sure the statement has a valid form for the SEQUENCE statement. If
+ it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R423B (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstSEQUENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstSEQUENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlSEQUENCE)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSEQUENCE);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R423B ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SEQUENCE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R522 -- Parse the SAVE statement
+
+ return ffestb_R522; // to lexer
+
+ Make sure the statement has a valid form for the SAVE statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R522 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstSAVE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R522 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ return (ffelexHandler) ffestb_R5221_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ return (ffelexHandler) ffestb_R5221_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstSAVE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSAVE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R522 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ return (ffelexHandler) ffestb_R5221_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ return (ffelexHandler) ffestb_R5221_;
+ }
+
+ /* Here, we have at least one char after "SAVE" and t is COMMA or
+ EOS/SEMICOLON. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ ffestc_R522start ();
+ next = (ffelexHandler) ffestb_R5221_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5221_ -- "SAVE" [COLONCOLON]
+
+ return ffestb_R5221_; // to lexer
+
+ Handle NAME or SLASH. */
+
+static ffelexHandler
+ffestb_R5221_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffestb_local_.R522.is_cblock = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5224_;
+
+ case FFELEX_typeSLASH:
+ ffestb_local_.R522.is_cblock = TRUE;
+ return (ffelexHandler) ffestb_R5222_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R522finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5222_ -- "SAVE" [COLONCOLON] SLASH
+
+ return ffestb_R5222_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5222_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5223_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R522finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5223_ -- "SAVE" [COLONCOLON] SLASH NAME
+
+ return ffestb_R5223_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_R5223_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5224_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R522finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5224_ -- "SAVE" [COLONCOLON] R523
+
+ return ffestb_R5224_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5224_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffestb_local_.R522.is_cblock)
+ ffestc_R522item_cblock (ffesta_tokens[1]);
+ else
+ ffestc_R522item_object (ffesta_tokens[1]);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5221_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffestb_local_.R522.is_cblock)
+ ffestc_R522item_cblock (ffesta_tokens[1]);
+ else
+ ffestc_R522item_object (ffesta_tokens[1]);
+ ffestc_R522finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R522finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R528 -- Parse the DATA statement
+
+ return ffestb_R528; // to lexer
+
+ Make sure the statement has a valid form for the DATA statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R528 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstDATA)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ ffestb_local_.data.started = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDATA)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDATA);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (*p == '\0')
+ {
+ ffestb_local_.data.started = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback)
+ ffestb_R5281_)))
+ (t);
+ }
+ break;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ break;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.data.started = FALSE;
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ next = (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5281_ -- "DATA" expr-list
+
+ (ffestb_R5281_) // to expression handler
+
+ Handle COMMA or SLASH. */
+
+static ffelexHandler
+ffestb_R5281_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.data.started)
+ {
+ ffestc_R528_start ();
+ ffestb_local_.data.started = TRUE;
+ }
+ ffestc_R528_item_object (expr, ft);
+ }
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_);
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.data.started)
+ {
+ ffestc_R528_start ();
+ ffestb_local_.data.started = TRUE;
+ }
+ ffestc_R528_item_object (expr, ft);
+ ffestc_R528_item_startvals ();
+ }
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5282_);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ break;
+ }
+
+ if (ffestb_local_.data.started && !ffesta_is_inhibited ())
+ ffestc_R528_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5282_ -- "DATA" expr-list SLASH expr-list
+
+ (ffestb_R5282_) // to expression handler
+
+ Handle ASTERISK, COMMA, or SLASH. */
+
+static ffelexHandler
+ffestb_R5282_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R528_item_value (NULL, NULL, expr, ft);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5282_);
+
+ case FFELEX_typeASTERISK:
+ if (expr == NULL)
+ break;
+ ffestb_local_.data.expr = expr;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5283_);
+
+ case FFELEX_typeSLASH:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R528_item_value (NULL, NULL, expr, ft);
+ ffestc_R528_item_endvals (t);
+ }
+ return (ffelexHandler) ffestb_R5284_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R528_item_endvals (t);
+ ffestc_R528_finish ();
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5283_ -- "DATA" expr-list SLASH expr ASTERISK expr
+
+ (ffestb_R5283_) // to expression handler
+
+ Handle COMMA or SLASH. */
+
+static ffelexHandler
+ffestb_R5283_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
+ expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5282_);
+
+ case FFELEX_typeSLASH:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
+ expr, ft);
+ ffestc_R528_item_endvals (t);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5284_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R528_item_endvals (t);
+ ffestc_R528_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5284_ -- "DATA" expr-list SLASH expr-list SLASH
+
+ return ffestb_R5284_; // to lexer
+
+ Handle [COMMA] NAME or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5284_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_);
+
+ case FFELEX_typeNAME:
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_R5281_)))
+ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R528_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R528_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R537 -- Parse a PARAMETER statement
+
+ return ffestb_R537; // to lexer
+
+ Make sure the statement has a valid form for an PARAMETER statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R537 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.parameter.started = FALSE;
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextPARAMETER,
+ (ffeexprCallback) ffestb_R5371_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R5371_ -- "PARAMETER" OPEN_PAREN expr
+
+ (ffestb_R5371_) // to expression handler
+
+ Make sure the next token is EQUALS. */
+
+static ffelexHandler
+ffestb_R5371_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.parameter.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_R5372_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ if (ffestb_local_.parameter.started)
+ ffestc_R537_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5372_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr
+
+ (ffestb_R5372_) // to expression handler
+
+ Make sure the next token is COMMA or CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_R5372_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.parameter.started)
+ {
+ ffestc_R537_start ();
+ ffestb_local_.parameter.started = TRUE;
+ }
+ ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
+ expr, ft);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextPARAMETER,
+ (ffeexprCallback) ffestb_R5371_);
+
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.parameter.started)
+ {
+ ffestc_R537_start ();
+ ffestb_local_.parameter.started = TRUE;
+ }
+ ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
+ expr, ft);
+ ffestc_R537_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5373_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ if (ffestb_local_.parameter.started)
+ ffestc_R537_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5373_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr CLOSE_PAREN
+
+ return ffestb_R5373_; // to lexer
+
+ Make sure the next token is EOS or SEMICOLON, or generate an error. All
+ cleanup has already been done, by the way. */
+
+static ffelexHandler
+ffestb_R5373_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R542 -- Parse the NAMELIST statement
+
+ return ffestb_R542; // to lexer
+
+ Make sure the statement has a valid form for the NAMELIST statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R542 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstNAMELIST)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstNAMELIST)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlNAMELIST);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeSLASH:
+ break;
+ }
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_start ();
+ return (ffelexHandler) ffestb_R5421_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5421_ -- "NAMELIST" SLASH
+
+ return ffestb_R5421_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5421_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_item_nlist (t);
+ return (ffelexHandler) ffestb_R5422_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5422_ -- "NAMELIST" SLASH NAME
+
+ return ffestb_R5422_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_R5422_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5423_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5423_ -- "NAMELIST" SLASH NAME SLASH
+
+ return ffestb_R5423_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5423_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_item_nitem (t);
+ return (ffelexHandler) ffestb_R5424_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5424_ -- "NAMELIST" SLASH NAME SLASH NAME
+
+ return ffestb_R5424_; // to lexer
+
+ Handle COMMA, EOS/SEMICOLON, or SLASH. */
+
+static ffelexHandler
+ffestb_R5424_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R5425_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5421_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5425_ -- "NAMELIST" SLASH NAME SLASH NAME COMMA
+
+ return ffestb_R5425_; // to lexer
+
+ Handle NAME or SLASH. */
+
+static ffelexHandler
+ffestb_R5425_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_item_nitem (t);
+ return (ffelexHandler) ffestb_R5424_;
+
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5421_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R542_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R544 -- Parse an EQUIVALENCE statement
+
+ return ffestb_R544; // to lexer
+
+ Make sure the statement has a valid form for an EQUIVALENCE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R544 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEQUIVALENCE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.equivalence.started = FALSE;
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextEQUIVALENCE,
+ (ffeexprCallback) ffestb_R5441_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R5441_ -- "EQUIVALENCE" OPEN_PAREN expr
+
+ (ffestb_R5441_) // to expression handler
+
+ Make sure the next token is COMMA. */
+
+static ffelexHandler
+ffestb_R5441_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestb_local_.equivalence.exprs = ffestt_exprlist_create ();
+ ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextEQUIVALENCE,
+ (ffeexprCallback) ffestb_R5442_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ if (ffestb_local_.equivalence.started)
+ ffestc_R544_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5442_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr
+
+ (ffestb_R5442_) // to expression handler
+
+ Make sure the next token is COMMA or CLOSE_PAREN. For COMMA, we just
+ append the expression to our list and continue; for CLOSE_PAREN, we
+ append the expression and move to _3_. */
+
+static ffelexHandler
+ffestb_R5442_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextEQUIVALENCE,
+ (ffeexprCallback) ffestb_R5442_);
+
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffestb_R5443_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ if (ffestb_local_.equivalence.started)
+ ffestc_R544_finish ();
+ ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5443_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN
+
+ return ffestb_R5443_; // to lexer
+
+ Make sure the next token is COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5443_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.equivalence.started)
+ {
+ ffestc_R544_start ();
+ ffestb_local_.equivalence.started = TRUE;
+ }
+ ffestc_R544_item (ffestb_local_.equivalence.exprs);
+ }
+ ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
+ return (ffelexHandler) ffestb_R5444_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.equivalence.started)
+ {
+ ffestc_R544_start ();
+ ffestb_local_.equivalence.started = TRUE;
+ }
+ ffestc_R544_item (ffestb_local_.equivalence.exprs);
+ ffestc_R544_finish ();
+ }
+ ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ if (ffestb_local_.equivalence.started)
+ ffestc_R544_finish ();
+ ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5444_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN COMMA
+
+ return ffestb_R5444_; // to lexer
+
+ Make sure the next token is OPEN_PAREN, or generate an error. */
+
+static ffelexHandler
+ffestb_R5444_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextEQUIVALENCE,
+ (ffeexprCallback) ffestb_R5441_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
+ if (ffestb_local_.equivalence.started)
+ ffestc_R544_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R834 -- Parse the CYCLE statement
+
+ return ffestb_R834; // to lexer
+
+ Make sure the statement has a valid form for the CYCLE statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_R834 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCYCLE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8341_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R8341_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCYCLE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCYCLE);
+ if (*p == '\0')
+ {
+ ffesta_tokens[1] = NULL;
+ }
+ else
+ {
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ return (ffelexHandler) ffestb_R8341_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8341_ -- "CYCLE" [NAME]
+
+ return ffestb_R8341_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R8341_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R834 (ffesta_tokens[1]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R835 -- Parse the EXIT statement
+
+ return ffestb_R835; // to lexer
+
+ Make sure the statement has a valid form for the EXIT statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_R835 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstEXIT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8351_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R8351_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstEXIT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlEXIT);
+ if (*p == '\0')
+ {
+ ffesta_tokens[1] = NULL;
+ }
+ else
+ {
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ return (ffelexHandler) ffestb_R8351_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8351_ -- "EXIT" [NAME]
+
+ return ffestb_R8351_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R8351_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R835 (ffesta_tokens[1]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R838 -- Parse the ASSIGN statement
+
+ return ffestb_R838; // to lexer
+
+ Make sure the statement has a valid form for the ASSIGN statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R838 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+ ffelexHandler next;
+ ffelexToken et; /* First token in target. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstASSIGN)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNUMBER:
+ break;
+ }
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_R8381_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstASSIGN)
+ goto bad_0; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ /* Fall through. */
+ case FFELEX_typePERCENT:
+ case FFELEX_typeOPEN_PAREN:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlASSIGN);
+ if (!isdigit (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (ffesta_tokens[1]); /* Skip to "TO". */
+ i += ffelex_token_length (ffesta_tokens[1]);
+ if (!ffesrc_char_match_init (*p, 'T', 't') /* "TO". */
+ || (++i, !ffesrc_char_match_noninit (*++p, 'O', 'o')))
+ {
+ bad_i_1: /* :::::::::::::::::::: */
+ ffelex_token_kill (ffesta_tokens[1]);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ ++p, ++i;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i_1; /* :::::::::::::::::::: */
+ et = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ next = (ffelexHandler)
+ (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextASSIGN,
+ (ffeexprCallback)
+ ffestb_R8383_)))
+ (et);
+ ffelex_token_kill (et);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8381_ -- "ASSIGN" NUMBER
+
+ return ffestb_R8381_; // to lexer
+
+ Make sure the next token is "TO". */
+
+static ffelexHandler
+ffestb_R8381_ (ffelexToken t)
+{
+ if ((ffelex_token_type (t) == FFELEX_typeNAME)
+ && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "TO", "to",
+ "To") == 0))
+ {
+ return (ffelexHandler) ffestb_R8382_;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ return (ffelexHandler) ffestb_R8382_ (t); /* Maybe user forgot "TO". */
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8382_ -- "ASSIGN" NUMBER ("TO")
+
+ return ffestb_R8382_; // to lexer
+
+ Make sure the next token is a name, then pass it along to the expression
+ evaluator as an LHS expression. The callback function is _3_. */
+
+static ffelexHandler
+ffestb_R8382_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ {
+ return (ffelexHandler)
+ (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextASSIGN,
+ (ffeexprCallback) ffestb_R8383_)))
+ (t);
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8383_ -- "ASSIGN" NUMBER ("TO") expression
+
+ (ffestb_R8383_) // to expression handler
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R8383_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R838 (ffesta_tokens[1], expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R840 -- Parse an arithmetic-IF statement
+
+ return ffestb_R840; // to lexer
+
+ Make sure the statement has a valid form for an arithmetic-IF statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R840 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffesta_first_kw != FFESTR_firstIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstIF)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextARITHIF,
+ (ffeexprCallback) ffestb_R8401_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R8401_ -- "IF" OPEN_PAREN expr
+
+ (ffestb_R8401_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_R8401_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ ffestb_local_.if_stmt.expr = expr;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffelex_set_names (TRUE); /* In case it's a logical IF instead. */
+ return (ffelexHandler) ffestb_R8402_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8402_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_R8402_; // to lexer
+
+ Make sure the next token is NUMBER. */
+
+static ffelexHandler
+ffestb_R8402_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8403_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8403_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER
+
+ return ffestb_R8403_; // to lexer
+
+ Make sure the next token is COMMA. */
+
+static ffelexHandler
+ffestb_R8403_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R8404_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8404_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA
+
+ return ffestb_R8404_; // to lexer
+
+ Make sure the next token is NUMBER. */
+
+static ffelexHandler
+ffestb_R8404_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffesta_tokens[3] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8405_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8405_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER
+
+ return ffestb_R8405_; // to lexer
+
+ Make sure the next token is COMMA. */
+
+static ffelexHandler
+ffestb_R8405_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R8406_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8406_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
+
+ return ffestb_R8406_; // to lexer
+
+ Make sure the next token is NUMBER. */
+
+static ffelexHandler
+ffestb_R8406_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffesta_tokens[4] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8407_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8407_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
+ NUMBER
+
+ return ffestb_R8407_; // to lexer
+
+ Make sure the next token is EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R8407_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R840 (ffestb_local_.if_stmt.expr, ffesta_tokens[1],
+ ffesta_tokens[2], ffesta_tokens[3], ffesta_tokens[4]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[4]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[4]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R841 -- Parse the CONTINUE statement
+
+ return ffestb_R841; // to lexer
+
+ Make sure the statement has a valid form for the CONTINUE statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_R841 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCONTINUE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCONTINUE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTINUE)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTINUE);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R841 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1102 -- Parse the PROGRAM statement
+
+ return ffestb_R1102; // to lexer
+
+ Make sure the statement has a valid form for the PROGRAM statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R1102 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstPROGRAM)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11021_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstPROGRAM)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPROGRAM);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_R11021_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11021_ -- "PROGRAM" NAME
+
+ return ffestb_R11021_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R11021_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1102 (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_block -- Parse the BLOCK DATA statement
+
+ return ffestb_block; // to lexer
+
+ Make sure the statement has a valid form for the BLOCK DATA statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_block (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstBLOCK)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ if (ffesta_second_kw != FFESTR_secondDATA)
+ goto bad_1; /* :::::::::::::::::::: */
+ break;
+ }
+
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_R1111_1_;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_blockdata -- Parse the BLOCKDATA statement
+
+ return ffestb_blockdata; // to lexer
+
+ Make sure the statement has a valid form for the BLOCKDATA statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_blockdata (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R1111_2_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R1111_2_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlBLOCKDATA);
+ if (*p == '\0')
+ {
+ ffesta_tokens[1] = NULL;
+ }
+ else
+ {
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ }
+ return (ffelexHandler) ffestb_R1111_2_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1111_1_ -- "BLOCK" "DATA"
+
+ return ffestb_R1111_1_; // to lexer
+
+ Make sure the next token is a NAME, EOS, or SEMICOLON token. */
+
+static ffelexHandler
+ffestb_R1111_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R1111_2_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R1111_2_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1111_2_ -- "BLOCK/DATA" NAME
+
+ return ffestb_R1111_2_; // to lexer
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R1111_2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1111 (ffesta_tokens[1]);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
+ break;
+ }
+
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1212 -- Parse the CALL statement
+
+ return ffestb_R1212; // to lexer
+
+ Make sure the statement has a valid form for the CALL statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R1212 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCALL)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+ ffesta_confirmed ();
+ return (ffelexHandler)
+ (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
+ (ffeexprCallback) ffestb_R12121_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCALL)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCALL);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ next = (ffelexHandler)
+ (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
+ (ffeexprCallback) ffestb_R12121_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12121_ -- "CALL" expr
+
+ (ffestb_R12121_) // to expression handler
+
+ Make sure the statement has a valid form for the CALL statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12121_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R1212 (expr, ft);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1227 -- Parse the RETURN statement
+
+ return ffestb_R1227; // to lexer
+
+ Make sure the statement has a valid form for the RETURN statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R1227 (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstRETURN)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextRETURN,
+ (ffeexprCallback) ffestb_R12271_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstRETURN)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextRETURN, (ffeexprCallback) ffestb_R12271_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlRETURN);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R12271_ -- "RETURN" expr
+
+ (ffestb_R12271_) // to expression handler
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1227 (expr, ft);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1228 -- Parse the CONTAINS statement
+
+ return ffestb_R1228; // to lexer
+
+ Make sure the statement has a valid form for the CONTAINS statement. If
+ it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1228 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCONTAINS)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCONTAINS)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTAINS)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTAINS);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1228 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTAINS", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTAINS", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V009 -- Parse the UNION statement
+
+ return ffestb_V009; // to lexer
+
+ Make sure the statement has a valid form for the UNION statement. If
+ it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V009 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstUNION)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstUNION)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlUNION)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUNION);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V009 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "UNION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "UNION", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_construct -- Parse a construct name
+
+ return ffestb_construct; // to lexer
+
+ Make sure the statement can have a construct name (if-then-stmt, do-stmt,
+ select-case-stmt). */
+
+ffelexHandler
+ffestb_construct (ffelexToken t UNUSED)
+{
+ /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is
+ COLON. */
+
+ ffesta_confirmed ();
+ ffelex_set_names (TRUE);
+ return (ffelexHandler) ffestb_construct1_;
+}
+
+/* ffestb_construct1_ -- NAME COLON
+
+ return ffestb_construct1_; // to lexer
+
+ Make sure we've got a NAME that is DO, DOWHILE, IF, SELECT, or SELECTCASE. */
+
+static ffelexHandler
+ffestb_construct1_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_first_kw = ffestr_first (t);
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstIF:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
+ break;
+
+ case FFESTR_firstDO:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
+ break;
+
+ case FFESTR_firstDOWHILE:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
+ break;
+
+ case FFESTR_firstSELECT:
+ case FFESTR_firstSELECTCASE:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffesta_construct_name = ffesta_tokens[0];
+ ffesta_tokens[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_construct2_;
+
+ case FFELEX_typeNAMES:
+ ffesta_first_kw = ffestr_first (t);
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstIF:
+ if (ffelex_token_length (t) != FFESTR_firstlIF)
+ goto bad; /* :::::::::::::::::::: */
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
+ break;
+
+ case FFESTR_firstDO:
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
+ break;
+
+ case FFESTR_firstDOWHILE:
+ if (ffelex_token_length (t) != FFESTR_firstlDOWHILE)
+ goto bad; /* :::::::::::::::::::: */
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
+ break;
+
+ case FFESTR_firstSELECTCASE:
+ if (ffelex_token_length (t) != FFESTR_firstlSELECTCASE)
+ goto bad; /* :::::::::::::::::::: */
+ ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffesta_construct_name = ffesta_tokens[0];
+ ffesta_tokens[0] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_construct2_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
+ ffesta_tokens[0], t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_construct2_ -- NAME COLON "DO/DOWHILE/IF/SELECT/SELECTCASE"
+
+ return ffestb_construct2_; // to lexer
+
+ This extra step is needed to set ffesta_second_kw if the second token
+ (here) is a NAME, so DO and SELECT can continue to expect it. */
+
+static ffelexHandler
+ffestb_construct2_ (ffelexToken t)
+{
+ if (ffelex_token_type (t) == FFELEX_typeNAME)
+ ffesta_second_kw = ffestr_second (t);
+ return (ffelexHandler) (*ffestb_local_.construct.next) (t);
+}
+
+/* ffestb_heap -- Parse an ALLOCATE/DEALLOCATE statement
+
+ return ffestb_heap; // to lexer
+
+ Make sure the statement has a valid form for an ALLOCATE/DEALLOCATE
+ statement. If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_heap (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.heap.len)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.heap.exprs = ffestt_exprlist_create ();
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_args.heap.ctx,
+ (ffeexprCallback) ffestb_heap1_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_heap1_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr
+
+ (ffestb_heap1_) // to expression handler
+
+ Make sure the next token is COMMA. */
+
+static ffelexHandler
+ffestb_heap1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_heap2_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.heap.exprs, expr,
+ ffelex_token_use (t));
+ ffesta_tokens[1] = NULL;
+ ffestb_local_.heap.expr = NULL;
+ return (ffelexHandler) ffestb_heap5_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap2_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA
+
+ return ffestb_heap2_; // to lexer
+
+ Make sure the next token is NAME. */
+
+static ffelexHandler
+ffestb_heap2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_heap3_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap3_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN expr COMMA NAME
+
+ return ffestb_heap3_; // to lexer
+
+ If token is EQUALS, make sure NAME was "STAT" and handle STAT variable;
+ else pass NAME and token to expression handler. */
+
+static ffelexHandler
+ffestb_heap3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherSTAT)
+ break;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextHEAPSTAT,
+ (ffeexprCallback) ffestb_heap4_);
+
+ default:
+ next = (ffelexHandler)
+ (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_args.heap.ctx,
+ (ffeexprCallback) ffestb_heap1_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap4_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... COMMA "STAT" EQUALS
+ expr
+
+ (ffestb_heap4_) // to expression handler
+
+ Make sure the next token is CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_heap4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffestb_local_.heap.expr = expr;
+ return (ffelexHandler) ffestb_heap5_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_heap5_ -- "ALLOCATE/DEALLOCATE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_heap5_; // to lexer
+
+ Make sure the next token is EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_heap5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstALLOCATE)
+ ffestc_R620 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
+ ffesta_tokens[1]);
+ else
+ ffestc_R625 (ffestb_local_.heap.exprs, ffestb_local_.heap.expr,
+ ffesta_tokens[1]);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.heap.badname, t);
+ ffestt_exprlist_kill (ffestb_local_.heap.exprs);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_module -- Parse the MODULEPROCEDURE statement
+
+ return ffestb_module; // to lexer
+
+ Make sure the statement has a valid form for the MODULEPROCEDURE statement.
+ If it does, implement the statement.
+
+ 31-May-90 JCB 1.1
+ Confirm NAME==MODULE followed by standard four invalid tokens, so we
+ get decent message if somebody forgets that MODULE requires a name. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_module (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexToken mt; /* Name in MODULE PROCEDUREname, i.e.
+ includes "PROCEDURE". */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstMODULE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ goto bad_1m; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1m; /* :::::::::::::::::::: */
+ }
+
+ ffesta_confirmed ();
+ if (ffesta_second_kw != FFESTR_secondPROCEDURE)
+ {
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_module3_;
+ }
+ ffestb_local_.moduleprocedure.started = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_module1_;
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0])
+ + (i = FFESTR_firstlMODULEPROCEDURE);
+ if ((ffesta_first_kw == FFESTR_firstMODULE)
+ || ((ffesta_first_kw == FFESTR_firstMODULEPROCEDURE)
+ && !ffesrc_is_name_init (*p)))
+ { /* Definitely not "MODULE PROCEDURE name". */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1m; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1m; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMODULE);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_im; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ ffestc_R1105 (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) ffesta_zero (t);
+ }
+
+ /* Here we know that we're indeed looking at a MODULEPROCEDURE
+ statement rather than MODULE and that the character following
+ MODULEPROCEDURE in the NAMES token is a valid first character for a
+ NAME. This means that unless the second token is COMMA, we have an
+ ambiguous statement that can be read either as MODULE PROCEDURE name
+ or MODULE PROCEDUREname, the former being an R1205, the latter an
+ R1105. */
+
+ if (ffesta_first_kw != FFESTR_firstMODULEPROCEDURE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA: /* Aha, clearly not MODULE PROCEDUREname. */
+ ffesta_confirmed ();
+ ffestb_local_.moduleprocedure.started = FALSE;
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_module2_ (t);
+
+ case FFELEX_typeEOS: /* MODULE PROCEDURE name or MODULE
+ PROCEDUREname. */
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ mt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlMODULE,
+ 0);
+ if (!ffesta_is_inhibited ())
+ ffestc_module (mt, nt); /* Implement ambiguous statement. */
+ ffelex_token_kill (nt);
+ ffelex_token_kill (mt);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_1m: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_im: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MODULE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module1_ -- "MODULEPROCEDURE" or "MODULE" "PROCEDURE"
+
+ return ffestb_module1_; // to lexer
+
+ Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_module1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffestb_local_.moduleprocedure.started
+ && (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME))
+ {
+ ffesta_confirmed ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ }
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_module2_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (ffestb_local_.moduleprocedure.started)
+ break; /* Error if we've already seen NAME COMMA. */
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1105 (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
+ ffestc_R1205_finish ();
+ else if (!ffestb_local_.moduleprocedure.started)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module2_ -- "MODULE/PROCEDURE" NAME
+
+ return ffestb_module2_; // to lexer
+
+ Make sure the statement has a valid form for the MODULEPROCEDURE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_module2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffestb_local_.moduleprocedure.started)
+ {
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1205_start ();
+ }
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R1205_item (ffesta_tokens[1]);
+ ffestc_R1205_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ if (!ffestb_local_.moduleprocedure.started)
+ {
+ ffestb_local_.moduleprocedure.started = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1205_start ();
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R1205_item (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_module1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.moduleprocedure.started && !ffesta_is_inhibited ())
+ ffestc_R1205_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE PROCEDURE", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_module3_ -- "MODULE" NAME
+
+ return ffestb_module3_; // to lexer
+
+ Make sure the statement has a valid form for the MODULE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_module3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1105 (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MODULE", t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R809 -- Parse the SELECTCASE statement
+
+ return ffestb_R809; // to lexer
+
+ Make sure the statement has a valid form for the SELECTCASE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R809 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstSELECT:
+ if ((ffelex_token_type (t) != FFELEX_typeNAME)
+ || (ffesta_second_kw != FFESTR_secondCASE))
+ goto bad_1; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_R8091_;
+
+ case FFESTR_firstSELECTCASE:
+ return (ffelexHandler) ffestb_R8091_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstSELECTCASE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSELECTCASE);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_R8091_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8091_ -- "SELECTCASE" or "SELECT" "CASE"
+
+ return ffestb_R8091_; // to lexer
+
+ Make sure the statement has a valid form for the SELECTCASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8091_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextSELECTCASE, (ffeexprCallback) ffestb_R8092_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8092_ -- "SELECT/CASE" OPEN_PAREN expr
+
+ (ffestb_R8092_) // to expression handler
+
+ Make sure the statement has a valid form for the SELECTCASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8092_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ ffestb_local_.selectcase.expr = expr;
+ return (ffelexHandler) ffestb_R8093_;
+
+ default:
+ break;
+ }
+
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8093_ -- "SELECT/CASE" OPEN_PAREN expr CLOSE_PAREN
+
+ return ffestb_R8093_; // to lexer
+
+ Make sure the statement has a valid form for the SELECTCASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8093_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R809 (ffesta_construct_name, ffestb_local_.selectcase.expr,
+ ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ return ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffesta_construct_name != NULL)
+ {
+ ffelex_token_kill (ffesta_construct_name);
+ ffesta_construct_name = NULL;
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R810 -- Parse the CASE statement
+
+ return ffestb_R810; // to lexer
+
+ Make sure the statement has a valid form for the CASE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R810 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCASE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (ffesta_second_kw != FFESTR_secondDEFAULT)
+ goto bad_1; /* :::::::::::::::::::: */
+ ffestb_local_.case_stmt.cases = NULL;
+ return (ffelexHandler) ffestb_R8101_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
+ }
+
+ case FFELEX_typeNAMES:
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstCASEDEFAULT:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+ }
+ ffestb_local_.case_stmt.cases = NULL;
+ p = ffelex_token_text (ffesta_tokens[0])
+ + (i = FFESTR_firstlCASEDEFAULT);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R8101_ (t);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
+ 0);
+ return (ffelexHandler) ffestb_R8102_ (t);
+
+ case FFESTR_firstCASE:
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCASE);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8101_ -- "CASE" case-selector
+
+ return ffestb_R8101_; // to lexer
+
+ Make sure the statement has a valid form for the CASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8101_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R8102_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_tokens[1] = NULL;
+ return (ffelexHandler) ffestb_R8102_ (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.case_stmt.cases != NULL)
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8102_ -- "CASE" case-selector [NAME]
+
+ return ffestb_R8102_; // to lexer
+
+ Make sure the statement has a valid form for the CASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8102_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R810 (ffestb_local_.case_stmt.cases, ffesta_tokens[1]);
+ if (ffestb_local_.case_stmt.cases != NULL)
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.case_stmt.cases != NULL)
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ if (ffesta_tokens[1] != NULL)
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8103_ -- "CASE" OPEN_PAREN expr
+
+ (ffestb_R8103_) // to expression handler
+
+ Make sure the statement has a valid form for the CASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8103_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffestb_R8101_;
+
+ case FFELEX_typeCOMMA:
+ ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
+ ffelex_token_use (ft));
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
+
+ case FFELEX_typeCOLON:
+ ffestt_caselist_append (ffestb_local_.case_stmt.cases, TRUE, expr, NULL,
+ ffelex_token_use (ft)); /* NULL second expr for
+ now, just plug in. */
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8104_);
+
+ default:
+ break;
+ }
+
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R8104_ -- "CASE" OPEN_PAREN expr COLON expr
+
+ (ffestb_R8104_) // to expression handler
+
+ Make sure the statement has a valid form for the CASE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R8104_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.case_stmt.cases->previous->expr2 = expr;
+ return (ffelexHandler) ffestb_R8101_;
+
+ case FFELEX_typeCOMMA:
+ ffestb_local_.case_stmt.cases->previous->expr2 = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
+
+ default:
+ break;
+ }
+
+ ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R1001 -- Parse a FORMAT statement
+
+ return ffestb_R1001; // to lexer
+
+ Make sure the statement has a valid form for an FORMAT statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R1001 (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstFORMAT)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstFORMAT)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFORMAT)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.format.complained = FALSE;
+ ffestb_local_.format.f = NULL; /* No parent yet. */
+ ffestb_local_.format.f = ffestt_formatlist_create (NULL,
+ ffelex_token_use (t));
+ ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
+ NAMES. */
+ return (ffelexHandler) ffestb_R10011_;
+
+ case FFELEX_typeOPEN_ARRAY:/* "(/". */
+ ffesta_confirmed ();
+ ffestb_local_.format.complained = FALSE;
+ ffestb_local_.format.f = ffestt_formatlist_create (NULL,
+ ffelex_token_use (t));
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ ffelex_set_names_pure (TRUE); /* Have even free-form lexer give us
+ NAMES. */
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R10011_ -- "FORMAT" OPEN_PAREN expr
+
+ return ffestb_R10011_; // to lexer
+
+ For CLOSE_PAREN, wrap up the format list and if it is the top-level one,
+ exit. For anything else, pass it to _2_. */
+
+static ffelexHandler
+ffestb_R10011_ (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ break;
+
+ default:
+ return (ffelexHandler) ffestb_R10012_ (t);
+ }
+
+ /* If we have a format we're working on, continue working on it. */
+
+ f = ffestb_local_.format.f->u.root.parent;
+
+ if (f != NULL)
+ {
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+ }
+
+ return (ffelexHandler) ffestb_R100114_;
+}
+
+/* ffestb_R10012_ -- "FORMAT" OPEN_PAREN [format-item-list]
+
+ return ffestb_R10012_; // to lexer
+
+ The initial state for a format-item. Here, just handle the initial
+ number, sign for number, or run-time expression. Also handle spurious
+ comma, close-paren (indicating spurious comma), close-array (like
+ close-paren but preceded by slash), and quoted strings. */
+
+static ffelexHandler
+ffestb_R10012_ (ffelexToken t)
+{
+ unsigned long unsigned_val;
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_ANGLE:
+ ffesta_confirmed ();
+ ffestb_local_.format.pre.t = ffelex_token_use (t);
+ ffelex_set_names_pure (FALSE);
+ if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
+ {
+ ffestb_local_.format.complained = TRUE;
+ ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100115_);
+
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.sign = FALSE; /* No sign present. */
+ ffestb_local_.format.pre.present = TRUE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = ffelex_token_use (t);
+ ffestb_local_.format.pre.u.unsigned_val = unsigned_val
+ = strtoul (ffelex_token_text (t), NULL, 10);
+ ffelex_set_expecting_hollerith (unsigned_val, '\0',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ return (ffelexHandler) ffestb_R10014_;
+
+ case FFELEX_typePLUS:
+ ffestb_local_.format.sign = TRUE; /* Positive. */
+ ffestb_local_.format.pre.t = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R10013_;
+
+ case FFELEX_typeMINUS:
+ ffestb_local_.format.sign = FALSE; /* Negative. */
+ ffestb_local_.format.pre.t = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R10013_;
+
+ case FFELEX_typeCOLON:
+ case FFELEX_typeCOLONCOLON:/* "::". */
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT: /* "//". */
+ case FFELEX_typeNAMES:
+ case FFELEX_typeDOLLAR:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeOPEN_ARRAY:/* "(/". */
+ ffestb_local_.format.sign = FALSE; /* No sign present. */
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R10014_ (t);
+
+ case FFELEX_typeCOMMA:
+ ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R10012_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeCLOSE_ARRAY: /* "/)". */
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
+ for (f = ffestb_local_.format.f;
+ f->u.root.parent != NULL;
+ f = f->u.root.parent->next)
+ ;
+ ffestb_local_.format.f = f;
+ return (ffelexHandler) ffestb_R100114_ (t);
+
+ case FFELEX_typeQUOTE:
+ if (ffe_is_vxt ())
+ break; /* Error, probably something like FORMAT("17)
+ = X. */
+ ffelex_set_expecting_hollerith (-1, '\"',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t)); /* Don't have to unset
+ this one. */
+ return (ffelexHandler) ffestb_R100113_;
+
+ case FFELEX_typeAPOSTROPHE:
+#if 0 /* No apparent need for this, and not killed
+ anywhere. */
+ ffesta_tokens[1] = ffelex_token_use (t);
+#endif
+ ffelex_set_expecting_hollerith (-1, '\'',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t)); /* Don't have to unset
+ this one. */
+ return (ffelexHandler) ffestb_R100113_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R10013_ -- "FORMAT" OPEN_PAREN [format-item-list] PLUS/MINUS
+
+ return ffestb_R10013_; // to lexer
+
+ Expect a NUMBER or complain about and then ignore the PLUS/MINUS. */
+
+static ffelexHandler
+ffestb_R10013_ (ffelexToken t)
+{
+ unsigned long unsigned_val;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.pre.present = TRUE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ unsigned_val = strtoul (ffelex_token_text (t), NULL, 10);
+ ffestb_local_.format.pre.u.signed_val = ffestb_local_.format.sign
+ ? unsigned_val : -unsigned_val;
+ ffestb_local_.format.sign = TRUE; /* Sign present. */
+ return (ffelexHandler) ffestb_R10014_;
+
+ default:
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ return (ffelexHandler) ffestb_R10012_ (t);
+ }
+}
+
+/* ffestb_R10014_ -- "FORMAT" OPEN_PAREN [format-item-list] [[+/-] NUMBER]
+
+ return ffestb_R10014_; // to lexer
+
+ Here is where we expect to see the actual NAMES, COLON, SLASH, OPEN_PAREN,
+ OPEN_ARRAY, COLONCOLON, CONCAT, DOLLAR, or HOLLERITH that identifies what
+ kind of format-item we're dealing with. But if we see a NUMBER instead, it
+ means free-form spaces number like "5 6 X", so scale the current number
+ accordingly and reenter this state. (I really wouldn't be surprised if
+ they change this spacing rule in the F90 spec so that you can't embed
+ spaces within numbers or within keywords like BN in a free-source-form
+ program.) */
+
+static ffelexHandler
+ffestb_R10014_ (ffelexToken t)
+{
+ ffesttFormatList f;
+ ffeTokenLength i;
+ char *p;
+ ffestrFormat kw;
+
+ ffelex_set_expecting_hollerith (0, '\0',
+ ffewhere_line_unknown (),
+ ffewhere_column_unknown ());
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeHOLLERITH:
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeR1016;
+ f->t = ffelex_token_use (t);
+ ffelex_token_kill (ffestb_local_.format.pre.t); /* It WAS present! */
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeNUMBER:
+ assert (ffestb_local_.format.pre.present);
+ ffesta_confirmed ();
+ if (ffestb_local_.format.pre.rtexpr)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R10014_;
+ }
+ if (ffestb_local_.format.sign)
+ {
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.pre.u.signed_val *= 10;
+ ffestb_local_.format.pre.u.signed_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ }
+ else
+ {
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.pre.u.unsigned_val *= 10;
+ ffestb_local_.format.pre.u.unsigned_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ ffelex_set_expecting_hollerith (ffestb_local_.format.pre.u.unsigned_val,
+ '\0',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ }
+ return (ffelexHandler) ffestb_R10014_;
+
+ case FFELEX_typeCOLONCOLON: /* "::". */
+ if (ffestb_local_.format.pre.present)
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
+ ffestb_local_.format.pre.t);
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffestb_local_.format.pre.present = FALSE;
+ }
+ else
+ {
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeCOLON;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeCOLON;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeCOLON:
+ if (ffestb_local_.format.pre.present)
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
+ ffestb_local_.format.pre.t);
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ return (ffelexHandler) ffestb_R100112_;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeCOLON;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeCONCAT: /* "//". */
+ if (ffestb_local_.format.sign)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val = ffestb_local_.format.pre;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val = ffestb_local_.format.pre;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeSLASH:
+ if (ffestb_local_.format.sign)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val = ffestb_local_.format.pre;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffestb_local_.format.sign)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeFORMAT;
+ f->t = ffelex_token_use (t);
+ f->u.R1003D.R1004 = ffestb_local_.format.pre;
+ f->u.R1003D.format = ffestb_local_.format.f
+ = ffestt_formatlist_create (f, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_R10011_;
+
+ case FFELEX_typeOPEN_ARRAY:/* "(/". */
+ if (ffestb_local_.format.sign)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeFORMAT;
+ f->t = ffelex_token_use (t);
+ f->u.R1003D.R1004 = ffestb_local_.format.pre;
+ f->u.R1003D.format = ffestb_local_.format.f
+ = ffestt_formatlist_create (f, ffelex_token_use (t));
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R100112_;
+
+ case FFELEX_typeCLOSE_ARRAY: /* "/)". */
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val = ffestb_local_.format.pre;
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeQUOTE:
+ if (ffe_is_vxt ())
+ break; /* A totally bad character in a VXT FORMAT. */
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffesta_confirmed ();
+#if 0 /* No apparent need for this, and not killed
+ anywhere. */
+ ffesta_tokens[1] = ffelex_token_use (t);
+#endif
+ ffelex_set_expecting_hollerith (-1, '\"',
+ ffelex_token_where_line (t),
+ ffelex_token_where_column (t)); /* Don't have to unset
+ this one. */
+ return (ffelexHandler) ffestb_R100113_;
+
+ case FFELEX_typeAPOSTROPHE:
+ ffesta_confirmed ();
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+#if 0 /* No apparent need for this, and not killed
+ anywhere. */
+ ffesta_tokens[1] = ffelex_token_use (t);
+#endif
+ ffelex_set_expecting_hollerith (-1, '\'', ffelex_token_where_line (t),
+ ffelex_token_where_column (t)); /* Don't have to unset
+ this one. */
+ return (ffelexHandler) ffestb_R100113_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
+ for (f = ffestb_local_.format.f;
+ f->u.root.parent != NULL;
+ f = f->u.root.parent->next)
+ ;
+ ffestb_local_.format.f = f;
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ return (ffelexHandler) ffestb_R100114_ (t);
+
+ case FFELEX_typeDOLLAR:
+ ffestb_local_.format.t = ffelex_token_use (t);
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed (); /* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
+ return (ffelexHandler) ffestb_R10015_;
+
+ case FFELEX_typeNAMES:
+ kw = ffestr_format (t);
+ ffestb_local_.format.t = ffelex_token_use (t);
+ switch (kw)
+ {
+ case FFESTR_formatI:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeI;
+ i = FFESTR_formatlI;
+ break;
+
+ case FFESTR_formatB:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeB;
+ i = FFESTR_formatlB;
+ break;
+
+ case FFESTR_formatO:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeO;
+ i = FFESTR_formatlO;
+ break;
+
+ case FFESTR_formatZ:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeZ;
+ i = FFESTR_formatlZ;
+ break;
+
+ case FFESTR_formatF:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeF;
+ i = FFESTR_formatlF;
+ break;
+
+ case FFESTR_formatE:
+ ffestb_local_.format.current = FFESTP_formattypeE;
+ i = FFESTR_formatlE;
+ break;
+
+ case FFESTR_formatEN:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ i = FFESTR_formatlEN;
+ break;
+
+ case FFESTR_formatG:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeG;
+ i = FFESTR_formatlG;
+ break;
+
+ case FFESTR_formatL:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeL;
+ i = FFESTR_formatlL;
+ break;
+
+ case FFESTR_formatA:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeA;
+ i = FFESTR_formatlA;
+ break;
+
+ case FFESTR_formatD:
+ ffestb_local_.format.current = FFESTP_formattypeD;
+ i = FFESTR_formatlD;
+ break;
+
+ case FFESTR_formatQ:
+ ffestb_local_.format.current = FFESTP_formattypeQ;
+ i = FFESTR_formatlQ;
+ break;
+
+ case FFESTR_formatDOLLAR:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
+ i = FFESTR_formatlDOLLAR;
+ break;
+
+ case FFESTR_formatP:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeP;
+ i = FFESTR_formatlP;
+ break;
+
+ case FFESTR_formatT:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeT;
+ i = FFESTR_formatlT;
+ break;
+
+ case FFESTR_formatTL:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeTL;
+ i = FFESTR_formatlTL;
+ break;
+
+ case FFESTR_formatTR:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeTR;
+ i = FFESTR_formatlTR;
+ break;
+
+ case FFESTR_formatX:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeX;
+ i = FFESTR_formatlX;
+ break;
+
+ case FFESTR_formatS:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeS;
+ i = FFESTR_formatlS;
+ break;
+
+ case FFESTR_formatSP:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeSP;
+ i = FFESTR_formatlSP;
+ break;
+
+ case FFESTR_formatSS:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeSS;
+ i = FFESTR_formatlSS;
+ break;
+
+ case FFESTR_formatBN:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeBN;
+ i = FFESTR_formatlBN;
+ break;
+
+ case FFESTR_formatBZ:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeBZ;
+ i = FFESTR_formatlBZ;
+ break;
+
+ case FFESTR_formatH: /* Error, either "H" or "<expr>H". */
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeH;
+ i = FFESTR_formatlH;
+ break;
+
+ case FFESTR_formatPD:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeD;
+ i = FFESTR_formatlPD;
+ break;
+
+ case FFESTR_formatPE:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeE;
+ i = FFESTR_formatlPE;
+ break;
+
+ case FFESTR_formatPEN:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ i = FFESTR_formatlPEN;
+ break;
+
+ case FFESTR_formatPF:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeF;
+ i = FFESTR_formatlPF;
+ break;
+
+ case FFESTR_formatPG:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_name_from_names (t,
+ FFESTR_formatlP, 1);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ ffestb_local_.format.current = FFESTP_formattypeG;
+ i = FFESTR_formatlPG;
+ break;
+
+ default:
+ if (ffestb_local_.format.pre.present)
+ ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ p = strpbrk (ffelex_token_text (t), "0123456789");
+ if (p == NULL)
+ i = ffelex_token_length (t);
+ else
+ i = p - ffelex_token_text (t);
+ break;
+ }
+ p = ffelex_token_text (t) + i;
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10015_;
+ if (!isdigit (*p))
+ {
+ if (ffestb_local_.format.current == FFESTP_formattypeH)
+ p = strpbrk (p, "0123456789");
+ else
+ {
+ p = NULL;
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ }
+ if (p == NULL)
+ return (ffelexHandler) ffestb_R10015_;
+ i = p - ffelex_token_text (t); /* Collect digits. */
+ }
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
+ ffestb_local_.format.post.u.unsigned_val
+ = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
+ p += ffelex_token_length (ffestb_local_.format.post.t);
+ i += ffelex_token_length (ffestb_local_.format.post.t);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10016_;
+ if ((kw != FFESTR_formatP) || !ffelex_is_firstnamechar (*p))
+ {
+ if (ffestb_local_.format.current != FFESTP_formattypeH)
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
+ return (ffelexHandler) ffestb_R10016_;
+ }
+
+ /* Here we have [number]P[number][text]. Treat as
+ [number]P,[number][text]. */
+
+ ffestb_subr_R1001_append_p_ ();
+ t = ffestb_local_.format.t = ffelex_token_names_from_names (t, i, 0);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre = ffestb_local_.format.post;
+ kw = ffestr_format (t);
+ switch (kw)
+ { /* Only a few possibilities here. */
+ case FFESTR_formatD:
+ ffestb_local_.format.current = FFESTP_formattypeD;
+ i = FFESTR_formatlD;
+ break;
+
+ case FFESTR_formatE:
+ ffestb_local_.format.current = FFESTP_formattypeE;
+ i = FFESTR_formatlE;
+ break;
+
+ case FFESTR_formatEN:
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ i = FFESTR_formatlEN;
+ break;
+
+ case FFESTR_formatF:
+ ffestb_local_.format.current = FFESTP_formattypeF;
+ i = FFESTR_formatlF;
+ break;
+
+ case FFESTR_formatG:
+ ffestb_local_.format.current = FFESTP_formattypeG;
+ i = FFESTR_formatlG;
+ break;
+
+ default:
+ ffebad_start (FFEBAD_FORMAT_P_NOCOMMA);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ p = strpbrk (ffelex_token_text (t), "0123456789");
+ if (p == NULL)
+ i = ffelex_token_length (t);
+ else
+ i = p - ffelex_token_text (t);
+ }
+ p = ffelex_token_text (t) + i;
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10015_;
+ if (!isdigit (*p))
+ {
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ p = strpbrk (p, "0123456789");
+ if (p == NULL)
+ return (ffelexHandler) ffestb_R10015_;
+ i = p - ffelex_token_text (t); /* Collect digits anyway. */
+ }
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
+ ffestb_local_.format.post.u.unsigned_val
+ = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
+ p += ffelex_token_length (ffestb_local_.format.post.t);
+ i += ffelex_token_length (ffestb_local_.format.post.t);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10016_;
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
+ return (ffelexHandler) ffestb_R10016_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R10015_ -- [[+/-] NUMBER] NAMES
+
+ return ffestb_R10015_; // to lexer
+
+ Here we've gotten at least the initial mnemonic for the edit descriptor.
+ We expect either a NUMBER, for the post-mnemonic value, a NAMES, for
+ further clarification (in free-form only, sigh) of the mnemonic, or
+ anything else. In all cases we go to _6_, with the difference that for
+ NUMBER and NAMES we send the next token rather than the current token. */
+
+static ffelexHandler
+ffestb_R10015_ (ffelexToken t)
+{
+ bool split_pea; /* New NAMES requires splitting kP from new
+ edit desc. */
+ ffestrFormat kw;
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_ANGLE:
+ ffesta_confirmed ();
+ ffestb_local_.format.post.t = ffelex_token_use (t);
+ ffelex_set_names_pure (FALSE);
+ if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
+ {
+ ffestb_local_.format.complained = TRUE;
+ ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100116_);
+
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = ffelex_token_use (t);
+ ffestb_local_.format.post.u.unsigned_val
+ = strtoul (ffelex_token_text (t), NULL, 10);
+ return (ffelexHandler) ffestb_R10016_;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed (); /* NAMES " " NAMES invalid elsewhere in
+ free-form. */
+ kw = ffestr_format (t);
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ split_pea = TRUE;
+ break;
+
+ case FFESTP_formattypeH: /* An error, maintain this indicator. */
+ kw = FFESTR_formatNone;
+ split_pea = FALSE;
+ break;
+
+ default:
+ split_pea = FALSE;
+ break;
+ }
+
+ switch (kw)
+ {
+ case FFESTR_formatF:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeF;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlF;
+ break;
+
+ case FFESTR_formatE:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeE;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlE;
+ break;
+
+ case FFESTR_formatEN:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlEN;
+ break;
+
+ case FFESTR_formatG:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeG;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlG;
+ break;
+
+ case FFESTR_formatL:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeT:
+ ffestb_local_.format.current = FFESTP_formattypeTL;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlL;
+ break;
+
+ case FFESTR_formatD:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeP:
+ ffestb_local_.format.current = FFESTP_formattypeD;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlD;
+ break;
+
+ case FFESTR_formatS:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeS:
+ ffestb_local_.format.current = FFESTP_formattypeSS;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlS;
+ break;
+
+ case FFESTR_formatP:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeS:
+ ffestb_local_.format.current = FFESTP_formattypeSP;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlP;
+ break;
+
+ case FFESTR_formatR:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeT:
+ ffestb_local_.format.current = FFESTP_formattypeTR;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlR;
+ break;
+
+ case FFESTR_formatZ:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeB:
+ ffestb_local_.format.current = FFESTP_formattypeBZ;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlZ;
+ break;
+
+ case FFESTR_formatN:
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeE:
+ ffestb_local_.format.current = FFESTP_formattypeEN;
+ break;
+
+ case FFESTP_formattypeB:
+ ffestb_local_.format.current = FFESTP_formattypeBN;
+ break;
+
+ default:
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ break;
+ }
+ i = FFESTR_formatlN;
+ break;
+
+ default:
+ if (ffestb_local_.format.current != FFESTP_formattypeH)
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ split_pea = FALSE; /* Go ahead and let the P be in the party. */
+ p = strpbrk (ffelex_token_text (t), "0123456789");
+ if (p == NULL)
+ i = ffelex_token_length (t);
+ else
+ i = p - ffelex_token_text (t);
+ }
+
+ if (split_pea)
+ {
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.t = ffelex_token_use (t);
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre.present = FALSE;
+ ffestb_local_.format.pre.rtexpr = FALSE;
+ ffestb_local_.format.pre.t = NULL;
+ ffestb_local_.format.pre.u.unsigned_val = 1;
+ }
+
+ p = ffelex_token_text (t) + i;
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10015_;
+ if (!isdigit (*p))
+ {
+ ffestb_local_.format.current = FFESTP_formattypeNone;
+ p = strpbrk (p, "0123456789");
+ if (p == NULL)
+ return (ffelexHandler) ffestb_R10015_;
+ i = p - ffelex_token_text (t); /* Collect digits anyway. */
+ }
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
+ ffestb_local_.format.post.u.unsigned_val
+ = strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
+ p += ffelex_token_length (ffestb_local_.format.post.t);
+ i += ffelex_token_length (ffestb_local_.format.post.t);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R10016_;
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
+ return (ffelexHandler) ffestb_R10016_;
+
+ default:
+ ffestb_local_.format.post.present = FALSE;
+ ffestb_local_.format.post.rtexpr = FALSE;
+ ffestb_local_.format.post.t = NULL;
+ ffestb_local_.format.post.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R10016_ (t);
+ }
+}
+
+/* ffestb_R10016_ -- [[+/-] NUMBER] NAMES NUMBER
+
+ return ffestb_R10016_; // to lexer
+
+ Expect a PERIOD here. Maybe find a NUMBER to append to the current
+ number, in which case return to this state. Maybe find a NAMES to switch
+ from a kP descriptor to a new descriptor (else the NAMES is spurious),
+ in which case generator the P item and go to state _4_. Anything
+ else, pass token on to state _8_. */
+
+static ffelexHandler
+ffestb_R10016_ (ffelexToken t)
+{
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePERIOD:
+ return (ffelexHandler) ffestb_R10017_;
+
+ case FFELEX_typeNUMBER:
+ assert (ffestb_local_.format.post.present);
+ ffesta_confirmed ();
+ if (ffestb_local_.format.post.rtexpr)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R10016_;
+ }
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.post.u.unsigned_val *= 10;
+ ffestb_local_.format.post.u.unsigned_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ return (ffelexHandler) ffestb_R10016_;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed (); /* NUMBER " " NAMES invalid elsewhere. */
+ if (ffestb_local_.format.current != FFESTP_formattypeP)
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
+ return (ffelexHandler) ffestb_R10016_;
+ }
+ ffestb_subr_R1001_append_p_ ();
+ ffestb_local_.format.sign = FALSE;
+ ffestb_local_.format.pre = ffestb_local_.format.post;
+ return (ffelexHandler) ffestb_R10014_ (t);
+
+ default:
+ ffestb_local_.format.dot.present = FALSE;
+ ffestb_local_.format.dot.rtexpr = FALSE;
+ ffestb_local_.format.dot.t = NULL;
+ ffestb_local_.format.dot.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R10018_ (t);
+ }
+}
+
+/* ffestb_R10017_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD
+
+ return ffestb_R10017_; // to lexer
+
+ Here we've gotten the period following the edit descriptor.
+ We expect either a NUMBER, for the dot value, or something else, which
+ probably means we're not even close to being in a real FORMAT statement. */
+
+static ffelexHandler
+ffestb_R10017_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_ANGLE:
+ ffestb_local_.format.dot.t = ffelex_token_use (t);
+ ffelex_set_names_pure (FALSE);
+ if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
+ {
+ ffestb_local_.format.complained = TRUE;
+ ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100117_);
+
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.dot.present = TRUE;
+ ffestb_local_.format.dot.rtexpr = FALSE;
+ ffestb_local_.format.dot.t = ffelex_token_use (t);
+ ffestb_local_.format.dot.u.unsigned_val
+ = strtoul (ffelex_token_text (t), NULL, 10);
+ return (ffelexHandler) ffestb_R10018_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_DOT, t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R10018_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER
+
+ return ffestb_R10018_; // to lexer
+
+ Expect a NAMES here, which must begin with "E" to be valid. Maybe find a
+ NUMBER to append to the current number, in which case return to this state.
+ Anything else, pass token on to state _10_. */
+
+static ffelexHandler
+ffestb_R10018_ (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ assert (ffestb_local_.format.dot.present);
+ ffesta_confirmed ();
+ if (ffestb_local_.format.dot.rtexpr)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R10018_;
+ }
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.dot.u.unsigned_val *= 10;
+ ffestb_local_.format.dot.u.unsigned_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ return (ffelexHandler) ffestb_R10018_;
+
+ case FFELEX_typeNAMES:
+ if (!ffesrc_char_match_init (*(p = ffelex_token_text (t)), 'E', 'e'))
+ {
+ ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
+ return (ffelexHandler) ffestb_R10018_;
+ }
+ if (*++p == '\0')
+ return (ffelexHandler) ffestb_R10019_; /* Go get NUMBER. */
+ i = 1;
+ if (!isdigit (*p))
+ {
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, 1, NULL);
+ return (ffelexHandler) ffestb_R10018_;
+ }
+ ffestb_local_.format.exp.present = TRUE;
+ ffestb_local_.format.exp.rtexpr = FALSE;
+ ffestb_local_.format.exp.t = ffelex_token_number_from_names (t, i);
+ ffestb_local_.format.exp.u.unsigned_val
+ = strtoul (ffelex_token_text (ffestb_local_.format.exp.t), NULL, 10);
+ p += ffelex_token_length (ffestb_local_.format.exp.t);
+ i += ffelex_token_length (ffestb_local_.format.exp.t);
+ if (*p == '\0')
+ return (ffelexHandler) ffestb_R100110_;
+ ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
+ return (ffelexHandler) ffestb_R100110_;
+
+ default:
+ ffestb_local_.format.exp.present = FALSE;
+ ffestb_local_.format.exp.rtexpr = FALSE;
+ ffestb_local_.format.exp.t = NULL;
+ ffestb_local_.format.exp.u.unsigned_val = 1;
+ return (ffelexHandler) ffestb_R100110_ (t);
+ }
+}
+
+/* ffestb_R10019_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER "E"
+
+ return ffestb_R10019_; // to lexer
+
+ Here we've gotten the "E" following the edit descriptor.
+ We expect either a NUMBER, for the exponent value, or something else. */
+
+static ffelexHandler
+ffestb_R10019_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_ANGLE:
+ ffestb_local_.format.exp.t = ffelex_token_use (t);
+ ffelex_set_names_pure (FALSE);
+ if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
+ {
+ ffestb_local_.format.complained = TRUE;
+ ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100118_);
+
+ case FFELEX_typeNUMBER:
+ ffestb_local_.format.exp.present = TRUE;
+ ffestb_local_.format.exp.rtexpr = FALSE;
+ ffestb_local_.format.exp.t = ffelex_token_use (t);
+ ffestb_local_.format.exp.u.unsigned_val
+ = strtoul (ffelex_token_text (t), NULL, 10);
+ return (ffelexHandler) ffestb_R100110_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ if (ffestb_local_.format.dot.present)
+ ffelex_token_kill (ffestb_local_.format.dot.t);
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_EXP, t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100110_ -- [[+/-] NUMBER] NAMES NUMBER [PERIOD NUMBER ["E" NUMBER]]
+
+ return ffestb_R100110_; // to lexer
+
+ Maybe find a NUMBER to append to the current number, in which case return
+ to this state. Anything else, handle current descriptor, then pass token
+ on to state _10_. */
+
+static ffelexHandler
+ffestb_R100110_ (ffelexToken t)
+{
+ ffeTokenLength i;
+ enum expect
+ {
+ required,
+ optional,
+ disallowed
+ };
+ ffebad err;
+ enum expect pre;
+ enum expect post;
+ enum expect dot;
+ enum expect exp;
+ bool R1005;
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ assert (ffestb_local_.format.exp.present);
+ ffesta_confirmed ();
+ if (ffestb_local_.format.exp.rtexpr)
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+ return (ffelexHandler) ffestb_R100110_;
+ }
+ for (i = 0; i < ffelex_token_length (t); ++i)
+ ffestb_local_.format.exp.u.unsigned_val *= 10;
+ ffestb_local_.format.exp.u.unsigned_val += strtoul (ffelex_token_text (t),
+ NULL, 10);
+ return (ffelexHandler) ffestb_R100110_;
+
+ default:
+ if (ffestb_local_.format.sign
+ && (ffestb_local_.format.current != FFESTP_formattypeP)
+ && (ffestb_local_.format.current != FFESTP_formattypeH))
+ {
+ ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
+ ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
+ ffelex_token_where_column (ffestb_local_.format.pre.t));
+ ffebad_finish ();
+ ffestb_local_.format.pre.u.unsigned_val
+ = (ffestb_local_.format.pre.u.signed_val < 0)
+ ? -ffestb_local_.format.pre.u.signed_val
+ : ffestb_local_.format.pre.u.signed_val;
+ }
+ switch (ffestb_local_.format.current)
+ {
+ case FFESTP_formattypeI:
+ err = FFEBAD_FORMAT_BAD_I_SPEC;
+ pre = optional;
+ post = required;
+ dot = optional;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeB:
+ err = FFEBAD_FORMAT_BAD_B_SPEC;
+ pre = optional;
+ post = required;
+ dot = optional;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeO:
+ err = FFEBAD_FORMAT_BAD_O_SPEC;
+ pre = optional;
+ post = required;
+ dot = optional;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeZ:
+ err = FFEBAD_FORMAT_BAD_Z_SPEC;
+ pre = optional;
+ post = required;
+ dot = optional;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeF:
+ err = FFEBAD_FORMAT_BAD_F_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeE:
+ err = FFEBAD_FORMAT_BAD_E_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = optional;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeEN:
+ err = FFEBAD_FORMAT_BAD_EN_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = optional;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeG:
+ err = FFEBAD_FORMAT_BAD_G_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = optional;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeL:
+ err = FFEBAD_FORMAT_BAD_L_SPEC;
+ pre = optional;
+ post = required;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeA:
+ err = FFEBAD_FORMAT_BAD_A_SPEC;
+ pre = optional;
+ post = optional;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeD:
+ err = FFEBAD_FORMAT_BAD_D_SPEC;
+ pre = optional;
+ post = required;
+ dot = required;
+ exp = disallowed;
+ R1005 = TRUE;
+ break;
+
+ case FFESTP_formattypeQ:
+ err = FFEBAD_FORMAT_BAD_Q_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeDOLLAR:
+ err = FFEBAD_FORMAT_BAD_DOLLAR_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeP:
+ err = FFEBAD_FORMAT_BAD_P_SPEC;
+ pre = required;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeT:
+ err = FFEBAD_FORMAT_BAD_T_SPEC;
+ pre = disallowed;
+ post = required;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeTL:
+ err = FFEBAD_FORMAT_BAD_TL_SPEC;
+ pre = disallowed;
+ post = required;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeTR:
+ err = FFEBAD_FORMAT_BAD_TR_SPEC;
+ pre = disallowed;
+ post = required;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeX:
+ err = FFEBAD_FORMAT_BAD_X_SPEC;
+ pre = required;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeS:
+ err = FFEBAD_FORMAT_BAD_S_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeSP:
+ err = FFEBAD_FORMAT_BAD_SP_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeSS:
+ err = FFEBAD_FORMAT_BAD_SS_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeBN:
+ err = FFEBAD_FORMAT_BAD_BN_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeBZ:
+ err = FFEBAD_FORMAT_BAD_BZ_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeH: /* Definitely an error, make sure of
+ it. */
+ err = FFEBAD_FORMAT_BAD_H_SPEC;
+ pre = ffestb_local_.format.pre.present ? disallowed : required;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+
+ case FFESTP_formattypeNone:
+ ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_SPEC,
+ ffestb_local_.format.t);
+
+ clean_up_to_11_: /* :::::::::::::::::::: */
+
+ ffelex_token_kill (ffestb_local_.format.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ if (ffestb_local_.format.dot.present)
+ ffelex_token_kill (ffestb_local_.format.dot.t);
+ if (ffestb_local_.format.exp.present)
+ ffelex_token_kill (ffestb_local_.format.exp.t);
+ return (ffelexHandler) ffestb_R100111_ (t);
+
+ default:
+ assert (FALSE);
+ err = FFEBAD_FORMAT_BAD_H_SPEC;
+ pre = disallowed;
+ post = disallowed;
+ dot = disallowed;
+ exp = disallowed;
+ R1005 = FALSE;
+ break;
+ }
+ if (((pre == disallowed) && ffestb_local_.format.pre.present)
+ || ((pre == required) && !ffestb_local_.format.pre.present))
+ {
+ ffesta_ffebad_1t (err, (pre == required)
+ ? ffestb_local_.format.t : ffestb_local_.format.pre.t);
+ goto clean_up_to_11_; /* :::::::::::::::::::: */
+ }
+ if (((post == disallowed) && ffestb_local_.format.post.present)
+ || ((post == required) && !ffestb_local_.format.post.present))
+ {
+ ffesta_ffebad_1t (err, (post == required)
+ ? ffestb_local_.format.t : ffestb_local_.format.post.t);
+ goto clean_up_to_11_; /* :::::::::::::::::::: */
+ }
+ if (((dot == disallowed) && ffestb_local_.format.dot.present)
+ || ((dot == required) && !ffestb_local_.format.dot.present))
+ {
+ ffesta_ffebad_1t (err, (dot == required)
+ ? ffestb_local_.format.t : ffestb_local_.format.dot.t);
+ goto clean_up_to_11_; /* :::::::::::::::::::: */
+ }
+ if (((exp == disallowed) && ffestb_local_.format.exp.present)
+ || ((exp == required) && !ffestb_local_.format.exp.present))
+ {
+ ffesta_ffebad_1t (err, (exp == required)
+ ? ffestb_local_.format.t : ffestb_local_.format.exp.t);
+ goto clean_up_to_11_; /* :::::::::::::::::::: */
+ }
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = ffestb_local_.format.current;
+ f->t = ffestb_local_.format.t;
+ if (R1005)
+ {
+ f->u.R1005.R1004 = ffestb_local_.format.pre;
+ f->u.R1005.R1006 = ffestb_local_.format.post;
+ f->u.R1005.R1007_or_R1008 = ffestb_local_.format.dot;
+ f->u.R1005.R1009 = ffestb_local_.format.exp;
+ }
+ else
+ /* Must be R1010. */
+ {
+ if (pre == disallowed)
+ f->u.R1010.val = ffestb_local_.format.post;
+ else
+ f->u.R1010.val = ffestb_local_.format.pre;
+ }
+ return (ffelexHandler) ffestb_R100111_ (t);
+ }
+}
+
+/* ffestb_R100111_ -- edit-descriptor
+
+ return ffestb_R100111_; // to lexer
+
+ Expect a COMMA, CLOSE_PAREN, CLOSE_ARRAY, COLON, COLONCOLON, SLASH, or
+ CONCAT, or complain about missing comma. */
+
+static ffelexHandler
+ffestb_R100111_ (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R10012_;
+
+ case FFELEX_typeCOLON:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ return (ffelexHandler) ffestb_R10012_ (t);
+
+ case FFELEX_typeCLOSE_PAREN:
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeCLOSE_ARRAY: /* "/)". */
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeOPEN_ANGLE:
+ case FFELEX_typeDOLLAR:
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeOPEN_ARRAY:
+ case FFELEX_typeQUOTE:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeNAMES:
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_COMMA, t);
+ return (ffelexHandler) ffestb_R10012_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
+ for (f = ffestb_local_.format.f;
+ f->u.root.parent != NULL;
+ f = f->u.root.parent->next)
+ ;
+ ffestb_local_.format.f = f;
+ return (ffelexHandler) ffestb_R100114_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100112_ -- COLON, COLONCOLON, SLASH, OPEN_ARRAY, or CONCAT
+
+ return ffestb_R100112_; // to lexer
+
+ Like _11_ except the COMMA is optional. */
+
+static ffelexHandler
+ffestb_R100112_ (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R10012_;
+
+ case FFELEX_typeCOLON:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ case FFELEX_typeOPEN_ANGLE:
+ case FFELEX_typeNAMES:
+ case FFELEX_typeDOLLAR:
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeOPEN_ARRAY:
+ case FFELEX_typeQUOTE:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typePLUS:
+ case FFELEX_typeMINUS:
+ return (ffelexHandler) ffestb_R10012_ (t);
+
+ case FFELEX_typeCLOSE_PAREN:
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeCLOSE_ARRAY: /* "/)". */
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeSLASH;
+ f->t = ffelex_token_use (t);
+ f->u.R1010.val.present = FALSE;
+ f->u.R1010.val.rtexpr = FALSE;
+ f->u.R1010.val.t = NULL;
+ f->u.R1010.val.u.unsigned_val = 1;
+ f = ffestb_local_.format.f->u.root.parent;
+ if (f == NULL)
+ return (ffelexHandler) ffestb_R100114_;
+ ffestb_local_.format.f = f->next;
+ return (ffelexHandler) ffestb_R100111_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
+ for (f = ffestb_local_.format.f;
+ f->u.root.parent != NULL;
+ f = f->u.root.parent->next)
+ ;
+ ffestb_local_.format.f = f;
+ return (ffelexHandler) ffestb_R100114_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100113_ -- Handle CHARACTER token.
+
+ return ffestb_R100113_; // to lexer
+
+ Append the format item to the list, go to _11_. */
+
+static ffelexHandler
+ffestb_R100113_ (ffelexToken t)
+{
+ ffesttFormatList f;
+
+ assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
+
+ if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
+ {
+ ffebad_start (FFEBAD_NULL_CHAR_CONST);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_finish ();
+ }
+
+ f = ffestt_formatlist_append (ffestb_local_.format.f);
+ f->type = FFESTP_formattypeR1016;
+ f->t = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R100111_;
+}
+
+/* ffestb_R100114_ -- "FORMAT" OPEN_PAREN format-item-list CLOSE_PAREN
+
+ return ffestb_R100114_; // to lexer
+
+ Handle EOS/SEMICOLON or something else. */
+
+static ffelexHandler
+ffestb_R100114_ (ffelexToken t)
+{
+ ffelex_set_names_pure (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited () && !ffestb_local_.format.complained)
+ ffestc_R1001 (ffestb_local_.format.f);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100115_ -- OPEN_ANGLE expr
+
+ (ffestb_R100115_) // to expression handler
+
+ Handle expression prior to the edit descriptor. */
+
+static ffelexHandler
+ffestb_R100115_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_ANGLE:
+ ffestb_local_.format.pre.present = TRUE;
+ ffestb_local_.format.pre.rtexpr = TRUE;
+ ffestb_local_.format.pre.u.expr = expr;
+ ffelex_set_names_pure (TRUE);
+ return (ffelexHandler) ffestb_R10014_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100116_ -- "[n]X" OPEN_ANGLE expr
+
+ (ffestb_R100116_) // to expression handler
+
+ Handle expression after the edit descriptor. */
+
+static ffelexHandler
+ffestb_R100116_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_ANGLE:
+ ffestb_local_.format.post.present = TRUE;
+ ffestb_local_.format.post.rtexpr = TRUE;
+ ffestb_local_.format.post.u.expr = expr;
+ ffelex_set_names_pure (TRUE);
+ return (ffelexHandler) ffestb_R10016_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100117_ -- "[n]X[n]." OPEN_ANGLE expr
+
+ (ffestb_R100117_) // to expression handler
+
+ Handle expression after the PERIOD. */
+
+static ffelexHandler
+ffestb_R100117_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_ANGLE:
+ ffestb_local_.format.dot.present = TRUE;
+ ffestb_local_.format.dot.rtexpr = TRUE;
+ ffestb_local_.format.dot.u.expr = expr;
+ ffelex_set_names_pure (TRUE);
+ return (ffelexHandler) ffestb_R10018_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ ffelex_token_kill (ffestb_local_.format.dot.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R100118_ -- "[n]X[n].[n]E" OPEN_ANGLE expr
+
+ (ffestb_R100118_) // to expression handler
+
+ Handle expression after the "E". */
+
+static ffelexHandler
+ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_ANGLE:
+ ffestb_local_.format.exp.present = TRUE;
+ ffestb_local_.format.exp.rtexpr = TRUE;
+ ffestb_local_.format.exp.u.expr = expr;
+ ffelex_set_names_pure (TRUE);
+ return (ffelexHandler) ffestb_R100110_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.format.t);
+ ffelex_token_kill (ffestb_local_.format.exp.t);
+ if (ffestb_local_.format.pre.present)
+ ffelex_token_kill (ffestb_local_.format.pre.t);
+ if (ffestb_local_.format.post.present)
+ ffelex_token_kill (ffestb_local_.format.post.t);
+ if (ffestb_local_.format.dot.present)
+ ffelex_token_kill (ffestb_local_.format.dot.t);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
+ ffestt_formatlist_kill (ffestb_local_.format.f);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+}
+
+/* ffestb_R1107 -- Parse the USE statement
+
+ return ffestb_R1107; // to lexer
+
+ Make sure the statement has a valid form for the USE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1107 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstUSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11071_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstUSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlUSE);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+ }
+ ffesta_confirmed ();
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_R11071_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "USE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11071_ -- "USE" NAME
+
+ return ffestb_R11071_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11071_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R1107_start (ffesta_tokens[1], FALSE);
+ ffestc_R1107_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R11072_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11072_ -- "USE" NAME COMMA
+
+ return ffestb_R11072_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11072_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11073_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11073_ -- "USE" NAME COMMA NAME
+
+ return ffestb_R11073_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11073_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLON:
+ if (ffestr_other (ffesta_tokens[2]) != FFESTR_otherONLY)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_start (ffesta_tokens[1], TRUE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffestb_R11074_;
+
+ case FFELEX_typePOINTS:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_start (ffesta_tokens[1], FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = ffesta_tokens[2];
+ return (ffelexHandler) ffestb_R110711_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11074_ -- "USE" NAME COMMA "ONLY" COLON
+
+ return ffestb_R11074_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11074_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11075_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11075_ -- "USE" NAME COMMA "ONLY" COLON NAME
+
+ return ffestb_R11075_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11075_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R1107_item (NULL, ffesta_tokens[1]);
+ ffestc_R1107_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_item (NULL, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R11078_;
+
+ case FFELEX_typePOINTS:
+ return (ffelexHandler) ffestb_R11076_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11076_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS
+
+ return ffestb_R11076_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11076_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_item (ffesta_tokens[1], t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R11077_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11077_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME
+
+ return ffestb_R11077_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11077_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R11078_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11078_ -- "USE" NAME COMMA "ONLY" COLON NAME POINTS NAME COMMA
+
+ return ffestb_R11078_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11078_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R11075_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R11079_ -- "USE" NAME COMMA
+
+ return ffestb_R11079_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R11079_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R110710_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110710_ -- "USE" NAME COMMA NAME
+
+ return ffestb_R110710_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R110710_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePOINTS:
+ return (ffelexHandler) ffestb_R110711_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110711_ -- "USE" NAME COMMA NAME POINTS
+
+ return ffestb_R110711_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R110711_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_item (ffesta_tokens[1], t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R110712_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R110712_ -- "USE" NAME COMMA NAME POINTS NAME
+
+ return ffestb_R110712_; // to lexer
+
+ Make sure the statement has a valid form for the USE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R110712_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R11079_;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "USE", t);
+ ffestc_R1107_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R1202 -- Parse the INTERFACE statement
+
+ return ffestb_R1202; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement.
+ If it does, implement the statement.
+
+ 15-May-90 JCB 1.1
+ Allow INTERFACE by itself; missed this
+ valid form when originally doing syntactic analysis code. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R1202 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstINTERFACE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffesta_confirmed ();
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondOPERATOR:
+ ffestb_local_.interface.operator = FFESTP_definedoperatorOPERATOR;
+ break;
+
+ case FFESTR_secondASSIGNMENT:
+ ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
+ break;
+
+ default:
+ ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
+ break;
+ }
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R12021_;
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINTERFACE);
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstINTERFACEOPERATOR:
+ if (*(ffelex_token_text (ffesta_tokens[0])
+ + FFESTR_firstlINTERFACEOPERATOR) == '\0')
+ ffestb_local_.interface.operator
+ = FFESTP_definedoperatorOPERATOR;
+ break;
+
+ case FFESTR_firstINTERFACEASSGNMNT:
+ if (*(ffelex_token_text (ffesta_tokens[0])
+ + FFESTR_firstlINTERFACEASSGNMNT) == '\0')
+ ffestb_local_.interface.operator
+ = FFESTP_definedoperatorASSIGNMENT;
+ break;
+
+ case FFESTR_firstINTERFACE:
+ ffestb_local_.interface.operator = FFESTP_definedoperatorNone;
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeOPEN_ARRAY: /* Sigh. */
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (*p == '\0')
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNone, NULL);
+ return (ffelexHandler) ffesta_zero (t);
+ }
+ break;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_R12021_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INTERFACE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12021_ -- "INTERFACE" NAME
+
+ return ffestb_R12021_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12021_ (ffelexToken t)
+{
+ ffestb_local_.interface.slash = TRUE; /* Slash follows open paren. */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNone, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.interface.slash = FALSE; /* Slash doesn't follow. */
+ /* Fall through. */
+ case FFELEX_typeOPEN_ARRAY:
+ switch (ffestb_local_.interface.operator)
+ {
+ case FFESTP_definedoperatorNone:
+ break;
+
+ case FFESTP_definedoperatorOPERATOR:
+ ffestb_local_.interface.assignment = FALSE;
+ return (ffelexHandler) ffestb_R12022_;
+
+ case FFESTP_definedoperatorASSIGNMENT:
+ ffestb_local_.interface.assignment = TRUE;
+ return (ffelexHandler) ffestb_R12022_;
+
+ default:
+ assert (FALSE);
+ }
+ break;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12022_ -- "INTERFACE" "OPERATOR/ASSIGNMENT" OPEN_PAREN
+
+ return ffestb_R12022_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12022_ (ffelexToken t)
+{
+ ffesta_tokens[2] = ffelex_token_use (t);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePERIOD:
+ if (ffestb_local_.interface.slash)
+ break;
+ return (ffelexHandler) ffestb_R12023_;
+
+ case FFELEX_typePOWER:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorPOWER;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeASTERISK:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorMULT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typePLUS:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorADD;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeCONCAT:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeSLASH:
+ if (ffestb_local_.interface.slash)
+ {
+ ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+ return (ffelexHandler) ffestb_R12025_;
+ }
+ ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeMINUS:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorSUBTRACT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeREL_EQ:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorEQ;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeREL_NE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeOPEN_ANGLE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorLT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeREL_LE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorLE;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeCLOSE_ANGLE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorGT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeREL_GE:
+ if (ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorGE;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeEQUALS:
+ if (ffestb_local_.interface.slash)
+ {
+ ffestb_local_.interface.operator = FFESTP_definedoperatorNE;
+ return (ffelexHandler) ffestb_R12025_;
+ }
+ ffestb_local_.interface.operator = FFESTP_definedoperatorASSIGNMENT;
+ return (ffelexHandler) ffestb_R12025_;
+
+ case FFELEX_typeCLOSE_ARRAY:
+ if (!ffestb_local_.interface.slash)
+ {
+ ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+ return (ffelexHandler) ffestb_R12026_;
+ }
+ ffestb_local_.interface.operator = FFESTP_definedoperatorCONCAT;
+ return (ffelexHandler) ffestb_R12026_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ if (!ffestb_local_.interface.slash)
+ break;
+ ffestb_local_.interface.operator = FFESTP_definedoperatorDIVIDE;
+ return (ffelexHandler) ffestb_R12026_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12023_ -- "INTERFACE" NAME OPEN_PAREN PERIOD
+
+ return ffestb_R12023_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12023_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R12024_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12024_ -- "INTERFACE" NAME OPEN_PAREN PERIOD NAME
+
+ return ffestb_R12024_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12024_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typePERIOD:
+ return (ffelexHandler) ffestb_R12025_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12025_ -- "INTERFACE" NAME OPEN_PAREN operator
+
+ return ffestb_R12025_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12025_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R12026_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12026_ -- "INTERFACE" NAME OPEN_PAREN operator CLOSE_PAREN
+
+ return ffestb_R12026_; // to lexer
+
+ Make sure the statement has a valid form for the INTERFACE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12026_ (ffelexToken t)
+{
+ char *p;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (ffestb_local_.interface.assignment
+ && (ffestb_local_.interface.operator
+ != FFESTP_definedoperatorASSIGNMENT))
+ {
+ ffebad_start (FFEBAD_INTERFACE_ASSIGNMENT);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
+ ffelex_token_where_column (ffesta_tokens[1]));
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
+ ffelex_token_where_column (ffesta_tokens[2]));
+ ffebad_finish ();
+ }
+ switch (ffelex_token_type (ffesta_tokens[2]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_other (ffesta_tokens[2]))
+ {
+ case FFESTR_otherNOT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNOT, NULL);
+ break;
+
+ case FFESTR_otherAND:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorAND, NULL);
+ break;
+
+ case FFESTR_otherOR:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorOR, NULL);
+ break;
+
+ case FFESTR_otherEQV:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorEQV, NULL);
+ break;
+
+ case FFESTR_otherNEQV:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNEQV, NULL);
+ break;
+
+ case FFESTR_otherEQ:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorEQ, NULL);
+ break;
+
+ case FFESTR_otherNE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorNE, NULL);
+ break;
+
+ case FFESTR_otherLT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorLT, NULL);
+ break;
+
+ case FFESTR_otherLE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorLE, NULL);
+ break;
+
+ case FFESTR_otherGT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorGT, NULL);
+ break;
+
+ case FFESTR_otherGE:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorGE, NULL);
+ break;
+
+ default:
+ for (p = ffelex_token_text (ffesta_tokens[2]); *p != '\0'; ++p)
+ {
+ if (!isalpha (*p))
+ {
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1t (FFEBAD_INTERFACE_NONLETTER,
+ ffesta_tokens[2]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ }
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (FFESTP_definedoperatorOPERATOR,
+ ffesta_tokens[2]);
+ }
+ break;
+
+ case FFELEX_typeEQUALS:
+ if (!ffestb_local_.interface.assignment
+ && (ffestb_local_.interface.operator
+ == FFESTP_definedoperatorASSIGNMENT))
+ {
+ ffebad_start (FFEBAD_INTERFACE_OPERATOR);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[1]),
+ ffelex_token_where_column (ffesta_tokens[1]));
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[2]),
+ ffelex_token_where_column (ffesta_tokens[2]));
+ ffebad_finish ();
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (ffestb_local_.interface.operator, NULL);
+ break;
+
+ default:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1202 (ffestb_local_.interface.operator, NULL);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INTERFACE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_S3P4 -- Parse the INCLUDE line
+
+ return ffestb_S3P4; // to lexer
+
+ Make sure the statement has a valid form for the INCLUDE line. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_S3P4 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffelexToken nt;
+ ffelexToken ut;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstINCLUDE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ ffesta_confirmed ();
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
+ (ffeexprCallback) ffestb_S3P41_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstINCLUDE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINCLUDE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeAPOSTROPHE:
+ case FFELEX_typeQUOTE:
+ break;
+ }
+ ffesta_confirmed ();
+ if (*p == '\0')
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
+ (ffeexprCallback) ffestb_S3P41_)))
+ (t);
+ if (!isdigit (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ p += ffelex_token_length (nt);
+ i += ffelex_token_length (nt);
+ if ((*p != '_') || (++i, *++p != '\0'))
+ {
+ ffelex_token_kill (nt);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ ut = ffelex_token_uscore_from_names (ffesta_tokens[0], i - 1);
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextINCLUDE,
+ (ffeexprCallback) ffestb_S3P41_)))
+ (nt);
+ ffelex_token_kill (nt);
+ next = (ffelexHandler) (*next) (ut);
+ ffelex_token_kill (ut);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_S3P41_ -- "INCLUDE" [NUMBER "_"] expr
+
+ (ffestb_S3P41_) // to expression handler
+
+ Make sure the next token is an EOS, but not a SEMICOLON. */
+
+static ffelexHandler
+ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffe_is_pedantic ()
+ && ((ffelex_token_type (t) == FFELEX_typeSEMICOLON)
+ || ffesta_line_has_semicolons))
+ {
+ ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+ ffestc_S3P4 (expr, ft);
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V012 -- Parse the MAP statement
+
+ return ffestb_V012; // to lexer
+
+ Make sure the statement has a valid form for the MAP statement. If
+ it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V012 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstMAP)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstMAP)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlMAP)
+ {
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlMAP);
+ goto bad_i; /* :::::::::::::::::::: */
+ }
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V012 ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid first token. */
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "MAP", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "MAP", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V014 -- Parse the VOLATILE statement
+
+ return ffestb_V014; // to lexer
+
+ Make sure the statement has a valid form for the VOLATILE statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_V014 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstVOLATILE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ return (ffelexHandler) ffestb_V0141_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ return (ffelexHandler) ffestb_V0141_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstVOLATILE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlVOLATILE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ return (ffelexHandler) ffestb_V0141_ (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ return (ffelexHandler) ffestb_V0141_;
+ }
+
+ /* Here, we have at least one char after "VOLATILE" and t is COMMA or
+ EOS/SEMICOLON. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_start ();
+ next = (ffelexHandler) ffestb_V0141_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0141_ -- "VOLATILE" [COLONCOLON]
+
+ return ffestb_V0141_; // to lexer
+
+ Handle NAME or SLASH. */
+
+static ffelexHandler
+ffestb_V0141_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffestb_local_.V014.is_cblock = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0144_;
+
+ case FFELEX_typeSLASH:
+ ffestb_local_.V014.is_cblock = TRUE;
+ return (ffelexHandler) ffestb_V0142_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0142_ -- "VOLATILE" [COLONCOLON] SLASH
+
+ return ffestb_V0142_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0142_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0143_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0143_ -- "VOLATILE" [COLONCOLON] SLASH NAME
+
+ return ffestb_V0143_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_V0143_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_V0144_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0144_ -- "VOLATILE" [COLONCOLON] R523
+
+ return ffestb_V0144_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0144_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffestb_local_.V014.is_cblock)
+ ffestc_V014_item_cblock (ffesta_tokens[1]);
+ else
+ ffestc_V014_item_object (ffesta_tokens[1]);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0141_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffestb_local_.V014.is_cblock)
+ ffestc_V014_item_cblock (ffesta_tokens[1]);
+ else
+ ffestc_V014_item_object (ffesta_tokens[1]);
+ ffestc_V014_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V014_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V025 -- Parse the DEFINEFILE statement
+
+ return ffestb_V025; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V025 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ ffestb_local_.V025.started = FALSE;
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstDEFINE:
+ if ((ffelex_token_type (t) != FFELEX_typeNAME)
+ || (ffesta_second_kw != FFESTR_secondFILE))
+ goto bad_1; /* :::::::::::::::::::: */
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_V0251_;
+
+ case FFESTR_firstDEFINEFILE:
+ return (ffelexHandler) ffestb_V0251_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDEFINEFILE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDEFINEFILE);
+ if (isdigit (*p))
+ nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
+ else if (ffesrc_is_name_init (*p))
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ else
+ goto bad_i; /* :::::::::::::::::::: */
+ next = (ffelexHandler) ffestb_V0251_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0251_ -- "DEFINEFILE" or "DEFINE" "FILE"
+
+ return ffestb_V0251_; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0251_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
+ ffesta_confirmed ();
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_)))
+ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0252_ -- "DEFINEFILE" expr
+
+ (ffestb_V0252_) // to expression handler
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0252_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.V025.u = expr;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0253_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0253_ -- "DEFINEFILE" expr OPEN_PAREN expr
+
+ (ffestb_V0253_) // to expression handler
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0253_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestb_local_.V025.m = expr;
+ ffesta_tokens[2] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0254_);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0254_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr
+
+ (ffestb_V0254_) // to expression handler
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0254_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestb_local_.V025.n = expr;
+ ffesta_tokens[3] = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_V0255_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0255_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA
+
+ return ffestb_V0255_; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0255_ (ffelexToken t)
+{
+ char *p;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ p = ffelex_token_text (t);
+ if (!ffesrc_char_match_init (*p, 'U', 'u') || (*++p != '\0'))
+ break;
+ return (ffelexHandler) ffestb_V0256_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0256_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+
+ return ffestb_V0256_; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0256_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextFILEASSOC,
+ (ffeexprCallback) ffestb_V0257_);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0257_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+ COMMA expr
+
+ (ffestb_V0257_) // to expression handler
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0257_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestb_local_.V025.asv = expr;
+ ffesta_tokens[4] = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_V0258_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0258_ -- "DEFINEFILE" expr OPEN_PAREN expr COMMA expr COMMA "U"
+ COMMA expr CLOSE_PAREN
+
+ return ffestb_V0258_; // to lexer
+
+ Make sure the statement has a valid form for the DEFINEFILE statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_V0258_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffestb_local_.V025.started)
+ {
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V025_start ();
+ ffestb_local_.V025.started = TRUE;
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_V025_item (ffestb_local_.V025.u, ffesta_tokens[1],
+ ffestb_local_.V025.m, ffesta_tokens[2],
+ ffestb_local_.V025.n, ffesta_tokens[3],
+ ffestb_local_.V025.asv, ffesta_tokens[4]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[4]);
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNIT_DF, (ffeexprCallback) ffestb_V0252_);
+ if (!ffesta_is_inhibited ())
+ ffestc_V025_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffesta_tokens[3]);
+ ffelex_token_kill (ffesta_tokens[4]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DEFINE FILE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
+
+ ffestb_subr_kill_easy_();
+
+ Kills all tokens in the I/O data structure. Assumes that they are
+ overlaid with each other (union) in ffest_private.h and the typing
+ and structure references assume (though not necessarily dangerous if
+ FALSE) that INQUIRE has the most file elements. */
+
+#if FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_easy_ (ffestpInquireIx max)
+{
+ ffestpInquireIx ix;
+
+ for (ix = 0; ix < max; ++ix)
+ {
+ if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.inquire.inquire_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
+ if (ffestp_file.inquire.inquire_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure
+
+ ffestb_subr_kill_accept_();
+
+ Kills all tokens in the ACCEPT data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_accept_ ()
+{
+ ffestpAcceptIx ix;
+
+ for (ix = 0; ix < FFESTP_acceptix; ++ix)
+ {
+ if (ffestp_file.accept.accept_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.accept.accept_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw);
+ if (ffestp_file.accept.accept_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement
+ data structure
+
+ ffestb_subr_kill_beru_();
+
+ Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_beru_ ()
+{
+ ffestpBeruIx ix;
+
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ {
+ if (ffestp_file.beru.beru_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.beru.beru_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw);
+ if (ffestp_file.beru.beru_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure
+
+ ffestb_subr_kill_close_();
+
+ Kills all tokens in the CLOSE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_close_ ()
+{
+ ffestpCloseIx ix;
+
+ for (ix = 0; ix < FFESTP_closeix; ++ix)
+ {
+ if (ffestp_file.close.close_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.close.close_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.close.close_spec[ix].kw);
+ if (ffestp_file.close.close_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.close.close_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure
+
+ ffestb_subr_kill_delete_();
+
+ Kills all tokens in the DELETE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_delete_ ()
+{
+ ffestpDeleteIx ix;
+
+ for (ix = 0; ix < FFESTP_deleteix; ++ix)
+ {
+ if (ffestp_file.delete.delete_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.delete.delete_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw);
+ if (ffestp_file.delete.delete_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure
+
+ ffestb_subr_kill_inquire_();
+
+ Kills all tokens in the INQUIRE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_inquire_ ()
+{
+ ffestpInquireIx ix;
+
+ for (ix = 0; ix < FFESTP_inquireix; ++ix)
+ {
+ if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.inquire.inquire_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
+ if (ffestp_file.inquire.inquire_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_open_ -- Kill OPEN statement data structure
+
+ ffestb_subr_kill_open_();
+
+ Kills all tokens in the OPEN data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_open_ ()
+{
+ ffestpOpenIx ix;
+
+ for (ix = 0; ix < FFESTP_openix; ++ix)
+ {
+ if (ffestp_file.open.open_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.open.open_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.open.open_spec[ix].kw);
+ if (ffestp_file.open.open_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.open.open_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_print_ -- Kill PRINT statement data structure
+
+ ffestb_subr_kill_print_();
+
+ Kills all tokens in the PRINT data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_print_ ()
+{
+ ffestpPrintIx ix;
+
+ for (ix = 0; ix < FFESTP_printix; ++ix)
+ {
+ if (ffestp_file.print.print_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.print.print_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.print.print_spec[ix].kw);
+ if (ffestp_file.print.print_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.print.print_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_read_ -- Kill READ statement data structure
+
+ ffestb_subr_kill_read_();
+
+ Kills all tokens in the READ data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_read_ ()
+{
+ ffestpReadIx ix;
+
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ {
+ if (ffestp_file.read.read_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.read.read_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.read.read_spec[ix].kw);
+ if (ffestp_file.read.read_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.read.read_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure
+
+ ffestb_subr_kill_rewrite_();
+
+ Kills all tokens in the REWRITE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_rewrite_ ()
+{
+ ffestpRewriteIx ix;
+
+ for (ix = 0; ix < FFESTP_rewriteix; ++ix)
+ {
+ if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.rewrite.rewrite_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw);
+ if (ffestp_file.rewrite.rewrite_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_type_ -- Kill TYPE statement data structure
+
+ ffestb_subr_kill_type_();
+
+ Kills all tokens in the TYPE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_type_ ()
+{
+ ffestpTypeIx ix;
+
+ for (ix = 0; ix < FFESTP_typeix; ++ix)
+ {
+ if (ffestp_file.type.type_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.type.type_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.type.type_spec[ix].kw);
+ if (ffestp_file.type.type_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.type.type_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_subr_kill_write_ -- Kill WRITE statement data structure
+
+ ffestb_subr_kill_write_();
+
+ Kills all tokens in the WRITE data structure. */
+
+#if !FFESTB_KILL_EASY_
+static void
+ffestb_subr_kill_write_ ()
+{
+ ffestpWriteIx ix;
+
+ for (ix = 0; ix < FFESTP_writeix; ++ix)
+ {
+ if (ffestp_file.write.write_spec[ix].kw_or_val_present)
+ {
+ if (ffestp_file.write.write_spec[ix].kw_present)
+ ffelex_token_kill (ffestp_file.write.write_spec[ix].kw);
+ if (ffestp_file.write.write_spec[ix].value_present)
+ ffelex_token_kill (ffestp_file.write.write_spec[ix].value);
+ }
+ }
+}
+
+#endif
+/* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement
+
+ return ffestb_beru; // to lexer
+
+ Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/
+ UNLOCK statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_beru (ffelexToken t)
+{
+ ffelexHandler next;
+ ffestpBeruIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru2_;
+
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM,
+ (ffeexprCallback) ffestb_beru1_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0])
+ != ffestb_args.beru.len)
+ break;
+
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru2_;
+
+ default:
+ break;
+ }
+ for (ix = 0; ix < FFESTP_beruix; ++ix)
+ ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ ffestb_args.beru.len);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr
+
+ (ffestb_beru1_) // to expression handler
+
+ Make sure the next token is an EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ ffesta_confirmed ();
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstBACKSPACE:
+ ffestc_R919 ();
+ break;
+
+ case FFESTR_firstENDFILE:
+ case FFESTR_firstEND:
+ ffestc_R920 ();
+ break;
+
+ case FFESTR_firstREWIND:
+ ffestc_R921 ();
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstUNLOCK:
+ ffestc_V022 ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_subr_kill_beru_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN
+
+ return ffestb_beru2_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_beru2_ (ffelexToken t)
+{
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru3_;
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME
+
+ return ffestb_beru3_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_beru3_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+ ffelexToken ot;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffelex_token_kill (ffesta_tokens[1]);
+ nt = ffesta_tokens[2];
+ next = (ffelexHandler) ffestb_beru5_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ ot = ffesta_tokens[2];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
+ (nt);
+ ffelex_token_kill (nt);
+ next = (ffelexHandler) (*next) (ot);
+ ffelex_token_kill (ot);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN]
+
+ (ffestb_beru4_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here.
+
+ 15-Feb-91 JCB 1.2
+ Now using new mechanism whereby expr comes back as opITEM if the
+ expr is considered part (or all) of an I/O control list (and should
+ be stripped of its outer opITEM node) or not if it is considered
+ a plain unit number that happens to have been enclosed in parens.
+ 26-Mar-90 JCB 1.1
+ No longer expecting close-paren here because of constructs like
+ BACKSPACE (5)+2, so now expecting either COMMA because it was a
+ construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like
+ the former construct. Ah, the vagaries of Fortran. */
+
+static ffelexHandler
+ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ bool inlist;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ if (ffebld_op (expr) == FFEBLD_opITEM)
+ {
+ inlist = TRUE;
+ expr = ffebld_head (expr);
+ }
+ else
+ inlist = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
+ if (inlist)
+ return (ffelexHandler) ffestb_beru9_ (t);
+ return (ffelexHandler) ffestb_beru10_ (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
+ COMMA]
+
+ return ffestb_beru5_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_beru5_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.beru.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.beru.ix = FFESTP_beruixERR;
+ ffestb_local_.beru.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.beru.ix = FFESTP_beruixIOSTAT;
+ ffestb_local_.beru.left = TRUE;
+ ffestb_local_.beru.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.beru.ix = FFESTP_beruixUNIT;
+ ffestb_local_.beru.left = FALSE;
+ ffestb_local_.beru.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
+ .kw_present = TRUE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
+ .value_present = FALSE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label
+ = ffestb_local_.beru.label;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru6_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
+ COMMA] NAME
+
+ return ffestb_beru6_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_beru6_ (ffelexToken t)
+{
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.beru.label)
+ return (ffelexHandler) ffestb_beru8_;
+ if (ffestb_local_.beru.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.beru.context,
+ (ffeexprCallback) ffestb_beru7_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.beru.context,
+ (ffeexprCallback) ffestb_beru7_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_beru7_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
+ = TRUE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_beru5_;
+ return (ffelexHandler) ffestb_beru10_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_beru8_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_beru8_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
+ = TRUE;
+ ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_beru9_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
+ NUMBER
+
+ return ffestb_beru9_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_beru9_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_beru5_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_beru10_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_beru10_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_beru10_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstBACKSPACE:
+ ffestc_R919 ();
+ break;
+
+ case FFESTR_firstENDFILE:
+ case FFESTR_firstEND:
+ ffestc_R920 ();
+ break;
+
+ case FFESTR_firstREWIND:
+ ffestc_R921 ();
+ break;
+
+#if FFESTR_VXT
+ case FFESTR_firstUNLOCK:
+ ffestc_V022 ();
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_subr_kill_beru_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_beru_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode -- Parse the VXT DECODE/ENCODE statement
+
+ return ffestb_vxtcode; // to lexer
+
+ Make sure the statement has a valid form for the VXT DECODE/ENCODE
+ statement. If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_vxtcode (ffelexToken t)
+{
+ ffestpVxtcodeIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
+ ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
+ }
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0])
+ != ffestb_args.vxtcode.len)
+ goto bad_0; /* :::::::::::::::::::: */
+
+ for (ix = 0; ix < FFESTP_vxtcodeix; ++ix)
+ ffestp_file.vxtcode.vxtcode_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_vxtcode1_);
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_vxtcode1_ -- "VXTCODE" OPEN_PAREN expr
+
+ (ffestb_vxtcode1_) // to expression handler
+
+ Handle COMMA here. */
+
+static ffelexHandler
+ffestb_vxtcode1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_or_val_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].kw_present = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value_is_label
+ = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].value
+ = ffelex_token_use (ft);
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixC].u.expr = expr;
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_vxtcode2_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode2_ -- "VXTCODE" OPEN_PAREN expr COMMA expr
+
+ (ffestb_vxtcode2_) // to expression handler
+
+ Handle COMMA here. */
+
+static ffelexHandler
+ffestb_vxtcode2_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_or_val_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].kw_present = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value_is_label
+ = (expr == NULL);
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].value
+ = ffelex_token_use (ft);
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixF].u.expr = expr;
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextFILEVXTCODE,
+ (ffeexprCallback) ffestb_vxtcode3_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEVXTCODE,
+ (ffeexprCallback) ffestb_vxtcode3_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode3_ -- "VXTCODE" OPEN_PAREN expr COMMA expr COMMA expr
+
+ (ffestb_vxtcode3_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_vxtcode3_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_or_val_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].kw_present = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value_is_label
+ = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].value
+ = ffelex_token_use (ft);
+ ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixB].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_vxtcode4_;
+ return (ffelexHandler) ffestb_vxtcode9_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode4_ -- "VXTCODE" OPEN_PAREN ...
+
+ return ffestb_vxtcode4_; // to lexer
+
+ Handle NAME=expr construct here. */
+
+static ffelexHandler
+ffestb_vxtcode4_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.vxtcode.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixERR;
+ ffestb_local_.vxtcode.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.vxtcode.ix = FFESTP_vxtcodeixIOSTAT;
+ ffestb_local_.vxtcode.left = TRUE;
+ ffestb_local_.vxtcode.context = FFEEXPR_contextFILEINT;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+ .kw_present = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix]
+ .value_present = FALSE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_is_label
+ = ffestb_local_.vxtcode.label;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_vxtcode5_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode5_ -- "VXTCODE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]] NAME
+
+ return ffestb_vxtcode5_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_vxtcode5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.vxtcode.label)
+ return (ffelexHandler) ffestb_vxtcode7_;
+ if (ffestb_local_.vxtcode.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.vxtcode.context,
+ (ffeexprCallback) ffestb_vxtcode6_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.vxtcode.context,
+ (ffeexprCallback) ffestb_vxtcode6_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode6_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_vxtcode6_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_vxtcode6_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_vxtcode4_;
+ return (ffelexHandler) ffestb_vxtcode9_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode7_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_vxtcode7_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_vxtcode7_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value_present
+ = TRUE;
+ ffestp_file.vxtcode.vxtcode_spec[ffestb_local_.vxtcode.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_vxtcode8_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode8_ -- "VXTCODE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_vxtcode8_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_vxtcode8_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_vxtcode4_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_vxtcode9_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode9_ -- "VXTCODE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_vxtcode9_; // to lexer
+
+ Handle EOS or SEMICOLON here.
+
+ 07-Jun-90 JCB 1.1
+ Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
+ since they apply to internal files. */
+
+static ffelexHandler
+ffestb_vxtcode9_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ {
+ ffestc_V023_start ();
+ ffestc_V023_finish ();
+ }
+ else
+ {
+ ffestc_V024_start ();
+ ffestc_V024_finish ();
+ }
+ }
+ ffestb_subr_kill_vxtcode_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ ffestc_V023_start ();
+ else
+ ffestc_V024_start ();
+ ffestb_subr_kill_vxtcode_ ();
+ if (ffesta_first_kw == FFESTR_firstDECODE)
+ next = (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextIOLISTDF,
+ (ffeexprCallback) ffestb_vxtcode10_);
+ else
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLISTDF,
+ (ffeexprCallback) ffestb_vxtcode10_);
+
+ /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
+ (f2c provides this extension, as do other compilers, supposedly.) */
+
+ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ return next;
+
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_vxtcode_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_vxtcode10_ -- "VXTCODE(...)" expr
+
+ (ffestb_vxtcode10_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here.
+
+ 07-Jun-90 JCB 1.1
+ Context for ENCODE/DECODE expressions is now IOLISTDF instead of IOLIST
+ since they apply to internal files. */
+
+static ffelexHandler
+ffestb_vxtcode10_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ ffestc_V023_item (expr, ft);
+ else
+ ffestc_V024_item (expr, ft);
+ if (ffesta_first_kw == FFESTR_firstDECODE)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextIOLISTDF,
+ (ffeexprCallback) ffestb_vxtcode10_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLISTDF,
+ (ffeexprCallback) ffestb_vxtcode10_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ {
+ ffestc_V023_item (expr, ft);
+ ffestc_V023_finish ();
+ }
+ else
+ {
+ ffestc_V024_item (expr, ft);
+ ffestc_V024_finish ();
+ }
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ if (ffesta_first_kw == FFESTR_firstENCODE)
+ ffestc_V023_finish ();
+ else
+ ffestc_V024_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.vxtcode.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R904 -- Parse an OPEN statement
+
+ return ffestb_R904; // to lexer
+
+ Make sure the statement has a valid form for an OPEN statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R904 (ffelexToken t)
+{
+ ffestpOpenIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstOPEN)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstOPEN)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_openix; ++ix)
+ ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE;
+
+ return (ffelexHandler) ffestb_R9041_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9041_ -- "OPEN" OPEN_PAREN
+
+ return ffestb_R9041_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9041_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9042_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
+ (t);
+ }
+}
+
+/* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME
+
+ return ffestb_R9042_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9042_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9044_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr
+
+ (ffestb_R9043_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9044_;
+ return (ffelexHandler) ffestb_R9049_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_R9044_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9044_ (ffelexToken t)
+{
+ ffestrOpen kw;
+
+ ffestb_local_.open.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_open (t);
+ switch (kw)
+ {
+ case FFESTR_openACCESS:
+ ffestb_local_.open.ix = FFESTP_openixACCESS;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openACTION:
+ ffestb_local_.open.ix = FFESTP_openixACTION;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openASSOCIATEVARIABLE:
+ ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE;
+ ffestb_local_.open.left = TRUE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEASSOC;
+ break;
+
+ case FFESTR_openBLANK:
+ ffestb_local_.open.ix = FFESTP_openixBLANK;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openBLOCKSIZE:
+ ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openBUFFERCOUNT:
+ ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openCARRIAGECONTROL:
+ ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openDEFAULTFILE:
+ ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openDELIM:
+ ffestb_local_.open.ix = FFESTP_openixDELIM;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openDISP:
+ case FFESTR_openDISPOSE:
+ ffestb_local_.open.ix = FFESTP_openixDISPOSE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openERR:
+ ffestb_local_.open.ix = FFESTP_openixERR;
+ ffestb_local_.open.label = TRUE;
+ break;
+
+ case FFESTR_openEXTENDSIZE:
+ ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openFILE:
+ case FFESTR_openNAME:
+ ffestb_local_.open.ix = FFESTP_openixFILE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openFORM:
+ ffestb_local_.open.ix = FFESTP_openixFORM;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openINITIALSIZE:
+ ffestb_local_.open.ix = FFESTP_openixINITIALSIZE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openIOSTAT:
+ ffestb_local_.open.ix = FFESTP_openixIOSTAT;
+ ffestb_local_.open.left = TRUE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEINT;
+ break;
+
+#if 0 /* Haven't added support for expression
+ context yet (though easy). */
+ case FFESTR_openKEY:
+ ffestb_local_.open.ix = FFESTP_openixKEY;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEKEY;
+ break;
+#endif
+
+ case FFESTR_openMAXREC:
+ ffestb_local_.open.ix = FFESTP_openixMAXREC;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openNOSPANBLOCKS:
+ if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
+ .kw_or_val_present)
+ goto bad; /* :::::::::::::::::::: */
+ ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
+ .kw_or_val_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
+ .kw_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
+ .value_present = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9048_;
+
+ case FFESTR_openORGANIZATION:
+ ffestb_local_.open.ix = FFESTP_openixORGANIZATION;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openPAD:
+ ffestb_local_.open.ix = FFESTP_openixPAD;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openPOSITION:
+ ffestb_local_.open.ix = FFESTP_openixPOSITION;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openREADONLY:
+ if (ffestp_file.open.open_spec[FFESTP_openixREADONLY]
+ .kw_or_val_present)
+ goto bad; /* :::::::::::::::::::: */
+ ffestp_file.open.open_spec[FFESTP_openixREADONLY]
+ .kw_or_val_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixREADONLY]
+ .kw_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixREADONLY]
+ .value_present = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9048_;
+
+ case FFESTR_openRECL:
+ case FFESTR_openRECORDSIZE:
+ ffestb_local_.open.ix = FFESTP_openixRECL;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openRECORDTYPE:
+ ffestb_local_.open.ix = FFESTP_openixRECORDTYPE;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_openSHARED:
+ if (ffestp_file.open.open_spec[FFESTP_openixSHARED]
+ .kw_or_val_present)
+ goto bad; /* :::::::::::::::::::: */
+ ffestp_file.open.open_spec[FFESTP_openixSHARED]
+ .kw_or_val_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixSHARED]
+ .kw_present = TRUE;
+ ffestp_file.open.open_spec[FFESTP_openixSHARED]
+ .value_present = FALSE;
+ ffestp_file.open.open_spec[FFESTP_openixSHARED].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9048_;
+
+ case FFESTR_openSTATUS:
+ case FFESTR_openTYPE:
+ ffestb_local_.open.ix = FFESTP_openixSTATUS;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_openUNIT:
+ ffestb_local_.open.ix = FFESTP_openixUNIT;
+ ffestb_local_.open.left = FALSE;
+ ffestb_local_.open.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_openUSEROPEN:
+ ffestb_local_.open.ix = FFESTP_openixUSEROPEN;
+ ffestb_local_.open.left = TRUE;
+ ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.open.open_spec[ffestb_local_.open.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.open.open_spec[ffestb_local_.open.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix]
+ .kw_present = TRUE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix]
+ .value_present = FALSE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label
+ = ffestb_local_.open.label;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9045_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_R9045_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9045_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.open.label)
+ return (ffelexHandler) ffestb_R9047_;
+ if (ffestb_local_.open.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.open.context,
+ (ffeexprCallback) ffestb_R9046_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.open.context,
+ (ffeexprCallback) ffestb_R9046_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R9046_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
+ = TRUE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9044_;
+ return (ffelexHandler) ffestb_R9049_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R9047_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R9047_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
+ = TRUE;
+ ffestp_file.open.open_spec[ffestb_local_.open.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9048_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R9048_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9048_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9044_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R9049_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R9049_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9049_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R904 ();
+ ffestb_subr_kill_open_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_open_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R907 -- Parse a CLOSE statement
+
+ return ffestb_R907; // to lexer
+
+ Make sure the statement has a valid form for a CLOSE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R907 (ffelexToken t)
+{
+ ffestpCloseIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCLOSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCLOSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_closeix; ++ix)
+ ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE;
+
+ return (ffelexHandler) ffestb_R9071_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9071_ -- "CLOSE" OPEN_PAREN
+
+ return ffestb_R9071_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9071_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9072_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
+ (t);
+ }
+}
+
+/* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME
+
+ return ffestb_R9072_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9072_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9074_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr
+
+ (ffestb_R9073_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9074_;
+ return (ffelexHandler) ffestb_R9079_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_R9074_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9074_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.close.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.close.ix = FFESTP_closeixERR;
+ ffestb_local_.close.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.close.ix = FFESTP_closeixIOSTAT;
+ ffestb_local_.close.left = TRUE;
+ ffestb_local_.close.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioSTATUS:
+ case FFESTR_genioDISP:
+ case FFESTR_genioDISPOSE:
+ ffestb_local_.close.ix = FFESTP_closeixSTATUS;
+ ffestb_local_.close.left = FALSE;
+ ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.close.ix = FFESTP_closeixUNIT;
+ ffestb_local_.close.left = FALSE;
+ ffestb_local_.close.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.close.close_spec[ffestb_local_.close.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.close.close_spec[ffestb_local_.close.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix]
+ .kw_present = TRUE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix]
+ .value_present = FALSE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label
+ = ffestb_local_.close.label;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9075_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_R9075_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9075_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.close.label)
+ return (ffelexHandler) ffestb_R9077_;
+ if (ffestb_local_.close.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.close.context,
+ (ffeexprCallback) ffestb_R9076_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.close.context,
+ (ffeexprCallback) ffestb_R9076_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R9076_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
+ = TRUE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9074_;
+ return (ffelexHandler) ffestb_R9079_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R9077_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R9077_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
+ = TRUE;
+ ffestp_file.close.close_spec[ffestb_local_.close.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9078_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R9078_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9078_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9074_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R9079_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R9079_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9079_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R907 ();
+ ffestb_subr_kill_close_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_close_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R909 -- Parse the READ statement
+
+ return ffestb_R909; // to lexer
+
+ Make sure the statement has a valid form for the READ
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R909 (ffelexToken t)
+{
+ ffelexHandler next;
+ ffestpReadIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstREAD)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9092_;
+
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstREAD)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
+ break;
+
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9092_;
+
+ default:
+ break;
+ }
+ for (ix = 0; ix < FFESTP_readix; ++ix)
+ ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlREAD);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9091_ -- "READ" expr
+
+ (ffestb_R9091_) // to expression handler
+
+ Make sure the next token is a COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_start (TRUE);
+ ffestb_subr_kill_read_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90915_);
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9092_ -- "READ" OPEN_PAREN
+
+ return ffestb_R9092_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9092_ (ffelexToken t)
+{
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9093_;
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9093_ -- "READ" OPEN_PAREN NAME
+
+ return ffestb_R9093_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9093_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+ ffelexToken ot;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffelex_token_kill (ffesta_tokens[1]);
+ nt = ffesta_tokens[2];
+ next = (ffelexHandler) ffestb_R9098_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ ot = ffesta_tokens[2];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
+ (nt);
+ ffelex_token_kill (nt);
+ next = (ffelexHandler) (*next) (ot);
+ ffelex_token_kill (ot);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN]
+
+ (ffestb_R9094_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here.
+
+ 15-Feb-91 JCB 1.1
+ Use new ffeexpr mechanism whereby the expr is encased in an opITEM if
+ ffeexpr decided it was an item in a control list (hence a unit
+ specifier), or a format specifier otherwise. */
+
+static ffelexHandler
+ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ if (expr == NULL)
+ goto bad; /* :::::::::::::::::::: */
+
+ if (ffebld_op (expr) != FFEBLD_opITEM)
+ {
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
+ = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_start (TRUE);
+ ffestb_subr_kill_read_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90915_);
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ }
+
+ expr = ffebld_head (expr);
+
+ if (expr == NULL)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9095_;
+ return (ffelexHandler) ffestb_R90913_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA
+
+ return ffestb_R9095_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9095_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9096_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
+ (t);
+ }
+}
+
+/* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME
+
+ return ffestb_R9096_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9096_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9098_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr
+
+ (ffestb_R9097_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9098_;
+ return (ffelexHandler) ffestb_R90913_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]]
+
+ return ffestb_R9098_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9098_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.read.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioADVANCE:
+ ffestb_local_.read.ix = FFESTP_readixADVANCE;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_genioEOR:
+ ffestb_local_.read.ix = FFESTP_readixEOR;
+ ffestb_local_.read.label = TRUE;
+ break;
+
+ case FFESTR_genioERR:
+ ffestb_local_.read.ix = FFESTP_readixERR;
+ ffestb_local_.read.label = TRUE;
+ break;
+
+ case FFESTR_genioEND:
+ ffestb_local_.read.ix = FFESTP_readixEND;
+ ffestb_local_.read.label = TRUE;
+ break;
+
+ case FFESTR_genioFMT:
+ ffestb_local_.read.ix = FFESTP_readixFORMAT;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.read.ix = FFESTP_readixIOSTAT;
+ ffestb_local_.read.left = TRUE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioKEY:
+ case FFESTR_genioKEYEQ:
+ ffestb_local_.read.ix = FFESTP_readixKEYEQ;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
+ break;
+
+ case FFESTR_genioKEYGE:
+ ffestb_local_.read.ix = FFESTP_readixKEYGE;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
+ break;
+
+ case FFESTR_genioKEYGT:
+ ffestb_local_.read.ix = FFESTP_readixKEYGT;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
+ break;
+
+ case FFESTR_genioKEYID:
+ ffestb_local_.read.ix = FFESTP_readixKEYID;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioNML:
+ ffestb_local_.read.ix = FFESTP_readixFORMAT;
+ ffestb_local_.read.left = TRUE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST;
+ break;
+
+ case FFESTR_genioNULLS:
+ ffestb_local_.read.ix = FFESTP_readixNULLS;
+ ffestb_local_.read.left = TRUE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioREC:
+ ffestb_local_.read.ix = FFESTP_readixREC;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioSIZE:
+ ffestb_local_.read.ix = FFESTP_readixSIZE;
+ ffestb_local_.read.left = TRUE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.read.ix = FFESTP_readixUNIT;
+ ffestb_local_.read.left = FALSE;
+ ffestb_local_.read.context = FFEEXPR_contextFILEUNIT;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .kw_present = TRUE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .value_present = FALSE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label
+ = ffestb_local_.read.label;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9099_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]] NAME
+
+ return ffestb_R9099_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9099_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.read.label)
+ return (ffelexHandler) ffestb_R90911_;
+ if (ffestb_local_.read.left)
+ return (ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.read.context,
+ (ffeexprCallback) ffestb_R90910_);
+ return (ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.read.context,
+ (ffeexprCallback) ffestb_R90910_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R90910_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT)
+ ffestp_file.read.read_spec[ffestb_local_.read.ix]
+ .value_is_label = TRUE;
+ else
+ break;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
+ = TRUE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9098_;
+ return (ffelexHandler) ffestb_R90913_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R90911_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R90911_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
+ = TRUE;
+ ffestp_file.read.read_spec[ffestb_local_.read.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R90912_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R90912_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R90912_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9098_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R90913_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R90913_; // to lexer
+
+ Handle EOS or SEMICOLON here.
+
+ 15-Feb-91 JCB 1.1
+ Fix to allow implied-DO construct here (OPEN_PAREN) -- actually,
+ don't presume knowledge of what an initial token in an lhs context
+ is going to be, let ffeexpr_lhs handle that as much as possible. */
+
+static ffelexHandler
+ffestb_R90913_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R909_start (FALSE);
+ ffestc_R909_finish ();
+ }
+ ffestb_subr_kill_read_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_confirmed ();
+ /* Fall through. */
+ case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
+ break;
+ }
+
+ /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine
+ about it, so leave it up to that code. */
+
+ /* EXTENSION: Allow an optional preceding COMMA here if not pedantic. (f2c
+ provides this extension, as do other compilers, supposedly.) */
+
+ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ return (ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90914_);
+
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90914_)))
+ (t);
+}
+
+/* ffestb_R90914_ -- "READ(...)" expr
+
+ (ffestb_R90914_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_start (FALSE);
+ ffestb_subr_kill_read_ ();
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_item (expr, ft);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90915_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_start (FALSE);
+ ffestb_subr_kill_read_ ();
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R909_item (expr, ft);
+ ffestc_R909_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_read_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R90915_ -- "READ(...)" expr COMMA expr
+
+ (ffestb_R90915_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_item (expr, ft);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestc_context_iolist (),
+ (ffeexprCallback) ffestb_R90915_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R909_item (expr, ft);
+ ffestc_R909_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R909_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R910 -- Parse the WRITE statement
+
+ return ffestb_R910; // to lexer
+
+ Make sure the statement has a valid form for the WRITE
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R910 (ffelexToken t)
+{
+ ffestpWriteIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_writeix; ++ix)
+ ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffestb_R9101_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+
+ for (ix = 0; ix < FFESTP_writeix; ++ix)
+ ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffestb_R9101_;
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9101_ -- "WRITE" OPEN_PAREN
+
+ return ffestb_R9101_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9101_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9102_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
+ (t);
+ }
+}
+
+/* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME
+
+ return ffestb_R9102_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9102_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9107_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN]
+
+ (ffestb_R9103_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9104_;
+ return (ffelexHandler) ffestb_R91012_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA
+
+ return ffestb_R9104_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9104_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9105_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
+ (t);
+ }
+}
+
+/* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME
+
+ return ffestb_R9105_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9105_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9107_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr
+
+ (ffestb_R9106_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE;
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE;
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9107_;
+ return (ffelexHandler) ffestb_R91012_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]]
+
+ return ffestb_R9107_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9107_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.write.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioADVANCE:
+ ffestb_local_.write.ix = FFESTP_writeixADVANCE;
+ ffestb_local_.write.left = FALSE;
+ ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_genioEOR:
+ ffestb_local_.write.ix = FFESTP_writeixEOR;
+ ffestb_local_.write.label = TRUE;
+ break;
+
+ case FFESTR_genioERR:
+ ffestb_local_.write.ix = FFESTP_writeixERR;
+ ffestb_local_.write.label = TRUE;
+ break;
+
+ case FFESTR_genioFMT:
+ ffestb_local_.write.ix = FFESTP_writeixFORMAT;
+ ffestb_local_.write.left = FALSE;
+ ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.write.ix = FFESTP_writeixIOSTAT;
+ ffestb_local_.write.left = TRUE;
+ ffestb_local_.write.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioNML:
+ ffestb_local_.write.ix = FFESTP_writeixFORMAT;
+ ffestb_local_.write.left = TRUE;
+ ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST;
+ break;
+
+ case FFESTR_genioREC:
+ ffestb_local_.write.ix = FFESTP_writeixREC;
+ ffestb_local_.write.left = FALSE;
+ ffestb_local_.write.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.write.ix = FFESTP_writeixUNIT;
+ ffestb_local_.write.left = FALSE;
+ ffestb_local_.write.context = FFEEXPR_contextFILEUNIT;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .kw_present = TRUE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .value_present = FALSE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label
+ = ffestb_local_.write.label;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9108_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]] NAME
+
+ return ffestb_R9108_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9108_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.write.label)
+ return (ffelexHandler) ffestb_R91010_;
+ if (ffestb_local_.write.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.write.context,
+ (ffeexprCallback) ffestb_R9109_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.write.context,
+ (ffeexprCallback) ffestb_R9109_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R9109_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT)
+ ffestp_file.write.write_spec[ffestb_local_.write.ix]
+ .value_is_label = TRUE;
+ else
+ break;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
+ = TRUE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9107_;
+ return (ffelexHandler) ffestb_R91012_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R91010_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R91010_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
+ = TRUE;
+ ffestp_file.write.write_spec[ffestb_local_.write.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R91011_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R91011_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R91011_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9107_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R91012_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R91012_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R91012_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R910_start ();
+ ffestc_R910_finish ();
+ }
+ ffestb_subr_kill_write_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_confirmed ();
+ /* Fall through. */
+ case FFELEX_typeOPEN_PAREN: /* Could still be assignment!! */
+
+ /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
+ (f2c provides this extension, as do other compilers, supposedly.) */
+
+ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_);
+
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_)))
+ (t);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91013_ -- "WRITE(...)" expr
+
+ (ffestb_R91013_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_start ();
+ ffestb_subr_kill_write_ ();
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_start ();
+ ffestb_subr_kill_write_ ();
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R910_item (expr, ft);
+ ffestc_R910_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_write_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr
+
+ (ffestb_R91014_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R910_item (expr, ft);
+ ffestc_R910_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R910_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R911 -- Parse the PRINT statement
+
+ return ffestb_R911; // to lexer
+
+ Make sure the statement has a valid form for the PRINT
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R911 (ffelexToken t)
+{
+ ffelexHandler next;
+ ffestpPrintIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstPRINT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_printix; ++ix)
+ ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstPRINT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPRINT)
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+ for (ix = 0; ix < FFESTP_printix; ++ix)
+ ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlPRINT);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9111_ -- "PRINT" expr
+
+ (ffestb_R9111_) // to expression handler
+
+ Make sure the next token is a COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE;
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE;
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_R911_start ();
+ ffestb_subr_kill_print_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
+ if (!ffesta_is_inhibited ())
+ ffestc_R911_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_print_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9112_ -- "PRINT" expr COMMA expr
+
+ (ffestb_R9112_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R911_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R911_item (expr, ft);
+ ffestc_R911_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R911_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R923 -- Parse an INQUIRE statement
+
+ return ffestb_R923; // to lexer
+
+ Make sure the statement has a valid form for an INQUIRE statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R923 (ffelexToken t)
+{
+ ffestpInquireIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstINQUIRE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstINQUIRE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_inquireix; ++ix)
+ ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE;
+
+ ffestb_local_.inquire.may_be_iolength = TRUE;
+ return (ffelexHandler) ffestb_R9231_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN
+
+ return ffestb_R9231_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9231_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9232_;
+
+ default:
+ ffestb_local_.inquire.may_be_iolength = FALSE;
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
+ (t);
+ }
+}
+
+/* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME
+
+ return ffestb_R9232_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_R9232_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_R9234_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ ffestb_local_.inquire.may_be_iolength = FALSE;
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr
+
+ (ffestb_R9233_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9234_;
+ return (ffelexHandler) ffestb_R9239_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_R9234_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_R9234_ (ffelexToken t)
+{
+ ffestrInquire kw;
+
+ ffestb_local_.inquire.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_inquire (t);
+ if (kw != FFESTR_inquireIOLENGTH)
+ ffestb_local_.inquire.may_be_iolength = FALSE;
+ switch (kw)
+ {
+ case FFESTR_inquireACCESS:
+ ffestb_local_.inquire.ix = FFESTP_inquireixACCESS;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireACTION:
+ ffestb_local_.inquire.ix = FFESTP_inquireixACTION;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireBLANK:
+ ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireCARRIAGECONTROL:
+ ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireDEFAULTFILE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
+ ffestb_local_.inquire.left = FALSE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireDELIM:
+ ffestb_local_.inquire.ix = FFESTP_inquireixDELIM;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireDIRECT:
+ ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireERR:
+ ffestb_local_.inquire.ix = FFESTP_inquireixERR;
+ ffestb_local_.inquire.label = TRUE;
+ break;
+
+ case FFESTR_inquireEXIST:
+ ffestb_local_.inquire.ix = FFESTP_inquireixEXIST;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
+ break;
+
+ case FFESTR_inquireFILE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixFILE;
+ ffestb_local_.inquire.left = FALSE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireFORM:
+ ffestb_local_.inquire.ix = FFESTP_inquireixFORM;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireFORMATTED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireIOLENGTH:
+ if (!ffestb_local_.inquire.may_be_iolength)
+ goto bad; /* :::::::::::::::::::: */
+ ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_inquireIOSTAT:
+ ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_inquireKEYED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixKEYED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireNAME:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireNAMED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
+ break;
+
+ case FFESTR_inquireNEXTREC:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT;
+ break;
+
+ case FFESTR_inquireNUMBER:
+ ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_inquireOPENED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixOPENED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
+ break;
+
+ case FFESTR_inquireORGANIZATION:
+ ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquirePAD:
+ ffestb_local_.inquire.ix = FFESTP_inquireixPAD;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquirePOSITION:
+ ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireREAD:
+ ffestb_local_.inquire.ix = FFESTP_inquireixREAD;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireREADWRITE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireRECL:
+ ffestb_local_.inquire.ix = FFESTP_inquireixRECL;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_inquireRECORDTYPE:
+ ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
+ break;
+
+ case FFESTR_inquireSEQUENTIAL:
+ ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireUNFORMATTED:
+ ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED;
+ ffestb_local_.inquire.left = TRUE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
+ break;
+
+ case FFESTR_inquireUNIT:
+ ffestb_local_.inquire.ix = FFESTP_inquireixUNIT;
+ ffestb_local_.inquire.left = FALSE;
+ ffestb_local_.inquire.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
+ .kw_present = TRUE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
+ .value_present = FALSE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label
+ = ffestb_local_.inquire.label;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9235_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_R9235_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_R9235_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.inquire.label)
+ return (ffelexHandler) ffestb_R9237_;
+ if (ffestb_local_.inquire.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.inquire.context,
+ (ffeexprCallback) ffestb_R9236_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.inquire.context,
+ (ffeexprCallback) ffestb_R9236_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_R9236_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
+ break; /* IOLENGTH=expr must be followed by
+ CLOSE_PAREN. */
+ /* Fall through. */
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
+ = TRUE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_R9234_;
+ if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
+ return (ffelexHandler) ffestb_R92310_;
+ return (ffelexHandler) ffestb_R9239_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_R9237_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_R9237_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
+ = TRUE;
+ ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R9238_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_R9238_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_R9238_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_R9234_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_R9239_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_R9239_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R9239_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R923A ();
+ ffestb_subr_kill_inquire_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)"
+
+ return ffestb_R92310_; // to lexer
+
+ Make sure EOS or SEMICOLON not here; begin R923B processing and expect
+ output IO list. */
+
+static ffelexHandler
+ffestb_R92310_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ break;
+
+ default:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R923B_start ();
+ ffestb_subr_kill_inquire_ ();
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_)))
+ (t);
+ }
+
+ ffestb_subr_kill_inquire_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr
+
+ (ffestb_R92311_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R923B_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R923B_item (expr, ft);
+ ffestc_R923B_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R923B_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V018 -- Parse the REWRITE statement
+
+ return ffestb_V018; // to lexer
+
+ Make sure the statement has a valid form for the REWRITE
+ statement. If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V018 (ffelexToken t)
+{
+ ffestpRewriteIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstREWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ for (ix = 0; ix < FFESTP_rewriteix; ++ix)
+ ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffestb_V0181_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstREWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREWRITE)
+ goto bad_0; /* :::::::::::::::::::: */
+
+ for (ix = 0; ix < FFESTP_rewriteix; ++ix)
+ ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) ffestb_V0181_;
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0181_ -- "REWRITE" OPEN_PAREN
+
+ return ffestb_V0181_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0181_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0182_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
+ (t);
+ }
+}
+
+/* ffestb_V0182_ -- "REWRITE" OPEN_PAREN NAME
+
+ return ffestb_V0182_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_V0182_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_V0187_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0183_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_V0183_ -- "REWRITE" OPEN_PAREN expr [CLOSE_PAREN]
+
+ (ffestb_V0183_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0183_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].kw_present = FALSE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_present = TRUE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0184_;
+ return (ffelexHandler) ffestb_V01812_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0184_ -- "REWRITE" OPEN_PAREN expr COMMA
+
+ return ffestb_V0184_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0184_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0185_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
+ (t);
+ }
+}
+
+/* ffestb_V0185_ -- "REWRITE" OPEN_PAREN expr COMMA NAME
+
+ return ffestb_V0185_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_V0185_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_V0187_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMAT, (ffeexprCallback) ffestb_V0186_)))
+ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_V0186_ -- "REWRITE" OPEN_PAREN expr COMMA expr
+
+ (ffestb_V0186_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0186_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present
+ = TRUE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present = FALSE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_present = TRUE;
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value_is_label
+ = (expr == NULL);
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value
+ = ffelex_token_use (ft);
+ ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0187_;
+ return (ffelexHandler) ffestb_V01812_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0187_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]]
+
+ return ffestb_V0187_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0187_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.rewrite.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.rewrite.ix = FFESTP_rewriteixERR;
+ ffestb_local_.rewrite.label = TRUE;
+ break;
+
+ case FFESTR_genioFMT:
+ ffestb_local_.rewrite.ix = FFESTP_rewriteixFMT;
+ ffestb_local_.rewrite.left = FALSE;
+ ffestb_local_.rewrite.context = FFEEXPR_contextFILEFORMAT;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.rewrite.ix = FFESTP_rewriteixIOSTAT;
+ ffestb_local_.rewrite.left = TRUE;
+ ffestb_local_.rewrite.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.rewrite.ix = FFESTP_rewriteixUNIT;
+ ffestb_local_.rewrite.left = FALSE;
+ ffestb_local_.rewrite.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .kw_present = TRUE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .value_present = FALSE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_is_label
+ = ffestb_local_.rewrite.label;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0188_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0188_ -- "REWRITE" OPEN_PAREN [external-file-unit COMMA [format
+ COMMA]] NAME
+
+ return ffestb_V0188_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_V0188_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.rewrite.label)
+ return (ffelexHandler) ffestb_V01810_;
+ if (ffestb_local_.rewrite.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.rewrite.context,
+ (ffeexprCallback) ffestb_V0189_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.rewrite.context,
+ (ffeexprCallback) ffestb_V0189_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0189_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_V0189_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0189_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ if (ffestb_local_.rewrite.context == FFEEXPR_contextFILEFORMAT)
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix]
+ .value_is_label = TRUE;
+ else
+ break;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
+ = TRUE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0187_;
+ return (ffelexHandler) ffestb_V01812_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01810_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_V01810_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_V01810_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value_present
+ = TRUE;
+ ffestp_file.rewrite.rewrite_spec[ffestb_local_.rewrite.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V01811_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01811_ -- "REWRITE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_V01811_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V01811_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_V0187_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_V01812_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01812_ -- "REWRITE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_V01812_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V01812_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V018_start ();
+ ffestc_V018_finish ();
+ }
+ ffestb_subr_kill_rewrite_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeOPEN_PAREN:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V018_start ();
+ ffestb_subr_kill_rewrite_ ();
+
+ /* EXTENSION: Allow an optional preceding COMMA here if not pedantic.
+ (f2c provides this extension, as do other compilers, supposedly.) */
+
+ if (!ffe_is_pedantic () && (ffelex_token_type (t) == FFELEX_typeCOMMA))
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
+
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_)))
+ (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_rewrite_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V01813_ -- "REWRITE(...)" expr
+
+ (ffestb_V01813_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V01813_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_V018_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V01813_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V018_item (expr, ft);
+ ffestc_V018_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V018_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "REWRITE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V019 -- Parse the ACCEPT statement
+
+ return ffestb_V019; // to lexer
+
+ Make sure the statement has a valid form for the ACCEPT
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_V019 (ffelexToken t)
+{
+ ffelexHandler next;
+ ffestpAcceptIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstACCEPT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_acceptix; ++ix)
+ ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstACCEPT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlACCEPT)
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+ for (ix = 0; ix < FFESTP_acceptix; ++ix)
+ ffestp_file.accept.accept_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0191_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlACCEPT);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0191_ -- "ACCEPT" expr
+
+ (ffestb_V0191_) // to expression handler
+
+ Make sure the next token is a COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0191_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].kw_present = FALSE;
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_present = TRUE;
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_V019_start ();
+ ffestb_subr_kill_accept_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST,
+ (ffeexprCallback) ffestb_V0192_);
+ if (!ffesta_is_inhibited ())
+ ffestc_V019_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_accept_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0192_ -- "ACCEPT" expr COMMA expr
+
+ (ffestb_V0192_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0192_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_V019_item (expr, ft);
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST,
+ (ffeexprCallback) ffestb_V0192_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V019_item (expr, ft);
+ ffestc_V019_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V019_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ACCEPT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V020 -- Parse the TYPE statement
+
+ return ffestb_V020; // to lexer
+
+ Make sure the statement has a valid form for the TYPE
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_V020 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexHandler next;
+ ffestpTypeIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ case FFELEX_typeCOMMA: /* Because "TYPE,PUBLIC::A" is ambiguous with
+ '90. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNUMBER:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeNAME: /* Because TYPE A is ambiguous with '90. */
+ default:
+ break;
+ }
+
+ for (ix = 0; ix < FFESTP_typeix; ++ix)
+ ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
+ return (ffelexHandler) (*((ffelexHandler)
+ ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_)))
+ (t);
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (ffelex_token_length (ffesta_tokens[0]) == FFESTR_firstlTYPE)
+ break; /* Else might be assignment/stmtfuncdef. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typeCOLON:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
+ if (isdigit (*p))
+ ffesta_confirmed (); /* Else might be '90 TYPE statement. */
+ for (ix = 0; ix < FFESTP_typeix; ++ix)
+ ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
+ next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_);
+ next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
+ FFESTR_firstlTYPE);
+ if (next == NULL)
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0201_ -- "TYPE" expr
+
+ (ffestb_V0201_) // to expression handler
+
+ Make sure the next token is a COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ bool comma = TRUE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffe_is_vxt () && (expr != NULL)
+ && (ffebld_op (expr) == FFEBLD_opSYMTER))
+ break;
+ comma = FALSE;
+ /* Fall through. */
+ case FFELEX_typeCOMMA:
+ if (!ffe_is_vxt () && comma && (expr != NULL)
+ && (ffebld_op (expr) == FFEBLD_opPAREN)
+ && (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER))
+ break;
+ ffesta_confirmed ();
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_or_val_present
+ = TRUE;
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_present = FALSE;
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_present = TRUE;
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_is_label
+ = (expr == NULL);
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value
+ = ffelex_token_use (ft);
+ ffestp_file.type.type_spec[FFESTP_typeixFORMAT].u.expr = expr;
+ if (!ffesta_is_inhibited ())
+ ffestc_V020_start ();
+ ffestb_subr_kill_type_ ();
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
+ if (!ffesta_is_inhibited ())
+ ffestc_V020_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_type_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0202_ -- "TYPE" expr COMMA expr
+
+ (ffestb_V0202_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_V020_item (expr, ft);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V020_item (expr, ft);
+ ffestc_V020_finish ();
+ }
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V020_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V021 -- Parse a DELETE statement
+
+ return ffestb_V021; // to lexer
+
+ Make sure the statement has a valid form for a DELETE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V021 (ffelexToken t)
+{
+ ffestpDeleteIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstDELETE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstDELETE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlDELETE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_deleteix; ++ix)
+ ffestp_file.delete.delete_spec[ix].kw_or_val_present = FALSE;
+
+ return (ffelexHandler) ffestb_V0211_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0211_ -- "DELETE" OPEN_PAREN
+
+ return ffestb_V0211_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0211_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0212_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
+ (t);
+ }
+}
+
+/* ffestb_V0212_ -- "DELETE" OPEN_PAREN NAME
+
+ return ffestb_V0212_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_V0212_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_V0214_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0213_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_V0213_ -- "DELETE" OPEN_PAREN expr
+
+ (ffestb_V0213_) // to expression handler
+
+ Handle COMMA or DELETE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0213_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].kw_present = FALSE;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_present = TRUE;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0214_;
+ return (ffelexHandler) ffestb_V0219_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0214_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_V0214_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0214_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.delete.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.delete.ix = FFESTP_deleteixERR;
+ ffestb_local_.delete.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.delete.ix = FFESTP_deleteixIOSTAT;
+ ffestb_local_.delete.left = TRUE;
+ ffestb_local_.delete.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioREC:
+ ffestb_local_.delete.ix = FFESTP_deleteixREC;
+ ffestb_local_.delete.left = FALSE;
+ ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.delete.ix = FFESTP_deleteixUNIT;
+ ffestb_local_.delete.left = FALSE;
+ ffestb_local_.delete.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+ .kw_present = TRUE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix]
+ .value_present = FALSE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_is_label
+ = ffestb_local_.delete.label;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0215_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0215_ -- "DELETE" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_V0215_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_V0215_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.delete.label)
+ return (ffelexHandler) ffestb_V0217_;
+ if (ffestb_local_.delete.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.delete.context,
+ (ffeexprCallback) ffestb_V0216_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.delete.context, (ffeexprCallback) ffestb_V0216_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0216_ -- "DELETE" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_V0216_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0216_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
+ = TRUE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0214_;
+ return (ffelexHandler) ffestb_V0219_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0217_ -- "DELETE" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_V0217_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_V0217_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value_present
+ = TRUE;
+ ffestp_file.delete.delete_spec[ffestb_local_.delete.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0218_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0218_ -- "DELETE" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_V0218_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0218_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_V0214_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_V0219_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0219_ -- "DELETE" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_V0219_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0219_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V021 ();
+ ffestb_subr_kill_delete_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_delete_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DELETE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V026 -- Parse a FIND statement
+
+ return ffestb_V026; // to lexer
+
+ Make sure the statement has a valid form for a FIND statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_V026 (ffelexToken t)
+{
+ ffestpFindIx ix;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstFIND)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstFIND)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFIND)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ for (ix = 0; ix < FFESTP_findix; ++ix)
+ ffestp_file.find.find_spec[ix].kw_or_val_present = FALSE;
+
+ return (ffelexHandler) ffestb_V0261_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_V0261_ -- "FIND" OPEN_PAREN
+
+ return ffestb_V0261_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0261_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0262_;
+
+ default:
+ return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
+ (t);
+ }
+}
+
+/* ffestb_V0262_ -- "FIND" OPEN_PAREN NAME
+
+ return ffestb_V0262_; // to lexer
+
+ If EQUALS here, go to states that handle it. Else, send NAME and this
+ token thru expression handler. */
+
+static ffelexHandler
+ffestb_V0262_ (ffelexToken t)
+{
+ ffelexHandler next;
+ ffelexToken nt;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ nt = ffesta_tokens[1];
+ next = (ffelexHandler) ffestb_V0264_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_V0263_)))
+ (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) (*next) (t);
+ }
+}
+
+/* ffestb_V0263_ -- "FIND" OPEN_PAREN expr
+
+ (ffestb_V0263_) // to expression handler
+
+ Handle COMMA or FIND_PAREN here. */
+
+static ffelexHandler
+ffestb_V0263_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_or_val_present
+ = TRUE;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].kw_present = FALSE;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].value_present = TRUE;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].value_is_label
+ = FALSE;
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].value
+ = ffelex_token_use (ft);
+ ffestp_file.find.find_spec[FFESTP_findixUNIT].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0264_;
+ return (ffelexHandler) ffestb_V0269_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0264_ -- "FIND" OPEN_PAREN [external-file-unit COMMA]
+
+ return ffestb_V0264_; // to lexer
+
+ Handle expr construct (not NAME=expr construct) here. */
+
+static ffelexHandler
+ffestb_V0264_ (ffelexToken t)
+{
+ ffestrGenio kw;
+
+ ffestb_local_.find.label = FALSE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ kw = ffestr_genio (t);
+ switch (kw)
+ {
+ case FFESTR_genioERR:
+ ffestb_local_.find.ix = FFESTP_findixERR;
+ ffestb_local_.find.label = TRUE;
+ break;
+
+ case FFESTR_genioIOSTAT:
+ ffestb_local_.find.ix = FFESTP_findixIOSTAT;
+ ffestb_local_.find.left = TRUE;
+ ffestb_local_.find.context = FFEEXPR_contextFILEINT;
+ break;
+
+ case FFESTR_genioREC:
+ ffestb_local_.find.ix = FFESTP_findixREC;
+ ffestb_local_.find.left = FALSE;
+ ffestb_local_.find.context = FFEEXPR_contextFILENUM;
+ break;
+
+ case FFESTR_genioUNIT:
+ ffestb_local_.find.ix = FFESTP_findixUNIT;
+ ffestb_local_.find.left = FALSE;
+ ffestb_local_.find.context = FFEEXPR_contextFILENUM;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.find.find_spec[ffestb_local_.find.ix]
+ .kw_or_val_present)
+ break; /* Can't specify a keyword twice! */
+ ffestp_file.find.find_spec[ffestb_local_.find.ix]
+ .kw_or_val_present = TRUE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix]
+ .kw_present = TRUE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix]
+ .value_present = FALSE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value_is_label
+ = ffestb_local_.find.label;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].kw
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0265_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0265_ -- "FIND" OPEN_PAREN [external-file-unit COMMA] NAME
+
+ return ffestb_V0265_; // to lexer
+
+ Make sure EQUALS here, send next token to expression handler. */
+
+static ffelexHandler
+ffestb_V0265_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (ffestb_local_.find.label)
+ return (ffelexHandler) ffestb_V0267_;
+ if (ffestb_local_.find.left)
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ ffestb_local_.find.context,
+ (ffeexprCallback) ffestb_V0266_);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.find.context,
+ (ffeexprCallback) ffestb_V0266_);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0266_ -- "FIND" OPEN_PAREN ... NAME EQUALS expr
+
+ (ffestb_V0266_) // to expression handler
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0266_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
+ = TRUE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value
+ = ffelex_token_use (ft);
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].u.expr = expr;
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_V0264_;
+ return (ffelexHandler) ffestb_V0269_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0267_ -- "FIND" OPEN_PAREN ... NAME EQUALS
+
+ return ffestb_V0267_; // to lexer
+
+ Handle NUMBER for label here. */
+
+static ffelexHandler
+ffestb_V0267_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value_present
+ = TRUE;
+ ffestp_file.find.find_spec[ffestb_local_.find.ix].value
+ = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0268_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0268_ -- "FIND" OPEN_PAREN ... NAME EQUALS NUMBER
+
+ return ffestb_V0268_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN here. */
+
+static ffelexHandler
+ffestb_V0268_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_V0264_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_V0269_;
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0269_ -- "FIND" OPEN_PAREN ... CLOSE_PAREN
+
+ return ffestb_V0269_; // to lexer
+
+ Handle EOS or SEMICOLON here. */
+
+static ffelexHandler
+ffestb_V0269_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V026 ();
+ ffestb_subr_kill_find_ ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestb_subr_kill_find_ ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FIND", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_dimlist -- Parse the ALLOCATABLE/POINTER/TARGET statement
+
+ return ffestb_dimlist; // to lexer
+
+ Make sure the statement has a valid form for the ALLOCATABLE/POINTER/
+ TARGET statement. If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_dimlist (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ return (ffelexHandler) ffestb_dimlist1_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ return (ffelexHandler) ffestb_dimlist1_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dimlist.len);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ next = (ffelexHandler) ffestb_dimlist1_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ return (ffelexHandler) ffestb_dimlist1_;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ ffestb_local_.dimlist.started = FALSE;
+ next = (ffelexHandler) ffestb_dimlist1_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist1_ -- "ALLOCATABLE/POINTER/TARGET" [COLONCOLON]
+
+ return ffestb_dimlist1_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_dimlist1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_dimlist2_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist2_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME
+
+ return ffestb_dimlist2_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_dimlist2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_dimlist3_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLIST;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDIMLIST, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimlist.started)
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ }
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_item (ffesta_tokens[1], NULL);
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_item (ffesta_tokens[1], NULL);
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_item (ffesta_tokens[1], NULL);
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_dimlist4_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimlist.started)
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_item (ffesta_tokens[1], NULL);
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_item (ffesta_tokens[1], NULL);
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_item (ffesta_tokens[1], NULL);
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist3_ -- "ALLOCATABLE/POINTER/TARGET" ... NAME OPEN_PAREN
+ dimlist CLOSE_PAREN
+
+ return ffestb_dimlist3_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_dimlist3_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimlist.started)
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ ffestb_local_.dimlist.started = TRUE;
+ }
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_dimlist4_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimlist.started)
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_start ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_start ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_start ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ if (ffestb_local_.dimlist.started && !ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dimlist4_ -- "ALLOCATABLE/POINTER/TARGET" ... COMMA
+
+ return ffestb_dimlist4_; // to lexer
+
+ Make sure we don't have EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_dimlist4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffesta_first_kw)
+ {
+ case FFESTR_firstALLOCATABLE:
+ ffestc_R525_finish ();
+ break;
+
+ case FFESTR_firstPOINTER:
+ ffestc_R526_finish ();
+ break;
+
+ case FFESTR_firstTARGET:
+ ffestc_R527_finish ();
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dimlist.badname, t);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ return (ffelexHandler) ffestb_dimlist1_ (t);
+ }
+}
+
+#endif
+/* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
+
+ return ffestb_dummy; // to lexer
+
+ Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_dummy (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
+ ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
+ ffestb_local_.dummy.first_kw = ffesta_first_kw;
+ return (ffelexHandler) ffestb_dummy1_;
+
+ case FFELEX_typeNAMES:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dummy.len);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1]
+ = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
+ ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
+ ffestb_local_.dummy.first_kw = ffesta_first_kw;
+ return (ffelexHandler) ffestb_dummy1_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dummy1_ -- "ENTRY/FUNCTION/SUBROUTINE" NAME
+
+ return ffestb_dummy1_; // to lexer
+
+ Make sure the next token is an EOS, SEMICOLON, or OPEN_PAREN. In the
+ former case, just implement a null arg list, else get the arg list and
+ then implement. */
+
+static ffelexHandler
+ffestb_dummy1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (ffestb_local_.dummy.first_kw == FFESTR_firstFUNCTION)
+ {
+ ffesta_confirmed (); /* Later, not if typename w/o RECURSIVE. */
+ break; /* Produce an error message, need that open
+ paren. */
+ }
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ { /* Pretend as though we got a truly NULL
+ list. */
+ ffestb_subrargs_.name_list.args = NULL;
+ ffestb_subrargs_.name_list.ok = TRUE;
+ ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_dummy2_ (t);
+ }
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
+ ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_dummy2_;
+ ffestb_subrargs_.name_list.is_subr = ffestb_local_.dummy.is_subr;
+ ffestb_subrargs_.name_list.names = FALSE;
+ return (ffelexHandler) ffestb_subr_name_list_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_dummy2_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN
+
+ return ffestb_dummy2_; // to lexer
+
+ Make sure the statement has a valid form for a dummy-def statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_dummy2_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.name_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ switch (ffestb_local_.dummy.first_kw)
+ {
+ case FFESTR_firstFUNCTION:
+ ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone,
+ NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL);
+ break;
+
+ case FFESTR_firstSUBROUTINE:
+ ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren,
+ ffestb_local_.decl.recursive);
+ break;
+
+ case FFESTR_firstENTRY:
+ ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren);
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ if (ffestb_subrargs_.name_list.args != NULL)
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION)
+ || (ffestr_other (t) != FFESTR_otherRESULT))
+ break;
+ ffestb_local_.decl.type = FFESTP_typeNone;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_funcname_6_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ if (ffestb_subrargs_.name_list.args != NULL)
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R524 -- Parse the DIMENSION statement
+
+ return ffestb_R524; // to lexer
+
+ Make sure the statement has a valid form for the DIMENSION statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_R524 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
+ ffestb_local_.dimension.started = TRUE;
+ return (ffelexHandler) ffestb_R5241_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.R524.len);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+
+ /* Here, we have at least one char after "DIMENSION" and t is
+ OPEN_PAREN. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ ffestb_local_.dimension.started = FALSE;
+ next = (ffelexHandler) ffestb_R5241_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5241_ -- "DIMENSION"
+
+ return ffestb_R5241_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5241_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5242_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R524_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5242_ -- "DIMENSION" ... NAME
+
+ return ffestb_R5242_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_R5242_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5243_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
+ ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R524_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5243_ -- "DIMENSION" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+ return ffestb_R5243_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5243_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimension.started)
+ {
+ ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
+ ffestb_local_.dimension.started = TRUE;
+ }
+ ffestc_R524_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_R5244_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.dimension.started)
+ {
+ ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
+ ffestb_local_.dimension.started = TRUE;
+ }
+ ffestc_R524_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R524_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ if (ffestb_local_.dimension.started && !ffesta_is_inhibited ())
+ ffestc_R524_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5244_ -- "DIMENSION" ... COMMA
+
+ return ffestb_R5244_; // to lexer
+
+ Make sure we don't have EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5244_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R524_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ return (ffelexHandler) ffestb_R5241_ (t);
+ }
+}
+
+/* ffestb_R547 -- Parse the COMMON statement
+
+ return ffestb_R547; // to lexer
+
+ Make sure the statement has a valid form for the COMMON statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_R547 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCOMMON)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ return (ffelexHandler) ffestb_R5471_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCOMMON)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCOMMON);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ return (ffelexHandler) ffestb_R5471_ (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+
+ /* Here, we have at least one char after "COMMON" and t is COMMA,
+ EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
+ ffestb_local_.common.started = FALSE;
+ else
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ }
+ next = (ffelexHandler) ffestb_R5471_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5471_ -- "COMMON"
+
+ return ffestb_R5471_; // to lexer
+
+ Handle NAME, SLASH, or CONCAT. */
+
+static ffelexHandler
+ffestb_R5471_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ return (ffelexHandler) ffestb_R5474_ (t);
+
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_R5472_;
+
+ case FFELEX_typeCONCAT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_cblock (NULL);
+ return (ffelexHandler) ffestb_R5474_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5472_ -- "COMMON" SLASH
+
+ return ffestb_R5472_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5472_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5473_;
+
+ case FFELEX_typeSLASH:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_cblock (NULL);
+ return (ffelexHandler) ffestb_R5474_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5473_ -- "COMMON" SLASH NAME
+
+ return ffestb_R5473_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_R5473_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_cblock (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5474_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5474_ -- "COMMON" [SLASH NAME SLASH] or "COMMON" CONCAT
+
+ return ffestb_R5474_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_R5474_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_R5475_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5475_ -- "COMMON" ... NAME
+
+ return ffestb_R5475_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_R5475_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_R5476_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_object (ffesta_tokens[1], NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5477_;
+
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_item_object (ffesta_tokens[1], NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_R5471_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_R547_item_object (ffesta_tokens[1], NULL);
+ ffestc_R547_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5476_ -- "COMMON" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+ return ffestb_R5476_; // to lexer
+
+ Handle COMMA, SLASH, CONCAT, EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5476_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.common.started)
+ {
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ }
+ ffestc_R547_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_R5477_;
+
+ case FFELEX_typeSLASH:
+ case FFELEX_typeCONCAT:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.common.started)
+ {
+ ffestc_R547_start ();
+ ffestb_local_.common.started = TRUE;
+ }
+ ffestc_R547_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_R5471_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.common.started)
+ ffestc_R547_start ();
+ ffestc_R547_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_R547_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ if (ffestb_local_.common.started && !ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R5477_ -- "COMMON" ... COMMA
+
+ return ffestb_R5477_; // to lexer
+
+ Make sure we don't have EOS or SEMICOLON. */
+
+static ffelexHandler
+ffestb_R5477_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R547_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ return (ffelexHandler) ffestb_R5471_ (t);
+ }
+}
+
+/* ffestb_R624 -- Parse a NULLIFY statement
+
+ return ffestb_R624; // to lexer
+
+ Make sure the statement has a valid form for a NULLIFY
+ statement. If it does, implement the statement.
+
+ 31-May-90 JCB 2.0
+ Rewrite to produce a list of expressions rather than just names; this
+ eases semantic checking, putting it in expression handling where that
+ kind of thing gets done anyway, and makes it easier to support more
+ flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_R624 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstNULLIFY)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstNULLIFY)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlNULLIFY)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeNAME:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.R624.exprs = ffestt_exprlist_create ();
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextNULLIFY,
+ (ffeexprCallback) ffestb_R6241_);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_R6241_ -- "NULLIFY" OPEN_PAREN expr
+
+ return ffestb_R6241_; // to lexer
+
+ Make sure the statement has a valid form for a NULLIFY statement. If it
+ does, implement the statement.
+
+ 31-May-90 JCB 2.0
+ Rewrite to produce a list of expressions rather than just names; this
+ eases semantic checking, putting it in expression handling where that
+ kind of thing gets done anyway, and makes it easier to support more
+ flexible extensions to Fortran 90 like NULLIFY(FOO%BAR). */
+
+static ffelexHandler
+ffestb_R6241_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_R6242_;
+
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ ffestt_exprlist_append (ffestb_local_.R624.exprs, expr,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
+ FFEEXPR_contextNULLIFY,
+ (ffeexprCallback) ffestb_R6241_);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+ ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R6242_ -- "NULLIFY" OPEN_PAREN expr-list CLOSE_PAREN
+
+ return ffestb_R6242_; // to lexer
+
+ Make sure the statement has a valid form for a NULLIFY statement. If it
+ does, implement the statement. */
+
+static ffelexHandler
+ffestb_R6242_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R624 (ffestb_local_.R624.exprs);
+ ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NULLIFY", t);
+ ffestt_exprlist_kill (ffestb_local_.R624.exprs);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_R1229 -- Parse a STMTFUNCTION statement
+
+ return ffestb_R1229; // to lexer
+
+ Make sure the statement has a valid form for a STMTFUNCTION
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_R1229 (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeNAME:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
+ ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_;
+ ffestb_subrargs_.name_list.is_subr = FALSE; /* No "*" items in list! */
+ ffestb_subrargs_.name_list.names = TRUE; /* In case "IF(FOO)CALL
+ FOO...". */
+ return (ffelexHandler) ffestb_subr_name_list_;
+
+bad_0: /* :::::::::::::::::::: */
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
+
+ return ffestb_R12291_; // to lexer
+
+ Make sure the statement has a valid form for a STMTFUNCTION statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12291_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ if (!ffestb_subrargs_.name_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1229_start (ffesta_tokens[0],
+ ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
+ EQUALS expr
+
+ (ffestb_R12292_) // to expression handler
+
+ Make sure the statement has a valid form for a STMTFUNCTION statement. If
+ it does, implement the statement. */
+
+static ffelexHandler
+ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ if (expr == NULL)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1229_finish (expr, ft);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffestc_R1229_finish (NULL, NULL);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_chartype -- Parse the CHARACTER statement
+
+ return ffestb_decl_chartype; // to lexer
+
+ Make sure the statement has a valid form for the CHARACTER statement. If
+ it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_chartype (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstCHRCTR)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_starlen_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "_TYPEDECL";
+ return (ffelexHandler) ffestb_decl_typeparams_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstCHRCTR)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCHRCTR);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_starlen_;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (*p != '\0')
+ break;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_typeparams_;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_decl_entsp_2_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_chartype1_ -- "CHARACTER" ASTERISK char-length
+
+ return ffestb_decl_chartype1_; // to lexer
+
+ Handle COMMA, COLONCOLON, or anything else. */
+
+static ffelexHandler
+ffestb_decl_chartype1_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ /* Fall through. */
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ default:
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+}
+
+/* ffestb_decl_dbltype -- Parse the DOUBLEPRECISION/DOUBLECOMPLEX statement
+
+ return ffestb_decl_dbltype; // to lexer
+
+ Make sure the statement has a valid form for the DOUBLEPRECISION/
+ DOUBLECOMPLEX statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_dbltype (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffestb_local_.decl.type = ffestb_args.decl.type;
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeOPEN_PAREN:
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_decl_entsp_2_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_double -- Parse the DOUBLE PRECISION/DOUBLE COMPLEX statement
+
+ return ffestb_decl_double; // to lexer
+
+ Make sure the statement has a valid form for the DOUBLE PRECISION/
+ DOUBLE COMPLEX statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_double (ffelexToken t)
+{
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstDBL)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ switch (ffestr_second (t))
+ {
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ break;
+
+ case FFESTR_secondPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_attrsp_;
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_decl_gentype -- Parse the INTEGER/REAL/COMPLEX/LOGICAL statement
+
+ return ffestb_decl_gentype; // to lexer
+
+ Make sure the statement has a valid form for the INTEGER/REAL/COMPLEX/
+ LOGICAL statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_gentype (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+
+ ffestb_local_.decl.type = ffestb_args.decl.type;
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_starkind_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_kindparam_;
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+
+ case FFELEX_typeNAMES:
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ break;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_starkind_;
+
+ case FFELEX_typeOPEN_PAREN:
+ if (*p != '\0')
+ break;
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "TYPEDECL";
+ return (ffelexHandler) ffestb_decl_kindparam_;
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
+ return (ffelexHandler) ffestb_decl_entsp_2_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive -- Parse the RECURSIVE FUNCTION statement
+
+ return ffestb_decl_recursive; // to lexer
+
+ Make sure the statement has a valid form for the RECURSIVE FUNCTION
+ statement. If it does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_decl_recursive (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexToken ot;
+ ffelexHandler next;
+ bool needfunc;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstRECURSIVE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+ ffesta_confirmed ();
+ ffestb_local_.decl.recursive = ffelex_token_use (ffesta_tokens[0]);
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondINTEGER:
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondBYTE:
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondWORD:
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondREAL:
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondLOGICAL:
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondCHARACTER:
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ return (ffelexHandler) ffestb_decl_recursive1_;
+
+ case FFESTR_secondDOUBLE:
+ return (ffelexHandler) ffestb_decl_recursive2_;
+
+ case FFESTR_secondDOUBLEPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_func_;
+
+ case FFESTR_secondDOUBLECOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_func_;
+
+ case FFESTR_secondTYPE:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ return (ffelexHandler) ffestb_decl_recursive3_;
+
+ case FFESTR_secondFUNCTION:
+ ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
+ ffestb_local_.dummy.badname = "FUNCTION";
+ ffestb_local_.dummy.is_subr = FALSE;
+ return (ffelexHandler) ffestb_decl_recursive4_;
+
+ case FFESTR_secondSUBROUTINE:
+ ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
+ ffestb_local_.dummy.badname = "SUBROUTINE";
+ ffestb_local_.dummy.is_subr = TRUE;
+ return (ffelexHandler) ffestb_decl_recursive4_;
+
+ default:
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstRECURSIVE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeEOS:
+ ffesta_confirmed ();
+ break;
+
+ default:
+ break;
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECURSIVE);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_0; /* :::::::::::::::::::: */
+ ffestb_local_.decl.recursive
+ = ffelex_token_name_from_names (ffesta_tokens[0], 0,
+ FFESTR_firstlRECURSIVE);
+ nt = ffelex_token_names_from_names (ffesta_tokens[0],
+ FFESTR_firstlRECURSIVE, 0);
+ switch (ffestr_first (nt))
+ {
+ case FFESTR_firstINTGR:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlINTGR);
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstBYTE:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlBYTE);
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstWORD:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlWORD);
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstREAL:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlREAL);
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstCMPLX:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlCMPLX);
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstLGCL:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlLGCL);
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstCHRCTR:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlCHRCTR);
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ needfunc = FALSE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstDBLPRCSN:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLPRCSN);
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ needfunc = TRUE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstDBLCMPLX:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlDBLCMPLX);
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ needfunc = TRUE;
+ goto typefunc; /* :::::::::::::::::::: */
+
+ case FFESTR_firstTYPE:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlTYPE);
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ next = (ffelexHandler) ffestb_decl_recursive3_;
+ break;
+
+ case FFESTR_firstFUNCTION:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlFUNCTION);
+ ffestb_local_.dummy.first_kw = FFESTR_firstFUNCTION;
+ ffestb_local_.dummy.badname = "FUNCTION";
+ ffestb_local_.dummy.is_subr = FALSE;
+ next = (ffelexHandler) ffestb_decl_recursive4_;
+ break;
+
+ case FFESTR_firstSUBROUTINE:
+ p = ffelex_token_text (nt) + (i = FFESTR_firstlSUBROUTINE);
+ ffestb_local_.dummy.first_kw = FFESTR_firstSUBROUTINE;
+ ffestb_local_.dummy.badname = "SUBROUTINE";
+ ffestb_local_.dummy.is_subr = TRUE;
+ next = (ffelexHandler) ffestb_decl_recursive4_;
+ break;
+
+ default:
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffelex_token_kill (nt);
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ if (*p == '\0')
+ {
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ot = ffelex_token_name_from_names (nt, i, 0);
+ ffelex_token_kill (nt);
+ next = (ffelexHandler) (*next) (ot);
+ ffelex_token_kill (ot);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+typefunc: /* :::::::::::::::::::: */
+ if (*p == '\0')
+ {
+ ffelex_token_kill (nt);
+ if (needfunc) /* DOUBLE PRECISION or DOUBLE COMPLEX? */
+ {
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ return (ffelexHandler) ffestb_decl_recursive1_ (t);
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ot = ffelex_token_names_from_names (nt, i, 0);
+ ffelex_token_kill (nt);
+ if (ffestr_first (ot) != FFESTR_firstFUNCTION)
+ goto bad_o; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ot) + (i = FFESTR_firstlFUNCTION);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_name_from_names (ot, i, 0);
+ ffelex_token_kill (ot);
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_funcname_1_ (t);
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", nt, i, t);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_o: /* :::::::::::::::::::: */
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ot);
+ ffelex_token_kill (ot);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive1_ -- "RECURSIVE" generic-type
+
+ return ffestb_decl_recursive1_; // to lexer
+
+ Handle ASTERISK, OPEN_PAREN, or NAME. */
+
+static ffelexHandler
+ffestb_decl_recursive1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+ ffestb_local_.decl.badname = "TYPEFUNC";
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ return (ffelexHandler) ffestb_decl_starlen_;
+ return (ffelexHandler) ffestb_decl_starkind_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+ ffestb_local_.decl.badname = "TYPEFUNC";
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ {
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_typeparams_;
+ }
+ return (ffelexHandler) ffestb_decl_kindparam_;
+
+ case FFELEX_typeNAME:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_func_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive2_ -- "RECURSIVE" "DOUBLE"
+
+ return ffestb_decl_recursive2_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_recursive2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_second (t))
+ {
+ case FFESTR_secondPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ break;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_func_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive3_ -- "RECURSIVE" "TYPE"
+
+ return ffestb_decl_recursive3_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_recursive3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_func_;
+ ffestb_local_.decl.badname = "TYPEFUNC";
+ return (ffelexHandler) ffestb_decl_typetype1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_recursive4_ -- "RECURSIVE" "FUNCTION/SUBROUTINE"
+
+ return ffestb_decl_recursive4_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_recursive4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_dummy1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_typetype -- Parse the R426/R501/R1219 TYPE statement
+
+ return ffestb_decl_typetype; // to lexer
+
+ Make sure the statement has a valid form for the TYPE statement. If it
+ does, implement the statement. */
+
+#if FFESTR_F90
+ffelexHandler
+ffestb_decl_typetype (ffelexToken t)
+{
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:/* Not COMMA: R424 "TYPE,PUBLIC::A". */
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ ffestb_local_.decl.recursive = NULL;
+ ffestb_local_.decl.parameter = FALSE; /* No PARAMETER attribute seen. */
+ ffestb_local_.decl.coloncolon = FALSE; /* No COLONCOLON seen. */
+
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
+ ffestb_local_.decl.badname = "type-declaration";
+ return (ffelexHandler) ffestb_decl_typetype1_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+#endif
+/* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
+
+ return ffestb_decl_attrs_; // to lexer
+
+ Handle NAME of an attribute. */
+
+static ffelexHandler
+ffestb_decl_attrs_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_first (t))
+ {
+#if FFESTR_F90
+ case FFESTR_firstALLOCATABLE:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribALLOCATABLE, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+ case FFESTR_firstDIMENSION:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_attrs_1_;
+
+ case FFESTR_firstEXTERNAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+ case FFESTR_firstINTENT:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_attrs_3_;
+#endif
+
+ case FFESTR_firstINTRINSIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+ case FFESTR_firstOPTIONAL:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribOPTIONAL, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+ case FFESTR_firstPARAMETER:
+ ffestb_local_.decl.parameter = TRUE;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+ case FFESTR_firstPOINTER:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribPOINTER, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+#if FFESTR_F90
+ case FFESTR_firstPRIVATE:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribPRIVATE, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+ case FFESTR_firstPUBLIC:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribPUBLIC, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+ case FFESTR_firstSAVE:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribSAVE, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+#if FFESTR_F90
+ case FFESTR_firstTARGET:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribTARGET, t,
+ FFESTR_otherNone, NULL);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+#endif
+
+ default:
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION"
+
+ return ffestb_decl_attrs_1_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_attrs_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_attrs_2_;
+ ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool;
+ ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
+ ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_attrs_7_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN
+ dimlist CLOSE_PAREN
+
+ return ffestb_decl_attrs_2_; // to lexer
+
+ Handle COMMA or COLONCOLON. */
+
+static ffelexHandler
+ffestb_decl_attrs_2_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1],
+ FFESTR_otherNone, ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_decl_attrs_7_ (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_3_ -- "type" [type parameters] ",INTENT"
+
+ return ffestb_decl_attrs_3_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_attrs_3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffestb_decl_attrs_4_;
+
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_attrs_7_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_4_ -- "type" [type parameters] ",INTENT" OPEN_PAREN
+
+ return ffestb_decl_attrs_4_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_attrs_4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffestb_local_.decl.kw = ffestr_other (t);
+ switch (ffestb_local_.decl.kw)
+ {
+ case FFESTR_otherIN:
+ return (ffelexHandler) ffestb_decl_attrs_5_;
+
+ case FFESTR_otherINOUT:
+ return (ffelexHandler) ffestb_decl_attrs_6_;
+
+ case FFESTR_otherOUT:
+ return (ffelexHandler) ffestb_decl_attrs_6_;
+
+ default:
+ ffestb_local_.decl.kw = FFESTR_otherNone;
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ return (ffelexHandler) ffestb_decl_attrs_5_;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_5_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
+
+ return ffestb_decl_attrs_5_; // to lexer
+
+ Handle NAME or CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_attrs_5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_other (t))
+ {
+ case FFESTR_otherOUT:
+ if (ffestb_local_.decl.kw != FFESTR_otherNone)
+ ffestb_local_.decl.kw = FFESTR_otherINOUT;
+ return (ffelexHandler) ffestb_decl_attrs_6_;
+
+ default:
+ if (ffestb_local_.decl.kw != FFESTR_otherNone)
+ {
+ ffestb_local_.decl.kw = FFESTR_otherNone;
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
+ }
+ return (ffelexHandler) ffestb_decl_attrs_5_;
+ }
+ break;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_decl_attrs_6_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrs_6_ -- "type" [type parameters] ",INTENT" OPEN_PAREN "IN"
+ ["OUT"]
+
+ return ffestb_decl_attrs_6_; // to lexer
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_attrs_6_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if ((ffestb_local_.decl.kw != FFESTR_otherNone)
+ && !ffesta_is_inhibited ())
+ ffestc_decl_attrib (FFESTP_attribINTENT, ffesta_tokens[1],
+ ffestb_local_.decl.kw, NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_attrs_7_;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_attrs_7_ -- "type" [type parameters] attribute
+
+ return ffestb_decl_attrs_7_; // to lexer
+
+ Handle COMMA (another attribute) or COLONCOLON (entities). */
+
+static ffelexHandler
+ffestb_decl_attrs_7_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_attrsp_ -- "type" [type parameters]
+
+ return ffestb_decl_attrsp_; // to lexer
+
+ Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have
+ no attributes but entities), or go to entsp to see about functions or
+ entities. */
+
+static ffelexHandler
+ffestb_decl_attrsp_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_attrs_;
+
+ case FFELEX_typeCOLONCOLON:
+ ffestb_local_.decl.coloncolon = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ default:
+ return (ffelexHandler) ffestb_decl_entsp_ (t);
+ }
+}
+
+/* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"]
+
+ return ffestb_decl_ents_; // to lexer
+
+ Handle NAME of an entity. */
+
+static ffelexHandler
+ffestb_decl_ents_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_ents_1_;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME
+
+ return ffestb_decl_ents_1_; // to lexer
+
+ Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
+ NULL, FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
+ NULL, FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeASTERISK:
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_ents_2_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_ents_3_ (t);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typeSLASH:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_subrargs_.dim_list.dims = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_ents_7_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_2_ -- "type" [type parameters] [attributes "::"] NAME
+ ASTERISK
+
+ return ffestb_decl_ents_2_; // to lexer
+
+ Handle NUMBER or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_ents_2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ if (ffestb_local_.decl.type != FFESTP_typeCHARACTER)
+ {
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_ents_3_;
+ }
+ /* Fall through. *//* (CHARACTER's *n is always a len spec. */
+ case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted)
+ "(array-spec)". */
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_subrargs_.dim_list.dims = NULL;
+ return (ffelexHandler) ffestb_decl_ents_5_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_3_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER]
+
+ return ffestb_decl_ents_3_; // to lexer
+
+ Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeASTERISK:
+ ffestb_subrargs_.dim_list.dims = NULL;
+ return (ffelexHandler) ffestb_decl_ents_5_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
+ ? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_subrargs_.dim_list.ctx,
+ (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typeSLASH:
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_subrargs_.dim_list.dims = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_ents_7_ (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+
+ return ffestb_decl_ents_4_; // to lexer
+
+ Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_4_ (ffelexToken t)
+{
+ ffelexToken nt;
+
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES)
+ {
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSLASH: /* But NOT FFELEX_typeEQUALS. */
+ case FFELEX_typeCOLONCOLON: /* Actually an error. */
+ break; /* Confirm and handle. */
+
+ default: /* Perhaps EQUALS, as in
+ INTEGERFUNCTIONX(A)=B. */
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = nt;
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ NULL, NULL, NULL, NULL);
+ }
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeASTERISK:
+ if (ffestb_local_.decl.lent != NULL)
+ break; /* Can't specify "*length" twice. */
+ return (ffelexHandler) ffestb_decl_ents_5_;
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_decl_ents_7_ (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
+ && !ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ ASTERISK
+
+ return ffestb_decl_ents_5_; // to lexer
+
+ Handle NUMBER or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_ents_5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_ents_7_;
+
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ ASTERISK OPEN_PAREN expr
+
+ (ffestb_decl_ents_6_) // to expression handler
+
+ Handle CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ return (ffelexHandler) ffestb_decl_ents_7_;
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ [ASTERISK charlength]
+
+ return ffestb_decl_ents_7_; // to lexer
+
+ Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_7_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeEQUALS:
+ if (!ffestb_local_.decl.coloncolon)
+ ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t);
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER
+ : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_);
+
+ case FFELEX_typeSLASH:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
+ TRUE);
+ ffestc_decl_itemstartvals ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_decl_ents_9_);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ [ASTERISK charlength] EQUALS expr
+
+ (ffestb_decl_ents_8_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
+ FALSE);
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
+ FALSE);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_subrargs_.dim_list.dims != NULL)
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_9_ -- "type" ... SLASH expr
+
+ (ffestb_decl_ents_9_) // to expression handler
+
+ Handle ASTERISK, COMMA, or SLASH. */
+
+static ffelexHandler
+ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_itemvalue (NULL, NULL, expr, ft);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_decl_ents_9_);
+
+ case FFELEX_typeASTERISK:
+ if (expr == NULL)
+ break;
+ ffestb_local_.decl.expr = expr;
+ ffesta_tokens[1] = ffelex_token_use (ft);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_decl_ents_10_);
+
+ case FFELEX_typeSLASH:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_itemvalue (NULL, NULL, expr, ft);
+ ffestc_decl_itemendvals (t);
+ }
+ return (ffelexHandler) ffestb_decl_ents_11_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_itemendvals (t);
+ ffestc_decl_finish ();
+ }
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr
+
+ (ffestb_decl_ents_10_) // to expression handler
+
+ Handle COMMA or SLASH. */
+
+static ffelexHandler
+ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
+ expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffeexpr_rhs
+ (ffesta_output_pool, FFEEXPR_contextDATA,
+ (ffeexprCallback) ffestb_decl_ents_9_);
+
+ case FFELEX_typeSLASH:
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
+ expr, ft);
+ ffestc_decl_itemendvals (t);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_ents_11_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_decl_itemendvals (t);
+ ffestc_decl_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME
+ [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
+ [ASTERISK charlength] SLASH initvals SLASH
+
+ return ffestb_decl_ents_11_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_ents_11_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_decl_ents_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_decl_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_ -- "type" [type parameters]
+
+ return ffestb_decl_entsp_; // to lexer
+
+ Handle NAME or NAMES beginning either an entity (object) declaration or
+ a function definition.. */
+
+static ffelexHandler
+ffestb_decl_entsp_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_entsp_1_;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_entsp_2_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME
+
+ return ffestb_decl_entsp_1_; // to lexer
+
+ If we get another NAME token here, then the previous one must be
+ "RECURSIVE" or "FUNCTION" and we handle it accordingly. Otherwise,
+ we send the previous and current token through to _ents_. */
+
+static ffelexHandler
+ffestb_decl_entsp_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_first (ffesta_tokens[1]))
+ {
+#if FFESTR_F90
+ case FFESTR_firstRECURSIVE:
+ if (ffestr_first (t) != FFESTR_firstFUNCTION)
+ {
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+ }
+ ffestb_local_.decl.recursive = ffesta_tokens[1];
+ return (ffelexHandler) ffestb_decl_funcname_;
+#endif
+
+ case FFESTR_firstFUNCTION:
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_decl_funcname_ (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]);
+ break;
+ }
+ break;
+
+ default:
+ if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
+ && !ffesta_is_inhibited ())
+ ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ /* NAME/NAMES token already in ffesta_tokens[1]. */
+ return (ffelexHandler) ffestb_decl_ents_1_ (t);
+ }
+
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES
+
+ return ffestb_decl_entsp_2_; // to lexer
+
+ If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES
+ begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a
+ first-name-char, we have a possible syntactically ambiguous situation.
+ Otherwise, we have a straightforward situation just as if we went
+ through _entsp_1_ instead of here. */
+
+static ffelexHandler
+ffestb_decl_entsp_2_ (ffelexToken t)
+{
+ ffelexToken nt;
+ bool asterisk_ok;
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeINTEGER:
+ case FFESTP_typeREAL:
+ case FFESTP_typeCOMPLEX:
+ case FFESTP_typeLOGICAL:
+ asterisk_ok = (ffestb_local_.decl.kindt == NULL);
+ break;
+
+ case FFESTP_typeCHARACTER:
+ asterisk_ok = (ffestb_local_.decl.lent == NULL);
+ break;
+
+ case FFESTP_typeBYTE:
+ case FFESTP_typeWORD:
+ default:
+ asterisk_ok = FALSE;
+ break;
+ }
+ switch (ffestr_first (ffesta_tokens[1]))
+ {
+#if FFESTR_F90
+ case FFESTR_firstRECURSIVEFNCTN:
+ if (!asterisk_ok)
+ break; /* For our own convenience, treat as non-FN
+ stmt. */
+ p = ffelex_token_text (ffesta_tokens[1])
+ + (i = FFESTR_firstlRECURSIVEFNCTN);
+ if (!ffesrc_is_name_init (*p))
+ break;
+ ffestb_local_.decl.recursive
+ = ffelex_token_name_from_names (ffesta_tokens[1], 0,
+ FFESTR_firstlRECURSIVEFNCTN);
+ ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+ FFESTR_firstlRECURSIVEFNCTN, 0);
+ return (ffelexHandler) ffestb_decl_entsp_3_;
+#endif
+
+ case FFESTR_firstFUNCTION:
+ if (!asterisk_ok)
+ break; /* For our own convenience, treat as non-FN
+ stmt. */
+ p = ffelex_token_text (ffesta_tokens[1])
+ + (i = FFESTR_firstlFUNCTION);
+ if (!ffesrc_is_name_init (*p))
+ break;
+ ffestb_local_.decl.recursive = NULL;
+ ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+ FFESTR_firstlFUNCTION, 0);
+ return (ffelexHandler) ffestb_decl_entsp_3_;
+
+ default:
+ break;
+ }
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.aster_after = FALSE;
+ switch (ffestr_first (ffesta_tokens[1]))
+ {
+#if FFESTR_F90
+ case FFESTR_firstRECURSIVEFNCTN:
+ p = ffelex_token_text (ffesta_tokens[1])
+ + (i = FFESTR_firstlRECURSIVEFNCTN);
+ if (!ffesrc_is_name_init (*p))
+ break;
+ ffestb_local_.decl.recursive
+ = ffelex_token_name_from_names (ffesta_tokens[1], 0,
+ FFESTR_firstlRECURSIVEFNCTN);
+ ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+ FFESTR_firstlRECURSIVEFNCTN, 0);
+ return (ffelexHandler) ffestb_decl_entsp_5_ (t);
+#endif
+
+ case FFESTR_firstFUNCTION:
+ p = ffelex_token_text (ffesta_tokens[1])
+ + (i = FFESTR_firstlFUNCTION);
+ if (!ffesrc_is_name_init (*p))
+ break;
+ ffestb_local_.decl.recursive = NULL;
+ ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
+ FFESTR_firstlFUNCTION, 0);
+ return (ffelexHandler) ffestb_decl_entsp_5_ (t);
+
+ default:
+ break;
+ }
+ if ((ffestb_local_.decl.kindt != NULL)
+ || (ffestb_local_.decl.lent != NULL))
+ break; /* Have kind/len type param, definitely not
+ assignment stmt. */
+ return (ffelexHandler) ffestb_decl_entsp_1_ (t);
+
+ default:
+ break;
+ }
+
+ nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = nt; /* Change NAMES to NAME. */
+ return (ffelexHandler) ffestb_decl_entsp_1_ (t);
+}
+
+/* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME ASTERISK
+
+ return ffestb_decl_entsp_3_; // to lexer
+
+ Handle NUMBER or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_entsp_3_ (ffelexToken t)
+{
+ ffestb_local_.decl.aster_after = TRUE;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeINTEGER:
+ case FFESTP_typeREAL:
+ case FFESTP_typeCOMPLEX:
+ case FFESTP_typeLOGICAL:
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ break;
+
+ case FFESTP_typeCHARACTER:
+ ffestb_local_.decl.lent = ffelex_token_use (t);
+ break;
+
+ case FFESTP_typeBYTE:
+ case FFESTP_typeWORD:
+ default:
+ assert (FALSE);
+ }
+ return (ffelexHandler) ffestb_decl_entsp_5_;
+
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_entsp_4_);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME ASTERISK OPEN_PAREN expr
+
+ (ffestb_decl_entsp_4_) // to expression handler
+
+ Allow only CLOSE_PAREN; and deal with character-length expression. */
+
+static ffelexHandler
+ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeCHARACTER:
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ break;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+ }
+ return (ffelexHandler) ffestb_decl_entsp_5_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter]
+
+ return ffestb_decl_entsp_5_; // to lexer
+
+ Make sure the next token is an OPEN_PAREN. Get the arg list or dimension
+ list. If it can't be an arg list, or if the CLOSE_PAREN is followed by
+ something other than EOS/SEMICOLON or NAME, then treat as dimension list
+ and handle statement as an R426/R501. If it can't be a dimension list, or
+ if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle
+ statement as an R1219. If it can be either an arg list or a dimension
+ list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC
+ whether to treat the statement as an R426/R501 or an R1219 and act
+ accordingly. */
+
+static ffelexHandler
+ffestb_decl_entsp_5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL))
+ { /* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr)
+ (..." must be a function-stmt, since the
+ (len-expr) cannot precede (array-spec) in
+ an object declaration but can precede
+ (name-list) in a function stmt. */
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = ffesta_tokens[2];
+ return (ffelexHandler) ffestb_decl_funcname_4_ (t);
+ }
+ ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
+ ffestb_local_.decl.empty = TRUE;
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_6_;
+
+ default:
+ break;
+ }
+
+ assert (ffestb_local_.decl.aster_after);
+ ffesta_confirmed (); /* We've seen an ASTERISK, so even EQUALS
+ confirmed. */
+ ffestb_subr_ambig_to_ents_ ();
+ ffestb_subrargs_.dim_list.dims = NULL;
+ return (ffelexHandler) ffestb_decl_ents_7_ (t);
+}
+
+/* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN
+
+ return ffestb_decl_entsp_6_; // to lexer
+
+ If CLOSE_PAREN, we definitely have an R1219 function-stmt, since
+ the notation "name()" is invalid for a declaration. */
+
+static ffelexHandler
+ffestb_decl_entsp_6_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (!ffestb_local_.decl.empty)
+ { /* Trailing comma, just a warning for
+ stmt func def, so allow ambiguity. */
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist,
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_8_;
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = ffesta_tokens[2];
+ next = (ffelexHandler) ffestt_tokenlist_handle
+ (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeNAME:
+ ffestb_local_.decl.empty = FALSE;
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_7_;
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typePERCENT:
+ case FFELEX_typePERIOD:
+ case FFELEX_typeOPEN_PAREN:
+ if ((ffestb_local_.decl.kindt != NULL)
+ || (ffestb_local_.decl.lent != NULL))
+ break; /* type(params)name or type*val name, either
+ way confirmed. */
+ return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
+
+ default:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_subr_ambig_to_ents_ ();
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_decl_ents_3_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN NAME
+
+ return ffestb_decl_entsp_7_; // to lexer
+
+ Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219
+ function-stmt. */
+
+static ffelexHandler
+ffestb_decl_entsp_7_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_8_;
+
+ case FFELEX_typeCOMMA:
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_entsp_6_;
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typePERCENT:
+ case FFELEX_typePERIOD:
+ case FFELEX_typeOPEN_PAREN:
+ if ((ffestb_local_.decl.kindt != NULL)
+ || (ffestb_local_.decl.lent != NULL))
+ break; /* type(params)name or type*val name, either
+ way confirmed. */
+ return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
+
+ default:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_subr_ambig_to_ents_ ();
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_decl_ents_3_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN name-list
+ CLOSE_PAREN
+
+ return ffestb_decl_entsp_8_; // to lexer
+
+ If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve
+ it. If NAME (must be "RESULT", but that is checked later on),
+ definitely an R1219 function-stmt. Anything else, handle as entity decl. */
+
+static ffelexHandler
+ffestb_decl_entsp_8_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (ffestc_is_decl_not_R1219 ())
+ break;
+ /* Fall through. */
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_tokens[1] = ffesta_tokens[2];
+ next = (ffelexHandler) ffestt_tokenlist_handle
+ (ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+
+ case FFELEX_typeEQUALS:
+ case FFELEX_typePOINTS:
+ case FFELEX_typePERCENT:
+ case FFELEX_typePERIOD:
+ case FFELEX_typeOPEN_PAREN:
+ if ((ffestb_local_.decl.kindt != NULL)
+ || (ffestb_local_.decl.lent != NULL))
+ break; /* type(params)name or type*val name, either
+ way confirmed. */
+ return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
+
+ default:
+ break;
+ }
+
+ ffesta_confirmed ();
+ ffestb_subr_ambig_to_ents_ ();
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_decl_ents_3_);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_func_ -- ["type" [type parameters]] RECURSIVE
+
+ return ffestb_decl_func_; // to lexer
+
+ Handle "FUNCTION". */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_func_ (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffestr_first (t) != FFESTR_firstFUNCTION)
+ break;
+ return (ffelexHandler) ffestb_decl_funcname_;
+
+ case FFELEX_typeNAMES:
+ ffesta_confirmed ();
+ if (ffestr_first (t) != FFESTR_firstFUNCTION)
+ break;
+ p = ffelex_token_text (t) + (i = FFESTR_firstlFUNCTION);
+ if (*p == '\0')
+ break;
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffesta_tokens[1] = ffelex_token_name_from_names (t, i, 0);
+ return (ffelexHandler) ffestb_decl_funcname_1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_i: /* :::::::::::::::::::: */
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t, i, NULL);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+
+ return ffestb_decl_funcname_; // to lexer
+
+ Handle NAME of a function. */
+
+static ffelexHandler
+ffestb_decl_funcname_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_funcname_1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME
+
+ return ffestb_decl_funcname_1_; // to lexer
+
+ Handle ASTERISK or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_funcname_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ return (ffelexHandler) ffestb_decl_funcname_2_;
+
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffestb_decl_funcname_4_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME ASTERISK
+
+ return ffestb_decl_funcname_2_; // to lexer
+
+ Handle NUMBER or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_funcname_2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNUMBER:
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeINTEGER:
+ case FFESTP_typeREAL:
+ case FFESTP_typeCOMPLEX:
+ case FFESTP_typeLOGICAL:
+ if (ffestb_local_.decl.kindt == NULL)
+ ffestb_local_.decl.kindt = ffelex_token_use (t);
+ else
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+
+ case FFESTP_typeCHARACTER:
+ if (ffestb_local_.decl.lent == NULL)
+ ffestb_local_.decl.lent = ffelex_token_use (t);
+ else
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+
+ case FFESTP_typeBYTE:
+ case FFESTP_typeWORD:
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+ }
+ return (ffelexHandler) ffestb_decl_funcname_4_;
+
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextCHARACTERSIZE,
+ (ffeexprCallback) ffestb_decl_funcname_3_);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME ASTERISK OPEN_PAREN expr
+
+ (ffestb_decl_funcname_3_) // to expression handler
+
+ Allow only CLOSE_PAREN; and deal with character-length expression. */
+
+static ffelexHandler
+ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ if (expr == NULL)
+ break;
+ switch (ffestb_local_.decl.type)
+ {
+ case FFESTP_typeCHARACTER:
+ if (ffestb_local_.decl.lent == NULL)
+ {
+ ffestb_local_.decl.len = expr;
+ ffestb_local_.decl.lent = ffelex_token_use (ft);
+ }
+ else
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ break;
+ }
+ return (ffelexHandler) ffestb_decl_funcname_4_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter]
+
+ return ffestb_decl_funcname_4_; // to lexer
+
+ Make sure the next token is an OPEN_PAREN. Get the arg list and
+ then implement. */
+
+static ffelexHandler
+ffestb_decl_funcname_4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
+ ffestb_subrargs_.name_list.handler
+ = (ffelexHandler) ffestb_decl_funcname_5_;
+ ffestb_subrargs_.name_list.is_subr = FALSE;
+ ffestb_subrargs_.name_list.names = FALSE;
+ return (ffelexHandler) ffestb_subr_name_list_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arg-list
+ CLOSE_PAREN
+
+ return ffestb_decl_funcname_5_; // to lexer
+
+ Must have EOS/SEMICOLON or "RESULT" here. */
+
+static ffelexHandler
+ffestb_decl_funcname_5_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.name_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent,
+ ffestb_local_.decl.recursive, NULL);
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeNAME:
+ if (ffestr_other (t) != FFESTR_otherRESULT)
+ break;
+ return (ffelexHandler) ffestb_decl_funcname_6_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arglist
+ CLOSE_PAREN "RESULT"
+
+ return ffestb_decl_funcname_6_; // to lexer
+
+ Make sure the next token is an OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_funcname_6_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ return (ffelexHandler) ffestb_decl_funcname_7_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arglist
+ CLOSE_PAREN "RESULT" OPEN_PAREN
+
+ return ffestb_decl_funcname_7_; // to lexer
+
+ Make sure the next token is a NAME. */
+
+static ffelexHandler
+ffestb_decl_funcname_7_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[2] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_funcname_8_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arglist
+ CLOSE_PAREN "RESULT" OPEN_PAREN NAME
+
+ return ffestb_decl_funcname_8_; // to lexer
+
+ Make sure the next token is a CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_funcname_8_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_decl_funcname_9_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION
+ NAME [type parameter] OPEN_PAREN arg-list
+ CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN
+
+ return ffestb_decl_funcname_9_; // to lexer
+
+ Must have EOS/SEMICOLON here. */
+
+static ffelexHandler
+ffestb_decl_funcname_9_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
+ ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
+ ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
+ ffestb_local_.decl.len, ffestb_local_.decl.lent,
+ ffestb_local_.decl.recursive, ffesta_tokens[2]);
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.recursive != NULL)
+ ffelex_token_kill (ffestb_local_.decl.recursive);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffelex_token_kill (ffesta_tokens[2]);
+ ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
+ ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V003 -- Parse the STRUCTURE statement
+
+ return ffestb_V003; // to lexer
+
+ Make sure the statement has a valid form for the STRUCTURE statement.
+ If it does, implement the statement. */
+
+#if FFESTR_VXT
+ffelexHandler
+ffestb_V003 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffelexHandler next;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_start (NULL);
+ ffestb_local_.structure.started = TRUE;
+ return (ffelexHandler) ffestb_V0034_ (t);
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ return (ffelexHandler) ffestb_V0031_;
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstSTRUCTURE)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSTRUCTURE);
+ switch (ffelex_token_type (t))
+ {
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeSLASH:
+ ffesta_confirmed ();
+ if (*p != '\0')
+ goto bad_1; /* :::::::::::::::::::: */
+ return (ffelexHandler) ffestb_V0031_;
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+ }
+
+ /* Here, we have at least one char after "STRUCTURE" and t is COMMA,
+ EOS/SEMICOLON, or OPEN_PAREN. */
+
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
+ if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
+ ffestb_local_.structure.started = FALSE;
+ else
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_start (NULL);
+ ffestb_local_.structure.started = TRUE;
+ }
+ next = (ffelexHandler) ffestb_V0034_ (nt);
+ ffelex_token_kill (nt);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0031_ -- "STRUCTURE" SLASH
+
+ return ffestb_V0031_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0031_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0032_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0032_ -- "STRUCTURE" SLASH NAME
+
+ return ffestb_V0032_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_V0032_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_start (ffesta_tokens[1]);
+ ffestb_local_.structure.started = TRUE;
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0033_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0033_ -- "STRUCTURE" SLASH NAME SLASH
+
+ return ffestb_V0033_; // to lexer
+
+ Handle NAME or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0033_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ return (ffelexHandler) ffestb_V0034_ (t);
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0034_ -- "STRUCTURE" [SLASH NAME SLASH]
+
+ return ffestb_V0034_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0034_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0035_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0035_ -- "STRUCTURE" ... NAME
+
+ return ffestb_V0035_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_V0035_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0036_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_item (ffesta_tokens[1], NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0034_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V003_item (ffesta_tokens[1], NULL);
+ ffestc_V003_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V003_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0036_ -- "STRUCTURE" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+ return ffestb_V0036_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0036_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.structure.started)
+ {
+ ffestc_V003_start (NULL);
+ ffestb_local_.structure.started = TRUE;
+ }
+ ffestc_V003_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_V0034_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ {
+ if (!ffestb_local_.structure.started)
+ ffestc_V003_start (NULL);
+ ffestc_V003_item (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_V003_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "STRUCTURE", t);
+ if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
+ ffestc_V003_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V016 -- Parse the RECORD statement
+
+ return ffestb_V016; // to lexer
+
+ Make sure the statement has a valid form for the RECORD statement. If it
+ does, implement the statement. */
+
+ffelexHandler
+ffestb_V016 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstRECORD)
+ goto bad_0; /* :::::::::::::::::::: */
+ break;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstRECORD)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlRECORD);
+ if (*p != '\0')
+ goto bad_i; /* :::::::::::::::::::: */
+ break;
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeSLASH:
+ break;
+ }
+
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_start ();
+ return (ffelexHandler) ffestb_V0161_;
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "RECORD", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0161_ -- "RECORD" SLASH
+
+ return ffestb_V0161_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0161_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_item_structure (t);
+ return (ffelexHandler) ffestb_V0162_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0162_ -- "RECORD" SLASH NAME
+
+ return ffestb_V0162_; // to lexer
+
+ Handle SLASH. */
+
+static ffelexHandler
+ffestb_V0162_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_V0163_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0163_ -- "RECORD" SLASH NAME SLASH
+
+ return ffestb_V0163_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0163_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0164_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0164_ -- "RECORD" ... NAME
+
+ return ffestb_V0164_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_V0164_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
+ ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_V0165_;
+ ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
+ ffestb_subrargs_.dim_list.ctx = FFEEXPR_contextDIMLISTCOMMON;
+#ifdef FFECOM_dimensionsMAX
+ ffestb_subrargs_.dim_list.ndims = 0;
+#endif
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextDIMLISTCOMMON, (ffeexprCallback) ffestb_subr_dimlist_);
+
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_item_object (ffesta_tokens[1], NULL);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0166_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V016_item_object (ffesta_tokens[1], NULL);
+ ffestc_V016_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0165_ -- "RECORD" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
+
+ return ffestb_V0165_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0165_ (ffelexToken t)
+{
+ if (!ffestb_subrargs_.dim_list.ok)
+ goto bad; /* :::::::::::::::::::: */
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffestb_V0166_;
+
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V016_item_object (ffesta_tokens[1],
+ ffestb_subrargs_.dim_list.dims);
+ ffestc_V016_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ if (ffestb_local_.structure.started && !ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0166_ -- "RECORD" SLASH NAME SLASH NAME [OPEN_PAREN dimlist
+ CLOSE_PAREN] COMMA
+
+ return ffestb_V0166_; // to lexer
+
+ Handle NAME or SLASH. */
+
+static ffelexHandler
+ffestb_V0166_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0164_;
+
+ case FFELEX_typeSLASH:
+ return (ffelexHandler) ffestb_V0161_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RECORD", t);
+ break;
+ }
+
+ if (!ffesta_is_inhibited ())
+ ffestc_V016_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_V027 -- Parse the VXT PARAMETER statement
+
+ return ffestb_V027; // to lexer
+
+ Make sure the statement has a valid form for the VXT PARAMETER statement.
+ If it does, implement the statement. */
+
+ffelexHandler
+ffestb_V027 (ffelexToken t)
+{
+ char *p;
+ ffeTokenLength i;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ ffesta_confirmed ();
+ ffestb_local_.vxtparam.started = TRUE;
+ if (!ffesta_is_inhibited ())
+ ffestc_V027_start ();
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0271_;
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstPARAMETER)
+ goto bad_0; /* :::::::::::::::::::: */
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPARAMETER);
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ if (!ffesrc_is_name_init (*p))
+ goto bad_i; /* :::::::::::::::::::: */
+ ffestb_local_.vxtparam.started = FALSE;
+ ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
+ 0);
+ return (ffelexHandler) ffestb_V0271_ (t);
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+
+bad_i: /* :::::::::::::::::::: */
+ ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0], i, t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0271_ -- "PARAMETER" NAME
+
+ return ffestb_V0271_; // to lexer
+
+ Handle EQUALS. */
+
+static ffelexHandler
+ffestb_V0271_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEQUALS:
+ return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
+ FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_V0272_);
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
+ ffestc_V027_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0272_ -- "PARAMETER" NAME EQUALS expr
+
+ (ffestb_V0272_) // to expression handler
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffestb_local_.vxtparam.started)
+ {
+ if (ffestc_is_let_not_V027 ())
+ break; /* Not a valid VXTPARAMETER stmt. */
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_V027_start ();
+ ffestb_local_.vxtparam.started = TRUE;
+ }
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ {
+ ffestc_V027_item (ffesta_tokens[1], expr, ft);
+ ffestc_V027_finish ();
+ }
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeCOMMA:
+ ffesta_confirmed ();
+ if (!ffestb_local_.vxtparam.started)
+ {
+ if (!ffesta_is_inhibited ())
+ ffestc_V027_start ();
+ ffestb_local_.vxtparam.started = TRUE;
+ }
+ if (expr == NULL)
+ break;
+ if (!ffesta_is_inhibited ())
+ ffestc_V027_item (ffesta_tokens[1], expr, ft);
+ ffelex_token_kill (ffesta_tokens[1]);
+ return (ffelexHandler) ffestb_V0273_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
+ ffestc_V027_finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_V0273_ -- "PARAMETER" NAME EQUALS expr COMMA
+
+ return ffestb_V0273_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_V0273_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_V0271_;
+
+ default:
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
+ break;
+ }
+
+ if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
+ ffestc_V027_finish ();
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539 -- Parse the IMPLICIT FUNCTION statement
+
+ return ffestb_decl_R539; // to lexer
+
+ Make sure the statement has a valid form for the IMPLICIT
+ statement. If it does, implement the statement. */
+
+ffelexHandler
+ffestb_decl_R539 (ffelexToken t)
+{
+ ffeTokenLength i;
+ char *p;
+ ffelexToken nt;
+ ffestrSecond kw;
+
+ ffestb_local_.decl.recursive = NULL;
+
+ switch (ffelex_token_type (ffesta_tokens[0]))
+ {
+ case FFELEX_typeNAME:
+ if (ffesta_first_kw != FFESTR_firstIMPLICIT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ ffesta_confirmed (); /* Error, but clearly intended. */
+ goto bad_1; /* :::::::::::::::::::: */
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+
+ case FFELEX_typeNAME:
+ break;
+ }
+ ffesta_confirmed ();
+ ffestb_local_.decl.imp_started = FALSE;
+ switch (ffesta_second_kw)
+ {
+ case FFESTR_secondINTEGER:
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondBYTE:
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondWORD:
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondREAL:
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondLOGICAL:
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondCHARACTER:
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondDOUBLE:
+ return (ffelexHandler) ffestb_decl_R5392_;
+
+ case FFESTR_secondDOUBLEPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+ case FFESTR_secondDOUBLECOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+ case FFESTR_secondNONE:
+ return (ffelexHandler) ffestb_decl_R5394_;
+
+#if FFESTR_F90
+ case FFESTR_secondTYPE:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ return (ffelexHandler) ffestb_decl_R5393_;
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ case FFELEX_typeNAMES:
+ if (ffesta_first_kw != FFESTR_firstIMPLICIT)
+ goto bad_0; /* :::::::::::::::::::: */
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeCOLONCOLON:
+ case FFELEX_typeASTERISK:
+ case FFELEX_typeSEMICOLON:
+ case FFELEX_typeEOS:
+ ffesta_confirmed ();
+ break;
+
+ case FFELEX_typeOPEN_PAREN:
+ break;
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+ p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT);
+ if (!ffesrc_is_name_init (*p))
+ goto bad_0; /* :::::::::::::::::::: */
+ ffestb_local_.decl.imp_started = FALSE;
+ nt = ffelex_token_name_from_names (ffesta_tokens[0],
+ FFESTR_firstlIMPLICIT, 0);
+ kw = ffestr_second (nt);
+ ffelex_token_kill (nt);
+ switch (kw)
+ {
+ case FFESTR_secondINTEGER:
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondBYTE:
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondWORD:
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondREAL:
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondLOGICAL:
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondCHARACTER:
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ return (ffelexHandler) ffestb_decl_R5391_ (t);
+
+ case FFESTR_secondDOUBLEPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_ (t);
+
+ case FFESTR_secondDOUBLECOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_ (t);
+
+ case FFESTR_secondNONE:
+ return (ffelexHandler) ffestb_decl_R5394_ (t);
+
+#if FFESTR_F90
+ case FFESTR_secondTYPE:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ return (ffelexHandler) ffestb_decl_R5393_ (t);
+#endif
+
+ default:
+ goto bad_1; /* :::::::::::::::::::: */
+ }
+
+ default:
+ goto bad_0; /* :::::::::::::::::::: */
+ }
+
+bad_0: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+
+bad_1: /* :::::::::::::::::::: */
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t,
+ (ffelexHandler) ffesta_zero); /* Invalid second token. */
+}
+
+/* ffestb_decl_R5391_ -- "IMPLICIT" generic-type
+
+ return ffestb_decl_R5391_; // to lexer
+
+ Handle ASTERISK or OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R5391_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeASTERISK:
+ ffesta_confirmed ();
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
+ ffestb_local_.decl.badname = "IMPLICIT";
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ return (ffelexHandler) ffestb_decl_starlen_;
+ return (ffelexHandler) ffestb_decl_starkind_;
+
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
+ ffestb_local_.decl.badname = "IMPLICIT";
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
+ ffestb_local_.decl.imp_handler
+ = (ffelexHandler) ffestb_decl_typeparams_;
+ else
+ ffestb_local_.decl.imp_handler
+ = (ffelexHandler) ffestb_decl_kindparam_;
+ return (ffelexHandler) ffestb_decl_R539maybe_ (t);
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE"
+
+ return ffestb_decl_R5392_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R5392_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_second (t))
+ {
+ case FFESTR_secondPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ break;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ break;
+
+ default:
+ goto bad; /* :::::::::::::::::::: */
+ }
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+ default:
+ break;
+ }
+
+bad: /* :::::::::::::::::::: */
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R5393_ -- "IMPLICIT" "TYPE"
+
+ return ffestb_decl_R5393_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+#if FFESTR_F90
+static ffelexHandler
+ffestb_decl_R5393_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
+ ffestb_local_.decl.badname = "IMPLICIT";
+ return (ffelexHandler) ffestb_decl_typetype1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+#endif
+/* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
+
+ return ffestb_decl_R5394_; // to lexer
+
+ Handle EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_R5394_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R539 (); /* IMPLICIT NONE. */
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA
+
+ return ffestb_decl_R5395_; // to lexer
+
+ Handle NAME for next type-spec. */
+
+static ffelexHandler
+ffestb_decl_R5395_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ switch (ffestr_second (t))
+ {
+ case FFESTR_secondINTEGER:
+ ffestb_local_.decl.type = FFESTP_typeINTEGER;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondBYTE:
+ ffestb_local_.decl.type = FFESTP_typeBYTE;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondWORD:
+ ffestb_local_.decl.type = FFESTP_typeWORD;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondREAL:
+ ffestb_local_.decl.type = FFESTP_typeREAL;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondCOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondLOGICAL:
+ ffestb_local_.decl.type = FFESTP_typeLOGICAL;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondCHARACTER:
+ ffestb_local_.decl.type = FFESTP_typeCHARACTER;
+ return (ffelexHandler) ffestb_decl_R5391_;
+
+ case FFESTR_secondDOUBLE:
+ return (ffelexHandler) ffestb_decl_R5392_;
+
+ case FFESTR_secondDOUBLEPRECISION:
+ ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+ case FFESTR_secondDOUBLECOMPLEX:
+ ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
+ ffestb_local_.decl.kind = NULL;
+ ffestb_local_.decl.kindt = NULL;
+ ffestb_local_.decl.len = NULL;
+ ffestb_local_.decl.lent = NULL;
+ return (ffelexHandler) ffestb_decl_R539letters_;
+
+#if FFESTR_F90
+ case FFESTR_secondTYPE:
+ ffestb_local_.decl.type = FFESTP_typeTYPE;
+ return (ffelexHandler) ffestb_decl_R5393_;
+#endif
+
+ default:
+ break;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec
+
+ return ffestb_decl_R539letters_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R539letters_ (ffelexToken t)
+{
+ ffelex_set_names (FALSE);
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeOPEN_PAREN:
+ ffestb_local_.decl.imps = ffestt_implist_create ();
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+
+ default:
+ break;
+ }
+
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN
+
+ return ffestb_decl_R539letters_1_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R539letters_1_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (t) != 1)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ return (ffelexHandler) ffestb_decl_R539letters_2_;
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME
+
+ return ffestb_decl_R539letters_2_; // to lexer
+
+ Handle COMMA or MINUS. */
+
+static ffelexHandler
+ffestb_decl_R539letters_2_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
+ return (ffelexHandler) ffestb_decl_R539letters_5_;
+
+ case FFELEX_typeMINUS:
+ return (ffelexHandler) ffestb_decl_R539letters_3_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
+
+ return ffestb_decl_R539letters_3_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R539letters_3_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (t) != 1)
+ break;
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
+ ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539letters_4_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
+ NAME
+
+ return ffestb_decl_R539letters_4_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R539letters_4_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ return (ffelexHandler) ffestb_decl_R539letters_5_;
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN
+ letter-spec-list CLOSE_PAREN
+
+ return ffestb_decl_R539letters_5_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_R539letters_5_ (ffelexToken t)
+{
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ if (!ffestb_local_.decl.imp_started)
+ {
+ ffestb_local_.decl.imp_started = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R539start ();
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_local_.decl.len,
+ ffestb_local_.decl.lent, ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_decl_R5395_;
+ if (!ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
+
+/* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec
+
+ return ffestb_decl_R539maybe_; // to lexer
+
+ Handle OPEN_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_ (ffelexToken t)
+{
+ assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN);
+ ffestb_local_.decl.imps = ffestt_implist_create ();
+ ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
+ ffestb_local_.decl.imp_seen_comma
+ = (ffestb_local_.decl.type != FFESTP_typeCHARACTER);
+ return (ffelexHandler) ffestb_decl_R539maybe_1_;
+}
+
+/* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN
+
+ return ffestb_decl_R539maybe_1_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_1_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (t) != 1)
+ break;
+ ffesta_tokens[1] = ffelex_token_use (t);
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_2_;
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME
+
+ return ffestb_decl_R539maybe_2_; // to lexer
+
+ Handle COMMA or MINUS. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_2_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
+ if (ffestb_local_.decl.imp_seen_comma)
+ {
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+ }
+ ffestb_local_.decl.imp_seen_comma = TRUE;
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_1_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_5_;
+
+ case FFELEX_typeMINUS:
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_3_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
+
+ return ffestb_decl_R539maybe_3_; // to lexer
+
+ Handle NAME. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_3_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeNAME:
+ if (ffelex_token_length (t) != 1)
+ break;
+ ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
+ ffelex_token_use (t));
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_4_;
+
+ default:
+ break;
+ }
+
+ ffelex_token_kill (ffesta_tokens[1]);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
+ NAME
+
+ return ffestb_decl_R539maybe_4_; // to lexer
+
+ Handle COMMA or CLOSE_PAREN. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_4_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ if (ffestb_local_.decl.imp_seen_comma)
+ {
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) ffestb_decl_R539letters_1_;
+ }
+ ffestb_local_.decl.imp_seen_comma = TRUE;
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_1_;
+
+ case FFELEX_typeCLOSE_PAREN:
+ ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
+ return (ffelexHandler) ffestb_decl_R539maybe_5_;
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+}
+
+/* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN
+ letter-spec-list CLOSE_PAREN
+
+ return ffestb_decl_R539maybe_5_; // to lexer
+
+ Handle COMMA or EOS/SEMICOLON. */
+
+static ffelexHandler
+ffestb_decl_R539maybe_5_ (ffelexToken t)
+{
+ ffelexHandler next;
+
+ switch (ffelex_token_type (t))
+ {
+ case FFELEX_typeCOMMA:
+ case FFELEX_typeEOS:
+ case FFELEX_typeSEMICOLON:
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ if (!ffestb_local_.decl.imp_started)
+ {
+ ffestb_local_.decl.imp_started = TRUE;
+ ffesta_confirmed ();
+ if (!ffesta_is_inhibited ())
+ ffestc_R539start ();
+ }
+ if (!ffesta_is_inhibited ())
+ ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
+ ffestb_local_.decl.kindt, ffestb_local_.decl.len,
+ ffestb_local_.decl.lent, ffestb_local_.decl.imps);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+ return (ffelexHandler) ffestb_decl_R5395_;
+ if (!ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ return (ffelexHandler) ffesta_zero (t);
+
+ case FFELEX_typeOPEN_PAREN:
+ ffesta_confirmed ();
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
+ (ffelexHandler) ffestb_local_.decl.imp_handler);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ return (ffelexHandler) (*next) (t);
+
+ default:
+ break;
+ }
+
+ ffestt_implist_kill (ffestb_local_.decl.imps);
+ ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
+ if (ffestb_local_.decl.kindt != NULL)
+ ffelex_token_kill (ffestb_local_.decl.kindt);
+ if (ffestb_local_.decl.lent != NULL)
+ ffelex_token_kill (ffestb_local_.decl.lent);
+ if (ffestb_local_.decl.imp_started && !ffesta_is_inhibited ())
+ ffestc_R539finish ();
+ ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
+ return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
+}
diff --git a/gcc/f/stb.h b/gcc/f/stb.h
new file mode 100644
index 00000000000..a3385d9a596
--- /dev/null
+++ b/gcc/f/stb.h
@@ -0,0 +1,253 @@
+/* stb.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ stb.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_stb
+#define _H_f_stb
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bad.h"
+#include "expr.h"
+#include "lex.h"
+#include "stp.h"
+#include "str.h"
+
+/* Structure definitions. */
+
+struct _ffestb_args_
+ {
+ struct
+ {
+ char *badname;
+ ffeTokenLength len; /* Length of "ENTRY/FUNCTION/SUBROUTINE". */
+ bool is_subr; /* TRUE if SUBROUTINE or if ENTRY within
+ SUBROUTINE. */
+ }
+ dummy;
+ struct
+ {
+ char *badname;
+ ffeTokenLength len; /* Length of
+ "BACKSPACE/ENDFILE/REWIND/UNLOCK". */
+ }
+ beru;
+ struct
+ {
+ ffeTokenLength len; /* Length of keyword including "END". */
+ ffestrSecond second; /* Second keyword. */
+ }
+ endxyz;
+ struct
+ {
+ ffestrSecond second; /* Second keyword. */
+ }
+ elsexyz;
+ struct
+ {
+ ffeTokenLength len; /* Length of "STOP/PAUSE". */
+ }
+ halt;
+#if FFESTR_F90
+ struct
+ {
+ char *badname;
+ ffeTokenLength len; /* Length of "ALLOCATE/DEALLOCATE". */
+ ffeexprContext ctx; /* Either ALLOCATE or DEALLOCATE. */
+ }
+ heap;
+#endif
+ struct
+ {
+ char *badname;
+ ffeTokenLength len; /* Length of
+ "EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/
+ PRIVATE". */
+ }
+ varlist;
+#if FFESTR_VXT
+ struct
+ {
+ char *badname;
+ ffeTokenLength len; /* Length of "ENCODE/DECODE". */
+ }
+ vxtcode;
+#endif
+#if FFESTR_F90
+ struct
+ {
+ char *badname;
+ ffeTokenLength len; /* Length of "ALLOCATABLE/POINTER/TARGET". */
+ }
+ dimlist;
+#endif
+ struct
+ {
+ char *badname;
+ ffeTokenLength len; /* Length of "DIMENSION/VIRTUAL". */
+ }
+ R524;
+ struct
+ {
+ ffeTokenLength len; /* Length of first keyword. */
+ ffestpType type; /* Type of declaration. */
+ }
+ decl;
+ };
+
+/* Global objects accessed by users of this module. */
+
+extern struct _ffestb_args_ ffestb_args;
+
+/* Declare functions with prototypes. */
+
+ffelexHandler ffestb_beru (ffelexToken t);
+ffelexHandler ffestb_block (ffelexToken t);
+ffelexHandler ffestb_blockdata (ffelexToken t);
+ffelexHandler ffestb_decl_chartype (ffelexToken t);
+ffelexHandler ffestb_construct (ffelexToken t);
+ffelexHandler ffestb_decl_dbltype (ffelexToken t);
+ffelexHandler ffestb_decl_double (ffelexToken t);
+ffelexHandler ffestb_dimlist (ffelexToken t);
+ffelexHandler ffestb_do (ffelexToken t);
+ffelexHandler ffestb_dowhile (ffelexToken t);
+ffelexHandler ffestb_dummy (ffelexToken t);
+ffelexHandler ffestb_else (ffelexToken t);
+ffelexHandler ffestb_elsexyz (ffelexToken t);
+ffelexHandler ffestb_end (ffelexToken t);
+ffelexHandler ffestb_endxyz (ffelexToken t);
+ffelexHandler ffestb_decl_gentype (ffelexToken t);
+ffelexHandler ffestb_goto (ffelexToken t);
+ffelexHandler ffestb_halt (ffelexToken t);
+#if FFESTR_F90
+ffelexHandler ffestb_heap (ffelexToken t);
+#endif
+ffelexHandler ffestb_if (ffelexToken t);
+ffelexHandler ffestb_let (ffelexToken t);
+#if FFESTR_F90
+ffelexHandler ffestb_module (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_decl_recursive (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_type (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_decl_typetype (ffelexToken t);
+#endif
+ffelexHandler ffestb_varlist (ffelexToken t);
+#if FFESTR_VXT
+ffelexHandler ffestb_vxtcode (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_where (ffelexToken t);
+#endif
+#if HARD_F90
+ffelexHandler ffestb_R423B (ffelexToken t);
+#endif
+ffelexHandler ffestb_R522 (ffelexToken t);
+ffelexHandler ffestb_R524 (ffelexToken t);
+ffelexHandler ffestb_R528 (ffelexToken t);
+ffelexHandler ffestb_R537 (ffelexToken t);
+ffelexHandler ffestb_decl_R539 (ffelexToken t);
+ffelexHandler ffestb_R542 (ffelexToken t);
+ffelexHandler ffestb_R544 (ffelexToken t);
+ffelexHandler ffestb_R547 (ffelexToken t);
+#if FFESTR_F90
+ffelexHandler ffestb_R624 (ffelexToken t);
+#endif
+ffelexHandler ffestb_R809 (ffelexToken t);
+ffelexHandler ffestb_R810 (ffelexToken t);
+ffelexHandler ffestb_R834 (ffelexToken t);
+ffelexHandler ffestb_R835 (ffelexToken t);
+ffelexHandler ffestb_R838 (ffelexToken t);
+ffelexHandler ffestb_R840 (ffelexToken t);
+ffelexHandler ffestb_R841 (ffelexToken t);
+ffelexHandler ffestb_R904 (ffelexToken t);
+ffelexHandler ffestb_R907 (ffelexToken t);
+ffelexHandler ffestb_R909 (ffelexToken t);
+ffelexHandler ffestb_R910 (ffelexToken t);
+ffelexHandler ffestb_R911 (ffelexToken t);
+ffelexHandler ffestb_R923 (ffelexToken t);
+ffelexHandler ffestb_R1001 (ffelexToken t);
+ffelexHandler ffestb_R1102 (ffelexToken t);
+#if FFESTR_F90
+ffelexHandler ffestb_R1107 (ffelexToken t);
+#endif
+#if FFESTR_F90
+ffelexHandler ffestb_R1202 (ffelexToken t);
+#endif
+ffelexHandler ffestb_R1212 (ffelexToken t);
+ffelexHandler ffestb_R1227 (ffelexToken t);
+#if FFESTR_F90
+ffelexHandler ffestb_R1228 (ffelexToken t);
+#endif
+ffelexHandler ffestb_R1229 (ffelexToken t);
+ffelexHandler ffestb_S3P4 (ffelexToken t);
+#if FFESTR_VXT
+ffelexHandler ffestb_V003 (ffelexToken t);
+ffelexHandler ffestb_V009 (ffelexToken t);
+ffelexHandler ffestb_V012 (ffelexToken t);
+#endif
+ffelexHandler ffestb_V014 (ffelexToken t);
+#if FFESTR_VXT
+ffelexHandler ffestb_V016 (ffelexToken t);
+ffelexHandler ffestb_V018 (ffelexToken t);
+ffelexHandler ffestb_V019 (ffelexToken t);
+#endif
+ffelexHandler ffestb_V020 (ffelexToken t);
+#if FFESTR_VXT
+ffelexHandler ffestb_V021 (ffelexToken t);
+ffelexHandler ffestb_V025 (ffelexToken t);
+ffelexHandler ffestb_V026 (ffelexToken t);
+#endif
+ffelexHandler ffestb_V027 (ffelexToken t);
+
+/* Define macros. */
+
+#define ffestb_init_0()
+#define ffestb_init_1()
+#define ffestb_init_2()
+#define ffestb_init_3()
+#define ffestb_init_4()
+#define ffestb_terminate_0()
+#define ffestb_terminate_1()
+#define ffestb_terminate_2()
+#define ffestb_terminate_3()
+#define ffestb_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/stc.c b/gcc/f/stc.c
new file mode 100644
index 00000000000..ef91d7188dd
--- /dev/null
+++ b/gcc/f/stc.c
@@ -0,0 +1,13895 @@
+/* stc.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ st.c
+
+ Description:
+ Verifies the proper semantics for statements, checking expressions already
+ semantically analyzed individually, collectively, checking label defs and
+ refs, and so on. Uses ffebad to indicate errors in semantics.
+
+ In many cases, both a token and a keyword (ffestrFirst, ffestrSecond,
+ or ffestrOther) is provided. ONLY USE THE TOKEN as a pointer to the
+ source-code location for an error message or similar; use the keyword
+ as the semantic matching for the token, since the token's text might
+ not match the keyword's code. For example, INTENT(IN OUT) A in free
+ source form passes to ffestc_R519_start the token "IN" but the keyword
+ FFESTR_otherINOUT, and the latter is correct.
+
+ Generally, either a single ffestc function handles an entire statement,
+ in which case its name is ffestc_xyz_, or more than one function is
+ needed, in which case its names are ffestc_xyz_start_,
+ ffestc_xyz_item_ or ffestc_xyz_item_abc_, and ffestc_xyz_finish_.
+ The caller must call _start_ before calling any _item_ functions, and
+ must call _finish_ afterwards. If it is clearly a syntactic matter as
+ to restrictions on the number and variety of _item_ calls, then the caller
+ should report any errors and ffestc_ should presume it has been taken
+ care of and handle any semantic problems with grace and no error messages.
+ If the permitted number and variety of _item_ calls has some basis in
+ semantics, then the caller should not generate any messages and ffestc
+ should do all the checking.
+
+ A few ffestc functions have names rather than grammar numbers, like
+ ffestc_elsewhere and ffestc_end. These are cases where the actual
+ statement depends on its context rather than just its form; ELSE WHERE
+ may be the obvious (WHERE...ELSE WHERE...END WHERE) or something a little
+ more subtle (WHERE: IF THEN...ELSE WHERE...END IF WHERE). The actual
+ ffestc functions do exist and do work, but may or may not be invoked
+ by ffestb depending on whether some form of resolution is possible.
+ For example, ffestc_R1103 end-program-stmt is reachable directly when
+ END PROGRAM [name] is specified, or via ffestc_end when END is specified
+ and the context is a main program. So ffestc_xyz_ should make a quick
+ determination of the context and pick the appropriate ffestc_Nxyz_
+ function to invoke, without a lot of ceremony.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "stc.h"
+#include "bad.h"
+#include "bld.h"
+#include "data.h"
+#include "expr.h"
+#include "global.h"
+#include "implic.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#include "sta.h"
+#include "std.h"
+#include "stp.h"
+#include "str.h"
+#include "stt.h"
+#include "stw.h"
+
+/* Externals defined here. */
+
+ffeexprContext ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
+/* Valid only from READ/WRITE start to finish. */
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFESTC_orderOK_, /* Statement ok in this context, process. */
+ FFESTC_orderBAD_, /* Statement not ok in this context, don't
+ process. */
+ FFESTC_orderBADOK_, /* Don't process but push block if
+ applicable. */
+ FFESTC
+ } ffestcOrder_;
+
+typedef enum
+ {
+ FFESTC_stateletSIMPLE_, /* Expecting simple/start. */
+ FFESTC_stateletATTRIB_, /* Expecting attrib/item/itemstart. */
+ FFESTC_stateletITEM_, /* Expecting item/itemstart/finish. */
+ FFESTC_stateletITEMVALS_, /* Expecting itemvalue/itemendvals. */
+ FFESTC_
+ } ffestcStatelet_;
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+union ffestc_local_u_
+ {
+ struct
+ {
+ ffebld initlist; /* For list of one sym in INTEGER I/3/ case. */
+ ffetargetCharacterSize stmt_size;
+ ffetargetCharacterSize size;
+ ffeinfoBasictype basic_type;
+ ffeinfoKindtype stmt_kind_type;
+ ffeinfoKindtype kind_type;
+ bool per_var_kind_ok;
+ char is_R426; /* 1=R426, 2=R501. */
+ }
+ decl;
+ struct
+ {
+ ffebld objlist; /* For list of target objects. */
+ ffebldListBottom list_bottom; /* For building lists. */
+ }
+ data;
+ struct
+ {
+ ffebldListBottom list_bottom; /* For building lists. */
+ int entry_num;
+ }
+ dummy;
+ struct
+ {
+ ffesymbol symbol; /* NML symbol. */
+ }
+ namelist;
+ struct
+ {
+ ffelexToken t; /* First token in list. */
+ ffeequiv eq; /* Current equivalence being built up. */
+ ffebld list; /* List of expressions in equivalence. */
+ ffebldListBottom bottom;
+ bool ok; /* TRUE while current list still being
+ processed. */
+ bool save; /* TRUE if any var in list is SAVEd. */
+ }
+ equiv;
+ struct
+ {
+ ffesymbol symbol; /* BCB/NCB symbol. */
+ }
+ common;
+ struct
+ {
+ ffesymbol symbol; /* SFN symbol. */
+ }
+ sfunc;
+#if FFESTR_VXT
+ struct
+ {
+ char list_state; /* 0=>no field names allowed, 1=>error
+ reported already, 2=>field names req'd,
+ 3=>have a field name. */
+ }
+ V003;
+#endif
+ }; /* Merge with the one in ffestc later. */
+
+/* Static objects accessed by functions in this module. */
+
+static bool ffestc_ok_; /* _start_ fn's send this to _xyz_ fn's. */
+static bool ffestc_parent_ok_; /* Parent sym for baby sym fn's ok. */
+static char ffestc_namelist_; /* 0=>not namelist, 1=>namelist, 2=>error. */
+static union ffestc_local_u_ ffestc_local_;
+static ffestcStatelet_ ffestc_statelet_ = FFESTC_stateletSIMPLE_;
+static ffestwShriek ffestc_shriek_after1_ = NULL;
+static unsigned long ffestc_blocknum_ = 0; /* Next block# to assign. */
+static int ffestc_entry_num_;
+static int ffestc_sfdummy_argno_;
+static int ffestc_saved_entry_num_;
+static ffelab ffestc_label_;
+
+/* Static functions (internal). */
+
+static void ffestc_R544_equiv_ (ffebld expr, ffelexToken t);
+static void ffestc_establish_declinfo_ (ffebld kind, ffelexToken kindt,
+ ffebld len, ffelexToken lent);
+static void ffestc_establish_declstmt_ (ffestpType type, ffelexToken typet,
+ ffebld kind, ffelexToken kindt,
+ ffebld len, ffelexToken lent);
+static void ffestc_establish_impletter_ (ffelexToken first, ffelexToken last);
+static ffeinfoKindtype ffestc_kindtype_kind_ (ffeinfoBasictype bt,
+ ffetargetCharacterSize val);
+static ffeinfoKindtype ffestc_kindtype_star_ (ffeinfoBasictype bt,
+ ffetargetCharacterSize val);
+static void ffestc_labeldef_any_ (void);
+static bool ffestc_labeldef_begin_ (void);
+static void ffestc_labeldef_branch_begin_ (void);
+static void ffestc_labeldef_branch_end_ (void);
+static void ffestc_labeldef_endif_ (void);
+static void ffestc_labeldef_format_ (void);
+static void ffestc_labeldef_invalid_ (void);
+static void ffestc_labeldef_notloop_ (void);
+static void ffestc_labeldef_notloop_begin_ (void);
+static void ffestc_labeldef_useless_ (void);
+static bool ffestc_labelref_is_assignable_ (ffelexToken label_token,
+ ffelab *label);
+static bool ffestc_labelref_is_branch_ (ffelexToken label_token,
+ ffelab *label);
+static bool ffestc_labelref_is_format_ (ffelexToken label_token,
+ ffelab *label);
+static bool ffestc_labelref_is_loopend_ (ffelexToken label_token,
+ ffelab *label);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_access_ (void);
+#endif
+static ffestcOrder_ ffestc_order_actiondo_ (void);
+static ffestcOrder_ ffestc_order_actionif_ (void);
+static ffestcOrder_ ffestc_order_actionwhere_ (void);
+static void ffestc_order_any_ (void);
+static void ffestc_order_bad_ (void);
+static ffestcOrder_ ffestc_order_blockdata_ (void);
+static ffestcOrder_ ffestc_order_blockspec_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_component_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_contains_ (void);
+#endif
+static ffestcOrder_ ffestc_order_data_ (void);
+static ffestcOrder_ ffestc_order_data77_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_derivedtype_ (void);
+#endif
+static ffestcOrder_ ffestc_order_do_ (void);
+static ffestcOrder_ ffestc_order_entry_ (void);
+static ffestcOrder_ ffestc_order_exec_ (void);
+static ffestcOrder_ ffestc_order_format_ (void);
+static ffestcOrder_ ffestc_order_function_ (void);
+static ffestcOrder_ ffestc_order_iface_ (void);
+static ffestcOrder_ ffestc_order_ifthen_ (void);
+static ffestcOrder_ ffestc_order_implicit_ (void);
+static ffestcOrder_ ffestc_order_implicitnone_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_interface_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_map_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_module_ (void);
+#endif
+static ffestcOrder_ ffestc_order_parameter_ (void);
+static ffestcOrder_ ffestc_order_program_ (void);
+static ffestcOrder_ ffestc_order_progspec_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_record_ (void);
+#endif
+static ffestcOrder_ ffestc_order_selectcase_ (void);
+static ffestcOrder_ ffestc_order_sfunc_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_spec_ (void);
+#endif
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_structure_ (void);
+#endif
+static ffestcOrder_ ffestc_order_subroutine_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_type_ (void);
+#endif
+static ffestcOrder_ ffestc_order_typedecl_ (void);
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_union_ (void);
+#endif
+static ffestcOrder_ ffestc_order_unit_ (void);
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_use_ (void);
+#endif
+#if FFESTR_VXT
+static ffestcOrder_ ffestc_order_vxtstructure_ (void);
+#endif
+#if FFESTR_F90
+static ffestcOrder_ ffestc_order_where_ (void);
+#endif
+static void ffestc_promote_dummy_ (ffelexToken t);
+static void ffestc_promote_execdummy_ (ffelexToken t);
+static void ffestc_promote_sfdummy_ (ffelexToken t);
+static void ffestc_shriek_begin_program_ (void);
+#if FFESTR_F90
+static void ffestc_shriek_begin_uses_ (void);
+#endif
+static void ffestc_shriek_blockdata_ (bool ok);
+static void ffestc_shriek_do_ (bool ok);
+static void ffestc_shriek_end_program_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_end_uses_ (bool ok);
+#endif
+static void ffestc_shriek_function_ (bool ok);
+static void ffestc_shriek_if_ (bool ok);
+static void ffestc_shriek_ifthen_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_interface_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_map_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_module_ (bool ok);
+#endif
+static void ffestc_shriek_select_ (bool ok);
+#if FFESTR_VXT
+static void ffestc_shriek_structure_ (bool ok);
+#endif
+static void ffestc_shriek_subroutine_ (bool ok);
+#if FFESTR_F90
+static void ffestc_shriek_type_ (bool ok);
+#endif
+#if FFESTR_VXT
+static void ffestc_shriek_union_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_where_ (bool ok);
+#endif
+#if FFESTR_F90
+static void ffestc_shriek_wherethen_ (bool ok);
+#endif
+static int ffestc_subr_binsrch_ (char **list, int size, ffestpFile *spec,
+ char *whine);
+static ffestvFormat ffestc_subr_format_ (ffestpFile *spec);
+static bool ffestc_subr_is_branch_ (ffestpFile *spec);
+static bool ffestc_subr_is_format_ (ffestpFile *spec);
+static bool ffestc_subr_is_present_ (char *name, ffestpFile *spec);
+static int ffestc_subr_speccmp_ (char *string, ffestpFile *spec,
+ char **target, int *length);
+static ffestvUnit ffestc_subr_unit_ (ffestpFile *spec);
+static void ffestc_try_shriek_do_ (void);
+
+/* Internal macros. */
+
+#define ffestc_check_simple_() \
+ assert(ffestc_statelet_ == FFESTC_stateletSIMPLE_)
+#define ffestc_check_start_() \
+ assert(ffestc_statelet_ == FFESTC_stateletSIMPLE_); \
+ ffestc_statelet_ = FFESTC_stateletATTRIB_
+#define ffestc_check_attrib_() \
+ assert(ffestc_statelet_ == FFESTC_stateletATTRIB_)
+#define ffestc_check_item_() \
+ assert(ffestc_statelet_ == FFESTC_stateletATTRIB_ \
+ || ffestc_statelet_ == FFESTC_stateletITEM_); \
+ ffestc_statelet_ = FFESTC_stateletITEM_
+#define ffestc_check_item_startvals_() \
+ assert(ffestc_statelet_ == FFESTC_stateletATTRIB_ \
+ || ffestc_statelet_ == FFESTC_stateletITEM_); \
+ ffestc_statelet_ = FFESTC_stateletITEMVALS_
+#define ffestc_check_item_value_() \
+ assert(ffestc_statelet_ == FFESTC_stateletITEMVALS_)
+#define ffestc_check_item_endvals_() \
+ assert(ffestc_statelet_ == FFESTC_stateletITEMVALS_); \
+ ffestc_statelet_ = FFESTC_stateletITEM_
+#define ffestc_check_finish_() \
+ assert(ffestc_statelet_ == FFESTC_stateletATTRIB_ \
+ || ffestc_statelet_ == FFESTC_stateletITEM_); \
+ ffestc_statelet_ = FFESTC_stateletSIMPLE_
+#define ffestc_order_action_() ffestc_order_exec_()
+#if FFESTR_F90
+#define ffestc_order_interfacespec_() ffestc_order_derivedtype_()
+#endif
+#define ffestc_shriek_if_lost_ ffestc_shriek_if_
+#if FFESTR_F90
+#define ffestc_shriek_where_lost_ ffestc_shriek_where_
+#endif
+
+/* ffestc_establish_declinfo_ -- Determine specific type/params info for entity
+
+ ffestc_establish_declinfo_(kind,kind_token,len,len_token);
+
+ Must be called after _declstmt_ called to establish base type. */
+
+static void
+ffestc_establish_declinfo_ (ffebld kind, ffelexToken kindt, ffebld len,
+ ffelexToken lent)
+{
+ ffeinfoBasictype bt = ffestc_local_.decl.basic_type;
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize val;
+
+ if (kindt == NULL)
+ kt = ffestc_local_.decl.stmt_kind_type;
+ else if (!ffestc_local_.decl.per_var_kind_ok)
+ {
+ ffebad_start (FFEBAD_KINDTYPE);
+ ffebad_here (0, ffelex_token_where_line (kindt),
+ ffelex_token_where_column (kindt));
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ kt = ffestc_local_.decl.stmt_kind_type;
+ }
+ else
+ {
+ if (kind == NULL)
+ {
+ assert (ffelex_token_type (kindt) == FFELEX_typeNUMBER);
+ val = atol (ffelex_token_text (kindt));
+ kt = ffestc_kindtype_star_ (bt, val);
+ }
+ else if (ffebld_op (kind) == FFEBLD_opANY)
+ kt = ffestc_local_.decl.stmt_kind_type;
+ else
+ {
+ assert (ffebld_op (kind) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (kind))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (kind))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ val = ffebld_constant_integerdefault (ffebld_conter (kind));
+ kt = ffestc_kindtype_kind_ (bt, val);
+ }
+
+ if (kt == FFEINFO_kindtypeNONE)
+ { /* Not valid kind type. */
+ ffebad_start (FFEBAD_KINDTYPE);
+ ffebad_here (0, ffelex_token_where_line (kindt),
+ ffelex_token_where_column (kindt));
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ kt = ffestc_local_.decl.stmt_kind_type;
+ }
+ }
+
+ ffestc_local_.decl.kind_type = kt;
+
+ /* Now check length specification for CHARACTER data type. */
+
+ if (((len == NULL) && (lent == NULL))
+ || (bt != FFEINFO_basictypeCHARACTER))
+ val = ffestc_local_.decl.stmt_size;
+ else
+ {
+ if (len == NULL)
+ {
+ assert (ffelex_token_type (lent) == FFELEX_typeNUMBER);
+ val = atol (ffelex_token_text (lent));
+ }
+ else if (ffebld_op (len) == FFEBLD_opSTAR)
+ val = FFETARGET_charactersizeNONE;
+ else if (ffebld_op (len) == FFEBLD_opANY)
+ val = FFETARGET_charactersizeNONE;
+ else
+ {
+ assert (ffebld_op (len) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (len))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (len))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ val = ffebld_constant_integerdefault (ffebld_conter (len));
+ }
+ }
+
+ if ((val == 0) && !(0 && ffe_is_90 ()))
+ {
+ val = 1;
+ ffebad_start (FFEBAD_ZERO_SIZE);
+ ffebad_here (0, ffelex_token_where_line (lent), ffelex_token_where_column (lent));
+ ffebad_finish ();
+ }
+ ffestc_local_.decl.size = val;
+}
+
+/* ffestc_establish_declstmt_ -- Establish host-specific type/params info
+
+ ffestc_establish_declstmt_(type,type_token,kind,kind_token,len,
+ len_token); */
+
+static void
+ffestc_establish_declstmt_ (ffestpType type, ffelexToken typet, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+ ffeinfoBasictype bt;
+ ffeinfoKindtype ktd; /* Default kindtype. */
+ ffeinfoKindtype kt;
+ ffetargetCharacterSize val;
+ bool per_var_kind_ok = TRUE;
+
+ /* Determine basictype and default kindtype. */
+
+ switch (type)
+ {
+ case FFESTP_typeINTEGER:
+ bt = FFEINFO_basictypeINTEGER;
+ ktd = FFEINFO_kindtypeINTEGERDEFAULT;
+ break;
+
+ case FFESTP_typeBYTE:
+ bt = FFEINFO_basictypeINTEGER;
+ ktd = FFEINFO_kindtypeINTEGER2;
+ break;
+
+ case FFESTP_typeWORD:
+ bt = FFEINFO_basictypeINTEGER;
+ ktd = FFEINFO_kindtypeINTEGER3;
+ break;
+
+ case FFESTP_typeREAL:
+ bt = FFEINFO_basictypeREAL;
+ ktd = FFEINFO_kindtypeREALDEFAULT;
+ break;
+
+ case FFESTP_typeCOMPLEX:
+ bt = FFEINFO_basictypeCOMPLEX;
+ ktd = FFEINFO_kindtypeREALDEFAULT;
+ break;
+
+ case FFESTP_typeLOGICAL:
+ bt = FFEINFO_basictypeLOGICAL;
+ ktd = FFEINFO_kindtypeLOGICALDEFAULT;
+ break;
+
+ case FFESTP_typeCHARACTER:
+ bt = FFEINFO_basictypeCHARACTER;
+ ktd = FFEINFO_kindtypeCHARACTERDEFAULT;
+ break;
+
+ case FFESTP_typeDBLPRCSN:
+ bt = FFEINFO_basictypeREAL;
+ ktd = FFEINFO_kindtypeREALDOUBLE;
+ per_var_kind_ok = FALSE;
+ break;
+
+ case FFESTP_typeDBLCMPLX:
+ bt = FFEINFO_basictypeCOMPLEX;
+#if FFETARGET_okCOMPLEX2
+ ktd = FFEINFO_kindtypeREALDOUBLE;
+#else
+ ktd = FFEINFO_kindtypeREALDEFAULT;
+ ffebad_start (FFEBAD_BAD_DBLCMPLX);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+#endif
+ per_var_kind_ok = FALSE;
+ break;
+
+ default:
+ assert ("Unexpected type (F90 TYPE?)!" == NULL);
+ bt = FFEINFO_basictypeNONE;
+ ktd = FFEINFO_kindtypeNONE;
+ break;
+ }
+
+ if (kindt == NULL)
+ kt = ktd;
+ else
+ { /* Not necessarily default kind type. */
+ if (kind == NULL)
+ { /* Shouldn't happen for CHARACTER. */
+ assert (ffelex_token_type (kindt) == FFELEX_typeNUMBER);
+ val = atol (ffelex_token_text (kindt));
+ kt = ffestc_kindtype_star_ (bt, val);
+ }
+ else if (ffebld_op (kind) == FFEBLD_opANY)
+ kt = ktd;
+ else
+ {
+ assert (ffebld_op (kind) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (kind))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (kind))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ val = ffebld_constant_integerdefault (ffebld_conter (kind));
+ kt = ffestc_kindtype_kind_ (bt, val);
+ }
+
+ if (kt == FFEINFO_kindtypeNONE)
+ { /* Not valid kind type. */
+ ffebad_start (FFEBAD_KINDTYPE);
+ ffebad_here (0, ffelex_token_where_line (kindt),
+ ffelex_token_where_column (kindt));
+ ffebad_here (1, ffelex_token_where_line (typet),
+ ffelex_token_where_column (typet));
+ ffebad_finish ();
+ kt = ktd;
+ }
+ }
+
+ ffestc_local_.decl.basic_type = bt;
+ ffestc_local_.decl.stmt_kind_type = kt;
+ ffestc_local_.decl.per_var_kind_ok = per_var_kind_ok;
+
+ /* Now check length specification for CHARACTER data type. */
+
+ if (((len == NULL) && (lent == NULL))
+ || (type != FFESTP_typeCHARACTER))
+ val = (type == FFESTP_typeCHARACTER) ? 1 : FFETARGET_charactersizeNONE;
+ else
+ {
+ if (len == NULL)
+ {
+ assert (ffelex_token_type (lent) == FFELEX_typeNUMBER);
+ val = atol (ffelex_token_text (lent));
+ }
+ else if (ffebld_op (len) == FFEBLD_opSTAR)
+ val = FFETARGET_charactersizeNONE;
+ else if (ffebld_op (len) == FFEBLD_opANY)
+ val = FFETARGET_charactersizeNONE;
+ else
+ {
+ assert (ffebld_op (len) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (len))
+ == FFEINFO_basictypeINTEGER);
+ assert (ffeinfo_kindtype (ffebld_info (len))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ val = ffebld_constant_integerdefault (ffebld_conter (len));
+ }
+ }
+
+ if ((val == 0) && !(0 && ffe_is_90 ()))
+ {
+ val = 1;
+ ffebad_start (FFEBAD_ZERO_SIZE);
+ ffebad_here (0, ffelex_token_where_line (lent), ffelex_token_where_column (lent));
+ ffebad_finish ();
+ }
+ ffestc_local_.decl.stmt_size = val;
+}
+
+/* ffestc_establish_impletter_ -- Establish type/params for IMPLICIT letter(s)
+
+ ffestc_establish_impletter_(first_letter_token,last_letter_token); */
+
+static void
+ffestc_establish_impletter_ (ffelexToken first, ffelexToken last)
+{
+ bool ok = FALSE; /* Stays FALSE if first letter > last. */
+ char c;
+
+ if (last == NULL)
+ ok = ffeimplic_establish_initial (c = *(ffelex_token_text (first)),
+ ffestc_local_.decl.basic_type,
+ ffestc_local_.decl.kind_type,
+ ffestc_local_.decl.size);
+ else
+ {
+ for (c = *(ffelex_token_text (first));
+ c <= *(ffelex_token_text (last));
+ c++)
+ {
+ ok = ffeimplic_establish_initial (c,
+ ffestc_local_.decl.basic_type,
+ ffestc_local_.decl.kind_type,
+ ffestc_local_.decl.size);
+ if (!ok)
+ break;
+ }
+ }
+
+ if (!ok)
+ {
+ char cs[2];
+
+ cs[0] = c;
+ cs[1] = '\0';
+
+ ffebad_start (FFEBAD_BAD_IMPLICIT);
+ ffebad_here (0, ffelex_token_where_line (first), ffelex_token_where_column (first));
+ ffebad_string (cs);
+ ffebad_finish ();
+ }
+}
+
+/* ffestc_init_3 -- Initialize ffestc for new program unit
+
+ ffestc_init_3(); */
+
+void
+ffestc_init_3 ()
+{
+ ffestv_save_state_ = FFESTV_savestateNONE;
+ ffestc_entry_num_ = 0;
+ ffestv_num_label_defines_ = 0;
+}
+
+/* ffestc_init_4 -- Initialize ffestc for new scoping unit
+
+ ffestc_init_4();
+
+ For SUBROUTINEs/FUNCTIONs within INTERFACE/END INTERFACE, derived-TYPE-
+ defs, and statement function defs. */
+
+void
+ffestc_init_4 ()
+{
+ ffestc_saved_entry_num_ = ffestc_entry_num_;
+ ffestc_entry_num_ = 0;
+}
+
+/* ffestc_kindtype_kind_ -- Determine kindtype from basictype and KIND= value
+
+ ffeinfoKindtype kt;
+ ffeinfoBasictype bt;
+ ffetargetCharacterSize val;
+ kt = ffestc_kindtype_kind_(bt,val);
+ if (kt == FFEINFO_kindtypeNONE)
+ // unsupported/invalid KIND= value for type */
+
+static ffeinfoKindtype
+ffestc_kindtype_kind_ (ffeinfoBasictype bt, ffetargetCharacterSize val)
+{
+ ffetype type;
+ ffetype base_type;
+ ffeinfoKindtype kt;
+
+ base_type = ffeinfo_type (bt, 1); /* ~~ */
+ assert (base_type != NULL);
+
+ type = ffetype_lookup_kind (base_type, (int) val);
+ if (type == NULL)
+ return FFEINFO_kindtypeNONE;
+
+ for (kt = 1; kt < FFEINFO_kindtype; ++kt)
+ if (ffeinfo_type (bt, kt) == type)
+ return kt;
+
+ return FFEINFO_kindtypeNONE;
+}
+
+/* ffestc_kindtype_star_ -- Determine kindtype from basictype and * value
+
+ ffeinfoKindtype kt;
+ ffeinfoBasictype bt;
+ ffetargetCharacterSize val;
+ kt = ffestc_kindtype_star_(bt,val);
+ if (kt == FFEINFO_kindtypeNONE)
+ // unsupported/invalid * value for type */
+
+static ffeinfoKindtype
+ffestc_kindtype_star_ (ffeinfoBasictype bt, ffetargetCharacterSize val)
+{
+ ffetype type;
+ ffetype base_type;
+ ffeinfoKindtype kt;
+
+ base_type = ffeinfo_type (bt, 1); /* ~~ */
+ assert (base_type != NULL);
+
+ type = ffetype_lookup_star (base_type, (int) val);
+ if (type == NULL)
+ return FFEINFO_kindtypeNONE;
+
+ for (kt = 1; kt < FFEINFO_kindtype; ++kt)
+ if (ffeinfo_type (bt, kt) == type)
+ return kt;
+
+ return FFEINFO_kindtypeNONE;
+}
+
+/* Define label as usable for anything without complaint. */
+
+static void
+ffestc_labeldef_any_ ()
+{
+ if ((ffesta_label_token == NULL)
+ || !ffestc_labeldef_begin_ ())
+ return;
+
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_labeldef_begin_ -- Define label as unknown, initially
+
+ ffestc_labeldef_begin_(); */
+
+static bool
+ffestc_labeldef_begin_ ()
+{
+ ffelabValue label_value;
+ ffelab label;
+
+ label_value = (ffelabValue) atol (ffelex_token_text (ffesta_label_token));
+ if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+ {
+ ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_finish ();
+ }
+
+ label = ffelab_find (label_value);
+ if (label == NULL)
+ {
+ label = ffestc_label_ = ffelab_new (label_value);
+ ffestv_num_label_defines_++;
+ ffelab_set_definition_line (label,
+ ffewhere_line_use (ffelex_token_where_line (ffesta_label_token)));
+ ffelab_set_definition_column (label,
+ ffewhere_column_use (ffelex_token_where_column (ffesta_label_token)));
+
+ return TRUE;
+ }
+
+ if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
+ {
+ ffestv_num_label_defines_++;
+ ffestc_label_ = label;
+ ffelab_set_definition_line (label,
+ ffewhere_line_use (ffelex_token_where_line (ffesta_label_token)));
+ ffelab_set_definition_column (label,
+ ffewhere_column_use (ffelex_token_where_column (ffesta_label_token)));
+
+ return TRUE;
+ }
+
+ ffebad_start (FFEBAD_LABEL_ALREADY_DEFINED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_definition_line (label),
+ ffelab_definition_column (label));
+ ffebad_string (ffelex_token_text (ffesta_label_token));
+ ffebad_finish ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+ return FALSE;
+}
+
+/* ffestc_labeldef_branch_begin_ -- Define label as a branch target one
+
+ ffestc_labeldef_branch_begin_(); */
+
+static void
+ffestc_labeldef_branch_begin_ ()
+{
+ if ((ffesta_label_token == NULL)
+ || (ffestc_shriek_after1_ != NULL)
+ || !ffestc_labeldef_begin_ ())
+ return;
+
+ switch (ffelab_type (ffestc_label_))
+ {
+ case FFELAB_typeUNKNOWN:
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP);
+ ffelab_set_blocknum (ffestc_label_,
+ ffestw_blocknum (ffestw_stack_top ()));
+ ffestd_labeldef_branch (ffestc_label_);
+ break;
+
+ case FFELAB_typeNOTLOOP:
+ if (ffelab_blocknum (ffestc_label_)
+ < ffestw_blocknum (ffestw_stack_top ()))
+ {
+ ffebad_start (FFEBAD_LABEL_BLOCK);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ }
+ ffelab_set_blocknum (ffestc_label_,
+ ffestw_blocknum (ffestw_stack_top ()));
+ ffestd_labeldef_branch (ffestc_label_);
+ break;
+
+ case FFELAB_typeLOOPEND:
+ if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+ || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+ { /* Unterminated block. */
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+ ffebad_here (0, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_finish ();
+ break;
+ }
+ ffestd_labeldef_branch (ffestc_label_);
+ /* Leave something around for _branch_end_() to handle. */
+ return;
+
+ case FFELAB_typeFORMAT:
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ break;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ ffestc_try_shriek_do_ ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+}
+
+/* Define possible end of labeled-DO-loop. Call only after calling
+ ffestc_labeldef_branch_begin_, or when other branch_* functions
+ recognize that a label might also be serving as a branch end (in
+ which case they must issue a diagnostic). */
+
+static void
+ffestc_labeldef_branch_end_ ()
+{
+ if (ffesta_label_token == NULL)
+ return;
+
+ assert (ffestc_label_ != NULL);
+ assert ((ffelab_type (ffestc_label_) == FFELAB_typeLOOPEND)
+ || (ffelab_type (ffestc_label_) == FFELAB_typeANY));
+
+ while ((ffestw_state (ffestw_stack_top ()) == FFESTV_stateDO)
+ && (ffestw_label (ffestw_stack_top ()) == ffestc_label_))
+ ffestc_shriek_do_ (TRUE);
+
+ ffestc_try_shriek_do_ ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+}
+
+/* ffestc_labeldef_endif_ -- Define label as an END IF one
+
+ ffestc_labeldef_endif_(); */
+
+static void
+ffestc_labeldef_endif_ ()
+{
+ if ((ffesta_label_token == NULL)
+ || (ffestc_shriek_after1_ != NULL)
+ || !ffestc_labeldef_begin_ ())
+ return;
+
+ switch (ffelab_type (ffestc_label_))
+ {
+ case FFELAB_typeUNKNOWN:
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_type (ffestc_label_, FFELAB_typeENDIF);
+ ffelab_set_blocknum (ffestc_label_,
+ ffestw_blocknum (ffestw_previous (ffestw_stack_top ())));
+ ffestd_labeldef_endif (ffestc_label_);
+ break;
+
+ case FFELAB_typeNOTLOOP:
+ if (ffelab_blocknum (ffestc_label_)
+ < ffestw_blocknum (ffestw_previous (ffestw_stack_top ())))
+ {
+ ffebad_start (FFEBAD_LABEL_BLOCK);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ }
+ ffelab_set_blocknum (ffestc_label_,
+ ffestw_blocknum (ffestw_previous (ffestw_stack_top ())));
+ ffestd_labeldef_endif (ffestc_label_);
+ break;
+
+ case FFELAB_typeLOOPEND:
+ if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+ || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+ { /* Unterminated block. */
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+ ffebad_here (0, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_finish ();
+ break;
+ }
+ ffestd_labeldef_endif (ffestc_label_);
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_finish ();
+ ffestc_labeldef_branch_end_ ();
+ return;
+
+ case FFELAB_typeFORMAT:
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ break;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ ffestc_try_shriek_do_ ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+}
+
+/* ffestc_labeldef_format_ -- Define label as a FORMAT one
+
+ ffestc_labeldef_format_(); */
+
+static void
+ffestc_labeldef_format_ ()
+{
+ if ((ffesta_label_token == NULL)
+ || (ffestc_shriek_after1_ != NULL))
+ {
+ ffebad_start (FFEBAD_FORMAT_NO_LABEL_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ return;
+ }
+
+ if (!ffestc_labeldef_begin_ ())
+ return;
+
+ switch (ffelab_type (ffestc_label_))
+ {
+ case FFELAB_typeUNKNOWN:
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_type (ffestc_label_, FFELAB_typeFORMAT);
+ ffestd_labeldef_format (ffestc_label_);
+ break;
+
+ case FFELAB_typeFORMAT:
+ ffestd_labeldef_format (ffestc_label_);
+ break;
+
+ case FFELAB_typeLOOPEND:
+ if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+ || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+ { /* Unterminated block. */
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+ ffebad_here (0, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_finish ();
+ break;
+ }
+ ffestd_labeldef_format (ffestc_label_);
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_finish ();
+ ffestc_labeldef_branch_end_ ();
+ return;
+
+ case FFELAB_typeNOTLOOP:
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ break;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ ffestc_try_shriek_do_ ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+}
+
+/* ffestc_labeldef_invalid_ -- Label definition invalid, complain if present
+
+ ffestc_labeldef_invalid_(); */
+
+static void
+ffestc_labeldef_invalid_ ()
+{
+ if ((ffesta_label_token == NULL)
+ || (ffestc_shriek_after1_ != NULL)
+ || !ffestc_labeldef_begin_ ())
+ return;
+
+ ffebad_start (FFEBAD_INVALID_LABEL_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_finish ();
+
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffestc_try_shriek_do_ ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+}
+
+/* Define label as a non-loop-ending one on a statement that can't
+ be in the "then" part of a logical IF, such as a block-IF statement. */
+
+static void
+ffestc_labeldef_notloop_ ()
+{
+ if (ffesta_label_token == NULL)
+ return;
+
+ assert (ffestc_shriek_after1_ == NULL);
+
+ if (!ffestc_labeldef_begin_ ())
+ return;
+
+ switch (ffelab_type (ffestc_label_))
+ {
+ case FFELAB_typeUNKNOWN:
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP);
+ ffelab_set_blocknum (ffestc_label_,
+ ffestw_blocknum (ffestw_stack_top ()));
+ ffestd_labeldef_notloop (ffestc_label_);
+ break;
+
+ case FFELAB_typeNOTLOOP:
+ if (ffelab_blocknum (ffestc_label_)
+ < ffestw_blocknum (ffestw_stack_top ()))
+ {
+ ffebad_start (FFEBAD_LABEL_BLOCK);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ }
+ ffelab_set_blocknum (ffestc_label_,
+ ffestw_blocknum (ffestw_stack_top ()));
+ ffestd_labeldef_notloop (ffestc_label_);
+ break;
+
+ case FFELAB_typeLOOPEND:
+ if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+ || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+ { /* Unterminated block. */
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+ ffebad_here (0, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_finish ();
+ break;
+ }
+ ffestd_labeldef_notloop (ffestc_label_);
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_finish ();
+ ffestc_labeldef_branch_end_ ();
+ return;
+
+ case FFELAB_typeFORMAT:
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ break;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ ffestc_try_shriek_do_ ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+}
+
+/* Define label as a non-loop-ending one. Use this when it is
+ possible that the pending label is inhibited because we're in
+ the midst of a logical-IF, and thus _branch_end_ is going to
+ be called after the current statement to resolve a potential
+ loop-ending label. */
+
+static void
+ffestc_labeldef_notloop_begin_ ()
+{
+ if ((ffesta_label_token == NULL)
+ || (ffestc_shriek_after1_ != NULL)
+ || !ffestc_labeldef_begin_ ())
+ return;
+
+ switch (ffelab_type (ffestc_label_))
+ {
+ case FFELAB_typeUNKNOWN:
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP);
+ ffelab_set_blocknum (ffestc_label_,
+ ffestw_blocknum (ffestw_stack_top ()));
+ ffestd_labeldef_notloop (ffestc_label_);
+ break;
+
+ case FFELAB_typeNOTLOOP:
+ if (ffelab_blocknum (ffestc_label_)
+ < ffestw_blocknum (ffestw_stack_top ()))
+ {
+ ffebad_start (FFEBAD_LABEL_BLOCK);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ }
+ ffelab_set_blocknum (ffestc_label_,
+ ffestw_blocknum (ffestw_stack_top ()));
+ ffestd_labeldef_notloop (ffestc_label_);
+ break;
+
+ case FFELAB_typeLOOPEND:
+ if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+ || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+ { /* Unterminated block. */
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+ ffebad_here (0, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_finish ();
+ break;
+ }
+ ffestd_labeldef_branch (ffestc_label_);
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_finish ();
+ return;
+
+ case FFELAB_typeFORMAT:
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ break;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ ffestc_try_shriek_do_ ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+}
+
+/* ffestc_labeldef_useless_ -- Define label as a useless one
+
+ ffestc_labeldef_useless_(); */
+
+static void
+ffestc_labeldef_useless_ ()
+{
+ if ((ffesta_label_token == NULL)
+ || (ffestc_shriek_after1_ != NULL)
+ || !ffestc_labeldef_begin_ ())
+ return;
+
+ switch (ffelab_type (ffestc_label_))
+ {
+ case FFELAB_typeUNKNOWN:
+ ffelab_set_type (ffestc_label_, FFELAB_typeUSELESS);
+ ffestd_labeldef_useless (ffestc_label_);
+ break;
+
+ case FFELAB_typeLOOPEND:
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+ || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
+ { /* Unterminated block. */
+ ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
+ ffebad_here (0, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_finish ();
+ break;
+ }
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_doref_line (ffestc_label_),
+ ffelab_doref_column (ffestc_label_));
+ ffebad_finish ();
+ ffestc_labeldef_branch_end_ ();
+ return;
+
+ case FFELAB_typeASSIGNABLE:
+ case FFELAB_typeFORMAT:
+ case FFELAB_typeNOTLOOP:
+ ffelab_set_type (ffestc_label_, FFELAB_typeANY);
+ ffestd_labeldef_any (ffestc_label_);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
+ ffelex_token_where_column (ffesta_label_token));
+ ffebad_here (1, ffelab_firstref_line (ffestc_label_),
+ ffelab_firstref_column (ffestc_label_));
+ ffebad_finish ();
+ break;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ ffestc_try_shriek_do_ ();
+
+ ffelex_token_kill (ffesta_label_token);
+ ffesta_label_token = NULL;
+}
+
+/* ffestc_labelref_is_assignable_ -- Reference to label in ASSIGN stmt
+
+ if (ffestc_labelref_is_assignable_(label_token,&label))
+ // label ref is ok, label is filled in with ffelab object */
+
+static bool
+ffestc_labelref_is_assignable_ (ffelexToken label_token, ffelab *x_label)
+{
+ ffelab label;
+ ffelabValue label_value;
+
+ label_value = (ffelabValue) atol (ffelex_token_text (label_token));
+ if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+ {
+ ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+ ffebad_here (0, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+ return FALSE;
+ }
+
+ label = ffelab_find (label_value);
+ if (label == NULL)
+ {
+ label = ffelab_new (label_value);
+ ffelab_set_firstref_line (label,
+ ffewhere_line_use (ffelex_token_where_line (label_token)));
+ ffelab_set_firstref_column (label,
+ ffewhere_column_use (ffelex_token_where_column (label_token)));
+ }
+
+ switch (ffelab_type (label))
+ {
+ case FFELAB_typeUNKNOWN:
+ ffelab_set_type (label, FFELAB_typeASSIGNABLE);
+ break;
+
+ case FFELAB_typeASSIGNABLE:
+ case FFELAB_typeLOOPEND:
+ case FFELAB_typeFORMAT:
+ case FFELAB_typeNOTLOOP:
+ case FFELAB_typeENDIF:
+ break;
+
+ case FFELAB_typeUSELESS:
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ *x_label = label;
+ return TRUE;
+}
+
+/* ffestc_labelref_is_branch_ -- Reference to label in branch stmt
+
+ if (ffestc_labelref_is_branch_(label_token,&label))
+ // label ref is ok, label is filled in with ffelab object */
+
+static bool
+ffestc_labelref_is_branch_ (ffelexToken label_token, ffelab *x_label)
+{
+ ffelab label;
+ ffelabValue label_value;
+ ffestw block;
+ unsigned long blocknum;
+
+ label_value = (ffelabValue) atol (ffelex_token_text (label_token));
+ if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+ {
+ ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+ ffebad_here (0, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+ return FALSE;
+ }
+
+ label = ffelab_find (label_value);
+ if (label == NULL)
+ {
+ label = ffelab_new (label_value);
+ ffelab_set_firstref_line (label,
+ ffewhere_line_use (ffelex_token_where_line (label_token)));
+ ffelab_set_firstref_column (label,
+ ffewhere_column_use (ffelex_token_where_column (label_token)));
+ }
+
+ switch (ffelab_type (label))
+ {
+ case FFELAB_typeUNKNOWN:
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_type (label, FFELAB_typeNOTLOOP);
+ ffelab_set_blocknum (label, ffestw_blocknum (ffestw_stack_top ()));
+ break;
+
+ case FFELAB_typeLOOPEND:
+ if (ffelab_blocknum (label) != 0)
+ break; /* Already taken care of. */
+ for (block = ffestw_top_do (ffestw_stack_top ());
+ (block != NULL) && (ffestw_label (block) != label);
+ block = ffestw_top_do (ffestw_previous (block)))
+ ; /* Find most recent DO <label> ancestor. */
+ if (block == NULL)
+ { /* Reference to within a (dead) block. */
+ ffebad_start (FFEBAD_LABEL_BLOCK);
+ ffebad_here (0, ffelab_definition_line (label),
+ ffelab_definition_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+ break;
+ }
+ ffelab_set_blocknum (label, ffestw_blocknum (block));
+ ffelab_set_firstref_line (label,
+ ffewhere_line_use (ffelex_token_where_line (label_token)));
+ ffelab_set_firstref_column (label,
+ ffewhere_column_use (ffelex_token_where_column (label_token)));
+ break;
+
+ case FFELAB_typeNOTLOOP:
+ case FFELAB_typeENDIF:
+ if (ffelab_blocknum (label) == ffestw_blocknum (ffestw_stack_top ()))
+ break;
+ blocknum = ffelab_blocknum (label);
+ for (block = ffestw_stack_top ();
+ ffestw_blocknum (block) > blocknum;
+ block = ffestw_previous (block))
+ ; /* Find most recent common ancestor. */
+ if (ffelab_blocknum (label) == ffestw_blocknum (block))
+ break; /* Check again. */
+ if (!ffewhere_line_is_unknown (ffelab_definition_line (label)))
+ { /* Reference to within a (dead) block. */
+ ffebad_start (FFEBAD_LABEL_BLOCK);
+ ffebad_here (0, ffelab_definition_line (label),
+ ffelab_definition_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+ break;
+ }
+ ffelab_set_blocknum (label, ffestw_blocknum (block));
+ break;
+
+ case FFELAB_typeFORMAT:
+ if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
+ {
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_USE_USE);
+ ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+ }
+ /* Fall through. */
+ case FFELAB_typeUSELESS:
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ *x_label = label;
+ return TRUE;
+}
+
+/* ffestc_labelref_is_format_ -- Reference to label in [FMT=] specification
+
+ if (ffestc_labelref_is_format_(label_token,&label))
+ // label ref is ok, label is filled in with ffelab object */
+
+static bool
+ffestc_labelref_is_format_ (ffelexToken label_token, ffelab *x_label)
+{
+ ffelab label;
+ ffelabValue label_value;
+
+ label_value = (ffelabValue) atol (ffelex_token_text (label_token));
+ if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+ {
+ ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+ ffebad_here (0, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+ return FALSE;
+ }
+
+ label = ffelab_find (label_value);
+ if (label == NULL)
+ {
+ label = ffelab_new (label_value);
+ ffelab_set_firstref_line (label,
+ ffewhere_line_use (ffelex_token_where_line (label_token)));
+ ffelab_set_firstref_column (label,
+ ffewhere_column_use (ffelex_token_where_column (label_token)));
+ }
+
+ switch (ffelab_type (label))
+ {
+ case FFELAB_typeUNKNOWN:
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_type (label, FFELAB_typeFORMAT);
+ break;
+
+ case FFELAB_typeFORMAT:
+ break;
+
+ case FFELAB_typeLOOPEND:
+ case FFELAB_typeNOTLOOP:
+ if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
+ {
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_USE_USE);
+ ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+ }
+ /* Fall through. */
+ case FFELAB_typeUSELESS:
+ case FFELAB_typeENDIF:
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ ffestc_try_shriek_do_ ();
+
+ *x_label = label;
+ return TRUE;
+}
+
+/* ffestc_labelref_is_loopend_ -- Reference to label in DO stmt
+
+ if (ffestc_labelref_is_loopend_(label_token,&label))
+ // label ref is ok, label is filled in with ffelab object */
+
+static bool
+ffestc_labelref_is_loopend_ (ffelexToken label_token, ffelab *x_label)
+{
+ ffelab label;
+ ffelabValue label_value;
+
+ label_value = (ffelabValue) atol (ffelex_token_text (label_token));
+ if ((label_value == 0) || (label_value > FFELAB_valueMAX))
+ {
+ ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
+ ffebad_here (0, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+ return FALSE;
+ }
+
+ label = ffelab_find (label_value);
+ if (label == NULL)
+ {
+ label = ffelab_new (label_value);
+ ffelab_set_doref_line (label,
+ ffewhere_line_use (ffelex_token_where_line (label_token)));
+ ffelab_set_doref_column (label,
+ ffewhere_column_use (ffelex_token_where_column (label_token)));
+ }
+
+ switch (ffelab_type (label))
+ {
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_doref_line (label,
+ ffewhere_line_use (ffelex_token_where_line (label_token)));
+ ffelab_set_doref_column (label,
+ ffewhere_column_use (ffelex_token_where_column (label_token)));
+ ffewhere_line_kill (ffelab_firstref_line (label));
+ ffelab_set_firstref_line (label, ffewhere_line_unknown ());
+ ffewhere_column_kill (ffelab_firstref_column (label));
+ ffelab_set_firstref_column (label, ffewhere_column_unknown ());
+ /* Fall through. */
+ case FFELAB_typeUNKNOWN:
+ ffelab_set_type (label, FFELAB_typeLOOPEND);
+ ffelab_set_blocknum (label, 0);
+ break;
+
+ case FFELAB_typeLOOPEND:
+ if (!ffewhere_line_is_unknown (ffelab_definition_line (label)))
+ { /* Def must follow all refs. */
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_DEF_DO);
+ ffebad_here (0, ffelab_definition_line (label),
+ ffelab_definition_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+ }
+ if (ffelab_blocknum (label) != 0)
+ { /* Had a branch ref earlier, can't go inside
+ this new block! */
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_USE_USE);
+ ffebad_here (0, ffelab_firstref_line (label),
+ ffelab_firstref_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+ }
+ if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
+ || (ffestw_label (ffestw_stack_top ()) != label))
+ { /* Top of stack interrupts flow between two
+ DOs specifying label. */
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_DO_BLOCK_DO);
+ ffebad_here (0, ffelab_doref_line (label),
+ ffelab_doref_column (label));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_here (2, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+ }
+ break;
+
+ case FFELAB_typeNOTLOOP:
+ case FFELAB_typeFORMAT:
+ if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
+ {
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_USE_USE);
+ ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+ }
+ /* Fall through. */
+ case FFELAB_typeUSELESS:
+ case FFELAB_typeENDIF:
+ ffelab_set_type (label, FFELAB_typeANY);
+ ffestd_labeldef_any (label);
+
+ ffebad_start (FFEBAD_LABEL_USE_DEF);
+ ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
+ ffebad_here (1, ffelex_token_where_line (label_token),
+ ffelex_token_where_column (label_token));
+ ffebad_finish ();
+
+ ffestc_try_shriek_do_ ();
+
+ return FALSE;
+
+ default:
+ assert ("bad label" == NULL);
+ /* Fall through. */
+ case FFELAB_typeANY:
+ break;
+ }
+
+ *x_label = label;
+ return TRUE;
+}
+
+/* ffestc_order_access_ -- Check ordering on <access> statement
+
+ if (ffestc_order_access_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_access_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE3:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_actiondo_ -- Check ordering on <actiondo> statement
+
+ if (ffestc_order_actiondo_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_actiondo_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateDO:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateSELECT1:
+ if (ffestw_top_do (ffestw_stack_top ()) == NULL)
+ break;
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateIF:
+ if (ffestw_top_do (ffestw_stack_top ()) == NULL)
+ break;
+ ffestc_shriek_after1_ = ffestc_shriek_if_;
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ default:
+ break;
+ }
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+}
+
+/* ffestc_order_actionif_ -- Check ordering on <actionif> statement
+
+ if (ffestc_order_actionif_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_actionif_ ()
+{
+ bool update;
+
+recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_statePROGRAM3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+ update = TRUE;
+ break;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+ update = TRUE;
+ break;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+ update = TRUE;
+ break;
+
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ update = FALSE;
+ break;
+
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateDO:
+ case FFESTV_stateSELECT1:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateIF:
+ ffestc_shriek_after1_ = ffestc_shriek_if_;
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+
+ switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+ {
+ case FFESTV_stateINTERFACE0:
+ ffestc_order_bad_ ();
+ if (update)
+ ffestw_update (NULL);
+ return FFESTC_orderBAD_;
+
+ default:
+ if (update)
+ ffestw_update (NULL);
+ return FFESTC_orderOK_;
+ }
+}
+
+/* ffestc_order_actionwhere_ -- Check ordering on <actionwhere> statement
+
+ if (ffestc_order_actionwhere_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_actionwhere_ ()
+{
+ bool update;
+
+recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_statePROGRAM3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+ update = TRUE;
+ break;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+ update = TRUE;
+ break;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+ update = TRUE;
+ break;
+
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ update = FALSE;
+ break;
+
+ case FFESTV_stateWHERETHEN:
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateDO:
+ case FFESTV_stateSELECT1:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+#if FFESTR_F90
+ ffestc_shriek_after1_ = ffestc_shriek_where_;
+#endif
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateIF:
+ ffestc_shriek_after1_ = ffestc_shriek_if_;
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+
+ switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+ {
+ case FFESTV_stateINTERFACE0:
+ ffestc_order_bad_ ();
+ if (update)
+ ffestw_update (NULL);
+ return FFESTC_orderBAD_;
+
+ default:
+ if (update)
+ ffestw_update (NULL);
+ return FFESTC_orderOK_;
+ }
+}
+
+/* Check ordering on "any" statement. Like _actionwhere_, but
+ doesn't produce any diagnostics. */
+
+static void
+ffestc_order_any_ ()
+{
+ bool update;
+
+recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_statePROGRAM3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+ update = TRUE;
+ break;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+ update = TRUE;
+ break;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+ update = TRUE;
+ break;
+
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ update = FALSE;
+ break;
+
+ case FFESTV_stateWHERETHEN:
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateDO:
+ case FFESTV_stateSELECT1:
+ return;
+
+ case FFESTV_stateWHERE:
+#if FFESTR_F90
+ ffestc_shriek_after1_ = ffestc_shriek_where_;
+#endif
+ return;
+
+ case FFESTV_stateIF:
+ ffestc_shriek_after1_ = ffestc_shriek_if_;
+ return;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ default:
+ return;
+ }
+
+ switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+ {
+ case FFESTV_stateINTERFACE0:
+ if (update)
+ ffestw_update (NULL);
+ return;
+
+ default:
+ if (update)
+ ffestw_update (NULL);
+ return;
+ }
+}
+
+/* ffestc_order_bad_ -- Whine about statement ordering violation
+
+ ffestc_order_bad_();
+
+ Uses current ffesta_tokens[0] and, if available, info on where current
+ state started to produce generic message. Someday we should do
+ fancier things than this, but this just gets things creaking along for
+ now. */
+
+static void
+ffestc_order_bad_ ()
+{
+ if (ffewhere_line_is_unknown (ffestw_line (ffestw_stack_top ())))
+ {
+ ffebad_start (FFEBAD_ORDER_1);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+ else
+ {
+ ffebad_start (FFEBAD_ORDER_2);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ ffestc_labeldef_useless_ (); /* Any label definition is useless. */
+}
+
+/* ffestc_order_blockdata_ -- Check ordering on <blockdata> statement
+
+ if (ffestc_order_blockdata_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_blockdata_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_stateBLOCKDATA2:
+ case FFESTV_stateBLOCKDATA3:
+ case FFESTV_stateBLOCKDATA4:
+ case FFESTV_stateBLOCKDATA5:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_blockspec_ -- Check ordering on <blockspec> statement
+
+ if (ffestc_order_blockspec_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_blockspec_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_stateBLOCKDATA2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateBLOCKDATA3:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_component_ -- Check ordering on <component-decl> statement
+
+ if (ffestc_order_component_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_component_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateTYPE:
+ case FFESTV_stateSTRUCTURE:
+ case FFESTV_stateMAP:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_contains_ -- Check ordering on CONTAINS statement
+
+ if (ffestc_order_contains_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_contains_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_statePROGRAM3:
+ case FFESTV_statePROGRAM4:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM5);
+ break;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateSUBROUTINE4:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE5);
+ break;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateFUNCTION4:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION5);
+ break;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateMODULE4:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE5);
+ break;
+
+ case FFESTV_stateUSE:
+ ffestc_shriek_end_uses_ (TRUE);
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+
+ switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+ {
+ case FFESTV_stateNIL:
+ ffestw_update (NULL);
+ return FFESTC_orderOK_;
+
+ default:
+ ffestc_order_bad_ ();
+ ffestw_update (NULL);
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_data_ -- Check ordering on DATA statement
+
+ if (ffestc_order_data_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_data_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM2:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateBLOCKDATA2:
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateBLOCKDATA3:
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ case FFESTV_stateBLOCKDATA4:
+ case FFESTV_stateWHERETHEN:
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateDO:
+ case FFESTV_stateSELECT0:
+ case FFESTV_stateSELECT1:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_data77_ -- Check ordering on pedantic-F77 DATA statement
+
+ if (ffestc_order_data77_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_data77_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_statePROGRAM3:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_stateBLOCKDATA2:
+ case FFESTV_stateBLOCKDATA3:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA4);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ case FFESTV_stateBLOCKDATA4:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERETHEN:
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateDO:
+ case FFESTV_stateSELECT0:
+ case FFESTV_stateSELECT1:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_derivedtype_ -- Check ordering on derived TYPE statement
+
+ if (ffestc_order_derivedtype_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_derivedtype_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+ ffestc_shriek_end_uses_ (TRUE);
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_do_ -- Check ordering on <do> statement
+
+ if (ffestc_order_do_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_do_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateDO:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_entry_ -- Check ordering on ENTRY statement
+
+ if (ffestc_order_entry_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_entry_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateSUBROUTINE0:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1);
+ break;
+
+ case FFESTV_stateFUNCTION0:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1);
+ break;
+
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ break;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+
+ switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+ {
+ case FFESTV_stateNIL:
+ case FFESTV_stateMODULE5:
+ ffestw_update (NULL);
+ return FFESTC_orderOK_;
+
+ default:
+ ffestc_order_bad_ ();
+ ffestw_update (NULL);
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_exec_ -- Check ordering on <exec> statement
+
+ if (ffestc_order_exec_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_exec_ ()
+{
+ bool update;
+
+recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_statePROGRAM3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
+ update = TRUE;
+ break;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
+ update = TRUE;
+ break;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
+ update = TRUE;
+ break;
+
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ update = FALSE;
+ break;
+
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateDO:
+ case FFESTV_stateSELECT1:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+
+ switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
+ {
+ case FFESTV_stateINTERFACE0:
+ ffestc_order_bad_ ();
+ if (update)
+ ffestw_update (NULL);
+ return FFESTC_orderBAD_;
+
+ default:
+ if (update)
+ ffestw_update (NULL);
+ return FFESTC_orderOK_;
+ }
+}
+
+/* ffestc_order_format_ -- Check ordering on FORMAT statement
+
+ if (ffestc_order_format_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_format_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM1);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ case FFESTV_stateWHERETHEN:
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateDO:
+ case FFESTV_stateSELECT0:
+ case FFESTV_stateSELECT1:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_function_ -- Check ordering on <function> statement
+
+ if (ffestc_order_function_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_function_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateFUNCTION4:
+ case FFESTV_stateFUNCTION5:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_iface_ -- Check ordering on <iface> statement
+
+ if (ffestc_order_iface_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_iface_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ case FFESTV_statePROGRAM5:
+ case FFESTV_stateSUBROUTINE5:
+ case FFESTV_stateFUNCTION5:
+ case FFESTV_stateMODULE5:
+ case FFESTV_stateINTERFACE0:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_ifthen_ -- Check ordering on <ifthen> statement
+
+ if (ffestc_order_ifthen_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_ifthen_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateIFTHEN:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_implicit_ -- Check ordering on IMPLICIT statement
+
+ if (ffestc_order_implicit_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_implicit_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM2:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateMODULE2:
+ case FFESTV_stateBLOCKDATA2:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_implicitnone_ -- Check ordering on IMPLICIT NONE statement
+
+ if (ffestc_order_implicitnone_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_implicitnone_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_interface_ -- Check ordering on <interface> statement
+
+ if (ffestc_order_interface_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_interface_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateINTERFACE0:
+ case FFESTV_stateINTERFACE1:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_map_ -- Check ordering on <map> statement
+
+ if (ffestc_order_map_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_map_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateMAP:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_module_ -- Check ordering on <module> statement
+
+ if (ffestc_order_module_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_module_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateMODULE4:
+ case FFESTV_stateMODULE5:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+ ffestc_shriek_end_uses_ (TRUE);
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_parameter_ -- Check ordering on <parameter> statement
+
+ if (ffestc_order_parameter_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_parameter_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM2:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateMODULE2:
+ case FFESTV_stateBLOCKDATA2:
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateBLOCKDATA3:
+ case FFESTV_stateTYPE: /* GNU extension here! */
+ case FFESTV_stateSTRUCTURE:
+ case FFESTV_stateUNION:
+ case FFESTV_stateMAP:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_program_ -- Check ordering on <program> statement
+
+ if (ffestc_order_program_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_program_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_statePROGRAM3:
+ case FFESTV_statePROGRAM4:
+ case FFESTV_statePROGRAM5:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_progspec_ -- Check ordering on <progspec> statement
+
+ if (ffestc_order_progspec_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_progspec_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_stateBLOCKDATA2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
+ if (ffe_is_pedantic ())
+ {
+ ffebad_start (FFEBAD_BLOCKDATA_STMT);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_record_ -- Check ordering on RECORD statement
+
+ if (ffestc_order_record_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_record_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_stateBLOCKDATA2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateBLOCKDATA3:
+ case FFESTV_stateSTRUCTURE:
+ case FFESTV_stateMAP:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_selectcase_ -- Check ordering on <selectcase> statement
+
+ if (ffestc_order_selectcase_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_selectcase_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateSELECT0:
+ case FFESTV_stateSELECT1:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_sfunc_ -- Check ordering on statement-function definition
+
+ if (ffestc_order_sfunc_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_sfunc_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_spec_ -- Check ordering on <spec> statement
+
+ if (ffestc_order_spec_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_spec_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_structure_ -- Check ordering on <structure> statement
+
+ if (ffestc_order_structure_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_structure_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateSTRUCTURE:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_subroutine_ -- Check ordering on <subroutine> statement
+
+ if (ffestc_order_subroutine_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_subroutine_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateSUBROUTINE5:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_type_ -- Check ordering on <type> statement
+
+ if (ffestc_order_type_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_type_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateTYPE:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_typedecl_ -- Check ordering on <typedecl> statement
+
+ if (ffestc_order_typedecl_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_typedecl_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_stateBLOCKDATA2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateBLOCKDATA3:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_union_ -- Check ordering on <union> statement
+
+ if (ffestc_order_union_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_union_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateUNION:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_unit_ -- Check ordering on <unit> statement
+
+ if (ffestc_order_unit_() != FFESTC_orderOK_)
+ return; */
+
+static ffestcOrder_
+ffestc_order_unit_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+/* ffestc_order_use_ -- Check ordering on USE statement
+
+ if (ffestc_order_use_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_use_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM1);
+ ffestc_shriek_begin_uses_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateSUBROUTINE0:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1);
+ ffestc_shriek_begin_uses_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateFUNCTION0:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1);
+ ffestc_shriek_begin_uses_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateMODULE0:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE1);
+ ffestc_shriek_begin_uses_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateUSE:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_vxtstructure_ -- Check ordering on STRUCTURE statement
+
+ if (ffestc_order_vxtstructure_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_VXT
+static ffestcOrder_
+ffestc_order_vxtstructure_ ()
+{
+ recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_statePROGRAM2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_stateBLOCKDATA2:
+ ffestw_update (NULL);
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
+ return FFESTC_orderOK_;
+
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateBLOCKDATA3:
+ case FFESTV_stateSTRUCTURE:
+ case FFESTV_stateMAP:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+#if FFESTR_F90
+ ffestc_shriek_where_ (FALSE);
+#endif
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* ffestc_order_where_ -- Check ordering on <where> statement
+
+ if (ffestc_order_where_() != FFESTC_orderOK_)
+ return; */
+
+#if FFESTR_F90
+static ffestcOrder_
+ffestc_order_where_ ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateWHERETHEN:
+ return FFESTC_orderOK_;
+
+ case FFESTV_stateWHERE:
+ ffestc_order_bad_ ();
+ ffestc_shriek_where_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ case FFESTV_stateIF:
+ ffestc_order_bad_ ();
+ ffestc_shriek_if_ (FALSE);
+ return FFESTC_orderBAD_;
+
+ default:
+ ffestc_order_bad_ ();
+ return FFESTC_orderBAD_;
+ }
+}
+
+#endif
+/* Invoked for each token in dummy arg list of FUNCTION, SUBROUTINE, and
+ ENTRY (prior to the first executable statement). */
+
+static void
+ffestc_promote_dummy_ (ffelexToken t)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffebld e;
+ bool sfref_ok;
+
+ assert (t != NULL);
+
+ if (ffelex_token_type (t) == FFELEX_typeASTERISK)
+ {
+ ffebld_append_item (&ffestc_local_.dummy.list_bottom,
+ ffebld_new_star ());
+ return; /* Don't bother with alternate returns! */
+ }
+
+ s = ffesymbol_declare_local (t, FALSE);
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ sfref_ok = FALSE;
+
+ if (sa & FFESYMBOL_attrsANY)
+ na = sa;
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ if (ffestc_entry_num_ == ffesymbol_maxentrynum (s))
+ { /* Seen this one twice in this list! */
+ na = FFESYMBOL_attrsetNONE;
+ }
+ else
+ na = sa;
+ sfref_ok = TRUE; /* Ok for sym to be ref'd in sfuncdef
+ previously, since already declared as a
+ dummy arg. */
+ }
+ else if (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsANY
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsDUMMY;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ if (!ffesymbol_is_specable (s)
+ && (!sfref_ok
+ || (ffesymbol_where (s) != FFEINFO_whereDUMMY)))
+ na = FFESYMBOL_attrsetNONE; /* Can't dcl sym ref'd in sfuncdef. */
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_set_maxentrynum (s, ffestc_entry_num_);
+ ffesymbol_set_numentries (s, ffesymbol_numentries (s) + 1);
+ e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE);
+ ffebld_set_info (e,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ FFETARGET_charactersizeNONE));
+ ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
+ ffesymbol_signal_unreported (s);
+ }
+}
+
+/* ffestc_promote_execdummy_ -- Declare token as dummy variable in exec context
+
+ ffestc_promote_execdummy_(t);
+
+ Invoked for each token in dummy arg list of ENTRY when the statement
+ follows the first executable statement. */
+
+static void
+ffestc_promote_execdummy_ (ffelexToken t)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffesymbolState ss;
+ ffesymbolState ns;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ ffebld e;
+
+ assert (t != NULL);
+
+ if (ffelex_token_type (t) == FFELEX_typeASTERISK)
+ {
+ ffebld_append_item (&ffestc_local_.dummy.list_bottom,
+ ffebld_new_star ());
+ return; /* Don't bother with alternate returns! */
+ }
+
+ s = ffesymbol_declare_local (t, FALSE);
+ na = sa = ffesymbol_attrs (s);
+ ss = ffesymbol_state (s);
+ kind = ffesymbol_kind (s);
+ where = ffesymbol_where (s);
+
+ if (ffestc_entry_num_ == ffesymbol_maxentrynum (s))
+ { /* Seen this one twice in this list! */
+ na = FFESYMBOL_attrsetNONE;
+ }
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ ns = FFESYMBOL_stateUNDERSTOOD; /* Assume we know it all know. */
+
+ switch (kind)
+ {
+ case FFEINFO_kindENTITY:
+ case FFEINFO_kindFUNCTION:
+ case FFEINFO_kindSUBROUTINE:
+ break; /* These are fine, as far as we know. */
+
+ case FFEINFO_kindNONE:
+ if (sa & FFESYMBOL_attrsDUMMY)
+ ns = FFESYMBOL_stateUNCERTAIN; /* Learned nothing new. */
+ else if (sa & FFESYMBOL_attrsANYLEN)
+ {
+ kind = FFEINFO_kindENTITY;
+ where = FFEINFO_whereDUMMY;
+ }
+ else if (sa & FFESYMBOL_attrsACTUALARG)
+ na = FFESYMBOL_attrsetNONE;
+ else
+ {
+ na = sa | FFESYMBOL_attrsDUMMY;
+ ns = FFESYMBOL_stateUNCERTAIN;
+ }
+ break;
+
+ default:
+ na = FFESYMBOL_attrsetNONE; /* Error. */
+ break;
+ }
+
+ switch (where)
+ {
+ case FFEINFO_whereDUMMY:
+ break; /* This is fine. */
+
+ case FFEINFO_whereNONE:
+ where = FFEINFO_whereDUMMY;
+ break;
+
+ default:
+ na = FFESYMBOL_attrsetNONE; /* Error. */
+ break;
+ }
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, t);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, ns);
+ ffesymbol_set_maxentrynum (s, ffestc_entry_num_);
+ ffesymbol_set_numentries (s, ffesymbol_numentries (s) + 1);
+ if ((ns == FFESYMBOL_stateUNDERSTOOD)
+ && (kind != FFEINFO_kindSUBROUTINE)
+ && !ffeimplic_establish_symbol (s))
+ {
+ ffesymbol_error (s, t);
+ return;
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ kind,
+ where,
+ ffesymbol_size (s)));
+ e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE);
+ ffebld_set_info (e, ffeinfo_use (ffesymbol_info (s)));
+ ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s);
+ }
+}
+
+/* ffestc_promote_sfdummy_ -- Declare token as stmt-func dummy variable
+
+ ffestc_promote_sfdummy_(t);
+
+ Invoked for each token in dummy arg list of statement function.
+
+ 22-Oct-91 JCB 1.1
+ Reject arg if CHARACTER*(*). */
+
+static void
+ffestc_promote_sfdummy_ (ffelexToken t)
+{
+ ffesymbol s;
+ ffesymbol sp; /* Parent symbol. */
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffebld e;
+
+ assert (t != NULL);
+
+ s = ffesymbol_declare_sfdummy (t); /* Sets maxentrynum to 0 for new obj;
+ also sets sfa_dummy_parent to
+ parent symbol. */
+ if (ffesymbol_state (s) != FFESYMBOL_stateNONE)
+ {
+ ffesymbol_error (s, t); /* Dummy already in list. */
+ return;
+ }
+
+ sp = ffesymbol_sfdummyparent (s); /* Now flag dummy's parent as used
+ for dummy. */
+ sa = ffesymbol_attrs (sp);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!ffesymbol_is_specable (sp)
+ && ((ffesymbol_kind (sp) != FFEINFO_kindENTITY)
+ || ((ffesymbol_where (sp) != FFEINFO_whereLOCAL)
+ && (ffesymbol_where (sp) != FFEINFO_whereCOMMON)
+ && (ffesymbol_where (sp) != FFEINFO_whereDUMMY)
+ && (ffesymbol_where (sp) != FFEINFO_whereNONE))))
+ na = FFESYMBOL_attrsetNONE; /* Can't be PARAMETER etc., must be a var. */
+ else if (sa & FFESYMBOL_attrsANY)
+ na = sa;
+ else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsRESULT
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsSFARG;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ {
+ ffesymbol_error (sp, t);
+ ffesymbol_set_info (s, ffeinfo_new_any ());
+ }
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
+ ffesymbol_set_attrs (sp, na);
+ if (!ffeimplic_establish_symbol (sp)
+ || ((ffesymbol_basictype (sp) == FFEINFO_basictypeCHARACTER)
+ && (ffesymbol_size (sp) == FFETARGET_charactersizeNONE)))
+ ffesymbol_error (sp, t);
+ else
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (sp),
+ ffesymbol_kindtype (sp),
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereDUMMY,
+ ffesymbol_size (sp)));
+
+ ffesymbol_signal_unreported (sp);
+ }
+
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_maxentrynum (s, ffestc_sfdummy_argno_++);
+ ffesymbol_signal_unreported (s);
+ e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE);
+ ffebld_set_info (e, ffeinfo_use (ffesymbol_info (s)));
+ ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
+}
+
+/* ffestc_shriek_begin_program_ -- Implicit PROGRAM statement
+
+ ffestc_shriek_begin_program_();
+
+ Invoked only when a PROGRAM statement is NOT present at the beginning
+ of a main program unit. */
+
+static void
+ffestc_shriek_begin_program_ ()
+{
+ ffestw b;
+ ffesymbol s;
+
+ ffestc_blocknum_ = 0;
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_statePROGRAM0);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_end_program_);
+ ffestw_set_name (b, NULL);
+
+ s = ffesymbol_declare_programunit (NULL,
+ ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+
+ /* Special case: this is one symbol that won't go through
+ ffestu_exec_transition_ when the first statement in a main program is
+ executable, because the transition happens in ffest before ffestc is
+ reached and triggers the implicit generation of a main program. So we
+ do the exec transition for the implicit main program right here, just
+ for cleanliness' sake (at the very least). */
+
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindPROGRAM,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+
+ ffesymbol_signal_unreported (s);
+
+ ffestd_R1102 (s, NULL);
+}
+
+/* ffestc_shriek_begin_uses_ -- Start a bunch of USE statements
+
+ ffestc_shriek_begin_uses_();
+
+ Invoked before handling the first USE statement in a block of one or
+ more USE statements. _end_uses_(bool ok) is invoked before handling
+ the first statement after the block (there are no BEGIN USE and END USE
+ statements, but the semantics of USE statements effectively requires
+ handling them as a single block rather than one statement at a time). */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_begin_uses_ ()
+{
+ ffestw b;
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateUSE);
+ ffestw_set_blocknum (b, 0);
+ ffestw_set_shriek (b, ffestc_shriek_end_uses_);
+
+ ffestd_begin_uses ();
+}
+
+#endif
+/* ffestc_shriek_blockdata_ -- End a BLOCK DATA
+
+ ffestc_shriek_blockdata_(TRUE); */
+
+static void
+ffestc_shriek_blockdata_ (bool ok)
+{
+ if (!ffesta_seen_first_exec)
+ {
+ ffesta_seen_first_exec = TRUE;
+ ffestd_exec_begin ();
+ }
+
+ ffestd_R1112 (ok);
+
+ ffestd_exec_end ();
+
+ if (ffestw_name (ffestw_stack_top ()) != NULL)
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ ffestw_kill (ffestw_pop ());
+
+ ffe_terminate_2 ();
+ ffe_init_2 ();
+}
+
+/* ffestc_shriek_do_ -- End of statement following DO-term-stmt etc
+
+ ffestc_shriek_do_(TRUE);
+
+ Also invoked by _labeldef_branch_end_ (or, in cases
+ of errors, other _labeldef_ functions) when the label definition is
+ for a DO-target (LOOPEND) label, once per matching/outstanding DO
+ block on the stack. These cases invoke this function with ok==TRUE, so
+ only forced stack popping (via ffestc_eof()) invokes it with ok==FALSE. */
+
+static void
+ffestc_shriek_do_ (bool ok)
+{
+ ffelab l;
+
+ if (((l = ffestw_label (ffestw_stack_top ())) != NULL)
+ && (ffewhere_line_is_unknown (ffelab_definition_line (l))))
+ { /* DO target is label that is still
+ undefined. */
+ assert ((ffelab_type (l) == FFELAB_typeLOOPEND)
+ || (ffelab_type (l) == FFELAB_typeANY));
+ if (ffelab_type (l) != FFELAB_typeANY)
+ {
+ ffelab_set_definition_line (l,
+ ffewhere_line_use (ffelab_doref_line (l)));
+ ffelab_set_definition_column (l,
+ ffewhere_column_use (ffelab_doref_column (l)));
+ ffestv_num_label_defines_++;
+ }
+ ffestd_labeldef_branch (l);
+ }
+
+ ffestd_do (ok);
+
+ if (ffestw_name (ffestw_stack_top ()) != NULL)
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ if (ffestw_do_iter_var_t (ffestw_stack_top ()) != NULL)
+ ffelex_token_kill (ffestw_do_iter_var_t (ffestw_stack_top ()));
+ if (ffestw_do_iter_var (ffestw_stack_top ()) != NULL)
+ ffesymbol_set_is_doiter (ffestw_do_iter_var (ffestw_stack_top ()), FALSE);
+ ffestw_kill (ffestw_pop ());
+}
+
+/* ffestc_shriek_end_program_ -- End a PROGRAM
+
+ ffestc_shriek_end_program_(); */
+
+static void
+ffestc_shriek_end_program_ (bool ok)
+{
+ if (!ffesta_seen_first_exec)
+ {
+ ffesta_seen_first_exec = TRUE;
+ ffestd_exec_begin ();
+ }
+
+ ffestd_R1103 (ok);
+
+ ffestd_exec_end ();
+
+ if (ffestw_name (ffestw_stack_top ()) != NULL)
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ ffestw_kill (ffestw_pop ());
+
+ ffe_terminate_2 ();
+ ffe_init_2 ();
+}
+
+/* ffestc_shriek_end_uses_ -- End a bunch of USE statements
+
+ ffestc_shriek_end_uses_(TRUE);
+
+ ok==TRUE means simply not popping due to ffestc_eof()
+ being called, because there is no formal END USES statement in Fortran. */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_end_uses_ (bool ok)
+{
+ ffestd_end_uses (ok);
+
+ ffestw_kill (ffestw_pop ());
+}
+
+#endif
+/* ffestc_shriek_function_ -- End a FUNCTION
+
+ ffestc_shriek_function_(TRUE); */
+
+static void
+ffestc_shriek_function_ (bool ok)
+{
+ if (!ffesta_seen_first_exec)
+ {
+ ffesta_seen_first_exec = TRUE;
+ ffestd_exec_begin ();
+ }
+
+ ffestd_R1221 (ok);
+
+ ffestd_exec_end ();
+
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ ffestw_kill (ffestw_pop ());
+ ffesta_is_entry_valid = FALSE;
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffe_terminate_2 ();
+ ffe_init_2 ();
+ break;
+
+ default:
+ ffe_terminate_3 ();
+ ffe_init_3 ();
+ break;
+
+ case FFESTV_stateINTERFACE0:
+ ffe_terminate_4 ();
+ ffe_init_4 ();
+ break;
+ }
+}
+
+/* ffestc_shriek_if_ -- End of statement following logical IF
+
+ ffestc_shriek_if_(TRUE);
+
+ Applies ONLY to logical IF, not to IF-THEN. For example, does not
+ ffelex_token_kill the construct name for an IF-THEN block (the name
+ field is invalid for logical IF). ok==TRUE iff statement following
+ logical IF (substatement) is valid; else, statement is invalid or
+ stack forcibly popped due to ffestc_eof(). */
+
+static void
+ffestc_shriek_if_ (bool ok)
+{
+ ffestd_end_R807 (ok);
+
+ ffestw_kill (ffestw_pop ());
+ ffestc_shriek_after1_ = NULL;
+
+ ffestc_try_shriek_do_ ();
+}
+
+/* ffestc_shriek_ifthen_ -- End an IF-THEN
+
+ ffestc_shriek_ifthen_(TRUE); */
+
+static void
+ffestc_shriek_ifthen_ (bool ok)
+{
+ ffestd_R806 (ok);
+
+ if (ffestw_name (ffestw_stack_top ()) != NULL)
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ ffestw_kill (ffestw_pop ());
+
+ ffestc_try_shriek_do_ ();
+}
+
+/* ffestc_shriek_interface_ -- End an INTERFACE
+
+ ffestc_shriek_interface_(TRUE); */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_interface_ (bool ok)
+{
+ ffestd_R1203 (ok);
+
+ ffestw_kill (ffestw_pop ());
+
+ ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_map_ -- End a MAP
+
+ ffestc_shriek_map_(TRUE); */
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_map_ (bool ok)
+{
+ ffestd_V013 (ok);
+
+ ffestw_kill (ffestw_pop ());
+
+ ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_module_ -- End a MODULE
+
+ ffestc_shriek_module_(TRUE); */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_module_ (bool ok)
+{
+ if (!ffesta_seen_first_exec)
+ {
+ ffesta_seen_first_exec = TRUE;
+ ffestd_exec_begin ();
+ }
+
+ ffestd_R1106 (ok);
+
+ ffestd_exec_end ();
+
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ ffestw_kill (ffestw_pop ());
+
+ ffe_terminate_2 ();
+ ffe_init_2 ();
+}
+
+#endif
+/* ffestc_shriek_select_ -- End a SELECT
+
+ ffestc_shriek_select_(TRUE); */
+
+static void
+ffestc_shriek_select_ (bool ok)
+{
+ ffestwSelect s;
+ ffestwCase c;
+
+ ffestd_R811 (ok);
+
+ if (ffestw_name (ffestw_stack_top ()) != NULL)
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ s = ffestw_select (ffestw_stack_top ());
+ ffelex_token_kill (s->t);
+ for (c = s->first_rel; c != (ffestwCase) &s->first_rel; c = c->next_rel)
+ ffelex_token_kill (c->t);
+ malloc_pool_kill (s->pool);
+
+ ffestw_kill (ffestw_pop ());
+
+ ffestc_try_shriek_do_ ();
+}
+
+/* ffestc_shriek_structure_ -- End a STRUCTURE
+
+ ffestc_shriek_structure_(TRUE); */
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_structure_ (bool ok)
+{
+ ffestd_V004 (ok);
+
+ ffestw_kill (ffestw_pop ());
+
+ ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_subroutine_ -- End a SUBROUTINE
+
+ ffestc_shriek_subroutine_(TRUE); */
+
+static void
+ffestc_shriek_subroutine_ (bool ok)
+{
+ if (!ffesta_seen_first_exec)
+ {
+ ffesta_seen_first_exec = TRUE;
+ ffestd_exec_begin ();
+ }
+
+ ffestd_R1225 (ok);
+
+ ffestd_exec_end ();
+
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ ffestw_kill (ffestw_pop ());
+ ffesta_is_entry_valid = FALSE;
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffe_terminate_2 ();
+ ffe_init_2 ();
+ break;
+
+ default:
+ ffe_terminate_3 ();
+ ffe_init_3 ();
+ break;
+
+ case FFESTV_stateINTERFACE0:
+ ffe_terminate_4 ();
+ ffe_init_4 ();
+ break;
+ }
+}
+
+/* ffestc_shriek_type_ -- End a TYPE
+
+ ffestc_shriek_type_(TRUE); */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_type_ (bool ok)
+{
+ ffestd_R425 (ok);
+
+ ffe_terminate_4 ();
+
+ ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
+ ffestw_kill (ffestw_pop ());
+
+ ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_union_ -- End a UNION
+
+ ffestc_shriek_union_(TRUE); */
+
+#if FFESTR_VXT
+static void
+ffestc_shriek_union_ (bool ok)
+{
+ ffestd_V010 (ok);
+
+ ffestw_kill (ffestw_pop ());
+
+ ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_where_ -- Implicit END WHERE statement
+
+ ffestc_shriek_where_(TRUE);
+
+ Implement the end of the current WHERE "block". ok==TRUE iff statement
+ following WHERE (substatement) is valid; else, statement is invalid
+ or stack forcibly popped due to ffestc_eof(). */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_where_ (bool ok)
+{
+ ffestd_R745 (ok);
+
+ ffestw_kill (ffestw_pop ());
+ ffestc_shriek_after1_ = NULL;
+ if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateIF)
+ ffestc_shriek_if_ (TRUE); /* "IF (x) WHERE (y) stmt" is only valid
+ case. */
+
+ ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_shriek_wherethen_ -- End a WHERE(-THEN)
+
+ ffestc_shriek_wherethen_(TRUE); */
+
+#if FFESTR_F90
+static void
+ffestc_shriek_wherethen_ (bool ok)
+{
+ ffestd_end_R740 (ok);
+
+ ffestw_kill (ffestw_pop ());
+
+ ffestc_try_shriek_do_ ();
+}
+
+#endif
+/* ffestc_subr_binsrch_ -- Binary search of char const in list of strings
+
+ i = ffestc_subr_binsrch_(search_list,search_list_size,&spec,"etc");
+
+ search_list contains search_list_size char *'s, spec is checked to see
+ if it is a char constant and, if so, is binary-searched against the list.
+ 0 is returned if not found, else the "classic" index (beginning with 1)
+ is returned. Before returning 0 where the search was performed but
+ fruitless, if "etc" is a non-NULL char *, an error message is displayed
+ using "etc" as the pick-one-of-these string. */
+
+static int
+ffestc_subr_binsrch_ (char **list, int size, ffestpFile *spec, char *whine)
+{
+ int lowest_tested;
+ int highest_tested;
+ int halfway;
+ int offset;
+ int c;
+ char *str;
+ int len;
+
+ if (size == 0)
+ return 0; /* Nobody should pass size == 0, but for
+ elegance.... */
+
+ lowest_tested = -1;
+ highest_tested = size;
+ halfway = size >> 1;
+
+ list += halfway;
+
+ c = ffestc_subr_speccmp_ (*list, spec, &str, &len);
+ if (c == 2)
+ return 0;
+ c = -c; /* Sigh. */
+
+next: /* :::::::::::::::::::: */
+ switch (c)
+ {
+ case -1:
+ offset = (halfway - lowest_tested) >> 1;
+ if (offset == 0)
+ goto nope; /* :::::::::::::::::::: */
+ highest_tested = halfway;
+ list -= offset;
+ halfway -= offset;
+ c = ffesrc_strcmp_1ns2i (ffe_case_match (), str, len, *list);
+ goto next; /* :::::::::::::::::::: */
+
+ case 0:
+ return halfway + 1;
+
+ case 1:
+ offset = (highest_tested - halfway) >> 1;
+ if (offset == 0)
+ goto nope; /* :::::::::::::::::::: */
+ lowest_tested = halfway;
+ list += offset;
+ halfway += offset;
+ c = ffesrc_strcmp_1ns2i (ffe_case_match (), str, len, *list);
+ goto next; /* :::::::::::::::::::: */
+
+ default:
+ assert ("unexpected return from ffesrc_strcmp_1ns2i" == NULL);
+ break;
+ }
+
+nope: /* :::::::::::::::::::: */
+ ffebad_start (FFEBAD_SPEC_VALUE);
+ ffebad_here (0, ffelex_token_where_line (spec->value),
+ ffelex_token_where_column (spec->value));
+ ffebad_string (whine);
+ ffebad_finish ();
+ return 0;
+}
+
+/* ffestc_subr_format_ -- Return summary of format specifier
+
+ ffestc_subr_format_(&specifier); */
+
+static ffestvFormat
+ffestc_subr_format_ (ffestpFile *spec)
+{
+ if (!spec->kw_or_val_present)
+ return FFESTV_formatNONE;
+ assert (spec->value_present);
+ if (spec->value_is_label)
+ return FFESTV_formatLABEL; /* Ok if not a label. */
+
+ assert (spec->value != NULL);
+ if (ffebld_op (spec->u.expr) == FFEBLD_opSTAR)
+ return FFESTV_formatASTERISK;
+
+ if (ffeinfo_kind (ffebld_info (spec->u.expr)) == FFEINFO_kindNAMELIST)
+ return FFESTV_formatNAMELIST;
+
+ if (ffeinfo_rank (ffebld_info (spec->u.expr)) != 0)
+ return FFESTV_formatCHAREXPR; /* F77 C5. */
+
+ switch (ffeinfo_basictype (ffebld_info (spec->u.expr)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ return FFESTV_formatINTEXPR;
+
+ case FFEINFO_basictypeCHARACTER:
+ return FFESTV_formatCHAREXPR;
+
+ case FFEINFO_basictypeANY:
+ return FFESTV_formatASTERISK;
+
+ default:
+ assert ("bad basictype" == NULL);
+ return FFESTV_formatINTEXPR;
+ }
+}
+
+/* ffestc_subr_is_branch_ -- Handle specifier as branch target label
+
+ ffestc_subr_is_branch_(&specifier); */
+
+static bool
+ffestc_subr_is_branch_ (ffestpFile *spec)
+{
+ if (!spec->kw_or_val_present)
+ return TRUE;
+ assert (spec->value_present);
+ assert (spec->value_is_label);
+ spec->value_is_label++; /* For checking purposes only; 1=>2. */
+ return ffestc_labelref_is_branch_ (spec->value, &spec->u.label);
+}
+
+/* ffestc_subr_is_format_ -- Handle specifier as format target label
+
+ ffestc_subr_is_format_(&specifier); */
+
+static bool
+ffestc_subr_is_format_ (ffestpFile *spec)
+{
+ if (!spec->kw_or_val_present)
+ return TRUE;
+ assert (spec->value_present);
+ if (!spec->value_is_label)
+ return TRUE; /* Ok if not a label. */
+
+ spec->value_is_label++; /* For checking purposes only; 1=>2. */
+ return ffestc_labelref_is_format_ (spec->value, &spec->u.label);
+}
+
+/* ffestc_subr_is_present_ -- Ensure specifier is present, else error
+
+ ffestc_subr_is_present_("SPECIFIER",&specifier); */
+
+static bool
+ffestc_subr_is_present_ (char *name, ffestpFile *spec)
+{
+ if (spec->kw_or_val_present)
+ {
+ assert (spec->value_present);
+ return TRUE;
+ }
+
+ ffebad_start (FFEBAD_MISSING_SPECIFIER);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_string (name);
+ ffebad_finish ();
+ return FALSE;
+}
+
+/* ffestc_subr_speccmp_ -- Compare string to constant expression, if present
+
+ if (ffestc_subr_speccmp_("Constant",&specifier,NULL,NULL) == 0)
+ // specifier value is present and is a char constant "CONSTANT"
+
+ Like strcmp, except the return values are defined as: -1 returned in place
+ of strcmp's generic negative value, 1 in place of it's generic positive
+ value, and 2 when there is no character constant string to compare. Also,
+ a case-insensitive comparison is performed, where string is assumed to
+ already be in InitialCaps form.
+
+ If a non-NULL pointer is provided as the char **target, then *target is
+ written with NULL if 2 is returned, a pointer to the constant string
+ value of the specifier otherwise. Similarly, length is written with
+ 0 if 2 is returned, the length of the constant string value otherwise. */
+
+static int
+ffestc_subr_speccmp_ (char *string, ffestpFile *spec, char **target,
+ int *length)
+{
+ ffebldConstant c;
+ int i;
+
+ if (!spec->kw_or_val_present || !spec->value_present
+ || (spec->u.expr == NULL)
+ || (ffebld_op (spec->u.expr) != FFEBLD_opCONTER))
+ {
+ if (target != NULL)
+ *target = NULL;
+ if (length != NULL)
+ *length = 0;
+ return 2;
+ }
+
+ if (ffebld_constant_type (c = ffebld_conter (spec->u.expr))
+ != FFEBLD_constCHARACTERDEFAULT)
+ {
+ if (target != NULL)
+ *target = NULL;
+ if (length != NULL)
+ *length = 0;
+ return 2;
+ }
+
+ if (target != NULL)
+ *target = ffebld_constant_characterdefault (c).text;
+ if (length != NULL)
+ *length = ffebld_constant_characterdefault (c).length;
+
+ i = ffesrc_strcmp_1ns2i (ffe_case_match (),
+ ffebld_constant_characterdefault (c).text,
+ ffebld_constant_characterdefault (c).length,
+ string);
+ if (i == 0)
+ return 0;
+ if (i > 0)
+ return -1; /* Yes indeed, we reverse the strings to
+ _strcmpin_. */
+ return 1;
+}
+
+/* ffestc_subr_unit_ -- Return summary of unit specifier
+
+ ffestc_subr_unit_(&specifier); */
+
+static ffestvUnit
+ffestc_subr_unit_ (ffestpFile *spec)
+{
+ if (!spec->kw_or_val_present)
+ return FFESTV_unitNONE;
+ assert (spec->value_present);
+ assert (spec->value != NULL);
+
+ if (ffebld_op (spec->u.expr) == FFEBLD_opSTAR)
+ return FFESTV_unitASTERISK;
+
+ switch (ffeinfo_basictype (ffebld_info (spec->u.expr)))
+ {
+ case FFEINFO_basictypeINTEGER:
+ return FFESTV_unitINTEXPR;
+
+ case FFEINFO_basictypeCHARACTER:
+ return FFESTV_unitCHAREXPR;
+
+ case FFEINFO_basictypeANY:
+ return FFESTV_unitASTERISK;
+
+ default:
+ assert ("bad basictype" == NULL);
+ return FFESTV_unitINTEXPR;
+ }
+}
+
+/* Call this function whenever it's possible that one or more top
+ stack items are label-targeting DO blocks that have had their
+ labels defined, but at a time when they weren't at the top of the
+ stack. This prevents uninformative diagnostics for programs
+ like "DO 10", "IF (...) THEN", "10 ELSE", "END IF", "END". */
+
+static void
+ffestc_try_shriek_do_ ()
+{
+ ffelab lab;
+ ffelabType ty;
+
+ while ((ffestw_state (ffestw_stack_top ()) == FFESTV_stateDO)
+ && ((lab = (ffestw_label (ffestw_stack_top ()))) != NULL)
+ && (((ty = (ffelab_type (lab)))
+ == FFELAB_typeANY)
+ || (ty == FFELAB_typeUSELESS)
+ || (ty == FFELAB_typeFORMAT)
+ || (ty == FFELAB_typeNOTLOOP)
+ || (ty == FFELAB_typeENDIF)))
+ ffestc_shriek_do_ (FALSE);
+}
+
+/* ffestc_decl_start -- R426 or R501
+
+ ffestc_decl_start(...);
+
+ Verify that R426 component-def-stmt or R501 type-declaration-stmt are
+ valid here, figure out which one, and implement. */
+
+void
+ffestc_decl_start (ffestpType type, ffelexToken typet, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ case FFESTV_statePROGRAM0:
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_statePROGRAM1:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_statePROGRAM2:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateMODULE2:
+ case FFESTV_stateBLOCKDATA2:
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateBLOCKDATA3:
+ case FFESTV_stateUSE:
+ ffestc_local_.decl.is_R426 = 2;
+ break;
+
+ case FFESTV_stateTYPE:
+ case FFESTV_stateSTRUCTURE:
+ case FFESTV_stateMAP:
+ ffestc_local_.decl.is_R426 = 1;
+ break;
+
+ default:
+ ffestc_order_bad_ ();
+ ffestc_labeldef_useless_ ();
+ ffestc_local_.decl.is_R426 = 0;
+ return;
+ }
+
+ switch (ffestc_local_.decl.is_R426)
+ {
+#if FFESTR_F90
+ case 1:
+ ffestc_R426_start (type, typet, kind, kindt, len, lent);
+ break;
+#endif
+
+ case 2:
+ ffestc_R501_start (type, typet, kind, kindt, len, lent);
+ break;
+
+ default:
+ ffestc_labeldef_useless_ ();
+ break;
+ }
+}
+
+/* ffestc_decl_attrib -- R426 or R501 type attribute
+
+ ffestc_decl_attrib(...);
+
+ Verify that R426 component-def-stmt or R501 type-declaration-stmt attribute
+ is valid here and implement. */
+
+void
+ffestc_decl_attrib (ffestpAttrib attrib UNUSED,
+ ffelexToken attribt UNUSED,
+ ffestrOther intent_kw UNUSED,
+ ffesttDimList dims UNUSED)
+{
+#if FFESTR_F90
+ switch (ffestc_local_.decl.is_R426)
+ {
+ case 1:
+ ffestc_R426_attrib (attrib, attribt, intent_kw, dims);
+ break;
+
+ case 2:
+ ffestc_R501_attrib (attrib, attribt, intent_kw, dims);
+ break;
+
+ default:
+ break;
+ }
+#else
+ ffebad_start (FFEBAD_F90);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ return;
+#endif
+}
+
+/* ffestc_decl_item -- R426 or R501
+
+ ffestc_decl_item(...);
+
+ Establish type for a particular object. */
+
+void
+ffestc_decl_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+ ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
+ ffelexToken initt, bool clist)
+{
+ switch (ffestc_local_.decl.is_R426)
+ {
+#if FFESTR_F90
+ case 1:
+ ffestc_R426_item (name, kind, kindt, dims, len, lent, init, initt,
+ clist);
+ break;
+#endif
+
+ case 2:
+ ffestc_R501_item (name, kind, kindt, dims, len, lent, init, initt,
+ clist);
+ break;
+
+ default:
+ break;
+ }
+}
+
+/* ffestc_decl_itemstartvals -- R426 or R501 start list of values
+
+ ffestc_decl_itemstartvals();
+
+ Gonna specify values for the object now. */
+
+void
+ffestc_decl_itemstartvals ()
+{
+ switch (ffestc_local_.decl.is_R426)
+ {
+#if FFESTR_F90
+ case 1:
+ ffestc_R426_itemstartvals ();
+ break;
+#endif
+
+ case 2:
+ ffestc_R501_itemstartvals ();
+ break;
+
+ default:
+ break;
+ }
+}
+
+/* ffestc_decl_itemvalue -- R426 or R501 source value
+
+ ffestc_decl_itemvalue(repeat,repeat_token,value,value_token);
+
+ Make sure repeat and value are valid for the object being initialized. */
+
+void
+ffestc_decl_itemvalue (ffebld repeat, ffelexToken repeat_token,
+ ffebld value, ffelexToken value_token)
+{
+ switch (ffestc_local_.decl.is_R426)
+ {
+#if FFESTR_F90
+ case 1:
+ ffestc_R426_itemvalue (repeat, repeat_token, value, value_token);
+ break;
+#endif
+
+ case 2:
+ ffestc_R501_itemvalue (repeat, repeat_token, value, value_token);
+ break;
+
+ default:
+ break;
+ }
+}
+
+/* ffestc_decl_itemendvals -- R426 or R501 end list of values
+
+ ffelexToken t; // the SLASH token that ends the list.
+ ffestc_decl_itemendvals(t);
+
+ No more values, might specify more objects now. */
+
+void
+ffestc_decl_itemendvals (ffelexToken t)
+{
+ switch (ffestc_local_.decl.is_R426)
+ {
+#if FFESTR_F90
+ case 1:
+ ffestc_R426_itemendvals (t);
+ break;
+#endif
+
+ case 2:
+ ffestc_R501_itemendvals (t);
+ break;
+
+ default:
+ break;
+ }
+}
+
+/* ffestc_decl_finish -- R426 or R501
+
+ ffestc_decl_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_decl_finish ()
+{
+ switch (ffestc_local_.decl.is_R426)
+ {
+#if FFESTR_F90
+ case 1:
+ ffestc_R426_finish ();
+ break;
+#endif
+
+ case 2:
+ ffestc_R501_finish ();
+ break;
+
+ default:
+ break;
+ }
+}
+
+/* ffestc_elsewhere -- Generic ELSE WHERE statement
+
+ ffestc_end();
+
+ Decide whether ELSEWHERE or ELSE w/if-construct-name=="WHERE" is meant. */
+
+void
+ffestc_elsewhere (ffelexToken where)
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateIFTHEN:
+ ffestc_R805 (where);
+ break;
+
+ default:
+#if FFESTR_F90
+ ffestc_R744 ();
+#endif
+ break;
+ }
+}
+
+/* ffestc_end -- Generic END statement
+
+ ffestc_end();
+
+ Make sure a generic END is valid in the current context, and implement
+ it. */
+
+void
+ffestc_end ()
+{
+ ffestw b;
+
+ b = ffestw_stack_top ();
+
+recurse:
+
+ switch (ffestw_state (b))
+ {
+ case FFESTV_stateBLOCKDATA0:
+ case FFESTV_stateBLOCKDATA1:
+ case FFESTV_stateBLOCKDATA2:
+ case FFESTV_stateBLOCKDATA3:
+ case FFESTV_stateBLOCKDATA4:
+ case FFESTV_stateBLOCKDATA5:
+ ffestc_R1112 (NULL);
+ break;
+
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateFUNCTION4:
+ case FFESTV_stateFUNCTION5:
+ if ((ffestw_state (ffestw_previous (b)) != FFESTV_stateNIL)
+ && (ffestw_state (ffestw_previous (b)) != FFESTV_stateINTERFACE0))
+ {
+ ffebad_start (FFEBAD_END_WO);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_previous (b)), ffestw_col (ffestw_previous (b)));
+ ffebad_string ("FUNCTION");
+ ffebad_finish ();
+ }
+ ffestc_R1221 (NULL);
+ break;
+
+ case FFESTV_stateMODULE0:
+ case FFESTV_stateMODULE1:
+ case FFESTV_stateMODULE2:
+ case FFESTV_stateMODULE3:
+ case FFESTV_stateMODULE4:
+ case FFESTV_stateMODULE5:
+#if FFESTR_F90
+ ffestc_R1106 (NULL);
+#endif
+ break;
+
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateSUBROUTINE5:
+ if ((ffestw_state (ffestw_previous (b)) != FFESTV_stateNIL)
+ && (ffestw_state (ffestw_previous (b)) != FFESTV_stateINTERFACE0))
+ {
+ ffebad_start (FFEBAD_END_WO);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_previous (b)), ffestw_col (ffestw_previous (b)));
+ ffebad_string ("SUBROUTINE");
+ ffebad_finish ();
+ }
+ ffestc_R1225 (NULL);
+ break;
+
+ case FFESTV_stateUSE:
+ b = ffestw_previous (ffestw_stack_top ());
+ goto recurse; /* :::::::::::::::::::: */
+
+ default:
+ ffestc_R1103 (NULL);
+ break;
+ }
+}
+
+/* ffestc_eof -- Generic EOF
+
+ ffestc_eof();
+
+ Make sure we're at state NIL, or issue an error message and use each
+ block's shriek function to clean up to state NIL. */
+
+void
+ffestc_eof ()
+{
+ if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateNIL)
+ {
+ ffebad_start (FFEBAD_EOF_BEFORE_BLOCK_END);
+ ffebad_here (0, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ do
+ (*ffestw_shriek (ffestw_stack_top ()))(FALSE);
+ while (ffestw_state (ffestw_stack_top ()) != FFESTV_stateNIL);
+ }
+}
+
+/* ffestc_exec_transition -- Check if ok and move stmt state to executable
+
+ if (ffestc_exec_transition())
+ // Transition successful (kind of like a CONTINUE stmt was seen).
+
+ If the current statement state is a non-nested specification state in
+ which, say, a CONTINUE statement would be valid, then enter the state
+ we'd be in after seeing CONTINUE (without, of course, generating any
+ CONTINUE code), call ffestd_exec_begin, and return TRUE. Otherwise
+ return FALSE.
+
+ This function cannot be invoked once the first executable statement
+ is seen. This function may choose to always return TRUE by shrieking
+ away any interceding state stack entries to reach the base level of
+ specification state, but right now it doesn't, and it is (or should
+ be) purely an issue of how one wishes errors to be handled (for example,
+ an unrecognized statement in the middle of a STRUCTURE construct: after
+ the error message, should subsequent statements still be interpreted as
+ being within the construct, or should the construct be terminated upon
+ seeing the unrecognized statement? we do the former at the moment). */
+
+bool
+ffestc_exec_transition ()
+{
+ bool update;
+
+recurse:
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ ffestc_shriek_begin_program_ ();
+ goto recurse; /* :::::::::::::::::::: */
+
+ case FFESTV_statePROGRAM0:
+ case FFESTV_stateSUBROUTINE0:
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateBLOCKDATA0:
+ ffestw_state (ffestw_stack_top ()) += 4; /* To state UNIT4. */
+ update = TRUE;
+ break;
+
+ case FFESTV_statePROGRAM1:
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateBLOCKDATA1:
+ ffestw_state (ffestw_stack_top ()) += 3; /* To state UNIT4. */
+ update = TRUE;
+ break;
+
+ case FFESTV_statePROGRAM2:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateBLOCKDATA2:
+ ffestw_state (ffestw_stack_top ()) += 2; /* To state UNIT4. */
+ update = TRUE;
+ break;
+
+ case FFESTV_statePROGRAM3:
+ case FFESTV_stateSUBROUTINE3:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateBLOCKDATA3:
+ ffestw_state (ffestw_stack_top ()) += 1; /* To state UNIT4. */
+ update = TRUE;
+ break;
+
+ case FFESTV_stateUSE:
+#if FFESTR_F90
+ ffestc_shriek_end_uses_ (TRUE);
+#endif
+ goto recurse; /* :::::::::::::::::::: */
+
+ default:
+ return FALSE;
+ }
+
+ if (update)
+ ffestw_update (NULL); /* Update state line/col info. */
+
+ ffesta_seen_first_exec = TRUE;
+ ffestd_exec_begin ();
+
+ return TRUE;
+}
+
+/* ffestc_ffebad_here_doiter -- Calls ffebad_here with ptr to DO iter var
+
+ ffesymbol s;
+ // call ffebad_start first, of course.
+ ffestc_ffebad_here_doiter(0,s);
+ // call ffebad_finish afterwards, naturally.
+
+ Searches the stack of blocks backwards for a DO loop that has s
+ as its iteration variable, then calls ffebad_here with pointers to
+ that particular reference to the variable. Crashes if the DO loop
+ can't be found. */
+
+void
+ffestc_ffebad_here_doiter (ffebadIndex i, ffesymbol s)
+{
+ ffestw block;
+
+ for (block = ffestw_top_do (ffestw_stack_top ());
+ (block != NULL) && (ffestw_blocknum (block) != 0);
+ block = ffestw_top_do (ffestw_previous (block)))
+ {
+ if (ffestw_do_iter_var (block) == s)
+ {
+ ffebad_here (i, ffelex_token_where_line (ffestw_do_iter_var_t (block)),
+ ffelex_token_where_column (ffestw_do_iter_var_t (block)));
+ return;
+ }
+ }
+ assert ("no do block found" == NULL);
+}
+
+/* ffestc_is_decl_not_R1219 -- Context information for FFESTB
+
+ if (ffestc_is_decl_not_R1219()) ...
+
+ When a statement with the form "type[RECURSIVE]FUNCTIONname(name-list)"
+ is seen, call this function. It returns TRUE if the statement's context
+ is such that it is a declaration of an object named
+ "[RECURSIVE]FUNCTIONname" with an array-decl spec of "name-list", FALSE
+ if the statement's context is such that it begins the definition of a
+ function named "name" havin the dummy argument list "name-list" (this
+ is the R1219 function-stmt case). */
+
+bool
+ffestc_is_decl_not_R1219 ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateNIL:
+ case FFESTV_statePROGRAM5:
+ case FFESTV_stateSUBROUTINE5:
+ case FFESTV_stateFUNCTION5:
+ case FFESTV_stateMODULE5:
+ case FFESTV_stateINTERFACE0:
+ return FALSE;
+
+ default:
+ return TRUE;
+ }
+}
+
+/* ffestc_is_entry_in_subr -- Context information for FFESTB
+
+ if (ffestc_is_entry_in_subr()) ...
+
+ When a statement with the form "ENTRY name(name-list)"
+ is seen, call this function. It returns TRUE if the statement's context
+ is such that it may have "*", meaning alternate return, in place of
+ names in the name list (i.e. if the ENTRY is in a subroutine context).
+ It also returns TRUE if the ENTRY is not in a function context (invalid
+ but prevents extra complaints about "*", if present). It returns FALSE
+ if the ENTRY is in a function context. */
+
+bool
+ffestc_is_entry_in_subr ()
+{
+ ffestvState s;
+
+ s = ffestw_state (ffestw_stack_top ());
+
+recurse:
+
+ switch (s)
+ {
+ case FFESTV_stateFUNCTION0:
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ case FFESTV_stateFUNCTION4:
+ return FALSE;
+
+ case FFESTV_stateUSE:
+ s = ffestw_state (ffestw_previous (ffestw_stack_top ()));
+ goto recurse; /* :::::::::::::::::::: */
+
+ default:
+ return TRUE;
+ }
+}
+
+/* ffestc_is_let_not_V027 -- Context information for FFESTB
+
+ if (ffestc_is_let_not_V027()) ...
+
+ When a statement with the form "PARAMETERname=expr"
+ is seen, call this function. It returns TRUE if the statement's context
+ is such that it is an assignment to an object named "PARAMETERname", FALSE
+ if the statement's context is such that it is a V-extension PARAMETER
+ statement that is like a PARAMETER(name=expr) statement except that the
+ type of name is determined by the type of expr, not the implicit or
+ explicit typing of name. */
+
+bool
+ffestc_is_let_not_V027 ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ case FFESTV_stateWHERETHEN:
+ case FFESTV_stateIFTHEN:
+ case FFESTV_stateDO:
+ case FFESTV_stateSELECT0:
+ case FFESTV_stateSELECT1:
+ case FFESTV_stateWHERE:
+ case FFESTV_stateIF:
+ return TRUE;
+
+ default:
+ return FALSE;
+ }
+}
+
+/* ffestc_module -- MODULE or MODULE PROCEDURE statement
+
+ ffestc_module(module_name_token,procedure_name_token);
+
+ Decide which is intended, and implement it by calling _R1105_ or
+ _R1205_. */
+
+#if FFESTR_F90
+void
+ffestc_module (ffelexToken module, ffelexToken procedure)
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateINTERFACE0:
+ case FFESTV_stateINTERFACE1:
+ ffestc_R1205_start ();
+ ffestc_R1205_item (procedure);
+ ffestc_R1205_finish ();
+ break;
+
+ default:
+ ffestc_R1105 (module);
+ break;
+ }
+}
+
+#endif
+/* ffestc_private -- Generic PRIVATE statement
+
+ ffestc_end();
+
+ This is either a PRIVATE within R422 derived-type statement or an
+ R521 PRIVATE statement. Figure it out based on context and implement
+ it, or produce an error. */
+
+#if FFESTR_F90
+void
+ffestc_private ()
+{
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateTYPE:
+ ffestc_R423A ();
+ break;
+
+ default:
+ ffestc_R521B ();
+ break;
+ }
+}
+
+#endif
+/* ffestc_terminate_4 -- Terminate ffestc after scoping unit
+
+ ffestc_terminate_4();
+
+ For SUBROUTINEs/FUNCTIONs within INTERFACE/END INTERFACE, derived-TYPE-
+ defs, and statement function defs. */
+
+void
+ffestc_terminate_4 ()
+{
+ ffestc_entry_num_ = ffestc_saved_entry_num_;
+}
+
+/* ffestc_R423A -- PRIVATE statement (in R422 derived-type statement)
+
+ ffestc_R423A(); */
+
+#if FFESTR_F90
+void
+ffestc_R423A ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_type_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) != 0)
+ {
+ ffebad_start (FFEBAD_DERIVTYP_ACCESS_FIRST);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ return;
+ }
+
+ if (ffestw_state (ffestw_previous (ffestw_stack_top ())) != FFESTV_stateMODULE3)
+ {
+ ffebad_start (FFEBAD_DERIVTYP_ACCESS);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ return;
+ }
+
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Seen
+ private-sequence-stmt. */
+
+ ffestd_R423A ();
+}
+
+/* ffestc_R423B -- SEQUENCE statement (in R422 derived-type-stmt)
+
+ ffestc_R423B(); */
+
+void
+ffestc_R423B ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_type_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) != 0)
+ {
+ ffebad_start (FFEBAD_DERIVTYP_ACCESS_FIRST);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ return;
+ }
+
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Seen
+ private-sequence-stmt. */
+
+ ffestd_R423B ();
+}
+
+/* ffestc_R424 -- derived-TYPE-def statement
+
+ ffestc_R424(access_token,access_kw,name_token);
+
+ Handle a derived-type definition. */
+
+void
+ffestc_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name)
+{
+ ffestw b;
+
+ assert (name != NULL);
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_derivedtype_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if ((access != NULL)
+ && (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE3))
+ {
+ ffebad_start (FFEBAD_DERIVTYP_ACCESS);
+ ffebad_here (0, ffelex_token_where_line (access),
+ ffelex_token_where_column (access));
+ ffebad_finish ();
+ access = NULL;
+ }
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateTYPE);
+ ffestw_set_blocknum (b, 0);
+ ffestw_set_shriek (b, ffestc_shriek_type_);
+ ffestw_set_name (b, ffelex_token_use (name));
+ ffestw_set_substate (b, 0); /* Awaiting private-sequence-stmt and one
+ component-def-stmt. */
+
+ ffestd_R424 (access, access_kw, name);
+
+ ffe_init_4 ();
+}
+
+/* ffestc_R425 -- END TYPE statement
+
+ ffestc_R425(name_token);
+
+ Make sure ffestc_kind_ identifies a TYPE definition. If not
+ NULL, make sure name_token gives the correct name. Implement the end
+ of the type definition. */
+
+void
+ffestc_R425 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_type_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) != 2)
+ {
+ ffebad_start (FFEBAD_DERIVTYP_NO_COMPONENTS);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+
+ if ((name != NULL)
+ && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+ {
+ ffebad_start (FFEBAD_TYPE_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+
+ ffestc_shriek_type_ (TRUE);
+}
+
+/* ffestc_R426_start -- component-declaration-stmt
+
+ ffestc_R426_start(...);
+
+ Verify that R426 component-declaration-stmt is
+ valid here and implement. */
+
+void
+ffestc_R426_start (ffestpType type, ffelexToken typet, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_component_ () != FFESTC_orderOK_)
+ {
+ ffestc_local_.decl.is_R426 = 0;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateSTRUCTURE:
+ case FFESTV_stateMAP:
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Seen at least one
+ member. */
+ break;
+
+ case FFESTV_stateTYPE:
+ ffestw_set_substate (ffestw_stack_top (), 2);
+ break;
+
+ default:
+ assert ("Component parent state invalid" == NULL);
+ break;
+ }
+}
+
+/* ffestc_R426_attrib -- type attribute
+
+ ffestc_R426_attrib(...);
+
+ Verify that R426 component-declaration-stmt attribute
+ is valid here and implement. */
+
+void
+ffestc_R426_attrib (ffestpAttrib attrib, ffelexToken attribt,
+ ffestrOther intent_kw, ffesttDimList dims)
+{
+ ffestc_check_attrib_ ();
+}
+
+/* ffestc_R426_item -- declared object
+
+ ffestc_R426_item(...);
+
+ Establish type for a particular object. */
+
+void
+ffestc_R426_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+ ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
+ ffelexToken initt, bool clist)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ assert (ffelex_token_type (name) == FFELEX_typeNAME); /* Not NAMES. */
+ assert (kind == NULL); /* No way an expression should get here. */
+
+ if ((dims != NULL) || (init != NULL) || clist)
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+}
+
+/* ffestc_R426_itemstartvals -- Start list of values
+
+ ffestc_R426_itemstartvals();
+
+ Gonna specify values for the object now. */
+
+void
+ffestc_R426_itemstartvals ()
+{
+ ffestc_check_item_startvals_ ();
+}
+
+/* ffestc_R426_itemvalue -- Source value
+
+ ffestc_R426_itemvalue(repeat,repeat_token,value,value_token);
+
+ Make sure repeat and value are valid for the object being initialized. */
+
+void
+ffestc_R426_itemvalue (ffebld repeat, ffelexToken repeat_token,
+ ffebld value, ffelexToken value_token)
+{
+ ffestc_check_item_value_ ();
+}
+
+/* ffestc_R426_itemendvals -- End list of values
+
+ ffelexToken t; // the SLASH token that ends the list.
+ ffestc_R426_itemendvals(t);
+
+ No more values, might specify more objects now. */
+
+void
+ffestc_R426_itemendvals (ffelexToken t)
+{
+ ffestc_check_item_endvals_ ();
+}
+
+/* ffestc_R426_finish -- Done
+
+ ffestc_R426_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R426_finish ()
+{
+ ffestc_check_finish_ ();
+}
+
+#endif
+/* ffestc_R501_start -- type-declaration-stmt
+
+ ffestc_R501_start(...);
+
+ Verify that R501 type-declaration-stmt is
+ valid here and implement. */
+
+void
+ffestc_R501_start (ffestpType type, ffelexToken typet, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent)
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_typedecl_ () != FFESTC_orderOK_)
+ {
+ ffestc_local_.decl.is_R426 = 0;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestc_establish_declstmt_ (type, typet, kind, kindt, len, lent);
+}
+
+/* ffestc_R501_attrib -- type attribute
+
+ ffestc_R501_attrib(...);
+
+ Verify that R501 type-declaration-stmt attribute
+ is valid here and implement. */
+
+void
+ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt,
+ ffestrOther intent_kw UNUSED,
+ ffesttDimList dims UNUSED)
+{
+ ffestc_check_attrib_ ();
+
+ switch (attrib)
+ {
+#if FFESTR_F90
+ case FFESTP_attribALLOCATABLE:
+ break;
+#endif
+
+ case FFESTP_attribDIMENSION:
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ break;
+
+ case FFESTP_attribEXTERNAL:
+ break;
+
+#if FFESTR_F90
+ case FFESTP_attribINTENT:
+ break;
+#endif
+
+ case FFESTP_attribINTRINSIC:
+ break;
+
+#if FFESTR_F90
+ case FFESTP_attribOPTIONAL:
+ break;
+#endif
+
+ case FFESTP_attribPARAMETER:
+ break;
+
+#if FFESTR_F90
+ case FFESTP_attribPOINTER:
+ break;
+#endif
+
+#if FFESTR_F90
+ case FFESTP_attribPRIVATE:
+ break;
+
+ case FFESTP_attribPUBLIC:
+ break;
+#endif
+
+ case FFESTP_attribSAVE:
+ switch (ffestv_save_state_)
+ {
+ case FFESTV_savestateNONE:
+ ffestv_save_state_ = FFESTV_savestateSPECIFIC;
+ ffestv_save_line_
+ = ffewhere_line_use (ffelex_token_where_line (attribt));
+ ffestv_save_col_
+ = ffewhere_column_use (ffelex_token_where_column (attribt));
+ break;
+
+ case FFESTV_savestateSPECIFIC:
+ case FFESTV_savestateANY:
+ break;
+
+ case FFESTV_savestateALL:
+ if (ffe_is_pedantic ())
+ {
+ ffebad_start (FFEBAD_CONFLICTING_SAVES);
+ ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
+ ffebad_here (1, ffelex_token_where_line (attribt),
+ ffelex_token_where_column (attribt));
+ ffebad_finish ();
+ }
+ ffestv_save_state_ = FFESTV_savestateANY;
+ break;
+
+ default:
+ assert ("unexpected save state" == NULL);
+ break;
+ }
+ break;
+
+#if FFESTR_F90
+ case FFESTP_attribTARGET:
+ break;
+#endif
+
+ default:
+ assert ("unexpected attribute" == NULL);
+ break;
+ }
+}
+
+/* ffestc_R501_item -- declared object
+
+ ffestc_R501_item(...);
+
+ Establish type for a particular object. */
+
+void
+ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+ ffesttDimList dims, ffebld len, ffelexToken lent,
+ ffebld init, ffelexToken initt, bool clist)
+{
+ ffesymbol s;
+ ffesymbol sfn; /* FUNCTION symbol. */
+ ffebld array_size;
+ ffebld extents;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffestpDimtype nd;
+ bool is_init = (init != NULL) || clist;
+ bool is_assumed;
+ bool is_ugly_assumed;
+ ffeinfoRank rank;
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ assert (ffelex_token_type (name) == FFELEX_typeNAME); /* Not NAMES. */
+ assert (kind == NULL); /* No way an expression should get here. */
+
+ ffestc_establish_declinfo_ (kind, kindt, len, lent);
+
+ is_assumed = (ffestc_local_.decl.basic_type == FFEINFO_basictypeCHARACTER)
+ && (ffestc_local_.decl.size == FFETARGET_charactersizeNONE);
+
+ if ((dims != NULL) || is_init)
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ s = ffesymbol_declare_local (name, TRUE);
+ sa = ffesymbol_attrs (s);
+
+ /* First figure out what kind of object this is based solely on the current
+ object situation (type params, dimension list, and initialization). */
+
+ na = FFESYMBOL_attrsTYPE;
+
+ if (is_assumed)
+ na |= FFESYMBOL_attrsANYLEN;
+
+ is_ugly_assumed = (ffe_is_ugly_assumed ()
+ && ((sa & FFESYMBOL_attrsDUMMY)
+ || (ffesymbol_where (s) == FFEINFO_whereDUMMY)));
+
+ nd = ffestt_dimlist_type (dims, is_ugly_assumed);
+ switch (nd)
+ {
+ case FFESTP_dimtypeNONE:
+ break;
+
+ case FFESTP_dimtypeKNOWN:
+ na |= FFESYMBOL_attrsARRAY;
+ break;
+
+ case FFESTP_dimtypeADJUSTABLE:
+ na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE;
+ break;
+
+ case FFESTP_dimtypeASSUMED:
+ na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsANYSIZE;
+ break;
+
+ case FFESTP_dimtypeADJUSTABLEASSUMED:
+ na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYSIZE;
+ break;
+
+ default:
+ assert ("unexpected dimtype" == NULL);
+ na = FFESYMBOL_attrsetNONE;
+ break;
+ }
+
+ if (!ffesta_is_entry_valid
+ && (((na & (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsARRAY))
+ == (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsARRAY))))
+ na = FFESYMBOL_attrsetNONE;
+
+ if (is_init)
+ {
+ if (na == FFESYMBOL_attrsetNONE)
+ ;
+ else if (na & (FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYSIZE))
+ na = FFESYMBOL_attrsetNONE;
+ else
+ na |= FFESYMBOL_attrsINIT;
+ }
+
+ /* Now figure out what kind of object we've got based on previous
+ declarations of or references to the object. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ;
+ else if (!ffesymbol_is_specable (s)
+ && (((ffesymbol_where (s) != FFEINFO_whereCONSTANT)
+ && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC))
+ || (na & (FFESYMBOL_attrsARRAY | FFESYMBOL_attrsINIT))))
+ na = FFESYMBOL_attrsetNONE; /* Can't dcl sym ref'd in sfuncdef, and can't
+ dimension/init UNDERSTOODs. */
+ else if (sa & FFESYMBOL_attrsANY)
+ na = sa;
+ else if ((sa & na)
+ || ((sa & (FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsADJUSTS))
+ && (na & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsANYLEN)))
+ || ((sa & FFESYMBOL_attrsRESULT)
+ && (na & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsINIT)))
+ || ((sa & (FFESYMBOL_attrsSFUNC
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsINTRINSIC
+ | FFESYMBOL_attrsINIT))
+ && (na & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsINIT)))
+ || ((sa & FFESYMBOL_attrsARRAY)
+ && !ffesta_is_entry_valid
+ && (na & FFESYMBOL_attrsANYLEN))
+ || ((sa & (FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsDUMMY))
+ && (na & FFESYMBOL_attrsINIT))
+ || ((sa & (FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV))
+ && (na & (FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsANYSIZE))))
+ na = FFESYMBOL_attrsetNONE;
+ else if ((ffesymbol_kind (s) == FFEINFO_kindENTITY)
+ && (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+ && (na & FFESYMBOL_attrsANYLEN))
+ { /* If CHARACTER*(*) FOO after PARAMETER FOO. */
+ na |= FFESYMBOL_attrsTYPE;
+ ffestc_local_.decl.size = ffebld_size (ffesymbol_init (s));
+ }
+ else
+ na |= sa;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ {
+ ffesymbol_error (s, name);
+ ffestc_parent_ok_ = FALSE;
+ }
+ else if (na & FFESYMBOL_attrsANY)
+ ffestc_parent_ok_ = FALSE;
+ else
+ {
+ ffesymbol_set_attrs (s, na);
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ rank = ffesymbol_rank (s);
+ if (dims != NULL)
+ {
+ ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
+ &array_size,
+ &extents,
+ is_ugly_assumed));
+ ffesymbol_set_arraysize (s, array_size);
+ ffesymbol_set_extents (s, extents);
+ if (!(0 && ffe_is_90 ())
+ && (ffebld_op (array_size) == FFEBLD_opCONTER)
+ && (ffebld_constant_integerdefault (ffebld_conter (array_size))
+ == 0))
+ {
+ ffebad_start (FFEBAD_ZERO_ARRAY);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_finish ();
+ }
+ }
+ if (init != NULL)
+ {
+ ffesymbol_set_init (s,
+ ffeexpr_convert (init, initt, name,
+ ffestc_local_.decl.basic_type,
+ ffestc_local_.decl.kind_type,
+ rank,
+ ffestc_local_.decl.size,
+ FFEEXPR_contextDATA));
+ ffecom_notify_init_symbol (s);
+ ffesymbol_update_init (s);
+#if FFEGLOBAL_ENABLED
+ if (ffesymbol_common (s) != NULL)
+ ffeglobal_init_common (ffesymbol_common (s), initt);
+#endif
+ }
+ else if (clist)
+ {
+ ffebld symter;
+
+ symter = ffebld_new_symter (s, FFEINTRIN_genNONE,
+ FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE);
+
+ ffebld_set_info (symter,
+ ffeinfo_new (ffestc_local_.decl.basic_type,
+ ffestc_local_.decl.kind_type,
+ rank,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ ffestc_local_.decl.size));
+ ffestc_local_.decl.initlist = ffebld_new_item (symter, NULL);
+ }
+ if (ffesymbol_basictype (s) == FFEINFO_basictypeNONE)
+ {
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffestc_local_.decl.basic_type,
+ ffestc_local_.decl.kind_type,
+ rank,
+ ffesymbol_kind (s),
+ ffesymbol_where (s),
+ ffestc_local_.decl.size));
+ if ((na & FFESYMBOL_attrsRESULT)
+ && ((sfn = ffesymbol_funcresult (s)) != NULL))
+ {
+ ffesymbol_set_info (sfn,
+ ffeinfo_new (ffestc_local_.decl.basic_type,
+ ffestc_local_.decl.kind_type,
+ rank,
+ ffesymbol_kind (sfn),
+ ffesymbol_where (sfn),
+ ffestc_local_.decl.size));
+ ffesymbol_signal_unreported (sfn);
+ }
+ }
+ else if ((ffestc_local_.decl.basic_type != ffesymbol_basictype (s))
+ || (ffestc_local_.decl.kind_type != ffesymbol_kindtype (s))
+ || ((ffestc_local_.decl.basic_type
+ == FFEINFO_basictypeCHARACTER)
+ && (ffestc_local_.decl.size != ffesymbol_size (s))))
+ { /* Explicit type disagrees with established
+ implicit type. */
+ ffesymbol_error (s, name);
+ }
+
+ if ((na & FFESYMBOL_attrsADJUSTS)
+ && ((ffestc_local_.decl.basic_type != FFEINFO_basictypeINTEGER)
+ || (ffestc_local_.decl.kind_type != FFEINFO_kindtypeINTEGER1)))
+ ffesymbol_error (s, name);
+
+ ffesymbol_signal_unreported (s);
+ ffestc_parent_ok_ = TRUE;
+ }
+}
+
+/* ffestc_R501_itemstartvals -- Start list of values
+
+ ffestc_R501_itemstartvals();
+
+ Gonna specify values for the object now. */
+
+void
+ffestc_R501_itemstartvals ()
+{
+ ffestc_check_item_startvals_ ();
+
+ if (ffestc_parent_ok_)
+ ffedata_begin (ffestc_local_.decl.initlist);
+}
+
+/* ffestc_R501_itemvalue -- Source value
+
+ ffestc_R501_itemvalue(repeat,repeat_token,value,value_token);
+
+ Make sure repeat and value are valid for the object being initialized. */
+
+void
+ffestc_R501_itemvalue (ffebld repeat, ffelexToken repeat_token,
+ ffebld value, ffelexToken value_token)
+{
+ ffetargetIntegerDefault rpt;
+
+ ffestc_check_item_value_ ();
+
+ if (!ffestc_parent_ok_)
+ return;
+
+ if (repeat == NULL)
+ rpt = 1;
+ else if (ffebld_op (repeat) == FFEBLD_opCONTER)
+ rpt = ffebld_constant_integerdefault (ffebld_conter (repeat));
+ else
+ {
+ ffestc_parent_ok_ = FALSE;
+ ffedata_end (TRUE, NULL);
+ return;
+ }
+
+ if (!(ffestc_parent_ok_ = ffedata_value (rpt, value,
+ (repeat_token == NULL) ? value_token : repeat_token)))
+ ffedata_end (TRUE, NULL);
+}
+
+/* ffestc_R501_itemendvals -- End list of values
+
+ ffelexToken t; // the SLASH token that ends the list.
+ ffestc_R501_itemendvals(t);
+
+ No more values, might specify more objects now. */
+
+void
+ffestc_R501_itemendvals (ffelexToken t)
+{
+ ffestc_check_item_endvals_ ();
+
+ if (ffestc_parent_ok_)
+ ffestc_parent_ok_ = ffedata_end (FALSE, t);
+
+ if (ffestc_parent_ok_)
+ ffesymbol_signal_unreported (ffebld_symter (ffebld_head
+ (ffestc_local_.decl.initlist)));
+}
+
+/* ffestc_R501_finish -- Done
+
+ ffestc_R501_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R501_finish ()
+{
+ ffestc_check_finish_ ();
+}
+
+/* ffestc_R519_start -- INTENT statement list begin
+
+ ffestc_R519_start();
+
+ Verify that INTENT is valid here, and begin accepting items in the list. */
+
+#if FFESTR_F90
+void
+ffestc_R519_start (ffelexToken intent, ffestrOther intent_kw)
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_spec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R519_start (intent_kw);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R519_item -- INTENT statement for name
+
+ ffestc_R519_item(name_token);
+
+ Make sure name_token identifies a valid object to be INTENTed. */
+
+void
+ffestc_R519_item (ffelexToken name)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R519_item (name);
+}
+
+/* ffestc_R519_finish -- INTENT statement list complete
+
+ ffestc_R519_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R519_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R519_finish ();
+}
+
+/* ffestc_R520_start -- OPTIONAL statement list begin
+
+ ffestc_R520_start();
+
+ Verify that OPTIONAL is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R520_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_spec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R520_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R520_item -- OPTIONAL statement for name
+
+ ffestc_R520_item(name_token);
+
+ Make sure name_token identifies a valid object to be OPTIONALed. */
+
+void
+ffestc_R520_item (ffelexToken name)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R520_item (name);
+}
+
+/* ffestc_R520_finish -- OPTIONAL statement list complete
+
+ ffestc_R520_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R520_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R520_finish ();
+}
+
+/* ffestc_R521A -- PUBLIC statement
+
+ ffestc_R521A();
+
+ Verify that PUBLIC is valid here. */
+
+void
+ffestc_R521A ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_access_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ switch (ffestv_access_state_)
+ {
+ case FFESTV_accessstateNONE:
+ ffestv_access_state_ = FFESTV_accessstatePUBLIC;
+ ffestv_access_line_
+ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+ ffestv_access_col_
+ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+ break;
+
+ case FFESTV_accessstateANY:
+ break;
+
+ case FFESTV_accessstatePUBLIC:
+ case FFESTV_accessstatePRIVATE:
+ ffebad_start (FFEBAD_CONFLICTING_ACCESSES);
+ ffebad_here (0, ffestv_access_line_, ffestv_access_col_);
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ ffestv_access_state_ = FFESTV_accessstateANY;
+ break;
+
+ default:
+ assert ("unexpected access state" == NULL);
+ break;
+ }
+
+ ffestd_R521A ();
+}
+
+/* ffestc_R521Astart -- PUBLIC statement list begin
+
+ ffestc_R521Astart();
+
+ Verify that PUBLIC is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R521Astart ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_access_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R521Astart ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R521Aitem -- PUBLIC statement for name
+
+ ffestc_R521Aitem(name_token);
+
+ Make sure name_token identifies a valid object to be PUBLICed. */
+
+void
+ffestc_R521Aitem (ffelexToken name)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R521Aitem (name);
+}
+
+/* ffestc_R521Afinish -- PUBLIC statement list complete
+
+ ffestc_R521Afinish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R521Afinish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R521Afinish ();
+}
+
+/* ffestc_R521B -- PRIVATE statement
+
+ ffestc_R521B();
+
+ Verify that PRIVATE is valid here (outside a derived-type statement). */
+
+void
+ffestc_R521B ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_access_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ switch (ffestv_access_state_)
+ {
+ case FFESTV_accessstateNONE:
+ ffestv_access_state_ = FFESTV_accessstatePRIVATE;
+ ffestv_access_line_
+ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+ ffestv_access_col_
+ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+ break;
+
+ case FFESTV_accessstateANY:
+ break;
+
+ case FFESTV_accessstatePUBLIC:
+ case FFESTV_accessstatePRIVATE:
+ ffebad_start (FFEBAD_CONFLICTING_ACCESSES);
+ ffebad_here (0, ffestv_access_line_, ffestv_access_col_);
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ ffestv_access_state_ = FFESTV_accessstateANY;
+ break;
+
+ default:
+ assert ("unexpected access state" == NULL);
+ break;
+ }
+
+ ffestd_R521B ();
+}
+
+/* ffestc_R521Bstart -- PRIVATE statement list begin
+
+ ffestc_R521Bstart();
+
+ Verify that PRIVATE is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R521Bstart ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_access_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R521Bstart ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R521Bitem -- PRIVATE statement for name
+
+ ffestc_R521Bitem(name_token);
+
+ Make sure name_token identifies a valid object to be PRIVATEed. */
+
+void
+ffestc_R521Bitem (ffelexToken name)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R521Bitem (name);
+}
+
+/* ffestc_R521Bfinish -- PRIVATE statement list complete
+
+ ffestc_R521Bfinish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R521Bfinish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R521Bfinish ();
+}
+
+#endif
+/* ffestc_R522 -- SAVE statement with no list
+
+ ffestc_R522();
+
+ Verify that SAVE is valid here, and flag everything as SAVEd. */
+
+void
+ffestc_R522 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ switch (ffestv_save_state_)
+ {
+ case FFESTV_savestateNONE:
+ ffestv_save_state_ = FFESTV_savestateALL;
+ ffestv_save_line_
+ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+ ffestv_save_col_
+ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+ break;
+
+ case FFESTV_savestateANY:
+ break;
+
+ case FFESTV_savestateSPECIFIC:
+ case FFESTV_savestateALL:
+ if (ffe_is_pedantic ())
+ {
+ ffebad_start (FFEBAD_CONFLICTING_SAVES);
+ ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+ ffestv_save_state_ = FFESTV_savestateALL;
+ break;
+
+ default:
+ assert ("unexpected save state" == NULL);
+ break;
+ }
+
+ ffe_set_is_saveall (TRUE);
+
+ ffestd_R522 ();
+}
+
+/* ffestc_R522start -- SAVE statement list begin
+
+ ffestc_R522start();
+
+ Verify that SAVE is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R522start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ switch (ffestv_save_state_)
+ {
+ case FFESTV_savestateNONE:
+ ffestv_save_state_ = FFESTV_savestateSPECIFIC;
+ ffestv_save_line_
+ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+ ffestv_save_col_
+ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+ break;
+
+ case FFESTV_savestateSPECIFIC:
+ case FFESTV_savestateANY:
+ break;
+
+ case FFESTV_savestateALL:
+ if (ffe_is_pedantic ())
+ {
+ ffebad_start (FFEBAD_CONFLICTING_SAVES);
+ ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
+ ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+ ffestv_save_state_ = FFESTV_savestateANY;
+ break;
+
+ default:
+ assert ("unexpected save state" == NULL);
+ break;
+ }
+
+ ffestd_R522start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R522item_object -- SAVE statement for object-name
+
+ ffestc_R522item_object(name_token);
+
+ Make sure name_token identifies a valid object to be SAVEd. */
+
+void
+ffestc_R522item_object (ffelexToken name)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ s = ffesymbol_declare_local (name, FALSE);
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!ffesymbol_is_specable (s)
+ && ((ffesymbol_kind (s) != FFEINFO_kindENTITY)
+ || (ffesymbol_where (s) != FFEINFO_whereLOCAL)))
+ na = FFESYMBOL_attrsetNONE; /* Can't dcl sym ref'd in sfuncdef. */
+ else if (sa & FFESYMBOL_attrsANY)
+ na = sa;
+ else if (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsSAVE;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, name);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_update_save (s);
+ ffesymbol_signal_unreported (s);
+ }
+
+ ffestd_R522item_object (name);
+}
+
+/* ffestc_R522item_cblock -- SAVE statement for common-block-name
+
+ ffestc_R522item_cblock(name_token);
+
+ Make sure name_token identifies a valid common block to be SAVEd. */
+
+void
+ffestc_R522item_cblock (ffelexToken name)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ s = ffesymbol_declare_cblock (name, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!ffesymbol_is_specable (s))
+ na = FFESYMBOL_attrsetNONE;
+ else if (sa & FFESYMBOL_attrsANY)
+ na = sa; /* Already have an error here, say nothing. */
+ else if (!(sa & ~(FFESYMBOL_attrsCBLOCK)))
+ na = sa | FFESYMBOL_attrsSAVECBLOCK;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, (name == NULL) ? ffesta_tokens[0] : name);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_update_save (s);
+ ffesymbol_signal_unreported (s);
+ }
+
+ ffestd_R522item_cblock (name);
+}
+
+/* ffestc_R522finish -- SAVE statement list complete
+
+ ffestc_R522finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R522finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R522finish ();
+}
+
+/* ffestc_R524_start -- DIMENSION statement list begin
+
+ ffestc_R524_start(bool virtual);
+
+ Verify that DIMENSION is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R524_start (bool virtual)
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R524_start (virtual);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R524_item -- DIMENSION statement for object-name
+
+ ffestc_R524_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be DIMENSIONd. */
+
+void
+ffestc_R524_item (ffelexToken name, ffesttDimList dims)
+{
+ ffesymbol s;
+ ffebld array_size;
+ ffebld extents;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffestpDimtype nd;
+ ffeinfoRank rank;
+ bool is_ugly_assumed;
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ assert (dims != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ s = ffesymbol_declare_local (name, FALSE);
+ sa = ffesymbol_attrs (s);
+
+ /* First figure out what kind of object this is based solely on the current
+ object situation (dimension list). */
+
+ is_ugly_assumed = (ffe_is_ugly_assumed ()
+ && ((sa & FFESYMBOL_attrsDUMMY)
+ || (ffesymbol_where (s) == FFEINFO_whereDUMMY)));
+
+ nd = ffestt_dimlist_type (dims, is_ugly_assumed);
+ switch (nd)
+ {
+ case FFESTP_dimtypeKNOWN:
+ na = FFESYMBOL_attrsARRAY;
+ break;
+
+ case FFESTP_dimtypeADJUSTABLE:
+ na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE;
+ break;
+
+ case FFESTP_dimtypeASSUMED:
+ na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsANYSIZE;
+ break;
+
+ case FFESTP_dimtypeADJUSTABLEASSUMED:
+ na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYSIZE;
+ break;
+
+ default:
+ assert ("Unexpected dims type" == NULL);
+ na = FFESYMBOL_attrsetNONE;
+ break;
+ }
+
+ /* Now figure out what kind of object we've got based on previous
+ declarations of or references to the object. */
+
+ if (!ffesymbol_is_specable (s))
+ na = FFESYMBOL_attrsetNONE; /* Can't dcl sym ref'd in sfuncdef. */
+ else if (sa & FFESYMBOL_attrsANY)
+ na = FFESYMBOL_attrsANY;
+ else if (!ffesta_is_entry_valid
+ && (sa & FFESYMBOL_attrsANYLEN))
+ na = FFESYMBOL_attrsetNONE;
+ else if ((sa & FFESYMBOL_attrsARRAY)
+ || ((sa & (FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE))
+ && (na & (FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYSIZE))))
+ na = FFESYMBOL_attrsetNONE;
+ else if (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsTYPE)))
+ na |= sa;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, name);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
+ &array_size,
+ &extents,
+ is_ugly_assumed));
+ ffesymbol_set_arraysize (s, array_size);
+ ffesymbol_set_extents (s, extents);
+ if (!(0 && ffe_is_90 ())
+ && (ffebld_op (array_size) == FFEBLD_opCONTER)
+ && (ffebld_constant_integerdefault (ffebld_conter (array_size))
+ == 0))
+ {
+ ffebad_start (FFEBAD_ZERO_ARRAY);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_finish ();
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ rank,
+ ffesymbol_kind (s),
+ ffesymbol_where (s),
+ ffesymbol_size (s)));
+ }
+
+ ffesymbol_signal_unreported (s);
+
+ ffestd_R524_item (name, dims);
+}
+
+/* ffestc_R524_finish -- DIMENSION statement list complete
+
+ ffestc_R524_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R524_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R524_finish ();
+}
+
+/* ffestc_R525_start -- ALLOCATABLE statement list begin
+
+ ffestc_R525_start();
+
+ Verify that ALLOCATABLE is valid here, and begin accepting items in the
+ list. */
+
+#if FFESTR_F90
+void
+ffestc_R525_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R525_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R525_item -- ALLOCATABLE statement for object-name
+
+ ffestc_R525_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be ALLOCATABLEd. */
+
+void
+ffestc_R525_item (ffelexToken name, ffesttDimList dims)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ ffestd_R525_item (name, dims);
+}
+
+/* ffestc_R525_finish -- ALLOCATABLE statement list complete
+
+ ffestc_R525_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R525_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R525_finish ();
+}
+
+/* ffestc_R526_start -- POINTER statement list begin
+
+ ffestc_R526_start();
+
+ Verify that POINTER is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R526_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R526_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R526_item -- POINTER statement for object-name
+
+ ffestc_R526_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be POINTERd. */
+
+void
+ffestc_R526_item (ffelexToken name, ffesttDimList dims)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ ffestd_R526_item (name, dims);
+}
+
+/* ffestc_R526_finish -- POINTER statement list complete
+
+ ffestc_R526_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R526_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R526_finish ();
+}
+
+/* ffestc_R527_start -- TARGET statement list begin
+
+ ffestc_R527_start();
+
+ Verify that TARGET is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R527_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R527_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R527_item -- TARGET statement for object-name
+
+ ffestc_R527_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be TARGETd. */
+
+void
+ffestc_R527_item (ffelexToken name, ffesttDimList dims)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ ffestd_R527_item (name, dims);
+}
+
+/* ffestc_R527_finish -- TARGET statement list complete
+
+ ffestc_R527_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R527_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R527_finish ();
+}
+
+#endif
+/* ffestc_R528_start -- DATA statement list begin
+
+ ffestc_R528_start();
+
+ Verify that DATA is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R528_start ()
+{
+ ffestcOrder_ order;
+
+ ffestc_check_start_ ();
+ if (ffe_is_pedantic_not_90 ())
+ order = ffestc_order_data77_ ();
+ else
+ order = ffestc_order_data_ ();
+ if (order != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+#if 1
+ ffestc_local_.data.objlist = NULL;
+#else
+ ffestd_R528_start_ ();
+#endif
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R528_item_object -- DATA statement target object
+
+ ffestc_R528_item_object(object,object_token);
+
+ Make sure object is valid to be DATAd. */
+
+void
+ffestc_R528_item_object (ffebld expr, ffelexToken expr_token UNUSED)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+#if 1
+ if (ffestc_local_.data.objlist == NULL)
+ ffebld_init_list (&ffestc_local_.data.objlist,
+ &ffestc_local_.data.list_bottom);
+
+ ffebld_append_item (&ffestc_local_.data.list_bottom, expr);
+#else
+ ffestd_R528_item_object_ (expr, expr_token);
+#endif
+}
+
+/* ffestc_R528_item_startvals -- DATA statement start list of values
+
+ ffestc_R528_item_startvals();
+
+ No more objects, gonna specify values for the list of objects now. */
+
+void
+ffestc_R528_item_startvals ()
+{
+ ffestc_check_item_startvals_ ();
+ if (!ffestc_ok_)
+ return;
+
+#if 1
+ assert (ffestc_local_.data.objlist != NULL);
+ ffebld_end_list (&ffestc_local_.data.list_bottom);
+ ffedata_begin (ffestc_local_.data.objlist);
+#else
+ ffestd_R528_item_startvals_ ();
+#endif
+}
+
+/* ffestc_R528_item_value -- DATA statement source value
+
+ ffestc_R528_item_value(repeat,repeat_token,value,value_token);
+
+ Make sure repeat and value are valid for the objects being initialized. */
+
+void
+ffestc_R528_item_value (ffebld repeat, ffelexToken repeat_token,
+ ffebld value, ffelexToken value_token)
+{
+ ffetargetIntegerDefault rpt;
+
+ ffestc_check_item_value_ ();
+ if (!ffestc_ok_)
+ return;
+
+#if 1
+ if (repeat == NULL)
+ rpt = 1;
+ else if (ffebld_op (repeat) == FFEBLD_opCONTER)
+ rpt = ffebld_constant_integerdefault (ffebld_conter (repeat));
+ else
+ {
+ ffestc_ok_ = FALSE;
+ ffedata_end (TRUE, NULL);
+ return;
+ }
+
+ if (!(ffestc_ok_ = ffedata_value (rpt, value,
+ (repeat_token == NULL)
+ ? value_token
+ : repeat_token)))
+ ffedata_end (TRUE, NULL);
+
+#else
+ ffestd_R528_item_value_ (repeat, value);
+#endif
+}
+
+/* ffestc_R528_item_endvals -- DATA statement start list of values
+
+ ffelexToken t; // the SLASH token that ends the list.
+ ffestc_R528_item_endvals(t);
+
+ No more values, might specify more objects now. */
+
+void
+ffestc_R528_item_endvals (ffelexToken t)
+{
+ ffestc_check_item_endvals_ ();
+ if (!ffestc_ok_)
+ return;
+
+#if 1
+ ffedata_end (!ffestc_ok_, t);
+ ffestc_local_.data.objlist = NULL;
+#else
+ ffestd_R528_item_endvals_ (t);
+#endif
+}
+
+/* ffestc_R528_finish -- DATA statement list complete
+
+ ffestc_R528_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R528_finish ()
+{
+ ffestc_check_finish_ ();
+
+#if 1
+#else
+ ffestd_R528_finish_ ();
+#endif
+}
+
+/* ffestc_R537_start -- PARAMETER statement list begin
+
+ ffestc_R537_start();
+
+ Verify that PARAMETER is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R537_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_parameter_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ ffestd_R537_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R537_item -- PARAMETER statement assignment
+
+ ffestc_R537_item(dest,dest_token,source,source_token);
+
+ Make sure the source is a valid source for the destination; make the
+ assignment. */
+
+void
+ffestc_R537_item (ffebld dest, ffelexToken dest_token, ffebld source,
+ ffelexToken source_token)
+{
+ ffesymbol s;
+
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if ((ffebld_op (dest) == FFEBLD_opANY)
+ || (ffebld_op (source) == FFEBLD_opANY))
+ {
+ if (ffebld_op (dest) == FFEBLD_opSYMTER)
+ {
+ s = ffebld_symter (dest);
+ ffesymbol_set_init (s, ffebld_new_any ());
+ ffebld_set_info (ffesymbol_init (s), ffeinfo_new_any ());
+ ffesymbol_signal_unreported (s);
+ }
+ ffestd_R537_item (dest, source);
+ return;
+ }
+
+ assert (ffebld_op (dest) == FFEBLD_opSYMTER);
+ assert (ffebld_op (source) == FFEBLD_opCONTER);
+
+ s = ffebld_symter (dest);
+ if ((ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+ && (ffesymbol_size (s) == FFETARGET_charactersizeNONE))
+ { /* Destination has explicit/implicit
+ CHARACTER*(*) type; set length. */
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ 0,
+ ffesymbol_kind (s),
+ ffesymbol_where (s),
+ ffebld_size (source)));
+ ffebld_set_info (dest, ffeinfo_use (ffesymbol_info (s)));
+ }
+
+ source = ffeexpr_convert_expr (source, source_token, dest, dest_token,
+ FFEEXPR_contextDATA);
+
+ ffesymbol_set_init (s, source);
+
+ ffesymbol_signal_unreported (s);
+
+ ffestd_R537_item (dest, source);
+}
+
+/* ffestc_R537_finish -- PARAMETER statement list complete
+
+ ffestc_R537_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R537_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R537_finish ();
+}
+
+/* ffestc_R539 -- IMPLICIT NONE statement
+
+ ffestc_R539();
+
+ Verify that the IMPLICIT NONE statement is ok here and implement. */
+
+void
+ffestc_R539 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_implicitnone_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffeimplic_none ();
+
+ ffestd_R539 ();
+}
+
+/* ffestc_R539start -- IMPLICIT statement
+
+ ffestc_R539start();
+
+ Verify that the IMPLICIT statement is ok here and implement. */
+
+void
+ffestc_R539start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_implicit_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R539start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R539item -- IMPLICIT statement specification (R540)
+
+ ffestc_R539item(...);
+
+ Verify that the type and letter list are all ok and implement. */
+
+void
+ffestc_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
+ ffebld len, ffelexToken lent, ffesttImpList letters)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if ((type == FFESTP_typeCHARACTER) && (len != NULL)
+ && (ffebld_op (len) == FFEBLD_opSTAR))
+ { /* Complain and pretend they're CHARACTER
+ [*1]. */
+ ffebad_start (FFEBAD_IMPLICIT_ADJLEN);
+ ffebad_here (0, ffelex_token_where_line (lent),
+ ffelex_token_where_column (lent));
+ ffebad_finish ();
+ len = NULL;
+ lent = NULL;
+ }
+ ffestc_establish_declstmt_ (type, ffesta_tokens[0], kind, kindt, len, lent);
+ ffestc_establish_declinfo_ (NULL, NULL, NULL, NULL);
+
+ ffestt_implist_drive (letters, ffestc_establish_impletter_);
+
+ ffestd_R539item (type, kind, kindt, len, lent, letters);
+}
+
+/* ffestc_R539finish -- IMPLICIT statement
+
+ ffestc_R539finish();
+
+ Finish up any local activities. */
+
+void
+ffestc_R539finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R539finish ();
+}
+
+/* ffestc_R542_start -- NAMELIST statement list begin
+
+ ffestc_R542_start();
+
+ Verify that NAMELIST is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R542_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ if (ffe_is_f2c_library ()
+ && (ffe_case_source () == FFE_caseNONE))
+ {
+ ffebad_start (FFEBAD_NAMELIST_CASE);
+ ffesta_ffebad_here_current_stmt (0);
+ ffebad_finish ();
+ }
+
+ ffestd_R542_start ();
+
+ ffestc_local_.namelist.symbol = NULL;
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R542_item_nlist -- NAMELIST statement for group-name
+
+ ffestc_R542_item_nlist(groupname_token);
+
+ Make sure name_token identifies a valid object to be NAMELISTd. */
+
+void
+ffestc_R542_item_nlist (ffelexToken name)
+{
+ ffesymbol s;
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_local_.namelist.symbol != NULL)
+ ffesymbol_signal_unreported (ffestc_local_.namelist.symbol);
+
+ s = ffesymbol_declare_local (name, FALSE);
+
+ if ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ || ((ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ && (ffesymbol_kind (s) == FFEINFO_kindNAMELIST)))
+ {
+ ffestc_parent_ok_ = TRUE;
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffebld_init_list (ffesymbol_ptr_to_namelist (s),
+ ffesymbol_ptr_to_listbottom (s));
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindNAMELIST,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ }
+ }
+ else
+ {
+ if (ffesymbol_kind (s) != FFEINFO_kindANY)
+ ffesymbol_error (s, name);
+ ffestc_parent_ok_ = FALSE;
+ }
+
+ ffestc_local_.namelist.symbol = s;
+
+ ffestd_R542_item_nlist (name);
+}
+
+/* ffestc_R542_item_nitem -- NAMELIST statement for variable-name
+
+ ffestc_R542_item_nitem(name_token);
+
+ Make sure name_token identifies a valid object to be NAMELISTd. */
+
+void
+ffestc_R542_item_nitem (ffelexToken name)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffebld e;
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ s = ffesymbol_declare_local (name, FALSE);
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!ffesymbol_is_specable (s)
+ && ((ffesymbol_kind (s) != FFEINFO_kindENTITY)
+ || ((ffesymbol_where (s) != FFEINFO_whereLOCAL)
+ && (ffesymbol_where (s) != FFEINFO_whereCOMMON))))
+ na = FFESYMBOL_attrsetNONE;
+ else if (sa & FFESYMBOL_attrsANY)
+ na = FFESYMBOL_attrsANY;
+ else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsNAMELIST;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, name);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_set_namelisted (s, TRUE);
+ ffesymbol_signal_unreported (s);
+#if 0 /* No need to establish type yet! */
+ if (!ffeimplic_establish_symbol (s))
+ ffesymbol_error (s, name);
+#endif
+ }
+
+ if (ffestc_parent_ok_)
+ {
+ e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE);
+ ffebld_set_info (e,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE, 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ FFETARGET_charactersizeNONE));
+ ffebld_append_item
+ (ffesymbol_ptr_to_listbottom (ffestc_local_.namelist.symbol), e);
+ }
+
+ ffestd_R542_item_nitem (name);
+}
+
+/* ffestc_R542_finish -- NAMELIST statement list complete
+
+ ffestc_R542_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R542_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffesymbol_signal_unreported (ffestc_local_.namelist.symbol);
+
+ ffestd_R542_finish ();
+}
+
+/* ffestc_R544_start -- EQUIVALENCE statement list begin
+
+ ffestc_R544_start();
+
+ Verify that EQUIVALENCE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R544_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R544_item -- EQUIVALENCE statement assignment
+
+ ffestc_R544_item(exprlist);
+
+ Make sure the equivalence is valid, then implement it. */
+
+void
+ffestc_R544_item (ffesttExprList exprlist)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ /* First we go through the list and come up with one ffeequiv object that
+ will describe all items in the list. When an ffeequiv object is first
+ found, it is used (else we create one as a "local equiv" for the time
+ being). If subsequent ffeequiv objects are found, they are merged with
+ the first so we end up with one. However, if more than one COMMON
+ variable is involved, then an error condition occurs. */
+
+ ffestc_local_.equiv.ok = TRUE;
+ ffestc_local_.equiv.t = NULL; /* No token yet. */
+ ffestc_local_.equiv.eq = NULL;/* No equiv yet. */
+ ffestc_local_.equiv.save = FALSE; /* No SAVEd variables yet. */
+
+ ffebld_init_list (&ffestc_local_.equiv.list, &ffestc_local_.equiv.bottom);
+ ffestt_exprlist_drive (exprlist, ffestc_R544_equiv_); /* Get one equiv. */
+ ffebld_end_list (&ffestc_local_.equiv.bottom);
+
+ if (!ffestc_local_.equiv.ok)
+ return; /* Something went wrong, stop bothering with
+ this stuff. */
+
+ if (ffestc_local_.equiv.eq == NULL)
+ ffestc_local_.equiv.eq = ffeequiv_new (); /* Make local equivalence. */
+
+ /* Append this list of equivalences to list of such lists for this
+ equivalence. */
+
+ ffeequiv_add (ffestc_local_.equiv.eq, ffestc_local_.equiv.list,
+ ffestc_local_.equiv.t);
+ if (ffestc_local_.equiv.save)
+ ffeequiv_update_save (ffestc_local_.equiv.eq);
+}
+
+/* ffestc_R544_equiv_ -- EQUIVALENCE statement handler for item in list
+
+ ffebld expr;
+ ffelexToken t;
+ ffestc_R544_equiv_(expr,t);
+
+ Record information, if any, on symbol in expr; if symbol has equivalence
+ object already, merge with outstanding object if present or make it
+ the outstanding object. */
+
+static void
+ffestc_R544_equiv_ (ffebld expr, ffelexToken t)
+{
+ ffesymbol s;
+
+ if (!ffestc_local_.equiv.ok)
+ return;
+
+ if (ffestc_local_.equiv.t == NULL)
+ ffestc_local_.equiv.t = t;
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opANY:
+ return; /* Don't put this on the list. */
+
+ case FFEBLD_opSYMTER:
+ case FFEBLD_opARRAYREF:
+ case FFEBLD_opSUBSTR:
+ break; /* All of these are ok. */
+
+ default:
+ assert ("ffestc_R544_equiv_ bad op" == NULL);
+ return;
+ }
+
+ ffebld_append_item (&ffestc_local_.equiv.bottom, expr);
+
+ s = ffeequiv_symbol (expr);
+
+ /* See if symbol has an equivalence object already. */
+
+ if (ffesymbol_equiv (s) != NULL)
+ if (ffestc_local_.equiv.eq == NULL)
+ ffestc_local_.equiv.eq = ffesymbol_equiv (s); /* New equiv obj. */
+ else if (ffestc_local_.equiv.eq != ffesymbol_equiv (s))
+ {
+ ffestc_local_.equiv.eq = ffeequiv_merge (ffesymbol_equiv (s),
+ ffestc_local_.equiv.eq,
+ t);
+ if (ffestc_local_.equiv.eq == NULL)
+ ffestc_local_.equiv.ok = FALSE; /* Couldn't merge. */
+ }
+
+ if (ffesymbol_is_save (s))
+ ffestc_local_.equiv.save = TRUE;
+}
+
+/* ffestc_R544_finish -- EQUIVALENCE statement list complete
+
+ ffestc_R544_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R544_finish ()
+{
+ ffestc_check_finish_ ();
+}
+
+/* ffestc_R547_start -- COMMON statement list begin
+
+ ffestc_R547_start();
+
+ Verify that COMMON is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R547_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestc_local_.common.symbol = NULL; /* Blank common is the default. */
+ ffestc_parent_ok_ = TRUE;
+
+ ffestd_R547_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R547_item_object -- COMMON statement for object-name
+
+ ffestc_R547_item_object(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be COMMONd. */
+
+void
+ffestc_R547_item_object (ffelexToken name, ffesttDimList dims)
+{
+ ffesymbol s;
+ ffebld array_size;
+ ffebld extents;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffestpDimtype nd;
+ ffebld e;
+ ffeinfoRank rank;
+ bool is_ugly_assumed;
+
+ if (ffestc_parent_ok_ && (ffestc_local_.common.symbol == NULL))
+ ffestc_R547_item_cblock (NULL); /* As if "COMMON [//] ...". */
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ if (dims != NULL)
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ s = ffesymbol_declare_local (name, FALSE);
+ sa = ffesymbol_attrs (s);
+
+ /* First figure out what kind of object this is based solely on the current
+ object situation (dimension list). */
+
+ is_ugly_assumed = (ffe_is_ugly_assumed ()
+ && ((sa & FFESYMBOL_attrsDUMMY)
+ || (ffesymbol_where (s) == FFEINFO_whereDUMMY)));
+
+ nd = ffestt_dimlist_type (dims, is_ugly_assumed);
+ switch (nd)
+ {
+ case FFESTP_dimtypeNONE:
+ na = FFESYMBOL_attrsCOMMON;
+ break;
+
+ case FFESTP_dimtypeKNOWN:
+ na = FFESYMBOL_attrsCOMMON | FFESYMBOL_attrsARRAY;
+ break;
+
+ default:
+ na = FFESYMBOL_attrsetNONE;
+ break;
+ }
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ;
+ else if (!ffesymbol_is_specable (s))
+ na = FFESYMBOL_attrsetNONE; /* Can't dcl sym ref'd in sfuncdef. */
+ else if (sa & FFESYMBOL_attrsANY)
+ na = FFESYMBOL_attrsANY;
+ else if ((sa & (FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsSFARG))
+ && (na & FFESYMBOL_attrsARRAY))
+ na = FFESYMBOL_attrsetNONE;
+ else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)))
+ na |= sa;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, name);
+ else if ((ffesymbol_equiv (s) != NULL)
+ && (ffeequiv_common (ffesymbol_equiv (s)) != NULL)
+ && (ffeequiv_common (ffesymbol_equiv (s))
+ != ffestc_local_.common.symbol))
+ {
+ /* Oops, just COMMONed a symbol to a different area (via equiv). */
+ ffebad_start (FFEBAD_EQUIV_COMMON);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_string (ffesymbol_text (ffestc_local_.common.symbol));
+ ffebad_string (ffesymbol_text (ffeequiv_common (ffesymbol_equiv (s))));
+ ffebad_finish ();
+ ffesymbol_set_attr (s, na | FFESYMBOL_attrANY);
+ ffesymbol_set_info (s, ffeinfo_new_any ());
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_signal_unreported (s);
+ }
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_set_common (s, ffestc_local_.common.symbol);
+#if FFEGLOBAL_ENABLED
+ if (ffesymbol_is_init (s))
+ ffeglobal_init_common (ffestc_local_.common.symbol, name);
+#endif
+ if (ffesymbol_is_save (ffestc_local_.common.symbol))
+ ffesymbol_update_save (s);
+ if (ffesymbol_equiv (s) != NULL)
+ { /* Is this newly COMMONed symbol involved in
+ an equivalence? */
+ if (ffeequiv_common (ffesymbol_equiv (s)) == NULL)
+ ffeequiv_set_common (ffesymbol_equiv (s), /* Yes, tell equiv obj. */
+ ffestc_local_.common.symbol);
+#if FFEGLOBAL_ENABLED
+ if (ffeequiv_is_init (ffesymbol_equiv (s)))
+ ffeglobal_init_common (ffestc_local_.common.symbol, name);
+#endif
+ if (ffesymbol_is_save (ffestc_local_.common.symbol))
+ ffeequiv_update_save (ffesymbol_equiv (s));
+ }
+ if (dims != NULL)
+ {
+ ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
+ &array_size,
+ &extents,
+ is_ugly_assumed));
+ ffesymbol_set_arraysize (s, array_size);
+ ffesymbol_set_extents (s, extents);
+ if (!(0 && ffe_is_90 ())
+ && (ffebld_op (array_size) == FFEBLD_opCONTER)
+ && (ffebld_constant_integerdefault (ffebld_conter (array_size))
+ == 0))
+ {
+ ffebad_start (FFEBAD_ZERO_ARRAY);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_finish ();
+ }
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ rank,
+ ffesymbol_kind (s),
+ ffesymbol_where (s),
+ ffesymbol_size (s)));
+ }
+ ffesymbol_signal_unreported (s);
+ }
+
+ if (ffestc_parent_ok_)
+ {
+ e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+ FFEINTRIN_impNONE);
+ ffebld_set_info (e,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ FFETARGET_charactersizeNONE));
+ ffebld_append_item
+ (ffesymbol_ptr_to_listbottom (ffestc_local_.common.symbol), e);
+ }
+
+ ffestd_R547_item_object (name, dims);
+}
+
+/* ffestc_R547_item_cblock -- COMMON statement for common-block-name
+
+ ffestc_R547_item_cblock(name_token);
+
+ Make sure name_token identifies a valid common block to be COMMONd. */
+
+void
+ffestc_R547_item_cblock (ffelexToken name)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_local_.common.symbol != NULL)
+ ffesymbol_signal_unreported (ffestc_local_.common.symbol);
+
+ s = ffesymbol_declare_cblock (name,
+ ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!ffesymbol_is_specable (s))
+ na = FFESYMBOL_attrsetNONE;
+ else if (sa & FFESYMBOL_attrsANY)
+ na = FFESYMBOL_attrsANY; /* Already have an error here, say nothing. */
+ else if (!(sa & ~(FFESYMBOL_attrsCBLOCK
+ | FFESYMBOL_attrsSAVECBLOCK)))
+ {
+ if (!(sa & FFESYMBOL_attrsCBLOCK))
+ ffebld_init_list (ffesymbol_ptr_to_commonlist (s),
+ ffesymbol_ptr_to_listbottom (s));
+ na = sa | FFESYMBOL_attrsCBLOCK;
+ }
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ {
+ ffesymbol_error (s, name == NULL ? ffesta_tokens[0] : name);
+ ffestc_parent_ok_ = FALSE;
+ }
+ else if (na & FFESYMBOL_attrsANY)
+ ffestc_parent_ok_ = FALSE;
+ else
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ if (name == NULL)
+ ffesymbol_update_save (s);
+ ffestc_parent_ok_ = TRUE;
+ }
+
+ ffestc_local_.common.symbol = s;
+
+ ffestd_R547_item_cblock (name);
+}
+
+/* ffestc_R547_finish -- COMMON statement list complete
+
+ ffestc_R547_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R547_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_local_.common.symbol != NULL)
+ ffesymbol_signal_unreported (ffestc_local_.common.symbol);
+
+ ffestd_R547_finish ();
+}
+
+/* ffestc_R620 -- ALLOCATE statement
+
+ ffestc_R620(exprlist,stat,stat_token);
+
+ Make sure the expression list is valid, then implement it. */
+
+#if FFESTR_F90
+void
+ffestc_R620 (ffesttExprList exprlist, ffebld stat, ffelexToken stat_token)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_R620 (exprlist, stat);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R624 -- NULLIFY statement
+
+ ffestc_R624(pointer_name_list);
+
+ Make sure pointer_name_list identifies valid pointers for a NULLIFY. */
+
+void
+ffestc_R624 (ffesttExprList pointers)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_R624 (pointers);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R625 -- DEALLOCATE statement
+
+ ffestc_R625(exprlist,stat,stat_token);
+
+ Make sure the equivalence is valid, then implement it. */
+
+void
+ffestc_R625 (ffesttExprList exprlist, ffebld stat, ffelexToken stat_token)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_R625 (exprlist, stat);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_let -- R1213 or R737
+
+ ffestc_let(...);
+
+ Verify that R1213 defined-assignment or R737 assignment-stmt are
+ valid here, figure out which one, and implement. */
+
+#if FFESTR_F90
+void
+ffestc_let (ffebld dest, ffebld source, ffelexToken source_token)
+{
+ ffestc_R737 (dest, source, source_token);
+}
+
+#endif
+/* ffestc_R737 -- Assignment statement
+
+ ffestc_R737(dest_expr,source_expr,source_token);
+
+ Make sure the assignment is valid. */
+
+void
+ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+ ffestc_check_simple_ ();
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+#if FFESTR_F90
+ case FFESTV_stateWHERE:
+ case FFESTV_stateWHERETHEN:
+ if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R737B (dest, source);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ return;
+#endif
+
+ default:
+ break;
+ }
+
+ if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ source = ffeexpr_convert_expr (source, source_token, dest, ffesta_tokens[0],
+ FFEEXPR_contextLET);
+
+ ffestd_R737A (dest, source);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R738 -- Pointer assignment statement
+
+ ffestc_R738(dest_expr,source_expr,source_token);
+
+ Make sure the assignment is valid. */
+
+#if FFESTR_F90
+void
+ffestc_R738 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_R738 (dest, source);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R740 -- WHERE statement
+
+ ffestc_R740(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R740 (ffebld expr, ffelexToken expr_token)
+{
+ ffestw b;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+ ffestw_set_state (b, FFESTV_stateWHERE);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_where_lost_);
+
+ ffestd_R740 (expr);
+
+ /* Leave label finishing to next statement. */
+
+}
+
+/* ffestc_R742 -- WHERE-construct statement
+
+ ffestc_R742(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R742 (ffebld expr, ffelexToken expr_token)
+{
+ ffestw b;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_exec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_probably_this_wont_work_ ();
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+ ffestw_set_state (b, FFESTV_stateWHERETHEN);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_wherethen_);
+ ffestw_set_substate (b, 0); /* Haven't seen ELSEWHERE yet. */
+
+ ffestd_R742 (expr);
+}
+
+/* ffestc_R744 -- ELSE WHERE statement
+
+ ffestc_R744();
+
+ Make sure ffestc_kind_ identifies a WHERE block.
+ Implement the ELSE of the current WHERE block. */
+
+void
+ffestc_R744 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_where_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) != 0)
+ {
+ ffebad_start (FFEBAD_SECOND_ELSE_WHERE);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Saw ELSEWHERE. */
+
+ ffestd_R744 ();
+}
+
+/* ffestc_R745 -- END WHERE statement
+
+ ffestc_R745();
+
+ Make sure ffestc_kind_ identifies a WHERE block.
+ Implement the end of the current WHERE block. */
+
+void
+ffestc_R745 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_where_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestc_shriek_wherethen_ (TRUE);
+}
+
+#endif
+/* ffestc_R803 -- Block IF (IF-THEN) statement
+
+ ffestc_R803(construct_name,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R803 (ffelexToken construct_name, ffebld expr,
+ ffelexToken expr_token UNUSED)
+{
+ ffestw b;
+ ffesymbol s;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_exec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+ ffestw_set_state (b, FFESTV_stateIFTHEN);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_ifthen_);
+ ffestw_set_substate (b, 0); /* Haven't seen ELSE yet. */
+
+ if (construct_name == NULL)
+ ffestw_set_name (b, NULL);
+ else
+ {
+ ffestw_set_name (b, ffelex_token_use (construct_name));
+
+ s = ffesymbol_declare_local (construct_name, FALSE);
+
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindCONSTRUCT,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ ffesymbol_error (s, construct_name);
+ }
+
+ ffestd_R803 (construct_name, expr);
+}
+
+/* ffestc_R804 -- ELSE IF statement
+
+ ffestc_R804(expr,expr_token,name_token);
+
+ Make sure ffestc_kind_ identifies an IF block. If not
+ NULL, make sure name_token gives the correct name. Implement the else
+ of the IF block. */
+
+void
+ffestc_R804 (ffebld expr, ffelexToken expr_token UNUSED,
+ ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (name != NULL)
+ {
+ if (ffestw_name (ffestw_stack_top ()) == NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ else if (ffelex_token_strcmp (name,
+ ffestw_name (ffestw_stack_top ()))
+ != 0)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+ }
+
+ if (ffestw_substate (ffestw_stack_top ()) != 0)
+ {
+ ffebad_start (FFEBAD_AFTER_ELSE);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ return; /* Don't upset back end with ELSEIF
+ after ELSE. */
+ }
+
+ ffestd_R804 (expr, name);
+}
+
+/* ffestc_R805 -- ELSE statement
+
+ ffestc_R805(name_token);
+
+ Make sure ffestc_kind_ identifies an IF block. If not
+ NULL, make sure name_token gives the correct name. Implement the ELSE
+ of the IF block. */
+
+void
+ffestc_R805 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (name != NULL)
+ {
+ if (ffestw_name (ffestw_stack_top ()) == NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+ }
+
+ if (ffestw_substate (ffestw_stack_top ()) != 0)
+ {
+ ffebad_start (FFEBAD_AFTER_ELSE);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ return; /* Tell back end about only one ELSE. */
+ }
+
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Saw ELSE. */
+
+ ffestd_R805 (name);
+}
+
+/* ffestc_R806 -- END IF statement
+
+ ffestc_R806(name_token);
+
+ Make sure ffestc_kind_ identifies an IF block. If not
+ NULL, make sure name_token gives the correct name. Implement the end
+ of the IF block. */
+
+void
+ffestc_R806 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_endif_ ();
+
+ if (name == NULL)
+ {
+ if (ffestw_name (ffestw_stack_top ()) != NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if (ffestw_name (ffestw_stack_top ()) == NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+ }
+
+ ffestc_shriek_ifthen_ (TRUE);
+}
+
+/* ffestc_R807 -- Logical IF statement
+
+ ffestc_R807(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R807 (ffebld expr, ffelexToken expr_token UNUSED)
+{
+ ffestw b;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_action_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+ ffestw_set_state (b, FFESTV_stateIF);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_if_lost_);
+
+ ffestd_R807 (expr);
+
+ /* Do the label finishing in the next statement. */
+
+}
+
+/* ffestc_R809 -- SELECT CASE statement
+
+ ffestc_R809(construct_name,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R809 (ffelexToken construct_name, ffebld expr, ffelexToken expr_token)
+{
+ ffestw b;
+ mallocPool pool;
+ ffestwSelect s;
+ ffesymbol sym;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_exec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
+ ffestw_set_state (b, FFESTV_stateSELECT0);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_select_);
+ ffestw_set_substate (b, 0); /* Haven't seen CASE DEFAULT yet. */
+
+ /* Init block to manage CASE list. */
+
+ pool = malloc_pool_new ("Select", ffe_pool_any_unit (), 1024);
+ s = (ffestwSelect) malloc_new_kp (pool, "Select", sizeof (*s));
+ s->first_rel = (ffestwCase) &s->first_rel;
+ s->last_rel = (ffestwCase) &s->first_rel;
+ s->first_stmt = (ffestwCase) &s->first_rel;
+ s->last_stmt = (ffestwCase) &s->first_rel;
+ s->pool = pool;
+ s->cases = 1;
+ s->t = ffelex_token_use (expr_token);
+ s->type = ffeinfo_basictype (ffebld_info (expr));
+ s->kindtype = ffeinfo_kindtype (ffebld_info (expr));
+ ffestw_set_select (b, s);
+
+ if (construct_name == NULL)
+ ffestw_set_name (b, NULL);
+ else
+ {
+ ffestw_set_name (b, ffelex_token_use (construct_name));
+
+ sym = ffesymbol_declare_local (construct_name, FALSE);
+
+ if (ffesymbol_state (sym) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (sym, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (sym,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE, 0,
+ FFEINFO_kindCONSTRUCT,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ sym = ffecom_sym_learned (sym);
+ ffesymbol_signal_unreported (sym);
+ }
+ else
+ ffesymbol_error (sym, construct_name);
+ }
+
+ ffestd_R809 (construct_name, expr);
+}
+
+/* ffestc_R810 -- CASE statement
+
+ ffestc_R810(case_value_range_list,name);
+
+ If case_value_range_list is NULL, it's CASE DEFAULT. name is the case-
+ construct-name. Make sure no more than one CASE DEFAULT is present for
+ a given case-construct and that there aren't any overlapping ranges or
+ duplicate case values. */
+
+void
+ffestc_R810 (ffesttCaseList cases, ffelexToken name)
+{
+ ffesttCaseList caseobj;
+ ffestwSelect s;
+ ffestwCase c, nc;
+ ffebldConstant expr1c, expr2c;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_selectcase_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ s = ffestw_select (ffestw_stack_top ());
+
+ if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateSELECT0)
+ {
+#if 0 /* Not sure we want to have msgs point here
+ instead of SELECT CASE. */
+ ffestw_update (NULL); /* Update state line/col info. */
+#endif
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateSELECT1);
+ }
+
+ if (name != NULL)
+ {
+ if (ffestw_name (ffestw_stack_top ()) == NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ else if (ffelex_token_strcmp (name,
+ ffestw_name (ffestw_stack_top ()))
+ != 0)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+ }
+
+ if (cases == NULL)
+ {
+ if (ffestw_substate (ffestw_stack_top ()) != 0)
+ {
+ ffebad_start (FFEBAD_CASE_SECOND_DEFAULT);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Saw ELSE. */
+ }
+ else
+ { /* For each case, try to fit into sorted list
+ of ranges. */
+ for (caseobj = cases->next; caseobj != cases; caseobj = caseobj->next)
+ {
+ if ((caseobj->expr1 == NULL)
+ && (!caseobj->range
+ || (caseobj->expr2 == NULL)))
+ { /* "CASE (:)". */
+ ffebad_start (FFEBAD_CASE_BAD_RANGE);
+ ffebad_here (0, ffelex_token_where_line (caseobj->t),
+ ffelex_token_where_column (caseobj->t));
+ ffebad_finish ();
+ continue;
+ }
+
+ if (((caseobj->expr1 != NULL)
+ && ((ffeinfo_basictype (ffebld_info (caseobj->expr1))
+ != s->type)
+ || (ffeinfo_kindtype (ffebld_info (caseobj->expr1))
+ != s->kindtype)))
+ || ((caseobj->range)
+ && (caseobj->expr2 != NULL)
+ && ((ffeinfo_basictype (ffebld_info (caseobj->expr2))
+ != s->type)
+ || (ffeinfo_kindtype (ffebld_info (caseobj->expr2))
+ != s->kindtype))))
+ {
+ ffebad_start (FFEBAD_CASE_TYPE_DISAGREE);
+ ffebad_here (0, ffelex_token_where_line (caseobj->t),
+ ffelex_token_where_column (caseobj->t));
+ ffebad_here (1, ffelex_token_where_line (s->t),
+ ffelex_token_where_column (s->t));
+ ffebad_finish ();
+ continue;
+ }
+
+ if ((s->type == FFEINFO_basictypeLOGICAL) && (caseobj->range))
+ {
+ ffebad_start (FFEBAD_CASE_LOGICAL_RANGE);
+ ffebad_here (0, ffelex_token_where_line (caseobj->t),
+ ffelex_token_where_column (caseobj->t));
+ ffebad_finish ();
+ continue;
+ }
+
+ if (caseobj->expr1 == NULL)
+ expr1c = NULL;
+ else if (ffebld_op (caseobj->expr1) != FFEBLD_opCONTER)
+ continue; /* opANY. */
+ else
+ expr1c = ffebld_conter (caseobj->expr1);
+
+ if (!caseobj->range)
+ expr2c = expr1c; /* expr1c and expr2c are NOT NULL in this
+ case. */
+ else if (caseobj->expr2 == NULL)
+ expr2c = NULL;
+ else if (ffebld_op (caseobj->expr2) != FFEBLD_opCONTER)
+ continue; /* opANY. */
+ else
+ expr2c = ffebld_conter (caseobj->expr2);
+
+ if (expr1c == NULL)
+ { /* "CASE (:high)", must be first in list. */
+ c = s->first_rel;
+ if ((c != (ffestwCase) &s->first_rel)
+ && ((c->low == NULL)
+ || (ffebld_constant_cmp (expr2c, c->low) >= 0)))
+ { /* Other "CASE (:high)" or lowest "CASE
+ (low[:high])" low. */
+ ffebad_start (FFEBAD_CASE_DUPLICATE);
+ ffebad_here (0, ffelex_token_where_line (caseobj->t),
+ ffelex_token_where_column (caseobj->t));
+ ffebad_here (1, ffelex_token_where_line (c->t),
+ ffelex_token_where_column (c->t));
+ ffebad_finish ();
+ continue;
+ }
+ }
+ else if (expr2c == NULL)
+ { /* "CASE (low:)", must be last in list. */
+ c = s->last_rel;
+ if ((c != (ffestwCase) &s->first_rel)
+ && ((c->high == NULL)
+ || (ffebld_constant_cmp (expr1c, c->high) <= 0)))
+ { /* Other "CASE (low:)" or lowest "CASE
+ ([low:]high)" high. */
+ ffebad_start (FFEBAD_CASE_DUPLICATE);
+ ffebad_here (0, ffelex_token_where_line (caseobj->t),
+ ffelex_token_where_column (caseobj->t));
+ ffebad_here (1, ffelex_token_where_line (c->t),
+ ffelex_token_where_column (c->t));
+ ffebad_finish ();
+ continue;
+ }
+ c = c->next_rel; /* Same as c = (ffestwCase) &s->first;. */
+ }
+ else
+ { /* (expr1c != NULL) && (expr2c != NULL). */
+ if (ffebld_constant_cmp (expr1c, expr2c) > 0)
+ { /* Such as "CASE (3:1)" or "CASE ('B':'A')". */
+ ffebad_start (FFEBAD_CASE_RANGE_USELESS); /* Warn/inform only. */
+ ffebad_here (0, ffelex_token_where_line (caseobj->t),
+ ffelex_token_where_column (caseobj->t));
+ ffebad_finish ();
+ continue;
+ }
+ for (c = s->first_rel;
+ (c != (ffestwCase) &s->first_rel)
+ && ((c->low == NULL)
+ || (ffebld_constant_cmp (expr1c, c->low) > 0));
+ c = c->next_rel)
+ ;
+ nc = c; /* Which one to report? */
+ if (((c != (ffestwCase) &s->first_rel)
+ && (ffebld_constant_cmp (expr2c, c->low) >= 0))
+ || (((nc = c->previous_rel) != (ffestwCase) &s->first_rel)
+ && (ffebld_constant_cmp (expr1c, nc->high) <= 0)))
+ { /* Interference with range in case nc. */
+ ffebad_start (FFEBAD_CASE_DUPLICATE);
+ ffebad_here (0, ffelex_token_where_line (caseobj->t),
+ ffelex_token_where_column (caseobj->t));
+ ffebad_here (1, ffelex_token_where_line (nc->t),
+ ffelex_token_where_column (nc->t));
+ ffebad_finish ();
+ continue;
+ }
+ }
+
+ /* If we reach here for this case range/value, it's ok (sorts into
+ the list of ranges/values) so we give it its own case object
+ sorted into the list of case statements. */
+
+ nc = malloc_new_kp (s->pool, "Case range", sizeof (*nc));
+ nc->next_rel = c;
+ nc->previous_rel = c->previous_rel;
+ nc->next_stmt = (ffestwCase) &s->first_rel;
+ nc->previous_stmt = s->last_stmt;
+ nc->low = expr1c;
+ nc->high = expr2c;
+ nc->casenum = s->cases;
+ nc->t = ffelex_token_use (caseobj->t);
+ nc->next_rel->previous_rel = nc;
+ nc->previous_rel->next_rel = nc;
+ nc->next_stmt->previous_stmt = nc;
+ nc->previous_stmt->next_stmt = nc;
+ }
+ }
+
+ ffestd_R810 ((cases == NULL) ? 0 : s->cases);
+
+ s->cases++; /* Increment # of cases. */
+}
+
+/* ffestc_R811 -- END SELECT statement
+
+ ffestc_R811(name_token);
+
+ Make sure ffestc_kind_ identifies a SELECT block. If not
+ NULL, make sure name_token gives the correct name. Implement the end
+ of the SELECT block. */
+
+void
+ffestc_R811 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_selectcase_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ if (name == NULL)
+ {
+ if (ffestw_name (ffestw_stack_top ()) != NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if (ffestw_name (ffestw_stack_top ()) == NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ else if (ffelex_token_strcmp (name,
+ ffestw_name (ffestw_stack_top ()))
+ != 0)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+ }
+
+ ffestc_shriek_select_ (TRUE);
+}
+
+/* ffestc_R819A -- Iterative labeled DO statement
+
+ ffestc_R819A(construct_name,label_token,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R819A (ffelexToken construct_name, ffelexToken label_token, ffebld var,
+ ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
+ ffelexToken end_token, ffebld incr, ffelexToken incr_token)
+{
+ ffestw b;
+ ffelab label;
+ ffesymbol s;
+ ffesymbol varsym;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_exec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ if (!ffestc_labelref_is_loopend_ (label_token, &label))
+ return;
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, b);
+ ffestw_set_state (b, FFESTV_stateDO);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_do_);
+ ffestw_set_label (b, label);
+ switch (ffebld_op (var))
+ {
+ case FFEBLD_opSYMTER:
+ if ((ffeinfo_basictype (ffebld_info (var)) == FFEINFO_basictypeREAL)
+ && ffe_is_warn_surprising ())
+ {
+ ffebad_start (FFEBAD_DO_REAL); /* See error message!!! */
+ ffebad_here (0, ffelex_token_where_line (var_token),
+ ffelex_token_where_column (var_token));
+ ffebad_string (ffesymbol_text (ffebld_symter (var)));
+ ffebad_finish ();
+ }
+ if (!ffesymbol_is_doiter (varsym = ffebld_symter (var)))
+ { /* Presumably already complained about by
+ ffeexpr_lhs_. */
+ ffesymbol_set_is_doiter (varsym, TRUE);
+ ffestw_set_do_iter_var (b, varsym);
+ ffestw_set_do_iter_var_t (b, ffelex_token_use (var_token));
+ break;
+ }
+ /* Fall through. */
+ case FFEBLD_opANY:
+ ffestw_set_do_iter_var (b, NULL);
+ ffestw_set_do_iter_var_t (b, NULL);
+ break;
+
+ default:
+ assert ("bad iter var" == NULL);
+ break;
+ }
+
+ if (construct_name == NULL)
+ ffestw_set_name (b, NULL);
+ else
+ {
+ ffestw_set_name (b, ffelex_token_use (construct_name));
+
+ s = ffesymbol_declare_local (construct_name, FALSE);
+
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindCONSTRUCT,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ ffesymbol_error (s, construct_name);
+ }
+
+ if (incr == NULL)
+ {
+ incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+ ffebld_set_info (incr, ffeinfo_new
+ (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ }
+
+ start = ffeexpr_convert_expr (start, start_token, var, var_token,
+ FFEEXPR_contextLET);
+ end = ffeexpr_convert_expr (end, end_token, var, var_token,
+ FFEEXPR_contextLET);
+ incr = ffeexpr_convert_expr (incr, incr_token, var, var_token,
+ FFEEXPR_contextLET);
+
+ ffestd_R819A (construct_name, label, var,
+ start, start_token,
+ end, end_token,
+ incr, incr_token);
+}
+
+/* ffestc_R819B -- Labeled DO WHILE statement
+
+ ffestc_R819B(construct_name,label_token,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R819B (ffelexToken construct_name, ffelexToken label_token,
+ ffebld expr, ffelexToken expr_token UNUSED)
+{
+ ffestw b;
+ ffelab label;
+ ffesymbol s;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_exec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ if (!ffestc_labelref_is_loopend_ (label_token, &label))
+ return;
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, b);
+ ffestw_set_state (b, FFESTV_stateDO);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_do_);
+ ffestw_set_label (b, label);
+ ffestw_set_do_iter_var (b, NULL);
+ ffestw_set_do_iter_var_t (b, NULL);
+
+ if (construct_name == NULL)
+ ffestw_set_name (b, NULL);
+ else
+ {
+ ffestw_set_name (b, ffelex_token_use (construct_name));
+
+ s = ffesymbol_declare_local (construct_name, FALSE);
+
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindCONSTRUCT,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ ffesymbol_error (s, construct_name);
+ }
+
+ ffestd_R819B (construct_name, label, expr);
+}
+
+/* ffestc_R820A -- Iterative nonlabeled DO statement
+
+ ffestc_R820A(construct_name,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R820A (ffelexToken construct_name, ffebld var, ffelexToken var_token,
+ ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token,
+ ffebld incr, ffelexToken incr_token)
+{
+ ffestw b;
+ ffesymbol s;
+ ffesymbol varsym;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_exec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, b);
+ ffestw_set_state (b, FFESTV_stateDO);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_do_);
+ ffestw_set_label (b, NULL);
+ switch (ffebld_op (var))
+ {
+ case FFEBLD_opSYMTER:
+ if ((ffeinfo_basictype (ffebld_info (var)) == FFEINFO_basictypeREAL)
+ && ffe_is_warn_surprising ())
+ {
+ ffebad_start (FFEBAD_DO_REAL); /* See error message!!! */
+ ffebad_here (0, ffelex_token_where_line (var_token),
+ ffelex_token_where_column (var_token));
+ ffebad_string (ffesymbol_text (ffebld_symter (var)));
+ ffebad_finish ();
+ }
+ if (!ffesymbol_is_doiter (varsym = ffebld_symter (var)))
+ { /* Presumably already complained about by
+ ffeexpr_lhs_. */
+ ffesymbol_set_is_doiter (varsym, TRUE);
+ ffestw_set_do_iter_var (b, varsym);
+ ffestw_set_do_iter_var_t (b, ffelex_token_use (var_token));
+ break;
+ }
+ /* Fall through. */
+ case FFEBLD_opANY:
+ ffestw_set_do_iter_var (b, NULL);
+ ffestw_set_do_iter_var_t (b, NULL);
+ break;
+
+ default:
+ assert ("bad iter var" == NULL);
+ break;
+ }
+
+ if (construct_name == NULL)
+ ffestw_set_name (b, NULL);
+ else
+ {
+ ffestw_set_name (b, ffelex_token_use (construct_name));
+
+ s = ffesymbol_declare_local (construct_name, FALSE);
+
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindCONSTRUCT,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ ffesymbol_error (s, construct_name);
+ }
+
+ if (incr == NULL)
+ {
+ incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+ ffebld_set_info (incr, ffeinfo_new
+ (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ }
+
+ start = ffeexpr_convert_expr (start, start_token, var, var_token,
+ FFEEXPR_contextLET);
+ end = ffeexpr_convert_expr (end, end_token, var, var_token,
+ FFEEXPR_contextLET);
+ incr = ffeexpr_convert_expr (incr, incr_token, var, var_token,
+ FFEEXPR_contextLET);
+
+#if 0
+ if ((ffebld_op (incr) == FFEBLD_opCONTER)
+ && (ffebld_constant_is_zero (ffebld_conter (incr))))
+ {
+ ffebad_start (FFEBAD_DO_STEP_ZERO);
+ ffebad_here (0, ffelex_token_where_line (incr_token),
+ ffelex_token_where_column (incr_token));
+ ffebad_string ("Iterative DO loop");
+ ffebad_finish ();
+ }
+#endif
+
+ ffestd_R819A (construct_name, NULL, var,
+ start, start_token,
+ end, end_token,
+ incr, incr_token);
+}
+
+/* ffestc_R820B -- Nonlabeled DO WHILE statement
+
+ ffestc_R820B(construct_name,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R820B (ffelexToken construct_name, ffebld expr,
+ ffelexToken expr_token UNUSED)
+{
+ ffestw b;
+ ffesymbol s;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_exec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, b);
+ ffestw_set_state (b, FFESTV_stateDO);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_do_);
+ ffestw_set_label (b, NULL);
+ ffestw_set_do_iter_var (b, NULL);
+ ffestw_set_do_iter_var_t (b, NULL);
+
+ if (construct_name == NULL)
+ ffestw_set_name (b, NULL);
+ else
+ {
+ ffestw_set_name (b, ffelex_token_use (construct_name));
+
+ s = ffesymbol_declare_local (construct_name, FALSE);
+
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindCONSTRUCT,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ ffesymbol_error (s, construct_name);
+ }
+
+ ffestd_R819B (construct_name, NULL, expr);
+}
+
+/* ffestc_R825 -- END DO statement
+
+ ffestc_R825(name_token);
+
+ Make sure ffestc_kind_ identifies a DO block. If not
+ NULL, make sure name_token gives the correct name. Implement the end
+ of the DO block. */
+
+void
+ffestc_R825 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_do_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (name == NULL)
+ {
+ if (ffestw_name (ffestw_stack_top ()) != NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ }
+ else
+ {
+ if (ffestw_name (ffestw_stack_top ()) == NULL)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ else if (ffelex_token_strcmp (name,
+ ffestw_name (ffestw_stack_top ()))
+ != 0)
+ {
+ ffebad_start (FFEBAD_CONSTRUCT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+ }
+
+ if (ffesta_label_token == NULL)
+ { /* If top of stack has label, its an error! */
+ if (ffestw_label (ffestw_stack_top ()) != NULL)
+ {
+ ffebad_start (FFEBAD_DO_HAD_LABEL);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+
+ ffestc_shriek_do_ (TRUE);
+
+ ffestc_try_shriek_do_ ();
+
+ return;
+ }
+
+ ffestd_R825 (name);
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R834 -- CYCLE statement
+
+ ffestc_R834(name_token);
+
+ Handle a CYCLE within a loop. */
+
+void
+ffestc_R834 (ffelexToken name)
+{
+ ffestw block;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actiondo_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_begin_ ();
+
+ if (name == NULL)
+ block = ffestw_top_do (ffestw_stack_top ());
+ else
+ { /* Search for name. */
+ for (block = ffestw_top_do (ffestw_stack_top ());
+ (block != NULL) && (ffestw_blocknum (block) != 0);
+ block = ffestw_top_do (ffestw_previous (block)))
+ {
+ if ((ffestw_name (block) != NULL)
+ && (ffelex_token_strcmp (name, ffestw_name (block)) == 0))
+ break;
+ }
+ if ((block == NULL) || (ffestw_blocknum (block) == 0))
+ {
+ block = ffestw_top_do (ffestw_stack_top ());
+ ffebad_start (FFEBAD_CONSTRUCT_NO_DO_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_finish ();
+ }
+ }
+
+ ffestd_R834 (block);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+
+ /* notloop's that are actionif's can be the target of a loop-end
+ statement if they're in the "then" part of a logical IF, as
+ in "DO 10", "10 IF (...) CYCLE". */
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R835 -- EXIT statement
+
+ ffestc_R835(name_token);
+
+ Handle a EXIT within a loop. */
+
+void
+ffestc_R835 (ffelexToken name)
+{
+ ffestw block;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actiondo_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_begin_ ();
+
+ if (name == NULL)
+ block = ffestw_top_do (ffestw_stack_top ());
+ else
+ { /* Search for name. */
+ for (block = ffestw_top_do (ffestw_stack_top ());
+ (block != NULL) && (ffestw_blocknum (block) != 0);
+ block = ffestw_top_do (ffestw_previous (block)))
+ {
+ if ((ffestw_name (block) != NULL)
+ && (ffelex_token_strcmp (name, ffestw_name (block)) == 0))
+ break;
+ }
+ if ((block == NULL) || (ffestw_blocknum (block) == 0))
+ {
+ block = ffestw_top_do (ffestw_stack_top ());
+ ffebad_start (FFEBAD_CONSTRUCT_NO_DO_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_finish ();
+ }
+ }
+
+ ffestd_R835 (block);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+
+ /* notloop's that are actionif's can be the target of a loop-end
+ statement if they're in the "then" part of a logical IF, as
+ in "DO 10", "10 IF (...) EXIT". */
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R836 -- GOTO statement
+
+ ffestc_R836(label_token);
+
+ Make sure label_token identifies a valid label for a GOTO. Update
+ that label's info to indicate it is the target of a GOTO. */
+
+void
+ffestc_R836 (ffelexToken label_token)
+{
+ ffelab label;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_begin_ ();
+
+ if (ffestc_labelref_is_branch_ (label_token, &label))
+ ffestd_R836 (label);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+
+ /* notloop's that are actionif's can be the target of a loop-end
+ statement if they're in the "then" part of a logical IF, as
+ in "DO 10", "10 IF (...) GOTO 100". */
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R837 -- Computed GOTO statement
+
+ ffestc_R837(label_list,expr,expr_token);
+
+ Make sure label_list identifies valid labels for a GOTO. Update
+ each label's info to indicate it is the target of a GOTO. */
+
+void
+ffestc_R837 (ffesttTokenList label_toks, ffebld expr,
+ ffelexToken expr_token UNUSED)
+{
+ ffesttTokenItem ti;
+ bool ok = TRUE;
+ int i;
+ ffelab *labels;
+
+ assert (label_toks != NULL);
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ labels = malloc_new_kp (ffesta_output_pool, "FFESTC labels",
+ sizeof (*labels)
+ * ffestt_tokenlist_count (label_toks));
+
+ for (ti = label_toks->first, i = 0;
+ ti != (ffesttTokenItem) &label_toks->first;
+ ti = ti->next, ++i)
+ {
+ if (!ffestc_labelref_is_branch_ (ti->t, &labels[i]))
+ {
+ ok = FALSE;
+ break;
+ }
+ }
+
+ if (ok)
+ ffestd_R837 (labels, ffestt_tokenlist_count (label_toks), expr);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R838 -- ASSIGN statement
+
+ ffestc_R838(label_token,target_variable,target_token);
+
+ Make sure label_token identifies a valid label for an assignment. Update
+ that label's info to indicate it is the source of an assignment. Update
+ target_variable's info to indicate it is the target the assignment of that
+ label. */
+
+void
+ffestc_R838 (ffelexToken label_token, ffebld target,
+ ffelexToken target_token UNUSED)
+{
+ ffelab label;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_labelref_is_assignable_ (label_token, &label))
+ ffestd_R838 (label, target);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R839 -- Assigned GOTO statement
+
+ ffestc_R839(target,target_token,label_list);
+
+ Make sure label_list identifies valid labels for a GOTO. Update
+ each label's info to indicate it is the target of a GOTO. */
+
+void
+ffestc_R839 (ffebld target, ffelexToken target_token UNUSED,
+ ffesttTokenList label_toks)
+{
+ ffesttTokenItem ti;
+ bool ok = TRUE;
+ int i;
+ ffelab *labels;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_begin_ ();
+
+ if (label_toks == NULL)
+ {
+ labels = NULL;
+ i = 0;
+ }
+ else
+ {
+ labels = malloc_new_kp (ffesta_output_pool, "FFESTC labels",
+ sizeof (*labels) * ffestt_tokenlist_count (label_toks));
+
+ for (ti = label_toks->first, i = 0;
+ ti != (ffesttTokenItem) &label_toks->first;
+ ti = ti->next, ++i)
+ {
+ if (!ffestc_labelref_is_branch_ (ti->t, &labels[i]))
+ {
+ ok = FALSE;
+ break;
+ }
+ }
+ }
+
+ if (ok)
+ ffestd_R839 (target, labels, i);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+
+ /* notloop's that are actionif's can be the target of a loop-end
+ statement if they're in the "then" part of a logical IF, as
+ in "DO 10", "10 IF (...) GOTO I". */
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R840 -- Arithmetic IF statement
+
+ ffestc_R840(expr,expr_token,neg,zero,pos);
+
+ Make sure the labels are valid; implement. */
+
+void
+ffestc_R840 (ffebld expr, ffelexToken expr_token UNUSED,
+ ffelexToken neg_token, ffelexToken zero_token,
+ ffelexToken pos_token)
+{
+ ffelab neg;
+ ffelab zero;
+ ffelab pos;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_begin_ ();
+
+ if (ffestc_labelref_is_branch_ (neg_token, &neg)
+ && ffestc_labelref_is_branch_ (zero_token, &zero)
+ && ffestc_labelref_is_branch_ (pos_token, &pos))
+ ffestd_R840 (expr, neg, zero, pos);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+
+ /* notloop's that are actionif's can be the target of a loop-end
+ statement if they're in the "then" part of a logical IF, as
+ in "DO 10", "10 IF (...) GOTO (100,200,300), I". */
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R841 -- CONTINUE statement
+
+ ffestc_R841(); */
+
+void
+ffestc_R841 ()
+{
+ ffestc_check_simple_ ();
+
+ if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
+ return;
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+#if FFESTR_F90
+ case FFESTV_stateWHERE:
+ case FFESTV_stateWHERETHEN:
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R841 (TRUE);
+
+ /* It's okay that we call ffestc_labeldef_branch_end_ () below,
+ since that will be a no-op after calling _useless_ () above. */
+ break;
+#endif
+
+ default:
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_R841 (FALSE);
+
+ break;
+ }
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R842 -- STOP statement
+
+ ffestc_R842(expr,expr_token);
+
+ Make sure statement is valid here; implement. expr and expr_token are
+ both NULL if there was no expression. */
+
+void
+ffestc_R842 (ffebld expr, ffelexToken expr_token UNUSED)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_begin_ ();
+
+ ffestd_R842 (expr);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+
+ /* notloop's that are actionif's can be the target of a loop-end
+ statement if they're in the "then" part of a logical IF, as
+ in "DO 10", "10 IF (...) STOP". */
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R843 -- PAUSE statement
+
+ ffestc_R843(expr,expr_token);
+
+ Make sure statement is valid here; implement. expr and expr_token are
+ both NULL if there was no expression. */
+
+void
+ffestc_R843 (ffebld expr, ffelexToken expr_token UNUSED)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_R843 (expr);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R904 -- OPEN statement
+
+ ffestc_R904();
+
+ Make sure an OPEN is valid in the current context, and implement it. */
+
+void
+ffestc_R904 ()
+{
+ int i;
+ int expect_file;
+ char *status_strs[]
+ =
+ {
+ "New",
+ "Old",
+ "Replace",
+ "Scratch",
+ "Unknown"
+ };
+ char *access_strs[]
+ =
+ {
+ "Append",
+ "Direct",
+ "Keyed",
+ "Sequential"
+ };
+ char *blank_strs[]
+ =
+ {
+ "Null",
+ "Zero"
+ };
+ char *carriagecontrol_strs[]
+ =
+ {
+ "Fortran",
+ "List",
+ "None"
+ };
+ char *dispose_strs[]
+ =
+ {
+ "Delete",
+ "Keep",
+ "Print",
+ "Print/Delete",
+ "Save",
+ "Submit",
+ "Submit/Delete"
+ };
+ char *form_strs[]
+ =
+ {
+ "Formatted",
+ "Unformatted"
+ };
+ char *organization_strs[]
+ =
+ {
+ "Indexed",
+ "Relative",
+ "Sequential"
+ };
+ char *position_strs[]
+ =
+ {
+ "Append",
+ "AsIs",
+ "Rewind"
+ };
+ char *action_strs[]
+ =
+ {
+ "Read",
+ "ReadWrite",
+ "Write"
+ };
+ char *delim_strs[]
+ =
+ {
+ "Apostrophe",
+ "None",
+ "Quote"
+ };
+ char *recordtype_strs[]
+ =
+ {
+ "Fixed",
+ "Segmented",
+ "Stream",
+ "Stream_CR",
+ "Stream_LF",
+ "Variable"
+ };
+ char *pad_strs[]
+ =
+ {
+ "No",
+ "Yes"
+ };
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.open.open_spec[FFESTP_openixERR])
+ && ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.open.open_spec[FFESTP_openixUNIT]))
+ {
+ i = ffestc_subr_binsrch_ (status_strs,
+ ARRAY_SIZE (status_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixSTATUS],
+ "NEW, OLD, REPLACE, SCRATCH, or UNKNOWN");
+ switch (i)
+ {
+ case 0: /* Unknown. */
+ case 5: /* UNKNOWN. */
+ expect_file = 2; /* Unknown, don't care about FILE=. */
+ break;
+
+ case 1: /* NEW. */
+ case 2: /* OLD. */
+ if (ffe_is_pedantic ())
+ expect_file = 1; /* Yes, need FILE=. */
+ else
+ expect_file = 2; /* f2clib doesn't care about FILE=. */
+ break;
+
+ case 3: /* REPLACE. */
+ expect_file = 1; /* Yes, need FILE=. */
+ break;
+
+ case 4: /* SCRATCH. */
+ expect_file = 0; /* No, disallow FILE=. */
+ break;
+
+ default:
+ assert ("invalid _binsrch_ result" == NULL);
+ expect_file = 0;
+ break;
+ }
+ if ((expect_file == 0)
+ && ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present)
+ {
+ ffebad_start (FFEBAD_CONFLICTING_SPECS);
+ assert (ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present);
+ if (ffestp_file.open.open_spec[FFESTP_openixFILE].kw_present)
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.open.open_spec[FFESTP_openixFILE].kw),
+ ffelex_token_where_column
+ (ffestp_file.open.open_spec[FFESTP_openixFILE].kw));
+ }
+ else
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.open.open_spec[FFESTP_openixFILE].value),
+ ffelex_token_where_column
+ (ffestp_file.open.open_spec[FFESTP_openixFILE].value));
+ }
+ assert (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_or_val_present);
+ if (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_present)
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw),
+ ffelex_token_where_column
+ (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw));
+ }
+ else
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value),
+ ffelex_token_where_column
+ (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value));
+ }
+ ffebad_finish ();
+ }
+ else if ((expect_file == 1)
+ && !ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present)
+ {
+ ffebad_start (FFEBAD_MISSING_SPECIFIER);
+ assert (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_or_val_present);
+ if (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_present)
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw),
+ ffelex_token_where_column
+ (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw));
+ }
+ else
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value),
+ ffelex_token_where_column
+ (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value));
+ }
+ ffebad_string ("FILE=");
+ ffebad_finish ();
+ }
+
+ ffestc_subr_binsrch_ (access_strs, ARRAY_SIZE (access_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixACCESS],
+ "APPEND, DIRECT, KEYED, or SEQUENTIAL");
+
+ ffestc_subr_binsrch_ (blank_strs, ARRAY_SIZE (blank_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixBLANK],
+ "NULL or ZERO");
+
+ ffestc_subr_binsrch_ (carriagecontrol_strs,
+ ARRAY_SIZE (carriagecontrol_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixCARRIAGECONTROL],
+ "FORTRAN, LIST, or NONE");
+
+ ffestc_subr_binsrch_ (dispose_strs, ARRAY_SIZE (dispose_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixDISPOSE],
+ "DELETE, KEEP, PRINT, PRINT/DELETE, SAVE, SUBMIT, or SUBMIT/DELETE");
+
+ ffestc_subr_binsrch_ (form_strs, ARRAY_SIZE (form_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixFORM],
+ "FORMATTED or UNFORMATTED");
+
+ ffestc_subr_binsrch_ (organization_strs, ARRAY_SIZE (organization_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixORGANIZATION],
+ "INDEXED, RELATIVE, or SEQUENTIAL");
+
+ ffestc_subr_binsrch_ (position_strs, ARRAY_SIZE (position_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixPOSITION],
+ "APPEND, ASIS, or REWIND");
+
+ ffestc_subr_binsrch_ (action_strs, ARRAY_SIZE (action_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixACTION],
+ "READ, READWRITE, or WRITE");
+
+ ffestc_subr_binsrch_ (delim_strs, ARRAY_SIZE (delim_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixDELIM],
+ "APOSTROPHE, NONE, or QUOTE");
+
+ ffestc_subr_binsrch_ (recordtype_strs, ARRAY_SIZE (recordtype_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixRECORDTYPE],
+ "FIXED, SEGMENTED, STREAM, STREAM_CR, STREAM_LF, or VARIABLE");
+
+ ffestc_subr_binsrch_ (pad_strs, ARRAY_SIZE (pad_strs),
+ &ffestp_file.open.open_spec[FFESTP_openixPAD],
+ "NO or YES");
+
+ ffestd_R904 ();
+ }
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R907 -- CLOSE statement
+
+ ffestc_R907();
+
+ Make sure a CLOSE is valid in the current context, and implement it. */
+
+void
+ffestc_R907 ()
+{
+ char *status_strs[]
+ =
+ {
+ "Delete",
+ "Keep",
+ "Print",
+ "Print/Delete",
+ "Save",
+ "Submit",
+ "Submit/Delete"
+ };
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.close.close_spec[FFESTP_closeixERR])
+ && ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.close.close_spec[FFESTP_closeixUNIT]))
+ {
+ ffestc_subr_binsrch_ (status_strs, ARRAY_SIZE (status_strs),
+ &ffestp_file.close.close_spec[FFESTP_closeixSTATUS],
+ "DELETE, KEEP, PRINT, PRINT/DELETE, SAVE, SUBMIT, or SUBMIT/DELETE");
+
+ ffestd_R907 ();
+ }
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R909_start -- READ(...) statement list begin
+
+ ffestc_R909_start(FALSE);
+
+ Verify that READ is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R909_start (bool only_format)
+{
+ ffestvUnit unit;
+ ffestvFormat format;
+ bool rec;
+ bool key;
+ ffestpReadIx keyn;
+ ffestpReadIx spec1;
+ ffestpReadIx spec2;
+
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ if (!ffestc_subr_is_format_
+ (&ffestp_file.read.read_spec[FFESTP_readixFORMAT]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ format = ffestc_subr_format_
+ (&ffestp_file.read.read_spec[FFESTP_readixFORMAT]);
+ ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+ if (only_format)
+ {
+ ffestd_R909_start (TRUE, FFESTV_unitNONE, format, FALSE, FALSE);
+
+ ffestc_ok_ = TRUE;
+ return;
+ }
+
+ if (!ffestc_subr_is_branch_
+ (&ffestp_file.read.read_spec[FFESTP_readixEOR])
+ || !ffestc_subr_is_branch_
+ (&ffestp_file.read.read_spec[FFESTP_readixERR])
+ || !ffestc_subr_is_branch_
+ (&ffestp_file.read.read_spec[FFESTP_readixEND]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ unit = ffestc_subr_unit_
+ (&ffestp_file.read.read_spec[FFESTP_readixUNIT]);
+ if (unit == FFESTV_unitNONE)
+ {
+ ffebad_start (FFEBAD_NO_UNIT_SPEC);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ rec = ffestp_file.read.read_spec[FFESTP_readixREC].kw_or_val_present;
+
+ if (ffestp_file.read.read_spec[FFESTP_readixKEYEQ].kw_or_val_present)
+ {
+ key = TRUE;
+ keyn = spec1 = FFESTP_readixKEYEQ;
+ }
+ else
+ {
+ key = FALSE;
+ keyn = spec1 = FFESTP_readix;
+ }
+
+ if (ffestp_file.read.read_spec[FFESTP_readixKEYGT].kw_or_val_present)
+ {
+ if (key)
+ {
+ spec2 = FFESTP_readixKEYGT;
+ whine: /* :::::::::::::::::::: */
+ ffebad_start (FFEBAD_CONFLICTING_SPECS);
+ assert (ffestp_file.read.read_spec[spec1].kw_or_val_present);
+ if (ffestp_file.read.read_spec[spec1].kw_present)
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.read.read_spec[spec1].kw),
+ ffelex_token_where_column
+ (ffestp_file.read.read_spec[spec1].kw));
+ }
+ else
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.read.read_spec[spec1].value),
+ ffelex_token_where_column
+ (ffestp_file.read.read_spec[spec1].value));
+ }
+ assert (ffestp_file.read.read_spec[spec2].kw_or_val_present);
+ if (ffestp_file.read.read_spec[spec2].kw_present)
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.read.read_spec[spec2].kw),
+ ffelex_token_where_column
+ (ffestp_file.read.read_spec[spec2].kw));
+ }
+ else
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.read.read_spec[spec2].value),
+ ffelex_token_where_column
+ (ffestp_file.read.read_spec[spec2].value));
+ }
+ ffebad_finish ();
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ key = TRUE;
+ keyn = spec1 = FFESTP_readixKEYGT;
+ }
+
+ if (ffestp_file.read.read_spec[FFESTP_readixKEYGE].kw_or_val_present)
+ {
+ if (key)
+ {
+ spec2 = FFESTP_readixKEYGT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ key = TRUE;
+ keyn = FFESTP_readixKEYGT;
+ }
+
+ if (rec)
+ {
+ spec1 = FFESTP_readixREC;
+ if (key)
+ {
+ spec2 = keyn;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (unit == FFESTV_unitCHAREXPR)
+ {
+ spec2 = FFESTP_readixUNIT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if ((format == FFESTV_formatASTERISK)
+ || (format == FFESTV_formatNAMELIST))
+ {
+ spec2 = FFESTP_readixFORMAT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixADVANCE;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixEND].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixEND;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixNULLS;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ }
+ else if (key)
+ {
+ spec1 = keyn;
+ if (unit == FFESTV_unitCHAREXPR)
+ {
+ spec2 = FFESTP_readixUNIT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if ((format == FFESTV_formatASTERISK)
+ || (format == FFESTV_formatNAMELIST))
+ {
+ spec2 = FFESTP_readixFORMAT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixADVANCE;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixEND].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixEND;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixEOR].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixEOR;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixNULLS;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixREC].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixREC;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixSIZE].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixSIZE;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ }
+ else
+ { /* Sequential/Internal. */
+ if (unit == FFESTV_unitCHAREXPR)
+ { /* Internal file. */
+ spec1 = FFESTP_readixUNIT;
+ if (format == FFESTV_formatNAMELIST)
+ {
+ spec2 = FFESTP_readixFORMAT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
+ {
+ spec2 = FFESTP_readixADVANCE;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
+ { /* ADVANCE= specified. */
+ spec1 = FFESTP_readixADVANCE;
+ if (format == FFESTV_formatNONE)
+ {
+ ffebad_start (FFEBAD_MISSING_FORMAT_SPEC);
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.read.read_spec[spec1].kw),
+ ffelex_token_where_column
+ (ffestp_file.read.read_spec[spec1].kw));
+ ffebad_finish ();
+
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ if (format == FFESTV_formatNAMELIST)
+ {
+ spec2 = FFESTP_readixFORMAT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixEOR].kw_or_val_present)
+ { /* EOR= specified. */
+ spec1 = FFESTP_readixEOR;
+ if (ffestc_subr_speccmp_ ("No",
+ &ffestp_file.read.read_spec[FFESTP_readixADVANCE],
+ NULL, NULL) != 0)
+ {
+ goto whine_advance; /* :::::::::::::::::::: */
+ }
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
+ { /* NULLS= specified. */
+ spec1 = FFESTP_readixNULLS;
+ if (format != FFESTV_formatASTERISK)
+ {
+ spec2 = FFESTP_readixFORMAT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ }
+ if (ffestp_file.read.read_spec[FFESTP_readixSIZE].kw_or_val_present)
+ { /* SIZE= specified. */
+ spec1 = FFESTP_readixSIZE;
+ if (ffestc_subr_speccmp_ ("No",
+ &ffestp_file.read.read_spec[FFESTP_readixADVANCE],
+ NULL, NULL) != 0)
+ {
+ whine_advance: /* :::::::::::::::::::: */
+ if (ffestp_file.read.read_spec[FFESTP_readixADVANCE]
+ .kw_or_val_present)
+ {
+ ffebad_start (FFEBAD_CONFLICTING_SPECS);
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.read.read_spec[spec1].kw),
+ ffelex_token_where_column
+ (ffestp_file.read.read_spec[spec1].kw));
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw),
+ ffelex_token_where_column
+ (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw));
+ ffebad_finish ();
+ }
+ else
+ {
+ ffebad_start (FFEBAD_MISSING_ADVANCE_SPEC);
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.read.read_spec[spec1].kw),
+ ffelex_token_where_column
+ (ffestp_file.read.read_spec[spec1].kw));
+ ffebad_finish ();
+ }
+
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ }
+ }
+
+ if (unit == FFESTV_unitCHAREXPR)
+ ffestc_iolist_context_ = FFEEXPR_contextIOLISTDF;
+ else
+ ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
+
+ ffestd_R909_start (FALSE, unit, format, rec, key);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R909_item -- READ statement i/o item
+
+ ffestc_R909_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_R909_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_namelist_ != 0)
+ {
+ if (ffestc_namelist_ == 1)
+ {
+ ffestc_namelist_ = 2;
+ ffebad_start (FFEBAD_NAMELIST_ITEMS);
+ ffebad_here (0, ffelex_token_where_line (expr_token),
+ ffelex_token_where_column (expr_token));
+ ffebad_finish ();
+ }
+ return;
+ }
+
+ ffestd_R909_item (expr, expr_token);
+}
+
+/* ffestc_R909_finish -- READ statement list complete
+
+ ffestc_R909_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R909_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R909_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R910_start -- WRITE(...) statement list begin
+
+ ffestc_R910_start();
+
+ Verify that WRITE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R910_start ()
+{
+ ffestvUnit unit;
+ ffestvFormat format;
+ bool rec;
+ ffestpWriteIx spec1;
+ ffestpWriteIx spec2;
+
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ if (!ffestc_subr_is_branch_
+ (&ffestp_file.write.write_spec[FFESTP_writeixEOR])
+ || !ffestc_subr_is_branch_
+ (&ffestp_file.write.write_spec[FFESTP_writeixERR])
+ || !ffestc_subr_is_format_
+ (&ffestp_file.write.write_spec[FFESTP_writeixFORMAT]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ format = ffestc_subr_format_
+ (&ffestp_file.write.write_spec[FFESTP_writeixFORMAT]);
+ ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+ unit = ffestc_subr_unit_
+ (&ffestp_file.write.write_spec[FFESTP_writeixUNIT]);
+ if (unit == FFESTV_unitNONE)
+ {
+ ffebad_start (FFEBAD_NO_UNIT_SPEC);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ rec = ffestp_file.write.write_spec[FFESTP_writeixREC].kw_or_val_present;
+
+ if (rec)
+ {
+ spec1 = FFESTP_writeixREC;
+ if (unit == FFESTV_unitCHAREXPR)
+ {
+ spec2 = FFESTP_writeixUNIT;
+ whine: /* :::::::::::::::::::: */
+ ffebad_start (FFEBAD_CONFLICTING_SPECS);
+ assert (ffestp_file.write.write_spec[spec1].kw_or_val_present);
+ if (ffestp_file.write.write_spec[spec1].kw_present)
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.write.write_spec[spec1].kw),
+ ffelex_token_where_column
+ (ffestp_file.write.write_spec[spec1].kw));
+ }
+ else
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.write.write_spec[spec1].value),
+ ffelex_token_where_column
+ (ffestp_file.write.write_spec[spec1].value));
+ }
+ assert (ffestp_file.write.write_spec[spec2].kw_or_val_present);
+ if (ffestp_file.write.write_spec[spec2].kw_present)
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.write.write_spec[spec2].kw),
+ ffelex_token_where_column
+ (ffestp_file.write.write_spec[spec2].kw));
+ }
+ else
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.write.write_spec[spec2].value),
+ ffelex_token_where_column
+ (ffestp_file.write.write_spec[spec2].value));
+ }
+ ffebad_finish ();
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ if ((format == FFESTV_formatASTERISK)
+ || (format == FFESTV_formatNAMELIST))
+ {
+ spec2 = FFESTP_writeixFORMAT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
+ {
+ spec2 = FFESTP_writeixADVANCE;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ }
+ else
+ { /* Sequential/Indexed/Internal. */
+ if (unit == FFESTV_unitCHAREXPR)
+ { /* Internal file. */
+ spec1 = FFESTP_writeixUNIT;
+ if (format == FFESTV_formatNAMELIST)
+ {
+ spec2 = FFESTP_writeixFORMAT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
+ {
+ spec2 = FFESTP_writeixADVANCE;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ }
+ if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
+ { /* ADVANCE= specified. */
+ spec1 = FFESTP_writeixADVANCE;
+ if (format == FFESTV_formatNONE)
+ {
+ ffebad_start (FFEBAD_MISSING_FORMAT_SPEC);
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.write.write_spec[spec1].kw),
+ ffelex_token_where_column
+ (ffestp_file.write.write_spec[spec1].kw));
+ ffebad_finish ();
+
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ if (format == FFESTV_formatNAMELIST)
+ {
+ spec2 = FFESTP_writeixFORMAT;
+ goto whine; /* :::::::::::::::::::: */
+ }
+ }
+ if (ffestp_file.write.write_spec[FFESTP_writeixEOR].kw_or_val_present)
+ { /* EOR= specified. */
+ spec1 = FFESTP_writeixEOR;
+ if (ffestc_subr_speccmp_ ("No",
+ &ffestp_file.write.write_spec[FFESTP_writeixADVANCE],
+ NULL, NULL) != 0)
+ {
+ if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE]
+ .kw_or_val_present)
+ {
+ ffebad_start (FFEBAD_CONFLICTING_SPECS);
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.write.write_spec[spec1].kw),
+ ffelex_token_where_column
+ (ffestp_file.write.write_spec[spec1].kw));
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw),
+ ffelex_token_where_column
+ (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw));
+ ffebad_finish ();
+ }
+ else
+ {
+ ffebad_start (FFEBAD_MISSING_ADVANCE_SPEC);
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.write.write_spec[spec1].kw),
+ ffelex_token_where_column
+ (ffestp_file.write.write_spec[spec1].kw));
+ ffebad_finish ();
+ }
+
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ }
+ }
+
+ if (unit == FFESTV_unitCHAREXPR)
+ ffestc_iolist_context_ = FFEEXPR_contextIOLISTDF;
+ else
+ ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
+
+ ffestd_R910_start (unit, format, rec);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R910_item -- WRITE statement i/o item
+
+ ffestc_R910_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_R910_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_namelist_ != 0)
+ {
+ if (ffestc_namelist_ == 1)
+ {
+ ffestc_namelist_ = 2;
+ ffebad_start (FFEBAD_NAMELIST_ITEMS);
+ ffebad_here (0, ffelex_token_where_line (expr_token),
+ ffelex_token_where_column (expr_token));
+ ffebad_finish ();
+ }
+ return;
+ }
+
+ ffestd_R910_item (expr, expr_token);
+}
+
+/* ffestc_R910_finish -- WRITE statement list complete
+
+ ffestc_R910_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R910_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R910_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R911_start -- PRINT(...) statement list begin
+
+ ffestc_R911_start();
+
+ Verify that PRINT is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R911_start ()
+{
+ ffestvFormat format;
+
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ if (!ffestc_subr_is_format_
+ (&ffestp_file.print.print_spec[FFESTP_printixFORMAT]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ format = ffestc_subr_format_
+ (&ffestp_file.print.print_spec[FFESTP_printixFORMAT]);
+ ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+ ffestd_R911_start (format);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R911_item -- PRINT statement i/o item
+
+ ffestc_R911_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_R911_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_namelist_ != 0)
+ {
+ if (ffestc_namelist_ == 1)
+ {
+ ffestc_namelist_ = 2;
+ ffebad_start (FFEBAD_NAMELIST_ITEMS);
+ ffebad_here (0, ffelex_token_where_line (expr_token),
+ ffelex_token_where_column (expr_token));
+ ffebad_finish ();
+ }
+ return;
+ }
+
+ ffestd_R911_item (expr, expr_token);
+}
+
+/* ffestc_R911_finish -- PRINT statement list complete
+
+ ffestc_R911_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R911_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R911_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R919 -- BACKSPACE statement
+
+ ffestc_R919();
+
+ Make sure a BACKSPACE is valid in the current context, and implement it. */
+
+void
+ffestc_R919 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+ && ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+ ffestd_R919 ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R920 -- ENDFILE statement
+
+ ffestc_R920();
+
+ Make sure a ENDFILE is valid in the current context, and implement it. */
+
+void
+ffestc_R920 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+ && ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+ ffestd_R920 ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R921 -- REWIND statement
+
+ ffestc_R921();
+
+ Make sure a REWIND is valid in the current context, and implement it. */
+
+void
+ffestc_R921 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+ && ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+ ffestd_R921 ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R923A -- INQUIRE statement (non-IOLENGTH version)
+
+ ffestc_R923A();
+
+ Make sure an INQUIRE is valid in the current context, and implement it. */
+
+void
+ffestc_R923A ()
+{
+ bool by_file;
+ bool by_unit;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.inquire.inquire_spec[FFESTP_inquireixERR]))
+ {
+ by_file = ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE]
+ .kw_or_val_present;
+ by_unit = ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT]
+ .kw_or_val_present;
+ if (by_file && by_unit)
+ {
+ ffebad_start (FFEBAD_CONFLICTING_SPECS);
+ assert (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present);
+ if (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present)
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw),
+ ffelex_token_where_column
+ (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw));
+ }
+ else
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value),
+ ffelex_token_where_column
+ (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value));
+ }
+ assert (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw_or_val_present);
+ if (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw_present)
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw),
+ ffelex_token_where_column
+ (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw));
+ }
+ else
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].value),
+ ffelex_token_where_column
+ (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].value));
+ }
+ ffebad_finish ();
+ }
+ else if (!by_file && !by_unit)
+ {
+ ffebad_start (FFEBAD_MISSING_SPECIFIER);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_string ("UNIT= or FILE=");
+ ffebad_finish ();
+ }
+ else
+ ffestd_R923A (by_file);
+ }
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
+
+ ffestc_R923B_start();
+
+ Verify that INQUIRE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_R923B_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_R923B_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R923B_item -- INQUIRE statement i/o item
+
+ ffestc_R923B_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_R923B_item (ffebld expr, ffelexToken expr_token UNUSED)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R923B_item (expr);
+}
+
+/* ffestc_R923B_finish -- INQUIRE statement list complete
+
+ ffestc_R923B_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R923B_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R923B_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R1001 -- FORMAT statement
+
+ ffestc_R1001(format_list);
+
+ Make sure format_list is valid. Update label's info to indicate it is a
+ FORMAT label, and (perhaps) warn if there is no label! */
+
+void
+ffestc_R1001 (ffesttFormatList f)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_format_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_format_ ();
+
+ ffestd_R1001 (f);
+}
+
+/* ffestc_R1102 -- PROGRAM statement
+
+ ffestc_R1102(name_token);
+
+ Make sure ffestc_kind_ identifies an empty block. Make sure name_token
+ gives a valid name. Implement the beginning of a main program. */
+
+void
+ffestc_R1102 (ffelexToken name)
+{
+ ffestw b;
+ ffesymbol s;
+
+ assert (name != NULL);
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_unit_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestc_blocknum_ = 0;
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_statePROGRAM0);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_end_program_);
+
+ ffestw_set_name (b, ffelex_token_use (name));
+
+ s = ffesymbol_declare_programunit (name,
+ ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindPROGRAM,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ ffesymbol_error (s, name);
+
+ ffestd_R1102 (s, name);
+}
+
+/* ffestc_R1103 -- END PROGRAM statement
+
+ ffestc_R1103(name_token);
+
+ Make sure ffestc_kind_ identifies the current kind of program unit. If not
+ NULL, make sure name_token gives the correct name. Implement the end
+ of the current program unit. */
+
+void
+ffestc_R1103 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_program_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ if (name != NULL)
+ {
+ if (ffestw_name (ffestw_stack_top ()) == NULL)
+ {
+ ffebad_start (FFEBAD_PROGRAM_NOT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
+ {
+ ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+ }
+
+ ffestc_shriek_end_program_ (TRUE);
+}
+
+/* ffestc_R1105 -- MODULE statement
+
+ ffestc_R1105(name_token);
+
+ Make sure ffestc_kind_ identifies an empty block. Make sure name_token
+ gives a valid name. Implement the beginning of a module. */
+
+#if FFESTR_F90
+void
+ffestc_R1105 (ffelexToken name)
+{
+ ffestw b;
+
+ assert (name != NULL);
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_unit_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestc_blocknum_ = 0;
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateMODULE0);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_module_);
+ ffestw_set_name (b, ffelex_token_use (name));
+
+ ffestd_R1105 (name);
+}
+
+/* ffestc_R1106 -- END MODULE statement
+
+ ffestc_R1106(name_token);
+
+ Make sure ffestc_kind_ identifies the current kind of program unit. If not
+ NULL, make sure name_token gives the correct name. Implement the end
+ of the current program unit. */
+
+void
+ffestc_R1106 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_module_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if ((name != NULL)
+ && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+ {
+ ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+
+ ffestc_shriek_module_ (TRUE);
+}
+
+/* ffestc_R1107_start -- USE statement list begin
+
+ ffestc_R1107_start();
+
+ Verify that USE is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R1107_start (ffelexToken name, bool only)
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_use_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R1107_start (name, only);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1107_item -- USE statement for name
+
+ ffestc_R1107_item(local_token,use_token);
+
+ Make sure name_token identifies a valid object to be USEed. local_token
+ may be NULL if _start_ was called with only==TRUE. */
+
+void
+ffestc_R1107_item (ffelexToken local, ffelexToken use)
+{
+ ffestc_check_item_ ();
+ assert (use != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R1107_item (local, use);
+}
+
+/* ffestc_R1107_finish -- USE statement list complete
+
+ ffestc_R1107_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R1107_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R1107_finish ();
+}
+
+#endif
+/* ffestc_R1111 -- BLOCK DATA statement
+
+ ffestc_R1111(name_token);
+
+ Make sure ffestc_kind_ identifies no current program unit. If not
+ NULL, make sure name_token gives a valid name. Implement the beginning
+ of a block data program unit. */
+
+void
+ffestc_R1111 (ffelexToken name)
+{
+ ffestw b;
+ ffesymbol s;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_unit_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestc_blocknum_ = 0;
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateBLOCKDATA0);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_blockdata_);
+
+ if (name == NULL)
+ ffestw_set_name (b, NULL);
+ else
+ ffestw_set_name (b, ffelex_token_use (name));
+
+ s = ffesymbol_declare_blockdataunit (name,
+ ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindBLOCKDATA,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ ffesymbol_error (s, name);
+
+ ffestd_R1111 (s, name);
+}
+
+/* ffestc_R1112 -- END BLOCK DATA statement
+
+ ffestc_R1112(name_token);
+
+ Make sure ffestc_kind_ identifies the current kind of program unit. If not
+ NULL, make sure name_token gives the correct name. Implement the end
+ of the current program unit. */
+
+void
+ffestc_R1112 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_blockdata_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (name != NULL)
+ {
+ if (ffestw_name (ffestw_stack_top ()) == NULL)
+ {
+ ffebad_start (FFEBAD_BLOCKDATA_NOT_NAMED);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+ else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
+ {
+ ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+ }
+
+ ffestc_shriek_blockdata_ (TRUE);
+}
+
+/* ffestc_R1202 -- INTERFACE statement
+
+ ffestc_R1202(operator,defined_name);
+
+ Make sure ffestc_kind_ identifies an INTERFACE block.
+ Implement the end of the current interface.
+
+ 15-May-90 JCB 1.1
+ Allow no operator or name to mean INTERFACE by itself; missed this
+ valid form when originally doing syntactic analysis code. */
+
+#if FFESTR_F90
+void
+ffestc_R1202 (ffestpDefinedOperator operator, ffelexToken name)
+{
+ ffestw b;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_interfacespec_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateINTERFACE0);
+ ffestw_set_blocknum (b, 0);
+ ffestw_set_shriek (b, ffestc_shriek_interface_);
+
+ if ((operator == FFESTP_definedoperatorNone) && (name == NULL))
+ ffestw_set_substate (b, 0); /* No generic-spec, so disallow MODULE
+ PROCEDURE. */
+ else
+ ffestw_set_substate (b, 1); /* MODULE PROCEDURE ok. */
+
+ ffestd_R1202 (operator, name);
+
+ ffe_init_4 ();
+}
+
+/* ffestc_R1203 -- END INTERFACE statement
+
+ ffestc_R1203();
+
+ Make sure ffestc_kind_ identifies an INTERFACE block.
+ Implement the end of the current interface. */
+
+void
+ffestc_R1203 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_interface_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestc_shriek_interface_ (TRUE);
+
+ ffe_terminate_4 ();
+}
+
+/* ffestc_R1205_start -- MODULE PROCEDURE statement list begin
+
+ ffestc_R1205_start();
+
+ Verify that MODULE PROCEDURE is valid here, and begin accepting items in
+ the list. */
+
+void
+ffestc_R1205_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_interface_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) == 0)
+ {
+ ffebad_start (FFEBAD_INVALID_MODULE_PROCEDURE);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateINTERFACE0)
+ {
+ ffestw_update (NULL); /* Update state line/col info. */
+ ffestw_set_state (ffestw_stack_top (), FFESTV_stateINTERFACE1);
+ }
+
+ ffestd_R1205_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1205_item -- MODULE PROCEDURE statement for name
+
+ ffestc_R1205_item(name_token);
+
+ Make sure name_token identifies a valid object to be MODULE PROCEDUREed. */
+
+void
+ffestc_R1205_item (ffelexToken name)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R1205_item (name);
+}
+
+/* ffestc_R1205_finish -- MODULE PROCEDURE statement list complete
+
+ ffestc_R1205_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R1205_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R1205_finish ();
+}
+
+#endif
+/* ffestc_R1207_start -- EXTERNAL statement list begin
+
+ ffestc_R1207_start();
+
+ Verify that EXTERNAL is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R1207_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R1207_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1207_item -- EXTERNAL statement for name
+
+ ffestc_R1207_item(name_token);
+
+ Make sure name_token identifies a valid object to be EXTERNALd. */
+
+void
+ffestc_R1207_item (ffelexToken name)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ s = ffesymbol_declare_local (name, FALSE);
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!ffesymbol_is_specable (s))
+ na = FFESYMBOL_attrsetNONE; /* Can't dcl sym ref'd in sfuncdef. */
+ else if (sa & FFESYMBOL_attrsANY)
+ na = FFESYMBOL_attrsANY;
+ else if (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsEXTERNAL;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, name);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_set_explicitwhere (s, TRUE);
+ ffesymbol_reference (s, name, FALSE);
+ ffesymbol_signal_unreported (s);
+ }
+
+ ffestd_R1207_item (name);
+}
+
+/* ffestc_R1207_finish -- EXTERNAL statement list complete
+
+ ffestc_R1207_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R1207_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R1207_finish ();
+}
+
+/* ffestc_R1208_start -- INTRINSIC statement list begin
+
+ ffestc_R1208_start();
+
+ Verify that INTRINSIC is valid here, and begin accepting items in the list. */
+
+void
+ffestc_R1208_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R1208_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1208_item -- INTRINSIC statement for name
+
+ ffestc_R1208_item(name_token);
+
+ Make sure name_token identifies a valid object to be INTRINSICd. */
+
+void
+ffestc_R1208_item (ffelexToken name)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffeintrinGen gen;
+ ffeintrinSpec spec;
+ ffeintrinImp imp;
+
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ s = ffesymbol_declare_local (name, TRUE);
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!ffesymbol_is_specable (s))
+ na = FFESYMBOL_attrsetNONE; /* Can't dcl sym ref'd in sfuncdef. */
+ else if (sa & FFESYMBOL_attrsANY)
+ na = sa;
+ else if (!(sa & ~FFESYMBOL_attrsTYPE))
+ {
+ if (ffeintrin_is_intrinsic (ffelex_token_text (name), name, TRUE,
+ &gen, &spec, &imp)
+ && ((imp == FFEINTRIN_impNONE)
+#if 0 /* Don't bother with this for now. */
+ || ((ffeintrin_basictype (spec)
+ == ffesymbol_basictype (s))
+ && (ffeintrin_kindtype (spec)
+ == ffesymbol_kindtype (s)))
+#else
+ || 1
+#endif
+ || !(sa & FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsINTRINSIC;
+ else
+ na = FFESYMBOL_attrsetNONE;
+ }
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, name);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_generic (s, gen);
+ ffesymbol_set_specific (s, spec);
+ ffesymbol_set_implementation (s, imp);
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereINTRINSIC,
+ ffesymbol_size (s)));
+ ffesymbol_set_explicitwhere (s, TRUE);
+ ffesymbol_reference (s, name, TRUE);
+ }
+
+ ffesymbol_signal_unreported (s);
+
+ ffestd_R1208_item (name);
+}
+
+/* ffestc_R1208_finish -- INTRINSIC statement list complete
+
+ ffestc_R1208_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_R1208_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_R1208_finish ();
+}
+
+/* ffestc_R1212 -- CALL statement
+
+ ffestc_R1212(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestc_R1212 (ffebld expr, ffelexToken expr_token UNUSED)
+{
+ ffebld item; /* ITEM. */
+ ffebld labexpr; /* LABTOK=>LABTER. */
+ ffelab label;
+ bool ok; /* TRUE if all LABTOKs were ok. */
+ bool ok1; /* TRUE if a particular LABTOK is ok. */
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffebld_op (expr) != FFEBLD_opSUBRREF)
+ ffestd_R841 (FALSE); /* CONTINUE. */
+ else
+ {
+ ok = TRUE;
+
+ for (item = ffebld_right (expr);
+ item != NULL;
+ item = ffebld_trail (item))
+ {
+ if (((labexpr = ffebld_head (item)) != NULL)
+ && (ffebld_op (labexpr) == FFEBLD_opLABTOK))
+ {
+ ok1 = ffestc_labelref_is_branch_ (ffebld_labtok (labexpr),
+ &label);
+ ffelex_token_kill (ffebld_labtok (labexpr));
+ if (!ok1)
+ {
+ label = NULL;
+ ok = FALSE;
+ }
+ ffebld_set_op (labexpr, FFEBLD_opLABTER);
+ ffebld_set_labter (labexpr, label);
+ }
+ }
+
+ if (ok)
+ ffestd_R1212 (expr);
+ }
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R1213 -- Defined assignment statement
+
+ ffestc_R1213(dest_expr,source_expr,source_token);
+
+ Make sure the assignment is valid. */
+
+#if FFESTR_F90
+void
+ffestc_R1213 (ffebld dest, ffebld source, ffelexToken source_token)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_R1213 (dest, source);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_R1219 -- FUNCTION statement
+
+ ffestc_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
+ recursive);
+
+ Make sure statement is valid here, register arguments for the
+ function name, and so on.
+
+ 06-Apr-90 JCB 2.0
+ Added the kind, len, and recursive arguments. */
+
+void
+ffestc_R1219 (ffelexToken funcname, ffesttTokenList args,
+ ffelexToken final UNUSED, ffestpType type, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent,
+ ffelexToken recursive, ffelexToken result)
+{
+ ffestw b;
+ ffesymbol s;
+ ffesymbol fs; /* FUNCTION symbol when dealing with RESULT
+ symbol. */
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffelexToken res;
+ bool separate_result;
+
+ assert ((funcname != NULL)
+ && (ffelex_token_type (funcname) == FFELEX_typeNAME));
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_iface_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestc_blocknum_ = 0;
+ ffesta_is_entry_valid =
+ (ffestw_state (ffestw_stack_top ()) == FFESTV_stateNIL);
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateFUNCTION0);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_function_);
+ ffestw_set_name (b, ffelex_token_use (funcname));
+
+ if (type == FFESTP_typeNone)
+ {
+ ffestc_local_.decl.basic_type = FFEINFO_basictypeNONE;
+ ffestc_local_.decl.kind_type = FFEINFO_kindtypeNONE;
+ ffestc_local_.decl.size = FFETARGET_charactersizeNONE;
+ }
+ else
+ {
+ ffestc_establish_declstmt_ (type, ffesta_tokens[0],
+ kind, kindt, len, lent);
+ ffestc_establish_declinfo_ (NULL, NULL, NULL, NULL);
+ }
+
+ separate_result = (result != NULL)
+ && (ffelex_token_strcmp (funcname, result) != 0);
+
+ if (separate_result)
+ fs = ffesymbol_declare_funcnotresunit (funcname); /* Global/local. */
+ else
+ fs = ffesymbol_declare_funcunit (funcname); /* Global only. */
+
+ if (ffesymbol_state (fs) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (fs, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_signal_unreported (fs);
+
+ /* Note that .basic_type and .kind_type might be NONE here. */
+
+ ffesymbol_set_info (fs,
+ ffeinfo_new (ffestc_local_.decl.basic_type,
+ ffestc_local_.decl.kind_type,
+ 0,
+ FFEINFO_kindFUNCTION,
+ FFEINFO_whereLOCAL,
+ ffestc_local_.decl.size));
+
+ /* Check whether the type info fits the filewide expectations;
+ set ok flag accordingly. */
+
+ ffesymbol_reference (fs, funcname, FALSE);
+ if (ffesymbol_attrs (fs) & FFESYMBOL_attrsANY)
+ ffestc_parent_ok_ = FALSE;
+ else
+ ffestc_parent_ok_ = TRUE;
+ }
+ else
+ {
+ if (ffesymbol_kind (fs) != FFEINFO_kindANY)
+ ffesymbol_error (fs, funcname);
+ ffestc_parent_ok_ = FALSE;
+ }
+
+ if (ffestc_parent_ok_)
+ {
+ ffebld_init_list (&fs->dummy_args, &ffestc_local_.dummy.list_bottom);
+ ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
+ ffebld_end_list (&ffestc_local_.dummy.list_bottom);
+ }
+
+ if (result == NULL)
+ res = funcname;
+ else
+ res = result;
+
+ s = ffesymbol_declare_funcresult (res);
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (sa & FFESYMBOL_attrsANY)
+ na = FFESYMBOL_attrsANY;
+ else if (ffesymbol_state (s) != FFESYMBOL_stateNONE)
+ na = FFESYMBOL_attrsetNONE;
+ else
+ {
+ na = FFESYMBOL_attrsRESULT;
+ if (ffestc_local_.decl.basic_type != FFEINFO_basictypeNONE)
+ {
+ na |= FFESYMBOL_attrsTYPE;
+ if ((ffestc_local_.decl.basic_type == FFEINFO_basictypeCHARACTER)
+ && (ffestc_local_.decl.size == FFETARGET_charactersizeNONE))
+ na |= FFESYMBOL_attrsANYLEN;
+ }
+ }
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if ((na & ~FFESYMBOL_attrsANY) == FFESYMBOL_attrsetNONE)
+ {
+ if (!(na & FFESYMBOL_attrsANY))
+ ffesymbol_error (s, res);
+ ffesymbol_set_funcresult (fs, NULL);
+ ffesymbol_set_funcresult (s, NULL);
+ ffestc_parent_ok_ = FALSE;
+ }
+ else
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ ffesymbol_set_funcresult (fs, s);
+ ffesymbol_set_funcresult (s, fs);
+ if (ffestc_local_.decl.basic_type != FFEINFO_basictypeNONE)
+ {
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffestc_local_.decl.basic_type,
+ ffestc_local_.decl.kind_type,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereNONE,
+ ffestc_local_.decl.size));
+ }
+ }
+
+ ffesymbol_signal_unreported (fs);
+
+ ffestd_R1219 (fs, funcname, args, type, kind, kindt, len, lent,
+ (recursive != NULL), result, separate_result);
+}
+
+/* ffestc_R1221 -- END FUNCTION statement
+
+ ffestc_R1221(name_token);
+
+ Make sure ffestc_kind_ identifies the current kind of program unit. If
+ not NULL, make sure name_token gives the correct name. Implement the end
+ of the current program unit. */
+
+void
+ffestc_R1221 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_function_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ if ((name != NULL)
+ && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+ {
+ ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+
+ ffestc_shriek_function_ (TRUE);
+}
+
+/* ffestc_R1223 -- SUBROUTINE statement
+
+ ffestc_R1223(subrname,arglist,ending_token,recursive_token);
+
+ Make sure statement is valid here, register arguments for the
+ subroutine name, and so on.
+
+ 06-Apr-90 JCB 2.0
+ Added the recursive argument. */
+
+void
+ffestc_R1223 (ffelexToken subrname, ffesttTokenList args,
+ ffelexToken final, ffelexToken recursive)
+{
+ ffestw b;
+ ffesymbol s;
+
+ assert ((subrname != NULL)
+ && (ffelex_token_type (subrname) == FFELEX_typeNAME));
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_iface_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestc_blocknum_ = 0;
+ ffesta_is_entry_valid
+ = (ffestw_state (ffestw_stack_top ()) == FFESTV_stateNIL);
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateSUBROUTINE0);
+ ffestw_set_blocknum (b, ffestc_blocknum_++);
+ ffestw_set_shriek (b, ffestc_shriek_subroutine_);
+ ffestw_set_name (b, ffelex_token_use (subrname));
+
+ s = ffesymbol_declare_subrunit (subrname);
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindSUBROUTINE,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ ffestc_parent_ok_ = TRUE;
+ }
+ else
+ {
+ if (ffesymbol_kind (s) != FFEINFO_kindANY)
+ ffesymbol_error (s, subrname);
+ ffestc_parent_ok_ = FALSE;
+ }
+
+ if (ffestc_parent_ok_)
+ {
+ ffebld_init_list (&s->dummy_args, &ffestc_local_.dummy.list_bottom);
+ ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
+ ffebld_end_list (&ffestc_local_.dummy.list_bottom);
+ }
+
+ ffesymbol_signal_unreported (s);
+
+ ffestd_R1223 (s, subrname, args, final, (recursive != NULL));
+}
+
+/* ffestc_R1225 -- END SUBROUTINE statement
+
+ ffestc_R1225(name_token);
+
+ Make sure ffestc_kind_ identifies the current kind of program unit. If
+ not NULL, make sure name_token gives the correct name. Implement the end
+ of the current program unit. */
+
+void
+ffestc_R1225 (ffelexToken name)
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_subroutine_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_ ();
+
+ if ((name != NULL)
+ && (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0))
+ {
+ ffebad_start (FFEBAD_UNIT_WRONG_NAME);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_here (1, ffelex_token_where_line (ffestw_name (ffestw_stack_top ())),
+ ffelex_token_where_column (ffestw_name (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+
+ ffestc_shriek_subroutine_ (TRUE);
+}
+
+/* ffestc_R1226 -- ENTRY statement
+
+ ffestc_R1226(entryname,arglist,ending_token);
+
+ Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the
+ entry point name, and so on. */
+
+void
+ffestc_R1226 (ffelexToken entryname, ffesttTokenList args,
+ ffelexToken final UNUSED)
+{
+ ffesymbol s;
+ ffesymbol fs;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ bool in_spec; /* TRUE if further specification statements
+ may follow, FALSE if executable stmts. */
+ bool in_func; /* TRUE if ENTRY is a FUNCTION, not
+ SUBROUTINE. */
+
+ assert ((entryname != NULL)
+ && (ffelex_token_type (entryname) == FFELEX_typeNAME));
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_entry_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateFUNCTION1:
+ case FFESTV_stateFUNCTION2:
+ case FFESTV_stateFUNCTION3:
+ in_func = TRUE;
+ in_spec = TRUE;
+ break;
+
+ case FFESTV_stateFUNCTION4:
+ in_func = TRUE;
+ in_spec = FALSE;
+ break;
+
+ case FFESTV_stateSUBROUTINE1:
+ case FFESTV_stateSUBROUTINE2:
+ case FFESTV_stateSUBROUTINE3:
+ in_func = FALSE;
+ in_spec = TRUE;
+ break;
+
+ case FFESTV_stateSUBROUTINE4:
+ in_func = FALSE;
+ in_spec = FALSE;
+ break;
+
+ default:
+ assert ("ENTRY not in FUNCTION or SUBROUTINE?" == NULL);
+ in_func = FALSE;
+ in_spec = FALSE;
+ break;
+ }
+
+ if (in_func)
+ fs = ffesymbol_declare_funcunit (entryname);
+ else
+ fs = ffesymbol_declare_subrunit (entryname);
+
+ if (ffesymbol_state (fs) == FFESYMBOL_stateNONE)
+ ffesymbol_set_state (fs, FFESYMBOL_stateUNDERSTOOD);
+ else
+ {
+ if (ffesymbol_kind (fs) != FFEINFO_kindANY)
+ ffesymbol_error (fs, entryname);
+ }
+
+ ++ffestc_entry_num_;
+
+ ffebld_init_list (&fs->dummy_args, &ffestc_local_.dummy.list_bottom);
+ if (in_spec)
+ ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
+ else
+ ffestt_tokenlist_drive (args, ffestc_promote_execdummy_);
+ ffebld_end_list (&ffestc_local_.dummy.list_bottom);
+
+ if (in_func)
+ {
+ s = ffesymbol_declare_funcresult (entryname);
+ ffesymbol_set_funcresult (fs, s);
+ ffesymbol_set_funcresult (s, fs);
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous
+ declarations of or references to the object. */
+
+ if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+ na = FFESYMBOL_attrsetNONE;
+ else if (sa & FFESYMBOL_attrsANY)
+ na = FFESYMBOL_attrsANY;
+ else if (!(sa & ~(FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsTYPE)))
+ na = sa | FFESYMBOL_attrsRESULT;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error
+ cropped up; ANY means an old error to be ignored; otherwise,
+ everything's ok, update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ {
+ ffesymbol_error (s, entryname);
+ ffestc_parent_ok_ = FALSE;
+ }
+ else if (na & FFESYMBOL_attrsANY)
+ {
+ ffestc_parent_ok_ = FALSE;
+ }
+ else
+ {
+ ffesymbol_set_attrs (s, na);
+ if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ else if (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN)
+ {
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereRESULT,
+ ffesymbol_size (s)));
+ ffesymbol_resolve_intrin (s);
+ ffestorag_exec_layout (s);
+ }
+ }
+
+ /* Since ENTRY might appear after executable stmts, do what would have
+ been done if it hadn't -- give symbol implicit type and
+ exec-transition it. */
+
+ if (!in_spec && ffesymbol_is_specable (s))
+ {
+ if (!ffeimplic_establish_symbol (s)) /* Do implicit typing. */
+ ffesymbol_error (s, entryname);
+ s = ffecom_sym_exec_transition (s);
+ }
+
+ /* Use whatever type info is available for ENTRY to set up type for its
+ global-name-space function symbol relative. */
+
+ ffesymbol_set_info (fs,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ 0,
+ FFEINFO_kindFUNCTION,
+ FFEINFO_whereLOCAL,
+ ffesymbol_size (s)));
+
+
+ /* Check whether the type info fits the filewide expectations;
+ set ok flag accordingly. */
+
+ ffesymbol_reference (fs, entryname, FALSE);
+
+ /* ~~Question??:
+ When ENTRY FOO() RESULT(IBAR) is supported, what will the typing be
+ if FOO and IBAR would normally end up with different types? I think
+ the answer is that FOO is always given whatever type would be chosen
+ for IBAR, rather than the other way around, and I think it ends up
+ working that way for FUNCTION FOO() RESULT(IBAR), but this should be
+ checked out in all its different combos. Related question is, is
+ there any way that FOO in either case ends up without type info
+ filled in? Does anyone care? */
+
+ ffesymbol_signal_unreported (s);
+ }
+ else
+ {
+ ffesymbol_set_info (fs,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindSUBROUTINE,
+ FFEINFO_whereLOCAL,
+ FFETARGET_charactersizeNONE));
+ }
+
+ if (!in_spec)
+ fs = ffecom_sym_exec_transition (fs);
+
+ ffesymbol_signal_unreported (fs);
+
+ ffestd_R1226 (fs);
+}
+
+/* ffestc_R1227 -- RETURN statement
+
+ ffestc_R1227(expr,expr_token);
+
+ Make sure statement is valid here; implement. expr and expr_token are
+ both NULL if there was no expression. */
+
+void
+ffestc_R1227 (ffebld expr, ffelexToken expr_token)
+{
+ ffestw b;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_notloop_begin_ ();
+
+ for (b = ffestw_stack_top (); ; b = ffestw_previous (b))
+ {
+ switch (ffestw_state (b))
+ {
+ case FFESTV_statePROGRAM4:
+ case FFESTV_stateSUBROUTINE4:
+ case FFESTV_stateFUNCTION4:
+ goto base; /* :::::::::::::::::::: */
+
+ case FFESTV_stateNIL:
+ assert ("bad state" == NULL);
+ break;
+
+ default:
+ break;
+ }
+ }
+
+ base:
+ switch (ffestw_state (b))
+ {
+ case FFESTV_statePROGRAM4:
+ if (ffe_is_pedantic ())
+ {
+ ffebad_start (FFEBAD_RETURN_IN_MAIN);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+ if (expr != NULL)
+ {
+ ffebad_start (FFEBAD_ALTRETURN_IN_PROGRAM);
+ ffebad_here (0, ffelex_token_where_line (expr_token),
+ ffelex_token_where_column (expr_token));
+ ffebad_finish ();
+ expr = NULL;
+ }
+ break;
+
+ case FFESTV_stateSUBROUTINE4:
+ break;
+
+ case FFESTV_stateFUNCTION4:
+ if (expr != NULL)
+ {
+ ffebad_start (FFEBAD_ALTRETURN_IN_FUNCTION);
+ ffebad_here (0, ffelex_token_where_line (expr_token),
+ ffelex_token_where_column (expr_token));
+ ffebad_finish ();
+ expr = NULL;
+ }
+ break;
+
+ default:
+ assert ("bad state #2" == NULL);
+ break;
+ }
+
+ ffestd_R1227 (expr);
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+
+ /* notloop's that are actionif's can be the target of a loop-end
+ statement if they're in the "then" part of a logical IF, as
+ in "DO 10", "10 IF (...) RETURN". */
+
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_R1228 -- CONTAINS statement
+
+ ffestc_R1228(); */
+
+#if FFESTR_F90
+void
+ffestc_R1228 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_contains_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestd_R1228 ();
+
+ ffe_terminate_3 ();
+ ffe_init_3 ();
+}
+
+#endif
+/* ffestc_R1229_start -- STMTFUNCTION statement begin
+
+ ffestc_R1229_start(func_name,func_arg_list,close_paren);
+
+ Verify that STMTFUNCTION is valid here, establish func_arg_list in a new
+ "live" scope within the current scope, and expect the actual expression
+ (or NULL) in ffestc_R1229_finish. The reason there are two ffestc
+ functions to handle this is so the scope can be established, allowing
+ ffeexpr to assign proper characteristics to references to the dummy
+ arguments. */
+
+void
+ffestc_R1229_start (ffelexToken name, ffesttTokenList args,
+ ffelexToken final UNUSED)
+{
+ ffesymbol s;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+
+ ffestc_check_start_ ();
+ if (ffestc_order_sfunc_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ assert (name != NULL);
+ assert (args != NULL);
+
+ s = ffesymbol_declare_local (name, FALSE);
+ sa = ffesymbol_attrs (s);
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (!ffesymbol_is_specable (s))
+ na = FFESYMBOL_attrsetNONE; /* Can't dcl sym ref'd in sfuncdef. */
+ else if (sa & FFESYMBOL_attrsANY)
+ na = FFESYMBOL_attrsANY;
+ else if (!(sa & ~FFESYMBOL_attrsTYPE))
+ na = sa | FFESYMBOL_attrsSFUNC;
+ else
+ na = FFESYMBOL_attrsetNONE;
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ {
+ ffesymbol_error (s, name);
+ ffestc_parent_ok_ = FALSE;
+ }
+ else if (na & FFESYMBOL_attrsANY)
+ ffestc_parent_ok_ = FALSE;
+ else
+ {
+ ffesymbol_set_attrs (s, na);
+ ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+ if (!ffeimplic_establish_symbol (s)
+ || ((ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+ && (ffesymbol_size (s) == FFETARGET_charactersizeNONE)))
+ {
+ ffesymbol_error (s, ffesta_tokens[0]);
+ ffestc_parent_ok_ = FALSE;
+ }
+ else
+ {
+ /* Tell ffeexpr that sfunc def is in progress. */
+ ffesymbol_set_sfexpr (s, ffebld_new_any ());
+ ffestc_parent_ok_ = TRUE;
+ }
+ }
+
+ ffe_init_4 ();
+
+ if (ffestc_parent_ok_)
+ {
+ ffebld_init_list (&s->dummy_args, &ffestc_local_.dummy.list_bottom);
+ ffestc_sfdummy_argno_ = 0;
+ ffestt_tokenlist_drive (args, ffestc_promote_sfdummy_);
+ ffebld_end_list (&ffestc_local_.dummy.list_bottom);
+ }
+
+ ffestc_local_.sfunc.symbol = s;
+
+ ffestd_R1229_start (name, args);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_R1229_finish -- STMTFUNCTION statement list complete
+
+ ffestc_R1229_finish(expr,expr_token);
+
+ If expr is NULL, an error occurred parsing the expansion expression, so
+ just cancel the effects of ffestc_R1229_start and pretend nothing
+ happened. Otherwise, install the expression as the expansion for the
+ statement function named in _start_, then clean up. */
+
+void
+ffestc_R1229_finish (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_parent_ok_ && (expr != NULL))
+ ffesymbol_set_sfexpr (ffestc_local_.sfunc.symbol,
+ ffeexpr_convert_to_sym (expr,
+ expr_token,
+ ffestc_local_.sfunc.symbol,
+ ffesta_tokens[0]));
+
+ ffestd_R1229_finish (ffestc_local_.sfunc.symbol);
+
+ ffesymbol_signal_unreported (ffestc_local_.sfunc.symbol);
+
+ ffe_terminate_4 ();
+}
+
+/* ffestc_S3P4 -- INCLUDE line
+
+ ffestc_S3P4(filename,filename_token);
+
+ Make sure INCLUDE not preceded by any semicolons or a label def; implement. */
+
+void
+ffestc_S3P4 (ffebld filename, ffelexToken filename_token UNUSED)
+{
+ ffestc_check_simple_ ();
+ ffestc_labeldef_invalid_ ();
+
+ ffestd_S3P4 (filename);
+}
+
+/* ffestc_V003_start -- STRUCTURE statement list begin
+
+ ffestc_V003_start(structure_name);
+
+ Verify that STRUCTURE is valid here, and begin accepting items in the list. */
+
+#if FFESTR_VXT
+void
+ffestc_V003_start (ffelexToken structure_name)
+{
+ ffestw b;
+
+ ffestc_check_start_ ();
+ if (ffestc_order_vxtstructure_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateSTRUCTURE:
+ case FFESTV_stateMAP:
+ ffestc_local_.V003.list_state = 2; /* Require at least one field
+ name. */
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Seen at least one
+ member. */
+ break;
+
+ default:
+ ffestc_local_.V003.list_state = 0; /* No field names required. */
+ if (structure_name == NULL)
+ {
+ ffebad_start (FFEBAD_STRUCT_MISSING_NAME);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+ break;
+ }
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateSTRUCTURE);
+ ffestw_set_blocknum (b, 0);
+ ffestw_set_shriek (b, ffestc_shriek_structure_);
+ ffestw_set_substate (b, 0); /* No field-declarations seen yet. */
+
+ ffestd_V003_start (structure_name);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V003_item -- STRUCTURE statement for object-name
+
+ ffestc_V003_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be STRUCTUREd. */
+
+void
+ffestc_V003_item (ffelexToken name, ffesttDimList dims)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_local_.V003.list_state < 2)
+ {
+ if (ffestc_local_.V003.list_state == 0)
+ {
+ ffestc_local_.V003.list_state = 1;
+ ffebad_start (FFEBAD_STRUCT_IGNORING_FIELD);
+ ffebad_here (0, ffelex_token_where_line (name),
+ ffelex_token_where_column (name));
+ ffebad_finish ();
+ }
+ return;
+ }
+ ffestc_local_.V003.list_state = 3; /* Have at least one field name. */
+
+ if (dims != NULL)
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ ffestd_V003_item (name, dims);
+}
+
+/* ffestc_V003_finish -- STRUCTURE statement list complete
+
+ ffestc_V003_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V003_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_local_.V003.list_state == 2)
+ {
+ ffebad_start (FFEBAD_STRUCT_MISSING_FIELD);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_previous (ffestw_stack_top ())),
+ ffestw_col (ffestw_previous (ffestw_stack_top ())));
+ ffebad_finish ();
+ }
+
+ ffestd_V003_finish ();
+}
+
+/* ffestc_V004 -- END STRUCTURE statement
+
+ ffestc_V004();
+
+ Make sure ffestc_kind_ identifies a STRUCTURE block.
+ Implement the end of the current STRUCTURE block. */
+
+void
+ffestc_V004 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_structure_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) != 1)
+ {
+ ffebad_start (FFEBAD_STRUCT_NO_COMPONENTS);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+
+ ffestc_shriek_structure_ (TRUE);
+}
+
+/* ffestc_V009 -- UNION statement
+
+ ffestc_V009(); */
+
+void
+ffestc_V009 ()
+{
+ ffestw b;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_structure_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Seen at least one member. */
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateUNION);
+ ffestw_set_blocknum (b, 0);
+ ffestw_set_shriek (b, ffestc_shriek_union_);
+ ffestw_set_substate (b, 0); /* No map decls seen yet. */
+
+ ffestd_V009 ();
+}
+
+/* ffestc_V010 -- END UNION statement
+
+ ffestc_V010();
+
+ Make sure ffestc_kind_ identifies a UNION block.
+ Implement the end of the current UNION block. */
+
+void
+ffestc_V010 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_union_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) != 2)
+ {
+ ffebad_start (FFEBAD_UNION_NO_TWO_MAPS);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+
+ ffestc_shriek_union_ (TRUE);
+}
+
+/* ffestc_V012 -- MAP statement
+
+ ffestc_V012(); */
+
+void
+ffestc_V012 ()
+{
+ ffestw b;
+
+ ffestc_check_simple_ ();
+ if (ffestc_order_union_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) != 2)
+ ffestw_substate (ffestw_stack_top ())++; /* 0=>1, 1=>2. */
+
+ b = ffestw_update (ffestw_push (NULL));
+ ffestw_set_top_do (b, NULL);
+ ffestw_set_state (b, FFESTV_stateMAP);
+ ffestw_set_blocknum (b, 0);
+ ffestw_set_shriek (b, ffestc_shriek_map_);
+ ffestw_set_substate (b, 0); /* No field-declarations seen yet. */
+
+ ffestd_V012 ();
+}
+
+/* ffestc_V013 -- END MAP statement
+
+ ffestc_V013();
+
+ Make sure ffestc_kind_ identifies a MAP block.
+ Implement the end of the current MAP block. */
+
+void
+ffestc_V013 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_map_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_useless_ ();
+
+ if (ffestw_substate (ffestw_stack_top ()) != 1)
+ {
+ ffebad_start (FFEBAD_MAP_NO_COMPONENTS);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
+ ffebad_finish ();
+ }
+
+ ffestc_shriek_map_ (TRUE);
+}
+
+#endif
+/* ffestc_V014_start -- VOLATILE statement list begin
+
+ ffestc_V014_start();
+
+ Verify that VOLATILE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_V014_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_progspec_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_V014_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V014_item_object -- VOLATILE statement for object-name
+
+ ffestc_V014_item_object(name_token);
+
+ Make sure name_token identifies a valid object to be VOLATILEd. */
+
+void
+ffestc_V014_item_object (ffelexToken name)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V014_item_object (name);
+}
+
+/* ffestc_V014_item_cblock -- VOLATILE statement for common-block-name
+
+ ffestc_V014_item_cblock(name_token);
+
+ Make sure name_token identifies a valid common block to be VOLATILEd. */
+
+void
+ffestc_V014_item_cblock (ffelexToken name)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V014_item_cblock (name);
+}
+
+/* ffestc_V014_finish -- VOLATILE statement list complete
+
+ ffestc_V014_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V014_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V014_finish ();
+}
+
+/* ffestc_V016_start -- RECORD statement list begin
+
+ ffestc_V016_start();
+
+ Verify that RECORD is valid here, and begin accepting items in the list. */
+
+#if FFESTR_VXT
+void
+ffestc_V016_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_record_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ switch (ffestw_state (ffestw_stack_top ()))
+ {
+ case FFESTV_stateSTRUCTURE:
+ case FFESTV_stateMAP:
+ ffestw_set_substate (ffestw_stack_top (), 1); /* Seen at least one
+ member. */
+ break;
+
+ default:
+ break;
+ }
+
+ ffestd_V016_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V016_item_structure -- RECORD statement for common-block-name
+
+ ffestc_V016_item_structure(name_token);
+
+ Make sure name_token identifies a valid structure to be RECORDed. */
+
+void
+ffestc_V016_item_structure (ffelexToken name)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V016_item_structure (name);
+}
+
+/* ffestc_V016_item_object -- RECORD statement for object-name
+
+ ffestc_V016_item_object(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be RECORDd. */
+
+void
+ffestc_V016_item_object (ffelexToken name, ffesttDimList dims)
+{
+ ffestc_check_item_ ();
+ assert (name != NULL);
+ if (!ffestc_ok_)
+ return;
+
+ if (dims != NULL)
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+
+ ffestd_V016_item_object (name, dims);
+}
+
+/* ffestc_V016_finish -- RECORD statement list complete
+
+ ffestc_V016_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V016_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V016_finish ();
+}
+
+/* ffestc_V018_start -- REWRITE(...) statement list begin
+
+ ffestc_V018_start();
+
+ Verify that REWRITE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_V018_start ()
+{
+ ffestvFormat format;
+
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ if (!ffestc_subr_is_branch_
+ (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixERR])
+ || !ffestc_subr_is_format_
+ (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT])
+ || !ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixUNIT]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ format = ffestc_subr_format_
+ (&ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT]);
+ switch (format)
+ {
+ case FFESTV_formatNAMELIST:
+ case FFESTV_formatASTERISK:
+ ffebad_start (FFEBAD_CONFLICTING_SPECS);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ assert (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_or_val_present);
+ if (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw_present)
+ {
+ ffebad_here (0, ffelex_token_where_line
+ (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw),
+ ffelex_token_where_column
+ (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].kw));
+ }
+ else
+ {
+ ffebad_here (1, ffelex_token_where_line
+ (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value),
+ ffelex_token_where_column
+ (ffestp_file.rewrite.rewrite_spec[FFESTP_rewriteixFMT].value));
+ }
+ ffebad_finish ();
+ ffestc_ok_ = FALSE;
+ return;
+
+ default:
+ break;
+ }
+
+ ffestd_V018_start (format);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V018_item -- REWRITE statement i/o item
+
+ ffestc_V018_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_V018_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V018_item (expr);
+}
+
+/* ffestc_V018_finish -- REWRITE statement list complete
+
+ ffestc_V018_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V018_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V018_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V019_start -- ACCEPT statement list begin
+
+ ffestc_V019_start();
+
+ Verify that ACCEPT is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_V019_start ()
+{
+ ffestvFormat format;
+
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ if (!ffestc_subr_is_format_
+ (&ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ format = ffestc_subr_format_
+ (&ffestp_file.accept.accept_spec[FFESTP_acceptixFORMAT]);
+ ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+ ffestd_V019_start (format);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V019_item -- ACCEPT statement i/o item
+
+ ffestc_V019_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_V019_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_namelist_ != 0)
+ {
+ if (ffestc_namelist_ == 1)
+ {
+ ffestc_namelist_ = 2;
+ ffebad_start (FFEBAD_NAMELIST_ITEMS);
+ ffebad_here (0, ffelex_token_where_line (expr_token),
+ ffelex_token_where_column (expr_token));
+ ffebad_finish ();
+ }
+ return;
+ }
+
+ ffestd_V019_item (expr);
+}
+
+/* ffestc_V019_finish -- ACCEPT statement list complete
+
+ ffestc_V019_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V019_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V019_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_V020_start -- TYPE statement list begin
+
+ ffestc_V020_start();
+
+ Verify that TYPE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_V020_start ()
+{
+ ffestvFormat format;
+
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ if (!ffestc_subr_is_format_
+ (&ffestp_file.type.type_spec[FFESTP_typeixFORMAT]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ format = ffestc_subr_format_
+ (&ffestp_file.type.type_spec[FFESTP_typeixFORMAT]);
+ ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
+
+ ffestd_V020_start (format);
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V020_item -- TYPE statement i/o item
+
+ ffestc_V020_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_V020_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ if (ffestc_namelist_ != 0)
+ {
+ if (ffestc_namelist_ == 1)
+ {
+ ffestc_namelist_ = 2;
+ ffebad_start (FFEBAD_NAMELIST_ITEMS);
+ ffebad_here (0, ffelex_token_where_line (expr_token),
+ ffelex_token_where_column (expr_token));
+ ffebad_finish ();
+ }
+ return;
+ }
+
+ ffestd_V020_item (expr);
+}
+
+/* ffestc_V020_finish -- TYPE statement list complete
+
+ ffestc_V020_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V020_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V020_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V021 -- DELETE statement
+
+ ffestc_V021();
+
+ Make sure a DELETE is valid in the current context, and implement it. */
+
+#if FFESTR_VXT
+void
+ffestc_V021 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.delete.delete_spec[FFESTP_deleteixERR])
+ && ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.delete.delete_spec[FFESTP_deleteixUNIT]))
+ ffestd_V021 ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V022 -- UNLOCK statement
+
+ ffestc_V022();
+
+ Make sure a UNLOCK is valid in the current context, and implement it. */
+
+void
+ffestc_V022 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.beru.beru_spec[FFESTP_beruixERR])
+ && ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.beru.beru_spec[FFESTP_beruixUNIT]))
+ ffestd_V022 ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V023_start -- ENCODE(...) statement list begin
+
+ ffestc_V023_start();
+
+ Verify that ENCODE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_V023_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ if (!ffestc_subr_is_branch_
+ (&ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixERR]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ ffestd_V023_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V023_item -- ENCODE statement i/o item
+
+ ffestc_V023_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_V023_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V023_item (expr);
+}
+
+/* ffestc_V023_finish -- ENCODE statement list complete
+
+ ffestc_V023_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V023_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V023_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V024_start -- DECODE(...) statement list begin
+
+ ffestc_V024_start();
+
+ Verify that DECODE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_V024_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ if (!ffestc_subr_is_branch_
+ (&ffestp_file.vxtcode.vxtcode_spec[FFESTP_vxtcodeixERR]))
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+
+ ffestd_V024_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V024_item -- DECODE statement i/o item
+
+ ffestc_V024_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestc_V024_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V024_item (expr);
+}
+
+/* ffestc_V024_finish -- DECODE statement list complete
+
+ ffestc_V024_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V024_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V024_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V025_start -- DEFINEFILE statement list begin
+
+ ffestc_V025_start();
+
+ Verify that DEFINEFILE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestc_V025_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_branch_begin_ ();
+
+ ffestd_V025_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V025_item -- DEFINE FILE statement item
+
+ ffestc_V025_item(u,ut,m,mt,n,nt,asv,asvt);
+
+ Implement item. */
+
+void
+ffestc_V025_item (ffebld u, ffelexToken ut, ffebld m, ffelexToken mt,
+ ffebld n, ffelexToken nt, ffebld asv, ffelexToken asvt)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V025_item (u, m, n, asv);
+}
+
+/* ffestc_V025_finish -- DEFINE FILE statement list complete
+
+ ffestc_V025_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V025_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V025_finish ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+/* ffestc_V026 -- FIND statement
+
+ ffestc_V026();
+
+ Make sure a FIND is valid in the current context, and implement it. */
+
+void
+ffestc_V026 ()
+{
+ ffestc_check_simple_ ();
+ if (ffestc_order_actionif_ () != FFESTC_orderOK_)
+ return;
+ ffestc_labeldef_branch_begin_ ();
+
+ if (ffestc_subr_is_branch_
+ (&ffestp_file.find.find_spec[FFESTP_findixERR])
+ && ffestc_subr_is_present_ ("UNIT",
+ &ffestp_file.find.find_spec[FFESTP_findixUNIT])
+ && ffestc_subr_is_present_ ("REC",
+ &ffestp_file.find.find_spec[FFESTP_findixREC]))
+ ffestd_V026 ();
+
+ if (ffestc_shriek_after1_ != NULL)
+ (*ffestc_shriek_after1_) (TRUE);
+ ffestc_labeldef_branch_end_ ();
+}
+
+#endif
+/* ffestc_V027_start -- VXT PARAMETER statement list begin
+
+ ffestc_V027_start();
+
+ Verify that PARAMETER is valid here, and begin accepting items in the list. */
+
+void
+ffestc_V027_start ()
+{
+ ffestc_check_start_ ();
+ if (ffestc_order_parameter_ () != FFESTC_orderOK_)
+ {
+ ffestc_ok_ = FALSE;
+ return;
+ }
+ ffestc_labeldef_useless_ ();
+
+ ffestd_V027_start ();
+
+ ffestc_ok_ = TRUE;
+}
+
+/* ffestc_V027_item -- VXT PARAMETER statement assignment
+
+ ffestc_V027_item(dest,dest_token,source,source_token);
+
+ Make sure the source is a valid source for the destination; make the
+ assignment. */
+
+void
+ffestc_V027_item (ffelexToken dest_token, ffebld source,
+ ffelexToken source_token UNUSED)
+{
+ ffestc_check_item_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V027_item (dest_token, source);
+}
+
+/* ffestc_V027_finish -- VXT PARAMETER statement list complete
+
+ ffestc_V027_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestc_V027_finish ()
+{
+ ffestc_check_finish_ ();
+ if (!ffestc_ok_)
+ return;
+
+ ffestd_V027_finish ();
+}
+
+/* Any executable statement. Mainly make sure that one-shot things
+ like the statement for a logical IF are reset. */
+
+void
+ffestc_any ()
+{
+ ffestc_check_simple_ ();
+
+ ffestc_order_any_ ();
+
+ ffestc_labeldef_any_ ();
+
+ if (ffestc_shriek_after1_ == NULL)
+ return;
+
+ ffestd_any ();
+
+ (*ffestc_shriek_after1_) (TRUE);
+}
diff --git a/gcc/f/stc.h b/gcc/f/stc.h
new file mode 100644
index 00000000000..d5cc601b945
--- /dev/null
+++ b/gcc/f/stc.h
@@ -0,0 +1,360 @@
+/* stc.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ stc.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_stc
+#define _H_f_stc
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bad.h"
+#include "bld.h"
+#include "expr.h"
+#include "lex.h"
+#include "stp.h"
+#include "str.h"
+#include "stt.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+extern ffeexprContext ffestc_iolist_context_;
+
+/* Declare functions with prototypes. */
+
+void ffestc_decl_start (ffestpType type, ffelexToken typet, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent);
+void ffestc_decl_attrib (ffestpAttrib attrib, ffelexToken attribt,
+ ffestrOther intent_kw, ffesttDimList dims);
+void ffestc_decl_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+ ffesttDimList dims, ffebld len, ffelexToken lent,
+ ffebld init, ffelexToken initt, bool clist);
+void ffestc_decl_itemstartvals (void);
+void ffestc_decl_itemvalue (ffebld repeat, ffelexToken repeat_token,
+ ffebld value, ffelexToken value_token);
+void ffestc_decl_itemendvals (ffelexToken t);
+void ffestc_decl_finish (void);
+void ffestc_elsewhere (ffelexToken where_token);
+void ffestc_end (void);
+void ffestc_eof (void);
+bool ffestc_exec_transition (void);
+void ffestc_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
+void ffestc_init_3 (void);
+void ffestc_init_4 (void);
+bool ffestc_is_decl_not_R1219 (void);
+bool ffestc_is_entry_in_subr (void);
+bool ffestc_is_let_not_V027 (void);
+#if FFESTR_F90
+void ffestc_let (ffebld dest, ffebld source, ffelexToken source_token);
+#else
+#define ffestc_let ffestc_R737
+#endif
+#if FFESTR_F90
+void ffestc_module (ffelexToken module_name, ffelexToken procedure_name);
+#endif
+#if FFESTR_F90
+void ffestc_private (void);
+#endif
+void ffestc_terminate_4 (void);
+#if FFESTR_F90
+void ffestc_R423A (void);
+void ffestc_R423B (void);
+void ffestc_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name);
+void ffestc_R425 (ffelexToken name);
+void ffestc_R426_start (ffestpType type, ffelexToken typet, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent);
+void ffestc_R426_attrib (ffestpAttrib attrib, ffelexToken attribt,
+ ffestrOther intent_kw, ffesttDimList dims);
+void ffestc_R426_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+ ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
+ ffelexToken initt, bool clist);
+void ffestc_R426_itemstartvals (void);
+void ffestc_R426_itemvalue (ffebld repeat, ffelexToken repeat_token,
+ ffebld value, ffelexToken value_token);
+void ffestc_R426_itemendvals (ffelexToken t);
+void ffestc_R426_finish (void);
+#endif
+void ffestc_R501_start (ffestpType type, ffelexToken typet, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent);
+void ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt,
+ ffestrOther intent_kw, ffesttDimList dims);
+void ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt,
+ ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
+ ffelexToken initt, bool clist);
+void ffestc_R501_itemstartvals (void);
+void ffestc_R501_itemvalue (ffebld repeat, ffelexToken repeat_token,
+ ffebld value, ffelexToken value_token);
+void ffestc_R501_itemendvals (ffelexToken t);
+void ffestc_R501_finish (void);
+#if FFESTR_F90
+void ffestc_R519_start (ffelexToken intent, ffestrOther intent_kw);
+void ffestc_R519_item (ffelexToken name);
+void ffestc_R519_finish (void);
+void ffestc_R520_start (void);
+void ffestc_R520_item (ffelexToken name);
+void ffestc_R520_finish (void);
+void ffestc_R521A (void);
+void ffestc_R521Astart (void);
+void ffestc_R521Aitem (ffelexToken name);
+void ffestc_R521Afinish (void);
+void ffestc_R521B (void);
+void ffestc_R521Bstart (void);
+void ffestc_R521Bitem (ffelexToken name);
+void ffestc_R521Bfinish (void);
+#endif
+void ffestc_R522 (void);
+void ffestc_R522start (void);
+void ffestc_R522item_object (ffelexToken name);
+void ffestc_R522item_cblock (ffelexToken name);
+void ffestc_R522finish (void);
+void ffestc_R524_start (bool virtual);
+void ffestc_R524_item (ffelexToken name, ffesttDimList dims);
+void ffestc_R524_finish (void);
+#if FFESTR_F90
+void ffestc_R525_start (void);
+void ffestc_R525_item (ffelexToken name, ffesttDimList dims);
+void ffestc_R525_finish (void);
+void ffestc_R526_start (void);
+void ffestc_R526_item (ffelexToken name, ffesttDimList dims);
+void ffestc_R526_finish (void);
+void ffestc_R527_start (void);
+void ffestc_R527_item (ffelexToken name, ffesttDimList dims);
+void ffestc_R527_finish (void);
+#endif
+void ffestc_R528_start (void);
+void ffestc_R528_item_object (ffebld expr, ffelexToken expr_token);
+void ffestc_R528_item_startvals (void);
+void ffestc_R528_item_value (ffebld repeat, ffelexToken repeat_token,
+ ffebld value, ffelexToken value_token);
+void ffestc_R528_item_endvals (ffelexToken t);
+void ffestc_R528_finish (void);
+void ffestc_R537_start (void);
+void ffestc_R537_item (ffebld dest, ffelexToken dest_token, ffebld source,
+ ffelexToken source_token);
+void ffestc_R537_finish (void);
+void ffestc_R539 (void);
+void ffestc_R539start (void);
+void ffestc_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
+ ffebld len, ffelexToken lent, ffesttImpList letters);
+void ffestc_R539finish (void);
+void ffestc_R542_start (void);
+void ffestc_R542_item_nlist (ffelexToken name);
+void ffestc_R542_item_nitem (ffelexToken name);
+void ffestc_R542_finish (void);
+void ffestc_R544_start (void);
+void ffestc_R544_item (ffesttExprList exprlist);
+void ffestc_R544_finish (void);
+void ffestc_R547_start (void);
+void ffestc_R547_item_object (ffelexToken name, ffesttDimList dims);
+void ffestc_R547_item_cblock (ffelexToken name);
+void ffestc_R547_finish (void);
+#if FFESTR_F90
+void ffestc_R620 (ffesttExprList objects, ffebld stat,
+ ffelexToken stat_token);
+void ffestc_R624 (ffesttExprList pointers);
+void ffestc_R625 (ffesttExprList objects, ffebld stat,
+ ffelexToken stat_token);
+#endif
+void ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token);
+#if FFESTR_F90
+void ffestc_R738 (ffebld dest, ffebld source, ffelexToken source_token);
+void ffestc_R740 (ffebld expr, ffelexToken expr_token);
+void ffestc_R742 (ffebld expr, ffelexToken expr_token);
+void ffestc_R744 (void);
+void ffestc_R745 (void);
+#endif
+void ffestc_R803 (ffelexToken construct_name, ffebld expr,
+ ffelexToken expr_token);
+void ffestc_R804 (ffebld expr, ffelexToken expr_token, ffelexToken name);
+void ffestc_R805 (ffelexToken name);
+void ffestc_R806 (ffelexToken name);
+void ffestc_R807 (ffebld expr, ffelexToken expr_token);
+void ffestc_R809 (ffelexToken construct_name, ffebld expr,
+ ffelexToken expr_token);
+void ffestc_R810 (ffesttCaseList cases, ffelexToken name);
+void ffestc_R811 (ffelexToken name);
+void ffestc_R819A (ffelexToken construct_name, ffelexToken label, ffebld var,
+ ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
+ ffelexToken end_token, ffebld incr, ffelexToken incr_token);
+void ffestc_R819B (ffelexToken construct_name, ffelexToken label, ffebld expr,
+ ffelexToken expr_token);
+void ffestc_R820A (ffelexToken construct_name, ffebld var,
+ ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
+ ffelexToken end_token, ffebld incr, ffelexToken incr_token);
+void ffestc_R820B (ffelexToken construct_name, ffebld expr,
+ ffelexToken expr_token);
+void ffestc_R825 (ffelexToken name);
+void ffestc_R834 (ffelexToken name);
+void ffestc_R835 (ffelexToken name);
+void ffestc_R836 (ffelexToken label);
+void ffestc_R837 (ffesttTokenList label_toks, ffebld expr,
+ ffelexToken expr_token);
+void ffestc_R838 (ffelexToken label, ffebld target, ffelexToken target_token);
+void ffestc_R839 (ffebld target, ffelexToken target_token,
+ ffesttTokenList label_toks);
+void ffestc_R840 (ffebld expr, ffelexToken expr_token, ffelexToken neg,
+ ffelexToken zero, ffelexToken pos);
+void ffestc_R841 (void);
+void ffestc_R842 (ffebld expr, ffelexToken expr_token);
+void ffestc_R843 (ffebld expr, ffelexToken expr_token);
+void ffestc_R904 (void);
+void ffestc_R907 (void);
+void ffestc_R909_start (bool only_format);
+void ffestc_R909_item (ffebld expr, ffelexToken expr_token);
+void ffestc_R909_finish (void);
+void ffestc_R910_start (void);
+void ffestc_R910_item (ffebld expr, ffelexToken expr_token);
+void ffestc_R910_finish (void);
+void ffestc_R911_start (void);
+void ffestc_R911_item (ffebld expr, ffelexToken expr_token);
+void ffestc_R911_finish (void);
+void ffestc_R919 (void);
+void ffestc_R920 (void);
+void ffestc_R921 (void);
+void ffestc_R923A (void);
+void ffestc_R923B_start (void);
+void ffestc_R923B_item (ffebld expr, ffelexToken expr_token);
+void ffestc_R923B_finish (void);
+void ffestc_R1001 (ffesttFormatList f);
+void ffestc_R1102 (ffelexToken name);
+void ffestc_R1103 (ffelexToken name);
+#if FFESTR_F90
+void ffestc_R1105 (ffelexToken name);
+void ffestc_R1106 (ffelexToken name);
+void ffestc_R1107_start (ffelexToken name, bool only);
+void ffestc_R1107_item (ffelexToken local, ffelexToken use);
+void ffestc_R1107_finish (void);
+#endif
+void ffestc_R1111 (ffelexToken name);
+void ffestc_R1112 (ffelexToken name);
+#if FFESTR_F90
+void ffestc_R1202 (ffestpDefinedOperator operator, ffelexToken name);
+void ffestc_R1203 (void);
+void ffestc_R1205_start (void);
+void ffestc_R1205_item (ffelexToken name);
+void ffestc_R1205_finish (void);
+#endif
+void ffestc_R1207_start (void);
+void ffestc_R1207_item (ffelexToken name);
+void ffestc_R1207_finish (void);
+void ffestc_R1208_start (void);
+void ffestc_R1208_item (ffelexToken name);
+void ffestc_R1208_finish (void);
+void ffestc_R1212 (ffebld expr, ffelexToken expr_token);
+#if FFESTR_F90
+void ffestc_R1213 (ffebld dest, ffebld source, ffelexToken source_token);
+#endif
+void ffestc_R1219 (ffelexToken funcname, ffesttTokenList args,
+ ffelexToken final, ffestpType type, ffebld kind, ffelexToken kindt,
+ ffebld len, ffelexToken lent, ffelexToken recursive, ffelexToken result);
+void ffestc_R1221 (ffelexToken name);
+void ffestc_R1223 (ffelexToken subrname, ffesttTokenList args,
+ ffelexToken final, ffelexToken recursive);
+void ffestc_R1225 (ffelexToken name);
+void ffestc_R1226 (ffelexToken entryname, ffesttTokenList args,
+ ffelexToken final);
+void ffestc_R1227 (ffebld expr, ffelexToken expr_token);
+#if FFESTR_F90
+void ffestc_R1228 (void);
+#endif
+void ffestc_R1229_start (ffelexToken name, ffesttTokenList args,
+ ffelexToken final);
+void ffestc_R1229_finish (ffebld expr, ffelexToken expr_token);
+void ffestc_S3P4 (ffebld filename, ffelexToken filename_token);
+#if FFESTR_VXT
+void ffestc_V003_start (ffelexToken structure_name);
+void ffestc_V003_item (ffelexToken name, ffesttDimList dims);
+void ffestc_V003_finish (void);
+void ffestc_V004 (void);
+void ffestc_V009 (void);
+void ffestc_V010 (void);
+void ffestc_V012 (void);
+void ffestc_V013 (void);
+#endif
+void ffestc_V014_start (void);
+void ffestc_V014_item_object (ffelexToken name);
+void ffestc_V014_item_cblock (ffelexToken name);
+void ffestc_V014_finish (void);
+#if FFESTR_VXT
+void ffestc_V016_start (void);
+void ffestc_V016_item_structure (ffelexToken name);
+void ffestc_V016_item_object (ffelexToken name, ffesttDimList dims);
+void ffestc_V016_finish (void);
+void ffestc_V018_start (void);
+void ffestc_V018_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V018_finish (void);
+void ffestc_V019_start (void);
+void ffestc_V019_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V019_finish (void);
+#endif
+void ffestc_V020_start (void);
+void ffestc_V020_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V020_finish (void);
+#if FFESTR_VXT
+void ffestc_V021 (void);
+void ffestc_V022 (void);
+void ffestc_V023_start (void);
+void ffestc_V023_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V023_finish (void);
+void ffestc_V024_start (void);
+void ffestc_V024_item (ffebld expr, ffelexToken expr_token);
+void ffestc_V024_finish (void);
+void ffestc_V025_start (void);
+void ffestc_V025_item (ffebld u, ffelexToken ut, ffebld m, ffelexToken mt,
+ ffebld n, ffelexToken nt, ffebld asv, ffelexToken asvt);
+void ffestc_V025_finish (void);
+void ffestc_V026 (void);
+#endif
+void ffestc_V027_start (void);
+void ffestc_V027_item (ffelexToken dest_token, ffebld source,
+ ffelexToken source_token);
+void ffestc_V027_finish (void);
+void ffestc_any (void);
+
+/* Define macros. */
+
+#define ffestc_context_iolist() ffestc_iolist_context_
+#define ffestc_init_0()
+#define ffestc_init_1()
+#define ffestc_init_2()
+#define ffestc_terminate_0()
+#define ffestc_terminate_1()
+#define ffestc_terminate_2()
+#define ffestc_terminate_3()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/std.c b/gcc/f/std.c
new file mode 100644
index 00000000000..ea497425d9c
--- /dev/null
+++ b/gcc/f/std.c
@@ -0,0 +1,6739 @@
+/* std.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ st.c
+
+ Description:
+ Implements the various statements and such like.
+
+ Modifications:
+ 21-Nov-91 JCB 2.0
+ Split out actual code generation to ffeste.
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "std.h"
+#include "bld.h"
+#include "com.h"
+#include "lab.h"
+#include "lex.h"
+#include "malloc.h"
+#include "sta.h"
+#include "ste.h"
+#include "stp.h"
+#include "str.h"
+#include "sts.h"
+#include "stt.h"
+#include "stv.h"
+#include "stw.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+#define FFESTD_COPY_EASY_ 1 /* 1 for only one _subr_copy_xyz_ fn. */
+
+#define FFESTD_IS_END_OPTIMIZED_ 1 /* 0=always gen STOP/RETURN before
+ END. */
+
+typedef enum
+ {
+ FFESTD_stateletSIMPLE_, /* Expecting simple/start. */
+ FFESTD_stateletATTRIB_, /* Expecting attrib/item/itemstart. */
+ FFESTD_stateletITEM_, /* Expecting item/itemstart/finish. */
+ FFESTD_stateletITEMVALS_, /* Expecting itemvalue/itemendvals. */
+ FFESTD_
+ } ffestdStatelet_;
+
+#if FFECOM_TWOPASS
+typedef enum
+ {
+ FFESTD_stmtidENDDOLOOP_,
+ FFESTD_stmtidENDLOGIF_,
+ FFESTD_stmtidEXECLABEL_,
+ FFESTD_stmtidFORMATLABEL_,
+ FFESTD_stmtidR737A_, /* let */
+ FFESTD_stmtidR803_, /* IF-block */
+ FFESTD_stmtidR804_, /* ELSE IF */
+ FFESTD_stmtidR805_, /* ELSE */
+ FFESTD_stmtidR806_, /* END IF */
+ FFESTD_stmtidR807_, /* IF-logical */
+ FFESTD_stmtidR809_, /* SELECT CASE */
+ FFESTD_stmtidR810_, /* CASE */
+ FFESTD_stmtidR811_, /* END SELECT */
+ FFESTD_stmtidR819A_, /* DO-iterative */
+ FFESTD_stmtidR819B_, /* DO WHILE */
+ FFESTD_stmtidR825_, /* END DO */
+ FFESTD_stmtidR834_, /* CYCLE */
+ FFESTD_stmtidR835_, /* EXIT */
+ FFESTD_stmtidR836_, /* GOTO */
+ FFESTD_stmtidR837_, /* GOTO-computed */
+ FFESTD_stmtidR838_, /* ASSIGN */
+ FFESTD_stmtidR839_, /* GOTO-assigned */
+ FFESTD_stmtidR840_, /* IF-arithmetic */
+ FFESTD_stmtidR841_, /* CONTINUE */
+ FFESTD_stmtidR842_, /* STOP */
+ FFESTD_stmtidR843_, /* PAUSE */
+ FFESTD_stmtidR904_, /* OPEN */
+ FFESTD_stmtidR907_, /* CLOSE */
+ FFESTD_stmtidR909_, /* READ */
+ FFESTD_stmtidR910_, /* WRITE */
+ FFESTD_stmtidR911_, /* PRINT */
+ FFESTD_stmtidR919_, /* BACKSPACE */
+ FFESTD_stmtidR920_, /* ENDFILE */
+ FFESTD_stmtidR921_, /* REWIND */
+ FFESTD_stmtidR923A_, /* INQUIRE */
+ FFESTD_stmtidR923B_, /* INQUIRE-iolength */
+ FFESTD_stmtidR1001_, /* FORMAT */
+ FFESTD_stmtidR1103_, /* END_PROGRAM */
+ FFESTD_stmtidR1112_, /* END_BLOCK_DATA */
+ FFESTD_stmtidR1212_, /* CALL */
+ FFESTD_stmtidR1221_, /* END_FUNCTION */
+ FFESTD_stmtidR1225_, /* END_SUBROUTINE */
+ FFESTD_stmtidR1226_, /* ENTRY */
+ FFESTD_stmtidR1227_, /* RETURN */
+#if FFESTR_VXT
+ FFESTD_stmtidV018_, /* REWRITE */
+ FFESTD_stmtidV019_, /* ACCEPT */
+#endif
+ FFESTD_stmtidV020_, /* TYPE */
+#if FFESTR_VXT
+ FFESTD_stmtidV021_, /* DELETE */
+ FFESTD_stmtidV022_, /* UNLOCK */
+ FFESTD_stmtidV023_, /* ENCODE */
+ FFESTD_stmtidV024_, /* DECODE */
+ FFESTD_stmtidV025start_, /* DEFINEFILE (start) */
+ FFESTD_stmtidV025item_, /* (DEFINEFILE item) */
+ FFESTD_stmtidV025finish_, /* (DEFINEFILE finish) */
+ FFESTD_stmtidV026_, /* FIND */
+#endif
+ FFESTD_stmtid_,
+ } ffestdStmtId_;
+
+#endif
+
+/* Internal typedefs. */
+
+typedef struct _ffestd_expr_item_ *ffestdExprItem_;
+#if FFECOM_TWOPASS
+typedef struct _ffestd_stmt_ *ffestdStmt_;
+#endif
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffestd_expr_item_
+ {
+ ffestdExprItem_ next;
+ ffebld expr;
+ ffelexToken token;
+ };
+
+#if FFECOM_TWOPASS
+struct _ffestd_stmt_
+ {
+ ffestdStmt_ next;
+ ffestdStmt_ previous;
+ ffestdStmtId_ id;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ char *filename;
+ int filelinenum;
+#endif
+ union
+ {
+ struct
+ {
+ ffestw block;
+ }
+ enddoloop;
+ struct
+ {
+ ffelab label;
+ }
+ execlabel;
+ struct
+ {
+ ffelab label;
+ }
+ formatlabel;
+ struct
+ {
+ mallocPool pool;
+ ffebld dest;
+ ffebld source;
+ }
+ R737A;
+ struct
+ {
+ mallocPool pool;
+ ffebld expr;
+ }
+ R803;
+ struct
+ {
+ mallocPool pool;
+ ffebld expr;
+ }
+ R804;
+ struct
+ {
+ mallocPool pool;
+ ffebld expr;
+ }
+ R807;
+ struct
+ {
+ mallocPool pool;
+ ffestw block;
+ ffebld expr;
+ }
+ R809;
+ struct
+ {
+ mallocPool pool;
+ ffestw block;
+ unsigned long casenum;
+ }
+ R810;
+ struct
+ {
+ ffestw block;
+ }
+ R811;
+ struct
+ {
+ mallocPool pool;
+ ffestw block;
+ ffelab label;
+ ffebld var;
+ ffebld start;
+ ffelexToken start_token;
+ ffebld end;
+ ffelexToken end_token;
+ ffebld incr;
+ ffelexToken incr_token;
+ }
+ R819A;
+ struct
+ {
+ mallocPool pool;
+ ffestw block;
+ ffelab label;
+ ffebld expr;
+ }
+ R819B;
+ struct
+ {
+ ffestw block;
+ }
+ R834;
+ struct
+ {
+ ffestw block;
+ }
+ R835;
+ struct
+ {
+ ffelab label;
+ }
+ R836;
+ struct
+ {
+ mallocPool pool;
+ ffelab *labels;
+ int count;
+ ffebld expr;
+ }
+ R837;
+ struct
+ {
+ mallocPool pool;
+ ffelab label;
+ ffebld target;
+ }
+ R838;
+ struct
+ {
+ mallocPool pool;
+ ffebld target;
+ }
+ R839;
+ struct
+ {
+ mallocPool pool;
+ ffebld expr;
+ ffelab neg;
+ ffelab zero;
+ ffelab pos;
+ }
+ R840;
+ struct
+ {
+ mallocPool pool;
+ ffebld expr;
+ }
+ R842;
+ struct
+ {
+ mallocPool pool;
+ ffebld expr;
+ }
+ R843;
+ struct
+ {
+ mallocPool pool;
+ ffestpOpenStmt *params;
+ }
+ R904;
+ struct
+ {
+ mallocPool pool;
+ ffestpCloseStmt *params;
+ }
+ R907;
+ struct
+ {
+ mallocPool pool;
+ ffestpReadStmt *params;
+ bool only_format;
+ ffestvUnit unit;
+ ffestvFormat format;
+ bool rec;
+ bool key;
+ ffestdExprItem_ list;
+ }
+ R909;
+ struct
+ {
+ mallocPool pool;
+ ffestpWriteStmt *params;
+ ffestvUnit unit;
+ ffestvFormat format;
+ bool rec;
+ ffestdExprItem_ list;
+ }
+ R910;
+ struct
+ {
+ mallocPool pool;
+ ffestpPrintStmt *params;
+ ffestvFormat format;
+ ffestdExprItem_ list;
+ }
+ R911;
+ struct
+ {
+ mallocPool pool;
+ ffestpBeruStmt *params;
+ }
+ R919;
+ struct
+ {
+ mallocPool pool;
+ ffestpBeruStmt *params;
+ }
+ R920;
+ struct
+ {
+ mallocPool pool;
+ ffestpBeruStmt *params;
+ }
+ R921;
+ struct
+ {
+ mallocPool pool;
+ ffestpInquireStmt *params;
+ bool by_file;
+ }
+ R923A;
+ struct
+ {
+ mallocPool pool;
+ ffestpInquireStmt *params;
+ ffestdExprItem_ list;
+ }
+ R923B;
+ struct
+ {
+ ffestsHolder str;
+ }
+ R1001;
+ struct
+ {
+ mallocPool pool;
+ ffebld expr;
+ }
+ R1212;
+ struct
+ {
+ ffesymbol entry;
+ int entrynum;
+ }
+ R1226;
+ struct
+ {
+ mallocPool pool;
+ ffestw block;
+ ffebld expr;
+ }
+ R1227;
+#if FFESTR_VXT
+ struct
+ {
+ mallocPool pool;
+ ffestpRewriteStmt *params;
+ ffestvFormat format;
+ ffestdExprItem_ list;
+ }
+ V018;
+ struct
+ {
+ mallocPool pool;
+ ffestpAcceptStmt *params;
+ ffestvFormat format;
+ ffestdExprItem_ list;
+ }
+ V019;
+#endif
+ struct
+ {
+ mallocPool pool;
+ ffestpTypeStmt *params;
+ ffestvFormat format;
+ ffestdExprItem_ list;
+ }
+ V020;
+#if FFESTR_VXT
+ struct
+ {
+ mallocPool pool;
+ ffestpDeleteStmt *params;
+ }
+ V021;
+ struct
+ {
+ mallocPool pool;
+ ffestpBeruStmt *params;
+ }
+ V022;
+ struct
+ {
+ mallocPool pool;
+ ffestpVxtcodeStmt *params;
+ ffestdExprItem_ list;
+ }
+ V023;
+ struct
+ {
+ mallocPool pool;
+ ffestpVxtcodeStmt *params;
+ ffestdExprItem_ list;
+ }
+ V024;
+ struct
+ {
+ ffebld u;
+ ffebld m;
+ ffebld n;
+ ffebld asv;
+ }
+ V025item;
+ struct
+ {
+ mallocPool pool;
+ } V025finish;
+ struct
+ {
+ mallocPool pool;
+ ffestpFindStmt *params;
+ }
+ V026;
+#endif
+ }
+ u;
+ };
+
+#endif
+
+/* Static objects accessed by functions in this module. */
+
+static ffestdStatelet_ ffestd_statelet_ = FFESTD_stateletSIMPLE_;
+static int ffestd_block_level_ = 0; /* Block level for reachableness. */
+static bool ffestd_is_reachable_; /* Is the current stmt reachable? */
+static ffelab ffestd_label_formatdef_ = NULL;
+#if FFECOM_TWOPASS
+static ffestdExprItem_ *ffestd_expr_list_;
+static struct
+ {
+ ffestdStmt_ first;
+ ffestdStmt_ last;
+ }
+
+ffestd_stmt_list_
+=
+{
+ NULL, NULL
+};
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static int ffestd_2pass_entrypoints_ = 0; /* # ENTRY statements
+ pending. */
+#endif
+
+/* Static functions (internal). */
+
+#if FFECOM_TWOPASS
+static void ffestd_stmt_append_ (ffestdStmt_ stmt);
+static ffestdStmt_ ffestd_stmt_new_ (ffestdStmtId_ id);
+static void ffestd_stmt_pass_ (void);
+#endif
+#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
+static ffestpInquireStmt *ffestd_subr_copy_easy_ (ffestpInquireIx max);
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void ffestd_subr_vxt_ (void);
+#endif
+#if FFESTR_F90
+static void ffestd_subr_f90_ (void);
+#endif
+static void ffestd_subr_labels_ (bool unexpected);
+static void ffestd_R1001dump_ (ffests s, ffesttFormatList list);
+static void ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
+ char *string);
+static void ffestd_R1001error_ (ffesttFormatList f);
+
+/* Internal macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffestd_subr_line_now_() \
+ ffeste_set_line (ffelex_token_where_filename (ffesta_tokens[0]), \
+ ffelex_token_where_filelinenum (ffesta_tokens[0]))
+#define ffestd_subr_line_restore_(s) \
+ ffeste_set_line ((s)->filename, (s)->filelinenum)
+#define ffestd_subr_line_save_(s) \
+ ((s)->filename = ffelex_token_where_filename (ffesta_tokens[0]), \
+ (s)->filelinenum = ffelex_token_where_filelinenum (ffesta_tokens[0]))
+#else
+#define ffestd_subr_line_now_()
+#if FFECOM_TWOPASS
+#define ffestd_subr_line_restore_(s)
+#define ffestd_subr_line_save_(s)
+#endif /* FFECOM_TWOPASS */
+#endif /* FFECOM_targetCURRENT != FFECOM_targetGCC */
+#define ffestd_check_simple_() \
+ assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_)
+#define ffestd_check_start_() \
+ assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_); \
+ ffestd_statelet_ = FFESTD_stateletATTRIB_
+#define ffestd_check_attrib_() \
+ assert(ffestd_statelet_ == FFESTD_stateletATTRIB_)
+#define ffestd_check_item_() \
+ assert(ffestd_statelet_ == FFESTD_stateletATTRIB_ \
+ || ffestd_statelet_ == FFESTD_stateletITEM_); \
+ ffestd_statelet_ = FFESTD_stateletITEM_
+#define ffestd_check_item_startvals_() \
+ assert(ffestd_statelet_ == FFESTD_stateletATTRIB_ \
+ || ffestd_statelet_ == FFESTD_stateletITEM_); \
+ ffestd_statelet_ = FFESTD_stateletITEMVALS_
+#define ffestd_check_item_value_() \
+ assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_)
+#define ffestd_check_item_endvals_() \
+ assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_); \
+ ffestd_statelet_ = FFESTD_stateletITEM_
+#define ffestd_check_finish_() \
+ assert(ffestd_statelet_ == FFESTD_stateletATTRIB_ \
+ || ffestd_statelet_ == FFESTD_stateletITEM_); \
+ ffestd_statelet_ = FFESTD_stateletSIMPLE_
+
+#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
+#define ffestd_subr_copy_accept_() (ffestpAcceptStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_acceptix)
+#define ffestd_subr_copy_beru_() (ffestpBeruStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_beruix)
+#define ffestd_subr_copy_close_() (ffestpCloseStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_closeix)
+#define ffestd_subr_copy_delete_() (ffestpDeleteStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_deleteix)
+#define ffestd_subr_copy_find_() (ffestpFindStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_findix)
+#define ffestd_subr_copy_inquire_() (ffestpInquireStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_inquireix)
+#define ffestd_subr_copy_open_() (ffestpOpenStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_openix)
+#define ffestd_subr_copy_print_() (ffestpPrintStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_printix)
+#define ffestd_subr_copy_read_() (ffestpReadStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_readix)
+#define ffestd_subr_copy_rewrite_() (ffestpRewriteStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_rewriteix)
+#define ffestd_subr_copy_type_() (ffestpTypeStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_typeix)
+#define ffestd_subr_copy_vxtcode_() (ffestpVxtcodeStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
+#define ffestd_subr_copy_write_() (ffestpWriteStmt *) \
+ ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_writeix)
+#endif
+
+/* ffestd_stmt_append_ -- Append statement to end of stmt list
+
+ ffestd_stmt_append_(ffestd_stmt_new_(FFESTD_stmtidR737A_)); */
+
+#if FFECOM_TWOPASS
+static void
+ffestd_stmt_append_ (ffestdStmt_ stmt)
+{
+ stmt->next = (ffestdStmt_) &ffestd_stmt_list_.first;
+ stmt->previous = ffestd_stmt_list_.last;
+ stmt->next->previous = stmt;
+ stmt->previous->next = stmt;
+}
+
+#endif
+/* ffestd_stmt_new_ -- Make new statement with given id
+
+ ffestdStmt_ stmt;
+ stmt = ffestd_stmt_new_(FFESTD_stmtidR737A_); */
+
+#if FFECOM_TWOPASS
+static ffestdStmt_
+ffestd_stmt_new_ (ffestdStmtId_ id)
+{
+ ffestdStmt_ stmt;
+
+ stmt = malloc_new_kp (ffe_pool_any_unit (), "ffestdStmt_", sizeof (*stmt));
+ stmt->id = id;
+ return stmt;
+}
+
+#endif
+/* ffestd_stmt_pass_ -- Pass all statements on list to ffeste
+
+ ffestd_stmt_pass_(); */
+
+#if FFECOM_TWOPASS
+static void
+ffestd_stmt_pass_ ()
+{
+ ffestdStmt_ stmt;
+ ffestdExprItem_ expr; /* For traversing lists. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ if (ffestd_2pass_entrypoints_ != 0)
+ {
+ tree which = ffecom_which_entrypoint_decl ();
+ tree value;
+ tree label;
+ int pushok;
+ int ents = ffestd_2pass_entrypoints_;
+ tree duplicate;
+
+ expand_start_case (0, which, TREE_TYPE (which), "entrypoint dispatch");
+ push_momentary ();
+
+ stmt = ffestd_stmt_list_.first;
+ do
+ {
+ while (stmt->id != FFESTD_stmtidR1226_)
+ stmt = stmt->next;
+
+ if (stmt->u.R1226.entry != NULL)
+ {
+ value = build_int_2 (stmt->u.R1226.entrynum, 0);
+ /* Yes, we really want to build a null LABEL_DECL here and not
+ put it on any list. That's what pushcase wants, so that's
+ what it gets! */
+ label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+
+ pushok = pushcase (value, convert, label, &duplicate);
+ assert (pushok == 0);
+
+ label = ffecom_temp_label ();
+ TREE_USED (label) = 1;
+ expand_goto (label);
+ clear_momentary ();
+
+ ffesymbol_hook (stmt->u.R1226.entry).length_tree = label;
+ }
+ stmt = stmt->next;
+ }
+ while (--ents != 0);
+
+ pop_momentary ();
+ expand_end_case (which);
+ clear_momentary ();
+ }
+#endif
+
+ for (stmt = ffestd_stmt_list_.first;
+ stmt != (ffestdStmt_) &ffestd_stmt_list_.first;
+ stmt = stmt->next)
+ {
+ switch (stmt->id)
+ {
+ case FFESTD_stmtidENDDOLOOP_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_do (stmt->u.enddoloop.block);
+ ffestw_kill (stmt->u.enddoloop.block);
+ break;
+
+ case FFESTD_stmtidENDLOGIF_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_end_R807 ();
+ break;
+
+ case FFESTD_stmtidEXECLABEL_:
+ ffeste_labeldef_branch (stmt->u.execlabel.label);
+ break;
+
+ case FFESTD_stmtidFORMATLABEL_:
+ ffeste_labeldef_format (stmt->u.formatlabel.label);
+ break;
+
+ case FFESTD_stmtidR737A_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R737A (stmt->u.R737A.dest, stmt->u.R737A.source);
+ malloc_pool_kill (stmt->u.R737A.pool);
+ break;
+
+ case FFESTD_stmtidR803_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R803 (stmt->u.R803.expr);
+ malloc_pool_kill (stmt->u.R803.pool);
+ break;
+
+ case FFESTD_stmtidR804_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R804 (stmt->u.R804.expr);
+ malloc_pool_kill (stmt->u.R804.pool);
+ break;
+
+ case FFESTD_stmtidR805_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R805 ();
+ break;
+
+ case FFESTD_stmtidR806_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R806 ();
+ break;
+
+ case FFESTD_stmtidR807_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R807 (stmt->u.R807.expr);
+ malloc_pool_kill (stmt->u.R807.pool);
+ break;
+
+ case FFESTD_stmtidR809_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R809 (stmt->u.R809.block, stmt->u.R809.expr);
+ malloc_pool_kill (stmt->u.R809.pool);
+ break;
+
+ case FFESTD_stmtidR810_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R810 (stmt->u.R810.block, stmt->u.R810.casenum);
+ malloc_pool_kill (stmt->u.R810.pool);
+ break;
+
+ case FFESTD_stmtidR811_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R811 (stmt->u.R811.block);
+ malloc_pool_kill (ffestw_select (stmt->u.R811.block)->pool);
+ ffestw_kill (stmt->u.R811.block);
+ break;
+
+ case FFESTD_stmtidR819A_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R819A (stmt->u.R819A.block, stmt->u.R819A.label,
+ stmt->u.R819A.var,
+ stmt->u.R819A.start, stmt->u.R819A.start_token,
+ stmt->u.R819A.end, stmt->u.R819A.end_token,
+ stmt->u.R819A.incr, stmt->u.R819A.incr_token);
+ ffelex_token_kill (stmt->u.R819A.start_token);
+ ffelex_token_kill (stmt->u.R819A.end_token);
+ if (stmt->u.R819A.incr_token != NULL)
+ ffelex_token_kill (stmt->u.R819A.incr_token);
+ malloc_pool_kill (stmt->u.R819A.pool);
+ break;
+
+ case FFESTD_stmtidR819B_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R819B (stmt->u.R819B.block, stmt->u.R819B.label,
+ stmt->u.R819B.expr);
+ malloc_pool_kill (stmt->u.R819B.pool);
+ break;
+
+ case FFESTD_stmtidR825_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R825 ();
+ break;
+
+ case FFESTD_stmtidR834_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R834 (stmt->u.R834.block);
+ break;
+
+ case FFESTD_stmtidR835_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R835 (stmt->u.R835.block);
+ break;
+
+ case FFESTD_stmtidR836_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R836 (stmt->u.R836.label);
+ break;
+
+ case FFESTD_stmtidR837_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R837 (stmt->u.R837.labels, stmt->u.R837.count,
+ stmt->u.R837.expr);
+ malloc_pool_kill (stmt->u.R837.pool);
+ break;
+
+ case FFESTD_stmtidR838_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R838 (stmt->u.R838.label, stmt->u.R838.target);
+ malloc_pool_kill (stmt->u.R838.pool);
+ break;
+
+ case FFESTD_stmtidR839_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R839 (stmt->u.R839.target);
+ malloc_pool_kill (stmt->u.R839.pool);
+ break;
+
+ case FFESTD_stmtidR840_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R840 (stmt->u.R840.expr, stmt->u.R840.neg, stmt->u.R840.zero,
+ stmt->u.R840.pos);
+ malloc_pool_kill (stmt->u.R840.pool);
+ break;
+
+ case FFESTD_stmtidR841_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R841 ();
+ break;
+
+ case FFESTD_stmtidR842_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R842 (stmt->u.R842.expr);
+ malloc_pool_kill (stmt->u.R842.pool);
+ break;
+
+ case FFESTD_stmtidR843_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R843 (stmt->u.R843.expr);
+ malloc_pool_kill (stmt->u.R843.pool);
+ break;
+
+ case FFESTD_stmtidR904_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R904 (stmt->u.R904.params);
+ malloc_pool_kill (stmt->u.R904.pool);
+ break;
+
+ case FFESTD_stmtidR907_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R907 (stmt->u.R907.params);
+ malloc_pool_kill (stmt->u.R907.pool);
+ break;
+
+ case FFESTD_stmtidR909_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R909_start (stmt->u.R909.params, stmt->u.R909.only_format,
+ stmt->u.R909.unit, stmt->u.R909.format,
+ stmt->u.R909.rec, stmt->u.R909.key);
+ for (expr = stmt->u.R909.list; expr != NULL; expr = expr->next)
+ {
+ ffeste_R909_item (expr->expr, expr->token);
+ ffelex_token_kill (expr->token);
+ }
+ ffeste_R909_finish ();
+ malloc_pool_kill (stmt->u.R909.pool);
+ break;
+
+ case FFESTD_stmtidR910_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R910_start (stmt->u.R910.params, stmt->u.R910.unit,
+ stmt->u.R910.format, stmt->u.R910.rec);
+ for (expr = stmt->u.R910.list; expr != NULL; expr = expr->next)
+ {
+ ffeste_R910_item (expr->expr, expr->token);
+ ffelex_token_kill (expr->token);
+ }
+ ffeste_R910_finish ();
+ malloc_pool_kill (stmt->u.R910.pool);
+ break;
+
+ case FFESTD_stmtidR911_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
+ for (expr = stmt->u.R911.list; expr != NULL; expr = expr->next)
+ {
+ ffeste_R911_item (expr->expr, expr->token);
+ ffelex_token_kill (expr->token);
+ }
+ ffeste_R911_finish ();
+ malloc_pool_kill (stmt->u.R911.pool);
+ break;
+
+ case FFESTD_stmtidR919_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R919 (stmt->u.R919.params);
+ malloc_pool_kill (stmt->u.R919.pool);
+ break;
+
+ case FFESTD_stmtidR920_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R920 (stmt->u.R920.params);
+ malloc_pool_kill (stmt->u.R920.pool);
+ break;
+
+ case FFESTD_stmtidR921_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R921 (stmt->u.R921.params);
+ malloc_pool_kill (stmt->u.R921.pool);
+ break;
+
+ case FFESTD_stmtidR923A_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R923A (stmt->u.R923A.params, stmt->u.R923A.by_file);
+ malloc_pool_kill (stmt->u.R923A.pool);
+ break;
+
+ case FFESTD_stmtidR923B_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R923B_start (stmt->u.R923B.params);
+ for (expr = stmt->u.R923B.list; expr != NULL; expr = expr->next)
+ ffeste_R923B_item (expr->expr);
+ ffeste_R923B_finish ();
+ malloc_pool_kill (stmt->u.R923B.pool);
+ break;
+
+ case FFESTD_stmtidR1001_:
+ ffeste_R1001 (&stmt->u.R1001.str);
+ ffests_kill (&stmt->u.R1001.str);
+ break;
+
+ case FFESTD_stmtidR1103_:
+ ffeste_R1103 ();
+ break;
+
+ case FFESTD_stmtidR1112_:
+ ffeste_R1112 ();
+ break;
+
+ case FFESTD_stmtidR1212_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R1212 (stmt->u.R1212.expr);
+ malloc_pool_kill (stmt->u.R1212.pool);
+ break;
+
+ case FFESTD_stmtidR1221_:
+ ffeste_R1221 ();
+ break;
+
+ case FFESTD_stmtidR1225_:
+ ffeste_R1225 ();
+ break;
+
+ case FFESTD_stmtidR1226_:
+ ffestd_subr_line_restore_ (stmt);
+ if (stmt->u.R1226.entry != NULL)
+ ffeste_R1226 (stmt->u.R1226.entry);
+ break;
+
+ case FFESTD_stmtidR1227_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
+ malloc_pool_kill (stmt->u.R1227.pool);
+ break;
+
+#if FFESTR_VXT
+ case FFESTD_stmtidV018_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_V018_start (stmt->u.V018.params, stmt->u.V018.format);
+ for (expr = stmt->u.V018.list; expr != NULL; expr = expr->next)
+ ffeste_V018_item (expr->expr);
+ ffeste_V018_finish ();
+ malloc_pool_kill (stmt->u.V018.pool);
+ break;
+
+ case FFESTD_stmtidV019_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_V019_start (stmt->u.V019.params, stmt->u.V019.format);
+ for (expr = stmt->u.V019.list; expr != NULL; expr = expr->next)
+ ffeste_V019_item (expr->expr);
+ ffeste_V019_finish ();
+ malloc_pool_kill (stmt->u.V019.pool);
+ break;
+#endif
+
+ case FFESTD_stmtidV020_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
+ for (expr = stmt->u.V020.list; expr != NULL; expr = expr->next)
+ ffeste_V020_item (expr->expr);
+ ffeste_V020_finish ();
+ malloc_pool_kill (stmt->u.V020.pool);
+ break;
+
+#if FFESTR_VXT
+ case FFESTD_stmtidV021_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_V021 (stmt->u.V021.params);
+ malloc_pool_kill (stmt->u.V021.pool);
+ break;
+
+ case FFESTD_stmtidV023_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_V023_start (stmt->u.V023.params);
+ for (expr = stmt->u.V023.list; expr != NULL; expr = expr->next)
+ ffeste_V023_item (expr->expr);
+ ffeste_V023_finish ();
+ malloc_pool_kill (stmt->u.V023.pool);
+ break;
+
+ case FFESTD_stmtidV024_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_V024_start (stmt->u.V024.params);
+ for (expr = stmt->u.V024.list; expr != NULL; expr = expr->next)
+ ffeste_V024_item (expr->expr);
+ ffeste_V024_finish ();
+ malloc_pool_kill (stmt->u.V024.pool);
+ break;
+
+ case FFESTD_stmtidV025start_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_V025_start ();
+ break;
+
+ case FFESTD_stmtidV025item_:
+ ffeste_V025_item (stmt->u.V025item.u, stmt->u.V025item.m,
+ stmt->u.V025item.n, stmt->u.V025item.asv);
+ break;
+
+ case FFESTD_stmtidV025finish_:
+ ffeste_V025_finish ();
+ malloc_pool_kill (stmt->u.V025finish.pool);
+ break;
+
+ case FFESTD_stmtidV026_:
+ ffestd_subr_line_restore_ (stmt);
+ ffeste_V026 (stmt->u.V026.params);
+ malloc_pool_kill (stmt->u.V026.pool);
+ break;
+#endif
+
+ default:
+ assert ("bad stmt->id" == NULL);
+ break;
+ }
+ }
+}
+
+#endif
+/* ffestd_subr_copy_easy_ -- Copy I/O statement data structure
+
+ ffestd_subr_copy_easy_();
+
+ Copies all data except tokens in the I/O data structure into a new
+ structure that lasts as long as the output pool for the current
+ statement. Assumes that they are
+ overlaid with each other (union) in stp.h and the typing
+ and structure references assume (though not necessarily dangerous if
+ FALSE) that INQUIRE has the most file elements. */
+
+#if FFESTD_COPY_EASY_ && FFECOM_TWOPASS
+static ffestpInquireStmt *
+ffestd_subr_copy_easy_ (ffestpInquireIx max)
+{
+ ffestpInquireStmt *stmt;
+ ffestpInquireIx ix;
+
+ stmt = (ffestpInquireStmt *) malloc_new_kp (ffesta_output_pool,
+ "FFESTD easy", sizeof (ffestpFile) * max);
+
+ for (ix = 0; ix < max; ++ix)
+ {
+ if ((stmt->inquire_spec[ix].kw_or_val_present
+ = ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
+ && (stmt->inquire_spec[ix].value_present
+ = ffestp_file.inquire.inquire_spec[ix].value_present))
+ if ((stmt->inquire_spec[ix].value_is_label
+ = ffestp_file.inquire.inquire_spec[ix].value_is_label))
+ stmt->inquire_spec[ix].u.label
+ = ffestp_file.inquire.inquire_spec[ix].u.label;
+ else
+ stmt->inquire_spec[ix].u.expr
+ = ffestp_file.inquire.inquire_spec[ix].u.expr;
+ }
+
+ return stmt;
+}
+
+#endif
+/* ffestd_subr_labels_ -- Handle any undefined labels
+
+ ffestd_subr_labels_(FALSE);
+
+ For every undefined label, generate an error message and either define
+ label as a FORMAT() statement (for FORMAT labels) or as a STOP statement
+ (for all other labels). */
+
+static void
+ffestd_subr_labels_ (bool unexpected)
+{
+ ffelab l;
+ ffelabHandle h;
+ ffelabNumber undef;
+ ffesttFormatList f;
+
+ undef = ffelab_number () - ffestv_num_label_defines_;
+
+ for (h = ffelab_handle_first (); h != NULL; h = ffelab_handle_next (h))
+ {
+ l = ffelab_handle_target (h);
+ if (ffewhere_line_is_unknown (ffelab_definition_line (l)))
+ { /* Undefined label. */
+ assert (!unexpected);
+ assert (undef > 0);
+ undef--;
+ ffebad_start (FFEBAD_UNDEF_LABEL);
+ if (ffelab_type (l) == FFELAB_typeLOOPEND)
+ ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
+ else if (ffelab_type (l) != FFELAB_typeANY)
+ ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
+ else if (!ffewhere_line_is_unknown (ffelab_firstref_line (l)))
+ ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
+ else if (!ffewhere_line_is_unknown (ffelab_doref_line (l)))
+ ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
+ else
+ ffebad_here (0, ffelab_definition_line (l), ffelab_definition_column (l));
+ ffebad_finish ();
+
+ switch (ffelab_type (l))
+ {
+ case FFELAB_typeFORMAT:
+ ffelab_set_definition_line (l,
+ ffewhere_line_use (ffelab_firstref_line (l)));
+ ffelab_set_definition_column (l,
+ ffewhere_column_use (ffelab_firstref_column (l)));
+ ffestv_num_label_defines_++;
+ f = ffestt_formatlist_create (NULL, NULL);
+ ffestd_labeldef_format (l);
+ ffestd_R1001 (f);
+ ffestt_formatlist_kill (f);
+ break;
+
+ case FFELAB_typeASSIGNABLE:
+ ffelab_set_definition_line (l,
+ ffewhere_line_use (ffelab_firstref_line (l)));
+ ffelab_set_definition_column (l,
+ ffewhere_column_use (ffelab_firstref_column (l)));
+ ffestv_num_label_defines_++;
+ ffelab_set_type (l, FFELAB_typeNOTLOOP);
+ ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
+ ffestd_labeldef_notloop (l);
+ ffestd_R842 (NULL);
+ break;
+
+ case FFELAB_typeNOTLOOP:
+ ffelab_set_definition_line (l,
+ ffewhere_line_use (ffelab_firstref_line (l)));
+ ffelab_set_definition_column (l,
+ ffewhere_column_use (ffelab_firstref_column (l)));
+ ffestv_num_label_defines_++;
+ ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
+ ffestd_labeldef_notloop (l);
+ ffestd_R842 (NULL);
+ break;
+
+ default:
+ assert ("bad label type" == NULL);
+ /* Fall through. */
+ case FFELAB_typeUNKNOWN:
+ case FFELAB_typeANY:
+ break;
+ }
+ }
+ }
+ ffelab_handle_done (h);
+ assert (undef == 0);
+}
+
+/* ffestd_subr_f90_ -- Report error about lack of full F90 support
+
+ ffestd_subr_f90_(); */
+
+#if FFESTR_F90
+static void
+ffestd_subr_f90_ ()
+{
+ ffebad_start (FFEBAD_F90);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+}
+
+#endif
+/* ffestd_subr_vxt_ -- Report error about lack of full VXT support
+
+ ffestd_subr_vxt_(); */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffestd_subr_vxt_ ()
+{
+ ffebad_start (FFEBAD_VXT_UNSUPPORTED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+}
+
+#endif
+/* ffestd_begin_uses -- Start a bunch of USE statements
+
+ ffestd_begin_uses();
+
+ Invoked before handling the first USE statement in a block of one or
+ more USE statements. _end_uses_(bool ok) is invoked before handling
+ the first statement after the block (there are no BEGIN USE and END USE
+ statements, but the semantics of USE statements effectively requires
+ handling them as a single block rather than one statement at a time). */
+
+void
+ffestd_begin_uses ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("; begin_uses\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_do -- End of statement following DO-term-stmt etc
+
+ ffestd_do(TRUE);
+
+ Also invoked by _labeldef_branch_finish_ (or, in cases
+ of errors, other _labeldef_ functions) when the label definition is
+ for a DO-target (LOOPEND) label, once per matching/outstanding DO
+ block on the stack. These cases invoke this function with ok==TRUE, so
+ only forced stack popping (via ffestd_eof_()) invokes it with ok==FALSE. */
+
+void
+ffestd_do (bool ok UNUSED)
+{
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_do (ffestw_stack_top ());
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidENDDOLOOP_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.enddoloop.block = ffestw_stack_top ();
+ }
+#endif
+
+ --ffestd_block_level_;
+ assert (ffestd_block_level_ >= 0);
+}
+
+/* ffestd_end_uses -- End a bunch of USE statements
+
+ ffestd_end_uses(TRUE);
+
+ ok==TRUE means simply not popping due to ffestd_eof_()
+ being called, because there is no formal END USES statement in Fortran. */
+
+#if FFESTR_F90
+void
+ffestd_end_uses (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("; end_uses\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_end_R740 -- End a WHERE(-THEN)
+
+ ffestd_end_R740(TRUE); */
+
+void
+ffestd_end_R740 (bool ok)
+{
+ return; /* F90. */
+}
+
+#endif
+/* ffestd_end_R807 -- End of statement following logical IF
+
+ ffestd_end_R807(TRUE);
+
+ Applies ONLY to logical IF, not to IF-THEN. For example, does not
+ ffelex_token_kill the construct name for an IF-THEN block (the name
+ field is invalid for logical IF). ok==TRUE iff statement following
+ logical IF (substatement) is valid; else, statement is invalid or
+ stack forcibly popped due to ffestd_eof_(). */
+
+void
+ffestd_end_R807 (bool ok UNUSED)
+{
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_end_R807 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidENDLOGIF_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ }
+#endif
+
+ --ffestd_block_level_;
+ assert (ffestd_block_level_ >= 0);
+}
+
+/* ffestd_exec_begin -- Executable statements can start coming in now
+
+ ffestd_exec_begin(); */
+
+void
+ffestd_exec_begin ()
+{
+ ffecom_exec_transition ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("{ begin_exec\n", dmpout);
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ if (ffestd_2pass_entrypoints_ != 0)
+ { /* Process pending ENTRY statements now that
+ info filled in. */
+ ffestdStmt_ stmt;
+ int ents = ffestd_2pass_entrypoints_;
+
+ stmt = ffestd_stmt_list_.first;
+ do
+ {
+ while (stmt->id != FFESTD_stmtidR1226_)
+ stmt = stmt->next;
+
+ if (!ffecom_2pass_advise_entrypoint (stmt->u.R1226.entry))
+ {
+ stmt->u.R1226.entry = NULL;
+ --ffestd_2pass_entrypoints_;
+ }
+ stmt = stmt->next;
+ }
+ while (--ents != 0);
+ }
+#endif
+}
+
+/* ffestd_exec_end -- Executable statements can no longer come in now
+
+ ffestd_exec_end(); */
+
+void
+ffestd_exec_end ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ int old_lineno = lineno;
+ char *old_input_filename = input_filename;
+#endif
+
+ ffecom_end_transition ();
+
+#if FFECOM_TWOPASS
+ ffestd_stmt_pass_ ();
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("} end_exec\n", dmpout);
+ fputs ("> end_unit\n", dmpout);
+#endif
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffecom_finish_progunit ();
+
+ if (ffestd_2pass_entrypoints_ != 0)
+ {
+ int ents = ffestd_2pass_entrypoints_;
+ ffestdStmt_ stmt = ffestd_stmt_list_.first;
+
+ do
+ {
+ while (stmt->id != FFESTD_stmtidR1226_)
+ stmt = stmt->next;
+
+ if (stmt->u.R1226.entry != NULL)
+ {
+ ffestd_subr_line_restore_ (stmt);
+ ffecom_2pass_do_entrypoint (stmt->u.R1226.entry);
+ }
+ stmt = stmt->next;
+ }
+ while (--ents != 0);
+ }
+
+ ffestd_stmt_list_.first = NULL;
+ ffestd_stmt_list_.last = NULL;
+ ffestd_2pass_entrypoints_ = 0;
+
+ lineno = old_lineno;
+ input_filename = old_input_filename;
+#endif
+}
+
+/* ffestd_init_3 -- Initialize for any program unit
+
+ ffestd_init_3(); */
+
+void
+ffestd_init_3 ()
+{
+#if FFECOM_TWOPASS
+ ffestd_stmt_list_.first = (ffestdStmt_) &ffestd_stmt_list_.first;
+ ffestd_stmt_list_.last = (ffestdStmt_) &ffestd_stmt_list_.first;
+#endif
+}
+
+/* Generate "code" for "any" label def. */
+
+void
+ffestd_labeldef_any (ffelab label UNUSED)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "; any_label_def %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_labeldef_branch -- Generate "code" for branch label def
+
+ ffestd_labeldef_branch(label); */
+
+void
+ffestd_labeldef_branch (ffelab label)
+{
+#if FFECOM_ONEPASS
+ ffeste_labeldef_branch (label);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidEXECLABEL_);
+ ffestd_stmt_append_ (stmt);
+ stmt->u.execlabel.label = label;
+ }
+#endif
+
+ ffestd_is_reachable_ = TRUE;
+}
+
+/* ffestd_labeldef_format -- Generate "code" for FORMAT label def
+
+ ffestd_labeldef_format(label); */
+
+void
+ffestd_labeldef_format (ffelab label)
+{
+ ffestd_label_formatdef_ = label;
+
+#if FFECOM_ONEPASS
+ ffeste_labeldef_format (label);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_);
+ ffestd_stmt_append_ (stmt);
+ stmt->u.formatlabel.label = label;
+ }
+#endif
+}
+
+/* ffestd_labeldef_useless -- Generate "code" for useless label def
+
+ ffestd_labeldef_useless(label); */
+
+void
+ffestd_labeldef_useless (ffelab label UNUSED)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "; useless_label_def %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R423A -- PRIVATE statement (in R422 derived-type statement)
+
+ ffestd_R423A(); */
+
+#if FFESTR_F90
+void
+ffestd_R423A ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* PRIVATE_derived_type\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R423B -- SEQUENCE statement (in R422 derived-type-stmt)
+
+ ffestd_R423B(); */
+
+void
+ffestd_R423B ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* SEQUENCE_derived_type\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R424 -- derived-TYPE-def statement
+
+ ffestd_R424(access_token,access_kw,name_token);
+
+ Handle a derived-type definition. */
+
+void
+ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ char *a;
+
+ if (access == NULL)
+ fprintf (dmpout, "* TYPE %s\n", ffelex_token_text (name));
+ else
+ {
+ switch (access_kw)
+ {
+ case FFESTR_otherPUBLIC:
+ a = "PUBLIC";
+ break;
+
+ case FFESTR_otherPRIVATE:
+ a = "PRIVATE";
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ fprintf (dmpout, "* TYPE,%s: %s\n", a, ffelex_token_text (name));
+ }
+#endif
+}
+
+/* ffestd_R425 -- End a TYPE
+
+ ffestd_R425(TRUE); */
+
+void
+ffestd_R425 (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "* END_TYPE %s\n", ffelex_token_text (ffestw_name (ffestw_stack_top ())));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R519_start -- INTENT statement list begin
+
+ ffestd_R519_start();
+
+ Verify that INTENT is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R519_start (ffestrOther intent_kw)
+{
+ ffestd_check_start_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ char *a;
+
+ switch (intent_kw)
+ {
+ case FFESTR_otherIN:
+ a = "IN";
+ break;
+
+ case FFESTR_otherOUT:
+ a = "OUT";
+ break;
+
+ case FFESTR_otherINOUT:
+ a = "INOUT";
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ fprintf (dmpout, "* INTENT (%s) ", a);
+#endif
+}
+
+/* ffestd_R519_item -- INTENT statement for name
+
+ ffestd_R519_item(name_token);
+
+ Make sure name_token identifies a valid object to be INTENTed. */
+
+void
+ffestd_R519_item (ffelexToken name)
+{
+ ffestd_check_item_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R519_finish -- INTENT statement list complete
+
+ ffestd_R519_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R519_finish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R520_start -- OPTIONAL statement list begin
+
+ ffestd_R520_start();
+
+ Verify that OPTIONAL is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R520_start ()
+{
+ ffestd_check_start_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("* OPTIONAL ", dmpout);
+#endif
+}
+
+/* ffestd_R520_item -- OPTIONAL statement for name
+
+ ffestd_R520_item(name_token);
+
+ Make sure name_token identifies a valid object to be OPTIONALed. */
+
+void
+ffestd_R520_item (ffelexToken name)
+{
+ ffestd_check_item_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R520_finish -- OPTIONAL statement list complete
+
+ ffestd_R520_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R520_finish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R521A -- PUBLIC statement
+
+ ffestd_R521A();
+
+ Verify that PUBLIC is valid here. */
+
+void
+ffestd_R521A ()
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("* PUBLIC\n", dmpout);
+#endif
+}
+
+/* ffestd_R521Astart -- PUBLIC statement list begin
+
+ ffestd_R521Astart();
+
+ Verify that PUBLIC is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R521Astart ()
+{
+ ffestd_check_start_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("* PUBLIC ", dmpout);
+#endif
+}
+
+/* ffestd_R521Aitem -- PUBLIC statement for name
+
+ ffestd_R521Aitem(name_token);
+
+ Make sure name_token identifies a valid object to be PUBLICed. */
+
+void
+ffestd_R521Aitem (ffelexToken name)
+{
+ ffestd_check_item_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R521Afinish -- PUBLIC statement list complete
+
+ ffestd_R521Afinish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R521Afinish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R521B -- PRIVATE statement
+
+ ffestd_R521B();
+
+ Verify that PRIVATE is valid here (outside a derived-type statement). */
+
+void
+ffestd_R521B ()
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("* PRIVATE_outside_of_R422_derived_type_def\n", dmpout);
+#endif
+}
+
+/* ffestd_R521Bstart -- PRIVATE statement list begin
+
+ ffestd_R521Bstart();
+
+ Verify that PRIVATE is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R521Bstart ()
+{
+ ffestd_check_start_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("* PRIVATE ", dmpout);
+#endif
+}
+
+/* ffestd_R521Bitem -- PRIVATE statement for name
+
+ ffestd_R521Bitem(name_token);
+
+ Make sure name_token identifies a valid object to be PRIVATEed. */
+
+void
+ffestd_R521Bitem (ffelexToken name)
+{
+ ffestd_check_item_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R521Bfinish -- PRIVATE statement list complete
+
+ ffestd_R521Bfinish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R521Bfinish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R522 -- SAVE statement with no list
+
+ ffestd_R522();
+
+ Verify that SAVE is valid here, and flag everything as SAVEd. */
+
+void
+ffestd_R522 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* SAVE_all\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R522start -- SAVE statement list begin
+
+ ffestd_R522start();
+
+ Verify that SAVE is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R522start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* SAVE ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R522item_object -- SAVE statement for object-name
+
+ ffestd_R522item_object(name_token);
+
+ Make sure name_token identifies a valid object to be SAVEd. */
+
+void
+ffestd_R522item_object (ffelexToken name UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R522item_cblock -- SAVE statement for common-block-name
+
+ ffestd_R522item_cblock(name_token);
+
+ Make sure name_token identifies a valid common block to be SAVEd. */
+
+void
+ffestd_R522item_cblock (ffelexToken name UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "/%s/,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R522finish -- SAVE statement list complete
+
+ ffestd_R522finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R522finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R524_start -- DIMENSION statement list begin
+
+ ffestd_R524_start(bool virtual);
+
+ Verify that DIMENSION is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R524_start (bool virtual UNUSED)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (virtual)
+ fputs ("* VIRTUAL ", dmpout); /* V028. */
+ else
+ fputs ("* DIMENSION ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R524_item -- DIMENSION statement for object-name
+
+ ffestd_R524_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be DIMENSIONd. */
+
+void
+ffestd_R524_item (ffelexToken name UNUSED, ffesttDimList dims UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (ffelex_token_text (name), dmpout);
+ fputc ('(', dmpout);
+ ffestt_dimlist_dump (dims);
+ fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R524_finish -- DIMENSION statement list complete
+
+ ffestd_R524_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R524_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R525_start -- ALLOCATABLE statement list begin
+
+ ffestd_R525_start();
+
+ Verify that ALLOCATABLE is valid here, and begin accepting items in the
+ list. */
+
+#if FFESTR_F90
+void
+ffestd_R525_start ()
+{
+ ffestd_check_start_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("* ALLOCATABLE ", dmpout);
+#endif
+}
+
+/* ffestd_R525_item -- ALLOCATABLE statement for object-name
+
+ ffestd_R525_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be ALLOCATABLEd. */
+
+void
+ffestd_R525_item (ffelexToken name, ffesttDimList dims)
+{
+ ffestd_check_item_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputs (ffelex_token_text (name), dmpout);
+ if (dims != NULL)
+ {
+ fputc ('(', dmpout);
+ ffestt_dimlist_dump (dims);
+ fputc (')', dmpout);
+ }
+ fputc (',', dmpout);
+#endif
+}
+
+/* ffestd_R525_finish -- ALLOCATABLE statement list complete
+
+ ffestd_R525_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R525_finish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R526_start -- POINTER statement list begin
+
+ ffestd_R526_start();
+
+ Verify that POINTER is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_R526_start ()
+{
+ ffestd_check_start_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("* POINTER ", dmpout);
+#endif
+}
+
+/* ffestd_R526_item -- POINTER statement for object-name
+
+ ffestd_R526_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be POINTERd. */
+
+void
+ffestd_R526_item (ffelexToken name, ffesttDimList dims)
+{
+ ffestd_check_item_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputs (ffelex_token_text (name), dmpout);
+ if (dims != NULL)
+ {
+ fputc ('(', dmpout);
+ ffestt_dimlist_dump (dims);
+ fputc (')', dmpout);
+ }
+ fputc (',', dmpout);
+#endif
+}
+
+/* ffestd_R526_finish -- POINTER statement list complete
+
+ ffestd_R526_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R526_finish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R527_start -- TARGET statement list begin
+
+ ffestd_R527_start();
+
+ Verify that TARGET is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_R527_start ()
+{
+ ffestd_check_start_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("* TARGET ", dmpout);
+#endif
+}
+
+/* ffestd_R527_item -- TARGET statement for object-name
+
+ ffestd_R527_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be TARGETd. */
+
+void
+ffestd_R527_item (ffelexToken name, ffesttDimList dims)
+{
+ ffestd_check_item_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputs (ffelex_token_text (name), dmpout);
+ if (dims != NULL)
+ {
+ fputc ('(', dmpout);
+ ffestt_dimlist_dump (dims);
+ fputc (')', dmpout);
+ }
+ fputc (',', dmpout);
+#endif
+}
+
+/* ffestd_R527_finish -- TARGET statement list complete
+
+ ffestd_R527_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R527_finish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R537_start -- PARAMETER statement list begin
+
+ ffestd_R537_start();
+
+ Verify that PARAMETER is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R537_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* PARAMETER (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R537_item -- PARAMETER statement assignment
+
+ ffestd_R537_item(dest,dest_token,source,source_token);
+
+ Make sure the source is a valid source for the destination; make the
+ assignment. */
+
+void
+ffestd_R537_item (ffebld dest UNUSED, ffebld source UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (dest);
+ fputc ('=', dmpout);
+ ffebld_dump (source);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R537_finish -- PARAMETER statement list complete
+
+ ffestd_R537_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R537_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R539 -- IMPLICIT NONE statement
+
+ ffestd_R539();
+
+ Verify that the IMPLICIT NONE statement is ok here and implement. */
+
+void
+ffestd_R539 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* IMPLICIT_NONE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R539start -- IMPLICIT statement
+
+ ffestd_R539start();
+
+ Verify that the IMPLICIT statement is ok here and implement. */
+
+void
+ffestd_R539start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* IMPLICIT ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R539item -- IMPLICIT statement specification (R540)
+
+ ffestd_R539item(...);
+
+ Verify that the type and letter list are all ok and implement. */
+
+void
+ffestd_R539item (ffestpType type UNUSED, ffebld kind UNUSED,
+ ffelexToken kindt UNUSED, ffebld len UNUSED,
+ ffelexToken lent UNUSED, ffesttImpList letters UNUSED)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ char *a;
+#endif
+
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ switch (type)
+ {
+ case FFESTP_typeINTEGER:
+ a = "INTEGER";
+ break;
+
+ case FFESTP_typeBYTE:
+ a = "BYTE";
+ break;
+
+ case FFESTP_typeWORD:
+ a = "WORD";
+ break;
+
+ case FFESTP_typeREAL:
+ a = "REAL";
+ break;
+
+ case FFESTP_typeCOMPLEX:
+ a = "COMPLEX";
+ break;
+
+ case FFESTP_typeLOGICAL:
+ a = "LOGICAL";
+ break;
+
+ case FFESTP_typeCHARACTER:
+ a = "CHARACTER";
+ break;
+
+ case FFESTP_typeDBLPRCSN:
+ a = "DOUBLE PRECISION";
+ break;
+
+ case FFESTP_typeDBLCMPLX:
+ a = "DOUBLE COMPLEX";
+ break;
+
+#if FFESTR_F90
+ case FFESTP_typeTYPE:
+ a = "TYPE";
+ break;
+#endif
+
+ default:
+ assert (FALSE);
+ a = "?";
+ break;
+ }
+ fprintf (dmpout, "%s(", a);
+ if (kindt != NULL)
+ {
+ fputs ("kind=", dmpout);
+ if (kind == NULL)
+ fputs (ffelex_token_text (kindt), dmpout);
+ else
+ ffebld_dump (kind);
+ if (lent != NULL)
+ fputc (',', dmpout);
+ }
+ if (lent != NULL)
+ {
+ fputs ("len=", dmpout);
+ if (len == NULL)
+ fputs (ffelex_token_text (lent), dmpout);
+ else
+ ffebld_dump (len);
+ }
+ fputs (")(", dmpout);
+ ffestt_implist_dump (letters);
+ fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R539finish -- IMPLICIT statement
+
+ ffestd_R539finish();
+
+ Finish up any local activities. */
+
+void
+ffestd_R539finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R542_start -- NAMELIST statement list begin
+
+ ffestd_R542_start();
+
+ Verify that NAMELIST is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R542_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* NAMELIST ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R542_item_nlist -- NAMELIST statement for group-name
+
+ ffestd_R542_item_nlist(groupname_token);
+
+ Make sure name_token identifies a valid object to be NAMELISTd. */
+
+void
+ffestd_R542_item_nlist (ffelexToken name UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "/%s/", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R542_item_nitem -- NAMELIST statement for variable-name
+
+ ffestd_R542_item_nitem(name_token);
+
+ Make sure name_token identifies a valid object to be NAMELISTd. */
+
+void
+ffestd_R542_item_nitem (ffelexToken name UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R542_finish -- NAMELIST statement list complete
+
+ ffestd_R542_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R542_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R544_start -- EQUIVALENCE statement list begin
+
+ ffestd_R544_start();
+
+ Verify that EQUIVALENCE is valid here, and begin accepting items in the
+ list. */
+
+#if 0
+void
+ffestd_R544_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* EQUIVALENCE (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffestd_R544_item -- EQUIVALENCE statement assignment
+
+ ffestd_R544_item(exprlist);
+
+ Make sure the equivalence is valid, then implement it. */
+
+#if 0
+void
+ffestd_R544_item (ffesttExprList exprlist)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffestt_exprlist_dump (exprlist);
+ fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffestd_R544_finish -- EQUIVALENCE statement list complete
+
+ ffestd_R544_finish();
+
+ Just wrap up any local activities. */
+
+#if 0
+void
+ffestd_R544_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffestd_R547_start -- COMMON statement list begin
+
+ ffestd_R547_start();
+
+ Verify that COMMON is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R547_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* COMMON ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R547_item_object -- COMMON statement for object-name
+
+ ffestd_R547_item_object(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be COMMONd. */
+
+void
+ffestd_R547_item_object (ffelexToken name UNUSED,
+ ffesttDimList dims UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (ffelex_token_text (name), dmpout);
+ if (dims != NULL)
+ {
+ fputc ('(', dmpout);
+ ffestt_dimlist_dump (dims);
+ fputc (')', dmpout);
+ }
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R547_item_cblock -- COMMON statement for common-block-name
+
+ ffestd_R547_item_cblock(name_token);
+
+ Make sure name_token identifies a valid common block to be COMMONd. */
+
+void
+ffestd_R547_item_cblock (ffelexToken name UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (name == NULL)
+ fputs ("//,", dmpout);
+ else
+ fprintf (dmpout, "/%s/,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R547_finish -- COMMON statement list complete
+
+ ffestd_R547_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R547_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R620 -- ALLOCATE statement
+
+ ffestd_R620(exprlist,stat,stat_token);
+
+ Make sure the expression list is valid, then implement it. */
+
+#if FFESTR_F90
+void
+ffestd_R620 (ffesttExprList exprlist, ffebld stat)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("+ ALLOCATE (", dmpout);
+ ffestt_exprlist_dump (exprlist);
+ if (stat != NULL)
+ {
+ fputs (",stat=", dmpout);
+ ffebld_dump (stat);
+ }
+ fputs (")\n", dmpout);
+#endif
+}
+
+/* ffestd_R624 -- NULLIFY statement
+
+ ffestd_R624(pointer_name_list);
+
+ Make sure pointer_name_list identifies valid pointers for a NULLIFY. */
+
+void
+ffestd_R624 (ffesttExprList pointers)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("+ NULLIFY (", dmpout);
+ assert (pointers != NULL);
+ ffestt_exprlist_dump (pointers);
+ fputs (")\n", dmpout);
+#endif
+}
+
+/* ffestd_R625 -- DEALLOCATE statement
+
+ ffestd_R625(exprlist,stat,stat_token);
+
+ Make sure the equivalence is valid, then implement it. */
+
+void
+ffestd_R625 (ffesttExprList exprlist, ffebld stat)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("+ DEALLOCATE (", dmpout);
+ ffestt_exprlist_dump (exprlist);
+ if (stat != NULL)
+ {
+ fputs (",stat=", dmpout);
+ ffebld_dump (stat);
+ }
+ fputs (")\n", dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R737A -- Assignment statement outside of WHERE
+
+ ffestd_R737A(dest_expr,source_expr); */
+
+void
+ffestd_R737A (ffebld dest, ffebld source)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R737A (dest, source);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR737A_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R737A.pool = ffesta_output_pool;
+ stmt->u.R737A.dest = dest;
+ stmt->u.R737A.source = source;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R737B -- Assignment statement inside of WHERE
+
+ ffestd_R737B(dest_expr,source_expr); */
+
+#if FFESTR_F90
+void
+ffestd_R737B (ffebld dest, ffebld source)
+{
+ ffestd_check_simple_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputs ("+ let_inside_where ", dmpout);
+ ffebld_dump (dest);
+ fputs ("=", dmpout);
+ ffebld_dump (source);
+ fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R738 -- Pointer assignment statement
+
+ ffestd_R738(dest_expr,source_expr,source_token);
+
+ Make sure the assignment is valid. */
+
+void
+ffestd_R738 (ffebld dest, ffebld source)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("+ let_pointer ", dmpout);
+ ffebld_dump (dest);
+ fputs ("=>", dmpout);
+ ffebld_dump (source);
+ fputc ('\n', dmpout);
+#endif
+}
+
+/* ffestd_R740 -- WHERE statement
+
+ ffestd_R740(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestd_R740 (ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("+ WHERE (", dmpout);
+ ffebld_dump (expr);
+ fputs (")\n", dmpout);
+
+ ++ffestd_block_level_;
+ assert (ffestd_block_level_ > 0);
+#endif
+}
+
+/* ffestd_R742 -- WHERE-construct statement
+
+ ffestd_R742(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestd_R742 (ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("+ WHERE_construct (", dmpout);
+ ffebld_dump (expr);
+ fputs (")\n", dmpout);
+
+ ++ffestd_block_level_;
+ assert (ffestd_block_level_ > 0);
+#endif
+}
+
+/* ffestd_R744 -- ELSE WHERE statement
+
+ ffestd_R744();
+
+ Make sure ffestd_kind_ identifies a WHERE block.
+ Implement the ELSE of the current WHERE block. */
+
+void
+ffestd_R744 ()
+{
+ ffestd_check_simple_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputs ("+ ELSE_WHERE\n", dmpout);
+#endif
+}
+
+/* ffestd_R745 -- Implicit END WHERE statement
+
+ ffestd_R745(TRUE);
+
+ Implement the end of the current WHERE "block". ok==TRUE iff statement
+ following WHERE (substatement) is valid; else, statement is invalid
+ or stack forcibly popped due to ffestd_eof_(). */
+
+void
+ffestd_R745 (bool ok)
+{
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputs ("+ END_WHERE\n", dmpout); /* Also see ffestd_R745. */
+
+ --ffestd_block_level_;
+ assert (ffestd_block_level_ >= 0);
+#endif
+}
+
+#endif
+/* ffestd_R803 -- Block IF (IF-THEN) statement
+
+ ffestd_R803(construct_name,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R803 (expr); /* Don't bother with name. */
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR803_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R803.pool = ffesta_output_pool;
+ stmt->u.R803.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+ ++ffestd_block_level_;
+ assert (ffestd_block_level_ > 0);
+}
+
+/* ffestd_R804 -- ELSE IF statement
+
+ ffestd_R804(expr,expr_token,name_token);
+
+ Make sure ffestd_kind_ identifies an IF block. If not
+ NULL, make sure name_token gives the correct name. Implement the else
+ of the IF block. */
+
+void
+ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R804 (expr); /* Don't bother with name. */
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR804_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R804.pool = ffesta_output_pool;
+ stmt->u.R804.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R805 -- ELSE statement
+
+ ffestd_R805(name_token);
+
+ Make sure ffestd_kind_ identifies an IF block. If not
+ NULL, make sure name_token gives the correct name. Implement the ELSE
+ of the IF block. */
+
+void
+ffestd_R805 (ffelexToken name UNUSED)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R805 (); /* Don't bother with name. */
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ }
+#endif
+}
+
+/* ffestd_R806 -- End an IF-THEN
+
+ ffestd_R806(TRUE); */
+
+void
+ffestd_R806 (bool ok UNUSED)
+{
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R806 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ }
+#endif
+
+ --ffestd_block_level_;
+ assert (ffestd_block_level_ >= 0);
+}
+
+/* ffestd_R807 -- Logical IF statement
+
+ ffestd_R807(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestd_R807 (ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R807 (expr);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR807_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R807.pool = ffesta_output_pool;
+ stmt->u.R807.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+ ++ffestd_block_level_;
+ assert (ffestd_block_level_ > 0);
+}
+
+/* ffestd_R809 -- SELECT CASE statement
+
+ ffestd_R809(construct_name,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestd_R809 (ffelexToken construct_name UNUSED, ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R809 (ffestw_stack_top (), expr);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR809_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R809.pool = ffesta_output_pool;
+ stmt->u.R809.block = ffestw_use (ffestw_stack_top ());
+ stmt->u.R809.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ malloc_pool_use (ffestw_select (ffestw_stack_top ())->pool);
+ }
+#endif
+
+ ++ffestd_block_level_;
+ assert (ffestd_block_level_ > 0);
+}
+
+/* ffestd_R810 -- CASE statement
+
+ ffestd_R810(case_value_range_list,name);
+
+ If casenum is 0, it's CASE DEFAULT. Else it's the case ranges at
+ the start of the first_stmt list in the select object at the top of
+ the stack that match casenum. */
+
+void
+ffestd_R810 (unsigned long casenum)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R810 (ffestw_stack_top (), casenum);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR810_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R810.pool = ffesta_output_pool;
+ stmt->u.R810.block = ffestw_stack_top ();
+ stmt->u.R810.casenum = casenum;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R811 -- End a SELECT
+
+ ffestd_R811(TRUE); */
+
+void
+ffestd_R811 (bool ok UNUSED)
+{
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R811 (ffestw_stack_top ());
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR811_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R811.block = ffestw_stack_top ();
+ }
+#endif
+
+ --ffestd_block_level_;
+ assert (ffestd_block_level_ >= 0);
+}
+
+/* ffestd_R819A -- Iterative DO statement
+
+ ffestd_R819A(construct_name,label_token,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestd_R819A (ffelexToken construct_name UNUSED, ffelab label,
+ ffebld var, ffebld start, ffelexToken start_token,
+ ffebld end, ffelexToken end_token,
+ ffebld incr, ffelexToken incr_token)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R819A (ffestw_stack_top (), label, var, start, end, incr,
+ incr_token);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR819A_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R819A.pool = ffesta_output_pool;
+ stmt->u.R819A.block = ffestw_use (ffestw_stack_top ());
+ stmt->u.R819A.label = label;
+ stmt->u.R819A.var = var;
+ stmt->u.R819A.start = start;
+ stmt->u.R819A.start_token = ffelex_token_use (start_token);
+ stmt->u.R819A.end = end;
+ stmt->u.R819A.end_token = ffelex_token_use (end_token);
+ stmt->u.R819A.incr = incr;
+ stmt->u.R819A.incr_token = (incr_token == NULL) ? NULL
+ : ffelex_token_use (incr_token);
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+ ++ffestd_block_level_;
+ assert (ffestd_block_level_ > 0);
+}
+
+/* ffestd_R819B -- DO WHILE statement
+
+ ffestd_R819B(construct_name,label_token,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestd_R819B (ffelexToken construct_name UNUSED, ffelab label,
+ ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R819B (ffestw_stack_top (), label, expr);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR819B_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R819B.pool = ffesta_output_pool;
+ stmt->u.R819B.block = ffestw_use (ffestw_stack_top ());
+ stmt->u.R819B.label = label;
+ stmt->u.R819B.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+ ++ffestd_block_level_;
+ assert (ffestd_block_level_ > 0);
+}
+
+/* ffestd_R825 -- END DO statement
+
+ ffestd_R825(name_token);
+
+ Make sure ffestd_kind_ identifies a DO block. If not
+ NULL, make sure name_token gives the correct name. Do whatever
+ is specific to seeing END DO with a DO-target label definition on it,
+ where the END DO is really treated as a CONTINUE (i.e. generate th
+ same code you would for CONTINUE). ffestd_do handles the actual
+ generation of end-loop code. */
+
+void
+ffestd_R825 (ffelexToken name UNUSED)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R825 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR825_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ }
+#endif
+}
+
+/* ffestd_R834 -- CYCLE statement
+
+ ffestd_R834(name_token);
+
+ Handle a CYCLE within a loop. */
+
+void
+ffestd_R834 (ffestw block)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R834 (block);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR834_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R834.block = block;
+ }
+#endif
+}
+
+/* ffestd_R835 -- EXIT statement
+
+ ffestd_R835(name_token);
+
+ Handle a EXIT within a loop. */
+
+void
+ffestd_R835 (ffestw block)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R835 (block);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR835_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R835.block = block;
+ }
+#endif
+}
+
+/* ffestd_R836 -- GOTO statement
+
+ ffestd_R836(label);
+
+ Make sure label_token identifies a valid label for a GOTO. Update
+ that label's info to indicate it is the target of a GOTO. */
+
+void
+ffestd_R836 (ffelab label)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R836 (label);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR836_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R836.label = label;
+ }
+#endif
+
+ if (ffestd_block_level_ == 0)
+ ffestd_is_reachable_ = FALSE;
+}
+
+/* ffestd_R837 -- Computed GOTO statement
+
+ ffestd_R837(labels,expr);
+
+ Make sure label_list identifies valid labels for a GOTO. Update
+ each label's info to indicate it is the target of a GOTO. */
+
+void
+ffestd_R837 (ffelab *labels, int count, ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R837 (labels, count, expr);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR837_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R837.pool = ffesta_output_pool;
+ stmt->u.R837.labels = labels;
+ stmt->u.R837.count = count;
+ stmt->u.R837.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R838 -- ASSIGN statement
+
+ ffestd_R838(label_token,target_variable,target_token);
+
+ Make sure label_token identifies a valid label for an assignment. Update
+ that label's info to indicate it is the source of an assignment. Update
+ target_variable's info to indicate it is the target the assignment of that
+ label. */
+
+void
+ffestd_R838 (ffelab label, ffebld target)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R838 (label, target);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR838_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R838.pool = ffesta_output_pool;
+ stmt->u.R838.label = label;
+ stmt->u.R838.target = target;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R839 -- Assigned GOTO statement
+
+ ffestd_R839(target,labels);
+
+ Make sure label_list identifies valid labels for a GOTO. Update
+ each label's info to indicate it is the target of a GOTO. */
+
+void
+ffestd_R839 (ffebld target, ffelab *labels UNUSED, int count UNUSED)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R839 (target);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR839_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R839.pool = ffesta_output_pool;
+ stmt->u.R839.target = target;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+ if (ffestd_block_level_ == 0)
+ ffestd_is_reachable_ = FALSE;
+}
+
+/* ffestd_R840 -- Arithmetic IF statement
+
+ ffestd_R840(expr,expr_token,neg,zero,pos);
+
+ Make sure the labels are valid; implement. */
+
+void
+ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R840 (expr, neg, zero, pos);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR840_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R840.pool = ffesta_output_pool;
+ stmt->u.R840.expr = expr;
+ stmt->u.R840.neg = neg;
+ stmt->u.R840.zero = zero;
+ stmt->u.R840.pos = pos;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+ if (ffestd_block_level_ == 0)
+ ffestd_is_reachable_ = FALSE;
+}
+
+/* ffestd_R841 -- CONTINUE statement
+
+ ffestd_R841(); */
+
+void
+ffestd_R841 (bool in_where UNUSED)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R841 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ }
+#endif
+}
+
+/* ffestd_R842 -- STOP statement
+
+ ffestd_R842(expr); */
+
+void
+ffestd_R842 (ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R842 (expr);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R842.pool = ffesta_output_pool;
+ stmt->u.R842.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+ if (ffestd_block_level_ == 0)
+ ffestd_is_reachable_ = FALSE;
+}
+
+/* ffestd_R843 -- PAUSE statement
+
+ ffestd_R843(expr,expr_token);
+
+ Make sure statement is valid here; implement. expr and expr_token are
+ both NULL if there was no expression. */
+
+void
+ffestd_R843 (ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R843 (expr);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR843_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R843.pool = ffesta_output_pool;
+ stmt->u.R843.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R904 -- OPEN statement
+
+ ffestd_R904();
+
+ Make sure an OPEN is valid in the current context, and implement it. */
+
+void
+ffestd_R904 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define specified(something) \
+ (ffestp_file.open.open_spec[something].kw_or_val_present)
+
+ /* Warn if there are any thing we don't handle via f2c libraries. */
+
+ if (specified (FFESTP_openixACTION)
+ || specified (FFESTP_openixASSOCIATEVARIABLE)
+ || specified (FFESTP_openixBLOCKSIZE)
+ || specified (FFESTP_openixBUFFERCOUNT)
+ || specified (FFESTP_openixCARRIAGECONTROL)
+ || specified (FFESTP_openixDEFAULTFILE)
+ || specified (FFESTP_openixDELIM)
+ || specified (FFESTP_openixDISPOSE)
+ || specified (FFESTP_openixEXTENDSIZE)
+ || specified (FFESTP_openixINITIALSIZE)
+ || specified (FFESTP_openixKEY)
+ || specified (FFESTP_openixMAXREC)
+ || specified (FFESTP_openixNOSPANBLOCKS)
+ || specified (FFESTP_openixORGANIZATION)
+ || specified (FFESTP_openixPAD)
+ || specified (FFESTP_openixPOSITION)
+ || specified (FFESTP_openixREADONLY)
+ || specified (FFESTP_openixRECORDTYPE)
+ || specified (FFESTP_openixSHARED)
+ || specified (FFESTP_openixUSEROPEN))
+ {
+ ffebad_start (FFEBAD_OPEN_UNSUPPORTED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+
+#undef specified
+#endif
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R904 (&ffestp_file.open);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR904_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R904.pool = ffesta_output_pool;
+ stmt->u.R904.params = ffestd_subr_copy_open_ ();
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R907 -- CLOSE statement
+
+ ffestd_R907();
+
+ Make sure a CLOSE is valid in the current context, and implement it. */
+
+void
+ffestd_R907 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R907 (&ffestp_file.close);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR907_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R907.pool = ffesta_output_pool;
+ stmt->u.R907.params = ffestd_subr_copy_close_ ();
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R909_start -- READ(...) statement list begin
+
+ ffestd_R909_start(FALSE);
+
+ Verify that READ is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_R909_start (bool only_format, ffestvUnit unit,
+ ffestvFormat format, bool rec, bool key)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define specified(something) \
+ (ffestp_file.read.read_spec[something].kw_or_val_present)
+
+ /* Warn if there are any thing we don't handle via f2c libraries. */
+ if (specified (FFESTP_readixADVANCE)
+ || specified (FFESTP_readixEOR)
+ || specified (FFESTP_readixKEYEQ)
+ || specified (FFESTP_readixKEYGE)
+ || specified (FFESTP_readixKEYGT)
+ || specified (FFESTP_readixKEYID)
+ || specified (FFESTP_readixNULLS)
+ || specified (FFESTP_readixSIZE))
+ {
+ ffebad_start (FFEBAD_READ_UNSUPPORTED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+
+#undef specified
+#endif
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R909_start (&ffestp_file.read, only_format, unit, format, rec, key);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR909_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R909.pool = ffesta_output_pool;
+ stmt->u.R909.params = ffestd_subr_copy_read_ ();
+ stmt->u.R909.only_format = only_format;
+ stmt->u.R909.unit = unit;
+ stmt->u.R909.format = format;
+ stmt->u.R909.rec = rec;
+ stmt->u.R909.key = key;
+ stmt->u.R909.list = NULL;
+ ffestd_expr_list_ = &stmt->u.R909.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R909_item -- READ statement i/o item
+
+ ffestd_R909_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_R909_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_ONEPASS
+ ffeste_R909_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ item->token = ffelex_token_use (expr_token);
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+}
+
+/* ffestd_R909_finish -- READ statement list complete
+
+ ffestd_R909_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R909_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_ONEPASS
+ ffeste_R909_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+}
+
+/* ffestd_R910_start -- WRITE(...) statement list begin
+
+ ffestd_R910_start();
+
+ Verify that WRITE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define specified(something) \
+ (ffestp_file.write.write_spec[something].kw_or_val_present)
+
+ /* Warn if there are any thing we don't handle via f2c libraries. */
+ if (specified (FFESTP_writeixADVANCE)
+ || specified (FFESTP_writeixEOR))
+ {
+ ffebad_start (FFEBAD_WRITE_UNSUPPORTED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+
+#undef specified
+#endif
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R910_start (&ffestp_file.write, unit, format, rec);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR910_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R910.pool = ffesta_output_pool;
+ stmt->u.R910.params = ffestd_subr_copy_write_ ();
+ stmt->u.R910.unit = unit;
+ stmt->u.R910.format = format;
+ stmt->u.R910.rec = rec;
+ stmt->u.R910.list = NULL;
+ ffestd_expr_list_ = &stmt->u.R910.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R910_item -- WRITE statement i/o item
+
+ ffestd_R910_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_R910_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_ONEPASS
+ ffeste_R910_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ item->token = ffelex_token_use (expr_token);
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+}
+
+/* ffestd_R910_finish -- WRITE statement list complete
+
+ ffestd_R910_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R910_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_ONEPASS
+ ffeste_R910_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+}
+
+/* ffestd_R911_start -- PRINT statement list begin
+
+ ffestd_R911_start();
+
+ Verify that PRINT is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_R911_start (ffestvFormat format)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R911_start (&ffestp_file.print, format);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR911_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R911.pool = ffesta_output_pool;
+ stmt->u.R911.params = ffestd_subr_copy_print_ ();
+ stmt->u.R911.format = format;
+ stmt->u.R911.list = NULL;
+ ffestd_expr_list_ = &stmt->u.R911.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R911_item -- PRINT statement i/o item
+
+ ffestd_R911_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_R911_item (ffebld expr, ffelexToken expr_token)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_ONEPASS
+ ffeste_R911_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ item->token = ffelex_token_use (expr_token);
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+}
+
+/* ffestd_R911_finish -- PRINT statement list complete
+
+ ffestd_R911_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R911_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_ONEPASS
+ ffeste_R911_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+}
+
+/* ffestd_R919 -- BACKSPACE statement
+
+ ffestd_R919();
+
+ Make sure a BACKSPACE is valid in the current context, and implement it. */
+
+void
+ffestd_R919 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R919 (&ffestp_file.beru);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR919_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R919.pool = ffesta_output_pool;
+ stmt->u.R919.params = ffestd_subr_copy_beru_ ();
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R920 -- ENDFILE statement
+
+ ffestd_R920();
+
+ Make sure a ENDFILE is valid in the current context, and implement it. */
+
+void
+ffestd_R920 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R920 (&ffestp_file.beru);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR920_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R920.pool = ffesta_output_pool;
+ stmt->u.R920.params = ffestd_subr_copy_beru_ ();
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R921 -- REWIND statement
+
+ ffestd_R921();
+
+ Make sure a REWIND is valid in the current context, and implement it. */
+
+void
+ffestd_R921 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R921 (&ffestp_file.beru);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR921_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R921.pool = ffesta_output_pool;
+ stmt->u.R921.params = ffestd_subr_copy_beru_ ();
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R923A -- INQUIRE statement (non-IOLENGTH version)
+
+ ffestd_R923A(bool by_file);
+
+ Make sure an INQUIRE is valid in the current context, and implement it. */
+
+void
+ffestd_R923A (bool by_file)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define specified(something) \
+ (ffestp_file.inquire.inquire_spec[something].kw_or_val_present)
+
+ /* Warn if there are any thing we don't handle via f2c libraries. */
+ if (specified (FFESTP_inquireixACTION)
+ || specified (FFESTP_inquireixCARRIAGECONTROL)
+ || specified (FFESTP_inquireixDEFAULTFILE)
+ || specified (FFESTP_inquireixDELIM)
+ || specified (FFESTP_inquireixKEYED)
+ || specified (FFESTP_inquireixORGANIZATION)
+ || specified (FFESTP_inquireixPAD)
+ || specified (FFESTP_inquireixPOSITION)
+ || specified (FFESTP_inquireixREAD)
+ || specified (FFESTP_inquireixREADWRITE)
+ || specified (FFESTP_inquireixRECORDTYPE)
+ || specified (FFESTP_inquireixWRITE))
+ {
+ ffebad_start (FFEBAD_INQUIRE_UNSUPPORTED);
+ ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ ffebad_finish ();
+ }
+
+#undef specified
+#endif
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R923A (&ffestp_file.inquire, by_file);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR923A_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R923A.pool = ffesta_output_pool;
+ stmt->u.R923A.params = ffestd_subr_copy_inquire_ ();
+ stmt->u.R923A.by_file = by_file;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
+
+ ffestd_R923B_start();
+
+ Verify that INQUIRE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_R923B_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R923B_start (&ffestp_file.inquire);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR923B_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R923B.pool = ffesta_output_pool;
+ stmt->u.R923B.params = ffestd_subr_copy_inquire_ ();
+ stmt->u.R923B.list = NULL;
+ ffestd_expr_list_ = &stmt->u.R923B.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R923B_item -- INQUIRE statement i/o item
+
+ ffestd_R923B_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_R923B_item (ffebld expr)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_ONEPASS
+ ffeste_R923B_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+}
+
+/* ffestd_R923B_finish -- INQUIRE statement list complete
+
+ ffestd_R923B_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R923B_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_ONEPASS
+ ffeste_R923B_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+}
+
+/* ffestd_R1001 -- FORMAT statement
+
+ ffestd_R1001(format_list); */
+
+void
+ffestd_R1001 (ffesttFormatList f)
+{
+ ffestsHolder str;
+ ffests s = &str;
+
+ ffestd_check_simple_ ();
+
+ if (ffestd_label_formatdef_ == NULL)
+ return; /* Nothing to hook it up to (no label def). */
+
+ ffests_new (s, malloc_pool_image (), 80);
+ ffests_putc (s, '(');
+ ffestd_R1001dump_ (s, f); /* Build the string in s. */
+ ffests_putc (s, ')');
+
+#if FFECOM_ONEPASS
+ ffeste_R1001 (s);
+ ffests_kill (s); /* Kill the string in s. */
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_);
+ ffestd_stmt_append_ (stmt);
+ stmt->u.R1001.str = str;
+ }
+#endif
+
+ ffestd_label_formatdef_ = NULL;
+}
+
+/* ffestd_R1001dump_ -- Dump list of formats
+
+ ffesttFormatList list;
+ ffestd_R1001dump_(list,0);
+
+ The formats in the list are dumped. */
+
+static void
+ffestd_R1001dump_ (ffests s, ffesttFormatList list)
+{
+ ffesttFormatList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ if (next != list->next)
+ ffests_putc (s, ',');
+ switch (next->type)
+ {
+ case FFESTP_formattypeI:
+ ffestd_R1001dump_1005_3_ (s, next, "I");
+ break;
+
+ case FFESTP_formattypeB:
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffestd_R1001dump_1005_3_ (s, next, "B");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_R1001error_ (next);
+#else
+#error
+#endif
+ break;
+
+ case FFESTP_formattypeO:
+ ffestd_R1001dump_1005_3_ (s, next, "O");
+ break;
+
+ case FFESTP_formattypeZ:
+ ffestd_R1001dump_1005_3_ (s, next, "Z");
+ break;
+
+ case FFESTP_formattypeF:
+ ffestd_R1001dump_1005_4_ (s, next, "F");
+ break;
+
+ case FFESTP_formattypeE:
+ ffestd_R1001dump_1005_5_ (s, next, "E");
+ break;
+
+ case FFESTP_formattypeEN:
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffestd_R1001dump_1005_5_ (s, next, "EN");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_R1001error_ (next);
+#else
+#error
+#endif
+ break;
+
+ case FFESTP_formattypeG:
+ ffestd_R1001dump_1005_5_ (s, next, "G");
+ break;
+
+ case FFESTP_formattypeL:
+ ffestd_R1001dump_1005_2_ (s, next, "L");
+ break;
+
+ case FFESTP_formattypeA:
+ ffestd_R1001dump_1005_1_ (s, next, "A");
+ break;
+
+ case FFESTP_formattypeD:
+ ffestd_R1001dump_1005_4_ (s, next, "D");
+ break;
+
+ case FFESTP_formattypeQ:
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffestd_R1001dump_1010_1_ (s, next, "Q");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_R1001error_ (next);
+#else
+#error
+#endif
+ break;
+
+ case FFESTP_formattypeDOLLAR:
+ ffestd_R1001dump_1010_1_ (s, next, "$");
+ break;
+
+ case FFESTP_formattypeP:
+ ffestd_R1001dump_1010_4_ (s, next, "P");
+ break;
+
+ case FFESTP_formattypeT:
+ ffestd_R1001dump_1010_5_ (s, next, "T");
+ break;
+
+ case FFESTP_formattypeTL:
+ ffestd_R1001dump_1010_5_ (s, next, "TL");
+ break;
+
+ case FFESTP_formattypeTR:
+ ffestd_R1001dump_1010_5_ (s, next, "TR");
+ break;
+
+ case FFESTP_formattypeX:
+ ffestd_R1001dump_1010_3_ (s, next, "X");
+ break;
+
+ case FFESTP_formattypeS:
+ ffestd_R1001dump_1010_1_ (s, next, "S");
+ break;
+
+ case FFESTP_formattypeSP:
+ ffestd_R1001dump_1010_1_ (s, next, "SP");
+ break;
+
+ case FFESTP_formattypeSS:
+ ffestd_R1001dump_1010_1_ (s, next, "SS");
+ break;
+
+ case FFESTP_formattypeBN:
+ ffestd_R1001dump_1010_1_ (s, next, "BN");
+ break;
+
+ case FFESTP_formattypeBZ:
+ ffestd_R1001dump_1010_1_ (s, next, "BZ");
+ break;
+
+ case FFESTP_formattypeSLASH:
+ ffestd_R1001dump_1010_2_ (s, next, "/");
+ break;
+
+ case FFESTP_formattypeCOLON:
+ ffestd_R1001dump_1010_1_ (s, next, ":");
+ break;
+
+ case FFESTP_formattypeR1016:
+ switch (ffelex_token_type (next->t))
+ {
+ case FFELEX_typeCHARACTER:
+ {
+ char *p = ffelex_token_text (next->t);
+ ffeTokenLength i = ffelex_token_length (next->t);
+
+ ffests_putc (s, '\002');
+ while (i-- != 0)
+ {
+ if (*p == '\002')
+ ffests_putc (s, '\002');
+ ffests_putc (s, *p);
+ ++p;
+ }
+ ffests_putc (s, '\002');
+ }
+ break;
+
+ case FFELEX_typeHOLLERITH:
+ {
+ char *p = ffelex_token_text (next->t);
+ ffeTokenLength i = ffelex_token_length (next->t);
+
+ ffests_printf_1U (s,
+ "%" ffeTokenLength_f "uH",
+ i);
+ while (i-- != 0)
+ {
+ ffests_putc (s, *p);
+ ++p;
+ }
+ }
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ break;
+
+ case FFESTP_formattypeFORMAT:
+ if (next->u.R1003D.R1004.present)
+ if (next->u.R1003D.R1004.rtexpr)
+ ffestd_R1001error_ (next);
+ else
+ ffests_printf_1U (s, "%lu",
+ next->u.R1003D.R1004.u.unsigned_val);
+
+ ffests_putc (s, '(');
+ ffestd_R1001dump_ (s, next->u.R1003D.format);
+ ffests_putc (s, ')');
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+}
+
+/* ffestd_R1001dump_1005_1_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1005_1_(f,"I");
+
+ The format is dumped with form [r]X[w]. */
+
+static void
+ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (!f->u.R1005.R1007_or_R1008.present);
+ assert (!f->u.R1005.R1009.present);
+
+ if (f->u.R1005.R1004.present)
+ if (f->u.R1005.R1004.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+ ffests_puts (s, string);
+
+ if (f->u.R1005.R1006.present)
+ if (f->u.R1005.R1006.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
+}
+
+/* ffestd_R1001dump_1005_2_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1005_2_(f,"I");
+
+ The format is dumped with form [r]Xw. */
+
+static void
+ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (!f->u.R1005.R1007_or_R1008.present);
+ assert (!f->u.R1005.R1009.present);
+ assert (f->u.R1005.R1006.present);
+
+ if (f->u.R1005.R1004.present)
+ if (f->u.R1005.R1004.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+ ffests_puts (s, string);
+
+ if (f->u.R1005.R1006.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
+}
+
+/* ffestd_R1001dump_1005_3_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1005_3_(f,"I");
+
+ The format is dumped with form [r]Xw[.m]. */
+
+static void
+ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (!f->u.R1005.R1009.present);
+ assert (f->u.R1005.R1006.present);
+
+ if (f->u.R1005.R1004.present)
+ if (f->u.R1005.R1004.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+ ffests_puts (s, string);
+
+ if (f->u.R1005.R1006.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
+
+ if (f->u.R1005.R1007_or_R1008.present)
+ {
+ ffests_putc (s, '.');
+ if (f->u.R1005.R1007_or_R1008.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu",
+ f->u.R1005.R1007_or_R1008.u.unsigned_val);
+ }
+}
+
+/* ffestd_R1001dump_1005_4_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1005_4_(f,"I");
+
+ The format is dumped with form [r]Xw.d. */
+
+static void
+ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (!f->u.R1005.R1009.present);
+ assert (f->u.R1005.R1007_or_R1008.present);
+ assert (f->u.R1005.R1006.present);
+
+ if (f->u.R1005.R1004.present)
+ if (f->u.R1005.R1004.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+ ffests_puts (s, string);
+
+ if (f->u.R1005.R1006.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
+
+ ffests_putc (s, '.');
+ if (f->u.R1005.R1007_or_R1008.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
+}
+
+/* ffestd_R1001dump_1005_5_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1005_5_(f,"I");
+
+ The format is dumped with form [r]Xw.d[Ee]. */
+
+static void
+ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (f->u.R1005.R1007_or_R1008.present);
+ assert (f->u.R1005.R1006.present);
+
+ if (f->u.R1005.R1004.present)
+ if (f->u.R1005.R1004.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
+
+ ffests_puts (s, string);
+
+ if (f->u.R1005.R1006.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
+
+ ffests_putc (s, '.');
+ if (f->u.R1005.R1007_or_R1008.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
+
+ if (f->u.R1005.R1009.present)
+ {
+ ffests_putc (s, 'E');
+ if (f->u.R1005.R1009.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1005.R1009.u.unsigned_val);
+ }
+}
+
+/* ffestd_R1001dump_1010_1_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1010_1_(f,"I");
+
+ The format is dumped with form X. */
+
+static void
+ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (!f->u.R1010.val.present);
+
+ ffests_puts (s, string);
+}
+
+/* ffestd_R1001dump_1010_2_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1010_2_(f,"I");
+
+ The format is dumped with form [r]X. */
+
+static void
+ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, char *string)
+{
+ if (f->u.R1010.val.present)
+ if (f->u.R1010.val.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
+
+ ffests_puts (s, string);
+}
+
+/* ffestd_R1001dump_1010_3_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1010_3_(f,"I");
+
+ The format is dumped with form nX. */
+
+static void
+ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (f->u.R1010.val.present);
+
+ if (f->u.R1010.val.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
+
+ ffests_puts (s, string);
+}
+
+/* ffestd_R1001dump_1010_4_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1010_4_(f,"I");
+
+ The format is dumped with form kX. Note that k is signed. */
+
+static void
+ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (f->u.R1010.val.present);
+
+ if (f->u.R1010.val.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1D (s, "%ld", f->u.R1010.val.u.signed_val);
+
+ ffests_puts (s, string);
+}
+
+/* ffestd_R1001dump_1010_5_ -- Dump a particular format
+
+ ffesttFormatList f;
+ ffestd_R1001dump_1010_5_(f,"I");
+
+ The format is dumped with form Xn. */
+
+static void
+ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, char *string)
+{
+ assert (f->u.R1010.val.present);
+
+ ffests_puts (s, string);
+
+ if (f->u.R1010.val.rtexpr)
+ ffestd_R1001error_ (f);
+ else
+ ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
+}
+
+/* ffestd_R1001error_ -- Complain about FORMAT specification not supported
+
+ ffesttFormatList f;
+ ffestd_R1001error_(f);
+
+ An error message is produced. */
+
+static void
+ffestd_R1001error_ (ffesttFormatList f)
+{
+ ffebad_start (FFEBAD_FORMAT_UNSUPPORTED);
+ ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
+ ffebad_finish ();
+}
+
+/* ffestd_R1102 -- PROGRAM statement
+
+ ffestd_R1102(name_token);
+
+ Make sure ffestd_kind_ identifies an empty block. Make sure name_token
+ gives a valid name. Implement the beginning of a main program. */
+
+void
+ffestd_R1102 (ffesymbol s, ffelexToken name UNUSED)
+{
+ ffestd_check_simple_ ();
+
+ assert (ffestd_block_level_ == 0);
+ ffestd_is_reachable_ = TRUE;
+
+ ffecom_notify_primary_entry (s);
+ ffe_set_is_mainprog (TRUE); /* Is a main program. */
+ ffe_set_is_saveall (TRUE); /* Main program always has implicit SAVE. */
+
+ ffestw_set_sym (ffestw_stack_top (), s);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (name == NULL)
+ fputs ("< PROGRAM_unnamed\n", dmpout);
+ else
+ fprintf (dmpout, "< PROGRAM %s\n", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1103 -- End a PROGRAM
+
+ ffestd_R1103(); */
+
+void
+ffestd_R1103 (bool ok UNUSED)
+{
+ assert (ffestd_block_level_ == 0);
+
+ if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
+ ffestd_R842 (NULL); /* Generate STOP. */
+
+ if (ffestw_state (ffestw_stack_top ()) != FFESTV_statePROGRAM5)
+ ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
+
+#if FFECOM_ONEPASS
+ ffeste_R1103 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR1103_);
+ ffestd_stmt_append_ (stmt);
+ }
+#endif
+}
+
+/* ffestd_R1105 -- MODULE statement
+
+ ffestd_R1105(name_token);
+
+ Make sure ffestd_kind_ identifies an empty block. Make sure name_token
+ gives a valid name. Implement the beginning of a module. */
+
+#if FFESTR_F90
+void
+ffestd_R1105 (ffelexToken name)
+{
+ assert (ffestd_block_level_ == 0);
+
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fprintf (dmpout, "* MODULE %s\n", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R1106 -- End a MODULE
+
+ ffestd_R1106(TRUE); */
+
+void
+ffestd_R1106 (bool ok)
+{
+ assert (ffestd_block_level_ == 0);
+
+ /* Generate any wrap-up code here (unlikely in MODULE!). */
+
+ if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateMODULE5)
+ ffestd_subr_labels_ (TRUE); /* Handle any undefined labels (unlikely). */
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fprintf (dmpout, "< END_MODULE %s\n",
+ ffelex_token_text (ffestw_name (ffestw_stack_top ())));
+#endif
+}
+
+/* ffestd_R1107_start -- USE statement list begin
+
+ ffestd_R1107_start();
+
+ Verify that USE is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R1107_start (ffelexToken name, bool only)
+{
+ ffestd_check_start_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fprintf (dmpout, "* USE %s,", ffelex_token_text (name)); /* NB
+ _shriek_begin_uses_. */
+ if (only)
+ fputs ("only: ", dmpout);
+#endif
+}
+
+/* ffestd_R1107_item -- USE statement for name
+
+ ffestd_R1107_item(local_token,use_token);
+
+ Make sure name_token identifies a valid object to be USEed. local_token
+ may be NULL if _start_ was called with only==TRUE. */
+
+void
+ffestd_R1107_item (ffelexToken local, ffelexToken use)
+{
+ ffestd_check_item_ ();
+ assert (use != NULL);
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ if (local != NULL)
+ fprintf (dmpout, "%s=>", ffelex_token_text (local));
+ fprintf (dmpout, "%s,", ffelex_token_text (use));
+#endif
+}
+
+/* ffestd_R1107_finish -- USE statement list complete
+
+ ffestd_R1107_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R1107_finish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R1111 -- BLOCK DATA statement
+
+ ffestd_R1111(name_token);
+
+ Make sure ffestd_kind_ identifies no current program unit. If not
+ NULL, make sure name_token gives a valid name. Implement the beginning
+ of a block data program unit. */
+
+void
+ffestd_R1111 (ffesymbol s, ffelexToken name UNUSED)
+{
+ assert (ffestd_block_level_ == 0);
+ ffestd_is_reachable_ = TRUE;
+
+ ffestd_check_simple_ ();
+
+ ffecom_notify_primary_entry (s);
+ ffestw_set_sym (ffestw_stack_top (), s);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (name == NULL)
+ fputs ("< BLOCK_DATA_unnamed\n", dmpout);
+ else
+ fprintf (dmpout, "< BLOCK_DATA %s\n", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1112 -- End a BLOCK DATA
+
+ ffestd_R1112(TRUE); */
+
+void
+ffestd_R1112 (bool ok UNUSED)
+{
+ assert (ffestd_block_level_ == 0);
+
+ /* Generate any return-like code here (not likely for BLOCK DATA!). */
+
+ if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateBLOCKDATA5)
+ ffestd_subr_labels_ (TRUE); /* Handle any undefined labels. */
+
+#if FFECOM_ONEPASS
+ ffeste_R1112 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR1112_);
+ ffestd_stmt_append_ (stmt);
+ }
+#endif
+}
+
+/* ffestd_R1202 -- INTERFACE statement
+
+ ffestd_R1202(operator,defined_name);
+
+ Make sure ffestd_kind_ identifies an INTERFACE block.
+ Implement the end of the current interface.
+
+ 06-Jun-90 JCB 1.1
+ Allow no operator or name to mean INTERFACE by itself; missed this
+ valid form when originally doing syntactic analysis code. */
+
+#if FFESTR_F90
+void
+ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ switch (operator)
+ {
+ case FFESTP_definedoperatorNone:
+ if (name == NULL)
+ fputs ("* INTERFACE_unnamed\n", dmpout);
+ else
+ fprintf (dmpout, "* INTERFACE %s\n", ffelex_token_text (name));
+ break;
+
+ case FFESTP_definedoperatorOPERATOR:
+ fprintf (dmpout, "* INTERFACE_OPERATOR (.%s.)\n", ffelex_token_text (name));
+ break;
+
+ case FFESTP_definedoperatorASSIGNMENT:
+ fputs ("* INTERFACE_ASSIGNMENT (=)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorPOWER:
+ fputs ("* INTERFACE_OPERATOR (**)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorMULT:
+ fputs ("* INTERFACE_OPERATOR (*)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorADD:
+ fputs ("* INTERFACE_OPERATOR (+)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorCONCAT:
+ fputs ("* INTERFACE_OPERATOR (//)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorDIVIDE:
+ fputs ("* INTERFACE_OPERATOR (/)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorSUBTRACT:
+ fputs ("* INTERFACE_OPERATOR (-)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorNOT:
+ fputs ("* INTERFACE_OPERATOR (.not.)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorAND:
+ fputs ("* INTERFACE_OPERATOR (.and.)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorOR:
+ fputs ("* INTERFACE_OPERATOR (.or.)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorEQV:
+ fputs ("* INTERFACE_OPERATOR (.eqv.)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorNEQV:
+ fputs ("* INTERFACE_OPERATOR (.neqv.)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorEQ:
+ fputs ("* INTERFACE_OPERATOR (==)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorNE:
+ fputs ("* INTERFACE_OPERATOR (/=)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorLT:
+ fputs ("* INTERFACE_OPERATOR (<)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorLE:
+ fputs ("* INTERFACE_OPERATOR (<=)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorGT:
+ fputs ("* INTERFACE_OPERATOR (>)\n", dmpout);
+ break;
+
+ case FFESTP_definedoperatorGE:
+ fputs ("* INTERFACE_OPERATOR (>=)\n", dmpout);
+ break;
+
+ default:
+ assert (FALSE);
+ break;
+ }
+#endif
+}
+
+/* ffestd_R1203 -- End an INTERFACE
+
+ ffestd_R1203(TRUE); */
+
+void
+ffestd_R1203 (bool ok)
+{
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputs ("* END_INTERFACE\n", dmpout);
+#endif
+}
+
+/* ffestd_R1205_start -- MODULE PROCEDURE statement list begin
+
+ ffestd_R1205_start();
+
+ Verify that MODULE PROCEDURE is valid here, and begin accepting items in
+ the list. */
+
+void
+ffestd_R1205_start ()
+{
+ ffestd_check_start_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputs ("* MODULE_PROCEDURE ", dmpout);
+#endif
+}
+
+/* ffestd_R1205_item -- MODULE PROCEDURE statement for name
+
+ ffestd_R1205_item(name_token);
+
+ Make sure name_token identifies a valid object to be MODULE PROCEDUREed. */
+
+void
+ffestd_R1205_item (ffelexToken name)
+{
+ ffestd_check_item_ ();
+ assert (name != NULL);
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#endif
+}
+
+/* ffestd_R1205_finish -- MODULE PROCEDURE statement list complete
+
+ ffestd_R1205_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R1205_finish ()
+{
+ ffestd_check_finish_ ();
+
+ return; /* F90. */
+
+#ifdef FFESTD_F90
+ fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R1207_start -- EXTERNAL statement list begin
+
+ ffestd_R1207_start();
+
+ Verify that EXTERNAL is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R1207_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* EXTERNAL (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1207_item -- EXTERNAL statement for name
+
+ ffestd_R1207_item(name_token);
+
+ Make sure name_token identifies a valid object to be EXTERNALd. */
+
+void
+ffestd_R1207_item (ffelexToken name)
+{
+ ffestd_check_item_ ();
+ assert (name != NULL);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1207_finish -- EXTERNAL statement list complete
+
+ ffestd_R1207_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R1207_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1208_start -- INTRINSIC statement list begin
+
+ ffestd_R1208_start();
+
+ Verify that INTRINSIC is valid here, and begin accepting items in the list. */
+
+void
+ffestd_R1208_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* INTRINSIC (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1208_item -- INTRINSIC statement for name
+
+ ffestd_R1208_item(name_token);
+
+ Make sure name_token identifies a valid object to be INTRINSICd. */
+
+void
+ffestd_R1208_item (ffelexToken name)
+{
+ ffestd_check_item_ ();
+ assert (name != NULL);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1208_finish -- INTRINSIC statement list complete
+
+ ffestd_R1208_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_R1208_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1212 -- CALL statement
+
+ ffestd_R1212(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffestd_R1212 (ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R1212 (expr);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR1212_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R1212.pool = ffesta_output_pool;
+ stmt->u.R1212.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+}
+
+/* ffestd_R1213 -- Defined assignment statement
+
+ ffestd_R1213(dest_expr,source_expr,source_token);
+
+ Make sure the assignment is valid. */
+
+#if FFESTR_F90
+void
+ffestd_R1213 (ffebld dest, ffebld source)
+{
+ ffestd_check_simple_ ();
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("+ let_defined ", dmpout);
+ ffebld_dump (dest);
+ fputs ("=", dmpout);
+ ffebld_dump (source);
+ fputc ('\n', dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R1219 -- FUNCTION statement
+
+ ffestd_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
+ recursive);
+
+ Make sure statement is valid here, register arguments for the
+ function name, and so on.
+
+ 06-Jun-90 JCB 2.0
+ Added the kind, len, and recursive arguments. */
+
+void
+ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED,
+ ffesttTokenList args UNUSED, ffestpType type UNUSED,
+ ffebld kind UNUSED, ffelexToken kindt UNUSED,
+ ffebld len UNUSED, ffelexToken lent UNUSED,
+ bool recursive UNUSED, ffelexToken result UNUSED,
+ bool separate_result UNUSED)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ char *a;
+#endif
+
+ assert (ffestd_block_level_ == 0);
+ ffestd_is_reachable_ = TRUE;
+
+ ffestd_check_simple_ ();
+
+ ffecom_notify_primary_entry (s);
+ ffestw_set_sym (ffestw_stack_top (), s);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ switch (type)
+ {
+ case FFESTP_typeINTEGER:
+ a = "INTEGER";
+ break;
+
+ case FFESTP_typeBYTE:
+ a = "BYTE";
+ break;
+
+ case FFESTP_typeWORD:
+ a = "WORD";
+ break;
+
+ case FFESTP_typeREAL:
+ a = "REAL";
+ break;
+
+ case FFESTP_typeCOMPLEX:
+ a = "COMPLEX";
+ break;
+
+ case FFESTP_typeLOGICAL:
+ a = "LOGICAL";
+ break;
+
+ case FFESTP_typeCHARACTER:
+ a = "CHARACTER";
+ break;
+
+ case FFESTP_typeDBLPRCSN:
+ a = "DOUBLE PRECISION";
+ break;
+
+ case FFESTP_typeDBLCMPLX:
+ a = "DOUBLE COMPLEX";
+ break;
+
+#if FFESTR_F90
+ case FFESTP_typeTYPE:
+ a = "TYPE";
+ break;
+#endif
+
+ case FFESTP_typeNone:
+ a = "";
+ break;
+
+ default:
+ assert (FALSE);
+ a = "?";
+ break;
+ }
+ fprintf (dmpout, "< FUNCTION %s ", ffelex_token_text (funcname));
+ if (recursive)
+ fputs ("RECURSIVE ", dmpout);
+ fprintf (dmpout, "%s(", a);
+ if (kindt != NULL)
+ {
+ fputs ("kind=", dmpout);
+ if (kind == NULL)
+ fputs (ffelex_token_text (kindt), dmpout);
+ else
+ ffebld_dump (kind);
+ if (lent != NULL)
+ fputc (',', dmpout);
+ }
+ if (lent != NULL)
+ {
+ fputs ("len=", dmpout);
+ if (len == NULL)
+ fputs (ffelex_token_text (lent), dmpout);
+ else
+ ffebld_dump (len);
+ }
+ fprintf (dmpout, ")");
+ if (args != NULL)
+ {
+ fputs (" (", dmpout);
+ ffestt_tokenlist_dump (args);
+ fputc (')', dmpout);
+ }
+ if (result != NULL)
+ fprintf (dmpout, " result(%s)", ffelex_token_text (result));
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1221 -- End a FUNCTION
+
+ ffestd_R1221(TRUE); */
+
+void
+ffestd_R1221 (bool ok UNUSED)
+{
+ assert (ffestd_block_level_ == 0);
+
+ if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
+ ffestd_R1227 (NULL); /* Generate RETURN. */
+
+ if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateFUNCTION5)
+ ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
+
+#if FFECOM_ONEPASS
+ ffeste_R1221 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR1221_);
+ ffestd_stmt_append_ (stmt);
+ }
+#endif
+}
+
+/* ffestd_R1223 -- SUBROUTINE statement
+
+ ffestd_R1223(subrname,arglist,ending_token,recursive_token);
+
+ Make sure statement is valid here, register arguments for the
+ subroutine name, and so on.
+
+ 06-Jun-90 JCB 2.0
+ Added the recursive argument. */
+
+void
+ffestd_R1223 (ffesymbol s, ffelexToken subrname UNUSED,
+ ffesttTokenList args UNUSED, ffelexToken final UNUSED,
+ bool recursive UNUSED)
+{
+ assert (ffestd_block_level_ == 0);
+ ffestd_is_reachable_ = TRUE;
+
+ ffestd_check_simple_ ();
+
+ ffecom_notify_primary_entry (s);
+ ffestw_set_sym (ffestw_stack_top (), s);
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "< SUBROUTINE %s ", ffelex_token_text (subrname));
+ if (recursive)
+ fputs ("recursive ", dmpout);
+ if (args != NULL)
+ {
+ fputc ('(', dmpout);
+ ffestt_tokenlist_dump (args);
+ fputc (')', dmpout);
+ }
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1225 -- End a SUBROUTINE
+
+ ffestd_R1225(TRUE); */
+
+void
+ffestd_R1225 (bool ok UNUSED)
+{
+ assert (ffestd_block_level_ == 0);
+
+ if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
+ ffestd_R1227 (NULL); /* Generate RETURN. */
+
+ if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateSUBROUTINE5)
+ ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
+
+#if FFECOM_ONEPASS
+ ffeste_R1225 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR1225_);
+ ffestd_stmt_append_ (stmt);
+ }
+#endif
+}
+
+/* ffestd_R1226 -- ENTRY statement
+
+ ffestd_R1226(entryname,arglist,ending_token);
+
+ Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the
+ entry point name, and so on. */
+
+void
+ffestd_R1226 (ffesymbol entry)
+{
+ ffestd_check_simple_ ();
+
+#if (FFECOM_targetCURRENT == FFECOM_targetFFE) || FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R1226 (entry);
+#else
+ if (!ffesta_seen_first_exec || ffecom_2pass_advise_entrypoint (entry))
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR1226_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R1226.entry = entry;
+ stmt->u.R1226.entrynum = ++ffestd_2pass_entrypoints_;
+ }
+#endif
+
+ ffestd_is_reachable_ = TRUE;
+}
+
+/* ffestd_R1227 -- RETURN statement
+
+ ffestd_R1227(expr);
+
+ Make sure statement is valid here; implement. expr and expr_token are
+ both NULL if there was no expression. */
+
+void
+ffestd_R1227 (ffebld expr)
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R1227 (ffestw_stack_top (), expr);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR1227_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.R1227.pool = ffesta_output_pool;
+ stmt->u.R1227.block = ffestw_stack_top ();
+ stmt->u.R1227.expr = expr;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+ if (ffestd_block_level_ == 0)
+ ffestd_is_reachable_ = FALSE;
+}
+
+/* ffestd_R1228 -- CONTAINS statement
+
+ ffestd_R1228(); */
+
+#if FFESTR_F90
+void
+ffestd_R1228 ()
+{
+ assert (ffestd_block_level_ == 0);
+
+ ffestd_check_simple_ ();
+
+ /* Generate RETURN/STOP code here */
+
+ ffestd_subr_labels_ (ffestw_state (ffestw_stack_top ())
+ == FFESTV_stateMODULE5); /* Handle any undefined
+ labels. */
+
+ ffestd_subr_f90_ ();
+ return;
+
+#ifdef FFESTD_F90
+ fputs ("- CONTAINS\n", dmpout);
+#endif
+}
+
+#endif
+/* ffestd_R1229_start -- STMTFUNCTION statement begin
+
+ ffestd_R1229_start(func_name,func_arg_list,close_paren);
+
+ This function does not really need to do anything, since _finish_
+ gets all the info needed, and ffestc_R1229_start has already
+ done all the stuff that makes a two-phase operation (start and
+ finish) for handling statement functions necessary.
+
+ 03-Jan-91 JCB 2.0
+ Do nothing, now that _finish_ does everything. */
+
+void
+ffestd_R1229_start (ffelexToken name UNUSED, ffesttTokenList args UNUSED)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_R1229_finish -- STMTFUNCTION statement list complete
+
+ ffestd_R1229_finish(s);
+
+ The statement function's symbol is passed. Its list of dummy args is
+ accessed via ffesymbol_dummyargs and its expansion expression (expr)
+ is accessed via ffesymbol_sfexpr.
+
+ If sfexpr is NULL, an error occurred parsing the expansion expression, so
+ just cancel the effects of ffestd_R1229_start and pretend nothing
+ happened. Otherwise, install the expression as the expansion for the
+ statement function, then clean up.
+
+ 03-Jan-91 JCB 2.0
+ Takes sfunc sym instead of just the expansion expression as an
+ argument, so this function can do all the work, and _start_ is just
+ a nicety than can do nothing in a back end. */
+
+void
+ffestd_R1229_finish (ffesymbol s)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld args = ffesymbol_dummyargs (s);
+#endif
+ ffebld expr = ffesymbol_sfexpr (s);
+
+ ffestd_check_finish_ ();
+
+ if (expr == NULL)
+ return; /* Nothing to do, definition didn't work. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "* stmtfunction %s(", ffesymbol_text (s));
+ for (; args != NULL; args = ffebld_trail (args))
+ fprintf (dmpout, "%s,", ffesymbol_text (ffebld_symter (ffebld_head (args))));
+ fputs (")=", dmpout);
+ ffebld_dump (expr);
+ fputc ('\n', dmpout);
+#if 0 /* Normally no need to preserve the
+ expression. */
+ ffesymbol_set_sfexpr (s, NULL); /* Except expr.c sees NULL
+ as recursive reference!
+ So until we can use something
+ convenient, like a "permanent"
+ expression, don't worry about
+ wasting some memory in the
+ stand-alone FFE. */
+#else
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+#endif
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ /* With gcc, cannot do anything here, because the backend hasn't even
+ (necessarily) been notified that we're compiling a program unit! */
+
+#if 0 /* Must preserve the expression for gcc. */
+ ffesymbol_set_sfexpr (s, NULL);
+#else
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+#endif
+#else
+#error
+#endif
+}
+
+/* ffestd_S3P4 -- INCLUDE line
+
+ ffestd_S3P4(filename,filename_token);
+
+ Make sure INCLUDE not preceded by any semicolons or a label def; implement. */
+
+void
+ffestd_S3P4 (ffebld filename)
+{
+ FILE *fi;
+ ffetargetCharacterDefault buildname;
+ ffewhereFile wf;
+
+ ffestd_check_simple_ ();
+
+ assert (filename != NULL);
+ if (ffebld_op (filename) != FFEBLD_opANY)
+ {
+ assert (ffebld_op (filename) == FFEBLD_opCONTER);
+ assert (ffeinfo_basictype (ffebld_info (filename))
+ == FFEINFO_basictypeCHARACTER);
+ assert (ffeinfo_kindtype (ffebld_info (filename))
+ == FFEINFO_kindtypeCHARACTERDEFAULT);
+ buildname = ffebld_constant_characterdefault (ffebld_conter (filename));
+ wf = ffewhere_file_new (ffetarget_text_characterdefault (buildname),
+ ffetarget_length_characterdefault (buildname));
+ fi = ffecom_open_include (ffewhere_file_name (wf),
+ ffelex_token_where_line (ffesta_tokens[0]),
+ ffelex_token_where_column (ffesta_tokens[0]));
+ if (fi == NULL)
+ ffewhere_file_kill (wf);
+ else
+ ffelex_set_include (wf, (ffelex_token_type (ffesta_tokens[0])
+ == FFELEX_typeNAME), fi);
+ }
+}
+
+/* ffestd_V003_start -- STRUCTURE statement list begin
+
+ ffestd_V003_start(structure_name);
+
+ Verify that STRUCTURE is valid here, and begin accepting items in the list. */
+
+#if FFESTR_VXT
+void
+ffestd_V003_start (ffelexToken structure_name)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (structure_name == NULL)
+ fputs ("* STRUCTURE_unnamed ", dmpout);
+ else
+ fprintf (dmpout, "* STRUCTURE %s ", ffelex_token_text (structure_name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#else
+#error
+#endif
+}
+
+/* ffestd_V003_item -- STRUCTURE statement for object-name
+
+ ffestd_V003_item(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be STRUCTUREd. */
+
+void
+ffestd_V003_item (ffelexToken name, ffesttDimList dims)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (ffelex_token_text (name), dmpout);
+ if (dims != NULL)
+ {
+ fputc ('(', dmpout);
+ ffestt_dimlist_dump (dims);
+ fputc (')', dmpout);
+ }
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V003_finish -- STRUCTURE statement list complete
+
+ ffestd_V003_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V003_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V004 -- End a STRUCTURE
+
+ ffestd_V004(TRUE); */
+
+void
+ffestd_V004 (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* END_STRUCTURE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V009 -- UNION statement
+
+ ffestd_V009(); */
+
+void
+ffestd_V009 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* UNION\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V010 -- End a UNION
+
+ ffestd_V010(TRUE); */
+
+void
+ffestd_V010 (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* END_UNION\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V012 -- MAP statement
+
+ ffestd_V012(); */
+
+void
+ffestd_V012 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* MAP\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V013 -- End a MAP
+
+ ffestd_V013(TRUE); */
+
+void
+ffestd_V013 (bool ok)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* END_MAP\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffestd_V014_start -- VOLATILE statement list begin
+
+ ffestd_V014_start();
+
+ Verify that VOLATILE is valid here, and begin accepting items in the list. */
+
+void
+ffestd_V014_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* VOLATILE (", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#else
+#error
+#endif
+}
+
+/* ffestd_V014_item_object -- VOLATILE statement for object-name
+
+ ffestd_V014_item_object(name_token);
+
+ Make sure name_token identifies a valid object to be VOLATILEd. */
+
+void
+ffestd_V014_item_object (ffelexToken name UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "%s,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V014_item_cblock -- VOLATILE statement for common-block-name
+
+ ffestd_V014_item_cblock(name_token);
+
+ Make sure name_token identifies a valid common block to be VOLATILEd. */
+
+void
+ffestd_V014_item_cblock (ffelexToken name UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "/%s/,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V014_finish -- VOLATILE statement list complete
+
+ ffestd_V014_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V014_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V016_start -- RECORD statement list begin
+
+ ffestd_V016_start();
+
+ Verify that RECORD is valid here, and begin accepting items in the list. */
+
+#if FFESTR_VXT
+void
+ffestd_V016_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* RECORD ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#else
+#error
+#endif
+}
+
+/* ffestd_V016_item_structure -- RECORD statement for common-block-name
+
+ ffestd_V016_item_structure(name_token);
+
+ Make sure name_token identifies a valid structure to be RECORDed. */
+
+void
+ffestd_V016_item_structure (ffelexToken name)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "/%s/,", ffelex_token_text (name));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V016_item_object -- RECORD statement for object-name
+
+ ffestd_V016_item_object(name_token,dim_list);
+
+ Make sure name_token identifies a valid object to be RECORDd. */
+
+void
+ffestd_V016_item_object (ffelexToken name, ffesttDimList dims)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (ffelex_token_text (name), dmpout);
+ if (dims != NULL)
+ {
+ fputc ('(', dmpout);
+ ffestt_dimlist_dump (dims);
+ fputc (')', dmpout);
+ }
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V016_finish -- RECORD statement list complete
+
+ ffestd_V016_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V016_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V018_start -- REWRITE(...) statement list begin
+
+ ffestd_V018_start();
+
+ Verify that REWRITE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_V018_start (ffestvFormat format)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V018_start (&ffestp_file.rewrite, format);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV018_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.V018.pool = ffesta_output_pool;
+ stmt->u.V018.params = ffestd_subr_copy_rewrite_ ();
+ stmt->u.V018.format = format;
+ stmt->u.V018.list = NULL;
+ ffestd_expr_list_ = &stmt->u.V018.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V018_item -- REWRITE statement i/o item
+
+ ffestd_V018_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_V018_item (ffebld expr)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V018_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V018_finish -- REWRITE statement list complete
+
+ ffestd_V018_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V018_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V018_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V019_start -- ACCEPT statement list begin
+
+ ffestd_V019_start();
+
+ Verify that ACCEPT is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_V019_start (ffestvFormat format)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V019_start (&ffestp_file.accept, format);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV019_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.V019.pool = ffesta_output_pool;
+ stmt->u.V019.params = ffestd_subr_copy_accept_ ();
+ stmt->u.V019.format = format;
+ stmt->u.V019.list = NULL;
+ ffestd_expr_list_ = &stmt->u.V019.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V019_item -- ACCEPT statement i/o item
+
+ ffestd_V019_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_V019_item (ffebld expr)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V019_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V019_finish -- ACCEPT statement list complete
+
+ ffestd_V019_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V019_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V019_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+#endif
+/* ffestd_V020_start -- TYPE statement list begin
+
+ ffestd_V020_start();
+
+ Verify that TYPE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_V020_start (ffestvFormat format UNUSED)
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V020_start (&ffestp_file.type, format);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV020_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.V020.pool = ffesta_output_pool;
+ stmt->u.V020.params = ffestd_subr_copy_type_ ();
+ stmt->u.V020.format = format;
+ stmt->u.V020.list = NULL;
+ ffestd_expr_list_ = &stmt->u.V020.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V020_item -- TYPE statement i/o item
+
+ ffestd_V020_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_V020_item (ffebld expr UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V020_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V020_finish -- TYPE statement list complete
+
+ ffestd_V020_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V020_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V020_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V021 -- DELETE statement
+
+ ffestd_V021();
+
+ Make sure a DELETE is valid in the current context, and implement it. */
+
+#if FFESTR_VXT
+void
+ffestd_V021 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V021 (&ffestp_file.delete);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV021_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.V021.pool = ffesta_output_pool;
+ stmt->u.V021.params = ffestd_subr_copy_delete_ ();
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V022 -- UNLOCK statement
+
+ ffestd_V022();
+
+ Make sure a UNLOCK is valid in the current context, and implement it. */
+
+void
+ffestd_V022 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V022 (&ffestp_file.beru);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV022_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.V022.pool = ffesta_output_pool;
+ stmt->u.V022.params = ffestd_subr_copy_beru_ ();
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V023_start -- ENCODE(...) statement list begin
+
+ ffestd_V023_start();
+
+ Verify that ENCODE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_V023_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V023_start (&ffestp_file.vxtcode);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV023_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.V023.pool = ffesta_output_pool;
+ stmt->u.V023.params = ffestd_subr_copy_vxtcode_ ();
+ stmt->u.V023.list = NULL;
+ ffestd_expr_list_ = &stmt->u.V023.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V023_item -- ENCODE statement i/o item
+
+ ffestd_V023_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_V023_item (ffebld expr)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V023_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V023_finish -- ENCODE statement list complete
+
+ ffestd_V023_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V023_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V023_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V024_start -- DECODE(...) statement list begin
+
+ ffestd_V024_start();
+
+ Verify that DECODE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_V024_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V024_start (&ffestp_file.vxtcode);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV024_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.V024.pool = ffesta_output_pool;
+ stmt->u.V024.params = ffestd_subr_copy_vxtcode_ ();
+ stmt->u.V024.list = NULL;
+ ffestd_expr_list_ = &stmt->u.V024.list;
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V024_item -- DECODE statement i/o item
+
+ ffestd_V024_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffestd_V024_item (ffebld expr)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V024_item (expr);
+#else
+ {
+ ffestdExprItem_ item
+ = (ffestdExprItem_) malloc_new_kp (ffesta_output_pool, "ffestdExprItem_",
+ sizeof (*item));
+
+ item->next = NULL;
+ item->expr = expr;
+ *ffestd_expr_list_ = item;
+ ffestd_expr_list_ = &item->next;
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V024_finish -- DECODE statement list complete
+
+ ffestd_V024_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V024_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V024_finish ();
+#else
+ /* Nothing to do, it's implicit. */
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V025_start -- DEFINEFILE statement list begin
+
+ ffestd_V025_start();
+
+ Verify that DEFINEFILE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffestd_V025_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V025_start ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV025start_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+/* ffestd_V025_item -- DEFINE FILE statement item
+
+ ffestd_V025_item(u,ut,m,mt,n,nt,asv,asvt);
+
+ Implement item. Treat each item kind of like a separate statement,
+ since there's really no need to treat them as an aggregate. */
+
+void
+ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V025_item (u, m, n, asv);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV025item_);
+ ffestd_stmt_append_ (stmt);
+ stmt->u.V025item.u = u;
+ stmt->u.V025item.m = m;
+ stmt->u.V025item.n = n;
+ stmt->u.V025item.asv = asv;
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V025_finish -- DEFINE FILE statement list complete
+
+ ffestd_V025_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V025_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffeste_V025_finish ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV025finish_);
+ stmt->u.V025finish.pool = ffesta_output_pool;
+ ffestd_stmt_append_ (stmt);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#endif
+}
+
+/* ffestd_V026 -- FIND statement
+
+ ffestd_V026();
+
+ Make sure a FIND is valid in the current context, and implement it. */
+
+void
+ffestd_V026 ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_V026 (&ffestp_file.find);
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidV026_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ stmt->u.V026.pool = ffesta_output_pool;
+ stmt->u.V026.params = ffestd_subr_copy_find_ ();
+ ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
+ }
+#endif
+
+#endif
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+}
+
+#endif
+/* ffestd_V027_start -- VXT PARAMETER statement list begin
+
+ ffestd_V027_start();
+
+ Verify that PARAMETER is valid here, and begin accepting items in the list. */
+
+void
+ffestd_V027_start ()
+{
+ ffestd_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* PARAMETER_vxt ", dmpout);
+#else
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffestd_subr_vxt_ ();
+#endif
+#endif
+}
+
+/* ffestd_V027_item -- VXT PARAMETER statement assignment
+
+ ffestd_V027_item(dest,dest_token,source,source_token);
+
+ Make sure the source is a valid source for the destination; make the
+ assignment. */
+
+void
+ffestd_V027_item (ffelexToken dest_token UNUSED, ffebld source UNUSED)
+{
+ ffestd_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs (ffelex_token_text (dest_token), dmpout);
+ fputc ('=', dmpout);
+ ffebld_dump (source);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffestd_V027_finish -- VXT PARAMETER statement list complete
+
+ ffestd_V027_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffestd_V027_finish ()
+{
+ ffestd_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* Any executable statement. */
+
+void
+ffestd_any ()
+{
+ ffestd_check_simple_ ();
+
+#if FFECOM_ONEPASS
+ ffestd_subr_line_now_ ();
+ ffeste_R841 ();
+#else
+ {
+ ffestdStmt_ stmt;
+
+ stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
+ ffestd_stmt_append_ (stmt);
+ ffestd_subr_line_save_ (stmt);
+ }
+#endif
+}
diff --git a/gcc/f/std.h b/gcc/f/std.h
new file mode 100644
index 00000000000..0e608b13548
--- /dev/null
+++ b/gcc/f/std.h
@@ -0,0 +1,298 @@
+/* std.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ std.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_std
+#define _H_f_std
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lab.h"
+#include "lex.h"
+#include "stp.h"
+#include "str.h"
+#include "stt.h"
+#include "stv.h"
+#include "stw.h"
+#include "symbol.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffestd_begin_uses (void);
+void ffestd_do (bool ok);
+#if FFESTR_F90
+void ffestd_end_uses (bool ok);
+void ffestd_end_R740 (bool ok);
+#endif
+void ffestd_end_R807 (bool ok);
+void ffestd_exec_begin (void);
+void ffestd_exec_end (void);
+void ffestd_init_3 (void);
+void ffestd_labeldef_any (ffelab label);
+void ffestd_labeldef_branch (ffelab label);
+void ffestd_labeldef_format (ffelab label);
+void ffestd_labeldef_useless (ffelab label);
+#if FFESTR_F90
+void ffestd_R423A (void);
+void ffestd_R423B (void);
+void ffestd_R424 (ffelexToken access, ffestrOther access_kw, ffelexToken name);
+void ffestd_R425 (bool ok);
+void ffestd_R519_start (ffestrOther intent_kw);
+void ffestd_R519_item (ffelexToken name);
+void ffestd_R519_finish (void);
+void ffestd_R520_start (void);
+void ffestd_R520_item (ffelexToken name);
+void ffestd_R520_finish (void);
+void ffestd_R521A (void);
+void ffestd_R521Astart (void);
+void ffestd_R521Aitem (ffelexToken name);
+void ffestd_R521Afinish (void);
+void ffestd_R521B (void);
+void ffestd_R521Bstart (void);
+void ffestd_R521Bitem (ffelexToken name);
+void ffestd_R521Bfinish (void);
+#endif
+void ffestd_R522 (void);
+void ffestd_R522start (void);
+void ffestd_R522item_object (ffelexToken name);
+void ffestd_R522item_cblock (ffelexToken name);
+void ffestd_R522finish (void);
+void ffestd_R524_start (bool virtual);
+void ffestd_R524_item (ffelexToken name, ffesttDimList dims);
+void ffestd_R524_finish (void);
+#if FFESTR_F90
+void ffestd_R525_start (void);
+void ffestd_R525_item (ffelexToken name, ffesttDimList dims);
+void ffestd_R525_finish (void);
+void ffestd_R526_start (void);
+void ffestd_R526_item (ffelexToken name, ffesttDimList dims);
+void ffestd_R526_finish (void);
+void ffestd_R527_start (void);
+void ffestd_R527_item (ffelexToken name, ffesttDimList dims);
+void ffestd_R527_finish (void);
+#endif
+void ffestd_R537_start (void);
+void ffestd_R537_item (ffebld dest, ffebld source);
+void ffestd_R537_finish (void);
+void ffestd_R539 (void);
+void ffestd_R539start (void);
+void ffestd_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
+ ffebld len, ffelexToken lent, ffesttImpList letters);
+void ffestd_R539finish (void);
+void ffestd_R542_start (void);
+void ffestd_R542_item_nlist (ffelexToken name);
+void ffestd_R542_item_nitem (ffelexToken name);
+void ffestd_R542_finish (void);
+void ffestd_R544_start (void);
+void ffestd_R544_item (ffesttExprList exprlist);
+void ffestd_R544_finish (void);
+void ffestd_R547_start (void);
+void ffestd_R547_item_object (ffelexToken name, ffesttDimList dims);
+void ffestd_R547_item_cblock (ffelexToken name);
+void ffestd_R547_finish (void);
+#if FFESTR_F90
+void ffestd_R620 (ffesttExprList exprlist, ffebld stat);
+void ffestd_R624 (ffesttExprList pointers);
+void ffestd_R625 (ffesttExprList exprlist, ffebld stat);
+#endif
+void ffestd_R737A (ffebld dest, ffebld source);
+#if FFESTR_F90
+void ffestd_R737B (ffebld dest, ffebld source);
+void ffestd_R738 (ffebld dest, ffebld source);
+void ffestd_R740 (ffebld expr);
+void ffestd_R742 (ffebld expr);
+void ffestd_R744 (void);
+void ffestd_R745 (bool ok);
+#endif
+void ffestd_R803 (ffelexToken construct_name, ffebld expr);
+void ffestd_R804 (ffebld expr, ffelexToken name);
+void ffestd_R805 (ffelexToken name);
+void ffestd_R806 (bool ok);
+void ffestd_R807 (ffebld expr);
+void ffestd_R809 (ffelexToken construct_name, ffebld expr);
+void ffestd_R810 (unsigned long casenum);
+void ffestd_R811 (bool ok);
+void ffestd_R819A (ffelexToken construct_name, ffelab label, ffebld var,
+ ffebld start, ffelexToken start_token,
+ ffebld end, ffelexToken end_token,
+ ffebld incr, ffelexToken incr_token);
+void ffestd_R819B (ffelexToken construct_name, ffelab label, ffebld expr);
+void ffestd_R825 (ffelexToken name);
+void ffestd_R834 (ffestw block);
+void ffestd_R835 (ffestw block);
+void ffestd_R836 (ffelab label);
+void ffestd_R837 (ffelab *labels, int count, ffebld expr);
+void ffestd_R838 (ffelab label, ffebld target);
+void ffestd_R839 (ffebld target, ffelab *labels, int count);
+void ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos);
+void ffestd_R841 (bool in_where);
+void ffestd_R842 (ffebld expr);
+void ffestd_R843 (ffebld expr);
+void ffestd_R904 (void);
+void ffestd_R907 (void);
+void ffestd_R909_start (bool only_format, ffestvUnit unit,
+ ffestvFormat format, bool rec, bool key);
+void ffestd_R909_item (ffebld expr, ffelexToken expr_token);
+void ffestd_R909_finish (void);
+void ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec);
+void ffestd_R910_item (ffebld expr, ffelexToken expr_token);
+void ffestd_R910_finish (void);
+void ffestd_R911_start (ffestvFormat format);
+void ffestd_R911_item (ffebld expr, ffelexToken expr_token);
+void ffestd_R911_finish (void);
+void ffestd_R919 (void);
+void ffestd_R920 (void);
+void ffestd_R921 (void);
+void ffestd_R923A (bool by_file);
+void ffestd_R923B_start (void);
+void ffestd_R923B_item (ffebld expr);
+void ffestd_R923B_finish (void);
+void ffestd_R1001 (ffesttFormatList f);
+void ffestd_R1102 (ffesymbol s, ffelexToken name);
+void ffestd_R1103 (bool ok);
+#if FFESTR_F90
+void ffestd_R1105 (ffelexToken name);
+void ffestd_R1106 (bool ok);
+void ffestd_R1107_start (ffelexToken name, bool only);
+void ffestd_R1107_item (ffelexToken local, ffelexToken use);
+void ffestd_R1107_finish (void);
+#endif
+void ffestd_R1111 (ffesymbol s, ffelexToken name);
+void ffestd_R1112 (bool ok);
+#if FFESTR_F90
+void ffestd_R1202 (ffestpDefinedOperator operator, ffelexToken name);
+void ffestd_R1203 (bool ok);
+void ffestd_R1205_start (void);
+void ffestd_R1205_item (ffelexToken name);
+void ffestd_R1205_finish (void);
+#endif
+void ffestd_R1207_start (void);
+void ffestd_R1207_item (ffelexToken name);
+void ffestd_R1207_finish (void);
+void ffestd_R1208_start (void);
+void ffestd_R1208_item (ffelexToken name);
+void ffestd_R1208_finish (void);
+void ffestd_R1212 (ffebld expr);
+#if FFESTR_F90
+void ffestd_R1213 (ffebld dest, ffebld source);
+#endif
+void ffestd_R1219 (ffesymbol s, ffelexToken funcname,
+ ffesttTokenList args, ffestpType type, ffebld kind,
+ ffelexToken kindt, ffebld len, ffelexToken lent,
+ bool recursive, ffelexToken result,
+ bool separate_result);
+void ffestd_R1221 (bool ok);
+void ffestd_R1223 (ffesymbol s, ffelexToken subrname, ffesttTokenList args,
+ ffelexToken final, bool recursive);
+void ffestd_R1225 (bool ok);
+void ffestd_R1226 (ffesymbol entry);
+void ffestd_R1227 (ffebld expr);
+#if FFESTR_F90
+void ffestd_R1228 (void);
+#endif
+void ffestd_R1229_start (ffelexToken name, ffesttTokenList args);
+void ffestd_R1229_finish (ffesymbol s);
+void ffestd_S3P4 (ffebld filename);
+#if FFESTR_VXT
+void ffestd_V003_start (ffelexToken structure_name);
+void ffestd_V003_item (ffelexToken name, ffesttDimList dims);
+void ffestd_V003_finish (void);
+void ffestd_V004 (bool ok);
+void ffestd_V009 (void);
+void ffestd_V010 (bool ok);
+void ffestd_V012 (void);
+void ffestd_V013 (bool ok);
+#endif
+void ffestd_V014_start (void);
+void ffestd_V014_item_object (ffelexToken name);
+void ffestd_V014_item_cblock (ffelexToken name);
+void ffestd_V014_finish (void);
+#if FFESTR_VXT
+void ffestd_V016_start (void);
+void ffestd_V016_item_structure (ffelexToken name);
+void ffestd_V016_item_object (ffelexToken name, ffesttDimList dims);
+void ffestd_V016_finish (void);
+void ffestd_V018_start (ffestvFormat format);
+void ffestd_V018_item (ffebld expr);
+void ffestd_V018_finish (void);
+void ffestd_V019_start (ffestvFormat format);
+void ffestd_V019_item (ffebld expr);
+void ffestd_V019_finish (void);
+#endif
+void ffestd_V020_start (ffestvFormat format);
+void ffestd_V020_item (ffebld expr);
+void ffestd_V020_finish (void);
+#if FFESTR_VXT
+void ffestd_V021 (void);
+void ffestd_V022 (void);
+void ffestd_V023_start (void);
+void ffestd_V023_item (ffebld expr);
+void ffestd_V023_finish (void);
+void ffestd_V024_start (void);
+void ffestd_V024_item (ffebld expr);
+void ffestd_V024_finish (void);
+void ffestd_V025_start (void);
+void ffestd_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv);
+void ffestd_V025_finish (void);
+void ffestd_V026 (void);
+#endif
+void ffestd_V027_start (void);
+void ffestd_V027_item (ffelexToken dest_token, ffebld source);
+void ffestd_V027_finish (void);
+void ffestd_any (void);
+
+/* Define macros. */
+
+#define ffestd_init_0()
+#define ffestd_init_1()
+#define ffestd_init_2()
+#define ffestd_init_4()
+#define ffestd_labeldef_notloop(l) ffestd_labeldef_branch(l)
+#define ffestd_labeldef_endif(l) ffestd_labeldef_branch(l)
+#define ffestd_terminate_0()
+#define ffestd_terminate_1()
+#define ffestd_terminate_2()
+#define ffestd_terminate_3()
+#define ffestd_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/ste.c b/gcc/f/ste.c
new file mode 100644
index 00000000000..a5e9757cca3
--- /dev/null
+++ b/gcc/f/ste.c
@@ -0,0 +1,5414 @@
+/* ste.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ ste.c
+
+ Description:
+ Implements the various statements and such like.
+
+ Modifications:
+*/
+
+/* As of 0.5.4, any statement that calls on ffecom to transform an
+ expression might need to be wrapped in ffecom_push_calltemps ()
+ and ffecom_pop_calltemps () as are some other cases. That is
+ the case when the transformation might involve generation of
+ a temporary that must be auto-popped, the specific case being
+ when a COMPLEX operation requiring a call to libf2c being
+ generated, whereby a temp is needed to hold the result since
+ libf2c doesn't return COMPLEX results directly. Cases where it
+ is known that ffecom_expr () won't need to do this, such as
+ the CALL statement (where it's the transformation of the
+ call expr itself that does the wrapping), don't need to bother
+ with this wrapping. Forgetting to do the wrapping currently
+ means a crash at an assertion when the wrapping would be helpful
+ to keep temporaries from being wasted -- see ffecom_push_tempvar. */
+
+/* Include files. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "config.j"
+#include "rtl.j"
+#endif
+
+#include "proj.h"
+#include "ste.h"
+#include "bld.h"
+#include "com.h"
+#include "expr.h"
+#include "lab.h"
+#include "lex.h"
+#include "sta.h"
+#include "stp.h"
+#include "str.h"
+#include "sts.h"
+#include "stt.h"
+#include "stv.h"
+#include "stw.h"
+#include "symbol.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFESTE_stateletSIMPLE_, /* Expecting simple/start. */
+ FFESTE_stateletATTRIB_, /* Expecting attrib/item/itemstart. */
+ FFESTE_stateletITEM_, /* Expecting item/itemstart/finish. */
+ FFESTE_stateletITEMVALS_, /* Expecting itemvalue/itemendvals. */
+ FFESTE_
+ } ffesteStatelet_;
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+static ffesteStatelet_ ffeste_statelet_ = FFESTE_stateletSIMPLE_;
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static ffelab ffeste_label_formatdef_ = NULL;
+static tree (*ffeste_io_driver_) (ffebld expr); /* do?io. */
+static ffecomGfrt ffeste_io_endgfrt_; /* end function to call. */
+static tree ffeste_io_abort_; /* abort-io label or NULL_TREE. */
+static bool ffeste_io_abort_is_temp_; /* abort-io label is a temp. */
+static tree ffeste_io_end_; /* END= label or NULL_TREE. */
+static tree ffeste_io_err_; /* ERR= label or NULL_TREE. */
+static tree ffeste_io_iostat_; /* IOSTAT= var or NULL_TREE. */
+static bool ffeste_io_iostat_is_temp_; /* IOSTAT= var is a temp. */
+#endif
+
+/* Static functions (internal). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void ffeste_begin_iterdo_ (ffestw block, tree *tvar, tree *tincr,
+ tree *xitersvar, ffebld var,
+ ffebld start, ffelexToken start_token,
+ ffebld end, ffelexToken end_token,
+ ffebld incr, ffelexToken incr_token,
+ char *msg);
+static void ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar);
+static void ffeste_io_call_ (tree call, bool do_check);
+static tree ffeste_io_dofio_ (ffebld expr);
+static tree ffeste_io_dolio_ (ffebld expr);
+static tree ffeste_io_douio_ (ffebld expr);
+static tree ffeste_io_ialist_ (bool have_err, ffestvUnit unit,
+ ffebld unit_expr, int unit_dflt);
+static tree ffeste_io_cilist_ (bool have_err, ffestvUnit unit,
+ ffebld unit_expr, int unit_dflt,
+ bool have_end, ffestvFormat format,
+ ffestpFile *format_spec, bool rec,
+ ffebld rec_expr);
+static tree ffeste_io_cllist_ (bool have_err, ffebld unit_expr,
+ ffestpFile *stat_spec);
+static tree ffeste_io_icilist_ (bool have_err, ffebld unit_expr,
+ bool have_end, ffestvFormat format,
+ ffestpFile *format_spec);
+static void ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token);
+static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr,
+ ffestpFile *file_spec,
+ ffestpFile *stat_spec,
+ ffestpFile *access_spec,
+ ffestpFile *form_spec,
+ ffestpFile *recl_spec,
+ ffestpFile *blank_spec);
+static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt);
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+static void ffeste_subr_file_ (char *kw, ffestpFile *spec);
+#else
+#error
+#endif
+
+/* Internal macros. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffeste_emit_line_note_() \
+ emit_line_note (input_filename, lineno)
+#endif
+#define ffeste_check_simple_() \
+ assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_)
+#define ffeste_check_start_() \
+ assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_); \
+ ffeste_statelet_ = FFESTE_stateletATTRIB_
+#define ffeste_check_attrib_() \
+ assert(ffeste_statelet_ == FFESTE_stateletATTRIB_)
+#define ffeste_check_item_() \
+ assert(ffeste_statelet_ == FFESTE_stateletATTRIB_ \
+ || ffeste_statelet_ == FFESTE_stateletITEM_); \
+ ffeste_statelet_ = FFESTE_stateletITEM_
+#define ffeste_check_item_startvals_() \
+ assert(ffeste_statelet_ == FFESTE_stateletATTRIB_ \
+ || ffeste_statelet_ == FFESTE_stateletITEM_); \
+ ffeste_statelet_ = FFESTE_stateletITEMVALS_
+#define ffeste_check_item_value_() \
+ assert(ffeste_statelet_ == FFESTE_stateletITEMVALS_)
+#define ffeste_check_item_endvals_() \
+ assert(ffeste_statelet_ == FFESTE_stateletITEMVALS_); \
+ ffeste_statelet_ = FFESTE_stateletITEM_
+#define ffeste_check_finish_() \
+ assert(ffeste_statelet_ == FFESTE_stateletATTRIB_ \
+ || ffeste_statelet_ == FFESTE_stateletITEM_); \
+ ffeste_statelet_ = FFESTE_stateletSIMPLE_
+
+#define ffeste_f2c_charnolenspec_(Spec,Exp,Init) \
+ do \
+ { \
+ if (Spec->kw_or_val_present) \
+ Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&ignore); \
+ else \
+ Exp = null_pointer_node; \
+ if (TREE_CONSTANT(Exp)) \
+ { \
+ Init = Exp; \
+ Exp = NULL_TREE; \
+ } \
+ else \
+ { \
+ Init = null_pointer_node; \
+ constantp = FALSE; \
+ } \
+ } while(0)
+
+#define ffeste_f2c_charspec_(Spec,Exp,Init,Lenexp,Leninit) \
+ do \
+ { \
+ if (Spec->kw_or_val_present) \
+ Exp = ffecom_arg_ptr_to_expr(Spec->u.expr,&Lenexp); \
+ else \
+ { \
+ Exp = null_pointer_node; \
+ Lenexp = ffecom_f2c_ftnlen_zero_node; \
+ } \
+ if (TREE_CONSTANT(Exp)) \
+ { \
+ Init = Exp; \
+ Exp = NULL_TREE; \
+ } \
+ else \
+ { \
+ Init = null_pointer_node; \
+ constantp = FALSE; \
+ } \
+ if ((Lenexp != NULL_TREE) && TREE_CONSTANT(Lenexp)) \
+ { \
+ Leninit = Lenexp; \
+ Lenexp = NULL_TREE; \
+ } \
+ else \
+ { \
+ Leninit = ffecom_f2c_ftnlen_zero_node; \
+ constantp = FALSE; \
+ } \
+ } while(0)
+
+#define ffeste_f2c_exp_(Field,Exp) \
+ do \
+ { \
+ if (Exp != NULL_TREE) \
+ { \
+ Exp = ffecom_modify(void_type_node,ffecom_2(COMPONENT_REF, \
+ TREE_TYPE(Field),t,Field),Exp); \
+ expand_expr_stmt(Exp); \
+ } \
+ } while(0)
+
+#define ffeste_f2c_init_(Init) \
+ do \
+ { \
+ TREE_CHAIN(initn) = build_tree_list((field = TREE_CHAIN(field)),Init); \
+ initn = TREE_CHAIN(initn); \
+ } while(0)
+
+#define ffeste_f2c_flagspec_(Flag,Init) \
+ do { Init = convert (ffecom_f2c_flag_type_node, \
+ Flag ? integer_one_node : integer_zero_node); } \
+ while(0)
+
+#define ffeste_f2c_intspec_(Spec,Exp,Init) \
+ do \
+ { \
+ if (Spec->kw_or_val_present) \
+ Exp = ffecom_expr(Spec->u.expr); \
+ else \
+ Exp = ffecom_integer_zero_node; \
+ if (TREE_CONSTANT(Exp)) \
+ { \
+ Init = Exp; \
+ Exp = NULL_TREE; \
+ } \
+ else \
+ { \
+ Init = ffecom_integer_zero_node; \
+ constantp = FALSE; \
+ } \
+ } while(0)
+
+#define ffeste_f2c_ptrtointspec_(Spec,Exp,Init) \
+ do \
+ { \
+ if (Spec->kw_or_val_present) \
+ Exp = ffecom_ptr_to_expr(Spec->u.expr); \
+ else \
+ Exp = null_pointer_node; \
+ if (TREE_CONSTANT(Exp)) \
+ { \
+ Init = Exp; \
+ Exp = NULL_TREE; \
+ } \
+ else \
+ { \
+ Init = null_pointer_node; \
+ constantp = FALSE; \
+ } \
+ } while(0)
+
+
+/* Begin an iterative DO loop. Pass the block to start if applicable.
+
+ NOTE: Does _two_ push_momentary () calls, which the caller must
+ undo (by calling ffeste_end_iterdo_). */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
+ tree *xitersvar, ffebld var,
+ ffebld start, ffelexToken start_token,
+ ffebld end, ffelexToken end_token,
+ ffebld incr, ffelexToken incr_token,
+ char *msg)
+{
+ tree tvar;
+ tree expr;
+ tree tstart;
+ tree tend;
+ tree tincr;
+ tree tincr_saved;
+ tree niters;
+
+ push_momentary (); /* Want to save these throughout the loop. */
+
+ tvar = ffecom_expr_rw (var);
+ tincr = ffecom_expr (incr);
+
+ /* Check whether incr is known to be zero, complain and fix. */
+
+ if (integer_zerop (tincr) || real_zerop (tincr))
+ {
+ ffebad_start (FFEBAD_DO_STEP_ZERO);
+ ffebad_here (0, ffelex_token_where_line (incr_token),
+ ffelex_token_where_column (incr_token));
+ ffebad_string (msg);
+ ffebad_finish ();
+ tincr = convert (TREE_TYPE (tvar), integer_one_node);
+ }
+
+ tincr_saved = ffecom_save_tree (tincr);
+
+ push_momentary (); /* Want to discard the rest after the loop. */
+
+ tstart = ffecom_expr (start);
+ tend = ffecom_expr (end);
+
+ { /* For warnings only, nothing else
+ happens here. */
+ tree try;
+
+ if (!ffe_is_onetrip ())
+ {
+ try = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
+ tend,
+ tstart);
+
+ try = ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
+ try,
+ tincr);
+
+ if (TREE_CODE (TREE_TYPE (tvar)) != REAL_TYPE)
+ try = ffecom_2 (TRUNC_DIV_EXPR, integer_type_node, try,
+ tincr);
+ else
+ try = convert (integer_type_node,
+ ffecom_2 (RDIV_EXPR, TREE_TYPE (tvar),
+ try,
+ tincr));
+
+ /* Warn if loop never executed, since we've done the evaluation
+ of the unofficial iteration count already. */
+
+ try = ffecom_truth_value (ffecom_2 (LE_EXPR, integer_type_node,
+ try,
+ convert (TREE_TYPE (tvar),
+ integer_zero_node)));
+
+ if (integer_onep (try))
+ {
+ ffebad_start (FFEBAD_DO_NULL);
+ ffebad_here (0, ffelex_token_where_line (start_token),
+ ffelex_token_where_column (start_token));
+ ffebad_string (msg);
+ ffebad_finish ();
+ }
+ }
+
+ /* Warn if end plus incr would overflow. */
+
+ try = ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
+ tend,
+ tincr);
+
+ if ((TREE_CODE_CLASS (TREE_CODE (try)) == 'c')
+ && TREE_CONSTANT_OVERFLOW (try))
+ {
+ ffebad_start (FFEBAD_DO_END_OVERFLOW);
+ ffebad_here (0, ffelex_token_where_line (end_token),
+ ffelex_token_where_column (end_token));
+ ffebad_string (msg);
+ ffebad_finish ();
+ }
+ }
+
+ /* Do the initial assignment into the DO var. */
+
+ expr = ffecom_modify (void_type_node, tvar, tstart);
+ expand_expr_stmt (expr);
+
+ expr = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
+ tend,
+ TREE_CONSTANT (tstart) ? tstart : tvar);
+
+ if (!ffe_is_onetrip ())
+ {
+ expr = ffecom_2 (PLUS_EXPR, TREE_TYPE (expr),
+ expr,
+ convert (TREE_TYPE (expr), tincr_saved));
+ }
+
+ if (TREE_CODE (TREE_TYPE (tvar)) != REAL_TYPE)
+ expr = ffecom_2 (TRUNC_DIV_EXPR, TREE_TYPE (expr),
+ expr,
+ tincr_saved);
+ else
+ expr = ffecom_2 (RDIV_EXPR, TREE_TYPE (expr),
+ expr,
+ tincr_saved);
+
+#if 1 /* New, F90-approved approach: convert to default INTEGER. */
+ if (TREE_TYPE (tvar) != error_mark_node)
+ expr = convert (ffecom_integer_type_node, expr);
+#else /* Old approach; convert to INTEGER unless that's a narrowing. */
+ if ((TREE_TYPE (tvar) != error_mark_node)
+ && ((TREE_CODE (TREE_TYPE (tvar)) != INTEGER_TYPE)
+ || ((TYPE_SIZE (TREE_TYPE (tvar)) != NULL_TREE)
+ && ((TREE_CODE (TYPE_SIZE (TREE_TYPE (tvar)))
+ != INTEGER_CST)
+ || (TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (tvar)))
+ <= TREE_INT_CST_LOW (TYPE_SIZE (ffecom_integer_type_node)))))))
+ /* Convert unless promoting INTEGER type of any kind downward to
+ default INTEGER; else leave as, say, INTEGER*8 (long long int). */
+ expr = convert (ffecom_integer_type_node, expr);
+#endif
+
+ niters = ffecom_push_tempvar (TREE_TYPE (expr),
+ FFETARGET_charactersizeNONE, -1, FALSE);
+ expr = ffecom_modify (void_type_node, niters, expr);
+ expand_expr_stmt (expr);
+
+ if (block == NULL)
+ expand_start_loop_continue_elsewhere (0);
+ else
+ ffestw_set_do_hook (block,
+ expand_start_loop_continue_elsewhere (1));
+
+ if (!ffe_is_onetrip ())
+ {
+ expr = ffecom_truth_value
+ (ffecom_2 (GE_EXPR, integer_type_node,
+ ffecom_2 (PREDECREMENT_EXPR,
+ TREE_TYPE (niters),
+ niters,
+ convert (TREE_TYPE (niters),
+ ffecom_integer_one_node)),
+ convert (TREE_TYPE (niters),
+ ffecom_integer_zero_node)));
+
+ expand_exit_loop_if_false (0, expr);
+ }
+
+ clear_momentary (); /* Discard the above now that we're done with
+ DO stmt. */
+
+ if (block == NULL)
+ {
+ *xtvar = tvar;
+ *xtincr = tincr_saved;
+ *xitersvar = niters;
+ }
+ else
+ {
+ ffestw_set_do_tvar (block, tvar);
+ ffestw_set_do_incr_saved (block, tincr_saved);
+ ffestw_set_do_count_var (block, niters);
+ }
+}
+
+#endif
+
+/* End an iterative DO loop. Pass the same iteration variable and increment
+ value trees that were generated in the paired _begin_ call. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_end_iterdo_ (tree tvar, tree tincr, tree itersvar)
+{
+ tree expr;
+ tree niters = itersvar;
+
+ expand_loop_continue_here ();
+
+ if (ffe_is_onetrip ())
+ {
+ expr = ffecom_truth_value
+ (ffecom_2 (GE_EXPR, integer_type_node,
+ ffecom_2 (PREDECREMENT_EXPR,
+ TREE_TYPE (niters),
+ niters,
+ convert (TREE_TYPE (niters),
+ ffecom_integer_one_node)),
+ convert (TREE_TYPE (niters),
+ ffecom_integer_zero_node)));
+
+ expand_exit_loop_if_false (0, expr);
+ }
+
+ expr = ffecom_modify (void_type_node, tvar,
+ ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
+ tvar,
+ tincr));
+ expand_expr_stmt (expr);
+ expand_end_loop ();
+
+ ffecom_pop_tempvar (itersvar); /* Free #iters var. */
+
+ clear_momentary ();
+ pop_momentary (); /* Lose the stuff we just built. */
+
+ clear_momentary ();
+ pop_momentary (); /* Lose the tvar and incr_saved trees. */
+}
+
+#endif
+/* ffeste_io_call_ -- Generate call to run-time I/O routine
+
+ tree callexpr = build(CALL_EXPR,...);
+ ffeste_io_call_(callexpr,TRUE);
+
+ Sets TREE_SIDE_EFFECTS(callexpr) = 1. If ffeste_io_iostat_ is not
+ NULL_TREE, replaces callexpr with "iostat = callexpr;". Expands the
+ result. If ffeste_io_abort_ is not NULL_TREE and the second argument
+ is TRUE, generates "if (iostat != 0) goto ffeste_io_abort_;". */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_io_call_ (tree call, bool do_check)
+{
+ /* Generate the call and optional assignment into iostat var. */
+
+ TREE_SIDE_EFFECTS (call) = 1;
+ if (ffeste_io_iostat_ != NULL_TREE)
+ {
+ call = ffecom_modify (do_check ? NULL_TREE : void_type_node,
+ ffeste_io_iostat_, call);
+ }
+ expand_expr_stmt (call);
+
+ if (!do_check
+ || (ffeste_io_abort_ == NULL_TREE)
+ || (TREE_CODE (ffeste_io_abort_) == ERROR_MARK))
+ return;
+
+ /* Generate optional test. */
+
+ expand_start_cond (ffecom_truth_value (ffeste_io_iostat_), 0);
+ expand_goto (ffeste_io_abort_);
+ expand_end_cond ();
+}
+
+#endif
+/* ffeste_io_dofio_ -- Generate call to do_fio for formatted I/O item
+
+ ffebld expr;
+ tree call;
+ call = ffeste_io_dofio_(expr);
+
+ Returns a tree for a CALL_EXPR to the do_fio function, which handles
+ a formatted I/O list item, along with the appropriate arguments for
+ the function. It is up to the caller to set the TREE_SIDE_EFFECTS flag
+ for the CALL_EXPR, expand (emit) the expression, emit any assignment
+ of the result to an IOSTAT= variable, and emit any checking of the
+ result for errors. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_dofio_ (ffebld expr)
+{
+ tree num_elements;
+ tree variable;
+ tree size;
+ tree arglist;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ bool is_complex;
+
+ bt = ffeinfo_basictype (ffebld_info (expr));
+ kt = ffeinfo_kindtype (ffebld_info (expr));
+
+ if ((bt == FFEINFO_basictypeANY)
+ || (kt == FFEINFO_kindtypeANY))
+ return error_mark_node;
+
+ if (bt == FFEINFO_basictypeCOMPLEX)
+ {
+ is_complex = TRUE;
+ bt = FFEINFO_basictypeREAL;
+ }
+ else
+ is_complex = FALSE;
+
+ ffecom_push_calltemps ();
+
+ variable = ffecom_arg_ptr_to_expr (expr, &size);
+
+ if ((variable == error_mark_node)
+ || (size == error_mark_node))
+ {
+ ffecom_pop_calltemps ();
+ return error_mark_node;
+ }
+
+ if (size == NULL_TREE) /* Already filled in for CHARACTER type. */
+ { /* "(ftnlen) sizeof(type)" */
+ size = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE (ffecom_tree_type[bt][kt]),
+ size_int (TYPE_PRECISION (char_type_node)));
+#if 0 /* Assume that while it is possible that char * is wider than
+ ftnlen, no object in Fortran space can get big enough for its
+ size to be wider than ftnlen. I really hope nobody wastes
+ time debugging a case where it can! */
+ assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
+ >= TYPE_PRECISION (TREE_TYPE (size)));
+#endif
+ size = convert (ffecom_f2c_ftnlen_type_node, size);
+ }
+
+ if ((ffeinfo_rank (ffebld_info (expr)) == 0)
+ || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE))
+ num_elements = is_complex ? ffecom_f2c_ftnlen_two_node
+ : ffecom_f2c_ftnlen_one_node;
+ else
+ {
+ num_elements = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size);
+ num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
+ size_int (TYPE_PRECISION
+ (char_type_node)));
+ num_elements = convert (ffecom_f2c_ftnlen_type_node,
+ num_elements);
+ }
+
+ num_elements
+ = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+ num_elements);
+
+ variable = convert (string_type_node, variable);
+
+ arglist = build_tree_list (NULL_TREE, num_elements);
+ TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable);
+ TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size);
+
+ ffecom_pop_calltemps ();
+
+ return ffecom_call_gfrt (FFECOM_gfrtDOFIO, arglist);
+}
+
+#endif
+/* ffeste_io_dolio_ -- Generate call to do_lio for list-directed I/O item
+
+ ffebld expr;
+ tree call;
+ call = ffeste_io_dolio_(expr);
+
+ Returns a tree for a CALL_EXPR to the do_lio function, which handles
+ a list-directed I/O list item, along with the appropriate arguments for
+ the function. It is up to the caller to set the TREE_SIDE_EFFECTS flag
+ for the CALL_EXPR, expand (emit) the expression, emit any assignment
+ of the result to an IOSTAT= variable, and emit any checking of the
+ result for errors. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_dolio_ (ffebld expr)
+{
+ tree type_id;
+ tree num_elements;
+ tree variable;
+ tree size;
+ tree arglist;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ int tc;
+
+ bt = ffeinfo_basictype (ffebld_info (expr));
+ kt = ffeinfo_kindtype (ffebld_info (expr));
+
+ if ((bt == FFEINFO_basictypeANY)
+ || (kt == FFEINFO_kindtypeANY))
+ return error_mark_node;
+
+ ffecom_push_calltemps ();
+
+ tc = ffecom_f2c_typecode (bt, kt);
+ assert (tc != -1);
+ type_id = build_int_2 (tc, 0);
+
+ type_id
+ = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnint_type_node,
+ convert (ffecom_f2c_ftnint_type_node,
+ type_id));
+
+ variable = ffecom_arg_ptr_to_expr (expr, &size);
+
+ if ((type_id == error_mark_node)
+ || (variable == error_mark_node)
+ || (size == error_mark_node))
+ {
+ ffecom_pop_calltemps ();
+ return error_mark_node;
+ }
+
+ if (size == NULL_TREE) /* Already filled in for CHARACTER type. */
+ { /* "(ftnlen) sizeof(type)" */
+ size = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE (ffecom_tree_type[bt][kt]),
+ size_int (TYPE_PRECISION (char_type_node)));
+#if 0 /* Assume that while it is possible that char * is wider than
+ ftnlen, no object in Fortran space can get big enough for its
+ size to be wider than ftnlen. I really hope nobody wastes
+ time debugging a case where it can! */
+ assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
+ >= TYPE_PRECISION (TREE_TYPE (size)));
+#endif
+ size = convert (ffecom_f2c_ftnlen_type_node, size);
+ }
+
+ if ((ffeinfo_rank (ffebld_info (expr)) == 0)
+ || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE))
+ num_elements = ffecom_integer_one_node;
+ else
+ {
+ num_elements = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size);
+ num_elements = size_binop (CEIL_DIV_EXPR,
+ num_elements, size_int (TYPE_PRECISION
+ (char_type_node)));
+ num_elements = convert (ffecom_f2c_ftnlen_type_node,
+ num_elements);
+ }
+
+ num_elements
+ = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+ num_elements);
+
+ variable = convert (string_type_node, variable);
+
+ arglist = build_tree_list (NULL_TREE, type_id);
+ TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, num_elements);
+ TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, variable);
+ TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (arglist)))
+ = build_tree_list (NULL_TREE, size);
+
+ ffecom_pop_calltemps ();
+
+ return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist);
+}
+
+#endif
+/* ffeste_io_douio_ -- Generate call to do_uio for unformatted I/O item
+
+ ffebld expr;
+ tree call;
+ call = ffeste_io_douio_(expr);
+
+ Returns a tree for a CALL_EXPR to the do_uio function, which handles
+ an unformatted I/O list item, along with the appropriate arguments for
+ the function. It is up to the caller to set the TREE_SIDE_EFFECTS flag
+ for the CALL_EXPR, expand (emit) the expression, emit any assignment
+ of the result to an IOSTAT= variable, and emit any checking of the
+ result for errors. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_douio_ (ffebld expr)
+{
+ tree num_elements;
+ tree variable;
+ tree size;
+ tree arglist;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ bool is_complex;
+
+ bt = ffeinfo_basictype (ffebld_info (expr));
+ kt = ffeinfo_kindtype (ffebld_info (expr));
+
+ if ((bt == FFEINFO_basictypeANY)
+ || (kt == FFEINFO_kindtypeANY))
+ return error_mark_node;
+
+ if (bt == FFEINFO_basictypeCOMPLEX)
+ {
+ is_complex = TRUE;
+ bt = FFEINFO_basictypeREAL;
+ }
+ else
+ is_complex = FALSE;
+
+ ffecom_push_calltemps ();
+
+ variable = ffecom_arg_ptr_to_expr (expr, &size);
+
+ if ((variable == error_mark_node)
+ || (size == error_mark_node))
+ {
+ ffecom_pop_calltemps ();
+ return error_mark_node;
+ }
+
+ if (size == NULL_TREE) /* Already filled in for CHARACTER type. */
+ { /* "(ftnlen) sizeof(type)" */
+ size = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE (ffecom_tree_type[bt][kt]),
+ size_int (TYPE_PRECISION (char_type_node)));
+#if 0 /* Assume that while it is possible that char * is wider than
+ ftnlen, no object in Fortran space can get big enough for its
+ size to be wider than ftnlen. I really hope nobody wastes
+ time debugging a case where it can! */
+ assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
+ >= TYPE_PRECISION (TREE_TYPE (size)));
+#endif
+ size = convert (ffecom_f2c_ftnlen_type_node, size);
+ }
+
+ if ((ffeinfo_rank (ffebld_info (expr)) == 0)
+ || (TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE))
+ num_elements = is_complex ? ffecom_f2c_ftnlen_two_node
+ : ffecom_f2c_ftnlen_one_node;
+ else
+ {
+ num_elements = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE (TREE_TYPE (TREE_TYPE (variable))), size);
+ num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
+ size_int (TYPE_PRECISION
+ (char_type_node)));
+ num_elements = convert (ffecom_f2c_ftnlen_type_node,
+ num_elements);
+ }
+
+ num_elements
+ = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+ num_elements);
+
+ variable = convert (string_type_node, variable);
+
+ arglist = build_tree_list (NULL_TREE, num_elements);
+ TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable);
+ TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size);
+
+ ffecom_pop_calltemps ();
+
+ return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist);
+}
+
+#endif
+/* ffeste_io_ialist_ -- Make arglist with ptr to B/E/R control list
+
+ tree arglist;
+ arglist = ffeste_io_ialist_(...);
+
+ Returns a tree suitable as an argument list containing a pointer to
+ a BACKSPACE/ENDFILE/REWIND control list. First, generates that control
+ list, if necessary, along with any static and run-time initializations
+ that are needed as specified by the arguments to this function. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_ialist_ (bool have_err,
+ ffestvUnit unit,
+ ffebld unit_expr,
+ int unit_dflt)
+{
+ static tree f2c_alist_struct = NULL_TREE;
+ tree t;
+ tree ttype;
+ int yes;
+ tree field;
+ tree inits, initn;
+ bool constantp = TRUE;
+ static tree errfield, unitfield;
+ tree errinit, unitinit;
+ tree unitexp;
+ static int mynumber = 0;
+
+ if (f2c_alist_struct == NULL_TREE)
+ {
+ tree ref;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ ref = make_node (RECORD_TYPE);
+
+ errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+ ffecom_f2c_flag_type_node);
+ unitfield = ffecom_decl_field (ref, errfield, "unit",
+ ffecom_f2c_ftnint_type_node);
+
+ TYPE_FIELDS (ref) = errfield;
+ layout_type (ref);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ f2c_alist_struct = ref;
+ }
+
+ ffeste_f2c_flagspec_ (have_err, errinit);
+
+ switch (unit)
+ {
+ case FFESTV_unitNONE:
+ case FFESTV_unitASTERISK:
+ unitinit = build_int_2 (unit_dflt, 0);
+ unitexp = NULL_TREE;
+ break;
+
+ case FFESTV_unitINTEXPR:
+ unitexp = ffecom_expr (unit_expr);
+ if (TREE_CONSTANT (unitexp))
+ {
+ unitinit = unitexp;
+ unitexp = NULL_TREE;
+ }
+ else
+ {
+ unitinit = ffecom_integer_zero_node;
+ constantp = FALSE;
+ }
+ break;
+
+ default:
+ assert ("bad unit spec" == NULL);
+ unitexp = NULL_TREE;
+ unitinit = ffecom_integer_zero_node;
+ break;
+ }
+
+ inits = build_tree_list ((field = TYPE_FIELDS (f2c_alist_struct)), errinit);
+ initn = inits;
+ ffeste_f2c_init_ (unitinit);
+
+ inits = build (CONSTRUCTOR, f2c_alist_struct, NULL_TREE, inits);
+ TREE_CONSTANT (inits) = constantp ? 1 : 0;
+ TREE_STATIC (inits) = 1;
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_alist_%d", NULL,
+ mynumber++),
+ f2c_alist_struct);
+ TREE_STATIC (t) = 1;
+ t = ffecom_start_decl (t, 1);
+ ffecom_finish_decl (t, inits, 0);
+
+ resume_momentary (yes);
+
+ ffeste_f2c_exp_ (unitfield, unitexp);
+
+ ttype = build_pointer_type (TREE_TYPE (t));
+ t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+ t = build_tree_list (NULL_TREE, t);
+
+ return t;
+}
+
+#endif
+/* ffeste_io_cilist_ -- Make arglist with ptr to external I/O control list
+
+ tree arglist;
+ arglist = ffeste_io_cilist_(...);
+
+ Returns a tree suitable as an argument list containing a pointer to
+ an external-file I/O control list. First, generates that control
+ list, if necessary, along with any static and run-time initializations
+ that are needed as specified by the arguments to this function. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_cilist_ (bool have_err,
+ ffestvUnit unit,
+ ffebld unit_expr,
+ int unit_dflt,
+ bool have_end,
+ ffestvFormat format,
+ ffestpFile *format_spec,
+ bool rec,
+ ffebld rec_expr)
+{
+ static tree f2c_cilist_struct = NULL_TREE;
+ tree t;
+ tree ttype;
+ int yes;
+ tree field;
+ tree inits, initn;
+ tree ignore; /* We ignore the length of format! */
+ bool constantp = TRUE;
+ static tree errfield, unitfield, endfield, formatfield, recfield;
+ tree errinit, unitinit, endinit, formatinit, recinit;
+ tree unitexp, formatexp, recexp;
+ static int mynumber = 0;
+
+ if (f2c_cilist_struct == NULL_TREE)
+ {
+ tree ref;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ ref = make_node (RECORD_TYPE);
+
+ errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+ ffecom_f2c_flag_type_node);
+ unitfield = ffecom_decl_field (ref, errfield, "unit",
+ ffecom_f2c_ftnint_type_node);
+ endfield = ffecom_decl_field (ref, unitfield, "end",
+ ffecom_f2c_flag_type_node);
+ formatfield = ffecom_decl_field (ref, endfield, "format",
+ string_type_node);
+ recfield = ffecom_decl_field (ref, formatfield, "rec",
+ ffecom_f2c_ftnint_type_node);
+
+ TYPE_FIELDS (ref) = errfield;
+ layout_type (ref);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ f2c_cilist_struct = ref;
+ }
+
+ ffeste_f2c_flagspec_ (have_err, errinit);
+
+ switch (unit)
+ {
+ case FFESTV_unitNONE:
+ case FFESTV_unitASTERISK:
+ unitinit = build_int_2 (unit_dflt, 0);
+ unitexp = NULL_TREE;
+ break;
+
+ case FFESTV_unitINTEXPR:
+ unitexp = ffecom_expr (unit_expr);
+ if (TREE_CONSTANT (unitexp))
+ {
+ unitinit = unitexp;
+ unitexp = NULL_TREE;
+ }
+ else
+ {
+ unitinit = ffecom_integer_zero_node;
+ constantp = FALSE;
+ }
+ break;
+
+ default:
+ assert ("bad unit spec" == NULL);
+ unitexp = NULL_TREE;
+ unitinit = ffecom_integer_zero_node;
+ break;
+ }
+
+ switch (format)
+ {
+ case FFESTV_formatNONE:
+ formatinit = null_pointer_node;
+ formatexp = NULL_TREE;
+ break;
+
+ case FFESTV_formatLABEL:
+ formatexp = NULL_TREE;
+ formatinit = ffecom_lookup_label (format_spec->u.label);
+ if ((formatinit == NULL_TREE)
+ || (TREE_CODE (formatinit) == ERROR_MARK))
+ break;
+ formatinit = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (void_type_node),
+ formatinit);
+ TREE_CONSTANT (formatinit) = 1;
+ break;
+
+ case FFESTV_formatCHAREXPR:
+ formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, &ignore);
+ if (TREE_CONSTANT (formatexp))
+ {
+ formatinit = formatexp;
+ formatexp = NULL_TREE;
+ }
+ else
+ {
+ formatinit = null_pointer_node;
+ constantp = FALSE;
+ }
+ break;
+
+ case FFESTV_formatASTERISK:
+ formatinit = null_pointer_node;
+ formatexp = NULL_TREE;
+ break;
+
+ case FFESTV_formatINTEXPR:
+ formatinit = null_pointer_node;
+ formatexp = ffecom_expr_assign (format_spec->u.expr);
+ if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (formatexp)))
+ < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+ error ("ASSIGNed FORMAT specifier is too small");
+ formatexp = convert (string_type_node, formatexp);
+ break;
+
+ case FFESTV_formatNAMELIST:
+ formatinit = ffecom_expr (format_spec->u.expr);
+ formatexp = NULL_TREE;
+ break;
+
+ default:
+ assert ("bad format spec" == NULL);
+ formatexp = NULL_TREE;
+ formatinit = integer_zero_node;
+ break;
+ }
+
+ ffeste_f2c_flagspec_ (have_end, endinit);
+
+ if (rec)
+ recexp = ffecom_expr (rec_expr);
+ else
+ recexp = ffecom_integer_zero_node;
+ if (TREE_CONSTANT (recexp))
+ {
+ recinit = recexp;
+ recexp = NULL_TREE;
+ }
+ else
+ {
+ recinit = ffecom_integer_zero_node;
+ constantp = FALSE;
+ }
+
+ inits = build_tree_list ((field = TYPE_FIELDS (f2c_cilist_struct)), errinit);
+ initn = inits;
+ ffeste_f2c_init_ (unitinit);
+ ffeste_f2c_init_ (endinit);
+ ffeste_f2c_init_ (formatinit);
+ ffeste_f2c_init_ (recinit);
+
+ inits = build (CONSTRUCTOR, f2c_cilist_struct, NULL_TREE, inits);
+ TREE_CONSTANT (inits) = constantp ? 1 : 0;
+ TREE_STATIC (inits) = 1;
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_cilist_%d", NULL,
+ mynumber++),
+ f2c_cilist_struct);
+ TREE_STATIC (t) = 1;
+ t = ffecom_start_decl (t, 1);
+ ffecom_finish_decl (t, inits, 0);
+
+ resume_momentary (yes);
+
+ ffeste_f2c_exp_ (unitfield, unitexp);
+ ffeste_f2c_exp_ (formatfield, formatexp);
+ ffeste_f2c_exp_ (recfield, recexp);
+
+ ttype = build_pointer_type (TREE_TYPE (t));
+ t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+ t = build_tree_list (NULL_TREE, t);
+
+ return t;
+}
+
+#endif
+/* ffeste_io_cllist_ -- Make arglist with ptr to CLOSE control list
+
+ tree arglist;
+ arglist = ffeste_io_cllist_(...);
+
+ Returns a tree suitable as an argument list containing a pointer to
+ a CLOSE-statement control list. First, generates that control
+ list, if necessary, along with any static and run-time initializations
+ that are needed as specified by the arguments to this function. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_cllist_ (bool have_err,
+ ffebld unit_expr,
+ ffestpFile *stat_spec)
+{
+ static tree f2c_close_struct = NULL_TREE;
+ tree t;
+ tree ttype;
+ int yes;
+ tree field;
+ tree inits, initn;
+ tree ignore; /* Ignore length info for certain fields. */
+ bool constantp = TRUE;
+ static tree errfield, unitfield, statfield;
+ tree errinit, unitinit, statinit;
+ tree unitexp, statexp;
+ static int mynumber = 0;
+
+ if (f2c_close_struct == NULL_TREE)
+ {
+ tree ref;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ ref = make_node (RECORD_TYPE);
+
+ errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+ ffecom_f2c_flag_type_node);
+ unitfield = ffecom_decl_field (ref, errfield, "unit",
+ ffecom_f2c_ftnint_type_node);
+ statfield = ffecom_decl_field (ref, unitfield, "stat",
+ string_type_node);
+
+ TYPE_FIELDS (ref) = errfield;
+ layout_type (ref);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ f2c_close_struct = ref;
+ }
+
+ ffeste_f2c_flagspec_ (have_err, errinit);
+
+ unitexp = ffecom_expr (unit_expr);
+ if (TREE_CONSTANT (unitexp))
+ {
+ unitinit = unitexp;
+ unitexp = NULL_TREE;
+ }
+ else
+ {
+ unitinit = ffecom_integer_zero_node;
+ constantp = FALSE;
+ }
+
+ ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit);
+
+ inits = build_tree_list ((field = TYPE_FIELDS (f2c_close_struct)), errinit);
+ initn = inits;
+ ffeste_f2c_init_ (unitinit);
+ ffeste_f2c_init_ (statinit);
+
+ inits = build (CONSTRUCTOR, f2c_close_struct, NULL_TREE, inits);
+ TREE_CONSTANT (inits) = constantp ? 1 : 0;
+ TREE_STATIC (inits) = 1;
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_cllist_%d", NULL,
+ mynumber++),
+ f2c_close_struct);
+ TREE_STATIC (t) = 1;
+ t = ffecom_start_decl (t, 1);
+ ffecom_finish_decl (t, inits, 0);
+
+ resume_momentary (yes);
+
+ ffeste_f2c_exp_ (unitfield, unitexp);
+ ffeste_f2c_exp_ (statfield, statexp);
+
+ ttype = build_pointer_type (TREE_TYPE (t));
+ t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+ t = build_tree_list (NULL_TREE, t);
+
+ return t;
+}
+
+#endif
+/* ffeste_io_icilist_ -- Make arglist with ptr to internal I/O control list
+
+ tree arglist;
+ arglist = ffeste_io_icilist_(...);
+
+ Returns a tree suitable as an argument list containing a pointer to
+ an internal-file I/O control list. First, generates that control
+ list, if necessary, along with any static and run-time initializations
+ that are needed as specified by the arguments to this function. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_icilist_ (bool have_err,
+ ffebld unit_expr,
+ bool have_end,
+ ffestvFormat format,
+ ffestpFile *format_spec)
+{
+ static tree f2c_icilist_struct = NULL_TREE;
+ tree t;
+ tree ttype;
+ int yes;
+ tree field;
+ tree inits, initn;
+ tree ignore; /* We ignore the length of format! */
+ bool constantp = TRUE;
+ static tree errfield, unitfield, endfield, formatfield, unitlenfield,
+ unitnumfield;
+ tree errinit, unitinit, endinit, formatinit, unitleninit, unitnuminit;
+ tree unitexp, formatexp, unitlenexp, unitnumexp;
+ static int mynumber = 0;
+
+ if (f2c_icilist_struct == NULL_TREE)
+ {
+ tree ref;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ ref = make_node (RECORD_TYPE);
+
+ errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+ ffecom_f2c_flag_type_node);
+ unitfield = ffecom_decl_field (ref, errfield, "unit",
+ string_type_node);
+ endfield = ffecom_decl_field (ref, unitfield, "end",
+ ffecom_f2c_flag_type_node);
+ formatfield = ffecom_decl_field (ref, endfield, "format",
+ string_type_node);
+ unitlenfield = ffecom_decl_field (ref, formatfield, "unitlen",
+ ffecom_f2c_ftnint_type_node);
+ unitnumfield = ffecom_decl_field (ref, unitlenfield, "unitnum",
+ ffecom_f2c_ftnint_type_node);
+
+ TYPE_FIELDS (ref) = errfield;
+ layout_type (ref);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ f2c_icilist_struct = ref;
+ }
+
+ ffeste_f2c_flagspec_ (have_err, errinit);
+
+ unitexp = ffecom_arg_ptr_to_expr (unit_expr, &unitlenexp);
+ if ((ffeinfo_rank (ffebld_info (unit_expr)) == 0)
+ || (TREE_CODE (TREE_TYPE (TREE_TYPE (unitexp))) != ARRAY_TYPE))
+ unitnumexp = ffecom_integer_one_node;
+ else
+ {
+ unitnumexp = size_binop (CEIL_DIV_EXPR,
+ TYPE_SIZE (TREE_TYPE (TREE_TYPE (unitexp))), unitlenexp);
+ unitnumexp = size_binop (CEIL_DIV_EXPR,
+ unitnumexp, size_int (TYPE_PRECISION
+ (char_type_node)));
+ }
+ if (TREE_CONSTANT (unitexp))
+ {
+ unitinit = unitexp;
+ unitexp = NULL_TREE;
+ }
+ else
+ {
+ unitinit = null_pointer_node;
+ constantp = FALSE;
+ }
+ if ((unitlenexp != NULL_TREE) && TREE_CONSTANT (unitlenexp))
+ {
+ unitleninit = unitlenexp;
+ unitlenexp = NULL_TREE;
+ }
+ else
+ {
+ unitleninit = ffecom_integer_zero_node;
+ constantp = FALSE;
+ }
+ if (TREE_CONSTANT (unitnumexp))
+ {
+ unitnuminit = unitnumexp;
+ unitnumexp = NULL_TREE;
+ }
+ else
+ {
+ unitnuminit = ffecom_integer_zero_node;
+ constantp = FALSE;
+ }
+
+ switch (format)
+ {
+ case FFESTV_formatNONE:
+ formatinit = null_pointer_node;
+ formatexp = NULL_TREE;
+ break;
+
+ case FFESTV_formatLABEL:
+ formatexp = NULL_TREE;
+ formatinit = ffecom_lookup_label (format_spec->u.label);
+ if ((formatinit == NULL_TREE)
+ || (TREE_CODE (formatinit) == ERROR_MARK))
+ break;
+ formatinit = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (void_type_node),
+ formatinit);
+ TREE_CONSTANT (formatinit) = 1;
+ break;
+
+ case FFESTV_formatCHAREXPR:
+ formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, &ignore);
+ if (TREE_CONSTANT (formatexp))
+ {
+ formatinit = formatexp;
+ formatexp = NULL_TREE;
+ }
+ else
+ {
+ formatinit = null_pointer_node;
+ constantp = FALSE;
+ }
+ break;
+
+ case FFESTV_formatASTERISK:
+ formatinit = null_pointer_node;
+ formatexp = NULL_TREE;
+ break;
+
+ case FFESTV_formatINTEXPR:
+ formatinit = null_pointer_node;
+ formatexp = ffecom_expr_assign (format_spec->u.expr);
+ if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (formatexp)))
+ < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+ error ("ASSIGNed FORMAT specifier is too small");
+ formatexp = convert (string_type_node, formatexp);
+ break;
+
+ default:
+ assert ("bad format spec" == NULL);
+ formatexp = NULL_TREE;
+ formatinit = ffecom_integer_zero_node;
+ break;
+ }
+
+ ffeste_f2c_flagspec_ (have_end, endinit);
+
+ inits = build_tree_list ((field = TYPE_FIELDS (f2c_icilist_struct)),
+ errinit);
+ initn = inits;
+ ffeste_f2c_init_ (unitinit);
+ ffeste_f2c_init_ (endinit);
+ ffeste_f2c_init_ (formatinit);
+ ffeste_f2c_init_ (unitleninit);
+ ffeste_f2c_init_ (unitnuminit);
+
+ inits = build (CONSTRUCTOR, f2c_icilist_struct, NULL_TREE, inits);
+ TREE_CONSTANT (inits) = constantp ? 1 : 0;
+ TREE_STATIC (inits) = 1;
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_icilist_%d", NULL,
+ mynumber++),
+ f2c_icilist_struct);
+ TREE_STATIC (t) = 1;
+ t = ffecom_start_decl (t, 1);
+ ffecom_finish_decl (t, inits, 0);
+
+ resume_momentary (yes);
+
+ ffeste_f2c_exp_ (unitfield, unitexp);
+ ffeste_f2c_exp_ (formatfield, formatexp);
+ ffeste_f2c_exp_ (unitlenfield, unitlenexp);
+ ffeste_f2c_exp_ (unitnumfield, unitnumexp);
+
+ ttype = build_pointer_type (TREE_TYPE (t));
+ t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+ t = build_tree_list (NULL_TREE, t);
+
+ return t;
+}
+
+#endif
+/* ffeste_io_impdo_ -- Handle implied-DO in I/O list
+
+ ffebld expr;
+ ffeste_io_impdo_(expr);
+
+ Expands code to start up the DO loop. Then for each item in the
+ DO loop, handles appropriately (possibly including recursively calling
+ itself). Then expands code to end the DO loop. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token)
+{
+ ffebld var = ffebld_head (ffebld_right (impdo));
+ ffebld start = ffebld_head (ffebld_trail (ffebld_right (impdo)));
+ ffebld end = ffebld_head (ffebld_trail (ffebld_trail
+ (ffebld_right (impdo))));
+ ffebld incr = ffebld_head (ffebld_trail (ffebld_trail
+ (ffebld_trail (ffebld_right (impdo)))));
+ ffebld list; /* Used for list of items in left part of
+ impdo. */
+ ffebld item; /* I/O item from head of given list. */
+ tree tvar;
+ tree tincr;
+ tree titervar;
+
+ if (incr == NULL)
+ {
+ incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+ ffebld_set_info (incr, ffeinfo_new
+ (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ }
+
+ /* Start the DO loop. */
+
+ start = ffeexpr_convert_expr (start, impdo_token, var, impdo_token,
+ FFEEXPR_contextLET);
+ end = ffeexpr_convert_expr (end, impdo_token, var, impdo_token,
+ FFEEXPR_contextLET);
+ incr = ffeexpr_convert_expr (incr, impdo_token, var, impdo_token,
+ FFEEXPR_contextLET);
+
+ ffeste_begin_iterdo_ (NULL, &tvar, &tincr, &titervar, var,
+ start, impdo_token,
+ end, impdo_token,
+ incr, impdo_token,
+ "Implied DO loop");
+
+ /* Handle the list of items. */
+
+ for (list = ffebld_left (impdo); list != NULL; list = ffebld_trail (list))
+ {
+ item = ffebld_head (list);
+ if (item == NULL)
+ continue;
+ while (ffebld_op (item) == FFEBLD_opPAREN)
+ item = ffebld_left (item);
+ if (ffebld_op (item) == FFEBLD_opANY)
+ continue;
+ if (ffebld_op (item) == FFEBLD_opIMPDO)
+ ffeste_io_impdo_ (item, impdo_token);
+ else
+ ffeste_io_call_ ((*ffeste_io_driver_) (item), TRUE);
+ clear_momentary ();
+ }
+
+ /* Generate end of implied-do construct. */
+
+ ffeste_end_iterdo_ (tvar, tincr, titervar);
+}
+
+#endif
+/* ffeste_io_inlist_ -- Make arglist with ptr to INQUIRE control list
+
+ tree arglist;
+ arglist = ffeste_io_inlist_(...);
+
+ Returns a tree suitable as an argument list containing a pointer to
+ an INQUIRE-statement control list. First, generates that control
+ list, if necessary, along with any static and run-time initializations
+ that are needed as specified by the arguments to this function. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_inlist_ (bool have_err,
+ ffestpFile *unit_spec,
+ ffestpFile *file_spec,
+ ffestpFile *exist_spec,
+ ffestpFile *open_spec,
+ ffestpFile *number_spec,
+ ffestpFile *named_spec,
+ ffestpFile *name_spec,
+ ffestpFile *access_spec,
+ ffestpFile *sequential_spec,
+ ffestpFile *direct_spec,
+ ffestpFile *form_spec,
+ ffestpFile *formatted_spec,
+ ffestpFile *unformatted_spec,
+ ffestpFile *recl_spec,
+ ffestpFile *nextrec_spec,
+ ffestpFile *blank_spec)
+{
+ static tree f2c_inquire_struct = NULL_TREE;
+ tree t;
+ tree ttype;
+ int yes;
+ tree field;
+ tree inits, initn;
+ bool constantp = TRUE;
+ static tree errfield, unitfield, filefield, filelenfield, existfield,
+ openfield, numberfield, namedfield, namefield, namelenfield, accessfield,
+ accesslenfield, sequentialfield, sequentiallenfield, directfield, directlenfield,
+ formfield, formlenfield, formattedfield, formattedlenfield, unformattedfield,
+ unformattedlenfield, reclfield, nextrecfield, blankfield, blanklenfield;
+ tree errinit, unitinit, fileinit, fileleninit, existinit, openinit, numberinit,
+ namedinit, nameinit, nameleninit, accessinit, accessleninit, sequentialinit,
+ sequentialleninit, directinit, directleninit, forminit, formleninit,
+ formattedinit, formattedleninit, unformattedinit, unformattedleninit,
+ reclinit, nextrecinit, blankinit, blankleninit;
+ tree
+ unitexp, fileexp, filelenexp, existexp, openexp, numberexp, namedexp,
+ nameexp, namelenexp, accessexp, accesslenexp, sequentialexp, sequentiallenexp,
+ directexp, directlenexp, formexp, formlenexp, formattedexp, formattedlenexp,
+ unformattedexp, unformattedlenexp, reclexp, nextrecexp, blankexp, blanklenexp;
+ static int mynumber = 0;
+
+ if (f2c_inquire_struct == NULL_TREE)
+ {
+ tree ref;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ ref = make_node (RECORD_TYPE);
+
+ errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+ ffecom_f2c_flag_type_node);
+ unitfield = ffecom_decl_field (ref, errfield, "unit",
+ ffecom_f2c_ftnint_type_node);
+ filefield = ffecom_decl_field (ref, unitfield, "file",
+ string_type_node);
+ filelenfield = ffecom_decl_field (ref, filefield, "filelen",
+ ffecom_f2c_ftnlen_type_node);
+ existfield = ffecom_decl_field (ref, filelenfield, "exist",
+ ffecom_f2c_ptr_to_ftnint_type_node);
+ openfield = ffecom_decl_field (ref, existfield, "open",
+ ffecom_f2c_ptr_to_ftnint_type_node);
+ numberfield = ffecom_decl_field (ref, openfield, "number",
+ ffecom_f2c_ptr_to_ftnint_type_node);
+ namedfield = ffecom_decl_field (ref, numberfield, "named",
+ ffecom_f2c_ptr_to_ftnint_type_node);
+ namefield = ffecom_decl_field (ref, namedfield, "name",
+ string_type_node);
+ namelenfield = ffecom_decl_field (ref, namefield, "namelen",
+ ffecom_f2c_ftnlen_type_node);
+ accessfield = ffecom_decl_field (ref, namelenfield, "access",
+ string_type_node);
+ accesslenfield = ffecom_decl_field (ref, accessfield, "accesslen",
+ ffecom_f2c_ftnlen_type_node);
+ sequentialfield = ffecom_decl_field (ref, accesslenfield, "sequential",
+ string_type_node);
+ sequentiallenfield = ffecom_decl_field (ref, sequentialfield,
+ "sequentiallen",
+ ffecom_f2c_ftnlen_type_node);
+ directfield = ffecom_decl_field (ref, sequentiallenfield, "direct",
+ string_type_node);
+ directlenfield = ffecom_decl_field (ref, directfield, "directlen",
+ ffecom_f2c_ftnlen_type_node);
+ formfield = ffecom_decl_field (ref, directlenfield, "form",
+ string_type_node);
+ formlenfield = ffecom_decl_field (ref, formfield, "formlen",
+ ffecom_f2c_ftnlen_type_node);
+ formattedfield = ffecom_decl_field (ref, formlenfield, "formatted",
+ string_type_node);
+ formattedlenfield = ffecom_decl_field (ref, formattedfield,
+ "formattedlen",
+ ffecom_f2c_ftnlen_type_node);
+ unformattedfield = ffecom_decl_field (ref, formattedlenfield,
+ "unformatted",
+ string_type_node);
+ unformattedlenfield = ffecom_decl_field (ref, unformattedfield,
+ "unformattedlen",
+ ffecom_f2c_ftnlen_type_node);
+ reclfield = ffecom_decl_field (ref, unformattedlenfield, "recl",
+ ffecom_f2c_ptr_to_ftnint_type_node);
+ nextrecfield = ffecom_decl_field (ref, reclfield, "nextrec",
+ ffecom_f2c_ptr_to_ftnint_type_node);
+ blankfield = ffecom_decl_field (ref, nextrecfield, "blank",
+ string_type_node);
+ blanklenfield = ffecom_decl_field (ref, blankfield, "blanklen",
+ ffecom_f2c_ftnlen_type_node);
+
+ TYPE_FIELDS (ref) = errfield;
+ layout_type (ref);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ f2c_inquire_struct = ref;
+ }
+
+ ffeste_f2c_flagspec_ (have_err, errinit);
+ ffeste_f2c_intspec_ (unit_spec, unitexp, unitinit);
+ ffeste_f2c_charspec_ (file_spec, fileexp, fileinit, filelenexp, fileleninit);
+ ffeste_f2c_ptrtointspec_ (exist_spec, existexp, existinit);
+ ffeste_f2c_ptrtointspec_ (open_spec, openexp, openinit);
+ ffeste_f2c_ptrtointspec_ (number_spec, numberexp, numberinit);
+ ffeste_f2c_ptrtointspec_ (named_spec, namedexp, namedinit);
+ ffeste_f2c_charspec_ (name_spec, nameexp, nameinit, namelenexp, nameleninit);
+ ffeste_f2c_charspec_ (access_spec, accessexp, accessinit, accesslenexp,
+ accessleninit);
+ ffeste_f2c_charspec_ (sequential_spec, sequentialexp, sequentialinit,
+ sequentiallenexp, sequentialleninit);
+ ffeste_f2c_charspec_ (direct_spec, directexp, directinit, directlenexp,
+ directleninit);
+ ffeste_f2c_charspec_ (form_spec, formexp, forminit, formlenexp, formleninit);
+ ffeste_f2c_charspec_ (formatted_spec, formattedexp, formattedinit,
+ formattedlenexp, formattedleninit);
+ ffeste_f2c_charspec_ (unformatted_spec, unformattedexp, unformattedinit,
+ unformattedlenexp, unformattedleninit);
+ ffeste_f2c_ptrtointspec_ (recl_spec, reclexp, reclinit);
+ ffeste_f2c_ptrtointspec_ (nextrec_spec, nextrecexp, nextrecinit);
+ ffeste_f2c_charspec_ (blank_spec, blankexp, blankinit, blanklenexp,
+ blankleninit);
+
+ inits = build_tree_list ((field = TYPE_FIELDS (f2c_inquire_struct)),
+ errinit);
+ initn = inits;
+ ffeste_f2c_init_ (unitinit);
+ ffeste_f2c_init_ (fileinit);
+ ffeste_f2c_init_ (fileleninit);
+ ffeste_f2c_init_ (existinit);
+ ffeste_f2c_init_ (openinit);
+ ffeste_f2c_init_ (numberinit);
+ ffeste_f2c_init_ (namedinit);
+ ffeste_f2c_init_ (nameinit);
+ ffeste_f2c_init_ (nameleninit);
+ ffeste_f2c_init_ (accessinit);
+ ffeste_f2c_init_ (accessleninit);
+ ffeste_f2c_init_ (sequentialinit);
+ ffeste_f2c_init_ (sequentialleninit);
+ ffeste_f2c_init_ (directinit);
+ ffeste_f2c_init_ (directleninit);
+ ffeste_f2c_init_ (forminit);
+ ffeste_f2c_init_ (formleninit);
+ ffeste_f2c_init_ (formattedinit);
+ ffeste_f2c_init_ (formattedleninit);
+ ffeste_f2c_init_ (unformattedinit);
+ ffeste_f2c_init_ (unformattedleninit);
+ ffeste_f2c_init_ (reclinit);
+ ffeste_f2c_init_ (nextrecinit);
+ ffeste_f2c_init_ (blankinit);
+ ffeste_f2c_init_ (blankleninit);
+
+ inits = build (CONSTRUCTOR, f2c_inquire_struct, NULL_TREE, inits);
+ TREE_CONSTANT (inits) = constantp ? 1 : 0;
+ TREE_STATIC (inits) = 1;
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_inlist_%d", NULL,
+ mynumber++),
+ f2c_inquire_struct);
+ TREE_STATIC (t) = 1;
+ t = ffecom_start_decl (t, 1);
+ ffecom_finish_decl (t, inits, 0);
+
+ resume_momentary (yes);
+
+ ffeste_f2c_exp_ (unitfield, unitexp);
+ ffeste_f2c_exp_ (filefield, fileexp);
+ ffeste_f2c_exp_ (filelenfield, filelenexp);
+ ffeste_f2c_exp_ (existfield, existexp);
+ ffeste_f2c_exp_ (openfield, openexp);
+ ffeste_f2c_exp_ (numberfield, numberexp);
+ ffeste_f2c_exp_ (namedfield, namedexp);
+ ffeste_f2c_exp_ (namefield, nameexp);
+ ffeste_f2c_exp_ (namelenfield, namelenexp);
+ ffeste_f2c_exp_ (accessfield, accessexp);
+ ffeste_f2c_exp_ (accesslenfield, accesslenexp);
+ ffeste_f2c_exp_ (sequentialfield, sequentialexp);
+ ffeste_f2c_exp_ (sequentiallenfield, sequentiallenexp);
+ ffeste_f2c_exp_ (directfield, directexp);
+ ffeste_f2c_exp_ (directlenfield, directlenexp);
+ ffeste_f2c_exp_ (formfield, formexp);
+ ffeste_f2c_exp_ (formlenfield, formlenexp);
+ ffeste_f2c_exp_ (formattedfield, formattedexp);
+ ffeste_f2c_exp_ (formattedlenfield, formattedlenexp);
+ ffeste_f2c_exp_ (unformattedfield, unformattedexp);
+ ffeste_f2c_exp_ (unformattedlenfield, unformattedlenexp);
+ ffeste_f2c_exp_ (reclfield, reclexp);
+ ffeste_f2c_exp_ (nextrecfield, nextrecexp);
+ ffeste_f2c_exp_ (blankfield, blankexp);
+ ffeste_f2c_exp_ (blanklenfield, blanklenexp);
+
+ ttype = build_pointer_type (TREE_TYPE (t));
+ t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+ t = build_tree_list (NULL_TREE, t);
+
+ return t;
+}
+
+#endif
+/* ffeste_io_olist_ -- Make arglist with ptr to OPEN control list
+
+ tree arglist;
+ arglist = ffeste_io_olist_(...);
+
+ Returns a tree suitable as an argument list containing a pointer to
+ an OPEN-statement control list. First, generates that control
+ list, if necessary, along with any static and run-time initializations
+ that are needed as specified by the arguments to this function. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static tree
+ffeste_io_olist_ (bool have_err,
+ ffebld unit_expr,
+ ffestpFile *file_spec,
+ ffestpFile *stat_spec,
+ ffestpFile *access_spec,
+ ffestpFile *form_spec,
+ ffestpFile *recl_spec,
+ ffestpFile *blank_spec)
+{
+ static tree f2c_open_struct = NULL_TREE;
+ tree t;
+ tree ttype;
+ int yes;
+ tree field;
+ tree inits, initn;
+ tree ignore; /* Ignore length info for certain fields. */
+ bool constantp = TRUE;
+ static tree errfield, unitfield, filefield, filelenfield, statfield,
+ accessfield, formfield, reclfield, blankfield;
+ tree errinit, unitinit, fileinit, fileleninit, statinit, accessinit,
+ forminit, reclinit, blankinit;
+ tree
+ unitexp, fileexp, filelenexp, statexp, accessexp, formexp, reclexp,
+ blankexp;
+ static int mynumber = 0;
+
+ if (f2c_open_struct == NULL_TREE)
+ {
+ tree ref;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ ref = make_node (RECORD_TYPE);
+
+ errfield = ffecom_decl_field (ref, NULL_TREE, "err",
+ ffecom_f2c_flag_type_node);
+ unitfield = ffecom_decl_field (ref, errfield, "unit",
+ ffecom_f2c_ftnint_type_node);
+ filefield = ffecom_decl_field (ref, unitfield, "file",
+ string_type_node);
+ filelenfield = ffecom_decl_field (ref, filefield, "filelen",
+ ffecom_f2c_ftnlen_type_node);
+ statfield = ffecom_decl_field (ref, filelenfield, "stat",
+ string_type_node);
+ accessfield = ffecom_decl_field (ref, statfield, "access",
+ string_type_node);
+ formfield = ffecom_decl_field (ref, accessfield, "form",
+ string_type_node);
+ reclfield = ffecom_decl_field (ref, formfield, "recl",
+ ffecom_f2c_ftnint_type_node);
+ blankfield = ffecom_decl_field (ref, reclfield, "blank",
+ string_type_node);
+
+ TYPE_FIELDS (ref) = errfield;
+ layout_type (ref);
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ f2c_open_struct = ref;
+ }
+
+ ffeste_f2c_flagspec_ (have_err, errinit);
+
+ unitexp = ffecom_expr (unit_expr);
+ if (TREE_CONSTANT (unitexp))
+ {
+ unitinit = unitexp;
+ unitexp = NULL_TREE;
+ }
+ else
+ {
+ unitinit = ffecom_integer_zero_node;
+ constantp = FALSE;
+ }
+
+ ffeste_f2c_charspec_ (file_spec, fileexp, fileinit, filelenexp, fileleninit);
+ ffeste_f2c_charnolenspec_ (stat_spec, statexp, statinit);
+ ffeste_f2c_charnolenspec_ (access_spec, accessexp, accessinit);
+ ffeste_f2c_charnolenspec_ (form_spec, formexp, forminit);
+ ffeste_f2c_intspec_ (recl_spec, reclexp, reclinit);
+ ffeste_f2c_charnolenspec_ (blank_spec, blankexp, blankinit);
+
+ inits = build_tree_list ((field = TYPE_FIELDS (f2c_open_struct)), errinit);
+ initn = inits;
+ ffeste_f2c_init_ (unitinit);
+ ffeste_f2c_init_ (fileinit);
+ ffeste_f2c_init_ (fileleninit);
+ ffeste_f2c_init_ (statinit);
+ ffeste_f2c_init_ (accessinit);
+ ffeste_f2c_init_ (forminit);
+ ffeste_f2c_init_ (reclinit);
+ ffeste_f2c_init_ (blankinit);
+
+ inits = build (CONSTRUCTOR, f2c_open_struct, NULL_TREE, inits);
+ TREE_CONSTANT (inits) = constantp ? 1 : 0;
+ TREE_STATIC (inits) = 1;
+
+ yes = suspend_momentary ();
+
+ t = build_decl (VAR_DECL,
+ ffecom_get_invented_identifier ("__g77_olist_%d", NULL,
+ mynumber++),
+ f2c_open_struct);
+ TREE_STATIC (t) = 1;
+ t = ffecom_start_decl (t, 1);
+ ffecom_finish_decl (t, inits, 0);
+
+ resume_momentary (yes);
+
+ ffeste_f2c_exp_ (unitfield, unitexp);
+ ffeste_f2c_exp_ (filefield, fileexp);
+ ffeste_f2c_exp_ (filelenfield, filelenexp);
+ ffeste_f2c_exp_ (statfield, statexp);
+ ffeste_f2c_exp_ (accessfield, accessexp);
+ ffeste_f2c_exp_ (formfield, formexp);
+ ffeste_f2c_exp_ (reclfield, reclexp);
+ ffeste_f2c_exp_ (blankfield, blankexp);
+
+ ttype = build_pointer_type (TREE_TYPE (t));
+ t = ffecom_1 (ADDR_EXPR, ttype, t);
+
+ t = build_tree_list (NULL_TREE, t);
+
+ return t;
+}
+
+#endif
+/* ffeste_subr_file_ -- Display file-statement specifier
+
+ ffeste_subr_file_(&specifier); */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+static void
+ffeste_subr_file_ (char *kw, ffestpFile *spec)
+{
+ if (!spec->kw_or_val_present)
+ return;
+ fputs (kw, dmpout);
+ if (spec->value_present)
+ {
+ fputc ('=', dmpout);
+ if (spec->value_is_label)
+ {
+ assert (spec->value_is_label == 2); /* Temporary checking only. */
+ fprintf (dmpout, "%" ffelabValue_f "u",
+ ffelab_value (spec->u.label));
+ }
+ else
+ ffebld_dump (spec->u.expr);
+ }
+ fputc (',', dmpout);
+}
+#endif
+
+/* ffeste_subr_beru_ -- Generate code for BACKSPACE/ENDFILE/REWIND
+
+ ffeste_subr_beru_(FFECOM_gfrtFBACK); */
+
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+static void
+ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
+{
+ tree alist;
+ bool iostat;
+ bool errl;
+
+#define specified(something) (info->beru_spec[something].kw_or_val_present)
+
+ ffeste_emit_line_note_ ();
+
+ /* Do the real work. */
+
+ iostat = specified (FFESTP_beruixIOSTAT);
+ errl = specified (FFESTP_beruixERR);
+
+ /* ~~For now, we assume the unit number is specified and is not ASTERISK,
+ because the FFE doesn't support BACKSPACE(*) and rejects a BACKSPACE
+ without any unit specifier. f2c, however, supports the former
+ construct. When it is time to add this feature to the FFE, which
+ probably is fairly easy, ffestc_R919 and company will want to pass an
+ ffestvUnit indicator of FFESTV_unitINTEXPR or _unitASTERISK to
+ ffeste_R919 and company, and they will want to pass that same value to
+ this function, and that argument will replace the constant _unitINTEXPR_
+ in the call below. Right now, the default unit number, 6, is ignored. */
+
+ ffecom_push_calltemps ();
+
+ alist = ffeste_io_ialist_ (errl || iostat, FFESTV_unitINTEXPR,
+ info->beru_spec[FFESTP_beruixUNIT].u.expr, 6);
+
+ if (errl)
+ { /* ERR= */
+ ffeste_io_err_
+ = ffeste_io_abort_
+ = ffecom_lookup_label
+ (info->beru_spec[FFESTP_beruixERR].u.label);
+ ffeste_io_abort_is_temp_ = FALSE;
+ }
+ else
+ { /* no ERR= */
+ ffeste_io_err_ = NULL_TREE;
+
+ if ((ffeste_io_abort_is_temp_ = iostat))
+ ffeste_io_abort_ = ffecom_temp_label ();
+ else
+ ffeste_io_abort_ = NULL_TREE;
+ }
+
+ if (iostat)
+ { /* IOSTAT= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = ffecom_expr
+ (info->beru_spec[FFESTP_beruixIOSTAT].u.expr);
+ }
+ else if (ffeste_io_abort_ != NULL_TREE)
+ { /* no IOSTAT= but ERR= */
+ ffeste_io_iostat_is_temp_ = TRUE;
+ ffeste_io_iostat_
+ = ffecom_push_tempvar (ffecom_integer_type_node,
+ FFETARGET_charactersizeNONE, -1, FALSE);
+ }
+ else
+ { /* no IOSTAT=, or ERR= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = NULL_TREE;
+ }
+
+ /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ ffeste_io_call_ (ffecom_call_gfrt (rt, alist),
+ !ffeste_io_abort_is_temp_);
+
+ /* If we've got a temp label, generate its code here. */
+
+ if (ffeste_io_abort_is_temp_)
+ {
+ DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+ emit_nop ();
+ expand_label (ffeste_io_abort_);
+
+ assert (ffeste_io_err_ == NULL_TREE);
+ }
+
+ /* If we've got a temp iostat, pop the temp. */
+
+ if (ffeste_io_iostat_is_temp_)
+ ffecom_pop_tempvar (ffeste_io_iostat_);
+
+ ffecom_pop_calltemps ();
+
+#undef specified
+
+ clear_momentary ();
+}
+
+#endif
+/* ffeste_do -- End of statement following DO-term-stmt etc
+
+ ffeste_do(TRUE);
+
+ Also invoked by _labeldef_branch_finish_ (or, in cases
+ of errors, other _labeldef_ functions) when the label definition is
+ for a DO-target (LOOPEND) label, once per matching/outstanding DO
+ block on the stack. These cases invoke this function with ok==TRUE, so
+ only forced stack popping (via ffeste_eof_()) invokes it with ok==FALSE. */
+
+void
+ffeste_do (ffestw block)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ END_DO\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ if (ffestw_do_tvar (block) == 0)
+ expand_end_loop (); /* DO WHILE and just DO. */
+ else
+ ffeste_end_iterdo_ (ffestw_do_tvar (block),
+ ffestw_do_incr_saved (block),
+ ffestw_do_count_var (block));
+
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_end_R807 -- End of statement following logical IF
+
+ ffeste_end_R807(TRUE);
+
+ Applies ONLY to logical IF, not to IF-THEN. For example, does not
+ ffelex_token_kill the construct name for an IF-THEN block (the name
+ field is invalid for logical IF). ok==TRUE iff statement following
+ logical IF (substatement) is valid; else, statement is invalid or
+ stack forcibly popped due to ffeste_eof_(). */
+
+void
+ffeste_end_R807 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ END_IF\n", dmpout); /* Also see ffeste_R806. */
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ expand_end_cond ();
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_labeldef_branch -- Generate "code" for branch label def
+
+ ffeste_labeldef_branch(label); */
+
+void
+ffeste_labeldef_branch (ffelab label)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "+ label %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree glabel;
+
+ glabel = ffecom_lookup_label (label);
+ assert (glabel != NULL_TREE);
+ if (TREE_CODE (glabel) == ERROR_MARK)
+ return;
+ assert (DECL_INITIAL (glabel) == NULL_TREE);
+ DECL_INITIAL (glabel) = error_mark_node;
+ DECL_SOURCE_FILE (glabel) = ffelab_definition_filename (label);
+ DECL_SOURCE_LINE (glabel) = ffelab_definition_filelinenum (label);
+ emit_nop ();
+ expand_label (glabel);
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_labeldef_format -- Generate "code" for FORMAT label def
+
+ ffeste_labeldef_format(label); */
+
+void
+ffeste_labeldef_format (ffelab label)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "$ label %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_label_formatdef_ = label;
+#else
+#error
+#endif
+}
+
+/* ffeste_R737A -- Assignment statement outside of WHERE
+
+ ffeste_R737A(dest_expr,source_expr); */
+
+void
+ffeste_R737A (ffebld dest, ffebld source)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ let ", dmpout);
+ ffebld_dump (dest);
+ fputs ("=", dmpout);
+ ffebld_dump (source);
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ ffecom_expand_let_stmt (dest, source);
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R803 -- Block IF (IF-THEN) statement
+
+ ffeste_R803(construct_name,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffeste_R803 (ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ IF_block (", dmpout);
+ ffebld_dump (expr);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0);
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R804 -- ELSE IF statement
+
+ ffeste_R804(expr,expr_token,name_token);
+
+ Make sure ffeste_kind_ identifies an IF block. If not
+ NULL, make sure name_token gives the correct name. Implement the else
+ of the IF block. */
+
+void
+ffeste_R804 (ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ ELSE_IF (", dmpout);
+ ffebld_dump (expr);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ expand_start_elseif (ffecom_truth_value (ffecom_expr (expr)));
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R805 -- ELSE statement
+
+ ffeste_R805(name_token);
+
+ Make sure ffeste_kind_ identifies an IF block. If not
+ NULL, make sure name_token gives the correct name. Implement the ELSE
+ of the IF block. */
+
+void
+ffeste_R805 ()
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ ELSE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ expand_start_else ();
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R806 -- End an IF-THEN
+
+ ffeste_R806(TRUE); */
+
+void
+ffeste_R806 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ END_IF_then\n", dmpout); /* Also see ffeste_shriek_if_. */
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ expand_end_cond ();
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R807 -- Logical IF statement
+
+ ffeste_R807(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffeste_R807 (ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ IF_logical (", dmpout);
+ ffebld_dump (expr);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ expand_start_cond (ffecom_truth_value (ffecom_expr (expr)), 0);
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R809 -- SELECT CASE statement
+
+ ffeste_R809(construct_name,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffeste_R809 (ffestw block, ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ SELECT_CASE (", dmpout);
+ ffebld_dump (expr);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffecom_push_calltemps ();
+
+ {
+ tree texpr;
+
+ ffeste_emit_line_note_ ();
+
+ if ((expr == NULL)
+ || (ffeinfo_basictype (ffebld_info (expr))
+ == FFEINFO_basictypeANY))
+ {
+ ffestw_set_select_texpr (block, error_mark_node);
+ clear_momentary ();
+ }
+ else
+ {
+ texpr = ffecom_expr (expr);
+ if (ffeinfo_basictype (ffebld_info (expr))
+ != FFEINFO_basictypeCHARACTER)
+ {
+ expand_start_case (1, texpr, TREE_TYPE (texpr),
+ "SELECT CASE statement");
+ ffestw_set_select_texpr (block, texpr);
+ ffestw_set_select_break (block, FALSE);
+ push_momentary ();
+ }
+ else
+ {
+ ffebad_start_msg ("SELECT CASE on CHARACTER type (at %0) not supported -- sorry",
+ FFEBAD_severityFATAL);
+ ffebad_here (0, ffestw_line (block), ffestw_col (block));
+ ffebad_finish ();
+ ffestw_set_select_texpr (block, error_mark_node);
+ }
+ }
+ }
+
+ ffecom_pop_calltemps ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R810 -- CASE statement
+
+ ffeste_R810(case_value_range_list,name);
+
+ If casenum is 0, it's CASE DEFAULT. Else it's the case ranges at
+ the start of the first_stmt list in the select object at the top of
+ the stack that match casenum. */
+
+void
+ffeste_R810 (ffestw block, unsigned long casenum)
+{
+ ffestwSelect s = ffestw_select (block);
+ ffestwCase c;
+
+ ffeste_check_simple_ ();
+
+ if (s->first_stmt == (ffestwCase) &s->first_rel)
+ c = NULL;
+ else
+ c = s->first_stmt;
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if ((c == NULL) || (casenum != c->casenum))
+ {
+ if (casenum == 0) /* Intentional CASE DEFAULT. */
+ fputs ("+ CASE_DEFAULT", dmpout);
+ }
+ else
+ {
+ bool comma = FALSE;
+
+ fputs ("+ CASE (", dmpout);
+ do
+ {
+ if (comma)
+ fputc (',', dmpout);
+ else
+ comma = TRUE;
+ if (c->low != NULL)
+ ffebld_constant_dump (c->low);
+ if (c->low != c->high)
+ {
+ fputc (':', dmpout);
+ if (c->high != NULL)
+ ffebld_constant_dump (c->high);
+ }
+ c = c->next_stmt;
+ /* Unlink prev. */
+ c->previous_stmt->previous_stmt->next_stmt = c;
+ c->previous_stmt = c->previous_stmt->previous_stmt;
+ }
+ while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum));
+ fputc (')', dmpout);
+ }
+
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree texprlow;
+ tree texprhigh;
+ tree tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+ int pushok;
+ tree duplicate;
+
+ ffeste_emit_line_note_ ();
+
+ if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK)
+ {
+ clear_momentary ();
+ return;
+ }
+
+ if (ffestw_select_break (block))
+ expand_exit_something ();
+ else
+ ffestw_set_select_break (block, TRUE);
+
+ if ((c == NULL) || (casenum != c->casenum))
+ {
+ if (casenum == 0) /* Intentional CASE DEFAULT. */
+ {
+ pushok = pushcase (NULL_TREE, 0, tlabel, &duplicate);
+ assert (pushok == 0);
+ }
+ }
+ else
+ do
+ {
+ texprlow = (c->low == NULL) ? NULL_TREE
+ : ffecom_constantunion (&ffebld_constant_union (c->low), s->type,
+ s->kindtype, ffecom_tree_type[s->type][s->kindtype]);
+ if (c->low != c->high)
+ {
+ texprhigh = (c->high == NULL) ? NULL_TREE
+ : ffecom_constantunion (&ffebld_constant_union (c->high),
+ s->type, s->kindtype, ffecom_tree_type[s->type][s->kindtype]);
+ pushok = pushcase_range (texprlow, texprhigh, convert,
+ tlabel, &duplicate);
+ }
+ else
+ pushok = pushcase (texprlow, convert, tlabel, &duplicate);
+ assert (pushok == 0);
+ c = c->next_stmt;
+ /* Unlink prev. */
+ c->previous_stmt->previous_stmt->next_stmt = c;
+ c->previous_stmt = c->previous_stmt->previous_stmt;
+ }
+ while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum));
+
+ clear_momentary ();
+ } /* ~~~handle character, character*1 */
+#else
+#error
+#endif
+}
+
+/* ffeste_R811 -- End a SELECT
+
+ ffeste_R811(TRUE); */
+
+void
+ffeste_R811 (ffestw block)
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ END_SELECT\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+
+ if (TREE_CODE (ffestw_select_texpr (block)) == ERROR_MARK)
+ {
+ clear_momentary ();
+ return;
+ }
+
+ expand_end_case (ffestw_select_texpr (block));
+ pop_momentary ();
+ clear_momentary (); /* ~~~handle character and character*1 */
+#else
+#error
+#endif
+}
+
+/* Iterative DO statement. */
+
+void
+ffeste_R819A (ffestw block, ffelab label UNUSED, ffebld var,
+ ffebld start, ffelexToken start_token,
+ ffebld end, ffelexToken end_token,
+ ffebld incr, ffelexToken incr_token)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if ((ffebld_op (incr) == FFEBLD_opCONTER)
+ && (ffebld_constant_is_zero (ffebld_conter (incr))))
+ {
+ ffebad_start (FFEBAD_DO_STEP_ZERO);
+ ffebad_here (0, ffelex_token_where_line (incr_token),
+ ffelex_token_where_column (incr_token));
+ ffebad_string ("Iterative DO loop");
+ ffebad_finish ();
+ /* Don't bother replacing it with 1 yet. */
+ }
+
+ if (label == NULL)
+ fputs ("+ DO_iterative_nonlabeled (", dmpout);
+ else
+ fprintf (dmpout, "+ DO_iterative_labeled %lu (", ffelab_value (label));
+ ffebld_dump (var);
+ fputc ('=', dmpout);
+ ffebld_dump (start);
+ fputc (',', dmpout);
+ ffebld_dump (end);
+ fputc (',', dmpout);
+ ffebld_dump (incr);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ /* Start the DO loop. */
+
+ ffeste_begin_iterdo_ (block, NULL, NULL, NULL,
+ var,
+ start, start_token,
+ end, end_token,
+ incr, incr_token,
+ "Iterative DO loop");
+
+ ffecom_pop_calltemps ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R819B -- DO WHILE statement
+
+ ffeste_R819B(construct_name,label_token,expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (label == NULL)
+ fputs ("+ DO_WHILE_nonlabeled (", dmpout);
+ else
+ fprintf (dmpout, "+ DO_WHILE_labeled %lu (", ffelab_value (label));
+ ffebld_dump (expr);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ ffestw_set_do_hook (block, expand_start_loop (1));
+ ffestw_set_do_tvar (block, 0); /* Means DO WHILE vs. iter DO. */
+ if (expr != NULL)
+ expand_exit_loop_if_false (0, ffecom_truth_value (ffecom_expr (expr)));
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R825 -- END DO statement
+
+ ffeste_R825(name_token);
+
+ Make sure ffeste_kind_ identifies a DO block. If not
+ NULL, make sure name_token gives the correct name. Do whatever
+ is specific to seeing END DO with a DO-target label definition on it,
+ where the END DO is really treated as a CONTINUE (i.e. generate th
+ same code you would for CONTINUE). ffeste_do handles the actual
+ generation of end-loop code. */
+
+void
+ffeste_R825 ()
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ END_DO_sugar\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ emit_nop ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R834 -- CYCLE statement
+
+ ffeste_R834(name_token);
+
+ Handle a CYCLE within a loop. */
+
+void
+ffeste_R834 (ffestw block)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "+ CYCLE block #%lu\n", ffestw_blocknum (block));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ expand_continue_loop (ffestw_do_hook (block));
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R835 -- EXIT statement
+
+ ffeste_R835(name_token);
+
+ Handle a EXIT within a loop. */
+
+void
+ffeste_R835 (ffestw block)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "+ EXIT block #%lu\n", ffestw_blocknum (block));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ expand_exit_loop (ffestw_do_hook (block));
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R836 -- GOTO statement
+
+ ffeste_R836(label);
+
+ Make sure label_token identifies a valid label for a GOTO. Update
+ that label's info to indicate it is the target of a GOTO. */
+
+void
+ffeste_R836 (ffelab label)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "+ GOTO %lu\n", ffelab_value (label));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree glabel;
+
+ ffeste_emit_line_note_ ();
+ glabel = ffecom_lookup_label (label);
+ if ((glabel != NULL_TREE)
+ && (TREE_CODE (glabel) != ERROR_MARK))
+ {
+ TREE_USED (glabel) = 1;
+ expand_goto (glabel);
+ clear_momentary ();
+ }
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R837 -- Computed GOTO statement
+
+ ffeste_R837(labels,count,expr);
+
+ Make sure label_list identifies valid labels for a GOTO. Update
+ each label's info to indicate it is the target of a GOTO. */
+
+void
+ffeste_R837 (ffelab *labels, int count, ffebld expr)
+{
+ int i;
+
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ CGOTO (", dmpout);
+ for (i = 0; i < count; ++i)
+ {
+ if (i != 0)
+ fputc (',', dmpout);
+ fprintf (dmpout, "%" ffelabValue_f "u", ffelab_value (labels[i]));
+ }
+ fputs ("),", dmpout);
+ ffebld_dump (expr);
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree texpr;
+ tree value;
+ tree tlabel;
+ int pushok;
+ tree duplicate;
+
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ texpr = ffecom_expr (expr);
+ expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement");
+ push_momentary (); /* In case of lots of labels, keep clearing
+ them out. */
+ for (i = 0; i < count; ++i)
+ {
+ value = build_int_2 (i + 1, 0);
+ tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+
+ pushok = pushcase (value, convert, tlabel, &duplicate);
+ assert (pushok == 0);
+ tlabel = ffecom_lookup_label (labels[i]);
+ if ((tlabel == NULL_TREE)
+ || (TREE_CODE (tlabel) == ERROR_MARK))
+ continue;
+ TREE_USED (tlabel) = 1;
+ expand_goto (tlabel);
+ clear_momentary ();
+ }
+ pop_momentary ();
+ expand_end_case (texpr);
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R838 -- ASSIGN statement
+
+ ffeste_R838(label_token,target_variable,target_token);
+
+ Make sure label_token identifies a valid label for an assignment. Update
+ that label's info to indicate it is the source of an assignment. Update
+ target_variable's info to indicate it is the target the assignment of that
+ label. */
+
+void
+ffeste_R838 (ffelab label, ffebld target)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "+ ASSIGN %lu TO ", ffelab_value (label));
+ ffebld_dump (target);
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree expr_tree;
+ tree label_tree;
+ tree target_tree;
+
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ label_tree = ffecom_lookup_label (label);
+ if ((label_tree != NULL_TREE)
+ && (TREE_CODE (label_tree) != ERROR_MARK))
+ {
+ label_tree = ffecom_1 (ADDR_EXPR,
+ build_pointer_type (void_type_node),
+ label_tree);
+ TREE_CONSTANT (label_tree) = 1;
+ target_tree = ffecom_expr_assign_w (target);
+ if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree)))
+ < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree))))
+ error ("ASSIGN to variable that is too small");
+ label_tree = convert (TREE_TYPE (target_tree), label_tree);
+ expr_tree = ffecom_modify (void_type_node,
+ target_tree,
+ label_tree);
+ expand_expr_stmt (expr_tree);
+ clear_momentary ();
+ }
+
+ ffecom_pop_calltemps ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R839 -- Assigned GOTO statement
+
+ ffeste_R839(target,target_token,label_list);
+
+ Make sure label_list identifies valid labels for a GOTO. Update
+ each label's info to indicate it is the target of a GOTO. */
+
+void
+ffeste_R839 (ffebld target)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ AGOTO ", dmpout);
+ ffebld_dump (target);
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree t;
+
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ t = ffecom_expr_assign (target);
+ if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
+ < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+ error ("ASSIGNed GOTO target variable is too small");
+ expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t));
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R840 -- Arithmetic IF statement
+
+ ffeste_R840(expr,expr_token,neg,zero,pos);
+
+ Make sure the labels are valid; implement. */
+
+void
+ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ IF_arithmetic (", dmpout);
+ ffebld_dump (expr);
+ fprintf (dmpout, ") %" ffelabValue_f "u,%" ffelabValue_f "u,%" ffelabValue_f "u\n",
+ ffelab_value (neg), ffelab_value (zero), ffelab_value (pos));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree gneg = ffecom_lookup_label (neg);
+ tree gzero = ffecom_lookup_label (zero);
+ tree gpos = ffecom_lookup_label (pos);
+ tree texpr;
+
+ if ((gneg == NULL_TREE) || (gzero == NULL_TREE) || (gpos == NULL_TREE))
+ return;
+ if ((TREE_CODE (gneg) == ERROR_MARK)
+ || (TREE_CODE (gzero) == ERROR_MARK)
+ || (TREE_CODE (gpos) == ERROR_MARK))
+ return;
+
+ ffecom_push_calltemps ();
+
+ if (neg == zero)
+ if (neg == pos)
+ expand_goto (gzero);
+ else
+ { /* IF (expr.LE.0) THEN GOTO neg/zero ELSE
+ GOTO pos. */
+ texpr = ffecom_expr (expr);
+ texpr = ffecom_2 (LE_EXPR, integer_type_node,
+ texpr,
+ convert (TREE_TYPE (texpr),
+ integer_zero_node));
+ expand_start_cond (ffecom_truth_value (texpr), 0);
+ expand_goto (gzero);
+ expand_start_else ();
+ expand_goto (gpos);
+ expand_end_cond ();
+ }
+ else if (neg == pos)
+ { /* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO
+ zero. */
+ texpr = ffecom_expr (expr);
+ texpr = ffecom_2 (NE_EXPR, integer_type_node,
+ texpr,
+ convert (TREE_TYPE (texpr),
+ integer_zero_node));
+ expand_start_cond (ffecom_truth_value (texpr), 0);
+ expand_goto (gneg);
+ expand_start_else ();
+ expand_goto (gzero);
+ expand_end_cond ();
+ }
+ else if (zero == pos)
+ { /* IF (expr.GE.0) THEN GOTO zero/pos ELSE
+ GOTO neg. */
+ texpr = ffecom_expr (expr);
+ texpr = ffecom_2 (GE_EXPR, integer_type_node,
+ texpr,
+ convert (TREE_TYPE (texpr),
+ integer_zero_node));
+ expand_start_cond (ffecom_truth_value (texpr), 0);
+ expand_goto (gzero);
+ expand_start_else ();
+ expand_goto (gneg);
+ expand_end_cond ();
+ }
+ else
+ { /* Use a SAVE_EXPR in combo with:
+ IF (expr.LT.0) THEN GOTO neg
+ ELSEIF (expr.GT.0) THEN GOTO pos
+ ELSE GOTO zero. */
+ tree expr_saved = ffecom_save_tree (ffecom_expr (expr));
+
+ texpr = ffecom_2 (LT_EXPR, integer_type_node,
+ expr_saved,
+ convert (TREE_TYPE (expr_saved),
+ integer_zero_node));
+ expand_start_cond (ffecom_truth_value (texpr), 0);
+ expand_goto (gneg);
+ texpr = ffecom_2 (GT_EXPR, integer_type_node,
+ expr_saved,
+ convert (TREE_TYPE (expr_saved),
+ integer_zero_node));
+ expand_start_elseif (ffecom_truth_value (texpr));
+ expand_goto (gpos);
+ expand_start_else ();
+ expand_goto (gzero);
+ expand_end_cond ();
+ }
+ ffeste_emit_line_note_ ();
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R841 -- CONTINUE statement
+
+ ffeste_R841(); */
+
+void
+ffeste_R841 ()
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ CONTINUE\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_emit_line_note_ ();
+ emit_nop ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R842 -- STOP statement
+
+ ffeste_R842(expr); */
+
+void
+ffeste_R842 (ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (expr == NULL)
+ {
+ fputs ("+ STOP\n", dmpout);
+ }
+ else
+ {
+ fputs ("+ STOP_coded ", dmpout);
+ ffebld_dump (expr);
+ fputc ('\n', dmpout);
+ }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree callit;
+ ffelexToken msg;
+
+ ffeste_emit_line_note_ ();
+ if ((expr == NULL)
+ || (ffeinfo_basictype (ffebld_info (expr))
+ == FFEINFO_basictypeANY))
+ {
+ msg = ffelex_token_new_character ("", ffelex_token_where_line
+ (ffesta_tokens[0]), ffelex_token_where_column
+ (ffesta_tokens[0]));
+ expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+ (msg));
+ ffelex_token_kill (msg);
+ ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT, 0));
+ }
+ else if (ffeinfo_basictype (ffebld_info (expr))
+ == FFEINFO_basictypeINTEGER)
+ {
+ char num[50];
+
+ assert (ffebld_op (expr) == FFEBLD_opCONTER);
+ assert (ffeinfo_kindtype (ffebld_info (expr))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ sprintf (num, "%" ffetargetIntegerDefault_f "d",
+ ffebld_constant_integer1 (ffebld_conter (expr)));
+ msg = ffelex_token_new_character (num, ffelex_token_where_line
+ (ffesta_tokens[0]), ffelex_token_where_column
+ (ffesta_tokens[0]));
+ expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+ (msg));
+ ffelex_token_kill (msg);
+ ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT, 0));
+ }
+ else
+ {
+ assert (ffeinfo_basictype (ffebld_info (expr))
+ == FFEINFO_basictypeCHARACTER);
+ assert (ffebld_op (expr) == FFEBLD_opCONTER);
+ assert (ffeinfo_kindtype (ffebld_info (expr))
+ == FFEINFO_kindtypeCHARACTERDEFAULT);
+ }
+
+ ffecom_push_calltemps ();
+ callit = ffecom_call_gfrt (FFECOM_gfrtSTOP,
+ ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+ ffecom_pop_calltemps ();
+ TREE_SIDE_EFFECTS (callit) = 1;
+ expand_expr_stmt (callit);
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R843 -- PAUSE statement
+
+ ffeste_R843(expr,expr_token);
+
+ Make sure statement is valid here; implement. expr and expr_token are
+ both NULL if there was no expression. */
+
+void
+ffeste_R843 (ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (expr == NULL)
+ {
+ fputs ("+ PAUSE\n", dmpout);
+ }
+ else
+ {
+ fputs ("+ PAUSE_coded ", dmpout);
+ ffebld_dump (expr);
+ fputc ('\n', dmpout);
+ }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree callit;
+ ffelexToken msg;
+
+ ffeste_emit_line_note_ ();
+ if ((expr == NULL)
+ || (ffeinfo_basictype (ffebld_info (expr))
+ == FFEINFO_basictypeANY))
+ {
+ msg = ffelex_token_new_character ("", ffelex_token_where_line
+ (ffesta_tokens[0]), ffelex_token_where_column
+ (ffesta_tokens[0]));
+ expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+ (msg));
+ ffelex_token_kill (msg);
+ ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT, 0));
+ }
+ else if (ffeinfo_basictype (ffebld_info (expr))
+ == FFEINFO_basictypeINTEGER)
+ {
+ char num[50];
+
+ assert (ffebld_op (expr) == FFEBLD_opCONTER);
+ assert (ffeinfo_kindtype (ffebld_info (expr))
+ == FFEINFO_kindtypeINTEGERDEFAULT);
+ sprintf (num, "%" ffetargetIntegerDefault_f "d",
+ ffebld_constant_integer1 (ffebld_conter (expr)));
+ msg = ffelex_token_new_character (num, ffelex_token_where_line
+ (ffesta_tokens[0]), ffelex_token_where_column
+ (ffesta_tokens[0]));
+ expr = ffebld_new_conter (ffebld_constant_new_characterdefault
+ (msg));
+ ffelex_token_kill (msg);
+ ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
+ FFEINFO_kindtypeCHARACTERDEFAULT, 0, FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT, 0));
+ }
+ else
+ {
+ assert (ffeinfo_basictype (ffebld_info (expr))
+ == FFEINFO_basictypeCHARACTER);
+ assert (ffebld_op (expr) == FFEBLD_opCONTER);
+ assert (ffeinfo_kindtype (ffebld_info (expr))
+ == FFEINFO_kindtypeCHARACTERDEFAULT);
+ }
+
+ ffecom_push_calltemps ();
+ callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE,
+ ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+ ffecom_pop_calltemps ();
+ TREE_SIDE_EFFECTS (callit) = 1;
+ expand_expr_stmt (callit);
+ clear_momentary ();
+ }
+#if 0 /* Old approach for phantom g77 run-time
+ library. */
+ {
+ tree callit;
+
+ ffeste_emit_line_note_ ();
+ if (expr == NULL)
+ callit = ffecom_call_gfrt (FFECOM_gfrtPAUSENIL, NULL_TREE);
+ else if (ffeinfo_basictype (ffebld_info (expr))
+ == FFEINFO_basictypeINTEGER)
+ {
+ ffecom_push_calltemps ();
+ callit = ffecom_call_gfrt (FFECOM_gfrtPAUSEINT,
+ ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+ ffecom_pop_calltemps ();
+ }
+ else
+ {
+ if (ffeinfo_basictype (ffebld_info (expr))
+ != FFEINFO_basictypeCHARACTER)
+ break;
+ ffecom_push_calltemps ();
+ callit = ffecom_call_gfrt (FFECOM_gfrtPAUSECHAR,
+ ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)));
+ ffecom_pop_calltemps ();
+ }
+ TREE_SIDE_EFFECTS (callit) = 1;
+ expand_expr_stmt (callit);
+ clear_momentary ();
+ }
+#endif
+#else
+#error
+#endif
+}
+
+/* ffeste_R904 -- OPEN statement
+
+ ffeste_R904();
+
+ Make sure an OPEN is valid in the current context, and implement it. */
+
+void
+ffeste_R904 (ffestpOpenStmt *info)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ OPEN (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->open_spec[FFESTP_openixUNIT]);
+ ffeste_subr_file_ ("ACCESS", &info->open_spec[FFESTP_openixACCESS]);
+ ffeste_subr_file_ ("ACTION", &info->open_spec[FFESTP_openixACTION]);
+ ffeste_subr_file_ ("ASSOCIATEVARIABLE", &info->open_spec[FFESTP_openixASSOCIATEVARIABLE]);
+ ffeste_subr_file_ ("BLANK", &info->open_spec[FFESTP_openixBLANK]);
+ ffeste_subr_file_ ("BLOCKSIZE", &info->open_spec[FFESTP_openixBLOCKSIZE]);
+ ffeste_subr_file_ ("BUFFERCOUNT", &info->open_spec[FFESTP_openixBUFFERCOUNT]);
+ ffeste_subr_file_ ("CARRIAGECONTROL", &info->open_spec[FFESTP_openixCARRIAGECONTROL]);
+ ffeste_subr_file_ ("DEFAULTFILE", &info->open_spec[FFESTP_openixDEFAULTFILE]);
+ ffeste_subr_file_ ("DELIM", &info->open_spec[FFESTP_openixDELIM]);
+ ffeste_subr_file_ ("DISPOSE", &info->open_spec[FFESTP_openixDISPOSE]);
+ ffeste_subr_file_ ("ERR", &info->open_spec[FFESTP_openixERR]);
+ ffeste_subr_file_ ("EXTENDSIZE", &info->open_spec[FFESTP_openixEXTENDSIZE]);
+ ffeste_subr_file_ ("FILE", &info->open_spec[FFESTP_openixFILE]);
+ ffeste_subr_file_ ("FORM", &info->open_spec[FFESTP_openixFORM]);
+ ffeste_subr_file_ ("INITIALSIZE", &info->open_spec[FFESTP_openixINITIALSIZE]);
+ ffeste_subr_file_ ("IOSTAT", &info->open_spec[FFESTP_openixIOSTAT]);
+ ffeste_subr_file_ ("KEY", &info->open_spec[FFESTP_openixKEY]);
+ ffeste_subr_file_ ("MAXREC", &info->open_spec[FFESTP_openixMAXREC]);
+ ffeste_subr_file_ ("NOSPANBLOCKS", &info->open_spec[FFESTP_openixNOSPANBLOCKS]);
+ ffeste_subr_file_ ("ORGANIZATION", &info->open_spec[FFESTP_openixORGANIZATION]);
+ ffeste_subr_file_ ("PAD", &info->open_spec[FFESTP_openixPAD]);
+ ffeste_subr_file_ ("POSITION", &info->open_spec[FFESTP_openixPOSITION]);
+ ffeste_subr_file_ ("READONLY", &info->open_spec[FFESTP_openixREADONLY]);
+ ffeste_subr_file_ ("RECL", &info->open_spec[FFESTP_openixRECL]);
+ ffeste_subr_file_ ("RECORDTYPE", &info->open_spec[FFESTP_openixRECORDTYPE]);
+ ffeste_subr_file_ ("SHARED", &info->open_spec[FFESTP_openixSHARED]);
+ ffeste_subr_file_ ("STATUS", &info->open_spec[FFESTP_openixSTATUS]);
+ ffeste_subr_file_ ("USEROPEN", &info->open_spec[FFESTP_openixUSEROPEN]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree args;
+ bool iostat;
+ bool errl;
+
+#define specified(something) (info->open_spec[something].kw_or_val_present)
+
+ ffeste_emit_line_note_ ();
+
+ iostat = specified (FFESTP_openixIOSTAT);
+ errl = specified (FFESTP_openixERR);
+
+ ffecom_push_calltemps ();
+
+ args = ffeste_io_olist_ (errl || iostat,
+ info->open_spec[FFESTP_openixUNIT].u.expr,
+ &info->open_spec[FFESTP_openixFILE],
+ &info->open_spec[FFESTP_openixSTATUS],
+ &info->open_spec[FFESTP_openixACCESS],
+ &info->open_spec[FFESTP_openixFORM],
+ &info->open_spec[FFESTP_openixRECL],
+ &info->open_spec[FFESTP_openixBLANK]);
+
+ if (errl)
+ {
+ ffeste_io_err_
+ = ffeste_io_abort_
+ = ffecom_lookup_label
+ (info->open_spec[FFESTP_openixERR].u.label);
+ ffeste_io_abort_is_temp_ = FALSE;
+ }
+ else
+ {
+ ffeste_io_err_ = NULL_TREE;
+
+ if ((ffeste_io_abort_is_temp_ = iostat))
+ ffeste_io_abort_ = ffecom_temp_label ();
+ else
+ ffeste_io_abort_ = NULL_TREE;
+ }
+
+ if (iostat)
+ { /* IOSTAT= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = ffecom_expr
+ (info->open_spec[FFESTP_openixIOSTAT].u.expr);
+ }
+ else if (ffeste_io_abort_ != NULL_TREE)
+ { /* no IOSTAT= but ERR= */
+ ffeste_io_iostat_is_temp_ = TRUE;
+ ffeste_io_iostat_
+ = ffecom_push_tempvar (ffecom_integer_type_node,
+ FFETARGET_charactersizeNONE, -1, FALSE);
+ }
+ else
+ { /* no IOSTAT=, or ERR= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = NULL_TREE;
+ }
+
+ /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args),
+ !ffeste_io_abort_is_temp_);
+
+ /* If we've got a temp label, generate its code here. */
+
+ if (ffeste_io_abort_is_temp_)
+ {
+ DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+ emit_nop ();
+ expand_label (ffeste_io_abort_);
+
+ assert (ffeste_io_err_ == NULL_TREE);
+ }
+
+ /* If we've got a temp iostat, pop the temp. */
+
+ if (ffeste_io_iostat_is_temp_)
+ ffecom_pop_tempvar (ffeste_io_iostat_);
+
+ ffecom_pop_calltemps ();
+
+#undef specified
+ }
+
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R907 -- CLOSE statement
+
+ ffeste_R907();
+
+ Make sure a CLOSE is valid in the current context, and implement it. */
+
+void
+ffeste_R907 (ffestpCloseStmt *info)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ CLOSE (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->close_spec[FFESTP_closeixUNIT]);
+ ffeste_subr_file_ ("ERR", &info->close_spec[FFESTP_closeixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->close_spec[FFESTP_closeixIOSTAT]);
+ ffeste_subr_file_ ("STATUS", &info->close_spec[FFESTP_closeixSTATUS]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree args;
+ bool iostat;
+ bool errl;
+
+#define specified(something) (info->close_spec[something].kw_or_val_present)
+
+ ffeste_emit_line_note_ ();
+
+ iostat = specified (FFESTP_closeixIOSTAT);
+ errl = specified (FFESTP_closeixERR);
+
+ ffecom_push_calltemps ();
+
+ args = ffeste_io_cllist_ (errl || iostat,
+ info->close_spec[FFESTP_closeixUNIT].u.expr,
+ &info->close_spec[FFESTP_closeixSTATUS]);
+
+ if (errl)
+ {
+ ffeste_io_err_
+ = ffeste_io_abort_
+ = ffecom_lookup_label
+ (info->close_spec[FFESTP_closeixERR].u.label);
+ ffeste_io_abort_is_temp_ = FALSE;
+ }
+ else
+ {
+ ffeste_io_err_ = NULL_TREE;
+
+ if ((ffeste_io_abort_is_temp_ = iostat))
+ ffeste_io_abort_ = ffecom_temp_label ();
+ else
+ ffeste_io_abort_ = NULL_TREE;
+ }
+
+ if (iostat)
+ { /* IOSTAT= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = ffecom_expr
+ (info->close_spec[FFESTP_closeixIOSTAT].u.expr);
+ }
+ else if (ffeste_io_abort_ != NULL_TREE)
+ { /* no IOSTAT= but ERR= */
+ ffeste_io_iostat_is_temp_ = TRUE;
+ ffeste_io_iostat_
+ = ffecom_push_tempvar (ffecom_integer_type_node,
+ FFETARGET_charactersizeNONE, -1, FALSE);
+ }
+ else
+ { /* no IOSTAT=, or ERR= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = NULL_TREE;
+ }
+
+ /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args),
+ !ffeste_io_abort_is_temp_);
+
+ /* If we've got a temp label, generate its code here. */
+
+ if (ffeste_io_abort_is_temp_)
+ {
+ DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+ emit_nop ();
+ expand_label (ffeste_io_abort_);
+
+ assert (ffeste_io_err_ == NULL_TREE);
+ }
+
+ /* If we've got a temp iostat, pop the temp. */
+
+ if (ffeste_io_iostat_is_temp_)
+ ffecom_pop_tempvar (ffeste_io_iostat_);
+
+ ffecom_pop_calltemps ();
+
+#undef specified
+ }
+
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_start -- READ(...) statement list begin
+
+ ffeste_R909_start(FALSE);
+
+ Verify that READ is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
+ ffestvUnit unit, ffestvFormat format, bool rec,
+ bool key UNUSED)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ switch (format)
+ {
+ case FFESTV_formatNONE:
+ if (rec)
+ fputs ("+ READ_ufdac", dmpout);
+ else if (key)
+ fputs ("+ READ_ufidx", dmpout);
+ else
+ fputs ("+ READ_ufseq", dmpout);
+ break;
+
+ case FFESTV_formatLABEL:
+ case FFESTV_formatCHAREXPR:
+ case FFESTV_formatINTEXPR:
+ if (rec)
+ fputs ("+ READ_fmdac", dmpout);
+ else if (key)
+ fputs ("+ READ_fmidx", dmpout);
+ else if (unit == FFESTV_unitCHAREXPR)
+ fputs ("+ READ_fmint", dmpout);
+ else
+ fputs ("+ READ_fmseq", dmpout);
+ break;
+
+ case FFESTV_formatASTERISK:
+ if (unit == FFESTV_unitCHAREXPR)
+ fputs ("+ READ_lsint", dmpout);
+ else
+ fputs ("+ READ_lsseq", dmpout);
+ break;
+
+ case FFESTV_formatNAMELIST:
+ fputs ("+ READ_nlseq", dmpout);
+ break;
+
+ default:
+ assert ("Unexpected kind of format item in R909 READ" == NULL);
+ }
+
+ if (only_format)
+ {
+ fputc (' ', dmpout);
+ ffeste_subr_file_ ("FORMAT", &info->read_spec[FFESTP_readixFORMAT]);
+ fputc (' ', dmpout);
+
+ return;
+ }
+
+ fputs (" (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->read_spec[FFESTP_readixUNIT]);
+ ffeste_subr_file_ ("FORMAT", &info->read_spec[FFESTP_readixFORMAT]);
+ ffeste_subr_file_ ("ADVANCE", &info->read_spec[FFESTP_readixADVANCE]);
+ ffeste_subr_file_ ("EOR", &info->read_spec[FFESTP_readixEOR]);
+ ffeste_subr_file_ ("ERR", &info->read_spec[FFESTP_readixERR]);
+ ffeste_subr_file_ ("END", &info->read_spec[FFESTP_readixEND]);
+ ffeste_subr_file_ ("IOSTAT", &info->read_spec[FFESTP_readixIOSTAT]);
+ ffeste_subr_file_ ("KEYEQ", &info->read_spec[FFESTP_readixKEYEQ]);
+ ffeste_subr_file_ ("KEYGE", &info->read_spec[FFESTP_readixKEYGE]);
+ ffeste_subr_file_ ("KEYGT", &info->read_spec[FFESTP_readixKEYGT]);
+ ffeste_subr_file_ ("KEYID", &info->read_spec[FFESTP_readixKEYID]);
+ ffeste_subr_file_ ("NULLS", &info->read_spec[FFESTP_readixNULLS]);
+ ffeste_subr_file_ ("REC", &info->read_spec[FFESTP_readixREC]);
+ ffeste_subr_file_ ("SIZE", &info->read_spec[FFESTP_readixSIZE]);
+ fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+#define specified(something) (info->read_spec[something].kw_or_val_present)
+
+ ffeste_emit_line_note_ ();
+
+ /* Do the real work. */
+
+ {
+ ffecomGfrt start;
+ ffecomGfrt end;
+ tree cilist;
+ bool iostat;
+ bool errl;
+ bool endl;
+
+ /* First determine the start, per-item, and end run-time functions to
+ call. The per-item function is picked by choosing an ffeste functio
+ to call to handle a given item; it knows how to generate a call to the
+ appropriate run-time function, and is called an "io driver". It
+ handles the implied-DO construct, for example. */
+
+ switch (format)
+ {
+ case FFESTV_formatNONE: /* no FMT= */
+ ffeste_io_driver_ = ffeste_io_douio_;
+ if (rec)
+ start = FFECOM_gfrtSRDUE, end = FFECOM_gfrtERDUE;
+#if 0
+ else if (key)
+ start = FFECOM_gfrtSRIUE, end = FFECOM_gfrtERIUE;
+#endif
+ else
+ start = FFECOM_gfrtSRSUE, end = FFECOM_gfrtERSUE;
+ break;
+
+ case FFESTV_formatLABEL: /* FMT=10 */
+ case FFESTV_formatCHAREXPR: /* FMT='(I10)' */
+ case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */
+ ffeste_io_driver_ = ffeste_io_dofio_;
+ if (rec)
+ start = FFECOM_gfrtSRDFE, end = FFECOM_gfrtERDFE;
+#if 0
+ else if (key)
+ start = FFECOM_gfrtSRIFE, end = FFECOM_gfrtERIFE;
+#endif
+ else if (unit == FFESTV_unitCHAREXPR)
+ start = FFECOM_gfrtSRSFI, end = FFECOM_gfrtERSFI;
+ else
+ start = FFECOM_gfrtSRSFE, end = FFECOM_gfrtERSFE;
+ break;
+
+ case FFESTV_formatASTERISK: /* FMT=* */
+ ffeste_io_driver_ = ffeste_io_dolio_;
+ if (unit == FFESTV_unitCHAREXPR)
+ start = FFECOM_gfrtSRSLI, end = FFECOM_gfrtERSLI;
+ else
+ start = FFECOM_gfrtSRSLE, end = FFECOM_gfrtERSLE;
+ break;
+
+ case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST
+ /FOO/] */
+ ffeste_io_driver_ = NULL; /* No start or driver function. */
+ start = FFECOM_gfrtSRSNE, end = FFECOM_gfrt;
+ break;
+
+ default:
+ assert ("Weird stuff" == NULL);
+ start = FFECOM_gfrt, end = FFECOM_gfrt;
+ break;
+ }
+ ffeste_io_endgfrt_ = end;
+
+ iostat = specified (FFESTP_readixIOSTAT);
+ errl = specified (FFESTP_readixERR);
+ endl = specified (FFESTP_readixEND);
+
+ ffecom_push_calltemps ();
+
+ if (unit == FFESTV_unitCHAREXPR)
+ {
+ cilist = ffeste_io_icilist_ (errl || iostat,
+ info->read_spec[FFESTP_readixUNIT].u.expr,
+ endl || iostat, format,
+ &info->read_spec[FFESTP_readixFORMAT]);
+ }
+ else
+ {
+ cilist = ffeste_io_cilist_ (errl || iostat, unit,
+ info->read_spec[FFESTP_readixUNIT].u.expr,
+ 5, endl || iostat, format,
+ &info->read_spec[FFESTP_readixFORMAT],
+ rec,
+ info->read_spec[FFESTP_readixREC].u.expr);
+ }
+
+ if (errl)
+ { /* ERR= */
+ ffeste_io_err_
+ = ffecom_lookup_label
+ (info->read_spec[FFESTP_readixERR].u.label);
+
+ if (endl)
+ { /* ERR= END= */
+ ffeste_io_end_
+ = ffecom_lookup_label
+ (info->read_spec[FFESTP_readixEND].u.label);
+ ffeste_io_abort_is_temp_ = TRUE;
+ ffeste_io_abort_ = ffecom_temp_label ();
+ }
+ else
+ { /* ERR= but no END= */
+ ffeste_io_end_ = NULL_TREE;
+ if ((ffeste_io_abort_is_temp_ = iostat))
+ ffeste_io_abort_ = ffecom_temp_label ();
+ else
+ ffeste_io_abort_ = ffeste_io_err_;
+ }
+ }
+ else
+ { /* no ERR= */
+ ffeste_io_err_ = NULL_TREE;
+ if (endl)
+ { /* END= but no ERR= */
+ ffeste_io_end_
+ = ffecom_lookup_label
+ (info->read_spec[FFESTP_readixEND].u.label);
+ if ((ffeste_io_abort_is_temp_ = iostat))
+ ffeste_io_abort_ = ffecom_temp_label ();
+ else
+ ffeste_io_abort_ = ffeste_io_end_;
+ }
+ else
+ { /* no ERR= or END= */
+ ffeste_io_end_ = NULL_TREE;
+ if ((ffeste_io_abort_is_temp_ = iostat))
+ ffeste_io_abort_ = ffecom_temp_label ();
+ else
+ ffeste_io_abort_ = NULL_TREE;
+ }
+ }
+
+ if (iostat)
+ { /* IOSTAT= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = ffecom_expr
+ (info->read_spec[FFESTP_readixIOSTAT].u.expr);
+ }
+ else if (ffeste_io_abort_ != NULL_TREE)
+ { /* no IOSTAT= but ERR= or END= or both */
+ ffeste_io_iostat_is_temp_ = TRUE;
+ ffeste_io_iostat_
+ = ffecom_push_tempvar (ffecom_integer_type_node,
+ FFETARGET_charactersizeNONE, -1, FALSE);
+ }
+ else
+ { /* no IOSTAT=, ERR=, or END= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = NULL_TREE;
+ }
+
+ /* If there is no end function, then there are no item functions (i.e.
+ it's a NAMELIST), and vice versa by the way. In this situation, don't
+ generate the "if (iostat != 0) goto label;" if the label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
+ !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+ }
+
+#undef specified
+
+ push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_item -- READ statement i/o item
+
+ ffeste_R909_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_R909_item (ffebld expr, ffelexToken expr_token)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ if (expr == NULL)
+ return;
+ while (ffebld_op (expr) == FFEBLD_opPAREN)
+ expr = ffebld_left (expr); /* "READ *,(A)" -- really a bug in the user's
+ code, but I've been told lots of code does
+ this (blech)! */
+ if (ffebld_op (expr) == FFEBLD_opANY)
+ return;
+ if (ffebld_op (expr) == FFEBLD_opIMPDO)
+ ffeste_io_impdo_ (expr, expr_token);
+ else
+ ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R909_finish -- READ statement list complete
+
+ ffeste_R909_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_R909_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+ /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ {
+ if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+ ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+ !ffeste_io_abort_is_temp_);
+
+ clear_momentary ();
+ pop_momentary ();
+
+ /* If we've got a temp label, generate its code here and have it fan out
+ to the END= or ERR= label as appropriate. */
+
+ if (ffeste_io_abort_is_temp_)
+ {
+ DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+ emit_nop ();
+ expand_label (ffeste_io_abort_);
+
+ /* if (iostat<0) goto end_label; */
+
+ if ((ffeste_io_end_ != NULL_TREE)
+ && (TREE_CODE (ffeste_io_end_) != ERROR_MARK))
+ {
+ expand_start_cond (ffecom_truth_value
+ (ffecom_2 (LT_EXPR, integer_type_node,
+ ffeste_io_iostat_,
+ ffecom_integer_zero_node)),
+ 0);
+ expand_goto (ffeste_io_end_);
+ expand_end_cond ();
+ }
+
+ /* if (iostat>0) goto err_label; */
+
+ if ((ffeste_io_err_ != NULL_TREE)
+ && (TREE_CODE (ffeste_io_err_) != ERROR_MARK))
+ {
+ expand_start_cond (ffecom_truth_value
+ (ffecom_2 (GT_EXPR, integer_type_node,
+ ffeste_io_iostat_,
+ ffecom_integer_zero_node)),
+ 0);
+ expand_goto (ffeste_io_err_);
+ expand_end_cond ();
+ }
+
+ }
+
+ /* If we've got a temp iostat, pop the temp. */
+
+ if (ffeste_io_iostat_is_temp_)
+ ffecom_pop_tempvar (ffeste_io_iostat_);
+
+ ffecom_pop_calltemps ();
+
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_start -- WRITE(...) statement list begin
+
+ ffeste_R910_start();
+
+ Verify that WRITE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
+ ffestvFormat format, bool rec)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ switch (format)
+ {
+ case FFESTV_formatNONE:
+ if (rec)
+ fputs ("+ WRITE_ufdac (", dmpout);
+ else
+ fputs ("+ WRITE_ufseq_or_idx (", dmpout);
+ break;
+
+ case FFESTV_formatLABEL:
+ case FFESTV_formatCHAREXPR:
+ case FFESTV_formatINTEXPR:
+ if (rec)
+ fputs ("+ WRITE_fmdac (", dmpout);
+ else if (unit == FFESTV_unitCHAREXPR)
+ fputs ("+ WRITE_fmint (", dmpout);
+ else
+ fputs ("+ WRITE_fmseq_or_idx (", dmpout);
+ break;
+
+ case FFESTV_formatASTERISK:
+ if (unit == FFESTV_unitCHAREXPR)
+ fputs ("+ WRITE_lsint (", dmpout);
+ else
+ fputs ("+ WRITE_lsseq (", dmpout);
+ break;
+
+ case FFESTV_formatNAMELIST:
+ fputs ("+ WRITE_nlseq (", dmpout);
+ break;
+
+ default:
+ assert ("Unexpected kind of format item in R910 WRITE" == NULL);
+ }
+
+ ffeste_subr_file_ ("UNIT", &info->write_spec[FFESTP_writeixUNIT]);
+ ffeste_subr_file_ ("FORMAT", &info->write_spec[FFESTP_writeixFORMAT]);
+ ffeste_subr_file_ ("ADVANCE", &info->write_spec[FFESTP_writeixADVANCE]);
+ ffeste_subr_file_ ("EOR", &info->write_spec[FFESTP_writeixEOR]);
+ ffeste_subr_file_ ("ERR", &info->write_spec[FFESTP_writeixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->write_spec[FFESTP_writeixIOSTAT]);
+ ffeste_subr_file_ ("REC", &info->write_spec[FFESTP_writeixREC]);
+ fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+#define specified(something) (info->write_spec[something].kw_or_val_present)
+
+ ffeste_emit_line_note_ ();
+
+ /* Do the real work. */
+
+ {
+ ffecomGfrt start;
+ ffecomGfrt end;
+ tree cilist;
+ bool iostat;
+ bool errl;
+
+ /* First determine the start, per-item, and end run-time functions to
+ call. The per-item function is picked by choosing an ffeste functio
+ to call to handle a given item; it knows how to generate a call to the
+ appropriate run-time function, and is called an "io driver". It
+ handles the implied-DO construct, for example. */
+
+ switch (format)
+ {
+ case FFESTV_formatNONE: /* no FMT= */
+ ffeste_io_driver_ = ffeste_io_douio_;
+ if (rec)
+ start = FFECOM_gfrtSWDUE, end = FFECOM_gfrtEWDUE;
+ else
+ start = FFECOM_gfrtSWSUE, end = FFECOM_gfrtEWSUE;
+ break;
+
+ case FFESTV_formatLABEL: /* FMT=10 */
+ case FFESTV_formatCHAREXPR: /* FMT='(I10)' */
+ case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */
+ ffeste_io_driver_ = ffeste_io_dofio_;
+ if (rec)
+ start = FFECOM_gfrtSWDFE, end = FFECOM_gfrtEWDFE;
+ else if (unit == FFESTV_unitCHAREXPR)
+ start = FFECOM_gfrtSWSFI, end = FFECOM_gfrtEWSFI;
+ else
+ start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE;
+ break;
+
+ case FFESTV_formatASTERISK: /* FMT=* */
+ ffeste_io_driver_ = ffeste_io_dolio_;
+ if (unit == FFESTV_unitCHAREXPR)
+ start = FFECOM_gfrtSWSLI, end = FFECOM_gfrtEWSLI;
+ else
+ start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE;
+ break;
+
+ case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST
+ /FOO/] */
+ ffeste_io_driver_ = NULL; /* No start or driver function. */
+ start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt;
+ break;
+
+ default:
+ assert ("Weird stuff" == NULL);
+ start = FFECOM_gfrt, end = FFECOM_gfrt;
+ break;
+ }
+ ffeste_io_endgfrt_ = end;
+
+ iostat = specified (FFESTP_writeixIOSTAT);
+ errl = specified (FFESTP_writeixERR);
+
+ ffecom_push_calltemps ();
+
+ if (unit == FFESTV_unitCHAREXPR)
+ {
+ cilist = ffeste_io_icilist_ (errl || iostat,
+ info->write_spec[FFESTP_writeixUNIT].u.expr,
+ FALSE, format,
+ &info->write_spec[FFESTP_writeixFORMAT]);
+ }
+ else
+ {
+ cilist = ffeste_io_cilist_ (errl || iostat, unit,
+ info->write_spec[FFESTP_writeixUNIT].u.expr,
+ 6, FALSE, format,
+ &info->write_spec[FFESTP_writeixFORMAT],
+ rec,
+ info->write_spec[FFESTP_writeixREC].u.expr);
+ }
+
+ ffeste_io_end_ = NULL_TREE;
+
+ if (errl)
+ { /* ERR= */
+ ffeste_io_err_
+ = ffeste_io_abort_
+ = ffecom_lookup_label
+ (info->write_spec[FFESTP_writeixERR].u.label);
+ ffeste_io_abort_is_temp_ = FALSE;
+ }
+ else
+ { /* no ERR= */
+ ffeste_io_err_ = NULL_TREE;
+
+ if ((ffeste_io_abort_is_temp_ = iostat))
+ ffeste_io_abort_ = ffecom_temp_label ();
+ else
+ ffeste_io_abort_ = NULL_TREE;
+ }
+
+ if (iostat)
+ { /* IOSTAT= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = ffecom_expr
+ (info->write_spec[FFESTP_writeixIOSTAT].u.expr);
+ }
+ else if (ffeste_io_abort_ != NULL_TREE)
+ { /* no IOSTAT= but ERR= */
+ ffeste_io_iostat_is_temp_ = TRUE;
+ ffeste_io_iostat_
+ = ffecom_push_tempvar (ffecom_integer_type_node,
+ FFETARGET_charactersizeNONE, -1, FALSE);
+ }
+ else
+ { /* no IOSTAT=, or ERR= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = NULL_TREE;
+ }
+
+ /* If there is no end function, then there are no item functions (i.e.
+ it's a NAMELIST), and vice versa by the way. In this situation, don't
+ generate the "if (iostat != 0) goto label;" if the label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
+ !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+ }
+
+#undef specified
+
+ push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_item -- WRITE statement i/o item
+
+ ffeste_R910_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_R910_item (ffebld expr, ffelexToken expr_token)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ if (expr == NULL)
+ return;
+ if (ffebld_op (expr) == FFEBLD_opANY)
+ return;
+ if (ffebld_op (expr) == FFEBLD_opIMPDO)
+ ffeste_io_impdo_ (expr, expr_token);
+ else
+ ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R910_finish -- WRITE statement list complete
+
+ ffeste_R910_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_R910_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+ /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ {
+ if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+ ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+ !ffeste_io_abort_is_temp_);
+
+ clear_momentary ();
+ pop_momentary ();
+
+ /* If we've got a temp label, generate its code here. */
+
+ if (ffeste_io_abort_is_temp_)
+ {
+ DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+ emit_nop ();
+ expand_label (ffeste_io_abort_);
+
+ assert (ffeste_io_err_ == NULL_TREE);
+ }
+
+ /* If we've got a temp iostat, pop the temp. */
+
+ if (ffeste_io_iostat_is_temp_)
+ ffecom_pop_tempvar (ffeste_io_iostat_);
+
+ ffecom_pop_calltemps ();
+
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_start -- PRINT statement list begin
+
+ ffeste_R911_start();
+
+ Verify that PRINT is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ switch (format)
+ {
+ case FFESTV_formatLABEL:
+ case FFESTV_formatCHAREXPR:
+ case FFESTV_formatINTEXPR:
+ fputs ("+ PRINT_fm ", dmpout);
+ break;
+
+ case FFESTV_formatASTERISK:
+ fputs ("+ PRINT_ls ", dmpout);
+ break;
+
+ case FFESTV_formatNAMELIST:
+ fputs ("+ PRINT_nl ", dmpout);
+ break;
+
+ default:
+ assert ("Unexpected kind of format item in R911 PRINT" == NULL);
+ }
+ ffeste_subr_file_ ("FORMAT", &info->print_spec[FFESTP_printixFORMAT]);
+ fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+
+ ffeste_emit_line_note_ ();
+
+ /* Do the real work. */
+
+ {
+ ffecomGfrt start;
+ ffecomGfrt end;
+ tree cilist;
+
+ /* First determine the start, per-item, and end run-time functions to
+ call. The per-item function is picked by choosing an ffeste functio
+ to call to handle a given item; it knows how to generate a call to the
+ appropriate run-time function, and is called an "io driver". It
+ handles the implied-DO construct, for example. */
+
+ switch (format)
+ {
+ case FFESTV_formatLABEL: /* FMT=10 */
+ case FFESTV_formatCHAREXPR: /* FMT='(I10)' */
+ case FFESTV_formatINTEXPR: /* FMT=I [after ASSIGN 10 TO I] */
+ ffeste_io_driver_ = ffeste_io_dofio_;
+ start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE;
+ break;
+
+ case FFESTV_formatASTERISK: /* FMT=* */
+ ffeste_io_driver_ = ffeste_io_dolio_;
+ start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE;
+ break;
+
+ case FFESTV_formatNAMELIST: /* FMT=FOO or NML=FOO [NAMELIST
+ /FOO/] */
+ ffeste_io_driver_ = NULL; /* No start or driver function. */
+ start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt;
+ break;
+
+ default:
+ assert ("Weird stuff" == NULL);
+ start = FFECOM_gfrt, end = FFECOM_gfrt;
+ break;
+ }
+ ffeste_io_endgfrt_ = end;
+
+ ffecom_push_calltemps ();
+
+ cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format,
+ &info->print_spec[FFESTP_printixFORMAT], FALSE, NULL);
+
+ ffeste_io_end_ = NULL_TREE;
+ ffeste_io_err_ = NULL_TREE;
+ ffeste_io_abort_ = NULL_TREE;
+ ffeste_io_abort_is_temp_ = FALSE;
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = NULL_TREE;
+
+ /* If there is no end function, then there are no item functions (i.e.
+ it's a NAMELIST), and vice versa by the way. In this situation, don't
+ generate the "if (iostat != 0) goto label;" if the label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ ffeste_io_call_ (ffecom_call_gfrt (start, cilist),
+ !ffeste_io_abort_is_temp_ || (end != FFECOM_gfrt));
+ }
+
+ push_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_item -- PRINT statement i/o item
+
+ ffeste_R911_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_R911_item (ffebld expr, ffelexToken expr_token)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ if (expr == NULL)
+ return;
+ if (ffebld_op (expr) == FFEBLD_opANY)
+ return;
+ if (ffebld_op (expr) == FFEBLD_opIMPDO)
+ ffeste_io_impdo_ (expr, expr_token);
+ else
+ ffeste_io_call_ ((*ffeste_io_driver_) (expr), FALSE);
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R911_finish -- PRINT statement list complete
+
+ ffeste_R911_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_R911_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ if (ffeste_io_endgfrt_ != FFECOM_gfrt)
+ ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE),
+ FALSE);
+
+ ffecom_pop_calltemps ();
+
+ clear_momentary ();
+ pop_momentary ();
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R919 -- BACKSPACE statement
+
+ ffeste_R919();
+
+ Make sure a BACKSPACE is valid in the current context, and implement it. */
+
+void
+ffeste_R919 (ffestpBeruStmt *info)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ BACKSPACE (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+ ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_subr_beru_ (info, FFECOM_gfrtFBACK);
+#else
+#error
+#endif
+}
+
+/* ffeste_R920 -- ENDFILE statement
+
+ ffeste_R920();
+
+ Make sure a ENDFILE is valid in the current context, and implement it. */
+
+void
+ffeste_R920 (ffestpBeruStmt *info)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ ENDFILE (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+ ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_subr_beru_ (info, FFECOM_gfrtFEND);
+#else
+#error
+#endif
+}
+
+/* ffeste_R921 -- REWIND statement
+
+ ffeste_R921();
+
+ Make sure a REWIND is valid in the current context, and implement it. */
+
+void
+ffeste_R921 (ffestpBeruStmt *info)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ REWIND (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+ ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ ffeste_subr_beru_ (info, FFECOM_gfrtFREW);
+#else
+#error
+#endif
+}
+
+/* ffeste_R923A -- INQUIRE statement (non-IOLENGTH version)
+
+ ffeste_R923A(bool by_file);
+
+ Make sure an INQUIRE is valid in the current context, and implement it. */
+
+void
+ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (by_file)
+ {
+ fputs ("+ INQUIRE_file (", dmpout);
+ ffeste_subr_file_ ("FILE", &info->inquire_spec[FFESTP_inquireixFILE]);
+ }
+ else
+ {
+ fputs ("+ INQUIRE_unit (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->inquire_spec[FFESTP_inquireixUNIT]);
+ }
+ ffeste_subr_file_ ("ACCESS", &info->inquire_spec[FFESTP_inquireixACCESS]);
+ ffeste_subr_file_ ("ACTION", &info->inquire_spec[FFESTP_inquireixACTION]);
+ ffeste_subr_file_ ("BLANK", &info->inquire_spec[FFESTP_inquireixBLANK]);
+ ffeste_subr_file_ ("CARRIAGECONTROL", &info->inquire_spec[FFESTP_inquireixCARRIAGECONTROL]);
+ ffeste_subr_file_ ("DEFAULTFILE", &info->inquire_spec[FFESTP_inquireixDEFAULTFILE]);
+ ffeste_subr_file_ ("DELIM", &info->inquire_spec[FFESTP_inquireixDELIM]);
+ ffeste_subr_file_ ("DIRECT", &info->inquire_spec[FFESTP_inquireixDIRECT]);
+ ffeste_subr_file_ ("ERR", &info->inquire_spec[FFESTP_inquireixERR]);
+ ffeste_subr_file_ ("EXIST", &info->inquire_spec[FFESTP_inquireixEXIST]);
+ ffeste_subr_file_ ("FORM", &info->inquire_spec[FFESTP_inquireixFORM]);
+ ffeste_subr_file_ ("FORMATTED", &info->inquire_spec[FFESTP_inquireixFORMATTED]);
+ ffeste_subr_file_ ("IOSTAT", &info->inquire_spec[FFESTP_inquireixIOSTAT]);
+ ffeste_subr_file_ ("KEYED", &info->inquire_spec[FFESTP_inquireixKEYED]);
+ ffeste_subr_file_ ("NAME", &info->inquire_spec[FFESTP_inquireixNAME]);
+ ffeste_subr_file_ ("NAMED", &info->inquire_spec[FFESTP_inquireixNAMED]);
+ ffeste_subr_file_ ("NEXTREC", &info->inquire_spec[FFESTP_inquireixNEXTREC]);
+ ffeste_subr_file_ ("NUMBER", &info->inquire_spec[FFESTP_inquireixNUMBER]);
+ ffeste_subr_file_ ("OPENED", &info->inquire_spec[FFESTP_inquireixOPENED]);
+ ffeste_subr_file_ ("ORGANIZATION", &info->inquire_spec[FFESTP_inquireixORGANIZATION]);
+ ffeste_subr_file_ ("PAD", &info->inquire_spec[FFESTP_inquireixPAD]);
+ ffeste_subr_file_ ("POSITION", &info->inquire_spec[FFESTP_inquireixPOSITION]);
+ ffeste_subr_file_ ("READ", &info->inquire_spec[FFESTP_inquireixREAD]);
+ ffeste_subr_file_ ("READWRITE", &info->inquire_spec[FFESTP_inquireixREADWRITE]);
+ ffeste_subr_file_ ("RECL", &info->inquire_spec[FFESTP_inquireixRECL]);
+ ffeste_subr_file_ ("RECORDTYPE", &info->inquire_spec[FFESTP_inquireixRECORDTYPE]);
+ ffeste_subr_file_ ("SEQUENTIAL", &info->inquire_spec[FFESTP_inquireixSEQUENTIAL]);
+ ffeste_subr_file_ ("UNFORMATTED", &info->inquire_spec[FFESTP_inquireixUNFORMATTED]);
+ ffeste_subr_file_ ("WRITE", &info->inquire_spec[FFESTP_inquireixWRITE]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree args;
+ bool iostat;
+ bool errl;
+
+#define specified(something) (info->inquire_spec[something].kw_or_val_present)
+
+ ffeste_emit_line_note_ ();
+
+ iostat = specified (FFESTP_inquireixIOSTAT);
+ errl = specified (FFESTP_inquireixERR);
+
+ ffecom_push_calltemps ();
+
+ args = ffeste_io_inlist_ (errl || iostat,
+ &info->inquire_spec[FFESTP_inquireixUNIT],
+ &info->inquire_spec[FFESTP_inquireixFILE],
+ &info->inquire_spec[FFESTP_inquireixEXIST],
+ &info->inquire_spec[FFESTP_inquireixOPENED],
+ &info->inquire_spec[FFESTP_inquireixNUMBER],
+ &info->inquire_spec[FFESTP_inquireixNAMED],
+ &info->inquire_spec[FFESTP_inquireixNAME],
+ &info->inquire_spec[FFESTP_inquireixACCESS],
+ &info->inquire_spec[FFESTP_inquireixSEQUENTIAL],
+ &info->inquire_spec[FFESTP_inquireixDIRECT],
+ &info->inquire_spec[FFESTP_inquireixFORM],
+ &info->inquire_spec[FFESTP_inquireixFORMATTED],
+ &info->inquire_spec[FFESTP_inquireixUNFORMATTED],
+ &info->inquire_spec[FFESTP_inquireixRECL],
+ &info->inquire_spec[FFESTP_inquireixNEXTREC],
+ &info->inquire_spec[FFESTP_inquireixBLANK]);
+
+ if (errl)
+ {
+ ffeste_io_err_
+ = ffeste_io_abort_
+ = ffecom_lookup_label
+ (info->inquire_spec[FFESTP_inquireixERR].u.label);
+ ffeste_io_abort_is_temp_ = FALSE;
+ }
+ else
+ {
+ ffeste_io_err_ = NULL_TREE;
+
+ if ((ffeste_io_abort_is_temp_ = iostat))
+ ffeste_io_abort_ = ffecom_temp_label ();
+ else
+ ffeste_io_abort_ = NULL_TREE;
+ }
+
+ if (iostat)
+ { /* IOSTAT= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = ffecom_expr
+ (info->inquire_spec[FFESTP_inquireixIOSTAT].u.expr);
+ }
+ else if (ffeste_io_abort_ != NULL_TREE)
+ { /* no IOSTAT= but ERR= */
+ ffeste_io_iostat_is_temp_ = TRUE;
+ ffeste_io_iostat_
+ = ffecom_push_tempvar (ffecom_integer_type_node,
+ FFETARGET_charactersizeNONE, -1, FALSE);
+ }
+ else
+ { /* no IOSTAT=, or ERR= */
+ ffeste_io_iostat_is_temp_ = FALSE;
+ ffeste_io_iostat_ = NULL_TREE;
+ }
+
+ /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
+ label, since we're gonna fall through to there anyway. */
+
+ ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args),
+ !ffeste_io_abort_is_temp_);
+
+ /* If we've got a temp label, generate its code here. */
+
+ if (ffeste_io_abort_is_temp_)
+ {
+ DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
+ emit_nop ();
+ expand_label (ffeste_io_abort_);
+
+ assert (ffeste_io_err_ == NULL_TREE);
+ }
+
+ /* If we've got a temp iostat, pop the temp. */
+
+ if (ffeste_io_iostat_is_temp_)
+ ffecom_pop_tempvar (ffeste_io_iostat_);
+
+ ffecom_pop_calltemps ();
+
+#undef specified
+ }
+
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
+
+ ffeste_R923B_start();
+
+ Verify that INQUIRE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_R923B_start (ffestpInquireStmt *info UNUSED)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ INQUIRE (", dmpout);
+ ffeste_subr_file_ ("IOLENGTH", &info->inquire_spec[FFESTP_inquireixIOLENGTH]);
+ fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ assert ("INQUIRE(IOLENGTH=<var>) not implemented yet! ~~~" == NULL);
+ ffeste_emit_line_note_ ();
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_item -- INQUIRE statement i/o item
+
+ ffeste_R923B_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_R923B_item (ffebld expr UNUSED)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R923B_finish -- INQUIRE statement list complete
+
+ ffeste_R923B_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_R923B_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ clear_momentary ();
+#else
+#error
+#endif
+}
+
+/* ffeste_R1001 -- FORMAT statement
+
+ ffeste_R1001(format_list); */
+
+void
+ffeste_R1001 (ffests s)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "$ FORMAT %.*s\n", (int) ffests_length (s), ffests_text (s));
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree t;
+ tree ttype;
+ tree maxindex;
+ tree var;
+
+ assert (ffeste_label_formatdef_ != NULL);
+
+ ffeste_emit_line_note_ ();
+
+ t = build_string (ffests_length (s), ffests_text (s));
+
+ TREE_TYPE (t)
+ = build_type_variant (build_array_type
+ (char_type_node,
+ build_range_type (integer_type_node,
+ integer_one_node,
+ build_int_2 (ffests_length (s),
+ 0))),
+ 1, 0);
+ TREE_CONSTANT (t) = 1;
+ TREE_STATIC (t) = 1;
+
+ push_obstacks_nochange ();
+ end_temporary_allocation ();
+
+ var = ffecom_lookup_label (ffeste_label_formatdef_);
+ if ((var != NULL_TREE)
+ && (TREE_CODE (var) == VAR_DECL))
+ {
+ DECL_INITIAL (var) = t;
+ maxindex = build_int_2 (ffests_length (s) - 1, 0);
+ ttype = TREE_TYPE (var);
+ TYPE_DOMAIN (ttype) = build_range_type (integer_type_node,
+ integer_zero_node,
+ maxindex);
+ if (!TREE_TYPE (maxindex))
+ TREE_TYPE (maxindex) = TYPE_DOMAIN (ttype);
+ layout_type (ttype);
+ rest_of_decl_compilation (var, NULL, 1, 0);
+ expand_decl (var);
+ expand_decl_init (var);
+ }
+
+ resume_temporary_allocation ();
+ pop_obstacks ();
+
+ ffeste_label_formatdef_ = NULL;
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1103 -- End a PROGRAM
+
+ ffeste_R1103(); */
+
+void
+ffeste_R1103 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ END_PROGRAM\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1112 -- End a BLOCK DATA
+
+ ffeste_R1112(TRUE); */
+
+void
+ffeste_R1112 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("* END_BLOCK_DATA\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1212 -- CALL statement
+
+ ffeste_R1212(expr,expr_token);
+
+ Make sure statement is valid here; implement. */
+
+void
+ffeste_R1212 (ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ CALL ", dmpout);
+ ffebld_dump (expr);
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ ffebld args = ffebld_right (expr);
+ ffebld arg;
+ ffebld labels = NULL; /* First in list of LABTERs. */
+ ffebld prevlabels = NULL;
+ ffebld prevargs = NULL;
+
+ ffeste_emit_line_note_ ();
+
+ /* Here we split the list at ffebld_right(expr) into two lists: one at
+ ffebld_right(expr) consisting of all items that are not LABTERs, the
+ other at labels consisting of all items that are LABTERs. Then, if
+ the latter list is NULL, we have an ordinary call, else we have a call
+ with alternate returns. */
+
+ for (args = ffebld_right (expr); args != NULL; args = ffebld_trail (args))
+ {
+ if (((arg = ffebld_head (args)) == NULL)
+ || (ffebld_op (arg) != FFEBLD_opLABTER))
+ {
+ if (prevargs == NULL)
+ {
+ prevargs = args;
+ ffebld_set_right (expr, args);
+ }
+ else
+ {
+ ffebld_set_trail (prevargs, args);
+ prevargs = args;
+ }
+ }
+ else
+ {
+ if (prevlabels == NULL)
+ {
+ prevlabels = labels = args;
+ }
+ else
+ {
+ ffebld_set_trail (prevlabels, args);
+ prevlabels = args;
+ }
+ }
+ }
+ if (prevlabels == NULL)
+ labels = NULL;
+ else
+ ffebld_set_trail (prevlabels, NULL);
+ if (prevargs == NULL)
+ ffebld_set_right (expr, NULL);
+ else
+ ffebld_set_trail (prevargs, NULL);
+
+ if (labels == NULL)
+ expand_expr_stmt (ffecom_expr (expr));
+ else
+ {
+ tree texpr;
+ tree value;
+ tree tlabel;
+ int caseno;
+ int pushok;
+ tree duplicate;
+
+ texpr = ffecom_expr (expr);
+ expand_start_case (0, texpr, TREE_TYPE (texpr), "CALL statement");
+ push_momentary (); /* In case of many labels, keep 'em cleared
+ out. */
+ for (caseno = 1;
+ labels != NULL;
+ ++caseno, labels = ffebld_trail (labels))
+ {
+ value = build_int_2 (caseno, 0);
+ tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
+
+ pushok = pushcase (value, convert, tlabel, &duplicate);
+ assert (pushok == 0);
+ tlabel
+ = ffecom_lookup_label (ffebld_labter (ffebld_head (labels)));
+ if ((tlabel == NULL_TREE)
+ || (TREE_CODE (tlabel) == ERROR_MARK))
+ continue;
+ TREE_USED (tlabel) = 1;
+ expand_goto (tlabel);
+ clear_momentary ();
+ }
+
+ pop_momentary ();
+ expand_end_case (texpr);
+ }
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1221 -- End a FUNCTION
+
+ ffeste_R1221(TRUE); */
+
+void
+ffeste_R1221 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ END_FUNCTION\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1225 -- End a SUBROUTINE
+
+ ffeste_R1225(TRUE); */
+
+void
+ffeste_R1225 ()
+{
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "+ END_SUBROUTINE\n");
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_R1226 -- ENTRY statement
+
+ ffeste_R1226(entryname,arglist,ending_token);
+
+ Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the
+ entry point name, and so on. */
+
+void
+ffeste_R1226 (ffesymbol entry)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fprintf (dmpout, "+ ENTRY %s", ffesymbol_text (entry));
+ if (ffesymbol_dummyargs (entry) != NULL)
+ {
+ ffebld argh;
+
+ fputc ('(', dmpout);
+ for (argh = ffesymbol_dummyargs (entry);
+ argh != NULL;
+ argh = ffebld_trail (argh))
+ {
+ assert (ffebld_head (argh) != NULL);
+ switch (ffebld_op (ffebld_head (argh)))
+ {
+ case FFEBLD_opSYMTER:
+ fputs (ffesymbol_text (ffebld_symter (ffebld_head (argh))),
+ dmpout);
+ break;
+
+ case FFEBLD_opSTAR:
+ fputc ('*', dmpout);
+ break;
+
+ default:
+ fputc ('?', dmpout);
+ ffebld_dump (ffebld_head (argh));
+ fputc ('?', dmpout);
+ break;
+ }
+ if (ffebld_trail (argh) != NULL)
+ fputc (',', dmpout);
+ }
+ fputc (')', dmpout);
+ }
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree label = ffesymbol_hook (entry).length_tree;
+
+ ffeste_emit_line_note_ ();
+
+ DECL_INITIAL (label) = error_mark_node;
+ emit_nop ();
+ expand_label (label);
+
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_R1227 -- RETURN statement
+
+ ffeste_R1227(expr);
+
+ Make sure statement is valid here; implement. expr and expr_token are
+ both NULL if there was no expression. */
+
+void
+ffeste_R1227 (ffestw block UNUSED, ffebld expr)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ if (expr == NULL)
+ {
+ fputs ("+ RETURN\n", dmpout);
+ }
+ else
+ {
+ fputs ("+ RETURN_alternate ", dmpout);
+ ffebld_dump (expr);
+ fputc ('\n', dmpout);
+ }
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+ {
+ tree rtn;
+
+ ffeste_emit_line_note_ ();
+ ffecom_push_calltemps ();
+
+ rtn = ffecom_return_expr (expr);
+
+ if ((rtn == NULL_TREE)
+ || (rtn == error_mark_node))
+ expand_null_return ();
+ else
+ {
+ tree result = DECL_RESULT (current_function_decl);
+
+ if ((result != error_mark_node)
+ && (TREE_TYPE (result) != error_mark_node))
+ expand_return (ffecom_modify (NULL_TREE,
+ result,
+ convert (TREE_TYPE (result),
+ rtn)));
+ else
+ expand_null_return ();
+ }
+
+ ffecom_pop_calltemps ();
+ clear_momentary ();
+ }
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_start -- REWRITE(...) statement list begin
+
+ ffeste_V018_start();
+
+ Verify that REWRITE is valid here, and begin accepting items in the
+ list. */
+
+#if FFESTR_VXT
+void
+ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ switch (format)
+ {
+ case FFESTV_formatNONE:
+ fputs ("+ REWRITE_uf (", dmpout);
+ break;
+
+ case FFESTV_formatLABEL:
+ case FFESTV_formatCHAREXPR:
+ case FFESTV_formatINTEXPR:
+ fputs ("+ REWRITE_fm (", dmpout);
+ break;
+
+ default:
+ assert ("Unexpected kind of format item in V018 REWRITE" == NULL);
+ }
+ ffeste_subr_file_ ("UNIT", &info->rewrite_spec[FFESTP_rewriteixUNIT]);
+ ffeste_subr_file_ ("FMT", &info->rewrite_spec[FFESTP_rewriteixFMT]);
+ ffeste_subr_file_ ("ERR", &info->rewrite_spec[FFESTP_rewriteixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->rewrite_spec[FFESTP_rewriteixIOSTAT]);
+ fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_item -- REWRITE statement i/o item
+
+ ffeste_V018_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_V018_item (ffebld expr)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V018_finish -- REWRITE statement list complete
+
+ ffeste_V018_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_V018_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_start -- ACCEPT statement list begin
+
+ ffeste_V019_start();
+
+ Verify that ACCEPT is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ switch (format)
+ {
+ case FFESTV_formatLABEL:
+ case FFESTV_formatCHAREXPR:
+ case FFESTV_formatINTEXPR:
+ fputs ("+ ACCEPT_fm ", dmpout);
+ break;
+
+ case FFESTV_formatASTERISK:
+ fputs ("+ ACCEPT_ls ", dmpout);
+ break;
+
+ case FFESTV_formatNAMELIST:
+ fputs ("+ ACCEPT_nl ", dmpout);
+ break;
+
+ default:
+ assert ("Unexpected kind of format item in V019 ACCEPT" == NULL);
+ }
+ ffeste_subr_file_ ("FORMAT", &info->accept_spec[FFESTP_acceptixFORMAT]);
+ fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_item -- ACCEPT statement i/o item
+
+ ffeste_V019_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_V019_item (ffebld expr)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V019_finish -- ACCEPT statement list complete
+
+ ffeste_V019_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_V019_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
+/* ffeste_V020_start -- TYPE statement list begin
+
+ ffeste_V020_start();
+
+ Verify that TYPE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_V020_start (ffestpTypeStmt *info UNUSED,
+ ffestvFormat format UNUSED)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ switch (format)
+ {
+ case FFESTV_formatLABEL:
+ case FFESTV_formatCHAREXPR:
+ case FFESTV_formatINTEXPR:
+ fputs ("+ TYPE_fm ", dmpout);
+ break;
+
+ case FFESTV_formatASTERISK:
+ fputs ("+ TYPE_ls ", dmpout);
+ break;
+
+ case FFESTV_formatNAMELIST:
+ fputs ("* TYPE_nl ", dmpout);
+ break;
+
+ default:
+ assert ("Unexpected kind of format item in V020 TYPE" == NULL);
+ }
+ ffeste_subr_file_ ("FORMAT", &info->type_spec[FFESTP_typeixFORMAT]);
+ fputc (' ', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V020_item -- TYPE statement i/o item
+
+ ffeste_V020_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_V020_item (ffebld expr UNUSED)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V020_finish -- TYPE statement list complete
+
+ ffeste_V020_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_V020_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V021 -- DELETE statement
+
+ ffeste_V021();
+
+ Make sure a DELETE is valid in the current context, and implement it. */
+
+#if FFESTR_VXT
+void
+ffeste_V021 (ffestpDeleteStmt *info)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ DELETE (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->delete_spec[FFESTP_deleteixUNIT]);
+ ffeste_subr_file_ ("REC", &info->delete_spec[FFESTP_deleteixREC]);
+ ffeste_subr_file_ ("ERR", &info->delete_spec[FFESTP_deleteixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->delete_spec[FFESTP_deleteixIOSTAT]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V022 -- UNLOCK statement
+
+ ffeste_V022();
+
+ Make sure a UNLOCK is valid in the current context, and implement it. */
+
+void
+ffeste_V022 (ffestpBeruStmt *info)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ UNLOCK (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->beru_spec[FFESTP_beruixUNIT]);
+ ffeste_subr_file_ ("ERR", &info->beru_spec[FFESTP_beruixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->beru_spec[FFESTP_beruixIOSTAT]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_start -- ENCODE(...) statement list begin
+
+ ffeste_V023_start();
+
+ Verify that ENCODE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_V023_start (ffestpVxtcodeStmt *info)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ ENCODE (", dmpout);
+ ffeste_subr_file_ ("C", &info->vxtcode_spec[FFESTP_vxtcodeixC]);
+ ffeste_subr_file_ ("F", &info->vxtcode_spec[FFESTP_vxtcodeixF]);
+ ffeste_subr_file_ ("B", &info->vxtcode_spec[FFESTP_vxtcodeixB]);
+ ffeste_subr_file_ ("ERR", &info->vxtcode_spec[FFESTP_vxtcodeixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]);
+ fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_item -- ENCODE statement i/o item
+
+ ffeste_V023_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_V023_item (ffebld expr)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V023_finish -- ENCODE statement list complete
+
+ ffeste_V023_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_V023_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_start -- DECODE(...) statement list begin
+
+ ffeste_V024_start();
+
+ Verify that DECODE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_V024_start (ffestpVxtcodeStmt *info)
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ DECODE (", dmpout);
+ ffeste_subr_file_ ("C", &info->vxtcode_spec[FFESTP_vxtcodeixC]);
+ ffeste_subr_file_ ("F", &info->vxtcode_spec[FFESTP_vxtcodeixF]);
+ ffeste_subr_file_ ("B", &info->vxtcode_spec[FFESTP_vxtcodeixB]);
+ ffeste_subr_file_ ("ERR", &info->vxtcode_spec[FFESTP_vxtcodeixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->vxtcode_spec[FFESTP_vxtcodeixIOSTAT]);
+ fputs (") ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_item -- DECODE statement i/o item
+
+ ffeste_V024_item(expr,expr_token);
+
+ Implement output-list expression. */
+
+void
+ffeste_V024_item (ffebld expr)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (expr);
+ fputc (',', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V024_finish -- DECODE statement list complete
+
+ ffeste_V024_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_V024_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_start -- DEFINEFILE statement list begin
+
+ ffeste_V025_start();
+
+ Verify that DEFINEFILE is valid here, and begin accepting items in the
+ list. */
+
+void
+ffeste_V025_start ()
+{
+ ffeste_check_start_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ DEFINE_FILE ", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_item -- DEFINE FILE statement item
+
+ ffeste_V025_item(u,ut,m,mt,n,nt,asv,asvt);
+
+ Implement item. */
+
+void
+ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv)
+{
+ ffeste_check_item_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ ffebld_dump (u);
+ fputc ('(', dmpout);
+ ffebld_dump (m);
+ fputc (',', dmpout);
+ ffebld_dump (n);
+ fputs (",U,", dmpout);
+ ffebld_dump (asv);
+ fputs ("),", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V025_finish -- DEFINE FILE statement list complete
+
+ ffeste_V025_finish();
+
+ Just wrap up any local activities. */
+
+void
+ffeste_V025_finish ()
+{
+ ffeste_check_finish_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputc ('\n', dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+/* ffeste_V026 -- FIND statement
+
+ ffeste_V026();
+
+ Make sure a FIND is valid in the current context, and implement it. */
+
+void
+ffeste_V026 (ffestpFindStmt *info)
+{
+ ffeste_check_simple_ ();
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+ fputs ("+ FIND (", dmpout);
+ ffeste_subr_file_ ("UNIT", &info->find_spec[FFESTP_findixUNIT]);
+ ffeste_subr_file_ ("REC", &info->find_spec[FFESTP_findixREC]);
+ ffeste_subr_file_ ("ERR", &info->find_spec[FFESTP_findixERR]);
+ ffeste_subr_file_ ("IOSTAT", &info->find_spec[FFESTP_findixIOSTAT]);
+ fputs (")\n", dmpout);
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+#else
+#error
+#endif
+}
+
+#endif
diff --git a/gcc/f/ste.h b/gcc/f/ste.h
new file mode 100644
index 00000000000..e2122cecffd
--- /dev/null
+++ b/gcc/f/ste.h
@@ -0,0 +1,168 @@
+/* ste.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ ste.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_ste
+#define _H_f_ste
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lab.h"
+#include "lex.h"
+#include "stp.h"
+#include "str.h"
+#include "sts.h"
+#include "stt.h"
+#include "stv.h"
+#include "stw.h"
+#include "symbol.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffeste_do (ffestw block);
+void ffeste_end_R807 (void);
+void ffeste_labeldef_branch (ffelab label);
+void ffeste_labeldef_format (ffelab label);
+void ffeste_R737A (ffebld dest, ffebld source);
+void ffeste_R803 (ffebld expr);
+void ffeste_R804 (ffebld expr);
+void ffeste_R805 (void);
+void ffeste_R806 (void);
+void ffeste_R807 (ffebld expr);
+void ffeste_R809 (ffestw block, ffebld expr);
+void ffeste_R810 (ffestw block, unsigned long casenum);
+void ffeste_R811 (ffestw block);
+void ffeste_R819A (ffestw block, ffelab label, ffebld var,
+ ffebld start, ffelexToken start_token,
+ ffebld end, ffelexToken end_token,
+ ffebld incr, ffelexToken incr_token);
+void ffeste_R819B (ffestw block, ffelab label, ffebld expr);
+void ffeste_R825 (void);
+void ffeste_R834 (ffestw block);
+void ffeste_R835 (ffestw block);
+void ffeste_R836 (ffelab label);
+void ffeste_R837 (ffelab *labels, int count, ffebld expr);
+void ffeste_R838 (ffelab label, ffebld target);
+void ffeste_R839 (ffebld target);
+void ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos);
+void ffeste_R841 (void);
+void ffeste_R842 (ffebld expr);
+void ffeste_R843 (ffebld expr);
+void ffeste_R904 (ffestpOpenStmt *info);
+void ffeste_R907 (ffestpCloseStmt *info);
+void ffeste_R909_start (ffestpReadStmt *info, bool only_format,
+ ffestvUnit unit, ffestvFormat format, bool rec, bool key);
+void ffeste_R909_item (ffebld expr, ffelexToken expr_token);
+void ffeste_R909_finish (void);
+void ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
+ ffestvFormat format, bool rec);
+void ffeste_R910_item (ffebld expr, ffelexToken expr_token);
+void ffeste_R910_finish (void);
+void ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format);
+void ffeste_R911_item (ffebld expr, ffelexToken expr_token);
+void ffeste_R911_finish (void);
+void ffeste_R919 (ffestpBeruStmt *info);
+void ffeste_R920 (ffestpBeruStmt *info);
+void ffeste_R921 (ffestpBeruStmt *info);
+void ffeste_R923A (ffestpInquireStmt *info, bool by_file);
+void ffeste_R923B_start (ffestpInquireStmt *info);
+void ffeste_R923B_item (ffebld expr);
+void ffeste_R923B_finish (void);
+void ffeste_R1001 (ffests s);
+void ffeste_R1103 (void);
+void ffeste_R1112 (void);
+void ffeste_R1212 (ffebld expr);
+void ffeste_R1221 (void);
+void ffeste_R1225 (void);
+void ffeste_R1226 (ffesymbol entry);
+void ffeste_R1227 (ffestw block, ffebld expr);
+#if FFESTR_VXT
+void ffeste_V018_start (ffestpRewriteStmt *info, ffestvFormat format);
+void ffeste_V018_item (ffebld expr);
+void ffeste_V018_finish (void);
+void ffeste_V019_start (ffestpAcceptStmt *info, ffestvFormat format);
+void ffeste_V019_item (ffebld expr);
+void ffeste_V019_finish (void);
+#endif
+void ffeste_V020_start (ffestpTypeStmt *info, ffestvFormat format);
+void ffeste_V020_item (ffebld expr);
+void ffeste_V020_finish (void);
+#if FFESTR_VXT
+void ffeste_V021 (ffestpDeleteStmt *info);
+void ffeste_V022 (ffestpBeruStmt *info);
+void ffeste_V023_start (ffestpVxtcodeStmt *info);
+void ffeste_V023_item (ffebld expr);
+void ffeste_V023_finish (void);
+void ffeste_V024_start (ffestpVxtcodeStmt *info);
+void ffeste_V024_item (ffebld expr);
+void ffeste_V024_finish (void);
+void ffeste_V025_start (void);
+void ffeste_V025_item (ffebld u, ffebld m, ffebld n, ffebld asv);
+void ffeste_V025_finish (void);
+void ffeste_V026 (ffestpFindStmt *info);
+#endif
+
+/* Define macros. */
+
+#define ffeste_init_0()
+#define ffeste_init_1()
+#define ffeste_init_2()
+#define ffeste_init_3()
+#define ffeste_init_4()
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#define ffeste_filename() input_filename
+#define ffeste_filelinenum() lineno
+#define ffeste_set_line(name,num) \
+ (input_filename = (name), lineno = (num))
+#elif FFECOM_targetCURRENT == FFECOM_targetFFE
+#define ffeste_set_line(name,num)
+#else
+#error
+#endif /* FFECOM_targetCURRENT == FFECOM_targetFFE */
+#define ffeste_terminate_0()
+#define ffeste_terminate_1()
+#define ffeste_terminate_2()
+#define ffeste_terminate_3()
+#define ffeste_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/storag.c b/gcc/f/storag.c
new file mode 100644
index 00000000000..7ad155b983a
--- /dev/null
+++ b/gcc/f/storag.c
@@ -0,0 +1,573 @@
+/* storag.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Maintains information on storage (memory) relationships between
+ COMMON, dummy, and local variables, plus their equivalences (dummies
+ don't have equivalences, however).
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "storag.h"
+#include "data.h"
+#include "malloc.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Externals defined here. */
+
+ffestoragList_ ffestorag_list_;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+static ffetargetOffset ffestorag_local_size_; /* #units allocated so far. */
+static bool ffestorag_reported_;/* Reports happen only once. */
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+#define ffestorag_next_(s) ((s)->next)
+#define ffestorag_previous_(s) ((s)->previous)
+
+/* ffestorag_drive -- Drive fn from list of storage objects
+
+ ffestoragList sl;
+ void (*fn)(ffestorag mst,ffestorag st);
+ ffestorag mst; // the master ffestorag object (or whatever)
+ ffestorag_drive(sl,fn,mst);
+
+ Calls (*fn)(mst,st) for every st in the list sl. */
+
+void
+ffestorag_drive (ffestoragList sl, void (*fn) (ffestorag mst, ffestorag st),
+ ffestorag mst)
+{
+ ffestorag st;
+
+ for (st = sl->first;
+ st != (ffestorag) &sl->first;
+ st = st->next)
+ (*fn) (mst, st);
+}
+
+/* ffestorag_dump -- Dump information on storage object
+
+ ffestorag s; // the ffestorag object
+ ffestorag_dump(s);
+
+ Dumps information in the storage object. */
+
+void
+ffestorag_dump (ffestorag s)
+{
+ if (s == NULL)
+ {
+ fprintf (dmpout, "(no storage object)");
+ return;
+ }
+
+ switch (s->type)
+ {
+ case FFESTORAG_typeCBLOCK:
+ fprintf (dmpout, "CBLOCK ");
+ break;
+
+ case FFESTORAG_typeCOMMON:
+ fprintf (dmpout, "COMMON ");
+ break;
+
+ case FFESTORAG_typeLOCAL:
+ fprintf (dmpout, "LOCAL ");
+ break;
+
+ case FFESTORAG_typeEQUIV:
+ fprintf (dmpout, "EQUIV ");
+ break;
+
+ default:
+ fprintf (dmpout, "?%d? ", s->type);
+ break;
+ }
+
+ if (s->symbol != NULL)
+ fprintf (dmpout, "\"%s\" ", ffesymbol_text (s->symbol));
+
+ fprintf (dmpout, "at %" ffetargetOffset_f "d size %" ffetargetOffset_f
+ "d, align loc%%%"
+ ffetargetAlign_f "u=%" ffetargetAlign_f "u, bt=%s, kt=%s",
+ s->offset,
+ s->size, (unsigned int) s->alignment, (unsigned int) s->modulo,
+ ffeinfo_basictype_string (s->basic_type),
+ ffeinfo_kindtype_string (s->kind_type));
+
+ if (s->equivs_.first != (ffestorag) &s->equivs_.first)
+ {
+ ffestorag sq;
+
+ fprintf (dmpout, " with equivs");
+ for (sq = s->equivs_.first;
+ sq != (ffestorag) &s->equivs_.first;
+ sq = ffestorag_next_ (sq))
+ {
+ if (ffestorag_previous_ (sq) == (ffestorag) &s->equivs_.first)
+ fputc (' ', dmpout);
+ else
+ fputc (',', dmpout);
+ fprintf (dmpout, "%s", ffesymbol_text (ffestorag_symbol (sq)));
+ }
+ }
+}
+
+/* ffestorag_init_2 -- Initialize for new program unit
+
+ ffestorag_init_2(); */
+
+void
+ffestorag_init_2 ()
+{
+ ffestorag_list_.first = ffestorag_list_.last
+ = (ffestorag) &ffestorag_list_.first;
+ ffestorag_local_size_ = 0;
+ ffestorag_reported_ = FALSE;
+}
+
+/* ffestorag_end_layout -- Do final layout for symbol
+
+ ffesymbol s;
+ ffestorag_end_layout(s); */
+
+void
+ffestorag_end_layout (ffesymbol s)
+{
+ if (ffesymbol_storage (s) != NULL)
+ return; /* Already laid out. */
+
+ ffestorag_exec_layout (s); /* Do what we have in common. */
+#if 0
+ assert (ffesymbol_storage (s) == NULL); /* I'd like to know what
+ cases miss going through
+ ffecom_sym_learned, and
+ why; I don't think we
+ should have to do the
+ exec_layout thing at all
+ here. */
+ /* Now I think I know: we have to do exec_layout here, because equivalence
+ handling could encounter an error that takes a variable off of its
+ equivalence object (and vice versa), and we should then layout the var
+ as a local entity. */
+#endif
+}
+
+/* ffestorag_exec_layout -- Do initial layout for symbol
+
+ ffesymbol s;
+ ffestorag_exec_layout(s); */
+
+void
+ffestorag_exec_layout (ffesymbol s)
+{
+ ffetargetAlign alignment;
+ ffetargetAlign modulo;
+ ffetargetOffset size;
+ ffetargetOffset num_elements;
+ ffetargetAlign pad;
+ ffestorag st;
+ ffestorag stv;
+ ffebld list;
+ ffebld item;
+ ffesymbol var;
+ bool init;
+
+ if (ffesymbol_storage (s) != NULL)
+ return; /* Already laid out. */
+
+ switch (ffesymbol_kind (s))
+ {
+ default:
+ return; /* Do nothing. */
+
+ case FFEINFO_kindENTITY:
+ switch (ffesymbol_where (s))
+ {
+ case FFEINFO_whereLOCAL:
+ if (ffesymbol_equiv (s) != NULL)
+ return; /* Let ffeequiv handle this guy. */
+ if (ffesymbol_rank (s) == 0)
+ num_elements = 1;
+ else
+ {
+ if (ffebld_op (ffesymbol_arraysize (s))
+ != FFEBLD_opCONTER)
+ return; /* An adjustable local array, just like a dummy. */
+ num_elements
+ = ffebld_constant_integerdefault (ffebld_conter
+ (ffesymbol_arraysize (s)));
+ }
+ ffetarget_layout (ffesymbol_text (s), &alignment, &modulo,
+ &size, ffesymbol_basictype (s),
+ ffesymbol_kindtype (s), ffesymbol_size (s),
+ num_elements);
+ st = ffestorag_new (ffestorag_list_master ());
+ st->parent = NULL; /* Initializations happen at sym level. */
+ st->init = NULL;
+ st->accretion = NULL;
+ st->symbol = s;
+ st->size = size;
+ st->offset = 0;
+ st->alignment = alignment;
+ st->modulo = modulo;
+ st->type = FFESTORAG_typeLOCAL;
+ st->basic_type = ffesymbol_basictype (s);
+ st->kind_type = ffesymbol_kindtype (s);
+ st->type_symbol = s;
+ st->is_save = ffesymbol_is_save (s);
+ st->is_init = ffesymbol_is_init (s);
+ ffesymbol_set_storage (s, st);
+ if (ffesymbol_is_init (s))
+ ffecom_notify_init_symbol (s); /* Init completed before, but
+ we didn't have a storage
+ object for it; maybe back
+ end wants to see the sym
+ again now. */
+ ffesymbol_signal_unreported (s);
+ return;
+
+ case FFEINFO_whereCOMMON:
+ return; /* Allocate storage for entire common block
+ at once. */
+
+ case FFEINFO_whereDUMMY:
+ return; /* Don't do anything about dummies for now. */
+
+ case FFEINFO_whereRESULT:
+ case FFEINFO_whereIMMEDIATE:
+ case FFEINFO_whereCONSTANT:
+ case FFEINFO_whereNONE:
+ return; /* These don't get storage (esp. NONE, which
+ is UNCERTAIN). */
+
+ default:
+ assert ("bad ENTITY where" == NULL);
+ return;
+ }
+ break;
+
+ case FFEINFO_kindCOMMON:
+ assert (ffesymbol_where (s) == FFEINFO_whereLOCAL);
+ st = ffestorag_new (ffestorag_list_master ());
+ st->parent = NULL; /* Initializations happen here. */
+ st->init = NULL;
+ st->accretion = NULL;
+ st->symbol = s;
+ st->size = 0;
+ st->offset = 0;
+ st->alignment = 1;
+ st->modulo = 0;
+ st->type = FFESTORAG_typeCBLOCK;
+ if (ffesymbol_commonlist (s) != NULL)
+ {
+ var = ffebld_symter (ffebld_head (ffesymbol_commonlist (s)));
+ st->basic_type = ffesymbol_basictype (var);
+ st->kind_type = ffesymbol_kindtype (var);
+ st->type_symbol = var;
+ }
+ else
+ { /* Special case for empty common area:
+ NONE/NONE means nothing. */
+ st->basic_type = FFEINFO_basictypeNONE;
+ st->kind_type = FFEINFO_kindtypeNONE;
+ st->type_symbol = NULL;
+ }
+ st->is_save = ffesymbol_is_save (s);
+ st->is_init = ffesymbol_is_init (s);
+ if (!ffe_is_mainprog ())
+ ffeglobal_save_common (s,
+ st->is_save || ffe_is_saveall (),
+ ffesymbol_where_line (s),
+ ffesymbol_where_column (s));
+ ffesymbol_set_storage (s, st);
+
+ init = FALSE;
+ for (list = ffesymbol_commonlist (s);
+ list != NULL;
+ list = ffebld_trail (list))
+ {
+ item = ffebld_head (list);
+ assert (ffebld_op (item) == FFEBLD_opSYMTER);
+ var = ffebld_symter (item);
+ if (ffesymbol_basictype (var) == FFEINFO_basictypeANY)
+ continue; /* Ignore any symbols that have errors. */
+ if (ffesymbol_rank (var) == 0)
+ num_elements = 1;
+ else
+ num_elements = ffebld_constant_integerdefault (ffebld_conter
+ (ffesymbol_arraysize (var)));
+ ffetarget_layout (ffesymbol_text (var), &alignment, &modulo,
+ &size, ffesymbol_basictype (var),
+ ffesymbol_kindtype (var), ffesymbol_size (var),
+ num_elements);
+ pad = ffetarget_align (&st->alignment, &st->modulo, st->size,
+ alignment, modulo);
+ if (pad != 0)
+ { /* Warn about padding in the midst of a
+ common area. */
+ char padding[20];
+
+ sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
+ ffebad_start (FFEBAD_COMMON_PAD);
+ ffebad_string (padding);
+ ffebad_string (ffesymbol_text (var));
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string ((pad == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
+ ffebad_finish ();
+ }
+ stv = ffestorag_new (ffestorag_list_master ());
+ stv->parent = st; /* Initializations happen in COMMON block. */
+ stv->init = NULL;
+ stv->accretion = NULL;
+ stv->symbol = var;
+ stv->size = size;
+ if (!ffetarget_offset_add (&stv->offset, st->size, pad))
+ { /* Common block size plus pad, complain if
+ overflow. */
+ ffetarget_offset_overflow (ffesymbol_text (s));
+ }
+ if (!ffetarget_offset_add (&st->size, stv->offset, stv->size))
+ { /* Adjust size of common block, complain if
+ overflow. */
+ ffetarget_offset_overflow (ffesymbol_text (s));
+ }
+ stv->alignment = alignment;
+ stv->modulo = modulo;
+ stv->type = FFESTORAG_typeCOMMON;
+ stv->basic_type = ffesymbol_basictype (var);
+ stv->kind_type = ffesymbol_kindtype (var);
+ stv->type_symbol = var;
+ stv->is_save = st->is_save;
+ stv->is_init = st->is_init;
+ ffesymbol_set_storage (var, stv);
+ ffesymbol_signal_unreported (var);
+ ffestorag_update (st, var, ffesymbol_basictype (var),
+ ffesymbol_kindtype (var));
+ if (ffesymbol_is_init (var))
+ init = TRUE; /* Must move inits over to COMMON's
+ ffestorag. */
+ }
+ if (ffeequiv_layout_cblock (st))
+ init = TRUE;
+ ffeglobal_pad_common (s, st->modulo, ffesymbol_where_line (s),
+ ffesymbol_where_column (s));
+ if (init)
+ ffedata_gather (st); /* Gather subordinate inits into one init. */
+ ffesymbol_signal_unreported (s);
+ return;
+ }
+}
+
+/* ffestorag_new -- Create new ffestorag object, append to list
+
+ ffestorag s;
+ ffestoragList sl;
+ s = ffestorag_new(sl); */
+
+ffestorag
+ffestorag_new (ffestoragList sl)
+{
+ ffestorag s;
+
+ s = (ffestorag) malloc_new_kp (ffe_pool_program_unit (), "ffestorag",
+ sizeof (*s));
+ s->next = (ffestorag) &sl->first;
+ s->previous = sl->last;
+#ifdef FFECOM_storageHOOK
+ s->hook = FFECOM_storageNULL;
+#endif
+ s->previous->next = s;
+ sl->last = s;
+ s->equivs_.first = s->equivs_.last = (ffestorag) &s->equivs_.first;
+
+ return s;
+}
+
+/* Report info on LOCAL non-sym-assoc'ed entities if needed. */
+
+void
+ffestorag_report ()
+{
+ ffestorag s;
+
+ if (ffestorag_reported_)
+ return;
+
+ for (s = ffestorag_list_.first;
+ s != (ffestorag) &ffestorag_list_.first;
+ s = s->next)
+ {
+ if (s->symbol == NULL)
+ {
+ ffestorag_reported_ = TRUE;
+ fputs ("Storage area: ", dmpout);
+ ffestorag_dump (s);
+ fputc ('\n', dmpout);
+ }
+ }
+}
+
+/* ffestorag_update -- Update type info for ffestorag object
+
+ ffestorag s; // existing object
+ ffeinfoBasictype bt; // basic type for newly added member of object
+ ffeinfoKindtype kt; // kind type for it
+ ffestorag_update(s,bt,kt);
+
+ If the existing type for the storage object agrees with the new type
+ info, just returns. If the basic types agree but not the kind types,
+ sets the kind type for the object to NONE. If the basic types
+ disagree, sets the kind type to NONE, and the basic type to NONE if the
+ basic types both are not CHARACTER, otherwise to ANY. If the basic
+ type for the object already is NONE, it is set to ANY if the new basic
+ type is CHARACTER. Any time a transition is made to ANY and pedantic
+ mode is on, a message is issued that mixing CHARACTER and non-CHARACTER
+ stuff in the same COMMON/EQUIVALENCE is invalid. */
+
+void
+ffestorag_update (ffestorag s, ffesymbol sym, ffeinfoBasictype bt,
+ ffeinfoKindtype kt)
+{
+ if (s->basic_type == bt)
+ {
+ if (s->kind_type == kt)
+ return;
+ s->kind_type = FFEINFO_kindtypeNONE;
+ return;
+ }
+
+ switch (s->basic_type)
+ {
+ case FFEINFO_basictypeANY:
+ return; /* No need to do anything further. */
+
+ case FFEINFO_basictypeCHARACTER:
+ any: /* :::::::::::::::::::: */
+ s->basic_type = FFEINFO_basictypeANY;
+ s->kind_type = FFEINFO_kindtypeANY;
+ if (ffe_is_pedantic ())
+ {
+ ffebad_start (FFEBAD_MIXED_TYPES);
+ ffebad_string (ffesymbol_text (s->type_symbol));
+ ffebad_string (ffesymbol_text (sym));
+ ffebad_finish ();
+ }
+ return;
+
+ default:
+ if (bt == FFEINFO_basictypeCHARACTER)
+ goto any; /* :::::::::::::::::::: */
+ s->basic_type = FFEINFO_basictypeNONE;
+ s->kind_type = FFEINFO_kindtypeNONE;
+ return;
+ }
+}
+
+/* Update INIT flag for storage object.
+
+ If the INIT flag for the <s> object is already TRUE, return. Else,
+ set it to TRUE and call ffe*_update_init for all contained objects. */
+
+void
+ffestorag_update_init (ffestorag s)
+{
+ ffestorag sq;
+
+ if (s->is_init)
+ return;
+
+ s->is_init = TRUE;
+
+ if ((s->symbol != NULL)
+ && !ffesymbol_is_init (s->symbol))
+ ffesymbol_update_init (s->symbol);
+
+ if (s->parent != NULL)
+ ffestorag_update_init (s->parent);
+
+ for (sq = s->equivs_.first;
+ sq != (ffestorag) &s->equivs_.first;
+ sq = ffestorag_next_ (sq))
+ {
+ if (!sq->is_init)
+ ffestorag_update_init (sq);
+ }
+}
+
+/* Update SAVE flag for storage object.
+
+ If the SAVE flag for the <s> object is already TRUE, return. Else,
+ set it to TRUE and call ffe*_update_save for all contained objects. */
+
+void
+ffestorag_update_save (ffestorag s)
+{
+ ffestorag sq;
+
+ if (s->is_save)
+ return;
+
+ s->is_save = TRUE;
+
+ if ((s->symbol != NULL)
+ && !ffesymbol_is_save (s->symbol))
+ ffesymbol_update_save (s->symbol);
+
+ if (s->parent != NULL)
+ ffestorag_update_save (s->parent);
+
+ for (sq = s->equivs_.first;
+ sq != (ffestorag) &s->equivs_.first;
+ sq = ffestorag_next_ (sq))
+ {
+ if (!sq->is_save)
+ ffestorag_update_save (sq);
+ }
+}
diff --git a/gcc/f/storag.h b/gcc/f/storag.h
new file mode 100644
index 00000000000..89c5f95b726
--- /dev/null
+++ b/gcc/f/storag.h
@@ -0,0 +1,167 @@
+/* storag.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ storag.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_storag
+#define _H_f_storag
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFESTORAG_typeNONE,
+ FFESTORAG_typeCBLOCK, /* A COMMON block. */
+ FFESTORAG_typeCOMMON, /* A COMMON variable. */
+ FFESTORAG_typeLOCAL, /* A local entity (var/array/equivalence). */
+ FFESTORAG_typeEQUIV, /* An entity equivalenced into a COMMON/LOCAL
+ entity. */
+ FFESTORAG_type
+ } ffestoragType;
+
+/* Typedefs. */
+
+typedef struct _ffestorag_ *ffestorag;
+typedef struct _ffestorag_list_ *ffestoragList;
+typedef struct _ffestorag_list_ ffestoragList_;
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "info.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Structure definitions. */
+
+struct _ffestorag_list_
+ {
+ ffestorag first; /* First storage area in list. */
+ ffestorag last; /* Last storage area in list. */
+ };
+
+struct _ffestorag_
+ {
+ ffestorag next; /* Next storage area in list. */
+ ffestorag previous; /* Previous storage area in list. */
+ ffestorag parent; /* Parent who holds aggregate
+ initializations. */
+ ffebld init; /* Initialization expression. */
+ ffebld accretion; /* Initializations seen so far for aggregate. */
+ ffetargetOffset accretes; /* # inits needed to fill entire aggregate. */
+ ffesymbol symbol; /* NULL if typeLOCAL and non-NULL equivs
+ and the first "rooted" symbol not known. */
+ ffestoragList_ equivs_; /* NULL if typeLOCAL and not an EQUIVALENCE
+ area. */
+ ffetargetOffset size; /* Size of area. */
+ ffetargetOffset offset; /* Offset of entity within area, 0 for CBLOCK
+ and non-equivalence LOCAL, <= 0 for equivalence
+ LOCAL. */
+ ffetargetAlign alignment; /* Initial alignment for entity. */
+ ffetargetAlign modulo; /* Modulo within alignment. */
+#ifdef FFECOM_storageHOOK
+ ffecomStorage hook; /* Whatever the backend needs here. */
+#endif
+ ffestoragType type;
+ ffeinfoBasictype basic_type;/* NONE= >1 non-CHARACTER; ANY=
+ CHAR+non-CHAR. */
+ ffeinfoKindtype kind_type; /* NONE= >1 kind type or NONE/ANY basic_type. */
+ ffesymbol type_symbol; /* First symbol for basic_type/kind_type. */
+ bool is_save; /* SAVE flag set for this storage area. */
+ bool is_init; /* INIT flag set for this storage area. */
+ };
+
+/* Global objects accessed by users of this module. */
+
+extern ffestoragList_ ffestorag_list_;
+
+/* Declare functions with prototypes. */
+
+void ffestorag_drive (ffestoragList sl, void (*fn) (ffestorag mst, ffestorag st),
+ ffestorag mst);
+void ffestorag_dump (ffestorag s);
+void ffestorag_end_layout (ffesymbol s);
+void ffestorag_exec_layout (ffesymbol s);
+void ffestorag_init_2 (void);
+ffestorag ffestorag_new (ffestoragList sl);
+void ffestorag_report (void);
+void ffestorag_update (ffestorag s, ffesymbol sym, ffeinfoBasictype bt,
+ ffeinfoKindtype kt);
+void ffestorag_update_init (ffestorag s);
+void ffestorag_update_save (ffestorag s);
+
+/* Define macros. */
+
+#define ffestorag_accretes(s) ((s)->accretes)
+#define ffestorag_accretion(s) ((s)->accretion)
+#define ffestorag_alignment(s) ((s)->alignment)
+#define ffestorag_basictype(s) ((s)->basic_type)
+#define ffestorag_hook(s) ((s)->hook)
+#define ffestorag_init(s) ((s)->init)
+#define ffestorag_init_0()
+#define ffestorag_init_1()
+#define ffestorag_init_3()
+#define ffestorag_init_4()
+#define ffestorag_is_init(s) ((s)->is_init)
+#define ffestorag_is_save(s) ((s)->is_save)
+#define ffestorag_kindtype(s) ((s)->kind_type)
+#define ffestorag_list_equivs(s) (&(s)->equivs_)
+#define ffestorag_list_master() (&ffestorag_list_)
+#define ffestorag_modulo(s) ((s)->modulo)
+#define ffestorag_offset(s) ((s)->offset)
+#define ffestorag_parent(s) ((s)->parent)
+#define ffestorag_ptr_to_alignment(s) (&(s)->alignment)
+#define ffestorag_ptr_to_modulo(s) (&(s)->modulo)
+#define ffestorag_set_accretes(s,a) ((s)->accretes = (a))
+#define ffestorag_set_accretion(s,a) ((s)->accretion = (a))
+#define ffestorag_set_alignment(s,a) ((s)->alignment = (a))
+#define ffestorag_set_basictype(s,b) ((s)->basic_type = (b))
+#define ffestorag_set_hook(s,h) ((s)->hook = (h))
+#define ffestorag_set_init(s,i) ((s)->init = (i))
+#define ffestorag_set_is_init(s,in) ((s)->is_init = (in))
+#define ffestorag_set_is_save(s,sa) ((s)->is_save = (sa))
+#define ffestorag_set_kindtype(s,k) ((s)->kind_type = (k))
+#define ffestorag_set_modulo(s,m) ((s)->modulo = (m))
+#define ffestorag_set_offset(s,o) ((s)->offset = (o))
+#define ffestorag_set_parent(s,p) ((s)->parent = (p))
+#define ffestorag_set_size(s,si) ((s)->size = (si))
+#define ffestorag_set_symbol(s,sy) ((s)->symbol = (sy))
+#define ffestorag_set_type(s,t) ((s)->type = (t))
+#define ffestorag_set_typesymbol(s,sy) ((s)->type_symbol = (sy))
+#define ffestorag_size(s) ((s)->size)
+#define ffestorag_symbol(s) ((s)->symbol)
+#define ffestorag_terminate_0()
+#define ffestorag_terminate_1()
+#define ffestorag_terminate_2()
+#define ffestorag_terminate_3()
+#define ffestorag_terminate_4()
+#define ffestorag_type(s) ((s)->type)
+#define ffestorag_typesymbol(s) ((s)->type_symbol)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/stp.c b/gcc/f/stp.c
new file mode 100644
index 00000000000..1f28c2e2283
--- /dev/null
+++ b/gcc/f/stp.c
@@ -0,0 +1,59 @@
+/* stp.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Keeps track of some information needed while parsing (and usually
+ before the exact statement is not confirmed).
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "stp.h"
+
+/* Externals defined here. */
+
+union _ffestp_fileu_ ffestp_file;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
diff --git a/gcc/f/stp.h b/gcc/f/stp.h
new file mode 100644
index 00000000000..6ad9f681fe7
--- /dev/null
+++ b/gcc/f/stp.h
@@ -0,0 +1,508 @@
+/* stp.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ stp.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_stp
+#define _H_f_stp
+
+/* Simple definitions and enumerations. */
+
+enum _ffestp_acceptix_
+ {
+ FFESTP_acceptixFORMAT,
+ FFESTP_acceptix
+ };
+typedef enum _ffestp_acceptix_ ffestpAcceptIx;
+
+enum _ffestp_attrib_
+ {
+#if FFESTR_F90
+ FFESTP_attribALLOCATABLE,
+#endif
+ FFESTP_attribDIMENSION,
+ FFESTP_attribEXTERNAL,
+#if FFESTR_F90
+ FFESTP_attribINTENT,
+#endif
+ FFESTP_attribINTRINSIC,
+#if FFESTR_F90
+ FFESTP_attribOPTIONAL,
+#endif
+ FFESTP_attribPARAMETER,
+#if FFESTR_F90
+ FFESTP_attribPOINTER,
+#endif
+#if FFESTR_F90
+ FFESTP_attribPRIVATE,
+ FFESTP_attribPUBLIC,
+#endif
+ FFESTP_attribSAVE,
+#if FFESTR_F90
+ FFESTP_attribTARGET,
+#endif
+ FFESTP_attrib
+ };
+typedef enum _ffestp_attrib_ ffestpAttrib;
+
+enum _ffestp_beruix_
+ {
+ FFESTP_beruixERR,
+ FFESTP_beruixIOSTAT,
+ FFESTP_beruixUNIT,
+ FFESTP_beruix
+ };
+typedef enum _ffestp_beruix_ ffestpBeruIx;
+
+enum _ffestp_closeix_
+ {
+ FFESTP_closeixERR,
+ FFESTP_closeixIOSTAT,
+ FFESTP_closeixSTATUS,
+ FFESTP_closeixUNIT,
+ FFESTP_closeix
+ };
+typedef enum _ffestp_closeix_ ffestpCloseIx;
+
+enum _ffestp_deleteix_
+ {
+ FFESTP_deleteixERR,
+ FFESTP_deleteixIOSTAT,
+ FFESTP_deleteixREC,
+ FFESTP_deleteixUNIT,
+ FFESTP_deleteix
+ };
+typedef enum _ffestp_deleteix_ ffestpDeleteIx;
+
+enum _ffestp_findix_
+ {
+ FFESTP_findixERR,
+ FFESTP_findixIOSTAT,
+ FFESTP_findixREC,
+ FFESTP_findixUNIT,
+ FFESTP_findix
+ };
+typedef enum _ffestp_findix_ ffestpFindIx;
+
+enum _ffestp_inquireix_
+ {
+ FFESTP_inquireixACCESS,
+ FFESTP_inquireixACTION,
+ FFESTP_inquireixBLANK,
+ FFESTP_inquireixCARRIAGECONTROL,
+ FFESTP_inquireixDEFAULTFILE,
+ FFESTP_inquireixDELIM,
+ FFESTP_inquireixDIRECT,
+ FFESTP_inquireixERR,
+ FFESTP_inquireixEXIST,
+ FFESTP_inquireixFILE,
+ FFESTP_inquireixFORM,
+ FFESTP_inquireixFORMATTED,
+ FFESTP_inquireixIOLENGTH,
+ FFESTP_inquireixIOSTAT,
+ FFESTP_inquireixKEYED,
+ FFESTP_inquireixNAME,
+ FFESTP_inquireixNAMED,
+ FFESTP_inquireixNEXTREC,
+ FFESTP_inquireixNUMBER,
+ FFESTP_inquireixOPENED,
+ FFESTP_inquireixORGANIZATION,
+ FFESTP_inquireixPAD,
+ FFESTP_inquireixPOSITION,
+ FFESTP_inquireixREAD,
+ FFESTP_inquireixREADWRITE,
+ FFESTP_inquireixRECL,
+ FFESTP_inquireixRECORDTYPE,
+ FFESTP_inquireixSEQUENTIAL,
+ FFESTP_inquireixUNFORMATTED,
+ FFESTP_inquireixUNIT,
+ FFESTP_inquireixWRITE,
+ FFESTP_inquireix
+ };
+typedef enum _ffestp_inquireix_ ffestpInquireIx;
+
+enum _ffestp_openix_
+ {
+ FFESTP_openixACCESS,
+ FFESTP_openixACTION,
+ FFESTP_openixASSOCIATEVARIABLE,
+ FFESTP_openixBLANK,
+ FFESTP_openixBLOCKSIZE,
+ FFESTP_openixBUFFERCOUNT,
+ FFESTP_openixCARRIAGECONTROL,
+ FFESTP_openixDEFAULTFILE,
+ FFESTP_openixDELIM,
+ FFESTP_openixDISPOSE,
+ FFESTP_openixERR,
+ FFESTP_openixEXTENDSIZE,
+ FFESTP_openixFILE,
+ FFESTP_openixFORM,
+ FFESTP_openixINITIALSIZE,
+ FFESTP_openixIOSTAT,
+ FFESTP_openixKEY,
+ FFESTP_openixMAXREC,
+ FFESTP_openixNOSPANBLOCKS,
+ FFESTP_openixORGANIZATION,
+ FFESTP_openixPAD,
+ FFESTP_openixPOSITION,
+ FFESTP_openixREADONLY,
+ FFESTP_openixRECL,
+ FFESTP_openixRECORDTYPE,
+ FFESTP_openixSHARED,
+ FFESTP_openixSTATUS,
+ FFESTP_openixUNIT,
+ FFESTP_openixUSEROPEN,
+ FFESTP_openix
+ };
+typedef enum _ffestp_openix_ ffestpOpenIx;
+
+enum _ffestp_printix_
+ {
+ FFESTP_printixFORMAT,
+ FFESTP_printix
+ };
+typedef enum _ffestp_printix_ ffestpPrintIx;
+
+enum _ffestp_readix_
+ {
+ FFESTP_readixADVANCE,
+ FFESTP_readixEND,
+ FFESTP_readixEOR,
+ FFESTP_readixERR,
+ FFESTP_readixFORMAT, /* Or NAMELIST (use expr info to
+ distinguish). */
+ FFESTP_readixIOSTAT,
+ FFESTP_readixKEYEQ,
+ FFESTP_readixKEYGE,
+ FFESTP_readixKEYGT,
+ FFESTP_readixKEYID,
+ FFESTP_readixNULLS,
+ FFESTP_readixREC,
+ FFESTP_readixSIZE,
+ FFESTP_readixUNIT,
+ FFESTP_readix
+ };
+typedef enum _ffestp_readix_ ffestpReadIx;
+
+enum _ffestp_rewriteix_
+ {
+ FFESTP_rewriteixERR,
+ FFESTP_rewriteixFMT,
+ FFESTP_rewriteixIOSTAT,
+ FFESTP_rewriteixUNIT,
+ FFESTP_rewriteix
+ };
+typedef enum _ffestp_rewriteix_ ffestpRewriteIx;
+
+enum _ffestp_typeix_
+ {
+ FFESTP_typeixFORMAT,
+ FFESTP_typeix
+ };
+typedef enum _ffestp_typeix_ ffestpTypeIx;
+
+enum _ffestp_vxtcodeix_
+ {
+ FFESTP_vxtcodeixB,
+ FFESTP_vxtcodeixC,
+ FFESTP_vxtcodeixERR,
+ FFESTP_vxtcodeixF,
+ FFESTP_vxtcodeixIOSTAT,
+ FFESTP_vxtcodeix
+ };
+typedef enum _ffestp_vxtcodeix_ ffestpVxtcodeIx;
+
+enum _ffestp_writeix_
+ {
+ FFESTP_writeixADVANCE,
+ FFESTP_writeixEOR,
+ FFESTP_writeixERR,
+ FFESTP_writeixFORMAT, /* Or NAMELIST (use expr info to
+ distinguish). */
+ FFESTP_writeixIOSTAT,
+ FFESTP_writeixREC,
+ FFESTP_writeixUNIT,
+ FFESTP_writeix
+ };
+typedef enum _ffestp_writeix_ ffestpWriteIx;
+
+#if FFESTR_F90
+enum _ffestp_definedoperator_
+ {
+ FFESTP_definedoperatorNone, /* INTERFACE generic-name. */
+ FFESTP_definedoperatorOPERATOR, /* INTERFACE
+ OPERATOR(defined-operator). */
+ FFESTP_definedoperatorASSIGNMENT, /* INTERFACE ASSIGNMENT(=). */
+ FFESTP_definedoperatorPOWER,
+ FFESTP_definedoperatorMULT,
+ FFESTP_definedoperatorADD,
+ FFESTP_definedoperatorCONCAT,
+ FFESTP_definedoperatorDIVIDE,
+ FFESTP_definedoperatorSUBTRACT,
+ FFESTP_definedoperatorNOT,
+ FFESTP_definedoperatorAND,
+ FFESTP_definedoperatorOR,
+ FFESTP_definedoperatorEQV,
+ FFESTP_definedoperatorNEQV,
+ FFESTP_definedoperatorEQ,
+ FFESTP_definedoperatorNE,
+ FFESTP_definedoperatorLT,
+ FFESTP_definedoperatorLE,
+ FFESTP_definedoperatorGT,
+ FFESTP_definedoperatorGE,
+ FFESTP_definedoperator
+ };
+typedef enum _ffestp_definedoperator_ ffestpDefinedOperator;
+#endif
+
+enum _ffestp_dimtype_
+ {
+ FFESTP_dimtypeNONE,
+ FFESTP_dimtypeKNOWN, /* Known-bounds dimension list. */
+ FFESTP_dimtypeADJUSTABLE, /* Adjustable dimension list. */
+ FFESTP_dimtypeASSUMED, /* Assumed dimension list (known except for
+ last). */
+ FFESTP_dimtypeADJUSTABLEASSUMED, /* Both. */
+ FFESTP_dimtype
+ };
+typedef enum _ffestp_dimtype_ ffestpDimtype;
+
+enum _ffestp_formattype_
+ {
+ FFESTP_formattypeNone,
+ FFESTP_formattypeI,
+ FFESTP_formattypeB,
+ FFESTP_formattypeO,
+ FFESTP_formattypeZ,
+ FFESTP_formattypeF,
+ FFESTP_formattypeE,
+ FFESTP_formattypeEN,
+ FFESTP_formattypeG,
+ FFESTP_formattypeL,
+ FFESTP_formattypeA,
+ FFESTP_formattypeD,
+ FFESTP_formattypeQ,
+ FFESTP_formattypeDOLLAR, /* $ (V-extension). */
+ FFESTP_formattypeP,
+ FFESTP_formattypeT,
+ FFESTP_formattypeTL,
+ FFESTP_formattypeTR,
+ FFESTP_formattypeX,
+ FFESTP_formattypeS,
+ FFESTP_formattypeSP,
+ FFESTP_formattypeSS,
+ FFESTP_formattypeBN,
+ FFESTP_formattypeBZ,
+ FFESTP_formattypeH, /* Hollerith, used only for error-reporting. */
+ FFESTP_formattypeSLASH,
+ FFESTP_formattypeCOLON,
+ FFESTP_formattypeR1016, /* char-literal-constant or cHchars. */
+ FFESTP_formattypeFORMAT, /* [r](format-item-list). */
+ FFESTP_formattype
+ };
+typedef enum _ffestp_formattype_ ffestpFormatType;
+
+enum _ffestp_type_
+ {
+ FFESTP_typeNone,
+ FFESTP_typeINTEGER,
+ FFESTP_typeREAL,
+ FFESTP_typeCOMPLEX,
+ FFESTP_typeLOGICAL,
+ FFESTP_typeCHARACTER,
+ FFESTP_typeDBLPRCSN,
+ FFESTP_typeDBLCMPLX,
+ FFESTP_typeBYTE,
+ FFESTP_typeWORD,
+#if FFESTR_F90
+ FFESTP_typeTYPE,
+#endif
+ FFESTP_type
+ };
+typedef enum _ffestp_type_ ffestpType;
+
+/* Typedefs. */
+
+typedef struct _ffest_accept_stmt_ ffestpAcceptStmt;
+typedef struct _ffest_beru_stmt_ ffestpBeruStmt;
+typedef struct _ffest_close_stmt_ ffestpCloseStmt;
+typedef struct _ffest_delete_stmt_ ffestpDeleteStmt;
+typedef struct _ffestp_file ffestpFile;
+typedef struct _ffest_find_stmt_ ffestpFindStmt;
+typedef struct _ffest_inquire_stmt_ ffestpInquireStmt;
+typedef struct _ffest_open_stmt_ ffestpOpenStmt;
+typedef struct _ffest_print_stmt_ ffestpPrintStmt;
+typedef struct _ffest_read_stmt_ ffestpReadStmt;
+typedef struct _ffest_rewrite_stmt_ ffestpRewriteStmt;
+typedef struct _ffest_type_stmt_ ffestpTypeStmt;
+typedef struct _ffest_vxtcode_stmt_ ffestpVxtcodeStmt;
+typedef struct _ffest_write_stmt_ ffestpWriteStmt;
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lab.h"
+#include "lex.h"
+#include "stp.h"
+#include "stt.h"
+
+/* Structure definitions. */
+
+struct _ffestp_file
+ {
+ bool kw_or_val_present; /* If FALSE, all else is n/a. */
+ bool kw_present; /* Indicates whether kw has a token. */
+ bool value_present; /* Indicates whether value/expr are valid. */
+ bool value_is_label; /* TRUE if expr has no expression, value is
+ NUMBER. */
+ ffelexToken kw; /* The keyword, iff kw_or_val_present &&
+ kw_present. */
+ ffelexToken value; /* The value, iff kw_or_val_present &&
+ value_present. */
+ union
+ {
+ ffebld expr; /* The expr, iff kw_or_val_present &&
+ value_present && !value_is_label. */
+ ffelab label; /* The label, iff kw_or_val_present &&
+ value_present && value_is_label. */
+ }
+ u;
+ };
+
+struct _ffest_accept_stmt_
+ {
+ ffestpFile accept_spec[FFESTP_acceptix];
+ };
+
+struct _ffest_beru_stmt_
+ {
+ ffestpFile beru_spec[FFESTP_beruix];
+ };
+
+struct _ffest_close_stmt_
+ {
+ ffestpFile close_spec[FFESTP_closeix];
+ };
+
+struct _ffest_delete_stmt_
+ {
+ ffestpFile delete_spec[FFESTP_deleteix];
+ };
+
+struct _ffest_find_stmt_
+ {
+ ffestpFile find_spec[FFESTP_findix];
+ };
+
+struct _ffest_imp_list_
+ {
+ ffesttImpList next;
+ ffesttImpList previous;
+ ffelexToken first;
+ ffelexToken last; /* NULL if a single letter. */
+ };
+
+struct _ffest_inquire_stmt_
+ {
+ ffestpFile inquire_spec[FFESTP_inquireix];
+ };
+
+struct _ffest_open_stmt_
+ {
+ ffestpFile open_spec[FFESTP_openix];
+ };
+
+struct _ffest_print_stmt_
+ {
+ ffestpFile print_spec[FFESTP_printix];
+ };
+
+struct _ffest_read_stmt_
+ {
+ ffestpFile read_spec[FFESTP_readix];
+ };
+
+struct _ffest_rewrite_stmt_
+ {
+ ffestpFile rewrite_spec[FFESTP_rewriteix];
+ };
+
+struct _ffest_type_stmt_
+ {
+ ffestpFile type_spec[FFESTP_typeix];
+ };
+
+struct _ffest_vxtcode_stmt_
+ {
+ ffestpFile vxtcode_spec[FFESTP_vxtcodeix];
+ };
+
+struct _ffest_write_stmt_
+ {
+ ffestpFile write_spec[FFESTP_writeix];
+ };
+
+union _ffestp_fileu_
+ {
+ ffestpAcceptStmt accept;
+ ffestpBeruStmt beru;
+ ffestpCloseStmt close;
+ ffestpDeleteStmt delete;
+ ffestpFindStmt find;
+ ffestpInquireStmt inquire;
+ ffestpOpenStmt open;
+ ffestpPrintStmt print;
+ ffestpReadStmt read;
+ ffestpRewriteStmt rewrite;
+ ffestpTypeStmt type;
+ ffestpVxtcodeStmt vxtcode;
+ ffestpWriteStmt write;
+ };
+
+/* Global objects accessed by users of this module. */
+
+extern union _ffestp_fileu_ ffestp_file;
+
+/* Declare functions with prototypes. */
+
+
+/* Define macros. */
+
+#define ffestp_init_0()
+#define ffestp_init_1()
+#define ffestp_init_2()
+#define ffestp_init_3()
+#define ffestp_init_4()
+#define ffestp_terminate_0()
+#define ffestp_terminate_1()
+#define ffestp_terminate_2()
+#define ffestp_terminate_3()
+#define ffestp_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/str-1t.fin b/gcc/f/str-1t.fin
new file mode 100644
index 00000000000..b2c7766afc4
--- /dev/null
+++ b/gcc/f/str-1t.fin
@@ -0,0 +1,135 @@
+{
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+}
+
+FFESTR_first // // ffestrFirst ffestr_first 1 1
+;Accept ACCEPT
+;Allocatable ALLOCATABLE
+;Allocate ALLOCATE
+Assign ASSIGN
+Backspace BACKSPACE
+Block BLOCK
+BlockData BLOCKDATA
+Byte BYTE
+Call CALL
+Case CASE
+CaseDefault CASEDEFAULT
+Character CHRCTR
+Close CLOSE
+Common COMMON
+Complex CMPLX
+;Contains CONTAINS
+Continue CONTINUE
+Cycle CYCLE
+Data DATA
+;Deallocate DEALLOCATE
+Decode DECODE
+Define DEFINE
+;DefineFile DEFINEFILE
+Delete DELETE
+Dimension DIMENSION
+Do DO
+Double DBL
+DoubleComplex DBLCMPLX
+DoublePrecision DBLPRCSN
+DoWhile DOWHILE
+Else ELSE
+ElseIf ELSEIF
+;ElseWhere ELSEWHERE
+Encode ENCODE
+End END
+EndBlock ENDBLOCK
+EndBlockData ENDBLOCKDATA
+EndDo ENDDO
+EndFile ENDFILE
+EndFunction ENDFUNCTION
+EndIf ENDIF
+;EndInterface ENDINTERFACE
+;EndMap ENDMAP
+;EndModule ENDMODULE
+EndProgram ENDPROGRAM
+EndSelect ENDSELECT
+;EndStructure ENDSTRUCTURE
+EndSubroutine ENDSUBROUTINE
+;EndType ENDTYPE
+;EndUnion ENDUNION
+;EndWhere ENDWHERE
+Entry ENTRY
+Equivalence EQUIVALENCE
+Exit EXIT
+External EXTERNAL
+Find FIND
+Format FORMAT
+Function FUNCTION
+Go GO
+Goto GOTO
+If IF
+Implicit IMPLICIT
+Include INCLUDE
+Inquire INQUIRE
+Integer INTGR
+;Intent INTENT
+;Interface INTERFACE
+;InterfaceAssignment INTERFACEASSGNMNT
+;InterfaceOperator INTERFACEOPERATOR
+Intrinsic INTRINSIC
+Logical LGCL
+;Map MAP
+;Module MODULE
+;ModuleProcedure MODULEPROCEDURE
+NameList NAMELIST
+;Nullify NULLIFY
+Open OPEN
+;Optional OPTIONAL
+Parameter PARAMETER
+Pause PAUSE
+;Pointer POINTER
+Print PRINT
+;Private PRIVATE
+Program PROGRAM
+;Public PUBLIC
+Read READ
+Real REAL
+;Record RECORD
+;Recursive RECURSIVE
+;RecursiveFunction RECURSIVEFNCTN
+Return RETURN
+Rewind REWIND
+;Rewrite REWRITE
+Save SAVE
+Select SELECT
+SelectCase SELECTCASE
+;Sequence SEQUENCE
+Stop STOP
+;Structure STRUCTURE
+Subroutine SUBROUTINE
+;Target TARGET
+Then THEN
+Type TYPE
+;Union UNION
+;Unlock UNLOCK
+;Use USE
+Virtual VIRTUAL
+Volatile VOLATILE
+;Where WHERE
+Word WORD
+Write WRITE
diff --git a/gcc/f/str-2t.fin b/gcc/f/str-2t.fin
new file mode 100644
index 00000000000..c8973809af5
--- /dev/null
+++ b/gcc/f/str-2t.fin
@@ -0,0 +1,60 @@
+{
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+}
+
+FFESTR_second // // ffestrSecond ffestr_second 1 0
+;Assignment ASSIGNMENT
+Block BLOCK
+BlockData BLOCKDATA
+Byte BYTE
+Case CASE
+Character CHARACTER
+Complex COMPLEX
+Data DATA
+Default DEFAULT
+Do DO
+Double DOUBLE
+DoubleComplex DOUBLECOMPLEX
+DoublePrecision DOUBLEPRECISION
+File FILE
+Function FUNCTION
+If IF
+Integer INTEGER
+;Interface INTERFACE
+Logical LOGICAL
+;Map MAP
+;Module MODULE
+None NONE
+;Operator OPERATOR
+Precision PRECISION
+;Procedure PROCEDURE
+Program PROGRAM
+Real REAL
+Select SELECT
+;Structure STRUCTURE
+Subroutine SUBROUTINE
+To TO
+;Type TYPE
+;Union UNION
+;Where WHERE
+While WHILE
+Word WORD
diff --git a/gcc/f/str-fo.fin b/gcc/f/str-fo.fin
new file mode 100644
index 00000000000..f0475cd6c4b
--- /dev/null
+++ b/gcc/f/str-fo.fin
@@ -0,0 +1,55 @@
+{
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+}
+
+FFESTR_format // // ffestrFormat ffestr_format 0 1
+$ DOLLAR
+A A
+B B
+BN BN
+BZ BZ
+D D
+E E
+En EN
+F F
+G G
+H H
+I I
+L L
+N N
+O O
+P P
+PD PD
+PE PE
+PEn PEN
+PF PF
+PG PG
+Q Q
+R R
+S S
+SP SP
+SS SS
+T T
+TL TL
+TR TR
+X X
+Z Z
diff --git a/gcc/f/str-io.fin b/gcc/f/str-io.fin
new file mode 100644
index 00000000000..12066a59c0d
--- /dev/null
+++ b/gcc/f/str-io.fin
@@ -0,0 +1,43 @@
+{
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+}
+
+FFESTR_genio // // ffestrGenio ffestr_genio 1 0
+Advance ADVANCE
+Disp DISP
+Dispose DISPOSE
+End END
+EoR EOR
+Err ERR
+Fmt FMT
+IOStat IOSTAT
+Key KEY
+KeyEQ KEYEQ
+KeyGE KEYGE
+KeyGT KEYGT
+KeyID KEYID
+Nml NML
+Nulls NULLS
+Rec REC
+Size SIZE
+Status STATUS
+Unit UNIT
diff --git a/gcc/f/str-nq.fin b/gcc/f/str-nq.fin
new file mode 100644
index 00000000000..ef4729e0339
--- /dev/null
+++ b/gcc/f/str-nq.fin
@@ -0,0 +1,55 @@
+{
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+}
+
+FFESTR_inquire // // ffestrInquire ffestr_inquire 1 0
+Access ACCESS
+Action ACTION
+Blank BLANK
+CarriageControl CARRIAGECONTROL
+DefaultFile DEFAULTFILE
+Delim DELIM
+Direct DIRECT
+Err ERR
+Exist EXIST
+File FILE
+Form FORM
+Formatted FORMATTED
+IOLength IOLENGTH
+IOStat IOSTAT
+Keyed KEYED
+Name NAME
+Named NAMED
+NextRec NEXTREC
+Number NUMBER
+Opened OPENED
+Organization ORGANIZATION
+Pad PAD
+Position POSITION
+Read READ
+ReadWrite READWRITE
+RecL RECL
+RecordType RECORDTYPE
+Sequential SEQUENTIAL
+Unformatted UNFORMATTED
+Unit UNIT
+Write WRITE
diff --git a/gcc/f/str-op.fin b/gcc/f/str-op.fin
new file mode 100644
index 00000000000..161a6486187
--- /dev/null
+++ b/gcc/f/str-op.fin
@@ -0,0 +1,57 @@
+{
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+}
+
+FFESTR_open // // ffestrOpen ffestr_open 1 0
+Access ACCESS
+Action ACTION
+AssociateVariable ASSOCIATEVARIABLE
+Blank BLANK
+BlockSize BLOCKSIZE
+BufferCount BUFFERCOUNT
+CarriageControl CARRIAGECONTROL
+DefaultFile DEFAULTFILE
+Delim DELIM
+Disp DISP
+Dispose DISPOSE
+Err ERR
+ExtendSize EXTENDSIZE
+File FILE
+Form FORM
+InitialSize INITIALSIZE
+IOStat IOSTAT
+Key KEY
+MaxRec MAXREC
+Name NAME
+NoSpanBlocks NOSPANBLOCKS
+Organization ORGANIZATION
+Pad PAD
+Position POSITION
+Readonly READONLY
+Recl RECL
+RecordSize RECORDSIZE
+RecordType RECORDTYPE
+Shared SHARED
+Status STATUS
+Type TYPE
+Unit UNIT
+UserOpen USEROPEN
diff --git a/gcc/f/str-ot.fin b/gcc/f/str-ot.fin
new file mode 100644
index 00000000000..107d0bb50cf
--- /dev/null
+++ b/gcc/f/str-ot.fin
@@ -0,0 +1,47 @@
+{
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+}
+
+FFESTR_other // // ffestrOther ffestr_other 1 1
+;And AND
+;Dimension DIMENSION
+;Eq EQ
+;Eqv EQV
+;Ge GE
+;Gt GT
+In IN
+InOut INOUT
+Kind KIND
+;Le LE
+Len LEN
+;Lt LT
+;Ne NE
+;Neqv NEQV
+;Not NOT
+;Only ONLY
+;Or OR
+Out OUT
+;Pointer POINTER
+;Private PRIVATE
+;Public PUBLIC
+Result RESULT
+;Stat STAT
diff --git a/gcc/f/str.c b/gcc/f/str.c
new file mode 100644
index 00000000000..3fa6b86200e
--- /dev/null
+++ b/gcc/f/str.c
@@ -0,0 +1,217 @@
+/* str.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Handles recognition of keywords.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "src.h"
+#include "str.h"
+#include "lex.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffestr_first -- Look up the first names in a statement
+
+ ffestrFirst kw;
+ ffelexToken t;
+ kw = ffestr_first(t);
+
+ Returns FFESTR_firstNone if no matches, else FFESTR_firstXYZ if the
+ NAME or NAMES token matches XYZ. t must be a NAME or NAMES token or this
+ routine will crash.
+
+ This routine's code is actually written by a utility called FINI, itself
+ written specifically for the Gnu Fortran project. FINI takes an input
+ file, in this case "ffe_first.fini", consisting primarily of a
+ list of statements (ASSIGN, IF, DO, DOWHILE), and outputs a C file,
+ "str-1t.j", that contains the definition of the
+ ffestr_first function. We #include that file here.
+
+ 30-Jan-90 JCB 2.0
+ Updated for Fortran 90.
+*/
+
+#ifndef MAKING_DEPENDENCIES
+#include "str-1t.j"
+#endif
+/* ffestr_format -- Look up format names in a statement
+
+ ffestrFormat kw;
+ ffelexToken t;
+ kw = ffestr_format(t);
+
+ Returns FFESTR_formatNone if no matches, else FFESTR_formatXYZ if the
+ NAME or NAMES token matches XYZ. t must be a NAME or NAMES token or this
+ routine will crash.
+
+ This routine's code is actually written by a utility called FINI, itself
+ written specifically for the Gnu Fortran project. FINI takes an input
+ file, in this case "ffe_format.fini", consisting primarily of a
+ list of format keywords (I, F, TL, TR), and outputs a C file,
+ "str-fo.j", that contains the definition of the
+ ffestr_format function. We #include that file here.
+
+*/
+
+#ifndef MAKING_DEPENDENCIES
+#include "str-fo.j"
+#endif
+/* ffestr_genio -- Look up genio names in a statement
+
+ ffestrGenio kw;
+ ffelexToken t;
+ kw = ffestr_genio(t);
+
+ Returns FFESTR_genioNone if no matches, else FFESTR_genioXYZ if the
+ NAME or NAMES token matches XYZ. t must be a NAME or NAMES token or this
+ routine will crash.
+
+ This routine's code is actually written by a utility called FINI, itself
+ written specifically for the Gnu Fortran project. FINI takes an input
+ file, in this case "ffe_genio.fini", consisting primarily of a
+ list of statement keywords (TO, FUNCTION), and outputs a C file,
+ "str-io.j", that contains the definition of the
+ ffestr_genio function. We #include that file here.
+
+*/
+
+#ifndef MAKING_DEPENDENCIES
+#include "str-io.j"
+#endif
+/* ffestr_inquire -- Look up inquire names in a statement
+
+ ffestrInquire kw;
+ ffelexToken t;
+ kw = ffestr_inquire(t);
+
+ Returns FFESTR_inquireNone if no matches, else FFESTR_inquireXYZ if the
+ NAME or NAMES token matches XYZ. t must be a NAME or NAMES token or this
+ routine will crash.
+
+ This routine's code is actually written by a utility called FINI, itself
+ written specifically for the Gnu Fortran project. FINI takes an input
+ file, in this case "ffe_inquire.fini", consisting primarily of a
+ list of statement keywords (TO, FUNCTION), and outputs a C file,
+ "str-nq.j", that contains the definition of the
+ ffestr_inquire function. We #include that file here.
+
+*/
+
+#ifndef MAKING_DEPENDENCIES
+#include "str-nq.j"
+#endif
+/* ffestr_open -- Look up open names in a statement
+
+ ffestrOpen kw;
+ ffelexToken t;
+ kw = ffestr_open(t);
+
+ Returns FFESTR_openNone if no matches, else FFESTR_openXYZ if the
+ NAME or NAMES token matches XYZ. t must be a NAME or NAMES token or this
+ routine will crash.
+
+ This routine's code is actually written by a utility called FINI, itself
+ written specifically for the Gnu Fortran project. FINI takes an input
+ file, in this case "ffe_open.fini", consisting primarily of a
+ list of statement keywords (TO, FUNCTION), and outputs a C file,
+ "str-op.j", that contains the definition of the
+ ffestr_open function. We #include that file here.
+
+*/
+
+#ifndef MAKING_DEPENDENCIES
+#include "str-op.j"
+#endif
+/* ffestr_other -- Look up other names in a statement
+
+ ffestrOther kw;
+ ffelexToken t;
+ kw = ffestr_other(t);
+
+ Returns FFESTR_otherNone if no matches, else FFESTR_otherXYZ if the
+ NAME or NAMES token matches XYZ. t must be a NAME or NAMES token or this
+ routine will crash.
+
+ This routine's code is actually written by a utility called FINI, itself
+ written specifically for the Gnu Fortran project. FINI takes an input
+ file, in this case "ffe_other.fini", consisting primarily of a
+ list of statement keywords (TO, FUNCTION), and outputs a C file,
+ "str-ot.j", that contains the definition of the
+ ffestr_other function. We #include that file here.
+
+*/
+
+#ifndef MAKING_DEPENDENCIES
+#include "str-ot.j"
+#endif
+/* ffestr_second -- Look up the second name in a statement
+
+ ffestrSecond kw;
+ ffelexToken t;
+ kw = ffestr_second(t);
+
+ Returns FFESTR_secondNone if no matches, else FFESTR_secondXYZ if the
+ NAME or NAMES token matches XYZ. t must be a NAME or NAMES token or this
+ routine will crash.
+
+ This routine's code is actually written by a utility called FINI, itself
+ written specifically for the Gnu Fortran project. FINI takes an input
+ file, in this case "ffe_second.fini", consisting primarily of a
+ list of statement keywords (TO, FUNCTION), and outputs a C file,
+ "str-2t.j", that contains the definition of the
+ ffestr_second function. We #include that file here.
+
+*/
+
+#ifndef MAKING_DEPENDENCIES
+#include "str-2t.j"
+#endif
diff --git a/gcc/f/str.h b/gcc/f/str.h
new file mode 100644
index 00000000000..84def9a79af
--- /dev/null
+++ b/gcc/f/str.h
@@ -0,0 +1,85 @@
+/* str.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ str.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_str
+#define _H_f_str
+
+/* Simple definitions and enumerations. */
+
+#define FFESTR_F90 0 /* Unsupported F90 stuff. */
+#define FFESTR_VXT 0 /* Unsupported VXT stuff. */
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "lex.h"
+#ifndef MAKING_DEPENDENCIES
+#include "str-1t.h"
+#include "str-fo.h"
+#include "str-io.h"
+#include "str-nq.h"
+#include "str-ot.h"
+#include "str-op.h"
+#include "str-2t.h"
+#endif
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+ffestrFirst ffestr_first (ffelexToken t);
+ffestrFormat ffestr_format (ffelexToken t);
+ffestrGenio ffestr_genio (ffelexToken t);
+ffestrInquire ffestr_inquire (ffelexToken t);
+ffestrOpen ffestr_open (ffelexToken t);
+ffestrOther ffestr_other (ffelexToken t);
+ffestrSecond ffestr_second (ffelexToken t);
+
+/* Define macros. */
+
+#define ffestr_init_0()
+#define ffestr_init_1()
+#define ffestr_init_2()
+#define ffestr_init_3()
+#define ffestr_init_4()
+#define ffestr_terminate_0()
+#define ffestr_terminate_1()
+#define ffestr_terminate_2()
+#define ffestr_terminate_3()
+#define ffestr_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/sts.c b/gcc/f/sts.c
new file mode 100644
index 00000000000..769712c1da1
--- /dev/null
+++ b/gcc/f/sts.c
@@ -0,0 +1,271 @@
+/* sts.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None (despite the name, it doesn't really depend on ffest*)
+
+ Description:
+ Provides an arbitrary-length string facility for the limited needs of
+ GNU Fortran FORMAT statement generation.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "sts.h"
+#include "com.h"
+#include "malloc.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffests_kill -- Kill a varying-length string
+
+ ffests s;
+ ffests_kill(s);
+
+ The storage associated with the string <s> is freed. */
+
+void
+ffests_kill (ffests s)
+{
+ if (s->text_ != NULL)
+ malloc_kill_ksr (s->pool_, s->text_, s->max_);
+}
+
+/* ffests_new -- Make a varying-length string
+
+ ffests s;
+ ffests_new(s,malloc_pool_image(),0);
+
+ The string is initialized to hold, in this case, 0 characters, and
+ current and future heap manipulations to hold the string will use
+ the image pool. */
+
+void
+ffests_new (ffests s, mallocPool pool, ffestsLength size)
+{
+ s->pool_ = pool;
+ s->len_ = 0;
+ s->max_ = size;
+
+ if (size == 0)
+ s->text_ = NULL;
+ else
+ s->text_ = malloc_new_ksr (pool, "ffests", size);
+}
+
+/* ffests_printf_1D -- printf("...%ld...",(long)) to a string
+
+ ffests s;
+ ffests_printf_1D(s,"...%ld...",1);
+
+ Like printf, but into a string. */
+
+void
+ffests_printf_1D (ffests s, char *ctl, long arg1)
+{
+ char quickbuf[40];
+ char *buff;
+ ffestsLength len;
+
+ if ((len = strlen (ctl) + 21) < ARRAY_SIZE (quickbuf))
+ /* No # bigger than 20 digits. */
+ {
+ sprintf (&quickbuf[0], ctl, arg1);
+ ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
+ }
+ else
+ {
+ buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1D", len);
+ sprintf (buff, ctl, arg1);
+ ffests_puttext (s, buff, strlen (buff));
+ malloc_kill_ks (malloc_pool_image (), buff, len);
+ }
+}
+
+/* ffests_printf_1U -- printf("...%lu...",(unsigned long)) to a string
+
+ ffests s;
+ ffests_printf_1U(s,"...%lu...",1);
+
+ Like printf, but into a string. */
+
+void
+ffests_printf_1U (ffests s, char *ctl, unsigned long arg1)
+{
+ char quickbuf[40];
+ char *buff;
+ ffestsLength len;
+
+ if ((len = strlen (ctl) + 21) < ARRAY_SIZE (quickbuf))
+ /* No # bigger than 20 digits. */
+ {
+ sprintf (&quickbuf[0], ctl, arg1);
+ ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
+ }
+ else
+ {
+ buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1U", len);
+ sprintf (buff, ctl, arg1);
+ ffests_puttext (s, buff, strlen (buff));
+ malloc_kill_ks (malloc_pool_image (), buff, len);
+ }
+}
+
+/* ffests_printf_1s -- printf("...%s...",(char *)) to a string
+
+ ffests s;
+ ffests_printf_1s(s,"...%s...","hi there!");
+
+ Like printf, but into a string. */
+
+void
+ffests_printf_1s (ffests s, char *ctl, char *arg1)
+{
+ char quickbuf[40];
+ char *buff;
+ ffestsLength len;
+
+ if ((len = strlen (ctl) + strlen (arg1) - 1) < ARRAY_SIZE (quickbuf))
+ {
+ sprintf (&quickbuf[0], ctl, arg1);
+ ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
+ }
+ else
+ {
+ buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1s", len);
+ sprintf (buff, ctl, arg1);
+ ffests_puttext (s, buff, strlen (buff));
+ malloc_kill_ks (malloc_pool_image (), buff, len);
+ }
+}
+
+/* ffests_printf_2Us -- printf("...%lu...%s...",...) to a string
+
+ ffests s;
+ ffests_printf_2Us(s,"...%lu...%s...",1,"hi there!");
+
+ Like printf, but into a string. */
+
+void
+ffests_printf_2Us (ffests s, char *ctl, unsigned long arg1, char *arg2)
+{
+ char quickbuf[60];
+ char *buff;
+ ffestsLength len;
+
+ if ((len = strlen (ctl) + 21 + strlen (arg2) - 1) < ARRAY_SIZE (quickbuf))
+ /* No # bigger than 20 digits. */
+ {
+ sprintf (&quickbuf[0], ctl, arg1, arg2);
+ ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
+ }
+ else
+ {
+ buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_2Us", len);
+ sprintf (buff, ctl, arg1, arg2);
+ ffests_puttext (s, buff, strlen (buff));
+ malloc_kill_ks (malloc_pool_image (), buff, len);
+ }
+}
+
+/* ffests_putc -- Put a single character into string
+
+ ffests s;
+ ffests_putc(s,'*'); */
+
+void
+ffests_putc (ffests s, char c)
+{
+ ffests_puttext (s, &c, 1);
+}
+
+/* ffests_puts -- Put a zero-terminated (C-style) string into string
+
+ ffests s;
+ ffests_puts(s,"append me"); */
+
+void
+ffests_puts (ffests s, char *string)
+{
+ ffests_puttext (s, string, strlen (string));
+}
+
+/* ffests_puttext -- Put a number of characters into string
+
+ ffests s;
+ ffests_puttext(s,"hi there",8);
+
+ The string need not be 0-terminated, because the passed length is used,
+ and may be 0. */
+
+void
+ffests_puttext (ffests s, char *text, ffestsLength length)
+{
+ ffestsLength newlen;
+ ffestsLength newmax;
+
+ if (length <= 0)
+ return;
+
+ newlen = s->len_ + length;
+ if (newlen > s->max_)
+ if (s->text_ == NULL)
+ {
+ s->max_ = 40;
+ s->text_ = malloc_new_ksr (s->pool_, "ffests", s->max_);
+ }
+ else
+ {
+ newmax = s->max_ << 1;
+ while (newmax < newlen)
+ newmax <<= 1;
+ s->text_ = malloc_resize_ksr (s->pool_, s->text_, newmax, s->max_);
+ s->max_ = newmax;
+ }
+
+ memcpy (s->text_ + s->len_, text, length);
+ s->len_ = newlen;
+}
diff --git a/gcc/f/sts.h b/gcc/f/sts.h
new file mode 100644
index 00000000000..c8141fe01fb
--- /dev/null
+++ b/gcc/f/sts.h
@@ -0,0 +1,89 @@
+/* sts.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ sts.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_sts
+#define _H_f_sts
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+typedef struct _ffests_ *ffests;
+typedef struct _ffests_ ffestsHolder;
+typedef unsigned long int ffestsLength;
+
+/* Include files needed by this one. */
+
+#include "malloc.h"
+
+/* Structure definitions. */
+
+struct _ffests_
+ {
+ char *text_;
+ mallocPool pool_;
+ ffestsLength len_;
+ ffestsLength max_;
+ };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffests_kill (ffests s);
+void ffests_new (ffests s, mallocPool pool, ffestsLength size);
+void ffests_printf_1D (ffests s, char *ctl, long arg1);
+void ffests_printf_1U (ffests s, char *ctl, unsigned long arg1);
+void ffests_printf_1s (ffests s, char *ctl, char *arg1);
+void ffests_printf_2Us (ffests s, char *ctl, unsigned long arg1,
+ char *arg2);
+void ffests_putc (ffests s, char c);
+void ffests_puts (ffests s, char *string);
+void ffests_puttext (ffests s, char *text, ffestsLength length);
+
+/* Define macros. */
+
+#define ffests_init_0()
+#define ffests_init_1()
+#define ffests_init_2()
+#define ffests_init_3()
+#define ffests_init_4()
+#define ffests_length(s) ((s)->len_)
+#define ffests_terminate_0()
+#define ffests_terminate_1()
+#define ffests_terminate_2()
+#define ffests_terminate_3()
+#define ffests_terminate_4()
+#define ffests_text(s) ((s)->text_)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/stt.c b/gcc/f/stt.c
new file mode 100644
index 00000000000..d0fd582355b
--- /dev/null
+++ b/gcc/f/stt.c
@@ -0,0 +1,1034 @@
+/* stt.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Manages lists of tokens and related info for parsing.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "stt.h"
+#include "bld.h"
+#include "expr.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "sta.h"
+#include "stp.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffestt_caselist_append -- Append case to list of cases
+
+ ffesttCaseList list;
+ ffelexToken t;
+ ffestt_caselist_append(list,range,case1,case2,t);
+
+ list must have already been created by ffestt_caselist_create. The
+ list is allocated out of the scratch pool. The token is consumed. */
+
+void
+ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1,
+ ffebld case2, ffelexToken t)
+{
+ ffesttCaseList new;
+
+ new = (ffesttCaseList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST case list", sizeof (*new));
+ new->next = list->previous->next;
+ new->previous = list->previous;
+ new->next->previous = new;
+ new->previous->next = new;
+ new->expr1 = case1;
+ new->expr2 = case2;
+ new->range = range;
+ new->t = t;
+}
+
+/* ffestt_caselist_create -- Create new list of cases
+
+ ffesttCaseList list;
+ list = ffestt_caselist_create();
+
+ The list is allocated out of the scratch pool. */
+
+ffesttCaseList
+ffestt_caselist_create ()
+{
+ ffesttCaseList new;
+
+ new = (ffesttCaseList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST case list root",
+ sizeof (*new));
+ new->next = new->previous = new;
+ new->t = NULL;
+ new->expr1 = NULL;
+ new->expr2 = NULL;
+ new->range = FALSE;
+ return new;
+}
+
+/* ffestt_caselist_dump -- Dump list of cases
+
+ ffesttCaseList list;
+ ffestt_caselist_dump(list);
+
+ The cases in the list are dumped with commas separating them. */
+
+void
+ffestt_caselist_dump (ffesttCaseList list)
+{
+ ffesttCaseList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ if (next != list->next)
+ fputc (',', dmpout);
+ if (next->expr1 != NULL)
+ ffebld_dump (next->expr1);
+ if (next->range)
+ {
+ fputc (':', dmpout);
+ if (next->expr2 != NULL)
+ ffebld_dump (next->expr2);
+ }
+ }
+}
+
+/* ffestt_caselist_kill -- Kill list of cases
+
+ ffesttCaseList list;
+ ffestt_caselist_kill(list);
+
+ The tokens on the list are killed.
+
+ 02-Mar-90 JCB 1.1
+ Don't kill the list itself or change it, since it will be trashed when
+ ffesta_scratch_pool is killed anyway, so kill only the lex tokens. */
+
+void
+ffestt_caselist_kill (ffesttCaseList list)
+{
+ ffesttCaseList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ ffelex_token_kill (next->t);
+ }
+}
+
+/* ffestt_dimlist_append -- Append dim to list of dims
+
+ ffesttDimList list;
+ ffelexToken t;
+ ffestt_dimlist_append(list,lower,upper,t);
+
+ list must have already been created by ffestt_dimlist_create. The
+ list is allocated out of the scratch pool. The token is consumed. */
+
+void
+ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper,
+ ffelexToken t)
+{
+ ffesttDimList new;
+
+ new = (ffesttDimList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST dim list", sizeof (*new));
+ new->next = list->previous->next;
+ new->previous = list->previous;
+ new->next->previous = new;
+ new->previous->next = new;
+ new->lower = lower;
+ new->upper = upper;
+ new->t = t;
+}
+
+/* Convert list of dims into ffebld format.
+
+ ffesttDimList list;
+ ffeinfoRank rank;
+ ffebld array_size;
+ ffebld extents;
+ ffestt_dimlist_as_expr (list, &rank, &array_size, &extents);
+
+ The dims in the list are converted to a list of ITEMs; the rank of the
+ array, an expression representing the array size, a list of extent
+ expressions, and the list of ITEMs are returned.
+
+ If is_ugly_assumed, treat a final dimension with no lower bound
+ and an upper bound of 1 as a * bound. */
+
+ffebld
+ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank,
+ ffebld *array_size, ffebld *extents,
+ bool is_ugly_assumed)
+{
+ ffesttDimList next;
+ ffebld expr;
+ ffebld as;
+ ffebld ex; /* List of extents. */
+ ffebld ext; /* Extent of a given dimension. */
+ ffebldListBottom bottom;
+ ffeinfoRank r;
+ ffeinfoKindtype nkt;
+ ffetargetIntegerDefault low;
+ ffetargetIntegerDefault high;
+ bool zero = FALSE; /* Zero-size array. */
+ bool any = FALSE;
+ bool star = FALSE; /* Adjustable array. */
+
+ assert (list != NULL);
+
+ r = 0;
+ ffebld_init_list (&expr, &bottom);
+ for (next = list->next; next != list; next = next->next)
+ {
+ ++r;
+ if (((next->lower == NULL)
+ || (ffebld_op (next->lower) == FFEBLD_opCONTER))
+ && (ffebld_op (next->upper) == FFEBLD_opCONTER))
+ {
+ if (next->lower == NULL)
+ low = 1;
+ else
+ low = ffebld_constant_integerdefault (ffebld_conter (next->lower));
+ high = ffebld_constant_integerdefault (ffebld_conter (next->upper));
+ if (low
+ > high)
+ zero = TRUE;
+ if ((next->next == list)
+ && is_ugly_assumed
+ && (next->lower == NULL)
+ && (high == 1)
+ && (ffebld_conter_orig (next->upper) == NULL))
+ {
+ star = TRUE;
+ ffebld_append_item (&bottom,
+ ffebld_new_bounds (NULL, ffebld_new_star ()));
+ continue;
+ }
+ }
+ else if (((next->lower != NULL)
+ && (ffebld_op (next->lower) == FFEBLD_opANY))
+ || (ffebld_op (next->upper) == FFEBLD_opANY))
+ any = TRUE;
+ else if (ffebld_op (next->upper) == FFEBLD_opSTAR)
+ star = TRUE;
+ ffebld_append_item (&bottom,
+ ffebld_new_bounds (next->lower, next->upper));
+ }
+ ffebld_end_list (&bottom);
+
+ if (zero)
+ {
+ as = ffebld_new_conter (ffebld_constant_new_integerdefault_val (0));
+ ffebld_set_info (as, ffeinfo_new
+ (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ ex = NULL;
+ }
+ else if (any)
+ {
+ as = ffebld_new_any ();
+ ffebld_set_info (as, ffeinfo_new_any ());
+ ex = ffebld_copy (as);
+ }
+ else if (star)
+ {
+ as = ffebld_new_star ();
+ ex = ffebld_new_star (); /* ~~Should really be list as below. */
+ }
+ else
+ {
+ as = NULL;
+ ffebld_init_list (&ex, &bottom);
+ for (next = list->next; next != list; next = next->next)
+ {
+ if ((next->lower == NULL)
+ || ((ffebld_op (next->lower) == FFEBLD_opCONTER)
+ && (ffebld_constant_integerdefault (ffebld_conter
+ (next->lower)) == 1)))
+ ext = ffebld_copy (next->upper);
+ else
+ {
+ ext = ffebld_new_subtract (next->upper, next->lower);
+ nkt
+ = ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
+ ffeinfo_kindtype (ffebld_info
+ (next->lower)),
+ ffeinfo_kindtype (ffebld_info
+ (next->upper)));
+ ffebld_set_info (ext,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ nkt,
+ 0,
+ FFEINFO_kindENTITY,
+ ((ffebld_op (ffebld_left (ext))
+ == FFEBLD_opCONTER)
+ && (ffebld_op (ffebld_right
+ (ext))
+ == FFEBLD_opCONTER))
+ ? FFEINFO_whereCONSTANT
+ : FFEINFO_whereFLEETING,
+ FFETARGET_charactersizeNONE));
+ ffebld_set_left (ext,
+ ffeexpr_convert_expr (ffebld_left (ext),
+ next->t, ext, next->t,
+ FFEEXPR_contextLET));
+ ffebld_set_right (ext,
+ ffeexpr_convert_expr (ffebld_right (ext),
+ next->t, ext,
+ next->t,
+ FFEEXPR_contextLET));
+ ext = ffeexpr_collapse_subtract (ext, next->t);
+
+ nkt
+ = ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
+ ffeinfo_kindtype (ffebld_info (ext)),
+ FFEINFO_kindtypeINTEGERDEFAULT);
+ ext
+ = ffebld_new_add (ext,
+ ffebld_new_conter
+ (ffebld_constant_new_integerdefault_val
+ (1)));
+ ffebld_set_info (ffebld_right (ext), ffeinfo_new
+ (FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT,
+ 0,
+ FFEINFO_kindENTITY,
+ FFEINFO_whereCONSTANT,
+ FFETARGET_charactersizeNONE));
+ ffebld_set_info (ext,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ nkt, 0, FFEINFO_kindENTITY,
+ (ffebld_op (ffebld_left (ext))
+ == FFEBLD_opCONTER)
+ ? FFEINFO_whereCONSTANT
+ : FFEINFO_whereFLEETING,
+ FFETARGET_charactersizeNONE));
+ ffebld_set_left (ext,
+ ffeexpr_convert_expr (ffebld_left (ext),
+ next->t, ext,
+ next->t,
+ FFEEXPR_contextLET));
+ ffebld_set_right (ext,
+ ffeexpr_convert_expr (ffebld_right (ext),
+ next->t, ext,
+ next->t,
+ FFEEXPR_contextLET));
+ ext = ffeexpr_collapse_add (ext, next->t);
+ }
+ ffebld_append_item (&bottom, ext);
+ if (as == NULL)
+ as = ext;
+ else
+ {
+ nkt
+ = ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
+ ffeinfo_kindtype (ffebld_info (as)),
+ ffeinfo_kindtype (ffebld_info (ext)));
+ as = ffebld_new_multiply (as, ext);
+ ffebld_set_info (as,
+ ffeinfo_new (FFEINFO_basictypeINTEGER,
+ nkt, 0, FFEINFO_kindENTITY,
+ ((ffebld_op (ffebld_left (as))
+ == FFEBLD_opCONTER)
+ && (ffebld_op (ffebld_right
+ (as))
+ == FFEBLD_opCONTER))
+ ? FFEINFO_whereCONSTANT
+ : FFEINFO_whereFLEETING,
+ FFETARGET_charactersizeNONE));
+ ffebld_set_left (as,
+ ffeexpr_convert_expr (ffebld_left (as),
+ next->t, as, next->t,
+ FFEEXPR_contextLET));
+ ffebld_set_right (as,
+ ffeexpr_convert_expr (ffebld_right (as),
+ next->t, as,
+ next->t,
+ FFEEXPR_contextLET));
+ as = ffeexpr_collapse_multiply (as, next->t);
+ }
+ }
+ ffebld_end_list (&bottom);
+ as = ffeexpr_convert (as, list->next->t, NULL,
+ FFEINFO_basictypeINTEGER,
+ FFEINFO_kindtypeINTEGERDEFAULT, 0,
+ FFETARGET_charactersizeNONE,
+ FFEEXPR_contextLET);
+ }
+
+ *rank = r;
+ *array_size = as;
+ *extents = ex;
+ return expr;
+}
+
+/* ffestt_dimlist_create -- Create new list of dims
+
+ ffesttDimList list;
+ list = ffestt_dimlist_create();
+
+ The list is allocated out of the scratch pool. */
+
+ffesttDimList
+ffestt_dimlist_create ()
+{
+ ffesttDimList new;
+
+ new = (ffesttDimList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST dim list root", sizeof (*new));
+ new->next = new->previous = new;
+ new->t = NULL;
+ new->lower = NULL;
+ new->upper = NULL;
+ return new;
+}
+
+/* ffestt_dimlist_dump -- Dump list of dims
+
+ ffesttDimList list;
+ ffestt_dimlist_dump(list);
+
+ The dims in the list are dumped with commas separating them. */
+
+void
+ffestt_dimlist_dump (ffesttDimList list)
+{
+ ffesttDimList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ if (next != list->next)
+ fputc (',', dmpout);
+ if (next->lower != NULL)
+ ffebld_dump (next->lower);
+ fputc (':', dmpout);
+ if (next->upper != NULL)
+ ffebld_dump (next->upper);
+ }
+}
+
+/* ffestt_dimlist_kill -- Kill list of dims
+
+ ffesttDimList list;
+ ffestt_dimlist_kill(list);
+
+ The tokens on the list are killed. */
+
+void
+ffestt_dimlist_kill (ffesttDimList list)
+{
+ ffesttDimList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ ffelex_token_kill (next->t);
+ }
+}
+
+/* Determine type of list of dimensions.
+
+ Return KNOWN for all-constant bounds, ADJUSTABLE for constant
+ and variable but no * bounds, ASSUMED for constant and * but
+ not variable bounds, ADJUSTABLEASSUMED for constant and variable
+ and * bounds.
+
+ If is_ugly_assumed, treat a final dimension with no lower bound
+ and an upper bound of 1 as a * bound. */
+
+ffestpDimtype
+ffestt_dimlist_type (ffesttDimList list, bool is_ugly_assumed)
+{
+ ffesttDimList next;
+ ffestpDimtype type;
+
+ if (list == NULL)
+ return FFESTP_dimtypeNONE;
+
+ type = FFESTP_dimtypeKNOWN;
+ for (next = list->next; next != list; next = next->next)
+ {
+ bool ugly_assumed = FALSE;
+
+ if ((next->next == list)
+ && is_ugly_assumed
+ && (next->lower == NULL)
+ && (next->upper != NULL)
+ && (ffebld_op (next->upper) == FFEBLD_opCONTER)
+ && (ffebld_constant_integerdefault (ffebld_conter (next->upper))
+ == 1)
+ && (ffebld_conter_orig (next->upper) == NULL))
+ ugly_assumed = TRUE;
+
+ if (next->lower != NULL)
+ {
+ if (ffebld_op (next->lower) != FFEBLD_opCONTER)
+ {
+ if (type == FFESTP_dimtypeASSUMED)
+ type = FFESTP_dimtypeADJUSTABLEASSUMED;
+ else
+ type = FFESTP_dimtypeADJUSTABLE;
+ }
+ }
+ if (next->upper != NULL)
+ {
+ if (ugly_assumed
+ || (ffebld_op (next->upper) == FFEBLD_opSTAR))
+ {
+ if (type == FFESTP_dimtypeADJUSTABLE)
+ type = FFESTP_dimtypeADJUSTABLEASSUMED;
+ else
+ type = FFESTP_dimtypeASSUMED;
+ }
+ else if (ffebld_op (next->upper) != FFEBLD_opCONTER)
+ type = FFESTP_dimtypeADJUSTABLE;
+ }
+ }
+
+ return type;
+}
+
+/* ffestt_exprlist_append -- Append expr to list of exprs
+
+ ffesttExprList list;
+ ffelexToken t;
+ ffestt_exprlist_append(list,expr,t);
+
+ list must have already been created by ffestt_exprlist_create. The
+ list is allocated out of the scratch pool. The token is consumed. */
+
+void
+ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t)
+{
+ ffesttExprList new;
+
+ new = (ffesttExprList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST expr list", sizeof (*new));
+ new->next = list->previous->next;
+ new->previous = list->previous;
+ new->next->previous = new;
+ new->previous->next = new;
+ new->expr = expr;
+ new->t = t;
+}
+
+/* ffestt_exprlist_create -- Create new list of exprs
+
+ ffesttExprList list;
+ list = ffestt_exprlist_create();
+
+ The list is allocated out of the scratch pool. */
+
+ffesttExprList
+ffestt_exprlist_create ()
+{
+ ffesttExprList new;
+
+ new = (ffesttExprList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST expr list root", sizeof (*new));
+ new->next = new->previous = new;
+ new->expr = NULL;
+ new->t = NULL;
+ return new;
+}
+
+/* ffestt_exprlist_drive -- Drive list of token pairs into function
+
+ ffesttExprList list;
+ void fn(ffebld expr,ffelexToken t);
+ ffestt_exprlist_drive(list,fn);
+
+ The expr/token pairs in the list are passed to the function one pair
+ at a time. */
+
+void
+ffestt_exprlist_drive (ffesttExprList list, void (*fn) ())
+{
+ ffesttExprList next;
+
+ if (list == NULL)
+ return;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ (*fn) (next->expr, next->t);
+ }
+}
+
+/* ffestt_exprlist_dump -- Dump list of exprs
+
+ ffesttExprList list;
+ ffestt_exprlist_dump(list);
+
+ The exprs in the list are dumped with commas separating them. */
+
+void
+ffestt_exprlist_dump (ffesttExprList list)
+{
+ ffesttExprList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ if (next != list->next)
+ fputc (',', dmpout);
+ ffebld_dump (next->expr);
+ }
+}
+
+/* ffestt_exprlist_kill -- Kill list of exprs
+
+ ffesttExprList list;
+ ffestt_exprlist_kill(list);
+
+ The tokens on the list are killed.
+
+ 02-Mar-90 JCB 1.1
+ Don't kill the list itself or change it, since it will be trashed when
+ ffesta_scratch_pool is killed anyway, so kill only the lex tokens. */
+
+void
+ffestt_exprlist_kill (ffesttExprList list)
+{
+ ffesttExprList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ ffelex_token_kill (next->t);
+ }
+}
+
+/* ffestt_formatlist_append -- Append null format to list of formats
+
+ ffesttFormatList list, new;
+ new = ffestt_formatlist_append(list);
+
+ list must have already been created by ffestt_formatlist_create. The
+ new item is allocated out of the scratch pool. The caller must initialize
+ it appropriately. */
+
+ffesttFormatList
+ffestt_formatlist_append (ffesttFormatList list)
+{
+ ffesttFormatList new;
+
+ new = (ffesttFormatList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST format list", sizeof (*new));
+ new->next = list->previous->next;
+ new->previous = list->previous;
+ new->next->previous = new;
+ new->previous->next = new;
+ return new;
+}
+
+/* ffestt_formatlist_create -- Create new list of formats
+
+ ffesttFormatList list;
+ list = ffestt_formatlist_create(NULL);
+
+ The list is allocated out of the scratch pool. */
+
+ffesttFormatList
+ffestt_formatlist_create (ffesttFormatList parent, ffelexToken t)
+{
+ ffesttFormatList new;
+
+ new = (ffesttFormatList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST format list root", sizeof (*new));
+ new->next = new->previous = new;
+ new->type = FFESTP_formattypeNone;
+ new->t = t;
+ new->u.root.parent = parent;
+ return new;
+}
+
+/* ffestt_formatlist_kill -- Kill tokens on list of formats
+
+ ffesttFormatList list;
+ ffestt_formatlist_kill(list);
+
+ The tokens on the list are killed. */
+
+void
+ffestt_formatlist_kill (ffesttFormatList list)
+{
+ ffesttFormatList next;
+
+ /* Always kill from the very top on down. */
+
+ while (list->u.root.parent != NULL)
+ list = list->u.root.parent->next;
+
+ /* Kill first token for this list. */
+
+ if (list->t != NULL)
+ ffelex_token_kill (list->t);
+
+ /* Kill each item in this list. */
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ ffelex_token_kill (next->t);
+ switch (next->type)
+ {
+ case FFESTP_formattypeI:
+ case FFESTP_formattypeB:
+ case FFESTP_formattypeO:
+ case FFESTP_formattypeZ:
+ case FFESTP_formattypeF:
+ case FFESTP_formattypeE:
+ case FFESTP_formattypeEN:
+ case FFESTP_formattypeG:
+ case FFESTP_formattypeL:
+ case FFESTP_formattypeA:
+ case FFESTP_formattypeD:
+ if (next->u.R1005.R1004.t != NULL)
+ ffelex_token_kill (next->u.R1005.R1004.t);
+ if (next->u.R1005.R1006.t != NULL)
+ ffelex_token_kill (next->u.R1005.R1006.t);
+ if (next->u.R1005.R1007_or_R1008.t != NULL)
+ ffelex_token_kill (next->u.R1005.R1007_or_R1008.t);
+ if (next->u.R1005.R1009.t != NULL)
+ ffelex_token_kill (next->u.R1005.R1009.t);
+ break;
+
+ case FFESTP_formattypeQ:
+ case FFESTP_formattypeDOLLAR:
+ case FFESTP_formattypeP:
+ case FFESTP_formattypeT:
+ case FFESTP_formattypeTL:
+ case FFESTP_formattypeTR:
+ case FFESTP_formattypeX:
+ case FFESTP_formattypeS:
+ case FFESTP_formattypeSP:
+ case FFESTP_formattypeSS:
+ case FFESTP_formattypeBN:
+ case FFESTP_formattypeBZ:
+ case FFESTP_formattypeSLASH:
+ case FFESTP_formattypeCOLON:
+ if (next->u.R1010.val.t != NULL)
+ ffelex_token_kill (next->u.R1010.val.t);
+ break;
+
+ case FFESTP_formattypeR1016:
+ break; /* Nothing more to do. */
+
+ case FFESTP_formattypeFORMAT:
+ if (next->u.R1003D.R1004.t != NULL)
+ ffelex_token_kill (next->u.R1003D.R1004.t);
+ next->u.R1003D.format->u.root.parent = NULL; /* Parent already dying. */
+ ffestt_formatlist_kill (next->u.R1003D.format);
+ break;
+
+ default:
+ assert (FALSE);
+ }
+ }
+}
+
+/* ffestt_implist_append -- Append token pair to list of token pairs
+
+ ffesttImpList list;
+ ffelexToken t;
+ ffestt_implist_append(list,start_token,end_token);
+
+ list must have already been created by ffestt_implist_create. The
+ list is allocated out of the scratch pool. The tokens are consumed. */
+
+void
+ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last)
+{
+ ffesttImpList new;
+
+ new = (ffesttImpList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST token list", sizeof (*new));
+ new->next = list->previous->next;
+ new->previous = list->previous;
+ new->next->previous = new;
+ new->previous->next = new;
+ new->first = first;
+ new->last = last;
+}
+
+/* ffestt_implist_create -- Create new list of token pairs
+
+ ffesttImpList list;
+ list = ffestt_implist_create();
+
+ The list is allocated out of the scratch pool. */
+
+ffesttImpList
+ffestt_implist_create ()
+{
+ ffesttImpList new;
+
+ new = (ffesttImpList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST token list root",
+ sizeof (*new));
+ new->next = new->previous = new;
+ new->first = NULL;
+ new->last = NULL;
+ return new;
+}
+
+/* ffestt_implist_drive -- Drive list of token pairs into function
+
+ ffesttImpList list;
+ void fn(ffelexToken first,ffelexToken last);
+ ffestt_implist_drive(list,fn);
+
+ The token pairs in the list are passed to the function one pair at a time. */
+
+void
+ffestt_implist_drive (ffesttImpList list, void (*fn) ())
+{
+ ffesttImpList next;
+
+ if (list == NULL)
+ return;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ (*fn) (next->first, next->last);
+ }
+}
+
+/* ffestt_implist_dump -- Dump list of token pairs
+
+ ffesttImpList list;
+ ffestt_implist_dump(list);
+
+ The token pairs in the list are dumped with commas separating them. */
+
+void
+ffestt_implist_dump (ffesttImpList list)
+{
+ ffesttImpList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ if (next != list->next)
+ fputc (',', dmpout);
+ assert (ffelex_token_type (next->first) == FFELEX_typeNAME);
+ fputs (ffelex_token_text (next->first), dmpout);
+ if (next->last != NULL)
+ {
+ fputc ('-', dmpout);
+ assert (ffelex_token_type (next->last) == FFELEX_typeNAME);
+ fputs (ffelex_token_text (next->last), dmpout);
+ }
+ }
+}
+
+/* ffestt_implist_kill -- Kill list of token pairs
+
+ ffesttImpList list;
+ ffestt_implist_kill(list);
+
+ The tokens on the list are killed. */
+
+void
+ffestt_implist_kill (ffesttImpList list)
+{
+ ffesttImpList next;
+
+ for (next = list->next; next != list; next = next->next)
+ {
+ ffelex_token_kill (next->first);
+ if (next->last != NULL)
+ ffelex_token_kill (next->last);
+ }
+}
+
+/* ffestt_tokenlist_append -- Append token to list of tokens
+
+ ffesttTokenList tl;
+ ffelexToken t;
+ ffestt_tokenlist_append(tl,t);
+
+ tl must have already been created by ffestt_tokenlist_create. The
+ list is allocated out of the scratch pool. The token is consumed. */
+
+void
+ffestt_tokenlist_append (ffesttTokenList tl, ffelexToken t)
+{
+ ffesttTokenItem ti;
+
+ ti = (ffesttTokenItem) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST token item", sizeof (*ti));
+ ti->next = (ffesttTokenItem) &tl->first;
+ ti->previous = tl->last;
+ ti->next->previous = ti;
+ ti->previous->next = ti;
+ ti->t = t;
+ ++tl->count;
+}
+
+/* ffestt_tokenlist_create -- Create new list of tokens
+
+ ffesttTokenList tl;
+ tl = ffestt_tokenlist_create();
+
+ The list is allocated out of the scratch pool. */
+
+ffesttTokenList
+ffestt_tokenlist_create ()
+{
+ ffesttTokenList tl;
+
+ tl = (ffesttTokenList) malloc_new_kp (ffesta_scratch_pool,
+ "FFEST token list", sizeof (*tl));
+ tl->first = tl->last = (ffesttTokenItem) &tl->first;
+ tl->count = 0;
+ return tl;
+}
+
+/* ffestt_tokenlist_drive -- Dump list of tokens
+
+ ffesttTokenList tl;
+ void fn(ffelexToken t);
+ ffestt_tokenlist_drive(tl,fn);
+
+ The tokens in the list are passed to the given function. */
+
+void
+ffestt_tokenlist_drive (ffesttTokenList tl, void (*fn) ())
+{
+ ffesttTokenItem ti;
+
+ if (tl == NULL)
+ return;
+
+ for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+ {
+ (*fn) (ti->t);
+ }
+}
+
+/* ffestt_tokenlist_dump -- Dump list of tokens
+
+ ffesttTokenList tl;
+ ffestt_tokenlist_dump(tl);
+
+ The tokens in the list are dumped with commas separating them. */
+
+void
+ffestt_tokenlist_dump (ffesttTokenList tl)
+{
+ ffesttTokenItem ti;
+
+ for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+ {
+ if (ti != tl->first)
+ fputc (',', dmpout);
+ switch (ffelex_token_type (ti->t))
+ {
+ case FFELEX_typeNUMBER:
+ case FFELEX_typeNAME:
+ case FFELEX_typeNAMES:
+ fputs (ffelex_token_text (ti->t), dmpout);
+ break;
+
+ case FFELEX_typeASTERISK:
+ fputc ('*', dmpout);
+ break;
+
+ default:
+ assert (FALSE);
+ fputc ('?', dmpout);
+ break;
+ }
+ }
+}
+
+/* ffestt_tokenlist_handle -- Handle list of tokens
+
+ ffesttTokenList tl;
+ ffelexHandler handler;
+ handler = ffestt_tokenlist_handle(tl,handler);
+
+ The tokens in the list are passed to the handler(s). */
+
+ffelexHandler
+ffestt_tokenlist_handle (ffesttTokenList tl, ffelexHandler handler)
+{
+ ffesttTokenItem ti;
+
+ for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+ handler = (ffelexHandler) (*handler) (ti->t);
+
+ return (ffelexHandler) handler;
+}
+
+/* ffestt_tokenlist_kill -- Kill list of tokens
+
+ ffesttTokenList tl;
+ ffestt_tokenlist_kill(tl);
+
+ The tokens on the list are killed.
+
+ 02-Mar-90 JCB 1.1
+ Don't kill the list itself or change it, since it will be trashed when
+ ffesta_scratch_pool is killed anyway, so kill only the lex tokens. */
+
+void
+ffestt_tokenlist_kill (ffesttTokenList tl)
+{
+ ffesttTokenItem ti;
+
+ for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+ {
+ ffelex_token_kill (ti->t);
+ }
+}
diff --git a/gcc/f/stt.h b/gcc/f/stt.h
new file mode 100644
index 00000000000..827841ea983
--- /dev/null
+++ b/gcc/f/stt.h
@@ -0,0 +1,218 @@
+/* stt.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ stt.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_stt
+#define _H_f_stt
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+typedef struct _ffest_case_list_ *ffesttCaseList;
+typedef struct _ffest_dim_list_ *ffesttDimList;
+typedef struct _ffest_expr_list_ *ffesttExprList;
+typedef struct _ffest_format_value_ ffesttFormatValue;
+typedef struct _ffest_format_list_ *ffesttFormatList;
+typedef struct _ffest_imp_list_ *ffesttImpList;
+typedef struct _ffest_token_item_ *ffesttTokenItem;
+typedef struct _ffest_token_list_ *ffesttTokenList;
+
+/* Include files needed by this one. */
+
+#include "top.h"
+#include "bld.h"
+#include "info.h"
+#include "lex.h"
+#include "stp.h"
+
+/* Structure definitions. */
+
+struct _ffest_case_list_
+ {
+ ffesttCaseList next;
+ ffesttCaseList previous;
+ ffelexToken t;
+ ffebld expr1;
+ ffebld expr2;
+ bool range; /* TRUE if "[expr1]:[expr2]", FALSE if
+ "expr1". */
+ };
+
+struct _ffest_dim_list_
+ {
+ ffesttDimList next;
+ ffesttDimList previous;
+ ffelexToken t;
+ ffebld lower;
+ ffebld upper;
+ };
+
+struct _ffest_expr_list_
+ {
+ ffesttExprList next;
+ ffesttExprList previous;
+ ffelexToken t;
+ ffebld expr;
+ };
+
+struct _ffest_token_item_
+ {
+ ffesttTokenItem next;
+ ffesttTokenItem previous;
+ ffelexToken t;
+ };
+
+struct _ffest_token_list_
+ {
+ ffesttTokenItem first;
+ ffesttTokenItem last;
+ int count; /* Number of tokens in list. */
+ };
+
+struct _ffest_format_value_
+ {
+ bool present; /* TRUE if value supplied (needed for
+ optional values only). */
+ bool rtexpr; /* FALSE if constant value here, TRUE if
+ run-time expr (VXT). */
+ ffelexToken t; /* The first token, or perhaps just prior if
+ can't get it. */
+ union
+ {
+ ffeUnionLongPtr unused; /* Make sure all the info gets copied. */
+ long signed_val; /* for R1011. */
+ unsigned long unsigned_val; /* For other constant values. */
+ ffebld expr; /* For run-time expression (VXT). */
+ }
+ u;
+ };
+
+struct _ffest_format_list_
+ {
+ ffesttFormatList next;
+ ffesttFormatList previous;
+ ffelexToken t; /* The NAME, CHARACTER, or HOLLERITH token. */
+ ffestpFormatType type;
+ union ffest_format_
+ {
+ struct
+ {
+ ffesttFormatValue R1004; /* r, the repeat count. */
+ ffesttFormatValue R1006; /* w, the field width. */
+ ffesttFormatValue R1007_or_R1008; /* m, the minimum number of
+ digits; d, the number of
+ decimal digits. */
+ ffesttFormatValue R1009; /* e, the number of exponent digits. */
+ }
+ R1005; /* data-edit-desc. */
+ struct
+ {
+ ffesttFormatValue val; /* r, the repeat count; k, the
+ precision magnitude adjustment; n,
+ the column number (abs or rel). */
+ }
+ R1010; /* control-edit-desc. */
+ struct
+ {
+ ffesttFormatValue R1004; /* r, the repeat count. */
+ ffesttFormatList format; /* the parenthesized
+ format-item-list. */
+ }
+ R1003D; /* format-item of for [r](format-item-list). */
+ struct
+ {
+ ffesttFormatList parent; /* NULL if outer list, else parent
+ item. */
+ }
+ root; /* FFESTP_formattypeNone case. */
+ }
+ u;
+ };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1,
+ ffebld case2, ffelexToken t);
+ffesttCaseList ffestt_caselist_create (void);
+void ffestt_caselist_dump (ffesttCaseList list);
+void ffestt_caselist_kill (ffesttCaseList list);
+void ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper,
+ ffelexToken t);
+ffebld ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank,
+ ffebld *array_size, ffebld *extents,
+ bool is_ugly_assumed);
+ffesttDimList ffestt_dimlist_create (void);
+void ffestt_dimlist_dump (ffesttDimList list);
+void ffestt_dimlist_kill (ffesttDimList list);
+ffestpDimtype ffestt_dimlist_type (ffesttDimList dims, bool is_ugly_assumed);
+void ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t);
+ffesttExprList ffestt_exprlist_create (void);
+void ffestt_exprlist_drive (ffesttExprList list, void (*fn) ());
+void ffestt_exprlist_dump (ffesttExprList list);
+void ffestt_exprlist_kill (ffesttExprList list);
+ffesttFormatList ffestt_formatlist_append (ffesttFormatList list);
+ffesttFormatList ffestt_formatlist_create (ffesttFormatList parent,
+ ffelexToken t);
+void ffestt_formatlist_dump (ffesttFormatList list);
+void ffestt_formatlist_kill (ffesttFormatList list);
+void ffestt_implist_append (ffesttImpList list, ffelexToken first,
+ ffelexToken last);
+ffesttImpList ffestt_implist_create (void);
+void ffestt_implist_drive (ffesttImpList list, void (*fn) ());
+void ffestt_implist_dump (ffesttImpList list);
+void ffestt_implist_kill (ffesttImpList list);
+void ffestt_tokenlist_append (ffesttTokenList list, ffelexToken t);
+ffesttTokenList ffestt_tokenlist_create (void);
+void ffestt_tokenlist_drive (ffesttTokenList list, void (*fn) ());
+void ffestt_tokenlist_dump (ffesttTokenList list);
+ffelexHandler ffestt_tokenlist_handle (ffesttTokenList list,
+ ffelexHandler handler);
+void ffestt_tokenlist_kill (ffesttTokenList list);
+
+/* Define macros. */
+
+#define ffestt_init_0()
+#define ffestt_init_1()
+#define ffestt_init_2()
+#define ffestt_init_3()
+#define ffestt_init_4()
+#define ffestt_terminate_0()
+#define ffestt_terminate_1()
+#define ffestt_terminate_2()
+#define ffestt_terminate_3()
+#define ffestt_terminate_4()
+#define ffestt_tokenlist_count(tl) ((tl)->count)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/stu.c b/gcc/f/stu.c
new file mode 100644
index 00000000000..138a070e5d3
--- /dev/null
+++ b/gcc/f/stu.c
@@ -0,0 +1,1161 @@
+/* stu.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "bld.h"
+#include "com.h"
+#include "equiv.h"
+#include "global.h"
+#include "info.h"
+#include "implic.h"
+#include "intrin.h"
+#include "stu.h"
+#include "storag.h"
+#include "sta.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+static void ffestu_list_exec_transition_ (ffebld list);
+static bool ffestu_symter_end_transition_ (ffebld expr);
+static bool ffestu_symter_exec_transition_ (ffebld expr);
+static bool ffestu_dummies_transition_ (ffesymbol (*symfunc) (),
+ ffebld list);
+
+/* Internal macros. */
+
+#define ffestu_equiv_(s) (((ffesymbol_equiv (s) == NULL) \
+ || (ffeequiv_common (ffesymbol_equiv (s)) == NULL)) ? FFEINFO_whereLOCAL \
+ : FFEINFO_whereCOMMON)
+
+/* Update symbol info just before end of unit. */
+
+ffesymbol
+ffestu_sym_end_transition (ffesymbol s)
+{
+ ffeinfoKind skd;
+ ffeinfoWhere swh;
+ ffeinfoKind nkd;
+ ffeinfoWhere nwh;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffesymbolState ss;
+ ffesymbolState ns;
+ bool needs_type = TRUE; /* Implicit type assignment might be
+ necessary. */
+
+ assert (s != NULL);
+ ss = ffesymbol_state (s);
+ sa = ffesymbol_attrs (s);
+ skd = ffesymbol_kind (s);
+ swh = ffesymbol_where (s);
+
+ switch (ss)
+ {
+ case FFESYMBOL_stateUNCERTAIN:
+ if ((swh == FFEINFO_whereDUMMY)
+ && (ffesymbol_numentries (s) == 0))
+ { /* Not actually in any dummy list! */
+ ffesymbol_error (s, ffesta_tokens[0]);
+ return s;
+ }
+ else if (((swh == FFEINFO_whereLOCAL)
+ || (swh == FFEINFO_whereNONE))
+ && (skd == FFEINFO_kindENTITY)
+ && ffestu_symter_end_transition_ (ffesymbol_dims (s)))
+ { /* Bad dimension expressions. */
+ ffesymbol_error (s, NULL);
+ return s;
+ }
+ break;
+
+ case FFESYMBOL_stateUNDERSTOOD:
+ if ((swh == FFEINFO_whereLOCAL)
+ && ((skd == FFEINFO_kindFUNCTION)
+ || (skd == FFEINFO_kindSUBROUTINE)))
+ {
+ int n_args;
+ ffebld list;
+ ffebld item;
+ ffeglobalArgSummary as;
+ ffeinfoBasictype bt;
+ ffeinfoKindtype kt;
+ bool array;
+ char *name = NULL;
+
+ ffestu_dummies_transition_ (ffecom_sym_end_transition,
+ ffesymbol_dummyargs (s));
+
+ n_args = ffebld_list_length (ffesymbol_dummyargs (s));
+ ffeglobal_proc_def_nargs (s, n_args);
+ for (list = ffesymbol_dummyargs (s), n_args = 0;
+ list != NULL;
+ list = ffebld_trail (list), ++n_args)
+ {
+ item = ffebld_head (list);
+ array = FALSE;
+ if (item != NULL)
+ {
+ bt = ffeinfo_basictype (ffebld_info (item));
+ kt = ffeinfo_kindtype (ffebld_info (item));
+ array = (ffeinfo_rank (ffebld_info (item)) > 0);
+ switch (ffebld_op (item))
+ {
+ case FFEBLD_opSTAR:
+ as = FFEGLOBAL_argsummaryALTRTN;
+ break;
+
+ case FFEBLD_opSYMTER:
+ name = ffesymbol_text (ffebld_symter (item));
+ as = FFEGLOBAL_argsummaryNONE;
+
+ switch (ffeinfo_kind (ffebld_info (item)))
+ {
+ case FFEINFO_kindFUNCTION:
+ as = FFEGLOBAL_argsummaryFUNC;
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ as = FFEGLOBAL_argsummarySUBR;
+ break;
+
+ case FFEINFO_kindNONE:
+ as = FFEGLOBAL_argsummaryPROC;
+ break;
+
+ default:
+ break;
+ }
+
+ if (as != FFEGLOBAL_argsummaryNONE)
+ break;
+
+ /* Fall through. */
+ default:
+ if (bt == FFEINFO_basictypeCHARACTER)
+ as = FFEGLOBAL_argsummaryDESCR;
+ else
+ as = FFEGLOBAL_argsummaryREF;
+ break;
+ }
+ }
+ else
+ {
+ as = FFEGLOBAL_argsummaryNONE;
+ bt = FFEINFO_basictypeNONE;
+ kt = FFEINFO_kindtypeNONE;
+ }
+ ffeglobal_proc_def_arg (s, n_args, name, as, bt, kt, array);
+ }
+ }
+ else if (swh == FFEINFO_whereDUMMY)
+ {
+ if (ffesymbol_numentries (s) == 0)
+ { /* Not actually in any dummy list! */
+ ffesymbol_error (s, ffesta_tokens[0]);
+ return s;
+ }
+ if (ffestu_symter_end_transition_ (ffesymbol_dims (s)))
+ { /* Bad dimension expressions. */
+ ffesymbol_error (s, NULL);
+ return s;
+ }
+ }
+ else if ((swh == FFEINFO_whereLOCAL)
+ && ffestu_symter_end_transition_ (ffesymbol_dims (s)))
+ { /* Bad dimension expressions. */
+ ffesymbol_error (s, NULL);
+ return s;
+ }
+
+ ffestorag_end_layout (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ return s;
+
+ default:
+ assert ("bad status" == NULL);
+ return s;
+ }
+
+ ns = FFESYMBOL_stateUNDERSTOOD;
+ na = sa = ffesymbol_attrs (s);
+
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ nkd = skd;
+ nwh = swh;
+
+ /* Figure out what kind of object we've got based on previous declarations
+ of or references to the object. */
+
+ if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsTYPE)
+ nwh = FFEINFO_whereGLOBAL;
+ else
+ /* Not TYPE. */
+ {
+ if (sa & FFESYMBOL_attrsDUMMY)
+ { /* Not TYPE. */
+ ns = FFESYMBOL_stateUNCERTAIN; /* FUNCTION/SUBROUTINE. */
+ needs_type = FALSE; /* Don't assign type to SUBROUTINE! */
+ }
+ else if (sa & FFESYMBOL_attrsACTUALARG)
+ { /* Not DUMMY or TYPE. */
+ ns = FFESYMBOL_stateUNCERTAIN; /* FUNCTION/SUBROUTINE. */
+ needs_type = FALSE; /* Don't assign type to SUBROUTINE! */
+ }
+ else
+ /* Not ACTUALARG, DUMMY, or TYPE. */
+ { /* This is an assumption, essentially. */
+ nkd = FFEINFO_kindBLOCKDATA;
+ nwh = FFEINFO_whereGLOBAL;
+ needs_type = FALSE;
+ }
+ }
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ /* Honestly, this appears to be a guess. I can't find anyplace in the
+ standard that makes clear whether this unreferenced dummy argument
+ is an ENTITY or a FUNCTION. And yet, for the f2c interface, picking
+ one is critical for CHARACTER entities because it determines whether
+ to expect an additional argument specifying the length of an ENTITY
+ that is not expected (or needed) for a FUNCTION. HOWEVER, F90 makes
+ this guess a correct one, and it does seem that the Section 18 Notes
+ in Appendix B of F77 make it clear the F77 standard at least
+ intended to make this guess correct as well, so this seems ok. */
+
+ nkd = FFEINFO_kindENTITY;
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsTYPE)));
+
+ if (ffestu_symter_end_transition_ (ffesymbol_dims (s)))
+ {
+ ffesymbol_error (s, NULL);
+ return s;
+ }
+
+ if (sa & FFESYMBOL_attrsADJUSTABLE)
+ { /* Not actually in any dummy list! */
+ if (ffe_is_pedantic ()
+ && ffebad_start_msg ("Local adjustable symbol `%A' at %0",
+ FFEBAD_severityPEDANTIC))
+ {
+ ffebad_string (ffesymbol_text (s));
+ ffebad_here (0, ffesymbol_where_line (s),
+ ffesymbol_where_column (s));
+ ffebad_finish ();
+ }
+ }
+ nwh = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ nwh = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsTYPE
+ | FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG)));
+
+ if (sa & FFESYMBOL_attrsANYLEN)
+ { /* Can't touch this. */
+ ffesymbol_signal_change (s);
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_reference (s, NULL, FALSE);
+ ffestorag_end_layout (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ return s;
+ }
+
+ nkd = FFEINFO_kindENTITY;
+ nwh = FFEINFO_whereLOCAL;
+ }
+ else
+ assert ("unexpected attribute set" == NULL);
+
+ /* Now see what we've got for a new object: NONE means a new error cropped
+ up; ANY means an old error to be ignored; otherwise, everything's ok,
+ update the object (symbol) and continue on. */
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, ffesta_tokens[0]);
+ else if (!(na & FFESYMBOL_attrsANY))
+ {
+ ffesymbol_signal_change (s);
+ ffesymbol_set_attrs (s, na); /* Establish new info. */
+ ffesymbol_set_state (s, ns);
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ nkd,
+ nwh,
+ ffesymbol_size (s)));
+ if (needs_type && !ffeimplic_establish_symbol (s))
+ ffesymbol_error (s, ffesta_tokens[0]);
+ else
+ ffesymbol_resolve_intrin (s);
+ s = ffecom_sym_learned (s);
+ ffesymbol_reference (s, NULL, FALSE);
+ ffestorag_end_layout (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* ffestu_sym_exec_transition -- Update symbol just before first exec stmt
+
+ ffesymbol s;
+ ffestu_sym_exec_transition(s); */
+
+ffesymbol
+ffestu_sym_exec_transition (ffesymbol s)
+{
+ ffeinfoKind skd;
+ ffeinfoWhere swh;
+ ffeinfoKind nkd;
+ ffeinfoWhere nwh;
+ ffesymbolAttrs sa;
+ ffesymbolAttrs na;
+ ffesymbolState ss;
+ ffesymbolState ns;
+ ffeintrinGen gen;
+ ffeintrinSpec spec;
+ ffeintrinImp imp;
+ bool needs_type = TRUE; /* Implicit type assignment might be
+ necessary. */
+ bool resolve_intrin = TRUE; /* Might need to resolve intrinsic. */
+
+ assert (s != NULL);
+
+ sa = ffesymbol_attrs (s);
+ skd = ffesymbol_kind (s);
+ swh = ffesymbol_where (s);
+ ss = ffesymbol_state (s);
+
+ switch (ss)
+ {
+ case FFESYMBOL_stateNONE:
+ return s; /* Assume caller will handle it. */
+
+ case FFESYMBOL_stateSEEN:
+ break;
+
+ case FFESYMBOL_stateUNCERTAIN:
+ ffestorag_exec_layout (s);
+ return s; /* Already processed this one, or not
+ necessary. */
+
+ case FFESYMBOL_stateUNDERSTOOD:
+ if (skd == FFEINFO_kindNAMELIST)
+ {
+ ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
+ ffestu_list_exec_transition_ (ffesymbol_namelist (s));
+ }
+ else if ((swh == FFEINFO_whereLOCAL)
+ && ((skd == FFEINFO_kindFUNCTION)
+ || (skd == FFEINFO_kindSUBROUTINE)))
+ {
+ ffestu_dummies_transition_ (ffecom_sym_exec_transition,
+ ffesymbol_dummyargs (s));
+ if ((skd == FFEINFO_kindFUNCTION)
+ && !ffeimplic_establish_symbol (s))
+ ffesymbol_error (s, ffesta_tokens[0]);
+ }
+
+ ffesymbol_reference (s, NULL, FALSE);
+ ffestorag_exec_layout (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ return s;
+
+ default:
+ assert ("bad status" == NULL);
+ return s;
+ }
+
+ ns = FFESYMBOL_stateUNDERSTOOD; /* Only a few UNCERTAIN exceptions. */
+
+ na = sa;
+ nkd = skd;
+ nwh = swh;
+
+ assert (!(sa & FFESYMBOL_attrsANY));
+
+ if (sa & FFESYMBOL_attrsCOMMON)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ nkd = FFEINFO_kindENTITY;
+ nwh = FFEINFO_whereCOMMON;
+ }
+ else if (sa & FFESYMBOL_attrsRESULT)
+ { /* Result variable for function. */
+ assert (!(sa & ~(FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsRESULT
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ nkd = FFEINFO_kindENTITY;
+ nwh = FFEINFO_whereRESULT;
+ }
+ else if (sa & FFESYMBOL_attrsSFUNC)
+ { /* Statement function. */
+ assert (!(sa & ~(FFESYMBOL_attrsSFUNC
+ | FFESYMBOL_attrsTYPE)));
+
+ nkd = FFEINFO_kindFUNCTION;
+ nwh = FFEINFO_whereCONSTANT;
+ }
+ else if (sa & FFESYMBOL_attrsEXTERNAL)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsTYPE)));
+
+ if (sa & FFESYMBOL_attrsTYPE)
+ {
+ nkd = FFEINFO_kindFUNCTION;
+
+ if (sa & FFESYMBOL_attrsDUMMY)
+ nwh = FFEINFO_whereDUMMY;
+ else
+ {
+ if (ffesta_is_entry_valid)
+ {
+ nwh = FFEINFO_whereNONE; /* DUMMY, GLOBAL. */
+ ns = FFESYMBOL_stateUNCERTAIN;
+ }
+ else
+ nwh = FFEINFO_whereGLOBAL;
+ }
+ }
+ else
+ /* No TYPE. */
+ {
+ nkd = FFEINFO_kindNONE; /* FUNCTION, SUBROUTINE, BLOCKDATA. */
+ needs_type = FALSE; /* Only gets type if FUNCTION. */
+ ns = FFESYMBOL_stateUNCERTAIN;
+
+ if (sa & FFESYMBOL_attrsDUMMY)
+ nwh = FFEINFO_whereDUMMY; /* Not BLOCKDATA. */
+ else
+ {
+ if (ffesta_is_entry_valid)
+ nwh = FFEINFO_whereNONE; /* DUMMY, GLOBAL. */
+ else
+ nwh = FFEINFO_whereGLOBAL;
+ }
+ }
+ }
+ else if (sa & FFESYMBOL_attrsDUMMY)
+ {
+ assert (!(sa & FFESYMBOL_attrsEXTERNAL)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE /* Possible. */
+ | FFESYMBOL_attrsADJUSTS /* Possible. */
+ | FFESYMBOL_attrsANYLEN /* Possible. */
+ | FFESYMBOL_attrsANYSIZE /* Possible. */
+ | FFESYMBOL_attrsARRAY /* Possible. */
+ | FFESYMBOL_attrsDUMMY /* Have it. */
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsSFARG /* Possible. */
+ | FFESYMBOL_attrsTYPE))); /* Possible. */
+
+ nwh = FFEINFO_whereDUMMY;
+
+ if (ffestu_symter_exec_transition_ (ffesymbol_dims (s)))
+ na = FFESYMBOL_attrsetNONE;
+
+ if (sa & (FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSFARG))
+ nkd = FFEINFO_kindENTITY;
+ else if (sa & FFESYMBOL_attrsDUMMY) /* Still okay. */
+ {
+ if (!(sa & FFESYMBOL_attrsTYPE))
+ needs_type = FALSE; /* Don't assign type to SUBROUTINE! */
+ nkd = FFEINFO_kindNONE; /* ENTITY, FUNCTION, SUBROUTINE. */
+ ns = FFESYMBOL_stateUNCERTAIN;
+ }
+ }
+ else if (sa & FFESYMBOL_attrsADJUSTS)
+ { /* Must be DUMMY or COMMON at some point. */
+ assert (!(sa & (FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTS /* Have it. */
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV /* Possible. */
+ | FFESYMBOL_attrsINIT /* Possible. */
+ | FFESYMBOL_attrsNAMELIST /* Possible. */
+ | FFESYMBOL_attrsSFARG /* Possible. */
+ | FFESYMBOL_attrsTYPE))); /* Possible. */
+
+ nkd = FFEINFO_kindENTITY;
+
+ if (sa & FFESYMBOL_attrsEQUIV)
+ {
+ if ((ffesymbol_equiv (s) == NULL)
+ || (ffeequiv_common (ffesymbol_equiv (s)) == NULL))
+ na = FFESYMBOL_attrsetNONE; /* Not equiv'd into COMMON. */
+ else
+ nwh = FFEINFO_whereCOMMON;
+ }
+ else if (!ffesta_is_entry_valid
+ || (sa & (FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST)))
+ na = FFESYMBOL_attrsetNONE;
+ else
+ nwh = FFEINFO_whereDUMMY;
+ }
+ else if (sa & FFESYMBOL_attrsSAVE)
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsTYPE)));
+
+ nkd = FFEINFO_kindENTITY;
+ nwh = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsEQUIV)
+ {
+ assert (!(sa & FFESYMBOL_attrsCOMMON)); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTS /* Possible. */
+ | FFESYMBOL_attrsARRAY /* Possible. */
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV /* Have it. */
+ | FFESYMBOL_attrsINIT /* Possible. */
+ | FFESYMBOL_attrsNAMELIST /* Possible. */
+ | FFESYMBOL_attrsSAVE /* Possible. */
+ | FFESYMBOL_attrsSFARG /* Possible. */
+ | FFESYMBOL_attrsTYPE))); /* Possible. */
+
+ nkd = FFEINFO_kindENTITY;
+ nwh = ffestu_equiv_ (s);
+ }
+ else if (sa & FFESYMBOL_attrsNAMELIST)
+ {
+ assert (!(sa & (FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsSAVE))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsARRAY /* Possible. */
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT /* Possible. */
+ | FFESYMBOL_attrsNAMELIST /* Have it. */
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG /* Possible. */
+ | FFESYMBOL_attrsTYPE))); /* Possible. */
+
+ nkd = FFEINFO_kindENTITY;
+ nwh = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsINIT)
+ {
+ assert (!(sa & (FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsARRAY /* Possible. */
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT /* Have it. */
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG /* Possible. */
+ | FFESYMBOL_attrsTYPE))); /* Possible. */
+
+ nkd = FFEINFO_kindENTITY;
+ nwh = FFEINFO_whereLOCAL;
+ }
+ else if (sa & FFESYMBOL_attrsSFARG)
+ {
+ assert (!(sa & (FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsRESULT
+ | FFESYMBOL_attrsSAVE))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsRESULT
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG /* Have it. */
+ | FFESYMBOL_attrsTYPE))); /* Possible. */
+
+ nkd = FFEINFO_kindENTITY;
+
+ if (ffesta_is_entry_valid)
+ {
+ nwh = FFEINFO_whereNONE; /* DUMMY, LOCAL. */
+ ns = FFESYMBOL_stateUNCERTAIN;
+ }
+ else
+ nwh = FFEINFO_whereLOCAL;
+ }
+ else if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYSIZE))
+ {
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsTYPE)));
+
+ nkd = FFEINFO_kindENTITY;
+
+ if (ffestu_symter_exec_transition_ (ffesymbol_dims (s)))
+ na = FFESYMBOL_attrsetNONE;
+
+ if (sa & (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsANYSIZE))
+ nwh = FFEINFO_whereDUMMY;
+ else if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYSIZE))
+ /* Still okay. */
+ {
+ nwh = FFEINFO_whereNONE; /* DUMMY, LOCAL. */
+ ns = FFESYMBOL_stateUNCERTAIN;
+ }
+ }
+ else if (sa & FFESYMBOL_attrsARRAY)
+ {
+ assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN /* Possible. */
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsARRAY /* Have it. */
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsTYPE))); /* Possible. */
+
+ nkd = FFEINFO_kindENTITY;
+
+ if (sa & FFESYMBOL_attrsANYLEN)
+ {
+ assert (ffesta_is_entry_valid); /* Already diagnosed. */
+ nwh = FFEINFO_whereDUMMY;
+ }
+ else
+ {
+ if (ffesta_is_entry_valid)
+ {
+ nwh = FFEINFO_whereNONE; /* DUMMY, LOCAL. */
+ ns = FFESYMBOL_stateUNCERTAIN;
+ }
+ else
+ nwh = FFEINFO_whereLOCAL;
+ }
+ }
+ else if (sa & FFESYMBOL_attrsANYLEN)
+ {
+ assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsRESULT))); /* Handled above. */
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsANYLEN /* Have it. */
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsRESULT
+ | FFESYMBOL_attrsTYPE))); /* Have it too. */
+
+ if (ffesta_is_entry_valid)
+ {
+ nkd = FFEINFO_kindNONE; /* ENTITY, FUNCTION. */
+ nwh = FFEINFO_whereNONE; /* DUMMY, INTRINSIC, RESULT. */
+ ns = FFESYMBOL_stateUNCERTAIN;
+ resolve_intrin = FALSE;
+ }
+ else if (ffeintrin_is_intrinsic (ffesymbol_text (s), NULL, FALSE,
+ &gen, &spec, &imp))
+ {
+ ffesymbol_signal_change (s);
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_set_generic (s, gen);
+ ffesymbol_set_specific (s, spec);
+ ffesymbol_set_implementation (s, imp);
+ ffesymbol_set_info (s,
+ ffeinfo_new (FFEINFO_basictypeNONE,
+ FFEINFO_kindtypeNONE,
+ 0,
+ FFEINFO_kindNONE,
+ FFEINFO_whereINTRINSIC,
+ FFETARGET_charactersizeNONE));
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_reference (s, NULL, FALSE);
+ ffestorag_exec_layout (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ return s;
+ }
+ else
+ { /* SPECIAL: can't have CHAR*(*) var in
+ PROGRAM/BLOCKDATA, unless it isn't
+ referenced anywhere in the code. */
+ ffesymbol_signal_change (s); /* Can't touch this. */
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_reference (s, NULL, FALSE);
+ ffestorag_exec_layout (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ return s;
+ }
+ }
+ else if (sa & FFESYMBOL_attrsTYPE)
+ {
+ assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsRESULT
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsSFUNC)));
+ assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
+ | FFESYMBOL_attrsADJUSTS
+ | FFESYMBOL_attrsANYLEN
+ | FFESYMBOL_attrsANYSIZE
+ | FFESYMBOL_attrsARRAY
+ | FFESYMBOL_attrsCOMMON
+ | FFESYMBOL_attrsDUMMY
+ | FFESYMBOL_attrsEQUIV
+ | FFESYMBOL_attrsEXTERNAL
+ | FFESYMBOL_attrsINIT
+ | FFESYMBOL_attrsINTRINSIC /* UNDERSTOOD. */
+ | FFESYMBOL_attrsNAMELIST
+ | FFESYMBOL_attrsRESULT
+ | FFESYMBOL_attrsSAVE
+ | FFESYMBOL_attrsSFARG
+ | FFESYMBOL_attrsSFUNC
+ | FFESYMBOL_attrsTYPE))); /* Have it. */
+
+ nkd = FFEINFO_kindNONE; /* ENTITY, FUNCTION. */
+ nwh = FFEINFO_whereNONE; /* DUMMY, GLOBAL, INTRINSIC, LOCAL, RESULT. */
+ ns = FFESYMBOL_stateUNCERTAIN;
+ resolve_intrin = FALSE;
+ }
+ else if (sa & (FFESYMBOL_attrsCBLOCK | FFESYMBOL_attrsSAVECBLOCK))
+ { /* COMMON block. */
+ assert (!(sa & ~(FFESYMBOL_attrsCBLOCK
+ | FFESYMBOL_attrsSAVECBLOCK)));
+
+ if (sa & FFESYMBOL_attrsCBLOCK)
+ ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
+ else
+ ffesymbol_set_commonlist (s, NULL);
+ ffestu_list_exec_transition_ (ffesymbol_commonlist (s));
+ nkd = FFEINFO_kindCOMMON;
+ nwh = FFEINFO_whereLOCAL;
+ needs_type = FALSE;
+ }
+ else
+ { /* First seen in stmt func definition. */
+ assert (sa == FFESYMBOL_attrsetNONE);
+ assert ("Why are we here again?" == NULL); /* ~~~~~ */
+
+ nkd = FFEINFO_kindNONE; /* ENTITY, FUNCTION. */
+ nwh = FFEINFO_whereNONE; /* DUMMY, GLOBAL, LOCAL. */
+ ns = FFESYMBOL_stateUNCERTAIN; /* Will get repromoted by caller. */
+ needs_type = FALSE;
+ }
+
+ if (na == FFESYMBOL_attrsetNONE)
+ ffesymbol_error (s, ffesta_tokens[0]);
+ else if (!(na & FFESYMBOL_attrsANY)
+ && (needs_type || (nkd != skd) || (nwh != swh)
+ || (na != sa) || (ns != ss)))
+ {
+ ffesymbol_signal_change (s);
+ ffesymbol_set_attrs (s, na); /* Establish new info. */
+ ffesymbol_set_state (s, ns);
+ if ((ffesymbol_common (s) == NULL)
+ && (ffesymbol_equiv (s) != NULL))
+ ffesymbol_set_common (s, ffeequiv_common (ffesymbol_equiv (s)));
+ ffesymbol_set_info (s,
+ ffeinfo_new (ffesymbol_basictype (s),
+ ffesymbol_kindtype (s),
+ ffesymbol_rank (s),
+ nkd,
+ nwh,
+ ffesymbol_size (s)));
+ if (needs_type && !ffeimplic_establish_symbol (s))
+ ffesymbol_error (s, ffesta_tokens[0]);
+ else if (resolve_intrin)
+ ffesymbol_resolve_intrin (s);
+ ffesymbol_reference (s, NULL, FALSE);
+ ffestorag_exec_layout (s);
+ ffesymbol_signal_unreported (s); /* For debugging purposes. */
+ }
+
+ return s;
+}
+
+/* ffestu_list_exec_transition_ -- Update SYMTERs in ITEM list w/in symbol
+
+ ffebld list;
+ ffestu_list_exec_transition_(list);
+
+ list contains an FFEBLD_opITEM list of SYMTERs (possibly STARs and
+ other things, too, but we'll ignore the known ones). For each SYMTER,
+ we run sym_exec_transition_ on the corresponding ffesymbol (a recursive
+ call, since that's the function that's calling us) to update it's
+ information. Then we copy that information into the SYMTER.
+
+ Make sure we don't get called recursively ourselves! */
+
+static void
+ffestu_list_exec_transition_ (ffebld list)
+{
+ static in_progress = FALSE;
+ ffebld item;
+ ffesymbol symbol;
+
+ assert (!in_progress);
+ in_progress = TRUE;
+
+ for (; list != NULL; list = ffebld_trail (list))
+ {
+ if ((item = ffebld_head (list)) == NULL)
+ continue; /* Try next item. */
+
+ switch (ffebld_op (item))
+ {
+ case FFEBLD_opSTAR:
+ break;
+
+ case FFEBLD_opSYMTER:
+ symbol = ffebld_symter (item);
+ if (symbol == NULL)
+ break; /* Detached from stmt func dummy list. */
+ symbol = ffecom_sym_exec_transition (symbol);
+ assert (ffesymbol_kind (symbol) != FFEINFO_kindNONE);
+ assert (ffesymbol_where (symbol) != FFEINFO_whereNONE);
+ ffebld_set_info (item, ffesymbol_info (symbol));
+ break;
+
+ default:
+ assert ("Unexpected item on list" == NULL);
+ break;
+ }
+ }
+
+ in_progress = FALSE;
+}
+
+/* ffestu_symter_end_transition_ -- Update SYMTERs in expr w/in symbol
+
+ ffebld expr;
+ ffestu_symter_end_transition_(expr);
+
+ Any SYMTER in expr's tree with whereNONE gets updated to the
+ (recursively transitioned) sym it identifies (DUMMY or COMMON). */
+
+static bool
+ffestu_symter_end_transition_ (ffebld expr)
+{
+ ffesymbol symbol;
+ bool any = FALSE;
+
+ /* Label used for tail recursion (reset expr and go here instead of calling
+ self). */
+
+tail: /* :::::::::::::::::::: */
+
+ if (expr == NULL)
+ return any;
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opITEM:
+ while (ffebld_trail (expr) != NULL)
+ {
+ if (ffestu_symter_end_transition_ (ffebld_head (expr)))
+ any = TRUE;
+ expr = ffebld_trail (expr);
+ }
+ expr = ffebld_head (expr);
+ goto tail; /* :::::::::::::::::::: */
+
+ case FFEBLD_opSYMTER:
+ symbol = ffecom_sym_end_transition (ffebld_symter (expr));
+ if ((symbol != NULL)
+ && ffesymbol_attr (symbol, FFESYMBOL_attrANY))
+ any = TRUE;
+ ffebld_set_info (expr, ffesymbol_info (symbol));
+ break;
+
+ case FFEBLD_opANY:
+ return TRUE;
+
+ default:
+ break;
+ }
+
+ switch (ffebld_arity (expr))
+ {
+ case 2:
+ if (ffestu_symter_end_transition_ (ffebld_left (expr)))
+ any = TRUE;
+ expr = ffebld_right (expr);
+ goto tail; /* :::::::::::::::::::: */
+
+ case 1:
+ expr = ffebld_left (expr);
+ goto tail; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+
+ return any;
+}
+
+/* ffestu_symter_exec_transition_ -- Update SYMTERs in expr w/in symbol
+
+ ffebld expr;
+ ffestu_symter_exec_transition_(expr);
+
+ Any SYMTER in expr's tree with whereNONE gets updated to the
+ (recursively transitioned) sym it identifies (DUMMY or COMMON). */
+
+static bool
+ffestu_symter_exec_transition_ (ffebld expr)
+{
+ ffesymbol symbol;
+ bool any = FALSE;
+
+ /* Label used for tail recursion (reset expr and go here instead of calling
+ self). */
+
+tail: /* :::::::::::::::::::: */
+
+ if (expr == NULL)
+ return any;
+
+ switch (ffebld_op (expr))
+ {
+ case FFEBLD_opITEM:
+ while (ffebld_trail (expr) != NULL)
+ {
+ if (ffestu_symter_exec_transition_ (ffebld_head (expr)))
+ any = TRUE;
+ expr = ffebld_trail (expr);
+ }
+ expr = ffebld_head (expr);
+ goto tail; /* :::::::::::::::::::: */
+
+ case FFEBLD_opSYMTER:
+ symbol = ffecom_sym_exec_transition (ffebld_symter (expr));
+ if ((symbol != NULL)
+ && ffesymbol_attr (symbol, FFESYMBOL_attrANY))
+ any = TRUE;
+ ffebld_set_info (expr, ffesymbol_info (symbol));
+ break;
+
+ case FFEBLD_opANY:
+ return TRUE;
+
+ default:
+ break;
+ }
+
+ switch (ffebld_arity (expr))
+ {
+ case 2:
+ if (ffestu_symter_exec_transition_ (ffebld_left (expr)))
+ any = TRUE;
+ expr = ffebld_right (expr);
+ goto tail; /* :::::::::::::::::::: */
+
+ case 1:
+ expr = ffebld_left (expr);
+ goto tail; /* :::::::::::::::::::: */
+
+ default:
+ break;
+ }
+
+ return any;
+}
+
+/* ffestu_dummies_transition_ -- Update SYMTERs in ITEM list w/in entry
+
+ ffebld list;
+ ffesymbol symfunc(ffesymbol s);
+ if (ffestu_dummies_transition_(symfunc,list))
+ // One or more items are still UNCERTAIN.
+
+ list contains an FFEBLD_opITEM list of SYMTERs (possibly STARs and
+ other things, too, but we'll ignore the known ones). For each SYMTER,
+ we run symfunc on the corresponding ffesymbol (a recursive
+ call, since that's the function that's calling us) to update it's
+ information. Then we copy that information into the SYMTER.
+
+ Return TRUE if any of the SYMTER's has incomplete information.
+
+ Make sure we don't get called recursively ourselves! */
+
+static bool
+ffestu_dummies_transition_ (ffesymbol (*symfunc) (), ffebld list)
+{
+ static in_progress = FALSE;
+ ffebld item;
+ ffesymbol symbol;
+ bool uncertain = FALSE;
+
+ assert (!in_progress);
+ in_progress = TRUE;
+
+ for (; list != NULL; list = ffebld_trail (list))
+ {
+ if ((item = ffebld_head (list)) == NULL)
+ continue; /* Try next item. */
+
+ switch (ffebld_op (item))
+ {
+ case FFEBLD_opSTAR:
+ break;
+
+ case FFEBLD_opSYMTER:
+ symbol = ffebld_symter (item);
+ if (symbol == NULL)
+ break; /* Detached from stmt func dummy list. */
+ symbol = (*symfunc) (symbol);
+ if (ffesymbol_state (symbol) == FFESYMBOL_stateUNCERTAIN)
+ uncertain = TRUE;
+ else
+ {
+ assert (ffesymbol_kind (symbol) != FFEINFO_kindNONE);
+ assert (ffesymbol_where (symbol) != FFEINFO_whereNONE);
+ }
+ ffebld_set_info (item, ffesymbol_info (symbol));
+ break;
+
+ default:
+ assert ("Unexpected item on list" == NULL);
+ break;
+ }
+ }
+
+ in_progress = FALSE;
+
+ return uncertain;
+}
diff --git a/gcc/f/stu.h b/gcc/f/stu.h
new file mode 100644
index 00000000000..1b1718c048f
--- /dev/null
+++ b/gcc/f/stu.h
@@ -0,0 +1,69 @@
+/* stu.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ stu.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_stu
+#define _H_f_stu
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "symbol.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+ffesymbol ffestu_sym_end_transition (ffesymbol s);
+ffesymbol ffestu_sym_exec_transition (ffesymbol s);
+
+/* Define macros. */
+
+#define ffestu_init_0()
+#define ffestu_init_1()
+#define ffestu_init_2()
+#define ffestu_init_3()
+#define ffestu_init_4()
+#define ffestu_terminate_0()
+#define ffestu_terminate_1()
+#define ffestu_terminate_2()
+#define ffestu_terminate_3()
+#define ffestu_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/stv.c b/gcc/f/stv.c
new file mode 100644
index 00000000000..bd62e699865
--- /dev/null
+++ b/gcc/f/stv.c
@@ -0,0 +1,66 @@
+/* stv.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None (despite the name, it doesn't really depend on ffest*)
+
+ Description:
+ Various and sundry info.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "stv.h"
+#include "lab.h"
+#include "where.h"
+
+/* Externals defined here. */
+
+ffestvSavestate ffestv_save_state_;
+ffewhereLine ffestv_save_line_;
+ffewhereColumn ffestv_save_col_;
+ffestvAccessstate ffestv_access_state_;
+ffewhereLine ffestv_access_line_;
+ffewhereColumn ffestv_access_col_;
+ffelabNumber ffestv_num_label_defines_;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
diff --git a/gcc/f/stv.h b/gcc/f/stv.h
new file mode 100644
index 00000000000..6cd9299aaf2
--- /dev/null
+++ b/gcc/f/stv.h
@@ -0,0 +1,165 @@
+/* stv.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ stv.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_stv
+#define _H_f_stv
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+ {
+ FFESTV_accessstateNONE, /* Haven't seen PUBLIC or PRIVATE yet. */
+ FFESTV_accessstatePUBLIC, /* Seen PUBLIC stmt w/o args. */
+ FFESTV_accessstatePRIVATE, /* Seen PRIVATE stmt w/o args. */
+ FFESTV_accessstateANY, /* Conflict seen and reported, so stop
+ whining. */
+ FFESTV_accessstate
+ } ffestvAccessstate;
+
+typedef enum
+ { /* Format specifier in an I/O statement. */
+ FFESTV_formatNONE, /* None. */
+ FFESTV_formatLABEL, /* Label (normal format). */
+ FFESTV_formatCHAREXPR, /* Character expression (normal format). */
+ FFESTV_formatASTERISK, /* Asterisk (list-directed). */
+ FFESTV_formatINTEXPR, /* Integer expression (assigned label). */
+ FFESTV_formatNAMELIST, /* Namelist (namelist-directed). */
+ FFESTV_format
+ } ffestvFormat;
+
+typedef enum
+ {
+ FFESTV_savestateNONE, /* Haven't seen SAVE stmt or attribute yet. */
+ FFESTV_savestateSPECIFIC, /* Seen SAVE stmt w/args or SAVE attr. */
+ FFESTV_savestateALL, /* Seen SAVE stmt w/o args. */
+ FFESTV_savestateANY, /* Conflict seen and reported, so stop
+ whining. */
+ FFESTV_savestate
+ } ffestvSavestate;
+
+typedef enum
+ {
+ FFESTV_stateNIL, /* Initial state, and after end of outer prog
+ unit. */
+ FFESTV_statePROGRAM0, /* After PROGRAM. */
+ FFESTV_statePROGRAM1, /* Before first non-USE statement. */
+ FFESTV_statePROGRAM2, /* After IMPLICIT NONE. */
+ FFESTV_statePROGRAM3, /* After IMPLICIT, PARAMETER, FORMAT. */
+ FFESTV_statePROGRAM4, /* Before executable stmt or CONTAINS. */
+ FFESTV_statePROGRAM5, /* After CONTAINS. */
+ FFESTV_stateSUBROUTINE0, /* After SUBROUTINE. */
+ FFESTV_stateSUBROUTINE1, /* Before first non-USE statement. */
+ FFESTV_stateSUBROUTINE2, /* After IMPLICIT NONE. */
+ FFESTV_stateSUBROUTINE3, /* After IMPLICIT, PARAMETER, FORMAT, ENTRY. */
+ FFESTV_stateSUBROUTINE4, /* Before executable stmt or CONTAINS. */
+ FFESTV_stateSUBROUTINE5, /* After CONTAINS. */
+ FFESTV_stateFUNCTION0, /* After FUNCTION. */
+ FFESTV_stateFUNCTION1, /* Before first non-USE statement. */
+ FFESTV_stateFUNCTION2, /* After IMPLICIT NONE. */
+ FFESTV_stateFUNCTION3, /* After IMPLICIT, PARAMETER, FORMAT, ENTRY. */
+ FFESTV_stateFUNCTION4, /* Before executable stmt or CONTAINS. */
+ FFESTV_stateFUNCTION5, /* After CONTAINS. */
+ FFESTV_stateMODULE0, /* After MODULE. */
+ FFESTV_stateMODULE1, /* Before first non-USE statement. */
+ FFESTV_stateMODULE2, /* After IMPLICIT NONE. */
+ FFESTV_stateMODULE3, /* After IMPLICIT, PARAMETER, FORMAT, ENTRY. */
+ FFESTV_stateMODULE4, /* Before executable stmt or CONTAINS. */
+ FFESTV_stateMODULE5, /* After CONTAINS. */
+ FFESTV_stateBLOCKDATA0, /* After BLOCKDATA. */
+ FFESTV_stateBLOCKDATA1, /* Before first non-USE statement. */
+ FFESTV_stateBLOCKDATA2, /* After IMPLICIT NONE. */
+ FFESTV_stateBLOCKDATA3, /* After IMPLICIT, PARAMETER, FORMAT, ENTRY. */
+ FFESTV_stateBLOCKDATA4, /* Before executable stmt or CONTAINS. */
+ FFESTV_stateBLOCKDATA5, /* After CONTAINS. */
+ FFESTV_stateUSE, /* Before first USE thru last USE. */
+ FFESTV_stateTYPE, /* After TYPE thru END TYPE. */
+ FFESTV_stateINTERFACE0, /* After INTERFACE thru MODULE PROCEDURE. */
+ FFESTV_stateINTERFACE1, /* After MODULE PROCEDURE thru END INTERFACE. */
+ FFESTV_stateSTRUCTURE, /* After STRUCTURE thru END STRUCTURE. */
+ FFESTV_stateUNION, /* After UNION thru END UNION. */
+ FFESTV_stateMAP, /* After MAP thru END MAP. */
+ FFESTV_stateWHERETHEN, /* After WHERE-construct thru END WHERE. */
+ FFESTV_stateWHERE, /* After WHERE-stmt thru next stmt. */
+ FFESTV_stateIFTHEN, /* After IF THEN thru END IF. */
+ FFESTV_stateIF, /* After IF thru next stmt. */
+ FFESTV_stateDO, /* After DO thru END DO or terminating label. */
+ FFESTV_stateSELECT0, /* After SELECT to before first CASE. */
+ FFESTV_stateSELECT1, /* First CASE in SELECT thru END SELECT. */
+ FFESTV_state
+ } ffestvState;
+
+typedef enum
+ { /* Unit specifier. */
+ FFESTV_unitNONE, /* None. */
+ FFESTV_unitINTEXPR, /* Integer expression (external file unit). */
+ FFESTV_unitASTERISK, /* Default unit. */
+ FFESTV_unitCHAREXPR, /* Character expression (internal file unit). */
+ FFESTV_unit
+ } ffestvUnit;
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "lab.h"
+#include "where.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+extern ffestvSavestate ffestv_save_state_;
+extern ffewhereLine ffestv_save_line_;
+extern ffewhereColumn ffestv_save_col_;
+extern ffestvAccessstate ffestv_access_state_;
+extern ffewhereLine ffestv_access_line_;
+extern ffewhereColumn ffestv_access_col_;
+extern ffelabNumber ffestv_num_label_defines_;
+
+/* Declare functions with prototypes. */
+
+
+/* Define macros. */
+
+#define ffestv_init_0()
+#define ffestv_init_1()
+#define ffestv_init_2()
+#define ffestv_init_3()
+#define ffestv_init_4()
+#define ffestv_terminate_0()
+#define ffestv_terminate_1()
+#define ffestv_terminate_2()
+#define ffestv_terminate_3()
+#define ffestv_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/stw.c b/gcc/f/stw.c
new file mode 100644
index 00000000000..70d8803dcb0
--- /dev/null
+++ b/gcc/f/stw.c
@@ -0,0 +1,428 @@
+/* stw.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None (despite the name, it doesn't really depend on ffest*)
+
+ Description:
+ Provides abstraction and stack mechanism to track the block structure
+ of a Fortran program.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "stw.h"
+#include "bld.h"
+#include "com.h"
+#include "info.h"
+#include "lab.h"
+#include "lex.h"
+#include "malloc.h"
+#include "sta.h"
+#include "stv.h"
+#include "symbol.h"
+#include "where.h"
+
+/* Externals defined here. */
+
+ffestw ffestw_stack_top_ = NULL;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffestw_display_state -- DEBUGGING; display current block state
+
+ ffestw_display_state(); */
+
+void
+ffestw_display_state ()
+{
+ assert (ffestw_stack_top_ != NULL);
+
+ if (!ffe_is_ffedebug ())
+ return;
+
+ fprintf (dmpout, "; block %lu, state ", ffestw_stack_top_->blocknum_);
+ switch (ffestw_stack_top_->state_)
+ {
+ case FFESTV_stateNIL:
+ fputs ("NIL", dmpout);
+ break;
+
+ case FFESTV_statePROGRAM0:
+ fputs ("PROGRAM0", dmpout);
+ break;
+
+ case FFESTV_statePROGRAM1:
+ fputs ("PROGRAM1", dmpout);
+ break;
+
+ case FFESTV_statePROGRAM2:
+ fputs ("PROGRAM2", dmpout);
+ break;
+
+ case FFESTV_statePROGRAM3:
+ fputs ("PROGRAM3", dmpout);
+ break;
+
+ case FFESTV_statePROGRAM4:
+ fputs ("PROGRAM4", dmpout);
+ break;
+
+ case FFESTV_statePROGRAM5:
+ fputs ("PROGRAM5", dmpout);
+ break;
+
+ case FFESTV_stateSUBROUTINE0:
+ fputs ("SUBROUTINE0", dmpout);
+ break;
+
+ case FFESTV_stateSUBROUTINE1:
+ fputs ("SUBROUTINE1", dmpout);
+ break;
+
+ case FFESTV_stateSUBROUTINE2:
+ fputs ("SUBROUTINE2", dmpout);
+ break;
+
+ case FFESTV_stateSUBROUTINE3:
+ fputs ("SUBROUTINE3", dmpout);
+ break;
+
+ case FFESTV_stateSUBROUTINE4:
+ fputs ("SUBROUTINE4", dmpout);
+ break;
+
+ case FFESTV_stateSUBROUTINE5:
+ fputs ("SUBROUTINE5", dmpout);
+ break;
+
+ case FFESTV_stateFUNCTION0:
+ fputs ("FUNCTION0", dmpout);
+ break;
+
+ case FFESTV_stateFUNCTION1:
+ fputs ("FUNCTION1", dmpout);
+ break;
+
+ case FFESTV_stateFUNCTION2:
+ fputs ("FUNCTION2", dmpout);
+ break;
+
+ case FFESTV_stateFUNCTION3:
+ fputs ("FUNCTION3", dmpout);
+ break;
+
+ case FFESTV_stateFUNCTION4:
+ fputs ("FUNCTION4", dmpout);
+ break;
+
+ case FFESTV_stateFUNCTION5:
+ fputs ("FUNCTION5", dmpout);
+ break;
+
+ case FFESTV_stateMODULE0:
+ fputs ("MODULE0", dmpout);
+ break;
+
+ case FFESTV_stateMODULE1:
+ fputs ("MODULE1", dmpout);
+ break;
+
+ case FFESTV_stateMODULE2:
+ fputs ("MODULE2", dmpout);
+ break;
+
+ case FFESTV_stateMODULE3:
+ fputs ("MODULE3", dmpout);
+ break;
+
+ case FFESTV_stateMODULE4:
+ fputs ("MODULE4", dmpout);
+ break;
+
+ case FFESTV_stateMODULE5:
+ fputs ("MODULE5", dmpout);
+ break;
+
+ case FFESTV_stateBLOCKDATA0:
+ fputs ("BLOCKDATA0", dmpout);
+ break;
+
+ case FFESTV_stateBLOCKDATA1:
+ fputs ("BLOCKDATA1", dmpout);
+ break;
+
+ case FFESTV_stateBLOCKDATA2:
+ fputs ("BLOCKDATA2", dmpout);
+ break;
+
+ case FFESTV_stateBLOCKDATA3:
+ fputs ("BLOCKDATA3", dmpout);
+ break;
+
+ case FFESTV_stateBLOCKDATA4:
+ fputs ("BLOCKDATA4", dmpout);
+ break;
+
+ case FFESTV_stateBLOCKDATA5:
+ fputs ("BLOCKDATA5", dmpout);
+ break;
+
+ case FFESTV_stateUSE:
+ fputs ("USE", dmpout);
+ break;
+
+ case FFESTV_stateTYPE:
+ fputs ("TYPE", dmpout);
+ break;
+
+ case FFESTV_stateINTERFACE0:
+ fputs ("INTERFACE0", dmpout);
+ break;
+
+ case FFESTV_stateINTERFACE1:
+ fputs ("INTERFACE1", dmpout);
+ break;
+
+ case FFESTV_stateSTRUCTURE:
+ fputs ("STRUCTURE", dmpout);
+ break;
+
+ case FFESTV_stateUNION:
+ fputs ("UNION", dmpout);
+ break;
+
+ case FFESTV_stateMAP:
+ fputs ("MAP", dmpout);
+ break;
+
+ case FFESTV_stateWHERETHEN:
+ fputs ("WHERETHEN", dmpout);
+ break;
+
+ case FFESTV_stateWHERE:
+ fputs ("WHERE", dmpout);
+ break;
+
+ case FFESTV_stateIFTHEN:
+ fputs ("IFTHEN", dmpout);
+ break;
+
+ case FFESTV_stateIF:
+ fputs ("IF", dmpout);
+ break;
+
+ case FFESTV_stateDO:
+ fputs ("DO", dmpout);
+ break;
+
+ case FFESTV_stateSELECT0:
+ fputs ("SELECT0", dmpout);
+ break;
+
+ case FFESTV_stateSELECT1:
+ fputs ("SELECT1", dmpout);
+ break;
+
+ default:
+ assert ("bad state" == NULL);
+ break;
+ }
+ if (ffestw_stack_top_->top_do_ != NULL)
+ fputs (" (within DO)", dmpout);
+ fputc ('\n', dmpout);
+}
+
+/* ffestw_init_0 -- Initialize ffestw structures
+
+ ffestw_init_0(); */
+
+void
+ffestw_init_0 ()
+{
+ ffestw b;
+
+ ffestw_stack_top_ = b = (ffestw) malloc_new_kp (malloc_pool_image (),
+ "FFESTW stack base", sizeof (*b));
+ b->uses_ = 0; /* catch if anyone uses, kills, &c this
+ block. */
+ b->next_ = NULL;
+ b->previous_ = NULL;
+ b->top_do_ = NULL;
+ b->blocknum_ = 0;
+ b->shriek_ = NULL;
+ b->state_ = FFESTV_stateNIL;
+ b->line_ = ffewhere_line_unknown ();
+ b->col_ = ffewhere_column_unknown ();
+}
+
+/* ffestw_kill -- Kill block
+
+ ffestw b;
+ ffestw_kill(b); */
+
+void
+ffestw_kill (ffestw b)
+{
+ assert (b != NULL);
+ assert (b->uses_ > 0);
+
+ if (--b->uses_ != 0)
+ return;
+
+ ffewhere_line_kill (b->line_);
+ ffewhere_column_kill (b->col_);
+}
+
+/* ffestw_new -- Create block
+
+ ffestw b;
+ b = ffestw_new(); */
+
+ffestw
+ffestw_new ()
+{
+ ffestw b;
+
+ b = (ffestw) malloc_new_kp (malloc_pool_image (), "FFESTW", sizeof (*b));
+ b->uses_ = 1;
+
+ return b;
+}
+
+/* ffestw_pop -- Pop block off stack
+
+ ffestw_pop(); */
+
+ffestw
+ffestw_pop ()
+{
+ ffestw b;
+ ffestw oldb = ffestw_stack_top_;
+
+ assert (oldb != NULL);
+ ffestw_stack_top_ = b = ffestw_stack_top_->previous_;
+ assert (b != NULL);
+ if ((ffewhere_line_is_unknown (b->line_) || ffewhere_column_is_unknown (b->col_))
+ && (ffesta_tokens[0] != NULL))
+ {
+ assert (b->state_ == FFESTV_stateNIL);
+ if (ffewhere_line_is_unknown (b->line_))
+ b->line_
+ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+ if (ffewhere_column_is_unknown (b->col_))
+ b->col_
+ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+ }
+
+ return oldb;
+}
+
+/* ffestw_push -- Push block onto stack, return its address
+
+ ffestw b; // NULL if new block to be obtained first.
+ ffestw_push(b);
+
+ Returns address of block if desired, also updates ffestw_stack_top_
+ to point to it.
+
+ 30-Oct-91 JCB 2.0
+ Takes block as arg, or NULL if new block needed. */
+
+ffestw
+ffestw_push (ffestw b)
+{
+ if (b == NULL)
+ b = ffestw_new ();
+
+ b->next_ = NULL;
+ b->previous_ = ffestw_stack_top_;
+ b->line_ = ffewhere_line_unknown ();
+ b->col_ = ffewhere_column_unknown ();
+ ffestw_stack_top_ = b;
+ return b;
+}
+
+/* ffestw_update -- Update current block line/col info
+
+ ffestw_update();
+
+ Updates block to point to current statement. */
+
+ffestw
+ffestw_update (ffestw b)
+{
+ if (b == NULL)
+ {
+ b = ffestw_stack_top_;
+ assert (b != NULL);
+ }
+
+ if (ffesta_tokens[0] == NULL)
+ return b;
+
+ ffewhere_line_kill (b->line_);
+ ffewhere_column_kill (b->col_);
+ b->line_ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
+ b->col_ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
+
+ return b;
+}
+
+/* ffestw_use -- Mark extra use of block
+
+ ffestw b;
+ b = ffestw_use(b); // will always return original copy of b
+
+ Increments use counter for b. */
+
+ffestw
+ffestw_use (ffestw b)
+{
+ assert (b != NULL);
+ assert (b->uses_ != 0);
+
+ ++b->uses_;
+
+ return b;
+}
diff --git a/gcc/f/stw.h b/gcc/f/stw.h
new file mode 100644
index 00000000000..54643b833d4
--- /dev/null
+++ b/gcc/f/stw.h
@@ -0,0 +1,184 @@
+/* stw.h -- Private #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ stw.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_stw
+#define _H_f_stw
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+typedef struct _ffestw_ *ffestw;
+typedef struct _ffestw_case_ *ffestwCase;
+typedef struct _ffestw_select_ *ffestwSelect;
+typedef void (*ffestwShriek) (bool ok);
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "com.h"
+#include "info.h"
+#include "lab.h"
+#include "lex.h"
+#include "malloc.h"
+#include "stv.h"
+#include "symbol.h"
+#include "where.h"
+
+/* Structure definitions. */
+
+struct _ffestw_
+ {
+ ffestw next_; /* Next (unused) block, or NULL. */
+ ffestw previous_; /* Previous block, NULL if this is NIL state. */
+ ffestw top_do_; /* Previous or current DO state, or NULL. */
+ unsigned long blocknum_; /* Block # w/in procedure/program. */
+ ffestwShriek shriek_; /* Call me to pop block in a hurry. */
+ ffesymbol sym_; /* Related symbol (if there is one). */
+ ffelexToken name_; /* Construct name (IFTHEN, SELECT, DO only). */
+ ffestwSelect select_; /* Info for SELECT CASE blocks. */
+ ffelab label_; /* For DO blocks w/labels, the target label. */
+ ffesymbol do_iter_var_; /* For iter DO blocks, the iter var or NULL. */
+ ffelexToken do_iter_var_t_; /* The token for do_iter_var. */
+ ffewhereLine line_; /* Where first token of statement triggering
+ state */
+ ffewhereColumn col_; /* was seen in source file. */
+ char uses_; /* # uses (new+use-kill calls). */
+ ffestvState state_;
+ int substate_; /* Used on a per-block-state basis. */
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+ struct nesting *do_hook_; /* backend id for given loop (EXIT/CYCLE). */
+ tree do_tvar_; /* tree form of do_iter_var. */
+ tree do_incr_saved_; /* tree SAVED_EXPR of incr expr. */
+ tree do_count_var_; /* tree of countdown variable. */
+ tree select_texpr_; /* tree for end case. */
+ bool select_break_; /* TRUE when CASE should start with gen
+ "break;". */
+#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC*/
+ };
+
+struct _ffestw_case_
+ {
+ ffestwCase next_rel; /* Next case range in relational order. */
+ ffestwCase previous_rel; /* Previous case range in relational order. */
+ ffestwCase next_stmt; /* Next range in stmt or first in next stmt. */
+ ffestwCase previous_stmt; /* Previous range. */
+ ffebldConstant low; /* Low value in range. */
+ ffebldConstant high; /* High value in range. */
+ unsigned long casenum; /* CASE stmt index for this range/value. */
+ ffelexToken t; /* Token for this range/value; ffestc only. */
+ };
+
+struct _ffestw_select_
+ {
+ ffestwCase first_rel; /* First CASE range (after low) in order. */
+ ffestwCase last_rel; /* Last CASE range (before high) in order. */
+ ffestwCase first_stmt; /* First range in first CASE stmt. */
+ ffestwCase last_stmt; /* Last range in last CASE stmt. */
+ mallocPool pool; /* Pool in which this and all cases are
+ allocated. */
+ unsigned long cases; /* Number of CASE stmts seen so far. */
+ ffelexToken t; /* First token of selected expression; ffestc
+ only. */
+ ffeinfoBasictype type; /* Basic type (integer, character, or
+ logical). */
+ ffeinfoKindtype kindtype; /* Kind type. */
+ };
+
+/* Global objects accessed by users of this module. */
+
+extern ffestw ffestw_stack_top_;
+
+/* Declare functions with prototypes. */
+
+void ffestw_display_state ();
+void ffestw_kill (ffestw block);
+void ffestw_init_0 (void);
+ffestw ffestw_new ();
+ffestw ffestw_pop ();
+ffestw ffestw_push (ffestw block);
+ffestw ffestw_update (ffestw block);
+ffestw ffestw_use (ffestw block);
+
+/* Define macros. */
+
+#define ffestw_blocknum(b) ((b)->blocknum_)
+#define ffestw_col(b) ((b)->col_)
+#define ffestw_do_count_var(b) ((b)->do_count_var_)
+#define ffestw_do_hook(b) ((b)->do_hook_)
+#define ffestw_do_incr_saved(b) ((b)->do_incr_saved_)
+#define ffestw_do_iter_var(b) ((b)->do_iter_var_)
+#define ffestw_do_iter_var_t(b) ((b)->do_iter_var_t_)
+#define ffestw_do_tvar(b) ((b)->do_tvar_)
+#define ffestw_init_1()
+#define ffestw_init_2()
+#define ffestw_init_3()
+#define ffestw_init_4()
+#define ffestw_label(b) ((b)->label_)
+#define ffestw_line(b) ((b)->line_)
+#define ffestw_name(b) ((b)->name_)
+#define ffestw_previous(b) ((b)->previous_)
+#define ffestw_select(b) ((b)->select_)
+#define ffestw_select_break(b) ((b)->select_break_)
+#define ffestw_select_texpr(b) ((b)->select_texpr_)
+#define ffestw_set_blocknum(b,bl) ((b)->blocknum_ = (bl))
+#define ffestw_set_col(b,c) ((b)->col_ = (c))
+#define ffestw_set_do_count_var(b,d) ((b)->do_count_var_ = (d))
+#define ffestw_set_do_hook(b,d) ((b)->do_hook_ = (d))
+#define ffestw_set_do_incr_saved(b,d) ((b)->do_incr_saved_ = (d))
+#define ffestw_set_do_iter_var(b,v) ((b)->do_iter_var_ = (v))
+#define ffestw_set_do_iter_var_t(b,t) ((b)->do_iter_var_t_ = (t))
+#define ffestw_set_do_tvar(b,d) ((b)->do_tvar_ = (d))
+#define ffestw_set_label(b,l) ((b)->label_ = (l))
+#define ffestw_set_line(b,l) ((b)->line_ = (l))
+#define ffestw_set_name(b,n) ((b)->name_ = (n))
+#define ffestw_set_select(b,s) ((b)->select_ = (s))
+#define ffestw_set_select_break(b,br) ((b)->select_break_ = (br))
+#define ffestw_set_select_texpr(b,t) ((b)->select_texpr_ = (t))
+#define ffestw_set_shriek(b,s) ((b)->shriek_ = (s))
+#define ffestw_set_state(b,s) ((b)->state_ = (s))
+#define ffestw_set_substate(b,s) ((b)->substate_ = (s))
+#define ffestw_set_sym(b,s) ((b)->sym_= (s))
+#define ffestw_set_top_do(b,t) ((b)->top_do_ = (t))
+#define ffestw_shriek(b) ((b)->shriek_)
+#define ffestw_stack_top() ffestw_stack_top_
+#define ffestw_state(b) ((b)->state_)
+#define ffestw_substate(b) ((b)->substate_)
+#define ffestw_sym(b) ((b)->sym_)
+#define ffestw_terminate_0()
+#define ffestw_terminate_1()
+#define ffestw_terminate_2()
+#define ffestw_terminate_3()
+#define ffestw_terminate_4()
+#define ffestw_top_do(b) ((b)->top_do_)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/symbol.c b/gcc/f/symbol.c
new file mode 100644
index 00000000000..7199cdb9c7c
--- /dev/null
+++ b/gcc/f/symbol.c
@@ -0,0 +1,1469 @@
+/* Implementation of Fortran symbol manager
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#include "proj.h"
+#include "symbol.h"
+#include "bad.h"
+#include "bld.h"
+#include "com.h"
+#include "equiv.h"
+#include "global.h"
+#include "info.h"
+#include "intrin.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#include "st.h"
+#include "storag.h"
+#include "target.h"
+#include "where.h"
+
+/* Choice of how to handle global symbols -- either global only within the
+ program unit being defined or global within the entire source file.
+ The former is appropriate for systems where an object file can
+ easily be taken apart program unit by program unit, the latter is the
+ UNIX/C model where the object file is essentially a monolith. */
+
+#define FFESYMBOL_globalPROGUNIT_ 1
+#define FFESYMBOL_globalFILE_ 2
+
+/* Choose how to handle global symbols here. */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+#define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_
+#elif FFECOM_targetCURRENT == FFECOM_targetGCC
+/* Would be good to understand why PROGUNIT in this case too.
+ (1995-08-22). */
+#define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_
+#else
+#error
+#endif
+
+/* Choose how to handle memory pools based on global symbol stuff. */
+
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
+#define FFESYMBOL_SPACE_POOL_ ffe_pool_program_unit()
+#elif FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
+#define FFESYMBOL_SPACE_POOL_ ffe_pool_file()
+#else
+#error
+#endif
+
+/* What kind of retraction is needed for a symbol? */
+
+enum _ffesymbol_retractcommand_
+ {
+ FFESYMBOL_retractcommandDELETE_,
+ FFESYMBOL_retractcommandRETRACT_,
+ FFESYMBOL_retractcommand_
+ };
+typedef enum _ffesymbol_retractcommand_ ffesymbolRetractCommand_;
+
+/* This object keeps track of retraction for a symbol and links to the next
+ such object. */
+
+typedef struct _ffesymbol_retract_ *ffesymbolRetract_;
+struct _ffesymbol_retract_
+ {
+ ffesymbolRetract_ next;
+ ffesymbolRetractCommand_ command;
+ ffesymbol live; /* Live symbol. */
+ ffesymbol symbol; /* Backup copy of symbol. */
+ };
+
+static ffebad ffesymbol_check_token_ (ffelexToken t, char *c);
+static void ffesymbol_kill_manifest_ (void);
+static ffesymbol ffesymbol_new_ (ffename n);
+static ffesymbol ffesymbol_unhook_ (ffesymbol s);
+static void ffesymbol_whine_state_ (ffebad bad, ffelexToken t, char c);
+
+/* Manifest names for unnamed things (as tokens) so we make them only
+ once. */
+
+static ffelexToken ffesymbol_token_blank_common_ = NULL;
+static ffelexToken ffesymbol_token_unnamed_main_ = NULL;
+static ffelexToken ffesymbol_token_unnamed_blockdata_ = NULL;
+
+/* Name spaces currently in force. */
+
+static ffenameSpace ffesymbol_global_ = NULL;
+static ffenameSpace ffesymbol_local_ = NULL;
+static ffenameSpace ffesymbol_sfunc_ = NULL;
+
+/* Keep track of retraction. */
+
+static bool ffesymbol_retractable_ = FALSE;
+static mallocPool ffesymbol_retract_pool_;
+static ffesymbolRetract_ ffesymbol_retract_first_;
+static ffesymbolRetract_ *ffesymbol_retract_list_;
+
+/* List of state names. */
+
+static char *ffesymbol_state_name_[] =
+{
+ "?",
+ "@",
+ "&",
+ "$",
+};
+
+/* List of attribute names. */
+
+static char *ffesymbol_attr_name_[] =
+{
+#define DEFATTR(ATTR,ATTRS,NAME) NAME,
+#include "symbol.def"
+#undef DEFATTR
+};
+
+
+/* Check whether the token text has any invalid characters. If not,
+ return FALSE. If so, if error messages inhibited, return TRUE
+ so caller knows to try again later, else report error and return
+ FALSE. */
+
+static ffebad
+ffesymbol_check_token_ (ffelexToken t, char *c)
+{
+ char *p = ffelex_token_text (t);
+ ffeTokenLength len = ffelex_token_length (t);
+ ffebad bad;
+ ffeTokenLength i = 0;
+ ffebad skip_me = ((ffe_case_symbol () == FFE_caseINITCAP)
+ ? FFEBAD_SYMBOL_NOLOWER_INITCAP : FFEBAD + 1);
+ ffebad stop_me = ((ffe_case_symbol () == FFE_caseINITCAP)
+ ? FFEBAD : FFEBAD + 1);
+ if (len == 0)
+ return FFEBAD;
+
+ bad = ffesrc_bad_char_symbol_init (*p);
+ if (bad == FFEBAD)
+ {
+ for (++i, ++p; i < len; ++i, ++p)
+ {
+ bad = ffesrc_bad_char_symbol_noninit (*p);
+ if (bad == skip_me)
+ continue; /* Keep looking for good InitCap character. */
+ if (bad == stop_me)
+ break; /* Found good InitCap character. */
+ if (bad != FFEBAD)
+ break; /* Bad character found. */
+ }
+ }
+
+ if (bad != FFEBAD)
+ if (i >= len)
+ *c = *(ffelex_token_text (t));
+ else
+ *c = *p;
+
+ return bad;
+}
+
+/* Kill manifest (g77-picked) names. */
+
+static void
+ffesymbol_kill_manifest_ ()
+{
+ if (ffesymbol_token_blank_common_ != NULL)
+ ffelex_token_kill (ffesymbol_token_blank_common_);
+ if (ffesymbol_token_unnamed_main_ != NULL)
+ ffelex_token_kill (ffesymbol_token_unnamed_main_);
+ if (ffesymbol_token_unnamed_blockdata_ != NULL)
+ ffelex_token_kill (ffesymbol_token_unnamed_blockdata_);
+
+ ffesymbol_token_blank_common_ = NULL;
+ ffesymbol_token_unnamed_main_ = NULL;
+ ffesymbol_token_unnamed_blockdata_ = NULL;
+}
+
+/* Make new symbol.
+
+ If the "retractable" flag is not set, just return the new symbol.
+ Else, add symbol to the "retract" list as a delete item, set
+ the "have_old" flag, and return the new symbol. */
+
+static ffesymbol
+ffesymbol_new_ (ffename n)
+{
+ ffesymbol s;
+ ffesymbolRetract_ r;
+
+ assert (n != NULL);
+
+ s = (ffesymbol) malloc_new_ks (FFESYMBOL_SPACE_POOL_, "FFESYMBOL",
+ sizeof (*s));
+ s->name = n;
+ s->other_space_name = NULL;
+#if FFEGLOBAL_ENABLED
+ s->global = NULL;
+#endif
+ s->attrs = FFESYMBOL_attrsetNONE;
+ s->state = FFESYMBOL_stateNONE;
+ s->info = ffeinfo_new_null ();
+ s->dims = NULL;
+ s->extents = NULL;
+ s->dim_syms = NULL;
+ s->array_size = NULL;
+ s->init = NULL;
+ s->accretion = NULL;
+ s->accretes = 0;
+ s->dummy_args = NULL;
+ s->namelist = NULL;
+ s->common_list = NULL;
+ s->sfunc_expr = NULL;
+ s->list_bottom = NULL;
+ s->common = NULL;
+ s->equiv = NULL;
+ s->storage = NULL;
+#ifdef FFECOM_symbolHOOK
+ s->hook = FFECOM_symbolNULL;
+#endif
+ s->sfa_dummy_parent = NULL;
+ s->func_result = NULL;
+ s->value = 0;
+ s->check_state = FFESYMBOL_checkstateNONE_;
+ s->check_token = NULL;
+ s->max_entry_num = 0;
+ s->num_entries = 0;
+ s->generic = FFEINTRIN_genNONE;
+ s->specific = FFEINTRIN_specNONE;
+ s->implementation = FFEINTRIN_impNONE;
+ s->is_save = FALSE;
+ s->is_init = FALSE;
+ s->do_iter = FALSE;
+ s->reported = FALSE;
+ s->explicit_where = FALSE;
+ s->namelisted = FALSE;
+
+ ffename_set_symbol (n, s);
+
+ if (!ffesymbol_retractable_)
+ {
+ s->have_old = FALSE;
+ return s;
+ }
+
+ r = (ffesymbolRetract_) malloc_new_kp (ffesymbol_retract_pool_,
+ "FFESYMBOL retract", sizeof (*r));
+ r->next = NULL;
+ r->command = FFESYMBOL_retractcommandDELETE_;
+ r->live = s;
+ r->symbol = NULL; /* No backup copy. */
+
+ *ffesymbol_retract_list_ = r;
+ ffesymbol_retract_list_ = &r->next;
+
+ s->have_old = TRUE;
+ return s;
+}
+
+/* Unhook a symbol from its (soon-to-be-killed) name obj.
+
+ NULLify the names to which this symbol points. Do other cleanup as
+ needed. */
+
+static ffesymbol
+ffesymbol_unhook_ (ffesymbol s)
+{
+ s->other_space_name = s->name = NULL;
+ if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK)
+ || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
+ ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
+ if (s->check_state == FFESYMBOL_checkstatePENDING_)
+ ffelex_token_kill (s->check_token);
+
+ return s;
+}
+
+/* Issue diagnostic about bad character in token representing user-defined
+ symbol name. */
+
+static void
+ffesymbol_whine_state_ (ffebad bad, ffelexToken t, char c)
+{
+ char badstr[2];
+
+ badstr[0] = c;
+ badstr[1] = '\0';
+
+ ffebad_start (bad);
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_string (badstr);
+ ffebad_finish ();
+}
+
+/* Returns a string representing the attributes set. */
+
+char *
+ffesymbol_attrs_string (ffesymbolAttrs attrs)
+{
+ static char string[FFESYMBOL_attr * 12 + 20];
+ char *p;
+ ffesymbolAttr attr;
+
+ p = &string[0];
+
+ if (attrs == FFESYMBOL_attrsetNONE)
+ {
+ strcpy (p, "NONE");
+ return &string[0];
+ }
+
+ for (attr = 0; attr < FFESYMBOL_attr; ++attr)
+ {
+ if (attrs & ((ffesymbolAttrs) 1 << attr))
+ {
+ attrs &= ~((ffesymbolAttrs) 1 << attr);
+ strcpy (p, ffesymbol_attr_name_[attr]);
+ while (*p)
+ ++p;
+ *(p++) = '|';
+ }
+ }
+ if (attrs == FFESYMBOL_attrsetNONE)
+ *--p = '\0';
+ else
+ sprintf (p, "?0x%" ffesymbolAttrs_f "x?", attrs);
+ assert (((size_t) (p - &string[0])) < ARRAY_SIZE (string));
+ return &string[0];
+}
+
+/* Check symbol's name for validity, considering that it might actually
+ be an intrinsic and thus should not be complained about just yet. */
+
+void
+ffesymbol_check (ffesymbol s, ffelexToken t, bool maybe_intrin)
+{
+ char c;
+ ffebad bad;
+ ffeintrinGen gen;
+ ffeintrinSpec spec;
+ ffeintrinImp imp;
+
+ if (!ffesrc_check_symbol ()
+ || ((s->check_state != FFESYMBOL_checkstateNONE_)
+ && ((s->check_state != FFESYMBOL_checkstateINHIBITED_)
+ || ffebad_inhibit ())))
+ return;
+
+ bad = ffesymbol_check_token_ (t, &c);
+
+ if (bad == FFEBAD)
+ {
+ s->check_state = FFESYMBOL_checkstateCHECKED_;
+ return;
+ }
+
+ if (maybe_intrin
+ && ffeintrin_is_intrinsic (ffelex_token_text (t), NULL, FALSE,
+ &gen, &spec, &imp))
+ {
+ s->check_state = FFESYMBOL_checkstatePENDING_;
+ s->check_token = ffelex_token_use (t);
+ return;
+ }
+
+ if (ffebad_inhibit ())
+ {
+ s->check_state = FFESYMBOL_checkstateINHIBITED_;
+ return; /* Don't complain now, do it later. */
+ }
+
+ s->check_state = FFESYMBOL_checkstateCHECKED_;
+
+ ffesymbol_whine_state_ (bad, t, c);
+}
+
+/* Declare a BLOCKDATA unit.
+
+ Retrieves or creates the ffesymbol for the specified BLOCKDATA (unnamed
+ if t is NULL). Doesn't actually ensure the named item is a
+ BLOCKDATA; the caller must handle that. */
+
+ffesymbol
+ffesymbol_declare_blockdataunit (ffelexToken t, ffewhereLine wl,
+ ffewhereColumn wc)
+{
+ ffename n;
+ ffesymbol s;
+ bool user = (t != NULL);
+
+ assert (!ffesymbol_retractable_);
+
+ if (t == NULL)
+ {
+ if (ffesymbol_token_unnamed_blockdata_ == NULL)
+ ffesymbol_token_unnamed_blockdata_
+ = ffelex_token_new_name (FFETARGET_nameUNNAMED_BLOCK_DATA, wl, wc);
+ t = ffesymbol_token_unnamed_blockdata_;
+ }
+
+ n = ffename_lookup (ffesymbol_local_, t);
+ if (n != NULL)
+ return ffename_symbol (n); /* This will become an error. */
+
+ n = ffename_find (ffesymbol_global_, t);
+ s = ffename_symbol (n);
+ if (s != NULL)
+ {
+ if (user)
+ ffesymbol_check (s, t, FALSE);
+ return s;
+ }
+
+ s = ffesymbol_new_ (n);
+ if (user)
+ ffesymbol_check (s, t, FALSE);
+
+ /* A program unit name also is in the local name space. */
+
+ n = ffename_find (ffesymbol_local_, t);
+ ffename_set_symbol (n, s);
+ s->other_space_name = n;
+
+ ffeglobal_new_blockdata (s, t); /* Detect conflicts, when
+ appropriate. */
+
+ return s;
+}
+
+/* Declare a common block (named or unnamed).
+
+ Retrieves or creates the ffesymbol for the specified common block (blank
+ common if t is NULL). Doesn't actually ensure the named item is a
+ common block; the caller must handle that. */
+
+ffesymbol
+ffesymbol_declare_cblock (ffelexToken t, ffewhereLine wl, ffewhereColumn wc)
+{
+ ffename n;
+ ffesymbol s;
+ bool blank;
+
+ assert (!ffesymbol_retractable_);
+
+ if (t == NULL)
+ {
+ blank = TRUE;
+ if (ffesymbol_token_blank_common_ == NULL)
+ ffesymbol_token_blank_common_
+ = ffelex_token_new_name (FFETARGET_nameBLANK_COMMON, wl, wc);
+ t = ffesymbol_token_blank_common_;
+ }
+ else
+ blank = FALSE;
+
+ n = ffename_find (ffesymbol_global_, t);
+ s = ffename_symbol (n);
+ if (s != NULL)
+ {
+ if (!blank)
+ ffesymbol_check (s, t, FALSE);
+ return s;
+ }
+
+ s = ffesymbol_new_ (n);
+ if (!blank)
+ ffesymbol_check (s, t, FALSE);
+
+ ffeglobal_new_common (s, t, blank); /* Detect conflicts. */
+
+ return s;
+}
+
+/* Declare a FUNCTION program unit (with distinct RESULT() name).
+
+ Retrieves or creates the ffesymbol for the specified function. Doesn't
+ actually ensure the named item is a function; the caller must handle
+ that.
+
+ If FUNCTION with RESULT() is specified but the names are the same,
+ pretend as though RESULT() was not specified, and don't call this
+ function; use ffesymbol_declare_funcunit() instead. */
+
+ffesymbol
+ffesymbol_declare_funcnotresunit (ffelexToken t)
+{
+ ffename n;
+ ffesymbol s;
+
+ assert (t != NULL);
+ assert (!ffesymbol_retractable_);
+
+ n = ffename_lookup (ffesymbol_local_, t);
+ if (n != NULL)
+ return ffename_symbol (n); /* This will become an error. */
+
+ n = ffename_find (ffesymbol_global_, t);
+ s = ffename_symbol (n);
+ if (s != NULL)
+ {
+ ffesymbol_check (s, t, FALSE);
+ return s;
+ }
+
+ s = ffesymbol_new_ (n);
+ ffesymbol_check (s, t, FALSE);
+
+ /* A FUNCTION program unit name also is in the local name space; handle it
+ here since RESULT() is a different name and is handled separately. */
+
+ n = ffename_find (ffesymbol_local_, t);
+ ffename_set_symbol (n, s);
+ s->other_space_name = n;
+
+ ffeglobal_new_function (s, t);/* Detect conflicts, when appropriate. */
+
+ return s;
+}
+
+/* Declare a function result.
+
+ Retrieves or creates the ffesymbol for the specified function result,
+ whether specified via a distinct RESULT() or by default in a FUNCTION or
+ ENTRY statement. */
+
+ffesymbol
+ffesymbol_declare_funcresult (ffelexToken t)
+{
+ ffename n;
+ ffesymbol s;
+
+ assert (t != NULL);
+ assert (!ffesymbol_retractable_);
+
+ n = ffename_find (ffesymbol_local_, t);
+ s = ffename_symbol (n);
+ if (s != NULL)
+ return s;
+
+ return ffesymbol_new_ (n);
+}
+
+/* Declare a FUNCTION program unit with no RESULT().
+
+ Retrieves or creates the ffesymbol for the specified function. Doesn't
+ actually ensure the named item is a function; the caller must handle
+ that.
+
+ This is the function to call when the FUNCTION or ENTRY statement has
+ no separate and distinct name specified via RESULT(). That's because
+ this function enters the global name of the function in only the global
+ name space. ffesymbol_declare_funcresult() must still be called to
+ declare the name for the function result in the local name space. */
+
+ffesymbol
+ffesymbol_declare_funcunit (ffelexToken t)
+{
+ ffename n;
+ ffesymbol s;
+
+ assert (t != NULL);
+ assert (!ffesymbol_retractable_);
+
+ n = ffename_find (ffesymbol_global_, t);
+ s = ffename_symbol (n);
+ if (s != NULL)
+ {
+ ffesymbol_check (s, t, FALSE);
+ return s;
+ }
+
+ s = ffesymbol_new_ (n);
+ ffesymbol_check (s, t, FALSE);
+
+ ffeglobal_new_function (s, t);/* Detect conflicts. */
+
+ return s;
+}
+
+/* Declare a local entity.
+
+ Retrieves or creates the ffesymbol for the specified local entity.
+ Set maybe_intrin TRUE if this name might turn out to name an
+ intrinsic (legitimately); otherwise if the name doesn't meet the
+ requirements for a user-defined symbol name, a diagnostic will be
+ issued right away rather than waiting until the intrinsicness of the
+ symbol is determined. */
+
+ffesymbol
+ffesymbol_declare_local (ffelexToken t, bool maybe_intrin)
+{
+ ffename n;
+ ffesymbol s;
+
+ assert (t != NULL);
+
+ /* If we're parsing within a statement function definition, return the
+ symbol if already known (a dummy argument for the statement function).
+ Otherwise continue on, which means the symbol is declared within the
+ containing (local) program unit rather than the statement function
+ definition. */
+
+ if ((ffesymbol_sfunc_ != NULL)
+ && ((n = ffename_lookup (ffesymbol_sfunc_, t)) != NULL))
+ return ffename_symbol (n);
+
+ n = ffename_find (ffesymbol_local_, t);
+ s = ffename_symbol (n);
+ if (s != NULL)
+ {
+ ffesymbol_check (s, t, maybe_intrin);
+ return s;
+ }
+
+ s = ffesymbol_new_ (n);
+ ffesymbol_check (s, t, maybe_intrin);
+ return s;
+}
+
+/* Declare a main program unit.
+
+ Retrieves or creates the ffesymbol for the specified main program unit
+ (unnamed main program unit if t is NULL). Doesn't actually ensure the
+ named item is a program; the caller must handle that. */
+
+ffesymbol
+ffesymbol_declare_programunit (ffelexToken t, ffewhereLine wl,
+ ffewhereColumn wc)
+{
+ ffename n;
+ ffesymbol s;
+ bool user = (t != NULL);
+
+ assert (!ffesymbol_retractable_);
+
+ if (t == NULL)
+ {
+ if (ffesymbol_token_unnamed_main_ == NULL)
+ ffesymbol_token_unnamed_main_
+ = ffelex_token_new_name (FFETARGET_nameUNNAMED_MAIN, wl, wc);
+ t = ffesymbol_token_unnamed_main_;
+ }
+
+ n = ffename_lookup (ffesymbol_local_, t);
+ if (n != NULL)
+ return ffename_symbol (n); /* This will become an error. */
+
+ n = ffename_find (ffesymbol_global_, t);
+ s = ffename_symbol (n);
+ if (s != NULL)
+ {
+ if (user)
+ ffesymbol_check (s, t, FALSE);
+ return s;
+ }
+
+ s = ffesymbol_new_ (n);
+ if (user)
+ ffesymbol_check (s, t, FALSE);
+
+ /* A program unit name also is in the local name space. */
+
+ n = ffename_find (ffesymbol_local_, t);
+ ffename_set_symbol (n, s);
+ s->other_space_name = n;
+
+ ffeglobal_new_program (s, t); /* Detect conflicts. */
+
+ return s;
+}
+
+/* Declare a statement-function dummy.
+
+ Retrieves or creates the ffesymbol for the specified statement
+ function dummy. Also ensures that it has a link to the parent (local)
+ ffesymbol with the same name, creating it if necessary. */
+
+ffesymbol
+ffesymbol_declare_sfdummy (ffelexToken t)
+{
+ ffename n;
+ ffesymbol s;
+ ffesymbol sp; /* Parent symbol in local area. */
+
+ assert (t != NULL);
+
+ n = ffename_find (ffesymbol_local_, t);
+ sp = ffename_symbol (n);
+ if (sp == NULL)
+ sp = ffesymbol_new_ (n);
+ ffesymbol_check (sp, t, FALSE);
+
+ n = ffename_find (ffesymbol_sfunc_, t);
+ s = ffename_symbol (n);
+ if (s == NULL)
+ {
+ s = ffesymbol_new_ (n);
+ s->sfa_dummy_parent = sp;
+ }
+ else
+ assert (s->sfa_dummy_parent == sp);
+
+ return s;
+}
+
+/* Declare a subroutine program unit.
+
+ Retrieves or creates the ffesymbol for the specified subroutine
+ Doesn't actually ensure the named item is a subroutine; the caller must
+ handle that. */
+
+ffesymbol
+ffesymbol_declare_subrunit (ffelexToken t)
+{
+ ffename n;
+ ffesymbol s;
+
+ assert (!ffesymbol_retractable_);
+ assert (t != NULL);
+
+ n = ffename_lookup (ffesymbol_local_, t);
+ if (n != NULL)
+ return ffename_symbol (n); /* This will become an error. */
+
+ n = ffename_find (ffesymbol_global_, t);
+ s = ffename_symbol (n);
+ if (s != NULL)
+ {
+ ffesymbol_check (s, t, FALSE);
+ return s;
+ }
+
+ s = ffesymbol_new_ (n);
+ ffesymbol_check (s, t, FALSE);
+
+ /* A program unit name also is in the local name space. */
+
+ n = ffename_find (ffesymbol_local_, t);
+ ffename_set_symbol (n, s);
+ s->other_space_name = n;
+
+ ffeglobal_new_subroutine (s, t); /* Detect conflicts, when
+ appropriate. */
+
+ return s;
+}
+
+/* Call given fn with all local/global symbols.
+
+ ffesymbol (*fn) (ffesymbol s);
+ ffesymbol_drive (fn); */
+
+void
+ffesymbol_drive (ffesymbol (*fn) ())
+{
+ assert (ffesymbol_sfunc_ == NULL); /* Might be ok, but not for current
+ uses. */
+ ffename_space_drive_symbol (ffesymbol_local_, fn);
+ ffename_space_drive_symbol (ffesymbol_global_, fn);
+}
+
+/* Call given fn with all sfunc-only symbols.
+
+ ffesymbol (*fn) (ffesymbol s);
+ ffesymbol_drive_sfnames (fn); */
+
+void
+ffesymbol_drive_sfnames (ffesymbol (*fn) ())
+{
+ ffename_space_drive_symbol (ffesymbol_sfunc_, fn);
+}
+
+/* Dump info on the symbol for debugging purposes. */
+
+void
+ffesymbol_dump (ffesymbol s)
+{
+ ffeinfoKind k;
+ ffeinfoWhere w;
+
+ assert (s != NULL);
+
+ if (ffeinfo_size (s->info) != FFETARGET_charactersizeNONE)
+ fprintf (dmpout, "%s:%d%s%s*%" ffetargetCharacterSize_f "u",
+ ffesymbol_text (s),
+ (int) ffeinfo_rank (s->info),
+ ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
+ ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)),
+ ffeinfo_size (s->info));
+ else
+ fprintf (dmpout, "%s:%d%s%s",
+ ffesymbol_text (s),
+ (int) ffeinfo_rank (s->info),
+ ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
+ ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)));
+ if ((k = ffeinfo_kind (s->info)) != FFEINFO_kindNONE)
+ fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
+ if ((w = ffeinfo_where (s->info)) != FFEINFO_whereNONE)
+ fprintf (dmpout, "@%s", ffeinfo_where_string (w));
+
+ if ((s->generic != FFEINTRIN_genNONE)
+ || (s->specific != FFEINTRIN_specNONE)
+ || (s->implementation != FFEINTRIN_impNONE))
+ fprintf (dmpout, "{%s:%s:%s}",
+ ffeintrin_name_generic (s->generic),
+ ffeintrin_name_specific (s->specific),
+ ffeintrin_name_implementation (s->implementation));
+}
+
+/* Produce generic error message about a symbol.
+
+ For now, just output error message using symbol's name and pointing to
+ the token. */
+
+void
+ffesymbol_error (ffesymbol s, ffelexToken t)
+{
+ if ((t != NULL)
+ && ffest_ffebad_start (FFEBAD_SYMERR))
+ {
+ ffebad_string (ffesymbol_text (s));
+ ffebad_here (0, ffelex_token_where_line (t),
+ ffelex_token_where_column (t));
+ ffebad_here (1, ffesymbol_where_line (s), ffesymbol_where_column (s));
+ ffebad_finish ();
+ }
+
+ if (ffesymbol_attr (s, FFESYMBOL_attrANY))
+ return;
+
+ ffesymbol_signal_change (s); /* May need to back up to previous version. */
+ if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK)
+ || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
+ ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
+ ffesymbol_set_attr (s, FFESYMBOL_attrANY);
+ ffesymbol_set_info (s, ffeinfo_new_any ());
+ ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+ if (s->check_state == FFESYMBOL_checkstatePENDING_)
+ ffelex_token_kill (s->check_token);
+ s->check_state = FFESYMBOL_checkstateCHECKED_;
+ s = ffecom_sym_learned (s);
+ ffesymbol_signal_unreported (s);
+}
+
+void
+ffesymbol_init_0 ()
+{
+ ffesymbolAttrs attrs = FFESYMBOL_attrsetNONE;
+
+ assert (FFESYMBOL_state == ARRAY_SIZE (ffesymbol_state_name_));
+ assert (FFESYMBOL_attr == ARRAY_SIZE (ffesymbol_attr_name_));
+ assert (attrs == FFESYMBOL_attrsetNONE);
+ attrs = ((ffesymbolAttrs) 1 << FFESYMBOL_attr);
+ assert (attrs != 0);
+}
+
+void
+ffesymbol_init_1 ()
+{
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
+ ffesymbol_global_ = ffename_space_new (ffe_pool_file ());
+#endif
+}
+
+void
+ffesymbol_init_2 ()
+{
+}
+
+void
+ffesymbol_init_3 ()
+{
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
+ ffesymbol_global_ = ffename_space_new (ffe_pool_program_unit ());
+#endif
+ ffesymbol_local_ = ffename_space_new (ffe_pool_program_unit ());
+}
+
+void
+ffesymbol_init_4 ()
+{
+ ffesymbol_sfunc_ = ffename_space_new (ffe_pool_program_unit ());
+}
+
+/* Look up a local entity.
+
+ Retrieves the ffesymbol for the specified local entity, or returns NULL
+ if no local entity by that name exists. */
+
+ffesymbol
+ffesymbol_lookup_local (ffelexToken t)
+{
+ ffename n;
+ ffesymbol s;
+
+ assert (t != NULL);
+
+ n = ffename_lookup (ffesymbol_local_, t);
+ if (n == NULL)
+ return NULL;
+
+ s = ffename_symbol (n);
+ return s; /* May be NULL here, too. */
+}
+
+/* Registers the symbol as one that is referenced by the
+ current program unit. Currently applies only to
+ symbols known to have global interest (globals and
+ intrinsics).
+
+ s is the (global/intrinsic) symbol referenced; t is the
+ referencing token; explicit is TRUE if the reference
+ is, e.g., INTRINSIC FOO. */
+
+void
+ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit)
+{
+ ffename gn;
+ ffesymbol gs = NULL;
+ ffeinfoKind kind;
+ ffeinfoWhere where;
+ bool okay;
+
+ if (ffesymbol_retractable_)
+ return;
+
+ if (t == NULL)
+ t = ffename_token (s->name); /* Use the first reference in this program unit. */
+
+ kind = ffesymbol_kind (s);
+ where = ffesymbol_where (s);
+
+ if (where == FFEINFO_whereINTRINSIC)
+ {
+ ffeglobal_ref_intrinsic (s, t,
+ explicit
+ || s->explicit_where
+ || ffeintrin_is_standard (s->generic, s->specific));
+ return;
+ }
+
+ if ((where != FFEINFO_whereGLOBAL)
+ && ((where != FFEINFO_whereLOCAL)
+ || ((kind != FFEINFO_kindFUNCTION)
+ && (kind != FFEINFO_kindSUBROUTINE))))
+ return;
+
+ gn = ffename_lookup (ffesymbol_global_, t);
+ if (gn != NULL)
+ gs = ffename_symbol (gn);
+ if ((gs != NULL) && (gs != s))
+ {
+ /* We have just discovered another global symbol with the same name
+ but a different `nature'. Complain. Note that COMMON /FOO/ can
+ coexist with local symbol FOO, e.g. local variable, just not with
+ CALL FOO, hence the separate namespaces. */
+
+ ffesymbol_error (gs, t);
+ ffesymbol_error (s, NULL);
+ return;
+ }
+
+ switch (kind)
+ {
+ case FFEINFO_kindBLOCKDATA:
+ okay = ffeglobal_ref_blockdata (s, t);
+ break;
+
+ case FFEINFO_kindSUBROUTINE:
+ okay = ffeglobal_ref_subroutine (s, t);
+ break;
+
+ case FFEINFO_kindFUNCTION:
+ okay = ffeglobal_ref_function (s, t);
+ break;
+
+ case FFEINFO_kindNONE:
+ okay = ffeglobal_ref_external (s, t);
+ break;
+
+ default:
+ assert ("bad kind in global ref" == NULL);
+ return;
+ }
+
+ if (! okay)
+ ffesymbol_error (s, NULL);
+}
+
+/* Report info on the symbol for debugging purposes. */
+
+ffesymbol
+ffesymbol_report (ffesymbol s)
+{
+ ffeinfoKind k;
+ ffeinfoWhere w;
+
+ assert (s != NULL);
+
+ if (s->reported)
+ return s;
+
+ s->reported = TRUE;
+
+ if (ffeinfo_size (s->info) != FFETARGET_charactersizeNONE)
+ fprintf (dmpout, "\"%s\": %s %s %d%s%s*%" ffetargetCharacterSize_f "u",
+ ffesymbol_text (s),
+ ffesymbol_state_string (s->state),
+ ffesymbol_attrs_string (s->attrs),
+ (int) ffeinfo_rank (s->info),
+ ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
+ ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)),
+ ffeinfo_size (s->info));
+ else
+ fprintf (dmpout, "\"%s\": %s %s %d%s%s",
+ ffesymbol_text (s),
+ ffesymbol_state_string (s->state),
+ ffesymbol_attrs_string (s->attrs),
+ (int) ffeinfo_rank (s->info),
+ ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
+ ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)));
+ if ((k = ffeinfo_kind (s->info)) != FFEINFO_kindNONE)
+ fprintf (dmpout, "/%s", ffeinfo_kind_string (k));
+ if ((w = ffeinfo_where (s->info)) != FFEINFO_whereNONE)
+ fprintf (dmpout, "@%s", ffeinfo_where_string (w));
+ fputc ('\n', dmpout);
+
+ if (s->dims != NULL)
+ {
+ fprintf (dmpout, " dims: ");
+ ffebld_dump (s->dims);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->extents != NULL)
+ {
+ fprintf (dmpout, " extents: ");
+ ffebld_dump (s->extents);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->dim_syms != NULL)
+ {
+ fprintf (dmpout, " dim syms: ");
+ ffebld_dump (s->dim_syms);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->array_size != NULL)
+ {
+ fprintf (dmpout, " array size: ");
+ ffebld_dump (s->array_size);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->init != NULL)
+ {
+ fprintf (dmpout, " init-value: ");
+ if (ffebld_op (s->init) == FFEBLD_opANY)
+ fputs ("<any>\n", dmpout);
+ else
+ {
+ ffebld_dump (s->init);
+ fputs ("\n", dmpout);
+ }
+ }
+
+ if (s->accretion != NULL)
+ {
+ fprintf (dmpout, " accretion (%" ffetargetOffset_f "d left): ",
+ s->accretes);
+ ffebld_dump (s->accretion);
+ fputs ("\n", dmpout);
+ }
+ else if (s->accretes != 0)
+ fprintf (dmpout, " accretes!! = %" ffetargetOffset_f "d left\n",
+ s->accretes);
+
+ if (s->dummy_args != NULL)
+ {
+ fprintf (dmpout, " dummies: ");
+ ffebld_dump (s->dummy_args);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->namelist != NULL)
+ {
+ fprintf (dmpout, " namelist: ");
+ ffebld_dump (s->namelist);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->common_list != NULL)
+ {
+ fprintf (dmpout, " common-list: ");
+ ffebld_dump (s->common_list);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->sfunc_expr != NULL)
+ {
+ fprintf (dmpout, " sfunc expression: ");
+ ffebld_dump (s->sfunc_expr);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->is_save)
+ {
+ fprintf (dmpout, " SAVEd\n");
+ }
+
+ if (s->is_init)
+ {
+ fprintf (dmpout, " initialized\n");
+ }
+
+ if (s->do_iter)
+ {
+ fprintf (dmpout, " DO-loop iteration variable (currently)\n");
+ }
+
+ if (s->explicit_where)
+ {
+ fprintf (dmpout, " Explicit INTRINSIC/EXTERNAL\n");
+ }
+
+ if (s->namelisted)
+ {
+ fprintf (dmpout, " Namelisted\n");
+ }
+
+ if (s->common != NULL)
+ {
+ fprintf (dmpout, " COMMON area: %s\n", ffesymbol_text (s->common));
+ }
+
+ if (s->equiv != NULL)
+ {
+ fprintf (dmpout, " EQUIVALENCE information: ");
+ ffeequiv_dump (s->equiv);
+ fputs ("\n", dmpout);
+ }
+
+ if (s->storage != NULL)
+ {
+ fprintf (dmpout, " Storage: ");
+ ffestorag_dump (s->storage);
+ fputs ("\n", dmpout);
+ }
+
+ return s;
+}
+
+/* Report info on the symbols. */
+
+void
+ffesymbol_report_all ()
+{
+ ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_report);
+ ffename_space_drive_symbol (ffesymbol_local_, ffesymbol_report);
+ ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_report);
+}
+
+/* Resolve symbol that has become known intrinsic or non-intrinsic. */
+
+void
+ffesymbol_resolve_intrin (ffesymbol s)
+{
+ char c;
+ ffebad bad;
+
+ if (!ffesrc_check_symbol ())
+ return;
+ if (s->check_state != FFESYMBOL_checkstatePENDING_)
+ return;
+ if (ffebad_inhibit ())
+ return; /* We'll get back to this later. */
+
+ if (ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
+ {
+ bad = ffesymbol_check_token_ (s->check_token, &c);
+ assert (bad != FFEBAD); /* How did this suddenly become ok? */
+ ffesymbol_whine_state_ (bad, s->check_token, c);
+ }
+
+ s->check_state = FFESYMBOL_checkstateCHECKED_;
+ ffelex_token_kill (s->check_token);
+}
+
+/* Retract or cancel retract list. */
+
+void
+ffesymbol_retract (bool retract)
+{
+ ffesymbolRetract_ r;
+ ffename name;
+ ffename other_space_name;
+ ffesymbol ls;
+ ffesymbol os;
+
+ assert (ffesymbol_retractable_);
+
+ ffesymbol_retractable_ = FALSE;
+
+ for (r = ffesymbol_retract_first_; r != NULL; r = r->next)
+ {
+ ls = r->live;
+ os = r->symbol;
+ switch (r->command)
+ {
+ case FFESYMBOL_retractcommandDELETE_:
+ if (retract)
+ {
+ ffecom_sym_retract (ls);
+ name = ls->name;
+ other_space_name = ls->other_space_name;
+ ffesymbol_unhook_ (ls);
+ malloc_kill_ks (FFESYMBOL_SPACE_POOL_, ls, sizeof (*ls));
+ if (name != NULL)
+ ffename_set_symbol (name, NULL);
+ if (other_space_name != NULL)
+ ffename_set_symbol (other_space_name, NULL);
+ }
+ else
+ {
+ ffecom_sym_commit (ls);
+ ls->have_old = FALSE;
+ }
+ break;
+
+ case FFESYMBOL_retractcommandRETRACT_:
+ if (retract)
+ {
+ ffecom_sym_retract (ls);
+ ffesymbol_unhook_ (ls);
+ *ls = *os;
+ malloc_kill_ks (FFESYMBOL_SPACE_POOL_, os, sizeof (*os));
+ }
+ else
+ {
+ ffecom_sym_commit (ls);
+ ffesymbol_unhook_ (os);
+ malloc_kill_ks (FFESYMBOL_SPACE_POOL_, os, sizeof (*os));
+ ls->have_old = FALSE;
+ }
+ break;
+
+ default:
+ assert ("bad command" == NULL);
+ break;
+ }
+ }
+}
+
+/* Return retractable flag. */
+
+bool
+ffesymbol_retractable ()
+{
+ return ffesymbol_retractable_;
+}
+
+/* Set retractable flag, retract pool.
+
+ Between this call and ffesymbol_retract, any changes made to existing
+ symbols cause the previous versions of those symbols to be saved, and any
+ newly created symbols to have their previous nonexistence saved. When
+ ffesymbol_retract is called, this information either is used to retract
+ the changes and new symbols, or is discarded. */
+
+void
+ffesymbol_set_retractable (mallocPool pool)
+{
+ assert (!ffesymbol_retractable_);
+
+ ffesymbol_retractable_ = TRUE;
+ ffesymbol_retract_pool_ = pool;
+ ffesymbol_retract_list_ = &ffesymbol_retract_first_;
+ ffesymbol_retract_first_ = NULL;
+}
+
+/* Existing symbol about to be changed; save?
+
+ Call this function before changing a symbol if it is possible that
+ the current actions may need to be undone (i.e. one of several possible
+ statement forms are being used to analyze the current system).
+
+ If the "retractable" flag is not set, just return.
+ Else, if the symbol's "have_old" flag is set, just return.
+ Else, make a copy of the symbol and add it to the "retract" list, set
+ the "have_old" flag, and return. */
+
+void
+ffesymbol_signal_change (ffesymbol s)
+{
+ ffesymbolRetract_ r;
+ ffesymbol sym;
+
+ if (!ffesymbol_retractable_ || s->have_old)
+ return;
+
+ r = (ffesymbolRetract_) malloc_new_kp (ffesymbol_retract_pool_,
+ "FFESYMBOL retract", sizeof (*r));
+ r->next = NULL;
+ r->command = FFESYMBOL_retractcommandRETRACT_;
+ r->live = s;
+ r->symbol = sym = (ffesymbol) malloc_new_ks (FFESYMBOL_SPACE_POOL_,
+ "FFESYMBOL", sizeof (*sym));
+ *sym = *s; /* Make an exact copy of the symbol in case
+ we need it back. */
+ sym->info = ffeinfo_use (s->info);
+ if (s->check_state == FFESYMBOL_checkstatePENDING_)
+ sym->check_token = ffelex_token_use (s->check_token);
+
+ *ffesymbol_retract_list_ = r;
+ ffesymbol_retract_list_ = &r->next;
+
+ s->have_old = TRUE;
+}
+
+/* Returns the string based on the state. */
+
+char *
+ffesymbol_state_string (ffesymbolState state)
+{
+ if (state >= ARRAY_SIZE (ffesymbol_state_name_))
+ return "?\?\?";
+ return ffesymbol_state_name_[state];
+}
+
+void
+ffesymbol_terminate_0 ()
+{
+}
+
+void
+ffesymbol_terminate_1 ()
+{
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
+ ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_);
+ ffename_space_kill (ffesymbol_global_);
+ ffesymbol_global_ = NULL;
+
+ ffesymbol_kill_manifest_ ();
+#endif
+}
+
+void
+ffesymbol_terminate_2 ()
+{
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
+ ffesymbol_kill_manifest_ ();
+#endif
+}
+
+void
+ffesymbol_terminate_3 ()
+{
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
+ ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_);
+ ffename_space_kill (ffesymbol_global_);
+#endif
+ ffename_space_drive_symbol (ffesymbol_local_, ffesymbol_unhook_);
+ ffename_space_kill (ffesymbol_local_);
+#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
+ ffesymbol_global_ = NULL;
+#endif
+ ffesymbol_local_ = NULL;
+}
+
+void
+ffesymbol_terminate_4 ()
+{
+ ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_unhook_);
+ ffename_space_kill (ffesymbol_sfunc_);
+ ffesymbol_sfunc_ = NULL;
+}
+
+/* Update INIT info to TRUE and all equiv/storage too.
+
+ If INIT flag is TRUE, does nothing. Else sets it to TRUE and calls
+ on the ffeequiv and ffestorag modules to update their INIT flags if
+ the <s> symbol has those objects, and also updates the common area if
+ it exists. */
+
+void
+ffesymbol_update_init (ffesymbol s)
+{
+ ffebld item;
+
+ if (s->is_init)
+ return;
+
+ s->is_init = TRUE;
+
+ if ((s->equiv != NULL)
+ && !ffeequiv_is_init (s->equiv))
+ ffeequiv_update_init (s->equiv);
+
+ if ((s->storage != NULL)
+ && !ffestorag_is_init (s->storage))
+ ffestorag_update_init (s->storage);
+
+ if ((s->common != NULL)
+ && (!ffesymbol_is_init (s->common)))
+ ffesymbol_update_init (s->common);
+
+ for (item = s->common_list; item != NULL; item = ffebld_trail (item))
+ {
+ if (!ffesymbol_is_init (ffebld_symter (ffebld_head (item))))
+ ffesymbol_update_init (ffebld_symter (ffebld_head (item)));
+ }
+}
+
+/* Update SAVE info to TRUE and all equiv/storage too.
+
+ If SAVE flag is TRUE, does nothing. Else sets it to TRUE and calls
+ on the ffeequiv and ffestorag modules to update their SAVE flags if
+ the <s> symbol has those objects, and also updates the common area if
+ it exists. */
+
+void
+ffesymbol_update_save (ffesymbol s)
+{
+ ffebld item;
+
+ if (s->is_save)
+ return;
+
+ s->is_save = TRUE;
+
+ if ((s->equiv != NULL)
+ && !ffeequiv_is_save (s->equiv))
+ ffeequiv_update_save (s->equiv);
+
+ if ((s->storage != NULL)
+ && !ffestorag_is_save (s->storage))
+ ffestorag_update_save (s->storage);
+
+ if ((s->common != NULL)
+ && (!ffesymbol_is_save (s->common)))
+ ffesymbol_update_save (s->common);
+
+ for (item = s->common_list; item != NULL; item = ffebld_trail (item))
+ {
+ if (!ffesymbol_is_save (ffebld_symter (ffebld_head (item))))
+ ffesymbol_update_save (ffebld_symter (ffebld_head (item)));
+ }
+}
diff --git a/gcc/f/symbol.def b/gcc/f/symbol.def
new file mode 100644
index 00000000000..ad100d4ebbe
--- /dev/null
+++ b/gcc/f/symbol.def
@@ -0,0 +1,654 @@
+/* Definitions and documentations for attributes used in GNU F77 compiler
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+/* "How g77 learns about symbols"
+
+ There are three primary things in a symbol that g77 uses to keep
+ track of what it has learned about that symbol:
+
+ 1. The state
+ 2. The attributes
+ 3. The info
+
+ State, attributes, and info (see f-info* files) all start out with
+ "NONE" fields when a symbol is first created.
+
+ In a PROGRAM or BLOCK DATA program unit, info where cannot be DUMMY
+ or RESULT. Any combinations including those possibilities are not
+ considered possible in such program units.
+
+ As soon as a symbol is created, it _must_ have its state changed to
+ SEEN, UNCERTAIN, or UNDERSTOOD.
+
+ If SEEN, some info might be set, such as the type info (as in when
+ the TYPE attribute is present) or kind/where info.
+
+ If UNCERTAIN, the permitted combinations of attributes and info are
+ listed below. Only the attributes ACTUALARG, ADJUSTABLE, ANYLEN, ARRAY,
+ DUMMY, EXTERNAL, SFARG, and TYPE are permitted. (All these attributes
+ are contrasted to each attribute below, even though some combinations
+ wouldn't be permitted in SEEN state either.) Note that DUMMY and
+ RESULT are not permitted in a PROGRAM/BLOCKDATA program unit, which
+ results in some of the combinations below not occurring (not UNCERTAIN,
+ but UNDERSTOOD).
+
+ ANYLEN|TYPE & ~(ACTUALARG|ADJUSTABLE|ARRAY|DUMMY|EXTERNAL|SFARG):
+ ENTITY/DUMMY, ENTITY/RESULT, FUNCTION/INTRINSIC.
+
+ ARRAY & ~(ACTUALARG|ANYLEN|DUMMY|EXTERNAL|SFARG|TYPE):
+ ENTITY/DUMMY, ENTITY/LOCAL.
+
+ ARRAY|TYPE & ~(ACTUALARG|ANYLEN|DUMMY|EXTERNAL|SFARG):
+ ENTITY/DUMMY, ENTITY/LOCAL.
+
+ DUMMY & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|EXTERNAL|SFARG|TYPE):
+ ENTITY/DUMMY, FUNCTION/DUMMY, SUBROUTINE/DUMMY.
+
+ DUMMY|TYPE & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|EXTERNAL|SFARG):
+ ENTITY/DUMMY, FUNCTION/DUMMY.
+
+ EXTERNAL & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|DUMMY|SFARG|TYPE):
+ FUNCTION/DUMMY, FUNCTION/GLOBAL, SUBROUTINE/DUMMY,
+ SUBROUTINE/GLOBAL, BLOCKDATA/GLOBAL.
+
+ EXTERNAL|ACTUALARG & ~(ADJUSTABLE|ANYLEN|ARRAY|DUMMY|SFARG|TYPE):
+ FUNCTION/GLOBAL, SUBROUTINE/GLOBAL.
+
+ EXTERNAL|DUMMY & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|SFARG|TYPE):
+ FUNCTION/DUMMY, SUBROUTINE/DUMMY.
+
+ EXTERNAL|TYPE & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|DUMMY|SFARG):
+ FUNCTION/DUMMY, FUNCTION/GLOBAL.
+
+ SFARG & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|DUMMY|EXTERNAL|TYPE):
+ ENTITY/DUMMY, ENTITY/LOCAL.
+
+ SFARG|TYPE & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|DUMMY|EXTERNAL):
+ ENTITY/DUMMY, ENTITY/LOCAL.
+
+ TYPE & ~(ACTUALARG|ANYLEN|ARRAY|DUMMY|EXTERNAL|SFARG):
+ ENTITY/DUMMY, ENTITY/LOCAL, ENTITY/RESULT, FUNCTION/DUMMY,
+ FUNCTION/GLOBAL, FUNCTION/INTRINSIC.
+
+ If UNDERSTOOD, the attributes are no longer considered, and the info
+ field is considered to be as fully filled in as possible by analyzing
+ a single program unit.
+
+ Each of the attributes (used only for SEEN/UNCERTAIN states) is
+ defined and described below. In many cases, a symbol starts out as
+ SEEN and has attributes set as it is seen in various contexts prior
+ to the first executable statement being seen (the "exec transition").
+ Once that happens, either it becomes immediately UNDERSTOOD and all
+ its info filled in, or it becomes UNCERTAIN and its info only partially
+ filled in until it becomes UNDERSTOOD. While UNCERTAIN, only a
+ subset of attributes are possible/important.
+
+ Not all symbols reach the UNDERSTOOD state, and in some cases symbols
+ go immediately from NONE to the UNDERSTOOD or even UNCERTAIN state.
+ For example, given "PROGRAM FOO", everything is known about the name
+ "FOO", so it becomes immediately UNDERSTOOD.
+
+ Also, there are multiple name spaces, and not all attributes are
+ possible/permitted in all name spaces.
+
+ The only attributes permitted in the global name space are:
+
+ ANY, CBLOCK, SAVECBLOCK.
+
+ The only attributes permitted in the local name space are:
+
+ ANY, ACTUALARG, ADJUSTABLE, ADJUSTS, ANYLEN, ANYSIZE, ARRAY, COMMON,
+ DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST, RESULT, SAVE, SFARG,
+ SFUNC, TYPE.
+
+ In the stmt-func name space, no attributes are used, just the states.
+
+*/
+
+
+/* Actual argument. Always accompanied by EXTERNAL.
+
+ Context is a name used as an actual argument passed to a procedure
+ other than a statement function.
+
+ Valid in UNCERTAIN state and local name space only.
+
+ This attribute is used only to flag the fact that an EXTERNAL'ed name
+ has been seen as an actual argument, and therefore cannot be
+ discovered later to be a DUMMY argument (via an ENTRY statement).
+
+ If DUMMY + EXTERNAL already, it is permitted to see the name
+ as an actual argument, but ACTUALARG is not added as an attribute since
+ that fact does not improve knowledge about the name. Hence it is not
+ permitted to transition ACTUALARG + EXTERNAL += DUMMY, and the
+ transition DUMMY + EXTERNAL += ACTUALARG is not actually done.
+
+ Cannot be combined with: ANYLEN, ARRAY, DUMMY, SFARG, TYPE.
+
+ Can be combined with: ACTUALARG, ANY, EXTERNAL.
+
+ Unrelated: ADJUSTABLE, ADJUSTS, ANYSIZE, CBLOCK, COMMON, EQUIV, INIT,
+ INTRINSIC, NAMELIST, RESULT, SAVE, SAVECBLOCK, SFUNC.
+
+*/
+
+DEFATTR (FFESYMBOL_attrACTUALARG, FFESYMBOL_attrsACTUALARG, "ACTUALARG")
+#ifndef FFESYMBOL_attrsACTUALARG
+#define FFESYMBOL_attrsACTUALARG ((ffesymbolAttrs) 1 << FFESYMBOL_attrACTUALARG)
+#endif
+
+/* Has adjustable dimension(s). Always accompanied by ARRAY.
+
+ Context is an ARRAY-attributed name with an adjustable dimension (at
+ least one dimension containing a variable reference).
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ADJUSTS, COMMON, EQUIV, EXTERNAL,
+ NAMELIST, INIT, INTRINSIC, RESULT, SAVE, SFARG, SFUNC.
+
+ Can be combined with: ANY, ANYLEN, ANYSIZE, ARRAY, TYPE.
+
+ Must be combined with: DUMMY.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrADJUSTABLE, FFESYMBOL_attrsADJUSTABLE, "ADJUSTABLE")
+#ifndef FFESYMBOL_attrsADJUSTABLE
+#define FFESYMBOL_attrsADJUSTABLE ((ffesymbolAttrs) 1 << FFESYMBOL_attrADJUSTABLE)
+#endif
+
+/* Adjusts an array.
+
+ Context is an expression in an array declarator, such as in a
+ DIMENSION, COMMON, or type-specification statement.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, ARRAY,
+ EXTERNAL, INTRINSIC, RESULT, SAVE, SFUNC.
+
+ Can be combined with: ADJUSTS, ANY, COMMON, DUMMY, EQUIV, INIT,
+ NAMELIST, SFARG, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrADJUSTS, FFESYMBOL_attrsADJUSTS, "ADJUSTS")
+#ifndef FFESYMBOL_attrsADJUSTS
+#define FFESYMBOL_attrsADJUSTS ((ffesymbolAttrs) 1 << FFESYMBOL_attrADJUSTS)
+#endif
+
+/* Can be anything now, diagnostic has been issued at least once.
+
+ Valid in UNDERSTOOD state only. Valid in any name space.
+
+ Can be combined with anything.
+
+*/
+
+DEFATTR (FFESYMBOL_attrANY, FFESYMBOL_attrsANY, "ANY")
+#ifndef FFESYMBOL_attrsANY
+#define FFESYMBOL_attrsANY ((ffesymbolAttrs) 1 << FFESYMBOL_attrANY)
+#endif
+
+/* Assumed (any) length. Always accompanied by TYPE.
+
+ Context is a name listed in a CHARACTER statement and given a length
+ specification of (*).
+
+ Valid in SEEN and UNCERTAIN states. Valid in local name space only.
+
+ In SEEN state, attributes marked below with "=" are unrelated.
+
+ In UNCERTAIN state, attributes marked below with "+" are unrelated,
+ attributes marked below with "-" cannot be combined with ANYLEN,
+ and attributes marked below with "!" transition to state UNDERSTOOD
+ instead of acquiring the new attribute. Any other subsequent mentioning
+ of the name transitions to state UNDERSTOOD. UNCERTAIN state is not
+ valid for this attribute in PROGRAM/BLOCKDATA program unit.
+
+ Cannot be combined with: ACTUALARG=, ADJUSTS+, ANYLEN, COMMON+, EQUIV+,
+ EXTERNAL, INIT+, INTRINSIC+, NAMELIST+, SAVE+, SFARG, SFUNC+.
+
+ Can be combined with: ADJUSTABLE+, ANY, ANYSIZE+, ARRAY-, DUMMY!, RESULT+,
+ TYPE.
+
+ Unrelated: CBLOCK, SAVECBLOCK.
+
+ In PROGRAM/BLOCKDATA, cannot be combined with ARRAY.
+
+*/
+
+DEFATTR (FFESYMBOL_attrANYLEN, FFESYMBOL_attrsANYLEN, "ANYLEN")
+#ifndef FFESYMBOL_attrsANYLEN
+#define FFESYMBOL_attrsANYLEN ((ffesymbolAttrs) 1 << FFESYMBOL_attrANYLEN)
+#endif
+
+/* Has assumed (any) size. Always accompanied by ARRAY.
+
+ Context is an ARRAY-attributed name with its last dimension having
+ an upper bound of "*".
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTS, ANYSIZE, COMMON, EQUIV, EXTERNAL,
+ NAMELIST, INIT, INTRINSIC, RESULT, SAVE, SFARG, SFUNC.
+
+ Can be combined with: ADJUSTABLE, ANY, ANYLEN, ARRAY, TYPE.
+
+ Must be combined with: DUMMY.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrANYSIZE, FFESYMBOL_attrsANYSIZE, "ANYSIZE")
+#ifndef FFESYMBOL_attrsANYSIZE
+#define FFESYMBOL_attrsANYSIZE ((ffesymbolAttrs) 1 << FFESYMBOL_attrANYSIZE)
+#endif
+
+/* Array.
+
+ Context is a name followed by an array declarator, such as in a
+ type-statement-decl, a DIMENSION statement, or a COMMON statement.
+
+ Valid in SEEN and UNCERTAIN states. Valid in local name space only.
+
+ In SEEN state, attributes marked below with "=" are unrelated.
+
+ In UNCERTAIN state, attributes marked below with "+" are unrelated,
+ attributes marked below with "-" cannot be combined with ARRAY,
+ and attributes marked below with "!" transition to state UNDERSTOOD
+ instead of acquiring the new attribute. Any other subsequent mentioning
+ of the name transitions to state UNDERSTOOD. UNCERTAIN state is not
+ valid for this attribute in PROGRAM/BLOCKDATA program unit.
+
+ Cannot be combined with: ACTUALARG=, ADJUSTS+, ARRAY, EXTERNAL,
+ INTRINSIC+, RESULT+, SFARG, SFUNC+.
+
+ Can be combined with: ADJUSTABLE+, ANY, ANYLEN-, ANYSIZE+, COMMON+,
+ DUMMY!, EQUIV+, INIT+, NAMELIST+, SAVE+, TYPE.
+
+ Unrelated: CBLOCK, SAVECBLOCK.
+
+ In PROGRAM/BLOCKDATA, cannot be combined with ANYLEN.
+ Cannot follow INIT.
+
+*/
+
+DEFATTR (FFESYMBOL_attrARRAY, FFESYMBOL_attrsARRAY, "ARRAY")
+#ifndef FFESYMBOL_attrsARRAY
+#define FFESYMBOL_attrsARRAY ((ffesymbolAttrs) 1 << FFESYMBOL_attrARRAY)
+#endif
+
+/* COMMON block.
+
+ Context is a name enclosed in slashes in a COMMON statement.
+
+ Valid in SEEN state and global name space only.
+
+ Cannot be combined with:
+
+ Can be combined with: CBLOCK, SAVECBLOCK.
+
+ Unrelated: ACTUALARG, ADJUSTABLE, ADJUSTS, ANY, ANYLEN, ANYSIZE,
+ ARRAY, COMMON, DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST,
+ RESULT, SAVE, SFARG, SFUNC, TYPE.
+
+*/
+
+DEFATTR (FFESYMBOL_attrCBLOCK, FFESYMBOL_attrsCBLOCK, "CBLOCK")
+#ifndef FFESYMBOL_attrsCBLOCK
+#define FFESYMBOL_attrsCBLOCK ((ffesymbolAttrs) 1 << FFESYMBOL_attrCBLOCK)
+#endif
+
+/* Placed in COMMON.
+
+ Context is a name listed in a COMMON statement but not enclosed in
+ slashes.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, COMMON, DUMMY,
+ EXTERNAL, INTRINSIC, RESULT, SAVE, SFUNC.
+
+ Can be combined with: ADJUSTS, ANY, ARRAY, EQUIV, INIT, NAMELIST,
+ SFARG, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrCOMMON, FFESYMBOL_attrsCOMMON, "COMMON")
+#ifndef FFESYMBOL_attrsCOMMON
+#define FFESYMBOL_attrsCOMMON ((ffesymbolAttrs) 1 << FFESYMBOL_attrCOMMON)
+#endif
+
+/* Dummy argument.
+
+ Context is a name listed in the arglist of FUNCTION, SUBROUTINE, ENTRY.
+ (Statement-function definitions have dummy arguments, but since they're
+ the only possible entities in the statement-function name space, this
+ attribution mechanism isn't used for them.)
+
+ Valid in SEEN and UNCERTAIN states. Valid in local name space only.
+
+ In SEEN state, attributes marked below with "=" are unrelated.
+
+ In UNCERTAIN state, attributes marked below with "+" are unrelated,
+ attributes marked below with "-" cannot be combined with DUMMY,
+ and attributes marked below with "!" transition to state UNDERSTOOD
+ instead of acquiring the new attribute. Any other subsequent mentioning
+ of the name transitions to state UNDERSTOOD. UNCERTAIN state is not
+ valid for this attribute in PROGRAM/BLOCKDATA program unit.
+
+ Cannot be combined with: ACTUALARG=, COMMON+, EQUIV+, INIT+, INTRINSIC+,
+ NAMELIST+, RESULT+, SAVE+, SFUNC+.
+
+ Can be combined with: ADJUSTABLE+, ADJUSTS+, ANY, ANYLEN-, ANYSIZE+,
+ ARRAY-, DUMMY, EXTERNAL, SFARG-, TYPE.
+
+ Unrelated: CBLOCK, SAVECBLOCK.
+
+ VXT Fortran disallows DUMMY + NAMELIST.
+ F90 allows DUMMY + NAMELIST (with some restrictions), g77 doesn't yet.
+
+*/
+
+DEFATTR (FFESYMBOL_attrDUMMY, FFESYMBOL_attrsDUMMY, "DUMMY")
+#ifndef FFESYMBOL_attrsDUMMY
+#define FFESYMBOL_attrsDUMMY ((ffesymbolAttrs) 1 << FFESYMBOL_attrDUMMY)
+#endif
+
+/* EQUIVALENCE'd.
+
+ Context is a name given in an EQUIVALENCE statement.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, DUMMY,
+ EXTERNAL, INTRINSIC, RESULT, SFUNC.
+
+ Can be combined with: ADJUSTS, ANY, ARRAY, COMMON, EQUIV, INIT,
+ NAMELIST, SAVE, SFARG, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrEQUIV, FFESYMBOL_attrsEQUIV, "EQUIV")
+#ifndef FFESYMBOL_attrsEQUIV
+#define FFESYMBOL_attrsEQUIV ((ffesymbolAttrs) 1 << FFESYMBOL_attrEQUIV)
+#endif
+
+/* EXTERNAL.
+
+ Context is a name listed in an EXTERNAL statement.
+
+ Valid in SEEN and UNCERTAIN states. Valid in local name space only.
+
+ In SEEN state, attributes marked below with "=" are unrelated.
+
+ In UNCERTAIN state, attributes marked below with "+" are unrelated,
+ attributes marked below with "-" cannot be combined with EXTERNAL,
+ and attributes marked below with "!" transition to state UNDERSTOOD
+ instead of acquiring the new attribute. Many other subsequent mentionings
+ of the name transitions to state UNDERSTOOD. UNCERTAIN state is not
+ valid for this attribute in PROGRAM/BLOCKDATA program unit.
+
+ Cannot be combined with: ADJUSTABLE+, ADJUSTS+, ANYLEN, ANYSIZE+,
+ ARRAY, COMMON+, EQUIV+, EXTERNAL, INIT+, INTRINSIC+, NAMELIST+, RESULT+,
+ SAVE+, SFARG, SFUNC+.
+
+ Can be combined with: ACTUALARG=, ANY, DUMMY, TYPE.
+
+ Unrelated: CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrEXTERNAL, FFESYMBOL_attrsEXTERNAL, "EXTERNAL")
+#ifndef FFESYMBOL_attrsEXTERNAL
+#define FFESYMBOL_attrsEXTERNAL ((ffesymbolAttrs) 1 << FFESYMBOL_attrEXTERNAL)
+#endif
+
+/* Given an initial value.
+
+ Context is a name listed in a type-def-stmt such as INTEGER or REAL
+ and given an initial value or values. Someday will also include
+ names in DATA statements, which currently immediately exec-transition
+ their targets.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, DUMMY, EXTERNAL,
+ INIT, INTRINSIC, RESULT, SFUNC.
+
+ Can be combined with: ADJUSTS, ANY, ARRAY, COMMON, EQUIV, NAMELIST,
+ SAVE, SFARG, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+ Cannot be followed by ARRAY.
+
+*/
+
+DEFATTR (FFESYMBOL_attrINIT, FFESYMBOL_attrsINIT, "INIT")
+#ifndef FFESYMBOL_attrsINIT
+#define FFESYMBOL_attrsINIT ((ffesymbolAttrs) 1 << FFESYMBOL_attrINIT)
+#endif
+
+/* INTRINSIC.
+
+ Context is a name listed in an INTRINSIC statement.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ADJUSTS, ANYLEN, ANYSIZE, ARRAY,
+ COMMON, DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST, RESULT,
+ SAVE, SFARG, SFUNC.
+
+ Can be combined with: ANY, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrINTRINSIC, FFESYMBOL_attrsINTRINSIC, "INTRINSIC")
+#ifndef FFESYMBOL_attrsINTRINSIC
+#define FFESYMBOL_attrsINTRINSIC ((ffesymbolAttrs) 1 << FFESYMBOL_attrINTRINSIC)
+#endif
+
+/* NAMELISTed.
+
+ Context is a name listed in a NAMELIST statement but not enclosed in
+ slashes.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, DUMMY, EXTERNAL,
+ INTRINSIC, RESULT, SFUNC.
+
+ Can be combined with: ADJUSTS, ANY, ARRAY, COMMON, EQUIV, INIT,
+ NAMELIST, SAVE, SFARG, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrNAMELIST, FFESYMBOL_attrsNAMELIST, "NAMELIST")
+#ifndef FFESYMBOL_attrsNAMELIST
+#define FFESYMBOL_attrsNAMELIST ((ffesymbolAttrs) 1 << FFESYMBOL_attrNAMELIST)
+#endif
+
+/* RESULT of a function.
+
+ Context is name in RESULT() clause in FUNCTION or ENTRY statement, or
+ the name in a FUNCTION or ENTRY statement (within a FUNCTION subprogram)
+ that has no RESULT() clause.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ADJUSTS, ANYSIZE, ARRAY, COMMON,
+ DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST, RESULT, SAVE, SFUNC.
+
+ Can be combined with: ANY, ANYLEN, SFARG, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+ Cannot be preceded by SFARG.
+
+*/
+
+DEFATTR (FFESYMBOL_attrRESULT, FFESYMBOL_attrsRESULT, "RESULT")
+#ifndef FFESYMBOL_attrsRESULT
+#define FFESYMBOL_attrsRESULT ((ffesymbolAttrs) 1 << FFESYMBOL_attrRESULT)
+#endif
+
+/* SAVEd (not enclosed in slashes).
+
+ Context is a name listed in a SAVE statement but not enclosed in slashes.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADUSTABLE, ADJUSTS, ANYLEN, ANYSIZE, COMMON,
+ DUMMY, EXTERNAL, INTRINSIC, RESULT, SAVE, SFUNC.
+
+ Can be combined with: ANY, ARRAY, EQUIV, INIT, NAMELIST,
+ SFARG, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrSAVE, FFESYMBOL_attrsSAVE, "SAVE")
+#ifndef FFESYMBOL_attrsSAVE
+#define FFESYMBOL_attrsSAVE ((ffesymbolAttrs) 1 << FFESYMBOL_attrSAVE)
+#endif
+
+/* SAVEd (enclosed in slashes).
+
+ Context is a name enclosed in slashes in a SAVE statement.
+
+ Valid in SEEN state and global name space only.
+
+ Cannot be combined with: SAVECBLOCK.
+
+ Can be combined with: CBLOCK.
+
+ Unrelated: ACTUALARG, ADJUSTABLE, ADJUSTS, ANY, ANYLEN, ANYSIZE,
+ ARRAY, COMMON, DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST,
+ RESULT, SAVE, SFARG, SFUNC, TYPE.
+
+*/
+
+DEFATTR (FFESYMBOL_attrSAVECBLOCK, FFESYMBOL_attrsSAVECBLOCK, "SAVECBLOCK")
+#ifndef FFESYMBOL_attrsSAVECBLOCK
+#define FFESYMBOL_attrsSAVECBLOCK ((ffesymbolAttrs) 1 << FFESYMBOL_attrSAVECBLOCK)
+#endif
+
+/* Name used as a statement function arg or DATA implied-DO iterator.
+
+ Context is a name listed in the arglist of statement-function-definition
+ or as the iterator in an implied-DO construct in a DATA statement.
+
+ Valid in SEEN and UNCERTAIN states. Valid in local name space only.
+
+ In SEEN state, attributes marked below with "=" are unrelated.
+
+ In UNCERTAIN state, attributes marked below with "+" are unrelated,
+ attributes marked below with "-" cannot be combined with SFARG,
+ and attributes marked below with "!" transition to state UNDERSTOOD
+ instead of acquiring the new attribute. Any other subsequent mentioning
+ of the name transitions to state UNDERSTOOD. UNCERTAIN state is not
+ valid for this attribute in PROGRAM/BLOCKDATA program unit.
+
+ Cannot be combined with: ACTUALARG=, ADJUSTABLE+, ANYLEN, ANYSIZE+,
+ ARRAY, EXTERNAL, INTRINSIC+, SFUNC+.
+
+ Can be combined with: ADJUSTS+, ANY, COMMON+, DUMMY!, EQUIV+, INIT+,
+ NAMELIST+, RESULT+, SAVE+, SFARG, TYPE.
+
+ Unrelated: CBLOCK, SAVECBLOCK.
+
+ Cannot be followed by RESULT.
+
+*/
+
+DEFATTR (FFESYMBOL_attrSFARG, FFESYMBOL_attrsSFARG, "SFARG")
+#ifndef FFESYMBOL_attrsSFARG
+#define FFESYMBOL_attrsSFARG ((ffesymbolAttrs) 1 << FFESYMBOL_attrSFARG)
+#endif
+
+/* Statement function name.
+
+ Context is a statement-function-definition statement, the name being
+ defined.
+
+ Valid in SEEN state and local name space only.
+
+ Cannot be combined with: ADJUSTABLE, ADJUSTS, ANYLEN, ANYSIZE, ARRAY,
+ COMMON, DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST, RESULT,
+ SAVE, SFARG, SFUNC.
+
+ Can be combined with: ANY, TYPE.
+
+ Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrSFUNC, FFESYMBOL_attrsSFUNC, "SFUNC")
+#ifndef FFESYMBOL_attrsSFUNC
+#define FFESYMBOL_attrsSFUNC ((ffesymbolAttrs) 1 << FFESYMBOL_attrSFUNC)
+#endif
+
+/* Explicitly typed.
+
+ Context is a name listed in a type-def-stmt such as INTEGER or REAL.
+
+ Valid in SEEN and UNCERTAIN states. Valid in local name space only.
+
+ In SEEN state, attributes marked below with "=" are unrelated.
+
+ In UNCERTAIN state, attributes marked below with "+" are unrelated,
+ attributes marked below with "-" cannot be combined with TYPE,
+ and attributes marked below with "!" transition to state UNDERSTOOD
+ instead of acquiring the new attribute. Many other subsequent mentionings
+ of the name transitions to state UNDERSTOOD. UNCERTAIN state is not
+ valid for this attribute in PROGRAM/BLOCKDATA program unit.
+
+ Cannot be combined with: ACTUALARG=, TYPE.
+
+ Can be combined with: ADJUSTABLE+, ADJUSTS+, ANY, ANYLEN, ANYSIZE+,
+ ARRAY, COMMON+, DUMMY, EQUIV+, EXTERNAL, INIT+, INTRINSIC+, NAMELIST+,
+ RESULT+, SAVE+, SFARG, SFUNC+.
+
+ Unrelated: CBLOCK, SAVECBLOCK.
+
+*/
+
+DEFATTR (FFESYMBOL_attrTYPE, FFESYMBOL_attrsTYPE, "TYPE")
+#ifndef FFESYMBOL_attrsTYPE
+#define FFESYMBOL_attrsTYPE ((ffesymbolAttrs) 1 << FFESYMBOL_attrTYPE)
+#endif
diff --git a/gcc/f/symbol.h b/gcc/f/symbol.h
new file mode 100644
index 00000000000..efa91bb01b6
--- /dev/null
+++ b/gcc/f/symbol.h
@@ -0,0 +1,289 @@
+/* Interface definitions for Fortran symbol manager
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef _H_f_symbol
+#define _H_f_symbol
+
+/* The main symbol type. */
+
+typedef struct _ffesymbol_ *ffesymbol;
+
+/* State of understanding about what the symbol represents. */
+
+enum _ffesymbol_state_
+ {
+/* See ffesymbol_state_is_exec() macro below when making changes. */
+ FFESYMBOL_stateNONE, /* Never before seen. */
+ FFESYMBOL_stateSEEN, /* Seen before exec transition and not yet
+ understood (info not filled in, etc). */
+ FFESYMBOL_stateUNCERTAIN, /* Almost understood (info partly filled in). */
+ FFESYMBOL_stateUNDERSTOOD, /* Fully understood (info filled in). */
+ FFESYMBOL_state
+ };
+typedef enum _ffesymbol_state_ ffesymbolState;
+#define ffesymbolState_f ""
+
+/* Attributes. Symbols acquire attributes while their state is SEEN.
+ These attributes are basically ignored once the symbol becomes
+ UNDERSTOOD. */
+
+typedef long int ffesymbolAttrs;/* Holds set of attributes. */
+#define ffesymbolAttrs_f "l"
+
+enum _ffesymbol_attr_
+ {
+#define DEFATTR(ATTR,ATTRS,NAME) ATTR,
+#include "symbol.def"
+#undef DEFATTR
+ FFESYMBOL_attr
+ }; /* A given attribute. */
+typedef enum _ffesymbol_attr_ ffesymbolAttr;
+#define ffesymbolAttr_f ""
+
+#define FFESYMBOL_attrsetNONE 0
+#define FFESYMBOL_attrsetALL (((ffesymbolAttrs) 1 << FFESYMBOL_attr) - 1)
+
+/* This is just for avoiding complaining about, e.g., "I = IABS(3)", that
+ IABS doesn't meet the requirements for a user-defined symbol name as
+ a result of, say, --symbol-case-lower, if IABS turns out to indeed be
+ a reference to the intrinsic IABS (in which case it's a Fortran keyword
+ like CALL) and not a user-defined name. */
+
+enum _ffesymbol_checkstate_
+ {
+ FFESYMBOL_checkstateNONE_, /* Not checked/never necessary to check. */
+ FFESYMBOL_checkstateINHIBITED_, /* Bad name, but inhibited. */
+ FFESYMBOL_checkstatePENDING_, /* Bad name, might be intrinsic. */
+ FFESYMBOL_checkstateCHECKED_, /* Ok name, intrinsic, or bad name
+ reported. */
+ FFESYMBOL_checkstate_
+ };
+typedef enum _ffesymbol_checkstate_ ffesymbolCheckState_;
+#define ffesymbolCheckState_f_ ""
+
+#include "bld.h"
+#include "com.h"
+#include "equiv.h"
+#include "global.h"
+#include "info.h"
+#include "intrin.h"
+#include "lex.h"
+#include "malloc.h"
+#include "name.h"
+#include "storag.h"
+#include "target.h"
+#include "top.h"
+#include "where.h"
+
+struct _ffesymbol_
+ {
+ ffename name;
+ ffename other_space_name; /* For dual-space objects. */
+ ffeglobal global; /* In filewide name space. */
+ ffesymbolAttrs attrs; /* What kind of symbol am I? */
+ ffesymbolState state; /* What state am I in? */
+ ffeinfo info; /* Info filled in when _stateUNDERSTOOD. */
+ ffebld dims; /* Dimension list expression. */
+ ffebld extents; /* Extents list expression. */
+ ffebld dim_syms; /* List of SYMTERs of all symbols in dims. */
+ ffebld array_size; /* Size as an expression involving some of
+ dims. */
+ ffebld init; /* Initialization expression or expr list or
+ PARAMETER value. */
+ ffebld accretion; /* Initializations seen so far for
+ array/substr. */
+ ffetargetOffset accretes; /* # inits needed to fill entire array. */
+ ffebld dummy_args; /* For functions, subroutines, and entry
+ points. */
+ ffebld namelist; /* List of symbols in NML. */
+ ffebld common_list; /* List of entities in BCB/NCB. */
+ ffebld sfunc_expr; /* SFN's expression. */
+ ffebldListBottom list_bottom; /* For BCB, NCB, NML. */
+ ffesymbol common; /* Who is my containing COMMON area? */
+ ffeequiv equiv; /* Who have I been equivalenced with? */
+ ffestorag storage; /* Where am I in relation to my outside
+ world? */
+#ifdef FFECOM_symbolHOOK
+ ffecomSymbol hook; /* Whatever the compiler/backend wants! */
+#endif
+ ffesymbol sfa_dummy_parent; /* "X" outside sfunc "CIRC(X) = 3.14 * X". */
+ ffesymbol func_result; /* FUN sym's corresponding RES sym, & vice
+ versa. */
+ ffetargetIntegerDefault value; /* IMMEDIATE (DATA impdo) value. */
+ ffesymbolCheckState_ check_state; /* Valid name? */
+ ffelexToken check_token; /* checkstatePENDING_ only. */
+ int max_entry_num; /* For detecting dummy arg listed twice/IMPDO
+ iterator nesting violation; also for id of
+ sfunc dummy arg. */
+ int num_entries; /* Number of entry points in which this
+ symbol appears as a dummy arg; helps
+ determine whether arg might not be passed,
+ for example. */
+ ffeintrinGen generic; /* Generic intrinsic id, if any. */
+ ffeintrinSpec specific; /* Specific intrinsic id, if any. */
+ ffeintrinImp implementation;/* Implementation id, if any. */
+ bool is_save; /* SAVE flag set for this symbol (see also
+ ffe_is_saveall()). */
+ bool is_init; /* INIT flag set for this symbol. */
+ bool do_iter; /* Is currently a DO-loop iter (can't be
+ changed in loop). */
+ bool reported; /* (Debug) TRUE if the latest version has
+ been reported. */
+ bool have_old; /* TRUE if old copy of this symbol saved
+ away. */
+ bool explicit_where; /* TRUE if INTRINSIC/EXTERNAL explicit. */
+ bool namelisted; /* TRUE if in NAMELIST (needs static alloc). */
+ };
+
+#define ffesymbol_accretes(s) ((s)->accretes)
+#define ffesymbol_accretion(s) ((s)->accretion)
+#define ffesymbol_arraysize(s) ((s)->array_size)
+#define ffesymbol_attr(s,a) ((s)->attrs & ((ffesymbolAttrs) 1 << (a)))
+#define ffesymbol_attrs(s) ((s)->attrs)
+char *ffesymbol_attrs_string (ffesymbolAttrs attrs);
+#define ffesymbol_basictype(s) ffeinfo_basictype((s)->info)
+void ffesymbol_check (ffesymbol s, ffelexToken t, bool maybe_intrin);
+#define ffesymbol_common(s) ((s)->common)
+#define ffesymbol_commonlist(s) ((s)->common_list)
+ffesymbol ffesymbol_declare_blockdataunit (ffelexToken t, ffewhereLine wl,
+ ffewhereColumn wc);
+ffesymbol ffesymbol_declare_cblock (ffelexToken t, ffewhereLine wl,
+ ffewhereColumn wc);
+ffesymbol ffesymbol_declare_funcnotresunit (ffelexToken t);
+ffesymbol ffesymbol_declare_funcresult (ffelexToken t);
+ffesymbol ffesymbol_declare_funcunit (ffelexToken t);
+ffesymbol ffesymbol_declare_local (ffelexToken t, bool maybe_intrin);
+ffesymbol ffesymbol_declare_programunit (ffelexToken t, ffewhereLine wl,
+ ffewhereColumn wc);
+ffesymbol ffesymbol_declare_sfdummy (ffelexToken t);
+ffesymbol ffesymbol_declare_subrunit (ffelexToken t);
+#define ffesymbol_dims(s) ((s)->dims)
+#define ffesymbol_dim_syms(s) ((s)->dim_syms)
+void ffesymbol_drive (ffesymbol (*fn) ());
+void ffesymbol_drive_sfnames (ffesymbol (*fn) ());
+#define ffesymbol_dummyargs(s) ((s)->dummy_args)
+void ffesymbol_dump (ffesymbol s);
+void ffesymbol_error (ffesymbol s, ffelexToken t);
+#define ffesymbol_equiv(s) ((s)->equiv)
+#define ffesymbol_explicitwhere(s) ((s)->explicit_where)
+#define ffesymbol_extents(s) ((s)->extents)
+#define ffesymbol_first_token(s) ((s)->name == NULL ? NULL \
+ : ffename_first_token((s)->name))
+#define ffesymbol_funcresult(s) ((s)->func_result)
+#define ffesymbol_generic(s) ((s)->generic)
+#define ffesymbol_global(s) ((s)->global)
+#define ffesymbol_hook(s) ((s)->hook)
+#define ffesymbol_implementation(s) ((s)->implementation)
+#define ffesymbol_info(s) ((s)->info)
+#define ffesymbol_init(s) ((s)->init)
+void ffesymbol_init_0 (void);
+void ffesymbol_init_1 (void);
+void ffesymbol_init_2 (void);
+void ffesymbol_init_3 (void);
+void ffesymbol_init_4 (void);
+#define ffesymbol_is_doiter(s) ((s)->do_iter)
+#define ffesymbol_is_dualspace(s) ((s)->other_space_name != NULL)
+#define ffesymbol_is_f2c(s) (ffe_is_f2c())
+#define ffesymbol_is_init(s) ((s)->is_init)
+#define ffesymbol_is_reported(s) ((s)->reported)
+#define ffesymbol_is_save(s) ((s)->is_save)
+#define ffesymbol_is_specable(s) ffesymbol_state_is_specable(s->state)
+#define ffesymbol_kindtype(s) ffeinfo_kindtype((s)->info)
+#define ffesymbol_kind(s) ffeinfo_kind((s)->info)
+ffesymbol ffesymbol_lookup_local (ffelexToken t);
+#define ffesymbol_maxentrynum(s) ((s)->max_entry_num)
+#define ffesymbol_name(s) ((s)->name)
+#define ffesymbol_namelist(s) ((s)->namelist)
+#define ffesymbol_namelisted(s) ((s)->namelisted)
+#define ffesymbol_numentries(s) ((s)->num_entries)
+#define ffesymbol_ptr_to_commonlist(s) (&(s)->common_list)
+#define ffesymbol_ptr_to_listbottom(s) (&(s)->list_bottom)
+#define ffesymbol_ptr_to_namelist(s) (&(s)->namelist)
+#define ffesymbol_rank(s) ffeinfo_rank((s)->info)
+void ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit);
+ffesymbol ffesymbol_report (ffesymbol s);
+void ffesymbol_report_all (void);
+void ffesymbol_resolve_intrin (ffesymbol s);
+void ffesymbol_retract (bool retract);
+bool ffesymbol_retractable (void);
+#define ffesymbol_set_accretes(s,a) ((s)->accretes = (a))
+#define ffesymbol_set_accretion(s,a) ((s)->accretion = (a))
+#define ffesymbol_set_arraysize(s,a) ((s)->array_size = (a))
+#define ffesymbol_set_attr(s,a) ((s)->attrs |= ((ffesymbolAttrs) 1 << (a)))
+#define ffesymbol_set_attrs(s,a) ((s)->attrs = (a))
+#define ffesymbol_set_common(s,c) ((s)->common = (c))
+#define ffesymbol_set_commonlist(s,c) ((s)->common_list = (c))
+#define ffesymbol_set_dims(s,d) ((s)->dims = (d))
+#define ffesymbol_set_dim_syms(s,d) ((s)->dim_syms = (d))
+#define ffesymbol_set_dummyargs(s,d) ((s)->dummy_args = (d))
+#define ffesymbol_set_equiv(s,e) ((s)->equiv = (e))
+#define ffesymbol_set_explicitwhere(s,e) ((s)->explicit_where = (e))
+#define ffesymbol_set_extents(s,e) ((s)->extents = (e))
+#define ffesymbol_set_funcresult(s,f) ((s)->func_result = (f))
+#define ffesymbol_set_generic(s,g) ((s)->generic = (g))
+#define ffesymbol_set_global(s,g) ((s)->global = (g))
+#define ffesymbol_set_hook(s,h) ((s)->hook = (h))
+#define ffesymbol_set_implementation(s,im) ((s)->implementation = (im))
+#define ffesymbol_set_init(s,i) ((s)->init = (i))
+#define ffesymbol_set_info(s,i) ((s)->info = (i))
+#define ffesymbol_set_is_doiter(s,f) ((s)->do_iter = (f))
+#define ffesymbol_set_is_init(s,in) ((s)->is_init = (in))
+#define ffesymbol_set_is_save(s,sa) ((s)->is_save = (sa))
+#define ffesymbol_set_maxentrynum(s,m) ((s)->max_entry_num = (m))
+#define ffesymbol_set_namelist(s,n) ((s)->namelist = (n))
+#define ffesymbol_set_namelisted(s,n) ((s)->namelisted = (n))
+#define ffesymbol_set_numentries(s,n) ((s)->num_entries = (n))
+void ffesymbol_set_retractable (mallocPool pool);
+#define ffesymbol_set_sfexpr(s,e) ((s)->sfunc_expr = (e))
+#define ffesymbol_set_specific(s,sp) ((s)->specific = (sp))
+#define ffesymbol_set_state(s,st) ((s)->state = (st))
+#define ffesymbol_set_storage(s,st) ((s)->storage = (st))
+#define ffesymbol_set_value(s,v) ((s)->value = (v))
+#define ffesymbol_sfdummyparent(s) ((s)->sfa_dummy_parent)
+#define ffesymbol_sfexpr(s) ((s)->sfunc_expr)
+void ffesymbol_signal_change (ffesymbol s);
+#define ffesymbol_signal_unreported(s) ((s)->reported = FALSE)
+#define ffesymbol_size(s) ffeinfo_size((s)->info)
+#define ffesymbol_specific(s) ((s)->specific)
+#define ffesymbol_state(s) ((s)->state)
+#define ffesymbol_state_is_specable(s) ((s) <= FFESYMBOL_stateSEEN)
+char *ffesymbol_state_string (ffesymbolState state);
+#define ffesymbol_storage(s) ((s)->storage)
+void ffesymbol_terminate_0 (void);
+void ffesymbol_terminate_1 (void);
+void ffesymbol_terminate_2 (void);
+void ffesymbol_terminate_3 (void);
+void ffesymbol_terminate_4 (void);
+#define ffesymbol_text(s) (((s)->name == NULL) ? "<->" : ffename_text((s)->name))
+void ffesymbol_update_init (ffesymbol s);
+void ffesymbol_update_save (ffesymbol s);
+#define ffesymbol_value(s) ((s)->value)
+#define ffesymbol_where(s) ffeinfo_where((s)->info)
+#define ffesymbol_where_column(s) (((s)->name == NULL) \
+ ? ffewhere_column_unknown() : ffename_where_column((s)->name))
+#define ffesymbol_where_filename(s) \
+ ffewhere_line_filename(ffesymbol_where_line(s))
+#define ffesymbol_where_filelinenum(s) \
+ ffewhere_line_filelinenum(ffesymbol_where_line(s))
+#define ffesymbol_where_line(s) (((s)->name == NULL) ? ffewhere_line_unknown() \
+ : ffename_where_line((s)->name))
+
+#endif
diff --git a/gcc/f/target.c b/gcc/f/target.c
new file mode 100644
index 00000000000..828e7adcf75
--- /dev/null
+++ b/gcc/f/target.c
@@ -0,0 +1,2487 @@
+/* target.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Implements conversion of lexer tokens to machine-dependent numerical
+ form and accordingly issues diagnostic messages when necessary.
+
+ Also, this module, especially its .h file, provides nearly all of the
+ information on the target machine's data type, kind type, and length
+ type capabilities. The idea is that by carefully going through
+ target.h and changing things properly, one can accomplish much
+ towards the porting of the FFE to a new machine. There are limits
+ to how much this can accomplish towards that end, however. For one
+ thing, the ffeexpr_collapse_convert function doesn't contain all the
+ conversion cases necessary, because the text file would be
+ enormous (even though most of the function would be cut during the
+ cpp phase because of the absence of the types), so when adding to
+ the number of supported kind types for a given type, one must look
+ to see if ffeexpr_collapse_convert needs modification in this area,
+ in addition to providing the appropriate macros and functions in
+ ffetarget. Note that if combinatorial explosion actually becomes a
+ problem for a given machine, one might have to modify the way conversion
+ expressions are built so that instead of just one conversion expr, a
+ series of conversion exprs are built to make a path from one type to
+ another that is not a "near neighbor". For now, however, with a handful
+ of each of the numeric types and only one character type, things appear
+ manageable.
+
+ A nonobvious change to ffetarget would be if the target machine was
+ not a 2's-complement machine. Any item with the word "magical" (case-
+ insensitive) in the FFE's source code (at least) indicates an assumption
+ that a 2's-complement machine is the target, and thus that there exists
+ a magnitude that can be represented as a negative number but not as
+ a positive number. It is possible that this situation can be dealt
+ with by changing only ffetarget, for example, on a 1's-complement
+ machine, perhaps #defineing ffetarget_constant_is_magical to simply
+ FALSE along with making the appropriate changes in ffetarget's number
+ parsing functions would be sufficient to effectively "comment out" code
+ in places like ffeexpr that do certain magical checks. But it is
+ possible there are other 2's-complement dependencies lurking in the
+ FFE (as possibly is true of any large program); if you find any, please
+ report them so we can replace them with dependencies on ffetarget
+ instead.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include <ctype.h>
+#include "glimits.j"
+#include "target.h"
+#include "bad.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+
+/* Externals defined here. */
+
+char ffetarget_string_[40]; /* Temp for ascii-to-double (atof). */
+HOST_WIDE_INT ffetarget_long_val_;
+HOST_WIDE_INT ffetarget_long_junk_;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+static void ffetarget_print_char_ (FILE *f, unsigned char c);
+
+/* Internal macros. */
+
+#ifdef REAL_VALUE_ATOF
+#define FFETARGET_ATOF_(p,m) REAL_VALUE_ATOF ((p),(m))
+#else
+#define FFETARGET_ATOF_(p,m) atof ((p))
+#endif
+
+
+/* ffetarget_print_char_ -- Print a single character (in apostrophe context)
+
+ See prototype.
+
+ Outputs char so it prints or is escaped C style. */
+
+static void
+ffetarget_print_char_ (FILE *f, unsigned char c)
+{
+ switch (c)
+ {
+ case '\\':
+ fputs ("\\\\", f);
+ break;
+
+ case '\'':
+ fputs ("\\\'", f);
+ break;
+
+ default:
+ if (isprint (c) && isascii (c))
+ fputc (c, f);
+ else
+ fprintf (f, "\\%03o", (unsigned int) c);
+ break;
+ }
+}
+
+/* ffetarget_aggregate_info -- Determine type for aggregate storage area
+
+ See prototype.
+
+ If aggregate type is distinct, just return it. Else return a type
+ representing a common denominator for the nondistinct type (for now,
+ just return default character, since that'll work on almost all target
+ machines).
+
+ The rules for abt/akt are (as implemented by ffestorag_update):
+
+ abt == FFEINFO_basictypeANY (akt == FFEINFO_kindtypeANY also, by
+ definition): CHARACTER and non-CHARACTER types mixed.
+
+ abt == FFEINFO_basictypeNONE (akt == FFEINFO_kindtypeNONE also, by
+ definition): More than one non-CHARACTER type mixed, but no CHARACTER
+ types mixed in.
+
+ abt some other value, akt == FFEINFO_kindtypeNONE: abt indicates the
+ only basic type mixed in, but more than one kind type is mixed in.
+
+ abt some other value, akt some other value: abt and akt indicate the
+ only type represented in the aggregation. */
+
+void
+ffetarget_aggregate_info (ffeinfoBasictype *ebt, ffeinfoKindtype *ekt,
+ ffetargetAlign *units, ffeinfoBasictype abt,
+ ffeinfoKindtype akt)
+{
+ ffetype type;
+
+ if ((abt == FFEINFO_basictypeNONE) || (abt == FFEINFO_basictypeANY)
+ || (akt == FFEINFO_kindtypeNONE))
+ {
+ *ebt = FFEINFO_basictypeCHARACTER;
+ *ekt = FFEINFO_kindtypeCHARACTERDEFAULT;
+ }
+ else
+ {
+ *ebt = abt;
+ *ekt = akt;
+ }
+
+ type = ffeinfo_type (*ebt, *ekt);
+ assert (type != NULL);
+
+ *units = ffetype_size (type);
+}
+
+/* ffetarget_align -- Align one storage area to superordinate, update super
+
+ See prototype.
+
+ updated_alignment/updated_modulo contain the already existing
+ alignment requirements for the storage area at whose offset the
+ object with alignment requirements alignment/modulo is to be placed.
+ Find the smallest pad such that the requirements are maintained and
+ return it, but only after updating the updated_alignment/_modulo
+ requirements as necessary to indicate the placement of the new object. */
+
+ffetargetAlign
+ffetarget_align (ffetargetAlign *updated_alignment,
+ ffetargetAlign *updated_modulo, ffetargetOffset offset,
+ ffetargetAlign alignment, ffetargetAlign modulo)
+{
+ ffetargetAlign pad;
+ ffetargetAlign min_pad; /* Minimum amount of padding needed. */
+ ffetargetAlign min_m = 0; /* Minimum-padding m. */
+ ffetargetAlign ua; /* Updated alignment. */
+ ffetargetAlign um; /* Updated modulo. */
+ ffetargetAlign ucnt; /* Multiplier applied to ua. */
+ ffetargetAlign m; /* Copy of modulo. */
+ ffetargetAlign cnt; /* Multiplier applied to alignment. */
+ ffetargetAlign i;
+ ffetargetAlign j;
+
+ assert (*updated_modulo < *updated_alignment);
+ assert (modulo < alignment);
+
+ /* The easy case: similar alignment requirements. */
+
+ if (*updated_alignment == alignment)
+ {
+ if (modulo > *updated_modulo)
+ pad = alignment - (modulo - *updated_modulo);
+ else
+ pad = *updated_modulo - modulo;
+ pad = (offset + pad) % alignment;
+ if (pad != 0)
+ pad = alignment - pad;
+ return pad;
+ }
+
+ /* Sigh, find LCM (Least Common Multiple) for the two alignment factors. */
+
+ for (ua = *updated_alignment, ucnt = 1;
+ ua % alignment != 0;
+ ua += *updated_alignment)
+ ++ucnt;
+
+ cnt = ua / alignment;
+
+ min_pad = ~(ffetargetAlign) 0;/* Set to largest value. */
+
+ /* Find all combinations of modulo values the two alignment requirements
+ have; pick the combination that results in the smallest padding
+ requirement. Of course, if a zero-pad requirement is encountered, just
+ use that one. */
+
+ for (um = *updated_modulo, i = 0; i < ucnt; um += *updated_alignment, ++i)
+ {
+ for (m = modulo, j = 0; j < cnt; m += alignment, ++j)
+ {
+ if (m > um) /* This code is similar to the "easy case"
+ code above. */
+ pad = ua - (m - um);
+ else
+ pad = um - m;
+ pad = (offset + pad) % ua;
+ if (pad != 0)
+ pad = ua - pad;
+ else
+ { /* A zero pad means we've got something
+ useful. */
+ *updated_alignment = ua;
+ *updated_modulo = um;
+ return 0;
+ }
+ if (pad < min_pad)
+ { /* New minimum padding value. */
+ min_pad = pad;
+ min_m = um;
+ }
+ }
+ }
+
+ *updated_alignment = ua;
+ *updated_modulo = min_m;
+ return min_pad;
+}
+
+#if FFETARGET_okCHARACTER1
+bool
+ffetarget_character1 (ffetargetCharacter1 *val, ffelexToken character,
+ mallocPool pool)
+{
+ val->length = ffelex_token_length (character);
+ if (val->length == 0)
+ val->text = NULL;
+ else
+ {
+ val->text = malloc_new_kp (pool, "ffetargetCharacter1", val->length);
+ memcpy (val->text, ffelex_token_text (character), val->length);
+ }
+
+ return TRUE;
+}
+
+#endif
+/* Produce orderable comparison between two constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+int
+ffetarget_cmp_character1 (ffetargetCharacter1 l, ffetargetCharacter1 r)
+{
+ if (l.length < r.length)
+ return -1;
+ if (l.length > r.length)
+ return 1;
+ if (l.length == 0)
+ return 0;
+ return memcmp (l.text, r.text, l.length);
+}
+
+#endif
+/* ffetarget_concatenate_character1 -- Perform CONCAT op on two constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_concatenate_character1 (ffetargetCharacter1 *res,
+ ffetargetCharacter1 l, ffetargetCharacter1 r, mallocPool pool,
+ ffetargetCharacterSize *len)
+{
+ res->length = *len = l.length + r.length;
+ if (*len == 0)
+ res->text = NULL;
+ else
+ {
+ res->text = malloc_new_kp (pool, "ffetargetCharacter1(CONCAT)", *len);
+ if (l.length != 0)
+ memcpy (res->text, l.text, l.length);
+ if (r.length != 0)
+ memcpy (res->text + l.length, r.text, r.length);
+ }
+
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_eq_character1 -- Perform relational comparison on char constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_eq_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r)
+{
+ assert (l.length == r.length);
+ *res = (memcmp (l.text, r.text, l.length) == 0);
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_le_character1 -- Perform relational comparison on char constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_le_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r)
+{
+ assert (l.length == r.length);
+ *res = (memcmp (l.text, r.text, l.length) <= 0);
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_lt_character1 -- Perform relational comparison on char constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_lt_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r)
+{
+ assert (l.length == r.length);
+ *res = (memcmp (l.text, r.text, l.length) < 0);
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_ge_character1 -- Perform relational comparison on char constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_ge_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r)
+{
+ assert (l.length == r.length);
+ *res = (memcmp (l.text, r.text, l.length) >= 0);
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_gt_character1 -- Perform relational comparison on char constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_gt_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r)
+{
+ assert (l.length == r.length);
+ *res = (memcmp (l.text, r.text, l.length) > 0);
+ return FFEBAD;
+}
+#endif
+
+#if FFETARGET_okCHARACTER1
+bool
+ffetarget_iszero_character1 (ffetargetCharacter1 constant)
+{
+ ffetargetCharacterSize i;
+
+ for (i = 0; i < constant.length; ++i)
+ if (constant.text[i] != 0)
+ return FALSE;
+ return TRUE;
+}
+#endif
+
+bool
+ffetarget_iszero_hollerith (ffetargetHollerith constant)
+{
+ ffetargetHollerithSize i;
+
+ for (i = 0; i < constant.length; ++i)
+ if (constant.text[i] != 0)
+ return FALSE;
+ return TRUE;
+}
+
+/* ffetarget_layout -- Do storage requirement analysis for entity
+
+ Return the alignment/modulo requirements along with the size, given the
+ data type info and the number of elements an array (1 for a scalar). */
+
+void
+ffetarget_layout (char *error_text UNUSED, ffetargetAlign *alignment,
+ ffetargetAlign *modulo, ffetargetOffset *size,
+ ffeinfoBasictype bt, ffeinfoKindtype kt,
+ ffetargetCharacterSize charsize,
+ ffetargetIntegerDefault num_elements)
+{
+ bool ok; /* For character type. */
+ ffetargetOffset numele; /* Converted from num_elements. */
+ ffetype type;
+
+ type = ffeinfo_type (bt, kt);
+ assert (type != NULL);
+
+ *alignment = ffetype_alignment (type);
+ *modulo = ffetype_modulo (type);
+ if (bt == FFEINFO_basictypeCHARACTER)
+ {
+ ok = ffetarget_offset_charsize (size, charsize, ffetype_size (type));
+#ifdef ffetarget_offset_overflow
+ if (!ok)
+ ffetarget_offset_overflow (error_text);
+#endif
+ }
+ else
+ *size = ffetype_size (type);
+
+ if ((num_elements < 0)
+ || !ffetarget_offset (&numele, num_elements)
+ || !ffetarget_offset_multiply (size, *size, numele))
+ {
+ ffetarget_offset_overflow (error_text);
+ *alignment = 1;
+ *modulo = 0;
+ *size = 0;
+ }
+}
+
+/* ffetarget_ne_character1 -- Perform relational comparison on char constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_ne_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r)
+{
+ assert (l.length == r.length);
+ *res = (memcmp (l.text, r.text, l.length) != 0);
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_substr_character1 -- Perform SUBSTR op on three constants
+
+ Compare lengths, if equal then use memcmp. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_substr_character1 (ffetargetCharacter1 *res,
+ ffetargetCharacter1 l,
+ ffetargetCharacterSize first,
+ ffetargetCharacterSize last, mallocPool pool,
+ ffetargetCharacterSize *len)
+{
+ if (last < first)
+ {
+ res->length = *len = 0;
+ res->text = NULL;
+ }
+ else
+ {
+ res->length = *len = last - first + 1;
+ res->text = malloc_new_kp (pool, "ffetargetCharacter1(SUBSTR)", *len);
+ memcpy (res->text, l.text + first - 1, *len);
+ }
+
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_cmp_hollerith -- Produce orderable comparison between two
+ constants
+
+ Compare lengths, if equal then use memcmp. */
+
+int
+ffetarget_cmp_hollerith (ffetargetHollerith l, ffetargetHollerith r)
+{
+ if (l.length < r.length)
+ return -1;
+ if (l.length > r.length)
+ return 1;
+ return memcmp (l.text, r.text, l.length);
+}
+
+ffebad
+ffetarget_convert_any_character1_ (char *res, size_t size,
+ ffetargetCharacter1 l)
+{
+ if (size <= (size_t) l.length)
+ {
+ char *p;
+ ffetargetCharacterSize i;
+
+ memcpy (res, l.text, size);
+ for (p = &l.text[0] + size, i = l.length - size;
+ i > 0;
+ ++p, --i)
+ if (*p != ' ')
+ return FFEBAD_TRUNCATING_CHARACTER;
+ }
+ else
+ {
+ memcpy (res, l.text, size);
+ memset (res + l.length, ' ', size - l.length);
+ }
+
+ return FFEBAD;
+}
+
+ffebad
+ffetarget_convert_any_hollerith_ (char *res, size_t size,
+ ffetargetHollerith l)
+{
+ if (size <= (size_t) l.length)
+ {
+ char *p;
+ ffetargetCharacterSize i;
+
+ memcpy (res, l.text, size);
+ for (p = &l.text[0] + size, i = l.length - size;
+ i > 0;
+ ++p, --i)
+ if (*p != ' ')
+ return FFEBAD_TRUNCATING_HOLLERITH;
+ }
+ else
+ {
+ memcpy (res, l.text, size);
+ memset (res + l.length, ' ', size - l.length);
+ }
+
+ return FFEBAD;
+}
+
+ffebad
+ffetarget_convert_any_typeless_ (char *res, size_t size,
+ ffetargetTypeless l)
+{
+ unsigned long long int l1;
+ unsigned long int l2;
+ unsigned int l3;
+ unsigned short int l4;
+ unsigned char l5;
+ size_t size_of;
+ char *p;
+
+ if (size >= sizeof (l1))
+ {
+ l1 = l;
+ p = (char *) &l1;
+ size_of = sizeof (l1);
+ }
+ else if (size >= sizeof (l2))
+ {
+ l2 = l;
+ p = (char *) &l2;
+ size_of = sizeof (l2);
+ l1 = l2;
+ }
+ else if (size >= sizeof (l3))
+ {
+ l3 = l;
+ p = (char *) &l3;
+ size_of = sizeof (l3);
+ l1 = l3;
+ }
+ else if (size >= sizeof (l4))
+ {
+ l4 = l;
+ p = (char *) &l4;
+ size_of = sizeof (l4);
+ l1 = l4;
+ }
+ else if (size >= sizeof (l5))
+ {
+ l5 = l;
+ p = (char *) &l5;
+ size_of = sizeof (l5);
+ l1 = l5;
+ }
+ else
+ {
+ assert ("stumped by conversion from typeless!" == NULL);
+ abort ();
+ }
+
+ if (size <= size_of)
+ {
+ int i = size_of - size;
+
+ memcpy (res, p + i, size);
+ for (; i > 0; ++p, --i)
+ if (*p != '\0')
+ return FFEBAD_TRUNCATING_TYPELESS;
+ }
+ else
+ {
+ int i = size - size_of;
+
+ memset (res, 0, i);
+ memcpy (res + i, p, size_of);
+ }
+
+ if (l1 != l)
+ return FFEBAD_TRUNCATING_TYPELESS;
+ return FFEBAD;
+}
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
+ ffetargetCharacterSize size,
+ ffetargetCharacter1 l,
+ mallocPool pool)
+{
+ res->length = size;
+ if (size == 0)
+ res->text = NULL;
+ else
+ {
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ if (size <= l.length)
+ memcpy (res->text, l.text, size);
+ else
+ {
+ memcpy (res->text, l.text, l.length);
+ memset (res->text + l.length, ' ', size - l.length);
+ }
+ }
+
+ return FFEBAD;
+}
+
+#endif
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
+ ffetargetCharacterSize size,
+ ffetargetHollerith l, mallocPool pool)
+{
+ res->length = size;
+ if (size == 0)
+ res->text = NULL;
+ else
+ {
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ if (size <= l.length)
+ {
+ char *p;
+ ffetargetCharacterSize i;
+
+ memcpy (res->text, l.text, size);
+ for (p = &l.text[0] + size, i = l.length - size;
+ i > 0;
+ ++p, --i)
+ if (*p != ' ')
+ return FFEBAD_TRUNCATING_HOLLERITH;
+ }
+ else
+ {
+ memcpy (res->text, l.text, l.length);
+ memset (res->text + l.length, ' ', size - l.length);
+ }
+ }
+
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_convert_character1_integer1 -- Raw conversion. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_convert_character1_integer4 (ffetargetCharacter1 *res,
+ ffetargetCharacterSize size,
+ ffetargetInteger4 l, mallocPool pool)
+{
+ long long int l1;
+ long int l2;
+ int l3;
+ short int l4;
+ char l5;
+ size_t size_of;
+ char *p;
+
+ if (((size_t) size) >= sizeof (l1))
+ {
+ l1 = l;
+ p = (char *) &l1;
+ size_of = sizeof (l1);
+ }
+ else if (((size_t) size) >= sizeof (l2))
+ {
+ l2 = l;
+ p = (char *) &l2;
+ size_of = sizeof (l2);
+ l1 = l2;
+ }
+ else if (((size_t) size) >= sizeof (l3))
+ {
+ l3 = l;
+ p = (char *) &l3;
+ size_of = sizeof (l3);
+ l1 = l3;
+ }
+ else if (((size_t) size) >= sizeof (l4))
+ {
+ l4 = l;
+ p = (char *) &l4;
+ size_of = sizeof (l4);
+ l1 = l4;
+ }
+ else if (((size_t) size) >= sizeof (l5))
+ {
+ l5 = l;
+ p = (char *) &l5;
+ size_of = sizeof (l5);
+ l1 = l5;
+ }
+ else
+ {
+ assert ("stumped by conversion from integer1!" == NULL);
+ abort ();
+ }
+
+ res->length = size;
+ if (size == 0)
+ res->text = NULL;
+ else
+ {
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ if (((size_t) size) <= size_of)
+ {
+ int i = size_of - size;
+
+ memcpy (res->text, p + i, size);
+ for (; i > 0; ++p, --i)
+ if (*p != 0)
+ return FFEBAD_TRUNCATING_NUMERIC;
+ }
+ else
+ {
+ int i = size - size_of;
+
+ memset (res->text, 0, i);
+ memcpy (res->text + i, p, size_of);
+ }
+ }
+
+ if (l1 != l)
+ return FFEBAD_TRUNCATING_NUMERIC;
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_convert_character1_logical1 -- Raw conversion. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_convert_character1_logical4 (ffetargetCharacter1 *res,
+ ffetargetCharacterSize size,
+ ffetargetLogical4 l, mallocPool pool)
+{
+ long long int l1;
+ long int l2;
+ int l3;
+ short int l4;
+ char l5;
+ size_t size_of;
+ char *p;
+
+ if (((size_t) size) >= sizeof (l1))
+ {
+ l1 = l;
+ p = (char *) &l1;
+ size_of = sizeof (l1);
+ }
+ else if (((size_t) size) >= sizeof (l2))
+ {
+ l2 = l;
+ p = (char *) &l2;
+ size_of = sizeof (l2);
+ l1 = l2;
+ }
+ else if (((size_t) size) >= sizeof (l3))
+ {
+ l3 = l;
+ p = (char *) &l3;
+ size_of = sizeof (l3);
+ l1 = l3;
+ }
+ else if (((size_t) size) >= sizeof (l4))
+ {
+ l4 = l;
+ p = (char *) &l4;
+ size_of = sizeof (l4);
+ l1 = l4;
+ }
+ else if (((size_t) size) >= sizeof (l5))
+ {
+ l5 = l;
+ p = (char *) &l5;
+ size_of = sizeof (l5);
+ l1 = l5;
+ }
+ else
+ {
+ assert ("stumped by conversion from logical1!" == NULL);
+ abort ();
+ }
+
+ res->length = size;
+ if (size == 0)
+ res->text = NULL;
+ else
+ {
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ if (((size_t) size) <= size_of)
+ {
+ int i = size_of - size;
+
+ memcpy (res->text, p + i, size);
+ for (; i > 0; ++p, --i)
+ if (*p != 0)
+ return FFEBAD_TRUNCATING_NUMERIC;
+ }
+ else
+ {
+ int i = size - size_of;
+
+ memset (res->text, 0, i);
+ memcpy (res->text + i, p, size_of);
+ }
+ }
+
+ if (l1 != l)
+ return FFEBAD_TRUNCATING_NUMERIC;
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_convert_character1_typeless -- Raw conversion. */
+
+#if FFETARGET_okCHARACTER1
+ffebad
+ffetarget_convert_character1_typeless (ffetargetCharacter1 *res,
+ ffetargetCharacterSize size,
+ ffetargetTypeless l, mallocPool pool)
+{
+ unsigned long long int l1;
+ unsigned long int l2;
+ unsigned int l3;
+ unsigned short int l4;
+ unsigned char l5;
+ size_t size_of;
+ char *p;
+
+ if (((size_t) size) >= sizeof (l1))
+ {
+ l1 = l;
+ p = (char *) &l1;
+ size_of = sizeof (l1);
+ }
+ else if (((size_t) size) >= sizeof (l2))
+ {
+ l2 = l;
+ p = (char *) &l2;
+ size_of = sizeof (l2);
+ l1 = l2;
+ }
+ else if (((size_t) size) >= sizeof (l3))
+ {
+ l3 = l;
+ p = (char *) &l3;
+ size_of = sizeof (l3);
+ l1 = l3;
+ }
+ else if (((size_t) size) >= sizeof (l4))
+ {
+ l4 = l;
+ p = (char *) &l4;
+ size_of = sizeof (l4);
+ l1 = l4;
+ }
+ else if (((size_t) size) >= sizeof (l5))
+ {
+ l5 = l;
+ p = (char *) &l5;
+ size_of = sizeof (l5);
+ l1 = l5;
+ }
+ else
+ {
+ assert ("stumped by conversion from typeless!" == NULL);
+ abort ();
+ }
+
+ res->length = size;
+ if (size == 0)
+ res->text = NULL;
+ else
+ {
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ if (((size_t) size) <= size_of)
+ {
+ int i = size_of - size;
+
+ memcpy (res->text, p + i, size);
+ for (; i > 0; ++p, --i)
+ if (*p != 0)
+ return FFEBAD_TRUNCATING_TYPELESS;
+ }
+ else
+ {
+ int i = size - size_of;
+
+ memset (res->text, 0, i);
+ memcpy (res->text + i, p, size_of);
+ }
+ }
+
+ if (l1 != l)
+ return FFEBAD_TRUNCATING_TYPELESS;
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_divide_complex1 -- Divide function
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEX1
+ffebad
+ffetarget_divide_complex1 (ffetargetComplex1 *res, ffetargetComplex1 l,
+ ffetargetComplex1 r)
+{
+ ffebad bad;
+ ffetargetReal1 tmp1, tmp2, tmp3, tmp4;
+
+ bad = ffetarget_multiply_real1 (&tmp1, r.real, r.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, r.imaginary, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real1 (&tmp3, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+
+ if (ffetarget_iszero_real1 (tmp3))
+ {
+ ffetarget_real1_zero (&(res)->real);
+ ffetarget_real1_zero (&(res)->imaginary);
+ return FFEBAD_DIV_BY_ZERO;
+ }
+
+ bad = ffetarget_multiply_real1 (&tmp1, l.real, r.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real1 (&tmp4, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_divide_real1 (&res->real, tmp4, tmp3);
+ if (bad != FFEBAD)
+ return bad;
+
+ bad = ffetarget_multiply_real1 (&tmp1, r.real, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, l.real, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real1 (&tmp4, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_divide_real1 (&res->imaginary, tmp4, tmp3);
+
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_divide_complex2 -- Divide function
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEX2
+ffebad
+ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
+ ffetargetComplex2 r)
+{
+ ffebad bad;
+ ffetargetReal2 tmp1, tmp2, tmp3, tmp4;
+
+ bad = ffetarget_multiply_real2 (&tmp1, r.real, r.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, r.imaginary, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real2 (&tmp3, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+
+ if (ffetarget_iszero_real2 (tmp3))
+ {
+ ffetarget_real2_zero (&(res)->real);
+ ffetarget_real2_zero (&(res)->imaginary);
+ return FFEBAD_DIV_BY_ZERO;
+ }
+
+ bad = ffetarget_multiply_real2 (&tmp1, l.real, r.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real2 (&tmp4, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_divide_real2 (&res->real, tmp4, tmp3);
+ if (bad != FFEBAD)
+ return bad;
+
+ bad = ffetarget_multiply_real2 (&tmp1, r.real, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, l.real, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real2 (&tmp4, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_divide_real2 (&res->imaginary, tmp4, tmp3);
+
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_hollerith -- Convert token to a hollerith constant
+
+ See prototype.
+
+ Token use count not affected overall. */
+
+bool
+ffetarget_hollerith (ffetargetHollerith *val, ffelexToken integer,
+ mallocPool pool)
+{
+ val->length = ffelex_token_length (integer);
+ val->text = malloc_new_kp (pool, "ffetargetHollerith", val->length);
+ memcpy (val->text, ffelex_token_text (integer), val->length);
+
+ return TRUE;
+}
+
+/* ffetarget_integer_bad_magical -- Complain about a magical number
+
+ Just calls ffebad with the arguments. */
+
+void
+ffetarget_integer_bad_magical (ffelexToken t)
+{
+ ffebad_start (FFEBAD_BAD_MAGICAL);
+ ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+ ffebad_finish ();
+}
+
+/* ffetarget_integer_bad_magical_binary -- Complain about a magical number
+
+ Just calls ffebad with the arguments. */
+
+void
+ffetarget_integer_bad_magical_binary (ffelexToken integer,
+ ffelexToken minus)
+{
+ ffebad_start (FFEBAD_BAD_MAGICAL_BINARY);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_here (1, ffelex_token_where_line (minus),
+ ffelex_token_where_column (minus));
+ ffebad_finish ();
+}
+
+/* ffetarget_integer_bad_magical_precedence -- Complain about a magical
+ number
+
+ Just calls ffebad with the arguments. */
+
+void
+ffetarget_integer_bad_magical_precedence (ffelexToken integer,
+ ffelexToken uminus,
+ ffelexToken higher_op)
+{
+ ffebad_start (FFEBAD_BAD_MAGICAL_PRECEDENCE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_here (1, ffelex_token_where_line (uminus),
+ ffelex_token_where_column (uminus));
+ ffebad_here (2, ffelex_token_where_line (higher_op),
+ ffelex_token_where_column (higher_op));
+ ffebad_finish ();
+}
+
+/* ffetarget_integer_bad_magical_precedence_binary -- Complain...
+
+ Just calls ffebad with the arguments. */
+
+void
+ffetarget_integer_bad_magical_precedence_binary (ffelexToken integer,
+ ffelexToken minus,
+ ffelexToken higher_op)
+{
+ ffebad_start (FFEBAD_BAD_MAGICAL_PRECEDENCE_BINARY);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_here (1, ffelex_token_where_line (minus),
+ ffelex_token_where_column (minus));
+ ffebad_here (2, ffelex_token_where_line (higher_op),
+ ffelex_token_where_column (higher_op));
+ ffebad_finish ();
+}
+
+/* ffetarget_integer1 -- Convert token to an integer
+
+ See prototype.
+
+ Token use count not affected overall. */
+
+#if FFETARGET_okINTEGER1
+bool
+ffetarget_integer1 (ffetargetInteger1 *val, ffelexToken integer)
+{
+ ffetargetInteger1 x;
+ char *p;
+ char c;
+
+ assert (ffelex_token_type (integer) == FFELEX_typeNUMBER);
+
+ p = ffelex_token_text (integer);
+ x = 0;
+
+ /* Skip past leading zeros. */
+
+ while (((c = *p) != '\0') && (c == '0'))
+ ++p;
+
+ /* Interpret rest of number. */
+
+ while (c != '\0')
+ {
+ if ((x == FFETARGET_integerALMOST_BIG_MAGICAL)
+ && (c == '0' + FFETARGET_integerFINISH_BIG_MAGICAL)
+ && (*(p + 1) == '\0'))
+ {
+ *val = (ffetargetInteger1) FFETARGET_integerBIG_MAGICAL;
+ return TRUE;
+ }
+ else if (x == FFETARGET_integerALMOST_BIG_MAGICAL)
+ {
+ if ((c > '0' + FFETARGET_integerFINISH_BIG_MAGICAL)
+ || (*(p + 1) != '\0'))
+ {
+ ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ *val = 0;
+ return FALSE;
+ }
+ }
+ else if (x > FFETARGET_integerALMOST_BIG_MAGICAL)
+ {
+ ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ *val = 0;
+ return FALSE;
+ }
+ x = x * 10 + c - '0';
+ c = *(++p);
+ };
+
+ *val = x;
+ return TRUE;
+}
+
+#endif
+/* ffetarget_integerbinary -- Convert token to a binary integer
+
+ ffetarget_integerbinary x;
+ if (ffetarget_integerdefault_8(&x,integer_token))
+ // conversion ok.
+
+ Token use count not affected overall. */
+
+bool
+ffetarget_integerbinary (ffetargetIntegerDefault *val, ffelexToken integer)
+{
+ ffetargetIntegerDefault x;
+ char *p;
+ char c;
+ bool bad_digit;
+
+ assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
+ || (ffelex_token_type (integer) == FFELEX_typeNUMBER));
+
+ p = ffelex_token_text (integer);
+ x = 0;
+
+ /* Skip past leading zeros. */
+
+ while (((c = *p) != '\0') && (c == '0'))
+ ++p;
+
+ /* Interpret rest of number. */
+
+ bad_digit = FALSE;
+ while (c != '\0')
+ {
+ if ((c >= '0') && (c <= '1'))
+ c -= '0';
+ else
+ {
+ bad_digit = TRUE;
+ c = 0;
+ }
+
+#if 0 /* Don't complain about signed overflow; just
+ unsigned overflow. */
+ if ((x == FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
+ && (c == FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY)
+ && (*(p + 1) == '\0'))
+ {
+ *val = FFETARGET_integerBIG_OVERFLOW_BINARY;
+ return TRUE;
+ }
+ else
+#endif
+#if FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY == 0
+ if ((x & FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY) != 0)
+#else
+ if (x == FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
+ {
+ if ((c > FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY)
+ || (*(p + 1) != '\0'))
+ {
+ ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ *val = 0;
+ return FALSE;
+ }
+ }
+ else if (x > FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
+#endif
+ {
+ ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ *val = 0;
+ return FALSE;
+ }
+ x = (x << 1) + c;
+ c = *(++p);
+ };
+
+ if (bad_digit)
+ {
+ ffebad_start (FFEBAD_INVALID_BINARY_DIGIT);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ }
+
+ *val = x;
+ return !bad_digit;
+}
+
+/* ffetarget_integerhex -- Convert token to a hex integer
+
+ ffetarget_integerhex x;
+ if (ffetarget_integerdefault_8(&x,integer_token))
+ // conversion ok.
+
+ Token use count not affected overall. */
+
+bool
+ffetarget_integerhex (ffetargetIntegerDefault *val, ffelexToken integer)
+{
+ ffetargetIntegerDefault x;
+ char *p;
+ char c;
+ bool bad_digit;
+
+ assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
+ || (ffelex_token_type (integer) == FFELEX_typeNUMBER));
+
+ p = ffelex_token_text (integer);
+ x = 0;
+
+ /* Skip past leading zeros. */
+
+ while (((c = *p) != '\0') && (c == '0'))
+ ++p;
+
+ /* Interpret rest of number. */
+
+ bad_digit = FALSE;
+ while (c != '\0')
+ {
+ if ((c >= 'A') && (c <= 'F'))
+ c = c - 'A' + 10;
+ else if ((c >= 'a') && (c <= 'f'))
+ c = c - 'a' + 10;
+ else if ((c >= '0') && (c <= '9'))
+ c -= '0';
+ else
+ {
+ bad_digit = TRUE;
+ c = 0;
+ }
+
+#if 0 /* Don't complain about signed overflow; just
+ unsigned overflow. */
+ if ((x == FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
+ && (c == FFETARGET_integerFINISH_BIG_OVERFLOW_HEX)
+ && (*(p + 1) == '\0'))
+ {
+ *val = FFETARGET_integerBIG_OVERFLOW_HEX;
+ return TRUE;
+ }
+ else
+#endif
+#if FFETARGET_integerFINISH_BIG_OVERFLOW_HEX == 0
+ if (x >= FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
+#else
+ if (x == FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
+ {
+ if ((c > FFETARGET_integerFINISH_BIG_OVERFLOW_HEX)
+ || (*(p + 1) != '\0'))
+ {
+ ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ *val = 0;
+ return FALSE;
+ }
+ }
+ else if (x > FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
+#endif
+ {
+ ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ *val = 0;
+ return FALSE;
+ }
+ x = (x << 4) + c;
+ c = *(++p);
+ };
+
+ if (bad_digit)
+ {
+ ffebad_start (FFEBAD_INVALID_HEX_DIGIT);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ }
+
+ *val = x;
+ return !bad_digit;
+}
+
+/* ffetarget_integeroctal -- Convert token to an octal integer
+
+ ffetarget_integeroctal x;
+ if (ffetarget_integerdefault_8(&x,integer_token))
+ // conversion ok.
+
+ Token use count not affected overall. */
+
+bool
+ffetarget_integeroctal (ffetargetIntegerDefault *val, ffelexToken integer)
+{
+ ffetargetIntegerDefault x;
+ char *p;
+ char c;
+ bool bad_digit;
+
+ assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
+ || (ffelex_token_type (integer) == FFELEX_typeNUMBER));
+
+ p = ffelex_token_text (integer);
+ x = 0;
+
+ /* Skip past leading zeros. */
+
+ while (((c = *p) != '\0') && (c == '0'))
+ ++p;
+
+ /* Interpret rest of number. */
+
+ bad_digit = FALSE;
+ while (c != '\0')
+ {
+ if ((c >= '0') && (c <= '7'))
+ c -= '0';
+ else
+ {
+ bad_digit = TRUE;
+ c = 0;
+ }
+
+#if 0 /* Don't complain about signed overflow; just
+ unsigned overflow. */
+ if ((x == FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL)
+ && (c == FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL)
+ && (*(p + 1) == '\0'))
+ {
+ *val = FFETARGET_integerBIG_OVERFLOW_OCTAL;
+ return TRUE;
+ }
+ else
+#endif
+#if FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL == 0
+ if (x >= FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL)
+#else
+ if (x == FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL)
+ {
+ if ((c > FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL)
+ || (*(p + 1) != '\0'))
+ {
+ ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ *val = 0;
+ return FALSE;
+ }
+ }
+ else if (x > FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL)
+#endif
+ {
+ ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ *val = 0;
+ return FALSE;
+ }
+ x = (x << 3) + c;
+ c = *(++p);
+ };
+
+ if (bad_digit)
+ {
+ ffebad_start (FFEBAD_INVALID_OCTAL_DIGIT);
+ ffebad_here (0, ffelex_token_where_line (integer),
+ ffelex_token_where_column (integer));
+ ffebad_finish ();
+ }
+
+ *val = x;
+ return !bad_digit;
+}
+
+/* ffetarget_multiply_complex1 -- Multiply function
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEX1
+ffebad
+ffetarget_multiply_complex1 (ffetargetComplex1 *res, ffetargetComplex1 l,
+ ffetargetComplex1 r)
+{
+ ffebad bad;
+ ffetargetReal1 tmp1, tmp2;
+
+ bad = ffetarget_multiply_real1 (&tmp1, l.real, r.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real1 (&res->real, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp1, l.imaginary, r.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, l.real, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real1 (&res->imaginary, tmp1, tmp2);
+
+ return bad;
+}
+
+#endif
+/* ffetarget_multiply_complex2 -- Multiply function
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEX2
+ffebad
+ffetarget_multiply_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
+ ffetargetComplex2 r)
+{
+ ffebad bad;
+ ffetargetReal2 tmp1, tmp2;
+
+ bad = ffetarget_multiply_real2 (&tmp1, l.real, r.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real2 (&res->real, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp1, l.imaginary, r.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, l.real, r.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real2 (&res->imaginary, tmp1, tmp2);
+
+ return bad;
+}
+
+#endif
+/* ffetarget_power_complexdefault_integerdefault -- Power function
+
+ See prototype. */
+
+ffebad
+ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault *res,
+ ffetargetComplexDefault l,
+ ffetargetIntegerDefault r)
+{
+ ffebad bad;
+ ffetargetRealDefault tmp;
+ ffetargetRealDefault tmp1;
+ ffetargetRealDefault tmp2;
+ ffetargetRealDefault two;
+
+ if (ffetarget_iszero_real1 (l.real)
+ && ffetarget_iszero_real1 (l.imaginary))
+ {
+ ffetarget_real1_zero (&res->real);
+ ffetarget_real1_zero (&res->imaginary);
+ return FFEBAD;
+ }
+
+ if (r == 0)
+ {
+ ffetarget_real1_one (&res->real);
+ ffetarget_real1_zero (&res->imaginary);
+ return FFEBAD;
+ }
+
+ if (r < 0)
+ {
+ r = -r;
+ bad = ffetarget_multiply_real1 (&tmp1, l.real, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real1 (&tmp, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_divide_real1 (&l.real, l.real, tmp);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_divide_real1 (&l.imaginary, l.imaginary, tmp);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_uminus_real1 (&l.imaginary, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ }
+
+ ffetarget_real1_two (&two);
+
+ while ((r & 1) == 0)
+ {
+ bad = ffetarget_multiply_real1 (&tmp1, l.real, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real1 (&tmp, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&l.imaginary, l.real, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&l.imaginary, l.imaginary, two);
+ if (bad != FFEBAD)
+ return bad;
+ l.real = tmp;
+ r >>= 1;
+ }
+
+ *res = l;
+ r >>= 1;
+
+ while (r != 0)
+ {
+ bad = ffetarget_multiply_real1 (&tmp1, l.real, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real1 (&tmp, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&l.imaginary, l.real, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&l.imaginary, l.imaginary, two);
+ if (bad != FFEBAD)
+ return bad;
+ l.real = tmp;
+ if ((r & 1) == 1)
+ {
+ bad = ffetarget_multiply_real1 (&tmp1, res->real, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, res->imaginary,
+ l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real1 (&tmp, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp1, res->imaginary, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real1 (&tmp2, res->real, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real1 (&res->imaginary, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ res->real = tmp;
+ }
+ r >>= 1;
+ }
+
+ return FFEBAD;
+}
+
+/* ffetarget_power_complexdouble_integerdefault -- Power function
+
+ See prototype. */
+
+#if FFETARGET_okCOMPLEXDOUBLE
+ffebad
+ffetarget_power_complexdouble_integerdefault (ffetargetComplexDouble *res,
+ ffetargetComplexDouble l, ffetargetIntegerDefault r)
+{
+ ffebad bad;
+ ffetargetRealDouble tmp;
+ ffetargetRealDouble tmp1;
+ ffetargetRealDouble tmp2;
+ ffetargetRealDouble two;
+
+ if (ffetarget_iszero_real2 (l.real)
+ && ffetarget_iszero_real2 (l.imaginary))
+ {
+ ffetarget_real2_zero (&res->real);
+ ffetarget_real2_zero (&res->imaginary);
+ return FFEBAD;
+ }
+
+ if (r == 0)
+ {
+ ffetarget_real2_one (&res->real);
+ ffetarget_real2_zero (&res->imaginary);
+ return FFEBAD;
+ }
+
+ if (r < 0)
+ {
+ r = -r;
+ bad = ffetarget_multiply_real2 (&tmp1, l.real, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real2 (&tmp, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_divide_real2 (&l.real, l.real, tmp);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_divide_real2 (&l.imaginary, l.imaginary, tmp);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_uminus_real2 (&l.imaginary, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ }
+
+ ffetarget_real2_two (&two);
+
+ while ((r & 1) == 0)
+ {
+ bad = ffetarget_multiply_real2 (&tmp1, l.real, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real2 (&tmp, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&l.imaginary, l.real, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&l.imaginary, l.imaginary, two);
+ if (bad != FFEBAD)
+ return bad;
+ l.real = tmp;
+ r >>= 1;
+ }
+
+ *res = l;
+ r >>= 1;
+
+ while (r != 0)
+ {
+ bad = ffetarget_multiply_real2 (&tmp1, l.real, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real2 (&tmp, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&l.imaginary, l.real, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&l.imaginary, l.imaginary, two);
+ if (bad != FFEBAD)
+ return bad;
+ l.real = tmp;
+ if ((r & 1) == 1)
+ {
+ bad = ffetarget_multiply_real2 (&tmp1, res->real, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, res->imaginary,
+ l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_subtract_real2 (&tmp, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp1, res->imaginary, l.real);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_multiply_real2 (&tmp2, res->real, l.imaginary);
+ if (bad != FFEBAD)
+ return bad;
+ bad = ffetarget_add_real2 (&res->imaginary, tmp1, tmp2);
+ if (bad != FFEBAD)
+ return bad;
+ res->real = tmp;
+ }
+ r >>= 1;
+ }
+
+ return FFEBAD;
+}
+
+#endif
+/* ffetarget_power_integerdefault_integerdefault -- Power function
+
+ See prototype. */
+
+ffebad
+ffetarget_power_integerdefault_integerdefault (ffetargetIntegerDefault *res,
+ ffetargetIntegerDefault l, ffetargetIntegerDefault r)
+{
+ if (l == 0)
+ {
+ *res = 0;
+ return FFEBAD;
+ }
+
+ if (r == 0)
+ {
+ *res = 1;
+ return FFEBAD;
+ }
+
+ if (r < 0)
+ {
+ if (l == 1)
+ *res = 1;
+ else if (l == 0)
+ *res = 1;
+ else if (l == -1)
+ *res = ((-r) & 1) == 0 ? 1 : -1;
+ else
+ *res = 0;
+ return FFEBAD;
+ }
+
+ while ((r & 1) == 0)
+ {
+ l *= l;
+ r >>= 1;
+ }
+
+ *res = l;
+ r >>= 1;
+
+ while (r != 0)
+ {
+ l *= l;
+ if ((r & 1) == 1)
+ *res *= l;
+ r >>= 1;
+ }
+
+ return FFEBAD;
+}
+
+/* ffetarget_power_realdefault_integerdefault -- Power function
+
+ See prototype. */
+
+ffebad
+ffetarget_power_realdefault_integerdefault (ffetargetRealDefault *res,
+ ffetargetRealDefault l, ffetargetIntegerDefault r)
+{
+ ffebad bad;
+
+ if (ffetarget_iszero_real1 (l))
+ {
+ ffetarget_real1_zero (res);
+ return FFEBAD;
+ }
+
+ if (r == 0)
+ {
+ ffetarget_real1_one (res);
+ return FFEBAD;
+ }
+
+ if (r < 0)
+ {
+ ffetargetRealDefault one;
+
+ ffetarget_real1_one (&one);
+ r = -r;
+ bad = ffetarget_divide_real1 (&l, one, l);
+ if (bad != FFEBAD)
+ return bad;
+ }
+
+ while ((r & 1) == 0)
+ {
+ bad = ffetarget_multiply_real1 (&l, l, l);
+ if (bad != FFEBAD)
+ return bad;
+ r >>= 1;
+ }
+
+ *res = l;
+ r >>= 1;
+
+ while (r != 0)
+ {
+ bad = ffetarget_multiply_real1 (&l, l, l);
+ if (bad != FFEBAD)
+ return bad;
+ if ((r & 1) == 1)
+ {
+ bad = ffetarget_multiply_real1 (res, *res, l);
+ if (bad != FFEBAD)
+ return bad;
+ }
+ r >>= 1;
+ }
+
+ return FFEBAD;
+}
+
+/* ffetarget_power_realdouble_integerdefault -- Power function
+
+ See prototype. */
+
+ffebad
+ffetarget_power_realdouble_integerdefault (ffetargetRealDouble *res,
+ ffetargetRealDouble l,
+ ffetargetIntegerDefault r)
+{
+ ffebad bad;
+
+ if (ffetarget_iszero_real2 (l))
+ {
+ ffetarget_real2_zero (res);
+ return FFEBAD;
+ }
+
+ if (r == 0)
+ {
+ ffetarget_real2_one (res);
+ return FFEBAD;
+ }
+
+ if (r < 0)
+ {
+ ffetargetRealDouble one;
+
+ ffetarget_real2_one (&one);
+ r = -r;
+ bad = ffetarget_divide_real2 (&l, one, l);
+ if (bad != FFEBAD)
+ return bad;
+ }
+
+ while ((r & 1) == 0)
+ {
+ bad = ffetarget_multiply_real2 (&l, l, l);
+ if (bad != FFEBAD)
+ return bad;
+ r >>= 1;
+ }
+
+ *res = l;
+ r >>= 1;
+
+ while (r != 0)
+ {
+ bad = ffetarget_multiply_real2 (&l, l, l);
+ if (bad != FFEBAD)
+ return bad;
+ if ((r & 1) == 1)
+ {
+ bad = ffetarget_multiply_real2 (res, *res, l);
+ if (bad != FFEBAD)
+ return bad;
+ }
+ r >>= 1;
+ }
+
+ return FFEBAD;
+}
+
+/* ffetarget_print_binary -- Output typeless binary integer
+
+ ffetargetTypeless val;
+ ffetarget_typeless_binary(dmpout,val); */
+
+void
+ffetarget_print_binary (FILE *f, ffetargetTypeless value)
+{
+ char *p;
+ char digits[sizeof (value) * CHAR_BIT + 1];
+
+ if (f == NULL)
+ f = dmpout;
+
+ p = &digits[ARRAY_SIZE (digits) - 1];
+ *p = '\0';
+ do
+ {
+ *--p = (value & 1) + '0';
+ value >>= 1;
+ } while (value == 0);
+
+ fputs (p, f);
+}
+
+/* ffetarget_print_character1 -- Output character string
+
+ ffetargetCharacter1 val;
+ ffetarget_print_character1(dmpout,val); */
+
+void
+ffetarget_print_character1 (FILE *f, ffetargetCharacter1 value)
+{
+ unsigned char *p;
+ ffetargetCharacterSize i;
+
+ fputc ('\'', dmpout);
+ for (i = 0, p = value.text; i < value.length; ++i, ++p)
+ ffetarget_print_char_ (f, *p);
+ fputc ('\'', dmpout);
+}
+
+/* ffetarget_print_hollerith -- Output hollerith string
+
+ ffetargetHollerith val;
+ ffetarget_print_hollerith(dmpout,val); */
+
+void
+ffetarget_print_hollerith (FILE *f, ffetargetHollerith value)
+{
+ unsigned char *p;
+ ffetargetHollerithSize i;
+
+ fputc ('\'', dmpout);
+ for (i = 0, p = value.text; i < value.length; ++i, ++p)
+ ffetarget_print_char_ (f, *p);
+ fputc ('\'', dmpout);
+}
+
+/* ffetarget_print_octal -- Output typeless octal integer
+
+ ffetargetTypeless val;
+ ffetarget_print_octal(dmpout,val); */
+
+void
+ffetarget_print_octal (FILE *f, ffetargetTypeless value)
+{
+ char *p;
+ char digits[sizeof (value) * CHAR_BIT / 3 + 1];
+
+ if (f == NULL)
+ f = dmpout;
+
+ p = &digits[ARRAY_SIZE (digits) - 3];
+ *p = '\0';
+ do
+ {
+ *--p = (value & 3) + '0';
+ value >>= 3;
+ } while (value == 0);
+
+ fputs (p, f);
+}
+
+/* ffetarget_print_hex -- Output typeless hex integer
+
+ ffetargetTypeless val;
+ ffetarget_print_hex(dmpout,val); */
+
+void
+ffetarget_print_hex (FILE *f, ffetargetTypeless value)
+{
+ char *p;
+ char digits[sizeof (value) * CHAR_BIT / 4 + 1];
+ static char hexdigits[16] = "0123456789ABCDEF";
+
+ if (f == NULL)
+ f = dmpout;
+
+ p = &digits[ARRAY_SIZE (digits) - 3];
+ *p = '\0';
+ do
+ {
+ *--p = hexdigits[value & 4];
+ value >>= 4;
+ } while (value == 0);
+
+ fputs (p, f);
+}
+
+/* ffetarget_real1 -- Convert token to a single-precision real number
+
+ See prototype.
+
+ Pass NULL for any token not provided by the user, but a valid Fortran
+ real number must be provided somehow. For example, it is ok for
+ exponent_sign_token and exponent_digits_token to be NULL as long as
+ exponent_token not only starts with "E" or "e" but also contains at least
+ one digit following it. Token use counts not affected overall. */
+
+#if FFETARGET_okREAL1
+bool
+ffetarget_real1 (ffetargetReal1 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits)
+{
+ size_t sz = 1; /* Allow room for '\0' byte at end. */
+ char *ptr = &ffetarget_string_[0];
+ char *p = ptr;
+ char *q;
+
+#define dotok(x) if (x != NULL) ++sz;
+#define dotoktxt(x) if (x != NULL) sz += ffelex_token_length(x)
+
+ dotoktxt (integer);
+ dotok (decimal);
+ dotoktxt (fraction);
+ dotoktxt (exponent);
+ dotok (exponent_sign);
+ dotoktxt (exponent_digits);
+
+#undef dotok
+#undef dotoktxt
+
+ if (sz > ARRAY_SIZE (ffetarget_string_))
+ p = ptr = (char *) malloc_new_ks (malloc_pool_image (), "ffetarget_real1",
+ sz);
+
+#define dotoktxt(x) if (x != NULL) \
+ { \
+ for (q = ffelex_token_text(x); *q != '\0'; ++q) \
+ *p++ = *q; \
+ }
+
+ dotoktxt (integer);
+
+ if (decimal != NULL)
+ *p++ = '.';
+
+ dotoktxt (fraction);
+ dotoktxt (exponent);
+
+ if (exponent_sign != NULL)
+ if (ffelex_token_type (exponent_sign) == FFELEX_typePLUS)
+ *p++ = '+';
+ else
+ {
+ assert (ffelex_token_type (exponent_sign) == FFELEX_typeMINUS);
+ *p++ = '-';
+ }
+
+ dotoktxt (exponent_digits);
+
+#undef dotoktxt
+
+ *p = '\0';
+
+ ffetarget_make_real1 (value,
+ FFETARGET_ATOF_ (ptr,
+ SFmode));
+
+ if (sz > ARRAY_SIZE (ffetarget_string_))
+ malloc_kill_ks (malloc_pool_image (), ptr, sz);
+
+ return TRUE;
+}
+
+#endif
+/* ffetarget_real2 -- Convert token to a single-precision real number
+
+ See prototype.
+
+ Pass NULL for any token not provided by the user, but a valid Fortran
+ real number must be provided somehow. For example, it is ok for
+ exponent_sign_token and exponent_digits_token to be NULL as long as
+ exponent_token not only starts with "E" or "e" but also contains at least
+ one digit following it. Token use counts not affected overall. */
+
+#if FFETARGET_okREAL2
+bool
+ffetarget_real2 (ffetargetReal2 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits)
+{
+ size_t sz = 1; /* Allow room for '\0' byte at end. */
+ char *ptr = &ffetarget_string_[0];
+ char *p = ptr;
+ char *q;
+
+#define dotok(x) if (x != NULL) ++sz;
+#define dotoktxt(x) if (x != NULL) sz += ffelex_token_length(x)
+
+ dotoktxt (integer);
+ dotok (decimal);
+ dotoktxt (fraction);
+ dotoktxt (exponent);
+ dotok (exponent_sign);
+ dotoktxt (exponent_digits);
+
+#undef dotok
+#undef dotoktxt
+
+ if (sz > ARRAY_SIZE (ffetarget_string_))
+ p = ptr = (char *) malloc_new_ks (malloc_pool_image (), "ffetarget_real1", sz);
+
+#define dotoktxt(x) if (x != NULL) \
+ { \
+ for (q = ffelex_token_text(x); *q != '\0'; ++q) \
+ *p++ = *q; \
+ }
+#define dotoktxtexp(x) if (x != NULL) \
+ { \
+ *p++ = 'E'; \
+ for (q = ffelex_token_text(x) + 1; *q != '\0'; ++q) \
+ *p++ = *q; \
+ }
+
+ dotoktxt (integer);
+
+ if (decimal != NULL)
+ *p++ = '.';
+
+ dotoktxt (fraction);
+ dotoktxtexp (exponent);
+
+ if (exponent_sign != NULL)
+ if (ffelex_token_type (exponent_sign) == FFELEX_typePLUS)
+ *p++ = '+';
+ else
+ {
+ assert (ffelex_token_type (exponent_sign) == FFELEX_typeMINUS);
+ *p++ = '-';
+ }
+
+ dotoktxt (exponent_digits);
+
+#undef dotoktxt
+
+ *p = '\0';
+
+ ffetarget_make_real2 (value,
+ FFETARGET_ATOF_ (ptr,
+ DFmode));
+
+ if (sz > ARRAY_SIZE (ffetarget_string_))
+ malloc_kill_ks (malloc_pool_image (), ptr, sz);
+
+ return TRUE;
+}
+
+#endif
+bool
+ffetarget_typeless_binary (ffetargetTypeless *xvalue, ffelexToken token)
+{
+ char *p;
+ char c;
+ ffetargetTypeless value = 0;
+ ffetargetTypeless new_value = 0;
+ bool bad_digit = FALSE;
+ bool overflow = FALSE;
+
+ p = ffelex_token_text (token);
+
+ for (c = *p; c != '\0'; c = *++p)
+ {
+ new_value <<= 1;
+ if ((new_value >> 1) != value)
+ overflow = TRUE;
+ if (isdigit (c))
+ new_value += c - '0';
+ else
+ bad_digit = TRUE;
+ value = new_value;
+ }
+
+ if (bad_digit)
+ {
+ ffebad_start (FFEBAD_INVALID_TYPELESS_BINARY_DIGIT);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_finish ();
+ }
+ else if (overflow)
+ {
+ ffebad_start (FFEBAD_TYPELESS_OVERFLOW);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_finish ();
+ }
+
+ *xvalue = value;
+
+ return !bad_digit && !overflow;
+}
+
+bool
+ffetarget_typeless_octal (ffetargetTypeless *xvalue, ffelexToken token)
+{
+ char *p;
+ char c;
+ ffetargetTypeless value = 0;
+ ffetargetTypeless new_value = 0;
+ bool bad_digit = FALSE;
+ bool overflow = FALSE;
+
+ p = ffelex_token_text (token);
+
+ for (c = *p; c != '\0'; c = *++p)
+ {
+ new_value <<= 3;
+ if ((new_value >> 3) != value)
+ overflow = TRUE;
+ if (isdigit (c))
+ new_value += c - '0';
+ else
+ bad_digit = TRUE;
+ value = new_value;
+ }
+
+ if (bad_digit)
+ {
+ ffebad_start (FFEBAD_INVALID_TYPELESS_OCTAL_DIGIT);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_finish ();
+ }
+ else if (overflow)
+ {
+ ffebad_start (FFEBAD_TYPELESS_OVERFLOW);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_finish ();
+ }
+
+ *xvalue = value;
+
+ return !bad_digit && !overflow;
+}
+
+bool
+ffetarget_typeless_hex (ffetargetTypeless *xvalue, ffelexToken token)
+{
+ char *p;
+ char c;
+ ffetargetTypeless value = 0;
+ ffetargetTypeless new_value = 0;
+ bool bad_digit = FALSE;
+ bool overflow = FALSE;
+
+ p = ffelex_token_text (token);
+
+ for (c = *p; c != '\0'; c = *++p)
+ {
+ new_value <<= 4;
+ if ((new_value >> 4) != value)
+ overflow = TRUE;
+ if (isdigit (c))
+ new_value += c - '0';
+ else if ((c >= 'A') && (c <= 'F'))
+ new_value += c - 'A' + 10;
+ else if ((c >= 'a') && (c <= 'f'))
+ new_value += c - 'a' + 10;
+ else
+ bad_digit = TRUE;
+ value = new_value;
+ }
+
+ if (bad_digit)
+ {
+ ffebad_start (FFEBAD_INVALID_TYPELESS_HEX_DIGIT);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_finish ();
+ }
+ else if (overflow)
+ {
+ ffebad_start (FFEBAD_TYPELESS_OVERFLOW);
+ ffebad_here (0, ffelex_token_where_line (token),
+ ffelex_token_where_column (token));
+ ffebad_finish ();
+ }
+
+ *xvalue = value;
+
+ return !bad_digit && !overflow;
+}
+
+void
+ffetarget_verify_character1 (mallocPool pool, ffetargetCharacter1 val)
+{
+ if (val.length != 0)
+ malloc_verify_kp (pool, val.text, val.length);
+}
+
+/* This is like memcpy. It is needed because some systems' header files
+ don't declare memcpy as a function but instead
+ "#define memcpy(to,from,len) something". */
+
+void *
+ffetarget_memcpy_ (void *dst, void *src, size_t len)
+{
+ return (void *) memcpy (dst, src, len);
+}
+
+/* ffetarget_num_digits_ -- Determine number of non-space characters in token
+
+ ffetarget_num_digits_(token);
+
+ All non-spaces are assumed to be binary, octal, or hex digits. */
+
+int
+ffetarget_num_digits_ (ffelexToken token)
+{
+ int i;
+ char *c;
+
+ switch (ffelex_token_type (token))
+ {
+ case FFELEX_typeNAME:
+ case FFELEX_typeNUMBER:
+ return ffelex_token_length (token);
+
+ case FFELEX_typeCHARACTER:
+ i = 0;
+ for (c = ffelex_token_text (token); *c != '\0'; ++c)
+ {
+ if (*c != ' ')
+ ++i;
+ }
+ return i;
+
+ default:
+ assert ("weird token" == NULL);
+ return 1;
+ }
+}
diff --git a/gcc/f/target.h b/gcc/f/target.h
new file mode 100644
index 00000000000..216d7704bd3
--- /dev/null
+++ b/gcc/f/target.h
@@ -0,0 +1,1865 @@
+/* target.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ target.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_target
+#define _H_f_target
+
+#ifdef FFE_STANDALONE
+#define HOST_WIDE_INT long
+#else
+#ifndef TREE_CODE
+#include "tree.j"
+#endif
+#endif
+
+/* For now, g77 requires the ability to determine the exact bit pattern
+ of a float on the target machine. (Hopefully this will be changed
+ soon). Make sure we can do this. */
+
+#if !defined (REAL_ARITHMETIC) \
+ && ((TARGET_FLOAT_FORMAT != HOST_FLOAT_FORMAT) \
+ || (FLOAT_WORDS_BIG_ENDIAN != HOST_FLOAT_WORDS_BIG_ENDIAN))
+#error "g77 requires ability to access exact FP representation of target machine"
+#endif
+
+/* Simple definitions and enumerations. */
+
+#define FFETARGET_charactersizeNONE (-1)
+#ifndef FFETARGET_charactersizeMAXIMUM
+#define FFETARGET_charactersizeMAXIMUM 2147483647
+#endif
+
+#ifndef FFETARGET_defaultIS_90
+#define FFETARGET_defaultIS_90 0
+#endif
+#ifndef FFETARGET_defaultIS_AUTOMATIC
+#define FFETARGET_defaultIS_AUTOMATIC 1
+#endif
+#ifndef FFETARGET_defaultIS_BACKSLASH
+#define FFETARGET_defaultIS_BACKSLASH 1
+#endif
+#ifndef FFETARGET_defaultIS_INIT_LOCAL_ZERO
+#define FFETARGET_defaultIS_INIT_LOCAL_ZERO 0
+#endif
+#ifndef FFETARGET_defaultIS_DOLLAR_OK
+#define FFETARGET_defaultIS_DOLLAR_OK 0
+#endif
+#ifndef FFETARGET_defaultIS_F2C
+#define FFETARGET_defaultIS_F2C 1
+#endif
+#ifndef FFETARGET_defaultIS_F2C_LIBRARY
+#define FFETARGET_defaultIS_F2C_LIBRARY 1
+#endif
+#ifndef FFETARGET_defaultIS_FREE_FORM
+#define FFETARGET_defaultIS_FREE_FORM 0
+#endif
+#ifndef FFETARGET_defaultIS_PEDANTIC
+#define FFETARGET_defaultIS_PEDANTIC 0
+#endif
+#ifndef FFETARGET_defaultCASE_INTRIN
+#define FFETARGET_defaultCASE_INTRIN FFE_caseLOWER
+#endif
+#ifndef FFETARGET_defaultCASE_MATCH
+#define FFETARGET_defaultCASE_MATCH FFE_caseLOWER
+#endif
+#ifndef FFETARGET_defaultCASE_SOURCE
+#define FFETARGET_defaultCASE_SOURCE FFE_caseLOWER
+#endif
+#ifndef FFETARGET_defaultCASE_SYMBOL
+#define FFETARGET_defaultCASE_SYMBOL FFE_caseNONE
+#endif
+
+#ifndef FFETARGET_defaultFIXED_LINE_LENGTH
+#define FFETARGET_defaultFIXED_LINE_LENGTH 72
+#endif
+
+/* 1 if external Fortran names ("FOO" in SUBROUTINE FOO, COMMON /FOO/,
+ and even enforced/default-for-unnamed PROGRAM, blank-COMMON, and
+ BLOCK DATA names, but not names of library functions implementing
+ intrinsics or names of local/internal variables) should have an
+ underscore appended (for compatibility with existing systems). */
+
+#ifndef FFETARGET_defaultEXTERNAL_UNDERSCORED
+#define FFETARGET_defaultEXTERNAL_UNDERSCORED 1
+#endif
+
+/* 1 if external Fortran names with underscores already in them should
+ have an extra underscore appended (in addition to the one they
+ might already have appened if FFETARGET_defaultEXTERNAL_UNDERSCORED). */
+
+#ifndef FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED
+#define FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED 1
+#endif
+
+/* If FFETARGET_defaultEXTERNAL_UNDERSCORED is 0, the following definitions
+ might also need to be overridden to make g77 objects compatible with
+ f2c+gcc objects. Although I don't think the unnamed BLOCK DATA one
+ is an issue at all. Of course, on some systems it isn't f2c
+ compatibility that is the issue -- maybe compatibility with some
+ other compiler(s). I don't know what to recommend for systems where
+ there is no existing Fortran compiler -- I suppose porting f2c and
+ pretending it's the existing one is best for now. */
+
+/* 1 if the "FOO" in "PROGRAM FOO" should be overridden and a particular
+ name imposed in place of it in the actual code (normally the case,
+ because the library's main entry point on most systems calls the main
+ function by a particular name). Someday g77 might do the f2c trick
+ of also outputting a "FOO" procedure that just calls the main procedure,
+ but that'll wait until somebody shows why it is needed. */
+
+#ifndef FFETARGET_isENFORCED_MAIN
+#define FFETARGET_isENFORCED_MAIN 1
+#endif
+
+/* The enforced name of the main program if ENFORCED_MAIN is 1. */
+
+#ifndef FFETARGET_nameENFORCED_MAIN_NAME
+#define FFETARGET_nameENFORCED_MAIN_NAME "MAIN__"
+#endif
+
+/* The name used for an unnamed main program if ENFORCED_MAIN is 0. */
+
+#ifndef FFETARGET_nameUNNAMED_MAIN
+#define FFETARGET_nameUNNAMED_MAIN "MAIN__"
+#endif
+
+/* The name used for an unnamed block data program. */
+
+#ifndef FFETARGET_nameUNNAMED_BLOCK_DATA
+#define FFETARGET_nameUNNAMED_BLOCK_DATA "_BLOCK_DATA__"
+#endif
+
+/* The name used for blank common. */
+
+#ifndef FFETARGET_nameBLANK_COMMON
+#define FFETARGET_nameBLANK_COMMON "_BLNK__"
+#endif
+
+#ifndef FFETARGET_integerSMALLEST_POSITIVE
+#define FFETARGET_integerSMALLEST_POSITIVE 0
+#endif
+#ifndef FFETARGET_integerLARGEST_POSITIVE
+#define FFETARGET_integerLARGEST_POSITIVE 2147483647
+#endif
+#ifndef FFETARGET_integerBIG_MAGICAL
+#define FFETARGET_integerBIG_MAGICAL 020000000000 /* 2147483648 */
+#endif
+#ifndef FFETARGET_integerALMOST_BIG_MAGICAL
+#define FFETARGET_integerALMOST_BIG_MAGICAL 214748364
+#endif
+#ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY
+#define FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY 0x80000000
+#endif
+#ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_HEX
+#define FFETARGET_integerALMOST_BIG_OVERFLOW_HEX 0x10000000
+#endif
+#ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL
+#define FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL 0x20000000
+#endif
+#ifndef FFETARGET_integerFINISH_BIG_MAGICAL
+#define FFETARGET_integerFINISH_BIG_MAGICAL 8
+#endif
+#ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY
+#define FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY 0
+#endif
+#ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_HEX
+#define FFETARGET_integerFINISH_BIG_OVERFLOW_HEX 0
+#endif
+#ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL
+#define FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL 0
+#endif
+
+#ifndef FFETARGET_offsetNONE
+#define FFETARGET_offsetNONE 0 /* Not used by FFE, for backend if needed. */
+#endif
+
+#define FFETARGET_okINTEGER1 1
+#define FFETARGET_okINTEGER2 1
+#define FFETARGET_okINTEGER3 1
+#define FFETARGET_okINTEGER4 1
+#define FFETARGET_okLOGICAL1 1
+#define FFETARGET_okLOGICAL2 1
+#define FFETARGET_okLOGICAL3 1
+#define FFETARGET_okLOGICAL4 1
+#define FFETARGET_okREAL1 1
+#define FFETARGET_okREAL2 1
+#define FFETARGET_okREAL3 0
+#define FFETARGET_okREALQUAD FFETARGET_okREAL3
+#define FFETARGET_okCOMPLEX1 1
+#define FFETARGET_okCOMPLEX2 1
+#define FFETARGET_okCOMPLEX3 0
+#define FFETARGET_okCOMPLEXDOUBLE FFETARGET_okCOMPLEX2
+#define FFETARGET_okCOMPLEXQUAD FFETARGET_okCOMPLEX3
+#define FFETARGET_okCHARACTER1 1
+
+#define FFETARGET_f2cTYUNKNOWN 0
+#define FFETARGET_f2cTYADDR 1
+#define FFETARGET_f2cTYSHORT 2
+#define FFETARGET_f2cTYLONG 3
+#define FFETARGET_f2cTYREAL 4
+#define FFETARGET_f2cTYDREAL 5
+#define FFETARGET_f2cTYCOMPLEX 6
+#define FFETARGET_f2cTYDCOMPLEX 7
+#define FFETARGET_f2cTYLOGICAL 8
+#define FFETARGET_f2cTYCHAR 9
+#define FFETARGET_f2cTYSUBR 10
+#define FFETARGET_f2cTYINT1 11
+#define FFETARGET_f2cTYLOGICAL1 12
+#define FFETARGET_f2cTYLOGICAL2 13
+#define FFETARGET_f2cTYQUAD 14
+
+/* Typedefs. */
+
+typedef unsigned char ffetargetAlign; /* ffetargetOffset for alignment. */
+#define ffetargetAlign_f ""
+typedef long ffetargetCharacterSize;
+#define ffetargetCharacterSize_f "l"
+typedef void (*ffetargetCopyfunc) (void *, void *, size_t);
+typedef ffetargetCharacterSize ffetargetHollerithSize;
+#define ffetargetHollerithSize_f "l"
+typedef long long ffetargetOffset;
+#define ffetargetOffset_f "ll"
+
+#if FFETARGET_okINTEGER1
+#ifndef __alpha__
+typedef long int ffetargetInteger1;
+#define ffetargetInteger1_f "l"
+#else
+typedef int ffetargetInteger1;
+#define ffetargetInteger1_f ""
+#endif
+#endif
+#if FFETARGET_okINTEGER2
+typedef signed char ffetargetInteger2;
+#define ffetargetInteger2_f ""
+#endif
+#if FFETARGET_okINTEGER3
+typedef short int ffetargetInteger3;
+#define ffetargetInteger3_f ""
+#endif
+#if FFETARGET_okINTEGER4
+typedef long long int ffetargetInteger4;
+#define ffetargetInteger4_f "ll"
+#endif
+#if FFETARGET_okINTEGER5
+typedef ? ffetargetInteger5;
+#define ffetargetInteger5_f
+?
+#endif
+#if FFETARGET_okINTEGER6
+typedef ? ffetargetInteger6;
+#define ffetargetInteger6_f
+?
+#endif
+#if FFETARGET_okINTEGER7
+typedef ? ffetargetInteger7;
+#define ffetargetInteger7_f
+?
+#endif
+#if FFETARGET_okINTEGER8
+typedef ? ffetargetInteger8;
+#define ffetargetInteger8_f
+?
+#endif
+#if FFETARGET_okLOGICAL1
+#ifndef __alpha__
+typedef long int ffetargetLogical1;
+#define ffetargetLogical1_f "l"
+#else
+typedef int ffetargetLogical1;
+#define ffetargetLogical1_f ""
+#endif
+#endif
+#if FFETARGET_okLOGICAL2
+typedef signed char ffetargetLogical2;
+#define ffetargetLogical2_f ""
+#endif
+#if FFETARGET_okLOGICAL3
+typedef short int ffetargetLogical3;
+#define ffetargetLogical3_f ""
+#endif
+#if FFETARGET_okLOGICAL4
+typedef long long int ffetargetLogical4;
+#define ffetargetLogical4_f "ll"
+#endif
+#if FFETARGET_okLOGICAL5
+typedef ? ffetargetLogical5;
+#define ffetargetLogical5_f
+?
+#endif
+#if FFETARGET_okLOGICAL6
+typedef ? ffetargetLogical6;
+#define ffetargetLogical6_f
+?
+#endif
+#if FFETARGET_okLOGICAL7
+typedef ? ffetargetLogical7;
+#define ffetargetLogical7_f
+?
+#endif
+#if FFETARGET_okLOGICAL8
+typedef ? ffetargetLogical8;
+#define ffetargetLogical8_f
+?
+#endif
+#if FFETARGET_okREAL1
+#ifdef REAL_ARITHMETIC
+#ifndef __alpha__
+typedef long int ffetargetReal1;
+#define ffetargetReal1_f "l"
+#define ffetarget_cvt_r1_to_rv_ REAL_VALUE_UNTO_TARGET_SINGLE
+#define ffetarget_cvt_rv_to_r1_ REAL_VALUE_TO_TARGET_SINGLE
+#else
+typedef int ffetargetReal1;
+#define ffetargetReal1_f ""
+#define ffetarget_cvt_r1_to_rv_(in) \
+ ({ REAL_VALUE_TYPE _rv; \
+ _rv = REAL_VALUE_UNTO_TARGET_SINGLE ((long) (in)); \
+ _rv; })
+#define ffetarget_cvt_rv_to_r1_(in, out) \
+ ({ long _tmp; \
+ REAL_VALUE_TO_TARGET_SINGLE ((in), _tmp); \
+ (out) = (ffetargetReal1) _tmp; })
+#endif
+#else /* REAL_ARITHMETIC */
+typedef float ffetargetReal1;
+#define ffetargetReal1_f ""
+#endif /* REAL_ARITHMETIC */
+#endif
+#if FFETARGET_okREAL2
+#ifdef REAL_ARITHMETIC
+#ifndef __alpha__
+typedef struct
+ {
+ long int v[2];
+ }
+ffetargetReal2;
+#define ffetargetReal2_f "l"
+#define ffetarget_cvt_r2_to_rv_ REAL_VALUE_UNTO_TARGET_DOUBLE
+#define ffetarget_cvt_rv_to_r2_ REAL_VALUE_TO_TARGET_DOUBLE
+#else
+typedef struct
+ {
+ int v[2];
+ }
+ffetargetReal2;
+#define ffetargetReal2_f ""
+#define ffetarget_cvt_r2_to_rv_(in) \
+ ({ REAL_VALUE_TYPE _rv; \
+ long _tmp[2]; \
+ _tmp[0] = (in)[0]; \
+ _tmp[1] = (in)[1]; \
+ _rv = REAL_VALUE_UNTO_TARGET_DOUBLE (_tmp); \
+ _rv; })
+#define ffetarget_cvt_rv_to_r2_(in, out) \
+ ({ long _tmp[2]; \
+ REAL_VALUE_TO_TARGET_DOUBLE ((in), _tmp); \
+ (out)[0] = (int) (_tmp[0]); \
+ (out)[1] = (int) (_tmp[1]); })
+#endif
+#else
+typedef double ffetargetReal2;
+#define ffetargetReal2_f ""
+#endif
+#endif
+#if FFETARGET_okREAL3
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal3[?];
+#else
+typedef ? ffetargetReal3;
+#define ffetargetReal3_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL4
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal4[?];
+#else
+typedef ? ffetargetReal4;
+#define ffetargetReal4_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL5
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal5[?];
+#else
+typedef ? ffetargetReal5;
+#define ffetargetReal5_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL6
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal6[?];
+#else
+typedef ? ffetargetReal6;
+#define ffetargetReal6_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL7
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal7[?];
+#else
+typedef ? ffetargetReal7;
+#define ffetargetReal7_f
+#endif
+?
+#endif
+#if FFETARGET_okREAL8
+#ifdef REAL_ARITHMETIC
+typedef long ffetargetReal8[?];
+#else
+typedef ? ffetargetReal8;
+#define ffetargetReal8_f
+#endif
+?
+#endif
+#if FFETARGET_okCOMPLEX1
+struct _ffetarget_complex_1_
+ {
+ ffetargetReal1 real;
+ ffetargetReal1 imaginary;
+ };
+typedef struct _ffetarget_complex_1_ ffetargetComplex1;
+#endif
+#if FFETARGET_okCOMPLEX2
+struct _ffetarget_complex_2_
+ {
+ ffetargetReal2 real;
+ ffetargetReal2 imaginary;
+ };
+typedef struct _ffetarget_complex_2_ ffetargetComplex2;
+#endif
+#if FFETARGET_okCOMPLEX3
+struct _ffetarget_complex_3_
+ {
+ ffetargetReal3 real;
+ ffetargetReal3 imaginary;
+ };
+typedef struct _ffetarget_complex_3_ ffetargetComplex3;
+#endif
+#if FFETARGET_okCOMPLEX4
+struct _ffetarget_complex_4_
+ {
+ ffetargetReal4 real;
+ ffetargetReal4 imaginary;
+ };
+typedef struct _ffetarget_complex_4_ ffetargetComplex4;
+#endif
+#if FFETARGET_okCOMPLEX5
+struct _ffetarget_complex_5_
+ {
+ ffetargetReal5 real;
+ ffetargetReal5 imaginary;
+ };
+typedef struct _ffetarget_complex_5_ ffetargetComplex5;
+#endif
+#if FFETARGET_okCOMPLEX6
+struct _ffetarget_complex_6_
+ {
+ ffetargetReal6 real;
+ ffetargetReal6 imaginary;
+ };
+typedef struct _ffetarget_complex_6_ ffetargetComplex6;
+#endif
+#if FFETARGET_okCOMPLEX7
+struct _ffetarget_complex_7_
+ {
+ ffetargetReal7 real;
+ ffetargetReal7 imaginary;
+ };
+typedef struct _ffetarget_complex_7_ ffetargetComplex7;
+#endif
+#if FFETARGET_okCOMPLEX8
+struct _ffetarget_complex_8_
+ {
+ ffetargetReal8 real;
+ ffetargetReal8 imaginary;
+ };
+typedef struct _ffetarget_complex_8_ ffetargetComplex8;
+#endif
+#if FFETARGET_okCHARACTER1
+struct _ffetarget_char_1_
+ {
+ ffetargetCharacterSize length;
+ unsigned char *text;
+ };
+typedef struct _ffetarget_char_1_ ffetargetCharacter1;
+typedef unsigned char ffetargetCharacterUnit1;
+#endif
+#if FFETARGET_okCHARACTER2
+typedef ? ffetargetCharacter2;
+typedef ? ffetargetCharacterUnit2;
+#endif
+#if FFETARGET_okCHARACTER3
+typedef ? ffetargetCharacter3;
+typedef ? ffetargetCharacterUnit3;
+#endif
+#if FFETARGET_okCHARACTER4
+typedef ? ffetargetCharacter4;
+typedef ? ffetargetCharacterUnit4;
+#endif
+#if FFETARGET_okCHARACTER5
+typedef ? ffetargetCharacter5;
+typedef ? ffetargetCharacterUnit5;
+#endif
+#if FFETARGET_okCHARACTER6
+typedef ? ffetargetCharacter6;
+typedef ? ffetargetCharacterUnit6;
+#endif
+#if FFETARGET_okCHARACTER7
+typedef ? ffetargetCharacter7;
+typedef ? ffetargetCharacterUnit7;
+#endif
+#if FFETARGET_okCHARACTER8
+typedef ? ffetargetCharacter8;
+typedef ? ffetargetCharacterUnit8;
+#endif
+
+typedef unsigned long long int ffetargetTypeless;
+
+struct _ffetarget_hollerith_
+ {
+ ffetargetHollerithSize length;
+ unsigned char *text;
+ };
+typedef struct _ffetarget_hollerith_ ffetargetHollerith;
+
+typedef ffetargetCharacter1 ffetargetCharacterDefault;
+typedef ffetargetComplex1 ffetargetComplexDefault;
+#if FFETARGET_okCOMPLEXDOUBLE
+typedef ffetargetComplex2 ffetargetComplexDouble;
+#endif
+#if FFETARGET_okCOMPLEXQUAD
+typedef ffetargetComplex3 ffetargetComplexQuad;
+#endif
+typedef ffetargetInteger1 ffetargetIntegerDefault;
+#define ffetargetIntegerDefault_f ffetargetInteger1_f
+typedef ffetargetLogical1 ffetargetLogicalDefault;
+#define ffetargetLogicalDefault_f ffetargetLogical1_f
+typedef ffetargetReal1 ffetargetRealDefault;
+#define ffetargetRealDefault_f ffetargetReal1_f
+typedef ffetargetReal2 ffetargetRealDouble;
+#define ffetargetRealDouble_f ffetargetReal2_f
+#if FFETARGET_okREALQUAD
+typedef ffetargetReal3 ffetargetRealQuad;
+#define ffetargetRealQuad_f ffetargetReal3_f
+#endif
+
+/* Include files needed by this one. */
+
+#include "bad.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+extern char ffetarget_string_[40]; /* Temp for ascii-to-double (atof). */
+extern HOST_WIDE_INT ffetarget_long_val_;
+extern HOST_WIDE_INT ffetarget_long_junk_;
+
+/* Declare functions with prototypes. */
+
+void ffetarget_aggregate_info (ffeinfoBasictype *ebt, ffeinfoKindtype *ekt,
+ ffetargetAlign *units, ffeinfoBasictype abt,
+ ffeinfoKindtype akt);
+ffetargetAlign ffetarget_align (ffetargetAlign *updated_alignment,
+ ffetargetAlign *updated_modulo,
+ ffetargetOffset offset,
+ ffetargetAlign alignment,
+ ffetargetAlign modulo);
+#if FFETARGET_okCHARACTER1
+bool ffetarget_character1 (ffetargetCharacter1 *val, ffelexToken character,
+ mallocPool pool);
+int ffetarget_cmp_character1 (ffetargetCharacter1 l, ffetargetCharacter1 r);
+ffebad ffetarget_concatenate_character1 (ffetargetCharacter1 *res,
+ ffetargetCharacter1 l,
+ ffetargetCharacter1 r,
+ mallocPool pool,
+ ffetargetCharacterSize *len);
+ffebad ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
+ ffetargetCharacterSize res_size,
+ ffetargetCharacter1 l,
+ mallocPool pool);
+ffebad ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
+ ffetargetCharacterSize res_size,
+ ffetargetHollerith l,
+ mallocPool pool);
+ffebad ffetarget_convert_character1_integer4 (ffetargetCharacter1 *res,
+ ffetargetCharacterSize res_size,
+ ffetargetInteger4 l,
+ mallocPool pool);
+ffebad ffetarget_convert_character1_logical4 (ffetargetCharacter1 *res,
+ ffetargetCharacterSize res_size,
+ ffetargetLogical4 l,
+ mallocPool pool);
+ffebad ffetarget_convert_character1_typeless (ffetargetCharacter1 *res,
+ ffetargetCharacterSize res_size,
+ ffetargetTypeless l,
+ mallocPool pool);
+ffebad ffetarget_eq_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r);
+ffebad ffetarget_le_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r);
+ffebad ffetarget_ge_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r);
+ffebad ffetarget_gt_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r);
+ffebad ffetarget_lt_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r);
+ffebad ffetarget_ne_character1 (bool *res, ffetargetCharacter1 l,
+ ffetargetCharacter1 r);
+ffebad ffetarget_substr_character1 (ffetargetCharacter1 *res,
+ ffetargetCharacter1 l,
+ ffetargetCharacterSize first,
+ ffetargetCharacterSize last,
+ mallocPool pool,
+ ffetargetCharacterSize *len);
+#endif
+int ffetarget_cmp_hollerith (ffetargetHollerith l, ffetargetHollerith r);
+bool ffetarget_hollerith (ffetargetHollerith *val, ffelexToken hollerith,
+ mallocPool pool);
+int ffetarget_cmp_typeless (ffetargetTypeless l, ffetargetTypeless r);
+ffebad ffetarget_convert_any_character1_ (char *res, size_t size,
+ ffetargetCharacter1 l);
+ffebad ffetarget_convert_any_hollerith_ (char *res, size_t size,
+ ffetargetHollerith l);
+ffebad ffetarget_convert_any_typeless_ (char *res, size_t size,
+ ffetargetTypeless l);
+#if FFETARGET_okCOMPLEX1
+ffebad ffetarget_divide_complex1 (ffetargetComplex1 *res, ffetargetComplex1 l,
+ ffetargetComplex1 r);
+#endif
+#if FFETARGET_okCOMPLEX2
+ffebad ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
+ ffetargetComplex2 r);
+#endif
+#if FFETARGET_okCOMPLEX3
+ffebad ffetarget_divide_complex3 (ffetargetComplex3 *res, ffetargetComplex3 l,
+ ffetargetComplex3 r);
+#endif
+#if FFETARGET_okCOMPLEX4
+ffebad ffetarget_divide_complex4 (ffetargetComplex4 *res, ffetargetComplex4 l,
+ ffetargetComplex4 r);
+#endif
+#if FFETARGET_okCOMPLEX5
+ffebad ffetarget_divide_complex5 (ffetargetComplex5 *res, ffetargetComplex5 l,
+ ffetargetComplex5 r);
+#endif
+#if FFETARGET_okCOMPLEX6
+ffebad ffetarget_divide_complex6 (ffetargetComplex6 *res, ffetargetComplex6 l,
+ ffetargetComplex6 r);
+#endif
+#if FFETARGET_okCOMPLEX7
+ffebad ffetarget_divide_complex7 (ffetargetComplex7 *res, ffetargetComplex7 l,
+ ffetargetComplex7 r);
+#endif
+#if FFETARGET_okCOMPLEX8
+ffebad ffetarget_divide_complex8 (ffetargetComplex8 *res, ffetargetComplex8 l,
+ ffetargetComplex8 r);
+#endif
+#if FFETARGET_okINTEGER1
+bool ffetarget_integer1 (ffetargetInteger1 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER2
+bool ffetarget_integer2 (ffetargetInteger2 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER3
+bool ffetarget_integer3 (ffetargetInteger3 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER4
+bool ffetarget_integer4 (ffetargetInteger4 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER5
+bool ffetarget_integer5 (ffetargetInteger5 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER6
+bool ffetarget_integer6 (ffetargetInteger6 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER7
+bool ffetarget_integer7 (ffetargetInteger7 *val, ffelexToken integer);
+#endif
+#if FFETARGET_okINTEGER8
+bool ffetarget_integer8 (ffetargetInteger8 *val, ffelexToken integer);
+#endif
+bool ffetarget_integerbinary (ffetargetIntegerDefault *val,
+ ffelexToken integer);
+bool ffetarget_integerhex (ffetargetIntegerDefault *val,
+ ffelexToken integer);
+bool ffetarget_integeroctal (ffetargetIntegerDefault *val,
+ ffelexToken integer);
+void ffetarget_integer_bad_magical (ffelexToken t);
+void ffetarget_integer_bad_magical_binary (ffelexToken integer, ffelexToken minus);
+void ffetarget_integer_bad_magical_precedence (ffelexToken integer,
+ ffelexToken uminus,
+ ffelexToken higher_op);
+void ffetarget_integer_bad_magical_precedence_binary (ffelexToken integer,
+ ffelexToken minus,
+ ffelexToken higher_op);
+#if FFETARGET_okCHARACTER1
+bool ffetarget_iszero_character1 (ffetargetCharacter1 constant);
+#endif
+bool ffetarget_iszero_hollerith (ffetargetHollerith constant);
+void ffetarget_layout (char *error_text, ffetargetAlign *alignment,
+ ffetargetAlign *modulo, ffetargetOffset *size,
+ ffeinfoBasictype bt, ffeinfoKindtype kt,
+ ffetargetCharacterSize charsize,
+ ffetargetIntegerDefault num_elements);
+#if FFETARGET_okCOMPLEX1
+ffebad ffetarget_multiply_complex1 (ffetargetComplex1 *res,
+ ffetargetComplex1 l,
+ ffetargetComplex1 r);
+#endif
+#if FFETARGET_okCOMPLEX2
+ffebad ffetarget_multiply_complex2 (ffetargetComplex2 *res,
+ ffetargetComplex2 l,
+ ffetargetComplex2 r);
+#endif
+#if FFETARGET_okCOMPLEX3
+ffebad ffetarget_multiply_complex3 (ffetargetComplex3 *res,
+ ffetargetComplex3 l,
+ ffetargetComplex3 r);
+#endif
+#if FFETARGET_okCOMPLEX4
+ffebad ffetarget_multiply_complex4 (ffetargetComplex4 *res,
+ ffetargetComplex4 l,
+ ffetargetComplex4 r);
+#endif
+#if FFETARGET_okCOMPLEX5
+ffebad ffetarget_multiply_complex5 (ffetargetComplex5 *res,
+ ffetargetComplex5 l,
+ ffetargetComplex5 r);
+#endif
+#if FFETARGET_okCOMPLEX6
+ffebad ffetarget_multiply_complex6 (ffetargetComplex6 *res,
+ ffetargetComplex6 l,
+ ffetargetComplex6 r);
+#endif
+#if FFETARGET_okCOMPLEX7
+ffebad ffetarget_multiply_complex7 (ffetargetComplex7 *res,
+ ffetargetComplex7 l,
+ ffetargetComplex7 r);
+#endif
+#if FFETARGET_okCOMPLEX8
+ffebad ffetarget_multiply_complex8 (ffetargetComplex8 *res,
+ ffetargetComplex8 l,
+ ffetargetComplex8 r);
+#endif
+ffebad ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault *res,
+ ffetargetComplexDefault l,
+ ffetargetIntegerDefault r);
+#if FFETARGET_okCOMPLEXDOUBLE
+ffebad ffetarget_power_complexdouble_integerdefault (ffetargetComplexDouble *res,
+ ffetargetComplexDouble l,
+ ffetargetIntegerDefault r);
+#endif
+ffebad ffetarget_power_integerdefault_integerdefault (ffetargetIntegerDefault *res,
+ ffetargetIntegerDefault l,
+ ffetargetIntegerDefault r);
+ffebad ffetarget_power_realdefault_integerdefault (ffetargetRealDefault *res,
+ ffetargetRealDefault l,
+ ffetargetIntegerDefault r);
+ffebad ffetarget_power_realdouble_integerdefault (ffetargetRealDouble *res,
+ ffetargetRealDouble l,
+ ffetargetIntegerDefault r);
+void ffetarget_print_binary (FILE *f, ffetargetTypeless val);
+void ffetarget_print_character1 (FILE *f, ffetargetCharacter1 val);
+void ffetarget_print_hollerith (FILE *f, ffetargetHollerith val);
+void ffetarget_print_octal (FILE *f, ffetargetTypeless val);
+void ffetarget_print_hex (FILE *f, ffetargetTypeless val);
+#if FFETARGET_okREAL1
+bool ffetarget_real1 (ffetargetReal1 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL2
+bool ffetarget_real2 (ffetargetReal2 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL3
+bool ffetarget_real3 (ffetargetReal3 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL4
+bool ffetarget_real4 (ffetargetReal4 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL5
+bool ffetarget_real5 (ffetargetReal5 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL6
+bool ffetarget_real6 (ffetargetReal6 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL7
+bool ffetarget_real7 (ffetargetReal7 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits);
+#endif
+#if FFETARGET_okREAL8
+bool ffetarget_real8 (ffetargetReal8 *value, ffelexToken integer,
+ ffelexToken decimal, ffelexToken fraction,
+ ffelexToken exponent, ffelexToken exponent_sign,
+ ffelexToken exponent_digits);
+#endif
+bool ffetarget_typeless_binary (ffetargetTypeless *value, ffelexToken token);
+bool ffetarget_typeless_octal (ffetargetTypeless *value, ffelexToken token);
+bool ffetarget_typeless_hex (ffetargetTypeless *value, ffelexToken token);
+void ffetarget_verify_character1 (mallocPool pool, ffetargetCharacter1 val);
+int ffetarget_num_digits_ (ffelexToken t);
+void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
+
+/* Define macros. */
+
+#if BUILT_FOR_280
+#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
+ REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0), ((kt == 1) ? SFmode : DFmode))
+#else
+#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
+ REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0))
+#endif
+
+#ifdef REAL_ARITHMETIC
+#define ffetarget_add_complex1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
+ li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
+ ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
+ REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
+ REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
+ ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
+ ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
+ FFEBAD; })
+#define ffetarget_add_complex2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
+ li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
+ ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
+ REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
+ REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
+ ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_add_complex1(res,l,r) \
+ ((res)->real = (l).real + (r).real, \
+ (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD)
+#define ffetarget_add_complex2(res,l,r) \
+ ((res)->real = (l).real + (r).real, \
+ (res)->imaginary = (l).imaginary + (r).imaginary, FFEBAD)
+#endif
+#define ffetarget_add_integer1(res,l,r) (*(res) = (l) + (r), FFEBAD)
+#define ffetarget_add_integer2(res,l,r) (*(res) = (l) + (r), FFEBAD)
+#define ffetarget_add_integer3(res,l,r) (*(res) = (l) + (r), FFEBAD)
+#define ffetarget_add_integer4(res,l,r) (*(res) = (l) + (r), FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_add_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr, resr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
+ ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
+ FFEBAD; })
+#define ffetarget_add_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr, resr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_add_real1(res,l,r) (*(res) = (l) + (r), FFEBAD)
+#define ffetarget_add_real2(res,l,r) (*(res) = (l) + (r), FFEBAD)
+#endif
+#define ffetarget_aggregate_ptr_memcpy(dbt,dkt,sbt,skt) \
+ ((ffetargetCopyfunc) ffetarget_memcpy_)
+#define ffetarget_and_integer1(res,l,r) (*(res) = (l) & (r), FFEBAD)
+#define ffetarget_and_integer2(res,l,r) (*(res) = (l) & (r), FFEBAD)
+#define ffetarget_and_integer3(res,l,r) (*(res) = (l) & (r), FFEBAD)
+#define ffetarget_and_integer4(res,l,r) (*(res) = (l) & (r), FFEBAD)
+#define ffetarget_and_logical1(res,l,r) (*(res) = (l) && (r), FFEBAD)
+#define ffetarget_and_logical2(res,l,r) (*(res) = (l) && (r), FFEBAD)
+#define ffetarget_and_logical3(res,l,r) (*(res) = (l) && (r), FFEBAD)
+#define ffetarget_and_logical4(res,l,r) (*(res) = (l) && (r), FFEBAD)
+#define ffetarget_binarymil(v,t) ffetarget_typeless_binary (v, t)
+#define ffetarget_binaryvxt(v,t) ffetarget_typeless_binary (v, t)
+#define ffetarget_cmp_integer1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
+#define ffetarget_cmp_integer2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
+#define ffetarget_cmp_integer3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
+#define ffetarget_cmp_integer4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
+#define ffetarget_cmp_logical1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
+#define ffetarget_cmp_logical2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
+#define ffetarget_cmp_logical3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
+#define ffetarget_cmp_logical4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
+#define ffetarget_cmp_real1(l,r) memcmp (&(l), &(r), sizeof(l))
+#define ffetarget_cmp_real2(l,r) memcmp (&(l), &(r), sizeof(l))
+#define ffetarget_cmp_real3(l,r) memcmp (&(l), &(r), sizeof(l))
+#define ffetarget_cmp_typeless(l,r) \
+ memcmp (&(l), &(r), sizeof ((l)))
+#define ffetarget_convert_character1_integer1(res,res_size,l,pool) \
+ ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
+#define ffetarget_convert_character1_integer2(res,res_size,l,pool) \
+ ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
+#define ffetarget_convert_character1_integer3(res,res_size,l,pool) \
+ ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
+#define ffetarget_convert_character1_logical1(res,res_size,l,pool) \
+ ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
+#define ffetarget_convert_character1_logical2(res,res_size,l,pool) \
+ ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
+#define ffetarget_convert_character1_logical3(res,res_size,l,pool) \
+ ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
+#define ffetarget_convert_complex1_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_complex1_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_complex1_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_complex1_complex2(res,l) \
+ ({ REAL_VALUE_TYPE lr, li; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
+ li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
+ ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
+ ffetarget_cvt_rv_to_r1_ (li, (res)->imaginary), \
+ FFEBAD; })
+#else
+#define ffetarget_convert_complex1_complex2(res,l) \
+ ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_complex1_integer(res,l) \
+ ({ REAL_VALUE_TYPE resi, resr; \
+ ffetargetInteger1 lf = (l); \
+ FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
+ resi = dconst0; \
+ ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
+ ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
+ FFEBAD; })
+#else
+#define ffetarget_convert_complex1_integer(res,l) \
+ ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#endif
+#define ffetarget_convert_complex1_integer1 ffetarget_convert_complex1_integer
+#define ffetarget_convert_complex1_integer2 ffetarget_convert_complex1_integer
+#define ffetarget_convert_complex1_integer3 ffetarget_convert_complex1_integer
+#define ffetarget_convert_complex1_integer4 ffetarget_convert_complex1_integer
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_complex1_real1(res,l) \
+ ((res)->real = (l), \
+ ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
+ FFEBAD)
+#define ffetarget_convert_complex1_real2(res,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
+ ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
+ FFEBAD; })
+#else
+#define ffetarget_convert_complex1_real1(res,l) \
+ ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#define ffetarget_convert_complex1_real2(res,l) \
+ ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#endif
+#define ffetarget_convert_complex2_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_complex2_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_complex2_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_complex2_complex1(res,l) \
+ ({ REAL_VALUE_TYPE lr, li; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
+ li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
+ ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
+ ffetarget_cvt_rv_to_r2_ (li, &((res)->imaginary.v[0])), \
+ FFEBAD; })
+#else
+#define ffetarget_convert_complex2_complex1(res,l) \
+ ((res)->real = (l).real, (res)->imaginary = (l).imaginary, FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_complex2_integer(res,l) \
+ ({ REAL_VALUE_TYPE resi, resr; \
+ ffetargetInteger1 lf = (l); \
+ FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
+ resi = dconst0; \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
+ ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_convert_complex2_integer(res,l) \
+ ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#endif
+#define ffetarget_convert_complex2_integer1 ffetarget_convert_complex2_integer
+#define ffetarget_convert_complex2_integer2 ffetarget_convert_complex2_integer
+#define ffetarget_convert_complex2_integer3 ffetarget_convert_complex2_integer
+#define ffetarget_convert_complex2_integer4 ffetarget_convert_complex2_integer
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_complex2_real1(res,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r1_to_rv_ (l); \
+ ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
+ ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
+ FFEBAD; })
+#define ffetarget_convert_complex2_real2(res,l) \
+ ((res)->real = (l), \
+ ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
+ FFEBAD)
+#else
+#define ffetarget_convert_complex2_real1(res,l) \
+ ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#define ffetarget_convert_complex2_real2(res,l) \
+ ((res)->real = (l), (res)->imaginary = 0, FFEBAD)
+#endif
+#define ffetarget_convert_integer2_character1(res,l) \
+ ffetarget_convert_integer1_character1(res,l)
+#define ffetarget_convert_integer2_complex1(res,l) \
+ ffetarget_convert_integer1_complex1(res,l)
+#define ffetarget_convert_integer2_complex2(res,l) \
+ ffetarget_convert_integer1_complex2(res,l)
+#define ffetarget_convert_integer2_hollerith(res,l) \
+ ffetarget_convert_integer1_hollerith(res,l)
+#define ffetarget_convert_integer2_integer1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer2_integer3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer2_integer4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer2_logical1(res,l) \
+ ffetarget_convert_integer1_logical1(res,l)
+#define ffetarget_convert_integer2_logical2(res,l) \
+ ffetarget_convert_integer2_logical1(res,l)
+#define ffetarget_convert_integer2_logical3(res,l) \
+ ffetarget_convert_integer2_logical1(res,l)
+#define ffetarget_convert_integer2_logical4(res,l) \
+ ffetarget_convert_integer2_logical1(res,l)
+#define ffetarget_convert_integer2_real1(res,l) \
+ ffetarget_convert_integer1_real1(res,l)
+#define ffetarget_convert_integer2_real2(res,l) \
+ ffetarget_convert_integer1_real2(res,l)
+#define ffetarget_convert_integer2_typeless(res,l) \
+ ffetarget_convert_integer1_typeless(res,l)
+#define ffetarget_convert_integer3_character1(res,l) \
+ ffetarget_convert_integer1_character1(res,l)
+#define ffetarget_convert_integer3_complex1(res,l) \
+ ffetarget_convert_integer1_complex1(res,l)
+#define ffetarget_convert_integer3_complex2(res,l) \
+ ffetarget_convert_integer1_complex2(res,l)
+#define ffetarget_convert_integer3_hollerith(res,l) \
+ ffetarget_convert_integer1_hollerith(res,l)
+#define ffetarget_convert_integer3_integer1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer3_integer2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer3_integer4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer3_logical1(res,l) \
+ ffetarget_convert_integer1_logical1(res,l)
+#define ffetarget_convert_integer3_logical2(res,l) \
+ ffetarget_convert_integer3_logical1(res,l)
+#define ffetarget_convert_integer3_logical3(res,l) \
+ ffetarget_convert_integer3_logical1(res,l)
+#define ffetarget_convert_integer3_logical4(res,l) \
+ ffetarget_convert_integer3_logical1(res,l)
+#define ffetarget_convert_integer3_real1(res,l) \
+ ffetarget_convert_integer1_real1(res,l)
+#define ffetarget_convert_integer3_real2(res,l) \
+ ffetarget_convert_integer1_real2(res,l)
+#define ffetarget_convert_integer3_typeless(res,l) \
+ ffetarget_convert_integer1_typeless(res,l)
+#define ffetarget_convert_integer4_character1(res,l) \
+ ffetarget_convert_integer1_character1(res,l)
+#define ffetarget_convert_integer4_complex1(res,l) \
+ ffetarget_convert_integer1_complex1(res,l)
+#define ffetarget_convert_integer4_complex2(res,l) \
+ ffetarget_convert_integer1_complex2(res,l)
+#define ffetarget_convert_integer4_hollerith(res,l) \
+ ffetarget_convert_integer1_hollerith(res,l)
+#define ffetarget_convert_integer4_integer1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer4_integer2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer4_integer3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer4_logical1(res,l) \
+ ffetarget_convert_integer1_logical1(res,l)
+#define ffetarget_convert_integer4_logical2(res,l) \
+ ffetarget_convert_integer1_logical1(res,l)
+#define ffetarget_convert_integer4_logical3(res,l) \
+ ffetarget_convert_integer1_logical1(res,l)
+#define ffetarget_convert_integer4_logical4(res,l) \
+ ffetarget_convert_integer1_logical1(res,l)
+#define ffetarget_convert_integer4_real1(res,l) \
+ ffetarget_convert_integer1_real1(res,l)
+#define ffetarget_convert_integer4_real2(res,l) \
+ ffetarget_convert_integer1_real2(res,l)
+#define ffetarget_convert_integer4_typeless(res,l) \
+ ffetarget_convert_integer1_typeless(res,l)
+#define ffetarget_convert_logical1_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical1_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical1_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical1_logical2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical1_logical3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical1_logical4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical1_integer1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical1_integer2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical1_integer3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical1_integer4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical2_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical2_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical2_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical2_logical1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical2_logical3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical2_logical4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical2_integer1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical2_integer2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical2_integer3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical2_integer4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical3_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical3_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical3_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical3_logical1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical3_logical2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical3_logical4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical3_integer1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical3_integer2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical3_integer3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical3_integer4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical4_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical4_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical4_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_logical4_logical1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical4_logical2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical4_logical3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical4_integer1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical4_integer2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical4_integer3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_logical4_integer4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_integer1_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_integer1_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_integer1_integer2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_integer3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_integer4(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_logical1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_logical2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_logical3(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_logical4(res,l) (*(res) = (l), FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_integer1_real1(res,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r1_to_rv_ (l); \
+ REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
+ *(res) = ffetarget_long_val_; \
+ FFEBAD; })
+#define ffetarget_convert_integer1_real2(res,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
+ *(res) = ffetarget_long_val_; \
+ FFEBAD; })
+#define ffetarget_convert_integer1_complex1(res,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
+ REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
+ *(res) = ffetarget_long_val_; \
+ FFEBAD; })
+#define ffetarget_convert_integer1_complex2(res,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
+ REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
+ *(res) = ffetarget_long_val_; \
+ FFEBAD; })
+#else
+#define ffetarget_convert_integer1_real1(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_real2(res,l) (*(res) = (l), FFEBAD)
+#define ffetarget_convert_integer1_complex1(res,l) (*(res) = (l).real, FFEBAD)
+#define ffetarget_convert_integer1_complex2(res,l) (*(res) = (l).real, FFEBAD)
+#endif
+#define ffetarget_convert_real1_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_real1_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_real1_integer2(res,l) \
+ ffetarget_convert_real1_integer1(res,l)
+#define ffetarget_convert_real1_integer3(res,l) \
+ ffetarget_convert_real1_integer1(res,l)
+#define ffetarget_convert_real1_integer4(res,l) \
+ ffetarget_convert_real1_integer1(res,l)
+#define ffetarget_convert_real1_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_real1_complex1(res,l) (*(res) = (l).real, FFEBAD)
+#define ffetarget_convert_real1_complex2(res,l) \
+ ffetarget_convert_real1_real2 ((res), (l).real)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_real1_integer1(res,l) \
+ ({ REAL_VALUE_TYPE resr; \
+ ffetargetInteger1 lf = (l); \
+ FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
+ ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
+ FFEBAD; })
+#else
+#define ffetarget_convert_real1_integer1(res,l) (*(res) = (l), FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_real1_real2(res,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ ffetarget_cvt_rv_to_r1_ (lr, *(res)); \
+ FFEBAD; })
+#else
+#define ffetarget_convert_real1_real2(res,l) (*(res) = (l), FFEBAD)
+#endif
+#define ffetarget_convert_real2_character1(res,l) \
+ ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_real2_hollerith(res,l) \
+ ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_real2_integer2(res,l) \
+ ffetarget_convert_real2_integer1(res,l)
+#define ffetarget_convert_real2_integer3(res,l) \
+ ffetarget_convert_real2_integer1(res,l)
+#define ffetarget_convert_real2_integer4(res,l) \
+ ffetarget_convert_real2_integer1(res,l)
+#define ffetarget_convert_real2_typeless(res,l) \
+ ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
+#define ffetarget_convert_real2_complex1(res,l) \
+ ffetarget_convert_real2_real1 ((res), (l).real)
+#define ffetarget_convert_real2_complex2(res,l) (*(res) = (l).real, FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_real2_integer(res,l) \
+ ({ REAL_VALUE_TYPE resr; \
+ ffetargetInteger1 lf = (l); \
+ FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
+ FFEBAD; })
+#define ffetarget_convert_real2_integer1 ffetarget_convert_real2_integer
+#else
+#define ffetarget_convert_real2_integer1(res,l) (*(res) = (l), FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_convert_real2_real1(res,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ ffetarget_cvt_rv_to_r2_ (lr, &((res)->v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_convert_real2_real1(res,l) (*(res) = (l), FFEBAD)
+#endif
+#define ffetarget_divide_integer1(res,l,r) \
+ (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
+ : (*(res) = (l) / (r), FFEBAD))
+#define ffetarget_divide_integer2(res,l,r) \
+ ffetarget_divide_integer1(res,l,r)
+#define ffetarget_divide_integer3(res,l,r) \
+ ffetarget_divide_integer1(res,l,r)
+#define ffetarget_divide_integer4(res,l,r) \
+ ffetarget_divide_integer1(res,l,r)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_divide_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr, resr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ REAL_VALUES_EQUAL (rr, dconst0) \
+ ? ({ ffetarget_cvt_rv_to_r1_ (dconst0, *(res)); \
+ FFEBAD_DIV_BY_ZERO; \
+ }) \
+ : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
+ ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
+ FFEBAD; \
+ }); \
+ })
+#define ffetarget_divide_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr, resr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ REAL_VALUES_EQUAL (rr, dconst0) \
+ ? ({ ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0])); \
+ FFEBAD_DIV_BY_ZERO; \
+ }) \
+ : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
+ FFEBAD; \
+ }); \
+ })
+#else
+#define ffetarget_divide_real1(res,l,r) \
+ (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
+ : (*(res) = (l) / (r), FFEBAD))
+#define ffetarget_divide_real2(res,l,r) \
+ (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO) \
+ : (*(res) = (l) / (r), FFEBAD))
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_eq_complex1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, li, rr, ri; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
+ li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
+ ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
+ *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
+ ? TRUE : FALSE; \
+ FFEBAD; })
+#define ffetarget_eq_complex2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, li, rr, ri; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
+ li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
+ ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
+ *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
+ ? TRUE : FALSE; \
+ FFEBAD; })
+#else
+#define ffetarget_eq_complex1(res,l,r) \
+ (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary)) \
+ ? TRUE : FALSE, FFEBAD)
+#define ffetarget_eq_complex2(res,l,r) \
+ (*(res) = (((l).real == (r).real) && ((l).imaginary == (r).imaginary)) \
+ ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_eq_integer1(res,l,r) \
+ (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_eq_integer2(res,l,r) \
+ (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_eq_integer3(res,l,r) \
+ (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_eq_integer4(res,l,r) \
+ (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_eq_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
+ FFEBAD; })
+#define ffetarget_eq_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
+ FFEBAD; })
+#else
+#define ffetarget_eq_real1(res,l,r) \
+ (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_eq_real2(res,l,r) \
+ (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_eqv_integer1(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
+#define ffetarget_eqv_integer2(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
+#define ffetarget_eqv_integer3(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
+#define ffetarget_eqv_integer4(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
+#define ffetarget_eqv_logical1(res,l,r) (*(res) = (l) == (r), FFEBAD)
+#define ffetarget_eqv_logical2(res,l,r) (*(res) = (l) == (r), FFEBAD)
+#define ffetarget_eqv_logical3(res,l,r) (*(res) = (l) == (r), FFEBAD)
+#define ffetarget_eqv_logical4(res,l,r) (*(res) = (l) == (r), FFEBAD)
+#define ffetarget_ge_integer1(res,l,r) \
+ (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ge_integer2(res,l,r) \
+ (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ge_integer3(res,l,r) \
+ (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ge_integer4(res,l,r) \
+ (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_ge_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
+ FFEBAD; })
+#define ffetarget_ge_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
+ FFEBAD; })
+#else
+#define ffetarget_ge_real1(res,l,r) \
+ (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ge_real2(res,l,r) \
+ (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_gt_integer1(res,l,r) \
+ (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_gt_integer2(res,l,r) \
+ (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_gt_integer3(res,l,r) \
+ (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_gt_integer4(res,l,r) \
+ (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_gt_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
+ ? FALSE : TRUE; \
+ FFEBAD; })
+#define ffetarget_gt_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
+ ? FALSE : TRUE; \
+ FFEBAD; })
+#else
+#define ffetarget_gt_real1(res,l,r) \
+ (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_gt_real2(res,l,r) \
+ (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_hexxmil(v,t) ffetarget_typeless_hex (v, t)
+#define ffetarget_hexxvxt(v,t) ffetarget_typeless_hex (v, t)
+#define ffetarget_hexzmil(v,t) ffetarget_typeless_hex (v, t)
+#define ffetarget_hexzvxt(v,t) ffetarget_typeless_hex (v, t)
+#define ffetarget_init_0()
+#define ffetarget_init_1()
+#define ffetarget_init_2()
+#define ffetarget_init_3()
+#define ffetarget_init_4()
+#ifndef __alpha__
+#define ffetarget_integerdefault_is_magical(i) \
+ (((unsigned long int) i) == FFETARGET_integerBIG_MAGICAL)
+#else
+#define ffetarget_integerdefault_is_magical(i) \
+ (((unsigned int) i) == FFETARGET_integerBIG_MAGICAL)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_iszero_real1(l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ REAL_VALUES_EQUAL (lr, dconst0); \
+ })
+#define ffetarget_iszero_real2(l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ REAL_VALUES_EQUAL (lr, dconst0); \
+ })
+#else
+#define ffetarget_iszero_real1(l) ((l) == 0.)
+#define ffetarget_iszero_real2(l) ((l) == 0.)
+#endif
+#define ffetarget_iszero_typeless(l) ((l) == 0)
+#define ffetarget_logical1(v,truth) (*(v) = truth ? 1 : 0)
+#define ffetarget_le_integer1(res,l,r) \
+ (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_le_integer2(res,l,r) \
+ (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_le_integer3(res,l,r) \
+ (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_le_integer4(res,l,r) \
+ (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_le_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
+ ? TRUE : FALSE; \
+ FFEBAD; })
+#define ffetarget_le_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
+ ? TRUE : FALSE; \
+ FFEBAD; })
+#else
+#define ffetarget_le_real1(res,l,r) \
+ (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_le_real2(res,l,r) \
+ (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_lt_integer1(res,l,r) \
+ (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_lt_integer2(res,l,r) \
+ (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_lt_integer3(res,l,r) \
+ (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_lt_integer4(res,l,r) \
+ (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_lt_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
+ FFEBAD; })
+#define ffetarget_lt_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
+ FFEBAD; })
+#else
+#define ffetarget_lt_real1(res,l,r) \
+ (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_lt_real2(res,l,r) \
+ (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_length_character1(c) ((c).length)
+#define ffetarget_length_characterdefault ffetarget_length_character1
+#ifdef REAL_ARITHMETIC
+#define ffetarget_make_real1(res,lr) \
+ ffetarget_cvt_rv_to_r1_ ((lr), *(res))
+#define ffetarget_make_real2(res,lr) \
+ ffetarget_cvt_rv_to_r2_ ((lr), &((res)->v[0]))
+#else
+#define ffetarget_make_real1(res,lr) (*(res) = (lr))
+#define ffetarget_make_real2(res,lr) (*(res) = (lr))
+#endif
+#define ffetarget_multiply_integer1(res,l,r) (*(res) = (l) * (r), FFEBAD)
+#define ffetarget_multiply_integer2(res,l,r) (*(res) = (l) * (r), FFEBAD)
+#define ffetarget_multiply_integer3(res,l,r) (*(res) = (l) * (r), FFEBAD)
+#define ffetarget_multiply_integer4(res,l,r) (*(res) = (l) * (r), FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_multiply_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr, resr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
+ ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
+ FFEBAD; })
+#define ffetarget_multiply_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr, resr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_multiply_real1(res,l,r) (*(res) = (l) * (r), FFEBAD)
+#define ffetarget_multiply_real2(res,l,r) (*(res) = (l) * (r), FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_ne_complex1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, li, rr, ri; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
+ li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
+ ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
+ *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
+ ? FALSE : TRUE; \
+ FFEBAD; })
+#define ffetarget_ne_complex2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, li, rr, ri; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
+ li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
+ ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
+ *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
+ ? FALSE : TRUE; \
+ FFEBAD; })
+#else
+#define ffetarget_ne_complex1(res,l,r) \
+ (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary)) \
+ ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ne_complex2(res,l,r) \
+ (*(res) = (((l).real != (r).real) || ((l).imaginary != (r).imaginary)) \
+ ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_ne_integer1(res,l,r) \
+ (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ne_integer2(res,l,r) \
+ (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ne_integer3(res,l,r) \
+ (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ne_integer4(res,l,r) \
+ (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_ne_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
+ FFEBAD; })
+#define ffetarget_ne_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
+ FFEBAD; })
+#else
+#define ffetarget_ne_real1(res,l,r) \
+ (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
+#define ffetarget_ne_real2(res,l,r) \
+ (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
+#endif
+#define ffetarget_neqv_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
+#define ffetarget_neqv_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
+#define ffetarget_neqv_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
+#define ffetarget_neqv_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
+#define ffetarget_neqv_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
+#define ffetarget_neqv_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
+#define ffetarget_neqv_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
+#define ffetarget_neqv_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
+#define ffetarget_not_integer1(res,l) (*(res) = ~(l), FFEBAD)
+#define ffetarget_not_integer2(res,l) (*(res) = ~(l), FFEBAD)
+#define ffetarget_not_integer3(res,l) (*(res) = ~(l), FFEBAD)
+#define ffetarget_not_integer4(res,l) (*(res) = ~(l), FFEBAD)
+#define ffetarget_not_logical1(res,l) (*(res) = !(l), FFEBAD)
+#define ffetarget_not_logical2(res,l) (*(res) = !(l), FFEBAD)
+#define ffetarget_not_logical3(res,l) (*(res) = !(l), FFEBAD)
+#define ffetarget_not_logical4(res,l) (*(res) = !(l), FFEBAD)
+#define ffetarget_octalmil(v,t) ffetarget_typeless_octal (v, t)
+#define ffetarget_octalvxt(v,t) ffetarget_typeless_octal (v, t)
+#define ffetarget_offset(res,l) (*(res) = (l), TRUE) /* Overflow? */
+#define ffetarget_offset_add(res,l,r) (*(res) = (l) + (r), TRUE) /* Overflow? */
+#define ffetarget_offset_charsize(res,l,u) (*(res) = (l) * (u), TRUE) /* Ov? */
+#define ffetarget_offset_multiply(res,l,r) (*(res) = (l) * (r), TRUE) /* Ov? */
+#define ffetarget_offset_overflow(text) ((void) 0) /* ~~no message? */
+#define ffetarget_or_integer1(res,l,r) (*(res) = (l) | (r), FFEBAD)
+#define ffetarget_or_integer2(res,l,r) (*(res) = (l) | (r), FFEBAD)
+#define ffetarget_or_integer3(res,l,r) (*(res) = (l) | (r), FFEBAD)
+#define ffetarget_or_integer4(res,l,r) (*(res) = (l) | (r), FFEBAD)
+#define ffetarget_or_logical1(res,l,r) (*(res) = (l) || (r), FFEBAD)
+#define ffetarget_or_logical2(res,l,r) (*(res) = (l) || (r), FFEBAD)
+#define ffetarget_or_logical3(res,l,r) (*(res) = (l) || (r), FFEBAD)
+#define ffetarget_or_logical4(res,l,r) (*(res) = (l) || (r), FFEBAD)
+#define ffetarget_print_binarymil(f,v) ffetarget_print_binary (f, v)
+#define ffetarget_print_binaryvxt(f,v) ffetarget_print_binary (f, v)
+#define ffetarget_print_hexxmil(f,v) ffetarget_print_hex (f, v)
+#define ffetarget_print_hexxvxt(f,v) ffetarget_print_hex (f, v)
+#define ffetarget_print_hexzmil(f,v) ffetarget_print_hex (f, v)
+#define ffetarget_print_hexzvxt(f,v) ffetarget_print_hex (f, v)
+#define ffetarget_print_integer1(f,v) \
+ fprintf ((f), "%" ffetargetInteger1_f "d", (v))
+#define ffetarget_print_integer2(f,v) \
+ fprintf ((f), "%" ffetargetInteger2_f "d", (v))
+#define ffetarget_print_integer3(f,v) \
+ fprintf ((f), "%" ffetargetInteger3_f "d", (v))
+#define ffetarget_print_integer4(f,v) \
+ fprintf ((f), "%" ffetargetInteger4_f "d", (v))
+#define ffetarget_print_logical1(f,v) \
+ fprintf ((f), "%" ffetargetLogical1_f "d", (v))
+#define ffetarget_print_logical2(f,v) \
+ fprintf ((f), "%" ffetargetLogical2_f "d", (v))
+#define ffetarget_print_logical3(f,v) \
+ fprintf ((f), "%" ffetargetLogical3_f "d", (v))
+#define ffetarget_print_logical4(f,v) \
+ fprintf ((f), "%" ffetargetLogical4_f "d", (v))
+#define ffetarget_print_octalmil(f,v) ffetarget_print_octal(f,v)
+#define ffetarget_print_octalvxt(f,v) ffetarget_print_octal(f,v)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_print_real1(f,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \
+ fputs (ffetarget_string_, (f)); \
+ })
+#define ffetarget_print_real2(f,l) \
+ ({ REAL_VALUE_TYPE lr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ REAL_VALUE_TO_DECIMAL (lr, bad_fmt_val??, ffetarget_string_); \
+ fputs (ffetarget_string_, (f)); \
+ })
+#else
+#define ffetarget_print_real1(f,v) \
+ fprintf ((f), "%" ffetargetReal1_f "g", (v))
+#define ffetarget_print_real2(f,v) \
+ fprintf ((f), "%" ffetargetReal2_f "g", (v))
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_real1_one(res) ffetarget_cvt_rv_to_r1_ (dconst1, *(res))
+#define ffetarget_real2_one(res) ffetarget_cvt_rv_to_r2_ (dconst1, &((res)->v[0]))
+#else
+#define ffetarget_real1_one(res) (*(res) = (float) 1.)
+#define ffetarget_real2_one(res) (*(res) = 1.)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_real1_two(res) ffetarget_cvt_rv_to_r1_ (dconst2, *(res))
+#define ffetarget_real2_two(res) ffetarget_cvt_rv_to_r2_ (dconst2, &((res)->v[0]))
+#else
+#define ffetarget_real1_two(res) (*(res) = (float) 2.)
+#define ffetarget_real2_two(res) (*(res) = 2.)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_real1_zero(res) ffetarget_cvt_rv_to_r1_ (dconst0, *(res))
+#define ffetarget_real2_zero(res) ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0]))
+#else
+#define ffetarget_real1_zero(res) (*(res) = (float) 0.)
+#define ffetarget_real2_zero(res) (*(res) = 0.)
+#endif
+#define ffetarget_size_typeless_binary(t) ((ffetarget_num_digits_(t) + 7) / 8)
+#define ffetarget_size_typeless_octal(t) \
+ ((ffetarget_num_digits_(t) * 3 + 7) / 8)
+#define ffetarget_size_typeless_hex(t) ((ffetarget_num_digits_(t) + 1) / 2)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_subtract_complex1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
+ li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
+ ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
+ REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
+ REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
+ ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
+ ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
+ FFEBAD; })
+#define ffetarget_subtract_complex2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
+ li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
+ ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
+ REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
+ REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
+ ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_subtract_complex1(res,l,r) \
+ ((res)->real = (l).real - (r).real, \
+ (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD)
+#define ffetarget_subtract_complex2(res,l,r) \
+ ((res)->real = (l).real - (r).real, \
+ (res)->imaginary = (l).imaginary - (r).imaginary, FFEBAD)
+#endif
+#define ffetarget_subtract_integer1(res,l,r) (*(res) = (l) - (r), FFEBAD)
+#define ffetarget_subtract_integer2(res,l,r) (*(res) = (l) - (r), FFEBAD)
+#define ffetarget_subtract_integer3(res,l,r) (*(res) = (l) - (r), FFEBAD)
+#define ffetarget_subtract_integer4(res,l,r) (*(res) = (l) - (r), FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_subtract_real1(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr, resr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ rr = ffetarget_cvt_r1_to_rv_ ((r)); \
+ REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
+ ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
+ FFEBAD; })
+#define ffetarget_subtract_real2(res,l,r) \
+ ({ REAL_VALUE_TYPE lr, rr, resr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
+ REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_subtract_real1(res,l,r) (*(res) = (l) - (r), FFEBAD)
+#define ffetarget_subtract_real2(res,l,r) (*(res) = (l) - (r), FFEBAD)
+#endif
+#define ffetarget_terminate_0()
+#define ffetarget_terminate_1()
+#define ffetarget_terminate_2()
+#define ffetarget_terminate_3()
+#define ffetarget_terminate_4()
+#define ffetarget_text_character1(c) ((c).text)
+#define ffetarget_text_characterdefault ffetarget_text_character1
+#ifdef REAL_ARITHMETIC
+#define ffetarget_uminus_complex1(res,l) \
+ ({ REAL_VALUE_TYPE lr, li, resr, resi; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
+ li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
+ resr = REAL_VALUE_NEGATE (lr); \
+ resi = REAL_VALUE_NEGATE (li); \
+ ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
+ ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
+ FFEBAD; })
+#define ffetarget_uminus_complex2(res,l) \
+ ({ REAL_VALUE_TYPE lr, li, resr, resi; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
+ li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
+ resr = REAL_VALUE_NEGATE (lr); \
+ resi = REAL_VALUE_NEGATE (li); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
+ ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_uminus_complex1(res,l) \
+ ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD)
+#define ffetarget_uminus_complex2(res,l) \
+ ((res)->real = -(l).real, (res)->imaginary = -(l).imaginary, FFEBAD)
+#endif
+#define ffetarget_uminus_integer1(res,l) (*(res) = -(l), FFEBAD)
+#define ffetarget_uminus_integer2(res,l) (*(res) = -(l), FFEBAD)
+#define ffetarget_uminus_integer3(res,l) (*(res) = -(l), FFEBAD)
+#define ffetarget_uminus_integer4(res,l) (*(res) = -(l), FFEBAD)
+#ifdef REAL_ARITHMETIC
+#define ffetarget_uminus_real1(res,l) \
+ ({ REAL_VALUE_TYPE lr, resr; \
+ lr = ffetarget_cvt_r1_to_rv_ ((l)); \
+ resr = REAL_VALUE_NEGATE (lr); \
+ ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
+ FFEBAD; })
+#define ffetarget_uminus_real2(res,l) \
+ ({ REAL_VALUE_TYPE lr, resr; \
+ lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+ resr = REAL_VALUE_NEGATE (lr); \
+ ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
+ FFEBAD; })
+#else
+#define ffetarget_uminus_real1(res,l) (*(res) = -(l), FFEBAD)
+#define ffetarget_uminus_real2(res,l) (*(res) = -(l), FFEBAD)
+#endif
+#ifdef REAL_ARITHMETIC
+#define ffetarget_value_real1(lr) ffetarget_cvt_r1_to_rv_ ((lr))
+#define ffetarget_value_real2(lr) ffetarget_cvt_r2_to_rv_ (&((lr).v[0]))
+#else
+#define ffetarget_value_real1
+#define ffetarget_value_real2
+#endif
+#define ffetarget_xor_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
+#define ffetarget_xor_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
+#define ffetarget_xor_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
+#define ffetarget_xor_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
+#define ffetarget_xor_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
+#define ffetarget_xor_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
+#define ffetarget_xor_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
+#define ffetarget_xor_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/tconfig.j b/gcc/f/tconfig.j
new file mode 100644
index 00000000000..b5fb04259c9
--- /dev/null
+++ b/gcc/f/tconfig.j
@@ -0,0 +1,27 @@
+/* tconfig.j -- Wrapper for GCC's tconfig.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_tconfig
+#define _J_f_tconfig
+#include "tconfig.h"
+#endif
+#endif
diff --git a/gcc/f/tm.j b/gcc/f/tm.j
new file mode 100644
index 00000000000..08efa5133ca
--- /dev/null
+++ b/gcc/f/tm.j
@@ -0,0 +1,27 @@
+/* tm.j -- Wrapper for GCC's tm.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_tm
+#define _J_f_tm
+#include "tm.h"
+#endif
+#endif
diff --git a/gcc/f/top.c b/gcc/f/top.c
new file mode 100644
index 00000000000..50d596ec82e
--- /dev/null
+++ b/gcc/f/top.c
@@ -0,0 +1,926 @@
+/* top.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None.
+
+ Description:
+ The GNU Fortran Front End.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include <ctype.h>
+#include "proj.h"
+#include "top.h"
+#include "bad.h"
+#include "bit.h"
+#include "bld.h"
+#include "com.h"
+#include "data.h"
+#include "equiv.h"
+#include "expr.h"
+#include "global.h"
+#include "implic.h"
+#include "info.h"
+#include "intrin.h"
+#include "lab.h"
+#include "lex.h"
+#include "malloc.h"
+#include "name.h"
+#include "src.h"
+#include "st.h"
+#include "storag.h"
+#include "symbol.h"
+#include "target.h"
+#include "where.h"
+#if FFECOM_targetCURRENT == FFECOM_targetGCC
+#include "flags.j"
+#endif
+
+/* Externals defined here. */
+
+int flag_traditional; /* Shouldn't need this (C front end only)! */
+bool ffe_is_do_internal_checks_ = TRUE;
+bool ffe_is_90_ = FFETARGET_defaultIS_90;
+bool ffe_is_automatic_ = FFETARGET_defaultIS_AUTOMATIC;
+bool ffe_is_backslash_ = FFETARGET_defaultIS_BACKSLASH;
+bool ffe_is_emulate_complex_ = TRUE;
+bool ffe_is_underscoring_ = FFETARGET_defaultEXTERNAL_UNDERSCORED
+ || FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED;
+bool ffe_is_second_underscore_ = FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED;
+bool ffe_is_debug_kludge_ = FALSE;
+bool ffe_is_dollar_ok_ = FFETARGET_defaultIS_DOLLAR_OK;
+bool ffe_is_f2c_ = FFETARGET_defaultIS_F2C;
+bool ffe_is_f2c_library_ = FFETARGET_defaultIS_F2C_LIBRARY;
+bool ffe_is_ffedebug_ = FALSE;
+bool ffe_is_free_form_ = FFETARGET_defaultIS_FREE_FORM;
+bool ffe_is_globals_ = TRUE;
+bool ffe_is_ident_ = TRUE;
+bool ffe_is_init_local_zero_ = FFETARGET_defaultIS_INIT_LOCAL_ZERO;
+bool ffe_is_mainprog_; /* TRUE if current prog unit known to be
+ main. */
+bool ffe_is_onetrip_ = FALSE;
+bool ffe_is_silent_ = TRUE;
+bool ffe_is_typeless_boz_ = FALSE;
+bool ffe_is_pedantic_ = FFETARGET_defaultIS_PEDANTIC;
+bool ffe_is_saveall_; /* TRUE if mainprog or SAVE (no args) seen. */
+bool ffe_is_ugly_args_ = TRUE;
+bool ffe_is_ugly_assign_ = FALSE; /* Try and store pointer to ASSIGN labels in INTEGER vars. */
+bool ffe_is_ugly_assumed_ = FALSE; /* DIMENSION X([...,]1) => DIMENSION X([...,]*) */
+bool ffe_is_ugly_comma_ = FALSE;
+bool ffe_is_ugly_complex_ = FALSE;
+bool ffe_is_ugly_init_ = TRUE;
+bool ffe_is_ugly_logint_ = FALSE;
+bool ffe_is_version_ = FALSE;
+bool ffe_is_vxt_ = FALSE;
+bool ffe_is_warn_globals_ = TRUE;
+bool ffe_is_warn_implicit_ = FALSE;
+bool ffe_is_warn_surprising_ = FALSE;
+bool ffe_is_zeros_ = FALSE;
+ffeCase ffe_case_intrin_ = FFETARGET_defaultCASE_INTRIN;
+ffeCase ffe_case_match_ = FFETARGET_defaultCASE_MATCH;
+ffeCase ffe_case_source_ = FFETARGET_defaultCASE_SOURCE;
+ffeCase ffe_case_symbol_ = FFETARGET_defaultCASE_SYMBOL;
+ffeIntrinsicState ffe_intrinsic_state_badu77_ = FFE_intrinsicstateENABLED;
+ffeIntrinsicState ffe_intrinsic_state_gnu_ = FFE_intrinsicstateENABLED;
+ffeIntrinsicState ffe_intrinsic_state_f2c_ = FFE_intrinsicstateENABLED;
+ffeIntrinsicState ffe_intrinsic_state_f90_ = FFE_intrinsicstateENABLED;
+ffeIntrinsicState ffe_intrinsic_state_mil_ = FFE_intrinsicstateENABLED;
+ffeIntrinsicState ffe_intrinsic_state_unix_ = FFE_intrinsicstateENABLED;
+ffeIntrinsicState ffe_intrinsic_state_vxt_ = FFE_intrinsicstateENABLED;
+int ffe_fixed_line_length_ = FFETARGET_defaultFIXED_LINE_LENGTH;
+mallocPool ffe_file_pool_ = NULL;
+mallocPool ffe_any_unit_pool_ = NULL;
+mallocPool ffe_program_unit_pool_ = NULL;
+ffeCounter ffe_count_0 = 0;
+ffeCounter ffe_count_1 = 0;
+ffeCounter ffe_count_2 = 0;
+ffeCounter ffe_count_3 = 0;
+ffeCounter ffe_count_4 = 0;
+bool ffe_in_0 = FALSE;
+bool ffe_in_1 = FALSE;
+bool ffe_in_2 = FALSE;
+bool ffe_in_3 = FALSE;
+bool ffe_in_4 = FALSE;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+static bool ffe_is_digit_string_ (char *s);
+
+/* Internal macros. */
+
+static bool
+ffe_is_digit_string_ (char *s)
+{
+ char *p;
+
+ for (p = s; isdigit (*p); ++p)
+ ;
+
+ return (p != s) && (*p == '\0');
+}
+
+/* Handle command-line options. Returns 0 if unrecognized, 1 if
+ recognized and handled. */
+
+int
+ffe_decode_option (char *opt)
+{
+ if (opt[0] != '-')
+ return 0;
+ if (opt[1] == 'f')
+ {
+ if (strcmp (&opt[2], "version") == 0)
+ ffe_set_is_version (TRUE);
+ else if (strcmp (&opt[2], "null-version") == 0)
+ ; /* Someday generate program to print version
+ info. */
+ else if (strcmp (&opt[2], "set-g77-defaults") == 0)
+ {
+ ffe_is_do_internal_checks_ = 0;
+#if BUILT_FOR_270 /* User must have applied patch (circa 2.7.2 and beyond). */
+ flag_move_all_movables = 1;
+ flag_reduce_all_givs = 1;
+ flag_rerun_loop_opt = 1;
+ flag_argument_noalias = 2;
+#endif
+ }
+ else if (strcmp (&opt[2], "ident") == 0)
+ ffe_set_is_ident (TRUE);
+ else if (strcmp (&opt[2], "no-ident") == 0)
+ ffe_set_is_ident (FALSE);
+ else if (strcmp (&opt[2], "f66") == 0)
+ {
+ ffe_set_is_onetrip (TRUE);
+ ffe_set_is_ugly_assumed (TRUE);
+ }
+ else if (strcmp (&opt[2], "no-f66") == 0)
+ {
+ ffe_set_is_onetrip (FALSE);
+ ffe_set_is_ugly_assumed (FALSE);
+ }
+ else if (strcmp (&opt[2], "f77") == 0)
+ {
+ ffe_set_is_backslash (TRUE);
+ ffe_set_is_typeless_boz (FALSE);
+ }
+ else if (strcmp (&opt[2], "no-f77") == 0)
+ {
+ ffe_set_is_backslash (FALSE);
+ }
+ else if (strcmp (&opt[2], "f90") == 0)
+ ffe_set_is_90 (TRUE);
+ else if (strcmp (&opt[2], "no-f90") == 0)
+ ffe_set_is_90 (FALSE);
+ else if (strcmp (&opt[2], "automatic") == 0)
+ ffe_set_is_automatic (TRUE);
+ else if (strcmp (&opt[2], "no-automatic") == 0)
+ ffe_set_is_automatic (FALSE);
+ else if (strcmp (&opt[2], "dollar-ok") == 0)
+ ffe_set_is_dollar_ok (TRUE);
+ else if (strcmp (&opt[2], "no-dollar-ok") == 0)
+ ffe_set_is_dollar_ok (FALSE);
+ else if (strcmp (&opt[2], "f2c") == 0)
+ ffe_set_is_f2c (TRUE);
+ else if (strcmp (&opt[2], "no-f2c") == 0)
+ ffe_set_is_f2c (FALSE);
+ else if (strcmp (&opt[2], "f2c-library") == 0)
+ ffe_set_is_f2c_library (TRUE);
+ else if (strcmp (&opt[2], "no-f2c-library") == 0)
+ ffe_set_is_f2c_library (FALSE);
+ else if (strcmp (&opt[2], "free-form") == 0)
+ ffe_set_is_free_form (TRUE);
+ else if (strcmp (&opt[2], "no-free-form") == 0)
+ ffe_set_is_free_form (FALSE);
+ else if (strcmp (&opt[2], "fixed-form") == 0)
+ ffe_set_is_free_form (FALSE);
+ else if (strcmp (&opt[2], "no-fixed-form") == 0)
+ ffe_set_is_free_form (TRUE);
+ else if (strcmp (&opt[2], "pedantic") == 0)
+ ffe_set_is_pedantic (TRUE);
+ else if (strcmp (&opt[2], "no-pedantic") == 0)
+ ffe_set_is_pedantic (FALSE);
+ else if (strcmp (&opt[2], "vxt") == 0)
+ ffe_set_is_vxt (TRUE);
+ else if (strcmp (&opt[2], "not-vxt") == 0)
+ ffe_set_is_vxt (FALSE);
+ else if (strcmp (&opt[2], "vxt-not-f90") == 0)
+ warning ("%s no longer supported -- try -fvxt", opt);
+ else if (strcmp (&opt[2], "f90-not-vxt") == 0)
+ warning ("%s no longer supported -- try -fno-vxt -ff90", opt);
+ else if (strcmp (&opt[2], "ugly") == 0)
+ {
+ warning ("%s is overloaded with meanings and likely to be removed;", opt);
+ warning ("use only the specific -fugly-* options you need");
+ ffe_set_is_ugly_args (TRUE);
+ ffe_set_is_ugly_assign (TRUE);
+ ffe_set_is_ugly_assumed (TRUE);
+ ffe_set_is_ugly_comma (TRUE);
+ ffe_set_is_ugly_complex (TRUE);
+ ffe_set_is_ugly_init (TRUE);
+ ffe_set_is_ugly_logint (TRUE);
+ }
+ else if (strcmp (&opt[2], "no-ugly") == 0)
+ {
+ ffe_set_is_ugly_args (FALSE);
+ ffe_set_is_ugly_assign (FALSE);
+ ffe_set_is_ugly_assumed (FALSE);
+ ffe_set_is_ugly_comma (FALSE);
+ ffe_set_is_ugly_complex (FALSE);
+ ffe_set_is_ugly_init (FALSE);
+ ffe_set_is_ugly_logint (FALSE);
+ }
+ else if (strcmp (&opt[2], "ugly-args") == 0)
+ ffe_set_is_ugly_args (TRUE);
+ else if (strcmp (&opt[2], "no-ugly-args") == 0)
+ ffe_set_is_ugly_args (FALSE);
+ else if (strcmp (&opt[2], "ugly-assign") == 0)
+ ffe_set_is_ugly_assign (TRUE);
+ else if (strcmp (&opt[2], "no-ugly-assign") == 0)
+ ffe_set_is_ugly_assign (FALSE);
+ else if (strcmp (&opt[2], "ugly-assumed") == 0)
+ ffe_set_is_ugly_assumed (TRUE);
+ else if (strcmp (&opt[2], "no-ugly-assumed") == 0)
+ ffe_set_is_ugly_assumed (FALSE);
+ else if (strcmp (&opt[2], "ugly-comma") == 0)
+ ffe_set_is_ugly_comma (TRUE);
+ else if (strcmp (&opt[2], "no-ugly-comma") == 0)
+ ffe_set_is_ugly_comma (FALSE);
+ else if (strcmp (&opt[2], "ugly-complex") == 0)
+ ffe_set_is_ugly_complex (TRUE);
+ else if (strcmp (&opt[2], "no-ugly-complex") == 0)
+ ffe_set_is_ugly_complex (FALSE);
+ else if (strcmp (&opt[2], "ugly-init") == 0)
+ ffe_set_is_ugly_init (TRUE);
+ else if (strcmp (&opt[2], "no-ugly-init") == 0)
+ ffe_set_is_ugly_init (FALSE);
+ else if (strcmp (&opt[2], "ugly-logint") == 0)
+ ffe_set_is_ugly_logint (TRUE);
+ else if (strcmp (&opt[2], "no-ugly-logint") == 0)
+ ffe_set_is_ugly_logint (FALSE);
+ else if (strcmp (&opt[2], "xyzzy") == 0)
+ ffe_set_is_ffedebug (TRUE);
+ else if (strcmp (&opt[2], "no-xyzzy") == 0)
+ ffe_set_is_ffedebug (FALSE);
+ else if (strcmp (&opt[2], "init-local-zero") == 0)
+ ffe_set_is_init_local_zero (TRUE);
+ else if (strcmp (&opt[2], "no-init-local-zero") == 0)
+ ffe_set_is_init_local_zero (FALSE);
+ else if (strcmp (&opt[2], "emulate-complex") == 0)
+ ffe_set_is_emulate_complex (TRUE);
+ else if (strcmp (&opt[2], "no-emulate-complex") == 0)
+ ffe_set_is_emulate_complex (FALSE);
+ else if (strcmp (&opt[2], "backslash") == 0)
+ ffe_set_is_backslash (TRUE);
+ else if (strcmp (&opt[2], "no-backslash") == 0)
+ ffe_set_is_backslash (FALSE);
+ else if (strcmp (&opt[2], "underscoring") == 0)
+ ffe_set_is_underscoring (TRUE);
+ else if (strcmp (&opt[2], "no-underscoring") == 0)
+ ffe_set_is_underscoring (FALSE);
+ else if (strcmp (&opt[2], "second-underscore") == 0)
+ ffe_set_is_second_underscore (TRUE);
+ else if (strcmp (&opt[2], "no-second-underscore") == 0)
+ ffe_set_is_second_underscore (FALSE);
+ else if (strcmp (&opt[2], "zeros") == 0)
+ ffe_set_is_zeros (TRUE);
+ else if (strcmp (&opt[2], "no-zeros") == 0)
+ ffe_set_is_zeros (FALSE);
+ else if (strcmp (&opt[2], "debug-kludge") == 0)
+ ffe_set_is_debug_kludge (TRUE);
+ else if (strcmp (&opt[2], "no-debug-kludge") == 0)
+ ffe_set_is_debug_kludge (FALSE);
+ else if (strcmp (&opt[2], "onetrip") == 0)
+ ffe_set_is_onetrip (TRUE);
+ else if (strcmp (&opt[2], "no-onetrip") == 0)
+ ffe_set_is_onetrip (FALSE);
+ else if (strcmp (&opt[2], "silent") == 0)
+ ffe_set_is_silent (TRUE);
+ else if (strcmp (&opt[2], "no-silent") == 0)
+ ffe_set_is_silent (FALSE);
+ else if (strcmp (&opt[2], "globals") == 0)
+ ffe_set_is_globals (TRUE);
+ else if (strcmp (&opt[2], "no-globals") == 0)
+ ffe_set_is_globals (FALSE);
+ else if (strcmp (&opt[2], "typeless-boz") == 0)
+ ffe_set_is_typeless_boz (TRUE);
+ else if (strcmp (&opt[2], "no-typeless-boz") == 0)
+ ffe_set_is_typeless_boz (FALSE);
+ else if (strcmp (&opt[2], "intrin-case-initcap") == 0)
+ ffe_set_case_intrin (FFE_caseINITCAP);
+ else if (strcmp (&opt[2], "intrin-case-upper") == 0)
+ ffe_set_case_intrin (FFE_caseUPPER);
+ else if (strcmp (&opt[2], "intrin-case-lower") == 0)
+ ffe_set_case_intrin (FFE_caseLOWER);
+ else if (strcmp (&opt[2], "intrin-case-any") == 0)
+ ffe_set_case_intrin (FFE_caseNONE);
+ else if (strcmp (&opt[2], "match-case-initcap") == 0)
+ ffe_set_case_match (FFE_caseINITCAP);
+ else if (strcmp (&opt[2], "match-case-upper") == 0)
+ ffe_set_case_match (FFE_caseUPPER);
+ else if (strcmp (&opt[2], "match-case-lower") == 0)
+ ffe_set_case_match (FFE_caseLOWER);
+ else if (strcmp (&opt[2], "match-case-any") == 0)
+ ffe_set_case_match (FFE_caseNONE);
+ else if (strcmp (&opt[2], "source-case-upper") == 0)
+ ffe_set_case_source (FFE_caseUPPER);
+ else if (strcmp (&opt[2], "source-case-lower") == 0)
+ ffe_set_case_source (FFE_caseLOWER);
+ else if (strcmp (&opt[2], "source-case-preserve") == 0)
+ ffe_set_case_source (FFE_caseNONE);
+ else if (strcmp (&opt[2], "symbol-case-initcap") == 0)
+ ffe_set_case_symbol (FFE_caseINITCAP);
+ else if (strcmp (&opt[2], "symbol-case-upper") == 0)
+ ffe_set_case_symbol (FFE_caseUPPER);
+ else if (strcmp (&opt[2], "symbol-case-lower") == 0)
+ ffe_set_case_symbol (FFE_caseLOWER);
+ else if (strcmp (&opt[2], "symbol-case-any") == 0)
+ ffe_set_case_symbol (FFE_caseNONE);
+ else if (strcmp (&opt[2], "case-strict-upper") == 0)
+ {
+ ffe_set_case_intrin (FFE_caseUPPER);
+ ffe_set_case_match (FFE_caseUPPER);
+ ffe_set_case_source (FFE_caseNONE);
+ ffe_set_case_symbol (FFE_caseUPPER);
+ }
+ else if (strcmp (&opt[2], "case-strict-lower") == 0)
+ {
+ ffe_set_case_intrin (FFE_caseLOWER);
+ ffe_set_case_match (FFE_caseLOWER);
+ ffe_set_case_source (FFE_caseNONE);
+ ffe_set_case_symbol (FFE_caseLOWER);
+ }
+ else if (strcmp (&opt[2], "case-initcap") == 0)
+ {
+ ffe_set_case_intrin (FFE_caseINITCAP);
+ ffe_set_case_match (FFE_caseINITCAP);
+ ffe_set_case_source (FFE_caseNONE);
+ ffe_set_case_symbol (FFE_caseINITCAP);
+ }
+ else if (strcmp (&opt[2], "case-upper") == 0)
+ {
+ ffe_set_case_intrin (FFE_caseNONE);
+ ffe_set_case_match (FFE_caseNONE);
+ ffe_set_case_source (FFE_caseUPPER);
+ ffe_set_case_symbol (FFE_caseNONE);
+ }
+ else if (strcmp (&opt[2], "case-lower") == 0)
+ {
+ ffe_set_case_intrin (FFE_caseNONE);
+ ffe_set_case_match (FFE_caseNONE);
+ ffe_set_case_source (FFE_caseLOWER);
+ ffe_set_case_symbol (FFE_caseNONE);
+ }
+ else if (strcmp (&opt[2], "case-preserve") == 0)
+ {
+ ffe_set_case_intrin (FFE_caseNONE);
+ ffe_set_case_match (FFE_caseNONE);
+ ffe_set_case_source (FFE_caseNONE);
+ ffe_set_case_symbol (FFE_caseNONE);
+ }
+ else if (strcmp (&opt[2], "badu77-intrinsics-delete") == 0)
+ ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDELETED);
+ else if (strcmp (&opt[2], "badu77-intrinsics-hide") == 0)
+ ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateHIDDEN);
+ else if (strcmp (&opt[2], "badu77-intrinsics-disable") == 0)
+ ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateDISABLED);
+ else if (strcmp (&opt[2], "badu77-intrinsics-enable") == 0)
+ ffe_set_intrinsic_state_badu77 (FFE_intrinsicstateENABLED);
+ else if (strcmp (&opt[2], "gnu-intrinsics-delete") == 0)
+ ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDELETED);
+ else if (strcmp (&opt[2], "gnu-intrinsics-hide") == 0)
+ ffe_set_intrinsic_state_gnu (FFE_intrinsicstateHIDDEN);
+ else if (strcmp (&opt[2], "gnu-intrinsics-disable") == 0)
+ ffe_set_intrinsic_state_gnu (FFE_intrinsicstateDISABLED);
+ else if (strcmp (&opt[2], "gnu-intrinsics-enable") == 0)
+ ffe_set_intrinsic_state_gnu (FFE_intrinsicstateENABLED);
+ else if (strcmp (&opt[2], "f2c-intrinsics-delete") == 0)
+ ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDELETED);
+ else if (strcmp (&opt[2], "f2c-intrinsics-hide") == 0)
+ ffe_set_intrinsic_state_f2c (FFE_intrinsicstateHIDDEN);
+ else if (strcmp (&opt[2], "f2c-intrinsics-disable") == 0)
+ ffe_set_intrinsic_state_f2c (FFE_intrinsicstateDISABLED);
+ else if (strcmp (&opt[2], "f2c-intrinsics-enable") == 0)
+ ffe_set_intrinsic_state_f2c (FFE_intrinsicstateENABLED);
+ else if (strcmp (&opt[2], "f90-intrinsics-delete") == 0)
+ ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDELETED);
+ else if (strcmp (&opt[2], "f90-intrinsics-hide") == 0)
+ ffe_set_intrinsic_state_f90 (FFE_intrinsicstateHIDDEN);
+ else if (strcmp (&opt[2], "f90-intrinsics-disable") == 0)
+ ffe_set_intrinsic_state_f90 (FFE_intrinsicstateDISABLED);
+ else if (strcmp (&opt[2], "f90-intrinsics-enable") == 0)
+ ffe_set_intrinsic_state_f90 (FFE_intrinsicstateENABLED);
+ else if (strcmp (&opt[2], "mil-intrinsics-delete") == 0)
+ ffe_set_intrinsic_state_mil (FFE_intrinsicstateDELETED);
+ else if (strcmp (&opt[2], "mil-intrinsics-hide") == 0)
+ ffe_set_intrinsic_state_mil (FFE_intrinsicstateHIDDEN);
+ else if (strcmp (&opt[2], "mil-intrinsics-disable") == 0)
+ ffe_set_intrinsic_state_mil (FFE_intrinsicstateDISABLED);
+ else if (strcmp (&opt[2], "mil-intrinsics-enable") == 0)
+ ffe_set_intrinsic_state_mil (FFE_intrinsicstateENABLED);
+ else if (strcmp (&opt[2], "unix-intrinsics-delete") == 0)
+ ffe_set_intrinsic_state_unix (FFE_intrinsicstateDELETED);
+ else if (strcmp (&opt[2], "unix-intrinsics-hide") == 0)
+ ffe_set_intrinsic_state_unix (FFE_intrinsicstateHIDDEN);
+ else if (strcmp (&opt[2], "unix-intrinsics-disable") == 0)
+ ffe_set_intrinsic_state_unix (FFE_intrinsicstateDISABLED);
+ else if (strcmp (&opt[2], "unix-intrinsics-enable") == 0)
+ ffe_set_intrinsic_state_unix (FFE_intrinsicstateENABLED);
+ else if (strcmp (&opt[2], "vxt-intrinsics-delete") == 0)
+ ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDELETED);
+ else if (strcmp (&opt[2], "vxt-intrinsics-hide") == 0)
+ ffe_set_intrinsic_state_vxt (FFE_intrinsicstateHIDDEN);
+ else if (strcmp (&opt[2], "vxt-intrinsics-disable") == 0)
+ ffe_set_intrinsic_state_vxt (FFE_intrinsicstateDISABLED);
+ else if (strcmp (&opt[2], "vxt-intrinsics-enable") == 0)
+ ffe_set_intrinsic_state_vxt (FFE_intrinsicstateENABLED);
+ else if (strncmp (&opt[2], "fixed-line-length-",
+ strlen ("fixed-line-length-")) == 0)
+ {
+ char *len = &opt[2] + strlen ("fixed-line-length-");
+
+ if (strcmp (len, "none") == 0)
+ ffe_set_fixed_line_length (0);
+ else if (ffe_is_digit_string_ (len))
+ ffe_set_fixed_line_length (atol (len));
+ else
+ return 0;
+ }
+ else
+ return 0;
+ }
+ else if (opt[1] == 'W')
+ {
+ if (!strcmp (&opt[2], "comment"))
+ ; /* cpp handles this one. */
+ else if (!strcmp (&opt[2], "no-comment"))
+ ; /* cpp handles this one. */
+ else if (!strcmp (&opt[2], "comments"))
+ ; /* cpp handles this one. */
+ else if (!strcmp (&opt[2], "no-comments"))
+ ; /* cpp handles this one. */
+ else if (!strcmp (&opt[2], "trigraphs"))
+ ; /* cpp handles this one. */
+ else if (!strcmp (&opt[2], "no-trigraphs"))
+ ; /* cpp handles this one. */
+ else if (!strcmp (&opt[2], "import"))
+ ; /* cpp handles this one. */
+ else if (!strcmp (&opt[2], "no-import"))
+ ; /* cpp handles this one. */
+ else if (!strcmp (&opt[2], "globals"))
+ ffe_set_is_warn_globals (TRUE);
+ else if (!strcmp (&opt[2], "no-globals"))
+ ffe_set_is_warn_globals (FALSE);
+ else if (!strcmp (&opt[2], "implicit"))
+ ffe_set_is_warn_implicit (TRUE);
+ else if (!strcmp (&opt[2], "no-implicit"))
+ ffe_set_is_warn_implicit (FALSE);
+ else if (!strcmp (&opt[2], "surprising"))
+ ffe_set_is_warn_surprising (TRUE);
+ else if (!strcmp (&opt[2], "no-surprising"))
+ ffe_set_is_warn_surprising (FALSE);
+ else if (!strcmp (&opt[2], "all"))
+ {
+ /* We save the value of warn_uninitialized, since if they put
+ -Wuninitialized on the command line, we need to generate a
+ warning about not using it without also specifying -O. */
+ if (warn_uninitialized != 1)
+ warn_uninitialized = 2;
+ warn_unused = 1;
+ }
+ else
+ return 0;
+ }
+ else if (opt[1] == 'I')
+ return ffecom_decode_include_option (&opt[2]);
+ else
+ return 0;
+
+ return 1;
+}
+
+/* Run the FFE on a source file (not an INCLUDEd file).
+
+ Runs the whole shebang.
+
+ Prepare and invoke the appropriate lexer. */
+
+void
+ffe_file (ffewhereFile wf, FILE *f)
+{
+ ffe_init_1 ();
+ ffelex_set_handler ((ffelexHandler) ffest_first);
+ ffewhere_file_set (wf, TRUE, 0);
+ if (ffe_is_free_form_)
+ ffelex_file_free (wf, f);
+ else
+ ffelex_file_fixed (wf, f);
+ ffest_eof ();
+ ffe_terminate_1 ();
+}
+
+/* ffe_init_0 -- Initialize the FFE per image invocation
+
+ ffe_init_0();
+
+ Performs per-image invocation. */
+
+void
+ffe_init_0 ()
+{
+ ++ffe_count_0;
+ ffe_in_0 = TRUE;
+
+ ffebad_init_0 ();
+ ffebit_init_0 ();
+ ffebld_init_0 ();
+ ffecom_init_0 ();
+ ffedata_init_0 ();
+ ffeequiv_init_0 ();
+ ffeexpr_init_0 ();
+ ffeglobal_init_0 ();
+ ffeimplic_init_0 ();
+ ffeinfo_init_0 ();
+ ffeintrin_init_0 ();
+ ffelab_init_0 ();
+ ffelex_init_0 ();
+ ffename_init_0 ();
+ ffesrc_init_0 ();
+ ffest_init_0 ();
+ ffestorag_init_0 ();
+ ffesymbol_init_0 ();
+ ffetarget_init_0 ();
+ ffetype_init_0 ();
+ ffewhere_init_0 ();
+}
+
+/* ffe_init_1 -- Initialize the FFE per source file
+
+ ffe_init_1();
+
+ Performs per-source-file invocation (not including INCLUDEd files). */
+
+void
+ffe_init_1 ()
+{
+ ++ffe_count_1;
+ ffe_in_1 = TRUE;
+
+ assert (ffe_file_pool_ == NULL);
+ ffe_file_pool_ = malloc_pool_new ("File", malloc_pool_image (), 1024);
+
+ ffebad_init_1 ();
+ ffebit_init_1 ();
+ ffebld_init_1 ();
+ ffecom_init_1 ();
+ ffedata_init_1 ();
+ ffeequiv_init_1 ();
+ ffeexpr_init_1 ();
+ ffeglobal_init_1 ();
+ ffeimplic_init_1 ();
+ ffeinfo_init_1 ();
+ ffeintrin_init_1 ();
+ ffelab_init_1 ();
+ ffelex_init_1 ();
+ ffename_init_1 ();
+ ffesrc_init_1 ();
+ ffest_init_1 ();
+ ffestorag_init_1 ();
+ ffesymbol_init_1 ();
+ ffetarget_init_1 ();
+ ffetype_init_1 ();
+ ffewhere_init_1 ();
+
+ ffe_init_2 ();
+}
+
+/* ffe_init_2 -- Initialize the FFE per outer program unit
+
+ ffe_init_2();
+
+ Performs per-program-unit invocation. */
+
+void
+ffe_init_2 ()
+{
+ ++ffe_count_2;
+ ffe_in_2 = TRUE;
+
+ assert (ffe_program_unit_pool_ == NULL);
+ ffe_program_unit_pool_ = malloc_pool_new ("Program unit", ffe_file_pool_, 1024);
+ ffe_is_mainprog_ = FALSE;
+ ffe_is_saveall_ = !ffe_is_automatic_;
+
+ ffebad_init_2 ();
+ ffebit_init_2 ();
+ ffebld_init_2 ();
+ ffecom_init_2 ();
+ ffedata_init_2 ();
+ ffeequiv_init_2 ();
+ ffeexpr_init_2 ();
+ ffeglobal_init_2 ();
+ ffeimplic_init_2 ();
+ ffeinfo_init_2 ();
+ ffeintrin_init_2 ();
+ ffelab_init_2 ();
+ ffelex_init_2 ();
+ ffename_init_2 ();
+ ffesrc_init_2 ();
+ ffest_init_2 ();
+ ffestorag_init_2 ();
+ ffesymbol_init_2 ();
+ ffetarget_init_2 ();
+ ffetype_init_2 ();
+ ffewhere_init_2 ();
+
+ ffe_init_3 ();
+}
+
+/* ffe_init_3 -- Initialize the FFE per any program unit
+
+ ffe_init_3();
+
+ Performs per-any-unit initialization; does NOT do
+ per-statement-function-definition initialization (i.e. the chain
+ of inits, from 0-3, breaks here; level 4 must be invoked independently). */
+
+void
+ffe_init_3 ()
+{
+ ++ffe_count_3;
+ ffe_in_3 = TRUE;
+
+ assert (ffe_any_unit_pool_ == NULL);
+ ffe_any_unit_pool_ = malloc_pool_new ("Any unit", ffe_program_unit_pool_, 1024);
+
+ ffebad_init_3 ();
+ ffebit_init_3 ();
+ ffebld_init_3 ();
+ ffecom_init_3 ();
+ ffedata_init_3 ();
+ ffeequiv_init_3 ();
+ ffeexpr_init_3 ();
+ ffeglobal_init_3 ();
+ ffeimplic_init_3 ();
+ ffeinfo_init_3 ();
+ ffeintrin_init_3 ();
+ ffelab_init_3 ();
+ ffelex_init_3 ();
+ ffename_init_3 ();
+ ffesrc_init_3 ();
+ ffest_init_3 ();
+ ffestorag_init_3 ();
+ ffesymbol_init_3 ();
+ ffetarget_init_3 ();
+ ffetype_init_3 ();
+ ffewhere_init_3 ();
+}
+
+/* ffe_init_4 -- Initialize the FFE per statement function definition
+
+ ffe_init_4(); */
+
+void
+ffe_init_4 ()
+{
+ ++ffe_count_4;
+ ffe_in_4 = TRUE;
+
+ ffebad_init_4 ();
+ ffebit_init_4 ();
+ ffebld_init_4 ();
+ ffecom_init_4 ();
+ ffedata_init_4 ();
+ ffeequiv_init_4 ();
+ ffeexpr_init_4 ();
+ ffeglobal_init_4 ();
+ ffeimplic_init_4 ();
+ ffeinfo_init_4 ();
+ ffeintrin_init_4 ();
+ ffelab_init_4 ();
+ ffelex_init_4 ();
+ ffename_init_4 ();
+ ffesrc_init_4 ();
+ ffest_init_4 ();
+ ffestorag_init_4 ();
+ ffesymbol_init_4 ();
+ ffetarget_init_4 ();
+ ffetype_init_4 ();
+ ffewhere_init_4 ();
+}
+
+/* ffe_terminate_0 -- Terminate the FFE prior to image termination
+
+ ffe_terminate_0(); */
+
+void
+ffe_terminate_0 ()
+{
+ ffe_count_1 = 0;
+ ffe_in_0 = FALSE;
+
+ ffebad_terminate_0 ();
+ ffebit_terminate_0 ();
+ ffebld_terminate_0 ();
+ ffecom_terminate_0 ();
+ ffedata_terminate_0 ();
+ ffeequiv_terminate_0 ();
+ ffeexpr_terminate_0 ();
+ ffeglobal_terminate_0 ();
+ ffeimplic_terminate_0 ();
+ ffeinfo_terminate_0 ();
+ ffeintrin_terminate_0 ();
+ ffelab_terminate_0 ();
+ ffelex_terminate_0 ();
+ ffename_terminate_0 ();
+ ffesrc_terminate_0 ();
+ ffest_terminate_0 ();
+ ffestorag_terminate_0 ();
+ ffesymbol_terminate_0 ();
+ ffetarget_terminate_0 ();
+ ffetype_terminate_0 ();
+ ffewhere_terminate_0 ();
+}
+
+/* ffe_terminate_1 -- Terminate the FFE after seeing source file EOF
+
+ ffe_terminate_1(); */
+
+void
+ffe_terminate_1 ()
+{
+ ffe_count_2 = 0;
+ ffe_in_1 = FALSE;
+
+ ffe_terminate_2 ();
+
+ ffebad_terminate_1 ();
+ ffebit_terminate_1 ();
+ ffebld_terminate_1 ();
+ ffecom_terminate_1 ();
+ ffedata_terminate_1 ();
+ ffeequiv_terminate_1 ();
+ ffeexpr_terminate_1 ();
+ ffeglobal_terminate_1 ();
+ ffeimplic_terminate_1 ();
+ ffeinfo_terminate_1 ();
+ ffeintrin_terminate_1 ();
+ ffelab_terminate_1 ();
+ ffelex_terminate_1 ();
+ ffename_terminate_1 ();
+ ffesrc_terminate_1 ();
+ ffest_terminate_1 ();
+ ffestorag_terminate_1 ();
+ ffesymbol_terminate_1 ();
+ ffetarget_terminate_1 ();
+ ffetype_terminate_1 ();
+ ffewhere_terminate_1 ();
+
+ assert (ffe_file_pool_ != NULL);
+ malloc_pool_kill (ffe_file_pool_);
+ ffe_file_pool_ = NULL;
+}
+
+/* ffe_terminate_2 -- Terminate the FFE after seeing outer program unit END
+
+ ffe_terminate_2(); */
+
+void
+ffe_terminate_2 ()
+{
+ ffe_count_3 = 0;
+ ffe_in_2 = FALSE;
+
+ ffe_terminate_3 ();
+
+ ffebad_terminate_2 ();
+ ffebit_terminate_2 ();
+ ffebld_terminate_2 ();
+ ffecom_terminate_2 ();
+ ffedata_terminate_2 ();
+ ffeequiv_terminate_2 ();
+ ffeexpr_terminate_2 ();
+ ffeglobal_terminate_2 ();
+ ffeimplic_terminate_2 ();
+ ffeinfo_terminate_2 ();
+ ffeintrin_terminate_2 ();
+ ffelab_terminate_2 ();
+ ffelex_terminate_2 ();
+ ffename_terminate_2 ();
+ ffesrc_terminate_2 ();
+ ffest_terminate_2 ();
+ ffestorag_terminate_2 ();
+ ffesymbol_terminate_2 ();
+ ffetarget_terminate_2 ();
+ ffetype_terminate_2 ();
+ ffewhere_terminate_2 ();
+
+ assert (ffe_program_unit_pool_ != NULL);
+ malloc_pool_kill (ffe_program_unit_pool_);
+ ffe_program_unit_pool_ = NULL;
+}
+
+/* ffe_terminate_3 -- Terminate the FFE after seeing any program unit END
+
+ ffe_terminate_3(); */
+
+void
+ffe_terminate_3 ()
+{
+ ffe_count_4 = 0;
+ ffe_in_3 = FALSE;
+
+ ffebad_terminate_3 ();
+ ffebit_terminate_3 ();
+ ffebld_terminate_3 ();
+ ffecom_terminate_3 ();
+ ffedata_terminate_3 ();
+ ffeequiv_terminate_3 ();
+ ffeexpr_terminate_3 ();
+ ffeglobal_terminate_3 ();
+ ffeimplic_terminate_3 ();
+ ffeinfo_terminate_3 ();
+ ffeintrin_terminate_3 ();
+ ffelab_terminate_3 ();
+ ffelex_terminate_3 ();
+ ffename_terminate_3 ();
+ ffesrc_terminate_3 ();
+ ffest_terminate_3 ();
+ ffestorag_terminate_3 ();
+ ffesymbol_terminate_3 ();
+ ffetarget_terminate_3 ();
+ ffetype_terminate_3 ();
+ ffewhere_terminate_3 ();
+
+ assert (ffe_any_unit_pool_ != NULL);
+ malloc_pool_kill (ffe_any_unit_pool_);
+ ffe_any_unit_pool_ = NULL;
+}
+
+/* ffe_terminate_4 -- Terminate the FFE after seeing sfunc def expression
+
+ ffe_terminate_4(); */
+
+void
+ffe_terminate_4 ()
+{
+ ffe_in_4 = FALSE;
+
+ ffebad_terminate_4 ();
+ ffebit_terminate_4 ();
+ ffebld_terminate_4 ();
+ ffecom_terminate_4 ();
+ ffedata_terminate_4 ();
+ ffeequiv_terminate_4 ();
+ ffeexpr_terminate_4 ();
+ ffeglobal_terminate_4 ();
+ ffeimplic_terminate_4 ();
+ ffeinfo_terminate_4 ();
+ ffeintrin_terminate_4 ();
+ ffelab_terminate_4 ();
+ ffelex_terminate_4 ();
+ ffename_terminate_4 ();
+ ffesrc_terminate_4 ();
+ ffest_terminate_4 ();
+ ffestorag_terminate_4 ();
+ ffesymbol_terminate_4 ();
+ ffetarget_terminate_4 ();
+ ffetype_terminate_4 ();
+ ffewhere_terminate_4 ();
+}
diff --git a/gcc/f/top.h b/gcc/f/top.h
new file mode 100644
index 00000000000..3d91fd77be7
--- /dev/null
+++ b/gcc/f/top.h
@@ -0,0 +1,261 @@
+/* top.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995-1997 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ top.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_parse
+#define _H_f_parse
+
+/* Simple definitions and enumerations. */
+
+enum _ffe_case_
+ {
+ FFE_caseNONE, /* No case conversion, match
+ case-insensitive. */
+ FFE_caseUPPER, /* Convert lowercase to uppercase, match
+ upper. */
+ FFE_caseLOWER, /* Convert uppercase to lowercase, match
+ lower. */
+ FFE_caseINITCAP, /* Match InitialCap (no meaning for
+ conversion). */
+ FFE_case
+ };
+typedef enum _ffe_case_ ffeCase;
+
+enum _ffeintrinsic_state_
+ { /* State of a family of intrinsics. NOTE:
+ order IS important, see
+ ffe_intrinsic_state_max (). */
+ FFE_intrinsicstateDELETED, /* Doesn't exist at all. */
+ FFE_intrinsicstateDISABLED, /* Diagnostic if used as intrinsic. */
+ FFE_intrinsicstateHIDDEN, /* Exists only if INTRINSIC stmt. */
+ FFE_intrinsicstateENABLED, /* Exists as normal. */
+ FFE_intrinsicstate
+ };
+typedef enum _ffeintrinsic_state_ ffeIntrinsicState;
+
+/* Typedefs. */
+
+typedef unsigned long ffeCounter;
+#define ffeCounter_f "l"
+typedef unsigned int ffeKwIndex;
+typedef unsigned long int ffeTokenLength;
+#define ffeTokenLength_f "l"
+typedef void *ffeUnionLongPtr; /* unused type to cover union of long and
+ ptr. */
+
+/* Include files needed by this one. */
+
+#include "malloc.h"
+#include "where.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+extern bool ffe_is_do_internal_checks_;
+extern bool ffe_is_90_;
+extern bool ffe_is_automatic_;
+extern bool ffe_is_backslash_;
+extern bool ffe_is_emulate_complex_;
+extern bool ffe_is_underscoring_;
+extern bool ffe_is_second_underscore_;
+extern bool ffe_is_debug_kludge_;
+extern bool ffe_is_dollar_ok_;
+extern bool ffe_is_f2c_;
+extern bool ffe_is_f2c_library_;
+extern bool ffe_is_ffedebug_;
+extern bool ffe_is_free_form_;
+extern bool ffe_is_globals_;
+extern bool ffe_is_ident_;
+extern bool ffe_is_init_local_zero_;
+extern bool ffe_is_mainprog_;
+extern bool ffe_is_onetrip_;
+extern bool ffe_is_silent_;
+extern bool ffe_is_typeless_boz_;
+extern bool ffe_is_pedantic_;
+extern bool ffe_is_saveall_;
+extern bool ffe_is_ugly_args_;
+extern bool ffe_is_ugly_assign_;
+extern bool ffe_is_ugly_assumed_;
+extern bool ffe_is_ugly_comma_;
+extern bool ffe_is_ugly_complex_;
+extern bool ffe_is_ugly_init_;
+extern bool ffe_is_ugly_logint_;
+extern bool ffe_is_version_;
+extern bool ffe_is_vxt_;
+extern bool ffe_is_warn_globals_;
+extern bool ffe_is_warn_implicit_;
+extern bool ffe_is_warn_surprising_;
+extern bool ffe_is_zeros_;
+extern ffeCase ffe_case_intrin_;
+extern ffeCase ffe_case_match_;
+extern ffeCase ffe_case_source_;
+extern ffeCase ffe_case_symbol_;
+extern ffeIntrinsicState ffe_intrinsic_state_badu77_;
+extern ffeIntrinsicState ffe_intrinsic_state_gnu_;
+extern ffeIntrinsicState ffe_intrinsic_state_f2c_;
+extern ffeIntrinsicState ffe_intrinsic_state_f90_;
+extern ffeIntrinsicState ffe_intrinsic_state_mil_;
+extern ffeIntrinsicState ffe_intrinsic_state_unix_;
+extern ffeIntrinsicState ffe_intrinsic_state_vxt_;
+extern int ffe_fixed_line_length_;
+extern mallocPool ffe_file_pool_;
+extern mallocPool ffe_any_unit_pool_;
+extern mallocPool ffe_program_unit_pool_;
+extern ffeCounter ffe_count_0;
+extern ffeCounter ffe_count_1;
+extern ffeCounter ffe_count_2;
+extern ffeCounter ffe_count_3;
+extern ffeCounter ffe_count_4;
+extern bool ffe_in_0;
+extern bool ffe_in_1;
+extern bool ffe_in_2;
+extern bool ffe_in_3;
+extern bool ffe_in_4;
+
+/* Declare functions with prototypes. */
+
+int ffe_decode_option (char *opt);
+void ffe_file (ffewhereFile wf, FILE *f);
+void ffe_init_0 (void);
+void ffe_init_1 (void);
+void ffe_init_2 (void);
+void ffe_init_3 (void);
+void ffe_init_4 (void);
+void ffe_terminate_0 (void);
+void ffe_terminate_1 (void);
+void ffe_terminate_2 (void);
+void ffe_terminate_3 (void);
+void ffe_terminate_4 (void);
+
+/* Define macros. */
+
+#define ffe_case_intrin() ffe_case_intrin_
+#define ffe_case_match() ffe_case_match_
+#define ffe_case_source() ffe_case_source_
+#define ffe_case_symbol() ffe_case_symbol_
+#define ffe_intrinsic_state_badu77() ffe_intrinsic_state_badu77_
+#define ffe_intrinsic_state_f2c() ffe_intrinsic_state_f2c_
+#define ffe_intrinsic_state_f90() ffe_intrinsic_state_f90_
+#define ffe_intrinsic_state_gnu() ffe_intrinsic_state_gnu_
+#define ffe_intrinsic_state_mil() ffe_intrinsic_state_mil_
+#define ffe_intrinsic_state_unix() ffe_intrinsic_state_unix_
+#define ffe_intrinsic_state_vxt() ffe_intrinsic_state_vxt_
+#define ffe_is_90() ffe_is_90_
+#define ffe_is_automatic() ffe_is_automatic_
+#define ffe_is_backslash() ffe_is_backslash_
+#define ffe_is_debug_kludge() ffe_is_debug_kludge_
+#define ffe_is_do_internal_checks() ffe_is_do_internal_checks_
+#define ffe_is_dollar_ok() ffe_is_dollar_ok_
+#define ffe_is_emulate_complex() ffe_is_emulate_complex_
+#define ffe_is_f2c() ffe_is_f2c_
+#define ffe_is_f2c_library() ffe_is_f2c_library_
+#define ffe_is_ffedebug() ffe_is_ffedebug_
+#define ffe_is_free_form() ffe_is_free_form_
+#define ffe_is_globals() ffe_is_globals_
+#define ffe_is_ident() ffe_is_ident_
+#define ffe_is_init_local_zero() ffe_is_init_local_zero_
+#define ffe_is_mainprog() ffe_is_mainprog_
+#define ffe_is_onetrip() ffe_is_onetrip_
+#define ffe_is_pedantic() ffe_is_pedantic_
+#define ffe_is_pedantic_not_90() (ffe_is_pedantic_ && !ffe_is_90_)
+#define ffe_is_saveall() ffe_is_saveall_
+#define ffe_is_second_underscore() ffe_is_second_underscore_
+#define ffe_is_silent() ffe_is_silent_
+#define ffe_is_typeless_boz() ffe_is_typeless_boz_
+#define ffe_is_ugly_args() ffe_is_ugly_args_
+#define ffe_is_ugly_assign() ffe_is_ugly_assign_
+#define ffe_is_ugly_assumed() ffe_is_ugly_assumed_
+#define ffe_is_ugly_comma() ffe_is_ugly_comma_
+#define ffe_is_ugly_complex() ffe_is_ugly_complex_
+#define ffe_is_ugly_init() ffe_is_ugly_init_
+#define ffe_is_ugly_logint() ffe_is_ugly_logint_
+#define ffe_is_underscoring() ffe_is_underscoring_
+#define ffe_is_version() ffe_is_version_
+#define ffe_is_vxt() ffe_is_vxt_
+#define ffe_is_warn_globals() ffe_is_warn_globals_
+#define ffe_is_warn_implicit() ffe_is_warn_implicit_
+#define ffe_is_warn_surprising() ffe_is_warn_surprising_
+#define ffe_is_zeros() ffe_is_zeros_
+#define ffe_fixed_line_length() ffe_fixed_line_length_
+#define ffe_pool_file() (ffe_file_pool_)
+#define ffe_pool_any_unit() (ffe_any_unit_pool_)
+#define ffe_pool_program_unit() (ffe_program_unit_pool_)
+#define ffe_set_case_intrin(f) (ffe_case_intrin_ = (f))
+#define ffe_set_case_match(f) (ffe_case_match_ = (f))
+#define ffe_set_case_source(f) (ffe_case_source_ = (f))
+#define ffe_set_case_symbol(f) (ffe_case_symbol_ = (f))
+#define ffe_set_intrinsic_state_badu77(s) (ffe_intrinsic_state_badu77_ = (s))
+#define ffe_set_intrinsic_state_f2c(s) (ffe_intrinsic_state_f2c_ = (s))
+#define ffe_set_intrinsic_state_f90(s) (ffe_intrinsic_state_f90_ = (s))
+#define ffe_set_intrinsic_state_gnu(s) (ffe_intrinsic_state_gnu_ = (s))
+#define ffe_set_intrinsic_state_mil(s) (ffe_intrinsic_state_mil_ = (s))
+#define ffe_set_intrinsic_state_unix(s) (ffe_intrinsic_state_unix_ = (s))
+#define ffe_set_intrinsic_state_vxt(s) (ffe_intrinsic_state_vxt_ = (s))
+#define ffe_set_is_90(f) (ffe_is_90_ = (f))
+#define ffe_set_is_automatic(f) (ffe_is_automatic_ = (f))
+#define ffe_set_is_backslash(f) (ffe_is_backslash_ = (f))
+#define ffe_set_is_debug_kludge(f) (ffe_is_debug_kludge_ = (f))
+#define ffe_set_is_do_internal_checks(f) (ffe_set_is_do_internal_checks_ = (f))
+#define ffe_set_is_dollar_ok(f) (ffe_is_dollar_ok_ = (f))
+#define ffe_set_is_emulate_complex(f) (ffe_is_emulate_complex_ = (f))
+#define ffe_set_is_f2c(f) (ffe_is_f2c_ = (f))
+#define ffe_set_is_f2c_library(f) (ffe_is_f2c_library_ = (f))
+#define ffe_set_is_ffedebug(f) (ffe_is_ffedebug_ = (f))
+#define ffe_set_is_free_form(f) (ffe_is_free_form_ = (f))
+#define ffe_set_is_globals(f) (ffe_is_globals_ = (f))
+#define ffe_set_is_ident(f) (ffe_is_ident_ = (f))
+#define ffe_set_is_init_local_zero(f) (ffe_is_init_local_zero_ = (f))
+#define ffe_set_is_mainprog(f) (ffe_is_mainprog_ = (f))
+#define ffe_set_is_onetrip(f) (ffe_is_onetrip_ = (f))
+#define ffe_set_is_pedantic(f) (ffe_is_pedantic_ = (f))
+#define ffe_set_is_saveall(f) (ffe_is_saveall_ = (f))
+#define ffe_set_is_second_underscore(f) (ffe_is_second_underscore_ = (f))
+#define ffe_set_is_silent(f) (ffe_is_silent_ = (f))
+#define ffe_set_is_typeless_boz(f) (ffe_is_typeless_boz_ = (f))
+#define ffe_set_is_ugly_args(f) (ffe_is_ugly_args_ = (f))
+#define ffe_set_is_ugly_assign(f) (ffe_is_ugly_assign_ = (f))
+#define ffe_set_is_ugly_assumed(f) (ffe_is_ugly_assumed_ = (f))
+#define ffe_set_is_ugly_comma(f) (ffe_is_ugly_comma_ = (f))
+#define ffe_set_is_ugly_complex(f) (ffe_is_ugly_complex_ = (f))
+#define ffe_set_is_ugly_init(f) (ffe_is_ugly_init_ = (f))
+#define ffe_set_is_ugly_logint(f) (ffe_is_ugly_logint_ = (f))
+#define ffe_set_is_underscoring(f) (ffe_is_underscoring_ = (f))
+#define ffe_set_is_version(f) (ffe_is_version_ = (f))
+#define ffe_set_is_vxt(f) (ffe_is_vxt_ = (f))
+#define ffe_set_is_warn_globals(f) (ffe_is_warn_globals_ = (f))
+#define ffe_set_is_warn_implicit(f) (ffe_is_warn_implicit_ = (f))
+#define ffe_set_is_warn_surprising(f) (ffe_is_warn_surprising_ = (f))
+#define ffe_set_is_zeros(f) (ffe_is_zeros_ = (f))
+#define ffe_set_fixed_line_length(l) (ffe_fixed_line_length_ = (l))
+#define ffe_state_max(s1,s2) ((s1) > (s2) ? (s1) : (s2))
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/tree.j b/gcc/f/tree.j
new file mode 100644
index 00000000000..3b836b32819
--- /dev/null
+++ b/gcc/f/tree.j
@@ -0,0 +1,28 @@
+/* tree.j -- Wrapper for GCC's tree.h
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef MAKING_DEPENDENCIES
+#ifndef _J_f_tree
+#define _J_f_tree
+#include "config.j"
+#include "tree.h"
+#endif
+#endif
diff --git a/gcc/f/type.c b/gcc/f/type.c
new file mode 100644
index 00000000000..f359362849f
--- /dev/null
+++ b/gcc/f/type.c
@@ -0,0 +1,107 @@
+/* Implementation of Fortran type abstraction
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#include "proj.h"
+#include "type.h"
+#include "malloc.h"
+
+
+/* Look up a type given its base type and kind value. */
+
+ffetype
+ffetype_lookup_kind (ffetype base_type, int kind)
+{
+ if ((base_type->kinds_ == NULL)
+ || (kind < 0)
+ || (((size_t) kind) >= ARRAY_SIZE (base_type->kinds_->type_)))
+ return NULL;
+
+ return base_type->kinds_->type_[kind];
+}
+
+ffetype
+ffetype_lookup_star (ffetype base_type, int star)
+{
+ if ((base_type->stars_ == NULL)
+ || (star < 0)
+ || (((size_t) star) >= ARRAY_SIZE (base_type->stars_->type_)))
+ return NULL;
+
+ return base_type->stars_->type_[star];
+}
+
+ffetype
+ffetype_new (void)
+{
+ ffetype type;
+
+ type = (ffetype) malloc_new_kp (malloc_pool_image (), "ffetype",
+ sizeof (*type));
+ type->kinds_ = NULL;
+ type->stars_ = NULL;
+ type->alignment_ = 0;
+ type->modulo_ = 0;
+ type->size_ = 0;
+
+ return type;
+}
+
+void
+ffetype_set_kind (ffetype base_type, int kind, ffetype type)
+{
+ assert (kind < (int) sizeof (*(base_type->kinds_)));
+
+ if (base_type->kinds_ == NULL)
+ {
+ int i;
+
+ base_type->kinds_
+ = (ffetype_indexes_) malloc_new_kp (malloc_pool_image (),
+ "ffetype_indexes_[kinds]",
+ sizeof (*(base_type->kinds_)));
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (base_type->kinds_->type_); ++i)
+ base_type->kinds_->type_[i] = NULL;
+ }
+
+ assert (base_type->kinds_->type_[kind] == NULL);
+
+ base_type->kinds_->type_[kind] = type;
+}
+
+void
+ffetype_set_star (ffetype base_type, int star, ffetype type)
+{
+ if (base_type->stars_ == NULL)
+ {
+ int i;
+
+ base_type->stars_
+ = (ffetype_indexes_) malloc_new_kp (malloc_pool_image (),
+ "ffetype_indexes_[stars]",
+ sizeof (*(base_type->stars_)));
+ for (i = 0; ((size_t) i) < ARRAY_SIZE (base_type->stars_->type_); ++i)
+ base_type->stars_->type_[i] = NULL;
+ }
+
+ assert (base_type->stars_->type_[star] == NULL);
+
+ base_type->stars_->type_[star] = type;
+}
diff --git a/gcc/f/type.h b/gcc/f/type.h
new file mode 100644
index 00000000000..a89364fa4b9
--- /dev/null
+++ b/gcc/f/type.h
@@ -0,0 +1,64 @@
+/* Interface definitions for Fortran type abstraction
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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. */
+
+#ifndef _H_f_type
+#define _H_f_type
+
+typedef struct _ffetype_ *ffetype;
+typedef struct _ffetype_indexes_ *ffetype_indexes_;
+
+struct _ffetype_
+ {
+ ffetype_indexes_ kinds_;
+ ffetype_indexes_ stars_;
+ int alignment_;
+ int modulo_;
+ int size_;
+ };
+
+struct _ffetype_indexes_
+ {
+ ffetype type_[40]; /* *n, KIND=n: 0 <= n <= 39. */
+ };
+
+#define ffetype_alignment(t) ((t)->alignment_)
+#define ffetype_init_0()
+#define ffetype_init_1()
+#define ffetype_init_2()
+#define ffetype_init_3()
+#define ffetype_init_4()
+ffetype ffetype_lookup_kind (ffetype base_type, int kind);
+ffetype ffetype_lookup_star (ffetype base_type, int star);
+#define ffetype_modulo(t) ((t)->modulo_)
+ffetype ffetype_new (void);
+#define ffetype_set_ams(t,a,m,s) ((t)->alignment_ = (a), \
+ (t)->modulo_ = (m), \
+ (t)->size_ = (s))
+void ffetype_set_kind (ffetype base_type, int kind, ffetype type);
+void ffetype_set_star (ffetype base_type, int star, ffetype type);
+#define ffetype_size(t) ((t)->size_)
+#define ffetype_terminate_0()
+#define ffetype_terminate_1()
+#define ffetype_terminate_2()
+#define ffetype_terminate_3()
+#define ffetype_terminate_4()
+
+#endif
diff --git a/gcc/f/where.c b/gcc/f/where.c
new file mode 100644
index 00000000000..7442a5fac3a
--- /dev/null
+++ b/gcc/f/where.c
@@ -0,0 +1,542 @@
+/* where.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+
+ Description:
+ Simple data abstraction for Fortran source lines (called card images).
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "where.h"
+#include "lex.h"
+#include "malloc.h"
+
+/* Externals defined here. */
+
+struct _ffewhere_line_ ffewhere_unknown_line_
+=
+{NULL, NULL, 0, 0, 0};
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+typedef struct _ffewhere_ll_ *ffewhereLL_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffewhere_ll_
+ {
+ ffewhereLL_ next;
+ ffewhereLL_ previous;
+ ffewhereFile wf;
+ ffewhereLineNumber line_no; /* ffelex_line_number() at time of creation. */
+ ffewhereLineNumber offset; /* User-desired offset (usually 1). */
+ };
+
+struct _ffewhere_root_ll_
+ {
+ ffewhereLL_ first;
+ ffewhereLL_ last;
+ };
+
+struct _ffewhere_root_line_
+ {
+ ffewhereLine first;
+ ffewhereLine last;
+ ffewhereLineNumber none;
+ };
+
+/* Static objects accessed by functions in this module. */
+
+static struct _ffewhere_root_ll_ ffewhere_root_ll_;
+static struct _ffewhere_root_line_ ffewhere_root_line_;
+
+/* Static functions (internal). */
+
+static ffewhereLL_ ffewhere_ll_lookup_ (ffewhereLineNumber ln);
+
+/* Internal macros. */
+
+
+/* Look up line-to-line object from absolute line num. */
+
+static ffewhereLL_
+ffewhere_ll_lookup_ (ffewhereLineNumber ln)
+{
+ ffewhereLL_ ll;
+
+ if (ln == 0)
+ return ffewhere_root_ll_.first;
+
+ for (ll = ffewhere_root_ll_.last;
+ ll != (ffewhereLL_) &ffewhere_root_ll_.first;
+ ll = ll->previous)
+ {
+ if (ll->line_no <= ln)
+ return ll;
+ }
+
+ assert ("no line num" == NULL);
+ return NULL;
+}
+
+/* Kill file object.
+
+ Note that this object must not have been passed in a call
+ to any other ffewhere function except ffewhere_file_name and
+ ffewhere_file_namelen. */
+
+void
+ffewhere_file_kill (ffewhereFile wf)
+{
+ malloc_kill_ks (ffe_pool_file (), wf,
+ offsetof (struct _ffewhere_file_, text)
+ + wf->length + 1);
+}
+
+/* Create file object. */
+
+ffewhereFile
+ffewhere_file_new (char *name, size_t length)
+{
+ ffewhereFile wf;
+
+ wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile",
+ offsetof (struct _ffewhere_file_, text)
+ + length + 1);
+ wf->length = length;
+ memcpy (&wf->text[0], name, length);
+ wf->text[length] = '\0';
+
+ return wf;
+}
+
+/* Set file and first line number.
+
+ Pass FALSE if no line number is specified. */
+
+void
+ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln)
+{
+ ffewhereLL_ ll;
+
+ ll = malloc_new_kp (ffe_pool_file (), "ffewhereLL_", sizeof (*ll));
+ ll->next = (ffewhereLL_) &ffewhere_root_ll_.first;
+ ll->previous = ffewhere_root_ll_.last;
+ ll->next->previous = ll;
+ ll->previous->next = ll;
+ if (wf == NULL)
+ {
+ if (ll->previous == ll->next)
+ ll->wf = NULL;
+ else
+ ll->wf = ll->previous->wf;
+ }
+ else
+ ll->wf = wf;
+ ll->line_no = ffelex_line_number ();
+ if (have_num)
+ ll->offset = ln;
+ else
+ {
+ if (ll->previous == ll->next)
+ ll->offset = 1;
+ else
+ ll->offset
+ = ll->line_no - ll->previous->line_no + ll->previous->offset;
+ }
+}
+
+/* Do initializations. */
+
+void
+ffewhere_init_1 ()
+{
+ ffewhere_root_line_.first = ffewhere_root_line_.last
+ = (ffewhereLine) &ffewhere_root_line_.first;
+ ffewhere_root_line_.none = 0;
+
+ ffewhere_root_ll_.first = ffewhere_root_ll_.last
+ = (ffewhereLL_) &ffewhere_root_ll_.first;
+}
+
+/* Return the textual content of the line. */
+
+char *
+ffewhere_line_content (ffewhereLine wl)
+{
+ assert (wl != NULL);
+ return wl->content;
+}
+
+/* Look up file object from line object. */
+
+ffewhereFile
+ffewhere_line_file (ffewhereLine wl)
+{
+ ffewhereLL_ ll;
+
+ assert (wl != NULL);
+ ll = ffewhere_ll_lookup_ (wl->line_num);
+ return ll->wf;
+}
+
+/* Lookup file object from line object, calc line#. */
+
+ffewhereLineNumber
+ffewhere_line_filelinenum (ffewhereLine wl)
+{
+ ffewhereLL_ ll;
+
+ assert (wl != NULL);
+ ll = ffewhere_ll_lookup_ (wl->line_num);
+ return wl->line_num + ll->offset - ll->line_no;
+}
+
+/* Decrement use count for line, deallocate if no uses left. */
+
+void
+ffewhere_line_kill (ffewhereLine wl)
+{
+#if 0
+ if (!ffewhere_line_is_unknown (wl))
+ fprintf (dmpout, "; ffewhere_line_kill %" ffewhereLineNumber_f "u, uses=%"
+ ffewhereUses_f_ "u\n",
+ wl->line_num, wl->uses);
+#endif
+ assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
+ if (!ffewhere_line_is_unknown (wl) && (--wl->uses == 0))
+ {
+ wl->previous->next = wl->next;
+ wl->next->previous = wl->previous;
+ malloc_kill_ks (ffe_pool_file (), wl,
+ offsetof (struct _ffewhere_line_, content)
+ + wl->length + 1);
+ }
+}
+
+/* Make a new line or increment use count of existing one.
+
+ Find out where line object is, if anywhere. If in lexer, it might also
+ be at the end of the list of lines, else put it on the end of the list.
+ Then, if in the list of lines, increment the use count and return the
+ line object. Else, make an empty line object (no line) and return
+ that. */
+
+ffewhereLine
+ffewhere_line_new (ffewhereLineNumber ln)
+{
+ ffewhereLine wl = ffewhere_root_line_.last;
+
+ /* If this is the lexer's current line, see if it is already at the end of
+ the list, and if not, make it and return it. */
+
+ if (((ln == 0) /* Presumably asking for EOF pointer. */
+ || (wl->line_num != ln))
+ && (ffelex_line_number () == ln))
+ {
+#if 0
+ fprintf (dmpout,
+ "; ffewhere_line_new %" ffewhereLineNumber_f "u, lexer\n",
+ ln);
+#endif
+ wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
+ offsetof (struct _ffewhere_line_, content)
+ + (size_t) ffelex_line_length () + 1);
+ wl->next = (ffewhereLine) &ffewhere_root_line_;
+ wl->previous = ffewhere_root_line_.last;
+ wl->previous->next = wl;
+ wl->next->previous = wl;
+ wl->line_num = ln;
+ wl->uses = 1;
+ wl->length = ffelex_line_length ();
+ strcpy (wl->content, ffelex_line ());
+ return wl;
+ }
+
+ /* See if line is on list already. */
+
+ while (wl->line_num > ln)
+ wl = wl->previous;
+
+ /* If line is there, increment its use count and return. */
+
+ if (wl->line_num == ln)
+ {
+#if 0
+ fprintf (dmpout, "; ffewhere_line_new %" ffewhereLineNumber_f "u, uses=%"
+ ffewhereUses_f_ "u\n", ln,
+ wl->uses);
+#endif
+ wl->uses++;
+ return wl;
+ }
+
+ /* Else, make a new one with a blank line (since we've obviously lost it,
+ which should never happen) and return it. */
+
+ fprintf (stderr,
+ "(Cannot resurrect line %lu for error reporting purposes.)\n",
+ ln);
+
+ wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
+ offsetof (struct _ffewhere_line_, content)
+ + 1);
+ wl->next = (ffewhereLine) &ffewhere_root_line_;
+ wl->previous = ffewhere_root_line_.last;
+ wl->previous->next = wl;
+ wl->next->previous = wl;
+ wl->line_num = ln;
+ wl->uses = 1;
+ wl->length = 0;
+ *(wl->content) = '\0';
+ return wl;
+}
+
+/* Increment use count of line, as in a copy. */
+
+ffewhereLine
+ffewhere_line_use (ffewhereLine wl)
+{
+#if 0
+ fprintf (dmpout, "; ffewhere_line_use %" ffewhereLineNumber_f "u, uses=%" ffewhereUses_f_
+ "u\n", wl->line_num, wl->uses);
+#endif
+ assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
+ if (!ffewhere_line_is_unknown (wl))
+ ++wl->uses;
+ return wl;
+}
+
+/* Set an ffewhere object based on a track index.
+
+ Determines the absolute line and column number of a character at a given
+ index into an ffewhereTrack array. wr* is the reference position, wt is
+ the tracking information, and i is the index desired. wo* is set to wr*
+ plus the continual offsets described by wt[0...i-1], or unknown if any of
+ the continual offsets are not known. */
+
+void
+ffewhere_set_from_track (ffewhereLine *wol, ffewhereColumn *woc,
+ ffewhereLine wrl, ffewhereColumn wrc,
+ ffewhereTrack wt, ffewhereIndex i)
+{
+ ffewhereLineNumber ln;
+ ffewhereColumnNumber cn;
+ ffewhereIndex j;
+ ffewhereIndex k;
+
+ if ((i == 0) || (i >= FFEWHERE_indexMAX))
+ {
+ *wol = ffewhere_line_use (wrl);
+ *woc = ffewhere_column_use (wrc);
+ }
+ else
+ {
+ ln = ffewhere_line_number (wrl);
+ cn = ffewhere_column_number (wrc);
+ for (j = 0, k = 0; j < i; ++j, k += 2)
+ {
+ if ((wt[k] == FFEWHERE_indexUNKNOWN)
+ || (wt[k + 1] == FFEWHERE_indexUNKNOWN))
+ {
+ *wol = ffewhere_line_unknown ();
+ *woc = ffewhere_column_unknown ();
+ return;
+ }
+ if (wt[k] == 0)
+ cn += wt[k + 1] + 1;
+ else
+ {
+ ln += wt[k];
+ cn = wt[k + 1] + 1;
+ }
+ }
+ if (ln == ffewhere_line_number (wrl))
+ { /* Already have the line object, just use it
+ directly. */
+ *wol = ffewhere_line_use (wrl);
+ }
+ else /* Must search for the line object. */
+ *wol = ffewhere_line_new (ln);
+ *woc = ffewhere_column_new (cn);
+ }
+}
+
+/* Build next tracking index.
+
+ Set wt[i-1] continual offset so that it offsets from w* to (ln,cn). Update
+ w* to contain (ln,cn). DO NOT call this routine if i >= FFEWHERE_indexMAX
+ or i == 0. */
+
+void
+ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt,
+ ffewhereIndex i, ffewhereLineNumber ln,
+ ffewhereColumnNumber cn)
+{
+ unsigned int lo;
+ unsigned int co;
+
+ if ((ffewhere_line_is_unknown (*wl))
+ || (ffewhere_column_is_unknown (*wc))
+ || ((lo = ln - ffewhere_line_number (*wl)) >= FFEWHERE_indexUNKNOWN))
+ {
+ wt[i * 2 - 2] = wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
+ ffewhere_line_kill (*wl);
+ ffewhere_column_kill (*wc);
+ *wl = FFEWHERE_lineUNKNOWN;
+ *wc = FFEWHERE_columnUNKNOWN;
+ }
+ else if (lo == 0)
+ {
+ wt[i * 2 - 2] = 0;
+ if ((co = cn - ffewhere_column_number (*wc)) > FFEWHERE_indexUNKNOWN)
+ {
+ wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
+ ffewhere_line_kill (*wl);
+ ffewhere_column_kill (*wc);
+ *wl = FFEWHERE_lineUNKNOWN;
+ *wc = FFEWHERE_columnUNKNOWN;
+ }
+ else
+ {
+ wt[i * 2 - 1] = co - 1;
+ ffewhere_column_kill (*wc);
+ *wc = ffewhere_column_use (ffewhere_column_new (cn));
+ }
+ }
+ else
+ {
+ wt[i * 2 - 2] = lo;
+ if (cn > FFEWHERE_indexUNKNOWN)
+ {
+ wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
+ ffewhere_line_kill (*wl);
+ ffewhere_column_kill (*wc);
+ *wl = ffewhere_line_unknown ();
+ *wc = ffewhere_column_unknown ();
+ }
+ else
+ {
+ wt[i * 2 - 1] = cn - 1;
+ ffewhere_line_kill (*wl);
+ ffewhere_column_kill (*wc);
+ *wl = ffewhere_line_use (ffewhere_line_new (ln));
+ *wc = ffewhere_column_use (ffewhere_column_new (cn));
+ }
+ }
+}
+
+/* Clear tracking index for internally created track.
+
+ Set the tracking information to indicate that the tracking is at its
+ simplest (no spaces or newlines within the tracking). This means set
+ everything to zero in the current implementation. Length is the total
+ length of the token; length must be 2 or greater, since length-1 tracking
+ characters are set. */
+
+void
+ffewhere_track_clear (ffewhereTrack wt, ffewhereIndex length)
+{
+ ffewhereIndex i;
+
+ if (length > FFEWHERE_indexMAX)
+ length = FFEWHERE_indexMAX;
+
+ for (i = 1; i < length; ++i)
+ wt[i * 2 - 2] = wt[i * 2 - 1] = 0;
+}
+
+/* Copy tracking index from one place to another.
+
+ Copy tracking information from swt[start] to dwt[0] and so on, presumably
+ after an ffewhere_set_from_track call. Length is the total
+ length of the token; length must be 2 or greater, since length-1 tracking
+ characters are set. */
+
+void
+ffewhere_track_copy (ffewhereTrack dwt, ffewhereTrack swt, ffewhereIndex start,
+ ffewhereIndex length)
+{
+ ffewhereIndex i;
+ ffewhereIndex copy;
+
+ if (length > FFEWHERE_indexMAX)
+ length = FFEWHERE_indexMAX;
+
+ if (length + start > FFEWHERE_indexMAX)
+ copy = FFEWHERE_indexMAX - start;
+ else
+ copy = length;
+
+ for (i = 1; i < copy; ++i)
+ {
+ dwt[i * 2 - 2] = swt[(i + start) * 2 - 2];
+ dwt[i * 2 - 1] = swt[(i + start) * 2 - 1];
+ }
+
+ for (; i < length; ++i)
+ {
+ dwt[i * 2 - 2] = 0;
+ dwt[i * 2 - 1] = 0;
+ }
+}
+
+/* Kill tracking data.
+
+ Kill all the tracking information by killing incremented lines from the
+ first line number. */
+
+void
+ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc UNUSED,
+ ffewhereTrack wt, ffewhereIndex length)
+{
+ ffewhereLineNumber ln;
+ unsigned int lo;
+ ffewhereIndex i;
+
+ ln = ffewhere_line_number (wrl);
+
+ if (length > FFEWHERE_indexMAX)
+ length = FFEWHERE_indexMAX;
+
+ for (i = 0; i < length - 1; ++i)
+ {
+ if ((lo = wt[i * 2]) == FFEWHERE_indexUNKNOWN)
+ break;
+ else if (lo != 0)
+ {
+ ln += lo;
+ wrl = ffewhere_line_new (ln);
+ ffewhere_line_kill (wrl);
+ }
+ }
+}
diff --git a/gcc/f/where.h b/gcc/f/where.h
new file mode 100644
index 00000000000..aae031367d2
--- /dev/null
+++ b/gcc/f/where.h
@@ -0,0 +1,138 @@
+/* where.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ where.c
+
+ Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef _H_f_where
+#define _H_f_where
+
+/* Simple definitions and enumerations. */
+
+#define FFEWHERE_columnMAX UCHAR_MAX
+#define FFEWHERE_columnUNKNOWN 0
+#define FFEWHERE_indexMAX 36
+#define FFEWHERE_indexUNKNOWN UCHAR_MAX
+#define FFEWHERE_lineMAX ULONG_MAX
+#define FFEWHERE_lineUNKNOWN (&ffewhere_unknown_line_)
+#define FFEWHERE_filenameUNKNOWN ("(input file)")
+
+/* Typedefs. */
+
+typedef unsigned char ffewhereColumnNumber; /* Change FFEWHERE_columnMAX
+ too. */
+#define ffewhereColumnNumber_f ""
+typedef unsigned char ffewhereColumn;
+typedef struct _ffewhere_file_ *ffewhereFile;
+typedef unsigned short ffewhereLength_;
+#define ffewhereLength_f_ ""
+typedef unsigned long ffewhereLineNumber; /* Change FFEWHERE_lineMAX
+ too. */
+#define ffewhereLineNumber_f "l"
+typedef struct _ffewhere_line_ *ffewhereLine;
+typedef unsigned char ffewhereIndex;
+#define ffewhereIndex_f ""
+typedef ffewhereIndex ffewhereTrack[FFEWHERE_indexMAX * 2 - 2];
+typedef unsigned int ffewhereUses_;
+#define ffewhereUses_f_ ""
+
+/* Include files needed by this one. */
+
+#include "glimits.j"
+#include "top.h"
+
+/* Structure definitions. */
+
+struct _ffewhere_file_
+ {
+ size_t length;
+ char text[1];
+ };
+
+struct _ffewhere_line_
+ {
+ ffewhereLine next;
+ ffewhereLine previous;
+ ffewhereLineNumber line_num;
+ ffewhereUses_ uses;
+ ffewhereLength_ length;
+ char content[1];
+ };
+
+/* Global objects accessed by users of this module. */
+
+extern struct _ffewhere_line_ ffewhere_unknown_line_;
+
+/* Declare functions with prototypes. */
+
+void ffewhere_file_kill (ffewhereFile wf);
+ffewhereFile ffewhere_file_new (char *name, size_t length);
+void ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln);
+void ffewhere_init_1 (void);
+char *ffewhere_line_content (ffewhereLine l);
+ffewhereFile ffewhere_line_file (ffewhereLine l);
+ffewhereLineNumber ffewhere_line_filelinenum (ffewhereLine l);
+void ffewhere_line_kill (ffewhereLine l);
+ffewhereLine ffewhere_line_new (ffewhereLineNumber ln);
+ffewhereLine ffewhere_line_use (ffewhereLine wl);
+void ffewhere_set_from_track (ffewhereLine *wol, ffewhereColumn *woc,
+ ffewhereLine wrl, ffewhereColumn wrc, ffewhereTrack wt,
+ ffewhereIndex i);
+void ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt,
+ ffewhereIndex i, ffewhereLineNumber ln, ffewhereColumnNumber cn);
+void ffewhere_track_clear (ffewhereTrack wt, ffewhereIndex length);
+void ffewhere_track_copy (ffewhereTrack dwt, ffewhereTrack swt,
+ ffewhereIndex start, ffewhereIndex length);
+void ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc, ffewhereTrack wt,
+ ffewhereIndex length);
+
+/* Define macros. */
+
+#define ffewhere_column_is_unknown(c) (c == FFEWHERE_columnUNKNOWN)
+#define ffewhere_column_kill(c) ((void) 0)
+#define ffewhere_column_new(cn) (cn)
+#define ffewhere_column_number(c) (c)
+#define ffewhere_column_unknown() (FFEWHERE_columnUNKNOWN)
+#define ffewhere_column_use(c) (c)
+#define ffewhere_file_name(f) ((f)->text)
+#define ffewhere_file_namelen(f) ((f)->length)
+#define ffewhere_init_0()
+#define ffewhere_init_2()
+#define ffewhere_init_3()
+#define ffewhere_init_4()
+#define ffewhere_line_filename(l) (ffewhere_line_file(l)->text)
+#define ffewhere_line_is_unknown(l) (l == FFEWHERE_lineUNKNOWN)
+#define ffewhere_line_number(l) ((l)->line_num)
+#define ffewhere_line_unknown() (FFEWHERE_lineUNKNOWN)
+#define ffewhere_terminate_0()
+#define ffewhere_terminate_1()
+#define ffewhere_terminate_2()
+#define ffewhere_terminate_3()
+#define ffewhere_terminate_4()
+
+/* End of #include file. */
+
+#endif
diff --git a/gcc/f/zzz.c b/gcc/f/zzz.c
new file mode 100644
index 00000000000..cff8e54143f
--- /dev/null
+++ b/gcc/f/zzz.c
@@ -0,0 +1,56 @@
+/* zzz.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Related Modules:
+ None
+
+ Description:
+ Has the version number for the front end. Makes it easier to
+ tell how consistently patches have been applied, etc.
+
+ Modifications:
+*/
+
+#include "zzz.h"
+
+/* If you want to override the version date/time info with your own
+ macros, e.g. for a consistent distribution when bootstrapping,
+ go ahead! */
+
+#ifndef FFEZZZ_DATE
+#ifdef __DATE__
+#define FFEZZZ_DATE __DATE__
+#else /* !defined (__DATE__) */
+#define FFEZZZ_DATE "date unknown"
+#endif /* !defined (__DATE__) */
+#endif /* !defined (FFEZZZ_DATE) */
+
+#ifndef FFEZZZ_TIME
+#ifdef __TIME__
+#define FFEZZZ_TIME __TIME__
+#else /* !defined (__TIME__) */
+#define FFEZZZ_TIME "time unknown"
+#endif /* !defined (__TIME__) */
+#endif /* !defined (FFEZZZ_TIME) */
+
+char *ffezzz_version_string = "0.5.21-19970811";
+char *ffezzz_date = FFEZZZ_DATE;
+char *ffezzz_time = FFEZZZ_TIME;
diff --git a/gcc/f/zzz.h b/gcc/f/zzz.h
new file mode 100644
index 00000000000..9414f97f43e
--- /dev/null
+++ b/gcc/f/zzz.h
@@ -0,0 +1,35 @@
+/* zzz.h -- Public #include File (module.h template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+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.
+
+ Owning Modules:
+ zzz.c
+
+ Modifications:
+*/
+
+#ifndef _H_f_zzz
+#define _H_f_zzz
+
+extern char *ffezzz_version_string;
+extern char *ffezzz_date;
+extern char *ffezzz_time;
+
+#endif
diff --git a/include/COPYING b/include/COPYING
new file mode 100644
index 00000000000..60549be514a
--- /dev/null
+++ b/include/COPYING
@@ -0,0 +1,340 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, 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 software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, 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 redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+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 give any other recipients of the Program a copy of this License
+along with the Program.
+
+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 Program or any portion
+of it, thus forming a work based on the Program, 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) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+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 Program, 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 Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) 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; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, 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 executable. 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.
+
+If distribution of executable or 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 counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program 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.
+
+ 5. 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 Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program 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.
+
+ 7. 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 Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program 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 Program.
+
+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.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program 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.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the 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 Program
+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 Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, 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
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "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 PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. 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 PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ This program 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 of the License, or
+ (at your option) any later version.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) 19yy name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/include/ChangeLog b/include/ChangeLog
new file mode 100644
index 00000000000..984d4b7914e
--- /dev/null
+++ b/include/ChangeLog
@@ -0,0 +1,1254 @@
+Fri Aug 8 16:43:56 1997 Doug Evans <dje@canuck.cygnus.com>
+
+ * dis-asm.h (arc_get_disassembler): Declare.
+
+Wed Jul 30 11:39:50 1997 Per Bothner <bothner@deneb.cygnus.com>
+
+ * demangle.h (DMGL_JAVA): New option to request Java demangling.
+
+Tue Jul 22 17:59:54 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * libiberty.h (PEXECUTE_*): Define.
+ (pexecute, pwait): Declare.
+
+Fri Jun 6 13:02:33 1997 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * remote-sim.h (sim_kill): Mark as depreciated.
+
+Fri May 23 13:43:41 1997 Fred Fish <fnf@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Add task_link member.
+
+Thu May 22 11:32:49 1997 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * remote-sim.h: Review documentation. Clarify restrictions on
+ when functions can be called.
+
+Wed May 21 16:47:53 1997 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * remote-sim.h (sim_set_profile_size): Add prototype, document as
+ depreciated.
+
+Tue May 20 09:32:22 1997 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * remote-sim.h (sim_open): Add callback struct.
+ (sim_set_callbacks): Drop SIM_DESC argument. Document.
+ (sim_size): Remove recently added SIM_DESC argument. Document.
+
+Mon May 19 19:14:44 1997 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * remote-sim.h: Pass SD into sim_size.
+
+Thu May 15 01:24:16 1997 Mark Alexander <marka@cygnus.com>
+
+ * obstack.h (obstack_specify_allocation_with_arg, obstack_chunkfun,
+ obstack_freefun): Eliminate compile warnings in gdb.
+
+Tue May 13 10:21:14 1997 Nick Clifton <nickc@cygnus.com>
+
+ * coff/arm.h (constants): Added new flag bits F_APCS_26 and
+ F_APCS_SET for the f_flags field of the filehdr structure. Added new
+ flags: F_APCS26, F_ARM_2, F_ARM_3, F_ARM_7, F_ARM_7T to store
+ information in the flags field of the internal_f structure used by BFD
+ routines.
+
+Tue Apr 22 10:24:34 1997 Fred Fish <fnf@cygnus.com>
+
+ * floatformat.h (floatformat_byteorders): Add comments for previous
+ formats and add floatformat_littlebyte_bigword, primarily for ARM.
+ Add declaration for floatformat_ieee_double_littlebyte_bigword.
+
+Fri Apr 18 13:04:49 1997 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * remote-sim.h (sim_stop): New interface - asynchronous
+ notification of a request to stop / suspend the running
+ simulation.
+
+ * remote-sim.h (enum sim_stop): Add sim_running and sim_polling as
+ states for use internal to simulators.
+
+ * callback.h (struct host_callback_strut): Put a magic number at
+ the end of the struct to allow basic checking.
+ (struct host_callback_struct ): Add poll_quit - so
+ that the console etc can be polled at regular intervals.
+
+Thu Apr 17 02:17:12 1997 Doug Evans <dje@canuck.cygnus.com>
+
+ * remote-sim.h (struct _bfd): Declare.
+ (sim_load): Return SIM_RC. New arg `abfd'.
+ (sim_create_inferior): Return SIM_RC. Delete arg `start_address'.
+
+Wed Apr 2 17:09:12 1997 Andrew Cagney <cagney@kremvax.cygnus.com>
+
+ * remote-sim.h (sim_trace, sim_size): Make these global. They
+ will go away shortly.
+
+Wed Apr 2 15:23:49 1997 Doug Evans <dje@canuck.cygnus.com>
+
+ * remote-sim.h (SIM_OPEN_KIND, SIM_RC): New enums.
+ (sim_open): New argument `kind'.
+
+Wed Apr 2 14:45:51 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * COPYING: Update FSF address.
+
+Fri Mar 28 15:29:54 1997 Mike Meissner <meissner@cygnus.com>
+
+ * callback.h (top level): Include stdarg.h or varargs.h if
+ va_start is not defined.
+ (host_callback_struct): Make {,e}vprintf_filtered take a va_list
+ instead of void *, since va_list might be an array or structure
+ type.
+
+Fri Mar 28 15:44:41 1997 H.J. Lu <hjl@gnu.ai.mit.edu>
+
+ * libiberty.h (basename): Add prototype for glibc and linux.
+
+Mon Mar 17 19:22:12 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * objalloc.h: New file.
+
+Mon Mar 17 14:57:55 1997 Andrew Cagney <cagney@kremvax.cygnus.com>
+
+ * remote-sim.h: New file, copied in from gdb/remote-sim.h. One
+ day this will be placed in a directory of its own.
+
+Sat Mar 15 19:00:14 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * obstack.h: Update to current FSF version.
+
+Thu Mar 6 15:46:59 1997 Andrew Cagney <cagney@kremvax.cygnus.com>
+
+ * callback.h (struct host_callback_struct): Add callbacks -
+ flush_stdout, write_stderr, flush_stderr, vprintf_filtered,
+ evprintf_filtered. Delete redundant callbacks - printf_filtered.
+
+Thu Feb 27 23:18:27 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Remove lprefix and lprefix_len
+ fields.
+
+Tue Feb 25 00:10:49 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * dis-asm.h (INIT_DISASSEMBLE_INFO_NO_ARCH): Initialize
+ bytes_per_chunk and display_endian.
+
+Mon Feb 24 17:47:02 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ From Eric Youngdale <eric@andante.jic.com>:
+ * bfdlink.h (struct bfd_elf_version_expr): Define.
+ (struct bfd_elf_version_deps): Define.
+ (struct bfd_elf_version_tree): Define.
+
+Thu Feb 6 14:20:01 1997 Martin M. Hunt <hunt@pizza.cygnus.com>
+
+ * dis-asm.h: (disassemble_info): Add new fields
+ bytes_per_chunk and display_endian to control the
+ display of raw instructions.
+
+Sun Dec 8 17:11:12 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * callback.h (host_callback): New member `error'.
+
+Wed Nov 20 00:40:23 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * callback.h: New file, moved here from gdb.
+
+Mon Nov 18 16:34:00 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * libiberty.h: Checkin again; last checkin failed due to sticky tag.
+
+Wed Nov 13 08:22:00 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * libiberty.h: Revert last commit due to conflicts with hpux
+ system headers.
+
+Tue Nov 12 16:31:00 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * libiberty.h: Move prototypes from argv.c here.
+
+Thu Oct 31 14:56:18 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * ansidecl.h (VPARAMS,VA_START): Define.
+
+Fri Oct 25 12:08:04 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * dis-asm.h (disassemble_info): Add bytes_per_line field.
+ (INIT_DISASSEMBLE_INFO_NO_ARCH): Initialize bytes_per_line field.
+
+Thu Oct 24 17:10:01 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * dis-asm.h (disassemble_info): Add symbol field.
+ (INIT_DISASSEMBLE_INFO_NO_ARCH): Initialize symbol field.
+
+Thu Oct 17 11:17:40 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * dis-asm.h (print_insn_m32r): Declare.
+
+Mon Oct 14 23:56:52 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * libiberty.h: Declare parameter types for xmalloc and xrealloc.
+
+Thu Oct 3 13:45:27 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * fnmatch.h: New file.
+
+Thu Oct 3 10:33:14 1996 Jeffrey A Law (law@cygnus.com)
+
+ * dis-asm.h (print_insn_mn10x00): Delete declaration.
+ (print_insn_mn10200, print_insn_mn10300): Declare.
+
+Wed Oct 2 21:24:43 1996 Jeffrey A Law (law@cygnus.com)
+
+ * dis-asm.h (print_insn_mn10x00): Declare.
+
+Mon Sep 30 13:56:11 1996 Fred Fish <fnf@cygnus.com>
+
+ * libiberty.h: Remove #ifndef PRIVATE_XMALLOC.
+
+Tue Aug 13 16:10:30 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * obstack.h: Change bcopy to memcpy. Works better on Posix
+ systems, which generally lack bcopy.
+
+Mon Aug 12 17:03:18 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * ansidecl.h: Change WIN32 to _WIN32.
+
+Fri Jul 26 13:58:18 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * dis-asm.h: Add flavour field.
+ (print_insn_alpha): Declare.
+ (print_insn_alpha_osf, print_insn_alpha_vms): Don't declare.
+ (INIT_DISASSEMBLE_INFO): Initialize flavour field.
+
+Tue Jul 23 17:37:58 1996 Fred Fish <fnf@cygnus.com>
+
+ * libiberty.h (PRIVATE_XMALLOC): Enclose xmalloc/xrealloc
+ definitions inside #ifndef so that programs that want to
+ can define PRIVATE_XMALLOC and then define xmalloc and
+ xrealloc anyway they want.
+ (basename): Document in source that we can't declare the
+ parameter type because it is declared inconsistently across
+ different systems.
+
+Mon Jul 22 13:16:13 1996 Richard Henderson <rth@tamu.edu>
+
+ * dis-asm.h (print_insn_alpha): Don't declare.
+ (print_insn_alpha_osf, print_insn_alpha_vms): Declare.
+
+Wed Jul 17 14:45:12 1996 Martin M. Hunt <hunt@pizza.cygnus.com>
+
+ * dis-asm.h: (print_insn_d10v): Declare.
+
+Mon Jul 15 16:55:38 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * dis-asm.h: Get rid of decls for print_insn_i8086,
+ print_insn_sparc64 and print_insn_sparclite.
+ * (INIT_DISASSEMBLE_INFO): Split into two pieces. One,
+ INIT_DISASSEMBLE_INFO_NO_ARCH inits everything except for endian,
+ mach, and arch.
+
+Fri Jul 12 10:19:27 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * dis-asm.h (print_insn_i8086): Declare.
+
+Wed Jul 3 16:02:39 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * dis-asm.h (print_insn_sparclite): Declare.
+
+Tue Jun 18 16:02:46 1996 Jeffrey A. Law <law@rtl.cygnus.com>
+
+ * dis-asm.h (print_insn_h8300s): Declare.
+
+Tue Jun 18 15:11:33 1996 Klaus Kaempf <kkaempf@progis.de>
+
+ * fopen-vms.h: New file.
+
+Tue Jun 4 18:58:16 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Add notice_all field.
+
+Fri Apr 26 10:33:12 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * demangle.h (#ifdef IN_GCC): #include "gansidecl.h".
+ (PROTO,PTR,const): Delete.
+
+Mon Apr 22 17:27:42 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Add traditional_format field.
+
+Mon Apr 15 15:16:56 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * libiberty.h (choose_temp_base): Add prototype.
+
+Tue Mar 12 17:29:46 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (bfd_wrapped_link_hash_lookup): Declare.
+ (struct bfd_link_info): Add wrap_hash field.
+
+Wed Feb 14 16:49:17 1996 Martin Anantharaman <martin@mail.imech.uni-duisburg.de>
+
+ * ieee.h (ieee_record_enum_type): Define
+ ieee_external_reference_info_enum.
+
+Fri Feb 2 17:09:25 1996 Doug Evans <dje@charmed.cygnus.com>
+
+ * dis-asm.h (DISASM_RAW_INSN): Delete.
+
+Tue Jan 23 09:21:47 1996 Doug Evans <dje@charmed.cygnus.com>
+
+ * dis-asm.h (INIT_DISASSEMBLE_INFO): Set endian to BFD_ENDIAN_UNKNOWN.
+ New argument FPRINTF_FUNC.
+
+Mon Jan 22 16:37:59 1996 Doug Evans <dje@charmed.cygnus.com>
+
+ * dis-asm.h (disassemble_info): New members arch, mach, endian.
+ (INIT_DISASSEMBLE_INFO): Initialize them.
+ (DISASM_RAW_INSN{,FLAG}): Define.
+
+Thu Jan 18 11:32:38 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * demangle.h (cplus_demangle_opname): Change opname parameter to
+ const char *.
+ (cplus_mangle_opname): Change return type and opname parameter to
+ const char *.
+
+Fri Jan 5 00:01:22 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * ieee.h (enum ieee_record): Add ieee_asn_record_enum,
+ ieee_at_record_enum, ieee_ty_record_enum, ieee_atn_record_enum,
+ ieee_bb_record_enum, and ieee_be_record_enum.
+
+Wed Jan 3 13:12:09 1996 Fred Fish <fnf@cygnus.com>
+
+ * obstack.h: Update copyright to 1996.
+ (_obstack_memory_used): Declare.
+ (obstack_memory_used): Define macro.
+
+Thu Dec 28 11:42:12 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * libiberty.h (xstrdup): Declare.
+
+Thu Dec 21 14:47:17 1995 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * wait.h: Protect all macros with #ifndef.
+
+Tue Oct 24 21:45:40 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Add static_link field.
+
+Tue Sep 12 16:28:04 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_callbacks): Add symbol parameter to
+ warning callback.
+
+Fri Sep 1 13:11:51 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_callbacks): Change warning callback
+ to take BFD, section, and address arguments.
+
+Thu Aug 31 16:45:12 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Remove PE stuff.
+
+Tue Aug 22 03:18:23 1995 Ken Raeburn <raeburn@kr-laptop.cygnus.com>
+
+ * libiberty.h: Declare xstrerror. From Pat Rankin.
+
+Mon Aug 21 18:11:36 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Remove PE stuff.
+
+Wed Aug 2 08:14:12 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * dis-asm.h (print_insn_sparc64): Declare.
+
+Mon Jul 10 13:26:49 1995 Eric Youngdale <eric@aib.com>
+
+ * bfdlink.h (struct bfd_link_info): Add new field symbolic.
+
+Sun Jul 2 17:48:40 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Change type of base_file to
+ PTR.
+
+Thu Jun 29 00:02:45 1995 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * bfdlink.h (struct bfd_link_info): Added base_file member.
+
+Tue Jun 20 16:40:04 1995 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * ansidecl.h: win32s is ANSI enough.
+
+Thu May 18 04:25:50 1995 Ken Raeburn <raeburn@kr-laptop.cygnus.com>
+
+ Wed May 10 14:28:16 1995 Richard Earnshaw (rearnsha@armltd.co.uk)
+
+ * dis-asm.h (print_insn_arm): Delete declaration.
+ (print_insn_{little,big}_arm): New declarations.
+
+ * floatformat.h (floatformat_arm_ext): Declare.
+
+Sat May 13 10:14:08 1995 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * coff/pe.h: New file.
+ * bfdlink.h (subsytem, stack_heap_parameters): New.
+ * coff/i386.h (NT_SECTION_ALIGNMENT, NT_FILE_ALIGNMENT,
+ NT_DEF_RESERVE, NT_DEF_COMMIT): New.
+ * coff/internal.h (internal_filehdr): New fields for PE.
+ (IMAGE_DATA_DIRECTORY): New.
+ (internal_aouthdr): New fields for PE.
+
+Thu May 4 14:36:42 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * demangle.h: Don't include ansidecl.h if IN_GCC.
+
+Tue Feb 21 00:37:28 1995 Jeff Law (law@snake.cs.utah.edu)
+
+ * hp-symtab.h: Don't use bitfield enumerations, the HP C compiler
+ does not handle them correctly.
+
+Thu Feb 9 14:20:27 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * libiberty.h (basename): Don't declare parameter type; some
+ systems have this in their header files.
+
+Wed Feb 8 17:35:38 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (struct bfd_link_hash_entry): Change format of common
+ symbol information, to remove restrictions on maximum size and
+ alignment power, by using a pointer to a structure instead.
+
+Mon Feb 6 14:55:32 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * bfdlink.h (enum bfd_link_hash_type): Rename bfd_link_hash_weak
+ to bfd_link_hash_undefweak. Add bfd_link_hash_defweak.
+
+Mon Jan 16 21:00:23 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * dis-asm.h (GDB_INIT_DISASSEMBLE_INFO, etc): Remove all
+ GDB-specific definitions.
+
+Sun Jan 15 18:39:35 1995 Steve Chamberlain <sac@splat>
+
+ * dis-asm.h (print_insn_w65): Declare.
+
+Thu Jan 12 17:51:17 1995 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * libiberty.h (hex_p): Fix sense of test.
+
+Wed Jan 11 22:36:40 1995 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * libiberty.h (_hex_array_size, _hex_bad, _hex_value, hex_init,
+ hex_p, hex_value): New macros and declarations, for hex.c.
+
+Fri Jan 6 17:44:14 1995 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * dis-asm.h: Make idempotent.
+
+Wed Dec 14 13:08:43 1994 Stan Shebs <shebs@andros.cygnus.com>
+
+ * progress.h: New file, empty definitions for progress macros.
+
+Fri Nov 25 00:14:05 1994 Jeff Law (law@snake.cs.utah.edu)
+
+ * hp-symtab.h: New file describing the debug symbols emitted
+ by the HP C compilers.
+
+Fri Nov 11 15:48:37 1994 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * bfdlink.h (struct bfd_link_hash_entry): Change u.c.size from 24
+ to 26 bits, and change u.c.alignment_power from 8 to 6 bits. 6
+ bit in the alignment power is enough for a 64 bit address space.
+
+Mon Oct 31 13:02:51 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * demangle.h (cplus_mangle_opname): Declare.
+
+Tue Oct 25 11:38:02 1994 Ian Lance Taylor <ian@sanguine.cygnus.com>
+
+ * bfdlink.h (struct bfd_link_callbacks): Fix comments for
+ multiple_common field.
+
+Sun Sep 04 17:58:10 1994 Richard Earnshaw (rwe@pegasus.esprit.ec.org)
+
+ * aout/aout64.h: Only define QMAGIC if it isn't already defined.
+
+ * dis-asm.h: Add support for the ARM.
+
+Wed Aug 10 12:51:41 1994 Doug Evans (dje@canuck.cygnus.com)
+
+ * libiberty.h (strsignal): Document its existence even if we
+ can't declare it.
+
+Tue Aug 2 14:40:03 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * os9k.h: Remove u_int16, u_int32, and owner_id typedefs and
+ expand their uses. Those names conflict with Mach headers.
+
+Fri Jul 22 14:17:12 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * bfdlink.h (struct bfd_link_hash_entry): Change u.c.size into a
+ bitfield. Add field u.c.alignment_power.
+
+Sun Jul 10 00:26:39 1994 Ian Dall (dall@hfrd.dsto.gov.au)
+
+ * dis-asm.h: Add print_insn_ns32k declaration.
+
+Mon Jun 20 17:13:29 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * bfdlink.h (bfd_link_hash_table): Make creator a const pointer.
+
+Sat Jun 18 16:09:32 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * demangle.h (cplus_demangle_opname): Declare.
+
+Thu Jun 16 15:19:03 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * bfdlink.h (struct bfd_link_info): Add new field shared.
+
+Mon Jun 6 14:39:44 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * bfdlink.h (struct bfd_link_hash_entry): Remove written field:
+ not needed for all backends.
+
+Thu Apr 28 19:06:50 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ * dis-asm.h (disassembler): Declare.
+
+Fri Apr 1 00:38:17 1994 Jim Wilson (wilson@mole.gnu.ai.mit.edu)
+
+ * obstack.h: Delete use of IN_GCC to control whether
+ stddef.h or gstddef.h is included.
+
+Tue Mar 22 13:06:02 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * bfdlink.h (enum bfd_link_order_type): Add bfd_data_link_order.
+ (struct bfd_link_order): Add data field to union.
+
+Mon Mar 21 18:45:26 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * bfdlink.h (struct bfd_link_callbacks): Change bitsize argument
+ to add_to_set to reloc. Remove bitsize argument from constructor.
+ Comment that reloc_overflow, reloc_dangerous and unattached_reloc
+ must handle NULL pointers for reloc location.
+ (enum bfd_link_order_type): Add bfd_section_reloc_link_order and
+ bfd_symbol_reloc_link_order.
+ (struct bfd_link_order): Add reloc field to union.
+ (struct bfd_link_order_reloc): Define.
+
+Mon Mar 14 12:27:50 1994 Ian Lance Taylor (ian@cygnus.com)
+
+ * ieee-float.h: Removed; no longer used.
+
+Tue Mar 1 18:10:49 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * os9k.h: os9000 target specific header file, the header of the
+ object file is used now.
+
+Sun Feb 27 21:52:26 1994 Jim Kingdon (kingdon@deneb.cygnus.com)
+
+ * floatformat.h: New file, intended to replace ieee-float.h.
+
+Sun Feb 20 17:15:42 1994 Ian Lance Taylor (ian@lisa.cygnus.com)
+
+ * ansidecl.h (ANSI_PROTOTYPES): Define if using ANSI prototypes.
+
+Wed Feb 16 01:07:12 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * libiberty.h: Don't declare strsignal, to avoid conflicts with
+ Solaris system header files.
+
+Sat Feb 12 22:11:32 1994 Jeffrey A. Law (law@snake.cs.utah.edu)
+
+ * libiberty.h (xexit): Use __volatile__ to avoid losing if
+ compiling with gcc -traditional.
+
+Thu Feb 10 14:05:41 1994 Ian Lance Taylor (ian@cygnus.com)
+
+ * libiberty.h: New file. Declares functions provided by
+ libiberty.
+
+Tue Feb 8 05:19:52 1994 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ Handle obstack_chunk_alloc returning NULL. This allows
+ obstacks to be used by libraries, without forcing them
+ to call exit or longjmp.
+ * obstack.h (struct obstack): Add alloc_failed flag.
+ _obstack_begin, _obstack_begin_1): Declare to return int, not void.
+ (obstack_finish): If alloc_failed, return NULL.
+ (obstack_base, obstack_next_free, objstack_object_size):
+ If alloc_failed, return 0.
+ (obstack_grow, obstack_grow0, obstack_1grow, obstack_ptr_grow,
+ obstack_int_grow, obstack_blank): If alloc_failed, do nothing that
+ could corrupt the obstack.
+
+Mon Jan 24 15:06:05 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * bfdlink.h (struct bfd_link_callbacks): Add name, reloc_name and
+ addend argments to reloc_overflow callback.
+
+Fri Jan 21 19:13:12 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * dis-asm.h (print_insn_big_powerpc, print_insn_little_powerpc,
+ print_insn_rs6000): Declare.
+
+Thu Jan 6 14:15:55 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * bfdlink.h (struct bfd_link_callbacks): Add bitsize argument to
+ add_to_set field. Add new callback named constructor.
+
+Thu Dec 30 10:44:06 1993 Ian Lance Taylor (ian@rtl.cygnus.com)
+
+ * bfdlink.h: New file for new BFD linker backend routines.
+
+Mon Nov 29 10:43:57 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * dis-asm.h (enum dis_insn_tyupe): Remove non-ANSI trailing comma.
+
+Sat Oct 2 20:42:26 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * dis-asm.h: Move comment to right place.
+
+Mon Aug 9 19:03:35 1993 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ * obstack.h (obstack_chunkfun, obstack_freefun): Add defns from
+ previous version. Are these Cygnus local changes?
+
+Fri Aug 6 17:05:47 1993 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ * getopt.h, obstack.h: Update to latest FSF version.
+
+Mon Aug 2 16:37:14 1993 Stu Grossman (grossman at cygnus.com)
+
+ * coff/i386.h: Add Lynx magic number.
+
+Mon Aug 2 14:45:29 1993 John Gilmore (gnu@cygnus.com)
+
+ * dis-asm.h: Move enum outside of struct defn to avoid warnings.
+
+Mon Aug 2 08:49:30 1993 Stu Grossman (grossman at cygnus.com)
+
+ * wait.h (WEXITSTATUS, WSTOPSIG): Mask down to 8 bits. This is
+ for systems that store stuff into the high 16 bits of a wait
+ status.
+
+Fri Jul 30 18:38:02 1993 John Gilmore (gnu@cygnus.com)
+
+ * dis-asm.h: Add new fields insn_info_valid, branch_delay_insns,
+ data_size, insn_type, target, target2. These are used to return
+ information from the instruction decoders back to the calling
+ program. Add comments, make more readable.
+
+Mon Jul 19 22:14:14 1993 Fred Fish (fnf@deneb.cygnus.com)
+
+ * nlm: New directory containing NLM/NetWare includes.
+
+Thu Jul 15 12:10:04 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * dis-asm.h (struct disassemble_info): New field application_data.
+
+Thu Jul 15 12:41:15 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * dis-asm.h: Added declaration of print_insn_m88k.
+
+Thu Jul 8 09:05:26 1993 Doug Evans (dje@canuck.cygnus.com)
+
+ * opcode/h8300.h: Lots of little fixes for the h8/300h.
+
+Fri Jul 2 10:31:59 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * ansidecl.h: Use ANSI macros if __mips and _SYSTYPE_SVR4 are
+ defined, since RISC/OS cc handles ANSI declarations in SVR4 mode
+ but does not define __STDC__.
+
+Sun Jun 20 18:27:52 1993 Ken Raeburn (raeburn@poseidon.cygnus.com)
+
+ * dis-asm.h: Don't need to include ansidecl.h any more.
+
+Fri Jun 18 03:22:10 1993 John Gilmore (gnu@cygnus.com)
+
+ * oasys.h: Eliminate "int8_type", "int16_type", "int32_type", and
+ their variants. These changes are coordinated with corresponding
+ changes in ../bfd/oasys.c.
+
+Wed Jun 16 10:43:08 1993 Fred Fish (fnf@cygnus.com)
+
+ * bfd.h: Note that it has been removed.
+
+Tue Jun 8 12:16:03 1993 Steve Chamberlain (sac@phydeaux.cygnus.com)
+
+ Support for H8/300-H
+ * dis-asm.h (print_insn_h8300, print_insn_h8300h): Declare it.
+ * coff/h8300.h: New magic number.
+ * coff/internal.h: New relocations.
+ * opcode/h8300.h: Lots of new opcodes.
+
+Tue Jun 1 07:35:03 1993 Ken Raeburn (raeburn@kr-pc.cygnus.com)
+
+ * ansidecl.h (const): Don't define it if it's already defined.
+
+Thu May 27 18:19:51 1993 Ken Raeburn (raeburn@cambridge.cygnus.com)
+
+ * dis-asm.h (print_insn_hppa): Declare it.
+
+ * bfd.h: Moved to bfd directory. Small stub here includes it
+ without requiring "-I../bfd".
+
+Thu Apr 29 12:06:13 1993 Ken Raeburn (raeburn@deneb.cygnus.com)
+
+ * bfd.h: Updated with BSF_FUNCTION.
+
+Mon Apr 26 18:15:50 1993 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * bfd.h, dis-asm.h: Updated with Hitachi SH.
+
+Fri Apr 23 18:41:38 1993 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * bfd.h: Updated with alpha changes.
+ * dis-asm.h: Added alpha.
+
+Fri Apr 16 17:35:30 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * bfd.h: Update for signed bfd_*get_*.
+
+Thu Apr 15 09:24:21 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * bfd.h: Updated for file_truncated error.
+
+Thu Apr 8 10:53:47 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * ansidecl.h: If no ANSI, define const to be empty.
+
+Thu Apr 1 09:00:10 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * dis-asm.h: Declare a29k and i960 print_insn_*.
+
+ * dis-asm.h: Add print_address_func and related stuff.
+
+ * dis-asm.h (dis_asm_read_memory): Fix prototype.
+
+Wed Mar 31 17:40:16 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * dis-asm.h: Add print_insn_sparc.
+
+Wed Mar 31 17:51:42 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * bfd.h: Updated for BFD_RELOC_MIPS_GPREL and bfd_[gs]et_gp_size
+ prototypes.
+
+Wed Mar 31 16:35:12 1993 Stu Grossman (grossman@cygnus.com)
+
+ * dis-asm.h: (disassemble_info): Fix typo in prototype of
+ dis_asm_memory_error().
+
+Tue Mar 30 19:09:23 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * dis-asm.h (disassembler_info): Add read_memory_func,
+ memory_error_func, buffer, and length.
+ ({GDB_,}INIT_DISASSEMBLE_INFO): Set them.
+ print_insn_*: Remove second argument.
+
+Tue Mar 30 14:48:55 1993 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * bfd.h: Update for lma field of section.
+
+Tue Mar 30 12:22:55 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * ansidecl.h: Use ANSI versions on AIX regardless of __STDC__.
+
+Fri Mar 19 14:49:49 1993 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * dis-asm.h: Add h8500.
+
+Thu Mar 18 13:49:09 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * ieee-float.h: Moved from ../gdb.
+ * dis-asm.h: New file. Interface to dis-assembler.
+
+Thu Mar 11 10:52:57 1993 Fred Fish (fnf@cygnus.com)
+
+ * demangle.h (DMGL_NO_OPTS): Add define (set to 0) to use
+ in place of bare 0, for readability reasons.
+
+Tue Mar 2 17:50:11 1993 Fred Fish (fnf@cygnus.com)
+
+ * demangle.h: Replace all references to cfront with ARM.
+
+Tue Feb 23 12:21:14 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * bfd.h: Update for new elements in JUMP_TABLE.
+
+Tue Feb 16 00:51:30 1993 John Gilmore (gnu@cygnus.com)
+
+ * bfd.h: Update for BFD_VERSION 2.1.
+
+Tue Jan 26 11:49:20 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * bfd.h: Update for SEC_IS_COMMON flag.
+
+Tue Jan 19 12:25:12 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * bfd.h: Update for bfd_asymbol_value bug fix.
+
+Fri Jan 8 16:37:18 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * bfd.h: Update to include ECOFF tdata and target_flavour.
+
+Sun Dec 27 17:52:30 1992 Fred Fish (fnf@cygnus.com)
+
+ * bfd.h: Add declaration for bfd_get_size().
+
+Tue Dec 22 22:42:46 1992 Fred Fish (fnf@cygnus.com)
+
+ * demangle.h: Protect file from multiple inclusions with
+ #if !defined(DEMANGLE_H)...#define DEMANGLE_H...#endif.
+
+Mon Dec 21 21:25:50 1992 Stu Grossman (grossman at cygnus.com)
+
+ * bfd.h: Update to get hppa_core_struct from bfd.c.
+
+Thu Dec 17 00:42:35 1992 John Gilmore (gnu@cygnus.com)
+
+ * bfd.h: Update to get tekhex tdata name change from bfd.
+
+Mon Nov 9 23:55:42 1992 John Gilmore (gnu@cygnus.com)
+
+ * ansidecl.h: Update comments to discourage use of EXFUN.
+
+Thu Nov 5 16:35:44 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * bfd.h: Update to bring in SEC_SHARED_LIBRARY.
+
+Thu Nov 5 03:21:32 1992 John Gilmore (gnu@cygnus.com)
+
+ * bfd.h: Update to match EXFUN, bfd_seclet_struct, and SDEF
+ cleanups in bfd.
+
+Wed Nov 4 07:28:05 1992 Ken Raeburn (raeburn@cygnus.com)
+
+ * bout.h (N_CALLNAME, N_BALNAME): Define as char-type values, so
+ widening works consistently.
+
+Fri Oct 16 03:17:08 1992 John Gilmore (gnu@cygnus.com)
+
+ * getopt.h: Update to Revised Standard FSF Version.
+
+Thu Oct 15 21:43:22 1992 K. Richard Pixley (rich@sendai.cygnus.com)
+
+ * getopt.h (struct option): use the provided enum for has_arg.
+
+ * demangle.h (AUTO_DEMANGLING, GNU_DEMANGLING,
+ LUCID_DEMANGLING): ultrix compilers require enums to be
+ enums and ints to be ints and casts where they meet. cast some
+ enums into ints.
+
+Thu Oct 15 04:35:51 1992 John Gilmore (gnu@cygnus.com)
+
+ * bfd.h: Update after comment changes.
+
+Thu Oct 8 09:03:02 1992 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * bfd.h (bfd_get_symbol_leading_char): new macro for getting in xvec
+
+Thu Sep 3 09:10:50 1992 Stu Grossman (grossman at cygnus.com)
+
+ * bfd.h (struct reloc_howto_struct): size needs to be signed if
+ it's going to hold negative values.
+
+Sun Aug 30 17:50:27 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * demangle.h: New file, moved from ../gdb. Made independent
+ of gdb. Allow demangling style option to be passed as a
+ parameter to cplus_demangle(), but using the
+ current_demangling_style global as the default.
+
+Sat Aug 29 10:07:55 1992 Fred Fish (fnf@cygnus.com)
+
+ * obstack.h: Merge comment change from current FSF version.
+
+Thu Aug 27 12:59:29 1992 Brendan Kehoe (brendan@cygnus.com)
+
+ * bfd.h: add we32k
+
+Tue Aug 25 15:07:47 1992 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * bfd.h: new after Z8000 stuff
+
+Mon Aug 17 09:01:23 1992 Ken Raeburn (raeburn@cygnus.com)
+
+ * bfd.h: Regenerated after page/segment size changes.
+
+Sat Aug 1 13:46:31 1992 Fred Fish (fnf@cygnus.com)
+
+ * obstack.h: Merge changes from current FSF version.
+
+Mon Jul 20 21:06:23 1992 Fred Fish (fnf@cygnus.com)
+
+ * obstack.h (area_id, flags): Remove, replace with extra_arg,
+ use_extra_arg, and maybe_empty_object.
+ * obstack.h (OBSTACK_MAYBE_EMPTY_OBJECT, OBSTACK_MMALLOC_LIKE):
+ Remove, replaced by maybe_empty_object and use_extra_arg bitfields.
+ * obstack.h (obstack_full_begin, _obstack_begin): Remove area_id
+ and flags arguments.
+ * obstack.h (obstack_alloc_arg): New macro to set extra_arg.
+
+Thu Jul 16 08:12:44 1992 Steve Chamberlain (sac@thepub.cygnus.com)
+
+ * bfd.h: new after adding BFD_IS_RELAXABLE
+
+Sat Jul 4 03:22:23 1992 John Gilmore (gnu at cygnus.com)
+
+ * bfd.h: Regen after adding BSF_FILE.
+
+Mon Jun 29 14:18:36 1992 Fred Fish (fnf at sunfish)
+
+ * obstack.h: Convert bcopy() use to memcpy(), which is more
+ portable, more standard, and can take advantage of gcc's builtin
+ functions for increased performance.
+
+Thu Jun 25 04:46:08 1992 John Gilmore (gnu at cygnus.com)
+
+ * ansidecl.h (PARAMS): Incorporate this macro from gdb's defs.h.
+ It's a cleaner way to forward-declare function prototypes.
+
+Fri Jun 19 15:46:32 1992 Stu Grossman (grossman at cygnus.com)
+
+ * bfd.h: HPPA merge.
+
+Tue Jun 16 21:30:56 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * getopt.h: gratuitous white space changes merged from other prep
+ releases.
+
+Thu Jun 11 01:10:55 1992 John Gilmore (gnu at cygnus.com)
+
+ * bfd.h: Regen'd from bfd.c after removing elf_core_tdata_struct.
+
+Mon May 18 17:29:03 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * getopt.h: merged changes from make-3.62.11.
+
+ * getopt.h: merged changes from grep-1.6 (alpha).
+
+Fri May 8 14:53:32 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * getopt.h: merged changes from bison-1.18.
+
+Sat Mar 14 17:25:20 1992 Fred Fish (fnf@cygnus.com)
+
+ * obstack.h: Add "area_id" and "flags" members to obstack
+ structure. Add obstack_chunkfun() and obstack_freefun() to
+ set functions explicitly. Convert maybe_empty_object to
+ a bit in "flags".
+
+Thu Feb 27 22:01:02 1992 Per Bothner (bothner@cygnus.com)
+
+ * wait.h (WIFSTOPPED): Add IBM rs6000-specific version.
+
+Fri Feb 21 20:49:20 1992 John Gilmore (gnu at cygnus.com)
+
+ * obstack.h: Add obstack_full_begin.
+ * bfd.h, obstack.h: Protolint.
+
+Thu Jan 30 01:18:42 1992 John Gilmore (gnu at cygnus.com)
+
+ * bfd.h: Remove comma from enum declaration.
+
+Mon Jan 27 22:01:13 1992 Steve Chamberlain (sac at cygnus.com)
+
+ * bfd.h : new target entr, bfd_relax_section
+
+Wed Dec 18 17:19:44 1991 Stu Grossman (grossman at cygnus.com)
+
+ * bfd.h, ieee.h, opcode/m68k.h, opcode/sparc.h: ANSIfy enums.
+
+Thu Dec 12 20:59:56 1991 John Gilmore (gnu at cygnus.com)
+
+ * fopen-same.h, fopen-bin.h: New files for configuring
+ whether fopen distinguishes binary files or not. For use
+ by host-dependent config files.
+
+Sat Nov 30 20:46:43 1991 Steve Chamberlain (sac at rtl.cygnus.com)
+
+ * bfd.h: change the documentation format.
+
+ * created coff, elf and opcode and aout directories. Moved:
+
+ aout64.h ==> aout/aout64.h
+ ar.h ==> aout/ar.h
+ a.out.encap.h ==> aout/encap.h
+ a.out.host.h ==> aout/host.h
+ a.out.hp.h ==> aout/hp.h
+ a.out.sun4.h ==> aout/sun4.h
+ ranlib.h ==> aout/ranlib.h
+ reloc.h ==> aout/reloc.h
+ stab.def ==> aout/stab.def
+ stab.gnu.h ==> aout/stab_gnu.h
+
+ coff-a29k.h ==> coff/a29k.h
+ coff-h8300.h ==> coff/h8300.h
+ coff-i386.h ==> coff/i386.h
+ coff-i960.h ==> coff/i960.h
+ internalcoff.h ==> coff/internal.h
+ coff-m68k.h ==> coff/m68k.h
+ coff-m88k.h ==> coff/m88k.h
+ coff-mips.h ==> coff/mips.h
+ coff-rs6000.h ==> coff/rs6000.h
+
+ elf-common.h ==> elf/common.h
+ dwarf.h ==> elf/dwarf.h
+ elf-external.h ==> elf/external.h
+ elf-internal.h ==> elf/internal.h
+
+ a29k-opcode.h ==> opcode/a29k.h
+ arm-opcode.h ==> opcode/arm.h
+ h8300-opcode.h ==> opcode/h8300.h
+ i386-opcode.h ==> opcode/i386.h
+ i860-opcode.h ==> opcode/i860.h
+ i960-opcode.h ==> opcode/i960.h
+ m68k-opcode.h ==> opcode/m68k.h
+ m88k-opcode.h ==> opcode/m88k.h
+ mips-opcode.h ==> opcode/mips.h
+ np1-opcode.h ==> opcode/np1.h
+ ns32k-opcode.h ==> opcode/ns32k.h
+ pn-opcode.h ==> opcode/pn.h
+ pyr-opcode.h ==> opcode/pyr.h
+ sparc-opcode.h ==> opcode/sparc.h
+ tahoe-opcode.h ==> opcode/tahoe.h
+ vax-opcode.h ==> opcode/vax.h
+
+
+
+Wed Nov 27 10:38:31 1991 Steve Chamberlain (sac at rtl.cygnus.com)
+
+ * internalcoff.h: (internal_scnhdr) took out #def dependency, now
+ s_nreloc and s_nlnno are always long. (internal_reloc): allways
+ has an offset field now.
+
+Fri Nov 22 08:12:58 1991 John Gilmore (gnu at cygnus.com)
+
+ * coff-rs6000.h: Lint; use unsigned chars for external fields.
+ * internalcoff.h: Lint; cast storage classes to signed char.
+
+Thu Nov 21 21:01:05 1991 Per Bothner (bothner at cygnus.com)
+
+ * stab.def: Remove the GNU extended type codes (e.g. N_SETT).
+ * aout64.h: The heuristic for distinguishing between
+ sunos-style and bsd-style ZMAGIC files (wrt. where the
+ text segment starts) is moved into (the default definition of)
+ the macro N_HEADER_IN_TEXT. This definition is only used
+ if no other definition is used - e.g. bfd/newsos3.c defines
+ N_HEADER_IN_TEXT(x) to be always 0 (as before).
+
+Thu Nov 21 11:53:03 1991 John Gilmore (gnu at cygnus.com)
+
+ * aout64.h (N_TXTADDR, N_TXTOFF, N_TXTSIZE): New definitions
+ that should handle all uses. LOGICAL_ versions deleted.
+ Eliminate N_HEADER_IN_TEXT, using a_entry to determine which
+ kind of zmagic a.out file we are looking at.
+ * coff-rs6000.h: Typo.
+
+Tue Nov 19 18:43:37 1991 Per Bothner (bothner at cygnus.com)
+
+ (Note: This is a revised entry, as was aout64.h.)
+ * aout64.h: Some cleanups of N_TXTADDR and N_TXTOFF:
+ Will now work for both old- and new-style ZMAGIC files,
+ depending on N_HEADER_IN_TEXT macro.
+ Add LOGICAL_TXTADDR, LOICAL_TXTOFF and LOGICAL_TXTSIZE
+ that don't count the exec header as part
+ of the text segment, to be consistent with bfd.
+ * a.out.sun4.h: Simplified/fixed for previous change.
+
+Mon Nov 18 00:02:06 1991 Fred Fish (fnf at cygnus.com)
+
+ * dwarf.h: Update to DWARF draft 5 version from gcc2.
+
+Thu Nov 14 19:44:59 1991 Per Bothner (bothner at cygnus.com)
+
+ * stab.def: Added defs for extended GNU symbol types,
+ such as N_SETT. These are normally ifdef'd out (because
+ of conflicts with a.out.gnu.h), but are used by bfb_stab_name().
+
+Thu Nov 14 19:17:03 1991 Fred Fish (fnf at cygnus.com)
+
+ * elf-common.h: Add defines to support ELF symbol table code.
+
+Mon Nov 11 19:01:06 1991 Fred Fish (fnf at cygnus.com)
+
+ * elf-internal.h, elf-external.h, elf-common.h: Add support for
+ note sections, which are used in ELF core files to hold copies
+ of various /proc structures.
+
+Thu Nov 7 08:58:26 1991 Steve Chamberlain (sac at cygnus.com)
+
+ * internalcoff.h: took out the M88 dependency in the lineno
+ struct.
+ * coff-m88k.h: defines GET_LINENO_LNNO and PUT_LINENO_LNNO to use
+ 32bit linno entries.
+ * a29k-opcode.h: fixed encoding of mtacc
+
+Sun Nov 3 11:54:22 1991 Per Bothner (bothner at cygnus.com)
+
+ * bfd.h: Updated from ../bfd/bfd-in.h (q.v).
+
+Fri Nov 1 11:13:53 1991 John Gilmore (gnu at cygnus.com)
+
+ * internalcoff.h: Add x_csect defines.
+
+Fri Oct 25 03:18:20 1991 John Gilmore (gnu at cygnus.com)
+
+ * Rename COFF-related files in `coff-ARCH.h' form.
+ coff-a29k.h, coff-i386.h, coff-i960.h, coff-m68k.h, coff-m88k.h,
+ coff-mips.h, coff-rs6000.h to be exact.
+
+Thu Oct 24 22:11:11 1991 John Gilmore (gnu at cygnus.com)
+
+ RS/6000 support, by Metin G. Ozisik, Mimi Phûông-Thåo Võ, and
+ John Gilmore.
+
+ * a.out.gnu.h: Update slightly.
+ * bfd.h: Add new error code, fix doc, add bfd_arch_rs6000.
+ * internalcoff.h: Add more F_ codes for filehdr. Add
+ rs/6000-dependent fields to aouthdr. Add storage classes
+ to syments. Add 6000-specific auxent. Add r_size in reloc.
+ * rs6000coff.c: New file.
+
+Thu Oct 24 04:13:20 1991 Fred Fish (fnf at cygnus.com)
+
+ * dwarf.h: New file for dwarf support. Copied from gcc2
+ distribution.
+
+Wed Oct 16 13:31:45 1991 John Gilmore (gnu at cygnus.com)
+
+ * aout64.h: Remove PAGE_SIZE defines; they are target-dependent.
+ Add N_FN_SEQ for N_FN symbol type used on Sequent machines.
+ * stab.def: Include N_FN_SEQ in table.
+ * bout.h: External formats of structures use unsigned chars.
+
+Fri Oct 11 12:40:43 1991 Steve Chamberlain (steve at cygnus.com)
+
+ * bfd.h:upgrade from bfd.c
+ * internalcoff.h: add n_name, n_zeroes and n_offset macros
+ * amdcoff.h: Define OMAGIC and AOUTHDRSZ.
+
+Fri Oct 11 10:58:06 1991 Per Bothner (bothner at cygnus.com)
+
+ * a.out.host.h: Change SEGMENT_SIZE to 0x1000 for Sony.
+ * bfd.h (align_power): Add (actually move) comment.
+
+Tue Oct 8 15:29:32 1991 Per Bothner (bothner at cygnus.com)
+
+ * sys/h-rtbsd.h: Define MISSING_VFPRINT (for binutils/bucomm.c).
+
+Sun Oct 6 19:24:39 1991 John Gilmore (gnu at cygnus.com)
+
+ * aout64.h: Move struct internal_exec to ../bfd/libaout.h so
+ it can be shared by all `a.out-family' code. Rename
+ EXTERNAL_LIST_SIZE to EXTERNAL_NLIST_SIZE. Use basic types
+ for nlist members, and make strx integral rather than pointer.
+ More commentary on n_type values.
+ * bout.h: Provide a struct external_exec rather than an
+ internal_exec.
+ * m68kcoff.h: Remove `tagentries' which snuck in from the i960
+ COFF port.
+
+Fri Oct 4 01:25:59 1991 John Gilmore (gnu at cygnus.com)
+
+ * h8300-opcode.h: Remove `_enum' from the typedef for an enum.
+ * bfd.h: Update to match bfd changes.
+
+ * sys/h-i386mach.h, sysdep.h: Add 386 Mach host support.
+
+Tue Oct 1 04:58:42 1991 John Gilmore (gnu at cygnus.com)
+
+ * bfd.h, elf-common.h, elf-external.h, elf-internal.h:
+ Add preliminary ELF support, sufficient for GDB, from Fred Fish.
+ * sysdep.h, sys/h-amix.h: Support Amiga SVR4.
+
+ * sys/h-vaxult.h: Make it work. (David Taylor <taylor@think.com>)
+ * a.out.vax.h: Remove unused and confusing file.
+
+Mon Sep 30 12:52:35 1991 Per Bothner (bothner at cygnus.com)
+
+ * sysdep.h: Define NEWSOS3_SYS, and use it.
+
+Fri Sep 20 13:38:21 1991 John Gilmore (gnu at cygnus.com)
+
+ * a.out.gnu.h (N_FN): Its value *really is* 0x1F.
+ Fix it, and add comments warning about or-ing N_EXT with it
+ and/or N_WARNING.
+ * aout64.h (N_FN): Fix value, add comments about N_EXT.
+ * stab.def (table at end): Update to show all the type
+ values <0x20, including low order bits. Move N_FN to
+ its rightful place.
+
+Tue Sep 17 17:41:37 1991 Stu Grossman (grossman at cygnus.com)
+
+ * sys/h-irix3.h: sgi/irix support.
+
+Tue Sep 17 07:52:59 1991 John Gilmore (gnu at cygint.cygnus.com)
+
+ * stab.def (N_DEFD): Add GNU Modula-2 debug stab, from Andrew
+ Beers.
+
+Thu Sep 12 14:12:59 1991 John Gilmore (gnu at cygint.cygnus.com)
+
+ * internalcoff.h (SYMNMLEN, FILNMLEN, DIMNUM): Define these
+ for internalcoff, separately from the various external coff's.
+ * amdcoff.h, bcs88kcoff.h, i386coff.h, intel-coff.h, m68kcoff.h,
+ m88k-bcs.h: Prefix SYMNMLEN, FILNMLEN, and DIMNUM with E_'s for
+ the external struct definitions.
+ * ecoff.h: Remove these #define's, kludge no longer needed.
+
+ * sys/h-ultra3.h: Add new Ultracomputer host.
+ * sysdep.h: Add ULTRA3_SYM1_SYS and use it.
+
+Tue Sep 10 10:11:46 1991 John Gilmore (gnu at cygint.cygnus.com)
+
+ * i386coff.h (LINESZ): Always 6, not based on sizeof().
+ (Fix from Peter Schauer <pes@regent.e-technik.tu-muenchen.de>.)
+
+Wed Sep 4 08:58:37 1991 John Gilmore (gnu at cygint.cygnus.com)
+
+ * a.out.gnu.h, aout64.h: Add N_WARNING. Change N_FN to 0x0E,
+ to match SunOS and BSD. Add N_COMM as 0x12 for SunOS shared lib
+ support.
+ * stab.def: Add N_COMM to table, fix overlap comment.
+
+Tue Sep 3 06:29:20 1991 John Gilmore (gnu at cygint.cygnus.com)
+
+ Merge with latest FSF versions of these files.
+
+ * stab.gnu.h: Add LAST_UNUSED_STAB_CODE.
+ * stab.def: Update to GPL2. Move N_WARNING out, since not a
+ debug symbol. Change comments, and reorder table to numeric
+ order. Update final table comment.
+ (N_DSLINE, N_BSLINE): Renumber from 0x66 and 0x68, to 0x46 and 0x48.
+
+ * obstack.h: GPL2. Merge.
+
+Fri Aug 23 01:54:23 1991 John Gilmore (gnu at cygint.cygnus.com)
+
+ * a.out.gnu.h, a.out.sun4.h: Make SEGMENT_SIZE able to depend
+ on the particular a.out being examined.
+ * a.out.sun4.h: Define segment sizes for Sun-3's and Sun-4's.
+ * FIXME: a.out.gnu.h is almost obsolete.
+ * FIXME: a.out.sun4.h should be renamed a.out.sun.h now.
+
+Wed Aug 21 20:32:13 1991 John Gilmore (gnu at cygint.cygnus.com)
+
+ * Start a ChangeLog for the includes directory.
+
+ * a.out.gnu.h (N_FN): Fix value -- was 15, should be 0x1E.
+ * stab.def: Update allocation table in comments at end,
+ to reflect reality as I know it.
+
+
+Local Variables:
+mode: change-log
+left-margin: 8
+fill-column: 74
+version-control: never
+End:
diff --git a/include/ansidecl.h b/include/ansidecl.h
new file mode 100644
index 00000000000..abe87a9390b
--- /dev/null
+++ b/include/ansidecl.h
@@ -0,0 +1,154 @@
+/* ANSI and traditional C compatability macros
+ Copyright 1991, 1992, 1996 Free Software Foundation, Inc.
+ This file is part of the GNU C Library.
+
+This program 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 of the License, or
+(at your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+/* ANSI and traditional C compatibility macros
+
+ ANSI C is assumed if __STDC__ is #defined.
+
+ Macro ANSI C definition Traditional C definition
+ ----- ---- - ---------- ----------- - ----------
+ PTR `void *' `char *'
+ LONG_DOUBLE `long double' `double'
+ VOLATILE `volatile' `'
+ SIGNED `signed' `'
+ PTRCONST `void *const' `char *'
+ ANSI_PROTOTYPES 1 not defined
+
+ CONST is also defined, but is obsolete. Just use const.
+
+ obsolete -- DEFUN (name, arglist, args)
+
+ Defines function NAME.
+
+ ARGLIST lists the arguments, separated by commas and enclosed in
+ parentheses. ARGLIST becomes the argument list in traditional C.
+
+ ARGS list the arguments with their types. It becomes a prototype in
+ ANSI C, and the type declarations in traditional C. Arguments should
+ be separated with `AND'. For functions with a variable number of
+ arguments, the last thing listed should be `DOTS'.
+
+ obsolete -- DEFUN_VOID (name)
+
+ Defines a function NAME, which takes no arguments.
+
+ obsolete -- EXFUN (name, (prototype)) -- obsolete.
+
+ Replaced by PARAMS. Do not use; will disappear someday soon.
+ Was used in external function declarations.
+ In ANSI C it is `NAME PROTOTYPE' (so PROTOTYPE should be enclosed in
+ parentheses). In traditional C it is `NAME()'.
+ For a function that takes no arguments, PROTOTYPE should be `(void)'.
+
+ obsolete -- PROTO (type, name, (prototype) -- obsolete.
+
+ This one has also been replaced by PARAMS. Do not use.
+
+ PARAMS ((args))
+
+ We could use the EXFUN macro to handle prototype declarations, but
+ the name is misleading and the result is ugly. So we just define a
+ simple macro to handle the parameter lists, as in:
+
+ static int foo PARAMS ((int, char));
+
+ This produces: `static int foo();' or `static int foo (int, char);'
+
+ EXFUN would have done it like this:
+
+ static int EXFUN (foo, (int, char));
+
+ but the function is not external...and it's hard to visually parse
+ the function name out of the mess. EXFUN should be considered
+ obsolete; new code should be written to use PARAMS.
+
+ DOTS is also obsolete.
+
+ Examples:
+
+ extern int printf PARAMS ((const char *format, ...));
+*/
+
+#ifndef _ANSIDECL_H
+
+#define _ANSIDECL_H 1
+
+
+/* Every source file includes this file,
+ so they will all get the switch for lint. */
+/* LINTLIBRARY */
+
+
+#if defined (__STDC__) || defined (_AIX) || (defined (__mips) && defined (_SYSTYPE_SVR4)) || defined(_WIN32)
+/* All known AIX compilers implement these things (but don't always
+ define __STDC__). The RISC/OS MIPS compiler defines these things
+ in SVR4 mode, but does not define __STDC__. */
+
+#define PTR void *
+#define PTRCONST void *CONST
+#define LONG_DOUBLE long double
+
+#define AND ,
+#define NOARGS void
+#define VOLATILE volatile
+#define SIGNED signed
+
+#define PARAMS(paramlist) paramlist
+#define ANSI_PROTOTYPES 1
+
+#define VPARAMS(ARGS) ARGS
+#define VA_START(va_list,var) va_start(va_list,var)
+
+/* These are obsolete. Do not use. */
+#define CONST const
+#define DOTS , ...
+#define PROTO(type, name, arglist) type name arglist
+#define EXFUN(name, proto) name proto
+#define DEFUN(name, arglist, args) name(args)
+#define DEFUN_VOID(name) name(void)
+
+#else /* Not ANSI C. */
+
+#define PTR char *
+#define PTRCONST PTR
+#define LONG_DOUBLE double
+
+#define AND ;
+#define NOARGS
+#ifndef const /* some systems define it in header files for non-ansi mode */
+#define const
+#endif
+#define VOLATILE
+#define SIGNED
+
+#define PARAMS(paramlist) ()
+
+#define VPARAMS(ARGS) (va_alist) va_dcl
+#define VA_START(va_list,var) va_start(va_list)
+
+/* These are obsolete. Do not use. */
+#define CONST
+#define DOTS
+#define PROTO(type, name, arglist) type name ()
+#define EXFUN(name, proto) name()
+#define DEFUN(name, arglist, args) name arglist args;
+#define DEFUN_VOID(name) name()
+
+#endif /* ANSI C. */
+
+#endif /* ansidecl.h */
diff --git a/include/demangle.h b/include/demangle.h
new file mode 100644
index 00000000000..00f6a0c3bc0
--- /dev/null
+++ b/include/demangle.h
@@ -0,0 +1,90 @@
+/* Defs for interface to demanglers.
+ Copyright 1992, 1995, 1996 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+
+#if !defined (DEMANGLE_H)
+#define DEMANGLE_H
+
+#ifdef IN_GCC
+#include "gansidecl.h"
+#define PARAMS(ARGS) PROTO(ARGS)
+#else /* ! IN_GCC */
+#include <ansidecl.h>
+#endif /* IN_GCC */
+
+/* Options passed to cplus_demangle (in 2nd parameter). */
+
+#define DMGL_NO_OPTS 0 /* For readability... */
+#define DMGL_PARAMS (1 << 0) /* Include function args */
+#define DMGL_ANSI (1 << 1) /* Include const, volatile, etc */
+#define DMGL_JAVA (1 << 2) /* Demangle as Java rather than C++. */
+
+#define DMGL_AUTO (1 << 8)
+#define DMGL_GNU (1 << 9)
+#define DMGL_LUCID (1 << 10)
+#define DMGL_ARM (1 << 11)
+/* If none of these are set, use 'current_demangling_style' as the default. */
+#define DMGL_STYLE_MASK (DMGL_AUTO|DMGL_GNU|DMGL_LUCID|DMGL_ARM)
+
+/* Enumeration of possible demangling styles.
+
+ Lucid and ARM styles are still kept logically distinct, even though
+ they now both behave identically. The resulting style is actual the
+ union of both. I.E. either style recognizes both "__pt__" and "__rf__"
+ for operator "->", even though the first is lucid style and the second
+ is ARM style. (FIXME?) */
+
+extern enum demangling_styles
+{
+ unknown_demangling = 0,
+ auto_demangling = DMGL_AUTO,
+ gnu_demangling = DMGL_GNU,
+ lucid_demangling = DMGL_LUCID,
+ arm_demangling = DMGL_ARM
+} current_demangling_style;
+
+/* Define string names for the various demangling styles. */
+
+#define AUTO_DEMANGLING_STYLE_STRING "auto"
+#define GNU_DEMANGLING_STYLE_STRING "gnu"
+#define LUCID_DEMANGLING_STYLE_STRING "lucid"
+#define ARM_DEMANGLING_STYLE_STRING "arm"
+
+/* Some macros to test what demangling style is active. */
+
+#define CURRENT_DEMANGLING_STYLE current_demangling_style
+#define AUTO_DEMANGLING (((int) CURRENT_DEMANGLING_STYLE) & DMGL_AUTO)
+#define GNU_DEMANGLING (((int) CURRENT_DEMANGLING_STYLE) & DMGL_GNU)
+#define LUCID_DEMANGLING (((int) CURRENT_DEMANGLING_STYLE) & DMGL_LUCID)
+#define ARM_DEMANGLING (CURRENT_DEMANGLING_STYLE & DMGL_ARM)
+
+extern char *
+cplus_demangle PARAMS ((const char *mangled, int options));
+
+extern int
+cplus_demangle_opname PARAMS ((const char *opname, char *result, int options));
+
+extern const char *
+cplus_mangle_opname PARAMS ((const char *opname, int options));
+
+/* Note: This sets global state. FIXME if you care about multi-threading. */
+
+extern void
+set_cplus_marker_for_demangling PARAMS ((int ch));
+
+#endif /* DEMANGLE_H */
diff --git a/include/floatformat.h b/include/floatformat.h
new file mode 100644
index 00000000000..90daca21bcb
--- /dev/null
+++ b/include/floatformat.h
@@ -0,0 +1,111 @@
+/* IEEE floating point support declarations, for GDB, the GNU Debugger.
+ Copyright (C) 1991 Free Software Foundation, Inc.
+
+This file is part of GDB.
+
+This program 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 of the License, or
+(at your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#if !defined (FLOATFORMAT_H)
+#define FLOATFORMAT_H 1
+
+#include "ansidecl.h"
+
+/* A floatformat consists of a sign bit, an exponent and a mantissa. Once the
+ bytes are concatenated according to the byteorder flag, then each of those
+ fields is contiguous. We number the bits with 0 being the most significant
+ (i.e. BITS_BIG_ENDIAN type numbering), and specify which bits each field
+ contains with the *_start and *_len fields. */
+
+/* What is the order of the bytes. */
+
+enum floatformat_byteorders {
+
+ /* Standard little endian byte order.
+ EX: 1.2345678e10 => 00 00 80 c5 e0 fe 06 42 */
+
+ floatformat_little,
+
+ /* Standard big endian byte order.
+ EX: 1.2345678e10 => 42 06 fe e0 c5 80 00 00 */
+
+ floatformat_big,
+
+ /* Little endian byte order but big endian word order.
+ EX: 1.2345678e10 => e0 fe 06 42 00 00 80 c5 */
+
+ floatformat_littlebyte_bigword
+
+};
+
+enum floatformat_intbit { floatformat_intbit_yes, floatformat_intbit_no };
+
+struct floatformat
+{
+ enum floatformat_byteorders byteorder;
+ unsigned int totalsize; /* Total size of number in bits */
+
+ /* Sign bit is always one bit long. 1 means negative, 0 means positive. */
+ unsigned int sign_start;
+
+ unsigned int exp_start;
+ unsigned int exp_len;
+ /* Amount added to "true" exponent. 0x3fff for many IEEE extendeds. */
+ unsigned int exp_bias;
+ /* Exponent value which indicates NaN. This is the actual value stored in
+ the float, not adjusted by the exp_bias. This usually consists of all
+ one bits. */
+ unsigned int exp_nan;
+
+ unsigned int man_start;
+ unsigned int man_len;
+
+ /* Is the integer bit explicit or implicit? */
+ enum floatformat_intbit intbit;
+};
+
+/* floatformats for IEEE single and double, big and little endian. */
+
+extern const struct floatformat floatformat_ieee_single_big;
+extern const struct floatformat floatformat_ieee_single_little;
+extern const struct floatformat floatformat_ieee_double_big;
+extern const struct floatformat floatformat_ieee_double_little;
+
+/* floatformat for ARM IEEE double, little endian bytes and big endian words */
+
+extern const struct floatformat floatformat_ieee_double_littlebyte_bigword;
+
+/* floatformats for various extendeds. */
+
+extern const struct floatformat floatformat_i387_ext;
+extern const struct floatformat floatformat_m68881_ext;
+extern const struct floatformat floatformat_i960_ext;
+extern const struct floatformat floatformat_m88110_ext;
+extern const struct floatformat floatformat_arm_ext;
+
+/* Convert from FMT to a double.
+ FROM is the address of the extended float.
+ Store the double in *TO. */
+
+extern void
+floatformat_to_double PARAMS ((const struct floatformat *, char *, double *));
+
+/* The converse: convert the double *FROM to FMT
+ and store where TO points. */
+
+extern void
+floatformat_from_double PARAMS ((const struct floatformat *,
+ double *, char *));
+
+#endif /* defined (FLOATFORMAT_H) */
diff --git a/include/fnmatch.h b/include/fnmatch.h
new file mode 100644
index 00000000000..1a653ab6314
--- /dev/null
+++ b/include/fnmatch.h
@@ -0,0 +1,69 @@
+/* Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc.
+
+NOTE: The canonical source of this file is maintained with the GNU C Library.
+Bugs can be reported to bug-glibc@prep.ai.mit.edu.
+
+This program 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.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef _FNMATCH_H
+
+#define _FNMATCH_H 1
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if defined (__cplusplus) || (defined (__STDC__) && __STDC__)
+#undef __P
+#define __P(args) args
+#else /* Not C++ or ANSI C. */
+#undef __P
+#define __P(args) ()
+/* We can get away without defining `const' here only because in this file
+ it is used only inside the prototype for `fnmatch', which is elided in
+ non-ANSI C where `const' is problematical. */
+#endif /* C++ or ANSI C. */
+
+
+/* We #undef these before defining them because some losing systems
+ (HP-UX A.08.07 for example) define these in <unistd.h>. */
+#undef FNM_PATHNAME
+#undef FNM_NOESCAPE
+#undef FNM_PERIOD
+
+/* Bits set in the FLAGS argument to `fnmatch'. */
+#define FNM_PATHNAME (1 << 0) /* No wildcard can ever match `/'. */
+#define FNM_NOESCAPE (1 << 1) /* Backslashes don't quote special chars. */
+#define FNM_PERIOD (1 << 2) /* Leading `.' is matched only explicitly. */
+
+#if !defined (_POSIX_C_SOURCE) || _POSIX_C_SOURCE < 2 || defined (_GNU_SOURCE)
+#define FNM_FILE_NAME FNM_PATHNAME /* Preferred GNU name. */
+#define FNM_LEADING_DIR (1 << 3) /* Ignore `/...' after a match. */
+#define FNM_CASEFOLD (1 << 4) /* Compare without regard to case. */
+#endif
+
+/* Value returned by `fnmatch' if STRING does not match PATTERN. */
+#define FNM_NOMATCH 1
+
+/* Match STRING against the filename pattern PATTERN,
+ returning zero if it matches, FNM_NOMATCH if not. */
+extern int fnmatch __P ((const char *__pattern, const char *__string,
+ int __flags));
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* fnmatch.h */
diff --git a/include/getopt.h b/include/getopt.h
new file mode 100644
index 00000000000..abf91538320
--- /dev/null
+++ b/include/getopt.h
@@ -0,0 +1,129 @@
+/* Declarations for getopt.
+ Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 program; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifndef _GETOPT_H
+#define _GETOPT_H 1
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* For communication from `getopt' to the caller.
+ When `getopt' finds an option that takes an argument,
+ the argument value is returned here.
+ Also, when `ordering' is RETURN_IN_ORDER,
+ each non-option ARGV-element is returned here. */
+
+extern char *optarg;
+
+/* Index in ARGV of the next element to be scanned.
+ This is used for communication to and from the caller
+ and for communication between successive calls to `getopt'.
+
+ On entry to `getopt', zero means this is the first call; initialize.
+
+ When `getopt' returns EOF, this is the index of the first of the
+ non-option elements that the caller should itself scan.
+
+ Otherwise, `optind' communicates from one call to the next
+ how much of ARGV has been scanned so far. */
+
+extern int optind;
+
+/* Callers store zero here to inhibit the error message `getopt' prints
+ for unrecognized options. */
+
+extern int opterr;
+
+/* Set to an option character which was unrecognized. */
+
+extern int optopt;
+
+/* Describe the long-named options requested by the application.
+ The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
+ of `struct option' terminated by an element containing a name which is
+ zero.
+
+ The field `has_arg' is:
+ no_argument (or 0) if the option does not take an argument,
+ required_argument (or 1) if the option requires an argument,
+ optional_argument (or 2) if the option takes an optional argument.
+
+ If the field `flag' is not NULL, it points to a variable that is set
+ to the value given in the field `val' when the option is found, but
+ left unchanged if the option is not found.
+
+ To have a long-named option do something other than set an `int' to
+ a compiled-in constant, such as set a value from `optarg', set the
+ option's `flag' field to zero and its `val' field to a nonzero
+ value (the equivalent single-letter option character, if there is
+ one). For long options that have a zero `flag' field, `getopt'
+ returns the contents of the `val' field. */
+
+struct option
+{
+#if __STDC__
+ const char *name;
+#else
+ char *name;
+#endif
+ /* has_arg can't be an enum because some compilers complain about
+ type mismatches in all the code that assumes it is an int. */
+ int has_arg;
+ int *flag;
+ int val;
+};
+
+/* Names for the values of the `has_arg' field of `struct option'. */
+
+#define no_argument 0
+#define required_argument 1
+#define optional_argument 2
+
+#if __STDC__
+#if defined(__GNU_LIBRARY__)
+/* Many other libraries have conflicting prototypes for getopt, with
+ differences in the consts, in stdlib.h. To avoid compilation
+ errors, only prototype getopt for the GNU C library. */
+extern int getopt (int argc, char *const *argv, const char *shortopts);
+#else /* not __GNU_LIBRARY__ */
+extern int getopt ();
+#endif /* not __GNU_LIBRARY__ */
+extern int getopt_long (int argc, char *const *argv, const char *shortopts,
+ const struct option *longopts, int *longind);
+extern int getopt_long_only (int argc, char *const *argv,
+ const char *shortopts,
+ const struct option *longopts, int *longind);
+
+/* Internal only. Users should not call this directly. */
+extern int _getopt_internal (int argc, char *const *argv,
+ const char *shortopts,
+ const struct option *longopts, int *longind,
+ int long_only);
+#else /* not __STDC__ */
+extern int getopt ();
+extern int getopt_long ();
+extern int getopt_long_only ();
+
+extern int _getopt_internal ();
+#endif /* not __STDC__ */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GETOPT_H */
diff --git a/include/libiberty.h b/include/libiberty.h
new file mode 100644
index 00000000000..893d2a93729
--- /dev/null
+++ b/include/libiberty.h
@@ -0,0 +1,161 @@
+/* Function declarations for libiberty.
+ Written by Cygnus Support, 1994.
+
+ The libiberty library provides a number of functions which are
+ missing on some operating systems. We do not declare those here,
+ to avoid conflicts with the system header files on operating
+ systems that do support those functions. In this file we only
+ declare those functions which are specific to libiberty. */
+
+#ifndef LIBIBERTY_H
+#define LIBIBERTY_H
+
+#include "ansidecl.h"
+
+/* Build an argument vector from a string. Allocates memory using
+ malloc. Use freeargv to free the vector. */
+
+extern char **buildargv PARAMS ((char *));
+
+/* Free a vector returned by buildargv. */
+
+extern void freeargv PARAMS ((char **));
+
+/* Return the last component of a path name. Note that we can't use a
+ prototype here because the parameter is declared inconsistently
+ across different systems, sometimes as "char *" and sometimes as
+ "const char *" */
+
+#if defined(__GNU_LIBRARY__ ) || defined (__linux__)
+extern char *basename PARAMS ((const char *));
+#else
+extern char *basename ();
+#endif
+
+/* Concatenate an arbitrary number of strings, up to (char *) NULL.
+ Allocates memory using xmalloc. */
+
+extern char *concat PARAMS ((const char *, ...));
+
+/* Check whether two file descriptors refer to the same file. */
+
+extern int fdmatch PARAMS ((int fd1, int fd2));
+
+/* Get the amount of time the process has run, in microseconds. */
+
+extern long get_run_time PARAMS ((void));
+
+/* Choose a temporary directory to use for scratch files. */
+
+extern char *choose_temp_base PARAMS ((void));
+
+/* Allocate memory filled with spaces. Allocates using malloc. */
+
+extern const char *spaces PARAMS ((int count));
+
+/* Return the maximum error number for which strerror will return a
+ string. */
+
+extern int errno_max PARAMS ((void));
+
+/* Return the name of an errno value (e.g., strerrno (EINVAL) returns
+ "EINVAL"). */
+
+extern const char *strerrno PARAMS ((int));
+
+/* Given the name of an errno value, return the value. */
+
+extern int strtoerrno PARAMS ((const char *));
+
+/* ANSI's strerror(), but more robust. */
+
+extern char *xstrerror PARAMS ((int));
+
+/* Return the maximum signal number for which strsignal will return a
+ string. */
+
+extern int signo_max PARAMS ((void));
+
+/* Return a signal message string for a signal number
+ (e.g., strsignal (SIGHUP) returns something like "Hangup"). */
+/* This is commented out as it can conflict with one in system headers.
+ We still document its existence though. */
+
+/*extern const char *strsignal PARAMS ((int));*/
+
+/* Return the name of a signal number (e.g., strsigno (SIGHUP) returns
+ "SIGHUP"). */
+
+extern const char *strsigno PARAMS ((int));
+
+/* Given the name of a signal, return its number. */
+
+extern int strtosigno PARAMS ((const char *));
+
+/* Register a function to be run by xexit. Returns 0 on success. */
+
+extern int xatexit PARAMS ((void (*fn) (void)));
+
+/* Exit, calling all the functions registered with xatexit. */
+
+#ifndef __GNUC__
+extern void xexit PARAMS ((int status));
+#else
+typedef void libiberty_voidfn PARAMS ((int status));
+__volatile__ libiberty_voidfn xexit;
+#endif
+
+/* Set the program name used by xmalloc. */
+
+extern void xmalloc_set_program_name PARAMS ((const char *));
+
+/* Allocate memory without fail. If malloc fails, this will print a
+ message to stderr (using the name set by xmalloc_set_program_name,
+ if any) and then call xexit. */
+
+#ifdef ANSI_PROTOTYPES
+/* Get a definition for size_t. */
+#include <stddef.h>
+#endif
+extern PTR xmalloc PARAMS ((size_t));
+
+/* Reallocate memory without fail. This works like xmalloc.
+
+ FIXME: We do not declare the parameter types for the same reason as
+ xmalloc. */
+
+extern PTR xrealloc PARAMS ((PTR, size_t));
+
+/* Copy a string into a memory buffer without fail. */
+
+extern char *xstrdup PARAMS ((const char *));
+
+/* hex character manipulation routines */
+
+#define _hex_array_size 256
+#define _hex_bad 99
+extern char _hex_value[_hex_array_size];
+extern void hex_init PARAMS ((void));
+#define hex_p(c) (hex_value (c) != _hex_bad)
+/* If you change this, note well: Some code relies on side effects in
+ the argument being performed exactly once. */
+#define hex_value(c) (_hex_value[(unsigned char) (c)])
+
+/* Definitions used by the pexecute routine. */
+
+#define PEXECUTE_FIRST 1
+#define PEXECUTE_LAST 2
+#define PEXECUTE_ONE (PEXECUTE_FIRST + PEXECUTE_LAST)
+#define PEXECUTE_SEARCH 4
+#define PEXECUTE_VERBOSE 8
+
+/* Execute a program. */
+
+extern int pexecute PARAMS ((const char *, char * const *, const char *,
+ const char *, char **, char **, int));
+
+/* Wait for pexecute to finish. */
+
+extern int pwait PARAMS ((int, int *, int));
+
+#endif /* ! defined (LIBIBERTY_H) */
diff --git a/include/objalloc.h b/include/objalloc.h
new file mode 100644
index 00000000000..24f87f8749d
--- /dev/null
+++ b/include/objalloc.h
@@ -0,0 +1,115 @@
+/* objalloc.h -- routines to allocate memory for objects
+ Copyright 1997 Free Software Foundation, Inc.
+ Written by Ian Lance Taylor, Cygnus Solutions.
+
+This program 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.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef OBJALLOC_H
+#define OBJALLOC_H
+
+#include "ansidecl.h"
+
+/* These routines allocate space for an object. The assumption is
+ that the object will want to allocate space as it goes along, but
+ will never want to free any particular block. There is a function
+ to free a block, which also frees all more recently allocated
+ blocks. There is also a function to free all the allocated space.
+
+ This is essentially a specialization of obstacks. The main
+ difference is that a block may not be allocated a bit at a time.
+ Another difference is that these routines are always built on top
+ of malloc, and always pass an malloc failure back to the caller,
+ unlike more recent versions of obstacks. */
+
+/* This is what an objalloc structure looks like. Callers should not
+ refer to these fields, nor should they allocate these structure
+ themselves. Instead, they should only create them via
+ objalloc_init, and only access them via the functions and macros
+ listed below. The structure is only defined here so that we can
+ access it via macros. */
+
+struct objalloc
+{
+ char *current_ptr;
+ unsigned int current_space;
+ PTR chunks;
+};
+
+/* Work out the required alignment. */
+
+struct objalloc_align { char x; double d; };
+
+#if defined (__STDC__) && __STDC__
+#ifndef offsetof
+#include <stddef.h>
+#endif
+#define OBJALLOC_ALIGN \
+ ((ptrdiff_t) ((char *) &((struct objalloc_align *) 0)->d - (char *) 0))
+#else
+#define OBJALLOC_ALIGN \
+ ((long) ((char *) &((struct objalloc_align *) 0)->d - (char *) 0))
+#endif
+
+/* Create an objalloc structure. Returns NULL if malloc fails. */
+
+extern struct objalloc *objalloc_create PARAMS ((void));
+
+/* Allocate space from an objalloc structure. Returns NULL if malloc
+ fails. */
+
+extern PTR _objalloc_alloc PARAMS ((struct objalloc *, unsigned long));
+
+/* The macro version of objalloc_alloc. We only define this if using
+ gcc, because otherwise we would have to evaluate the arguments
+ multiple times, or use a temporary field as obstack.h does. */
+
+#if defined (__GNUC__) && defined (__STDC__) && __STDC__
+
+/* NextStep 2.0 cc is really gcc 1.93 but it defines __GNUC__ = 2 and
+ does not implement __extension__. But that compiler doesn't define
+ __GNUC_MINOR__. */
+#if __GNUC__ < 2 || (__NeXT__ && !__GNUC_MINOR__)
+#define __extension__
+#endif
+
+#define objalloc_alloc(o, l) \
+ __extension__ \
+ ({ struct objalloc *__o = (o); \
+ unsigned long __len = (l); \
+ if (__len == 0) \
+ __len = 1; \
+ __len = (__len + OBJALLOC_ALIGN - 1) &~ (OBJALLOC_ALIGN - 1); \
+ (__len <= __o->current_space \
+ ? (__o->current_ptr += __len, \
+ __o->current_space -= __len, \
+ (PTR) (__o->current_ptr - __len)) \
+ : _objalloc_alloc (__o, __len)); })
+
+#else /* ! __GNUC__ */
+
+#define objalloc_alloc(o, l) _objalloc_alloc ((o), (l))
+
+#endif /* ! __GNUC__ */
+
+/* Free an entire objalloc structure. */
+
+extern void objalloc_free PARAMS ((struct objalloc *));
+
+/* Free a block allocated by objalloc_alloc. This also frees all more
+ recently allocated blocks. */
+
+extern void objalloc_free_block PARAMS ((struct objalloc *, PTR));
+
+#endif /* OBJALLOC_H */
diff --git a/include/obstack.h b/include/obstack.h
new file mode 100644
index 00000000000..ffc6b9ecfca
--- /dev/null
+++ b/include/obstack.h
@@ -0,0 +1,570 @@
+/* obstack.h - object stack macros
+ Copyright (C) 1988,89,90,91,92,93,94,96 Free Software Foundation, Inc.
+
+This program 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.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Summary:
+
+All the apparent functions defined here are macros. The idea
+is that you would use these pre-tested macros to solve a
+very specific set of problems, and they would run fast.
+Caution: no side-effects in arguments please!! They may be
+evaluated MANY times!!
+
+These macros operate a stack of objects. Each object starts life
+small, and may grow to maturity. (Consider building a word syllable
+by syllable.) An object can move while it is growing. Once it has
+been "finished" it never changes address again. So the "top of the
+stack" is typically an immature growing object, while the rest of the
+stack is of mature, fixed size and fixed address objects.
+
+These routines grab large chunks of memory, using a function you
+supply, called `obstack_chunk_alloc'. On occasion, they free chunks,
+by calling `obstack_chunk_free'. You must define them and declare
+them before using any obstack macros.
+
+Each independent stack is represented by a `struct obstack'.
+Each of the obstack macros expects a pointer to such a structure
+as the first argument.
+
+One motivation for this package is the problem of growing char strings
+in symbol tables. Unless you are "fascist pig with a read-only mind"
+--Gosper's immortal quote from HAKMEM item 154, out of context--you
+would not like to put any arbitrary upper limit on the length of your
+symbols.
+
+In practice this often means you will build many short symbols and a
+few long symbols. At the time you are reading a symbol you don't know
+how long it is. One traditional method is to read a symbol into a
+buffer, realloc()ating the buffer every time you try to read a symbol
+that is longer than the buffer. This is beaut, but you still will
+want to copy the symbol from the buffer to a more permanent
+symbol-table entry say about half the time.
+
+With obstacks, you can work differently. Use one obstack for all symbol
+names. As you read a symbol, grow the name in the obstack gradually.
+When the name is complete, finalize it. Then, if the symbol exists already,
+free the newly read name.
+
+The way we do this is to take a large chunk, allocating memory from
+low addresses. When you want to build a symbol in the chunk you just
+add chars above the current "high water mark" in the chunk. When you
+have finished adding chars, because you got to the end of the symbol,
+you know how long the chars are, and you can create a new object.
+Mostly the chars will not burst over the highest address of the chunk,
+because you would typically expect a chunk to be (say) 100 times as
+long as an average object.
+
+In case that isn't clear, when we have enough chars to make up
+the object, THEY ARE ALREADY CONTIGUOUS IN THE CHUNK (guaranteed)
+so we just point to it where it lies. No moving of chars is
+needed and this is the second win: potentially long strings need
+never be explicitly shuffled. Once an object is formed, it does not
+change its address during its lifetime.
+
+When the chars burst over a chunk boundary, we allocate a larger
+chunk, and then copy the partly formed object from the end of the old
+chunk to the beginning of the new larger chunk. We then carry on
+accreting characters to the end of the object as we normally would.
+
+A special macro is provided to add a single char at a time to a
+growing object. This allows the use of register variables, which
+break the ordinary 'growth' macro.
+
+Summary:
+ We allocate large chunks.
+ We carve out one object at a time from the current chunk.
+ Once carved, an object never moves.
+ We are free to append data of any size to the currently
+ growing object.
+ Exactly one object is growing in an obstack at any one time.
+ You can run one obstack per control block.
+ You may have as many control blocks as you dare.
+ Because of the way we do it, you can `unwind' an obstack
+ back to a previous state. (You may remove objects much
+ as you would with a stack.)
+*/
+
+
+/* Don't do the contents of this file more than once. */
+
+#ifndef __OBSTACK_H__
+#define __OBSTACK_H__
+
+/* We use subtraction of (char *) 0 instead of casting to int
+ because on word-addressable machines a simple cast to int
+ may ignore the byte-within-word field of the pointer. */
+
+#ifndef __PTR_TO_INT
+#define __PTR_TO_INT(P) ((P) - (char *) 0)
+#endif
+
+#ifndef __INT_TO_PTR
+#define __INT_TO_PTR(P) ((P) + (char *) 0)
+#endif
+
+/* We need the type of the resulting object. In ANSI C it is ptrdiff_t
+ but in traditional C it is usually long. If we are in ANSI C and
+ don't already have ptrdiff_t get it. */
+
+#if defined (__STDC__) && __STDC__ && ! defined (offsetof)
+#if defined (__GNUC__) && defined (IN_GCC)
+/* On Next machine, the system's stddef.h screws up if included
+ after we have defined just ptrdiff_t, so include all of stddef.h.
+ Otherwise, define just ptrdiff_t, which is all we need. */
+#ifndef __NeXT__
+#define __need_ptrdiff_t
+#endif
+#endif
+
+#include <stddef.h>
+#endif
+
+#if defined (__STDC__) && __STDC__
+#define PTR_INT_TYPE ptrdiff_t
+#else
+#define PTR_INT_TYPE long
+#endif
+
+struct _obstack_chunk /* Lives at front of each chunk. */
+{
+ char *limit; /* 1 past end of this chunk */
+ struct _obstack_chunk *prev; /* address of prior chunk or NULL */
+ char contents[4]; /* objects begin here */
+};
+
+struct obstack /* control current object in current chunk */
+{
+ long chunk_size; /* preferred size to allocate chunks in */
+ struct _obstack_chunk *chunk; /* address of current struct obstack_chunk */
+ char *object_base; /* address of object we are building */
+ char *next_free; /* where to add next char to current object */
+ char *chunk_limit; /* address of char after current chunk */
+ PTR_INT_TYPE temp; /* Temporary for some macros. */
+ int alignment_mask; /* Mask of alignment for each object. */
+#if defined (__STDC__) && __STDC__
+ /* These prototypes vary based on `use_extra_arg', and we use
+ casts to the prototypeless function type in all assignments,
+ but having prototypes here quiets -Wstrict-prototypes. */
+ struct _obstack_chunk *(*chunkfun) (void *, long);
+ void (*freefun) (void *, struct _obstack_chunk *);
+ void *extra_arg; /* first arg for chunk alloc/dealloc funcs */
+#else
+ struct _obstack_chunk *(*chunkfun) (); /* User's fcn to allocate a chunk. */
+ void (*freefun) (); /* User's function to free a chunk. */
+ char *extra_arg; /* first arg for chunk alloc/dealloc funcs */
+#endif
+ unsigned use_extra_arg:1; /* chunk alloc/dealloc funcs take extra arg */
+ unsigned maybe_empty_object:1;/* There is a possibility that the current
+ chunk contains a zero-length object. This
+ prevents freeing the chunk if we allocate
+ a bigger chunk to replace it. */
+ unsigned alloc_failed:1; /* chunk alloc func returned 0 */
+};
+
+/* Declare the external functions we use; they are in obstack.c. */
+
+#if defined (__STDC__) && __STDC__
+extern void _obstack_newchunk (struct obstack *, int);
+extern void _obstack_free (struct obstack *, void *);
+extern int _obstack_begin (struct obstack *, int, int,
+ void *(*) (long), void (*) (void *));
+extern int _obstack_begin_1 (struct obstack *, int, int,
+ void *(*) (void *, long),
+ void (*) (void *, void *), void *);
+/* CYGNUS LOCAL */
+extern int _obstack_memory_used (struct obstack *);
+/* END CYGNUS LOCAL */
+#else
+extern void _obstack_newchunk ();
+extern void _obstack_free ();
+extern int _obstack_begin ();
+extern int _obstack_begin_1 ();
+/* CYGNUS LOCAL */
+extern int _obstack_memory_used ();
+/* END CYGNUS LOCAL */
+#endif
+
+#if defined (__STDC__) && __STDC__
+
+/* Do the function-declarations after the structs
+ but before defining the macros. */
+
+void obstack_init (struct obstack *obstack);
+
+void * obstack_alloc (struct obstack *obstack, int size);
+
+void * obstack_copy (struct obstack *obstack, void *address, int size);
+void * obstack_copy0 (struct obstack *obstack, void *address, int size);
+
+void obstack_free (struct obstack *obstack, void *block);
+
+void obstack_blank (struct obstack *obstack, int size);
+
+void obstack_grow (struct obstack *obstack, void *data, int size);
+void obstack_grow0 (struct obstack *obstack, void *data, int size);
+
+void obstack_1grow (struct obstack *obstack, int data_char);
+void obstack_ptr_grow (struct obstack *obstack, void *data);
+void obstack_int_grow (struct obstack *obstack, int data);
+
+void * obstack_finish (struct obstack *obstack);
+
+int obstack_object_size (struct obstack *obstack);
+
+int obstack_room (struct obstack *obstack);
+void obstack_1grow_fast (struct obstack *obstack, int data_char);
+void obstack_ptr_grow_fast (struct obstack *obstack, void *data);
+void obstack_int_grow_fast (struct obstack *obstack, int data);
+void obstack_blank_fast (struct obstack *obstack, int size);
+
+void * obstack_base (struct obstack *obstack);
+void * obstack_next_free (struct obstack *obstack);
+int obstack_alignment_mask (struct obstack *obstack);
+int obstack_chunk_size (struct obstack *obstack);
+/* CYGNUS LOCAL */
+int obstack_memory_used (struct obstack *obstack);
+/* END CYGNUS LOCAL */
+
+#endif /* __STDC__ */
+
+/* Non-ANSI C cannot really support alternative functions for these macros,
+ so we do not declare them. */
+
+/* Pointer to beginning of object being allocated or to be allocated next.
+ Note that this might not be the final address of the object
+ because a new chunk might be needed to hold the final size. */
+
+#define obstack_base(h) ((h)->alloc_failed ? 0 : (h)->object_base)
+
+/* Size for allocating ordinary chunks. */
+
+#define obstack_chunk_size(h) ((h)->chunk_size)
+
+/* Pointer to next byte not yet allocated in current chunk. */
+
+#define obstack_next_free(h) ((h)->alloc_failed ? 0 : (h)->next_free)
+
+/* Mask specifying low bits that should be clear in address of an object. */
+
+#define obstack_alignment_mask(h) ((h)->alignment_mask)
+
+/* To prevent prototype warnings provide complete argument list in
+ standard C version. */
+#if defined (__STDC__) && __STDC__
+
+#define obstack_init(h) \
+ _obstack_begin ((h), 0, 0, \
+ (void *(*) (long)) obstack_chunk_alloc, (void (*) (void *)) obstack_chunk_free)
+
+#define obstack_begin(h, size) \
+ _obstack_begin ((h), (size), 0, \
+ (void *(*) (long)) obstack_chunk_alloc, (void (*) (void *)) obstack_chunk_free)
+
+#define obstack_specify_allocation(h, size, alignment, chunkfun, freefun) \
+ _obstack_begin ((h), (size), (alignment), \
+ (void *(*) (long)) (chunkfun), (void (*) (void *)) (freefun))
+
+#define obstack_specify_allocation_with_arg(h, size, alignment, chunkfun, freefun, arg) \
+ _obstack_begin_1 ((h), (size), (alignment), \
+ (void *(*) (void *, long)) (chunkfun), \
+ (void (*) (void *, void *)) (freefun), (arg))
+
+#define obstack_chunkfun(h, newchunkfun) \
+ ((h) -> chunkfun = (struct _obstack_chunk *(*)(void *, long)) (newchunkfun))
+
+#define obstack_freefun(h, newfreefun) \
+ ((h) -> freefun = (void (*)(void *, struct _obstack_chunk *)) (newfreefun))
+
+#else
+
+#define obstack_init(h) \
+ _obstack_begin ((h), 0, 0, \
+ (void *(*) ()) obstack_chunk_alloc, (void (*) ()) obstack_chunk_free)
+
+#define obstack_begin(h, size) \
+ _obstack_begin ((h), (size), 0, \
+ (void *(*) ()) obstack_chunk_alloc, (void (*) ()) obstack_chunk_free)
+
+#define obstack_specify_allocation(h, size, alignment, chunkfun, freefun) \
+ _obstack_begin ((h), (size), (alignment), \
+ (void *(*) ()) (chunkfun), (void (*) ()) (freefun))
+
+#define obstack_specify_allocation_with_arg(h, size, alignment, chunkfun, freefun, arg) \
+ _obstack_begin_1 ((h), (size), (alignment), \
+ (void *(*) ()) (chunkfun), (void (*) ()) (freefun), (arg))
+
+#define obstack_chunkfun(h, newchunkfun) \
+ ((h) -> chunkfun = (struct _obstack_chunk *(*)()) (newchunkfun))
+
+#define obstack_freefun(h, newfreefun) \
+ ((h) -> freefun = (void (*)()) (newfreefun))
+
+#endif
+
+#define obstack_1grow_fast(h,achar) (*((h)->next_free)++ = achar)
+
+#define obstack_blank_fast(h,n) ((h)->next_free += (n))
+
+/* CYGNUS LOCAL */
+#define obstack_memory_used(h) _obstack_memory_used (h)
+/* END CYGNUS LOCAL */
+
+#if defined (__GNUC__) && defined (__STDC__) && __STDC__
+/* NextStep 2.0 cc is really gcc 1.93 but it defines __GNUC__ = 2 and
+ does not implement __extension__. But that compiler doesn't define
+ __GNUC_MINOR__. */
+#if __GNUC__ < 2 || (__NeXT__ && !__GNUC_MINOR__)
+#define __extension__
+#endif
+
+/* For GNU C, if not -traditional,
+ we can define these macros to compute all args only once
+ without using a global variable.
+ Also, we can avoid using the `temp' slot, to make faster code. */
+
+#define obstack_object_size(OBSTACK) \
+ __extension__ \
+ ({ struct obstack *__o = (OBSTACK); \
+ __o->alloc_failed ? 0 : \
+ (unsigned) (__o->next_free - __o->object_base); })
+
+#define obstack_room(OBSTACK) \
+ __extension__ \
+ ({ struct obstack *__o = (OBSTACK); \
+ (unsigned) (__o->chunk_limit - __o->next_free); })
+
+#define obstack_grow(OBSTACK,where,length) \
+__extension__ \
+({ struct obstack *__o = (OBSTACK); \
+ int __len = (length); \
+ if (__o->next_free + __len > __o->chunk_limit) \
+ _obstack_newchunk (__o, __len); \
+ if (!__o->alloc_failed) \
+ { \
+ memcpy (__o->next_free, (char *) (where), __len); \
+ __o->next_free += __len; \
+ } \
+ (void) 0; })
+
+#define obstack_grow0(OBSTACK,where,length) \
+__extension__ \
+({ struct obstack *__o = (OBSTACK); \
+ int __len = (length); \
+ if (__o->next_free + __len + 1 > __o->chunk_limit) \
+ _obstack_newchunk (__o, __len + 1); \
+ if (!__o->alloc_failed) \
+ { \
+ memcpy (__o->next_free, (char *) (where), __len); \
+ __o->next_free += __len; \
+ *(__o->next_free)++ = 0; \
+ } \
+ (void) 0; })
+
+#define obstack_1grow(OBSTACK,datum) \
+__extension__ \
+({ struct obstack *__o = (OBSTACK); \
+ if (__o->next_free + 1 > __o->chunk_limit) \
+ _obstack_newchunk (__o, 1); \
+ if (!__o->alloc_failed) \
+ *(__o->next_free)++ = (datum); \
+ (void) 0; })
+
+/* These assume that the obstack alignment is good enough for pointers or ints,
+ and that the data added so far to the current object
+ shares that much alignment. */
+
+#define obstack_ptr_grow(OBSTACK,datum) \
+__extension__ \
+({ struct obstack *__o = (OBSTACK); \
+ if (__o->next_free + sizeof (void *) > __o->chunk_limit) \
+ _obstack_newchunk (__o, sizeof (void *)); \
+ if (!__o->alloc_failed) \
+ *((void **)__o->next_free)++ = ((void *)datum); \
+ (void) 0; })
+
+#define obstack_int_grow(OBSTACK,datum) \
+__extension__ \
+({ struct obstack *__o = (OBSTACK); \
+ if (__o->next_free + sizeof (int) > __o->chunk_limit) \
+ _obstack_newchunk (__o, sizeof (int)); \
+ if (!__o->alloc_failed) \
+ *((int *)__o->next_free)++ = ((int)datum); \
+ (void) 0; })
+
+#define obstack_ptr_grow_fast(h,aptr) (*((void **) (h)->next_free)++ = (void *)aptr)
+#define obstack_int_grow_fast(h,aint) (*((int *) (h)->next_free)++ = (int) aint)
+
+#define obstack_blank(OBSTACK,length) \
+__extension__ \
+({ struct obstack *__o = (OBSTACK); \
+ int __len = (length); \
+ if (__o->chunk_limit - __o->next_free < __len) \
+ _obstack_newchunk (__o, __len); \
+ if (!__o->alloc_failed) \
+ __o->next_free += __len; \
+ (void) 0; })
+
+#define obstack_alloc(OBSTACK,length) \
+__extension__ \
+({ struct obstack *__h = (OBSTACK); \
+ obstack_blank (__h, (length)); \
+ obstack_finish (__h); })
+
+#define obstack_copy(OBSTACK,where,length) \
+__extension__ \
+({ struct obstack *__h = (OBSTACK); \
+ obstack_grow (__h, (where), (length)); \
+ obstack_finish (__h); })
+
+#define obstack_copy0(OBSTACK,where,length) \
+__extension__ \
+({ struct obstack *__h = (OBSTACK); \
+ obstack_grow0 (__h, (where), (length)); \
+ obstack_finish (__h); })
+
+/* The local variable is named __o1 to avoid a name conflict
+ when obstack_blank is called. */
+#define obstack_finish(OBSTACK) \
+__extension__ \
+({ struct obstack *__o1 = (OBSTACK); \
+ void *value; \
+ if (__o1->alloc_failed) \
+ value = 0; \
+ else \
+ { \
+ value = (void *) __o1->object_base; \
+ if (__o1->next_free == value) \
+ __o1->maybe_empty_object = 1; \
+ __o1->next_free \
+ = __INT_TO_PTR ((__PTR_TO_INT (__o1->next_free)+__o1->alignment_mask)\
+ & ~ (__o1->alignment_mask)); \
+ if (__o1->next_free - (char *)__o1->chunk \
+ > __o1->chunk_limit - (char *)__o1->chunk) \
+ __o1->next_free = __o1->chunk_limit; \
+ __o1->object_base = __o1->next_free; \
+ } \
+ value; })
+
+#define obstack_free(OBSTACK, OBJ) \
+__extension__ \
+({ struct obstack *__o = (OBSTACK); \
+ void *__obj = (OBJ); \
+ if (__obj > (void *)__o->chunk && __obj < (void *)__o->chunk_limit) \
+ __o->next_free = __o->object_base = __obj; \
+ else (obstack_free) (__o, __obj); })
+
+#else /* not __GNUC__ or not __STDC__ */
+
+#define obstack_object_size(h) \
+ (unsigned) ((h)->alloc_failed ? 0 : (h)->next_free - (h)->object_base)
+
+#define obstack_room(h) \
+ (unsigned) ((h)->chunk_limit - (h)->next_free)
+
+/* Note that the call to _obstack_newchunk is enclosed in (..., 0)
+ so that we can avoid having void expressions
+ in the arms of the conditional expression.
+ Casting the third operand to void was tried before,
+ but some compilers won't accept it. */
+
+#define obstack_grow(h,where,length) \
+( (h)->temp = (length), \
+ (((h)->next_free + (h)->temp > (h)->chunk_limit) \
+ ? (_obstack_newchunk ((h), (h)->temp), 0) : 0), \
+ ((h)->alloc_failed ? 0 : \
+ (memcpy ((h)->next_free, (char *) (where), (h)->temp), \
+ (h)->next_free += (h)->temp)))
+
+#define obstack_grow0(h,where,length) \
+( (h)->temp = (length), \
+ (((h)->next_free + (h)->temp + 1 > (h)->chunk_limit) \
+ ? (_obstack_newchunk ((h), (h)->temp + 1), 0) : 0), \
+ ((h)->alloc_failed ? 0 : \
+ (memcpy ((h)->next_free, (char *) (where), (h)->temp), \
+ (h)->next_free += (h)->temp, \
+ *((h)->next_free)++ = 0)))
+
+#define obstack_1grow(h,datum) \
+( (((h)->next_free + 1 > (h)->chunk_limit) \
+ ? (_obstack_newchunk ((h), 1), 0) : 0), \
+ ((h)->alloc_failed ? 0 : \
+ (*((h)->next_free)++ = (datum))))
+
+#define obstack_ptr_grow(h,datum) \
+( (((h)->next_free + sizeof (char *) > (h)->chunk_limit) \
+ ? (_obstack_newchunk ((h), sizeof (char *)), 0) : 0), \
+ ((h)->alloc_failed ? 0 : \
+ (*((char **) (((h)->next_free+=sizeof(char *))-sizeof(char *))) = ((char *) datum))))
+
+#define obstack_int_grow(h,datum) \
+( (((h)->next_free + sizeof (int) > (h)->chunk_limit) \
+ ? (_obstack_newchunk ((h), sizeof (int)), 0) : 0), \
+ ((h)->alloc_failed ? 0 : \
+ (*((int *) (((h)->next_free+=sizeof(int))-sizeof(int))) = ((int) datum))))
+
+#define obstack_ptr_grow_fast(h,aptr) (*((char **) (h)->next_free)++ = (char *) aptr)
+#define obstack_int_grow_fast(h,aint) (*((int *) (h)->next_free)++ = (int) aint)
+
+#define obstack_blank(h,length) \
+( (h)->temp = (length), \
+ (((h)->chunk_limit - (h)->next_free < (h)->temp) \
+ ? (_obstack_newchunk ((h), (h)->temp), 0) : 0), \
+ ((h)->alloc_failed ? 0 : \
+ ((h)->next_free += (h)->temp)))
+
+#define obstack_alloc(h,length) \
+ (obstack_blank ((h), (length)), obstack_finish ((h)))
+
+#define obstack_copy(h,where,length) \
+ (obstack_grow ((h), (where), (length)), obstack_finish ((h)))
+
+#define obstack_copy0(h,where,length) \
+ (obstack_grow0 ((h), (where), (length)), obstack_finish ((h)))
+
+#define obstack_finish(h) \
+( (h)->alloc_failed ? 0 : \
+ (((h)->next_free == (h)->object_base \
+ ? (((h)->maybe_empty_object = 1), 0) \
+ : 0), \
+ (h)->temp = __PTR_TO_INT ((h)->object_base), \
+ (h)->next_free \
+ = __INT_TO_PTR ((__PTR_TO_INT ((h)->next_free)+(h)->alignment_mask) \
+ & ~ ((h)->alignment_mask)), \
+ (((h)->next_free - (char *) (h)->chunk \
+ > (h)->chunk_limit - (char *) (h)->chunk) \
+ ? ((h)->next_free = (h)->chunk_limit) : 0), \
+ (h)->object_base = (h)->next_free, \
+ __INT_TO_PTR ((h)->temp)))
+
+#if defined (__STDC__) && __STDC__
+#define obstack_free(h,obj) \
+( (h)->temp = (char *) (obj) - (char *) (h)->chunk, \
+ (((h)->temp > 0 && (h)->temp < (h)->chunk_limit - (char *) (h)->chunk)\
+ ? (int) ((h)->next_free = (h)->object_base \
+ = (h)->temp + (char *) (h)->chunk) \
+ : (((obstack_free) ((h), (h)->temp + (char *) (h)->chunk), 0), 0)))
+#else
+#define obstack_free(h,obj) \
+( (h)->temp = (char *) (obj) - (char *) (h)->chunk, \
+ (((h)->temp > 0 && (h)->temp < (h)->chunk_limit - (char *) (h)->chunk)\
+ ? (int) ((h)->next_free = (h)->object_base \
+ = (h)->temp + (char *) (h)->chunk) \
+ : (_obstack_free ((h), (h)->temp + (char *) (h)->chunk), 0)))
+#endif
+
+#endif /* not __GNUC__ or not __STDC__ */
+
+#endif /* not __OBSTACK_H__ */
diff --git a/install-sh b/install-sh
new file mode 100755
index 00000000000..853408cec35
--- /dev/null
+++ b/install-sh
@@ -0,0 +1,287 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission. M.I.T. makes no representations about the
+# suitability of this software for any purpose. It is provided "as is"
+# without express or implied warranty.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch. It can only install one file at a time, a restriction
+# shared with many OS's install programs.
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+# CYGNUS LOCAL: exeext variable
+exeext=""
+# END CYGNUS LOCAL
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -d) dir_arg=true
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ -t=*) transformarg=`echo $1 | sed 's/-t=//'`
+ shift
+ continue;;
+
+ -b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+ shift
+ continue;;
+
+ # CYGNUS LOCAL: -x option
+ -x=*) exeext=`echo $1 | sed 's/-x=//'`
+ shift
+ continue;;
+
+ -x) exeext=".exe"
+ shift
+ continue;;
+ # END CYGNUS LOCAL
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ # this colon is to work around a 386BSD /bin/sh bug
+ :
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+else
+ true
+fi
+
+if [ x"$dir_arg" != x ]; then
+ dst=$src
+ src=""
+
+ if [ -d $dst ]; then
+ instcmd=:
+ chmodcmd=""
+ else
+ instcmd=mkdir
+ fi
+else
+
+# CYGNUS LOCAL noer
+# Win32-based gcc automatically appends .exe to produced executables,
+# whether asked for or not. This breaks installs. The following
+# changes the value of $src to $src.exe if $src is missing
+
+ if [ -f $src ]
+ then
+ true
+ elif [ -f $src.exe ]
+ then
+ echo "install: $src does not exist, trying with .exe appended"
+ src="$src".exe
+ fi
+
+# end CYGNUS LOCAL noer
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad
+# if $src (and thus $dsttmp) contains '*'.
+
+ if [ -f $src -o -d $src ]
+ then
+ true
+ else
+ echo "install: $src does not exist"
+ exit 1
+ fi
+
+ if [ x"$dst" = x ]
+ then
+ echo "install: no destination specified"
+ exit 1
+ else
+ true
+ fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+ if [ -d $dst ]
+ then
+ dst="$dst"/`basename $src`
+ else
+ true
+ fi
+
+ # CYGNUS LOCAL: Use exeext
+ case "`basename $dst`" in
+ *.*) ;;
+ *) dst="$dst$exeext" ;;
+ esac
+ # END CYGNUS LOCAL
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+# this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='
+'
+IFS="${IFS-${defaultIFS}}"
+
+oIFS="${IFS}"
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS="${oIFS}"
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+ pathcomp="${pathcomp}${1}"
+ shift
+
+ if [ ! -d "${pathcomp}" ] ;
+ then
+ $mkdirprog "${pathcomp}"
+ else
+ true
+ fi
+
+ pathcomp="${pathcomp}/"
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+ $doit $instcmd $dst &&
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+ if [ x"$transformarg" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ dstfile=`basename $dst $transformbasename |
+ sed $transformarg`$transformbasename
+ fi
+
+# don't allow the sed command to completely eliminate the filename
+
+ if [ x"$dstfile" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ true
+ fi
+
+# Make a temp file name in the proper directory.
+
+ dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+ $doit $instcmd $src $dsttmp &&
+
+ trap "rm -f ${dsttmp}" 0 &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing. If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
+
+# Now rename the file to the real destination.
+
+ $doit $rmcmd -f $dstdir/$dstfile &&
+ $doit $mvcmd $dsttmp $dstdir/$dstfile
+
+fi &&
+
+
+exit 0
diff --git a/libiberty/COPYING.LIB b/libiberty/COPYING.LIB
new file mode 100644
index 00000000000..eb685a5ec98
--- /dev/null
+++ b/libiberty/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.
+
+ <one line to give the library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ 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.
+
+ <signature of Ty Coon>, 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
diff --git a/libiberty/ChangeLog b/libiberty/ChangeLog
new file mode 100644
index 00000000000..265acc49a4e
--- /dev/null
+++ b/libiberty/ChangeLog
@@ -0,0 +1,2233 @@
+Tue Aug 19 20:28:45 1997 Geoffrey Noer <noer@cygnus.com>
+
+ * config/mh-cygwin32: also build random.o
+
+Tue Aug 19 17:10:56 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * cplus-dem.c: Add 'extern' to prepends_underscore.
+
+Wed Jul 30 11:42:19 1997 Per Bothner <bothner@cygnus.com>
+
+ * cplus-dem.c: Various changes to produce Java output when passed
+ DMGL_JAVA. Thus "::" becomes "." and "JArray<Foo>" becomes "Foo[]".
+ (main): Support --java and -j flags to set DMGL_JAVA.
+
+Tue Jul 22 19:05:23 1997 Robert Hoehne <robert.hoehne@Mathematik.TU-Chemnitz.DE>
+
+ * config/mh-go32 (CC, AR, RANLIB): Don't define.
+
+Tue Jul 22 17:49:54 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (REQUIRED_OFILES): Add pexecute.o.
+ (pexecute.o): New target.
+
+ * Makefile.in (stamp-needed): New target, replacing needed-list.
+ (needed-list): Just depend upon stamp-needed.
+ (stamp-config): New target, replacing config.h.
+ (config.h): Just depend upon stamp-config.
+ (mostlyclean): Remove stamp-*.
+
+Thu Jun 12 11:00:18 1997 Angela Marie Thomas (angela@cygnus.com)
+
+ * Makefile.in (FLAGS_TO_PASS): pass INSTALL, INSTALL_PROGRAM and
+ INSTALL_DATA for multilibbed installs
+
+Tue Jun 3 13:21:05 1997 Doug Evans <dje@canuck.cygnus.com>
+
+ Tue Dec 10 09:44:57 1996 Paul Eggert <eggert@twinsun.com>
+
+ * choose-temp.c (choose_temp_base): Don't dump core if TMPDIR is empty.
+
+ * choose-temp.c (try): Insist that temp dir be searchable.
+
+ Wed Oct 23 17:36:39 1996 Doug Rupp (rupp@gnat.com)
+
+ * choose-temp.c (choose_temp_base): On VMS, use proper syntax
+ for current directory.
+
+ Sat Feb 15 19:03:48 1997 Geoffrey Noer (noer@cygnus.com)
+
+ * pexecute.c: Remove special cases for cygwin32.
+ (pwait): Remove local definition of `pid'.
+
+ Tue Nov 12 18:26:15 1996 Doug Rupp (rupp@gnat.com)
+
+ * pexecute.c (vfork): Supply new definition for VMS.
+ (pwait): Use waitpid instead of wait for VMS.
+
+Tue May 20 14:02:20 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * cplus-dem.c (do_type): Handle `J'.
+ (demangle_fund_type): Print "complex" for it.
+
+Wed Apr 30 12:15:45 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure.in: Don't turn on multilib here.
+
+Mon Apr 28 19:04:31 1997 Michael Snyder <msnyder@cleaver.cygnus.com>
+
+ * obstack.c: move _obstack_memory_used outside of ifdef. Cannot be
+ elided; needed by gdb and not present in libc.
+
+Thu Apr 24 19:33:47 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (clean): Remove tmpmulti.out.
+
+Tue Apr 22 10:25:15 1997 Fred Fish <fnf@cygnus.com>
+
+ * floatformat.c (floatformat_ieee_double_littlebyte_bigword):
+ Add new floatformat, mainly for ARM doubles.
+
+Mon Apr 14 12:11:16 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.table: Use ${config_shell} with ${moveifchange}. From
+ Thomas Graichen <graichen@rzpd.de>.
+
+Fri Apr 4 03:09:24 1997 Ulrich Drepper <drepper@cygnus.com>
+
+ * configure.in: Enable multilibing by default.
+ Update multilib template to read config-ml.in.
+
+Tue Apr 1 16:26:39 1997 Klaus Kaempf <kkaempf@progis.de>
+
+ * makefile.vms: Add objalloc.
+
+Mon Mar 31 23:57:51 1997 H.J. Lu <hjl@gnu.ai.mit.edu>
+
+ * cplus-dem.c (demangle_it): Add prototype declaration.
+ (usage, fatal): Likewise.
+
+ * xexit.c (_xexit_cleanup): Add prototype.
+
+ * strerror.c (init_error_tables): Declare.
+
+Fri Mar 28 11:43:20 1997 H.J. Lu <hjl@lucon.org>
+
+ * functions.def: Add DEF of vasprintf, and DEFFUNC of strsignal.
+ * strsignal.c: Only define strsignal if NEED_strsignal.
+ * Makefile.in (REQUIRED_OFILES): Remove vasprintf.o.
+ * configure.in: Add NEED_strsignal to xconfig.h. Add vasprintf.o
+ to xneeded-list.
+ * config/mh-cygwin32 (HDEFINES): Add -DNEED_strsignal.
+ (EXTRA_OFILES): Define to vasprintf.o.
+ * config/mh-windows (HDEFINES): Add -DNEED_strsignal.
+ (EXTRA_OFILES): Add vasprintf.o.
+ * config/mt-vxworks5 (vxconfig.h): Define NEED_strsignal.
+ (vxneeded-list): Add vasprintf.o.
+
+Thu Mar 20 17:02:09 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * objalloc.c: Include <stdio.h>.
+
+Mon Mar 17 19:23:11 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * objalloc.c: New file.
+ * Makefile.in (CFILES): Add objalloc.c
+ (REQUIRED_OFILES): Add objalloc.o.
+ (objalloc.o): New target.
+
+Sat Mar 15 18:49:41 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * obstack.c: Update to current FSF version.
+
+Fri Mar 14 14:18:47 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * cplus-dem.c: Add prototypes for all static functions.
+ (mystrstr): Make static. Make arguments and result const.
+ (cplus_match): Remove; not used.
+
+Tue Mar 11 14:20:31 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * cplus-dem.c (gnu_special): Call demangled_fund_type for other
+ __t* symbols.
+
+Tue Mar 11 15:41:21 1997 H.J. Lu <hjl@lucon.org>
+
+ * spaces.c: Declare malloc and free properly.
+ * strsignal.c (init_signal_tables): Add prototype.
+ * xatexit.c (_xexit_cleanup): Add parameter declarations.
+
+Wed Feb 19 15:43:24 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * Makefile.in (lneeded-list): If alloca.o is needed, xexit.o is
+ also required because of xmalloc.o.
+
+Fri Feb 14 13:43:38 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * strsignal.c: Unconditionally redefine sys_siglist around the
+ inclusion of the system header files.
+
+Thu Feb 13 22:01:04 1997 Klaus Kaempf <kkaempf@progis.de>
+
+ * makefile.vms: Remove 8 bit characters. Update to latest
+ gcc release.
+
+Tue Feb 4 11:52:19 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * strsignal.c: Use NEED_sys_siglist instead of
+ LOSING_SYS_SIGLIST.
+ * config.table: Don't use mh-lynxos.
+ * config/mh-lynxos: Remove.
+
+Thu Jan 16 14:51:03 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * cplus-dem.c: Fix indenting; make identical to the copy
+ in GCC.
+ (do_type, case 'M'): Check for a template as well as a class.
+
+Thu Dec 19 13:51:33 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * config/mt-vxworks5 (vxneeded-list): Remove sigsetmask.o, since
+ vxworks 5.[0-3] all have sigsetmask in them; the one provided by
+ libiberty is incorrect, as well.
+
+Mon Dec 2 15:03:42 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * alloca.c (alloca): When compiled with an ANSI/ISO compiler,
+ alloca takes a size_t argument, not just unsigned.
+
+Mon Nov 18 15:42:08 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * cplus-dem.c: Note that this file also lives in GCC.
+
+Mon Nov 18 15:19:00 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * alloca.c: Remove include of libiberty.h for hpux.
+ * argv.c: Replace defs from libiberty.h.
+ * spaces.c: Put back externs from removed from libiberty.h.
+ * vasprintf.c: Remove include of libiberty.h for hpux.
+
+Mon Nov 18 14:08:00 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * cplus-dem.c: Checking in again; last checkin filed due to sticky tag.
+
+Wed Nov 13 08:22:00 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * cplus-dem.c: Revert last two commits due to conflicts with
+ hpux system headers.
+
+Wed Nov 13 08:22:00 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * alloca.c, argv.c, spaces.c, strcasecmp.c, vasprintf.c, vprintf.c:
+ Revert last commit due to conflicts with hpux system headers.
+
+Wed Nov 13 10:36:50 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * cplus-dem.c (x{m,re}alloc): Make declarations compatibile with
+ libiberty.h when compiled with a standard compiler.
+
+Tue Nov 12 16:31:00 1996 Dawn Perchik <dawn@critters.cygnus.com>
+
+ * alloca.c: Include libiberty.h for definition of xmalloc.
+ Don't redefine NULL.
+ * argv.c: Move prototypes to libiberty.h.
+ * cplus-dem.c: Include libiberty.h for definition of xmalloc.
+ Don't redefine NULL.
+ Use casts to eliminate compiler warnings.
+ * spaces.c: Remove prototypes for malloc and free which are
+ already in libibrty.h.
+ * strcasecmp.c: Use casts to eliminate compiler warnings.
+ * vasprintf.c: Include libiberty.h for definition of malloc.
+ Don't redefine NULL.
+ * vprintf.c: Include stdarg.h if __STDC__.
+
+Fri Oct 11 15:42:12 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * config/mh-windows: Add strcasecmp.o to EXTRA_OFILES.
+
+Fri Oct 11 11:16:31 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw.c (mpwify_filename): Rewrite to simplify, and to handle
+ upward components correctly.
+
+Tue Oct 8 08:55:34 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * config.table, config/mh-windows: Add support for building under
+ MSVC (the Microsoft build environment).
+
+Mon Oct 7 10:50:27 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * fnmatch.c: Undef const if not __STDC__.
+
+Thu Oct 3 13:46:39 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * fnmatch.c: New file.
+ * Makefile.in (CFILES): Add fnmatch.c.
+ (REQUIRED_OFILES): Add fnmatch.o.
+ (fnmatch.o): New target.
+
+Wed Sep 18 14:49:13 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * cplus-dem.c (demangle_template): Fix handling of address args.
+ (gnu_special): Handle type_info stuff.
+
+Fri Sep 13 17:52:55 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw.c (DebugPI): Make settable from the env var DEBUG_PATHNAMES.
+ (mpwify_filename): Handle "::/" case.
+
+Thu Sep 12 13:30:40 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * config/mh-cygwin32: new file (need -DNEED_basename and
+ -DNEED_sys_siglist for native NT rebuilding)
+ * config.table (*-*-cygwin32): new entry
+ * choose-temp.c: bring in sync with gcc (revert Aug 17 change)
+
+Thu Aug 29 16:48:45 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * config.table (i[345]86-*-*): Recognize i686 for pentium pro.
+
+Tue Aug 27 13:47:58 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * pexecute.c (pexecute) [MPW]: Remove old bogus code that
+ messed with arguments that included a '/', add escape chars
+ to double quotes, remove const decl from arg that Mac
+ compilers don't seem to like.
+
+Sat Aug 17 04:44:27 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * pexecute.c: Update test for win32 (&& ! cygwin32).
+ * choose-temp.c: fix WIN32 preprocessor defines
+
+Thu Aug 15 12:26:48 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-make.sed: Add @DASH_C_FLAG@ and @SEGMENT_FLAG({Default})@
+ to editing of default makefile rule.
+
+Sun Aug 11 21:03:27 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * alloca-norm.h: Include <malloc.h> if _WIN32.
+ * argv.c: Include non-prototyped decls for malloc and string
+ functions if ! _WIN32 or if __GNUC__.
+
+Thu Aug 8 12:42:40 1996 Klaus Kaempf <kkaempf@progis.de>
+
+ * config.h-vms: New file.
+ * makefile.vms: Use it.
+
+Wed Aug 7 17:16:12 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * getopt.c (_getopt_internal): If argc is 0, just return (before
+ we reference *argv and segfault).
+
+Mon Aug 5 01:29:08 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (distclean): Add multilib.out.
+
+Thu Jul 18 17:40:55 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * alloca-norm.h: Change #ifdef sparc to #if defined (sparc) &&
+ defined (sun). From Andrew Gierth <ANDREWG@microlise.co.uk>.
+
+Mon Jul 1 13:40:44 1996 Ken Raeburn <raeburn@cygnus.com>
+
+ Tue May 28 15:29:03 1996 Pat Rankin <rankin@eql.caltech.edu>
+
+ * vmsbuild.com (REQUIRD_OFILES): Add choose-temp.o and xstrdup.o.
+
+ Thu Jan 25 18:20:04 1996 Pat Rankin <rankin@eql.caltech.edu>
+
+ * vmsbuild.com: Changes to handle DEFFUNC(on_exit).
+ (do_ofiles): Allow nonexistent source file in pass 3.
+ (chk_deffunc): New routine.
+
+Tue Jun 25 19:24:43 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * pexecute.c (PEXECUTE_VERBOSE): Define.
+ (MPW pexecute): Check flags & PEXECUTE_VERBOSE instead of verbose_flag.
+
+Tue Jun 25 23:11:48 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (docdir): Removed.
+
+Tue Jun 25 23:01:07 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (oldincludedir): Removed.
+
+Tue Jun 25 22:50:07 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (datadir): Set to $(prefix)/share.
+
+Thu Jun 20 21:17:52 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * cplus-dem.c (demangle_arm_pt): Reindent. Avoid endless loop by
+ checking for errors from do_type.
+
+Tue Jun 18 14:36:19 1996 Klaus Kaempf <kkaempf@progis.de>
+
+ * makefile.vms: New file.
+ * xmalloc.c: If VMS, include <stdlib.h> and <unixlib.h> rather
+ than declaring malloc, realloc, and sbrk.
+
+Mon Jun 10 13:17:17 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * pexecute.c: New file.
+
+Wed Jun 5 16:57:45 1996 Richard Henderson <rth@tamu.edu>
+
+ * xmalloc.c: Declare sbrk.
+
+Sat May 4 05:08:45 1996 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * alloca-norm.h: Add SPARCworks cc compatible __builtin_alloca
+ declaration.
+
+Mon Apr 22 18:41:49 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * xstrerror.c: Include <stdio.h>.
+
+Sun Apr 21 11:55:12 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (CFILES): Add atexit.c.
+
+Sun Apr 21 09:50:09 1996 Stephen L Moshier (moshier@world.std.com)
+
+ * choose-temp.c: Include sys/types.h before sys/file.h for sco3.2v5.
+
+Wed Apr 17 11:17:55 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * choose-temp.c: Don't #include sys/file.h ifdef NO_SYS_FILE_H.
+ #include <stdio.h>
+ * config/mt-vxworks5 (HDEFINES): Define NO_SYS_FILE_H.
+
+Tue Apr 16 11:27:16 1996 Jeffrey A Law (law@cygnus.com)
+
+ * Makefile.in (lneeded-list): If alloca.o is needed, so is xmalloc.o.
+ Reverts Feb 8, 1995 change.
+
+Mon Apr 15 12:53:26 1996 Doug Evans <dje@canuck.cygnus.com>
+
+ * choose-temp.c: New file.
+ * Makefile.in (CFILES): Add choose-temp.c.
+ (REQUIRED_OFILES): Add choose-temp.o.
+
+Sat Apr 13 14:19:30 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * floatformat.c (floatformat_to_double): Don't bias exponent when
+ handling zero's, denorms or NaNs.
+
+Thu Apr 11 13:36:56 1996 Stu Grossman (grossman@critters.cygnus.com)
+
+ * floatformat.c (floatformat_to_double): Fix bugs with handling
+ numbers with fractions < 32 bits.
+
+Mon Apr 8 14:48:34 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.table: Permit --enable-shared to specify a list of
+ directories.
+
+Tue Mar 19 22:02:07 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * cplus-dem.c (demangle_template): Fix for non-mangled pointer
+ arguments.
+
+Fri Mar 8 17:24:18 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: If srcdir is `.' and with_target_subdir is not
+ `.', then set MULTISRCTOP before calling config-ml.in.
+
+Thu Mar 7 13:37:10 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw.c (mpw_open): Add debugging output option.
+
+Wed Mar 6 17:36:03 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * cplus-dem.c (demangle_template): Fix for address-of-extern arguments.
+
+Tue Feb 27 12:00:50 1996 Raymond Jou <rjou@mexican.cygnus.com>
+
+ * mpw.c (mpwify_filename): Change 6 to 5 in
+ strncmp (unixname, "/tmp/", 5).
+
+Tue Feb 20 10:55:53 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * cplus-dem.c (demangle_template): Initialize is_bool. Correctly
+ handle 0 as a pointer value parameter.
+
+Mon Feb 5 16:41:44 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (all): Depend upon required-list.
+ (required-list): New target.
+ (clean): Remove required-list.
+
+Wed Jan 31 10:19:41 1996 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * win32.c: Deleted.
+ * config.table (i386-*-win32): Deleted.
+ * config/mh-i386win32: Deleted.
+
+Thu Jan 18 11:34:17 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * cplus-dem.c (cplus_demangle_opname): Change opname parameter to
+ const char *.
+ (cplus_mangle_opname): Change return type and opname parameter to
+ const char *. Don't cast return value.
+
+Tue Jan 16 12:13:11 1996 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw.c: Include Timer.h, in order to get m68k Microseconds trap
+ definition.
+
+Wed Jan 3 13:15:04 1996 Fred Fish <fnf@cygnus.com>
+
+ * obstack.c: Update copyright to 1996.
+ (_obstack_memory_used): Define new function. Called via
+ obstack_memory_used macro.
+
+Thu Dec 28 11:39:40 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * xstrdup.c: New file.
+ * Makefile.in (CFILES): Add xstrdup.c.
+ (REQUIRED_OFILES): Add xstrdup.o.
+ (xstrdup.o): New target.
+
+Mon Dec 11 18:18:52 1995 Mike Stump <mrs@cygnus.com>
+
+ * atexit.c: New stub to provide atexit on systems that have
+ on_exit, like SunOS 4.1.x systems.
+ * functions.def (on_exit, atexit): Ditto.
+
+Mon Dec 11 15:42:14 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw.c (mpw_abort): Remove decl.
+ (mpw_access): Move debugging printf.
+
+Sat Dec 2 01:25:23 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.table: Consistently use ${host} rather than ${xhost} or
+ ${target}.
+ * configure.in: Don't bother to set ${xhost} before calling
+ config.table.
+
+Tue Nov 28 14:16:57 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * Makefile.in (.c.o): Use test instead of the left bracket, to
+ avoid problems with some versions of make.
+
+Tue Nov 28 11:45:17 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-make.sed: Fix INCDIR edit to work with Nov 14 change.
+
+Tue Nov 21 11:26:34 1995 Fred Fish <fnf@rtl.cygnus.com>
+
+ * config/mh-hpux: Remove. It was only used to define EXTRA_OFILES,
+ which was set to just alloca.o, which is now automatically marked
+ as needed by the autoconfiguration process.
+
+Tue Nov 21 14:15:06 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.table: Check ${with_cross_host} rather than comparing
+ ${host} and ${target}.
+
+Thu Nov 16 14:34:42 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: If with_target_subdir is empty, set xhost to
+ ${host} rather than ${target} before calling config.table.
+
+Tue Nov 14 01:38:30 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (MULTITOP): Deleted.
+ (MULTISRCTOP, MULTIBUILDTOP): New.
+ (FLAGS_TO_PASS): Delete INCDIR.
+ (INCDIR): Add $(MULTISRCTOP).
+ (install_to_libdir): Add $(MULTISUBDIR). Call $(MULTIDO).
+ * configure.in: Delete call to cfg-ml-com.in. Call config-ml.in
+ instead of cfg-ml-pos.in.
+ (cross-compile check): Change to test for with_target_subdir.
+ (EXTRA_LINKS): Delete.
+
+Sun Nov 12 12:13:04 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-make.sed: Add getpagesize.c.o to needed-list.
+ * mpw.c [USE_MW_HEADERS]: Conditionalize compiling of
+ functions that are supplied by Metrowerks libraries.
+ (fstat): Clean up descriptor->pointer conversion code.
+ (InstallConsole, etc): Empty definitions, for when linking
+ with SIOUX.
+
+Sun Nov 5 19:25:27 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (FLAGS_TO_PASS): Also pass PICFLAGS.
+ (.c.o): Stylistic change.
+
+Thu Nov 2 12:06:29 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * strtol.c, strtoul.c: Don't include <stdlib.h>. From
+ phdm@info.ucl.ac.be (Philippe De Muyter).
+
+Wed Nov 1 11:59:36 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Correct sed call.
+
+Mon Oct 30 13:03:45 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in: Clean up / simplify for native.
+
+ * configure.in: Merge in stuff from ../xiberty/configure.in.
+ * Makefile.in (CC): Add definition (so it can be overrridden
+ by ../configure).
+
+Tue Oct 24 17:57:27 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-make.sed: Leave strerror.c.o in standard list of functions.
+ * mpw.c (R_OK, ENOENT, EACCESS, ENOSYS): Remove.
+ (link): Remove useless definition with error return.
+ (last_microseconds, warn_if_spin_delay, record_for_spin_delay):
+ Use UnsignedWide type for microsecond counts.
+
+Thu Oct 19 10:52:07 1995 Michael Meissner <meissner@wogglebug.tiac.net>
+
+ * memcmp.c (memcmp): Argument types are const void *, not void
+ *const.
+
+ * strncasecmp.c (strncasecmp): Include ansidecl.h/stdarg.h, not
+ sys/types.h.
+ * strcasecmp.c (strcasecmp): Ditto.
+
+Tue Oct 10 11:03:24 1995 Fred Fish <fnf@cygnus.com>
+
+ * Makefile.in (BISON): Remove macro.
+
+Tue Sep 26 15:06:46 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * Makefile.in (HFILES): Add default empty definition.
+ * mpw-config.in (config.h): Only update if changed.
+ * mpw-make.in: Remove.
+ * mpw-make.sed: New file, edits Makefile.in into MPW makefile.
+ * mpw.c: Remove semi-clone of strerror code.
+ (sys_nerr, sys_errlist): Define here.
+ (Microseconds): Only define as A-line trap if m68k Mac.
+
+Wed Sep 20 12:53:32 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (maintainer-clean): New synonym for distclean.
+
+Mon Aug 28 19:47:52 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.table: For host, generalize rs6000-ibm-aix*
+ to *-ibm-aix* so we also include powerpc.
+
+Tue Aug 22 03:18:05 1995 Ken Raeburn <raeburn@kr-laptop.cygnus.com>
+
+ Fri Jun 16 18:35:40 1995 Pat Rankin (rankin@eql.caltech.edu)
+
+ * xstrerror.c: New file.
+ * Makefile.in, vmsbuild.com: Compile it.
+
+Mon Jul 31 12:16:32 1995 steve chamberlain <sac@slash.cygnus.com>
+
+ * config.table (i386-*-win32): New.
+
+Fri Jul 21 11:35:52 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (MULTITOP): New variable.
+ (MULTIDIRS, MULTISUBDIR, MULTIDO, MULTICLEAN): Likewise.
+ (all): Add multilib support.
+ (install_to_tooldir, *clean): Likewise.
+
+Mon Jul 10 11:47:27 1995 Ken Raeburn <raeburn@cygnus.com>
+
+ * makefile.dos (OBJS): Add hex.o. From DJ Delorie.
+
+Fri Jun 30 17:28:59 1995 Pat Rankin (rankin@eql.caltech.edu)
+
+ * vmsbuild.com: create "new-lib.olb", build libiberty under that
+ name, and then make it become "liberty.olb" when done, so that an
+ incomplete build attempt never leaves behind something which looks
+ like a complete library.
+
+Thu Jun 29 00:22:02 1995 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * config/mh-i386pe: New file for PE hosts.
+ * config.table: Understand PE hosts.
+
+Wed Jun 28 19:13:23 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * cplus-dem.c: Update from gcc.
+
+ * argv.c, dummy.c: If __STDC__, #include "alloca-conf.h" after
+ <stddef.h>.
+ * alloca-norm.h: If __STDC__, declare alloca with its parameter.
+
+Thu Jun 22 18:57:47 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ * mpw-make.in (ALL_CFLAGS): Define NEED_basename.
+ * mpw.c: Only test DebugPI once whenever printing debug info.
+ (mpwify_filename): If filename is /tmp/foo, change it into :_foo,
+ also fix to not write on input filename buffer.
+ (mpw_access): Use stat() instead of open(), works for directories
+ as well as files.
+
+Mon Jun 19 00:33:22 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in: Massage broken shells that require 'else true'.
+
+Sat Jun 17 23:21:58 1995 Fred Fish <fnf@cygnus.com>
+
+ * alloca-norm.h: Declare alloca as type "PTR" to match functions.def.
+ Declare __builtin_alloca in the sparc case, as argv.c did.
+ * argv.c: Replace inline version of alloca-norm.h at start of file with
+ a #include of alloca-conf.h. Precede it with an include of ansidecl.h
+ because alloca-norm.h needs to declare alloca as "PTR".
+
+Mon Jun 12 14:24:26 1995 Steve Chamberlain <sac@slash.cygnus.com>
+
+ * win32.c: New file.
+
+Fri Jun 9 15:16:14 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * dummy.c: #include "alloca-conf.h".
+
+Wed Jun 7 11:46:23 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (mostlyclean): Remove stamp-picdir.
+ (clean): Don't.
+
+Mon Jun 5 18:46:06 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config.table (frags): Use toplevel pic frags.
+
+ * Makefile.in (PICFLAG): New macro.
+ (all): Depend on stamp-picdir.
+ (needed-list): Ditto.
+ (.c.o): Also build pic object.
+ (stamp-picdir): New rule.
+ (mostlyclean): Remove pic.
+ (clean): Remove stamp-picdir.
+
+Fri Mar 24 16:55:48 1995 Pat Rankin (rankin@eql.caltech.edu)
+
+ * vmsbuild.com (config.h): Add `#define NEED_basename'.
+
+Tue May 23 10:12:46 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * clock.c, getopt.c, strtod.c, vsprintf.c: Change from using LGPL
+ to libio-style copyright.
+ * getpagesize.c: Remove FSF copyright.
+
+Sat May 20 12:30:23 1995 Ken Raeburn <raeburn@kr-laptop.cygnus.com>
+
+ Added improved VMS support from Pat Rankin:
+
+ Fri Mar 17 18:40:36 1995 Pat Rankin (rankin@eql.caltech.edu)
+
+ * vmsbuild.com: new file.
+
+ * getpagesize.c (getpagesize): implement for VMS;
+ * strerror.c (strerror, strerrno, strtoerrno): add rudimentary
+ support for EVMSERR.
+
+Thu May 18 17:01:42 1995 Ken Raeburn <raeburn@kr-laptop.cygnus.com>
+
+ Wed May 10 14:28:16 1995 Richard Earnshaw (rearnsha@armltd.co.uk)
+
+ * floatformat.c (floatformat_arm_ext): Define.
+
+Tue May 16 13:30:59 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * basename.c, bcmp.c, getcwd.c, insque.c, rename.c, sigsetmask.c,
+ strerror.c, strsignal.c: Remove FSF copyright.
+ * sigsetmask.c: #include <sys/types.h> - seems to be needed by ISC.
+
+Mon May 15 19:53:17 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * bcopy.c, bzero.c, memcmp.c, memcpy.c, memset.c, strchr.c,
+ strrchr.c, strstr.c, vfork.c: Remove FSF Copyright, because this
+ might contaminate libstdc++ with the LGPL. (OK'd by RMS 11 Oct 94.)
+ * strchr.c, strrchr.c: Add cast to suppress const warning.
+
+Thu May 4 14:36:42 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * cplus-dem.c: Use const instead of CONST. Don't include
+ ansidecl.h directly.
+
+Wed Apr 19 01:30:27 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * cplus-dem.c: Don't include libiberty.h. Do declare xmalloc and
+ xrealloc.
+ (-DMAIN): Don't rely on an externally-defined version number;
+ instead, require the version number to be defined as a
+ preprocessor macro. Handle the RS/6000 leading dot. Define
+ xmalloc, xrealloc and fatal. Don't strip a leading underscore
+ if we couldn't demangle the word.
+
+Tue Apr 4 13:03:51 1995 Stan Shebs <shebs@andros.cygnus.com>
+
+ (Old mpw.c change descriptions retained for informational value.)
+ * mpw.c (warning_threshold): Default to .4 sec.
+ (overflow_count, current_progress): New globals.
+ (warn_if_spin_delay): Include current progress type,
+ such as program name, in message.
+ (mpw_start_progress): Set current_progress variable from arg.
+ (mpw_end_progress): Report spin delays by power-of-two-size
+ buckets instead of constant-size buckets.
+
+ * mpw.c: Clean up formatting, types, returns, etc.
+ (ENOSYS): Define.
+ (mpw_fread, mpw_fwrite): Define.
+ (sleep): Define correctly.
+
+ * mpw.c: New code to implement cursor spinning support.
+ (umask): New function.
+ (mpw_fopen, mpw_fseek, stat, fstat): Call PROGRESS.
+
+ * mpw.c (mpw_basename, mpw_mixed_basename): New functions, find
+ basenames for MPW and MPW/Unix filenames.
+ (mpw_special_init): New function, calls Macsbug if desired.
+
+ * mpw.c: Add GPL notice.
+ (mpwify_filename): Add more transformations.
+ (mpw_fopen): Call mpwify_filename on file names.
+ (rename): Remove.
+ (chdir, getcwd): Add simple definitions.
+
+ * mpw.c: Random cleanups, remove unused code bits.
+ Added copy of strerror.c for gcc's use.
+ (stat, fstat, _stat): New versions based on Guido van Rossum code.
+
+ * mpw.c (mpw_fseek): Make it work correctly when doing SEEK_CUR.
+
+ * mpw.c (stat): Remove hack definition, get from sys/stat.h.
+ (fork, vfork, etc): Print error messages if called.
+ (getrusage, sbrk, environ, isatty, link, utime, mkdir, rmdir,
+ rename, chown): Define.
+
+ * mpw-config.in: New file, MPW version of configure.in.
+ * mpw-make.in: New file, MPW version of Makefile.in.
+ * mpw.c: New file, MPW compatibility routines.
+
+Fri Mar 24 14:10:30 1995 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * basename.c: Include config.h before checking for NEED_basename.
+
+Thu Mar 23 19:09:54 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * functions.def: Add DEFFUNC for basename.
+
+ * basename.c: Only define basename if NEED_basename.
+
+Thu Mar 16 13:36:05 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config.table: Fix --enable-shared logic for native builds.
+
+Mon Mar 13 11:05:11 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * cplus-dem.c (demangle_template): Demangle bool literals properly.
+
+Mon Mar 6 23:57:28 1995 Stu Grossman (grossman@cygnus.com)
+
+ * strtol.c strtoul.c: Replace these with less buggy versions from
+ NetBSD. (strtoul in particular couldn't handle base 16.)
+
+Wed Mar 1 15:59:01 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * config/mt-vxworks5 (HDEFINES): Define NO_SYS_PARAM_H.
+
+ * clock.c: If NO_SYS_PARAM_H is defined, don't include
+ <sys/param.h>.
+ * getcwd.c, getpagesize.c, getruntime.c: Likewise.
+
+Fri Feb 17 15:40:55 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * getruntime.c (get_run_time): Don't assume that CLOCKS_PER_SEC is
+ a number; ANSI appears to permit any expression, including a
+ function call.
+
+ * config.table (*-*-vxworks5*): Use mt-vxworks5 when configuring
+ xiberty.
+ * config/mt-vxworks5: New file.
+
+Thu Feb 9 14:19:45 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * basename.c (basename): Change argument to be const.
+
+Wed Feb 8 18:06:52 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (lneeded-list): Don't worry about xmalloc.
+
+Sun Jan 15 00:40:36 1995 Jeff Law (law@snake.cs.utah.edu)
+
+ * Makefile.in (distclean): Delete xhost-mkfrag.
+
+Thu Jan 12 16:54:18 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (lneeded-list): If alloca.o is needed, so is xmalloc.o.
+
+Wed Jan 11 22:39:56 1995 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * hex.c: New file.
+ * Makefile.in (REQUIRED_OFILES, CFILES): List it.
+ (hex.o): Add dependencies.
+
+ * cplus-dem.c (demangle_prefix): For GNU style constructor and
+ destructor names, try demangling the remainder of the string.
+
+Wed Dec 28 00:49:15 1994 Ian Lance Taylor <ian@tweedledumb.cygnus.com>
+
+ * vasprintf.c (int_vasprintf): New static function.
+ (vasprintf): Use int_vasprintf. Removes assumption that va_list
+ is assignment compatible.
+
+Sat Nov 5 19:29:12 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * Makefile.in (LIBCFLAGS): New variable.
+ (FLAGS_TO_PASS): Pass it.
+ (.c.o): Use it.
+
+Thu Nov 3 19:09:47 1994 Ken Raeburn <raeburn@cujo.cygnus.com>
+
+ * getopt.c, getopt1.c: Do compile these functions under Linux,
+ since many native versions are based on glibc but are buggy.
+
+Mon Oct 24 15:16:46 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * vasprintf.c: Make 'format' arg be const, to avoid a mismatch
+ with prototype in GNU libc. Support stdarg.h as well as varargs.h.
+
+Tue Oct 11 17:48:27 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * Makefile.in (REQUIRED_OFILES): Add vasprintf.o.
+ * functions.def: Remove vasprintf.
+
+Wed Sep 14 17:04:55 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * xmalloc.c (first_break): New static variable.
+ (xmalloc_set_program_name): Record sbrk (0) in first_break.
+ (xmalloc): If memory allocation fails, try to report how much
+ memory was allocated by the program up to this point.
+ (xrealloc): Likewise.
+
+Sun Sep 04 17:58:10 1994 Richard Earnshaw (rwe@pegasus.esprit.ec.org)
+
+ * Makefile.in (ERRORS_CC): New variable, defaulted to $(CC). Use it
+ when linking dummy.
+ * config.table: Add host RISCiX Makefile frag.
+ * config/mh-riscix: New file.
+
+Thu Aug 25 17:29:44 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * Makefile.in (FLAGS_TO_PASS): Define.
+ ($(RULE1)): Use $(FLAGS_TO_PASS).
+
+Wed Aug 24 17:08:47 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * vasprintf.c: Include <string.h>.
+ (vasprintf): Add casts to void for va_arg to avoid gcc warnings.
+ * xatexit.c: Declare malloc.
+
+Fri Aug 19 15:29:12 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * cplus-dem.c (demangle_args): Fix a bug in previous patch (the
+ one below).
+
+Thu Aug 18 14:37:14 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * cplus-dem.c (demangle args): Handle ARM repeat encoding where
+ the type index is greater than 9.
+
+Wed Aug 17 16:13:49 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * cplus-dem.c (demangle_qualified): accept optional '_' between
+ qualified name. This is baecause the template name may end with
+ numeric and can mixed up with the length of next qualified name.
+
+Wed Aug 3 05:52:14 1994 D. V. Henkel-Wallace (gumby@cygnus.com)
+
+ * config/mt-sunos4: Use our standard location for cross-includes
+ and cross-libs when the target is also a "host" environment (ie no
+ newlib; includes and such don't belong to us). This is specific
+ to the Cygnus Support environment.
+
+Tue Aug 2 15:25:12 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * cplus-dem.c (demangle_template): demangle as xxx<'Q'> not
+ xxx<ch=81>.
+
+Mon Aug 1 17:02:48 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * cplus-dem.c (main): flush stdout to make pipe work.
+
+Sat Jul 16 12:56:32 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * config.table (*-*-cxux7*): Recognize.
+ * floatformat.c (floatformat_m88110_ext) [HARRIS_FLOAT_FORMAT]:
+ Harris-specific float format.
+ * config/mh-cxux7: New file.
+
+Wed Jun 29 00:26:17 1994 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * cplus-dem.c (demangle_template): Make sure that the result of
+ consume_count doesn't index beyond the end of the string.
+
+Mon Jun 20 23:54:37 1994 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * cplus-dem.c (gnu_special): Handle vtable mangling of gcc-2.4.5 and
+ earlier. Improve test for new vtable mangling. Change output back
+ to `virtual table'.
+
+Mon Jun 20 11:37:30 1994 Ian Lance Taylor (ian@sanguine.cygnus.com)
+
+ * obstack.c: Always compile this code, even if using the GNU
+ library. Avoids problems with relatively recent binary
+ incompatibility.
+
+Thu Jun 16 17:54:01 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * cplus-dem.c: Include libiberty.h.
+ (xmalloc, xrealloc, free): Don't declare.
+ (strstr): Don't declare parameters.
+ (xmalloc, xrealloc): Don't define.
+ (long_options): Add no-strip-underscores.
+ (main): Call xmalloc_set_program_name. Pass n in short options to
+ getopt_long. Handle option 'n' to not strip underscores.
+ (usage): Mention -n and --no-strip-underscores.
+
+Sun Jun 12 01:37:09 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * cplus-dem.c (demangle_template): Separate consecutive >'s with a
+ space.
+ (gnu_special): Demangle template and qualified names in a vtable name.
+
+Fri May 27 12:27:52 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ From gas-2.3 and binutils-2.4 net releases:
+
+ Wed May 11 22:32:00 1994 DJ Delorie (dj@ctron.com)
+
+ * makefile.dos: [new] Makefile for dos/go32
+ * configure.bat: update for latest files
+ * msdos.c: remove some functions now in libc.a
+
+Fri May 20 18:53:32 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * cplus-dem.c (gnu_special): Recognize thunks, as well as
+ the new naming style for vtables (when -fvtable-thunks).
+
+Wed May 18 13:34:06 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * Makefile.in (XTRAFLAGS): Don't define.
+ (.c.o, dummy.o): Don't use XTRAFLAGS.
+ ($(RULE1)): Don't pass XTRAFLAGS down in recursive call.
+
+Fri May 13 16:02:12 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * vasprintf.c: New file.
+ * Makefile.in, functions.def: Add it.
+
+Fri May 13 16:20:28 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * cplus-dem.c (demangle_fund_type): Grok bool.
+
+Fri May 6 14:44:21 1994 Steve Chamberlain (sac@cygnus.com)
+
+ * config.table: Add go32
+ * config/mh-go32: New template.
+
+Fri May 6 11:01:59 1994 D. V. Henkel-Wallace (gumby@rtl.cygnus.com)
+
+ * config.table, config/mt-sunos4: config for when sun4 is cross target.
+
+Mon Apr 11 00:54:33 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu)
+
+ * getopt.c [not __GNU_LIBRARY__] [__GCC__] [not __STDC__]:
+ Declare strlen to return int. Don't include stddef.h.
+
+Fri Apr 1 00:38:17 1994 Jim Wilson (wilson@mole.gnu.ai.mit.edu)
+
+ * getopt.c: Delete use of IN_GCC to control whether
+ stddef.h or gstddef.h is included.
+
+Thu Apr 14 14:00:56 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * cplus-dem.c (demangle_signature): Fix a bug in template function
+ type numbering.
+
+Wed Apr 13 17:23:03 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * cplus-dem.c (demangle_signature): Fix template function with arm
+ style argument type number, Tn.
+
+Wed Apr 13 17:11:15 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * cplus-dem.c (optable): Add new[] and delete[].
+
+Fri Apr 8 11:21:42 1994 Jim Kingdon (kingdon@deneb.cygnus.com)
+
+ * argv.c (buildargv): Don't produce empty argument just because
+ there is trailing whitespace.
+
+Wed Apr 6 11:42:14 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * cplus-dem.c (demangle_template): fix 'Q' qualified name bug.
+ Handle 'p' same as 'P'.
+ * cplus-dem.c (do_type): Handle 'p' same as 'P'.
+
+Sat Mar 26 12:00:13 1994 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * floatformat.c (get_field, put_field): Fix off by one error in
+ little endian case.
+
+Thu Mar 24 10:40:19 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * floatformat.c (floatformat_from_double): Pass unsigned char *,
+ not char *, to put_field.
+
+Fri Mar 18 12:34:33 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * memmove.c: Re-wrote; placed in public domain.
+
+Wed Mar 16 10:33:07 1994 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * cplus-dem.c (demangle_prefix): If ARM demangling, don't treat
+ __Q* as a constructor.
+
+Mon Mar 14 12:26:02 1994 Ian Lance Taylor (ian@cygnus.com)
+
+ * ieee-float.c: Removed; no longer used.
+ * Makefile.in: Changed accordingly.
+
+Mon Mar 7 12:28:17 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * floatformat.c (get_field): Removed unused local variable i.
+ (put_field): Removed unused local variable i.
+
+Sun Feb 27 21:50:11 1994 Jim Kingdon (kingdon@deneb.cygnus.com)
+
+ * floatformat.c: New file, intended to replace ieee-float.c.
+ * Makefile.in: Change accordingly.
+
+Thu Feb 24 11:51:12 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * getopt.c: Remove #ifdef GETOPT_COMPAT and #if 0 code.
+ (_getopt_initialize): New function, broken out of _getopt_internal.
+ (_getopt_internal):
+ If long_only and the ARGV-element has the form "-f", where f is
+ a valid short option, don't consider it an abbreviated form of
+ a long option that starts with f. Otherwise there would be no
+ way to give the -f short option.
+
+Thu Feb 10 14:44:16 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu)
+
+ * getopt.c [not __GNU_LIBRARY__] [__GNUC__] [not IN_GCC]:
+ Test just __STDC__, not emacs.
+
+Wed Feb 9 00:14:00 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu)
+
+ * getopt.c [not __GNU_LIBRARY__] [__GNUC__] [not IN_GCC]
+ [emacs] [not __STDC__]: Don't include stddef.h. Don't declare strlen.
+
+Fri Dec 24 19:43:00 1993 Noah Friedman (friedman@nutrimat.gnu.ai.mit.edu)
+
+ * getopt.c (_NO_PROTO): Define before config.h is included.
+
+Mon Sep 20 15:59:03 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
+
+ * getopt.c, getopt1.c [emacs || CONFIG_BROKETS]: Include
+ <config.h> only under these, else "config.h".
+
+Thu Aug 12 18:16:49 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
+
+ * getopt.c, getopt1.c [HAVE_CONFIG_H]: Include
+ <config.h> instead of "config.h".
+
+Sun Feb 20 17:17:01 1994 Ian Lance Taylor (ian@lisa.cygnus.com)
+
+ * concat.c: Check ANSI_PROTOTYPES rather than __STDC__ to decide
+ whether to use prototypes or not.
+ * strerror.c (const): Never undefine; let ansidecl.h handle it.
+ * strsignal.c (const): Likewise.
+
+Thu Feb 17 13:27:35 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * xatexit.c (_xexit_cleanup): Declare as extern; don't initialize.
+ Merging common and initialized variables need not be supported by
+ ANSI C compilers.
+ (xatexit): Initialize _xexit_cleanup if not already set.
+ * xexit.c: Comment fix.
+
+Wed Feb 16 01:15:36 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * xmalloc.c: Don't declare xexit; it's declared in libiberty.h.
+ (xrealloc): If oldmem is NULL, allocate with malloc, rather than
+ assuming that realloc works correctly.
+
+Tue Feb 15 09:26:16 1994 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * concat.c, ieee-float.c: Replace inclusion of <string.h>
+ with explicit function declarations, as recommended by Ian Taylor.
+
+Sat Feb 12 10:31:11 1994 David J. Mackenzie (djm@rtl.cygnus.com)
+
+ * xmalloc.c (xmalloc, xrealloc): Use PTR and size_t throughout.
+ (malloc, realloc): Declare.
+
+Thu Feb 10 17:08:19 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * argv.c, basename.c: Include ansidecl.h and libiberty.h.
+ * concat.c, fdmatch.c, getruntime.c, spaces.c: Likewise.
+ * strerror.c, strsignal.c, xatexit.c, xexit.c: Likewise.
+ * xmalloc.c: Likewise.
+ * concat.c: Don't declare xmalloc. If __STDC__, use <stdarg.h>
+ macros, not <varargs.h> macros.
+ * spaces.c (spaces): Make return type const. Don't crash if
+ malloc returns NULL.
+ * strerror.c (struct error_info): Make name and msg fields const.
+ (error_names): Make const.
+ (strerrno): Make const.
+ (strtoerrno): Make argument const.
+ * strsignal.c (struct signal_info): Make name and msg fields
+ const.
+ (signal_names, sys_siglist): Make const.
+ (strsignal, strsigno): Make const.
+ (strtosigno): Make argument const.
+ * xatexit.c: Declare parameter types.
+ * xmalloc.c (name): Make const.
+ (xmalloc_set_program_name): Make argument const.
+ * Makefile.in (INCDIR): Define.
+ (.c.o): Use $(INCDIR).
+ (dummy.o): Likewise.
+ (argv.o, basename.o): New targets; depend on libiberty.h.
+ (concat.o, fdmatch.o, getruntime.o, spaces.o): Likewise.
+ (strerror.o, strsignal.o, xatexit.o, xexit.o): Likewise.
+ (xmalloc.o): Likewise.
+ (cplus-dem.o): New target; depend on demangle.h.
+ (getopt.o, getopt1.o): New targets; depend on getopt.h.
+ (ieee-float.o): New target; depend on ieee-float.h.
+ (obstack.o): New target; depend on obstack.h.
+
+Tue Feb 8 05:29:08 1994 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ Handle obstack_chunk_alloc returning NULL. This allows
+ obstacks to be used by libraries, without forcing them
+ to call exit or longjmp.
+ * obstack.c (_obstack_begin, _obstack_begin_1, _obstack_newchunk):
+ If CALL_CHUNKFUN returns NULL, set alloc_failed, else clear it.
+ (_obstack_begin, _obstack_begin_1): Return 1 if successful, 0 if not.
+
+Tue Feb 8 00:32:28 1994 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * concat.c, ieee-float.c: Include <string.h>.
+
+Sun Feb 6 21:28:46 1994 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ * xmalloc.c (xmalloc_set_program_name): New function.
+ (xmalloc, xrealloc): Include the name in the error message, if set.
+
+ * Replace atexit.c with xatexit.c.
+ * Makefile.in (CFILES), functions.def: Change references.
+
+Sat Feb 5 14:02:32 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * getruntime.c (get_run_time): Use getrusage or times if
+ HAVE_GETRUSAGE or HAVE_TIMES are defined.
+
+Fri Feb 4 15:49:38 1994 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ * atexit.c: New file.
+ * Makefile.in (CFILES), functions.def: Add it.
+ * xexit.c: New file.
+ * Makefile.in (CFILES, REQUIRED_OFILES): Add it.
+ * xmalloc.c (xmalloc, xrealloc): Call xexit instead of exit.
+ Change request for 0 bytes into request for 1 byte.
+
+Wed Feb 2 11:36:49 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * xmalloc.c (xmalloc, xrealloc): Print size using %lu, and cast to
+ unsigned long, to avoid warnings.
+
+Fri Jan 28 17:49:06 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
+
+ * dummy.c: Don't include time.h ever; always define clock_t as
+ "unsigned long". Until gcc/fixincludes ensures that clock_t
+ exists, __STDC__ isn't a sufficient test. And if clock() doesn't
+ exist, clock_t probably doesn't either.
+
+Mon Jan 24 11:52:31 1994 Stan Shebs (shebs@andros.cygnus.com)
+
+ * clock.c, getruntime.c: New files.
+ * Makefile.in: Add to file lists.
+ * functions.def (clock): Add to list.
+ * dummy.c (time.h): Add if __STDC__.
+ (clock_t): #define as "unsigned long" if not __STDC__.
+
+Tue Jan 11 11:27:44 1994 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * strtod.c: Declare atof. From edler@jan.ultra.nyu.edu (Jan
+ Edler).
+
+Tue Dec 28 14:17:30 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * Makefile.in (errors): Use CFLAGS as well as LDFLAGS when
+ linking.
+
+Fri Dec 17 12:26:07 1993 Kung Hsu (kung@cirdan.cygnus.com)
+
+ * cplus-dem.c (demangle_arm_pt): New function. Common code
+ for ARM template demangling.
+ * cplus-dem.c (demangle_class_name): Use demangle_arm_pt.
+ * cplus-dem.c (demangle_prefix): Likewise.
+
+Tue Nov 30 15:47:48 1993 Jason Merrill (jason@deneb.cygnus.com)
+
+ * cplus-dem.c (cplus_demangle_opname): Add CONST to please gcc.
+
+Sat Nov 27 11:05:50 1993 Fred Fish (fnf@cygnus.com)
+
+ Merge changes from tom@basil.icce.rug.nl (Tom R.Hageman)
+ * strerror.c, strsignal.c: As a small space optimization, don't
+ include messages when they aren't actually used.
+
+ Merge changes from takefive.co.at!joe (Josef Leherbauer)
+ * cplus-dem.c (demangle_prefix, demangle_function_name,
+ cplus_demangle_opname): Fixes for systems where cplus_marker
+ is something other than '$'.
+
+Fri Nov 26 13:51:11 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * waitpid.c: Simple-minded approcimation to waitpid
+ using vanilla wait.
+ * functions.def, Makefile.in: Update accordingly,
+
+Thu Nov 18 18:01:15 1993 Kung Hsu (kung@cirdan.cygnus.com)
+
+ * cplus-dem.c(demangle_template): fix bug template instantiation
+ with value of user defined type.
+
+Wed Nov 17 18:30:21 1993 Kung Hsu (kung@cirdan.cygnus.com)
+
+ * cplus-dem.c(cplus_demangle_opname): add the subject new function
+ to support unified search of operator in class.
+
+Wed Nov 10 09:47:22 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ gcc -Wall lint:
+ * strtoul.c (strtoul): use "(digit = *s) != '\0'" not just
+ "digit = *s" as condition in while loop.
+
+Tue Nov 9 15:52:22 1993 Mark Eichin (eichin@cygnus.com)
+
+ * Makefile.in: pass SHELL to recursive make
+
+Thu Nov 4 12:09:26 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * vfprintf.c, vprintf.c, vsprintf.c: Make format arg
+ be (const char*), for ANSI (and gcc w/fixproto) consistency.
+
+Thu Nov 4 08:29:04 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.table: Make *-*-hiux* use mh-hpux.
+
+Fri Oct 22 07:53:15 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * config.table: Add * to end of all OS names.
+
+Tue Oct 19 17:12:01 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * Makefile.in (lneeded-list): ensure that object file names are
+ not duplicated, as multiple instances of the same object file in
+ a library causes problems on some machines
+
+Mon Oct 18 21:59:28 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * strcasecmp.c, strncasecmp.c: Change u_char to unsigned char.
+
+Fri Oct 15 22:17:11 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * strncasecmp.c: new file, implements strncasecmp
+ * strcasecmp.c: new file, implement strcasecmp
+
+ * Makefile.in (CFILES): list these two new source files
+
+ * functions.def: add strcasecmp and strncasecmp entries
+
+Fri Oct 15 14:53:05 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * strtoul.c (strtoul), strtol.c (strtol): Handle overflow
+ according to ANSI C.
+
+Thu Oct 14 16:34:19 1993 Kung Hsu (kung@cirdan.cygnus.com)
+
+ * cplus-dem.c: add support of ARM global constructor/destructor,
+ and 'G' for passing record or union in parameter.
+
+Wed Oct 13 13:36:19 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in: Fix comment to clarify that stuff in REQUIRED_OFILES
+ should not be in functions.def.
+
+Wed Oct 13 13:13:38 1993 Ian Lance Taylor (ian@tweedledumb.cygnus.com)
+
+ * functions.def: Removed xmalloc. Stuff in REQUIRED_OFILES should
+ not be in functions.def.
+
+Mon Oct 4 18:26:39 1993 Kung Hsu (kung@cirdan.cygnus.com)
+
+ * cplus-dem.c: change globl constructor/destructor to proper name
+
+Tue Sep 28 18:11:07 1993 Kung Hsu (kung@cirdan.cygnus.com)
+
+ * cplus-dem.c: fix bug in constructor/destructor
+
+Tue Sep 28 16:20:49 1993 Kung Hsu (kung@cirdan.cygnus.com)
+
+ * cplus-dem.c: support both old and new _vt$... vtbl mangled names
+
+Fri Sep 24 19:07:16 1993 Jason Merrill (jason@deneb.cygnus.com)
+
+ * cplus-dem.c: Fix demangle_template prototype
+
+Fri Sep 24 17:32:55 1993 Kung Hsu (kung@cirdan.cygnus.com)
+
+ * cplus-dem.c: fix template demangling
+ * cplus-dem.c: fix const type demangling
+ * cplus-dem.c: fix constructor/destructor, virtual table,
+ qualifier, global constructor/destructor demangling
+
+Wed Sep 1 23:13:11 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * strsignal.c, strerror.c: Use fully-bracketed initializer to
+ keep gcc -Wall happy.
+
+Fri Aug 27 10:30:09 1993 Jason Merrill (jason@deneb.cygnus.com)
+
+ * cplus-dem.c (do_type): Add CONSTS to make gcc happy with last
+ patch.
+
+Fri Aug 27 11:24:54 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ Patch from Paul Flinders:
+ * cplus-dem.c (do_type): Deal with arrays.
+
+Tue Aug 24 14:23:50 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * cplus-dem.c (demangle_qualified: Deal with GNU format for more
+ than 9 classes.
+
+Wed Aug 18 19:50:29 1993 Jason Merrill (jason@deneb.cygnus.com)
+
+ * Makefile.in (dummy.o): Redirect to /dev/null to avoid "variable
+ not initialized" warnings under HP/UX
+
+Sun Aug 15 20:42:40 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * strerror.c: Move include of stdio.h after sys_errlist #define.
+ Also remove NULL definition (stdio.h always defines NULL, so it
+ never did anything but clutter up the code).
+
+Sat Aug 14 14:21:49 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * Makefile.in, functions.def: handle xmalloc.c
+
+ * xmalloc.c: provide xmalloc and xrealloc functions
+
+Thu Aug 12 17:38:57 1993 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ * cplus-dem.c: Fix a comment.
+
+Sat Aug 7 13:56:35 1993 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ * getopt1.c: Declare const the way getopt.c does.
+
+Fri Aug 6 17:03:13 1993 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ * obstack.c, alloca.c: Update from FSF.
+ * getopt.c, getopt1.c: Update to current FSF version, which
+ doesn't use alloca.
+
+Tue Jul 27 14:03:57 1993 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * Makefile.in (demangle): Add the target with a message saying
+ where demangle went.
+
+Mon Jul 26 15:49:54 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * Makefile.in: Remove obsolete `demangle' target.
+
+Thu Jul 22 08:31:01 1993 Fred Fish (fnf@deneb.cygnus.com)
+
+ * cplus-dem.c (arm_special): Apply patch from arg@lucid.com to
+ avoid infinite loop on vtbl symbols with disambiguating "junk"
+ tacked on the end.
+
+Mon Jul 19 14:10:37 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * strsignal.c: work around some systems losing definitions of
+ sys_siglist
+
+ * config/mh-lynxos: this system has a losing definition of
+ sys_siglist
+
+ * config.table: use mh-lynxos for *-*-lynxos
+
+Mon Jul 19 17:08:52 1993 Ken Raeburn (raeburn@rtl.cygnus.com)
+
+ * config.table: Add support for HPPA BSD hosts.
+
+ * config/mh-hpbsd: New file.
+
+Mon Jul 12 18:00:40 1993 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in (TAGS): make work when srcdir != objdir.
+
+Sun Jun 27 15:35:31 1993 David J. Mackenzie (djm@thepub.cygnus.com)
+
+ * cplus-dem.c (main): Add long options, including --help and
+ --version.
+ (usage): New function from code in main.
+
+Tue Jun 22 11:37:38 1993 Per Bothner (bothner@deneb.cygnus.com)
+
+ * config.table: New shell scipt, sourced by both ./configure,in
+ and ../xiberty/configure.in, to avoid maintainance lossages.
+ * configure.in and ../xiberty/configure.in: Use config.table.
+
+ * configure.in: Don't use mh-aix for AIX 3.2, only for 3.1.
+ * configure.in: Map *-*-irix* (except irix4) to mh-sysv.
+ * ../xiberty/configure.in: Update from ./configure.in.
+
+Tue Jun 15 17:05:31 1993 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: remove parentdir support
+
+Wed May 26 12:59:09 1993 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * cplus-dem.c (xrealloc): Match definition with prototype.
+
+Tue May 25 14:27:51 1993 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * cplus-dem.c (demangle_prefix): Demangle cfront
+ local variables as an extension to ARM demangling.
+
+Fri May 21 09:53:57 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * ieee-float.c: Don't require pointers to double to be aligned.
+
+Tue May 18 17:12:10 1993 Fred Fish (fnf@cygnus.com)
+
+ (merge changes from dlong@cse.ucsc.edu)
+ * cplus-dem.c (consume_count): Simplify.
+ * cplus-dem.c (arm_pt, demangle_class_name): New functions.
+ * cplus-dem.c (various): Calls to arm_pt, demangle_class_name.
+
+ * cplus-dem.c (xmalloc, xrealloc, strstr): Make extern decls into
+ full prototypes.
+ * cplus-dem.c (free): Add prototype.
+ * cplus-dem.c (optable): Fully bracketize initializer.
+
+Fri May 14 17:13:05 1993 Per Bothner (bothner@cygnus.com)
+
+ * cplus-dem.c: Whether initial underscores are stripped
+ depends on the external variable prepends_underscore
+ (which is generated by the binutils Makefile).
+
+Fri May 14 07:32:20 1993 Ken Raeburn (raeburn@deneb.cygnus.com)
+
+ * cplus-dem.c (mop_up, arm_special): Remove some unused variables.
+
+Tue May 4 20:31:59 1993 Fred Fish (fnf@cygnus.com)
+
+ * cplus-dem.c (consume_count): Return zero if arg does not
+ start with digit, and don't consume any input.
+
+Tue May 4 08:10:28 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * Makefile.in (demangle): Use ${srcdir} not $^.
+
+ * strtod.c: New file, needed at least for BSD 4.3.
+
+Sun May 2 11:30:42 1993 Fred Fish (fnf@cygnus.com)
+
+ * strsignal.c (sys_siglist): For ANSI compilations, type is
+ "const char *const". Also remove conditionalization on __STDC__
+ since const is defined away for non-ANSI.
+
+Wed Apr 28 19:29:55 1993 Ken Raeburn (raeburn@deneb.cygnus.com)
+
+ * configure.in: Recognize *-*-hpux.
+ * config/mh-hpux: New file.
+
+Tue Apr 27 15:22:19 1993 Per Bothner (bothner@cygnus.com)
+
+ * tmpnam.c: Added ANSI tmpnam() function.
+ * functions.def, Makefile.in: Update accordingly.
+
+Tue Apr 27 13:38:38 1993 Peter Schauer (pes@regent.e-technik.tu-muenchen.de)
+
+ * cplus-dem.c (demangle_function_name): Get the demangling of
+ stop__1A right.
+
+Fri Apr 16 23:48:24 1993 Jim Kingdon (kingdon at calvin)
+
+ * cplus-dem.c: Declare strstr return type.
+
+Fri Mar 26 12:01:26 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * strsignal.c: Add some AIX signals.
+
+Thu Mar 25 15:17:23 1993 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in (MAKEOVERRIDES): Define to be empty.
+
+Wed Mar 24 01:59:25 1993 david d `zoo' zuhn (zoo at poseidon.cygnus.com)
+
+ * Makefile.in: add installcheck & dvi targets
+
+Thu Mar 18 14:05:44 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * ieee-float.c: New file, moved from ../gdb (since it is
+ needed by ../opcode/m68k-dis.c).
+
+Tue Mar 2 17:47:31 1993 Fred Fish (fnf@cygnus.com)
+
+ * cplus-dem.c: Replace all references to cfront with ARM.
+
+Fri Feb 26 00:17:07 1993 Per Bothner (bothner@rtl.cygnus.com)
+
+ * cplus-dem.c: Fix main program (when compiled with -DMAIN)
+ to be more useful as a filter.
+
+Sat Feb 20 21:41:39 1993 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * Makefile.in (install_to_libdir, install_to_tooldir): Go into the
+ destination directory before running $(RANLIB), in case that
+ program tries to create a file in the current directory as part of
+ its work.
+
+Thu Feb 18 23:00:19 1993 John Gilmore (gnu@cygnus.com)
+
+ * strsignal.c (sys_siglist): Remove yet another *%^&%&$# "const"
+ because BSD 4.4 lacks one. Isn't this fun?
+
+Thu Feb 18 11:24:25 1993 Fred Fish (fnf@cygnus.com)
+
+ * cplus-dem.c (demangle_signature): Set func_done after
+ demangling a template.
+ * cplus-dem.c (demangle_template): Fix several small bugs
+ in demangling GNU style templates.
+ * cplus-dem.c (demangle_prefix): Fix for templates in GNU
+ style constructors.
+ * cplus-dem.c (gnu_special): Fix for templates in GNU style
+ static data members.
+
+Tue Feb 16 17:28:35 1993 Fred Fish (fnf@cygnus.com)
+
+ * cplus-dem.c (demangle_signature): Modify to include type
+ modifiers like static and const in remembered types.
+
+Thu Feb 11 22:20:47 1993 Fred Fish (fnf@cygnus.com)
+
+ * cplus-dem.c (demangled_qualified): Add new parameter that tells
+ whether to prepend or append the qualifiers.
+ * cplus-dem.c (string_prepends): Used now, remove #if 0.
+ * cplus-dem.c (demangle_signature): Call demangle_qualified
+ with prepending.
+ * cplus_dem.c (gnu_special): Recognize static data members that
+ use qualified names.
+ * cplus-dem.c (demangle_qualified): Accumulate qualifiers in a
+ temporary buffer and the prepend or append them to the result,
+ as specified by the new "append" flag.
+ * cplus-dem.c (do_type): Call demangled_qualified with
+ appending.
+
+Mon Dec 28 10:47:19 1992 Ken Raeburn (raeburn@cygnus.com)
+
+ * strsignal.c (signal_table): Now const.
+ (init_signal_tables): Variable eip now points to const.
+
+ * strerror.c (error_table): Now const.
+ (init_error_tables): Variable eip now points to const.
+
+Tue Dec 15 15:36:50 1992 Per Bothner (bothner@cygnus.com)
+
+ * memchr.c (memchr): New (ANSI standard) function.
+ * Makefile.in, functions.def: Added memchr.
+ * Makefile.in (AR_FLAGS): Use rc instad of non-standard cq.
+
+Wed Dec 2 22:49:10 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * getopt.c: remove use of USG around <alloca.h>, which never meant
+ anything anyway
+
+ * config/mh-{aix,apollo68,ncr3000,sysv,sysv4}: removed definitions
+ of USG and USGr4
+
+Thu Nov 19 03:09:33 1992 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * cplus-dem.c (demangle_fund_type): Recognize `w', a wide character;
+ it's now a type according to the ANSI X3J16 working paper; output
+ "wchar_t" for it.
+ (demangle_template): Accept `w' as an integral type.
+ (xmalloc, xrealloc): Use `char *', not `PTR'. Cast calls to their
+ counterparts malloc and realloc to `char *'.
+ (main): Exit with a 0 status.
+ * Makefile.in (demangle): Don't expect the user to define
+ DEMANGLE, instead force to be cplus-dem.c. Look in $(srcdir)/../include
+ for demangle.h. Pass it any HDEFINES or XTRAFLAGS.
+
+Wed Nov 18 18:56:20 1992 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in (AR_FLAGS): Avoid verbosity.
+ * config/mh-sysv4: Remove AR_FLAGS override, use INSTALL=cp,
+ replace USGr4 with HAVE_SYSCONF.
+ * config/mh-solaris: Remove; mh-sysv4 works now.
+ * getpagesize.c: Replace USGr4 with HAVE_SYSCONF.
+ * configure.in: Simplify host matching table, remove separate
+ solaris config file.
+
+Sun Nov 15 09:35:16 1992 Fred Fish (fnf@cygnus.com)
+
+ * configure.in (i[34]86-*-solaris2*): Add, use mh-sysv4.
+
+Tue Nov 3 21:27:03 1992 Brendan Kehoe (brendan@cygnus.com)
+
+ * cplus-dem.c (xmalloc, xrealloc): Add decls.
+ (remember_type): Don't cast xmalloc.
+ (string_need): Likewise; don't cast xrealloc either.
+
+Fri Oct 23 08:52:01 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in, functions.defs, rename.c: added simple
+ implementation of rename, since some binutils programs use it.
+
+Thu Oct 15 15:18:22 1992 Per Bothner (bothner@cygnus.com)
+
+ * strsignal.c: Add appropriate 'const' to sys_siglist
+ extern declaration (if __STDC__). (Needed for Linux.)
+ * strsignal.c (strsignal): Add cast to remove const-ness.
+
+Fri Oct 9 03:22:55 1992 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in (needed.awk, needed2.awk): Remove erroneous \'s
+ before "'s, diagnosed by BSD 4.4 awk.
+
+Thu Oct 8 15:25:12 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: create config.h and needed-list through $(CONFIG_H)
+ and $(NEEDED_LIST), to give some hooks for xiberty.
+
+Thu Oct 1 23:31:42 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * configure.in: use cpu-vendor-triple instead of nested cases
+
+Wed Sep 30 11:26:59 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Makefile.in, argv.c, basename.c, bcmp.c, bcopy.c, bzero.c,
+ concat.c, cplus-dem.c, fdmatch.c, getcwd.c, getopt.c, getopt1.c,
+ getpagesize.c, insque.c, memcmp.c, memcpy.c, memmove.c, memset.c,
+ obstack.c, sigsetmask.c, spaces.c, strchr.c, strerror.c,
+ strrchr.c, strsignal.c, strstr.c, vfork.c, vsprintf.c:
+ Convert from using GPL to LGPL.
+
+Sat Sep 26 04:01:30 1992 John Gilmore (gnu@cygnus.com)
+
+ * Makefile.in (errors): Leave dummy.o and dummy around so that
+ we can see how the needed list was generated (it's sometimes wrong).
+ (mostlyclean): Remove them.
+
+Mon Sep 21 14:50:42 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * getcwd.c: supply a default if MAXPATHLEN is not defined.
+
+ * config/mh-irix4: set EXTRA_OFILES to alloca.o, from WRS.
+
+Wed Sep 9 12:41:48 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: Use XTRAFLAGS when compiling, so that xiberty works
+ when cross-compiling.
+
+Thu Sep 3 13:29:39 1992 K. Richard Pixley (rich@sendai.cygnus.com)
+
+ * cplus-dem.c: (demangle_prefix): reduction in strength of strstr
+ as a time optimization.
+
+ * cplus-dem.c (cplus_demangle): remove strpbrk test. Appears to
+ be more expensive than simply demangling.
+
+ * cplus-dem.c (cplus_match): new function.
+
+Tue Sep 1 15:24:04 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * cplus-dem.c: #include <stdio.h>, to define NULL.
+ Define current_demangling_style.
+
+Sun Aug 30 17:58:19 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * cplus-dem.c: New file, moved from ../gdb.
+ * cplus-dem.c (set_cplus_marker_for_demangling): New exported
+ function, to avoid compiling in target-dependency for CPLUS_MARKER.
+ * cplus-dem.c (cplus_demangle): Allow demangling style option
+ to be passed as a parameter, but using the global variable
+ current_demangling_style as a default.
+ * Makefile.in: Update for cplus-dem.c
+
+Sat Aug 29 10:44:09 1992 Fred Fish (fnf@cygnus.com)
+
+ * obstack.c: Merge in comment changes from FSF version. Now
+ matches the FSF version exactly.
+
+Fri Aug 28 18:39:08 1992 John Gilmore (gnu@cygnus.com)
+
+ * obstack.c (CALL_FREEFUN): Can't use ?: with void values (at
+ least on losing DECstations!); use if-then-else instead.
+
+Wed Aug 19 14:40:34 1992 Ian Lance Taylor (ian@cygnus.com)
+
+ * Makefile.in: always create installation directories.
+
+Mon Aug 10 17:33:40 1992 david d `zoo' zuhn (zoo at cirdan.cygnus.com)
+
+ * Makefile.in: clean up definition of CFILES, more comments
+
+Sat Aug 8 23:10:59 1992 Fred Fish (fnf@cygnus.com)
+
+ * getopt.c (my_index): Make first arg const to match strchr,
+ which it sometimes is remapped to.
+
+Sat Aug 1 13:48:50 1992 Fred Fish (fnf@cygnus.com)
+
+ * obstack.c (DEFAULT_ALIGNMENT): Update to match FSF version.
+ * obstack.c (_obstack_begin): Initialize use_extra_arg.
+ * obstack.c (_obstack_begin_1): New, from FSF version.
+
+Mon Jul 20 21:07:58 1992 Fred Fish (fnf@cygnus.com)
+
+ * obstack.c (CALL_CHECKFUN, CALL_FREEFUN): Use use_extra_arg and
+ extra_arg.
+ * obstack.c (_obstack_begin): Remove area_id and flags arguments
+ (previously added for mmalloc support, interface has changed).
+ Also convert flags usage to use use_extra_arg and maybe_empty_object.
+
+Fri Jul 10 00:41:53 1992 Fred Fish (fnf@cygnus.com)
+
+ * argv.c: Move expandargv inline and eliminate static variables.
+ Rewrite to always allocate in powers of two. Fix to return an
+ argv with a single null string arg if passed a null string.
+
+Fri Jul 3 20:27:29 1992 Fred Fish (fnf@cygnus.com)
+
+ * random.c, sigsetmask.c, strerror.c, strsignal.c: Remove
+ "(void)" casts from function calls where the return value is
+ ignored, in accordance with GNU coding standards.
+
+Mon Jun 29 10:54:19 1992 Fred Fish (fnf at cygnus.com)
+
+ * bcopy.c, strerror.c, strsignal.c: Lint.
+
+Thu Jun 25 09:18:41 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * getopt.c: merge changes from make.
+
+Thu Jun 25 04:43:22 1992 John Gilmore (gnu at cygnus.com)
+
+ * alloca.c: Incorporate fixes from gdb/alloca.c.
+ FIXME: Eventually move gdb's alloca configuration files here,
+ and remove gdb/alloca.c and its Makefile.in support.
+
+Tue Jun 23 21:56:30 1992 Fred Fish (fnf@cygnus.com)
+
+ * dummy.c: Define NOTHING to /*nothing*/, change return type
+ of main to int and return zero.
+ * functions.def: Supply NOTHING as the fourth arg to macros
+ that don't have an explicit arg, to satisfy picky preprocessors.
+
+Wed Jun 17 18:13:58 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Makefile.in: Clean up *clean rules, as per standards.texi.
+
+Tue Jun 16 16:11:59 1992 K. Richard Pixley (rich@rtl.cygnus.com)
+
+ * getopt.c, getopt1.c: merged largely gratuitous, mostly
+ whitespace diffs from other prep distributions.
+
+Mon Jun 15 12:25:46 1992 Fred Fish (fnf@cygnus.com)
+
+ * config/mh-ncr3000 (INSTALL): Don't use /usr/ucb/install,
+ it is broken on ncr 3000's.
+
+Mon Jun 15 01:03:26 1992 John Gilmore (gnu at cygnus.com)
+
+ * sigsetmask.c: Rewrite. Old one was very confused about its
+ arguments and result. New one can't do much, but at least knows
+ what it can't do, and it's good enough for GDB's use.
+
+Sun Jun 14 15:17:40 1992 Stu Grossman (grossman at cygnus.com)
+
+ * functions.def: Use proper prototype for strtoul.
+
+Fri Jun 12 19:22:40 1992 John Gilmore (gnu at cygnus.com)
+
+ * Makefile.in: Add random.c.
+ * config/mh-*: Use "true" rather than "echo >/dev/null" for ranlib.
+ * configure.in: update solaris2 config.
+
+Wed Jun 10 16:31:29 1992 Fred Fish (fnf@cygnus.com)
+
+ * random.c: Add for random() and srandom().
+ * functions.def: Add random
+
+Tue Jun 9 17:27:18 1992 Fred Fish (fnf@cygnus.com)
+
+ * config/{mh-ncr3000, mh-sysv4}: Add definition for INSTALL
+ using /usr/ucb/install.
+
+Mon Jun 1 13:20:17 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * strerror.c: Kludge to guard against a conflict with
+ possible declaration of sys_errlist in errno.h.
+
+Sun May 31 15:07:47 1992 Mark Eichin (eichin at cygnus.com)
+
+ * configure.in, config/mh-solaris: add solaris2 config support.
+
+Fri May 29 17:23:23 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * sigsetmask.c: #ifdef out sigsetmask if SIG_SETMASK
+ is not defined (should be defined in signal.h, says Posix.).
+
+Mon May 18 17:35:04 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * getopt.c: merged changes from make-3.62.11.
+
+Fri May 8 14:53:07 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * getopt.c: merged changes from bison-1.18.
+
+Tue May 5 11:51:40 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * Makefile.in: Don't have $(EXTRA_OFILES) depend on config.h,
+ since that introduces a circular dependency.
+ ($(EXTRA_OFILES) are used to build config.h.)
+
+ * strtoul.c: Fixes to handle non-decimal bases better.
+
+Wed Apr 22 09:27:51 1992 Fred Fish (fnf@cygnus.com)
+
+ * config/mh-ncr3000: Replace MINUS_G with CFLAGS.
+ * Makefile.dos: Finish MINUS_G eradication.
+ * Makefile.in (CFILES): Add strsignal.c.
+ * Makefile.in (REQUIRED_OFILES): Add strerror.o strsignal.o
+ * Makefile.in (needed-list): Split creation of errors file to
+ separate make target.
+ * Makefile.in (config.h, needed2.awk, errors): New targets.
+ * Makefile.in (clean): Split to multiple lines, add needed2.awk
+ and config.h.
+ * dummy.c (DEFFUNC, DEFVAR): Add defines and undefs.
+ * functions.def (strerror): Remove from optional list.
+ * functions.def (sys_nerr, sys_errlist, sys_siglist): DEFVAR's
+ * functions.def (strerror, psignal): DEFFUNC's
+ * strerror.c: Rewrite from scratch to use sys_errlist only if
+ available, add errno_max(), add strerrno(), add strtoerrno(),
+ add test driver.
+ * strsignal.c: New file, signal equivalent to strerror.c.
+ Uses sys_siglist if available, defines signo_max(), strsignal(),
+ strsigno(), strtosigno(), psignal(), and test driver.
+
+Mon Apr 20 20:49:32 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in: do not print recursion line.
+
+ * Makefile.in: allow CFLAGS to be passed in from command line.
+ Removed MINUS_G. Default CFLAGS to -g.
+
+Mon Apr 20 12:57:46 1992 Per Bothner (bothner@rtl.cygnus.com)
+
+ * config/mh-aix: New. EXTRA_OFILES lists copysign.o,
+ so libg++ users don't have to be inconvenienced by a
+ libc.a bug (libc.a needs copysign, but doesn't define it!).
+ * configure.in: Use config/mh-aix.
+ * strtoul.c: Handle '-' as required by ANSI.
+ Clean up radix handling.
+ * strstr.c: Fix buggy algorithm.
+ * Makefile.in: Change so that ${EXTRA_OFILES} is
+ appended to needed-list (which is used by libg++).
+
+Fri Apr 10 22:51:41 1992 Fred Fish (fnf@cygnus.com)
+
+ * configure.in: Recognize new ncr3000 config.
+ * config/mh-ncr3000: New config file.
+
+Wed Apr 1 23:31:43 1992 John Gilmore (gnu at cygnus.com)
+
+ * argv.c, dummy.c: Lint.
+
+Tue Mar 31 18:46:44 1992 Fred Fish (fnf@cygnus.com)
+
+ * config/mh-sysv4: New config file.
+ * configure.in (host_makefile_frag): Set to config/mh-sysv4 for
+ host_os == sysv4.
+ * getpagesize.c: For SVR4, use sysconf(_SC_PAGESIZE) to get
+ pagesize.
+
+Sun Mar 29 12:26:42 1992 John Gilmore (gnu at cygnus.com)
+
+ * getopt.c: Lint.
+
+Fri Mar 27 08:32:55 1992 Fred Fish (fnf@cygnus.com)
+
+ * functions.def (alloca): Fix return type and args to avoid
+ type clash with gcc's builtin alloca.
+
+Tue Mar 24 23:33:42 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * configure.in, config/mh-irix4: irix4 support.
+
+ * Makefile.in, functions.def, alloca.c: added alloca.
+
+Tue Mar 24 17:34:46 1992 Stu Grossman (grossman at cygnus.com)
+
+ * obstack.c (CALL_FREEFUN): Make it compile on DECstations.
+
+Thu Mar 19 13:57:42 1992 Fred Fish (fnf@cygnus.com)
+
+ * argv.c: Fix various external function definitions to be
+ correct in an ANSI compilation environment.
+
+Sat Mar 14 17:28:17 1992 Fred Fish (fnf@cygnus.com)
+
+ * obstack.c: Changes to support calling mmalloc functions,
+ which take an additional argument over malloc functions.
+
+Fri Mar 6 22:01:10 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * added check target.
+
+Thu Feb 27 22:19:39 1992 Per Bothner (bothner@cygnus.com)
+
+ * argv.c: #include alloca-conf.h (needed by AIX).
+
+Wed Feb 26 18:04:40 1992 K. Richard Pixley (rich@cygnus.com)
+
+ * Makefile.in, configure.in: removed traces of namesubdir,
+ -subdirs, $(subdir), $(unsubdir), some rcs triggers. Forced
+ copyrights to '92, changed some from Cygnus to FSF.
+
+Sat Feb 22 01:09:21 1992 Stu Grossman (grossman at cygnus.com)
+
+ * argv.c: Check in Fred's version which fixes problems with
+ alloca().
+
+Fri Feb 7 21:46:08 1992 Stu Grossman (grossman at cygnus.com)
+
+ * makefile.dos: Remove NUL to keep patch from failing.
+
+Thu Jan 30 22:48:41 1992 Stu Grossman (grossman at cygnus.com)
+
+ * getopt.c (_getopt_internal): Fix usage of enum has_arg.
+
+Mon Jan 20 18:53:23 1992 Stu Grossman (grossman at cygnus.com)
+
+ * getopt.c, getopt1.c, ../include/getopt.h: Get latest versions.
+
+Sat Jan 18 16:53:01 1992 Fred Fish (fnf at cygnus.com)
+
+ * argv.c: New file to build and destroy standard argument
+ vectors from a command string.
+
+ * Makefile.in: Add argv.c and argv.o to appropriate macros.
+
+Fri Dec 20 12:12:57 1991 Fred Fish (fnf at cygnus.com)
+
+ * configure.in: Change svr4 references to sysv4.
+
+ * rindex.c: Declare return type of externally used function
+ strrchr().
+
+Thu Dec 19 18:35:03 1991 John Gilmore (gnu at cygnus.com)
+
+ * Makefile.in: Remove "***" in normal output, since Make produces
+ this on errors, and it's convenient to search for.
+
+Tue Dec 17 23:21:30 1991 Per Bothner (bothner at cygnus.com)
+
+ * memcmp.c, memcpy.c, memmove.c, memset.c, strchr.c, strrchr.c:
+ New ANSI functions. The old non-ANSI functions (such as bcopy)
+ should be avoided.
+ * bcopy.c: Fix to correctly handle overlapping regions.
+ * index.c, rindex.c: Re-write in terms of strchr() and strrchr().
+ * functions.def: Add the new functions.
+ * functions.def: Add 4th parameter to DEF macro,
+ an ansidecl.h-style prototype.
+ * dummy.c: Use expanded DEF macro to create a dummy function
+ call, with correct parameter types. (This avoids some
+ complaints from gcc about predefined builtins.)
+
+ Move the functionality of config/mh-default into Makefile.in.
+ This avoid duplication, and simplifies things slightly.
+ * Makefile.in: Tweak so we don't need config/mh-default.
+ * README: Update.
+ * configure.in: No longer need config/mh-default.
+ * config/mh-default: Deleted.
+ * config/mh-sysv: Remove lines copied from old mh-default.
+
+Tue Dec 17 05:46:46 1991 John Gilmore (gnu at cygnus.com)
+
+ * fdmatch.c (fdmatch): Don't compare st_rdev, which is for
+ 'mknod' device numbers.
+
+Mon Dec 16 12:25:34 1991 Fred Fish (fnf at cygnus.com)
+
+ * fdmatch.c, Makefile.in: Add new function that takes two
+ open file descriptors and returns nonzero if they refer to
+ the same file, zero otherwise. (used in gdb)
+
+Wed Dec 11 17:40:39 1991 Steve Chamberlain (sac at rtl.cygnus.com)
+ From DJ:
+ * msdos.c: stub functions for dos.
+ * makefile.dos, configdj.bat: new.
+ * getopt.c: Don't include alloca-conf.h in a GO32 world.
+
+
+Tue Dec 10 04:14:49 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * Makefile.in: infodir belongs in datadir.
+
+Fri Dec 6 23:26:45 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * Makefile.in: remove spaces following hyphens because bsd make
+ can't cope. added standards.text support. install using
+ INSTALL_DATA.
+
+ * configure.in: remove commontargets as it is no longer a
+ recognized hook.
+
+Thu Dec 5 22:46:46 1991 K. Richard Pixley (rich at rtl.cygnus.com)
+
+ * Makefile.in: idestdir and ddestdir go away. Added copyrights
+ and shift gpl to v2. Added ChangeLog if it didn't exist. docdir
+ and mandir now keyed off datadir by default.
+
+Fri Nov 22 19:15:29 1991 John Gilmore (gnu at cygnus.com)
+
+ * Makefile.in: find-needed.awk does not fit in 14 chars.
+
+ * Makefile.in: Suppress error checking when compiling the test
+ program, because Ultrix make/sh aborts there due to a bug.
+
+Fri Nov 22 12:23:17 1991 Per Bothner (bothner at cygnus.com)
+
+ * Makefile.in: Re-did how EXTRA_OFILES is used to be more useful.
+ * README: Explained how the auto-configuration works,
+ and how to add new files and/or configurations.
+
+Fri Nov 22 09:45:23 1991 John Gilmore (gnu at cygnus.com)
+
+ * strtoul.c: Avoid defining ULONG_MAX if already defined;
+ cast a const char * to char * for pedants.
+
+ * getopt.c: Only define "const" after local include files get to,
+ and only if they haven't defined it.
+
+Thu Nov 21 16:58:53 1991 John Gilmore (gnu at cygnus.com)
+
+ * getcwd.c (remove getwd.c): GNU code should call getcwd(). We
+ emulate it with getwd() if available. This avoids callers having
+ to find a MAXPATHLEN or PATH_MAX value from somewhere.
+ * Makefile.in, functions.def: getwd->getcwd.
+ * configure.in: Use generic case for every system.
+ * config/mh-{delta88,mach,rs6000,svr4}: Remove.
+ * config/mh-sysv: Use default handling, just add -DUSG.
+
+Thu Nov 14 10:58:05 1991 Per Bothner (bothner at cygnus.com)
+
+ * Makefile.in, config/mh-default: Re-do make magic
+ so that for the default ("automatic") mode we only
+ compile the files we actually need. Do this using
+ a recursive make: The top-level generates the list
+ of needed files (loosely, the ones missing in libc),
+ and then passes that list to the recursive make.
+ * config/mh-mach: Remove obsolete STRERROR-{C,O} macros.
+
+Tue Nov 12 19:10:57 1991 John Gilmore (gnu at cygnus.com)
+
+ RS/6000 host support (grumble).
+
+ * configure.in: Build alloca-conf.h file from alloca-norm.h
+ (everything else) or alloca-botch.h (rs/6000).
+ * Makefile.in: Include . on the include path.
+ * getopt.c: Use alloca-conf.h.
+ * alloca-norm.h: How to declare alloca on reasonable machines.
+ * alloca-botch.h: How to declare alloca on braindead machines.
+
+Tue Nov 12 09:21:48 1991 Fred Fish (fnf at cygnus.com)
+
+ * concat.c : New file, like concat() in gdb but can take a
+ variable number of arguments rather than fixed at 3 args. For
+ now, client applications must supply an xmalloc(), which is a
+ front end function to malloc() that deals with out-of-memory
+ conditions.
+
+ * Makefile.in: Add concat.c and concat.o to appropriate macros.
+
+Sat Nov 9 13:29:59 1991 Fred Fish (fnf at cygnus.com)
+
+ * config/mh-svr4: Add sigsetmask to list of required functions.
+
+Sun Nov 3 11:57:56 1991 Per Bothner (bothner at cygnus.com)
+
+ * vsprintf.c: New file.
+ * functions.def, Makefile.in: Add vsprintf.
+
+Sun Oct 27 16:31:22 1991 John Gilmore (gnu at cygnus.com)
+
+ * configure.in, config/mh-rs6000: Add rs/6000 host support.
+ * Makefile.in: Compile with debug info.
+
+Fri Oct 25 17:01:12 1991 Per Bothner (bothner at cygnus.com)
+
+ * Makefile.in, configure.in, and new files: dummy.c, functions.def,
+ config/mf-default: Added a default configuration mode,
+ which includes into libiberty.a functions that are "missing" in libc.
+ * strdup.c, vprintf.c, vfprintf.c: New files.
+
+Thu Oct 24 02:29:26 1991 Fred Fish (fnf at cygnus.com)
+
+ * config/hmake-svr4: New file.
+
+ * config/hmake-sysv: Add HOST_CFILES and HOST_OFILES.
+
+ * basename.c, bcmp.c, bcopy.c, bzero.c, getpagesize.c getwd.c,
+ index.c, insque.c, rindex.c, spaces.c, strstr.c, vfork.c: New
+ files containing either portable C versions or emulations using
+ native library calls.
+
+ * strerror.c: Add copyright, internal documentation, etc.
+
+ * strtol.c: Replace hardwired hex constants with some more
+ portable macros. Remove illegal (according to gcc) cast.
+
+ * strtoul.c: Replace hardwired hex constant with more portable
+ macro.
+
+ * Makefile.in: Move TARGETLIB and CFLAGS where makefile fragments
+ can override them. Add new source and object file names to CFILES
+ and OFILES respectively.
+
+ * configure.in: Add support for SVR4 makefile fragments.
+
+Tue Oct 22 19:00:23 1991 Steve Chamberlain (steve at cygnus.com)
+
+ * Makefile.in: Move RANLIB, AR and AR_FLAGS to where they can be
+ over-ridden by config/hmake-*
+ * configure.in: added m88kcvs to sysv list
+
+Fri Oct 4 01:29:08 1991 John Gilmore (gnu at cygnus.com)
+
+ * Makefile.in: Most hosts need strerror, but one or two don't,
+ and they override these definitions in the host-dependent makefile
+ fragment.
+ * config/hmake-mach: The odd man out on strerror -- it's supplied.
+ * strerror.c: New file.
+
+ * strtol.c, strtoul.c: Add strtol to libiberty, since Mach lacks
+ it and bfd uses it.
+ * configure.in, Makefile.in, config/hmake-mach: Only configure
+ strtol & strotoul in on Mach.
+
+Tue Sep 3 06:36:23 1991 John Gilmore (gnu at cygint.cygnus.com)
+
+ * obstack.c: Merge with latest FSF version.
+
+
+Local Variables:
+version-control: never
+End:
diff --git a/libiberty/Makefile.in b/libiberty/Makefile.in
new file mode 100644
index 00000000000..46874e12bf4
--- /dev/null
+++ b/libiberty/Makefile.in
@@ -0,0 +1,336 @@
+#
+# Makefile
+# Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 1997 Free Software Foundation
+#
+# This file is part of the libiberty library.
+# Libiberty 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.
+#
+# Libiberty 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 libiberty; 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 file was written, and is maintained by K. Richard Pixley
+# <rich@cygnus.com>.
+
+#
+# Makefile for libiberty directory
+#
+
+srcdir = .
+
+prefix = /usr/local
+
+exec_prefix = $(prefix)
+bindir = $(exec_prefix)/bin
+libdir = $(exec_prefix)/lib
+
+datadir = $(prefix)/share
+
+mandir = $(prefix)/man
+man1dir = $(mandir)/man1
+man2dir = $(mandir)/man2
+man3dir = $(mandir)/man3
+man4dir = $(mandir)/man4
+man5dir = $(mandir)/man5
+man6dir = $(mandir)/man6
+man7dir = $(mandir)/man7
+man8dir = $(mandir)/man8
+man9dir = $(mandir)/man9
+infodir = $(prefix)/info
+includedir = $(prefix)/include
+
+SHELL = /bin/sh
+
+# Multilib support variables.
+MULTISRCTOP =
+MULTIBUILDTOP =
+MULTIDIRS =
+MULTISUBDIR =
+MULTIDO = true
+MULTICLEAN = true
+
+INSTALL = install -c
+INSTALL_PROGRAM = $(INSTALL)
+INSTALL_DATA = $(INSTALL)
+
+AR = ar
+AR_FLAGS = rc
+
+ERRORS_CC = $(CC)
+CC = cc
+CFLAGS = -g
+LIBCFLAGS = $(CFLAGS)
+MAKEINFO = makeinfo
+RANLIB = ranlib
+
+PICFLAG =
+
+MAKEOVERRIDES =
+
+TARGETLIB = libiberty.a
+
+CONFIG_H = lconfig.h
+NEEDED_LIST = lneeded-list
+
+# HOST_OFILES contains the list of objects that should be in the
+# library (in addition to the REQUIRED_OFILES and EXTRA_OFILES).
+# A configuration may override this with a fixed list a object files
+# names (hard to maintain), or some other way to generate a list.
+HOST_OFILES=`cat needed-list`
+
+# Extra targets that the top-level target depends on.
+# Specifically, what needs to be made before HOST_OFILES can be used.
+# Can be empty if HOST_OFILES is just a list of file names.
+DO_ALSO = needed-list
+
+# A configuration can specify extra .o files that should be included,
+# even if they are in libc. (Perhaps the libc version is buggy.)
+EXTRA_OFILES =
+
+# Flags to pass to a recursive make.
+FLAGS_TO_PASS = \
+ "AR=$(AR)" \
+ "AR_FLAGS=$(AR_FLAGS)" \
+ "CC=$(CC)" \
+ "CFLAGS=$(CFLAGS)" \
+ "LIBCFLAGS=$(LIBCFLAGS)" \
+ "EXTRA_OFILES=$(EXTRA_OFILES)" \
+ "HDEFINES=$(HDEFINES)" \
+ "INSTALL=$(INSTALL)" \
+ "INSTALL_DATA=$(INSTALL_DATA)" \
+ "INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \
+ "LDFLAGS=$(LDFLAGS)" \
+ "LOADLIBES=$(LOADLIBES)" \
+ "PICFLAG=$(PICFLAG)" \
+ "RANLIB=$(RANLIB)" \
+ "SHELL=$(SHELL)"
+
+all: stamp-picdir $(TARGETLIB) required-list
+ @if [ "$(RULE1)" != "not-used" ]; then \
+ $(MULTIDO) $(FLAGS_TO_PASS) multi-do DO=all; \
+ else true; \
+ fi
+
+.PHONY: check installcheck
+check installcheck:
+
+
+#### Host, target, and site specific Makefile fragments come in here.
+###
+
+INCDIR=$(srcdir)/$(MULTISRCTOP)../include
+
+COMPILE.c = $(CC) -c $(LIBCFLAGS) -I. -I$(INCDIR) $(HDEFINES)
+.c.o:
+ test -z "$(PICFLAG)" || \
+ $(COMPILE.c) $(PICFLAG) $< -o pic/$@
+ $(COMPILE.c) $<
+
+# The default target just invokes make recursively.
+# However, the automatic configuration (in config/mh_default).
+# first causes it to figure out the objects missing in libc.
+info install-info clean-info dvi:
+
+# Include files that are in this directory.
+HFILES =
+
+# NOTE: If you add new files to the library, add them to this list
+# (alphabetical), and add them to REQUIRED_OFILES or 'functions.def'.
+CFILES = alloca.c argv.c atexit.c basename.c bcmp.c bcopy.c bzero.c \
+ choose-temp.c clock.c concat.c cplus-dem.c fdmatch.c fnmatch.c \
+ getcwd.c getopt.c getopt1.c getpagesize.c getruntime.c \
+ floatformat.c hex.c index.c insque.c \
+ memchr.c memcmp.c memcpy.c memmove.c memset.c objalloc.c \
+ obstack.c random.c rename.c rindex.c sigsetmask.c spaces.c \
+ strcasecmp.c strncasecmp.c \
+ strchr.c strdup.c strerror.c strrchr.c strsignal.c \
+ strstr.c strtod.c strtol.c strtoul.c tmpnam.c \
+ vasprintf.c vfork.c vfprintf.c vprintf.c vsprintf.c waitpid.c \
+ xatexit.c xexit.c xmalloc.c xstrdup.c xstrerror.c
+# These are always included in the library.
+REQUIRED_OFILES = argv.o basename.o choose-temp.o concat.o cplus-dem.o \
+ fdmatch.o fnmatch.o getopt.o getopt1.o getruntime.o hex.o \
+ floatformat.o objalloc.o obstack.o pexecute.o spaces.o strerror.o \
+ strsignal.o xatexit.o xexit.o xmalloc.o xstrdup.o xstrerror.o
+
+# Do we want/need any config overrides?
+#
+
+STAGESTUFF = $(TARGETLIB) *.o
+
+INSTALL_DEST = libdir
+install: install_to_$(INSTALL_DEST)
+
+install_to_libdir: all
+ $(INSTALL_DATA) $(TARGETLIB) $(libdir)/$(TARGETLIB).n
+ ( cd $(libdir) ; $(RANLIB) $(libdir)/$(TARGETLIB).n )
+ mv -f $(libdir)/$(TARGETLIB).n $(libdir)$(MULTISUBDIR)/$(TARGETLIB)
+ @$(MULTIDO) $(FLAGS_TO_PASS) multi-do DO=install
+
+install_to_tooldir: all
+ $(INSTALL_DATA) $(TARGETLIB) $(tooldir)/lib/$(TARGETLIB).n
+ ( cd $(tooldir) ; $(RANLIB) $(tooldir)/lib/$(TARGETLIB).n )
+ mv -f $(tooldir)/lib/$(TARGETLIB).n $(tooldir)/lib$(MULTISUBDIR)/$(TARGETLIB)
+ @$(MULTIDO) $(FLAGS_TO_PASS) multi-do DO=install
+
+# The default configuration adds to libiberty all those functions that are
+# missing in libc. More precisely, it includes whatever $(CC) fails to find.
+# Then a sed+awk combination translates the ld error messages into
+# a list of .o files.
+
+stamp-needed: stamp-picdir $(NEEDED_LIST)
+ cp $(NEEDED_LIST) needed-tmp
+ $(SHELL) $(srcdir)/../move-if-change needed-tmp needed-list
+ touch stamp-needed
+
+needed-list: stamp-needed ; @true
+
+lneeded-list: $(EXTRA_OFILES) needed.awk errors
+ rm -f lneeded-list
+ f=""; \
+ for i in `awk -f needed.awk <errors` $(EXTRA_OFILES) ; do \
+ case " $$f " in \
+ *" $$i "*) ;; \
+ *) f="$$f $$i" ;; \
+ esac ; \
+ done ; \
+ case $$f in \
+ *alloca.o*) f="$$f xmalloc.o xexit.o" ;; \
+ esac ; \
+ echo $$f >>lneeded-list
+
+# Generate an awk script that looks for functions in functions.def
+
+needed.awk: $(srcdir)/functions.def Makefile
+ echo "# !Automatically generated from $(srcdir)/functions.def"\
+ "- DO NOT EDIT!" >needed.awk
+ grep '^DEF(' < $(srcdir)/functions.def \
+ | sed -e '/DEF/s|DEF.\([^,]*\).*|/\1/ { printf "\1.o " }|' \
+ >>needed.awk
+
+stamp-config: $(CONFIG_H)
+ cp $(CONFIG_H) config.tmp
+ $(SHELL) $(srcdir)/../move-if-change config.tmp config.h
+ touch stamp-config
+
+config.h: stamp-config ; @true
+
+lconfig.h: needed2.awk errors
+ echo "/* !Automatically generated from $(srcdir)/functions.def"\
+ "- DO NOT EDIT! */" >lconfig.h
+ awk -f needed2.awk <errors >>lconfig.h
+
+# Generate an awk script that looks for variables in functions.def
+
+needed2.awk: $(srcdir)/functions.def Makefile
+ echo "# !Automatically generated from $(srcdir)/functions.def"\
+ "- DO NOT EDIT!" >needed2.awk
+ grep '^DEFVAR(' < $(srcdir)/functions.def \
+ | sed -e '/DEFVAR/s|DEFVAR.\([^,]*\).*|/\1/ { printf "#ifndef NEED_\1\\n#define NEED_\1\\n#endif\\n" }|' \
+ >>needed2.awk
+ grep '^DEFFUNC(' < $(srcdir)/functions.def \
+ | sed -e '/DEFFUNC/s|DEFFUNC.\([^,]*\).*|/\1/ { printf "#ifndef NEED_\1\\n#define NEED_\1\\n#endif\\n" }|' \
+ >>needed2.awk
+
+dummy.o: $(srcdir)/dummy.c $(srcdir)/functions.def
+ $(CC) -c $(CFLAGS) -I. -I$(INCDIR) $(HDEFINES) $(srcdir)/dummy.c 2>/dev/null
+
+errors: dummy.o $(EXTRA_OFILES)
+ -($(ERRORS_CC) -o dummy $(CFLAGS) $(LDFLAGS) $(ERRORS_LDFLAGS) dummy.o $(EXTRA_OFILES) $(LOADLIBES)) >errors 2>&1 || true
+
+# required-list is used when building a shared bfd/opcodes/libiberty library.
+required-list: Makefile
+ echo $(REQUIRED_OFILES) > required-list
+
+$(HOST_OFILES) $(REQUIRED_OFILES) : config.h
+
+RULE1 = $(TARGETLIB)
+$(RULE1): $(REQUIRED_OFILES) $(DO_ALSO) .always.
+ @$(MAKE) RULE1=not-used RULE2=$(TARGETLIB) $(FLAGS_TO_PASS) \
+ "HOST_OFILES=$(HOST_OFILES)"
+
+# Rule invoked by recursive make in $(RULE1).
+RULE2 = not-used
+$(RULE2): $(REQUIRED_OFILES) $(HOST_OFILES)
+ rm -rf $(TARGETLIB)
+ $(AR) $(AR_FLAGS) $(TARGETLIB) \
+ $(REQUIRED_OFILES) $(HOST_OFILES)
+ $(RANLIB) $(TARGETLIB)
+
+stamp-picdir:
+ if [ -n "$(PICFLAG)" ] && [ ! -d pic ]; then \
+ mkdir pic; \
+ else true; fi
+ touch stamp-picdir
+
+.always.:
+# Do nothing.
+
+.PHONY: all etags tags ls clean stage1 stage2 .always.
+
+etags tags: TAGS
+
+TAGS: $(CFILES) $(HFILES)
+ etags `for i in $(HFILES) $(CFILES); do echo $(srcdir)/$$i ; done`
+
+# The standalone demangler (c++filt) has been moved to binutils.
+demangle:
+ @echo "The standalone demangler, now named c++filt, is now"
+ @echo "a part of binutils."
+ @false
+
+ls:
+ @echo Makefile $(HFILES) $(CFILES)
+
+# Need to deal with profiled libraries, too.
+
+mostlyclean:
+ rm -rf *.o pic core errs \#* *.E a.out
+ rm -f needed.awk needed2.awk errors dummy needed-list config.h stamp-*
+ rm -f $(CONFIG_H) $(NEEDED_LIST) stamp-picdir
+ @$(MULTICLEAN) multi-clean DO=mostlyclean
+clean: mostlyclean
+ rm -f *.a required-list tmpmulti.out
+ @$(MULTICLEAN) multi-clean DO=clean
+distclean: clean
+ rm -f *~ Makefile config.status alloca-conf.h xhost-mkfrag TAGS multilib.out
+ @$(MULTICLEAN) multi-clean DO=distclean
+maintainer-clean realclean: distclean
+
+force:
+
+Makefile: $(srcdir)/Makefile.in $(host_makefile_frag) $(target_makefile_frag)
+ $(SHELL) ./config.status
+
+argv.o: $(INCDIR)/libiberty.h
+basename.o: $(INCDIR)/libiberty.h
+concat.o: $(INCDIR)/libiberty.h
+cplus-dem.o: $(INCDIR)/demangle.h
+fdmatch.o: $(INCDIR)/libiberty.h
+fnmatch.o: $(INCDIR)/fnmatch.h
+getopt.o: $(INCDIR)/getopt.h
+getopt1.o: $(INCDIR)/getopt.h
+getruntime.o: $(INCDIR)/libiberty.h
+hex.o: $(INCDIR)/libiberty.h
+floatformat.o: $(INCDIR)/floatformat.h
+objalloc.o: $(INCDIR)/objalloc.h
+obstack.o: $(INCDIR)/obstack.h
+pexecute.o: $(INCDIR)/libiberty.h
+spaces.o: $(INCDIR)/libiberty.h
+strerror.o: $(INCDIR)/libiberty.h
+strsignal.o: $(INCDIR)/libiberty.h
+xatexit.o: $(INCDIR)/libiberty.h
+xexit.o: $(INCDIR)/libiberty.h
+xmalloc.o: $(INCDIR)/libiberty.h
+xstrdup.o: $(INCDIR)/libiberty.h
+xstrerror.o: $(INCDIR)/libiberty.h
diff --git a/libiberty/README b/libiberty/README
new file mode 100644
index 00000000000..5081bbac196
--- /dev/null
+++ b/libiberty/README
@@ -0,0 +1,129 @@
+This directory contains the -liberty library of free software.
+It is a collection of subroutines used by various GNU programs.
+Current members include:
+
+ getopt -- get options from command line
+ obstack -- stacks of arbitrarily-sized objects
+ strerror -- error message strings corresponding to errno
+ strtol -- string-to-long conversion
+ strtoul -- string-to-unsigned-long conversion
+
+We expect many of the GNU subroutines that are floating around to
+eventually arrive here.
+
+To build the library, do:
+
+ ./configure HOSTTYPE
+ make
+
+Please report bugs and fixes to "bug-gnu-utils@prep.ai.mit.edu". Thank you.
+
+ADDING A NEW FILE
+=================
+
+There are two sets of files: Those that are "required" will be
+included in the library for all configurations, while those
+that are "optional" will be included in the library only if "needed."
+
+To add a new required file, edit Makefile to add the source file
+name to CFILES and the object file to REQUIRED_OFILES.
+
+Adding a new optional file is more fragile. As a general rule,
+an optional file will be included in the library if it provides
+functionality missing in the "standard" C library.
+For most hosts, the Makefile automatically figures out which
+functionality is missing by compiling and linking a dummy test
+program, and examining the error messages.
+
+So to get this to work, you should do the following:
+
+1) Select one function defined in the file you're adding.
+For example, the getcwd function.
+2) Add that function to the list in the file functions.def.
+3) The name of the new file must be the same as the function
+you've chosen with the .c suffix added. E.g. getcwd() must be
+defined in getcwd.c. (The file can define other functions as well.)
+4) In Makefile.in, add the name of the source file (e.g. getcwd.c)
+to CFILES.
+
+The file you've added (e.g. getcwd.c) should compile and work
+on all hosts where it is needed (e.g. not found when linking
+the dummy.c program). It does not have to work or even
+compile on hosts where it is not needed.
+
+HOW THE AUTOMATIC CONFIGURATION WORKS
+=====================================
+
+The libiberty.a target (in RULE1) depends on $(DO_ALSO).
+For normal configurations, DO_ALSO=needed-list.
+
+So needed-list is first made. The needed-list rule compiles
+dummy.c. Because dummy.c includes functions.def, the
+resulting object file will contain a call to each of the
+optional functions (for simplicity assume each optional file
+defines a single function). This object file will be linked
+against the standard libraries (as defined by using $(CC)
+and various flags). Any function missing will causes the
+linker to emit an error message. We assume the name
+of the missing function(s) are in the error message(s).
+The awk script find-needed.awk has been generated from
+functions.def. It is used to search the linker output
+messages for words that match the functions listed in
+functions.def. The list of functions found is written
+on a single line to the file needed-list.
+
+After needed-list has been generated, the libiberty.a
+target (in RULE1) just calls 'make' recursively.
+It passes the contents of needed-list using the
+definition (expanded) HOST_OFILES="`cat needed-list`".
+It also tells the inferior 'make' to use RULE2.
+
+The inferior 'make' is very conventional: The main
+rule is $(RULE2) (which is libiberty.a). It depends
+on a list of object files: $(REQUIRED_OFILES) $(HOST_OFILES)
+(and $(EXTRA_OFILES), which is usually empty). The superior
+'make' passes in $(HOST_OFILES); the others are fixed
+in the Makefile.
+
+ADDING A NEW CONFIGURATION
+==========================
+
+On most hosts you should be able to use the scheme for automatically
+figuring out which files are needed. In that case, you probably
+don't need a special Makefile stub for that configuration.
+
+If the fully automatic scheme doesn't work, you may be able to get
+by with defining EXTRA_OFILES in your Makefile stub. This is
+a list of object file names that should be treated as required
+for this configuration - they will be included in libiberty.a,
+regardless of whatever might be in the C library. Moreover,
+when the dummy.c program is linked, it will be linked with
+$(EXTRA_OFILES). Therefore, if a function in functions.def
+is defined by one of the EXTRA_OFILES, it will not be listed as
+"needed". Thus if your hal9000 host needs a special implementation
+of getcwd, you can just create hal9000-getcwd.c, and define:
+ EXTRA_OFILES=hal9000-getcwd.o
+Or if you want to use the libiberty version of strstr(),
+even though there is a version in the C library (it might be
+buggy or slow), just define:
+ EXTRA_OFILES=strstr.o
+
+You can create a "manual" host configuration FOO with a file
+config/mh-FOO. In it, the HOST_OFILES macro should explicitly
+list that subset of the optional files that should be in the
+library. You should also set:
+ DO_ALSO =
+This overrides all of the magic needed to automatically
+determine which files are "needed." However, keeping that list
+up to date is another matter...
+
+HOW THE MANUAL CONFIGURATION WORKS
+==================================
+
+This also uses a recursive make, but the superior make
+does not do anything interesting - it just calls the
+inferior make with HOST_OFILES defined as $(HOST_OFILES),
+which is the list you created in your configuration.
+
+You probably don't want to depend on manual configuration,
+because keeping the HOST_OFILES list up-to-date will be a pain.
diff --git a/libiberty/alloca-botch.h b/libiberty/alloca-botch.h
new file mode 100644
index 00000000000..c909573f58c
--- /dev/null
+++ b/libiberty/alloca-botch.h
@@ -0,0 +1,5 @@
+/* RS/6000 AIX botched alloca and requires a pragma, which ordinary compilers
+ throw up about, so we have to put it in a specially-configured file.
+ Like this one. */
+
+#pragma alloca
diff --git a/libiberty/alloca-norm.h b/libiberty/alloca-norm.h
new file mode 100644
index 00000000000..394a6533277
--- /dev/null
+++ b/libiberty/alloca-norm.h
@@ -0,0 +1,23 @@
+/* "Normal" configuration for alloca. */
+
+#ifdef __GNUC__
+#define alloca __builtin_alloca
+#else /* ! defined (__GNUC__) */
+#if defined (sparc) && defined (sun)
+#include <alloca.h>
+#ifdef __STDC__
+extern void *__builtin_alloca();
+#else /* ! defined (__STDC__) */
+extern char *__builtin_alloca(); /* Stupid include file doesn't declare it */
+#endif /* ! defined (__STDC__) */
+#else /* ! defined (sparc) || ! defined (sun) */
+#ifdef __STDC__
+PTR alloca (size_t);
+#else /* ! defined (__STDC__) */
+PTR alloca (); /* must agree with functions.def */
+#endif /* ! defined (__STDC__) */
+#endif /* ! defined (sparc) || ! defined (sun) */
+#ifdef _WIN32
+#include <malloc.h>
+#endif
+#endif /* ! defined (__GNUC__) */
diff --git a/libiberty/alloca.c b/libiberty/alloca.c
new file mode 100644
index 00000000000..911d42fcb8c
--- /dev/null
+++ b/libiberty/alloca.c
@@ -0,0 +1,479 @@
+/* alloca.c -- allocate automatically reclaimed memory
+ (Mostly) portable public-domain implementation -- D A Gwyn
+
+ This implementation of the PWB library alloca function,
+ which is used to allocate space off the run-time stack so
+ that it is automatically reclaimed upon procedure exit,
+ was inspired by discussions with J. Q. Johnson of Cornell.
+ J.Otto Tennant <jot@cray.com> contributed the Cray support.
+
+ There are some preprocessor constants that can
+ be defined when compiling for your specific system, for
+ improved efficiency; however, the defaults should be okay.
+
+ The general concept of this implementation is to keep
+ track of all alloca-allocated blocks, and reclaim any
+ that are found to be deeper in the stack than the current
+ invocation. This heuristic does not reclaim storage as
+ soon as it becomes invalid, but it will do so eventually.
+
+ As a special case, alloca(0) reclaims storage without
+ allocating any. It is a good idea to use alloca(0) in
+ your main control loop, etc. to force garbage collection. */
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+/* If compiling with GCC, this file's not needed. */
+#ifndef alloca
+
+#ifdef emacs
+#ifdef static
+/* actually, only want this if static is defined as ""
+ -- this is for usg, in which emacs must undefine static
+ in order to make unexec workable
+ */
+#ifndef STACK_DIRECTION
+you
+lose
+-- must know STACK_DIRECTION at compile-time
+#endif /* STACK_DIRECTION undefined */
+#endif /* static */
+#endif /* emacs */
+
+/* If your stack is a linked list of frames, you have to
+ provide an "address metric" ADDRESS_FUNCTION macro. */
+
+#if defined (CRAY) && defined (CRAY_STACKSEG_END)
+long i00afunc ();
+#define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
+#else
+#define ADDRESS_FUNCTION(arg) &(arg)
+#endif
+
+#if __STDC__
+#include <stddef.h>
+typedef void *pointer;
+#else
+typedef char *pointer;
+typedef unsigned size_t;
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+/* Different portions of Emacs need to call different versions of
+ malloc. The Emacs executable needs alloca to call xmalloc, because
+ ordinary malloc isn't protected from input signals. On the other
+ hand, the utilities in lib-src need alloca to call malloc; some of
+ them are very simple, and don't have an xmalloc routine.
+
+ Non-Emacs programs expect this to call use xmalloc.
+
+ Callers below should use malloc. */
+
+#ifndef emacs
+#define malloc xmalloc
+extern pointer xmalloc ();
+#endif
+
+/* Define STACK_DIRECTION if you know the direction of stack
+ growth for your system; otherwise it will be automatically
+ deduced at run-time.
+
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown */
+
+#ifndef STACK_DIRECTION
+#define STACK_DIRECTION 0 /* Direction unknown. */
+#endif
+
+#if STACK_DIRECTION != 0
+
+#define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
+
+#else /* STACK_DIRECTION == 0; need run-time code. */
+
+static int stack_dir; /* 1 or -1 once known. */
+#define STACK_DIR stack_dir
+
+static void
+find_stack_direction ()
+{
+ static char *addr = NULL; /* Address of first `dummy', once known. */
+ auto char dummy; /* To get stack address. */
+
+ if (addr == NULL)
+ { /* Initial entry. */
+ addr = ADDRESS_FUNCTION (dummy);
+
+ find_stack_direction (); /* Recurse once. */
+ }
+ else
+ {
+ /* Second entry. */
+ if (ADDRESS_FUNCTION (dummy) > addr)
+ stack_dir = 1; /* Stack grew upward. */
+ else
+ stack_dir = -1; /* Stack grew downward. */
+ }
+}
+
+#endif /* STACK_DIRECTION == 0 */
+
+/* An "alloca header" is used to:
+ (a) chain together all alloca'ed blocks;
+ (b) keep track of stack depth.
+
+ It is very important that sizeof(header) agree with malloc
+ alignment chunk size. The following default should work okay. */
+
+#ifndef ALIGN_SIZE
+#define ALIGN_SIZE sizeof(double)
+#endif
+
+typedef union hdr
+{
+ char align[ALIGN_SIZE]; /* To force sizeof(header). */
+ struct
+ {
+ union hdr *next; /* For chaining headers. */
+ char *deep; /* For stack depth measure. */
+ } h;
+} header;
+
+static header *last_alloca_header = NULL; /* -> last alloca header. */
+
+/* Return a pointer to at least SIZE bytes of storage,
+ which will be automatically reclaimed upon exit from
+ the procedure that called alloca. Originally, this space
+ was supposed to be taken from the current stack frame of the
+ caller, but that method cannot be made to work for some
+ implementations of C, for example under Gould's UTX/32. */
+
+pointer
+alloca (size)
+ size_t size;
+{
+ auto char probe; /* Probes stack depth: */
+ register char *depth = ADDRESS_FUNCTION (probe);
+
+#if STACK_DIRECTION == 0
+ if (STACK_DIR == 0) /* Unknown growth direction. */
+ find_stack_direction ();
+#endif
+
+ /* Reclaim garbage, defined as all alloca'd storage that
+ was allocated from deeper in the stack than currently. */
+
+ {
+ register header *hp; /* Traverses linked list. */
+
+ for (hp = last_alloca_header; hp != NULL;)
+ if ((STACK_DIR > 0 && hp->h.deep > depth)
+ || (STACK_DIR < 0 && hp->h.deep < depth))
+ {
+ register header *np = hp->h.next;
+
+ free ((pointer) hp); /* Collect garbage. */
+
+ hp = np; /* -> next header. */
+ }
+ else
+ break; /* Rest are not deeper. */
+
+ last_alloca_header = hp; /* -> last valid storage. */
+ }
+
+ if (size == 0)
+ return NULL; /* No allocation required. */
+
+ /* Allocate combined header + user data storage. */
+
+ {
+ register pointer new = malloc (sizeof (header) + size);
+ /* Address of header. */
+
+ ((header *) new)->h.next = last_alloca_header;
+ ((header *) new)->h.deep = depth;
+
+ last_alloca_header = (header *) new;
+
+ /* User storage begins just after header. */
+
+ return (pointer) ((char *) new + sizeof (header));
+ }
+}
+
+#if defined (CRAY) && defined (CRAY_STACKSEG_END)
+
+#ifdef DEBUG_I00AFUNC
+#include <stdio.h>
+#endif
+
+#ifndef CRAY_STACK
+#define CRAY_STACK
+#ifndef CRAY2
+/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
+struct stack_control_header
+ {
+ long shgrow:32; /* Number of times stack has grown. */
+ long shaseg:32; /* Size of increments to stack. */
+ long shhwm:32; /* High water mark of stack. */
+ long shsize:32; /* Current size of stack (all segments). */
+ };
+
+/* The stack segment linkage control information occurs at
+ the high-address end of a stack segment. (The stack
+ grows from low addresses to high addresses.) The initial
+ part of the stack segment linkage control information is
+ 0200 (octal) words. This provides for register storage
+ for the routine which overflows the stack. */
+
+struct stack_segment_linkage
+ {
+ long ss[0200]; /* 0200 overflow words. */
+ long sssize:32; /* Number of words in this segment. */
+ long ssbase:32; /* Offset to stack base. */
+ long:32;
+ long sspseg:32; /* Offset to linkage control of previous
+ segment of stack. */
+ long:32;
+ long sstcpt:32; /* Pointer to task common address block. */
+ long sscsnm; /* Private control structure number for
+ microtasking. */
+ long ssusr1; /* Reserved for user. */
+ long ssusr2; /* Reserved for user. */
+ long sstpid; /* Process ID for pid based multi-tasking. */
+ long ssgvup; /* Pointer to multitasking thread giveup. */
+ long sscray[7]; /* Reserved for Cray Research. */
+ long ssa0;
+ long ssa1;
+ long ssa2;
+ long ssa3;
+ long ssa4;
+ long ssa5;
+ long ssa6;
+ long ssa7;
+ long sss0;
+ long sss1;
+ long sss2;
+ long sss3;
+ long sss4;
+ long sss5;
+ long sss6;
+ long sss7;
+ };
+
+#else /* CRAY2 */
+/* The following structure defines the vector of words
+ returned by the STKSTAT library routine. */
+struct stk_stat
+ {
+ long now; /* Current total stack size. */
+ long maxc; /* Amount of contiguous space which would
+ be required to satisfy the maximum
+ stack demand to date. */
+ long high_water; /* Stack high-water mark. */
+ long overflows; /* Number of stack overflow ($STKOFEN) calls. */
+ long hits; /* Number of internal buffer hits. */
+ long extends; /* Number of block extensions. */
+ long stko_mallocs; /* Block allocations by $STKOFEN. */
+ long underflows; /* Number of stack underflow calls ($STKRETN). */
+ long stko_free; /* Number of deallocations by $STKRETN. */
+ long stkm_free; /* Number of deallocations by $STKMRET. */
+ long segments; /* Current number of stack segments. */
+ long maxs; /* Maximum number of stack segments so far. */
+ long pad_size; /* Stack pad size. */
+ long current_address; /* Current stack segment address. */
+ long current_size; /* Current stack segment size. This
+ number is actually corrupted by STKSTAT to
+ include the fifteen word trailer area. */
+ long initial_address; /* Address of initial segment. */
+ long initial_size; /* Size of initial segment. */
+ };
+
+/* The following structure describes the data structure which trails
+ any stack segment. I think that the description in 'asdef' is
+ out of date. I only describe the parts that I am sure about. */
+
+struct stk_trailer
+ {
+ long this_address; /* Address of this block. */
+ long this_size; /* Size of this block (does not include
+ this trailer). */
+ long unknown2;
+ long unknown3;
+ long link; /* Address of trailer block of previous
+ segment. */
+ long unknown5;
+ long unknown6;
+ long unknown7;
+ long unknown8;
+ long unknown9;
+ long unknown10;
+ long unknown11;
+ long unknown12;
+ long unknown13;
+ long unknown14;
+ };
+
+#endif /* CRAY2 */
+#endif /* not CRAY_STACK */
+
+#ifdef CRAY2
+/* Determine a "stack measure" for an arbitrary ADDRESS.
+ I doubt that "lint" will like this much. */
+
+static long
+i00afunc (long *address)
+{
+ struct stk_stat status;
+ struct stk_trailer *trailer;
+ long *block, size;
+ long result = 0;
+
+ /* We want to iterate through all of the segments. The first
+ step is to get the stack status structure. We could do this
+ more quickly and more directly, perhaps, by referencing the
+ $LM00 common block, but I know that this works. */
+
+ STKSTAT (&status);
+
+ /* Set up the iteration. */
+
+ trailer = (struct stk_trailer *) (status.current_address
+ + status.current_size
+ - 15);
+
+ /* There must be at least one stack segment. Therefore it is
+ a fatal error if "trailer" is null. */
+
+ if (trailer == 0)
+ abort ();
+
+ /* Discard segments that do not contain our argument address. */
+
+ while (trailer != 0)
+ {
+ block = (long *) trailer->this_address;
+ size = trailer->this_size;
+ if (block == 0 || size == 0)
+ abort ();
+ trailer = (struct stk_trailer *) trailer->link;
+ if ((block <= address) && (address < (block + size)))
+ break;
+ }
+
+ /* Set the result to the offset in this segment and add the sizes
+ of all predecessor segments. */
+
+ result = address - block;
+
+ if (trailer == 0)
+ {
+ return result;
+ }
+
+ do
+ {
+ if (trailer->this_size <= 0)
+ abort ();
+ result += trailer->this_size;
+ trailer = (struct stk_trailer *) trailer->link;
+ }
+ while (trailer != 0);
+
+ /* We are done. Note that if you present a bogus address (one
+ not in any segment), you will get a different number back, formed
+ from subtracting the address of the first block. This is probably
+ not what you want. */
+
+ return (result);
+}
+
+#else /* not CRAY2 */
+/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
+ Determine the number of the cell within the stack,
+ given the address of the cell. The purpose of this
+ routine is to linearize, in some sense, stack addresses
+ for alloca. */
+
+static long
+i00afunc (long address)
+{
+ long stkl = 0;
+
+ long size, pseg, this_segment, stack;
+ long result = 0;
+
+ struct stack_segment_linkage *ssptr;
+
+ /* Register B67 contains the address of the end of the
+ current stack segment. If you (as a subprogram) store
+ your registers on the stack and find that you are past
+ the contents of B67, you have overflowed the segment.
+
+ B67 also points to the stack segment linkage control
+ area, which is what we are really interested in. */
+
+ stkl = CRAY_STACKSEG_END ();
+ ssptr = (struct stack_segment_linkage *) stkl;
+
+ /* If one subtracts 'size' from the end of the segment,
+ one has the address of the first word of the segment.
+
+ If this is not the first segment, 'pseg' will be
+ nonzero. */
+
+ pseg = ssptr->sspseg;
+ size = ssptr->sssize;
+
+ this_segment = stkl - size;
+
+ /* It is possible that calling this routine itself caused
+ a stack overflow. Discard stack segments which do not
+ contain the target address. */
+
+ while (!(this_segment <= address && address <= stkl))
+ {
+#ifdef DEBUG_I00AFUNC
+ fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
+#endif
+ if (pseg == 0)
+ break;
+ stkl = stkl - pseg;
+ ssptr = (struct stack_segment_linkage *) stkl;
+ size = ssptr->sssize;
+ pseg = ssptr->sspseg;
+ this_segment = stkl - size;
+ }
+
+ result = address - this_segment;
+
+ /* If you subtract pseg from the current end of the stack,
+ you get the address of the previous stack segment's end.
+ This seems a little convoluted to me, but I'll bet you save
+ a cycle somewhere. */
+
+ while (pseg != 0)
+ {
+#ifdef DEBUG_I00AFUNC
+ fprintf (stderr, "%011o %011o\n", pseg, size);
+#endif
+ stkl = stkl - pseg;
+ ssptr = (struct stack_segment_linkage *) stkl;
+ size = ssptr->sssize;
+ pseg = ssptr->sspseg;
+ result += size;
+ }
+ return (result);
+}
+
+#endif /* not CRAY2 */
+#endif /* CRAY */
+
+#endif /* no alloca */
diff --git a/libiberty/argv.c b/libiberty/argv.c
new file mode 100644
index 00000000000..60694f919bb
--- /dev/null
+++ b/libiberty/argv.c
@@ -0,0 +1,333 @@
+/* Create and destroy argument vectors (argv's)
+ Copyright (C) 1992 Free Software Foundation, Inc.
+ Written by Fred Fish @ Cygnus Support
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; see the file COPYING.LIB. If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+
+/* Create and destroy argument vectors. An argument vector is simply an
+ array of string pointers, terminated by a NULL pointer. */
+
+#include "ansidecl.h"
+#include "libiberty.h"
+
+#ifdef isspace
+#undef isspace
+#endif
+#define isspace(ch) ((ch) == ' ' || (ch) == '\t')
+
+/* Routines imported from standard C runtime libraries. */
+
+#ifdef __STDC__
+
+#include <stddef.h>
+extern void *memcpy (void *s1, const void *s2, size_t n); /* 4.11.2.1 */
+extern size_t strlen (const char *s); /* 4.11.6.3 */
+extern void *malloc (size_t size); /* 4.10.3.3 */
+extern void *realloc (void *ptr, size_t size); /* 4.10.3.4 */
+extern void free (void *ptr); /* 4.10.3.2 */
+extern char *strdup (const char *s); /* Non-ANSI */
+
+#else /* !__STDC__ */
+
+#if !defined _WIN32 || defined __GNUC__
+extern char *memcpy (); /* Copy memory region */
+extern int strlen (); /* Count length of string */
+extern char *malloc (); /* Standard memory allocater */
+extern char *realloc (); /* Standard memory reallocator */
+extern void free (); /* Free malloc'd memory */
+extern char *strdup (); /* Duplicate a string */
+#endif
+
+#endif /* __STDC__ */
+
+#include "alloca-conf.h"
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+#ifndef EOS
+#define EOS '\0'
+#endif
+
+#define INITIAL_MAXARGC 8 /* Number of args + NULL in initial argv */
+
+
+/*
+
+NAME
+
+ freeargv -- free an argument vector
+
+SYNOPSIS
+
+ void freeargv (vector)
+ char **vector;
+
+DESCRIPTION
+
+ Free an argument vector that was built using buildargv. Simply scans
+ through the vector, freeing the memory for each argument until the
+ terminating NULL is found, and then frees the vector itself.
+
+RETURNS
+
+ No value.
+
+*/
+
+void freeargv (vector)
+char **vector;
+{
+ register char **scan;
+
+ if (vector != NULL)
+ {
+ for (scan = vector; *scan != NULL; scan++)
+ {
+ free (*scan);
+ }
+ free (vector);
+ }
+}
+
+/*
+
+NAME
+
+ buildargv -- build an argument vector from a string
+
+SYNOPSIS
+
+ char **buildargv (sp)
+ char *sp;
+
+DESCRIPTION
+
+ Given a pointer to a string, parse the string extracting fields
+ separated by whitespace and optionally enclosed within either single
+ or double quotes (which are stripped off), and build a vector of
+ pointers to copies of the string for each field. The input string
+ remains unchanged.
+
+ All of the memory for the pointer array and copies of the string
+ is obtained from malloc. All of the memory can be returned to the
+ system with the single function call freeargv, which takes the
+ returned result of buildargv, as it's argument.
+
+ The memory for the argv array is dynamically expanded as necessary.
+
+RETURNS
+
+ Returns a pointer to the argument vector if successful. Returns NULL
+ if the input string pointer is NULL or if there is insufficient
+ memory to complete building the argument vector.
+
+NOTES
+
+ In order to provide a working buffer for extracting arguments into,
+ with appropriate stripping of quotes and translation of backslash
+ sequences, we allocate a working buffer at least as long as the input
+ string. This ensures that we always have enough space in which to
+ work, since the extracted arg is never larger than the input string.
+
+ If the input is a null string (as opposed to a NULL pointer), then
+ buildarg returns an argv that has one arg, a null string.
+
+ Argv is always kept terminated with a NULL arg pointer, so it can
+ be passed to freeargv at any time, or returned, as appropriate.
+*/
+
+char **buildargv (input)
+char *input;
+{
+ char *arg;
+ char *copybuf;
+ int squote = 0;
+ int dquote = 0;
+ int bsquote = 0;
+ int argc = 0;
+ int maxargc = 0;
+ char **argv = NULL;
+ char **nargv;
+
+ if (input != NULL)
+ {
+ copybuf = alloca (strlen (input) + 1);
+ /* Is a do{}while to always execute the loop once. Always return an
+ argv, even for null strings. See NOTES above, test case below. */
+ do
+ {
+ /* Pick off argv[argc] */
+ while (isspace (*input))
+ {
+ input++;
+ }
+ if ((maxargc == 0) || (argc >= (maxargc - 1)))
+ {
+ /* argv needs initialization, or expansion */
+ if (argv == NULL)
+ {
+ maxargc = INITIAL_MAXARGC;
+ nargv = (char **) malloc (maxargc * sizeof (char *));
+ }
+ else
+ {
+ maxargc *= 2;
+ nargv = (char **) realloc (argv, maxargc * sizeof (char *));
+ }
+ if (nargv == NULL)
+ {
+ if (argv != NULL)
+ {
+ freeargv (argv);
+ argv = NULL;
+ }
+ break;
+ }
+ argv = nargv;
+ argv[argc] = NULL;
+ }
+ /* Begin scanning arg */
+ arg = copybuf;
+ while (*input != EOS)
+ {
+ if (isspace (*input) && !squote && !dquote && !bsquote)
+ {
+ break;
+ }
+ else
+ {
+ if (bsquote)
+ {
+ bsquote = 0;
+ *arg++ = *input;
+ }
+ else if (*input == '\\')
+ {
+ bsquote = 1;
+ }
+ else if (squote)
+ {
+ if (*input == '\'')
+ {
+ squote = 0;
+ }
+ else
+ {
+ *arg++ = *input;
+ }
+ }
+ else if (dquote)
+ {
+ if (*input == '"')
+ {
+ dquote = 0;
+ }
+ else
+ {
+ *arg++ = *input;
+ }
+ }
+ else
+ {
+ if (*input == '\'')
+ {
+ squote = 1;
+ }
+ else if (*input == '"')
+ {
+ dquote = 1;
+ }
+ else
+ {
+ *arg++ = *input;
+ }
+ }
+ input++;
+ }
+ }
+ *arg = EOS;
+ argv[argc] = strdup (copybuf);
+ if (argv[argc] == NULL)
+ {
+ freeargv (argv);
+ argv = NULL;
+ break;
+ }
+ argc++;
+ argv[argc] = NULL;
+
+ while (isspace (*input))
+ {
+ input++;
+ }
+ }
+ while (*input != EOS);
+ }
+ return (argv);
+}
+
+#ifdef MAIN
+
+/* Simple little test driver. */
+
+static char *tests[] =
+{
+ "a simple command line",
+ "arg 'foo' is single quoted",
+ "arg \"bar\" is double quoted",
+ "arg \"foo bar\" has embedded whitespace",
+ "arg 'Jack said \\'hi\\'' has single quotes",
+ "arg 'Jack said \\\"hi\\\"' has double quotes",
+ "a b c d e f g h i j k l m n o p q r s t u v w x y z 1 2 3 4 5 6 7 8 9",
+
+ /* This should be expanded into only one argument. */
+ "trailing-whitespace ",
+
+ "",
+ NULL
+};
+
+main ()
+{
+ char **argv;
+ char **test;
+ char **targs;
+
+ for (test = tests; *test != NULL; test++)
+ {
+ printf ("buildargv(\"%s\")\n", *test);
+ if ((argv = buildargv (*test)) == NULL)
+ {
+ printf ("failed!\n\n");
+ }
+ else
+ {
+ for (targs = argv; *targs != NULL; targs++)
+ {
+ printf ("\t\"%s\"\n", *targs);
+ }
+ printf ("\n");
+ }
+ freeargv (argv);
+ }
+
+}
+
+#endif /* MAIN */
diff --git a/libiberty/atexit.c b/libiberty/atexit.c
new file mode 100644
index 00000000000..4463cb69501
--- /dev/null
+++ b/libiberty/atexit.c
@@ -0,0 +1,14 @@
+/* Wrapper to implement ANSI C's atexit using SunOS's on_exit. */
+/* This function is in the public domain. --Mike Stump. */
+
+#ifndef NEED_on_exit
+int
+atexit(f)
+ void (*f)();
+{
+ /* If the system doesn't provide a definition for atexit, use on_exit
+ if the system provides that. */
+ on_exit (f, 0);
+ return 0;
+}
+#endif
diff --git a/libiberty/basename.c b/libiberty/basename.c
new file mode 100644
index 00000000000..689b0c2d39a
--- /dev/null
+++ b/libiberty/basename.c
@@ -0,0 +1,43 @@
+/* Return the basename of a pathname.
+ This file is in the public domain. */
+
+/*
+NAME
+ basename -- return pointer to last component of a pathname
+
+SYNOPSIS
+ char *basename (const char *name)
+
+DESCRIPTION
+ Given a pointer to a string containing a typical pathname
+ (/usr/src/cmd/ls/ls.c for example), returns a pointer to the
+ last component of the pathname ("ls.c" in this case).
+
+BUGS
+ Presumes a UNIX style path with UNIX style separators.
+*/
+
+#include "ansidecl.h"
+#include "libiberty.h"
+
+#include "config.h"
+
+#ifdef NEED_basename
+
+char *
+basename (name)
+ const char *name;
+{
+ const char *base = name;
+
+ while (*name)
+ {
+ if (*name++ == '/')
+ {
+ base = name;
+ }
+ }
+ return (char *) base;
+}
+
+#endif
diff --git a/libiberty/bcmp.c b/libiberty/bcmp.c
new file mode 100644
index 00000000000..11e4417db15
--- /dev/null
+++ b/libiberty/bcmp.c
@@ -0,0 +1,49 @@
+/* bcmp
+ This function is in the public domain. */
+
+/*
+
+NAME
+
+ bcmp -- compare two memory regions
+
+SYNOPSIS
+
+ int bcmp (char *from, char *to, int count)
+
+DESCRIPTION
+
+ Compare two memory regions and return zero if they are identical,
+ non-zero otherwise. If count is zero, return zero.
+
+NOTES
+
+ No guarantee is made about the non-zero returned value. In
+ particular, the results may be signficantly different than
+ strcmp(), where the return value is guaranteed to be less than,
+ equal to, or greater than zero, according to lexicographical
+ sorting of the compared regions.
+
+BUGS
+
+*/
+
+
+int
+bcmp (from, to, count)
+ char *from, *to;
+ int count;
+{
+ int rtnval = 0;
+
+ while (count-- > 0)
+ {
+ if (*from++ != *to++)
+ {
+ rtnval = 1;
+ break;
+ }
+ }
+ return (rtnval);
+}
+
diff --git a/libiberty/bcopy.c b/libiberty/bcopy.c
new file mode 100644
index 00000000000..b655363d879
--- /dev/null
+++ b/libiberty/bcopy.c
@@ -0,0 +1,35 @@
+/* bcopy -- copy memory regions of arbitary length
+
+NAME
+ bcopy -- copy memory regions of arbitrary length
+
+SYNOPSIS
+ void bcopy (char *in, char *out, int length)
+
+DESCRIPTION
+ Copy LENGTH bytes from memory region pointed to by IN to memory
+ region pointed to by OUT.
+
+BUGS
+ Significant speed improvements can be made in some cases by
+ implementing copies of multiple bytes simultaneously, or unrolling
+ the copy loop.
+
+*/
+
+void
+bcopy (src, dest, len)
+ register char *src, *dest;
+ int len;
+{
+ if (dest < src)
+ while (len--)
+ *dest++ = *src++;
+ else
+ {
+ char *lasts = src + (len-1);
+ char *lastd = dest + (len-1);
+ while (len--)
+ *(char *)lastd-- = *(char *)lasts--;
+ }
+}
diff --git a/libiberty/bzero.c b/libiberty/bzero.c
new file mode 100644
index 00000000000..d01644b7f4b
--- /dev/null
+++ b/libiberty/bzero.c
@@ -0,0 +1,31 @@
+/* Portable version of bzero for systems without it.
+ This function is in the public domain. */
+
+/*
+NAME
+ bzero -- zero the contents of a specified memory region
+
+SYNOPSIS
+ void bzero (char *to, int count)
+
+DESCRIPTION
+ Zero COUNT bytes of memory pointed to by TO.
+
+BUGS
+ Significant speed enhancements may be made in some environments
+ by zeroing more than a single byte at a time, or by unrolling the
+ loop.
+
+*/
+
+
+void
+bzero (to, count)
+ char *to;
+ int count;
+{
+ while (count-- > 0)
+ {
+ *to++ = 0;
+ }
+}
diff --git a/libiberty/choose-temp.c b/libiberty/choose-temp.c
new file mode 100644
index 00000000000..798de4822a5
--- /dev/null
+++ b/libiberty/choose-temp.c
@@ -0,0 +1,147 @@
+/* Utility to pick a temporary filename prefix.
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 file exports one function: choose_temp_base. */
+
+/* This file lives in at least two places: libiberty and gcc.
+ Don't change one without the other. */
+
+#ifndef NO_SYS_FILE_H
+#include <sys/types.h>
+#include <sys/file.h> /* May get R_OK, etc. on some systems. */
+#endif
+
+#ifndef R_OK
+#define R_OK 4
+#define W_OK 2
+#define X_OK 1
+#endif
+
+#include <stdio.h> /* May get P_tmpdir. */
+
+#ifdef IN_GCC
+#include "config.h"
+#include "gansidecl.h"
+extern char *xmalloc ();
+#else
+#include "ansidecl.h"
+#include "libiberty.h"
+#if defined (__MSDOS__) || defined (_WIN32)
+#define DIR_SEPARATOR '\\'
+#endif
+#endif
+
+#ifndef DIR_SEPARATOR
+#define DIR_SEPARATOR '/'
+#endif
+
+/* On MSDOS, write temp files in current dir
+ because there's no place else we can expect to use. */
+/* ??? Although the current directory is tried as a last resort,
+ this is left in so that on MSDOS it is prefered to /tmp on the
+ off chance that someone requires this, since that was the previous
+ behaviour. */
+#ifdef __MSDOS__
+#ifndef P_tmpdir
+#define P_tmpdir "."
+#endif
+#endif
+
+/* Name of temporary file.
+ mktemp requires 6 trailing X's. */
+#define TEMP_FILE "ccXXXXXX"
+
+/* Subroutine of choose_temp_base.
+ If BASE is non-NULL, returh it.
+ Otherwise it checks if DIR is a usable directory.
+ If success, DIR is returned.
+ Otherwise NULL is returned. */
+
+static char *
+try (dir, base)
+ char *dir, *base;
+{
+ if (base != 0)
+ return base;
+ if (dir != 0
+ && access (dir, R_OK | W_OK | X_OK) == 0)
+ return dir;
+ return 0;
+}
+
+/* Return a prefix for temporary file names or NULL if unable to find one.
+ The current directory is chosen if all else fails so the program is
+ exited if a temporary directory can't be found (mktemp fails).
+ The buffer for the result is obtained with xmalloc. */
+
+char *
+choose_temp_base ()
+{
+ char *base = 0;
+ char *temp_filename;
+ int len;
+ static char tmp[] = { DIR_SEPARATOR, 't', 'm', 'p', 0 };
+ static char usrtmp[] = { DIR_SEPARATOR, 'u', 's', 'r', DIR_SEPARATOR, 't', 'm', 'p', 0 };
+
+#ifndef MPW
+ base = try (getenv ("TMPDIR"), base);
+ base = try (getenv ("TMP"), base);
+ base = try (getenv ("TEMP"), base);
+
+#ifdef P_tmpdir
+ base = try (P_tmpdir, base);
+#endif
+
+ /* Try /usr/tmp, then /tmp. */
+ base = try (usrtmp, base);
+ base = try (tmp, base);
+
+ /* If all else fails, use the current directory! */
+ if (base == 0)
+#ifdef VMS
+ base = "[";
+#else
+ base = ".";
+#endif
+
+#else /* MPW */
+ base = ":";
+#endif
+
+ len = strlen (base);
+ temp_filename = xmalloc (len + 1 /*DIR_SEPARATOR*/
+ + strlen (TEMP_FILE) + 1);
+ strcpy (temp_filename, base);
+
+#ifndef MPW
+ if (len != 0
+ && temp_filename[len-1] != '/'
+ && temp_filename[len-1] != DIR_SEPARATOR)
+ temp_filename[len++] = DIR_SEPARATOR;
+#else /* MPW */
+ if (temp_filename[len-1] != ':')
+ temp_filename[len++] = ':';
+#endif /* MPW */
+ strcpy (temp_filename + len, TEMP_FILE);
+
+ mktemp (temp_filename);
+ if (strlen (temp_filename) == 0)
+ abort ();
+ return temp_filename;
+}
diff --git a/libiberty/clock.c b/libiberty/clock.c
new file mode 100644
index 00000000000..b60de1657a4
--- /dev/null
+++ b/libiberty/clock.c
@@ -0,0 +1,73 @@
+/* ANSI-compatible clock function.
+ Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of the libiberty 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING. If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifdef HAVE_GETRUSAGE
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif
+
+#ifdef HAVE_TIMES
+#ifndef NO_SYS_PARAM_H
+#include <sys/param.h>
+#endif
+#include <sys/times.h>
+#endif
+
+/* FIXME: should be able to declare as clock_t. */
+
+long
+clock ()
+{
+#ifdef HAVE_GETRUSAGE
+ struct rusage rusage;
+
+ getrusage (0, &rusage);
+ return (rusage.ru_utime.tv_sec * 1000000 + rusage.ru_utime.tv_usec
+ + rusage.ru_stime.tv_sec * 1000000 + rusage.ru_stime.tv_usec);
+#else
+#ifdef HAVE_TIMES
+ struct tms tms;
+
+ times (&tms);
+ return (tms.tms_utime + tms.tms_stime) * (1000000 / HZ);
+#else
+#ifdef VMS
+ struct
+ {
+ int proc_user_time;
+ int proc_system_time;
+ int child_user_time;
+ int child_system_time;
+ } vms_times;
+
+ times (&vms_times);
+ return (vms_times.proc_user_time + vms_times.proc_system_time) * 10000;
+#else
+ /* A fallback, if nothing else available. */
+ return 0;
+#endif /* VMS */
+#endif /* HAVE_TIMES */
+#endif /* HAVE_GETRUSAGE */
+}
+
diff --git a/libiberty/concat.c b/libiberty/concat.c
new file mode 100644
index 00000000000..5b132c85764
--- /dev/null
+++ b/libiberty/concat.c
@@ -0,0 +1,167 @@
+/* Concatenate variable number of strings.
+ Copyright (C) 1991, 1994 Free Software Foundation, Inc.
+ Written by Fred Fish @ Cygnus Support
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; see the file COPYING.LIB. If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+
+/*
+
+NAME
+
+ concat -- concatenate a variable number of strings
+
+SYNOPSIS
+
+ #include <varargs.h>
+
+ char *concat (s1, s2, s3, ..., NULL)
+
+DESCRIPTION
+
+ Concatenate a variable number of strings and return the result
+ in freshly malloc'd memory.
+
+ Returns NULL if insufficient memory is available. The argument
+ list is terminated by the first NULL pointer encountered. Pointers
+ to empty strings are ignored.
+
+NOTES
+
+ This function uses xmalloc() which is expected to be a front end
+ function to malloc() that deals with low memory situations. In
+ typical use, if malloc() returns NULL then xmalloc() diverts to an
+ error handler routine which never returns, and thus xmalloc will
+ never return a NULL pointer. If the client application wishes to
+ deal with low memory situations itself, it should supply an xmalloc
+ that just directly invokes malloc and blindly returns whatever
+ malloc returns.
+*/
+
+
+#include "ansidecl.h"
+#include "libiberty.h"
+
+#ifdef ANSI_PROTOTYPES
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+#ifdef __STDC__
+#include <stddef.h>
+extern size_t strlen (const char *s);
+#else
+extern int strlen ();
+#endif
+
+#define NULLP (char *)0
+
+/* VARARGS */
+#ifdef ANSI_PROTOTYPES
+char *
+concat (const char *first, ...)
+#else
+char *
+concat (va_alist)
+ va_dcl
+#endif
+{
+ register int length;
+ register char *newstr;
+ register char *end;
+ register const char *arg;
+ va_list args;
+#ifndef ANSI_PROTOTYPES
+ const char *first;
+#endif
+
+ /* First compute the size of the result and get sufficient memory. */
+
+#ifdef ANSI_PROTOTYPES
+ va_start (args, first);
+#else
+ va_start (args);
+ first = va_arg (args, const char *);
+#endif
+
+ if (first == NULLP)
+ length = 0;
+ else
+ {
+ length = strlen (first);
+ while ((arg = va_arg (args, const char *)) != NULLP)
+ {
+ length += strlen (arg);
+ }
+ }
+ newstr = (char *) xmalloc (length + 1);
+ va_end (args);
+
+ /* Now copy the individual pieces to the result string. */
+
+ if (newstr != NULLP)
+ {
+#ifdef ANSI_PROTOTYPES
+ va_start (args, first);
+#else
+ va_start (args);
+ first = va_arg (args, const char *);
+#endif
+ end = newstr;
+ if (first != NULLP)
+ {
+ arg = first;
+ while (*arg)
+ {
+ *end++ = *arg++;
+ }
+ while ((arg = va_arg (args, const char *)) != NULLP)
+ {
+ while (*arg)
+ {
+ *end++ = *arg++;
+ }
+ }
+ }
+ *end = '\000';
+ va_end (args);
+ }
+
+ return (newstr);
+}
+
+#ifdef MAIN
+
+/* Simple little test driver. */
+
+#include <stdio.h>
+
+int
+main ()
+{
+ printf ("\"\" = \"%s\"\n", concat (NULLP));
+ printf ("\"a\" = \"%s\"\n", concat ("a", NULLP));
+ printf ("\"ab\" = \"%s\"\n", concat ("a", "b", NULLP));
+ printf ("\"abc\" = \"%s\"\n", concat ("a", "b", "c", NULLP));
+ printf ("\"abcd\" = \"%s\"\n", concat ("ab", "cd", NULLP));
+ printf ("\"abcde\" = \"%s\"\n", concat ("ab", "c", "de", NULLP));
+ printf ("\"abcdef\" = \"%s\"\n", concat ("", "a", "", "bcd", "ef", NULLP));
+ return 0;
+}
+
+#endif
diff --git a/libiberty/config.h-vms b/libiberty/config.h-vms
new file mode 100644
index 00000000000..ccac6a2bcc7
--- /dev/null
+++ b/libiberty/config.h-vms
@@ -0,0 +1,13 @@
+#ifndef NEED_strerror
+#define NEED_strerror
+#endif
+#ifndef NEED_basename
+#define NEED_basename
+#endif
+#ifndef NEED_psignal
+#define NEED_psignal
+#endif
+#ifndef NEED_on_exit
+#define NEED_on_exit
+#endif
+
diff --git a/libiberty/config.table b/libiberty/config.table
new file mode 100644
index 00000000000..dba783b489f
--- /dev/null
+++ b/libiberty/config.table
@@ -0,0 +1,69 @@
+case "${host}" in
+ rs6000-ibm-aix3.1 | rs6000-ibm-aix)
+ frag=mh-aix
+ files=${xsrcdir}alloca-botch.h ;;
+ *-ibm-aix*) files=${xsrcdir}alloca-botch.h ;;
+ arm-*-riscix*) frag=mh-riscix ;;
+ m68k-apollo-bsd*) frag=mh-a68bsd ;;
+ m68k-apollo-sysv*) frag=mh-apollo68 ;;
+ i[3456]86-ncr-sysv4*) frag=mh-ncr3000 ;;
+ *-*-cxux7*) frag=mh-cxux7 ;;
+ *-*-cygwin32) frag=mh-cygwin32 ;;
+ *-*-dgux*) frag=mh-sysv ;;
+ hppa*-hp-bsd*) frag=mh-hpbsd ;;
+ *-*-hpux*) frag=mh-hpux ;;
+ *-*-hiux*) frag=mh-hpux ;;
+ *-*-irix4*) frag=mh-irix4 ;;
+ *-*-irix*) frag=mh-sysv ;;
+ *-*-m88kbcs*) frag=mh-sysv ;;
+ *-*-solaris2*) frag=mh-sysv4 ;;
+ *-*-sysv4*) frag=mh-sysv4 ;;
+ *-*-sysv*) frag=mh-sysv ;;
+ *-*-go32) frag=mh-go32 ;;
+ i[345]86-*-windows*) frag=mh-windows ;;
+
+ *-*-vxworks5*)
+ # VxWorks 5 needs special action, because the usual
+ # autoconfiguration scheme does not work.
+ frag=mt-vxworks5
+ ;;
+esac
+
+# Try to handle funky case of solaris 2 -> sun 4.
+case "${host}" in
+ sparc-sun-sunos4.1.3)
+ if [ "${with_cross_host}" != "${host}" ] ; then
+ frag=mt-sunos4
+ fi
+ ;;
+esac
+
+frags=$frag
+
+# If they didn't specify --enable-shared, don't generate shared libs.
+case "${enable_shared}" in
+ yes) shared=yes ;;
+ no) shared=no ;;
+ *) shared=yes ;;
+esac
+if [ "${shared}" = "yes" ]; then
+ case "${host}" in
+ hppa*-*-*) frags="${frags} ../../config/mh-papic" ;;
+ i[3456]86-*-*) frags="${frags} ../../config/mh-x86pic" ;;
+ *-*-*) frags="${frags} ../../config/mh-${host_cpu}pic" ;;
+ esac
+fi
+
+echo "# Warning: this fragment is automatically generated" > temp-frag
+
+for frag in ${frags}; do
+ frag=${srcdir}/${xsrcdir}config/$frag
+ if [ -f ${frag} ]; then
+ echo "Appending ${frag} to xhost-mkfrag"
+ echo "# Following fragment copied from ${frag}" >> temp-frag
+ cat ${frag} >> temp-frag
+ fi
+done
+
+frag=xhost-mkfrag
+${config_shell} ${moveifchange} temp-frag xhost-mkfrag
diff --git a/libiberty/config/mh-a68bsd b/libiberty/config/mh-a68bsd
new file mode 100644
index 00000000000..3c5a237e60b
--- /dev/null
+++ b/libiberty/config/mh-a68bsd
@@ -0,0 +1,2 @@
+RANLIB=ranlib
+CC= cc -A ansi -A runtype,any -A systype,any -U__STDC__
diff --git a/libiberty/config/mh-aix b/libiberty/config/mh-aix
new file mode 100644
index 00000000000..c7b848d976a
--- /dev/null
+++ b/libiberty/config/mh-aix
@@ -0,0 +1,10 @@
+HDEFINES = -D__IEEE_BIG_ENDIAN
+RANLIB=true
+INSTALL=cp
+
+# Most releases of AIX 3.1 include an incorrect internal version of copysign
+# in libc.a for use by some libc public functions including modf. The public
+# version of copysign in libm.a is usable. For the sake of libg++ (which
+# uses modf), we add copysign here. Supposedly, this problem is fixed in AIX
+# 3.1.8 and above, including all releases of AIX 3.2.
+EXTRA_OFILES = copysign.o
diff --git a/libiberty/config/mh-apollo68 b/libiberty/config/mh-apollo68
new file mode 100644
index 00000000000..651770ce31c
--- /dev/null
+++ b/libiberty/config/mh-apollo68
@@ -0,0 +1,2 @@
+RANLIB=true
+CC= cc -A ansi -A runtype,any -A systype,any -U__STDC__
diff --git a/libiberty/config/mh-cxux7 b/libiberty/config/mh-cxux7
new file mode 100644
index 00000000000..6d4d30bf46f
--- /dev/null
+++ b/libiberty/config/mh-cxux7
@@ -0,0 +1,3 @@
+HDEFINES = -DHAVE_SYSCONF -DHARRIS_FLOAT_FORMAT
+RANLIB=true
+INSTALL = cp
diff --git a/libiberty/config/mh-cygwin32 b/libiberty/config/mh-cygwin32
new file mode 100644
index 00000000000..f45bdc8bad7
--- /dev/null
+++ b/libiberty/config/mh-cygwin32
@@ -0,0 +1,2 @@
+HDEFINES=-DNEED_sys_siglist -DNEED_basename -DNEED_strsignal
+EXTRA_OFILES=vasprintf.o random.o
diff --git a/libiberty/config/mh-go32 b/libiberty/config/mh-go32
new file mode 100644
index 00000000000..919290ef539
--- /dev/null
+++ b/libiberty/config/mh-go32
@@ -0,0 +1 @@
+HDEFINES=-DHAVE_GETRUSAGE
diff --git a/libiberty/config/mh-hpbsd b/libiberty/config/mh-hpbsd
new file mode 100644
index 00000000000..ce11dcd6ac9
--- /dev/null
+++ b/libiberty/config/mh-hpbsd
@@ -0,0 +1,2 @@
+# HPPA hosts using BSD
+RANLIB=true
diff --git a/libiberty/config/mh-irix4 b/libiberty/config/mh-irix4
new file mode 100644
index 00000000000..ace76782712
--- /dev/null
+++ b/libiberty/config/mh-irix4
@@ -0,0 +1,4 @@
+CC = cc -cckr
+RANLIB = true
+INSTALL = cp
+EXTRA_OFILES = alloca.o
diff --git a/libiberty/config/mh-ncr3000 b/libiberty/config/mh-ncr3000
new file mode 100644
index 00000000000..3a45c22b128
--- /dev/null
+++ b/libiberty/config/mh-ncr3000
@@ -0,0 +1,19 @@
+# Host configuration file for an NCR 3000 (i486/SVR4) system.
+
+# The NCR 3000 ships with a MetaWare compiler installed as /bin/cc.
+# This compiler not only emits obnoxious copyright messages every time
+# you run it, but it chokes and dies on a whole bunch of GNU source
+# files. Default to using the AT&T compiler installed in /usr/ccs/ATT/cc.
+# Unfortunately though, the AT&T compiler sometimes generates code that
+# the assembler barfs on if -g is used, so disable it by default as well.
+CC = /usr/ccs/ATT/cc
+CFLAGS =
+
+RANLIB = true
+
+# The /usr/ucb/install program is incompatible (complains about unknown
+# group staff). Use good old cp...
+INSTALL = cp
+
+# The l flag generates a warning from the SVR4 archiver, remove it.
+AR_FLAGS = cq
diff --git a/libiberty/config/mh-riscix b/libiberty/config/mh-riscix
new file mode 100644
index 00000000000..0209279de56
--- /dev/null
+++ b/libiberty/config/mh-riscix
@@ -0,0 +1,6 @@
+# The native linker only reports the first undefined symbol if linking with a
+# shared library. So build using gcc and link statically (this requires
+# gcc 2.6.0 or above).
+
+ERRORS_CC = gcc
+ERRORS_LDFLAGS = -static
diff --git a/libiberty/config/mh-sysv b/libiberty/config/mh-sysv
new file mode 100644
index 00000000000..eb102d55010
--- /dev/null
+++ b/libiberty/config/mh-sysv
@@ -0,0 +1 @@
+RANLIB=true
diff --git a/libiberty/config/mh-sysv4 b/libiberty/config/mh-sysv4
new file mode 100644
index 00000000000..4d1aa3cd61d
--- /dev/null
+++ b/libiberty/config/mh-sysv4
@@ -0,0 +1,3 @@
+HDEFINES = -DHAVE_SYSCONF
+RANLIB=true
+INSTALL = cp
diff --git a/libiberty/config/mh-windows b/libiberty/config/mh-windows
new file mode 100644
index 00000000000..f20c51f2191
--- /dev/null
+++ b/libiberty/config/mh-windows
@@ -0,0 +1,2 @@
+HDEFINES=-DNEED_basename -DNEED_sys_siglist -DNEED_strsignal -DNO_SYS_FILE_H
+EXTRA_OFILES=strcasecmp.o vasprintf.o
diff --git a/libiberty/config/mt-sunos4 b/libiberty/config/mt-sunos4
new file mode 100644
index 00000000000..c25baa6ead6
--- /dev/null
+++ b/libiberty/config/mt-sunos4
@@ -0,0 +1,2 @@
+XTRAFLAGS = -isystem /s1/cygnus/dejagnu/sparc-sun-sunos4.1.3/include/
+LOADLIBES = -L/s1/cygnus/dejagnu/sparc-sun-sunos4.1.3/lib
diff --git a/libiberty/config/mt-vxworks5 b/libiberty/config/mt-vxworks5
new file mode 100644
index 00000000000..916d69e5521
--- /dev/null
+++ b/libiberty/config/mt-vxworks5
@@ -0,0 +1,28 @@
+# VxWorks 5.x target Makefile fragment.
+# The autoconfiguration fails for a VxWorks target, because the
+# libraries are actually on the target board, not in the file system.
+# Therefore, we compute the dependencies by hand.
+
+HDEFINES = -DNO_SYS_PARAM_H -DNO_SYS_FILE_H
+CONFIG_H = vxconfig.h
+NEEDED_LIST = vxneeded-list
+
+vxconfig.h: Makefile
+ if [ -f ../newlib/Makefile ]; then \
+ $(MAKE) $(FLAGS_TO_PASS) xconfig.h; \
+ cp xconfig.h vxconfig.h; \
+ else \
+ echo "#define NEED_sys_nerr 1" >vxconfig.h; \
+ echo "#define NEED_sys_errlist 1" >>vxconfig.h; \
+ echo "#define NEED_sys_siglist 1" >>vxconfig.h; \
+ echo "#define NEED_strsignal 1" >>vxconfig.h; \
+ echo "#define NEED_psignal 1" >>vxconfig.h; \
+ fi
+
+vxneeded-list: Makefile
+ if [ -f ../newlib/Makefile ]; then \
+ $(MAKE) $(FLAGS_TO_PASS) xneeded-list; \
+ cp xneeded-list vxneeded-list; \
+ else \
+ echo getopt.o getpagesize.o insque.o random.o strcasecmp.o strncasecmp.o strdup.o vfork.o waitpid.o vasprintf.o >vxneeded-list; \
+ fi
diff --git a/libiberty/configure.bat b/libiberty/configure.bat
new file mode 100644
index 00000000000..ed33777174b
--- /dev/null
+++ b/libiberty/configure.bat
@@ -0,0 +1,15 @@
+@echo off
+if "%1" == "h8/300" goto h8300
+
+echo Configuring libiberty for go32
+copy Makefile.dos Makefile
+echo #define NEED_sys_siglist 1 >> config.h
+echo #define NEED_psignal 1 >> config.h
+update alloca-normal.h alloca-conf.h
+goto exit
+
+:h8300
+echo Configuring libiberty for H8/300
+copy Makefile.dos Makefile
+
+:exit
diff --git a/libiberty/configure.in b/libiberty/configure.in
new file mode 100644
index 00000000000..b0020d8bab4
--- /dev/null
+++ b/libiberty/configure.in
@@ -0,0 +1,66 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../configure.
+
+configdirs=
+srctrigger=getopt1.c
+srcname="-liberty library"
+
+# per-host:
+
+files="alloca-norm.h"
+links="alloca-conf.h"
+
+. ${srcdir}/config.table
+host_makefile_frag=${frag}
+
+# per-target:
+
+# post-target:
+
+# If this is the target libiberty, check at compile time whether we are using
+# newlib. If we are, we already know the files we need, since the linker
+# will fail when run on some of the newlib targets.
+if [ -n "${with_target_subdir}" ] ; then
+ cat > Makefile.tem <<'!EOF!'
+CONFIG_H = xconfig.h
+NEEDED_LIST = xneeded-list
+
+xconfig.h: Makefile
+ if [ -f ../newlib/Makefile ]; then \
+ echo "#define NEED_sys_nerr 1" >xconfig.h; \
+ echo "#define NEED_sys_errlist 1" >>xconfig.h; \
+ echo "#define NEED_sys_siglist 1" >>xconfig.h; \
+ echo "#define NEED_strsignal 1" >>xconfig.h; \
+ echo "#define NEED_psignal 1" >>xconfig.h; \
+ else \
+ $(MAKE) $(FLAGS_TO_PASS) lconfig.h; \
+ cp lconfig.h xconfig.h; \
+ fi
+
+xneeded-list: Makefile
+ if [ -f ../newlib/Makefile ]; then \
+ echo insque.o random.o strdup.o alloca.o vasprintf.o >xneeded-list; \
+ else \
+ $(MAKE) $(FLAGS_TO_PASS) lneeded-list; \
+ cp lneeded-list xneeded-list; \
+ fi
+!EOF!
+sed -e "/^####/ r Makefile.tem" \
+ -e '/INSTALL_DEST =/s/libdir/tooldir/' ${Makefile} > Makefile.tem3
+mv Makefile.tem3 ${Makefile}
+rm -f Makefile.tem
+fi
+
+# We need multilib support, but only if configuring for the target.
+if [ -n "${with_target_subdir}" ] ; then
+ if [ "${srcdir}" = "." ] ; then
+ if [ "${with_target_subdir}" != "." ] ; then
+ . ${with_multisrctop}../../config-ml.in
+ else
+ . ${with_multisrctop}../config-ml.in
+ fi
+ else
+ . ${srcdir}/../config-ml.in
+ fi
+fi
diff --git a/libiberty/copysign.c b/libiberty/copysign.c
new file mode 100644
index 00000000000..0b5f8c3d9df
--- /dev/null
+++ b/libiberty/copysign.c
@@ -0,0 +1,140 @@
+#include <ansidecl.h>
+
+#ifdef __IEEE_BIG_ENDIAN
+
+typedef union
+{
+ double value;
+ struct
+ {
+ unsigned int sign : 1;
+ unsigned int exponent: 11;
+ unsigned int fraction0:4;
+ unsigned int fraction1:16;
+ unsigned int fraction2:16;
+ unsigned int fraction3:16;
+
+ } number;
+ struct
+ {
+ unsigned int sign : 1;
+ unsigned int exponent: 11;
+ unsigned int quiet:1;
+ unsigned int function0:3;
+ unsigned int function1:16;
+ unsigned int function2:16;
+ unsigned int function3:16;
+ } nan;
+ struct
+ {
+ unsigned long msw;
+ unsigned long lsw;
+ } parts;
+ long aslong[2];
+} __ieee_double_shape_type;
+
+#endif
+
+#ifdef __IEEE_LITTLE_ENDIAN
+
+typedef union
+{
+ double value;
+ struct
+ {
+#ifdef __SMALL_BITFIELDS
+ unsigned int fraction3:16;
+ unsigned int fraction2:16;
+ unsigned int fraction1:16;
+ unsigned int fraction0: 4;
+#else
+ unsigned int fraction1:32;
+ unsigned int fraction0:20;
+#endif
+ unsigned int exponent :11;
+ unsigned int sign : 1;
+ } number;
+ struct
+ {
+#ifdef __SMALL_BITFIELDS
+ unsigned int function3:16;
+ unsigned int function2:16;
+ unsigned int function1:16;
+ unsigned int function0:3;
+#else
+ unsigned int function1:32;
+ unsigned int function0:19;
+#endif
+ unsigned int quiet:1;
+ unsigned int exponent: 11;
+ unsigned int sign : 1;
+ } nan;
+ struct
+ {
+ unsigned long lsw;
+ unsigned long msw;
+ } parts;
+
+ long aslong[2];
+
+} __ieee_double_shape_type;
+
+#endif
+
+#ifdef __IEEE_BIG_ENDIAN
+typedef union
+{
+ float value;
+ struct
+ {
+ unsigned int sign : 1;
+ unsigned int exponent: 8;
+ unsigned int fraction0: 7;
+ unsigned int fraction1: 16;
+ } number;
+ struct
+ {
+ unsigned int sign:1;
+ unsigned int exponent:8;
+ unsigned int quiet:1;
+ unsigned int function0:6;
+ unsigned int function1:16;
+ } nan;
+ long p1;
+
+} __ieee_float_shape_type;
+#endif
+
+#ifdef __IEEE_LITTLE_ENDIAN
+typedef union
+{
+ float value;
+ struct
+ {
+ unsigned int fraction0: 7;
+ unsigned int fraction1: 16;
+ unsigned int exponent: 8;
+ unsigned int sign : 1;
+ } number;
+ struct
+ {
+ unsigned int function1:16;
+ unsigned int function0:6;
+ unsigned int quiet:1;
+ unsigned int exponent:8;
+ unsigned int sign:1;
+ } nan;
+ long p1;
+
+} __ieee_float_shape_type;
+#endif
+
+
+double DEFUN(copysign, (x, y), double x AND double y)
+{
+ __ieee_double_shape_type a,b;
+ b.value = y;
+ a.value = x;
+ a.number.sign =b.number.sign;
+ return a.value;
+}
diff --git a/libiberty/cplus-dem.c b/libiberty/cplus-dem.c
new file mode 100644
index 00000000000..5794a5bb869
--- /dev/null
+++ b/libiberty/cplus-dem.c
@@ -0,0 +1,3087 @@
+/* Demangler for GNU C++
+ Copyright 1989, 1991, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+ Written by James Clark (jjc@jclark.uucp)
+ Rewritten by Fred Fish (fnf@cygnus.com) for ARM and Lucid demangling
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 file exports two functions; cplus_mangle_opname and cplus_demangle.
+
+ This file imports xmalloc and xrealloc, which are like malloc and
+ realloc except that they generate a fatal error if there is no
+ available memory. */
+
+/* This file lives in both GCC and libiberty. When making changes, please
+ try not to break either. */
+
+#include <ctype.h>
+#include <string.h>
+#include <stdio.h>
+
+#include <demangle.h>
+#undef CURRENT_DEMANGLING_STYLE
+#define CURRENT_DEMANGLING_STYLE work->options
+
+extern char *xmalloc PARAMS((unsigned));
+extern char *xrealloc PARAMS((char *, unsigned));
+
+static const char *mystrstr PARAMS ((const char *, const char *));
+
+static const char *
+mystrstr (s1, s2)
+ const char *s1, *s2;
+{
+ register const char *p = s1;
+ register int len = strlen (s2);
+
+ for (; (p = strchr (p, *s2)) != 0; p++)
+ {
+ if (strncmp (p, s2, len) == 0)
+ {
+ return (p);
+ }
+ }
+ return (0);
+}
+
+/* In order to allow a single demangler executable to demangle strings
+ using various common values of CPLUS_MARKER, as well as any specific
+ one set at compile time, we maintain a string containing all the
+ commonly used ones, and check to see if the marker we are looking for
+ is in that string. CPLUS_MARKER is usually '$' on systems where the
+ assembler can deal with that. Where the assembler can't, it's usually
+ '.' (but on many systems '.' is used for other things). We put the
+ current defined CPLUS_MARKER first (which defaults to '$'), followed
+ by the next most common value, followed by an explicit '$' in case
+ the value of CPLUS_MARKER is not '$'.
+
+ We could avoid this if we could just get g++ to tell us what the actual
+ cplus marker character is as part of the debug information, perhaps by
+ ensuring that it is the character that terminates the gcc<n>_compiled
+ marker symbol (FIXME). */
+
+#if !defined (CPLUS_MARKER)
+#define CPLUS_MARKER '$'
+#endif
+
+enum demangling_styles current_demangling_style = gnu_demangling;
+
+static char cplus_markers[] = { CPLUS_MARKER, '.', '$', '\0' };
+
+void
+set_cplus_marker_for_demangling (ch)
+ int ch;
+{
+ cplus_markers[0] = ch;
+}
+
+/* Stuff that is shared between sub-routines.
+ Using a shared structure allows cplus_demangle to be reentrant. */
+
+struct work_stuff
+{
+ int options;
+ char **typevec;
+ int ntypes;
+ int typevec_size;
+ int constructor;
+ int destructor;
+ int static_type; /* A static member function */
+ int const_type; /* A const member function */
+};
+
+#define PRINT_ANSI_QUALIFIERS (work -> options & DMGL_ANSI)
+#define PRINT_ARG_TYPES (work -> options & DMGL_PARAMS)
+
+static const struct optable
+{
+ const char *in;
+ const char *out;
+ int flags;
+} optable[] = {
+ {"nw", " new", DMGL_ANSI}, /* new (1.92, ansi) */
+ {"dl", " delete", DMGL_ANSI}, /* new (1.92, ansi) */
+ {"new", " new", 0}, /* old (1.91, and 1.x) */
+ {"delete", " delete", 0}, /* old (1.91, and 1.x) */
+ {"vn", " new []", DMGL_ANSI}, /* GNU, pending ansi */
+ {"vd", " delete []", DMGL_ANSI}, /* GNU, pending ansi */
+ {"as", "=", DMGL_ANSI}, /* ansi */
+ {"ne", "!=", DMGL_ANSI}, /* old, ansi */
+ {"eq", "==", DMGL_ANSI}, /* old, ansi */
+ {"ge", ">=", DMGL_ANSI}, /* old, ansi */
+ {"gt", ">", DMGL_ANSI}, /* old, ansi */
+ {"le", "<=", DMGL_ANSI}, /* old, ansi */
+ {"lt", "<", DMGL_ANSI}, /* old, ansi */
+ {"plus", "+", 0}, /* old */
+ {"pl", "+", DMGL_ANSI}, /* ansi */
+ {"apl", "+=", DMGL_ANSI}, /* ansi */
+ {"minus", "-", 0}, /* old */
+ {"mi", "-", DMGL_ANSI}, /* ansi */
+ {"ami", "-=", DMGL_ANSI}, /* ansi */
+ {"mult", "*", 0}, /* old */
+ {"ml", "*", DMGL_ANSI}, /* ansi */
+ {"amu", "*=", DMGL_ANSI}, /* ansi (ARM/Lucid) */
+ {"aml", "*=", DMGL_ANSI}, /* ansi (GNU/g++) */
+ {"convert", "+", 0}, /* old (unary +) */
+ {"negate", "-", 0}, /* old (unary -) */
+ {"trunc_mod", "%", 0}, /* old */
+ {"md", "%", DMGL_ANSI}, /* ansi */
+ {"amd", "%=", DMGL_ANSI}, /* ansi */
+ {"trunc_div", "/", 0}, /* old */
+ {"dv", "/", DMGL_ANSI}, /* ansi */
+ {"adv", "/=", DMGL_ANSI}, /* ansi */
+ {"truth_andif", "&&", 0}, /* old */
+ {"aa", "&&", DMGL_ANSI}, /* ansi */
+ {"truth_orif", "||", 0}, /* old */
+ {"oo", "||", DMGL_ANSI}, /* ansi */
+ {"truth_not", "!", 0}, /* old */
+ {"nt", "!", DMGL_ANSI}, /* ansi */
+ {"postincrement","++", 0}, /* old */
+ {"pp", "++", DMGL_ANSI}, /* ansi */
+ {"postdecrement","--", 0}, /* old */
+ {"mm", "--", DMGL_ANSI}, /* ansi */
+ {"bit_ior", "|", 0}, /* old */
+ {"or", "|", DMGL_ANSI}, /* ansi */
+ {"aor", "|=", DMGL_ANSI}, /* ansi */
+ {"bit_xor", "^", 0}, /* old */
+ {"er", "^", DMGL_ANSI}, /* ansi */
+ {"aer", "^=", DMGL_ANSI}, /* ansi */
+ {"bit_and", "&", 0}, /* old */
+ {"ad", "&", DMGL_ANSI}, /* ansi */
+ {"aad", "&=", DMGL_ANSI}, /* ansi */
+ {"bit_not", "~", 0}, /* old */
+ {"co", "~", DMGL_ANSI}, /* ansi */
+ {"call", "()", 0}, /* old */
+ {"cl", "()", DMGL_ANSI}, /* ansi */
+ {"alshift", "<<", 0}, /* old */
+ {"ls", "<<", DMGL_ANSI}, /* ansi */
+ {"als", "<<=", DMGL_ANSI}, /* ansi */
+ {"arshift", ">>", 0}, /* old */
+ {"rs", ">>", DMGL_ANSI}, /* ansi */
+ {"ars", ">>=", DMGL_ANSI}, /* ansi */
+ {"component", "->", 0}, /* old */
+ {"pt", "->", DMGL_ANSI}, /* ansi; Lucid C++ form */
+ {"rf", "->", DMGL_ANSI}, /* ansi; ARM/GNU form */
+ {"indirect", "*", 0}, /* old */
+ {"method_call", "->()", 0}, /* old */
+ {"addr", "&", 0}, /* old (unary &) */
+ {"array", "[]", 0}, /* old */
+ {"vc", "[]", DMGL_ANSI}, /* ansi */
+ {"compound", ", ", 0}, /* old */
+ {"cm", ", ", DMGL_ANSI}, /* ansi */
+ {"cond", "?:", 0}, /* old */
+ {"cn", "?:", DMGL_ANSI}, /* pseudo-ansi */
+ {"max", ">?", 0}, /* old */
+ {"mx", ">?", DMGL_ANSI}, /* pseudo-ansi */
+ {"min", "<?", 0}, /* old */
+ {"mn", "<?", DMGL_ANSI}, /* pseudo-ansi */
+ {"nop", "", 0}, /* old (for operator=) */
+ {"rm", "->*", DMGL_ANSI} /* ansi */
+};
+
+
+typedef struct string /* Beware: these aren't required to be */
+{ /* '\0' terminated. */
+ char *b; /* pointer to start of string */
+ char *p; /* pointer after last character */
+ char *e; /* pointer after end of allocated space */
+} string;
+
+#define STRING_EMPTY(str) ((str) -> b == (str) -> p)
+#define PREPEND_BLANK(str) {if (!STRING_EMPTY(str)) \
+ string_prepend(str, " ");}
+#define APPEND_BLANK(str) {if (!STRING_EMPTY(str)) \
+ string_append(str, " ");}
+
+#define ARM_VTABLE_STRING "__vtbl__" /* Lucid/ARM virtual table prefix */
+#define ARM_VTABLE_STRLEN 8 /* strlen (ARM_VTABLE_STRING) */
+
+/* Prototypes for local functions */
+
+static char *
+mop_up PARAMS ((struct work_stuff *, string *, int));
+
+#if 0
+static int
+demangle_method_args PARAMS ((struct work_stuff *work, const char **, string *));
+#endif
+
+static int
+demangle_template PARAMS ((struct work_stuff *work, const char **, string *,
+ string *));
+
+static int
+arm_pt PARAMS ((struct work_stuff *, const char *, int, const char **,
+ const char **));
+
+static void
+demangle_arm_pt PARAMS ((struct work_stuff *, const char **, int, string *));
+
+static int
+demangle_class_name PARAMS ((struct work_stuff *, const char **, string *));
+
+static int
+demangle_qualified PARAMS ((struct work_stuff *, const char **, string *,
+ int, int));
+
+static int
+demangle_class PARAMS ((struct work_stuff *, const char **, string *));
+
+static int
+demangle_fund_type PARAMS ((struct work_stuff *, const char **, string *));
+
+static int
+demangle_signature PARAMS ((struct work_stuff *, const char **, string *));
+
+static int
+demangle_prefix PARAMS ((struct work_stuff *, const char **, string *));
+
+static int
+gnu_special PARAMS ((struct work_stuff *, const char **, string *));
+
+static int
+arm_special PARAMS ((struct work_stuff *, const char **, string *));
+
+static void
+string_need PARAMS ((string *, int));
+
+static void
+string_delete PARAMS ((string *));
+
+static void
+string_init PARAMS ((string *));
+
+static void
+string_clear PARAMS ((string *));
+
+#if 0
+static int
+string_empty PARAMS ((string *));
+#endif
+
+static void
+string_append PARAMS ((string *, const char *));
+
+static void
+string_appends PARAMS ((string *, string *));
+
+static void
+string_appendn PARAMS ((string *, const char *, int));
+
+static void
+string_prepend PARAMS ((string *, const char *));
+
+static void
+string_prependn PARAMS ((string *, const char *, int));
+
+static int
+get_count PARAMS ((const char **, int *));
+
+static int
+consume_count PARAMS ((const char **));
+
+static int
+demangle_args PARAMS ((struct work_stuff *, const char **, string *));
+
+static int
+do_type PARAMS ((struct work_stuff *, const char **, string *));
+
+static int
+do_arg PARAMS ((struct work_stuff *, const char **, string *));
+
+static void
+demangle_function_name PARAMS ((struct work_stuff *, const char **, string *,
+ const char *));
+
+static void
+remember_type PARAMS ((struct work_stuff *, const char *, int));
+
+static void
+forget_types PARAMS ((struct work_stuff *));
+
+static void
+string_prepends PARAMS ((string *, string *));
+
+/* Translate count to integer, consuming tokens in the process.
+ Conversion terminates on the first non-digit character.
+ Trying to consume something that isn't a count results in
+ no consumption of input and a return of 0. */
+
+static int
+consume_count (type)
+ const char **type;
+{
+ int count = 0;
+
+ while (isdigit (**type))
+ {
+ count *= 10;
+ count += **type - '0';
+ (*type)++;
+ }
+ return (count);
+}
+
+int
+cplus_demangle_opname (opname, result, options)
+ const char *opname;
+ char *result;
+ int options;
+{
+ int len, i, len1, ret;
+ string type;
+ struct work_stuff work[1];
+ const char *tem;
+
+ len = strlen(opname);
+ result[0] = '\0';
+ ret = 0;
+ work->options = options;
+
+ if (opname[0] == '_' && opname[1] == '_'
+ && opname[2] == 'o' && opname[3] == 'p')
+ {
+ /* ANSI. */
+ /* type conversion operator. */
+ tem = opname + 4;
+ if (do_type (work, &tem, &type))
+ {
+ strcat (result, "operator ");
+ strncat (result, type.b, type.p - type.b);
+ string_delete (&type);
+ ret = 1;
+ }
+ }
+ else if (opname[0] == '_' && opname[1] == '_'
+ && opname[2] >= 'a' && opname[2] <= 'z'
+ && opname[3] >= 'a' && opname[3] <= 'z')
+ {
+ if (opname[4] == '\0')
+ {
+ /* Operator. */
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ if (strlen (optable[i].in) == 2
+ && memcmp (optable[i].in, opname + 2, 2) == 0)
+ {
+ strcat (result, "operator");
+ strcat (result, optable[i].out);
+ ret = 1;
+ break;
+ }
+ }
+ }
+ else
+ {
+ if (opname[2] == 'a' && opname[5] == '\0')
+ {
+ /* Assignment. */
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ if (strlen (optable[i].in) == 3
+ && memcmp (optable[i].in, opname + 2, 3) == 0)
+ {
+ strcat (result, "operator");
+ strcat (result, optable[i].out);
+ ret = 1;
+ break;
+ }
+ }
+ }
+ }
+ }
+ else if (len >= 3
+ && opname[0] == 'o'
+ && opname[1] == 'p'
+ && strchr (cplus_markers, opname[2]) != NULL)
+ {
+ /* see if it's an assignment expression */
+ if (len >= 10 /* op$assign_ */
+ && memcmp (opname + 3, "assign_", 7) == 0)
+ {
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ len1 = len - 10;
+ if (strlen (optable[i].in) == len1
+ && memcmp (optable[i].in, opname + 10, len1) == 0)
+ {
+ strcat (result, "operator");
+ strcat (result, optable[i].out);
+ strcat (result, "=");
+ ret = 1;
+ break;
+ }
+ }
+ }
+ else
+ {
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ len1 = len - 3;
+ if (strlen (optable[i].in) == len1
+ && memcmp (optable[i].in, opname + 3, len1) == 0)
+ {
+ strcat (result, "operator");
+ strcat (result, optable[i].out);
+ ret = 1;
+ break;
+ }
+ }
+ }
+ }
+ else if (len >= 5 && memcmp (opname, "type", 4) == 0
+ && strchr (cplus_markers, opname[4]) != NULL)
+ {
+ /* type conversion operator */
+ tem = opname + 5;
+ if (do_type (work, &tem, &type))
+ {
+ strcat (result, "operator ");
+ strncat (result, type.b, type.p - type.b);
+ string_delete (&type);
+ ret = 1;
+ }
+ }
+ return ret;
+
+}
+/* Takes operator name as e.g. "++" and returns mangled
+ operator name (e.g. "postincrement_expr"), or NULL if not found.
+
+ If OPTIONS & DMGL_ANSI == 1, return the ANSI name;
+ if OPTIONS & DMGL_ANSI == 0, return the old GNU name. */
+
+const char *
+cplus_mangle_opname (opname, options)
+ const char *opname;
+ int options;
+{
+ int i;
+ int len;
+
+ len = strlen (opname);
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ if (strlen (optable[i].out) == len
+ && (options & DMGL_ANSI) == (optable[i].flags & DMGL_ANSI)
+ && memcmp (optable[i].out, opname, len) == 0)
+ return optable[i].in;
+ }
+ return (0);
+}
+
+/* char *cplus_demangle (const char *mangled, int options)
+
+ If MANGLED is a mangled function name produced by GNU C++, then
+ a pointer to a malloced string giving a C++ representation
+ of the name will be returned; otherwise NULL will be returned.
+ It is the caller's responsibility to free the string which
+ is returned.
+
+ The OPTIONS arg may contain one or more of the following bits:
+
+ DMGL_ANSI ANSI qualifiers such as `const' and `void' are
+ included.
+ DMGL_PARAMS Function parameters are included.
+
+ For example,
+
+ cplus_demangle ("foo__1Ai", DMGL_PARAMS) => "A::foo(int)"
+ cplus_demangle ("foo__1Ai", DMGL_PARAMS | DMGL_ANSI) => "A::foo(int)"
+ cplus_demangle ("foo__1Ai", 0) => "A::foo"
+
+ cplus_demangle ("foo__1Afe", DMGL_PARAMS) => "A::foo(float,...)"
+ cplus_demangle ("foo__1Afe", DMGL_PARAMS | DMGL_ANSI)=> "A::foo(float,...)"
+ cplus_demangle ("foo__1Afe", 0) => "A::foo"
+
+ Note that any leading underscores, or other such characters prepended by
+ the compilation system, are presumed to have already been stripped from
+ MANGLED. */
+
+char *
+cplus_demangle (mangled, options)
+ const char *mangled;
+ int options;
+{
+ string decl;
+ int success = 0;
+ struct work_stuff work[1];
+ char *demangled = NULL;
+
+ if ((mangled != NULL) && (*mangled != '\0'))
+ {
+ memset ((char *) work, 0, sizeof (work));
+ work -> options = options;
+ if ((work->options & DMGL_STYLE_MASK) == 0)
+ work->options |= (int)current_demangling_style & DMGL_STYLE_MASK;
+
+ string_init (&decl);
+
+ /* First check to see if gnu style demangling is active and if the
+ string to be demangled contains a CPLUS_MARKER. If so, attempt to
+ recognize one of the gnu special forms rather than looking for a
+ standard prefix. In particular, don't worry about whether there
+ is a "__" string in the mangled string. Consider "_$_5__foo" for
+ example. */
+
+ if ((AUTO_DEMANGLING || GNU_DEMANGLING))
+ {
+ success = gnu_special (work, &mangled, &decl);
+ }
+ if (!success)
+ {
+ success = demangle_prefix (work, &mangled, &decl);
+ }
+ if (success && (*mangled != '\0'))
+ {
+ success = demangle_signature (work, &mangled, &decl);
+ }
+ if (work->constructor == 2)
+ {
+ string_prepend(&decl, "global constructors keyed to ");
+ work->constructor = 0;
+ }
+ else if (work->destructor == 2)
+ {
+ string_prepend(&decl, "global destructors keyed to ");
+ work->destructor = 0;
+ }
+ demangled = mop_up (work, &decl, success);
+ }
+ return (demangled);
+}
+
+static char *
+mop_up (work, declp, success)
+ struct work_stuff *work;
+ string *declp;
+ int success;
+{
+ char *demangled = NULL;
+
+ /* Discard the remembered types, if any. */
+
+ forget_types (work);
+ if (work -> typevec != NULL)
+ {
+ free ((char *) work -> typevec);
+ }
+
+ /* If demangling was successful, ensure that the demangled string is null
+ terminated and return it. Otherwise, free the demangling decl. */
+
+ if (!success)
+ {
+ string_delete (declp);
+ }
+ else
+ {
+ string_appendn (declp, "", 1);
+ demangled = declp -> b;
+ }
+ return (demangled);
+}
+
+/*
+
+LOCAL FUNCTION
+
+ demangle_signature -- demangle the signature part of a mangled name
+
+SYNOPSIS
+
+ static int
+ demangle_signature (struct work_stuff *work, const char **mangled,
+ string *declp);
+
+DESCRIPTION
+
+ Consume and demangle the signature portion of the mangled name.
+
+ DECLP is the string where demangled output is being built. At
+ entry it contains the demangled root name from the mangled name
+ prefix. I.E. either a demangled operator name or the root function
+ name. In some special cases, it may contain nothing.
+
+ *MANGLED points to the current unconsumed location in the mangled
+ name. As tokens are consumed and demangling is performed, the
+ pointer is updated to continuously point at the next token to
+ be consumed.
+
+ Demangling GNU style mangled names is nasty because there is no
+ explicit token that marks the start of the outermost function
+ argument list. */
+
+static int
+demangle_signature (work, mangled, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+{
+ int success = 1;
+ int func_done = 0;
+ int expect_func = 0;
+ const char *oldmangled = NULL;
+ string trawname;
+ string tname;
+
+ while (success && (**mangled != '\0'))
+ {
+ switch (**mangled)
+ {
+ case 'Q':
+ oldmangled = *mangled;
+ success = demangle_qualified (work, mangled, declp, 1, 0);
+ if (success)
+ {
+ remember_type (work, oldmangled, *mangled - oldmangled);
+ }
+ if (AUTO_DEMANGLING || GNU_DEMANGLING)
+ {
+ expect_func = 1;
+ }
+ oldmangled = NULL;
+ break;
+
+ case 'S':
+ /* Static member function */
+ if (oldmangled == NULL)
+ {
+ oldmangled = *mangled;
+ }
+ (*mangled)++;
+ work -> static_type = 1;
+ break;
+
+ case 'C':
+ /* a const member function */
+ if (oldmangled == NULL)
+ {
+ oldmangled = *mangled;
+ }
+ (*mangled)++;
+ work -> const_type = 1;
+ break;
+
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ if (oldmangled == NULL)
+ {
+ oldmangled = *mangled;
+ }
+ success = demangle_class (work, mangled, declp);
+ if (success)
+ {
+ remember_type (work, oldmangled, *mangled - oldmangled);
+ }
+ if (AUTO_DEMANGLING || GNU_DEMANGLING)
+ {
+ expect_func = 1;
+ }
+ oldmangled = NULL;
+ break;
+
+ case 'F':
+ /* Function */
+ /* ARM style demangling includes a specific 'F' character after
+ the class name. For GNU style, it is just implied. So we can
+ safely just consume any 'F' at this point and be compatible
+ with either style. */
+
+ oldmangled = NULL;
+ func_done = 1;
+ (*mangled)++;
+
+ /* For lucid/ARM style we have to forget any types we might
+ have remembered up to this point, since they were not argument
+ types. GNU style considers all types seen as available for
+ back references. See comment in demangle_args() */
+
+ if (LUCID_DEMANGLING || ARM_DEMANGLING)
+ {
+ forget_types (work);
+ }
+ success = demangle_args (work, mangled, declp);
+ break;
+
+ case 't':
+ /* G++ Template */
+ string_init(&trawname);
+ string_init(&tname);
+ if (oldmangled == NULL)
+ {
+ oldmangled = *mangled;
+ }
+ success = demangle_template (work, mangled, &tname, &trawname);
+ if (success)
+ {
+ remember_type (work, oldmangled, *mangled - oldmangled);
+ }
+ string_append(&tname, (work -> options & DMGL_JAVA) ? "." : "::");
+ string_prepends(declp, &tname);
+ if (work -> destructor & 1)
+ {
+ string_prepend (&trawname, "~");
+ string_appends (declp, &trawname);
+ work->destructor -= 1;
+ }
+ if ((work->constructor & 1) || (work->destructor & 1))
+ {
+ string_appends (declp, &trawname);
+ work->constructor -= 1;
+ }
+ string_delete(&trawname);
+ string_delete(&tname);
+ oldmangled = NULL;
+ expect_func = 1;
+ break;
+
+ case '_':
+ /* At the outermost level, we cannot have a return type specified,
+ so if we run into another '_' at this point we are dealing with
+ a mangled name that is either bogus, or has been mangled by
+ some algorithm we don't know how to deal with. So just
+ reject the entire demangling. */
+ success = 0;
+ break;
+
+ default:
+ if (AUTO_DEMANGLING || GNU_DEMANGLING)
+ {
+ /* Assume we have stumbled onto the first outermost function
+ argument token, and start processing args. */
+ func_done = 1;
+ success = demangle_args (work, mangled, declp);
+ }
+ else
+ {
+ /* Non-GNU demanglers use a specific token to mark the start
+ of the outermost function argument tokens. Typically 'F',
+ for ARM-demangling, for example. So if we find something
+ we are not prepared for, it must be an error. */
+ success = 0;
+ }
+ break;
+ }
+ /*
+ if (AUTO_DEMANGLING || GNU_DEMANGLING)
+ */
+ {
+ if (success && expect_func)
+ {
+ func_done = 1;
+ success = demangle_args (work, mangled, declp);
+ }
+ }
+ }
+ if (success && !func_done)
+ {
+ if (AUTO_DEMANGLING || GNU_DEMANGLING)
+ {
+ /* With GNU style demangling, bar__3foo is 'foo::bar(void)', and
+ bar__3fooi is 'foo::bar(int)'. We get here when we find the
+ first case, and need to ensure that the '(void)' gets added to
+ the current declp. Note that with ARM, the first case
+ represents the name of a static data member 'foo::bar',
+ which is in the current declp, so we leave it alone. */
+ success = demangle_args (work, mangled, declp);
+ }
+ }
+ if (success && work -> static_type && PRINT_ARG_TYPES)
+ {
+ string_append (declp, " static");
+ }
+ if (success && work -> const_type && PRINT_ARG_TYPES)
+ {
+ string_append (declp, " const");
+ }
+ return (success);
+}
+
+#if 0
+
+static int
+demangle_method_args (work, mangled, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+{
+ int success = 0;
+
+ if (work -> static_type)
+ {
+ string_append (declp, *mangled + 1);
+ *mangled += strlen (*mangled);
+ success = 1;
+ }
+ else
+ {
+ success = demangle_args (work, mangled, declp);
+ }
+ return (success);
+}
+
+#endif
+
+static int
+demangle_template (work, mangled, tname, trawname)
+ struct work_stuff *work;
+ const char **mangled;
+ string *tname;
+ string *trawname;
+{
+ int i;
+ int is_pointer;
+ int is_real;
+ int is_integral;
+ int is_char;
+ int is_bool;
+ int r;
+ int need_comma = 0;
+ int success = 0;
+ int done;
+ const char *old_p;
+ const char *start;
+ int symbol_len;
+ int is_java_array;
+ string temp;
+
+ (*mangled)++;
+ start = *mangled;
+ /* get template name */
+ if ((r = consume_count (mangled)) == 0 || strlen (*mangled) < r)
+ {
+ return (0);
+ }
+ if (trawname)
+ string_appendn (trawname, *mangled, r);
+ is_java_array = (work -> options & DMGL_JAVA)
+ && strncmp (*mangled, "JArray1Z", 8) == 0;
+ if (! is_java_array)
+ {
+ string_appendn (tname, *mangled, r);
+ string_append (tname, "<");
+ }
+ *mangled += r;
+ /* get size of template parameter list */
+ if (!get_count (mangled, &r))
+ {
+ return (0);
+ }
+ for (i = 0; i < r; i++)
+ {
+ if (need_comma)
+ {
+ string_append (tname, ", ");
+ }
+ /* Z for type parameters */
+ if (**mangled == 'Z')
+ {
+ (*mangled)++;
+ /* temp is initialized in do_type */
+ success = do_type (work, mangled, &temp);
+ if (success)
+ {
+ string_appends (tname, &temp);
+ }
+ string_delete(&temp);
+ if (!success)
+ {
+ break;
+ }
+ }
+ else
+ {
+ /* otherwise, value parameter */
+ old_p = *mangled;
+ is_pointer = 0;
+ is_real = 0;
+ is_integral = 0;
+ is_char = 0;
+ is_bool = 0;
+ done = 0;
+ /* temp is initialized in do_type */
+ success = do_type (work, mangled, &temp);
+ /*
+ if (success)
+ {
+ string_appends (tname, &temp);
+ }
+ */
+ string_delete(&temp);
+ if (!success)
+ {
+ break;
+ }
+ /*
+ string_append (tname, "=");
+ */
+ while (*old_p && !done)
+ {
+ switch (*old_p)
+ {
+ case 'P':
+ case 'p':
+ case 'R':
+ done = is_pointer = 1;
+ break;
+ case 'C': /* const */
+ case 'S': /* explicitly signed [char] */
+ case 'U': /* unsigned */
+ case 'V': /* volatile */
+ case 'F': /* function */
+ case 'M': /* member function */
+ case 'O': /* ??? */
+ case 'J': /* complex */
+ old_p++;
+ continue;
+ case 'Q': /* qualified name */
+ done = is_integral = 1;
+ break;
+ case 'T': /* remembered type */
+ abort ();
+ break;
+ case 'v': /* void */
+ abort ();
+ break;
+ case 'x': /* long long */
+ case 'l': /* long */
+ case 'i': /* int */
+ case 's': /* short */
+ case 'w': /* wchar_t */
+ done = is_integral = 1;
+ break;
+ case 'b': /* bool */
+ done = is_bool = 1;
+ break;
+ case 'c': /* char */
+ done = is_char = 1;
+ break;
+ case 'r': /* long double */
+ case 'd': /* double */
+ case 'f': /* float */
+ done = is_real = 1;
+ break;
+ default:
+ /* it's probably user defined type, let's assume
+ it's integral, it seems hard to figure out
+ what it really is */
+ done = is_integral = 1;
+ }
+ }
+ if (is_integral)
+ {
+ if (**mangled == 'm')
+ {
+ string_appendn (tname, "-", 1);
+ (*mangled)++;
+ }
+ while (isdigit (**mangled))
+ {
+ string_appendn (tname, *mangled, 1);
+ (*mangled)++;
+ }
+ }
+ else if (is_char)
+ {
+ char tmp[2];
+ int val;
+ if (**mangled == 'm')
+ {
+ string_appendn (tname, "-", 1);
+ (*mangled)++;
+ }
+ string_appendn (tname, "'", 1);
+ val = consume_count(mangled);
+ if (val == 0)
+ {
+ success = 0;
+ break;
+ }
+ tmp[0] = (char)val;
+ tmp[1] = '\0';
+ string_appendn (tname, &tmp[0], 1);
+ string_appendn (tname, "'", 1);
+ }
+ else if (is_bool)
+ {
+ int val = consume_count (mangled);
+ if (val == 0)
+ string_appendn (tname, "false", 5);
+ else if (val == 1)
+ string_appendn (tname, "true", 4);
+ else
+ success = 0;
+ }
+ else if (is_real)
+ {
+ if (**mangled == 'm')
+ {
+ string_appendn (tname, "-", 1);
+ (*mangled)++;
+ }
+ while (isdigit (**mangled))
+ {
+ string_appendn (tname, *mangled, 1);
+ (*mangled)++;
+ }
+ if (**mangled == '.') /* fraction */
+ {
+ string_appendn (tname, ".", 1);
+ (*mangled)++;
+ while (isdigit (**mangled))
+ {
+ string_appendn (tname, *mangled, 1);
+ (*mangled)++;
+ }
+ }
+ if (**mangled == 'e') /* exponent */
+ {
+ string_appendn (tname, "e", 1);
+ (*mangled)++;
+ while (isdigit (**mangled))
+ {
+ string_appendn (tname, *mangled, 1);
+ (*mangled)++;
+ }
+ }
+ }
+ else if (is_pointer)
+ {
+ symbol_len = consume_count (mangled);
+ if (symbol_len == 0)
+ {
+ success = 0;
+ break;
+ }
+ if (symbol_len == 0)
+ string_appendn (tname, "0", 1);
+ else
+ {
+ char *p = xmalloc (symbol_len + 1), *q;
+ strncpy (p, *mangled, symbol_len);
+ p [symbol_len] = '\0';
+ q = cplus_demangle (p, work->options);
+ string_appendn (tname, "&", 1);
+ if (q)
+ {
+ string_append (tname, q);
+ free (q);
+ }
+ else
+ string_append (tname, p);
+ free (p);
+ }
+ *mangled += symbol_len;
+ }
+ }
+ need_comma = 1;
+ }
+ if (is_java_array)
+ {
+ string_append (tname, "[]");
+ }
+ else
+ {
+ if (tname->p[-1] == '>')
+ string_append (tname, " ");
+ string_append (tname, ">");
+ }
+
+ /*
+ if (work -> static_type)
+ {
+ string_append (declp, *mangled + 1);
+ *mangled += strlen (*mangled);
+ success = 1;
+ }
+ else
+ {
+ success = demangle_args (work, mangled, declp);
+ }
+ }
+ */
+ return (success);
+}
+
+static int
+arm_pt (work, mangled, n, anchor, args)
+ struct work_stuff *work;
+ const char *mangled;
+ int n;
+ const char **anchor, **args;
+{
+ /* ARM template? */
+ if (ARM_DEMANGLING && (*anchor = mystrstr (mangled, "__pt__")))
+ {
+ int len;
+ *args = *anchor + 6;
+ len = consume_count (args);
+ if (*args + len == mangled + n && **args == '_')
+ {
+ ++*args;
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static void
+demangle_arm_pt (work, mangled, n, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ int n;
+ string *declp;
+{
+ const char *p;
+ const char *args;
+ const char *e = *mangled + n;
+
+ /* ARM template? */
+ if (arm_pt (work, *mangled, n, &p, &args))
+ {
+ string arg;
+ string_init (&arg);
+ string_appendn (declp, *mangled, p - *mangled);
+ string_append (declp, "<");
+ /* should do error checking here */
+ while (args < e) {
+ string_clear (&arg);
+ do_type (work, &args, &arg);
+ string_appends (declp, &arg);
+ string_append (declp, ",");
+ }
+ string_delete (&arg);
+ --declp->p;
+ string_append (declp, ">");
+ }
+ else
+ {
+ string_appendn (declp, *mangled, n);
+ }
+ *mangled += n;
+}
+
+static int
+demangle_class_name (work, mangled, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+{
+ int n;
+ int success = 0;
+
+ n = consume_count (mangled);
+ if (strlen (*mangled) >= n)
+ {
+ demangle_arm_pt (work, mangled, n, declp);
+ success = 1;
+ }
+
+ return (success);
+}
+
+/*
+
+LOCAL FUNCTION
+
+ demangle_class -- demangle a mangled class sequence
+
+SYNOPSIS
+
+ static int
+ demangle_class (struct work_stuff *work, const char **mangled,
+ strint *declp)
+
+DESCRIPTION
+
+ DECLP points to the buffer into which demangling is being done.
+
+ *MANGLED points to the current token to be demangled. On input,
+ it points to a mangled class (I.E. "3foo", "13verylongclass", etc.)
+ On exit, it points to the next token after the mangled class on
+ success, or the first unconsumed token on failure.
+
+ If the CONSTRUCTOR or DESTRUCTOR flags are set in WORK, then
+ we are demangling a constructor or destructor. In this case
+ we prepend "class::class" or "class::~class" to DECLP.
+
+ Otherwise, we prepend "class::" to the current DECLP.
+
+ Reset the constructor/destructor flags once they have been
+ "consumed". This allows demangle_class to be called later during
+ the same demangling, to do normal class demangling.
+
+ Returns 1 if demangling is successful, 0 otherwise.
+
+*/
+
+static int
+demangle_class (work, mangled, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+{
+ int success = 0;
+ string class_name;
+
+ string_init (&class_name);
+ if (demangle_class_name (work, mangled, &class_name))
+ {
+ if ((work->constructor & 1) || (work->destructor & 1))
+ {
+ string_prepends (declp, &class_name);
+ if (work -> destructor & 1)
+ {
+ string_prepend (declp, "~");
+ work -> destructor -= 1;
+ }
+ else
+ {
+ work -> constructor -= 1;
+ }
+ }
+ string_prepend (declp, (work -> options & DMGL_JAVA) ? "." : "::");
+ string_prepends (declp, &class_name);
+ success = 1;
+ }
+ string_delete (&class_name);
+ return (success);
+}
+
+/*
+
+LOCAL FUNCTION
+
+ demangle_prefix -- consume the mangled name prefix and find signature
+
+SYNOPSIS
+
+ static int
+ demangle_prefix (struct work_stuff *work, const char **mangled,
+ string *declp);
+
+DESCRIPTION
+
+ Consume and demangle the prefix of the mangled name.
+
+ DECLP points to the string buffer into which demangled output is
+ placed. On entry, the buffer is empty. On exit it contains
+ the root function name, the demangled operator name, or in some
+ special cases either nothing or the completely demangled result.
+
+ MANGLED points to the current pointer into the mangled name. As each
+ token of the mangled name is consumed, it is updated. Upon entry
+ the current mangled name pointer points to the first character of
+ the mangled name. Upon exit, it should point to the first character
+ of the signature if demangling was successful, or to the first
+ unconsumed character if demangling of the prefix was unsuccessful.
+
+ Returns 1 on success, 0 otherwise.
+ */
+
+static int
+demangle_prefix (work, mangled, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+{
+ int success = 1;
+ const char *scan;
+ int i;
+
+ if (strlen(*mangled) >= 11 && strncmp(*mangled, "_GLOBAL_", 8) == 0)
+ {
+ char *marker = strchr (cplus_markers, (*mangled)[8]);
+ if (marker != NULL && *marker == (*mangled)[10])
+ {
+ if ((*mangled)[9] == 'D')
+ {
+ /* it's a GNU global destructor to be executed at program exit */
+ (*mangled) += 11;
+ work->destructor = 2;
+ if (gnu_special (work, mangled, declp))
+ return success;
+ }
+ else if ((*mangled)[9] == 'I')
+ {
+ /* it's a GNU global constructor to be executed at program init */
+ (*mangled) += 11;
+ work->constructor = 2;
+ if (gnu_special (work, mangled, declp))
+ return success;
+ }
+ }
+ }
+ else if (ARM_DEMANGLING && strncmp(*mangled, "__std__", 7) == 0)
+ {
+ /* it's a ARM global destructor to be executed at program exit */
+ (*mangled) += 7;
+ work->destructor = 2;
+ }
+ else if (ARM_DEMANGLING && strncmp(*mangled, "__sti__", 7) == 0)
+ {
+ /* it's a ARM global constructor to be executed at program initial */
+ (*mangled) += 7;
+ work->constructor = 2;
+ }
+
+ /* This block of code is a reduction in strength time optimization
+ of:
+ scan = mystrstr (*mangled, "__"); */
+
+ {
+ scan = *mangled;
+
+ do {
+ scan = strchr (scan, '_');
+ } while (scan != NULL && *++scan != '_');
+
+ if (scan != NULL) --scan;
+ }
+
+ if (scan != NULL)
+ {
+ /* We found a sequence of two or more '_', ensure that we start at
+ the last pair in the sequence. */
+ i = strspn (scan, "_");
+ if (i > 2)
+ {
+ scan += (i - 2);
+ }
+ }
+
+ if (scan == NULL)
+ {
+ success = 0;
+ }
+ else if (work -> static_type)
+ {
+ if (!isdigit (scan[0]) && (scan[0] != 't'))
+ {
+ success = 0;
+ }
+ }
+ else if ((scan == *mangled)
+ && (isdigit (scan[2]) || (scan[2] == 'Q') || (scan[2] == 't')))
+ {
+ /* The ARM says nothing about the mangling of local variables.
+ But cfront mangles local variables by prepending __<nesting_level>
+ to them. As an extension to ARM demangling we handle this case. */
+ if ((LUCID_DEMANGLING || ARM_DEMANGLING) && isdigit (scan[2]))
+ {
+ *mangled = scan + 2;
+ consume_count (mangled);
+ string_append (declp, *mangled);
+ *mangled += strlen (*mangled);
+ success = 1;
+ }
+ else
+ {
+ /* A GNU style constructor starts with __[0-9Qt]. But cfront uses
+ names like __Q2_3foo3bar for nested type names. So don't accept
+ this style of constructor for cfront demangling. */
+ if (!(LUCID_DEMANGLING || ARM_DEMANGLING))
+ work -> constructor += 1;
+ *mangled = scan + 2;
+ }
+ }
+ else if ((scan == *mangled) && !isdigit (scan[2]) && (scan[2] != 't'))
+ {
+ /* Mangled name starts with "__". Skip over any leading '_' characters,
+ then find the next "__" that separates the prefix from the signature.
+ */
+ if (!(ARM_DEMANGLING || LUCID_DEMANGLING)
+ || (arm_special (work, mangled, declp) == 0))
+ {
+ while (*scan == '_')
+ {
+ scan++;
+ }
+ if ((scan = mystrstr (scan, "__")) == NULL || (*(scan + 2) == '\0'))
+ {
+ /* No separator (I.E. "__not_mangled"), or empty signature
+ (I.E. "__not_mangled_either__") */
+ success = 0;
+ }
+ else
+ {
+ demangle_function_name (work, mangled, declp, scan);
+ }
+ }
+ }
+ else if (ARM_DEMANGLING && scan[2] == 'p' && scan[3] == 't')
+ {
+ /* Cfront-style parameterized type. Handled later as a signature. */
+ success = 1;
+
+ /* ARM template? */
+ demangle_arm_pt (work, mangled, strlen (*mangled), declp);
+ }
+ else if (*(scan + 2) != '\0')
+ {
+ /* Mangled name does not start with "__" but does have one somewhere
+ in there with non empty stuff after it. Looks like a global
+ function name. */
+ demangle_function_name (work, mangled, declp, scan);
+ }
+ else
+ {
+ /* Doesn't look like a mangled name */
+ success = 0;
+ }
+
+ if (!success && (work->constructor == 2 || work->destructor == 2))
+ {
+ string_append (declp, *mangled);
+ *mangled += strlen (*mangled);
+ success = 1;
+ }
+ return (success);
+}
+
+/*
+
+LOCAL FUNCTION
+
+ gnu_special -- special handling of gnu mangled strings
+
+SYNOPSIS
+
+ static int
+ gnu_special (struct work_stuff *work, const char **mangled,
+ string *declp);
+
+
+DESCRIPTION
+
+ Process some special GNU style mangling forms that don't fit
+ the normal pattern. For example:
+
+ _$_3foo (destructor for class foo)
+ _vt$foo (foo virtual table)
+ _vt$foo$bar (foo::bar virtual table)
+ __vt_foo (foo virtual table, new style with thunks)
+ _3foo$varname (static data member)
+ _Q22rs2tu$vw (static data member)
+ __t6vector1Zii (constructor with template)
+ __thunk_4__$_7ostream (virtual function thunk)
+ */
+
+static int
+gnu_special (work, mangled, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+{
+ int n;
+ int success = 1;
+ const char *p;
+
+ if ((*mangled)[0] == '_'
+ && strchr (cplus_markers, (*mangled)[1]) != NULL
+ && (*mangled)[2] == '_')
+ {
+ /* Found a GNU style destructor, get past "_<CPLUS_MARKER>_" */
+ (*mangled) += 3;
+ work -> destructor += 1;
+ }
+ else if ((*mangled)[0] == '_'
+ && (((*mangled)[1] == '_'
+ && (*mangled)[2] == 'v'
+ && (*mangled)[3] == 't'
+ && (*mangled)[4] == '_')
+ || ((*mangled)[1] == 'v'
+ && (*mangled)[2] == 't'
+ && strchr (cplus_markers, (*mangled)[3]) != NULL)))
+ {
+ /* Found a GNU style virtual table, get past "_vt<CPLUS_MARKER>"
+ and create the decl. Note that we consume the entire mangled
+ input string, which means that demangle_signature has no work
+ to do. */
+ if ((*mangled)[2] == 'v')
+ (*mangled) += 5; /* New style, with thunks: "__vt_" */
+ else
+ (*mangled) += 4; /* Old style, no thunks: "_vt<CPLUS_MARKER>" */
+ while (**mangled != '\0')
+ {
+ p = strpbrk (*mangled, cplus_markers);
+ switch (**mangled)
+ {
+ case 'Q':
+ success = demangle_qualified (work, mangled, declp, 0, 1);
+ break;
+ case 't':
+ success = demangle_template (work, mangled, declp, 0);
+ break;
+ default:
+ if (isdigit(*mangled[0]))
+ {
+ n = consume_count(mangled);
+ }
+ else
+ {
+ n = strcspn (*mangled, cplus_markers);
+ }
+ string_appendn (declp, *mangled, n);
+ (*mangled) += n;
+ }
+
+ if (success && ((p == NULL) || (p == *mangled)))
+ {
+ if (p != NULL)
+ {
+ string_append (declp,
+ (work -> options & DMGL_JAVA) ? "." : "::");
+ (*mangled)++;
+ }
+ }
+ else
+ {
+ success = 0;
+ break;
+ }
+ }
+ if (success)
+ string_append (declp, " virtual table");
+ }
+ else if ((*mangled)[0] == '_'
+ && (strchr("0123456789Qt", (*mangled)[1]) != NULL)
+ && (p = strpbrk (*mangled, cplus_markers)) != NULL)
+ {
+ /* static data member, "_3foo$varname" for example */
+ (*mangled)++;
+ switch (**mangled)
+ {
+ case 'Q':
+ success = demangle_qualified (work, mangled, declp, 0, 1);
+ break;
+ case 't':
+ success = demangle_template (work, mangled, declp, 0);
+ break;
+ default:
+ n = consume_count (mangled);
+ string_appendn (declp, *mangled, n);
+ (*mangled) += n;
+ }
+ if (success && (p == *mangled))
+ {
+ /* Consumed everything up to the cplus_marker, append the
+ variable name. */
+ (*mangled)++;
+ string_append (declp, (work -> options & DMGL_JAVA) ? "." : "::");
+ n = strlen (*mangled);
+ string_appendn (declp, *mangled, n);
+ (*mangled) += n;
+ }
+ else
+ {
+ success = 0;
+ }
+ }
+ else if (strncmp (*mangled, "__thunk_", 8) == 0)
+ {
+ int delta = ((*mangled) += 8, consume_count (mangled));
+ char *method = cplus_demangle (++*mangled, work->options);
+ if (method)
+ {
+ char buf[50];
+ sprintf (buf, "virtual function thunk (delta:%d) for ", -delta);
+ string_append (declp, buf);
+ string_append (declp, method);
+ free (method);
+ n = strlen (*mangled);
+ (*mangled) += n;
+ }
+ else
+ {
+ success = 0;
+ }
+ }
+ else if (strncmp (*mangled, "__t", 3) == 0
+ && ((*mangled)[3] == 'i' || (*mangled)[3] == 'f'))
+ {
+ p = (*mangled)[3] == 'i' ? " type_info node" : " type_info function";
+ (*mangled) += 4;
+ switch (**mangled)
+ {
+ case 'Q':
+ success = demangle_qualified (work, mangled, declp, 0, 1);
+ break;
+ case 't':
+ success = demangle_template (work, mangled, declp, 0);
+ break;
+ default:
+ success = demangle_fund_type (work, mangled, declp);
+ break;
+ }
+ if (success && **mangled != '\0')
+ success = 0;
+ if (success)
+ string_append (declp, p);
+ }
+ else
+ {
+ success = 0;
+ }
+ return (success);
+}
+
+/*
+
+LOCAL FUNCTION
+
+ arm_special -- special handling of ARM/lucid mangled strings
+
+SYNOPSIS
+
+ static int
+ arm_special (struct work_stuff *work, const char **mangled,
+ string *declp);
+
+
+DESCRIPTION
+
+ Process some special ARM style mangling forms that don't fit
+ the normal pattern. For example:
+
+ __vtbl__3foo (foo virtual table)
+ __vtbl__3foo__3bar (bar::foo virtual table)
+
+ */
+
+static int
+arm_special (work, mangled, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+{
+ int n;
+ int success = 1;
+ const char *scan;
+
+ if (strncmp (*mangled, ARM_VTABLE_STRING, ARM_VTABLE_STRLEN) == 0)
+ {
+ /* Found a ARM style virtual table, get past ARM_VTABLE_STRING
+ and create the decl. Note that we consume the entire mangled
+ input string, which means that demangle_signature has no work
+ to do. */
+ scan = *mangled + ARM_VTABLE_STRLEN;
+ while (*scan != '\0') /* first check it can be demangled */
+ {
+ n = consume_count (&scan);
+ if (n==0)
+ {
+ return (0); /* no good */
+ }
+ scan += n;
+ if (scan[0] == '_' && scan[1] == '_')
+ {
+ scan += 2;
+ }
+ }
+ (*mangled) += ARM_VTABLE_STRLEN;
+ while (**mangled != '\0')
+ {
+ n = consume_count (mangled);
+ string_prependn (declp, *mangled, n);
+ (*mangled) += n;
+ if ((*mangled)[0] == '_' && (*mangled)[1] == '_')
+ {
+ string_prepend (declp, "::");
+ (*mangled) += 2;
+ }
+ }
+ string_append (declp, " virtual table");
+ }
+ else
+ {
+ success = 0;
+ }
+ return (success);
+}
+
+/*
+
+LOCAL FUNCTION
+
+ demangle_qualified -- demangle 'Q' qualified name strings
+
+SYNOPSIS
+
+ static int
+ demangle_qualified (struct work_stuff *, const char *mangled,
+ string *result, int isfuncname, int append);
+
+DESCRIPTION
+
+ Demangle a qualified name, such as "Q25Outer5Inner" which is
+ the mangled form of "Outer::Inner". The demangled output is
+ prepended or appended to the result string according to the
+ state of the append flag.
+
+ If isfuncname is nonzero, then the qualified name we are building
+ is going to be used as a member function name, so if it is a
+ constructor or destructor function, append an appropriate
+ constructor or destructor name. I.E. for the above example,
+ the result for use as a constructor is "Outer::Inner::Inner"
+ and the result for use as a destructor is "Outer::Inner::~Inner".
+
+BUGS
+
+ Numeric conversion is ASCII dependent (FIXME).
+
+ */
+
+static int
+demangle_qualified (work, mangled, result, isfuncname, append)
+ struct work_stuff *work;
+ const char **mangled;
+ string *result;
+ int isfuncname;
+ int append;
+{
+ int qualifiers;
+ int namelength;
+ int success = 1;
+ const char *p;
+ char num[2];
+ string temp;
+
+ string_init (&temp);
+ switch ((*mangled)[1])
+ {
+ case '_':
+ /* GNU mangled name with more than 9 classes. The count is preceded
+ by an underscore (to distinguish it from the <= 9 case) and followed
+ by an underscore. */
+ p = *mangled + 2;
+ qualifiers = atoi (p);
+ if (!isdigit (*p) || *p == '0')
+ success = 0;
+
+ /* Skip the digits. */
+ while (isdigit (*p))
+ ++p;
+
+ if (*p != '_')
+ success = 0;
+
+ *mangled = p + 1;
+ break;
+
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ /* The count is in a single digit. */
+ num[0] = (*mangled)[1];
+ num[1] = '\0';
+ qualifiers = atoi (num);
+
+ /* If there is an underscore after the digit, skip it. This is
+ said to be for ARM-qualified names, but the ARM makes no
+ mention of such an underscore. Perhaps cfront uses one. */
+ if ((*mangled)[2] == '_')
+ {
+ (*mangled)++;
+ }
+ (*mangled) += 2;
+ break;
+
+ case '0':
+ default:
+ success = 0;
+ }
+
+ if (!success)
+ return success;
+
+ /* Pick off the names and collect them in the temp buffer in the order
+ in which they are found, separated by '::'. */
+
+ while (qualifiers-- > 0)
+ {
+ if (*mangled[0] == '_')
+ *mangled = *mangled + 1;
+ if (*mangled[0] == 't')
+ {
+ success = demangle_template(work, mangled, &temp, 0);
+ if (!success) break;
+ }
+ else
+ {
+ namelength = consume_count (mangled);
+ if (strlen (*mangled) < namelength)
+ {
+ /* Simple sanity check failed */
+ success = 0;
+ break;
+ }
+ string_appendn (&temp, *mangled, namelength);
+ *mangled += namelength;
+ }
+ if (qualifiers > 0)
+ {
+ string_append (&temp, (work -> options & DMGL_JAVA) ? "." : "::");
+ }
+ }
+
+ /* If we are using the result as a function name, we need to append
+ the appropriate '::' separated constructor or destructor name.
+ We do this here because this is the most convenient place, where
+ we already have a pointer to the name and the length of the name. */
+
+ if (isfuncname && (work->constructor & 1 || work->destructor & 1))
+ {
+ string_append (&temp, (work -> options & DMGL_JAVA) ? "." : "::");
+ if (work -> destructor & 1)
+ {
+ string_append (&temp, "~");
+ }
+ string_appendn (&temp, (*mangled) - namelength, namelength);
+ }
+
+ /* Now either prepend the temp buffer to the result, or append it,
+ depending upon the state of the append flag. */
+
+ if (append)
+ {
+ string_appends (result, &temp);
+ }
+ else
+ {
+ if (!STRING_EMPTY (result))
+ {
+ string_append (&temp, (work -> options & DMGL_JAVA) ? "." : "::");
+ }
+ string_prepends (result, &temp);
+ }
+
+ string_delete (&temp);
+ return (success);
+}
+
+/*
+
+LOCAL FUNCTION
+
+ get_count -- convert an ascii count to integer, consuming tokens
+
+SYNOPSIS
+
+ static int
+ get_count (const char **type, int *count)
+
+DESCRIPTION
+
+ Return 0 if no conversion is performed, 1 if a string is converted.
+*/
+
+static int
+get_count (type, count)
+ const char **type;
+ int *count;
+{
+ const char *p;
+ int n;
+
+ if (!isdigit (**type))
+ {
+ return (0);
+ }
+ else
+ {
+ *count = **type - '0';
+ (*type)++;
+ if (isdigit (**type))
+ {
+ p = *type;
+ n = *count;
+ do
+ {
+ n *= 10;
+ n += *p - '0';
+ p++;
+ }
+ while (isdigit (*p));
+ if (*p == '_')
+ {
+ *type = p + 1;
+ *count = n;
+ }
+ }
+ }
+ return (1);
+}
+
+/* result will be initialised here; it will be freed on failure */
+
+static int
+do_type (work, mangled, result)
+ struct work_stuff *work;
+ const char **mangled;
+ string *result;
+{
+ int n;
+ int done;
+ int success;
+ string decl;
+ const char *remembered_type;
+ int constp;
+ int volatilep;
+
+ string_init (&decl);
+ string_init (result);
+
+ done = 0;
+ success = 1;
+ while (success && !done)
+ {
+ int member;
+ switch (**mangled)
+ {
+
+ /* A pointer type */
+ case 'P':
+ case 'p':
+ (*mangled)++;
+ if (! (work -> options & DMGL_JAVA))
+ string_prepend (&decl, "*");
+ break;
+
+ /* A reference type */
+ case 'R':
+ (*mangled)++;
+ string_prepend (&decl, "&");
+ break;
+
+ /* An array */
+ case 'A':
+ {
+ const char *p = ++(*mangled);
+
+ string_prepend (&decl, "(");
+ string_append (&decl, ")[");
+ /* Copy anything up until the next underscore (the size of the
+ array). */
+ while (**mangled && **mangled != '_')
+ ++(*mangled);
+ if (**mangled == '_')
+ {
+ string_appendn (&decl, p, *mangled - p);
+ string_append (&decl, "]");
+ *mangled += 1;
+ }
+ else
+ success = 0;
+ break;
+ }
+
+ /* A back reference to a previously seen type */
+ case 'T':
+ (*mangled)++;
+ if (!get_count (mangled, &n) || n >= work -> ntypes)
+ {
+ success = 0;
+ }
+ else
+ {
+ remembered_type = work -> typevec[n];
+ mangled = &remembered_type;
+ }
+ break;
+
+ /* A function */
+ case 'F':
+ (*mangled)++;
+ if (!STRING_EMPTY (&decl) && decl.b[0] == '*')
+ {
+ string_prepend (&decl, "(");
+ string_append (&decl, ")");
+ }
+ /* After picking off the function args, we expect to either find the
+ function return type (preceded by an '_') or the end of the
+ string. */
+ if (!demangle_args (work, mangled, &decl)
+ || (**mangled != '_' && **mangled != '\0'))
+ {
+ success = 0;
+ }
+ if (success && (**mangled == '_'))
+ {
+ (*mangled)++;
+ }
+ break;
+
+ case 'M':
+ case 'O':
+ {
+ constp = 0;
+ volatilep = 0;
+
+ member = **mangled == 'M';
+ (*mangled)++;
+ if (!isdigit (**mangled) && **mangled != 't')
+ {
+ success = 0;
+ break;
+ }
+
+ string_append (&decl, ")");
+ string_prepend (&decl, (work -> options & DMGL_JAVA) ? "." : "::");
+ if (isdigit (**mangled))
+ {
+ n = consume_count (mangled);
+ if (strlen (*mangled) < n)
+ {
+ success = 0;
+ break;
+ }
+ string_prependn (&decl, *mangled, n);
+ *mangled += n;
+ }
+ else
+ {
+ string temp;
+ string_init (&temp);
+ success = demangle_template (work, mangled, &temp, NULL);
+ if (success)
+ {
+ string_prependn (&decl, temp.b, temp.p - temp.b);
+ string_clear (&temp);
+ }
+ else
+ break;
+ }
+ string_prepend (&decl, "(");
+ if (member)
+ {
+ if (**mangled == 'C')
+ {
+ (*mangled)++;
+ constp = 1;
+ }
+ if (**mangled == 'V')
+ {
+ (*mangled)++;
+ volatilep = 1;
+ }
+ if (*(*mangled)++ != 'F')
+ {
+ success = 0;
+ break;
+ }
+ }
+ if ((member && !demangle_args (work, mangled, &decl))
+ || **mangled != '_')
+ {
+ success = 0;
+ break;
+ }
+ (*mangled)++;
+ if (! PRINT_ANSI_QUALIFIERS)
+ {
+ break;
+ }
+ if (constp)
+ {
+ APPEND_BLANK (&decl);
+ string_append (&decl, "const");
+ }
+ if (volatilep)
+ {
+ APPEND_BLANK (&decl);
+ string_append (&decl, "volatile");
+ }
+ break;
+ }
+ case 'G':
+ (*mangled)++;
+ break;
+
+ case 'C':
+ (*mangled)++;
+ /*
+ if ((*mangled)[1] == 'P')
+ {
+ */
+ if (PRINT_ANSI_QUALIFIERS)
+ {
+ if (!STRING_EMPTY (&decl))
+ {
+ string_prepend (&decl, " ");
+ }
+ string_prepend (&decl, "const");
+ }
+ break;
+ /*
+ }
+ */
+
+ /* fall through */
+ default:
+ done = 1;
+ break;
+ }
+ }
+
+ switch (**mangled)
+ {
+ /* A qualified name, such as "Outer::Inner". */
+ case 'Q':
+ success = demangle_qualified (work, mangled, result, 0, 1);
+ break;
+
+ default:
+ success = demangle_fund_type (work, mangled, result);
+ break;
+ }
+
+ if (success)
+ {
+ if (!STRING_EMPTY (&decl))
+ {
+ string_append (result, " ");
+ string_appends (result, &decl);
+ }
+ }
+ else
+ {
+ string_delete (result);
+ }
+ string_delete (&decl);
+ return (success);
+}
+
+/* Given a pointer to a type string that represents a fundamental type
+ argument (int, long, unsigned int, etc) in TYPE, a pointer to the
+ string in which the demangled output is being built in RESULT, and
+ the WORK structure, decode the types and add them to the result.
+
+ For example:
+
+ "Ci" => "const int"
+ "Sl" => "signed long"
+ "CUs" => "const unsigned short"
+
+ */
+
+static int
+demangle_fund_type (work, mangled, result)
+ struct work_stuff *work;
+ const char **mangled;
+ string *result;
+{
+ int done = 0;
+ int success = 1;
+
+ /* First pick off any type qualifiers. There can be more than one. */
+
+ while (!done)
+ {
+ switch (**mangled)
+ {
+ case 'C':
+ (*mangled)++;
+ if (PRINT_ANSI_QUALIFIERS)
+ {
+ APPEND_BLANK (result);
+ string_append (result, "const");
+ }
+ break;
+ case 'U':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "unsigned");
+ break;
+ case 'S': /* signed char only */
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "signed");
+ break;
+ case 'V':
+ (*mangled)++;
+ if (PRINT_ANSI_QUALIFIERS)
+ {
+ APPEND_BLANK (result);
+ string_append (result, "volatile");
+ }
+ break;
+ case 'J':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "complex");
+ break;
+ default:
+ done = 1;
+ break;
+ }
+ }
+
+ /* Now pick off the fundamental type. There can be only one. */
+
+ switch (**mangled)
+ {
+ case '\0':
+ case '_':
+ break;
+ case 'v':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "void");
+ break;
+ case 'x':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "long long");
+ break;
+ case 'l':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "long");
+ break;
+ case 'i':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "int");
+ break;
+ case 's':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "short");
+ break;
+ case 'b':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "bool");
+ break;
+ case 'c':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "char");
+ break;
+ case 'w':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "wchar_t");
+ break;
+ case 'r':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "long double");
+ break;
+ case 'd':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "double");
+ break;
+ case 'f':
+ (*mangled)++;
+ APPEND_BLANK (result);
+ string_append (result, "float");
+ break;
+ case 'G':
+ (*mangled)++;
+ if (!isdigit (**mangled))
+ {
+ success = 0;
+ break;
+ }
+ /* fall through */
+ /* An explicit type, such as "6mytype" or "7integer" */
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ APPEND_BLANK (result);
+ if (!demangle_class_name (work, mangled, result)) {
+ --result->p;
+ success = 0;
+ }
+ break;
+ case 't':
+ success = demangle_template(work,mangled, result, 0);
+ break;
+ default:
+ success = 0;
+ break;
+ }
+
+ return (success);
+}
+
+/* `result' will be initialized in do_type; it will be freed on failure */
+
+static int
+do_arg (work, mangled, result)
+ struct work_stuff *work;
+ const char **mangled;
+ string *result;
+{
+ const char *start = *mangled;
+
+ if (!do_type (work, mangled, result))
+ {
+ return (0);
+ }
+ else
+ {
+ remember_type (work, start, *mangled - start);
+ return (1);
+ }
+}
+
+static void
+remember_type (work, start, len)
+ struct work_stuff *work;
+ const char *start;
+ int len;
+{
+ char *tem;
+
+ if (work -> ntypes >= work -> typevec_size)
+ {
+ if (work -> typevec_size == 0)
+ {
+ work -> typevec_size = 3;
+ work -> typevec
+ = (char **) xmalloc (sizeof (char *) * work -> typevec_size);
+ }
+ else
+ {
+ work -> typevec_size *= 2;
+ work -> typevec
+ = (char **) xrealloc ((char *)work -> typevec,
+ sizeof (char *) * work -> typevec_size);
+ }
+ }
+ tem = xmalloc (len + 1);
+ memcpy (tem, start, len);
+ tem[len] = '\0';
+ work -> typevec[work -> ntypes++] = tem;
+}
+
+/* Forget the remembered types, but not the type vector itself. */
+
+static void
+forget_types (work)
+ struct work_stuff *work;
+{
+ int i;
+
+ while (work -> ntypes > 0)
+ {
+ i = --(work -> ntypes);
+ if (work -> typevec[i] != NULL)
+ {
+ free (work -> typevec[i]);
+ work -> typevec[i] = NULL;
+ }
+ }
+}
+
+/* Process the argument list part of the signature, after any class spec
+ has been consumed, as well as the first 'F' character (if any). For
+ example:
+
+ "__als__3fooRT0" => process "RT0"
+ "complexfunc5__FPFPc_PFl_i" => process "PFPc_PFl_i"
+
+ DECLP must be already initialised, usually non-empty. It won't be freed
+ on failure.
+
+ Note that g++ differs significantly from ARM and lucid style mangling
+ with regards to references to previously seen types. For example, given
+ the source fragment:
+
+ class foo {
+ public:
+ foo::foo (int, foo &ia, int, foo &ib, int, foo &ic);
+ };
+
+ foo::foo (int, foo &ia, int, foo &ib, int, foo &ic) { ia = ib = ic; }
+ void foo (int, foo &ia, int, foo &ib, int, foo &ic) { ia = ib = ic; }
+
+ g++ produces the names:
+
+ __3fooiRT0iT2iT2
+ foo__FiR3fooiT1iT1
+
+ while lcc (and presumably other ARM style compilers as well) produces:
+
+ foo__FiR3fooT1T2T1T2
+ __ct__3fooFiR3fooT1T2T1T2
+
+ Note that g++ bases it's type numbers starting at zero and counts all
+ previously seen types, while lucid/ARM bases it's type numbers starting
+ at one and only considers types after it has seen the 'F' character
+ indicating the start of the function args. For lucid/ARM style, we
+ account for this difference by discarding any previously seen types when
+ we see the 'F' character, and subtracting one from the type number
+ reference.
+
+ */
+
+static int
+demangle_args (work, mangled, declp)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+{
+ string arg;
+ int need_comma = 0;
+ int r;
+ int t;
+ const char *tem;
+ char temptype;
+
+ if (PRINT_ARG_TYPES)
+ {
+ string_append (declp, "(");
+ if (**mangled == '\0')
+ {
+ string_append (declp, "void");
+ }
+ }
+
+ while (**mangled != '_' && **mangled != '\0' && **mangled != 'e')
+ {
+ if ((**mangled == 'N') || (**mangled == 'T'))
+ {
+ temptype = *(*mangled)++;
+
+ if (temptype == 'N')
+ {
+ if (!get_count (mangled, &r))
+ {
+ return (0);
+ }
+ }
+ else
+ {
+ r = 1;
+ }
+ if (ARM_DEMANGLING && work -> ntypes >= 10)
+ {
+ /* If we have 10 or more types we might have more than a 1 digit
+ index so we'll have to consume the whole count here. This
+ will lose if the next thing is a type name preceded by a
+ count but it's impossible to demangle that case properly
+ anyway. Eg if we already have 12 types is T12Pc "(..., type1,
+ Pc, ...)" or "(..., type12, char *, ...)" */
+ if ((t = consume_count(mangled)) == 0)
+ {
+ return (0);
+ }
+ }
+ else
+ {
+ if (!get_count (mangled, &t))
+ {
+ return (0);
+ }
+ }
+ if (LUCID_DEMANGLING || ARM_DEMANGLING)
+ {
+ t--;
+ }
+ /* Validate the type index. Protect against illegal indices from
+ malformed type strings. */
+ if ((t < 0) || (t >= work -> ntypes))
+ {
+ return (0);
+ }
+ while (--r >= 0)
+ {
+ tem = work -> typevec[t];
+ if (need_comma && PRINT_ARG_TYPES)
+ {
+ string_append (declp, ", ");
+ }
+ if (!do_arg (work, &tem, &arg))
+ {
+ return (0);
+ }
+ if (PRINT_ARG_TYPES)
+ {
+ string_appends (declp, &arg);
+ }
+ string_delete (&arg);
+ need_comma = 1;
+ }
+ }
+ else
+ {
+ if (need_comma & PRINT_ARG_TYPES)
+ {
+ string_append (declp, ", ");
+ }
+ if (!do_arg (work, mangled, &arg))
+ {
+ return (0);
+ }
+ if (PRINT_ARG_TYPES)
+ {
+ string_appends (declp, &arg);
+ }
+ string_delete (&arg);
+ need_comma = 1;
+ }
+ }
+
+ if (**mangled == 'e')
+ {
+ (*mangled)++;
+ if (PRINT_ARG_TYPES)
+ {
+ if (need_comma)
+ {
+ string_append (declp, ",");
+ }
+ string_append (declp, "...");
+ }
+ }
+
+ if (PRINT_ARG_TYPES)
+ {
+ string_append (declp, ")");
+ }
+ return (1);
+}
+
+static void
+demangle_function_name (work, mangled, declp, scan)
+ struct work_stuff *work;
+ const char **mangled;
+ string *declp;
+ const char *scan;
+{
+ int i;
+ int len;
+ string type;
+ const char *tem;
+
+ string_appendn (declp, (*mangled), scan - (*mangled));
+ string_need (declp, 1);
+ *(declp -> p) = '\0';
+
+ /* Consume the function name, including the "__" separating the name
+ from the signature. We are guaranteed that SCAN points to the
+ separator. */
+
+ (*mangled) = scan + 2;
+
+ if (LUCID_DEMANGLING || ARM_DEMANGLING)
+ {
+
+ /* See if we have an ARM style constructor or destructor operator.
+ If so, then just record it, clear the decl, and return.
+ We can't build the actual constructor/destructor decl until later,
+ when we recover the class name from the signature. */
+
+ if (strcmp (declp -> b, "__ct") == 0)
+ {
+ work -> constructor += 1;
+ string_clear (declp);
+ return;
+ }
+ else if (strcmp (declp -> b, "__dt") == 0)
+ {
+ work -> destructor += 1;
+ string_clear (declp);
+ return;
+ }
+ }
+
+ if (declp->p - declp->b >= 3
+ && declp->b[0] == 'o'
+ && declp->b[1] == 'p'
+ && strchr (cplus_markers, declp->b[2]) != NULL)
+ {
+ /* see if it's an assignment expression */
+ if (declp->p - declp->b >= 10 /* op$assign_ */
+ && memcmp (declp->b + 3, "assign_", 7) == 0)
+ {
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ len = declp->p - declp->b - 10;
+ if (strlen (optable[i].in) == len
+ && memcmp (optable[i].in, declp->b + 10, len) == 0)
+ {
+ string_clear (declp);
+ string_append (declp, "operator");
+ string_append (declp, optable[i].out);
+ string_append (declp, "=");
+ break;
+ }
+ }
+ }
+ else
+ {
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ int len = declp->p - declp->b - 3;
+ if (strlen (optable[i].in) == len
+ && memcmp (optable[i].in, declp->b + 3, len) == 0)
+ {
+ string_clear (declp);
+ string_append (declp, "operator");
+ string_append (declp, optable[i].out);
+ break;
+ }
+ }
+ }
+ }
+ else if (declp->p - declp->b >= 5 && memcmp (declp->b, "type", 4) == 0
+ && strchr (cplus_markers, declp->b[4]) != NULL)
+ {
+ /* type conversion operator */
+ tem = declp->b + 5;
+ if (do_type (work, &tem, &type))
+ {
+ string_clear (declp);
+ string_append (declp, "operator ");
+ string_appends (declp, &type);
+ string_delete (&type);
+ }
+ }
+ else if (declp->b[0] == '_' && declp->b[1] == '_'
+ && declp->b[2] == 'o' && declp->b[3] == 'p')
+ {
+ /* ANSI. */
+ /* type conversion operator. */
+ tem = declp->b + 4;
+ if (do_type (work, &tem, &type))
+ {
+ string_clear (declp);
+ string_append (declp, "operator ");
+ string_appends (declp, &type);
+ string_delete (&type);
+ }
+ }
+ else if (declp->b[0] == '_' && declp->b[1] == '_'
+ && declp->b[2] >= 'a' && declp->b[2] <= 'z'
+ && declp->b[3] >= 'a' && declp->b[3] <= 'z')
+ {
+ if (declp->b[4] == '\0')
+ {
+ /* Operator. */
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ if (strlen (optable[i].in) == 2
+ && memcmp (optable[i].in, declp->b + 2, 2) == 0)
+ {
+ string_clear (declp);
+ string_append (declp, "operator");
+ string_append (declp, optable[i].out);
+ break;
+ }
+ }
+ }
+ else
+ {
+ if (declp->b[2] == 'a' && declp->b[5] == '\0')
+ {
+ /* Assignment. */
+ for (i = 0; i < sizeof (optable) / sizeof (optable[0]); i++)
+ {
+ if (strlen (optable[i].in) == 3
+ && memcmp (optable[i].in, declp->b + 2, 3) == 0)
+ {
+ string_clear (declp);
+ string_append (declp, "operator");
+ string_append (declp, optable[i].out);
+ break;
+ }
+ }
+ }
+ }
+ }
+}
+
+/* a mini string-handling package */
+
+static void
+string_need (s, n)
+ string *s;
+ int n;
+{
+ int tem;
+
+ if (s->b == NULL)
+ {
+ if (n < 32)
+ {
+ n = 32;
+ }
+ s->p = s->b = xmalloc (n);
+ s->e = s->b + n;
+ }
+ else if (s->e - s->p < n)
+ {
+ tem = s->p - s->b;
+ n += tem;
+ n *= 2;
+ s->b = xrealloc (s->b, n);
+ s->p = s->b + tem;
+ s->e = s->b + n;
+ }
+}
+
+static void
+string_delete (s)
+ string *s;
+{
+ if (s->b != NULL)
+ {
+ free (s->b);
+ s->b = s->e = s->p = NULL;
+ }
+}
+
+static void
+string_init (s)
+ string *s;
+{
+ s->b = s->p = s->e = NULL;
+}
+
+static void
+string_clear (s)
+ string *s;
+{
+ s->p = s->b;
+}
+
+#if 0
+
+static int
+string_empty (s)
+ string *s;
+{
+ return (s->b == s->p);
+}
+
+#endif
+
+static void
+string_append (p, s)
+ string *p;
+ const char *s;
+{
+ int n;
+ if (s == NULL || *s == '\0')
+ return;
+ n = strlen (s);
+ string_need (p, n);
+ memcpy (p->p, s, n);
+ p->p += n;
+}
+
+static void
+string_appends (p, s)
+ string *p, *s;
+{
+ int n;
+
+ if (s->b != s->p)
+ {
+ n = s->p - s->b;
+ string_need (p, n);
+ memcpy (p->p, s->b, n);
+ p->p += n;
+ }
+}
+
+static void
+string_appendn (p, s, n)
+ string *p;
+ const char *s;
+ int n;
+{
+ if (n != 0)
+ {
+ string_need (p, n);
+ memcpy (p->p, s, n);
+ p->p += n;
+ }
+}
+
+static void
+string_prepend (p, s)
+ string *p;
+ const char *s;
+{
+ if (s != NULL && *s != '\0')
+ {
+ string_prependn (p, s, strlen (s));
+ }
+}
+
+static void
+string_prepends (p, s)
+ string *p, *s;
+{
+ if (s->b != s->p)
+ {
+ string_prependn (p, s->b, s->p - s->b);
+ }
+}
+
+static void
+string_prependn (p, s, n)
+ string *p;
+ const char *s;
+ int n;
+{
+ char *q;
+
+ if (n != 0)
+ {
+ string_need (p, n);
+ for (q = p->p - 1; q >= p->b; q--)
+ {
+ q[n] = q[0];
+ }
+ memcpy (p->b, s, n);
+ p->p += n;
+ }
+}
+
+/* To generate a standalone demangler program for testing purposes,
+ just compile and link this file with -DMAIN and libiberty.a. When
+ run, it demangles each command line arg, or each stdin string, and
+ prints the result on stdout. */
+
+#ifdef MAIN
+
+#include "getopt.h"
+
+static char *program_name;
+static char *program_version = VERSION;
+static int flags = DMGL_PARAMS | DMGL_ANSI;
+
+static void demangle_it PARAMS ((char *));
+static void usage PARAMS ((FILE *, int));
+static void fatal PARAMS ((char *));
+
+static void
+demangle_it (mangled_name)
+ char *mangled_name;
+{
+ char *result;
+
+ result = cplus_demangle (mangled_name, flags);
+ if (result == NULL)
+ {
+ printf ("%s\n", mangled_name);
+ }
+ else
+ {
+ printf ("%s\n", result);
+ free (result);
+ }
+}
+
+static void
+usage (stream, status)
+ FILE *stream;
+ int status;
+{
+ fprintf (stream, "\
+Usage: %s [-_] [-n] [-s {gnu,lucid,arm}] [--strip-underscores]\n\
+ [--no-strip-underscores] [--format={gnu,lucid,arm}]\n\
+ [--help] [--version] [arg...]\n",
+ program_name);
+ exit (status);
+}
+
+#define MBUF_SIZE 512
+char mbuffer[MBUF_SIZE];
+
+/* Defined in the automatically-generated underscore.c. */
+extern int prepends_underscore;
+
+int strip_underscore = 0;
+
+static struct option long_options[] = {
+ {"strip-underscores", no_argument, 0, '_'},
+ {"format", required_argument, 0, 's'},
+ {"help", no_argument, 0, 'h'},
+ {"java", no_argument, 0, 'j'},
+ {"no-strip-underscores", no_argument, 0, 'n'},
+ {"version", no_argument, 0, 'v'},
+ {0, no_argument, 0, 0}
+};
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ char *result;
+ int c;
+
+ program_name = argv[0];
+
+ strip_underscore = prepends_underscore;
+
+ while ((c = getopt_long (argc, argv, "_ns:j", long_options, (int *) 0)) != EOF)
+ {
+ switch (c)
+ {
+ case '?':
+ usage (stderr, 1);
+ break;
+ case 'h':
+ usage (stdout, 0);
+ case 'n':
+ strip_underscore = 0;
+ break;
+ case 'v':
+ printf ("GNU %s version %s\n", program_name, program_version);
+ exit (0);
+ case '_':
+ strip_underscore = 1;
+ break;
+ case 'j':
+ flags |= DMGL_JAVA;
+ break;
+ case 's':
+ if (strcmp (optarg, "gnu") == 0)
+ {
+ current_demangling_style = gnu_demangling;
+ }
+ else if (strcmp (optarg, "lucid") == 0)
+ {
+ current_demangling_style = lucid_demangling;
+ }
+ else if (strcmp (optarg, "arm") == 0)
+ {
+ current_demangling_style = arm_demangling;
+ }
+ else
+ {
+ fprintf (stderr, "%s: unknown demangling style `%s'\n",
+ program_name, optarg);
+ exit (1);
+ }
+ break;
+ }
+ }
+
+ if (optind < argc)
+ {
+ for ( ; optind < argc; optind++)
+ {
+ demangle_it (argv[optind]);
+ }
+ }
+ else
+ {
+ for (;;)
+ {
+ int i = 0;
+ c = getchar ();
+ /* Try to read a label. */
+ while (c != EOF && (isalnum(c) || c == '_' || c == '$' || c == '.'))
+ {
+ if (i >= MBUF_SIZE-1)
+ break;
+ mbuffer[i++] = c;
+ c = getchar ();
+ }
+ if (i > 0)
+ {
+ int skip_first = 0;
+
+ if (mbuffer[0] == '.')
+ ++skip_first;
+ if (strip_underscore && mbuffer[skip_first] == '_')
+ ++skip_first;
+
+ if (skip_first > i)
+ skip_first = i;
+
+ mbuffer[i] = 0;
+
+ result = cplus_demangle (mbuffer + skip_first, flags);
+ if (result)
+ {
+ if (mbuffer[0] == '.')
+ putc ('.', stdout);
+ fputs (result, stdout);
+ free (result);
+ }
+ else
+ fputs (mbuffer, stdout);
+
+ fflush (stdout);
+ }
+ if (c == EOF)
+ break;
+ putchar (c);
+ }
+ }
+
+ exit (0);
+}
+
+static void
+fatal (str)
+ char *str;
+{
+ fprintf (stderr, "%s: %s\n", program_name, str);
+ exit (1);
+}
+
+char * malloc ();
+char * realloc ();
+
+char *
+xmalloc (size)
+ unsigned size;
+{
+ register char *value = (char *) malloc (size);
+ if (value == 0)
+ fatal ("virtual memory exhausted");
+ return value;
+}
+
+char *
+xrealloc (ptr, size)
+ char *ptr;
+ unsigned size;
+{
+ register char *value = (char *) realloc (ptr, size);
+ if (value == 0)
+ fatal ("virtual memory exhausted");
+ return value;
+}
+#endif /* main */
diff --git a/libiberty/dummy.c b/libiberty/dummy.c
new file mode 100644
index 00000000000..08da647e30e
--- /dev/null
+++ b/libiberty/dummy.c
@@ -0,0 +1,49 @@
+#include <ansidecl.h>
+
+#ifdef __STDC__
+#include <stddef.h>
+#define clock_t unsigned long
+#define DEF(NAME, RETURN_TYPE, ARGLIST, ARGS) extern RETURN_TYPE NAME (ARGS);
+#define DEFFUNC(NAME, RETURN_TYPE, ARGLIST, ARGS) extern RETURN_TYPE NAME (ARGS);
+#else
+#define void int
+#define size_t unsigned long
+#define clock_t unsigned long
+#define DEF(NAME, RETURN_TYPE, ARGLIST, ARGS) extern RETURN_TYPE NAME ();
+#define DEFFUNC(NAME, RETURN_TYPE, ARGLIST, ARGS) extern RETURN_TYPE NAME ();
+#endif
+
+#define DEFVAR(NAME,DECL,USE) extern DECL;
+
+#define NOTHING /*nothing*/
+
+#include "alloca-conf.h"
+#include "functions.def"
+
+/* Always use our: getopt.o getopt1.o obstack.o spaces.o */
+
+int
+main (argc, argv)
+ int argc; char **argv;
+{
+
+/* Create a dummy function call for each DEF-defined function. */
+
+#undef DEF
+#undef DEFVAR
+#undef DEFFUNC
+#undef AND
+#define AND = 0;
+/* ARGS expands into a set of declaration. NAME ARG_LIST expands
+ info a function call that uses those variables as actual parameters.
+ If the function has been DEF'ed correctly, we can pass the right
+ number and types of parameters, which is nice. (E.g. gcc may
+ otherwise complain about the wrong number of parameters to certain
+ builtins.) */
+#define DEF(NAME, RETURN_TYPE, ARG_LIST, ARGS) { ARGS; NAME ARG_LIST; }
+#define DEFVAR(NAME, DECL, USE) { USE; }
+#define DEFFUNC(NAME, RETURN_TYPE, ARG_LIST, ARGS) { ARGS; NAME ARG_LIST; }
+#include "functions.def"
+
+ return (0);
+}
diff --git a/libiberty/fdmatch.c b/libiberty/fdmatch.c
new file mode 100644
index 00000000000..7af039f5a2b
--- /dev/null
+++ b/libiberty/fdmatch.c
@@ -0,0 +1,73 @@
+/* Compare two open file descriptors to see if they refer to the same file.
+ Copyright (C) 1991 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; see the file COPYING.LIB. If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+
+/*
+
+NAME
+
+ fdmatch -- see if two file descriptors refer to same file
+
+SYNOPSIS
+
+ int fdmatch (int fd1, int fd2)
+
+DESCRIPTION
+
+ Check to see if two open file descriptors refer to the same file.
+ This is useful, for example, when we have an open file descriptor
+ for an unnamed file, and the name of a file that we believe to
+ correspond to that fd. This can happen when we are exec'd with
+ an already open file (stdout for example) or from the SVR4 /proc
+ calls that return open file descriptors for mapped address spaces.
+ All we have to do is open the file by name and check the two file
+ descriptors for a match, which is done by comparing major&minor
+ device numbers and inode numbers.
+
+BUGS
+
+ (FIXME: does this work for networks?)
+ It works for NFS, which assigns a device number to each mount.
+
+*/
+
+#include "ansidecl.h"
+#include "libiberty.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+
+int fdmatch (fd1, fd2)
+ int fd1;
+ int fd2;
+{
+ struct stat sbuf1;
+ struct stat sbuf2;
+
+ if ((fstat (fd1, &sbuf1) == 0) &&
+ (fstat (fd2, &sbuf2) == 0) &&
+ (sbuf1.st_dev == sbuf2.st_dev) &&
+ (sbuf1.st_ino == sbuf2.st_ino))
+ {
+ return (1);
+ }
+ else
+ {
+ return (0);
+ }
+}
diff --git a/libiberty/floatformat.c b/libiberty/floatformat.c
new file mode 100644
index 00000000000..7f6086f4306
--- /dev/null
+++ b/libiberty/floatformat.c
@@ -0,0 +1,401 @@
+/* IEEE floating point support routines, for GDB, the GNU Debugger.
+ Copyright (C) 1991, 1994 Free Software Foundation, Inc.
+
+This file is part of GDB.
+
+This program 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 of the License, or
+(at your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#include "floatformat.h"
+#include <math.h> /* ldexp */
+#ifdef __STDC__
+#include <stddef.h>
+extern void *memcpy (void *s1, const void *s2, size_t n);
+extern void *memset (void *s, int c, size_t n);
+#else
+extern char *memcpy ();
+extern char *memset ();
+#endif
+
+/* The odds that CHAR_BIT will be anything but 8 are low enough that I'm not
+ going to bother with trying to muck around with whether it is defined in
+ a system header, what we do if not, etc. */
+#define FLOATFORMAT_CHAR_BIT 8
+
+/* floatformats for IEEE single and double, big and little endian. */
+const struct floatformat floatformat_ieee_single_big =
+{
+ floatformat_big, 32, 0, 1, 8, 127, 255, 9, 23, floatformat_intbit_no
+};
+const struct floatformat floatformat_ieee_single_little =
+{
+ floatformat_little, 32, 0, 1, 8, 127, 255, 9, 23, floatformat_intbit_no
+};
+const struct floatformat floatformat_ieee_double_big =
+{
+ floatformat_big, 64, 0, 1, 11, 1023, 2047, 12, 52, floatformat_intbit_no
+};
+const struct floatformat floatformat_ieee_double_little =
+{
+ floatformat_little, 64, 0, 1, 11, 1023, 2047, 12, 52, floatformat_intbit_no
+};
+
+/* floatformat for IEEE double, little endian byte order, with big endian word
+ ordering, as on the ARM. */
+
+const struct floatformat floatformat_ieee_double_littlebyte_bigword =
+{
+ floatformat_littlebyte_bigword, 64, 0, 1, 11, 1023, 2047, 12, 52, floatformat_intbit_no
+};
+
+const struct floatformat floatformat_i387_ext =
+{
+ floatformat_little, 80, 0, 1, 15, 0x3fff, 0x7fff, 16, 64,
+ floatformat_intbit_yes
+};
+const struct floatformat floatformat_m68881_ext =
+{
+ /* Note that the bits from 16 to 31 are unused. */
+ floatformat_big, 96, 0, 1, 15, 0x3fff, 0x7fff, 32, 64, floatformat_intbit_yes
+};
+const struct floatformat floatformat_i960_ext =
+{
+ /* Note that the bits from 0 to 15 are unused. */
+ floatformat_little, 96, 16, 17, 15, 0x3fff, 0x7fff, 32, 64,
+ floatformat_intbit_yes
+};
+const struct floatformat floatformat_m88110_ext =
+{
+#ifdef HARRIS_FLOAT_FORMAT
+ /* Harris uses raw format 128 bytes long, but the number is just an ieee
+ double, and the last 64 bits are wasted. */
+ floatformat_big,128, 0, 1, 11, 0x3ff, 0x7ff, 12, 52,
+ floatformat_intbit_no
+#else
+ floatformat_big, 80, 0, 1, 15, 0x3fff, 0x7fff, 16, 64,
+ floatformat_intbit_yes
+#endif /* HARRIS_FLOAT_FORMAT */
+};
+const struct floatformat floatformat_arm_ext =
+{
+ /* Bits 1 to 16 are unused. */
+ floatformat_big, 96, 0, 17, 15, 0x3fff, 0x7fff, 32, 64,
+ floatformat_intbit_yes
+};
+
+static unsigned long get_field PARAMS ((unsigned char *,
+ enum floatformat_byteorders,
+ unsigned int,
+ unsigned int,
+ unsigned int));
+
+/* Extract a field which starts at START and is LEN bytes long. DATA and
+ TOTAL_LEN are the thing we are extracting it from, in byteorder ORDER. */
+static unsigned long
+get_field (data, order, total_len, start, len)
+ unsigned char *data;
+ enum floatformat_byteorders order;
+ unsigned int total_len;
+ unsigned int start;
+ unsigned int len;
+{
+ unsigned long result;
+ unsigned int cur_byte;
+ int cur_bitshift;
+
+ /* Start at the least significant part of the field. */
+ cur_byte = (start + len) / FLOATFORMAT_CHAR_BIT;
+ if (order == floatformat_little)
+ cur_byte = (total_len / FLOATFORMAT_CHAR_BIT) - cur_byte - 1;
+ cur_bitshift =
+ ((start + len) % FLOATFORMAT_CHAR_BIT) - FLOATFORMAT_CHAR_BIT;
+ result = *(data + cur_byte) >> (-cur_bitshift);
+ cur_bitshift += FLOATFORMAT_CHAR_BIT;
+ if (order == floatformat_little)
+ ++cur_byte;
+ else
+ --cur_byte;
+
+ /* Move towards the most significant part of the field. */
+ while (cur_bitshift < len)
+ {
+ if (len - cur_bitshift < FLOATFORMAT_CHAR_BIT)
+ /* This is the last byte; zero out the bits which are not part of
+ this field. */
+ result |=
+ (*(data + cur_byte) & ((1 << (len - cur_bitshift)) - 1))
+ << cur_bitshift;
+ else
+ result |= *(data + cur_byte) << cur_bitshift;
+ cur_bitshift += FLOATFORMAT_CHAR_BIT;
+ if (order == floatformat_little)
+ ++cur_byte;
+ else
+ --cur_byte;
+ }
+ return result;
+}
+
+#ifndef min
+#define min(a, b) ((a) < (b) ? (a) : (b))
+#endif
+
+/* Convert from FMT to a double.
+ FROM is the address of the extended float.
+ Store the double in *TO. */
+
+void
+floatformat_to_double (fmt, from, to)
+ const struct floatformat *fmt;
+ char *from;
+ double *to;
+{
+ unsigned char *ufrom = (unsigned char *)from;
+ double dto;
+ long exponent;
+ unsigned long mant;
+ unsigned int mant_bits, mant_off;
+ int mant_bits_left;
+ int special_exponent; /* It's a NaN, denorm or zero */
+
+ exponent = get_field (ufrom, fmt->byteorder, fmt->totalsize,
+ fmt->exp_start, fmt->exp_len);
+ /* Note that if exponent indicates a NaN, we can't really do anything useful
+ (not knowing if the host has NaN's, or how to build one). So it will
+ end up as an infinity or something close; that is OK. */
+
+ mant_bits_left = fmt->man_len;
+ mant_off = fmt->man_start;
+ dto = 0.0;
+
+ special_exponent = exponent == 0 || exponent == fmt->exp_nan;
+
+ /* Don't bias zero's, denorms or NaNs. */
+ if (!special_exponent)
+ exponent -= fmt->exp_bias;
+
+ /* Build the result algebraically. Might go infinite, underflow, etc;
+ who cares. */
+
+ /* If this format uses a hidden bit, explicitly add it in now. Otherwise,
+ increment the exponent by one to account for the integer bit. */
+
+ if (!special_exponent)
+ if (fmt->intbit == floatformat_intbit_no)
+ dto = ldexp (1.0, exponent);
+ else
+ exponent++;
+
+ while (mant_bits_left > 0)
+ {
+ mant_bits = min (mant_bits_left, 32);
+
+ mant = get_field (ufrom, fmt->byteorder, fmt->totalsize,
+ mant_off, mant_bits);
+
+ dto += ldexp ((double)mant, exponent - mant_bits);
+ exponent -= mant_bits;
+ mant_off += mant_bits;
+ mant_bits_left -= mant_bits;
+ }
+
+ /* Negate it if negative. */
+ if (get_field (ufrom, fmt->byteorder, fmt->totalsize, fmt->sign_start, 1))
+ dto = -dto;
+ *to = dto;
+}
+
+static void put_field PARAMS ((unsigned char *, enum floatformat_byteorders,
+ unsigned int,
+ unsigned int,
+ unsigned int,
+ unsigned long));
+
+/* Set a field which starts at START and is LEN bytes long. DATA and
+ TOTAL_LEN are the thing we are extracting it from, in byteorder ORDER. */
+static void
+put_field (data, order, total_len, start, len, stuff_to_put)
+ unsigned char *data;
+ enum floatformat_byteorders order;
+ unsigned int total_len;
+ unsigned int start;
+ unsigned int len;
+ unsigned long stuff_to_put;
+{
+ unsigned int cur_byte;
+ int cur_bitshift;
+
+ /* Start at the least significant part of the field. */
+ cur_byte = (start + len) / FLOATFORMAT_CHAR_BIT;
+ if (order == floatformat_little)
+ cur_byte = (total_len / FLOATFORMAT_CHAR_BIT) - cur_byte - 1;
+ cur_bitshift =
+ ((start + len) % FLOATFORMAT_CHAR_BIT) - FLOATFORMAT_CHAR_BIT;
+ *(data + cur_byte) &=
+ ~(((1 << ((start + len) % FLOATFORMAT_CHAR_BIT)) - 1) << (-cur_bitshift));
+ *(data + cur_byte) |=
+ (stuff_to_put & ((1 << FLOATFORMAT_CHAR_BIT) - 1)) << (-cur_bitshift);
+ cur_bitshift += FLOATFORMAT_CHAR_BIT;
+ if (order == floatformat_little)
+ ++cur_byte;
+ else
+ --cur_byte;
+
+ /* Move towards the most significant part of the field. */
+ while (cur_bitshift < len)
+ {
+ if (len - cur_bitshift < FLOATFORMAT_CHAR_BIT)
+ {
+ /* This is the last byte. */
+ *(data + cur_byte) &=
+ ~((1 << (len - cur_bitshift)) - 1);
+ *(data + cur_byte) |= (stuff_to_put >> cur_bitshift);
+ }
+ else
+ *(data + cur_byte) = ((stuff_to_put >> cur_bitshift)
+ & ((1 << FLOATFORMAT_CHAR_BIT) - 1));
+ cur_bitshift += FLOATFORMAT_CHAR_BIT;
+ if (order == floatformat_little)
+ ++cur_byte;
+ else
+ --cur_byte;
+ }
+}
+
+/* The converse: convert the double *FROM to an extended float
+ and store where TO points. Neither FROM nor TO have any alignment
+ restrictions. */
+
+void
+floatformat_from_double (fmt, from, to)
+ CONST struct floatformat *fmt;
+ double *from;
+ char *to;
+{
+ double dfrom;
+ int exponent;
+ double mant;
+ unsigned int mant_bits, mant_off;
+ int mant_bits_left;
+ unsigned char *uto = (unsigned char *)to;
+
+ memcpy (&dfrom, from, sizeof (dfrom));
+ memset (uto, 0, fmt->totalsize / FLOATFORMAT_CHAR_BIT);
+ if (dfrom == 0)
+ return; /* Result is zero */
+ if (dfrom != dfrom)
+ {
+ /* From is NaN */
+ put_field (uto, fmt->byteorder, fmt->totalsize, fmt->exp_start,
+ fmt->exp_len, fmt->exp_nan);
+ /* Be sure it's not infinity, but NaN value is irrel */
+ put_field (uto, fmt->byteorder, fmt->totalsize, fmt->man_start,
+ 32, 1);
+ return;
+ }
+
+ /* If negative, set the sign bit. */
+ if (dfrom < 0)
+ {
+ put_field (uto, fmt->byteorder, fmt->totalsize, fmt->sign_start, 1, 1);
+ dfrom = -dfrom;
+ }
+
+ /* How to tell an infinity from an ordinary number? FIXME-someday */
+
+ mant = frexp (dfrom, &exponent);
+ put_field (uto, fmt->byteorder, fmt->totalsize, fmt->exp_start, fmt->exp_len,
+ exponent + fmt->exp_bias - 1);
+
+ mant_bits_left = fmt->man_len;
+ mant_off = fmt->man_start;
+ while (mant_bits_left > 0)
+ {
+ unsigned long mant_long;
+ mant_bits = mant_bits_left < 32 ? mant_bits_left : 32;
+
+ mant *= 4294967296.0;
+ mant_long = (unsigned long)mant;
+ mant -= mant_long;
+
+ /* If the integer bit is implicit, then we need to discard it.
+ If we are discarding a zero, we should be (but are not) creating
+ a denormalized number which means adjusting the exponent
+ (I think). */
+ if (mant_bits_left == fmt->man_len
+ && fmt->intbit == floatformat_intbit_no)
+ {
+ mant_long &= 0x7fffffff;
+ mant_bits -= 1;
+ }
+ else if (mant_bits < 32)
+ {
+ /* The bits we want are in the most significant MANT_BITS bits of
+ mant_long. Move them to the least significant. */
+ mant_long >>= 32 - mant_bits;
+ }
+
+ put_field (uto, fmt->byteorder, fmt->totalsize,
+ mant_off, mant_bits, mant_long);
+ mant_off += mant_bits;
+ mant_bits_left -= mant_bits;
+ }
+}
+
+
+#ifdef IEEE_DEBUG
+
+/* This is to be run on a host which uses IEEE floating point. */
+
+void
+ieee_test (n)
+ double n;
+{
+ double result;
+ char exten[16];
+
+ floatformat_to_double (&floatformat_ieee_double_big, &n, &result);
+ if (n != result)
+ printf ("Differ(to): %.20g -> %.20g\n", n, result);
+ floatformat_from_double (&floatformat_ieee_double_big, &n, &result);
+ if (n != result)
+ printf ("Differ(from): %.20g -> %.20g\n", n, result);
+
+ floatformat_from_double (&floatformat_m68881_ext, &n, exten);
+ floatformat_to_double (&floatformat_m68881_ext, exten, &result);
+ if (n != result)
+ printf ("Differ(to+from): %.20g -> %.20g\n", n, result);
+
+#if IEEE_DEBUG > 1
+ /* This is to be run on a host which uses 68881 format. */
+ {
+ long double ex = *(long double *)exten;
+ if (ex != n)
+ printf ("Differ(from vs. extended): %.20g\n", n);
+ }
+#endif
+}
+
+int
+main ()
+{
+ ieee_test (0.5);
+ ieee_test (256.0);
+ ieee_test (0.12345);
+ ieee_test (234235.78907234);
+ ieee_test (-512.0);
+ ieee_test (-0.004321);
+ return 0;
+}
+#endif
diff --git a/libiberty/fnmatch.c b/libiberty/fnmatch.c
new file mode 100644
index 00000000000..685d9e40edc
--- /dev/null
+++ b/libiberty/fnmatch.c
@@ -0,0 +1,223 @@
+/* Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc.
+
+NOTE: The canonical source of this file is maintained with the GNU C Library.
+Bugs can be reported to bug-glibc@prep.ai.mit.edu.
+
+This program 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.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifdef HAVE_CONFIG_H
+#if defined (CONFIG_BROKETS)
+/* We use <config.h> instead of "config.h" so that a compilation
+ using -I. -I$srcdir will use ./config.h rather than $srcdir/config.h
+ (which it would do because it found this file in $srcdir). */
+#include <config.h>
+#else
+#include "config.h"
+#endif
+#endif
+
+
+#ifndef _GNU_SOURCE
+#define _GNU_SOURCE
+#endif
+
+/* This code to undef const added in libiberty. */
+#ifndef __STDC__
+/* This is a separate conditional since some stdc systems
+ reject `defined (const)'. */
+#ifndef const
+#define const
+#endif
+#endif
+
+#include <errno.h>
+#include <fnmatch.h>
+#include <ctype.h>
+
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+ actually compiling the library itself. This code is part of the GNU C
+ Library, but also included in many other GNU distributions. Compiling
+ and linking in this code is a waste when using the GNU C library
+ (especially if it is a shared library). Rather than having every GNU
+ program understand `configure --with-gnu-libc' and omit the object files,
+ it is simpler to just do this in the source for each such file. */
+
+#if defined (_LIBC) || !defined (__GNU_LIBRARY__)
+
+
+#if !defined(__GNU_LIBRARY__) && !defined(STDC_HEADERS)
+extern int errno;
+#endif
+
+/* Match STRING against the filename pattern PATTERN, returning zero if
+ it matches, nonzero if not. */
+int
+fnmatch (pattern, string, flags)
+ const char *pattern;
+ const char *string;
+ int flags;
+{
+ register const char *p = pattern, *n = string;
+ register char c;
+
+/* Note that this evalutes C many times. */
+#define FOLD(c) ((flags & FNM_CASEFOLD) && isupper (c) ? tolower (c) : (c))
+
+ while ((c = *p++) != '\0')
+ {
+ c = FOLD (c);
+
+ switch (c)
+ {
+ case '?':
+ if (*n == '\0')
+ return FNM_NOMATCH;
+ else if ((flags & FNM_FILE_NAME) && *n == '/')
+ return FNM_NOMATCH;
+ else if ((flags & FNM_PERIOD) && *n == '.' &&
+ (n == string || ((flags & FNM_FILE_NAME) && n[-1] == '/')))
+ return FNM_NOMATCH;
+ break;
+
+ case '\\':
+ if (!(flags & FNM_NOESCAPE))
+ {
+ c = *p++;
+ c = FOLD (c);
+ }
+ if (FOLD (*n) != c)
+ return FNM_NOMATCH;
+ break;
+
+ case '*':
+ if ((flags & FNM_PERIOD) && *n == '.' &&
+ (n == string || ((flags & FNM_FILE_NAME) && n[-1] == '/')))
+ return FNM_NOMATCH;
+
+ for (c = *p++; c == '?' || c == '*'; c = *p++, ++n)
+ if (((flags & FNM_FILE_NAME) && *n == '/') ||
+ (c == '?' && *n == '\0'))
+ return FNM_NOMATCH;
+
+ if (c == '\0')
+ return 0;
+
+ {
+ char c1 = (!(flags & FNM_NOESCAPE) && c == '\\') ? *p : c;
+ c1 = FOLD (c1);
+ for (--p; *n != '\0'; ++n)
+ if ((c == '[' || FOLD (*n) == c1) &&
+ fnmatch (p, n, flags & ~FNM_PERIOD) == 0)
+ return 0;
+ return FNM_NOMATCH;
+ }
+
+ case '[':
+ {
+ /* Nonzero if the sense of the character class is inverted. */
+ register int not;
+
+ if (*n == '\0')
+ return FNM_NOMATCH;
+
+ if ((flags & FNM_PERIOD) && *n == '.' &&
+ (n == string || ((flags & FNM_FILE_NAME) && n[-1] == '/')))
+ return FNM_NOMATCH;
+
+ not = (*p == '!' || *p == '^');
+ if (not)
+ ++p;
+
+ c = *p++;
+ for (;;)
+ {
+ register char cstart = c, cend = c;
+
+ if (!(flags & FNM_NOESCAPE) && c == '\\')
+ cstart = cend = *p++;
+
+ cstart = cend = FOLD (cstart);
+
+ if (c == '\0')
+ /* [ (unterminated) loses. */
+ return FNM_NOMATCH;
+
+ c = *p++;
+ c = FOLD (c);
+
+ if ((flags & FNM_FILE_NAME) && c == '/')
+ /* [/] can never match. */
+ return FNM_NOMATCH;
+
+ if (c == '-' && *p != ']')
+ {
+ cend = *p++;
+ if (!(flags & FNM_NOESCAPE) && cend == '\\')
+ cend = *p++;
+ if (cend == '\0')
+ return FNM_NOMATCH;
+ cend = FOLD (cend);
+
+ c = *p++;
+ }
+
+ if (FOLD (*n) >= cstart && FOLD (*n) <= cend)
+ goto matched;
+
+ if (c == ']')
+ break;
+ }
+ if (!not)
+ return FNM_NOMATCH;
+ break;
+
+ matched:;
+ /* Skip the rest of the [...] that already matched. */
+ while (c != ']')
+ {
+ if (c == '\0')
+ /* [... (unterminated) loses. */
+ return FNM_NOMATCH;
+
+ c = *p++;
+ if (!(flags & FNM_NOESCAPE) && c == '\\')
+ /* XXX 1003.2d11 is unclear if this is right. */
+ ++p;
+ }
+ if (not)
+ return FNM_NOMATCH;
+ }
+ break;
+
+ default:
+ if (c != FOLD (*n))
+ return FNM_NOMATCH;
+ }
+
+ ++n;
+ }
+
+ if (*n == '\0')
+ return 0;
+
+ if ((flags & FNM_LEADING_DIR) && *n == '/')
+ /* The FNM_LEADING_DIR flag says that "foo*" matches "foobar/frobozz". */
+ return 0;
+
+ return FNM_NOMATCH;
+}
+
+#endif /* _LIBC or not __GNU_LIBRARY__. */
diff --git a/libiberty/functions.def b/libiberty/functions.def
new file mode 100644
index 00000000000..aeed4c69c3b
--- /dev/null
+++ b/libiberty/functions.def
@@ -0,0 +1,69 @@
+/*
+ * List of function definitions that may *optionally* be included
+ * in libiberty.a. The function names must match the filenames,
+ * e.g. bzero() is defined in bzero.c. (While each file can contain
+ * extra functions, do not list them.)
+ *
+ * In the default libiberty configuration, these object files
+ * (e.g bzero.o) are included if and only if cc fails to find
+ * the corresponding function in libc.
+ */
+
+DEF(atexit, int, (f), void (*f)())
+DEF(bcmp, int, (s1, s2, length), char *s1 AND char *s2 AND int length )
+DEF(bcopy, void, (s1, s2, length), char *s1 AND char *s2 AND int length )
+DEF(bzero, void, (s, length), char *s AND int length)
+DEF(clock, clock_t, (), NOTHING)
+DEF(getopt, int, (argc, argv, optstring),
+ int argc AND char **argv AND CONST char *optstring)
+DEF(getpagesize, int , (), NOTHING)
+DEF(getcwd, char*, (buf, len), char *buf AND int len)
+DEF(index, char*, (s, c), char *s AND int c)
+DEF(insque, void, (), NOTHING)
+DEF(memchr, PTR, (s, c, length), CONST PTR s AND int c AND size_t length)
+DEF(memcmp, int, (s1, s2, length),
+ CONST PTR s1 AND CONST PTR s2 AND size_t length)
+DEF(memcpy, PTR, (s1, s2, length), PTR s1 AND CONST PTR s2 AND size_t length)
+DEF(memmove, PTR, (s1, s2, length), PTR s1 AND CONST PTR s2 AND size_t length)
+DEF(memset, PTR, (s, val, length), PTR s AND int val AND size_t length )
+DEF(random, long int, (), NOTHING)
+DEF(rename, int, (f, t), char *f AND char *t)
+DEF(rindex, char*, (s, c), char *s AND int c)
+DEF(strcasecmp, int, (s1, s2), char *s1 AND char *s2)
+DEF(strncasecmp, int, (s1, s2, n), char *s1 AND char *s2 AND int n)
+DEF(strchr, char*, (s, c), CONST char *s AND int c)
+DEF(strdup, char*, (s1), char * s1)
+DEF(strrchr, char*, (s, c), CONST char *s AND int c)
+DEF(strstr, char*, (), NOTHING)
+DEF(strtod, double, (), NOTHING)
+DEF(strtol, long, (), NOTHING)
+DEF(strtoul, unsigned long, (), NOTHING)
+DEF(tmpnam, char *, (s), char * s)
+DEF(vfork, int, (), NOTHING)
+DEF(vfprintf, int, (), NOTHING)
+DEF(vprintf, int, (), NOTHING)
+DEF(vsprintf, int, (), NOTHING)
+DEF(sigsetmask, int, (), NOTHING)
+DEF(alloca, PTR, (size), size_t size)
+DEF(waitpid, int, (pid, statp, opts), int pid AND int* statp AND int opts )
+DEF(vasprintf, int, (), NOTHING)
+
+/* List of global variables that we want to look for in the host
+ environment, and to generate an entry NEED_<variable> in config.h
+ if they are not found. The first arg is the variable name, the
+ second arg is how to declare the variable, and the third is how to
+ use it. */
+
+DEFVAR(sys_nerr, int sys_nerr, sys_nerr = 0)
+DEFVAR(sys_errlist, char *sys_errlist[], sys_errlist[0] = 0)
+DEFVAR(sys_siglist, char *sys_siglist[], sys_siglist[0] = 0)
+
+/* List of global functions that we want to look for in the host
+ environment, and to generate an entry NEED_<funcname> in config.h
+ if they are not found. */
+
+DEFFUNC(strerror, char*, (), NOTHING)
+DEFFUNC(psignal, void, (signo, message), unsigned signo AND char *message)
+DEFFUNC(basename, char *, (name), CONST char *name)
+DEFFUNC(on_exit, void, (f, arg), void (*f)() AND char *arg)
+DEFFUNC(strsignal, char *, (), NOTHING)
diff --git a/libiberty/getcwd.c b/libiberty/getcwd.c
new file mode 100644
index 00000000000..60c1dd84eed
--- /dev/null
+++ b/libiberty/getcwd.c
@@ -0,0 +1,52 @@
+/* Emulate getcwd using getwd.
+ This function is in the public domain. */
+
+/*
+NAME
+ getcwd -- get absolute pathname for current working directory
+
+SYNOPSIS
+ char *getcwd (char pathname[len], len)
+
+DESCRIPTION
+ Copy the absolute pathname for the current working directory into
+ the supplied buffer and return a pointer to the buffer. If the
+ current directory's path doesn't fit in LEN characters, the result
+ is NULL and errno is set.
+
+BUGS
+ Emulated via the getwd() call, which is reasonable for most
+ systems that do not have getcwd().
+
+*/
+
+#ifndef NO_SYS_PARAM_H
+#include <sys/param.h>
+#endif
+#include <errno.h>
+
+extern char *getwd ();
+extern int errno;
+
+#ifndef MAXPATHLEN
+#define MAXPATHLEN 1024
+#endif
+
+char *
+getcwd (buf, len)
+ char *buf;
+ int len;
+{
+ char ourbuf[MAXPATHLEN];
+ char *result;
+
+ result = getwd (ourbuf);
+ if (result) {
+ if (strlen (ourbuf) >= len) {
+ errno = ERANGE;
+ return 0;
+ }
+ strcpy (buf, ourbuf);
+ }
+ return buf;
+}
diff --git a/libiberty/getopt.c b/libiberty/getopt.c
new file mode 100644
index 00000000000..79080aa54b3
--- /dev/null
+++ b/libiberty/getopt.c
@@ -0,0 +1,760 @@
+/* Getopt for GNU.
+ NOTE: getopt is now part of the C library, so if you don't know what
+ "Keep this file name-space clean" means, talk to roland@gnu.ai.mit.edu
+ before changing it!
+
+ Copyright (C) 1987, 88, 89, 90, 91, 92, 93, 94, 95
+ Free Software Foundation, Inc.
+
+This file is part of the libiberty 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING. If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* This tells Alpha OSF/1 not to define a getopt prototype in <stdio.h>.
+ Ditto for AIX 3.2 and <stdlib.h>. */
+#ifndef _NO_PROTO
+#define _NO_PROTO
+#endif
+
+#ifdef HAVE_CONFIG_H
+#if defined (emacs) || defined (CONFIG_BROKETS)
+/* We use <config.h> instead of "config.h" so that a compilation
+ using -I. -I$srcdir will use ./config.h rather than $srcdir/config.h
+ (which it would do because it found this file in $srcdir). */
+#include <config.h>
+#else
+#include "config.h"
+#endif
+#endif
+
+#ifndef __STDC__
+/* This is a separate conditional since some stdc systems
+ reject `defined (const)'. */
+#ifndef const
+#define const
+#endif
+#endif
+
+#include <stdio.h>
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+ actually compiling the library itself. This code is part of the GNU C
+ Library, but also included in many other GNU distributions. Compiling
+ and linking in this code is a waste when using the GNU C library
+ (especially if it is a shared library). Rather than having every GNU
+ program understand `configure --with-gnu-libc' and omit the object files,
+ it is simpler to just do this in the source for each such file. */
+/* Many versions of the Linux C library include older, broken versions
+ of these routines, which will break the linker's command-line
+ parsing. */
+
+#if defined (_LIBC) || !defined (__GNU_LIBRARY__) || defined (__linux__)
+
+
+/* This needs to come after some library #include
+ to get __GNU_LIBRARY__ defined. */
+#ifdef __GNU_LIBRARY__
+/* Don't include stdlib.h for non-GNU C libraries because some of them
+ contain conflicting prototypes for getopt. */
+#include <stdlib.h>
+#endif /* GNU C library. */
+
+/* This version of `getopt' appears to the caller like standard Unix `getopt'
+ but it behaves differently for the user, since it allows the user
+ to intersperse the options with the other arguments.
+
+ As `getopt' works, it permutes the elements of ARGV so that,
+ when it is done, all the options precede everything else. Thus
+ all application programs are extended to handle flexible argument order.
+
+ Setting the environment variable POSIXLY_CORRECT disables permutation.
+ Then the behavior is completely standard.
+
+ GNU application programs can use a third alternative mode in which
+ they can distinguish the relative order of options and other arguments. */
+
+#include "getopt.h"
+
+/* For communication from `getopt' to the caller.
+ When `getopt' finds an option that takes an argument,
+ the argument value is returned here.
+ Also, when `ordering' is RETURN_IN_ORDER,
+ each non-option ARGV-element is returned here. */
+
+char *optarg = NULL;
+
+/* Index in ARGV of the next element to be scanned.
+ This is used for communication to and from the caller
+ and for communication between successive calls to `getopt'.
+
+ On entry to `getopt', zero means this is the first call; initialize.
+
+ When `getopt' returns EOF, this is the index of the first of the
+ non-option elements that the caller should itself scan.
+
+ Otherwise, `optind' communicates from one call to the next
+ how much of ARGV has been scanned so far. */
+
+/* XXX 1003.2 says this must be 1 before any call. */
+int optind = 0;
+
+/* The next char to be scanned in the option-element
+ in which the last option character we returned was found.
+ This allows us to pick up the scan where we left off.
+
+ If this is zero, or a null string, it means resume the scan
+ by advancing to the next ARGV-element. */
+
+static char *nextchar;
+
+/* Callers store zero here to inhibit the error message
+ for unrecognized options. */
+
+int opterr = 1;
+
+/* Set to an option character which was unrecognized.
+ This must be initialized on some systems to avoid linking in the
+ system's own getopt implementation. */
+
+int optopt = '?';
+
+/* Describe how to deal with options that follow non-option ARGV-elements.
+
+ If the caller did not specify anything,
+ the default is REQUIRE_ORDER if the environment variable
+ POSIXLY_CORRECT is defined, PERMUTE otherwise.
+
+ REQUIRE_ORDER means don't recognize them as options;
+ stop option processing when the first non-option is seen.
+ This is what Unix does.
+ This mode of operation is selected by either setting the environment
+ variable POSIXLY_CORRECT, or using `+' as the first character
+ of the list of option characters.
+
+ PERMUTE is the default. We permute the contents of ARGV as we scan,
+ so that eventually all the non-options are at the end. This allows options
+ to be given in any order, even with programs that were not written to
+ expect this.
+
+ RETURN_IN_ORDER is an option available to programs that were written
+ to expect options and other ARGV-elements in any order and that care about
+ the ordering of the two. We describe each non-option ARGV-element
+ as if it were the argument of an option with character code 1.
+ Using `-' as the first character of the list of option characters
+ selects this mode of operation.
+
+ The special argument `--' forces an end of option-scanning regardless
+ of the value of `ordering'. In the case of RETURN_IN_ORDER, only
+ `--' can cause `getopt' to return EOF with `optind' != ARGC. */
+
+static enum
+{
+ REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER
+} ordering;
+
+#ifdef __GNU_LIBRARY__
+/* We want to avoid inclusion of string.h with non-GNU libraries
+ because there are many ways it can cause trouble.
+ On some systems, it contains special magic macros that don't work
+ in GCC. */
+#include <string.h>
+#define my_index strchr
+#else
+
+/* Avoid depending on library functions or files
+ whose names are inconsistent. */
+
+char *getenv ();
+
+static char *
+my_index (str, chr)
+ const char *str;
+ int chr;
+{
+ while (*str)
+ {
+ if (*str == chr)
+ return (char *) str;
+ str++;
+ }
+ return 0;
+}
+
+/* If using GCC, we can safely declare strlen this way.
+ If not using GCC, it is ok not to declare it. */
+#ifdef __GNUC__
+/* Note that Motorola Delta 68k R3V7 comes with GCC but not stddef.h.
+ That was relevant to code that was here before. */
+#ifndef __STDC__
+/* gcc with -traditional declares the built-in strlen to return int,
+ and has done so at least since version 2.4.5. -- rms. */
+extern int strlen (const char *);
+#endif /* not __STDC__ */
+#endif /* __GNUC__ */
+
+#endif /* not __GNU_LIBRARY__ */
+
+/* Handle permutation of arguments. */
+
+/* Describe the part of ARGV that contains non-options that have
+ been skipped. `first_nonopt' is the index in ARGV of the first of them;
+ `last_nonopt' is the index after the last of them. */
+
+static int first_nonopt;
+static int last_nonopt;
+
+/* Exchange two adjacent subsequences of ARGV.
+ One subsequence is elements [first_nonopt,last_nonopt)
+ which contains all the non-options that have been skipped so far.
+ The other is elements [last_nonopt,optind), which contains all
+ the options processed since those non-options were skipped.
+
+ `first_nonopt' and `last_nonopt' are relocated so that they describe
+ the new indices of the non-options in ARGV after they are moved. */
+
+static void
+exchange (argv)
+ char **argv;
+{
+ int bottom = first_nonopt;
+ int middle = last_nonopt;
+ int top = optind;
+ char *tem;
+
+ /* Exchange the shorter segment with the far end of the longer segment.
+ That puts the shorter segment into the right place.
+ It leaves the longer segment in the right place overall,
+ but it consists of two parts that need to be swapped next. */
+
+ while (top > middle && middle > bottom)
+ {
+ if (top - middle > middle - bottom)
+ {
+ /* Bottom segment is the short one. */
+ int len = middle - bottom;
+ register int i;
+
+ /* Swap it with the top part of the top segment. */
+ for (i = 0; i < len; i++)
+ {
+ tem = argv[bottom + i];
+ argv[bottom + i] = argv[top - (middle - bottom) + i];
+ argv[top - (middle - bottom) + i] = tem;
+ }
+ /* Exclude the moved bottom segment from further swapping. */
+ top -= len;
+ }
+ else
+ {
+ /* Top segment is the short one. */
+ int len = top - middle;
+ register int i;
+
+ /* Swap it with the bottom part of the bottom segment. */
+ for (i = 0; i < len; i++)
+ {
+ tem = argv[bottom + i];
+ argv[bottom + i] = argv[middle + i];
+ argv[middle + i] = tem;
+ }
+ /* Exclude the moved top segment from further swapping. */
+ bottom += len;
+ }
+ }
+
+ /* Update records for the slots the non-options now occupy. */
+
+ first_nonopt += (optind - last_nonopt);
+ last_nonopt = optind;
+}
+
+/* Initialize the internal data when the first call is made. */
+
+static const char *
+_getopt_initialize (optstring)
+ const char *optstring;
+{
+ /* Start processing options with ARGV-element 1 (since ARGV-element 0
+ is the program name); the sequence of previously skipped
+ non-option ARGV-elements is empty. */
+
+ first_nonopt = last_nonopt = optind = 1;
+
+ nextchar = NULL;
+
+ /* Determine how to handle the ordering of options and nonoptions. */
+
+ if (optstring[0] == '-')
+ {
+ ordering = RETURN_IN_ORDER;
+ ++optstring;
+ }
+ else if (optstring[0] == '+')
+ {
+ ordering = REQUIRE_ORDER;
+ ++optstring;
+ }
+ else if (getenv ("POSIXLY_CORRECT") != NULL)
+ ordering = REQUIRE_ORDER;
+ else
+ ordering = PERMUTE;
+
+ return optstring;
+}
+
+/* Scan elements of ARGV (whose length is ARGC) for option characters
+ given in OPTSTRING.
+
+ If an element of ARGV starts with '-', and is not exactly "-" or "--",
+ then it is an option element. The characters of this element
+ (aside from the initial '-') are option characters. If `getopt'
+ is called repeatedly, it returns successively each of the option characters
+ from each of the option elements.
+
+ If `getopt' finds another option character, it returns that character,
+ updating `optind' and `nextchar' so that the next call to `getopt' can
+ resume the scan with the following option character or ARGV-element.
+
+ If there are no more option characters, `getopt' returns `EOF'.
+ Then `optind' is the index in ARGV of the first ARGV-element
+ that is not an option. (The ARGV-elements have been permuted
+ so that those that are not options now come last.)
+
+ OPTSTRING is a string containing the legitimate option characters.
+ If an option character is seen that is not listed in OPTSTRING,
+ return '?' after printing an error message. If you set `opterr' to
+ zero, the error message is suppressed but we still return '?'.
+
+ If a char in OPTSTRING is followed by a colon, that means it wants an arg,
+ so the following text in the same ARGV-element, or the text of the following
+ ARGV-element, is returned in `optarg'. Two colons mean an option that
+ wants an optional arg; if there is text in the current ARGV-element,
+ it is returned in `optarg', otherwise `optarg' is set to zero.
+
+ If OPTSTRING starts with `-' or `+', it requests different methods of
+ handling the non-option ARGV-elements.
+ See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above.
+
+ Long-named options begin with `--' instead of `-'.
+ Their names may be abbreviated as long as the abbreviation is unique
+ or is an exact match for some defined option. If they have an
+ argument, it follows the option name in the same ARGV-element, separated
+ from the option name by a `=', or else the in next ARGV-element.
+ When `getopt' finds a long-named option, it returns 0 if that option's
+ `flag' field is nonzero, the value of the option's `val' field
+ if the `flag' field is zero.
+
+ The elements of ARGV aren't really const, because we permute them.
+ But we pretend they're const in the prototype to be compatible
+ with other systems.
+
+ LONGOPTS is a vector of `struct option' terminated by an
+ element containing a name which is zero.
+
+ LONGIND returns the index in LONGOPT of the long-named option found.
+ It is only valid when a long-named option has been found by the most
+ recent call.
+
+ If LONG_ONLY is nonzero, '-' as well as '--' can introduce
+ long-named options. */
+
+int
+_getopt_internal (argc, argv, optstring, longopts, longind, long_only)
+ int argc;
+ char *const *argv;
+ const char *optstring;
+ const struct option *longopts;
+ int *longind;
+ int long_only;
+{
+ optarg = NULL;
+
+ if (optind == 0)
+ optstring = _getopt_initialize (optstring);
+
+ if (argc == 0)
+ return EOF;
+
+ if (nextchar == NULL || *nextchar == '\0')
+ {
+ /* Advance to the next ARGV-element. */
+
+ if (ordering == PERMUTE)
+ {
+ /* If we have just processed some options following some non-options,
+ exchange them so that the options come first. */
+
+ if (first_nonopt != last_nonopt && last_nonopt != optind)
+ exchange ((char **) argv);
+ else if (last_nonopt != optind)
+ first_nonopt = optind;
+
+ /* Skip any additional non-options
+ and extend the range of non-options previously skipped. */
+
+ while (optind < argc
+ && (argv[optind][0] != '-' || argv[optind][1] == '\0'))
+ optind++;
+ last_nonopt = optind;
+ }
+
+ /* The special ARGV-element `--' means premature end of options.
+ Skip it like a null option,
+ then exchange with previous non-options as if it were an option,
+ then skip everything else like a non-option. */
+
+ if (optind != argc && !strcmp (argv[optind], "--"))
+ {
+ optind++;
+
+ if (first_nonopt != last_nonopt && last_nonopt != optind)
+ exchange ((char **) argv);
+ else if (first_nonopt == last_nonopt)
+ first_nonopt = optind;
+ last_nonopt = argc;
+
+ optind = argc;
+ }
+
+ /* If we have done all the ARGV-elements, stop the scan
+ and back over any non-options that we skipped and permuted. */
+
+ if (optind == argc)
+ {
+ /* Set the next-arg-index to point at the non-options
+ that we previously skipped, so the caller will digest them. */
+ if (first_nonopt != last_nonopt)
+ optind = first_nonopt;
+ return EOF;
+ }
+
+ /* If we have come to a non-option and did not permute it,
+ either stop the scan or describe it to the caller and pass it by. */
+
+ if ((argv[optind][0] != '-' || argv[optind][1] == '\0'))
+ {
+ if (ordering == REQUIRE_ORDER)
+ return EOF;
+ optarg = argv[optind++];
+ return 1;
+ }
+
+ /* We have found another option-ARGV-element.
+ Skip the initial punctuation. */
+
+ nextchar = (argv[optind] + 1
+ + (longopts != NULL && argv[optind][1] == '-'));
+ }
+
+ /* Decode the current option-ARGV-element. */
+
+ /* Check whether the ARGV-element is a long option.
+
+ If long_only and the ARGV-element has the form "-f", where f is
+ a valid short option, don't consider it an abbreviated form of
+ a long option that starts with f. Otherwise there would be no
+ way to give the -f short option.
+
+ On the other hand, if there's a long option "fubar" and
+ the ARGV-element is "-fu", do consider that an abbreviation of
+ the long option, just like "--fu", and not "-f" with arg "u".
+
+ This distinction seems to be the most useful approach. */
+
+ if (longopts != NULL
+ && (argv[optind][1] == '-'
+ || (long_only && (argv[optind][2] || !my_index (optstring, argv[optind][1])))))
+ {
+ char *nameend;
+ const struct option *p;
+ const struct option *pfound = NULL;
+ int exact = 0;
+ int ambig = 0;
+ int indfound;
+ int option_index;
+
+ for (nameend = nextchar; *nameend && *nameend != '='; nameend++)
+ /* Do nothing. */ ;
+
+ /* Test all long options for either exact match
+ or abbreviated matches. */
+ for (p = longopts, option_index = 0; p->name; p++, option_index++)
+ if (!strncmp (p->name, nextchar, nameend - nextchar))
+ {
+ if (nameend - nextchar == strlen (p->name))
+ {
+ /* Exact match found. */
+ pfound = p;
+ indfound = option_index;
+ exact = 1;
+ break;
+ }
+ else if (pfound == NULL)
+ {
+ /* First nonexact match found. */
+ pfound = p;
+ indfound = option_index;
+ }
+ else
+ /* Second or later nonexact match found. */
+ ambig = 1;
+ }
+
+ if (ambig && !exact)
+ {
+ if (opterr)
+ fprintf (stderr, "%s: option `%s' is ambiguous\n",
+ argv[0], argv[optind]);
+ nextchar += strlen (nextchar);
+ optind++;
+ return '?';
+ }
+
+ if (pfound != NULL)
+ {
+ option_index = indfound;
+ optind++;
+ if (*nameend)
+ {
+ /* Don't test has_arg with >, because some C compilers don't
+ allow it to be used on enums. */
+ if (pfound->has_arg)
+ optarg = nameend + 1;
+ else
+ {
+ if (opterr)
+ {
+ if (argv[optind - 1][1] == '-')
+ /* --option */
+ fprintf (stderr,
+ "%s: option `--%s' doesn't allow an argument\n",
+ argv[0], pfound->name);
+ else
+ /* +option or -option */
+ fprintf (stderr,
+ "%s: option `%c%s' doesn't allow an argument\n",
+ argv[0], argv[optind - 1][0], pfound->name);
+ }
+ nextchar += strlen (nextchar);
+ return '?';
+ }
+ }
+ else if (pfound->has_arg == 1)
+ {
+ if (optind < argc)
+ optarg = argv[optind++];
+ else
+ {
+ if (opterr)
+ fprintf (stderr, "%s: option `%s' requires an argument\n",
+ argv[0], argv[optind - 1]);
+ nextchar += strlen (nextchar);
+ return optstring[0] == ':' ? ':' : '?';
+ }
+ }
+ nextchar += strlen (nextchar);
+ if (longind != NULL)
+ *longind = option_index;
+ if (pfound->flag)
+ {
+ *(pfound->flag) = pfound->val;
+ return 0;
+ }
+ return pfound->val;
+ }
+
+ /* Can't find it as a long option. If this is not getopt_long_only,
+ or the option starts with '--' or is not a valid short
+ option, then it's an error.
+ Otherwise interpret it as a short option. */
+ if (!long_only || argv[optind][1] == '-'
+ || my_index (optstring, *nextchar) == NULL)
+ {
+ if (opterr)
+ {
+ if (argv[optind][1] == '-')
+ /* --option */
+ fprintf (stderr, "%s: unrecognized option `--%s'\n",
+ argv[0], nextchar);
+ else
+ /* +option or -option */
+ fprintf (stderr, "%s: unrecognized option `%c%s'\n",
+ argv[0], argv[optind][0], nextchar);
+ }
+ nextchar = (char *) "";
+ optind++;
+ return '?';
+ }
+ }
+
+ /* Look at and handle the next short option-character. */
+
+ {
+ char c = *nextchar++;
+ char *temp = my_index (optstring, c);
+
+ /* Increment `optind' when we start to process its last character. */
+ if (*nextchar == '\0')
+ ++optind;
+
+ if (temp == NULL || c == ':')
+ {
+ if (opterr)
+ {
+ /* 1003.2 specifies the format of this message. */
+ fprintf (stderr, "%s: illegal option -- %c\n", argv[0], c);
+ }
+ optopt = c;
+ return '?';
+ }
+ if (temp[1] == ':')
+ {
+ if (temp[2] == ':')
+ {
+ /* This is an option that accepts an argument optionally. */
+ if (*nextchar != '\0')
+ {
+ optarg = nextchar;
+ optind++;
+ }
+ else
+ optarg = NULL;
+ nextchar = NULL;
+ }
+ else
+ {
+ /* This is an option that requires an argument. */
+ if (*nextchar != '\0')
+ {
+ optarg = nextchar;
+ /* If we end this ARGV-element by taking the rest as an arg,
+ we must advance to the next element now. */
+ optind++;
+ }
+ else if (optind == argc)
+ {
+ if (opterr)
+ {
+ /* 1003.2 specifies the format of this message. */
+ fprintf (stderr, "%s: option requires an argument -- %c\n",
+ argv[0], c);
+ }
+ optopt = c;
+ if (optstring[0] == ':')
+ c = ':';
+ else
+ c = '?';
+ }
+ else
+ /* We already incremented `optind' once;
+ increment it again when taking next ARGV-elt as argument. */
+ optarg = argv[optind++];
+ nextchar = NULL;
+ }
+ }
+ return c;
+ }
+}
+
+int
+getopt (argc, argv, optstring)
+ int argc;
+ char *const *argv;
+ const char *optstring;
+{
+ return _getopt_internal (argc, argv, optstring,
+ (const struct option *) 0,
+ (int *) 0,
+ 0);
+}
+
+#endif /* _LIBC or not __GNU_LIBRARY__. */
+
+#ifdef TEST
+
+/* Compile with -DTEST to make an executable for use in testing
+ the above definition of `getopt'. */
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ int c;
+ int digit_optind = 0;
+
+ while (1)
+ {
+ int this_option_optind = optind ? optind : 1;
+
+ c = getopt (argc, argv, "abc:d:0123456789");
+ if (c == EOF)
+ break;
+
+ switch (c)
+ {
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ if (digit_optind != 0 && digit_optind != this_option_optind)
+ printf ("digits occur in two different argv-elements.\n");
+ digit_optind = this_option_optind;
+ printf ("option %c\n", c);
+ break;
+
+ case 'a':
+ printf ("option a\n");
+ break;
+
+ case 'b':
+ printf ("option b\n");
+ break;
+
+ case 'c':
+ printf ("option c with value `%s'\n", optarg);
+ break;
+
+ case '?':
+ break;
+
+ default:
+ printf ("?? getopt returned character code 0%o ??\n", c);
+ }
+ }
+
+ if (optind < argc)
+ {
+ printf ("non-option ARGV-elements: ");
+ while (optind < argc)
+ printf ("%s ", argv[optind++]);
+ printf ("\n");
+ }
+
+ exit (0);
+}
+
+#endif /* TEST */
diff --git a/libiberty/getopt1.c b/libiberty/getopt1.c
new file mode 100644
index 00000000000..c3400e5b643
--- /dev/null
+++ b/libiberty/getopt1.c
@@ -0,0 +1,190 @@
+/* getopt_long and getopt_long_only entry points for GNU getopt.
+ Copyright (C) 1987, 88, 89, 90, 91, 92, 1993
+ Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 program; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+#if defined (emacs) || defined (CONFIG_BROKETS)
+/* We use <config.h> instead of "config.h" so that a compilation
+ using -I. -I$srcdir will use ./config.h rather than $srcdir/config.h
+ (which it would do because it found this file in $srcdir). */
+#include <config.h>
+#else
+#include "config.h"
+#endif
+#endif
+
+#include "getopt.h"
+
+#ifndef __STDC__
+/* This is a separate conditional since some stdc systems
+ reject `defined (const)'. */
+#ifndef const
+#define const
+#endif
+#endif
+
+#include <stdio.h>
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+ actually compiling the library itself. This code is part of the GNU C
+ Library, but also included in many other GNU distributions. Compiling
+ and linking in this code is a waste when using the GNU C library
+ (especially if it is a shared library). Rather than having every GNU
+ program understand `configure --with-gnu-libc' and omit the object files,
+ it is simpler to just do this in the source for each such file. */
+/* Many versions of the Linux C library include older, broken versions
+ of these routines, which will break the linker's command-line
+ parsing. */
+
+#if defined (_LIBC) || !defined (__GNU_LIBRARY__) || defined (__linux__)
+
+
+/* This needs to come after some library #include
+ to get __GNU_LIBRARY__ defined. */
+#ifdef __GNU_LIBRARY__
+#include <stdlib.h>
+#else
+char *getenv ();
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+int
+getopt_long (argc, argv, options, long_options, opt_index)
+ int argc;
+ char *const *argv;
+ const char *options;
+ const struct option *long_options;
+ int *opt_index;
+{
+ return _getopt_internal (argc, argv, options, long_options, opt_index, 0);
+}
+
+/* Like getopt_long, but '-' as well as '--' can indicate a long option.
+ If an option that starts with '-' (not '--') doesn't match a long option,
+ but does match a short option, it is parsed as a short option
+ instead. */
+
+int
+getopt_long_only (argc, argv, options, long_options, opt_index)
+ int argc;
+ char *const *argv;
+ const char *options;
+ const struct option *long_options;
+ int *opt_index;
+{
+ return _getopt_internal (argc, argv, options, long_options, opt_index, 1);
+}
+
+
+#endif /* _LIBC or not __GNU_LIBRARY__. */
+
+#ifdef TEST
+
+#include <stdio.h>
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ int c;
+ int digit_optind = 0;
+
+ while (1)
+ {
+ int this_option_optind = optind ? optind : 1;
+ int option_index = 0;
+ static struct option long_options[] =
+ {
+ {"add", 1, 0, 0},
+ {"append", 0, 0, 0},
+ {"delete", 1, 0, 0},
+ {"verbose", 0, 0, 0},
+ {"create", 0, 0, 0},
+ {"file", 1, 0, 0},
+ {0, 0, 0, 0}
+ };
+
+ c = getopt_long (argc, argv, "abc:d:0123456789",
+ long_options, &option_index);
+ if (c == EOF)
+ break;
+
+ switch (c)
+ {
+ case 0:
+ printf ("option %s", long_options[option_index].name);
+ if (optarg)
+ printf (" with arg %s", optarg);
+ printf ("\n");
+ break;
+
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ if (digit_optind != 0 && digit_optind != this_option_optind)
+ printf ("digits occur in two different argv-elements.\n");
+ digit_optind = this_option_optind;
+ printf ("option %c\n", c);
+ break;
+
+ case 'a':
+ printf ("option a\n");
+ break;
+
+ case 'b':
+ printf ("option b\n");
+ break;
+
+ case 'c':
+ printf ("option c with value `%s'\n", optarg);
+ break;
+
+ case 'd':
+ printf ("option d with value `%s'\n", optarg);
+ break;
+
+ case '?':
+ break;
+
+ default:
+ printf ("?? getopt returned character code 0%o ??\n", c);
+ }
+ }
+
+ if (optind < argc)
+ {
+ printf ("non-option ARGV-elements: ");
+ while (optind < argc)
+ printf ("%s ", argv[optind++]);
+ printf ("\n");
+ }
+
+ exit (0);
+}
+
+#endif /* TEST */
diff --git a/libiberty/getpagesize.c b/libiberty/getpagesize.c
new file mode 100644
index 00000000000..e9784b8520b
--- /dev/null
+++ b/libiberty/getpagesize.c
@@ -0,0 +1,89 @@
+/* Emulation of getpagesize() for systems that need it. */
+
+/*
+
+NAME
+
+ getpagesize -- return the number of bytes in page of memory
+
+SYNOPSIS
+
+ int getpagesize (void)
+
+DESCRIPTION
+
+ Returns the number of bytes in a page of memory. This is the
+ granularity of many of the system memory management routines.
+ No guarantee is made as to whether or not it is the same as the
+ basic memory management hardware page size.
+
+BUGS
+
+ Is intended as a reasonable replacement for systems where this
+ is not provided as a system call. The value of 4096 may or may
+ not be correct for the systems where it is returned as the default
+ value.
+
+*/
+
+#ifndef VMS
+
+#include <sys/types.h>
+#ifndef NO_SYS_PARAM_H
+#include <sys/param.h>
+#endif
+
+#ifdef HAVE_SYSCONF
+#include <unistd.h>
+#define GNU_OUR_PAGESIZE sysconf(_SC_PAGESIZE)
+#else
+#ifdef PAGESIZE
+#define GNU_OUR_PAGESIZE PAGESIZE
+#else /* no PAGESIZE */
+#ifdef EXEC_PAGESIZE
+#define GNU_OUR_PAGESIZE EXEC_PAGESIZE
+#else /* no EXEC_PAGESIZE */
+#ifdef NBPG
+#define GNU_OUR_PAGESIZE (NBPG * CLSIZE)
+#ifndef CLSIZE
+#define CLSIZE 1
+#endif /* CLSIZE */
+#else /* no NBPG */
+#ifdef NBPC
+#define GNU_OUR_PAGESIZE NBPC
+#else /* no NBPC */
+#define GNU_OUR_PAGESIZE 4096 /* Just punt and use reasonable value */
+#endif /* NBPC */
+#endif /* NBPG */
+#endif /* EXEC_PAGESIZE */
+#endif /* PAGESIZE */
+#endif /* HAVE_SYSCONF */
+
+int
+getpagesize ()
+{
+ return (GNU_OUR_PAGESIZE);
+}
+
+#else /* VMS */
+
+#if 0 /* older distributions of gcc-vms are missing <syidef.h> */
+#include <syidef.h>
+#endif
+#ifndef SYI$_PAGE_SIZE /* VMS V5.4 and earlier didn't have this yet */
+#define SYI$_PAGE_SIZE 4452
+#endif
+extern unsigned long lib$getsyi(const unsigned short *,...);
+
+int getpagesize ()
+{
+ long pagsiz = 0L;
+ unsigned short itmcod = SYI$_PAGE_SIZE;
+
+ (void) lib$getsyi (&itmcod, (void *) &pagsiz);
+ if (pagsiz == 0L)
+ pagsiz = 512L; /* VAX default */
+ return (int) pagsiz;
+}
+
+#endif /* VMS */
diff --git a/libiberty/getruntime.c b/libiberty/getruntime.c
new file mode 100644
index 00000000000..1be3b4c4a2a
--- /dev/null
+++ b/libiberty/getruntime.c
@@ -0,0 +1,82 @@
+/* Return time used so far, in microseconds.
+ Copyright (C) 1994 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 "ansidecl.h"
+#include "libiberty.h"
+
+/* There are several ways to get elapsed execution time; unfortunately no
+ single way is available for all host systems, nor are there reliable
+ ways to find out which way is correct for a given host. */
+
+#include <time.h>
+
+/* These should go away when libiberty uses autoconf. */
+
+#if defined(__sun__) && !defined(__svr4__)
+#define HAVE_GETRUSAGE
+#endif
+
+#ifdef HAVE_SYSCONF
+#define HAVE_TIMES
+#endif
+
+#ifdef HAVE_GETRUSAGE
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif
+
+#ifdef HAVE_TIMES
+#ifndef NO_SYS_PARAM_H
+#include <sys/param.h>
+#endif
+#include <sys/times.h>
+#endif
+
+/* This is a fallback; if wrong, it will likely make obviously wrong
+ results. */
+
+#ifndef CLOCKS_PER_SEC
+#define CLOCKS_PER_SEC 1
+#endif
+
+long
+get_run_time ()
+{
+#ifdef HAVE_GETRUSAGE
+ struct rusage rusage;
+
+ getrusage (0, &rusage);
+ return (rusage.ru_utime.tv_sec * 1000000 + rusage.ru_utime.tv_usec
+ + rusage.ru_stime.tv_sec * 1000000 + rusage.ru_stime.tv_usec);
+#else /* ! HAVE_GETRUSAGE */
+#ifdef HAVE_TIMES
+ struct tms tms;
+
+ times (&tms);
+ return (tms.tms_utime + tms.tms_stime) * (1000000 / HZ);
+#else /* ! HAVE_TIMES */
+ /* Fall back on clock and hope it's correctly implemented. */
+ const long clocks_per_sec = CLOCKS_PER_SEC;
+ if (clocks_per_sec <= 1000000)
+ return clock () * (1000000 / clocks_per_sec);
+ else
+ return clock () / clocks_per_sec;
+#endif /* HAVE_TIMES */
+#endif /* HAVE_GETRUSAGE */
+}
diff --git a/libiberty/hex.c b/libiberty/hex.c
new file mode 100644
index 00000000000..3a2eef03d4c
--- /dev/null
+++ b/libiberty/hex.c
@@ -0,0 +1,33 @@
+/* Hex character manipulation support.
+ Copyright (C) 1995 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 "libiberty.h"
+
+char _hex_value[_hex_array_size];
+
+void hex_init ()
+{
+ int i;
+ for (i = 0; i < _hex_array_size; i++)
+ _hex_value[i] = _hex_bad;
+ for (i = 0; i < 10; i++)
+ _hex_value['0' + i] = i;
+ for (i = 0; i < 6; i++)
+ _hex_value['a' + i] = _hex_value['A' + i] = 10 + i;
+}
diff --git a/libiberty/index.c b/libiberty/index.c
new file mode 100644
index 00000000000..e5a00f54d94
--- /dev/null
+++ b/libiberty/index.c
@@ -0,0 +1,11 @@
+/* Stub implementation of (obsolete) index(). */
+
+extern char * strchr();
+
+char *
+index (s, c)
+ char *s;
+ int c;
+{
+ return strchr (s, c);
+}
diff --git a/libiberty/insque.c b/libiberty/insque.c
new file mode 100644
index 00000000000..775019f8fff
--- /dev/null
+++ b/libiberty/insque.c
@@ -0,0 +1,50 @@
+/* insque(3C) routines
+ This file is in the public domain. */
+
+/*
+NAME
+ insque, remque -- insert, remove an element from a queue
+
+SYNOPSIS
+ struct qelem {
+ struct qelem *q_forw;
+ struct qelem *q_back;
+ char q_data[];
+ };
+
+ void insque (struct qelem *elem, struct qelem *pred)
+
+ void remque (struct qelem *elem)
+
+DESCRIPTION
+ Routines to manipulate queues built from doubly linked lists.
+ The insque routine inserts ELEM in the queue immediately after
+ PRED. The remque routine removes ELEM from its containing queue.
+*/
+
+
+struct qelem {
+ struct qelem *q_forw;
+ struct qelem *q_back;
+};
+
+
+void
+insque (elem, pred)
+ struct qelem *elem;
+ struct qelem *pred;
+{
+ elem -> q_forw = pred -> q_forw;
+ pred -> q_forw -> q_back = elem;
+ elem -> q_back = pred;
+ pred -> q_forw = elem;
+}
+
+
+void
+remque (elem)
+ struct qelem *elem;
+{
+ elem -> q_forw -> q_back = elem -> q_back;
+ elem -> q_back -> q_forw = elem -> q_forw;
+}
diff --git a/libiberty/makefile.dos b/libiberty/makefile.dos
new file mode 100644
index 00000000000..7eba62c3395
--- /dev/null
+++ b/libiberty/makefile.dos
@@ -0,0 +1,29 @@
+CFLAGS=-O2
+
+OBJS = \
+ argv.o \
+ basename.o \
+ concat.o \
+ cplus-dem.o \
+ fdmatch.o \
+ floatformat.o \
+ getopt.o \
+ getopt1.o \
+ getruntime.o \
+ hex.o \
+ msdos.o \
+ obstack.o \
+ spaces.o \
+ strerror.o \
+ strsignal.o \
+ xatexit.o \
+ xexit.o \
+ xmalloc.o \
+ $E
+
+.c.o:
+ gcc -I../include $(CFLAGS) -c $<
+
+libiberty.a : $(OBJS)
+ -rm libiberty.a
+ ar rvs libiberty.a $(OBJS)
diff --git a/libiberty/makefile.vms b/libiberty/makefile.vms
new file mode 100644
index 00000000000..6f49ee1b1ea
--- /dev/null
+++ b/libiberty/makefile.vms
@@ -0,0 +1,37 @@
+#
+# Makefile for libiberty under openVMS/Alpha
+#
+# For use with gnu-make for vms
+#
+# Created by Klaus K"ampf, kkaempf@progis.de
+#
+#
+
+OBJS=bcopy.obj,bcmp.obj,getopt.obj,obstack.obj,xexit.obj,xmalloc.obj,hex.obj,\
+ getopt1.obj,cplus-dem.obj,strncasecmp.obj,strcasecmp.obj,strdup.obj,\
+ concat.obj,getruntime.obj,getpagesize.obj,alloca.obj,xstrerror.obj,\
+ xstrdup.obj,xatexit.obj,choose-temp.obj,fnmatch.obj,objalloc.obj
+
+ifeq ($(CC),gcc)
+CFLAGS=/include=([],[-.include])
+else
+# assume dec c
+CFLAGS=/noopt/debug/include=([],[-.include])/define=("const=")/warnings=disable=(missingreturn,implicitfunc)
+endif
+
+libiberty.olb: config.h alloca-conf.h $(OBJS)
+ purge
+ lib/create libiberty *.obj
+
+alloca-conf.h: alloca-norm.h
+ $(CP) $< $@
+
+config.h: config.h-vms
+ $(CP) $< $@
+
+clean:
+ $$ purge
+ $(RM) alloca-conf.h;
+ $(RM) config.h;
+ $(RM) *.obj;
+ $(RM) libiberty.olb;
diff --git a/libiberty/memchr.c b/libiberty/memchr.c
new file mode 100644
index 00000000000..93ef43d3f88
--- /dev/null
+++ b/libiberty/memchr.c
@@ -0,0 +1,60 @@
+/*
+FUNCTION
+ <<memchr>>---find character in memory
+
+INDEX
+ memchr
+
+ANSI_SYNOPSIS
+ #include <string.h>
+ void *memchr(const void *<[src]>, int <[c]>, size_t <[length]>);
+
+TRAD_SYNOPSIS
+ #include <string.h>
+ void *memchr(<[src]>, <[c]>, <[length]>)
+ void *<[src]>;
+ void *<[c]>;
+ size_t <[length]>;
+
+DESCRIPTION
+ This function searches memory starting at <<*<[src]>>> for the
+ character <[c]>. The search only ends with the first
+ occurrence of <[c]>, or after <[length]> characters; in
+ particular, <<NULL>> does not terminate the search.
+
+RETURNS
+ If the character <[c]> is found within <[length]> characters
+ of <<*<[src]>>>, a pointer to the character is returned. If
+ <[c]> is not found, then <<NULL>> is returned.
+
+PORTABILITY
+<<memchr>> requires no supporting OS subroutines.
+
+QUICKREF
+ memchr ansi pure
+
+*/
+
+#include <ansidecl.h>
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#endif
+
+PTR
+memchr (src_void, c, length)
+ register CONST PTR src_void;
+ int c;
+ size_t length;
+{
+ CONST unsigned char *src = (CONST unsigned char *)src_void;
+
+ while (--length >= 0)
+ {
+ if (*src == c)
+ return (PTR)src;
+ src++;
+ }
+ return NULL;
+}
diff --git a/libiberty/memcmp.c b/libiberty/memcmp.c
new file mode 100644
index 00000000000..127ae0c8019
--- /dev/null
+++ b/libiberty/memcmp.c
@@ -0,0 +1,38 @@
+/* memcmp -- compare two memory regions.
+ This function is in the public domain. */
+
+/*
+NAME
+ memcmp -- compare two memory regions
+
+SYNOPSIS
+ int memcmp (const void *from, const void *to, size_t count)
+
+DESCRIPTION
+ Compare two memory regions and return less than,
+ equal to, or greater than zero, according to lexicographical
+ ordering of the compared regions.
+*/
+
+#include <ansidecl.h>
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#endif
+
+int
+DEFUN(memcmp, (str1, str2, count),
+ const PTR str1 AND const PTR str2 AND size_t count)
+{
+ register unsigned char *s1 = (unsigned char*)str1;
+ register unsigned char *s2 = (unsigned char*)str2;
+
+ while (count-- > 0)
+ {
+ if (*s1++ != *s2++)
+ return s1[-1] < s2[-1] ? -1 : 1;
+ }
+ return 0;
+}
+
diff --git a/libiberty/memcpy.c b/libiberty/memcpy.c
new file mode 100644
index 00000000000..c28208a0f7e
--- /dev/null
+++ b/libiberty/memcpy.c
@@ -0,0 +1,28 @@
+/* memcpy (the standard C function)
+ This function is in the public domain. */
+
+/*
+NAME
+ memcpy -- copy memory regions of arbitary length
+
+SYNOPSIS
+ void* memcpy (void *out, const void *in, size_t n);
+
+DESCRIPTION
+ Copy LENGTH bytes from memory region pointed to by IN to memory
+ region pointed to by OUT.
+*/
+
+#include <ansidecl.h>
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#endif
+
+PTR
+DEFUN(memcpy, (out, in, length), PTR out AND CONST PTR in AND size_t length)
+{
+ bcopy(in, out, length);
+ return out;
+}
diff --git a/libiberty/memmove.c b/libiberty/memmove.c
new file mode 100644
index 00000000000..818fc249662
--- /dev/null
+++ b/libiberty/memmove.c
@@ -0,0 +1,18 @@
+/* Wrapper to implement ANSI C's memmove using BSD's bcopy. */
+/* This function is in the public domain. --Per Bothner. */
+#include <ansidecl.h>
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#endif
+
+PTR
+memmove (s1, s2, n)
+ PTR s1;
+ CONST PTR s2;
+ size_t n;
+{
+ bcopy (s2, s1, n);
+ return s1;
+}
diff --git a/libiberty/memset.c b/libiberty/memset.c
new file mode 100644
index 00000000000..5f54831e83c
--- /dev/null
+++ b/libiberty/memset.c
@@ -0,0 +1,19 @@
+/* memset
+ This implementation is in the public domain. */
+
+#include <ansidecl.h>
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#endif
+
+PTR
+DEFUN(memset, (dest, val, len),
+ PTR dest AND register int val AND register size_t len)
+{
+ register unsigned char *ptr = (unsigned char*)dest;
+ while (len-- > 0)
+ *ptr++ = val;
+ return dest;
+}
diff --git a/libiberty/mpw-config.in b/libiberty/mpw-config.in
new file mode 100644
index 00000000000..829d8e730d4
--- /dev/null
+++ b/libiberty/mpw-config.in
@@ -0,0 +1,9 @@
+# MPW configuration fragment for libiberty.
+
+forward-include "{srcdir}"alloca-norm.h alloca-conf.h
+
+Echo '/* config.h. Generated by mpw-configure. */' > "{o}"config.new
+
+MoveIfChange "{o}"config.new "{o}"config.h
+
+
diff --git a/libiberty/mpw-make.sed b/libiberty/mpw-make.sed
new file mode 100644
index 00000000000..6f2a5e77b2b
--- /dev/null
+++ b/libiberty/mpw-make.sed
@@ -0,0 +1,51 @@
+# Sed commands to finish translating libiberty's Unix makefile to MPW syntax.
+
+# Comment out a useless thing.
+/^\.always\./s/^/#/
+
+# Replace the auto-generated list with the list of what we know we need.
+s/`cat needed-list`/"{o}"alloca.c.o "{o}"bcopy.c.o "{o}"getpagesize.c.o "{o}"insque.c.o "{o}"mpw.c.o "{o}"strcasecmp.c.o "{o}"strdup.c.o "{o}"strncasecmp.c.o/
+
+# Paste in some desirable definitions.
+# The default rule here completely replaces the tricky stuff in the Unix
+# Makefile.in.
+/^###$/a\
+\
+HDEFINES = -d NEED_sys_siglist -d NEED_sys_errlist -d NEED_basename -d NEED_strcasecmp -d NEED_strncasecmp\
+INCLUDES = -i : -i {INCDIR}: -i {INCDIR}:mpw: -i ::extra-include: -i "{s}"\
+\
+.c.o \\Option-f .c\
+ {CC} @DASH_C_FLAG@ {DepDir}{Default}.c {LIBCFLAGS} {INCLUDES} {HDEFINES} @SEGMENT_FLAG({Default})@ -o {TargDir}{Default}.c.o\
+
+# Remove dependency on needed-list, which we don't use.
+/DO_ALSO =/s/needed-list//
+
+/INCDIR=/s/"{srcdir}"{MULTISRCTOP}::/"{topsrcdir}"/
+
+# Whack out the COMPILE.c trickiness.
+/^COMPILE.c /,/^$/d
+
+# Remove the multido trickiness from the "all" target.
+/^all \\Option-f/,/^$/c\
+all \\Option-f {TARGETLIB}\
+
+
+# Remove the RULE1/RULE2 crud.
+/if \[/,/fi/d
+/^RULE1 =/,/RULE2 =/d
+/RULE2/s/RULE2/TARGETLIB/
+
+# Don't want fdmatch ever.
+s/ "{o}"fdmatch.c.o//
+
+# Fix paths to generated files.
+/config.h/s/"{s}"config.h/"{o}"config.h/
+
+# Whack out config rebuild rules.
+/^"{o}"config.h \\Option-f/,/^$/d
+
+
+
+
+
+
diff --git a/libiberty/mpw.c b/libiberty/mpw.c
new file mode 100644
index 00000000000..4380da45203
--- /dev/null
+++ b/libiberty/mpw.c
@@ -0,0 +1,1010 @@
+/* MPW-Unix compatibility library.
+ Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 should only be compiled and linked under MPW. */
+
+#include "mpw.h"
+
+#include <stdlib.h>
+
+#ifndef USE_MW_HEADERS
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif
+
+#include <Types.h>
+#include <Files.h>
+
+#include <Timer.h>
+
+/* Initialize to 0 at first, then set to errno_max() later. */
+
+int sys_nerr = 0;
+
+/* Debug flag for pathname hacking. Set this to one and rebuild. */
+
+int DebugPI = -1;
+
+void
+mpwify_filename(char *unixname, char *macname)
+{
+ int i, j;
+
+ /* (should truncate 255 chars from end of name, not beginning) */
+ if (strlen (unixname) > 255)
+ {
+ fprintf (stderr, "Pathname \"%s\" is too long for Macs, truncating\n",
+ unixname);
+ }
+ j = 0;
+ /* If you're going to end up with one or more colons in the middle of a
+ a path after an all-Unix relative path is translated, you must add a
+ colon on the front, so that the first component is not thought to be
+ a disk name. */
+ if (unixname[0] != '/' && ! strchr (unixname, ':') && strchr (unixname, '/'))
+ {
+ macname[j++] = ':';
+ }
+ for (i = 0; unixname[i] != '\0' && i < 255; ++i)
+ {
+ if (i == 0 && unixname[i] == '/')
+ {
+ if (strncmp (unixname, "/tmp/", 5) == 0)
+ {
+ /* A temporary name, make a more Mac-flavored tmpname. */
+ /* A better choice would be {Boot}Trash:foo, but
+ that would require being able to identify the
+ boot disk's and trashcan's name. Another option
+ would be to have an env var, so user can point it
+ at a ramdisk. */
+ macname[j++] = ':';
+ macname[j++] = 't';
+ macname[j++] = 'm';
+ macname[j++] = 'p';
+ macname[j++] = '_';
+ i += 4;
+ }
+ else
+ {
+ /* Don't copy the leading slash. */
+ }
+ }
+ else if (unixname[i] == ':' && unixname[i+1] == '/')
+ {
+ macname[j++] = ':';
+ i += 1;
+ }
+ else if (unixname[i] == '.' && unixname[i+1] == '/')
+ {
+ macname[j++] = ':';
+ i += 1;
+ }
+ else if (unixname[i] == '.' && unixname[i+1] == '.' && unixname[i+2] == '/')
+ {
+ macname[j++] = ':';
+ macname[j++] = ':';
+ i += 2;
+ }
+ else if (unixname[i] == '/')
+ {
+ macname[j++] = ':';
+ }
+ else
+ {
+ macname[j++] = unixname[i];
+ }
+ }
+ macname[j] = '\0';
+ /* Allow for getting the debug flag from an env var; quite useful. */
+ if (DebugPI < 0)
+ DebugPI = (*(getenv ("DEBUG_PATHNAMES")) == '1' ? 1 : 0);
+ if (DebugPI)
+ {
+ fprintf (stderr, "# Made \"%s\"\n", unixname);
+ fprintf (stderr, "# into \"%s\"\n", macname);
+ }
+}
+
+/* MPW-flavored basename finder. */
+
+char *
+mpw_basename (name)
+ char *name;
+{
+ char *base = name;
+
+ while (*name)
+ {
+ if (*name++ == ':')
+ {
+ base = name;
+ }
+ }
+ return base;
+}
+
+/* Mixed MPW/Unix basename finder. This can be led astray by
+ filenames with slashes in them and come up with a basename that
+ either corresponds to no file or (worse) to some other file, so
+ should only be tried if other methods of finding a file via a
+ basename have failed. */
+
+char *
+mpw_mixed_basename (name)
+ char *name;
+{
+ char *base = name;
+
+ while (*name)
+ {
+ if (*name == '/' || *name == ':')
+ {
+ base = name + 1;
+ }
+ ++name;
+ }
+ return base;
+}
+
+/* This function is fopen() modified to create files that are type TEXT
+ or 'BIN ', and always of type 'MPS '. */
+
+FILE *
+mpw_fopen (char *name, char *mode)
+{
+#undef fopen
+ int errnum;
+ FILE *fp;
+ char tmpname[256];
+
+ mpwify_filename (name, tmpname);
+ PROGRESS (1);
+ fp = fopen (tmpname, mode);
+ errnum = errno;
+
+ /* If writing, need to set type and creator usefully. */
+ if (strchr (mode, 'w'))
+ {
+ char *pname = (char *) malloc (strlen (tmpname) + 2);
+ OSErr e;
+ struct FInfo fi;
+
+ pname[0] = strlen (tmpname);
+ strcpy (pname+1, tmpname);
+
+ e = GetFInfo ((ConstStr255Param) pname, 0, &fi);
+ /* should do spiffier error handling */
+ if (e != 0)
+ fprintf(stderr, "GetFInfo returns %d\n", e);
+ if (strchr (mode, 'b'))
+ {
+ fi.fdType = (OSType) 'BIN ';
+ }
+ else
+ {
+ fi.fdType = (OSType) 'TEXT';
+ }
+ fi.fdCreator = (OSType) 'MPS ';
+ e = SetFInfo ((ConstStr255Param) pname, 0, &fi);
+ if (e != 0)
+ fprintf(stderr, "SetFInfo returns %d\n", e);
+ free (pname);
+ }
+ if (fp == NULL)
+ errno = errnum;
+ return fp;
+}
+
+/* This is a version of fseek() modified to fill the file with zeros
+ if seeking past the end of it. */
+
+#define ZEROBLKSIZE 4096
+
+char zeros[ZEROBLKSIZE];
+
+int
+mpw_fseek (FILE *fp, int offset, int whence)
+{
+#undef fseek
+ int cursize, numleft;
+
+ PROGRESS (1);
+ if (whence == SEEK_SET)
+ {
+ fseek (fp, 0, SEEK_END);
+ cursize = ftell (fp);
+ if (offset > cursize)
+ {
+ numleft = offset - cursize;
+ while (numleft > ZEROBLKSIZE)
+ {
+ /* This might fail, should check for that. */
+ PROGRESS (1);
+ fwrite (zeros, 1, ZEROBLKSIZE, fp);
+ numleft -= ZEROBLKSIZE;
+ }
+ PROGRESS (1);
+ fwrite (zeros, 1, numleft, fp);
+ fflush (fp);
+ }
+ }
+ return fseek (fp, offset, whence);
+}
+
+int
+mpw_fread (char *ptr, int size, int nitems, FILE *stream)
+{
+#undef fread
+ int rslt;
+
+ PROGRESS (1);
+ rslt = fread (ptr, size, nitems, stream);
+ PROGRESS (1);
+ return rslt;
+}
+
+int
+mpw_fwrite (char *ptr, int size, int nitems, FILE *stream)
+{
+#undef fwrite
+ int rslt;
+
+ PROGRESS (1);
+ rslt = fwrite (ptr, size, nitems, stream);
+ PROGRESS (1);
+ return rslt;
+}
+
+int
+link ()
+{
+ fprintf (stderr, "link not available!\n");
+ mpw_abort ();
+}
+
+int
+fork ()
+{
+ fprintf (stderr, "fork not available!\n");
+ mpw_abort ();
+}
+
+int
+vfork ()
+{
+ fprintf (stderr, "vfork not available!\n");
+ mpw_abort ();
+ return (-1);
+}
+
+int
+pipe (int *fd)
+{
+ fprintf (stderr, "pipe not available!\n");
+ mpw_abort ();
+ return (-1);
+}
+
+#ifndef USE_MW_HEADERS
+int
+execvp (char *file, char **argv)
+{
+ fprintf (stderr, "execvp not available!\n");
+ mpw_abort ();
+ return (-1);
+}
+
+int
+execv (char *path, char **argv)
+{
+ fprintf (stderr, "execv not available!\n");
+ mpw_abort ();
+ return (-1);
+}
+#endif
+
+int
+kill (int pid, int sig)
+{
+ fprintf (stderr, "kill not available!\n");
+ mpw_abort ();
+ return (-1);
+}
+
+int
+wait (int *status)
+{
+ *status = 0;
+ return 0;
+}
+
+#ifndef USE_MW_HEADERS
+int
+sleep (int seconds)
+{
+ unsigned long start_time, now;
+
+ time (&start_time);
+
+ while (1)
+ {
+ PROGRESS (1);
+ time (&now);
+ if (now > start_time + seconds)
+ return 0;
+ }
+}
+#endif
+
+void
+putenv (char *str)
+{
+ /* The GCC driver calls this to do things for collect2, but we
+ don't care about collect2. */
+}
+
+int
+chmod (char *path, int mode)
+{
+ /* Pretend it was all OK. */
+ return 0;
+}
+
+#ifndef USE_MW_HEADERS
+int
+getuid ()
+{
+ /* One value is as good as another... */
+ return 0;
+}
+
+int
+getgid ()
+{
+ /* One value is as good as another... */
+ return 0;
+}
+#endif
+
+/* Instead of coredumping, which is not a normal Mac facility, we
+ drop into Macsbug. If we then "g" from Macsbug, the program will
+ exit cleanly. */
+
+void
+mpw_abort ()
+{
+ /* Make sure no output still buffered up, then zap into MacsBug. */
+ fflush(stdout);
+ fflush(stderr);
+ printf("## Abort! ##\n");
+#ifdef MPW_SADE
+ SysError(8005);
+#else
+ Debugger();
+#endif
+ /* "g" in MacsBug will then cause a regular error exit. */
+ exit (1);
+}
+
+/* Imitation getrusage based on the ANSI clock() function. */
+
+int
+getrusage (int who, struct rusage *rusage)
+{
+ int clk = clock ();
+
+#if 0
+ rusage->ru_utime.tv_sec = clk / CLOCKS_PER_SEC;
+ rusage->ru_utime.tv_usec = ((clk * 1000) / CLOCKS_PER_SEC) * 1000;
+ rusage->ru_stime.tv_sec = 0;
+ rusage->ru_stime.tv_usec = 0;
+#endif
+}
+
+int
+sbrk ()
+{
+ return 0;
+}
+
+#ifndef USE_MW_HEADERS
+int
+isatty (int fd)
+{
+ return 0;
+}
+
+/* This is inherited from Timothy Murray's Posix library. */
+
+#include "utime.h"
+
+int
+utime (char *filename, struct utimbuf *times)
+{
+ CInfoPBRec cipbr;
+ HFileInfo *fpb = (HFileInfo *) &cipbr;
+ DirInfo *dpb = (DirInfo *) &cipbr;
+ unsigned char pname[256];
+ short err;
+
+ strcpy ((char *) pname, filename);
+ c2pstr (pname);
+
+ dpb->ioDrDirID = 0L;
+ fpb->ioNamePtr = pname;
+ fpb->ioVRefNum = 0;
+ fpb->ioFDirIndex = 0;
+ fpb->ioFVersNum = 0;
+ err = PBGetCatInfo (&cipbr, 0);
+ if (err != noErr) {
+ errno = ENOENT;
+ return -1;
+ }
+ dpb->ioDrDirID = 0L;
+ fpb->ioFlMdDat = times->modtime;
+ fpb->ioFlCrDat = times->actime;
+ err = PBSetCatInfo (&cipbr, 0);
+ if (err != noErr) {
+ errno = EACCES;
+ return -1;
+ }
+ return 0;
+}
+
+int
+mkdir (char *path, int mode)
+{
+ errno = ENOSYS;
+ return -1;
+}
+
+int
+rmdir ()
+{
+ errno = ENOSYS;
+ return -1;
+}
+#endif
+
+chown ()
+{
+ errno = ENOSYS;
+ return -1;
+}
+
+char *myenviron[] = {NULL};
+
+char **environ = myenviron;
+
+#ifndef USE_MW_HEADERS
+
+/* Minimal 'stat' emulation: tells directories from files and
+ gives length and mtime.
+
+ Derived from code written by Guido van Rossum, CWI, Amsterdam
+ and placed by him in the public domain. */
+
+extern int __uid, __gid;
+
+int __uid = 0;
+int __gid = 0;
+
+/* Bits in ioFlAttrib: */
+#define LOCKBIT (1<<0) /* File locked */
+#define DIRBIT (1<<4) /* It's a directory */
+
+/* Macified "stat" in which filename is given relative to a directory,
+ specified by long DirID. */
+
+static int
+_stat (char *name, long dirid, struct stat *buf)
+{
+ CInfoPBRec cipbr;
+ HFileInfo *fpb = (HFileInfo*) &cipbr;
+ DirInfo *dpb = (DirInfo*) &cipbr;
+ Str255 pname;
+ short err;
+
+ /* Make a temp copy of the name and pascalize. */
+ strcpy ((char *) pname, name);
+ c2pstr (pname);
+
+ cipbr.dirInfo.ioDrDirID = dirid;
+ cipbr.hFileInfo.ioNamePtr = pname;
+ cipbr.hFileInfo.ioVRefNum = 0;
+ cipbr.hFileInfo.ioFDirIndex = 0;
+ cipbr.hFileInfo.ioFVersNum = 0;
+ err = PBGetCatInfo (&cipbr, 0);
+ if (err != noErr)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+ /* Mac files are readable if they can be accessed at all. */
+ buf->st_mode = 0444;
+ /* Mark unlocked files as writeable. */
+ if (!(fpb->ioFlAttrib & LOCKBIT))
+ buf->st_mode |= 0222;
+ if (fpb->ioFlAttrib & DIRBIT)
+ {
+ /* Mark directories as "executable". */
+ buf->st_mode |= 0111 | S_IFDIR;
+ buf->st_size = dpb->ioDrNmFls;
+ buf->st_rsize = 0;
+ }
+ else
+ {
+ buf->st_mode |= S_IFREG;
+ /* Mark apps as "executable". */
+ if (fpb->ioFlFndrInfo.fdType == 'APPL')
+ buf->st_mode |= 0111;
+ /* Fill in the sizes of data and resource forks. */
+ buf->st_size = fpb->ioFlLgLen;
+ buf->st_rsize = fpb->ioFlRLgLen;
+ }
+ /* Fill in various times. */
+ buf->st_atime = fpb->ioFlCrDat;
+ buf->st_mtime = fpb->ioFlMdDat;
+ buf->st_ctime = fpb->ioFlCrDat;
+ /* Set up an imitation inode number. */
+ buf->st_ino = (unsigned short) fpb->ioDirID;
+ /* Set up an imitation device. */
+ GetVRefNum (buf->st_ino, &buf->st_dev);
+ buf->st_uid = __uid;
+ buf->st_gid = __gid;
+/* buf->st_FlFndrInfo = fpb->ioFlFndrInfo; */
+ return 0;
+}
+
+/* stat() sets up an empty dirid. */
+
+int
+stat (char *path, struct stat *buf)
+{
+ long rslt, errnum;
+ char tmpname[256];
+
+ mpwify_filename (path, tmpname);
+ if (DebugPI)
+ fprintf (stderr, "# stat (%s, %x)", tmpname, buf);
+ PROGRESS (1);
+ rslt = _stat (tmpname, 0L, buf);
+ errnum = errno;
+ if (DebugPI)
+ {
+ fprintf (stderr, " -> %d", rslt);
+ if (rslt != 0)
+ fprintf (stderr, " (errno is %d)", errnum);
+ fprintf (stderr, "\n");
+ fflush (stderr);
+ }
+ if (rslt != 0)
+ errno = errnum;
+ return rslt;
+}
+
+int
+fstat (int fd, struct stat *buf)
+{
+ FCBPBRec fcb;
+ FILE *fp;
+ Str255 pathname;
+ long dirid = 0L, temp;
+ long rslt, errnum;
+ short err;
+
+ if (DebugPI < 0)
+ DebugPI = (*(getenv ("DEBUG_PATHNAMES")) == '1' ? 1 : 0);
+ if (DebugPI)
+ fprintf (stderr, "# fstat (%d, %x)", fd, buf);
+ PROGRESS (1);
+ pathname[0] = 0;
+#ifdef FIOFNAME
+ /* Use an MPW-specific ioctl to get the pathname associated with
+ the file descriptor. */
+ ioctl (fd, FIOFNAME, (long *) pathname);
+#else
+ you lose
+#endif
+ if (DebugPI)
+ fprintf (stderr, " (name is %s)", pathname);
+ dirid = 0L /* fcb.ioFCBParID */ ;
+ rslt = _stat ((char *) pathname, dirid, buf);
+ errnum = errno;
+ if (DebugPI)
+ {
+ fprintf (stderr, " -> %d", rslt);
+ if (rslt != 0)
+ fprintf (stderr, " (errno is %d)", errnum);
+ fprintf (stderr, "\n");
+ fflush (stderr);
+ }
+ if (rslt != 0)
+ errno = errnum;
+ return rslt;
+}
+
+#endif /* n USE_MW_HEADERS */
+
+chdir ()
+{
+ errno = ENOSYS;
+ return (-1);
+}
+
+char *
+getcwd (char *buf, int size)
+{
+ if (buf == NULL)
+ buf = (char *) malloc (size);
+ strcpy(buf, ":");
+ return buf;
+}
+
+/* This should probably be more elaborate for MPW. */
+
+char *
+getpwd ()
+{
+ return ":";
+}
+
+int
+mpw_open (char *filename, int arg2, int arg3)
+{
+#undef open
+ int fd, errnum = 0;
+ char tmpname[256];
+
+ mpwify_filename (filename, tmpname);
+ fd = open (tmpname, arg2);
+ errnum = errno;
+
+ if (DebugPI)
+ {
+ fprintf (stderr, "# open (%s, %d, %d)", tmpname, arg2, arg3);
+ fprintf (stderr, " -> %d", fd);
+ if (fd == -1)
+ fprintf (stderr, " (errno is %d)", errnum);
+ fprintf (stderr, "\n");
+ }
+ if (fd == -1)
+ errno = errnum;
+ return fd;
+}
+
+int
+mpw_access (char *filename, unsigned int cmd)
+{
+#undef access
+
+ int rslt, errnum = 0;
+ struct stat st;
+ char tmpname[256];
+
+ mpwify_filename (filename, tmpname);
+ if (cmd & R_OK || cmd & X_OK)
+ {
+ rslt = stat (tmpname, &st);
+ errnum = errno;
+ if (rslt >= 0)
+ {
+ if (((st.st_mode & 004 == 0) && (cmd & R_OK))
+ || ((st.st_mode & 002 == 0) && (cmd & W_OK))
+ || ((st.st_mode & 001 == 0) && (cmd & X_OK)))
+ {
+ rslt = -1;
+ errnum = EACCES;
+ }
+ }
+ }
+ if (DebugPI)
+ {
+ fprintf (stderr, "# mpw_access (%s, %d)", tmpname, cmd);
+ fprintf (stderr, " -> %d", rslt);
+ if (rslt != 0)
+ fprintf (stderr, " (errno is %d)", errnum);
+ fprintf (stderr, "\n");
+ }
+ if (rslt != 0)
+ errno = errnum;
+ return rslt;
+}
+
+/* The MPW library creat() has no mode argument. */
+
+int
+mpw_creat (char *path, /* mode_t */ int mode)
+{
+#undef creat
+
+#ifdef USE_MW_HEADERS
+ return creat (path, mode);
+#else
+ return creat (path);
+#endif
+}
+
+/* This is a hack to get control in an MPW tool before it crashes the
+ machine. */
+
+mpw_special_init (name)
+ char *name;
+{
+ if (strstr (name, "DEBUG"))
+ DebugStr("\pat beginning of program");
+}
+
+static int current_umask;
+
+int
+umask(int mask)
+{
+ int oldmask = current_umask;
+
+ current_umask = mask;
+ return oldmask;
+}
+
+/* Cursor-spinning stuff that includes metering of spin rate and delays. */
+
+/* Nonzero when cursor spinning has been set up properly. */
+
+int cursor_inited;
+
+/* Nonzero if spin should be measured and excessive delays reported. */
+
+int measure_spin;
+
+/* Nonzero if spin histogram and rate data should be written out. */
+
+int dump_spin_data;
+
+long warning_threshold = 400000;
+
+long bucket_size = 1024;
+
+long bucket_power = 10;
+
+long numbuckets = 300;
+
+int *delay_counts;
+
+int overflow_count;
+
+char *current_progress;
+
+static UnsignedWide last_microseconds;
+
+static char *last_spin_file = "";
+
+static int last_spin_line;
+
+void
+warn_if_spin_delay (char *file, int line)
+{
+ long diff, ix;
+ UnsignedWide now;
+
+ Microseconds(&now);
+
+ diff = now.lo - last_microseconds.lo;
+
+ if (diff > warning_threshold)
+ fprintf (stderr, "# %s: %ld.%06ld sec delay getting from %s:%d to %s:%d\n",
+ (current_progress ? current_progress : ""),
+ diff / 1000000, diff % 1000000,
+ last_spin_file, last_spin_line, file, line);
+ if (dump_spin_data)
+ {
+ if (diff >= 0)
+ {
+ ix = diff >> bucket_power;
+ if (ix >= 0 && ix < numbuckets && delay_counts != NULL)
+ ++delay_counts[ix];
+ else
+ ++overflow_count;
+ }
+ else
+ fprintf (stderr, "raw diff is %ld (?)\n", diff);
+ }
+}
+
+void
+record_for_spin_delay (char *file, int line)
+{
+ Microseconds (&last_microseconds);
+ last_spin_file = file;
+ last_spin_line = line;
+}
+
+void
+mpw_start_progress (char *str, int n, char *file, int line)
+{
+ int i;
+ char *measure, *threshold;
+
+ if (!cursor_inited)
+ {
+ InitCursorCtl (nil);
+ cursor_inited = 1;
+ record_for_spin_delay (file, line);
+ measure = getenv ("MEASURE_SPIN");
+ if (measure != NULL && measure[0] != '\0')
+ {
+ measure_spin = 1;
+ if (strcmp (measure, "all") == 0)
+ dump_spin_data = 1;
+ }
+ threshold = getenv ("SPIN_WARN_THRESHOLD");
+ if (threshold != NULL && threshold[0] != '\0')
+ warning_threshold = atol (threshold);
+ if (dump_spin_data)
+ {
+ if (delay_counts == NULL)
+ delay_counts = (int *) malloc (numbuckets * sizeof (int));
+ for (i = 0; i < numbuckets; ++i)
+ delay_counts[i] = 0;
+ overflow_count = 0;
+ }
+ }
+ current_progress = str;
+
+ sys_nerr = errno_max ();
+
+ mpw_special_init (str);
+}
+
+void
+mpw_progress (int n)
+{
+ SpinCursor (32);
+}
+
+void
+mpw_progress_measured (int n, char *file, int line)
+{
+ if (measure_spin)
+ warn_if_spin_delay (file, line);
+ SpinCursor (32);
+ if (measure_spin)
+ record_for_spin_delay (file, line);
+}
+
+void
+mpw_end_progress (char *str, char *file, int line)
+{
+ long i, delay, count = 0, sum = 0, avgdelay, spinrate;
+ long curpower = 0, curgroup = 0;
+
+ /* Warn if it's been a while since the last spin. */
+ if (measure_spin)
+ warn_if_spin_delay (file, line);
+
+ /* Dump all the nonzero delay counts and an approximation of the delay. */
+ if (dump_spin_data && delay_counts != NULL)
+ {
+ for (i = 0; i < numbuckets; ++i)
+ {
+ delay = (i + 1) * bucket_size;
+ sum += delay_counts[i] * (i + 1);
+ count += delay_counts[i];
+ if (delay <= (1 << curpower))
+ {
+ curgroup += delay_counts[i];
+ }
+ else
+ {
+ if (curgroup > 0)
+ fprintf (stderr,
+ "# %s: %d delays between %ld.%06ld and %ld.%06ld sec\n",
+ (str ? str : ""),
+ curgroup,
+ (1 << curpower) / 1000000,
+ (1 << curpower) % 1000000,
+ (1 << (curpower + 1)) / 1000000,
+ (1 << (curpower + 1)) % 1000000);
+ ++curpower;
+ curgroup = 0;
+ }
+ }
+ if (count > 0)
+ {
+ avgdelay = (sum * bucket_size) / count;
+ spinrate = 1000000 / avgdelay;
+ fprintf (stderr, "# %s: Average spin rate is %d times/sec\n",
+ (str ? str : ""), spinrate);
+ }
+ }
+}
+
+#ifdef PROGRESS_TEST
+
+/* Test program. */
+
+main ()
+{
+ int i, j;
+ double x = 1.0, y = 2.4;
+ long start = Microseconds (), tm; FIXME
+
+ START_PROGRESS ("hi", 0);
+
+ for (i = 0; i < 1000; ++i)
+ {
+ PROGRESS (1);
+
+ for (j = 0; j < (i * 100); ++j)
+ {
+ x += (x * y) / j;
+ }
+ }
+
+ END_PROGRESS ("hi");
+
+ tm = Microseconds () - start;
+
+ printf ("Total time is %d.%d secs\n", tm / 1000000, tm % 1000000);
+}
+
+#endif
+
+#ifdef USE_MW_HEADERS
+/* Empty definitions for Metrowerks' SIOUX console library. */
+
+#ifndef __CONSOLE__
+#include <console.h>
+#endif
+
+short
+InstallConsole(short fd)
+{
+#pragma unused (fd)
+ return 0;
+}
+
+void
+RemoveConsole(void)
+{
+}
+
+long
+WriteCharsToConsole(char *buf, long n)
+{
+#pragma unused (buf, n)
+ return 0;
+}
+
+long ReadCharsFromConsole(char *buf, long n)
+{
+#pragma unused (buf, n)
+ return 0;
+}
+
+extern char *
+__ttyname(long fd)
+{
+ static char *__devicename = "null device";
+
+ if (fd >= 0 && fd <= 2)
+ return (__devicename);
+ return NULL;
+}
+
+#endif
diff --git a/libiberty/msdos.c b/libiberty/msdos.c
new file mode 100644
index 00000000000..923e64d4ede
--- /dev/null
+++ b/libiberty/msdos.c
@@ -0,0 +1,15 @@
+char msg[] = "No vfork available - aborting\n";
+vfork()
+{
+ write(1, msg, sizeof(msg));
+}
+
+sigsetmask()
+{
+ /* no signals support in go32 (yet) */
+}
+
+waitpid()
+{
+ return -1;
+}
diff --git a/libiberty/objalloc.c b/libiberty/objalloc.c
new file mode 100644
index 00000000000..34687d3891a
--- /dev/null
+++ b/libiberty/objalloc.c
@@ -0,0 +1,289 @@
+/* objalloc.c -- routines to allocate memory for objects
+ Copyright 1997 Free Software Foundation, Inc.
+ Written by Ian Lance Taylor, Cygnus Solutions.
+
+This program 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.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include "ansidecl.h"
+#include "objalloc.h"
+
+/* Get a definition for NULL. */
+#include <stdio.h>
+
+#if VMS
+#include <stdlib.h>
+#include <unixlib.h>
+#else
+
+#ifdef ANSI_PROTOTYPES
+/* Get a definition for size_t. */
+#include <stddef.h>
+#endif
+
+/* For systems with larger pointers than ints, this must be declared. */
+extern PTR malloc PARAMS ((size_t));
+#endif
+
+/* These routines allocate space for an object. Freeing allocated
+ space may or may not free all more recently allocated space.
+
+ We handle large and small allocation requests differently. If we
+ don't have enough space in the current block, and the allocation
+ request is for more than 512 bytes, we simply pass it through to
+ malloc. */
+
+/* The objalloc structure is defined in objalloc.h. */
+
+/* This structure appears at the start of each chunk. */
+
+struct objalloc_chunk
+{
+ /* Next chunk. */
+ struct objalloc_chunk *next;
+ /* If this chunk contains large objects, this is the value of
+ current_ptr when this chunk was allocated. If this chunk
+ contains small objects, this is NULL. */
+ char *current_ptr;
+};
+
+/* The aligned size of objalloc_chunk. */
+
+#define CHUNK_HEADER_SIZE \
+ ((sizeof (struct objalloc_chunk) + OBJALLOC_ALIGN - 1) \
+ &~ (OBJALLOC_ALIGN - 1))
+
+/* We ask for this much memory each time we create a chunk which is to
+ hold small objects. */
+
+#define CHUNK_SIZE (4096 - 32)
+
+/* A request for this amount or more is just passed through to malloc. */
+
+#define BIG_REQUEST (512)
+
+/* Create an objalloc structure. */
+
+struct objalloc *
+objalloc_create ()
+{
+ struct objalloc *ret;
+ struct objalloc_chunk *chunk;
+
+ ret = (struct objalloc *) malloc (sizeof *ret);
+ if (ret == NULL)
+ return NULL;
+
+ ret->chunks = (PTR) malloc (CHUNK_SIZE);
+ if (ret->chunks == NULL)
+ {
+ free (ret);
+ return NULL;
+ }
+
+ chunk = (struct objalloc_chunk *) ret->chunks;
+ chunk->next = NULL;
+ chunk->current_ptr = NULL;
+
+ ret->current_ptr = (char *) chunk + CHUNK_HEADER_SIZE;
+ ret->current_space = CHUNK_SIZE - CHUNK_HEADER_SIZE;
+
+ return ret;
+}
+
+/* Allocate space from an objalloc structure. */
+
+PTR
+_objalloc_alloc (o, len)
+ struct objalloc *o;
+ unsigned long len;
+{
+ /* We avoid confusion from zero sized objects by always allocating
+ at least 1 byte. */
+ if (len == 0)
+ len = 1;
+
+ len = (len + OBJALLOC_ALIGN - 1) &~ (OBJALLOC_ALIGN - 1);
+
+ if (len <= o->current_space)
+ {
+ o->current_ptr += len;
+ o->current_space -= len;
+ return (PTR) (o->current_ptr - len);
+ }
+
+ if (len >= BIG_REQUEST)
+ {
+ char *ret;
+ struct objalloc_chunk *chunk;
+
+ ret = (char *) malloc (CHUNK_HEADER_SIZE + len);
+ if (ret == NULL)
+ return NULL;
+
+ chunk = (struct objalloc_chunk *) ret;
+ chunk->next = (struct objalloc_chunk *) o->chunks;
+ chunk->current_ptr = o->current_ptr;
+
+ o->chunks = (PTR) chunk;
+
+ return (PTR) (ret + CHUNK_HEADER_SIZE);
+ }
+ else
+ {
+ struct objalloc_chunk *chunk;
+
+ chunk = (struct objalloc_chunk *) malloc (CHUNK_SIZE);
+ if (chunk == NULL)
+ return NULL;
+ chunk->next = (struct objalloc_chunk *) o->chunks;
+ chunk->current_ptr = NULL;
+
+ o->current_ptr = (char *) chunk + CHUNK_HEADER_SIZE;
+ o->current_space = CHUNK_SIZE - CHUNK_HEADER_SIZE;
+
+ o->chunks = (PTR) chunk;
+
+ return objalloc_alloc (o, len);
+ }
+}
+
+/* Free an entire objalloc structure. */
+
+void
+objalloc_free (o)
+ struct objalloc *o;
+{
+ struct objalloc_chunk *l;
+
+ l = (struct objalloc_chunk *) o->chunks;
+ while (l != NULL)
+ {
+ struct objalloc_chunk *next;
+
+ next = l->next;
+ free (l);
+ l = next;
+ }
+
+ free (o);
+}
+
+/* Free a block from an objalloc structure. This also frees all more
+ recently allocated blocks. */
+
+void
+objalloc_free_block (o, block)
+ struct objalloc *o;
+ PTR block;
+{
+ struct objalloc_chunk *p, *small;
+ char *b = (char *) block;
+
+ /* First set P to the chunk which contains the block we are freeing,
+ and set Q to the last small object chunk we see before P. */
+ small = NULL;
+ for (p = (struct objalloc_chunk *) o->chunks; p != NULL; p = p->next)
+ {
+ if (p->current_ptr == NULL)
+ {
+ if (b > (char *) p && b < (char *) p + CHUNK_SIZE)
+ break;
+ small = p;
+ }
+ else
+ {
+ if (b == (char *) p + CHUNK_HEADER_SIZE)
+ break;
+ }
+ }
+
+ /* If we can't find the chunk, the caller has made a mistake. */
+ if (p == NULL)
+ abort ();
+
+ if (p->current_ptr == NULL)
+ {
+ struct objalloc_chunk *q;
+ struct objalloc_chunk *first;
+
+ /* The block is in a chunk containing small objects. We can
+ free every chunk through SMALL, because they have certainly
+ been allocated more recently. After SMALL, we will not see
+ any chunks containing small objects; we can free any big
+ chunk if the current_ptr is greater than or equal to B. We
+ can then reset the new current_ptr to B. */
+
+ first = NULL;
+ q = (struct objalloc_chunk *) o->chunks;
+ while (q != p)
+ {
+ struct objalloc_chunk *next;
+
+ next = q->next;
+ if (small != NULL)
+ {
+ if (small == q)
+ small = NULL;
+ free (q);
+ }
+ else if (q->current_ptr > b)
+ free (q);
+ else if (first == NULL)
+ first = q;
+
+ q = next;
+ }
+
+ if (first == NULL)
+ first = p;
+ o->chunks = (PTR) first;
+
+ /* Now start allocating from this small block again. */
+ o->current_ptr = b;
+ o->current_space = ((char *) p + CHUNK_SIZE) - b;
+ }
+ else
+ {
+ struct objalloc_chunk *q;
+ char *current_ptr;
+
+ /* This block is in a large chunk by itself. We can free
+ everything on the list up to and including this block. We
+ then start allocating from the next chunk containing small
+ objects, setting current_ptr from the value stored with the
+ large chunk we are freeing. */
+
+ current_ptr = p->current_ptr;
+ p = p->next;
+
+ q = (struct objalloc_chunk *) o->chunks;
+ while (q != p)
+ {
+ struct objalloc_chunk *next;
+
+ next = q->next;
+ free (q);
+ q = next;
+ }
+
+ o->chunks = (PTR) p;
+
+ while (p->current_ptr != NULL)
+ p = p->next;
+
+ o->current_ptr = current_ptr;
+ o->current_space = ((char *) p + CHUNK_SIZE) - current_ptr;
+ }
+}
diff --git a/libiberty/obstack.c b/libiberty/obstack.c
new file mode 100644
index 00000000000..a6880caaa6c
--- /dev/null
+++ b/libiberty/obstack.c
@@ -0,0 +1,514 @@
+/* obstack.c - subroutines used implicitly by object stack macros
+ Copyright (C) 1988, 89, 90, 91, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
+
+This program 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.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include "obstack.h"
+
+/* NOTE BEFORE MODIFYING THIS FILE: This version number must be
+ incremented whenever callers compiled using an old obstack.h can no
+ longer properly call the functions in this obstack.c. */
+#define OBSTACK_INTERFACE_VERSION 1
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+ actually compiling the library itself, and the installed library
+ supports the same library interface we do. This code is part of the GNU
+ C Library, but also included in many other GNU distributions. Compiling
+ and linking in this code is a waste when using the GNU C library
+ (especially if it is a shared library). Rather than having every GNU
+ program understand `configure --with-gnu-libc' and omit the object
+ files, it is simpler to just do this in the source for each such file. */
+
+#include <stdio.h> /* Random thing to get __GNU_LIBRARY__. */
+#if !defined (_LIBC) && defined (__GNU_LIBRARY__) && __GNU_LIBRARY__ > 1
+#include <gnu-versions.h>
+#if _GNU_OBSTACK_INTERFACE_VERSION == OBSTACK_INTERFACE_VERSION
+#define ELIDE_CODE
+#endif
+#endif
+
+/* CYGNUS LOCAL (not to be elided!) */
+
+int
+_obstack_memory_used (h)
+ struct obstack *h;
+{
+ register struct _obstack_chunk* lp;
+ register int nbytes = 0;
+
+ for (lp = h->chunk; lp != 0; lp = lp->prev)
+ {
+ nbytes += lp->limit - (char *) lp;
+ }
+ return nbytes;
+}
+
+/* END CYGNUS LOCAL */
+
+#ifndef ELIDE_CODE
+
+
+#if defined (__STDC__) && __STDC__
+#define POINTER void *
+#else
+#define POINTER char *
+#endif
+
+/* Determine default alignment. */
+struct fooalign {char x; double d;};
+#define DEFAULT_ALIGNMENT \
+ ((PTR_INT_TYPE) ((char *) &((struct fooalign *) 0)->d - (char *) 0))
+/* If malloc were really smart, it would round addresses to DEFAULT_ALIGNMENT.
+ But in fact it might be less smart and round addresses to as much as
+ DEFAULT_ROUNDING. So we prepare for it to do that. */
+union fooround {long x; double d;};
+#define DEFAULT_ROUNDING (sizeof (union fooround))
+
+/* When we copy a long block of data, this is the unit to do it with.
+ On some machines, copying successive ints does not work;
+ in such a case, redefine COPYING_UNIT to `long' (if that works)
+ or `char' as a last resort. */
+#ifndef COPYING_UNIT
+#define COPYING_UNIT int
+#endif
+
+/* The non-GNU-C macros copy the obstack into this global variable
+ to avoid multiple evaluation. */
+
+struct obstack *_obstack;
+
+/* Define a macro that either calls functions with the traditional malloc/free
+ calling interface, or calls functions with the mmalloc/mfree interface
+ (that adds an extra first argument), based on the state of use_extra_arg.
+ For free, do not use ?:, since some compilers, like the MIPS compilers,
+ do not allow (expr) ? void : void. */
+
+#define CALL_CHUNKFUN(h, size) \
+ (((h) -> use_extra_arg) \
+ ? (*(h)->chunkfun) ((h)->extra_arg, (size)) \
+ : (*(struct _obstack_chunk *(*) ()) (h)->chunkfun) ((size)))
+
+#define CALL_FREEFUN(h, old_chunk) \
+ do { \
+ if ((h) -> use_extra_arg) \
+ (*(h)->freefun) ((h)->extra_arg, (old_chunk)); \
+ else \
+ (*(void (*) ()) (h)->freefun) ((old_chunk)); \
+ } while (0)
+
+
+/* Initialize an obstack H for use. Specify chunk size SIZE (0 means default).
+ Objects start on multiples of ALIGNMENT (0 means use default).
+ CHUNKFUN is the function to use to allocate chunks,
+ and FREEFUN the function to free them.
+
+ Return nonzero if successful, zero if out of memory.
+ To recover from an out of memory error,
+ free up some memory, then call this again. */
+
+int
+_obstack_begin (h, size, alignment, chunkfun, freefun)
+ struct obstack *h;
+ int size;
+ int alignment;
+ POINTER (*chunkfun) ();
+ void (*freefun) ();
+{
+ register struct _obstack_chunk *chunk; /* points to new chunk */
+
+ if (alignment == 0)
+ alignment = DEFAULT_ALIGNMENT;
+ if (size == 0)
+ /* Default size is what GNU malloc can fit in a 4096-byte block. */
+ {
+ /* 12 is sizeof (mhead) and 4 is EXTRA from GNU malloc.
+ Use the values for range checking, because if range checking is off,
+ the extra bytes won't be missed terribly, but if range checking is on
+ and we used a larger request, a whole extra 4096 bytes would be
+ allocated.
+
+ These number are irrelevant to the new GNU malloc. I suspect it is
+ less sensitive to the size of the request. */
+ int extra = ((((12 + DEFAULT_ROUNDING - 1) & ~(DEFAULT_ROUNDING - 1))
+ + 4 + DEFAULT_ROUNDING - 1)
+ & ~(DEFAULT_ROUNDING - 1));
+ size = 4096 - extra;
+ }
+
+ h->chunkfun = (struct _obstack_chunk * (*)()) chunkfun;
+ h->freefun = freefun;
+ h->chunk_size = size;
+ h->alignment_mask = alignment - 1;
+ h->use_extra_arg = 0;
+
+ chunk = h->chunk = CALL_CHUNKFUN (h, h -> chunk_size);
+ if (!chunk)
+ {
+ h->alloc_failed = 1;
+ return 0;
+ }
+ h->alloc_failed = 0;
+ h->next_free = h->object_base = chunk->contents;
+ h->chunk_limit = chunk->limit
+ = (char *) chunk + h->chunk_size;
+ chunk->prev = 0;
+ /* The initial chunk now contains no empty object. */
+ h->maybe_empty_object = 0;
+ return 1;
+}
+
+int
+_obstack_begin_1 (h, size, alignment, chunkfun, freefun, arg)
+ struct obstack *h;
+ int size;
+ int alignment;
+ POINTER (*chunkfun) ();
+ void (*freefun) ();
+ POINTER arg;
+{
+ register struct _obstack_chunk *chunk; /* points to new chunk */
+
+ if (alignment == 0)
+ alignment = DEFAULT_ALIGNMENT;
+ if (size == 0)
+ /* Default size is what GNU malloc can fit in a 4096-byte block. */
+ {
+ /* 12 is sizeof (mhead) and 4 is EXTRA from GNU malloc.
+ Use the values for range checking, because if range checking is off,
+ the extra bytes won't be missed terribly, but if range checking is on
+ and we used a larger request, a whole extra 4096 bytes would be
+ allocated.
+
+ These number are irrelevant to the new GNU malloc. I suspect it is
+ less sensitive to the size of the request. */
+ int extra = ((((12 + DEFAULT_ROUNDING - 1) & ~(DEFAULT_ROUNDING - 1))
+ + 4 + DEFAULT_ROUNDING - 1)
+ & ~(DEFAULT_ROUNDING - 1));
+ size = 4096 - extra;
+ }
+
+ h->chunkfun = (struct _obstack_chunk * (*)()) chunkfun;
+ h->freefun = freefun;
+ h->chunk_size = size;
+ h->alignment_mask = alignment - 1;
+ h->extra_arg = arg;
+ h->use_extra_arg = 1;
+
+ chunk = h->chunk = CALL_CHUNKFUN (h, h -> chunk_size);
+ if (!chunk)
+ {
+ h->alloc_failed = 1;
+ return 0;
+ }
+ h->alloc_failed = 0;
+ h->next_free = h->object_base = chunk->contents;
+ h->chunk_limit = chunk->limit
+ = (char *) chunk + h->chunk_size;
+ chunk->prev = 0;
+ /* The initial chunk now contains no empty object. */
+ h->maybe_empty_object = 0;
+ return 1;
+}
+
+/* Allocate a new current chunk for the obstack *H
+ on the assumption that LENGTH bytes need to be added
+ to the current object, or a new object of length LENGTH allocated.
+ Copies any partial object from the end of the old chunk
+ to the beginning of the new one. */
+
+void
+_obstack_newchunk (h, length)
+ struct obstack *h;
+ int length;
+{
+ register struct _obstack_chunk *old_chunk = h->chunk;
+ register struct _obstack_chunk *new_chunk;
+ register long new_size;
+ register int obj_size = h->next_free - h->object_base;
+ register int i;
+ int already;
+
+ /* Compute size for new chunk. */
+ new_size = (obj_size + length) + (obj_size >> 3) + 100;
+ if (new_size < h->chunk_size)
+ new_size = h->chunk_size;
+
+ /* Allocate and initialize the new chunk. */
+ new_chunk = CALL_CHUNKFUN (h, new_size);
+ if (!new_chunk)
+ {
+ h->alloc_failed = 1;
+ return;
+ }
+ h->alloc_failed = 0;
+ h->chunk = new_chunk;
+ new_chunk->prev = old_chunk;
+ new_chunk->limit = h->chunk_limit = (char *) new_chunk + new_size;
+
+ /* Move the existing object to the new chunk.
+ Word at a time is fast and is safe if the object
+ is sufficiently aligned. */
+ if (h->alignment_mask + 1 >= DEFAULT_ALIGNMENT)
+ {
+ for (i = obj_size / sizeof (COPYING_UNIT) - 1;
+ i >= 0; i--)
+ ((COPYING_UNIT *)new_chunk->contents)[i]
+ = ((COPYING_UNIT *)h->object_base)[i];
+ /* We used to copy the odd few remaining bytes as one extra COPYING_UNIT,
+ but that can cross a page boundary on a machine
+ which does not do strict alignment for COPYING_UNITS. */
+ already = obj_size / sizeof (COPYING_UNIT) * sizeof (COPYING_UNIT);
+ }
+ else
+ already = 0;
+ /* Copy remaining bytes one by one. */
+ for (i = already; i < obj_size; i++)
+ new_chunk->contents[i] = h->object_base[i];
+
+ /* If the object just copied was the only data in OLD_CHUNK,
+ free that chunk and remove it from the chain.
+ But not if that chunk might contain an empty object. */
+ if (h->object_base == old_chunk->contents && ! h->maybe_empty_object)
+ {
+ new_chunk->prev = old_chunk->prev;
+ CALL_FREEFUN (h, old_chunk);
+ }
+
+ h->object_base = new_chunk->contents;
+ h->next_free = h->object_base + obj_size;
+ /* The new chunk certainly contains no empty object yet. */
+ h->maybe_empty_object = 0;
+}
+
+/* Return nonzero if object OBJ has been allocated from obstack H.
+ This is here for debugging.
+ If you use it in a program, you are probably losing. */
+
+#if defined (__STDC__) && __STDC__
+/* Suppress -Wmissing-prototypes warning. We don't want to declare this in
+ obstack.h because it is just for debugging. */
+int _obstack_allocated_p (struct obstack *h, POINTER obj);
+#endif
+
+int
+_obstack_allocated_p (h, obj)
+ struct obstack *h;
+ POINTER obj;
+{
+ register struct _obstack_chunk *lp; /* below addr of any objects in this chunk */
+ register struct _obstack_chunk *plp; /* point to previous chunk if any */
+
+ lp = (h)->chunk;
+ /* We use >= rather than > since the object cannot be exactly at
+ the beginning of the chunk but might be an empty object exactly
+ at the end of an adjacent chunk. */
+ while (lp != 0 && ((POINTER) lp >= obj || (POINTER) (lp)->limit < obj))
+ {
+ plp = lp->prev;
+ lp = plp;
+ }
+ return lp != 0;
+}
+
+/* Free objects in obstack H, including OBJ and everything allocate
+ more recently than OBJ. If OBJ is zero, free everything in H. */
+
+#undef obstack_free
+
+/* This function has two names with identical definitions.
+ This is the first one, called from non-ANSI code. */
+
+void
+_obstack_free (h, obj)
+ struct obstack *h;
+ POINTER obj;
+{
+ register struct _obstack_chunk *lp; /* below addr of any objects in this chunk */
+ register struct _obstack_chunk *plp; /* point to previous chunk if any */
+
+ lp = h->chunk;
+ /* We use >= because there cannot be an object at the beginning of a chunk.
+ But there can be an empty object at that address
+ at the end of another chunk. */
+ while (lp != 0 && ((POINTER) lp >= obj || (POINTER) (lp)->limit < obj))
+ {
+ plp = lp->prev;
+ CALL_FREEFUN (h, lp);
+ lp = plp;
+ /* If we switch chunks, we can't tell whether the new current
+ chunk contains an empty object, so assume that it may. */
+ h->maybe_empty_object = 1;
+ }
+ if (lp)
+ {
+ h->object_base = h->next_free = (char *) (obj);
+ h->chunk_limit = lp->limit;
+ h->chunk = lp;
+ }
+ else if (obj != 0)
+ /* obj is not in any of the chunks! */
+ abort ();
+}
+
+/* This function is used from ANSI code. */
+
+void
+obstack_free (h, obj)
+ struct obstack *h;
+ POINTER obj;
+{
+ register struct _obstack_chunk *lp; /* below addr of any objects in this chunk */
+ register struct _obstack_chunk *plp; /* point to previous chunk if any */
+
+ lp = h->chunk;
+ /* We use >= because there cannot be an object at the beginning of a chunk.
+ But there can be an empty object at that address
+ at the end of another chunk. */
+ while (lp != 0 && ((POINTER) lp >= obj || (POINTER) (lp)->limit < obj))
+ {
+ plp = lp->prev;
+ CALL_FREEFUN (h, lp);
+ lp = plp;
+ /* If we switch chunks, we can't tell whether the new current
+ chunk contains an empty object, so assume that it may. */
+ h->maybe_empty_object = 1;
+ }
+ if (lp)
+ {
+ h->object_base = h->next_free = (char *) (obj);
+ h->chunk_limit = lp->limit;
+ h->chunk = lp;
+ }
+ else if (obj != 0)
+ /* obj is not in any of the chunks! */
+ abort ();
+}
+
+#if 0
+/* These are now turned off because the applications do not use it
+ and it uses bcopy via obstack_grow, which causes trouble on sysV. */
+
+/* Now define the functional versions of the obstack macros.
+ Define them to simply use the corresponding macros to do the job. */
+
+#if defined (__STDC__) && __STDC__
+/* These function definitions do not work with non-ANSI preprocessors;
+ they won't pass through the macro names in parentheses. */
+
+/* The function names appear in parentheses in order to prevent
+ the macro-definitions of the names from being expanded there. */
+
+POINTER (obstack_base) (obstack)
+ struct obstack *obstack;
+{
+ return obstack_base (obstack);
+}
+
+POINTER (obstack_next_free) (obstack)
+ struct obstack *obstack;
+{
+ return obstack_next_free (obstack);
+}
+
+int (obstack_object_size) (obstack)
+ struct obstack *obstack;
+{
+ return obstack_object_size (obstack);
+}
+
+int (obstack_room) (obstack)
+ struct obstack *obstack;
+{
+ return obstack_room (obstack);
+}
+
+void (obstack_grow) (obstack, pointer, length)
+ struct obstack *obstack;
+ POINTER pointer;
+ int length;
+{
+ obstack_grow (obstack, pointer, length);
+}
+
+void (obstack_grow0) (obstack, pointer, length)
+ struct obstack *obstack;
+ POINTER pointer;
+ int length;
+{
+ obstack_grow0 (obstack, pointer, length);
+}
+
+void (obstack_1grow) (obstack, character)
+ struct obstack *obstack;
+ int character;
+{
+ obstack_1grow (obstack, character);
+}
+
+void (obstack_blank) (obstack, length)
+ struct obstack *obstack;
+ int length;
+{
+ obstack_blank (obstack, length);
+}
+
+void (obstack_1grow_fast) (obstack, character)
+ struct obstack *obstack;
+ int character;
+{
+ obstack_1grow_fast (obstack, character);
+}
+
+void (obstack_blank_fast) (obstack, length)
+ struct obstack *obstack;
+ int length;
+{
+ obstack_blank_fast (obstack, length);
+}
+
+POINTER (obstack_finish) (obstack)
+ struct obstack *obstack;
+{
+ return obstack_finish (obstack);
+}
+
+POINTER (obstack_alloc) (obstack, length)
+ struct obstack *obstack;
+ int length;
+{
+ return obstack_alloc (obstack, length);
+}
+
+POINTER (obstack_copy) (obstack, pointer, length)
+ struct obstack *obstack;
+ POINTER pointer;
+ int length;
+{
+ return obstack_copy (obstack, pointer, length);
+}
+
+POINTER (obstack_copy0) (obstack, pointer, length)
+ struct obstack *obstack;
+ POINTER pointer;
+ int length;
+{
+ return obstack_copy0 (obstack, pointer, length);
+}
+
+#endif /* __STDC__ */
+
+#endif /* 0 */
+
+#endif /* !ELIDE_CODE */
diff --git a/libiberty/pexecute.c b/libiberty/pexecute.c
new file mode 100644
index 00000000000..ab5f392780c
--- /dev/null
+++ b/libiberty/pexecute.c
@@ -0,0 +1,580 @@
+/* Utilities to execute a program in a subprocess (possibly linked by pipes
+ with other subprocesses), and wait for it.
+ Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 file exports two functions: pexecute and pwait. */
+
+/* This file lives in at least two places: libiberty and gcc.
+ Don't change one without the other. */
+
+#include <stdio.h>
+#include <errno.h>
+
+#ifdef IN_GCC
+#include "config.h"
+#include "gansidecl.h"
+/* ??? Need to find a suitable header file. */
+#define PEXECUTE_FIRST 1
+#define PEXECUTE_LAST 2
+#define PEXECUTE_ONE (PEXECUTE_FIRST + PEXECUTE_LAST)
+#define PEXECUTE_SEARCH 4
+#define PEXECUTE_VERBOSE 8
+#else
+#include "libiberty.h"
+#endif
+
+/* stdin file number. */
+#define STDIN_FILE_NO 0
+
+/* stdout file number. */
+#define STDOUT_FILE_NO 1
+
+/* value of `pipe': port index for reading. */
+#define READ_PORT 0
+
+/* value of `pipe': port index for writing. */
+#define WRITE_PORT 1
+
+static char *install_error_msg = "installation problem, cannot exec `%s'";
+
+/* pexecute: execute a program.
+
+ PROGRAM and ARGV are the arguments to execv/execvp.
+
+ THIS_PNAME is name of the calling program (i.e. argv[0]).
+
+ TEMP_BASE is the path name, sans suffix, of a temporary file to use
+ if needed. This is currently only needed for MSDOS ports that don't use
+ GO32 (do any still exist?). Ports that don't need it can pass NULL.
+
+ (FLAGS & PEXECUTE_SEARCH) is non-zero if $PATH should be searched
+ (??? It's not clear that GCC passes this flag correctly).
+ (FLAGS & PEXECUTE_FIRST) is nonzero for the first process in chain.
+ (FLAGS & PEXECUTE_FIRST) is nonzero for the last process in chain.
+ FIRST_LAST could be simplified to only mark the last of a chain of processes
+ but that requires the caller to always mark the last one (and not give up
+ early if some error occurs). It's more robust to require the caller to
+ mark both ends of the chain.
+
+ The result is the pid on systems like Unix where we fork/exec and on systems
+ like WIN32 and OS2 where we use spawn. It is up to the caller to wait for
+ the child.
+
+ The result is the WEXITSTATUS on systems like MSDOS where we spawn and wait
+ for the child here.
+
+ Upon failure, ERRMSG_FMT and ERRMSG_ARG are set to the text of the error
+ message with an optional argument (if not needed, ERRMSG_ARG is set to
+ NULL), and -1 is returned. `errno' is available to the caller to use.
+
+ pwait: cover function for wait.
+
+ PID is the process id of the task to wait for.
+ STATUS is the `status' argument to wait.
+ FLAGS is currently unused (allows future enhancement without breaking
+ upward compatibility). Pass 0 for now.
+
+ The result is the pid of the child reaped,
+ or -1 for failure (errno says why).
+
+ On systems that don't support waiting for a particular child, PID is
+ ignored. On systems like MSDOS that don't really multitask pwait
+ is just a mechanism to provide a consistent interface for the caller.
+
+ pfinish: finish generation of script
+
+ pfinish is necessary for systems like MPW where a script is generated that
+ runs the requested programs.
+*/
+
+#ifdef __MSDOS__
+
+/* MSDOS doesn't multitask, but for the sake of a consistent interface
+ the code behaves like it does. pexecute runs the program, tucks the
+ exit code away, and returns a "pid". pwait must be called to fetch the
+ exit code. */
+
+#include <process.h>
+
+/* For communicating information from pexecute to pwait. */
+static int last_pid = 0;
+static int last_status = 0;
+static int last_reaped = 0;
+
+int
+pexecute (program, argv, this_pname, temp_base, errmsg_fmt, errmsg_arg, flags)
+ const char *program;
+ char * const *argv;
+ const char *this_pname;
+ const char *temp_base;
+ char **errmsg_fmt, **errmsg_arg;
+ int flags;
+{
+ int rc;
+
+ last_pid++;
+ if (last_pid < 0)
+ last_pid = 1;
+
+ if ((flags & PEXECUTE_ONE) != PEXECUTE_ONE)
+ abort ();
+
+#ifdef __GO32__
+ /* ??? What are the possible return values from spawnv? */
+ rc = (flags & PEXECUTE_SEARCH ? spawnvp : spawnv) (1, program, argv);
+#else
+ char *scmd, *rf;
+ FILE *argfile;
+ int i, el = flags & PEXECUTE_SEARCH ? 4 : 0;
+
+ scmd = (char *) xmalloc (strlen (program) + strlen (temp_base) + 6 + el);
+ rf = scmd + strlen(program) + 2 + el;
+ sprintf (scmd, "%s%s @%s.gp", program,
+ (flags & PEXECUTE_SEARCH ? ".exe" : ""), temp_base);
+ argfile = fopen (rf, "w");
+ if (argfile == 0)
+ {
+ int errno_save = errno;
+ free (scmd);
+ errno = errno_save;
+ *errmsg_fmt = "cannot open `%s.gp'";
+ *errmsg_arg = temp_base;
+ return -1;
+ }
+
+ for (i=1; argv[i]; i++)
+ {
+ char *cp;
+ for (cp = argv[i]; *cp; cp++)
+ {
+ if (*cp == '"' || *cp == '\'' || *cp == '\\' || isspace (*cp))
+ fputc ('\\', argfile);
+ fputc (*cp, argfile);
+ }
+ fputc ('\n', argfile);
+ }
+ fclose (argfile);
+
+ rc = system (scmd);
+
+ {
+ int errno_save = errno;
+ remove (rf);
+ free (scmd);
+ errno = errno_save;
+ }
+#endif
+
+ if (rc == -1)
+ {
+ *errmsg_fmt = install_error_msg;
+ *errmsg_arg = program;
+ return -1;
+ }
+
+ /* Tuck the status away for pwait, and return a "pid". */
+ last_status = rc << 8;
+ return last_pid;
+}
+
+int
+pwait (pid, status, flags)
+ int pid;
+ int *status;
+ int flags;
+{
+ /* On MSDOS each pexecute must be followed by it's associated pwait. */
+ if (pid != last_pid
+ /* Called twice for the same child? */
+ || pid == last_reaped)
+ {
+ /* ??? ECHILD would be a better choice. Can we use it here? */
+ errno = EINVAL;
+ return -1;
+ }
+ /* ??? Here's an opportunity to canonicalize the values in STATUS.
+ Needed? */
+ *status = last_status;
+ last_reaped = last_pid;
+ return last_pid;
+}
+
+#endif /* MSDOS */
+
+#if defined (_WIN32)
+
+#include <process.h>
+extern int _spawnv ();
+extern int _spawnvp ();
+
+int
+pexecute (program, argv, this_pname, temp_base, errmsg_fmt, errmsg_arg, flags)
+ const char *program;
+ char * const *argv;
+ const char *this_pname;
+ const char *temp_base;
+ char **errmsg_fmt, **errmsg_arg;
+ int flags;
+{
+ int pid;
+
+ if ((flags & PEXECUTE_ONE) != PEXECUTE_ONE)
+ abort ();
+ pid = (flags & PEXECUTE_SEARCH ? _spawnvp : _spawnv) (_P_NOWAIT, program, argv);
+ if (pid == -1)
+ {
+ *errmsg_fmt = install_error_msg;
+ *errmsg_arg = program;
+ return -1;
+ }
+ return pid;
+}
+
+int
+pwait (pid, status, flags)
+ int pid;
+ int *status;
+ int flags;
+{
+ /* ??? Here's an opportunity to canonicalize the values in STATUS.
+ Needed? */
+ return cwait (status, pid, WAIT_CHILD);
+}
+
+#endif /* _WIN32 */
+
+#ifdef OS2
+
+/* ??? Does OS2 have process.h? */
+extern int spawnv ();
+extern int spawnvp ();
+
+int
+pexecute (program, argv, this_pname, temp_base, errmsg_fmt, errmsg_arg, flags)
+ const char *program;
+ char * const *argv;
+ const char *this_pname;
+ const char *temp_base;
+ char **errmsg_fmt, **errmsg_arg;
+ int flags;
+{
+ int pid;
+
+ if ((flags & PEXECUTE_ONE) != PEXECUTE_ONE)
+ abort ();
+ /* ??? Presumably 1 == _P_NOWAIT. */
+ pid = (flags & PEXECUTE_SEARCH ? spawnvp : spawnv) (1, program, argv);
+ if (pid == -1)
+ {
+ *errmsg_fmt = install_error_msg;
+ *errmsg_arg = program;
+ return -1;
+ }
+ return pid;
+}
+
+int
+pwait (pid, status, flags)
+ int pid;
+ int *status;
+ int flags;
+{
+ /* ??? Here's an opportunity to canonicalize the values in STATUS.
+ Needed? */
+ int pid = wait (status);
+ return pid;
+}
+
+#endif /* OS2 */
+
+#ifdef MPW
+
+/* MPW pexecute doesn't actually run anything; instead, it writes out
+ script commands that, when run, will do the actual executing.
+
+ For example, in GCC's case, GCC will write out several script commands:
+
+ cpp ...
+ cc1 ...
+ as ...
+ ld ...
+
+ and then exit. None of the above programs will have run yet. The task
+ that called GCC will then execute the script and cause cpp,etc. to run.
+ The caller must invoke pfinish before calling exit. This adds
+ the finishing touches to the generated script. */
+
+static int first_time = 1;
+
+int
+pexecute (program, argv, this_pname, temp_base, errmsg_fmt, errmsg_arg, flags)
+ const char *program;
+ char **argv;
+ const char *this_pname;
+ const char *temp_base;
+ char **errmsg_fmt, **errmsg_arg;
+ int flags;
+{
+ char tmpprogram[255];
+ char *cp, *tmpname;
+ int i;
+
+ mpwify_filename (program, tmpprogram);
+ if (first_time)
+ {
+ printf ("Set Failed 0\n");
+ first_time = 0;
+ }
+
+ fputs ("If {Failed} == 0\n", stdout);
+ /* If being verbose, output a copy of the command. It should be
+ accurate enough and escaped enough to be "clickable". */
+ if (flags & PEXECUTE_VERBOSE)
+ {
+ fputs ("\tEcho ", stdout);
+ fputc ('\'', stdout);
+ fputs (tmpprogram, stdout);
+ fputc ('\'', stdout);
+ fputc (' ', stdout);
+ for (i=1; argv[i]; i++)
+ {
+ /* We have to quote every arg, so that when the echo is
+ executed, the quotes are stripped and the original arg
+ is left. */
+ fputc ('\'', stdout);
+ for (cp = argv[i]; *cp; cp++)
+ {
+ /* Write an Option-d esc char in front of special chars. */
+ if (strchr ("\"'+", *cp))
+ fputc ('\266', stdout);
+ fputc (*cp, stdout);
+ }
+ fputc ('\'', stdout);
+ fputc (' ', stdout);
+ }
+ fputs ("\n", stdout);
+ }
+ fputs ("\t", stdout);
+ fputs (tmpprogram, stdout);
+ fputc (' ', stdout);
+
+ for (i=1; argv[i]; i++)
+ {
+ if (strchr (argv[i], ' '))
+ fputc ('\'', stdout);
+ for (cp = argv[i]; *cp; cp++)
+ {
+ /* Write an Option-d esc char in front of special chars. */
+ if (strchr ("\"'+", *cp))
+ {
+ fputc ('\266', stdout);
+ }
+ fputc (*cp, stdout);
+ }
+ if (strchr (argv[i], ' '))
+ fputc ('\'', stdout);
+ fputc (' ', stdout);
+ }
+
+ fputs ("\n", stdout);
+
+ /* Output commands that arrange to clean up and exit if a failure occurs.
+ We have to be careful to collect the status from the program that was
+ run, rather than some other script command. Also, we don't exit
+ immediately, since necessary cleanups are at the end of the script. */
+ fputs ("\tSet TmpStatus {Status}\n", stdout);
+ fputs ("\tIf {TmpStatus} != 0\n", stdout);
+ fputs ("\t\tSet Failed {TmpStatus}\n", stdout);
+ fputs ("\tEnd\n", stdout);
+ fputs ("End\n", stdout);
+
+ /* We're just composing a script, can't fail here. */
+ return 0;
+}
+
+int
+pwait (pid, status, flags)
+ int pid;
+ int *status;
+ int flags;
+{
+ *status = 0;
+ return 0;
+}
+
+/* Write out commands that will exit with the correct error code
+ if something in the script failed. */
+
+void
+pfinish ()
+{
+ printf ("\tExit \"{Failed}\"\n");
+}
+
+#endif /* MPW */
+
+/* include for Unix-like environments but not for Dos-like environments */
+#if ! defined (__MSDOS__) && ! defined (OS2) && ! defined (MPW) \
+ && ! defined (_WIN32)
+
+#ifdef VMS
+#define vfork() (decc$$alloc_vfork_blocks() >= 0 ? \
+ lib$get_current_invo_context(decc$$get_vfork_jmpbuf()) : -1)
+#else
+#ifdef USG
+#define vfork fork
+#endif
+#endif
+
+extern int execv ();
+extern int execvp ();
+
+int
+pexecute (program, argv, this_pname, temp_base, errmsg_fmt, errmsg_arg, flags)
+ const char *program;
+ char * const *argv;
+ const char *this_pname;
+ const char *temp_base;
+ char **errmsg_fmt, **errmsg_arg;
+ int flags;
+{
+ int (*func)() = (flags & PEXECUTE_SEARCH ? execvp : execv);
+ int pid;
+ int pdes[2];
+ int input_desc, output_desc;
+ int retries, sleep_interval;
+ /* Pipe waiting from last process, to be used as input for the next one.
+ Value is STDIN_FILE_NO if no pipe is waiting
+ (i.e. the next command is the first of a group). */
+ static int last_pipe_input;
+
+ /* If this is the first process, initialize. */
+ if (flags & PEXECUTE_FIRST)
+ last_pipe_input = STDIN_FILE_NO;
+
+ input_desc = last_pipe_input;
+
+ /* If this isn't the last process, make a pipe for its output,
+ and record it as waiting to be the input to the next process. */
+ if (! (flags & PEXECUTE_LAST))
+ {
+ if (pipe (pdes) < 0)
+ {
+ *errmsg_fmt = "pipe";
+ *errmsg_arg = NULL;
+ return -1;
+ }
+ output_desc = pdes[WRITE_PORT];
+ last_pipe_input = pdes[READ_PORT];
+ }
+ else
+ {
+ /* Last process. */
+ output_desc = STDOUT_FILE_NO;
+ last_pipe_input = STDIN_FILE_NO;
+ }
+
+ /* Fork a subprocess; wait and retry if it fails. */
+ sleep_interval = 1;
+ for (retries = 0; retries < 4; retries++)
+ {
+ pid = vfork ();
+ if (pid >= 0)
+ break;
+ sleep (sleep_interval);
+ sleep_interval *= 2;
+ }
+
+ switch (pid)
+ {
+ case -1:
+ {
+#ifdef vfork
+ *errmsg_fmt = "fork";
+#else
+ *errmsg_fmt = "vfork";
+#endif
+ *errmsg_arg = NULL;
+ return -1;
+ }
+
+ case 0: /* child */
+ /* Move the input and output pipes into place, if necessary. */
+ if (input_desc != STDIN_FILE_NO)
+ {
+ close (STDIN_FILE_NO);
+ dup (input_desc);
+ close (input_desc);
+ }
+ if (output_desc != STDOUT_FILE_NO)
+ {
+ close (STDOUT_FILE_NO);
+ dup (output_desc);
+ close (output_desc);
+ }
+
+ /* Close the parent's descs that aren't wanted here. */
+ if (last_pipe_input != STDIN_FILE_NO)
+ close (last_pipe_input);
+
+ /* Exec the program. */
+ (*func) (program, argv);
+
+ /* Note: Calling fprintf and exit here doesn't seem right for vfork. */
+ fprintf (stderr, "%s: ", this_pname);
+ fprintf (stderr, install_error_msg, program);
+#ifdef IN_GCC
+ fprintf (stderr, ": %s\n", my_strerror (errno));
+#else
+ fprintf (stderr, ": %s\n", xstrerror (errno));
+#endif
+ exit (-1);
+ /* NOTREACHED */
+ return 0;
+
+ default:
+ /* In the parent, after forking.
+ Close the descriptors that we made for this child. */
+ if (input_desc != STDIN_FILE_NO)
+ close (input_desc);
+ if (output_desc != STDOUT_FILE_NO)
+ close (output_desc);
+
+ /* Return child's process number. */
+ return pid;
+ }
+}
+
+int
+pwait (pid, status, flags)
+ int pid;
+ int *status;
+ int flags;
+{
+ /* ??? Here's an opportunity to canonicalize the values in STATUS.
+ Needed? */
+#ifdef VMS
+ pid = waitpid (-1, status, 0);
+#else
+ pid = wait (status);
+#endif
+ return pid;
+}
+
+#endif /* ! __MSDOS__ && ! OS2 && ! MPW && ! _WIN32 */
diff --git a/libiberty/random.c b/libiberty/random.c
new file mode 100644
index 00000000000..e205719832b
--- /dev/null
+++ b/libiberty/random.c
@@ -0,0 +1,373 @@
+/*
+ * Copyright (c) 1983 Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that the above copyright notice and this paragraph are
+ * duplicated in all such forms and that any documentation,
+ * advertising materials, and other materials related to such
+ * distribution and use acknowledge that the software was developed
+ * by the University of California, Berkeley. The name of the
+ * University may not be used to endorse or promote products derived
+ * from this software without specific prior written permission.
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ */
+
+/*
+ * This is derived from the Berkeley source:
+ * @(#)random.c 5.5 (Berkeley) 7/6/88
+ * It was reworked for the GNU C Library by Roland McGrath.
+ */
+
+#include <errno.h>
+
+#if 0
+
+#include <ansidecl.h>
+#include <limits.h>
+#include <stddef.h>
+#include <stdlib.h>
+
+#else
+
+#define ULONG_MAX ((unsigned long)(~0L)) /* 0xFFFFFFFF for 32-bits */
+#define LONG_MAX ((long)(ULONG_MAX >> 1)) /* 0x7FFFFFFF for 32-bits*/
+
+#ifdef __STDC__
+# define PTR void *
+# define NULL (void *) 0
+#else
+# define PTR char *
+# define NULL 0
+#endif
+
+#endif
+
+long int random ();
+
+/* An improved random number generation package. In addition to the standard
+ rand()/srand() like interface, this package also has a special state info
+ interface. The initstate() routine is called with a seed, an array of
+ bytes, and a count of how many bytes are being passed in; this array is
+ then initialized to contain information for random number generation with
+ that much state information. Good sizes for the amount of state
+ information are 32, 64, 128, and 256 bytes. The state can be switched by
+ calling the setstate() function with the same array as was initiallized
+ with initstate(). By default, the package runs with 128 bytes of state
+ information and generates far better random numbers than a linear
+ congruential generator. If the amount of state information is less than
+ 32 bytes, a simple linear congruential R.N.G. is used. Internally, the
+ state information is treated as an array of longs; the zeroeth element of
+ the array is the type of R.N.G. being used (small integer); the remainder
+ of the array is the state information for the R.N.G. Thus, 32 bytes of
+ state information will give 7 longs worth of state information, which will
+ allow a degree seven polynomial. (Note: The zeroeth word of state
+ information also has some other information stored in it; see setstate
+ for details). The random number generation technique is a linear feedback
+ shift register approach, employing trinomials (since there are fewer terms
+ to sum up that way). In this approach, the least significant bit of all
+ the numbers in the state table will act as a linear feedback shift register,
+ and will have period 2^deg - 1 (where deg is the degree of the polynomial
+ being used, assuming that the polynomial is irreducible and primitive).
+ The higher order bits will have longer periods, since their values are
+ also influenced by pseudo-random carries out of the lower bits. The
+ total period of the generator is approximately deg*(2**deg - 1); thus
+ doubling the amount of state information has a vast influence on the
+ period of the generator. Note: The deg*(2**deg - 1) is an approximation
+ only good for large deg, when the period of the shift register is the
+ dominant factor. With deg equal to seven, the period is actually much
+ longer than the 7*(2**7 - 1) predicted by this formula. */
+
+
+
+/* For each of the currently supported random number generators, we have a
+ break value on the amount of state information (you need at least thi
+ bytes of state info to support this random number generator), a degree for
+ the polynomial (actually a trinomial) that the R.N.G. is based on, and
+ separation between the two lower order coefficients of the trinomial. */
+
+/* Linear congruential. */
+#define TYPE_0 0
+#define BREAK_0 8
+#define DEG_0 0
+#define SEP_0 0
+
+/* x**7 + x**3 + 1. */
+#define TYPE_1 1
+#define BREAK_1 32
+#define DEG_1 7
+#define SEP_1 3
+
+/* x**15 + x + 1. */
+#define TYPE_2 2
+#define BREAK_2 64
+#define DEG_2 15
+#define SEP_2 1
+
+/* x**31 + x**3 + 1. */
+#define TYPE_3 3
+#define BREAK_3 128
+#define DEG_3 31
+#define SEP_3 3
+
+/* x**63 + x + 1. */
+#define TYPE_4 4
+#define BREAK_4 256
+#define DEG_4 63
+#define SEP_4 1
+
+
+/* Array versions of the above information to make code run faster.
+ Relies on fact that TYPE_i == i. */
+
+#define MAX_TYPES 5 /* Max number of types above. */
+
+static int degrees[MAX_TYPES] = { DEG_0, DEG_1, DEG_2, DEG_3, DEG_4 };
+static int seps[MAX_TYPES] = { SEP_0, SEP_1, SEP_2, SEP_3, SEP_4 };
+
+
+
+/* Initially, everything is set up as if from:
+ initstate(1, randtbl, 128);
+ Note that this initialization takes advantage of the fact that srandom
+ advances the front and rear pointers 10*rand_deg times, and hence the
+ rear pointer which starts at 0 will also end up at zero; thus the zeroeth
+ element of the state information, which contains info about the current
+ position of the rear pointer is just
+ (MAX_TYPES * (rptr - state)) + TYPE_3 == TYPE_3. */
+
+static long int randtbl[DEG_3 + 1] =
+ { TYPE_3,
+ 0x9a319039, 0x32d9c024, 0x9b663182, 0x5da1f342,
+ 0xde3b81e0, 0xdf0a6fb5, 0xf103bc02, 0x48f340fb,
+ 0x7449e56b, 0xbeb1dbb0, 0xab5c5918, 0x946554fd,
+ 0x8c2e680f, 0xeb3d799f, 0xb11ee0b7, 0x2d436b86,
+ 0xda672e2a, 0x1588ca88, 0xe369735d, 0x904f35f7,
+ 0xd7158fd6, 0x6fa6f051, 0x616e6b96, 0xac94efdc,
+ 0x36413f93, 0xc622c298, 0xf5a42ab8, 0x8a88d77b,
+ 0xf5ad9d0e, 0x8999220b, 0x27fb47b9
+ };
+
+/* FPTR and RPTR are two pointers into the state info, a front and a rear
+ pointer. These two pointers are always rand_sep places aparts, as they
+ cycle through the state information. (Yes, this does mean we could get
+ away with just one pointer, but the code for random is more efficient
+ this way). The pointers are left positioned as they would be from the call:
+ initstate(1, randtbl, 128);
+ (The position of the rear pointer, rptr, is really 0 (as explained above
+ in the initialization of randtbl) because the state table pointer is set
+ to point to randtbl[1] (as explained below).) */
+
+static long int *fptr = &randtbl[SEP_3 + 1];
+static long int *rptr = &randtbl[1];
+
+
+
+/* The following things are the pointer to the state information table,
+ the type of the current generator, the degree of the current polynomial
+ being used, and the separation between the two pointers.
+ Note that for efficiency of random, we remember the first location of
+ the state information, not the zeroeth. Hence it is valid to access
+ state[-1], which is used to store the type of the R.N.G.
+ Also, we remember the last location, since this is more efficient than
+ indexing every time to find the address of the last element to see if
+ the front and rear pointers have wrapped. */
+
+static long int *state = &randtbl[1];
+
+static int rand_type = TYPE_3;
+static int rand_deg = DEG_3;
+static int rand_sep = SEP_3;
+
+static long int *end_ptr = &randtbl[sizeof(randtbl) / sizeof(randtbl[0])];
+
+/* Initialize the random number generator based on the given seed. If the
+ type is the trivial no-state-information type, just remember the seed.
+ Otherwise, initializes state[] based on the given "seed" via a linear
+ congruential generator. Then, the pointers are set to known locations
+ that are exactly rand_sep places apart. Lastly, it cycles the state
+ information a given number of times to get rid of any initial dependencies
+ introduced by the L.C.R.N.G. Note that the initialization of randtbl[]
+ for default usage relies on values produced by this routine. */
+void
+srandom (x)
+ unsigned int x;
+{
+ state[0] = x;
+ if (rand_type != TYPE_0)
+ {
+ register long int i;
+ for (i = 1; i < rand_deg; ++i)
+ state[i] = (1103515145 * state[i - 1]) + 12345;
+ fptr = &state[rand_sep];
+ rptr = &state[0];
+ for (i = 0; i < 10 * rand_deg; ++i)
+ random();
+ }
+}
+
+/* Initialize the state information in the given array of N bytes for
+ future random number generation. Based on the number of bytes we
+ are given, and the break values for the different R.N.G.'s, we choose
+ the best (largest) one we can and set things up for it. srandom is
+ then called to initialize the state information. Note that on return
+ from srandom, we set state[-1] to be the type multiplexed with the current
+ value of the rear pointer; this is so successive calls to initstate won't
+ lose this information and will be able to restart with setstate.
+ Note: The first thing we do is save the current state, if any, just like
+ setstate so that it doesn't matter when initstate is called.
+ Returns a pointer to the old state. */
+PTR
+initstate (seed, arg_state, n)
+ unsigned int seed;
+ PTR arg_state;
+ unsigned long n;
+{
+ PTR ostate = (PTR) &state[-1];
+
+ if (rand_type == TYPE_0)
+ state[-1] = rand_type;
+ else
+ state[-1] = (MAX_TYPES * (rptr - state)) + rand_type;
+ if (n < BREAK_1)
+ {
+ if (n < BREAK_0)
+ {
+ errno = EINVAL;
+ return NULL;
+ }
+ rand_type = TYPE_0;
+ rand_deg = DEG_0;
+ rand_sep = SEP_0;
+ }
+ else if (n < BREAK_2)
+ {
+ rand_type = TYPE_1;
+ rand_deg = DEG_1;
+ rand_sep = SEP_1;
+ }
+ else if (n < BREAK_3)
+ {
+ rand_type = TYPE_2;
+ rand_deg = DEG_2;
+ rand_sep = SEP_2;
+ }
+ else if (n < BREAK_4)
+ {
+ rand_type = TYPE_3;
+ rand_deg = DEG_3;
+ rand_sep = SEP_3;
+ }
+ else
+ {
+ rand_type = TYPE_4;
+ rand_deg = DEG_4;
+ rand_sep = SEP_4;
+ }
+
+ state = &((long int *) arg_state)[1]; /* First location. */
+ /* Must set END_PTR before srandom. */
+ end_ptr = &state[rand_deg];
+ srandom(seed);
+ if (rand_type == TYPE_0)
+ state[-1] = rand_type;
+ else
+ state[-1] = (MAX_TYPES * (rptr - state)) + rand_type;
+
+ return ostate;
+}
+
+/* Restore the state from the given state array.
+ Note: It is important that we also remember the locations of the pointers
+ in the current state information, and restore the locations of the pointers
+ from the old state information. This is done by multiplexing the pointer
+ location into the zeroeth word of the state information. Note that due
+ to the order in which things are done, it is OK to call setstate with the
+ same state as the current state
+ Returns a pointer to the old state information. */
+
+PTR
+setstate (arg_state)
+ PTR arg_state;
+{
+ register long int *new_state = (long int *) arg_state;
+ register int type = new_state[0] % MAX_TYPES;
+ register int rear = new_state[0] / MAX_TYPES;
+ PTR ostate = (PTR) &state[-1];
+
+ if (rand_type == TYPE_0)
+ state[-1] = rand_type;
+ else
+ state[-1] = (MAX_TYPES * (rptr - state)) + rand_type;
+
+ switch (type)
+ {
+ case TYPE_0:
+ case TYPE_1:
+ case TYPE_2:
+ case TYPE_3:
+ case TYPE_4:
+ rand_type = type;
+ rand_deg = degrees[type];
+ rand_sep = seps[type];
+ break;
+ default:
+ /* State info munged. */
+ errno = EINVAL;
+ return NULL;
+ }
+
+ state = &new_state[1];
+ if (rand_type != TYPE_0)
+ {
+ rptr = &state[rear];
+ fptr = &state[(rear + rand_sep) % rand_deg];
+ }
+ /* Set end_ptr too. */
+ end_ptr = &state[rand_deg];
+
+ return ostate;
+}
+
+/* If we are using the trivial TYPE_0 R.N.G., just do the old linear
+ congruential bit. Otherwise, we do our fancy trinomial stuff, which is the
+ same in all ther other cases due to all the global variables that have been
+ set up. The basic operation is to add the number at the rear pointer into
+ the one at the front pointer. Then both pointers are advanced to the next
+ location cyclically in the table. The value returned is the sum generated,
+ reduced to 31 bits by throwing away the "least random" low bit.
+ Note: The code takes advantage of the fact that both the front and
+ rear pointers can't wrap on the same call by not testing the rear
+ pointer if the front one has wrapped. Returns a 31-bit random number. */
+
+long int
+random ()
+{
+ if (rand_type == TYPE_0)
+ {
+ state[0] = ((state[0] * 1103515245) + 12345) & LONG_MAX;
+ return state[0];
+ }
+ else
+ {
+ long int i;
+ *fptr += *rptr;
+ /* Chucking least random bit. */
+ i = (*fptr >> 1) & LONG_MAX;
+ ++fptr;
+ if (fptr >= end_ptr)
+ {
+ fptr = state;
+ ++rptr;
+ }
+ else
+ {
+ ++rptr;
+ if (rptr >= end_ptr)
+ rptr = state;
+ }
+ return i;
+ }
+}
diff --git a/libiberty/rename.c b/libiberty/rename.c
new file mode 100644
index 00000000000..ae26e2d0040
--- /dev/null
+++ b/libiberty/rename.c
@@ -0,0 +1,22 @@
+/* rename -- rename a file
+ This function is in the public domain. */
+
+/* Rename a file. */
+
+#include <errno.h>
+
+int
+rename (zfrom, zto)
+ char *zfrom;
+ char *zto;
+{
+ if (link (zfrom, zto) < 0)
+ {
+ if (errno != EEXIST)
+ return -1;
+ if (unlink (zto) < 0
+ || link (zfrom, zto) < 0)
+ return -1;
+ }
+ return unlink (zfrom);
+}
diff --git a/libiberty/rindex.c b/libiberty/rindex.c
new file mode 100644
index 00000000000..061d1269f17
--- /dev/null
+++ b/libiberty/rindex.c
@@ -0,0 +1,11 @@
+/* Stub implementation of (obsolete) rindex(). */
+
+extern char *strrchr ();
+
+char *
+rindex (s, c)
+ char *s;
+ int c;
+{
+ return strrchr (s, c);
+}
diff --git a/libiberty/sigsetmask.c b/libiberty/sigsetmask.c
new file mode 100644
index 00000000000..2a09e6a6c5a
--- /dev/null
+++ b/libiberty/sigsetmask.c
@@ -0,0 +1,30 @@
+/* Version of sigsetmask.c
+ Written by Steve Chamberlain (sac@cygnus.com).
+ Contributed by Cygnus Support.
+ This file is in the public doamin. */
+
+/* Set the current signal mask to the set provided, and return the
+ previous value */
+
+#define _POSIX_SOURCE
+#include <ansidecl.h>
+/* Including <sys/types.h> seems to be needed by ISC. */
+#include <sys/types.h>
+#include <signal.h>
+
+#ifdef SIG_SETMASK
+int
+DEFUN(sigsetmask,(set),
+ int set)
+{
+ sigset_t new;
+ sigset_t old;
+
+ sigemptyset (&new);
+ if (set != 0) {
+ abort(); /* FIXME, we don't know how to translate old mask to new */
+ }
+ sigprocmask(SIG_SETMASK, &new, &old);
+ return 1; /* FIXME, we always return 1 as old value. */
+}
+#endif
diff --git a/libiberty/spaces.c b/libiberty/spaces.c
new file mode 100644
index 00000000000..ea925712e3f
--- /dev/null
+++ b/libiberty/spaces.c
@@ -0,0 +1,78 @@
+/* Allocate memory region filled with spaces.
+ Copyright (C) 1991 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; see the file COPYING.LIB. If
+not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/*
+
+NAME
+
+ spaces -- return a pointer to a buffer full of spaces
+
+SYNOPSIS
+
+ char *spaces (int count)
+
+DESCRIPTION
+
+ Returns a pointer to a memory region filled with the specified
+ number of spaces and null terminated. The returned pointer is
+ valid until at least the next call.
+
+BUGS
+
+*/
+
+#include "ansidecl.h"
+#include "libiberty.h"
+
+#if VMS
+#include <stdlib.h>
+#include <unixlib.h>
+#else
+/* For systems with larger pointers than ints, these must be declared. */
+extern PTR malloc PARAMS ((size_t));
+extern void free PARAMS ((PTR));
+#endif
+
+const char *
+spaces (count)
+ int count;
+{
+ register char *t;
+ static char *buf;
+ static int maxsize;
+
+ if (count > maxsize)
+ {
+ if (buf)
+ {
+ free (buf);
+ }
+ buf = malloc (count + 1);
+ if (buf == (char *) 0)
+ return 0;
+ for (t = buf + count ; t != buf ; )
+ {
+ *--t = ' ';
+ }
+ maxsize = count;
+ buf[count] = '\0';
+ }
+ return (const char *) (buf + maxsize - count);
+}
+
diff --git a/libiberty/strcasecmp.c b/libiberty/strcasecmp.c
new file mode 100644
index 00000000000..3aa930b696f
--- /dev/null
+++ b/libiberty/strcasecmp.c
@@ -0,0 +1,82 @@
+/*
+ * Copyright (c) 1987 Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that this notice is preserved and that due credit is given
+ * to the University of California at Berkeley. The name of the University
+ * may not be used to endorse or promote products derived from this
+ * software without specific written prior permission. This software
+ * is provided ``as is'' without express or implied warranty.
+ */
+
+#if defined(LIBC_SCCS) && !defined(lint)
+static char sccsid[] = "@(#)strcasecmp.c 5.5 (Berkeley) 11/24/87";
+#endif /* LIBC_SCCS and not lint */
+
+#include <ansidecl.h>
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#endif
+
+/*
+ * This array is designed for mapping upper and lower case letter
+ * together for a case independent comparison. The mappings are
+ * based upon ascii character sequences.
+ */
+typedef unsigned char uc;
+static unsigned char charmap[] = {
+ (uc)'\000',(uc)'\001',(uc)'\002',(uc)'\003',(uc)'\004',(uc)'\005',(uc)'\006',(uc)'\007',
+ (uc)'\010',(uc)'\011',(uc)'\012',(uc)'\013',(uc)'\014',(uc)'\015',(uc)'\016',(uc)'\017',
+ (uc)'\020',(uc)'\021',(uc)'\022',(uc)'\023',(uc)'\024',(uc)'\025',(uc)'\026',(uc)'\027',
+ (uc)'\030',(uc)'\031',(uc)'\032',(uc)'\033',(uc)'\034',(uc)'\035',(uc)'\036',(uc)'\037',
+ (uc)'\040',(uc)'\041',(uc)'\042',(uc)'\043',(uc)'\044',(uc)'\045',(uc)'\046',(uc)'\047',
+ (uc)'\050',(uc)'\051',(uc)'\052',(uc)'\053',(uc)'\054',(uc)'\055',(uc)'\056',(uc)'\057',
+ (uc)'\060',(uc)'\061',(uc)'\062',(uc)'\063',(uc)'\064',(uc)'\065',(uc)'\066',(uc)'\067',
+ (uc)'\070',(uc)'\071',(uc)'\072',(uc)'\073',(uc)'\074',(uc)'\075',(uc)'\076',(uc)'\077',
+ (uc)'\100',(uc)'\141',(uc)'\142',(uc)'\143',(uc)'\144',(uc)'\145',(uc)'\146',(uc)'\147',
+ (uc)'\150',(uc)'\151',(uc)'\152',(uc)'\153',(uc)'\154',(uc)'\155',(uc)'\156',(uc)'\157',
+ (uc)'\160',(uc)'\161',(uc)'\162',(uc)'\163',(uc)'\164',(uc)'\165',(uc)'\166',(uc)'\167',
+ (uc)'\170',(uc)'\171',(uc)'\172',(uc)'\133',(uc)'\134',(uc)'\135',(uc)'\136',(uc)'\137',
+ (uc)'\140',(uc)'\141',(uc)'\142',(uc)'\143',(uc)'\144',(uc)'\145',(uc)'\146',(uc)'\147',
+ (uc)'\150',(uc)'\151',(uc)'\152',(uc)'\153',(uc)'\154',(uc)'\155',(uc)'\156',(uc)'\157',
+ (uc)'\160',(uc)'\161',(uc)'\162',(uc)'\163',(uc)'\164',(uc)'\165',(uc)'\166',(uc)'\167',
+ (uc)'\170',(uc)'\171',(uc)'\172',(uc)'\173',(uc)'\174',(uc)'\175',(uc)'\176',(uc)'\177',
+ (uc)'\200',(uc)'\201',(uc)'\202',(uc)'\203',(uc)'\204',(uc)'\205',(uc)'\206',(uc)'\207',
+ (uc)'\210',(uc)'\211',(uc)'\212',(uc)'\213',(uc)'\214',(uc)'\215',(uc)'\216',(uc)'\217',
+ (uc)'\220',(uc)'\221',(uc)'\222',(uc)'\223',(uc)'\224',(uc)'\225',(uc)'\226',(uc)'\227',
+ (uc)'\230',(uc)'\231',(uc)'\232',(uc)'\233',(uc)'\234',(uc)'\235',(uc)'\236',(uc)'\237',
+ (uc)'\240',(uc)'\241',(uc)'\242',(uc)'\243',(uc)'\244',(uc)'\245',(uc)'\246',(uc)'\247',
+ (uc)'\250',(uc)'\251',(uc)'\252',(uc)'\253',(uc)'\254',(uc)'\255',(uc)'\256',(uc)'\257',
+ (uc)'\260',(uc)'\261',(uc)'\262',(uc)'\263',(uc)'\264',(uc)'\265',(uc)'\266',(uc)'\267',
+ (uc)'\270',(uc)'\271',(uc)'\272',(uc)'\273',(uc)'\274',(uc)'\275',(uc)'\276',(uc)'\277',
+ (uc)'\300',(uc)'\341',(uc)'\342',(uc)'\343',(uc)'\344',(uc)'\345',(uc)'\346',(uc)'\347',
+ (uc)'\350',(uc)'\351',(uc)'\352',(uc)'\353',(uc)'\354',(uc)'\355',(uc)'\356',(uc)'\357',
+ (uc)'\360',(uc)'\361',(uc)'\362',(uc)'\363',(uc)'\364',(uc)'\365',(uc)'\366',(uc)'\367',
+ (uc)'\370',(uc)'\371',(uc)'\372',(uc)'\333',(uc)'\334',(uc)'\335',(uc)'\336',(uc)'\337',
+ (uc)'\340',(uc)'\341',(uc)'\342',(uc)'\343',(uc)'\344',(uc)'\345',(uc)'\346',(uc)'\347',
+ (uc)'\350',(uc)'\351',(uc)'\352',(uc)'\353',(uc)'\354',(uc)'\355',(uc)'\356',(uc)'\357',
+ (uc)'\360',(uc)'\361',(uc)'\362',(uc)'\363',(uc)'\364',(uc)'\365',(uc)'\366',(uc)'\367',
+ (uc)'\370',(uc)'\371',(uc)'\372',(uc)'\373',(uc)'\374',(uc)'\375',(uc)'\376',(uc)'\377',
+};
+
+int
+strcasecmp(s1, s2)
+ const char *s1, *s2;
+{
+ register unsigned char u1, u2;
+
+ for (;;) {
+ u1 = (unsigned char) *s1++;
+ u2 = (unsigned char) *s2++;
+ if (charmap[u1] != charmap[u2]) {
+ return charmap[u1] - charmap[u2];
+ }
+ if (u1 == '\0') {
+ return 0;
+ }
+ }
+}
+
diff --git a/libiberty/strchr.c b/libiberty/strchr.c
new file mode 100644
index 00000000000..22976ce248a
--- /dev/null
+++ b/libiberty/strchr.c
@@ -0,0 +1,34 @@
+/* Portable version of strchr()
+ This function is in the public domain. */
+
+/*
+NAME
+ strchr -- return pointer to first occurance of a character
+
+SYNOPSIS
+ char *strchr (const char *s, int c)
+
+DESCRIPTION
+ Returns a pointer to the first occurance of character C in
+ string S, or a NULL pointer if no occurance is found.
+
+BUGS
+ Behavior when character is the null character is implementation
+ dependent.
+*/
+
+#include <ansidecl.h>
+
+char *
+strchr (s, c)
+ register CONST char *s;
+ int c;
+{
+ do {
+ if (*s == c)
+ {
+ return (char*)s;
+ }
+ } while (*s++);
+ return (0);
+}
diff --git a/libiberty/strdup.c b/libiberty/strdup.c
new file mode 100644
index 00000000000..1785b34f274
--- /dev/null
+++ b/libiberty/strdup.c
@@ -0,0 +1,10 @@
+char *
+strdup(s)
+ char *s;
+{
+ char *result = (char*)malloc(strlen(s) + 1);
+ if (result == (char*)0)
+ return (char*)0;
+ strcpy(result, s);
+ return result;
+}
diff --git a/libiberty/strerror.c b/libiberty/strerror.c
new file mode 100644
index 00000000000..f5e2eebee2e
--- /dev/null
+++ b/libiberty/strerror.c
@@ -0,0 +1,831 @@
+/* Extended support for using errno values.
+ Written by Fred Fish. fnf@cygnus.com
+ This file is in the public domain. --Per Bothner. */
+
+#include "ansidecl.h"
+#include "libiberty.h"
+
+#include "config.h"
+
+#ifndef NEED_sys_errlist
+/* Note that errno.h (not sure what OS) or stdio.h (BSD 4.4, at least)
+ might declare sys_errlist in a way that the compiler might consider
+ incompatible with our later declaration, perhaps by using const
+ attributes. So we hide the declaration in errno.h (if any) using a
+ macro. */
+#define sys_errlist sys_errlist__
+#endif
+
+#include <stdio.h>
+#include <errno.h>
+
+#ifndef NEED_sys_errlist
+#undef sys_errlist
+#endif
+
+/* Routines imported from standard C runtime libraries. */
+
+#ifdef __STDC__
+#include <stddef.h>
+extern void *malloc (size_t size); /* 4.10.3.3 */
+extern void *memset (void *s, int c, size_t n); /* 4.11.6.1 */
+#else /* !__STDC__ */
+extern char *malloc (); /* Standard memory allocater */
+extern char *memset ();
+#endif /* __STDC__ */
+
+#ifndef MAX
+# define MAX(a,b) ((a) > (b) ? (a) : (b))
+#endif
+
+static void init_error_tables PARAMS ((void));
+
+/* Translation table for errno values. See intro(2) in most UNIX systems
+ Programmers Reference Manuals.
+
+ Note that this table is generally only accessed when it is used at runtime
+ to initialize errno name and message tables that are indexed by errno
+ value.
+
+ Not all of these errnos will exist on all systems. This table is the only
+ thing that should have to be updated as new error numbers are introduced.
+ It's sort of ugly, but at least its portable. */
+
+struct error_info
+{
+ int value; /* The numeric value from <errno.h> */
+ const char *name; /* The equivalent symbolic value */
+#ifdef NEED_sys_errlist
+ const char *msg; /* Short message about this value */
+#endif
+};
+
+#ifdef NEED_sys_errlist
+# define ENTRY(value, name, msg) {value, name, msg}
+#else
+# define ENTRY(value, name, msg) {value, name}
+#endif
+
+static const struct error_info error_table[] =
+{
+#if defined (EPERM)
+ ENTRY(EPERM, "EPERM", "Not owner"),
+#endif
+#if defined (ENOENT)
+ ENTRY(ENOENT, "ENOENT", "No such file or directory"),
+#endif
+#if defined (ESRCH)
+ ENTRY(ESRCH, "ESRCH", "No such process"),
+#endif
+#if defined (EINTR)
+ ENTRY(EINTR, "EINTR", "Interrupted system call"),
+#endif
+#if defined (EIO)
+ ENTRY(EIO, "EIO", "I/O error"),
+#endif
+#if defined (ENXIO)
+ ENTRY(ENXIO, "ENXIO", "No such device or address"),
+#endif
+#if defined (E2BIG)
+ ENTRY(E2BIG, "E2BIG", "Arg list too long"),
+#endif
+#if defined (ENOEXEC)
+ ENTRY(ENOEXEC, "ENOEXEC", "Exec format error"),
+#endif
+#if defined (EBADF)
+ ENTRY(EBADF, "EBADF", "Bad file number"),
+#endif
+#if defined (ECHILD)
+ ENTRY(ECHILD, "ECHILD", "No child processes"),
+#endif
+#if defined (EWOULDBLOCK) /* Put before EAGAIN, sometimes aliased */
+ ENTRY(EWOULDBLOCK, "EWOULDBLOCK", "Operation would block"),
+#endif
+#if defined (EAGAIN)
+ ENTRY(EAGAIN, "EAGAIN", "No more processes"),
+#endif
+#if defined (ENOMEM)
+ ENTRY(ENOMEM, "ENOMEM", "Not enough space"),
+#endif
+#if defined (EACCES)
+ ENTRY(EACCES, "EACCES", "Permission denied"),
+#endif
+#if defined (EFAULT)
+ ENTRY(EFAULT, "EFAULT", "Bad address"),
+#endif
+#if defined (ENOTBLK)
+ ENTRY(ENOTBLK, "ENOTBLK", "Block device required"),
+#endif
+#if defined (EBUSY)
+ ENTRY(EBUSY, "EBUSY", "Device busy"),
+#endif
+#if defined (EEXIST)
+ ENTRY(EEXIST, "EEXIST", "File exists"),
+#endif
+#if defined (EXDEV)
+ ENTRY(EXDEV, "EXDEV", "Cross-device link"),
+#endif
+#if defined (ENODEV)
+ ENTRY(ENODEV, "ENODEV", "No such device"),
+#endif
+#if defined (ENOTDIR)
+ ENTRY(ENOTDIR, "ENOTDIR", "Not a directory"),
+#endif
+#if defined (EISDIR)
+ ENTRY(EISDIR, "EISDIR", "Is a directory"),
+#endif
+#if defined (EINVAL)
+ ENTRY(EINVAL, "EINVAL", "Invalid argument"),
+#endif
+#if defined (ENFILE)
+ ENTRY(ENFILE, "ENFILE", "File table overflow"),
+#endif
+#if defined (EMFILE)
+ ENTRY(EMFILE, "EMFILE", "Too many open files"),
+#endif
+#if defined (ENOTTY)
+ ENTRY(ENOTTY, "ENOTTY", "Not a typewriter"),
+#endif
+#if defined (ETXTBSY)
+ ENTRY(ETXTBSY, "ETXTBSY", "Text file busy"),
+#endif
+#if defined (EFBIG)
+ ENTRY(EFBIG, "EFBIG", "File too large"),
+#endif
+#if defined (ENOSPC)
+ ENTRY(ENOSPC, "ENOSPC", "No space left on device"),
+#endif
+#if defined (ESPIPE)
+ ENTRY(ESPIPE, "ESPIPE", "Illegal seek"),
+#endif
+#if defined (EROFS)
+ ENTRY(EROFS, "EROFS", "Read-only file system"),
+#endif
+#if defined (EMLINK)
+ ENTRY(EMLINK, "EMLINK", "Too many links"),
+#endif
+#if defined (EPIPE)
+ ENTRY(EPIPE, "EPIPE", "Broken pipe"),
+#endif
+#if defined (EDOM)
+ ENTRY(EDOM, "EDOM", "Math argument out of domain of func"),
+#endif
+#if defined (ERANGE)
+ ENTRY(ERANGE, "ERANGE", "Math result not representable"),
+#endif
+#if defined (ENOMSG)
+ ENTRY(ENOMSG, "ENOMSG", "No message of desired type"),
+#endif
+#if defined (EIDRM)
+ ENTRY(EIDRM, "EIDRM", "Identifier removed"),
+#endif
+#if defined (ECHRNG)
+ ENTRY(ECHRNG, "ECHRNG", "Channel number out of range"),
+#endif
+#if defined (EL2NSYNC)
+ ENTRY(EL2NSYNC, "EL2NSYNC", "Level 2 not synchronized"),
+#endif
+#if defined (EL3HLT)
+ ENTRY(EL3HLT, "EL3HLT", "Level 3 halted"),
+#endif
+#if defined (EL3RST)
+ ENTRY(EL3RST, "EL3RST", "Level 3 reset"),
+#endif
+#if defined (ELNRNG)
+ ENTRY(ELNRNG, "ELNRNG", "Link number out of range"),
+#endif
+#if defined (EUNATCH)
+ ENTRY(EUNATCH, "EUNATCH", "Protocol driver not attached"),
+#endif
+#if defined (ENOCSI)
+ ENTRY(ENOCSI, "ENOCSI", "No CSI structure available"),
+#endif
+#if defined (EL2HLT)
+ ENTRY(EL2HLT, "EL2HLT", "Level 2 halted"),
+#endif
+#if defined (EDEADLK)
+ ENTRY(EDEADLK, "EDEADLK", "Deadlock condition"),
+#endif
+#if defined (ENOLCK)
+ ENTRY(ENOLCK, "ENOLCK", "No record locks available"),
+#endif
+#if defined (EBADE)
+ ENTRY(EBADE, "EBADE", "Invalid exchange"),
+#endif
+#if defined (EBADR)
+ ENTRY(EBADR, "EBADR", "Invalid request descriptor"),
+#endif
+#if defined (EXFULL)
+ ENTRY(EXFULL, "EXFULL", "Exchange full"),
+#endif
+#if defined (ENOANO)
+ ENTRY(ENOANO, "ENOANO", "No anode"),
+#endif
+#if defined (EBADRQC)
+ ENTRY(EBADRQC, "EBADRQC", "Invalid request code"),
+#endif
+#if defined (EBADSLT)
+ ENTRY(EBADSLT, "EBADSLT", "Invalid slot"),
+#endif
+#if defined (EDEADLOCK)
+ ENTRY(EDEADLOCK, "EDEADLOCK", "File locking deadlock error"),
+#endif
+#if defined (EBFONT)
+ ENTRY(EBFONT, "EBFONT", "Bad font file format"),
+#endif
+#if defined (ENOSTR)
+ ENTRY(ENOSTR, "ENOSTR", "Device not a stream"),
+#endif
+#if defined (ENODATA)
+ ENTRY(ENODATA, "ENODATA", "No data available"),
+#endif
+#if defined (ETIME)
+ ENTRY(ETIME, "ETIME", "Timer expired"),
+#endif
+#if defined (ENOSR)
+ ENTRY(ENOSR, "ENOSR", "Out of streams resources"),
+#endif
+#if defined (ENONET)
+ ENTRY(ENONET, "ENONET", "Machine is not on the network"),
+#endif
+#if defined (ENOPKG)
+ ENTRY(ENOPKG, "ENOPKG", "Package not installed"),
+#endif
+#if defined (EREMOTE)
+ ENTRY(EREMOTE, "EREMOTE", "Object is remote"),
+#endif
+#if defined (ENOLINK)
+ ENTRY(ENOLINK, "ENOLINK", "Link has been severed"),
+#endif
+#if defined (EADV)
+ ENTRY(EADV, "EADV", "Advertise error"),
+#endif
+#if defined (ESRMNT)
+ ENTRY(ESRMNT, "ESRMNT", "Srmount error"),
+#endif
+#if defined (ECOMM)
+ ENTRY(ECOMM, "ECOMM", "Communication error on send"),
+#endif
+#if defined (EPROTO)
+ ENTRY(EPROTO, "EPROTO", "Protocol error"),
+#endif
+#if defined (EMULTIHOP)
+ ENTRY(EMULTIHOP, "EMULTIHOP", "Multihop attempted"),
+#endif
+#if defined (EDOTDOT)
+ ENTRY(EDOTDOT, "EDOTDOT", "RFS specific error"),
+#endif
+#if defined (EBADMSG)
+ ENTRY(EBADMSG, "EBADMSG", "Not a data message"),
+#endif
+#if defined (ENAMETOOLONG)
+ ENTRY(ENAMETOOLONG, "ENAMETOOLONG", "File name too long"),
+#endif
+#if defined (EOVERFLOW)
+ ENTRY(EOVERFLOW, "EOVERFLOW", "Value too large for defined data type"),
+#endif
+#if defined (ENOTUNIQ)
+ ENTRY(ENOTUNIQ, "ENOTUNIQ", "Name not unique on network"),
+#endif
+#if defined (EBADFD)
+ ENTRY(EBADFD, "EBADFD", "File descriptor in bad state"),
+#endif
+#if defined (EREMCHG)
+ ENTRY(EREMCHG, "EREMCHG", "Remote address changed"),
+#endif
+#if defined (ELIBACC)
+ ENTRY(ELIBACC, "ELIBACC", "Can not access a needed shared library"),
+#endif
+#if defined (ELIBBAD)
+ ENTRY(ELIBBAD, "ELIBBAD", "Accessing a corrupted shared library"),
+#endif
+#if defined (ELIBSCN)
+ ENTRY(ELIBSCN, "ELIBSCN", ".lib section in a.out corrupted"),
+#endif
+#if defined (ELIBMAX)
+ ENTRY(ELIBMAX, "ELIBMAX", "Attempting to link in too many shared libraries"),
+#endif
+#if defined (ELIBEXEC)
+ ENTRY(ELIBEXEC, "ELIBEXEC", "Cannot exec a shared library directly"),
+#endif
+#if defined (EILSEQ)
+ ENTRY(EILSEQ, "EILSEQ", "Illegal byte sequence"),
+#endif
+#if defined (ENOSYS)
+ ENTRY(ENOSYS, "ENOSYS", "Operation not applicable"),
+#endif
+#if defined (ELOOP)
+ ENTRY(ELOOP, "ELOOP", "Too many symbolic links encountered"),
+#endif
+#if defined (ERESTART)
+ ENTRY(ERESTART, "ERESTART", "Interrupted system call should be restarted"),
+#endif
+#if defined (ESTRPIPE)
+ ENTRY(ESTRPIPE, "ESTRPIPE", "Streams pipe error"),
+#endif
+#if defined (ENOTEMPTY)
+ ENTRY(ENOTEMPTY, "ENOTEMPTY", "Directory not empty"),
+#endif
+#if defined (EUSERS)
+ ENTRY(EUSERS, "EUSERS", "Too many users"),
+#endif
+#if defined (ENOTSOCK)
+ ENTRY(ENOTSOCK, "ENOTSOCK", "Socket operation on non-socket"),
+#endif
+#if defined (EDESTADDRREQ)
+ ENTRY(EDESTADDRREQ, "EDESTADDRREQ", "Destination address required"),
+#endif
+#if defined (EMSGSIZE)
+ ENTRY(EMSGSIZE, "EMSGSIZE", "Message too long"),
+#endif
+#if defined (EPROTOTYPE)
+ ENTRY(EPROTOTYPE, "EPROTOTYPE", "Protocol wrong type for socket"),
+#endif
+#if defined (ENOPROTOOPT)
+ ENTRY(ENOPROTOOPT, "ENOPROTOOPT", "Protocol not available"),
+#endif
+#if defined (EPROTONOSUPPORT)
+ ENTRY(EPROTONOSUPPORT, "EPROTONOSUPPORT", "Protocol not supported"),
+#endif
+#if defined (ESOCKTNOSUPPORT)
+ ENTRY(ESOCKTNOSUPPORT, "ESOCKTNOSUPPORT", "Socket type not supported"),
+#endif
+#if defined (EOPNOTSUPP)
+ ENTRY(EOPNOTSUPP, "EOPNOTSUPP", "Operation not supported on transport endpoint"),
+#endif
+#if defined (EPFNOSUPPORT)
+ ENTRY(EPFNOSUPPORT, "EPFNOSUPPORT", "Protocol family not supported"),
+#endif
+#if defined (EAFNOSUPPORT)
+ ENTRY(EAFNOSUPPORT, "EAFNOSUPPORT", "Address family not supported by protocol"),
+#endif
+#if defined (EADDRINUSE)
+ ENTRY(EADDRINUSE, "EADDRINUSE", "Address already in use"),
+#endif
+#if defined (EADDRNOTAVAIL)
+ ENTRY(EADDRNOTAVAIL, "EADDRNOTAVAIL","Cannot assign requested address"),
+#endif
+#if defined (ENETDOWN)
+ ENTRY(ENETDOWN, "ENETDOWN", "Network is down"),
+#endif
+#if defined (ENETUNREACH)
+ ENTRY(ENETUNREACH, "ENETUNREACH", "Network is unreachable"),
+#endif
+#if defined (ENETRESET)
+ ENTRY(ENETRESET, "ENETRESET", "Network dropped connection because of reset"),
+#endif
+#if defined (ECONNABORTED)
+ ENTRY(ECONNABORTED, "ECONNABORTED", "Software caused connection abort"),
+#endif
+#if defined (ECONNRESET)
+ ENTRY(ECONNRESET, "ECONNRESET", "Connection reset by peer"),
+#endif
+#if defined (ENOBUFS)
+ ENTRY(ENOBUFS, "ENOBUFS", "No buffer space available"),
+#endif
+#if defined (EISCONN)
+ ENTRY(EISCONN, "EISCONN", "Transport endpoint is already connected"),
+#endif
+#if defined (ENOTCONN)
+ ENTRY(ENOTCONN, "ENOTCONN", "Transport endpoint is not connected"),
+#endif
+#if defined (ESHUTDOWN)
+ ENTRY(ESHUTDOWN, "ESHUTDOWN", "Cannot send after transport endpoint shutdown"),
+#endif
+#if defined (ETOOMANYREFS)
+ ENTRY(ETOOMANYREFS, "ETOOMANYREFS", "Too many references: cannot splice"),
+#endif
+#if defined (ETIMEDOUT)
+ ENTRY(ETIMEDOUT, "ETIMEDOUT", "Connection timed out"),
+#endif
+#if defined (ECONNREFUSED)
+ ENTRY(ECONNREFUSED, "ECONNREFUSED", "Connection refused"),
+#endif
+#if defined (EHOSTDOWN)
+ ENTRY(EHOSTDOWN, "EHOSTDOWN", "Host is down"),
+#endif
+#if defined (EHOSTUNREACH)
+ ENTRY(EHOSTUNREACH, "EHOSTUNREACH", "No route to host"),
+#endif
+#if defined (EALREADY)
+ ENTRY(EALREADY, "EALREADY", "Operation already in progress"),
+#endif
+#if defined (EINPROGRESS)
+ ENTRY(EINPROGRESS, "EINPROGRESS", "Operation now in progress"),
+#endif
+#if defined (ESTALE)
+ ENTRY(ESTALE, "ESTALE", "Stale NFS file handle"),
+#endif
+#if defined (EUCLEAN)
+ ENTRY(EUCLEAN, "EUCLEAN", "Structure needs cleaning"),
+#endif
+#if defined (ENOTNAM)
+ ENTRY(ENOTNAM, "ENOTNAM", "Not a XENIX named type file"),
+#endif
+#if defined (ENAVAIL)
+ ENTRY(ENAVAIL, "ENAVAIL", "No XENIX semaphores available"),
+#endif
+#if defined (EISNAM)
+ ENTRY(EISNAM, "EISNAM", "Is a named type file"),
+#endif
+#if defined (EREMOTEIO)
+ ENTRY(EREMOTEIO, "EREMOTEIO", "Remote I/O error"),
+#endif
+ ENTRY(0, NULL, NULL)
+};
+
+#ifdef EVMSERR
+/* This is not in the table, because the numeric value of EVMSERR (32767)
+ lies outside the range of sys_errlist[]. */
+static struct { int value; const char *name, *msg; }
+ evmserr = { EVMSERR, "EVMSERR", "VMS-specific error" };
+#endif
+
+/* Translation table allocated and initialized at runtime. Indexed by the
+ errno value to find the equivalent symbolic value. */
+
+static const char **error_names;
+static int num_error_names = 0;
+
+/* Translation table allocated and initialized at runtime, if it does not
+ already exist in the host environment. Indexed by the errno value to find
+ the descriptive string.
+
+ We don't export it for use in other modules because even though it has the
+ same name, it differs from other implementations in that it is dynamically
+ initialized rather than statically initialized. */
+
+#ifdef NEED_sys_errlist
+
+static int sys_nerr;
+static const char **sys_errlist;
+
+#else
+
+extern int sys_nerr;
+extern char *sys_errlist[];
+
+#endif
+
+
+/*
+
+NAME
+
+ init_error_tables -- initialize the name and message tables
+
+SYNOPSIS
+
+ static void init_error_tables ();
+
+DESCRIPTION
+
+ Using the error_table, which is initialized at compile time, generate
+ the error_names and the sys_errlist (if needed) tables, which are
+ indexed at runtime by a specific errno value.
+
+BUGS
+
+ The initialization of the tables may fail under low memory conditions,
+ in which case we don't do anything particularly useful, but we don't
+ bomb either. Who knows, it might succeed at a later point if we free
+ some memory in the meantime. In any case, the other routines know
+ how to deal with lack of a table after trying to initialize it. This
+ may or may not be considered to be a bug, that we don't specifically
+ warn about this particular failure mode.
+
+*/
+
+static void
+init_error_tables ()
+{
+ const struct error_info *eip;
+ int nbytes;
+
+ /* If we haven't already scanned the error_table once to find the maximum
+ errno value, then go find it now. */
+
+ if (num_error_names == 0)
+ {
+ for (eip = error_table; eip -> name != NULL; eip++)
+ {
+ if (eip -> value >= num_error_names)
+ {
+ num_error_names = eip -> value + 1;
+ }
+ }
+ }
+
+ /* Now attempt to allocate the error_names table, zero it out, and then
+ initialize it from the statically initialized error_table. */
+
+ if (error_names == NULL)
+ {
+ nbytes = num_error_names * sizeof (char *);
+ if ((error_names = (const char **) malloc (nbytes)) != NULL)
+ {
+ memset (error_names, 0, nbytes);
+ for (eip = error_table; eip -> name != NULL; eip++)
+ {
+ error_names[eip -> value] = eip -> name;
+ }
+ }
+ }
+
+#ifdef NEED_sys_errlist
+
+ /* Now attempt to allocate the sys_errlist table, zero it out, and then
+ initialize it from the statically initialized error_table. */
+
+ if (sys_errlist == NULL)
+ {
+ nbytes = num_error_names * sizeof (char *);
+ if ((sys_errlist = (const char **) malloc (nbytes)) != NULL)
+ {
+ memset (sys_errlist, 0, nbytes);
+ sys_nerr = num_error_names;
+ for (eip = error_table; eip -> name != NULL; eip++)
+ {
+ sys_errlist[eip -> value] = eip -> msg;
+ }
+ }
+ }
+
+#endif
+
+}
+
+/*
+
+NAME
+
+ errno_max -- return the max errno value
+
+SYNOPSIS
+
+ int errno_max ();
+
+DESCRIPTION
+
+ Returns the maximum errno value for which a corresponding symbolic
+ name or message is available. Note that in the case where
+ we use the sys_errlist supplied by the system, it is possible for
+ there to be more symbolic names than messages, or vice versa.
+ In fact, the manual page for perror(3C) explicitly warns that one
+ should check the size of the table (sys_nerr) before indexing it,
+ since new error codes may be added to the system before they are
+ added to the table. Thus sys_nerr might be smaller than value
+ implied by the largest errno value defined in <errno.h>.
+
+ We return the maximum value that can be used to obtain a meaningful
+ symbolic name or message.
+
+*/
+
+int
+errno_max ()
+{
+ int maxsize;
+
+ if (error_names == NULL)
+ {
+ init_error_tables ();
+ }
+ maxsize = MAX (sys_nerr, num_error_names);
+ return (maxsize - 1);
+}
+
+#ifdef NEED_strerror
+
+/*
+
+NAME
+
+ strerror -- map an error number to an error message string
+
+SYNOPSIS
+
+ char *strerror (int errnoval)
+
+DESCRIPTION
+
+ Maps an errno number to an error message string, the contents of
+ which are implementation defined. On systems which have the external
+ variables sys_nerr and sys_errlist, these strings will be the same
+ as the ones used by perror().
+
+ If the supplied error number is within the valid range of indices
+ for the sys_errlist, but no message is available for the particular
+ error number, then returns the string "Error NUM", where NUM is the
+ error number.
+
+ If the supplied error number is not a valid index into sys_errlist,
+ returns NULL.
+
+ The returned string is only guaranteed to be valid only until the
+ next call to strerror.
+
+*/
+
+char *
+strerror (errnoval)
+ int errnoval;
+{
+ char *msg;
+ static char buf[32];
+
+#ifdef NEED_sys_errlist
+
+ if (error_names == NULL)
+ {
+ init_error_tables ();
+ }
+
+#endif
+
+ if ((errnoval < 0) || (errnoval >= sys_nerr))
+ {
+#ifdef EVMSERR
+ if (errnoval == evmserr.value)
+ msg = evmserr.msg;
+ else
+#endif
+ /* Out of range, just return NULL */
+ msg = NULL;
+ }
+ else if ((sys_errlist == NULL) || (sys_errlist[errnoval] == NULL))
+ {
+ /* In range, but no sys_errlist or no entry at this index. */
+ sprintf (buf, "Error %d", errnoval);
+ msg = buf;
+ }
+ else
+ {
+ /* In range, and a valid message. Just return the message. */
+ msg = (char *) sys_errlist[errnoval];
+ }
+
+ return (msg);
+}
+
+#endif /* NEED_strerror */
+
+
+/*
+
+NAME
+
+ strerrno -- map an error number to a symbolic name string
+
+SYNOPSIS
+
+ const char *strerrno (int errnoval)
+
+DESCRIPTION
+
+ Given an error number returned from a system call (typically
+ returned in errno), returns a pointer to a string containing the
+ symbolic name of that error number, as found in <errno.h>.
+
+ If the supplied error number is within the valid range of indices
+ for symbolic names, but no name is available for the particular
+ error number, then returns the string "Error NUM", where NUM is
+ the error number.
+
+ If the supplied error number is not within the range of valid
+ indices, then returns NULL.
+
+BUGS
+
+ The contents of the location pointed to are only guaranteed to be
+ valid until the next call to strerrno.
+
+*/
+
+const char *
+strerrno (errnoval)
+ int errnoval;
+{
+ const char *name;
+ static char buf[32];
+
+ if (error_names == NULL)
+ {
+ init_error_tables ();
+ }
+
+ if ((errnoval < 0) || (errnoval >= num_error_names))
+ {
+#ifdef EVMSERR
+ if (errnoval == evmserr.value)
+ name = evmserr.name;
+ else
+#endif
+ /* Out of range, just return NULL */
+ name = NULL;
+ }
+ else if ((error_names == NULL) || (error_names[errnoval] == NULL))
+ {
+ /* In range, but no error_names or no entry at this index. */
+ sprintf (buf, "Error %d", errnoval);
+ name = (const char *) buf;
+ }
+ else
+ {
+ /* In range, and a valid name. Just return the name. */
+ name = error_names[errnoval];
+ }
+
+ return (name);
+}
+
+/*
+
+NAME
+
+ strtoerrno -- map a symbolic errno name to a numeric value
+
+SYNOPSIS
+
+ int strtoerrno (char *name)
+
+DESCRIPTION
+
+ Given the symbolic name of a error number, map it to an errno value.
+ If no translation is found, returns 0.
+
+*/
+
+int
+strtoerrno (name)
+ const char *name;
+{
+ int errnoval = 0;
+
+ if (name != NULL)
+ {
+ if (error_names == NULL)
+ {
+ init_error_tables ();
+ }
+ for (errnoval = 0; errnoval < num_error_names; errnoval++)
+ {
+ if ((error_names[errnoval] != NULL) &&
+ (strcmp (name, error_names[errnoval]) == 0))
+ {
+ break;
+ }
+ }
+ if (errnoval == num_error_names)
+ {
+#ifdef EVMSERR
+ if (strcmp (name, evmserr.name) == 0)
+ errnoval = evmserr.value;
+ else
+#endif
+ errnoval = 0;
+ }
+ }
+ return (errnoval);
+}
+
+
+/* A simple little main that does nothing but print all the errno translations
+ if MAIN is defined and this file is compiled and linked. */
+
+#ifdef MAIN
+
+#include <stdio.h>
+
+int
+main ()
+{
+ int errn;
+ int errnmax;
+ const char *name;
+ char *msg;
+ char *strerror ();
+
+ errnmax = errno_max ();
+ printf ("%d entries in names table.\n", num_error_names);
+ printf ("%d entries in messages table.\n", sys_nerr);
+ printf ("%d is max useful index.\n", errnmax);
+
+ /* Keep printing values until we get to the end of *both* tables, not
+ *either* table. Note that knowing the maximum useful index does *not*
+ relieve us of the responsibility of testing the return pointer for
+ NULL. */
+
+ for (errn = 0; errn <= errnmax; errn++)
+ {
+ name = strerrno (errn);
+ name = (name == NULL) ? "<NULL>" : name;
+ msg = strerror (errn);
+ msg = (msg == NULL) ? "<NULL>" : msg;
+ printf ("%-4d%-18s%s\n", errn, name, msg);
+ }
+
+ return 0;
+}
+
+#endif
diff --git a/libiberty/strncasecmp.c b/libiberty/strncasecmp.c
new file mode 100644
index 00000000000..4485cac7a6a
--- /dev/null
+++ b/libiberty/strncasecmp.c
@@ -0,0 +1,82 @@
+/*
+ * Copyright (c) 1987 Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that this notice is preserved and that due credit is given
+ * to the University of California at Berkeley. The name of the University
+ * may not be used to endorse or promote products derived from this
+ * software without specific written prior permission. This software
+ * is provided ``as is'' without express or implied warranty.
+ */
+
+#if defined(LIBC_SCCS) && !defined(lint)
+static char sccsid[] = "@(#)strcasecmp.c 5.5 (Berkeley) 11/24/87";
+#endif /* LIBC_SCCS and not lint */
+
+#include <ansidecl.h>
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#endif
+
+/*
+ * This array is designed for mapping upper and lower case letter
+ * together for a case independent comparison. The mappings are
+ * based upon ascii character sequences.
+ */
+static unsigned char charmap[] = {
+ '\000', '\001', '\002', '\003', '\004', '\005', '\006', '\007',
+ '\010', '\011', '\012', '\013', '\014', '\015', '\016', '\017',
+ '\020', '\021', '\022', '\023', '\024', '\025', '\026', '\027',
+ '\030', '\031', '\032', '\033', '\034', '\035', '\036', '\037',
+ '\040', '\041', '\042', '\043', '\044', '\045', '\046', '\047',
+ '\050', '\051', '\052', '\053', '\054', '\055', '\056', '\057',
+ '\060', '\061', '\062', '\063', '\064', '\065', '\066', '\067',
+ '\070', '\071', '\072', '\073', '\074', '\075', '\076', '\077',
+ '\100', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
+ '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
+ '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
+ '\170', '\171', '\172', '\133', '\134', '\135', '\136', '\137',
+ '\140', '\141', '\142', '\143', '\144', '\145', '\146', '\147',
+ '\150', '\151', '\152', '\153', '\154', '\155', '\156', '\157',
+ '\160', '\161', '\162', '\163', '\164', '\165', '\166', '\167',
+ '\170', '\171', '\172', '\173', '\174', '\175', '\176', '\177',
+ '\200', '\201', '\202', '\203', '\204', '\205', '\206', '\207',
+ '\210', '\211', '\212', '\213', '\214', '\215', '\216', '\217',
+ '\220', '\221', '\222', '\223', '\224', '\225', '\226', '\227',
+ '\230', '\231', '\232', '\233', '\234', '\235', '\236', '\237',
+ '\240', '\241', '\242', '\243', '\244', '\245', '\246', '\247',
+ '\250', '\251', '\252', '\253', '\254', '\255', '\256', '\257',
+ '\260', '\261', '\262', '\263', '\264', '\265', '\266', '\267',
+ '\270', '\271', '\272', '\273', '\274', '\275', '\276', '\277',
+ '\300', '\341', '\342', '\343', '\344', '\345', '\346', '\347',
+ '\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357',
+ '\360', '\361', '\362', '\363', '\364', '\365', '\366', '\367',
+ '\370', '\371', '\372', '\333', '\334', '\335', '\336', '\337',
+ '\340', '\341', '\342', '\343', '\344', '\345', '\346', '\347',
+ '\350', '\351', '\352', '\353', '\354', '\355', '\356', '\357',
+ '\360', '\361', '\362', '\363', '\364', '\365', '\366', '\367',
+ '\370', '\371', '\372', '\373', '\374', '\375', '\376', '\377',
+};
+
+int
+strncasecmp(s1, s2, n)
+ const char *s1, *s2;
+ register size_t n;
+{
+ register unsigned char u1, u2;
+
+ for (; n != 0; --n) {
+ u1 = (unsigned char) *s1++;
+ u2 = (unsigned char) *s2++;
+ if (charmap[u1] != charmap[u2]) {
+ return charmap[u1] - charmap[u2];
+ }
+ if (u1 == '\0') {
+ return 0;
+ }
+ }
+ return 0;
+}
diff --git a/libiberty/strrchr.c b/libiberty/strrchr.c
new file mode 100644
index 00000000000..30f9e8a3658
--- /dev/null
+++ b/libiberty/strrchr.c
@@ -0,0 +1,34 @@
+/* Portable version of strrchr().
+ This function is in the public domain. */
+
+/*
+NAME
+ strrchr -- return pointer to last occurance of a character
+
+SYNOPSIS
+ char *strrchr (const char *s, int c)
+
+DESCRIPTION
+ Returns a pointer to the last occurance of character C in
+ string S, or a NULL pointer if no occurance is found.
+
+BUGS
+ Behavior when character is the null character is implementation
+ dependent.
+*/
+
+#include <ansidecl.h>
+
+char *
+strrchr (s, c)
+ register CONST char *s;
+ int c;
+{
+ char *rtnval = 0;
+
+ do {
+ if (*s == c)
+ rtnval = (char*) s;
+ } while (*s++);
+ return (rtnval);
+}
diff --git a/libiberty/strsignal.c b/libiberty/strsignal.c
new file mode 100644
index 00000000000..7d40b4cedff
--- /dev/null
+++ b/libiberty/strsignal.c
@@ -0,0 +1,638 @@
+/* Extended support for using signal values.
+ Written by Fred Fish. fnf@cygnus.com
+ This file is in the public domain. */
+
+#include "ansidecl.h"
+#include "libiberty.h"
+
+#include "config.h"
+
+/* We need to declare sys_siglist, because even if the system provides
+ it we can't assume that it is declared in <signal.h> (for example,
+ SunOS provides sys_siglist, but it does not declare it in any
+ header file). fHowever, we can't declare sys_siglist portably,
+ because on some systems it is declared with const and on some
+ systems it is declared without const. If we were using autoconf,
+ we could work out the right declaration. Until, then we just
+ ignore any declaration in the system header files, and always
+ declare it ourselves. With luck, this will always work. */
+#define sys_siglist no_such_symbol
+
+#include <stdio.h>
+#include <signal.h>
+
+/* Routines imported from standard C runtime libraries. */
+
+#ifdef __STDC__
+#include <stddef.h>
+extern void *malloc (size_t size); /* 4.10.3.3 */
+extern void *memset (void *s, int c, size_t n); /* 4.11.6.1 */
+#else /* !__STDC__ */
+extern char *malloc (); /* Standard memory allocater */
+extern char *memset ();
+#endif /* __STDC__ */
+
+/* Undefine the macro we used to hide the definition of sys_siglist
+ found in the system header files. */
+#undef sys_siglist
+
+#ifndef NULL
+# ifdef __STDC__
+# define NULL (void *) 0
+# else
+# define NULL 0
+# endif
+#endif
+
+#ifndef MAX
+# define MAX(a,b) ((a) > (b) ? (a) : (b))
+#endif
+
+static void init_signal_tables PARAMS ((void));
+
+/* Translation table for signal values.
+
+ Note that this table is generally only accessed when it is used at runtime
+ to initialize signal name and message tables that are indexed by signal
+ value.
+
+ Not all of these signals will exist on all systems. This table is the only
+ thing that should have to be updated as new signal numbers are introduced.
+ It's sort of ugly, but at least its portable. */
+
+struct signal_info
+{
+ int value; /* The numeric value from <signal.h> */
+ const char *name; /* The equivalent symbolic value */
+#ifdef NEED_sys_siglist
+ const char *msg; /* Short message about this value */
+#endif
+};
+
+#ifdef NEED_sys_siglist
+# define ENTRY(value, name, msg) {value, name, msg}
+#else
+# define ENTRY(value, name, msg) {value, name}
+#endif
+
+static const struct signal_info signal_table[] =
+{
+#if defined (SIGHUP)
+ ENTRY(SIGHUP, "SIGHUP", "Hangup"),
+#endif
+#if defined (SIGINT)
+ ENTRY(SIGINT, "SIGINT", "Interrupt"),
+#endif
+#if defined (SIGQUIT)
+ ENTRY(SIGQUIT, "SIGQUIT", "Quit"),
+#endif
+#if defined (SIGILL)
+ ENTRY(SIGILL, "SIGILL", "Illegal instruction"),
+#endif
+#if defined (SIGTRAP)
+ ENTRY(SIGTRAP, "SIGTRAP", "Trace/breakpoint trap"),
+#endif
+/* Put SIGIOT before SIGABRT, so that if SIGIOT==SIGABRT then SIGABRT
+ overrides SIGIOT. SIGABRT is in ANSI and POSIX.1, and SIGIOT isn't. */
+#if defined (SIGIOT)
+ ENTRY(SIGIOT, "SIGIOT", "IOT trap"),
+#endif
+#if defined (SIGABRT)
+ ENTRY(SIGABRT, "SIGABRT", "Aborted"),
+#endif
+#if defined (SIGEMT)
+ ENTRY(SIGEMT, "SIGEMT", "Emulation trap"),
+#endif
+#if defined (SIGFPE)
+ ENTRY(SIGFPE, "SIGFPE", "Arithmetic exception"),
+#endif
+#if defined (SIGKILL)
+ ENTRY(SIGKILL, "SIGKILL", "Killed"),
+#endif
+#if defined (SIGBUS)
+ ENTRY(SIGBUS, "SIGBUS", "Bus error"),
+#endif
+#if defined (SIGSEGV)
+ ENTRY(SIGSEGV, "SIGSEGV", "Segmentation fault"),
+#endif
+#if defined (SIGSYS)
+ ENTRY(SIGSYS, "SIGSYS", "Bad system call"),
+#endif
+#if defined (SIGPIPE)
+ ENTRY(SIGPIPE, "SIGPIPE", "Broken pipe"),
+#endif
+#if defined (SIGALRM)
+ ENTRY(SIGALRM, "SIGALRM", "Alarm clock"),
+#endif
+#if defined (SIGTERM)
+ ENTRY(SIGTERM, "SIGTERM", "Terminated"),
+#endif
+#if defined (SIGUSR1)
+ ENTRY(SIGUSR1, "SIGUSR1", "User defined signal 1"),
+#endif
+#if defined (SIGUSR2)
+ ENTRY(SIGUSR2, "SIGUSR2", "User defined signal 2"),
+#endif
+/* Put SIGCLD before SIGCHLD, so that if SIGCLD==SIGCHLD then SIGCHLD
+ overrides SIGCLD. SIGCHLD is in POXIX.1 */
+#if defined (SIGCLD)
+ ENTRY(SIGCLD, "SIGCLD", "Child status changed"),
+#endif
+#if defined (SIGCHLD)
+ ENTRY(SIGCHLD, "SIGCHLD", "Child status changed"),
+#endif
+#if defined (SIGPWR)
+ ENTRY(SIGPWR, "SIGPWR", "Power fail/restart"),
+#endif
+#if defined (SIGWINCH)
+ ENTRY(SIGWINCH, "SIGWINCH", "Window size changed"),
+#endif
+#if defined (SIGURG)
+ ENTRY(SIGURG, "SIGURG", "Urgent I/O condition"),
+#endif
+#if defined (SIGIO)
+ /* "I/O pending" has also been suggested, but is misleading since the
+ signal only happens when the process has asked for it, not everytime
+ I/O is pending. */
+ ENTRY(SIGIO, "SIGIO", "I/O possible"),
+#endif
+#if defined (SIGPOLL)
+ ENTRY(SIGPOLL, "SIGPOLL", "Pollable event occurred"),
+#endif
+#if defined (SIGSTOP)
+ ENTRY(SIGSTOP, "SIGSTOP", "Stopped (signal)"),
+#endif
+#if defined (SIGTSTP)
+ ENTRY(SIGTSTP, "SIGTSTP", "Stopped (user)"),
+#endif
+#if defined (SIGCONT)
+ ENTRY(SIGCONT, "SIGCONT", "Continued"),
+#endif
+#if defined (SIGTTIN)
+ ENTRY(SIGTTIN, "SIGTTIN", "Stopped (tty input)"),
+#endif
+#if defined (SIGTTOU)
+ ENTRY(SIGTTOU, "SIGTTOU", "Stopped (tty output)"),
+#endif
+#if defined (SIGVTALRM)
+ ENTRY(SIGVTALRM, "SIGVTALRM", "Virtual timer expired"),
+#endif
+#if defined (SIGPROF)
+ ENTRY(SIGPROF, "SIGPROF", "Profiling timer expired"),
+#endif
+#if defined (SIGXCPU)
+ ENTRY(SIGXCPU, "SIGXCPU", "CPU time limit exceeded"),
+#endif
+#if defined (SIGXFSZ)
+ ENTRY(SIGXFSZ, "SIGXFSZ", "File size limit exceeded"),
+#endif
+#if defined (SIGWIND)
+ ENTRY(SIGWIND, "SIGWIND", "SIGWIND"),
+#endif
+#if defined (SIGPHONE)
+ ENTRY(SIGPHONE, "SIGPHONE", "SIGPHONE"),
+#endif
+#if defined (SIGLOST)
+ ENTRY(SIGLOST, "SIGLOST", "Resource lost"),
+#endif
+#if defined (SIGWAITING)
+ ENTRY(SIGWAITING, "SIGWAITING", "Process's LWPs are blocked"),
+#endif
+#if defined (SIGLWP)
+ ENTRY(SIGLWP, "SIGLWP", "Signal LWP"),
+#endif
+#if defined (SIGDANGER)
+ ENTRY(SIGDANGER, "SIGDANGER", "Swap space dangerously low"),
+#endif
+#if defined (SIGGRANT)
+ ENTRY(SIGGRANT, "SIGGRANT", "Monitor mode granted"),
+#endif
+#if defined (SIGRETRACT)
+ ENTRY(SIGRETRACT, "SIGRETRACT", "Need to relinguish monitor mode"),
+#endif
+#if defined (SIGMSG)
+ ENTRY(SIGMSG, "SIGMSG", "Monitor mode data available"),
+#endif
+#if defined (SIGSOUND)
+ ENTRY(SIGSOUND, "SIGSOUND", "Sound completed"),
+#endif
+#if defined (SIGSAK)
+ ENTRY(SIGSAK, "SIGSAK", "Secure attention"),
+#endif
+ ENTRY(0, NULL, NULL)
+};
+
+/* Translation table allocated and initialized at runtime. Indexed by the
+ signal value to find the equivalent symbolic value. */
+
+static const char **signal_names;
+static int num_signal_names = 0;
+
+/* Translation table allocated and initialized at runtime, if it does not
+ already exist in the host environment. Indexed by the signal value to find
+ the descriptive string.
+
+ We don't export it for use in other modules because even though it has the
+ same name, it differs from other implementations in that it is dynamically
+ initialized rather than statically initialized. */
+
+#ifdef NEED_sys_siglist
+
+static int sys_nsig;
+static const char **sys_siglist;
+
+#else
+
+static int sys_nsig = NSIG;
+extern const char * const sys_siglist[];
+
+#endif
+
+
+/*
+
+NAME
+
+ init_signal_tables -- initialize the name and message tables
+
+SYNOPSIS
+
+ static void init_signal_tables ();
+
+DESCRIPTION
+
+ Using the signal_table, which is initialized at compile time, generate
+ the signal_names and the sys_siglist (if needed) tables, which are
+ indexed at runtime by a specific signal value.
+
+BUGS
+
+ The initialization of the tables may fail under low memory conditions,
+ in which case we don't do anything particularly useful, but we don't
+ bomb either. Who knows, it might succeed at a later point if we free
+ some memory in the meantime. In any case, the other routines know
+ how to deal with lack of a table after trying to initialize it. This
+ may or may not be considered to be a bug, that we don't specifically
+ warn about this particular failure mode.
+
+*/
+
+static void
+init_signal_tables ()
+{
+ const struct signal_info *eip;
+ int nbytes;
+
+ /* If we haven't already scanned the signal_table once to find the maximum
+ signal value, then go find it now. */
+
+ if (num_signal_names == 0)
+ {
+ for (eip = signal_table; eip -> name != NULL; eip++)
+ {
+ if (eip -> value >= num_signal_names)
+ {
+ num_signal_names = eip -> value + 1;
+ }
+ }
+ }
+
+ /* Now attempt to allocate the signal_names table, zero it out, and then
+ initialize it from the statically initialized signal_table. */
+
+ if (signal_names == NULL)
+ {
+ nbytes = num_signal_names * sizeof (char *);
+ if ((signal_names = (const char **) malloc (nbytes)) != NULL)
+ {
+ memset (signal_names, 0, nbytes);
+ for (eip = signal_table; eip -> name != NULL; eip++)
+ {
+ signal_names[eip -> value] = eip -> name;
+ }
+ }
+ }
+
+#ifdef NEED_sys_siglist
+
+ /* Now attempt to allocate the sys_siglist table, zero it out, and then
+ initialize it from the statically initialized signal_table. */
+
+ if (sys_siglist == NULL)
+ {
+ nbytes = num_signal_names * sizeof (char *);
+ if ((sys_siglist = (const char **) malloc (nbytes)) != NULL)
+ {
+ memset (sys_siglist, 0, nbytes);
+ sys_nsig = num_signal_names;
+ for (eip = signal_table; eip -> name != NULL; eip++)
+ {
+ sys_siglist[eip -> value] = eip -> msg;
+ }
+ }
+ }
+
+#endif
+
+}
+
+
+/*
+
+NAME
+
+ signo_max -- return the max signo value
+
+SYNOPSIS
+
+ int signo_max ();
+
+DESCRIPTION
+
+ Returns the maximum signo value for which a corresponding symbolic
+ name or message is available. Note that in the case where
+ we use the sys_siglist supplied by the system, it is possible for
+ there to be more symbolic names than messages, or vice versa.
+ In fact, the manual page for psignal(3b) explicitly warns that one
+ should check the size of the table (NSIG) before indexing it,
+ since new signal codes may be added to the system before they are
+ added to the table. Thus NSIG might be smaller than value
+ implied by the largest signo value defined in <signal.h>.
+
+ We return the maximum value that can be used to obtain a meaningful
+ symbolic name or message.
+
+*/
+
+int
+signo_max ()
+{
+ int maxsize;
+
+ if (signal_names == NULL)
+ {
+ init_signal_tables ();
+ }
+ maxsize = MAX (sys_nsig, num_signal_names);
+ return (maxsize - 1);
+}
+
+
+/*
+
+NAME
+
+ strsignal -- map a signal number to a signal message string
+
+SYNOPSIS
+
+ const char *strsignal (int signo)
+
+DESCRIPTION
+
+ Maps an signal number to an signal message string, the contents of
+ which are implementation defined. On systems which have the external
+ variable sys_siglist, these strings will be the same as the ones used
+ by psignal().
+
+ If the supplied signal number is within the valid range of indices
+ for the sys_siglist, but no message is available for the particular
+ signal number, then returns the string "Signal NUM", where NUM is the
+ signal number.
+
+ If the supplied signal number is not a valid index into sys_siglist,
+ returns NULL.
+
+ The returned string is only guaranteed to be valid only until the
+ next call to strsignal.
+
+*/
+
+#ifdef NEED_strsignal
+
+const char *
+strsignal (signo)
+ int signo;
+{
+ const char *msg;
+ static char buf[32];
+
+#ifdef NEED_sys_siglist
+
+ if (signal_names == NULL)
+ {
+ init_signal_tables ();
+ }
+
+#endif
+
+ if ((signo < 0) || (signo >= sys_nsig))
+ {
+ /* Out of range, just return NULL */
+ msg = NULL;
+ }
+ else if ((sys_siglist == NULL) || (sys_siglist[signo] == NULL))
+ {
+ /* In range, but no sys_siglist or no entry at this index. */
+ sprintf (buf, "Signal %d", signo);
+ msg = (const char *) buf;
+ }
+ else
+ {
+ /* In range, and a valid message. Just return the message. */
+ msg = (const char *) sys_siglist[signo];
+ }
+
+ return (msg);
+}
+
+#endif /* NEED_strsignal */
+
+/*
+
+NAME
+
+ strsigno -- map an signal number to a symbolic name string
+
+SYNOPSIS
+
+ const char *strsigno (int signo)
+
+DESCRIPTION
+
+ Given an signal number, returns a pointer to a string containing
+ the symbolic name of that signal number, as found in <signal.h>.
+
+ If the supplied signal number is within the valid range of indices
+ for symbolic names, but no name is available for the particular
+ signal number, then returns the string "Signal NUM", where NUM is
+ the signal number.
+
+ If the supplied signal number is not within the range of valid
+ indices, then returns NULL.
+
+BUGS
+
+ The contents of the location pointed to are only guaranteed to be
+ valid until the next call to strsigno.
+
+*/
+
+const char *
+strsigno (signo)
+ int signo;
+{
+ const char *name;
+ static char buf[32];
+
+ if (signal_names == NULL)
+ {
+ init_signal_tables ();
+ }
+
+ if ((signo < 0) || (signo >= num_signal_names))
+ {
+ /* Out of range, just return NULL */
+ name = NULL;
+ }
+ else if ((signal_names == NULL) || (signal_names[signo] == NULL))
+ {
+ /* In range, but no signal_names or no entry at this index. */
+ sprintf (buf, "Signal %d", signo);
+ name = (const char *) buf;
+ }
+ else
+ {
+ /* In range, and a valid name. Just return the name. */
+ name = signal_names[signo];
+ }
+
+ return (name);
+}
+
+
+/*
+
+NAME
+
+ strtosigno -- map a symbolic signal name to a numeric value
+
+SYNOPSIS
+
+ int strtosigno (char *name)
+
+DESCRIPTION
+
+ Given the symbolic name of a signal, map it to a signal number.
+ If no translation is found, returns 0.
+
+*/
+
+int
+strtosigno (name)
+ const char *name;
+{
+ int signo = 0;
+
+ if (name != NULL)
+ {
+ if (signal_names == NULL)
+ {
+ init_signal_tables ();
+ }
+ for (signo = 0; signo < num_signal_names; signo++)
+ {
+ if ((signal_names[signo] != NULL) &&
+ (strcmp (name, signal_names[signo]) == 0))
+ {
+ break;
+ }
+ }
+ if (signo == num_signal_names)
+ {
+ signo = 0;
+ }
+ }
+ return (signo);
+}
+
+
+/*
+
+NAME
+
+ psignal -- print message about signal to stderr
+
+SYNOPSIS
+
+ void psignal (unsigned signo, char *message);
+
+DESCRIPTION
+
+ Print to the standard error the message, followed by a colon,
+ followed by the description of the signal specified by signo,
+ followed by a newline.
+*/
+
+#ifdef NEED_psignal
+
+void
+psignal (signo, message)
+ unsigned signo;
+ char *message;
+{
+ if (signal_names == NULL)
+ {
+ init_signal_tables ();
+ }
+ if ((signo <= 0) || (signo >= sys_nsig))
+ {
+ fprintf (stderr, "%s: unknown signal\n", message);
+ }
+ else
+ {
+ fprintf (stderr, "%s: %s\n", message, sys_siglist[signo]);
+ }
+}
+
+#endif /* NEED_psignal */
+
+
+/* A simple little main that does nothing but print all the signal translations
+ if MAIN is defined and this file is compiled and linked. */
+
+#ifdef MAIN
+
+#include <stdio.h>
+
+int
+main ()
+{
+ int signo;
+ int maxsigno;
+ const char *name;
+ const char *msg;
+
+ maxsigno = signo_max ();
+ printf ("%d entries in names table.\n", num_signal_names);
+ printf ("%d entries in messages table.\n", sys_nsig);
+ printf ("%d is max useful index.\n", maxsigno);
+
+ /* Keep printing values until we get to the end of *both* tables, not
+ *either* table. Note that knowing the maximum useful index does *not*
+ relieve us of the responsibility of testing the return pointer for
+ NULL. */
+
+ for (signo = 0; signo <= maxsigno; signo++)
+ {
+ name = strsigno (signo);
+ name = (name == NULL) ? "<NULL>" : name;
+ msg = strsignal (signo);
+ msg = (msg == NULL) ? "<NULL>" : msg;
+ printf ("%-4d%-18s%s\n", signo, name, msg);
+ }
+
+ return 0;
+}
+
+#endif
diff --git a/libiberty/strstr.c b/libiberty/strstr.c
new file mode 100644
index 00000000000..fab36e3fb3d
--- /dev/null
+++ b/libiberty/strstr.c
@@ -0,0 +1,51 @@
+/* Simple implementation of strstr for systems without it.
+ This function is in the public domain. */
+
+/*
+
+NAME
+
+ strstr -- locate first occurance of a substring
+
+SYNOPSIS
+
+ #include <string.h>
+
+ char *strstr (char *s1, char *s2)
+
+DESCRIPTION
+
+ Locates the first occurance in the string pointed to by S1 of
+ the string pointed to by S2. Returns a pointer to the substring
+ found, or a NULL pointer if not found. If S2 points to a string
+ with zero length, the function returns S1.
+
+BUGS
+
+*/
+
+
+/* FIXME: The above description is ANSI compiliant. This routine has not
+ been validated to comply with it. -fnf */
+
+char *
+strstr (s1, s2)
+ char *s1, *s2;
+{
+ register char *p = s1;
+ extern char *strchr ();
+ extern int strncmp ();
+#if __GNUC__==2
+ extern __SIZE_TYPE__ strlen ();
+#endif
+ register int len = strlen (s2);
+
+ for (; (p = strchr (p, *s2)) != 0; p++)
+ {
+ if (strncmp (p, s2, len) == 0)
+ {
+ return (p);
+ }
+ }
+ return (0);
+}
diff --git a/libiberty/strtod.c b/libiberty/strtod.c
new file mode 100644
index 00000000000..c86c73de9b3
--- /dev/null
+++ b/libiberty/strtod.c
@@ -0,0 +1,122 @@
+/* Implementation of strtod for systems with atof.
+ Copyright (C) 1991, 1995 Free Software Foundation, Inc.
+
+This file is part of the libiberty 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING. If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <ctype.h>
+
+extern double atof ();
+
+/* Disclaimer: this is currently just used by CHILL in GDB and therefore
+ has not been tested well. It may have been tested for nothing except
+ that it compiles. */
+
+double
+strtod (str, ptr)
+ char *str;
+ char **ptr;
+{
+ char *p;
+
+ if (ptr == (char **)0)
+ return atof (str);
+
+ p = str;
+
+ while (isspace (*p))
+ ++p;
+
+ if (*p == '+' || *p == '-')
+ ++p;
+
+ /* INF or INFINITY. */
+ if ((p[0] == 'i' || p[0] == 'I')
+ && (p[1] == 'n' || p[1] == 'N')
+ && (p[2] == 'f' || p[2] == 'F'))
+ {
+ if ((p[3] == 'i' || p[3] == 'I')
+ && (p[4] == 'n' || p[4] == 'N')
+ && (p[5] == 'i' || p[5] == 'I')
+ && (p[6] == 't' || p[6] == 'T')
+ && (p[7] == 'y' || p[7] == 'Y'))
+ {
+ *ptr = p + 7;
+ return atof (str);
+ }
+ else
+ {
+ *ptr = p + 3;
+ return atof (str);
+ }
+ }
+
+ /* NAN or NAN(foo). */
+ if ((p[0] == 'n' || p[0] == 'N')
+ && (p[1] == 'a' || p[1] == 'A')
+ && (p[2] == 'n' || p[2] == 'N'))
+ {
+ p += 3;
+ if (*p == '(')
+ {
+ ++p;
+ while (*p != '\0' && *p != ')')
+ ++p;
+ if (*p == ')')
+ ++p;
+ }
+ *ptr = p;
+ return atof (str);
+ }
+
+ /* digits, with 0 or 1 periods in it. */
+ if (isdigit (*p) || *p == '.')
+ {
+ int got_dot = 0;
+ while (isdigit (*p) || (!got_dot && *p == '.'))
+ {
+ if (*p == '.')
+ got_dot = 1;
+ ++p;
+ }
+
+ /* Exponent. */
+ if (*p == 'e' || *p == 'E')
+ {
+ int i;
+ i = 1;
+ if (p[i] == '+' || p[i] == '-')
+ ++i;
+ if (isdigit (p[i]))
+ {
+ while (isdigit (p[i]))
+ ++i;
+ *ptr = p + i;
+ return atof (str);
+ }
+ }
+ *ptr = p;
+ return atof (str);
+ }
+ /* Didn't find any digits. Doesn't look like a number. */
+ *ptr = str;
+ return 0.0;
+}
diff --git a/libiberty/strtol.c b/libiberty/strtol.c
new file mode 100644
index 00000000000..db27ee0a875
--- /dev/null
+++ b/libiberty/strtol.c
@@ -0,0 +1,143 @@
+/*-
+ * Copyright (c) 1990 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ * must display the following acknowledgement:
+ * This product includes software developed by the University of
+ * California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include <limits.h>
+#include <ctype.h>
+#include <errno.h>
+#if 0
+#include <stdlib.h>
+#endif
+#include "ansidecl.h"
+
+/* FIXME: It'd be nice to configure around these, but the include files are too
+ painful. These macros should at least be more portable than hardwired hex
+ constants. */
+
+#ifndef ULONG_MAX
+#define ULONG_MAX ((unsigned long)(~0L)) /* 0xFFFFFFFF */
+#endif
+
+#ifndef LONG_MAX
+#define LONG_MAX ((long)(ULONG_MAX >> 1)) /* 0x7FFFFFFF */
+#endif
+
+#ifndef LONG_MIN
+#define LONG_MIN ((long)(~LONG_MAX)) /* 0x80000000 */
+#endif
+
+/*
+ * Convert a string to a long integer.
+ *
+ * Ignores `locale' stuff. Assumes that the upper and lower case
+ * alphabets and digits are each contiguous.
+ */
+long
+strtol(nptr, endptr, base)
+ CONST char *nptr;
+ char **endptr;
+ register int base;
+{
+ register CONST char *s = nptr;
+ register unsigned long acc;
+ register int c;
+ register unsigned long cutoff;
+ register int neg = 0, any, cutlim;
+
+ /*
+ * Skip white space and pick up leading +/- sign if any.
+ * If base is 0, allow 0x for hex and 0 for octal, else
+ * assume decimal; if base is already 16, allow 0x.
+ */
+ do {
+ c = *s++;
+ } while (isspace(c));
+ if (c == '-') {
+ neg = 1;
+ c = *s++;
+ } else if (c == '+')
+ c = *s++;
+ if ((base == 0 || base == 16) &&
+ c == '0' && (*s == 'x' || *s == 'X')) {
+ c = s[1];
+ s += 2;
+ base = 16;
+ }
+ if (base == 0)
+ base = c == '0' ? 8 : 10;
+
+ /*
+ * Compute the cutoff value between legal numbers and illegal
+ * numbers. That is the largest legal value, divided by the
+ * base. An input number that is greater than this value, if
+ * followed by a legal input character, is too big. One that
+ * is equal to this value may be valid or not; the limit
+ * between valid and invalid numbers is then based on the last
+ * digit. For instance, if the range for longs is
+ * [-2147483648..2147483647] and the input base is 10,
+ * cutoff will be set to 214748364 and cutlim to either
+ * 7 (neg==0) or 8 (neg==1), meaning that if we have accumulated
+ * a value > 214748364, or equal but the next digit is > 7 (or 8),
+ * the number is too big, and we will return a range error.
+ *
+ * Set any if any `digits' consumed; make it negative to indicate
+ * overflow.
+ */
+ cutoff = neg ? -(unsigned long)LONG_MIN : LONG_MAX;
+ cutlim = cutoff % (unsigned long)base;
+ cutoff /= (unsigned long)base;
+ for (acc = 0, any = 0;; c = *s++) {
+ if (isdigit(c))
+ c -= '0';
+ else if (isalpha(c))
+ c -= isupper(c) ? 'A' - 10 : 'a' - 10;
+ else
+ break;
+ if (c >= base)
+ break;
+ if (any < 0 || acc > cutoff || acc == cutoff && c > cutlim)
+ any = -1;
+ else {
+ any = 1;
+ acc *= base;
+ acc += c;
+ }
+ }
+ if (any < 0) {
+ acc = neg ? LONG_MIN : LONG_MAX;
+ errno = ERANGE;
+ } else if (neg)
+ acc = -acc;
+ if (endptr != 0)
+ *endptr = (char *) (any ? s - 1 : nptr);
+ return (acc);
+}
diff --git a/libiberty/strtoul.c b/libiberty/strtoul.c
new file mode 100644
index 00000000000..40902452fed
--- /dev/null
+++ b/libiberty/strtoul.c
@@ -0,0 +1,110 @@
+/*
+ * Copyright (c) 1990 Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ * must display the following acknowledgement:
+ * This product includes software developed by the University of
+ * California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include <limits.h>
+#include <ctype.h>
+#include <errno.h>
+#if 0
+#include <stdlib.h>
+#endif
+#include "ansidecl.h"
+
+#ifndef ULONG_MAX
+#define ULONG_MAX ((unsigned long)(~0L)) /* 0xFFFFFFFF */
+#endif
+
+/*
+ * Convert a string to an unsigned long integer.
+ *
+ * Ignores `locale' stuff. Assumes that the upper and lower case
+ * alphabets and digits are each contiguous.
+ */
+unsigned long
+strtoul(nptr, endptr, base)
+ CONST char *nptr;
+ char **endptr;
+ register int base;
+{
+ register CONST char *s = nptr;
+ register unsigned long acc;
+ register int c;
+ register unsigned long cutoff;
+ register int neg = 0, any, cutlim;
+
+ /*
+ * See strtol for comments as to the logic used.
+ */
+ do {
+ c = *s++;
+ } while (isspace(c));
+ if (c == '-') {
+ neg = 1;
+ c = *s++;
+ } else if (c == '+')
+ c = *s++;
+ if ((base == 0 || base == 16) &&
+ c == '0' && (*s == 'x' || *s == 'X')) {
+ c = s[1];
+ s += 2;
+ base = 16;
+ }
+ if (base == 0)
+ base = c == '0' ? 8 : 10;
+ cutoff = (unsigned long)ULONG_MAX / (unsigned long)base;
+ cutlim = (unsigned long)ULONG_MAX % (unsigned long)base;
+ for (acc = 0, any = 0;; c = *s++) {
+ if (isdigit(c))
+ c -= '0';
+ else if (isalpha(c))
+ c -= isupper(c) ? 'A' - 10 : 'a' - 10;
+ else
+ break;
+ if (c >= base)
+ break;
+ if (any < 0 || acc > cutoff || acc == cutoff && c > cutlim)
+ any = -1;
+ else {
+ any = 1;
+ acc *= base;
+ acc += c;
+ }
+ }
+ if (any < 0) {
+ acc = ULONG_MAX;
+ errno = ERANGE;
+ } else if (neg)
+ acc = -acc;
+ if (endptr != 0)
+ *endptr = (char *) (any ? s - 1 : nptr);
+ return (acc);
+}
diff --git a/libiberty/tmpnam.c b/libiberty/tmpnam.c
new file mode 100644
index 00000000000..c0614677425
--- /dev/null
+++ b/libiberty/tmpnam.c
@@ -0,0 +1,39 @@
+#include <stdio.h>
+
+#ifndef L_tmpnam
+#define L_tmpname 100
+#endif
+#ifndef P_tmpdir
+#define P_tmpdir "/usr/tmp"
+#endif
+
+static char tmpnam_buffer[L_tmpnam];
+static int tmpnam_counter;
+
+extern int getpid ();
+
+char *
+tmpnam (s)
+ char *s;
+{
+ int pid = getpid ();
+
+ if (s == NULL)
+ s = tmpnam_buffer;
+
+ /* Generate the filename and make sure that there isn't one called
+ it already. */
+
+ while (1)
+ {
+ FILE *f;
+ sprintf (s, "%s/%s%x.%x", P_tmpdir, "t", pid, tmpnam_counter);
+ f = fopen (s, "r");
+ if (f == NULL)
+ break;
+ tmpnam_counter++;
+ fclose (f);
+ }
+
+ return s;
+}
diff --git a/libiberty/vasprintf.c b/libiberty/vasprintf.c
new file mode 100644
index 00000000000..3794cbd2c4f
--- /dev/null
+++ b/libiberty/vasprintf.c
@@ -0,0 +1,165 @@
+/* Like vsprintf but provides a pointer to malloc'd storage, which must
+ be freed by the caller.
+ Copyright (C) 1994 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 <stdio.h>
+#include <string.h>
+#include <ansidecl.h>
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+#ifdef TEST
+int global_total_width;
+#endif
+
+unsigned long strtoul ();
+char *malloc ();
+
+static int
+int_vasprintf (result, format, args)
+ char **result;
+ const char *format;
+ va_list *args;
+{
+ const char *p = format;
+ /* Add one to make sure that it is never zero, which might cause malloc
+ to return NULL. */
+ int total_width = strlen (format) + 1;
+ va_list ap;
+
+ memcpy ((PTR) &ap, (PTR) args, sizeof (va_list));
+
+ while (*p != '\0')
+ {
+ if (*p++ == '%')
+ {
+ while (strchr ("-+ #0", *p))
+ ++p;
+ if (*p == '*')
+ {
+ ++p;
+ total_width += abs (va_arg (ap, int));
+ }
+ else
+ total_width += strtoul (p, &p, 10);
+ if (*p == '.')
+ {
+ ++p;
+ if (*p == '*')
+ {
+ ++p;
+ total_width += abs (va_arg (ap, int));
+ }
+ else
+ total_width += strtoul (p, &p, 10);
+ }
+ while (strchr ("hlL", *p))
+ ++p;
+ /* Should be big enough for any format specifier except %s. */
+ total_width += 30;
+ switch (*p)
+ {
+ case 'd':
+ case 'i':
+ case 'o':
+ case 'u':
+ case 'x':
+ case 'X':
+ case 'c':
+ (void) va_arg (ap, int);
+ break;
+ case 'f':
+ case 'e':
+ case 'E':
+ case 'g':
+ case 'G':
+ (void) va_arg (ap, double);
+ break;
+ case 's':
+ total_width += strlen (va_arg (ap, char *));
+ break;
+ case 'p':
+ case 'n':
+ (void) va_arg (ap, char *);
+ break;
+ }
+ }
+ }
+#ifdef TEST
+ global_total_width = total_width;
+#endif
+ *result = malloc (total_width);
+ if (*result != NULL)
+ return vsprintf (*result, format, *args);
+ else
+ return 0;
+}
+
+int
+vasprintf (result, format, args)
+ char **result;
+ const char *format;
+ va_list args;
+{
+ return int_vasprintf (result, format, &args);
+}
+
+#ifdef TEST
+void
+checkit
+#ifdef __STDC__
+ (const char* format, ...)
+#else
+ (va_alist)
+ va_dcl
+#endif
+{
+ va_list args;
+ char *result;
+
+#ifdef __STDC__
+ va_start (args, format);
+#else
+ char *format;
+ va_start (args);
+ format = va_arg (args, char *);
+#endif
+ vasprintf (&result, format, args);
+ if (strlen (result) < global_total_width)
+ printf ("PASS: ");
+ else
+ printf ("FAIL: ");
+ printf ("%d %s\n", global_total_width, result);
+}
+
+int
+main ()
+{
+ checkit ("%d", 0x12345678);
+ checkit ("%200d", 5);
+ checkit ("%.300d", 6);
+ checkit ("%100.150d", 7);
+ checkit ("%s", "jjjjjjjjjiiiiiiiiiiiiiiioooooooooooooooooppppppppppppaa\n\
+777777777777777777333333333333366666666666622222222222777777777777733333");
+ checkit ("%f%s%d%s", 1.0, "foo", 77, "asdjffffffffffffffiiiiiiiiiiixxxxx");
+}
+#endif /* TEST */
diff --git a/libiberty/vfork.c b/libiberty/vfork.c
new file mode 100644
index 00000000000..86c45919f66
--- /dev/null
+++ b/libiberty/vfork.c
@@ -0,0 +1,8 @@
+/* Emulate vfork using just plain fork, for systems without a real vfork.
+ This function is in the public domain. */
+
+int
+vfork ()
+{
+ return (fork ());
+}
diff --git a/libiberty/vfprintf.c b/libiberty/vfprintf.c
new file mode 100644
index 00000000000..ce3fdf9c474
--- /dev/null
+++ b/libiberty/vfprintf.c
@@ -0,0 +1,13 @@
+#include <stdio.h>
+#include <varargs.h>
+#include <ansidecl.h>
+#undef vfprintf
+
+int
+vfprintf (file, format, ap)
+ FILE *file;
+ const char *format;
+ va_list ap;
+{
+ return _doprnt (format, ap, file);
+}
diff --git a/libiberty/vmsbuild.com b/libiberty/vmsbuild.com
new file mode 100644
index 00000000000..9400b45723a
--- /dev/null
+++ b/libiberty/vmsbuild.com
@@ -0,0 +1,166 @@
+$! libiberty/vmsbuild.com -- build liberty.olb for VMS host, VMS target
+$!
+$ CC = "gcc /noVerbose/Debug/Incl=([],[-.include])"
+$ LIBR = "library /Obj"
+$ LINK = "link"
+$ DELETE= "delete /noConfirm"
+$ SEARCH= "search /Exact"
+$ ECHO = "write sys$output"
+$ ABORT = "exit %x002C"
+$!
+$ LIB_NAME = "liberty.olb" !this is what we're going to construct
+$ WORK_LIB = "new-lib.olb" !used to guard against an incomplete build
+$
+$! manually copied from Makefile.in
+$ REQUIRED_OFILES = "argv.o basename.o choose-temp.o concat.o cplus-dem.o "-
+ + "fdmatch.o getopt.o getopt1.o getruntime.o hex.o "-
+ + "floatformat.o obstack.o spaces.o strerror.o strsignal.o "-
+ + "vasprintf.o xatexit.o xexit.o xmalloc.o xstrdup.o xstrerror.o"
+$! anything not caught by link+search of dummy.* should be added here
+$ EXTRA_OFILES = ""
+$!
+$! move to the directory which contains this command procedure
+$ old_dir = f$environ("DEFAULT")
+$ new_dir = f$parse("_._;",f$environ("PROCEDURE")) - "_._;"
+$ set default 'new_dir'
+$
+$ ECHO "Starting libiberty build..."
+$ create config.h
+/* libiberty config.h for VMS */
+#define NEED_sys_siglist
+#define NEED_psignal
+#define NEED_basename
+$ if f$search("alloca-conf.h").eqs."" then -
+ copy alloca-norm.h alloca-conf.h
+$ LIBR 'WORK_LIB' /Create
+$
+$! first pass: compile "required" modules
+$ ofiles = REQUIRED_OFILES + " " + EXTRA_OFILES
+$ pass = 1
+$ gosub do_ofiles
+$
+$! second pass: process dummy.c, using the first pass' results
+$ ECHO " now checking run-time library for missing functionality"
+$ if f$search("dummy.obj").nes."" then DELETE dummy.obj;*
+$ define/noLog sys$error _NL: !can't use /User_Mode here due to gcc
+$ define/noLog sys$output _NL: ! driver's use of multiple image activation
+$ on error then continue
+$ 'CC' dummy.c
+$ deassign sys$error !restore, more or less
+$ deassign sys$output
+$ if f$search("dummy.obj").eqs."" then goto pass2_failure1
+$! link dummy.obj, capturing full linker feedback in dummy.map
+$ oldmsg = f$environ("MESSAGE")
+$ set message /Facility/Severity/Identification/Text
+$ define/User sys$output _NL:
+$ define/User sys$error _NL:
+$ LINK/Map=dummy.map/noExe dummy.obj,'WORK_LIB'/Libr,-
+ gnu_cc:[000000]gcclib.olb/Libr,sys$library:vaxcrtl.olb/Libr
+$ set message 'oldmsg'
+$ if f$search("dummy.map").eqs."" then goto pass2_failure2
+$ DELETE dummy.obj;*
+$ SEARCH dummy.map "%LINK-I-UDFSYM" /Output=dummy.list
+$ DELETE dummy.map;*
+$ ECHO " check completed"
+$! we now have a file with one entry per line of unresolvable symbols
+$ ofiles = ""
+$ if f$trnlnm("IFILE$").nes."" then close/noLog ifile$
+$ open/Read ifile$ dummy.list
+$iloop: read/End=idone ifile$ iline
+$ iline = f$edit(iline,"COMPRESS,TRIM,LOWERCASE")
+$ ofiles = ofiles + " " + f$element(1," ",iline) + ".o"
+$ goto iloop
+$idone: close ifile$
+$ DELETE dummy.list;*
+$ on error then ABORT
+$
+$! third pass: compile "missing" modules collected in pass 2
+$ pass = 3
+$ gosub do_ofiles
+$
+$! finish up
+$ LIBR 'WORK_LIB' /Compress /Output='LIB_NAME' !new-lib.olb -> liberty.olb
+$ DELETE 'WORK_LIB';*
+$
+$! all done
+$ ECHO "Completed libiberty build."
+$ type sys$input:
+
+ You many wish to do
+ $ COPY LIBERTY.OLB GNU_CC:[000000]
+ so that this run-time library resides in the same location as gcc's
+ support library. When building gas, be sure to leave the original
+ copy of liberty.olb here so that gas's build procedure can find it.
+
+$ set default 'old_dir'
+$ exit
+$
+$!
+$! compile each element of the space-delimited list 'ofiles'
+$!
+$do_ofiles:
+$ ofiles = f$edit(ofiles,"COMPRESS,TRIM")
+$ i = 0
+$oloop:
+$ f = f$element(i," ",ofiles)
+$ if f.eqs." " then goto odone
+$ f = f - ".o" !strip dummy suffix
+$ ECHO " ''f'"
+$ skip_f = 0
+$ if pass.eq.3 .and. f$search("''f'.c").eqs."" then gosub chk_deffunc
+$ if .not.skip_f
+$ then
+$ 'CC' 'f'.c
+$ LIBR 'WORK_LIB' 'f'.obj /Insert
+$ DELETE 'f'.obj;*
+$ endif
+$ i = i + 1
+$ goto oloop
+$odone:
+$ return
+$
+$!
+$! check functions.def for a DEFFUNC() entry corresponding to missing file 'f'.c
+$!
+$chk_deffunc:
+$ define/User sys$output _NL:
+$ define/User sys$error _NL:
+$ SEARCH functions.def "DEFFUNC","''f'" /Match=AND
+$ if (($status.and.%x7FFFFFFF) .eq. 1)
+$ then
+$ skip_f = 1
+$ open/Append config_h config.h
+$ write config_h "#define NEED_''f'"
+$ close config_h
+$ endif
+$ return
+$
+$!
+$pass2_failure1:
+$! if we reach here, dummy.c failed to compile and we're really stuck
+$ type sys$input:
+
+ Cannot compile the library contents checker (dummy.c + functions.def),
+ so cannot continue!
+
+$! attempt the compile again, without suppressing diagnostic messages this time
+$ on error then ABORT +0*f$verify(v)
+$ v = f$verify(1)
+$ 'CC' dummy.c
+$ ABORT +0*f$verify(v) !'f$verify(0)'
+$!
+$pass2_failure2:
+$! should never reach here..
+$ type sys$input:
+
+ Cannot link the library contents checker (dummy.obj), so cannot continue!
+
+$! attempt the link again, without suppressing diagnostic messages this time
+$ on error then ABORT +0*f$verify(v)
+$ v = f$verify(1)
+$ LINK/Map=dummy.map/noExe dummy.obj,'WORK_LIB'/Libr,-
+ gnu_cc:[000000]gcclib.olb/Libr,sys$library:vaxcrtl.olb/Libr
+$ ABORT +0*f$verify(v) !'f$verify(0)'
+$
+$! not reached
+$ exit
diff --git a/libiberty/vprintf.c b/libiberty/vprintf.c
new file mode 100644
index 00000000000..89c289eb105
--- /dev/null
+++ b/libiberty/vprintf.c
@@ -0,0 +1,15 @@
+#include <stdio.h>
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+#include <ansidecl.h>
+#undef vprintf
+int
+vprintf (format, ap)
+ const char *format;
+ va_list ap;
+{
+ return vfprintf (stdout, format, ap);
+}
diff --git a/libiberty/vsprintf.c b/libiberty/vsprintf.c
new file mode 100644
index 00000000000..bf0760cf6d3
--- /dev/null
+++ b/libiberty/vsprintf.c
@@ -0,0 +1,55 @@
+/* Simple implementation of vsprintf for systems without it.
+ Highly system-dependent, but should work on most "traditional"
+ implementations of stdio; newer ones should already have vsprintf.
+ Written by Per Bothner of Cygnus Support.
+ Based on libg++'s "form" (written by Doug Lea; dl@rocky.oswego.edu).
+ Copyright (C) 1991, 1995 Free Software Foundation, Inc.
+
+This file is part of the libiberty 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING. If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <varargs.h>
+#include <stdio.h>
+#include <ansidecl.h>
+#undef vsprintf
+
+int
+vsprintf (buf, format, ap)
+ char *buf;
+ const char *format;
+ va_list ap;
+{
+ FILE b;
+ int ret;
+#ifdef VMS
+ b->_flag = _IOWRT|_IOSTRG;
+ b->_ptr = buf;
+ b->_cnt = 12000;
+#else
+ b._flag = _IOWRT|_IOSTRG;
+ b._ptr = buf;
+ b._cnt = 12000;
+#endif
+ ret = _doprnt(format, ap, &b);
+ putc('\0', &b);
+ return ret;
+
+}
diff --git a/libiberty/waitpid.c b/libiberty/waitpid.c
new file mode 100644
index 00000000000..23db0b932d2
--- /dev/null
+++ b/libiberty/waitpid.c
@@ -0,0 +1,11 @@
+int
+waitpid (pid, stat_loc, options)
+ int pid, *stat_loc, options;
+{
+ for (;;)
+ {
+ int wpid = wait(stat_loc);
+ if (wpid == pid || wpid == -1)
+ return wpid;
+ }
+}
diff --git a/libiberty/xatexit.c b/libiberty/xatexit.c
new file mode 100644
index 00000000000..31476c29ddc
--- /dev/null
+++ b/libiberty/xatexit.c
@@ -0,0 +1,82 @@
+/*
+ * Copyright (c) 1990 Regents of the University of California.
+ * All rights reserved.
+ *
+ * %sccs.include.redist.c%
+ */
+
+/* Adapted from newlib/libc/stdlib/{,at}exit.[ch].
+ If you use xatexit, you must call xexit instead of exit. */
+
+#include "ansidecl.h"
+#include "libiberty.h"
+
+#include <stdio.h>
+
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#endif
+
+/* For systems with larger pointers than ints, this must be declared. */
+PTR malloc PARAMS ((size_t));
+
+static void xatexit_cleanup PARAMS ((void));
+
+/* Pointer to function run by xexit. */
+extern void (*_xexit_cleanup) PARAMS ((void));
+
+#define XATEXIT_SIZE 32
+
+struct xatexit {
+ struct xatexit *next; /* next in list */
+ int ind; /* next index in this table */
+ void (*fns[XATEXIT_SIZE]) PARAMS ((void)); /* the table itself */
+};
+
+/* Allocate one struct statically to guarantee that we can register
+ at least a few handlers. */
+static struct xatexit xatexit_first;
+
+/* Points to head of LIFO stack. */
+static struct xatexit *xatexit_head = &xatexit_first;
+
+/* Register function FN to be run by xexit.
+ Return 0 if successful, -1 if not. */
+
+int
+xatexit (fn)
+ void (*fn) PARAMS ((void));
+{
+ register struct xatexit *p;
+
+ /* Tell xexit to call xatexit_cleanup. */
+ if (!_xexit_cleanup)
+ _xexit_cleanup = xatexit_cleanup;
+
+ p = xatexit_head;
+ if (p->ind >= XATEXIT_SIZE)
+ {
+ if ((p = (struct xatexit *) malloc (sizeof *p)) == NULL)
+ return -1;
+ p->ind = 0;
+ p->next = xatexit_head;
+ xatexit_head = p;
+ }
+ p->fns[p->ind++] = fn;
+ return 0;
+}
+
+/* Call any cleanup functions. */
+
+static void
+xatexit_cleanup ()
+{
+ register struct xatexit *p;
+ register int n;
+
+ for (p = xatexit_head; p; p = p->next)
+ for (n = p->ind; --n >= 0;)
+ (*p->fns[n]) ();
+}
diff --git a/libiberty/xexit.c b/libiberty/xexit.c
new file mode 100644
index 00000000000..431bbe02991
--- /dev/null
+++ b/libiberty/xexit.c
@@ -0,0 +1,36 @@
+/* xexit.c -- Run any exit handlers, then exit.
+ Copyright (C) 1994, 95, 1997 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 "ansidecl.h"
+#include "libiberty.h"
+
+#include <stdio.h>
+
+/* This variable is set by xatexit if it is called. This way, xmalloc
+ doesn't drag xatexit into the link. */
+void (*_xexit_cleanup) PARAMS ((void));
+
+void
+xexit (code)
+ int code;
+{
+ if (_xexit_cleanup != NULL)
+ (*_xexit_cleanup) ();
+ exit (code);
+}
diff --git a/libiberty/xmalloc.c b/libiberty/xmalloc.c
new file mode 100644
index 00000000000..c479b1f9e95
--- /dev/null
+++ b/libiberty/xmalloc.c
@@ -0,0 +1,113 @@
+/* memory allocation routines with error checking.
+ Copyright 1989, 90, 91, 92, 93, 94 Free Software Foundation, Inc.
+
+This file is part of the libiberty library.
+Libiberty 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.
+
+Libiberty 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 libiberty; 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 "ansidecl.h"
+#include "libiberty.h"
+
+#include <stdio.h>
+
+#ifdef __STDC__
+#include <stddef.h>
+#else
+#define size_t unsigned long
+#define ptrdiff_t long
+#endif
+
+#if VMS
+#include <stdlib.h>
+#include <unixlib.h>
+#else
+/* For systems with larger pointers than ints, these must be declared. */
+PTR malloc PARAMS ((size_t));
+PTR realloc PARAMS ((PTR, size_t));
+PTR sbrk PARAMS ((ptrdiff_t));
+#endif
+
+/* The program name if set. */
+static const char *name = "";
+
+/* The initial sbrk, set when the program name is set. */
+static char *first_break = NULL;
+
+void
+xmalloc_set_program_name (s)
+ const char *s;
+{
+ name = s;
+ if (first_break == NULL)
+ first_break = (char *) sbrk (0);
+}
+
+PTR
+xmalloc (size)
+ size_t size;
+{
+ PTR newmem;
+
+ if (size == 0)
+ size = 1;
+ newmem = malloc (size);
+ if (!newmem)
+ {
+ extern char **environ;
+ size_t allocated;
+
+ if (first_break != NULL)
+ allocated = (char *) sbrk (0) - first_break;
+ else
+ allocated = (char *) sbrk (0) - (char *) &environ;
+ fprintf (stderr,
+ "\n%s%sCan not allocate %lu bytes after allocating %lu bytes\n",
+ name, *name ? ": " : "",
+ (unsigned long) size, (unsigned long) allocated);
+ xexit (1);
+ }
+ return (newmem);
+}
+
+PTR
+xrealloc (oldmem, size)
+ PTR oldmem;
+ size_t size;
+{
+ PTR newmem;
+
+ if (size == 0)
+ size = 1;
+ if (!oldmem)
+ newmem = malloc (size);
+ else
+ newmem = realloc (oldmem, size);
+ if (!newmem)
+ {
+ extern char **environ;
+ size_t allocated;
+
+ if (first_break != NULL)
+ allocated = (char *) sbrk (0) - first_break;
+ else
+ allocated = (char *) sbrk (0) - (char *) &environ;
+ fprintf (stderr,
+ "\n%s%sCan not reallocate %lu bytes after allocating %lu bytes\n",
+ name, *name ? ": " : "",
+ (unsigned long) size, (unsigned long) allocated);
+ xexit (1);
+ }
+ return (newmem);
+}
diff --git a/libiberty/xstrdup.c b/libiberty/xstrdup.c
new file mode 100644
index 00000000000..9d08bc70405
--- /dev/null
+++ b/libiberty/xstrdup.c
@@ -0,0 +1,17 @@
+/* xstrdup.c -- Duplicate a string in memory, using xmalloc.
+ This trivial function is in the public domain.
+ Ian Lance Taylor, Cygnus Support, December 1995. */
+
+#include "ansidecl.h"
+#include "libiberty.h"
+
+char *
+xstrdup (s)
+ const char *s;
+{
+ char *ret;
+
+ ret = xmalloc (strlen (s) + 1);
+ strcpy (ret, s);
+ return ret;
+}
diff --git a/libiberty/xstrerror.c b/libiberty/xstrerror.c
new file mode 100644
index 00000000000..770b653ba80
--- /dev/null
+++ b/libiberty/xstrerror.c
@@ -0,0 +1,56 @@
+/* xstrerror.c -- jacket routine for more robust strerror() usage.
+ Fri Jun 16 18:30:00 1995 Pat Rankin <rankin@eql.caltech.edu>
+ This code is in the public domain. */
+
+#include <stdio.h>
+
+#include "libiberty.h"
+#include "config.h"
+
+#ifdef VMS
+#include <errno.h>
+#if !defined (__STRICT_ANSI__) && !defined (__HIDE_FORBIDDEN_NAMES)
+extern char *strerror PARAMS ((int,...));
+#define DONT_DECLARE_STRERROR
+#endif
+#endif /* VMS */
+
+#ifndef DONT_DECLARE_STRERROR
+extern char *strerror PARAMS ((int));
+#endif
+
+/* If strerror returns NULL, we'll format the number into a static buffer. */
+
+#define ERRSTR_FMT "undocumented error #%d"
+static char xstrerror_buf[sizeof ERRSTR_FMT + 20];
+
+/* Like strerror, but result is never a null pointer. */
+
+char *
+xstrerror (errnum)
+ int errnum;
+{
+ char *errstr;
+#ifdef VMS
+ char *(*vmslib_strerror) PARAMS ((int,...));
+
+ /* Override any possibly-conflicting declaration from system header. */
+ vmslib_strerror = (char *(*) PARAMS ((int,...))) strerror;
+ /* Second argument matters iff first is EVMSERR, but it's simpler to
+ pass it unconditionally. `vaxc$errno' is declared in <errno.h>
+ and maintained by the run-time library in parallel to `errno'.
+ We assume that `errnum' corresponds to the last value assigned to
+ errno by the run-time library, hence vaxc$errno will be relevant. */
+ errstr = (*vmslib_strerror) (errnum, vaxc$errno);
+#else
+ errstr = strerror (errnum);
+#endif
+
+ /* If `errnum' is out of range, result might be NULL. We'll fix that. */
+ if (!errstr)
+ {
+ sprintf (xstrerror_buf, ERRSTR_FMT, errnum);
+ errstr = xstrerror_buf;
+ }
+ return errstr;
+}
diff --git a/libio/ChangeLog b/libio/ChangeLog
new file mode 100644
index 00000000000..de8f618cabf
--- /dev/null
+++ b/libio/ChangeLog
@@ -0,0 +1,1940 @@
+Wed Aug 20 02:01:34 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * iostream.h: Add copy assignment ops for _IO_?stream_withassign.
+
+Tue Jul 22 10:31:41 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * config.shared (CHECK_SUBDIRS): Use install-sh, not install.sh.
+
+Wed Jun 25 12:20:55 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * config.shared (DOING_GPERF): Look for this, defining TOLIBGXX
+ and LIBS for it.
+
+Wed Jun 18 11:03:34 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * config.shared (FLAGS_TO_PASS): Don't include RUNTEST.
+
+Tue Jun 17 22:23:48 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * config.shared (FLAGS_TO_PASS): Pass RUNTEST and RUNTESTFLAGS.
+
+Fri May 16 21:08:53 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * iovfprintf.c: Declare __cvt_double before use.
+
+ * floatconv.c (d2b): Use _G_int32_t instead of int for the
+ e and bits parameters.
+ (_IO_strtod): Use _G_int32_t.
+
+ * gen-params: Look for NO_USE_DTOA and USE_INT32_FLAGS.
+
+ * strops.c (_IO_str_init_static): use _G_int32_t appropriately.
+
+ * libio.h: If _G_NO_USE_DTOA is set, then don't define
+ _IO_USE_DTOA.
+
+ * config/mn10200.mt: Don't use dtoa, it only works
+ for "real" doubles.
+
+Thu May 15 17:44:12 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * configure.in: Set CHECK_SUBDIRS to testsuite if we're doing
+ a cross compile.
+
+ * config.shared(check): Only run make check in the directories
+ specified by CHECK_SUBDIRS. Set CHECK_SUBDIRS to SUBDIRS
+ if it has no previous value.
+
+Thu May 1 17:35:19 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (test, tpipe): Add $(CFLAGS).
+
+Wed Apr 30 12:16:29 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure.in: Don't turn on multilib here.
+
+Sat Apr 26 13:38:21 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * configure.in (configdirs): Add testsuite directory.
+
+ * testsuite/ChangeLog:
+ * testsuite/Makefile.in:
+ * testsuite/libio.tests/tiomanip.exp:
+ * testsuite/libio.tests/tstdiomisc.exp:
+ * testsuite/libio.tests/tiomisc.exp:
+ * testsuite/libio.tests/tFile.exp:
+ * testsuite/libio.tests/tfformat.exp:
+ * testsuite/libio.tests/tiformat.exp:
+ * testsuite/libio.tests/hounddog.exp:
+ * testsuite/libio.tests/putbackdog.exp:
+ * testsuite/configure.in:
+ * testsuite/lib/libio.exp:
+ * testsuite/config/default.exp:
+ New files for DejaGnu-style testsuite.
+
+Fri Apr 4 03:16:44 1997 Ulrich Drepper <drepepr@cygnus.com>
+
+ * configure.in: Enable multilibing by default.
+ Update multilib template to read config-ml.in.
+
+ * floatconv.c: Enable use in cross targets which use the
+ newlib ieeefp.h header.
+
+Thu Jan 23 09:16:16 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * libioP.h (_IO_file_attach): Delete redundant decl.
+
+Tue Jan 21 22:13:45 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * streambuf.h (class ios): Take out STREAMSIZE member, since we
+ only need (and should only have) the global one.
+
+Tue Jan 7 14:02:40 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * iostream.h (long long fns): Use __extension__.
+
+ * gen-params: Use _G_llong and _G_ullong instead of long long for
+ deduced types.
+
+Fri Dec 6 13:13:30 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * dbz/dbz.c: Use off_t.
+
+Sat Nov 23 15:44:37 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (install): Don't install _G_config.h with other headers.
+
+Mon Nov 18 17:12:41 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config.shared (SUBDIRS): Use -O instead of -O3 for debugging.
+
+Sun Nov 3 12:43:34 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * iostream.cc (write_int): Treat string literals as const.
+
+Thu Sep 26 10:09:18 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * depend: Regenerate.
+
+Wed Sep 25 22:54:45 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config.shared (depend.new): Deal with headers that don't end in .h.
+
+Thu Aug 29 17:05:53 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (i[345]86-*-*): Recognize i686 for pentium pro.
+
+Mon Aug 5 01:26:32 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config{ure.in,.shared} (DISTCLEAN): Add multilib.out.
+
+Fri Aug 2 17:39:35 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * libio.h (NULL): Use __null.
+ * libioP.h (NULL): Ditto.
+ * streambuf.h (NULL): Ditto.
+ * ioextend.cc (get_array_element): Use NULL instead of (void*)0.
+
+Fri Jul 5 18:26:41 1996 Jim Wilson <wilson@cygnus.com>
+
+ * strfile.h (struct _IO_streambuf): New struct type.
+ (struct _IO_strfile): Use it.
+
+Tue Jun 18 18:24:21 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * fstream.h (fstreambase): Make __my_fb mutable.
+ From Joe Buck.
+
+Tue Jun 18 11:03:53 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * dbz/fake.c (main): Set return type to int.
+ * dbz/dbzmain.c (main): Likewise.
+ * dbz/byteflip.c (main): Likewise.
+
+Mon Jun 17 14:05:36 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * gen-params: Check if clog conflicts with system libraries.
+ * stdstreams.cc: If it does, use __IO_clog.
+ * iostream.h: Likewise.
+
+Tue Jun 11 13:39:31 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * stdiostream.h (istdiostream (FILE*)): Put istream base
+ initializer before init for __f.
+ (ostdiostream (FILE*)): Likewise for ostream base init.
+
+Tue May 14 11:47:21 1996 Per Bothner <bothner@andros.cygnus.com>
+
+ * strfile.h (_IO_str_fields): Removed _len field.
+ (_IO_STR_DYNAMIC, _IO_STR_FROZEN): new macros.
+ * strstream.h (strstreambuf::is_static): Removed.
+ (strstreambuf::frozen): Use _IO_STR_DYNAMIC instead of is_static.
+ * strstream.h, strstream.cc: Remove support for !_IO_NEW_STREAMS.
+ * strstream.cc (strstreambuf::init_dynamic): Don't set _s._len.
+ * strops.c (_IO_str_init_static): Better handling of the
+ negative (== unbounded) size case.
+ (_IO_str_overflow, _IO_str_underflow, _IO_str_count): Re-write
+ to not use _s._len, and otherwise cleanup/fix.
+ * strstream.h, strstream.cc (strstreambase::strstreambase()): Call
+ ios::init here.
+ (other constructors): Simplify - init already called.
+
+Tue May 14 10:55:21 1996 Per Bothner <bothner@deneb.cygnus.com>
+
+ Change so that strstreambuf default constructor does no allocation.
+ * strstream.h (strstreambuf::init_dynamic): Default initial size = 0.
+ * strstream.cc (strstreambuf::init_dynamic): Don't allocate a
+ buffer (yet) if initial_size is 0.
+ * strops.c (_IO_str_overflow): Add 100 to size of re-allocated
+ buffer, to handle case when initial size is 0.
+
+ * iostdio.h (remove, rename, tmpfile, tempnam): Comment out.
+
+Mon May 13 23:19:39 1996 Per Bothner <bothner@deneb.cygnus.com>
+
+ * fileops.c (_IO_file_close_it): Just call _IO_do_flush rather
+ than _IO_file_sync, to avoid useless lseek.
+
+Tue May 14 10:48:48 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * floatconv.c (_IO_strtod): Force rv into the stack.
+
+ * config.shared (gxx_includedir): Now $(includedir)/g++.
+
+Sat Apr 27 02:37:49 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * libioP.h (JUMP*): Implement for thunks.
+ (_IO_jump_t): Add second dummy field for thunks.
+
+Thu Apr 25 13:20:00 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config.shared (CXX): Use gcc, not g++.
+
+Wed Apr 24 10:29:50 1996 Doug Evans <dje@blues.cygnus.com>
+
+ * config.shared (depend.new): Delete $(srcdir)/ from foo.{c,cc}
+ for SunOS VPATH.
+ * depend: Regenerated.
+
+Fri Apr 19 17:24:51 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Version 2.8.0b3.
+
+Wed Apr 10 17:16:01 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure.in (ALL): Don't build iostream.a.
+
+Mon Apr 8 14:44:11 1996 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * iosetvbuf.c (_IO_setvbuf): Clear _IO_UNBUFFERED unless _IONBF.
+
+Mon Apr 8 15:08:23 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Permit --enable-shared to specify a list of
+ directories.
+
+Fri Apr 5 17:48:56 1996 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.shared (MOSTLYCLEAN): Also remove ${EXTRA_MOSTLYCLEAN}.
+
+Fri Mar 22 23:25:00 1996 Ulrich Drepper <drepepr@gnu.ai.mit.edu>
+
+ * genops.c (_IO_sputbackc, _IO_sungetc): Clear EOF flag if putsh
+ back was successful.
+
+Wed Mar 27 11:54:08 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Version 2.8.0b2.
+
+Fri Mar 22 15:39:36 1996 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * fileops.c (_IO_do_write): Revert previous fix. (It fails to
+ handle the case that fp->_IO_read_end != fp->_IO_write_base.)
+ (_IO_file_overflow): Instead, if _IO_read_ptr is at the end of
+ the buffer, reset all the read pointers to _IO_buf_base.
+
+Tue Mar 12 12:03:17 1996 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * fileops.c (_IO_do_write): Even if to_do==0, must re-set buffer
+ pointers. Bug and solution from Luke Blanshard <luke@cs.wisc.edu>.
+
+Wed Feb 28 10:00:24 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Version 2.8.0b1.
+
+Tue Feb 27 18:08:16 1996 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * iopopen.c (_IO_proc_open): Use (char*)0 rather than imprecise NULL.
+
+ * streambuf.h (ios): Add ios::binary; deprecate ios::bin.
+ * filebuf.cc (filebuf::open): Handle ios::binary.
+
+Fri Feb 9 12:40:19 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * cleanup.c (_IO_cleanup_registration_needed) [!_G_HAVE_ATEXIT]: Init
+ to NULL.
+ * filedoalloc.c (_IO_cleanup_registration_needed): Remove decl.
+
+Thu Feb 8 08:12:50 1996 Brendan Kehoe <brendan@cygnus.com>
+
+ * filedoalloc.c (_IO_cleanup_registration_needed): Revert previous
+ change, since cleanup.c only defines it if _G_HAVE_ATEXIT.
+
+Wed Feb 7 15:10:17 1996 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * filedoalloc.c (_IO_cleanup_registration_needed): Declare as extern.
+
+Tue Dec 12 17:21:13 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * indstream.h, instream.cc (indirectbuf::uflow): New method.
+ * indstream.cc (indirectbuf::underflow): Fix to use sgetc, not sbumpc.
+ Fixes bug reported by Kevin Beyer <beyer@cs.wisc.edu>.
+
+ * indstream.cc (indirectbuf::seekpos): Add paranoia test.
+
+Fri Dec 8 14:55:34 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * stream.h: Add warning to not use these functions.
+ * stream.cc (str, chr): Re-implement here (from libg++).
+
+Tue Nov 28 15:07:01 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.shared: Use test instead of [ to avoid DEC Unix lossage.
+
+Thu Nov 23 14:51:43 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * iopopen.c: Move #include <sys/types.h> ahead of #include <signal.h>
+ to deal with BSDI's literal implementation of Posix.
+
+Sat Nov 25 11:21:55 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (install): Set rootme.
+ * config.shared (TOPDIR): Set with ${foo-...} rather than ${foo=...}.
+ (INSTALL): Handle absolute, dot, relative-not-dot values of srcdir.
+ (TEXIDIR): Likewise.
+
+Tue Nov 21 14:12:05 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Check ${with_cross_host} rather than comparing
+ ${host} and ${target}.
+
+Mon Nov 20 13:55:29 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * configure.in: Match *-sco3.2v[45]*.
+
+Wed Nov 15 20:19:31 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * config.shared (FLAGS_TO_PASS): Also pass SHLIB and SHCURSES.
+
+Tue Nov 14 01:41:08 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * config.shared (TO_REAL_TOPDIR): Define.
+ (MULTITOP): Deleted.
+ (MULTISRCTOP, MULTIBUILDTOP): New.
+ (TOPDIR): Change MULTITOP to MULTIBUILDTOP, and use TO_REAL_TOPDIR.
+ (INSTALL): Add with_multisrctop, TO_REAL_TOPDIR.
+ (TEXIDIR): Use TO_REAL_TOPDIR.
+ (LIBS): Delete MULTITOP.
+ (FLAGS_TO_PASS): Add NM.
+ (CXXINCLUDES): Delete MULTITOP.
+ (depend.new): Delete adding MULTITOP to ../ build tree references.
+ Add MULTISRCTOP to ../ source tree references.
+ * configure.in: Delete call to cfg-ml-com.in. Call config-ml.in
+ instead of cfg-ml-pos.in.
+
+Sun Nov 12 16:30:48 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (VERSION): Set to 2.7.1.
+ * configure.in: Add warning for Linux.
+ * config.shared (DISTCLEAN): Add EXTRA_DISTCLEAN.
+
+ * editbuf.h (edit_mark::index_in_buffer): Avoid unused param warning.
+
+ * iostream.cc (istream::operator>> (char*)): Improve ANSI compliance.
+
+Fri Nov 10 08:41:37 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * config.shared (check): Add missing semicolon.
+
+Thu Nov 9 17:27:22 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure.in (ALL): Remove $(OSPRIM_OBJECTS).
+ * config.shared (check): Set LD_LIBRARY_PATH.
+ * NEWS: Fix typo.
+ * iogetdelim.c (_IO_getdelim): Index *lineptr, rather than lineptr.
+ From alan@spri.levels.unisa.edu.au (Alan Modra).
+
+Mon Nov 6 15:03:33 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * streambuf.cc, editbuf.cc, isgetline.cc, parsestream.cc:
+ Fixes to avoid -Wall warnings.
+
+Fri Nov 3 16:41:41 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * gen-params [!__STDC__]: Include varargs.h instead of stdarg.h.
+
+Thu Nov 2 15:04:03 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.shared: Re-write if X then Y else true fi to (not X) || Y.
+
+Wed Nov 1 13:26:44 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * iostream.h (istream::ipfx): Add default argument value.
+ Reported by Yotam Medini <yotam_medini@tmai.com>.
+
+ * libioP.h (_IO_blen): Fix typo.
+ Reported by Bryan T. Vold <btv@ldl.healthpartners.com>.
+
+Fri Oct 27 19:26:20 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (_G_config.h): Set CC to $(CC) rather than to $(CXX),
+ now that CXX defaults to g++ and CC default to gcc (when found).
+ * config.shared: Simplify CXX and CC, since they get overridden
+ by ../configure anyway.
+
+Wed Oct 25 19:45:50 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * iostdio.h: Wrap including the file with #ifndef _IOSTDIO_H.
+
+Wed Oct 25 11:14:25 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * libio.h (_IO_seekoff, _IO_seekpos): New declarations.
+ * libioP.h (_IO_seekoff, _IO_seekpos): Remove declarations.
+ * libioP.h: Cleanup; remove old !_IO_UNIFIED_JUMPTABLES stuff.
+
+ * filebuf.cc (filebuf::~filebuf): Only call SYSYCLOSE if currently
+ open. Bug found by Martin Gerbershagen <ger@ezis-ulm.de>.
+
+ * streambuf.h (streambuf::pubseekoff, streambuf::pubseekpos):
+ Added, from ANSI draft.
+ * filebuf.cc (filebuf::open), iostream.cc (variables places), SFile.cc:
+ Use pubseekoff/pubseekpos rather than sseekoff/sseekpos.
+
+ * Makefile.in (install): Don't install libiostream.a.
+
+ * filedoalloc.c: Also #include <unistd.h>.
+
+Mon Oct 9 18:09:54 1995 Jason Molenda <crash@phydeaux.cygnus.com>
+
+ * config.shared (SUFFIXES): add .c.
+
+Tue Sep 26 16:08:01 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * procbuf.cc: Move #pragma implementation to beginning.
+
+Wed Sep 20 17:53:33 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * procbuf.h, procbuf.cc: Add #pragma interface/implementation stuff.
+
+Wed Sep 20 18:59:00 1995 John Eaton <jwe@bevo.che.wisc.edu>
+
+ * procbuf.h: Protect from being included multiple times.
+
+Wed Sep 20 15:47:14 1995 John Eaton <jwe@bevo.che.wisc.edu>
+
+ * procbuf.h (procbuf): Add '_next' pointer field for compatibility
+ with _IO_proc_file.
+
+Wed Sep 20 13:54:02 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * config.shared: Add support for maintainer-clean target as a
+ synonym for realclean.
+ * dbz/Makefile.in: Likewise.
+
+Mon Sep 11 12:11:19 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * iopopen.c: #include <sys/types.h> before <sys/wait.h>.
+ This is in accordance with Posix, and needed for ISC.
+
+Fri Sep 8 00:11:55 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * gen-params: Use double quotes in the eval setting $TYPE to
+ $VALUE, to preserve any single quotes in $VALUE.
+
+Mon Aug 21 11:39:09 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * gen-params: Test for an appropriate version of gcc before using
+ mode attributes.
+
+ * config.shared: Add $(PICDIR) to $ALL.
+
+Mon Aug 7 17:51:40 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * gen-params: Generate new macro _G_HAVE_SYS_CDEFS.
+ * libio.h: If _G_HAVE_SYS_CDEFS, get __P from <sys/cdefs.h>.
+
+Fri Aug 4 23:21:17 1995 Paul Eggert <eggert@twinsun.com>
+
+ * gen-params: When following typedef changes, allow typedefs
+ that do not have a space before the defined type name,
+ e.g. `typedef void *__gnuc_va_list;' as in Linux. Also,
+ not require a space in the definiens, e.g. `typedef void*foo;'.
+
+Thu Aug 3 17:54:15 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * iostream.h, iostream.cc (istream::sync): Added missing method.
+
+Thu Aug 3 17:49:34 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in: Remove netbsd special case.
+ * config/netbsd.mt: Removed; no longer used.
+
+Tue Jun 20 16:07:12 1995 Paul Eggert <eggert@twinsun.com>
+
+ * gen-params: Take transitive closure of `typedef' relation.
+ This is needed for BSD/OS 2.0, which has
+ fpos_t -> off_t -> quad_t -> long long.
+
+Mon Jul 24 18:28:10 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * config.shared (TOPDIR): Delete extra '/', $rootme may be empty.
+
+Sat Jul 22 13:27:45 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * config.shared (depend.new): Fix quoting in DO NOT EDIT line.
+
+ * Makefile.in (_G_config.h): Add multilib support.
+ (install): Likewise.
+ * config.shared: Likewise.
+ * configure.in: Likewise.
+
+Wed Jun 28 17:40:25 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * PlotFile.h, SFile.h, builtinbuf.h, editbuf.h, fstream.h,
+ indstream.h, iomanip.h, iostream.h, parsestream.h, pfstream.h,
+ procbuf.h, stdiostream.h, stream.h, streambuf.h, strstream.h: Wrap
+ with extern "C++".
+
+Thu Jun 22 04:34:01 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * gen-params: Surround attributes with __.
+
+Mon Jun 19 00:33:22 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config.shared (SUBDIRS): Massage broken shells that require
+ 'else true'.
+
+Sat Jun 17 11:25:38 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * streambuf.h: Declare inline members inline in class.
+
+Thu Jun 15 20:45:13 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (VERSION): Update to version 2.7.0.
+
+Wed Jun 14 21:41:11 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * Makefile.in (STDIO_WRAP_OBJECTS): Remove stdfiles.o.
+ (LIBIO_OBJECTS): Add stdfiles.o.
+
+Wed Jun 7 16:11:36 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * config.shared (all): Appease bash.
+
+Wed Jun 7 11:16:38 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * configure.in (MOSTLYCLEAN): Remove stamp-picdir.
+
+ * config.shared (MOSTLYCLEAN): Ditto.
+ (CLEAN): Don't.
+
+Mon Jun 5 18:29:39 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config/mh-*pic: Removed.
+
+ * configure.in (MOSTLYCLEAN): Remove pic objects.
+ (frags): Use toplevel pic fragments.
+
+ * config.shared (CXXFLAGS): Use -O3.
+ (PICFLAG, PICDIR): New macros.
+ (all): Depend on $(PICDIR).
+ (FLAGS_TO_PASS): Pass PICFLAG.
+ (.x.o): Also build pic object.
+ (stamp-picdir): Create directory for pic objects.
+ (MOSTLYCLEAN): Remove pic objects.
+ (CLEAN): Remove stamp-picdir.
+
+ * Makefile.in (iostream.list): Depend on stamp-picdir.
+ (c++clean): Don't remove _G_config.h.
+
+Mon Jun 5 15:03:47 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * strstream.h, strstream.cc (strstream::strstream()): Re-implement to
+ be like ostrstream::ostrestream(), and not leak memory.
+
+ * streambuf.h: Use #if !_IO_UNIFIED_JUMPTABLES instead of #ifndef.
+
+ * iolibio.h (_IO_rewind): Add missing flags when calling _IO_seekoff.
+
+Thu May 25 22:30:21 1995 J.T. Conklin <jtc@rtl.cygnus.com>
+
+ * config/netbsd.mt (G_CONFIG_ARGS): Add defn for off_t. Another
+ layer of typedefs has been added and the gen-params script can
+ not handle it.
+
+Wed May 10 03:02:58 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * iolibio.h (_IO_rewind): Add new argument to _IO_seekoff.
+
+ * config/linux.mt (LIBIOSTREAM_OBJECTS): Include $(STDIO_WRAP_OBJECTS).
+ (LIBIOSTREAM_DEP): Include stdio.list.
+ (LIBIOSTREAM_USE): Include `cat stdio.list`.
+
+ * Makefile.in (LIBIOSTREAM_DEP): New variable.
+ (LIBIOSTREAM_USE): Ditto.
+ (libiostream.a): Use them.
+ (iostream.list): Ditto.
+ (stdio.list): New rule.
+ (stdio/stdio.list): Ditto.
+
+Tue May 9 18:29:38 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * libioP.h (_IO_jump_t): Change TYPE for __dummy from int to
+ _G_size_t.
+
+Sat May 6 13:50:37 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * libio.h (_IO_UNIFIED_JUMPTABLES): #define as true.
+ (_IO_FILE): Remove _jumps field (#if _IO_UNIFIED_JUMPTABLES).
+
+ * libioP.h (enum _IO_seekflags_): Removed.
+
+ * libioP.h (_IO_setbuf_t): Change return value of setpos jumptable
+ function to match C++ streambuf::setpos. (Return NULL on failure.)
+ * fileops.c (_IO_file_setbuf), genops.c (_IO_default_setbuf),
+ filebuf.cc, iosetvbuf.c: Update to use new setbuf conventions.
+
+ * streambuf.h (streambuf): Re-order virtual functions more logically.
+ * streambuf.cc (streambuf::uflow), streambuf.h: New virtual.
+ * libioP.h (struct _IO_jump_t): Define using new JUMP_FIELD macro.
+ And re-order in more logical order consistent with streambuf vtable.
+ * fileops.c (_IO_file_jumps), iopopen.c (_IO_proc_jumps), iovfprintf.c
+ (_IO_helper_jumps), streambuf.cc (_IO_streambuf_jumps), strops.c
+ (_IO_str_jumps): Update accordingly, using JUMP_INIT macro.
+ * stdfiles.c: Set vtable to point to _IO_file_jumps.
+ * filebuf.cc, iopopen.c, iovfprintf.c (helper_vfprintf), iovsprintf.c,
+ iovsscanf.c: Use macros and #if to set jumptables.
+
+ * streambuf.c: _IO_streambuf_jumps and the _IO_sb_* methods are not
+ needed #if _IO_UNIFIED_JUMPTABLES.
+ * filebuf.cc (filebuf::__new): Also no longer needed.
+ * fstream.cc (fstreambase::__fb_init, fstreambase::fstreambase): Fix.
+ * stdstrbufs.c: Use filebuf vtable instead of builtinbuf's.
+ * builtinbuf.h, builtinbuf.cc (builtinbuf): Commented out #if
+ _IO_UNIFIED_JUMPTABLES - no longer needed.
+ * strstream.cc (SET_STR_JUMPS): Does nothing now.
+
+ * builtinbuf.cc, fileops.c, genops.c, iofgetpos.c, iofsetpos.c,
+ ioftell.c, iopopen.c, ioseekoff.c, ioseekpos.c, iosetvbuf.c,
+ iovfprintf.c, iovfscanf.c, strops.c: Use DEFUN and DEFUN_VOID.
+ * filebuf.cc, fileops.c, genops.c, iopopen.c, ioseekoff.c, ioseekpos.c,
+ iosetvbuf.c, iovfscanf.c: Use new JUMP_* and IO_OVERFLOW/... macros.
+
+ * libioP.h (_IO_seekpos_t): Third arg is now an int (using _IOS_INPUT
+ and _IOS_OUTPUT), not an enum _IO_seekflags_. Flags values are
+ changed, and their sense inverted (to match streambuf::seekpos).
+ * libioP.h (_IO_seekoff_t): Similarly match streambuf::seekoff.
+ * filebuf.cc, fileops.c (_IO_file_fopen, _IO_file_seekoff), genops.c
+ (_IO_default_seekpos, _IO_default_seekpos), iofgetpos.c, iofsetpos.c,
+ iolibio.h (_IO_fseek), ioftell.c, ioseekoff.c, ioseekpos.c,
+ iostream.cc, streambuf.cc, strops.c (_IO_str_seekoff), strstream.cc:
+ New seekpos/seekoff conventions.
+ * iostreamP.h (convert_to_seekflags): Removed - no longer needed.
+
+ * iolibio.h (_IO_fread): New declaration.
+
+ * dbz/Makefile.in: Re-arrange for cleaner dependencies.
+
+Fri May 5 15:55:22 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * libioP.h (_IO_JUMPS. JUMP_FIELD, JUMP0, JUMP1, JUMP2, JUMP3,
+ JUMP_INIT, _IO_FINISH, _IO_OVERFLOW, ... _IO_SYSSTAT): New macros
+ in preparation for new unified jumptable/vtable implementation.
+ * cleanup.c, filedoalloc.c, iofclose.c, iofflush.c, iofiledoalloc.c,
+ ioprims.c, iosetbuffer.c, iostrerror.c, ioungetc.c: Use DEFUN.
+ * filedoalloc.c, iofclose, iofflush, iosetbuffer.c: Use new macros.
+
+ * iofopen.c, iofdopen.c: Use macros and #if for new jumptables.
+
+ * gen-params: Do not #include <sys/types.h>.
+ Add missing quote in 'eval'.
+ Do add #include <sys/types.h> in test for <sys/resource.h>.
+ * config/netbsd.mt: New file, defining _G_CONFIG_ARGS (for fpos_t).
+ * configure.in: Use netbsd.mt for NetBSD.
+
+Wed May 3 15:03:47 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * libioP.h (DEFUN, DEFUN_VOID, AND): New macros, from ansidecl.h.
+ * iofdopen.c, iofgets.c, iofopen.c, iofputs.c, iofread.c, iofwrite.c,
+ iogetdelim.c, iogetline.c, iogets.c, ioignore.c, iopadn.c, ioperror.c,
+ ioputs.c, iovsprintf.c, iovsscanf.c, outfloat.c: Use DEFUN.
+
+Mon May 1 16:22:30 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * gen-params: #include <sys/types.h>. Don't use __WCHAR_TYPE__ in
+ definition of _G_wchar_t. Use __attribute__ ((mode)) to get
+ specific-sized ints under gcc, don't worry about int8 or int64
+ otherwise. Provide defaults if deduction fails.
+
+Thu Apr 27 18:27:53 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * streambuf.h (ios::~ios): Delete _arrays.
+ (_IO_NEW_STREAMS): Turn on.
+ * libio.h (__adjust_column): Remove bogus declaration.
+ * genops.c (_IO_set_column): Fix typo (in commented-out code).
+
+Tue Apr 25 17:14:29 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config.shared (CXXINCLUDES): Use a shell variable with a
+ different name from the make variable.
+ * configure.in: Update accordingly.
+
+Mon Apr 17 17:19:40 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * streambuf.h (__adjust_column): Remove redundant declaration.
+
+Sat Apr 15 11:39:25 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.shared (do-clean-dvi): Also remove *.cps.
+
+ * gen-params: Use ${SED} instead of sed.
+
+ * libio.h: Remove #if'd out stuff (confuses makedepend).
+
+ * stdstreams.cc (STD_STR): Standard streams start with ios::dec set.
+
+Fri Apr 14 23:46:31 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * iostream.h, iostream.cc (istream::read, ostream::write):
+ Use streamsize for the length parameter.
+
+ * streambuf.h: Removed redundant __overflow and __underflow.
+
+ * fstream.h, fstream.cc: Add void fstreambase::attach(int).
+
+ * iosscanf.c (_IO_sscanf): Fix non-__STDC__ missing declaration.
+
+Mon Apr 3 15:40:55 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * indstream.*: Fix prototypes of xsputn and xsgetn.
+
+ * fileops.c: Avoid ??? trigraph.
+
+Mon Mar 27 16:16:38 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * iomanip.h (operator<< (ostream&, const omanip<TP>&): Define
+ separately.
+ (operator>> (istream&, const imanip<TP>&): Ditto.
+
+Mon Mar 27 08:56:00 1995 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * builtinbuf.cc (builtinbuf::setbuf): Cast NULL to streambuf*, to
+ avoid warning/error about conversion from void*.
+ * indstream.cc (indirectbuf::seekoff): Likewise.
+ (indirectbuf::seekpos): Likewise.
+ * filebuf.cc (filebuf::setbuf): Likewise.
+ (filebuf::close): Cast NULL to filebuf*.
+
+Wed Mar 1 14:23:18 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in (DISTCLEAN): Add, with target-mkfrag.
+
+Fri Feb 24 01:01:08 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * configure.in (frags): Don't require so many dashes in the
+ canonical target name.
+
+Sat Feb 18 13:18:30 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * streambuf.cc (streambuf::sync): Always return 0, even for
+ non-flushed output. This is required by the ANSI/ISO draft.
+ * genops.c (_IO_sync): Likewise always return 0.
+
+Fri Feb 17 16:33:28 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * fileops.c (_IO_file_close_it): Call _IO_file_sync, rather
+ than _IO_do_flush, because we want to adjust the file pointer
+ if reading and not at end (as in SVR4, and as in fflush).
+ Also, make sure to return error indication if sync fails.
+ (_IO_file_sync): Ignore seek error if it is ESPIPE.
+ (_IO_file_seekoff): If not readable, do dumb lseek.
+ * iofclose.c (_IO_fclose): If closing a non-filebuf, return -1
+ if _IO_ERR_SEEN.
+
+Fri Feb 17 19:31:00 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * gen-params: Check for struct tms in <sys/times.h>, defining
+ HAVE_SYS_TIMES accordingly.
+
+Wed Feb 15 21:05:11 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * strops.c (_IO_str_count): Use LEN macro.
+ (_IO_str_seekoff): Update _len field.
+
+Mon Feb 6 19:29:00 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * gen-params: Default to short, long and long long for 16, 32 and
+ 64 bit types, in case detection fails.
+
+Wed Jan 25 18:07:30 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * gen-params (_G_wint_t): Allow for broken promotions.
+
+Tue Jan 24 16:15:40 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * stdstrbufs.cc (_IO_fake_stdiobufs): Add an extra layer of struct,
+ to force correct alignment on i960s.
+ (DEF_STDIOBUF, _IO_{stdin,stdout,stderr}_buf): Update accordingly.
+
+Thu Jan 19 18:30:53 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config.shared (CXXINCLUDES): Add libstdc++ to includes for
+ building libg++.
+ (LIBS): Also link with libstdc++ when building libg++ toys.
+ Don't set EXPORT_ALL_VARIABLES; users will have to set
+ LD_LIBRARY_PATH themselves.
+
+Fri Dec 30 16:38:13 1994 Mike Stump <mrs@cygnus.com>
+
+ * config/linux.mt: Fix build problem on linux 1.0.8.
+
+Thu Dec 22 11:49:45 1994 J.T. Conklin (jtc@phishhead.cygnus.com)
+
+ * config/netware.mt: Use gcc to pre-link iostream.nlm's objects
+ instead of using nlmconv, so that references to functions in
+ libgcc.a are resolved.
+
+ * configure.in: Append .mt to target makefile fragment file names.
+
+ * floatconv.c (tens, tinytens, bigtens): Added const qualifier.
+
+Tue Dec 20 09:59:50 1994 Mike Stump <mrs@cygnus.com>
+
+ * gen-params (VTABLE_LABEL_PREFIX): Since some systems have GNU nm
+ as nm, and they demangle by default, we have to notice this, and
+ try --no-cplus (linux) or --no-demangle when running nm.
+
+Wed Dec 14 18:13:58 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * gen-params: To determine vt-name-mangling using dummy.C add
+ #include and #prama interface/implementation to avoid problem with
+ assemblers that don't emit local symbols. Reported under HPUX 8
+ by Thomas Arend <arend@blasius.Chemietechnik.Uni-Dortmund.DE>.
+
+ * streambuf.h (ios::ios): Move inline definition after
+ that of ios::init (which ios::ios calls).
+
+Sun Dec 4 19:50:32 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * fileops.c (_IO_file_init, _IO_file_close_it, _IO_file_sync):
+ Set _offset to _IO_pos_BAD, to support applications that follow
+ POSIX.1 rules on mixing file handles.
+
+ * fileops.c (_IO_file_overflow): Handle case that buffer was
+ allocated (perhaps by setvbuf) but _IO_write_base is still 0.
+
+ * iostdio.h (setbuffer): #define as _IO_setbuffer.
+ * streambuf.h, filebuf.cc: Removed filebuf::do_write.
+
+Tue Nov 29 23:38:57 1994 Per Bothner (bothner@rtl.cygnus.com)
+
+ * floatconv.c (setword0, setword1): Fix typo.
+
+Tue Nov 29 15:37:29 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.shared: Move -fno-implicit-template from CXXFLAGS
+ to LIBCXXFLAGS. Tests are better run without it.
+
+ * floatconv.c (word0, word1): Re-place/re-implement using unions
+ instead of casts to avoid optimizer problems.
+
+ * dbz/dbzmain.c: Renamed dirname -> dir_name to avoid OSF
+ header file braindamage.
+
+Sat Nov 5 19:44:00 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * config.shared (LIBCFLAGS): Define.
+ (LIBCXXFLAGS): Define.
+ (DOING_LIBGXX): Define TOLIBGXX. Change LIBS to use -lg++. Add
+ LD_LIBRARY_PATH and .EXPORT_ALL_VARIABLES:.
+ (FLAGS_TO_PASS): Add LIBC{,XX}FLAGS.
+ (XC{,XX}FLAGS): Set to LIBCFLAGS or CFLAGS depending on $LIBDIR.
+ (COMPILE.c): Define, use in .c.o rule.
+ (COMPILE.cc): Define, use in .cc.o rule.
+
+Sat Nov 5 15:12:12 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (VERSION): Update to 0.67.
+
+ * streambuf.h (ios::dont_close): Is now set by default.
+ * fstream.h, fstream.cc (__fb_init): New function. Clears
+ ios::dont_close. Change fstreambase constructors to call it.
+ * strstream.cc: *strstream constructors must clear ios::dont_close.
+ * iostream.cc: Simplify - don't need to set ios::dont_close.
+ * ioassign.cc: Simplify - assume ios::dont_close is always set.
+
+ * fstream.h, fstream.cc: If _IO_NEW_STREAMS, put the
+ filebuf as a member __my_fb.
+ * strstream.{h,cc}: Likewile use a strstreambuf member __my_sb.
+ * streambuf.h, stdstreams.cc, ioextend.cc:
+ Fix if _IO_NEW_STREAMS to not use ios::dont_close.
+
+ * streambuf.h (class ios): Move rdbuf later, to avoid
+ inability of g++ to inline.
+ * filebuf.cc (filebuf::~filebuf): Call _IO_do_flush.
+
+ * config.shared: Emit rules to make depend.
+ * depend: New file.
+
+Fri Nov 4 17:19:11 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * README: Fix typos.
+ * libio.h: Add comment. Update Copyright notice.
+
+Fri Nov 4 21:46:30 1994 Paul Eggert <eggert@twinsun.com>
+
+ * libio.h (__P): Change argument name spelling from
+ `paramlist' to `protos' for compatibility with BSDI 1.1.
+
+Thu Nov 3 00:45:16 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * config.shared (CXXFLAGS): Add -fno-implicit-templates.
+
+Mon Oct 24 15:57:35 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * config.shared: Define NOSTDIC and use it for libio too.
+
+Thu Oct 20 19:45:35 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * iogetdelim.c: #include <stdlib.h>.
+
+Thu Oct 20 17:09:52 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * iostream.h: Add classes _IO_istream_withassign and
+ _IO_ostream_withassign. Re-type cin, cout, cerr, clog.
+ (class iostream): Don't add extra _gcount field.
+ * ioassign.cc: New file. Implement operator= for cin etc.
+ * streambuf.h (class ios): Change return type of operator=.
+ * Makefile.in (IOSTREAM_OBJECTS): Add ioassign.o.
+
+ * Makefile.in: Re-arrange, so linux.mt overrides can work.
+
+ * fileops.c (_IO_file_seekoff): Optimize seeks within buffer.
+
+Wed Oct 19 14:25:47 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * gen-params (wint_t): Return to using __WCHAR_TYPE__ for
+ compatibility with gcc versions prior to 2.6.1.
+
+Tue Oct 18 17:08:18 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in: Define _G_CONFOG_H as _G_config.h for Linux. Use it.
+ (IO_OBJECTS): Add iogetdelim.o.
+ * config/linux.mt: New file.
+ * configure.in: Select config/linux.mt if Linux.
+ * iogetdelim.c: Verious cleanups, many from
+ Ulrich Drepper <drepper@ipd.info.uni-karlsruhe.de>.
+ * libioP.h: Add _IO_getdelim. Use (void) for no-parameter functions.
+
+Thu Oct 13 16:30:56 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * libio.h: Rename USE_DTOA to _IO_USE_DTOA for namespace reasons.
+ * iostream.cc, iovfscanf.c, iovfprintf, floatconv.c:
+ Update USE_DTOA -> _IO_USE_DTOA.
+
+ * libio.h (_IO_feof, _IO_ferror): Move to here ...
+ * iolibio: ... from here
+
+ * iostream.cc (istream::get, istream::ignore, istream::read):
+ Set _gcount to 0 if ipfx0 failed.
+
+ * iostream.cc (flush): Do virtual function call, rather than
+ going through jumptable. (To get correct method in derived class.)
+ Bug and fix from John Wiegley <jw@cis.ohio-state.edu>.
+
+ * iofdopen.c (O_ACCMODE): Define using O_RDWR, not O_RDWRITE.
+
+ * streambuf.h (ios::rdbuf(streambuf*)): New.
+ * streambuf.h (ios::operator=): Make private (i.e. dis-allow).
+
+Wed Oct 12 19:09:20 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * gen-params: Define _G_NO_NRV and _G_NO_EXTERN_TEMPLATES if not
+ compiling with g++.
+
+Thu Oct 6 16:03:43 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iostream.texi (ostrstream::str): Note that NUL is not written
+ automatically.
+
+Wed Oct 5 17:28:29 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iogetdelim.c (_IO_getdelim): New function.
+
+Wed Oct 5 15:40:22 1994 J.T. Conklin (jtc@phishhead.cygnus.com)
+
+ * config/netware.mt: New file, first cut at Netware NLM support.
+ * configure.in (*-*-netware*): Use config/netware.mt.
+
+ * config.shared (NLMCONV, LD): New definition.
+
+ * gen-params: check for nm in ${binutils}/nm.new.
+ * config.shared: Likewise.
+
+Tue Oct 4 12:20:01 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iomanip.h (omanip::operator<<): Make 2nd arg be const.
+ Bug and fix reported by Greg McGary <gkm@magilla.cichlid.com>.
+
+ * strstream.cc (strstreambuf::pcount): Simplify, to match
+ ANSI/ISO specification.
+
+Mon Sep 26 15:19:52 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * gen-params: Include <wchar.h> and <wctype.h> if they exist.
+
+Thu Sep 8 14:41:41 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * iostream.h (class istream): Declare operator>>(long double&).
+ (class ostream): Define operator<<(long double).
+
+ * iostream.cc (istream::operator>>(long double&)): Define.
+
+Wed Sep 7 14:42:29 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iostream.texi (Overflow): Fix bugs in example.
+
+Fri Sep 2 17:45:57 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iostream.tex: Document a little on how to write your
+ own streambuf-derived class, with an example.
+
+Tue Aug 30 13:03:57 1994 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * floatconv.c (s2b): Declare X and Y to be _G_int32_t.
+ (diff, quorem): Declare BORROW, Y, and Z likewise.
+ (ulp): Declare L likewise.
+ (_IO_strtod): Declare L and AADJ likewise.
+ (_IO_dtoa): Declare L and D likewise. Cast division of D by DS to
+ _G_int32_t.
+
+Mon Aug 29 16:01:54 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iosetvbuf.c (_IO_setvbuf): If setting _IOFBF and no
+ buffer was specified, call __doallocate.
+
+ * fileops.c, floatconv.c: Add a bunch of parentheses to
+ shut up gcc warnings. Patch from H.J.Lu.
+
+ * stdiostream.cc (stdiobuf::sys_read): Inline call to getc
+ for the normal case (size==1).
+
+Sat Aug 20 12:14:52 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (VERSION): Increase to 0.66.
+
+Fri Aug 19 17:28:41 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iolibio.h: Added _IO_printf prototype.
+ Added extern "C" { ... } wrappers #ifdef __cplusplus.
+ Bugs reported by Neal Becker <neal@ctd.comsat.com>.
+
+Wed Aug 17 18:17:15 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * fileops.c (_IO_file_seekoff): For _IO_seek_cur, adjust for
+ read-ahead before jumping to label dumb.
+
+Wed Aug 3 13:15:01 1994 H.J. Lu (hjl@nynexst.com)
+
+ * libioP.h (CHECK_FILE(FILE,RET)): new, which checks for
+ FILE == NULL and _IO_MAGIC_MASK.
+ (COERCE_FILE(FILE)): merged into CHECK_FILE(FILE,RET)
+ with typo fixes.
+
+ * iofread.c, iofwrite.c: add CHECK_FILE(fp, 0);
+ * iofclose.c: add CHECK_FILE(fp, EOF); remove _IO_MAGIC_MASK check.
+
+ * iofflush.c, iofgetpos.c, iofputs.c, iofscanf.c,
+ iofsetpos.c, iofvbuf.c, ioungetc.c:
+ Add CHECK_FILE(fp, EOF) and remove COERCE_FILE(fp).
+
+ * iofgets.c: add CHECK_FILE(fp, NULL) and remove COERCE_FILE(fp).
+ * iofprintf.c: add CHECK_FILE(fp, -1) and remove COERCE_FILE(fp).
+ * ioftell.c: add CHECK_FILE(fp, -1L) and remove COERCE_FILE(fp).
+ * iosetbuffer.c: add CHECK_FILE(fp, ) and remove COERCE_FILE(fp).
+
+Fri Aug 12 15:35:39 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iofdopen.c (_IO_fdopen): #define O_ACCMODE if it isn't.
+ Still set O_APPEND if "a" is given, but don't unset it
+ if it isn't. Added comment.
+
+Mon Aug 8 13:11:00 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * gen-params (VTABLE_LABEL_PREFIX): Changes in the implementation.
+ For look for _*vt[$_.]7*filebuf in the nm output, because that
+ matches what g++ produces and has produced. Thus it should be
+ somewhat more robust.
+
+Sun Aug 7 22:52:49 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * gen-params (CC): Remove no-longer-needed -I options
+ passed to xgcc (now they are implied by the -B options).
+
+Wed Jul 20 16:41:13 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (tooldir): Added definition, so we can do
+ 'make install' in this directory.
+ Bug reported by Klamer Schutte <schutte@tpd.tno.nl>.
+
+Mon Jul 18 18:02:34 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * gen-params (VTABLE_LABEL_PREFIX): Remove filename sppearing
+ by itself. Add comment explaining what is going on.
+
+Tue Dec 21 13:02:48 1993 H.J. Lu (hjl@jalod)
+
+ * libio.h: define _IO_uid_t and _IO_HAVE_ST_BLKSIZE
+ as _G_xxxxxxxx.
+
+Tue Dec 21 13:02:48 1993 H.J. Lu (hjl@jalod)
+
+ * iopopen.c: Don't include <errno.h>. It is included in "libioP.h".
+
+ * iopopen.c (_IO_proc_close) : check if fp is on the list
+ before close it.
+
+Thu Jul 14 16:38:47 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * gen-params (CONFIG_NM): Make sed scripts to find vtable name
+ mangling more robost for different forms of nm output.
+
+Tue Dec 21 13:02:48 1993 H.J. Lu (hjl@jalod)
+
+ * iofopen.c (_IO_fopen): don't check [redundantly] fp == NULL after
+ IO_file_init(&fp->_file).
+
+ * iomanip.h (template<class TP> class iapp):
+ change ostream to istream.
+
+Tue Jul 12 14:09:02 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (VERSION): Increase to 0.65.
+ * libioP.h (builtinbuf_vtable): Only define #ifdef __cplusplus.
+
+ * gen-params (_G_int8_t): Only define if defined(__STDC__),
+ because K&R C compilers don't have signed char.
+ (_G_int64_t, _G_uint64_t): Only define if defined(__GNUC__)
+ because other compilers may not have long long.
+
+Sun Mar 06 13:10:21 1994 H.J. Lu (hjl@nynexst.com)
+
+ * floatconv.c (_IO_dtoa ()): fix a small memory leak, set the
+ "on_stack" field to be 0 if "result" is not NULL.
+
+Sat Mar 05 13:18:20 1994 H.J. Lu (hjl@nynexst.com)
+
+ * floatconv.c (_IO_dtoa ()): if the number of digits of the
+ floating point number is more than the previous one, free the
+ old string and allocate a new one.
+ [Minor optimization to avoid Bcopy. -PB]
+
+Mon Jul 11 10:53:41 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * fileops.c (_IO_file_underflow): 'count' should be unsigned,
+ since it contains the return value of read. Reported by
+ Teemu Torma <tot@trema.fi>.
+
+Tue Dec 21 13:02:48 1993 H.J. Lu (hjl@nynexst.com)
+
+ * floatconv.c (_IO_strtod ()): make "+" and "-" as error.
+
+Sat Jul 9 15:09:21 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ Make sure _IO_FILE::_flags is always initialized correctly, for the
+ C functions (fopen, fdopen, popen), and not just the C++ functions.
+ * fileops.c (_IO_file_init): Set _flags to CLOSED_FILEBUF_FLAGS.
+ * fileops.c (_IO_file_fopen): Remove bogus assignment.
+ * filebuf.cc (filebuf constructors): Don't pass CLOSED_FILEBUF_FLAGS
+ to streambuf constructor - _IO_file_init does it instead.
+ * filebuf.cc (CLOSED_FILEBUF_FLAGS): Removed.
+ * iopopen.c (_IO_proc_open): Use _IO_mask_flags.
+
+Thu Jun 30 08:49:53 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * dbz/Makefile.in (mostlyclean): Add target.
+
+Wed Jun 29 09:30:12 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * gen-params: Woops, can't run a C program to determine target
+ characteristics. Sigh.
+
+Tue Jun 28 03:11:33 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * gen-params: Add _G_{,u}int{8,16,64}_t, use a short C program to
+ determine what all these should be rather than trying to compare
+ the MAX numbers in the shell.
+
+Sun Jun 26 21:04:24 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * stdiostream.h, stdiostream.cc (stdiobuf::xsgetn): Removed.
+ Too hairy. If we want to optimize it, we should do so in
+ filebuf::xsgetn (or rather _IO_file_xsgetn).
+
+ * stdiostream.h (class stdiobuf), stdiostream.cc: Fix parameter
+ and return types of virtual function to matcher base types (Oops!).
+ * streamstream.cc (stdiobuf::xsgetn, stdiobuf::xsputn):
+ Optimize to call fread.fwrite directly if !buffered.
+ * fileops.c: Fix comment.
+
+Fri Jun 24 11:28:18 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * stdiostream.h (istdiostream, ostdiostream): New classes.
+
+ More robust final cleanup.
+ * cleanup.c (_IO_register_cleanup): Register _IO_cleanup,
+ rather than _IO_flush_all.
+ * filedoalloc.c: Update comment.
+ * genops.c (_IO_unbuffer_all): New. Makes all files unbuffered.
+ * genops.c (_IO_cleanup), libioP.h: New function. Call
+ _IO_flush_all, and then _IO_unbuffer_all. This is in case C++
+ destructors try to do output *after* _IO_cleanup is called.
+
+ Construct standard stdiobufs statically (using type punning).
+ * stdstrbufs.c; Unless _STDIO_USES_IOSTREAM declare standard
+ stdiobufs (for stdin, stdout, and stderr), using type punning
+ (struct _IO_fake_stdiobuf). This avoids constructor-time problems.
+ * stdstreams.cc: Remove the declarations of the stdiobufs.
+ Instead use the new (fake) ones in stdstrbufs.cc. We no longer
+ have to call ios::sync_with_stdio at constructor time.
+
+ Preliminary support for new ANSI streambuf::uflow virtual.
+ * libioP.h (struct _IO_jump_t): Add __uflow field.
+ * genops.c (_IO_default_uflow), libioP.h: New function.
+ * fileops.c (_IO_file_jumps), iopopen.c (IO_proc_jumps),
+ iovfprintf.c (_IO_helper_jumps), strops.c (_IO_str_jumps),
+ streambuf.cc (_IO_streambuf_jumps): Add _IO_default_uflow.
+ * genops.c (__uflow): New function.
+ (save_for_backup): New function. Some code shared by
+ __underflow and __uflow, moved out from the former.
+ (_IO_default_uflow): New function.
+ * libio.h (_IO_getc): Call __uflow, not __underflow.
+
+Wed Jun 22 20:22:49 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ Make sure that the vtable of a streambuf is always valid,
+ which makes ios::rdbuf simpler and faster.
+ * gen-params: Add code to determine _G_VTABLE_LABEL_HAS_LENGTH,
+ _G_VTABLE_LABEL_PREFIX, _G_VTABLE_LABEL_PREFIX_ID, and
+ _G_USING_THUNKS, which describe how virtual function tables are named.
+ * stdfiles.c (FILEBUF_LITERAL): Moved to libioP.h.
+ * libioP.h (builtinbuf_vtable): New (complicated) declaration.
+ * filebuf.cc (filebuf::__new), strstream.cc (SET_STR_JUMPS):
+ Initialize vtable to builtinbuf_vtable, not NULL.
+ * stdstrbufs.cc: New file. Same as stdfiles.c, except that
+ vtable is initialized to builtinbuf_vtable, not NULL.
+ * streambuf.h (ios::rdbuf): Can now simplify/optimize, due to
+ above changes. Always, just return _strbuf.
+ * builtinbuf.h, builtinbuf.cc (builtinbuf::vtable,
+ builtinbuf::get_builtin_vtable): Removed. No longer needed.
+ * streambuf.h, builtinbuf.cc (ios::_IO_fix_vtable): No longer needed.
+ Only defined #ifdef _STREAM_COMPAT, for binary compatibility.
+ * Makefile.in: Move stdfiles.o from IO_OBJECTS to STDIO_WRAP_OBJECTS.
+ (IOSTREAM_OBJECT): Add stdstrbufs.o.
+ * Makefile.in (_G_config.h): Pass $(CXXFLAGS) as part of $(CXX).
+
+Fri Feb 11 11:08:01 1994 SBPM Marc GINGOLD (marc@david.saclay.cea.fr)
+
+ * iovfprintf.c (helper_vfprintf): add
+ hp->_IO_file_flags = _IO_MAGIC|(_IO_IS_FILEBUF+_IO_NO_READS);
+ [This is needed because _IO_vfprintf checks for _IO_UNBUFFERED. -PB]
+ [Actually: don't set _IO_IS_FILEBUF. -PB]
+
+Wed Jun 22 13:49:22 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * stdiostream.cc, stdiostream.h (stdiobuf::buffered): New methods.
+
+ * iofdopen.c (_IO_fdopen): Various minor improvements.
+
+ * iovfscanf.c: Don't return EOF on control_failure.
+
+Tue Dec 21 13:02:48 1993 H.J. Lu (hjl@nynexst.com)
+
+ * iovfscanf.c: Enforce the sequence of the conversion specifications.
+
+Fri Jun 17 20:57:22 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iofdopen.c: Use fcntl to check that requested access mode is
+ compatible with existing access mode, and to change the
+ O_APPEND file status flag if need be.
+
+Thu Jun 16 17:33:50 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * streambuf.h (ios::init): Initialize all the fields.
+ This may be overkill, but the current ANSI working paper requires it.
+ * streambuf.h (ios::ios): Reimplement in terms of ios::init.
+ * iostream.cc (Non-default constructors istream::istream,
+ ostream::ostream, iostream::iostream): Cannot use a mem-initializer,
+ because it is ignored if initializing a derived class. Instead,
+ call ios::init.
+
+Wed Jun 15 13:35:37 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * stdstreams.cc (ISTREAM_DEF): Fix typo (it's a _fake_istream, not
+ a _fake_ostream). Reported by Jason Shirk <jshirk@gomez.intel.com>.
+
+ * stdiostream.h, stdiostream.cc (stdiobuf::~stdiobuf): New.
+ Call _IO_do_flush.
+ * stdiostream.cc (stdiobuf::sync): Call _IO_do_flush rather
+ than filebuf::sync (to avoid bad seeks).
+
+ * libioP.h (_IO_do_flush): Add missing parentheses.
+
+Fri Jun 3 19:16:57 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * config.shared (CXXFLAGS): Remove -fno-implicit-templates.
+
+ * iomanip.h: Add explicit external instantiations.
+
+Wed Jun 1 14:14:44 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * libio.h (struct _IO_FILE_plus): Move definition from here ...
+ * libioP.h (struct _IO_FILE_plus): ... to here. Since this
+ file is private to the implementation, we can rename the fields
+ from the implementor's to the user's name anme space.
+ (This avoids a lossage on SCO, whose stdio.h has a #define _file.)
+ * iofdopen.c, iofopen.c, stdfiles.c: Fix field references accordingly.
+ * iopopen.c (struct_IO_proc_file): Rename fields from
+ implementor's name space to user's, and update usages.
+ * streambuf.h (streambuf::_vtable): Re-implement to not need
+ struct _IO_FILE_plus.
+ * strfile.h (struct _IO_strfile_): Likewise.
+
+Wed Jun 1 13:57:48 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * config.shared (CXXFLAGS): Use -fno-implicit-templates instead of
+ -fexternal-templates.
+
+Tue May 31 08:49:28 1994 Mike Stump (mrs@cygnus.com)
+
+ * genops.c, iofclose.c, iofdopen.c, iofopen.c, iopopen.c: Be
+ consistent about protecting #include <stdlib.h>.
+
+ * ioputs.c: Add #include <string.h>, to avoid warning on alpha.
+
+ * iofdopen.c: Add #include <stdlib.h>, so that malloc works on
+ machines where sizeof(int) != sizeof(void *).
+
+Mon May 30 17:26:49 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * pfstream.cc (ipfstream::ipfstream, opfstream::opfstream):
+ Reverse sense of test of return value of procbuf::open.
+ (It returns NULL on failure.)
+
+ * filedoalloc.c (_IO_file_doallocate): Remove dead code for
+ USE_MALLOC_BUF. Add code to return EOF if ALLOC_BUF fails.
+
+Sat May 28 13:47:47 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * iomanip.cc: Explicitly instantiate smanip<int> and
+ smanip<ios::fmtflags>.
+
+Wed May 25 16:04:12 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * strfile.h: Use __P instead of _PARAMS.
+
+Fri May 20 11:42:17 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * libio.h: Rename _PARAMS macro to __P for better glibc and BSD
+ compatibility. (Also define _PARAMS for backwards compatibility.)
+ * cleanup.c, iolibio.h, ioperror.c, iovfprintf.c, iovfscanf.c,
+ libioP.h: Use __P instead of _PARAMS.
+ * iostdio.h: Use __P instead of _ARGS.
+
+ * fileops.c (_IO_file_read): Minor stylistic tweak. (It is
+ preferable to test errno *after* the error return.)
+
+Fri May 13 15:25:36 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * iostream.*: Add insertor and extractor for bool (just pretend
+ it's an int).
+
+Fri May 13 14:12:03 1994 Mike Stump (mrs@cygnus.com)
+
+ * gen-params: Check for builtin bool support.
+
+Wed May 11 00:48:35 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ Make libg++ build with gcc -ansi -pedantic-errors
+ * gen-params: #ifdef __STRICT_ANSI__, #define _G_NO_NRV.
+ * pfstream.cc (ipfstream::ipfstream): Wrap use of variable-size
+ array in #ifndef __STRICT_ANSI__.
+
+Fri May 6 12:42:21 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (VERSION): Increase to 0.64.
+
+ * isgetline.cc (istream::getline): The delimiter should *not*
+ be included in the gcount().
+
+ * filedoalloc.c: #include <stdlib.h> (If __STDC__) to get malloc.
+ * iostream.h (ostream::put): Remove overloaded versions, to match
+ new working paper. (Actually just put inside _STREAM_COMPAT, for now.)
+
+Tue May 3 14:14:57 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * genops.c (_IO_default_finish): Make robust when called
+ multiple times on the same _IO_FILE*. (One way this can
+ happen is by the builtinbuf destructor being followed by the
+ streambuf destructor.)
+
+Mon May 2 13:55:26 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * gen-params: Actually determine wint_t rather than depending on
+ cpp to provide it or defaulting to the underlying type for
+ wchar_t.
+
+Sat Apr 30 14:47:30 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * gen-params: Add _G_wint_t, allow __*_TYPE__ to override values
+ at compile time, fix definition of _G_ARGS.
+
+Fri Apr 29 16:55:37 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * libio.h: Remove #pragma interface. (There is no implementation.)
+
+Mon Mar 28 14:22:26 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iostream.cc (ostream::operator<<(double)): Add/fix support
+ for printing '+' when ios::showpos is set.
+ (Fixes bug reported by Doug Moore <dougm@cs.rice.edu>.)
+ * iostream.cc (istream::read): Set eofbit as well as failbit on eof.
+ * iostream.cc (ostream::operator<<(int)): Fix conversion
+ to unsigned (used to lose on INT_MIN).
+ * iostream.cc (ostream::operator<<(long)): Use (unsigned long),
+ rather than (unsigned) for temporary.
+
+ * config.shared, Makefile.in: Remove definitions and uses
+ of XTRAFLAGS. It is no longer needed, since it is
+ now implied by the -B flag.
+
+Fri Mar 25 00:31:22 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * builtinbuf.h: Add put /**/ around comment on trailing #endif.
+
+ * Makefile.in (c++clean): Make clean in tests subdir, too.
+
+Wed Mar 23 16:42:09 1994 Doug Evans (dje@canuck.cygnus.com)
+
+ * configure.in: Remove Makefile.tem before creating it.
+ Needed when configuring from read-only source trees.
+
+Wed Mar 16 14:06:42 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * stdstreams.cc: Fix so that stdiobuf are used for cin/cout/cerr,
+ unless _STDIO_USES_IOSTREAM is defined.
+ * filebuf.cc (filebuf::setbuf): Fix confusion about return
+ value from _IO_file_setbuf.
+
+Sun Mar 13 00:54:12 1994 Paul Eggert (eggert@twinsun.com)
+
+ * config.shared: Ensure that `all' precedes `.PHONY';
+ BSDI 1.1 needs this.
+
+Sat Mar 12 03:58:00 1994 Paul Eggert (eggert@twinsun.com)
+
+ * config.shared: Output a definition of INSTALL that uses
+ $${rootme}, not ${rootme}. Most `make's don't care, but BSDI
+ 1.1 `make' does.
+
+Fri Mar 4 17:33:01 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iopopen.c: #define _POSIX_SOURCE.
+ * isgetline.c (istream::getline): Various fixes.
+
+Thu Mar 3 17:58:20 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iostream.cc (write_int): Fix test for when to add initial '0'
+ when ios::oct and ios::showbase are set.
+ For hex, showbase adds initial 0x (or 0X) regardless of val==0.
+ Bugs reported by Phil Roth <proth@cs.uiuc.edu>.
+
+Mon Feb 21 13:18:20 1994 H.J. Lu (hjl@nynexst.com)
+
+ * libio.h (_IO_PENDING_OUTPUT_COUNT(_fp)): return the
+ pending output count in _fp.
+
+Fri Feb 25 09:26:57 1994 Ian Lance Taylor (ian@cygnus.com)
+
+ * gen-params: For HAVE_SYS_WAIT, compile dummy.c, not dummy.C.
+
+Tue Feb 22 11:19:09 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * streambuf.h, genops.c, libioP.h: Rename references to
+ _IO_FILE fields other_gbase => _IO_save_base,
+ _aux_limit => _IO_backup_base, and _other_egptr => _IO_save_end.
+ * libio.h: Remove no-longer needed macros _other_gbase,
+ _aux_limit, and _other_egptr.
+ * genops.c (__underflow, _IO_default_finishh, _IO_unsave_markers):
+ Check _IO_save_base for NULL before FREEing it or calling
+ _IO_free_backup_area.
+
+Thu Feb 17 15:26:59 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * gen-params: Improve deduction of _G_uint32 and _G_int32.
+ Should now work for 16-bit, 32-bit, or 64-bit targets.
+ * gen-params: Check for sys/wait.h using ${CC}, since it's
+ now used in a C file, not a C++ file.
+ * floatconv.c: Typedef _G_uint32_t as unsigned32, and use
+ unsigned32 in place of unsigned long. (Needed for Alpha.)
+
+Tue Feb 8 13:40:15 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * fileops.c (_IO_file_close_it): Simplify by using _IO_do_flush.
+ * fileops.c (_IO_file_finish): Don't call _IO_file_close_it -
+ do it inline. Call _IO_do_flush even if _IO_DELETE_DONT_CLOSE.
+ * fileops.c (_IO_file_attach): Set _IO_DELETE_DONT_CLOSE.
+ * genops.c (_IO_flush_all): Only call overflow if there is
+ something to write.
+ * iofclose.c (_IO_fclose): Check that magic number is correct,
+ and clear it when done. Avoids crashing some buggy applications.
+ * iogetline.c (_IO_getline): Don't gratuitously increment old_len.
+ * iogets.c (_IO_gets): Take care to get required ANSi semantics.
+
+Sun Feb 6 19:50:39 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * iomanip.cc: Explicitly instantiate operator<< and >>.
+
+Fri Feb 4 12:28:22 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * config.shared (CXXFLAGS): Use -fexternal-templates.
+
+ * iomanip.h: Uncomment #pragma interface.
+
+Thu Jan 20 13:48:40 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ If no characters are read by fgets, ANSI C doesn't allow '\0' to
+ be written to the buffer, but it is required by ANSI C++
+ for istream::get and istream::getline. Both use _IO_getline ...
+ * iogetline.c (_IO_getline): Don't write a '\0' at the end
+ of the read data. The input buffer length does not include
+ space for a '\0'.
+ * iofgets.c, iogets.c: Change appropriately.
+ Also check for _IO_ERR_SEEN, as required by ANSI.
+ * isgetline.cc: Update accordingly.
+
+Mon Jan 17 13:24:26 1994 Jason Merrill (jason@deneb.cygnus.com)
+
+ * Makefile.in (c++clean): Added target for compiler testing
+ (i.e. make c++clean all).
+
+Mon Jan 10 11:20:42 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * libio.h (_IO_putc): Add parentheses.
+ Patch from Rik Faith <faith@cs.unc.edu>.
+
+Tue Jan 4 01:32:28 1993 Hongjiu Lu (hjl@nynexst.com)
+
+ * genops.c (_IO_default_xsputn):
+ (_IO_default_xsgetn):
+ * ioignore.c: change "_IO_size_t count" to
+ "_IO_ssize_t count".
+ * iogetline.c: change "_IO_size_t len" to
+ "_IO_ssize_t len".
+
+Mon Dec 20 00:31:21 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.shared (CXXINCLUDES): Fix quoting of $(NOSTDINC).
+
+Sun Dec 19 21:03:45 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (VERSION): Increase to 0.63.
+
+Fri Dec 17 13:02:44 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iofread.c (_IO_fread): Return 0 if either size or count is 0.
+ * iofwrite.c (_IO_fwrite): Return 0 if either size or count is 0.
+ (This is consistent with fread, and most implementations, but not
+ with a literal reading of the ANSI spec.)
+ * iovfscanf.c (_IO_vfscanf): If got EOF while skipping spaces,
+ set seen_eof and break (instead of returning).
+ * sbscan.cc (streambuf::vscan): Set error state before returning.
+ * streambuf.h: Add a forward declarations for class istream
+ to work around a g++ vtable name mangling bug. (Patch from
+ harry@pdsrc.hilco.com via Jeffrey A Law <law@snake.cs.utah.edu>.)
+ * NEWS: New file.
+
+Sat Dec 11 16:21:08 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iovfprintf.c (struct helper_file, _IO_helper_overflow,
+ helper_vfprintf, _IO_helper_jumps): New structs and functions.
+ (_IO_vfprintf): Use helper_vfprintf to make printing to
+ unbuffered files more efficient.
+ * genops.c (_IO_default_underflow), libioP.h: New function.
+
+ * iovsscanf.c (_IO_vsscanf): The input string's length marks
+ its logical end-of-file.
+
+Wed Dec 8 13:20:46 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * indstream.cc (indirectbuf::sync()): Don't crash if get_stream()
+ or put_stream() are NULL; sync() both streams even if error.
+
+Sun Dec 5 19:24:29 1993 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * iostreamP.h (convert_to_seekflags): Use _IO_seek_set instead of
+ 0 inside the conditial expressions.
+
+ * iofsetpos.c (_IO_fsetpos): Delete unused var `pos'.
+
+Sat Dec 4 15:57:26 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * filedoalloc.c (_IO_file_doallocate): Change type of couldbetty
+ to int, and type of size to _IO_size_t, instead of size_t.
+ (Change needed for Ultrix, which incorrectly deliberately doesn't
+ define size_t in <sys/types.h> if _POSIX_SOURCE is defined.)
+
+Thu Dec 2 22:43:03 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * fileops.c (_IO_file_finish): Remove redundant call to _IO_un_link.
+ * iofclose.c (_IO_fclose): Don't call fp->_jumps->__close; it's
+ too low-level. Instead call _IO_file_close_it.
+ * dbz/Makefile.in (rclean, distclean): Add some missing files.
+
+Wed Dec 1 13:19:14 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config/hpux.mt (MATH_H_INLINES): No longer define.
+ Patch from Jeffrey A Law <law@snake.cs.utah.edu>.
+
+Fri Nov 26 13:28:36 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.shared (CINCLUDES): Define default if libg++.
+ * iofread.c: Use _IO_sgetn.c.
+ * iolibio.h (_IO_clearerr): Fix typo.
+ * genops.c (_IO_seekmark): Return 0 on success.
+ * floactconv.c (Binit): Change to static.
+ * iofclose.c (_IO_fclose): Check if file is _IO_stdin, _IO_stdout,
+ or _IO_stderr; if so don't try to free it. Fix from hjl@nynexst.com.
+
+ * genops.c (_IO_default_sync), libioP.h: New function.
+ * libioP.h (_IO_default_close): Use _IO_default_sync -same interface.
+
+ * Makefile.in: Increase version to 0.62.
+ * iopopen.c (_IO_proc_close): Use waitpid (available in libibarty,
+ if needed), rather than wait. Don't block/ignore SIGINT etc,
+ as this is counter to Posix.2.
+ * iopopen.c: Chain open proc_files, and have the child close
+ the ones that are open (as required by Posix.2).
+
+ * fstream.h (fstreambase::rdbuf), strstream.h (strstreambase
+ ::rdbuf): Call ios::rdbuf() instead of getting _strbuf directly.
+
+ * sbscan.cc (streambuf::vscan): Comment out duplicate default arg.
+ * floatconv.c: Recognize Alpha and i860 as little-endian.
+ * streambuf.cc: Return two bogus value returns from void functions.
+ * iolibio.h, iofwrite.c: Fix buffer type to (const void*).
+ * libio.h: Predefine of struct _IO_FILE to help non-g++-compilers.
+ * libioP.h, pfstream.cc, stdfiles.c, iovfscanf.c: Cleanup syntax junk.
+ * stdstreams.cc: Minor simplification.
+ * streambuf.h, builtinbuf.cc: Add non-const ios::_IO_fix_vtable()
+ for temporary binary compatibility.
+
+ * filedoalloc.c, fileops.c: Add _POSIX_SOURCE.
+ * fileops.c, iofopen.c, iofputs.c, iostream.cc, strops.c,
+ strstream.cc, genops.c: Add some missing #includes.
+ * iofopen.c, iofdopen.c: Return NULL if malloc fails.
+ * iovfscanf.c: Fix return type in strtol prototype.
+ * fwrite.c: Remove bogus file.
+
+Wed Nov 17 14:09:42 1993 Per Bothner (bothner@cygnus.com)
+
+ * builtinbuf.cc (ios::_IO_fix_vtable), streambuf.h: Make method
+ const, to reduce problems with -Wcast-qual.
+
+Tue Nov 16 19:30:42 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * config.shared (CXXINCLUDE): use ${} instead of $() for NOSTDINC
+
+Tue Nov 16 14:15:45 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iopopen.c (_IO_proc_close): Re-structure to avoid
+ declarations after statements.
+ * floatconv.c: If not __STDC__, #define DBL_MANT_DIG.
+ * config/isc.mt (G_CONFIG_ARGS): Remove bogus spaces.
+ Patch from David A. Avery <daa@nic.cerf.net>.
+
+Tue Nov 16 15:58:31 1993 Mark Eichin (eichin@cygnus.com)
+
+ * Makefile.in (_G_config.h): explicitly use $(SHELL) to run
+ gen-params, since we know it is a script (we're explicitly looking
+ in ${srcdir} for it) and /bin/sh might not be good enough.
+
+Mon Nov 15 13:26:22 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * builtinbuf.cc: Don't depend on initialization of static
+ variable builtinbuf::vtable, since that might happen after
+ we need it (for a static constructor). Instead, initialize
+ it when needed by inlining the code from get_builtin_vtable
+ into ios::_IO_fix_vtable().
+
+ * floatconv.c: Avoid using #elif, which some C compilers lack.
+ * iogetline.c, libioP.h: Make char parameter be int, to avoid
+ some default promotion anomalies.
+
+Fri Nov 5 11:49:46 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config.shared (do-clean-dvi): Remove TeX work files.
+ * iopopen.c (extern _IO_fork): Don't use parameter type void.
+ * strops.c (_IO_str_init_static): Clear the allocate_buffer
+ function pointer, to mark the strfile as being static.
+ Bug fix from Mike Raisbeck <mike@pudding.rtr.COM>.
+
+Thu Nov 4 10:44:24 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * filebuf.cc (filebuf:): Use sseekoff rather than seekoff
+ (which loses if vtable pointer is NULL).
+
+ * iostream.cc (ostream::operator<<(long long n)): Fix thinko.
+
+ * Makefile.in (VERSION): Increase to 0.60.
+ * Makefile.in (IO_OBJECTS): Added iopopen.o.
+ * config.shared (DISTCLEAN): Also remove Make.pack.
+ * config.shared (CXXINCLUDES): Add $(NOSTDINC).
+
+ * config.shared (INSTALL): Fix so it ues the correct install.sh
+ whether $srcdir is absolute or relative.
+
+ * floatconv.c (DBL_MAX_10_EXP): Fix default value.
+
+Wed Nov 3 10:20:49 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * gen-params: Make more robust to allow random junk (NeXT
+ has spaces) before typedefs.
+
+ * fileops.c (_IO_file_overflow): Reduce code duplication.
+ * Makefile.in (IO_OBJECTS): Remove ioputs.o.
+
+ * iovfscanf.c, libio.h: Extra parameter to _IO_vfscanf,
+ for optionally setting an error indication..
+ * iofscanf.c, ioscanf.c, iofscanf.c, iovsscanf.c: Fix calls to
+ _IO_vfscanf to pass an extra NULL.
+ * sbscan.cc (streambuf::vscan): If passed an extra stream,
+ set its error state (using new _IO_vfscanf parameter.
+
+ * filedoalloc.c, fileops.c, genops.c, iogetline.c, ioignore.c,
+ libio.h, libioP.h, streambuf.cc streambuf.h, strfile.h, strops.c,
+ strstream.cc: Replace macros (_base, _ebuf, _eback, _gptr, _egptr,
+ _pbase, _pptr, _epptr) by field names (_IO_buf_base, _IO_buf_end,
+ _IO_read_base, _IO_read_pre, IO_read_end, _IO_write_base,
+ _IO_write_ptr, _IO_write_end).
+ * libio.h: Remove the old macros (which fixes a conflict.
+
+Mon Nov 1 15:22:12 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iostream.cc: Use _IO_sputn instead of sputn. _IO_sputn does
+ not require a vtable pointer, and is also slightly faster.
+
+ * builtinbuf.{h,cc} (builtinbuf::setbuf): Fix return and
+ parameter types.
+
+Mon Oct 25 12:56:33 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ Kludge to make sure _IO_FILE buffers get flushed before exit.
+ * dbz/dbzmain.c, dbz/fake.c, dbz/byteflip.c:
+ Invoke DBZ_FINISH macro (if defined) before (normal) exits.
+ * dbz/Makefile.in (CFLAGS): Define DBZ_FINISH to call _IO_flush_all.
+
+Sat Oct 23 22:10:53 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (VERSION): Set to 0.60 for libg++ release.
+ * fileops.c (_IO_file_attach): Set _offset to _IO_pos_BAD.
+ * iostream.cc (ostream::flush): Fix thinkp.
+ * editbuf.cc, isgetsb.cc, isscan.cc, osform.cc, parsestream.cc,
+ pfstream.cc, sbform.cc, sbscan.cc, stdstreams.cc, stream.cc:
+ Replace #include "ioprivate.h" by #include "libioP.h" (and
+ sometimes stdarg.h, stdlib.h and/or string.h).
+ * ioprivate.h: Removed.
+
+
+Thu Oct 21 19:24:02 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * PlotFile.h, SFile.h, editbuf.cc, editbuf.h, filebuf.cc,
+ fstream.cc, fstream.h, indstream.cc, indstream.h, iomanip.cc,
+ iomanip.h, ioprivate.h, iostream.cc, iostream.h, isgetline.cc,
+ isgetsb.cc, parsestream.cc, parsestream.h, pfstream.cc,
+ pfstream.h, procbuf.cc, procbuf.h, stdiostream.cc, stdiostream.h,
+ stdstreams.cc, streambuf.cc, streambuf.h, strstream.cc,
+ strstream.h: Remove old (duplicate) copyright notices.
+
+ * iostream.cc: Fix calls to sync() to be safe in the presence
+ of vtable-less streambufs.
+
+Wed Oct 20 15:22:04 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * streambuf.h (streambuf::underflow, streambuf::overflow):
+ Don't make virtual functions pure.
+ * streambuf.cc (streambuf::underflow, streambuf::overflow):
+ Default definitions (return EOF).
+ * fstream.h: Add new (int fd, char* buf, int len) constructors.
+ These are deprecated, but added for AT&T compatibility.
+ * fstream.cc fstreambase::fstreambase(int fd, char *p, int l): New.
+
+Thu Oct 14 14:57:01 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in: use 'mv -f' instead of 'mv'
+
+Tue Oct 12 05:01:44 1993 Mike Stump (mrs@cygnus.com)
+
+ * floatconv.c: Fix typo, change __STDC to __STDC__.
+
+Mon Oct 11 17:03:12 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * cleanup.c: It should be #if _G_HAVE_ATEXIT, not #ifdef.
+
+ * floatconv.c, iostrerror.c, iovfprintf.c, iovfscanf.c, libioP.h:
+ Bunch of fixes to allow use of non-ANSI (K&R) C compilers.
+
+ * Makefile.in (iostream.list): Use CC=$(CXX) to force use of gcc.
+ * README: New file.
+
+Fri Oct 8 16:19:58 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in: Move ioungetc.o from STDIO_WRAP_OBJECTS to
+ IO_OBJECTS (since it is needed for iovfscanf.c).
+ * iostrerror.c: Add declaration of strerror.
+
+Thu Oct 7 12:02:28 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * cleanup.c: New file, to cause flushing at exit.
+ * filedoalloc.c: Cause flushing on exit.
+ * Makefile.in (OSPRIM_OBJECTS): Add cleanup.o.
+ * gen-params: Check for atexit.
+
+Tue Oct 5 19:11:14 1993 Mike Stump (mrs@cygnus.com)
+
+ * ioperror.c (_IO_strerror): Add missing ()s in _PARAMS usage.
+
+Tue Oct 5 10:33:37 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iofprintf.c, iofscanf.c, ioprintf.c, ioscanf.c, iosprintf.c,
+ iosscanf.c: Remove bogus semi-colon after va_dcl.
+ * ioperror.c: Fix typos in declaration.
+
+Mon Oct 4 17:12:22 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * configure.in (CLEAN): Define (as _G_config.h *.a).
+
+ * fileops.c (_IO_file_read): Don't assume EINTR is defined.
+ * iosetbuf.c: Replace by generalized ...
+ * iosetbuffer.c: ... variant, derived from BSD.
+ * Makefile.in (STDIO_WRAP_OBJECTS): Change correspondingly.
+ * iosetvbuf.c (iosetvbuf): Minor ANSI tweak.
+ * iostdio.h (setbuf, setlinebuf): New #defines.
+ * iolibio.h (_IO_setbuf, _IO_setlinebuf): (Re-)define as macros.
+ * Makefile.in (LIBIO_OBJECTS): New macro.
+
+Tue Sep 28 14:15:52 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * libioP.h (_IO_proc_open, _IO_proc_close): Add missing return types.
+ * procbuf.cc: Belated fixes.
+
+Mon Sep 27 14:04:47 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in: List new files. Add STDIO_WRAP_OBJECTS macro.
+ * floatconv.c (d2b): Use Exp_msk11 instead of Exp_msk1.
+ * iofgetpos.c (_IO_fgetpos), iofsetpos.c (_IO_fsetpos): Clean up.
+ * iolibio.h: New file. Declarations of _IO_foo, for most foo
+ where foo is a stdio function. (Remove these from libio.h.)
+ * iostream.h (istream::istreambuf, ostream::ostreambuf): Move
+ obsolete functions inside #ifdef _STREAM_COMPAT.
+ * libio.h, libioP.h, streambuf.h, parsestream.h, stdiostream.h:
+ Use _IO_fpos_t rather than _IO_pos_t.
+ * iopopen.c: New file type, for pipe (popen-like) streams.
+ * procbuf.cc: Now just a C++ wrapper for the files in iopopen.c.
+ * streambuf.h (ios::unsetf): Return complete old value of flags.
+ * iogets.c (_IO_gets(), ioungetc.c (_IO_ungetc), ioperror.c
+ (_IO_perror), iostrerror.c (_IO_strerror): New files and
+ functions, for stdio implementation.
+ * iostdio.h: Add declarations for various recently-added functions.
+
+Sun Sep 12 14:24:55 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * streambuf.h (ios::showpos):: Fix typo.
+
+Fri Aug 27 12:05:47 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iopadn.c (_IO_padn): Change to return count of chars written.
+ * outfloat.c, iovfprintf.c: Change for new _IO_padn interface.
+ * iostream.cc (ostream::operator<<): Make sure to set badbit
+ on a failure (many places). Use _IO_padn more.
+ * iostream.cc (ostream& ostream::operator<<(const void *p): Move to
+ * osform.cc: ... here, to reduce linking-in-the-world syndrome.
+ * osform.cc: Use rdbuf(), instead of _strbuf directly.
+
+ * genops.c (_IO_sgetn), libio.h: New function.
+ * streambuf.h (streambuf.h::sgetn): Use _IO_sgetn.
+ * SFile.cc (SFile::operator[]): Use sseekoff, not seekoff.
+
+Thu Aug 26 10:16:31 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * config.shared (SUBDIRS): only recurse if the directory is configured
+
+Wed Aug 25 12:56:12 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * config/{hpux.mt, isc.mt, sco4.mt}:
+ Moved from ../libg++/config (since they affect _G_config.h).
+ * configure.in: Set target_make_frag to one of the above files.
+
+Fri Aug 20 00:53:14 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * iofopen.c (iofopen): Fix type passed to _IO_un_link().
+ * Makefile.in (_G_config.h): Pass $CC (not $CXX) as CC.
+
+ * configure.in (configdirs): Add dbz and stdio.
+ * fileops.c (_IO_file_seekoff): Convert more old functionality.
+ * iofdopen.c: Use mode parameter to set _flags.
+ * iofscanf.c, ioputs.c, ioscanf.c, iosprintf.c: New files.
+ * Makefile.in (IO_OBJECTS): Added new objects.
+ * iostdio.h: Add feof. fscanf, puts, sprintf, vsprintf.
+ * libio.h: Add _IO_vprintf macro.
+ * iofopen.c: Invoke _IO_un_link if failure.
+ * iovsprintf.c: Write terminating NUL.
+
+ * libioP.h: Add COERCE_FILE macro (by default does nothing).
+ * iofclose.c, iofflush.c, iofgets.c, iofprintf.c, iofputs.c,
+ iofread.c, ioftell.c, iofwrite.c, iosetbuf.c, iosetvbuf.c:
+ Invoke COERCE_FILE macro.
+ * ioftell.c: Use _IO_seekoff.
+
+Wed Aug 18 22:49:56 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * sbform.cc (streambuf::form), sbscan.cc (streambuf::scan):
+ Remove cast to _IO_va_list. (Loses if array type.)
+
+ * libio.h: Handle _IO_va_list for systems that need <stdarg.h>.
+ * floatconv.h: Fix typo (reported by H.J.Lu).
+
+Wed Aug 18 19:34:04 1993 david d `zoo' zuhn (zoo@rtl.cygnus.com)
+
+ * configure.in (INSTALLDIR): handle native vs. cross case
+
+ * Makefile.in (install): don't use $TARGETLIB, set INSTALLDIR to
+ $(libdir)
+
+Wed Aug 18 12:10:03 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in: Rename iostream-files to iostream.list.
+ * configure.in: Add iostream.list to MOSTLYCLEAN.
+
+Tue Aug 17 18:56:59 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in: Depend on _G_config.h where appropriate.
+ * config.shared (CXXINCLUDES): If doing libg++, search ../libio.
+
+Tue Aug 17 17:34:24 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ New directory. Based on old libg++/iostream code,
+ but extensively re-written.
+
+
diff --git a/libio/Makefile.in b/libio/Makefile.in
new file mode 100644
index 00000000000..ccf8f3ecc52
--- /dev/null
+++ b/libio/Makefile.in
@@ -0,0 +1,124 @@
+# Copyright (C) 1993, 1995 Free Software Foundation
+#
+# This file is part of the GNU IO 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.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this library; see the file COPYING. If not, write to the Free
+# Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+srcdir = .
+
+VERSION = 2.8.0
+# The config file (overriden by Linux).
+_G_CONFIG_H=_G_config.h
+tooldir = $(exec_prefix)/$(target)
+INSTALLDIR = $(libdir)
+
+IO_OBJECTS = filedoalloc.o floatconv.o genops.o fileops.o \
+ iovfprintf.o \
+ iovfscanf.o ioignore.o iopadn.o \
+ iofgetpos.o iofread.o iofscanf.o \
+ iofsetpos.o iogetdelim.o iogetline.o \
+ ioprintf.o ioseekoff.o ioseekpos.o \
+ outfloat.o strops.o iofclose.o iopopen.o ioungetc.o
+
+# These emulate stdio functionality, but with a different name (_IO_ungetc
+# instead of ungetc), and using _IO_FILE instead of FILE.
+# They are not needed for C++ iostream, nor stdio, though some stdio
+# files are build using the same source files (see stdio/configure.in).
+# They are needed for iostdio.h. They are needed under Linux to avoid
+# version incompatibility problems with the C library.
+# iofclose.o is not here, because it is needed for stdio (by pclose).
+STDIO_WRAP_OBJECTS = iofdopen.o iofflush.o iofgets.o iofopen.o iofprintf.o iofputs.o iofwrite.o \
+ iogets.o ioperror.o ioputs.o ioscanf.o iosetbuffer.o iosetvbuf.o \
+ iosprintf.o iosscanf.o ioftell.o iovsprintf.o iovsscanf.o
+
+IOSTREAM_OBJECTS = builtinbuf.o filebuf.o fstream.o \
+ indstream.o ioassign.o ioextend.o iomanip.o iostream.o \
+ isgetline.o isgetsb.o isscan.o \
+ osform.o procbuf.o sbform.o sbgetline.o sbscan.o \
+ stdiostream.o stdstrbufs.o stdstreams.o stream.o streambuf.o strstream.o \
+ PlotFile.o SFile.o parsestream.o pfstream.o editbuf.o
+
+# These files define _IO_read etc, which are just wrappers for read(2) etc.
+# They need to be changed to use name-space-clean (e.g. __read) versions
+# for each specific libc.
+OSPRIM_OBJECTS = ioprims.o iostrerror.o cleanup.o
+
+LIBIOSTREAM_OBJECTS = $(IO_OBJECTS) $(IOSTREAM_OBJECTS) $(OSPRIM_OBJECTS)
+LIBIO_OBJECTS = $(IO_OBJECTS) $(STDIO_WRAP_OBJECTS) $(OSPRIM_OBJECTS) stdfiles.o
+
+LIBIOSTREAM_DEP = $(LIBIOSTREAM_OBJECTS)
+LIBIOSTREAM_USE = $(LIBIOSTREAM_OBJECTS)
+
+USER_INCLUDES = *.h
+
+#### package, host, target, and site dependent Makefile fragments come in here.
+##
+
+libio.a: $(_G_CONFIG_H) $(LIBIO_OBJECTS)
+ -rm -rf libio.a
+ $(AR) $(AR_FLAGS) libio.a $(LIBIO_OBJECTS)
+ $(RANLIB) libio.a
+
+libiostream.a: $(_G_CONFIG_H) $(LIBIOSTREAM_DEP)
+ -rm -rf libiostream.a
+ $(AR) $(AR_FLAGS) libiostream.a $(LIBIOSTREAM_USE)
+ $(RANLIB) libiostream.a
+
+test: test.o libio.a
+ $(CC) $(CFLAGS) -o test test.o libio.a
+tpipe: tpipe.o libio.a
+ $(CC) $(CFLAGS) -o tpipe tpipe.o libio.a
+
+iostream.list: stamp-picdir $(_G_CONFIG_H) $(LIBIOSTREAM_DEP)
+ @echo "$(LIBIOSTREAM_USE)"> iostream.list
+
+stdio/stdio.list: force
+ @rootme=`pwd`/ ; export rootme; cd stdio ; \
+ $(MAKE) $(FLAGS_TO_PASS) stdio.list
+
+stdio.list: stdio/stdio.list
+ rm -f tstdio.list
+ sed 's,\([a-z_]*\.o\),stdio/\1,g' stdio/stdio.list > tstdio.list
+ mv tstdio.list stdio.list
+
+_G_config.h: ${srcdir}/gen-params
+ rootme=`pwd`/ ; export rootme; \
+ CC="$(CC)"; export CC; \
+ CXX="$(CXX) $(NOSTDINC) $(CXXFLAGS)"; export CXX; \
+ CONFIG_NM="$(NM)"; export CONFIG_NM; \
+ $(SHELL) ${srcdir}/gen-params LIB_VERSION=$(VERSION) $(G_CONFIG_ARGS) >tmp-params.h
+ mv tmp-params.h _G_config.h
+
+install:
+ rootme=`pwd`/ ; export rootme ; \
+ if [ -z "$(MULTISUBDIR)" ]; then \
+ if [ "$(_G_CONFIG_H)" != "" ]; then \
+ rm -f $(tooldir)/include/_G_config.h ; \
+ $(INSTALL_DATA) _G_config.h $(tooldir)/include/_G_config.h || exit 1; \
+ else true; \
+ fi ; \
+ cd $(srcdir); \
+ for FILE in $(USER_INCLUDES); do if [ $$FILE != _G_config.h ]; then \
+ rm -f $(gxx_includedir)/$$FILE ; \
+ $(INSTALL_DATA) $$FILE $(gxx_includedir)/$$FILE ; \
+ chmod a-x $(gxx_includedir)/$$FILE ; \
+ else true; fi; done ; \
+ else true; \
+ fi
+ @rootme=`pwd`/ ; export rootme ; \
+ $(MULTIDO) $(FLAGS_TO_PASS) multi-do DO=install
+
+c++clean:
+ rm -rf $(IOSTREAM_OBJECTS)
+ @$(MAKE) $(FLAGS_TO_PASS) "DODIRS=tests" DO=clean subdir_do
diff --git a/libio/NEWS b/libio/NEWS
new file mode 100644
index 00000000000..4a4ade28370
--- /dev/null
+++ b/libio/NEWS
@@ -0,0 +1,51 @@
+*** Major changes in libio version 2.7.0:
+
+* The data representations of _IO_FILE and streambufs have been modified.
+ The layout of the jump-table table _IO_jumps_t has been re-arranged
+ to match that of a virtual function table of a streambuf. Therefore,
+ we no longer need a separate _IO_FILE::_jumps pointer; instead it can
+ be shared with the virtual function table pointer. In addition to
+ saving space, this also removes the overhead when double indirection
+ was needed, and there are many simplificatons (e.g. we no longer need
+ the builtinbuf class.
+
+* The streambuf::uflow virtual has been added, to match the standard.
+
+* The ifstream, ofstream, and fstream classes now include the filebuf
+ as a member, rather than being pointed to it. Various related changes.
+
+* Version number changed to generally follow libg++ (and gcc).
+
+*** Major changes in libio version 0.66 (released with libg++ 2.6.1):
+
+* Some documentation and an example in iostream.texi on how to derive
+ your own class from streambuf.
+
+* New functions added to stdio: getline, detdelim, snprintf, vsnprintf.
+ This is for compatibility with the GNU C library.
+
+*** Major changes in libio version 0.65 (released with libg++ 2.6):
+
+* _IO_getline and streambuf::sgetline no longer write a '\0' at the end.
+
+* A number of improvements to get closer to the ANSI/ISO C++ working
+paper, such as:
+- Added (preliminary support for) new ANSI streambuf::uflow virtual.
+- Added istdiostream and ostdiostream classes.
+- Added ostream::operator<<(bool) and istream::operator>>(bool&).
+
+* More robust (and faster) initialization and cleanup of standard streambufs.
+
+* Many small bug fixes, portability improvements, and random enhancements.
+
+*** Major changes in libio version 0.63 (released with libg++ 2.5.3):
+
+* There is a g++ bug that causes inconsistent name mangling for the
+assembler name of the virtual function table for the istream class.
+A work-around has been put into streambuf.h, which will make g++
+always do the right thing. Note that this may require you to
+recompile programs that were incorrectly compiled by g++.
+
+* Functions that do printf-style formatting to the unbuffered
+streams have been optimized to write to a temporary buffer.
+
diff --git a/libio/PlotFile.cc b/libio/PlotFile.cc
new file mode 100644
index 00000000000..98b2d839555
--- /dev/null
+++ b/libio/PlotFile.cc
@@ -0,0 +1,157 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+// This may look like C code, but it is really -*- C++ -*-
+/*
+Copyright (C) 1988, 1992, 1993 Free Software Foundation
+ written by Doug Lea (dl@rocky.oswego.edu)
+ converted to use iostream library by Per Bothner (bothner@cygnus.com)
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with GCC to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#include <PlotFile.h>
+
+/*
+ PlotFile implementation module
+*/
+
+
+PlotFile& PlotFile:: cmd(char c)
+{
+ ofstream::put(c);
+ return *this;
+}
+
+PlotFile& PlotFile:: operator<<(const int x)
+{
+#if defined(convex)
+ ofstream::put((char)(x>>8));
+ ofstream::put((char)(x&0377));
+#else
+ ofstream::put((char)(x&0377));
+ ofstream::put((char)(x>>8));
+#endif
+ return *this;
+}
+
+PlotFile& PlotFile:: operator<<(const char *s)
+{
+ *(ofstream*)this << s;
+ return *this;
+}
+
+
+PlotFile& PlotFile:: arc(const int xi, const int yi,
+ const int x0, const int y0,
+ const int x1, const int y1)
+{
+ return cmd('a') << xi << yi << x0 << y0 << x1 << y1;
+}
+
+
+PlotFile& PlotFile:: box(const int x0, const int y0,
+ const int x1, const int y1)
+{
+ line(x0, y0, x0, y1);
+ line(x0, y1, x1, y1);
+ line(x1, y1, x1, y0);
+ return line(x1, y0, x0, y0);
+}
+
+PlotFile& PlotFile:: circle(const int x, const int y, const int r)
+{
+ return cmd('c') << x << y << r;
+}
+
+PlotFile& PlotFile:: cont(const int xi, const int yi)
+{
+ return cmd('n') << xi << yi;
+}
+
+PlotFile& PlotFile:: dot(const int xi, const int yi, const int dx,
+ int n, const int* pat)
+{
+ cmd('d') << xi << yi << dx << n;
+ while (n-- > 0) *this << *pat++;
+ return *this;
+}
+
+PlotFile& PlotFile:: erase()
+{
+ return cmd('e');
+}
+
+PlotFile& PlotFile:: label(const char* s)
+{
+ return cmd('t') << s << "\n";
+}
+
+PlotFile& PlotFile:: line(const int x0, const int y0,
+ const int x1, const int y1)
+{
+ return cmd('l') << x0 << y0 << x1 << y1;
+}
+
+PlotFile& PlotFile:: linemod(const char* s)
+{
+ return cmd('f') << s << "\n";
+}
+
+PlotFile& PlotFile:: move(const int xi, const int yi)
+{
+ return cmd('m') << xi << yi;
+}
+
+PlotFile& PlotFile:: point(const int xi, const int yi)
+{
+ return cmd('p') << xi << yi;
+}
+
+PlotFile& PlotFile:: space(const int x0, const int y0,
+ const int x1, const int y1)
+{
+ return cmd('s') << x0 << y0 << x1 << y1;
+}
diff --git a/libio/PlotFile.h b/libio/PlotFile.h
new file mode 100644
index 00000000000..82b08bc4681
--- /dev/null
+++ b/libio/PlotFile.h
@@ -0,0 +1,89 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/*
+ a very simple implementation of a class to output unix "plot"
+ format plotter files. See corresponding unix man pages for
+ more details.
+
+ written by Doug Lea (dl@rocky.oswego.edu)
+ converted to use iostream library by Per Bothner (bothner@cygnus.com)
+*/
+
+#ifndef _PlotFile_h
+#ifdef __GNUG__
+#pragma interface
+#endif
+#define _PlotFile_h
+
+#include <fstream.h>
+
+/*
+ Some plot libraries have the `box' command to draw boxes. Some don't.
+ `box' is included here via moves & lines to allow both possiblilties.
+*/
+
+extern "C++" {
+class PlotFile : public ofstream
+{
+protected:
+ PlotFile& cmd(char c);
+ PlotFile& operator << (const int x);
+ PlotFile& operator << (const char *s);
+
+public:
+
+ PlotFile() : ofstream() { }
+ PlotFile(int fd) : ofstream(fd) { }
+ PlotFile(const char *name, int mode=ios::out, int prot=0664)
+ : ofstream(name, mode, prot) { }
+
+// PlotFile& remove() { ofstream::remove(); return *this; }
+
+// int filedesc() { return ofstream::filedesc(); }
+// const char* name() { return File::name(); }
+// void setname(const char* newname) { File::setname(newname); }
+// int iocount() { return File::iocount(); }
+
+ PlotFile& arc(const int xi, const int yi,
+ const int x0, const int y0,
+ const int x1, const int y1);
+ PlotFile& box(const int x0, const int y0,
+ const int x1, const int y1);
+ PlotFile& circle(const int x, const int y, const int r);
+ PlotFile& cont(const int xi, const int yi);
+ PlotFile& dot(const int xi, const int yi, const int dx,
+ int n, const int* pat);
+ PlotFile& erase();
+ PlotFile& label(const char* s);
+ PlotFile& line(const int x0, const int y0,
+ const int x1, const int y1);
+ PlotFile& linemod(const char* s);
+ PlotFile& move(const int xi, const int yi);
+ PlotFile& point(const int xi, const int yi);
+ PlotFile& space(const int x0, const int y0,
+ const int x1, const int y1);
+};
+} // extern "C++"
+#endif
diff --git a/libio/README b/libio/README
new file mode 100644
index 00000000000..c2d564965ca
--- /dev/null
+++ b/libio/README
@@ -0,0 +1,30 @@
+This is libio, the GNU C/C++ input/output library.
+
+By default, the library is configured to build the C++ iostream
+facility (in $libdir/libiostream.a).
+
+The library can be configured to build the C stdio facility
+that is part of a C run-time library.
+
+This library is distributed with libg++; see ../libg++/README
+for installation instructions, and where to send bug reports
+and questions.
+
+* Copyright restrictions
+
+The files in this directory are generally covered by the GNU Public
+License (which is in the file ../COPYING), but modified with the
+following:
+
+ As a special exception, if you link this library with files
+ compiled with a GNU compiler to produce an executable, this does not cause
+ the resulting executable to be covered by the GNU General Public License.
+ This exception does not however invalidate any other reasons why
+ the executable file might be covered by the GNU General Public License.
+
+A few source files and subroutines are covered by other (but
+less restrictive) copyright conditions. E.g. some code (such
+as iovfprintf.c) is based on software that was developed by the
+University of California, Berkeley, for the Berkeley Software
+Distribution (BSD-4.4), and bears their copyright; and one
+file (floatconv.c) is derived from ("free") code copyrighted AT&T.
diff --git a/libio/SFile.cc b/libio/SFile.cc
new file mode 100644
index 00000000000..e5daa645695
--- /dev/null
+++ b/libio/SFile.cc
@@ -0,0 +1,82 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/*
+Copyright (C) 1988 Free Software Foundation
+ written by Doug Lea (dl@rocky.oswego.edu)
+
+This file is part of the GNU C++ 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. 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, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+*/
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#include <SFile.h>
+
+SFile::SFile(const char *filename, int size, int mode, int prot)
+: fstream(filename, mode, prot)
+{
+ sz = size;
+}
+
+SFile::SFile(int fd, int size)
+: fstream(fd)
+{
+ sz = size;
+}
+
+void SFile::open(const char *name, int size, int mode, int prot)
+{
+ fstream::open(name, mode, prot);
+ sz = size;
+}
+
+SFile& SFile::get(void* x)
+{
+ read(x, sz);
+ return *this;
+}
+
+SFile& SFile::put(void* x)
+{
+ write(x, sz);
+ return *this;
+}
+
+SFile& SFile::operator[](long i)
+{
+ if (rdbuf()->pubseekoff(i * sz, ios::beg) == EOF)
+ set(ios::badbit);
+ return *this;
+}
diff --git a/libio/SFile.h b/libio/SFile.h
new file mode 100644
index 00000000000..f07277cee49
--- /dev/null
+++ b/libio/SFile.h
@@ -0,0 +1,55 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1988, 1992, 1993 Free Software Foundation
+ written by Doug Lea (dl@rocky.oswego.edu)
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifndef _SFile_h
+#ifdef __GNUG__
+#pragma interface
+#endif
+#define _SFile_h 1
+
+#include <fstream.h>
+
+extern "C++" {
+class SFile: public fstream
+{
+ protected:
+ int sz; // unit size for structured binary IO
+
+public:
+ SFile() : fstream() { }
+ SFile(int fd, int size);
+ SFile(const char *name, int size, int mode, int prot=0664);
+ void open(const char *name, int size, int mode, int prot=0664);
+
+ int size() { return sz; }
+ int setsize(int s) { int old = sz; sz = s; return old; }
+
+ SFile& get(void* x);
+ SFile& put(void* x);
+ SFile& operator[](long i);
+};
+} // extern "C++"
+
+#endif
diff --git a/libio/builtinbuf.cc b/libio/builtinbuf.cc
new file mode 100644
index 00000000000..05e65a5c371
--- /dev/null
+++ b/libio/builtinbuf.cc
@@ -0,0 +1,78 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifdef __GNUC__
+#pragma implementation
+#endif
+#define _STREAM_COMPAT
+#include "builtinbuf.h"
+#include "iostreamP.h"
+#if !_IO_UNIFIED_JUMPTABLES
+int builtinbuf::overflow(int ch) { return _IO_OVERFLOW (this, ch); }
+
+int builtinbuf::underflow() { return _IO_UNDERFLOW (this); }
+
+streamsize builtinbuf::xsgetn(char* buf, streamsize n)
+{ return _IO_XSGETN (this, buf, n); }
+
+streamsize builtinbuf::xsputn(const char* buf, streamsize n)
+{ return _IO_XSPUTN (this, buf, n); }
+
+int builtinbuf::doallocate() { return _IO_DOALLOCATE (this); }
+
+builtinbuf::~builtinbuf() { _IO_FINISH (this); }
+
+int builtinbuf::sync() { return _IO_SYNC (this); }
+
+streambuf* builtinbuf::setbuf(char *buf, int n)
+{ return (streambuf*)_IO_SETBUF (this, buf, n); }
+
+streampos builtinbuf::seekoff(streamoff off, _seek_dir dir, int mode)
+{
+ return _IO_SEEKOFF (this, off, dir, mode);
+}
+
+streampos builtinbuf::seekpos(streampos pos, int mode)
+{
+ return _IO_SEEKPOS (this, pos, mode);
+}
+
+int builtinbuf::pbackfail(int c)
+{ return _IO_PBACKFAIL (this, c); }
+
+streamsize builtinbuf::sys_read(char* buf, streamsize size)
+{ return _IO_SYSREAD (this, buf, size); }
+
+streampos builtinbuf::sys_seek(streamoff off, _seek_dir dir)
+{ return _IO_SYSSEEK (this, off, dir); }
+
+streamsize builtinbuf::sys_write(const char* buf, streamsize size)
+{ return _IO_SYSWRITE (this, buf, size); }
+
+int builtinbuf::sys_stat(void* buf) // Actually, a (struct stat*)
+{ return _IO_SYSSTAT (this, buf); }
+
+int builtinbuf::sys_close()
+{ return _IO_SYSCLOSE (this); }
+#endif
diff --git a/libio/builtinbuf.h b/libio/builtinbuf.h
new file mode 100644
index 00000000000..0e0c6e85a9e
--- /dev/null
+++ b/libio/builtinbuf.h
@@ -0,0 +1,68 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifndef _BUILTINBUF_H
+#define _BUILTINBUF_H
+
+#ifdef __GNUC__
+#pragma interface
+#endif
+
+#include <streambuf.h>
+
+#if !_IO_UNIFIED_JUMPTABLES
+// A builtinbuf a a streambuf where all the virtual operations
+// call the _IO_jump_t table.
+
+extern "C++" {
+class builtinbuf : public streambuf {
+ friend ios;
+ virtual int overflow(int);
+ virtual int underflow();
+ virtual streamsize xsgetn(char *, streamsize);
+ virtual streamsize xsputn(const char *, streamsize);
+ virtual streambuf* setbuf(char*, int);
+ virtual int doallocate();
+ virtual ~builtinbuf();
+ virtual int sync();
+
+ virtual streampos seekoff(streamoff, _seek_dir, int mode=ios::in|ios::out);
+ virtual streampos seekpos(streampos pos, int mode = ios::in|ios::out);
+ virtual int pbackfail(int c);
+ virtual streamsize sys_read(char* buf, streamsize size);
+ virtual streampos sys_seek(streamoff, _seek_dir);
+ virtual streamsize sys_write(const char*, streamsize);
+ virtual int sys_stat(void*); // Actually, a (struct stat*)
+ virtual int sys_close();
+#if 0
+ virtual int get_column();
+ virtual int set_column(int);
+#endif
+ private:
+ builtinbuf() { }
+};
+} // extern "C++"
+#endif
+
+#endif /* _BUILTINBUF_H */
diff --git a/libio/cleanup.c b/libio/cleanup.c
new file mode 100644
index 00000000000..a0c5052d395
--- /dev/null
+++ b/libio/cleanup.c
@@ -0,0 +1,17 @@
+#include "libioP.h"
+#if _G_HAVE_ATEXIT
+#include <stdlib.h>
+
+typedef void (*voidfunc) __P((void));
+
+static void
+DEFUN_VOID(_IO_register_cleanup)
+{
+ atexit ((voidfunc)_IO_cleanup);
+ _IO_cleanup_registration_needed = 0;
+}
+
+void (*_IO_cleanup_registration_needed)() = _IO_register_cleanup;
+#else
+void (*_IO_cleanup_registration_needed)() = NULL;
+#endif /* _G_HAVE_ATEXIT */
diff --git a/libio/config.shared b/libio/config.shared
new file mode 100644
index 00000000000..8c79350e6f5
--- /dev/null
+++ b/libio/config.shared
@@ -0,0 +1,487 @@
+# Copyright (C) 1993, 1995, 1997 Free Software Foundation
+#
+# This file is part of the GNU IO 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.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU CC; see the file COPYING. If not, write to
+# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Significant variables:
+
+# Note that TO_TOPDIR does *not* include multilib.
+test -z "${TO_TOPDIR}" && TO_TOPDIR=${TOLIBGXX}../
+# Native configurations build target libraries in directories at the same
+# level as the rest of the tree. Cross configurations build target libraries
+# one level deeper. TO_REAL_TOPDIR accounts for this.
+# Obviously, TO_REAL_TOPDIR can only be used in the build tree.
+if [ "${with_target_subdir}" != "." ] ; then
+ TO_REAL_TOPDIR="${TO_TOPDIR}../"
+else
+ TO_REAL_TOPDIR="${TO_TOPDIR}"
+fi
+DOING_LIBGXX=${DOING_LIBGXX-false}
+THIS_FILE="${srcdir}/${TOLIBGXX}config.shared"
+
+echo "# Start of package fragment generated by ${THIS_FILE}."
+echo ""
+
+# Multilib support.
+echo 'MULTISRCTOP ='
+echo 'MULTIBUILDTOP ='
+echo 'MULTIDIRS ='
+echo 'MULTISUBDIR ='
+echo 'MULTIDO = true'
+echo 'MULTICLEAN = true'
+echo ''
+
+# TOLIBGXX
+# MOSTLYCLEAN
+# CLEAN
+# DISTCLEAN
+# REALCLEAN
+# SUBDIRS [defaults to (configdirs)]
+# INFO_FILES List of (basenames of) texinfo files
+# INFO_SUBDIRS [default: empty] sub-directories containing documentation
+
+# ??? This doesn't appear to be used by us or any of our callers.
+# Note that all uses in this file are single-quoted.
+rootme=${rootme-`pwd`}
+
+# libg++ uses the convention that $rootme includes a trailing '/'.
+# We use that in the definition of TOPDIR. $rootme is either empty
+# or an absolute pathname to the current directory (with trailing '/').
+TOPDIR=${TOPDIR-'$${rootme}$(MULTIBUILDTOP)'${TO_REAL_TOPDIR}}
+echo '#' TOPDIR="${TOPDIR} invsubdir=${invsubdir} subdir=${subdir}"
+SUBDIRS=${SUBDIRS-${configdirs}}
+CHECK_SUBDIRS=${CHECK_SUBDIRS-${SUBDIRS}}
+
+echo "srcdir = ${srcdir}"
+echo "SUBDIRS = ${SUBDIRS}"
+echo "CHECK_SUBDIRS = ${CHECK_SUBDIRS}"
+
+echo "prefix = ${prefix-/usr/local}"
+echo "exec_prefix = ${exec_prefix-'${prefix}'}"
+
+echo 'bindir = $(exec_prefix)/bin'
+echo 'libdir = $(exec_prefix)/lib'
+
+echo 'datadir = $(prefix)/lib'
+echo 'mandir = $(prefix)/man'
+echo 'man1dir = $(mandir)/man1'
+echo 'man2dir = $(mandir)/man2'
+echo 'man3dir = $(mandir)/man3'
+echo 'man4dir = $(mandir)/man4'
+echo 'man5dir = $(mandir)/man5'
+echo 'man6dir = $(mandir)/man6'
+echo 'man7dir = $(mandir)/man7'
+echo 'man8dir = $(mandir)/man8'
+echo 'man9dir = $(mandir)/man9'
+
+echo 'infodir = $(prefix)/info'
+echo 'includedir = $(prefix)/include'
+echo 'gxx_includedir = $(includedir)/g++'
+echo 'docdir = $(datadir)/doc'
+echo ''
+echo 'SHELL = /bin/sh'
+echo ''
+case "$srcdir" in
+ /*) echo 'INSTALL = $(srcdir)'/"${TO_TOPDIR}install-sh -c" ;;
+ .) echo 'INSTALL = $${rootme}'"${with_multisrctop}${TO_REAL_TOPDIR}install-sh -c" ;;
+ *) echo 'INSTALL = $${rootme}$(srcdir)'/"${TO_TOPDIR}install-sh -c" ;;
+esac
+echo 'INSTALL_PROGRAM = $(INSTALL)'
+echo 'INSTALL_DATA = $(INSTALL)'
+echo ''
+echo 'AR = `if [ -f' ${TOPDIR}'binutils/ar ] ; \'
+echo " then echo ${TOPDIR}binutils/ar ; "'\'
+echo ' else echo ar ; fi`'
+echo 'AR_FLAGS = rc'
+echo 'RANLIB = `if [ -f' ${TOPDIR}'binutils/ranlib ] ; \'
+echo ' then echo '${TOPDIR}'binutils/ranlib ; \'
+echo ' else echo ranlib ; fi`'
+echo 'NM = `if [ -f' ${TOPDIR}'binutils/nm.new ] ; \'
+echo ' then echo '${TOPDIR}'binutils/nm.new ; \'
+echo ' else echo nm ; fi`'
+echo 'NLMCONV = `if [ -f' ${TOPDIR}'binutils/nlmconv ] ; \'
+echo ' then echo '${TOPDIR}'binutils/nlmconv ; \'
+echo ' else echo nlmconv ; fi`'
+echo 'LD = `if [ -f' ${TOPDIR}'ld/ld.new ] ; \'
+echo ' then echo '${TOPDIR}'ld/ld.new ; \'
+echo ' else echo ld ; fi`'
+echo ''
+echo 'MAKEINFO = `if [ -f '${TOPDIR}'texinfo/C/makeinfo ] ; \'
+echo ' then echo '${TOPDIR}'texinfo/C/makeinfo ; \'
+echo ' else echo makeinfo ; fi`'
+case "$srcdir" in
+ .) echo 'TEXIDIR = '"${with_multisrctop}${TO_REAL_TOPDIR}texinfo" ;;
+ *) echo 'TEXIDIR = $(srcdir)'/"${TO_TOPDIR}texinfo" ;;
+esac
+echo 'TEXI2DVI = TEXINPUTS=${TEXIDIR}:$$TEXINPUTS texi2dvi'
+echo ''
+echo 'CC = cc'
+echo 'CXX = gcc'
+echo ''
+# FIXME!!!
+if true ; then
+ echo 'WRAP_C_INCLUDES ='
+else
+ echo 'WRAP_C_INCLUDES = -I$(srcdir)'/${TOLIBGXX}g++-include
+fi
+echo 'CFLAGS = -g'
+echo 'CXXFLAGS = -g -O'
+echo 'LIBCFLAGS = $(CFLAGS)'
+echo 'LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates'
+echo 'PICFLAG ='
+if [ "${LIBDIR}" = "yes" ]; then
+ echo 'PICDIR = stamp-picdir'
+else
+ echo 'PICDIR = '
+fi
+
+if test "${DOING_LIBGXX}" = "true" ; then
+ echo "TOLIBGXX = ${TOLIBGXX}"
+ echo 'PROTODIR = $(srcdir)'/${TOLIBGXX}src/gen
+ echo "LIBS = -L./${TOLIBGXX} -L./${TOLIBGXX}../libstdc++ -lg++ -lstdc++"
+
+ # You can override iostream (e.g. in a site- or host-Makefile fragment) to:
+ # iostream (Normal iostream library)
+ # old-stream (Old stream library; no longer supported)
+ # no-stream (If you don't want iostream to be part of libg++)
+ echo 'IO_DIR = ../libio'
+ echo '# IO_DIR = no-stream'
+elif test "${DOING_GPERF}" = "true" ; then
+ echo "IO_DIR = libio"
+ echo "TOLIBGXX = ${TOLIBGXX}"
+ echo "LIBS = -L./${TOLIBGXX} -L./${TOLIBGXX}../libstdc++ -lg++ -lstdc++"
+fi
+
+if [ -z "${ALL}" ] ; then
+ if [ -n "${TARGETLIB}" ] ; then
+ ALL='$(TARGETLIB)'
+ echo "TARGETLIB = ${TARGETLIB}"
+ elif [ -n "${TARGETPROG}" ] ; then
+ ALL='${TARGETPROG}'
+ echo "TARGETPROG = ${TARGETPROG}"
+ else
+ echo "config error: neither ALL, TARGETLIB or TARGETPROG is defined" 1>&2
+ fi
+fi
+
+ALL='$(PICDIR)'" ${ALL}"
+
+echo "all: ${ALL} multi-all"
+if [ "${SUBDIRS}" != "" ] ; then
+ echo ' @rootme=`pwd`/; export rootme; \'
+ echo ' $(MAKE) "DODIRS=$(SUBDIRS)" DO=all $(FLAGS_TO_PASS) subdir_do'
+fi
+echo '.PHONY: all'
+echo ''
+
+echo '.PHONY: multi-all'
+echo 'multi-all:'
+echo ' @$(MULTIDO) $(FLAGS_TO_PASS) multi-do DO=all'
+echo ''
+
+echo
+if [ "${SUBDIRS}" != "" ] ; then
+ echo '.PHONY: subdir_do'
+ echo 'subdir_do: force'
+ echo ' @rootme=`pwd`/; export rootme; \'
+ echo ' for i in $(DODIRS); do \'
+ echo ' if [ -f ./$$i/Makefile ] ; then \'
+ echo ' echo "cd $$i; make $(DO) ..." ; \'
+ echo ' (cd $$i ; $(MAKE) $(FLAGS_TO_PASS) $(DO)) || exit 1 ; \'
+ echo ' else true ; fi ; \'
+ echo ' done'
+ echo ''
+ echo '# List of variables to pass to sub-makes. This should not be needed'
+ echo '# by GNU make or Sun make (both of which pass command-line variable'
+ echo '# overrides thouh $(MAKE)) but may be needed by older versions.'
+ echo ''
+ echo 'FLAGS_TO_PASS= \'
+ echo ' "INSTALL=$(INSTALL)" \'
+ echo ' "INSTALL_DATA=$(INSTALL_DATA)" \'
+ echo ' "INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \'
+ echo ' "prefix=$(prefix)" \'
+ echo ' "exec_prefix=$(exec_prefix)" \'
+ echo ' "tooldir=$(tooldir)" \'
+ echo ' "AR=$(AR)" \'
+ echo ' "AR_FLAGS=$(AR_FLAGS)" \'
+ echo ' "CC=$(CC)" \'
+ echo ' "CXX=$(CXX)" \'
+ echo ' "CFLAGS=$(CFLAGS)" \'
+ echo ' "CXXFLAGS=$(CXXFLAGS)" \'
+ echo ' "NM=$(NM)" \'
+ echo ' "RANLIB=$(RANLIB)" \'
+ echo ' "LIBCFLAGS=$(LIBCFLAGS)" \'
+ echo ' "LIBCXXFLAGS=$(LIBCXXFLAGS)" \'
+ echo ' "LOADLIBES=$(LOADLIBES)" \'
+ echo ' "LDFLAGS=$(LDFLAGS)" \'
+ echo ' "MAKEINFO=$(MAKEINFO)" \'
+ echo ' "SHLIB=$(SHLIB)" \'
+ echo ' "SHCURSES=$(SHCURSES)" \'
+ echo ' "PICFLAG=$(PICFLAG)" \'
+ echo ' "RUNTESTFLAGS=$(RUNTESTFLAGS)"'
+fi
+
+echo 'NOSTDINC = -nostdinc++'
+if test -n "${XCXXINCLUDES}" ; then
+ echo "CXXINCLUDES = ${XCXXINCLUDES} "'$(NOSTDINC)'
+elif test "${DOING_LIBGXX}" = "true" ; then
+ echo 'CXXINCLUDES = $(NOSTDINC) -I. -I'"${TO_TOPDIR}libio"' -I$(srcdir) -I$(srcdir)/'"${TOLIBGXX}"'$(IO_DIR) -I$(srcdir)/'"${TOLIBGXX}"'../libstdc++ -I$(srcdir)/'"${TOLIBGXX}src"' $(WRAP_C_INCLUDES)'
+fi
+if test -n "${XCINCLUDES}" ; then
+ echo "CINCLUDES = ${XCINCLUDES}"
+elif test "${DOING_LIBGXX}" = "true" ; then
+ echo 'CINCLUDES ='
+fi
+
+if [ "${LIBDIR}" = "yes" ]; then
+ echo 'XCFLAGS = $(LIBCFLAGS)'
+ echo 'XCXXFLAGS = $(LIBCXXFLAGS)'
+else
+ echo 'XCFLAGS = $(CFLAGS)'
+ echo 'XCXXFLAGS = $(CXXFLAGS)'
+fi
+
+echo '.SUFFIXES: .o .C .cc .c'
+echo 'COMPILE.c = $(CC) -c $(XCFLAGS) $(CINCLUDES)'
+echo '.c.o:'
+if [ "${LIBDIR}" = "yes" ]; then
+echo ' test -z "$(PICFLAG)" ||\'
+echo ' $(COMPILE.c) $(PICFLAG) $< -o pic/$@'
+fi
+echo ' $(COMPILE.c) $<'
+[ "${TOUCH_ON_COMPILE}" = "yes" ] && echo ' @touch stamp'
+echo 'COMPILE.cc = $(CXX) -c $(XCXXFLAGS) $(CXXINCLUDES)'
+echo '.C.o:'
+if [ "${LIBDIR}" = "yes" ]; then
+echo ' test -z "$(PICFLAG)" ||\'
+echo ' $(COMPILE.cc) $(PICFLAG) $< -o pic/$@'
+fi
+echo ' $(COMPILE.cc) $<'
+[ "${TOUCH_ON_COMPILE}" = "yes" ] && echo ' @touch stamp'
+echo '.cc.o:'
+if [ "${LIBDIR}" = "yes" ]; then
+echo ' test -z "$(PICFLAG)" || \'
+echo ' $(COMPILE.cc) $(PICFLAG) $< -o pic/$@'
+fi
+echo ' $(COMPILE.cc) $<'
+[ "${TOUCH_ON_COMPILE}" = "yes" ] && echo ' @touch stamp'
+echo ''
+
+if [ -n "${TARGETLIB}" ] ; then
+ echo TARGETLIB = ${TARGETLIB}
+fi
+if [ -n "${TARGETPROG}" ] ; then
+ echo TARGETPROG = ${TARGETPROG}
+fi
+
+if [ "${LIBDIR}" = "yes" ]; then
+ echo ''
+ echo 'stamp-picdir:'
+ echo ' if [ -n "$(PICFLAG)" ] && [ ! -d pic ]; then \'
+ echo ' mkdir pic; \'
+ echo ' else true; fi'
+ echo ' touch stamp-picdir'
+fi
+
+echo ''
+echo '.PHONY: install'
+echo 'install:'
+echo '.PHONY: check'
+if [ "${CHECK}" != "check" ] ; then
+ echo "check: ${ALL} ${CHECK}"
+ if [ "${CHECK_SUBDIRS}" != "" ] ; then
+ echo ' rootme=`pwd`/; export rootme; \'
+ echo ' SAVE_LLPATH="$${SAVE_LLPATH-$$LD_LIBRARY_PATH}"; export SAVE_LLPATH; \'
+ echo ' LD_LIBRARY_PATH="$${rootme}${TOLIBGXX}../libstdc++:$${rootme}${TOLIBGXX}../libg++:$$SAVE_LLPATH"; \'
+ echo ' export LD_LIBRARY_PATH; \'
+ echo ' $(MAKE) "DODIRS=$(CHECK_SUBDIRS)" DO=check $(FLAGS_TO_PASS) subdir_do'
+ fi
+fi
+
+# Generate rules for documentation (depending on INFO_FILES and INFO_SUBDIRS).
+
+echo '.PHONY: info dvi install-info clean-info'
+
+# emit the rule for 'info'
+# (Note that the top-level ../Makefile.in greps for '^info:' when making
+# a release (in "make taz"), so don't break that!)
+if [ -z "${INFO_FILES}" ] ; then
+ echo 'info:'
+else
+ echo info: `for file in ${INFO_FILES} ; do echo $file.info ; done`
+fi
+if [ "${INFO_SUBDIRS}" != "" ] ; then
+ echo ' @rootme=`pwd`/; export rootme; \
+ $(MAKE) "DODIRS='${INFO_SUBDIRS}'" DO=info $(FLAGS_TO_PASS) subdir_do'
+fi
+
+# emit the rule for 'dvi'
+if [ -z "${INFO_FILES}" ] ; then
+ echo 'dvi:'
+else
+ echo dvi: `for file in ${INFO_FILES} ; do echo $file.dvi ; done`
+fi
+if [ "${INFO_SUBDIRS}" != "" ] ; then
+ echo ' @rootme=`pwd`/; export rootme; \
+ $(MAKE) "DODIRS='${INFO_SUBDIRS}'" DO=dvi $(FLAGS_TO_PASS) subdir_do'
+fi
+
+# Emit rules for each *.info and *.dvi file
+for file in ${INFO_FILES} ; do
+ echo ${file}.info: '$(srcdir)'/${file}.texi
+ echo ' $(MAKEINFO) -I$(srcdir) -I$(TEXIDIR) $(srcdir)/'${file}.texi -o ${file}.info
+ echo ${file}.dvi: '$(srcdir)'/${file}.texi
+ echo ' $(TEXI2DVI) $(srcdir)'/${file}.texi
+ echo "${file}.ps: ${file}.dvi"
+ echo " dvips ${file} -o"
+done
+
+# emit the rule for install-info
+echo 'install-info:'
+if [ -n "${INFO_FILES}" ] ; then
+ echo ' -parent=`echo $(infodir)|sed -e' "'"'s@/[^/]*$$@@'"'"'`; \'
+ echo ' if [ -d $$parent ] ; then true ; else mkdir $$parent ; fi'
+ echo ' -if [ -d $(infodir) ] ; then true ; else mkdir $(infodir) ; fi'
+ echo ' for i in *.info* ; do \'
+ echo ' $(INSTALL_DATA) $$i $(infodir)/$$i ; \'
+ echo ' done'
+fi
+if [ "${INFO_SUBDIRS}" != "" ] ; then
+ echo ' @rootme=`pwd`/; export rootme; \
+ $(MAKE) "DODIRS='${INFO_SUBDIRS}'" DO=install-info $(FLAGS_TO_PASS) subdir_do'
+fi
+
+# emit clean-info and clean-dvi rules
+echo '.PHONY: do-clean-info clean-info do-clean-dvi clean-dvi'
+echo do-clean-info:
+if [ -n "${INFO_FILES}" ] ; then
+ echo ' rm -f *.info*'
+fi
+echo 'do-clean-dvi:'
+if [ -n "${INFO_FILES}" ] ; then
+ echo ' rm -f *.dvi *.aux *.cp *.cps *.fn* *.ky *.log *.pg *.toc *.tp *.vr'
+fi
+for type in info dvi ; do
+ echo clean-${type}: do-clean-${type}
+ if [ "${INFO_SUBDIRS}" != "" ] ; then
+ echo ' @rootme=`pwd`/; export rootme; \
+ $(MAKE) "DODIRS='${NFO_SUBDIRS}'" DO=clean-'${type} '$(FLAGS_TO_PASS) subdir_do'
+ fi
+done
+
+echo ''
+
+echo '.PHONY: boltcc'
+echo 'boltcc:'
+echo ' rootme=`pwd`/ ; export rootme ; $(MAKE) $(FLAGS_TO_PASS)'
+echo ''
+
+# Emit clean rules
+
+echo ''
+echo '# clean rules'
+
+MOSTLYCLEAN="${MOSTLYCLEAN-*.o pic stamp-picdir core ${EXTRA_MOSTLYCLEAN}} `if test -n "${TOUCH_ON_COMPILE}"; then echo stamp; else true; fi`"
+CLEAN="${CLEAN-${TARGETPROG} ${TARGETLIB}}"
+DISTCLEAN="${DISTCLEAN-config.status Makefile *~ Make.pack multilib.out ${EXTRA_DISTCLEAN-}}"
+REALCLEAN="${REALCLEAN-depend *.info*}"
+
+
+echo '.PHONY: mostlyclean clean distclean maintainer-clean realclean'
+if test -z "${SUBDIRS}" ; then
+ echo "mostlyclean: clean-dvi"
+ echo " rm -rf ${MOSTLYCLEAN}"
+ echo ' @$(MULTICLEAN) multi-clean DO=mostlyclean'
+ echo "clean: clean-dvi"
+ echo " rm -rf ${MOSTLYCLEAN} ${CLEAN}"
+ echo ' @$(MULTICLEAN) multi-clean DO=clean'
+ echo "distclean: clean"
+ echo ' @$(MULTICLEAN) multi-clean DO=distclean'
+ echo " rm -rf ${DISTCLEAN}"
+ echo "maintainer-clean realclean: clean clean-info"
+ echo ' @$(MULTICLEAN) multi-clean DO=maintainer-clean'
+ echo " rm -rf ${DISTCLEAN} ${REALCLEAN}"
+else
+ echo '.PHONY: do-clean subdir_distclean subdir_maintainer_clean'
+ echo "mostlyclean: do-clean-dvi"
+ echo " rm -rf ${MOSTLYCLEAN}"
+ echo ' @$(MAKE) $(FLAGS_TO_PASS) "DODIRS=$(SUBDIRS)" DO=mostlyclean subdir_do'
+ echo ' @$(MULTICLEAN) multi-clean DO=mostlyclean'
+ echo "do-clean: do-clean-dvi"
+ echo " rm -rf ${MOSTLYCLEAN} ${CLEAN}"
+ echo "clean: do-clean"
+ echo ' @$(MAKE) $(FLAGS_TO_PASS) "DODIRS=$(SUBDIRS)" DO=clean subdir_do'
+ echo ' @$(MULTICLEAN) multi-clean DO=clean'
+ # distclean and maintainer-clean are tricky because they remove the Makefile.
+ echo "subdir_distclean:"
+ echo ' @$(MAKE) $(FLAGS_TO_PASS) "DODIRS=$(SUBDIRS)" DO=distclean subdir_do'
+ echo "distclean: do-clean subdir_distclean"
+ echo ' @$(MULTICLEAN) multi-clean DO=distclean'
+ echo " rm -rf ${DISTCLEAN}"
+ echo "subdir_maintainer_clean:"
+ echo ' @$(MAKE) $(FLAGS_TO_PASS) "DODIRS=$(SUBDIRS)" DO=maintainer-clean subdir_do'
+ echo "maintainer-clean realclean: do-clean subdir_maintainer_clean do-clean-info"
+ echo ' @$(MULTICLEAN) multi-clean DO=maintainer-clean'
+ echo " rm -rf ${DISTCLEAN} ${REALCLEAN}"
+fi
+
+echo ''
+echo '.PHONY: force'
+echo 'force:'
+echo ''
+echo '# with the gnu make, this is done automatically.'
+echo ''
+echo 'Makefile: $(srcdir)/Makefile.in $(host_makefile_frag) $(target_makefile_frag)'
+echo ' $(SHELL) ./config.status'
+echo ''
+echo '.NOEXPORT:'
+echo 'MAKEOVERRIDES='
+
+cat <<"EOF"
+DEPEND_SOURCES = ${srcdir}/*.cc ${srcdir}/*.c
+depend.new:
+# The sed script below attempts to make the depend output portable.
+# It cleans up the depenency information generated by cpp.
+# It replaces instances of $(srcdir)/ by the string '$(srcdir)/'.
+# It removes remaining absolute files names (such as /usr/include/stdio.h).
+# It removes lines containing only "\\".
+# It inserts '$(MULTISRCTOP)' in '$(srcdir)/..'.
+# In order to support SunOS VPATH, $(srcdir)/[a-z]*.{c,cc} is replaced with
+# [a-z]*.{c,cc} (the directory part is removed).
+# The awk script removes a continuation marker that is followed by
+# a blank line, since that may confuse make.
+ echo "# AUTOMATICALLY GENERATED BY 'make depend' - DO NOT EDIT" \
+ >depend.new
+ $(CXX) -M $(CXXINCLUDES) $(DEPEND_SOURCES) \
+ | sed -e 's|$(srcdir)/|$$(srcdir)/|g' \
+ -e 's| /[^ ]*||g' \
+ -e '/^[ ]*\\$$/d' -e 's/^[ ]*$$//' \
+ | sed -e 's|$$(srcdir)/[.][.]|$$(srcdir)/$$(MULTISRCTOP)..|g' \
+ -e 's|$$(srcdir)/\([^/]*[.]c\)|\1|' \
+ | awk 'BEGIN { prev = "" } \
+ /^( )*$$/ { if (prev ~ /\\$$/) \
+ { prev = substr(prev,1,length(prev)-1); next } } \
+ { print prev; prev = $$0 } \
+ END { if (prev !~ /^( )*$$/) print prev }' \
+ >> depend.new
+$(srcdir)/depend: depend.new
+ mv depend.new $(srcdir)/depend
+EOF
+
+if [ -f ${srcdir}/${subdir}/depend ] ; then
+ cat ${srcdir}/${subdir}/depend
+fi
+
+echo "# End of package fragment generated by ${THIS_FILE}."
diff --git a/libio/config/hpux.mt b/libio/config/hpux.mt
new file mode 100644
index 00000000000..fc95afa64fa
--- /dev/null
+++ b/libio/config/hpux.mt
@@ -0,0 +1,3 @@
+# Flags to pass to gen-params when building _G_config.h.
+# For example: G_CONFIG_ARGS = size_t="unsigned long"
+G_CONFIG_ARGS = DOLLAR_IN_LABEL=1
diff --git a/libio/config/isc.mt b/libio/config/isc.mt
new file mode 100644
index 00000000000..15cbb8c36c2
--- /dev/null
+++ b/libio/config/isc.mt
@@ -0,0 +1,4 @@
+# Flags to pass to gen-params when building _G_config.h.
+# For example: G_CONFIG_ARGS = size_t="unsigned long"
+G_CONFIG_ARGS = pid_t="unsigned short" \
+ gid_t="unsigned short" uid_t="unsigned short"
diff --git a/libio/config/linux.mt b/libio/config/linux.mt
new file mode 100644
index 00000000000..25d29c539a5
--- /dev/null
+++ b/libio/config/linux.mt
@@ -0,0 +1,26 @@
+# Since the Linux C library has libio, we have to be very careful.
+
+# By default, we build libio and use it. If someone wants to not
+# build it, let them go to extra work. The reason is that the user
+# may want a newer, bug fixed libio, also on a linux 1.0.8 system
+# things just won't build with the bottom section uncommented.
+
+# Comment this out to avoid including the stdio functions in libiostream.a:
+LIBIOSTREAM_OBJECTS = $(IO_OBJECTS) $(IOSTREAM_OBJECTS) $(STDIO_WRAP_OBJECTS) $(OSPRIM_OBJECTS)
+LIBIOSTREAM_DEP = $(LIBIOSTREAM_OBJECTS) stdio.list
+LIBIOSTREAM_USE = $(LIBIOSTREAM_OBJECTS) `cat stdio.list`
+
+# Comment the above and uncomment the below to use the code in the Linux libc:
+# We have _G_config.h in /usr/include.
+# _G_CONFIG_H=
+
+# We have those in libc.a.
+# IO_OBJECTS=
+# STDIO_WRAP_OBJECTS=
+# OSPRIM_OBJECTS=
+
+# We have the rest in /usr/include.
+# USER_INCLUDES=PlotFile.h SFile.h builtinbuf.h editbuf.h fstream.h \
+# indstream.h iomanip.h iostream.h istream.h ostream.h \
+# parsestream.h pfstream.h procbuf.h stdiostream.h stream.h \
+# streambuf.h strfile.h strstream.h
diff --git a/libio/config/mn10200.mt b/libio/config/mn10200.mt
new file mode 100644
index 00000000000..71e79167658
--- /dev/null
+++ b/libio/config/mn10200.mt
@@ -0,0 +1,3 @@
+# Flags to pass to gen-params when building _G_config.h.
+# For example: G_CONFIG_ARGS = size_t="unsigned long"
+G_CONFIG_ARGS = NO_USE_DTOA=1 USE_INT32_FLAGS=1
diff --git a/libio/config/netware.mt b/libio/config/netware.mt
new file mode 100644
index 00000000000..339a865717c
--- /dev/null
+++ b/libio/config/netware.mt
@@ -0,0 +1,16 @@
+IMPDIR= $(srcdir)/config/netware
+
+PRELUDE= prelude.o
+
+iostream.def: Makefile
+ -rm -f iostream.def
+ echo "description \"libiostream\"" >> iostream.def
+ echo "screenname \"NONE\"" >> iostream.def
+ echo "version `echo $(VERSION) | sed 's|\.|,|g'`" >> iostream.def
+ echo "export @$(IMPDIR)/iostream.imp" >> iostream.def
+
+iostream.O: $(PRELUDE) $(LIBIOSTREAM_OBJECTS)
+ $(CC) -Xlinker -Ur -o $@ $(PRELUDE) $(LIBIOSTREAM_OBJECTS)
+
+iostream.nlm: iostream.def iostream.O $(IMPDIR)/iostream.imp
+ $(NLMCONV) -l $(LD) -T iostream.def iostream.O iostream.nlm
diff --git a/libio/config/sco4.mt b/libio/config/sco4.mt
new file mode 100644
index 00000000000..1d8f6f189c3
--- /dev/null
+++ b/libio/config/sco4.mt
@@ -0,0 +1,3 @@
+# Flags to pass to gen-params when building _G_config.h.
+# For example: G_CONFIG_ARGS = size_t="unsigned long"
+G_CONFIG_ARGS = MATH_H_INLINES=1
diff --git a/libio/configure.in b/libio/configure.in
new file mode 100644
index 00000000000..d6359382bcf
--- /dev/null
+++ b/libio/configure.in
@@ -0,0 +1,93 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../configure.
+
+configdirs="tests dbz stdio testsuite"
+srctrigger=libioP.h
+srcname="input/output library"
+package_makefile_frag=Make.pack
+
+# per-host:
+
+# per-target:
+
+echo "# Warning: this fragment is automatically generated" > temp.mt
+frags=
+
+case "${target}" in
+ *-hpux*) frags=hpux.mt ;;
+ *-linux*)
+ echo "WARNING: The I/O implementation in FSF libg++ 2.8.x is not"
+ echo " compatible with Linux libc through 5.2.x."
+ echo " See libg++/README for more information."
+ echo " YOU ARE ON YOUR OWN!"
+ frags=linux.mt ;;
+ *-sco3.2v[45]*) frags=sco4.mt ;;
+ *-isc*) frags=isc.mt ;;
+ *-netware*) frags=netware.mt ;;
+ *) frags=${target_cpu}.mt ;;
+esac
+
+case "${enable_shared}" in
+ yes) shared=yes ;;
+ no) shared=no ;;
+ *libio*) shared=yes ;;
+ *) shared=no ;;
+esac
+
+if [ "${shared}" = "yes" ]; then
+ case "${target}" in
+ hppa*-*) frags="${frags} ../../config/mh-papic" ;;
+ i[3456]86-*) frags="${frags} ../../config/mh-x86pic" ;;
+ *) frags="${frags} ../../config/mh-${target_cpu}pic" ;;
+ esac
+fi
+
+for frag in ${frags}; do
+ frag=${srcdir}/config/$frag
+ if [ -f ${frag} ]; then
+ echo "Appending ${frag} to target-mkfrag"
+ echo "# Following fragment copied from ${frag}" >> temp.mt
+ cat ${frag} >> temp.mt
+ fi
+done
+
+target_makefile_frag=target-mkfrag
+${moveifchange} temp.mt target-mkfrag
+
+LIBDIR=yes
+TO_TOPDIR=../
+ALL='$(_G_CONFIG_H) libio.a iostream.list'
+XCINCLUDES='-I. -I$(srcdir)'
+XCXXINCLUDES='-I. -I$(srcdir)'
+MOSTLYCLEAN='*.o pic stamp-picdir core iostream.list'
+DISTCLEAN='config.status Makefile *~ Make.pack target-mkfrag multilib.out'
+CLEAN='_G_config.h *.a'
+INFO_FILES=iostream
+if [ -n "${with_cross_host}" ] ; then
+ CHECK_SUBDIRS=testsuite
+fi
+(. ${srcdir}/config.shared) >${package_makefile_frag}
+
+# post-target:
+
+# If cross-compiling, don't build gperf or the utils. They
+# will get built by the target compiler, which is confusing.
+# We cannot test the installation. We install in $(tooldir).
+if [ -n "${with_cross_host}" ] ; then
+ rm -f Makefile.tem
+ sed \
+ -e 's|INSTALLDIR.*=.*$|INSTALLDIR = $(tooldir)/lib|' \
+ Makefile >Makefile.tem
+ mv -f Makefile.tem Makefile
+fi
+
+if [ "${srcdir}" = "." ] ; then
+ if [ "${with_target_subdir}" != "." ] ; then
+ . ${with_multisrctop}../../config-ml.in
+ else
+ . ${with_multisrctop}../config-ml.in
+ fi
+else
+ . ${srcdir}/../config-ml.in
+fi
diff --git a/libio/dbz/Makefile.in b/libio/dbz/Makefile.in
new file mode 100644
index 00000000000..3f7833be840
--- /dev/null
+++ b/libio/dbz/Makefile.in
@@ -0,0 +1,217 @@
+srcdir = .
+CFLAGS = -g
+C_FLAGS = $(CFLAGS) -I$(srcdir) -I.. -I$(srcdir)/.. -DDBZ_FINISH='_IO_flush_all()'
+CC = `if [ -f ../../../gcc/gcc ] ; \
+ then echo ../../../gcc/gcc -B../../../gcc/ ; \
+ else echo gcc ; fi`
+LIBIO = ../libio.a ../../libiberty/libiberty.a
+LIBS = $(LIBIO)
+# LIBS = ../libcnews.a
+DBM =
+RFC = -DHAVERFCIZE
+CASE = case.o
+DEBUG = -DDBZDEBUG
+LINTFLAGS = -h $(DEBUG) $(RFC) -I$(srcdir)
+LDFLAGS =
+# =()<NEWSBIN = @<NEWSBIN>@>()=
+NEWSBIN = /usr/lib/newsbin
+# workaround for System V make bug
+SHELL = /bin/sh
+
+# database sizes for performance tests, regression, and regression prime-find
+TSIZE=12007
+RSIZE=4019
+RPSIZE=2679
+
+#### host and target dependent Makefile fragments come in here.
+##
+
+# history files for regression and performance tests
+RHIST=hist3.3
+R2HIST=hist10
+THIST=hist13
+
+#all: dbz
+all:
+install:
+install-info:
+info:
+
+check: r rclean
+
+bininstall: dbz
+ cp dbz $(NEWSBIN)
+
+cmp: dbz
+ cmp dbz $(NEWSBIN)/dbz
+
+newsinstall:
+ : nothing
+
+u: dbz.o
+ ar ruv ../libcnews.a dbz.o
+ cmp dbz.h ../h/dbz.h
+
+t: tdbz fake
+
+lint:
+ lint $(LINTFLAGS) dbzmain.c dbz.c
+
+.c.o:
+ $(CC) $(C_FLAGS) -c $<
+
+rdbz.o: rdbz.c
+ $(CC) $(C_FLAGS) $(DEBUG) -DDEFSIZE=$(RSIZE) -c rdbz.c
+
+rdbzmain.o: rdbzmain.c
+ $(CC) $(C_FLAGS) $(RFC) -c rdbzmain.c
+
+tdbz.o: $(srcdir)/dbz.c
+ cp $(srcdir)/dbz.c tdbz.c
+ $(CC) $(C_FLAGS) -DDEFSIZE=$(TSIZE) -c tdbz.c
+ rm tdbz.c
+
+dbz: dbzmain.o $(CASE)
+ $(CC) $(LDFLAGS) dbzmain.o $(CASE) $(PRE) $(DBM) $(LIBS) $(POST) -o $@
+
+tdbz: dbzmain.o tdbz.o $(CASE)
+ $(CC) $(LDFLAGS) dbzmain.o tdbz.o $(CASE) $(PRE) $(LIBS) $(POST) -o $@
+
+rdbz: rdbzmain.o rdbz.o $(CASE)
+ $(CC) $(LDFLAGS) rdbzmain.o rdbz.o $(CASE) $(PRE) $(LIBS) $(POST) -o $@
+
+fake: fake.o random.o
+ $(CC) $(LDFLAGS) fake.o random.o $(PRE) $(LIBS) $(POST) -o $@
+
+byteflip: byteflip.o
+ $(CC) $(LDFLAGS) byteflip.o $(PRE) $(LIBS) $(POST) -o $@
+
+hist10: fake
+ ./fake -t -e 75 10000 >$@
+
+hist3.3: fake
+ ./fake -t -e 75 3300 >$@
+
+hist13: fake
+ ./fake -t -e 75 13000 >$@
+
+r: $(srcdir)/getmap $(srcdir)/revbytes $(srcdir)/altbytes stamp-r8
+ : success!
+
+stamp-r0:
+ : 'WARNING: creates about 2MB of debris; do "make rclean" afterward'
+ rm -f dbase dbase[23] dbase.* dbase[23].*
+ test ! -d xx || rmdir xx
+ @touch stamp-r0
+
+stamp-r1: $(RHIST) $(R2HIST) stamp-r0
+ : crude check of synthetic history file
+ ( sed 25q $(RHIST) ; tail -25 $(RHIST) ) >histjunk
+ cmp histjunk $(srcdir)/firstlast25
+ rm histjunk
+ @touch stamp-r1
+
+r2a: rdbz stamp-r1
+ : basic tests, exercising as many options as possible
+ cp $(RHIST) dbase
+ mkdir xx
+ chmod -w xx
+ ./rdbz -E 1000 -0 -M -i -S -u -U -C xx dbase
+ rmdir xx
+ sed '/> 0/d' $(RHIST) >dbase.used
+ test "`cat dbase.used | wc -l`" -eq "`sed -n '2s/ .*//p' dbase.dir`" ;
+
+stamp-r2: r2a
+ cp $(RHIST) dbase2
+ ./rdbz -E 1000 -0 -p $(RPSIZE) -t ' ' dbase2
+ cmp $(RHIST) dbase
+ cmp dbase dbase2
+ cmp dbase.dir dbase2.dir
+ cmp dbase.pag dbase2.pag
+ ./rdbz -E 1000 -0 -c dbase
+ ./rdbz -E 1000 -0 -c -i -q -M -U dbase
+ @touch stamp-r2
+
+stamp-r3: stamp-r2
+ : build a database and then add to it
+ sed 1000q $(RHIST) >dbase2
+ sed 1,1000d $(RHIST) >dbase2.add
+ ./rdbz -E 1000 -0 dbase2
+ ./rdbz -E 1000 -0 -a dbase2 dbase2.add
+ cmp dbase dbase2
+ cmp dbase.dir dbase2.dir
+ cmp dbase.pag dbase2.pag
+ @touch stamp-r3
+
+stamp-r4: stamp-r3
+ : build based on existing one, test extraction and readonly files
+ ./rdbz -E 1000 -0 -f dbase dbase2
+ test "`cat dbase.used | wc -l`" -eq "`awk 'NR==2{print $$1}' dbase2.dir`" ;
+ test "`cat dbase.used | wc -l`" -eq "`awk 'NR==2{print $$2}' dbase2.dir`" ;
+ chmod -w dbase2.dir dbase2.pag
+ ./rdbz -E 1000 -x dbase2 dbase >dbase.temp
+ cmp dbase.used dbase.temp
+ @touch stamp-r4
+
+stamp-r5: stamp-r4
+ : try some small case perversions
+ sed 's/\(@[^ ]*\)A/\1a/' dbase >dbase.ick
+ ./rdbz -E 1000 -x dbase2 dbase.ick >dbase.temp
+ cmp dbase.used dbase.temp
+ sed -n 's/A\([^ ]*@\)/a\1/p' dbase >dbase.ick
+ ./rdbz -x dbase2 dbase.ick >dbase.temp
+ test ! -s dbase.temp ;
+ rm -f dbase2.dir dbase2.pag
+ @touch stamp-r5
+
+stamp-r6: stamp-r5
+ : try it without tags, case-insensitive, with case perversions
+ ./rdbz -E 1000 -0 -p '0 b 1' dbase2
+ tr '[A-M][n-z]' '[a-m][N-Z]' <dbase2 >dbase.ick
+ ./rdbz -E 1000 -x dbase2 dbase.ick >dbase.temp
+ cmp dbase.used dbase.temp
+ rm -f dbase.temp dbase.ick
+ @touch stamp-r6
+
+stamp-r7: byteflip stamp-r6
+ : test various perversions of byte ordering
+ awk -f $(srcdir)/revbytes dbase.dir >dbase2.dir
+ ./byteflip `$(srcdir)/getmap dbase.dir` `$(srcdir)/getmap dbase2.dir` <dbase.pag >dbase2.pag
+ cp dbase dbase2
+ ./rdbz -E 1000 -0 -c dbase2
+ awk -f $(srcdir)/altbytes dbase.dir >dbase2.dir
+ dd conv=swab <dbase.pag >dbase2.pag
+ ./rdbz -E 1000 -0 -c dbase2
+ cp dbase2 dbase3
+ ./rdbz -E 1000 -0 -f dbase2 dbase3
+ ./rdbz -E 1000 -0 -c dbase3
+ test " `$(srcdir)/getmap dbase2.dir`" = " `$(srcdir)/getmap dbase3.dir`" ;
+ @touch stamp-r7
+
+stamp-r8: stamp-r7
+ : test massive overflow, throw in case sensitivity and tag mask
+ cp $(R2HIST) dbase
+ ./rdbz -E 1000 -0 -p '0 0 7ffc0000' dbase
+ ./rdbz -E 1000 -0 -cq dbase
+ sed 100q dbase | egrep '[aA].* ' | tr aA Aa >dbase.ick
+ ./rdbz -x dbase dbase.ick >dbase.temp
+ test ! -s dbase.temp ;
+ @touch stamp-r8
+
+rclean:
+ rm -f dbase dbase[23] dbase.* dbase[23].* fake fake.o random.o
+ rm -f rdbz rdbz.o rdbzmain.o $(RHIST) $(R2HIST) byteflip byteflip.o
+ rm -f histjunk core stamp-r? *~
+ test ! -d xx || rmdir xx
+
+mostlyclean: rclean
+ rm -f *.o [a-z]dbz [a-z][a-z]dbz junk* PostScript.out
+ rm -f hist* dbase* *.bak mon.out gmon.out core dbm.h
+
+clean: mostlyclean
+ rm -f dbz
+
+distclean: clean
+ rm -rf Makefile config.status rdbz.c rdbzmain.c
+
+maintainer-clean realclean: distclean
diff --git a/libio/dbz/README b/libio/dbz/README
new file mode 100644
index 00000000000..e7fa8765ad5
--- /dev/null
+++ b/libio/dbz/README
@@ -0,0 +1,25 @@
+The dbz package was "liberated" from C News.
+It is included with the GNU libio because it provides
+a fairly good work-out for a stdio implementation.
+The Makefile.in, configure.in, and stdio.h have been
+set up to test libio.
+
+------
+
+This is the new, improved, lemon-freshened :-) dbz.
+
+Just "make" will get you dbz.o and the dbz program. "make r" runs an
+extensive set of regression tests; most of the mysterious oddments lying
+around here are to do with that. "make rclean" cleans up after "make r".
+
+You probably want to inspect the #ifdef list early in dbz.c before
+compiling, although the defaults should work all right on most systems.
+
+If you are not building this as part of C News, you will need to change
+the -I option in FLAGS in the Makefile to "-I.", and delete the DBMLIBS
+and RFC lines entirely. That will break some of the regression tests;
+at some point I'll fix this.
+
+If you are using this independently from C News, you probably still want
+to look through ../notebook/problems, as some of the portability problems
+described in there can affect dbz.
diff --git a/libio/dbz/altbytes b/libio/dbz/altbytes
new file mode 100644
index 00000000000..26cc9fb9e02
--- /dev/null
+++ b/libio/dbz/altbytes
@@ -0,0 +1,7 @@
+NR == 1 {
+ printf "%s %s %s %s %s %s %s %s %s", $1, $2, $3, $4, $5, $6, $7, $8, $9
+ for (i = 10; i <= NF; i += 2)
+ printf " %s %s", $(i+1), $i
+ printf "\n"
+}
+NR > 1 { print }
diff --git a/libio/dbz/byteflip.c b/libio/dbz/byteflip.c
new file mode 100644
index 00000000000..d54c6591fa1
--- /dev/null
+++ b/libio/dbz/byteflip.c
@@ -0,0 +1,38 @@
+#include <stdio.h>
+
+#define MAXWORD 32
+
+int
+main(argc, argv)
+int argc;
+char *argv[];
+{
+ register int len;
+ int inmap[MAXWORD];
+ int outmap[MAXWORD];
+ char in[MAXWORD];
+ char out[MAXWORD];
+ register int i;
+ register int a;
+
+ a = 1;
+ len = atoi(argv[a++]);
+ if (len > MAXWORD)
+ abort(); /* kind of drastic... */
+ for (i = 0; i < len; i++)
+ inmap[i] = atoi(argv[a++]);
+ if (atoi(argv[a++]) != len)
+ abort();
+ for (i = 0; i < len; i++)
+ outmap[i] = atoi(argv[a++]);
+
+ while (fread(in, 1, len, stdin) == len) {
+ for (i = 0; i < len; i++)
+ out[outmap[i]] = in[inmap[i]];
+ fwrite(out, 1, len, stdout);
+ }
+#ifdef DBZ_FINISH
+ DBZ_FINISH;
+#endif
+ exit(0);
+}
diff --git a/libio/dbz/case.c b/libio/dbz/case.c
new file mode 100644
index 00000000000..87b741ff54a
--- /dev/null
+++ b/libio/dbz/case.c
@@ -0,0 +1,129 @@
+/*
+ * case-mapping stuff
+ *
+ * We exploit the fact that we are dealing only with headers here, and
+ * headers are limited to the ASCII characters by RFC822. It is barely
+ * possible that we might be dealing with a translation into another
+ * character set, but in particular it's very unlikely for a header
+ * character to be outside -128..255.
+ *
+ * Life would be a whole lot simpler if tolower() could safely and portably
+ * be applied to any char.
+ */
+#include <stdio.h>
+#include "string.h"
+#include "case.h"
+
+/* note that case.h knows the value of OFFSET */
+#define OFFSET 128 /* avoid trouble with negative chars */
+#define MAPSIZE (256+OFFSET)
+char casemap[MAPSIZE]; /* relies on init to '\0' */
+static int primed = 0; /* has casemap been set up? */
+
+/*
+ - prime - set up case-mapping stuff
+ */
+static void
+prime()
+{
+ register char *lp;
+ register char *up;
+ register int c;
+ register int i;
+ static char lower[] = "abcdefghijklmnopqrstuvwxyz";
+ static char upper[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+ for (lp = lower, up = upper; *lp != '\0'; lp++, up++) {
+ c = *lp;
+ casemap[c+OFFSET] = c;
+ casemap[*up+OFFSET] = c;
+ }
+ for (i = 0; i < MAPSIZE; i++)
+ if (casemap[i] == '\0')
+ casemap[i] = (char)(i-OFFSET);
+ primed = 1;
+}
+
+/*
+ - cistrncmp - case-independent strncmp
+ */
+int /* < == > 0 */
+cistrncmp(s1, s2, len)
+char *s1;
+char *s2;
+int len;
+{
+ register char *p1;
+ register char *p2;
+ register int n;
+
+ if (!primed)
+ prime();
+
+ p1 = s1;
+ p2 = s2;
+ n = len;
+ while (--n >= 0 && *p1 != '\0' && TOLOW(*p1) == TOLOW(*p2)) {
+ p1++;
+ p2++;
+ }
+ if (n < 0)
+ return(0);
+
+ /*
+ * The following case analysis is necessary so that characters
+ * which look negative collate low against normal characters but
+ * high against the end-of-string NUL.
+ */
+ if (*p1 == '\0' && *p2 == '\0')
+ return(0);
+ else if (*p1 == '\0')
+ return(-1);
+ else if (*p2 == '\0')
+ return(1);
+ else
+ return(TOLOW(*p1) - TOLOW(*p2));
+}
+
+/*
+ - rfc822ize - do the bizarre case conversion needed for rfc822 message-ids
+ *
+ * Actually, this is not quite complete. Absolute, total, full RFC822
+ * compliance requires a horrible parsing job, because of the arcane
+ * quoting conventions -- abc"def"ghi is not equivalent to abc"DEF"ghi,
+ * for example. There are three or four things that might occur in the
+ * domain part of a message-id that are case-sensitive. They don't seem
+ * to ever occur in real news, thank Cthulhu. (What? You were expecting
+ * a merciful and forgiving deity to be invoked in connection with RFC822?
+ * Forget it; none of them would come near it.)
+ */
+char * /* returns the argument */
+rfc822ize(s)
+char *s;
+{
+ register char *p;
+ static char post[] = "postmaster";
+ static int postlen = sizeof(post)-1;
+
+ if (!primed)
+ prime();
+
+ p = strrchr(s, '@');
+ if (p == NULL) /* no local/domain split */
+ p = ""; /* assume all local */
+ else if (p - (s+1) == postlen && CISTREQN(s+1, post, postlen)) {
+ /* crazy special case -- "postmaster" is case-insensitive */
+ p = s;
+ }
+#ifdef NONSTANDARD
+#ifdef RFCVIOLATION
+#ifdef B_2_11_MISTAKE
+ p = s; /* all case-insensitive */
+#endif
+#endif
+#endif
+ for (; *p != '\0'; p++)
+ *p = TOLOW(*p);
+
+ return(s);
+}
diff --git a/libio/dbz/case.h b/libio/dbz/case.h
new file mode 100644
index 00000000000..d5ef6961550
--- /dev/null
+++ b/libio/dbz/case.h
@@ -0,0 +1,12 @@
+extern int cistrncmp();
+extern char *rfc822ize();
+
+extern char casemap[];
+
+/* must call cistrncmp before invoking TOLOW... */
+#define TOLOW(c) (casemap[(c)+128]) /* see case.c for why 128 */
+
+/* ...but the use of it in CISTREQN is safe without the preliminary call (!) */
+/* CISTREQN is an optimised case-insensitive strncmp(a,b,n)==0; n > 0 */
+#define CISTREQN(a, b, n) \
+ (TOLOW((a)[0]) == TOLOW((b)[0]) && cistrncmp(a, b, n) == 0)
diff --git a/libio/dbz/configure.in b/libio/dbz/configure.in
new file mode 100644
index 00000000000..4cb9b57ce0f
--- /dev/null
+++ b/libio/dbz/configure.in
@@ -0,0 +1,17 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../configure.
+
+configdirs=
+srctrigger=dbzmain.c
+srcname="libio dbz test"
+
+# per-host:
+
+# per-target:
+
+files="dbz.c dbzmain.c"
+links="rdbz.c rdbzmain.c"
+
+# post-target:
+
diff --git a/libio/dbz/dbz.1 b/libio/dbz/dbz.1
new file mode 100644
index 00000000000..d2fff17af98
--- /dev/null
+++ b/libio/dbz/dbz.1
@@ -0,0 +1,221 @@
+.TH DBZ 1 "11 Feb 1992"
+.BY "C News"
+.SH NAME
+dbz \- operate on dbz databases of text
+.SH SYNOPSIS
+.B dbz
+[
+.BR \- { axmc }
+] [
+.B \-t
+c
+] [
+.B \-l
+length
+] [
+.BR \- { qiue }
+] [
+.B \-f
+old
+] [
+.B \-p
+parms
+] database file ...
+.SH DESCRIPTION
+.I Dbz
+is a shell-level interface to the
+.IR dbz (3z)
+database routines for indexed access to a text file.
+.PP
+The
+.I database
+file must be a text file,
+one line per database record,
+with the key the first field on the line.
+The
+.B \-t
+option sets the field-separator character; the default is tab.
+Setting the separator character to NUL (with
+.BR "\-t\ ''" )
+makes the whole line the key.
+Lines must not exceed 1023 bytes in length including the newline;
+this limit can be increased with the
+.B \-l
+option.
+The limitations and restrictions of
+.IR dbz (3z)
+must also be observed;
+in particular, it remains the user's responsibility to ensure that
+no attempt is made to store two entries (whether identical or not)
+with the same key.
+.PP
+In the absence of options,
+.I dbz
+creates a
+.IR dbz (3z)
+index for the database;
+the index comprises files
+.IB database .pag
+and
+.IB database .dir
+in the same directory.
+Any previous index is silently overwritten.
+The
+.BR \-a ,
+.BR \-x ,
+.BR \-m ,
+and
+.B \-c
+options specify other operations.
+.PP
+With
+.BR \-a ,
+.I dbz
+appends lines from the
+.IR file (s)
+(standard input if none)
+to the database, updating both the
+text file and the indexes.
+.PP
+With
+.BR \-x ,
+.I dbz
+reads keys from the
+.IR file (s)
+(standard input if none)
+and prints (on standard output) the corresponding lines, if any,
+from the database.
+The input is in the form of database lines, although only the keys are
+significant.
+The
+.B \-q
+option makes
+.B \-x
+print the input lines whose keys are found instead of the database
+lines; this is somewhat faster.
+.PP
+With
+.BR \-m ,
+operation is the same as for
+.B \-x
+except that the keys which are \fInot\fR present in the database are printed.
+.PP
+With
+.BR \-c ,
+.I dbz
+checks the database for internal consistency.
+The
+.B \-q
+option causes this check to be done more quickly but less thoroughly
+(each key is looked up in the index, but no check is made to be sure
+that the index entry points to the right place).
+.PP
+The
+.B \-i
+option suppresses the use of
+.IR dbz (3z)'s
+.I incore
+facility.
+This makes accesses slower, but keeps the files current
+during updating
+and reduces
+startup/shutdown overhead.
+.PP
+Normally,
+.I dbz
+checks whether a key is already in the database before adding it.
+The
+.B \-u
+option suppresses this check, speeding things up at the expense of safety.
+.PP
+A new index is normally created with default size,
+case mapping, and tagging.
+The default size is right for 90-100,000 records.
+The default case mapping is right for RFC822 message-ids.
+See
+.IR dbz (3z)
+for what tagging is about.
+(Note, these defaults can be changed when
+.IR dbz (3z)
+is installed.)
+.PP
+If the
+.B \-f
+option is given,
+size, case mapping, and tagging
+are instead initialized based on the
+database
+.IR old .
+This is mostly useful when
+creating a new generation of an existing database.
+(See the description of
+.I dbzagain
+in
+.IR dbz (3z)
+for details.)
+.PP
+If the
+.B \-p
+option is given, the
+.I parms
+string specifies the size, case mapping, and tagging.
+If
+.I parms
+is a single decimal number,
+that is taken as the expected number of records
+in the index, with case mapping and tagging defaulted.
+Alternatively,
+.I parms
+can be three fields\(ema decimal number, a case-mapping code character, and a
+hexadecimal tag mask\(emseparated by white space.
+The decimal number is, again, the expected number of records;
+0 means ``use the default''.
+See
+.IR dbz (3z)
+for possible choices of case-mapping code,
+but in particular,
+.B 0
+means ``no case mapping''.
+See
+.IR dbz (3z)
+for details on tag masks;
+0 means ``use the default''.
+.PP
+If the
+.B \-e
+option is given, the decimal number in
+.B \-p
+is taken to be the exact table size, not the expected number of records,
+and invocation of
+.I dbzsize
+(see
+.IR dbz (3z))
+to predict a good size for that number of records is suppressed.
+.PP
+The
+.B \&.pag
+file is normally about 6 bytes per record (based on the estimate given to
+.B \-p
+or the previous history of the
+.B \-f
+database).
+The
+.B \&.dir
+file is tiny.
+.SH SEE ALSO
+dbz(3z)
+.SH HISTORY
+Written at U of Toronto by Henry Spencer, for the C News project.
+See
+.IR dbz (3z)
+for the history of the underlying database routines.
+.SH BUGS
+There are a number of undocumented options with obscure effects,
+meant for debugging and regression testing of
+.IR dbz (3z).
+.PP
+Permissions for the index files probably ought to be taken from those
+of the base file.
+.PP
+The line-length limit is a blemish, alleviated only slightly by
+.BR \-l .
diff --git a/libio/dbz/dbz.3z b/libio/dbz/dbz.3z
new file mode 100644
index 00000000000..6df25311c70
--- /dev/null
+++ b/libio/dbz/dbz.3z
@@ -0,0 +1,547 @@
+.TH DBZ 3Z "3 Feb 1991"
+.BY "C News"
+.SH NAME
+dbminit, fetch, store, dbmclose \- somewhat dbm-compatible database routines
+.br
+dbzfresh, dbzagain, dbzfetch, dbzstore \- database routines
+.br
+dbzsync, dbzsize, dbzincore, dbzcancel, dbzdebug \- database routines
+.SH SYNOPSIS
+.nf
+.B #include <dbz.h>
+.PP
+.B dbminit(base)
+.B char *base;
+.PP
+.B datum
+.B fetch(key)
+.B datum key;
+.PP
+.B store(key, value)
+.B datum key;
+.B datum value;
+.PP
+.B dbmclose()
+.PP
+.B dbzfresh(base, size, fieldsep, cmap, tagmask)
+.B char *base;
+.B long size;
+.B int fieldsep;
+.B int cmap;
+.B long tagmask;
+.PP
+.B dbzagain(base, oldbase)
+.B char *base;
+.B char *oldbase;
+.PP
+.B datum
+.B dbzfetch(key)
+.B datum key;
+.PP
+.B dbzstore(key, value)
+.B datum key;
+.B datum value;
+.PP
+.B dbzsync()
+.PP
+.B long
+.B dbzsize(nentries)
+.B long nentries;
+.PP
+.B dbzincore(newvalue)
+.PP
+.B dbzcancel()
+.PP
+.B dbzdebug(newvalue)
+.SH DESCRIPTION
+These functions provide an indexing system for rapid random access to a
+text file (the
+.I base
+.IR file ).
+Subject to certain constraints, they are call-compatible with
+.IR dbm (3),
+although they also provide some extensions.
+(Note that they are
+.I not
+file-compatible with
+.I dbm
+or any variant thereof.)
+.PP
+In principle,
+.I dbz
+stores key-value pairs, where both key and value are arbitrary sequences
+of bytes, specified to the functions by
+values of type
+.IR datum ,
+typedefed in the header file to be a structure with members
+.I dptr
+(a value of type
+.I char *
+pointing to the bytes)
+and
+.I dsize
+(a value of type
+.I int
+indicating how long the byte sequence is).
+.PP
+In practice,
+.I dbz
+is more restricted than
+.IR dbm .
+A
+.I dbz
+database
+must be an index into a base file,
+with the database
+.IR value s
+being
+.IR fseek (3)
+offsets into the base file.
+Each such
+.I value
+must ``point to'' a place in the base file where the corresponding
+.I key
+sequence is found.
+A key can be no longer than
+.SM DBZMAXKEY
+(a constant defined in the header file) bytes.
+No key can be an initial subsequence of another,
+which in most applications requires that keys be
+either bracketed or terminated in some way (see the
+discussion of the
+.I fieldsep
+parameter of
+.IR dbzfresh ,
+below,
+for a fine point on terminators).
+.PP
+.I Dbminit
+opens a database,
+an index into the base file
+.IR base ,
+consisting of files
+.IB base .dir
+and
+.IB base .pag
+which must already exist.
+(If the database is new, they should be zero-length files.)
+Subsequent accesses go to that database until
+.I dbmclose
+is called to close the database.
+The base file need not exist at the time of the
+.IR dbminit ,
+but it must exist before accesses are attempted.
+.PP
+.I Fetch
+searches the database for the specified
+.IR key ,
+returning the corresponding
+.IR value
+if any.
+.I Store
+stores the
+.IR key - value
+pair in the database.
+.I Store
+will fail unless the database files are writeable.
+See below for a complication arising from case mapping.
+.PP
+.I Dbzfresh
+is a variant of
+.I dbminit
+for creating a new database with more control over details.
+Unlike for
+.IR dbminit ,
+the database files need not exist:
+they will be created if necessary,
+and truncated in any case.
+.PP
+.IR Dbzfresh 's
+.I size
+parameter specifies the size of the first hash table within the database,
+in key-value pairs.
+Performance will be best if
+.I size
+is a prime number and
+the number of key-value pairs stored in the database does not exceed
+about 2/3 of
+.IR size .
+(The
+.I dbzsize
+function, given the expected number of key-value pairs,
+will suggest a database size that meets these criteria.)
+Assuming that an
+.I fseek
+offset is 4 bytes,
+the
+.B .pag
+file will be
+.RI 4* size
+bytes
+(the
+.B .dir
+file is tiny and roughly constant in size)
+until
+the number of key-value pairs exceeds about 80% of
+.IR size .
+(Nothing awful will happen if the database grows beyond 100% of
+.IR size ,
+but accesses will slow down somewhat and the
+.B .pag
+file will grow somewhat.)
+.PP
+.IR Dbzfresh 's
+.I fieldsep
+parameter specifies the field separator in the base file.
+If this is not
+NUL (0), and the last character of a
+.I key
+argument is NUL, that NUL compares equal to either a NUL or a
+.I fieldsep
+in the base file.
+This permits use of NUL to terminate key strings without requiring that
+NULs appear in the base file.
+The
+.I fieldsep
+of a database created with
+.I dbminit
+is the horizontal-tab character.
+.PP
+For use in news systems, various forms of case mapping (e.g. uppercase to
+lowercase) in keys are available.
+The
+.I cmap
+parameter to
+.I dbzfresh
+is a single character specifying which of several mapping algorithms to use.
+Available algorithms are:
+.RS
+.TP
+.B 0
+case-sensitive: no case mapping
+.TP
+.B B
+same as
+.B 0
+.TP
+.B NUL
+same as
+.B 0
+.TP
+.B =
+case-insensitive: uppercase and lowercase equivalent
+.TP
+.B b
+same as
+.B =
+.TP
+.B C
+RFC822 message-ID rules, case-sensitive before `@' (with certain exceptions)
+and case-insensitive after
+.TP
+.B ?
+whatever the local default is, normally
+.B C
+.RE
+.PP
+Mapping algorithm
+.B 0
+(no mapping) is faster than the others and is overwhelmingly the correct
+choice for most applications.
+Unless compatibility constraints interfere, it is more efficient to pre-map
+the keys, storing mapped keys in the base file, than to have
+.I dbz
+do the mapping on every search.
+.PP
+For historical reasons,
+.I fetch
+and
+.I store
+expect their
+.I key
+arguments to be pre-mapped, but expect unmapped keys in the base file.
+.I Dbzfetch
+and
+.I dbzstore
+do the same jobs but handle all case mapping internally,
+so the customer need not worry about it.
+.PP
+.I Dbz
+stores only the database
+.IR value s
+in its files, relying on reference to the base file to confirm a hit on a key.
+References to the base file can be minimized, greatly speeding up searches,
+if a little bit of information about the keys can be stored in the
+.I dbz
+files.
+This is ``free'' if there are some unused bits in an
+.I fseek
+offset,
+so that the offset can be
+.I tagged
+with some information about the key.
+The
+.I tagmask
+parameter of
+.I dbzfresh
+allows specifying the location of unused bits.
+.I Tagmask
+should be a mask with
+one group of
+contiguous
+.B 1
+bits.
+The bits in the mask should
+be unused (0) in
+.I most
+offsets.
+The bit immediately above the mask (the
+.I flag
+bit) should be unused (0) in
+.I all
+offsets;
+.I (dbz)store
+will reject attempts to store a key-value pair in which the
+.I value
+has the flag bit on.
+Apart from this restriction, tagging is invisible to the user.
+As a special case, a
+.I tagmask
+of 1 means ``no tagging'', for use with enormous base files or
+on systems with unusual offset representations.
+.PP
+A
+.I size
+of 0
+given to
+.I dbzfresh
+is synonymous with the local default;
+the normal default is suitable for tables of 90-100,000
+key-value pairs.
+A
+.I cmap
+of 0 (NUL) is synonymous with the character
+.BR 0 ,
+signifying no case mapping
+(note that the character
+.B ?
+specifies the local default mapping,
+normally
+.BR C ).
+A
+.I tagmask
+of 0 is synonymous with the local default tag mask,
+normally 0x7f000000 (specifying the top bit in a 32-bit offset
+as the flag bit, and the next 7 bits as the mask,
+which is suitable for base files up to circa 24MB).
+Calling
+.I dbminit(name)
+with the database files empty is equivalent to calling
+.IR dbzfresh(name,0,'\et','?',0) .
+.PP
+When databases are regenerated periodically, as in news,
+it is simplest to pick the parameters for a new database based on the old one.
+This also permits some memory of past sizes of the old database, so that
+a new database size can be chosen to cover expected fluctuations.
+.I Dbzagain
+is a variant of
+.I dbminit
+for creating a new database as a new generation of an old database.
+The database files for
+.I oldbase
+must exist.
+.I Dbzagain
+is equivalent to calling
+.I dbzfresh
+with the same field separator, case mapping, and tag mask as the old database,
+and a
+.I size
+equal to the result of applying
+.I dbzsize
+to the largest number of entries in the
+.I oldbase
+database and its previous 10 generations.
+.PP
+When many accesses are being done by the same program,
+.I dbz
+is massively faster if its first hash table is in memory.
+If an internal flag is 1,
+an attempt is made to read the table in when
+the database is opened, and
+.I dbmclose
+writes it out to disk again (if it was read successfully and
+has been modified).
+.I Dbzincore
+sets the flag to
+.I newvalue
+(which should be 0 or 1)
+and returns the previous value;
+this does not affect the status of a database that has already been opened.
+The default is 0.
+The attempt to read the table in may fail due to memory shortage;
+in this case
+.I dbz
+quietly falls back on its default behavior.
+.IR Store s
+to an in-memory database are not (in general) written out to the file
+until
+.IR dbmclose
+or
+.IR dbzsync ,
+so if robustness in the presence of crashes
+or concurrent accesses
+is crucial, in-memory databases
+should probably be avoided.
+.PP
+.I Dbzsync
+causes all buffers etc. to be flushed out to the files.
+It is typically used as a precaution against crashes or concurrent accesses
+when a
+.IR dbz -using
+process will be running for a long time.
+It is a somewhat expensive operation,
+especially
+for an in-memory database.
+.PP
+.I Dbzcancel
+cancels any pending writes from buffers.
+This is typically useful only for in-core databases, since writes are
+otherwise done immediately.
+Its main purpose is to let a child process, in the wake of a
+.IR fork ,
+do a
+.I dbmclose
+without writing its parent's data to disk.
+.PP
+If
+.I dbz
+has been compiled with debugging facilities available (which makes it
+bigger and a bit slower),
+.I dbzdebug
+alters the value (and returns the previous value) of an internal flag
+which (when 1; default is 0) causes
+verbose and cryptic debugging output on standard output.
+.PP
+Concurrent reading of databases is fairly safe,
+but there is no (inter)locking,
+so concurrent updating is not.
+.PP
+The database files include a record of the byte order of the processor
+creating the database, and accesses by processors with different byte
+order will work, although they will be slightly slower.
+Byte order is preserved by
+.IR dbzagain .
+However,
+agreement on the size and internal structure of an
+.I fseek
+offset is necessary, as is consensus on
+the character set.
+.PP
+An open database occupies three
+.I stdio
+streams and their corresponding file descriptors;
+a fourth is needed for an in-memory database.
+Memory consumption is negligible (except for
+.I stdio
+buffers) except for in-memory databases.
+.SH SEE ALSO
+dbz(1), dbm(3)
+.SH DIAGNOSTICS
+Functions returning
+.I int
+values return 0 for success, \-1 for failure.
+Functions returning
+.I datum
+values return a value with
+.I dptr
+set to NULL for failure.
+.I Dbminit
+attempts to have
+.I errno
+set plausibly on return, but otherwise this is not guaranteed.
+An
+.I errno
+of
+.B EDOM
+from
+.I dbminit
+indicates that the database did not appear to be in
+.I dbz
+format.
+.SH HISTORY
+The original
+.I dbz
+was written by
+Jon Zeeff (zeeff@b-tech.ann-arbor.mi.us).
+Later contributions by David Butler and Mark Moraes.
+Extensive reworking,
+including this documentation,
+by Henry Spencer (henry@zoo.toronto.edu) as
+part of the C News project.
+Hashing function by Peter Honeyman.
+.SH BUGS
+The
+.I dptr
+members of returned
+.I datum
+values point to static storage which is overwritten by later calls.
+.PP
+Unlike
+.IR dbm ,
+.I dbz
+will misbehave if an existing key-value pair is `overwritten' by
+a new
+.I (dbz)store
+with the same key.
+The user is responsible for avoiding this by using
+.I (dbz)fetch
+first to check for duplicates;
+an internal optimization remembers the result of the
+first search so there is minimal overhead in this.
+.PP
+Waiting until after
+.I dbminit
+to bring the base file into existence
+will fail if
+.IR chdir (2)
+has been used meanwhile.
+.PP
+The RFC822 case mapper implements only a first approximation to the
+hideously-complex RFC822 case rules.
+.PP
+The prime finder in
+.I dbzsize
+is not particularly quick.
+.PP
+Should implement the
+.I dbm
+functions
+.IR delete ,
+.IR firstkey ,
+and
+.IR nextkey .
+.PP
+On C implementations which trap integer overflow,
+.I dbz
+will refuse to
+.I (dbz)store
+an
+.I fseek
+offset equal to the greatest
+representable
+positive number,
+as this would cause overflow in the biased representation used.
+.PP
+.I Dbzagain
+perhaps ought to notice when many offsets
+in the old database were
+too big for
+tagging, and shrink the tag mask to match.
+.PP
+Marking
+.IR dbz 's
+file descriptors
+.RI close-on- exec
+would be a better approach to the problem
+.I dbzcancel
+tries to address, but that's harder to do portably.
diff --git a/libio/dbz/dbz.c b/libio/dbz/dbz.c
new file mode 100644
index 00000000000..c7e8444952b
--- /dev/null
+++ b/libio/dbz/dbz.c
@@ -0,0 +1,1763 @@
+/*
+
+dbz.c V3.2
+
+Copyright 1988 Jon Zeeff (zeeff@b-tech.ann-arbor.mi.us)
+You can use this code in any manner, as long as you leave my name on it
+and don't hold me responsible for any problems with it.
+
+Hacked on by gdb@ninja.UUCP (David Butler); Sun Jun 5 00:27:08 CDT 1988
+
+Various improvments + INCORE by moraes@ai.toronto.edu (Mark Moraes)
+
+Major reworking by Henry Spencer as part of the C News project.
+
+These routines replace dbm as used by the usenet news software
+(it's not a full dbm replacement by any means). It's fast and
+simple. It contains no AT&T code.
+
+In general, dbz's files are 1/20 the size of dbm's. Lookup performance
+is somewhat better, while file creation is spectacularly faster, especially
+if the incore facility is used.
+
+*/
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <string.h>
+#include <ctype.h>
+#include <errno.h>
+#ifndef __STDC__
+extern int errno;
+#endif
+#include <dbz.h>
+
+/*
+ * #ifdef index. "LIA" = "leave it alone unless you know what you're doing".
+ *
+ * FUNNYSEEKS SEEK_SET is not 0, get it from <unistd.h>
+ * INDEX_SIZE backward compatibility with old dbz; avoid using this
+ * NMEMORY number of days of memory for use in sizing new table (LIA)
+ * INCORE backward compatibility with old dbz; use dbzincore() instead
+ * DBZDEBUG enable debugging
+ * DEFSIZE default table size (not as critical as in old dbz)
+ * OLDBNEWS default case mapping as in old B News; set NOBUFFER
+ * BNEWS default case mapping as in current B News; set NOBUFFER
+ * DEFCASE default case-map algorithm selector
+ * NOTAGS fseek offsets are strange, do not do tagging (see below)
+ * NPAGBUF size of .pag buffer, in longs (LIA)
+ * SHISTBUF size of ASCII-file buffer, in bytes (LIA)
+ * MAXRUN length of run which shifts to next table (see below) (LIA)
+ * OVERFLOW long-int arithmetic overflow must be avoided, will trap
+ * NOBUFFER do not buffer hash-table i/o, B News locking is defective
+ */
+
+#ifdef FUNNYSEEKS
+#include <unistd.h>
+#else
+#define SEEK_SET 0
+#endif
+#ifdef OVERFLOW
+#include <limits.h>
+#endif
+
+static int dbzversion = 3; /* for validating .dir file format */
+
+/*
+ * The dbz database exploits the fact that when news stores a <key,value>
+ * tuple, the `value' part is a seek offset into a text file, pointing to
+ * a copy of the `key' part. This avoids the need to store a copy of
+ * the key in the dbz files. However, the text file *must* exist and be
+ * consistent with the dbz files, or things will fail.
+ *
+ * The basic format of the database is a simple hash table containing the
+ * values. A value is stored by indexing into the table using a hash value
+ * computed from the key; collisions are resolved by linear probing (just
+ * search forward for an empty slot, wrapping around to the beginning of
+ * the table if necessary). Linear probing is a performance disaster when
+ * the table starts to get full, so a complication is introduced. The
+ * database is actually one *or more* tables, stored sequentially in the
+ * .pag file, and the length of linear-probe sequences is limited. The
+ * search (for an existing item or an empty slot) always starts in the
+ * first table, and whenever MAXRUN probes have been done in table N,
+ * probing continues in table N+1. This behaves reasonably well even in
+ * cases of massive overflow. There are some other small complications
+ * added, see comments below.
+ *
+ * The table size is fixed for any particular database, but is determined
+ * dynamically when a database is rebuilt. The strategy is to try to pick
+ * the size so the first table will be no more than 2/3 full, that being
+ * slightly before the point where performance starts to degrade. (It is
+ * desirable to be a bit conservative because the overflow strategy tends
+ * to produce files with holes in them, which is a nuisance.)
+ */
+
+/*
+ * The following is for backward compatibility.
+ */
+#ifdef INDEX_SIZE
+#define DEFSIZE INDEX_SIZE
+#endif
+
+/*
+ * ANSI C says the offset argument to fseek is a long, not an off_t, for some
+ * reason. Let's use off_t anyway.
+ */
+#define SOF (sizeof(off_t))
+
+/*
+ * We assume that unused areas of a binary file are zeros, and that the
+ * bit pattern of `(off_t)0' is all zeros. The alternative is rather
+ * painful file initialization. Note that okayvalue(), if OVERFLOW is
+ * defined, knows what value of an offset would cause overflow.
+ */
+#define VACANT ((off_t)0)
+#define BIAS(o) ((o)+1) /* make any valid off_t non-VACANT */
+#define UNBIAS(o) ((o)-1) /* reverse BIAS() effect */
+
+/*
+ * In a Unix implementation, or indeed any in which an off_t is a byte
+ * count, there are a bunch of high bits free in an off_t. There is a
+ * use for them. Checking a possible hit by looking it up in the base
+ * file is relatively expensive, and the cost can be dramatically reduced
+ * by using some of those high bits to tag the value with a few more bits
+ * of the key's hash. This detects most false hits without the overhead of
+ * seek+read+strcmp. We use the top bit to indicate whether the value is
+ * tagged or not, and don't tag a value which is using the tag bits itself.
+ * We're in trouble if the off_t representation wants to use the top bit.
+ * The actual bitmasks and offset come from the configuration stuff,
+ * which permits fiddling with them as necessary, and also suppressing
+ * them completely (by defining the masks to 0). We build pre-shifted
+ * versions of the masks for efficiency.
+ */
+static off_t tagbits; /* pre-shifted tag mask */
+static off_t taghere; /* pre-shifted tag-enable bit */
+static off_t tagboth; /* tagbits|taghere */
+#define HASTAG(o) ((o)&taghere)
+#define TAG(o) ((o)&tagbits)
+#define NOTAG(o) ((o)&~tagboth)
+#define CANTAG(o) (((o)&tagboth) == 0)
+#define MKTAG(v) (((v)<<conf.tagshift)&tagbits)
+
+/*
+ * A new, from-scratch database, not built as a rebuild of an old one,
+ * needs to know table size, casemap algorithm, and tagging. Normally
+ * the user supplies this info, but there have to be defaults.
+ */
+#ifndef DEFSIZE
+#define DEFSIZE 120011 /* 300007 might be better */
+#endif
+#ifdef OLDBNEWS
+#define DEFCASE '0' /* B2.10 -- no mapping */
+#define NOBUFFER /* B News locking is defective */
+#endif
+#ifdef BNEWS
+#define DEFCASE '=' /* B2.11 -- all mapped */
+#define NOBUFFER /* B News locking is defective */
+#endif
+#ifndef DEFCASE /* C News compatibility is the default */
+#define DEFCASE 'C' /* C News -- RFC822 mapping */
+#endif
+#ifndef NOTAGS
+#define TAGENB 0x80 /* tag enable is top bit, tag is next 7 */
+#define TAGMASK 0x7f
+#define TAGSHIFT 24
+#else
+#define TAGENB 0 /* no tags */
+#define TAGMASK 0
+#define TAGSHIFT 0
+#endif
+
+/*
+ * We read configuration info from the .dir file into this structure,
+ * so we can avoid wired-in assumptions for an existing database.
+ *
+ * Among the info is a record of recent peak usages, so that a new table
+ * size can be chosen intelligently when rebuilding. 10 is a good
+ * number of usages to keep, since news displays marked fluctuations
+ * in volume on a 7-day cycle.
+ */
+struct dbzconfig {
+ int olddbz; /* .dir file empty but .pag not? */
+ off_t tsize; /* table size */
+# ifndef NMEMORY
+# define NMEMORY 10 /* # days of use info to remember */
+# endif
+# define NUSEDS (1+NMEMORY)
+ off_t used[NUSEDS]; /* entries used today, yesterday, ... */
+ int valuesize; /* size of table values, == SOF */
+ int bytemap[SOF]; /* byte-order map */
+ char casemap; /* case-mapping algorithm (see cipoint()) */
+ char fieldsep; /* field separator in base file, if any */
+ off_t tagenb; /* unshifted tag-enable bit */
+ off_t tagmask; /* unshifted tag mask */
+ int tagshift; /* shift count for tagmask and tagenb */
+};
+static struct dbzconfig conf;
+static int getconf();
+static long getno();
+static int putconf();
+static void mybytemap();
+static off_t bytemap();
+
+/*
+ * For a program that makes many, many references to the database, it
+ * is a large performance win to keep the table in core, if it will fit.
+ * Note that this does hurt robustness in the event of crashes, and
+ * dbmclose() *must* be called to flush the in-core database to disk.
+ * The code is prepared to deal with the possibility that there isn't
+ * enough memory. There *is* an assumption that a size_t is big enough
+ * to hold the size (in bytes) of one table, so dbminit() tries to figure
+ * out whether this is possible first.
+ *
+ * The preferred way to ask for an in-core table is to do dbzincore(1)
+ * before dbminit(). The default is not to do it, although -DINCORE
+ * overrides this for backward compatibility with old dbz.
+ *
+ * We keep only the first table in core. This greatly simplifies the
+ * code, and bounds memory demand. Furthermore, doing this is a large
+ * performance win even in the event of massive overflow.
+ */
+#ifdef INCORE
+static int incore = 1;
+#else
+static int incore = 0;
+#endif
+
+/*
+ * Stdio buffer for .pag reads. Buffering more than about 16 does not help
+ * significantly at the densities we try to maintain, and the much larger
+ * buffers that most stdios default to are much more expensive to fill.
+ * With small buffers, stdio is performance-competitive with raw read(),
+ * and it's much more portable.
+ */
+#ifndef NPAGBUF
+#define NPAGBUF 16
+#endif
+#ifndef NOBUFFER
+#ifdef _IOFBF
+static off_t pagbuf[NPAGBUF]; /* only needed if !NOBUFFER && _IOFBF */
+#endif
+#endif
+
+/*
+ * Stdio buffer for base-file reads. Message-IDs (all news ever needs to
+ * read) are essentially never longer than 64 bytes, and the typical stdio
+ * buffer is so much larger that it is much more expensive to fill.
+ */
+#ifndef SHISTBUF
+#define SHISTBUF 64
+#endif
+#ifdef _IOFBF
+static char basebuf[SHISTBUF]; /* only needed if _IOFBF exists */
+#endif
+
+/*
+ * Data structure for recording info about searches.
+ */
+struct searcher {
+ off_t place; /* current location in file */
+ int tabno; /* which table we're in */
+ int run; /* how long we'll stay in this table */
+# ifndef MAXRUN
+# define MAXRUN 100
+# endif
+ long hash; /* the key's hash code (for optimization) */
+ off_t tag; /* tag we are looking for */
+ int seen; /* have we examined current location? */
+ int aborted; /* has i/o error aborted search? */
+};
+static void start();
+#define FRESH ((struct searcher *)NULL)
+static off_t search();
+#define NOTFOUND ((off_t)-1)
+static int okayvalue();
+static int set();
+
+/*
+ * Arguably the searcher struct for a given routine ought to be local to
+ * it, but a fetch() is very often immediately followed by a store(), and
+ * in some circumstances it is a useful performance win to remember where
+ * the fetch() completed. So we use a global struct and remember whether
+ * it is current.
+ */
+static struct searcher srch;
+static struct searcher *prevp; /* &srch or FRESH */
+
+/* byte-ordering stuff */
+static int mybmap[SOF]; /* my byte order (see mybytemap()) */
+static int bytesame; /* is database order same as mine? */
+#define MAPIN(o) ((bytesame) ? (o) : bytemap((o), conf.bytemap, mybmap))
+#define MAPOUT(o) ((bytesame) ? (o) : bytemap((o), mybmap, conf.bytemap))
+
+/*
+ * The double parentheses needed to make this work are ugly, but the
+ * alternative (under most compilers) is to pack around 2K of unused
+ * strings -- there's just no way to get rid of them.
+ */
+static int debug; /* controlled by dbzdebug() */
+#ifdef DBZDEBUG
+#define DEBUG(args) if (debug) { (void) printf args ; }
+#else
+#define DEBUG(args) ;
+#endif
+
+/* externals used */
+extern char *malloc();
+extern char *calloc();
+extern void free(); /* ANSI C; some old implementations say int */
+extern int atoi();
+extern long atol();
+
+/* misc. forwards */
+static long hash();
+static void crcinit();
+static char *cipoint();
+static char *mapcase();
+static int isprime();
+static FILE *latebase();
+
+/* file-naming stuff */
+static char dir[] = ".dir";
+static char pag[] = ".pag";
+static char *enstring();
+
+/* central data structures */
+static FILE *basef; /* descriptor for base file */
+static char *basefname; /* name for not-yet-opened base file */
+static FILE *dirf; /* descriptor for .dir file */
+static int dirronly; /* dirf open read-only? */
+static FILE *pagf = NULL; /* descriptor for .pag file */
+static off_t pagpos; /* posn in pagf; only search may set != -1 */
+static int pagronly; /* pagf open read-only? */
+static off_t *corepag; /* incore version of .pag file, if any */
+static FILE *bufpagf; /* well-buffered pagf, for incore rewrite */
+static off_t *getcore();
+static int putcore();
+static int written; /* has a store() been done? */
+
+/*
+ - dbzfresh - set up a new database, no historical info
+ */
+int /* 0 success, -1 failure */
+dbzfresh(name, size, fs, cmap, tagmask)
+char *name; /* base name; .dir and .pag must exist */
+long size; /* table size (0 means default) */
+int fs; /* field-separator character in base file */
+int cmap; /* case-map algorithm (0 means default) */
+off_t tagmask; /* 0 default, 1 no tags */
+{
+ register char *fn;
+ struct dbzconfig c;
+ register off_t m;
+ register FILE *f;
+
+ if (pagf != NULL) {
+ DEBUG(("dbzfresh: database already open\n"));
+ return(-1);
+ }
+ if (size != 0 && size < 2) {
+ DEBUG(("dbzfresh: preposterous size (%ld)\n", size));
+ return(-1);
+ }
+
+ /* get default configuration */
+ if (getconf((FILE *)NULL, (FILE *)NULL, &c) < 0)
+ return(-1); /* "can't happen" */
+
+ /* and mess with it as specified */
+ if (size != 0)
+ c.tsize = size;
+ c.fieldsep = fs;
+ switch (cmap) {
+ case 0:
+ case '0':
+ case 'B': /* 2.10 compat */
+ c.casemap = '0'; /* '\0' nicer, but '0' printable! */
+ break;
+ case '=':
+ case 'b': /* 2.11 compat */
+ c.casemap = '=';
+ break;
+ case 'C':
+ c.casemap = 'C';
+ break;
+ case '?':
+ c.casemap = DEFCASE;
+ break;
+ default:
+ DEBUG(("dbzfresh case map `%c' unknown\n", cmap));
+ return(-1);
+ break;
+ }
+ switch (tagmask) {
+ case 0: /* default */
+ break;
+ case 1: /* no tags */
+ c.tagshift = 0;
+ c.tagmask = 0;
+ c.tagenb = 0;
+ break;
+ default:
+ m = tagmask;
+ c.tagshift = 0;
+ while (!(m&01)) {
+ m >>= 1;
+ c.tagshift++;
+ }
+ c.tagmask = m;
+ c.tagenb = (m << 1) & ~m;
+ break;
+ }
+
+ /* write it out */
+ fn = enstring(name, dir);
+ if (fn == NULL)
+ return(-1);
+ f = fopen(fn, "w");
+ free(fn);
+ if (f == NULL) {
+ DEBUG(("dbzfresh: unable to write config\n"));
+ return(-1);
+ }
+ if (putconf(f, &c) < 0) {
+ (void) fclose(f);
+ return(-1);
+ }
+ if (fclose(f) == EOF) {
+ DEBUG(("dbzfresh: fclose failure\n"));
+ return(-1);
+ }
+
+ /* create/truncate .pag */
+ fn = enstring(name, pag);
+ if (fn == NULL)
+ return(-1);
+ f = fopen(fn, "w");
+ free(fn);
+ if (f == NULL) {
+ DEBUG(("dbzfresh: unable to create/truncate .pag file\n"));
+ return(-1);
+ } else
+ (void) fclose(f);
+
+ /* and punt to dbminit for the hard work */
+ return(dbminit(name));
+}
+
+/*
+ - dbzsize - what's a good table size to hold this many entries?
+ */
+long
+dbzsize(contents)
+long contents; /* 0 means what's the default */
+{
+ register long n;
+
+ if (contents <= 0) { /* foulup or default inquiry */
+ DEBUG(("dbzsize: preposterous input (%ld)\n", contents));
+ return(DEFSIZE);
+ }
+ n = (contents/2)*3; /* try to keep table at most 2/3 full */
+ if (!(n&01)) /* make it odd */
+ n++;
+ DEBUG(("dbzsize: tentative size %ld\n", n));
+ while (!isprime(n)) /* and look for a prime */
+ n += 2;
+ DEBUG(("dbzsize: final size %ld\n", n));
+
+ return(n);
+}
+
+/*
+ - isprime - is a number prime?
+ *
+ * This is not a terribly efficient approach.
+ */
+static int /* predicate */
+isprime(x)
+register long x;
+{
+ static int quick[] = { 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 0 };
+ register int *ip;
+ register long div;
+ register long stop;
+
+ /* hit the first few primes quickly to eliminate easy ones */
+ /* this incidentally prevents ridiculously small tables */
+ for (ip = quick; (div = *ip) != 0; ip++)
+ if (x%div == 0) {
+ DEBUG(("isprime: quick result on %ld\n", (long)x));
+ return(0);
+ }
+
+ /* approximate square root of x */
+ for (stop = x; x/stop < stop; stop >>= 1)
+ continue;
+ stop <<= 1;
+
+ /* try odd numbers up to stop */
+ for (div = *--ip; div < stop; div += 2)
+ if (x%div == 0)
+ return(0);
+
+ return(1);
+}
+
+/*
+ - dbzagain - set up a new database to be a rebuild of an old one
+ */
+int /* 0 success, -1 failure */
+dbzagain(name, oldname)
+char *name; /* base name; .dir and .pag must exist */
+char *oldname; /* base name; all must exist */
+{
+ register char *fn;
+ struct dbzconfig c;
+ register int i;
+ register long top;
+ register FILE *f;
+ register int newtable;
+ register off_t newsize;
+
+ if (pagf != NULL) {
+ DEBUG(("dbzagain: database already open\n"));
+ return(-1);
+ }
+
+ /* pick up the old configuration */
+ fn = enstring(oldname, dir);
+ if (fn == NULL)
+ return(-1);
+ f = fopen(fn, "r");
+ free(fn);
+ if (f == NULL) {
+ DEBUG(("dbzagain: cannot open old .dir file\n"));
+ return(-1);
+ }
+ i = getconf(f, (FILE *)NULL, &c);
+ (void) fclose(f);
+ if (i < 0) {
+ DEBUG(("dbzagain: getconf failed\n"));
+ return(-1);
+ }
+
+ /* tinker with it */
+ top = 0;
+ newtable = 0;
+ for (i = 0; i < NUSEDS; i++) {
+ if (top < c.used[i])
+ top = c.used[i];
+ if (c.used[i] == 0)
+ newtable = 1; /* hasn't got full usage history yet */
+ }
+ if (top == 0) {
+ DEBUG(("dbzagain: old table has no contents!\n"));
+ newtable = 1;
+ }
+ for (i = NUSEDS-1; i > 0; i--)
+ c.used[i] = c.used[i-1];
+ c.used[0] = 0;
+ newsize = dbzsize(top);
+ if (!newtable || newsize > c.tsize) /* don't shrink new table */
+ c.tsize = newsize;
+
+ /* write it out */
+ fn = enstring(name, dir);
+ if (fn == NULL)
+ return(-1);
+ f = fopen(fn, "w");
+ free(fn);
+ if (f == NULL) {
+ DEBUG(("dbzagain: unable to write new .dir\n"));
+ return(-1);
+ }
+ i = putconf(f, &c);
+ (void) fclose(f);
+ if (i < 0) {
+ DEBUG(("dbzagain: putconf failed\n"));
+ return(-1);
+ }
+
+ /* create/truncate .pag */
+ fn = enstring(name, pag);
+ if (fn == NULL)
+ return(-1);
+ f = fopen(fn, "w");
+ free(fn);
+ if (f == NULL) {
+ DEBUG(("dbzagain: unable to create/truncate .pag file\n"));
+ return(-1);
+ } else
+ (void) fclose(f);
+
+ /* and let dbminit do the work */
+ return(dbminit(name));
+}
+
+/*
+ - dbminit - open a database, creating it (using defaults) if necessary
+ *
+ * We try to leave errno set plausibly, to the extent that underlying
+ * functions permit this, since many people consult it if dbminit() fails.
+ */
+int /* 0 success, -1 failure */
+dbminit(name)
+char *name;
+{
+ register int i;
+ register size_t s;
+ register char *dirfname;
+ register char *pagfname;
+
+ if (pagf != NULL) {
+ DEBUG(("dbminit: dbminit already called once\n"));
+ errno = 0;
+ return(-1);
+ }
+
+ /* open the .dir file */
+ dirfname = enstring(name, dir);
+ if (dirfname == NULL)
+ return(-1);
+ dirf = fopen(dirfname, "r+");
+ if (dirf == NULL) {
+ dirf = fopen(dirfname, "r");
+ dirronly = 1;
+ } else
+ dirronly = 0;
+ free(dirfname);
+ if (dirf == NULL) {
+ DEBUG(("dbminit: can't open .dir file\n"));
+ return(-1);
+ }
+
+ /* open the .pag file */
+ pagfname = enstring(name, pag);
+ if (pagfname == NULL) {
+ (void) fclose(dirf);
+ return(-1);
+ }
+ pagf = fopen(pagfname, "r+b");
+ if (pagf == NULL) {
+ pagf = fopen(pagfname, "rb");
+ if (pagf == NULL) {
+ DEBUG(("dbminit: .pag open failed\n"));
+ (void) fclose(dirf);
+ free(pagfname);
+ return(-1);
+ }
+ pagronly = 1;
+ } else if (dirronly)
+ pagronly = 1;
+ else
+ pagronly = 0;
+#ifdef NOBUFFER
+ /*
+ * B News does not do adequate locking on its database accesses.
+ * Why it doesn't get into trouble using dbm is a mystery. In any
+ * case, doing unbuffered i/o does not cure the problem, but does
+ * enormously reduce its incidence.
+ */
+ (void) setbuf(pagf, (char *)NULL);
+#else
+#ifdef _IOFBF
+ (void) setvbuf(pagf, (char *)pagbuf, _IOFBF, sizeof(pagbuf));
+#endif
+#endif
+ pagpos = -1;
+ /* don't free pagfname, need it below */
+
+ /* open the base file */
+ basef = fopen(name, "r");
+ if (basef == NULL) {
+ DEBUG(("dbminit: basefile open failed\n"));
+ basefname = enstring(name, "");
+ if (basefname == NULL) {
+ (void) fclose(pagf);
+ (void) fclose(dirf);
+ free(pagfname);
+ pagf = NULL;
+ return(-1);
+ }
+ } else
+ basefname = NULL;
+#ifdef _IOFBF
+ if (basef != NULL)
+ (void) setvbuf(basef, basebuf, _IOFBF, sizeof(basebuf));
+#endif
+
+ /* pick up configuration */
+ if (getconf(dirf, pagf, &conf) < 0) {
+ DEBUG(("dbminit: getconf failure\n"));
+ (void) fclose(basef);
+ (void) fclose(pagf);
+ (void) fclose(dirf);
+ free(pagfname);
+ pagf = NULL;
+ errno = EDOM; /* kind of a kludge, but very portable */
+ return(-1);
+ }
+ tagbits = conf.tagmask << conf.tagshift;
+ taghere = conf.tagenb << conf.tagshift;
+ tagboth = tagbits | taghere;
+ mybytemap(mybmap);
+ bytesame = 1;
+ for (i = 0; i < SOF; i++)
+ if (mybmap[i] != conf.bytemap[i])
+ bytesame = 0;
+
+ /* get first table into core, if it looks desirable and feasible */
+ s = (size_t)conf.tsize * SOF;
+ if (incore && (off_t)(s/SOF) == conf.tsize) {
+ bufpagf = fopen(pagfname, (pagronly) ? "rb" : "r+b");
+ if (bufpagf != NULL)
+ corepag = getcore(bufpagf);
+ } else {
+ bufpagf = NULL;
+ corepag = NULL;
+ }
+ free(pagfname);
+
+ /* misc. setup */
+ crcinit();
+ written = 0;
+ prevp = FRESH;
+ DEBUG(("dbminit: succeeded\n"));
+ return(0);
+}
+
+/*
+ - enstring - concatenate two strings into a malloced area
+ */
+static char * /* NULL if malloc fails */
+enstring(s1, s2)
+char *s1;
+char *s2;
+{
+ register char *p;
+
+ p = malloc((size_t)strlen(s1) + (size_t)strlen(s2) + 1);
+ if (p != NULL) {
+ (void) strcpy(p, s1);
+ (void) strcat(p, s2);
+ } else {
+ DEBUG(("enstring(%s, %s) out of memory\n", s1, s2));
+ }
+ return(p);
+}
+
+/*
+ - dbmclose - close a database
+ */
+int
+dbmclose()
+{
+ register int ret = 0;
+
+ if (pagf == NULL) {
+ DEBUG(("dbmclose: not opened!\n"));
+ return(-1);
+ }
+
+ if (fclose(pagf) == EOF) {
+ DEBUG(("dbmclose: fclose(pagf) failed\n"));
+ ret = -1;
+ }
+ pagf = basef; /* ensure valid pointer; dbzsync checks it */
+ if (dbzsync() < 0)
+ ret = -1;
+ if (bufpagf != NULL && fclose(bufpagf) == EOF) {
+ DEBUG(("dbmclose: fclose(bufpagf) failed\n"));
+ ret = -1;
+ }
+ if (corepag != NULL)
+ free((char *)corepag);
+ corepag = NULL;
+ if (fclose(basef) == EOF) {
+ DEBUG(("dbmclose: fclose(basef) failed\n"));
+ ret = -1;
+ }
+ if (basefname != NULL)
+ free(basefname);
+ basef = NULL;
+ pagf = NULL;
+ if (fclose(dirf) == EOF) {
+ DEBUG(("dbmclose: fclose(dirf) failed\n"));
+ ret = -1;
+ }
+
+ DEBUG(("dbmclose: %s\n", (ret == 0) ? "succeeded" : "failed"));
+ return(ret);
+}
+
+/*
+ - dbzsync - push all in-core data out to disk
+ */
+int
+dbzsync()
+{
+ register int ret = 0;
+
+ if (pagf == NULL) {
+ DEBUG(("dbzsync: not opened!\n"));
+ return(-1);
+ }
+ if (!written)
+ return(0);
+
+ if (corepag != NULL) {
+ if (putcore(corepag, bufpagf) < 0) {
+ DEBUG(("dbzsync: putcore failed\n"));
+ ret = -1;
+ }
+ }
+ if (!conf.olddbz)
+ if (putconf(dirf, &conf) < 0)
+ ret = -1;
+
+ DEBUG(("dbzsync: %s\n", (ret == 0) ? "succeeded" : "failed"));
+ return(ret);
+}
+
+/*
+ - dbzcancel - cancel writing of in-core data
+ * Mostly for use from child processes.
+ * Note that we don't need to futz around with stdio buffers, because we
+ * always fflush them immediately anyway and so they never have stale data.
+ */
+int
+dbzcancel()
+{
+ if (pagf == NULL) {
+ DEBUG(("dbzcancel: not opened!\n"));
+ return(-1);
+ }
+
+ written = 0;
+ return(0);
+}
+
+/*
+ - dbzfetch - fetch() with case mapping built in
+ */
+datum
+dbzfetch(key)
+datum key;
+{
+ char buffer[DBZMAXKEY + 1];
+ datum mappedkey;
+ register size_t keysize;
+
+ DEBUG(("dbzfetch: (%s)\n", key.dptr));
+
+ /* Key is supposed to be less than DBZMAXKEY */
+ keysize = key.dsize;
+ if (keysize >= DBZMAXKEY) {
+ keysize = DBZMAXKEY;
+ DEBUG(("keysize is %d - truncated to %d\n", key.dsize, DBZMAXKEY));
+ }
+
+ mappedkey.dptr = mapcase(buffer, key.dptr, keysize);
+ buffer[keysize] = '\0'; /* just a debug aid */
+ mappedkey.dsize = keysize;
+
+ return(fetch(mappedkey));
+}
+
+/*
+ - fetch - get an entry from the database
+ *
+ * Disgusting fine point, in the name of backward compatibility: if the
+ * last character of "key" is a NUL, that character is (effectively) not
+ * part of the comparison against the stored keys.
+ */
+datum /* dptr NULL, dsize 0 means failure */
+fetch(key)
+datum key;
+{
+ char buffer[DBZMAXKEY + 1];
+ static off_t key_ptr; /* return value points here */
+ datum output;
+ register size_t keysize;
+ register size_t cmplen;
+ register char *sepp;
+
+ DEBUG(("fetch: (%s)\n", key.dptr));
+ output.dptr = NULL;
+ output.dsize = 0;
+ prevp = FRESH;
+
+ /* Key is supposed to be less than DBZMAXKEY */
+ keysize = key.dsize;
+ if (keysize >= DBZMAXKEY) {
+ keysize = DBZMAXKEY;
+ DEBUG(("keysize is %d - truncated to %d\n", key.dsize, DBZMAXKEY));
+ }
+
+ if (pagf == NULL) {
+ DEBUG(("fetch: database not open!\n"));
+ return(output);
+ } else if (basef == NULL) { /* basef didn't exist yet */
+ basef = latebase();
+ if (basef == NULL)
+ return(output);
+ }
+
+ cmplen = keysize;
+ sepp = &conf.fieldsep;
+ if (key.dptr[keysize-1] == '\0') {
+ cmplen--;
+ sepp = &buffer[keysize-1];
+ }
+ start(&srch, &key, FRESH);
+ while ((key_ptr = search(&srch)) != NOTFOUND) {
+ DEBUG(("got 0x%lx\n", key_ptr));
+
+ /* fetch the key */
+ if (fseek(basef, key_ptr, SEEK_SET) != 0) {
+ DEBUG(("fetch: seek failed\n"));
+ return(output);
+ }
+ if (fread(buffer, 1, keysize, basef) != keysize) {
+ DEBUG(("fetch: read failed\n"));
+ return(output);
+ }
+
+ /* try it */
+ buffer[keysize] = '\0'; /* terminated for DEBUG */
+ (void) mapcase(buffer, buffer, keysize);
+ DEBUG(("fetch: buffer (%s) looking for (%s) size = %d\n",
+ buffer, key.dptr, keysize));
+ if (memcmp(key.dptr, buffer, cmplen) == 0 &&
+ (*sepp == conf.fieldsep || *sepp == '\0')) {
+ /* we found it */
+ output.dptr = (char *)&key_ptr;
+ output.dsize = SOF;
+ DEBUG(("fetch: successful\n"));
+ return(output);
+ }
+ }
+
+ /* we didn't find it */
+ DEBUG(("fetch: failed\n"));
+ prevp = &srch; /* remember where we stopped */
+ return(output);
+}
+
+/*
+ - latebase - try to open a base file that wasn't there at the start
+ */
+static FILE *
+latebase()
+{
+ register FILE *it;
+
+ if (basefname == NULL) {
+ DEBUG(("latebase: name foulup\n"));
+ return(NULL);
+ }
+ it = fopen(basefname, "r");
+ if (it == NULL) {
+ DEBUG(("latebase: still can't open base\n"));
+ } else {
+ DEBUG(("latebase: late open succeeded\n"));
+ free(basefname);
+ basefname = NULL;
+#ifdef _IOFBF
+ (void) setvbuf(it, basebuf, _IOFBF, sizeof(basebuf));
+#endif
+ }
+ return(it);
+}
+
+/*
+ - dbzstore - store() with case mapping built in
+ */
+int
+dbzstore(key, data)
+datum key;
+datum data;
+{
+ char buffer[DBZMAXKEY + 1];
+ datum mappedkey;
+ register size_t keysize;
+
+ DEBUG(("dbzstore: (%s)\n", key.dptr));
+
+ /* Key is supposed to be less than DBZMAXKEY */
+ keysize = key.dsize;
+ if (keysize >= DBZMAXKEY) {
+ DEBUG(("dbzstore: key size too big (%d)\n", key.dsize));
+ return(-1);
+ }
+
+ mappedkey.dptr = mapcase(buffer, key.dptr, keysize);
+ buffer[keysize] = '\0'; /* just a debug aid */
+ mappedkey.dsize = keysize;
+
+ return(store(mappedkey, data));
+}
+
+/*
+ - store - add an entry to the database
+ */
+int /* 0 success, -1 failure */
+store(key, data)
+datum key;
+datum data;
+{
+ off_t value;
+
+ if (pagf == NULL) {
+ DEBUG(("store: database not open!\n"));
+ return(-1);
+ } else if (basef == NULL) { /* basef didn't exist yet */
+ basef = latebase();
+ if (basef == NULL)
+ return(-1);
+ }
+ if (pagronly) {
+ DEBUG(("store: database open read-only\n"));
+ return(-1);
+ }
+ if (data.dsize != SOF) {
+ DEBUG(("store: value size wrong (%d)\n", data.dsize));
+ return(-1);
+ }
+ if (key.dsize >= DBZMAXKEY) {
+ DEBUG(("store: key size too big (%d)\n", key.dsize));
+ return(-1);
+ }
+
+ /* copy the value in to ensure alignment */
+ (void) memcpy((char *)&value, data.dptr, SOF);
+ DEBUG(("store: (%s, %ld)\n", key.dptr, (long)value));
+ if (!okayvalue(value)) {
+ DEBUG(("store: reserved bit or overflow in 0x%lx\n", value));
+ return(-1);
+ }
+
+ /* find the place, exploiting previous search if possible */
+ start(&srch, &key, prevp);
+ while (search(&srch) != NOTFOUND)
+ continue;
+
+ prevp = FRESH;
+ conf.used[0]++;
+ DEBUG(("store: used count %ld\n", conf.used[0]));
+ written = 1;
+ return(set(&srch, value));
+}
+
+/*
+ - dbzincore - control attempts to keep .pag file in core
+ */
+int /* old setting */
+dbzincore(value)
+int value;
+{
+ register int old = incore;
+
+ incore = value;
+ return(old);
+}
+
+/*
+ - getconf - get configuration from .dir file
+ */
+static int /* 0 success, -1 failure */
+getconf(df, pf, cp)
+register FILE *df; /* NULL means just give me the default */
+register FILE *pf; /* NULL means don't care about .pag */
+register struct dbzconfig *cp;
+{
+ register int c;
+ register int i;
+ int err = 0;
+
+ c = (df != NULL) ? getc(df) : EOF;
+ if (c == EOF) { /* empty file, no configuration known */
+ cp->olddbz = 0;
+ if (df != NULL && pf != NULL && getc(pf) != EOF)
+ cp->olddbz = 1;
+ cp->tsize = DEFSIZE;
+ cp->fieldsep = '\t';
+ for (i = 0; i < NUSEDS; i++)
+ cp->used[i] = 0;
+ cp->valuesize = SOF;
+ mybytemap(cp->bytemap);
+ cp->casemap = DEFCASE;
+ cp->tagenb = TAGENB;
+ cp->tagmask = TAGMASK;
+ cp->tagshift = TAGSHIFT;
+ DEBUG(("getconf: defaults (%ld, %c, (0x%lx/0x%lx<<%d))\n",
+ cp->tsize, cp->casemap, cp->tagenb,
+ cp->tagmask, cp->tagshift));
+ return(0);
+ }
+ (void) ungetc(c, df);
+
+ /* first line, the vital stuff */
+ if (getc(df) != 'd' || getc(df) != 'b' || getc(df) != 'z')
+ err = -1;
+ if (getno(df, &err) != dbzversion)
+ err = -1;
+ cp->tsize = getno(df, &err);
+ cp->fieldsep = getno(df, &err);
+ while ((c = getc(df)) == ' ')
+ continue;
+ cp->casemap = c;
+ cp->tagenb = getno(df, &err);
+ cp->tagmask = getno(df, &err);
+ cp->tagshift = getno(df, &err);
+ cp->valuesize = getno(df, &err);
+ if (cp->valuesize != SOF) {
+ DEBUG(("getconf: wrong off_t size (%d)\n", cp->valuesize));
+ err = -1;
+ cp->valuesize = SOF; /* to protect the loops below */
+ }
+ for (i = 0; i < cp->valuesize; i++)
+ cp->bytemap[i] = getno(df, &err);
+ if (getc(df) != '\n')
+ err = -1;
+ DEBUG(("size %ld, sep %d, cmap %c, tags 0x%lx/0x%lx<<%d, ", cp->tsize,
+ cp->fieldsep, cp->casemap, cp->tagenb, cp->tagmask,
+ cp->tagshift));
+ DEBUG(("bytemap (%d)", cp->valuesize));
+ for (i = 0; i < cp->valuesize; i++) {
+ DEBUG((" %d", cp->bytemap[i]));
+ }
+ DEBUG(("\n"));
+
+ /* second line, the usages */
+ for (i = 0; i < NUSEDS; i++)
+ cp->used[i] = getno(df, &err);
+ if (getc(df) != '\n')
+ err = -1;
+ DEBUG(("used %ld %ld %ld...\n", cp->used[0], cp->used[1], cp->used[2]));
+
+ if (err < 0) {
+ DEBUG(("getconf error\n"));
+ return(-1);
+ }
+ return(0);
+}
+
+/*
+ - getno - get a long
+ */
+static long
+getno(f, ep)
+FILE *f;
+int *ep;
+{
+ register char *p;
+# define MAXN 50
+ char getbuf[MAXN];
+ register int c;
+
+ while ((c = getc(f)) == ' ')
+ continue;
+ if (c == EOF || c == '\n') {
+ DEBUG(("getno: missing number\n"));
+ *ep = -1;
+ return(0);
+ }
+ p = getbuf;
+ *p++ = c;
+ while ((c = getc(f)) != EOF && c != '\n' && c != ' ')
+ if (p < &getbuf[MAXN-1])
+ *p++ = c;
+ if (c == EOF) {
+ DEBUG(("getno: EOF\n"));
+ *ep = -1;
+ } else
+ (void) ungetc(c, f);
+ *p = '\0';
+
+ if (strspn(getbuf, "-1234567890") != strlen(getbuf)) {
+ DEBUG(("getno: `%s' non-numeric\n", getbuf));
+ *ep = -1;
+ }
+ return(atol(getbuf));
+}
+
+/*
+ - putconf - write configuration to .dir file
+ */
+static int /* 0 success, -1 failure */
+putconf(f, cp)
+register FILE *f;
+register struct dbzconfig *cp;
+{
+ register int i;
+ register int ret = 0;
+
+ if (fseek(f, 0, SEEK_SET) != 0) {
+ DEBUG(("fseek failure in putconf\n"));
+ ret = -1;
+ }
+ fprintf(f, "dbz %d %ld %d %c %ld %ld %d %d", dbzversion, cp->tsize,
+ cp->fieldsep, cp->casemap, cp->tagenb,
+ cp->tagmask, cp->tagshift, cp->valuesize);
+ for (i = 0; i < cp->valuesize; i++)
+ fprintf(f, " %d", cp->bytemap[i]);
+ fprintf(f, "\n");
+ for (i = 0; i < NUSEDS; i++)
+ fprintf(f, "%ld%c", cp->used[i], (i < NUSEDS-1) ? ' ' : '\n');
+
+ (void) fflush(f);
+ if (ferror(f))
+ ret = -1;
+
+ DEBUG(("putconf status %d\n", ret));
+ return(ret);
+}
+
+/*
+ - getcore - try to set up an in-core copy of .pag file
+ */
+static off_t * /* pointer to copy, or NULL */
+getcore(f)
+FILE *f;
+{
+ register off_t *p;
+ register size_t i;
+ register size_t nread;
+ register char *it;
+
+ it = malloc((size_t)conf.tsize * SOF);
+ if (it == NULL) {
+ DEBUG(("getcore: malloc failed\n"));
+ return(NULL);
+ }
+
+ nread = fread(it, SOF, (size_t)conf.tsize, f);
+ if (ferror(f)) {
+ DEBUG(("getcore: read failed\n"));
+ free(it);
+ return(NULL);
+ }
+
+ p = (off_t *)it + nread;
+ i = (size_t)conf.tsize - nread;
+ while (i-- > 0)
+ *p++ = VACANT;
+ return((off_t *)it);
+}
+
+/*
+ - putcore - try to rewrite an in-core table
+ */
+static int /* 0 okay, -1 fail */
+putcore(tab, f)
+off_t *tab;
+FILE *f;
+{
+ if (fseek(f, 0, SEEK_SET) != 0) {
+ DEBUG(("fseek failure in putcore\n"));
+ return(-1);
+ }
+ (void) fwrite((char *)tab, SOF, (size_t)conf.tsize, f);
+ (void) fflush(f);
+ return((ferror(f)) ? -1 : 0);
+}
+
+/*
+ - start - set up to start or restart a search
+ */
+static void
+start(sp, kp, osp)
+register struct searcher *sp;
+register datum *kp;
+register struct searcher *osp; /* may be FRESH, i.e. NULL */
+{
+ register long h;
+
+ h = hash(kp->dptr, kp->dsize);
+ if (osp != FRESH && osp->hash == h) {
+ if (sp != osp)
+ *sp = *osp;
+ DEBUG(("search restarted\n"));
+ } else {
+ sp->hash = h;
+ sp->tag = MKTAG(h / conf.tsize);
+ DEBUG(("tag 0x%lx\n", sp->tag));
+ sp->place = h % conf.tsize;
+ sp->tabno = 0;
+ sp->run = (conf.olddbz) ? conf.tsize : MAXRUN;
+ sp->aborted = 0;
+ }
+ sp->seen = 0;
+}
+
+/*
+ - search - conduct part of a search
+ */
+static off_t /* NOTFOUND if we hit VACANT or error */
+search(sp)
+register struct searcher *sp;
+{
+ register off_t dest;
+ register off_t value;
+ off_t val; /* buffer for value (can't fread register) */
+ register off_t place;
+
+ if (sp->aborted)
+ return(NOTFOUND);
+
+ for (;;) {
+ /* determine location to be examined */
+ place = sp->place;
+ if (sp->seen) {
+ /* go to next location */
+ if (--sp->run <= 0) {
+ sp->tabno++;
+ sp->run = MAXRUN;
+ }
+ place = (place+1)%conf.tsize + sp->tabno*conf.tsize;
+ sp->place = place;
+ } else
+ sp->seen = 1; /* now looking at current location */
+ DEBUG(("search @ %ld\n", place));
+
+ /* get the tagged value */
+ if (corepag != NULL && place < conf.tsize) {
+ DEBUG(("search: in core\n"));
+ value = MAPIN(corepag[place]);
+ } else {
+ /* seek, if necessary */
+ dest = place * SOF;
+ if (pagpos != dest) {
+ if (fseek(pagf, dest, SEEK_SET) != 0) {
+ DEBUG(("search: seek failed\n"));
+ pagpos = -1;
+ sp->aborted = 1;
+ return(NOTFOUND);
+ }
+ pagpos = dest;
+ }
+
+ /* read it */
+ if (fread((char *)&val, sizeof(val), 1, pagf) == 1)
+ value = MAPIN(val);
+ else if (ferror(pagf)) {
+ DEBUG(("search: read failed\n"));
+ pagpos = -1;
+ sp->aborted = 1;
+ return(NOTFOUND);
+ } else
+ value = VACANT;
+
+ /* and finish up */
+ pagpos += sizeof(val);
+ }
+
+ /* vacant slot is always cause to return */
+ if (value == VACANT) {
+ DEBUG(("search: empty slot\n"));
+ return(NOTFOUND);
+ };
+
+ /* check the tag */
+ value = UNBIAS(value);
+ DEBUG(("got 0x%lx\n", value));
+ if (!HASTAG(value)) {
+ DEBUG(("tagless\n"));
+ return(value);
+ } else if (TAG(value) == sp->tag) {
+ DEBUG(("match\n"));
+ return(NOTAG(value));
+ } else {
+ DEBUG(("mismatch 0x%lx\n", TAG(value)));
+ }
+ }
+ /* NOTREACHED */
+}
+
+/*
+ - okayvalue - check that a value can be stored
+ */
+static int /* predicate */
+okayvalue(value)
+off_t value;
+{
+ if (HASTAG(value))
+ return(0);
+#ifdef OVERFLOW
+ if (value == LONG_MAX) /* BIAS() and UNBIAS() will overflow */
+ return(0);
+#endif
+ return(1);
+}
+
+/*
+ - set - store a value into a location previously found by search
+ */
+static int /* 0 success, -1 failure */
+set(sp, value)
+register struct searcher *sp;
+off_t value;
+{
+ register off_t place = sp->place;
+ register off_t v = value;
+
+ if (sp->aborted)
+ return(-1);
+
+ if (CANTAG(v) && !conf.olddbz) {
+ v |= sp->tag | taghere;
+ if (v != UNBIAS(VACANT)) /* BIAS(v) won't look VACANT */
+#ifdef OVERFLOW
+ if (v != LONG_MAX) /* and it won't overflow */
+#endif
+ value = v;
+ }
+ DEBUG(("tagged value is 0x%lx\n", value));
+ value = BIAS(value);
+ value = MAPOUT(value);
+
+ /* If we have the index file in memory, use it */
+ if (corepag != NULL && place < conf.tsize) {
+ corepag[place] = value;
+ DEBUG(("set: incore\n"));
+ return(0);
+ }
+
+ /* seek to spot */
+ pagpos = -1; /* invalidate position memory */
+ if (fseek(pagf, place * SOF, SEEK_SET) != 0) {
+ DEBUG(("set: seek failed\n"));
+ sp->aborted = 1;
+ return(-1);
+ }
+
+ /* write in data */
+ if (fwrite((char *)&value, SOF, 1, pagf) != 1) {
+ DEBUG(("set: write failed\n"));
+ sp->aborted = 1;
+ return(-1);
+ }
+ /* fflush improves robustness, and buffer re-use is rare anyway */
+ if (fflush(pagf) == EOF) {
+ DEBUG(("set: fflush failed\n"));
+ sp->aborted = 1;
+ return(-1);
+ }
+
+ DEBUG(("set: succeeded\n"));
+ return(0);
+}
+
+/*
+ - mybytemap - determine this machine's byte map
+ *
+ * A byte map is an array of ints, sizeof(off_t) of them. The 0th int
+ * is the byte number of the high-order byte in my off_t, and so forth.
+ */
+static void
+mybytemap(map)
+int map[]; /* -> int[SOF] */
+{
+ union {
+ off_t o;
+ char c[SOF];
+ } u;
+ register int *mp = &map[SOF];
+ register int ntodo;
+ register int i;
+
+ u.o = 1;
+ for (ntodo = (int)SOF; ntodo > 0; ntodo--) {
+ for (i = 0; i < SOF; i++)
+ if (u.c[i] != 0)
+ break;
+ if (i == SOF) {
+ /* trouble -- set it to *something* consistent */
+ DEBUG(("mybytemap: nonexistent byte %d!!!\n", ntodo));
+ for (i = 0; i < SOF; i++)
+ map[i] = i;
+ return;
+ }
+ DEBUG(("mybytemap: byte %d\n", i));
+ *--mp = i;
+ while (u.c[i] != 0)
+ u.o <<= 1;
+ }
+}
+
+/*
+ - bytemap - transform an off_t from byte ordering map1 to map2
+ */
+static off_t /* transformed result */
+bytemap(ino, map1, map2)
+off_t ino;
+int *map1;
+int *map2;
+{
+ union oc {
+ off_t o;
+ char c[SOF];
+ };
+ union oc in;
+ union oc out;
+ register int i;
+
+ in.o = ino;
+ for (i = 0; i < SOF; i++)
+ out.c[map2[i]] = in.c[map1[i]];
+ return(out.o);
+}
+
+/*
+ * This is a simplified version of the pathalias hashing function.
+ * Thanks to Steve Belovin and Peter Honeyman
+ *
+ * hash a string into a long int. 31 bit crc (from andrew appel).
+ * the crc table is computed at run time by crcinit() -- we could
+ * precompute, but it takes 1 clock tick on a 750.
+ *
+ * This fast table calculation works only if POLY is a prime polynomial
+ * in the field of integers modulo 2. Since the coefficients of a
+ * 32-bit polynomial won't fit in a 32-bit word, the high-order bit is
+ * implicit. IT MUST ALSO BE THE CASE that the coefficients of orders
+ * 31 down to 25 are zero. Happily, we have candidates, from
+ * E. J. Watson, "Primitive Polynomials (Mod 2)", Math. Comp. 16 (1962):
+ * x^32 + x^7 + x^5 + x^3 + x^2 + x^1 + x^0
+ * x^31 + x^3 + x^0
+ *
+ * We reverse the bits to get:
+ * 111101010000000000000000000000001 but drop the last 1
+ * f 5 0 0 0 0 0 0
+ * 010010000000000000000000000000001 ditto, for 31-bit crc
+ * 4 8 0 0 0 0 0 0
+ */
+
+#define POLY 0x48000000L /* 31-bit polynomial (avoids sign problems) */
+
+static long CrcTable[128];
+
+/*
+ - crcinit - initialize tables for hash function
+ */
+static void
+crcinit()
+{
+ register int i, j;
+ register long sum;
+
+ for (i = 0; i < 128; ++i) {
+ sum = 0L;
+ for (j = 7 - 1; j >= 0; --j)
+ if (i & (1 << j))
+ sum ^= POLY >> j;
+ CrcTable[i] = sum;
+ }
+ DEBUG(("crcinit: done\n"));
+}
+
+/*
+ - hash - Honeyman's nice hashing function
+ */
+static long
+hash(name, size)
+register char *name;
+register int size;
+{
+ register long sum = 0L;
+
+ while (size--) {
+ sum = (sum >> 7) ^ CrcTable[(sum ^ (*name++)) & 0x7f];
+ }
+ DEBUG(("hash: returns (%ld)\n", sum));
+ return(sum);
+}
+
+/*
+ * case-mapping stuff
+ *
+ * Borrowed from C News, by permission of the authors. Somewhat modified.
+ *
+ * We exploit the fact that we are dealing only with headers here, and
+ * headers are limited to the ASCII characters by RFC822. It is barely
+ * possible that we might be dealing with a translation into another
+ * character set, but in particular it's very unlikely for a header
+ * character to be outside -128..255.
+ *
+ * Life would be a whole lot simpler if tolower() could safely and portably
+ * be applied to any char.
+ */
+
+#define OFFSET 128 /* avoid trouble with negative chars */
+
+/* must call casencmp before invoking TOLOW... */
+#define TOLOW(c) (cmap[(c)+OFFSET])
+
+/* ...but the use of it in CISTREQN is safe without the preliminary call (!) */
+/* CISTREQN is an optimised case-insensitive strncmp(a,b,n)==0; n > 0 */
+#define CISTREQN(a, b, n) \
+ (TOLOW((a)[0]) == TOLOW((b)[0]) && casencmp(a, b, n) == 0)
+
+#define MAPSIZE (256+OFFSET)
+static char cmap[MAPSIZE]; /* relies on init to '\0' */
+static int mprimed = 0; /* has cmap been set up? */
+
+/*
+ - mapprime - set up case-mapping stuff
+ */
+static void
+mapprime()
+{
+ register char *lp;
+ register char *up;
+ register int c;
+ register int i;
+ static char lower[] = "abcdefghijklmnopqrstuvwxyz";
+ static char upper[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+ for (lp = lower, up = upper; *lp != '\0'; lp++, up++) {
+ c = *lp;
+ cmap[c+OFFSET] = c;
+ cmap[*up+OFFSET] = c;
+ }
+ for (i = 0; i < MAPSIZE; i++)
+ if (cmap[i] == '\0')
+ cmap[i] = (char)(i-OFFSET);
+ mprimed = 1;
+}
+
+/*
+ - casencmp - case-independent strncmp
+ */
+static int /* < == > 0 */
+casencmp(s1, s2, len)
+char *s1;
+char *s2;
+int len;
+{
+ register char *p1;
+ register char *p2;
+ register int n;
+
+ if (!mprimed)
+ mapprime();
+
+ p1 = s1;
+ p2 = s2;
+ n = len;
+ while (--n >= 0 && *p1 != '\0' && TOLOW(*p1) == TOLOW(*p2)) {
+ p1++;
+ p2++;
+ }
+ if (n < 0)
+ return(0);
+
+ /*
+ * The following case analysis is necessary so that characters
+ * which look negative collate low against normal characters but
+ * high against the end-of-string NUL.
+ */
+ if (*p1 == '\0' && *p2 == '\0')
+ return(0);
+ else if (*p1 == '\0')
+ return(-1);
+ else if (*p2 == '\0')
+ return(1);
+ else
+ return(TOLOW(*p1) - TOLOW(*p2));
+}
+
+/*
+ - mapcase - do case-mapped copy
+ */
+static char * /* returns src or dst */
+mapcase(dst, src, siz)
+char *dst; /* destination, used only if mapping needed */
+char *src; /* source; src == dst is legal */
+size_t siz;
+{
+ register char *s;
+ register char *d;
+ register char *c; /* case break */
+ register char *e; /* end of source */
+
+
+ c = cipoint(src, siz);
+ if (c == NULL)
+ return(src);
+
+ if (!mprimed)
+ mapprime();
+ s = src;
+ e = s + siz;
+ d = dst;
+
+ while (s < c)
+ *d++ = *s++;
+ while (s < e)
+ *d++ = TOLOW(*s++);
+
+ return(dst);
+}
+
+/*
+ - cipoint - where in this message-ID does it become case-insensitive?
+ *
+ * The RFC822 code is not quite complete. Absolute, total, full RFC822
+ * compliance requires a horrible parsing job, because of the arcane
+ * quoting conventions -- abc"def"ghi is not equivalent to abc"DEF"ghi,
+ * for example. There are three or four things that might occur in the
+ * domain part of a message-id that are case-sensitive. They don't seem
+ * to ever occur in real news, thank Cthulhu. (What? You were expecting
+ * a merciful and forgiving deity to be invoked in connection with RFC822?
+ * Forget it; none of them would come near it.)
+ */
+static char * /* pointer into s, or NULL for "nowhere" */
+cipoint(s, siz)
+char *s;
+size_t siz;
+{
+ register char *p;
+ static char post[] = "postmaster";
+ static int plen = sizeof(post)-1;
+
+ switch (conf.casemap) {
+ case '0': /* unmapped, sensible */
+ return(NULL);
+ break;
+ case 'C': /* C News, RFC 822 conformant (approx.) */
+ p = memchr(s, '@', siz);
+ if (p == NULL) /* no local/domain split */
+ return(NULL); /* assume all local */
+ else if (p - (s+1) == plen && CISTREQN(s+1, post, plen)) {
+ /* crazy -- "postmaster" is case-insensitive */
+ return(s);
+ } else
+ return(p);
+ break;
+ case '=': /* 2.11, neither sensible nor conformant */
+ return(s); /* all case-insensitive */
+ break;
+ }
+
+ DEBUG(("cipoint: unknown case mapping `%c'\n", conf.casemap));
+ return(NULL); /* just leave it alone */
+}
+
+/*
+ - dbzdebug - control dbz debugging at run time
+ */
+int /* old value */
+dbzdebug(value)
+int value;
+{
+#ifdef DBZDEBUG
+ register int old = debug;
+
+ debug = value;
+ return(old);
+#else
+ return(-1);
+#endif
+}
diff --git a/libio/dbz/dbz.h b/libio/dbz/dbz.h
new file mode 100644
index 00000000000..3d7e8ed702c
--- /dev/null
+++ b/libio/dbz/dbz.h
@@ -0,0 +1,32 @@
+/* for dbm and dbz */
+typedef struct {
+ char *dptr;
+ int dsize;
+} datum;
+
+/* standard dbm functions */
+extern int dbminit();
+extern datum fetch();
+extern int store();
+extern int delete(); /* not in dbz */
+extern datum firstkey(); /* not in dbz */
+extern datum nextkey(); /* not in dbz */
+extern int dbmclose(); /* in dbz, but not in old dbm */
+
+/* new stuff for dbz */
+extern int dbzfresh();
+extern int dbzagain();
+extern datum dbzfetch();
+extern int dbzstore();
+extern int dbzsync();
+extern long dbzsize();
+extern int dbzincore();
+extern int dbzcancel();
+extern int dbzdebug();
+
+/*
+ * In principle we could handle unlimited-length keys by operating a chunk
+ * at a time, but it's not worth it in practice. Setting a nice large
+ * bound on them simplifies the code and doesn't hurt anything.
+ */
+#define DBZMAXKEY 255
diff --git a/libio/dbz/dbzmain.c b/libio/dbz/dbzmain.c
new file mode 100644
index 00000000000..4317a0d0831
--- /dev/null
+++ b/libio/dbz/dbzmain.c
@@ -0,0 +1,519 @@
+/*
+ * dbz - use and test dbz in various ways
+ *
+ * -Log-
+ */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <string.h>
+#include <dbz.h>
+
+#ifdef FUNNYSEEKS
+#include <unistd.h>
+#else
+#define SEEK_SET 0
+#endif
+
+#define STREQ(a, b) (*(a) == *(b) && strcmp((a), (b)) == 0)
+
+#ifndef lint
+static char RCSid[] = "$Header: /egcs/carton/cvsfiles/egcs/./libio/dbz/dbzmain.c,v 1.1 1997/08/21 22:58:23 jason Exp $";
+#endif
+
+char *progname;
+
+char *inname = "(no file)"; /* filename for messages etc. */
+long lineno; /* line number for messages etc. */
+
+char *my_basename;
+char *pagname;
+char *dir_name;
+char *str2dup();
+FILE *base;
+
+int op = 'b'; /* what to do, default build a new table */
+int baseinput = 1; /* is the base file also the input? */
+
+char *from = NULL; /* old table to use for dbzagain() */
+int omitzero = 0; /* omit lines tagged with 0 */
+long every = 0; /* report every n lines */
+int syncs = 0; /* dbzsync() on each report */
+int quick = 0; /* quick checking, not too thorough */
+int sweep = 0; /* sweep file checking all offsets */
+int useincore = 1; /* should we use incore facility? */
+long xxx = 0; /* debugging variable */
+int printx = 0; /* print xxx after all is done */
+int unique = 1; /* before store(), check with fetch() */
+int usefresh = 0; /* use dbzfresh? */
+long siz = 0; /* -p size */
+char map = 'C'; /* -p map */
+long tag = 0; /* -p tag mask */
+int exact = 0; /* do not run dbzsize(siz) */
+int dbzint = 1; /* use new interface? */
+char fs = '\t'; /* field separator, default tab */
+int unopen = 0; /* make base unopenable during dbminit? */
+char *change = NULL; /* chdir here before dbmclose */
+
+#define DEFBUF 1024 /* default line-buffer size */
+int buflen = DEFBUF; /* line length limit */
+char lbuf[DEFBUF];
+char *line = lbuf;
+char cbuf[DEFBUF];
+char *cmp = cbuf;
+
+void fail();
+void dofile();
+void runs();
+void dosweep();
+void mkfiles();
+void crfile();
+void doline();
+void process();
+
+#ifdef HAVERFCIZE
+extern char *rfc822ize();
+#else
+#define rfc822ize(n) (n)
+#endif
+
+extern char *malloc();
+
+/*
+ - main - parse arguments and handle options
+ */
+int
+main(argc, argv)
+int argc;
+char *argv[];
+{
+ int c;
+ int errflg = 0;
+ extern int optind;
+ extern char *optarg;
+ int doruns = 0;
+ extern long atol();
+
+ progname = argv[0];
+
+ while ((c = getopt(argc, argv, "axcmt:l:R0E:SqOiX:Yuf:p:eMUC:d")) != EOF)
+ switch (c) {
+ case 'a': /* append to existing table */
+ if (op != 'b')
+ fail("only one of -a -x -c -m can be given", "");
+ op = 'a';
+ baseinput = 0;
+ break;
+ case 'x': /* extract from existing table */
+ if (op != 'b')
+ fail("only one of -a -x -c -m can be given", "");
+ op = 'x';
+ baseinput = 0;
+ break;
+ case 'c': /* check existing table */
+ if (op != 'b')
+ fail("only one of -a -x -c -m can be given", "");
+ op = 'c';
+ break;
+ case 'm': /* extract missing (complement of -x) */
+ if (op != 'b')
+ fail("only one of -a -x -c -m can be given", "");
+ op = 'm';
+ baseinput = 0;
+ break;
+ case 't': /* set field separator */
+ if (strlen(optarg) > 1)
+ fail("only one field separator allowed", "");
+ fs = *optarg;
+ break;
+ case 'l': /* override line-length limit */
+ buflen = atoi(optarg) + 1;
+ if (buflen <= 2)
+ fail("bad -l value `%s'", optarg);
+ line = malloc(buflen);
+ cmp = malloc(buflen);
+ if (line == NULL || cmp == NULL)
+ fail("cannot allocate %s-byte buffers", optarg);
+ break;
+ case 'R': /* print run statistics */
+ doruns = 1;
+ break;
+ case '0': /* omit lines tagged (by fake -t) with 0 */
+ omitzero = 1;
+ break;
+ case 'E': /* report every n items */
+ every = atol(optarg);
+ break;
+ case 'S': /* dbzsync() on each -E report */
+ syncs = 1;
+ break;
+ case 'q': /* quick check or extract */
+ quick = 1;
+ break;
+ case 'O': /* sweep file checking all offsets */
+ sweep = 1;
+ break;
+ case 'i': /* don't use incore */
+ useincore = 0;
+ break;
+ case 'X': /* set xxx */
+ xxx = atoi(optarg);
+ break;
+ case 'Y': /* print xxx afterward */
+ printx = 1;
+ break;
+ case 'u': /* don't check uniqueness */
+ unique = 0;
+ break;
+ case 'f': /* init from existing table's parameters */
+ from = optarg;
+ break;
+ case 'p': /* parameters for dbzfresh */
+ if (sscanf(optarg, "%ld %1s %lx", &siz, &map, &tag) != 3) {
+ map = '?';
+ tag = 0;
+ if (sscanf(optarg, "%ld", &siz) != 1)
+ fail("bad -n value `%s'", optarg);
+ }
+ usefresh = 1;
+ break;
+ case 'e': /* -p size is exact, don't dbzsize() it */
+ exact = 1;
+ break;
+ case 'M': /* use old dbm interface + rfc822ize */
+ dbzint = 0;
+ break;
+ case 'U': /* make base unopenable during init */
+ unopen = 1;
+ break;
+ case 'C': /* change directories before dbmclose */
+ change = optarg;
+ break;
+ case 'd': /* Debugging. */
+ if (dbzdebug(1) < 0)
+ fail("dbz debugging not available", "");
+ break;
+ case '?':
+ default:
+ errflg++;
+ break;
+ }
+ if (errflg || optind >= argc || (optind+1 < argc && baseinput)) {
+ fprintf(stderr, "usage: %s ", progname);
+ fprintf(stderr, "[-a] [-x] [-c] database [file] ...\n");
+ exit(2);
+ }
+
+ (void) dbzincore(useincore);
+ my_basename = argv[optind];
+ pagname = str2dup(my_basename, ".pag");
+ dir_name = str2dup(my_basename, ".dir");
+ mkfiles();
+ optind++;
+
+ if (baseinput) /* implies no further arguments */
+ process(base, my_basename);
+ else if (optind >= argc)
+ process(stdin, "stdin");
+ else
+ for (; optind < argc; optind++)
+ dofile(argv[optind]);
+
+ if (change != NULL)
+ (void) chdir(change);
+ if (dbmclose() < 0)
+ fail("dbmclose failed", "");
+ if (doruns)
+ runs(pagname);
+ if (sweep)
+ dosweep(my_basename, pagname);
+ if (printx)
+ printf("%ld\n", xxx);
+#ifdef DBZ_FINISH
+ DBZ_FINISH;
+#endif
+ exit(0);
+}
+
+/*
+ - dofile - open a file and invoke process()
+ */
+void
+dofile(name)
+char *name;
+{
+ register FILE *in;
+
+ if (STREQ(name, "-"))
+ process(stdin, "-");
+ else {
+ in = fopen(name, "r");
+ if (in == NULL)
+ fail("cannot open `%s'", name);
+ process(in, name);
+ (void) fclose(in);
+ }
+}
+
+/*
+ - mkfiles - create empty files and open them up
+ */
+void
+mkfiles()
+{
+ if (op == 'b' && !dbzint) {
+ crfile(dir_name);
+ crfile(pagname);
+ }
+
+ base = fopen(my_basename, (op == 'a') ? "a" : "r");
+ if (base == NULL)
+ fail("cannot open `%s'", my_basename);
+ if (unopen)
+ (void) chmod(my_basename, 0);
+ if (from != NULL) {
+ if (dbzagain(my_basename, from) < 0)
+ fail("dbzagain(`%s'...) failed", my_basename);
+ } else if (op == 'b' && dbzint) {
+ if (!exact)
+ siz = dbzsize(siz);
+ if (dbzfresh(my_basename, siz, (int)fs, map, tag) < 0)
+ fail("dbzfresh(`%s'...) failed", my_basename);
+ } else if (dbminit(my_basename) < 0)
+ fail("dbminit(`%s') failed", my_basename);
+ if (unopen)
+ (void) chmod(my_basename, 0600); /* hard to restore original */
+}
+
+/*
+ - crfile - create a file
+ */
+void
+crfile(name)
+char *name;
+{
+ register int f;
+
+ f = creat(name, 0666);
+ if (f < 0)
+ fail("cannot create `%s'", name);
+ (void) close(f);
+}
+
+/*
+ - process - process input file
+ */
+void
+process(in, name)
+FILE *in;
+char *name;
+{
+ register off_t place;
+
+ inname = name;
+ lineno = 0;
+
+ for (;;) {
+ place = ftell(in);
+ if (fgets(line, buflen, in) == NULL)
+ return;
+ lineno++;
+ if (every > 0 && lineno%every == 0) {
+ fprintf(stderr, "%ld\n", lineno);
+ if (dbzsync() < 0)
+ fail("dbzsync failed", "");
+ }
+ doline(line, place);
+ }
+ /* NOTREACHED */
+}
+
+/*
+ - doline - process input line
+ */
+void
+doline(lp, inoffset)
+char *lp;
+off_t inoffset;
+{
+ register char *p;
+ register char pc;
+ datum key, value;
+ off_t place = inoffset;
+ register int shouldfind;
+ register int llen;
+ char keytext[DBZMAXKEY+1];
+
+ p = NULL;
+ if (fs != '\0')
+ p = strchr(lp, fs);
+ if (p == NULL)
+ p = lp + strlen(lp);
+ if (p > lp && *(p-1) == '\n')
+ p--;
+ if (p - lp > DBZMAXKEY)
+ fail("key of `%.40s...' too long", lp);
+ pc = *p;
+ *p = '\0';
+ (void) strcpy(keytext, lp);
+ *p = pc;
+ key.dptr = (dbzint) ? keytext : rfc822ize(keytext);
+ key.dsize = strlen(keytext)+1;
+
+ switch (op) {
+ case 'a':
+ place = ftell(base);
+ llen = strlen(lp);
+ if (fwrite(lp, 1, llen, base) != llen)
+ fail("write error in `%s'", my_basename);
+ /* FALLTHROUGH */
+ case 'b':
+ if (omitzero && p != NULL && *(p+1) == '0')
+ return;
+ if (unique) {
+ value = (dbzint) ? dbzfetch(key) : fetch(key);
+ if (value.dptr != NULL)
+ fail("`%.40s...' already present", lp);
+ }
+ value.dptr = (char *)&place;
+ value.dsize = (int)sizeof(off_t);
+ if (((dbzint) ? dbzstore(key, value) : store(key, value)) < 0)
+ fail("store failed on `%.40s...'", lp);
+ break;
+ case 'c':
+ value = (dbzint) ? dbzfetch(key) : fetch(key);
+ shouldfind = (omitzero && p != NULL && *(p+1) == '0') ? 0 : 1;
+ if (!shouldfind && (value.dptr != NULL || value.dsize != 0))
+ fail("`%.40s...' found, shouldn't be", lp);
+ if (shouldfind && (value.dptr == NULL ||
+ value.dsize != sizeof(off_t)))
+ fail("can't find `%.40s...'", lp);
+ if (shouldfind && !quick) {
+ (void) memcpy((char *)&place, value.dptr, sizeof(off_t));
+ if (place != inoffset)
+ fail("offset mismatch on `%.40s...'", lp);
+ if (fseek(base, place, SEEK_SET) == -1)
+ fail("fseek failed on `%.40s...'", lp);
+ if (fgets(cmp, buflen, base) == NULL)
+ fail("can't read line for `%.40s...'", lp);
+ if (!STREQ(lp, cmp))
+ fail("compare failed on `%.40s...'", lp);
+ }
+ break;
+ case 'x':
+ value = (dbzint) ? dbzfetch(key) : fetch(key);
+ if (value.dptr != NULL && !quick) {
+ (void) memcpy((char *)&place, value.dptr, sizeof(off_t));
+ if (fseek(base, place, SEEK_SET) == -1)
+ fail("fseek failed on `%.40s...'", lp);
+ if (fgets(cmp, buflen, base) == NULL)
+ fail("can't read line for `%.40s...'", lp);
+ fputs(cmp, stdout);
+ } else if (value.dptr != NULL)
+ fputs(lp, stdout);
+ break;
+ case 'm':
+ value = (dbzint) ? dbzfetch(key) : fetch(key);
+ if (value.dptr == NULL) {
+ fputs(keytext, stdout);
+ putchar('\n');
+ }
+ break;
+ default:
+ fail("unknown operator -- can't happen", "");
+ break;
+ }
+}
+
+/*
+ - runs - print run statistics
+ */
+void
+runs(file)
+char *file;
+{
+ register FILE *fd;
+ off_t it;
+ register long run;
+
+ fd = fopen(file, "r");
+ if (fd == NULL)
+ fail("cannot reopen `%s'", file);
+ run = 0;
+ while (fread((char *)&it, sizeof(off_t), 1, fd) == 1) {
+ if (it != 0)
+ run++;
+ else if (run > 0) {
+ printf("%ld\n", run);
+ run = 0;
+ }
+ }
+ (void) fclose(fd);
+}
+
+/*
+ - dosweep - sweep pag file checking for valid offsets
+ */
+void
+dosweep(fn, pn)
+char *fn;
+char *pn;
+{
+ register FILE *pf;
+ off_t it;
+ char nl;
+ register FILE *hf;
+
+ hf = fopen(fn, "r");
+ if (hf == NULL)
+ fail("cannot reopen `%s'", fn);
+ pf = fopen(pn, "r");
+ if (pf == NULL)
+ fail("cannot reopen `%s'", pn);
+ while (fread((char *)&it, sizeof(off_t), 1, pf) == 1) {
+ it = (it & ((off_t)0x80000000)) ? (it&~((off_t)0xff000000)) : it;
+ if (it != 0 && it != 1) { /* 0 empty, 1 known okay */
+ it--; /* get rid of bias */
+ (void) fseek(hf, it-1, SEEK_SET);
+ nl = getc(hf);
+ if (nl != '\n')
+ fprintf(stderr, "offset 0%lo does not point to line\n",
+ (long)it);
+ }
+ }
+ (void) fclose(hf);
+ (void) fclose(pf);
+}
+
+/*
+ - fail - complain and die
+ */
+void
+fail(s1, s2)
+char *s1;
+char *s2;
+{
+ fprintf(stderr, "%s: (file `%s', line %ld) ", progname, inname, lineno);
+ fprintf(stderr, s1, s2);
+ fprintf(stderr, "\n");
+ exit(1);
+}
+
+/*
+ - str2dup - concatenate strings and malloc result
+ */
+char *
+str2dup(s1, s2)
+char *s1;
+char *s2;
+{
+ register char *p;
+
+ p = malloc((size_t)strlen(s1) + strlen(s2) + 1);
+ if (p == NULL)
+ fail("can't allocate space for strings", "");
+ (void) strcpy(p, s1);
+ (void) strcat(p, s2);
+ return(p);
+}
diff --git a/libio/dbz/fake.c b/libio/dbz/fake.c
new file mode 100644
index 00000000000..ed2a2b75937
--- /dev/null
+++ b/libio/dbz/fake.c
@@ -0,0 +1,144 @@
+/*
+ * fake - make up random lines resembling history-file entries, reproducibly
+ *
+ * -Log-
+ */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <string.h>
+
+#define MAXSTR 500 /* For sizing strings -- DON'T use BUFSIZ! */
+#define STREQ(a, b) (*(a) == *(b) && strcmp((a), (b)) == 0)
+
+#ifndef lint
+static char RCSid[] = "$Header: /rel/cvsfiles/devo/libio/dbz/fake.c,v 1.2 1993/10/25 20:02:42 bothner Exp $";
+#endif
+
+int midonly = 0; /* just message ids, rest not realistic */
+int tag = 0; /* tag lines with random digit for later use */
+int expired = -1; /* percentage of lines to be expired */
+
+int debug = 0;
+char *progname;
+
+char *inname; /* filename for messages etc. */
+long lineno; /* line number for messages etc. */
+
+void doline();
+void addchars();
+void seed();
+
+/*
+ - main - parse arguments and handle options
+ */
+int
+main(argc, argv)
+int argc;
+char *argv[];
+{
+ int c;
+ int errflg = 0;
+ FILE *in;
+ struct stat statbuf;
+ extern int optind;
+ extern char *optarg;
+ void process();
+ register long no;
+ extern long atol();
+ char line[MAXSTR];
+
+ progname = argv[0];
+
+ while ((c = getopt(argc, argv, "ms:te:d")) != EOF)
+ switch (c) {
+ case 'm': /* message-ids only */
+ midonly = 1;
+ break;
+ case 's': /* seed */
+ seed(atol(optarg));
+ break;
+ case 't': /* tag lines with a random digit */
+ tag = 1;
+ break;
+ case 'e': /* percentage to be expired */
+ expired = atoi(optarg);
+ break;
+ case 'd': /* Debugging. */
+ debug++;
+ break;
+ case '?':
+ default:
+ errflg++;
+ break;
+ }
+ if (errflg || optind != argc - 1) {
+ fprintf(stderr, "usage: %s ", progname);
+ fprintf(stderr, "[-m] [-s seed] length\n");
+ exit(2);
+ }
+
+ for (no = atol(argv[optind]); no > 0; no--) {
+ doline(line);
+ puts(line);
+ }
+#ifdef DBZ_FINISH
+ DBZ_FINISH;
+#endif
+ exit(0);
+}
+
+/*
+ - doline - generate random history pseudo-line
+ */
+void
+doline(buf)
+char *buf;
+{
+ char tagch[2];
+
+ (void) strcpy(buf, "<");
+ addchars(buf, range(4, 20));
+ (void) strcat(buf, "@");
+ addchars(buf, range(8, 20));
+ if (midonly)
+ (void) strcat(buf, ">\tx");
+ else {
+ if (tag) {
+ tagch[0] = "1234567890"[range(0,9)];
+ tagch[1] = '\0';
+ (void) strcat(buf, ">\t");
+ (void) strcat(buf, tagch);
+ (void) strcat(buf, "00000000~-");
+ } else
+ (void) strcat(buf, ">\t1234567890~-");
+ }
+ if (range(1, 100) > expired) {
+ if (midonly)
+ (void) strcat(buf, "\tx");
+ else {
+ (void) strcat(buf, "\t");
+ addchars(buf, range(10, 30));
+ }
+ }
+}
+
+/*
+ - addchars - generate n random characters suitable for history file
+ */
+void
+addchars(buf, len)
+char *buf;
+int len;
+{
+ register int i;
+ register char *p = buf + strlen(buf);
+ static char vocab[] = "1234567890.abcde.fghij.klmno.pqrst.uvwxyz.\
+1234567890.ABCDE.FGHIJ.KLMNO.PQRST.UVWXYZ.1234567890.\
+1234567890.abcde.fghij.klmno.pqrst.uvwxyz.1234567890";
+
+ for (i = len; i > 0; i--)
+ *p++ = vocab[range(0, sizeof(vocab)-2)];
+ *p++ = '\0';
+}
diff --git a/libio/dbz/firstlast25 b/libio/dbz/firstlast25
new file mode 100644
index 00000000000..4850468c0c2
--- /dev/null
+++ b/libio/dbz/firstlast25
@@ -0,0 +1,50 @@
+<m....VO1.9q.@s95e1zKsIj7LrIwa1> 600000000~- 90fz0706yo.1Env21x8b
+<H5.i.R6ZQ2@Vg6.5mqj8..z> 200000000~-
+<1Hy.ufmjqe371x5.o@HEEl0tAp4> 700000000~-
+<T6.c9.xM4i@943..7z.c..3h> 600000000~-
+<Exus7LsME4fPL9v8@2.ouu97O25z9cdft> 700000000~-
+<6kUzkf.v74@iC1iGj882RQ0zli> 400000000~-
+<J.7YT7dV.Kkul8Bh0fc@Rar.EnMx2lm0.6Yeob> 600000000~-
+<.wVJi1DX42@5.4i6.jaZ6qw9Ln1.> 500000000~-
+<uUd9e18vxzevae7uY@33a480208l0.4p2q> 300000000~-
+<43hQ.5shbE7@912400.ajES6x0sXl.M> 400000000~-
+<g25r..2r.0WOZ6k3@tb3.U9xrR.uw61a2y0> 600000000~-
+<923s5e67d5Oq085Y.1@6Pik68584> 900000000~-
+<.5.n5cx5aD62i9q8@Ai60Sc.4x> 200000000~-
+<9N9n@3.1ql87.yj2xFs.zLqI> 700000000~- Q2.kni8kZps7kF5uiEv32B38y4z.p
+<.X.fw.6LtoT.0@pp6bp.5s6yh74.> 400000000~-
+<54c1w@7..u1.99m9T4j.BNGBiK> 600000000~- .F3hb.OFh06V..p
+<j12Mtn6q9@m2.m1X1s> 500000000~-
+<o1WJV9G4H.zf0BX44w@W7.76xn33> 000000000~-
+<0C605s6plaAgfM.ap40@e6d66n.uv01W.j.8ph.> 100000000~- m.x7TY8.8DQ5
+<.2.14xdn.@D0g.W.uZ.75gyyg.q1G> 100000000~-
+<.A..03.@5v..64.5v3.3tbjUo.> 500000000~-
+<72..c19ms65.WCf0G3.@83seEG9nnhM.O.j22> 900000000~-
+<D..xX.kti9@u739li.xvy2> 000000000~- NPLL42XVfM
+<6HO.nFal1ufl3.8b@3.n0k7a.IDgNy> 700000000~- Wv4j3Itccnh0Zp3
+<x5RjUnIpd03xBBnuN@z0puc82Q26Ou.0T6> 400000000~- k67.hvXwv6X745R4rh2ybuFN3n.
+<62dIeg.fW92.ov375@x76mf5c6.37.v> 000000000~-
+<chdpqs.0mgZOp.@Dxl9v..94e7ar2> 900000000~-
+<.9Xr.7V91..oe5CG.hX@p5x3jos3s27R6O3yj1> 400000000~-
+<Mm6dr.231dH35ua@SE1u0za3V1M43lRn9> 100000000~-
+<JIhw2@.Qdf.8v28Tnf1M> 200000000~-
+<z4FCa.q4MF..EE0.2@W9U63e33h9w3lcFFl> 400000000~-
+<87.W3r6is4.@svVqQCBiNqz400A.qwj> 200000000~-
+<0liI7Lu0Mx435m7M99@87Xw.8j63.9.> 500000000~-
+<tRtht5M.6d0@06gj.qm3.s9> 200000000~- e27S.BKVD70P.o
+<Jpga8@m68yvw.b4b> 200000000~-
+<.2.69hy3JT1@Aq3.r83o.9> 700000000~-
+<.W7EurYppo4fhzs.I@8651m2W7v> 700000000~-
+<3m02.@22074.a5ct2j3> 900000000~-
+<.fy9Epa@.1.kNGCNokFwB8ezo1WM> 800000000~-
+<c758d64.FS4yY7L5@43sw.kI6> 900000000~-
+<vLd0.t@.kq70oHl96ixdnXd.GVv> 100000000~- 9A6Ejq5t55I4VJ6.q1
+<d3.4@n17p4N.77N7W..7.8> 300000000~-
+<f2lv064.8@4jokk3e07> 400000000~-
+<rr7hoxA.U7.JXxnpvd@1rbMO437vHnakx> 000000000~-
+<.0p3G7novlrYz9kjI@Sx.2w.yqzerZl12781.k> 700000000~-
+<51ny.pQ7ay4@nfU2l1f0ixG09584.m> 000000000~- 38K5bhK7cr6.bg.5MlC2Fxq06Ziuw.
+<2.cau.9s@.n4Pk0Jd9g> 300000000~-
+<bEH1Bwa.662i@zm.3g.gx4.lp3> 300000000~- c8.t4Q0.8t0.m50
+<.t13789u5AqM4m3.z0T@P17e.ypf> 200000000~- q17z.fZ3.FyD533WthqZs8q7
+<M4r1I@Ovaev.dp> 100000000~-
diff --git a/libio/dbz/getmap b/libio/dbz/getmap
new file mode 100755
index 00000000000..fd746cad7d9
--- /dev/null
+++ b/libio/dbz/getmap
@@ -0,0 +1,6 @@
+#!/bin/sh
+awk 'NR == 1 {
+ for (i = 9; i <= NF; i++)
+ printf "%s ", $i
+ printf "\n"
+}' $*
diff --git a/libio/dbz/random.c b/libio/dbz/random.c
new file mode 100644
index 00000000000..1d8de3a2b44
--- /dev/null
+++ b/libio/dbz/random.c
@@ -0,0 +1,31 @@
+/*
+ * random-number generator for testing
+ */
+static unsigned long next = 1;
+
+/*
+ - range - generate a random number within an inclusive range
+ *
+ * Algorithm from ANSI C standard. Limitation: max-min <= 32767.
+ */
+int
+range(min, max)
+int min;
+int max;
+{
+ register int temp;
+
+ next = next * 1103515245 + 12345;
+ temp = (int)((next/65536)%32768);
+ return(temp%(max - min + 1) + min);
+}
+
+/*
+ - seed - seed random number generator
+ */
+void
+seed(n)
+long n;
+{
+ next = (unsigned long)n;
+}
diff --git a/libio/dbz/revbytes b/libio/dbz/revbytes
new file mode 100644
index 00000000000..b3d80c2685f
--- /dev/null
+++ b/libio/dbz/revbytes
@@ -0,0 +1,7 @@
+NR == 1 {
+ printf "%s %s %s %s %s %s %s %s %s", $1, $2, $3, $4, $5, $6, $7, $8, $9
+ for (i = NF; i > 9; i--)
+ printf " %s", $i
+ printf "\n"
+}
+NR > 1 { print }
diff --git a/libio/dbz/stdio.h b/libio/dbz/stdio.h
new file mode 100644
index 00000000000..80faee30ad9
--- /dev/null
+++ b/libio/dbz/stdio.h
@@ -0,0 +1 @@
+#include "../iostdio.h"
diff --git a/libio/depend b/libio/depend
new file mode 100644
index 00000000000..171356c080f
--- /dev/null
+++ b/libio/depend
@@ -0,0 +1,352 @@
+# AUTOMATICALLY GENERATED BY 'make depend' - DO NOT EDIT
+
+PlotFile.o: PlotFile.cc \
+ $(srcdir)/PlotFile.h \
+ $(srcdir)/fstream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h
+SFile.o: SFile.cc \
+ $(srcdir)/SFile.h \
+ $(srcdir)/fstream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h
+builtinbuf.o: builtinbuf.cc \
+ $(srcdir)/builtinbuf.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/iostreamP.h \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h
+editbuf.o: editbuf.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/editbuf.h \
+ $(srcdir)/fstream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h
+filebuf.o: filebuf.cc \
+ $(srcdir)/iostreamP.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/builtinbuf.h
+fstream.o: fstream.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/fstream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h
+indstream.o: indstream.cc \
+ $(srcdir)/indstream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h
+ioassign.o: ioassign.cc \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h
+ioextend.o: ioextend.cc \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h
+iomanip.o: iomanip.cc \
+ $(srcdir)/iomanip.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h
+iostream.o: iostream.cc \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/floatio.h
+isgetline.o: isgetline.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h
+isgetsb.o: isgetsb.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h
+isscan.o: isscan.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h
+osform.o: osform.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h
+parsestream.o: parsestream.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/parsestream.h \
+ $(srcdir)/streambuf.h
+pfstream.o: pfstream.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/pfstream.h \
+ $(srcdir)/fstream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/procbuf.h
+procbuf.o: procbuf.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/procbuf.h \
+ $(srcdir)/streambuf.h
+sbform.o: sbform.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/streambuf.h
+sbgetline.o: sbgetline.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/streambuf.h
+sbscan.o: sbscan.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/streambuf.h
+stdiostream.o: stdiostream.cc \
+ $(srcdir)/stdiostream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h
+stdstrbufs.o: stdstrbufs.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+stdstreams.o: stdstreams.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/iostream.h
+stream.o: stream.cc \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/stream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/strstream.h \
+ $(srcdir)/strfile.h
+streambuf.o: streambuf.cc \
+ $(srcdir)/iostreamP.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h
+strstream.o: strstream.cc \
+ $(srcdir)/iostreamP.h \
+ $(srcdir)/streambuf.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/strstream.h \
+ $(srcdir)/iostream.h \
+ $(srcdir)/strfile.h
+cleanup.o: cleanup.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+filedoalloc.o: filedoalloc.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+fileops.o: fileops.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+floatconv.o: floatconv.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+genops.o: genops.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofclose.o: iofclose.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofdopen.o: iofdopen.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofflush.o: iofflush.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofgetpos.o: iofgetpos.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofgets.o: iofgets.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofopen.o: iofopen.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofprintf.o: iofprintf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofputs.o: iofputs.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofread.o: iofread.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofscanf.o: iofscanf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofsetpos.o: iofsetpos.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioftell.o: ioftell.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iofwrite.o: iofwrite.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iogetdelim.o: iogetdelim.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iogetline.o: iogetline.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iogets.o: iogets.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioignore.o: ioignore.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iopadn.o: iopadn.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioperror.o: ioperror.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iopopen.o: iopopen.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioprims.o: ioprims.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioprintf.o: ioprintf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioputs.o: ioputs.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioscanf.o: ioscanf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioseekoff.o: ioseekoff.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioseekpos.o: ioseekpos.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iosetbuffer.o: iosetbuffer.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iosetvbuf.o: iosetvbuf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iosprintf.o: iosprintf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iosscanf.o: iosscanf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iostrerror.o: iostrerror.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+ioungetc.o: ioungetc.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+iovfprintf.o: iovfprintf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/floatio.h
+iovfscanf.o: iovfscanf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/floatio.h
+iovsprintf.o: iovsprintf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/strfile.h
+iovsscanf.o: iovsscanf.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/strfile.h
+outfloat.o: outfloat.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+stdfiles.o: stdfiles.c \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h \
+ $(srcdir)/libio.h _G_config.h
+strops.o: strops.c \
+ $(srcdir)/strfile.h \
+ $(srcdir)/libio.h _G_config.h \
+ $(srcdir)/libioP.h \
+ $(srcdir)/iolibio.h
diff --git a/libio/editbuf.cc b/libio/editbuf.cc
new file mode 100644
index 00000000000..22304820f8f
--- /dev/null
+++ b/libio/editbuf.cc
@@ -0,0 +1,717 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+
+Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#include "libioP.h"
+#include "editbuf.h"
+#include <stddef.h>
+#include <stdlib.h>
+
+/* NOTE: Some of the code here is taken from GNU emacs */
+/* Hence this file falls under the GNU License! */
+
+// Invariants for edit_streambuf:
+// An edit_streambuf is associated with a specific edit_string,
+// which again is a sub-string of a specific edit_buffer.
+// An edit_streambuf is always in either get mode or put mode, never both.
+// In get mode, gptr() is the current position,
+// and pbase(), pptr(), and epptr() are all NULL.
+// In put mode, pptr() is the current position,
+// and eback(), gptr(), and egptr() are all NULL.
+// Any edit_streambuf that is actively doing insertion (as opposed to
+// replacing) // must have its pptr() pointing to the start of the gap.
+// Only one edit_streambuf can be actively inserting into a specific
+// edit_buffer; the edit_buffer's _writer field points to that edit_streambuf.
+// That edit_streambuf "owns" the gap, and the actual start of the
+// gap is the pptr() of the edit_streambuf; the edit_buffer::_gap_start pointer
+// will only be updated on an edit_streambuf::overflow().
+
+int edit_streambuf::truncate()
+{
+ str->buffer->delete_range(str->buffer->tell((buf_char*)pptr()),
+ str->buffer->tell(str->end));
+ return 0;
+}
+
+#ifdef OLD_STDIO
+inline void disconnect_gap_from_file(edit_buffer* buffer, FILE* fp)
+{
+ if (buffer->gap_start_ptr != &fp->__bufp)
+ return;
+ buffer->gap_start_normal = fp->__bufp;
+ buffer->gap_start_ptr = &buffer->gap_start_normal;
+}
+#endif
+
+void edit_streambuf::flush_to_buffer(edit_buffer* buffer)
+{
+ if (pptr() > buffer->_gap_start && pptr() < buffer->gap_end())
+ buffer->_gap_start = pptr();
+}
+
+void edit_streambuf::disconnect_gap_from_file(edit_buffer* buffer)
+{
+ if (buffer->_writer != this) return;
+ flush_to_buffer(buffer);
+ setp(pptr(),pptr());
+ buffer->_writer = NULL;
+}
+
+buf_index edit_buffer::tell(buf_char *ptr)
+{
+ if (ptr <= gap_start())
+ return ptr - data;
+ else
+ return ptr - gap_end() + size1();
+}
+
+#if 0
+buf_index buf_cookie::tell()
+{
+ return str->buffer->tell(file->__bufp);
+}
+#endif
+
+buf_index edit_buffer::tell(edit_mark*mark)
+{
+ return tell(data + mark->index_in_buffer(this));
+}
+
+// adjust the position of the gap
+
+void edit_buffer::move_gap(buf_offset pos)
+{
+ if (pos < size1())
+ gap_left (pos);
+ else if (pos > size1())
+ gap_right (pos);
+}
+
+void edit_buffer::gap_left (int pos)
+{
+ register buf_char *to, *from;
+ register int i;
+ int new_s1;
+
+ i = size1();
+ from = gap_start();
+ to = from + gap_size();
+ new_s1 = size1();
+
+ /* Now copy the characters. To move the gap down,
+ copy characters up. */
+
+ for (;;)
+ {
+ /* I gets number of characters left to copy. */
+ i = new_s1 - pos;
+ if (i == 0)
+ break;
+#if 0
+ /* If a quit is requested, stop copying now.
+ Change POS to be where we have actually moved the gap to. */
+ if (QUITP)
+ {
+ pos = new_s1;
+ break;
+ }
+#endif
+ /* Move at most 32000 chars before checking again for a quit. */
+ if (i > 32000)
+ i = 32000;
+ new_s1 -= i;
+ while (--i >= 0)
+ *--to = *--from;
+ }
+
+ /* Adjust markers, and buffer data structure, to put the gap at POS.
+ POS is where the loop above stopped, which may be what was specified
+ or may be where a quit was detected. */
+ adjust_markers (pos << 1, size1() << 1, gap_size(), data);
+#ifndef OLD_STDIO
+ _gap_start = data + pos;
+#else
+ if (gap_start_ptr == &gap_start_normal)
+ gap_start_normal = data + pos;
+#endif
+ __gap_end_pos = to - data;
+/* QUIT;*/
+}
+
+void edit_buffer::gap_right (int pos)
+{
+ register buf_char *to, *from;
+ register int i;
+ int new_s1;
+
+ i = size1();
+ to = gap_start();
+ from = i + gap_end();
+ new_s1 = i;
+
+ /* Now copy the characters. To move the gap up,
+ copy characters down. */
+
+ while (1)
+ {
+ /* I gets number of characters left to copy. */
+ i = pos - new_s1;
+ if (i == 0)
+ break;
+#if 0
+ /* If a quit is requested, stop copying now.
+ Change POS to be where we have actually moved the gap to. */
+ if (QUITP)
+ {
+ pos = new_s1;
+ break;
+ }
+#endif
+ /* Move at most 32000 chars before checking again for a quit. */
+ if (i > 32000)
+ i = 32000;
+ new_s1 += i;
+ while (--i >= 0)
+ *to++ = *from++;
+ }
+
+ adjust_markers ((size1() + gap_size()) << 1, (pos + gap_size()) << 1,
+ - gap_size(), data);
+#ifndef OLD_STDIO
+ _gap_start = data+pos;
+#else
+ if (gap_start_ptr == &gap_start_normal)
+ gap_start_normal = data + pos;
+#endif
+ __gap_end_pos = from - data;
+/* QUIT;*/
+}
+
+/* make sure that the gap in the current buffer is at least k
+ characters wide */
+
+void edit_buffer::make_gap(buf_offset k)
+{
+ register buf_char *p1, *p2, *lim;
+ buf_char *old_data = data;
+ int s1 = size1();
+
+ if (gap_size() >= k)
+ return;
+
+ /* Get more than just enough */
+ if (buf_size > 1000) k += 2000;
+ else k += /*200;*/ 20; // for testing!
+
+ p1 = (buf_char *) realloc (data, s1 + size2() + k);
+ if (p1 == 0)
+ abort(); /*memory_full ();*/
+
+ k -= gap_size(); /* Amount of increase. */
+
+ /* Record new location of text */
+ data = p1;
+
+ /* Transfer the new free space from the end to the gap
+ by shifting the second segment upward */
+ p2 = data + buf_size;
+ p1 = p2 + k;
+ lim = p2 - size2();
+ while (lim < p2)
+ *--p1 = *--p2;
+
+ /* Finish updating text location data */
+ __gap_end_pos += k;
+
+#ifndef OLD_STDIO
+ _gap_start = data + s1;
+#else
+ if (gap_start_ptr == &gap_start_normal)
+ gap_start_normal = data + s1;
+#endif
+
+ /* adjust markers */
+ adjust_markers (s1 << 1, (buf_size << 1) + 1, k, old_data);
+ buf_size += k;
+}
+
+/* Add `amount' to the position of every marker in the current buffer
+ whose current position is between `from' (exclusive) and `to' (inclusive).
+ Also, any markers past the outside of that interval, in the direction
+ of adjustment, are first moved back to the near end of the interval
+ and then adjusted by `amount'. */
+
+void edit_buffer::adjust_markers(register mark_pointer low,
+ register mark_pointer high,
+ int amount, buf_char *old_data)
+{
+ register struct edit_mark *m;
+ register mark_pointer mpos;
+ /* convert to mark_pointer */
+ amount <<= 1;
+
+ if (_writer)
+ _writer->disconnect_gap_from_file(this);
+
+ for (m = mark_list(); m != NULL; m = m->chain)
+ {
+ mpos = m->_pos;
+ if (amount > 0)
+ {
+ if (mpos > high && mpos < high + amount)
+ mpos = high + amount;
+ }
+ else
+ {
+ if (mpos > low + amount && mpos <= low)
+ mpos = low + amount;
+ }
+ if (mpos > low && mpos <= high)
+ mpos += amount;
+ m->_pos = mpos;
+ }
+
+ // Now adjust files
+ edit_streambuf *file;
+
+ for (file = files; file != NULL; file = file->next) {
+ mpos = file->current() - old_data;
+ if (amount > 0)
+ {
+ if (mpos > high && mpos < high + amount)
+ mpos = high + amount;
+ }
+ else
+ {
+ if (mpos > low + amount && mpos <= low)
+ mpos = low + amount;
+ }
+ if (mpos > low && mpos <= high)
+ mpos += amount;
+ char* new_pos = data + mpos;
+ file->set_current(new_pos, file->is_reading());
+ }
+}
+
+#if 0
+stdio_
+ __off == index at start of buffer (need only be valid after seek ? )
+ __buf ==
+
+if read/read_delete/overwrite mode:
+ __endp <= min(*gap_start_ptr, edit_string->end->ptr(buffer))
+
+if inserting:
+ must have *gap_start_ptr == __bufp && *gap_start_ptr+gap == __endp
+ file->edit_string->end->ptr(buffer) == *gap_start_ptr+end
+if write_mode:
+ if before gap
+#endif
+
+int edit_streambuf::underflow()
+{
+ if (!(_mode & ios::in))
+ return EOF;
+ struct edit_buffer *buffer = str->buffer;
+ if (!is_reading()) { // Must switch from put to get mode.
+ disconnect_gap_from_file(buffer);
+ set_current(pptr(), 1);
+ }
+ buf_char *str_end = str->end->ptr(buffer);
+ retry:
+ if (gptr() < egptr()) {
+ return *gptr();
+ }
+ if ((buf_char*)gptr() == str_end)
+ return EOF;
+ if (str_end <= buffer->gap_start()) {
+ setg(eback(), gptr(), str_end);
+ goto retry;
+ }
+ if (gptr() < buffer->gap_start()) {
+ setg(eback(), gptr(), buffer->gap_start());
+ goto retry;
+ }
+ if (gptr() == buffer->gap_start()) {
+ disconnect_gap_from_file(buffer);
+// fp->__offset += fp->__bufp - fp->__buffer;
+ setg(buffer->gap_end(), buffer->gap_end(), str_end);
+ }
+ else
+ setg(eback(), gptr(), str_end);
+ goto retry;
+}
+
+int edit_streambuf::overflow(int ch)
+{
+ if (_mode == ios::in)
+ return EOF;
+ struct edit_buffer *buffer = str->buffer;
+ flush_to_buffer(buffer);
+ if (ch == EOF)
+ return 0;
+ if (is_reading()) { // Must switch from get to put mode.
+ set_current(gptr(), 0);
+ }
+ buf_char *str_end = str->end->ptr(buffer);
+ retry:
+ if (pptr() < epptr()) {
+ *pptr() = ch;
+ pbump(1);
+ return (unsigned char)ch;
+ }
+ if ((buf_char*)pptr() == str_end || inserting()) {
+ /* insert instead */
+ if (buffer->_writer)
+ buffer->_writer->flush_to_buffer(); // Redundant?
+ buffer->_writer = NULL;
+ if (pptr() >= buffer->gap_end())
+ buffer->move_gap(pptr() - buffer->gap_size());
+ else
+ buffer->move_gap(pptr());
+ buffer->make_gap(1);
+ setp(buffer->gap_start(), buffer->gap_end());
+ buffer->_writer = this;
+ *pptr() = ch;
+ pbump(1);
+ return (unsigned char)ch;
+ }
+ if (str_end <= buffer->gap_start()) {
+ // Entire string is left of gap.
+ setp(pptr(), str_end);
+ }
+ else if (pptr() < buffer->gap_start()) {
+ // Current pos is left of gap.
+ setp(pptr(), buffer->gap_start());
+ goto retry;
+ }
+ else if (pptr() == buffer->gap_start()) {
+ // Current pos is at start of gap; move to end of gap.
+// disconnect_gap_from_file(buffer);
+ setp(buffer->gap_end(), str_end);
+// __offset += __bufp - __buffer;
+ }
+ else {
+ // Otherwise, current pos is right of gap.
+ setp(pptr(), str_end);
+ }
+ goto retry;
+}
+
+void edit_streambuf::set_current(char *new_pos, int reading)
+{
+ if (reading) {
+ setg(new_pos, new_pos, new_pos);
+ setp(NULL, NULL);
+ }
+ else {
+ setg(NULL, NULL, NULL);
+ setp(new_pos, new_pos);
+ }
+}
+
+// Called by fseek(fp, pos, whence) if fp is bound to a edit_buffer.
+
+streampos edit_streambuf::seekoff(streamoff offset, _seek_dir dir,
+ int /* =ios::in|ios::out*/)
+{
+ struct edit_buffer *buffer = str->buffer;
+ disconnect_gap_from_file(buffer);
+ buf_index cur_pos = buffer->tell((buf_char*)current());;
+ buf_index start_pos = buffer->tell(str->start);
+ buf_index end_pos = buffer->tell(str->end);
+ switch (dir) {
+ case ios::beg:
+ offset += start_pos;
+ break;
+ case ios::cur:
+ offset += cur_pos;
+ break;
+ case ios::end:
+ offset += end_pos;
+ break;
+ }
+ if (offset < start_pos || offset > end_pos)
+ return EOF;
+ buf_char *new_pos = buffer->data + offset;
+ buf_char* gap_start = buffer->gap_start();
+ if (new_pos > gap_start) {
+ buf_char* gap_end = buffer->gap_end();
+ new_pos += gap_end - gap_start;
+ if (new_pos >= buffer->data + buffer->buf_size) abort(); // Paranoia.
+ }
+ set_current(new_pos, is_reading());
+ return EOF;
+}
+
+#if 0
+int buf_seek(void *arg_cookie, fpos_t * pos, int whence)
+{
+ struct buf_cookie *cookie = arg_cookie;
+ FILE *file = cookie->file;
+ struct edit_buffer *buffer = cookie->str->buffer;
+ buf_char *str_start = cookie->str->start->ptr(buffer);
+ disconnect_gap_from_file(buffer, cookie->file);
+ fpos_t cur_pos, new_pos;
+ if (file->__bufp <= *buffer->gap_start_ptr
+ || str_start >= buffer->__gap_end)
+ cur_pos = str_start - file->__bufp;
+ else
+ cur_pos =
+ (*buffer->gap_start_ptr - str_start) + (file->__bufp - __gap_end);
+ end_pos = ...;
+ switch (whence) {
+ case SEEK_SET:
+ new_pos = *pos;
+ break;
+ case SEEK_CUR:
+ new_pos = cur_pos + *pos;
+ break;
+ case SEEK_END:
+ new_pos = end_pos + *pos;
+ break;
+ }
+ if (new_pos > end_pos) {
+ seek to end_pos;
+ insert_nulls(new_pos - end_pos);
+ return;
+ }
+ if (str_start + new_pos <= *gap_start_ptr &* *gap_start_ptr < end) {
+ __buffer = str_start;
+ __off = 0;
+ __bufp = str_start + new_pos;
+ file->__get_limit =
+ *buffer->gap_start_ptr; /* what if gap_start_ptr == &bufp ??? */
+ } else if () {
+
+ }
+ *pos = new_pos;
+}
+#endif
+
+/* Delete characters from `from' up to (but not incl) `to' */
+
+void edit_buffer::delete_range (buf_index from, buf_index to)
+{
+ register int numdel;
+
+ if ((numdel = to - from) <= 0)
+ return;
+
+ /* Make sure the gap is somewhere in or next to what we are deleting */
+ if (from > size1())
+ gap_right (from);
+ if (to < size1())
+ gap_left (to);
+
+ /* Relocate all markers pointing into the new, larger gap
+ to point at the end of the text before the gap. */
+ adjust_markers ((to + gap_size()) << 1, (to + gap_size()) << 1,
+ - numdel - gap_size(), data);
+
+ __gap_end_pos = to + gap_size();
+ _gap_start = data + from;
+}
+
+void edit_buffer::delete_range(struct edit_mark *start, struct edit_mark *end)
+{
+ delete_range(tell(start), tell(end));
+}
+
+void buf_delete_chars(struct edit_buffer *, struct edit_mark *, size_t)
+{
+ abort();
+}
+
+edit_streambuf::edit_streambuf(edit_string* bstr, int mode)
+{
+ _mode = mode;
+ str = bstr;
+ edit_buffer* buffer = bstr->buffer;
+ next = buffer->files;
+ buffer->files = this;
+ char* buf_ptr = bstr->start->ptr(buffer);
+ _inserting = 0;
+// setb(buf_ptr, buf_ptr, 0);
+ set_current(buf_ptr, !(mode & ios::out+ios::trunc+ios::app));
+ if (_mode & ios::trunc)
+ truncate();
+ if (_mode & ios::ate)
+ seekoff(0, ios::end);
+}
+
+// Called by fclose(fp) if fp is bound to a edit_buffer.
+
+#if 0
+static int buf_close(void *arg)
+{
+ register struct buf_cookie *cookie = arg;
+ struct edit_buffer *buffer = cookie->str->buffer;
+ struct buf_cookie **ptr;
+ for (ptr = &buffer->files; *ptr != cookie; ptr = &(*ptr)->next) ;
+ *ptr = cookie->next;
+ disconnect_gap_from_file(buffer, cookie->file);
+ free (cookie);
+ return 0;
+}
+#endif
+
+edit_streambuf::~edit_streambuf()
+{
+ if (_mode == ios::out)
+ truncate();
+ // Unlink this from list of files associated with bstr->buffer.
+ edit_streambuf **ptr = &str->buffer->files;
+ for (; *ptr != this; ptr = &(*ptr)->next) { }
+ *ptr = next;
+
+ disconnect_gap_from_file(str->buffer);
+}
+
+edit_buffer::edit_buffer()
+{
+ buf_size = /*200;*/ 15; /* for testing! */
+ data = (buf_char*)malloc(buf_size);
+ files = NULL;
+#ifndef OLD_STDIO
+ _gap_start = data;
+ _writer = NULL;
+#else
+ gap_start_normal = data;
+ gap_start_ptr = &gap_start_normal;
+#endif
+ __gap_end_pos = buf_size;
+ start_mark.chain = &end_mark;
+ start_mark._pos = 0;
+ end_mark.chain = NULL;
+ end_mark._pos = 2 * buf_size + 1;
+}
+
+// Allocate a new mark, which is adjusted by 'delta' bytes from 'this'.
+// Restrict new mark to lie within 'str'.
+
+edit_mark::edit_mark(struct edit_string *str, long delta)
+{
+ struct edit_buffer *buf = str->buffer;
+ chain = buf->start_mark.chain;
+ buf->start_mark.chain = this;
+ mark_pointer size1 = buf->size1() << 1;
+ int gap_size = buf->gap_size() << 1;
+ delta <<= 1;
+
+ // check if new and old marks are opposite sides of gap
+ if (_pos <= size1 && _pos + delta > size1)
+ delta += gap_size;
+ else if (_pos >= size1 + gap_size && _pos + delta < size1 + gap_size)
+ delta -= gap_size;
+
+ _pos = _pos + delta;
+ if (_pos < str->start->_pos & ~1)
+ _pos = (str->start->_pos & ~ 1) + (_pos & 1);
+ else if (_pos >= str->end->_pos)
+ _pos = (str->end->_pos & ~ 1) + (_pos & 1);
+}
+
+// A (slow) way to find the buffer a mark belongs to.
+
+edit_buffer * edit_mark::buffer()
+{
+ struct edit_mark *mark;
+ for (mark = this; mark->chain != NULL; mark = mark->chain) ;
+ // Assume that the last mark on the chain is the end_mark.
+ return (edit_buffer *)((char*)mark - offsetof(edit_buffer, end_mark));
+}
+
+edit_mark::~edit_mark()
+{
+ // Must unlink mark from chain of owning buffer
+ struct edit_buffer *buf = buffer();
+ if (this == &buf->start_mark || this == &buf->end_mark) abort();
+ edit_mark **ptr;
+ for (ptr = &buf->start_mark.chain; *ptr != this; ptr = &(*ptr)->chain) ;
+ *ptr = this->chain;
+}
+
+int edit_string::length() const
+{
+ ptrdiff_t delta = end->ptr(buffer) - start->ptr(buffer);
+ if (end->ptr(buffer) <= buffer->gap_start() ||
+ start->ptr(buffer) >= buffer->gap_end())
+ return delta;
+ return delta - buffer->gap_size();
+}
+
+buf_char * edit_string::copy_bytes(int *lenp) const
+{
+ char *new_str;
+ int len1, len2;
+ buf_char *start1, *start2;
+ start1 = start->ptr(buffer);
+ if (end->ptr(buffer) <= buffer->gap_start()
+ || start->ptr(buffer) >= buffer->gap_end()) {
+ len1 = end->ptr(buffer) - start1;
+ len2 = 0;
+ start2 = NULL; // To avoid a warning from g++.
+ }
+ else {
+ len1 = buffer->gap_start() - start1;
+ start2 = buffer->gap_end();
+ len2 = end->ptr(buffer) - start2;
+ }
+ new_str = (char*)malloc(len1 + len2 + 1);
+ memcpy(new_str, start1, len1);
+ if (len2 > 0) memcpy(new_str + len1, start2, len2);
+ new_str[len1+len2] = '\0';
+ *lenp = len1+len2;
+ return new_str;
+}
+
+// Replace the buf_chars in 'this' with ones from 'src'.
+// Equivalent to deleting this, then inserting src, except tries
+// to leave marks in place: Marks whose offset from the start
+// of 'this' is less than 'src->length()' will still have the
+// same offset in 'this' when done.
+
+void edit_string::assign(struct edit_string *src)
+{
+ edit_streambuf dst_file(this, ios::out);
+ if (buffer == src->buffer /*&& ???*/) { /* overly conservative */
+ int src_len;
+ buf_char *new_str;
+ new_str = src->copy_bytes(&src_len);
+ dst_file.sputn(new_str, src_len);
+ free (new_str);
+ } else {
+ edit_streambuf src_file(src, ios::in);
+ for ( ; ; ) {
+ int ch = src_file.sbumpc();
+ if (ch == EOF) break;
+ dst_file.sputc(ch);
+ }
+ }
+}
diff --git a/libio/editbuf.h b/libio/editbuf.h
new file mode 100644
index 00000000000..d15758f257e
--- /dev/null
+++ b/libio/editbuf.h
@@ -0,0 +1,185 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+
+Written by Per Bothner (bothner@cygnus.com). */
+
+#ifndef _EDITBUF_H
+#define _EDITBUF_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+#include <stdio.h>
+#include <fstream.h>
+
+extern "C++" {
+typedef unsigned long mark_pointer;
+// At some point, it might be nice to parameterize this code
+// in terms of buf_char.
+typedef /*unsigned*/ char buf_char;
+
+// Logical pos from start of buffer (does not count gap).
+typedef long buf_index;
+
+// Pos from start of buffer, possibly including gap_size.
+typedef long buf_offset;
+
+#if 0
+struct buf_cookie {
+ FILE *file;
+ struct edit_string *str;
+ struct buf_cookie *next;
+ buf_index tell();
+};
+#endif
+
+struct edit_buffer;
+struct edit_mark;
+
+// A edit_string is defined as the region between the 'start' and 'end' marks.
+// Normally (always?) 'start->insert_before()' should be false,
+// and 'end->insert_before()' should be true.
+
+struct edit_string {
+ struct edit_buffer *buffer; // buffer that 'start' and 'end' belong to
+ struct edit_mark *start, *end;
+ int length() const; // count of buf_chars currently in string
+ edit_string(struct edit_buffer *b,
+ struct edit_mark *ms, struct edit_mark *me)
+ { buffer = b; start = ms; end = me; }
+/* Make a fresh, contiguous copy of the data in STR.
+ Assign length of STR to *LENP.
+ (Output has extra NUL at out[*LENP].) */
+ buf_char *copy_bytes(int *lenp) const;
+// FILE *open_file(char *mode);
+ void assign(struct edit_string *src); // copy bytes from src to this
+};
+
+struct edit_streambuf : public streambuf {
+ friend edit_buffer;
+ edit_string *str;
+ edit_streambuf* next; // Chain of edit_streambuf's for a edit_buffer.
+ short _mode;
+ edit_streambuf(edit_string* bstr, int mode);
+ ~edit_streambuf();
+ virtual int underflow();
+ virtual int overflow(int c = EOF);
+ virtual streampos seekoff(streamoff, _seek_dir, int mode=ios::in|ios::out);
+ void flush_to_buffer();
+ void flush_to_buffer(edit_buffer* buffer);
+ int _inserting;
+ int inserting() { return _inserting; }
+ void inserting(int i) { _inserting = i; }
+// int delete_chars(int count, char* cut_buf); Not implemented.
+ int truncate();
+ int is_reading() { return gptr() != NULL; }
+ buf_char* current() { return is_reading() ? gptr() : pptr(); }
+ void set_current(char *p, int is_reading);
+ protected:
+ void disconnect_gap_from_file(edit_buffer* buffer);
+};
+
+// A 'edit_mark' indicates a position in a buffer.
+// It is "attached" the text (rather than the offset).
+// There are two kinds of mark, which have different behavior
+// when text is inserted at the mark:
+// If 'insert_before()' is true the mark will be adjusted to be
+// *after* the new text.
+
+struct edit_mark {
+ struct edit_mark *chain;
+ mark_pointer _pos;
+ inline int insert_before() { return _pos & 1; }
+ inline unsigned long index_in_buffer(struct edit_buffer *)
+ { return _pos >> 1; }
+ inline buf_char *ptr(struct edit_buffer *buf);
+ buf_index tell();
+ edit_mark() { }
+ edit_mark(struct edit_string *str, long delta);
+ edit_buffer *buffer();
+ ~edit_mark();
+};
+
+// A 'edit_buffer' consists of a sequence of buf_chars (the data),
+// a list of edit_marks pointing into the data, and a list of FILEs
+// also pointing into the data.
+// A 'edit_buffer' coerced to a edit_string is the string of
+// all the buf_chars in the buffer.
+
+// This implementation uses a conventional buffer gap (as in Emacs).
+// The gap start is defined by de-referencing a (buf_char**).
+// This is because sometimes a FILE is inserting into the buffer,
+// so rather than having each putc adjust the gap, we use indirection
+// to have the gap be defined as the write pointer of the FILE.
+// (This assumes that putc adjusts a pointer (as in GNU's libc), not an index.)
+
+struct edit_buffer {
+ buf_char *data; /* == emacs buffer_text.p1+1 */
+ buf_char *_gap_start;
+ edit_streambuf* _writer; // If non-NULL, currently writing stream
+ inline buf_char *gap_start()
+ { return _writer ? _writer->pptr() : _gap_start; }
+ buf_offset __gap_end_pos; // size of part 1 + size of gap
+ /* int gap; implicit: buf_size - size1 - size2 */
+ int buf_size;
+ struct edit_streambuf *files;
+ struct edit_mark start_mark;
+ struct edit_mark end_mark;
+ edit_buffer();
+ inline buf_offset gap_end_pos() { return __gap_end_pos; }
+ inline struct edit_mark *start_marker() { return &start_mark; }
+ inline struct edit_mark *end_marker() { return &end_mark; }
+/* these should be protected, ultimately */
+ buf_index tell(edit_mark*);
+ buf_index tell(buf_char*);
+ inline buf_char *gap_end() { return data + gap_end_pos(); }
+ inline int gap_size() { return gap_end() - gap_start(); }
+ inline int size1() { return gap_start() - data; }
+ inline int size2() { return buf_size - gap_end_pos(); }
+ inline struct edit_mark * mark_list() { return &start_mark; }
+ void make_gap (buf_offset);
+ void move_gap (buf_offset pos);
+ void move_gap (buf_char *pos) { move_gap(pos - data); }
+ void gap_left (int pos);
+ void gap_right (int pos);
+ void adjust_markers(mark_pointer low, mark_pointer high,
+ int amount, buf_char *old_data);
+ void delete_range(buf_index from, buf_index to);
+ void delete_range(struct edit_mark *start, struct edit_mark *end);
+};
+
+extern buf_char * bstr_copy(struct edit_string *str, int *lenp);
+
+// Convert a edit_mark to a (buf_char*)
+
+inline buf_char *edit_mark::ptr(struct edit_buffer *buf)
+ { return buf->data + index_in_buffer(buf); }
+
+inline void edit_streambuf::flush_to_buffer()
+{
+ edit_buffer* buffer = str->buffer;
+ if (buffer->_writer == this) flush_to_buffer(buffer);
+}
+} // extern "C++"
+#endif /* !_EDITBUF_H*/
+
diff --git a/libio/filebuf.cc b/libio/filebuf.cc
new file mode 100644
index 00000000000..1e2682fbce9
--- /dev/null
+++ b/libio/filebuf.cc
@@ -0,0 +1,206 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993, 1995 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+
+Written by Per Bothner (bothner@cygnus.com). */
+
+#include "iostreamP.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <errno.h>
+#include "builtinbuf.h"
+
+void filebuf::init()
+{
+ _IO_file_init(this);
+}
+
+filebuf::filebuf()
+{
+ _IO_file_init(this);
+}
+
+#if !_IO_UNIFIED_JUMPTABLES
+/* This is like "new filebuf()", but it uses the _IO_file_jump jumptable,
+ for eficiency. */
+
+filebuf* filebuf::__new()
+{
+ filebuf *fb = new filebuf;
+ _IO_JUMPS(fb) = &_IO_file_jumps;
+ fb->_vtable() = builtinbuf_vtable;
+ return fb;
+}
+#endif
+
+filebuf::filebuf(int fd)
+{
+ _IO_file_init(this);
+ _IO_file_attach(this, fd);
+}
+
+filebuf::filebuf(int fd, char* p, int len)
+{
+ _IO_file_init(this);
+ _IO_file_attach(this, fd);
+ setbuf(p, len);
+}
+
+filebuf::~filebuf()
+{
+ if (_IO_file_is_open(this))
+ {
+ _IO_do_flush (this);
+ if (!(xflags() & _IO_DELETE_DONT_CLOSE))
+ _IO_SYSCLOSE (this);
+ }
+}
+
+filebuf* filebuf::open(const char *filename, ios::openmode mode, int prot)
+{
+ if (_IO_file_is_open (this))
+ return NULL;
+ int posix_mode;
+ int read_write;
+ if (mode & ios::app)
+ mode |= ios::out;
+ if ((mode & (ios::in|ios::out)) == (ios::in|ios::out)) {
+ posix_mode = O_RDWR;
+ read_write = 0;
+ }
+ else if (mode & ios::out)
+ posix_mode = O_WRONLY, read_write = _IO_NO_READS;
+ else if (mode & (int)ios::in)
+ posix_mode = O_RDONLY, read_write = _IO_NO_WRITES;
+ else
+ posix_mode = 0, read_write = _IO_NO_READS+_IO_NO_WRITES;
+ if (mode & ios::binary)
+ {
+ mode &= ~ios::binary;
+#ifdef O_BINARY
+ /* This is a (mis-)feature of DOS/Windows C libraries. */
+ posix_mode |= O_BINARY;
+#endif
+ }
+ if ((mode & (int)ios::trunc) || mode == (int)ios::out)
+ posix_mode |= O_TRUNC;
+ if (mode & ios::app)
+ posix_mode |= O_APPEND, read_write |= _IO_IS_APPENDING;
+ if (!(mode & (int)ios::nocreate) && mode != ios::in)
+ posix_mode |= O_CREAT;
+ if (mode & (int)ios::noreplace)
+ posix_mode |= O_EXCL;
+ int fd = ::open(filename, posix_mode, prot);
+ if (fd < 0)
+ return NULL;
+ _fileno = fd;
+ xsetflags(read_write, _IO_NO_READS+_IO_NO_WRITES+_IO_IS_APPENDING);
+ if (mode & (ios::ate|ios::app)) {
+ if (pubseekoff(0, ios::end) == EOF)
+ return NULL;
+ }
+ _IO_link_in(this);
+ return this;
+}
+
+filebuf* filebuf::open(const char *filename, const char *mode)
+{
+ return (filebuf*)_IO_file_fopen(this, filename, mode);
+}
+
+filebuf* filebuf::attach(int fd)
+{
+ return (filebuf*)_IO_file_attach(this, fd);
+}
+
+streambuf* filebuf::setbuf(char* p, int len)
+{
+ return (streambuf*)_IO_file_setbuf (this, p, len);
+}
+
+int filebuf::doallocate() { return _IO_file_doallocate(this); }
+
+int filebuf::overflow(int c)
+{
+ return _IO_file_overflow(this, c);
+}
+
+int filebuf::underflow()
+{
+ return _IO_file_underflow(this);
+}
+
+int filebuf::sync()
+{
+ return _IO_file_sync(this);
+}
+
+streampos filebuf::seekoff(streamoff offset, _seek_dir dir, int mode)
+{
+ return _IO_file_seekoff (this, offset, dir, mode);
+}
+
+filebuf* filebuf::close()
+{
+ return (_IO_file_close_it(this) ? (filebuf*)NULL : this);
+}
+
+streamsize filebuf::sys_read(char* buf, streamsize size)
+{
+ return _IO_file_read(this, buf, size);
+}
+
+streampos filebuf::sys_seek(streamoff offset, _seek_dir dir)
+{
+ return _IO_file_seek(this, offset, dir);
+}
+
+streamsize filebuf::sys_write(const char *buf, streamsize n)
+{
+ return _IO_file_write (this, buf, n);
+}
+
+int filebuf::sys_stat(void* st)
+{
+ return _IO_file_stat (this, st);
+}
+
+int filebuf::sys_close()
+{
+ return _IO_file_close (this);
+}
+
+streamsize filebuf::xsputn(const char *s, streamsize n)
+{
+ return _IO_file_xsputn(this, s, n);
+}
+
+streamsize filebuf::xsgetn(char *s, streamsize n)
+{
+ // FIXME: OPTIMIZE THIS (specifically, when unbuffered()).
+ return streambuf::xsgetn(s, n);
+}
+
+// Non-ANSI AT&T-ism: Default open protection.
+const int filebuf::openprot = 0644;
diff --git a/libio/filedoalloc.c b/libio/filedoalloc.c
new file mode 100644
index 00000000000..f838bb3458f
--- /dev/null
+++ b/libio/filedoalloc.c
@@ -0,0 +1,102 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/*
+ * Copyright (c) 1990 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that the above copyright notice and this paragraph are
+ * duplicated in all such forms and that any documentation,
+ * advertising materials, and other materials related to such
+ * distribution and use acknowledge that the software was developed
+ * by the University of California, Berkeley. The name of the
+ * University may not be used to endorse or promote products derived
+ * from this software without specific prior written permission.
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ */
+
+/* Modified for GNU iostream by Per Bothner 1991, 1992. */
+
+#define _POSIX_SOURCE
+#include "libioP.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+#ifdef __STDC__
+#include <stdlib.h>
+#include <unistd.h>
+#endif
+
+/*
+ * Allocate a file buffer, or switch to unbuffered I/O.
+ * Per the ANSI C standard, ALL tty devices default to line buffered.
+ *
+ * As a side effect, we set __SOPT or __SNPT (en/dis-able fseek
+ * optimisation) right after the _fstat() that finds the buffer size.
+ */
+
+int
+DEFUN(_IO_file_doallocate, (fp),
+ register _IO_FILE *fp)
+{
+ register _IO_size_t size;
+ int couldbetty;
+ register char *p;
+ struct stat st;
+
+ /* If _IO_cleanup_registration_needed is non-zero, we should call the
+ function it points to. This is to make sure _IO_cleanup gets called
+ on exit. We call it from _IO_file_doallocate, since that is likely
+ to get called by any program that does buffered I/O. */
+ if (_IO_cleanup_registration_needed)
+ (*_IO_cleanup_registration_needed)();
+
+ if (fp->_fileno < 0 || _IO_SYSSTAT (fp, &st) < 0)
+ {
+ couldbetty = 0;
+ size = _IO_BUFSIZ;
+#if 0
+ /* do not try to optimise fseek() */
+ fp->_flags |= __SNPT;
+#endif
+ }
+ else
+ {
+ couldbetty = S_ISCHR(st.st_mode);
+#if _IO_HAVE_ST_BLKSIZE
+ size = st.st_blksize <= 0 ? _IO_BUFSIZ : st.st_blksize;
+#else
+ size = _IO_BUFSIZ;
+#endif
+ }
+ p = ALLOC_BUF(size);
+ if (p == NULL)
+ return EOF;
+ _IO_setb(fp, p, p+size, 1);
+ if (couldbetty && isatty(fp->_fileno))
+ fp->_flags |= _IO_LINE_BUF;
+ return 1;
+}
diff --git a/libio/fileops.c b/libio/fileops.c
new file mode 100644
index 00000000000..812af94d0f9
--- /dev/null
+++ b/libio/fileops.c
@@ -0,0 +1,755 @@
+/*
+Copyright (C) 1993, 1995 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* written by Per Bothner (bothner@cygnus.com) */
+
+#define _POSIX_SOURCE
+#include "libioP.h"
+#include <fcntl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <string.h>
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+
+/* An fstream can be in at most one of put mode, get mode, or putback mode.
+ Putback mode is a variant of get mode.
+
+ In a filebuf, there is only one current position, instead of two
+ separate get and put pointers. In get mode, the current posistion
+ is that of gptr(); in put mode that of pptr().
+
+ The position in the buffer that corresponds to the position
+ in external file system is normally _IO_read_end, except in putback
+ mode, when it is _IO_save_end.
+ If the field _fb._offset is >= 0, it gives the offset in
+ the file as a whole corresponding to eGptr(). (?)
+
+ PUT MODE:
+ If a filebuf is in put mode, then all of _IO_read_ptr, _IO_read_end,
+ and _IO_read_base are equal to each other. These are usually equal
+ to _IO_buf_base, though not necessarily if we have switched from
+ get mode to put mode. (The reason is to maintain the invariant
+ that _IO_read_end corresponds to the external file position.)
+ _IO_write_base is non-NULL and usually equal to _IO_base_base.
+ We also have _IO_write_end == _IO_buf_end, but only in fully buffered mode.
+ The un-flushed character are those between _IO_write_base and _IO_write_ptr.
+
+ GET MODE:
+ If a filebuf is in get or putback mode, eback() != egptr().
+ In get mode, the unread characters are between gptr() and egptr().
+ The OS file position corresponds to that of egptr().
+
+ PUTBACK MODE:
+ Putback mode is used to remember "excess" characters that have
+ been sputbackc'd in a separate putback buffer.
+ In putback mode, the get buffer points to the special putback buffer.
+ The unread characters are the characters between gptr() and egptr()
+ in the putback buffer, as well as the area between save_gptr()
+ and save_egptr(), which point into the original reserve buffer.
+ (The pointers save_gptr() and save_egptr() are the values
+ of gptr() and egptr() at the time putback mode was entered.)
+ The OS position corresponds to that of save_egptr().
+
+ LINE BUFFERED OUTPUT:
+ During line buffered output, _IO_write_base==base() && epptr()==base().
+ However, ptr() may be anywhere between base() and ebuf().
+ This forces a call to filebuf::overflow(int C) on every put.
+ If there is more space in the buffer, and C is not a '\n',
+ then C is inserted, and pptr() incremented.
+
+ UNBUFFERED STREAMS:
+ If a filebuf is unbuffered(), the _shortbuf[1] is used as the buffer.
+*/
+
+#define CLOSED_FILEBUF_FLAGS \
+ (_IO_IS_FILEBUF+_IO_NO_READS+_IO_NO_WRITES+_IO_TIED_PUT_GET)
+
+
+void
+DEFUN(_IO_file_init, (fp),
+ register _IO_FILE *fp)
+{
+ /* POSIX.1 allows another file handle to be used to change the position
+ of our file descriptor. Hence we actually don't know the actual
+ position before we do the first fseek (and until a following fflush). */
+ fp->_offset = _IO_pos_BAD;
+ fp->_IO_file_flags |= CLOSED_FILEBUF_FLAGS;
+
+ _IO_link_in(fp);
+ fp->_fileno = -1;
+}
+
+int
+DEFUN(_IO_file_close_it, (fp),
+ register _IO_FILE* fp)
+{
+ int write_status, close_status;
+ if (!_IO_file_is_open(fp))
+ return EOF;
+
+ write_status = _IO_do_flush (fp);
+
+ _IO_unsave_markers(fp);
+
+ close_status = _IO_SYSCLOSE (fp);
+
+ /* Free buffer. */
+ _IO_setb(fp, NULL, NULL, 0);
+ _IO_setg(fp, NULL, NULL, NULL);
+ _IO_setp(fp, NULL, NULL);
+
+ _IO_un_link(fp);
+ fp->_flags = _IO_MAGIC|CLOSED_FILEBUF_FLAGS;
+ fp->_fileno = EOF;
+ fp->_offset = _IO_pos_BAD;
+
+ return close_status ? close_status : write_status;
+}
+
+void
+DEFUN(_IO_file_finish, (fp),
+ register _IO_FILE* fp)
+{
+ if (_IO_file_is_open(fp))
+ {
+ _IO_do_flush (fp);
+ if (!(fp->_flags & _IO_DELETE_DONT_CLOSE))
+ _IO_SYSCLOSE (fp);
+ }
+ _IO_default_finish(fp);
+}
+
+_IO_FILE *
+DEFUN(_IO_file_fopen, (fp, filename, mode),
+ register _IO_FILE *fp AND const char *filename AND const char *mode)
+{
+ int oflags = 0, omode;
+ int read_write, fdesc;
+ int oprot = 0666;
+ if (_IO_file_is_open (fp))
+ return 0;
+ switch (*mode++) {
+ case 'r':
+ omode = O_RDONLY;
+ read_write = _IO_NO_WRITES;
+ break;
+ case 'w':
+ omode = O_WRONLY;
+ oflags = O_CREAT|O_TRUNC;
+ read_write = _IO_NO_READS;
+ break;
+ case 'a':
+ omode = O_WRONLY;
+ oflags = O_CREAT|O_APPEND;
+ read_write = _IO_NO_READS|_IO_IS_APPENDING;
+ break;
+ default:
+ errno = EINVAL;
+ return NULL;
+ }
+ if (mode[0] == '+' || (mode[0] == 'b' && mode[1] == '+')) {
+ omode = O_RDWR;
+ read_write &= _IO_IS_APPENDING;
+ }
+ fdesc = open(filename, omode|oflags, oprot);
+ if (fdesc < 0)
+ return NULL;
+ fp->_fileno = fdesc;
+ _IO_mask_flags(fp, read_write,_IO_NO_READS+_IO_NO_WRITES+_IO_IS_APPENDING);
+ if (read_write & _IO_IS_APPENDING)
+ if (_IO_SEEKOFF (fp, (_IO_off_t)0, _IO_seek_end, _IOS_INPUT|_IOS_OUTPUT)
+ == _IO_pos_BAD)
+ return NULL;
+ _IO_link_in(fp);
+ return fp;
+}
+
+_IO_FILE*
+DEFUN(_IO_file_attach, (fp, fd),
+ _IO_FILE *fp AND int fd)
+{
+ if (_IO_file_is_open(fp))
+ return NULL;
+ fp->_fileno = fd;
+ fp->_flags &= ~(_IO_NO_READS+_IO_NO_WRITES);
+ fp->_flags |= _IO_DELETE_DONT_CLOSE;
+ fp->_offset = _IO_pos_BAD;
+ return fp;
+}
+
+_IO_FILE*
+DEFUN(_IO_file_setbuf, (fp, p, len),
+ register _IO_FILE *fp AND char* p AND _IO_ssize_t len)
+{
+ if (_IO_default_setbuf(fp, p, len) == NULL)
+ return NULL;
+
+ fp->_IO_write_base = fp->_IO_write_ptr = fp->_IO_write_end
+ = fp->_IO_buf_base;
+ _IO_setg(fp, fp->_IO_buf_base, fp->_IO_buf_base, fp->_IO_buf_base);
+
+ return fp;
+}
+
+/* Write TO_DO bytes from DATA to FP.
+ Then mark FP as having empty buffers. */
+
+int
+DEFUN(_IO_do_write, (fp, data, to_do),
+ register _IO_FILE *fp AND const char* data AND _IO_size_t to_do)
+{
+ _IO_size_t count;
+ if (to_do == 0)
+ return 0;
+ else
+ {
+ if (fp->_flags & _IO_IS_APPENDING)
+ /* On a system without a proper O_APPEND implementation,
+ you would need to sys_seek(0, SEEK_END) here, but is
+ is not needed nor desirable for Unix- or Posix-like systems.
+ Instead, just indicate that offset (before and after) is
+ unpredictable. */
+ fp->_offset = _IO_pos_BAD;
+ else if (fp->_IO_read_end != fp->_IO_write_base)
+ {
+ _IO_pos_t new_pos
+ = _IO_SYSSEEK(fp, fp->_IO_write_base - fp->_IO_read_end, 1);
+ if (new_pos == _IO_pos_BAD)
+ return EOF;
+ fp->_offset = new_pos;
+ }
+ count = _IO_SYSWRITE (fp, data, to_do);
+ if (fp->_cur_column)
+ fp->_cur_column
+ = _IO_adjust_column (fp->_cur_column - 1, data, to_do) + 1;
+ }
+ _IO_setg(fp, fp->_IO_buf_base, fp->_IO_buf_base, fp->_IO_buf_base);
+ fp->_IO_write_base = fp->_IO_write_ptr = fp->_IO_buf_base;
+ fp->_IO_write_end = (fp->_flags & (_IO_LINE_BUF+_IO_UNBUFFERED)) ? fp->_IO_buf_base
+ : fp->_IO_buf_end;
+ return count != to_do ? EOF : 0;
+}
+
+int
+DEFUN(_IO_file_underflow, (fp),
+ register _IO_FILE *fp)
+{
+ _IO_ssize_t count;
+#if 0
+ /* SysV does not make this test; take it out for compatibility */
+ if (fp->_flags & _IO_EOF_SEEN)
+ return (EOF);
+#endif
+
+ if (fp->_flags & _IO_NO_READS)
+ return EOF;
+ if (fp->_IO_read_ptr < fp->_IO_read_end)
+ return *(unsigned char*)fp->_IO_read_ptr;
+
+ if (fp->_IO_buf_base == NULL)
+ _IO_doallocbuf(fp);
+
+ /* Flush all line buffered files before reading. */
+ /* FIXME This can/should be moved to genops ?? */
+ if (fp->_flags & (_IO_LINE_BUF|_IO_UNBUFFERED))
+ _IO_flush_all_linebuffered();
+
+ _IO_switch_to_get_mode(fp);
+
+ count = _IO_SYSREAD (fp, fp->_IO_buf_base,
+ fp->_IO_buf_end - fp->_IO_buf_base);
+ if (count <= 0)
+ {
+ if (count == 0)
+ fp->_flags |= _IO_EOF_SEEN;
+ else
+ fp->_flags |= _IO_ERR_SEEN, count = 0;
+ }
+ fp->_IO_read_base = fp->_IO_read_ptr = fp->_IO_buf_base;
+ fp->_IO_read_end = fp->_IO_buf_base + count;
+ fp->_IO_write_base = fp->_IO_write_ptr = fp->_IO_write_end
+ = fp->_IO_buf_base;
+ if (count == 0)
+ return EOF;
+ if (fp->_offset != _IO_pos_BAD)
+ _IO_pos_adjust(fp->_offset, count);
+ return *(unsigned char*)fp->_IO_read_ptr;
+}
+
+int
+DEFUN(_IO_file_overflow, (f, ch),
+ register _IO_FILE* f AND int ch)
+{
+ if (f->_flags & _IO_NO_WRITES) /* SET ERROR */
+ return EOF;
+ /* If currently reading or no buffer allocated. */
+ if ((f->_flags & _IO_CURRENTLY_PUTTING) == 0)
+ {
+ /* Allocate a buffer if needed. */
+ if (f->_IO_write_base == 0)
+ {
+ _IO_doallocbuf(f);
+ _IO_setg (f, f->_IO_buf_base, f->_IO_buf_base, f->_IO_buf_base);
+ }
+ /* Otherwise must be currently reading.
+ If _IO_read_ptr (and hence also _IO_read_end) is at the buffer end,
+ logically slide the buffer forwards one block (by setting the
+ read pointers to all point at the beginning of the block). This
+ makes room for subsequent output.
+ Otherwise, set the read pointers to _IO_read_end (leaving that
+ alone, so it can continue to correspond to the external position). */
+ if (f->_IO_read_ptr == f->_IO_buf_end)
+ f->_IO_read_end = f->_IO_read_ptr = f->_IO_buf_base;
+ f->_IO_write_ptr = f->_IO_read_ptr;
+ f->_IO_write_base = f->_IO_write_ptr;
+ f->_IO_write_end = f->_IO_buf_end;
+ f->_IO_read_base = f->_IO_read_ptr = f->_IO_read_end;
+
+ if (f->_flags & (_IO_LINE_BUF+_IO_UNBUFFERED))
+ f->_IO_write_end = f->_IO_write_ptr;
+ f->_flags |= _IO_CURRENTLY_PUTTING;
+ }
+ if (ch == EOF)
+ return _IO_do_flush(f);
+ if (f->_IO_write_ptr == f->_IO_buf_end ) /* Buffer is really full */
+ if (_IO_do_flush(f) == EOF)
+ return EOF;
+ *f->_IO_write_ptr++ = ch;
+ if ((f->_flags & _IO_UNBUFFERED)
+ || ((f->_flags & _IO_LINE_BUF) && ch == '\n'))
+ if (_IO_do_flush(f) == EOF)
+ return EOF;
+ return (unsigned char)ch;
+}
+
+int
+DEFUN(_IO_file_sync, (fp),
+ register _IO_FILE* fp)
+{
+ _IO_size_t delta;
+ /* char* ptr = cur_ptr(); */
+ if (fp->_IO_write_ptr > fp->_IO_write_base)
+ if (_IO_do_flush(fp)) return EOF;
+ delta = fp->_IO_read_ptr - fp->_IO_read_end;
+ if (delta != 0)
+ {
+#ifdef TODO
+ if (_IO_in_backup(fp))
+ delta -= eGptr() - Gbase();
+#endif
+ _IO_off_t new_pos = _IO_SYSSEEK (fp, delta, 1);
+ if (new_pos != (_IO_off_t)EOF)
+ fp->_IO_read_end = fp->_IO_read_ptr;
+#ifdef ESPIPE
+ else if (errno == ESPIPE)
+ ; /* Ignore error from unseekable devices. */
+#endif
+ else
+ return EOF;
+ }
+ fp->_offset = _IO_pos_BAD;
+ /* FIXME: Cleanup - can this be shared? */
+ /* setg(base(), ptr, ptr); */
+ return 0;
+}
+
+_IO_pos_t
+DEFUN(_IO_file_seekoff, (fp, offset, dir, mode),
+ register _IO_FILE *fp AND _IO_off_t offset AND int dir AND int mode)
+{
+ _IO_pos_t result;
+ _IO_off_t delta, new_offset;
+ long count;
+
+ if (mode == 0)
+ dir = _IO_seek_cur, offset = 0; /* Don't move any pointers. */
+
+ /* Flush unwritten characters.
+ (This may do an unneeded write if we seek within the buffer.
+ But to be able to switch to reading, we would need to set
+ egptr to ptr. That can't be done in the current design,
+ which assumes file_ptr() is eGptr. Anyway, since we probably
+ end up flushing when we close(), it doesn't make much difference.)
+ FIXME: simulate mem-papped files. */
+
+ if (fp->_IO_write_ptr > fp->_IO_write_base || _IO_in_put_mode(fp))
+ if (_IO_switch_to_get_mode(fp)) return EOF;
+
+ if (fp->_IO_buf_base == NULL)
+ {
+ _IO_doallocbuf(fp);
+ _IO_setp(fp, fp->_IO_buf_base, fp->_IO_buf_base);
+ _IO_setg(fp, fp->_IO_buf_base, fp->_IO_buf_base, fp->_IO_buf_base);
+ }
+
+ switch (dir)
+ {
+ case _IO_seek_cur:
+ /* Adjust for read-ahead (bytes is buffer). */
+ offset -= fp->_IO_read_end - fp->_IO_read_ptr;
+ if (fp->_offset == _IO_pos_BAD)
+ goto dumb;
+ /* Make offset absolute, assuming current pointer is file_ptr(). */
+ offset += _IO_pos_as_off(fp->_offset);
+
+ dir = _IO_seek_set;
+ break;
+ case _IO_seek_set:
+ break;
+ case _IO_seek_end:
+ {
+ struct stat st;
+ if (_IO_SYSSTAT (fp, &st) == 0 && S_ISREG(st.st_mode))
+ {
+ offset += st.st_size;
+ dir = _IO_seek_set;
+ }
+ else
+ goto dumb;
+ }
+ }
+ /* At this point, dir==_IO_seek_set. */
+
+ /* If destination is within current buffer, optimize: */
+ if (fp->_offset != _IO_pos_BAD && fp->_IO_read_base != NULL
+ && !_IO_in_backup (fp))
+ {
+ /* Offset relative to start of main get area. */
+ _IO_pos_t rel_offset = offset - fp->_offset
+ + (fp->_IO_read_end - fp->_IO_read_base);
+ if (rel_offset >= 0)
+ {
+#if 0
+ if (_IO_in_backup(fp))
+ _IO_switch_to_main_get_area(fp);
+#endif
+ if (rel_offset <= fp->_IO_read_end - fp->_IO_read_base)
+ {
+ _IO_setg(fp, fp->_IO_buf_base, fp->_IO_buf_base + rel_offset,
+ fp->_IO_read_end);
+ _IO_setp(fp, fp->_IO_buf_base, fp->_IO_buf_base);
+ return offset;
+ }
+#ifdef TODO
+ /* If we have streammarkers, seek forward by reading ahead. */
+ if (_IO_have_markers(fp))
+ {
+ int to_skip = rel_offset
+ - (fp->_IO_read_ptr - fp->_IO_read_base);
+ if (ignore(to_skip) != to_skip)
+ goto dumb;
+ return offset;
+ }
+#endif
+ }
+#ifdef TODO
+ if (rel_offset < 0 && rel_offset >= Bbase() - Bptr())
+ {
+ if (!_IO_in_backup(fp))
+ _IO_switch_to_backup_area(fp);
+ gbump(fp->_IO_read_end + rel_offset - fp->_IO_read_ptr);
+ return offset;
+ }
+#endif
+ }
+
+#ifdef TODO
+ _IO_unsave_markers(fp);
+#endif
+
+ if (fp->_flags & _IO_NO_READS)
+ goto dumb;
+
+ /* Try to seek to a block boundary, to improve kernel page management. */
+ new_offset = offset & ~(fp->_IO_buf_end - fp->_IO_buf_base - 1);
+ delta = offset - new_offset;
+ if (delta > fp->_IO_buf_end - fp->_IO_buf_base)
+ {
+ new_offset = offset;
+ delta = 0;
+ }
+ result = _IO_SYSSEEK (fp, new_offset, 0);
+ if (result < 0)
+ return EOF;
+ if (delta == 0)
+ count = 0;
+ else
+ {
+ count = _IO_SYSREAD (fp, fp->_IO_buf_base,
+ fp->_IO_buf_end - fp->_IO_buf_base);
+ if (count < delta)
+ {
+ /* We weren't allowed to read, but try to seek the remainder. */
+ offset = count == EOF ? delta : delta-count;
+ dir = _IO_seek_cur;
+ goto dumb;
+ }
+ }
+ _IO_setg(fp, fp->_IO_buf_base, fp->_IO_buf_base+delta, fp->_IO_buf_base+count);
+ _IO_setp(fp, fp->_IO_buf_base, fp->_IO_buf_base);
+ fp->_offset = result + count;
+ _IO_mask_flags(fp, 0, _IO_EOF_SEEN);
+ return offset;
+ dumb:
+
+ _IO_unsave_markers(fp);
+ result = _IO_SYSSEEK (fp, offset, dir);
+ if (result != EOF)
+ _IO_mask_flags(fp, 0, _IO_EOF_SEEN);
+ fp->_offset = result;
+ _IO_setg(fp, fp->_IO_buf_base, fp->_IO_buf_base, fp->_IO_buf_base);
+ _IO_setp(fp, fp->_IO_buf_base, fp->_IO_buf_base);
+ return result;
+}
+
+_IO_ssize_t
+DEFUN(_IO_file_read, (fp, buf, size),
+ register _IO_FILE* fp AND void* buf AND _IO_ssize_t size)
+{
+ for (;;)
+ {
+ _IO_ssize_t count = _IO_read(fp->_fileno, buf, size);
+#ifdef EINTR
+ if (count == -1 && errno == EINTR)
+ continue;
+#endif
+ return count;
+ }
+}
+
+_IO_pos_t
+DEFUN(_IO_file_seek, (fp, offset, dir),
+ _IO_FILE *fp AND _IO_off_t offset AND int dir)
+{
+ return _IO_lseek(fp->_fileno, offset, dir);
+}
+
+int
+DEFUN(_IO_file_stat, (fp, st),
+ _IO_FILE *fp AND void* st)
+{
+ return _IO_fstat(fp->_fileno, (struct stat*)st);
+}
+
+int
+DEFUN(_IO_file_close, (fp),
+ _IO_FILE* fp)
+{
+ return _IO_close(fp->_fileno);
+}
+
+_IO_ssize_t
+DEFUN(_IO_file_write, (f, data, n),
+ register _IO_FILE* f AND const void* data AND _IO_ssize_t n)
+{
+ _IO_ssize_t to_do = n;
+ while (to_do > 0)
+ {
+ _IO_ssize_t count = _IO_write(f->_fileno, data, to_do);
+ if (count == EOF)
+ {
+#ifdef EINTR
+ if (errno == EINTR)
+ continue;
+ else
+#endif
+ {
+ f->_flags |= _IO_ERR_SEEN;
+ break;
+ }
+ }
+ to_do -= count;
+ data = (void*)((char*)data + count);
+ }
+ n -= to_do;
+ if (f->_offset >= 0)
+ f->_offset += n;
+ return n;
+}
+
+_IO_size_t
+DEFUN(_IO_file_xsputn, (f, data, n),
+ _IO_FILE *f AND const void *data AND _IO_size_t n)
+{
+ register const char *s = (char*) data;
+ _IO_size_t to_do = n;
+ int must_flush = 0;
+ _IO_size_t count;
+
+ if (n <= 0)
+ return 0;
+ /* This is an optimized implementation.
+ If the amount to be written straddles a block boundary
+ (or the filebuf is unbuffered), use sys_write directly. */
+
+ /* First figure out how much space is available in the buffer. */
+ count = f->_IO_write_end - f->_IO_write_ptr; /* Space available. */
+ if ((f->_flags & _IO_LINE_BUF) && (f->_flags & _IO_CURRENTLY_PUTTING))
+ {
+ count = f->_IO_buf_end - f->_IO_write_ptr;
+ if (count >= n)
+ { register const char *p;
+ for (p = s + n; p > s; )
+ {
+ if (*--p == '\n') {
+ count = p - s + 1;
+ must_flush = 1;
+ break;
+ }
+ }
+ }
+ }
+ /* Then fill the buffer. */
+ if (count > 0)
+ {
+ if (count > to_do)
+ count = to_do;
+ if (count > 20) {
+ memcpy(f->_IO_write_ptr, s, count);
+ s += count;
+ }
+ else
+ {
+ register char *p = f->_IO_write_ptr;
+ register int i = (int)count;
+ while (--i >= 0) *p++ = *s++;
+ }
+ f->_IO_write_ptr += count;
+ to_do -= count;
+ }
+ if (to_do + must_flush > 0)
+ { _IO_size_t block_size, dont_write;
+ /* Next flush the (full) buffer. */
+ if (__overflow(f, EOF) == EOF)
+ return n - to_do;
+
+ /* Try to maintain alignment: write a whole number of blocks.
+ dont_write is what gets left over. */
+ block_size = f->_IO_buf_end - f->_IO_buf_base;
+ dont_write = block_size >= 128 ? to_do % block_size : 0;
+
+ count = to_do - dont_write;
+ if (_IO_do_write(f, s, count) == EOF)
+ return n - to_do;
+ to_do = dont_write;
+
+ /* Now write out the remainder. Normally, this will fit in the
+ buffer, but it's somewhat messier for line-buffered files,
+ so we let _IO_default_xsputn handle the general case. */
+ if (dont_write)
+ to_do -= _IO_default_xsputn(f, s+count, dont_write);
+ }
+ return n - to_do;
+}
+
+#if 0
+/* Work in progress */
+_IO_size_t
+DEFUN(_IO_file_xsgetn, (fp, data, n),
+ _IO_FILE *fp AND void *data AND _IO_size_t n)
+{
+ register _IO_size_t more = n;
+ register char *s = data;
+ for (;;)
+ {
+ _IO_ssize_t count = fp->_IO_read_end - fp->_IO_read_ptr; /* Data available. */
+ if (count > 0)
+ {
+ if (count > more)
+ count = more;
+ if (count > 20)
+ {
+ memcpy(s, fp->_IO_read_ptr, count);
+ s += count;
+ fp->_IO_read_ptr += count;
+ }
+ else if (count <= 0)
+ count = 0;
+ else
+ {
+ register char *p = fp->_IO_read_ptr;
+ register int i = (int)count;
+ while (--i >= 0) *s++ = *p++;
+ fp->_IO_read_ptr = p;
+ }
+ more -= count;
+ }
+#if 0
+ if (! _IO_in put_mode (fp)
+ && ! _IO_have_markers (fp) && ! IO_have_backup (fp))
+ {
+ /* This is an optimization of _IO_file_underflow */
+ if (fp->_flags & _IO_NO_READS)
+ break;
+ /* If we're reading a lot of data, don't bother allocating
+ a buffer. But if we're only reading a bit, perhaps we should ??*/
+ if (count <= 512 && fp->_IO_buf_base == NULL)
+ _IO_doallocbuf(fp);
+ if (fp->_flags & (_IO_LINE_BUF|_IO_UNBUFFERED))
+ _IO_flush_all_linebuffered();
+
+ _IO_switch_to_get_mode(fp); ???;
+ count = _IO_SYSREAD (fp, s, more);
+ if (count <= 0)
+ {
+ if (count == 0)
+ fp->_flags |= _IO_EOF_SEEN;
+ else
+ fp->_flags |= _IO_ERR_SEEN, count = 0;
+ }
+
+ s += count;
+ more -= count;
+ }
+#endif
+ if (more == 0 || __underflow(fp) == EOF)
+ break;
+ }
+ return n - more;
+}
+#endif
+
+struct _IO_jump_t _IO_file_jumps = {
+ JUMP_INIT_DUMMY,
+ JUMP_INIT(finish, _IO_file_finish),
+ JUMP_INIT(overflow, _IO_file_overflow),
+ JUMP_INIT(underflow, _IO_file_underflow),
+ JUMP_INIT(uflow, _IO_default_uflow),
+ JUMP_INIT(pbackfail, _IO_default_pbackfail),
+ JUMP_INIT(xsputn, _IO_file_xsputn),
+ JUMP_INIT(xsgetn, _IO_default_xsgetn),
+ JUMP_INIT(seekoff, _IO_file_seekoff),
+ JUMP_INIT(seekpos, _IO_default_seekpos),
+ JUMP_INIT(setbuf, _IO_file_setbuf),
+ JUMP_INIT(sync, _IO_file_sync),
+ JUMP_INIT(doallocate, _IO_file_doallocate),
+ JUMP_INIT(read, _IO_file_read),
+ JUMP_INIT(write, _IO_file_write),
+ JUMP_INIT(seek, _IO_file_seek),
+ JUMP_INIT(close, _IO_file_close),
+ JUMP_INIT(stat, _IO_file_stat)
+};
diff --git a/libio/floatconv.c b/libio/floatconv.c
new file mode 100644
index 00000000000..9503187b5d5
--- /dev/null
+++ b/libio/floatconv.c
@@ -0,0 +1,2375 @@
+/*
+Copyright (C) 1993, 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <libioP.h>
+#ifdef _IO_USE_DTOA
+/****************************************************************
+ *
+ * The author of this software is David M. Gay.
+ *
+ * Copyright (c) 1991 by AT&T.
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose without fee is hereby granted, provided that this entire notice
+ * is included in all copies of any software which is or includes a copy
+ * or modification of this software and in all copies of the supporting
+ * documentation for such software.
+ *
+ * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
+ * WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR AT&T MAKES ANY
+ * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
+ * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
+ *
+ ***************************************************************/
+
+/* Some cleaning up by Per Bothner, bothner@cygnus.com, 1992, 1993.
+ Re-written to not need static variables
+ (except result, result_k, HIWORD, LOWORD). */
+
+/* Note that the checking of _DOUBLE_IS_32BITS is for use with the
+ cross targets that employ the newlib ieeefp.h header. -- brendan */
+
+/* Please send bug reports to
+ David M. Gay
+ AT&T Bell Laboratories, Room 2C-463
+ 600 Mountain Avenue
+ Murray Hill, NJ 07974-2070
+ U.S.A.
+ dmg@research.att.com or research!dmg
+ */
+
+/* strtod for IEEE-, VAX-, and IBM-arithmetic machines.
+ *
+ * This strtod returns a nearest machine number to the input decimal
+ * string (or sets errno to ERANGE). With IEEE arithmetic, ties are
+ * broken by the IEEE round-even rule. Otherwise ties are broken by
+ * biased rounding (add half and chop).
+ *
+ * Inspired loosely by William D. Clinger's paper "How to Read Floating
+ * Point Numbers Accurately" [Proc. ACM SIGPLAN '90, pp. 92-101].
+ *
+ * Modifications:
+ *
+ * 1. We only require IEEE, IBM, or VAX double-precision
+ * arithmetic (not IEEE double-extended).
+ * 2. We get by with floating-point arithmetic in a case that
+ * Clinger missed -- when we're computing d * 10^n
+ * for a small integer d and the integer n is not too
+ * much larger than 22 (the maximum integer k for which
+ * we can represent 10^k exactly), we may be able to
+ * compute (d*10^k) * 10^(e-k) with just one roundoff.
+ * 3. Rather than a bit-at-a-time adjustment of the binary
+ * result in the hard case, we use floating-point
+ * arithmetic to determine the adjustment to within
+ * one bit; only in really hard cases do we need to
+ * compute a second residual.
+ * 4. Because of 3., we don't need a large table of powers of 10
+ * for ten-to-e (just some small tables, e.g. of 10^k
+ * for 0 <= k <= 22).
+ */
+
+/*
+ * #define IEEE_8087 for IEEE-arithmetic machines where the least
+ * significant byte has the lowest address.
+ * #define IEEE_MC68k for IEEE-arithmetic machines where the most
+ * significant byte has the lowest address.
+ * #define Sudden_Underflow for IEEE-format machines without gradual
+ * underflow (i.e., that flush to zero on underflow).
+ * #define IBM for IBM mainframe-style floating-point arithmetic.
+ * #define VAX for VAX-style floating-point arithmetic.
+ * #define Unsigned_Shifts if >> does treats its left operand as unsigned.
+ * #define No_leftright to omit left-right logic in fast floating-point
+ * computation of dtoa.
+ * #define Check_FLT_ROUNDS if FLT_ROUNDS can assume the values 2 or 3.
+ * #define RND_PRODQUOT to use rnd_prod and rnd_quot (assembly routines
+ * that use extended-precision instructions to compute rounded
+ * products and quotients) with IBM.
+ * #define ROUND_BIASED for IEEE-format with biased rounding.
+ * #define Inaccurate_Divide for IEEE-format with correctly rounded
+ * products but inaccurate quotients, e.g., for Intel i860.
+ * #define KR_headers for old-style C function headers.
+ */
+
+#ifdef DEBUG
+#include <stdio.h>
+#define Bug(x) {fprintf(stderr, "%s\n", x); exit(1);}
+#endif
+
+#ifdef __STDC__
+#include <stdlib.h>
+#include <string.h>
+#include <float.h>
+#define CONST const
+#else
+#define CONST
+#define KR_headers
+
+/* In this case, we assume IEEE floats. */
+#define FLT_ROUNDS 1
+#define FLT_RADIX 2
+#define DBL_MANT_DIG 53
+#define DBL_DIG 15
+#define DBL_MAX_10_EXP 308
+#define DBL_MAX_EXP 1024
+#endif
+
+#include <errno.h>
+#ifndef __MATH_H__
+#include <math.h>
+#endif
+
+#ifdef Unsigned_Shifts
+#define Sign_Extend(a,b) if (b < 0) a |= 0xffff0000;
+#else
+#define Sign_Extend(a,b) /*no-op*/
+#endif
+
+#if defined(__i386__) || defined(__i860__) || defined(clipper)
+#define IEEE_8087
+#endif
+#if defined(MIPSEL) || defined(__alpha__)
+#define IEEE_8087
+#endif
+#if defined(__sparc__) || defined(sparc) || defined(MIPSEB)
+#define IEEE_MC68k
+#endif
+
+#if defined(IEEE_8087) + defined(IEEE_MC68k) + defined(VAX) + defined(IBM) != 1
+
+#ifndef _DOUBLE_IS_32BITS
+#if FLT_RADIX==16
+#define IBM
+#else
+#if DBL_MANT_DIG==56
+#define VAX
+#else
+#if DBL_MANT_DIG==53 && DBL_MAX_10_EXP==308
+#define IEEE_Unknown
+#else
+Exactly one of IEEE_8087, IEEE_MC68k, VAX, or IBM should be defined.
+#endif
+#endif
+#endif
+#endif /* !_DOUBLE_IS_32BITS */
+#endif
+
+typedef _G_uint32_t unsigned32;
+
+union doubleword {
+ double d;
+ unsigned32 u[2];
+};
+
+#ifdef IEEE_8087
+#define HIWORD 1
+#define LOWORD 0
+#define TEST_ENDIANNESS /* nothing */
+#else
+#if defined(IEEE_MC68k)
+#define HIWORD 0
+#define LOWORD 1
+#define TEST_ENDIANNESS /* nothing */
+#else
+static int HIWORD = -1, LOWORD;
+static void test_endianness()
+{
+ union doubleword dw;
+ dw.d = 10;
+ if (dw.u[0] != 0) /* big-endian */
+ HIWORD=0, LOWORD=1;
+ else
+ HIWORD=1, LOWORD=0;
+}
+#define TEST_ENDIANNESS if (HIWORD<0) test_endianness();
+#endif
+#endif
+
+#if 0
+union doubleword _temp;
+#endif
+#if defined(__GNUC__) && !defined(_DOUBLE_IS_32BITS)
+#define word0(x) ({ union doubleword _du; _du.d = (x); _du.u[HIWORD]; })
+#define word1(x) ({ union doubleword _du; _du.d = (x); _du.u[LOWORD]; })
+#define setword0(D,W) \
+ ({ union doubleword _du; _du.d = (D); _du.u[HIWORD]=(W); (D)=_du.d; })
+#define setword1(D,W) \
+ ({ union doubleword _du; _du.d = (D); _du.u[LOWORD]=(W); (D)=_du.d; })
+#define setwords(D,W0,W1) ({ union doubleword _du; \
+ _du.u[HIWORD]=(W0); _du.u[LOWORD]=(W1); (D)=_du.d; })
+#define addword0(D,W) \
+ ({ union doubleword _du; _du.d = (D); _du.u[HIWORD]+=(W); (D)=_du.d; })
+#else
+#define word0(x) ((unsigned32 *)&x)[HIWORD]
+#ifndef _DOUBLE_IS_32BITS
+#define word1(x) ((unsigned32 *)&x)[LOWORD]
+#else
+#define word1(x) 0
+#endif
+#define setword0(D,W) word0(D) = (W)
+#ifndef _DOUBLE_IS_32BITS
+#define setword1(D,W) word1(D) = (W)
+#define setwords(D,W0,W1) (setword0(D,W0),setword1(D,W1))
+#else
+#define setword1(D,W)
+#define setwords(D,W0,W1) (setword0(D,W0))
+#endif
+#define addword0(D,X) (word0(D) += (X))
+#endif
+
+/* The following definition of Storeinc is appropriate for MIPS processors. */
+#if defined(IEEE_8087) + defined(VAX)
+#define Storeinc(a,b,c) (((unsigned short *)a)[1] = (unsigned short)b, \
+((unsigned short *)a)[0] = (unsigned short)c, a++)
+#else
+#if defined(IEEE_MC68k)
+#define Storeinc(a,b,c) (((unsigned short *)a)[0] = (unsigned short)b, \
+((unsigned short *)a)[1] = (unsigned short)c, a++)
+#else
+#define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
+#endif
+#endif
+
+/* #define P DBL_MANT_DIG */
+/* Ten_pmax = floor(P*log(2)/log(5)) */
+/* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
+/* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
+/* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
+
+#if defined(IEEE_8087) + defined(IEEE_MC68k) + defined(IEEE_Unknown)
+#define Exp_shift 20
+#define Exp_shift1 20
+#define Exp_msk1 0x100000
+#define Exp_msk11 0x100000
+#define Exp_mask 0x7ff00000
+#define P 53
+#define Bias 1023
+#define IEEE_Arith
+#define Emin (-1022)
+#define Exp_1 0x3ff00000
+#define Exp_11 0x3ff00000
+#define Ebits 11
+#define Frac_mask 0xfffff
+#define Frac_mask1 0xfffff
+#define Ten_pmax 22
+#define Bletch 0x10
+#define Bndry_mask 0xfffff
+#define Bndry_mask1 0xfffff
+#define LSB 1
+#define Sign_bit 0x80000000
+#define Log2P 1
+#define Tiny0 0
+#define Tiny1 1
+#define Quick_max 14
+#define Int_max 14
+#define Infinite(x) (word0(x) == 0x7ff00000) /* sufficient test for here */
+#else
+#undef Sudden_Underflow
+#define Sudden_Underflow
+#ifdef IBM
+#define Exp_shift 24
+#define Exp_shift1 24
+#define Exp_msk1 0x1000000
+#define Exp_msk11 0x1000000
+#define Exp_mask 0x7f000000
+#define P 14
+#define Bias 65
+#define Exp_1 0x41000000
+#define Exp_11 0x41000000
+#define Ebits 8 /* exponent has 7 bits, but 8 is the right value in b2d */
+#define Frac_mask 0xffffff
+#define Frac_mask1 0xffffff
+#define Bletch 4
+#define Ten_pmax 22
+#define Bndry_mask 0xefffff
+#define Bndry_mask1 0xffffff
+#define LSB 1
+#define Sign_bit 0x80000000
+#define Log2P 4
+#define Tiny0 0x100000
+#define Tiny1 0
+#define Quick_max 14
+#define Int_max 15
+#else /* VAX */
+#define Exp_shift 23
+#define Exp_shift1 7
+#define Exp_msk1 0x80
+#define Exp_msk11 0x800000
+#define Exp_mask 0x7f80
+#define P 56
+#define Bias 129
+#define Exp_1 0x40800000
+#define Exp_11 0x4080
+#define Ebits 8
+#define Frac_mask 0x7fffff
+#define Frac_mask1 0xffff007f
+#define Ten_pmax 24
+#define Bletch 2
+#define Bndry_mask 0xffff007f
+#define Bndry_mask1 0xffff007f
+#define LSB 0x10000
+#define Sign_bit 0x8000
+#define Log2P 1
+#define Tiny0 0x80
+#define Tiny1 0
+#define Quick_max 15
+#define Int_max 15
+#endif
+#endif
+
+#ifndef IEEE_Arith
+#define ROUND_BIASED
+#endif
+
+#ifdef RND_PRODQUOT
+#define rounded_product(a,b) a = rnd_prod(a, b)
+#define rounded_quotient(a,b) a = rnd_quot(a, b)
+extern double rnd_prod(double, double), rnd_quot(double, double);
+#else
+#define rounded_product(a,b) a *= b
+#define rounded_quotient(a,b) a /= b
+#endif
+
+#define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
+#define Big1 0xffffffff
+
+#define Kmax 15
+
+/* (1<<BIGINT_MINIMUM_K) is the minimum number of words to allocate
+ in a Bigint. dtoa usually manages with 1<<2, and has not been
+ known to need more than 1<<3. */
+
+#define BIGINT_MINIMUM_K 3
+
+struct Bigint {
+ struct Bigint *next;
+ int k; /* Parameter given to Balloc(k) */
+ int maxwds; /* Allocated space: equals 1<<k. */
+ short on_stack; /* 1 if stack-allocated. */
+ short sign; /* 0 if value is positive or zero; 1 if negative. */
+ int wds; /* Current length. */
+ unsigned32 x[1<<BIGINT_MINIMUM_K]; /* Actually: x[maxwds] */
+};
+
+#define BIGINT_HEADER_SIZE \
+ (sizeof(Bigint) - (1<<BIGINT_MINIMUM_K) * sizeof(unsigned32))
+
+typedef struct Bigint Bigint;
+
+/* Initialize a stack-allocated Bigint. */
+
+static Bigint *
+Binit
+#ifdef KR_headers
+ (v) Bigint *v;
+#else
+ (Bigint *v)
+#endif
+{
+ v->on_stack = 1;
+ v->k = BIGINT_MINIMUM_K;
+ v->maxwds = 1 << BIGINT_MINIMUM_K;
+ v->sign = v->wds = 0;
+ return v;
+}
+
+/* Allocate a Bigint with '1<<k' big digits. */
+
+static Bigint *
+Balloc
+#ifdef KR_headers
+ (k) int k;
+#else
+ (int k)
+#endif
+{
+ int x;
+ Bigint *rv;
+
+ if (k < BIGINT_MINIMUM_K)
+ k = BIGINT_MINIMUM_K;
+
+ x = 1 << k;
+ rv = (Bigint *)
+ malloc(BIGINT_HEADER_SIZE + x * sizeof(unsigned32));
+ rv->k = k;
+ rv->maxwds = x;
+ rv->sign = rv->wds = 0;
+ rv->on_stack = 0;
+ return rv;
+}
+
+static void
+Bfree
+#ifdef KR_headers
+ (v) Bigint *v;
+#else
+ (Bigint *v)
+#endif
+{
+ if (v && !v->on_stack)
+ free (v);
+}
+
+static void
+Bcopy
+#ifdef KR_headers
+ (x, y) Bigint *x, *y;
+#else
+ (Bigint *x, Bigint *y)
+#endif
+{
+ register unsigned32 *xp, *yp;
+ register int i = y->wds;
+ x->sign = y->sign;
+ x->wds = i;
+ for (xp = x->x, yp = y->x; --i >= 0; )
+ *xp++ = *yp++;
+}
+
+/* Make sure b has room for at least 1<<k big digits. */
+
+static Bigint *
+Brealloc
+#ifdef KR_headers
+ (b, k) Bigint *b; int k;
+#else
+ (Bigint * b, int k)
+#endif
+{
+ if (b == NULL)
+ return Balloc(k);
+ if (b->k >= k)
+ return b;
+ else
+ {
+ Bigint *rv = Balloc (k);
+ Bcopy(rv, b);
+ Bfree(b);
+ return rv;
+ }
+}
+
+/* Return b*m+a. b is modified.
+ Assumption: 0xFFFF*m+a fits in 32 bits. */
+
+static Bigint *
+multadd
+#ifdef KR_headers
+ (b, m, a) Bigint *b; int m, a;
+#else
+ (Bigint *b, int m, int a)
+#endif
+{
+ int i, wds;
+ unsigned32 *x, y;
+ unsigned32 xi, z;
+
+ wds = b->wds;
+ x = b->x;
+ i = 0;
+ do {
+ xi = *x;
+ y = (xi & 0xffff) * m + a;
+ z = (xi >> 16) * m + (y >> 16);
+ a = (int)(z >> 16);
+ *x++ = (z << 16) + (y & 0xffff);
+ }
+ while(++i < wds);
+ if (a) {
+ if (wds >= b->maxwds)
+ b = Brealloc(b, b->k+1);
+ b->x[wds++] = a;
+ b->wds = wds;
+ }
+ return b;
+ }
+
+static Bigint *
+s2b
+#ifdef KR_headers
+ (result, s, nd0, nd, y9)
+ Bigint *result; CONST char *s; int nd0, nd; unsigned32 y9;
+#else
+ (Bigint *result, CONST char *s, int nd0, int nd, unsigned32 y9)
+#endif
+{
+ int i, k;
+ _G_int32_t x, y;
+
+ x = (nd + 8) / 9;
+ for(k = 0, y = 1; x > y; y <<= 1, k++) ;
+ result = Brealloc(result, k);
+ result->x[0] = y9;
+ result->wds = 1;
+
+ i = 9;
+ if (9 < nd0)
+ {
+ s += 9;
+ do
+ result = multadd(result, 10, *s++ - '0');
+ while (++i < nd0);
+ s++;
+ }
+ else
+ s += 10;
+ for(; i < nd; i++)
+ result = multadd(result, 10, *s++ - '0');
+ return result;
+}
+
+static int
+hi0bits
+#ifdef KR_headers
+ (x) register unsigned32 x;
+#else
+ (register unsigned32 x)
+#endif
+{
+ register int k = 0;
+
+ if (!(x & 0xffff0000)) {
+ k = 16;
+ x <<= 16;
+ }
+ if (!(x & 0xff000000)) {
+ k += 8;
+ x <<= 8;
+ }
+ if (!(x & 0xf0000000)) {
+ k += 4;
+ x <<= 4;
+ }
+ if (!(x & 0xc0000000)) {
+ k += 2;
+ x <<= 2;
+ }
+ if (!(x & 0x80000000)) {
+ k++;
+ if (!(x & 0x40000000))
+ return 32;
+ }
+ return k;
+ }
+
+static int
+lo0bits
+#ifdef KR_headers
+ (y) unsigned32 *y;
+#else
+ (unsigned32 *y)
+#endif
+{
+ register int k;
+ register unsigned32 x = *y;
+
+ if (x & 7) {
+ if (x & 1)
+ return 0;
+ if (x & 2) {
+ *y = x >> 1;
+ return 1;
+ }
+ *y = x >> 2;
+ return 2;
+ }
+ k = 0;
+ if (!(x & 0xffff)) {
+ k = 16;
+ x >>= 16;
+ }
+ if (!(x & 0xff)) {
+ k += 8;
+ x >>= 8;
+ }
+ if (!(x & 0xf)) {
+ k += 4;
+ x >>= 4;
+ }
+ if (!(x & 0x3)) {
+ k += 2;
+ x >>= 2;
+ }
+ if (!(x & 1)) {
+ k++;
+ x >>= 1;
+ if (!x & 1)
+ return 32;
+ }
+ *y = x;
+ return k;
+ }
+
+static Bigint *
+i2b
+#ifdef KR_headers
+ (result, i) Bigint *result; int i;
+#else
+ (Bigint* result, int i)
+#endif
+{
+ result = Brealloc(result, 1);
+ result->x[0] = i;
+ result->wds = 1;
+ return result;
+}
+
+/* Do: c = a * b. */
+
+static Bigint *
+mult
+#ifdef KR_headers
+ (c, a, b) Bigint *a, *b, *c;
+#else
+ (Bigint *c, Bigint *a, Bigint *b)
+#endif
+{
+ int k, wa, wb, wc;
+ unsigned32 carry, y, z;
+ unsigned32 *x, *xa, *xae, *xb, *xbe, *xc, *xc0;
+ unsigned32 z2;
+ if (a->wds < b->wds) {
+ Bigint *tmp = a;
+ a = b;
+ b = tmp;
+ }
+ k = a->k;
+ wa = a->wds;
+ wb = b->wds;
+ wc = wa + wb;
+ if (wc > a->maxwds)
+ k++;
+ c = Brealloc(c, k);
+ for(x = c->x, xa = x + wc; x < xa; x++)
+ *x = 0;
+ xa = a->x;
+ xae = xa + wa;
+ xb = b->x;
+ xbe = xb + wb;
+ xc0 = c->x;
+ for(; xb < xbe; xb++, xc0++) {
+ if ((y = *xb & 0xffff)) {
+ x = xa;
+ xc = xc0;
+ carry = 0;
+ do {
+ z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
+ carry = z >> 16;
+ z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
+ carry = z2 >> 16;
+ Storeinc(xc, z2, z);
+ }
+ while(x < xae);
+ *xc = carry;
+ }
+ if ((y = *xb >> 16)) {
+ x = xa;
+ xc = xc0;
+ carry = 0;
+ z2 = *xc;
+ do {
+ z = (*x & 0xffff) * y + (*xc >> 16) + carry;
+ carry = z >> 16;
+ Storeinc(xc, z, z2);
+ z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
+ carry = z2 >> 16;
+ }
+ while(x < xae);
+ *xc = z2;
+ }
+ }
+ for(xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc) ;
+ c->wds = wc;
+ return c;
+ }
+
+/* Returns b*(5**k). b is modified. */
+/* Re-written by Per Bothner to not need a static list. */
+
+static Bigint *
+pow5mult
+#ifdef KR_headers
+ (b, k) Bigint *b; int k;
+#else
+ (Bigint *b, int k)
+#endif
+{
+ static int p05[6] = { 5, 25, 125, 625, 3125, 15625 };
+
+ for (; k > 6; k -= 6)
+ b = multadd(b, 15625, 0); /* b *= 5**6 */
+ if (k == 0)
+ return b;
+ else
+ return multadd(b, p05[k-1], 0);
+}
+
+/* Re-written by Per Bothner so shift can be in place. */
+
+static Bigint *
+lshift
+#ifdef KR_headers
+ (b, k) Bigint *b; int k;
+#else
+ (Bigint *b, int k)
+#endif
+{
+ int i;
+ unsigned32 *x, *x1, *xe;
+ int old_wds = b->wds;
+ int n = k >> 5;
+ int k1 = b->k;
+ int n1 = n + old_wds + 1;
+
+ if (k == 0)
+ return b;
+
+ for(i = b->maxwds; n1 > i; i <<= 1)
+ k1++;
+ b = Brealloc(b, k1);
+
+ xe = b->x; /* Source limit */
+ x = xe + old_wds; /* Source pointer */
+ x1 = x + n; /* Destination pointer */
+ if (k &= 0x1f) {
+ int k1 = 32 - k;
+ unsigned32 z = *--x;
+ if ((*x1 = (z >> k1)) != 0) {
+ ++n1;
+ }
+ while (x > xe) {
+ unsigned32 w = *--x;
+ *--x1 = (z << k) | (w >> k1);
+ z = w;
+ }
+ *--x1 = z << k;
+ }
+ else
+ do {
+ *--x1 = *--x;
+ } while(x > xe);
+ while (x1 > xe)
+ *--x1 = 0;
+ b->wds = n1 - 1;
+ return b;
+}
+
+static int
+cmp
+#ifdef KR_headers
+ (a, b) Bigint *a, *b;
+#else
+ (Bigint *a, Bigint *b)
+#endif
+{
+ unsigned32 *xa, *xa0, *xb, *xb0;
+ int i, j;
+
+ i = a->wds;
+ j = b->wds;
+#ifdef DEBUG
+ if (i > 1 && !a->x[i-1])
+ Bug("cmp called with a->x[a->wds-1] == 0");
+ if (j > 1 && !b->x[j-1])
+ Bug("cmp called with b->x[b->wds-1] == 0");
+#endif
+ if (i -= j)
+ return i;
+ xa0 = a->x;
+ xa = xa0 + j;
+ xb0 = b->x;
+ xb = xb0 + j;
+ for(;;) {
+ if (*--xa != *--xb)
+ return *xa < *xb ? -1 : 1;
+ if (xa <= xa0)
+ break;
+ }
+ return 0;
+ }
+
+/* Do: c = a-b. */
+
+static Bigint *
+diff
+#ifdef KR_headers
+ (c, a, b) Bigint *c, *a, *b;
+#else
+ (Bigint *c, Bigint *a, Bigint *b)
+#endif
+{
+ int i, wa, wb;
+ _G_int32_t borrow, y; /* We need signed shifts here. */
+ unsigned32 *xa, *xae, *xb, *xbe, *xc;
+ _G_int32_t z;
+
+ i = cmp(a,b);
+ if (!i) {
+ c = Brealloc(c, 0);
+ c->wds = 1;
+ c->x[0] = 0;
+ return c;
+ }
+ if (i < 0) {
+ Bigint *tmp = a;
+ a = b;
+ b = tmp;
+ i = 1;
+ }
+ else
+ i = 0;
+ c = Brealloc(c, a->k);
+ c->sign = i;
+ wa = a->wds;
+ xa = a->x;
+ xae = xa + wa;
+ wb = b->wds;
+ xb = b->x;
+ xbe = xb + wb;
+ xc = c->x;
+ borrow = 0;
+ do {
+ y = (*xa & 0xffff) - (*xb & 0xffff) + borrow;
+ borrow = y >> 16;
+ Sign_Extend(borrow, y);
+ z = (*xa++ >> 16) - (*xb++ >> 16) + borrow;
+ borrow = z >> 16;
+ Sign_Extend(borrow, z);
+ Storeinc(xc, z, y);
+ }
+ while(xb < xbe);
+ while(xa < xae) {
+ y = (*xa & 0xffff) + borrow;
+ borrow = y >> 16;
+ Sign_Extend(borrow, y);
+ z = (*xa++ >> 16) + borrow;
+ borrow = z >> 16;
+ Sign_Extend(borrow, z);
+ Storeinc(xc, z, y);
+ }
+ while(!*--xc)
+ wa--;
+ c->wds = wa;
+ return c;
+ }
+
+static double
+ulp
+#ifdef KR_headers
+ (x) double x;
+#else
+ (double x)
+#endif
+{
+ register _G_int32_t L;
+ double a;
+
+ L = (word0(x) & Exp_mask) - (P-1)*Exp_msk1;
+#ifndef Sudden_Underflow
+ if (L > 0) {
+#endif
+#ifdef IBM
+ L |= Exp_msk1 >> 4;
+#endif
+ setwords(a, L, 0);
+#ifndef Sudden_Underflow
+ }
+ else {
+ L = -L >> Exp_shift;
+ if (L < Exp_shift)
+ setwords(a, 0x80000 >> L, 0);
+ else {
+ L -= Exp_shift;
+ setwords(a, 0, L >= 31 ? 1 : 1 << (31 - L));
+ }
+ }
+#endif
+ return a;
+ }
+
+static double
+b2d
+#ifdef KR_headers
+ (a, e) Bigint *a; int *e;
+#else
+ (Bigint *a, int *e)
+#endif
+{
+ unsigned32 *xa, *xa0, w, y, z;
+ int k;
+ double d;
+ unsigned32 d0, d1;
+
+ xa0 = a->x;
+ xa = xa0 + a->wds;
+ y = *--xa;
+#ifdef DEBUG
+ if (!y) Bug("zero y in b2d");
+#endif
+ k = hi0bits(y);
+ *e = 32 - k;
+ if (k < Ebits) {
+ d0 = Exp_1 | y >> (Ebits - k);
+ w = xa > xa0 ? *--xa : 0;
+#ifndef _DOUBLE_IS_32BITS
+ d1 = y << ((32-Ebits) + k) | w >> (Ebits - k);
+#endif
+ goto ret_d;
+ }
+ z = xa > xa0 ? *--xa : 0;
+ if (k -= Ebits) {
+ d0 = Exp_1 | y << k | z >> (32 - k);
+ y = xa > xa0 ? *--xa : 0;
+#ifndef _DOUBLE_IS_32BITS
+ d1 = z << k | y >> (32 - k);
+#endif
+ }
+ else {
+ d0 = Exp_1 | y;
+#ifndef _DOUBLE_IS_32BITS
+ d1 = z;
+#endif
+ }
+ ret_d:
+#ifdef VAX
+ setwords(d, d0 >> 16 | d0 << 16, d1 >> 16 | d1 << 16);
+#else
+ setwords (d, d0, d1);
+#endif
+ return d;
+ }
+
+static Bigint *
+d2b
+#ifdef KR_headers
+ (result, d, e, bits) Bigint *result; double d; _G_int32_t *e, *bits;
+#else
+ (Bigint *result, double d, _G_int32_t *e, _G_int32_t *bits)
+#endif
+{
+ int de, i, k;
+ unsigned32 *x, y, z;
+ unsigned32 d0, d1;
+#ifdef VAX
+ d0 = word0(d) >> 16 | word0(d) << 16;
+ d1 = word1(d) >> 16 | word1(d) << 16;
+#else
+ d0 = word0(d);
+ d1 = word1(d);
+#endif
+
+ result = Brealloc(result, 1);
+ x = result->x;
+
+ z = d0 & Frac_mask;
+ d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
+
+ de = (int)(d0 >> Exp_shift); /* The exponent part of d. */
+
+ /* Put back the suppressed high-order bit, if normalized. */
+#ifndef IBM
+#ifndef Sudden_Underflow
+ if (de)
+#endif
+ z |= Exp_msk11;
+#endif
+
+#ifndef _DOUBLE_IS_32BITS
+ if ((y = d1)) {
+ if ((k = lo0bits(&y))) {
+ x[0] = y | z << (32 - k);
+ z >>= k;
+ }
+ else
+ x[0] = y;
+ i = result->wds = (x[1] = z) ? 2 : 1;
+ }
+ else {
+#endif /* !_DOUBLE_IS_32BITS */
+#ifdef DEBUG
+ if (!z)
+ Bug("Zero passed to d2b");
+#endif
+ k = lo0bits(&z);
+ x[0] = z;
+ i = result->wds = 1;
+#ifndef _DOUBLE_IS_32BITS
+ k += 32;
+ }
+#endif
+#ifndef Sudden_Underflow
+ if (de) {
+#endif
+#ifdef IBM
+ *e = (de - Bias - (P-1) << 2) + k;
+ *bits = 4*P + 8 - k - hi0bits(word0(d) & Frac_mask);
+#else
+ *e = de - Bias - (P-1) + k;
+ *bits = P - k;
+#endif
+#ifndef Sudden_Underflow
+ }
+ else {
+ *e = de - Bias - (P-1) + 1 + k;
+ *bits = 32*i - hi0bits(x[i-1]);
+ }
+#endif
+ return result;
+ }
+
+static double
+ratio
+#ifdef KR_headers
+ (a, b) Bigint *a, *b;
+#else
+ (Bigint *a, Bigint *b)
+#endif
+{
+ double da, db;
+ int k, ka, kb;
+
+ da = b2d(a, &ka);
+ db = b2d(b, &kb);
+ k = ka - kb + 32*(a->wds - b->wds);
+#ifdef IBM
+ if (k > 0) {
+ addword0(da, (k >> 2)*Exp_msk1);
+ if (k &= 3)
+ da *= 1 << k;
+ }
+ else {
+ k = -k;
+ addword0(db,(k >> 2)*Exp_msk1);
+ if (k &= 3)
+ db *= 1 << k;
+ }
+#else
+ if (k > 0)
+ addword0(da, k*Exp_msk1);
+ else {
+ k = -k;
+ addword0(db, k*Exp_msk1);
+ }
+#endif
+ return da / db;
+ }
+
+static CONST double
+tens[] = {
+ 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
+ 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
+ 1e20, 1e21, 1e22
+#ifdef VAX
+ , 1e23, 1e24
+#endif
+ };
+
+#ifdef IEEE_Arith
+static CONST double bigtens[] = { 1e16, 1e32, 1e64, 1e128, 1e256 };
+static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64, 1e-128, 1e-256 };
+#define n_bigtens 5
+#else
+#ifdef IBM
+static CONST double bigtens[] = { 1e16, 1e32, 1e64 };
+static CONST double tinytens[] = { 1e-16, 1e-32, 1e-64 };
+#define n_bigtens 3
+#else
+/* Also used for the case when !_DOUBLE_IS_32BITS. */
+static CONST double bigtens[] = { 1e16, 1e32 };
+static CONST double tinytens[] = { 1e-16, 1e-32 };
+#define n_bigtens 2
+#endif
+#endif
+
+ double
+_IO_strtod
+#ifdef KR_headers
+ (s00, se) CONST char *s00; char **se;
+#else
+ (CONST char *s00, char **se)
+#endif
+{
+ _G_int32_t bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign,
+ e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
+ CONST char *s, *s0, *s1;
+ double aadj, aadj1, adj, rv, rv0;
+ _G_int32_t L;
+ unsigned32 y, z;
+ Bigint _bb, _b_avail, _bd, _bd0, _bs, _delta;
+ Bigint *bb = Binit(&_bb);
+ Bigint *bd = Binit(&_bd);
+ Bigint *bd0 = Binit(&_bd0);
+ Bigint *bs = Binit(&_bs);
+ Bigint *b_avail = Binit(&_b_avail);
+ Bigint *delta = Binit(&_delta);
+
+ TEST_ENDIANNESS;
+ sign = nz0 = nz = 0;
+ rv = 0.;
+ (void)&rv; /* Force rv into the stack */
+ for(s = s00;;s++) switch(*s) {
+ case '-':
+ sign = 1;
+ /* no break */
+ case '+':
+ if (*++s)
+ goto break2;
+ /* no break */
+ case 0:
+ /* "+" and "-" should be reported as an error? */
+ sign = 0;
+ s = s00;
+ goto ret;
+ case '\t':
+ case '\n':
+ case '\v':
+ case '\f':
+ case '\r':
+ case ' ':
+ continue;
+ default:
+ goto break2;
+ }
+ break2:
+ if (*s == '0') {
+ nz0 = 1;
+ while(*++s == '0') ;
+ if (!*s)
+ goto ret;
+ }
+ s0 = s;
+ y = z = 0;
+ for(nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
+ if (nd < 9)
+ y = 10*y + c - '0';
+ else if (nd < 16)
+ z = 10*z + c - '0';
+ nd0 = nd;
+ if (c == '.') {
+ c = *++s;
+ if (!nd) {
+ for(; c == '0'; c = *++s)
+ nz++;
+ if (c > '0' && c <= '9') {
+ s0 = s;
+ nf += nz;
+ nz = 0;
+ goto have_dig;
+ }
+ goto dig_done;
+ }
+ for(; c >= '0' && c <= '9'; c = *++s) {
+ have_dig:
+ nz++;
+ if (c -= '0') {
+ nf += nz;
+ for(i = 1; i < nz; i++)
+ if (nd++ < 9)
+ y *= 10;
+ else if (nd <= DBL_DIG + 1)
+ z *= 10;
+ if (nd++ < 9)
+ y = 10*y + c;
+ else if (nd <= DBL_DIG + 1)
+ z = 10*z + c;
+ nz = 0;
+ }
+ }
+ }
+ dig_done:
+ e = 0;
+ if (c == 'e' || c == 'E') {
+ if (!nd && !nz && !nz0) {
+ s = s00;
+ goto ret;
+ }
+ s00 = s;
+ esign = 0;
+ switch(c = *++s) {
+ case '-':
+ esign = 1;
+ case '+':
+ c = *++s;
+ }
+ if (c >= '0' && c <= '9') {
+ while(c == '0')
+ c = *++s;
+ if (c > '0' && c <= '9') {
+ e = c - '0';
+ s1 = s;
+ while((c = *++s) >= '0' && c <= '9')
+ e = 10*e + c - '0';
+ if (s - s1 > 8)
+ /* Avoid confusion from exponents
+ * so large that e might overflow.
+ */
+ e = 9999999;
+ if (esign)
+ e = -e;
+ }
+ else
+ e = 0;
+ }
+ else
+ s = s00;
+ }
+ if (!nd) {
+ if (!nz && !nz0)
+ s = s00;
+ goto ret;
+ }
+ e1 = e -= nf;
+
+ /* Now we have nd0 digits, starting at s0, followed by a
+ * decimal point, followed by nd-nd0 digits. The number we're
+ * after is the integer represented by those digits times
+ * 10**e */
+
+ if (!nd0)
+ nd0 = nd;
+ k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
+ rv = y;
+ if (k > 9)
+ rv = tens[k - 9] * rv + z;
+ if (nd <= DBL_DIG
+#ifndef RND_PRODQUOT
+ && FLT_ROUNDS == 1
+#endif
+ ) {
+ if (!e)
+ goto ret;
+ if (e > 0) {
+ if (e <= Ten_pmax) {
+#ifdef VAX
+ goto vax_ovfl_check;
+#else
+ /* rv = */ rounded_product(rv, tens[e]);
+ goto ret;
+#endif
+ }
+ i = DBL_DIG - nd;
+ if (e <= Ten_pmax + i) {
+ /* A fancier test would sometimes let us do
+ * this for larger i values.
+ */
+ e -= i;
+ rv *= tens[i];
+#ifdef VAX
+ /* VAX exponent range is so narrow we must
+ * worry about overflow here...
+ */
+ vax_ovfl_check:
+ addword0(rv, - P*Exp_msk1);
+ /* rv = */ rounded_product(rv, tens[e]);
+ if ((word0(rv) & Exp_mask)
+ > Exp_msk1*(DBL_MAX_EXP+Bias-1-P))
+ goto ovfl;
+ addword0(rv, P*Exp_msk1);
+#else
+ /* rv = */ rounded_product(rv, tens[e]);
+#endif
+ goto ret;
+ }
+ }
+#ifndef Inaccurate_Divide
+ else if (e >= -Ten_pmax) {
+ /* rv = */ rounded_quotient(rv, tens[-e]);
+ goto ret;
+ }
+#endif
+ }
+ e1 += nd - k;
+
+ /* Get starting approximation = rv * 10**e1 */
+
+ if (e1 > 0) {
+ if ((i = e1 & 15))
+ rv *= tens[i];
+ if (e1 &= ~15) {
+ if (e1 > DBL_MAX_10_EXP) {
+ ovfl:
+ errno = ERANGE;
+#if defined(sun) && !defined(__svr4__)
+/* SunOS defines HUGE_VAL as __infinity(), which is in libm. */
+#undef HUGE_VAL
+#endif
+#ifndef HUGE_VAL
+#define HUGE_VAL 1.7976931348623157E+308
+#endif
+ rv = HUGE_VAL;
+ goto ret;
+ }
+ if (e1 >>= 4) {
+ for(j = 0; e1 > 1; j++, e1 >>= 1)
+ if (e1 & 1)
+ rv *= bigtens[j];
+ /* The last multiplication could overflow. */
+ addword0(rv, -P*Exp_msk1);
+ rv *= bigtens[j];
+ if ((z = word0(rv) & Exp_mask)
+ > Exp_msk1*(DBL_MAX_EXP+Bias-P))
+ goto ovfl;
+ if (z > Exp_msk1*(DBL_MAX_EXP+Bias-1-P)) {
+ /* set to largest number */
+ /* (Can't trust DBL_MAX) */
+ setwords(rv, Big0, Big1);
+ }
+ else
+ addword0(rv, P*Exp_msk1);
+ }
+
+ }
+ }
+ else if (e1 < 0) {
+ e1 = -e1;
+ if ((i = e1 & 15))
+ rv /= tens[i];
+ if (e1 &= ~15) {
+ e1 >>= 4;
+ for(j = 0; e1 > 1; j++, e1 >>= 1)
+ if (e1 & 1)
+ rv *= tinytens[j];
+ /* The last multiplication could underflow. */
+ rv0 = rv;
+ rv *= tinytens[j];
+ if (!rv) {
+ rv = 2.*rv0;
+ rv *= tinytens[j];
+ if (!rv) {
+ undfl:
+ rv = 0.;
+ errno = ERANGE;
+ goto ret;
+ }
+ setwords(rv, Tiny0, Tiny1);
+ /* The refinement below will clean
+ * this approximation up.
+ */
+ }
+ }
+ }
+
+ /* Now the hard part -- adjusting rv to the correct value.*/
+
+ /* Put digits into bd: true value = bd * 10^e */
+
+ bd0 = s2b(bd0, s0, nd0, nd, y);
+ bd = Brealloc(bd, bd0->k);
+
+ for(;;) {
+ Bcopy(bd, bd0);
+ bb = d2b(bb, rv, &bbe, &bbbits); /* rv = bb * 2^bbe */
+ bs = i2b(bs, 1);
+
+ if (e >= 0) {
+ bb2 = bb5 = 0;
+ bd2 = bd5 = e;
+ }
+ else {
+ bb2 = bb5 = -e;
+ bd2 = bd5 = 0;
+ }
+ if (bbe >= 0)
+ bb2 += bbe;
+ else
+ bd2 -= bbe;
+ bs2 = bb2;
+#ifdef Sudden_Underflow
+#ifdef IBM
+ j = 1 + 4*P - 3 - bbbits + ((bbe + bbbits - 1) & 3);
+#else
+ j = P + 1 - bbbits;
+#endif
+#else
+ i = bbe + bbbits - 1; /* logb(rv) */
+ if (i < Emin) /* denormal */
+ j = bbe + (P-Emin);
+ else
+ j = P + 1 - bbbits;
+#endif
+ bb2 += j;
+ bd2 += j;
+ i = bb2 < bd2 ? bb2 : bd2;
+ if (i > bs2)
+ i = bs2;
+ if (i > 0) {
+ bb2 -= i;
+ bd2 -= i;
+ bs2 -= i;
+ }
+ if (bb5 > 0) {
+ Bigint *b_tmp;
+ bs = pow5mult(bs, bb5);
+ b_tmp = mult(b_avail, bs, bb);
+ b_avail = bb;
+ bb = b_tmp;
+ }
+ if (bb2 > 0)
+ bb = lshift(bb, bb2);
+ if (bd5 > 0)
+ bd = pow5mult(bd, bd5);
+ if (bd2 > 0)
+ bd = lshift(bd, bd2);
+ if (bs2 > 0)
+ bs = lshift(bs, bs2);
+ delta = diff(delta, bb, bd);
+ dsign = delta->sign;
+ delta->sign = 0;
+ i = cmp(delta, bs);
+ if (i < 0) {
+ /* Error is less than half an ulp -- check for
+ * special case of mantissa a power of two.
+ */
+ if (dsign || word1(rv) || word0(rv) & Bndry_mask)
+ break;
+ delta = lshift(delta,Log2P);
+ if (cmp(delta, bs) > 0)
+ goto drop_down;
+ break;
+ }
+ if (i == 0) {
+ /* exactly half-way between */
+ if (dsign) {
+ if ((word0(rv) & Bndry_mask1) == Bndry_mask1
+ && word1(rv) == 0xffffffff) {
+ /*boundary case -- increment exponent*/
+ setword0(rv, (word0(rv) & Exp_mask)
+ + Exp_msk1);
+#ifdef IBM
+ setword0 (rv,
+ word0(rv) | (Exp_msk1 >> 4));
+#endif
+ setword1(rv, 0);
+ break;
+ }
+ }
+ else if (!(word0(rv) & Bndry_mask) && !word1(rv)) {
+ drop_down:
+ /* boundary case -- decrement exponent */
+#ifdef Sudden_Underflow
+ L = word0(rv) & Exp_mask;
+#ifdef IBM
+ if (L < Exp_msk1)
+#else
+ if (L <= Exp_msk1)
+#endif
+ goto undfl;
+ L -= Exp_msk1;
+#else
+ L = (word0(rv) & Exp_mask) - Exp_msk1;
+#endif
+ setwords(rv, L | Bndry_mask1, 0xffffffff);
+#ifdef IBM
+ continue;
+#else
+ break;
+#endif
+ }
+#ifndef ROUND_BIASED
+ if (!(word1(rv) & LSB))
+ break;
+#endif
+ if (dsign)
+ rv += ulp(rv);
+#ifndef ROUND_BIASED
+ else {
+ rv -= ulp(rv);
+#ifndef Sudden_Underflow
+ if (!rv)
+ goto undfl;
+#endif
+ }
+#endif
+ break;
+ }
+ if ((aadj = ratio(delta, bs)) <= 2.) {
+ if (dsign)
+ aadj = aadj1 = 1.;
+ else if (word1(rv) || word0(rv) & Bndry_mask) {
+#ifndef Sudden_Underflow
+ if (word1(rv) == Tiny1 && !word0(rv))
+ goto undfl;
+#endif
+ aadj = 1.;
+ aadj1 = -1.;
+ }
+ else {
+ /* special case -- power of FLT_RADIX to be */
+ /* rounded down... */
+
+ if (aadj < 2./FLT_RADIX)
+ aadj = 1./FLT_RADIX;
+ else
+ aadj *= 0.5;
+ aadj1 = -aadj;
+ }
+ }
+ else {
+ aadj *= 0.5;
+ aadj1 = dsign ? aadj : -aadj;
+#ifdef Check_FLT_ROUNDS
+ switch(FLT_ROUNDS) {
+ case 2: /* towards +infinity */
+ aadj1 -= 0.5;
+ break;
+ case 0: /* towards 0 */
+ case 3: /* towards -infinity */
+ aadj1 += 0.5;
+ }
+#else
+ if (FLT_ROUNDS == 0)
+ aadj1 += 0.5;
+#endif
+ }
+ y = word0(rv) & Exp_mask;
+
+ /* Check for overflow */
+
+ if (y == Exp_msk1*(DBL_MAX_EXP+Bias-1)) {
+ rv0 = rv;
+ addword0(rv, - P*Exp_msk1);
+ adj = aadj1 * ulp(rv);
+ rv += adj;
+ if ((word0(rv) & Exp_mask) >=
+ Exp_msk1*(DBL_MAX_EXP+Bias-P)) {
+ if (word0(rv0) == Big0 && word1(rv0) == Big1)
+ goto ovfl;
+ setwords(rv, Big0, Big1);
+ continue;
+ }
+ else
+ addword0(rv, P*Exp_msk1);
+ }
+ else {
+#ifdef Sudden_Underflow
+ if ((word0(rv) & Exp_mask) <= P*Exp_msk1) {
+ rv0 = rv;
+ addword0(rv, P*Exp_msk1);
+ adj = aadj1 * ulp(rv);
+ rv += adj;
+#ifdef IBM
+ if ((word0(rv) & Exp_mask) < P*Exp_msk1)
+#else
+ if ((word0(rv) & Exp_mask) <= P*Exp_msk1)
+#endif
+ {
+ if (word0(rv0) == Tiny0
+ && word1(rv0) == Tiny1)
+ goto undfl;
+ setwords(rv, Tiny0, Tiny1);
+ continue;
+ }
+ else
+ addword0(rv, -P*Exp_msk1);
+ }
+ else {
+ adj = aadj1 * ulp(rv);
+ rv += adj;
+ }
+#else
+ /* Compute adj so that the IEEE rounding rules will
+ * correctly round rv + adj in some half-way cases.
+ * If rv * ulp(rv) is denormalized (i.e.,
+ * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
+ * trouble from bits lost to denormalization;
+ * example: 1.2e-307 .
+ */
+ if (y <= (P-1)*Exp_msk1 && aadj >= 1.) {
+ aadj1 = (double)(int)(aadj + 0.5);
+ if (!dsign)
+ aadj1 = -aadj1;
+ }
+ adj = aadj1 * ulp(rv);
+ rv += adj;
+#endif
+ }
+ z = word0(rv) & Exp_mask;
+ if (y == z) {
+ /* Can we stop now? */
+ L = (_G_int32_t)aadj;
+ aadj -= L;
+ /* The tolerances below are conservative. */
+ if (dsign || word1(rv) || word0(rv) & Bndry_mask) {
+ if (aadj < .4999999 || aadj > .5000001)
+ break;
+ }
+ else if (aadj < .4999999/FLT_RADIX)
+ break;
+ }
+ }
+ Bfree(bb);
+ Bfree(bd);
+ Bfree(bs);
+ Bfree(bd0);
+ Bfree(delta);
+ Bfree(b_avail);
+ ret:
+ if (se)
+ *se = (char *)s;
+ return sign ? -rv : rv;
+ }
+
+static int
+quorem
+#ifdef KR_headers
+ (b, S) Bigint *b, *S;
+#else
+ (Bigint *b, Bigint *S)
+#endif
+{
+ int n;
+ _G_int32_t borrow, y;
+ unsigned32 carry, q, ys;
+ unsigned32 *bx, *bxe, *sx, *sxe;
+ _G_int32_t z;
+ unsigned32 si, zs;
+
+ n = S->wds;
+#ifdef DEBUG
+ /*debug*/ if (b->wds > n)
+ /*debug*/ Bug("oversize b in quorem");
+#endif
+ if (b->wds < n)
+ return 0;
+ sx = S->x;
+ sxe = sx + --n;
+ bx = b->x;
+ bxe = bx + n;
+ q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
+#ifdef DEBUG
+ /*debug*/ if (q > 9)
+ /*debug*/ Bug("oversized quotient in quorem");
+#endif
+ if (q) {
+ borrow = 0;
+ carry = 0;
+ do {
+ si = *sx++;
+ ys = (si & 0xffff) * q + carry;
+ zs = (si >> 16) * q + (ys >> 16);
+ carry = zs >> 16;
+ y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
+ borrow = y >> 16;
+ Sign_Extend(borrow, y);
+ z = (*bx >> 16) - (zs & 0xffff) + borrow;
+ borrow = z >> 16;
+ Sign_Extend(borrow, z);
+ Storeinc(bx, z, y);
+ }
+ while(sx <= sxe);
+ if (!*bxe) {
+ bx = b->x;
+ while(--bxe > bx && !*bxe)
+ --n;
+ b->wds = n;
+ }
+ }
+ if (cmp(b, S) >= 0) {
+ q++;
+ borrow = 0;
+ carry = 0;
+ bx = b->x;
+ sx = S->x;
+ do {
+ si = *sx++;
+ ys = (si & 0xffff) + carry;
+ zs = (si >> 16) + (ys >> 16);
+ carry = zs >> 16;
+ y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
+ borrow = y >> 16;
+ Sign_Extend(borrow, y);
+ z = (*bx >> 16) - (zs & 0xffff) + borrow;
+ borrow = z >> 16;
+ Sign_Extend(borrow, z);
+ Storeinc(bx, z, y);
+ }
+ while(sx <= sxe);
+ bx = b->x;
+ bxe = bx + n;
+ if (!*bxe) {
+ while(--bxe > bx && !*bxe)
+ --n;
+ b->wds = n;
+ }
+ }
+ return q;
+ }
+
+/* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
+ *
+ * Inspired by "How to Print Floating-Point Numbers Accurately" by
+ * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 92-101].
+ *
+ * Modifications:
+ * 1. Rather than iterating, we use a simple numeric overestimate
+ * to determine k = floor(log10(d)). We scale relevant
+ * quantities using O(log2(k)) rather than O(k) multiplications.
+ * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
+ * try to generate digits strictly left to right. Instead, we
+ * compute with fewer bits and propagate the carry if necessary
+ * when rounding the final digit up. This is often faster.
+ * 3. Under the assumption that input will be rounded nearest,
+ * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
+ * That is, we allow equality in stopping tests when the
+ * round-nearest rule will give the same floating-point value
+ * as would satisfaction of the stopping test with strict
+ * inequality.
+ * 4. We remove common factors of powers of 2 from relevant
+ * quantities.
+ * 5. When converting floating-point integers less than 1e16,
+ * we use floating-point arithmetic rather than resorting
+ * to multiple-precision integers.
+ * 6. When asked to produce fewer than 15 digits, we first try
+ * to get by with floating-point arithmetic; we resort to
+ * multiple-precision integer arithmetic only if we cannot
+ * guarantee that the floating-point calculation has given
+ * the correctly rounded result. For k requested digits and
+ * "uniformly" distributed input, the probability is
+ * something like 10^(k-15) that we must resort to the long
+ * calculation.
+ */
+
+ char *
+_IO_dtoa
+#ifdef KR_headers
+ (d, mode, ndigits, decpt, sign, rve)
+ double d; int mode, ndigits, *decpt, *sign; char **rve;
+#else
+ (double d, int mode, int ndigits, int *decpt, int *sign, char **rve)
+#endif
+{
+ /* Arguments ndigits, decpt, sign are similar to those
+ of ecvt and fcvt; trailing zeros are suppressed from
+ the returned string. If not null, *rve is set to point
+ to the end of the return value. If d is +-Infinity or NaN,
+ then *decpt is set to 9999.
+
+ mode:
+ 0 ==> shortest string that yields d when read in
+ and rounded to nearest.
+ 1 ==> like 0, but with Steele & White stopping rule;
+ e.g. with IEEE P754 arithmetic , mode 0 gives
+ 1e23 whereas mode 1 gives 9.999999999999999e22.
+ 2 ==> max(1,ndigits) significant digits. This gives a
+ return value similar to that of ecvt, except
+ that trailing zeros are suppressed.
+ 3 ==> through ndigits past the decimal point. This
+ gives a return value similar to that from fcvt,
+ except that trailing zeros are suppressed, and
+ ndigits can be negative.
+ 4-9 should give the same return values as 2-3, i.e.,
+ 4 <= mode <= 9 ==> same return as mode
+ 2 + (mode & 1). These modes are mainly for
+ debugging; often they run slower but sometimes
+ faster than modes 2-3.
+ 4,5,8,9 ==> left-to-right digit generation.
+ 6-9 ==> don't try fast floating-point estimate
+ (if applicable).
+
+ Values of mode other than 0-9 are treated as mode 0.
+
+ Sufficient space is allocated to the return value
+ to hold the suppressed trailing zeros.
+ */
+
+ _G_int32_t bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1,
+ j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
+ spec_case, try_quick;
+ _G_int32_t L;
+#ifndef Sudden_Underflow
+ int denorm;
+#endif
+ Bigint _b_avail, _b, _mhi, _mlo, _S;
+ Bigint *b_avail = Binit(&_b_avail);
+ Bigint *b = Binit(&_b);
+ Bigint *S = Binit(&_S);
+ /* mhi and mlo are only set and used if leftright. */
+ Bigint *mhi = NULL, *mlo = NULL;
+ double d2, ds, eps;
+ char *s, *s0;
+ static Bigint *result = NULL;
+ static int result_k;
+
+ TEST_ENDIANNESS;
+ if (result) {
+ /* result is contains a string, so its fields (interpreted
+ as a Bigint have been trashed. Restore them.
+ This is a really ugly interface - result should
+ not be static, since that is not thread-safe. FIXME. */
+ result->k = result_k;
+ result->maxwds = 1 << result_k;
+ result->on_stack = 0;
+ }
+
+ if (word0(d) & Sign_bit) {
+ /* set sign for everything, including 0's and NaNs */
+ *sign = 1;
+ setword0(d, word0(d) & ~Sign_bit); /* clear sign bit */
+ }
+ else
+ *sign = 0;
+
+#if defined(IEEE_Arith) + defined(VAX)
+#ifdef IEEE_Arith
+ if ((word0(d) & Exp_mask) == Exp_mask)
+#else
+ if (word0(d) == 0x8000)
+#endif
+ {
+ /* Infinity or NaN */
+ *decpt = 9999;
+#ifdef IEEE_Arith
+ if (!word1(d) && !(word0(d) & 0xfffff))
+ {
+ s = "Infinity";
+ if (rve)
+ *rve = s + 8;
+ }
+ else
+#endif
+ {
+ s = "NaN";
+ if (rve)
+ *rve = s +3;
+ }
+ return s;
+ }
+#endif
+#ifdef IBM
+ d += 0; /* normalize */
+#endif
+ if (!d) {
+ *decpt = 1;
+ s = "0";
+ if (rve)
+ *rve = s + 1;
+ return s;
+ }
+
+ b = d2b(b, d, &be, &bbits);
+ i = (int)(word0(d) >> Exp_shift1 & (Exp_mask>>Exp_shift1));
+#ifndef Sudden_Underflow
+ if (i) {
+#endif
+ d2 = d;
+ setword0(d2, (word0(d2) & Frac_mask1) | Exp_11);
+#ifdef IBM
+ if (j = 11 - hi0bits(word0(d2) & Frac_mask))
+ d2 /= 1 << j;
+#endif
+
+ i -= Bias;
+#ifdef IBM
+ i <<= 2;
+ i += j;
+#endif
+#ifndef Sudden_Underflow
+ denorm = 0;
+ }
+ else {
+ /* d is denormalized */
+ unsigned32 x;
+
+ i = bbits + be + (Bias + (P-1) - 1);
+ x = i > 32 ? word0(d) << (64 - i) | word1(d) >> (i - 32)
+ : word1(d) << (32 - i);
+ d2 = x;
+ addword0(d2, - 31*Exp_msk1); /* adjust exponent */
+ i -= (Bias + (P-1) - 1) + 1;
+ denorm = 1;
+ }
+#endif
+
+ /* Now i is the unbiased base-2 exponent. */
+
+ /* log(x) ~=~ log(1.5) + (x-1.5)/1.5
+ * log10(x) = log(x) / log(10)
+ * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
+ * log10(d) = i*log(2)/log(10) + log10(d2)
+ *
+ * This suggests computing an approximation k to log10(d) by
+ *
+ * k = i*0.301029995663981
+ * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
+ *
+ * We want k to be too large rather than too small.
+ * The error in the first-order Taylor series approximation
+ * is in our favor, so we just round up the constant enough
+ * to compensate for any error in the multiplication of
+ * (i) by 0.301029995663981; since |i| <= 1077,
+ * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
+ * adding 1e-13 to the constant term more than suffices.
+ * Hence we adjust the constant term to 0.1760912590558.
+ * (We could get a more accurate k by invoking log10,
+ * but this is probably not worthwhile.)
+ */
+
+ ds = (d2-1.5)*0.289529654602168 + 0.1760912590558 + i*0.301029995663981;
+ k = (int)ds;
+ if (ds < 0. && ds != k)
+ k--; /* want k = floor(ds) */
+ k_check = 1;
+ if (k >= 0 && k <= Ten_pmax) {
+ if (d < tens[k])
+ k--;
+ k_check = 0;
+ }
+ j = bbits - i - 1;
+ if (j >= 0) {
+ b2 = 0;
+ s2 = j;
+ }
+ else {
+ b2 = -j;
+ s2 = 0;
+ }
+ if (k >= 0) {
+ b5 = 0;
+ s5 = k;
+ s2 += k;
+ }
+ else {
+ b2 -= k;
+ b5 = -k;
+ s5 = 0;
+ }
+ if (mode < 0 || mode > 9)
+ mode = 0;
+ try_quick = 1;
+ if (mode > 5) {
+ mode -= 4;
+ try_quick = 0;
+ }
+ leftright = 1;
+ switch(mode) {
+ case 0:
+ case 1:
+ ilim = ilim1 = -1;
+ i = 18;
+ ndigits = 0;
+ break;
+ case 2:
+ leftright = 0;
+ /* no break */
+ case 4:
+ if (ndigits <= 0)
+ ndigits = 1;
+ ilim = ilim1 = i = ndigits;
+ break;
+ case 3:
+ leftright = 0;
+ /* no break */
+ case 5:
+ i = ndigits + k + 1;
+ ilim = i;
+ ilim1 = i - 1;
+ if (i <= 0)
+ i = 1;
+ }
+ /* i is now an upper bound of the number of digits to generate. */
+ j = sizeof(unsigned32) * (1<<BIGINT_MINIMUM_K);
+ /* The test is <= so as to allow room for the final '\0'. */
+ for(result_k = BIGINT_MINIMUM_K; BIGINT_HEADER_SIZE + j <= i;
+ j <<= 1) result_k++;
+ if (!result || result_k > result->k)
+ {
+ Bfree (result);
+ result = Balloc(result_k);
+ }
+ s = s0 = (char *)result;
+
+ if (ilim >= 0 && ilim <= Quick_max && try_quick) {
+
+ /* Try to get by with floating-point arithmetic. */
+
+ i = 0;
+ d2 = d;
+ k0 = k;
+ ilim0 = ilim;
+ ieps = 2; /* conservative */
+ if (k > 0) {
+ ds = tens[k&0xf];
+ j = k >> 4;
+ if (j & Bletch) {
+ /* prevent overflows */
+ j &= Bletch - 1;
+ d /= bigtens[n_bigtens-1];
+ ieps++;
+ }
+ for(; j; j >>= 1, i++)
+ if (j & 1) {
+ ieps++;
+ ds *= bigtens[i];
+ }
+ d /= ds;
+ }
+ else if ((j1 = -k)) {
+ d *= tens[j1 & 0xf];
+ for(j = j1 >> 4; j; j >>= 1, i++)
+ if (j & 1) {
+ ieps++;
+ d *= bigtens[i];
+ }
+ }
+ if (k_check && d < 1. && ilim > 0) {
+ if (ilim1 <= 0)
+ goto fast_failed;
+ ilim = ilim1;
+ k--;
+ d *= 10.;
+ ieps++;
+ }
+ eps = ieps*d + 7.;
+ addword0(eps, - (P-1)*Exp_msk1);
+ if (ilim == 0) {
+ d -= 5.;
+ if (d > eps)
+ goto one_digit;
+ if (d < -eps)
+ goto no_digits;
+ goto fast_failed;
+ }
+#ifndef No_leftright
+ if (leftright) {
+ /* Use Steele & White method of only
+ * generating digits needed.
+ */
+ eps = 0.5/tens[ilim-1] - eps;
+ for(i = 0;;) {
+ L = (_G_int32_t)d;
+ d -= L;
+ *s++ = '0' + (int)L;
+ if (d < eps)
+ goto ret1;
+ if (1. - d < eps)
+ goto bump_up;
+ if (++i >= ilim)
+ break;
+ eps *= 10.;
+ d *= 10.;
+ }
+ }
+ else {
+#endif
+ /* Generate ilim digits, then fix them up. */
+ eps *= tens[ilim-1];
+ for(i = 1;; i++, d *= 10.) {
+ L = (_G_int32_t)d;
+ d -= L;
+ *s++ = '0' + (int)L;
+ if (i == ilim) {
+ if (d > 0.5 + eps)
+ goto bump_up;
+ else if (d < 0.5 - eps) {
+ while(*--s == '0');
+ s++;
+ goto ret1;
+ }
+ break;
+ }
+ }
+#ifndef No_leftright
+ }
+#endif
+ fast_failed:
+ s = s0;
+ d = d2;
+ k = k0;
+ ilim = ilim0;
+ }
+
+ /* Do we have a "small" integer? */
+
+ if (be >= 0 && k <= Int_max) {
+ /* Yes. */
+ ds = tens[k];
+ if (ndigits < 0 && ilim <= 0) {
+ if (ilim < 0 || d <= 5*ds)
+ goto no_digits;
+ goto one_digit;
+ }
+ for(i = 1;; i++) {
+ L = (_G_int32_t)(d / ds);
+ d -= L*ds;
+#ifdef Check_FLT_ROUNDS
+ /* If FLT_ROUNDS == 2, L will usually be high by 1 */
+ if (d < 0) {
+ L--;
+ d += ds;
+ }
+#endif
+ *s++ = '0' + (int)L;
+ if (i == ilim) {
+ d += d;
+ if (d > ds || (d == ds && L & 1)) {
+ bump_up:
+ while(*--s == '9')
+ if (s == s0) {
+ k++;
+ *s = '0';
+ break;
+ }
+ ++*s++;
+ }
+ break;
+ }
+ if (!(d *= 10.))
+ break;
+ }
+ goto ret1;
+ }
+
+ m2 = b2;
+ m5 = b5;
+ if (leftright) {
+ if (mode < 2) {
+ i =
+#ifndef Sudden_Underflow
+ denorm ? be + (Bias + (P-1) - 1 + 1) :
+#endif
+#ifdef IBM
+ 1 + 4*P - 3 - bbits + ((bbits + be - 1) & 3);
+#else
+ 1 + P - bbits;
+#endif
+ }
+ else {
+ j = ilim - 1;
+ if (m5 >= j)
+ m5 -= j;
+ else {
+ s5 += j -= m5;
+ b5 += j;
+ m5 = 0;
+ }
+ if ((i = ilim) < 0) {
+ m2 -= i;
+ i = 0;
+ }
+ }
+ b2 += i;
+ s2 += i;
+ mhi = i2b(Binit(&_mhi), 1);
+ }
+ if (m2 > 0 && s2 > 0) {
+ i = m2 < s2 ? m2 : s2;
+ b2 -= i;
+ m2 -= i;
+ s2 -= i;
+ }
+ if (b5 > 0) {
+ if (leftright) {
+ if (m5 > 0) {
+ Bigint *b_tmp;
+ mhi = pow5mult(mhi, m5);
+ b_tmp = mult(b_avail, mhi, b);
+ b_avail = b;
+ b = b_tmp;
+ }
+ if ((j = b5 - m5))
+ b = pow5mult(b, j);
+ }
+ else
+ b = pow5mult(b, b5);
+ }
+ S = i2b(S, 1);
+ if (s5 > 0)
+ S = pow5mult(S, s5);
+
+ /* Check for special case that d is a normalized power of 2. */
+
+ if (mode < 2) {
+ if (!word1(d) && !(word0(d) & Bndry_mask)
+#ifndef Sudden_Underflow
+ && word0(d) & Exp_mask
+#endif
+ ) {
+ /* The special case */
+ b2 += Log2P;
+ s2 += Log2P;
+ spec_case = 1;
+ }
+ else
+ spec_case = 0;
+ }
+
+ /* Arrange for convenient computation of quotients:
+ * shift left if necessary so divisor has 4 leading 0 bits.
+ *
+ * Perhaps we should just compute leading 28 bits of S once
+ * and for all and pass them and a shift to quorem, so it
+ * can do shifts and ors to compute the numerator for q.
+ */
+ if ((i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f))
+ i = 32 - i;
+ if (i > 4) {
+ i -= 4;
+ b2 += i;
+ m2 += i;
+ s2 += i;
+ }
+ else if (i < 4) {
+ i += 28;
+ b2 += i;
+ m2 += i;
+ s2 += i;
+ }
+ if (b2 > 0)
+ b = lshift(b, b2);
+ if (s2 > 0)
+ S = lshift(S, s2);
+ if (k_check) {
+ if (cmp(b,S) < 0) {
+ k--;
+ b = multadd(b, 10, 0); /* we botched the k estimate */
+ if (leftright)
+ mhi = multadd(mhi, 10, 0);
+ ilim = ilim1;
+ }
+ }
+ if (ilim <= 0 && mode > 2) {
+ if (ilim < 0 || cmp(b,S = multadd(S,5,0)) <= 0) {
+ /* no digits, fcvt style */
+ no_digits:
+ k = -1 - ndigits;
+ goto ret;
+ }
+ one_digit:
+ *s++ = '1';
+ k++;
+ goto ret;
+ }
+ if (leftright) {
+ if (m2 > 0)
+ mhi = lshift(mhi, m2);
+
+ /* Compute mlo -- check for special case
+ * that d is a normalized power of 2.
+ */
+
+ if (spec_case) {
+ mlo = Brealloc(Binit(&_mlo), mhi->k);
+ Bcopy(mlo, mhi);
+ mhi = lshift(mhi, Log2P);
+ }
+ else
+ mlo = mhi;
+
+ for(i = 1;;i++) {
+ dig = quorem(b,S) + '0';
+ /* Do we yet have the shortest decimal string
+ * that will round to d?
+ */
+ j = cmp(b, mlo);
+ b_avail = diff(b_avail, S, mhi); /* b_avail = S - mi */
+ j1 = b_avail->sign ? 1 : cmp(b, b_avail);
+#ifndef ROUND_BIASED
+ if (j1 == 0 && !mode && !(word1(d) & 1)) {
+ if (dig == '9')
+ goto round_9_up;
+ if (j > 0)
+ dig++;
+ *s++ = dig;
+ goto ret;
+ }
+#endif
+ if (j < 0 || (j == 0 && !mode
+#ifndef ROUND_BIASED
+ && !(word1(d) & 1)
+#endif
+ )) {
+ if (j1 > 0) {
+ b = lshift(b, 1);
+ j1 = cmp(b, S);
+ if ((j1 > 0 || (j1 == 0 && dig & 1))
+ && dig++ == '9')
+ goto round_9_up;
+ }
+ *s++ = dig;
+ goto ret;
+ }
+ if (j1 > 0) {
+ if (dig == '9') { /* possible if i == 1 */
+ round_9_up:
+ *s++ = '9';
+ goto roundoff;
+ }
+ *s++ = dig + 1;
+ goto ret;
+ }
+ *s++ = dig;
+ if (i == ilim)
+ break;
+ b = multadd(b, 10, 0);
+ if (mlo == mhi)
+ mlo = mhi = multadd(mhi, 10, 0);
+ else {
+ mlo = multadd(mlo, 10, 0);
+ mhi = multadd(mhi, 10, 0);
+ }
+ }
+ }
+ else
+ for(i = 1;; i++) {
+ *s++ = dig = quorem(b,S) + '0';
+ if (i >= ilim)
+ break;
+ b = multadd(b, 10, 0);
+ }
+
+ /* Round off last digit */
+
+ b = lshift(b, 1);
+ j = cmp(b, S);
+ if (j > 0 || (j == 0 && dig & 1)) {
+ roundoff:
+ while(*--s == '9')
+ if (s == s0) {
+ k++;
+ *s++ = '1';
+ goto ret;
+ }
+ ++*s++;
+ }
+ else {
+ while(*--s == '0');
+ s++;
+ }
+ ret:
+ Bfree(b_avail);
+ Bfree(S);
+ if (mhi) {
+ if (mlo && mlo != mhi)
+ Bfree(mlo);
+ Bfree(mhi);
+ }
+ ret1:
+ Bfree(b);
+ *s = 0;
+ *decpt = k + 1;
+ if (rve)
+ *rve = s;
+ return s0;
+ }
+#endif /* _IO_USE_DTOA */
diff --git a/libio/floatio.h b/libio/floatio.h
new file mode 100644
index 00000000000..827767bde35
--- /dev/null
+++ b/libio/floatio.h
@@ -0,0 +1,51 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/*
+ * Copyright (c) 1990 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that the above copyright notice and this paragraph are
+ * duplicated in all such forms and that any documentation,
+ * advertising materials, and other materials related to such
+ * distribution and use acknowledge that the software was developed
+ * by the University of California, Berkeley. The name of the
+ * University may not be used to endorse or promote products derived
+ * from this software without specific prior written permission.
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ *
+ * %W% (Berkeley) %G%
+ */
+
+/*
+ * Floating point scanf/printf (input/output) definitions.
+ */
+
+/* 11-bit exponent (VAX G floating point) is 308 decimal digits */
+#define MAXEXP 308
+/* 128 bit fraction takes up 39 decimal digits; max reasonable precision */
+#define MAXFRACT 39
diff --git a/libio/fstream.cc b/libio/fstream.cc
new file mode 100644
index 00000000000..8930e0b9271
--- /dev/null
+++ b/libio/fstream.cc
@@ -0,0 +1,110 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+
+Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#define _STREAM_COMPAT
+extern "C" {
+#include "libioP.h"
+}
+#include <fstream.h>
+
+inline void
+fstreambase::__fb_init()
+{
+#ifdef _IO_NEW_STREAMS
+#if !_IO_UNIFIED_JUMPTABLES
+ /* Uses the _IO_file_jump jumptable, for eficiency. */
+ __my_fb._jumps = &_IO_file_jumps;
+ __my_fb._vtable() = builtinbuf_vtable;
+#endif
+ init (&__my_fb);
+#else
+ init(filebuf::__new());
+ _flags &= ~ios::dont_close;
+#endif
+}
+
+fstreambase::fstreambase()
+{
+ __fb_init ();
+}
+
+fstreambase::fstreambase(int fd)
+{
+ __fb_init ();
+ _IO_file_attach(rdbuf(), fd);
+}
+
+fstreambase::fstreambase(const char *name, int mode, int prot)
+{
+ __fb_init ();
+ if (!rdbuf()->open(name, mode, prot))
+ set(ios::badbit);
+}
+
+fstreambase::fstreambase(int fd, char *p, int l)
+{
+#ifdef _IO_NEW_STREAMS
+ __fb_init ();
+#else
+ init(filebuf::__new());
+#endif
+ _IO_file_attach(rdbuf(), fd);
+ _IO_file_setbuf(rdbuf(), p, l);
+}
+
+void fstreambase::open(const char *name, int mode, int prot)
+{
+ clear();
+ if (!rdbuf()->open(name, mode, prot))
+ set(ios::badbit);
+}
+
+void fstreambase::close()
+{
+ if (!rdbuf()->close())
+ set(ios::failbit);
+}
+
+void fstreambase::attach(int fd)
+{
+ if (!rdbuf()->attach(fd))
+ set(ios::failbit);
+}
+
+#if 0
+static int mode_to_sys(enum open_mode mode)
+{
+ return O_WRONLY;
+}
+
+static char* fopen_cmd_arg(io_mode i)
+{
+ return "w";
+}
+#endif
diff --git a/libio/fstream.h b/libio/fstream.h
new file mode 100644
index 00000000000..ea98f5caed0
--- /dev/null
+++ b/libio/fstream.h
@@ -0,0 +1,92 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifndef _FSTREAM_H
+#define _FSTREAM_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+#include <iostream.h>
+
+extern "C++" {
+class fstreambase : virtual public ios {
+#ifdef _IO_NEW_STREAMS
+ mutable filebuf __my_fb; // mutable so rdbuf() can be const
+#endif
+ void __fb_init ();
+ public:
+ fstreambase();
+ fstreambase(int fd);
+ fstreambase(int fd, char *p, int l); /* Deprecated */
+ fstreambase(const char *name, int mode, int prot=0664);
+ void close();
+#ifdef _IO_NEW_STREAMS
+ filebuf* rdbuf() const { return &__my_fb; }
+#else
+ filebuf* rdbuf() const { return (filebuf*) ios::rdbuf(); }
+#endif
+ void open(const char *name, int mode, int prot=0664);
+ int is_open() const { return rdbuf()->is_open(); }
+ void setbuf(char *ptr, int len) { rdbuf()->setbuf(ptr, len); }
+ void attach(int fd);
+#ifdef _STREAM_COMPAT
+ int filedesc() { return rdbuf()->fd(); }
+ fstreambase& raw() { rdbuf()->setbuf(NULL, 0); return *this; }
+#endif
+};
+
+class ifstream : public fstreambase, public istream {
+ public:
+ ifstream() : fstreambase() { }
+ ifstream(int fd) : fstreambase(fd) { }
+ ifstream(int fd, char *p, int l) : fstreambase(fd, p, l) { } /*Deprecated*/
+ ifstream(const char *name, int mode=ios::in, int prot=0664)
+ : fstreambase(name, mode, prot) { }
+ void open(const char *name, int mode=ios::in, int prot=0664)
+ { fstreambase::open(name, mode, prot); }
+};
+
+class ofstream : public fstreambase, public ostream {
+ public:
+ ofstream() : fstreambase() { }
+ ofstream(int fd) : fstreambase(fd) { }
+ ofstream(int fd, char *p, int l) : fstreambase(fd, p, l) { } /*Deprecated*/
+ ofstream(const char *name, int mode=ios::out, int prot=0664)
+ : fstreambase(name, mode, prot) { }
+ void open(const char *name, int mode=ios::out, int prot=0664)
+ { fstreambase::open(name, mode, prot); }
+};
+
+class fstream : public fstreambase, public iostream {
+ public:
+ fstream() : fstreambase() { }
+ fstream(int fd) : fstreambase(fd) { }
+ fstream(const char *name, int mode, int prot=0664)
+ : fstreambase(name, mode, prot) { }
+ fstream(int fd, char *p, int l) : fstreambase(fd, p, l) { } /*Deprecated*/
+ void open(const char *name, int mode, int prot=0664)
+ { fstreambase::open(name, mode, prot); }
+};
+} // extern "C++"
+#endif /*!_FSTREAM_H*/
diff --git a/libio/gen-params b/libio/gen-params
new file mode 100755
index 00000000000..9fb7272dd83
--- /dev/null
+++ b/libio/gen-params
@@ -0,0 +1,698 @@
+#!/bin/sh
+# Copyright (C) 1992, 1993, 1994 Free Software Foundation
+#
+# This file is part of the GNU IO 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.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this library; see the file COPYING. If not, write to the Free
+# Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Written by Per Bothner (bothner@cygnus.com)
+
+# This is a shell-script that figures out various things about a
+# system, and writes (to stdout) a C-style include files with
+# suitable definitions, including all the standard Posix types.
+# It works by compiling various test programs -- some are run through
+# the C pre-processor, and the output examined.
+# The test programs are only compiled, not executed, so the script
+# should even if you're cross-compiling.
+# It uses $CC (which defaults to cc) to compile C programs (extension .c),
+# and $CXX (which defaults to gcc) to compile C++ programs (extension .C).
+# The shell-script is written for libg++.a.
+
+# Usage: gen-params [NAME1=name1 ...]
+# - where an assignment (such as size_t="unsigned int" means to
+# use that value, instead of trying to figure it out.
+
+# Uncomment following line for debugging
+# set -x
+
+SED=sed
+
+# Evaluate the arguments (which should be assignments):
+for arg in "$@"; do
+ # Quote arg (i.e. FOO=bar => FOO='bar'), then eval it.
+ eval `echo "$arg" | ${SED} -e "s|^\(.*\)=\(.*\)|\1='\2'|"`
+done
+
+macro_prefix=${macro_prefix-"_G_"}
+rootdir=`pwd`/..
+gccdir=${gccdir-${rootdir}/gcc}
+binutilsdir=${binutilsdir-${rootdir}/binutils}
+CC=${CC-`if [ -f ${gccdir}/xgcc ] ; \
+ then echo ${gccdir}/xgcc -B${gccdir}/ ; \
+ else echo cc ; fi`}
+CXX=${CXX-`if [ -f ${gccdir}/xgcc ] ; \
+ then echo ${gccdir}/xgcc -B${gccdir}/ ; \
+ else echo gcc ; fi`}
+CPP=${CPP-`echo ${CC} -E`}
+CONFIG_NM=${CONFIG_NM-`if [ -f ${binutilsdir}/nm.new ] ; \
+ then echo ${binutilsdir}/nm.new ; \
+ else echo nm ; fi`}
+
+cat <<!EOF!
+/* AUTOMATICALLY GENERATED; DO NOT EDIT! */
+#ifndef ${macro_prefix}config_h
+#define ${macro_prefix}config_h
+!EOF!
+
+if [ x"${LIB_VERSION}" != "x" ] ; then
+ echo "#define ${macro_prefix}LIB_VERSION" '"'${LIB_VERSION}'"'
+fi
+
+# This program is used to test if the compiler prepends '_' before identifiers.
+# It is also used to check the g++ uses '$' or '.' various places.
+
+if test -z "${NAMES_HAVE_UNDERSCORE}" -o -z "${DOLLAR_IN_LABEL}" \
+ -o -z "${VTABLE_LABEL_PREFIX}"; then
+ cat >dummy.h <<!EOF!
+#ifdef __GNUG__
+#pragma interface
+#endif
+ struct filebuf {
+ virtual int foo();
+ };
+!EOF!
+ cat >dummy.C <<!EOF!
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#include "dummy.h"
+ int filebuf::foo() { return 0; }
+ extern "C" int FUNC(int);
+ int FUNC(int i) { return i+10; }
+!EOF!
+
+ if ${CXX} -O -c dummy.C ; then
+ if test -z "${NAMES_HAVE_UNDERSCORE}" ; then
+ if test "`${CONFIG_NM} dummy.o | grep _FUNC`" != ""; then
+ NAMES_HAVE_UNDERSCORE=1
+ elif test "`${CONFIG_NM} dummy.o | grep FUNC`" != ""; then
+ NAMES_HAVE_UNDERSCORE=0
+ else
+ echo "${CONFIG_NM} failed to find FUNC in dummy.o!" 1>&2; exit -1;
+ fi
+ fi
+ echo "#define ${macro_prefix}NAMES_HAVE_UNDERSCORE ${NAMES_HAVE_UNDERSCORE}"
+
+ if test -z "${VTABLE_LABEL_PREFIX}" ; then
+ # Determine how virtual function tables are named. This is fragile,
+ # because different nm's produce output in different formats.
+ ${CONFIG_NM} dummy.o >TMP
+ if [ -n "`${SED} -n -e 's/ virtual table/nope/p' <TMP`" ] ; then
+ ${CONFIG_NM} --no-cplus dummy.o >TMP 2>/dev/null ||
+ ${CONFIG_NM} --no-demangle dummy.o >TMP 2>/dev/null ||
+ ${CONFIG_NM} dummy.o >TMP 2>/dev/null
+ fi
+ # First we look for a pattern that matches historical output from g++.
+ # We surround the actual label name by <> to separate it from
+ # other nm junk.
+ ${SED} -n -e 's/_*vt[$_.]7*filebuf/<&>/p' <TMP >dummy.out
+ # For paranoia's sake (e.g. if we're using some other C++ compiler)
+ # we try a more general pattern, and append the result.
+ grep -v foo <TMP \
+ | ${SED} -n -e 's/[a-zA-Z0-9_.$]*filebuf[a-zA-Z0-9_.$]*/<&>/p' \
+ >>dummy.out
+ # Now we get rid of the <>, and any other junk on the nm output line.
+ # (We get rid of <filebuf> in case nm included debugging output for
+ # class filebuf itself.) Finally, we select the first line of
+ # the result, and hope that's what we wanted!
+ vtab_name=`${SED} -n -e '/<filebuf>/d' -e 's/^.*<\(.*\)>.*$/\1/p' \
+ <dummy.out | ${SED} -n -e '1p'`
+ case "${vtab_name}" in
+ *7filebuf) echo "#define ${macro_prefix}VTABLE_LABEL_HAS_LENGTH 1" ;;
+ *) echo "#define ${macro_prefix}VTABLE_LABEL_HAS_LENGTH 0" ;;
+ esac
+ VTABLE_LABEL_PREFIX=`echo $vtab_name | ${SED} -e 's/7*filebuf//'`
+ fi
+ echo "#define ${macro_prefix}VTABLE_LABEL_PREFIX" '"'"${VTABLE_LABEL_PREFIX}"'"'
+ if [ "${VTABLE_LABEL_PREFIX}" = "__vt_" -o \
+ "${VTABLE_LABEL_PREFIX}" = "___vt_" ] ; then
+ echo "#define ${macro_prefix}USING_THUNKS"
+ fi
+
+ # VTABLE_LABEL_PREFIX_ID is the same as VTABLE_LABEL_PREFIX,
+ # but the former is a C identifier, while the latter is a quoted
+ # st
+ if [ -z ""`echo ${VTABLE_LABEL_PREFIX} | ${SED} -e 's/[a-zA-Z0-9_]//g'` ] ; then
+ if [ "${NAMES_HAVE_UNDERSCORE}" = "1" ] ; then
+ VTABLE_LABEL_PREFIX=`echo ${VTABLE_LABEL_PREFIX} | ${SED} -e 's/^_//'`
+ fi
+ echo "#define ${macro_prefix}VTABLE_LABEL_PREFIX_ID ${VTABLE_LABEL_PREFIX}"
+ fi
+
+# if test -n "${DOLLAR_IN_LABEL}" ; then
+# echo "#define ${macro_prefix}DOLLAR_IN_LABEL ${DOLLAR_IN_LABEL}"
+# elif test "`${CONFIG_NM} dummy.o | grep 'vt[$$]7filebuf'`" != ""; then
+# echo "#define ${macro_prefix}DOLLAR_IN_LABEL 1"
+# elif test "`${CONFIG_NM} dummy.o | grep 'vt[.]7filebuf'`" != ""; then
+# echo "#define ${macro_prefix}DOLLAR_IN_LABEL 0"
+# elif test "`${CONFIG_NM} dummy.o | grep 'vtbl__7filebuf'`" != ""; then
+# echo "#define ${macro_prefix}DOLLAR_IN_LABEL 0"
+# else
+# echo "gen-params: ${CONFIG_NM} failed to find vt[.\$]filebuf in dummy.o!" 1>&2; exit 1
+# fi
+ else
+ # The compile failed for some reason (no C++?)
+ echo "gen-params: could not compile dummy.C with ${CXX}" 1>&2; exit 1;
+ fi
+fi
+
+# A little test program to check if struct stat has st_blksize.
+cat >dummy.c <<!EOF!
+#include <sys/types.h>
+#include <sys/stat.h>
+int BLKSIZE(struct stat *st)
+{
+ return st->st_blksize;
+}
+!EOF!
+
+if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_ST_BLKSIZE 1"
+else
+ echo "#define ${macro_prefix}HAVE_ST_BLKSIZE 0"
+fi
+
+# A little test program to check if the name 'clog' is defined in libm,
+# as it is under DEC UNIX.
+cat >dummy.c <<!EOF!
+int clog;
+main () {}
+!EOF!
+
+if ${CC} dummy.c -lm 2>&1 >/dev/null | grep clog >/dev/null; then
+ echo "#define ${macro_prefix}CLOG_CONFLICT 1"
+fi
+
+echo ""
+
+# Next, generate definitions for the standard types (such as mode_t)
+# compatible with those in the standard C header files.
+# It works by a dummy program through the C pre-processor, and then
+# using sed to search for typedefs in the output.
+
+for hdr in wchar wctype; do
+ eval $hdr=0
+ cat >dummy.c <<EOF
+#include <${hdr}.h>
+EOF
+ if ${CPP} dummy.c >/dev/null 2>&1 ; then eval $hdr=1; fi
+done
+
+cat >dummy.c <<!EOF!
+#include <sys/types.h>
+#include <stddef.h>
+#ifdef __STDC__
+#include <stdarg.h>
+#else /* !__STDC__ */
+#include <varargs.h>
+#endif /* __STDC__ */
+#include <stdio.h>
+#include <time.h>
+#include <signal.h>
+#ifdef __STDC__
+#include <limits.h>
+#endif
+#if WCHAR == 1
+#include <wchar.h>
+#endif
+#if WCTYPE == 1
+#include <wctype.h>
+#endif
+#ifdef size_t
+typedef size_t Xsize_t;
+#elif defined(__SIZE_TYPE__)
+typedef __SIZE_TYPE__ Xsize_t;
+#endif
+#ifdef ptrdiff_t
+typedef ptrdiff_t Xptrdiff_t;
+#elif defined(__PTRDIFF_TYPE__)
+typedef __PTRDIFF_TYPE__ Xptrdiff_t;
+#endif
+#ifdef wchar_t
+typedef wchar_t Xwchar_t;
+#elif defined(__WCHAR_TYPE__)
+typedef __WCHAR_TYPE__ Xwchar_t;
+#endif
+#ifdef va_list
+typedef va_list XXXva_list;
+#endif
+#ifdef BUFSIZ
+long XBUFSIZ=BUFSIZ;
+#endif
+#ifdef FOPEN_MAX
+long XFOPEN_MAX=FOPEN_MAX;
+#endif
+#ifdef FILENAME_MAX
+long XFILENAME_MAX=FILENAME_MAX;
+#endif
+#ifdef SHRT_MAX
+long XSHRT_MAX=SHRT_MAX;
+#endif
+#ifdef INT_MAX
+long XINT_MAX=INT_MAX;
+#endif
+#ifdef LONG_MAX
+long XLONG_MAX=LONG_MAX;
+#endif
+#ifdef LONG_LONG_MAX
+long XLONG_LONG_MAX=LONG_LONG_MAX;
+#endif
+!EOF!
+
+if ${CPP} dummy.c -DWCHAR=$wchar -DWCTYPE=$wctype >TMP ; then true
+else
+ echo "gen-params: could not invoke ${CPP} on dummy.c" 1>&2 ; exit 1
+fi
+tr ' ' ' ' <TMP >dummy.out
+
+for TYPE in dev_t clock_t fpos_t gid_t ino_t mode_t nlink_t off_t pid_t ptrdiff_t sigset_t size_t ssize_t time_t uid_t va_list wchar_t wint_t int16_t uint16_t int32_t uint_32_t u_int16_t u_int32_t; do
+ IMPORTED=`eval 'echo $'"$TYPE"`
+ if [ -n "${IMPORTED}" ] ; then
+ eval "$TYPE='$IMPORTED'"
+ else
+ t=$TYPE
+ VALUE=''
+
+ # Follow `typedef VALUE TYPE' chains, but don't loop indefinitely.
+ for iteration in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20; do
+ # Search dummy.out for a typedef for X*$t.
+ sed_script="
+ s/unsigned long long/_G_ullong/g
+ s/long long/_G_llong/g
+ /.*typedef *\\(.*[^ ]\\) *X*$t *;.*/{s||\1|;p;q;}
+ /.*typedef *\\(.*[^ a-zA-Z0-9_]\\)X*$t *;.*/{s||\1|;p;q;}
+ "
+ t=`${SED} -n "$sed_script" <dummy.out`
+ case "$t" in
+ '')
+ break;;
+ *)
+ # Found a type $t; save it in VALUE.
+ VALUE=$t
+ # If it won't cause problems in matching,
+ # look for a typedef for it in turn.
+ case "$VALUE" in
+ *.* | */* | *\ * | *\** | *\[* | *\\*) break;;
+ esac;;
+ esac
+ done
+
+ case "$VALUE" in
+ ?*) eval "$TYPE=\"$VALUE\""
+ esac
+ fi
+done
+
+# Look for some standard macros.
+for NAME in BUFSIZ FOPEN_MAX FILENAME_MAX NULL; do
+ IMPORTED=`eval 'echo $'"$NAME"`
+ if [ -n "${IMPORTED}" ] ; then
+ eval "$NAME='$IMPORTED /* specified */"
+ else
+ rm -f TMP
+ ${SED} -n -e 's| *;|;|g' -e "s|long X${NAME}= *\(.*\);|\1|w TMP" \
+ <dummy.out>/dev/null
+ # Now select the first definition.
+ if [ -s TMP ]; then
+ eval "$NAME='"`${SED} -e '2,$d' <TMP`"'"
+ fi
+ fi
+done
+
+# These macros must be numerical constants; strip any trailing 'L's.
+for NAME in SHRT_MAX INT_MAX LONG_MAX LONG_LONG_MAX; do
+ IMPORTED=`eval 'echo $'"$NAME"`
+ if [ -n "${IMPORTED}" ] ; then
+ eval "$NAME='$IMPORTED /* specified */"
+ else
+ rm -f TMP
+ ${SED} -n -e 's| *;|;|g' -e "s|long X${NAME}= *\([0-9]*\)L* *;|\1|w TMP" \
+ <dummy.out>/dev/null
+ # Now select the first definition.
+ if [ -s TMP ]; then
+ eval "$NAME='"`${SED} -e '2,$d' <TMP`"'"
+ fi
+ fi
+done
+
+# Figure out integral type sizes.
+
+default_int16='short /* deduction failed */'
+default_int32='long /* deduction failed */'
+INT16=32767
+INT32=2147483647
+
+if [ "${SHRT_MAX}" = $INT16 ] ; then
+ default_int16='short /* deduced */'
+ if [ "${LONG_MAX}" = $INT32 ] ; then
+ default_int32='long /* deduced */'
+ elif [ "${INT_MAX}" = $INT32 ] ; then
+ default_int32='int /* deduced */'
+ fi
+fi
+
+[ -n "$u_int16_t" ] && uint16_t="$u_int16_t"
+[ -n "$u_int32_t" ] && uint32_t="$u_int32_t"
+
+[ -z "$int16_t" ] && int16_t="$default_int16"
+[ -z "$uint16_t" ] && uint16_t="unsigned $int16_t"
+[ -z "$int32_t" ] && int32_t="$default_int32"
+[ -z "$uint32_t" ] && uint32_t="unsigned $int32_t"
+
+cat <<!EOF!
+#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+typedef int ${macro_prefix}int8_t __attribute__((__mode__(__QI__)));
+typedef unsigned int ${macro_prefix}uint8_t __attribute__((__mode__(__QI__)));
+typedef int ${macro_prefix}int16_t __attribute__((__mode__(__HI__)));
+typedef unsigned int ${macro_prefix}uint16_t __attribute__((__mode__(__HI__)));
+typedef int ${macro_prefix}int32_t __attribute__((__mode__(__SI__)));
+typedef unsigned int ${macro_prefix}uint32_t __attribute__((__mode__(__SI__)));
+typedef int ${macro_prefix}int64_t __attribute__((__mode__(__DI__)));
+typedef unsigned int ${macro_prefix}uint64_t __attribute__((__mode__(__DI__)));
+__extension__ typedef long long ${macro_prefix}llong;
+__extension__ typedef unsigned long long ${macro_prefix}ullong;
+#else
+typedef $int16_t ${macro_prefix}int16_t;
+typedef $uint16_t ${macro_prefix}uint16_t;
+typedef $int32_t ${macro_prefix}int32_t;
+typedef $uint32_t ${macro_prefix}uint32_t;
+#endif
+
+typedef ${clock_t-int /* default */} ${macro_prefix}clock_t;
+typedef ${dev_t-int /* default */} ${macro_prefix}dev_t;
+typedef ${fpos_t-long /* default */} ${macro_prefix}fpos_t;
+typedef ${gid_t-int /* default */} ${macro_prefix}gid_t;
+typedef ${ino_t-int /* default */} ${macro_prefix}ino_t;
+typedef ${mode_t-int /* default */} ${macro_prefix}mode_t;
+typedef ${nlink_t-int /* default */} ${macro_prefix}nlink_t;
+typedef ${off_t-long /* default */} ${macro_prefix}off_t;
+typedef ${pid_t-int /* default */} ${macro_prefix}pid_t;
+#ifndef __PTRDIFF_TYPE__
+#define __PTRDIFF_TYPE__ ${ptrdiff_t-long int /* default */}
+#endif
+typedef __PTRDIFF_TYPE__ ${macro_prefix}ptrdiff_t;
+typedef ${sigset_t-int /* default */} ${macro_prefix}sigset_t;
+#ifndef __SIZE_TYPE__
+#define __SIZE_TYPE__ ${size_t-unsigned long /* default */}
+#endif
+typedef __SIZE_TYPE__ ${macro_prefix}size_t;
+typedef ${time_t-int /* default */} ${macro_prefix}time_t;
+typedef ${uid_t-int /* default */} ${macro_prefix}uid_t;
+typedef ${wchar_t-int /* default */} ${macro_prefix}wchar_t;
+
+#define ${macro_prefix}BUFSIZ ${BUFSIZ-1024 /* default */}
+#define ${macro_prefix}FOPEN_MAX ${FOPEN_MAX-32 /* default */}
+#define ${macro_prefix}FILENAME_MAX ${FILENAME_MAX-1024 /* default */}
+#if defined (__cplusplus) || defined (__STDC__)
+#define ${macro_prefix}ARGS(ARGLIST) ARGLIST
+#else
+#define ${macro_prefix}ARGS(ARGLIST) ()
+#endif
+#if !defined (__GNUG__) || defined (__STRICT_ANSI__)
+#define ${macro_prefix}NO_NRV
+#endif
+#if !defined (__GNUG__)
+#define _G_NO_EXTERN_TEMPLATES
+#endif
+!EOF!
+
+# ssize_t is the signed version of size_t
+if [ -n "${ssize_t}" ] ; then
+ echo "typedef ${ssize_t} ${macro_prefix}ssize_t;"
+elif [ -z "${size_t}" ] ; then
+ echo "typedef long ${macro_prefix}ssize_t;"
+else
+ # Remove "unsigned" from ${size_t} to get ${ssize_t}.
+ tmp="`echo ${size_t} | ${SED} -e 's|unsigned||g' -e 's| | |g'`"
+ if [ -z "$tmp" ] ; then
+ tmp=int
+ else
+ # check $tmp doesn't conflict with <unistd.h>
+ echo "#include <unistd.h>
+ extern $tmp read();" >dummy.c
+ ${CC} -c dummy.c >/dev/null 2>&1 || tmp=int
+ fi
+ echo "typedef $tmp /* default */ ${macro_prefix}ssize_t;"
+fi
+
+# wint_t is often the integral type to which wchar_t promotes.
+if [ -z "${wint_t}" ] ; then
+ for TYPE in int 'unsigned int' 'long int' 'long unsigned int'; do
+ cat >dummy.C <<!EOF!
+#ifndef __WCHAR_TYPE__
+#define __WCHAR_TYPE__ ${wchar_t-int /* default */}
+#endif
+typedef __WCHAR_TYPE__ ${macro_prefix}wchar_t;
+void foo ($TYPE);
+void foo (double);
+void bar (${macro_prefix}wchar_t w)
+{
+ foo (w);
+}
+!EOF!
+ if ${CXX} -c dummy.C >/dev/null 2>&1 ; then
+ wint_t="$TYPE /* default */"
+ break
+ fi
+ done
+fi
+echo "typedef ${wint_t-int /* wchar_t is broken */} ${macro_prefix}wint_t;"
+
+# va_list can cause problems (e.g. some systems have va_list as a struct).
+# Check to see if ${va_list-char*} really is compatible with stdarg.h.
+cat >dummy.C <<!EOF!
+#define X_va_list ${va_list-char* /* default */}
+extern long foo(X_va_list ap); /* Check that X_va_list compiles on its own */
+extern "C" {
+#include <stdarg.h>
+}
+long foo(X_va_list ap) { return va_arg(ap, long); }
+long bar(int i, ...)
+{ va_list ap; long j; va_start(ap, i); j = foo(ap); va_end(ap); return j; }
+!EOF!
+if ${CXX} -c dummy.C >/dev/null 2>&1 ; then
+ # Ok: We have something that works.
+ echo "typedef ${va_list-char* /* default */} ${macro_prefix}va_list;"
+else
+ # No, it breaks. Indicate that <stdarg.h> must be included.
+ echo "#define ${macro_prefix}NEED_STDARG_H
+#define ${macro_prefix}va_list va_list"
+fi
+
+cat >dummy.c <<!EOF!
+#include <signal.h>
+extern int (*signal())();
+extern int dummy (int);
+main()
+{
+ int (*oldsig)(int) = signal (1, dummy);
+ (void) signal (2, oldsig);
+ return 0;
+}
+!EOF!
+if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}signal_return_type int"
+else
+ echo "#define ${macro_prefix}signal_return_type void"
+fi
+
+# check sprintf return type
+
+cat >dummy.c <<!EOF!
+#include <stdio.h>
+extern int sprintf(); char buf[100];
+int main() { return sprintf(buf, "%d", 34); }
+!EOF!
+if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}sprintf_return_type int"
+else
+ echo "#define ${macro_prefix}sprintf_return_type char*"
+fi
+
+if test -n "${HAVE_ATEXIT}" ; then
+ echo "#define ${macro_prefix}HAVE_ATEXIT ${HAVE_ATEXIT}"
+else
+ cat >dummy.c <<!EOF!
+#include <stdlib.h>
+int main()
+{
+ atexit (0);
+}
+!EOF!
+ if ${CC} dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_ATEXIT 1"
+ else
+ echo "#define ${macro_prefix}HAVE_ATEXIT 0"
+ fi
+fi
+
+
+# *** Check for presence of certain include files ***
+
+# check for sys/resource.h
+
+if test -n "${HAVE_SYS_RESOURCE}" ; then
+ echo "#define ${macro_prefix}HAVE_SYS_RESOURCE ${HAVE_SYS_RESOURCE}"
+else
+ cat >dummy.c <<!EOF!
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+ int main()
+ {
+ struct rusage res;
+ getrusage(RUSAGE_SELF, &res);
+ return (int)(res.ru_utime.tv_sec + (res.ru_utime.tv_usec / 1000000.0));
+ }
+!EOF!
+ # Note: We link because some systems have sys/resource, but not getrusage().
+ if ${CC} dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_SYS_RESOURCE 1"
+ else
+ echo "#define ${macro_prefix}HAVE_SYS_RESOURCE 0"
+ fi
+fi
+
+# check for struct tms in sys/times.h
+
+if test -n "${HAVE_SYS_TIMES}" ; then
+ echo "#define ${macro_prefix}HAVE_SYS_TIMES ${HAVE_SYS_TIMES}"
+else
+ cat >dummy.c <<!EOF!
+#include <sys/types.h>
+#include <sys/times.h>
+ int main()
+ {
+ struct tms s;
+ return s.tms_utime;
+ }
+!EOF!
+ if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_SYS_TIMES 1"
+ else
+ echo "#define ${macro_prefix}HAVE_SYS_TIMES 0"
+ fi
+fi
+
+# check for sys/socket.h
+
+if test -n "${HAVE_SYS_SOCKET}" ; then
+ echo "#define ${macro_prefix}HAVE_SYS_SOCKET ${HAVE_SYS_SOCKET}"
+else
+ echo '#include <sys/types.h>' >dummy.c
+ echo '#include <sys/socket.h>' >>dummy.c
+ if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_SYS_SOCKET 1"
+ else
+ echo "#define ${macro_prefix}HAVE_SYS_SOCKET 0"
+ fi
+fi
+
+# check for sys/cdefs.h
+
+if test -n "${HAVE_SYS_CDEFS}" ; then
+ echo "#define ${macro_prefix}HAVE_SYS_CDEFS ${HAVE_SYS_CDEFS}"
+else
+ echo '#include <sys/cdefs.h>' >dummy.c
+ echo 'extern int myfunc __P((int, int));' >>dummy.c
+ if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_SYS_CDEFS 1"
+ else
+ echo "#define ${macro_prefix}HAVE_SYS_CDEFS 0"
+ fi
+fi
+
+# Check for a (Posix-compatible) sys/wait.h */
+
+if test -n "${HAVE_SYS_WAIT}" ; then
+ echo "#define ${macro_prefix}HAVE_SYS_WAIT ${HAVE_SYS_WAIT}"
+else
+ cat >dummy.c <<!EOF!
+#include <sys/types.h>
+#include <sys/wait.h>
+ int f() { int i; wait(&i); return i; }
+!EOF!
+ if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_SYS_WAIT 1"
+ else
+ echo "#define ${macro_prefix}HAVE_SYS_WAIT 0"
+ fi
+fi
+
+if test -n "${HAVE_UNISTD}" ; then
+ echo "#define ${macro_prefix}HAVE_UNISTD ${HAVE_UNISTD}"
+else
+ echo '#include <unistd.h>' >dummy.c
+ if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_UNISTD 1"
+ else
+ echo "#define ${macro_prefix}HAVE_UNISTD 0"
+ fi
+fi
+
+if test -n "${HAVE_DIRENT}" ; then
+ echo "#define ${macro_prefix}HAVE_DIRENT ${HAVE_DIRENT}"
+else
+ echo '#include <sys/types.h>
+#include <dirent.h>' >dummy.c
+ if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_DIRENT 1"
+ else
+ echo "#define ${macro_prefix}HAVE_DIRENT 0"
+ fi
+fi
+
+if test -n "${HAVE_CURSES}" ; then
+ echo "#define ${macro_prefix}HAVE_CURSES ${HAVE_CURSES}"
+else
+ echo '#include <curses.h>' >dummy.c
+ if ${CC} -c dummy.c >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_CURSES 1"
+ else
+ echo "#define ${macro_prefix}HAVE_CURSES 0"
+ fi
+fi
+
+# There is no test for this at the moment; it is just set by the
+# configuration files.
+if test -n "${MATH_H_INLINES}" ; then
+ echo "#define ${macro_prefix}MATH_H_INLINES ${MATH_H_INLINES}"
+else
+ echo "#define ${macro_prefix}MATH_H_INLINES 0"
+fi
+
+if test -n "${HAVE_BOOL}" ; then
+ echo "#define ${macro_prefix}HAVE_BOOL ${HAVE_BOOL}"
+else
+ echo 'bool i=true,j=false;' >dummy.C
+ if ${CXX} -c dummy.C >/dev/null 2>&1 ; then
+ echo "#define ${macro_prefix}HAVE_BOOL 1"
+ else
+ echo "#define ${macro_prefix}HAVE_BOOL 0"
+ fi
+fi
+
+if test -n "${NO_USE_DTOA}" ; then
+ echo "#define ${macro_prefix}NO_USE_DTOA 1"
+fi
+if test -n "${USE_INT32_FLAGS}" ; then
+ echo "#define ${macro_prefix}USE_INT32_FLAGS 1"
+fi
+
+# Uncomment the following line if you don't have working templates.
+# echo "#define ${macro_prefix}NO_TEMPLATES"
+
+rm -f dummy.C dummy.o dummy.c dummy.out TMP core a.out
+
+echo "#endif /* !${macro_prefix}config_h */"
diff --git a/libio/genops.c b/libio/genops.c
new file mode 100644
index 00000000000..23a6fdeaeac
--- /dev/null
+++ b/libio/genops.c
@@ -0,0 +1,852 @@
+/*
+Copyright (C) 1993, 1995 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Generic or default I/O operations. */
+
+#include "libioP.h"
+#ifdef __STDC__
+#include <stdlib.h>
+#endif
+#include <string.h>
+
+void
+DEFUN(_IO_un_link, (fp),
+ _IO_FILE *fp)
+{
+ if (fp->_flags & _IO_LINKED) {
+ _IO_FILE **f;
+ for (f = &_IO_list_all; *f != NULL; f = &(*f)->_chain) {
+ if (*f == fp) {
+ *f = fp->_chain;
+ break;
+ }
+ }
+ fp->_flags &= ~_IO_LINKED;
+ }
+}
+
+void
+DEFUN(_IO_link_in, (fp),
+ _IO_FILE *fp)
+{
+ if ((fp->_flags & _IO_LINKED) == 0) {
+ fp->_flags |= _IO_LINKED;
+ fp->_chain = _IO_list_all;
+ _IO_list_all = fp;
+ }
+}
+
+/* Return minimum _pos markers
+ Assumes the current get area is the main get area. */
+
+_IO_size_t
+DEFUN(_IO_least_marker, (fp),
+ register _IO_FILE *fp)
+{
+ _IO_ssize_t least_so_far = fp->_IO_read_end - fp->_IO_read_base;
+ register struct _IO_marker *mark;
+ for (mark = fp->_markers; mark != NULL; mark = mark->_next)
+ if (mark->_pos < least_so_far)
+ least_so_far = mark->_pos;
+ return least_so_far;
+}
+
+/* Switch current get area from backup buffer to (start of) main get area. */
+
+void
+DEFUN(_IO_switch_to_main_get_area, (fp),
+ _IO_FILE *fp)
+{
+ char *tmp;
+ fp->_flags &= ~_IO_IN_BACKUP;
+ /* Swap _IO_read_end and _IO_save_end. */
+ tmp = fp->_IO_read_end; fp->_IO_read_end= fp->_IO_save_end; fp->_IO_save_end= tmp;
+ /* Swap _IO_read_base and _IO_save_base. */
+ tmp = fp->_IO_read_base; fp->_IO_read_base = fp->_IO_save_base; fp->_IO_save_base = tmp;
+ fp->_IO_read_ptr = fp->_IO_read_base;
+}
+
+/* Switch current get area from main get area to (end of) backup area. */
+
+void
+DEFUN(_IO_switch_to_backup_area, (fp),
+ register _IO_FILE *fp)
+{
+ char *tmp;
+ fp->_flags |= _IO_IN_BACKUP;
+ /* Swap _IO_read_end and _IO_save_end. */
+ tmp = fp->_IO_read_end; fp->_IO_read_end = fp->_IO_save_end; fp->_IO_save_end = tmp;
+ /* Swap _gbase and _IO_save_base. */
+ tmp = fp->_IO_read_base; fp->_IO_read_base = fp->_IO_save_base; fp->_IO_save_base = tmp;
+ fp->_IO_read_ptr = fp->_IO_read_end;
+}
+
+int
+DEFUN(_IO_switch_to_get_mode, (fp),
+ register _IO_FILE *fp)
+{
+ if (fp->_IO_write_ptr > fp->_IO_write_base)
+ if (_IO_OVERFLOW (fp, EOF) == EOF)
+ return EOF;
+ if (_IO_in_backup(fp))
+ fp->_IO_read_base = fp->_IO_backup_base;
+ else
+ {
+ fp->_IO_read_base = fp->_IO_buf_base;
+ if (fp->_IO_write_ptr > fp->_IO_read_end)
+ fp->_IO_read_end = fp->_IO_write_ptr;
+ }
+ fp->_IO_read_ptr = fp->_IO_write_ptr;
+
+ fp->_IO_write_base = fp->_IO_write_ptr = fp->_IO_write_end = fp->_IO_read_ptr;
+
+ fp->_flags &= ~_IO_CURRENTLY_PUTTING;
+ return 0;
+}
+
+void
+DEFUN(_IO_free_backup_area, (fp),
+ register _IO_FILE *fp)
+{
+ if (_IO_in_backup (fp))
+ _IO_switch_to_main_get_area(fp); /* Just in case. */
+ free (fp->_IO_save_base);
+ fp->_IO_save_base = NULL;
+ fp->_IO_save_end = NULL;
+ fp->_IO_backup_base = NULL;
+}
+
+#if 0
+int
+DEFUN(_IO_switch_to_put_mode, (fp),
+ register _IO_FILE *fp)
+{
+ fp->_IO_write_base = fp->_IO_read_ptr;
+ fp->_IO_write_ptr = fp->_IO_read_ptr;
+ /* Following is wrong if line- or un-buffered? */
+ fp->_IO_write_end = fp->_flags & _IO_IN_BACKUP ? fp->_IO_read_end : fp->_IO_buf_end;
+
+ fp->_IO_read_ptr = fp->_IO_read_end;
+ fp->_IO_read_base = fp->_IO_read_end;
+
+ fp->_flags |= _IO_CURRENTLY_PUTTING;
+ return 0;
+}
+#endif
+
+int
+DEFUN(__overflow, (f, ch),
+ _IO_FILE *f AND int ch)
+{
+ return _IO_OVERFLOW (f, ch);
+}
+
+static int
+DEFUN(save_for_backup, (fp),
+ _IO_FILE *fp)
+{
+ /* Append [_IO_read_base.._IO_read_end] to backup area. */
+ int least_mark = _IO_least_marker(fp);
+ /* needed_size is how much space we need in the backup area. */
+ int needed_size = (fp->_IO_read_end - fp->_IO_read_base) - least_mark;
+ int current_Bsize = fp->_IO_save_end - fp->_IO_save_base;
+ int avail; /* Extra space available for future expansion. */
+ int delta;
+ struct _IO_marker *mark;
+ if (needed_size > current_Bsize)
+ {
+ char *new_buffer;
+ avail = 100;
+ new_buffer = (char*)malloc(avail+needed_size);
+ if (new_buffer == NULL)
+ return EOF; /* FIXME */
+ if (least_mark < 0)
+ {
+ memcpy(new_buffer + avail,
+ fp->_IO_save_end + least_mark,
+ -least_mark);
+ memcpy(new_buffer +avail - least_mark,
+ fp->_IO_read_base,
+ fp->_IO_read_end - fp->_IO_read_base);
+ }
+ else
+ memcpy(new_buffer + avail,
+ fp->_IO_read_base + least_mark,
+ needed_size);
+ if (fp->_IO_save_base)
+ free (fp->_IO_save_base);
+ fp->_IO_save_base = new_buffer;
+ fp->_IO_save_end = new_buffer + avail + needed_size;
+ }
+ else
+ {
+ avail = current_Bsize - needed_size;
+ if (least_mark < 0)
+ {
+ memmove(fp->_IO_save_base + avail,
+ fp->_IO_save_end + least_mark,
+ -least_mark);
+ memcpy(fp->_IO_save_base + avail - least_mark,
+ fp->_IO_read_base,
+ fp->_IO_read_end - fp->_IO_read_base);
+ }
+ else if (needed_size > 0)
+ memcpy(fp->_IO_save_base + avail,
+ fp->_IO_read_base + least_mark,
+ needed_size);
+ }
+ /* FIXME: Dubious arithmetic if pointers are NULL */
+ fp->_IO_backup_base = fp->_IO_save_base + avail;
+ /* Adjust all the streammarkers. */
+ delta = fp->_IO_read_end - fp->_IO_read_base;
+ for (mark = fp->_markers; mark != NULL; mark = mark->_next)
+ mark->_pos -= delta;
+ return 0;
+}
+
+int
+DEFUN(__underflow, (fp),
+ _IO_FILE *fp)
+{
+ if (_IO_in_put_mode(fp))
+ if (_IO_switch_to_get_mode(fp) == EOF) return EOF;
+ if (fp->_IO_read_ptr < fp->_IO_read_end)
+ return *(unsigned char*)fp->_IO_read_ptr;
+ if (_IO_in_backup(fp))
+ {
+ _IO_switch_to_main_get_area(fp);
+ if (fp->_IO_read_ptr < fp->_IO_read_end)
+ return *fp->_IO_read_ptr;
+ }
+ if (_IO_have_markers(fp))
+ {
+ if (save_for_backup (fp))
+ return EOF;
+ }
+ else if (_IO_have_backup(fp))
+ _IO_free_backup_area(fp);
+ return _IO_UNDERFLOW (fp);
+}
+
+int
+DEFUN(__uflow, (fp),
+ _IO_FILE *fp)
+{
+ if (_IO_in_put_mode(fp))
+ if (_IO_switch_to_get_mode(fp) == EOF) return EOF;
+ if (fp->_IO_read_ptr < fp->_IO_read_end)
+ return *(unsigned char*)fp->_IO_read_ptr++;
+ if (_IO_in_backup(fp))
+ {
+ _IO_switch_to_main_get_area(fp);
+ if (fp->_IO_read_ptr < fp->_IO_read_end)
+ return *fp->_IO_read_ptr++;
+ }
+ if (_IO_have_markers(fp))
+ {
+ if (save_for_backup (fp))
+ return EOF;
+ }
+ else if (_IO_have_backup(fp))
+ _IO_free_backup_area(fp);
+ return _IO_UFLOW (fp);
+}
+
+void
+DEFUN(_IO_setb, (f, b, eb, a),
+ _IO_FILE *f AND char *b AND char *eb AND int a)
+{
+ if (f->_IO_buf_base && !(f->_flags & _IO_USER_BUF))
+ FREE_BUF(f->_IO_buf_base);
+ f->_IO_buf_base = b;
+ f->_IO_buf_end = eb;
+ if (a)
+ f->_flags &= ~_IO_USER_BUF;
+ else
+ f->_flags |= _IO_USER_BUF;
+}
+
+void
+DEFUN(_IO_doallocbuf, (fp),
+ register _IO_FILE *fp)
+{
+ if (fp->_IO_buf_base)
+ return;
+ if (!(fp->_flags & _IO_UNBUFFERED))
+ if (_IO_DOALLOCATE (fp) != EOF)
+ return;
+ _IO_setb(fp, fp->_shortbuf, fp->_shortbuf+1, 0);
+}
+
+int
+DEFUN(_IO_default_underflow, (fp),
+ _IO_FILE *fp)
+{
+ return EOF;
+}
+
+int
+DEFUN(_IO_default_uflow, (fp),
+ _IO_FILE *fp)
+{
+ int ch = _IO_UNDERFLOW (fp);
+ if (ch == EOF)
+ return EOF;
+ return *(unsigned char*)fp->_IO_read_ptr++;
+}
+
+_IO_size_t
+DEFUN(_IO_default_xsputn, (f, data, n),
+ register _IO_FILE *f AND const void *data AND _IO_size_t n)
+{
+ register const char *s = (char*) data;
+ register _IO_size_t more = n;
+ if (more <= 0)
+ return 0;
+ for (;;)
+ {
+ _IO_ssize_t count = f->_IO_write_end - f->_IO_write_ptr; /* Space available. */
+ if (count > 0)
+ {
+ if (count > more)
+ count = more;
+ if (count > 20)
+ {
+ memcpy(f->_IO_write_ptr, s, count);
+ s += count;
+ f->_IO_write_ptr += count;
+ }
+ else if (count <= 0)
+ count = 0;
+ else
+ {
+ register char *p = f->_IO_write_ptr;
+ register _IO_ssize_t i;
+ for (i = count; --i >= 0; ) *p++ = *s++;
+ f->_IO_write_ptr = p;
+ }
+ more -= count;
+ }
+ if (more == 0 || __overflow(f, (unsigned char)*s++) == EOF)
+ break;
+ more--;
+ }
+ return n - more;
+}
+
+_IO_size_t
+DEFUN(_IO_sgetn, (fp, data, n),
+ _IO_FILE *fp AND void *data AND _IO_size_t n)
+{
+ /* FIXME handle putback buffer here! */
+ return _IO_XSGETN (fp, data, n);
+}
+
+_IO_size_t
+DEFUN(_IO_default_xsgetn, (fp, data, n),
+ _IO_FILE *fp AND void *data AND _IO_size_t n)
+{
+ register _IO_size_t more = n;
+ register char *s = (char*) data;
+ for (;;)
+ {
+ _IO_ssize_t count = fp->_IO_read_end - fp->_IO_read_ptr; /* Data available. */
+ if (count > 0)
+ {
+ if (count > more)
+ count = more;
+ if (count > 20)
+ {
+ memcpy(s, fp->_IO_read_ptr, count);
+ s += count;
+ fp->_IO_read_ptr += count;
+ }
+ else if (count <= 0)
+ count = 0;
+ else
+ {
+ register char *p = fp->_IO_read_ptr;
+ register int i = (int)count;
+ while (--i >= 0) *s++ = *p++;
+ fp->_IO_read_ptr = p;
+ }
+ more -= count;
+ }
+ if (more == 0 || __underflow(fp) == EOF)
+ break;
+ }
+ return n - more;
+}
+
+int
+DEFUN(_IO_sync, (fp),
+ register _IO_FILE *fp)
+{
+ return 0;
+}
+
+_IO_FILE*
+DEFUN(_IO_default_setbuf, (fp, p, len),
+ register _IO_FILE *fp AND char* p AND _IO_ssize_t len)
+{
+ if (_IO_SYNC (fp) == EOF)
+ return NULL;
+ if (p == NULL || len == 0)
+ {
+ fp->_flags |= _IO_UNBUFFERED;
+ _IO_setb(fp, fp->_shortbuf, fp->_shortbuf+1, 0);
+ }
+ else
+ {
+ fp->_flags &= ~_IO_UNBUFFERED;
+ _IO_setb(fp, p, p+len, 0);
+ }
+ fp->_IO_write_base = fp->_IO_write_ptr = fp->_IO_write_end = 0;
+ fp->_IO_read_base = fp->_IO_read_ptr = fp->_IO_read_end = 0;
+ return fp;
+}
+
+_IO_pos_t
+DEFUN(_IO_default_seekpos, (fp, pos, mode),
+ _IO_FILE *fp AND _IO_pos_t pos AND int mode)
+{
+ return _IO_SEEKOFF (fp, _IO_pos_as_off(pos), 0, mode);
+}
+
+int
+DEFUN(_IO_default_doallocate, (fp),
+ _IO_FILE *fp)
+{
+ char *buf = ALLOC_BUF(_IO_BUFSIZ);
+ if (buf == NULL)
+ return EOF;
+ _IO_setb(fp, buf, buf+_IO_BUFSIZ, 1);
+ return 1;
+}
+
+void
+DEFUN(_IO_init, (fp, flags),
+ register _IO_FILE *fp AND int flags)
+{
+ fp->_flags = _IO_MAGIC|flags;
+ fp->_IO_buf_base = NULL;
+ fp->_IO_buf_end = NULL;
+ fp->_IO_read_base = NULL;
+ fp->_IO_read_ptr = NULL;
+ fp->_IO_read_end = NULL;
+ fp->_IO_write_base = NULL;
+ fp->_IO_write_ptr = NULL;
+ fp->_IO_write_end = NULL;
+ fp->_chain = NULL; /* Not necessary. */
+
+ fp->_IO_save_base = NULL;
+ fp->_IO_backup_base = NULL;
+ fp->_IO_save_end = NULL;
+ fp->_markers = NULL;
+ fp->_cur_column = 0;
+}
+
+int
+DEFUN(_IO_default_sync, (fp),
+ _IO_FILE *fp)
+{
+ return 0;
+}
+
+/* The way the C++ classes are mapped into the C functions in the
+ current implementation, this function can get called twice! */
+
+void
+DEFUN(_IO_default_finish, (fp),
+ _IO_FILE *fp)
+{
+ struct _IO_marker *mark;
+ if (fp->_IO_buf_base && !(fp->_flags & _IO_USER_BUF))
+ {
+ FREE_BUF(fp->_IO_buf_base);
+ fp->_IO_buf_base = fp->_IO_buf_end = NULL;
+ }
+
+ for (mark = fp->_markers; mark != NULL; mark = mark->_next)
+ mark->_sbuf = NULL;
+
+ if (fp->_IO_save_base)
+ {
+ free (fp->_IO_save_base);
+ fp->_IO_save_base = NULL;
+ }
+
+ _IO_un_link(fp);
+}
+
+_IO_pos_t
+DEFUN(_IO_default_seekoff, (fp, offset, dir, mode),
+ register _IO_FILE *fp AND _IO_off_t offset AND int dir AND int mode)
+{
+ return _IO_pos_BAD;
+}
+
+int
+DEFUN(_IO_sputbackc, (fp, c),
+ register _IO_FILE *fp AND int c)
+{
+ int result;
+
+ if (fp->_IO_read_ptr > fp->_IO_read_base
+ && (unsigned char)fp->_IO_read_ptr[-1] == (unsigned char)c)
+ {
+ fp->_IO_read_ptr--;
+ result = (unsigned char)c;
+ }
+ else
+ result = _IO_PBACKFAIL (fp, c);
+
+ if (result != EOF)
+ fp->_flags &= ~_IO_EOF_SEEN;
+
+ return result;
+}
+
+int
+DEFUN(_IO_sungetc, (fp),
+ register _IO_FILE *fp)
+{
+ int result;
+
+ if (fp->_IO_read_ptr > fp->_IO_read_base)
+ {
+ fp->_IO_read_ptr--;
+ result = (unsigned char)*fp->_IO_read_ptr;
+ }
+ else
+ result = _IO_PBACKFAIL (fp, EOF);
+
+ if (result != EOF)
+ fp->_flags &= ~_IO_EOF_SEEN;
+
+ return result;
+}
+
+#if 0 /* Work in progress */
+void
+DEFUN(_IO_set_column, (fp, c),
+ register _IO_FILE *fp AND int c)
+{
+ if (c == -1)
+ fp->_column = -1;
+ else
+ fp->_column = c - (fp->_IO_write_ptr - fp->_IO_write_base);
+}
+#else
+int
+DEFUN(_IO_set_column, (fp, i),
+ register _IO_FILE *fp AND int i)
+{
+ fp->_cur_column = i+1;
+ return 0;
+}
+#endif
+
+
+unsigned
+DEFUN(_IO_adjust_column, (start, line, count),
+ unsigned start AND const char *line AND int count)
+{
+ register const char *ptr = line + count;
+ while (ptr > line)
+ if (*--ptr == '\n')
+ return line + count - ptr - 1;
+ return start + count;
+}
+
+int
+DEFUN(_IO_get_column, (fp),
+ register _IO_FILE *fp)
+{
+ if (fp->_cur_column)
+ return _IO_adjust_column(fp->_cur_column - 1,
+ fp->_IO_write_base,
+ fp->_IO_write_ptr - fp->_IO_write_base);
+ return -1;
+}
+
+int
+DEFUN_VOID(_IO_flush_all)
+{
+ int result = 0;
+ _IO_FILE *fp;
+ for (fp = _IO_list_all; fp != NULL; fp = fp->_chain)
+ if (fp->_IO_write_ptr > fp->_IO_write_base
+ && _IO_OVERFLOW (fp, EOF) == EOF)
+ result = EOF;
+ return result;
+}
+
+void
+DEFUN_VOID(_IO_flush_all_linebuffered)
+{
+ _IO_FILE *fp;
+ for (fp = _IO_list_all; fp != NULL; fp = fp->_chain)
+ if (fp->_flags & _IO_LINE_BUF)
+ _IO_OVERFLOW (fp, EOF);
+}
+
+void
+DEFUN_VOID(_IO_unbuffer_all)
+{
+ _IO_FILE *fp;
+ for (fp = _IO_list_all; fp != NULL; fp = fp->_chain)
+ if (! (fp->_flags & _IO_UNBUFFERED))
+ _IO_SETBUF (fp, NULL, 0);
+}
+
+void
+DEFUN_VOID(_IO_cleanup)
+{
+ _IO_flush_all ();
+
+ /* We currently don't have a reliable mechanism for making sure that
+ C++ static destructors are executed in the correct order.
+ So it is possible that other static destructord might want to
+ write to cout - and they're supposed to be able to do so.
+
+ The following will make the standard streambufs be unbuffered,
+ which forces any output from late destructors to be written out. */
+ _IO_unbuffer_all ();
+}
+
+void
+DEFUN(_IO_init_marker, (marker, fp),
+ struct _IO_marker *marker AND _IO_FILE *fp)
+{
+ marker->_sbuf = fp;
+ if (_IO_in_put_mode(fp))
+ _IO_switch_to_get_mode(fp);
+ if (_IO_in_backup(fp))
+ marker->_pos = fp->_IO_read_ptr - fp->_IO_read_end;
+ else
+ marker->_pos = fp->_IO_read_ptr - fp->_IO_read_base;
+
+ /* Should perhaps sort the chain? */
+ marker->_next = fp->_markers;
+ fp->_markers = marker;
+}
+
+void
+DEFUN(_IO_remove_marker, (marker),
+ register struct _IO_marker *marker)
+{
+ /* Unlink from sb's chain. */
+ register struct _IO_marker **ptr = &marker->_sbuf->_markers;
+ for (; ; ptr = &(*ptr)->_next)
+ {
+ if (*ptr == NULL)
+ break;
+ else if (*ptr == marker)
+ {
+ *ptr = marker->_next;
+ return;
+ }
+ }
+#if 0
+ if _sbuf has a backup area that is no longer needed, should we delete
+ it now, or wait until the next underflow?
+#endif
+}
+
+#define BAD_DELTA EOF
+
+int
+DEFUN(_IO_marker_difference, (mark1, mark2),
+ struct _IO_marker *mark1 AND struct _IO_marker *mark2)
+{
+ return mark1->_pos - mark2->_pos;
+}
+
+/* Return difference between MARK and current posistion of MARK's stream. */
+int
+DEFUN(_IO_marker_delta, (mark),
+ struct _IO_marker *mark)
+{
+ int cur_pos;
+ if (mark->_sbuf == NULL)
+ return BAD_DELTA;
+ if (_IO_in_backup(mark->_sbuf))
+ cur_pos = mark->_sbuf->_IO_read_ptr - mark->_sbuf->_IO_read_end;
+ else
+ cur_pos = mark->_sbuf->_IO_read_ptr - mark->_sbuf->_IO_read_base;
+ return mark->_pos - cur_pos;
+}
+
+int
+DEFUN(_IO_seekmark, (fp, mark, delta),
+ _IO_FILE *fp AND struct _IO_marker *mark AND int delta)
+{
+ if (mark->_sbuf != fp)
+ return EOF;
+ if (mark->_pos >= 0)
+ {
+ if (_IO_in_backup(fp))
+ _IO_switch_to_main_get_area(fp);
+ fp->_IO_read_ptr = fp->_IO_read_base + mark->_pos;
+ }
+ else
+ {
+ if (!_IO_in_backup(fp))
+ _IO_switch_to_backup_area(fp);
+ fp->_IO_read_ptr = fp->_IO_read_end + mark->_pos;
+ }
+ return 0;
+}
+
+void
+DEFUN(_IO_unsave_markers, (fp),
+ register _IO_FILE *fp)
+{
+ register struct _IO_marker *mark = fp->_markers;
+ if (mark)
+ {
+#ifdef TODO
+ streampos offset = seekoff(0, ios::cur, ios::in);
+ if (offset != EOF)
+ {
+ offset += eGptr() - Gbase();
+ for ( ; mark != NULL; mark = mark->_next)
+ mark->set_streampos(mark->_pos + offset);
+ }
+ else
+ {
+ for ( ; mark != NULL; mark = mark->_next)
+ mark->set_streampos(EOF);
+ }
+#endif
+ fp->_markers = 0;
+ }
+
+ if (_IO_have_backup(fp))
+ _IO_free_backup_area(fp);
+}
+
+int
+DEFUN(_IO_nobackup_pbackfail, (fp, c),
+ register _IO_FILE *fp AND int c)
+{
+ if (fp->_IO_read_ptr > fp->_IO_read_base)
+ fp->_IO_read_ptr--;
+ if (c != EOF && *fp->_IO_read_ptr != c)
+ *fp->_IO_read_ptr = c;
+ return (unsigned char)c;
+}
+
+int
+DEFUN(_IO_default_pbackfail, (fp, c),
+ register _IO_FILE *fp AND int c)
+{
+ if (fp->_IO_read_ptr <= fp->_IO_read_base)
+ {
+ /* Need to handle a filebuf in write mode (switch to read mode). FIXME!*/
+ if (_IO_have_backup(fp) && !_IO_in_backup(fp))
+ _IO_switch_to_backup_area(fp);
+
+ if (!_IO_have_backup(fp))
+ {
+ /* No backup buffer: allocate one. */
+ /* Use nshort buffer, if unused? (probably not) FIXME */
+ int backup_size = 128;
+ char *bbuf = (char*)malloc(backup_size);
+ if (bbuf == NULL)
+ return EOF;
+ fp->_IO_save_base = bbuf;
+ fp->_IO_save_end = fp->_IO_save_base + backup_size;
+ fp->_IO_backup_base = fp->_IO_save_end;
+ _IO_switch_to_backup_area(fp);
+ }
+ else if (fp->_IO_read_ptr <= fp->_IO_read_base)
+ {
+ /* Increase size of existing backup buffer. */
+ _IO_size_t new_size;
+ _IO_size_t old_size = fp->_IO_read_end - fp->_IO_read_base;
+ char *new_buf;
+ new_size = 2 * old_size;
+ new_buf = (char*)malloc(new_size);
+ if (new_buf == NULL)
+ return EOF;
+ memcpy(new_buf+(new_size-old_size), fp->_IO_read_base, old_size);
+ free (fp->_IO_read_base);
+ _IO_setg(fp,
+ new_buf, new_buf+(new_size-old_size), new_buf+new_size);
+ fp->_IO_backup_base = fp->_IO_read_ptr;
+ }
+ }
+ fp->_IO_read_ptr--;
+ if (c != EOF && *fp->_IO_read_ptr != c)
+ *fp->_IO_read_ptr = c;
+ return (unsigned char)*fp->_IO_read_ptr;
+}
+
+_IO_pos_t
+DEFUN(_IO_default_seek, (fp, offset, dir),
+ _IO_FILE *fp AND _IO_off_t offset AND int dir)
+{
+ return _IO_pos_BAD;
+}
+
+int
+DEFUN(_IO_default_stat, (fp, st),
+ _IO_FILE *fp AND void* st)
+{
+ return EOF;
+}
+
+_IO_ssize_t
+DEFUN(_IO_default_read, (fp, data, n),
+ register _IO_FILE* fp AND void* data AND _IO_ssize_t n)
+{
+ return -1;
+}
+
+_IO_ssize_t
+DEFUN(_IO_default_write, (fp, data, n),
+ register _IO_FILE* fp AND const void* data AND _IO_ssize_t n)
+{
+ return 0;
+}
+
+
+#ifdef TODO
+#if defined(linux)
+#define IO_CLEANUP ;
+#endif
+
+#ifdef IO_CLEANUP
+ IO_CLEANUP
+#else
+struct __io_defs {
+ __io_defs() { }
+ ~__io_defs() { _IO_cleanup(); }
+};
+__io_defs io_defs__;
+#endif
+
+#endif /* TODO */
diff --git a/libio/indstream.cc b/libio/indstream.cc
new file mode 100644
index 00000000000..15a1bb2778d
--- /dev/null
+++ b/libio/indstream.cc
@@ -0,0 +1,121 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+
+Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+
+#include <indstream.h>
+
+indirectbuf::indirectbuf(streambuf *get, streambuf *put, int delete_mode)
+: streambuf()
+{
+ _get_stream = get;
+ _put_stream = put == NULL ? get : put;
+ _delete_flags = delete_mode;
+}
+
+indirectbuf::~indirectbuf()
+{
+ if (_delete_flags & ios::in) delete get_stream();
+ if (_delete_flags & ios::out) delete put_stream();
+}
+
+streamsize indirectbuf::xsputn(const char* s, streamsize n)
+{
+ return put_stream()->sputn(s, n);
+}
+
+streamsize indirectbuf::xsgetn(char* s, streamsize n)
+{
+ return get_stream()->sgetn(s, n);
+}
+
+int indirectbuf::overflow(int c /* = EOF */)
+{
+ if (c == EOF)
+ return put_stream()->overflow(c);
+ else
+ return put_stream()->sputc(c);
+}
+
+int indirectbuf::underflow()
+{
+ return get_stream()->sgetc();
+}
+
+int indirectbuf::uflow()
+{
+ return get_stream()->sbumpc();
+}
+
+streampos indirectbuf::seekoff(streamoff off, _seek_dir dir, int mode)
+{
+ int ret_val = 0;
+ int select = mode == 0 ? (ios::in|ios::out) : mode;
+ streambuf *gbuf = (select & ios::in) ? get_stream() : (streambuf*)NULL;
+ streambuf *pbuf = (select & ios::out) ? put_stream() : (streambuf*)NULL;
+ if (gbuf == pbuf)
+ ret_val = gbuf->seekoff(off, dir, mode);
+ else {
+ if (gbuf)
+ ret_val = gbuf->seekoff(off, dir, ios::in);
+ if (pbuf && ret_val != EOF)
+ ret_val = pbuf->seekoff(off, dir, ios::out);
+ }
+ return ret_val;
+}
+
+streampos indirectbuf::seekpos(streampos pos, int mode)
+{
+ int ret_val = EOF;
+ int select = mode == 0 ? (ios::in|ios::out) : mode;
+ streambuf *gbuf = (select & ios::in) ? get_stream() : (streambuf*)NULL;
+ streambuf *pbuf = (select & ios::out) ? put_stream() : (streambuf*)NULL;
+ if (gbuf == pbuf && gbuf != NULL)
+ ret_val = gbuf->seekpos(pos, mode);
+ else {
+ if (gbuf)
+ ret_val = gbuf->seekpos(pos, ios::in);
+ if (pbuf && ret_val != EOF)
+ ret_val = pbuf->seekpos(pos, ios::out);
+ }
+ return ret_val;
+}
+
+int indirectbuf::sync()
+{
+ streambuf *gbuf = get_stream();
+ int get_ret_val = gbuf ? gbuf->sync() : 0;
+ streambuf *pbuf = put_stream();
+ int put_ret_val = (pbuf && pbuf != gbuf) ? pbuf->sync() : 0;
+ return get_ret_val || put_ret_val;
+}
+
+int indirectbuf::pbackfail(int c)
+{
+ return get_stream()->sputbackc(c);
+}
diff --git a/libio/indstream.h b/libio/indstream.h
new file mode 100644
index 00000000000..c4558623d07
--- /dev/null
+++ b/libio/indstream.h
@@ -0,0 +1,77 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+
+Written by Per Bothner (bothner@cygnus.com). */
+
+#ifndef _INDSTREAM_H
+#define _INDSTREAM_H
+
+#ifdef __GNUG__
+#pragma interface
+#endif
+
+#include <iostream.h>
+
+extern "C++" {
+// An indirectbuf is one that forwards all of its I/O requests
+// to another streambuf.
+// All get-related requests are sent to get_stream().
+// All put-related requests are sent to put_stream().
+
+// An indirectbuf can be used to implement Common Lisp
+// synonym-streams and two-way-streams.
+//
+// class synonymbuf : public indirectbuf {
+// Symbol *sym;
+// synonymbuf(Symbol *s) { sym = s; }
+// virtual streambuf *lookup_stream(int mode) {
+// return coerce_to_streambuf(lookup_value(sym)); }
+// };
+
+class indirectbuf : public streambuf {
+ protected:
+ streambuf *_get_stream; // Optional cache for get_stream().
+ streambuf *_put_stream; // Optional cache for put_stream().
+ int _delete_flags;
+ public:
+ streambuf *get_stream()
+ { return _get_stream ? _get_stream : lookup_stream(ios::in); }
+ streambuf *put_stream()
+ { return _put_stream ? _put_stream : lookup_stream(ios::out); }
+ virtual streambuf *lookup_stream(int/*mode*/) { return NULL; } // ERROR!
+ indirectbuf(streambuf *get=NULL, streambuf *put=NULL, int delete_mode=0);
+ virtual ~indirectbuf();
+ virtual streamsize xsputn(const char* s, streamsize n);
+ virtual streamsize xsgetn(char* s, streamsize n);
+ virtual int underflow();
+ virtual int uflow();
+ virtual int overflow(int c = EOF);
+ virtual streampos seekoff(streamoff, _seek_dir, int mode=ios::in|ios::out);
+ virtual streampos seekpos(streampos pos, int mode = ios::in|ios::out);
+ virtual int sync();
+ virtual int pbackfail(int c);
+};
+} // extern "C++"
+
+#endif /* !_INDSTREAM_H */
diff --git a/libio/ioassign.cc b/libio/ioassign.cc
new file mode 100644
index 00000000000..5b8e68bbf53
--- /dev/null
+++ b/libio/ioassign.cc
@@ -0,0 +1,49 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#include <iostream.h>
+#include "libioP.h"
+
+// These method are provided for backward compatibility reasons.
+// It's generally poor style to use them.
+// They are not supported by the ANSI/ISO working paper.
+
+_IO_istream_withassign& _IO_istream_withassign::operator=(istream& rhs)
+{
+ if (&rhs != (istream*)this)
+ {
+ init (rhs.rdbuf ());
+ _gcount = 0;
+ }
+ return *this;
+}
+
+_IO_ostream_withassign& _IO_ostream_withassign::operator=(ostream& rhs)
+{
+ if (&rhs != (ostream*)this)
+ init (rhs.rdbuf ());
+ return *this;
+}
diff --git a/libio/ioextend.cc b/libio/ioextend.cc
new file mode 100644
index 00000000000..a31ff36e6e5
--- /dev/null
+++ b/libio/ioextend.cc
@@ -0,0 +1,132 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <iostream.h>
+
+static int __xalloc = 0;
+
+int ios::xalloc()
+{
+ return __xalloc++;
+}
+
+static ios::fmtflags __used_fmt_flags
+= ios::skipws | ios::left | ios::right | ios::internal
+| ios::dec | ios::oct | ios::hex | ios::showbase | ios::showpoint
+| ios::uppercase | ios::showpos | ios::scientific | ios::fixed
+#ifndef _IO_NEW_STREAMS
+| ios::dont_close
+#endif
+| ios::unitbuf | ios::stdio;
+
+ios::fmtflags ios::bitalloc()
+{
+ fmtflags bit_to_try = (fmtflags)1;
+ for (; bit_to_try; bit_to_try <<= 1)
+ {
+ if ((__used_fmt_flags & bit_to_try) == 0)
+ {
+ __used_fmt_flags |= bit_to_try;
+ return bit_to_try;
+ }
+ }
+ return 0;
+}
+
+// NOTE: This implementation of ios::iword and ios::pword assumes
+// that these methods are seldom used, so we want to minimize
+// the space and time overhead when NOT using these methods.
+//
+// ANSI specifies two conceptually-infinite arrays, one whose
+// elements are longs, and one whose elements are (void*)s.
+// We implement this as a single array, each of whose element is
+// a (struct ptr_and_long), which has space for both a long and a void*.
+// We also specify that (the i field of) the 0'th element of the array
+// contains the allocated length of the array (not counting that
+// initial element).
+
+struct ptr_and_long {
+ void *p;
+ long i;
+};
+
+static struct ptr_and_long&
+get_array_element(ios& io, int index)
+{
+ if (index < 0)
+ io._throw_failure();
+ register struct ptr_and_long *array = (ptr_and_long*)io._arrays;
+ int old_length = array == NULL ? 0 : array[0].i;
+ if (index >= old_length)
+ {
+ register int i;
+ int new_length = index + 10;
+ register struct ptr_and_long *new_array
+ = new ptr_and_long[1 + new_length];
+ if (array != NULL)
+ {
+ for (i = 1; i <= old_length; i++)
+ new_array[i] = array[i];
+ delete [] array;
+ }
+ for (i = old_length + 1; i <= new_length; i++)
+ {
+ new_array[i].i = 0;
+ new_array[i].p = NULL;
+ }
+ new_array[0].i = new_length;
+ new_array[0].p = NULL;
+ io._arrays = (void*)new_array;
+ array = new_array;
+ }
+ return array[index+1];
+}
+
+long& ios::iword(int index)
+{
+ return get_array_element(*this, index).i;
+}
+
+void*& ios::pword(int index)
+{
+ return get_array_element(*this, index).p;
+}
+
+long ios::iword(int index) const
+{
+ if (index < 0)
+ _throw_failure();
+ register struct ptr_and_long *pl_array = (ptr_and_long*)_arrays;
+ int len = pl_array == NULL ? 0 : pl_array[0].i;
+ return index >= len ? 0 : pl_array[index+1].i;
+}
+
+void* ios::pword(int index) const
+{
+ if (index < 0)
+ _throw_failure();
+ register struct ptr_and_long *pl_array = (ptr_and_long*)_arrays;
+ int len = pl_array == NULL ? 0 : pl_array[0].i;
+ return index >= len ? 0 : pl_array[index+1].p;
+}
diff --git a/libio/iofclose.c b/libio/iofclose.c
new file mode 100644
index 00000000000..f3ae0964e82
--- /dev/null
+++ b/libio/iofclose.c
@@ -0,0 +1,47 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#ifdef __STDC__
+#include <stdlib.h>
+#endif
+
+int
+DEFUN(_IO_fclose, (fp),
+ register _IO_FILE *fp)
+{
+ int status;
+ CHECK_FILE(fp, EOF);
+ if (fp->_IO_file_flags & _IO_IS_FILEBUF)
+ status = _IO_file_close_it(fp);
+ else
+ status = fp->_flags & _IO_ERR_SEEN ? -1 : 0;
+ _IO_FINISH (fp);
+ if (fp != _IO_stdin && fp != _IO_stdout && fp != _IO_stderr)
+ {
+ fp->_IO_file_flags = 0;
+ free(fp);
+ }
+ return status;
+}
diff --git a/libio/iofdopen.c b/libio/iofdopen.c
new file mode 100644
index 00000000000..f8bc76869ad
--- /dev/null
+++ b/libio/iofdopen.c
@@ -0,0 +1,121 @@
+/*
+Copyright (C) 1993, 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifdef __STDC__
+#include <stdlib.h>
+#endif
+#include "libioP.h"
+#include <fcntl.h>
+
+#ifndef _IO_fcntl
+#define _IO_fcntl fcntl
+#endif
+
+_IO_FILE *
+DEFUN(_IO_fdopen, (fd, mode),
+ int fd AND const char *mode)
+{
+ int read_write;
+ int posix_mode = 0;
+ struct _IO_FILE_plus *fp;
+ int fd_flags;
+
+ switch (*mode++)
+ {
+ case 'r':
+ read_write = _IO_NO_WRITES;
+ break;
+ case 'w':
+ read_write = _IO_NO_READS;
+ break;
+ case 'a':
+ posix_mode = O_APPEND;
+ read_write = _IO_NO_READS|_IO_IS_APPENDING;
+ break;
+ default:
+#ifdef EINVAL
+ errno = EINVAL;
+#endif
+ return NULL;
+ }
+ if (mode[0] == '+' || (mode[0] == 'b' && mode[1] == '+'))
+ read_write &= _IO_IS_APPENDING;
+#ifdef F_GETFL
+ fd_flags = _IO_fcntl (fd, F_GETFL);
+#ifndef O_ACCMODE
+#define O_ACCMODE (O_RDONLY|O_WRONLY|O_RDWR)
+#endif
+ if (fd_flags == -1
+ || ((fd_flags & O_ACCMODE) == O_RDONLY && !(read_write & _IO_NO_WRITES))
+ || ((fd_flags & O_ACCMODE) == O_WRONLY && !(read_write & _IO_NO_READS)))
+ return NULL;
+
+ /* The May 93 draft of P1003.4/D14.1 (redesignated as 1003.1b)
+ [System Application Program Interface (API) Amendment 1:
+ Realtime Extensions], Rationale B.8.3.3
+ Open a Stream on a File Descriptor says:
+
+ Although not explicitly required by POSIX.1, a good
+ implementation of append ("a") mode would cause the
+ O_APPEND flag to be set.
+
+ (Historical implementations [such as Solaris2] do a one-time
+ seek in fdopen.)
+
+ However, we do not turn O_APPEND off if the mode is "w" (even
+ though that would seem consistent) because that would be more
+ likely to break historical programs.
+ */
+ if ((posix_mode & O_APPEND) && !(fd_flags & O_APPEND))
+ {
+#ifdef F_SETFL
+ if (_IO_fcntl (fd, F_SETFL, fd_flags | O_APPEND) == -1)
+#endif
+ return NULL;
+ }
+#endif
+
+ fp = (struct _IO_FILE_plus*)malloc(sizeof(struct _IO_FILE_plus));
+ if (fp == NULL)
+ return NULL;
+ _IO_init(&fp->file, 0);
+ _IO_JUMPS(&fp->file) = &_IO_file_jumps;
+ _IO_file_init(&fp->file);
+#if !_IO_UNIFIED_JUMPTABLES
+ fp->vtable = NULL;
+#endif
+ if (_IO_file_attach(&fp->file, fd) == NULL)
+ {
+ _IO_un_link(&fp->file);
+ free (fp);
+ return NULL;
+ }
+ fp->file._flags &= ~_IO_DELETE_DONT_CLOSE;
+
+ fp->file._IO_file_flags =
+ _IO_mask_flags(&fp->file, read_write,
+ _IO_NO_READS+_IO_NO_WRITES+_IO_IS_APPENDING);
+
+ return (_IO_FILE*)fp;
+}
diff --git a/libio/iofflush.c b/libio/iofflush.c
new file mode 100644
index 00000000000..ecb816d4198
--- /dev/null
+++ b/libio/iofflush.c
@@ -0,0 +1,38 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+int
+DEFUN(_IO_fflush, (fp),
+ register _IO_FILE *fp)
+{
+ if (fp == NULL)
+ return _IO_flush_all();
+ else
+ {
+ CHECK_FILE(fp, EOF);
+ return _IO_SYNC (fp) ? EOF : 0;
+ }
+}
diff --git a/libio/iofgetpos.c b/libio/iofgetpos.c
new file mode 100644
index 00000000000..5e7a8632102
--- /dev/null
+++ b/libio/iofgetpos.c
@@ -0,0 +1,46 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include <errno.h>
+/* ANSI explicily requires setting errno to a positive value on failure. */
+
+int
+DEFUN(_IO_fgetpos, (fp, posp),
+ _IO_FILE* fp AND _IO_fpos_t *posp)
+{
+ _IO_fpos_t pos;
+ CHECK_FILE(fp, EOF);
+ pos = _IO_seekoff(fp, 0, _IO_seek_cur, 0);
+ if (pos == _IO_pos_BAD)
+ {
+#ifdef EIO
+ if (errno == 0)
+ errno = EIO;
+#endif
+ return EOF;
+ }
+ *posp = pos;
+ return 0;
+}
diff --git a/libio/iofgets.c b/libio/iofgets.c
new file mode 100644
index 00000000000..7b0b708a208
--- /dev/null
+++ b/libio/iofgets.c
@@ -0,0 +1,40 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+char*
+DEFUN(_IO_fgets, (buf, n, fp),
+ char* buf AND int n AND _IO_FILE* fp)
+{
+ _IO_size_t count;
+ CHECK_FILE(fp, NULL);
+ if (n <= 0)
+ return NULL;
+ count = _IO_getline(fp, buf, n - 1, '\n', 1);
+ if (count == 0 || (fp->_IO_file_flags & _IO_ERR_SEEN))
+ return NULL;
+ buf[count] = 0;
+ return buf;
+}
diff --git a/libio/iofopen.c b/libio/iofopen.c
new file mode 100644
index 00000000000..96910520ce7
--- /dev/null
+++ b/libio/iofopen.c
@@ -0,0 +1,49 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#ifdef __STDC__
+#include <stdlib.h>
+#endif
+
+_IO_FILE *
+DEFUN(_IO_fopen, (filename, mode),
+ const char *filename AND const char *mode)
+{
+ struct _IO_FILE_plus *fp =
+ (struct _IO_FILE_plus*)malloc(sizeof(struct _IO_FILE_plus));
+ if (fp == NULL)
+ return NULL;
+ _IO_init(&fp->file, 0);
+ _IO_JUMPS(&fp->file) = &_IO_file_jumps;
+ _IO_file_init(&fp->file);
+#if !_IO_UNIFIED_JUMPTABLES
+ fp->vtable = NULL;
+#endif
+ if (_IO_file_fopen(&fp->file, filename, mode) != NULL)
+ return (_IO_FILE*)fp;
+ _IO_un_link(&fp->file);
+ free (fp);
+ return NULL;
+}
diff --git a/libio/iofprintf.c b/libio/iofprintf.c
new file mode 100644
index 00000000000..11c76421809
--- /dev/null
+++ b/libio/iofprintf.c
@@ -0,0 +1,48 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+int
+_IO_fprintf
+#ifdef __STDC__
+ (_IO_FILE *fp, const char* format, ...)
+#else
+(fp, format, va_alist) _IO_FILE *fp; char *format; va_dcl
+#endif
+{
+ int ret;
+ va_list args;
+ CHECK_FILE(fp, -1);
+ _IO_va_start(args, format);
+ ret = _IO_vfprintf(fp, format, args);
+ va_end(args);
+ return ret;
+}
diff --git a/libio/iofputs.c b/libio/iofputs.c
new file mode 100644
index 00000000000..7a2580f7e35
--- /dev/null
+++ b/libio/iofputs.c
@@ -0,0 +1,37 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include <string.h>
+
+int
+DEFUN(_IO_fputs, (str, fp),
+ const char *str AND _IO_FILE *fp)
+{
+ _IO_size_t len = strlen(str);
+ CHECK_FILE(fp, EOF);
+ if (_IO_sputn(fp, str, len) != len)
+ return EOF;
+ return 1;
+}
diff --git a/libio/iofread.c b/libio/iofread.c
new file mode 100644
index 00000000000..8516cf30c14
--- /dev/null
+++ b/libio/iofread.c
@@ -0,0 +1,38 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+_IO_size_t
+DEFUN(_IO_fread, (buf, size, count, fp),
+ void *buf AND _IO_size_t size AND _IO_size_t count AND _IO_FILE* fp)
+{
+ _IO_size_t bytes_requested = size*count;
+ _IO_size_t bytes_read;
+ CHECK_FILE(fp, 0);
+ if (bytes_requested == 0)
+ return 0;
+ bytes_read = _IO_sgetn(fp, (char *)buf, bytes_requested);
+ return bytes_requested == bytes_read ? count : bytes_read / size;
+}
diff --git a/libio/iofscanf.c b/libio/iofscanf.c
new file mode 100644
index 00000000000..3e12d9b5315
--- /dev/null
+++ b/libio/iofscanf.c
@@ -0,0 +1,48 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+int
+_IO_fscanf
+#ifdef __STDC__
+ (_IO_FILE *fp, const char* format, ...)
+#else
+(fp, format, va_alist) _IO_FILE *fp; char *format; va_dcl
+#endif
+{
+ int ret;
+ va_list args;
+ CHECK_FILE(fp, EOF);
+ _IO_va_start(args, format);
+ ret = _IO_vfscanf(fp, format, args, NULL);
+ va_end(args);
+ return ret;
+}
diff --git a/libio/iofsetpos.c b/libio/iofsetpos.c
new file mode 100644
index 00000000000..ac8a3deb12d
--- /dev/null
+++ b/libio/iofsetpos.c
@@ -0,0 +1,43 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <libioP.h>
+#include <errno.h>
+
+int
+DEFUN(_IO_fsetpos, (fp, posp),
+ _IO_FILE* fp AND const _IO_fpos_t *posp)
+{
+ CHECK_FILE(fp, EOF);
+ if (_IO_seekpos(fp, *posp, _IOS_INPUT|_IOS_OUTPUT) == _IO_pos_BAD)
+ {
+ /*ANSI explicily requires setting errno to a positive value on failure.*/
+#ifdef EIO
+ if (errno == 0)
+ errno = EIO;
+#endif
+ return EOF;
+ }
+ return 0;
+}
diff --git a/libio/ioftell.c b/libio/ioftell.c
new file mode 100644
index 00000000000..d49ddaac821
--- /dev/null
+++ b/libio/ioftell.c
@@ -0,0 +1,45 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include <errno.h>
+/* ANSI explicily requires setting errno to a positive value on failure. */
+
+long int
+DEFUN(_IO_ftell, (fp),
+ _IO_FILE* fp)
+{
+ _IO_pos_t pos;
+ CHECK_FILE(fp, -1L);
+ pos = _IO_seekoff(fp, 0, _IO_seek_cur, 0);
+ if (pos == _IO_pos_BAD)
+ {
+#ifdef EIO
+ if (errno == 0)
+ errno = EIO;
+#endif
+ return -1L;
+ }
+ return _IO_pos_as_off(pos);
+}
diff --git a/libio/iofwrite.c b/libio/iofwrite.c
new file mode 100644
index 00000000000..eb3cd32b028
--- /dev/null
+++ b/libio/iofwrite.c
@@ -0,0 +1,44 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+_IO_size_t
+DEFUN(_IO_fwrite, (buf, size, count, fp),
+ const void* buf AND _IO_size_t size AND _IO_size_t count
+ AND _IO_FILE *fp)
+{
+ _IO_size_t request = size*count;
+ _IO_size_t written;
+ CHECK_FILE(fp, 0);
+ if (request == 0)
+ return 0;
+ written = _IO_sputn(fp, (const char *)buf, request);
+ /* Many traditional implementations return 0 if size==0 && count > 0,
+ but ANSI seems to require us to return count in this case. */
+ if (written == request)
+ return count;
+ else
+ return written/size;
+}
diff --git a/libio/iogetdelim.c b/libio/iogetdelim.c
new file mode 100644
index 00000000000..ee6c0bf1f19
--- /dev/null
+++ b/libio/iogetdelim.c
@@ -0,0 +1,99 @@
+/*
+Copyright (C) 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifdef __STDC__
+#include <stdlib.h>
+#endif
+#include "libioP.h"
+#include <string.h>
+#include <errno.h>
+
+/* Read up to (and including) a TERMINATOR from FP into *LINEPTR
+ (and null-terminate it). *LINEPTR is a pointer returned from malloc (or
+ NULL), pointing to *N characters of space. It is realloc'ed as
+ necessary. Returns the number of characters read (not including the
+ null terminator), or -1 on error or EOF. */
+
+_IO_ssize_t
+DEFUN(_IO_getdelim, (lineptr, n, delimiter, fp),
+ char **lineptr AND _IO_size_t *n AND int delimiter AND _IO_FILE *fp)
+{
+ register _IO_ssize_t cur_len = 0;
+ _IO_ssize_t len;
+
+ if (lineptr == NULL || n == NULL)
+ {
+#ifdef EINVAL
+ errno = EINVAL;
+#endif
+ return -1;
+ }
+ CHECK_FILE (fp, -1);
+ if (_IO_ferror (fp))
+ return -1;
+
+ if (*lineptr == NULL || *n == 0)
+ {
+ *n = 120;
+ *lineptr = (char *) malloc (*n);
+ if (*lineptr == NULL)
+ return -1;
+ }
+
+ len = fp->_IO_read_end - fp->_IO_read_ptr;
+ if (len <= 0)
+ {
+ if (__underflow (fp) == EOF)
+ return -1;
+ len = fp->_IO_read_end - fp->_IO_read_ptr;
+ }
+
+ for (;;)
+ {
+ _IO_size_t needed;
+ char *t;
+ t = (char *) memchr ((void *) fp->_IO_read_ptr, delimiter, len);
+ if (t != NULL)
+ len = (t - fp->_IO_read_ptr) + 1;
+ /* make enough space for len+1 (for final NUL) bytes. */
+ needed = cur_len + len + 1;
+ if (needed > *n)
+ {
+ if (t == NULL && needed < 2 * *n)
+ needed = 2 * *n; /* Be generous. */
+ *n = needed;
+ *lineptr = (char *) realloc (*lineptr, needed);
+ if (*lineptr == NULL)
+ return -1;
+ }
+ memcpy (*lineptr + cur_len, (void *) fp->_IO_read_ptr, len);
+ fp->_IO_read_ptr += len;
+ cur_len += len;
+ if (t != NULL || __underflow (fp) == EOF)
+ break;
+ len = fp->_IO_read_end - fp->_IO_read_ptr;
+ }
+ (*lineptr)[cur_len] = '\0';
+ return cur_len;
+}
diff --git a/libio/iogetline.c b/libio/iogetline.c
new file mode 100644
index 00000000000..278905d135d
--- /dev/null
+++ b/libio/iogetline.c
@@ -0,0 +1,74 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include <string.h>
+
+/* Algorithm based on that used by Berkeley pre-4.4 fgets implementation.
+
+ Read chars into buf (of size n), until delim is seen.
+ Return number of chars read (at most n).
+ Does not put a terminating '\0' in buf.
+ If extract_delim < 0, leave delimiter unread.
+ If extract_delim > 0, insert delim in output. */
+
+_IO_size_t
+DEFUN(_IO_getline, (fp, buf, n, delim, extract_delim),
+ _IO_FILE *fp AND char* buf AND _IO_size_t n
+ AND int delim AND int extract_delim)
+{
+ register char *ptr = buf;
+ do
+ {
+ _IO_ssize_t len = fp->_IO_read_end - fp->_IO_read_ptr;
+ char *t;
+ if (len <= 0)
+ if (__underflow(fp) == EOF)
+ break;
+ else
+ len = fp->_IO_read_end - fp->_IO_read_ptr;
+ if (len >= n)
+ len = n;
+ t = (char*)memchr((void*)fp->_IO_read_ptr, delim, len);
+ if (t != NULL)
+ {
+ _IO_size_t old_len = ptr-buf;
+ len = t - fp->_IO_read_ptr;
+ if (extract_delim >= 0)
+ {
+ t++;
+ if (extract_delim > 0)
+ len++;
+ }
+ memcpy((void*)ptr, (void*)fp->_IO_read_ptr, len);
+ fp->_IO_read_ptr = t;
+ return old_len + len;
+ }
+ memcpy((void*)ptr, (void*)fp->_IO_read_ptr, len);
+ fp->_IO_read_ptr += len;
+ ptr += len;
+ n -= len;
+ } while (n != 0);
+ return ptr - buf;
+}
diff --git a/libio/iogets.c b/libio/iogets.c
new file mode 100644
index 00000000000..f45d9c16e3f
--- /dev/null
+++ b/libio/iogets.c
@@ -0,0 +1,47 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include <limits.h>
+
+char*
+DEFUN(_IO_gets, (buf),
+ char* buf)
+{
+ _IO_size_t count;
+ int ch = _IO_getc (_IO_stdin);
+ if (ch == EOF)
+ return NULL;
+ if (ch == '\n')
+ count = 0;
+ else
+ {
+ buf[0] = (char)ch;
+ count = _IO_getline(_IO_stdin, buf + 1, INT_MAX, '\n', 0) + 1;
+ if (_IO_stdin->_IO_file_flags & _IO_ERR_SEEN)
+ return NULL;
+ }
+ buf[count] = 0;
+ return buf;
+}
diff --git a/libio/ioignore.c b/libio/ioignore.c
new file mode 100644
index 00000000000..a7c2f286755
--- /dev/null
+++ b/libio/ioignore.c
@@ -0,0 +1,46 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+int
+DEFUN(_IO_ignore, (fp, n),
+ register _IO_FILE *fp AND _IO_size_t n)
+{
+ register _IO_size_t more = n;
+ for (;;)
+ {
+ _IO_ssize_t count = fp->_IO_read_end - fp->_IO_read_ptr;
+ if (count > 0)
+ {
+ if (count > more)
+ count = more;
+ fp->_IO_read_ptr += count;
+ more -= count;
+ }
+ if (more == 0 || __underflow(fp) == EOF)
+ break;
+ }
+ return n - more;
+}
diff --git a/libio/iolibio.h b/libio/iolibio.h
new file mode 100644
index 00000000000..e5de77ea85c
--- /dev/null
+++ b/libio/iolibio.h
@@ -0,0 +1,53 @@
+#include "libio.h"
+
+/* These emulate stdio functionality, but with a different name
+ (_IO_ungetc instead of ungetc), and using _IO_FILE instead of FILE. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern int _IO_fclose __P((_IO_FILE*));
+extern _IO_FILE *_IO_fdopen __P((int, const char*));
+extern int _IO_fflush __P((_IO_FILE*));
+extern int _IO_fgetpos __P((_IO_FILE*, _IO_fpos_t*));
+extern char* _IO_fgets __P((char*, int, _IO_FILE*));
+extern _IO_FILE *_IO_fopen __P((const char*, const char*));
+extern int _IO_fprintf __P((_IO_FILE*, const char*, ...));
+extern int _IO_fputs __P((const char*, _IO_FILE*));
+extern int _IO_fsetpos __P((_IO_FILE*, const _IO_fpos_t *));
+extern long int _IO_ftell __P((_IO_FILE*));
+extern _IO_size_t _IO_fread __P((void*, _IO_size_t, _IO_size_t, _IO_FILE*));
+extern _IO_size_t _IO_fwrite __P((const void*,
+ _IO_size_t, _IO_size_t, _IO_FILE*));
+extern char* _IO_gets __P((char*));
+extern void _IO_perror __P((const char*));
+extern int _IO_printf __P((const char*, ...));
+extern int _IO_puts __P((const char*));
+extern int _IO_scanf __P((const char*, ...));
+extern void _IO_setbuffer __P((_IO_FILE *, char*, _IO_size_t));
+extern int _IO_setvbuf __P((_IO_FILE*, char*, int, _IO_size_t));
+extern int _IO_sscanf __P((const char*, const char*, ...));
+extern int _IO_sprintf __P((char *, const char*, ...));
+extern int _IO_ungetc __P((int, _IO_FILE*));
+extern int _IO_vsscanf __P((const char *, const char *, _IO_va_list));
+extern int _IO_vsprintf __P((char*, const char*, _IO_va_list));
+#ifndef _IO_pos_BAD
+#define _IO_pos_BAD ((_IO_fpos_t)(-1))
+#endif
+#define _IO_clearerr(FP) ((FP)->_flags &= ~(_IO_ERR_SEEN|_IO_EOF_SEEN))
+#define _IO_fseek(__fp, __offset, __whence) \
+ (_IO_seekoff(__fp, __offset, __whence, _IOS_INPUT|_IOS_OUTPUT) == _IO_pos_BAD ? EOF : 0)
+#define _IO_rewind(FILE) (void)_IO_seekoff(FILE, 0, 0, _IOS_INPUT|_IOS_OUTPUT)
+#define _IO_vprintf(FORMAT, ARGS) _IO_vfprintf(_IO_stdout, FORMAT, ARGS)
+#define _IO_freopen(FILENAME, MODE, FP) \
+ (_IO_file_close_it(FP), _IO_file_fopen(FP, FILENAME, MODE))
+#define _IO_fileno(FP) ((FP)->_fileno)
+extern _IO_FILE* _IO_popen __P((const char*, const char*));
+#define _IO_pclose _IO_fclose
+#define _IO_setbuf(_FP, _BUF) _IO_setbuffer(_FP, _BUF, _IO_BUFSIZ)
+#define _IO_setlinebuf(_FP) _IO_setvbuf(_FP, NULL, 1, 0)
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/libio/iomanip.cc b/libio/iomanip.cc
new file mode 100644
index 00000000000..fddba55a2b9
--- /dev/null
+++ b/libio/iomanip.cc
@@ -0,0 +1,90 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+
+#include "iomanip.h"
+
+
+// Those functions are called through a pointer,
+// thus it does not make sense, to inline them.
+
+ios & __iomanip_setbase (ios& i, int n)
+{
+ ios::fmtflags b;
+ switch (n)
+ {
+ case 8:
+ b = ios::oct; break;
+ case 10:
+ b = ios::dec; break;
+ case 16:
+ b = ios::hex; break;
+ default:
+ b = 0;
+ }
+ i.setf(b, ios::basefield);
+ return i;
+}
+
+ios & __iomanip_setfill (ios& i, int n)
+{
+ //FIXME if ( i.flags() & ios::widechar )
+ i.fill( (char) n);
+ //FIXME else
+ //FIXME i.fill( (wchar) n);
+ return i;
+}
+
+ios & __iomanip_setprecision (ios& i, int n)
+{
+ i.precision(n);
+ return i;
+}
+ios & __iomanip_setw (ios& i, int n)
+{
+ i.width(n);
+ return i;
+}
+
+ios & __iomanip_setiosflags (ios& i, ios::fmtflags n)
+{
+ i.setf(n,n);
+ return i;
+}
+
+ios & __iomanip_resetiosflags (ios& i, ios::fmtflags n)
+{
+ i.setf(0,n);
+ return i;
+}
+
+template class smanip<int>;
+template class smanip<ios::fmtflags>;
+template istream& operator>>(istream&, const smanip<int>&);
+template istream& operator>>(istream&, const smanip<ios::fmtflags>&);
+template ostream& operator<<(ostream&, const smanip<int>&);
+template ostream& operator<<(ostream&, const smanip<ios::fmtflags>&);
diff --git a/libio/iomanip.h b/libio/iomanip.h
new file mode 100644
index 00000000000..fe1156569b4
--- /dev/null
+++ b/libio/iomanip.h
@@ -0,0 +1,165 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifndef _IOMANIP_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+#define _IOMANIP_H
+
+#include <iostream.h>
+
+extern "C++" {
+//-----------------------------------------------------------------------------
+// Parametrized Manipulators as specified by ANSI draft
+//-----------------------------------------------------------------------------
+
+//-----------------------------------------------------------------------------
+// Stream Manipulators
+//-----------------------------------------------------------------------------
+//
+template<class TP> class smanip; // TP = Type Param
+
+template<class TP> class sapp {
+ ios& (*_f)(ios&, TP);
+public:
+ sapp(ios& (*f)(ios&, TP)) : _f(f) {}
+ //
+ smanip<TP> operator()(TP a)
+ { return smanip<TP>(_f, a); }
+};
+
+template <class TP> class smanip {
+ ios& (*_f)(ios&, TP);
+ TP _a;
+public:
+ smanip(ios& (*f)(ios&, TP), TP a) : _f(f), _a(a) {}
+ //
+ friend
+ istream& operator>>(istream& i, const smanip<TP>& m);
+ friend
+ ostream& operator<<(ostream& o, const smanip<TP>& m);
+};
+
+#ifdef __GNUG__
+extern template class smanip<int>;
+extern template class smanip<ios::fmtflags>;
+#endif
+
+template<class TP>
+inline istream& operator>>(istream& i, const smanip<TP>& m)
+{ (*m._f)(i, m._a); return i; }
+
+template<class TP>
+inline ostream& operator<<(ostream& o, const smanip<TP>& m)
+{ (*m._f)(o, m._a); return o;}
+
+#ifdef __GNUG__
+extern template istream& operator>>(istream&, const smanip<int>&);
+extern template istream& operator>>(istream&, const smanip<ios::fmtflags>&);
+extern template ostream& operator<<(ostream&, const smanip<int>&);
+extern template ostream& operator<<(ostream&, const smanip<ios::fmtflags>&);
+#endif
+
+//-----------------------------------------------------------------------------
+// Input-Stream Manipulators
+//-----------------------------------------------------------------------------
+//
+template<class TP> class imanip;
+
+template<class TP> class iapp {
+ istream& (*_f)(istream&, TP);
+public:
+ iapp(istream& (*f)(istream&,TP)) : _f(f) {}
+ //
+ imanip<TP> operator()(TP a)
+ { return imanip<TP>(_f, a); }
+};
+
+template <class TP> class imanip {
+ istream& (*_f)(istream&, TP);
+ TP _a;
+public:
+ imanip(istream& (*f)(istream&, TP), TP a) : _f(f), _a(a) {}
+ //
+ friend
+ istream& operator>>(istream& i, const imanip<TP>& m);
+};
+
+template <class TP>
+inline istream& operator>>(istream& i, const imanip<TP>& m)
+{ return (*m._f)( i, m._a); }
+
+//-----------------------------------------------------------------------------
+// Output-Stream Manipulators
+//-----------------------------------------------------------------------------
+//
+template<class TP> class omanip;
+
+template<class TP> class oapp {
+ ostream& (*_f)(ostream&, TP);
+public:
+ oapp(ostream& (*f)(ostream&,TP)) : _f(f) {}
+ //
+ omanip<TP> operator()(TP a)
+ { return omanip<TP>(_f, a); }
+};
+
+template <class TP> class omanip {
+ ostream& (*_f)(ostream&, TP);
+ TP _a;
+public:
+ omanip(ostream& (*f)(ostream&, TP), TP a) : _f(f), _a(a) {}
+ //
+ friend
+ ostream& operator<<(ostream& o, const omanip<TP>& m);
+};
+
+template <class TP>
+inline ostream& operator<<(ostream& o, const omanip<TP>& m)
+{ return (*m._f)(o, m._a); }
+
+//-----------------------------------------------------------------------------
+// Available Manipulators
+//-----------------------------------------------------------------------------
+
+//
+// Macro to define an iomanip function, with one argument
+// The underlying function is `__iomanip_<name>'
+//
+#define __DEFINE_IOMANIP_FN1(type,param,function) \
+ extern ios& __iomanip_##function (ios&, param); \
+ inline type<param> function (param n) \
+ { return type<param> (__iomanip_##function, n); }
+
+__DEFINE_IOMANIP_FN1( smanip, int, setbase)
+__DEFINE_IOMANIP_FN1( smanip, int, setfill)
+__DEFINE_IOMANIP_FN1( smanip, int, setprecision)
+__DEFINE_IOMANIP_FN1( smanip, int, setw)
+
+__DEFINE_IOMANIP_FN1( smanip, ios::fmtflags, resetiosflags)
+__DEFINE_IOMANIP_FN1( smanip, ios::fmtflags, setiosflags)
+} // extern "C++"
+
+#endif /*!_IOMANIP_H*/
diff --git a/libio/iopadn.c b/libio/iopadn.c
new file mode 100644
index 00000000000..0e502b712c3
--- /dev/null
+++ b/libio/iopadn.c
@@ -0,0 +1,65 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#define PADSIZE 16
+static char const blanks[PADSIZE] =
+{' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '};
+static char const zeroes[PADSIZE] =
+{'0','0','0','0','0','0','0','0','0','0','0','0','0','0','0','0'};
+
+_IO_ssize_t
+DEFUN(_IO_padn, (fp, pad, count),
+ _IO_FILE *fp AND int pad AND _IO_ssize_t count)
+{
+ char padbuf[PADSIZE];
+ const char *padptr;
+ register int i;
+ _IO_size_t written = 0, w;
+
+ if (pad == ' ')
+ padptr = blanks;
+ else if (pad == '0')
+ padptr = zeroes;
+ else
+ {
+ for (i = PADSIZE; --i >= 0; ) padbuf[i] = pad;
+ padptr = padbuf;
+ }
+ for (i = count; i >= PADSIZE; i -= PADSIZE)
+ {
+ w = _IO_sputn(fp, padptr, PADSIZE);
+ written += w;
+ if (w != PADSIZE)
+ return written;
+ }
+
+ if (i > 0)
+ {
+ w = _IO_sputn(fp, padptr, i);
+ written += w;
+ }
+ return written;
+}
diff --git a/libio/ioperror.c b/libio/ioperror.c
new file mode 100644
index 00000000000..55d822b63a6
--- /dev/null
+++ b/libio/ioperror.c
@@ -0,0 +1,22 @@
+#include "libioP.h"
+#include <errno.h>
+#include <string.h>
+#ifndef errno
+extern int errno;
+#endif
+
+#ifndef _IO_strerror
+extern char* _IO_strerror __P((int));
+#endif
+
+void
+DEFUN(_IO_perror, (s),
+ const char *s)
+{
+ char *error = _IO_strerror (errno);
+
+ if (s != NULL && *s != '\0')
+ _IO_fprintf (_IO_stderr, "%s:", s);
+
+ _IO_fprintf (_IO_stderr, "%s\n", error ? error : "");
+}
diff --git a/libio/iopopen.c b/libio/iopopen.c
new file mode 100644
index 00000000000..ef6ad12449f
--- /dev/null
+++ b/libio/iopopen.c
@@ -0,0 +1,222 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* written by Per Bothner (bothner@cygnus.com) */
+
+#define _POSIX_SOURCE
+#include "libioP.h"
+#include <sys/types.h>
+#if _IO_HAVE_SYS_WAIT
+#include <signal.h>
+#include <unistd.h>
+#ifdef __STDC__
+#include <stdlib.h>
+#endif
+#include <sys/wait.h>
+
+#ifndef _IO_fork
+#define _IO_fork vfork /* defined in libiberty, if needed */
+_IO_pid_t _IO_fork();
+#endif
+
+#endif /* _IO_HAVE_SYS_WAIT */
+
+#ifndef _IO_pipe
+#define _IO_pipe pipe
+extern int _IO_pipe();
+#endif
+
+#ifndef _IO_dup2
+#define _IO_dup2 dup2
+extern int _IO_dup2();
+#endif
+
+#ifndef _IO_waitpid
+#define _IO_waitpid waitpid
+#endif
+
+#ifndef _IO_execl
+#define _IO_execl execl
+#endif
+#ifndef _IO__exit
+#define _IO__exit _exit
+#endif
+
+struct _IO_proc_file
+{
+ struct _IO_FILE_plus file;
+ /* Following fields must match those in class procbuf (procbuf.h) */
+ _IO_pid_t pid;
+ struct _IO_proc_file *next;
+};
+typedef struct _IO_proc_file _IO_proc_file;
+
+static struct _IO_proc_file *proc_file_chain = NULL;
+
+_IO_FILE *
+DEFUN(_IO_proc_open, (fp, command, mode),
+ _IO_FILE* fp AND const char *command AND const char *mode)
+{
+#if _IO_HAVE_SYS_WAIT
+ int read_or_write;
+ int pipe_fds[2];
+ int parent_end, child_end;
+ _IO_pid_t child_pid;
+ if (_IO_file_is_open(fp))
+ return NULL;
+ if (_IO_pipe(pipe_fds) < 0)
+ return NULL;
+ if (mode[0] == 'r')
+ {
+ parent_end = pipe_fds[0];
+ child_end = pipe_fds[1];
+ read_or_write = _IO_NO_WRITES;
+ }
+ else
+ {
+ parent_end = pipe_fds[1];
+ child_end = pipe_fds[0];
+ read_or_write = _IO_NO_READS;
+ }
+ ((_IO_proc_file*)fp)->pid = child_pid = _IO_fork();
+ if (child_pid == 0)
+ {
+ int child_std_end = mode[0] == 'r' ? 1 : 0;
+ _IO_close(parent_end);
+ if (child_end != child_std_end)
+ {
+ _IO_dup2(child_end, child_std_end);
+ _IO_close(child_end);
+ }
+ /* Posix.2: "popen() shall ensure that any streams from previous
+ popen() calls that remain open in the parent process are closed
+ in the new child process." */
+ while (proc_file_chain)
+ {
+ _IO_close (_IO_fileno ((_IO_FILE *) proc_file_chain));
+ proc_file_chain = proc_file_chain->next;
+ }
+
+ _IO_execl("/bin/sh", "sh", "-c", command, (char *)0);
+ _IO__exit(127);
+ }
+ _IO_close(child_end);
+ if (child_pid < 0)
+ {
+ _IO_close(parent_end);
+ return NULL;
+ }
+ _IO_fileno(fp) = parent_end;
+
+ /* Link into proc_file_chain. */
+ ((_IO_proc_file*)fp)->next = proc_file_chain;
+ proc_file_chain = (_IO_proc_file*)fp;
+
+ _IO_mask_flags (fp, read_or_write, _IO_NO_READS|_IO_NO_WRITES);
+ return fp;
+#else /* !_IO_HAVE_SYS_WAIT */
+ return NULL;
+#endif
+}
+
+_IO_FILE *
+DEFUN(_IO_popen, (command, mode),
+ const char *command AND const char *mode)
+{
+ _IO_proc_file *fpx = (_IO_proc_file*)malloc(sizeof(_IO_proc_file));
+ _IO_FILE *fp = (_IO_FILE*)fpx;
+ if (fp == NULL)
+ return NULL;
+ _IO_init(fp, 0);
+ _IO_JUMPS(fp) = &_IO_proc_jumps;
+ _IO_file_init(fp);
+#if !_IO_UNIFIED_JUMPTABLES
+ ((struct _IO_FILE_plus*)fp)->vtable = NULL;
+#endif
+ if (_IO_proc_open (fp, command, mode) != NULL)
+ return fp;
+ free (fpx);
+ return NULL;
+}
+
+int
+DEFUN(_IO_proc_close, (fp),
+ _IO_FILE *fp)
+{
+ /* This is not name-space clean. FIXME! */
+#if _IO_HAVE_SYS_WAIT
+ int wstatus;
+ _IO_proc_file **ptr = &proc_file_chain;
+ _IO_pid_t wait_pid;
+ int status = -1;
+
+ /* Unlink from proc_file_chain. */
+ for ( ; *ptr != NULL; ptr = &(*ptr)->next)
+ {
+ if (*ptr == (_IO_proc_file*)fp)
+ {
+ *ptr = (*ptr)->next;
+ status = 0;
+ break;
+ }
+ }
+
+ if (status < 0 || _IO_close(_IO_fileno(fp)) < 0)
+ return -1;
+ /* POSIX.2 Rationale: "Some historical implementations either block
+ or ignore the signals SIGINT, SIGQUIT, and SIGHUP while waiting
+ for the child process to terminate. Since this behavior is not
+ described in POSIX.2, such implementations are not conforming." */
+ do
+ {
+ wait_pid = _IO_waitpid (((_IO_proc_file*)fp)->pid, &wstatus, 0);
+ } while (wait_pid == -1 && errno == EINTR);
+ if (wait_pid == -1)
+ return -1;
+ return wstatus;
+#else /* !_IO_HAVE_SYS_WAIT */
+ return -1;
+#endif
+}
+
+struct _IO_jump_t _IO_proc_jumps = {
+ JUMP_INIT_DUMMY,
+ JUMP_INIT(finish, _IO_file_finish),
+ JUMP_INIT(overflow, _IO_file_overflow),
+ JUMP_INIT(underflow, _IO_file_underflow),
+ JUMP_INIT(uflow, _IO_default_uflow),
+ JUMP_INIT(pbackfail, _IO_default_pbackfail),
+ JUMP_INIT(xsputn, _IO_file_xsputn),
+ JUMP_INIT(xsgetn, _IO_default_xsgetn),
+ JUMP_INIT(seekoff, _IO_file_seekoff),
+ JUMP_INIT(seekpos, _IO_default_seekpos),
+ JUMP_INIT(setbuf, _IO_file_setbuf),
+ JUMP_INIT(sync, _IO_file_sync),
+ JUMP_INIT(doallocate, _IO_file_doallocate),
+ JUMP_INIT(read, _IO_file_read),
+ JUMP_INIT(write, _IO_file_write),
+ JUMP_INIT(seek, _IO_file_seek),
+ JUMP_INIT(close, _IO_proc_close),
+ JUMP_INIT(stat, _IO_file_stat)
+};
diff --git a/libio/ioprims.c b/libio/ioprims.c
new file mode 100644
index 00000000000..faa69e0feff
--- /dev/null
+++ b/libio/ioprims.c
@@ -0,0 +1,72 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* I/O OS-level primitives.
+ Needs to be replaced if not using Unix.
+ Also needs to be replaced if avoiding name-space pollution
+ (in which case read would be defined in terms of _IO_read,
+ rather than vice versa). */
+
+#include "libioP.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#ifdef TODO
+/* Add open, isatty */
+#endif
+
+_IO_ssize_t
+DEFUN(_IO_read, (fildes, buf, nbyte),
+ int fildes AND void *buf AND _IO_size_t nbyte)
+{
+ return read (fildes, buf, nbyte);
+}
+
+_IO_ssize_t
+DEFUN(_IO_write, (fildes, buf, nbyte),
+ int fildes AND const void *buf AND _IO_size_t nbyte)
+{
+ return write (fildes, buf, nbyte);
+}
+
+_IO_off_t
+DEFUN(_IO_lseek, (fildes, offset, whence),
+ int fildes AND _IO_off_t offset AND int whence)
+{
+ return lseek (fildes, offset, whence);
+}
+
+int
+DEFUN(_IO_close, (fildes),
+ int fildes)
+{
+ return close (fildes);
+}
+
+int
+DEFUN(_IO_fstat, (fildes, buf),
+ int fildes AND struct stat *buf)
+{
+ return fstat (fildes, buf);
+}
diff --git a/libio/ioprintf.c b/libio/ioprintf.c
new file mode 100644
index 00000000000..0b99c2a6637
--- /dev/null
+++ b/libio/ioprintf.c
@@ -0,0 +1,47 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+int
+_IO_printf
+#ifdef __STDC__
+ (const char* format, ...)
+#else
+(format, va_alist) char *format; va_dcl
+#endif
+{
+ int ret;
+ va_list args;
+ _IO_va_start(args, format);
+ ret = _IO_vfprintf(_IO_stdout, format, args);
+ va_end(args);
+ return ret;
+}
diff --git a/libio/ioputs.c b/libio/ioputs.c
new file mode 100644
index 00000000000..f0a81642853
--- /dev/null
+++ b/libio/ioputs.c
@@ -0,0 +1,38 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include <string.h>
+
+int
+DEFUN(_IO_puts, (str),
+ const char *str)
+{
+ _IO_size_t len = strlen(str);
+ if (_IO_sputn(_IO_stdout, str, len) != len)
+ return EOF;
+ if (_IO_putc('\n', _IO_stdout) == EOF)
+ return EOF;
+ return len+1;
+}
diff --git a/libio/ioscanf.c b/libio/ioscanf.c
new file mode 100644
index 00000000000..405d1e2eb0f
--- /dev/null
+++ b/libio/ioscanf.c
@@ -0,0 +1,47 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+int
+_IO_scanf
+#ifdef __STDC__
+ (const char* format, ...)
+#else
+(format, va_alist) char *format; va_dcl
+#endif
+{
+ int ret;
+ va_list args;
+ _IO_va_start(args, format);
+ ret = _IO_vfscanf(_IO_stdin, format, args, NULL);
+ va_end(args);
+ return ret;
+}
diff --git a/libio/ioseekoff.c b/libio/ioseekoff.c
new file mode 100644
index 00000000000..06f4b9d2fe1
--- /dev/null
+++ b/libio/ioseekoff.c
@@ -0,0 +1,43 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <libioP.h>
+
+_IO_pos_t
+DEFUN(_IO_seekoff, (fp, offset, dir, mode),
+ _IO_FILE* fp AND _IO_off_t offset AND int dir AND int mode)
+{
+ /* If we have a backup buffer, get rid of it, since the __seekoff
+ callback may not know to do the right thing about it.
+ This may be over-kill, but it'll do for now. TODO */
+
+ if (_IO_have_backup (fp))
+ {
+ if (dir == _IO_seek_cur && _IO_in_backup (fp))
+ offset -= fp->_IO_read_end - fp->_IO_read_ptr;
+ _IO_free_backup_area (fp);
+ }
+
+ return _IO_SEEKOFF (fp, offset, dir, mode);
+}
diff --git a/libio/ioseekpos.c b/libio/ioseekpos.c
new file mode 100644
index 00000000000..1884f9df8f7
--- /dev/null
+++ b/libio/ioseekpos.c
@@ -0,0 +1,39 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <libioP.h>
+
+_IO_pos_t
+DEFUN(_IO_seekpos, (fp, pos, mode),
+ _IO_FILE* fp AND _IO_pos_t pos AND int mode)
+{
+ /* If we have a backup buffer, get rid of it, since the __seekoff
+ callback may not know to do the right thing about it.
+ This may be over-kill, but it'll do for now. TODO */
+
+ if (_IO_have_backup (fp))
+ _IO_free_backup_area (fp);
+
+ return _IO_SEEKPOS (fp, pos, mode);
+}
diff --git a/libio/iosetbuffer.c b/libio/iosetbuffer.c
new file mode 100644
index 00000000000..eb78d75d9ab
--- /dev/null
+++ b/libio/iosetbuffer.c
@@ -0,0 +1,36 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+void
+DEFUN(_IO_setbuffer, (fp, buf, size),
+ _IO_FILE *fp AND char *buf AND _IO_size_t size)
+{
+ CHECK_FILE(fp, );
+ fp->_flags &= ~_IO_LINE_BUF;
+ if (!buf)
+ size = 0;
+ (void) _IO_SETBUF (fp, buf, size);
+}
diff --git a/libio/iosetvbuf.c b/libio/iosetvbuf.c
new file mode 100644
index 00000000000..1b2da4f104c
--- /dev/null
+++ b/libio/iosetvbuf.c
@@ -0,0 +1,78 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#define _IOFBF 0 /* Fully buffered. */
+#define _IOLBF 1 /* Line buffered. */
+#define _IONBF 2 /* No buffering. */
+
+int
+DEFUN(_IO_setvbuf, (fp, buf, mode, size),
+ _IO_FILE* fp AND char* buf AND int mode AND _IO_size_t size)
+{
+ CHECK_FILE(fp, EOF);
+ switch (mode)
+ {
+ case _IOFBF:
+ fp->_IO_file_flags &= ~_IO_LINE_BUF|_IO_UNBUFFERED;
+ if (buf == NULL)
+ {
+ if (fp->_IO_buf_base == NULL)
+ {
+ /* There is no flag to distinguish between "fully buffered
+ mode has been explicitly set" as opposed to "line
+ buffering has not been explicitly set". In both
+ cases, _IO_LINE_BUF is off. If this is a tty, and
+ _IO_filedoalloc later gets called, it cannot know if
+ it should set the _IO_LINE_BUF flag (because that is
+ the default), or not (because we have explicitly asked
+ for fully buffered mode). So we make sure a buffer
+ gets allocated now, and explicitly turn off line
+ buffering.
+
+ A possibly cleaner alternative would be to add an
+ extra flag, but then flags are a finite resource. */
+ if (_IO_DOALLOCATE (fp) < 0)
+ return EOF;
+ fp->_IO_file_flags &= ~_IO_LINE_BUF;
+ }
+ return 0;
+ }
+ break;
+ case _IOLBF:
+ fp->_IO_file_flags &= ~_IO_UNBUFFERED;
+ fp->_IO_file_flags |= _IO_LINE_BUF;
+ if (buf == NULL)
+ return 0;
+ break;
+ case _IONBF:
+ buf = NULL;
+ size = 0;
+ break;
+ default:
+ return EOF;
+ }
+ return _IO_SETBUF (fp, buf, size) == NULL ? EOF : 0;
+}
diff --git a/libio/iosprintf.c b/libio/iosprintf.c
new file mode 100644
index 00000000000..b873eb4455d
--- /dev/null
+++ b/libio/iosprintf.c
@@ -0,0 +1,47 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+int
+_IO_sprintf
+#ifdef __STDC__
+ (char *string, const char* format, ...)
+#else
+(string, format, va_alist) char *string; char *format; va_dcl
+#endif
+{
+ int ret;
+ va_list args;
+ _IO_va_start(args, format);
+ ret = _IO_vsprintf(string, format, args);
+ va_end(args);
+ return ret;
+}
diff --git a/libio/iosscanf.c b/libio/iosscanf.c
new file mode 100644
index 00000000000..58868778c48
--- /dev/null
+++ b/libio/iosscanf.c
@@ -0,0 +1,47 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+int
+_IO_sscanf
+#ifdef __STDC__
+ (const char * string, const char* format, ...)
+#else
+(string, format, va_alist) char *string; char *format; va_dcl
+#endif
+{
+ int ret;
+ va_list args;
+ _IO_va_start(args, format);
+ ret = _IO_vsscanf(string, format, args);
+ va_end(args);
+ return ret;
+}
diff --git a/libio/iostdio.h b/libio/iostdio.h
new file mode 100644
index 00000000000..9ed47a4654a
--- /dev/null
+++ b/libio/iostdio.h
@@ -0,0 +1,114 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* This file defines a stdio-like environment, except that it avoid
+ link-time name clashes with an existing stdio.
+ It allows for testing the libio using stdio-using programs
+ with an incompatible libc.a.
+ It is not predantically correct - e.g. some macros are used
+ that may evaluate a stream argument more than once. */
+
+#ifndef _IOSTDIO_H
+#define _IOSTDIO_H
+
+#include "iolibio.h"
+
+typedef _IO_FILE FILE;
+#ifndef EOF
+#define EOF (-1)
+#endif
+#ifndef BUFSIZ
+#define BUFSIZ 1024
+#endif
+
+/* #define size_t, fpos_t L_tmpname TMP_MAX */
+
+#define _IOFBF 0 /* Fully buffered. */
+#define _IOLBF 1 /* Line buffered. */
+#define _IONBF 2 /* No buffering. */
+
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+
+#define stdin _IO_stdin
+#define stdout _IO_stdout
+#define stderr _IO_stderr
+
+#define getc(_fp) _IO_getc(_fp)
+#define putc(_ch, _fp) _IO_putc(_ch, _fp)
+
+#define clearerr _IO_clearerr
+#define fclose _IO_fclose
+#define feof _IO_feof
+#define ferror _IO_ferror
+#define fflush _IO_fflush
+#define fgetc(__fp) _IO_getc(_fp)
+#define fgetpos _IO_fgetpos
+#define fgets _IO_fgets
+#define fopen _IO_fopen
+#define fprintf _IO_fprintf
+#define fputc(_ch, _fp) _IO_putc(_ch, _fp)
+#define fputs _IO_fputs
+#define fread _IO_fread
+#define freopen _IO_freopen
+#define fscanf _IO_fscanf
+#define fseek _IO_fseek
+#define fsetpos _IO_fsetpos
+#define ftell _IO_ftell
+#define fwrite _IO_fwrite
+#define gets _IO_gets
+#define perror _IO_perror
+#define printf _IO_printf
+#define puts _IO_puts
+#define rewind _IO_rewind
+#define scanf _IO_scanf
+#define setbuf _IO_setbuf
+#define setbuffer _IO_setbuffer
+#define setvbuf _IO_setvbuf
+#define sprintf _IO_sprintf
+#define sscanf _IO_sscanf
+#define ungetc _IO_ungetc
+#define vfprintf _IO_vfprintf
+#define vprintf(__fmt, __args) vfprintf(stdout, __fmt, __args)
+#define vsprintf _IO_vsprintf
+
+#if 0
+/* We can use the libc versions of these, since they don't pass FILE*s. */
+#define remove ??? __P((const char*))
+#define rename ??? __P((const char* _old, const char* _new))
+#define tmpfile ??? __P((void))
+#define tmpnam ??? __P((char*))
+#endif
+
+#if !defined(__STRICT_ANSI__) || defined(_POSIX_SOURCE)
+#define fdopen _IO_fdopen
+#define fileno _IO_fileno
+#define popen _IO_popen
+#define pclose _IO_pclose
+#define setbuf _IO_setbuf
+#define setlinebuf _IO_setlinebuf
+#endif
+
+#endif /* _IOSTDIO_H */
diff --git a/libio/iostream.cc b/libio/iostream.cc
new file mode 100644
index 00000000000..78b09cb6af3
--- /dev/null
+++ b/libio/iostream.cc
@@ -0,0 +1,821 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUC__
+#pragma implementation
+#endif
+#define _STREAM_COMPAT
+#include <iostream.h>
+#include "libioP.h"
+#include <stdio.h> /* Needed for sprintf */
+#include <ctype.h>
+#include <string.h>
+#include <limits.h>
+#include "floatio.h"
+
+#define BUF (MAXEXP+MAXFRACT+1) /* + decimal point */
+
+//#define isspace(ch) ((ch)==' ' || (ch)=='\t' || (ch)=='\n')
+
+istream::istream(streambuf *sb, ostream* tied)
+{
+ init (sb, tied);
+ _gcount = 0;
+}
+
+int skip_ws(streambuf* sb)
+{
+ int ch;
+ for (;;) {
+ ch = sb->sbumpc();
+ if (ch == EOF || !isspace(ch))
+ return ch;
+ }
+}
+
+istream& istream::get(char& c)
+{
+ if (ipfx1()) {
+ int ch = _strbuf->sbumpc();
+ if (ch == EOF) {
+ set(ios::eofbit|ios::failbit);
+ _gcount = 0;
+ }
+ else {
+ c = (char)ch;
+ _gcount = 1;
+ }
+ }
+ else
+ _gcount = 0;
+ return *this;
+}
+
+int istream::peek()
+{
+ if (!good())
+ return EOF;
+ if (_tie && rdbuf()->in_avail() == 0)
+ _tie->flush();
+ int ch = _strbuf->sgetc();
+ if (ch == EOF)
+ set(ios::eofbit);
+ return ch;
+}
+
+istream& istream::ignore(int n /* = 1 */, int delim /* = EOF */)
+{
+ _gcount = 0;
+ if (ipfx1()) {
+ register streambuf* sb = _strbuf;
+ if (delim == EOF) {
+ _gcount = sb->ignore(n);
+ return *this;
+ }
+ for (;;) {
+#if 0
+ if (n != MAXINT) // FIXME
+#endif
+ if (--n < 0)
+ break;
+ int ch = sb->sbumpc();
+ if (ch == EOF) {
+ set(ios::eofbit|ios::failbit);
+ break;
+ }
+ _gcount++;
+ if (ch == delim)
+ break;
+ }
+ }
+ return *this;
+}
+
+istream& istream::read(char *s, streamsize n)
+{
+ if (ipfx1()) {
+ _gcount = _strbuf->sgetn(s, n);
+ if (_gcount != n)
+ set(ios::failbit|ios::eofbit);
+ }
+ else
+ _gcount = 0;
+ return *this;
+}
+
+int
+istream::sync ()
+{
+ streambuf *sb = rdbuf ();
+ if (sb == NULL)
+ return EOF;
+ if (sb->sync ()) // Later: pubsync
+ {
+ setstate (ios::badbit);
+ return EOF;
+ }
+ else
+ return 0;
+}
+
+istream& istream::seekg(streampos pos)
+{
+ pos = _strbuf->pubseekpos(pos, ios::in);
+ if (pos == streampos(EOF))
+ set(ios::badbit);
+ return *this;
+}
+
+istream& istream::seekg(streamoff off, _seek_dir dir)
+{
+ streampos pos = _IO_seekoff (_strbuf, off, (int) dir, _IOS_INPUT);
+ if (pos == streampos(EOF))
+ set(ios::badbit);
+ return *this;
+}
+
+streampos istream::tellg()
+{
+#if 0
+ streampos pos = _strbuf->pubseekoff(0, ios::cur, ios::in);
+#else
+ streampos pos = _IO_seekoff (_strbuf, 0, _IO_seek_cur, _IOS_INPUT);
+#endif
+ if (pos == streampos(EOF))
+ set(ios::badbit);
+ return pos;
+}
+
+istream& istream::operator>>(char& c)
+{
+ if (ipfx0()) {
+ int ch = _strbuf->sbumpc();
+ if (ch == EOF)
+ set(ios::eofbit|ios::failbit);
+ else
+ c = (char)ch;
+ }
+ return *this;
+}
+
+istream&
+istream::operator>> (char* ptr)
+{
+ register char *p = ptr;
+ int w = width(0);
+ if (ipfx0())
+ {
+ register streambuf* sb = _strbuf;
+ for (;;)
+ {
+ int ch = sb->sbumpc();
+ if (ch == EOF)
+ {
+ set(ios::eofbit);
+ break;
+ }
+ else if (isspace(ch) || w == 1)
+ {
+ sb->sputbackc(ch);
+ break;
+ }
+ else *p++ = ch;
+ w--;
+ }
+ if (p == ptr)
+ set(ios::failbit);
+ }
+ *p = '\0';
+ return *this;
+}
+
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__)
+#define LONGEST long long
+#else
+#define LONGEST long
+#endif
+
+static int read_int(istream& stream, unsigned LONGEST& val, int& neg)
+{
+ if (!stream.ipfx0())
+ return 0;
+ register streambuf* sb = stream.rdbuf();
+ int base = 10;
+ int ndigits = 0;
+ register int ch = skip_ws(sb);
+ if (ch == EOF)
+ goto eof_fail;
+ neg = 0;
+ if (ch == '+') {
+ ch = skip_ws(sb);
+ }
+ else if (ch == '-') {
+ neg = 1;
+ ch = skip_ws(sb);
+ }
+ if (ch == EOF) goto eof_fail;
+ if (!(stream.flags() & ios::basefield)) {
+ if (ch == '0') {
+ ch = sb->sbumpc();
+ if (ch == EOF) {
+ val = 0;
+ return 1;
+ }
+ if (ch == 'x' || ch == 'X') {
+ base = 16;
+ ch = sb->sbumpc();
+ if (ch == EOF) goto eof_fail;
+ }
+ else {
+ sb->sputbackc(ch);
+ base = 8;
+ ch = '0';
+ }
+ }
+ }
+ else if ((stream.flags() & ios::basefield) == ios::hex)
+ base = 16;
+ else if ((stream.flags() & ios::basefield) == ios::oct)
+ base = 8;
+ val = 0;
+ for (;;) {
+ if (ch == EOF)
+ break;
+ int digit;
+ if (ch >= '0' && ch <= '9')
+ digit = ch - '0';
+ else if (ch >= 'A' && ch <= 'F')
+ digit = ch - 'A' + 10;
+ else if (ch >= 'a' && ch <= 'f')
+ digit = ch - 'a' + 10;
+ else
+ digit = 999;
+ if (digit >= base) {
+ sb->sputbackc(ch);
+ if (ndigits == 0)
+ goto fail;
+ else
+ return 1;
+ }
+ ndigits++;
+ val = base * val + digit;
+ ch = sb->sbumpc();
+ }
+ return 1;
+ fail:
+ stream.set(ios::failbit);
+ return 0;
+ eof_fail:
+ stream.set(ios::failbit|ios::eofbit);
+ return 0;
+}
+
+#define READ_INT(TYPE) \
+istream& istream::operator>>(TYPE& i)\
+{\
+ unsigned LONGEST val; int neg;\
+ if (read_int(*this, val, neg)) {\
+ if (neg) val = -val;\
+ i = (TYPE)val;\
+ }\
+ return *this;\
+}
+
+READ_INT(short)
+READ_INT(unsigned short)
+READ_INT(int)
+READ_INT(unsigned int)
+READ_INT(long)
+READ_INT(unsigned long)
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__)
+READ_INT(long long)
+READ_INT(unsigned long long)
+#endif
+#if _G_HAVE_BOOL
+READ_INT(bool)
+#endif
+
+istream& istream::operator>>(long double& x)
+{
+ if (ipfx0())
+ scan("%lg", &x);
+ return *this;
+}
+
+istream& istream::operator>>(double& x)
+{
+ if (ipfx0())
+ scan("%lg", &x);
+ return *this;
+}
+
+istream& istream::operator>>(float& x)
+{
+ if (ipfx0())
+ scan("%g", &x);
+ return *this;
+}
+
+istream& istream::operator>>(register streambuf* sbuf)
+{
+ if (ipfx0()) {
+ register streambuf* inbuf = rdbuf();
+ // FIXME: Should optimize!
+ for (;;) {
+ register int ch = inbuf->sbumpc();
+ if (ch == EOF) {
+ set(ios::eofbit);
+ break;
+ }
+ if (sbuf->sputc(ch) == EOF) {
+ set(ios::failbit);
+ break;
+ }
+ }
+ }
+ return *this;
+}
+
+ostream& ostream::operator<<(char c)
+{
+ if (opfx()) {
+#if 1
+ // This is what the cfront implementation does.
+ if (_strbuf->sputc(c) == EOF)
+ goto failed;
+#else
+ // This is what cfront documentation and current ANSI drafts say.
+ int w = width(0);
+ char fill_char = fill();
+ register int padding = w > 0 ? w - 1 : 0;
+ register streambuf *sb = _strbuf;
+ if (!(flags() & ios::left) && padding) // Default adjustment.
+ if (_IO_padn(sb, fill_char, padding) < padding)
+ goto failed;
+ if (sb->sputc(c) == EOF)
+ goto failed;
+ if (flags() & ios::left && padding) // Left adjustment.
+ if (_IO_padn(sb, fill_char, padding) < padding)
+ goto failed;
+#endif
+ osfx();
+ }
+ return *this;
+ failed:
+ set(ios::badbit);
+ osfx();
+ return *this;
+}
+
+/* Write VAL on STREAM.
+ If SIGN<0, val is the absolute value of a negative number.
+ If SIGN>0, val is a signed non-negative number.
+ If SIGN==0, val is unsigned. */
+
+static void write_int(ostream& stream, unsigned LONGEST val, int sign)
+{
+#define WRITE_BUF_SIZE (10 + sizeof(unsigned LONGEST) * 3)
+ char buf[WRITE_BUF_SIZE];
+ register char *buf_ptr = buf+WRITE_BUF_SIZE; // End of buf.
+ const char *show_base = "";
+ int show_base_len = 0;
+ int show_pos = 0; // If 1, print a '+'.
+
+ // Now do the actual conversion, placing the result at the *end* of buf.
+ // Note that we use separate code for decimal, octal, and hex,
+ // so we can divide by optimizable constants.
+ if ((stream.flags() & ios::basefield) == ios::oct) { // Octal
+ do {
+ *--buf_ptr = (val & 7) + '0';
+ val = val >> 3;
+ } while (val != 0);
+ if ((stream.flags() & ios::showbase) && (*buf_ptr != '0'))
+ *--buf_ptr = '0';
+ }
+ else if ((stream.flags() & ios::basefield) == ios::hex) { // Hex
+ const char *xdigs = (stream.flags() & ios::uppercase) ? "0123456789ABCDEF0X"
+ : "0123456789abcdef0x";
+ do {
+ *--buf_ptr = xdigs[val & 15];
+ val = val >> 4;
+ } while (val != 0);
+ if ((stream.flags() & ios::showbase)) {
+ show_base = xdigs + 16; // Either "0X" or "0x".
+ show_base_len = 2;
+ }
+ }
+ else { // Decimal
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__)
+ // Optimization: Only use long long when we need to.
+ while (val > UINT_MAX) {
+ *--buf_ptr = (val % 10) + '0';
+ val /= 10;
+ }
+ // Use more efficient (int) arithmetic for the rest.
+ register unsigned int ival = (unsigned int)val;
+#else
+ register unsigned LONGEST ival = val;
+#endif
+ do {
+ *--buf_ptr = (ival % 10) + '0';
+ ival /= 10;
+ } while (ival != 0);
+ if (sign > 0 && (stream.flags() & ios::showpos))
+ show_pos=1;
+ }
+
+ int buf_len = buf+WRITE_BUF_SIZE - buf_ptr;
+ int w = stream.width(0);
+
+ // Calculate padding.
+ int len = buf_len+show_pos;
+ if (sign < 0) len++;
+ len += show_base_len;
+ int padding = len > w ? 0 : w - len;
+
+ // Do actual output.
+ register streambuf* sbuf = stream.rdbuf();
+ ios::fmtflags pad_kind =
+ stream.flags() & (ios::left|ios::right|ios::internal);
+ char fill_char = stream.fill();
+ if (padding > 0
+ && pad_kind != (ios::fmtflags)ios::left
+ && pad_kind != (ios::fmtflags)ios::internal) // Default (right) adjust.
+ if (_IO_padn(sbuf, fill_char, padding) < padding)
+ goto failed;
+ if (sign < 0 || show_pos)
+ {
+ char ch = sign < 0 ? '-' : '+';
+ if (sbuf->sputc(ch) < 0)
+ goto failed;
+ }
+ if (show_base_len)
+ if (_IO_sputn(sbuf, show_base, show_base_len) <= 0)
+ goto failed;
+ if (pad_kind == (ios::fmtflags)ios::internal && padding > 0)
+ if (_IO_padn(sbuf, fill_char, padding) < padding)
+ goto failed;
+ if (_IO_sputn (sbuf, buf_ptr, buf_len) != buf_len)
+ goto failed;
+ if (pad_kind == (ios::fmtflags)ios::left && padding > 0) // Left adjustment
+ if (_IO_padn(sbuf, fill_char, padding) < padding)
+ goto failed;
+ stream.osfx();
+ return;
+ failed:
+ stream.set(ios::badbit);
+ stream.osfx();
+}
+
+ostream& ostream::operator<<(int n)
+{
+ if (opfx()) {
+ int sign = 1;
+ unsigned int abs_n = (unsigned)n;
+ if (n < 0 && (flags() & (ios::oct|ios::hex)) == 0)
+ abs_n = -((unsigned)n), sign = -1;
+ write_int(*this, abs_n, sign);
+ }
+ return *this;
+}
+
+ostream& ostream::operator<<(unsigned int n)
+{
+ if (opfx())
+ write_int(*this, n, 0);
+ return *this;
+}
+
+
+ostream& ostream::operator<<(long n)
+{
+ if (opfx()) {
+ int sign = 1;
+ unsigned long abs_n = (unsigned long)n;
+ if (n < 0 && (flags() & (ios::oct|ios::hex)) == 0)
+ abs_n = -((unsigned long)n), sign = -1;
+ write_int(*this, abs_n, sign);
+ }
+ return *this;
+}
+
+ostream& ostream::operator<<(unsigned long n)
+{
+ if (opfx())
+ write_int(*this, n, 0);
+ return *this;
+}
+
+#if defined(__GNUC__) && !defined(__STRICT_ANSI__)
+ostream& ostream::operator<<(long long n)
+{
+ if (opfx()) {
+ int sign = 1;
+ unsigned long long abs_n = (unsigned long long)n;
+ if (n < 0 && (flags() & (ios::oct|ios::hex)) == 0)
+ abs_n = -((unsigned long long)n), sign = -1;
+ write_int(*this, abs_n, sign);
+ }
+ return *this;
+}
+
+
+ostream& ostream::operator<<(unsigned long long n)
+{
+ if (opfx())
+ write_int(*this, n, 0);
+ return *this;
+}
+#endif /*__GNUC__*/
+
+ostream& ostream::operator<<(double n)
+{
+ if (opfx()) {
+ // Uses __cvt_double (renamed from static cvt), in Chris Torek's
+ // stdio implementation. The setup code uses the same logic
+ // as in __vsbprintf.C (also based on Torek's code).
+ int format_char;
+ if ((flags() & ios::floatfield) == ios::fixed)
+ format_char = 'f';
+ else if ((flags() & ios::floatfield) == ios::scientific)
+ format_char = flags() & ios::uppercase ? 'E' : 'e';
+ else
+ format_char = flags() & ios::uppercase ? 'G' : 'g';
+
+ int prec = precision();
+ if (prec <= 0 && !(flags() & ios::fixed))
+ prec = 6; /* default */
+
+ // Do actual conversion.
+#ifdef _IO_USE_DTOA
+ if (_IO_outfloat(n, rdbuf(), format_char, width(0),
+ prec, flags(),
+ flags() & ios::showpos ? '+' : 0,
+ fill()) < 0)
+ set(ios::badbit|ios::failbit); // ??
+#else
+ int fpprec = 0; // 'Extra' (suppressed) floating precision.
+ if (prec > MAXFRACT) {
+ if (flags() & (ios::fixed|ios::scientific) & ios::showpos)
+ fpprec = prec - MAXFRACT;
+ prec = MAXFRACT;
+ }
+ int negative;
+ char buf[BUF];
+ int sign = '\0';
+ char *cp = buf;
+ *cp = 0;
+ int size = __cvt_double(n, prec,
+ flags() & ios::showpoint ? 0x80 : 0,
+ &negative,
+ format_char, cp, buf + sizeof(buf));
+ if (negative) sign = '-';
+ else if (flags() & ios::showpos) sign = '+';
+ if (*cp == 0)
+ cp++;
+
+ // Calculate padding.
+ int fieldsize = size + fpprec;
+ if (sign) fieldsize++;
+ int padding = 0;
+ int w = width(0);
+ if (fieldsize < w)
+ padding = w - fieldsize;
+
+ // Do actual output.
+ register streambuf* sbuf = rdbuf();
+ register i;
+ char fill_char = fill();
+ ios::fmtflags pad_kind =
+ flags() & (ios::left|ios::right|ios::internal);
+ if (pad_kind != (ios::fmtflags)ios::left // Default (right) adjust.
+ && pad_kind != (ios::fmtflags)ios::internal)
+ for (i = padding; --i >= 0; ) sbuf->sputc(fill_char);
+ if (sign)
+ sbuf->sputc(sign);
+ if (pad_kind == (ios::fmtflags)ios::internal)
+ for (i = padding; --i >= 0; ) sbuf->sputc(fill_char);
+
+ // Emit the actual concented field, followed by extra zeros.
+ _IO_sputn (sbuf, cp, size);
+ for (i = fpprec; --i >= 0; ) sbuf->sputc('0');
+
+ if (pad_kind == (ios::fmtflags)ios::left) // Left adjustment
+ for (i = padding; --i >= 0; ) sbuf->sputc(fill_char);
+#endif
+ osfx();
+ }
+ return *this;
+}
+
+ostream& ostream::operator<<(const char *s)
+{
+ if (opfx())
+ {
+ if (s == NULL)
+ s = "(null)";
+ int len = strlen(s);
+ int w = width(0);
+// FIXME: Should we: if (w && len>w) len = w;
+ char fill_char = fill();
+ register streambuf *sbuf = rdbuf();
+ register int padding = w > len ? w - len : 0;
+ if (!(flags() & ios::left) && padding > 0) // Default adjustment.
+ if (_IO_padn(sbuf, fill_char, padding) != padding)
+ goto failed;
+ if (_IO_sputn (sbuf, s, len) != len)
+ goto failed;
+ if (flags() & ios::left && padding > 0) // Left adjustment.
+ if (_IO_padn(sbuf, fill_char, padding) != padding)
+ goto failed;
+ osfx();
+ }
+ return *this;
+ failed:
+ set(ios::badbit);
+ osfx();
+ return *this;
+}
+
+#if 0
+ostream& ostream::operator<<(const void *p)
+{ Is in osform.cc, to avoid pulling in all of _IO_vfprintf by this file. */ }
+#endif
+
+ostream& ostream::operator<<(register streambuf* sbuf)
+{
+ if (opfx())
+ {
+ char buffer[_IO_BUFSIZ];
+ register streambuf* outbuf = _strbuf;
+ for (;;)
+ {
+ _IO_size_t count = _IO_sgetn(sbuf, buffer, _IO_BUFSIZ);
+ if (count <= 0)
+ break;
+ if (_IO_sputn(outbuf, buffer, count) != count)
+ {
+ set(ios::badbit);
+ break;
+ }
+ }
+ osfx();
+ }
+ return *this;
+}
+
+ostream::ostream(streambuf* sb, ostream* tied)
+{
+ init (sb, tied);
+}
+
+ostream& ostream::seekp(streampos pos)
+{
+ pos = _strbuf->pubseekpos(pos, ios::out);
+ if (pos == streampos(EOF))
+ set(ios::badbit);
+ return *this;
+}
+
+ostream& ostream::seekp(streamoff off, _seek_dir dir)
+{
+ streampos pos = _IO_seekoff (_strbuf, off, (int) dir, _IOS_OUTPUT);
+ if (pos == streampos(EOF))
+ set(ios::badbit);
+ return *this;
+}
+
+streampos ostream::tellp()
+{
+#if 1
+ streampos pos = _IO_seekoff (_strbuf, 0, _IO_seek_cur, _IOS_OUTPUT);
+#else
+ streampos pos = _strbuf->pubseekoff(0, ios::cur, ios::out);
+#endif
+ if (pos == streampos(EOF))
+ set(ios::badbit);
+ return pos;
+}
+
+ostream& ostream::flush()
+{
+ if (_strbuf->sync())
+ set(ios::badbit);
+ return *this;
+}
+
+ostream& flush(ostream& outs)
+{
+ return outs.flush();
+}
+
+istream& ws(istream& ins)
+{
+ if (ins.ipfx1()) {
+ int ch = skip_ws(ins._strbuf);
+ if (ch == EOF)
+ ins.set(ios::eofbit);
+ else
+ ins._strbuf->sputbackc(ch);
+ }
+ return ins;
+}
+
+// Skip white-space. Return 0 on failure (EOF), or 1 on success.
+// Differs from ws() manipulator in that failbit is set on EOF.
+// Called by ipfx() and ipfx0() if needed.
+
+int istream::_skip_ws()
+{
+ int ch = skip_ws(_strbuf);
+ if (ch == EOF) {
+ set(ios::eofbit|ios::failbit);
+ return 0;
+ }
+ else {
+ _strbuf->sputbackc(ch);
+ return 1;
+ }
+}
+
+ostream& ends(ostream& outs)
+{
+ outs.put('\0');
+ return outs;
+}
+
+ostream& endl(ostream& outs)
+{
+ return flush(outs.put('\n'));
+}
+
+ostream& ostream::write(const char *s, streamsize n)
+{
+ if (opfx()) {
+ if (_IO_sputn(_strbuf, s, n) != n)
+ set(ios::failbit);
+ }
+ return *this;
+}
+
+void ostream::do_osfx()
+{
+ if (flags() & ios::unitbuf)
+ flush();
+ if (flags() & ios::stdio) {
+ fflush(stdout);
+ fflush(stderr);
+ }
+}
+
+iostream::iostream(streambuf* sb, ostream* tied)
+{
+ init (sb, tied);
+}
+
+// NOTE: extension for compatibility with old libg++.
+// Not really compatible with fistream::close().
+#ifdef _STREAM_COMPAT
+void ios::close()
+{
+ if (_strbuf->_flags & _IO_IS_FILEBUF)
+ ((struct filebuf*)rdbuf())->close();
+ else if (_strbuf != NULL)
+ rdbuf()->sync();
+ _strbuf = NULL;
+ _state = badbit;
+}
+
+int istream::skip(int i)
+{
+ int old = (_flags & ios::skipws) != 0;
+ if (i)
+ _flags |= ios::skipws;
+ else
+ _flags &= ~ios::skipws;
+ return old;
+}
+#endif
diff --git a/libio/iostream.h b/libio/iostream.h
new file mode 100644
index 00000000000..d663b42430c
--- /dev/null
+++ b/libio/iostream.h
@@ -0,0 +1,258 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifndef _IOSTREAM_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+#define _IOSTREAM_H
+
+#include <streambuf.h>
+
+extern "C++" {
+class istream; class ostream;
+typedef ios& (*__manip)(ios&);
+typedef istream& (*__imanip)(istream&);
+typedef ostream& (*__omanip)(ostream&);
+
+extern istream& ws(istream& ins);
+extern ostream& flush(ostream& outs);
+extern ostream& endl(ostream& outs);
+extern ostream& ends(ostream& outs);
+
+class ostream : virtual public ios
+{
+ // NOTE: If fields are changed, you must fix _fake_ostream in stdstreams.C!
+ void do_osfx();
+ public:
+ ostream() { }
+ ostream(streambuf* sb, ostream* tied=NULL);
+ int opfx() {
+ if (!good()) return 0; else { if (_tie) _tie->flush(); return 1;} }
+ void osfx() { if (flags() & (ios::unitbuf|ios::stdio))
+ do_osfx(); }
+ ostream& flush();
+ ostream& put(char c) { _strbuf->sputc(c); return *this; }
+#ifdef _STREAM_COMPAT
+ /* Temporary binary compatibility. REMOVE IN NEXT RELEASE. */
+ ostream& put(unsigned char c) { return put((char)c); }
+ ostream& put(signed char c) { return put((char)c); }
+#endif
+ ostream& write(const char *s, streamsize n);
+ ostream& write(const unsigned char *s, streamsize n)
+ { return write((const char*)s, n);}
+ ostream& write(const signed char *s, streamsize n)
+ { return write((const char*)s, n);}
+ ostream& write(const void *s, streamsize n)
+ { return write((const char*)s, n);}
+ ostream& seekp(streampos);
+ ostream& seekp(streamoff, _seek_dir);
+ streampos tellp();
+ ostream& form(const char *format ...);
+ ostream& vform(const char *format, _IO_va_list args);
+
+ ostream& operator<<(char c);
+ ostream& operator<<(unsigned char c) { return (*this) << (char)c; }
+ ostream& operator<<(signed char c) { return (*this) << (char)c; }
+ ostream& operator<<(const char *s);
+ ostream& operator<<(const unsigned char *s)
+ { return (*this) << (const char*)s; }
+ ostream& operator<<(const signed char *s)
+ { return (*this) << (const char*)s; }
+ ostream& operator<<(const void *p);
+ ostream& operator<<(int n);
+ ostream& operator<<(unsigned int n);
+ ostream& operator<<(long n);
+ ostream& operator<<(unsigned long n);
+#if defined(__GNUC__)
+ __extension__ ostream& operator<<(long long n);
+ __extension__ ostream& operator<<(unsigned long long n);
+#endif
+ ostream& operator<<(short n) {return operator<<((int)n);}
+ ostream& operator<<(unsigned short n) {return operator<<((unsigned int)n);}
+#if _G_HAVE_BOOL
+ ostream& operator<<(bool b) { return operator<<((int)b); }
+#endif
+ ostream& operator<<(double n);
+ ostream& operator<<(float n) { return operator<<((double)n); }
+ ostream& operator<<(long double n) { return operator<<((double)n); }
+ ostream& operator<<(__omanip func) { return (*func)(*this); }
+ ostream& operator<<(__manip func) {(*func)(*this); return *this;}
+ ostream& operator<<(streambuf*);
+#ifdef _STREAM_COMPAT
+ streambuf* ostreambuf() const { return _strbuf; }
+#endif
+};
+
+class istream : virtual public ios
+{
+ // NOTE: If fields are changed, you must fix _fake_istream in stdstreams.C!
+protected:
+ _IO_size_t _gcount;
+
+ int _skip_ws();
+ public:
+ istream(): _gcount (0) { }
+ istream(streambuf* sb, ostream*tied=NULL);
+ istream& get(char* ptr, int len, char delim = '\n');
+ istream& get(unsigned char* ptr, int len, char delim = '\n')
+ { return get((char*)ptr, len, delim); }
+ istream& get(char& c);
+ istream& get(unsigned char& c) { return get((char&)c); }
+ istream& getline(char* ptr, int len, char delim = '\n');
+ istream& getline(unsigned char* ptr, int len, char delim = '\n')
+ { return getline((char*)ptr, len, delim); }
+ istream& get(signed char& c) { return get((char&)c); }
+ istream& get(signed char* ptr, int len, char delim = '\n')
+ { return get((char*)ptr, len, delim); }
+ istream& getline(signed char* ptr, int len, char delim = '\n')
+ { return getline((char*)ptr, len, delim); }
+ istream& read(char *ptr, streamsize n);
+ istream& read(unsigned char *ptr, streamsize n)
+ { return read((char*)ptr, n); }
+ istream& read(signed char *ptr, streamsize n)
+ { return read((char*)ptr, n); }
+ istream& read(void *ptr, streamsize n)
+ { return read((char*)ptr, n); }
+ istream& get(streambuf& sb, char delim = '\n');
+ istream& gets(char **s, char delim = '\n');
+ int ipfx(int need = 0) {
+ if (!good()) { set(ios::failbit); return 0; }
+ else {
+ if (_tie && (need == 0 || rdbuf()->in_avail() < need)) _tie->flush();
+ if (!need && (flags() & ios::skipws)) return _skip_ws();
+ else return 1;
+ }
+ }
+ int ipfx0() { // Optimized version of ipfx(0).
+ if (!good()) { set(ios::failbit); return 0; }
+ else {
+ if (_tie) _tie->flush();
+ if (flags() & ios::skipws) return _skip_ws();
+ else return 1;
+ }
+ }
+ int ipfx1() { // Optimized version of ipfx(1).
+ if (!good()) { set(ios::failbit); return 0; }
+ else {
+ if (_tie && rdbuf()->in_avail() == 0) _tie->flush();
+ return 1;
+ }
+ }
+ void isfx() { }
+ int get() { if (!ipfx1()) return EOF;
+ else { int ch = _strbuf->sbumpc();
+ if (ch == EOF) set(ios::eofbit);
+ return ch;
+ } }
+ int peek();
+ _IO_size_t gcount() { return _gcount; }
+ istream& ignore(int n=1, int delim = EOF);
+ int sync ();
+ istream& seekg(streampos);
+ istream& seekg(streamoff, _seek_dir);
+ streampos tellg();
+ istream& putback(char ch) {
+ if (good() && _strbuf->sputbackc(ch) == EOF) clear(ios::badbit);
+ return *this;}
+ istream& unget() {
+ if (good() && _strbuf->sungetc() == EOF) clear(ios::badbit);
+ return *this;}
+ istream& scan(const char *format ...);
+ istream& vscan(const char *format, _IO_va_list args);
+#ifdef _STREAM_COMPAT
+ istream& unget(char ch) { return putback(ch); }
+ int skip(int i);
+ streambuf* istreambuf() const { return _strbuf; }
+#endif
+
+ istream& operator>>(char*);
+ istream& operator>>(unsigned char* p) { return operator>>((char*)p); }
+ istream& operator>>(signed char*p) { return operator>>((char*)p); }
+ istream& operator>>(char& c);
+ istream& operator>>(unsigned char& c) {return operator>>((char&)c);}
+ istream& operator>>(signed char& c) {return operator>>((char&)c);}
+ istream& operator>>(int&);
+ istream& operator>>(long&);
+#if defined(__GNUC__)
+ __extension__ istream& operator>>(long long&);
+ __extension__ istream& operator>>(unsigned long long&);
+#endif
+ istream& operator>>(short&);
+ istream& operator>>(unsigned int&);
+ istream& operator>>(unsigned long&);
+ istream& operator>>(unsigned short&);
+#if _G_HAVE_BOOL
+ istream& operator>>(bool&);
+#endif
+ istream& operator>>(float&);
+ istream& operator>>(double&);
+ istream& operator>>(long double&);
+ istream& operator>>( __manip func) {(*func)(*this); return *this;}
+ istream& operator>>(__imanip func) { return (*func)(*this); }
+ istream& operator>>(streambuf*);
+};
+
+class iostream : public istream, public ostream
+{
+ public:
+ iostream() { }
+ iostream(streambuf* sb, ostream*tied=NULL);
+};
+
+class _IO_istream_withassign : public istream {
+public:
+ _IO_istream_withassign& operator=(istream&);
+ _IO_istream_withassign& operator=(_IO_istream_withassign& rhs)
+ { return operator= (static_cast<istream&> (rhs)); }
+};
+
+class _IO_ostream_withassign : public ostream {
+public:
+ _IO_ostream_withassign& operator=(ostream&);
+ _IO_ostream_withassign& operator=(_IO_ostream_withassign& rhs)
+ { return operator= (static_cast<ostream&> (rhs)); }
+};
+
+extern _IO_istream_withassign cin;
+// clog->rdbuf() == cerr->rdbuf()
+extern _IO_ostream_withassign cout, cerr;
+
+extern _IO_ostream_withassign clog
+#if _G_CLOG_CONFLICT
+__asm__ ("__IO_clog")
+#endif
+;
+
+struct Iostream_init { } ; // Compatibility hack for AT&T library.
+
+inline ios& dec(ios& i)
+{ i.setf(ios::dec, ios::dec|ios::hex|ios::oct); return i; }
+inline ios& hex(ios& i)
+{ i.setf(ios::hex, ios::dec|ios::hex|ios::oct); return i; }
+inline ios& oct(ios& i)
+{ i.setf(ios::oct, ios::dec|ios::hex|ios::oct); return i; }
+} // extern "C++"
+
+#endif /*!_IOSTREAM_H*/
diff --git a/libio/iostream.texi b/libio/iostream.texi
new file mode 100644
index 00000000000..54ccced6e71
--- /dev/null
+++ b/libio/iostream.texi
@@ -0,0 +1,1971 @@
+\input texinfo @c -*-Texinfo-*-
+@c Copyright (c) 1993 Free Software Foundation, Inc.
+
+@c %**start of header
+@setfilename iostream.info
+@settitle The GNU C++ Iostream Library
+@setchapternewpage odd
+@c %**end of header
+
+@ifinfo
+@format
+START-INFO-DIR-ENTRY
+* iostream: (iostream). The C++ input/output facility.
+END-INFO-DIR-ENTRY
+@end format
+
+This file describes libio, the GNU library for C++ iostreams and C stdio.
+
+libio includes software developed by the University of California,
+Berkeley.
+
+Copyright (C) 1993 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+@end ifinfo
+
+@finalout
+@syncodeindex fn cp
+@syncodeindex vr cp
+
+@titlepage
+@title The GNU C++ Iostream Library
+@subtitle Reference Manual for @code{libio} Version 0.64
+@sp 3
+@author Per Bothner @hfill @code{bothner@@cygnus.com}
+@author Cygnus Support @hfill @code{doc@@cygnus.com}
+@page
+
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1993 Free Software Foundation, Inc.
+
+@code{libio} includes software developed by the University of
+California, Berkeley.
+
+@code{libio} uses floating-point software written by David M. Gay, which
+includes the following notice:
+
+@quotation
+The author of this software is David M. Gay.
+
+Copyright (c) 1991 by AT&T.
+
+Permission to use, copy, modify, and distribute this software for any
+purpose without fee is hereby granted, provided that this entire notice
+is included in all copies of any software which is or includes a copy
+or modification of this software and in all copies of the supporting
+documentation for such software.
+
+THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR AT&T MAKES ANY
+REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
+OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
+@end quotation
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+entire resulting derived work is distributed under the terms of a
+permission notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions.
+@end titlepage
+
+@ifinfo
+@node Top
+@top The GNU C++ Iostream Library
+
+This file provides reference information on the GNU C++ iostream library
+(@code{libio}), version 0.64.
+
+@menu
+* Introduction::
+* Operators:: Operators and default streams.
+* Streams:: Stream classes.
+* Files and Strings:: Classes for files and strings.
+* Streambuf:: Using the streambuf layer.
+* Stdio:: C input and output.
+* Index::
+@end menu
+@end ifinfo
+
+@node Introduction
+@chapter Introduction
+
+The iostream classes implement most of the features of AT&T version 2.0
+iostream library classes, and most of the features of the ANSI X3J16
+library draft (which is based on the AT&T design).
+
+This manual is meant as a reference; for tutorial material on iostreams,
+see the corresponding section of any recent popular introduction to C++.
+
+@menu
+* Copying:: Special GNU licensing terms for libio.
+* Acknowledgements:: Contributors to GNU iostream.
+@end menu
+
+@node Copying
+@section Licensing terms for @code{libio}
+
+Since the @code{iostream} classes are so fundamental to standard C++,
+the Free Software Foundation has agreed to a special exception to its
+standard license, when you link programs with @code{libio.a}:
+
+@quotation
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+@end quotation
+
+The code is under the @sc{gnu} General Public License (version 2) for
+all other purposes than linking with this library; that means that you
+can modify and redistribute the code as usual, but remember that if you
+do, your modifications, and anything you link with the modified code,
+must be available to others on the same terms.
+
+These functions are also available as part of the @code{libg++}
+library; if you link with that library instead of @code{libio}, the
+@sc{gnu} Library General Public License applies.
+
+@node Acknowledgements
+@section Acknowledgements
+
+Per Bothner wrote most of the @code{iostream} library, but some portions
+have their origins elsewhere in the free software community. Heinz
+Seidl wrote the IO manipulators. The floating-point conversion software
+is by David M. Gay of AT&T. Some code was derived from parts of BSD
+4.4, which was written at the University of California, Berkeley.
+
+The iostream classes are found in the @code{libio} library. An early
+version was originally distributed in @code{libg++}, and they are still
+included there as well, for convenience if you need other @code{libg++}
+classes. Doug Lea was the original author of @code{libg++}, and some of
+the file-management code still in @code{libio} is his.
+
+Various people found bugs or offered suggestions. Hongjiu Lu worked
+hard to use the library as the default stdio implementation for Linux,
+and has provided much stress-testing of the library.
+
+@node Operators
+@chapter Operators and Default Streams
+
+The @sc{gnu} iostream library, @file{libio}, implements the standard
+input and output facilities for C++. These facilities are roughly
+analogous (in their purpose and ubiquity, at least) with those defined
+by the C @file{stdio} functions.
+
+Although these definitions come from a library, rather than being part
+of the ``core language'', they are sufficiently central to be specified
+in the latest working papers for C++.
+
+You can use two operators defined in this library for basic input and
+output operations. They are familiar from any C++ introductory
+textbook: @code{<<} for output, and @code{>>} for input. (Think of data
+flowing in the direction of the ``arrows''.)
+
+These operators are often used in conjunction with three streams that
+are open by default:
+
+@deftypevar ostream cout
+The standard output stream, analogous to the C @code{stdout}.
+@end deftypevar
+
+@deftypevar istream cin
+The standard input stream, analogous to the C @code{stdin}.
+@end deftypevar
+
+@deftypevar ostream cerr
+An alternative output stream for errors, analogous to the C
+@code{stderr}.
+@end deftypevar
+
+@noindent
+For example, this bare-bones C++ version of the traditional ``hello''
+program uses @code{<<} and @code{cout}:
+
+@example
+#include <iostream.h>
+
+int main(int argc, char **argv)
+@{
+ cout << "Well, hi there.\n";
+ return 0;
+@}
+@end example
+
+Casual use of these operators may be seductive, but---other than in
+writing throwaway code for your own use---it is not necessarily simpler
+than managing input and output in any other language. For example,
+robust code should check the state of the input and output streams
+between operations (for example, using the method @code{good}).
+@xref{States,,Checking the state of a stream}. You may also need to
+adjust maximum input or output field widths, using manipulators like
+@code{setw} or @code{setprecision}.
+
+@defop Operator ostream <<
+Write output to an open output stream of class @code{ostream}.
+Defined by this library on any @var{object} of a C++ primitive type, and
+on other classes of the library. You can overload the definition for any
+of your own applications' classes.
+
+Returns a reference to the implied argument @code{*this} (the open stream it
+writes on), permitting statements like
+@example
+cout << "The value of i is " << i << "\n";
+@end example
+@end defop
+
+@defop Operator istream >>
+Read input from an open input stream of class @code{istream}. Defined
+by this library on primitive numeric, pointer, and string types; you can
+extend the definition for any of your own applications' classes.
+
+Returns a reference to the implied argument @code{*this} (the open stream
+it reads), permitting multiple inputs in one statement.
+@end defop
+
+@node Streams
+@chapter Stream Classes
+
+The previous chapter referred in passing to the classes @code{ostream}
+and @code{istream}, for output and input respectively. These classes
+share certain properties, captured in their base class @code{ios}.
+
+@menu
+* Ios:: Shared properties.
+* Ostream:: Managing output streams.
+* Istream:: Managing input streams.
+* Iostream:: Input and output together.
+@end menu
+
+@node Ios
+@section Shared properties: class @code{ios}
+
+The base class @code{ios} provides methods to test and manage the state
+of input or output streams.
+
+@code{ios} delegates the job of actually reading and writing bytes to
+the abstract class @code{streambuf}, which is designed to provide
+buffered streams (compatible with C, in the @sc{gnu} implementation).
+@xref{Streambuf,,Using the @code{streambuf} layer}, for information on
+the facilities available at the @code{streambuf} level.
+
+@deftypefn Constructor {} ios::ios ([streambuf* @var{sb} @w{[, ostream*} @var{tie}])
+The @code{ios} constructor by default initializes a new @code{ios}, and
+if you supply a @code{streambuf} @var{sb} to associate with it, sets the
+state @code{good} in the new @code{ios} object. It also sets the
+default properties of the new object.
+
+@ignore
+@c FIXME--future: this (a) doesn't work, (b) is controversial at ANSI
+An @code{ios} without a @code{streambuf} has the state @code{bad} until
+you supply a @code{streambuf}; you can do that by assigning a new value
+to the @code{ios} with @samp{=}.
+@end ignore
+
+You can also supply an optional second argument @var{tie} to the
+constructor: if present, it is an initial value for @code{ios::tie}, to
+associate the new @code{ios} object with another stream.
+@end deftypefn
+
+@deftypefn Destructor {} ios::~ios ()
+The @code{ios} destructor is virtual, permitting application-specific
+behavior when a stream is closed---typically, the destructor frees any
+storage associated with the stream and releases any other associated
+objects.
+@end deftypefn
+
+@c FIXME-future: Is @deftypefn really the best way of displaying these?
+
+@c FIXME-future: Undocumented: ios::_throw_failure, ios::exceptions; things
+@c controlled by _STREAM_COMPAT; ios::Init; ios::_IO_fix_vtable.
+
+@menu
+* States:: Checking the state of a stream.
+* Format Control:: Choices in formatting.
+* Manipulators:: Convenient ways of changing stream properties.
+* Extending:: Extended data fields.
+* Synchronization:: Synchronizing related streams.
+* Streambuf from Ios:: Reaching the underlying streambuf.
+@end menu
+
+@node States
+@subsection Checking the state of a stream
+
+Use this collection of methods to test for (or signal) errors and other
+exceptional conditions of streams:
+
+@deftypefn Method {ios::operator void*} () const
+You can do a quick check on the state of the most recent operation on a
+stream by examining a pointer to the stream itself. The pointer is
+arbitrary except for its truth value; it is true if no failures have
+occurred (@code{ios::fail} is not true). For example, you might ask for
+input on @code{cin} only if all prior output operations succeeded:
+
+@example
+if (cout)
+@{
+ // Everything OK so far
+ cin >> new_value;
+ @dots{}
+@}
+@end example
+@end deftypefn
+
+@deftypefn Method {ios::operator !} () const
+In case it is more convenient to check whether something has failed, the
+operator @code{!} returns true if @code{ios::fail} is true (an operation
+has failed). For example,
+you might issue an error message if input failed:
+
+@example
+if (!cin)
+@{
+ // Oops
+ cerr << "Eh?\n";
+@}
+@end example
+@end deftypefn
+
+@deftypefn Method iostate ios::rdstate () const
+Return the state flags for this stream. The value is from the
+enumeration @code{iostate}. You can test for any combination of
+
+@vtable @code
+@item goodbit
+There are no indications of exceptional states on this stream.
+
+@item eofbit
+End of file.
+
+@item failbit
+An operation has failed on this stream; this usually indicates bad
+format of input.
+
+@item badbit
+The stream is unusable.
+@end vtable
+@end deftypefn
+
+@deftypefn Method void ios::setstate (iostate @var{state})
+@findex ios::set
+Set the state flag for this stream to @var{state} @emph{in addition to}
+any state flags already set. Synonym (for upward compatibility):
+@code{ios::set}.
+
+See @code{ios::clear} to set the stream state without regard to existing
+state flags. See @code{ios::good}, @code{ios::eof}, @code{ios::fail},
+and @code{ios::bad}, to test the state.
+@end deftypefn
+
+@deftypefn Method int ios::good () const
+Test the state flags associated with this stream; true if no error
+indicators are set.
+@end deftypefn
+
+@deftypefn Method int ios::bad () const
+Test whether a stream is marked as unusable. (Whether
+@code{ios::badbit} is set.)
+@end deftypefn
+
+@deftypefn Method int ios::eof () const
+True if end of file was reached on this stream. (If @code{ios::eofbit}
+is set.)
+@end deftypefn
+
+@deftypefn Method int ios::fail () const
+Test for any kind of failure on this stream: @emph{either} some
+operation failed, @emph{or} the stream is marked as bad. (If either
+@code{ios::failbit} or @code{ios::badbit} is set.)
+@end deftypefn
+
+@deftypefn Method void ios::clear (iostate @var{state})
+@c FIXME-future: There is some complication to do with buffering and _throw_failure
+Set the state indication for this stream to the argument @var{state}.
+You may call @code{ios::clear} with no argument, in which case the state
+is set to @code{good} (no errors pending).
+
+See @code{ios::good}, @code{ios::eof}, @code{ios::fail}, and
+@code{ios::bad}, to test the state; see @code{ios::set} or
+@code{ios::setstate} for an alternative way of setting the state.
+@end deftypefn
+
+@node Format Control
+@subsection Choices in formatting
+
+These methods control (or report on) settings for some details of
+controlling streams, primarily to do with formatting output:
+
+@deftypefn Method char ios::fill () const
+Report on the padding character in use.
+@end deftypefn
+
+@deftypefn Method char ios::fill (char @var{padding})
+Set the padding character. You can also use the manipulator
+@code{setfill}. @xref{Manipulators,,Changing stream properties in
+expressions}.
+
+Default: blank.
+@end deftypefn
+
+@deftypefn Method int ios::precision () const
+Report the number of significant digits currently in use for output of
+floating point numbers.
+
+Default: @code{6}.
+@end deftypefn
+
+@deftypefn Method int ios::precision (int @var{signif})
+Set the number of significant digits (for input and output numeric
+conversions) to @var{signif}.
+
+@findex setprecision
+@cindex setting @code{ios::precision}
+You can also use the manipulator @code{setprecision} for this purpose.
+@xref{Manipulators,,Changing stream properties using manipulators}.
+@end deftypefn
+
+@deftypefn Method int ios::width () const
+Report the current output field width setting (the number of
+characters to write on the next @samp{<<} output operation).
+
+Default: @code{0}, which means to use as many characters as necessary.
+@end deftypefn
+
+@deftypefn Method int ios::width (int @var{num})
+Set the input field width setting to @var{num}. Return the
+@emph{previous} value for this stream.
+
+@findex setw
+@cindex setting @code{ios::width}
+This value resets to zero (the default) every time you use @samp{<<}; it is
+essentially an additional implicit argument to that operator. You can
+also use the manipulator @code{setw} for this purpose.
+@xref{Manipulators,,Changing stream properties using manipulators}.
+@end deftypefn
+
+@need 2000
+@deftypefn Method fmtflags ios::flags () const
+Return the current value of the complete collection of flags controlling
+the format state. These are the flags and their meanings when set:
+
+@vtable @code
+@item ios::dec
+@itemx ios::oct
+@itemx ios::hex
+What numeric base to use in converting integers from internal to display
+representation, or vice versa: decimal, octal, or hexadecimal,
+respectively. (You can change the base using the manipulator
+@code{setbase}, or any of the manipulators @code{dec}, @code{oct}, or
+@code{hex}; @pxref{Manipulators,,Changing stream properties in
+expressions}.)
+
+On input, if none of these flags is set, read numeric constants
+according to the prefix: decimal if no prefix (or a @samp{.} suffix),
+octal if a @samp{0} prefix is present, hexadecimal if a @samp{0x} prefix
+is present.
+
+Default: @code{dec}.
+
+@item ios::fixed
+Avoid scientific notation, and always show a fixed number of digits after
+the decimal point, according to the output precision in effect.
+Use @code{ios::precision} to set precision.
+
+@item ios::left
+@itemx ios::right
+@itemx ios::internal
+Where output is to appear in a fixed-width field; left-justified,
+right-justified, or with padding in the middle (e.g. between a numeric
+sign and the associated value), respectively.
+
+@item ios::scientific
+Use scientific (exponential) notation to display numbers.
+
+@item ios::showbase
+Display the conventional prefix as a visual indicator of the conversion
+base: no prefix for decimal, @samp{0} for octal, @samp{0x} for hexadecimal.
+
+@item ios::showpoint
+Display a decimal point and trailing zeros after it to fill out numeric
+fields, even when redundant.
+
+@item ios::showpos
+Display a positive sign on display of positive numbers.
+
+@item ios::skipws
+Skip white space. (On by default).
+
+@item ios::stdio
+Flush the C @code{stdio} streams @code{stdout} and @code{stderr} after
+each output operation (for programs that mix C and C++ output conventions).
+
+@item ios::unitbuf
+Flush after each output operation.
+
+@item ios::uppercase
+Use upper-case characters for the non-numeral elements in numeric
+displays; for instance, @samp{0X7A} rather than @samp{0x7a}, or
+@samp{3.14E+09} rather than @samp{3.14e+09}.
+@end vtable
+@end deftypefn
+
+@deftypefn Method fmtflags ios::flags (fmtflags @var{value})
+Set @var{value} as the complete collection of flags controlling the
+format state. The flag values are described under @samp{ios::flags ()}.
+
+Use @code{ios::setf} or @code{ios::unsetf} to change one property at a
+time.
+@end deftypefn
+
+@deftypefn Method fmtflags ios::setf (fmtflags @var{flag})
+Set one particular flag (of those described for @samp{ios::flags ()};
+return the complete collection of flags @emph{previously} in effect.
+(Use @code{ios::unsetf} to cancel.)
+@end deftypefn
+
+@deftypefn Method fmtflags ios::setf (fmtflags @var{flag}, fmtflags @var{mask})
+Clear the flag values indicated by @var{mask}, then set any of them that
+are also in @var{flag}. (Flag values are described for @samp{ios::flags
+()}.) Return the complete collection of flags @emph{previously} in
+effect. (See @code{ios::unsetf} for another way of clearing flags.)
+@end deftypefn
+
+@deftypefn Method fmtflags ios::unsetf (fmtflags @var{flag})
+Make certain @var{flag} (a combination of flag values described for
+@samp{ios::flags ()}) is not set for this stream; converse of
+@code{ios::setf}. Returns the old values of those flags.
+@c FIXME-future: should probably be fixed to give same result as setf.
+@end deftypefn
+
+@node Manipulators
+@subsection Changing stream properties using manipulators
+
+For convenience, @var{manipulators} provide a way to change certain
+properties of streams, or otherwise affect them, in the middle of
+expressions involving @samp{<<} or @samp{>>}. For example, you might
+write
+
+@example
+cout << "|" << setfill('*') << setw(5) << 234 << "|";
+@end example
+
+@noindent
+to produce @samp{|**234|} as output.
+
+@deftypefn Manipulator {} ws
+Skip whitespace.
+@end deftypefn
+
+@deftypefn Manipulator {} flush
+Flush an output stream. For example, @samp{cout << @dots{} <<flush;}
+has the same effect as @samp{cout << @dots{}; cout.flush();}.
+@end deftypefn
+
+@deftypefn Manipulator {} endl
+Write an end of line character @samp{\n}, then flushes the output stream.
+@end deftypefn
+
+@deftypefn Manipulator {} ends
+Write @samp{\0} (the string terminator character).
+@end deftypefn
+
+@deftypefn Manipulator {} setprecision (int @var{signif})
+You can change the value of @code{ios::precision} in @samp{<<}
+expressions with the manipulator @samp{setprecision(@var{signif})}; for
+example,
+
+@example
+cout << setprecision(2) << 4.567;
+@end example
+
+@noindent
+prints @samp{4.6}. Requires @file{#include <iomanip.h>}.
+@end deftypefn
+
+@deftypefn Manipulator {} setw (int @var{n})
+You can change the value of @code{ios::width} in @samp{<<} expressions
+with the manipulator @samp{setw(@var{n})}; for example,
+
+@example
+cout << setw(5) << 234;
+@end example
+
+@noindent
+prints @w{@samp{ 234}} with two leading blanks. Requires @file{#include
+<iomanip.h>}.
+@end deftypefn
+
+@deftypefn Manipulator {} setbase (int @var{base})
+Where @var{base} is one of @code{10} (decimal), @code{8} (octal), or
+@code{16} (hexadecimal), change the base value for numeric
+representations. Requires @file{#include <iomanip.h>}.
+@end deftypefn
+
+@deftypefn Manipulator {} dec
+Select decimal base; equivalent to @samp{setbase(10)}.
+@end deftypefn
+
+@deftypefn Manipulator {} hex
+Select hexadecimal base; equivalent to @samp{setbase(16)}.
+@end deftypefn
+
+@deftypefn Manipulator {} oct
+Select octal base; equivalent to @samp{setbase(8)}.
+@end deftypefn
+
+@deftypefn Manipulator {} setfill (char @var{padding})
+Set the padding character, in the same way as @code{ios::fill}.
+Requires @file{#include <iomanip.h>}.
+@end deftypefn
+
+@node Extending
+@subsection Extended data fields
+
+A related collection of methods allows you to extend this collection of
+flags and parameters for your own applications, without risk of conflict
+between them:
+
+@deftypefn Method {static fmtflags} ios::bitalloc ()
+Reserve a bit (the single bit on in the result) to use as a flag. Using
+@code{bitalloc} guards against conflict between two packages that use
+@code{ios} objects for different purposes.
+
+This method is available for upward compatibility, but is not in the
+@sc{ansi} working paper. The number of bits available is limited; a
+return value of @code{0} means no bit is available.
+@end deftypefn
+
+@deftypefn Method {static int} ios::xalloc ()
+Reserve space for a long integer or pointer parameter. The result is a
+unique nonnegative integer. You can use it as an index to
+@code{ios::iword} or @code{ios::pword}. Use @code{xalloc} to arrange
+for arbitrary special-purpose data in your @code{ios} objects, without
+risk of conflict between packages designed for different purposes.
+@end deftypefn
+
+@deftypefn Method long& ios::iword (int @var{index})
+Return a reference to arbitrary data, of long integer type, stored in an
+@code{ios} instance. @var{index}, conventionally returned from
+@code{ios::xalloc}, identifies what particular data you need.
+@end deftypefn
+
+@deftypefn Method long ios::iword (int @var{index}) const
+Return the actual value of a long integer stored in an @code{ios}.
+@end deftypefn
+
+@deftypefn Method void*& ios::pword (int @var{index})
+Return a reference to an arbitrary pointer, stored in an @code{ios}
+instance. @var{index}, originally returned from @code{ios::xalloc},
+identifies what particular pointer you need.
+@end deftypefn
+
+@deftypefn Method void* ios::pword (int @var{index}) const
+Return the actual value of a pointer stored in an @code{ios}.
+@end deftypefn
+
+@node Synchronization
+@subsection Synchronizing related streams
+
+You can use these methods to synchronize related streams with
+one another:
+
+@deftypefn Method ostream* ios::tie () const
+Report on what output stream, if any, is to be flushed before accessing
+this one. A pointer value of @code{0} means no stream is tied.
+@end deftypefn
+
+@deftypefn Method ostream* ios::tie (ostream* @var{assoc})
+Declare that output stream @var{assoc} must be flushed before accessing
+this stream.
+@end deftypefn
+
+@deftypefn Method int ios::sync_with_stdio ([int @var{switch}])
+Unless iostreams and C @code{stdio} are designed to work together, you
+may have to choose between efficient C++ streams output and output
+compatible with C @code{stdio}. Use @samp{ios::sync_with_stdio()} to
+select C compatibility.
+
+The argument @var{switch} is a @sc{gnu} extension; use @code{0} as the
+argument to choose output that is not necessarily compatible with C
+@code{stdio}. The default value for @var{switch} is @code{1}.
+
+If you install the @code{stdio} implementation that comes with @sc{gnu}
+@code{libio}, there are compatible input/output facilities for both C
+and C++. In that situation, this method is unnecessary---but you may
+still want to write programs that call it, for portability.
+@end deftypefn
+
+@node Streambuf from Ios
+@subsection Reaching the underlying @code{streambuf}
+
+Finally, you can use this method to access the underlying object:
+
+@deftypefn Method streambuf* ios::rdbuf () const
+Return a pointer to the @code{streambuf} object that underlies this
+@code{ios}.
+@end deftypefn
+
+@node Ostream
+@section Managing output streams: class @code{ostream}
+
+Objects of class @code{ostream} inherit the generic methods from
+@code{ios}, and in addition have the following methods available.
+Declarations for this class come from @file{iostream.h}.
+
+@deftypefn Constructor {} ostream::ostream ()
+The simplest form of the constructor for an @code{ostream} simply
+allocates a new @code{ios} object.
+@end deftypefn
+
+@deftypefn Constructor {} ostream::ostream (streambuf* @var{sb} @w{[, ostream} @var{tie}])
+This alternative constructor requires a first argument @var{sb} of type
+@code{streambuf*}, to use an existing open stream for output. It also
+accepts an optional second argument @var{tie}, to specify a related
+@code{ostream*} as the initial value for @code{ios::tie}.
+
+If you give the @code{ostream} a @code{streambuf} explicitly, using
+this constructor, the @var{sb} is @emph{not} destroyed (or deleted or
+closed) when the @code{ostream} is destroyed.
+@end deftypefn
+
+@menu
+* Writing:: Writing on an ostream.
+* Output Position:: Repositioning an ostream.
+* Ostream Housekeeping:: Miscellaneous ostream utilities.
+@end menu
+
+@node Writing
+@subsection Writing on an @code{ostream}
+
+These methods write on an @code{ostream} (you may also use the operator
+@code{<<}; @pxref{Operators,,Operators and Default Streams}).
+
+@deftypefn Method ostream& ostream::put (char @var{c})
+Write the single character @var{c}.
+@end deftypefn
+
+@deftypefn Method ostream& ostream::write (@var{string}, int @var{length})
+Write @var{length} characters of a string to this @code{ostream},
+beginning at the pointer @var{string}.
+
+@var{string} may have any of these types: @code{char*}, @code{unsigned
+char*}, @code{signed char*}.
+@end deftypefn
+
+@deftypefn Method ostream& ostream::form (const char *@var{format}, ...)
+A @sc{gnu} extension, similar to @code{fprintf(@var{file},
+@var{format}, ...)}.
+
+@var{format} is a @code{printf}-style format control string, which is used
+to format the (variable number of) arguments, printing the result on
+this @code{ostream}. See @code{ostream::vform} for a version that uses
+an argument list rather than a variable number of arguments.
+@end deftypefn
+
+@deftypefn Method ostream& ostream::vform (const char *@var{format}, va_list @var{args})
+A @sc{gnu} extension, similar to @code{vfprintf(@var{file},
+@var{format}, @var{args})}.
+
+@var{format} is a @code{printf}-style format control string, which is used
+to format the argument list @var{args}, printing the result on
+this @code{ostream}. See @code{ostream::form} for a version that uses a
+variable number of arguments rather than an argument list.
+@end deftypefn
+
+@node Output Position
+@subsection Repositioning an @code{ostream}
+
+You can control the output position (on output streams that actually
+support positions, typically files) with these methods:
+@c FIXME-future: sort out which classes support this and which
+@c don't; fstream, filebuf? And what is failure condition when not supported?
+
+@deftypefn Method streampos ostream::tellp ()
+Return the current write position in the stream.
+@end deftypefn
+
+@deftypefn Method ostream& ostream::seekp (streampos @var{loc})
+Reset the output position to @var{loc} (which is usually the result of a
+previous call to @code{ostream::tellp}). @var{loc} specifies an
+absolute position in the output stream.
+@end deftypefn
+
+@deftypefn Method ostream& ostream::seekp (streamoff @var{loc}, @var{rel})
+@findex ios::seekdir
+Reset the output position to @var{loc}, relative to the beginning, end,
+or current output position in the stream, as indicated by @var{rel} (a
+value from the enumeration @code{ios::seekdir}):
+
+@vtable @code
+@item beg
+Interpret @var{loc} as an absolute offset from the beginning of the
+file.
+
+@item cur
+Interpret @var{loc} as an offset relative to the current output
+position.
+
+@item end
+Interpret @var{loc} as an offset from the current end of the output
+stream.
+@end vtable
+@end deftypefn
+
+@node Ostream Housekeeping
+@subsection Miscellaneous @code{ostream} utilities
+
+You may need to use these @code{ostream} methods for housekeeping:
+
+@deftypefn Method ostream& flush ()
+Deliver any pending buffered output for this @code{ostream}.
+@end deftypefn
+
+@deftypefn Method int ostream::opfx ()
+@code{opfx} is a @dfn{prefix} method for operations on @code{ostream}
+objects; it is designed to be called before any further processing. See
+@code{ostream::osfx} for the converse.
+@c FIXME-future: specify sometime which methods start with opfx.
+
+@code{opfx} tests that the stream is in state @code{good}, and if so
+flushes any stream tied to this one.
+
+The result is @code{1} when @code{opfx} succeeds; else (if the stream state is
+not @code{good}), the result is @code{0}.
+@end deftypefn
+
+@deftypefn Method void ostream::osfx ()
+@code{osfx} is a @dfn{suffix} method for operations on @code{ostream}
+objects; it is designed to be called at the conclusion of any processing. All
+the @code{ostream} methods end by calling @code{osfx}. See
+@code{ostream::opfx} for the converse.
+
+If the @code{unitbuf} flag is set for this stream, @code{osfx} flushes
+any buffered output for it.
+
+If the @code{stdio} flag is set for this stream, @code{osfx} flushes any
+output buffered for the C output streams @file{stdout} and @file{stderr}.
+@end deftypefn
+
+@node Istream
+@section Managing input streams: class @code{istream}
+
+Class @code{istream} objects are specialized for input; as for
+@code{ostream}, they are derived from @code{ios}, so you can use any of
+the general-purpose methods from that base class. Declarations for this
+class also come from @file{iostream.h}.
+
+@deftypefn Constructor {} istream::istream ()
+When used without arguments, the @code{istream} constructor simply
+allocates a new @code{ios} object and initializes the input counter (the
+value reported by @code{istream::gcount}) to @code{0}.
+@end deftypefn
+
+@deftypefn Constructor {} istream::istream (streambuf *@var{sb} @w{[, ostream} @var{tie}])
+You can also call the constructor with one or two arguments. The first
+argument @var{sb} is a @code{streambuf*}; if you supply this pointer,
+the constructor uses that @code{streambuf} for input.
+You can use the second optional argument @var{tie} to specify a related
+output stream as the initial value for @code{ios::tie}.
+
+If you give the @code{istream} a @code{streambuf} explicitly, using
+this constructor, the @var{sb} is @emph{not} destroyed (or deleted or
+closed) when the @code{ostream} is destroyed.
+@end deftypefn
+
+@menu
+* Char Input:: Reading one character.
+* String Input:: Reading strings.
+* Input Position:: Repositioning an istream.
+* Istream Housekeeping:: Miscellaneous istream utilities.
+@end menu
+
+@node Char Input
+@subsection Reading one character
+
+Use these methods to read a single character from the input stream:
+
+@deftypefn Method int istream::get ()
+Read a single character (or @code{EOF}) from the input stream, returning
+it (coerced to an unsigned char) as the result.
+@end deftypefn
+
+@deftypefn Method istream& istream::get (char& @var{c})
+Read a single character from the input stream, into @code{&@var{c}}.
+@end deftypefn
+
+@deftypefn Method int istream::peek ()
+Return the next available input character, but @emph{without} changing
+the current input position.
+@end deftypefn
+
+@node String Input
+@subsection Reading strings
+
+Use these methods to read strings (for example, a line at a time) from
+the input stream:
+
+@deftypefn Method istream& istream::get (char* @var{c}, int @var{len} @w{[, char} @var{delim}])
+Read a string from the input stream, into the array at @var{c}.
+
+The remaining arguments limit how much to read: up to @samp{len-1}
+characters, or up to (but not including) the first occurrence in the
+input of a particular delimiter character @var{delim}---newline
+(@code{\n}) by default. (Naturally, if the stream reaches end of file
+first, that too will terminate reading.)
+
+If @var{delim} was present in the input, it remains available as if
+unread; to discard it instead, see @code{iostream::getline}.
+
+@code{get} writes @samp{\0} at the end of the string, regardless
+of which condition terminates the read.
+@end deftypefn
+
+@deftypefn Method istream& istream::get (streambuf& @var{sb} @w{[, char} @var{delim}])
+Read characters from the input stream and copy them on the
+@code{streambuf} object @var{sb}. Copying ends either just before the
+next instance of the delimiter character @var{delim} (newline @code{\n}
+by default), or when either stream ends. If @var{delim} was present in
+the input, it remains available as if unread.
+@end deftypefn
+
+@deftypefn Method istream& istream::getline (@var{charptr}, int @var{len} @w{[, char} @var{delim}])
+Read a line from the input stream, into the array at @var{charptr}.
+@var{charptr} may be any of three kinds of pointer: @code{char*},
+@code{unsigned char*}, or @code{signed char*}.
+
+The remaining arguments limit how much to read: up to (but not
+including) the first occurrence in the input of a line delimiter
+character @var{delim}---newline (@code{\n}) by default, or up to
+@samp{len-1} characters (or to end of file, if that happens sooner).
+
+If @code{getline} succeeds in reading a ``full line'', it also discards
+the trailing delimiter character from the input stream. (To preserve it
+as available input, see the similar form of @code{iostream::get}.)
+
+If @var{delim} was @emph{not} found before @var{len} characters or end
+of file, @code{getline} sets the @code{ios::fail} flag, as well as the
+@code{ios::eof} flag if appropriate.
+
+@code{getline} writes a null character at the end of the string, regardless
+of which condition terminates the read.
+@end deftypefn
+
+@deftypefn Method istream& istream::read (@var{pointer}, int @var{len})
+Read @var{len} bytes into the location at @var{pointer}, unless the
+input ends first.
+
+@var{pointer} may be of type @code{char*}, @code{void*}, @code{unsigned
+char*}, or @code{signed char*}.
+
+If the @code{istream} ends before reading @var{len} bytes, @code{read}
+sets the @code{ios::fail} flag.
+@end deftypefn
+
+@deftypefn Method istream& istream::gets (char **@var{s} @w{[, char} @var{delim}])
+A @sc{gnu} extension, to read an arbitrarily long string
+from the current input position to the next instance of the @var{delim}
+character (newline @code{\n} by default).
+
+To permit reading a string of arbitrary length, @code{gets} allocates
+whatever memory is required. Notice that the first argument @var{s} is
+an address to record a character pointer, rather than the pointer
+itself.
+@end deftypefn
+
+@deftypefn Method istream& istream::scan (const char *format ...)
+A @sc{gnu} extension, similar to @code{fscanf(@var{file},
+@var{format}, ...)}. The @var{format} is a @code{scanf}-style format
+control string, which is used to read the variables in the remainder of
+the argument list from the @code{istream}.
+@end deftypefn
+
+@deftypefn Method istream& istream::vscan (const char *format, va_list args)
+Like @code{istream::scan}, but takes a single @code{va_list} argument.
+@end deftypefn
+
+@node Input Position
+@subsection Repositioning an @code{istream}
+
+Use these methods to control the current input position:
+
+@deftypefn Method streampos istream::tellg ()
+Return the current read position, so that you can save it and return to
+it later with @code{istream::seekg}.
+@end deftypefn
+
+@deftypefn Method istream& istream::seekg (streampos @var{p})
+Reset the input pointer (if the input device permits it) to @var{p},
+usually the result of an earlier call to @code{istream::tellg}.
+@end deftypefn
+
+@deftypefn Method istream& istream::seekg (streamoff @var{offset}, ios::seek_dir @var{ref})
+Reset the input pointer (if the input device permits it) to @var{offset}
+characters from the beginning of the input, the current position, or the
+end of input. Specify how to interpret @var{offset} with one of these
+values for the second argument:
+
+@vtable @code
+@item ios::beg
+Interpret @var{loc} as an absolute offset from the beginning of the
+file.
+
+@item ios::cur
+Interpret @var{loc} as an offset relative to the current output
+position.
+
+@item ios::end
+Interpret @var{loc} as an offset from the current end of the output
+stream.
+@end vtable
+@end deftypefn
+
+@node Istream Housekeeping
+@subsection Miscellaneous @code{istream} utilities
+
+Use these methods for housekeeping on @code{istream} objects:
+
+@deftypefn Method int istream::gcount ()
+Report how many characters were read from this @code{istream} in the
+last unformatted input operation.
+@c FIXME! Define "unformatted input" somewhere...
+@end deftypefn
+
+@deftypefn Method int istream::ipfx (int @var{keepwhite})
+Ensure that the @code{istream} object is ready for reading; check for
+errors and end of file and flush any tied stream. @code{ipfx} skips
+whitespace if you specify @code{0} as the @var{keepwhite}
+argument, @emph{and} @code{ios::skipws} is set for this stream.
+
+To avoid skipping whitespace (regardless of the @code{skipws} setting on
+the stream), use @code{1} as the argument.
+
+Call @code{istream::ipfx} to simplify writing your own methods for reading
+@code{istream} objects.
+@end deftypefn
+
+@deftypefn Method void istream::isfx ()
+A placeholder for compliance with the draft @sc{ansi} standard; this
+method does nothing whatever.
+
+If you wish to write portable standard-conforming code on @code{istream}
+objects, call @code{isfx} after any operation that reads from an
+@code{istream}; if @code{istream::ipfx} has any special effects that
+must be cancelled when done, @code{istream::isfx} will cancel them.
+@end deftypefn
+
+@deftypefn Method istream& istream::ignore ([int @var{n}] @w{[, int} @var{delim}])
+Discard some number of characters pending input. The first optional
+argument @var{n} specifies how many characters to skip. The second
+optional argument @var{delim} specifies a ``boundary'' character:
+@code{ignore} returns immediately if this character appears in the
+input.
+
+By default, @var{delim} is @code{EOF}; that is, if you do not specify a
+second argument, only the count @var{n} restricts how much to ignore
+(while input is still available).
+
+If you do not specify how many characters to ignore, @code{ignore}
+returns after discarding only one character.
+@end deftypefn
+
+@deftypefn Method istream& istream::putback (char @var{ch})
+Attempts to back up one character, replacing the character backed-up
+over by @var{ch}. Returns @code{EOF} if this is not allowed. Putting
+back the most recently read character is always allowed. (This method
+corresponds to the C function @code{ungetc}.)
+@end deftypefn
+
+@deftypefn Method istream& istream::unget ()
+Attempt to back up one character.
+@end deftypefn
+
+@node Iostream
+@section Input and output together: class @code{iostream}
+
+If you need to use the same stream for input and output, you can use an
+object of the class @code{iostream}, which is derived from @emph{both}
+@code{istream} and @code{ostream}.
+
+The constructors for @code{iostream} behave just like the constructors
+for @code{istream}.
+
+@deftypefn Constructor {} iostream::iostream ()
+When used without arguments, the @code{iostream} constructor simply
+allocates a new @code{ios} object, and initializes the input counter
+(the value reported by @code{istream::gcount}) to @code{0}.
+@end deftypefn
+
+@deftypefn Constructor {} iostream::iostream (streambuf* @var{sb} @w{[, ostream*} @var{tie}])
+You can also call a constructor with one or two arguments. The first
+argument @var{sb} is a @code{streambuf*}; if you supply this pointer,
+the constructor uses that @code{streambuf} for input and output.
+
+You can use the optional second argument @var{tie} (an @code{ostream*})
+to specify a related output stream as the initial value for
+@code{ios::tie}.
+@end deftypefn
+
+@cindex @code{iostream} destructor
+@cindex destructor for @code{iostream}
+As for @code{ostream} and @code{istream}, @code{iostream} simply uses
+the @code{ios} destructor. However, an @code{iostream} is not deleted by
+its destructor.
+
+You can use all the @code{istream}, @code{ostream}, and @code{ios}
+methods with an @code{iostream} object.
+
+@node Files and Strings
+@chapter Classes for Files and Strings
+
+There are two very common special cases of input and output: using files,
+and using strings in memory.
+
+@code{libio} defines four specialized classes for these cases:
+
+@ftable @code
+@item ifstream
+Methods for reading files.
+
+@item ofstream
+Methods for writing files.
+
+@item istrstream
+Methods for reading strings from memory.
+
+@item ostrstream
+Methods for writing strings in memory.
+@end ftable
+
+@menu
+* Files:: Reading and writing files.
+* Strings:: Reading and writing strings in memory.
+@end menu
+
+@node Files
+@section Reading and writing files
+
+These methods are declared in @file{fstream.h}.
+
+@findex ifstream
+@cindex class @code{ifstream}
+You can read data from class @code{ifstream} with any operation from class
+@code{istream}. There are also a few specialized facilities:
+
+@deftypefn Constructor {} ifstream::ifstream ()
+Make an @code{ifstream} associated with a new file for input. (If you
+use this version of the constructor, you need to call
+@code{ifstream::open} before actually reading anything)
+@end deftypefn
+
+@deftypefn Constructor {} ifstream::ifstream (int @var{fd})
+Make an @code{ifstream} for reading from a file that was already open,
+using file descriptor @var{fd}. (This constructor is compatible with
+other versions of iostreams for @sc{posix} systems, but is not part of
+the @sc{ansi} working paper.)
+@end deftypefn
+
+@deftypefn Constructor {} ifstream::ifstream (const char* @var{fname} @w{[, int} @var{mode} @w{[, int} @var{prot}]])
+Open a file @code{*@var{fname}} for this @code{ifstream} object.
+
+By default, the file is opened for input (with @code{ios::in} as
+@var{mode}). If you use this constructor, the file will be closed when
+the @code{ifstream} is destroyed.
+
+You can use the optional argument @var{mode} to specify how to open the
+file, by combining these enumerated values (with @samp{|} bitwise or).
+(These values are actually defined in class @code{ios}, so that all
+file-related streams may inherit them.) Only some of these modes are
+defined in the latest draft @sc{ansi} specification; if portability is
+important, you may wish to avoid the others.
+
+@vtable @code
+@item ios::in
+Open for input. (Included in @sc{ansi} draft.)
+
+@item ios::out
+Open for output. (Included in @sc{ansi} draft.)
+
+@item ios::ate
+Set the initial input (or output) position to the end of the file.
+
+@item ios::app
+Seek to end of file before each write. (Included in @sc{ansi} draft.)
+
+@item ios::trunc
+Guarantee a fresh file; discard any contents that were previously
+associated with it.
+
+@item ios::nocreate
+Guarantee an existing file; fail if the specified file did not already
+exist.
+
+@item ios::noreplace
+Guarantee a new file; fail if the specified file already existed.
+
+@item ios::bin
+Open as a binary file (on systems where binary and text files have different
+properties, typically how @samp{\n} is mapped; included in @sc{ansi} draft).
+@end vtable
+
+@noindent
+The last optional argument @var{prot} is specific to Unix-like systems;
+it specifies the file protection (by default @samp{644}).
+@end deftypefn
+
+@deftypefn Method void ifstream::open (const char* @var{fname} @w{[, int} @var{mode} @w{[, int} @var{prot}]])
+Open a file explicitly after the associated @code{ifstream} object
+already exists (for instance, after using the default constructor). The
+arguments, options and defaults all have the same meanings as in the
+fully specified @code{ifstream} constructor.
+@end deftypefn
+
+@findex ostream
+@cindex class @code{ostream}
+You can write data to class @code{ofstream} with any operation from class
+@code{ostream}. There are also a few specialized facilities:
+
+@deftypefn Constructor {} ofstream::ofstream ()
+Make an @code{ofstream} associated with a new file for output.
+@end deftypefn
+
+@deftypefn Constructor {} ofstream::ofstream (int @var{fd})
+Make an @code{ofstream} for writing to a file that was already open,
+using file descriptor @var{fd}.
+@end deftypefn
+
+@deftypefn Constructor {} ofstream::ofstream (const char* @var{fname} @w{[, int} @var{mode} @w{[, int} @var{prot}]])
+Open a file @code{*@var{fname}} for this @code{ofstream} object.
+
+By default, the file is opened for output (with @code{ios::out} as @var{mode}).
+You can use the optional argument @var{mode} to specify how to open the
+file, just as described for @code{ifstream::ifstream}.
+
+The last optional argument @var{prot} specifies the file protection (by
+default @samp{644}).
+@end deftypefn
+
+@deftypefn Destructor {} ofstream::~ofstream ()
+The files associated with @code{ofstream} objects are closed when the
+corresponding object is destroyed.
+@end deftypefn
+
+@deftypefn Method void ofstream::open (const char* @var{fname} @w{[, int} @var{mode} @w{[, int} @var{prot}]])
+Open a file explicitly after the associated @code{ofstream} object
+already exists (for instance, after using the default constructor). The
+arguments, options and defaults all have the same meanings as in the
+fully specified @code{ofstream} constructor.
+@end deftypefn
+
+@findex fstream
+@cindex class @code{fstream}
+The class @code{fstream} combines the facilities of @code{ifstream} and
+@code{ofstream}, just as @code{iostream} combines @code{istream} and
+@code{ostream}.
+
+@c FIXME-future: say something about fstream constructor, maybe.
+
+@findex fstreambase
+@cindex class @code{fstreambase}
+The class @code{fstreambase} underlies both @code{ifstream} and
+@code{ofstream}. They both inherit this additional method:
+
+@deftypefn Method void fstreambase::close ()
+Close the file associated with this object, and set @code{ios::fail} in
+this object to mark the event.
+@end deftypefn
+
+@node Strings
+@section Reading and writing in memory
+
+@c FIXME!! Per, there's a lot of guesswork here---please check carefully!
+
+@findex istrstream
+@cindex class @code{istrstream}
+@findex ostrstream
+@cindex class @code{ostrstream}
+@findex strstream
+@cindex class @code{strstream}
+@findex strstreambase
+@cindex class @code{strstreambase}
+@findex strstreambuf
+@cindex class @code{strstreambuf}
+The classes @code{istrstream}, @code{ostrstream}, and @code{strstream}
+provide some additional features for reading and writing strings in
+memory---both static strings, and dynamically allocated strings. The
+underlying class @code{strstreambase} provides some features common to
+all three; @code{strstreambuf} underlies that in turn.
+
+@c FIXME-future: Document strstreambuf methods one day, when we document
+@c streambuf more fully.
+
+@deftypefn Constructor {} istrstream::istrstream (const char* @var{str} @w{[, int} @var{size}])
+Associate the new input string class @code{istrstream} with an existing
+static string starting at @var{str}, of size @var{size}. If you do not
+specify @var{size}, the string is treated as a @code{NUL} terminated string.
+@end deftypefn
+
+@deftypefn Constructor {} ostrstream::ostrstream ()
+Create a new stream for output to a dynamically managed string, which
+will grow as needed.
+@end deftypefn
+
+@deftypefn Constructor {} ostrstream::ostrstream (char* @var{str}, int @var{size} [,int @var{mode}])
+A new stream for output to a statically defined string of length
+@var{size}, starting at @var{str}. You may optionally specify one of
+the modes described for @code{ifstream::ifstream}; if you do not specify
+one, the new stream is simply open for output, with mode @code{ios::out}.
+@end deftypefn
+
+@deftypefn Method int ostrstream::pcount ()
+Report the current length of the string associated with this @code{ostrstream}.
+@end deftypefn
+
+@deftypefn Method char* ostrstream::str ()
+A pointer to the string managed by this @code{ostrstream}. Implies
+@samp{ostrstream::freeze()}.
+
+Note that if you want the string to be nul-terminated,
+you must do that yourself (perhaps by writing ends to the stream).
+@end deftypefn
+
+@deftypefn Method void ostrstream::freeze ([int @var{n}])
+If @var{n} is nonzero (the default), declare that the string associated
+with this @code{ostrstream} is not to change dynamically; while frozen,
+it will not be reallocated if it needs more space, and it will not be
+deallocated when the @code{ostrstream} is destroyed. Use
+@samp{freeze(1)} if you refer to the string as a pointer after creating
+it via @code{ostrstream} facilities.
+
+@samp{freeze(0)} cancels this declaration, allowing a dynamically
+allocated string to be freed when its @code{ostrstream} is destroyed.
+
+If this @code{ostrstream} is already static---that is, if it was created
+to manage an existing statically allocated string---@code{freeze} is
+unnecessary, and has no effect.
+@end deftypefn
+
+@deftypefn Method int ostrstream::frozen ()
+Test whether @code{freeze(1)} is in effect for this string.
+@end deftypefn
+
+@deftypefn Method strstreambuf* strstreambase::rdbuf ()
+A pointer to the underlying @code{strstreambuf}.
+@end deftypefn
+
+@node Streambuf
+@chapter Using the @code{streambuf} Layer
+
+The @code{istream} and @code{ostream} classes are meant to handle
+conversion between objects in your program and their textual representation.
+
+By contrast, the underlying @code{streambuf} class is for transferring
+raw bytes between your program, and input sources or output sinks.
+Different @code{streambuf} subclasses connect to different kinds of
+sources and sinks.
+
+The @sc{gnu} implementation of @code{streambuf} is still evolving; we
+describe only some of the highlights.
+
+@menu
+* Areas:: Areas in a streambuf.
+* Overflow:: Simple output re-direction
+* Formatting:: C-style formatting for streambuf objects.
+* Stdiobuf:: Wrappers for C stdio.
+* Procbuf:: Reading/writing from/to a pipe
+* Backing Up:: Marking and returning to a position.
+* Indirectbuf:: Forwarding I/O activity.
+@end menu
+
+@node Areas
+@section Areas of a @code{streambuf}
+
+Streambuf buffer management is fairly sophisticated (this is a
+nice way to say ``complicated''). The standard protocol
+has the following ``areas'':
+
+@itemize @bullet
+@item
+@cindex put area
+The @dfn{put area} contains characters waiting for output.
+
+@item
+@cindex get area
+The @dfn{get area} contains characters available for reading.
+@end itemize
+
+The @sc{gnu} @code{streambuf} design extends this, but the details are
+still evolving.
+
+The following methods are used to manipulate these areas.
+These are all protected methods, which are intended to be
+used by virtual function in classes derived from @code{streambuf}.
+They are also all ANSI/ISO-standard, and the ugly names
+are traditional.
+(Note that if a pointer points to the 'end' of an area,
+it means that it points to the character after the area.)
+
+@deftypefn Method char* streambuf::pbase () const
+Returns a pointer to the start of the put area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::epptr () const
+Returns a pointer to the end of the put area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::pptr () const
+If @code{pptr() < epptr ()}, the @code{pptr()}
+returns a pointer to the current put position.
+(In that case, the next write will
+overwrite @code{*pptr()}, and increment @code{pptr()}.)
+Otherwise, there is no put position available
+(and the next character written will cause @code{streambuf::overflow}
+to be called).
+@end deftypefn
+
+@deftypefn Method void streambuf::pbump (int @var{N})
+Add @var{N} to the current put pointer.
+No error checking is done.
+@end deftypefn
+
+@deftypefn Method void streambuf::setp (char* @var{P}, char* @var{E})
+Sets the start of the put area to @var{P}, the end of the put area to @var{E},
+and the current put pointer to @var{P} (also).
+@end deftypefn
+
+@deftypefn Method char* streambuf::eback () const
+Returns a pointer to the start of the get area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::egptr () const
+Returns a pointer to the end of the get area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::gptr () const
+If @code{gptr() < egptr ()}, then @code{gptr()}
+returns a pointer to the current get position.
+(In that case the next read will read @code{*gptr()},
+and possibly increment @code{gptr()}.)
+Otherwise, there is no read position available
+(and the next read will cause @code{streambuf::underflow}
+to be called).
+@end deftypefn
+
+@deftypefn Method void streambuf:gbump (int @var{N})
+Add @var{N} to the current get pointer.
+No error checking is done.
+@end deftypefn
+
+@deftypefn Method void streambuf::setg (char* @var{B}, char* @var{P}, char* @var{E})
+Sets the start of the get area to @var{B}, the end of the get area to @var{E},
+and the current put pointer to @var{P}.
+@end deftypefn
+
+@node Overflow
+@section Simple output re-direction by redefining @code{overflow}
+
+Suppose you have a function @code{write_to_window} that
+writes characters to a @code{window} object. If you want to use the
+ostream function to write to it, here is one (portable) way to do it.
+This depends on the default buffering (if any).
+
+@cartouche
+@smallexample
+#include <iostream.h>
+/* Returns number of characters successfully written to @var{win}. */
+extern int write_to_window (window* win, char* text, int length);
+
+class windowbuf : public streambuf @{
+ window* win;
+ public:
+ windowbuf (window* w) @{ win = w; @}
+ int sync ();
+ int overflow (int ch);
+ // Defining xsputn is an optional optimization.
+ // (streamsize was recently added to ANSI C++, not portable yet.)
+ streamsize xsputn (char* text, streamsize n);
+@};
+
+int windowbuf::sync ()
+@{ streamsize n = pptr () - pbase ();
+ return (n && write_to_window (win, pbase (), n) != n) ? EOF : 0;
+@}
+
+int windowbuf::overflow (int ch)
+@{ streamsize n = pptr () - pbase ();
+ if (n && sync ())
+ return EOF;
+ if (ch != EOF)
+ @{
+ char cbuf[1];
+ cbuf[0] = ch;
+ if (write_to_window (win, cbuf, 1) != 1)
+ return EOF;
+ @}
+ pbump (-n); // Reset pptr().
+ return 0;
+@}
+
+streamsize windowbuf::xsputn (char* text, streamsize n)
+@{ return sync () == EOF ? 0 : write_to_window (win, text, n); @}
+
+int
+main (int argc, char**argv)
+@{
+ window *win = ...;
+ windowbuf wbuf(win);
+ ostream wstr(&wbuf);
+ wstr << "Hello world!\n";
+@}
+@end smallexample
+@end cartouche
+
+
+
+@node Formatting
+@section C-style formatting for @code{streambuf} objects
+
+The @sc{gnu} @code{streambuf} class supports @code{printf}-like
+formatting and scanning.
+
+@deftypefn Method int streambuf::form (const char *@var{format}, ...)
+Similar to @code{fprintf(@var{file}, @var{format}, ...)}.
+The @var{format} is a @code{printf}-style format control string, which is used
+to format the (variable number of) arguments, printing the result on
+the @code{this} streambuf. The result is the number of characters printed.
+@end deftypefn
+
+@deftypefn Method int streambuf::vform (const char *@var{format}, va_list @var{args})
+Similar to @code{vfprintf(@var{file}, @var{format}, @var{args})}.
+The @var{format} is a @code{printf}-style format control string, which is used
+to format the argument list @var{args}, printing the result on
+the @code{this} streambuf. The result is the number of characters printed.
+@end deftypefn
+
+@deftypefn Method int streambuf::scan (const char *@var{format}, ...)
+Similar to @code{fscanf(@var{file}, @var{format}, ...)}.
+The @var{format} is a @code{scanf}-style format control string, which is used
+to read the (variable number of) arguments from the @code{this} streambuf.
+The result is the number of items assigned, or @code{EOF} in case of
+input failure before any conversion.
+@end deftypefn
+
+@deftypefn Method int streambuf::vscan (const char *@var{format}, va_list @var{args})
+Like @code{streambuf::scan}, but takes a single @code{va_list} argument.
+@end deftypefn
+
+@node Stdiobuf
+@section Wrappers for C @code{stdio}
+
+A @dfn{stdiobuf} is a @code{streambuf} object that points to
+a @code{FILE} object (as defined by @code{stdio.h}).
+All @code{streambuf} operations on the @code{stdiobuf} are forwarded
+to the @code{FILE}. Thus the @code{stdiobuf} object provides a
+wrapper around a @code{FILE}, allowing use of @code{streambuf}
+operations on a @code{FILE}. This can be useful when mixing
+C code with C++ code.
+
+The pre-defined streams @code{cin}, @code{cout}, and @code{cerr} are
+normally implemented as @code{stdiobuf} objects that point to
+respectively @code{stdin}, @code{stdout}, and @code{stderr}. This is
+convenient, but it does cost some extra overhead.
+
+If you set things up to use the implementation of @code{stdio} provided
+with this library, then @code{cin}, @code{cout}, and @code{cerr} will be
+set up to to use @code{stdiobuf} objects, since you get their benefits
+for free. @xref{Stdio,,C Input and Output}.
+
+@ignore
+@c FIXME-future: setbuf is not yet documented, hence this para is not useful.
+Note that if you use @code{setbuf} to give a buffer to a @code{stdiobuf},
+that buffer will provide intermediate buffering in addition that
+whatever is done by the @code{FILE}.
+@end ignore
+
+@node Procbuf
+@section Reading/writing from/to a pipe
+
+The @dfn{procbuf} class is a @sc{gnu} extension. It is derived from
+@code{streambuf}. A @code{procbuf} can be @dfn{closed} (in which case
+it does nothing), or @dfn{open} (in which case it allows communicating
+through a pipe with some other program).
+
+@deftypefn Constructor {} procbuf::procbuf ()
+Creates a @code{procbuf} in a @dfn{closed} state.
+@end deftypefn
+
+@deftypefn Method procbuf* procbuf::open (const char *@var{command}, int @var{mode})
+Uses the shell (@file{/bin/sh}) to run a program specified by @var{command}.
+
+If @var{mode} is @samp{ios::in}, standard output from the program is sent
+to a pipe; you can read from the pipe by reading from the
+@code{procbuf}. (This is similar to @w{@samp{popen(@var{command}, "r")}}.)
+
+If @var{mode} is @samp{ios::out}, output written written to the
+@code{procbuf} is written to a pipe; the program is set up to read its
+standard input from (the other end of) the pipe. (This is similar to
+@w{@samp{popen(@var{command}, "w")}}.)
+
+The @code{procbuf} must start out in the @dfn{closed} state.
+Returns @samp{*this} on success, and @samp{NULL} on failure.
+@end deftypefn
+
+@deftypefn Constructor {} procbuf::procbuf (const char *@var{command}, int @var{mode})
+Calls @samp{procbuf::open (@var{command}, @var{mode})}.
+@end deftypefn
+
+@deftypefn Method procbuf* procbuf::close ()
+Waits for the program to finish executing,
+and then cleans up the resources used.
+Returns @samp{*this} on success, and @samp{NULL} on failure.
+@end deftypefn
+
+@deftypefn Destructor {} procbuf::~procbuf ()
+Calls @samp{procbuf::close}.
+@end deftypefn
+
+@node Backing Up
+@section Backing up
+
+The @sc{gnu} iostream library allows you to ask a @code{streambuf} to
+remember the current position. This allows you to go back to this
+position later, after reading further. You can back up arbitrary
+amounts, even on unbuffered files or multiple buffers' worth, as long as
+you tell the library in advance. This unbounded backup is very useful
+for scanning and parsing applications. This example shows a typical
+scenario:
+
+@cartouche
+@smallexample
+// Read either "dog", "hound", or "hounddog".
+// If "dog" is found, return 1.
+// If "hound" is found, return 2.
+// If "hounddog" is found, return 3.
+// If none of these are found, return -1.
+int my_scan(streambuf* sb)
+@{
+ streammarker fence(sb);
+ char buffer[20];
+ // Try reading "hounddog":
+ if (sb->sgetn(buffer, 8) == 8
+ && strncmp(buffer, "hounddog", 8) == 0)
+ return 3;
+ // No, no "hounddog": Back up to 'fence'
+ sb->seekmark(fence); //
+ // ... and try reading "dog":
+ if (sb->sgetn(buffer, 3) == 3
+ && strncmp(buffer, "dog", 3) == 0)
+ return 1;
+ // No, no "dog" either: Back up to 'fence'
+ sb->seekmark(fence); //
+ // ... and try reading "hound":
+ if (sb->sgetn(buffer, 5) == 5
+ && strncmp(buffer, "hound", 5) == 0)
+ return 2;
+ // No, no "hound" either: Back up and signal failure.
+ sb->seekmark(fence); // Backup to 'fence'
+ return -1;
+@}
+@end smallexample
+@end cartouche
+
+@deftypefn Constructor {} streammarker::streammarker (streambuf* @var{sbuf})
+Create a @code{streammarker} associated with @var{sbuf}
+that remembers the current position of the get pointer.
+@end deftypefn
+
+@deftypefn Method int streammarker::delta (streammarker& @var{mark2})
+Return the difference between the get positions corresponding
+to @code{*this} and @var{mark2} (which must point into the same
+@code{streambuffer} as @code{this}).
+@end deftypefn
+
+@deftypefn Method int streammarker::delta ()
+Return the position relative to the streambuffer's current get position.
+@end deftypefn
+
+@deftypefn Method int streambuf::seekmark (streammarker& @var{mark})
+Move the get pointer to where it (logically) was when @var{mark}
+was constructed.
+@end deftypefn
+
+@node Indirectbuf
+@section Forwarding I/O activity
+
+An @dfn{indirectbuf} is one that forwards all of its I/O requests
+to another streambuf.
+
+@ignore
+@c FIXME-future: get_stream and put_stream are so far undocumented.
+All get-related requests are sent to get_stream().
+All put-related requests are sent to put_stream().
+@end ignore
+
+An @code{indirectbuf} can be used to implement Common Lisp
+synonym-streams and two-way-streams:
+
+@example
+class synonymbuf : public indirectbuf @{
+ Symbol *sym;
+ synonymbuf(Symbol *s) @{ sym = s; @}
+ virtual streambuf *lookup_stream(int mode) @{
+ return coerce_to_streambuf(lookup_value(sym)); @}
+@};
+@end example
+
+@node Stdio
+@chapter C Input and Output
+
+@code{libio} is distributed with a complete implementation of the ANSI C
+@code{stdio} facility. It is implemented using @code{streambuf}
+objects. @xref{Stdiobuf,,Wrappers for C @code{stdio}}.
+
+The @code{stdio} package is intended as a replacement for the whatever
+@code{stdio} is in your C library.
+@ignore
+@c FIXME-future: This is not useful unless we specify what problems.
+It can co-exist with C libraries that have alternate implementations of
+stdio, but there may be some problems.
+@end ignore
+Since @code{stdio} works best when you build @code{libc} to contain it, and
+that may be inconvenient, it is not installed by default.
+
+Extensions beyond @sc{ansi}:
+
+@itemize @bullet
+@item
+A stdio @code{FILE} is identical to a streambuf.
+Hence there is no need to worry about synchronizing C and C++
+input/output---they are by definition always synchronized.
+
+@item
+If you create a new streambuf sub-class (in C++), you can use it as a
+@code{FILE} from C. Thus the system is extensible using the standard
+@code{streambuf} protocol.
+
+@item
+You can arbitrarily mix reading and writing, without having to seek
+in between.
+
+@item
+Unbounded @code{ungetc()} buffer.
+@end itemize
+
+@ignore
+@c FIXME-future: Per says this is not ready to go public at v0.5
+@node Libio buffer management
+@chapter Libio buffer management
+
+The libio user functions present an abstract sequence of characters,
+that they read and write from. A number of buffers are used to go
+between the user program and the abstract sequence. These buffers are
+concrete arrays of characters that contain some sub-sequence of the
+abstract sequence.
+
+The libio buffer management protocol is fairly complex. Its design is
+based on the C++ @code{streambuf} protocol, so that the C++
+@code{streambuf} classes can be trivially implemented on top of the
+libio protocol.
+
+The @dfn{write area} contains characters waiting for output.
+
+The @dfn{read area} contains characters available for reading.
+
+The @dfn{reserve area} is available to virtual methods.
+Usually, the get and/or put areas are part of the reserve area.
+
+The @dfn{main get area} contains characters that have
+been read in from the character source, but not yet
+read by the application.
+
+The @dfn{backup area} contains previously read data that is being saved
+because of a user request, or that have been "unread" (put back).
+@end ignore
+
+@ignore
+@c Per says this design is not finished
+@node Streambuf internals
+@chapter Streambuf internals
+
+@menu
+* Buffer management::
+* Filebuf internals::
+@end menu
+
+@node Buffer management
+@section Buffer management
+
+@subsection Areas
+
+NOTE: This chapter is due for an update.
+
+Streambuf buffer management is fairly sophisticated (this is a
+nice way to say "complicated"). The standard protocol
+has the following "areas":
+
+@itemize @bullet
+@cindex put area
+@item
+The @dfn{put area} contains characters waiting for output.
+@cindex get area
+@item
+The @dfn{get area} contains characters available for reading.
+@cindex reserve area
+@item
+The @dfn{reserve area} is available to virtual methods.
+Usually, the get and/or put areas are part of the reserve area.
+@end itemize
+
+The @sc{gnu} @code{streambuf} design extends this by supporting two
+get areas:
+@itemize @bullet
+@cindex main get area
+@item
+The @dfn{main get area} contains characters that have
+been read in from the character source, but not yet
+read by the application.
+@cindex backup area
+@item
+The @dfn{backup area} contains previously read data that is being
+saved because of a user request, or that have been "unread" (putback).
+@end itemize
+
+The backup and the main get area are logically contiguous: That is,
+the first character of the main get area follows the last character
+of the backup area.
+
+The @dfn{current get area} is whichever one of the backup or
+main get areas that is currently being read from.
+The other of the two is the @dfn{non-current get area}.
+
+@subsection Pointers
+
+The following @code{char*} pointers define the various areas.
+
+@deftypefn Method char* streambuf::base ()
+The start of the reserve area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::ebuf ()
+The end of the reserve area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::Gbase ()
+The start of the main get area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::eGptr ()
+The end of the main get area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::Bbase ()
+The start of the backup area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::Bptr ()
+The start of the used part of the backup area.
+The area (@code{Bptr()} .. @code{eBptr()}) contains data that has been
+pushed back, while (@code{Bbase()} .. @code{eBptr()}) contains unused
+space available for future putbacks.
+@end deftypefn
+
+@deftypefn Method char* streambuf::eBptr ()
+The end of the backup area.
+@end deftypefn
+
+@deftypefn Method char* streambuf::Nbase ()
+The start of the non-current get area (either @code{main_gbase} or @code{backup_gbase}).
+@end deftypefn
+
+@deftypefn Method char* streambuf::eNptr ()
+The end of the non-current get area.
+@end deftypefn
+
+@node Filebuf internals
+@section Filebuf internals
+
+The @code{filebuf} is used a lot, so it is importamt that it be
+efficient. It is also supports rather complex semantics.
+so let us examine its implementation.
+
+@subsection Tied read and write pointers
+
+The streambuf model allows completely independent read and write pointers.
+However, a @code{filebuf} has only a single logical pointer used
+for both reads and writes. Since the @code{streambuf} protocol
+uses @code{gptr()} for reading and @code{pptr()} for writing,
+we map the logical file pointer into either @code{gptr()} or @code{pptr()}
+at different times.
+
+@itemize @bullet
+@item
+Reading is allowed when @code{gptr() < egptr()}, which we call get mode.
+
+@item
+Writing is allowed when @code{pptr() < epptr()}, which we call put mode.
+@end itemize
+
+@noindent
+A @code{filebuf} cannot be in get mode and put mode at the same time.
+
+We have up to two buffers:
+
+@itemize @bullet
+@item
+The backup area, defined by @code{Bbase()}, @code{Bptr()}, and @code{eBptr()}.
+This can be empty.
+
+@item
+The reserve area, which also contains the main get area.
+For an unbuffered file, the (@code{shortbuf()}..@code{shortbuf()+1}) is used,
+where @code{shortbuf()} points to a 1-byte buffer that is part of
+the @code{filebuf}.
+@end itemize
+
+@noindent
+The file system's idea of the current position is @code{eGptr()}.
+
+Characters that have been written into a buffer but not yet written
+out (flushed) to the file systems are those between @code{pbase()}
+and @code{pptr()}.
+
+The end of the valid data bytes is:
+@code{pptr() > eGptr() && pptr() < ebuf() ? pptr() : eGptr()}.
+
+If the @code{filebuf} is unbuffered or line buffered,
+the @code{eptr()} is @code{pbase()}. This forces a call
+to @code{overflow()} on each put of a character.
+The logical @code{epptr()} is @code{epptr() ? ebuf() : NULL}.
+(If the buffer is read-only, set @code{pbase()}, @code{pptr()},
+and @code{epptr()} to @code{NULL}. NOT!)
+@end ignore
+
+@node Index
+@unnumbered Index
+@printindex cp
+
+@contents
+@bye
diff --git a/libio/iostreamP.h b/libio/iostreamP.h
new file mode 100644
index 00000000000..c9c40cb6ba9
--- /dev/null
+++ b/libio/iostreamP.h
@@ -0,0 +1,26 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "streambuf.h"
+#include "libioP.h"
diff --git a/libio/iostrerror.c b/libio/iostrerror.c
new file mode 100644
index 00000000000..65aa25d5e4e
--- /dev/null
+++ b/libio/iostrerror.c
@@ -0,0 +1,12 @@
+/* This should be replaced by whatever namespace-clean
+ version of strerror you have available. */
+
+#include "libioP.h"
+extern char *strerror __P ((int));
+
+char *
+DEFUN(_IO_strerror, (errnum),
+ int errnum)
+{
+ return strerror(errnum);
+}
diff --git a/libio/ioungetc.c b/libio/ioungetc.c
new file mode 100644
index 00000000000..033f652a067
--- /dev/null
+++ b/libio/ioungetc.c
@@ -0,0 +1,35 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+int
+DEFUN(_IO_ungetc, (c, fp),
+ int c AND _IO_FILE *fp)
+{
+ CHECK_FILE(fp, EOF);
+ if (c == EOF)
+ return EOF;
+ return _IO_sputbackc(fp, (unsigned char)c);
+}
diff --git a/libio/iovfprintf.c b/libio/iovfprintf.c
new file mode 100644
index 00000000000..c41cbbf8abc
--- /dev/null
+++ b/libio/iovfprintf.c
@@ -0,0 +1,885 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/*
+ * Copyright (c) 1990 Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that the above copyright notice and this paragraph are
+ * duplicated in all such forms and that any documentation,
+ * advertising materials, and other materials related to such
+ * distribution and use acknowledge that the software was developed
+ * by the University of California, Berkeley. The name of the
+ * University may not be used to endorse or promote products derived
+ * from this software without specific prior written permission.
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ */
+
+
+#if defined(LIBC_SCCS) && !defined(lint)
+static char sccsid[] = "%W% (Berkeley) %G%";
+#endif /* LIBC_SCCS and not lint */
+
+/*
+ * Actual printf innards.
+ *
+ * This code is large and complicated...
+ */
+
+#include <sys/types.h>
+#include "libioP.h"
+#include <string.h>
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+#ifndef _IO_USE_DTOA
+int __cvt_double __P((double number, register int prec, int flags, int *signp, int fmtch, char *startp, char *endp));
+#endif
+
+/*
+ * Define FLOATING_POINT to get floating point.
+ */
+#ifndef NO_FLOATING_POINT
+#define FLOATING_POINT
+#endif
+
+/* end of configuration stuff */
+
+
+/*
+ * Helper "class" for `fprintf to unbuffered': creates a
+ * temporary buffer. */
+
+struct helper_file
+{
+ struct _IO_FILE_plus _f;
+ _IO_FILE *_put_stream;
+};
+
+static int
+DEFUN(_IO_helper_overflow, (fp, c),
+ _IO_FILE *fp AND int c)
+{
+ _IO_FILE *target = ((struct helper_file*)fp)->_put_stream;
+ int used = fp->_IO_write_ptr - fp->_IO_write_base;
+ if (used)
+ {
+ _IO_sputn(target, fp->_IO_write_base, used);
+ fp->_IO_write_ptr -= used;
+ }
+ return _IO_putc (c, fp);
+}
+
+static struct _IO_jump_t _IO_helper_jumps = {
+ JUMP_INIT_DUMMY,
+ JUMP_INIT(finish, _IO_default_finish),
+ JUMP_INIT(overflow, _IO_helper_overflow),
+ JUMP_INIT(underflow, _IO_default_underflow),
+ JUMP_INIT(uflow, _IO_default_uflow),
+ JUMP_INIT(pbackfail, _IO_default_pbackfail),
+ JUMP_INIT(xsputn, _IO_default_xsputn),
+ JUMP_INIT(xsgetn, _IO_default_xsgetn),
+ JUMP_INIT(seekoff, _IO_default_seekoff),
+ JUMP_INIT(seekpos, _IO_default_seekpos),
+ JUMP_INIT(setbuf, _IO_default_setbuf),
+ JUMP_INIT(sync, _IO_default_sync),
+ JUMP_INIT(doallocate, _IO_default_doallocate),
+ JUMP_INIT(read, _IO_default_read),
+ JUMP_INIT(write, _IO_default_write),
+ JUMP_INIT(seek, _IO_default_seek),
+ JUMP_INIT(close, _IO_default_close),
+ JUMP_INIT(stat, _IO_default_stat)
+};
+
+static int
+DEFUN(helper_vfprintf, (fp, fmt0, ap),
+ register _IO_FILE* fp AND char const *fmt0 AND _IO_va_list ap)
+{
+ char buf[_IO_BUFSIZ];
+ struct helper_file helper;
+ register _IO_FILE *hp = (_IO_FILE*)&helper;
+ int result, to_flush;
+
+ /* initialize helper */
+ helper._put_stream = fp;
+ hp->_IO_write_base = buf;
+ hp->_IO_write_ptr = buf;
+ hp->_IO_write_end = buf+_IO_BUFSIZ;
+ hp->_IO_file_flags = _IO_MAGIC|_IO_NO_READS;
+ _IO_JUMPS(hp) = &_IO_helper_jumps;
+
+ /* Now print to helper instead. */
+ result = _IO_vfprintf(hp, fmt0, ap);
+
+ /* Now flush anything from the helper to the fp. */
+ if ((to_flush = hp->_IO_write_ptr - hp->_IO_write_base) > 0)
+ {
+ if (_IO_sputn(fp, hp->_IO_write_base, to_flush) != to_flush)
+ return EOF;
+ }
+ return result;
+}
+
+#ifdef FLOATING_POINT
+
+#include "floatio.h"
+#define BUF (MAXEXP+MAXFRACT+1) /* + decimal point */
+#define DEFPREC 6
+extern double modf __P((double, double*));
+
+#else /* no FLOATING_POINT */
+
+#define BUF 40
+
+#endif /* FLOATING_POINT */
+
+
+/*
+ * Macros for converting digits to letters and vice versa
+ */
+#define to_digit(c) ((c) - '0')
+#define is_digit(c) ((unsigned)to_digit(c) <= 9)
+#define to_char(n) ((n) + '0')
+
+/*
+ * Flags used during conversion.
+ */
+#define LONGINT 0x01 /* long integer */
+#define LONGDBL 0x02 /* long double; unimplemented */
+#define SHORTINT 0x04 /* short integer */
+#define ALT 0x08 /* alternate form */
+#define LADJUST 0x10 /* left adjustment */
+#define ZEROPAD 0x20 /* zero (as opposed to blank) pad */
+#define HEXPREFIX 0x40 /* add 0x or 0X prefix */
+
+int
+DEFUN(_IO_vfprintf, (fp, fmt0, ap),
+ register _IO_FILE* fp AND char const *fmt0 AND _IO_va_list ap)
+{
+ register const char *fmt; /* format string */
+ register int ch; /* character from fmt */
+ register int n; /* handy integer (short term usage) */
+ register char *cp; /* handy char pointer (short term usage) */
+ const char *fmark; /* for remembering a place in fmt */
+ register int flags; /* flags as above */
+ int ret; /* return value accumulator */
+ int width; /* width from format (%8d), or 0 */
+ int prec; /* precision from format (%.3d), or -1 */
+ char sign; /* sign prefix (' ', '+', '-', or \0) */
+#ifdef FLOATING_POINT
+ int softsign; /* temporary negative sign for floats */
+ double _double; /* double precision arguments %[eEfgG] */
+#ifndef _IO_USE_DTOA
+ int fpprec; /* `extra' floating precision in [eEfgG] */
+#endif
+#endif
+ unsigned long _ulong; /* integer arguments %[diouxX] */
+ enum { OCT, DEC, HEX } base;/* base for [diouxX] conversion */
+ int dprec; /* a copy of prec if [diouxX], 0 otherwise */
+ int dpad; /* extra 0 padding needed for integers */
+ int fieldsz; /* field size expanded by sign, dpad etc */
+ /* The initialization of 'size' is to suppress a warning that
+ 'size' might be used unitialized. It seems gcc can't
+ quite grok this spaghetti code ... */
+ int size = 0; /* size of converted field or string */
+ char buf[BUF]; /* space for %c, %[diouxX], %[eEfgG] */
+ char ox[2]; /* space for 0x hex-prefix */
+
+ /*
+ * BEWARE, these `goto error' on error, and PAD uses `n'.
+ */
+#define PRINT(ptr, len) \
+ do { if (_IO_sputn(fp,ptr, len) != len) goto error; } while (0)
+#define PAD_SP(howmany) if (_IO_padn(fp, ' ', howmany) < (howmany)) goto error;
+#define PAD_0(howmany) if (_IO_padn(fp, '0', howmany) < (howmany)) goto error;
+
+ /*
+ * To extend shorts properly, we need both signed and unsigned
+ * argument extraction methods.
+ */
+#define SARG() \
+ (flags&LONGINT ? va_arg(ap, long) : \
+ flags&SHORTINT ? (long)(short)va_arg(ap, int) : \
+ (long)va_arg(ap, int))
+#define UARG() \
+ (flags&LONGINT ? va_arg(ap, unsigned long) : \
+ flags&SHORTINT ? (unsigned long)(unsigned short)va_arg(ap, int) : \
+ (unsigned long)va_arg(ap, unsigned int))
+
+ /* optimise stderr (and other unbuffered Unix files) */
+ if (fp->_IO_file_flags & _IO_UNBUFFERED)
+ return helper_vfprintf(fp, fmt0, ap);
+
+ fmt = fmt0;
+ ret = 0;
+
+ /*
+ * Scan the format for conversions (`%' character).
+ */
+ for (;;) {
+ for (fmark = fmt; (ch = *fmt) != '\0' && ch != '%'; fmt++)
+ /* void */;
+ if ((n = fmt - fmark) != 0) {
+ PRINT(fmark, n);
+ ret += n;
+ }
+ if (ch == '\0')
+ goto done;
+ fmt++; /* skip over '%' */
+
+ flags = 0;
+ dprec = 0;
+#if defined(FLOATING_POINT) && !defined (_IO_USE_DTOA)
+ fpprec = 0;
+#endif
+ width = 0;
+ prec = -1;
+ sign = '\0';
+
+rflag: ch = *fmt++;
+reswitch: switch (ch) {
+ case ' ':
+ /*
+ * ``If the space and + flags both appear, the space
+ * flag will be ignored.''
+ * -- ANSI X3J11
+ */
+ if (!sign)
+ sign = ' ';
+ goto rflag;
+ case '#':
+ flags |= ALT;
+ goto rflag;
+ case '*':
+ /*
+ * ``A negative field width argument is taken as a
+ * - flag followed by a positive field width.''
+ * -- ANSI X3J11
+ * They don't exclude field widths read from args.
+ */
+ if ((width = va_arg(ap, int)) >= 0)
+ goto rflag;
+ width = -width;
+ /* FALLTHROUGH */
+ case '-':
+ flags |= LADJUST;
+ flags &= ~ZEROPAD; /* '-' disables '0' */
+ goto rflag;
+ case '+':
+ sign = '+';
+ goto rflag;
+ case '.':
+ if ((ch = *fmt++) == '*') {
+ n = va_arg(ap, int);
+ prec = n < 0 ? -1 : n;
+ goto rflag;
+ }
+ n = 0;
+ while (is_digit(ch)) {
+ n = 10 * n + to_digit(ch);
+ ch = *fmt++;
+ }
+ prec = n < 0 ? -1 : n;
+ goto reswitch;
+ case '0':
+ /*
+ * ``Note that 0 is taken as a flag, not as the
+ * beginning of a field width.''
+ * -- ANSI X3J11
+ */
+ if (!(flags & LADJUST))
+ flags |= ZEROPAD; /* '-' disables '0' */
+ goto rflag;
+ case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ n = 0;
+ do {
+ n = 10 * n + to_digit(ch);
+ ch = *fmt++;
+ } while (is_digit(ch));
+ width = n;
+ goto reswitch;
+#ifdef FLOATING_POINT
+ case 'L':
+ flags |= LONGDBL;
+ goto rflag;
+#endif
+ case 'h':
+ flags |= SHORTINT;
+ goto rflag;
+ case 'l':
+ flags |= LONGINT;
+ goto rflag;
+ case 'c':
+ *(cp = buf) = va_arg(ap, int);
+ size = 1;
+ sign = '\0';
+ break;
+ case 'D':
+ flags |= LONGINT;
+ /*FALLTHROUGH*/
+ case 'd':
+ case 'i':
+ _ulong = SARG();
+ if ((long)_ulong < 0) {
+ _ulong = -_ulong;
+ sign = '-';
+ }
+ base = DEC;
+ goto number;
+#ifdef FLOATING_POINT
+ case 'e':
+ case 'E':
+ case 'f':
+ case 'F':
+ case 'g':
+ case 'G':
+ _double = va_arg(ap, double);
+#ifdef _IO_USE_DTOA
+ {
+ int fmt_flags = 0;
+ int fill = ' ';
+ if (flags & ALT)
+ fmt_flags |= _IO_SHOWPOINT;
+ if (flags & LADJUST)
+ fmt_flags |= _IO_LEFT;
+ else if (flags & ZEROPAD)
+ fmt_flags |= _IO_INTERNAL, fill = '0';
+ n = _IO_outfloat(_double, fp, ch, width,
+ prec < 0 ? DEFPREC : prec,
+ fmt_flags, sign, fill);
+ if (n < 0)
+ goto error;
+ ret += n;
+ }
+ /* CHECK ERROR! */
+ continue;
+#else
+ /*
+ * don't do unrealistic precision; just pad it with
+ * zeroes later, so buffer size stays rational.
+ */
+ if (prec > MAXFRACT) {
+ if ((ch != 'g' && ch != 'G') || (flags&ALT))
+ fpprec = prec - MAXFRACT;
+ prec = MAXFRACT;
+ } else if (prec == -1)
+ prec = DEFPREC;
+ /* __cvt_double may have to round up before the
+ "start" of its buffer, i.e.
+ ``intf("%.2f", (double)9.999);'';
+ if the first character is still NUL, it did.
+ softsign avoids negative 0 if _double < 0 but
+ no significant digits will be shown. */
+ cp = buf;
+ *cp = '\0';
+ size = __cvt_double(_double, prec, flags, &softsign,
+ ch, cp, buf + sizeof(buf));
+ if (softsign)
+ sign = '-';
+ if (*cp == '\0')
+ cp++;
+ break;
+#endif
+#endif /* FLOATING_POINT */
+ case 'n':
+ if (flags & LONGINT)
+ *va_arg(ap, long *) = ret;
+ else if (flags & SHORTINT)
+ *va_arg(ap, short *) = ret;
+ else
+ *va_arg(ap, int *) = ret;
+ continue; /* no output */
+ case 'O':
+ flags |= LONGINT;
+ /*FALLTHROUGH*/
+ case 'o':
+ _ulong = UARG();
+ base = OCT;
+ goto nosign;
+ case 'p':
+ /*
+ * ``The argument shall be a pointer to void. The
+ * value of the pointer is converted to a sequence
+ * of printable characters, in an implementation-
+ * defined manner.''
+ * -- ANSI X3J11
+ */
+ /* NOSTRICT */
+ _ulong = (unsigned long)va_arg(ap, void *);
+ base = HEX;
+ flags |= HEXPREFIX;
+ ch = 'x';
+ goto nosign;
+ case 's':
+ if ((cp = va_arg(ap, char *)) == NULL)
+ cp = "(null)";
+ if (prec >= 0) {
+ /*
+ * can't use strlen; can only look for the
+ * NUL in the first `prec' characters, and
+ * strlen() will go further.
+ */
+ char *p = (char*)memchr(cp, 0, prec);
+
+ if (p != NULL) {
+ size = p - cp;
+ if (size > prec)
+ size = prec;
+ } else
+ size = prec;
+ } else
+ size = strlen(cp);
+ sign = '\0';
+ break;
+ case 'U':
+ flags |= LONGINT;
+ /*FALLTHROUGH*/
+ case 'u':
+ _ulong = UARG();
+ base = DEC;
+ goto nosign;
+ case 'X':
+ case 'x':
+ _ulong = UARG();
+ base = HEX;
+ /* leading 0x/X only if non-zero */
+ if (flags & ALT && _ulong != 0)
+ flags |= HEXPREFIX;
+
+ /* unsigned conversions */
+nosign: sign = '\0';
+ /*
+ * ``... diouXx conversions ... if a precision is
+ * specified, the 0 flag will be ignored.''
+ * -- ANSI X3J11
+ */
+number: if ((dprec = prec) >= 0)
+ flags &= ~ZEROPAD;
+
+ /*
+ * ``The result of converting a zero value with an
+ * explicit precision of zero is no characters.''
+ * -- ANSI X3J11
+ */
+ cp = buf + BUF;
+ if (_ulong != 0 || prec != 0) {
+ char *xdigs; /* digits for [xX] conversion */
+ /*
+ * unsigned mod is hard, and unsigned mod
+ * by a constant is easier than that by
+ * a variable; hence this switch.
+ */
+ switch (base) {
+ case OCT:
+ do {
+ *--cp = to_char(_ulong & 7);
+ _ulong >>= 3;
+ } while (_ulong);
+ /* handle octal leading 0 */
+ if (flags & ALT && *cp != '0')
+ *--cp = '0';
+ break;
+
+ case DEC:
+ /* many numbers are 1 digit */
+ while (_ulong >= 10) {
+ *--cp = to_char(_ulong % 10);
+ _ulong /= 10;
+ }
+ *--cp = to_char(_ulong);
+ break;
+
+ case HEX:
+ if (ch == 'X')
+ xdigs = "0123456789ABCDEF";
+ else /* ch == 'x' || ch == 'p' */
+ xdigs = "0123456789abcdef";
+ do {
+ *--cp = xdigs[_ulong & 15];
+ _ulong >>= 4;
+ } while (_ulong);
+ break;
+
+ default:
+ cp = "bug in vform: bad base";
+ goto skipsize;
+ }
+ }
+ size = buf + BUF - cp;
+ skipsize:
+ break;
+ default: /* "%?" prints ?, unless ? is NUL */
+ if (ch == '\0')
+ goto done;
+ /* pretend it was %c with argument ch */
+ cp = buf;
+ *cp = ch;
+ size = 1;
+ sign = '\0';
+ break;
+ }
+
+ /*
+ * All reasonable formats wind up here. At this point,
+ * `cp' points to a string which (if not flags&LADJUST)
+ * should be padded out to `width' places. If
+ * flags&ZEROPAD, it should first be prefixed by any
+ * sign or other prefix; otherwise, it should be blank
+ * padded before the prefix is emitted. After any
+ * left-hand padding and prefixing, emit zeroes
+ * required by a decimal [diouxX] precision, then print
+ * the string proper, then emit zeroes required by any
+ * leftover floating precision; finally, if LADJUST,
+ * pad with blanks.
+ */
+
+ /*
+ * compute actual size, so we know how much to pad.
+ */
+#if defined(FLOATING_POINT) && !defined (_IO_USE_DTOA)
+ fieldsz = size + fpprec;
+#else
+ fieldsz = size;
+#endif
+ dpad = dprec - size;
+ if (dpad < 0)
+ dpad = 0;
+
+ if (sign)
+ fieldsz++;
+ else if (flags & HEXPREFIX)
+ fieldsz += 2;
+ fieldsz += dpad;
+
+ /* right-adjusting blank padding */
+ if ((flags & (LADJUST|ZEROPAD)) == 0)
+ PAD_SP(width - fieldsz);
+
+ /* prefix */
+ if (sign) {
+ PRINT(&sign, 1);
+ } else if (flags & HEXPREFIX) {
+ ox[0] = '0';
+ ox[1] = ch;
+ PRINT(ox, 2);
+ }
+
+ /* right-adjusting zero padding */
+ if ((flags & (LADJUST|ZEROPAD)) == ZEROPAD)
+ PAD_0(width - fieldsz);
+
+ /* leading zeroes from decimal precision */
+ PAD_0(dpad);
+
+ /* the string or number proper */
+ PRINT(cp, size);
+
+#if defined(FLOATING_POINT) && !defined (_IO_USE_DTOA)
+ /* trailing f.p. zeroes */
+ PAD_0(fpprec);
+#endif
+
+ /* left-adjusting padding (always blank) */
+ if (flags & LADJUST)
+ PAD_SP(width - fieldsz);
+
+ /* finally, adjust ret */
+ ret += width > fieldsz ? width : fieldsz;
+
+ }
+done:
+ return ret;
+error:
+ return EOF;
+ /* NOTREACHED */
+}
+
+#if defined(FLOATING_POINT) && !defined(_IO_USE_DTOA)
+
+static char *exponent(register char *p, register int exp, int fmtch)
+{
+ register char *t;
+ char expbuf[MAXEXP];
+
+ *p++ = fmtch;
+ if (exp < 0) {
+ exp = -exp;
+ *p++ = '-';
+ }
+ else
+ *p++ = '+';
+ t = expbuf + MAXEXP;
+ if (exp > 9) {
+ do {
+ *--t = to_char(exp % 10);
+ } while ((exp /= 10) > 9);
+ *--t = to_char(exp);
+ for (; t < expbuf + MAXEXP; *p++ = *t++);
+ }
+ else {
+ *p++ = '0';
+ *p++ = to_char(exp);
+ }
+ return (p);
+}
+
+static char * round(double fract, int *exp,
+ register char *start, register char *end,
+ char ch, int *signp)
+{
+ double tmp;
+
+ if (fract)
+ (void)modf(fract * 10, &tmp);
+ else
+ tmp = to_digit(ch);
+ if (tmp > 4)
+ for (;; --end) {
+ if (*end == '.')
+ --end;
+ if (++*end <= '9')
+ break;
+ *end = '0';
+ if (end == start) {
+ if (exp) { /* e/E; increment exponent */
+ *end = '1';
+ ++*exp;
+ }
+ else { /* f; add extra digit */
+ *--end = '1';
+ --start;
+ }
+ break;
+ }
+ }
+ /* ``"%.3f", (double)-0.0004'' gives you a negative 0. */
+ else if (*signp == '-')
+ for (;; --end) {
+ if (*end == '.')
+ --end;
+ if (*end != '0')
+ break;
+ if (end == start)
+ *signp = 0;
+ }
+ return (start);
+}
+
+int __cvt_double(double number, register int prec, int flags, int *signp,
+ int fmtch, char *startp, char *endp)
+{
+ register char *p, *t;
+ register double fract;
+ int dotrim = 0, expcnt, gformat = 0;
+ double integer, tmp;
+
+ expcnt = 0;
+ if (number < 0) {
+ number = -number;
+ *signp = '-';
+ } else
+ *signp = 0;
+
+ fract = modf(number, &integer);
+
+ /* get an extra slot for rounding. */
+ t = ++startp;
+
+ /*
+ * get integer portion of number; put into the end of the buffer; the
+ * .01 is added for modf(356.0 / 10, &integer) returning .59999999...
+ */
+ for (p = endp - 1; p >= startp && integer; ++expcnt) {
+ tmp = modf(integer / 10, &integer);
+ *p-- = to_char((int)((tmp + .01) * 10));
+ }
+ switch (fmtch) {
+ case 'f':
+ case 'F':
+ /* reverse integer into beginning of buffer */
+ if (expcnt)
+ for (; ++p < endp; *t++ = *p);
+ else
+ *t++ = '0';
+ /*
+ * if precision required or alternate flag set, add in a
+ * decimal point.
+ */
+ if (prec || flags&ALT)
+ *t++ = '.';
+ /* if requires more precision and some fraction left */
+ if (fract) {
+ if (prec)
+ do {
+ fract = modf(fract * 10, &tmp);
+ *t++ = to_char((int)tmp);
+ } while (--prec && fract);
+ if (fract)
+ startp = round(fract, (int *)NULL, startp,
+ t - 1, (char)0, signp);
+ }
+ for (; prec--; *t++ = '0');
+ break;
+ case 'e':
+ case 'E':
+eformat: if (expcnt) {
+ *t++ = *++p;
+ if (prec || flags&ALT)
+ *t++ = '.';
+ /* if requires more precision and some integer left */
+ for (; prec && ++p < endp; --prec)
+ *t++ = *p;
+ /*
+ * if done precision and more of the integer component,
+ * round using it; adjust fract so we don't re-round
+ * later.
+ */
+ if (!prec && ++p < endp) {
+ fract = 0;
+ startp = round((double)0, &expcnt, startp,
+ t - 1, *p, signp);
+ }
+ /* adjust expcnt for digit in front of decimal */
+ --expcnt;
+ }
+ /* until first fractional digit, decrement exponent */
+ else if (fract) {
+ /* adjust expcnt for digit in front of decimal */
+ for (expcnt = -1;; --expcnt) {
+ fract = modf(fract * 10, &tmp);
+ if (tmp)
+ break;
+ }
+ *t++ = to_char((int)tmp);
+ if (prec || flags&ALT)
+ *t++ = '.';
+ }
+ else {
+ *t++ = '0';
+ if (prec || flags&ALT)
+ *t++ = '.';
+ }
+ /* if requires more precision and some fraction left */
+ if (fract) {
+ if (prec)
+ do {
+ fract = modf(fract * 10, &tmp);
+ *t++ = to_char((int)tmp);
+ } while (--prec && fract);
+ if (fract)
+ startp = round(fract, &expcnt, startp,
+ t - 1, (char)0, signp);
+ }
+ /* if requires more precision */
+ for (; prec--; *t++ = '0');
+
+ /* unless alternate flag, trim any g/G format trailing 0's */
+ if (gformat && !(flags&ALT)) {
+ while (t > startp && *--t == '0');
+ if (*t == '.')
+ --t;
+ ++t;
+ }
+ t = exponent(t, expcnt, fmtch);
+ break;
+ case 'g':
+ case 'G':
+ /* a precision of 0 is treated as a precision of 1. */
+ if (!prec)
+ ++prec;
+ /*
+ * ``The style used depends on the value converted; style e
+ * will be used only if the exponent resulting from the
+ * conversion is less than -4 or greater than the precision.''
+ * -- ANSI X3J11
+ */
+ if (expcnt > prec || (!expcnt && fract && fract < .0001)) {
+ /*
+ * g/G format counts "significant digits, not digits of
+ * precision; for the e/E format, this just causes an
+ * off-by-one problem, i.e. g/G considers the digit
+ * before the decimal point significant and e/E doesn't
+ * count it as precision.
+ */
+ --prec;
+ fmtch -= 2; /* G->E, g->e */
+ gformat = 1;
+ goto eformat;
+ }
+ /*
+ * reverse integer into beginning of buffer,
+ * note, decrement precision
+ */
+ if (expcnt)
+ for (; ++p < endp; *t++ = *p, --prec);
+ else
+ *t++ = '0';
+ /*
+ * if precision required or alternate flag set, add in a
+ * decimal point. If no digits yet, add in leading 0.
+ */
+ if (prec || flags&ALT) {
+ dotrim = 1;
+ *t++ = '.';
+ }
+ else
+ dotrim = 0;
+ /* if requires more precision and some fraction left */
+ if (fract) {
+ if (prec) {
+ /* If no integer part, don't count initial
+ * zeros as significant digits. */
+ do {
+ fract = modf(fract * 10, &tmp);
+ *t++ = to_char((int)tmp);
+ } while(!tmp && !expcnt);
+ while (--prec && fract) {
+ fract = modf(fract * 10, &tmp);
+ *t++ = to_char((int)tmp);
+ }
+ }
+ if (fract)
+ startp = round(fract, (int *)NULL, startp,
+ t - 1, (char)0, signp);
+ }
+ /* alternate format, adds 0's for precision, else trim 0's */
+ if (flags&ALT)
+ for (; prec--; *t++ = '0');
+ else if (dotrim) {
+ while (t > startp && *--t == '0');
+ if (*t != '.')
+ ++t;
+ }
+ }
+ return (t - startp);
+}
+
+#endif /* defined(FLOATING_POINT) && !defined(_IO_USE_DTOA) */
diff --git a/libio/iovfscanf.c b/libio/iovfscanf.c
new file mode 100644
index 00000000000..1220e0750b7
--- /dev/null
+++ b/libio/iovfscanf.c
@@ -0,0 +1,787 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/*
+ * Copyright (c) 1990 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that the above copyright notice and this paragraph are
+ * duplicated in all such forms and that any documentation,
+ * advertising materials, and other materials related to such
+ * distribution and use acknowledge that the software was developed
+ * by the University of California, Berkeley. The name of the
+ * University may not be used to endorse or promote products derived
+ * from this software without specific prior written permission.
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ */
+
+/* Extensively hacked for GNU iostream by Per Bothner 1991, 1992, 1993.
+ Changes copyright Free Software Foundation 1992, 1993. */
+
+#if defined(LIBC_SCCS) && !defined(lint)
+static char sccsid[] = "%W% (Berkeley) %G%";
+#endif /* LIBC_SCCS and not lint */
+
+#include <libioP.h>
+#include <ctype.h>
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+#ifndef NO_FLOATING_POINT
+#define FLOATING_POINT
+#endif
+
+#ifdef FLOATING_POINT
+#include "floatio.h"
+#define BUF (MAXEXP+MAXFRACT+3) /* 3 = sign + decimal point + NUL */
+#else
+#define BUF 40
+#endif
+
+/*
+ * Flags used during conversion.
+ */
+#define LONG 0x01 /* l: long or double */
+#define LONGDBL 0x02 /* L: long double; unimplemented */
+#define SHORT 0x04 /* h: short */
+#define SUPPRESS 0x08 /* suppress assignment */
+#define POINTER 0x10 /* weird %p pointer (`fake hex') */
+#define NOSKIP 0x20 /* do not skip blanks */
+#define WIDTH 0x40 /* width */
+
+/*
+ * The following are used in numeric conversions only:
+ * SIGNOK, NDIGITS, DPTOK, and EXPOK are for floating point;
+ * SIGNOK, NDIGITS, PFXOK, and NZDIGITS are for integral.
+ */
+#define SIGNOK 0x40 /* +/- is (still) legal */
+#define NDIGITS 0x80 /* no digits detected */
+
+#define DPTOK 0x100 /* (float) decimal point is still legal */
+#define EXPOK 0x200 /* (float) exponent (e+3, etc) still legal */
+
+#define PFXOK 0x100 /* 0x prefix is (still) legal */
+#define NZDIGITS 0x200 /* no zero digits detected */
+
+/*
+ * Conversion types.
+ */
+#define CT_CHAR 0 /* %c conversion */
+#define CT_CCL 1 /* %[...] conversion */
+#define CT_STRING 2 /* %s conversion */
+#define CT_INT 3 /* integer, i.e., strtol or strtoul */
+#define CT_FLOAT 4 /* floating, i.e., strtod */
+
+#define u_char unsigned char
+#define u_long unsigned long
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern u_long strtoul __P((const char*, char**, int));
+extern long strtol __P((const char*, char**, int));
+static const u_char *__sccl __P((char *tab, const u_char *fmt));
+#ifndef _IO_USE_DTOA
+extern double atof();
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+/* If errp != NULL, *errp|=1 if we see a premature EOF;
+ *errp|=2 if we an invalid character. */
+
+int
+DEFUN(_IO_vfscanf, (fp, fmt0, ap, errp),
+ register _IO_FILE *fp AND char const *fmt0
+ AND _IO_va_list ap AND int *errp)
+{
+ register const u_char *fmt = (const u_char *)fmt0;
+ register int c; /* character from format, or conversion */
+ register _IO_ssize_t width; /* field width, or 0 */
+ register char *p; /* points into all kinds of strings */
+ register int n; /* handy integer */
+ register int flags = 0; /* flags as defined above */
+ register char *p0; /* saves original value of p when necessary */
+ int nassigned; /* number of fields assigned */
+ int nread; /* number of characters consumed from fp */
+ /* Assignments to base and ccfn are just to suppress warnings from gcc.*/
+ int base = 0; /* base argument to strtol/strtoul */
+ typedef u_long (*strtoulfn) __P((const char*, char**, int));
+ strtoulfn ccfn = 0;
+ /* conversion function (strtol/strtoul) */
+ char ccltab[256]; /* character class table for %[...] */
+ char buf[BUF]; /* buffer for numeric conversions */
+ int seen_eof = 0;
+
+ /* `basefix' is used to avoid `if' tests in the integer scanner */
+ static short basefix[17] =
+ { 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16 };
+
+ nassigned = 0;
+ nread = 0;
+ for (;;) {
+ c = *fmt++;
+ if (c == 0)
+ goto done;
+ if (isspace(c)) {
+ for (;;) {
+ c = _IO_getc(fp);
+ if (c == EOF) {
+ seen_eof++;
+ break;
+ }
+ if (!isspace(c)) {
+ _IO_ungetc (c, fp);
+ break;
+ }
+ nread++;
+ }
+ continue;
+ }
+ if (c != '%')
+ goto literal;
+ width = 0;
+ flags = 0;
+ /*
+ * switch on the format. continue if done;
+ * break once format type is derived.
+ */
+again: c = *fmt++;
+ switch (c) {
+ case '%':
+literal:
+ n = _IO_getc(fp);
+ if (n == EOF)
+ goto eof_failure;
+ if (n != c) {
+ _IO_ungetc (n, fp);
+ goto match_failure;
+ }
+ nread++;
+ continue;
+
+ case '*':
+ if (flags) goto control_failure;
+ flags = SUPPRESS;
+ goto again;
+ case 'l':
+ if (flags & ~(SUPPRESS | WIDTH)) goto control_failure;
+ flags |= LONG;
+ goto again;
+ case 'L':
+ if (flags & ~(SUPPRESS | WIDTH)) goto control_failure;
+ flags |= LONGDBL;
+ goto again;
+ case 'h':
+ if (flags & ~(SUPPRESS | WIDTH)) goto control_failure;
+ flags |= SHORT;
+ goto again;
+
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ if (flags & ~(SUPPRESS | WIDTH)) goto control_failure;
+ flags |= WIDTH;
+ width = width * 10 + c - '0';
+ goto again;
+
+ /*
+ * Conversions.
+ * Those marked `compat' are for 4.[123]BSD compatibility.
+ *
+ * (According to ANSI, E and X formats are supposed
+ * to the same as e and x. Sorry about that.)
+ */
+ case 'D': /* compat */
+ flags |= LONG;
+ /* FALLTHROUGH */
+ case 'd':
+ c = CT_INT;
+ ccfn = (strtoulfn)strtol;
+ base = 10;
+ break;
+
+ case 'i':
+ c = CT_INT;
+ ccfn = (strtoulfn)strtol;
+ base = 0;
+ break;
+
+ case 'O': /* compat */
+ flags |= LONG;
+ /* FALLTHROUGH */
+ case 'o':
+ c = CT_INT;
+ ccfn = strtoul;
+ base = 8;
+ break;
+
+ case 'u':
+ c = CT_INT;
+ ccfn = strtoul;
+ base = 10;
+ break;
+
+ case 'X':
+ case 'x':
+ flags |= PFXOK; /* enable 0x prefixing */
+ c = CT_INT;
+ ccfn = strtoul;
+ base = 16;
+ break;
+
+#ifdef FLOATING_POINT
+ case 'E': case 'F':
+ case 'e': case 'f': case 'g':
+ c = CT_FLOAT;
+ break;
+#endif
+
+ case 's':
+ c = CT_STRING;
+ break;
+
+ case '[':
+ fmt = __sccl(ccltab, fmt);
+ flags |= NOSKIP;
+ c = CT_CCL;
+ break;
+
+ case 'c':
+ flags |= NOSKIP;
+ c = CT_CHAR;
+ break;
+
+ case 'p': /* pointer format is like hex */
+ flags |= POINTER | PFXOK;
+ c = CT_INT;
+ ccfn = strtoul;
+ base = 16;
+ break;
+
+ case 'n':
+ if (flags & SUPPRESS) /* ??? */
+ continue;
+ if (flags & SHORT)
+ *va_arg(ap, short *) = nread;
+ else if (flags & LONG)
+ *va_arg(ap, long *) = nread;
+ else
+ *va_arg(ap, int *) = nread;
+ continue;
+
+ /*
+ * Disgusting backwards compatibility hacks. XXX
+ */
+ case '\0': /* compat */
+ nassigned = EOF;
+ goto done;
+
+ default: /* compat */
+ if (isupper(c))
+ flags |= LONG;
+ c = CT_INT;
+ ccfn = (strtoulfn)strtol;
+ base = 10;
+ break;
+ }
+
+ /*
+ * We have a conversion that requires input.
+ */
+ if (_IO_peekc(fp) == EOF)
+ goto eof_failure;
+
+ /*
+ * Consume leading white space, except for formats
+ * that suppress this.
+ */
+ if ((flags & NOSKIP) == 0) {
+ n = (unsigned char)*fp->_IO_read_ptr;
+ while (isspace(n)) {
+ fp->_IO_read_ptr++;
+ nread++;
+ n = _IO_peekc(fp);
+ if (n == EOF)
+ goto eof_failure;
+ }
+ /* Note that there is at least one character in
+ the buffer, so conversions that do not set NOSKIP
+ can no longer result in an input failure. */
+ }
+
+ /*
+ * Do the conversion.
+ */
+ switch (c) {
+
+ case CT_CHAR:
+ /* scan arbitrary characters (sets NOSKIP) */
+ if (width == 0) /* FIXME! */
+ width = 1;
+ if (flags & SUPPRESS) {
+ _IO_size_t sum = 0;
+ for (;;) {
+ n = fp->_IO_read_end - fp->_IO_read_ptr;
+ if (n < (int)width) {
+ sum += n;
+ width -= n;
+ fp->_IO_read_ptr += n;
+ if (__underflow(fp) == EOF)
+ if (sum == 0)
+ goto eof_failure;
+ else {
+ seen_eof++;
+ break;
+ }
+ } else {
+ sum += width;
+ fp->_IO_read_ptr += width;
+ break;
+ }
+ }
+ nread += sum;
+ } else {
+ _IO_size_t r =
+
+ _IO_XSGETN (fp, (char*)va_arg(ap, char*), width);
+ if (r != width)
+ goto eof_failure;
+ nread += r;
+ nassigned++;
+ }
+ break;
+
+ case CT_CCL:
+ /* scan a (nonempty) character class (sets NOSKIP) */
+ if (width == 0)
+ width = ~0; /* `infinity' */
+ /* take only those things in the class */
+ if (flags & SUPPRESS) {
+ n = 0;
+ while (ccltab[(unsigned char)*fp->_IO_read_ptr]) {
+ n++, fp->_IO_read_ptr++;
+ if (--width == 0)
+ break;
+ if (_IO_peekc(fp) == EOF) {
+ if (n == 0)
+ goto eof_failure;
+ seen_eof++;
+ break;
+ }
+ }
+ if (n == 0)
+ goto match_failure;
+ } else {
+ p0 = p = va_arg(ap, char *);
+ while (ccltab[(unsigned char)*fp->_IO_read_ptr]) {
+ *p++ = *fp->_IO_read_ptr++;
+ if (--width == 0)
+ break;
+ if (_IO_peekc(fp) == EOF) {
+ if (p == p0)
+ goto eof_failure;
+ seen_eof++;
+ break;
+ }
+ }
+ n = p - p0;
+ if (n == 0)
+ goto match_failure;
+ *p = 0;
+ nassigned++;
+ }
+ nread += n;
+ break;
+
+ case CT_STRING:
+ /* like CCL, but zero-length string OK, & no NOSKIP */
+ if (width == 0)
+ width = ~0;
+ if (flags & SUPPRESS) {
+ n = 0;
+ while (!isspace((unsigned char)*fp->_IO_read_ptr)) {
+ n++, fp->_IO_read_ptr++;
+ if (--width == 0)
+ break;
+ if (_IO_peekc(fp) == EOF) {
+ seen_eof++;
+ break;
+ }
+ }
+ nread += n;
+ } else {
+ p0 = p = va_arg(ap, char *);
+ while (!isspace((unsigned char)*fp->_IO_read_ptr)) {
+ *p++ = *fp->_IO_read_ptr++;
+ if (--width == 0)
+ break;
+ if (_IO_peekc(fp) == EOF) {
+ seen_eof++;
+ break;
+ }
+ }
+ *p = 0;
+ nread += p - p0;
+ nassigned++;
+ }
+ continue;
+
+ case CT_INT:
+ /* scan an integer as if by strtol/strtoul */
+ if (width == 0 || width > sizeof(buf) - 1)
+ width = sizeof(buf) - 1;
+ flags |= SIGNOK | NDIGITS | NZDIGITS;
+ for (p = buf; width; width--) {
+ c = (unsigned char)*fp->_IO_read_ptr;
+ /*
+ * Switch on the character; `goto ok'
+ * if we accept it as a part of number.
+ */
+ switch (c) {
+
+ /*
+ * The digit 0 is always legal, but is
+ * special. For %i conversions, if no
+ * digits (zero or nonzero) have been
+ * scanned (only signs), we will have
+ * base==0. In that case, we should set
+ * it to 8 and enable 0x prefixing.
+ * Also, if we have not scanned zero digits
+ * before this, do not turn off prefixing
+ * (someone else will turn it off if we
+ * have scanned any nonzero digits).
+ */
+ case '0':
+ if (base == 0) {
+ base = 8;
+ flags |= PFXOK;
+ }
+ if (flags & NZDIGITS)
+ flags &= ~(SIGNOK|NZDIGITS|NDIGITS);
+ else
+ flags &= ~(SIGNOK|PFXOK|NDIGITS);
+ goto ok;
+
+ /* 1 through 7 always legal */
+ case '1': case '2': case '3':
+ case '4': case '5': case '6': case '7':
+ base = basefix[base];
+ flags &= ~(SIGNOK | PFXOK | NDIGITS);
+ goto ok;
+
+ /* digits 8 and 9 ok iff decimal or hex */
+ case '8': case '9':
+ base = basefix[base];
+ if (base <= 8)
+ break; /* not legal here */
+ flags &= ~(SIGNOK | PFXOK | NDIGITS);
+ goto ok;
+
+ /* letters ok iff hex */
+ case 'A': case 'B': case 'C':
+ case 'D': case 'E': case 'F':
+ case 'a': case 'b': case 'c':
+ case 'd': case 'e': case 'f':
+ /* no need to fix base here */
+ if (base <= 10)
+ break; /* not legal here */
+ flags &= ~(SIGNOK | PFXOK | NDIGITS);
+ goto ok;
+
+ /* sign ok only as first character */
+ case '+': case '-':
+ if (flags & SIGNOK) {
+ flags &= ~SIGNOK;
+ goto ok;
+ }
+ break;
+
+ /* x ok iff flag still set & 2nd char */
+ case 'x': case 'X':
+ if (flags & PFXOK && p == buf + 1) {
+ base = 16; /* if %i */
+ flags &= ~PFXOK;
+ goto ok;
+ }
+ break;
+ }
+
+ /*
+ * If we got here, c is not a legal character
+ * for a number. Stop accumulating digits.
+ */
+ break;
+ ok:
+ /*
+ * c is legal: store it and look at the next.
+ */
+ *p++ = c;
+ fp->_IO_read_ptr++;
+ if (_IO_peekc(fp) == EOF) {
+ seen_eof++;
+ break; /* EOF */
+ }
+ }
+ /*
+ * If we had only a sign, it is no good; push
+ * back the sign. If the number ends in `x',
+ * it was [sign] '0' 'x', so push back the x
+ * and treat it as [sign] '0'.
+ */
+ if (flags & NDIGITS) {
+ if (p > buf)
+ (void) _IO_ungetc(*(u_char *)--p, fp);
+ goto match_failure;
+ }
+ c = ((u_char *)p)[-1];
+ if (c == 'x' || c == 'X') {
+ --p;
+ (void) _IO_ungetc (c, fp);
+ }
+ if ((flags & SUPPRESS) == 0) {
+ u_long res;
+
+ *p = 0;
+ res = (*ccfn)(buf, (char **)NULL, base);
+ if (flags & POINTER)
+ *va_arg(ap, void **) = (void *)res;
+ else if (flags & SHORT)
+ *va_arg(ap, short *) = res;
+ else if (flags & LONG)
+ *va_arg(ap, long *) = res;
+ else
+ *va_arg(ap, int *) = res;
+ nassigned++;
+ }
+ nread += p - buf;
+ break;
+
+#ifdef FLOATING_POINT
+ case CT_FLOAT:
+ /* scan a floating point number as if by strtod */
+ if (width == 0 || width > sizeof(buf) - 1)
+ width = sizeof(buf) - 1;
+ flags |= SIGNOK | NDIGITS | DPTOK | EXPOK;
+ for (p = buf; width; width--) {
+ c = (unsigned char)*fp->_IO_read_ptr;
+ /*
+ * This code mimicks the integer conversion
+ * code, but is much simpler.
+ */
+ switch (c) {
+
+ case '0': case '1': case '2': case '3':
+ case '4': case '5': case '6': case '7':
+ case '8': case '9':
+ flags &= ~(SIGNOK | NDIGITS);
+ goto fok;
+
+ case '+': case '-':
+ if (flags & SIGNOK) {
+ flags &= ~SIGNOK;
+ goto fok;
+ }
+ break;
+ case '.':
+ if (flags & DPTOK) {
+ flags &= ~(SIGNOK | DPTOK);
+ goto fok;
+ }
+ break;
+ case 'e': case 'E':
+ /* no exponent without some digits */
+ if ((flags&(NDIGITS|EXPOK)) == EXPOK) {
+ flags =
+ (flags & ~(EXPOK|DPTOK)) |
+ SIGNOK | NDIGITS;
+ goto fok;
+ }
+ break;
+ }
+ break;
+ fok:
+ *p++ = c;
+ fp->_IO_read_ptr++;
+ if (_IO_peekc(fp) == EOF) {
+ seen_eof++;
+ break; /* EOF */
+ }
+ }
+ /*
+ * If no digits, might be missing exponent digits
+ * (just give back the exponent) or might be missing
+ * regular digits, but had sign and/or decimal point.
+ */
+ if (flags & NDIGITS) {
+ if (flags & EXPOK) {
+ /* no digits at all */
+ while (p > buf)
+ _IO_ungetc (*(u_char *)--p, fp);
+ goto match_failure;
+ }
+ /* just a bad exponent (e and maybe sign) */
+ c = *(u_char *)--p;
+ if (c != 'e' && c != 'E') {
+ (void) _IO_ungetc (c, fp);/* sign */
+ c = *(u_char *)--p;
+ }
+ (void) _IO_ungetc (c, fp);
+ }
+ if ((flags & SUPPRESS) == 0) {
+ double res;
+ *p = 0;
+#ifdef _IO_USE_DTOA
+ res = _IO_strtod(buf, NULL);
+#else
+ res = atof(buf);
+#endif
+ if (flags & LONG)
+ *va_arg(ap, double *) = res;
+ else
+ *va_arg(ap, float *) = res;
+ nassigned++;
+ }
+ nread += p - buf;
+ break;
+#endif /* FLOATING_POINT */
+ }
+ }
+eof_failure:
+ seen_eof++;
+input_failure:
+ if (nassigned == 0)
+ nassigned = -1;
+control_failure:
+match_failure:
+ if (errp)
+ *errp |= 2;
+done:
+ if (errp && seen_eof)
+ *errp |= 1;
+ return (nassigned);
+}
+
+/*
+ * Fill in the given table from the scanset at the given format
+ * (just after `['). Return a pointer to the character past the
+ * closing `]'. The table has a 1 wherever characters should be
+ * considered part of the scanset.
+ */
+static const u_char *
+DEFUN(__sccl, (tab, fmt),
+ register char *tab AND register const u_char *fmt)
+{
+ register int c, n, v;
+
+ /* first `clear' the whole table */
+ c = *fmt++; /* first char hat => negated scanset */
+ if (c == '^') {
+ v = 1; /* default => accept */
+ c = *fmt++; /* get new first char */
+ } else
+ v = 0; /* default => reject */
+ /* should probably use memset here */
+ for (n = 0; n < 256; n++)
+ tab[n] = v;
+ if (c == 0)
+ return (fmt - 1);/* format ended before closing ] */
+
+ /*
+ * Now set the entries corresponding to the actual scanset
+ * to the opposite of the above.
+ *
+ * The first character may be ']' (or '-') without being special;
+ * the last character may be '-'.
+ */
+ v = 1 - v;
+ for (;;) {
+ tab[c] = v; /* take character c */
+doswitch:
+ n = *fmt++; /* and examine the next */
+ switch (n) {
+
+ case 0: /* format ended too soon */
+ return (fmt - 1);
+
+ case '-':
+ /*
+ * A scanset of the form
+ * [01+-]
+ * is defined as `the digit 0, the digit 1,
+ * the character +, the character -', but
+ * the effect of a scanset such as
+ * [a-zA-Z0-9]
+ * is implementation defined. The V7 Unix
+ * scanf treats `a-z' as `the letters a through
+ * z', but treats `a-a' as `the letter a, the
+ * character -, and the letter a'.
+ *
+ * For compatibility, the `-' is not considerd
+ * to define a range if the character following
+ * it is either a close bracket (required by ANSI)
+ * or is not numerically greater than the character
+ * we just stored in the table (c).
+ */
+ n = *fmt;
+ if (n == ']' || n < c) {
+ c = '-';
+ break; /* resume the for(;;) */
+ }
+ fmt++;
+ do { /* fill in the range */
+ tab[++c] = v;
+ } while (c < n);
+#if 1 /* XXX another disgusting compatibility hack */
+ /*
+ * Alas, the V7 Unix scanf also treats formats
+ * such as [a-c-e] as `the letters a through e'.
+ * This too is permitted by the standard....
+ */
+ goto doswitch;
+#else
+ c = *fmt++;
+ if (c == 0)
+ return (fmt - 1);
+ if (c == ']')
+ return (fmt);
+#endif
+ break;
+
+ case ']': /* end of scanset */
+ return (fmt);
+
+ default: /* just another character */
+ c = n;
+ break;
+ }
+ }
+ /* NOTREACHED */
+}
diff --git a/libio/iovsprintf.c b/libio/iovsprintf.c
new file mode 100644
index 00000000000..06d926d3590
--- /dev/null
+++ b/libio/iovsprintf.c
@@ -0,0 +1,40 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "strfile.h"
+
+int
+DEFUN(_IO_vsprintf, (string, format, args),
+ char *string AND const char *format AND _IO_va_list args)
+{
+ _IO_strfile sf;
+ int ret;
+ _IO_init((_IO_FILE*)&sf, 0);
+ _IO_JUMPS((_IO_FILE*)&sf) = &_IO_str_jumps;
+ _IO_str_init_static ((_IO_FILE*)&sf, string, -1, string);
+ ret = _IO_vfprintf((_IO_FILE*)&sf, format, args);
+ _IO_putc('\0', (_IO_FILE*)&sf);
+ return ret;
+}
diff --git a/libio/iovsscanf.c b/libio/iovsscanf.c
new file mode 100644
index 00000000000..529778098a5
--- /dev/null
+++ b/libio/iovsscanf.c
@@ -0,0 +1,37 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "strfile.h"
+
+int
+DEFUN(_IO_vsscanf, (string, format, args),
+ const char *string AND const char *format AND _IO_va_list args)
+{
+ _IO_strfile sf;
+ _IO_init((_IO_FILE*)&sf, 0);
+ _IO_JUMPS((_IO_FILE*)&sf) = &_IO_str_jumps;
+ _IO_str_init_static ((_IO_FILE*)&sf, (char*)string, 0, NULL);
+ return _IO_vfscanf((_IO_FILE*)&sf, format, args, NULL);
+}
diff --git a/libio/isgetline.cc b/libio/isgetline.cc
new file mode 100644
index 00000000000..add26638b20
--- /dev/null
+++ b/libio/isgetline.cc
@@ -0,0 +1,139 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <libioP.h>
+#include "iostream.h"
+#include <string.h>
+
+istream& istream::getline(char* buf, int len, char delim)
+{
+ _gcount = 0;
+ if (len <= 0)
+ {
+ set(ios::failbit);
+ return *this;
+ }
+ int ch;
+ if (ipfx1())
+ {
+ streambuf *sb = rdbuf();
+ _gcount = _IO_getline(sb, buf, len - 1, delim, -1);
+ ch = sb->sbumpc();
+ if (ch == EOF)
+ set (_gcount == 0 ? (ios::failbit|ios::eofbit) : ios::eofbit);
+ else if (ch != (unsigned char) delim)
+ {
+ set(ios::failbit);
+ sb->sungetc(); // Leave delimiter unread.
+ }
+ }
+ else
+ ch = EOF;
+ buf[_gcount] = '\0';
+ if (ch == (unsigned char)delim)
+ _gcount++; // The delimiter is counted in the gcount().
+ return *this;
+}
+
+istream& istream::get(char* buf, int len, char delim)
+{
+ _gcount = 0;
+ if (len <= 0)
+ {
+ set(ios::failbit);
+ return *this;
+ }
+ if (ipfx1())
+ {
+ streambuf *sbuf = rdbuf();
+ long count = _IO_getline(sbuf, buf, len - 1, delim, -1);
+ if (count == 0 && sbuf->sgetc() == EOF)
+ set(ios::failbit|ios::eofbit);
+ else
+ _gcount = count;
+ }
+ buf[_gcount] = '\0';
+ return *this;
+}
+
+
+// from Doug Schmidt
+
+#define CHUNK_SIZE 512
+
+/* Reads an arbitrarily long input line terminated by a user-specified
+ TERMINATOR. Super-nifty trick using recursion avoids unnecessary calls
+ to NEW! */
+
+char *_sb_readline (streambuf *sb, long& total, char terminator)
+{
+ char buf[CHUNK_SIZE];
+ char *ptr;
+ int ch;
+
+ _IO_size_t count = _IO_getline(sb, buf, CHUNK_SIZE, terminator, -1);
+ ch = sb->sbumpc();
+ long old_total = total;
+ total += count;
+ if (ch != EOF && ch != terminator) {
+ total++; // Include ch in total.
+ ptr = _sb_readline(sb, total, terminator);
+ if (ptr) {
+ memcpy(ptr + old_total, buf, count);
+ ptr[old_total+count] = ch;
+ }
+ return ptr;
+ }
+
+ ptr = new char[total+1];
+ if (ptr != NULL) {
+ ptr[total] = '\0';
+ memcpy(ptr + total - count, buf, count);
+ }
+ return ptr;
+}
+
+/* Reads an arbitrarily long input line terminated by TERMINATOR.
+ This routine allocates its own memory, so the user should
+ only supply the address of a (char *). */
+
+istream& istream::gets(char **s, char delim /* = '\n' */)
+{
+ if (ipfx1()) {
+ long size = 0;
+ streambuf *sb = rdbuf();
+ *s = _sb_readline (sb, size, delim);
+ _gcount = *s ? size : 0;
+ if (sb->_flags & _IO_EOF_SEEN) {
+ set(ios::eofbit);
+ if (_gcount == 0)
+ set(ios::failbit);
+ }
+ }
+ else {
+ _gcount = 0;
+ *s = NULL;
+ }
+ return *this;
+}
diff --git a/libio/isgetsb.cc b/libio/isgetsb.cc
new file mode 100644
index 00000000000..55617e649a0
--- /dev/null
+++ b/libio/isgetsb.cc
@@ -0,0 +1,59 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "iostream.h"
+#include <string.h>
+
+istream& istream::get(streambuf& sb, char delim /* = '\n' */)
+{
+ _gcount = 0;
+ if (ipfx1())
+ {
+ register streambuf* isb = rdbuf();
+ for (;;)
+ {
+ streamsize len = isb->_IO_read_end - isb->_IO_read_ptr;
+ if (len <= 0)
+ if (__underflow(isb) == EOF)
+ break;
+ else
+ len = isb->_IO_read_end - isb->_IO_read_ptr;
+ char *delimp = (char*)memchr((void*)isb->_IO_read_ptr, delim, len);
+ if (delimp != NULL)
+ len = delimp - isb->_IO_read_ptr;
+ int written = sb.sputn(isb->_IO_read_ptr, len);
+ isb->_IO_read_ptr += written;
+ _gcount += written;
+ if (written != len)
+ {
+ set(ios::failbit);
+ break;
+ }
+ if (delimp != NULL)
+ break;
+ }
+ }
+ return *this;
+}
diff --git a/libio/isscan.cc b/libio/isscan.cc
new file mode 100644
index 00000000000..64d4bc682f8
--- /dev/null
+++ b/libio/isscan.cc
@@ -0,0 +1,45 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include <iostream.h>
+#include <stdarg.h>
+
+istream& istream::scan(const char *format ...)
+{
+ if (ipfx0()) {
+ va_list ap;
+ va_start(ap, format);
+ _strbuf->vscan(format, ap, this);
+ va_end(ap);
+ }
+ return *this;
+}
+
+istream& istream::vscan(const char *format, _IO_va_list args)
+{
+ if (ipfx0())
+ _strbuf->vscan(format, args, this);
+ return *this;
+}
diff --git a/libio/istream.h b/libio/istream.h
new file mode 100644
index 00000000000..f54ec1de9a1
--- /dev/null
+++ b/libio/istream.h
@@ -0,0 +1,25 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <stream.h>
diff --git a/libio/libio.h b/libio/libio.h
new file mode 100644
index 00000000000..c7aea0a6c24
--- /dev/null
+++ b/libio/libio.h
@@ -0,0 +1,267 @@
+/*
+Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* This is part of the iostream library. Written by Per Bothner. */
+
+#ifndef _IO_STDIO_H
+#define _IO_STDIO_H
+
+#include <_G_config.h>
+#define _IO_pos_t _G_fpos_t /* obsolete */
+#define _IO_fpos_t _G_fpos_t
+#define _IO_size_t _G_size_t
+#define _IO_ssize_t _G_ssize_t
+#define _IO_off_t _G_off_t
+#define _IO_pid_t _G_pid_t
+#define _IO_uid_t _G_uid_t
+#define _IO_HAVE_SYS_WAIT _G_HAVE_SYS_WAIT
+#define _IO_HAVE_ST_BLKSIZE _G_HAVE_ST_BLKSIZE
+#define _IO_BUFSIZ _G_BUFSIZ
+#define _IO_va_list _G_va_list
+
+#ifdef _G_NEED_STDARG_H
+/* This define avoids name pollution if we're using GNU stdarg.h */
+#define __need___va_list
+#include <stdarg.h>
+#ifdef __GNUC_VA_LIST
+#undef _IO_va_list
+#define _IO_va_list __gnuc_va_list
+#endif /* __GNUC_VA_LIST */
+#endif
+
+#ifndef __P
+#if _G_HAVE_SYS_CDEFS
+#include <sys/cdefs.h>
+#else
+#ifdef __STDC__
+#define __P(protos) protos
+#else
+#define __P(protos) ()
+#endif
+#endif
+#endif /*!__P*/
+
+/* For backward compatibility */
+#ifndef _PARAMS
+#define _PARAMS(protos) __P(protos)
+#endif /*!_PARAMS*/
+
+#ifndef __STDC__
+#define const
+#endif
+#ifndef _G_NO_USE_DTOA
+#define _IO_USE_DTOA
+#else
+#undef _IO_USE_DTOA
+#endif
+#define _IO_UNIFIED_JUMPTABLES 1
+
+#if 0
+#ifdef _IO_NEED_STDARG_H
+#include <stdarg.h>
+#endif
+#endif
+
+#ifndef EOF
+#define EOF (-1)
+#endif
+#ifndef NULL
+#ifdef __GNUG__
+#define NULL (__null)
+#else
+#if !defined(__cplusplus)
+#define NULL ((void*)0)
+#else
+#define NULL (0)
+#endif
+#endif
+#endif
+
+#define _IOS_INPUT 1
+#define _IOS_OUTPUT 2
+#define _IOS_ATEND 4
+#define _IOS_APPEND 8
+#define _IOS_TRUNC 16
+#define _IOS_NOCREATE 32
+#define _IOS_NOREPLACE 64
+#define _IOS_BIN 128
+
+/* Magic numbers and bits for the _flags field.
+ The magic numbers use the high-order bits of _flags;
+ the remaining bits are abailable for variable flags.
+ Note: The magic numbers must all be negative if stdio
+ emulation is desired. */
+
+#define _IO_MAGIC 0xFBAD0000 /* Magic number */
+#define _OLD_STDIO_MAGIC 0xFABC0000 /* Emulate old stdio. */
+#define _IO_MAGIC_MASK 0xFFFF0000
+#define _IO_USER_BUF 1 /* User owns buffer; don't delete it on close. */
+#define _IO_UNBUFFERED 2
+#define _IO_NO_READS 4 /* Reading not allowed */
+#define _IO_NO_WRITES 8 /* Writing not allowd */
+#define _IO_EOF_SEEN 0x10
+#define _IO_ERR_SEEN 0x20
+#define _IO_DELETE_DONT_CLOSE 0x40 /* Don't call close(_fileno) on cleanup. */
+#define _IO_LINKED 0x80 /* Set if linked (using _chain) to streambuf::_list_all.*/
+#define _IO_IN_BACKUP 0x100
+#define _IO_LINE_BUF 0x200
+#define _IO_TIED_PUT_GET 0x400 /* Set if put and get pointer logicly tied. */
+#define _IO_CURRENTLY_PUTTING 0x800
+#define _IO_IS_APPENDING 0x1000
+#define _IO_IS_FILEBUF 0x2000
+
+/* These are "formatting flags" matching the iostream fmtflags enum values. */
+#define _IO_SKIPWS 01
+#define _IO_LEFT 02
+#define _IO_RIGHT 04
+#define _IO_INTERNAL 010
+#define _IO_DEC 020
+#define _IO_OCT 040
+#define _IO_HEX 0100
+#define _IO_SHOWBASE 0200
+#define _IO_SHOWPOINT 0400
+#define _IO_UPPERCASE 01000
+#define _IO_SHOWPOS 02000
+#define _IO_SCIENTIFIC 04000
+#define _IO_FIXED 010000
+#define _IO_UNITBUF 020000
+#define _IO_STDIO 040000
+#define _IO_DONT_CLOSE 0100000
+
+/* A streammarker remembers a position in a buffer. */
+
+struct _IO_jump_t; struct _IO_FILE;
+
+struct _IO_marker {
+ struct _IO_marker *_next;
+ struct _IO_FILE *_sbuf;
+ /* If _pos >= 0
+ it points to _buf->Gbase()+_pos. FIXME comment */
+ /* if _pos < 0, it points to _buf->eBptr()+_pos. FIXME comment */
+ int _pos;
+#if 0
+ void set_streampos(streampos sp) { _spos = sp; }
+ void set_offset(int offset) { _pos = offset; _spos = (streampos)(-2); }
+ public:
+ streammarker(streambuf *sb);
+ ~streammarker();
+ int saving() { return _spos == -2; }
+ int delta(streammarker&);
+ int delta();
+#endif
+};
+
+struct _IO_FILE {
+#if _G_USE_INT32_FLAGS
+ _G_int32_t _flags; /* High-order word is _IO_MAGIC; rest is flags. */
+#else
+ int _flags;
+#endif
+#define _IO_file_flags _flags
+
+ /* The following pointers correspond to the C++ streambuf protocol. */
+ /* Note: Tk uses the _IO_read_ptr and _IO_read_end fields directly. */
+ char* _IO_read_ptr; /* Current read pointer */
+ char* _IO_read_end; /* End of get area. */
+ char* _IO_read_base; /* Start of putback+get area. */
+ char* _IO_write_base; /* Start of put area. */
+ char* _IO_write_ptr; /* Current put pointer. */
+ char* _IO_write_end; /* End of put area. */
+ char* _IO_buf_base; /* Start of reserve area. */
+ char* _IO_buf_end; /* End of reserve area. */
+ /* The following fields are used to support backing up and undo. */
+ char *_IO_save_base; /* Pointer to start of non-current get area. */
+ char *_IO_backup_base; /* Pointer to first valid character of backup area */
+ char *_IO_save_end; /* Pointer to end of non-current get area. */
+
+ struct _IO_marker *_markers;
+
+ struct _IO_FILE *_chain;
+
+ int _fileno;
+ int _blksize;
+ _IO_off_t _offset;
+
+#define __HAVE_COLUMN /* temporary */
+ /* 1+column number of pbase(); 0 is unknown. */
+ unsigned short _cur_column;
+ char _unused;
+ char _shortbuf[1];
+
+ /* char* _save_gptr; char* _save_egptr; */
+};
+
+#ifndef __cplusplus
+typedef struct _IO_FILE _IO_FILE;
+#endif
+
+struct _IO_FILE_plus;
+extern struct _IO_FILE_plus _IO_stdin_, _IO_stdout_, _IO_stderr_;
+#define _IO_stdin ((_IO_FILE*)(&_IO_stdin_))
+#define _IO_stdout ((_IO_FILE*)(&_IO_stdout_))
+#define _IO_stderr ((_IO_FILE*)(&_IO_stderr_))
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern int __underflow __P((_IO_FILE*));
+extern int __uflow __P((_IO_FILE*));
+extern int __overflow __P((_IO_FILE*, int));
+
+#define _IO_getc(_fp) \
+ ((_fp)->_IO_read_ptr >= (_fp)->_IO_read_end ? __uflow(_fp) \
+ : *(unsigned char*)(_fp)->_IO_read_ptr++)
+#define _IO_peekc(_fp) \
+ ((_fp)->_IO_read_ptr >= (_fp)->_IO_read_end \
+ && __underflow(_fp) == EOF ? EOF \
+ : *(unsigned char*)(_fp)->_IO_read_ptr)
+
+#define _IO_putc(_ch, _fp) \
+ (((_fp)->_IO_write_ptr >= (_fp)->_IO_write_end) \
+ ? __overflow(_fp, (unsigned char)(_ch)) \
+ : (unsigned char)(*(_fp)->_IO_write_ptr++ = (_ch)))
+
+#define _IO_feof(__fp) (((__fp)->_flags & _IO_EOF_SEEN) != 0)
+#define _IO_ferror(__fp) (((__fp)->_flags & _IO_ERR_SEEN) != 0)
+
+/* This one is for Emacs. */
+#define _IO_PENDING_OUTPUT_COUNT(_fp) \
+ ((_fp)->_IO_write_ptr - (_fp)->_IO_write_base)
+
+extern int _IO_vfscanf __P((_IO_FILE*, const char*, _IO_va_list, int*));
+extern int _IO_vfprintf __P((_IO_FILE*, const char*, _IO_va_list));
+extern _IO_ssize_t _IO_padn __P((_IO_FILE *, int, _IO_ssize_t));
+extern _IO_size_t _IO_sgetn __P((_IO_FILE *, void*, _IO_size_t));
+
+extern _IO_fpos_t _IO_seekoff __P((_IO_FILE*, _IO_off_t, int, int));
+extern _IO_fpos_t _IO_seekpos __P((_IO_FILE*, _IO_fpos_t, int));
+
+extern void _IO_free_backup_area __P((_IO_FILE*));
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _IO_STDIO_H */
diff --git a/libio/libioP.h b/libio/libioP.h
new file mode 100644
index 00000000000..7efc519aad5
--- /dev/null
+++ b/libio/libioP.h
@@ -0,0 +1,497 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+
+#include "iolibio.h"
+
+#if defined (__STDC__) || defined (_AIX) || (defined (__mips) && defined (_SYSTYPE_SVR4)) || defined(__cplusplus)
+/* All known AIX compilers implement these things (but don't always
+ define __STDC__). The RISC/OS MIPS compiler defines these things
+ in SVR4 mode, but does not define __STDC__. */
+
+#define AND ,
+#define DEFUN(name, arglist, args) name(args)
+#define DEFUN_VOID(name) name(void)
+
+#else /* Not ANSI C. */
+
+#define AND ;
+#ifndef const /* some systems define it in header files for non-ansi mode */
+#define const
+#endif
+#define DEFUN(name, arglist, args) name arglist args;
+#define DEFUN_VOID(name) name()
+#endif /* ANSI C. */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define _IO_seek_set 0
+#define _IO_seek_cur 1
+#define _IO_seek_end 2
+
+/* THE JUMPTABLE FUNCTIONS.
+
+ * The _IO_FILE type is used to implement the FILE type in GNU libc,
+ * as well as the streambuf class in GNU iostreams for C++.
+ * These are all the same, just used differently.
+ * An _IO_FILE (or FILE) object is allows followed by a pointer to
+ * a jump table (of pointers to functions). The pointer is accessed
+ * with the _IO_JUMPS macro. The jump table has a eccentric format,
+ * so as to be compatible with the layout of a C++ virtual function table.
+ * (as implemented by g++). When a pointer to a steambuf object is
+ * coerced to an (_IO_FILE*), then _IO_JUMPS on the result just
+ * happens to point to the virtual function table of the streambuf.
+ * Thus the _IO_JUMPS function table used for C stdio/libio does
+ * double duty as the virtual functiuon table for C++ streambuf.
+ *
+ * The entries in the _IO_JUMPS function table (and hence also the
+ * virtual functions of a streambuf) are described below.
+ * The first parameter of each function entry is the _IO_FILE/streambuf
+ * object being acted on (i.e. the 'this' parameter).
+ */
+
+#define _IO_JUMPS(THIS) ((struct _IO_FILE_plus*)(THIS))->vtable
+#ifdef _G_USING_THUNKS
+#define JUMP_FIELD(TYPE, NAME) TYPE NAME
+#define JUMP0(FUNC, THIS) _IO_JUMPS(THIS)->FUNC(THIS)
+#define JUMP1(FUNC, THIS, X1) _IO_JUMPS(THIS)->FUNC(THIS, X1)
+#define JUMP2(FUNC, THIS, X1, X2) _IO_JUMPS(THIS)->FUNC(THIS, X1, X2)
+#define JUMP3(FUNC, THIS, X1,X2,X3) _IO_JUMPS(THIS)->FUNC(THIS, X1,X2, X3)
+#define JUMP_INIT(NAME, VALUE) VALUE
+#define JUMP_INIT_DUMMY JUMP_INIT(dummy, 0), JUMP_INIT(dummy2, 0)
+#else
+/* These macros will change when we re-implement vtables to use "thunks"! */
+#define JUMP_FIELD(TYPE, NAME) struct { short delta1, delta2; TYPE pfn; } NAME
+#define JUMP0(FUNC, THIS) _IO_JUMPS(THIS)->FUNC.pfn(THIS)
+#define JUMP1(FUNC, THIS, X1) _IO_JUMPS(THIS)->FUNC.pfn(THIS, X1)
+#define JUMP2(FUNC, THIS, X1, X2) _IO_JUMPS(THIS)->FUNC.pfn(THIS, X1, X2)
+#define JUMP3(FUNC, THIS, X1,X2,X3) _IO_JUMPS(THIS)->FUNC.pfn(THIS, X1,X2, X3)
+#define JUMP_INIT(NAME, VALUE) {0, 0, VALUE}
+#define JUMP_INIT_DUMMY JUMP_INIT(dummy, 0)
+#endif
+
+/* The 'finish' function does any final cleaning up of an _IO_FILE object.
+ It does not delete (free) it, but does everything else to finalize it/
+ It matches the streambuf::~streambuf virtual destructor. */
+typedef void (*_IO_finish_t) __P((_IO_FILE*)); /* finalize */
+#define _IO_FINISH(FP) JUMP0(__finish, FP)
+
+/* The 'overflow' hook flushes the buffer.
+ The second argument is a character, or EOF.
+ It matches the streambuf::overflow virtual function. */
+typedef int (*_IO_overflow_t) __P((_IO_FILE*, int));
+#define _IO_OVERFLOW(FP, CH) JUMP1(__overflow, FP, CH)
+
+/* The 'underflow' hook tries to fills the get buffer.
+ It returns the next character (as an unsigned char) or EOF. The next
+ character remains in the get buffer, and the get postion is not changed.
+ It matches the streambuf::underflow virtual function. */
+typedef int (*_IO_underflow_t) __P((_IO_FILE*));
+#define _IO_UNDERFLOW(FP) JUMP0(__underflow, FP)
+
+/* The 'uflow' hook returns the next character in the input stream
+ (cast to unsigned char), and increments the read position;
+ EOF is returned on failure.
+ It matches the streambuf::uflow virtual function, which is not in the
+ cfront implementation, but was added to C++ by the ANSI/ISO committee. */
+#define _IO_UFLOW(FP) JUMP0(__uflow, FP)
+
+/* The 'pbackfail' hook handles backing up.
+ It matches the streambuf::pbackfail virtual function. */
+typedef int (*_IO_pbackfail_t) __P((_IO_FILE*, int));
+#define _IO_PBACKFAIL(FP, CH) JUMP1(__pbackfail, FP, CH)
+
+/* The 'xsputn' hook writes upto N characters from buffer DATA.
+ Returns the number of character actually written.
+ It matches the streambuf::xsputn virtual function. */
+typedef _IO_size_t (*_IO_xsputn_t)
+ __P((_IO_FILE *FP, const void *DATA, _IO_size_t N));
+#define _IO_XSPUTN(FP, DATA, N) JUMP2(__xsputn, FP, DATA, N)
+
+/* The 'xsgetn' hook reads upto N characters into buffer DATA.
+ Returns the number of character actually read.
+ It matches the streambuf::xsgetn virtual function. */
+typedef _IO_size_t (*_IO_xsgetn_t) __P((_IO_FILE*FP, void*DATA, _IO_size_t N));
+#define _IO_XSGETN(FP, DATA, N) JUMP2(__xsgetn, FP, DATA, N)
+
+/* The 'seekoff' hook moves the stream position to a new position
+ relative to the start of the file (if DIR==0), the current position
+ (MODE==1), or the end of the file (MODE==2).
+ It matches the streambuf::seekoff virtual function.
+ It is also used for the ANSI fseek function. */
+typedef _IO_fpos_t (*_IO_seekoff_t)
+ __P((_IO_FILE* FP, _IO_off_t OFF, int DIR, int MODE));
+#define _IO_SEEKOFF(FP, OFF, DIR, MODE) JUMP3(__seekoff, FP, OFF, DIR, MODE)
+
+/* The 'seekpos' hook also moves the stream position,
+ but to an absolute position given by a fpos_t (seekpos).
+ It matches the streambuf::seekpos virtual function.
+ It is also used for the ANSI fgetpos and fsetpos functions. */
+/* The _IO_seek_cur and _IO_seek_end options are not allowed. */
+typedef _IO_fpos_t (*_IO_seekpos_t) __P((_IO_FILE*, _IO_fpos_t, int));
+#define _IO_SEEKPOS(FP, POS, FLAGS) JUMP2(__seekpos, FP, POS, FLAGS)
+
+/* The 'setbuf' hook gives a buffer to the file.
+ It matches the streambuf::setbuf virtual function. */
+typedef _IO_FILE* (*_IO_setbuf_t) __P((_IO_FILE*, char *, _IO_ssize_t));
+#define _IO_SETBUF(FP, BUFFER, LENGTH) JUMP2(__setbuf, FP, BUFFER, LENGTH)
+
+/* The 'sync' hook attempts to synchronize the internal data structures
+ of the file with the external state.
+ It matches the streambuf::sync virtual function. */
+typedef int (*_IO_sync_t) __P((_IO_FILE*));
+#define _IO_SYNC(FP) JUMP0(__sync, FP)
+
+/* The 'doallocate' hook is used to tell the file to allocate a buffer.
+ It matches the streambuf::doallocate virtual function, which is not
+ in the ANSI/ISO C++ standard, but is part traditional implementations. */
+typedef int (*_IO_doallocate_t) __P((_IO_FILE*));
+#define _IO_DOALLOCATE(FP) JUMP0(__doallocate, FP)
+
+/* The following four hooks (sysread, syswrite, sysclose, sysseek, and
+ sysstat) are low-level hooks specific to this implementation.
+ There is no correspondance in the ANSI/ISO C++ standard library.
+ The hooks basically correspond to the Unix system functions
+ (read, write, close, lseek, and stat) except that a _IO_FILE*
+ parameter is used instead of a integer file descriptor; the default
+ implementation used for normal files just calls those functions.
+ The advantage of overriding these functions instead of the higher-level
+ ones (underflow, overflow etc) is that you can leave all the buffering
+ higher-level functions. */
+
+/* The 'sysread' hook is used to read data from the external file into
+ an existing buffer. It generalizes the Unix read(2) function.
+ It matches the streambuf::sys_read virtual function, which is
+ specific to this implementaion. */
+typedef _IO_ssize_t (*_IO_read_t) __P((_IO_FILE*, void*, _IO_ssize_t));
+#define _IO_SYSREAD(FP, DATA, LEN) JUMP2(__read, FP, DATA, LEN)
+
+/* The 'syswrite' hook is used to write data from an existing buffer
+ to an external file. It generalizes the Unix write(2) function.
+ It matches the streambuf::sys_write virtual function, which is
+ specific to this implementaion. */
+typedef _IO_ssize_t (*_IO_write_t) __P((_IO_FILE*,const void*,_IO_ssize_t));
+#define _IO_SYSWRITE(FP, DATA, LEN) JUMP2(__write, FP, DATA, LEN)
+
+/* The 'sysseek' hook is used to re-position an external file.
+ It generalizes the Unix lseek(2) function.
+ It matches the streambuf::sys_seek virtual function, which is
+ specific to this implementaion. */
+typedef _IO_fpos_t (*_IO_seek_t) __P((_IO_FILE*, _IO_off_t, int));
+#define _IO_SYSSEEK(FP, OFFSET, MODE) JUMP2(__seek, FP, OFFSET, MODE)
+
+/* The 'sysclose' hook is used to finalize (close, finish up) an
+ external file. It generalizes the Unix close(2) function.
+ It matches the streambuf::sys_close virtual function, which is
+ specific to this implementation. */
+typedef int (*_IO_close_t) __P((_IO_FILE*)); /* finalize */
+#define _IO_SYSCLOSE(FP) JUMP0(__close, FP)
+
+/* The 'sysstat' hook is used to get information about an external file
+ into a struct stat buffer. It generalizes the Unix fstat(2) call.
+ It matches the streambuf::sys_stat virtual function, which is
+ specific to this implementaion. */
+typedef int (*_IO_stat_t) __P((_IO_FILE*, void*));
+#define _IO_SYSSTAT(FP, BUF) JUMP1(__stat, FP, BUF)
+
+
+#define _IO_CHAR_TYPE char /* unsigned char ? */
+#define _IO_INT_TYPE int
+
+struct _IO_jump_t {
+ JUMP_FIELD(_G_size_t, __dummy);
+#ifdef _G_USING_THUNKS
+ JUMP_FIELD(_G_size_t, __dummy2);
+#endif
+ JUMP_FIELD(_IO_finish_t, __finish);
+ JUMP_FIELD(_IO_overflow_t, __overflow);
+ JUMP_FIELD(_IO_underflow_t, __underflow);
+ JUMP_FIELD(_IO_underflow_t, __uflow);
+ JUMP_FIELD(_IO_pbackfail_t, __pbackfail);
+ /* showmany */
+ JUMP_FIELD(_IO_xsputn_t, __xsputn);
+ JUMP_FIELD(_IO_xsgetn_t, __xsgetn);
+ JUMP_FIELD(_IO_seekoff_t, __seekoff);
+ JUMP_FIELD(_IO_seekpos_t, __seekpos);
+ JUMP_FIELD(_IO_setbuf_t, __setbuf);
+ JUMP_FIELD(_IO_sync_t, __sync);
+ JUMP_FIELD(_IO_doallocate_t, __doallocate);
+ JUMP_FIELD(_IO_read_t, __read);
+ JUMP_FIELD(_IO_write_t, __write);
+ JUMP_FIELD(_IO_seek_t, __seek);
+ JUMP_FIELD(_IO_close_t, __close);
+ JUMP_FIELD(_IO_stat_t, __stat);
+#if 0
+ get_column;
+ set_column;
+#endif
+};
+
+/* We always allocate an extra word following an _IO_FILE.
+ This contains a pointer to the function jump table used.
+ This is for compatibility with C++ streambuf; the word can
+ be used to smash to a pointer to a virtual function table. */
+
+struct _IO_FILE_plus {
+ _IO_FILE file;
+ const struct _IO_jump_t *vtable;
+};
+
+/* Generic functions */
+
+extern int _IO_switch_to_get_mode __P((_IO_FILE*));
+extern void _IO_init __P((_IO_FILE*, int));
+extern int _IO_sputbackc __P((_IO_FILE*, int));
+extern int _IO_sungetc __P((_IO_FILE*));
+extern void _IO_un_link __P((_IO_FILE*));
+extern void _IO_link_in __P((_IO_FILE *));
+extern void _IO_doallocbuf __P((_IO_FILE*));
+extern void _IO_unsave_markers __P((_IO_FILE*));
+extern void _IO_setb __P((_IO_FILE*, char*, char*, int));
+extern unsigned _IO_adjust_column __P((unsigned, const char *, int));
+#define _IO_sputn(__fp, __s, __n) _IO_XSPUTN(__fp, __s, __n)
+
+/* Marker-related function. */
+
+extern void _IO_init_marker __P((struct _IO_marker *, _IO_FILE *));
+extern void _IO_remove_marker __P((struct _IO_marker*));
+extern int _IO_marker_difference __P((struct _IO_marker *, struct _IO_marker *));
+extern int _IO_marker_delta __P((struct _IO_marker *));
+extern int _IO_seekmark __P((_IO_FILE *, struct _IO_marker *, int));
+
+/* Default jumptable functions. */
+
+extern int _IO_default_underflow __P((_IO_FILE*));
+extern int _IO_default_uflow __P((_IO_FILE*));
+extern int _IO_default_doallocate __P((_IO_FILE*));
+extern void _IO_default_finish __P((_IO_FILE *));
+extern int _IO_default_pbackfail __P((_IO_FILE*, int));
+extern _IO_FILE* _IO_default_setbuf __P((_IO_FILE *, char*, _IO_ssize_t));
+extern _IO_size_t _IO_default_xsputn __P((_IO_FILE *, const void*, _IO_size_t));
+extern _IO_size_t _IO_default_xsgetn __P((_IO_FILE *, void*, _IO_size_t));
+extern _IO_fpos_t _IO_default_seekoff __P((_IO_FILE*, _IO_off_t, int, int));
+extern _IO_fpos_t _IO_default_seekpos __P((_IO_FILE*, _IO_fpos_t, int));
+extern _IO_ssize_t _IO_default_write __P((_IO_FILE*,const void*,_IO_ssize_t));
+extern _IO_ssize_t _IO_default_read __P((_IO_FILE*, void*, _IO_ssize_t));
+extern int _IO_default_stat __P((_IO_FILE*, void*));
+extern _IO_fpos_t _IO_default_seek __P((_IO_FILE*, _IO_off_t, int));
+extern int _IO_default_sync __P((_IO_FILE*));
+#define _IO_default_close ((_IO_close_t)_IO_default_sync)
+
+extern struct _IO_jump_t _IO_file_jumps;
+extern struct _IO_jump_t _IO_streambuf_jumps;
+extern struct _IO_jump_t _IO_proc_jumps;
+extern struct _IO_jump_t _IO_str_jumps;
+extern int _IO_do_write __P((_IO_FILE*, const char*, _IO_size_t));
+extern int _IO_flush_all __P((void));
+extern void _IO_cleanup __P((void));
+extern void _IO_flush_all_linebuffered __P((void));
+
+#define _IO_do_flush(_f) \
+ _IO_do_write(_f, (_f)->_IO_write_base, \
+ (_f)->_IO_write_ptr-(_f)->_IO_write_base)
+#define _IO_in_put_mode(_fp) ((_fp)->_flags & _IO_CURRENTLY_PUTTING)
+#define _IO_mask_flags(fp, f, mask) \
+ ((fp)->_flags = ((fp)->_flags & ~(mask)) | ((f) & (mask)))
+#define _IO_setg(fp, eb, g, eg) ((fp)->_IO_read_base = (eb),\
+ (fp)->_IO_read_ptr = (g), (fp)->_IO_read_end = (eg))
+#define _IO_setp(__fp, __p, __ep) \
+ ((__fp)->_IO_write_base = (__fp)->_IO_write_ptr = __p, (__fp)->_IO_write_end = (__ep))
+#define _IO_have_backup(fp) ((fp)->_IO_save_base != NULL)
+#define _IO_in_backup(fp) ((fp)->_flags & _IO_IN_BACKUP)
+#define _IO_have_markers(fp) ((fp)->_markers != NULL)
+#define _IO_blen(fp) ((fp)->_IO_buf_end - (fp)->_IO_buf_base)
+
+/* Jumptable functions for files. */
+
+extern int _IO_file_doallocate __P((_IO_FILE*));
+extern _IO_FILE* _IO_file_setbuf __P((_IO_FILE *, char*, _IO_ssize_t));
+extern _IO_fpos_t _IO_file_seekoff __P((_IO_FILE*, _IO_off_t, int, int));
+extern _IO_size_t _IO_file_xsputn __P((_IO_FILE*,const void*,_IO_size_t));
+extern int _IO_file_stat __P((_IO_FILE*, void*));
+extern int _IO_file_close __P((_IO_FILE*));
+extern int _IO_file_underflow __P((_IO_FILE *));
+extern int _IO_file_overflow __P((_IO_FILE *, int));
+#define _IO_file_is_open(__fp) ((__fp)->_fileno >= 0)
+extern void _IO_file_init __P((_IO_FILE*));
+extern _IO_FILE* _IO_file_fopen __P((_IO_FILE*, const char*, const char*));
+extern _IO_ssize_t _IO_file_write __P((_IO_FILE*,const void*,_IO_ssize_t));
+extern _IO_ssize_t _IO_file_read __P((_IO_FILE*, void*, _IO_ssize_t));
+extern int _IO_file_sync __P((_IO_FILE*));
+extern int _IO_file_close_it __P((_IO_FILE*));
+extern _IO_fpos_t _IO_file_seek __P((_IO_FILE *, _IO_off_t, int));
+extern void _IO_file_finish __P((_IO_FILE*));
+
+/* Other file functions. */
+extern _IO_FILE* _IO_file_attach __P((_IO_FILE *, int));
+
+/* Jumptable functions for proc_files. */
+extern _IO_FILE* _IO_proc_open __P((_IO_FILE*, const char*, const char *));
+extern int _IO_proc_close __P((_IO_FILE*));
+
+/* Jumptable functions for strfiles. */
+extern int _IO_str_underflow __P((_IO_FILE*));
+extern int _IO_str_overflow __P((_IO_FILE *, int));
+extern int _IO_str_pbackfail __P((_IO_FILE*, int));
+extern _IO_fpos_t _IO_str_seekoff __P((_IO_FILE*,_IO_off_t,int,int));
+
+/* Other strfile functions */
+extern void _IO_str_init_static __P((_IO_FILE *, char*, int, char*));
+extern void _IO_str_init_readonly __P((_IO_FILE *, const char*, int));
+extern _IO_ssize_t _IO_str_count __P ((_IO_FILE*));
+
+extern _IO_size_t _IO_getline __P((_IO_FILE*,char*,_IO_size_t,int,int));
+extern _IO_ssize_t _IO_getdelim __P((char**, _IO_size_t*, int, _IO_FILE*));
+extern double _IO_strtod __P((const char *, char **));
+extern char * _IO_dtoa __P((double __d, int __mode, int __ndigits,
+ int *__decpt, int *__sign, char **__rve));
+extern int _IO_outfloat __P((double __value, _IO_FILE *__sb, int __type,
+ int __width, int __precision, int __flags,
+ int __sign_mode, int __fill));
+
+extern _IO_FILE *_IO_list_all;
+extern void (*_IO_cleanup_registration_needed) __P ((void));
+
+#ifndef EOF
+#define EOF (-1)
+#endif
+#ifndef NULL
+#ifdef __GNUG__
+#define NULL (__null)
+#else
+#if !defined(__cplusplus)
+#define NULL ((void*)0)
+#else
+#define NULL (0)
+#endif
+#endif
+#endif
+
+#define FREE_BUF(_B) free(_B)
+#define ALLOC_BUF(_S) (char*)malloc(_S)
+
+#ifndef OS_FSTAT
+#define OS_FSTAT fstat
+#endif
+struct stat;
+extern _IO_ssize_t _IO_read __P((int, void*, _IO_size_t));
+extern _IO_ssize_t _IO_write __P((int, const void*, _IO_size_t));
+extern _IO_off_t _IO_lseek __P((int, _IO_off_t, int));
+extern int _IO_close __P((int));
+extern int _IO_fstat __P((int, struct stat *));
+
+/* Operations on _IO_fpos_t.
+ Normally, these are trivial, but we provide hooks for configurations
+ where an _IO_fpos_t is a struct.
+ Note that _IO_off_t must be an integral type. */
+
+/* _IO_pos_BAD is an _IO_fpos_t value indicating error, unknown, or EOF. */
+#ifndef _IO_pos_BAD
+#define _IO_pos_BAD ((_IO_fpos_t)(-1))
+#endif
+/* _IO_pos_as_off converts an _IO_fpos_t value to an _IO_off_t value. */
+#ifndef _IO_pos_as_off
+#define _IO_pos_as_off(__pos) ((_IO_off_t)(__pos))
+#endif
+/* _IO_pos_adjust adjust an _IO_fpos_t by some number of bytes. */
+#ifndef _IO_pos_adjust
+#define _IO_pos_adjust(__pos, __delta) ((__pos) += (__delta))
+#endif
+/* _IO_pos_0 is an _IO_fpos_t value indicating beginning of file. */
+#ifndef _IO_pos_0
+#define _IO_pos_0 ((_IO_fpos_t)0)
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+/* check following! */
+#define FILEBUF_LITERAL(CHAIN, FLAGS, FD) \
+ { _IO_MAGIC+_IO_LINKED+_IO_IS_FILEBUF+FLAGS, \
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, CHAIN, FD}
+
+/* VTABLE_LABEL defines NAME as of the CLASS class.
+ CNLENGTH is strlen(#CLASS). */
+#ifdef __GNUC__
+#if _G_VTABLE_LABEL_HAS_LENGTH
+#define VTABLE_LABEL(NAME, CLASS, CNLENGTH) \
+ extern char NAME[] asm (_G_VTABLE_LABEL_PREFIX #CNLENGTH #CLASS);
+#else
+#define VTABLE_LABEL(NAME, CLASS, CNLENGTH) \
+ extern char NAME[] asm (_G_VTABLE_LABEL_PREFIX #CLASS);
+#endif
+#endif /* __GNUC__ */
+
+#if !defined(builtinbuf_vtable) && defined(__cplusplus)
+#ifdef __GNUC__
+VTABLE_LABEL(builtinbuf_vtable, builtinbuf, 10)
+#else
+#if _G_VTABLE_LABEL_HAS_LENGTH
+#define builtinbuf_vtable _G_VTABLE_LABEL_PREFIX_ID##10builtinbuf
+#else
+#define builtinbuf_vtable _G_VTABLE_LABEL_PREFIX_ID##builtinbuf
+#endif
+#endif
+#endif /* !defined(builtinbuf_vtable) && defined(__cplusplus) */
+
+#if defined(__STDC__) || defined(__cplusplus)
+#define _IO_va_start(args, last) va_start(args, last)
+#else
+#define _IO_va_start(args, last) va_start(args)
+#endif
+
+extern struct _IO_fake_stdiobuf _IO_stdin_buf, _IO_stdout_buf, _IO_stderr_buf;
+
+#if 1
+#define COERCE_FILE(FILE) /* Nothing */
+#else
+/* This is part of the kludge for binary compatibility with old stdio. */
+#define COERCE_FILE(FILE) \
+ (((FILE)->_IO_file_flags & _IO_MAGIC_MASK) == _OLD_MAGIC_MASK \
+ && (FILE) = *(FILE**)&((int*)fp)[1])
+#endif
+
+#ifdef EINVAL
+#define MAYBE_SET_EINVAL errno = EINVAL
+#else
+#define MAYBE_SET_EINVAL /* nothing */
+#endif
+
+#ifdef DEBUG
+#define CHECK_FILE(FILE,RET) \
+ if ((FILE) == NULL) { MAYBE_SET_EINVAL; return RET; } \
+ else { COERCE_FILE(FILE); \
+ if (((FILE)->_IO_file_flags & _IO_MAGIC_MASK) != _IO_MAGIC) \
+ { errno = EINVAL; return RET; }}
+#else
+#define CHECK_FILE(FILE,RET) \
+ COERCE_FILE(FILE)
+#endif
diff --git a/libio/osform.cc b/libio/osform.cc
new file mode 100644
index 00000000000..8c0011703da
--- /dev/null
+++ b/libio/osform.cc
@@ -0,0 +1,54 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include <iostream.h>
+#include <stdarg.h>
+
+ostream& ostream::form(const char *format ...)
+{
+ if (opfx()) {
+ va_list ap;
+ va_start(ap, format);
+ _IO_vfprintf(rdbuf(), format, ap);
+ va_end(ap);
+ }
+ return *this;
+}
+
+ostream& ostream::vform(const char *format, _IO_va_list args)
+{
+ if (opfx())
+ _IO_vfprintf(rdbuf(), format, args);
+ return *this;
+}
+
+ostream& ostream::operator<<(const void *p)
+{
+ if (opfx()) {
+ form("%p", p);
+ osfx();
+ }
+ return *this;
+}
diff --git a/libio/ostream.h b/libio/ostream.h
new file mode 100644
index 00000000000..f54ec1de9a1
--- /dev/null
+++ b/libio/ostream.h
@@ -0,0 +1,25 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <stream.h>
diff --git a/libio/outfloat.c b/libio/outfloat.c
new file mode 100644
index 00000000000..a74b1a2c3e1
--- /dev/null
+++ b/libio/outfloat.c
@@ -0,0 +1,204 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+/* Format floating-point number and print them.
+ Return number of chars printed, or EOF on error.
+
+ sign_mode == '+' : print "-" or "+"
+ sign_mode == ' ' : print "-" or " "
+ sign_mode == '\0' : print "-' or ""
+*/
+
+int
+DEFUN(_IO_outfloat, (value, sb, type, width, precision, flags,
+ sign_mode, fill),
+ double value AND _IO_FILE *sb AND int type AND int width
+ AND int precision AND int flags AND int sign_mode AND int fill)
+{
+ int count = 0;
+#define PUT(x) do {if (_IO_putc(x, sb) < 0) goto error; count++;} while (0)
+#define PUTN(p, n) \
+ do {int _n=n; count+=_n; if (_IO_sputn(sb, p,_n) != _n) goto error;} while(0)
+#define PADN(fill, n) \
+ do {int _n = n; count+=_n; if (_IO_padn(sb, fill, _n) != _n) goto error;} while (0)
+ int pad_kind = flags & (_IO_LEFT|_IO_RIGHT|_IO_INTERNAL);
+ int skip_zeroes = 0;
+ int show_dot = (flags & _IO_SHOWPOINT) != 0;
+ int decpt;
+ int sign;
+ int mode;
+ int exponent_size;
+ int print_sign;
+ int trailing_zeroes, useful_digits;
+ int padding, unpadded_width;
+ char *p;
+ char *exponent_start;
+ register int i;
+#define EBUF_SIZE 12
+#define EBUF_END &ebuf[EBUF_SIZE]
+ char ebuf[EBUF_SIZE];
+ char *end;
+ int exp = 0;
+ switch (type)
+ {
+ case 'f':
+ mode = 3;
+ break;
+ case 'e':
+ case 'E':
+ exp = type;
+ mode = 2;
+ if (precision != 999)
+ precision++; /* Add one to include digit before decimal point. */
+ break;
+ case 'g':
+ case 'G':
+ exp = type == 'g' ? 'e' : 'E';
+ if (precision == 0) precision = 1;
+ if (!(flags & _IO_SHOWPOINT))
+ skip_zeroes = 1;
+ type = 'g';
+ mode = 2;
+ break;
+ }
+ /* Do the actual convension */
+ if (precision == 999 && mode != 3)
+ mode = 0;
+ p = _IO_dtoa(value, mode, precision, &decpt, &sign, &end);
+ useful_digits = end-p;
+ exponent_start = EBUF_END;
+ if (mode == 0)
+ precision = useful_digits;
+ /* Check if we need to emit an exponent. */
+ if (mode != 3 && decpt != 9999)
+ {
+ i = decpt - 1;
+ if ((type != 'g' && type != 'F') || i < -4 || i >= precision)
+ {
+ /* Print the exponent into ebuf.
+ We write ebuf in reverse order (right-to-left). */
+ char sign;
+ if (i >= 0)
+ sign = '+';
+ else
+ sign = '-', i = -i;
+ /* Note: ANSI requires at least 2 exponent digits. */
+ do {
+ *--exponent_start = (i % 10) + '0';
+ i /= 10;
+ } while (i >= 10);
+ *--exponent_start = i + '0';
+ *--exponent_start = sign;
+ *--exponent_start = exp;
+ }
+ }
+ exponent_size = EBUF_END - exponent_start;
+ if (mode == 1)
+ precision = 1;
+ /* If we print an exponent, always show just one digit before point. */
+ if (exponent_size)
+ decpt = 1;
+ if (decpt == 9999)
+ { /* Infinity or NaN */
+ decpt = useful_digits;
+ precision = 0;
+ show_dot = 0;
+ }
+
+ /* dtoa truncates trailing zeroes. Set the variable trailing_zeroes to
+ the number of 0's we have to add (after the decimal point). */
+ if (skip_zeroes)
+ trailing_zeroes = 0;
+ else if (type == 'f')
+ trailing_zeroes = useful_digits <= decpt ? precision
+ : precision-(useful_digits-decpt);
+ else if (exponent_size) /* 'e' 'E' or 'g' format using exponential notation*/
+ trailing_zeroes = precision - useful_digits;
+ else /* 'g' format not using exponential notation. */
+ trailing_zeroes = useful_digits <= decpt ? precision - decpt
+ : precision-useful_digits;
+ if (trailing_zeroes < 0) trailing_zeroes = 0;
+
+ if (trailing_zeroes != 0 || useful_digits > decpt)
+ show_dot = 1;
+ if (sign_mode == 0)
+ print_sign = sign ? '-' : 0;
+ else if (sign_mode == '+')
+ print_sign = sign ? '-' : '+';
+ else /* if (sign_mode == ' ') */
+ print_sign = sign ? '-' : ' ';
+
+ /* Calculate the width (before padding). */
+ unpadded_width =
+ (print_sign != 0) + trailing_zeroes + exponent_size + show_dot
+ + useful_digits
+ + (decpt > useful_digits ? decpt - useful_digits
+ : decpt > 0 ? 0 : 1 - decpt);
+
+ padding = width > unpadded_width ? width - unpadded_width : 0;
+ if (padding > 0 && pad_kind != _IO_LEFT && pad_kind != _IO_INTERNAL)
+ PADN(fill, padding); /* Default (right) adjust */
+ if (print_sign)
+ PUT(print_sign);
+ if (pad_kind == _IO_INTERNAL && padding > 0)
+ PADN(fill, padding);
+ if (decpt > 0)
+ {
+ if (useful_digits >= decpt)
+ PUTN(p, decpt);
+ else
+ {
+ PUTN(p, useful_digits);
+ PADN('0', decpt-useful_digits);
+ }
+ if (show_dot)
+ {
+ PUT('.');
+ /* Print digits after the decimal point. */
+ if (useful_digits > decpt)
+ PUTN(p + decpt, useful_digits-decpt);
+ }
+ }
+ else
+ {
+ PUT('0');
+ if (show_dot)
+ {
+ PUT('.');
+ PADN('0', -decpt);
+ /* Print digits after the decimal point. */
+ PUTN(p, useful_digits);
+ }
+ }
+ PADN('0', trailing_zeroes);
+ if (exponent_size)
+ PUTN(exponent_start, exponent_size);
+ if (pad_kind == _IO_LEFT && padding > 0) /* Left adjustment*/
+ PADN(fill, padding);
+ return count;
+ error:
+ return EOF;
+}
diff --git a/libio/parsestream.cc b/libio/parsestream.cc
new file mode 100644
index 00000000000..320afd06d9b
--- /dev/null
+++ b/libio/parsestream.cc
@@ -0,0 +1,317 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+
+Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#include "libioP.h"
+#include "parsestream.h"
+#include <stdlib.h>
+
+streambuf* parsebuf::setbuf(char*, int)
+{
+ return NULL;
+}
+
+int parsebuf::tell_in_line()
+{
+ return 0;
+}
+
+int parsebuf::pbackfail(int c)
+{
+ if (c == EOF)
+ return 0;
+ if (seekoff(-1, ios::cur) == EOF)
+ return EOF;
+ return (unsigned char)c;
+}
+
+char* parsebuf::current_line() { return NULL; }
+
+streampos parsebuf::seekoff(streamoff offset, _seek_dir dir, int)
+{
+ // Make offset relative to line start.
+ switch (dir) {
+ case ios::beg:
+ offset -= pos_at_line_start;
+ break;
+ case ios::cur:
+ offset += tell_in_line();
+ break;
+ default:
+ return EOF;
+ }
+ if (offset < -1)
+ return EOF;
+ if (offset > _line_length + 1)
+ return EOF;
+ return seek_in_line(offset) + pos_at_line_start;
+}
+
+// string_parsebuf invariants:
+// The reserve ares (base() .. ebuf()) is always the entire string.
+// The get area (eback() .. egptr()) is the extended current line
+// (i.e. with the '\n' at either end, if these exist).
+
+string_parsebuf::string_parsebuf(char *buf, int len,
+ int delete_at_close /* = 0*/)
+: parsebuf()
+{
+ setb(buf, buf+len, delete_at_close);
+ register char *ptr = buf;
+ while (ptr < ebuf() && *ptr != '\n') ptr++;
+ _line_length = ptr - buf;
+ setg(buf, buf, ptr);
+}
+
+int string_parsebuf::underflow()
+{
+ register char* ptr = egptr(); // Point to end of current_line
+ do {
+ int i = right() - ptr;
+ if (i <= 0)
+ return EOF;
+ ptr++; i--; // Skip '\n'.
+ char *line_start = ptr;
+ while (ptr < right() && *ptr == '\n') ptr++;
+ setg(line_start-1, line_start, ptr + (ptr < right()));
+ pos_at_line_start = line_start - left();
+ _line_length = ptr - line_start;
+ __line_number++;
+ } while (gptr() == ptr);
+ return *gptr();
+}
+
+char* string_parsebuf::current_line()
+{
+ char *ptr = eback();
+ if (__line_number > 0)
+ ptr++; // Skip '\n' at end of previous line.
+ return ptr;
+}
+
+int string_parsebuf::tell_in_line()
+{
+ int offset = gptr() - eback();
+ if (__line_number > 0)
+ offset--;
+ return offset;
+}
+
+int string_parsebuf::seek_in_line(int i)
+{
+ int delta = i - tell_in_line();
+ gbump(delta); // FIXME: Needs error (bounds) checking!
+ return i;
+}
+
+static const char NewLine[1] = { '\n' };
+
+general_parsebuf::general_parsebuf(streambuf *buf, int delete_arg_buf)
+ : parsebuf()
+{
+ delete_buf = delete_arg_buf;
+ sbuf = buf;
+ int buf_size = 128;
+ char* buffer = ALLOC_BUF(buf_size);
+ setb(buffer, buffer+buf_size, 1);
+// setg(buffer, buffer, buffer);
+}
+
+general_parsebuf::~general_parsebuf()
+{
+ if (delete_buf)
+ delete sbuf;
+}
+
+int general_parsebuf::underflow()
+{
+ register char *ptr = base();
+ int has_newline = eback() < gptr() && gptr()[-1] == '\n';
+ if (has_newline)
+ *ptr++ = '\n';
+ register streambuf *sb = sbuf;
+ register int ch;
+ for (;;) {
+ ch = sb->sbumpc();
+ if (ch == EOF)
+ break;
+ if (ptr == ebuf()) {
+ int old_size = ebuf() - base();
+ char *new_buffer = new char[old_size * 2];
+ memcpy(new_buffer, base(), old_size);
+ setb(new_buffer, new_buffer + 2 * old_size, 1);
+ ptr = new_buffer + old_size;
+ }
+ *ptr++ = ch;
+ if (ch == '\n')
+ break;
+ }
+ char *cur_pos = base() + has_newline;
+ pos_at_line_start += _line_length + 1;
+ _line_length = ptr - cur_pos;
+ if (ch != EOF || _line_length > 0)
+ __line_number++;
+ setg(base(), cur_pos, ptr);
+ return ptr == cur_pos ? EOF : cur_pos[0];
+}
+
+char* general_parsebuf::current_line()
+{
+ char* ret = base();
+ if (__line_number > 1)
+ ret++; // Move past '\n' from end of previous line.
+ return ret;
+}
+
+int general_parsebuf::tell_in_line()
+{
+ int off = gptr() - base();
+ if (__line_number > 1)
+ off--; // Subtract 1 for '\n' from end of previous line.
+ return off;
+}
+
+int general_parsebuf::seek_in_line(int i)
+{
+ if (__line_number == 0)
+ (void)general_parsebuf::underflow();
+ if (__line_number > 1)
+ i++; // Add 1 for '\n' from end of previous line.
+ if (i < 0) i = 0;
+ int len = egptr() - eback();
+ if (i > len) i = len;
+ setg(base(), base() + i, egptr());
+ return i;
+}
+
+func_parsebuf::func_parsebuf(CharReader func, void *argm) : parsebuf()
+{
+ read_func = func;
+ arg = argm;
+ buf_start = NULL;
+ buf_end = NULL;
+ setb((char*)NewLine, (char*)NewLine+1, 0);
+ setg((char*)NewLine, (char*)NewLine+1, (char*)NewLine+1);
+ backed_up_to_newline = 0;
+}
+
+int func_parsebuf::tell_in_line()
+{
+ if (buf_start == NULL)
+ return 0;
+ if (egptr() != (char*)NewLine+1)
+ // Get buffer was line buffer.
+ return gptr() - buf_start;
+ if (backed_up_to_newline)
+ return -1; // Get buffer is '\n' preceding current line.
+ // Get buffer is '\n' following current line.
+ return (buf_end - buf_start) + (gptr() - (char*)NewLine);
+}
+
+char* func_parsebuf::current_line()
+{
+ return buf_start;
+}
+
+int func_parsebuf::seek_in_line(int i)
+{
+ if (i < 0) {
+ // Back up to preceding '\n'.
+ if (i < -1) i = -1;
+ backed_up_to_newline = 1;
+ setg((char*)NewLine, (char*)NewLine+(i+1), (char*)NewLine+1);
+ return i;
+ }
+ backed_up_to_newline = 0;
+ int line_length = buf_end-buf_start;
+ if (i <= line_length) {
+ setg(buf_start, buf_start+i, buf_end);
+ return i;
+ }
+ i -= line_length;
+ if (i > 0) i = 1;
+ setg((char*)NewLine, (char*)NewLine+i, (char*)NewLine+1);
+ return line_length + i;
+}
+
+int func_parsebuf::underflow()
+{
+ retry:
+ if (gptr() < egptr())
+ return *gptr();
+ if (gptr() != (char*)NewLine+1) {
+ // Get buffer was line buffer. Move to following '\n'.
+ setg((char*)NewLine, (char*)NewLine, (char*)NewLine+1);
+ return *gptr();
+ }
+ if (backed_up_to_newline)
+ // Get buffer was '\n' preceding current line. Move to current line.
+ backed_up_to_newline = 0;
+ else {
+ // Get buffer was '\n' following current line. Read new line.
+ if (buf_start) free(buf_start);
+ char *str = (*read_func)(arg);
+ buf_start = str;
+ if (str == NULL)
+ return EOF;
+ // Initially, _line_length == -1, so pos_at_line_start becomes 0.
+ pos_at_line_start += _line_length + 1;
+ _line_length = strlen(str);
+ buf_end = str + _line_length;
+ __line_number++;
+ }
+ setg(buf_start, buf_start, buf_end);
+ goto retry;
+}
+
+#if 0
+size_t parsebuf::line_length()
+{
+ if (current_line_length == (size_t)(-1)) // Initial value;
+ (void)sgetc();
+ return current_line_length;
+}
+#endif
+
+int parsebuf::seek_in_line(int i)
+{
+#if 1
+ abort();
+ return i; // Suppress warnings.
+#else
+ if (i > 0) {
+ size_t len = line_length();
+ if ((unsigned)i > len) i = len;
+ }
+ else if (i < -1) i = -1;
+ int new_pos = seekoff(pos_at_line_start + i, ios::beg);
+ if (new_pos == EOF)
+ return tell_in_line();
+ else return new_pos - pos_at_line_start;
+#endif
+}
diff --git a/libio/parsestream.h b/libio/parsestream.h
new file mode 100644
index 00000000000..326ab87a809
--- /dev/null
+++ b/libio/parsestream.h
@@ -0,0 +1,156 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License.
+
+Written by Per Bothner (bothner@cygnus.com). */
+
+#ifndef PARSESTREAM_H
+#define PARSESTREAM_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+#include "streambuf.h"
+
+extern "C++" {
+// A parsebuf is a streambuf optimized for scanning text files.
+// It keeps track of line and column numbers.
+// It is guaranteed to remember the entire current line,
+// as well the '\n'-s on either side of it (if they exist).
+// You can arbitrarily seek (or unget) within this extended line.
+// Other backward seeks are not supported.
+// Normal read semantics are supported (and hence istream operators like >>).
+
+class parsebuf : public streambuf {
+ protected:
+ _IO_fpos_t pos_at_line_start;
+ long _line_length;
+ unsigned long __line_number;
+ char *buf_start;
+ char *buf_end;
+
+ public:
+ parsebuf *chain;
+
+ // Return column number (raw - don't handle tabs etc).
+ // Retult can be -1, meaning: at '\n' before current line.
+ virtual int tell_in_line();
+
+ // seek to (raw) column I in current line.
+ // Result is new (raw) column position - differs from I if unable to seek.
+ // Seek to -1 tries to seek to before previous LF.
+ virtual int seek_in_line(int i);
+
+ // Note: there is no "current line" initially, until something is read.
+
+ // Current line number, starting with 0.
+ // If tell_in_line()==-1, then line number of next line.
+ int line_number() { return __line_number; }
+
+ // Length of current line, not counting either '\n'.
+ int line_length() { return _line_length; }
+ // Current line - not a copy, so file ops may trash it.
+ virtual char* current_line();
+ virtual streampos seekoff(streamoff, _seek_dir, int mode=ios::in|ios::out);
+ virtual streambuf* setbuf(char* p, int len);
+ protected:
+ parsebuf() { chain= NULL;
+ __line_number = 0; pos_at_line_start = 0; _line_length = -1; }
+ virtual int pbackfail(int c);
+};
+
+// A string_parsebuf is a parsebuf whose source is a fixed string.
+
+class string_parsebuf : public parsebuf {
+ public:
+ int do_delete;
+ string_parsebuf(char *str, int len, int delete_at_close=0);
+ virtual int underflow();
+ virtual char* current_line();
+ virtual int seek_in_line(int i);
+ virtual int tell_in_line();
+ char *left() const { return base(); }
+ char *right() const { return ebuf(); }
+// streampos seekoff(streamoff, _seek_dir, int);
+};
+
+// A func_parsebuf calls a given function to get new input.
+// Each call returns an entire NUL-terminated line (without the '\n').
+// That line has been allocated with malloc(), not new.
+// The interface is tailored to the GNU readline library.
+// Example:
+// char* DoReadLine(void* arg)
+// {
+// char *line = readline((char*)arg); /* 'arg' is used as prompt. */
+// if line == NULL) { putc('\n', stderr); return NULL; }
+// if (line[0] != '\0') add_history(line);
+// return line;
+// }
+// char PromptBuffer[100] = "> ";
+// func_parsebuf my_stream(DoReadLine, PromptBuffer);
+
+typedef char *(*CharReader)(void *arg);
+class istream;
+
+class func_parsebuf : public parsebuf {
+ public:
+ void *arg;
+ CharReader read_func;
+ int backed_up_to_newline;
+ func_parsebuf(CharReader func, void *argm = NULL);
+ int underflow();
+ virtual int tell_in_line();
+ virtual int seek_in_line(int i);
+ virtual char* current_line();
+};
+
+// A general_parsebuf is a parsebuf which gets its input from some
+// other streambuf. It explicitly buffers up an entire line.
+
+class general_parsebuf : public parsebuf {
+ public:
+ streambuf *sbuf;
+ int delete_buf; // Delete sbuf when destroying this.
+ general_parsebuf(streambuf *buf, int delete_arg_buf = 0);
+ int underflow();
+ virtual int tell_in_line();
+ virtual int seek_in_line(int i);
+ ~general_parsebuf();
+ virtual char* current_line();
+};
+
+#if 0
+class parsestream : public istream {
+ streammarker marks[2];
+ short _first; // of the two marks; either 0 or 1
+ int _lineno;
+ int first() { return _first; }
+ int second() { return 1-_first; }
+ int line_length() { marks[second].delta(marks[first]); }
+ int line_length() { marks[second].delta(marks[first]); }
+ int seek_in_line(int i);
+ int tell_in_line();
+ int line_number();
+};
+#endif
+} // extern "C++"
+#endif /*!defined(PARSESTREAM_H)*/
diff --git a/libio/pfstream.cc b/libio/pfstream.cc
new file mode 100644
index 00000000000..3fa93c958f8
--- /dev/null
+++ b/libio/pfstream.cc
@@ -0,0 +1,92 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#include "libioP.h"
+#include <pfstream.h>
+#include <procbuf.h>
+
+ipfstream::ipfstream(const char *name, int mode, int prot)
+{
+ const char* p;
+
+ // Look for '| command' (as used by ftp).
+ for (p = name; *p == ' ' || *p == '\t'; p++) ;
+ if (*p == '|') {
+ procbuf *pbuf = new procbuf();
+ init(pbuf);
+ if (!pbuf->open(p+1, mode))
+ set(ios::badbit);
+ return;
+ }
+
+ // Look for 'command |'
+ while (*p) p++; // Point to last
+ while (p[-1] == ' ' || p[-1] == '\t' || p[-1] == '\n') p--;
+ if (p[-1] == '|') {
+ // Must remove the final '|'.
+ p--;
+#if !defined (__GNUC__) || defined (__STRICT_ANSI__)
+ char *command = new char[p-name+1];
+#else
+ char command[p-name+1];
+#endif
+ memcpy(command, name, p-name);
+ command[p-name] = '\0';
+
+ procbuf *pbuf = new procbuf();
+ if (pbuf->open(command, mode))
+ set(ios::badbit);
+#if !defined (__GNUC__) || defined (__STRICT_ANSI__)
+ delete command;
+#endif
+ return;
+ }
+
+ init(new filebuf());
+ if (!rdbuf()->open(name, mode, prot))
+ set(ios::badbit);
+}
+
+opfstream::opfstream(const char *name, int mode, int prot)
+{
+ const char *p;
+ // Look for '| command'.
+ for (p = name; *p == ' ' || *p == '\t'; p++) ;
+ if (*p == '|') {
+ procbuf *pbuf = new procbuf();
+ init(pbuf);
+ if (!pbuf->open(p+1, mode))
+ set(ios::badbit);
+ }
+ else {
+ init(new filebuf());
+ if (!rdbuf()->open(name, mode, prot))
+ set(ios::badbit);
+ }
+}
diff --git a/libio/pfstream.h b/libio/pfstream.h
new file mode 100644
index 00000000000..3c5458baaa9
--- /dev/null
+++ b/libio/pfstream.h
@@ -0,0 +1,59 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifndef _PFSTREAM_H
+#define _PFSTREAM_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+#include <fstream.h>
+
+extern "C++" {
+// ipfstream foo("NAME") is like: ifstream foo("NAME"). However,
+// if NAME starts *or ends* with a '|', the remainder of NAME is
+// evaluated as a shell command (using a procbuf), and all input
+// read from foo is whatever that shell writes to its standard output.
+// E.g. ipfstream foo("|zcat foo.Z") or ipfstream foo("zcat foo.Z|")
+// (These two forms are equivalent.)
+
+class ipfstream : public ifstream {
+ public:
+ ipfstream(const char *name, int mode=ios::in, int prot=0664);
+};
+
+// opfstream foo("NAME") is like: ofstream foo("NAME").
+// However, if NAME starts with a '|', the remainder of NAME is
+// evaluated as a shell command (using a procbuf), and all output
+// written to foo is piped to the standard input of that shell.
+// E.g. opfstream foo("|more");
+
+class opfstream : public ofstream {
+ public:
+ opfstream(const char *name, int mode=ios::out, int prot=0664);
+};
+} // extern "C++"
+#endif /*!_PFSTREAM_H*/
+
diff --git a/libio/procbuf.cc b/libio/procbuf.cc
new file mode 100644
index 00000000000..1c79ce4ce0f
--- /dev/null
+++ b/libio/procbuf.cc
@@ -0,0 +1,55 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+
+#define _POSIX_SOURCE
+#include "libioP.h"
+#include "procbuf.h"
+
+procbuf::procbuf(const char *command, int mode) : filebuf()
+{
+ _IO_proc_open(this, command, (mode & ios::in) ? "r" : "w");
+}
+
+procbuf *procbuf::open(const char *command, int mode)
+{
+ return (procbuf*)_IO_proc_open(this, command, (mode & ios::in) ? "r" : "w");
+}
+
+/* #define USE_SIGMASK */
+
+int procbuf::sys_close()
+{
+ return _IO_proc_close(this);
+}
+
+procbuf::~procbuf()
+{
+ close();
+}
diff --git a/libio/procbuf.h b/libio/procbuf.h
new file mode 100644
index 00000000000..b361a6a7c84
--- /dev/null
+++ b/libio/procbuf.h
@@ -0,0 +1,50 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifndef _PROCBUF_H
+#define _PROCBUF_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+
+#include <streambuf.h>
+
+extern "C++" {
+class procbuf : public filebuf {
+ /* Following fields must match those in struct _IO_proc_file */
+ _IO_pid_t _pid;
+ procbuf *_next;
+ public:
+ procbuf() : filebuf() { }
+ procbuf(const char *command, int mode);
+ procbuf* open(const char *command, int mode);
+ procbuf *close() { return (procbuf*)filebuf::close(); }
+ virtual int sys_close();
+ ~procbuf();
+};
+} // extern "C++"
+
+#endif /* !_PROCBUF_H */
diff --git a/libio/sbform.cc b/libio/sbform.cc
new file mode 100644
index 00000000000..c17bd08db15
--- /dev/null
+++ b/libio/sbform.cc
@@ -0,0 +1,40 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "streambuf.h"
+#include <stdarg.h>
+
+int streambuf::vform(char const *fmt0, _IO_va_list ap)
+{
+ return _IO_vfprintf(this, fmt0, ap);
+}
+int streambuf::form(char const *format ...)
+{
+ va_list ap;
+ va_start(ap, format);
+ int count = _IO_vfprintf(this, format, ap);
+ va_end(ap);
+ return count;
+}
diff --git a/libio/sbgetline.cc b/libio/sbgetline.cc
new file mode 100644
index 00000000000..700e2ec7afc
--- /dev/null
+++ b/libio/sbgetline.cc
@@ -0,0 +1,31 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "streambuf.h"
+
+long streambuf::sgetline(char* buf, _IO_size_t n, char delim, int extract_delim)
+{
+ return _IO_getline(this, buf, n, delim, extract_delim);
+}
diff --git a/libio/sbscan.cc b/libio/sbscan.cc
new file mode 100644
index 00000000000..c0ec35c53db
--- /dev/null
+++ b/libio/sbscan.cc
@@ -0,0 +1,45 @@
+
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "streambuf.h"
+#include <stdarg.h>
+
+int streambuf::vscan(char const *fmt0, _IO_va_list ap, ios* stream /* = NULL*/)
+{
+ int errcode = 0;
+ int count = _IO_vfscanf(this, fmt0, ap, &errcode);
+ if (stream)
+ stream->setstate((ios::iostate)errcode);
+ return count;
+}
+int streambuf::scan(char const *format ...)
+{
+ va_list ap;
+ va_start(ap, format);
+ int count = _IO_vfscanf(this, format, ap, NULL);
+ va_end(ap);
+ return count;
+}
diff --git a/libio/stdfiles.c b/libio/stdfiles.c
new file mode 100644
index 00000000000..1d0ef85be90
--- /dev/null
+++ b/libio/stdfiles.c
@@ -0,0 +1,44 @@
+/*
+Copyright (C) 1993, 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+
+/* This file provides definitions of _IO_stdin, _IO_stdout, and _IO_stderr
+ for C code. Compare stdstreams.cc.
+ (The difference is that here the vtable field is set to 0,
+ so the objects defined are not valid C++ objects. On the other
+ hand, we don't need a C++ compiler to build this file.) */
+
+#include "libioP.h"
+
+
+#define DEF_STDFILE(NAME, FD, CHAIN, FLAGS) \
+ struct _IO_FILE_plus NAME \
+ = {FILEBUF_LITERAL(CHAIN, FLAGS, FD), &_IO_file_jumps}
+
+DEF_STDFILE(_IO_stdin_, 0, 0, _IO_NO_WRITES);
+DEF_STDFILE(_IO_stdout_, 1, &_IO_stdin_.file, _IO_NO_READS);
+DEF_STDFILE(_IO_stderr_, 2, &_IO_stdout_.file,
+ _IO_NO_READS+_IO_UNBUFFERED);
+
+_IO_FILE *_IO_list_all = &_IO_stderr_.file;
diff --git a/libio/stdio/ChangeLog b/libio/stdio/ChangeLog
new file mode 100644
index 00000000000..76ce5b7a875
--- /dev/null
+++ b/libio/stdio/ChangeLog
@@ -0,0 +1,93 @@
+Thu May 1 11:03:45 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * stdio.h (TMP_MAX): Wrap it with #ifndef for now, since it can
+ get defined by <limits.h> (e.g., HP/UX and AIX).
+
+Wed Mar 12 08:51:37 1997 Gavin Koch <gavin@cygnus.com>
+
+ * stdio.h: Use _IO_va_list rather than _G_va_list.
+
+Wed Jun 14 21:41:50 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * configure.in (LIBDIR): Set.
+ (MOSTLYCLEAN): Remove pic and stamp-picdir.
+ (stdio_objects): Also compile pic version.
+
+ * Makefile.in (STDIO_OBJECTS): Remove getdelim.o.
+
+Wed May 10 03:05:53 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * vsnprintf.c (vsnprintf): Update to use _IO_JUMPS.
+
+ * Makefile.in (STDIO_OBJECTS): Fix typo.
+
+Tue Oct 18 17:15:09 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * getline.c, snprintf.c, vsnprintf.c: New files, providing
+ functionality of the GNU C C library.
+ * Makefile.in (STDIO_OBJECTS), configure.in: Add new files.
+ * stdio.h: Add new functions.
+
+Fri Oct 14 15:56:27 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * stdio.h: Added vfscanf, vscanf, vsscanf, #ifndef __STRICT_ANSI__.
+
+Tue Aug 23 16:17:25 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * stdio.h: Added comment, at hjl's request.
+
+Sun Aug 7 13:28:12 1994 H.J. Lu (hjl@nynexst.com)
+
+ * stdio.h (getc, getchar, putc, putchar): New declarations.
+ Move macros after the declarations.
+
+Fri Aug 5 18:27:21 1994 H.J. Lu (hjl@nynexst.com)
+
+ * clearerr.c, rewind.c, setfileno.c:
+ Add CHECK_FILE(fp, ) and remove COERCE_FILE(fp).
+ * feof.c, ferror.c, fgetc.c, fileno.c, fputc.c, getw.c, putw.c,
+ vfscanf.c: Add CHECK_FILE(fp, EOF) and remove COERCE_FILE(fp).
+ * freopen.c: Add CHECK_FILE(fp, NULL) and remove COERCE_FILE(fp).
+ * fseek.c, vfprintf.c:
+ Add CHECK_FILE(fp, -1) and remove COERCE_FILE(fp).
+
+Fri May 20 13:11:58 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * stdio.h: Rename _ARGS macro to __P for better gnlibc and
+ BSD compatibility.
+
+Fri Nov 26 13:26:35 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ Bunch of little changes, many from H.J. Lu <hjl@nynexst.com>.
+ * feof.c, setbuf.c, vprintf.c, vcanf.c: #include <stdio.h>,
+ for error checking.
+ * fileno.c: #include libioP.h, not just libio.h.
+ * fputc.c: Fix typo.
+ * fseek.c, rewind.c: Use #include "...", not <...> ,for local files.
+ * getc.c, getchar.c, putc.c, putchar.c: New files, providing
+ non-macro versions of the standard macros.
+ * getw.c, putw.c, setfileno.c, setlinebuf.c: New files.
+ * Makefile.in (STDIO_OBJECTS): Add new files.
+ * vfscanf.c: Add missing new 4th arg to _IO_vfscanf call.
+
+Thu Oct 14 16:12:07 1993 Karen Christiansen (karen@deneb.cygnus.com)
+
+ * configure.in: changed mv to mv -f
+
+Mon Oct 4 17:29:23 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * configure.in (stdio_renames): Add fgetpos, fsetpos, gets,
+ perror, setbuffer, ungetc.
+ * clearerr.c, ferror.c, fgetc.c, fileno.c, fputc.c, freopen.c,
+ fseek.c, popen.c, rewind.c, setbuf.c: New files.
+ * Makefile.in (STDIO_OBJECTS): Add new files.
+ * stdio.h: Use _IO_XXX instead of _G_XXX many places.
+ #include <libio.h> instead of <_stdio.h>, to get useful defs.
+
+Fri Aug 20 00:28:28 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * feof.c, vprintf.c, vscanf.c: Converted stub functions.
+ * configure.in (stdio_renamed): Removed feof.
+ Added sprintf sscanf vsscanf.
+ * ChangeLog.old: Copy of old libg++/iostream/stdio/ChangeLog.
+
diff --git a/libio/stdio/Makefile.in b/libio/stdio/Makefile.in
new file mode 100644
index 00000000000..8df66a7c193
--- /dev/null
+++ b/libio/stdio/Makefile.in
@@ -0,0 +1,23 @@
+srcdir = .
+
+#### package, host, target, and site dependent Makefile fragments come in here.
+##
+
+# These are compiled from the corresponding ../ioFOO.c files.
+STDIO_RENAMED_OBJECTS = ... filled in by configure ...
+# These are the files that a libc would want.
+STDIO_OBJECTS = $(STDIO_RENAMED_OBJECTS) \
+ clearerr.o fdopen.o feof.o ferror.o fgetc.o fileno.o \
+ fputc.o freopen.o fseek.o getc.o getchar.o getline.o getw.o \
+ popen.o putc.o putchar.o putw.o rewind.o \
+ setbuf.o setfileno.o setlinebuf.o snprintf.o \
+ vfprintf.o vfscanf.o vprintf.o vscanf.o vsnprintf.o
+
+CC_FOR_STDIO=$(CC)
+CINCLUDES = -I. -I$(srcdir) -I.. -I$(srcdir)/.. -D__USE_GNU
+
+nothing:
+
+stdio.list: stamp-picdir $(STDIO_OBJECTS)
+ @echo "$(STDIO_OBJECTS)" >stdio.list
+
diff --git a/libio/stdio/clearerr.c b/libio/stdio/clearerr.c
new file mode 100644
index 00000000000..ee9780bdaf5
--- /dev/null
+++ b/libio/stdio/clearerr.c
@@ -0,0 +1,10 @@
+#include "libioP.h"
+#include "stdio.h"
+
+void
+clearerr(fp)
+ FILE* fp;
+{
+ CHECK_FILE(fp, /*nothing*/);
+ _IO_clearerr(fp);
+}
diff --git a/libio/stdio/configure.in b/libio/stdio/configure.in
new file mode 100644
index 00000000000..21e920acf47
--- /dev/null
+++ b/libio/stdio/configure.in
@@ -0,0 +1,48 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../configure.
+
+configdirs=
+srctrigger=stdio.h
+srcname="libio/stdio"
+package_makefile_frag=../Make.pack
+
+# per-host:
+
+# per-target:
+
+LIBDIR=yes
+TO_TOPDIR=../../
+ALL=nothing
+MOSTLYCLEAN='*.o pic stamp-picdir core stdio.list'
+(. ${srcdir}/../config.shared) >${package_makefile_frag}
+
+# post-target:
+
+# Certain files that are used to build a C library (such as fprintf.o)
+# are compled from the same sources as the ioXXX versions (such as ioprintf.c).
+# These lines add the appropriate rules.
+# NOTE: We assume a C compiler that where -o with -c works.
+# But these files are not built by default anyway ...
+
+# TODO: remove rename tmpfile tmpnam
+
+stdio_renames="fclose fflush fgetpos fgets fopen fprintf fputs fread \
+ fscanf fsetpos ftell fwrite getdelim gets perror printf puts \
+ scanf setbuffer setvbuf sprintf sscanf ungetc vsprintf vsscanf"
+stdio_objects=""
+
+for file in $stdio_renames ; do
+ cat >>Makefile <<EOF
+$file.o: \$(srcdir)/../io$file.c
+ if [ -n "\$(PICFLAG)" ]; then \\
+ \$(CC_FOR_STDIO) \$(CFLAGS) \$(CINCLUDES) \$(PICFLAG) -c \\
+ \$(srcdir)/../io$file.c -D_IO_$file=$file -o pic/$file.o; \\
+ fi
+ \$(CC_FOR_STDIO) \$(CFLAGS) \$(CINCLUDES) -c \\
+ \$(srcdir)/../io$file.c -D_IO_$file=$file -o $file.o
+EOF
+ stdio_objects="$stdio_objects $file.o"
+done
+sed -e "/STDIO_RENAMED_OBJECTS =/s/=.*/=${stdio_objects}/" <Makefile >tmp
+mv -f tmp Makefile
diff --git a/libio/stdio/fdopen.c b/libio/stdio/fdopen.c
new file mode 100644
index 00000000000..83e026ec7f7
--- /dev/null
+++ b/libio/stdio/fdopen.c
@@ -0,0 +1,9 @@
+#include "libioP.h"
+
+_IO_FILE *
+fdopen (fd, mode)
+ int fd;
+ const char *mode;
+{
+ return _IO_fdopen (fd, mode);
+}
diff --git a/libio/stdio/feof.c b/libio/stdio/feof.c
new file mode 100644
index 00000000000..bd30c175f3c
--- /dev/null
+++ b/libio/stdio/feof.c
@@ -0,0 +1,34 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "stdio.h"
+
+int
+feof(fp)
+ _IO_FILE* fp;
+{
+ CHECK_FILE(fp, EOF);
+ return _IO_feof(fp);
+}
diff --git a/libio/stdio/ferror.c b/libio/stdio/ferror.c
new file mode 100644
index 00000000000..ef95d7cd29d
--- /dev/null
+++ b/libio/stdio/ferror.c
@@ -0,0 +1,10 @@
+#include "libioP.h"
+#include "stdio.h"
+
+int
+ferror(fp)
+ FILE* fp;
+{
+ CHECK_FILE(fp, EOF);
+ return _IO_ferror(fp);
+}
diff --git a/libio/stdio/fgetc.c b/libio/stdio/fgetc.c
new file mode 100644
index 00000000000..cf6410a887f
--- /dev/null
+++ b/libio/stdio/fgetc.c
@@ -0,0 +1,10 @@
+#include "libioP.h"
+#include "stdio.h"
+
+int
+fgetc(fp)
+ FILE *fp;
+{
+ CHECK_FILE(fp, EOF);
+ return _IO_getc(fp);
+}
diff --git a/libio/stdio/fileno.c b/libio/stdio/fileno.c
new file mode 100644
index 00000000000..c0bc55ce9a1
--- /dev/null
+++ b/libio/stdio/fileno.c
@@ -0,0 +1,12 @@
+#include "libioP.h"
+#include "stdio.h"
+
+int
+fileno(fp)
+ _IO_FILE* fp;
+{
+ CHECK_FILE(fp, EOF);
+ if (!(fp->_flags & _IO_IS_FILEBUF))
+ return EOF;
+ return _IO_fileno(fp);
+}
diff --git a/libio/stdio/fputc.c b/libio/stdio/fputc.c
new file mode 100644
index 00000000000..e87b042bfba
--- /dev/null
+++ b/libio/stdio/fputc.c
@@ -0,0 +1,11 @@
+#include "libioP.h"
+#include "stdio.h"
+
+int
+fputc(c, fp)
+ int c;
+ FILE *fp;
+{
+ CHECK_FILE(fp, EOF);
+ return _IO_putc(c, fp);
+}
diff --git a/libio/stdio/freopen.c b/libio/stdio/freopen.c
new file mode 100644
index 00000000000..da3dc1d6411
--- /dev/null
+++ b/libio/stdio/freopen.c
@@ -0,0 +1,14 @@
+#include "libioP.h"
+#include "stdio.h"
+
+FILE*
+freopen(filename, mode, fp)
+ const char* filename;
+ const char* mode;
+ FILE* fp;
+{
+ CHECK_FILE(fp, NULL);
+ if (!(fp->_flags & _IO_IS_FILEBUF))
+ return NULL;
+ return _IO_freopen(filename, mode, fp);
+}
diff --git a/libio/stdio/fseek.c b/libio/stdio/fseek.c
new file mode 100644
index 00000000000..b80067da1c0
--- /dev/null
+++ b/libio/stdio/fseek.c
@@ -0,0 +1,12 @@
+#include "stdio.h"
+#include "libioP.h"
+
+int
+fseek(fp, offset, whence)
+ _IO_FILE* fp;
+ long int offset;
+ int whence;
+{
+ CHECK_FILE(fp, -1);
+ return _IO_fseek(fp, offset, whence);
+}
diff --git a/libio/stdio/getc.c b/libio/stdio/getc.c
new file mode 100644
index 00000000000..9db0987f71c
--- /dev/null
+++ b/libio/stdio/getc.c
@@ -0,0 +1,11 @@
+#include "libioP.h"
+#include "stdio.h"
+
+#undef getc
+
+int
+getc(stream)
+ FILE *stream;
+{
+ return _IO_getc (stream);
+}
diff --git a/libio/stdio/getchar.c b/libio/stdio/getchar.c
new file mode 100644
index 00000000000..88610dc49e2
--- /dev/null
+++ b/libio/stdio/getchar.c
@@ -0,0 +1,10 @@
+#include "libioP.h"
+#include "stdio.h"
+
+#undef getchar
+
+int
+getchar ()
+{
+ return _IO_getc (stdin);
+}
diff --git a/libio/stdio/getline.c b/libio/stdio/getline.c
new file mode 100644
index 00000000000..6f4b677086e
--- /dev/null
+++ b/libio/stdio/getline.c
@@ -0,0 +1,13 @@
+#include "libioP.h"
+#include "stdio.h"
+
+/* NOTE: This geline function is different from _IO_getline. */
+
+_IO_ssize_t
+getline (lineptr, linelen, fp)
+ char** lineptr;
+ size_t* linelen;
+ FILE* fp;
+{
+ return _IO_getdelim (lineptr, linelen, '\n', fp);
+}
diff --git a/libio/stdio/getw.c b/libio/stdio/getw.c
new file mode 100644
index 00000000000..1dfafbc1d4f
--- /dev/null
+++ b/libio/stdio/getw.c
@@ -0,0 +1,13 @@
+#include "libioP.h"
+#include "stdio.h"
+
+int
+getw(fp)
+ FILE *fp;
+{
+ int w;
+ _IO_size_t bytes_read;
+ CHECK_FILE(fp, EOF);
+ bytes_read = _IO_sgetn (fp, (char*)&w, sizeof(w));
+ return sizeof(w) == bytes_read ? w : EOF;
+}
diff --git a/libio/stdio/popen.c b/libio/stdio/popen.c
new file mode 100644
index 00000000000..9f9f3f72f58
--- /dev/null
+++ b/libio/stdio/popen.c
@@ -0,0 +1,23 @@
+#include "libioP.h"
+#include "stdio.h"
+#include <errno.h>
+
+FILE *
+popen(command, mode)
+ const char *command; const char *mode;
+{
+ return _IO_popen(command, mode);
+}
+
+int
+pclose(fp)
+ FILE *fp;
+{
+#if 0
+ /* Does not actually test that stream was created by popen(). Instead,
+ it depends on the filebuf::sys_close() virtual to Do The Right Thing. */
+ if (fp is not a proc_file)
+ return -1;
+#endif
+ return _IO_fclose(fp);
+}
diff --git a/libio/stdio/putc.c b/libio/stdio/putc.c
new file mode 100644
index 00000000000..2a3dcc36867
--- /dev/null
+++ b/libio/stdio/putc.c
@@ -0,0 +1,12 @@
+#include "libioP.h"
+#include "stdio.h"
+
+#undef putc
+
+int
+putc(c, stream)
+ int c;
+ FILE *stream;
+{
+ return _IO_putc(c, stream);
+}
diff --git a/libio/stdio/putchar.c b/libio/stdio/putchar.c
new file mode 100644
index 00000000000..a0a972fb539
--- /dev/null
+++ b/libio/stdio/putchar.c
@@ -0,0 +1,10 @@
+#include "libioP.h"
+#include "stdio.h"
+#undef putchar
+
+int
+putchar(c)
+ int c;
+{
+ return _IO_putc(c, stdout);
+}
diff --git a/libio/stdio/putw.c b/libio/stdio/putw.c
new file mode 100644
index 00000000000..fd73261359c
--- /dev/null
+++ b/libio/stdio/putw.c
@@ -0,0 +1,15 @@
+#include "libioP.h"
+#include "stdio.h"
+
+#undef putw
+
+int
+putw(w, fp)
+ int w;
+ FILE *fp;
+{
+ _IO_size_t written;
+ CHECK_FILE(fp, EOF);
+ written = _IO_sputn(fp, (const char *)&w, sizeof(w));
+ return written == sizeof(w) ? 0 : EOF;
+}
diff --git a/libio/stdio/rewind.c b/libio/stdio/rewind.c
new file mode 100644
index 00000000000..01fe20a75dd
--- /dev/null
+++ b/libio/stdio/rewind.c
@@ -0,0 +1,10 @@
+#include "stdio.h"
+#include "libioP.h"
+
+void
+rewind(fp)
+ _IO_FILE* fp;
+{
+ CHECK_FILE(fp, );
+ _IO_rewind(fp);
+}
diff --git a/libio/stdio/setbuf.c b/libio/stdio/setbuf.c
new file mode 100644
index 00000000000..5002e3d0733
--- /dev/null
+++ b/libio/stdio/setbuf.c
@@ -0,0 +1,9 @@
+#include "libioP.h"
+#include "stdio.h"
+
+void
+setbuf (fp, buf)
+ FILE *fp; char *buf;
+{
+ _IO_setbuffer(fp, buf, _IO_BUFSIZ);
+}
diff --git a/libio/stdio/setfileno.c b/libio/stdio/setfileno.c
new file mode 100644
index 00000000000..f7ccc6fdd66
--- /dev/null
+++ b/libio/stdio/setfileno.c
@@ -0,0 +1,17 @@
+/* Some known programs (xterm, pdksh?) non-portably change the _file
+ field of s struct _iobuf. This kludge allows the same "functionality".
+ This code is an undocumented feature for iostream/stdio. Use it at
+ your own risk. */
+
+#include "libioP.h"
+#include "stdio.h"
+
+void
+setfileno(fp, fd)
+ _IO_FILE* fp;
+ int fd;
+{
+ CHECK_FILE(fp, );
+ if ((fp->_flags & _IO_IS_FILEBUF) != 0)
+ fp->_fileno = fd;
+}
diff --git a/libio/stdio/setlinebuf.c b/libio/stdio/setlinebuf.c
new file mode 100644
index 00000000000..c447f954e9f
--- /dev/null
+++ b/libio/stdio/setlinebuf.c
@@ -0,0 +1,11 @@
+#include "libioP.h"
+#include "stdio.h"
+
+#undef setlinebuf
+
+void
+setlinebuf (stream)
+ FILE *stream;
+{
+ _IO_setvbuf(stream, NULL, 1, 0);
+}
diff --git a/libio/stdio/snprintf.c b/libio/stdio/snprintf.c
new file mode 100644
index 00000000000..5c70a444112
--- /dev/null
+++ b/libio/stdio/snprintf.c
@@ -0,0 +1,51 @@
+/*
+Copyright (C) 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+#ifdef __STDC__
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+
+int
+snprintf
+#ifdef __STDC__
+ (char *string, _IO_size_t maxlen, const char *format, ...)
+#else
+(string, maxlen, format, va_alist)
+ char *string;
+ _IO_size_t maxlen;
+ char *format;
+ va_dcl
+#endif
+{
+ int ret;
+ va_list args;
+ _IO_va_start(args, format);
+ ret = vsnprintf(string, maxlen, format, args);
+ va_end(args);
+ return ret;
+}
diff --git a/libio/stdio/stdio.h b/libio/stdio/stdio.h
new file mode 100644
index 00000000000..d1c41300b41
--- /dev/null
+++ b/libio/stdio/stdio.h
@@ -0,0 +1,181 @@
+/* This is part of the iostream/stdio library, providing -*- C -*- I/O.
+ Define ANSI C stdio on top of C++ iostreams.
+ Copyright (C) 1991, 1994 Free Software Foundation
+
+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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+*/
+
+/*
+ * ANSI Standard: 4.9 INPUT/OUTPUT <stdio.h>
+ */
+
+#ifndef _STDIO_H
+#define _STDIO_H
+#define _STDIO_USES_IOSTREAM
+
+#include <libio.h>
+
+#ifndef NULL
+#ifdef __cplusplus
+#define NULL 0
+#else
+#define NULL (void*)0
+#endif
+#endif
+
+#ifndef EOF
+#define EOF (-1)
+#endif
+#ifndef BUFSIZ
+#define BUFSIZ 1024
+#endif
+
+#define _IOFBF 0 /* Fully buffered. */
+#define _IOLBF 1 /* Line buffered. */
+#define _IONBF 2 /* No buffering. */
+
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+
+ /* define size_t. Crud in case <sys/types.h> has defined it. */
+#if !defined(_SIZE_T) && !defined(_T_SIZE_) && !defined(_T_SIZE)
+#if !defined(__SIZE_T) && !defined(_SIZE_T_) && !defined(___int_size_t_h)
+#if !defined(_GCC_SIZE_T) && !defined(_SIZET_)
+#define _SIZE_T
+#define _T_SIZE_
+#define _T_SIZE
+#define __SIZE_T
+#define _SIZE_T_
+#define ___int_size_t_h
+#define _GCC_SIZE_T
+#define _SIZET_
+typedef _IO_size_t size_t;
+#endif
+#endif
+#endif
+
+typedef struct _IO_FILE FILE;
+typedef _IO_fpos_t fpos_t;
+
+#define FOPEN_MAX _G_FOPEN_MAX
+#define FILENAME_MAX _G_FILENAME_MAX
+#ifndef TMP_MAX
+#define TMP_MAX 999 /* Only limited by filename length */
+#endif
+
+#define L_ctermid 9
+#define L_cuserid 9
+#define P_tmpdir "/tmp"
+#define L_tmpnam 20
+
+/* For use by debuggers. These are linked in if printf or fprintf are used. */
+extern FILE *stdin, *stdout, *stderr; /* TODO */
+
+#define stdin _IO_stdin
+#define stdout _IO_stdout
+#define stderr _IO_stderr
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef __P
+#if defined(__STDC__) || defined(__cplusplus) || defined(c_plusplus)
+#define __P(args) args
+#else
+#define __P(args) ()
+#endif
+#endif /*!__P*/
+
+extern void clearerr __P((FILE*));
+extern int fclose __P((FILE*));
+extern int feof __P((FILE*));
+extern int ferror __P((FILE*));
+extern int fflush __P((FILE*));
+extern int fgetc __P((FILE *));
+extern int fgetpos __P((FILE* fp, fpos_t *pos));
+extern char* fgets __P((char*, int, FILE*));
+extern FILE* fopen __P((const char*, const char*));
+extern int fprintf __P((FILE*, const char* format, ...));
+extern int fputc __P((int, FILE*));
+extern int fputs __P((const char *str, FILE *fp));
+extern size_t fread __P((void*, size_t, size_t, FILE*));
+extern FILE* freopen __P((const char*, const char*, FILE*));
+extern int fscanf __P((FILE *fp, const char* format, ...));
+extern int fseek __P((FILE* fp, long int offset, int whence));
+extern int fsetpos __P((FILE* fp, const fpos_t *pos));
+extern long int ftell __P((FILE* fp));
+extern size_t fwrite __P((const void*, size_t, size_t, FILE*));
+extern int getc __P((FILE *));
+extern int getchar __P((void));
+extern char* gets __P((char*));
+extern void perror __P((const char *));
+extern int printf __P((const char* format, ...));
+extern int putc __P((int, FILE *));
+extern int putchar __P((int));
+extern int puts __P((const char *str));
+extern int remove __P((const char*));
+extern int rename __P((const char* _old, const char* _new));
+extern void rewind __P((FILE*));
+extern int scanf __P((const char* format, ...));
+extern void setbuf __P((FILE*, char*));
+extern void setlinebuf __P((FILE*));
+extern void setbuffer __P((FILE*, char*, int));
+extern int setvbuf __P((FILE*, char*, int mode, size_t size));
+extern int sprintf __P((char*, const char* format, ...));
+extern int sscanf __P((const char* string, const char* format, ...));
+extern FILE* tmpfile __P((void));
+extern char* tmpnam __P((char*));
+extern int ungetc __P((int c, FILE* fp));
+extern int vfprintf __P((FILE *fp, char const *fmt0, _IO_va_list));
+extern int vprintf __P((char const *fmt, _IO_va_list));
+extern int vsprintf __P((char* string, const char* format, _IO_va_list));
+
+#ifndef __STRICT_ANSI__
+extern int vfscanf __P((FILE*, const char *, _IO_va_list));
+extern int vscanf __P((const char *, _IO_va_list));
+extern int vsscanf __P((const char *, const char *, _IO_va_list));
+#endif
+
+#if !defined(__STRICT_ANSI__) || defined(_POSIX_SOURCE)
+extern FILE *fdopen __P((int, const char *));
+extern int fileno __P((FILE*));
+extern FILE* popen __P((const char*, const char*));
+extern int pclose __P((FILE*));
+#endif
+
+#ifdef __USE_GNU
+extern _IO_ssize_t getdelim __P ((char **, size_t *, int, FILE*));
+extern _IO_ssize_t getline __P ((char **, size_t *, FILE *));
+
+extern int snprintf __P ((char *, size_t, const char *, ...));
+extern int vsnprintf __P ((char *, size_t, const char *, _IO_va_list));
+#endif
+
+extern int __underflow __P((struct _IO_FILE*));
+extern int __overflow __P((struct _IO_FILE*, int));
+
+#define getc(fp) _IO_getc(fp)
+#define putc(c, fp) _IO_putc(c, fp)
+#define putchar(c) putc(c, stdout)
+#define getchar() getc(stdin)
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /*!_STDIO_H*/
diff --git a/libio/stdio/vfprintf.c b/libio/stdio/vfprintf.c
new file mode 100644
index 00000000000..fca62094452
--- /dev/null
+++ b/libio/stdio/vfprintf.c
@@ -0,0 +1,35 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+
+int
+vfprintf(fp, format, args)
+ register _IO_FILE* fp;
+ char const *format;
+ _IO_va_list args;
+{
+ CHECK_FILE(fp, -1);
+ return _IO_vfprintf(fp, format, args);
+}
diff --git a/libio/stdio/vfscanf.c b/libio/stdio/vfscanf.c
new file mode 100644
index 00000000000..1759ee5ee01
--- /dev/null
+++ b/libio/stdio/vfscanf.c
@@ -0,0 +1,36 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "stdio.h"
+
+int
+vfscanf(fp, format, args)
+ register _IO_FILE* fp;
+ const char *format;
+ _IO_va_list args;
+{
+ CHECK_FILE(fp, EOF);
+ return _IO_vfscanf(fp, format, args, NULL);
+}
diff --git a/libio/stdio/vprintf.c b/libio/stdio/vprintf.c
new file mode 100644
index 00000000000..784f0d9b8df
--- /dev/null
+++ b/libio/stdio/vprintf.c
@@ -0,0 +1,33 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "stdio.h"
+
+int vprintf(format, args)
+ const char* format;
+ _IO_va_list args;
+{
+ return _IO_vfprintf(_IO_stdout, format, args);
+}
diff --git a/libio/stdio/vscanf.c b/libio/stdio/vscanf.c
new file mode 100644
index 00000000000..4ef4b52a21c
--- /dev/null
+++ b/libio/stdio/vscanf.c
@@ -0,0 +1,34 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "stdio.h"
+
+int
+vscanf(format, args)
+ const char *format;
+ _IO_va_list args;
+{
+ return _IO_vfscanf(_IO_stdin, format, args, NULL);
+}
diff --git a/libio/stdio/vsnprintf.c b/libio/stdio/vsnprintf.c
new file mode 100644
index 00000000000..8db41b76187
--- /dev/null
+++ b/libio/stdio/vsnprintf.c
@@ -0,0 +1,43 @@
+/*
+Copyright (C) 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "libioP.h"
+#include "strfile.h"
+
+int
+vsnprintf (string, maxlen, format, args)
+ char *string;
+ _IO_size_t maxlen;
+ const char *format;
+ _IO_va_list args;
+{
+ _IO_strfile sf;
+ int ret;
+ _IO_init((_IO_FILE*)&sf, 0);
+ _IO_JUMPS((_IO_FILE*)&sf) = &_IO_str_jumps;
+ _IO_str_init_static ((_IO_FILE*)&sf, string, maxlen - 1, string);
+ ret = _IO_vfprintf((_IO_FILE*)&sf, format, args);
+ *((_IO_FILE*)&sf)->_IO_write_ptr = '\0';
+ return ret;
+}
diff --git a/libio/stdiostream.cc b/libio/stdiostream.cc
new file mode 100644
index 00000000000..80db5e59bfd
--- /dev/null
+++ b/libio/stdiostream.cc
@@ -0,0 +1,159 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+
+#include <stdiostream.h>
+#include "libioP.h"
+
+// A stdiobuf is "tied" to a FILE object (as used by the stdio package).
+// Thus a stdiobuf is always synchronized with the corresponding FILE,
+// though at the cost of some overhead. (If you use the implementation
+// of stdio supplied with this library, you don't need stdiobufs.)
+// This implementation inherits from filebuf, but implement the virtual
+// functions sys_read/..., using the stdio functions fread/... instead
+// of the low-level read/... system calls. This has the advantage that
+// we get all of the nice filebuf semantics automatically, though
+// with some overhead.
+
+
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#endif
+#ifndef SEEK_CUR
+#define SEEK_CUR 1
+#endif
+#ifndef SEEK_END
+#define SEEK_END 2
+#endif
+
+stdiobuf::stdiobuf(FILE *f) : filebuf(fileno(f))
+{
+ _file = f;
+ // Turn off buffer in stdiobuf. Instead, rely on buffering in (FILE).
+ // Thus the stdiobuf will be synchronized with the FILE.
+ setbuf(NULL, 0);
+}
+
+stdiobuf::~stdiobuf()
+{
+ /* Only needed if we're buffered. Not buffered is the default. */
+ _IO_do_flush((_IO_FILE*)this);
+}
+
+streamsize stdiobuf::sys_read(char* buf, streamsize size)
+{
+ // A minor optimization, but it makes a noticable difference.
+ // A bigger optimization would be to write stdiobuf::underflow,
+ // but that has some modularity disadvantages. Re-evaluate that
+ // after we have gotten rid of the double indirection. FIXME
+ if (size == 1)
+ {
+ register ch = getc(_file);
+ if (ch == EOF)
+ return 0;
+ *buf = (char)ch;
+ return 1;
+ }
+ else
+ return fread(buf, 1, size, _file);
+}
+
+streamsize stdiobuf::sys_write(const char *buf, streamsize n)
+{
+ _IO_ssize_t count = fwrite(buf, 1, n, _file);
+ if (_offset >= 0)
+ _offset += n;
+ return count;
+}
+
+streampos stdiobuf::sys_seek(streamoff offset, _seek_dir dir)
+{
+ // Normally, equivalent to: fdir=dir
+ int fdir =
+ (dir == ios::beg) ? SEEK_SET :
+ (dir == ios::cur) ? SEEK_CUR :
+ (dir == ios::end) ? SEEK_END :
+ dir;
+ return fseek(_file, offset, fdir);
+}
+
+int stdiobuf::sys_close()
+{
+ int status = fclose(_file);
+ _file = NULL;
+ return status;
+}
+
+int stdiobuf::sync()
+{
+ if (_IO_do_flush((_IO_FILE*)this))
+ return EOF;
+ if (!(xflags() & _IO_NO_WRITES))
+ if (fflush(_file))
+ return EOF;
+ return 0;
+}
+
+int stdiobuf::overflow(int c /* = EOF*/)
+{
+ if (filebuf::overflow(c) == EOF)
+ return EOF;
+ if (c != EOF)
+ return c;
+ return fflush(_file);
+}
+
+streamsize stdiobuf::xsputn(const char* s, streamsize n)
+{
+ if (buffered ())
+ {
+ // The filebuf implementation of sputn loses.
+ return streambuf::xsputn(s, n);
+ }
+ else
+ return fwrite (s, 1, n, _file);
+}
+
+void stdiobuf::buffered (int b)
+{
+ if (b)
+ {
+ if (_flags & _IO_UNBUFFERED)
+ { /* Was unbuffered, make it buffered. */
+ _flags &= ~_IO_UNBUFFERED;
+ }
+ }
+ else
+ {
+ if (!(_flags & _IO_UNBUFFERED))
+ { /* Was buffered, make it unbuffered. */
+ setbuf(NULL, 0);
+ }
+ }
+}
diff --git a/libio/stdiostream.h b/libio/stdiostream.h
new file mode 100644
index 00000000000..b973d7a39b6
--- /dev/null
+++ b/libio/stdiostream.h
@@ -0,0 +1,79 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifndef _STDIOSTREAM_H
+#define _STDIOSTREAM_H
+
+#ifdef __GNUG__
+#pragma interface
+#endif
+
+#include <iostream.h>
+#include <stdio.h>
+
+extern "C++" {
+class stdiobuf : public filebuf {
+ protected:
+ FILE *_file;
+ public:
+ FILE* stdiofile() const { return _file; }
+ stdiobuf(FILE *);
+ ~stdiobuf();
+ int buffered () const { return _flags & _IO_UNBUFFERED ? 0 : 1; }
+ void buffered (int);
+ virtual streamsize sys_read(char*, streamsize);
+ virtual streampos sys_seek(streamoff, _seek_dir);
+ virtual streamsize sys_write(const char*, streamsize);
+ virtual int sys_close();
+ virtual int sync();
+ virtual int overflow(int c = EOF);
+ streamsize xsputn(const char* s, streamsize n);
+};
+
+class istdiostream : public istream
+{
+private:
+ stdiobuf _file;
+public:
+ istdiostream (FILE* __f) : istream(), _file(__f) { init(&_file); }
+ stdiobuf* rdbuf()/* const */ { return &_file; }
+ int buffered () const { return _file.buffered (); }
+ void buffered (int _i) { _file.buffered (_i); }
+};
+
+class ostdiostream : public ostream
+{
+private:
+ stdiobuf _file;
+public:
+ ostdiostream (FILE* __f) : ostream(), _file(__f) { init(&_file); }
+ stdiobuf* rdbuf() /* const */ { return &_file; }
+ int buffered () const { return _file.buffered (); }
+ void buffered (int _i) { _file.buffered (_i); }
+};
+} // extern "C++"
+
+#endif /* !_STDIOSTREAM_H */
diff --git a/libio/stdstrbufs.cc b/libio/stdstrbufs.cc
new file mode 100644
index 00000000000..8af259988a5
--- /dev/null
+++ b/libio/stdstrbufs.cc
@@ -0,0 +1,115 @@
+/*
+Copyright (C) 1994 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+
+/* This file provides definitions of _IO_stdin, _IO_stdout, and _IO_stderr
+ for C++ code. Compare stdfiles.c.
+ (The difference is that here the vtable field is set to
+ point to builtinbuf's vtable, so the objects are effectively
+ of class builtinbuf.) */
+
+#include "libioP.h"
+#include <stdio.h>
+
+#if !defined(filebuf_vtable) && defined(__cplusplus)
+#ifdef __GNUC__
+extern char filebuf_vtable[]
+ asm (_G_VTABLE_LABEL_PREFIX
+#if _G_VTABLE_LABEL_HAS_LENGTH
+ "7"
+#endif
+ "filebuf");
+#else /* !__GNUC__ */
+#if _G_VTABLE_LABEL_HAS_LENGTH
+#define filebuf_vtable _G_VTABLE_LABEL_PREFIX_ID##7filebuf
+#else
+#define filebuf_vtable _G_VTABLE_LABEL_PREFIX_ID##filebuf
+#endif
+extern char filebuf_vtable[];
+#endif /* !__GNUC__ */
+#endif /* !defined(filebuf_vtable) && defined(__cplusplus) */
+
+#ifndef STD_VTABLE
+#define STD_VTABLE (const struct _IO_jump_t *)filebuf_vtable
+#endif
+
+#define DEF_STDFILE(NAME, FD, CHAIN, FLAGS) \
+ struct _IO_FILE_plus NAME = {FILEBUF_LITERAL(CHAIN, FLAGS, FD), STD_VTABLE}
+
+DEF_STDFILE(_IO_stdin_, 0, 0, _IO_NO_WRITES);
+DEF_STDFILE(_IO_stdout_, 1, &_IO_stdin_.file, _IO_NO_READS);
+DEF_STDFILE(_IO_stderr_, 2, &_IO_stdout_.file,
+ _IO_NO_READS+_IO_UNBUFFERED);
+
+#ifdef _STDIO_USES_IOSTREAM
+_IO_FILE *_IO_list_all = &_IO_stderr_.file;
+#else /* !_STDIO_USES_IOSTREAM */
+#include "stdiostream.h"
+
+struct _IO_fake_stdiobuf {
+ struct {
+ _IO_FILE file;
+ const void *vtable;
+ } s;
+ FILE *stdio_file;
+};
+
+/* Define stdiobuf_vtable as a name for the virtual function table
+ of the stdiobuf class. */
+#ifndef stdiobuf_vtable
+#ifdef __GNUC__
+extern struct _IO_jump_t stdiobuf_vtable
+ asm (_G_VTABLE_LABEL_PREFIX
+#if _G_VTABLE_LABEL_HAS_LENGTH
+ "8"
+#endif
+ "stdiobuf");
+#else /* !__GNUC__ */
+#if _G_VTABLE_LABEL_HAS_LENGTH
+#define stdiobuf_vtable _G_VTABLE_LABEL_PREFIX_ID##8stdiobuf
+#else
+#define stdiobuf_vtable _G_VTABLE_LABEL_PREFIX_ID##stdiobuf
+#endif
+extern struct _IO_jump_t stdiobuf_vtable;
+#endif /* !__GNUC__ */
+#endif /* !stdiobuf_vtable */
+
+#if _IO_UNIFIED_JUMPTABLES
+#define JUMP_PTR /* Nothing */
+#else
+#define JUMP_PTR &_IO_streambuf_jumps,
+#endif
+
+#define DEF_STDIOFILE(NAME, FD, FILE, FLAGS, CHAIN) \
+ struct _IO_fake_stdiobuf NAME = \
+ {{{ _IO_MAGIC+_IO_LINKED+_IO_IS_FILEBUF+_IO_UNBUFFERED+FLAGS, \
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, CHAIN, JUMP_PTR FD},\
+ &stdiobuf_vtable}, FILE}
+
+DEF_STDIOFILE(_IO_stdin_buf, 0, stdin, _IO_NO_WRITES, &_IO_stderr_.file);
+DEF_STDIOFILE(_IO_stdout_buf, 1, stdout, _IO_NO_READS, &_IO_stdin_buf.s.file);
+DEF_STDIOFILE(_IO_stderr_buf, 2, stderr, _IO_NO_READS, &_IO_stdout_buf.s.file);
+
+_IO_FILE *_IO_list_all = &_IO_stderr_buf.s.file;
+#endif /* !_STDIO_USES_IOSTREAM */
diff --git a/libio/stdstreams.cc b/libio/stdstreams.cc
new file mode 100644
index 00000000000..a5889d738e2
--- /dev/null
+++ b/libio/stdstreams.cc
@@ -0,0 +1,153 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#include "libioP.h"
+#include "streambuf.h"
+#include <stdio.h>
+
+// The ANSI draft requires that operations on cin/cout/cerr can be
+// mixed with operations on stdin/stdout/stderr on a character by
+// character basis. This normally requires that the streambuf's
+// used by cin/cout/cerr be stdiostreams. However, if the stdio
+// implementation is the one that is built using this library,
+// then we don't need to, since in that case stdin/stdout/stderr
+// are identical to _IO_stdin/_IO_stdout/_IO_stderr.
+
+#include "libio.h"
+
+#ifdef _STDIO_USES_IOSTREAM
+#define CIN_SBUF _IO_stdin_
+#define COUT_SBUF _IO_stdout_
+#define CERR_SBUF _IO_stderr_
+static int use_stdiobuf = 0;
+#else
+#define CIN_SBUF _IO_stdin_buf
+#define COUT_SBUF _IO_stdout_buf
+#define CERR_SBUF _IO_stderr_buf
+static int use_stdiobuf = 1;
+#endif
+
+#define cin CIN
+#define cout COUT
+#define cerr CERR
+#define clog CLOG
+#include "iostream.h"
+#undef cin
+#undef cout
+#undef cerr
+#undef clog
+
+#ifdef __GNUG__
+#define PAD 0 /* g++ allows 0-length arrays. */
+#else
+#define PAD 1
+#endif
+struct _fake_istream {
+ struct myfields {
+#ifdef __GNUC__
+ _ios_fields *vb; /* pointer to virtual base class ios */
+ _IO_ssize_t _gcount;
+#else
+ /* This is supposedly correct for cfront. */
+ _IO_ssize_t _gcount;
+ void *vptr;
+ _ios_fields *vb; /* pointer to virtual base class ios */
+#endif
+ } mine;
+ _ios_fields base;
+ char filler[sizeof(struct istream)-sizeof(struct _ios_fields)+PAD];
+};
+struct _fake_ostream {
+ struct myfields {
+#ifndef __GNUC__
+ void *vptr;
+#endif
+ _ios_fields *vb; /* pointer to virtual base class ios */
+ } mine;
+ _ios_fields base;
+ char filler[sizeof(struct ostream)-sizeof(struct _ios_fields)+PAD];
+};
+
+
+#ifdef _IO_NEW_STREAMS
+#define STD_STR(SBUF, TIE, EXTRA_FLAGS) \
+ (streambuf*)&SBUF, TIE, 0, ios::skipws|ios::dec|EXTRA_FLAGS, ' ',0,0,6
+#else
+#define STD_STR(SBUF, TIE, EXTRA_FLAGS) \
+ (streambuf*)&SBUF, TIE, 0, ios::dont_close|ios::dec|ios::skipws|EXTRA_FLAGS, ' ',0,0,6
+#endif
+
+#ifdef __GNUC__
+#define OSTREAM_DEF(NAME, SBUF, TIE, EXTRA_FLAGS, ASM) \
+ _fake_ostream NAME ASM = { {&NAME.base}, {STD_STR(SBUF, TIE, EXTRA_FLAGS) }};
+#define ISTREAM_DEF(NAME, SBUF, TIE, EXTRA_FLAGS) \
+ _fake_istream NAME = { {&NAME.base}, {STD_STR(SBUF, TIE, EXTRA_FLAGS) }};
+#else
+#define OSTREAM_DEF(NAME, SBUF, TIE, EXTRA_FLAGS) \
+ _fake_ostream NAME = { {0, &NAME.base}, {STD_STR(SBUF, TIE, EXTRA_FLAGS) }};
+#define ISTREAM_DEF(NAME, SBUF, TIE, EXTRA_FLAGS) \
+ _fake_istream NAME = {{0, 0, &NAME.base}, {STD_STR(SBUF, TIE, EXTRA_FLAGS)}};
+#endif
+
+OSTREAM_DEF(cout, COUT_SBUF, NULL, 0, )
+OSTREAM_DEF(cerr, CERR_SBUF,(ostream*)&cout, ios::unitbuf, )
+ISTREAM_DEF(cin, CIN_SBUF, (ostream*)&cout, 0)
+
+/* Only for (partial) compatibility with AT&T's library. */
+#if _G_CLOG_CONFLICT
+OSTREAM_DEF(clog, CERR_SBUF, (ostream*)&cout, 0, __asm__ ("__IO_clog"))
+#else
+OSTREAM_DEF(clog, CERR_SBUF, (ostream*)&cout, 0, )
+#endif
+
+// Switches between using _IO_std{in,out,err} and __std{in,out,err}_buf
+// for standard streams. This does not normally need to be called
+// explicitly, but is provided for AT&T compatibility.
+
+int ios::sync_with_stdio(int new_state)
+{
+#ifdef _STDIO_USES_IOSTREAM
+ // It is always synced.
+ return 0;
+#else
+ if (new_state == use_stdiobuf) // The usual case now.
+ return use_stdiobuf;
+ if (new_state) {
+ cin.base._strbuf = (streambuf*)&_IO_stdin_buf;
+ cout.base._strbuf = (streambuf*)&_IO_stdout_buf;
+ cerr.base._strbuf = (streambuf*)&_IO_stderr_buf;
+ clog.base._strbuf = (streambuf*)&_IO_stderr_buf;
+ } else {
+ cin.base._strbuf = (streambuf*)_IO_stdin;
+ cout.base._strbuf = (streambuf*)_IO_stdout;
+ cerr.base._strbuf = (streambuf*)_IO_stderr;
+ clog.base._strbuf = (streambuf*)_IO_stderr;
+ }
+ int old_state = use_stdiobuf;
+ use_stdiobuf = new_state;
+ return old_state;
+#endif
+}
diff --git a/libio/stream.cc b/libio/stream.cc
new file mode 100644
index 00000000000..3440a0c9bdb
--- /dev/null
+++ b/libio/stream.cc
@@ -0,0 +1,170 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <stdarg.h>
+#include <string.h>
+#include "libioP.h"
+#include "stream.h"
+#include "strstream.h"
+
+static char Buffer[_IO_BUFSIZ];
+#define EndBuffer (Buffer+_IO_BUFSIZ)
+static char* next_chunk = Buffer; // Start of available part of Buffer.
+
+char* form(const char* format, ...)
+{
+ int space_left = EndBuffer - next_chunk;
+ // If less that 25% of the space is available start over.
+ if (space_left < (_IO_BUFSIZ>>2))
+ next_chunk = Buffer;
+ char* buf = next_chunk;
+
+ strstreambuf stream(buf, EndBuffer-buf-1, buf);
+ va_list ap;
+ va_start(ap, format);
+ int count = stream.vform(format, ap);
+ va_end(ap);
+ stream.sputc(0);
+ next_chunk = buf + stream.pcount();
+ return buf;
+}
+
+#define u_long unsigned long
+
+static char* itoa(unsigned long i, int size, int neg, int base)
+{
+ // Conservative estimate: If base==2, might need 8 characters
+ // for each input byte, but normally 3 is plenty.
+ int needed = size ? size
+ : (base >= 8 ? 3 : 8) * sizeof(unsigned long) + 2;
+ int space_left = EndBuffer - next_chunk;
+ if (space_left <= needed)
+ next_chunk = Buffer; // start over.
+
+ char* buf = next_chunk;
+
+ register char* ptr = buf+needed+1;
+ next_chunk = ptr;
+
+ if (needed < (2+neg) || ptr > EndBuffer)
+ return NULL;
+ *--ptr = 0;
+
+ if (i == 0)
+ *--ptr = '0';
+ while (i != 0 && ptr > buf) {
+ int ch = i % base;
+ i = i / base;
+ if (ch >= 10)
+ ch += 'a' - 10;
+ else
+ ch += '0';
+ *--ptr = ch;
+ }
+ if (neg)
+ *--ptr = '-';
+ if (size == 0)
+ return ptr;
+ while (ptr > buf)
+ *--ptr = ' ';
+ return buf;
+}
+
+char* dec(long i, int len /* = 0 */)
+{
+ if (i >= 0) return itoa((unsigned long)i, len, 0, 10);
+ else return itoa((unsigned long)(-i), len, 1, 10);
+}
+char* dec(int i, int len /* = 0 */)
+{
+ if (i >= 0) return itoa((unsigned long)i, len, 0, 10);
+ else return itoa((unsigned long)(-i), len, 1, 10);
+}
+char* dec(unsigned long i, int len /* = 0 */)
+{
+ return itoa(i, len, 0, 10);
+}
+char* dec(unsigned int i, int len /* = 0 */)
+{
+ return itoa(i, len, 0, 10);
+}
+
+char* hex(long i, int len /* = 0 */)
+{
+ return itoa((unsigned long)i, len, 0, 16);
+}
+char* hex(int i, int len /* = 0 */)
+{
+ return itoa((unsigned long)i, len, 0, 16);
+}
+char* hex(unsigned long i, int len /* = 0 */)
+{
+ return itoa(i, len, 0, 16);
+}
+char* hex(unsigned int i, int len /* = 0 */)
+{
+ return itoa(i, len, 0, 16);
+}
+
+char* oct(long i, int len /* = 0 */)
+{
+ return itoa((unsigned long)i, len, 0, 8);
+}
+char* oct(int i, int len /* = 0 */)
+{
+ return itoa((unsigned long)i, len, 0, 8);
+}
+char* oct(unsigned long i, int len /* = 0 */)
+{
+ return itoa(i, len, 0, 8);
+}
+char* oct(unsigned int i, int len /* = 0 */)
+{
+ return itoa(i, len, 0, 8);
+}
+
+static char *str(const char* s, int len, int width)
+{
+ if (width < len)
+ width = len;
+ int space_left = EndBuffer - next_chunk;
+ if (space_left <= width + 1)
+ next_chunk = Buffer; // start over.
+ char* buf = next_chunk;
+ memset (buf, ' ', width - len);
+ memcpy (buf + width - len, s, len);
+ buf[width] = 0;
+ return buf;
+}
+
+char* str(const char* s, int width)
+{
+ return str (s, strlen (s), width);
+}
+
+char* chr(char ch, int width)
+{
+ char c = ch;
+ return str (&c, 1, width);
+}
diff --git a/libio/stream.h b/libio/stream.h
new file mode 100644
index 00000000000..0859802ade6
--- /dev/null
+++ b/libio/stream.h
@@ -0,0 +1,59 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifndef _COMPAT_STREAM_H
+#define _COMPAT_STREAM_H
+
+// Compatibility with old library.
+// DO NOT USE THESE FUNCTIONS IN NEW CODE!
+// They are obsolete, non-standard, and non-reentrant.
+
+#define _STREAM_COMPAT
+#include <iostream.h>
+
+extern "C++" {
+extern char* form(const char*, ...);
+
+extern char* dec(long, int=0);
+extern char* dec(int, int=0);
+extern char* dec(unsigned long, int=0);
+extern char* dec(unsigned int, int=0);
+
+extern char* hex(long, int=0);
+extern char* hex(int, int=0);
+extern char* hex(unsigned long, int=0);
+extern char* hex(unsigned int, int=0);
+
+extern char* oct(long, int=0);
+extern char* oct(int, int=0);
+extern char* oct(unsigned long, int=0);
+extern char* oct(unsigned int, int=0);
+
+char* chr(char ch, int width = 0);
+char* str(const char* s, int width = 0);
+
+inline istream& WS(istream& str) { return ws(str); }
+} // extern "C++"
+
+#endif /* !_COMPAT_STREAM_H */
diff --git a/libio/streambuf.cc b/libio/streambuf.cc
new file mode 100644
index 00000000000..d66af097aa5
--- /dev/null
+++ b/libio/streambuf.cc
@@ -0,0 +1,343 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1991, 1992, 1993, 1995 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#define _STREAM_COMPAT
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#include "iostreamP.h"
+#include <string.h>
+#include <stdarg.h>
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+
+void streambuf::_un_link() { _IO_un_link(this); }
+
+void streambuf::_link_in() { _IO_link_in(this); }
+
+int streambuf::switch_to_get_mode()
+{ return _IO_switch_to_get_mode(this); }
+
+void streambuf::free_backup_area()
+{ _IO_free_backup_area(this); }
+
+#if 0
+int streambuf::switch_to_put_mode()
+{ return _IO_:switch_to_put_mode(this); }
+#endif
+
+int __overflow(streambuf* sb, int c)
+{
+ return sb->overflow(c);
+}
+
+int streambuf::underflow()
+{ return EOF; }
+
+int streambuf::uflow()
+{ return _IO_default_uflow (this); }
+
+int streambuf::overflow(int /* = EOF */)
+{ return EOF; }
+
+streamsize streambuf::xsputn(register const char* s, streamsize n)
+{ return _IO_default_xsputn(this, s, n); }
+
+streamsize streambuf::xsgetn(char* s, streamsize n)
+{ return _IO_default_xsgetn(this, s, n); }
+
+int streambuf::ignore(int n)
+{
+ register int more = n;
+ for (;;) {
+ int count = _IO_read_end - _IO_read_ptr; // Data available.
+ if (count > 0) {
+ if (count > more)
+ count = more;
+ _IO_read_ptr += count;
+ more -= count;
+ }
+ if (more == 0 || __underflow(this) == EOF)
+ break;
+ }
+ return n - more;
+}
+
+int streambuf::sync()
+{
+ return 0;
+}
+
+int streambuf::pbackfail(int c)
+{
+ return _IO_default_pbackfail(this, c);
+}
+
+streambuf* streambuf::setbuf(char* p, int len)
+{
+ if (sync() == EOF)
+ return NULL;
+ if (p == NULL || len == 0) {
+ unbuffered(1);
+ setb(_shortbuf, _shortbuf+1, 0);
+ }
+ else {
+ unbuffered(0);
+ setb(p, p+len, 0);
+ }
+ setp(0, 0);
+ setg(0, 0, 0);
+ return this;
+}
+
+streampos streambuf::seekpos(streampos pos, int mode)
+{
+ return seekoff(pos, ios::beg, mode);
+}
+
+streampos streambuf::sseekpos(streampos pos, int mode)
+{
+ return _IO_seekpos (this, pos, mode);
+}
+
+void streambuf::setb(char* b, char* eb, int a)
+{ _IO_setb(this, b, eb, a); }
+
+int streambuf::doallocate() { return _IO_default_doallocate(this); }
+
+void streambuf::doallocbuf() { _IO_doallocbuf(this); }
+
+#if !_IO_UNIFIED_JUMPTABLES
+/* The following are jump table entries that just call the virtual method */
+
+static int _IO_sb_overflow(_IO_FILE *fp, int c)
+{ return ((streambuf*)fp)->overflow(c); }
+static int _IO_sb_underflow(_IO_FILE *fp)
+{ return ((streambuf*)fp)->underflow(); }
+static _IO_size_t _IO_sb_xsputn(_IO_FILE *fp, const void *s, _IO_size_t n)
+{ return ((streambuf*)fp)->xsputn((const char*)s, n); }
+static _IO_size_t _IO_sb_xsgetn(_IO_FILE *fp, void *s, _IO_size_t n)
+{ return ((streambuf*)fp)->xsgetn((char*)s, n); }
+static int _IO_sb_close(_IO_FILE *fp)
+{ return ((streambuf*)fp)->sys_close(); }
+static int _IO_sb_stat(_IO_FILE *fp, void *b)
+{ return ((streambuf*)fp)->sys_stat(b); }
+static int _IO_sb_doallocate(_IO_FILE *fp)
+{ return ((streambuf*)fp)->doallocate(); }
+
+static _IO_pos_t _IO_sb_seekoff(_IO_FILE *fp, _IO_off_t pos, int dir, int mode)
+{
+ return ((streambuf*)fp)->seekoff(pos, (ios::seek_dir)dir, mode);
+}
+
+static _IO_pos_t _IO_sb_seekpos(_IO_FILE *fp, _IO_pos_t pos, int mode)
+{
+ return ((streambuf*)fp)->seekpos(pos, mode);
+}
+
+static int _IO_sb_pbackfail(_IO_FILE *fp, int ch)
+{ return ((streambuf*)fp)->pbackfail(ch); }
+static void _IO_sb_finish(_IO_FILE *fp)
+{ ((streambuf*)fp)->~streambuf(); }
+static _IO_ssize_t _IO_sb_read(_IO_FILE *fp, void *buf, _IO_ssize_t n)
+{ return ((streambuf*)fp)->sys_read((char*)buf, n); }
+static _IO_ssize_t _IO_sb_write(_IO_FILE *fp, const void *buf, _IO_ssize_t n)
+{ return ((streambuf*)fp)->sys_write((const char*)buf, n); }
+static int _IO_sb_sync(_IO_FILE *fp)
+{ return ((streambuf*)fp)->sync(); }
+static _IO_pos_t _IO_sb_seek(_IO_FILE *fp, _IO_off_t off, int dir)
+{ return ((streambuf*)fp)->sys_seek(off, (_seek_dir)dir); }
+static _IO_FILE* _IO_sb_setbuf(_IO_FILE *fp, char *buf, _IO_ssize_t n)
+{ return ((streambuf*)fp)->setbuf(buf, n); }
+
+/* This callbacks in this jumptable just call the corresponding
+ virtual function, so that C functions can access (potentially user-defined)
+ streambuf-derived objects.
+ Contrast the builtinbuf class, which does the converse: Allow
+ C++ virtual calls to to be used on _IO_FILE objects that are builtin
+ (or defined by C code). */
+
+
+struct _IO_jump_t _IO_streambuf_jumps = {
+ JUMP_INIT_DUMMY,
+ JUMP_INIT(finish, _IO_sb_finish),
+ JUMP_INIT(overflow, _IO_sb_overflow),
+ JUMP_INIT(underflow, _IO_sb_underflow),
+ JUMP_INIT(uflow, _IO_default_uflow),
+ JUMP_INIT(pbackfail, _IO_sb_pbackfail),
+ JUMP_INIT(xsputn, _IO_sb_xsputn),
+ JUMP_INIT(xsgetn, _IO_sb_xsgetn),
+ JUMP_INIT(seekoff, _IO_sb_seekoff),
+ JUMP_INIT(seekpos, _IO_sb_seekpos),
+ JUMP_INIT(setbuf, _IO_sb_setbuf),
+ JUMP_INIT(sync, _IO_sb_sync),
+ JUMP_INIT(doallocate, _IO_sb_doallocate),
+ JUMP_INIT(read, _IO_sb_read),
+ JUMP_INIT(write, _IO_sb_write),
+ JUMP_INIT(seek, _IO_sb_seek),
+ JUMP_INIT(close, _IO_sb_close),
+ JUMP_INIT(stat, _IO_sb_stat)
+};
+#endif
+
+streambuf::streambuf(int flags)
+{
+ _IO_init(this, flags);
+#if !_IO_UNIFIED_JUMPTABLES
+ _jumps = &_IO_streambuf_jumps;
+#endif
+}
+
+streambuf::~streambuf() { _IO_default_finish(this); }
+
+streampos
+streambuf::seekoff(streamoff, _seek_dir, int /*=ios::in|ios::out*/)
+{
+ return EOF;
+}
+
+streampos
+streambuf::sseekoff(streamoff o , _seek_dir d, int m /*=ios::in|ios::out*/)
+{
+ return _IO_seekoff (this, o, d, m);
+}
+
+int streambuf::sputbackc(char c)
+{
+ return _IO_sputbackc(this, c);
+}
+
+int streambuf::sungetc()
+{
+ return _IO_sungetc(this);
+}
+
+#if 0 /* Work in progress */
+void streambuf::collumn(int c)
+{
+ if (c == -1)
+ _collumn = -1;
+ else
+ _collumn = c - (_IO_write_ptr - _IO_write_base);
+}
+#endif
+
+
+int streambuf::get_column()
+{
+ if (_cur_column)
+ return _IO_adjust_column(_cur_column - 1, pbase(), pptr() - pbase());
+ return -1;
+}
+
+int streambuf::set_column(int i)
+{
+ _cur_column = i+1;
+ return 0;
+}
+
+int streambuf::flush_all() { return _IO_flush_all (); }
+
+void streambuf::flush_all_linebuffered()
+{ _IO_flush_all_linebuffered(); }
+
+int streambuf::sys_stat(void *)
+{
+#ifdef EIO
+ errno = EIO;
+#endif
+ return -1;
+}
+
+streamsize streambuf::sys_read(char* /*buf*/, streamsize /*size*/)
+{
+ return 0;
+}
+
+streamsize streambuf::sys_write(const char* /*buf*/, streamsize /*size*/)
+{
+ return 0;
+}
+
+streampos streambuf::sys_seek(streamoff, _seek_dir)
+{
+ return EOF;
+}
+
+int streambuf::sys_close() { return 0; /* Suceess; do nothing */ }
+
+streammarker::streammarker(streambuf *sb)
+{
+ _IO_init_marker(this, sb);
+}
+
+streammarker::~streammarker()
+{
+ _IO_remove_marker(this);
+}
+
+#define BAD_DELTA EOF
+
+int streammarker::delta(streammarker& other_mark)
+{
+ return _IO_marker_difference(this, &other_mark);
+}
+
+int streammarker::delta()
+{
+ return _IO_marker_delta(this);
+}
+
+int streambuf::seekmark(streammarker& mark, int delta /* = 0 */)
+{
+ return _IO_seekmark(this, &mark, delta);
+}
+
+void streambuf::unsave_markers()
+{
+ _IO_unsave_markers(this);
+}
+
+int ios::readable() { return !(rdbuf()->_flags & _IO_NO_READS); }
+int ios::writable() { return !(rdbuf()->_flags & _IO_NO_WRITES); }
+int ios::is_open() { return rdbuf()
+ && (rdbuf()->_flags & _IO_NO_READS+_IO_NO_WRITES)
+ != _IO_NO_READS+_IO_NO_WRITES; }
+
+#if defined(linux)
+#define IO_CLEANUP
+#endif
+
+#ifdef IO_CLEANUP
+ IO_CLEANUP
+#else
+struct __io_defs {
+ ~__io_defs() { _IO_cleanup (); }
+};
+__io_defs io_defs__;
+#endif
diff --git a/libio/streambuf.h b/libio/streambuf.h
new file mode 100644
index 00000000000..ea9a5478c26
--- /dev/null
+++ b/libio/streambuf.h
@@ -0,0 +1,475 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#ifndef _STREAMBUF_H
+#define _STREAMBUF_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+
+/* #define _G_IO_THROW */ /* Not implemented: ios::failure */
+
+#define _IO_NEW_STREAMS // new optimizated stream representation
+
+extern "C" {
+#include <libio.h>
+}
+//#include <_G_config.h>
+#ifdef _IO_NEED_STDARG_H
+#include <stdarg.h>
+#endif
+#ifndef _IO_va_list
+#define _IO_va_list char *
+#endif
+
+#ifndef EOF
+#define EOF (-1)
+#endif
+#ifndef NULL
+#ifdef __GNUG__
+#define NULL (__null)
+#else
+#define NULL (0)
+#endif
+#endif
+
+#ifndef _IO_wchar_t
+#define _IO_wchar_t short
+#endif
+
+extern "C++" {
+class istream; /* Work-around for a g++ name mangling bug. Fixed in 2.6. */
+class ostream; class streambuf;
+
+// In case some header files defines these as macros.
+#undef open
+#undef close
+
+typedef _IO_off_t streamoff;
+typedef _IO_fpos_t streampos;
+typedef _IO_ssize_t streamsize;
+
+typedef unsigned long __fmtflags;
+typedef unsigned char __iostate;
+
+struct _ios_fields
+{ // The data members of an ios.
+ streambuf *_strbuf;
+ ostream* _tie;
+ int _width;
+ __fmtflags _flags;
+ _IO_wchar_t _fill;
+ __iostate _state;
+ __iostate _exceptions;
+ int _precision;
+
+ void *_arrays; /* Support for ios::iword and ios::pword. */
+};
+
+#define _IOS_GOOD 0
+#define _IOS_EOF 1
+#define _IOS_FAIL 2
+#define _IOS_BAD 4
+
+#define _IO_INPUT 1
+#define _IO_OUTPUT 2
+#define _IO_ATEND 4
+#define _IO_APPEND 8
+#define _IO_TRUNC 16
+#define _IO_NOCREATE 32
+#define _IO_NOREPLACE 64
+#define _IO_BIN 128
+
+#ifdef _STREAM_COMPAT
+enum state_value {
+ _good = _IOS_GOOD,
+ _eof = _IOS_EOF,
+ _fail = _IOS_FAIL,
+ _bad = _IOS_BAD };
+enum open_mode {
+ input = _IO_INPUT,
+ output = _IO_OUTPUT,
+ atend = _IO_ATEND,
+ append = _IO_APPEND };
+#endif
+
+class ios : public _ios_fields {
+ ios& operator=(ios&); /* Not allowed! */
+ ios (const ios&); /* Not allowed! */
+ public:
+ typedef __fmtflags fmtflags;
+ typedef int iostate;
+ typedef int openmode;
+ typedef int streamsize;
+ enum io_state {
+ goodbit = _IOS_GOOD,
+ eofbit = _IOS_EOF,
+ failbit = _IOS_FAIL,
+ badbit = _IOS_BAD };
+ enum open_mode {
+ in = _IO_INPUT,
+ out = _IO_OUTPUT,
+ ate = _IO_ATEND,
+ app = _IO_APPEND,
+ trunc = _IO_TRUNC,
+ nocreate = _IO_NOCREATE,
+ noreplace = _IO_NOREPLACE,
+ bin = _IOS_BIN, // Deprecated - ANSI uses ios::binary.
+ binary = _IOS_BIN };
+ enum seek_dir { beg, cur, end};
+ // ANSI: typedef enum seek_dir seekdir; etc
+ // NOTE: If adding flags here, before to update ios::bitalloc().
+ enum { skipws=_IO_SKIPWS,
+ left=_IO_LEFT, right=_IO_RIGHT, internal=_IO_INTERNAL,
+ dec=_IO_DEC, oct=_IO_OCT, hex=_IO_HEX,
+ showbase=_IO_SHOWBASE, showpoint=_IO_SHOWPOINT,
+ uppercase=_IO_UPPERCASE, showpos=_IO_SHOWPOS,
+ scientific=_IO_SCIENTIFIC, fixed=_IO_FIXED,
+ unitbuf=_IO_UNITBUF, stdio=_IO_STDIO
+#ifndef _IO_NEW_STREAMS
+ , dont_close=_IO_DONT_CLOSE // Don't delete streambuf on stream destruction
+#endif
+ };
+ enum { // Masks.
+ basefield=dec+oct+hex,
+ floatfield = scientific+fixed,
+ adjustfield = left+right+internal
+ };
+
+#ifdef _IO_THROW
+ class failure : public xmsg {
+ ios* _stream;
+ public:
+ failure(ios* stream) { _stream = stream; }
+ failure(string cause, ios* stream) { _stream = stream; }
+ ios* rdios() const { return _stream; }
+ };
+#endif
+
+ ostream* tie() const { return _tie; }
+ ostream* tie(ostream* val) { ostream* save=_tie; _tie=val; return save; }
+
+ // Methods to change the format state.
+ _IO_wchar_t fill() const { return (_IO_wchar_t)_fill; }
+ _IO_wchar_t fill(_IO_wchar_t newf)
+ {_IO_wchar_t oldf = (_IO_wchar_t)_fill; _fill = (char)newf; return oldf;}
+ fmtflags flags() const { return _flags; }
+ fmtflags flags(fmtflags new_val) {
+ fmtflags old_val = _flags; _flags = new_val; return old_val; }
+ int precision() const { return _precision; }
+ int precision(int newp) {
+ unsigned short oldp = _precision; _precision = (unsigned short)newp;
+ return oldp; }
+ fmtflags setf(fmtflags val) {
+ fmtflags oldbits = _flags;
+ _flags |= val; return oldbits; }
+ fmtflags setf(fmtflags val, fmtflags mask) {
+ fmtflags oldbits = _flags;
+ _flags = (_flags & ~mask) | (val & mask); return oldbits; }
+ fmtflags unsetf(fmtflags mask) {
+ fmtflags oldbits = _flags;
+ _flags &= ~mask; return oldbits; }
+ int width() const { return _width; }
+ int width(int val) { int save = _width; _width = val; return save; }
+
+#ifdef _IO_THROW
+ void _throw_failure() const { throw new ios::failure(this); }
+#else
+ void _throw_failure() const { }
+#endif
+ void clear(iostate state = 0) {
+ _state = _strbuf ? state : state|badbit;
+ if (_state & _exceptions) _throw_failure(); }
+ void set(iostate flag) { _state |= flag;
+ if (_state & _exceptions) _throw_failure(); }
+ void setstate(iostate flag) { _state |= flag; // ANSI
+ if (_state & _exceptions) _throw_failure(); }
+ int good() const { return _state == 0; }
+ int eof() const { return _state & ios::eofbit; }
+ int fail() const { return _state & (ios::badbit|ios::failbit); }
+ int bad() const { return _state & ios::badbit; }
+ iostate rdstate() const { return _state; }
+ operator void*() const { return fail() ? (void*)0 : (void*)(-1); }
+ int operator!() const { return fail(); }
+ iostate exceptions() const { return _exceptions; }
+ void exceptions(iostate enable) {
+ _exceptions = enable;
+ if (_state & _exceptions) _throw_failure(); }
+
+ streambuf* rdbuf() const { return _strbuf; }
+ streambuf* rdbuf(streambuf *_s) {
+ streambuf *_old = _strbuf; _strbuf = _s; clear (); return _old; }
+
+ static int sync_with_stdio(int on);
+ static void sync_with_stdio() { sync_with_stdio(1); }
+ static fmtflags bitalloc();
+ static int xalloc();
+ void*& pword(int);
+ void* pword(int) const;
+ long& iword(int);
+ long iword(int) const;
+
+#ifdef _STREAM_COMPAT
+ void unset(state_value flag) { _state &= ~flag; }
+ void close();
+ int is_open();
+ int readable();
+ int writable();
+#endif
+
+ // Used to initialize standard streams. Not needed in this implementation.
+ class Init {
+ public:
+ Init () { }
+ };
+
+ protected:
+ inline ios(streambuf* sb = 0, ostream* tie_to = 0);
+ inline virtual ~ios();
+ inline void init(streambuf* sb, ostream* tie = 0);
+};
+
+#if __GNUG__==1
+typedef int _seek_dir;
+#else
+typedef ios::seek_dir _seek_dir;
+#endif
+
+// Magic numbers and bits for the _flags field.
+// The magic numbers use the high-order bits of _flags;
+// the remaining bits are abailable for variable flags.
+// Note: The magic numbers must all be negative if stdio
+// emulation is desired.
+
+// A streammarker remembers a position in a buffer.
+// You are guaranteed to be able to seek back to it if it is saving().
+class streammarker : private _IO_marker {
+ friend class streambuf;
+ void set_offset(int offset) { _pos = offset; }
+ public:
+ streammarker(streambuf *sb);
+ ~streammarker();
+ int saving() { return 1; }
+ int delta(streammarker&);
+ int delta();
+};
+
+struct streambuf : public _IO_FILE { // protected??
+ friend class ios;
+ friend class istream;
+ friend class ostream;
+ friend class streammarker;
+ const void *&_vtable() { return *(const void**)((_IO_FILE*)this + 1); }
+ protected:
+ static streambuf* _list_all; /* List of open streambufs. */
+ _IO_FILE*& xchain() { return _chain; }
+ void _un_link();
+ void _link_in();
+ char* gptr() const
+ { return _IO_file_flags & _IO_IN_BACKUP ? _IO_save_base : _IO_read_ptr; }
+ char* pptr() const { return _IO_write_ptr; }
+ char* egptr() const
+ { return _IO_file_flags & _IO_IN_BACKUP ? _IO_save_end : _IO_read_end; }
+ char* epptr() const { return _IO_write_end; }
+ char* pbase() const { return _IO_write_base; }
+ char* eback() const
+ { return _IO_file_flags & _IO_IN_BACKUP ? _IO_save_base : _IO_read_base;}
+ char* base() const { return _IO_buf_base; }
+ char* ebuf() const { return _IO_buf_end; }
+ int blen() const { return _IO_buf_end - _IO_buf_base; }
+ void xput_char(char c) { *_IO_write_ptr++ = c; }
+ int xflags() { return _IO_file_flags; }
+ int xflags(int f) {int fl = _IO_file_flags; _IO_file_flags = f; return fl;}
+ void xsetflags(int f) { _IO_file_flags |= f; }
+ void xsetflags(int f, int mask)
+ { _IO_file_flags = (_IO_file_flags & ~mask) | (f & mask); }
+ void gbump(int n)
+ { _IO_file_flags & _IO_IN_BACKUP ? (_IO_save_base+=n):(_IO_read_ptr+=n);}
+ void pbump(int n) { _IO_write_ptr += n; }
+ void setb(char* b, char* eb, int a=0);
+ void setp(char* p, char* ep)
+ { _IO_write_base=_IO_write_ptr=p; _IO_write_end=ep; }
+ void setg(char* eb, char* g, char *eg) {
+ if (_IO_file_flags & _IO_IN_BACKUP) _IO_free_backup_area(this);
+ _IO_read_base = eb; _IO_read_ptr = g; _IO_read_end = eg; }
+ char *shortbuf() { return _shortbuf; }
+
+ int in_backup() { return _flags & _IO_IN_BACKUP; }
+ // The start of the main get area: FIXME: wrong for write-mode filebuf?
+ char *Gbase() { return in_backup() ? _IO_save_base : _IO_read_base; }
+ // The end of the main get area:
+ char *eGptr() { return in_backup() ? _IO_save_end : _IO_read_end; }
+ // The start of the backup area:
+ char *Bbase() { return in_backup() ? _IO_read_base : _IO_save_base; }
+ char *Bptr() { return _IO_backup_base; }
+ // The end of the backup area:
+ char *eBptr() { return in_backup() ? _IO_read_end : _IO_save_end; }
+ char *Nbase() { return _IO_save_base; }
+ char *eNptr() { return _IO_save_end; }
+ int have_backup() { return _IO_save_base != NULL; }
+ int have_markers() { return _markers != NULL; }
+ void free_backup_area();
+ void unsave_markers(); // Make all streammarkers !saving().
+ int put_mode() { return _flags & _IO_CURRENTLY_PUTTING; }
+ int switch_to_get_mode();
+
+ streambuf(int flags=0);
+ public:
+ static int flush_all();
+ static void flush_all_linebuffered(); // Flush all line buffered files.
+ virtual ~streambuf();
+ virtual int overflow(int c = EOF); // Leave public for now
+ virtual int underflow(); // Leave public for now
+ virtual int uflow(); // Leave public for now
+ virtual int pbackfail(int c);
+// virtual int showmany ();
+ virtual streamsize xsputn(const char* s, streamsize n);
+ virtual streamsize xsgetn(char* s, streamsize n);
+ virtual streampos seekoff(streamoff, _seek_dir, int mode=ios::in|ios::out);
+ virtual streampos seekpos(streampos pos, int mode = ios::in|ios::out);
+
+ streampos pubseekoff(streamoff o, _seek_dir d, int mode=ios::in|ios::out)
+ { return _IO_seekoff (this, o, d, mode); }
+ streampos pubseekpos(streampos pos, int mode = ios::in|ios::out)
+ { return _IO_seekpos (this, pos, mode); }
+ streampos sseekoff(streamoff, _seek_dir, int mode=ios::in|ios::out);
+ streampos sseekpos(streampos pos, int mode = ios::in|ios::out);
+ virtual streambuf* setbuf(char* p, int len);
+ virtual int sync();
+ virtual int doallocate();
+
+ int seekmark(streammarker& mark, int delta = 0);
+ int sputbackc(char c);
+ int sungetc();
+ int unbuffered() { return _flags & _IO_UNBUFFERED ? 1 : 0; }
+ int linebuffered() { return _flags & _IO_LINE_BUF ? 1 : 0; }
+ void unbuffered(int i)
+ { if (i) _flags |= _IO_UNBUFFERED; else _flags &= ~_IO_UNBUFFERED; }
+ void linebuffered(int i)
+ { if (i) _flags |= _IO_LINE_BUF; else _flags &= ~_IO_LINE_BUF; }
+ int allocate() { // For AT&T compatibility
+ if (base() || unbuffered()) return 0;
+ else return doallocate(); }
+ // Allocate a buffer if needed; use _shortbuf if appropriate.
+ void allocbuf() { if (base() == NULL) doallocbuf(); }
+ void doallocbuf();
+ int in_avail() { return _IO_read_end - _IO_read_ptr; }
+ int out_waiting() { return _IO_write_ptr - _IO_write_base; }
+ streamsize sputn(const char* s, streamsize n) { return xsputn(s, n); }
+ streamsize padn(char pad, streamsize n) { return _IO_padn(this, pad, n); }
+ streamsize sgetn(char* s, streamsize n) { return _IO_sgetn(this, s, n); }
+ int ignore(int);
+ int get_column();
+ int set_column(int);
+ long sgetline(char* buf, _IO_size_t n, char delim, int putback_delim);
+ int sputc(int c) { return _IO_putc(c, this); }
+ int sbumpc() { return _IO_getc(this); }
+ int sgetc() { return _IO_peekc(this); }
+ int snextc() {
+ if (_IO_read_ptr >= _IO_read_end && __underflow(this) == EOF)
+ return EOF;
+ else return _IO_read_ptr++, sgetc(); }
+ void stossc() { if (_IO_read_ptr < _IO_read_end) _IO_read_ptr++; }
+ int vscan(char const *fmt0, _IO_va_list ap, ios* stream = NULL);
+ int scan(char const *fmt0 ...);
+ int vform(char const *fmt0, _IO_va_list ap);
+ int form(char const *fmt0 ...);
+#if 0 /* Work in progress */
+ int column(); // Current column number (of put pointer). -1 is unknown.
+ void column(int c); // Set column number of put pointer to c.
+#endif
+ virtual streamsize sys_read(char* buf, streamsize size);
+ virtual streamsize sys_write(const char*, streamsize);
+ virtual streampos sys_seek(streamoff, _seek_dir);
+ virtual int sys_close();
+ virtual int sys_stat(void*); // Actually, a (struct stat*)
+};
+
+// A backupbuf is a streambuf with full backup and savepoints on reading.
+// All standard streambufs in the GNU iostream library are backupbufs.
+
+class filebuf : public streambuf {
+ protected:
+ void init();
+ public:
+ static const int openprot; // Non-ANSI AT&T-ism: Default open protection.
+ filebuf();
+ filebuf(int fd);
+ filebuf(int fd, char* p, int len);
+#if !_IO_UNIFIED_JUMPTABLES
+ static filebuf *__new();
+#endif
+ ~filebuf();
+ filebuf* attach(int fd);
+ filebuf* open(const char *filename, const char *mode);
+ filebuf* open(const char *filename, ios::openmode mode, int prot = 0664);
+ virtual int underflow();
+ virtual int overflow(int c = EOF);
+ int is_open() const { return _fileno >= 0; }
+ int fd() const { return is_open() ? _fileno : EOF; }
+ filebuf* close();
+ virtual int doallocate();
+ virtual streampos seekoff(streamoff, _seek_dir, int mode=ios::in|ios::out);
+ virtual streambuf* setbuf(char* p, int len);
+ streamsize xsputn(const char* s, streamsize n);
+ streamsize xsgetn(char* s, streamsize n);
+ virtual int sync();
+ protected: // See documentation in filebuf.C.
+// virtual int pbackfail(int c);
+ int is_reading() { return eback() != egptr(); }
+ char* cur_ptr() { return is_reading() ? gptr() : pptr(); }
+ /* System's idea of pointer */
+ char* file_ptr() { return eGptr(); }
+ // Low-level operations (Usually invoke system calls.)
+ virtual streamsize sys_read(char* buf, streamsize size);
+ virtual streampos sys_seek(streamoff, _seek_dir);
+ virtual streamsize sys_write(const char*, streamsize);
+ virtual int sys_stat(void*); // Actually, a (struct stat*)
+ virtual int sys_close();
+#if 0
+ virtual uflow;
+ virtual showmany;
+#endif
+};
+
+inline void ios::init(streambuf* sb, ostream* tie_to) {
+ _state = sb ? ios::goodbit : ios::badbit; _exceptions=0;
+ _strbuf=sb; _tie = tie_to; _width=0; _fill=' ';
+#ifdef _IO_NEW_STREAMS
+ _flags=ios::skipws|ios::dec;
+#else
+ _flags=ios::skipws|ios::dec|ios::dont_close;
+#endif
+ _precision=6; _arrays = 0; }
+
+inline ios::ios(streambuf* sb, ostream* tie_to) { init(sb, tie_to); }
+
+inline ios::~ios() {
+#ifndef _IO_NEW_STREAMS
+ if (!(_flags & (unsigned int)ios::dont_close)) delete rdbuf();
+#endif
+ if (_arrays) delete [] _arrays;
+}
+} // extern "C++"
+#endif /* _STREAMBUF_H */
diff --git a/libio/strfile.h b/libio/strfile.h
new file mode 100644
index 00000000000..a24c9e0b65c
--- /dev/null
+++ b/libio/strfile.h
@@ -0,0 +1,62 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <libio.h>
+#ifdef TODO
+Merge into libio.h ?
+#endif
+
+typedef void *(*_IO_alloc_type) __P((_IO_size_t));
+typedef void (*_IO_free_type) __P((void*));
+
+struct _IO_str_fields
+{
+ _IO_alloc_type _allocate_buffer;
+ _IO_free_type _free_buffer;
+};
+
+/* This is needed for the Irix6 N32 ABI, which has a 64 bit off_t type,
+ but a 32 bit pointer type. In this case, we get 4 bytes of padding
+ after the vtable pointer. Putting them in a structure together solves
+ this problem. */
+
+struct _IO_streambuf
+{
+ struct _IO_FILE _f;
+ const void *_vtable;
+};
+
+typedef struct _IO_strfile_
+{
+ struct _IO_streambuf _sbf;
+ struct _IO_str_fields _s;
+} _IO_strfile;
+
+/* dynamic: set when the array object is allocated (or reallocated) as
+ necessary to hold a character sequence that can change in length. */
+#define _IO_STR_DYNAMIC(FP) ((FP)->_s._allocate_buffer != (_IO_alloc_type)0)
+
+/* frozen: set when the program has requested that the array object not
+ be altered, reallocated, or freed. */
+#define _IO_STR_FROZEN(FP) ((FP)->_f._IO_file_flags & _IO_USER_BUF)
diff --git a/libio/strops.c b/libio/strops.c
new file mode 100644
index 00000000000..3162cd966e0
--- /dev/null
+++ b/libio/strops.c
@@ -0,0 +1,290 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include "strfile.h"
+#include "libioP.h"
+#include <string.h>
+
+#if 0
+/* The following definitions are for exposition only.
+ They map the terminlogy used in the ANSI/ISO C++ draft standard
+ to the implementation. */
+
+/* allocated: set when a dynamic array object has been allocated, and
+ hence should be freed by the destructor for the strstreambuf object. */
+#define ALLOCATED(FP) ((FP)->_f._IO_buf_base && DYNAMIC(FP))
+
+/* constant: set when the array object has const elements,
+ so the output sequence cannot be written. */
+#define CONSTANT(FP) ((FP)->_f._IO_file_flags & _IO_NO_WRITES)
+
+/* alsize: the suggested minimum size for a dynamic array object. */
+#define ALSIZE(FP) ??? /* not stored */
+
+/* palloc: points to the function to call to allocate a dynamic array object.*/
+#define PALLOC(FP) \
+ ((FP)->_s._allocate_buffer == default_alloc ? 0 : (FP)->_s._allocate_buffer)
+
+/* pfree: points to the function to call to free a dynamic array object. */
+#define PFREE(FP) \
+ ((FP)->_s._free_buffer == default_free ? 0 : (FP)->_s._free_buffer)
+
+#endif
+
+#ifdef TODO
+/* An "unbounded buffer" is when a buffer is supplied, but with no
+ specified length. An example is the buffer argument to sprintf.
+ */
+#endif
+
+void
+DEFUN(_IO_str_init_static, (fp, ptr, size, pstart),
+ _IO_FILE *fp AND char *ptr AND int size AND char *pstart)
+{
+ if (size == 0)
+ size = strlen(ptr);
+ else if (size < 0)
+ {
+ /* If size is negative 'the characters are assumed to
+ continue indefinitely.' This is kind of messy ... */
+ _G_int32_t s;
+ size = 512;
+ /* Try increasing powers of 2, as long as we don't wrap around. */
+ for (; s = 2*size, s > 0 && ptr + s > ptr && s < 0x4000000L; )
+ size = s;
+ /* Try increasing size as much as we can without wrapping around. */
+ for (s = size >> 1; s > 0; s >>= 1)
+ {
+ if (ptr + size + s > ptr)
+ size += s;
+ }
+ }
+ _IO_setb(fp, ptr, ptr+size, 0);
+
+ fp->_IO_write_base = ptr;
+ fp->_IO_read_base = ptr;
+ fp->_IO_read_ptr = ptr;
+ if (pstart)
+ {
+ fp->_IO_write_ptr = pstart;
+ fp->_IO_write_end = ptr+size;
+ fp->_IO_read_end = pstart;
+ }
+ else
+ {
+ fp->_IO_write_ptr = ptr;
+ fp->_IO_write_end = ptr;
+ fp->_IO_read_end = ptr+size;
+ }
+ /* A null _allocate_buffer function flags the strfile as being static. */
+ (((_IO_strfile*)(fp))->_s._allocate_buffer) = (_IO_alloc_type)0;
+}
+
+void
+DEFUN(_IO_str_init_readonly, (fp, ptr, size),
+ _IO_FILE *fp AND const char *ptr AND int size)
+{
+ _IO_str_init_static (fp, (char*)ptr, size, NULL);
+ fp->_IO_file_flags |= _IO_NO_WRITES;
+}
+
+int
+DEFUN(_IO_str_overflow, (fp, c),
+ register _IO_FILE* fp AND int c)
+{
+ int flush_only = c == EOF;
+ _IO_size_t pos;
+ if (fp->_flags & _IO_NO_WRITES)
+ return flush_only ? 0 : EOF;
+ if ((fp->_flags & _IO_TIED_PUT_GET) && !(fp->_flags & _IO_CURRENTLY_PUTTING))
+ {
+ fp->_flags |= _IO_CURRENTLY_PUTTING;
+ fp->_IO_write_ptr = fp->_IO_read_ptr;
+ fp->_IO_read_ptr = fp->_IO_read_end;
+ }
+ pos = fp->_IO_write_ptr - fp->_IO_write_base;
+ if (pos >= _IO_blen(fp) + flush_only)
+ {
+ if (fp->_flags & _IO_USER_BUF) /* not allowed to enlarge */
+ return EOF;
+ else
+ {
+ char *new_buf;
+ char *old_buf = fp->_IO_buf_base;
+ _IO_size_t new_size = 2 * _IO_blen(fp) + 100;
+ new_buf
+ = (char*)(*((_IO_strfile*)fp)->_s._allocate_buffer)(new_size);
+ if (new_buf == NULL)
+ {
+ /* __ferror(fp) = 1; */
+ return EOF;
+ }
+ if (fp->_IO_buf_base)
+ {
+ memcpy(new_buf, old_buf, _IO_blen(fp));
+ (*((_IO_strfile*)fp)->_s._free_buffer)(fp->_IO_buf_base);
+ /* Make sure _IO_setb won't try to delete _IO_buf_base. */
+ fp->_IO_buf_base = NULL;
+ }
+#if 0
+ if (lenp == &LEN(fp)) /* use '\0'-filling */
+ memset(new_buf + pos, 0, blen() - pos);
+#endif
+ _IO_setb(fp, new_buf, new_buf + new_size, 1);
+ fp->_IO_read_base = new_buf + (fp->_IO_read_base - old_buf);
+ fp->_IO_read_ptr = new_buf + (fp->_IO_read_ptr - old_buf);
+ fp->_IO_read_end = new_buf + (fp->_IO_read_end - old_buf);
+ fp->_IO_write_ptr = new_buf + (fp->_IO_write_ptr - old_buf);
+
+ fp->_IO_write_base = new_buf;
+ fp->_IO_write_end = fp->_IO_buf_end;
+ }
+ }
+
+ if (!flush_only)
+ *fp->_IO_write_ptr++ = (unsigned char) c;
+ if (fp->_IO_write_ptr > fp->_IO_read_end)
+ fp->_IO_read_end = fp->_IO_write_ptr;
+ return c;
+}
+
+int
+DEFUN(_IO_str_underflow, (fp),
+ register _IO_FILE* fp)
+{
+ if (fp->_IO_write_ptr > fp->_IO_read_end)
+ fp->_IO_read_end = fp->_IO_write_ptr;
+ if ((fp->_flags & _IO_TIED_PUT_GET) && (fp->_flags & _IO_CURRENTLY_PUTTING))
+ {
+ fp->_flags &= ~_IO_CURRENTLY_PUTTING;
+ fp->_IO_read_ptr = fp->_IO_write_ptr;
+ fp->_IO_write_ptr = fp->_IO_write_end;
+ }
+ if (fp->_IO_read_ptr < fp->_IO_read_end)
+ return *fp->_IO_read_ptr;
+ else
+ return EOF;
+}
+
+/* The size of the valid part of the buffer. */
+
+_IO_ssize_t
+DEFUN(_IO_str_count, (fp),
+ register _IO_FILE *fp)
+{
+ return (fp->_IO_write_ptr > fp->_IO_read_end ? fp->_IO_write_ptr
+ : fp->_IO_read_end)
+ - fp->_IO_read_base;
+}
+
+_IO_pos_t
+DEFUN(_IO_str_seekoff, (fp, offset, dir, mode),
+ register _IO_FILE *fp AND _IO_off_t offset AND int dir AND int mode)
+{
+ _IO_ssize_t cur_size = _IO_str_count(fp);
+ _IO_pos_t new_pos = EOF;
+
+ /* Move the get pointer, if requested. */
+ if (mode & _IOS_INPUT)
+ {
+ switch (dir)
+ {
+ case _IO_seek_end:
+ offset += cur_size;
+ break;
+ case _IO_seek_cur:
+ offset += fp->_IO_read_ptr - fp->_IO_read_base;
+ break;
+ default: /* case _IO_seek_set: */
+ break;
+ }
+ if (offset < 0 || (_IO_size_t)offset > cur_size)
+ return EOF;
+ fp->_IO_read_ptr = fp->_IO_read_base + offset;
+ fp->_IO_read_end = fp->_IO_read_base + cur_size;
+ new_pos = offset;
+ }
+
+ /* Move the put pointer, if requested. */
+ if (mode & _IOS_OUTPUT)
+ {
+ switch (dir)
+ {
+ case _IO_seek_end:
+ offset += cur_size;
+ break;
+ case _IO_seek_cur:
+ offset += fp->_IO_write_ptr - fp->_IO_write_base;
+ break;
+ default: /* case _IO_seek_set: */
+ break;
+ }
+ if (offset < 0 || (_IO_size_t)offset > cur_size)
+ return EOF;
+ fp->_IO_write_ptr = fp->_IO_write_base + offset;
+ new_pos = offset;
+ }
+ return new_pos;
+}
+
+int
+DEFUN(_IO_str_pbackfail, (fp, c),
+ register _IO_FILE *fp AND int c)
+{
+ if ((fp->_flags & _IO_NO_WRITES) && c != EOF)
+ return EOF;
+ return _IO_default_pbackfail(fp, c);
+}
+
+void
+DEFUN (_IO_str_finish, (fp),
+ register _IO_FILE* fp)
+{
+ if (fp->_IO_buf_base && !(fp->_flags & _IO_USER_BUF))
+ (((_IO_strfile*)fp)->_s._free_buffer)(fp->_IO_buf_base);
+ fp->_IO_buf_base = NULL;
+
+ _IO_default_finish(fp);
+}
+
+struct _IO_jump_t _IO_str_jumps = {
+ JUMP_INIT_DUMMY,
+ JUMP_INIT(finish, _IO_str_finish),
+ JUMP_INIT(overflow, _IO_str_overflow),
+ JUMP_INIT(underflow, _IO_str_underflow),
+ JUMP_INIT(uflow, _IO_default_uflow),
+ JUMP_INIT(pbackfail, _IO_str_pbackfail),
+ JUMP_INIT(xsputn, _IO_default_xsputn),
+ JUMP_INIT(xsgetn, _IO_default_xsgetn),
+ JUMP_INIT(seekoff, _IO_str_seekoff),
+ JUMP_INIT(seekpos, _IO_default_seekpos),
+ JUMP_INIT(setbuf, _IO_default_setbuf),
+ JUMP_INIT(sync, _IO_default_sync),
+ JUMP_INIT(doallocate, _IO_default_doallocate),
+ JUMP_INIT(read, _IO_default_read),
+ JUMP_INIT(write, _IO_default_write),
+ JUMP_INIT(seek, _IO_default_seek),
+ JUMP_INIT(close, _IO_default_close),
+ JUMP_INIT(stat, _IO_default_stat)
+};
diff --git a/libio/strstream.cc b/libio/strstream.cc
new file mode 100644
index 00000000000..a32e811c9d9
--- /dev/null
+++ b/libio/strstream.cc
@@ -0,0 +1,116 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+#include "iostreamP.h"
+#include "strstream.h"
+#include <string.h>
+
+static void* default_alloc(_IO_size_t size)
+{
+ return (void*)new char[size];
+}
+
+static void default_free(void* ptr)
+{
+ delete [] (char*)ptr;
+}
+
+istrstream::istrstream(const char *cp, int n)
+{
+ __my_sb.init_readonly (cp, n);
+}
+
+strstreambase::strstreambase(char *cp, int n, int mode)
+: __my_sb (cp, n,
+ (mode == ios::app || mode == ios::ate) ? cp + strlen(cp) : cp)
+{
+ init (&__my_sb);
+}
+
+char *strstreambuf::str()
+{
+ freeze(1);
+ return base();
+}
+
+_IO_ssize_t strstreambuf::pcount () { return _IO_write_ptr - _IO_write_base; }
+
+int strstreambuf::overflow(int c /* = EOF */)
+{
+ return _IO_str_overflow (this, c);
+}
+
+int strstreambuf::underflow()
+{
+ return _IO_str_underflow(this);
+}
+
+
+void strstreambuf::init_dynamic(_IO_alloc_type alloc, _IO_free_type free,
+ int initial_size)
+
+{
+ _s._allocate_buffer = alloc ? alloc : default_alloc;
+ _s._free_buffer = free ? free : default_free;
+ if (initial_size > 0)
+ {
+ char * buf = (char*)(*_s._allocate_buffer)(initial_size);
+ setb(buf, buf + initial_size, 1);
+ setp(buf, buf + initial_size);
+ setg(buf, buf, buf);
+ }
+}
+
+void strstreambuf::init_static(char *ptr, int size, char *pstart)
+{
+ _IO_str_init_static (this, ptr, size, pstart);
+}
+
+void strstreambuf::init_readonly (const char *ptr, int size)
+{
+ _IO_str_init_readonly (this, ptr, size);
+}
+
+strstreambuf::~strstreambuf()
+{
+ if (_IO_buf_base && !(_flags & _IO_USER_BUF))
+ (_s._free_buffer)(_IO_buf_base);
+ _IO_buf_base = NULL;
+}
+
+streampos strstreambuf::seekoff(streamoff off, _seek_dir dir,
+ int mode /*=ios::in|ios::out*/)
+{
+ return _IO_str_seekoff (this, off, dir, mode);
+}
+
+int strstreambuf::pbackfail(int c)
+{
+ return _IO_str_pbackfail (this, c);
+}
diff --git a/libio/strstream.h b/libio/strstream.h
new file mode 100644
index 00000000000..d549b454758
--- /dev/null
+++ b/libio/strstream.h
@@ -0,0 +1,113 @@
+/* This is part of libio/iostream, providing -*- C++ -*- input/output.
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+/* Written by Per Bothner (bothner@cygnus.com). */
+
+#ifndef __STRSTREAM_H
+#define __STRSTREAM_H
+#ifdef __GNUG__
+#pragma interface
+#endif
+#include <iostream.h>
+#include <strfile.h>
+
+extern "C++" {
+class strstreambuf : public streambuf
+{
+ struct _IO_str_fields _s;
+ friend class istrstream;
+
+ void init_dynamic(_IO_alloc_type alloc, _IO_free_type free,
+ int initial_size = 0);
+ void init_static(char *ptr, int size, char *pstart);
+ void init_readonly(const char *ptr, int size);
+ protected:
+ virtual int overflow(int = EOF);
+ virtual int underflow();
+ virtual int pbackfail(int c);
+ public:
+ virtual ~strstreambuf();
+ strstreambuf() { init_dynamic(0, 0); }
+ strstreambuf(int initial_size) { init_dynamic(0, 0, initial_size); }
+ strstreambuf(void *(*alloc)(_IO_size_t), void (*free)(void*))
+ { init_dynamic(alloc, free); }
+ strstreambuf(char *ptr, int size, char *pstart = NULL)
+ { init_static(ptr, size, pstart); }
+ strstreambuf(unsigned char *ptr, int size, unsigned char *pstart = NULL)
+ { init_static((char*)ptr, size, (char*)pstart); }
+ strstreambuf(const char *ptr, int size)
+ { init_readonly(ptr, size); }
+ strstreambuf(const unsigned char *ptr, int size)
+ { init_readonly((const char*)ptr, size); }
+ strstreambuf(signed char *ptr, int size, signed char *pstart = NULL)
+ { init_static((char*)ptr, size, (char*)pstart); }
+ strstreambuf(const signed char *ptr, int size)
+ { init_readonly((const char*)ptr, size); }
+ // Note: frozen() is always true if !_IO_STR_DYNAMIC(this).
+ int frozen() { return _flags & _IO_USER_BUF ? 1 : 0; }
+ void freeze(int n=1)
+ { if (_IO_STR_DYNAMIC(this))
+ { if (n) _flags |= _IO_USER_BUF; else _flags &= ~_IO_USER_BUF; } }
+ _IO_ssize_t pcount();
+ char *str();
+ virtual streampos seekoff(streamoff, _seek_dir, int mode=ios::in|ios::out);
+};
+
+class strstreambase : virtual public ios {
+ protected:
+ strstreambuf __my_sb;
+ public:
+ strstreambuf* rdbuf() { return &__my_sb; }
+ protected:
+ strstreambase() { init (&__my_sb); }
+ strstreambase(char *cp, int n, int mode=ios::out);
+};
+
+class istrstream : public strstreambase, public istream {
+ public:
+ istrstream(const char*, int=0);
+};
+
+class ostrstream : public strstreambase, public ostream {
+ public:
+ ostrstream() { }
+ ostrstream(char *cp, int n, int mode=ios::out) :strstreambase(cp,n,mode){}
+ _IO_ssize_t pcount() { return ((strstreambuf*)_strbuf)->pcount(); }
+ char *str() { return ((strstreambuf*)_strbuf)->str(); }
+ void freeze(int n = 1) { ((strstreambuf*)_strbuf)->freeze(n); }
+ int frozen() { return ((strstreambuf*)_strbuf)->frozen(); }
+};
+
+class strstream : public strstreambase, public iostream {
+ public:
+ strstream() { }
+ strstream(char *cp, int n, int mode=ios::out) :strstreambase(cp,n,mode){}
+ _IO_ssize_t pcount() { return ((strstreambuf*)_strbuf)->pcount(); }
+ char *str() { return ((strstreambuf*)_strbuf)->str(); }
+ void freeze(int n = 1) { ((strstreambuf*)_strbuf)->freeze(n); }
+ int frozen() { return ((strstreambuf*)_strbuf)->frozen(); }
+};
+} // extern "C++"
+
+#endif /*!__STRSTREAM_H*/
diff --git a/libio/tests/ChangeLog b/libio/tests/ChangeLog
new file mode 100644
index 00000000000..cd942660557
--- /dev/null
+++ b/libio/tests/ChangeLog
@@ -0,0 +1,140 @@
+Tue May 20 17:57:31 1997 Jeffrey A Law (law@cygnus.com)
+
+ * tfformat.c (main): Only run half the testcases if SLOW_SIMULATOR
+ is defined.
+
+Sun May 18 17:15:32 1997 Jeffrey A Law (law@cygnus.com)
+
+ * tfformat.c (main): Exit immediately if doubles are not
+ at least 64 bits wide.
+
+Fri May 16 19:31:29 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ Fix testscases to use _G_int32_t appropriately.
+
+Thu May 1 17:35:43 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (tgetl, tFile, tiomisc, hounddog, putbackdog,
+ tiomanip, foo, foo+): Add $(CXXFLAGS).
+ (tfseek, twrseek, trdseek, tstdiomisc, tpopen): Add $(CFLAGS).
+
+Mon Apr 28 11:28:36 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * tiomisc.cc (operator delete): Add throw spec.
+
+Sat Apr 26 13:40:17 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * Makefile.in: Change check to check-old. Add do-nothing
+ check target.
+
+Wed Apr 10 17:15:47 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (IOLIBS): Link with libstdc++.
+
+Tue Mar 12 11:45:14 1996 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * tiomisc.cc (test_read_write_flush): New test for read/write/seek
+ on block end. From Luke Blanshard <luke@cs.wisc.edu>.
+
+Thu Jul 6 17:51:30 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * tiomisc.cc (getline_test3): New function. Test reading long lines.
+ * tiomisc.exp: Update for output from getline_test3.
+
+Wed May 10 03:06:51 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * configure.in (X*INCLUDES): Renamed.
+
+Thu Apr 27 21:05:00 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * tiomisc.cc (test_destroy), tiomisc.exp: Add support for
+ _IO_NEW_STREAMS.
+
+Tue Apr 25 15:15:01 1995 Jim Wilson <wilson@chestnut.cygnus.com>
+
+ * tstdiomisc.c (t2): Use N not n in last SCAN macro call.
+
+Sun Feb 12 21:23:24 1995 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * Makefile.in (JUNK_TO_CLEAN): Also delete foo.dat from tiomisc.
+
+Sat Nov 5 14:37:36 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * tiomisc.cc (test_destroy): New test case from Jason Merrill.
+ * tiomisc.exp: Update.
+
+ * Makefile.in (JUNK_TO_CLEAN): Add tstdiomisc.
+
+Thu Oct 13 16:47:30 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tiomisc.cc (reread_test): Remove bogus istream assignment.
+
+Wed Aug 31 13:59:56 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (CXX_FLAGS): Not used. Removed.
+
+Wed Aug 17 18:27:37 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tiomisc.cc (getline_test1, getline_test2, flush1_test): New tests,
+ * tiomisc.cc (reread_test): New tests,
+
+Wed Jun 22 13:44:19 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tstdiomisc.c: Add some sscanf tests.
+ * Makefile.in (check-tstdiomisc): Run diff with expected output.
+ * tstdiomisc.exp: New file. Expected output from tstdiomisc.
+ * Makefile.in (foo): New rule, for quick one-off tests.
+
+Fri May 6 14:10:24 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tFile.cc (t7): Revert Mar 4 change - I was confused.
+
+Sat Apr 2 04:41:41 1994 Andreas Schwab (schwab@issan.informatik.uni-dortmund.de)
+
+ * Makefile.in (tfformat): Fix dependency.
+
+Fri Mar 4 17:40:14 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tFile.cc (t7): gcount after getline shouldn't include delimiter.
+ * tFile.cc (show_int, t12), tFile.exp: More integer formatting tests.
+
+Tue Feb 8 18:39:09 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tiomisc.cc, tiomisc.exp: New test case (for filebuf::attach)
+ from Joe Buck.
+
+Mon Jan 31 13:24:58 1994 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tfformat.c (main): Fix fprintf format string (%s -> %d).
+ Bug reported by Jochen Voss <voss@mathematik.uni-kl.de>.
+
+Sun Dec 19 15:29:00 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tstdiomisc.c, Makefile.in: New tests.
+
+Thu Dec 2 22:56:21 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (JUNK_TO_CLEAN), configure.in (MOSTLYCLEAN):
+ Added, to cleanup after tests.
+
+Fri Nov 26 16:05:43 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tiomisc.cc, tiomisc.exp: A (hopefully growing) collection
+ of small, random tests (mainly regression tests).
+ * tiomisc.cc (test1 and test2): Tests from Wilco van Hoogstraeten
+ <wilco@erasmus.et.tudelft.nl> to check for (now-fixed) bugs.
+
+Mon Oct 4 17:38:27 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * Makefile.in (IOSTDIOLIB): New macro.
+
+Fri Aug 27 12:22:10 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ * tFile.cc (t7): Add test for buffer overflow.
+
+Fri Aug 20 00:23:53 1993 Per Bothner (bothner@kalessin.cygnus.com)
+
+ Moved various tests over from old libg++/iostream/test.
+ * Makefile.in: Edit appropriately.
+
+
diff --git a/libio/tests/Makefile.in b/libio/tests/Makefile.in
new file mode 100644
index 00000000000..66e88dc64d6
--- /dev/null
+++ b/libio/tests/Makefile.in
@@ -0,0 +1,197 @@
+# Copyright (C) 1993 Free Software Foundation
+#
+# This file is part of the GNU IO 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.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU CC; see the file COPYING. If not, write to
+# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+srcdir = .
+
+CFLAGS = -g
+C_FLAGS = $(CFLAGS) -I. -I.. -I$(srcdir) -I$(srcdir)/..
+CXXFLAGS = -g
+CC = gcc
+CXX = gcc
+
+#### package, host, target, and site dependent Makefile fragments come in here.
+##
+
+STDIO_LD_FLAGS = -u __cleanup
+
+#LIBS = ../../libg++.a
+
+#LIBSTDIO = ../stdio/libstdio++.a
+#LIBIO = ../libio.a
+
+#STDIOLIBS = $(STDIO_LD_FLAGS) $(LIBSTDIO) $(LIBIO) $(LIBS)
+STDIOLIBS = $(LIBSTDIO) $(LIBIO) $(LIBS)
+IOLIBS = -L../../libstdc++ -lstdc++
+IOSTDIOLIB = ../libio.a ../../libiberty/libiberty.a
+
+DEPEND_SOURCES = $(srcdir)/*.C
+
+.PHONY: check check-old check-iostream check-stdio
+check:
+
+check-old: check-iostream check-iostdio
+
+
+# These are tests written in C++, that test the iostream facility.
+check-iostream: check-tFile check-tiomisc \
+ check-hounddog check-putbackdog check-tiomanip
+
+# These are tests written in C, that don't need C++.
+# They test libio's emulation of stdio.
+check-iostdio: check-tiformat check-tfformat check-tstdiomisc
+
+# check-stdio runs test programs that use stdio.
+# These aren't run by default because there may be linker tricks needed
+# to build them (if libc.a contains a competing stdio implementation).
+
+check-stdio: check-tfseek check-twrseek check-trdseek check-tpopen
+
+# See ${MOSTLYCLEAN} in configure.in
+JUNK_TO_CLEAN = tFile tiomisc hounddog putbackdog tiomanip \
+ t?format *.out streamfile ftmp* tstdiomisc foo.dat
+
+.PHONY: info
+info:
+.PHONY: clean-info
+clean-info:
+.PHONY: install-info
+install-info:
+
+tst: tst.o
+ gcc -v -o tst tst.o $(STDIOLIBS)
+
+tgetl: tgetl.o
+ $(CXX) $(CXXFLAGS) -o tgetl tgetl.o $(IOLIBS)
+
+tFile: tFile.o
+ $(CXX) $(CXXFLAGS) -o tFile tFile.o $(IOLIBS)
+
+tiomisc: tiomisc.o
+ $(CXX) $(CXXFLAGS) -o tiomisc tiomisc.o $(IOLIBS)
+
+hounddog: hounddog.o
+ $(CXX) $(CXXFLAGS) -o hounddog hounddog.o $(IOLIBS)
+
+check-hounddog: hounddog
+ ./hounddog <$(srcdir)/hounddog.inp > hounddog.out 2>&1
+ diff -c hounddog.out $(srcdir)/hounddog.exp
+ ./hounddog -b0 <$(srcdir)/hounddog.inp > hound-b0.out 2>&1
+ diff -c hound-b0.out $(srcdir)/hounddog.exp
+ ./hounddog -b2 <$(srcdir)/hounddog.inp > hound-b2.out 2>&1
+ diff -c hound-b2.out $(srcdir)/hounddog.exp
+
+putbackdog: putbackdog.o
+ $(CXX) $(CXXFLAGS) -o putbackdog putbackdog.o $(IOLIBS)
+
+check-putbackdog-regular: putbackdog
+ ./putbackdog <$(srcdir)/hounddog.inp > putback.out 2>&1
+ diff -c putback.out $(srcdir)/hounddog.exp
+check-putbackdog-nobuf: putbackdog
+ ./putbackdog -b0 <$(srcdir)/hounddog.inp > putback-b0.out 2>&1
+ diff -c putback-b0.out $(srcdir)/hounddog.exp
+check-putbackdog-buf2: putbackdog
+ ./putbackdog -b2 <$(srcdir)/hounddog.inp > putback-b2.out 2>&1
+ diff -c putback-b2.out $(srcdir)/hounddog.exp
+check-putbackdog: \
+ check-putbackdog-regular check-putbackdog-nobuf check-putbackdog-buf2
+
+tfseek: tfseek.o
+ $(CC) $(CFLAGS) -o tfseek tfseek.o $(STDIOLIBS)
+
+check-tfseek: tfseek
+ ./tfseek SEEK_SET fopen > tfseek-set-fopen.out 2>&1
+ diff -c tfseek-set-fopen.out $(srcdir)/tfseek-set.exp
+ ./tfseek SEEK_SET freopen > tfseek-set-freopen.out 2>&1
+ diff -c tfseek-set-freopen.out $(srcdir)/tfseek-set.exp
+ ./tfseek SEEK_CUR fopen > tfseek-cur-fopen.out 2>&1
+ diff -c tfseek-cur-fopen.out $(srcdir)/tfseek-cur.exp
+ ./tfseek SEEK_CUR freopen > tfseek-cur-freopen.out 2>&1
+ diff -c tfseek-cur-freopen.out $(srcdir)/tfseek-cur.exp
+
+twrseek: twrseek.o
+ $(CC) $(CFLAGS) -o twrseek twrseek.o $(STDIOLIBS)
+
+check-twrseek: twrseek
+ ./twrseek > twrseek.out 2>&1
+ diff -c twrseek.out $(srcdir)/twrseek.exp
+
+trdseek: trdseek.o
+ $(CC) $(CFLAGS) -o trdseek -v trdseek.o $(STDIOLIBS)
+
+check-trdseek: trdseek
+ ./trdseek
+
+check-tFile-regular: tFile
+ ./tFile < $(srcdir)/tFile.inp > tFile.out 2>&1
+ diff -c tFile.out $(srcdir)/tFile.exp
+# Run tFile with cout.rdbuf() unbuffered.
+check-tFile-nobuf: tFile
+ ./tFile -b0 < $(srcdir)/tFile.inp > tFile-buf0.out 2>&1
+ diff -c tFile-buf0.out $(srcdir)/tFile.exp
+# Run tFile with a 3-byte buffer for cout.rdbuf().
+check-tFile-buf3: tFile
+ ./tFile -b3 < $(srcdir)/tFile.inp > tFile-buf3.out 2>&1
+ diff -c tFile-buf3.out $(srcdir)/tFile.exp
+check-tFile: check-tFile-regular check-tFile-nobuf check-tFile-buf3
+
+check-tiomisc: tiomisc
+ ./tiomisc >tiomisc.out 2>&1
+ diff -c tiomisc.out $(srcdir)/tiomisc.exp
+
+tiomanip: tiomanip.o
+ $(CXX) $(CXXFLAGS) -o tiomanip tiomanip.o $(IOLIBS)
+check-tiomanip: tiomanip
+ ./tiomanip >tiomanip.out 2>&1
+ diff -c tiomanip.out $(srcdir)/tiomanip.exp
+
+tfformat: $(srcdir)/tfformat.c
+ $(CC) $(C_FLAGS) -DTEST_LIBIO -DTEST_EXACTNESS \
+ -o tfformat $(srcdir)/tfformat.c $(IOSTDIOLIB)
+
+check-tfformat: tfformat
+ ./tfformat
+
+tiformat: $(srcdir)/tiformat.c
+ $(CC) $(C_FLAGS) -DTEST_LIBIO -o tiformat $(srcdir)/tiformat.c $(IOSTDIOLIB)
+
+check-tiformat: tiformat
+ ./tiformat
+
+tstdiomisc: tstdiomisc.o
+ $(CC) $(CFLAGS) -o tstdiomisc tstdiomisc.o $(IOSTDIOLIB)
+
+check-tstdiomisc: tstdiomisc
+ ./tstdiomisc >tstdiomisc.out 2>&1
+ diff -c tstdiomisc.out $(srcdir)/tstdiomisc.exp
+
+tpopen: tpopen.o
+ $(CC) $(CFLAGS) -o tpopen tpopen.o $(STDIOLIBS)
+
+check-tpopen: tpopen
+ ./tpopen > tpopen.out 2>&1
+ diff -c tpopen.out $(srcdir)/tpopen.exp
+
+trwseek: trwseek.o
+ $(CC) $(CFLAGS) -o trwseek trwseek.o $(STDIOLIBS)
+
+check-trwseek: trwseek
+ ./trwsseek TMP r+ k w o
+
+foo: foo.o
+ $(CXX) $(CXXFLAGS) -o foo foo.o $(STDIOLIBS)
+foo+: foo+.o
+ $(CXX) $(CXXFLAGS) -o foo+ foo+.o $(IOLIBS)
diff --git a/libio/tests/configure.in b/libio/tests/configure.in
new file mode 100644
index 00000000000..f832adfb236
--- /dev/null
+++ b/libio/tests/configure.in
@@ -0,0 +1,21 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../../configure.
+
+configdirs=
+srctrigger=tFile.cc
+srcname="test C++ input/output library"
+package_makefile_frag=Make.pack
+
+# per-host:
+
+# per-target:
+
+TO_TOPDIR=../../
+ALL=' '
+XCINCLUDES='-I. -I.. -I$(srcdir) -I$(srcdir)/..'
+XCXXINCLUDES='-I. -I.. -I$(srcdir) -I$(srcdir)/..'
+MOSTLYCLEAN='*.o core $(JUNK_TO_CLEAN)'
+(. ${srcdir}/../config.shared) >${package_makefile_frag}
+
+# post-target:
diff --git a/libio/tests/hounddog.cc b/libio/tests/hounddog.cc
new file mode 100644
index 00000000000..29a92383647
--- /dev/null
+++ b/libio/tests/hounddog.cc
@@ -0,0 +1,85 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+#include <iostream.h>
+#include <stdlib.h>
+#include <string.h>
+
+// Read either "dog", "hound", or "hounddog".
+// If "dog" is found, return 1.
+// If "hound" is found, return 2.
+// If "hounddog" is found, return 3.
+// If non of these are found, return -1.
+int my_scan(streambuf* sb)
+{
+ streammarker fence(sb);
+ char buffer[20];
+ // Try reading "hounddog":
+ if (sb->sgetn(buffer, 8) == 8 && strncmp(buffer, "hounddog", 8) == 0)
+ return 3;
+ // No, no "hounddog": Backup to 'fence' ...
+ sb->seekmark(fence);
+ // ... and try reading "dog":
+ if (sb->sgetn(buffer, 3) == 3 && strncmp(buffer, "dog", 3) == 0)
+ return 1;
+ // No, no "dog" either: Backup to 'fence' ...
+ sb->seekmark(fence);
+ // ... and try reading "hound":
+ if (sb->sgetn(buffer, 5) == 5 && strncmp(buffer, "hound", 5) == 0)
+ return 2;
+ // No, no "hound" either: Backup to 'fence' and signal failure.
+ sb->seekmark(fence); // Backup to 'fence'..
+ return -1;
+}
+
+int main(int argc, char **argv)
+{
+ streambuf *sb = cin.rdbuf();
+ if (argc > 1 && strncmp(argv[1], "-b", 2) == 0) {
+ streambuf *ret;
+ int buffer_size = atoi(&argv[1][2]);
+ if (buffer_size == 0)
+ ret = sb->setbuf(NULL, 0);
+ else
+ ret = sb->setbuf(new char[buffer_size], buffer_size);
+ if (ret != sb)
+ cerr << "Warning: cin.rdbuf()->setbuf failed!\n";
+ }
+ for (;;) {
+ int code = my_scan(sb);
+ int ch = sb->sbumpc();
+ if (code == -1 && ch == EOF)
+ break;
+ int n = 0;
+ while (ch != EOF && ch != '\n') {
+ n++;
+ ch = sb->sbumpc();
+ };
+ if (ch == EOF) {
+ cout << "[Unexpected EOF]\n";
+ break;
+ }
+ cout << "Code: " << code << " followed by " << n << " chars\n";
+ }
+}
diff --git a/libio/tests/hounddog.exp b/libio/tests/hounddog.exp
new file mode 100644
index 00000000000..2060807b431
--- /dev/null
+++ b/libio/tests/hounddog.exp
@@ -0,0 +1,7 @@
+Code: -1 followed by 6 chars
+Code: 1 followed by 3 chars
+Code: 2 followed by 0 chars
+Code: -1 followed by 3 chars
+Code: 3 followed by 4 chars
+Code: 1 followed by 0 chars
+Code: -1 followed by 3 chars
diff --git a/libio/tests/hounddog.inp b/libio/tests/hounddog.inp
new file mode 100644
index 00000000000..370371bc203
--- /dev/null
+++ b/libio/tests/hounddog.inp
@@ -0,0 +1,7 @@
+hello!
+doggie
+hound
+cat
+hounddog rat
+dog
+foo
diff --git a/libio/tests/putbackdog.cc b/libio/tests/putbackdog.cc
new file mode 100644
index 00000000000..0e1ed61f559
--- /dev/null
+++ b/libio/tests/putbackdog.cc
@@ -0,0 +1,97 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+// Test streambuf::sputbackc
+
+#include <iostream.h>
+#include <stdlib.h>
+#include <string.h>
+
+// Read either "dog", "hound", or "hounddog".
+// If "dog" is found, return 1.
+// If "hound" is found, return 2.
+// If "hounddog" is found, return 3.
+// If non of these are found, return -1.
+
+void unget_string(streambuf *sb, char *str, int count)
+{
+ for (str += count; -- count >= 0; )
+ sb->sputbackc(*--str);
+}
+
+int my_scan(streambuf* sb)
+{
+ char buffer[20];
+ // Try reading "hounddog":
+ int count;
+ count = sb->sgetn(buffer, 8);
+ if (count == 8 && strncmp(buffer, "hounddog", 8) == 0)
+ return 3;
+ // No, no "hounddog": Backup to 'fence' ...
+ unget_string(sb, buffer, count);
+ // ... and try reading "dog":
+ count = sb->sgetn(buffer, 3);
+ if (count == 3 && strncmp(buffer, "dog", 3) == 0)
+ return 1;
+ // No, no "dog" either: Backup to 'fence' ...
+ unget_string(sb, buffer, count);
+ // ... and try reading "hound":
+ count = sb->sgetn(buffer, 5);
+ if (count == 5 && strncmp(buffer, "hound", 5) == 0)
+ return 2;
+ // No, no "hound" either: Backup to 'fence' and signal failure.
+ unget_string(sb, buffer, count);
+ return -1;
+}
+
+int main(int argc, char **argv)
+{
+ streambuf *sb = cin.rdbuf();
+ if (argc > 1 && strncmp(argv[1], "-b", 2) == 0) {
+ streambuf *ret;
+ int buffer_size = atoi(&argv[1][2]);
+ if (buffer_size == 0)
+ ret = sb->setbuf(NULL, 0);
+ else
+ ret = sb->setbuf(new char[buffer_size], buffer_size);
+ if (ret != sb)
+ cerr << "Warning: cin.rdbuf()->setbuf failed!\n";
+ }
+ for (;;) {
+ int code = my_scan(sb);
+ int ch = sb->sbumpc();
+ if (code == -1 && ch == EOF)
+ break;
+ int n = 0;
+ while (ch != EOF && ch != '\n') {
+ n++;
+ ch = sb->sbumpc();
+ };
+ if (ch == EOF) {
+ cout << "[Unexpected EOF]\n";
+ break;
+ }
+ cout << "Code: " << code << " followed by " << n << " chars\n";
+ }
+}
diff --git a/libio/tests/tFile.cc b/libio/tests/tFile.cc
new file mode 100644
index 00000000000..d8a1ee301fa
--- /dev/null
+++ b/libio/tests/tFile.cc
@@ -0,0 +1,550 @@
+/*
+Copyright (C) 1993 Free Software Foundation
+
+This file is part of the GNU IO 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.
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this library; see the file COPYING. If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+As a special exception, if you link this library with files
+compiled with a GNU compiler to produce an executable, this does not cause
+the resulting executable to be covered by the GNU General Public License.
+This exception does not however invalidate any other reasons why
+the executable file might be covered by the GNU General Public License. */
+
+// This may look like C code, but it is really -*- C++ -*-
+
+/*
+ * a few tests for streams
+ *
+ */
+
+#include <stream.h>
+#include <fstream.h>
+#ifndef _OLD_STREAMS
+#include <strstream.h>
+#include "unistd.h"
+#endif
+#include <SFile.h>
+#include <PlotFile.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+
+class record
+{
+public:
+ char c; int i; double d;
+};
+
+ostream& operator<<(ostream& s, record& r)
+{
+ return(s << "(i = " << r.i << " c = " << r.c << " d = " << r.d << ")");
+}
+
+void t1()
+{
+ char ch;
+
+ assert(cout.good());
+ assert(cout.writable());
+ assert(cout.is_open());
+ cout << "Hello, world via cout\n";
+ assert(cerr.good());
+ assert(cerr.writable());
+ assert(cerr.is_open());
+ cerr << "Hello, world via cerr\n";
+
+ assert(cin.good());
+ assert(cin.readable());
+ assert(cin.is_open());
+
+ cout << "enter a char:"; cin >> ch;
+ cout.put('c'); cout.put(' '); cout.put('='); cout.put(' ');
+ cout.put('"'); cout.put(ch); cout << '"'; cout << char('\n');
+ assert(cin.good());
+ assert(cout.good());
+}
+
+void t2()
+{
+ int i;
+ short h;
+ long l;
+ float f;
+ double d;
+ char s[100];
+
+ cout << "enter three integers (short, int, long):";
+ cin >> h; cin >> i;
+ // cin.scan("%ld", &l);
+ cin >> l;
+ cout << "first = " << h << " via dec = " << dec(h, 8) << "\n";
+ cout << "second = " << i << form(" via form = %d = 0%o", i, i);
+ cout.form(" via cout.form = %d = 0x%x\n", i, i);
+ cout << "third = " << l << " via hex = " << hex(l) << "\n";
+ assert(cin.good());
+ assert(cout.good());
+
+ cout << "enter a float then a double:"; cin >> f; cin >> d;
+ cout << "first = " << f << "\n";
+ cout << "second = " << d << "\n";
+ assert(cin.good());
+ assert(cout.good());
+
+ cout << "enter 5 characters separated with spaces:"; cin >> s;
+ cout << "first = " << s << "\n";
+ cin.get(s, 100);
+ cout << "rest = " << s << "\n";
+
+ assert(cin.good());
+
+ cin.width(10);
+ cin >> s;
+ cin.clear();
+ cout << "A 10-character buffer: " << s << endl;
+
+ assert(cout.good());
+
+}
+
+void t3()
+{
+ char ch;
+ cout << "\nMaking streams sout and sin...";
+#ifdef _OLD_STREAMS
+ ostream sout("streamfile", io_writeonly, a_create);
+#else
+ ofstream sout("streamfile");
+#endif
+ assert(sout.good());
+ assert(sout.is_open());
+ assert(sout.writable());
+ assert(!sout.readable());
+ sout << "This file has one line testing output streams.\n";
+ sout.close();
+ assert(!sout.is_open());
+#ifdef _OLD_STREAMS
+ istream sin("streamfile", io_readonly, a_useonly);
+#else
+ ifstream sin("streamfile");
+#endif
+ assert(sin.good());
+ assert(sin.is_open());
+ assert(!sin.writable());
+ assert(sin.readable());
+ cout << "contents of file:\n";
+ while(sin >> ch) cout << ch;
+ sin.close();
+ assert(!sin.is_open());
+}
+
+
+void t4()
+{
+ char s[100];
+ char ch;
+ int i;
+
+ cout << "\nMaking File tf ... ";
+#ifdef _OLD_STREAMS
+ File tf("tempfile", io_readwrite, a_create);
+#else
+ fstream tf("tempfile", ios::in|ios::out|ios::trunc);
+#endif
+ assert(tf.good());
+ assert(tf.is_open());
+ assert(tf.writable());
+ assert(tf.readable());
+ strcpy(s, "This is the first and only line of this file.\n");
+#ifdef _OLD_STREAMS
+ tf.put(s);
+ tf.seek(0);
+#else
+ tf << s;
+ tf.rdbuf()->seekoff(0, ios::beg);
+#endif
+ tf.get(s, 100);
+ assert(tf.good());
+ cout << "first line of file:\n" << s << "\n";
+ cout << "next char = ";
+ tf.get(ch);
+ cout << (int)ch;
+ cout.put('\n');
+ assert(ch == 10);
+ strcpy(s, "Now there is a second line.\n");
+ cout << "reopening tempfile, appending: " << s;
+#ifdef _OLD_STREAMS
+ tf.open(tf.name(), io_appendonly, a_use);
+#else
+ tf.close();
+ tf.open("tempfile", ios::app);
+#endif
+ assert(tf.good());
+ assert(tf.is_open());
+ assert(tf.writable());
+ assert(!tf.readable());
+#ifdef _OLD_STREAMS
+ tf.put(s);
+ assert(tf.good());
+ tf.open(tf.name(), io_readonly, a_use);
+#else
+ tf << s;
+ assert(tf.good());
+ tf.close();
+ tf.open("tempfile", ios::in);
+#endif
+ tf.raw();
+ assert(tf.good());
+ assert(tf.is_open());
+ assert(!tf.writable());
+ assert(tf.readable());
+ cout << "First 10 chars via raw system read after reopen for input:\n";
+ read(tf.filedesc(), s, 10);
+ assert(tf.good());
+ for (i = 0; i < 10; ++ i)
+ cout.put(s[i]);
+ lseek(tf.filedesc(), 5, 0);
+ cout << "\nContents after raw lseek to pos 5:\n";
+ while ( (tf.get(ch)) && (cout.put(ch)) );
+#ifdef _OLD_STREAMS
+ tf.remove();
+#else
+ tf.close();
+ unlink("tempfile");
+#endif
+ assert(!tf.is_open());
+}
+
+void t5()
+{
+ record r;
+ int i;
+ cout << "\nMaking SFile rf...";
+#ifdef _OLD_STREAMS
+ SFile rf("recfile", sizeof(record), io_readwrite, a_create);
+#else
+ SFile rf("recfile", sizeof(record), ios::in|ios::out|ios::trunc);
+#endif
+ assert(rf.good());
+ assert(rf.is_open());
+ assert(rf.writable());
+ assert(rf.readable());
+ for (i = 0; i < 10; ++i)
+ {
+ r.c = i + 'a';
+ r.i = i;
+ r.d = (double)(i) / 1000.0;
+ rf.put(&r);
+ }
+ assert(rf.good());
+ cout << "odd elements of file in reverse order:\n";
+ for (i = 9; i >= 0; i -= 2)
+ {
+ rf[i].get(&r);
+ assert(r.c == i + 'a');
+ assert(r.i == i);
+ cout << r << "\n";
+ }
+ assert(rf.good());
+#ifdef _OLD_STREAMS
+ rf.remove();
+#else
+ rf.close();
+ unlink("recfile");
+#endif
+ assert(!rf.is_open());
+}
+
+void t6()
+{
+ cout << "\nMaking PlotFile pf ...";
+ static const char plot_name[] = "plot.out";
+ PlotFile pf(plot_name);
+ assert(pf.good());
+ assert(pf.is_open());
+ assert(pf.writable());
+ assert(!pf.readable());
+ pf.move(10,10);
+ pf.label("Test");
+ pf.circle(300,300,200);
+ pf.line(100, 100, 500, 500);
+ assert(pf.good());
+#ifdef _OLD_STREAMS
+ cout << "(You may delete or attempt to plot " << pf.name() << ")\n";
+#else
+ cout << "(You may delete or attempt to plot " << plot_name << ")\n";
+#endif
+}
+
+void t7()
+{
+ char ch;
+ static char t7_line1[] = "This is a string-based stream.\n";
+ static char t7_line2[] = "With two lines.\n";
+ char mybuf[60];
+ char *bufp;
+#ifdef _OLD_STREAMS
+ cout << "creating string-based ostream...\n";
+ ostream strout(60, mybuf);
+#else
+ cout << "creating ostrstream...\n";
+ ostrstream strout(mybuf, 60);
+#endif
+ assert(strout.good());
+ assert(strout.writable());
+ strout << t7_line1 << t7_line2 << ends;
+ assert(strout.good());
+ cout << "with contents:\n";
+ bufp = strout.str();
+ assert(bufp == mybuf);
+ strout.rdbuf()->freeze(0); /* Should be a no-op */
+ cout << mybuf;
+#ifdef _OLD_STREAMS
+ cout << "using it to create string-based istream...\n";
+ istream strin(strlen(mybuf), mybuf);
+#else
+ cout << "using it to create istrstream...\n";
+ istrstream strin(mybuf, strlen(mybuf));
+#endif
+ assert(strin.good());
+ assert(strin.readable());
+ cout << "with contents:\n";
+#ifndef _OLD_STREAMS
+ char line[100];
+ strin.getline(line, 100);
+ int line1_len = strlen(t7_line1);
+ assert(strin.tellg() == line1_len);
+ int line_len = strin.gcount();
+ assert(line_len == line1_len);
+ cout.write(line, line1_len - 1);
+ cout << endl;
+#endif
+ while (strin.get(ch)) cout.put(ch);
+
+ strstream str1;
+ strstream str2;
+ str1 << "Testing string-based stream using strstream.\n";
+ str1.seekg(0);
+ for (;;) {
+ int i = str1.get();
+ if (i == EOF)
+ break;
+ str2 << (char)i;
+ }
+ str2 << ends;
+ cout << str2.str();
+
+ // This should make it overflow.
+ strout << t7_line1;
+ assert (strout.bad());
+}
+
+void t8()
+{
+#ifdef _OLD_STREAMS
+ cout << "\nThe following file open should generate error message:";
+ cout.flush();
+ File ef("shouldnotexist", io_readonly, a_useonly);
+#else
+ ifstream ef("shouldnotexist");
+#endif
+ assert(!ef.good());
+ assert(!ef.is_open());
+}
+
+void t9()
+{
+ char ch;
+ static char ffile_name[] = "ftmp";
+ {
+ cout << "\nMaking filebuf streams fout and fin...";
+ filebuf foutbuf;
+#ifdef _OLD_STREAMS
+ foutbuf.open(ffile_name, output);
+#else
+ foutbuf.open(ffile_name, ios::out);
+#endif
+ ostream fout(&foutbuf);
+ assert(fout.good());
+ assert(fout.is_open());
+ assert(fout.writable());
+ assert(!fout.readable());
+ fout << "This file has one line testing output streams.\n";
+#ifdef _OLD_STREAMS
+ fout.close();
+ assert(!fout.is_open());
+#endif
+ }
+ filebuf finbuf;
+#ifdef _OLD_STREAMS
+ finbuf.open(ffile_name, input);
+#else
+ finbuf.open(ffile_name, ios::in);
+#endif
+ istream fin(&finbuf);
+ assert(fin.good());
+ assert(fin.is_open());
+ assert(!fin.writable());
+ assert(fin.readable());
+ cout << "contents of file:\n";
+ while(fin >> ch) cout << ch;
+#ifndef _OLD_STREAMS
+ cout << '\n';
+#endif
+ fin.close();
+ assert(!fin.is_open());
+}
+
+void t10()
+{
+ int fileCnt = 3;
+ char *file_name_pattern = "ftmp%d";
+ char current_file_name[50];
+ ifstream inFile;
+ ofstream outFile;
+ char c;
+ int i;
+
+ cout << '\n';
+
+ // Write some files.
+ for (i=0; i < fileCnt; i++) {
+ sprintf(current_file_name, file_name_pattern, i);
+ outFile.open(current_file_name, ios::out);
+
+ if ( outFile.fail() )
+ cerr << "File " << current_file_name
+ << " can't be opened for output" << endl;
+ else {
+ outFile << "This is line 1 of " << current_file_name << '\n';
+ outFile << "This is line 2 of " << current_file_name << endl;
+ outFile.close();
+ }
+ }
+
+ // Now read the files back in, and write then out to cout.
+ for (i=0; i < fileCnt; i++) {
+ sprintf(current_file_name, file_name_pattern, i);
+ inFile.open(current_file_name, ios::in);
+
+
+ if ( inFile.fail() )
+ cerr << "File " << current_file_name
+ << " can't be opened for input" << endl;
+ else {
+ while ( inFile.get (c))
+ cout << c;
+ cout << endl;
+ inFile.close();
+ }
+ }
+}
+
+// Test form
+
+void t11()
+{
+ int count1, count2;
+ cout.form("%.2f+%.2f = %4.3e\n%n", 5.5, 6.25, 5.5+6.25, &count1);
+ char *text = "Previous line has12345";
+ char text_length_to_use = strlen(text) - 5;
+ count2 = cout.rdbuf()->form("%-*.*s%3g characters\n",
+ text_length_to_use + 1,
+ text_length_to_use,
+ text,
+ (double)(count1-1));
+ cout.form("%-*.*s%+d characters\n%n",
+ text_length_to_use + 1, text_length_to_use, text,
+ count2-1, &count1);
+ assert(count1 == 33);
+}
+
+static void
+show_int (long val)
+{
+ cout.setf(ios::showbase);
+ cout << dec; cout.width (8); cout << val << "(dec) = ";
+ cout << hex; cout.width (8); cout << (0xFFFF & val) << "(hex) = ";
+ cout << oct; cout.width (8);
+ cout << (0xFFFF & val) << "(oct) [showbase on]\n";
+ cout.unsetf(ios::showbase);
+ cout << dec; cout.width (8); cout << val << "(dec) = ";
+ cout << hex; cout.width (8); cout << (0xFFFF & val) << "(hex) = ";
+ cout << oct; cout.width (8);
+ cout << (0xFFFF & val) << "(oct) [showbase off]\n";
+}
+
+void
+t12 ()
+{
+ ios::fmtflags old_flags = cout.setf(ios::showpos);
+ int fill = cout.fill('_');
+ cout.unsetf(ios::uppercase);
+ cout.setf(ios::internal, ios::adjustfield);
+ show_int(34567);
+ show_int(-34567);
+ cout.setf(ios::right, ios::adjustfield);
+ show_int(0);
+ cout.setf(ios::uppercase);
+ cout.unsetf(ios::showpos);
+ show_int(34567);
+ cout.setf(ios::left, ios::adjustfield);
+ show_int(-34567);
+ cout.fill(fill);
+ show_int(0);
+ cout.setf(old_flags,
+ ios::adjustfield|ios::basefield
+ |ios::showbase|ios::showpos|ios::uppercase);
+}
+
+main(int argc, char **argv)
+{
+ if (argc > 1 && strncmp(argv[1], "-b", 2) == 0) {
+ streambuf *sb = cout.rdbuf();
+ streambuf *ret;
+ int buffer_size = atoi(&argv[1][2]);
+ if (buffer_size == 0)
+ ret = sb->setbuf(NULL, 0);
+ else
+ ret = sb->setbuf(new char[buffer_size], buffer_size);
+ if (ret != sb)
+ cerr << "Warning: cout.rdbuf()->setbuf failed!\n";
+ }
+ t1();
+ t2();
+ t3();
+ t4();
+ t5();
+ t6();
+ t7();
+ t9();
+ t8();
+ t10();
+ t11();
+ t12();
+
+ cout << "Final names & states:\n";
+#ifdef _OLD_STREAMS
+ cout << "cin: " << cin.name() << "\t" << cin.rdstate() << "\n";
+ cout << "cout: " << cout.name() << "\t" << cout.rdstate() << "\n";
+ cout << "cerr: " << cerr.name() << "\t" << cerr.rdstate() << "\n";
+#else
+ cout << "cin: " << "(stdin)" << "\t" << cin.rdstate() << "\n";
+ cout << "cout: " << "(stdout)" << "\t" << cout.rdstate() << "\n";
+ cout << "cerr: " << "(stderr)" << "\t" << cerr.rdstate() << "\n";
+#endif
+ cout << "\nend of test.\n";
+}
diff --git a/libio/tests/tFile.exp b/libio/tests/tFile.exp
new file mode 100644
index 00000000000..154cd24dc0b
--- /dev/null
+++ b/libio/tests/tFile.exp
@@ -0,0 +1,75 @@
+Hello, world via cout
+Hello, world via cerr
+enter a char:c = "a"
+enter three integers (short, int, long):first = 123 via dec = 123
+second = 4567 via form = 4567 = 010727 via cout.form = 4567 = 0x11d7
+third = 89012 via hex = 15bb4
+enter a float then a double:first = 123.456
+second = -0.012
+enter 5 characters separated with spaces:first = 1
+rest = 2 3 4 5
+A 10-character buffer: abcdefghi
+
+Making streams sout and sin...contents of file:
+Thisfilehasonelinetestingoutputstreams.
+Making File tf ... first line of file:
+This is the first and only line of this file.
+next char = 10
+reopening tempfile, appending: Now there is a second line.
+First 10 chars via raw system read after reopen for input:
+This is th
+Contents after raw lseek to pos 5:
+is the first and only line of this file.
+Now there is a second line.
+
+Making SFile rf...odd elements of file in reverse order:
+(i = 9 c = j d = 0.009)
+(i = 7 c = h d = 0.007)
+(i = 5 c = f d = 0.005)
+(i = 3 c = d d = 0.003)
+(i = 1 c = b d = 0.001)
+
+Making PlotFile pf ...(You may delete or attempt to plot plot.out)
+creating ostrstream...
+with contents:
+This is a string-based stream.
+With two lines.
+using it to create istrstream...
+with contents:
+This is a string-based stream.
+With two lines.
+Testing string-based stream using strstream.
+
+Making filebuf streams fout and fin...contents of file:
+Thisfilehasonelinetestingoutputstreams.
+
+This is line 1 of ftmp0
+This is line 2 of ftmp0
+
+This is line 1 of ftmp1
+This is line 2 of ftmp1
+
+This is line 1 of ftmp2
+This is line 2 of ftmp2
+
+5.50+6.25 = 1.175e+01
+Previous line has 21 characters
+Previous line has +32 characters
++__34567(dec) = 0x__8707(hex) = _0103407(oct) [showbase on]
++__34567(dec) = ____8707(hex) = __103407(oct) [showbase off]
+-__34567(dec) = 0x__78f9(hex) = __074371(oct) [showbase on]
+-__34567(dec) = ____78f9(hex) = ___74371(oct) [showbase off]
+______+0(dec) = _____0x0(hex) = _______0(oct) [showbase on]
+______+0(dec) = _______0(hex) = _______0(oct) [showbase off]
+___34567(dec) = __0X8707(hex) = _0103407(oct) [showbase on]
+___34567(dec) = ____8707(hex) = __103407(oct) [showbase off]
+-34567__(dec) = 0X78F9__(hex) = 074371__(oct) [showbase on]
+-34567__(dec) = 78F9____(hex) = 74371___(oct) [showbase off]
+0 (dec) = 0X0 (hex) = 0 (oct) [showbase on]
+0 (dec) = 0 (hex) = 0 (oct) [showbase off]
+Final names & states:
+cin: (stdin) 0
+cout: (stdout) 0
+cerr: (stderr) 0
+
+end of test.
diff --git a/libio/tests/tFile.inp b/libio/tests/tFile.inp
new file mode 100644
index 00000000000..5b821ef072b
--- /dev/null
+++ b/libio/tests/tFile.inp
@@ -0,0 +1,5 @@
+a
+123 4567 89012
+123.456 -1.2e-2
+1 2 3 4 5
+abcdefghijklmnop
diff --git a/libio/tests/tfformat.c b/libio/tests/tfformat.c
new file mode 100644
index 00000000000..29bac8b6b79
--- /dev/null
+++ b/libio/tests/tfformat.c
@@ -0,0 +1,4181 @@
+#ifdef TEST_LIBIO
+#include <iostdio.h>
+#else
+#ifdef __cplusplus
+#include <strstream.h>
+#else
+#include <stdio.h>
+#endif
+#endif /* !TEST_LIBIO */
+
+/* Tests taken from Cygnus C library. */
+
+typedef struct
+{
+ int line;
+ double value;
+ char *result;
+ char *format_string;
+} sprint_double_type;
+
+sprint_double_type sprint_doubles[] =
+{
+__LINE__, 30.3, "< +30.3>", "<%+15.10g>",
+__LINE__, 10.0, "<10.00>", "<%5.2f>",
+
+__LINE__, 1.002121970718271e+05, "100212.19707 ", "%0-15.5f",
+__LINE__, -1.002121970718271e+05, "-100212.19707 ", "%0-15.5f",
+__LINE__, 1.002121970718271e+05, "000100212.19707", "%015.5f",
+__LINE__, -1.002121970718271e+05, "-00100212.19707", "%015.5f",
+__LINE__, 1.002121970718271e+05, "+00100212.19707", "%+015.5f",
+__LINE__, -1.002121970718271e+05, "-00100212.19707", "%+015.5f",
+__LINE__, 1.002121970718271e+05, " 00100212.19707", "% 015.5f",
+__LINE__, -1.002121970718271e+05, "-00100212.19707", "% 015.5f",
+__LINE__, 1.002121970718271e+05, "+100212.19707 ", "%+-15.5f",
+__LINE__, -1.002121970718271e+05, "-100212.19707 ", "%+-15.5f",
+
+__LINE__, -1.002121970718271e+29, "-1.0E+29", "%.1E",
+__LINE__, -1.002126048612756e-02, "-1.002126E-02", "%+#E",
+__LINE__, -1.002653755271637e+00, "-1.00265", "%G",
+__LINE__, -1.003238744365917e-23, "-0.00", "%4.2f",
+__LINE__, -1.005084840877781e-29, " -0", "%4.f",
+__LINE__, -1.005362549674427e+01, "-10.0536", "%#g",
+__LINE__, -1.005915042991691e-17, "-1.00592E-17", "%G",
+__LINE__, -1.007829874228503e-18, "-1.00783e-18", "%.7g",
+__LINE__, -1.007829874228503e-18, "-1.007830e-18", "%#.7g",
+__LINE__, -1.009390937771849e+15, "-1009390937771848.628657", "%+f",
+__LINE__, -1.010679382726182e-29, "-0.0000000", "%.7f",
+__LINE__, -1.010691853346650e+13, "-10106918533466.497934", "%+f",
+__LINE__, -1.013412912122286e-22, "-1.01E-22", "%.2E",
+__LINE__, -1.019269582113858e-25, " -0", "%4.0f",
+__LINE__, -1.019886033368556e+24, "-1.019886E+24", "%+.7G",
+__LINE__, -1.021037413548719e+02, "-102.103741", "%f",
+__LINE__, -1.023833576089065e+26, "-1.023834E+26", "%+E",
+__LINE__, -1.024736652408627e+10, "-10247366524.086265", "%+f",
+__LINE__, -1.025439198495476e+09, "-1.02544e+09", "%+g",
+__LINE__, -1.027080247585776e-04, "-0.0001027", "%6.7f",
+__LINE__, -1.028096307262016e+18, "-1.0281E+18", "%3G",
+__LINE__, -1.029604290697901e-02, "-0.010296", "%g",
+__LINE__, -1.034347730570491e+16, "-10343477305704908.975059", "%+f",
+__LINE__, -1.034663325049286e+22, "-1.0E+22", "%#.1E",
+__LINE__, -1.034843152721857e-14, " -0", "%6.f",
+__LINE__, -1.036082122299529e-29, "-1.04e-29", "%4.3g",
+__LINE__, -1.037213662365954e-09, "-1e-09", "%3.e",
+__LINE__, -1.038563976775690e-12, "-0.000000", "%f",
+__LINE__, -1.040910158681323e-02, "-0.0104091", "%+G",
+__LINE__, -1.044680094714482e-20, "-1.04468E-20", "%G",
+__LINE__, -1.044990054091126e+24, "-1.044990E+24", "%+E",
+__LINE__, -1.045693871096982e+11, "-1.045694e+11", "%+e",
+__LINE__, -1.045714133591312e-04, "-0.000104571", "%+#3g",
+__LINE__, -1.046215079103016e-15, "-1.04622e-15", "%g",
+__LINE__, -1.046285293993789e-18, "-1.04629E-18", "%+4G",
+__LINE__, -1.046306092899333e-06, "-0.00", "%0.2f",
+__LINE__, -1.047308973649206e-22, "-1.05E-22", "%+1.3G",
+__LINE__, -1.047369032507755e+01, "-1.047369E+01", "%E",
+__LINE__, -1.048986365562919e-21, "-1.05E-21", "%+.2E",
+__LINE__, -1.049530193156793e-17, "-1.04953E-17", "%+G",
+__LINE__, -1.050073419263768e+25, "-1.05007e+25", "%g",
+__LINE__, -1.051739652002504e-28, "-0.000000", "%+f",
+__LINE__, -1.054493420082636e+21, "-1.0545e+21", "%#5.4e",
+__LINE__, -1.055867291029098e+18, "-1.05587e+18", "%g",
+__LINE__, -1.056514389757866e-16, "-1.05651E-16", "%5.6G",
+__LINE__, -1.057180924868704e+15, "-1057180924868704", "%4.f",
+__LINE__, -1.058455468395683e-23, "-1.05846e-23", "%g",
+__LINE__, -1.062560982393212e+08, "-1.06256e+08", "%g",
+__LINE__, -1.063365829241138e-10, "-1.063366e-10", "%+e",
+__LINE__, -1.063568908667280e-19, "-1.06357E-19", "%+G",
+__LINE__, -1.063734263253492e-13, "-0.000000", "%0f",
+__LINE__, -1.064472689765495e-13, "-1E-13", "%4.0G",
+__LINE__, -1.067192610000129e-25, "-1.06719E-25", "%G",
+__LINE__, -1.068401334996592e-12, "-0.0000000", "%+.7f",
+__LINE__, -1.069012628653724e-13, "-1.069013E-13", "%+.7G",
+__LINE__, -1.069451976810790e+16, "-10694519768107904.056365", "%f",
+__LINE__, -1.069568935323556e+17, "-1.06957e+17", "%g",
+__LINE__, -1.071351044854107e-29, "-1.07135e-29", "%g",
+__LINE__, -1.072274197526185e-21, "-1E-21", "%1.G",
+__LINE__, -1.073875921752995e+23, "-1E+23", "%5.E",
+__LINE__, -1.074835151152265e-12, "-1.0748e-12", "%1.5g",
+__LINE__, -1.075171047088241e-19, "-1.07517E-19", "%#G",
+__LINE__, -1.076258826412760e+22, "-1.076259e+22", "%+e",
+__LINE__, -1.076365103160401e+06, "-1.07637E+06", "%+4.6G",
+__LINE__, -1.076817750454633e+08, "-1e+08", "%4.g",
+__LINE__, -1.078615405755685e-30, "-1e-30", "%4.g",
+__LINE__, -1.078629622917468e-25, "-1.078630e-25", "%e",
+__LINE__, -1.079352432833170e+11, "-107935243283", "%+2.f",
+__LINE__, -1.081431147440215e+16, "-10814311474402147.439378", "%+f",
+__LINE__, -1.083042116905339e-16, "-1.083e-16", "%.5g",
+__LINE__, -1.085351710708553e-10, "-1.085e-10", "%1.4g",
+__LINE__, -1.085796045618276e+07, "-1.085796e+07", "%e",
+__LINE__, -1.087398259981007e+22, "-1.0874e+22", "%g",
+__LINE__, -1.087986044402224e-11, "-1.087986e-11", "%e",
+__LINE__, -1.090451848762709e-02, "-1.090452e-02", "%e",
+__LINE__, -1.091463236899737e+11, "-1.091463E+11", "%#E",
+__LINE__, -1.091617921737384e-29, "-1.09162e-29", "%3g",
+__LINE__, -1.092049328579047e-17, "-1.092049E-17", "%E",
+__LINE__, -1.093647615472090e+06, "-1093647.61547", "%6.5f",
+__LINE__, -1.094133175602384e-08, "-1.1E-08", "%0.1E",
+__LINE__, -1.095397916728214e-23, "-1e-23", "%6.e",
+__LINE__, -1.098958790437321e+02, "-109.895879", "%+#f",
+__LINE__, -1.100194638181594e-20, "-1.100195e-20", "%e",
+__LINE__, -1.102174253534260e+05, "-1.1e+05", "%2.3g",
+__LINE__, -1.102890180316350e-12, "-1.10289e-12", "%+g",
+__LINE__, -1.105582337418378e+00, "-1.11", "%3.3g",
+__LINE__, -1.110515122647056e+04, "-1.E+04", "%#0.G",
+__LINE__, -1.111365895262625e-18, "-1e-18", "%0.g",
+__LINE__, -1.112010622677495e+04, "-11120.1", "%g",
+__LINE__, -1.112580043156699e-23, "-1.11258e-23", "%1g",
+__LINE__, -1.112829057091303e+08, "-1.11283e+08", "%+2g",
+__LINE__, -1.115019046200472e+18, "-1.1150190e+18", "%+#.7e",
+__LINE__, -1.118078332268016e-13, "-1.12E-13", "%1.3G",
+__LINE__, -1.119113571963886e+08, "-1.119114e+08", "%e",
+__LINE__, -1.120102397563448e-15, "-1.12e-15", "%.4g",
+__LINE__, -1.120707480791434e-19, "-1.12071e-19", "%g",
+__LINE__, -1.124243676139007e-07, "-0.000000", "%f",
+__LINE__, -1.125025214608798e+15, "-1.12503E+15", "%0G",
+__LINE__, -1.126074395136447e+06, "-1E+06", "%+.0G",
+__LINE__, -1.127203019940870e-06, "-0.000001", "%+#7f",
+__LINE__, -1.130577648480677e+01, "-1.130578e+01", "%e",
+__LINE__, -1.131469694425240e-11, "-1.13147e-11", "%#0.6g",
+__LINE__, -1.132225023239752e+02, "-113.223", "%G",
+__LINE__, -1.133702113050128e+20, "-1E+20", "%+3.E",
+__LINE__, -1.135529466224404e-13, "-1.13553e-13", "%#g",
+__LINE__, -1.137587210063004e+21, "-1e+21", "%.1g",
+__LINE__, -1.140765637106361e-21, "-1.1e-21", "%+.1e",
+__LINE__, -1.141182595083699e-18, "-0.000000", "%f",
+__LINE__, -1.141695709120972e+00, "-1.1417", "%3G",
+__LINE__, -1.143199141708028e+18, "-1143199141708027833", "%2.f",
+__LINE__, -1.146712902056139e+21, "-1146712902056139071760.298975", "%f",
+__LINE__, -1.146837903839073e-02, " -0.0", "%+5.1f",
+__LINE__, -1.147363016107446e+10, "-1.14736e+10", "%+7g",
+__LINE__, -1.149575523465052e+20, "-114957552346505220697.28140", "%+.5f",
+__LINE__, -1.152748955392589e+13, "-1.15275E+13", "%G",
+__LINE__, -1.152751106015483e-17, "-1E-17", "%+3.E",
+__LINE__, -1.155539139258226e-18, "-1.2e-18", "%+.2g",
+__LINE__, -1.157089280563492e+20, "-1.15709e+20", "%g",
+__LINE__, -1.161217745859779e+19, "-1.161218E+19", "%E",
+__LINE__, -1.162293536734798e+10, "-11622935367.347980", "%f",
+__LINE__, -1.162629909468603e+20, "-1.16E+20", "%.3G",
+__LINE__, -1.164979155838631e+24, "-1.16498E+24", "%G",
+__LINE__, -1.165103052644816e-20, " -1e-20", "%+7.g",
+__LINE__, -1.166448459023264e-08, "-0.000000", "%f",
+__LINE__, -1.167694506705309e+28, "-1e+28", "%.1g",
+__LINE__, -1.169901754818745e-28, "-0.000000", "%+f",
+__LINE__, -1.170330336216446e+08, " -1e+08", "%7.g",
+__LINE__, -1.170946623214213e-17, "-1.17095E-17", "%G",
+__LINE__, -1.174581596799302e+27, "-1.174582e+27", "%+e",
+__LINE__, -1.174763473995155e-28, "-1E-28", "%.1G",
+__LINE__, -1.175885640508038e-23, "-1E-23", "%+.0E",
+__LINE__, -1.177268411775439e-05, "-0.000012", "%#2.6f",
+__LINE__, -1.177739669428001e-30, "-1.17774E-30", "%G",
+__LINE__, -1.178059639880544e-02, "-0.0117806", "%+.7G",
+__LINE__, -1.178793300854446e-13, "-1.2E-13", "%+#0.2G",
+__LINE__, -1.179629345138058e-04, "-0.000118", "%0.3g",
+__LINE__, -1.180730292213358e-25, "-1.18073e-25", "%g",
+__LINE__, -1.180766261654697e+02, "-118.077", "%3g",
+__LINE__, -1.181880261069391e-29, "-1.181880e-29", "%+#e",
+__LINE__, -1.183752810063514e-09, "-1.18375e-09", "%#g",
+__LINE__, -1.184191742443406e-21, "-1.184192e-21", "%e",
+__LINE__, -1.184859760488406e-26, "-1.18486E-26", "%G",
+__LINE__, -1.187276828720072e-29, "-1.18728E-29", "%G",
+__LINE__, -1.187992907205195e-04, "-1.187993E-04", "%E",
+__LINE__, -1.190586192763405e-28, "-1.E-28", "%#1.E",
+__LINE__, -1.192104053032086e+02, "-119.21", "%G",
+__LINE__, -1.192917884333569e+26, "-1.192918E+26", "%E",
+__LINE__, -1.195900753509801e+22, "-1.1959e+22", "%g",
+__LINE__, -1.196559413116537e-28, "-0.000000", "%6.6f",
+__LINE__, -1.197534588732952e+12, "-1.19753e+12", "%#g",
+__LINE__, -1.200279514790649e-25, "-0.0000", "%0.4f",
+__LINE__, -1.203806667944635e+10, "-1.2038067E+10", "%5.7E",
+__LINE__, -1.204344885974736e+07, "-1.204E+07", "%#2.4G",
+__LINE__, -1.205668007693083e+00, "-1.20567", "%g",
+__LINE__, -1.205898515218947e-11, "-1.2059e-11", "%+g",
+__LINE__, -1.206787414909373e-05, "-1.2e-05", "%2.2g",
+__LINE__, -1.207905830366447e+15, "-1.207906e+15", "%6.7g",
+__LINE__, -1.208067010597729e-17, "-1.208067e-17", "%5e",
+__LINE__, -1.210189135822574e+01, "-12", "%+2.0f",
+__LINE__, -1.211560695948122e+10, "-1.21156e+10", "%+g",
+__LINE__, -1.214003025273234e-18, "-1.214e-18", "%+g",
+__LINE__, -1.214096815259005e+17, "-121409681525900459.142520", "%f",
+__LINE__, -1.214699041716797e-14, "-1.2147E-14", "%G",
+__LINE__, -1.215061611919443e+14, "-121506161191944.306310", "%+#f",
+__LINE__, -1.217491221065185e+27, "-1.21749e+27", "%g",
+__LINE__, -1.218538401534388e-11, "-1.218538e-11", "%#e",
+__LINE__, -1.218810085883466e+16, "-1e+16", "%+.1g",
+__LINE__, -1.219422688169801e+08, "-1.219423e+08", "%e",
+__LINE__, -1.220473194407651e-14, "-1.2205E-14", "%1.5G",
+__LINE__, -1.220824440193375e-02, "-0.012208", "%4f",
+__LINE__, -1.221520240637007e+13, "-1.221520E+13", "%1E",
+__LINE__, -1.221894719843486e+29, "-1.22189E+29", "%G",
+__LINE__, -1.223020108610281e+25, "-1.22302E+25", "%G",
+__LINE__, -1.223203206227728e-02, "-0.012232", "%G",
+__LINE__, -1.225661737076919e-15, "-1.22566E-15", "%G",
+__LINE__, -1.228147221003795e-08, "-1.22815E-08", "%G",
+__LINE__, -1.228298534591771e+20, "-1.22830E+20", "%#G",
+__LINE__, -1.228469080229780e-02, "-0.012285", "%0f",
+__LINE__, -1.229161950699222e-09, "-1e-09", "%0.e",
+__LINE__, -1.231294820136559e-17, "-1.231295E-17", "%1.7G",
+__LINE__, -1.232588663406698e-21, "-1E-21", "%+0.G",
+__LINE__, -1.233381256982191e-26, "-0.000000", "%f",
+__LINE__, -1.233435864835578e+14, "-1.23344e+14", "%#g",
+__LINE__, -1.237409567806099e-25, "-1.23741E-25", "%#G",
+__LINE__, -1.238244697758558e-02, "-1.238245e-02", "%7e",
+__LINE__, -1.239393163123284e+26, "-1.23939e+26", "%+g",
+__LINE__, -1.240484781756132e-18, "-1E-18", "%4.E",
+__LINE__, -1.241420286838750e+23, "-1E+23", "%2.E",
+__LINE__, -1.243781122052343e-18, "-1.243781e-18", "%+e",
+__LINE__, -1.244421506844779e+07, "-1.244422E+07", "%+6E",
+__LINE__, -1.245754054764741e-21, "-1e-21", "%5.0g",
+__LINE__, -1.245992228426733e-24, "-0.000000", "%f",
+__LINE__, -1.246498277739883e-12, "-0.0000000", "%5.7f",
+__LINE__, -1.247130891343776e-18, "-1.24713E-18", "%G",
+__LINE__, -1.247309461703025e-03, "-0.0012473", "%#5.5G",
+__LINE__, -1.248139162966407e-29, "-1.e-29", "%+#6.g",
+__LINE__, -1.249756153623776e+08, "-1.249756e+08", "%e",
+__LINE__, -1.250899983565585e-10, "-1.2509e-10", "%5g",
+__LINE__, -1.250957368798327e+19, "-1.25096E+19", "%0G",
+__LINE__, -1.252630814464822e-02, "-0.012526", "%+f",
+__LINE__, -1.253076368257011e-28, "-0.000000", "%f",
+__LINE__, -1.254243507039370e+01, "-1.254244e+01", "%e",
+__LINE__, -1.257605614492298e-12, "-1.257606E-12", "%6.7G",
+__LINE__, -1.258041911573120e+06, "-1258041.911573", "%+f",
+__LINE__, -1.261670983426507e-25, "-0.00", "%.2f",
+__LINE__, -1.263216883336562e-14, "-1.26322e-14", "%g",
+__LINE__, -1.266846944498751e-15, "-1e-15", "%0.g",
+__LINE__, -1.266977908502326e+06, "-1266978", "%+1.f",
+__LINE__, -1.267006162870084e-23, "-1.267006e-23", "%e",
+__LINE__, -1.269144609375931e+01, "-1.269145e+01", "%+e",
+__LINE__, -1.269458714257904e+25, "-1.26946E+25", "%G",
+__LINE__, -1.276697325772662e-02, "-0.0128", "%7.3G",
+__LINE__, -1.278855081807602e+15, "-1278855081807601.87891", "%#0.5f",
+__LINE__, -1.278966821639612e+20, "-1.278967E+20", "%3E",
+__LINE__, -1.281942705258106e+03, "-1281.94", "%+G",
+__LINE__, -1.282331291499203e+14, "-128233129149920.266343", "%+f",
+__LINE__, -1.285125739341808e-28, "-1.28513e-28", "%g",
+__LINE__, -1.285700693704978e+11, "-1.285701E+11", "%E",
+__LINE__, -1.286574096459251e+28, "-1.287E+28", "%6.4G",
+__LINE__, -1.287967889247240e+03, "-1287.97", "%G",
+__LINE__, -1.288913808801319e-27, "-1.3e-27", "%7.1e",
+__LINE__, -1.289147517760377e-18, "-1.289148E-18", "%E",
+__LINE__, -1.289355006600107e+23, "-1.28936E+23", "%+G",
+__LINE__, -1.291232014623979e+01, "-1.29123E+01", "%+.5E",
+__LINE__, -1.293658562875966e-18, "-1.29366e-18", "%+g",
+__LINE__, -1.294982911983638e-19, "-1.29498E-19", "%#G",
+__LINE__, -1.296123363481695e-13, "-1.296123E-13", "%E",
+__LINE__, -1.296632862070602e-20, "-1.29663e-20", "%+g",
+__LINE__, -1.297801639022777e+23, "-129780163902277735132884.11777", "%#0.5f",
+__LINE__, -1.297886574534611e+16, "-1.297887e+16", "%+e",
+__LINE__, -1.300588216308401e+11, "-1.30e+11", "%.2e",
+__LINE__, -1.301296100909062e-10, "-1.3013e-10", "%+g",
+__LINE__, -1.303144244306468e-07, "-1.303144E-07", "%E",
+__LINE__, -1.304096315024042e-20, "-1.3041E-20", "%+G",
+__LINE__, -1.304817970675085e+16, "-1.304818E+16", "%+E",
+__LINE__, -1.304870304632683e-15, " -1e-15", "%7.g",
+__LINE__, -1.305213586757638e-18, "-1.30521e-18", "%g",
+__LINE__, -1.306880734910465e-22, "-1.306881E-22", "%E",
+__LINE__, -1.308964092631446e-23, "-1.30896e-23", "%g",
+__LINE__, -1.312070555198201e+26, "-131207055519820126043839537", "%+7.f",
+__LINE__, -1.312511609151056e-30, "-1.312512E-30", "%#E",
+__LINE__, -1.313087359008389e-23, "-0.000000", "%+f",
+__LINE__, -1.316948423042059e-02, "-1.316948E-02", "%+E",
+__LINE__, -1.317080882577385e+29, "-1.317E+29", "%+.4G",
+__LINE__, -1.317514598984346e+24, "-1.317515e+24", "%e",
+__LINE__, -1.317817551125923e-21, "-1.31782E-21", "%+G",
+__LINE__, -1.319603985988120e+29, "-131960398598811989856471882376.354188", "%f",
+__LINE__, -1.328850458671907e+06, "-1e+06", "%.0e",
+__LINE__, -1.328945346449817e-23, "-1.328945e-23", "%+e",
+__LINE__, -1.330146584094221e-08, "-1e-08", "%+5.g",
+__LINE__, -1.332609617892115e+00, "-1.33261", "%2.7G",
+#ifndef __PCCNECV70__
+__LINE__, -1.332751724965715e+22, "-13327517249657150344432.920974", "%f",
+__LINE__, -1.333194379353273e-19, "-0.000000", "%f",
+__LINE__, -1.334304387932777e-06, "-1.334304e-06", "%e",
+__LINE__, -1.334306581172082e-05, "-1.3e-05", "%+1.2g",
+__LINE__, -1.335283510893438e-05, " -1E-05", "%7.G",
+__LINE__, -1.337939692108373e+11, "-1.33794e+11", "%+4g",
+__LINE__, -1.339117288874809e-03, "-0.001", "%1.3f",
+__LINE__, -1.340100588141492e+27, "-1.340101E+27", "%E",
+__LINE__, -1.341953272572953e-19, "-0.000000", "%+f",
+__LINE__, -1.343058354301620e-02, "-1.343058e-02", "%e",
+__LINE__, -1.346662720871543e+22, "-1.34666E+22", "%#G",
+__LINE__, -1.354010578652210e-02, "-0.0135401", "%#g",
+__LINE__, -1.354066549307666e-12, " -0", "%+6.f",
+__LINE__, -1.355284719365947e+21, "-1.35528e+21", "%g",
+__LINE__, -1.356326532145087e+29, "-1E+29", "%4.G",
+__LINE__, -1.357278618897291e+19, "-13572786188972911780.581398", "%f",
+__LINE__, -1.357537331348202e-10, "-0.000", "%+.3f",
+__LINE__, -1.360011287595868e-10, "-0.000000", "%f",
+__LINE__, -1.360506902899232e+16, "-13605069028992320.", "%#5.f",
+__LINE__, -1.361102570277000e+10, "-1.3611E+10", "%G",
+__LINE__, -1.362601255900219e+07, "-1.363E+07", "%.4G",
+__LINE__, -1.366078182354771e+10, "-1.36608E+10", "%0G",
+__LINE__, -1.366667926615127e+08, "-136666792.661513", "%f",
+__LINE__, -1.367162823743231e-12, "-0.000000", "%#f",
+__LINE__, -1.371523037550709e+09, "-1.37152e+09", "%+g",
+__LINE__, -1.374328925986197e-17, "-1.37e-17", "%.2e",
+__LINE__, -1.374995603898421e-26, "-1.375e-26", "%+g",
+__LINE__, -1.376726539375688e+09, "-1.376727E+09", "%+E",
+__LINE__, -1.378351117694958e-13, "-0.000000", "%f",
+__LINE__, -1.378514699313619e-14, "-1.378515e-14", "%e",
+__LINE__, -1.379347588942324e-23, "-1.4e-23", "%+.1e",
+__LINE__, -1.380380583822272e-17, "-0.000000", "%+f",
+__LINE__, -1.381658659947406e+19, "-1.38166e+19", "%g",
+__LINE__, -1.382775316390237e+29, "-138277531639023653298181670834.3104", "%+#7.4f",
+__LINE__, -1.383541138922400e+00, "-1.383541E+00", "%E",
+__LINE__, -1.384625301445090e+01, "-13.8", "%+.3g",
+__LINE__, -1.386844086284027e-13, "-1.38684E-13", "%+G",
+__LINE__, -1.386930516448650e-28, "-1.386931E-28", "%E",
+__LINE__, -1.387444896054260e-07, "-1.38744E-07", "%G",
+__LINE__, -1.389685107980798e+22, "-1.38969E+22", "%G",
+__LINE__, -1.390880300369347e+03, "-1390.880300", "%f",
+__LINE__, -1.391423370198150e-17, "-1E-17", "%+2.G",
+__LINE__, -1.394441767471218e-09, "-1.394442e-09", "%e",
+__LINE__, -1.396275525062527e-20, "-1.39628E-20", "%G",
+__LINE__, -1.397045957455157e+24, "-1E+24", "%.0E",
+__LINE__, -1.397458546930799e+21, "-1397458546930798526375.383517", "%f",
+__LINE__, -1.397584578988941e-14, "-1.39758e-14", "%5g",
+__LINE__, -1.397789397300823e+09, "-1.398e+09", "%.4g",
+__LINE__, -1.398167472294874e+21, "-1.398167E+21", "%+7E",
+__LINE__, -1.398809636136688e-16, "-0.000000", "%+f",
+__LINE__, -1.399545335304119e+26, "-139954533530411872277454676.805064", "%#5f",
+__LINE__, -1.400102603335755e+20, "-140010260333575509150.705329", "%2f",
+__LINE__, -1.401212746235235e+04, "-1.401213e+04", "%e",
+__LINE__, -1.404409427681801e+07, "-1E+07", "%4.E",
+__LINE__, -1.406018114263948e-25, "-1e-25", "%3.e",
+__LINE__, -1.406245608096877e-06, "-1.4e-06", "%+.1e",
+__LINE__, -1.410697254683835e-10, "-1.410697e-10", "%e",
+__LINE__, -1.410739097553846e+25, "-1.410739E+25", "%+E",
+__LINE__, -1.410850631189577e+04, "-14108.5", "%.6g",
+__LINE__, -1.411680434455781e+28, "-14116804344557807304738616949.180141", "%f",
+__LINE__, -1.413309465660099e-27, "-1.413309E-27", "%+#E",
+__LINE__, -1.418468741386300e+09, "-1418468741.386300", "%f",
+__LINE__, -1.420277110892909e+06, "-1.42028e+06", "%1g",
+__LINE__, -1.420417889565590e-17, "-1.42E-17", "%.2E",
+__LINE__, -1.421098212056305e+08, "-1.421098e+08", "%4e",
+__LINE__, -1.421792812798986e-20, " -1E-20", "%7.G",
+__LINE__, -1.423675488122461e+18, "-1423675488122461363.360571", "%f",
+__LINE__, -1.423810545840653e+15, "-1E+15", "%3.E",
+__LINE__, -1.424242673476368e-15, "-1.424243e-15", "%e",
+__LINE__, -1.427847435688733e-01, "-1.427847E-01", "%E",
+__LINE__, -1.433897734612555e-04, "-0.0001", "%3.g",
+__LINE__, -1.434537754075696e-24, "-1.435E-24", "%+0.3E",
+__LINE__, -1.434774864809324e-24, "-1E-24", "%2.E",
+__LINE__, -1.435583851565142e-11, "-1E-11", "%.0E",
+__LINE__, -1.438791024010112e+11, "-1.43879e+11", "%#.6g",
+__LINE__, -1.439267565343777e+27, "-1.4e+27", "%2.1e",
+__LINE__, -1.439440602670449e+02, "-143.944", "%G",
+__LINE__, -1.439494412124925e+13, "-14394944121249.251268", "%f",
+__LINE__, -1.440032823245152e+10, "-14400328232.451516", "%f",
+__LINE__, -1.440174494009562e-08, "-0.000000", "%7f",
+__LINE__, -1.440827804010568e+07, "-1.E+07", "%#6.1G",
+__LINE__, -1.442760907195336e+09, "-1.44276E+09", "%+5G",
+__LINE__, -1.444655304181403e+10, "-14446553041.814035", "%7f",
+__LINE__, -1.444995766787036e+04, "-14450", "%5G",
+__LINE__, -1.445078682874535e-13, "-1E-13", "%3.E",
+__LINE__, -1.446781469662328e+01, "-14.4678", "%G",
+__LINE__, -1.447795251395321e-04, "-0.000145", "%+f",
+__LINE__, -1.448193079247108e-02, "-0.014", "%4.2G",
+__LINE__, -1.449552967961345e+14, "-1E+14", "%1.E",
+__LINE__, -1.451269763513571e+10, "-14512697635.135705", "%6f",
+__LINE__, -1.451843176990292e+12, "-1e+12", "%1.g",
+__LINE__, -1.452631405935931e+06, "-1.452631e+06", "%e",
+__LINE__, -1.452753650285897e+21, "-1452753650285897091265.496783", "%5f",
+__LINE__, -1.453811512433860e-05, "-1e-05", "%+6.g",
+__LINE__, -1.454071430557372e+13, "-1.4541E+13", "%.4E",
+__LINE__, -1.455956079562999e+03, "-1455.96", "%G",
+__LINE__, -1.459712196146602e-17, "-1.45971e-17", "%g",
+__LINE__, -1.461857733495947e-02, "-1.4619E-02", "%.4E",
+__LINE__, -1.465257069090911e-11, "-1.465257E-11", "%+E",
+__LINE__, -1.465306607257042e+05, "-146531", "%g",
+__LINE__, -1.465857076315921e+20, "-1.46586E+20", "%+G",
+__LINE__, -1.467919792051489e+16, "-1.46792e+16", "%2g",
+__LINE__, -1.469271519834567e+20, "-146927151983456720785", "%+.0f",
+__LINE__, -1.472961447442697e-28, "-1.47296e-28", "%#g",
+__LINE__, -1.473385695190456e-12, "-1.473386E-12", "%E",
+__LINE__, -1.485003089033267e-10, "-1.485E-10", "%2G",
+__LINE__, -1.490541379072390e-18, "-1.490541E-18", "%4E",
+__LINE__, -1.490683434793125e+22, "-14906834347931249951102.472551", "%#f",
+__LINE__, -1.498356837215425e+20, "-1.49836E+20", "%#G",
+__LINE__, -1.498677007818122e+14, "-1.49868E+14", "%+4G",
+__LINE__, -1.502143197677119e+23, "-150214319767711934616727.", "%#7.f",
+__LINE__, -1.503563770470753e-24, "-1.50356e-24", "%.6g",
+__LINE__, -1.504643092793197e-18, "-1.504643e-18", "%+4e",
+__LINE__, -1.507017706254022e-13, "-1.50702e-13", "%+g",
+__LINE__, -1.507054033750081e-22, "-0.000000", "%f",
+__LINE__, -1.508662346022339e+16, "-1.508662E+16", "%#E",
+__LINE__, -1.509366882438902e+08, "-2e+08", "%4.g",
+__LINE__, -1.511086567087967e+20, "-1.51109e+20", "%g",
+__LINE__, -1.514959134622707e-18, "-0.000000", "%+f",
+__LINE__, -1.515730120364204e+06, "-2E+06", "%0.G",
+__LINE__, -1.516372763118606e-09, "-1.51637e-09", "%g",
+__LINE__, -1.520610443546204e+27, "-1.52061e+27", "%g",
+__LINE__, -1.522040655642012e+11, "-1.52204E+11", "%+2G",
+__LINE__, -1.523772495014966e-24, "-2E-24", "%2.G",
+__LINE__, -1.523980825983892e-05, "-0.000", "%2.3f",
+__LINE__, -1.526696214603152e-03, "-0.0015267", "%+6.5G",
+__LINE__, -1.528680540769583e+00, "-1.5287", "%0.5G",
+__LINE__, -1.529951830525433e+08, "-1.529952e+08", "%+e",
+__LINE__, -1.533052896559935e+05, "-153305", "%4.0f",
+__LINE__, -1.533829640475152e-03, "-0.00153383", "%+#g",
+__LINE__, -1.535617804643105e-30, "-1.535618e-30", "%e",
+__LINE__, -1.537623698361821e+16, "-15376236983618207.7875719", "%4.7f",
+__LINE__, -1.544994895330616e+24, "-1.54499e+24", "%g",
+__LINE__, -1.545083356728403e+17, "-1.545083e+17", "%e",
+__LINE__, -1.545684535393879e+12, "-1.55E+12", "%3.3G",
+__LINE__, -1.545878334099427e+13, "-15458783340994.268762", "%1f",
+__LINE__, -1.547697185980564e-18, "-1.5477e-18", "%.6g",
+__LINE__, -1.548576527172579e-29, "-1.5E-29", "%2.2G",
+__LINE__, -1.549712227835891e+08, "-1.549712e+08", "%#6.7g",
+__LINE__, -1.550010819435335e-21, "-1.55001E-21", "%G",
+__LINE__, -1.551412476164257e+14, "-1.551412E+14", "%E",
+__LINE__, -1.553156638090030e+01, " -2E+01", "%7.G",
+__LINE__, -1.553733233064355e-01, "-0.2", "%3.g",
+__LINE__, -1.558391111609365e+00, "-1.558391", "%+f",
+__LINE__, -1.562004019284766e+15, "-1.562E+15", "%6.5G",
+__LINE__, -1.562195733239758e-16, "-0.000000", "%f",
+__LINE__, -1.563953339012525e-14, "-1.56395E-14", "%1G",
+__LINE__, -1.568317638534983e+18, "-1.56832E+18", "%1G",
+__LINE__, -1.568546851135348e+04, "-15685.5", "%+#G",
+__LINE__, -1.574297872228857e+18, "-1.574298e+18", "%e",
+__LINE__, -1.575696460196291e-21, "-1.5757E-21", "%G",
+__LINE__, -1.576324848379791e+25, "-1.57632E+25", "%+G",
+__LINE__, -1.577524395140843e+06, "-1.5775E+06", "%.5G",
+__LINE__, -1.585122856675091e+12, "-1585122856675.091452", "%f",
+__LINE__, -1.586734674395556e-02, "-1.586735E-02", "%E",
+__LINE__, -1.592602264315192e+22, "-1.5926E+22", "%G",
+__LINE__, -1.594121556700562e+05, "-2E+05", "%+.0G",
+__LINE__, -1.598538116193430e+22, "-1.59854e+22", "%+g",
+__LINE__, -1.605647463222382e+18, "-1.6056E+18", "%.5G",
+__LINE__, -1.610891449201191e+06, "-1.6109E+06", "%#6.4E",
+__LINE__, -1.614593168166818e-05, "-1.61459E-05", "%G",
+__LINE__, -1.615597722557325e-03, "-0.001616", "%f",
+__LINE__, -1.616038022182124e-29, "-1.61604E-29", "%1G",
+__LINE__, -1.618380771451625e-28, "-2e-28", "%+1.g",
+__LINE__, -1.620287456872150e+10, "-1.620e+10", "%#7.3e",
+__LINE__, -1.620469955611903e-29, "-0.000000", "%f",
+__LINE__, -1.622580720690927e+20, "-1.622581E+20", "%+#E",
+__LINE__, -1.622752500991079e-12, "-1.622753E-12", "%E",
+__LINE__, -1.622771933776459e+08, "-1.6228E+08", "%+4.4E",
+__LINE__, -1.623894567037391e+09, "-1.623895e+09", "%#e",
+__LINE__, -1.624021408185354e-25, "-1.624E-25", "%.5G",
+__LINE__, -1.624405320939366e-06, "-1.62441e-06", "%+#g",
+__LINE__, -1.631236208958857e-25, "-1.631236e-25", "%#e",
+__LINE__, -1.632165969536046e+20, "-1.63217E+20", "%G",
+__LINE__, -1.632859596256475e+06, "-1.63286E+06", "%G",
+__LINE__, -1.634371961703112e+06, "-1.634372E+06", "%+E",
+__LINE__, -1.637230383641845e+24, "-1.63723e+24", "%#g",
+__LINE__, -1.638081480475853e+17, "-1.63808e+17", "%+g",
+__LINE__, -1.638279690467673e+14, "-163827969046767.325523", "%#f",
+__LINE__, -1.640360249548215e-29, "-1.64036e-29", "%+6.6g",
+__LINE__, -1.645691728060833e-30, "-1.64569e-30", "%g",
+__LINE__, -1.648548965852592e-03, " -0", "%5.f",
+__LINE__, -1.650100957771182e+21, "-1650100957771182308420.065965", "%+f",
+__LINE__, -1.650957176011913e-02, "-0.016510", "%#4.5G",
+__LINE__, -1.651165108095301e+29, "-165116510809530137038336761179.380119", "%f",
+__LINE__, -1.657132845094847e-06, "-0.000002", "%f",
+__LINE__, -1.657152146172541e+12, "-1.657152E+12", "%.7G",
+__LINE__, -1.658377345516132e-06, "-0.00", "%.2f",
+__LINE__, -1.658850468902324e+20, "-1.659e+20", "%.4g",
+__LINE__, -1.661723557149830e+18, "-1.66172E+18", "%G",
+__LINE__, -1.663570885140273e+14, "-166357088514027", "%2.f",
+__LINE__, -1.665186944896906e+25, "-1.66519E+25", "%G",
+__LINE__, -1.675910137717036e+22, "-2e+22", "%5.g",
+__LINE__, -1.677447987675587e-15, "-1.67745E-15", "%G",
+__LINE__, -1.677510590697220e+06, "-1677510.590697", "%5f",
+__LINE__, -1.677658141289510e-18, "-2E-18", "%+5.G",
+__LINE__, -1.678316848066192e-03, "-1.678317E-03", "%E",
+__LINE__, -1.681506404024821e+24, "-1.68151E+24", "%G",
+__LINE__, -1.688584243722160e+12, "-1.68858E+12", "%+#G",
+__LINE__, -1.689468295411408e+28, "-1.68947E+28", "%+G",
+__LINE__, -1.690746767470207e-11, "-1.69075E-11", "%G",
+__LINE__, -1.692773960755248e-14, "-2E-14", "%4.E",
+__LINE__, -1.693349092740995e-18, "-1.69335e-18", "%g",
+__LINE__, -1.693642321808920e-26, "-1.69364E-26", "%G",
+__LINE__, -1.694579128700042e-12, "-0.000000", "%f",
+__LINE__, -1.695454897264717e-08, "-1.7E-08", "%+4.3G",
+__LINE__, -1.695733278397589e+19, "-1.695733e+19", "%4e",
+__LINE__, -1.699522534409388e-05, "-1.69952E-05", "%G",
+__LINE__, -1.701752039544919e+00, "-2", "%.0f",
+__LINE__, -1.702304998615036e+16, "-1.7023E+16", "%1G",
+__LINE__, -1.703113580904556e-25, "-1.703114e-25", "%+e",
+__LINE__, -1.705165515454546e+29, "-1.705166e+29", "%+e",
+__LINE__, -1.707392568277288e-05, "-1.70739E-05", "%G",
+__LINE__, -1.707477319256742e+09, "-1707477319.26", "%7.2f",
+__LINE__, -1.709669107513969e-03, " -0.002", "%7.g",
+__LINE__, -1.713284011412432e-24, "-1.713e-24", "%3.3e",
+__LINE__, -1.715512203951086e-28, "-1.715512E-28", "%E",
+__LINE__, -1.716880832248879e+13, "-1.71688e+13", "%+g",
+__LINE__, -1.720722835740680e-15, "-1.7E-15", "%.1E",
+__LINE__, -1.721855769574895e+07, "-17218557.695749", "%3f",
+__LINE__, -1.722449437415368e+01, "-1.722449e+01", "%e",
+__LINE__, -1.723218805116591e-29, "-2e-29", "%.0g",
+__LINE__, -1.726129004920195e-05, "-1.72613E-05", "%0G",
+__LINE__, -1.727400228037571e-28, "-0.0000000", "%2.7f",
+__LINE__, -1.730008745782339e-23, "-1.73e-23", "%.4g",
+__LINE__, -1.731875670201859e+09, "-1.73188E+09", "%G",
+__LINE__, -1.732142976428085e+10, "-2E+10", "%+6.0E",
+__LINE__, -1.732699651229194e-02, "-0.017327", "%5g",
+__LINE__, -1.734772870736446e-12, "-0.000000", "%+f",
+__LINE__, -1.738576887938331e+09, "-1.73858e+09", "%g",
+__LINE__, -1.738759937912438e-08, "-1.73876e-08", "%+2g",
+__LINE__, -1.739320154069143e-18, "-0.0000", "%1.4f",
+__LINE__, -1.739870415800800e+16, "-1.73987e+16", "%g",
+__LINE__, -1.741290506928618e+04, "-17412.9", "%G",
+__LINE__, -1.742520800031913e+29, "-1.742521e+29", "%7e",
+__LINE__, -1.747620095195231e+01, "-2e+01", "%+2.g",
+__LINE__, -1.749860675924882e-21, "-1.74986E-21", "%G",
+__LINE__, -1.752675363661431e-06, "-1.7527E-06", "%.5G",
+__LINE__, -1.752871508059699e-06, " -0", "%7.f",
+__LINE__, -1.755178530989839e+25, "-1.7551785e+25", "%1.7e",
+__LINE__, -1.755566213249512e-07, "-1.755566e-07", "%.6e",
+__LINE__, -1.756193485005071e-24, "-1.75619E-24", "%+2.6G",
+__LINE__, -1.758501410496218e+03, "-1758.501", "%.7G",
+__LINE__, -1.758795617219102e+20, "-1.75880E+20", "%#6G",
+__LINE__, -1.760538679276709e+03, "-2e+03", "%+1.e",
+__LINE__, -1.762660914833003e+27, "-1.76266E+27", "%G",
+__LINE__, -1.765122691141907e+19, "-17651226911419071186.1", "%5.1f",
+__LINE__, -1.765313277389086e-18, "-2E-18", "%+1.E",
+__LINE__, -1.765821717148734e+19, "-1.76582E+19", "%G",
+__LINE__, -1.767048687863149e-17, "-1.77E-17", "%+.3G",
+__LINE__, -1.768661645451962e+18, "-1.77E+18", "%+.3G",
+__LINE__, -1.769753257452233e+01, "-17.6975", "%G",
+__LINE__, -1.770945665065531e+28, "-1.770946E+28", "%0.7G",
+__LINE__, -1.776713865753894e-09, "-2e-09", "%1.g",
+__LINE__, -1.778424845787448e+03, "-1.7784E+03", "%.4E",
+__LINE__, -1.779060610701250e+06, "-1.779061E+06", "%E",
+__LINE__, -1.781447182110762e-27, "-1.781447E-27", "%E",
+__LINE__, -1.782655842123784e-13, "-2.E-13", "%#2.1G",
+__LINE__, -1.783071018169166e+16, "-17830710181691664.217851", "%+f",
+__LINE__, -1.784665985294415e+25, "-2E+25", "%3.G",
+__LINE__, -1.787297600658096e+25, "-2E+25", "%+5.E",
+__LINE__, -1.788200250255718e+12, "-1.7882E+12", "%2.4E",
+__LINE__, -1.792860730579114e-09, "-1.79286E-09", "%G",
+__LINE__, -1.793122797100936e+24, "-1.793123e+24", "%e",
+__LINE__, -1.793761706915029e-25, "-0.000000", "%f",
+__LINE__, -1.793947567431932e+22, "-1.79395e+22", "%g",
+__LINE__, -1.796428035404303e-18, "-1.79643e-18", "%g",
+__LINE__, -1.797113144273918e-16, "-1.79711E-16", "%.6G",
+__LINE__, -1.798796767828424e-29, "-1.7988E-29", "%G",
+__LINE__, -1.805004010633763e-11, "-1.805e-11", "%2.5g",
+__LINE__, -1.806936269752338e-26, "-1.80694e-26", "%g",
+__LINE__, -1.807122541760172e-10, "-1.80712e-10", "%g",
+__LINE__, -1.808295407815630e-06, "-1.8083E-06", "%+G",
+__LINE__, -1.813893236685959e+15, "-1813893236685959", "%0.f",
+__LINE__, -1.816201530145367e+06, "-1816202", "%+2.f",
+__LINE__, -1.822811219123512e+13, "-1.82281e+13", "%g",
+__LINE__, -1.826276499170243e-25, "-2E-25", "%+3.G",
+__LINE__, -1.832399287433839e-26, "-1.832399E-26", "%#4E",
+__LINE__, -1.833597815584463e-18, "-0.000000", "%+3f",
+__LINE__, -1.834165532712233e+28, "-1.834166E+28", "%.7G",
+__LINE__, -1.837633147831083e+28, "-1.8376331e+28", "%.7e",
+__LINE__, -1.839756716742518e-01, "-0.2", "%+0.G",
+__LINE__, -1.840101206950368e-14, "-1.840101E-14", "%+E",
+__LINE__, -1.842043645474877e+17, "-1.84204e+17", "%+g",
+__LINE__, -1.842155892969934e+17, "-1.84216e+17", "%+g",
+__LINE__, -1.843566073012842e-25, "-1.84357E-25", "%G",
+__LINE__, -1.843976321320497e-02, "-0.02", "%+4.2f",
+__LINE__, -1.845299931651554e+11, "-1.8453E+11", "%0.4E",
+__LINE__, -1.846199038659889e-06, "-1.8462e-06", "%0.5g",
+__LINE__, -1.847062180184169e-30, "-1.847062E-30", "%5E",
+__LINE__, -1.847962158722201e-16, "-0.000000", "%f",
+__LINE__, -1.849446376756582e+15, "-1.8E+15", "%2.2G",
+__LINE__, -1.853168465523878e-24, "-2E-24", "%1.E",
+__LINE__, -1.853601367230139e+10, "-1.853601e+10", "%e",
+__LINE__, -1.857367903775364e+18, "-1.86E+18", "%1.3G",
+__LINE__, -1.858332820633906e-05, "-0.000019", "%7f",
+__LINE__, -1.860243811657223e-23, "-1.860244e-23", "%e",
+__LINE__, -1.860660612539794e+08, "-1.86066e+08", "%+6.5e",
+__LINE__, -1.861160816251124e-09, "-2E-09", "%1.G",
+__LINE__, -1.862380636974688e-25, "-1.9E-25", "%.2G",
+__LINE__, -1.864168808453004e+15, "-1.86417E+15", "%G",
+__LINE__, -1.864273144411246e+07, "-1.86427e+07", "%g",
+__LINE__, -1.864929236615802e-02, "-2e-02", "%+3.e",
+__LINE__, -1.865010503480847e+19, "-2E+19", "%4.G",
+__LINE__, -1.866276374553144e+22, "-1.866276e+22", "%e",
+__LINE__, -1.870809567910649e+09, "-1.870810e+09", "%e",
+__LINE__, -1.872555495839008e-13, "-1.872555E-13", "%3E",
+__LINE__, -1.874465717110388e-22, "-1.874466E-22", "%E",
+__LINE__, -1.874916306627632e+21, "-1874916306627632422987.517202", "%f",
+__LINE__, -1.875804322194491e-23, "-0.000000", "%+f",
+__LINE__, -1.876662099198587e-04, "-0.000187666", "%G",
+__LINE__, -1.876775504795760e-25, "-1.87678e-25", "%0g",
+__LINE__, -1.879343051002554e-20, " -0.", "%#6.f",
+__LINE__, -1.881535445774717e-15, "-1.881535e-15", "%e",
+__LINE__, -1.887515901404300e+00, "-1.888", "%2.4G",
+__LINE__, -1.887730637149009e+17, "-1.887731E+17", "%E",
+__LINE__, -1.889920303480086e+17, "-1.889920e+17", "%+e",
+__LINE__, -1.891903478784091e+04, "-1.891903e+04", "%e",
+__LINE__, -1.893550084305833e+16, "-1.89355e+16", "%g",
+__LINE__, -1.894675230197676e+05, "-1.894675e+05", "%#e",
+__LINE__, -1.898389624953187e-27, "-1.898390e-27", "%+e",
+__LINE__, -1.899250044644046e+21, "-1899250044644046120367.875119", "%+4.6f",
+__LINE__, -1.904187609804679e-02, "-1.90419E-02", "%0.5E",
+__LINE__, -1.904452538421193e-04, "-2e-04", "%4.0e",
+__LINE__, -1.904615326969061e-16, "-1.904615e-16", "%1.7g",
+__LINE__, -1.907761255064750e+02, "-190.776126", "%f",
+__LINE__, -1.910727641826707e-10, " -2e-10", "%7.g",
+__LINE__, -1.913149279262051e+15, "-1.913149e+15", "%.7g",
+__LINE__, -1.913235739298009e+28, "-1.913236e+28", "%e",
+__LINE__, -1.913526822735271e+18, "-1.914e+18", "%.4g",
+__LINE__, -1.913780977515583e+17, "-191378097751558335.9150", "%5.4f",
+__LINE__, -1.917095456962182e-10, "-2E-10", "%4.G",
+__LINE__, -1.918803033972851e+23, "-191880303397285132405158.947222", "%f",
+__LINE__, -1.926420984801848e+16, "-19264209848018483.128840", "%+f",
+__LINE__, -1.931905465942639e-10, "-1.93191e-10", "%g",
+__LINE__, -1.932907105840252e+06, "-1.932907e+06", "%+#e",
+__LINE__, -1.933091601918916e+15, "-1.933092E+15", "%#E",
+__LINE__, -1.934296184983361e+09, "-1.9343e+09", "%1.6g",
+__LINE__, -1.934637311832448e+11, "-1.93464e+11", "%+g",
+__LINE__, -1.936201483262186e+12, "-2e+12", "%+6.g",
+__LINE__, -1.939114661603911e+19, "-1.93911E+19", "%G",
+__LINE__, -1.940478182124347e-13, "-0.000000", "%f",
+__LINE__, -1.943218220654923e+08, "-2E+08", "%+5.0G",
+__LINE__, -1.943526872455779e-30, "-1.9E-30", "%.1E",
+__LINE__, -1.949869164681357e+19, "-1.949869e+19", "%#3e",
+__LINE__, -1.954181060535402e+23, "-1.954181e+23", "%e",
+__LINE__, -1.961581555579142e+14, "-1.962E+14", "%.3E",
+__LINE__, -1.964535562036915e+07, "-1.96454E+07", "%G",
+__LINE__, -1.969749653575926e+04, "-19697.5", "%.6g",
+__LINE__, -1.973475369169053e+15, "-1.97348e+15", "%g",
+__LINE__, -1.975658532866600e-21, "-2e-21", "%+1.2g",
+__LINE__, -1.984050343831260e+09, "-1.984050E+09", "%E",
+__LINE__, -1.984422410018571e+12, "-1.984422e+12", "%+4.7g",
+__LINE__, -1.984878687667223e-22, "-0.000000", "%f",
+__LINE__, -1.986116930967811e-28, "-1.98612e-28", "%g",
+__LINE__, -1.986774457812683e+02, "-1.986774e+02", "%e",
+__LINE__, -1.987274814938726e-04, "-0.000198727", "%g",
+__LINE__, -1.987319200580415e+10, "-1.987319E+10", "%E",
+__LINE__, -1.987980768698114e-19, "-0.000000", "%3f",
+__LINE__, -1.994698965044602e-29, "-2E-29", "%+4.0G",
+__LINE__, -1.997833122667050e+26, "-1.99783E+26", "%G",
+__LINE__, -1.999453681184129e-10, "-0.00000", "%.5f",
+__LINE__, -1.999897345839745e-16, "-1.9999e-16", "%g",
+__LINE__, -2.003703825123989e-22, "-0.000000", "%f",
+__LINE__, -2.004569188274957e-23, "-2.00457E-23", "%G",
+__LINE__, -2.005911883189058e+07, "-2.00591E+07", "%G",
+__LINE__, -2.006438312005722e-25, "-2.006e-25", "%0.4g",
+__LINE__, -2.017322171210280e+18, "-2.01732E+18", "%+0G",
+__LINE__, -2.017718635819594e-06, "-2.01772e-06", "%5g",
+__LINE__, -2.019187445568160e-12, "-0.00", "%.2f",
+__LINE__, -2.021022665608503e+25, "-20210226656085028551501636.684", "%2.3f",
+__LINE__, -2.022720393474145e+07, "-2.02272E+07", "%#G",
+__LINE__, -2.024506694471065e+23, "-2.02451E+23", "%G",
+__LINE__, -2.024884686553821e-15, " -2e-15", "%7.g",
+__LINE__, -2.027484636128966e-23, "-2.0275E-23", "%.5G",
+__LINE__, -2.028185530467237e+21, "-2028185530467237374097.067", "%+4.3f",
+__LINE__, -2.028388905566873e-09, "-0.000000", "%f",
+__LINE__, -2.029856507431584e-17, "-2.02986E-17", "%G",
+__LINE__, -2.029891733449167e+27, "-2029891733449166846270372843.7190875", "%3.7f",
+__LINE__, -2.031933616694469e+14, "-2.031934E+14", "%#E",
+__LINE__, -2.034011738471413e-10, "-2.03401E-10", "%#G",
+__LINE__, -2.036087355975756e+29, "-203608735597575574161055556032.806635", "%+f",
+__LINE__, -2.036355025137273e+09, "-2.036355E+09", "%#.7G",
+__LINE__, -2.038423730536878e+12, "-2E+12", "%4.G",
+__LINE__, -2.045209202278810e+23, "-2.045209e+23", "%+#e",
+__LINE__, -2.046794083517423e-06, "-2.04679e-06", "%g",
+__LINE__, -2.048042459678599e-19, "-0.000000", "%f",
+__LINE__, -2.050526462096153e+18, "-2.05053e+18", "%+g",
+__LINE__, -2.053583900249402e+13, "-2.053584e+13", "%0.7g",
+__LINE__, -2.054342100957522e-23, "-2.05434E-23", "%#G",
+__LINE__, -2.054793400141025e+11, "-205479340014.1", "%+2.1f",
+__LINE__, -2.059200689196498e-11, "-0.000000", "%#f",
+__LINE__, -2.060960692728114e-16, "-0.000000", "%+f",
+__LINE__, -2.061417528654300e-30, "-2.06E-30", "%.3G",
+__LINE__, -2.061513401198340e-29, "-2.06151e-29", "%7g",
+__LINE__, -2.061846698845984e+27, "-2.061847E+27", "%E",
+__LINE__, -2.063922242876789e-19, "-2.06392e-19", "%#g",
+__LINE__, -2.065359431805529e+03, "-2065.359432", "%f",
+__LINE__, -2.065529069992156e-04, "-0.000206553", "%+G",
+__LINE__, -2.066082546490980e-25, "-2.06608e-25", "%5g",
+__LINE__, -2.068394312095200e+17, "-2.068394e+17", "%e",
+__LINE__, -2.071024178556425e-10, "-2.07102E-10", "%G",
+__LINE__, -2.074401605950382e-22, "-2.07e-22", "%1.3g",
+__LINE__, -2.074731895144874e-26, "-2.07473E-26", "%G",
+__LINE__, -2.074895800882730e+18, "-2074895800882730068.082083", "%+f",
+__LINE__, -2.077336220500764e-30, "-0", "%2.f",
+__LINE__, -2.078067878561077e+09, "-2.0781e+09", "%0.5g",
+__LINE__, -2.080497889634533e+15, "-2.080498E+15", "%4E",
+__LINE__, -2.084717279367594e-21, "-2.08472e-21", "%+g",
+__LINE__, -2.087827915301948e+29, "-2E+29", "%6.1G",
+__LINE__, -2.090268686389680e+05, "-2.090269e+05", "%1e",
+__LINE__, -2.092036176589720e+24, "-2.09204e+24", "%+g",
+__LINE__, -2.093546373938615e-21, "-2.093546e-21", "%#e",
+__LINE__, -2.101302069316682e+18, "-2.1013e+18", "%+7g",
+__LINE__, -2.103463622286002e-13, "-2.103464E-13", "%E",
+__LINE__, -2.105622845016732e+06, "-2105622.845017", "%1f",
+__LINE__, -2.109999123037767e+28, "-2.11E+28", "%.2E",
+__LINE__, -2.110317013992166e+04, "-21103.2", "%+g",
+__LINE__, -2.112226142154618e+21, "-2112226142154617569702.", "%#6.f",
+__LINE__, -2.112519484486528e+06, "-2.11252E+06", "%G",
+__LINE__, -2.113439260812000e+23, "-2E+23", "%1.G",
+__LINE__, -2.113465893194608e-15, "-2.1135E-15", "%.5G",
+__LINE__, -2.113547784669409e+20, "-2.1135e+20", "%2.5g",
+__LINE__, -2.114146001321822e+28, "-2.114146e+28", "%e",
+__LINE__, -2.114509425574444e-30, " -0", "%4.f",
+__LINE__, -2.114887421659561e-21, "-0.000000", "%+f",
+__LINE__, -2.121120215127601e+21, "-2121120215127601404958.5683097", "%.7f",
+__LINE__, -2.122555390665796e+06, "-2E+06", "%0.G",
+__LINE__, -2.123468430242052e-27, "-0.000000", "%+f",
+__LINE__, -2.123473598890635e+28, "-2.12347e+28", "%+g",
+__LINE__, -2.124328049748190e-04, "-2.124328E-04", "%E",
+__LINE__, -2.125633890999010e+28, "-2E+28", "%+5.G",
+__LINE__, -2.125697963566045e+21, "-2.1257E+21", "%0G",
+__LINE__, -2.127638109230109e+06, "-2.12764e+06", "%+6g",
+__LINE__, -2.128456114617786e+07, "-2.128456E+07", "%E",
+__LINE__, -2.128732742932824e-04, "-2.128733E-04", "%#E",
+__LINE__, -2.129654381588404e+27, "-2129654381588404365999167566.7697564", "%+.7f",
+__LINE__, -2.129792795009985e+20, "-2.12979e+20", "%g",
+__LINE__, -2.131026925664619e-20, "-2e-20", "%.0e",
+__LINE__, -2.132860730144188e-04, "-0.0002", "%5.g",
+__LINE__, -2.133620979309562e+06, "-2e+06", "%3.e",
+__LINE__, -2.133821423139120e-27, "-2.13382E-27", "%.6G",
+__LINE__, -2.134253401425940e-07, "-0.000000", "%f",
+__LINE__, -2.135469568156964e-29, "-2.135470E-29", "%+7E",
+__LINE__, -2.135723595288365e-25, "-0.0", "%.1f",
+__LINE__, -2.137642458920094e-09, "-2.13764e-09", "%g",
+__LINE__, -2.143412361116583e+12, "-2.14341e+12", "%+g",
+__LINE__, -2.144467087741129e-17, "-2.14447e-17", "%+g",
+__LINE__, -2.145726966596964e-11, "-0.000000", "%2f",
+__LINE__, -2.148318753042597e+08, "-2.14832E+08", "%5G",
+__LINE__, -2.149932310549644e-19, "-2.14993e-19", "%g",
+__LINE__, -2.150050917377646e-21, " -0", "%3.f",
+__LINE__, -2.150854313643430e-16, "-0.000000", "%.6f",
+__LINE__, -2.151071797121845e+00, "-2.15107", "%+g",
+__LINE__, -2.158728406865981e+14, "-215872840686598.088666", "%7f",
+__LINE__, -2.166062878011641e-23, "-2.166063e-23", "%e",
+__LINE__, -2.167045002060684e+12, "-2.167045E+12", "%E",
+__LINE__, -2.173752581051530e+20, "-217375258105153035259.604621", "%f",
+__LINE__, -2.175599129057555e+24, "-2.175599E+24", "%E",
+__LINE__, -2.176564454093042e-02, "-0.0217656", "%+G",
+__LINE__, -2.181270774327071e-12, "-0.000000", "%#1f",
+__LINE__, -2.184404769844158e-09, "-2.2E-09", "%+.2G",
+__LINE__, -2.184881476334310e-07, "-2.18488e-07", "%g",
+__LINE__, -2.189197211449684e-11, "-2E-11", "%.0G",
+__LINE__, -2.189451286805190e+20, "-218945128680519029984", "%3.f",
+__LINE__, -2.190642494146884e-27, " -0.", "%#4.f",
+__LINE__, -2.194727956725854e+06, "-2.19E+06", "%.3G",
+__LINE__, -2.196145868303877e+11, "-219614586830.387726", "%+5f",
+__LINE__, -2.196397972262690e-16, "-0.000000", "%3f",
+__LINE__, -2.202692843474668e-01, "-2.203e-01", "%.3e",
+__LINE__, -2.204528684782451e-21, "-2.20453E-21", "%G",
+__LINE__, -2.214926838821340e-16, "-2e-16", "%+2.g",
+__LINE__, -2.215558986352773e+18, "-2215558986352773374", "%0.f",
+__LINE__, -2.216976693056186e+27, "-2216976693056186498154147557.215765", "%f",
+__LINE__, -2.217348422793322e+13, "-2.21735E+13", "%6G",
+__LINE__, -2.217732695583920e-07, "-0", "%.0f",
+__LINE__, -2.221185494767834e-14, "-2.22119e-14", "%g",
+__LINE__, -2.224557193699609e-16, "-2.224557E-16", "%E",
+__LINE__, -2.227417758704028e-18, "-0.000000", "%0f",
+__LINE__, -2.231261655673006e-30, "-2.231262E-30", "%E",
+__LINE__, -2.233081938836160e+21, "-2233081938836160240668.960", "%+6.3f",
+__LINE__, -2.233158918439853e+05, "-223316", "%2G",
+__LINE__, -2.233802298007898e-30, "-2.2338E-30", "%2G",
+__LINE__, -2.233864858404732e+17, "-223386485840473181.241350", "%f",
+__LINE__, -2.241242805107749e+14, "-2.24124E+14", "%G",
+__LINE__, -2.244555498855249e+25, "-2.24456E+25", "%#G",
+__LINE__, -2.248170665127481e-07, "-2.248171E-07", "%E",
+__LINE__, -2.252558275567388e-13, "-2.25256e-13", "%g",
+__LINE__, -2.256190083496001e+13, "-22561900834960.0136398", "%7.7f",
+__LINE__, -2.259851596715945e+27, "-2.259852e+27", "%e",
+__LINE__, -2.260461480001174e-21, "-0.000000", "%f",
+__LINE__, -2.264128628428577e+22, "-2.26413e+22", "%1g",
+__LINE__, -2.265914518399595e-04, "-0.000226591", "%G",
+__LINE__, -2.266251557092826e+23, "-2.26625e+23", "%g",
+__LINE__, -2.268592252572450e+19, "-2.268592e+19", "%2.6e",
+__LINE__, -2.268597523847349e+11, "-2.2686e+11", "%g",
+__LINE__, -2.268963106935546e+05, "-226896", "%+g",
+__LINE__, -2.272527876808919e-24, "-0.000000", "%#f",
+__LINE__, -2.273366440479073e+02, "-227.337", "%g",
+__LINE__, -2.277858038556191e+25, "-2.28E+25", "%0.3G",
+__LINE__, -2.282019915623415e+25, "-2E+25", "%5.E",
+__LINE__, -2.283333247435650e-27, " -0", "%4.f",
+__LINE__, -2.285230610829355e+23, "-2E+23", "%2.G",
+__LINE__, -2.290900253402985e+23, "-2.2909E+23", "%G",
+__LINE__, -2.293266953268186e+08, "-2.29327e+08", "%g",
+__LINE__, -2.293489603164786e+23, "-229348960316478578391752.3076525", "%4.7f",
+__LINE__, -2.294434667605481e+15, "-2.2944E+15", "%.5G",
+__LINE__, -2.296607768466765e+21, "-2.29661E+21", "%G",
+__LINE__, -2.297449967994012e+14, "-229744996799401.23542", "%+.5f",
+__LINE__, -2.301162556466583e-01, "-0.230116", "%+#2g",
+__LINE__, -2.301676246374004e+05, "-230168.", "%#g",
+__LINE__, -2.301976724487835e-01, "-0.230198", "%5G",
+__LINE__, -2.303269770571222e-15, "-2.303270e-15", "%.6e",
+__LINE__, -2.306451480495636e+23, "-2.30645E+23", "%G",
+__LINE__, -2.307659351219690e-17, "-0.000000", "%+3f",
+__LINE__, -2.309009762339430e+16, "-2.30901E+16", "%G",
+__LINE__, -2.309261751862100e+06, "-2309261.751862", "%+f",
+__LINE__, -2.309504876918634e-26, " -2E-26", "%7.E",
+__LINE__, -2.310910348147804e-26, "-2e-26", "%5.g",
+__LINE__, -2.317173552252235e+05, "-231717.4", "%.7g",
+__LINE__, -2.319517289618469e-23, "-2.31952E-23", "%+G",
+__LINE__, -2.320103195142527e+08, "-2.320103E+08", "%+E",
+__LINE__, -2.323523032125633e+24, "-2323523032125633491773442.07419", "%.5f",
+__LINE__, -2.326279126614399e-16, "-0.000000", "%f",
+__LINE__, -2.331393688620925e-09, "-2.33139e-09", "%#g",
+__LINE__, -2.334233527512469e+01, " -23", "%6.0f",
+__LINE__, -2.337418834112767e+24, " -2E+24", "%7.E",
+__LINE__, -2.339455293612118e+12, "-2339455293612.1", "%+.1f",
+__LINE__, -2.341930318143367e-18, "-2.E-18", "%#4.E",
+__LINE__, -2.346107614950921e-17, "-0.00000", "%+2.5f",
+__LINE__, -2.348356578807972e+23, "-2.34836e+23", "%g",
+__LINE__, -2.351485855138244e+19, "-2.351486e+19", "%+e",
+__LINE__, -2.362101647639198e-15, "-2.36210e-15", "%#g",
+__LINE__, -2.369743873030115e+08, "-2e+08", "%.1g",
+__LINE__, -2.371658164739356e+25, "-23716581647393559784120498.079574", "%f",
+__LINE__, -2.372427847607163e+28, "-2.37243E+28", "%G",
+__LINE__, -2.375465465294647e+11, "-2.375465e+11", "%e",
+__LINE__, -2.377128971572195e-18, "-0.0", "%1.1f",
+__LINE__, -2.380322448568089e-13, "-2.38032E-13", "%+#0G",
+__LINE__, -2.385960728264882e+26, "-2E+26", "%.0E",
+__LINE__, -2.387345744004747e+00, "-2.38735", "%G",
+__LINE__, -2.390480023300201e+25, "-2.39048e+25", "%g",
+__LINE__, -2.395420431930886e+23, "-2E+23", "%2.E",
+__LINE__, -2.401144663870969e-10, "-2.e-10", "%#6.g",
+__LINE__, -2.402787441215039e-08, "-2.40279e-08", "%g",
+__LINE__, -2.402990830425278e+08, "-2.40299E+08", "%G",
+__LINE__, -2.404213682932215e+08, "-2.40421e+08", "%2g",
+__LINE__, -2.409385592298822e+21, "-2409385592298821876511.283335", "%7f",
+__LINE__, -2.410798267658614e+13, "-2.4108e+13", "%+g",
+__LINE__, -2.413180068271811e-24, "-0.000000", "%+f",
+__LINE__, -2.413268457113495e+26, "-2.41327E+26", "%3.6G",
+__LINE__, -2.415341832206007e-13, "-0.000000", "%+f",
+__LINE__, -2.422519577068670e-08, "-0.0000000", "%.7f",
+__LINE__, -2.422533651282808e+20, "-2.42253E+20", "%#G",
+__LINE__, -2.422795006880671e+17, "-2.4228e+17", "%g",
+__LINE__, -2.423483330202008e+20, "-2.42348e+20", "%g",
+__LINE__, -2.431756009640369e-04, "-0.000243176", "%+#3g",
+__LINE__, -2.431878622534173e-05, "-0.000024", "%f",
+__LINE__, -2.432012113077180e+24, "-2.43201e+24", "%g",
+__LINE__, -2.433843704470487e+07, "-24338437", "%4.f",
+__LINE__, -2.435475755031956e+11, "-2.435476E+11", "%1E",
+__LINE__, -2.438081888695437e-13, "-0.000000", "%f",
+__LINE__, -2.438334590462860e+10, "-2.4E+10", "%5.2G",
+__LINE__, -2.440223135334059e+17, "-2.44022e+17", "%g",
+__LINE__, -2.444107281115317e-21, "-2.44411e-21", "%+g",
+__LINE__, -2.444582273206171e-02, " -0.02", "%7.G",
+__LINE__, -2.445234676352794e+23, "-2.44523e+23", "%#g",
+__LINE__, -2.449185020984714e+08, "-2.E+08", "%#2.G",
+__LINE__, -2.450646640466020e+22, "-2.45065E+22", "%5G",
+__LINE__, -2.456840850262473e+13, "-24568408502625", "%0.f",
+__LINE__, -2.464466865714499e-10, "-2e-10", "%6.g",
+__LINE__, -2.466022088999151e+27, "-2.46602E+27", "%G",
+__LINE__, -2.484398113119779e-04, "-2.484398E-04", "%E",
+__LINE__, -2.484591850456328e+23, "-248459185045632846566832.085955", "%+f",
+__LINE__, -2.488166252162446e-11, "-2.5E-11", "%4.2G",
+__LINE__, -2.493507313049390e+24, "-2.49E+24", "%4.3G",
+__LINE__, -2.500280281988428e+28, "-2.5E+28", "%.4G",
+__LINE__, -2.500373956445372e-07, "-2.50037e-07", "%g",
+__LINE__, -2.505566434769299e-12, "-2.5E-12", "%+#0.2G",
+__LINE__, -2.508215917020758e+05, "-2.508216e+05", "%5e",
+__LINE__, -2.519368094680315e-29, "-2.51937e-29", "%#0g",
+__LINE__, -2.522266530587753e-11, "-2.52227e-11", "%+g",
+__LINE__, -2.534492886372514e-06, "-2.53449E-06", "%0G",
+__LINE__, -2.534617610955074e-02, "-0.03", "%0.2f",
+__LINE__, -2.540551642835634e+26, "-3E+26", "%4.G",
+__LINE__, -2.548210731830516e-26, "-0.000", "%2.3f",
+__LINE__, -2.558868082397931e-11, "-3E-11", "%2.E",
+__LINE__, -2.560062512991052e+11, "-2.56006E+11", "%+G",
+__LINE__, -2.561274682814428e-05, "-0.000026", "%f",
+__LINE__, -2.563424949397357e-02, " -0", "%6.f",
+__LINE__, -2.577010939931465e+17, "-2.57701E+17", "%G",
+__LINE__, -2.578224879294822e+10, "-3E+10", "%+4.1G",
+__LINE__, -2.585655636750244e+13, "-2.585656e+13", "%+0.7g",
+__LINE__, -2.585657986834408e+14, "-2.5857e+14", "%3.5g",
+__LINE__, -2.586728929368101e+02, "-258.673", "%+g",
+__LINE__, -2.591293023229468e+06, "-2591293.0232295", "%2.7f",
+__LINE__, -2.592454222603538e-06, "-2.59245E-06", "%G",
+__LINE__, -2.599399905869649e+02, "-259.939991", "%f",
+__LINE__, -2.605382860307596e+12, "-2.60538E+12", "%2G",
+__LINE__, -2.607507689402762e-01, "-0.260751", "%#.6g",
+__LINE__, -2.612933252582967e+15, "-2.61293e+15", "%g",
+__LINE__, -2.614337505491483e-14, "-2.61434E-14", "%.6G",
+__LINE__, -2.618302263333671e+14, "-2.62e+14", "%3.3g",
+__LINE__, -2.622998533972296e+00, "-3.", "%#0.g",
+__LINE__, -2.623348319869643e-15, "-2.62335E-15", "%#G",
+__LINE__, -2.626703132693163e+23, "-3E+23", "%+6.E",
+__LINE__, -2.629610853765779e+25, "-2.62961E+25", "%+#G",
+__LINE__, -2.632993880472784e+26, "-2.63299E+26", "%G",
+__LINE__, -2.635651112327873e-20, "-2.63565E-20", "%1G",
+__LINE__, -2.636003980473492e-23, "-2.636E-23", "%G",
+__LINE__, -2.639316453244009e+10, "-26393164532.440094", "%#f",
+__LINE__, -2.640517223417942e-28, "-2.641e-28", "%.3e",
+__LINE__, -2.640625797147664e-22, "-2.640626E-22", "%E",
+__LINE__, -2.644401262524378e-12, " -0.000", "%7.3f",
+__LINE__, -2.651033203243637e-14, "-2.651033e-14", "%+e",
+__LINE__, -2.652386470126594e-24, "-2.652386E-24", "%E",
+__LINE__, -2.654281018623631e-12, "-0.00000", "%6.5f",
+__LINE__, -2.655529742118827e+02, "-265.552974", "%f",
+__LINE__, -2.658550833241620e+22, "-26585508332416196708436.473273", "%+f",
+__LINE__, -2.660515890519100e+08, "-2.660516E+08", "%E",
+__LINE__, -2.665025749266086e-24, "-2.66503E-24", "%G",
+__LINE__, -2.666117105643095e-20, "-2.66612e-20", "%g",
+__LINE__, -2.667051347741259e+11, "-3e+11", "%6.g",
+__LINE__, -2.667207607243375e+04, "-26672.076072", "%+#f",
+__LINE__, -2.667631877167590e+26, "-2.667632E+26", "%E",
+__LINE__, -2.673817942962878e+13, "-2.673818e+13", "%+2.6e",
+__LINE__, -2.674972907853507e+20, "-2.674973E+20", "%E",
+__LINE__, -2.675830887404867e+14, "-2.675831E+14", "%E",
+__LINE__, -2.682749918168908e+26, "-2.682750E+26", "%E",
+__LINE__, -2.689222801942679e-03, "-0.0027", "%7.2G",
+__LINE__, -2.692245629411156e+25, "-2.69225e+25", "%g",
+__LINE__, -2.692606702464273e+11, "-2.69261e+11", "%g",
+__LINE__, -2.693070822061136e-27, "-2.69307e-27", "%+g",
+__LINE__, -2.694415515655336e-30, "-3E-30", "%+3.0E",
+__LINE__, -2.694770057384739e+15, "-2.69477e+15", "%g",
+__LINE__, -2.699998392329361e+01, "-27", "%+.2g",
+__LINE__, -2.700151952281511e+23, "-270015195228151050343968.", "%+#5.f",
+__LINE__, -2.707398527302841e-08, "-2.70740e-08", "%+#3g",
+__LINE__, -2.711404950850030e-21, "-2.71E-21", "%.2E",
+__LINE__, -2.714057739024281e-10, "-2.714e-10", "%.4g",
+__LINE__, -2.717657632815414e-10, "-2.71766e-10", "%g",
+__LINE__, -2.720875786430592e-09, "-2.7E-09", "%6.2G",
+__LINE__, -2.725886730997891e+19, "-2.72589e+19", "%g",
+__LINE__, -2.726089169748676e-09, "-2.72609E-09", "%+G",
+__LINE__, -2.732907572038661e-30, "-2.73291E-30", "%G",
+__LINE__, -2.737918050958789e+11, "-3e+11", "%1.g",
+__LINE__, -2.739024251198484e-18, "-2.73902e-18", "%+g",
+__LINE__, -2.742646144452305e+13, "-2.74265e+13", "%g",
+__LINE__, -2.742911865386719e+06, "-3E+06", "%+5.G",
+__LINE__, -2.759159275123811e-30, "-0.000000", "%+f",
+__LINE__, -2.759794813930001e-21, "-2.75979e-21", "%+g",
+__LINE__, -2.763243077558348e+20, "-2.7632E+20", "%+0.4E",
+__LINE__, -2.770348477810209e-14, "-0.000000", "%2f",
+__LINE__, -2.776074766292453e+05, "-277607", "%g",
+__LINE__, -2.776610811432007e-07, "-2.77661E-07", "%6G",
+__LINE__, -2.778673793270678e+23, "-3E+23", "%+4.E",
+__LINE__, -2.782405168708350e+08, "-278240516.87084", "%.5f",
+__LINE__, -2.783316149365198e-09, "-3E-09", "%5.0G",
+__LINE__, -2.785436703085409e-27, "-2.78544E-27", "%#G",
+__LINE__, -2.787479051660640e+21, "-2.78748e+21", "%g",
+__LINE__, -2.789445406042450e-03, "-0.002789", "%+f",
+__LINE__, -2.791104581836077e+05, "-279110.4581836", "%+7.7f",
+__LINE__, -2.802078617775784e+04, "-28020.786", "%0.3f",
+__LINE__, -2.804954315579055e+20, "-2.80495E+20", "%G",
+__LINE__, -2.806575341862696e-05, "-2.80658E-05", "%G",
+__LINE__, -2.807769556900402e-06, "-0.000003", "%+#f",
+__LINE__, -2.808882056357941e-12, "-0.0", "%.1f",
+__LINE__, -2.809386677339924e+10, "-2.8094E+10", "%6.5G",
+__LINE__, -2.818404311437694e+19, "-3E+19", "%6.G",
+__LINE__, -2.819463285551660e+01, "-28.1946", "%+G",
+__LINE__, -2.821428853207724e-16, "-3e-16", "%6.g",
+__LINE__, -2.824452750788444e+07, "-3e+07", "%+2.g",
+__LINE__, -2.825430381094971e+28, "-3e+28", "%+.0e",
+__LINE__, -2.830010928384944e-17, "-0", "%.0f",
+__LINE__, -2.832505114479680e-09, "-0.000000", "%f",
+__LINE__, -2.833246604950796e+13, "-2.83325E+13", "%G",
+__LINE__, -2.833274073265017e+13, "-28332740732650.174564", "%f",
+__LINE__, -2.835842581787797e+07, "-2.83584E+07", "%2G",
+__LINE__, -2.839758384681983e-07, "-2.83976E-07", "%.6G",
+__LINE__, -2.841077022753766e-09, "-3E-09", "%0.1G",
+__LINE__, -2.845307294930682e+00, "-2.845307e+00", "%+1e",
+__LINE__, -2.847420163874243e+19, "-2.8e+19", "%1.2g",
+__LINE__, -2.848133715109881e-25, "-2.848134E-25", "%E",
+__LINE__, -2.850208101288058e-06, "-2.8502E-06", "%+5.4E",
+__LINE__, -2.853666525870413e+04, "-28536.665259", "%f",
+__LINE__, -2.855661543202034e+21, "-2.85566e+21", "%g",
+__LINE__, -2.859528889324159e-08, "-2.859529e-08", "%3e",
+__LINE__, -2.860545310690251e+29, "-3e+29", "%.1g",
+__LINE__, -2.863576633666884e-14, "-2.863577e-14", "%+5e",
+__LINE__, -2.864115740396321e-14, "-2.86412e-14", "%g",
+__LINE__, -2.864481979037153e+20, "-2.86E+20", "%3.3G",
+__LINE__, -2.867582970177984e-18, "-0.000000", "%f",
+__LINE__, -2.868237707901564e+25, "-3E+25", "%6.E",
+__LINE__, -2.871741071402520e+13, "-3e+13", "%.1g",
+__LINE__, -2.873724610073364e+18, "-2873724610073364438.278531", "%+#f",
+__LINE__, -2.876433859770866e-25, "-2.87643e-25", "%g",
+__LINE__, -2.877458587075737e-08, "-2.877E-08", "%+.4G",
+__LINE__, -2.883349842927101e+24, "-2.883350E+24", "%2E",
+__LINE__, -2.883749925642885e+09, "-2.883750e+09", "%e",
+__LINE__, -2.883773835633003e-17, "-0.000000", "%+f",
+__LINE__, -2.890389090491409e+24, "-2890389090491409262995148.310438", "%#1f",
+__LINE__, -2.900848552225810e-11, "-0.000000", "%+f",
+__LINE__, -2.911942123176400e+25, "-29119421231764004431852300", "%0.f",
+__LINE__, -2.912904462180751e-18, "-2.9129E-18", "%6G",
+__LINE__, -2.917717875075651e+26, "-3e+26", "%0.e",
+__LINE__, -2.922293201084093e-26, "-2.922293E-26", "%E",
+__LINE__, -2.925070319932451e-30, "-0.000000", "%f",
+__LINE__, -2.926558572870874e+15, "-2.926559E+15", "%E",
+__LINE__, -2.928781435877896e+26, "-2.928781e+26", "%+e",
+__LINE__, -2.930178318110376e+28, "-2.930178E+28", "%E",
+__LINE__, -2.930984661925819e+05, "-293098.5", "%.7G",
+__LINE__, -2.932762424932762e-08, "-0.000000", "%#f",
+__LINE__, -2.933415597492494e+10, "-29334155974.924943", "%+#2f",
+__LINE__, -2.933564314850986e+29, "-2.93356E+29", "%7G",
+__LINE__, -2.943224907893795e+10, "-2.943225E+10", "%+7E",
+__LINE__, -2.945311540471221e+19, "-2.94531E+19", "%#G",
+__LINE__, -2.945812356522847e+15, "-2.94581e+15", "%+g",
+__LINE__, -2.945836999630957e+00, "-2.945837E+00", "%E",
+__LINE__, -2.947798782726622e-01, "-0.29478", "%+g",
+__LINE__, -2.948958405827917e+18, "-2.94896e+18", "%g",
+__LINE__, -2.949790871798059e-11, "-2.94979E-11", "%G",
+__LINE__, -2.950347806125225e-12, "-2.95035e-12", "%g",
+__LINE__, -2.952781884599368e-29, "-2.952782E-29", "%+E",
+__LINE__, -2.956801341442716e+06, "-2.9568E+06", "%G",
+__LINE__, -2.957469310356540e-07, "-0.000", "%1.3f",
+__LINE__, -2.960464869534870e-23, "-2.96046E-23", "%G",
+__LINE__, -2.962339381825446e-07, "-0", "%1.f",
+__LINE__, -2.971013180028710e+22, "-2.971e+22", "%3.5g",
+__LINE__, -2.975167862441254e+07, "-2.97517e+07", "%g",
+__LINE__, -2.976018424339993e+16, "-2.976018e+16", "%3e",
+__LINE__, -2.979173094835454e+29, "-2.97917E+29", "%G",
+__LINE__, -2.983135249987541e-03, "-0.00298314", "%+G",
+__LINE__, -2.985142444917919e-24, "-2.985142E-24", "%+#7E",
+__LINE__, -2.988680953635159e-14, "-0.0000000", "%2.7f",
+__LINE__, -2.989629778079379e+04, "-29896.297781", "%f",
+__LINE__, -2.991274275137276e+19, "-29912742751372762839.423558", "%+4f",
+__LINE__, -2.991286396006024e-06, "-2.99129e-06", "%4g",
+__LINE__, -2.993310397844811e+04, "-2.993310E+04", "%3.6E",
+__LINE__, -2.994669852410861e-29, "-2.99467E-29", "%G",
+__LINE__, -2.996082093034831e+27, "-2.996082e+27", "%1e",
+__LINE__, -2.999783904575110e+16, "-2.999784E+16", "%#E",
+__LINE__, -3.012019221956988e+25, "-3.012019E+25", "%E",
+__LINE__, -3.014211917706622e-25, "-0.000000", "%+f",
+__LINE__, -3.015149723683428e-19, "-3.01515E-19", "%G",
+__LINE__, -3.022158478004638e-19, "-3.02216e-19", "%6g",
+__LINE__, -3.022825518373900e-12, "-3.0228E-12", "%+.4E",
+__LINE__, -3.025108924057340e-19, "-0.000000", "%f",
+__LINE__, -3.026316824631967e+24, "-3026316824631966717618070.106255", "%1f",
+__LINE__, -3.033074643529623e-13, "-3.03307e-13", "%g",
+__LINE__, -3.035292960731141e+24, "-3035292960731141409524980.190326", "%f",
+__LINE__, -3.043291272956732e-13, "-3.04329e-13", "%#g",
+__LINE__, -3.045216723973715e-23, "-3.045e-23", "%.4g",
+__LINE__, -3.047140976048835e+09, "-3.04714E+09", "%3.5E",
+__LINE__, -3.047680278470886e+09, "-3.047680E+09", "%#E",
+__LINE__, -3.048465807963461e+05, "-304847", "%g",
+__LINE__, -3.050904753556756e+22, "-3.0509E+22", "%G",
+__LINE__, -3.052845748999047e-13, "-3.05285e-13", "%g",
+__LINE__, -3.053395231883620e-06, "-3E-06", "%2.G",
+__LINE__, -3.054894203375445e-28, "-3e-28", "%2.g",
+__LINE__, -3.055080347760755e-13, "-0", "%2.f",
+__LINE__, -3.055513037393624e-29, "-3e-29", "%3.g",
+__LINE__, -3.056198778208295e-06, "-3.0562e-06", "%g",
+__LINE__, -3.057813660266980e-21, "-3E-21", "%1.G",
+__LINE__, -3.059687036330998e-11, "-3.1E-11", "%#2.2G",
+__LINE__, -3.061450385559094e-10, "-3.06145E-10", "%G",
+__LINE__, -3.066605713361383e-27, "-0.000000", "%f",
+__LINE__, -3.071590110813156e+22, "-3.07159E+22", "%G",
+__LINE__, -3.073253864426931e+26, "-3.0733E+26", "%.5G",
+__LINE__, -3.078998328596940e+07, "-3.079e+07", "%5.4g",
+__LINE__, -3.082733887951920e+06, "-3.082734e+06", "%+6e",
+__LINE__, -3.084365358064710e+24, "-3.084365E+24", "%#E",
+__LINE__, -3.086948022123716e+25, "-30869480221237162176350921.072299", "%+f",
+__LINE__, -3.088200214218024e-10, "-0", "%0.f",
+__LINE__, -3.093442983942874e+08, "-309344298.394287", "%f",
+__LINE__, -3.103573455403534e-09, "-3.103573E-09", "%#E",
+__LINE__, -3.109178443120997e+07, "-31091784.431210", "%f",
+__LINE__, -3.111494549914917e+28, "-3e+28", "%0.g",
+__LINE__, -3.113384020517480e-17, " -0", "%+6.f",
+__LINE__, -3.121622779718055e+14, "-312162277971805.491", "%+.3f",
+__LINE__, -3.122780443843900e-01, "-0.312278", "%#g",
+__LINE__, -3.122952438335638e-25, "-3.122952E-25", "%E",
+__LINE__, -3.128970339463168e-18, "-3e-18", "%3.g",
+__LINE__, -3.130862507719335e+10, "-3.130863e+10", "%3e",
+__LINE__, -3.145960838955379e+03, "-3145.96", "%g",
+__LINE__, -3.149362645138929e+21, "-3.14936e+21", "%g",
+__LINE__, -3.150697168664913e+26, "-315069716866491322804222363.629378", "%+f",
+__LINE__, -3.157946785041287e+05, "-3.1579e+05", "%.4e",
+__LINE__, -3.158347006986809e-02, "-3.E-02", "%#.0E",
+__LINE__, -3.159542871923388e+07, "-31595429", "%2.f",
+__LINE__, -3.169997512351985e+15, "-3.169998E+15", "%6.7G",
+__LINE__, -3.170971776544746e+07, "-31709717.765447", "%f",
+__LINE__, -3.173246079104466e+19, "-3.173246E+19", "%1E",
+__LINE__, -3.173581228658553e-02, "-0.03", "%+0.G",
+__LINE__, -3.187598864929850e-07, "-3.18760E-07", "%#G",
+__LINE__, -3.190525302270244e+08, "-3.190525e+08", "%+0.7g",
+__LINE__, -3.191879884186422e+19, "-3.19E+19", "%.2E",
+__LINE__, -3.197292604744926e+02, "-3.197293e+02", "%+e",
+__LINE__, -3.203713337688838e-12, "-3.20371E-12", "%6G",
+__LINE__, -3.204416889544914e-18, "-0.000000", "%+f",
+__LINE__, -3.204494471917096e+09, "-3.20449e+09", "%g",
+__LINE__, -3.211933195516720e+11, "-3.21193E+11", "%G",
+__LINE__, -3.214544021431917e-24, "-0.000000", "%1f",
+__LINE__, -3.215501229487004e-07, "-3e-07", "%3.e",
+__LINE__, -3.232157492322707e-13, "-3.E-13", "%+#5.G",
+__LINE__, -3.239074974455177e-05, "-3.239e-05", "%2.4g",
+__LINE__, -3.243083730801156e-24, "-3.243084e-24", "%#e",
+__LINE__, -3.243128583394124e+07, "-32431285.8339", "%6.4f",
+__LINE__, -3.247997999770571e-08, "-3e-08", "%5.e",
+__LINE__, -3.258251054563991e-15, "-3.2583E-15", "%.5G",
+__LINE__, -3.259499053187446e+07, "-3.2595E+07", "%5.6G",
+__LINE__, -3.261907782031174e+20, "-3.3e+20", "%.2g",
+__LINE__, -3.263979380855122e+29, "-3.26398E+29", "%G",
+__LINE__, -3.264166546402073e+06, "-3.26417E+06", "%5G",
+__LINE__, -3.269357648926951e+01, "-3.E+01", "%#5.G",
+__LINE__, -3.273523287028019e-30, "-3.27352e-30", "%g",
+__LINE__, -3.274464331526264e-14, "-3e-14", "%.0g",
+__LINE__, -3.276647049958546e+05, "-327664.7", "%+.1f",
+__LINE__, -3.276853612008326e-04, "-3.276854e-04", "%e",
+__LINE__, -3.288077788905925e+17, "-3.28808e+17", "%g",
+__LINE__, -3.292054327509010e+21, "-3.29205e+21", "%+g",
+__LINE__, -3.292086868337041e-16, " -0", "%7.f",
+__LINE__, -3.299368070005327e-17, "-3E-17", "%5.G",
+__LINE__, -3.307165537474566e-30, "-3e-30", "%+2.g",
+__LINE__, -3.310556325973673e-17, "-3.31056E-17", "%G",
+__LINE__, -3.315407318453138e-09, "-3.315407e-09", "%+#.6e",
+__LINE__, -3.318402800998018e-09, "-3.3184E-09", "%+G",
+__LINE__, -3.324277622889107e-04, "-0.000332428", "%G",
+__LINE__, -3.326372457131185e+14, "-3.326372e+14", "%0e",
+__LINE__, -3.333300611287597e+18, "-3.3E+18", "%4.2G",
+__LINE__, -3.333608976277018e-25, "-3.33361e-25", "%g",
+__LINE__, -3.333613056182724e-24, "-3.33361e-24", "%.5e",
+__LINE__, -3.338505874378410e-26, "-0.00000", "%.5f",
+__LINE__, -3.339838772519661e+24, "-3.3398E+24", "%0.5G",
+__LINE__, -3.354802735583258e-27, "-3.3548E-27", "%G",
+__LINE__, -3.356542080644329e+15, "-3356542080644329.129058", "%#f",
+__LINE__, -3.360027692463026e-29, "-3.36003e-29", "%+g",
+__LINE__, -3.361845657814323e+06, "-3361845.657814", "%f",
+__LINE__, -3.363135493765816e-12, " -0", "%5.f",
+__LINE__, -3.367383112102258e+19, "-33673831121022579360.158034", "%f",
+__LINE__, -3.376798505037497e+03, "-3376.8", "%+3G",
+__LINE__, -3.388170639372559e+09, "-3.388171e+09", "%+e",
+__LINE__, -3.397304185715499e-12, "-3.397304e-12", "%+e",
+__LINE__, -3.401559374016378e-13, "-3.40156e-13", "%g",
+__LINE__, -3.402651870178825e+21, "-3.40265e+21", "%+g",
+__LINE__, -3.410491213537530e+12, "-3.41049E+12", "%G",
+__LINE__, -3.411695570460075e-01, "-3.411696e-01", "%e",
+__LINE__, -3.417311435719220e+29, "-3.4E+29", "%3.1E",
+__LINE__, -3.417581063208165e-23, " -0", "%+4.f",
+__LINE__, -3.424005615113663e-28, "-0.000000", "%f",
+__LINE__, -3.424793585094130e-12, "-0.000000", "%f",
+__LINE__, -3.434733077762304e-05, "-3.43473e-05", "%g",
+__LINE__, -3.436384988494743e+08, "-3.43638E+08", "%G",
+__LINE__, -3.441082995163884e-21, "-0.000000", "%f",
+__LINE__, -3.442868661576827e-23, "-3.442869e-23", "%#.7g",
+__LINE__, -3.444337521046186e+13, "-3.44434E+13", "%#G",
+__LINE__, -3.448230173418967e-28, "-3.44823E-28", "%#G",
+__LINE__, -3.448523828225326e-21, "-3.4485e-21", "%.4e",
+__LINE__, -3.449876796754720e-07, "-3.44988e-07", "%g",
+__LINE__, -3.450163790411588e+25, "-34501637904115876054333966.749255", "%2f",
+__LINE__, -3.450224454406567e-26, "-3.450224E-26", "%#1E",
+__LINE__, -3.459930768422874e-28, "-3.46E-28", "%2.3G",
+__LINE__, -3.460730505022601e-28, "-3.46073e-28", "%#g",
+__LINE__, -3.462894265593946e-10, "-3.46289e-10", "%+#g",
+__LINE__, -3.464808359229496e+05, "-346481", "%6.6G",
+__LINE__, -3.467272303652620e-03, "-0.00346727", "%g",
+__LINE__, -3.468252706910251e+10, "-3.5E+10", "%#7.2G",
+__LINE__, -3.473623965680253e+27, "-3.47362e+27", "%g",
+__LINE__, -3.474527926009729e+11, "-3.475E+11", "%.4G",
+__LINE__, -3.476489048299929e+15, "-3.47649e+15", "%g",
+__LINE__, -3.477809698895344e-09, "-0.000", "%+.3f",
+__LINE__, -3.493008398637667e-28, " -0", "%+4.f",
+__LINE__, -3.497441286691613e+07, "-3.49744e+07", "%g",
+__LINE__, -3.500904660533358e+00, "-3.500905E+00", "%+1E",
+__LINE__, -3.504996054364915e+25, "-3.505e+25", "%+g",
+__LINE__, -3.507738629125434e-24, "-0.00", "%+4.2f",
+__LINE__, -3.508557770253211e-04, "-3.508558e-04", "%#6e",
+__LINE__, -3.516056824437550e+20, "-3.516057e+20", "%#e",
+__LINE__, -3.521102917733367e+02, "-352.11", "%g",
+__LINE__, -3.523948985825251e+10, "-3.52395e+10", "%+g",
+__LINE__, -3.525281835697895e-15, "-3.525282e-15", "%e",
+__LINE__, -3.534088845494570e-26, "-0.000000", "%2f",
+__LINE__, -3.541002442741569e+01, "-35.410", "%3.3f",
+__LINE__, -3.541126630345017e-19, "-3.541127e-19", "%e",
+__LINE__, -3.545277845967514e-17, "-0.000000", "%f",
+__LINE__, -3.560935430637329e-12, "-3.56094E-12", "%G",
+__LINE__, -3.564234584447659e-23, "-3.56423E-23", "%G",
+__LINE__, -3.576040378379921e-11, "-0.000000", "%+6f",
+__LINE__, -3.578133580350674e-05, "-3.578134e-05", "%#e",
+__LINE__, -3.584484015191491e-28, "-0.0", "%+2.1f",
+__LINE__, -3.591961845146752e+27, "-3.59196E+27", "%G",
+__LINE__, -3.602508380305001e+26, "-3.60251e+26", "%g",
+__LINE__, -3.603113449808132e+04, "-36031.134498", "%+3.6f",
+__LINE__, -3.605569849504628e+25, "-4E+25", "%6.G",
+__LINE__, -3.611297754851416e+05, "-361129.775485", "%+f",
+__LINE__, -3.613177909959201e-28, "-0.000000", "%f",
+__LINE__, -3.616261225230595e-01, "-0.361626", "%3g",
+__LINE__, -3.619203521536307e+09, "-3.6192E+09", "%G",
+__LINE__, -3.619316709131723e-27, "-0.0000000", "%.7f",
+__LINE__, -3.623100583082346e+28, "-3.6231E+28", "%+G",
+__LINE__, -3.626582653589919e+21, "-3626582653589918603387.332041", "%f",
+__LINE__, -3.626667540343067e-30, "-4.E-30", "%#.0G",
+__LINE__, -3.633539220625861e-30, "-3.634E-30", "%+.3E",
+__LINE__, -3.641655782149502e-11, "-3.64166E-11", "%G",
+__LINE__, -3.644523594046571e+25, "-3.64452e+25", "%5g",
+__LINE__, -3.645977605394108e+25, "-3.646e+25", "%+0.3e",
+__LINE__, -3.647864582248812e+13, "-4E+13", "%4.G",
+__LINE__, -3.655241667633056e-25, "-3.655242E-25", "%E",
+__LINE__, -3.662603655433297e+23, "-3.662604e+23", "%e",
+__LINE__, -3.668995445134158e+22, " -4E+22", "%7.G",
+__LINE__, -3.670006666569412e-11, "-3.670007e-11", "%e",
+__LINE__, -3.670510381138509e-24, "-3.670510e-24", "%e",
+__LINE__, -3.671283003268254e-20, "-3.67128E-20", "%G",
+__LINE__, -3.687760201176777e-13, "-3.68776E-13", "%G",
+__LINE__, -3.687983982100676e-14, "-0.00", "%.2f",
+__LINE__, -3.694808382827435e-12, "-3.694808E-12", "%#E",
+__LINE__, -3.696158520838821e+28, "-3.69616E+28", "%3G",
+__LINE__, -3.700911860811323e+18, "-3.70091e+18", "%+g",
+__LINE__, -3.701328314738669e+24, "-3.70133e+24", "%g",
+__LINE__, -3.707068461822151e-19, "-3.707068E-19", "%E",
+__LINE__, -3.710679411506914e+25, "-3.71068e+25", "%g",
+__LINE__, -3.713003840923896e-23, "-3.713e-23", "%7g",
+__LINE__, -3.717028397747828e-28, "-3.71703e-28", "%g",
+__LINE__, -3.728159642236442e+14, "-3.72816E+14", "%G",
+__LINE__, -3.731956233637010e+21, "-3.73196E+21", "%G",
+__LINE__, -3.742336623322610e+07, "-3.74234e+07", "%g",
+__LINE__, -3.748328269630045e+04, "-37483.3", "%G",
+__LINE__, -3.750803081283569e-27, "-3.7508E-27", "%+7G",
+__LINE__, -3.752021500826652e-04, "-0.0004", "%.1G",
+__LINE__, -3.755942257004103e-12, "-3.75594E-12", "%G",
+__LINE__, -3.765921235889045e+03, " -4e+03", "%+7.g",
+__LINE__, -3.772453135667801e-28, "-3.77245E-28", "%G",
+__LINE__, -3.776384200230367e+27, "-3.776e+27", "%1.4g",
+__LINE__, -3.787035870684945e-25, "-4E-25", "%+3.G",
+__LINE__, -3.798616350818839e-29, "-3.7986164e-29", "%.7e",
+__LINE__, -3.807178315238428e-15, "-0.000000", "%+#6f",
+__LINE__, -3.822059837967635e+18, "-3822059837967634621.236357", "%6.6f",
+__LINE__, -3.823553096022006e+12, "-3.82355e+12", "%g",
+__LINE__, -3.839198115259428e-23, "-0.000000", "%f",
+__LINE__, -3.846953640321746e+02, "-3.846954E+02", "%E",
+__LINE__, -3.852230696542361e+08, "-3.8522e+08", "%#.5g",
+__LINE__, -3.861139362195314e-25, "-3.86114E-25", "%2G",
+__LINE__, -3.873388618099769e+09, "-3873388618", "%0.0f",
+__LINE__, -3.874161550543817e+15, "-3.874162e+15", "%+e",
+__LINE__, -3.874527935469425e+20, "-3.87E+20", "%3.3G",
+__LINE__, -3.878069577893697e-30, "-3.878070E-30", "%#E",
+__LINE__, -3.878852490397702e-20, "-3.87885e-20", "%g",
+__LINE__, -3.879688342272101e-10, "-0.00", "%#4.2f",
+__LINE__, -3.879797428399897e+03, "-3880", "%1.4g",
+__LINE__, -3.881588804766756e+00, "-3.9", "%+4.2G",
+__LINE__, -3.889377318111182e+01, "-38.8938", "%+.4f",
+__LINE__, -3.893444523430385e-03, "-0.004", "%+2.g",
+__LINE__, -3.894912141515856e+03, "-3894.91", "%+g",
+__LINE__, -3.905279115773667e+04, "-39052.791158", "%f",
+__LINE__, -3.905333955484919e-20, "-3.90533E-20", "%G",
+__LINE__, -3.906559442060730e+27, "-3906559442060730447110472596.250474", "%f",
+__LINE__, -3.909396469655334e-26, "-3.91E-26", "%.3G",
+__LINE__, -3.920132491092364e+11, "-3.92013e+11", "%g",
+__LINE__, -3.935651497471973e+27, "-3935651497471972604103029880", "%5.f",
+__LINE__, -3.939742577853889e-03, "-0.004", "%5.G",
+__LINE__, -3.943284017088198e+19, "-39432840170881981123.3", "%.1f",
+__LINE__, -3.947452186327660e+09, "-3947452186.33", "%0.2f",
+__LINE__, -3.951967237553488e+18, "-3951967237553488132.562052", "%f",
+__LINE__, -3.953673427359789e-28, "-3.954E-28", "%3.4G",
+__LINE__, -3.956044867371602e+23, "-4e+23", "%+6.1g",
+__LINE__, -3.965038994251913e-20, "-3.96504e-20", "%g",
+__LINE__, -3.970527677577937e+05, "-4.e+05", "%#0.1g",
+__LINE__, -3.970717822164395e-20, "-3.970718e-20", "%6e",
+__LINE__, -3.978063834438912e-19, "-3.97806E-19", "%G",
+__LINE__, -3.982705395472599e+27, "-3.9827e+27", "%#.5g",
+__LINE__, -3.983486821352571e-28, "-3.98349e-28", "%g",
+__LINE__, -3.985470630230926e-14, "-4e-14", "%.2g",
+__LINE__, -3.993095662863953e-16, "-3.993096e-16", "%e",
+__LINE__, -4.006984141314271e-22, " -4e-22", "%7.2g",
+__LINE__, -4.006984141314271e-22, "-4.0e-22", "%#7.2g",
+__LINE__, -4.013226099863981e+06, "-4.013226E+06", "%+E",
+__LINE__, -4.013702226581167e+00, "-4.0137022", "%+#3.7f",
+__LINE__, -4.017598274642537e+11, "-4E+11", "%5.G",
+__LINE__, -4.021385792825529e-09, " -4e-09", "%7.2g",
+__LINE__, -4.024099064819937e-20, "-4.0241E-20", "%+G",
+__LINE__, -4.026952473441366e+22, "-4.026952e+22", "%6.7g",
+__LINE__, -4.027636677087866e+12, "-4.02764E+12", "%G",
+__LINE__, -4.036506013049443e+17, "-4.03651e+17", "%0.6g",
+__LINE__, -4.063191953523012e-06, " -0.0", "%6.1f",
+__LINE__, -4.070953223475192e-23, "-4.07095E-23", "%G",
+__LINE__, -4.072425833070524e+09, "-4.072426E+09", "%E",
+__LINE__, -4.086025576759603e+12, "-4.086026e+12", "%e",
+__LINE__, -4.086627783296081e-24, "-4.087E-24", "%.3E",
+__LINE__, -4.086683676772144e+10, "-40866836767.721439", "%f",
+__LINE__, -4.087336043219081e-10, "-0.", "%+#0.f",
+__LINE__, -4.125162973336809e-26, "-4.125163E-26", "%.7G",
+__LINE__, -4.150753797717075e-10, "-4.2e-10", "%.2g",
+__LINE__, -4.152126152181912e+23, "-4.15213e+23", "%g",
+__LINE__, -4.164458223079432e-07, "-4.164458E-07", "%E",
+__LINE__, -4.170624866130099e+03, "-4170.624866", "%4.6f",
+__LINE__, -4.171137277374942e-01, " -4E-01", "%+7.E",
+__LINE__, -4.176067421901769e-25, "-4.17607E-25", "%G",
+__LINE__, -4.179514418604771e+24, "-4.1795e+24", "%3.5g",
+__LINE__, -4.196285183415621e+23, "-4.19629E+23", "%5G",
+__LINE__, -4.198600486581023e+23, "-4E+23", "%+4.G",
+__LINE__, -4.199020494598538e-16, "-0.000000", "%+f",
+__LINE__, -4.207824153501688e-01, "-0.420782", "%G",
+__LINE__, -4.219086441294006e-13, " -0", "%+4.f",
+__LINE__, -4.223689582765525e+12, "-4.22369e+12", "%g",
+__LINE__, -4.230213377391093e+04, "-42302.1", "%+2.6G",
+__LINE__, -4.232495358100605e-02, "-0.042325", "%+f",
+__LINE__, -4.235459662515940e-29, "-0.000000", "%f",
+__LINE__, -4.240807508057296e-07, "-4e-07", "%0.g",
+__LINE__, -4.248376819122346e-13, "-4.248377e-13", "%7e",
+__LINE__, -4.251361939638334e-23, "-4.251362E-23", "%E",
+__LINE__, -4.253044333568077e+24, "-4.253044e+24", "%4e",
+__LINE__, -4.255728039119772e-30, "-4.25573E-30", "%2G",
+__LINE__, -4.256502531648988e+02, "-425.65", "%G",
+__LINE__, -4.260731632612400e-04, "-0", "%2.f",
+__LINE__, -4.262037138254753e-25, "-4e-25", "%5.g",
+__LINE__, -4.270910126379393e+00, "-4.2709", "%#7.4f",
+__LINE__, -4.273844276097008e-09, " -0.", "%#4.f",
+__LINE__, -4.280424136111831e+21, "-4.280E+21", "%.3E",
+__LINE__, -4.284351940366486e-23, "-0.000000", "%+f",
+__LINE__, -4.291747881693517e-29, "-4.3e-29", "%+#.2g",
+__LINE__, -4.298346825232928e+04, "-42983.5", "%G",
+__LINE__, -4.298879924365432e+28, "-42988799243654316484253286034.800112", "%f",
+__LINE__, -4.302192665689887e-25, "-0.000000", "%f",
+__LINE__, -4.303899568112784e+06, "-4E+06", "%1.G",
+__LINE__, -4.307399960278190e-30, "-4.31e-30", "%.3g",
+__LINE__, -4.341161949359232e+01, "-43.411619", "%+f",
+__LINE__, -4.353334435604675e+17, " -4e+17", "%+7.g",
+__LINE__, -4.354760231068195e+08, "-4e+08", "%2.e",
+__LINE__, -4.363535913318519e+08, "-4.363536E+08", "%+7E",
+__LINE__, -4.365389605557404e-29, "-4.365390e-29", "%e",
+__LINE__, -4.369278570829168e-22, "-4.369279E-22", "%5E",
+__LINE__, -4.372187639240662e-11, "-4.37219e-11", "%+g",
+__LINE__, -4.374221079233858e-15, "-4.37422E-15", "%4.6G",
+__LINE__, -4.374840292001664e-13, "-0.000000", "%+f",
+__LINE__, -4.376554800103945e+16, "-43765548001039453.751559", "%f",
+__LINE__, -4.376659235899513e+07, "-4.4E+07", "%0.2G",
+__LINE__, -4.377316129868239e-06, "-4.37732E-06", "%+5G",
+__LINE__, -4.380028480226885e+21, "-4e+21", "%1.0e",
+__LINE__, -4.380434965450223e+16, "-43804349654502230.393405", "%f",
+__LINE__, -4.392477080355168e-15, "-4E-15", "%+2.G",
+__LINE__, -4.396120020536161e+17, "-439612002053616102.159594", "%#f",
+__LINE__, -4.400993154571784e+13, "-44009931545717.844159", "%f",
+__LINE__, -4.402873692051930e-26, "-4.4e-26", "%5.3g",
+__LINE__, -4.405330274903779e+24, "-4405330274903779042006135.568954", "%+5f",
+__LINE__, -4.406272291312090e+06, "-4.40627e+06", "%+g",
+__LINE__, -4.407065949816988e-13, "-0.000000", "%f",
+__LINE__, -4.408295597674563e-10, "-4.4083e-10", "%g",
+__LINE__, -4.417553815178214e-30, "-4.41755E-30", "%G",
+__LINE__, -4.428894120469459e+16, "-4.42889e+16", "%g",
+__LINE__, -4.433747825142046e+04, "-4.433748e+04", "%#e",
+__LINE__, -4.435051082856639e+11, "-4.43505E+11", "%G",
+__LINE__, -4.445045573007259e-27, "-4.445e-27", "%.5g",
+__LINE__, -4.447791368960968e-25, " -4e-25", "%+7.g",
+__LINE__, -4.449691386526521e-11, "-4.44969e-11", "%g",
+__LINE__, -4.451399093849402e+06, "-4.e+06", "%#0.e",
+__LINE__, -4.453753130320864e-22, "-4E-22", "%6.E",
+__LINE__, -4.455910780463539e+00, "-4", "%2.g",
+__LINE__, -4.464935674747308e+25, "-4.46494e+25", "%g",
+__LINE__, -4.469759565657550e-29, "-4.46976e-29", "%g",
+__LINE__, -4.473254139442931e+14, "-4E+14", "%3.1G",
+__LINE__, -4.480844704930373e-04, "-0.000448", "%5.6f",
+__LINE__, -4.484177356024563e+19, "-4.484177E+19", "%E",
+__LINE__, -4.488115678357666e-13, "-4.48812e-13", "%g",
+__LINE__, -4.491545112281561e+12, "-4.491545E+12", "%E",
+__LINE__, -4.492547433553077e-23, "-4.49255e-23", "%g",
+__LINE__, -4.492701755830813e-05, "-0.000045", "%f",
+__LINE__, -4.497405935096372e-02, "-4.497406e-02", "%e",
+__LINE__, -4.502764260212887e+21, "-4.50276E+21", "%G",
+__LINE__, -4.511984199938207e+29, "-451198419993820731832556703011.505306", "%f",
+__LINE__, -4.514517861504637e-13, "-4.51452e-13", "%g",
+__LINE__, -4.525577218881990e+24, "-4.5e+24", "%2.2g",
+__LINE__, -4.549244580903896e-26, "-5E-26", "%2.G",
+__LINE__, -4.569192488002113e-29, "-5E-29", "%3.G",
+__LINE__, -4.572011438847734e+17, "-4.57e+17", "%#.3g",
+__LINE__, -4.573010973514519e-08, "-4.57301e-08", "%+7g",
+__LINE__, -4.584534976177852e-04, "-0.000458453", "%7g",
+__LINE__, -4.584729895132228e-21, "-0.000000", "%4f",
+__LINE__, -4.585259328217483e-30, "-4.58526E-30", "%+#4.6G",
+__LINE__, -4.589603063610410e-04, "-4.589603E-04", "%+E",
+__LINE__, -4.592428795671033e+22, " -5e+22", "%7.g",
+__LINE__, -4.595683678223830e-20, " -0", "%5.f",
+__LINE__, -4.602585606100101e+05, "-4.602586E+05", "%E",
+__LINE__, -4.603375306660027e-08, "-5E-08", "%+6.G",
+__LINE__, -4.611341343728034e-18, "-4.611341e-18", "%5e",
+__LINE__, -4.613608487855863e+05, "-461361", "%6g",
+__LINE__, -4.615997775774194e-24, "-4.61600e-24", "%#g",
+__LINE__, -4.620310950564759e+23, "-462031095056475926696749", "%1.0f",
+__LINE__, -4.620645693595563e-10, "-4.6206457e-10", "%.7e",
+__LINE__, -4.621527706233292e-09, "-4.621528e-09", "%#e",
+__LINE__, -4.625215210297273e-13, "-4.62522E-13", "%G",
+__LINE__, -4.636755152220100e-29, "-0.000000", "%#f",
+__LINE__, -4.641203877508087e+23, "-4.6412e+23", "%0g",
+__LINE__, -4.648627249239175e+23, "-4.65E+23", "%+0.3G",
+__LINE__, -4.662546890623409e-10, "-4.663E-10", "%.3E",
+__LINE__, -4.664488650292317e-27, "-4.66449e-27", "%#g",
+__LINE__, -4.668715685060282e+08, "-466871568.50603", "%.5f",
+__LINE__, -4.673332851657081e-18, "-4.7e-18", "%#5.2g",
+__LINE__, -4.683361436174074e+24, "-4.68e+24", "%#.2e",
+__LINE__, -4.693748680461066e-01, "-0.469375", "%G",
+__LINE__, -4.697110010549124e+23, "-4.69711E+23", "%G",
+__LINE__, -4.710442739966989e+06, "-4.710443e+06", "%2e",
+__LINE__, -4.713427678642280e-09, "-4.71343e-09", "%g",
+__LINE__, -4.721999055940316e-04, "-4.721999e-04", "%#1e",
+__LINE__, -4.724262200578540e+17, "-472426220057853996.081576", "%+f",
+__LINE__, -4.733267644288093e+01, "-4.733268e+01", "%7e",
+__LINE__, -4.742854711396110e-11, "-0.000000", "%f",
+__LINE__, -4.757456106385936e+23, "-4.75746e+23", "%g",
+__LINE__, -4.770895495642298e+27, "-4770895495642298200777986494.358629", "%2f",
+__LINE__, -4.775073456318149e+29, "-4.775073E+29", "%#E",
+__LINE__, -4.779997387204258e+17, "-4.78e+17", "%g",
+__LINE__, -4.799264315770707e-23, "-4.799264E-23", "%+.7G",
+__LINE__, -4.814277930599660e+10, "-5e+10", "%2.1g",
+__LINE__, -4.818413387018612e+05, "-5e+05", "%.0g",
+__LINE__, -4.818827195107612e-16, "-4.818827e-16", "%e",
+__LINE__, -4.841524514024803e+21, "-4.84152E+21", "%G",
+__LINE__, -4.860585077313477e+10, "-4.86059E+10", "%+G",
+__LINE__, -4.870037451948589e+28, "-48700374519485887248038125107.996166", "%f",
+__LINE__, -4.888835952705153e-28, "-4.888836E-28", "%+E",
+__LINE__, -4.893523355754114e-19, "-4.893523e-19", "%.6e",
+__LINE__, -4.906070260482585e+17, "-490607026048258454", "%+.0f",
+__LINE__, -4.907734144101900e+25, "-5E+25", "%+.1G",
+__LINE__, -4.917899547741841e-25, "-4.917900e-25", "%e",
+__LINE__, -4.923348512538722e+25, "-49233485125387215219916470.232420", "%+.6f",
+__LINE__, -4.926052630078460e-26, "-4.926053e-26", "%e",
+__LINE__, -4.926751662051156e+14, "-4.927E+14", "%+5.3E",
+__LINE__, -4.928017952199046e-12, "-0.000000", "%f",
+__LINE__, -4.944296782981195e-21, "-4.9443E-21", "%1.5G",
+__LINE__, -4.947320427183599e-19, "-4.947320e-19", "%.6e",
+__LINE__, -4.968188938972135e+17, "-4.96819E+17", "%G",
+__LINE__, -4.968756725758674e+05, "-496876", "%G",
+__LINE__, -4.968788759793340e-26, "-4.97E-26", "%.3G",
+__LINE__, -4.983904999913364e-24, "-5E-24", "%0.G",
+__LINE__, -4.985209496522767e+23, "-4.985209e+23", "%e",
+__LINE__, -4.987363880732866e+08, "-4.98736E+08", "%G",
+__LINE__, -4.989754940144973e+05, "-498975.494014", "%f",
+__LINE__, -4.998203870733718e-25, "-4.9982e-25", "%g",
+__LINE__, -4.999153445016792e-27, "-5e-27", "%+1.e",
+__LINE__, -5.002693488258108e+06, " -5e+06", "%+7.g",
+__LINE__, -5.017958458603783e+05, "-5.0179585E+05", "%+.7E",
+__LINE__, -5.028902178573363e-12, "-5.0289e-12", "%0g",
+__LINE__, -5.032337536971444e+07, "-50323375.369714", "%f",
+__LINE__, -5.036525516370473e-24, "-5.0365e-24", "%4.5g",
+__LINE__, -5.038642321515756e+18, "-5038642321515755639.893541", "%f",
+__LINE__, -5.051003516976770e-14, "-5.051E-14", "%+G",
+__LINE__, -5.051196143816789e+27, "-5.0512e+27", "%g",
+__LINE__, -5.057372886713786e+28, "-5.057373e+28", "%#e",
+__LINE__, -5.057475029459727e+12, "-5.05748e+12", "%+g",
+__LINE__, -5.068286816124670e-17, "-5.068E-17", "%5.3E",
+__LINE__, -5.070475165759468e-12, "-0.000000", "%4.6f",
+__LINE__, -5.081352543220476e+20, "-5.081E+20", "%.3E",
+__LINE__, -5.084398319179363e+11, "-508439831917.936313", "%#f",
+__LINE__, -5.085781220648484e+05, "-5.E+05", "%+#7.G",
+__LINE__, -5.094941054632498e-24, "-5.09494E-24", "%+G",
+__LINE__, -5.100059596310871e-10, "-5.10006e-10", "%3.6g",
+__LINE__, -5.103072553594136e-01, "-0.5", "%+1.g",
+__LINE__, -5.106319890388412e+08, "-5.106320e+08", "%4e",
+__LINE__, -5.107120687977690e+09, "-5107120687.977690", "%f",
+__LINE__, -5.119910716893161e-13, "-5.11991E-13", "%6G",
+__LINE__, -5.127594569425709e-29, "-5.12759e-29", "%#g",
+__LINE__, -5.130365585632797e+29, "-5.13037e+29", "%#g",
+__LINE__, -5.131415638022112e+08, "-513141563.802211", "%0f",
+__LINE__, -5.144703216335916e-23, "-5.1447e-23", "%g",
+__LINE__, -5.152511923201882e-05, "-5.15251E-05", "%+G",
+__LINE__, -5.165484448280190e-12, " -0.0", "%5.1f",
+__LINE__, -5.179220760465737e-20, "-5e-20", "%+5.g",
+__LINE__, -5.183005119662180e-10, "-5.183005E-10", "%+E",
+__LINE__, -5.199587953258117e+13, "-5.19959e+13", "%6g",
+__LINE__, -5.202041951844580e-25, "-0.000000", "%f",
+__LINE__, -5.202836038621740e+00, "-5.20284", "%G",
+__LINE__, -5.212204099528552e-11, "-5.2122e-11", "%.6g",
+__LINE__, -5.225617726710534e+17, "-522561772671053414.995868", "%+f",
+__LINE__, -5.230162003281426e+25, "-52301620032814257754694153.84578", "%+6.5f",
+__LINE__, -5.251849429321286e-11, "-5.25185e-11", "%g",
+__LINE__, -5.265174939930368e+23, "-5.265175E+23", "%1.6E",
+__LINE__, -5.271218134351422e+21, "-5.27122e+21", "%+1g",
+__LINE__, -5.273823357545750e+17, "-527382335754575048.980541", "%f",
+__LINE__, -5.279848797214957e+11, "-527984879721.495659", "%0f",
+__LINE__, -5.281551888625290e+11, "-5e+11", "%4.g",
+__LINE__, -5.281780377142961e-24, "-5.28178e-24", "%g",
+__LINE__, -5.292125782379512e+03, "-5292.125782", "%f",
+__LINE__, -5.292401691410388e+15, "-5292401691410387.520875", "%f",
+__LINE__, -5.305120752102265e-25, "-5.30512e-25", "%+#.5e",
+__LINE__, -5.317975791704413e+16, "-5.31798e+16", "%+g",
+__LINE__, -5.336522843607233e+27, "-5.33652e+27", "%#6g",
+__LINE__, -5.342016438000917e-05, " -5e-05", "%+7.e",
+__LINE__, -5.351122291549103e+06, "-5351122.291549", "%+0f",
+__LINE__, -5.352043956303597e+00, "-5.35204", "%g",
+__LINE__, -5.353582488767747e+09, "-5.354E+09", "%7.3E",
+__LINE__, -5.383420177718380e+04, "-5e+04", "%1.e",
+__LINE__, -5.384320189791882e-10, "-5.384320e-10", "%e",
+__LINE__, -5.409487543257379e-12, "-5.40949E-12", "%G",
+__LINE__, -5.418395794776773e+23, "-5.4184e+23", "%g",
+__LINE__, -5.419918795921525e-09, "-0.000000", "%+f",
+__LINE__, -5.422374157832442e+11, "-5.42237e+11", "%3g",
+__LINE__, -5.426916951577001e-27, "-5.42692E-27", "%+G",
+__LINE__, -5.430058833461779e+28, "-5.43006E+28", "%G",
+__LINE__, -5.444433348653147e+23, "-5.444433E+23", "%E",
+__LINE__, -5.446560186537024e+09, "-5.446560E+09", "%E",
+__LINE__, -5.464243500152188e+27, "-5.46424E+27", "%G",
+__LINE__, -5.464427517531742e+20, "-546442751753174249529.365625", "%f",
+__LINE__, -5.465783705970954e+05, "-5E+05", "%1.E",
+__LINE__, -5.475138077475789e-11, "-5e-11", "%.0e",
+__LINE__, -5.475302250616576e+10, "-54753022506.1658", "%.4f",
+__LINE__, -5.488964905442472e+09, "-5.48896e+09", "%g",
+__LINE__, -5.492508526846316e-08, "-5.49251e-08", "%.6g",
+__LINE__, -5.520533408804846e-15, "-5.520533e-15", "%e",
+__LINE__, -5.532744688447266e+28, "-55327446884472664123677532188.594341", "%2.6f",
+__LINE__, -5.535834653450131e-14, "-5.5e-14", "%0.1e",
+__LINE__, -5.554344735392882e-02, "-5.554345E-02", "%+#E",
+__LINE__, -5.555497334515501e-17, "-5.5555e-17", "%g",
+__LINE__, -5.558304303221977e+14, "-555830430322197.699411", "%f",
+__LINE__, -5.562210815777694e-05, "-5.562211E-05", "%#1E",
+__LINE__, -5.564800722538402e-09, "-5.56480e-09", "%#.6g",
+__LINE__, -5.567143271590439e-01, "-5.567143e-01", "%#e",
+__LINE__, -5.568606044396186e+01, "-55.6861", "%4g",
+__LINE__, -5.592027856401721e+12, "-5.592028e+12", "%.7g",
+__LINE__, -5.592295342565443e+22, "-6.E+22", "%#3.G",
+__LINE__, -5.600007421926053e+07, "-56000074.219261", "%1f",
+__LINE__, -5.601444553155006e-12, "-5.60144E-12", "%G",
+__LINE__, -5.605128912835080e-03, "-0.005605", "%+f",
+__LINE__, -5.610950285679577e+19, "-5.61095E+19", "%G",
+__LINE__, -5.622074657679467e+11, "-562207465767.946690", "%f",
+__LINE__, -5.627358352391656e-01, "-0.6", "%1.g",
+__LINE__, -5.627974317622488e-02, "-5.627974e-02", "%+e",
+__LINE__, -5.629497696447229e+27, "-5.629E+27", "%+.4G",
+__LINE__, -5.631383567258576e-29, "-5.63138e-29", "%0g",
+__LINE__, -5.635241327177333e-18, "-5.63524E-18", "%G",
+__LINE__, -5.644819783138381e+06, "-5.644820E+06", "%#E",
+__LINE__, -5.648538459114833e+26, "-564853845911483265496144667.849876", "%+f",
+__LINE__, -5.649004865848537e+00, "-5.649", "%g",
+__LINE__, -5.653403316885170e+23, "-6E+23", "%2.0E",
+__LINE__, -5.656109962244926e-18, "-0.000000", "%f",
+__LINE__, -5.674988031695793e+22, "-5.674988E+22", "%+.7G",
+__LINE__, -5.686380226400881e-22, "-0.000000", "%f",
+__LINE__, -5.698840855829442e-14, "-5.69884E-14", "%G",
+__LINE__, -5.707036642649580e+03, "-5707.036643", "%f",
+__LINE__, -5.710344882278847e+11, "-5.71034E+11", "%+G",
+__LINE__, -5.714852196401017e+19, "-5.71485E+19", "%+G",
+__LINE__, -5.720153622156089e-22, "-5.72015E-22", "%G",
+__LINE__, -5.722366011976922e+26, "-5.72237e+26", "%+g",
+__LINE__, -5.722909928097404e+12, "-5.72291E+12", "%2G",
+__LINE__, -5.725325961787777e-25, "-5.72533e-25", "%g",
+__LINE__, -5.727138241052646e+19, "-5.72714e+19", "%+#g",
+__LINE__, -5.734025840446336e+14, "-5.73403e+14", "%+g",
+__LINE__, -5.736469106710259e-05, "-0.000057", "%.6f",
+__LINE__, -5.755099153733116e-14, "-5.7551e-14", "%+g",
+__LINE__, -5.758411844890947e-20, "-6E-20", "%+6.G",
+__LINE__, -5.760350214122813e+03, "-5760.35", "%+g",
+__LINE__, -5.768009192512392e-30, "-0", "%1.f",
+__LINE__, -5.772343286693103e+07, "-5.77234E+07", "%G",
+__LINE__, -5.776693265471852e-27, "-5.776693E-27", "%E",
+__LINE__, -5.779682861172754e-28, "-5.779683e-28", "%e",
+__LINE__, -5.789953490749936e+26, "-578995349074993637117358957.76656", "%5.5f",
+__LINE__, -5.796771264754334e+04, "-57967.7", "%g",
+__LINE__, -5.804788370597286e-02, "-5.80479E-02", "%+#1.5E",
+__LINE__, -5.805343475329215e-13, "-5.80534e-13", "%g",
+__LINE__, -5.809853913830122e+09, "-5809853914", "%+0.f",
+__LINE__, -5.817313814570609e-30, " -0", "%7.0f",
+__LINE__, -5.831708441750138e+00, "-5.83171", "%#g",
+__LINE__, -5.846914550593652e+29, "-5.846915e+29", "%e",
+__LINE__, -5.851455214762288e+04, "-58514.6", "%+G",
+__LINE__, -5.855803663871393e-23, "-6E-23", "%5.E",
+__LINE__, -5.858065129988470e+10, "-5.85807e+10", "%+g",
+__LINE__, -5.863147168075411e-14, "-5.86315e-14", "%+g",
+__LINE__, -5.878936740266680e-04, "-0.000587894", "%g",
+__LINE__, -5.887654893386630e+25, "-58876548933866299506689756.526612", "%#f",
+__LINE__, -5.889416409731902e-02, "-0.06", "%5.g",
+__LINE__, -5.897630195029892e-18, "-5.897630E-18", "%#0.7G",
+__LINE__, -5.898506808456422e-19, "-5.89851E-19", "%G",
+__LINE__, -5.901768645393515e+29, "-5.90177E+29", "%+G",
+__LINE__, -5.907529093570369e+10, "-59075290935.703695", "%f",
+__LINE__, -5.910069365260240e+13, "-59100693652602.39849", "%+#5.5f",
+__LINE__, -5.915678929676435e-07, "-0.000001", "%+f",
+__LINE__, -5.922232380131716e-01, "-0.592223", "%+3f",
+__LINE__, -5.923716473994306e+19, "-5.92372E+19", "%+#.6G",
+__LINE__, -5.929950428920404e-15, "-5.929950e-15", "%+e",
+__LINE__, -5.949552735665802e+26, "-5.94955e+26", "%#g",
+__LINE__, -5.949977081310732e-02, "-0.059500", "%f",
+__LINE__, -5.954520303889356e-07, "-5.954520E-07", "%5E",
+__LINE__, -5.978861337429145e-13, "-6E-13", "%1.G",
+__LINE__, -5.980539445081087e+15, "-5.98054E+15", "%.6G",
+__LINE__, -5.981724990853490e-03, " -0.006", "%#7.g",
+__LINE__, -5.989488907825821e+03, "-6E+03", "%.2G",
+__LINE__, -5.998272294890842e+06, "-6.00E+06", "%4.2E",
+__LINE__, -6.023775731455919e-29, "-6.023776e-29", "%e",
+__LINE__, -6.028153126666870e-05, "-6.e-05", "%+#6.e",
+__LINE__, -6.036200621484690e+25, "-6e+25", "%2.2g",
+__LINE__, -6.036400640928137e-14, "-6.036401e-14", "%e",
+__LINE__, -6.038198451098329e-20, "-6.038198e-20", "%1.7g",
+__LINE__, -6.045778975641123e-15, "-6.04578E-15", "%G",
+__LINE__, -6.046038904252073e+00, "-6.04604", "%g",
+__LINE__, -6.082158462782175e-06, "-0.000006", "%+#f",
+__LINE__, -6.106162726644904e+10, "-6.10616e+10", "%g",
+__LINE__, -6.126345215489182e+10, "-6e+10", "%+1.g",
+__LINE__, -6.131852309620571e+02, "-6e+02", "%4.e",
+__LINE__, -6.134589313243809e-01, "-0.613459", "%+#f",
+__LINE__, -6.142358153783462e-10, "-6.14236E-10", "%4G",
+__LINE__, -6.151524334856263e+27, "-6151524334856262932191839354.345575", "%+6f",
+__LINE__, -6.156818333724550e+04, "-6.e+04", "%#.1g",
+__LINE__, -6.166172551433993e+24, "-6166172551433993120895138.4178", "%5.4f",
+__LINE__, -6.169532428006014e-09, "-6.16953e-09", "%3g",
+__LINE__, -6.172019382601770e-28, "-0.000000", "%+f",
+__LINE__, -6.174496985807155e-09, "-6.1745E-09", "%G",
+__LINE__, -6.186771845105751e+04, "-61867.7", "%G",
+__LINE__, -6.200817973780066e+22, "-6.20082E+22", "%3G",
+__LINE__, -6.218004335456301e-22, "-0.000000", "%+f",
+__LINE__, -6.219009630546262e-18, "-6.22e-18", "%6.3g",
+__LINE__, -6.242532875230618e-06, "-0.000006", "%7f",
+__LINE__, -6.243612261280864e+14, "-6.24361e+14", "%.6g",
+__LINE__, -6.243689597320126e+10, "-6e+10", "%.0e",
+__LINE__, -6.244620667090527e+04, "-6e+04", "%6.e",
+__LINE__, -6.250789625572054e-09, "-0.000000", "%+f",
+__LINE__, -6.253537566219164e+01, "-63.", "%#1.f",
+__LINE__, -6.284420289484166e+21, "-6.2844203e+21", "%7.7e",
+__LINE__, -6.285939888202846e+27, "-6e+27", "%+.0g",
+__LINE__, -6.290025777678105e+13, "-6E+13", "%2.E",
+__LINE__, -6.291364254323924e+10, "-6.3E+10", "%3.2G",
+__LINE__, -6.292428812164449e+15, "-6292428812164448.714839", "%.6f",
+__LINE__, -6.292600606358002e+29, "-6.29260E+29", "%#G",
+__LINE__, -6.292739629144148e-15, "-6.292740E-15", "%E",
+__LINE__, -6.296471626465745e+28, "-6.29647E+28", "%G",
+__LINE__, -6.299575066640315e+27, "-6.300E+27", "%.3E",
+__LINE__, -6.315234679394876e-24, "-6E-24", "%2.G",
+__LINE__, -6.320883246383228e-01, "-0.632088", "%2g",
+__LINE__, -6.324938413548937e-11, "-6e-11", "%.1g",
+__LINE__, -6.336312983176250e+04, "-6.336313e+04", "%e",
+__LINE__, -6.341786787214541e+06, "-6.341787E+06", "%+7.6E",
+__LINE__, -6.360189291106185e-15, "-0.0000000", "%#.7f",
+__LINE__, -6.364818355457748e-15, "-0.0000000", "%1.7f",
+__LINE__, -6.366291103431814e+04, "-63662.9", "%#G",
+__LINE__, -6.366334042923153e-05, "-6.37e-05", "%5.3g",
+__LINE__, -6.370477455143194e-12, "-0.000000", "%f",
+__LINE__, -6.372829256546279e+23, "-6.37283E+23", "%G",
+__LINE__, -6.375208490193110e-23, "-6.37521e-23", "%4.5e",
+__LINE__, -6.382595100891736e-24, "-6.3826E-24", "%5G",
+__LINE__, -6.396882421146790e-22, "-6.39688e-22", "%+g",
+__LINE__, -6.407190354039938e+08, "-6.40719e+08", "%+g",
+__LINE__, -6.408581541430886e-10, "-6.E-10", "%#0.0G",
+__LINE__, -6.409206904981703e-03, "-0.006", "%+.0G",
+__LINE__, -6.416106714707772e+26, "-641610671470777216285341637.558304", "%f",
+__LINE__, -6.417436981761998e-04, "-0.000642", "%+#f",
+__LINE__, -6.429997249673124e+11, "-642999724967.312414", "%#f",
+__LINE__, -6.440827429825250e+16, "-6.44083E+16", "%G",
+__LINE__, -6.444869858444955e+02, "-6e+02", "%6.g",
+__LINE__, -6.471701890976228e-25, " -6e-25", "%7.1g",
+__LINE__, -6.485393161670371e-12, "-6.485393e-12", "%.6e",
+__LINE__, -6.487710907063584e+23, "-6.E+23", "%#3.E",
+__LINE__, -6.492942931343439e-08, "-0.", "%+#2.0f",
+__LINE__, -6.496010652113223e+18, "-6.49601e+18", "%g",
+__LINE__, -6.502856921840228e+22, "-6.50286e+22", "%4g",
+__LINE__, -6.523559906055000e-10, "-6.52356E-10", "%.6G",
+__LINE__, -6.525899074126662e+04, "-6.5e+04", "%+.1e",
+__LINE__, -6.532216801155521e-09, "-6.53222E-09", "%G",
+__LINE__, -6.544601787025684e-27, "-0", "%+.0f",
+__LINE__, -6.558968312132168e-01, " -1", "%+6.f",
+__LINE__, -6.559654261655786e+08, "-6.559654e+08", "%e",
+__LINE__, -6.566562622196495e-21, "-6.56656E-21", "%.6G",
+__LINE__, -6.573486832071960e+04, "-65734.9", "%G",
+__LINE__, -6.573806290918275e+13, "-6.57381E+13", "%G",
+__LINE__, -6.578113771674787e+17, "-6.57811E+17", "%+#G",
+__LINE__, -6.584106931007506e+15, "-6.584107E+15", "%E",
+__LINE__, -6.590538844308877e+07, "-65905388.443089", "%f",
+__LINE__, -6.593708834068371e-07, "-0.000001", "%f",
+__LINE__, -6.597116446195875e+08, "-6.5971164e+08", "%#1.7e",
+__LINE__, -6.605813542127091e-04, "-0.0007", "%+0.g",
+__LINE__, -6.607491403866429e+07, "-7e+07", "%3.g",
+__LINE__, -6.616499847522278e+09, "-6.61650E+09", "%+#G",
+__LINE__, -6.618619768691332e+20, "-7E+20", "%2.G",
+__LINE__, -6.626748168962331e-22, "-7.E-22", "%+#3.E",
+__LINE__, -6.639335450348280e+12, "-6.63934e+12", "%g",
+__LINE__, -6.643910144912576e-03, "-0.006644", "%f",
+__LINE__, -6.650293872031870e-18, "-6.65029e-18", "%+#g",
+__LINE__, -6.654903858656310e-21, "-0.000000", "%f",
+__LINE__, -6.665834666726511e-12, "-6.665835E-12", "%E",
+__LINE__, -6.666428729917570e-19, "-0.000000", "%+#f",
+__LINE__, -6.668415789681128e+27, "-6.66842E+27", "%+G",
+__LINE__, -6.675214676269601e-28, "-6.67521e-28", "%#g",
+__LINE__, -6.679560072732262e+01, "-66.7956", "%#g",
+__LINE__, -6.692325075457020e-19, "-0.000000", "%1f",
+__LINE__, -6.697096655164652e+00, "-6.70", "%#.3g",
+__LINE__, -6.712436135928394e-28, "-7e-28", "%0.g",
+__LINE__, -6.720769486122685e-16, "-7e-16", "%0.e",
+__LINE__, -6.727196898490600e+26, "-672719689849060031860972230.8", "%.1f",
+__LINE__, -6.744132627576416e+02, "-674.413", "%6G",
+__LINE__, -6.757705576425288e+28, "-6.7577056e+28", "%.7e",
+__LINE__, -6.760554929237173e-02, "-0.067606", "%+f",
+__LINE__, -6.763538810629361e+10, "-6.7635E+10", "%.4E",
+__LINE__, -6.764712008860796e-29, "-6.76471E-29", "%+G",
+__LINE__, -6.767299719678443e+04, "-67672.997197", "%f",
+__LINE__, -6.768326491352134e+20, "-676832649135213415547.70", "%+.2f",
+__LINE__, -6.771116968952891e+03, "-7E+03", "%3.1G",
+__LINE__, -6.775218099238350e-30, "-7.e-30", "%+#6.g",
+__LINE__, -6.782142689928918e-18, "-0.00", "%4.2f",
+__LINE__, -6.795409770512149e+08, "-7E+08", "%+5.0G",
+__LINE__, -6.820966157097271e+14, "-6.820966e+14", "%e",
+__LINE__, -6.824972990592273e-22, "-0.00", "%+#1.2f",
+__LINE__, -6.830452914741750e+29, "-6.8E+29", "%+7.2G",
+__LINE__, -6.835797187132348e+10, "-6.8358E+10", "%+5G",
+__LINE__, -6.837040829636343e-03, "-0.00683704", "%+g",
+__LINE__, -6.852956218658224e+23, "-6.85296e+23", "%3g",
+__LINE__, -6.854102607287217e-26, "-7e-26", "%5.e",
+__LINE__, -6.865065870249438e+16, "-6.86507E+16", "%#G",
+__LINE__, -6.884819522625523e-13, "-6.88482E-13", "%5G",
+__LINE__, -6.916316600148513e-12, "-0.000000", "%f",
+__LINE__, -6.925312418761560e-05, "-6.92531E-05", "%#G",
+__LINE__, -6.929518694178331e+09, "-6929518694.178", "%#.3f",
+__LINE__, -6.936008056682024e+02, "-6.936008E+02", "%E",
+__LINE__, -6.944911117352400e+26, "-6.944911E+26", "%1.6E",
+__LINE__, -6.945829492125162e+05, "-6.9e+05", "%+2.2g",
+__LINE__, -6.946603162471856e-13, "-6.94660E-13", "%#G",
+__LINE__, -6.947529440406653e+22, "-6.9475e+22", "%+6.5g",
+__LINE__, -6.950167604854856e-30, "-0.000000", "%7f",
+__LINE__, -6.958122319262799e-26, "-7E-26", "%+1.E",
+__LINE__, -6.958978258390961e+16, "-6.95898E+16", "%+5.6G",
+__LINE__, -6.963780466334008e-06, "-6.96378E-06", "%2G",
+__LINE__, -6.965570896221966e+13, "-6.965571E+13", "%5E",
+__LINE__, -6.967741871945064e-10, "-6.96774E-10", "%+#G",
+__LINE__, -6.973815739524307e+19, "-69738157395243067782.076", "%6.3f",
+__LINE__, -6.982714545008106e+13, "-6.98271e+13", "%g",
+__LINE__, -6.985955885054476e+03, "-6985.96", "%6G",
+__LINE__, -6.986415266835747e+18, "-6.98642e+18", "%#g",
+__LINE__, -6.996461529596512e-08, "-7.0E-08", "%#.1E",
+__LINE__, -7.000144914012241e-05, "-7.00014e-05", "%#g",
+__LINE__, -7.001017894492730e-03, "-0.00700102", "%+#.6G",
+__LINE__, -7.003690685875917e+20, "-7E+20", "%0.G",
+__LINE__, -7.010454163965384e+00, "-7.010454e+00", "%+e",
+__LINE__, -7.011493550018082e-26, " -0", "%7.f",
+__LINE__, -7.018018443394008e+21, "-7.0E+21", "%+#1.1E",
+__LINE__, -7.027253777387243e-05, "-7.02725E-05", "%+G",
+__LINE__, -7.043679213677740e-17, "-0", "%1.f",
+__LINE__, -7.051690489227881e-16, "-7.052e-16", "%0.4g",
+__LINE__, -7.063422475274161e-16, "-7.063422E-16", "%E",
+__LINE__, -7.065069592235558e-30, "-7.06507e-30", "%+#g",
+__LINE__, -7.068265283935834e-29, "-7e-29", "%+5.e",
+__LINE__, -7.068748224536295e-13, "-0.000000", "%f",
+__LINE__, -7.069621910708177e-04, "-0.000707", "%1.3g",
+__LINE__, -7.079725450964823e-12, "-0.000000", "%f",
+__LINE__, -7.087255464668218e+17, "-7.1e+17", "%.1e",
+__LINE__, -7.088715102009605e-09, "-7e-09", "%6.0g",
+__LINE__, -7.090414916270137e-15, "-0.00000", "%.5f",
+__LINE__, -7.091868311008428e-03, " -0.0", "%5.1f",
+__LINE__, -7.094242165237718e+21, "-7.09424e+21", "%+g",
+__LINE__, -7.094324305740325e-05, "-7E-05", "%+3.G",
+__LINE__, -7.104544752289144e+04, "-71045.4", "%#g",
+__LINE__, -7.105164644813694e-29, "-0.000000", "%+f",
+__LINE__, -7.114513164219487e-12, "-7.11451e-12", "%+g",
+__LINE__, -7.115778236604137e-12, "-7.11578E-12", "%G",
+__LINE__, -7.126217683410162e-27, "-7.126218e-27", "%e",
+__LINE__, -7.136214260967733e+28, "-71362142609677334803564008325.338364", "%f",
+__LINE__, -7.143452595522573e+19, "-7.14345e+19", "%g",
+__LINE__, -7.156042088843537e+27, "-7156042088843537207765166385.7977837", "%4.7f",
+__LINE__, -7.173687683710490e+24, "-7.17369e+24", "%6g",
+__LINE__, -7.190531162598206e+25, "-71905311625982060164119503", "%4.f",
+__LINE__, -7.201301831373747e-09, "-7.2013e-09", "%g",
+__LINE__, -7.209601436737306e+10, "-7.2096e+10", "%g",
+__LINE__, -7.211058997356655e-06, "-7.211059E-06", "%E",
+__LINE__, -7.226756177676272e-09, "-7.22676E-09", "%+G",
+__LINE__, -7.230870817566419e+19, "-72308708175664193618.1040364", "%#.7f",
+__LINE__, -7.231355992133345e-05, "-7.231356E-05", "%#E",
+__LINE__, -7.245999575278407e-12, "-7.246e-12", "%g",
+__LINE__, -7.247426403040390e-09, "-7.2474E-09", "%+4.5G",
+__LINE__, -7.257348680308567e-12, "-7.3E-12", "%1.2G",
+__LINE__, -7.258184256387366e-26, "-7.25818E-26", "%+2G",
+__LINE__, -7.262633672900126e+10, "-7.26263e+10", "%#g",
+__LINE__, -7.268887462426250e+03, "-7.268887e+03", "%+#e",
+__LINE__, -7.275284494682963e+08, "-7.27528e+08", "%g",
+__LINE__, -7.276335846256479e-07, " -0", "%4.f",
+__LINE__, -7.312556378294452e+15, "-7.31256e+15", "%+6g",
+__LINE__, -7.334763752442417e-15, "-0.0000", "%#.4f",
+__LINE__, -7.354627097325888e-18, "-7E-18", "%0.E",
+__LINE__, -7.360087573342401e-25, "-7.4E-25", "%6.2G",
+__LINE__, -7.368533563361098e-29, "-7.4E-29", "%3.1E",
+__LINE__, -7.379267723540596e-06, "-0.000007", "%f",
+__LINE__, -7.384525781709565e-19, "-0.000000", "%+#f",
+__LINE__, -7.388940868679677e-09, "-7.388941E-09", "%E",
+__LINE__, -7.391602149099698e+00, "-7.391602E+00", "%E",
+__LINE__, -7.393159340196723e+22, "-7.39316e+22", "%#2.6g",
+__LINE__, -7.399783260198277e-16, "-7.39978E-16", "%G",
+__LINE__, -7.405609590448331e-06, "-7.40561e-06", "%g",
+__LINE__, -7.407396977847794e-11, "-7.40740E-11", "%#G",
+__LINE__, -7.433716848698637e+20, "-7.43372e+20", "%+g",
+__LINE__, -7.444176062769411e-01, "-0.744418", "%#g",
+__LINE__, -7.448314697244012e+12, "-7448314697244.011739", "%f",
+__LINE__, -7.449533988369018e+08, "-7.449534e+08", "%+#7e",
+__LINE__, -7.465682839758801e-01, "-7E-01", "%4.E",
+__LINE__, -7.466517843126368e-26, "-7.5E-26", "%.1E",
+__LINE__, -7.471385785539900e+24, "-7471385785539899515583783.795591", "%f",
+__LINE__, -7.478345583780341e+00, "-7.478346e+00", "%e",
+__LINE__, -7.524759284626724e-06, "-7.52476e-06", "%2g",
+__LINE__, -7.534831049342539e-19, "-7.53483E-19", "%G",
+__LINE__, -7.540546673179273e+15, "-8e+15", "%.1g",
+__LINE__, -7.543440436184003e-08, "-7.54344E-08", "%6G",
+__LINE__, -7.558224240835564e-06, "-7.55822e-06", "%g",
+__LINE__, -7.564132915154469e+23, "-756413291515446850610260.298708", "%+f",
+__LINE__, -7.566590720355392e+15, "-7.566591e+15", "%1.6e",
+__LINE__, -7.568565927479741e-01, "-7.568566e-01", "%#6e",
+__LINE__, -7.615574141973305e-17, "-7.6156e-17", "%+.5g",
+__LINE__, -7.641297631509318e-28, "-8e-28", "%+.1g",
+__LINE__, -7.661227834163450e+09, "-7661227834.1634497", "%+#.7f",
+__LINE__, -7.665934364070126e+11, "-766593436407.0", "%.1f",
+__LINE__, -7.682500068463102e-27, "-0.000000", "%+#f",
+__LINE__, -7.709363160273798e+15, "-7.70936e+15", "%g",
+__LINE__, -7.712596019255238e+26, "-7.7e+26", "%.2g",
+__LINE__, -7.730213358437991e+25, "-7.7e+25", "%6.2g",
+__LINE__, -7.744420019068976e+05, "-7.74442E+05", "%.5E",
+__LINE__, -7.745813181942296e+11, "-7.7458132e+11", "%+.7e",
+__LINE__, -7.751004379716307e+16, "-7.751004e+16", "%e",
+__LINE__, -7.759862226564527e-28, "-7.75986e-28", "%g",
+__LINE__, -7.767838880221207e-27, "-7.76784e-27", "%g",
+__LINE__, -7.776301142157532e-19, "-0", "%2.f",
+__LINE__, -7.783944257077553e-14, "-8e-14", "%3.g",
+__LINE__, -7.801587579382377e+28, "-8e+28", "%+0.g",
+__LINE__, -7.806685979552780e+25, "-7.806686E+25", "%E",
+__LINE__, -7.825968891331719e-05, "-7.82597E-05", "%G",
+__LINE__, -7.826834158664018e+12, "-7.826834E+12", "%+#E",
+__LINE__, -7.832536798726886e+24, "-7.83254E+24", "%#1G",
+__LINE__, -7.840485340202362e-18, "-0.000000", "%.6f",
+__LINE__, -7.843236212099233e+21, "-7.84324e+21", "%g",
+__LINE__, -7.906644052019278e-13, "-7.906644E-13", "%E",
+__LINE__, -7.908090440678874e-20, "-7.90809E-20", "%#G",
+__LINE__, -7.917588593012283e+08, "-7.917589E+08", "%+E",
+__LINE__, -7.929100086742454e+29, "-792910008674245414539427656563.930213", "%f",
+__LINE__, -7.933235286034290e+26, "-7.933235E+26", "%E",
+__LINE__, -7.943431966567875e-03, "-0.0079434", "%+.5g",
+__LINE__, -7.950872643572970e-22, "-7.95087e-22", "%2g",
+__LINE__, -7.971225555313069e-01, "-0.797123", "%f",
+__LINE__, -7.978310272676090e-12, "-0.000000", "%#f",
+__LINE__, -8.006805393896414e-29, "-8.00681E-29", "%G",
+__LINE__, -8.006906303018830e+25, "-8.00691E+25", "%+G",
+__LINE__, -8.008484654476057e+18, "-8.008485e+18", "%5.6e",
+__LINE__, -8.008943512904249e+27, "-8008943512904249217854157905.0943", "%+.4f",
+__LINE__, -8.016539743121665e+27, "-8.01654E+27", "%G",
+__LINE__, -8.018247227006128e-05, " -8E-05", "%7.G",
+__LINE__, -8.044391842561705e+21, "-8.04439e+21", "%g",
+__LINE__, -8.081902305002036e-02, "-8.081902E-02", "%E",
+__LINE__, -8.084193011936438e-03, "-0.0080842", "%+5.5g",
+__LINE__, -8.105813534846529e-27, "-0.000000", "%f",
+__LINE__, -8.128116892989251e+00, "-8.12812", "%G",
+__LINE__, -8.136119035731877e+05, "-8e+05", "%+0.g",
+__LINE__, -8.140584224052606e+14, "-8E+14", "%5.G",
+__LINE__, -8.145928897003907e+13, "-8.15E+13", "%.3G",
+__LINE__, -8.164495905907508e-02, "-0.081645", "%G",
+__LINE__, -8.169602113313905e+20, "-8.16960e+20", "%#g",
+__LINE__, -8.179181640418333e+24, "-8.E+24", "%#.1G",
+__LINE__, -8.184324492264231e-18, "-8.18432E-18", "%G",
+__LINE__, -8.186480473850516e-28, "-0.000000", "%+f",
+__LINE__, -8.196858948158896e+07, "-8.1969E+07", "%.4E",
+__LINE__, -8.213138534699043e-30, "-0.000000", "%f",
+__LINE__, -8.221181368676532e-21, "-8.221181E-21", "%#1E",
+__LINE__, -8.222605734191438e+16, "-8.22261E+16", "%+G",
+__LINE__, -8.223925661091432e-14, "-8.223926e-14", "%0e",
+__LINE__, -8.232281541044777e-01, "-0.823228", "%f",
+__LINE__, -8.245536794508725e+22, "-8E+22", "%6.G",
+__LINE__, -8.270687365305925e+25, "-82706873653059247430974210.146815", "%f",
+__LINE__, -8.288978945738204e+11, "-8.28898e+11", "%5g",
+__LINE__, -8.290628698333139e+02, "-829.063", "%+G",
+__LINE__, -8.292416206056451e-16, "-8.29242e-16", "%+g",
+__LINE__, -8.296322623746486e-13, "-8.29632E-13", "%0.6G",
+__LINE__, -8.298321941376933e-16, "-0.000000", "%+f",
+__LINE__, -8.302331258878365e+29, "-8.30233E+29", "%0G",
+__LINE__, -8.309022429255061e+06, "-8309022.429255", "%+f",
+__LINE__, -8.312786829254646e-23, "-8.312787e-23", "%e",
+__LINE__, -8.313852965178063e-15, "-8.313853e-15", "%#7e",
+__LINE__, -8.317529094827869e+16, "-8.31753E+16", "%2G",
+__LINE__, -8.322847660882248e-17, "-0.000000", "%f",
+__LINE__, -8.324060602752638e-30, "-8.32406e-30", "%#g",
+__LINE__, -8.325043500735461e+27, "-8325043500735461066142306663.095951", "%#f",
+__LINE__, -8.332432016286935e-02, "-0.0833243", "%g",
+__LINE__, -8.334251670232117e-09, "-8.33425e-09", "%g",
+__LINE__, -8.338076225141778e+02, "-833.808", "%g",
+__LINE__, -8.338349587571534e-23, "-8.33835e-23", "%+2g",
+__LINE__, -8.342420812231939e+23, "-834242081223193920891390.00745", "%+0.5f",
+__LINE__, -8.347404637940894e+17, "-8.347405e+17", "%+e",
+__LINE__, -8.367002601133880e-12, "-0.000000", "%#2.6f",
+__LINE__, -8.368579538210858e-17, "-8.36858e-17", "%5g",
+__LINE__, -8.392398522472401e-10, "-0.0000", "%.4f",
+__LINE__, -8.393029677635258e-29, " -8E-29", "%7.G",
+__LINE__, -8.393843230819225e-11, "-8.393843E-11", "%E",
+__LINE__, -8.397239871789148e-11, "-8.39724e-11", "%g",
+__LINE__, -8.402316358199041e-29, "-0.000", "%3.3f",
+__LINE__, -8.402910159034304e-14, "-8.4e-14", "%+0.3g",
+__LINE__, -8.414960962391726e+09, "-8414960962.391726", "%#f",
+__LINE__, -8.417512471384889e-28, "-8.417512e-28", "%e",
+__LINE__, -8.418719240222911e+21, "-8418719240222911182058.851409", "%f",
+__LINE__, -8.421210956044195e-09, "-0.00000", "%.5f",
+__LINE__, -8.422001733529095e+24, "-8E+24", "%0.G",
+__LINE__, -8.443614453772469e+21, "-8.44361E+21", "%+G",
+__LINE__, -8.445883044175737e-19, "-0", "%+1.f",
+__LINE__, -8.460545304711022e-01, "-0.846055", "%G",
+__LINE__, -8.470462532754567e+12, "-8.47E+12", "%6.3G",
+__LINE__, -8.478488782426476e-07, "-8.478489E-07", "%E",
+__LINE__, -8.478657582923923e+09, "-8.5e+09", "%.2g",
+__LINE__, -8.482732098043366e+12, "-8482732098043", "%5.f",
+__LINE__, -8.489112373854447e+07, "-8.489e+07", "%#3.3e",
+__LINE__, -8.494153144629106e+02, "-849.415", "%+g",
+__LINE__, -8.496331191616493e+28, "-8E+28", "%+6.G",
+__LINE__, -8.503711894495339e+05, "-850371", "%g",
+__LINE__, -8.505271893964268e+14, "-8.505272E+14", "%E",
+__LINE__, -8.509873985358741e+15, "-9.e+15", "%#7.g",
+__LINE__, -8.518336897898081e-20, "-8.51834E-20", "%G",
+__LINE__, -8.529588044136128e+21, "-8.529588E+21", "%E",
+__LINE__, -8.539706586811079e-23, "-8.53971E-23", "%G",
+__LINE__, -8.545924619642008e+10, "-8.545925e+10", "%6e",
+__LINE__, -8.572893681637353e+09, "-8.57289E+09", "%G",
+__LINE__, -8.585483717692345e+29, "-8.58548E+29", "%+G",
+__LINE__, -8.586092014292309e+27, "-8.59e+27", "%.2e",
+__LINE__, -8.604716827086833e-26, "-8.60472e-26", "%g",
+__LINE__, -8.621349224186615e-04, "-0.000862", "%f",
+__LINE__, -8.626097065201103e-21, " -0", "%5.f",
+__LINE__, -8.631700514212522e-16, "-8.631701E-16", "%+E",
+__LINE__, -8.634703359975640e-09, "-0.000000", "%+5f",
+__LINE__, -8.639393025443855e-17, "-8.63939e-17", "%g",
+__LINE__, -8.640641942556812e-11, "-8.64064e-11", "%#g",
+__LINE__, -8.646260250525495e-09, "-0.000", "%.3f",
+__LINE__, -8.667322015806242e+09, "-8667322015.806242", "%+#f",
+__LINE__, -8.690705655554451e+10, "-8.690706E+10", "%#E",
+__LINE__, -8.714299893763934e-07, "-8.7143E-07", "%.5G",
+__LINE__, -8.715729756264988e+27, "-8.71573E+27", "%+.6G",
+__LINE__, -8.716518487180945e+16, "-9e+16", "%3.e",
+__LINE__, -8.744404488756237e+25, "-87444044887562366596966967.335902", "%4f",
+__LINE__, -8.754720498369242e+13, "-8.75472e+13", "%g",
+__LINE__, -8.763198097931010e-19, "-8.76320e-19", "%#g",
+__LINE__, -8.779007408852458e+28, "-8.77901E+28", "%G",
+__LINE__, -8.794576202907937e+11, "-8.79458E+11", "%#2.6G",
+__LINE__, -8.799091520612418e-11, "-8.799E-11", "%3.4G",
+__LINE__, -8.799246265524921e+11, "-8.79925E+11", "%G",
+__LINE__, -8.809010508550436e-04, "-8.8090E-04", "%.4E",
+__LINE__, -8.817389999872653e-10, "-8.81739e-10", "%g",
+__LINE__, -8.842022428985267e-28, "-8.842022E-28", "%E",
+__LINE__, -8.851265987586864e-07, "-0.000001", "%f",
+__LINE__, -8.861985131432196e+03, "-8861.985", "%+.7G",
+__LINE__, -8.874449013455113e-29, "-8.874449e-29", "%e",
+__LINE__, -8.878752609483453e+18, "-8.87875E+18", "%G",
+__LINE__, -8.882501665315313e-04, "-0.00088825", "%+G",
+__LINE__, -8.892056241505784e-14, "-8.89206E-14", "%G",
+__LINE__, -8.895327674961603e-30, "-8.89533E-30", "%G",
+__LINE__, -8.900059462213669e-30, "-8.900059E-30", "%+#E",
+__LINE__, -8.957100548759815e+18, "-9e+18", "%3.0e",
+__LINE__, -8.961352369869012e-30, "-8.961352e-30", "%+#2e",
+__LINE__, -8.962296474587800e+02, "-896", "%4.f",
+__LINE__, -8.962536469328530e-12, "-8.96254E-12", "%G",
+__LINE__, -8.963299420391932e+21, "-8.9633e+21", "%g",
+__LINE__, -8.967736672941522e-11, "-8.96774e-11", "%g",
+__LINE__, -8.994077362462679e+11, "-8.9940774e+11", "%+#.7e",
+__LINE__, -9.000452862345622e+15, "-9e+15", "%2.e",
+__LINE__, -9.007489135361462e+07, "-9.0075E+07", "%+2.4E",
+__LINE__, -9.036271805879910e+16, "-9.03627E+16", "%G",
+__LINE__, -9.036319073700248e+22, "-9.03632e+22", "%1g",
+__LINE__, -9.043207635989237e+11, "-9.043208e+11", "%#e",
+__LINE__, -9.043856598625815e-26, "-9e-26", "%+1.g",
+__LINE__, -9.052760561065698e+14, "-9.052761E+14", "%E",
+__LINE__, -9.066480297957160e-06, "-9E-06", "%+1.G",
+__LINE__, -9.070971376440752e-01, "-0.907097", "%g",
+__LINE__, -9.073301831888273e+09, "-9.07330E+09", "%#G",
+__LINE__, -9.091228662702147e+28, "-9E+28", "%4.G",
+__LINE__, -9.093652024983832e+04, "-9.093652E+04", "%7.6E",
+__LINE__, -9.098945831139295e-04, "-9.098946E-04", "%+1.6E",
+__LINE__, -9.124981449916591e+05, "-912498", "%G",
+__LINE__, -9.132038703003394e-02, "-0.0913204", "%#G",
+__LINE__, -9.138271437433964e-04, "-0.000913827", "%5g",
+__LINE__, -9.158186427463699e-04, "-0.000915819", "%g",
+__LINE__, -9.160846358172526e+16, "-9.160846E+16", "%#E",
+__LINE__, -9.160884330810163e+17, "-9E+17", "%+5.G",
+__LINE__, -9.190271387375542e+21, "-9.19027e+21", "%+g",
+__LINE__, -9.191651872412619e-04, "-9.191652E-04", "%E",
+__LINE__, -9.196426161984341e-10, "-9E-10", "%4.G",
+__LINE__, -9.201074139774962e+09, "-9E+09", "%4.G",
+__LINE__, -9.223294284802762e+09, "-9.22329E+09", "%G",
+__LINE__, -9.224740266754996e+02, "-9E+02", "%6.0G",
+__LINE__, -9.231583780512302e-01, " -0.9", "%6.g",
+__LINE__, -9.241998826543689e+07, "-92419988", "%1.f",
+__LINE__, -9.243603351372128e+27, "-9.243603e+27", "%#e",
+__LINE__, -9.255922697415071e+11, "-9.25592e+11", "%g",
+__LINE__, -9.265734968114124e-02, "-0.092657", "%f",
+__LINE__, -9.273132068521061e+11, "-9.27313E+11", "%G",
+__LINE__, -9.276017912826685e+27, "-9.E+27", "%+#5.G",
+__LINE__, -9.279781279788505e+17, "-9.27978E+17", "%7G",
+__LINE__, -9.305057549822465e-19, "-9.30506E-19", "%5G",
+__LINE__, -9.313182384508469e+18, "-9.31318E+18", "%G",
+__LINE__, -9.313350925182641e-12, "-9.31E-12", "%.3G",
+__LINE__, -9.362202657509130e+08, "-9e+08", "%.1g",
+__LINE__, -9.367344757598381e+19, "-9.36734e+19", "%g",
+__LINE__, -9.374222399774300e+26, "-9.37422e+26", "%4g",
+__LINE__, -9.385734023305105e+02, "-9.385734e+02", "%+0e",
+__LINE__, -9.392042570618909e+17, "-9.39204E+17", "%G",
+__LINE__, -9.395742939311926e+20, "-939574293931192627837.8451", "%.4f",
+__LINE__, -9.409066155962469e+09, "-9.40907E+09", "%#G",
+__LINE__, -9.412851077799790e+23, "-9.412851E+23", "%E",
+__LINE__, -9.431808019049818e+08, "-9.43181e+08", "%g",
+__LINE__, -9.465236900519924e-27, "-9.46524e-27", "%g",
+__LINE__, -9.478330386415852e+17, "-9.478330e+17", "%e",
+__LINE__, -9.510393719697428e+15, "-9.51039E+15", "%+G",
+__LINE__, -9.534229599909890e-09, "-0.000000", "%f",
+__LINE__, -9.541731189284823e-17, "-1.E-16", "%+#7.G",
+__LINE__, -9.548861908445902e+24, "-9548861908445902102471336.547751", "%f",
+__LINE__, -9.578447281451794e+14, "-957844728145179", "%5.f",
+__LINE__, -9.580512736933464e+11, "-9.58051E+11", "%G",
+__LINE__, -9.596838169770637e-28, "-1E-27", "%+6.G",
+__LINE__, -9.597528852877852e-22, "-1e-21", "%2.1g",
+__LINE__, -9.599943658427051e+02, "-9.599944E+02", "%E",
+__LINE__, -9.603227991185260e-14, "-1E-13", "%+0.E",
+__LINE__, -9.606818733892343e+08, "-960681873.389", "%1.3f",
+__LINE__, -9.617442692720937e+16, "-9.61744E+16", "%G",
+__LINE__, -9.628685516961109e+29, "-9.62869e+29", "%3g",
+__LINE__, -9.638354750455226e-11, "-0.000000", "%f",
+__LINE__, -9.644266379029137e+16, "-96442663790291369.707575", "%f",
+__LINE__, -9.645563533575482e+06, "-1E+07", "%1.G",
+__LINE__, -9.645993536742941e-29, "-9.64599e-29", "%+g",
+__LINE__, -9.647147223548563e+00, "-9.647147e+00", "%e",
+__LINE__, -9.671225879906396e-11, "-0", "%0.f",
+__LINE__, -9.675000471729906e-09, "-9.675000E-09", "%E",
+__LINE__, -9.683992878297159e-26, "-9.68e-26", "%2.2e",
+__LINE__, -9.695491325144765e+10, "-9.69549E+10", "%#G",
+__LINE__, -9.695661526907136e-24, " -0.", "%#6.f",
+__LINE__, -9.703124881970338e+07, "-9.703e+07", "%0.4g",
+__LINE__, -9.707701257031864e+26, "-970770125703186437249314622.022212", "%f",
+__LINE__, -9.709879792694702e+09, "-9.709880E+09", "%E",
+__LINE__, -9.736052226907940e+26, "-9.73605e+26", "%+#g",
+__LINE__, -9.745037157520795e+07, "-9.74504e+07", "%#5.6g",
+__LINE__, -9.757293950670832e-29, "-9.757E-29", "%0.4G",
+__LINE__, -9.762126832689880e+12, "-9.76213E+12", "%G",
+__LINE__, -9.801328150341989e-01, " -1", "%7.G",
+__LINE__, -9.837332964629669e-20, "-9.83733E-20", "%0G",
+__LINE__, -9.837790327283010e+23, "-1E+24", "%.1G",
+__LINE__, -9.839636176463729e+23, "-9.83964E+23", "%#6.5E",
+__LINE__, -9.841454250618272e+11, "-9.84E+11", "%+2.3G",
+__LINE__, -9.852920805249280e-12, "-9.852921e-12", "%.7g",
+__LINE__, -9.854092850182351e+12, "-9.85409e+12", "%0g",
+__LINE__, -9.866796026839712e+02, "-9.9E+02", "%#.1E",
+__LINE__, -9.867413260289803e-21, "-1e-20", "%.1g",
+__LINE__, -9.882136052131983e-08, "-9.88214e-08", "%g",
+__LINE__, -9.882755697941866e+20, "-9.882756E+20", "%E",
+__LINE__, -9.897275811087050e+20, "-9.9E+20", "%0.3G",
+__LINE__, -9.899860651812364e-04, "-9.899861e-04", "%e",
+__LINE__, -9.906754113555550e-11, "-9.90675e-11", "%3g",
+__LINE__, -9.926067557389940e+11, "-9.92607E+11", "%G",
+__LINE__, -9.929638609014063e+17, "-992963860901406292.214233", "%1f",
+__LINE__, -9.941214552193284e-24, "-0.000000", "%+#f",
+__LINE__, -9.942875240256573e+14, "-9.942875e+14", "%+1e",
+__LINE__, -9.944492909695798e-01, "-9.944E-01", "%.3E",
+__LINE__, -9.954710507359939e-27, "-1e-26", "%+0.2g",
+__LINE__, -9.955410507742851e+03, "-9955.41", "%+G",
+__LINE__, -9.974437672251590e+02, "-997.444", "%#G",
+__LINE__, -9.975683165288929e-26, "-9.97568E-26", "%6G",
+__LINE__, 1.003827370583415e+06, "1003827.370583", "%3f",
+__LINE__, 1.004189065268560e-27, "1.004189E-27", "%.7G",
+__LINE__, 1.005840059175462e-28, "+1.00584E-28", "%+G",
+__LINE__, 1.006586790090557e-12, "0.000000", "%#f",
+__LINE__, 1.007598594773359e+18, "1.0076E+18", "%G",
+__LINE__, 1.007902307001894e+29, "1.0079e+29", "%g",
+__LINE__, 1.008607405036580e-15, "1.00861E-15", "%6G",
+__LINE__, 1.008769102466771e+16, "+1.00877E+16", "%+G",
+__LINE__, 1.009545698372534e-08, "+1E-08", "%+0.0G",
+__LINE__, 1.010173673945099e-12, "+1.01017e-12", "%+#0g",
+__LINE__, 1.011375000606627e+09, "1011375000.606627", "%f",
+__LINE__, 1.011944652221650e+15, "1011944652221649.98", "%3.2f",
+__LINE__, 1.013057788090379e-21, "0.000000", "%#f",
+__LINE__, 1.014525729953198e+15, "1.01453e+15", "%3g",
+__LINE__, 1.016760538234615e-21, "+1.016761E-21", "%+3E",
+__LINE__, 1.017052611781237e-29, "0.000000", "%f",
+__LINE__, 1.018471223361229e+14, "1.01847E+14", "%G",
+__LINE__, 1.021646959220873e+15, "1021646959220872.6", "%4.1f",
+__LINE__, 1.022304833976590e+27, "1.0223e+27", "%g",
+__LINE__, 1.022500312067325e-12, "1.0225e-12", "%6g",
+__LINE__, 1.023019285462627e-20, "0.000000", "%f",
+__LINE__, 1.024192579400824e+06, "1.02419e+06", "%g",
+__LINE__, 1.024517953555766e-28, "1.02452E-28", "%G",
+__LINE__, 1.026673589339585e+21, "1.02667E+21", "%G",
+__LINE__, 1.027231090958880e-19, "1.E-19", "%#3.G",
+__LINE__, 1.028249904956487e-27, "1E-27", "%5.G",
+__LINE__, 1.028570144661448e-28, "+1.02857E-28", "%+G",
+__LINE__, 1.028934898454705e-13, "+1.028935E-13", "%+E",
+__LINE__, 1.029071053545906e-26, "1.029071E-26", "%E",
+__LINE__, 1.032672895881148e-30, "+1.032673E-30", "%+E",
+__LINE__, 1.033502358979511e+06, "1.0335E+06", "%.5G",
+__LINE__, 1.036790427717847e+19, "1e+19", "%4.g",
+__LINE__, 1.037022928821648e+03, "1037.02", "%5g",
+__LINE__, 1.040551683941284e+14, "1.04055E+14", "%G",
+__LINE__, 1.044499252101308e-17, "1.044499E-17", "%E",
+__LINE__, 1.045791899570889e+15, "+1.04579e+15", "%+g",
+__LINE__, 1.048730383198703e+28, "1.049e+28", "%.4g",
+__LINE__, 1.050654419882509e-18, "0.000000", "%f",
+__LINE__, 1.052600569262127e-27, "+0.000", "%+2.3f",
+__LINE__, 1.053213014784149e+15, "1E+15", "%4.G",
+__LINE__, 1.057553916225948e-15, "+0.000000", "%+4f",
+__LINE__, 1.058191244482453e+19, "1.058e+19", "%.3e",
+__LINE__, 1.058746269793972e-26, "+1.1E-26", "%+.2G",
+__LINE__, 1.058793271960762e-01, "+1.058793E-01", "%+4E",
+__LINE__, 1.058869592738370e-19, "1.05887e-19", "%3g",
+__LINE__, 1.060402312803008e+15, "1060402312803008.229025", "%f",
+__LINE__, 1.061106284763095e+00, "1.061106", "%0f",
+__LINE__, 1.061180160987467e+09, "1e+09", "%2.g",
+__LINE__, 1.061181537176067e-06, "+1.06118e-06", "%+g",
+__LINE__, 1.065021381771174e+20, "1.06502e+20", "%g",
+__LINE__, 1.065464040401130e-16, "1.065464e-16", "%e",
+__LINE__, 1.065573419819459e-05, "0.00001", "%.5f",
+__LINE__, 1.066107764306644e+13, "1.066108e+13", "%#e",
+__LINE__, 1.071318759598956e+12, "1.071319e+12", "%e",
+__LINE__, 1.071564727222321e+10, "1.072E+10", "%3.4G",
+__LINE__, 1.074652481218139e+14, "1.0747E+14", "%.4E",
+__LINE__, 1.078453684911309e-02, "0.0107845", "%g",
+__LINE__, 1.078550811446675e-05, "1.07855e-05", "%g",
+__LINE__, 1.078780494515273e-04, "0.000107878", "%4G",
+__LINE__, 1.079467488876157e-16, "+1.079467E-16", "%+E",
+__LINE__, 1.080529722917934e-20, "0.000000", "%f",
+__LINE__, 1.082169127709439e+01, "10.8217", "%#5g",
+__LINE__, 1.087241285590951e+22, "1E+22", "%4.G",
+__LINE__, 1.091049208406195e-14, "0.0000", "%.4f",
+__LINE__, 1.095316064213237e+16, "+1e+16", "%+0.g",
+__LINE__, 1.095349083237975e-04, "1.095349e-04", "%5e",
+__LINE__, 1.098002465452836e+12, "1098002465452.836205", "%f",
+__LINE__, 1.098445764138997e+13, "1.09845E+13", "%G",
+__LINE__, 1.099968047892474e-13, "1.1e-13", "%2.5g",
+__LINE__, 1.101017598311363e-04, "0.000110102", "%G",
+__LINE__, 1.102776332077817e+18, "1.103e+18", "%.3e",
+__LINE__, 1.103734053887830e-01, "0.110373", "%f",
+__LINE__, 1.105730106869006e-03, "0.00110573", "%g",
+__LINE__, 1.106366781854058e-10, "1.10637e-10", "%g",
+__LINE__, 1.107354763213839e+15, "1.107355e+15", "%6e",
+__LINE__, 1.108151709609825e-10, "+1.10815E-10", "%+G",
+__LINE__, 1.110054501993647e+21, "+1.11005E+21", "%+G",
+__LINE__, 1.111574814737873e-17, "+1.112E-17", "%+1.4G",
+__LINE__, 1.111865512360108e-15, "1E-15", "%.0G",
+__LINE__, 1.112281568330498e-03, "1.112282e-03", "%.6e",
+__LINE__, 1.112625415174238e+21, "+1.11263e+21", "%+g",
+__LINE__, 1.112744974910395e-02, "0.011127", "%f",
+__LINE__, 1.114726566979885e-10, "1.11473e-10", "%g",
+__LINE__, 1.115395843055731e-20, "+0.000000", "%+6f",
+__LINE__, 1.115983414693121e+15, "1.11598e+15", "%5.6g",
+__LINE__, 1.116118842074266e+27, "1.116119e+27", "%e",
+__LINE__, 1.118386983012328e+19, "11183869830123276400.968280", "%1f",
+__LINE__, 1.119344607892718e-22, "1.119345e-22", "%e",
+__LINE__, 1.120560837110279e-19, "0.000000", "%f",
+__LINE__, 1.123620157906291e-02, "0.0112362", "%G",
+__LINE__, 1.126804857639478e+29, "1.1268E+29", "%#0.5G",
+__LINE__, 1.128962199461581e+11, "1.12896e+11", "%g",
+__LINE__, 1.129878714246809e-16, "1E-16", "%0.0G",
+__LINE__, 1.130331982972407e-06, "+0.", "%+#1.f",
+__LINE__, 1.134167332070028e-16, "0", "%0.0f",
+__LINE__, 1.134248080053598e-28, "0.000000", "%f",
+__LINE__, 1.136023160708119e-10, "+0.000000", "%+1f",
+__LINE__, 1.136167141059036e+23, "113616714105903593434732.101741", "%f",
+__LINE__, 1.136439499920164e+10, "+1.13644E+10", "%+G",
+__LINE__, 1.136859734932182e+24, "1.13686e+24", "%g",
+__LINE__, 1.138985939448731e+09, "1.13899e+09", "%2g",
+__LINE__, 1.139287324790407e-25, "1e-25", "%.1g",
+__LINE__, 1.140559912153251e+06, "1.14056e+06", "%g",
+__LINE__, 1.141318036027086e-26, "1.14132E-26", "%G",
+__LINE__, 1.142586049368452e-20, "+1.14259E-20", "%+7.5E",
+__LINE__, 1.143283863993333e-17, "1.143284E-17", "%3E",
+__LINE__, 1.144637911632432e-28, "1.144638E-28", "%#3E",
+__LINE__, 1.145791416532065e-10, "1.14579e-10", "%g",
+__LINE__, 1.146958047315780e-17, "1.146958e-17", "%e",
+__LINE__, 1.147898346886569e-08, "1E-08", "%3.0E",
+__LINE__, 1.149724744965608e-14, "1.14972e-14", "%5g",
+__LINE__, 1.155383721940441e-10, "1e-10", "%1.g",
+__LINE__, 1.157066617729094e-02, "0", "%1.f",
+__LINE__, 1.157893614537215e+05, "1.157894E+05", "%E",
+__LINE__, 1.160476344451928e-19, "1.2e-19", "%.1e",
+__LINE__, 1.161610499315966e-26, "1.161610E-26", "%E",
+__LINE__, 1.162345042181490e+29, "116234504218148981813385489658.685401", "%5.6f",
+__LINE__, 1.162376053722862e+23, "1.16238e+23", "%g",
+__LINE__, 1.162996084782483e+18, "+1e+18", "%+0.g",
+__LINE__, 1.163544861478966e+26, "1.16354E+26", "%G",
+__LINE__, 1.167300137450931e+06, "1E+06", "%.0G",
+__LINE__, 1.168693829096401e-30, "+1.16869e-30", "%+g",
+__LINE__, 1.172791369381396e+15, "1.173E+15", "%.4G",
+__LINE__, 1.174427110782028e-29, " 1E-29", "%7.G",
+__LINE__, 1.179498322112450e+27, "1179498322112449759657692993.641831", "%f",
+__LINE__, 1.179555606293547e+27, "1.17956e+27", "%3g",
+__LINE__, 1.180815814881269e+06, "1.180816e+06", "%e",
+__LINE__, 1.181494870072805e+20, "1.181495e+20", "%5e",
+__LINE__, 1.181524119225619e+12, "+1181524119225.61917", "%+5.5f",
+__LINE__, 1.182111212289243e-20, "1e-20", "%4.g",
+__LINE__, 1.184503315019769e-27, "1.1845e-27", "%7g",
+__LINE__, 1.186413646767670e+29, "1.18641e+29", "%g",
+__LINE__, 1.186852938885004e-13, "1.18685e-13", "%4g",
+__LINE__, 1.188837612473914e+05, "1e+05", "%.0g",
+__LINE__, 1.190317482928293e-29, "1.190317e-29", "%e",
+__LINE__, 1.190527491143987e+02, "1.190527E+02", "%E",
+__LINE__, 1.191823062060233e-30, "1.2E-30", "%6.2G",
+__LINE__, 1.191926974812428e-23, "1.2e-23", "%.2g",
+__LINE__, 1.193549622366544e-25, "1E-25", "%4.1G",
+__LINE__, 1.195517368629765e-21, "1.195517e-21", "%1.7g",
+__LINE__, 1.195573061651289e-27, "1.19557e-27", "%#g",
+__LINE__, 1.195806681188325e-03, "+0.00120", "%+#.3G",
+__LINE__, 1.196842275192189e-28, "1.19684e-28", "%g",
+__LINE__, 1.197307550969576e+04, "1.1973E+04", "%.4E",
+__LINE__, 1.197608525847607e+15, "1197608525847606.8062805", "%4.7f",
+__LINE__, 1.197801338159407e+04, "11978", "%5G",
+__LINE__, 1.197813329735025e+27, "1.19781E+27", "%7G",
+__LINE__, 1.199483904123253e-12, "1.19948e-12", "%g",
+__LINE__, 1.199535292169766e-09, "1.199535e-09", "%e",
+__LINE__, 1.201478067515135e+05, "120147.806752", "%f",
+__LINE__, 1.202054662662158e+17, "1.20205E+17", "%#G",
+__LINE__, 1.202111922368321e+07, "+1.202112E+07", "%+#E",
+__LINE__, 1.202536892743791e-01, "0.120254", "%#g",
+__LINE__, 1.205698674119882e-29, "1.2057E-29", "%G",
+__LINE__, 1.208091664701942e-13, " 0.", "%#3.f",
+__LINE__, 1.208942413954872e-17, "1.20894E-17", "%G",
+__LINE__, 1.209704891496613e+10, "1.210e+10", "%2.3e",
+__LINE__, 1.211355639334831e+29, "1E+29", "%.0G",
+__LINE__, 1.211447553804203e+17, " 1E+17", "%7.E",
+__LINE__, 1.212481583429790e-16, "1.212482e-16", "%e",
+__LINE__, 1.212849001551862e+26, "121284900155186181613942153.4899157", "%6.7f",
+__LINE__, 1.213057538677801e+06, "1213057.538678", "%#.6f",
+__LINE__, 1.214609592911893e+25, "1.214610e+25", "%#e",
+__LINE__, 1.216086266251665e+01, "1e+01", "%5.e",
+__LINE__, 1.216468565931026e-22, "1.216469E-22", "%1E",
+__LINE__, 1.216503126598765e+14, "+1E+14", "%+0.E",
+__LINE__, 1.216641013695553e-14, "0.000000", "%f",
+__LINE__, 1.223142246779504e-23, "0.000000", "%f",
+__LINE__, 1.223884786443274e+08, "122388479", "%5.f",
+__LINE__, 1.224012562770076e+29, "1.22401e+29", "%0g",
+__LINE__, 1.225098157528297e+14, "1.22510e+14", "%#g",
+__LINE__, 1.226306848505242e-22, "1.22631E-22", "%G",
+__LINE__, 1.227487485547996e-08, "+1.22749e-08", "%+g",
+__LINE__, 1.237206486909689e+02, "+123.721", "%+#.6g",
+__LINE__, 1.240281126177077e-02, "+0.01", "%+3.g",
+__LINE__, 1.241197211306994e-06, "1.241197E-06", "%E",
+__LINE__, 1.241776311097410e+07, "1.241776E+07", "%E",
+__LINE__, 1.245995986024999e-03, "0.001246", "%g",
+__LINE__, 1.246082428199607e+03, "1246.082428", "%f",
+__LINE__, 1.247021567954220e+05, " 1e+05", "%7.g",
+__LINE__, 1.248140089618390e-30, "+1.24814E-30", "%+G",
+__LINE__, 1.248403361652064e-30, "+0.000000", "%+f",
+__LINE__, 1.251098538918842e-26, "+1.251099E-26", "%+E",
+__LINE__, 1.251952633022061e+25, "1.25195e+25", "%g",
+__LINE__, 1.253029705843461e-04, "+1.E-04", "%+#4.E",
+__LINE__, 1.259562132729488e-09, "1e-09", "%1.e",
+__LINE__, 1.261702205492260e-27, "0.000000", "%f",
+__LINE__, 1.265910361926660e-19, "+1.265910e-19", "%+e",
+__LINE__, 1.267411912651087e+12, "1.26741E+12", "%1G",
+__LINE__, 1.267830718285980e-10, "1.26783e-10", "%g",
+__LINE__, 1.268238378987517e-23, "1E-23", "%5.E",
+__LINE__, 1.275543253354167e+10, "1.27554E+10", "%G",
+__LINE__, 1.277255234454465e-10, "1.27726E-10", "%5G",
+__LINE__, 1.280590949834150e-21, "1.280591E-21", "%E",
+__LINE__, 1.285570453788242e-02, "1.285570E-02", "%E",
+__LINE__, 1.287712130719031e+09, "1287712130.719031", "%#f",
+__LINE__, 1.290142876187105e+29, "+1.290143E+29", "%+E",
+__LINE__, 1.293129213191961e+21, "1.29313E+21", "%G",
+__LINE__, 1.293317101334714e-23, "+0.000000", "%+f",
+__LINE__, 1.294506813069071e-13, "0.0", "%3.1f",
+__LINE__, 1.295576232685739e-22, "+0.000000", "%+f",
+__LINE__, 1.296010470431800e-19, "+0.000000", "%+6f",
+__LINE__, 1.298798231947674e+19, "1.2988E+19", "%2G",
+__LINE__, 1.299521114379381e+09, "1.29952E+09", "%G",
+__LINE__, 1.299847637892712e+24, "1.299848e+24", "%e",
+__LINE__, 1.301269777843698e+29, "130126977784369834978406288428.232074", "%f",
+__LINE__, 1.302911786437618e-15, " 0", "%6.f",
+__LINE__, 1.303863159906719e+27, "1303863159906719415559450681", "%0.f",
+__LINE__, 1.304396472326846e-12, "+1E-12", "%+1.0G",
+__LINE__, 1.306180443528427e-30, "+1e-30", "%+.1g",
+__LINE__, 1.308469138968514e+22, "1.30847E+22", "%0G",
+__LINE__, 1.312700156826057e-11, "1.3127e-11", "%g",
+__LINE__, 1.315364075120764e+21, "+1.31536E+21", "%+G",
+__LINE__, 1.320376485288444e-09, "+1.3204E-09", "%+6.5G",
+__LINE__, 1.321434154364635e-08, "1.32143e-08", "%1g",
+__LINE__, 1.322777272579176e+19, "+1e+19", "%+3.e",
+__LINE__, 1.322861663428564e+00, "1.322862E+00", "%#E",
+__LINE__, 1.323566013489230e+14, "+1.323566E+14", "%+1E",
+__LINE__, 1.327446904132973e-20, "+1.32745E-20", "%+4.6G",
+__LINE__, 1.328226362528158e+19, "1e+19", "%2.g",
+__LINE__, 1.329167460803610e+08, "1e+08", "%3.g",
+__LINE__, 1.335371420823160e+14, "1.33537E+14", "%7G",
+__LINE__, 1.336116185095935e-21, "0.000000", "%f",
+__LINE__, 1.338766774704671e-22, "+1.33877e-22", "%+g",
+__LINE__, 1.339199373014647e-12, "1E-12", "%1.E",
+__LINE__, 1.344293357481519e+26, "134429335748151945750805680.290796", "%#2f",
+__LINE__, 1.344328188122843e+29, "1.34433e+29", "%g",
+__LINE__, 1.344382581316972e-05, "1E-05", "%5.0E",
+__LINE__, 1.349835616116184e+11, "134983561611.6", "%2.1f",
+__LINE__, 1.349955669989707e+20, "134995566998970728533.890906", "%7f",
+__LINE__, 1.350230411093841e+20, "135023041109384145386.229648", "%f",
+__LINE__, 1.353391369565576e+10, " 1E+10", "%7.1G",
+__LINE__, 1.356889483699471e+22, "+1.35689E+22", "%+G",
+__LINE__, 1.358141775798243e+24, "+1358141775798242578687791.137781", "%+f",
+__LINE__, 1.358547541975523e-15, "1.35855e-15", "%g",
+__LINE__, 1.363402539800791e+11, "1.3634E+11", "%G",
+__LINE__, 1.363676837988798e+16, "+13636768379887982.4053", "%+2.4f",
+__LINE__, 1.364592026494839e-24, "1.36459e-24", "%g",
+__LINE__, 1.366664212399413e-09, "+1E-09", "%+6.G",
+__LINE__, 1.367446193117463e-17, "1.3674e-17", "%2.4e",
+__LINE__, 1.368681648785823e-18, "1.36868E-18", "%3G",
+__LINE__, 1.370635189583606e+05, "1.370635E+05", "%E",
+__LINE__, 1.371395540772186e-18, "+1.371396e-18", "%+e",
+__LINE__, 1.371945318043159e+10, "1E+10", "%0.E",
+__LINE__, 1.373780604772988e-21, "1e-21", "%3.g",
+__LINE__, 1.374244970441862e-28, "0.000000", "%7.6f",
+__LINE__, 1.375874695067149e-25, "1.37587E-25", "%#3G",
+__LINE__, 1.377165614832621e+20, "1.37717E+20", "%#G",
+__LINE__, 1.381541864946684e-09, "1.38154E-09", "%G",
+__LINE__, 1.382901694835415e+00, "1.382902E+00", "%E",
+__LINE__, 1.384250577530184e-21, "1.384e-21", "%.4g",
+__LINE__, 1.385322753374640e-03, " 1E-03", "%6.E",
+__LINE__, 1.387026156054724e+19, "1.387026E+19", "%E",
+__LINE__, 1.388726735790498e-27, "+1.388727E-27", "%+E",
+__LINE__, 1.388819105742044e+16, "1.38882e+16", "%g",
+__LINE__, 1.389941086024951e-19, "0.000000", "%f",
+__LINE__, 1.390101174785536e+25, "1.3901E+25", "%G",
+__LINE__, 1.392210785638597e+24, "+1.39221E+24", "%+G",
+__LINE__, 1.396148856283474e-26, "1.4e-26", "%7.3g",
+__LINE__, 1.398153728631994e-21, "1.39815E-21", "%G",
+__LINE__, 1.398332446762342e-14, "+1.39833E-14", "%+5G",
+__LINE__, 1.400250919607987e+10, "1.40025E+10", "%G",
+__LINE__, 1.400662469019739e+03, "1.E+03", "%#0.0E",
+__LINE__, 1.401720273747805e-12, "0.000000", "%#f",
+__LINE__, 1.402151358748719e+22, "1.402151e+22", "%e",
+__LINE__, 1.402351913752357e-28, "1.40235E-28", "%#1.6G",
+__LINE__, 1.403285877973810e+13, "+14032858779738.097255", "%+4f",
+__LINE__, 1.404540981735861e+04, "14045.409817", "%4f",
+__LINE__, 1.406420622355064e+19, "1.40642E+19", "%G",
+__LINE__, 1.412552725962301e-29, "+1e-29", "%+1.e",
+__LINE__, 1.413266982485044e+10, "1.41327e+10", "%g",
+__LINE__, 1.413627189411456e+21, "1.41363E+21", "%0G",
+__LINE__, 1.416647216002592e-25, "+0.000000", "%+#f",
+__LINE__, 1.417107155080584e-10, "1e-10", "%1.e",
+__LINE__, 1.418829895346648e+19, "14188298953466484952.912197", "%f",
+__LINE__, 1.419404559267523e-11, "1.4194e-11", "%g",
+__LINE__, 1.422421321425472e+15, "1.422421E+15", "%E",
+__LINE__, 1.424858902008998e+18, "1.42486E+18", "%2.5E",
+__LINE__, 1.428863051254205e+22, "1.428863e+22", "%e",
+__LINE__, 1.429533727936725e-02, "0.0142953", "%g",
+__LINE__, 1.430982219743369e-19, " 1E-19", "%6.G",
+__LINE__, 1.431974118434703e+17, "1E+17", "%3.G",
+__LINE__, 1.432418341970152e+16, "+1.432418e+16", "%+5e",
+__LINE__, 1.433470281650523e+04, "14334.7", "%g",
+__LINE__, 1.434446243424653e+24, " +1e+24", "%+7.g",
+__LINE__, 1.435118019241039e+24, "+1e+24", "%+4.g",
+__LINE__, 1.435691648420278e-01, "0.1435692", "%#4.7g",
+__LINE__, 1.437569598098744e+27, "1.437570E+27", "%#E",
+__LINE__, 1.437633484061726e-25, "+1.43763e-25", "%+7g",
+__LINE__, 1.437866591230707e-13, "1.43787e-13", "%g",
+__LINE__, 1.440593154445915e-01, "+0.144059", "%+1G",
+__LINE__, 1.441368205977342e+16, "1.441368E+16", "%#E",
+__LINE__, 1.441825266684367e+28, "1.44183e+28", "%g",
+__LINE__, 1.442374183199456e+20, "1.442374E+20", "%E",
+__LINE__, 1.445101893951061e-24, "0", "%0.f",
+__LINE__, 1.446037835160094e-20, "+1.44604E-20", "%+2G",
+__LINE__, 1.449245376093616e+04, "1.449245e+04", "%e",
+__LINE__, 1.454126845620100e+09, "1.45413E+09", "%G",
+__LINE__, 1.455764608801107e+09, "1.5e+09", "%6.1e",
+__LINE__, 1.457176183149955e-12, "1.45718e-12", "%#g",
+__LINE__, 1.458821535020046e-05, "1.45882e-05", "%#g",
+__LINE__, 1.460179141161202e-19, "1.460179E-19", "%#E",
+__LINE__, 1.461701055446198e-20, "1.461701e-20", "%#2.7g",
+__LINE__, 1.462408181482172e+10, "1.4624082E+10", "%3.7E",
+__LINE__, 1.463706296748154e+24, "1e+24", "%2.g",
+__LINE__, 1.464891255780761e-19, "+1.46489e-19", "%+g",
+__LINE__, 1.467903978945872e+25, "1.4679E+25", "%G",
+__LINE__, 1.468585992857062e+22, "14685859928570619281629.205943", "%f",
+__LINE__, 1.469803528668286e+29, "+1E+29", "%+6.G",
+__LINE__, 1.469883002609266e-23, "1.E-23", "%#2.E",
+__LINE__, 1.469941481858809e+08, "+146994148.185881", "%+f",
+__LINE__, 1.470744493304611e+13, "1.47074e+13", "%g",
+__LINE__, 1.471857261085004e+23, "1E+23", "%2.G",
+__LINE__, 1.474419778873037e+06, "1474419.7789", "%#.4f",
+__LINE__, 1.483134762223381e-03, "0", "%0.0f",
+__LINE__, 1.483575501240724e-13, "1.48358e-13", "%g",
+__LINE__, 1.486068112294452e+20, "1.486068e+20", "%e",
+__LINE__, 1.488665528787761e-03, " +0", "%+4.f",
+__LINE__, 1.492145267536713e+07, "14921452.675367", "%f",
+__LINE__, 1.492589762884761e-01, "0.149259", "%f",
+__LINE__, 1.494784286168215e+01, "1.494784E+01", "%E",
+__LINE__, 1.495945331501655e+04, "1.5e+04", "%.2g",
+__LINE__, 1.501383201904700e+14, "2e+14", "%1.g",
+__LINE__, 1.501387105011959e-02, "0.0150139", "%g",
+__LINE__, 1.505784488562271e+26, "1.50578e+26", "%5g",
+__LINE__, 1.506367986495534e+10, "1.50637e+10", "%2g",
+__LINE__, 1.507421710226296e+19, "1.507422E+19", "%#E",
+__LINE__, 1.507960881206134e+16, "2e+16", "%.0g",
+__LINE__, 1.508974301049424e+14, "+1.508974E+14", "%+E",
+__LINE__, 1.509204025111090e-18, "1.509204E-18", "%E",
+__LINE__, 1.511351799767759e+21, "1511351799767759462866.93397", "%.5f",
+__LINE__, 1.511712197184520e-06, "+1.51171e-06", "%+1g",
+__LINE__, 1.514703727491400e+02, "151.47", "%.5g",
+__LINE__, 1.514855355408287e+04, "15148.6", "%g",
+__LINE__, 1.516256896575301e+06, "1.516257e+06", "%.6e",
+__LINE__, 1.517712083681069e+14, "1.51771e+14", "%0g",
+__LINE__, 1.522102209167607e-18, "1.52210e-18", "%#g",
+__LINE__, 1.526264862895663e-12, "0.000000", "%f",
+__LINE__, 1.527165480858125e+10, "1.527e+10", "%.4g",
+__LINE__, 1.528363280308369e+00, "+1.52836", "%+0G",
+__LINE__, 1.529108490733420e-22, "1.529108E-22", "%E",
+__LINE__, 1.529783364474522e+19, "15297833644745216119.531506", "%7f",
+__LINE__, 1.530698363199346e-01, "0.1531", "%#.4f",
+__LINE__, 1.531520796537450e+22, "1.53152E+22", "%G",
+__LINE__, 1.533314559644813e+06, "+1533314.559645", "%+f",
+__LINE__, 1.534682791112854e+01, "+15.3468", "%+0G",
+__LINE__, 1.534714026386730e-11, "0.000000", "%f",
+__LINE__, 1.537145729498115e+00, "1.537146E+00", "%E",
+__LINE__, 1.538740040875751e-23, "1.538740E-23", "%E",
+__LINE__, 1.546248240596482e-03, "0.001546", "%f",
+__LINE__, 1.546808012239302e-09, "+1.54681E-09", "%+G",
+__LINE__, 1.546903877359107e+06, "1.5e+06", "%.2g",
+__LINE__, 1.550153973747718e-18, "2e-18", "%.0g",
+__LINE__, 1.551703460384378e+00, "+1.5517", "%+.4f",
+__LINE__, 1.553995673101369e+29, "1.554E+29", "%G",
+__LINE__, 1.555477017531899e+28, "1.55548e+28", "%g",
+__LINE__, 1.555548963448462e+12, "1555548963448.46227", "%6.5f",
+__LINE__, 1.558702451007712e+16, "2e+16", "%5.1g",
+__LINE__, 1.561641587723724e+29, "1.561642e+29", "%e",
+__LINE__, 1.561868589559509e-05, "1.56187E-05", "%G",
+__LINE__, 1.565229056438949e+13, "1.56523e+13", "%1.6g",
+__LINE__, 1.570074406600442e+14, "+1.57007E+14", "%+4G",
+__LINE__, 1.570951909913194e+13, "1.57095E+13", "%.6G",
+__LINE__, 1.572186421520727e-30, "+1.57219e-30", "%+g",
+__LINE__, 1.574374582066945e+12, "1.57e+12", "%5.2e",
+__LINE__, 1.577789404823585e+12, "1.577789E+12", "%E",
+__LINE__, 1.579641278389186e+04, "15796.413", "%7.3f",
+__LINE__, 1.581602330975388e+17, "1.5816E+17", "%#.5G",
+__LINE__, 1.587809692297490e-18, "+1.58781e-18", "%+2g",
+__LINE__, 1.588672954832388e-05, "1.58867E-05", "%G",
+__LINE__, 1.594548954259978e+25, "+1.595e+25", "%+.3e",
+__LINE__, 1.596653742160718e+10, "15966537421.6072", "%.4f",
+__LINE__, 1.597416186584641e+25, "1.59742e+25", "%g",
+__LINE__, 1.597810706039500e-04, "0.000159781", "%g",
+__LINE__, 1.601425691153542e+01, "16.0143", "%G",
+__LINE__, 1.601491150913706e-15, "+1.60149e-15", "%+g",
+__LINE__, 1.609357026469645e+02, "160.936", "%0g",
+__LINE__, 1.611064881461188e+06, "+1.611065E+06", "%+E",
+__LINE__, 1.611324319640770e-03, "0.00161132", "%G",
+__LINE__, 1.613202907940803e+19, "1.6E+19", "%#.1E",
+__LINE__, 1.613883500056636e-12, "0.000000", "%5f",
+__LINE__, 1.618254213010772e+07, "16182542.130108", "%6f",
+__LINE__, 1.620441271211248e-08, "1.62044E-08", "%0G",
+__LINE__, 1.622548435024803e-01, "+0.162255", "%+5G",
+__LINE__, 1.623740394555269e+19, "16237403945552689066.289531", "%3f",
+__LINE__, 1.625774250389937e+18, "1.625774e+18", "%1e",
+__LINE__, 1.626300864432426e-02, "0.016263", "%G",
+__LINE__, 1.626351146877694e-11, "1.6263511e-11", "%2.7e",
+__LINE__, 1.626568757587995e+25, "16265687575879949733348439.62220", "%6.5f",
+__LINE__, 1.626717482094360e-28, "+1.626717e-28", "%+3e",
+__LINE__, 1.630801585998995e-28, "1.6308e-28", "%0g",
+__LINE__, 1.631827173682962e+03, "1632", "%1.4g",
+__LINE__, 1.631907571243379e+18, "1631907571243378818.337533", "%f",
+__LINE__, 1.632058420447239e-14, " +2E-14", "%+7.G",
+__LINE__, 1.632847882621240e+18, "+1.63285E+18", "%+2G",
+__LINE__, 1.637329146233172e-09, "+1.63733e-09", "%+g",
+__LINE__, 1.638315287442427e-16, "+1.63832E-16", "%+G",
+__LINE__, 1.641284849351445e+15, "1641284849351445.096488", "%f",
+__LINE__, 1.644871927486929e+10, "2e+10", "%1.e",
+__LINE__, 1.645917293047431e-19, "1.64592e-19", "%.6g",
+__LINE__, 1.649201265647819e-07, "0.000000", "%f",
+__LINE__, 1.650169065733559e+23, "165016906573355903731226.135278", "%3f",
+__LINE__, 1.651217291298196e-30, "2E-30", "%4.G",
+__LINE__, 1.652680660160331e+08, "2.e+08", "%#3.g",
+__LINE__, 1.654171892948767e-15, "1.65417e-15", "%g",
+__LINE__, 1.655435863725412e+17, "+1.655436e+17", "%+#e",
+__LINE__, 1.656015606204101e+28, "+1.7E+28", "%+3.2G",
+__LINE__, 1.656814723110478e-21, "+0.000000", "%+f",
+__LINE__, 1.658632655199721e-19, "2.E-19", "%#4.G",
+__LINE__, 1.659915061311444e+27, "1.66E+27", "%.3G",
+__LINE__, 1.664258574522914e-29, "+1.664259E-29", "%+E",
+__LINE__, 1.667662840654469e-28, "+2e-28", "%+0.g",
+__LINE__, 1.673124993246863e-25, "+0.000000", "%+f",
+__LINE__, 1.677788498058833e-20, "1.678e-20", "%.4g",
+__LINE__, 1.681211731173386e-07, "1.68121e-07", "%0.6g",
+__LINE__, 1.686341560076196e+02, "169", "%.0f",
+__LINE__, 1.686507685287281e+08, "1.686508E+08", "%E",
+__LINE__, 1.689500448795801e+03, "+1689.500449", "%+0f",
+__LINE__, 1.690639426041009e-13, "2e-13", "%5.0g",
+__LINE__, 1.691554939595928e+16, "+1.6916e+16", "%+.5g",
+__LINE__, 1.698597126229626e-09, "1.699e-09", "%3.4g",
+__LINE__, 1.700093083173516e+16, "17000930831735159", "%5.f",
+__LINE__, 1.703653732982710e+13, "+1.70365e+13", "%+g",
+__LINE__, 1.705353380573352e-16, "0.000000", "%f",
+__LINE__, 1.705973328700179e-26, "1.70597e-26", "%5g",
+__LINE__, 1.717797289369145e+22, "+1.717797E+22", "%+7E",
+__LINE__, 1.722819196705361e-28, "1.722819E-28", "%1.7G",
+__LINE__, 1.723775772891202e+01, "17.237758", "%f",
+__LINE__, 1.723787102325353e-23, "0.000000", "%2f",
+__LINE__, 1.724551301171870e-13, "0.000000", "%f",
+__LINE__, 1.726098078655758e-20, "0.0000000", "%7.7f",
+__LINE__, 1.726302822039762e+18, "+2E+18", "%+1.G",
+__LINE__, 1.726659209108151e+18, "+1.72666E+18", "%+6G",
+__LINE__, 1.728324925097269e-25, "1.728325e-25", "%7e",
+__LINE__, 1.728357491215602e+02, "172.836", "%G",
+__LINE__, 1.729612227517587e+22, "1.729612e+22", "%e",
+__LINE__, 1.731753104740805e-06, "1.73175e-06", "%2g",
+__LINE__, 1.736066279733589e+18, "+1.736066E+18", "%+3E",
+__LINE__, 1.736626769480182e-19, "2e-19", "%.0g",
+__LINE__, 1.737445267713118e-13, " 2e-13", "%7.g",
+__LINE__, 1.739264683023077e+05, "173926.468302", "%f",
+__LINE__, 1.739423702667596e-16, "+1.73942e-16", "%+g",
+__LINE__, 1.741053616961658e-14, "1.74105E-14", "%G",
+__LINE__, 1.741085952255057e+29, "1.7e+29", "%#.1e",
+__LINE__, 1.743673705633426e+03, "2E+03", "%5.0G",
+__LINE__, 1.750940899205665e+27, "1.75094e+27", "%g",
+__LINE__, 1.753871003884151e-26, "0.", "%#.0f",
+__LINE__, 1.755237470854478e-14, "1.755237e-14", "%4e",
+__LINE__, 1.757491419837315e-03, "0.002", "%1.G",
+__LINE__, 1.758657797688126e+26, "+1.75866E+26", "%+#G",
+__LINE__, 1.760491452270889e+08, "1.76049E+08", "%G",
+__LINE__, 1.760816275862939e-10, "2e-10", "%.1g",
+__LINE__, 1.760905893493003e-22, "1.76e-22", "%.2e",
+__LINE__, 1.762101125986743e-12, "2e-12", "%.0g",
+__LINE__, 1.763855968659571e+27, "1.763856E+27", "%E",
+__LINE__, 1.764595217341348e-13, "1.764595E-13", "%E",
+__LINE__, 1.766737296048445e+08, "+1.77e+08", "%+.3g",
+__LINE__, 1.769916386969961e-05, "+1.76992e-05", "%+g",
+__LINE__, 1.773873506344176e-01, "1.773874e-01", "%e",
+__LINE__, 1.775392554371421e+03, "+1775.39", "%+3.2f",
+__LINE__, 1.776007623006870e+24, "1776007623006870161930237.372871", "%f",
+__LINE__, 1.777418921678653e-27, " 0", "%6.f",
+__LINE__, 1.780967607234234e-18, "1.780968E-18", "%E",
+__LINE__, 1.782510583486435e+24, "+2e+24", "%+3.g",
+__LINE__, 1.784002921603004e+14, "1.784E+14", "%G",
+__LINE__, 1.784231151778382e+11, "1.7842E+11", "%.5G",
+__LINE__, 1.785589091453195e+02, " 179.", "%#5.f",
+__LINE__, 1.786402639400039e+19, "2e+19", "%0.g",
+__LINE__, 1.786506485794647e-25, "2E-25", "%.1G",
+__LINE__, 1.787513971482493e-04, "+0.000178751", "%+G",
+__LINE__, 1.799765409320039e+23, "179976540932003885586710", "%6.0f",
+__LINE__, 1.800451864218989e+08, "+1.80045e+08", "%+g",
+__LINE__, 1.800743538258572e+04, " +18007", "%+7.f",
+__LINE__, 1.801583764453362e+25, "1.8016e+25", "%0.5g",
+__LINE__, 1.804502093739547e+14, "2e+14", "%2.g",
+__LINE__, 1.805600104488678e-17, "1.805600E-17", "%E",
+__LINE__, 1.811342448081048e+17, "1.811342e+17", "%.6e",
+__LINE__, 1.812252160066930e+19, "2e+19", "%0.e",
+__LINE__, 1.816287564395273e+02, "182", "%2.f",
+__LINE__, 1.817097386762552e-13, "2E-13", "%3.1G",
+__LINE__, 1.817881381387254e+06, "1.81788E+06", "%G",
+__LINE__, 1.818416380830953e-30, "1.81842E-30", "%G",
+__LINE__, 1.824788290177454e-23, "1.82479e-23", "%g",
+__LINE__, 1.827832506678437e-18, "1.82783E-18", "%G",
+__LINE__, 1.828048053242609e+01, "18.2805", "%g",
+__LINE__, 1.828939681844203e-21, "1.82894E-21", "%.6G",
+__LINE__, 1.829763900251753e+12, "1829763900251.752773", "%1f",
+__LINE__, 1.833100407114602e-05, "0.000018", "%#f",
+__LINE__, 1.833672780034284e-07, "1.833673e-07", "%e",
+__LINE__, 1.834307692387540e+21, "2E+21", "%5.G",
+__LINE__, 1.835119931666753e+14, "+1.835120e+14", "%+e",
+__LINE__, 1.835956566920861e-26, "0.000000", "%#f",
+__LINE__, 1.837784131899354e+22, "1.83778E+22", "%G",
+__LINE__, 1.842867094224664e-09, "1.84287e-09", "%g",
+__LINE__, 1.844234823805319e+28, "2E+28", "%1.G",
+__LINE__, 1.844877682008962e+12, "1.84488e+12", "%g",
+__LINE__, 1.846530424340488e-22, "1.846530e-22", "%#.7g",
+__LINE__, 1.849111603036448e-08, "0.00", "%.2f",
+__LINE__, 1.850158752678734e+04, "+18502", "%+.5G",
+__LINE__, 1.851431391104701e-06, " +2e-06", "%+7.e",
+__LINE__, 1.851487430609031e-04, "0.000185149", "%G",
+__LINE__, 1.853171650128773e+03, "1853.17", "%G",
+__LINE__, 1.854743263740068e-16, "1.854743E-16", "%6.6E",
+__LINE__, 1.864399020932753e-11, "+0.000000", "%+f",
+__LINE__, 1.865028568072397e-22, "1.86503E-22", "%.6G",
+__LINE__, 1.868128423759223e+14, "1.86813E+14", "%4G",
+__LINE__, 1.868453558435480e+21, "1.86845E+21", "%G",
+__LINE__, 1.870663011627498e-06, "1.87E-06", "%.3G",
+__LINE__, 1.873273487748907e+17, "+1.873273E+17", "%+E",
+__LINE__, 1.878885220839805e-04, "0.000187889", "%G",
+__LINE__, 1.879102515623569e+17, "1.8791e+17", "%g",
+__LINE__, 1.889343972100858e-10, "2E-10", "%2.E",
+__LINE__, 1.891833282879762e-24, "+2e-24", "%+.1g",
+__LINE__, 1.895148778941240e-07, "0.000000", "%0f",
+__LINE__, 1.896950834067578e-28, "+1.89695e-28", "%+#g",
+__LINE__, 1.898464546986629e-05, "1.898465e-05", "%.7g",
+__LINE__, 1.900851427578321e-19, "1.90085e-19", "%6g",
+__LINE__, 1.901171344577750e+27, "1.901171e+27", "%7.7g",
+__LINE__, 1.903563335316359e+02, "190.356", "%0g",
+__LINE__, 1.903817306004701e-16, "+1.90e-16", "%+#6.2e",
+__LINE__, 1.910606410246797e+21, "1.91061E+21", "%2.5E",
+__LINE__, 1.912537759564710e+29, "1.91254E+29", "%G",
+__LINE__, 1.913606675894566e+27, "1.91361E+27", "%7.6G",
+__LINE__, 1.916473734025505e-05, " 2e-05", "%7.g",
+__LINE__, 1.916507511720523e+23, "+2E+23", "%+.0E",
+__LINE__, 1.917688262248837e-28, "1.918e-28", "%.4g",
+__LINE__, 1.921375594217083e-12, "1.92138E-12", "%G",
+__LINE__, 1.923916000932815e-25, "1.92392E-25", "%G",
+__LINE__, 1.926303652776462e-01, "+0.2", "%+0.G",
+__LINE__, 1.929411084211293e+21, "1.92941E+21", "%6G",
+__LINE__, 1.929996820297491e-26, "1.93e-26", "%.6g",
+__LINE__, 1.937301472034748e-29, "1.9373E-29", "%G",
+__LINE__, 1.937301660220894e-11, "+1.9373E-11", "%+G",
+__LINE__, 1.939038538587083e-02, "0.0193904", "%g",
+__LINE__, 1.940575489112444e-09, "1.94058E-09", "%G",
+__LINE__, 1.946550455606677e-26, "1.946550E-26", "%#1E",
+__LINE__, 1.954250777559491e-14, "1.95425E-14", "%G",
+__LINE__, 1.955646327688473e-16, "1.956E-16", "%#.3E",
+__LINE__, 1.956999911995683e+20, "2E+20", "%2.G",
+__LINE__, 1.959125254298784e-21, "1.95913E-21", "%#G",
+__LINE__, 1.960330340481290e+26, "1.96033e+26", "%.6g",
+__LINE__, 1.964156478075422e+01, "+19.6416", "%+g",
+__LINE__, 1.964702507676036e+19, "2.0e+19", "%2.1e",
+__LINE__, 1.965762191674409e-30, "2E-30", "%1.G",
+__LINE__, 1.967492699686803e-29, "+1.967493E-29", "%+#E",
+__LINE__, 1.970072604062236e-11, "+1.97007E-11", "%+G",
+__LINE__, 1.975631055550387e+05, "197563.105555", "%.6f",
+__LINE__, 1.975722425389177e+28, "+1.975722e+28", "%+5.6e",
+__LINE__, 1.977938328895365e-05, " 2e-05", "%6.e",
+__LINE__, 1.981950849019640e+13, "1.981951E+13", "%E",
+__LINE__, 1.982543168856985e-26, "1.98254e-26", "%4g",
+__LINE__, 1.984873317384181e-20, "1.98487E-20", "%4G",
+__LINE__, 1.986146420877074e+02, "+1.986146e+02", "%+0e",
+__LINE__, 1.986465942785167e-28, "1.98647e-28", "%g",
+__LINE__, 1.988250323235468e-05, " +0", "%+7.f",
+__LINE__, 1.989966623080645e-09, "1.989967e-09", "%e",
+__LINE__, 1.991243122514519e+11, "199124312251", "%5.f",
+__LINE__, 1.993287894645908e+25, "+1.993288E+25", "%+E",
+__LINE__, 1.995172329888890e-30, "+1.99517e-30", "%+3g",
+__LINE__, 1.997075127236432e+05, "1.997E+05", "%#.4G",
+__LINE__, 2.000651599487290e+04, "2E+04", "%2.E",
+__LINE__, 2.001429412876339e-28, "0.000000", "%6f",
+__LINE__, 2.003535646264196e+03, " 2E+03", "%7.G",
+__LINE__, 2.011751504116246e+06, "2E+06", "%2.G",
+__LINE__, 2.016361237694652e-30, "2.01636e-30", "%4g",
+__LINE__, 2.018266414065554e-08, "0.00", "%2.2f",
+__LINE__, 2.020706780608565e+03, "2E+03", "%.0G",
+__LINE__, 2.025098418552005e-16, "+2.025098E-16", "%+2E",
+__LINE__, 2.026100592518976e-11, "2.026101e-11", "%6e",
+__LINE__, 2.026167291572980e+11, "2.02617E+11", "%G",
+__LINE__, 2.026782170272331e+07, "2.026782E+07", "%E",
+__LINE__, 2.029133469449347e-06, " 2e-06", "%6.g",
+__LINE__, 2.031191570768443e-20, "2.031192E-20", "%2.7G",
+__LINE__, 2.031884221862863e-16, "2.031884e-16", "%e",
+__LINE__, 2.032992924118323e+29, "203299292411832333016263874014.84", "%#0.2f",
+__LINE__, 2.035799610097827e+28, "+20357996100978272835391180706.2104344", "%+3.7f",
+__LINE__, 2.038008183612069e+25, "20380081836120691463065668", "%7.0f",
+__LINE__, 2.041632205119365e-22, "+2.04163e-22", "%+g",
+__LINE__, 2.042769811159352e-10, "2e-10", "%.1g",
+__LINE__, 2.043034975847005e-08, "2.043035e-08", "%e",
+__LINE__, 2.045930666285880e+26, "2.04593e+26", "%g",
+__LINE__, 2.048377276651386e-21, "0.00000", "%2.5f",
+__LINE__, 2.051785787301292e-23, "0.000000", "%f",
+__LINE__, 2.055085792048183e-10, "0.000000", "%f",
+__LINE__, 2.055783028451040e-21, "+0", "%+1.f",
+__LINE__, 2.057641607509489e-17, "+2E-17", "%+2.G",
+__LINE__, 2.058348703001600e-15, "2.05835E-15", "%#G",
+__LINE__, 2.059594758787322e+24, "2.05959E+24", "%1G",
+__LINE__, 2.062710740295018e+01, "20.6271", "%G",
+__LINE__, 2.063240676447750e-11, "0.000000", "%f",
+__LINE__, 2.063799238238917e-09, "+0.000000", "%+f",
+__LINE__, 2.064564135160425e-17, "2.06456E-17", "%G",
+__LINE__, 2.066363476927650e-05, "2.07E-05", "%.3G",
+__LINE__, 2.066871450514214e-02, "+2.066871e-02", "%+e",
+__LINE__, 2.067258256169148e+07, "2.06726e+07", "%g",
+__LINE__, 2.068466590729350e-22, "0.0000", "%.4f",
+__LINE__, 2.068779510112540e-26, "2.06878e-26", "%g",
+__LINE__, 2.069258770387493e+19, "20692587703874929516.700831", "%3f",
+__LINE__, 2.069547778447951e+26, "2.069548e+26", "%6e",
+__LINE__, 2.070479507710941e-23, "2.07048E-23", "%G",
+__LINE__, 2.071809640061785e+22, "2.071810E+22", "%E",
+__LINE__, 2.073364463564950e-06, "2.07336e-06", "%g",
+__LINE__, 2.073478953644888e-10, "+2.07E-10", "%+.3G",
+__LINE__, 2.076039194312519e+12, "2.07604E+12", "%G",
+__LINE__, 2.081490398946229e-07, "+2.08149e-07", "%+g",
+__LINE__, 2.084941170287895e-07, "2.084941E-07", "%7E",
+__LINE__, 2.087035885023382e-18, "+0.000000", "%+f",
+__LINE__, 2.091025884363342e-09, "2.09103E-09", "%G",
+__LINE__, 2.091830555397864e+08, "209183056", "%0.f",
+__LINE__, 2.091998109232084e-22, "0.000000", "%#f",
+__LINE__, 2.093406473464940e-17, "2.09341e-17", "%g",
+__LINE__, 2.094646724039720e-26, "2.094647e-26", "%0.7g",
+__LINE__, 2.095218667083208e-22, "2.09522e-22", "%.5e",
+__LINE__, 2.096932364992728e-27, "2.1E-27", "%.2G",
+__LINE__, 2.097012452732083e+17, "2.09701E+17", "%G",
+__LINE__, 2.102022216908102e-07, "0.000000", "%f",
+__LINE__, 2.104648382618938e-04, "0.00021", "%.3G",
+__LINE__, 2.109159578853690e-19, "2.10916e-19", "%6g",
+__LINE__, 2.111732624641178e-13, "+2.111733E-13", "%+7.7G",
+__LINE__, 2.112676138351330e+21, " 2e+21", "%6.g",
+__LINE__, 2.117332904051741e-09, "+0.000000", "%+f",
+__LINE__, 2.118001353767757e-14, "2.118E-14", "%4.3E",
+__LINE__, 2.119413720893955e+12, "2.119414E+12", "%.7G",
+__LINE__, 2.119610992647014e+07, "+21196109.9265", "%+.4f",
+__LINE__, 2.120504022069221e+25, "21205040220692210617414730.223", "%#.3f",
+__LINE__, 2.120634617123718e-16, "2.120635e-16", "%#e",
+__LINE__, 2.128702437175385e+12, "2128702437175.385", "%.3f",
+__LINE__, 2.131148830213536e-12, "2.131149e-12", "%e",
+__LINE__, 2.132682622145255e+04, "+21326.83", "%+#5.7G",
+__LINE__, 2.133864841676473e-01, " +0.2", "%+6.g",
+__LINE__, 2.133939058496273e+16, "2E+16", "%4.G",
+__LINE__, 2.135087006806302e-24, "0.000000", "%f",
+__LINE__, 2.138983961194584e-20, "+2.138984e-20", "%+7e",
+__LINE__, 2.146534189669224e+17, "+2.147E+17", "%+.4G",
+__LINE__, 2.147375595676503e+09, "2.147376e+09", "%e",
+__LINE__, 2.152994986418075e+02, "2E+02", "%0.E",
+__LINE__, 2.154127135896811e+06, "2.15E+06", "%2.3G",
+__LINE__, 2.154613053892588e-29, "2.1546E-29", "%.4E",
+__LINE__, 2.160830430730653e-12, "2.16083E-12", "%#G",
+__LINE__, 2.161740591663027e+28, "2.161741e+28", "%e",
+__LINE__, 2.167181665934011e-06, "2e-06", "%1.e",
+__LINE__, 2.167348761729060e-04, "2.167349e-04", "%#e",
+__LINE__, 2.170270852816708e-10, "2.17027E-10", "%0G",
+__LINE__, 2.173048229189370e-06, "2.173e-06", "%.5g",
+__LINE__, 2.175554537855024e+10, "2.17555E+10", "%G",
+__LINE__, 2.177447372527968e-30, "+0.000000", "%+.6f",
+__LINE__, 2.178591661569858e+05, "2.1786e+05", "%1.5g",
+__LINE__, 2.184700207174818e-29, "0.000000", "%f",
+__LINE__, 2.190817031437247e+03, "2.E+03", "%#3.0E",
+__LINE__, 2.191396212145558e-01, "2.191E-01", "%6.3E",
+__LINE__, 2.191786353372880e-23, "2.19179e-23", "%.5e",
+__LINE__, 2.193471126151079e+19, "2.1935E+19", "%.4E",
+__LINE__, 2.194750177630526e-15, "2.194750e-15", "%e",
+__LINE__, 2.196145170358973e+05, "+219615", "%+g",
+__LINE__, 2.199602360934320e-09, "2.19960E-09", "%#6.6G",
+__LINE__, 2.202913988776998e+17, "+2.20291e+17", "%+g",
+__LINE__, 2.207094560707703e-10, "2.207095e-10", "%e",
+__LINE__, 2.207557214621658e-13, " 0", "%4.f",
+__LINE__, 2.209428206272229e+13, "2.20943e+13", "%g",
+__LINE__, 2.212662463615175e-11, " 0", "%4.0f",
+__LINE__, 2.215732710968468e-30, "2E-30", "%.1G",
+__LINE__, 2.218490841936778e-10, "2.21849e-10", "%2g",
+__LINE__, 2.218850610567959e-01, "+0.221885", "%+G",
+__LINE__, 2.220796939261542e-03, "0.002221", "%#f",
+__LINE__, 2.221819894808024e+24, "2.2e+24", "%5.1e",
+__LINE__, 2.223804993235507e+27, "2.223805e+27", "%1e",
+__LINE__, 2.224715386046563e-17, "0.00000", "%#.5f",
+__LINE__, 2.224864709983882e-16, "+2.224865e-16", "%+e",
+__LINE__, 2.225764510969505e+16, "2.E+16", "%#4.G",
+__LINE__, 2.233229189161284e-07, "+2.23323e-07", "%+6g",
+__LINE__, 2.236522807209868e+17, "2.23652e+17", "%g",
+__LINE__, 2.236641620849775e+20, "2E+20", "%0.G",
+__LINE__, 2.237089952728626e-13, "2E-13", "%5.E",
+__LINE__, 2.238531255563381e-11, " 2E-11", "%7.1G",
+__LINE__, 2.242782296436871e+12, "2242782296436.871103", "%f",
+__LINE__, 2.249177852069393e-02, "+2.249178E-02", "%+5E",
+__LINE__, 2.250735782732076e+29, "+2.25074e+29", "%+g",
+__LINE__, 2.257455203557544e-11, "+2e-11", "%+4.0g",
+__LINE__, 2.258002527939529e+24, "2.258e+24", "%g",
+__LINE__, 2.266955929448160e+20, "226695592944815960123.6056915", "%.7f",
+__LINE__, 2.269019719123250e-23, "0.000000", "%f",
+__LINE__, 2.269022332502809e+02, "+226.902233", "%+f",
+__LINE__, 2.271165222038591e-03, "0.002", "%1.1g",
+__LINE__, 2.273965946408021e+14, "+227396594640802.085507", "%+f",
+__LINE__, 2.277221153386242e+22, "22772211533862418697538.032575", "%#f",
+__LINE__, 2.280214920187521e-01, "0.2", "%2.G",
+__LINE__, 2.280762993019740e+06, "2.28076E+06", "%G",
+__LINE__, 2.283479263040833e-24, "+0.000000", "%+f",
+__LINE__, 2.283686319235123e-07, "2.2837E-07", "%5.5G",
+__LINE__, 2.285842617231066e-26, "0.000000", "%f",
+__LINE__, 2.293145864755873e-02, "0.02", "%.0g",
+__LINE__, 2.293439381531532e+03, "+2.293439E+03", "%+#1E",
+__LINE__, 2.297972500660698e-22, "2.29797e-22", "%g",
+__LINE__, 2.298725366073681e+23, "2.29873E+23", "%G",
+__LINE__, 2.303151535483950e-29, "2.30315E-29", "%G",
+__LINE__, 2.308565313657699e-25, " 0", "%4.f",
+__LINE__, 2.309305373760733e-07, "2.309305E-07", "%E",
+__LINE__, 2.309693761334710e-19, "2.30969e-19", "%g",
+__LINE__, 2.312218220995774e-20, "+2.31222E-20", "%+.6G",
+__LINE__, 2.313115729670525e+24, "2.31312E+24", "%G",
+__LINE__, 2.315325159866773e-21, "2.315325E-21", "%E",
+__LINE__, 2.316932917620091e-19, "0.000000", "%f",
+__LINE__, 2.317548394633895e+13, "2.31755E+13", "%0G",
+__LINE__, 2.318951465093612e+02, "+2.32e+02", "%+1.2e",
+__LINE__, 2.319151794905482e-17, "+0.000000", "%+0f",
+__LINE__, 2.319708617851078e-27, "0.000000", "%f",
+__LINE__, 2.320019976591725e+20, "2e+20", "%.1g",
+__LINE__, 2.322859962551666e+06, "2.32286e+06", "%g",
+__LINE__, 2.326474568074649e-29, "2.326e-29", "%.4g",
+__LINE__, 2.328400844172053e-07, "2.3284E-07", "%G",
+__LINE__, 2.333695247698112e+16, "2.3337e+16", "%g",
+__LINE__, 2.333717120257130e-19, "+0.000000", "%+f",
+__LINE__, 2.334711793234782e-19, "2.33471E-19", "%5G",
+__LINE__, 2.335524987281242e+02, "+233.55", "%+7.5g",
+__LINE__, 2.335556767836369e-30, "2.34e-30", "%.3g",
+__LINE__, 2.337696964360052e-10, "2.3377e-10", "%1g",
+__LINE__, 2.337858249184500e-14, "2.337858E-14", "%5.6E",
+__LINE__, 2.339984354781169e-14, "2.339984E-14", "%E",
+__LINE__, 2.340849041430089e-04, "0.00023", "%0.2G",
+__LINE__, 2.342388410373363e-24, "2.34239E-24", "%G",
+__LINE__, 2.343933106737237e-22, "2.34393e-22", "%g",
+__LINE__, 2.344870855713960e-08, "0.000000", "%.6f",
+__LINE__, 2.347368965433808e+24, "2347368965433808352116785", "%4.f",
+__LINE__, 2.349417462171421e-02, "+0.0234942", "%+G",
+__LINE__, 2.351071111431207e+11, "235107111143.12", "%.2f",
+__LINE__, 2.352756222810670e+19, "+2.e+19", "%+#4.g",
+__LINE__, 2.355862529217003e-22, "2.355863e-22", "%#4e",
+__LINE__, 2.356804045401445e-30, "2.3568E-30", "%G",
+__LINE__, 2.362100710185559e-26, "2.3621e-26", "%g",
+__LINE__, 2.368330779173562e-12, " 0", "%4.f",
+__LINE__, 2.383329784369796e+22, "2.38333E+22", "%G",
+__LINE__, 2.386845229536477e+01, "+23.868452", "%+#f",
+__LINE__, 2.388207830036780e-05, "0.000024", "%f",
+__LINE__, 2.391809468802907e+21, "+2.391809e+21", "%+e",
+__LINE__, 2.395172908564692e-09, "+0.000000", "%+f",
+__LINE__, 2.395447167030886e-29, "2.39545e-29", "%g",
+__LINE__, 2.397292973389182e+16, "23972929733891823", "%6.f",
+__LINE__, 2.401749832237687e-30, "2.401750E-30", "%E",
+__LINE__, 2.403610502544347e-03, "0.00240361", "%4G",
+__LINE__, 2.404676421776132e+17, "240467642177613206", "%6.f",
+__LINE__, 2.406327689091479e+25, "2.406328e+25", "%e",
+__LINE__, 2.407341999590511e-02, "0.024073", "%f",
+__LINE__, 2.407352797581004e+05, "240735.", "%#g",
+__LINE__, 2.407903467439017e+13, "2.4079E+13", "%G",
+__LINE__, 2.407979635013539e+21, " +2E+21", "%+7.G",
+__LINE__, 2.409513517930790e+29, "240951351793079027174826478585.600853", "%f",
+__LINE__, 2.412530651221551e+10, "+2.41253E+10", "%+G",
+__LINE__, 2.419943224673811e+00, "2.41994", "%#g",
+__LINE__, 2.422474399040258e-15, "0.000000", "%f",
+__LINE__, 2.426060206689458e+18, "2.42606E+18", "%1G",
+__LINE__, 2.439982659679872e+14, "+2.439983E+14", "%+E",
+__LINE__, 2.440528851375447e+13, "24405288513754.466173", "%f",
+__LINE__, 2.441340473292679e+19, "2.44134E+19", "%G",
+__LINE__, 2.443521636943916e+19, " 2.e+19", "%#7.g",
+__LINE__, 2.445925211597624e-27, "2.445925E-27", "%E",
+__LINE__, 2.446966179060722e+25, "2.446966e+25", "%5e",
+__LINE__, 2.447714218717278e+11, "2e+11", "%1.e",
+__LINE__, 2.448339744613286e+06, "2.4483e+06", "%3.5g",
+__LINE__, 2.448772993496189e+03, "2448.77", "%G",
+__LINE__, 2.448857654325229e+22, "+2.44886e+22", "%+g",
+__LINE__, 2.450082452098890e-27, "2.4501E-27", "%#3.5G",
+__LINE__, 2.451293602221637e+05, "245129.360222", "%f",
+__LINE__, 2.454531490229426e+02, "245.453", "%G",
+__LINE__, 2.458958369944980e+14, "2.5E+14", "%6.1E",
+__LINE__, 2.463666680775038e+14, "+246366668077503.80", "%+#.2f",
+__LINE__, 2.471582990960795e+05, "2.471583e+05", "%e",
+__LINE__, 2.474107179274687e+22, "2.47411e+22", "%g",
+__LINE__, 2.474332114849132e-08, "+2.47433e-08", "%+g",
+__LINE__, 2.476956762431716e+18, "+2476956762431715919.348107", "%+#f",
+__LINE__, 2.479091221850607e-22, "0.000000", "%f",
+__LINE__, 2.479819586598431e-24, "2.47982e-24", "%g",
+__LINE__, 2.480006174601455e-05, "2.48001E-05", "%G",
+__LINE__, 2.482672677638334e-26, "+0.000000", "%+f",
+__LINE__, 2.492816492208918e-14, " 0", "%7.f",
+__LINE__, 2.492964173197140e-12, " 2e-12", "%7.g",
+__LINE__, 2.494646635961173e+02, "249.465", "%g",
+__LINE__, 2.494687818780545e+11, "249468781878.054546", "%#7f",
+__LINE__, 2.510083560147301e-13, "+2.510084e-13", "%+#e",
+__LINE__, 2.511186607989480e-30, "2.51E-30", "%.3G",
+__LINE__, 2.514164516133643e-11, "2.51416e-11", "%g",
+__LINE__, 2.517242520804735e+11, "2.517243e+11", "%e",
+__LINE__, 2.518526126400833e-26, "2.51853e-26", "%g",
+__LINE__, 2.520313416401176e+09, "2520313416.401176", "%5f",
+__LINE__, 2.521653160738683e-29, "2.52165e-29", "%#g",
+__LINE__, 2.521941342615338e-16, "2.52194e-16", "%g",
+__LINE__, 2.523554774354461e-03, "+3E-03", "%+.0E",
+__LINE__, 2.525434130825058e+06, "+2.525434E+06", "%+E",
+__LINE__, 2.527616380113364e+02, "2.527616E+02", "%E",
+__LINE__, 2.531871347913505e+09, "+2.53187E+09", "%+#G",
+__LINE__, 2.532167428661069e+06, "2532167.428661", "%f",
+__LINE__, 2.545585718405995e+14, "+2.54559E+14", "%+G",
+__LINE__, 2.546305097286406e+10, "2.546305e+10", "%e",
+__LINE__, 2.547467156069069e-30, "+0.00", "%+3.2f",
+__LINE__, 2.548728793004506e-14, "2.54873E-14", "%G",
+__LINE__, 2.560375602395090e+11, "256037560239.509032", "%0f",
+__LINE__, 2.560555687476687e+03, "2561", "%.4g",
+__LINE__, 2.561709077363443e-24, "+0.000000", "%+f",
+__LINE__, 2.563763849675242e+10, "2.5637638E+10", "%.7E",
+__LINE__, 2.567482414574355e+11, "+2.567482e+11", "%+e",
+__LINE__, 2.571575046303674e-17, "3E-17", "%2.0E",
+__LINE__, 2.572997971296986e+11, "257299797129.698593", "%f",
+__LINE__, 2.578625935900331e+22, "25786259359003311786295.853381", "%f",
+__LINE__, 2.579663282966370e+12, "2.579663e+12", "%e",
+__LINE__, 2.593141782397610e-08, "0.000000", "%f",
+__LINE__, 2.594386109584196e+04, "3.E+04", "%#6.0E",
+__LINE__, 2.598069318007816e-22, "2.59807e-22", "%g",
+__LINE__, 2.600910462290091e+09, "2.600910E+09", "%6E",
+__LINE__, 2.602580183614458e-03, "2.602580e-03", "%e",
+__LINE__, 2.606540360440264e+09, "+2606540360.4", "%+#0.1f",
+__LINE__, 2.610016419698116e-21, "+3.e-21", "%+#3.g",
+__LINE__, 2.612279323574882e-20, "2.61228E-20", "%G",
+__LINE__, 2.614157324336453e-14, "2.61416e-14", "%g",
+__LINE__, 2.614688721873993e-09, "2.61e-09", "%6.2e",
+__LINE__, 2.616661104472416e-15, " 0", "%5.f",
+__LINE__, 2.616742079283195e-09, " +3E-09", "%+7.E",
+__LINE__, 2.618075304717427e+24, "2.618075e+24", "%e",
+__LINE__, 2.624118573335769e+26, "262411857333576925555007619.550452", "%1f",
+__LINE__, 2.625718894274227e+24, "+2625718894274227110940955.753904", "%+f",
+__LINE__, 2.627081999477812e+03, "2627.081999", "%f",
+__LINE__, 2.631061062224705e+14, "263106106222470.481626", "%f",
+__LINE__, 2.631545877128814e+27, "+2.63155e+27", "%+g",
+__LINE__, 2.632694395848818e-11, "2.63269e-11", "%g",
+__LINE__, 2.636728891022008e-22, "+2.63673e-22", "%+#4g",
+__LINE__, 2.638495675008130e-28, "+2.638496e-28", "%+e",
+__LINE__, 2.639704195859799e-11, "0.", "%#.0f",
+__LINE__, 2.641645264652665e-20, "0", "%0.f",
+__LINE__, 2.642012075064497e-20, "3E-20", "%0.E",
+__LINE__, 2.648725869006487e-29, " 3E-29", "%6.G",
+__LINE__, 2.649060724417770e+12, "3E+12", "%3.G",
+__LINE__, 2.651188545120166e-17, "0.000", "%.3f",
+__LINE__, 2.652302152621621e+14, "2.7E+14", "%.2G",
+__LINE__, 2.653309718412604e-28, "0.000000", "%f",
+__LINE__, 2.658344750491858e-21, " 3e-21", "%6.g",
+__LINE__, 2.664625074612594e+15, "3e+15", "%1.g",
+__LINE__, 2.666953728270800e-15, "3e-15", "%0.e",
+__LINE__, 2.674515419678877e-11, " 3E-11", "%6.E",
+__LINE__, 2.680054917256578e+15, "2680054917256577.5", "%#2.1f",
+__LINE__, 2.680495609883415e-11, "2.68E-11", "%#.3G",
+__LINE__, 2.685757893641070e+23, "268575789364107020418259.70809", "%1.5f",
+__LINE__, 2.695551226058178e+16, "26955512260581775.407786", "%f",
+__LINE__, 2.696346377519671e+04, "+26963.5", "%+G",
+__LINE__, 2.714262310601257e+17, "+2.714262E+17", "%+E",
+__LINE__, 2.719227450016317e-01, "0.271923", "%G",
+__LINE__, 2.724135433346056e-30, "+2.72414e-30", "%+g",
+__LINE__, 2.725143224130276e+14, "272514322413027.576530", "%6f",
+__LINE__, 2.729355189648310e-03, "+0.00273", "%+.5f",
+__LINE__, 2.732872167724945e+11, "2.73287E+11", "%G",
+__LINE__, 2.737709476435412e+17, "273770947643541218.141650", "%f",
+__LINE__, 2.739299356074967e-15, "2.7E-15", "%.2G",
+__LINE__, 2.740793612304798e-27, "2.740794E-27", "%.7G",
+__LINE__, 2.742030156175960e+20, "2.74203e+20", "%2.6g",
+__LINE__, 2.744455324096085e+11, "2.74446E+11", "%G",
+__LINE__, 2.745179546531160e+07, "2.7452E+07", "%.5G",
+__LINE__, 2.747470562525333e+04, "3E+04", "%2.E",
+__LINE__, 2.750243314674629e+21, "2.75024E+21", "%#G",
+__LINE__, 2.750250224436030e+20, "+2.750250e+20", "%+0.6e",
+__LINE__, 2.752712858561084e-22, "2.752713e-22", "%e",
+__LINE__, 2.756982987656667e-03, "0.002756983", "%#.7G",
+__LINE__, 2.761841188479590e+13, "3e+13", "%1.g",
+__LINE__, 2.769498440434419e+00, "+3e+00", "%+0.e",
+__LINE__, 2.769993785786379e+10, "27699937857.863794", "%f",
+__LINE__, 2.772900256376753e-06, "+2.7729E-06", "%+7.6G",
+__LINE__, 2.774401482467457e-06, "2.8e-06", "%3.2g",
+__LINE__, 2.777691370374757e-02, "+0.027777", "%+f",
+__LINE__, 2.779836227365899e-09, "3e-09", "%5.0g",
+__LINE__, 2.780481651765741e+01, "2.780482E+01", "%E",
+__LINE__, 2.782228478714809e-26, "2.782228E-26", "%4.7G",
+__LINE__, 2.790457781719376e+13, "+2.8e+13", "%+.2g",
+__LINE__, 2.792026581166417e-30, " 3.e-30", "%#7.0g",
+__LINE__, 2.792396278299615e-08, "0.00", "%#.2f",
+__LINE__, 2.793658047689995e-10, "2.794e-10", "%#0.4g",
+__LINE__, 2.795707358229888e-25, "0.000000", "%f",
+__LINE__, 2.796253091758523e-06, "2.796E-06", "%.4G",
+__LINE__, 2.796756564788716e-24, "2.796757e-24", "%e",
+__LINE__, 2.798730444798773e-14, "2.79873e-14", "%g",
+__LINE__, 2.799108397670447e-24, "3E-24", "%.0G",
+__LINE__, 2.799389008872835e+06, "2799389.", "%#0.f",
+__LINE__, 2.800413998518039e-14, "0.000000", "%f",
+__LINE__, 2.803237602587100e+15, "+2803237602587100.418816", "%+5f",
+__LINE__, 2.803474415574551e-04, "0.0002803", "%.7f",
+__LINE__, 2.804957468647181e+25, "2.80496e+25", "%g",
+__LINE__, 2.809345112788226e+09, "2809345112.788226", "%.6f",
+__LINE__, 2.811518239408899e+10, "3e+10", "%1.g",
+__LINE__, 2.813188439967416e-16, "0.0000000", "%5.7f",
+__LINE__, 2.813497118051755e+08, "2.8135e+08", "%.5g",
+__LINE__, 2.815748256510577e-29, "0.000000", "%2f",
+__LINE__, 2.816076365485207e-01, "0.281608", "%0G",
+__LINE__, 2.816083345772131e+24, "2.8161e+24", "%6.4e",
+__LINE__, 2.818686957605178e+12, "2.8187E+12", "%.5G",
+__LINE__, 2.821903538737691e+20, "2.8219E+20", "%G",
+__LINE__, 2.823659589845680e+26, "2.82366e+26", "%2g",
+__LINE__, 2.823685630865012e+22, "2.82369E+22", "%G",
+__LINE__, 2.828826386007914e+21, "2.828826E+21", "%7E",
+__LINE__, 2.830997901034349e+04, "+3e+04", "%+0.e",
+__LINE__, 2.833886731091353e-26, "+2.833887e-26", "%+4e",
+__LINE__, 2.839965144893913e+28, "28399651448939131626048038015.1421", "%.4f",
+__LINE__, 2.840651452049947e-09, "2.841E-09", "%#.3E",
+__LINE__, 2.843388001911757e-01, "0.284339", "%g",
+__LINE__, 2.846122151080671e+14, "2.84612E+14", "%.5E",
+__LINE__, 2.851257828837595e+05, "+285126", "%+5.f",
+__LINE__, 2.853823884459520e+07, "+2.85382E+07", "%+G",
+__LINE__, 2.853870068368765e-06, "2.854E-06", "%4.3E",
+__LINE__, 2.856687358149867e+01, "+28.567", "%+6.5G",
+__LINE__, 2.858946600073752e+06, "2.8589466e+06", "%3.7e",
+__LINE__, 2.861525727138818e+24, "2.8615257e+24", "%2.7e",
+__LINE__, 2.865104175886071e-24, "0.000000", "%f",
+__LINE__, 2.870678920363198e-14, "2.87068E-14", "%G",
+__LINE__, 2.873298537233691e+09, "+2.8733e+09", "%+g",
+__LINE__, 2.877939609444375e-02, "0.028779", "%f",
+__LINE__, 2.878253985341728e+13, "2.87825E+13", "%G",
+__LINE__, 2.879299244903946e+29, "287929924490394597569320467301", "%0.f",
+__LINE__, 2.885516225515485e-26, "0.000000", "%f",
+__LINE__, 2.886013724129579e+20, "+3e+20", "%+4.g",
+__LINE__, 2.887032786975506e-30, "0.000000", "%f",
+__LINE__, 2.890415456531026e-29, "2.89042E-29", "%G",
+__LINE__, 2.893177360548214e-13, "2.893E-13", "%#6.3E",
+__LINE__, 2.895265536458195e+26, "2.89527e+26", "%5g",
+__LINE__, 2.903844533810152e+23, "290384453381015195105874.23", "%.2f",
+__LINE__, 2.909060558287504e+27, "2.90906e+27", "%g",
+__LINE__, 2.911615480973172e-05, "2.91162E-05", "%3G",
+__LINE__, 2.912692297221896e+09, "2912692297.221896", "%#f",
+__LINE__, 2.913595662485813e-24, "2.9136E-24", "%G",
+__LINE__, 2.915960840341896e-27, "0.000000", "%f",
+__LINE__, 2.920451095973991e-16, "2.92e-16", "%2.2e",
+__LINE__, 2.920528295810925e+06, "2.92053E+06", "%#G",
+__LINE__, 2.921564671017147e+20, "2.921565E+20", "%#6E",
+__LINE__, 2.921628350942189e+01, "2.921628E+01", "%E",
+__LINE__, 2.921843377455232e+20, "2.921843E+20", "%#E",
+__LINE__, 2.930156950319384e+29, "2.930E+29", "%1.3E",
+__LINE__, 2.931229858895071e-30, "2.9e-30", "%4.2g",
+__LINE__, 2.931753029689166e+20, "2.93175e+20", "%g",
+__LINE__, 2.933023693079342e+15, "3.E+15", "%#.1G",
+__LINE__, 2.933078733225520e+26, "2.93308E+26", "%G",
+__LINE__, 2.933528170896643e-14, "+2.93353e-14", "%+g",
+__LINE__, 2.938648437428148e+00, "2.938648e+00", "%e",
+__LINE__, 2.940752238221344e+26, "+2.94075E+26", "%+G",
+__LINE__, 2.942836470459675e+20, "2.9428e+20", "%6.4e",
+__LINE__, 2.943218333254941e+29, "294321833325494086608387078740.634024", "%f",
+__LINE__, 2.943690574007512e-27, "0.000000", "%f",
+__LINE__, 2.945452907046501e+09, "+2.9455E+09", "%+.5G",
+__LINE__, 2.946648725966953e+16, "29466487259669534.637396", "%4f",
+__LINE__, 2.955119322417825e+29, "2.95512E+29", "%G",
+__LINE__, 2.966481197538973e+24, "2.96648e+24", "%#g",
+__LINE__, 2.969362862661362e+08, "+2.969363e+08", "%+7e",
+__LINE__, 2.970062459990078e+21, "+2.97006E+21", "%+G",
+__LINE__, 2.971059959019791e+10, " 3E+10", "%7.G",
+__LINE__, 2.973020205606034e-29, "0.000000", "%f",
+__LINE__, 2.977223210301426e+04, "2.977223e+04", "%#e",
+__LINE__, 2.977467832772786e-26, "0.000000", "%f",
+__LINE__, 2.981433606423384e+18, "2981433606423384397.032805", "%f",
+__LINE__, 2.981615513287404e-17, "2.98162e-17", "%g",
+__LINE__, 2.983880743847276e+19, " 3e+19", "%7.e",
+__LINE__, 2.983927792297305e-28, "2.983928e-28", "%e",
+__LINE__, 2.984807359492058e-17, " 0", "%2.f",
+__LINE__, 2.985123412933032e+09, "+2.98512e+09", "%+g",
+__LINE__, 2.991132955408629e-27, "+2.99113e-27", "%+4g",
+__LINE__, 2.992345635923643e+19, "3E+19", "%4.G",
+__LINE__, 2.993024238285395e-05, "2.99302e-05", "%2g",
+__LINE__, 2.995303406756363e+16, "+2.995303E+16", "%+E",
+__LINE__, 2.995492577854335e+19, "+29954925778543346481.797016", "%+f",
+__LINE__, 2.996856271675341e-25, "+3e-25", "%+0.e",
+__LINE__, 2.997813968112619e+12, "2.99781e+12", "%#5g",
+__LINE__, 3.002097486457961e-17, "3.00210e-17", "%5.5e",
+__LINE__, 3.006538123158692e+28, "+3.00654E+28", "%+#G",
+__LINE__, 3.007293721729544e+04, "30072.937217", "%f",
+__LINE__, 3.008301791944493e-07, "3.008e-07", "%.3e",
+__LINE__, 3.011742184603817e-17, "3.011742E-17", "%#E",
+__LINE__, 3.024641547299177e-30, "3.02464e-30", "%g",
+__LINE__, 3.026525135110198e-28, "3e-28", "%.0e",
+__LINE__, 3.026768160756558e+20, "3.02677E+20", "%G",
+__LINE__, 3.031928829940975e+18, "3031928829940975234.1", "%0.1f",
+__LINE__, 3.039787705138620e+24, "+3.E+24", "%+#5.G",
+__LINE__, 3.039803824423916e-02, "0.030398", "%5f",
+__LINE__, 3.041236293199133e-26, "3.04124e-26", "%g",
+__LINE__, 3.045634954037886e+04, "30456.3", "%g",
+__LINE__, 3.047528114241850e+25, "3e+25", "%0.e",
+__LINE__, 3.047958193737501e-24, "3.04796E-24", "%#G",
+__LINE__, 3.049537324414302e-16, "3.04954E-16", "%G",
+__LINE__, 3.050500637681798e-30, "3.0505E-30", "%G",
+__LINE__, 3.051769626625307e-01, "0.305177", "%f",
+__LINE__, 3.057280201971847e+11, "+3.05728E+11", "%+.5E",
+__LINE__, 3.060046173306881e-10, "+3.060046e-10", "%+e",
+__LINE__, 3.069732667347204e+27, "+3069732667347204291274920251.453295", "%+f",
+__LINE__, 3.075060836786916e-14, "0.000000", "%f",
+__LINE__, 3.078175179670964e+13, "3.07818E+13", "%G",
+__LINE__, 3.080305344303183e-21, "3.08031e-21", "%6g",
+__LINE__, 3.088881497064043e+27, "+3.088881E+27", "%+3E",
+__LINE__, 3.089196877931209e-20, "3.089197e-20", "%e",
+__LINE__, 3.091400888880487e-08, "3e-08", "%2.e",
+__LINE__, 3.093410684178904e+16, "3.09341e+16", "%g",
+__LINE__, 3.104225344208216e-21, "0.000000", "%f",
+__LINE__, 3.105843728248599e+13, "3.e+13", "%#.0g",
+__LINE__, 3.106463071390893e-07, "0.0000", "%.4f",
+__LINE__, 3.107784123569379e+02, "+310.778", "%+G",
+__LINE__, 3.110605148983672e-20, "3.1106051E-20", "%.7E",
+__LINE__, 3.111702418162670e-04, "0.00031117", "%.5G",
+__LINE__, 3.117610675303153e-17, "3.11761e-17", "%g",
+__LINE__, 3.123620125717981e+07, "3.1236e+07", "%2.5g",
+__LINE__, 3.125648558809832e-24, "+3.125649E-24", "%+#0.6E",
+__LINE__, 3.129025163659283e+10, "31290251636.592825", "%#f",
+__LINE__, 3.130689119412709e-29, "+3.131E-29", "%+#.4G",
+__LINE__, 3.135681222132527e+13, "3.13568E+13", "%G",
+__LINE__, 3.138290485073330e-10, "3.13829E-10", "%G",
+__LINE__, 3.141255250155306e-12, "3.14126E-12", "%G",
+__LINE__, 3.143224520918429e+25, "3.14322E+25", "%#1G",
+__LINE__, 3.144746921366173e-16, " 0", "%7.f",
+__LINE__, 3.151336678241994e+19, "+3.15134E+19", "%+G",
+__LINE__, 3.161752935716549e+24, "3.2E+24", "%2.1E",
+__LINE__, 3.167106521258172e-10, "+3.167107e-10", "%+e",
+__LINE__, 3.167266522824146e-04, "3E-04", "%3.E",
+__LINE__, 3.169995217131489e+27, "3169995217131488907114089670.358226", "%f",
+__LINE__, 3.172117220467692e-21, "3.1721E-21", "%.5G",
+__LINE__, 3.173824170351611e+02, " 3e+02", "%6.e",
+__LINE__, 3.186291452544739e-28, " 0", "%2.f",
+__LINE__, 3.194750094186063e+03, "+3.194750E+03", "%+E",
+__LINE__, 3.195001037118137e-20, "0", "%0.0f",
+__LINE__, 3.199271564719560e+02, "319.927", "%g",
+__LINE__, 3.212803450638544e+20, "3.2128e+20", "%.6g",
+__LINE__, 3.214502877263883e+24, "3214502877263882840708220", "%2.f",
+__LINE__, 3.214658414074286e-01, "+0.321466", "%+#g",
+__LINE__, 3.217627975823673e+00, "3.217628", "%f",
+__LINE__, 3.218257328710536e-07, "3.21826e-07", "%6.5e",
+__LINE__, 3.221949479347008e+02, "322.194948", "%f",
+__LINE__, 3.222862935507443e-14, "3.222863E-14", "%E",
+__LINE__, 3.223750247261608e+19, "3.22375e+19", "%g",
+__LINE__, 3.236030335782375e+05, "3.236030e+05", "%e",
+__LINE__, 3.241078803072735e+19, "3.24108e+19", "%g",
+__LINE__, 3.248069569167045e-06, "0.000003", "%#f",
+__LINE__, 3.248148973717269e-15, "3.24815E-15", "%G",
+__LINE__, 3.251150704311790e+25, "+3.25115e+25", "%+5g",
+__LINE__, 3.254498593372140e+15, "+3.2545e+15", "%+g",
+__LINE__, 3.254949399612861e-13, "+3.255E-13", "%+7.3E",
+__LINE__, 3.255490928554106e-17, "3.255491e-17", "%e",
+__LINE__, 3.262333894422112e+17, "326233389442211185.738074", "%0f",
+__LINE__, 3.263923577545217e-24, "0.0000000", "%.7f",
+__LINE__, 3.267125289609703e+23, "3.26713e+23", "%#.5e",
+__LINE__, 3.267906049108331e+27, "3.267906E+27", "%6E",
+__LINE__, 3.269885039157328e+14, "326988503915732.797722", "%f",
+__LINE__, 3.296011393609953e-27, " 3E-27", "%7.E",
+__LINE__, 3.296452164568996e+29, "3.296452E+29", "%E",
+__LINE__, 3.296544736555325e+10, "+3.29654E+10", "%+.6G",
+__LINE__, 3.301861835798572e+03, "3301.862", "%4.7g",
+__LINE__, 3.311292283423002e+21, " 3E+21", "%6.G",
+__LINE__, 3.314868440076262e-10, "3.3149E-10", "%.5G",
+__LINE__, 3.318057982247451e-13, "3.3181e-13", "%0.5g",
+__LINE__, 3.318139218410071e-22, "0.000000", "%f",
+__LINE__, 3.326769904839351e-11, "+3.3268e-11", "%+0.4e",
+__LINE__, 3.327483659787219e+27, "+3.32748e+27", "%+g",
+__LINE__, 3.332666889640198e+17, "333266688964019763.830038", "%f",
+__LINE__, 3.333807449377253e+10, "+3.33e+10", "%+.3g",
+__LINE__, 3.334572302792625e-09, "3.334572E-09", "%E",
+__LINE__, 3.337567126586765e-17, "0.0000000", "%#3.7f",
+__LINE__, 3.340512607683786e-04, "+3E-04", "%+1.E",
+__LINE__, 3.344911557516870e+04, "33449.1", "%G",
+__LINE__, 3.346464302017296e+26, "+3.E+26", "%+#3.G",
+__LINE__, 3.348503166628953e+00, "+3.348503e+00", "%+e",
+__LINE__, 3.350025157778138e-19, "3.35003e-19", "%6g",
+__LINE__, 3.352826233035342e+11, "335282623303.534200", "%7f",
+__LINE__, 3.357174089765502e+10, "3.35717E+10", "%G",
+__LINE__, 3.369253166475501e+03, "+3369.25", "%+G",
+__LINE__, 3.371385975046735e+02, "337.", "%#.0f",
+__LINE__, 3.372532650462104e-04, "+0.000", "%+.3f",
+__LINE__, 3.376498162710442e-26, "3.376498e-26", "%e",
+__LINE__, 3.383510307689135e-12, " 3e-12", "%7.0e",
+__LINE__, 3.388427914080631e-04, "0.0003", "%2.4f",
+__LINE__, 3.390757423408097e+29, "3.3908E+29", "%.4E",
+__LINE__, 3.393963140962879e-11, "3.39396e-11", "%g",
+__LINE__, 3.399245742994444e+24, "3.399246E+24", "%E",
+__LINE__, 3.417690405546708e-26, "0.00000", "%4.5f",
+__LINE__, 3.421159360472045e-30, "3.42116E-30", "%G",
+__LINE__, 3.421973947898887e-06, "3.42197E-06", "%4G",
+__LINE__, 3.425949002482817e-10, "+3.42595E-10", "%+G",
+__LINE__, 3.428355150377972e+08, "3.42836E+08", "%G",
+__LINE__, 3.445035158951526e+15, "3445035158951526.454985", "%f",
+__LINE__, 3.447363996077534e+28, "+3e+28", "%+2.e",
+__LINE__, 3.451571062654907e-03, "0.00345157", "%G",
+__LINE__, 3.452787236877688e+09, "3.45279e+09", "%g",
+__LINE__, 3.454114826574939e-22, "3.e-22", "%#3.e",
+__LINE__, 3.455241965974631e-03, "0.003455", "%#f",
+__LINE__, 3.456190496554365e-18, "3.E-18", "%#5.E",
+__LINE__, 3.456804565717233e-19, "+0.000", "%+2.3f",
+__LINE__, 3.457077651539715e-28, "3.457078E-28", "%E",
+__LINE__, 3.472025705376229e+22, "3.472e+22", "%7.4g",
+__LINE__, 3.473308270919079e+03, "3.473308e+03", "%e",
+__LINE__, 3.474468013243007e-30, "3.47447e-30", "%g",
+__LINE__, 3.477976957097698e+22, "3.47798e+22", "%g",
+__LINE__, 3.501174631980057e-06, "4e-06", "%4.g",
+__LINE__, 3.501808481702140e+20, "3.50181E+20", "%G",
+__LINE__, 3.511760000705324e+14, "351176000070532.357000", "%f",
+__LINE__, 3.511870226306087e+29, "3.51187e+29", "%.5e",
+__LINE__, 3.518846859147841e+02, "+351.885", "%+G",
+__LINE__, 3.521659149753418e+25, "35216591497534182053641416", "%5.f",
+__LINE__, 3.521721228178747e+21, "4e+21", "%2.e",
+__LINE__, 3.526696007281458e+22, "3.5267e+22", "%g",
+__LINE__, 3.535631031379084e-11, "4e-11", "%5.0g",
+__LINE__, 3.537219665456759e-01, "0.353722", "%f",
+__LINE__, 3.537252728287785e-09, "3.537253E-09", "%E",
+__LINE__, 3.542561277796815e-19, "3.542561E-19", "%E",
+__LINE__, 3.548942336915745e+13, "3.54894E+13", "%.5E",
+__LINE__, 3.574385715121768e-24, "3.57439E-24", "%#G",
+__LINE__, 3.578068067760211e-13, "3.578068E-13", "%E",
+__LINE__, 3.583296432862266e-13, "3.5833e-13", "%g",
+__LINE__, 3.591567367115590e+19, "3.59157e+19", "%1g",
+__LINE__, 3.594902312287635e-24, "3.5949E-24", "%G",
+__LINE__, 3.602929486764515e+12, "3602929486764.514522", "%#f",
+__LINE__, 3.606699462631472e-01, "+0.360670", "%+f",
+__LINE__, 3.608605968319811e+17, "3.60861e+17", "%g",
+__LINE__, 3.608780761567885e+24, "4e+24", "%0.e",
+__LINE__, 3.623857274715022e-15, "3.62386E-15", "%1G",
+__LINE__, 3.627346251764432e-22, "3.627e-22", "%.4g",
+__LINE__, 3.652610391698086e-16, "0.000000", "%3f",
+__LINE__, 3.657463146689917e-19, " 0", "%4.0f",
+__LINE__, 3.658538858712938e-15, "4E-15", "%5.G",
+__LINE__, 3.660337267266058e+16, "+36603372672660579.034698", "%+f",
+__LINE__, 3.661588742065142e-01, "0.366159", "%g",
+__LINE__, 3.662296387211376e-25, "0.000000", "%f",
+__LINE__, 3.668511100303393e-29, "0.000000", "%7f",
+__LINE__, 3.669499303661920e+06, "3.6695e+06", "%1.5g",
+__LINE__, 3.676856420121343e-23, "3.6769e-23", "%0.4e",
+__LINE__, 3.677197473476901e-19, "+3.6772e-19", "%+g",
+__LINE__, 3.677281754506453e+12, "+3677281754506.452671", "%+f",
+__LINE__, 3.678420802401506e-19, "3.67842E-19", "%G",
+__LINE__, 3.679970245325769e+07, "3.67997e+07", "%g",
+__LINE__, 3.682528947621349e+05, "4.e+05", "%#5.e",
+__LINE__, 3.688257471304210e+22, "36882574713042104441740.320908", "%f",
+__LINE__, 3.689129734472166e-01, "0.368913", "%0.6G",
+__LINE__, 3.693483801463324e+12, "4E+12", "%3.E",
+__LINE__, 3.694612396584729e-21, "+3.69461E-21", "%+G",
+__LINE__, 3.706150073392112e-19, "0.000000", "%2f",
+__LINE__, 3.706824819530577e+21, "3706824819530576853310.321894", "%f",
+__LINE__, 3.709583789659276e+19, "+3.709584E+19", "%+#E",
+__LINE__, 3.711137503697284e+22, "3.7111E+22", "%.5G",
+__LINE__, 3.717307412969522e-22, "3.717307E-22", "%#E",
+__LINE__, 3.717434999853808e+24, " 4E+24", "%6.G",
+__LINE__, 3.720761662524312e+14, "+372076166252431.2285", "%+1.4f",
+__LINE__, 3.721613815237707e-10, "3.72161e-10", "%g",
+__LINE__, 3.725086467464346e+14, "3.72509E+14", "%G",
+__LINE__, 3.727427083626536e-15, "+4E-15", "%+.0G",
+__LINE__, 3.731138322599465e-13, "3.73114e-13", "%5g",
+__LINE__, 3.732248129614146e-04, " 4E-04", "%7.E",
+__LINE__, 3.744422223926118e-24, "3.744422E-24", "%E",
+__LINE__, 3.745595428897916e+21, "+3745595428897916079336.027906", "%+f",
+__LINE__, 3.751308304055989e-08, "+3.751308e-08", "%+e",
+__LINE__, 3.755395417696132e-02, "0.037554", "%f",
+__LINE__, 3.769103881505159e+09, "3.7691e+09", "%g",
+__LINE__, 3.769535572757430e+00, "3.769536", "%6.7G",
+__LINE__, 3.770823872348274e-28, "+0.000000", "%+f",
+__LINE__, 3.771160653578178e+29, "3.77116e+29", "%g",
+__LINE__, 3.776563752716444e-12, "4E-12", "%.0E",
+__LINE__, 3.777953798674786e-28, "3.77795e-28", "%g",
+__LINE__, 3.785994690686598e+28, "4E+28", "%5.G",
+__LINE__, 3.787487488835162e+01, "+37.874875", "%+5f",
+__LINE__, 3.788249311173359e-18, "3.788249E-18", "%E",
+__LINE__, 3.798728360791314e-08, "3.798728E-08", "%2E",
+__LINE__, 3.799038238867092e+05, "3.79904E+05", "%.5E",
+__LINE__, 3.799822564549600e+06, "3.79982E+06", "%.5E",
+__LINE__, 3.804862840499834e-16, "0", "%1.f",
+__LINE__, 3.805375156822481e+12, "3805375156822.4814861", "%.7f",
+__LINE__, 3.821612790153376e-17, "3.821613e-17", "%e",
+__LINE__, 3.825193659558693e+14, "3.82519E+14", "%#G",
+__LINE__, 3.834180638680996e+17, "+383418063868099565.638659", "%+f",
+__LINE__, 3.834759760605814e-12, "3.83476E-12", "%G",
+__LINE__, 3.839786235582770e+16, "+3.84e+16", "%+0.3g",
+__LINE__, 3.843164462248778e+28, "3.84316e+28", "%#g",
+__LINE__, 3.845599697858050e+22, "3.8456E+22", "%G",
+__LINE__, 3.850147271017228e-21, "3.85e-21", "%.4g",
+__LINE__, 3.850283557812101e+07, "3.85028E+07", "%G",
+__LINE__, 3.854235609725703e+03, "3854.24", "%G",
+__LINE__, 3.864901885489405e-15, "3.8649E-15", "%G",
+__LINE__, 3.868630187629983e-24, "3.868630e-24", "%e",
+__LINE__, 3.876764606134972e-03, "+3.8767646e-03", "%+#0.7e",
+__LINE__, 3.884553592855422e+08, "+3.8845536e+08", "%+4.7e",
+__LINE__, 3.887417494351062e+03, "3887.42", "%0g",
+__LINE__, 3.887561018972304e+03, "3887.56", "%G",
+__LINE__, 3.888554801724658e-24, "3.888555e-24", "%e",
+__LINE__, 3.892806891909861e-01, "0.389281", "%f",
+__LINE__, 3.914459791345755e+15, "+3.914460E+15", "%+E",
+__LINE__, 3.918383209642759e+01, "39.1838", "%#G",
+__LINE__, 3.923970658741865e-10, "3.92397E-10", "%G",
+__LINE__, 3.928163650272335e+18, "3928163650272335161.162118", "%f",
+__LINE__, 3.933053127721002e-20, "3.933053e-20", "%e",
+__LINE__, 3.939306552155218e-29, "3.93931E-29", "%G",
+__LINE__, 3.953007066379472e+07, "3.953007E+07", "%E",
+__LINE__, 3.954924824986267e-01, "3.954925E-01", "%E",
+__LINE__, 3.956156072067987e+15, "3.956E+15", "%0.4G",
+__LINE__, 3.957756196797224e+22, "4.0E+22", "%4.1E",
+__LINE__, 3.960011413261009e+27, "+3960011413261008783592842519.283295", "%+f",
+__LINE__, 3.961789076323378e+20, "396178907632337828914.614875", "%f",
+__LINE__, 3.961985468081708e-28, "3.96199E-28", "%1G",
+__LINE__, 3.975007582283812e-27, "0.000000", "%0.6f",
+__LINE__, 3.987586813142132e+15, "+3.98759e+15", "%+g",
+__LINE__, 3.992250836957379e+21, "3.99225E+21", "%0G",
+__LINE__, 3.992985048620057e+00, "3.9930", "%.4f",
+__LINE__, 4.000000000000000e+02, "400.00", "%.2f",
+__LINE__, 4.000145414240556e+14, "4.00015e+14", "%#6g",
+__LINE__, 4.000774453529974e-25, "4E-25", "%.0E",
+__LINE__, 4.002041494804383e+17, "4.002041E+17", "%E",
+__LINE__, 4.005505415013214e+17, " 4E+17", "%6.2G",
+__LINE__, 4.008960306876491e-28, "0.000", "%.3f",
+__LINE__, 4.032337828117640e+16, "4.03234E+16", "%G",
+__LINE__, 4.035414597530057e+26, "403541459753005682387083652.429283", "%f",
+__LINE__, 4.037065874793069e-01, "0.403707", "%f",
+__LINE__, 4.047856284449970e-14, "4.04786E-14", "%#G",
+__LINE__, 4.049037221323070e-04, "4.049037e-04", "%e",
+__LINE__, 4.053458853142009e-07, "4E-07", "%2.0E",
+__LINE__, 4.056455443275955e-22, "4.056455e-22", "%e",
+__LINE__, 4.058158020771355e-22, "4.05816e-22", "%#2g",
+__LINE__, 4.067283508945137e+02, "+4.07e+02", "%+5.2e",
+__LINE__, 4.072155715199509e+11, "4.072e+11", "%.4g",
+__LINE__, 4.074643403755990e-22, "4e-22", "%0.g",
+__LINE__, 4.077450352325251e+08, "4.1e+08", "%3.2g",
+__LINE__, 4.081492619284916e-08, "4.081493E-08", "%E",
+__LINE__, 4.083271801996951e-10, "4.083272E-10", "%#E",
+__LINE__, 4.090188547940879e-15, "4.090189E-15", "%#E",
+__LINE__, 4.091167728938537e-11, "4e-11", "%1.g",
+__LINE__, 4.091916745541154e+15, "4091916745541153.588306", "%f",
+__LINE__, 4.092366122921161e+23, "4E+23", "%0.E",
+__LINE__, 4.094638368212577e-11, "4.09464E-11", "%#G",
+__LINE__, 4.097148443124199e-16, "0.000000", "%f",
+__LINE__, 4.101057893946401e+06, "4e+06", "%4.g",
+__LINE__, 4.101209521231476e+28, "41012095212314756409455185348.633677", "%f",
+__LINE__, 4.105683659045903e+05, "+4.E+05", "%+#1.G",
+__LINE__, 4.111553717385758e-16, "4.11155e-16", "%g",
+__LINE__, 4.112186409918593e+14, "+4.11219e+14", "%+g",
+__LINE__, 4.117782144860865e+25, "4.117782E+25", "%5E",
+__LINE__, 4.119420921722146e-27, "4.11942e-27", "%g",
+__LINE__, 4.134953783635018e+14, "+4.1349538e+14", "%+.7e",
+__LINE__, 4.136990822648468e+11, "4.136991E+11", "%E",
+__LINE__, 4.140475788523046e+14, "+4E+14", "%+5.G",
+__LINE__, 4.149589679915584e+24, "4.14959E+24", "%2G",
+__LINE__, 4.151240342256744e-22, " 0", "%2.f",
+__LINE__, 4.155533104307272e-04, "+0.000416", "%+f",
+__LINE__, 4.155890511880097e+25, "4.155891e+25", "%e",
+__LINE__, 4.159907901074450e-19, "4.159908E-19", "%7E",
+__LINE__, 4.171899783464252e+18, "4E+18", "%.0E",
+__LINE__, 4.177920266276382e-17, "+0.0000", "%+1.4f",
+__LINE__, 4.181728014477237e-20, "4.18173e-20", "%.6g",
+__LINE__, 4.203600495086497e-30, " 4E-30", "%6.G",
+__LINE__, 4.211166112605717e-08, "4E-08", "%5.1G",
+__LINE__, 4.219513437404614e+18, "+4E+18", "%+.0E",
+__LINE__, 4.221426315236785e+08, "4.221426E+08", "%#E",
+__LINE__, 4.226224756005934e-13, " 4.e-13", "%#7.g",
+__LINE__, 4.226979046489921e-01, "4.226979e-01", "%#.6e",
+__LINE__, 4.236283521629158e-08, "+4.23628E-08", "%+G",
+__LINE__, 4.239850628514233e-07, "4.23985E-07", "%.6G",
+__LINE__, 4.241177358638621e+04, "42411.773586", "%2f",
+__LINE__, 4.245306724398964e-13, "0.000000", "%#f",
+__LINE__, 4.246194290300334e+16, "42461942903003340.177293", "%2f",
+__LINE__, 4.251238996137952e-05, "4.25124E-05", "%3G",
+__LINE__, 4.262432542017438e+13, "42624325420174.375978", "%1f",
+__LINE__, 4.266383084300715e+16, "4E+16", "%4.G",
+__LINE__, 4.292963398931474e-11, "4.292963E-11", "%E",
+__LINE__, 4.296530271399131e-29, "0.000000", "%6f",
+__LINE__, 4.303753949741171e+19, "4.30375E+19", "%2G",
+__LINE__, 4.303767633827431e-28, "4.30377e-28", "%g",
+__LINE__, 4.316181911403991e-30, "4.3162e-30", "%#7.5g",
+__LINE__, 4.318654697213126e-18, "4.31865e-18", "%g",
+__LINE__, 4.320618603119499e+05, "432061.860312", "%3f",
+__LINE__, 4.322443609118441e+21, "4.32244E+21", "%7.5E",
+__LINE__, 4.322522446810708e-15, "4.32252e-15", "%.6g",
+__LINE__, 4.334728493589115e-18, "0.000000", "%f",
+__LINE__, 4.335342531476346e-19, "4.33534E-19", "%G",
+__LINE__, 4.340579325084176e-30, "4.34058e-30", "%#0.6g",
+__LINE__, 4.340775659883185e+04, "43407.756599", "%6f",
+__LINE__, 4.361131891528634e-14, " 4E-14", "%6.G",
+__LINE__, 4.366662624371249e-02, "+0.04", "%+4.g",
+__LINE__, 4.369919308458348e+28, "+4.36992e+28", "%+2g",
+__LINE__, 4.369930393192433e-24, "4.369930e-24", "%e",
+__LINE__, 4.376283118322521e-01, "0.437628", "%g",
+__LINE__, 4.386868840825930e+19, "4.3869E+19", "%.5G",
+__LINE__, 4.389349113395235e+05, "+4.389349e+05", "%+e",
+__LINE__, 4.392447466753053e-08, "+4.392E-08", "%+.4G",
+__LINE__, 4.394068619246889e-13, "4.39407e-13", "%6g",
+__LINE__, 4.404889573700147e-09, "4.404890E-09", "%E",
+__LINE__, 4.410531039373014e+05, "+4.41e+05", "%+.2e",
+__LINE__, 4.412466606726400e-08, " 0.0", "%6.1f",
+__LINE__, 4.414693719279123e+17, "4.414694e+17", "%e",
+__LINE__, 4.417050329080679e-01, "+0.441705", "%+g",
+__LINE__, 4.419509841929196e-10, "4.4195098E-10", "%.7E",
+__LINE__, 4.421012777695611e+07, "+4.42101E+07", "%+0.6G",
+__LINE__, 4.426387732151208e+11, "4.42639e+11", "%g",
+__LINE__, 4.439567017550398e+26, "4.439567E+26", "%E",
+__LINE__, 4.446479816166258e-21, "4.446480e-21", "%0e",
+__LINE__, 4.453486178424380e+05, "445348.617842", "%f",
+__LINE__, 4.455733696043438e+06, "4.45573e+06", "%3g",
+__LINE__, 4.455870606312063e+16, "4.45587e+16", "%g",
+__LINE__, 4.458776435431700e+22, "4e+22", "%1.g",
+__LINE__, 4.466448605584151e-30, "0.000000", "%f",
+__LINE__, 4.471063097005706e+16, "4.47106E+16", "%G",
+__LINE__, 4.482001890035190e-22, "+4.482E-22", "%+G",
+__LINE__, 4.493246870093631e+05, "449325", "%1G",
+__LINE__, 4.496089639281023e+17, "4.49609e+17", "%g",
+__LINE__, 4.515066070117557e+15, "4.51507e+15", "%g",
+__LINE__, 4.518296460916194e+24, "+4.5183E+24", "%+G",
+__LINE__, 4.526548719445596e+02, "452.655", "%6.3f",
+__LINE__, 4.532756455106440e-26, "4.53e-26", "%4.2e",
+__LINE__, 4.534466782633055e-14, "4.53447E-14", "%G",
+__LINE__, 4.541313061854649e-14, "4.54131E-14", "%G",
+__LINE__, 4.541848265404338e+02, " 5E+02", "%7.G",
+__LINE__, 4.546603085406363e-26, "5E-26", "%3.G",
+__LINE__, 4.557349604829375e+28, "+45573496048293753446500886639.", "%+#1.f",
+__LINE__, 4.560736449944898e-27, "4.56074e-27", "%g",
+__LINE__, 4.563726230559341e-15, "+0.0", "%+2.1f",
+__LINE__, 4.572650965532532e-26, "+5E-26", "%+4.G",
+__LINE__, 4.574369572115099e-10, "+0.000000", "%+2.6f",
+__LINE__, 4.576480601519729e+28, "+4.576481e+28", "%+e",
+__LINE__, 4.587487640650499e+02, "+458.75", "%+3.2f",
+__LINE__, 4.598365231538559e-27, "4.59837E-27", "%G",
+__LINE__, 4.599348244725009e-28, "+4.5993482e-28", "%+#3.7e",
+__LINE__, 4.599897524047587e+22, "45998975240475870052136.997401", "%#f",
+__LINE__, 4.605415604725077e-25, "0.000000", "%f",
+__LINE__, 4.613055015797716e+28, "4.613055E+28", "%E",
+__LINE__, 4.618715275814238e-10, "4.618715E-10", "%E",
+__LINE__, 4.619044579489540e-14, "0.00", "%.2f",
+__LINE__, 4.633693310095410e-20, "+0.000000", "%+f",
+__LINE__, 4.648505395281916e-28, "0.000000", "%f",
+__LINE__, 4.651232770446398e+21, "4.65e+21", "%.2e",
+__LINE__, 4.659743589975352e+28, "+4.65974e+28", "%+g",
+__LINE__, 4.660181457075208e-13, "4.66018e-13", "%g",
+__LINE__, 4.669787018529686e+20, "4.66979e+20", "%g",
+__LINE__, 4.672649286126732e-21, "4.6726E-21", "%4.5G",
+__LINE__, 4.675431901120643e-11, " 0", "%3.f",
+__LINE__, 4.684404068169945e+26, "468440406816994503458317922.2", "%6.1f",
+__LINE__, 4.685438834234642e+19, "5.E+19", "%#6.G",
+__LINE__, 4.688915890732712e+00, "+5e+00", "%+2.e",
+__LINE__, 4.692999432046297e+00, "4.692999E+00", "%E",
+__LINE__, 4.708690772584701e+11, "4.70869e+11", "%g",
+__LINE__, 4.711821455782105e-11, "+4.71182e-11", "%+1g",
+__LINE__, 4.712413965116830e-01, "4.712414E-01", "%E",
+__LINE__, 4.719504715401049e-08, "0.000000", "%f",
+__LINE__, 4.719767896031655e+27, "4.71977e+27", "%#g",
+__LINE__, 4.722493017411588e-05, "0.000047", "%4f",
+__LINE__, 4.729482386761477e+08, "4.72948e+08", "%1g",
+__LINE__, 4.730102169800602e-06, "0.000005", "%f",
+__LINE__, 4.743951614209393e+24, "4.743952E+24", "%#E",
+__LINE__, 4.746077075605921e-16, "4.746E-16", "%.3E",
+__LINE__, 4.747802537919248e+24, "4747802537919247889419694", "%4.f",
+__LINE__, 4.754727690703025e-26, "0", "%0.f",
+__LINE__, 4.756952432926979e-29, " 0.", "%#3.f",
+__LINE__, 4.758335147956709e+03, "4758.335148", "%f",
+__LINE__, 4.760141880810268e-25, "4.760142e-25", "%e",
+__LINE__, 4.767079423650815e-07, "5.E-07", "%#0.G",
+__LINE__, 4.785662728343338e-28, "4.78566e-28", "%g",
+__LINE__, 4.787146245774150e-13, "+4.78715E-13", "%+G",
+__LINE__, 4.787415449888824e-17, "4.78742e-17", "%3g",
+__LINE__, 4.794589807429657e-05, "4.79459E-05", "%6G",
+__LINE__, 4.794948299666205e+08, "4.79495e+08", "%g",
+__LINE__, 4.802292865915992e-04, "4.802293e-04", "%e",
+__LINE__, 4.802513688198601e+07, "+4.8e+07", "%+2.3g",
+__LINE__, 4.810456746192536e+06, "5E+06", "%0.0G",
+__LINE__, 4.820631660081696e+20, "+4.82063E+20", "%+G",
+__LINE__, 4.827865857270075e-20, "4.82787e-20", "%g",
+__LINE__, 4.835054268490970e+21, "4835054268490970308391.752042", "%#f",
+__LINE__, 4.838136770808465e-18, "4.83814E-18", "%G",
+__LINE__, 4.839342397882353e-26, "4.839342E-26", "%E",
+__LINE__, 4.845130210072029e-16, "0", "%1.f",
+__LINE__, 4.845161043167169e-12, "+4.845e-12", "%+.4g",
+__LINE__, 4.857425142494964e+01, "48.574251", "%f",
+__LINE__, 4.858118337285513e-10, "+4.8581e-10", "%+.5g",
+__LINE__, 4.867478343525339e-15, "+4.867478E-15", "%+E",
+__LINE__, 4.886137001331278e-11, "0.000000", "%f",
+__LINE__, 4.886835850687998e-20, " 0", "%6.0f",
+__LINE__, 4.886880737482383e+26, "488688073748238327453918827.814050", "%4f",
+__LINE__, 4.888812049144075e-22, "4.888812E-22", "%E",
+__LINE__, 4.895869618002905e+02, "+489.587", "%+.7g",
+__LINE__, 4.902046593298549e+09, " 5e+09", "%7.g",
+__LINE__, 4.907918627564751e-05, "4.91e-05", "%.3g",
+__LINE__, 4.916048355579009e+19, "49160483555790088772", "%2.f",
+__LINE__, 4.917197806128638e+14, "+5e+14", "%+5.g",
+__LINE__, 4.918303274189911e+13, "4.918303e+13", "%e",
+__LINE__, 4.922687970321108e+26, "492268797032110771993984599.2485", "%0.4f",
+__LINE__, 4.929263362431195e+14, "4.92926e+14", "%g",
+__LINE__, 4.933385398543267e-17, "0.000000", "%#f",
+__LINE__, 4.942367126455025e+00, " +5", "%+6.f",
+__LINE__, 4.947687486717652e-04, "0.000495", "%.6f",
+__LINE__, 4.960855200003128e-08, "+4.960855e-08", "%+e",
+__LINE__, 4.968485435774085e-21, "0.0000", "%#2.4f",
+__LINE__, 4.972088381506133e+01, "49.7", "%.1f",
+__LINE__, 4.977561524480392e-15, "4.977562E-15", "%7E",
+__LINE__, 4.984592111249502e-13, "5.0e-13", "%.1e",
+__LINE__, 4.997502335602838e-14, "4.998e-14", "%6.4g",
+__LINE__, 5.001731554335935e-09, "5.00173e-09", "%g",
+__LINE__, 5.006231697107042e-17, "5.0062e-17", "%1.5g",
+__LINE__, 5.008035801093423e+24, "5.008036E+24", "%#E",
+__LINE__, 5.008756965733827e-28, "5.009E-28", "%.4G",
+__LINE__, 5.009774027622812e+20, "+5.00977E+20", "%+G",
+__LINE__, 5.010576312346293e+29, "5.01058E+29", "%G",
+__LINE__, 5.012335250996786e+29, "5.012335e+29", "%.7g",
+__LINE__, 5.012404365186907e+20, "5E+20", "%3.2G",
+__LINE__, 5.024670103250229e-01, "+5.024670E-01", "%+E",
+__LINE__, 5.025765369164560e+03, "5025.77", "%g",
+__LINE__, 5.027173841003918e+11, "+5.02717E+11", "%+G",
+__LINE__, 5.032093817639893e-26, "5e-26", "%3.e",
+__LINE__, 5.039636818525848e-02, "0.050396", "%#f",
+__LINE__, 5.040626671307691e+23, "5.040627E+23", "%E",
+__LINE__, 5.040788233368296e-11, "+5.04079e-11", "%+g",
+__LINE__, 5.040903321336150e-28, "5.0409E-28", "%G",
+__LINE__, 5.042078512958994e+12, "5.04208E+12", "%G",
+__LINE__, 5.045957900223303e+15, "5045957900223303", "%0.f",
+__LINE__, 5.048298764352134e-14, "5.048299e-14", "%1e",
+__LINE__, 5.048827326763192e+28, "50488273267631917917697137454.524636", "%f",
+__LINE__, 5.049714558347361e-23, "5e-23", "%5.0g",
+__LINE__, 5.051509904923853e+16, "50515099049238534", "%5.f",
+__LINE__, 5.052789863743305e-10, "5.05279E-10", "%6G",
+__LINE__, 5.057429728861999e-29, "0.000", "%#1.3f",
+__LINE__, 5.075313093968501e-13, "+5.07531e-13", "%+g",
+__LINE__, 5.075874503501582e+29, "5e+29", "%2.e",
+__LINE__, 5.079468079020803e+01, "50.795", "%.5G",
+__LINE__, 5.086214826494080e-28, " 0.0", "%4.1f",
+__LINE__, 5.096054881114421e+13, "5.096e+13", "%.4g",
+__LINE__, 5.099045274853458e-23, "5.09905E-23", "%0G",
+__LINE__, 5.100248195124433e+00, "5.100248", "%f",
+__LINE__, 5.101016114276598e-20, "5e-20", "%4.1g",
+__LINE__, 5.103213528670269e+07, "51032135.286703", "%6f",
+__LINE__, 5.108373625126768e+08, "+510837362.512677", "%+f",
+__LINE__, 5.113097157183416e+07, "5.1131E+07", "%#.4E",
+__LINE__, 5.114452611789777e+08, "+5.11445E+08", "%+G",
+__LINE__, 5.117099184715288e-16, "5.1171E-16", "%G",
+__LINE__, 5.119910534665511e-13, "+5.11991E-13", "%+G",
+__LINE__, 5.121320931953720e+23, "+5.121321e+23", "%+#e",
+__LINE__, 5.121900318443998e+06, "5.121900e+06", "%e",
+__LINE__, 5.135698679084286e+00, "5.1357", "%2g",
+__LINE__, 5.146355903104154e-10, "+5.14636E-10", "%+.6G",
+__LINE__, 5.148754210958986e-24, "+5.148754e-24", "%+e",
+__LINE__, 5.156238368448428e+26, "5e+26", "%5.g",
+__LINE__, 5.159924520667922e-19, "+5E-19", "%+0.1G",
+__LINE__, 5.159938266135425e-27, "0.000000", "%f",
+__LINE__, 5.165915205175676e-01, "5.165915e-01", "%e",
+__LINE__, 5.190205499401547e-11, "5e-11", "%2.1g",
+__LINE__, 5.193260005542003e+26, "5.19326e+26", "%#g",
+__LINE__, 5.194732077318269e+08, "519473207.731827", "%f",
+__LINE__, 5.196394616633798e-19, "0", "%.0f",
+__LINE__, 5.206753628035638e+19, "5.20675e+19", "%6.6g",
+__LINE__, 5.207364136540851e-23, " 0.000", "%6.3f",
+__LINE__, 5.210672737132108e-09, "5.21067E-09", "%G",
+__LINE__, 5.211423933057123e-20, "+5.21142E-20", "%+G",
+__LINE__, 5.219749528363367e-27, "5.219750e-27", "%e",
+__LINE__, 5.228031587478653e-06, "+5.2E-06", "%+3.1E",
+__LINE__, 5.229303095005359e-25, "+0.000000", "%+#f",
+__LINE__, 5.234703511938320e-06, " 0", "%7.f",
+__LINE__, 5.235655046937822e-20, "5.235655E-20", "%.6E",
+__LINE__, 5.237924986002288e-01, "+0.52379", "%+.5f",
+__LINE__, 5.249148093603826e+20, "5.24915E+20", "%0G",
+__LINE__, 5.262680920244596e+16, "5.26268E+16", "%G",
+__LINE__, 5.267944704715845e-06, "5.e-06", "%#3.g",
+__LINE__, 5.268543533730505e-08, "5.26854E-08", "%G",
+__LINE__, 5.275727269515247e-02, "0.0527573", "%.6g",
+__LINE__, 5.279215316873723e+24, "5279215316873722585455652.733799", "%f",
+__LINE__, 5.284326985680811e+16, "52843269856808108.286828", "%6f",
+__LINE__, 5.286192957344040e-10, "5.3E-10", "%.1E",
+__LINE__, 5.289451976001091e-23, "5.28945E-23", "%G",
+__LINE__, 5.289512908209300e+09, "+5.289513e+09", "%+e",
+__LINE__, 5.295696957972123e+11, "5.296E+11", "%#.3E",
+__LINE__, 5.303584684011050e+16, "53035846840110503.208621", "%f",
+__LINE__, 5.310315581980172e+23, "531031558198017172855998", "%4.f",
+__LINE__, 5.317492728410062e-14, "5.31749e-14", "%7g",
+__LINE__, 5.324506949499409e+18, "5.3245E+18", "%.5G",
+__LINE__, 5.329238068668336e-20, "5e-20", "%4.g",
+__LINE__, 5.336050125161774e+14, "5.33605e+14", "%g",
+__LINE__, 5.349921315003169e-17, "5.34992E-17", "%.6G",
+__LINE__, 5.355648481782587e-20, "5.355648e-20", "%e",
+__LINE__, 5.358945557589489e-26, "+5e-26", "%+0.g",
+__LINE__, 5.359638846465574e+21, "5.359639E+21", "%E",
+__LINE__, 5.377048469393900e+14, "5.377E+14", "%.5G",
+__LINE__, 5.387471194156434e+23, "5.387471E+23", "%.7G",
+__LINE__, 5.401622578962497e-03, "+0.0054", "%+5.2g",
+__LINE__, 5.406882732497444e-16, "5.406883E-16", "%E",
+__LINE__, 5.421474560523198e-11, "+5.42147e-11", "%+g",
+__LINE__, 5.440249323479418e-26, "5.44025E-26", "%7G",
+__LINE__, 5.440922682921101e-05, "5e-05", "%.1g",
+__LINE__, 5.444400103673185e-01, "0.54444", "%G",
+__LINE__, 5.449339470916152e+09, "5449339470.9162", "%.4f",
+__LINE__, 5.451583259558706e-15, "5.e-15", "%#4.e",
+__LINE__, 5.460153018660573e+26, "+546015301866057267687892817.775719", "%+f",
+__LINE__, 5.477591210511918e+08, "+5.47759E+08", "%+0.5E",
+__LINE__, 5.481665401407188e-02, "5.481665e-02", "%e",
+__LINE__, 5.482670784411319e-16, "5E-16", "%4.G",
+__LINE__, 5.487494580636099e+12, "5.48749e+12", "%g",
+__LINE__, 5.508630369473937e-10, "5.508630e-10", "%e",
+__LINE__, 5.528898001438273e+20, "6e+20", "%4.g",
+__LINE__, 5.530331734443152e-24, " 6e-24", "%6.g",
+__LINE__, 5.531704398969656e-24, "0.000000", "%f",
+__LINE__, 5.539906569043238e+05, "+553990.656904", "%+f",
+__LINE__, 5.554571854756323e-08, "+0.00000", "%+4.5f",
+__LINE__, 5.555155069925145e-28, "5.55516e-28", "%g",
+__LINE__, 5.555302705075539e-08, "+5.5553e-08", "%+g",
+__LINE__, 5.563805076159055e-05, "5.563805e-05", "%e",
+__LINE__, 5.565063508995002e+07, "5.565E+07", "%.3E",
+__LINE__, 5.566281664807526e-08, "5.56628E-08", "%G",
+__LINE__, 5.575245679736338e-08, "5.575246e-08", "%e",
+__LINE__, 5.578254777281501e-21, "0.", "%#.0f",
+__LINE__, 5.582389275770848e-01, " 0.6", "%5.G",
+__LINE__, 5.592215029176133e-04, "0.00056", "%.2g",
+__LINE__, 5.593536789867047e-25, "5.59354e-25", "%g",
+__LINE__, 5.605652054074862e-03, " 0.006", "%8.G",
+__LINE__, 5.606982382643258e+20, "+5.60698E+20", "%+G",
+__LINE__, 5.614646821116853e-18, "5.6E-18", "%.2G",
+__LINE__, 5.625586848606565e-11, "+5.62559E-11", "%+G",
+__LINE__, 5.626300428046732e+26, " 6e+26", "%7.g",
+__LINE__, 5.638236626881086e-17, " 6E-17", "%6.G",
+__LINE__, 5.645744817075691e+04, "5.645745E+04", "%E",
+__LINE__, 5.651410004691736e+06, "6.E+06", "%#3.E",
+__LINE__, 5.659582345929256e-11, "+0.000000", "%+f",
+__LINE__, 5.670968861413510e+16, "+5.67097E+16", "%+G",
+__LINE__, 5.672476851235796e+01, "+56.724769", "%+0f",
+__LINE__, 5.674563779921248e+28, " 6E+28", "%6.0G",
+__LINE__, 5.675558529939025e+19, "5.67556e+19", "%3g",
+__LINE__, 5.676326888314589e-08, " 6e-08", "%7.g",
+__LINE__, 5.677928507840897e-30, "5.67793e-30", "%0g",
+__LINE__, 5.686622552402630e-15, "5.69E-15", "%1.3G",
+__LINE__, 5.710441686922142e-14, "5.710442E-14", "%E",
+__LINE__, 5.713234603280163e-21, "0.00000", "%0.5f",
+__LINE__, 5.714968959046963e+12, "5.71497e+12", "%g",
+__LINE__, 5.722025141555638e-23, "5.72e-23", "%.2e",
+__LINE__, 5.725398571007033e-09, "5.7254E-09", "%.6G",
+__LINE__, 5.751604813862738e+18, "6E+18", "%.1G",
+__LINE__, 5.761025444751985e+20, "5.76103e+20", "%g",
+__LINE__, 5.762315767948593e+15, "5.76232e+15", "%4g",
+__LINE__, 5.764528858586032e-15, "5.764529E-15", "%6.7G",
+__LINE__, 5.766408541535810e-07, " 6E-07", "%6.1G",
+__LINE__, 5.771831571087174e-01, "0.577183", "%f",
+__LINE__, 5.790102497364865e-15, "+5.790102e-15", "%+e",
+__LINE__, 5.790222335547785e-08, "5.79022e-08", "%0.6g",
+__LINE__, 5.794082127091130e+21, "5794082127091130018925.468903", "%f",
+__LINE__, 5.804568463644165e+28, "5.80457e+28", "%g",
+__LINE__, 5.827356651901066e+20, "582735665190106555400.006982", "%f",
+__LINE__, 5.837553387436408e+18, "5.837553E+18", "%3E",
+__LINE__, 5.844458110907209e+22, "5.84446e+22", "%g",
+__LINE__, 5.851672125746866e-19, "5.85167e-19", "%g",
+__LINE__, 5.868843476784172e-12, "5.868843e-12", "%1.7g",
+__LINE__, 5.870854146748864e-04, "0.000587", "%2.3g",
+__LINE__, 5.877787821470433e+01, "+58.77788", "%+#3.5f",
+__LINE__, 5.881333514866498e+04, "5.881334E+04", "%E",
+__LINE__, 5.908427816128965e+28, "+5.908428E+28", "%+E",
+__LINE__, 5.918139800007388e+07, "59181398.000074", "%f",
+__LINE__, 5.925587467475260e+21, "5925587467475259551008.548442", "%f",
+__LINE__, 5.930403502679683e-22, "5.9304E-22", "%.6G",
+__LINE__, 5.961572644847521e+02, "+596.157", "%+G",
+__LINE__, 5.968917715225198e-21, "5.96892e-21", "%4g",
+__LINE__, 5.982184454670110e-08, "0", "%0.f",
+__LINE__, 5.988414319040855e+09, "6E+09", "%0.G",
+__LINE__, 5.996263783103995e-10, "5.996264e-10", "%e",
+__LINE__, 6.004634162276014e-18, "6.00463e-18", "%g",
+__LINE__, 6.018734975519166e-08, "6.01873E-08", "%G",
+__LINE__, 6.029071822986717e-14, "0.0000000", "%.7f",
+__LINE__, 6.030392278117406e+23, "6.030392e+23", "%e",
+__LINE__, 6.034553399237175e-27, "+6.03455e-27", "%+g",
+__LINE__, 6.034938873443862e+24, "6034938873443861595546877.651941", "%f",
+__LINE__, 6.038929148003457e-16, "6.03893e-16", "%g",
+__LINE__, 6.039149626573702e-13, "6.0391E-13", "%3.5G",
+__LINE__, 6.041247664739301e+29, "6.041248E+29", "%3E",
+__LINE__, 6.044220746789781e+20, "+6.04422e+20", "%+g",
+__LINE__, 6.045775647107433e+19, "6E+19", "%2.G",
+__LINE__, 6.051917010461611e-05, "6.05192E-05", "%G",
+__LINE__, 6.059773181566425e+17, "+605977318156642486", "%+5.f",
+__LINE__, 6.082239575475813e+01, "+6E+01", "%+.1G",
+__LINE__, 6.093984174629151e+18, "6.093984e+18", "%e",
+__LINE__, 6.102368380479137e+22, "6.1E+22", "%.2G",
+__LINE__, 6.103097446204007e+25, "61030974462040070704915706.301108", "%#0f",
+__LINE__, 6.105244994410556e-24, "0.0000000", "%2.7f",
+__LINE__, 6.110828906801633e-14, "+6.110829e-14", "%+3e",
+__LINE__, 6.124439072468681e-30, "6.12444e-30", "%g",
+__LINE__, 6.127714703273447e-15, "0", "%0.f",
+__LINE__, 6.128539582408870e-15, "6.12854e-15", "%g",
+__LINE__, 6.145470264744349e+24, "6145470264744348654062378.045637", "%f",
+__LINE__, 6.159177701667455e+26, "615917770166745537352426254.074089", "%#f",
+__LINE__, 6.159348213337442e+17, "6.15935e+17", "%g",
+__LINE__, 6.161953891020492e-21, "0.000000", "%f",
+__LINE__, 6.169474192777305e+29, "+6.169E+29", "%+.4G",
+__LINE__, 6.198519761010651e-15, "+0", "%+1.f",
+__LINE__, 6.201381824304919e-27, " 0", "%5.f",
+__LINE__, 6.204387065736372e-18, "6.204387E-18", "%7E",
+__LINE__, 6.209270088144063e-24, "0.000000", "%f",
+__LINE__, 6.209871738353546e-20, "6.20987E-20", "%G",
+__LINE__, 6.222733191871026e+14, "+6.22273e+14", "%+g",
+__LINE__, 6.234670085354310e+04, "+62346.700854", "%+f",
+__LINE__, 6.258389346602224e-09, "6E-09", "%.0G",
+__LINE__, 6.263326582587503e+12, "6263326582588.", "%#5.f",
+__LINE__, 6.272768026763922e+03, "+6272.77", "%+g",
+__LINE__, 6.287747868625765e+00, "6E+00", "%.0E",
+__LINE__, 6.297724027388795e-17, "+6E-17", "%+3.G",
+__LINE__, 6.309940679156400e+27, "6.30994e+27", "%6.5e",
+__LINE__, 6.312960327030170e+06, "+6.312960E+06", "%+E",
+__LINE__, 6.317658179632976e+02, "+631.766", "%+g",
+__LINE__, 6.321255960699571e-27, "0.000000", "%f",
+__LINE__, 6.323069932833900e+03, "6323", "%.4G",
+__LINE__, 6.337027835933034e+21, "6.33703e+21", "%#g",
+__LINE__, 6.343583177899838e-03, "0.00634358", "%7G",
+__LINE__, 6.347464241733904e-03, "6.e-03", "%#0.e",
+__LINE__, 6.352038720353924e+07, "63520387.203539", "%f",
+__LINE__, 6.355292378565109e+23, "+635529237856510942350496.407016", "%+f",
+__LINE__, 6.377901944439164e-29, "0.000", "%2.3f",
+__LINE__, 6.378660255554053e-04, "6.37866E-04", "%.5E",
+__LINE__, 6.382838195255167e-18, "0.000000", "%f",
+__LINE__, 6.391046303581911e+22, "6E+22", "%.0G",
+__LINE__, 6.404812348309621e+22, "6.404812E+22", "%.7G",
+__LINE__, 6.406154091357119e+16, "6.40615E+16", "%G",
+__LINE__, 6.419414726557980e+21, "+6.41941e+21", "%+g",
+__LINE__, 6.432166563008504e+10, " +6e+10", "%+7.g",
+__LINE__, 6.438463704193190e+19, "6.438464e+19", "%e",
+__LINE__, 6.445270237908565e+15, "+6.445270E+15", "%+E",
+__LINE__, 6.445536770502964e+09, "6.446e+09", "%.3e",
+__LINE__, 6.446614224811444e+28, "64466142248114444157636171439.662576", "%f",
+__LINE__, 6.457046289718297e+18, "6457046289718297416.015957", "%4f",
+__LINE__, 6.457682856890173e+01, "6.457683E+01", "%2E",
+__LINE__, 6.471026352792729e-16, "+6.47103e-16", "%+g",
+__LINE__, 6.474527749567342e+19, "6E+19", "%.1G",
+__LINE__, 6.481178401781131e-24, "+6.48E-24", "%+6.3G",
+__LINE__, 6.490736647261461e-15, "+6.49074e-15", "%+g",
+__LINE__, 6.493196535069719e+23, "+6.4932E+23", "%+G",
+__LINE__, 6.500296992935538e-20, "+0.0", "%+.1f",
+__LINE__, 6.502867735895890e-19, "+0.000000", "%+6f",
+__LINE__, 6.506627529164683e+14, "650662752916468", "%5.f",
+__LINE__, 6.511909298966434e-15, "+6.51191E-15", "%+G",
+__LINE__, 6.514463062693312e+01, "65.1446", "%G",
+__LINE__, 6.520721469484543e+16, "6.52072E+16", "%G",
+__LINE__, 6.528064508731680e-05, "6.528065E-05", "%7E",
+__LINE__, 6.529007214194039e-24, "0.000000", "%f",
+__LINE__, 6.537822760557410e-23, "0.000000", "%f",
+__LINE__, 6.552222096390805e+29, "+6.55222E+29", "%+G",
+__LINE__, 6.554569862717104e+12, "6.55457E+12", "%G",
+__LINE__, 6.563440840359989e-30, "7E-30", "%4.G",
+__LINE__, 6.586246985535526e+17, "6.58625E+17", "%#4G",
+__LINE__, 6.593339522442827e+16, "6.6E+16", "%#4.1E",
+__LINE__, 6.611179030024350e+02, "7E+02", "%4.E",
+__LINE__, 6.617541638586767e-10, "6.617542E-10", "%E",
+__LINE__, 6.619147920886991e-28, "7e-28", "%.1g",
+__LINE__, 6.622304444772819e-21, "6.62230E-21", "%#4G",
+__LINE__, 6.634766655157910e+12, "6634766655158", "%2.f",
+__LINE__, 6.635639771921218e+25, "+6.63564E+25", "%+G",
+__LINE__, 6.644575305929087e+17, "+6.64458e+17", "%+g",
+__LINE__, 6.648697591328432e+04, "6.648698E+04", "%3E",
+__LINE__, 6.665426012448100e+09, "6.66543E+09", "%G",
+__LINE__, 6.675222780441723e-23, "6.67522e-23", "%1g",
+__LINE__, 6.689765053880623e+00, "6.6898", "%.5g",
+__LINE__, 6.693874943680238e+25, "7.e+25", "%#1.g",
+__LINE__, 6.695033453546435e+19, "6.695033E+19", "%E",
+__LINE__, 6.720131534244976e+03, "+6720.132", "%+.3f",
+__LINE__, 6.725287004784564e+19, "+6.72529e+19", "%+g",
+__LINE__, 6.743599626906313e-18, "0.0000000", "%7.7f",
+__LINE__, 6.755534260704152e+29, "7.e+29", "%#5.e",
+__LINE__, 6.761855244766418e-18, "6.8E-18", "%.2G",
+__LINE__, 6.764974143681080e-02, "6.765E-02", "%2.3E",
+__LINE__, 6.766924477711975e-17, "0.000000", "%4f",
+__LINE__, 6.772195434106330e-19, "6.7722E-19", "%G",
+__LINE__, 6.779433073319225e-23, "0.00", "%.2f",
+__LINE__, 6.790317710068964e+05, "6.8e+05", "%.1e",
+__LINE__, 6.791378160292960e+02, "679.137816", "%f",
+__LINE__, 6.798381262104190e-27, "0.000000", "%f",
+__LINE__, 6.804165939424860e-14, "7e-14", "%4.g",
+__LINE__, 6.810668670623699e+11, "681066867062.369852", "%f",
+__LINE__, 6.838942637635821e-17, "+6.84e-17", "%+.2e",
+__LINE__, 6.868523988329111e-09, "+6.868524e-09", "%+e",
+__LINE__, 6.873228061403223e-15, "6.873228E-15", "%3E",
+__LINE__, 6.879370500093334e-12, "+0.000000", "%+f",
+__LINE__, 6.891525498686674e-10, "7e-10", "%0.g",
+__LINE__, 6.923027319286220e+21, "7.e+21", "%#1.g",
+__LINE__, 6.923565533024560e-11, "+6.92357e-11", "%+g",
+__LINE__, 6.931415640770737e-24, "+6.93142e-24", "%+g",
+__LINE__, 6.936582619246057e+09, "6.936583e+09", "%7e",
+__LINE__, 6.938661496670582e+05, "693866.1496671", "%2.7f",
+__LINE__, 6.946115378286550e-25, "0.000000", "%f",
+__LINE__, 6.955823211921219e-09, "6.95582e-09", "%g",
+__LINE__, 6.962365243425770e+29, "696236524342577034474288666388.019919", "%7f",
+__LINE__, 6.970432274812882e+05, "+7e+05", "%+1.0e",
+__LINE__, 6.975784942897122e-13, "6.975785e-13", "%e",
+__LINE__, 6.976786489904214e-07, "6.97679E-07", "%3G",
+__LINE__, 6.985245976357042e-05, "0.00", "%.2f",
+__LINE__, 6.993402879410720e-21, "6.9934e-21", "%g",
+__LINE__, 7.012183985341519e+28, "+70121839853415188770213717362", "%+2.f",
+__LINE__, 7.028670648856025e-15, "7.028671e-15", "%.7g",
+__LINE__, 7.034042985683665e-03, " 0", "%2.f",
+__LINE__, 7.044054273278726e+18, "7.044e+18", "%7.4g",
+__LINE__, 7.049706744250734e-06, "7E-06", "%0.E",
+__LINE__, 7.061982657056197e+13, "+7.061983e+13", "%+e",
+__LINE__, 7.066873668945899e+21, "7.06687E+21", "%G",
+__LINE__, 7.087941418633258e+26, "7.08794E+26", "%G",
+__LINE__, 7.108268134631547e+22, "7.108268E+22", "%E",
+__LINE__, 7.112095848565475e-19, "7.1121e-19", "%g",
+__LINE__, 7.116326241291862e+16, "7.116326e+16", "%e",
+__LINE__, 7.118854843597607e-22, "0.000000", "%f",
+__LINE__, 7.121423043456375e-27, "0.000000", "%f",
+__LINE__, 7.131415427096460e-03, "0.007131", "%3f",
+__LINE__, 7.132023279679892e+22, "7.e+22", "%#3.e",
+__LINE__, 7.146250280189992e-18, "0.000000", "%f",
+__LINE__, 7.150059058390724e+03, "7150.06", "%g",
+__LINE__, 7.161081578177381e-02, "+0.0716108", "%+G",
+__LINE__, 7.164935125149336e-27, "7.2E-27", "%#6.2G",
+__LINE__, 7.173125717489549e-10, "7.173126e-10", "%e",
+__LINE__, 7.174199549624193e+00, "7.1741995", "%.7f",
+__LINE__, 7.192493588077649e+27, "7.19249e+27", "%g",
+__LINE__, 7.215209568601445e-06, "7.215210e-06", "%e",
+__LINE__, 7.238322284100497e+03, "7238.3", "%.1f",
+__LINE__, 7.239203871123613e+06, "7239204", "%4.f",
+__LINE__, 7.245809072577019e-09, "+7.245809E-09", "%+E",
+__LINE__, 7.256275686433336e+03, "7.256276e+03", "%e",
+__LINE__, 7.265774291605193e+27, "+7.26577E+27", "%+G",
+__LINE__, 7.287968172227119e-21, "+7.287968e-21", "%+e",
+__LINE__, 7.306020169678527e+12, "7E+12", "%2.E",
+__LINE__, 7.315587463572568e-04, "0.", "%#.0f",
+__LINE__, 7.324627764547963e+09, "7.324628E+09", "%#E",
+__LINE__, 7.331904966719081e-06, "+7.3319E-06", "%+G",
+__LINE__, 7.334448152798243e-02, "0.07", "%0.g",
+__LINE__, 7.334487195961240e-01, "+0.733449", "%+#g",
+__LINE__, 7.381283575515707e+13, "7.381284E+13", "%E",
+__LINE__, 7.394854567245476e-11, "0.000000", "%7f",
+__LINE__, 7.401950211415377e-08, " 7e-08", "%6.e",
+__LINE__, 7.409023867864680e+03, "7409.023868", "%#3f",
+__LINE__, 7.411912956257733e-20, "7e-20", "%0.g",
+__LINE__, 7.445275019272160e+11, "744527501927.2159511", "%.7f",
+__LINE__, 7.450279765616891e-16, "7.45028e-16", "%.6g",
+__LINE__, 7.467047411334495e+14, "7.46705E+14", "%G",
+__LINE__, 7.485628870972725e+28, "7E+28", "%.0G",
+__LINE__, 7.495391782588563e+11, "749539178258.856253", "%f",
+__LINE__, 7.495824101611911e+06, "7.49582e+06", "%.6g",
+__LINE__, 7.499759867592402e+20, "+749975986759240154100.3", "%+.1f",
+__LINE__, 7.508983397140368e+04, "75089.8", "%g",
+__LINE__, 7.512585199581016e-27, "7.512585E-27", "%.6E",
+__LINE__, 7.516831372212545e-29, "+7.516831e-29", "%+e",
+__LINE__, 7.525789465978582e+00, "7.52579", "%G",
+__LINE__, 7.528655653725963e+06, "7.5287e+06", "%3.4e",
+__LINE__, 7.533217421035612e+28, "75332174210356122046050586504.861712", "%f",
+__LINE__, 7.534147071756384e+03, "7534.15", "%g",
+__LINE__, 7.542648637430919e-25, "+0.000000", "%+#f",
+__LINE__, 7.554380140947798e-15, " 8e-15", "%7.g",
+__LINE__, 7.557366996007743e+25, " 8E+25", "%7.G",
+__LINE__, 7.579228950138068e+08, "8e+08", "%3.e",
+__LINE__, 7.579773904052487e-13, "0.000000", "%3f",
+__LINE__, 7.580377544554059e+27, "7.58038e+27", "%#g",
+__LINE__, 7.589615147875915e-15, "7.59E-15", "%.3G",
+__LINE__, 7.593317194045158e-12, "+0.", "%+#1.f",
+__LINE__, 7.605535657484387e-07, "7.60554E-07", "%G",
+__LINE__, 7.609171121278006e-08, " 0", "%5.f",
+__LINE__, 7.612033900317304e-14, "7.61203e-14", "%g",
+__LINE__, 7.628040858080326e+23, "+7.62804e+23", "%+g",
+__LINE__, 7.632109382948695e-01, "0.763211", "%#f",
+__LINE__, 7.633415922627254e+28, "76334159226272539910951309138.908982", "%#f",
+__LINE__, 7.636190400774419e+22, "+7.636190E+22", "%+E",
+__LINE__, 7.636228368661314e-23, "0.000000", "%f",
+__LINE__, 7.653292362739654e-17, "7.65329E-17", "%#G",
+__LINE__, 7.664044705231460e+03, "7.664045E+03", "%5E",
+__LINE__, 7.664257283149626e-05, "7.66426E-05", "%0G",
+__LINE__, 7.668996632821614e-19, " 0.0", "%4.1f",
+__LINE__, 7.674502669497263e-24, "7.6745e-24", "%g",
+__LINE__, 7.681870119755193e+12, "+7.68187e+12", "%+#g",
+__LINE__, 7.693453198401315e+02, "769.3453198", "%5.7f",
+__LINE__, 7.705080073293603e-29, "7.705080E-29", "%1E",
+__LINE__, 7.707244083934683e-07, "7.71E-07", "%2.3G",
+__LINE__, 7.749445584970652e-17, "7.75E-17", "%6.3G",
+__LINE__, 7.755369447889403e+09, "7.8e+09", "%#4.2g",
+__LINE__, 7.760378169707072e-06, "7.76038e-06", "%g",
+__LINE__, 7.763518882114968e-10, "0.000000", "%f",
+__LINE__, 7.764720069569677e-18, "0.000000", "%0f",
+__LINE__, 7.768821339438552e-03, "0.00776882", "%g",
+__LINE__, 7.774767835990679e-29, "7.774768E-29", "%7E",
+__LINE__, 7.805567188246987e-04, "0.000780557", "%2G",
+__LINE__, 7.825157442935941e-26, "0.000000", "%f",
+__LINE__, 7.833373563161910e+29, "+783337356316190991378789476584.643126", "%+f",
+__LINE__, 7.875872661746674e-16, "7.875873E-16", "%E",
+__LINE__, 7.880664458920439e-28, "7.881E-28", "%#0.3E",
+__LINE__, 7.893084198630288e+18, "7893084198630288206", "%1.f",
+__LINE__, 7.912222737877417e+04, "79122.2", "%G",
+__LINE__, 7.913004582748724e-26, "0.000000", "%f",
+__LINE__, 7.913749944463836e+17, "791374994446383617.230367", "%f",
+__LINE__, 7.923881665760883e-24, "0.000000", "%f",
+__LINE__, 7.926699779993694e-03, "0.007927", "%5.6f",
+__LINE__, 7.941991860623354e-20, "7.941992e-20", "%e",
+__LINE__, 7.942700358097138e+17, "794270035809713803.587329", "%2f",
+__LINE__, 7.945451569935757e-16, "7.94545E-16", "%#4.6G",
+__LINE__, 7.948277588625241e-04, "0", "%.0f",
+__LINE__, 7.952265062569124e+21, "+7.95227e+21", "%+#g",
+__LINE__, 7.959953534668040e+11, "8e+11", "%2.e",
+__LINE__, 7.962059154424500e-22, "7.96206E-22", "%G",
+__LINE__, 7.962856142535673e-26, "7.9629E-26", "%#.5G",
+__LINE__, 7.966528574505771e+12, "7.96653e+12", "%g",
+__LINE__, 8.006496880305429e-21, "8.0065E-21", "%G",
+__LINE__, 8.023374861440542e+06, "+8023375", "%+6.f",
+__LINE__, 8.041139717082990e-20, "8.04114e-20", "%g",
+__LINE__, 8.044201752824126e+15, "8.04420E+15", "%.5E",
+__LINE__, 8.044262927409321e-10, "+8E-10", "%+2.2G",
+__LINE__, 8.058285708061202e+02, "+8.058286e+02", "%+e",
+__LINE__, 8.104422320765144e+10, "8.10442e+10", "%#4g",
+__LINE__, 8.104572628022330e-11, "0.000000", "%f",
+__LINE__, 8.112156369917432e+15, "+8.11216E+15", "%+G",
+__LINE__, 8.114566569709531e-18, "8.11457E-18", "%G",
+__LINE__, 8.114795069552519e+13, "8.114795E+13", "%E",
+__LINE__, 8.121382719830660e+03, "8121.382720", "%f",
+__LINE__, 8.125179335533733e-12, "+8.125179e-12", "%+e",
+__LINE__, 8.126383949107055e+19, "81263839491070548604.056967", "%f",
+__LINE__, 8.129961701307842e-04, "+0.00081", "%+5.2g",
+__LINE__, 8.143780077390936e+15, "8.14378E+15", "%G",
+__LINE__, 8.149891507777399e+16, "+8E+16", "%+1.G",
+__LINE__, 8.167395708830107e+03, "8167", "%3.f",
+__LINE__, 8.167703619221975e+01, "81.677", "%G",
+__LINE__, 8.178463030771759e+06, "+8.17846E+06", "%+G",
+__LINE__, 8.188188531273697e+12, "8.18819E+12", "%G",
+__LINE__, 8.189094866416537e+11, "+8E+11", "%+.1G",
+__LINE__, 8.205086844365809e-18, "+8.205087E-18", "%+#E",
+__LINE__, 8.205762333408320e-26, "0.000000", "%f",
+__LINE__, 8.212370598174696e-10, "8.2124E-10", "%.5G",
+__LINE__, 8.228054316085489e-14, "0.000000", "%3f",
+__LINE__, 8.244313484402404e-16, "8.24431e-16", "%g",
+__LINE__, 8.244472235472472e+19, "8.24447E+19", "%G",
+__LINE__, 8.245421473302411e-09, "+8.2454e-09", "%+1.5g",
+__LINE__, 8.252286626634840e-22, "8E-22", "%3.G",
+__LINE__, 8.259969177912707e-19, "0.000000", "%f",
+__LINE__, 8.265769991725211e+18, "8.26577e+18", "%.5e",
+__LINE__, 8.293986939496488e+25, "8.3E+25", "%.1E",
+__LINE__, 8.310348813512608e-23, "+8.31035e-23", "%+g",
+__LINE__, 8.316951996533247e-20, "0.000000", "%f",
+__LINE__, 8.318818016883803e+05, " 8e+05", "%6.1g",
+__LINE__, 8.324896920131877e-13, "+8.324897e-13", "%+e",
+__LINE__, 8.325228630004624e-03, "0.0083252", "%5.7f",
+__LINE__, 8.332538660129034e+14, "8.3e+14", "%5.2g",
+__LINE__, 8.343325212751775e+07, "8.34333e+07", "%#4g",
+__LINE__, 8.363117398136236e+20, "+8.36e+20", "%+.3g",
+__LINE__, 8.364181324448165e+27, "8.36418e+27", "%#g",
+__LINE__, 8.372159259848738e+10, "8.37216e+10", "%4g",
+__LINE__, 8.379252006152759e-26, "8.37925e-26", "%g",
+__LINE__, 8.392670395720252e+09, "8392670395.720252", "%f",
+__LINE__, 8.423360059147756e+05, "+842336.", "%+#G",
+__LINE__, 8.425921213167943e+09, "8.425921e+09", "%1.7g",
+__LINE__, 8.431664412515776e-16, "8.43166E-16", "%#G",
+__LINE__, 8.448608859842500e+02, "844.861", "%1.3f",
+__LINE__, 8.456292247478771e-14, "8.45629E-14", "%G",
+__LINE__, 8.460077225296853e-04, "0.000846008", "%G",
+__LINE__, 8.478635925746218e-10, "0.000000", "%f",
+__LINE__, 8.492455774427448e+06, "8.49246e+06", "%g",
+__LINE__, 8.494450528380746e-07, "8.494451e-07", "%e",
+__LINE__, 8.516435842947605e-23, "+0.000000", "%+1f",
+__LINE__, 8.519057789029134e-18, "0.000000", "%0f",
+__LINE__, 8.522602111109066e+18, " 9.e+18", "%#7.g",
+__LINE__, 8.529176788022152e-24, "8.529E-24", "%0.4G",
+__LINE__, 8.534979605642793e-07, "0.000001", "%f",
+__LINE__, 8.546859563634342e-07, "8.546860E-07", "%E",
+__LINE__, 8.552370027054106e+12, "9e+12", "%.0g",
+__LINE__, 8.561781328234041e+10, "8.56178e+10", "%4g",
+__LINE__, 8.562688793145107e-20, "8.562689e-20", "%1.7g",
+__LINE__, 8.573130147270046e-07, " 9E-07", "%7.G",
+__LINE__, 8.584571984387802e-18, "8.5846e-18", "%.5g",
+__LINE__, 8.596407996491291e+11, "8.596408E+11", "%#E",
+__LINE__, 8.604843726850381e+10, " 9E+10", "%6.G",
+__LINE__, 8.626884271938994e-23, "8.62688e-23", "%g",
+__LINE__, 8.631140282429168e+24, "8631140282429168308908629.", "%#.0f",
+__LINE__, 8.635194331917948e-16, "8.63519E-16", "%G",
+__LINE__, 8.641417311588688e-24, "+0.000000", "%+f",
+__LINE__, 8.649120264278466e+26, "8.65E+26", "%1.3G",
+__LINE__, 8.649745523383894e+06, "8.649746e+06", "%e",
+__LINE__, 8.654720740091021e+16, "8.65472e+16", "%g",
+__LINE__, 8.655445556834509e-08, "9e-08", "%4.g",
+__LINE__, 8.658954696751902e+06, "8.65895E+06", "%G",
+__LINE__, 8.665712368800818e-10, "+8.66571E-10", "%+G",
+__LINE__, 8.666937057116442e-10, "8.666937e-10", "%e",
+__LINE__, 8.670981239765155e+05, "867098", "%G",
+__LINE__, 8.679631934294932e-25, "+9.E-25", "%+#0.G",
+__LINE__, 8.683595173050962e-21, "8.68360E-21", "%#G",
+__LINE__, 8.684938704958039e+25, "8.684939E+25", "%E",
+__LINE__, 8.686745463281227e-12, "8.686745E-12", "%5.7G",
+__LINE__, 8.700227628706534e-12, "8.700228e-12", "%#e",
+__LINE__, 8.705101179577200e+04, "87051.011796", "%#2f",
+__LINE__, 8.707824829984700e-24, "9e-24", "%.1g",
+__LINE__, 8.717654041009233e+21, "+9E+21", "%+6.0E",
+__LINE__, 8.741736299906572e-11, "8.74174E-11", "%#0G",
+__LINE__, 8.742228350419966e+18, "+8742228350419965821.060941", "%+f",
+__LINE__, 8.743045146087558e-17, "+8.74305E-17", "%+2G",
+__LINE__, 8.747820269457588e+18, "8.74782E+18", "%G",
+__LINE__, 8.756274717008537e-28, "8.756275E-28", "%E",
+__LINE__, 8.769782309254687e-24, "+8.769782E-24", "%+2.6E",
+__LINE__, 8.788151659193398e-16, " 9E-16", "%6.E",
+__LINE__, 8.789514812202340e-07, "9E-07", "%0.G",
+__LINE__, 8.792657843164822e-07, "8.79266e-07", "%0g",
+__LINE__, 8.810976223440985e+05, "881097.622344", "%f",
+__LINE__, 8.822553973113614e+10, "8.82255E+10", "%G",
+__LINE__, 8.839440421530611e-04, "0.000883944", "%G",
+__LINE__, 8.842539073558434e-12, "0", "%1.f",
+__LINE__, 8.882818021261782e-13, "+8.9e-13", "%+4.2g",
+__LINE__, 8.899833909201039e+05, "8.8998E+05", "%.5G",
+__LINE__, 8.903167498000181e-13, "9e-13", "%0.g",
+__LINE__, 8.933727737932164e+09, "+8933727738", "%+4.f",
+__LINE__, 8.946226267100711e+06, "8.946E+06", "%1.4G",
+__LINE__, 8.953203780849794e-21, "8.9532E-21", "%G",
+__LINE__, 8.959934262635649e+28, "+8.959934e+28", "%+e",
+__LINE__, 8.969485341781558e-25, "0.000000", "%#f",
+__LINE__, 8.970058187654221e+02, "897.005819", "%f",
+__LINE__, 8.979846508565979e+02, "8.979847E+02", "%E",
+__LINE__, 8.984561117901212e+01, "8.984561E+01", "%E",
+__LINE__, 8.992157765875611e-12, "8.99216e-12", "%g",
+__LINE__, 9.004487016708012e+01, "9.004487e+01", "%#e",
+__LINE__, 9.007306978283218e-24, "9.007307e-24", "%e",
+__LINE__, 9.014546375043562e+17, "901454637504356171.007203", "%#3f",
+__LINE__, 9.028177786002161e-12, "9.02818E-12", "%G",
+__LINE__, 9.029635986381795e-02, "0.09", "%.1g",
+__LINE__, 9.032389962233431e-07, "+0.000001", "%+f",
+__LINE__, 9.038466945070887e+10, "+9.038467E+10", "%+E",
+__LINE__, 9.040166964322772e-27, "9.04017e-27", "%g",
+__LINE__, 9.044627673694681e-11, "9.04463E-11", "%G",
+__LINE__, 9.045906217628948e+17, "904590621762894819.823941", "%1f",
+__LINE__, 9.051764975661710e+11, "9.05176e+11", "%#g",
+__LINE__, 9.053142913711405e+29, "9.053143e+29", "%#e",
+__LINE__, 9.073185209160657e-19, "+9.07319e-19", "%+g",
+__LINE__, 9.074372574441451e+02, "907.437", "%g",
+__LINE__, 9.084624602048136e+08, "9.084625E+08", "%E",
+__LINE__, 9.088839346363631e+18, "9.09e+18", "%.2e",
+__LINE__, 9.091945159170871e-15, "9.09195e-15", "%5g",
+__LINE__, 9.115304318083716e+10, "9.115304e+10", "%e",
+__LINE__, 9.115978352902710e+28, "9.11598E+28", "%G",
+__LINE__, 9.121415008221017e-17, "9.E-17", "%#6.G",
+__LINE__, 9.127270978060388e+18, "9.E+18", "%#5.G",
+__LINE__, 9.143941729069086e+08, "9.143942E+08", "%#E",
+__LINE__, 9.162740105978580e-19, " 9.E-19", "%#7.G",
+__LINE__, 9.221509957559626e-18, "9.22151e-18", "%g",
+__LINE__, 9.227419774250317e-28, " 0.", "%#3.f",
+__LINE__, 9.230846660807540e-21, "0.000000", "%f",
+__LINE__, 9.238091727277130e-06, "+0.00001", "%+.5f",
+__LINE__, 9.244337357684406e+10, "9E+10", "%5.G",
+__LINE__, 9.259179793993285e-19, " 9E-19", "%7.0G",
+__LINE__, 9.274068541525759e-17, "9.274069e-17", "%e",
+__LINE__, 9.283833535882367e+16, "9.28383e+16", "%#g",
+__LINE__, 9.295693096364605e+11, "+9.295693E+11", "%+E",
+__LINE__, 9.301820438602407e+05, "930182", "%G",
+__LINE__, 9.322805251555376e-29, "9e-29", "%1.e",
+__LINE__, 9.358443042421307e-27, "9.35844e-27", "%g",
+__LINE__, 9.372658444745124e-23, "9.372658e-23", "%e",
+__LINE__, 9.380302971355292e+05, "938030.3", "%.7g",
+__LINE__, 9.381976354968076e-26, "+9.382E-26", "%+5.4G",
+__LINE__, 9.391072061980585e-15, "9.391072E-15", "%E",
+__LINE__, 9.403554117166546e-06, "0.000009", "%f",
+__LINE__, 9.403712900426614e-28, "9.40371e-28", "%g",
+__LINE__, 9.419046629820578e+03, "9419.046630", "%f",
+__LINE__, 9.422344695378412e+22, "94223446953784115720509.362291", "%f",
+__LINE__, 9.433327680467576e+01, "9.433328e+01", "%e",
+__LINE__, 9.443975205260596e+20, "9.44398e+20", "%g",
+__LINE__, 9.445134851965593e-04, "+9.445135E-04", "%+E",
+__LINE__, 9.448403585149890e+24, "9e+24", "%0.g",
+__LINE__, 9.463149430113036e+18, "9.46315e+18", "%g",
+__LINE__, 9.465735160722534e+27, "+9465735160722534402566452627.070248", "%+f",
+__LINE__, 9.495210794344892e-04, "0.000950", "%f",
+__LINE__, 9.501916506373814e-25, "9.50192E-25", "%#G",
+__LINE__, 9.514641335897739e+29, "9.51464E+29", "%G",
+__LINE__, 9.524633436992819e-04, " 0.001", "%6.G",
+__LINE__, 9.530925101873022e-18, "9.530925e-18", "%2e",
+__LINE__, 9.557903833216979e-22, "9.557904E-22", "%E",
+__LINE__, 9.587709102390903e-01, " 1", "%2.f",
+__LINE__, 9.592723000828453e-02, "9.592723E-02", "%5E",
+__LINE__, 9.603430008794172e+27, "9.60343e+27", "%g",
+__LINE__, 9.622648414989433e-18, "9.622648e-18", "%1e",
+__LINE__, 9.633326171289319e-23, "9.633326e-23", "%e",
+__LINE__, 9.662064616152408e+19, "96620646161524081918.5146393", "%1.7f",
+__LINE__, 9.668544846563163e-23, "9.668545e-23", "%e",
+__LINE__, 9.691014191346685e+28, "9.69101E+28", "%G",
+__LINE__, 9.693075414840598e+02, "+969.308", "%+G",
+__LINE__, 9.695013453291907e-30, "9.695013e-30", "%5e",
+__LINE__, 9.705983477801926e-24, "9.70598e-24", "%g",
+__LINE__, 9.709022568030226e-17, "0.000000", "%f",
+__LINE__, 9.715194901854826e+20, "9.715195e+20", "%e",
+__LINE__, 9.721011821337717e+16, "1E+17", "%0.G",
+__LINE__, 9.734895542899672e+14, "9.734896e+14", "%e",
+__LINE__, 9.741486438769710e-29, " 1e-28", "%6.g",
+__LINE__, 9.766657482315475e-24, "9.76666E-24", "%7G",
+__LINE__, 9.767283293054552e-02, "0.09767", "%5.5f",
+__LINE__, 9.769553159146005e-20, "9.76955E-20", "%G",
+__LINE__, 9.777220880605434e-10, "0.00", "%4.2f",
+__LINE__, 9.790290569034575e+20, "979029056903457473027.", "%#6.f",
+__LINE__, 9.793128245822718e-01, "0.979313", "%G",
+__LINE__, 9.804758536498200e+08, "980475853.650", "%.3f",
+__LINE__, 9.816883664191066e-02, "0.1", "%.0g",
+__LINE__, 9.836109821010300e+25, "9.83611e+25", "%g",
+__LINE__, 9.846197559631225e+03, "1E+04", "%2.G",
+__LINE__, 9.863289416819924e+12, "9.86329e+12", "%g",
+__LINE__, 9.865893798657353e+12, "9.866e+12", "%0.4g",
+__LINE__, 9.868248446640862e-15, "0.000000", "%#f",
+__LINE__, 9.869973080775134e+04, "98699.7", "%G",
+__LINE__, 9.899444006312953e+20, "1E+21", "%.1G",
+__LINE__, 9.904083146074285e-08, "9.904083e-08", "%6e",
+__LINE__, 9.909790408255471e+15, "9909790408255471.305665", "%f",
+__LINE__, 9.930297455798394e-13, "+9.930297E-13", "%+5.6E",
+__LINE__, 9.933314448709083e-15, "9.93331E-15", "%#.6G",
+__LINE__, 9.938714530509870e+29, "9.938715e+29", "%e",
+__LINE__, 9.953892603540162e+07, "9.95389E+07", "%G",
+__LINE__, 9.962084643867200e+14, "+996208464386720.038419", "%+f",
+__LINE__, 9.977706708809947e-09, "9.9777E-09", "%#.4E",
+#endif
+__LINE__, 9.978034352999867e+15, "9.978034e+15", "%2.6e",
+__LINE__, 9.998315286730175e-30, "9.998315e-30", "%6e",
+
+0
+};
+
+/* matches(s1, s2) is true if s1 is "approximately" equal to s2.
+ Any digits after the first required_precision digits do not have to match.
+ */
+
+int required_precision = 13;
+
+#if defined(__STDC__) || defined(__cplusplus)
+int matches(register char *result, register char *desired)
+#else
+int matches(result, desired)
+ register char *result; register char *desired;
+#endif
+{
+ int digits_seen = 0;
+ for (;; result++, desired++) {
+ if (*result == *desired) {
+ if (*result == 0)
+ return 1;
+ else if (*result >= '0' && *result <= '9')
+ digits_seen++;
+ }
+ else if (digits_seen >= required_precision
+ && *result >= '0' && *result <= '9'
+ && *desired >= '0' && *desired <= '9')
+ continue;
+ else
+ return 0;
+ }
+}
+
+extern void dump_stats();
+
+int main()
+{
+ int errcount = 0;
+ int testcount = 0;
+ double d;
+#define BSIZE 1024
+ char buffer[BSIZE];
+ sprint_double_type *dptr;
+
+ /* This test demands more precision than a 32bit floating
+ point format can provide. So only run it if doubles
+ are last least 64bits wide. */
+ if (sizeof (double) < 8)
+ exit (0);
+
+#if defined(__cplusplus) && !defined(TEST_LIBIO)
+
+ strstream sstr(buffer, BSIZE, ios::in|ios::out);
+
+ for (dptr = sprint_doubles; dptr->line; dptr++)
+ {
+
+#ifdef SLOW_SIMULATOR
+ /* We only run half the tests if we have a slow simulator to
+ avoid dejagnu timeouts. */
+ if (testcount % 2)
+ {
+ testcount++;
+ continue;
+ }
+#endif
+
+ sstr.seekp(0);
+ sstr.form(dptr->format_string, dptr->value);
+ sstr << ends;
+ if (!matches(buffer, dptr->result))
+ {
+ errcount++;
+ cerr << "Error in line " << dptr->line;
+ cerr << " using \"" << dptr->format_string;
+ cerr << "\". Result is \"" << buffer << "\"; should be: \"";
+ cerr << dptr->result << "\".\n";
+ }
+
+#ifdef TEST_EXACTNESS
+ sstr.seekp(0);
+ sstr.form("%.999g", dptr->value);
+ sstr << ends;
+
+ sstr.seekg(0);
+ sstr.scan("%lg", &d);
+
+ if (dptr->value != d)
+ {
+ errcount++;
+ cerr << "Error in line " << dptr->line;
+ cerr << ". String is \"" << buffer << "\", value is " << d << ".\n";
+ }
+#endif
+ testcount++;
+ }
+
+#ifdef SLOW_SIMULATOR
+ testcount /= 2;
+#endif
+
+ if (errcount == 0)
+ {
+ cerr << "Encountered no errors in " << testcount << " tests.\n";
+ return 0;
+ }
+ else
+ {
+ cerr << "Encountered " << errcount << " errors in "
+ << testcount << " tests.\n";
+ return 1;
+ }
+#else
+ for (dptr = sprint_doubles; dptr->line; dptr++)
+ {
+#ifdef SLOW_SIMULATOR
+ /* We only run half the tests if we have a slow simulator to
+ avoid dejagnu timeouts. */
+ if (testcount % 2)
+ {
+ testcount++;
+ continue;
+ }
+#endif
+
+ sprintf (buffer, dptr->format_string, dptr->value);
+ if (!matches(buffer, dptr->result))
+ {
+ errcount++;
+ fprintf(stderr,
+ "Error in line %d using \"%s\". Result is \"%s\"; should be: \"%s\".\n",
+ dptr->line, dptr->format_string, buffer, dptr->result);
+ }
+
+#ifdef TEST_EXACTNESS
+ sprintf (buffer, "%.999g", dptr->value);
+ sscanf (buffer, "%lg", &d);
+ if (dptr->value != d)
+ {
+ errcount++;
+ fprintf (stderr,
+ "Error in line %d. String is \"%s\", value is %g.\n",
+ dptr->line, buffer, d);
+ }
+#endif
+ testcount++;
+ }
+
+#ifdef SLOW_SIMULATOR
+ testcount /= 2;
+#endif
+
+ if (errcount == 0)
+ {
+ fprintf(stderr, "Encountered no errors in %d tests.\n", testcount);
+ return 0;
+ }
+ else
+ {
+ fprintf(stderr, "Encountered %d errors in %d tests.\n",
+ errcount, testcount);
+ return 1;
+ }
+#endif
+}
diff --git a/libio/tests/tiformat.c b/libio/tests/tiformat.c
new file mode 100644
index 00000000000..78d09cedc23
--- /dev/null
+++ b/libio/tests/tiformat.c
@@ -0,0 +1,5112 @@
+#ifdef TEST_LIBIO
+#include <iostdio.h>
+#else
+#ifdef __cplusplus
+#include <strstream.h>
+#else
+#include <stdio.h>
+#endif
+#endif /* !TEST_LIBIO */
+#include <string.h>
+
+/* Tests taken from Cygnus C library. */
+typedef struct {
+ int line;
+ long value;
+ char *result;
+ char *format_string;
+} sprint_int_type;
+
+sprint_int_type sprint_ints[] =
+{
+__LINE__, 0x000838d2L, "838d2", "%.4x",
+__LINE__, 0x0063be46L, "63BE46", "%-6X",
+__LINE__, -0x1b236c0L, "-28456640", "%#0.d",
+__LINE__, -0x0000003L, "-3", "% 0d",
+__LINE__, 0x0000ed51L, "ed51", "%2.x",
+__LINE__, -0x00001f2L, "-498", "%1ld",
+__LINE__, 0x0ea3e927L, "EA3E927", "%+X",
+__LINE__, 0xffbef8daL, "FFBEF8DA", "%5X",
+__LINE__, 0x62ff9f56L, "62ff9f56", "%0x",
+__LINE__, 0x00000ad2L, "AD2", "%.0X",
+__LINE__, 0x00000000L, " ", "% 6.ld",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%1.4X",
+__LINE__, 0x0000208cL, " 208C", "%5X",
+__LINE__, 0x0000003cL, "3c", "%x",
+__LINE__, 0xffff6177L, "0xffff6177", "%+#x",
+__LINE__, 0xffffdc8dL, "ffffdc8d", "%+x",
+__LINE__, 0x00000000L, "0", "%X",
+__LINE__, 0x00002434L, "9268", "%0d",
+__LINE__, 0xd2c72cdbL, "d2c72cdb", "%-x",
+__LINE__, 0xfe38012bL, "0xfe38012b", "%+#7x",
+__LINE__, 0x00000001L, "0001", "%#.4d",
+__LINE__, -0x008525aL, "-0545370", "%06.7ld",
+__LINE__, 0xffffffacL, "ffffffac", "%3.7x",
+__LINE__, 0x007424d2L, "+7611602", "%+ld",
+__LINE__, 0x00001a85L, "1A85", "%.4X",
+__LINE__, -0x0000019L, "-25", "%3.d",
+__LINE__, 0xfffffffeL, "fffffffe", "%-x",
+__LINE__, -0x34473b2L, "-54817714", "% d",
+__LINE__, 0x000000eaL, "234", "%1.ld",
+__LINE__, -0x0000004L, "-4 ", "%-7.ld",
+__LINE__, 0x00006c94L, "27796", "%0d",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, 0x00000619L, "619", "%1x",
+__LINE__, 0x0000209cL, "8348", "%ld",
+__LINE__, -0x327f8ffL, "-52951295", "%-0ld",
+__LINE__, 0xffffff0bL, "FFFFFF0B", "%2.X",
+__LINE__, 0xf199d6aeL, "F199D6AE", "%X",
+__LINE__, 0x3ca5602eL, "1017471022", "%-1.ld",
+__LINE__, -0xfb2080bL, "-263325707", "%3.5d",
+__LINE__, 0x00001cb8L, "7352", "%d",
+__LINE__, 0x00000000L, "0000000", "%3.7d",
+__LINE__, 0xffffff40L, "FFFFFF40", "%+X",
+__LINE__, 0x14664450L, "0x14664450", "%#x",
+__LINE__, 0x0000002eL, "2e", "%1x",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, 0xffff606aL, "0XFFFF606A", "%#X",
+__LINE__, 0xffffff33L, "0XFFFFFF33", "%#X",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, -0x0000012L, "-00018", "%-2.5d",
+__LINE__, 0x0001fbe6L, "130022", "%1.d",
+__LINE__, 0xfff59dd9L, "fff59dd9", "%+x",
+__LINE__, 0x00000002L, "2", "%0.0d",
+__LINE__, 0x00000fe1L, "fe1 ", "%-7.x",
+__LINE__, 0x001f8f6aL, "1F8F6A", "%1.X",
+__LINE__, 0x0000001bL, "000001B", "%04.7X",
+__LINE__, 0x126a2609L, " 308946441", "% 4d",
+__LINE__, 0xffffffe3L, "0XFFFFFFE3", "%+#.1X",
+__LINE__, 0x1858f1c9L, "1858f1c9", "%.3x",
+__LINE__, 0x003fc672L, "3fc672", "%1x",
+__LINE__, 0x00c0bddcL, "12631516", "%#d",
+__LINE__, 0x000006d6L, "1750", "%#d",
+__LINE__, 0x000006a0L, "6A0", "%X",
+__LINE__, 0x000007beL, "7BE", "%X",
+__LINE__, -0x1c7cd1aL, "-29871386", "%ld",
+__LINE__, 0x000000ccL, "204", "%ld",
+__LINE__, 0x000002dbL, "731 ", "%-#5d",
+__LINE__, 0xffff67adL, "FFFF67AD", "% X",
+__LINE__, 0x00000008L, "8", "%d",
+__LINE__, 0xffe07007L, "FFE07007", "%5X",
+__LINE__, -0x0000001L, " -1", "% 7d",
+__LINE__, 0xfffffffeL, "fffffffe", "%x",
+__LINE__, 0x00027b68L, "+162664", "%+ld",
+__LINE__, 0x0a7c1997L, "+175905175", "%+2ld",
+__LINE__, 0xfe300896L, "fe300896", "%.4x",
+__LINE__, 0x00000537L, "537", "%-0.x",
+__LINE__, 0x3e981779L, "3e981779", "%.6x",
+__LINE__, 0xfffff05eL, "FFFFF05E", "%1.0X",
+__LINE__, -0x07bc0cfL, "-8110287", "%-7d",
+__LINE__, -0x01371bcL, "-1274300", "%.7ld",
+__LINE__, -0x0000013L, "-19", "%.2ld",
+__LINE__, 0x000000d1L, "0xd1", "%#x",
+__LINE__, -0x0000003L, "-3", "%-ld",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%4.1X",
+__LINE__, 0x00000000L, "0", "%ld",
+__LINE__, 0x0001c8afL, "116911", "%d",
+__LINE__, 0x000048c3L, "48C3", "%X",
+__LINE__, 0x00000079L, "0x0000079", "%-#0.7x",
+__LINE__, 0x0000615aL, " 24922", "% d",
+__LINE__, 0xfffffff5L, "fffffff5", "%x",
+__LINE__, 0x00000308L, "0000308", "%+07.7x",
+__LINE__, 0xfcadc983L, "fcadc983", "%x",
+__LINE__, 0x00000097L, "151", "%#d",
+__LINE__, 0x000001c5L, "453", "%0.2ld",
+__LINE__, 0x00000000L, "00", "%-1.2x",
+__LINE__, 0x00000001L, "+1", "%+02.d",
+__LINE__, 0x01eb4354L, "1EB4354", "% X",
+__LINE__, 0xffffa7d1L, "ffffa7d1", "%5.x",
+__LINE__, 0x0003170eL, "0x3170e", "%#x",
+__LINE__, 0x000001ceL, "1CE", "% .2X",
+__LINE__, 0x3a2991fbL, "975802875", "%d",
+__LINE__, -0xcdad8e2L, "-215668962", "%-d",
+__LINE__, 0xfe0261c3L, "fe0261c3", "%x",
+__LINE__, -0x0006ea7L, "-28327", "% ld",
+__LINE__, 0x032854a3L, "0X32854A3", "% #6X",
+__LINE__, 0x0000004bL, "4b", "%x",
+__LINE__, 0xffff6ca3L, "FFFF6CA3", "%4.X",
+__LINE__, 0x00000000L, "0", "%X",
+__LINE__, 0x00611f04L, "611F04", "%.1X",
+__LINE__, 0x00000000L, " 0", "%#6d",
+__LINE__, 0x0002c711L, "2c711", "%-02.x",
+__LINE__, -0x07a2fe4L, "-8007652", "%d",
+__LINE__, -0x0000547L, "-1351", "%ld",
+__LINE__, 0x00013954L, "0x13954", "%#x",
+__LINE__, -0x00523b7L, "-336823", "%ld",
+__LINE__, -0x00f6c6eL, "-1010798", "%6.ld",
+__LINE__, 0xffea6427L, "FFEA6427", "%3X",
+__LINE__, -0x0000005L, "-5", "%d",
+__LINE__, -0x04fe618L, "-5236248", "% .7d",
+__LINE__, 0xffa80a28L, "ffa80a28", "%-0x",
+__LINE__, 0x00000047L, "71", "%ld",
+__LINE__, 0x001dc6bbL, "1951419", "%#4ld",
+__LINE__, 0x00000868L, " 2152", "%#6d",
+__LINE__, 0x000002fbL, "2fb", "%x",
+__LINE__, 0x00607fa0L, "6324128", "%4d",
+__LINE__, 0xfffed161L, "fffed161", "%x",
+__LINE__, 0x0001c6e4L, " 116452", "% 2.5d",
+__LINE__, 0x0003dda8L, "3DDA8", "%4X",
+__LINE__, 0xfffffff8L, "fffffff8", "%x",
+__LINE__, 0xfacf664aL, "facf664a", "%x",
+__LINE__, 0x000000c1L, "C1", "% 1X",
+__LINE__, 0x0000839cL, " 839C", "%6X",
+__LINE__, 0xfffff69aL, "FFFFF69A", "%X",
+__LINE__, 0x000e5c2eL, "+941102", "%+d",
+__LINE__, -0x0000004L, "-4", "%#d",
+__LINE__, 0x00000000L, "00000", "%#.5ld",
+__LINE__, 0xfffffffeL, "fffffffe", "%3.1x",
+__LINE__, 0x0010ed68L, "1109352", "%-ld",
+__LINE__, 0xffffffe9L, "ffffffe9", "%.6x",
+__LINE__, 0x00000007L, " 7", "% 4.ld",
+__LINE__, 0x0000cabaL, "51898", "%ld",
+__LINE__, -0x0000119L, "-281", "% d",
+__LINE__, 0x0c3012a9L, "204477097", "%03.6ld",
+__LINE__, -0x001c98fL, "-117135", "%ld",
+__LINE__, 0x000017b1L, "+6065", "%+d",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, -0x0000019L, "-25", "% .2d",
+__LINE__, 0x0009ae28L, "9AE28", "%X",
+__LINE__, 0xe861c4feL, "e861c4fe", "%7.x",
+__LINE__, 0xffac88d3L, "FFAC88D3", "%X",
+__LINE__, -0x00005dfL, "-01503", "%-5.5ld",
+__LINE__, 0x0000013eL, "318", "%-0d",
+__LINE__, 0x04b6f58fL, "4b6f58f", "%x",
+__LINE__, 0xfffe3978L, "fffe3978", "%+0.6x",
+__LINE__, 0x57ee5244L, "57ee5244", "%+7.4x",
+__LINE__, 0xfffb5610L, "fffb5610", "% 6x",
+__LINE__, 0x00000006L, " 6", "%#7d",
+__LINE__, 0x0000000cL, "0x0000c", "%#.5x",
+__LINE__, -0xec59362L, "-247829346", "%1.7d",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, -0x0007e4bL, "-32331", "% d",
+__LINE__, 0x0ececa6fL, "248433263", "%0d",
+__LINE__, 0x00000578L, " 578", "%+6.x",
+__LINE__, -0x0000003L, "-3", "%ld",
+__LINE__, 0x000002bbL, "2bb", "% 0x",
+__LINE__, -0x0000006L, "-6", "%-ld",
+__LINE__, 0x000002f9L, "761", "%d",
+__LINE__, 0xffffd736L, "ffffd736", "%3.4x",
+__LINE__, 0x0010ba79L, "1096313", "%7.4d",
+__LINE__, -0x0001244L, "-4676", "%#.1d",
+__LINE__, 0x00000dbeL, "DBE", "%1X",
+__LINE__, -0x0000015L, "-21", "%-0.d",
+__LINE__, 0xffffffffL, "0xffffffff", "%#x",
+__LINE__, -0x6cdf4a3L, "-114160803", "%ld",
+__LINE__, 0x00008ac9L, "8AC9", "%1X",
+__LINE__, 0x00000000L, "00", "%.2X",
+__LINE__, -0x2263dbaL, "-36060602", "%5.5d",
+__LINE__, 0x00007da9L, "32169", "%0d",
+__LINE__, 0xfffffff7L, "FFFFFFF7", "% 4.X",
+__LINE__, 0xfbf36ccaL, "FBF36CCA", "%.1X",
+__LINE__, 0x00000040L, "64", "%.0ld",
+__LINE__, 0x0000001cL, " 28", "% d",
+__LINE__, 0xfffffadbL, "0xfffffadb", "%#.5x",
+__LINE__, 0x0eb95847L, "247027783", "%d",
+__LINE__, 0xfffd7030L, "FFFD7030", "%+02X",
+__LINE__, 0x00000005L, "00005", "%.5x",
+__LINE__, 0xfffffffdL, "FFFFFFFD", "%X",
+__LINE__, 0x98975b15L, "98975B15", "%02X",
+__LINE__, -0x0000034L, " -52", "%6ld",
+__LINE__, 0xffd7d0ccL, "ffd7d0cc", "% 5.6x",
+__LINE__, 0xffffffa6L, "FFFFFFA6", "%X",
+__LINE__, 0xfff27132L, "fff27132", "%x",
+__LINE__, -0x065b74dL, "-6666061", "%+6ld",
+__LINE__, 0xf6ac99d6L, "0XF6AC99D6", "%#X",
+__LINE__, 0xfffff4bdL, "FFFFF4BD", "%X",
+__LINE__, 0xfffffb62L, "FFFFFB62", "%6X",
+__LINE__, 0xf8434543L, "f8434543", "%-0x",
+__LINE__, 0x0002b374L, "0x2b374", "%-#6x",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0xffb5751dL, "ffb5751d", "%-3.x",
+__LINE__, 0x34ea7347L, "887780167", "%d",
+__LINE__, -0x008f457L, "-586839", "%0ld",
+__LINE__, 0x00000001L, " 1", "%#4d",
+__LINE__, 0xc32d7ad4L, "c32d7ad4", "%0x",
+__LINE__, 0xfffffb80L, "FFFFFB80", "%-.2X",
+__LINE__, 0x00000756L, "756 ", "%-6x",
+__LINE__, 0xfffb020fL, "FFFB020F", "%+.2X",
+__LINE__, -0xe68619fL, "-241721759", "%#1.6ld",
+__LINE__, 0x180166cdL, "402745037", "%3.7ld",
+__LINE__, -0x0000001L, "-1", "%+00d",
+__LINE__, 0xfdbc3611L, "fdbc3611", "%x",
+__LINE__, -0x000005bL, "-91", "%d",
+__LINE__, 0xffffe77fL, "ffffe77f", "%x",
+__LINE__, -0x0000019L, "-25", "%ld",
+__LINE__, 0x00000016L, "22", "%#d",
+__LINE__, -0x0000025L, "-37", "%ld",
+__LINE__, 0xffffe43fL, "ffffe43f", "%x",
+__LINE__, 0x000050a5L, "00050a5", "%.7x",
+__LINE__, 0x0000000cL, " 12", "% 5.ld",
+__LINE__, -0x001faffL, "-129791", "%4d",
+__LINE__, 0x239d7cf2L, "597523698", "%0.7ld",
+__LINE__, 0x04092183L, "4092183", "% 7X",
+__LINE__, -0x0043498L, "-275608", "%-ld",
+__LINE__, -0x0018dbeL, "-101822", "%d",
+__LINE__, 0xff3e09c3L, "FF3E09C3", "%X",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, -0x15d57558L, "-366310744", "%+0.7ld",
+__LINE__, 0x0004fb06L, "326406", "%0.0d",
+__LINE__, 0x00000119L, "0X119", "%#X",
+__LINE__, -0x14c53e19L, "-348470809", "%d",
+__LINE__, 0x00000019L, "0000019", "% .7X",
+__LINE__, -0x0000654L, "-1620", "%0.4ld",
+__LINE__, -0xde5899bL, "-233146779", "%#.1d",
+__LINE__, 0x0013c1f0L, "1294832", "%4.ld",
+__LINE__, 0x0a9fe761L, "A9FE761", "%X",
+__LINE__, -0x00000e5L, "-229", "%1ld",
+__LINE__, 0x00000161L, "000353", "%.6ld",
+__LINE__, 0x6b04e4bdL, "0x6b04e4bd", "%#7.0x",
+__LINE__, -0x0000ef0L, "-3824 ", "%-6.ld",
+__LINE__, -0x026306eL, "-2502766", "%ld",
+__LINE__, 0x00000000L, "0", "%-X",
+__LINE__, 0xfffffe1fL, "fffffe1f", "%-x",
+__LINE__, 0x0003aecfL, " 241359", "% 2.1ld",
+__LINE__, -0x0000014L, "-20", "%d",
+__LINE__, 0x00000002L, "0002", "%-.4ld",
+__LINE__, 0xfffff662L, "0XFFFFF662", "% #.6X",
+__LINE__, 0x00000006L, "6", "%0x",
+__LINE__, 0x0001f4c4L, " 128196", "% 0d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%5X",
+__LINE__, 0x05605e38L, "90201656", "%ld",
+__LINE__, 0xffffffdeL, "0XFFFFFFDE", "% #X",
+__LINE__, 0x000001e0L, " 1e0", "%7.x",
+__LINE__, 0x00000007L, "7", "%X",
+__LINE__, 0x00000001L, "+1", "%+d",
+__LINE__, 0xffffffe0L, "FFFFFFE0", "% X",
+__LINE__, 0xffd7f77aL, "FFD7F77A", "%+00.1X",
+__LINE__, 0xfffffffeL, "0xfffffffe", "%-#x",
+__LINE__, 0x01b0a63bL, "1b0a63b", "%x",
+__LINE__, -0x06554b7L, "-6640823", "%d",
+__LINE__, 0xfffffff8L, "fffffff8", "%x",
+__LINE__, 0x00000b2dL, "b2d", "%x",
+__LINE__, -0x2664ba2L, "-40258466", "%-d",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%X",
+__LINE__, -0x0000552L, " -1362", "%6.2ld",
+__LINE__, 0x00000009L, " 00009", "%6.5x",
+__LINE__, 0x00035c72L, "220274", "%05.ld",
+__LINE__, -0x014d09dL, "-1364125", "%d",
+__LINE__, -0x0000002L, " -2", "% 4d",
+__LINE__, 0x00000001L, "1", "%+X",
+__LINE__, 0x00000028L, "28", "%X",
+__LINE__, 0xf25c9eb2L, "F25C9EB2", "%7.X",
+__LINE__, -0x7ae4b62L, "-128863074", "%d",
+__LINE__, 0x00630d87L, "630D87", "%2X",
+__LINE__, 0x000000f8L, "F8", "%-X",
+__LINE__, 0xfffffff9L, "FFFFFFF9", "%X",
+__LINE__, -0x0000007L, "-7", "%0d",
+__LINE__, -0x2518fcdL, "-38899661", "% 3ld",
+__LINE__, 0xfffff4b4L, "FFFFF4B4", "%-5X",
+__LINE__, 0x01cc36c8L, "30160584", "%ld",
+__LINE__, 0xffffffffL, "ffffffff", "%-x",
+__LINE__, 0x0000000bL, " 11", "%6.ld",
+__LINE__, 0x00010d55L, " 68949", "% d",
+__LINE__, -0x0c01306L, "-12587782", "% 6.1ld",
+__LINE__, 0x001719d7L, "1513943", "%.1ld",
+__LINE__, -0x0000002L, " -2", "%+3.ld",
+__LINE__, 0x0000018eL, "398", "%d",
+__LINE__, 0x000000a6L, "0xa6", "%-#3x",
+__LINE__, 0x00006f66L, " 28518", "% #d",
+__LINE__, 0x0000032aL, "32A", "%X",
+__LINE__, -0x0000145L, "-325", "%0d",
+__LINE__, 0xffffffffL, "ffffffff", "%2.x",
+__LINE__, 0x00287171L, "2650481", "%ld",
+__LINE__, 0x0000004bL, "+75", "%+02.ld",
+__LINE__, 0xfffffff8L, "fffffff8", "%-0x",
+__LINE__, 0x00000064L, "64", "% X",
+__LINE__, 0xfffffca2L, "fffffca2", "%0x",
+__LINE__, 0x000010b6L, "10b6", "% .0x",
+__LINE__, -0x003806fL, "-229487", "%7d",
+__LINE__, -0x00000b7L, "-183", "%3ld",
+__LINE__, 0xffffe5baL, "FFFFE5BA", "%0X",
+__LINE__, 0x001f0da8L, "1f0da8", "%+x",
+__LINE__, 0x000ce185L, "844165", "%0ld",
+__LINE__, 0x00000c96L, "3222", "%0d",
+__LINE__, -0x0013099L, "-77977", "%1.ld",
+__LINE__, -0x5f3c47aL, "-99861626", "%.6ld",
+__LINE__, 0x00000cbfL, " CBF", "%+5.X",
+__LINE__, -0x0000001L, "-1", "%+ld",
+__LINE__, 0x0d793bc3L, "d793bc3", "%6.x",
+__LINE__, 0xfffffffdL, "0xfffffffd", "%+#x",
+__LINE__, -0x0000070L, " -112", "%6.d",
+__LINE__, 0xfffffb3fL, "FFFFFB3F", "%.7X",
+__LINE__, 0x037dfc78L, "0X37DFC78", "%#X",
+__LINE__, 0x00009ba5L, "39845", "%3ld",
+__LINE__, 0x0000004aL, "4a", "%0x",
+__LINE__, 0xffffff81L, "ffffff81", "%5.5x",
+__LINE__, -0x86ef222L, "-141488674", "%ld",
+__LINE__, -0xac5531eL, "-180704030", "% 4ld",
+__LINE__, 0x00002493L, "2493", "%+X",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%1.3X",
+__LINE__, 0x0005c875L, "378997", "%.0ld",
+__LINE__, 0x0301d345L, "50451269", "%d",
+__LINE__, 0xfff6b589L, "fff6b589", "%2.4x",
+__LINE__, -0x00001dbL, "-475 ", "%-7.0d",
+__LINE__, 0x0000d1e7L, "0x000d1e7", "%#2.7x",
+__LINE__, 0xf4c4d2bbL, "f4c4d2bb", "%.6x",
+__LINE__, 0x00c89f54L, "13147988", "%ld",
+__LINE__, -0x6599253cL, "-1704535356", "%+ld",
+__LINE__, 0xab7d61eaL, "ab7d61ea", "% x",
+__LINE__, 0x00000006L, "6", "%1ld",
+__LINE__, 0xffff5ab7L, "ffff5ab7", "%0x",
+__LINE__, -0x1cfeca5bL, "-486459995", "%#ld",
+__LINE__, 0x000000f3L, " f3", "% 6.x",
+__LINE__, -0x0000021L, "-33", "%d",
+__LINE__, 0xfe7246acL, "fe7246ac", "%-5.x",
+__LINE__, 0x00000017L, "00017", "%-.5X",
+__LINE__, -0x0cc250aL, "-13378826", "%0.0d",
+__LINE__, -0x00010aeL, "-04270", "%#.5ld",
+__LINE__, -0x7952c8bL, "-127216779", "% ld",
+__LINE__, 0x0002a53eL, "173374", "%4.0d",
+__LINE__, 0x03801bbfL, "3801BBF", "%0X",
+__LINE__, 0x0368645fL, "+57173087", "%+#0.6ld",
+__LINE__, 0x0000002fL, "47", "%d",
+__LINE__, 0x00000003L, "3", "%x",
+__LINE__, 0x000005f7L, "5F7", "%0X",
+__LINE__, -0x06e5e76L, "-7233142", "% 0.1ld",
+__LINE__, 0x053da936L, "53da936", "%1.4x",
+__LINE__, -0x0df0c2fL, "-14617647", "%.5ld",
+__LINE__, 0xfffffffdL, "FFFFFFFD", "%-0X",
+__LINE__, 0x000104bfL, "104BF", "%X",
+__LINE__, 0x000353fcL, "353FC", "%X",
+__LINE__, 0x182a18dcL, "+405412060", "%+ld",
+__LINE__, 0x0000000eL, " 14", "% 2d",
+__LINE__, -0x0000091L, "-145", "%+ld",
+__LINE__, 0x0029a9d6L, "2730454", "%d",
+__LINE__, 0x00009d57L, "009d57", "% .6x",
+__LINE__, 0x4c4d4f79L, "1280135033", "%5.ld",
+__LINE__, -0x000075bL, "-1883", "% 03d",
+__LINE__, -0x001b718L, "-112408", "%+d",
+__LINE__, 0xfffaaf57L, "FFFAAF57", "%+1X",
+__LINE__, 0x00f44e52L, "F44E52", "% 4X",
+__LINE__, 0x00000002L, "0X2", "%#X",
+__LINE__, 0x000a85e9L, "A85E9", "%+0X",
+__LINE__, 0xffff70bbL, "ffff70bb", "%6x",
+__LINE__, 0x00004e15L, "4e15", "%x",
+__LINE__, 0x000eeb60L, " 977760", "% ld",
+__LINE__, 0xfffffff1L, "fffffff1", "%0x",
+__LINE__, -0x294d7e2L, "-43309026", "% 02.d",
+__LINE__, 0x0001aaebL, "0109291", "%02.7ld",
+__LINE__, 0x000a01fcL, "0xa01fc", "%-#.5x",
+__LINE__, 0x002c3c30L, "+2898992", "%+#d",
+__LINE__, 0x015667aeL, "+22439854", "%+5ld",
+__LINE__, -0x05af42bL, "-5960747", "%+d",
+__LINE__, 0x0000be36L, "be36", "%+2x",
+__LINE__, 0x005e3f67L, "5e3f67", "% x",
+__LINE__, -0x0000020L, "-32", "% ld",
+__LINE__, -0x0003617L, "-13847", "% d",
+__LINE__, 0x00000014L, "14 ", "%-4.X",
+__LINE__, 0x00000001L, "001", "%0.3d",
+__LINE__, 0xfffffea9L, "fffffea9", "%3.x",
+__LINE__, 0xe447099eL, "E447099E", "%0X",
+__LINE__, 0x00049c71L, "302193", "%d",
+__LINE__, 0x76356ed3L, "0x76356ed3", "%#4.1x",
+__LINE__, 0x00000005L, " 0X5", "%#5X",
+__LINE__, 0x00004da2L, "0x004da2", "%#1.6x",
+__LINE__, 0xffdfb36cL, "FFDFB36C", "%4X",
+__LINE__, 0xffffe3c5L, "FFFFE3C5", "%+4.X",
+__LINE__, 0x00000006L, "6", "%0x",
+__LINE__, -0x914ff17L, "-152370967", "% .5ld",
+__LINE__, -0x0000002L, "-2", "%0ld",
+__LINE__, 0xffffff36L, "FFFFFF36", "% 2X",
+__LINE__, -0x0bb1598L, "-12260760", "%-ld",
+__LINE__, 0x00006db5L, "28085", "%0.5ld",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, -0x0000001L, "-1", "%0ld",
+__LINE__, 0x0fa37e79L, "FA37E79", "%1.X",
+__LINE__, -0x00000acL, "-172", "%.2d",
+__LINE__, 0xffffffd8L, "ffffffd8", "%.7x",
+__LINE__, -0x000a513L, "-42259", "%ld",
+__LINE__, 0x00001294L, "4756", "%2ld",
+__LINE__, -0x56bae0b4L, "-1455087796", "%.1ld",
+__LINE__, 0x3b26d5faL, "3b26d5fa", "%x",
+__LINE__, 0xff657013L, "ff657013", "%x",
+__LINE__, -0x00005f5L, "-1525", "%0.0ld",
+__LINE__, -0x0000001L, " -1", "% 7d",
+__LINE__, -0x02396b2L, "-2332338", "%d",
+__LINE__, -0x0000003L, "-000003", "%+7.6d",
+__LINE__, 0xfd3ec7c1L, "fd3ec7c1", "% 3.4x",
+__LINE__, -0x076e338L, "-7791416", "%0.d",
+__LINE__, -0x000015eL, "-350", "%3ld",
+__LINE__, 0x0a0f0b71L, "a0f0b71", "%x",
+__LINE__, 0xfffe00baL, "FFFE00BA", "%X",
+__LINE__, 0x00036bd8L, " 36bd8", "% 06.x",
+__LINE__, 0xfffff2dfL, "0XFFFFF2DF", "%#2.6X",
+__LINE__, 0x004687fbL, "4622331", "%ld",
+__LINE__, -0x0000331L, " -817", "%+6.d",
+__LINE__, 0xfcd5b090L, "fcd5b090", "%+0x",
+__LINE__, 0x0334f94cL, "334F94C", "%.6X",
+__LINE__, 0x00000bceL, "3022", "%.3ld",
+__LINE__, 0xf28d9dddL, "f28d9ddd", "%x",
+__LINE__, 0x00003a79L, " 14969", "% ld",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%.7X",
+__LINE__, 0x0043d7feL, "43D7FE", "%X",
+__LINE__, -0x0000b82L, "-2946", "%-ld",
+__LINE__, -0x00e29d8L, "-928216", "%d",
+__LINE__, 0xffffffecL, "ffffffec", "%-x",
+__LINE__, 0x0aeaf557L, "0xaeaf557", "%-#x",
+__LINE__, 0x00c07fe6L, "C07FE6", "%X",
+__LINE__, 0x307414d8L, "307414d8", "% 0x",
+__LINE__, -0x045ef67L, "-4583271", "%d",
+__LINE__, 0x0000024aL, " 0000586", "% .7d",
+__LINE__, 0xfffffc42L, "fffffc42", "%x",
+__LINE__, 0xfc38c249L, "fc38c249", "%5.x",
+__LINE__, -0x000d096L, "-53398", "%-d",
+__LINE__, -0x213a345L, "-34841413", "%ld",
+__LINE__, -0x0000130L, "-304", "%ld",
+__LINE__, -0x000efd1L, "-61393", "%ld",
+__LINE__, 0xfffff867L, "FFFFF867", "%2X",
+__LINE__, 0x00113ed0L, "0x113ed0", "%-#7x",
+__LINE__, 0x00000677L, " 1655", "% 3.ld",
+__LINE__, 0x0000002fL, "2f", "%x",
+__LINE__, 0xfffffd38L, "fffffd38", "%-4x",
+__LINE__, -0x000b3ccL, "-46028", "%1.2d",
+__LINE__, 0x45da719bL, "45DA719B", "%+0X",
+__LINE__, -0x000a454L, " -42068", "%7.3ld",
+__LINE__, 0x01cc7c30L, " 30178352", "% d",
+__LINE__, -0x05ae80eL, "-5957646", "%#.4ld",
+__LINE__, 0x000000b9L, "185", "%d",
+__LINE__, 0x003fcaf4L, "4180724", "%1.ld",
+__LINE__, 0x02da1b74L, "2DA1B74", "%X",
+__LINE__, 0xffffffd9L, "FFFFFFD9", "%X",
+__LINE__, 0x00064359L, "64359 ", "%-6X",
+__LINE__, 0x000000f0L, "240", "%ld",
+__LINE__, -0x01715e5L, "-1512933", "%ld",
+__LINE__, 0xc8f6e118L, "0XC8F6E118", "%#X",
+__LINE__, 0xfffffd8fL, "FFFFFD8F", "%X",
+__LINE__, 0x0000176dL, "5997 ", "%-6d",
+__LINE__, 0x00003cabL, "0x3cab", "%#0.3x",
+__LINE__, 0x00000001L, " 1", "% d",
+__LINE__, 0xfffff610L, "0XFFFFF610", "%#X",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%5.7X",
+__LINE__, 0x00000001L, "1", "%0x",
+__LINE__, 0x00000001L, "00001", "%.5ld",
+__LINE__, -0x0000d51L, "-3409", "%d",
+__LINE__, -0x08639eeL, "-8796654", "%ld",
+__LINE__, 0x00003121L, "12577", "%#1.2ld",
+__LINE__, 0x0000004eL, "78", "%d",
+__LINE__, 0xfffff64fL, "fffff64f", "%-x",
+__LINE__, 0x0000002aL, "2a", "%0x",
+__LINE__, 0x00000020L, "20", "%x",
+__LINE__, -0x00000b8L, "-184", "%#ld",
+__LINE__, 0x0000000aL, "10", "%-#d",
+__LINE__, 0x00000364L, "868", "%.1ld",
+__LINE__, 0x00d1f9b6L, "D1F9B6", "%0.X",
+__LINE__, 0x008cfda1L, "8CFDA1", "% 6.X",
+__LINE__, 0xffd58cceL, "FFD58CCE", "%X",
+__LINE__, 0x00000008L, "0000008", "%6.7ld",
+__LINE__, 0x00000318L, " 318", "%4X",
+__LINE__, 0x000172d8L, "94936", "%2ld",
+__LINE__, -0x056ccbfL, "-5688511", "%ld",
+__LINE__, 0x000000c7L, "+000199", "%+0.6d",
+__LINE__, 0x00000002L, "0X2", "%-#X",
+__LINE__, 0xfffff634L, "FFFFF634", "%.1X",
+__LINE__, -0x00001f3L, "-499", "%-ld",
+__LINE__, -0x000081bL, "-2075", "%-d",
+__LINE__, 0x000000b5L, "181", "%0d",
+__LINE__, 0xfe961ee8L, "fe961ee8", "%0x",
+__LINE__, 0x000028a2L, "10402", "%d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%.4X",
+__LINE__, -0x000058aL, "-1418", "%.3ld",
+__LINE__, 0x00001cebL, "1CEB", "%X",
+__LINE__, 0x00000021L, "21", "% X",
+__LINE__, 0x00000002L, "2", "%0d",
+__LINE__, -0x2f9bbf5L, "-49921013", "%.4ld",
+__LINE__, 0x00000e91L, "03729", "%#.5ld",
+__LINE__, 0xf1116740L, "f1116740", "%2x",
+__LINE__, 0x00014f72L, "14F72", "%X",
+__LINE__, 0xfffffcedL, "FFFFFCED", "%X",
+__LINE__, 0xffffffffL, "ffffffff", "%.5x",
+__LINE__, 0x0017cf0cL, " 1560332", "% 0ld",
+__LINE__, 0x0000000aL, "A", "% X",
+__LINE__, 0xff3a39d4L, "ff3a39d4", "%x",
+__LINE__, 0xfffef05fL, "FFFEF05F", "%X",
+__LINE__, 0xfedfe708L, "fedfe708", "%03.0x",
+__LINE__, 0x000345a0L, "345A0", "% X",
+__LINE__, -0x1ed5b6f7L, "-517322487", "%d",
+__LINE__, 0xd2d56c22L, "D2D56C22", "%0.X",
+__LINE__, 0x00002cbfL, "2CBF", "%.2X",
+__LINE__, 0x00000db4L, "db4", "%3x",
+__LINE__, -0x000b154L, "-45396", "%d",
+__LINE__, 0x002bf4c7L, "2BF4C7", "%X",
+__LINE__, 0x6954abf4L, "+1767156724", "%+d",
+__LINE__, 0xfffffffbL, "fffffffb", "%x",
+__LINE__, -0x29e0050eL, "-702547214", "%-0ld",
+__LINE__, -0x0014989L, "-84361", "%-#0.3ld",
+__LINE__, 0x001a557cL, "+1725820", "%+6.5d",
+__LINE__, -0x56689a81L, "-1449695873", "%.2d",
+__LINE__, 0x00000016L, " 16", "%05.X",
+__LINE__, 0x0001da1eL, " 121374", "% d",
+__LINE__, -0x04deac7L, "-5106375", "%03.4d",
+__LINE__, 0x000012b1L, "4785", "%d",
+__LINE__, 0x0009a116L, "9a116", "%-x",
+__LINE__, -0x0000003L, "-000003", "%4.6ld",
+__LINE__, 0x00000000L, "", "%.0x",
+__LINE__, 0x0000000aL, " A", "% 3X",
+__LINE__, 0xfffffff0L, "0xfffffff0", "%-#0.1x",
+__LINE__, 0x00000086L, "86", "%0X",
+__LINE__, 0x0000001fL, "31", "%-d",
+__LINE__, 0x0386f706L, "59176710", "%3.6ld",
+__LINE__, 0xffe437aeL, "0XFFE437AE", "%#X",
+__LINE__, 0x0e5405c6L, "e5405c6", "%-x",
+__LINE__, 0xfffdee46L, "FFFDEE46", "%+X",
+__LINE__, 0xff861e9dL, "FF861E9D", "%5.X",
+__LINE__, 0xfffff570L, "FFFFF570", "%-X",
+__LINE__, 0x045c90bdL, "45c90bd", "%0x",
+__LINE__, 0x000000aaL, "AA", "%+X",
+__LINE__, -0x747262eL, "-122103342", "%0ld",
+__LINE__, 0xffffad89L, "FFFFAD89", "%X",
+__LINE__, 0x00000018L, "18", "%0.2X",
+__LINE__, 0x00057a2dL, " 358957", "% #7.d",
+__LINE__, 0x73a0e21dL, "1939923485", "%ld",
+__LINE__, -0x00021e1L, "-8673", "%0d",
+__LINE__, 0x000000e9L, " 233", "% 06.3ld",
+__LINE__, 0xffffcc0dL, "ffffcc0d", "%x",
+__LINE__, 0x00000052L, "52", "%x",
+__LINE__, 0x01c155afL, "1C155AF", "%.5X",
+__LINE__, 0xffffffffL, "ffffffff", "%0.x",
+__LINE__, -0x00400a4L, "-262308", "%-d",
+__LINE__, -0x0000001L, "-0000001", "%#.7ld",
+__LINE__, 0x01fb9c99L, "1fb9c99", "% 03.5x",
+__LINE__, 0xffffffffL, "ffffffff", "%6.x",
+__LINE__, 0xff5e5eeaL, "FF5E5EEA", "%X",
+__LINE__, 0x0000000fL, "F", "%+0X",
+__LINE__, 0xfffffe3aL, "fffffe3a", "% x",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%-X",
+__LINE__, -0x0000007L, "-7", "%0ld",
+__LINE__, -0x002f635L, "-194101", "%d",
+__LINE__, -0x0000005L, "-5", "%ld",
+__LINE__, -0x0000059L, "-89", "%0ld",
+__LINE__, -0x1ccda96L, "-30202518", "%d",
+__LINE__, -0x0000002L, "-2", "%-d",
+__LINE__, 0xffffffdaL, "0XFFFFFFDA", "%#X",
+__LINE__, 0x00036cc5L, "224453", "%#d",
+__LINE__, 0x00000010L, "+16", "%+ld",
+__LINE__, 0x0b6039c7L, "190855623", "%d",
+__LINE__, -0x0000002L, "-002", "%#.3d",
+__LINE__, 0xfff3e746L, "FFF3E746", "%-4X",
+__LINE__, 0x0361b3deL, "361B3DE", "% 04X",
+__LINE__, 0xffffe6a2L, "ffffe6a2", "%-x",
+__LINE__, 0x00032790L, "0x0032790", "%#7.7x",
+__LINE__, 0xffe33b4eL, "ffe33b4e", "%-0x",
+__LINE__, -0x0094663L, "-607843", "%.3ld",
+__LINE__, -0x00a3efaL, "-671482", "%4d",
+__LINE__, 0x000000e6L, " 00E6", "%7.4X",
+__LINE__, 0x000125cbL, "125CB", "%+X",
+__LINE__, 0x0000b97eL, "b97e", "%x",
+__LINE__, -0x0000039L, "-57", "%+ld",
+__LINE__, 0xffffe39aL, "ffffe39a", "%5.4x",
+__LINE__, 0xffffffffL, "ffffffff", "%6.1x",
+__LINE__, -0xdee910cL, "-233738508", "%-#2d",
+__LINE__, -0x14044930L, "-335825200", "%6.ld",
+__LINE__, 0x00a81259L, "a81259", "%x",
+__LINE__, 0x020e74c6L, "20E74C6", "%X",
+__LINE__, -0x00000fbL, "-251", "%01.d",
+__LINE__, 0x034ceb45L, "34CEB45", "%5.X",
+__LINE__, 0xfeacb66aL, "feacb66a", "% x",
+__LINE__, 0x00003eb6L, "3EB6", "% X",
+__LINE__, 0x000009efL, "9ef", "% x",
+__LINE__, 0xf9d9dd07L, "F9D9DD07", "%0X",
+#ifndef __PCCNECV70__
+
+__LINE__, 0x000154d7L, "087255", "%.6ld",
+__LINE__, -0x000036eL, "-878", "%-ld",
+__LINE__, -0x0007dccL, "-32204", "% d",
+__LINE__, 0x000019dcL, "6620", "%d",
+__LINE__, 0xffffff6eL, "FFFFFF6E", "%2X",
+__LINE__, 0x00000016L, "0x16", "%-#x",
+__LINE__, 0xffdb3e96L, "ffdb3e96", "%+.5x",
+__LINE__, 0xffffffefL, "FFFFFFEF", "% 04.X",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%5X",
+__LINE__, 0x000c08cdL, "C08CD", "%-X",
+__LINE__, 0x18de71eeL, "18de71ee", "%x",
+__LINE__, 0xffffffffL, "ffffffff", "% x",
+__LINE__, -0x00025bdL, "-009661", "%#.6d",
+__LINE__, 0x2f05de14L, " 788913684", "% 6.4ld",
+__LINE__, 0x0c99cf86L, "211406726", "%.5d",
+__LINE__, 0x09e6a21dL, " 166109725", "% 0d",
+__LINE__, -0x013da65L, "-1301093", "%+ld",
+__LINE__, 0x000003d0L, " 976", "% 4.2d",
+__LINE__, -0xef9e3ccL, "-251257804", "%-7.0d",
+__LINE__, 0x0000000cL, "+12", "%+00ld",
+__LINE__, 0xffffffe2L, "ffffffe2", "%x",
+__LINE__, 0x000000feL, "fe", "%-x",
+__LINE__, 0xfffffc5fL, "fffffc5f", "%x",
+__LINE__, -0x0005c55L, "-23637", "%d",
+__LINE__, -0x0111ff2L, "-1122290", "% 7.d",
+__LINE__, -0x1a1746e5L, "-437733093", "%.4ld",
+__LINE__, 0x00001007L, "004103", "%00.6d",
+__LINE__, 0xffffffe1L, "ffffffe1", "%x",
+__LINE__, 0x0000d80fL, "55311", "%d",
+__LINE__, 0x00000004L, "4", "%+X",
+__LINE__, 0xfffffffdL, "fffffffd", "%6x",
+__LINE__, -0x2afbcc3cL, "-721144892", "%4.6ld",
+__LINE__, 0x00377f96L, "377F96", "%6.X",
+__LINE__, 0xffffffc8L, "FFFFFFC8", "%0X",
+__LINE__, 0x007ed9d1L, "8313297", "%-3d",
+__LINE__, 0x00000000L, "0", "%-X",
+__LINE__, 0x001e122dL, "1970733", "%01.d",
+__LINE__, -0x000029bL, "-667", "%ld",
+__LINE__, -0x002f563L, "-193891", "% 2.5d",
+__LINE__, 0xfffffffeL, "fffffffe", "%+3.7x",
+__LINE__, 0xfff7658cL, "fff7658c", "%x",
+__LINE__, -0x0006d08L, "-0027912", "%7.7ld",
+__LINE__, 0x00000080L, "80", "%X",
+__LINE__, 0x0000078fL, " 1935", "% 6ld",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "% X",
+__LINE__, 0x000000aeL, " AE", "%7.X",
+__LINE__, -0x000d6aaL, "-54954", "%-ld",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%6.X",
+__LINE__, 0x000003bfL, "+959", "%+d",
+__LINE__, -0x7242d04bL, "-1916981323", "% ld",
+__LINE__, 0xf0e6546fL, "F0E6546F", "% .7X",
+__LINE__, 0x047e196aL, "75372906", "%ld",
+__LINE__, 0x0240174eL, "240174E", "%+0X",
+__LINE__, -0x0000006L, "-006", "%.3ld",
+__LINE__, 0x00068aacL, "428716", "%#ld",
+__LINE__, 0xffffffa1L, "ffffffa1", "%0x",
+__LINE__, 0x000adab3L, "adab3", "%x",
+__LINE__, -0x00000aeL, "-0000174", "%7.7ld",
+__LINE__, 0x0f0a8f4bL, "f0a8f4b", "% x",
+__LINE__, 0xfee229bcL, "fee229bc", "%x",
+__LINE__, -0x275b8455L, "-660309077", "%.2ld",
+__LINE__, -0xca4b2a5L, "-212120229", "%d",
+__LINE__, 0x000000b5L, " 181", "%04.d",
+__LINE__, 0xfff213f2L, "FFF213F2", "%X",
+__LINE__, 0x00000003L, "3", "%-X",
+__LINE__, 0x0ebb978bL, "247175051", "%.6ld",
+__LINE__, 0xffffffcaL, "FFFFFFCA", "%X",
+__LINE__, -0x0000003L, "-03", "%+0.2d",
+__LINE__, -0x178ff86L, "-24706950", "%+d",
+__LINE__, 0x0000003cL, " 60", "%7.ld",
+__LINE__, -0x001012dL, "-65837", "%.5d",
+__LINE__, 0x03673fd2L, "3673fd2", "%.5x",
+__LINE__, -0x001fe74L, "-130676", "%#0.6ld",
+__LINE__, 0x004f6226L, "4f6226", "%-0x",
+__LINE__, 0xfffffa0fL, "fffffa0f", "%7x",
+__LINE__, 0xfffffff8L, "fffffff8", "%-.6x",
+__LINE__, -0x0000001L, "-1", "%#d",
+__LINE__, 0xffffe43dL, "ffffe43d", "%7x",
+__LINE__, 0x00009d47L, "0040263", "%7.7ld",
+__LINE__, 0xff0fc79fL, "FF0FC79F", "%-4.X",
+__LINE__, 0x2d610907L, "2d610907", "%x",
+__LINE__, -0x00002deL, "-734", "%04d",
+__LINE__, 0x0000036bL, " 36B", "%7.1X",
+__LINE__, 0x00000002L, "2", "%.0x",
+__LINE__, -0x1f577b3eL, "-525826878", "%d",
+__LINE__, 0x0000002dL, "45", "%#ld",
+__LINE__, 0xfffffffbL, "fffffffb", "%x",
+__LINE__, -0x0000004L, "-4", "%-.0d",
+__LINE__, 0x00016ba4L, "16ba4", "%x",
+__LINE__, -0x1ad853d5L, "-450384853", "% 0ld",
+__LINE__, 0x00366899L, "366899", "%2.x",
+__LINE__, 0x1659158bL, "1659158B", "%X",
+__LINE__, 0x000076c7L, "76c7", "%x",
+__LINE__, 0x00000674L, "674", "%0x",
+__LINE__, 0x016c9d8aL, "+23895434", "%+ld",
+__LINE__, 0xfffffc43L, "FFFFFC43", "%0X",
+__LINE__, 0xfff249d2L, "fff249d2", "%-2.x",
+__LINE__, 0xffffffddL, "ffffffdd", "%5x",
+__LINE__, 0xffffa7efL, "FFFFA7EF", "%0.3X",
+__LINE__, 0x030d4d06L, "30d4d06", "%x",
+__LINE__, -0x0e4694bL, "-14969163", "%d",
+__LINE__, 0x00000078L, "120", "%.3ld",
+__LINE__, -0x16c1273eL, "-381757246", "%0d",
+__LINE__, 0xffffd183L, "FFFFD183", "% 0X",
+__LINE__, -0x2dfdaddL, "-48224989", "%ld",
+__LINE__, -0x5767fe5cL, "-1466433116", "%ld",
+__LINE__, 0x01bea036L, "29270070", "%#4.3d",
+__LINE__, 0x00000027L, "27", "%-x",
+__LINE__, 0x0004d183L, "4D183", "%X",
+__LINE__, 0xffdaf9c8L, "FFDAF9C8", "%.7X",
+__LINE__, 0xfffffd95L, "fffffd95", "%x",
+__LINE__, -0x0059acbL, "-367307", "%00.d",
+__LINE__, 0x017d8db4L, "17d8db4", "% 05.x",
+__LINE__, 0x0001f084L, "001F084", "%5.7X",
+__LINE__, 0x00000006L, " 6", "% ld",
+__LINE__, 0x011b0802L, "18548738", "%.3ld",
+__LINE__, 0x00000006L, " 6", "%#3.d",
+__LINE__, 0xffffffffL, "ffffffff", "%6x",
+__LINE__, 0x00000001L, "1", "% x",
+__LINE__, 0x00000750L, " 01872", "% .5d",
+__LINE__, 0xfffffff9L, "fffffff9", "%x",
+__LINE__, -0x00f842cL, "-1016876", "%+d",
+__LINE__, -0x001dcf0L, "-122096", "%-0d",
+__LINE__, 0x000000c9L, "0XC9", "% #3X",
+__LINE__, 0x1e368e86L, "1e368e86", "%7x",
+__LINE__, -0x0001157L, "-4439", "% 03.4d",
+__LINE__, 0xfff91e87L, "FFF91E87", "%3.5X",
+__LINE__, 0x00000006L, "6", "%x",
+__LINE__, 0x00000bcaL, "3018", "%ld",
+__LINE__, 0x00495ff6L, "495ff6", "%01.0x",
+__LINE__, -0x0267f7aL, "-2523002", "% #5d",
+__LINE__, 0x00000060L, "96", "%-d",
+__LINE__, 0x000850c6L, "544966", "%#.1d",
+__LINE__, 0x00231457L, "231457", "%-6.4X",
+__LINE__, 0x0000000bL, "11", "%-d",
+__LINE__, 0x000003bdL, "957", "%#d",
+__LINE__, 0xfd51d970L, "FD51D970", "%+.7X",
+__LINE__, 0x000007bfL, "1983", "%-ld",
+__LINE__, 0x000034b2L, "34B2", "%0.X",
+__LINE__, 0x0000c18dL, "C18D", "%0.X",
+__LINE__, 0xffffbb83L, "ffffbb83", "% 3x",
+__LINE__, 0x000001d0L, "0x1d0", "%#x",
+__LINE__, -0x003c784L, "-247684", "%#ld",
+__LINE__, 0x0210cffaL, "210CFFA", "%X",
+__LINE__, -0x33093a1L, "-53515169", "% 0d",
+__LINE__, 0x00000001L, " 1", "% #ld",
+__LINE__, 0xffffaa53L, "ffffaa53", "%-4.5x",
+__LINE__, 0x2935c056L, "691388502", "%1.d",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, 0x000013d1L, "0X013D1", "%+#2.5X",
+__LINE__, -0x000035cL, "-860", "%-.2d",
+__LINE__, 0x00000000L, " ", "%-4.X",
+__LINE__, -0x0000147L, "-327", "%d",
+__LINE__, 0x0a317eb0L, "171015856", "%.7d",
+__LINE__, 0x00000003L, "3", "%ld",
+__LINE__, 0x000001d6L, "1d6", "%-x",
+__LINE__, 0x18185214L, "404247060", "%-.2ld",
+__LINE__, 0x00574140L, "0574140", "%.7X",
+__LINE__, 0x00002ea5L, "02ea5", "%.5x",
+__LINE__, 0x00000005L, "5", "% x",
+__LINE__, 0xffc47ed6L, "ffc47ed6", "%-x",
+__LINE__, 0x0001f5daL, "0X1F5DA", "%#X",
+__LINE__, 0xfffffcc9L, "fffffcc9", "% x",
+__LINE__, 0x02586c98L, "2586C98", "%X",
+__LINE__, -0x0000036L, "-54", "% ld",
+__LINE__, 0x00064b57L, "412503", "%1.5d",
+__LINE__, -0x0000007L, "-7", "%#0.0ld",
+__LINE__, 0x00023a03L, "145923", "%ld",
+__LINE__, -0x0000065L, "-101", "%+#d",
+__LINE__, 0x00000208L, "208", "%X",
+__LINE__, 0x00e97728L, "15300392", "%-ld",
+__LINE__, 0x0000030aL, "+778", "%+d",
+__LINE__, 0xf4d7deeeL, "F4D7DEEE", "%+X",
+__LINE__, -0x000009aL, "-154", "%+.3ld",
+__LINE__, 0x000002c0L, "+704", "%+ld",
+__LINE__, 0x0067ec23L, "67ec23", "%x",
+__LINE__, 0x005ca7fcL, "+6072316", "%+d",
+__LINE__, 0xfffff5f1L, "fffff5f1", "%x",
+__LINE__, 0x00000601L, " 0X601", "%#7.2X",
+__LINE__, -0x0000057L, "-87", "% ld",
+__LINE__, -0x0000078L, " -120", "%7.d",
+__LINE__, -0x000001fL, "-31 ", "%-6d",
+__LINE__, 0x0160c000L, "23117824", "%ld",
+__LINE__, -0x0000007L, "-7", "%0ld",
+__LINE__, 0xfffffffeL, "fffffffe", "%+x",
+__LINE__, 0x5b6ef898L, "5b6ef898", "%+0x",
+__LINE__, 0x0009bfb6L, "638902", "%d",
+__LINE__, -0x0000145L, " -325", "%#6.0d",
+__LINE__, -0x508c048L, "-84459592", "%-5.ld",
+__LINE__, 0x00000002L, " 0x2", "% #4x",
+__LINE__, 0x0001486eL, "84078", "%#d",
+__LINE__, 0x006ac76aL, "6997866", "%.6d",
+__LINE__, 0xffffff98L, "FFFFFF98", "%X",
+__LINE__, 0xfffffe08L, "fffffe08", "%6.x",
+__LINE__, -0x24ef47eL, "-38728830", "%1.6ld",
+__LINE__, 0x39d1b2dbL, "39D1B2DB", "% X",
+__LINE__, 0xfffc9ce2L, "0xfffc9ce2", "%#x",
+__LINE__, 0x59485e14L, "1497914900", "%#4ld",
+__LINE__, 0x000022ebL, "22EB", "%3.X",
+__LINE__, 0xfa410352L, "FA410352", "%-X",
+__LINE__, -0x4a342f0L, "-77808368", "% ld",
+__LINE__, 0xef5825a4L, "EF5825A4", "%.6X",
+__LINE__, 0x01b0185aL, "0x1b0185a", "% #x",
+__LINE__, -0x0004290L, "-17040", "%.3d",
+__LINE__, -0x10f88659L, "-284722777", "%+6.2ld",
+__LINE__, 0x00003216L, "12822", "%-d",
+__LINE__, 0x4a31a219L, "1244766745", "%d",
+__LINE__, 0xffffffb5L, "FFFFFFB5", "%-X",
+__LINE__, 0x0000d586L, "D586", "%-2.X",
+__LINE__, 0x00008496L, "33942", "%1.d",
+__LINE__, -0x0000011L, "-17", "%1ld",
+__LINE__, 0x0000003cL, "3C", "%2.X",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%.3X",
+__LINE__, 0x0000152aL, "152A", "%X",
+__LINE__, 0xfffe876eL, "FFFE876E", "%X",
+__LINE__, -0x0003874L, "-14452", "%-ld",
+__LINE__, -0x004918aL, "-299402", "%#.6d",
+__LINE__, -0x000000cL, "-12", "%-d",
+__LINE__, 0xffffd812L, "FFFFD812", "%+X",
+__LINE__, -0x000000cL, "-12", "%0d",
+__LINE__, -0x0000229L, "-553", "%0d",
+__LINE__, 0x00002ab8L, "2AB8", "%4.X",
+__LINE__, 0x0000004bL, "+75", "%+ld",
+__LINE__, 0x001c3178L, " 1847672", "% ld",
+__LINE__, -0x0000006L, "-6", "%.0ld",
+__LINE__, 0x0003be65L, "245349", "%ld",
+__LINE__, -0x0000001L, "-1", "%#1ld",
+__LINE__, 0x0000007fL, "+127", "%+ld",
+__LINE__, 0x0000020eL, "526 ", "%-5ld",
+__LINE__, 0x00000002L, "2", "%d",
+__LINE__, 0x03bd0873L, "0X3BD0873", "%#X",
+__LINE__, 0x00093a52L, "604754", "%-2d",
+__LINE__, -0x00823fcL, "-0533500", "%+.7ld",
+__LINE__, 0x00000000L, " ", "%4.X",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, 0xfff09edeL, "fff09ede", "%-x",
+__LINE__, 0x01e28c24L, "31624228", "%ld",
+__LINE__, 0x00001dccL, "1DCC", "%X",
+__LINE__, -0x0f0ea0dL, "-15788557", "%-00.ld",
+__LINE__, 0xffff73a1L, "FFFF73A1", "%X",
+__LINE__, -0x0004040L, "-16448", "%+#d",
+__LINE__, 0x0073b158L, "0x73b158", "%#7x",
+__LINE__, 0xfffff8ffL, "FFFFF8FF", "% 5X",
+__LINE__, -0x0000004L, "-4", "%0d",
+__LINE__, 0xffff56a3L, "ffff56a3", "%1.6x",
+__LINE__, -0x0000041L, "-65", "%0d",
+__LINE__, 0x00000009L, "+0000009", "%+2.7d",
+__LINE__, 0xffffe13dL, "0XFFFFE13D", "%+#2.X",
+__LINE__, -0x00002ceL, "-00718", "%.5ld",
+__LINE__, 0xffc53e28L, "ffc53e28", "%03.4x",
+__LINE__, 0x00000005L, "0X5", "%#X",
+__LINE__, 0x00000004L, "4", "%x",
+__LINE__, 0xe21b35ebL, "e21b35eb", "%-x",
+__LINE__, -0x0000098L, "-152", "%-ld",
+__LINE__, 0xffffff81L, "FFFFFF81", "%2X",
+__LINE__, 0x00000003L, "00003", "%.5ld",
+__LINE__, 0xfffffffcL, "fffffffc", "%+x",
+__LINE__, 0x000491f5L, "299509", "%1.ld",
+__LINE__, 0xf06bfd7dL, "F06BFD7D", "%X",
+__LINE__, -0x0000006L, "-6", "%0d",
+__LINE__, -0x0a4af7dL, "-10792829", "%-0d",
+__LINE__, -0x11a74efL, "-18511087", "%ld",
+__LINE__, 0x2dc95e17L, "768171543", "%-1.d",
+__LINE__, -0x0000001L, "-1", "%#ld",
+__LINE__, 0x00000033L, "51", "%-#d",
+__LINE__, 0x002d0219L, "2949657", "%ld",
+__LINE__, 0xfffffffdL, "FFFFFFFD", "%2.4X",
+__LINE__, 0x00000f20L, "+3872", "%+ld",
+__LINE__, -0x0000047L, "-071", "%4.3ld",
+__LINE__, 0x00000010L, " 16", "%6d",
+__LINE__, 0x00000000L, "0", "%0d",
+__LINE__, 0xffffff57L, "FFFFFF57", "%X",
+__LINE__, -0x0000700L, "-1792", "%-#d",
+__LINE__, -0x0000064L, "-100", "%-ld",
+__LINE__, 0xff26d49aL, "FF26D49A", "%-0X",
+__LINE__, -0x0000006L, "-6", "%.1ld",
+__LINE__, 0x1391edc5L, "1391edc5", "%.1x",
+__LINE__, 0x0000014aL, "330", "%-#ld",
+__LINE__, 0x07ecd1e1L, "7ecd1e1", "%6x",
+__LINE__, -0xa2b8898L, "-170625176", "%3.d",
+__LINE__, 0x00035287L, "0x35287", "%#.0x",
+__LINE__, 0x00000000L, "00000", "%0.5X",
+__LINE__, -0x0000153L, "-339", "%d",
+__LINE__, 0x0000ad6eL, " 44398", "% 0.d",
+__LINE__, 0x00000001L, "1", "%-X",
+__LINE__, -0x000000dL, "-13 ", "%-6.2d",
+__LINE__, -0x01bff8aL, "-1834890", "%d",
+__LINE__, 0x000a0fa8L, "+659368", "%+ld",
+__LINE__, 0xac044dc0L, "ac044dc0", "%.0x",
+__LINE__, 0x0003a729L, "239401", "%ld",
+__LINE__, -0x00004f0L, "-1264", "%+ld",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0x00000012L, "12", "% x",
+__LINE__, 0xffff770bL, "ffff770b", "%7.1x",
+__LINE__, 0xd7458572L, "d7458572", "%x",
+__LINE__, 0x01f1b4f9L, "1f1b4f9", "% 0x",
+__LINE__, 0xfffb2198L, "0XFFFB2198", "% #1.X",
+__LINE__, 0x00ef6189L, " 15688073", "% ld",
+__LINE__, -0x3f0ae63L, "-66104931", "% #d",
+__LINE__, -0x0006075L, "-24693", "%ld",
+__LINE__, 0x000000a1L, "161", "%d",
+__LINE__, 0xfffffffcL, "fffffffc", "%3.2x",
+__LINE__, 0xff6b4125L, "FF6B4125", "%+5.X",
+__LINE__, 0x00000001L, " 1", "%6.d",
+__LINE__, -0x0000001L, "-1", "%+0d",
+__LINE__, -0x000096cL, "-2412", "%0.4d",
+__LINE__, 0x00039c6fL, "236655", "%.0d",
+__LINE__, 0x3625286cL, "908404844", "%.1d",
+__LINE__, 0xfffffffaL, "fffffffa", "%x",
+__LINE__, 0x00000000L, "0", "%X",
+__LINE__, 0x00c34353L, "12796755", "%#.4d",
+__LINE__, 0x000002dfL, "735", "%ld",
+__LINE__, 0xffff38faL, "FFFF38FA", "%5.1X",
+__LINE__, -0x000002aL, "-42", "%0.d",
+__LINE__, 0x0000077eL, "1918", "%ld",
+__LINE__, 0x000001f7L, "503", "%ld",
+__LINE__, 0x00000004L, "4", "%ld",
+__LINE__, 0x0021fb02L, "2226946", "%d",
+__LINE__, 0x007c858dL, "8160653", "%-0d",
+__LINE__, -0x0000109L, "-265", "%.0d",
+__LINE__, 0xfffffffaL, "fffffffa", "% x",
+__LINE__, 0x0097932dL, "97932d", "%+x",
+__LINE__, 0xfffbbd03L, "fffbbd03", "%-.5x",
+__LINE__, -0x0000005L, "-5", "%0d",
+__LINE__, 0x03ee3a95L, "65944213", "%ld",
+__LINE__, -0x0000002L, " -00002", "%7.5d",
+__LINE__, 0xea1a4e54L, "EA1A4E54", "%X",
+__LINE__, -0x000a9d6L, "-43478", "%+d",
+__LINE__, -0x0fd8d65L, "-16616805", "%5ld",
+__LINE__, 0x00000001L, "1", "%-d",
+__LINE__, 0x00000072L, "72", "%2.X",
+__LINE__, 0xffffff94L, "FFFFFF94", "%X",
+__LINE__, 0x00000d2aL, "D2A", "%+X",
+__LINE__, 0xffff614fL, "ffff614f", "%x",
+__LINE__, -0x0000018L, "-24", "%ld",
+__LINE__, 0x0000003bL, "059", "%2.3d",
+__LINE__, 0x0000001aL, "1A", "%0X",
+__LINE__, -0x0000109L, "-265", "%02ld",
+__LINE__, 0x00000f9dL, "3997", "%#1d",
+__LINE__, 0x0000001bL, "1b", "%x",
+__LINE__, 0xffffff07L, "ffffff07", "%x",
+__LINE__, 0xfff1a425L, "0xfff1a425", "%#x",
+__LINE__, 0x00000005L, "5", "%-1d",
+__LINE__, -0x53a6efdL, "-87715581", "%ld",
+__LINE__, 0x042f37dbL, "42F37DB", "%6.X",
+__LINE__, 0x00053bd5L, "+342997", "%+5ld",
+__LINE__, 0xffffffffL, "ffffffff", "% x",
+__LINE__, 0xffffffefL, "FFFFFFEF", "%6.X",
+__LINE__, -0x10ec29aL, "-17744538", "%+2.d",
+__LINE__, 0x01dcc901L, "1dcc901", "%x",
+__LINE__, 0x0007dc68L, "515176", "%-3.d",
+__LINE__, -0x0000062L, "-0098", "%#2.4d",
+__LINE__, 0x00000000L, " ", "%3.0X",
+__LINE__, -0x00000deL, "-222", "%ld",
+__LINE__, 0x000c1fb8L, "C1FB8", "%0X",
+__LINE__, 0x0005bf58L, "5BF58", "%X",
+__LINE__, -0x000dd1bL, "-56603", "%-03.1d",
+__LINE__, 0x00000b14L, "B14", "%+3.X",
+__LINE__, 0x00000799L, "799", "%-x",
+__LINE__, 0xfffffffaL, "fffffffa", "%x",
+__LINE__, 0x00000003L, "0x00003", "% #7.5x",
+__LINE__, -0x002b9f1L, "-178673", "%+d",
+__LINE__, -0x001b817L, "-112663", "%0d",
+__LINE__, 0xf6f98533L, "f6f98533", "%.1x",
+__LINE__, 0x00338ffcL, "3379196", "%d",
+__LINE__, 0x0409e9b5L, "0X409E9B5", "%#X",
+__LINE__, 0x00b8e98eL, " 12118414", "% 0d",
+__LINE__, -0x002a8f6L, "-174326", "%ld",
+__LINE__, 0x13bb9722L, "331061026", "%0d",
+__LINE__, 0x00063c71L, "63c71", "%x",
+__LINE__, 0xfffffe37L, "FFFFFE37", "%.1X",
+__LINE__, 0xffff7b3eL, "ffff7b3e", "%+.1x",
+__LINE__, 0x005eeab1L, "5eeab1", "%+x",
+__LINE__, 0xffc69e99L, "ffc69e99", "%x",
+__LINE__, -0x000005cL, " -92", "%5ld",
+__LINE__, 0x07d8fa8aL, "7d8fa8a", "%x",
+__LINE__, 0x00030e0aL, "200202", "%-4.1d",
+__LINE__, 0x00001dc1L, "1DC1", "%.0X",
+__LINE__, 0x00000008L, "8", "%0ld",
+__LINE__, -0x01b5397L, "-1790871", "%3.d",
+__LINE__, 0x27fbb4b5L, "27fbb4b5", "%x",
+__LINE__, -0xe3fdcfcL, "-239066364", "%4ld",
+__LINE__, 0x0008bcb1L, "8bcb1", "%0x",
+__LINE__, 0xffff039eL, "ffff039e", "%.6x",
+__LINE__, 0x000d0bd4L, "d0bd4", "%-x",
+__LINE__, 0x00000000L, "+0", "%+d",
+__LINE__, -0x2a49ea4L, "-44342948", "%1d",
+__LINE__, -0x0000055L, "-85", "%0d",
+__LINE__, -0x0000a05L, "-2565", "%3.3ld",
+__LINE__, -0x000000bL, "-11 ", "%-4d",
+__LINE__, 0xfff30444L, "FFF30444", "%7.X",
+__LINE__, 0x0000003fL, "63", "%-0d",
+__LINE__, 0x00046779L, "46779", "%X",
+__LINE__, 0x000028d7L, " 0X28D7", "%#7.X",
+__LINE__, 0x00000019L, " 19", "%5x",
+__LINE__, 0x0032291dL, "3287325", "%2.ld",
+__LINE__, 0x00057afaL, "57AFA", "%X",
+__LINE__, 0xfffe8c64L, "fffe8c64", "%3.4x",
+__LINE__, -0x624110d6L, "-1648431318", "%+6d",
+__LINE__, 0x0000001aL, " 26", "% 5.d",
+__LINE__, 0xfffffffdL, "FFFFFFFD", "%6.X",
+__LINE__, 0x00199490L, "1676432", "%-1d",
+__LINE__, -0xfff8265L, "-268403301", "%-0ld",
+__LINE__, 0x0000000eL, "e", "%-x",
+__LINE__, 0x00c38aecL, "c38aec", "%x",
+__LINE__, -0x00658f4L, "-415988", "%#ld",
+__LINE__, 0x0066ac4eL, "6728782", "%0d",
+__LINE__, 0xc4a808d5L, "c4a808d5", "%x",
+__LINE__, 0x00000000L, " 0", "%6.1x",
+__LINE__, 0x00066d24L, "66d24", "%x",
+__LINE__, 0x00002117L, "2117", "%X",
+__LINE__, 0xfe06fdf4L, "FE06FDF4", "%0X",
+__LINE__, 0xfffffff9L, "fffffff9", "%x",
+__LINE__, 0x1c6bb795L, "+476821397", "%+d",
+__LINE__, 0xfffffba4L, "FFFFFBA4", "%X",
+__LINE__, 0xfffd7d44L, "fffd7d44", "%0x",
+__LINE__, 0x0019dd17L, "1694999", "%d",
+__LINE__, 0x6475851eL, "0x6475851e", "% #7.x",
+__LINE__, -0x00330d5L, "-209109", "%0ld",
+__LINE__, 0x009f53f7L, "09F53F7", "%+6.7X",
+__LINE__, -0x00172f9L, " -94969", "%7.5ld",
+__LINE__, 0xffffffdcL, "FFFFFFDC", "%X",
+__LINE__, -0x013bdecL, "-1293804", "%+#2ld",
+__LINE__, 0xfff845c0L, "fff845c0", "%+7.x",
+__LINE__, -0x0fbe712L, "-16508690", "%.7d",
+__LINE__, 0xffffe13fL, "ffffe13f", "%x",
+__LINE__, 0xbbc19951L, "BBC19951", "%-4X",
+__LINE__, -0x28d6d1bL, "-42822939", "%#d",
+__LINE__, -0x93cda6bL, "-154983019", "%-d",
+__LINE__, 0xffc93342L, "FFC93342", "%7.X",
+__LINE__, 0x072ac8b3L, " 120244403", "% ld",
+__LINE__, 0xfff8d17bL, "FFF8D17B", "% X",
+__LINE__, 0x00000da5L, "DA5", "%0.X",
+__LINE__, 0x055ad3acL, "0x55ad3ac", "%#1x",
+__LINE__, 0x00000e5aL, " 3674", "% .4ld",
+__LINE__, 0xffffff79L, "FFFFFF79", "%+X",
+__LINE__, 0xffffe167L, "ffffe167", "%+5x",
+__LINE__, 0x0000fa50L, "0064080", "%.7ld",
+__LINE__, 0x00000001L, "1", "%-d",
+__LINE__, 0xfffffffeL, "fffffffe", "%x",
+__LINE__, 0x000009acL, " 2476", "% #2.ld",
+__LINE__, 0x00000e78L, "0003704", "%.7ld",
+__LINE__, -0x000dfc3L, "-57283", "%6.d",
+__LINE__, 0x00000ee0L, "EE0", "%0X",
+__LINE__, -0x293703b3L, "-691471283", "%ld",
+__LINE__, 0x000073e8L, " 73e8", "%6x",
+__LINE__, 0xffffdffdL, "ffffdffd", "%5.5x",
+__LINE__, 0x00000004L, "4", "%+00.x",
+__LINE__, 0x00000008L, "0X8", "%#X",
+__LINE__, 0x0003044cL, "3044c", "%0x",
+__LINE__, 0xffc2095eL, "FFC2095E", "%0X",
+__LINE__, 0x00000aacL, "0002732", "%-.7ld",
+__LINE__, 0xffffff79L, "FFFFFF79", "%+1.X",
+__LINE__, 0x53a0f94aL, " 1403058506", "% 2.4ld",
+__LINE__, 0x000e928dL, "e928d", "%x",
+__LINE__, 0x0024127aL, "2364026", "%5.d",
+__LINE__, 0x000f7c1cL, " 1014812", "% 2.d",
+__LINE__, -0x000003dL, "-61 ", "%-#4ld",
+__LINE__, -0x0000122L, "-290", "%+ld",
+__LINE__, 0x00000006L, "+6", "%+0d",
+__LINE__, 0x00000129L, " 000129", "%7.6X",
+__LINE__, 0x15d873e5L, " 366506981", "% 5.7d",
+__LINE__, 0x00000001L, "1", "%d",
+__LINE__, 0x038d6110L, "+59597072", "%+d",
+__LINE__, 0x0f46ccc3L, "256298179", "%-1.4d",
+__LINE__, 0xfe434d21L, "fe434d21", "%x",
+__LINE__, -0x179797d7L, "-395810775", "%d",
+__LINE__, 0xe35807bfL, "e35807bf", "%x",
+__LINE__, 0x00000003L, " +3", "%+7d",
+__LINE__, 0x017e699eL, "25061790", "%#ld",
+__LINE__, -0x0000029L, "-41", "%d",
+__LINE__, 0xffffff11L, "ffffff11", "%1.x",
+__LINE__, -0x0001bf6L, "-7158", "%+0ld",
+__LINE__, 0xffffff4bL, "FFFFFF4B", "%4X",
+__LINE__, -0x0000040L, "-64", "%ld",
+__LINE__, 0x000034d6L, "+13526", "%+ld",
+__LINE__, 0xffffffa7L, "ffffffa7", "%x",
+__LINE__, 0xfffffe8eL, "fffffe8e", "%+.3x",
+__LINE__, 0x00000000L, "0", "%0.1d",
+__LINE__, -0x007cdf1L, "-511473", "%ld",
+__LINE__, 0xfffffeefL, "FFFFFEEF", "%-X",
+__LINE__, 0x00002d91L, "2d91", "%x",
+__LINE__, -0x000025bL, "-603", "%#ld",
+__LINE__, -0x000001bL, "-27", "%-ld",
+__LINE__, 0x042b6752L, "42B6752", "%+X",
+__LINE__, -0x75afb0a6L, "-1974448294", "% ld",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, 0x00000542L, " 1346", "%6d",
+__LINE__, -0x0000010L, "-16", "%+0d",
+__LINE__, 0xfffed8f7L, "FFFED8F7", "%5.X",
+__LINE__, 0x0541852eL, "541852e", "% 2.x",
+__LINE__, 0xff22aec3L, "ff22aec3", "% .1x",
+__LINE__, 0x5e34b745L, "1580513093", "%ld",
+__LINE__, 0xfffffff3L, "fffffff3", "%x",
+__LINE__, 0x0eda7b86L, "+249199494", "%+.3d",
+__LINE__, 0xffffe40fL, "ffffe40f", "%+x",
+__LINE__, -0x0003484L, "-13444", "%-1.5ld",
+__LINE__, 0x0000334bL, " 13131", "%6.ld",
+__LINE__, -0x0000149L, "-329", "%ld",
+__LINE__, 0x00000001L, " 001", "% 5.3x",
+__LINE__, 0xffeaa035L, "ffeaa035", "%+3.5x",
+__LINE__, 0x00211dffL, "2170367", "%ld",
+__LINE__, 0x007e91f4L, "7e91f4", "%x",
+__LINE__, 0xfffffffcL, "0xfffffffc", "%+#5x",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%6.X",
+__LINE__, 0x0156a9b5L, "156a9b5", "%x",
+__LINE__, 0xfffffe58L, "fffffe58", "%+x",
+__LINE__, 0xffff8c66L, "FFFF8C66", "%.0X",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, 0x00000005L, " 5", "%7.d",
+__LINE__, -0x0000002L, "-2", "%ld",
+__LINE__, 0x000076b9L, " 30393", "% ld",
+__LINE__, 0x00003824L, "3824", "%4X",
+__LINE__, 0x00000cdfL, " CDF", "% 7X",
+__LINE__, 0x017c9e8fL, "17C9E8F", "%-X",
+__LINE__, -0x20f582dL, "-34560045", "%-.5d",
+__LINE__, 0x0000732eL, " 29486", "% 7.ld",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%+0X",
+__LINE__, 0xf379a4a2L, "F379A4A2", "% .7X",
+__LINE__, -0x0000028L, "-40", "%-d",
+__LINE__, 0xe73cf79eL, "e73cf79e", "%x",
+__LINE__, 0x00000002L, " 2", "%7ld",
+__LINE__, -0x00029b1L, "-10673", "%-#1.ld",
+__LINE__, -0x0002a58L, "-10840", "%3.d",
+__LINE__, 0x00000002L, "2", "%-X",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%X",
+__LINE__, -0x000003aL, " -58", "%5ld",
+__LINE__, 0x0245ef3bL, "245ef3b", "%.3x",
+__LINE__, 0x00026ccaL, "158922", "%-06.3ld",
+__LINE__, 0x01016fd3L, "16871379", "%-d",
+__LINE__, 0x000016fcL, "5884", "%0ld",
+__LINE__, -0x00007fbL, " -2043", "%7.3d",
+__LINE__, 0xfff73d3cL, "fff73d3c", "%0x",
+__LINE__, -0x0000110L, "-272", "% 04.3d",
+__LINE__, 0x0000000eL, " 014", "% 04ld",
+__LINE__, -0x0000039L, "-57", "%.0ld",
+__LINE__, 0x00000c95L, "c95", "%0x",
+__LINE__, 0xffff3b2eL, "ffff3b2e", "%x",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%X",
+__LINE__, 0x00000015L, "21", "%.1d",
+__LINE__, 0x0000000cL, "+12", "%+ld",
+__LINE__, 0x00000000L, "0", "%+X",
+__LINE__, 0xfffc9a14L, "fffc9a14", "%-.5x",
+__LINE__, 0x0000003cL, "60", "%.2ld",
+__LINE__, -0x0000023L, " -35", "%6.d",
+__LINE__, 0x00000740L, "1856", "%ld",
+__LINE__, 0x00000160L, "160", "% 3.X",
+__LINE__, 0x00000006L, " 6", "%5.X",
+__LINE__, -0x0000677L, "-1655", "%.3ld",
+__LINE__, 0x12709c7eL, "12709C7E", "%.7X",
+__LINE__, 0x0000090fL, "+2319", "%+#d",
+__LINE__, 0xffffffe0L, "0xffffffe0", "%#4.1x",
+__LINE__, 0x00132ce0L, "1256672", "%ld",
+__LINE__, 0x00000059L, "59", "%+X",
+__LINE__, -0x0000017L, "-23", "%0d",
+__LINE__, -0x01fade6L, "-2076134", "%-4.3ld",
+__LINE__, 0x000df3faL, "914426", "%.5ld",
+__LINE__, 0xfffffd0fL, "fffffd0f", "%7x",
+__LINE__, -0x000c212L, "-49682", "%0.1ld",
+__LINE__, 0xffff8bcbL, "FFFF8BCB", "%.3X",
+__LINE__, 0x0000000aL, "a", "% x",
+__LINE__, 0x00000021L, "21", "%x",
+__LINE__, -0x0000040L, "-64", "% 1ld",
+__LINE__, 0x00000009L, " 9", "%6.ld",
+__LINE__, -0x0000d67L, "-3431", "% 5.3d",
+__LINE__, 0x03a85f1bL, "61366043", "%ld",
+__LINE__, 0x00000035L, "000053", "%0.6d",
+__LINE__, 0xfffda5cbL, "fffda5cb", "%+x",
+__LINE__, 0xffffff78L, "FFFFFF78", "%-7.0X",
+__LINE__, 0xfffffd6dL, "fffffd6d", "%7.x",
+__LINE__, 0xfffffc08L, "fffffc08", "%7.3x",
+__LINE__, 0x00003335L, " 13109", "% #d",
+__LINE__, -0x0000002L, " -2", "%5.d",
+__LINE__, -0x13767a48L, "-326531656", "%+ld",
+__LINE__, 0x00000be5L, "3045", "%4.0ld",
+__LINE__, 0xfffdb28cL, "FFFDB28C", "%X",
+__LINE__, 0x00127118L, "1208600", "%ld",
+__LINE__, 0x00000086L, " 134", "% ld",
+__LINE__, 0x0002214cL, "2214c", "%+x",
+__LINE__, 0x0000a0c2L, " a0c2", "%5.0x",
+__LINE__, -0x000007cL, "-124", "%ld",
+__LINE__, 0x0000012aL, "00298", "%3.5d",
+__LINE__, 0xfd4f1257L, "FD4F1257", "%+2.X",
+__LINE__, 0xffffd8aaL, "ffffd8aa", "%5x",
+__LINE__, -0x00000a7L, "-167", "%+ld",
+__LINE__, -0x0009c69L, "-40041", "%0.0ld",
+__LINE__, 0x02230418L, "35849240", "%-0.6ld",
+__LINE__, 0x00000000L, " 0", "%6x",
+__LINE__, 0xfffff184L, "fffff184", "%02.5x",
+__LINE__, -0x0ae967bL, "-11441787", "%d",
+__LINE__, 0x0015de3aL, "1433146", "%-5.3d",
+__LINE__, -0x0071e93L, "-466579", "%1.ld",
+__LINE__, 0xfffff8bdL, "fffff8bd", "%+x",
+__LINE__, -0x00000e4L, "-228", "%+ld",
+__LINE__, 0x000001d8L, " 472", "% .3ld",
+__LINE__, 0x00315faaL, "315faa", "%-0x",
+__LINE__, 0x00000e59L, "e59", "%0x",
+__LINE__, -0x0000005L, "-5", "%ld",
+__LINE__, 0x000018ecL, "6380", "%ld",
+__LINE__, 0xfffffff9L, "fffffff9", "%5.2x",
+__LINE__, -0xe7cfd39L, "-243072313", "%-d",
+__LINE__, 0x0002c30bL, "2C30B", "%1.2X",
+__LINE__, 0x0000007aL, "7A", "%X",
+__LINE__, 0xf604ecb2L, "F604ECB2", "%2X",
+__LINE__, -0x05f602cL, "-6250540", "%d",
+__LINE__, 0xffff9c86L, "ffff9c86", "%2.x",
+__LINE__, -0x00d7f55L, "-884565", "%#d",
+__LINE__, 0xd2a37824L, "D2A37824", "%4X",
+__LINE__, 0x00000000L, "", "%-.0x",
+__LINE__, 0x000d4b51L, "0d4b51", "%3.6x",
+__LINE__, 0x000ecd97L, "ecd97", "% x",
+__LINE__, -0x0000018L, "-024", "%+04ld",
+__LINE__, -0x009f292L, "-651922", "%ld",
+__LINE__, -0x0002da9L, "-11689", "%-0ld",
+__LINE__, -0x000a218L, "-41496", "%4.5d",
+__LINE__, 0xffff85acL, "FFFF85AC", "% 04.X",
+__LINE__, -0x0d9ffbeL, "-14286782", "%0d",
+__LINE__, 0xfb18cc8eL, "fb18cc8e", "%x",
+__LINE__, 0xffffe5d3L, "FFFFE5D3", "%-X",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, -0x0000006L, "-6", "% d",
+__LINE__, 0x0002fc62L, "2fc62", "% 03.x",
+__LINE__, 0x00000000L, "00", "%.2d",
+__LINE__, -0x00000fdL, " -253", "%6ld",
+__LINE__, -0x000000bL, "-11", "%d",
+__LINE__, -0x00042a3L, "-17059", "% 6d",
+__LINE__, 0x00000002L, "2", "% X",
+__LINE__, -0x61ead93eL, "-1642780990", "%-0d",
+__LINE__, 0xf2e61f6dL, "f2e61f6d", "%-.4x",
+__LINE__, 0xffd31b93L, "ffd31b93", "%x",
+__LINE__, -0x0000008L, "-8", "%ld",
+__LINE__, 0xffffffffL, "ffffffff", "%00x",
+__LINE__, 0x000000fbL, "+000251", "%+2.6d",
+__LINE__, 0x00000015L, " 15", "%4.X",
+__LINE__, 0x06ec6d96L, "6EC6D96", "%+2.X",
+__LINE__, 0xffff1df7L, "0xffff1df7", "% #1x",
+__LINE__, -0x000004bL, "-75", "%-ld",
+__LINE__, 0x00000008L, "8", "%#.0d",
+__LINE__, 0x00001355L, "4949", "%3.4ld",
+__LINE__, -0x00000f7L, "-247", "%d",
+__LINE__, 0x0000001fL, "31", "%.2ld",
+__LINE__, 0x0000d556L, "D556", "%-X",
+__LINE__, 0xffffd5a5L, "ffffd5a5", "% x",
+__LINE__, -0x0000e34L, "-3636", "%#d",
+__LINE__, -0x0000007L, "-7", "%d",
+__LINE__, 0x01ba10a4L, "1ba10a4", "%x",
+__LINE__, 0xfffff759L, "FFFFF759", "% X",
+__LINE__, -0x80d0adbL, "-135072475", "%d",
+__LINE__, 0x0002bf61L, "2bf61", "%x",
+__LINE__, 0xffff008bL, "FFFF008B", "%-7X",
+__LINE__, 0x00000e72L, "E72", "%X",
+__LINE__, -0x00000eaL, "-234", "%0ld",
+__LINE__, -0x0007b9dL, "-0031645", "%0.7ld",
+__LINE__, 0x0001baaaL, "0X1BAAA", "%#4X",
+__LINE__, 0x0000a57fL, " a57f", "%6.x",
+__LINE__, -0x21a73726L, "-564606758", "%ld",
+__LINE__, 0x06f45c9fL, "0x6f45c9f", "%#.3x",
+__LINE__, 0x00018e5dL, "101981", "%-d",
+__LINE__, 0x0001e69aL, "124570", "%-d",
+__LINE__, -0x0000d26L, " -3366", "% 07.d",
+__LINE__, 0x00000000L, "+", "%+0.ld",
+__LINE__, 0x00003916L, "14614", "%ld",
+__LINE__, 0xfffffd8fL, "fffffd8f", "%-3.x",
+__LINE__, 0x00000011L, "11", "%x",
+__LINE__, 0x000000e7L, "E7", "%X",
+__LINE__, 0xfdf9d89bL, "FDF9D89B", "%X",
+__LINE__, 0x00000a7cL, "a7c", "%x",
+__LINE__, 0x0000003fL, "00003F", "%.6X",
+__LINE__, 0xffffe729L, "FFFFE729", "%X",
+__LINE__, 0xfffffffeL, "fffffffe", "% .6x",
+__LINE__, -0x0000a4bL, "-2635", "%+d",
+__LINE__, 0xffffff50L, "ffffff50", "%0.7x",
+__LINE__, 0xfaf57e8bL, "faf57e8b", "% 4.x",
+__LINE__, -0x0000056L, "-86", "%ld",
+__LINE__, 0x08ed2a4dL, "8ed2a4d", "%4x",
+__LINE__, 0xff8d9081L, "FF8D9081", "%+0.X",
+__LINE__, 0x002730a1L, "2568353", "%4d",
+__LINE__, 0xffff9564L, "ffff9564", "%x",
+__LINE__, -0x0000006L, " -6", "%4ld",
+__LINE__, -0x19890310L, "-428409616", "%0ld",
+__LINE__, 0xd2ce636cL, "d2ce636c", "%+x",
+__LINE__, -0x00001feL, "-510", "%d",
+__LINE__, 0x00000006L, "0000006", "%+0.7x",
+__LINE__, 0xffffffc2L, "0XFFFFFFC2", "%-#.5X",
+__LINE__, -0x00000fdL, "-253", "%+d",
+__LINE__, 0x000216aaL, "0x216aa", "%#x",
+__LINE__, 0xffe36c66L, "ffe36c66", "%x",
+__LINE__, 0x00000002L, "2", "%x",
+__LINE__, -0x0000025L, "-37", "% d",
+__LINE__, 0x0000007eL, "126", "%d",
+__LINE__, 0x0003c1f9L, "+246265", "%+ld",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, -0x00539e7L, "-342503", "%06.ld",
+__LINE__, 0x00000d42L, " 3394", "%#6.ld",
+__LINE__, 0xf73b7c4eL, "F73B7C4E", "%X",
+__LINE__, 0x00000022L, "22", "%.1x",
+__LINE__, 0xffffa883L, "FFFFA883", "%X",
+__LINE__, 0x016ec247L, "16ec247", "%x",
+__LINE__, 0x00000019L, "19", "%+X",
+__LINE__, 0x0000665aL, "665A", "% 2.X",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%-5.X",
+__LINE__, 0x008e3fbcL, "8E3FBC", "%X",
+__LINE__, 0xfffffffaL, "FFFFFFFA", "%X",
+__LINE__, 0x1b806597L, "461399447", "%.2d",
+__LINE__, 0x00000366L, "0000870", "%#1.7ld",
+__LINE__, 0x0001d92eL, "1d92e", "%x",
+__LINE__, 0x000104ceL, "104CE", "%-X",
+__LINE__, 0xfffffe4cL, "fffffe4c", "%x",
+__LINE__, 0x000000e9L, "E9", "%X",
+__LINE__, 0x000a855cL, " 689500", "% d",
+__LINE__, 0x00000075L, "75", "% X",
+__LINE__, -0x0000026L, "-38", "%ld",
+__LINE__, 0xfffff169L, "fffff169", "%-04.2x",
+__LINE__, 0xffffff6fL, "ffffff6f", "%x",
+__LINE__, 0x00000003L, "0x3", "%#x",
+__LINE__, 0x00623babL, "6437803", "%.0d",
+__LINE__, -0x2260224cL, "-576725580", "%ld",
+__LINE__, 0xe7e7a998L, "E7E7A998", "%.1X",
+__LINE__, 0x00000005L, "5", "%X",
+__LINE__, 0x0000b560L, "0xb560", "%#x",
+__LINE__, 0xfe11854dL, "fe11854d", "%-.5x",
+__LINE__, 0x00190014L, "1638420", "%ld",
+__LINE__, 0x0001d22aL, "0X1D22A", "%-#X",
+__LINE__, 0x00000c16L, "c16", "%2x",
+__LINE__, 0x00000d1aL, "3354", "%#d",
+__LINE__, 0x000165f6L, "91638", "%d",
+__LINE__, 0xfffff557L, "0XFFFFF557", "%#X",
+__LINE__, 0x00000588L, " 588", "%07.X",
+__LINE__, 0xf4a72708L, "f4a72708", "%x",
+__LINE__, 0xfff1cba9L, "0xfff1cba9", "% #2.5x",
+__LINE__, 0x000333a4L, "209828", "%d",
+__LINE__, 0x0000179bL, "179B", "% 2.X",
+__LINE__, 0x00000460L, "1120", "%0ld",
+__LINE__, 0xffffff89L, "FFFFFF89", "%X",
+__LINE__, -0x0000012L, "-18", "%ld",
+__LINE__, 0x00004fe0L, "20448", "%0.d",
+__LINE__, 0x00532e77L, "532e77", "%00.x",
+__LINE__, 0xf7b92efeL, "f7b92efe", "%0x",
+__LINE__, -0x0000243L, "-579", "%+1.d",
+__LINE__, 0x34894bb7L, "+881413047", "%+d",
+__LINE__, 0xfffaa189L, "FFFAA189", "% 6X",
+__LINE__, -0x0000579L, "-1401", "%+ld",
+__LINE__, 0x005acb12L, "5acb12", "%5.0x",
+__LINE__, 0xffff890aL, "FFFF890A", "%X",
+__LINE__, 0x010dff2fL, "10DFF2F", "%.7X",
+__LINE__, 0x00005a7fL, "23167", "%#ld",
+__LINE__, 0x000005e3L, "1507", "%#3d",
+__LINE__, -0xa815bcbL, "-176249803", "%d",
+__LINE__, 0xffffffffL, "ffffffff", "%+x",
+__LINE__, 0xfffe0ff7L, "fffe0ff7", "%3x",
+__LINE__, 0xffffffffL, "0XFFFFFFFF", "%#2.1X",
+__LINE__, -0x1cc5ea52L, "-482732626", "%6.d",
+__LINE__, 0x000425edL, "+0271853", "%+.7d",
+__LINE__, 0x00000001L, "1", "%+x",
+__LINE__, -0x48f2a72L, "-76491378", "%7.0d",
+__LINE__, 0xfffffff7L, "FFFFFFF7", "% 0X",
+__LINE__, 0xfd8ffc0aL, "fd8ffc0a", "%.1x",
+__LINE__, 0x0001f56dL, " 1F56D", "%+7.2X",
+__LINE__, 0x000000dbL, " DB", "%6.X",
+__LINE__, 0xffffffc2L, "ffffffc2", "%x",
+__LINE__, 0x00000001L, "001", "%03ld",
+__LINE__, 0xffd89f58L, "ffd89f58", "% 0.x",
+__LINE__, 0xfe1a72fcL, "fe1a72fc", "%x",
+__LINE__, 0xfffff9b6L, "FFFFF9B6", "%X",
+__LINE__, 0x00243633L, "243633", "%X",
+__LINE__, 0x00821bc7L, "+8526791", "%+#0ld",
+__LINE__, 0xfe63f348L, "0XFE63F348", "%#3X",
+__LINE__, 0xff729f19L, "ff729f19", "%4x",
+__LINE__, 0xffff570fL, "FFFF570F", "%+X",
+__LINE__, 0x00a57a42L, "10844738", "%6.3d",
+__LINE__, 0xfe4a3ed0L, "FE4A3ED0", "%6.X",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, 0x000001bbL, "01bb", "% .4x",
+__LINE__, 0x02b4a1e9L, "2b4a1e9", "%-7.x",
+__LINE__, 0x31750683L, "31750683", "%x",
+__LINE__, 0x00001cd7L, "7383", "%#ld",
+__LINE__, 0x0000079dL, "1949", "%d",
+__LINE__, 0xffb8ff3bL, "FFB8FF3B", "%X",
+__LINE__, 0x00a768b6L, "0A768B6", "%-6.7X",
+__LINE__, 0x1c665b48L, "0X1C665B48", "% #X",
+__LINE__, -0x000037dL, "-000893", "%3.6d",
+__LINE__, 0x29890443L, "29890443", "%+0x",
+__LINE__, 0x000000e5L, "e5 ", "%-4x",
+__LINE__, 0xfff2b5faL, "FFF2B5FA", "%X",
+__LINE__, -0x5d32c2bL, "-97725483", "%05ld",
+__LINE__, -0x00016c5L, " -05829", "%+#7.5ld",
+__LINE__, 0x00000644L, "644", "%X",
+__LINE__, -0x018c027L, "-1622055", "%+.1d",
+__LINE__, 0x0000013cL, "0x13c", "%#x",
+__LINE__, 0x00000009L, "+9", "%+#ld",
+__LINE__, 0x00000000L, "0", "%ld",
+__LINE__, -0x018eb19L, "-1633049", "%4.3ld",
+__LINE__, 0xfffff429L, "FFFFF429", "% X",
+__LINE__, 0x0032de67L, "32DE67", "%X",
+__LINE__, 0x0016bdfaL, " 1490426", "% .2ld",
+__LINE__, 0x00000065L, "65", "%+.0X",
+__LINE__, 0x00000072L, " 72", "%+4.2X",
+__LINE__, 0x00075119L, "75119", "%2x",
+__LINE__, 0x000000b8L, "b8", "%x",
+__LINE__, 0x000000d0L, "d0", "%x",
+__LINE__, 0x000000b9L, "b9", "%x",
+__LINE__, 0x003fda9dL, " 4184733", "% #3.d",
+__LINE__, 0x00029a24L, "170532", "%4.d",
+__LINE__, -0x132a337dL, "-321532797", "% ld",
+__LINE__, 0x0000047aL, "0X47A", "%-#X",
+__LINE__, 0x00000000L, "0", "%-ld",
+__LINE__, -0x0d9750bL, "-14251275", "% ld",
+__LINE__, 0x00029d6cL, "29d6c", "%x",
+__LINE__, 0xfb060cc0L, "fb060cc0", "%x",
+__LINE__, 0xffffd524L, "0XFFFFD524", "%#X",
+__LINE__, 0xffffff30L, "ffffff30", "%-5x",
+__LINE__, 0x00001650L, "0005712", "%#0.7d",
+__LINE__, 0x0000b702L, "0B702", "%03.5X",
+__LINE__, 0x000003c1L, "3c1", "% .1x",
+__LINE__, -0x0290412L, "-2688018", "%d",
+__LINE__, -0x00008bfL, "-2239", "%#d",
+__LINE__, -0x0000001L, "-1", "%d",
+__LINE__, 0x0001d750L, "1D750", "%-X",
+__LINE__, 0x006eee92L, "6EEE92", "%-X",
+__LINE__, 0xff812b02L, "ff812b02", "%0x",
+__LINE__, 0xfffffeacL, "FFFFFEAC", "%+0X",
+__LINE__, 0x000003a5L, "3a5", "%x",
+__LINE__, -0x15270ceeL, "-354880750", "%2.ld",
+__LINE__, 0x06b686d2L, "6b686d2", "%0x",
+__LINE__, 0xffe9cdccL, "ffe9cdcc", "%x",
+__LINE__, 0x0ecb168eL, "ecb168e", "%x",
+__LINE__, 0x00000051L, "51", "%-X",
+__LINE__, -0x0018860L, "-100448", "%-0d",
+__LINE__, 0x8f08b82bL, "0x8f08b82b", "%-#.5x",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, 0x0000000eL, "e", "%+01x",
+__LINE__, 0x04cf15bcL, " 80680380", "% #ld",
+__LINE__, 0x50006e8aL, "50006e8a", "%x",
+__LINE__, 0x0002f669L, "194153", "%0d",
+__LINE__, 0x000000a6L, " 166", "% 5.ld",
+__LINE__, -0x04036bbL, "-4208315", "%7.5d",
+__LINE__, 0x00070deaL, "70DEA", "%+X",
+__LINE__, 0x00000964L, "0x964", "%#x",
+__LINE__, 0x0000004dL, "0x4d", "% #3.x",
+__LINE__, -0x0000001L, "-1", "%-0d",
+__LINE__, 0x0000043eL, "1086", "%ld",
+__LINE__, -0x0000001L, "-1", "%-d",
+__LINE__, 0x00000000L, "+0", "%+d",
+__LINE__, 0xfffe68d9L, "FFFE68D9", "%7.X",
+__LINE__, -0x0169199L, "-1479065", "%#.5ld",
+__LINE__, -0x000003dL, "-61", "%ld",
+__LINE__, 0x00000001L, "+1", "%+.1d",
+__LINE__, 0x0001a65dL, "1a65d", "%.5x",
+__LINE__, 0x00000141L, "+000321", "%+#5.6ld",
+__LINE__, 0x00000000L, " 0", "%4x",
+__LINE__, 0x00000408L, "1032", "%-2.3ld",
+__LINE__, 0xffffffedL, "FFFFFFED", "%-X",
+__LINE__, 0xfe832351L, "FE832351", "% .4X",
+__LINE__, 0x003a421bL, "3A421B", "%-X",
+__LINE__, -0x53ed7f25L, "-1408073509", "%ld",
+__LINE__, -0x0000003L, "-0003", "%-5.4ld",
+__LINE__, 0x00000ad0L, " 2768", "%7d",
+__LINE__, 0xfffaf30bL, "FFFAF30B", "%X",
+__LINE__, 0x006349d3L, " 6506963", "% 6.2ld",
+__LINE__, 0x07f0146aL, "7f0146a", "%+3.4x",
+__LINE__, -0x0000002L, " -2", "% 3.ld",
+__LINE__, -0x26e94f3L, "-40801523", "%-#ld",
+__LINE__, -0x0000004L, " -004", "%7.3d",
+__LINE__, 0xfffe8cc9L, "FFFE8CC9", "%0X",
+__LINE__, 0x00000018L, " 18", "%5.x",
+__LINE__, -0x4941de83L, "-1229053571", "% 0.5ld",
+__LINE__, 0x00000000L, " 0", "%6ld",
+__LINE__, 0xfffffffeL, "0XFFFFFFFE", "%-#X",
+__LINE__, -0x0142ae1L, "-1321697", "%4.ld",
+__LINE__, -0x0319e7fL, "-3251839", "%0ld",
+__LINE__, 0x000004ffL, " 4FF", "%7.2X",
+__LINE__, -0x0001c3eL, "-7230", "%#.2ld",
+__LINE__, 0xffffe522L, "ffffe522", "%x",
+__LINE__, 0x0001d1cbL, "+119243", "%+.3ld",
+__LINE__, 0xfad19d52L, "FAD19D52", "%+X",
+__LINE__, 0x00002a7cL, " 10876", "% 0.ld",
+__LINE__, 0x00001449L, "1449", "%X",
+__LINE__, 0x000732b8L, "471736", "%d",
+__LINE__, -0x211a496eL, "-555370862", "%ld",
+__LINE__, -0x0000004L, "-4", "%1.d",
+__LINE__, 0x0295c03dL, "43368509", "%5.ld",
+__LINE__, 0x01fa5722L, "33183522", "%0ld",
+__LINE__, 0xfffbff62L, "0xfffbff62", "%#x",
+__LINE__, 0x000000f5L, " 245", "% 2.d",
+__LINE__, 0x000000a0L, "160", "%-d",
+__LINE__, 0x0000000fL, "15", "%.2ld",
+__LINE__, 0x0bf5f077L, "+200667255", "%+ld",
+__LINE__, -0x14d3e5aL, "-21839450", "%#2.3d",
+__LINE__, -0x21cbe656L, "-567010902", "%ld",
+__LINE__, 0x000002b9L, "697", "%ld",
+__LINE__, 0xfffff9b0L, "FFFFF9B0", "%X",
+__LINE__, 0x007fd9c7L, "8378823", "%3.4d",
+__LINE__, 0x00036d06L, "36d06", "%x",
+__LINE__, 0xffde8052L, "FFDE8052", "%4.6X",
+__LINE__, 0x0000000dL, "13", "%#d",
+__LINE__, 0x68157d93L, "68157d93", "%x",
+__LINE__, 0x00000005L, "5", "%1x",
+__LINE__, 0xfffffff4L, "FFFFFFF4", "%X",
+__LINE__, 0xf5bbf7e9L, "f5bbf7e9", "%+.1x",
+__LINE__, 0x0be98f98L, "BE98F98", "%X",
+__LINE__, 0x00000122L, "00122", "%.5X",
+__LINE__, -0x0000936L, "-2358", "%+#3.0ld",
+__LINE__, 0xfd230f09L, "FD230F09", "%-7X",
+__LINE__, 0x00000089L, "137", "%ld",
+__LINE__, 0x00000078L, " 120", "%7d",
+__LINE__, -0x68ef2b6bL, "-1760504683", "%-ld",
+__LINE__, 0xc24480bbL, "C24480BB", "%+4X",
+__LINE__, 0xfefe36a2L, "FEFE36A2", "%0X",
+__LINE__, -0x35344baL, "-55788730", "%7.d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%+.6X",
+__LINE__, -0x0000f40L, "-3904", "% ld",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "%X",
+__LINE__, 0x58b37c4bL, "58b37c4b", "%2.2x",
+__LINE__, 0x000000e2L, "226", "%#ld",
+__LINE__, 0xfff5ebdeL, "fff5ebde", "%-7.1x",
+__LINE__, 0x0c6ea9beL, "208579006", "%-ld",
+__LINE__, 0xff708c74L, "FF708C74", "% 4.X",
+__LINE__, 0x00000000L, " 0", "% 3X",
+__LINE__, 0x00000004L, " 4", "%03.d",
+__LINE__, 0x0919be7cL, "+152682108", "%+6.d",
+__LINE__, 0x00d4fd1eL, "13958430", "%0d",
+__LINE__, 0xfe77a69eL, "fe77a69e", "%-7.x",
+__LINE__, 0x284ded44L, "676195652", "%-#2ld",
+__LINE__, -0x00006e6L, "-1766", "% ld",
+__LINE__, -0x7dac7eaL, "-131778538", "%.0ld",
+__LINE__, 0x0003c50fL, "247055", "%#d",
+__LINE__, 0xfffffffcL, "fffffffc", "%-x",
+__LINE__, 0xfe0f0d1fL, "fe0f0d1f", "% 5.1x",
+__LINE__, 0x00000009L, "9", "%0ld",
+__LINE__, -0x0175cc1L, "-1531073", "%-04.d",
+__LINE__, 0x000e4da2L, " 937378", "% 4.ld",
+__LINE__, 0x00000762L, "762", "%-0.X",
+__LINE__, 0x005211bfL, "5211bf", "%-x",
+__LINE__, 0xfffffffbL, "fffffffb", "%+2.6x",
+__LINE__, 0x00008862L, "34914", "%ld",
+__LINE__, 0xfffc9754L, "fffc9754", "%+x",
+__LINE__, 0x0000716eL, "716E", "%X",
+__LINE__, 0x000000a8L, "a8", "%x",
+__LINE__, 0xffff84f5L, "ffff84f5", "%0x",
+__LINE__, 0x00005032L, "5032", "%x",
+__LINE__, 0xffe242b4L, "ffe242b4", "%6x",
+__LINE__, 0x002df9bdL, "3013053", "%ld",
+__LINE__, 0xffffe267L, "FFFFE267", "%.5X",
+__LINE__, 0xffffffc7L, "0xffffffc7", "%#x",
+__LINE__, -0x1727c38L, "-24280120", "%d",
+__LINE__, 0x01308072L, "1308072", "%x",
+__LINE__, -0x5883c7cL, "-92814460", "%+ld",
+__LINE__, 0x000030adL, "30ad", "%x",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%X",
+__LINE__, -0x2090a708L, "-546350856", "% d",
+__LINE__, 0x0024e6b4L, "2418356", "%#ld",
+__LINE__, 0x02db71acL, "2DB71AC", "% 6.3X",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%2.7X",
+__LINE__, -0x000074eL, " -1870", "%7.ld",
+__LINE__, -0x0011d84L, "-73092", "%d",
+__LINE__, 0x00160723L, "160723", "%1.3x",
+__LINE__, 0x00412929L, "4270377", "%-d",
+__LINE__, -0x0008fc6L, "-36806", "% d",
+__LINE__, 0x00000002L, "2", "%d",
+__LINE__, 0x0eb67ffaL, "eb67ffa", "%.4x",
+__LINE__, 0x05b86c3cL, "95972412", "%4.4d",
+__LINE__, 0xffffca9cL, "FFFFCA9C", "% 4.X",
+__LINE__, 0x0007d571L, "7d571", "%-0x",
+__LINE__, -0x000239bL, "-09115", "%5.5d",
+__LINE__, -0x0000155L, " -341", "%5.3ld",
+__LINE__, 0x00000034L, "34", "%x",
+__LINE__, -0x0000051L, "-81", "%.1ld",
+__LINE__, 0x309bbbe0L, "309bbbe0", "%x",
+__LINE__, 0x0075be1eL, " 7716382", "% #ld",
+__LINE__, 0x000002d5L, "2d5", "%x",
+__LINE__, 0x006b466dL, "6B466D", "%-0X",
+__LINE__, 0x01d6c30fL, "1D6C30F", "%4.X",
+__LINE__, 0x00000003L, " 3", "%07.x",
+__LINE__, 0xfffcc102L, "FFFCC102", "%6.X",
+__LINE__, 0xffffffffL, "0XFFFFFFFF", "%#X",
+__LINE__, 0xfffffffeL, "fffffffe", "%+x",
+__LINE__, 0x00000005L, "5", "%ld",
+__LINE__, 0xff060284L, "ff060284", "%x",
+__LINE__, 0x007a3325L, "7A3325", "%-X",
+__LINE__, 0xf5f595bdL, "F5F595BD", "%0X",
+__LINE__, 0xfffa3a10L, "FFFA3A10", "%0X",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, -0x15078f9L, "-22051065", "%7d",
+__LINE__, -0x0000002L, "-000002", "%.6d",
+__LINE__, 0x00000036L, "54", "%1.1ld",
+__LINE__, -0xbbecf6aL, "-197054314", "%ld",
+__LINE__, 0x0000043dL, "43D", "%X",
+__LINE__, 0xfffffffaL, "0xfffffffa", "% #6.x",
+__LINE__, 0x016759f8L, "23550456", "%0.ld",
+__LINE__, 0x000052d2L, "+21202", "%+6.2d",
+__LINE__, -0x007d232L, "-512562", "%ld",
+__LINE__, 0x00240be0L, "2362336", "%.1d",
+__LINE__, -0x0000001L, "-1", "%0d",
+__LINE__, 0xfffffffaL, "FFFFFFFA", "%X",
+__LINE__, -0x0000e88L, "-3720", "%ld",
+__LINE__, 0xfffffa9bL, "FFFFFA9B", "%.5X",
+__LINE__, 0x09296eebL, "153710315", "%-1.0d",
+__LINE__, 0x001f46fcL, "0X1F46FC", "%#X",
+__LINE__, 0x00000006L, "6", "%X",
+__LINE__, 0xffffff87L, "0XFFFFFF87", "%+#X",
+__LINE__, 0x00000469L, "0469", "%04X",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, 0x00000000L, "", "%.0ld",
+__LINE__, -0x52bc137L, "-86753591", "%-#3ld",
+__LINE__, -0x2bddb08L, "-45996808", "%-3.d",
+__LINE__, 0x041367f7L, "41367F7", "%+X",
+__LINE__, -0x0018eb5L, "-102069", "%+ld",
+__LINE__, -0x0000537L, "-1335", "%#ld",
+__LINE__, -0x6f159ff4L, "-1863688180", "%+1.d",
+__LINE__, 0x00112ac8L, "0X112AC8", "%#6.3X",
+__LINE__, 0x00000000L, " ", "%3.d",
+__LINE__, 0x0008afe8L, "08afe8", "%+3.6x",
+__LINE__, 0x00000015L, "21", "%ld",
+__LINE__, -0x02b7130L, "-2847024", "% #2.4d",
+__LINE__, 0xffffffd0L, "FFFFFFD0", "%X",
+__LINE__, -0x6970fa1L, "-110563233", "%+#.4ld",
+__LINE__, 0x06387dccL, "0X6387DCC", "%-#X",
+__LINE__, 0xffffd506L, "ffffd506", "%+6x",
+__LINE__, -0x00fe5cdL, "-1041869", "%-#7d",
+__LINE__, -0x0c35bf6L, "-12803062", "%-03d",
+__LINE__, -0x0020d89L, "-134537", "%#d",
+__LINE__, -0x0c7aed3L, "-13086419", "%-ld",
+__LINE__, -0x000362aL, "-13866", "%#.4ld",
+__LINE__, -0x02d05f0L, "-2950640", "%#ld",
+__LINE__, 0x02de1321L, "0x2de1321", "%#7.x",
+__LINE__, 0xffb56428L, "0xffb56428", "%#x",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%X",
+__LINE__, 0xf072292dL, "F072292D", "%.5X",
+__LINE__, -0x0f4b0f2L, "-16036082", "%.5ld",
+__LINE__, 0x01b81885L, "28842117", "%5d",
+__LINE__, -0x009cfa6L, "-642982", "%d",
+__LINE__, 0xfffffffdL, "0XFFFFFFFD", "%-#.5X",
+__LINE__, 0x0dc97a66L, "DC97A66", "%2.X",
+__LINE__, 0x000000beL, "190", "%.0d",
+__LINE__, 0xffffe1c7L, "FFFFE1C7", "% X",
+__LINE__, 0x01883b9aL, "1883b9a", "%3x",
+__LINE__, 0xffffdde1L, "ffffdde1", "%+x",
+__LINE__, 0x2f1b4e32L, "+790318642", "%+ld",
+__LINE__, 0x000129aaL, "129aa", "%x",
+__LINE__, -0x00092c2L, "-37570", "%d",
+__LINE__, 0x00070fbdL, "70fbd", "%x",
+__LINE__, -0x00000eaL, "-234", "%+4ld",
+__LINE__, 0xfffffffeL, "fffffffe", "%x",
+__LINE__, 0x0091c7f7L, "91C7F7", "% .3X",
+__LINE__, -0x0c14fe2L, "-12668898", "%d",
+__LINE__, -0x0017c15L, "-97301", "%d",
+__LINE__, -0x00005d0L, "-0001488", "%5.7d",
+__LINE__, 0x0114c36eL, "18137966", "%0d",
+__LINE__, 0xffffffffL, "ffffffff", "%+x",
+__LINE__, 0x0ac76e78L, "180842104", "%d",
+__LINE__, 0x001976cdL, " 1668813", "% 4.ld",
+__LINE__, -0x0642319L, "-6562585", "% d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%X",
+__LINE__, -0x035019dL, "-3473821", "%.7d",
+__LINE__, -0x0000061L, "-97", "%#3.d",
+__LINE__, 0x0000001fL, " 31", "% 6.1ld",
+__LINE__, -0x0000024L, "-36", "%d",
+__LINE__, 0x000b3785L, "735109", "%ld",
+__LINE__, 0xfffffda9L, "fffffda9", "%-x",
+__LINE__, 0x00254832L, "2443314", "%-ld",
+__LINE__, 0xfffffd40L, "FFFFFD40", "%0X",
+__LINE__, -0x0006105L, "-24837", "%+#d",
+__LINE__, 0x00000006L, "+6", "%+d",
+__LINE__, 0xffd40fd8L, "ffd40fd8", "%3.x",
+__LINE__, -0x000988eL, "-39054", "%03d",
+__LINE__, 0x0005ad8bL, "5AD8B", "%0.0X",
+__LINE__, 0x00000001L, "1", "%d",
+__LINE__, 0xfe1f59b7L, "fe1f59b7", "%4.x",
+__LINE__, -0x0000022L, "-34", "%#d",
+__LINE__, 0x0018e3e9L, "18E3E9", "% X",
+__LINE__, 0xffffff25L, "FFFFFF25", "%2.X",
+__LINE__, -0x00002c6L, "-710", "%1.ld",
+__LINE__, 0x00009765L, "38757", "%5ld",
+__LINE__, 0xfe197646L, "FE197646", "%-X",
+__LINE__, 0x00000001L, " 1", "%+5.x",
+__LINE__, -0x0000002L, "-2", "%#ld",
+__LINE__, 0x0072f6beL, "72F6BE", "%1X",
+__LINE__, -0x000f06dL, "-61549", "%-d",
+__LINE__, 0x00000001L, " 1", "%5X",
+__LINE__, 0x328cba28L, " 848083496", "% 2.ld",
+__LINE__, 0x0000cddcL, "cddc", "%.1x",
+__LINE__, 0xfffffff9L, "fffffff9", "%7x",
+__LINE__, 0x00baf511L, "BAF511", "%-5.6X",
+__LINE__, 0x00000001L, " 1", "%4.ld",
+__LINE__, 0x0001e4b0L, "+124080", "%+ld",
+__LINE__, -0x07548f3L, "-7686387", "% 6.d",
+__LINE__, -0x01b14eaL, "-1774826", "% #0d",
+__LINE__, -0x000005cL, "-92 ", "%-04ld",
+__LINE__, -0x00000aeL, "-174", "%+.3ld",
+__LINE__, 0x0000008cL, "0X8C", "%+#X",
+__LINE__, 0x14c02360L, "14C02360", "%.6X",
+__LINE__, 0xfffffff6L, "FFFFFFF6", "%X",
+__LINE__, 0x009f4ee5L, "9f4ee5", "%x",
+__LINE__, 0x00000035L, "35", "%X",
+__LINE__, -0x00000ebL, "-235", "%ld",
+__LINE__, 0x1552ced8L, "1552CED8", "%04X",
+__LINE__, 0x0000002aL, " 2A", "%5X",
+__LINE__, 0xffffffffL, "ffffffff", "% x",
+__LINE__, -0xdec0db2L, "-233573810", "%d",
+__LINE__, 0x001e2ef0L, "1978096", "%2.d",
+__LINE__, 0xffffef24L, "ffffef24", "%.5x",
+__LINE__, 0xfffe6a6cL, "fffe6a6c", "%+x",
+__LINE__, -0x0000004L, "-4", "% ld",
+__LINE__, 0xfe3c6743L, "fe3c6743", "%.1x",
+__LINE__, 0x0000033dL, "829", "%0ld",
+__LINE__, -0x00006a0L, " -1696", "% 7.ld",
+__LINE__, 0xffffffdbL, "ffffffdb", "%0.0x",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%3.3X",
+__LINE__, -0x0000004L, "-4", "%#ld",
+__LINE__, 0x00b32b56L, "B32B56", "%X",
+__LINE__, 0xffffffffL, "0xffffffff", "%+#x",
+__LINE__, 0x01cd1a48L, "1cd1a48", "%+7x",
+__LINE__, 0xffffffdaL, "ffffffda", "%x",
+__LINE__, 0x1886509eL, "1886509E", "% X",
+__LINE__, 0x000000ebL, "235", "%0d",
+__LINE__, 0xfffffff4L, "fffffff4", "%0x",
+__LINE__, 0x00000547L, "547", "% X",
+__LINE__, 0x000017e6L, "17e6", "%-2.x",
+__LINE__, 0x00001dc4L, "7620", "%d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%3.0X",
+__LINE__, 0xffff93faL, "0XFFFF93FA", "%#X",
+__LINE__, 0xfffffe1cL, "FFFFFE1C", "%-X",
+__LINE__, 0x00000000L, "", "% .0x",
+__LINE__, 0x000000a1L, "A1", "%X",
+__LINE__, 0xffffffffL, "0xffffffff", "%#x",
+__LINE__, -0x0001460L, "-05216", "%+#.5d",
+__LINE__, 0x00000001L, "1 ", "%-6.x",
+__LINE__, 0xfffd5324L, "FFFD5324", "%+2.6X",
+__LINE__, 0x00000007L, " 07", "%06.2d",
+__LINE__, 0x00000003L, "3", "%-X",
+__LINE__, 0xfffffdb7L, "0XFFFFFDB7", "%+#X",
+__LINE__, 0xfffff4ccL, "fffff4cc", "%0x",
+__LINE__, 0x00000000L, "0 ", "%-5X",
+__LINE__, 0x00758c96L, "758C96", "%X",
+__LINE__, -0x0000001L, "-1", "%-ld",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, 0x03f03cafL, "66075823", "%.2ld",
+__LINE__, 0x0000a87cL, "a87c", "%1.x",
+__LINE__, 0x00000034L, "34", "%X",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0x00010167L, "10167", "%x",
+__LINE__, -0x00007ceL, "-1998 ", "%-6ld",
+__LINE__, 0x00000001L, "1", "%.0d",
+__LINE__, 0x00d94ceeL, "14241006", "%ld",
+__LINE__, -0x0000008L, "-8", "% d",
+__LINE__, -0x71520839L, "-1901201465", "%+0d",
+__LINE__, 0x0000035aL, "35a", "%-x",
+__LINE__, 0xfffd2f68L, "FFFD2F68", "%-X",
+__LINE__, 0x0006ea53L, "453203", "%1d",
+__LINE__, 0x000000dfL, "DF", "% 1X",
+__LINE__, 0xfffffffeL, "fffffffe", "% 7x",
+__LINE__, 0x00000156L, "156", "% X",
+__LINE__, 0x00037ac9L, " 228041", "% ld",
+__LINE__, 0xffffffdeL, "FFFFFFDE", "%0.5X",
+__LINE__, 0x00000025L, "37", "%-0.ld",
+__LINE__, -0x4133686L, "-68368006", "%2ld",
+__LINE__, -0x000003bL, "-59", "%.2ld",
+__LINE__, 0xfffff910L, "fffff910", "% 00.0x",
+__LINE__, 0xff9ec802L, "FF9EC802", "%2.6X",
+__LINE__, 0x00000008L, "0X8", "%#1X",
+__LINE__, 0xfffffff7L, "FFFFFFF7", "%-X",
+__LINE__, 0x0029a4daL, "2729178", "%04.ld",
+__LINE__, 0x007d1588L, "8197512", "%#d",
+__LINE__, 0x0007e86dL, "518253", "%0d",
+__LINE__, 0xfffffff9L, "fffffff9", "%x",
+__LINE__, 0x00000002L, "002", "%.3d",
+__LINE__, 0x00006ec1L, "6EC1", "%2X",
+__LINE__, 0x0000300cL, "12300", "%-d",
+__LINE__, -0x0000002L, "-2", "%+ld",
+__LINE__, -0x0000002L, "-2", "%ld",
+__LINE__, -0x00015d5L, "-005589", "%#.6ld",
+__LINE__, 0x00000041L, "65", "%d",
+__LINE__, 0x00000229L, "0000229", "% 0.7x",
+__LINE__, 0xfffffffbL, "fffffffb", "%03.x",
+__LINE__, 0x00093262L, "0602722", "%.7d",
+__LINE__, -0x00037b4L, "-14260", "%-0ld",
+__LINE__, 0xfffffffcL, "fffffffc", "%-x",
+__LINE__, 0xf24cb3e6L, "f24cb3e6", "%1x",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "%0X",
+__LINE__, 0x00000031L, "0000049", "%00.7ld",
+__LINE__, 0x00000bb3L, "BB3", "%.1X",
+__LINE__, -0x0000001L, "-0001", "%+#4.4ld",
+__LINE__, -0x0000001L, "-1", "% d",
+__LINE__, 0x00022c0cL, "22c0c", "%-x",
+__LINE__, 0xffffffd4L, "ffffffd4", "%x",
+__LINE__, 0x000729c6L, "469446", "%3.d",
+__LINE__, 0xb180feaeL, "b180feae", "%3.x",
+__LINE__, 0x124fac15L, "307211285", "%-0ld",
+__LINE__, -0x0000004L, "-4", "%ld",
+__LINE__, 0x0000006aL, "106", "%#d",
+__LINE__, 0x0000297fL, "297F", "%+3X",
+__LINE__, 0x0000000eL, "14", "%0ld",
+__LINE__, 0x00000027L, "27", "%0.1X",
+__LINE__, 0xffeb98ebL, "ffeb98eb", "% 05.2x",
+__LINE__, 0xfffff19bL, "FFFFF19B", "%+X",
+__LINE__, 0x00025992L, "154002", "%6.6d",
+__LINE__, 0x00000040L, " 040", "%6.3X",
+__LINE__, 0x00000a9eL, " 0a9e", "%5.4x",
+__LINE__, 0x00c7f2ccL, "c7f2cc", "%x",
+__LINE__, 0x000325e6L, " 325E6", "%6.X",
+__LINE__, -0x69faad3L, "-111127251", "%d",
+__LINE__, -0x059a307L, "-5874439", "% ld",
+__LINE__, 0xfffffff6L, "0xfffffff6", "%#0.0x",
+__LINE__, 0x0030fdf3L, "30fdf3", "%x",
+__LINE__, 0x00007343L, "+29507", "%+#2d",
+__LINE__, 0x0003cf4bL, "0X3CF4B", "% #.2X",
+__LINE__, 0x00000433L, "+1075", "%+0ld",
+__LINE__, 0xfffffffdL, "fffffffd", "%+.3x",
+__LINE__, 0x0ae30c4eL, "ae30c4e", "%+00x",
+__LINE__, 0x0002540fL, "02540f", "%-.6x",
+__LINE__, -0x0000001L, " -01", "% #5.2ld",
+__LINE__, 0xffffffe7L, "0xffffffe7", "% #5.x",
+__LINE__, 0x0000005bL, "91", "%d",
+__LINE__, 0x00001f9bL, "8091", "%.4ld",
+__LINE__, 0xfffff315L, "fffff315", "%4.x",
+__LINE__, -0x130eec41L, "-319745089", "% ld",
+__LINE__, 0xfff8fe13L, "FFF8FE13", "%X",
+__LINE__, -0x0000004L, "-00004", "%5.5d",
+__LINE__, 0x00000669L, "669", "%0X",
+__LINE__, -0x0000004L, "-4", "%d",
+__LINE__, 0xf5e81496L, "F5E81496", "% 6X",
+__LINE__, -0x0000001L, "-1", "% 0d",
+__LINE__, 0xfffffff7L, "fffffff7", "%x",
+__LINE__, 0x000001deL, "478", "%d",
+__LINE__, 0x0000623eL, "25150", "%5.0d",
+__LINE__, 0xffffffa8L, "FFFFFFA8", "%+X",
+__LINE__, -0x0000117L, "-279", "% ld",
+__LINE__, -0x0000517L, "-1303", "%d",
+__LINE__, 0xfffff9d5L, "fffff9d5", "% x",
+__LINE__, 0x000001ccL, "1CC", "%-X",
+__LINE__, 0x0000019aL, "0000410", "%.7d",
+__LINE__, 0x00000003L, "3 ", "%-06X",
+__LINE__, 0x00000009L, "0x9", "%#0x",
+__LINE__, 0xfd544610L, "0XFD544610", "% #X",
+__LINE__, 0xfffffffcL, "fffffffc", "%+x",
+__LINE__, 0x00009437L, "37943", "%ld",
+__LINE__, -0x00b5ea6L, "-745126", "%d",
+__LINE__, 0xffffffd8L, "ffffffd8", "%6x",
+__LINE__, 0x00002a2dL, "10797", "%.3ld",
+__LINE__, 0x00275238L, "2576952", "%0ld",
+__LINE__, 0xfff90a34L, "FFF90A34", "%-7X",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "% .7X",
+__LINE__, -0xb3b673eL, "-188442430", "% ld",
+__LINE__, 0xfffff67aL, "0xfffff67a", "%#0.x",
+__LINE__, 0x0000dff6L, " dff6", "%+7.x",
+__LINE__, 0xffee46e3L, "ffee46e3", "%x",
+__LINE__, 0x00001a66L, " 0006758", "% 7.7d",
+__LINE__, 0x0002b475L, "2B475", "%.4X",
+__LINE__, 0x0002090dL, "002090d", "%.7x",
+__LINE__, -0x0057838L, "-358456", "%#ld",
+__LINE__, 0x00000004L, "0x4", "%#x",
+__LINE__, 0x0574cb62L, "91540322", "%#7d",
+__LINE__, -0x0054388L, "-344968", "% #d",
+__LINE__, 0x000421c2L, "421C2", "% X",
+__LINE__, 0x00000003L, "3", "%0d",
+__LINE__, 0xffffe2e2L, "ffffe2e2", "% 5.x",
+__LINE__, 0x00000021L, "+33", "%+d",
+__LINE__, -0x0020033L, "-131123", "%ld",
+__LINE__, -0x0000001L, " -1", "%4.ld",
+__LINE__, 0x000000fdL, "000fd", "%3.5x",
+__LINE__, 0x023e4337L, "37634871", "%1d",
+__LINE__, 0x6e823d96L, "6E823D96", "% X",
+__LINE__, 0xfff0e133L, "fff0e133", "%x",
+__LINE__, -0x000deccL, "-57036", "%3d",
+__LINE__, 0x004397b8L, "4429752", "%0d",
+__LINE__, -0x0000023L, " -35", "%6d",
+__LINE__, 0xffe701caL, "FFE701CA", "%3X",
+__LINE__, 0x000c0319L, "+787225", "%+.6d",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0xfffffe1dL, "FFFFFE1D", "%X",
+__LINE__, 0xfffffb33L, "fffffb33", "%x",
+__LINE__, 0x02b5e30aL, "45474570", "%d",
+__LINE__, 0x000074ebL, "29931", "%03.ld",
+__LINE__, -0x4e42e310L, "-1313006352", "%-0.d",
+__LINE__, -0x000007bL, "-123", "%d",
+__LINE__, 0x00000160L, " 352", "% d",
+__LINE__, -0x16af31ecL, "-380580332", "%#ld",
+__LINE__, -0x000006eL, "-000110", "%07ld",
+__LINE__, 0x232699a0L, "232699a0", "%7.x",
+__LINE__, 0x00f9b8e5L, "+16365797", "%+0d",
+__LINE__, 0x0000000cL, "C", "%X",
+__LINE__, 0xfffffd4fL, "FFFFFD4F", "%X",
+__LINE__, 0xffffe7bbL, "FFFFE7BB", "%.7X",
+__LINE__, -0x0000163L, "-355", "%d",
+__LINE__, 0x00070315L, " 459541", "% #2.d",
+__LINE__, -0x7d5c12aL, "-131449130", "% 6.ld",
+__LINE__, 0xffffffb2L, "FFFFFFB2", "%X",
+__LINE__, -0x0004aadL, "-19117", "%+6.4ld",
+__LINE__, 0x00115586L, "1136006", "%0d",
+__LINE__, -0x0000021L, "-33", "%d",
+__LINE__, 0x093ce01eL, "93ce01e", "% 5x",
+__LINE__, 0x00672135L, "672135", "% x",
+__LINE__, 0x05f4abd5L, "0x5f4abd5", "%+#6.x",
+__LINE__, -0x0448b03L, "-4492035", "%-0.2ld",
+__LINE__, 0x00000000L, "0", "%#x",
+__LINE__, 0x1987217eL, "428286334", "%d",
+__LINE__, 0x000010f6L, "10f6", "%-x",
+__LINE__, 0x0000177aL, "177a", "%1x",
+__LINE__, 0xfffffefdL, "FFFFFEFD", "%7X",
+__LINE__, -0x095cbf8L, "-9817080", "%-5ld",
+__LINE__, 0x0000008aL, "138", "%2.0ld",
+__LINE__, 0xfffe80adL, "fffe80ad", "%0x",
+__LINE__, -0x1a4c8f7L, "-27576567", "%d",
+__LINE__, 0x00000000L, "0", "%-x",
+__LINE__, 0x0000a82bL, "43051", "%-ld",
+__LINE__, 0x000000ebL, "235", "%2.3ld",
+__LINE__, -0x0002747L, "-10055", "%d",
+__LINE__, 0x00000319L, "0X319", "%#X",
+__LINE__, 0xfffffcfeL, "FFFFFCFE", "% X",
+__LINE__, 0x00050f0eL, "50f0e", "%-1x",
+__LINE__, -0x398e09eL, "-60350622", "%0.7ld",
+__LINE__, 0x00000000L, " ", "%2.ld",
+__LINE__, 0x00000049L, "00049", "% .5X",
+__LINE__, -0x00000ddL, " -221", "%+#5ld",
+__LINE__, 0xf6db2facL, "f6db2fac", "%-07x",
+__LINE__, 0x0000004fL, "4F", "% .0X",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0xfd07f692L, "fd07f692", "%x",
+__LINE__, 0xdb98bde0L, "db98bde0", "%x",
+__LINE__, 0x00000271L, "0271", "% 3.4x",
+__LINE__, -0x000115aL, "-4442", "%#1.ld",
+__LINE__, 0x0002f5f2L, "194034", "%ld",
+__LINE__, -0x0000152L, " -338", "%+7ld",
+__LINE__, 0x00059336L, "365366", "%d",
+__LINE__, 0xfffffff6L, "fffffff6", "%-7x",
+__LINE__, 0xfb916c51L, "fb916c51", "%-x",
+__LINE__, 0xffff413dL, "FFFF413D", "%-X",
+__LINE__, 0xf2576910L, "F2576910", "%-4.X",
+__LINE__, 0xfffc7730L, "fffc7730", "%5.x",
+__LINE__, 0x000002e6L, "+742", "%+1d",
+__LINE__, -0x00001bfL, "-447", "%3d",
+__LINE__, 0x000002e1L, "2E1", "%-X",
+__LINE__, 0x00000096L, "150", "%#0ld",
+__LINE__, 0x000002bdL, "701", "%d",
+__LINE__, -0x0053386L, "-340870", "%#d",
+__LINE__, 0xfffdb076L, "FFFDB076", "%X",
+__LINE__, 0x00004dc5L, " +19909", "%+07.ld",
+__LINE__, 0x00000f7aL, " F7A", "%4X",
+__LINE__, 0x02405000L, " 37769216", "% ld",
+__LINE__, 0xfffce68dL, "fffce68d", "%0x",
+__LINE__, -0x35b3af2L, "-56310514", "%-ld",
+__LINE__, -0x0238631L, "-2328113", "%.4d",
+__LINE__, -0x000001eL, "-030", "%.3ld",
+__LINE__, 0xffffffddL, "FFFFFFDD", "%.4X",
+__LINE__, 0x0013f6acL, "13f6ac", "%02.x",
+__LINE__, 0xfffffffaL, "fffffffa", "%+07.x",
+__LINE__, -0x000192bL, " -6443", "%6.d",
+__LINE__, 0x0000058bL, "+1419", "%+d",
+__LINE__, 0x00001391L, "5009", "%ld",
+__LINE__, -0x0041a57L, "-268887", "%1ld",
+__LINE__, 0xfffff266L, "0xfffff266", "%+#6.6x",
+__LINE__, 0x0000018bL, " 395", "%6.ld",
+__LINE__, 0x009ae24dL, "+10150477", "%+ld",
+__LINE__, 0x0000007eL, "7E", "%X",
+__LINE__, 0xfffffd53L, "FFFFFD53", "% 0X",
+__LINE__, 0x000002faL, "2FA", "%-1.3X",
+__LINE__, 0x000000a4L, "164", "%0d",
+__LINE__, 0x00001833L, "6195", "%ld",
+__LINE__, -0x0000001L, "-1", "%d",
+__LINE__, 0xf2fcbd9bL, "F2FCBD9B", "%+0.2X",
+__LINE__, 0x00004a8aL, "4A8A", "%X",
+__LINE__, -0x10695cdaL, "-275340506", "%d",
+__LINE__, 0x00000037L, "37", "%X",
+__LINE__, 0x00082d5cL, "82D5C", "%+0.5X",
+__LINE__, 0xfffffe01L, "fffffe01", "% 5.3x",
+__LINE__, 0x000005eaL, "05EA", "% 1.4X",
+__LINE__, 0x0e0b8826L, "e0b8826", "%2x",
+__LINE__, -0x0000161L, "-353", "%+d",
+__LINE__, 0x19e3014aL, "19E3014A", "%+5X",
+__LINE__, 0x00000140L, "140", "%x",
+__LINE__, 0xffff84b9L, "FFFF84B9", "%X",
+__LINE__, -0x0005776L, "-22390", "%+5ld",
+__LINE__, 0x0162ad61L, "162AD61", "% X",
+__LINE__, 0x00002395L, "2395", "%X",
+__LINE__, 0x003702ecL, "3605228", "%5.2d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%7X",
+__LINE__, 0x00001778L, "0x1778", "%#5.x",
+__LINE__, 0xc52bef7fL, "C52BEF7F", "%X",
+__LINE__, 0xfffffec4L, "FFFFFEC4", "%X",
+__LINE__, 0x00000006L, "6", "%X",
+__LINE__, 0x00000000L, "000", "%03.3x",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0xffff6c46L, "FFFF6C46", "% 2.2X",
+__LINE__, -0x1506098L, "-22044824", "%01.d",
+__LINE__, 0x03415cafL, "3415caf", "%x",
+__LINE__, -0x00007b4L, "-1972", "%#4.4d",
+__LINE__, -0x00158c9L, "-88265", "%03.4d",
+__LINE__, 0x6947c336L, "1766310710", "%.6d",
+__LINE__, 0x0000017cL, "17C", "% 0X",
+__LINE__, -0x00001b7L, "-439", "% 0ld",
+__LINE__, 0x06a7575aL, "6A7575A", "%-.0X",
+__LINE__, 0x000b3459L, "734297", "%ld",
+__LINE__, -0x395d8ddL, "-60152029", "%ld",
+__LINE__, 0x00036bb3L, "224179", "%-6.d",
+__LINE__, 0xffff14ffL, "FFFF14FF", "%X",
+__LINE__, -0x15910e4fL, "-361827919", "%-0d",
+__LINE__, -0x0000004L, "-4", "%#d",
+__LINE__, 0xf7f7adacL, "F7F7ADAC", "% 3.X",
+__LINE__, 0xffffff74L, "FFFFFF74", "%0X",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, -0x000007bL, "-123 ", "%-7.d",
+__LINE__, -0x000002cL, "-44", "%d",
+__LINE__, -0x000002bL, " -43", "%5d",
+__LINE__, 0x0000ae5fL, "44639", "%d",
+__LINE__, 0x003cbc63L, "3CBC63", "%X",
+__LINE__, 0xfffffffcL, "0XFFFFFFFC", "%#5.7X",
+__LINE__, 0x0003e044L, "3E044", "%X",
+__LINE__, -0x0000c46L, "-3142", "%.1d",
+__LINE__, 0xff18f4bbL, "FF18F4BB", "%0X",
+__LINE__, 0xfffffffdL, "FFFFFFFD", "%.1X",
+__LINE__, -0x01c0f27L, "-1838887", "%0d",
+__LINE__, -0x1242901fL, "-306352159", "%.4ld",
+__LINE__, 0x1775c10aL, "393593098", "%6.ld",
+__LINE__, 0x00000001L, " 1", "%03.d",
+__LINE__, 0xfff1fd30L, "0xfff1fd30", "%#x",
+__LINE__, 0x00000191L, "191", "%0.X",
+__LINE__, 0x2e597178L, "777613688", "%2.ld",
+__LINE__, -0x4ef0cf3L, "-82775283", "%+.6ld",
+__LINE__, -0x0000085L, " -133", "%6.d",
+__LINE__, 0x0000014dL, "333 ", "%-5ld",
+__LINE__, -0xc03bd74L, "-201571700", "%07.6ld",
+__LINE__, -0x000000aL, "-10", "%d",
+__LINE__, 0x01f5e86eL, "32893038", "%#2.ld",
+__LINE__, 0x00000033L, "0X33", "% #X",
+__LINE__, 0x0087c797L, " 8898455", "% 7.d",
+__LINE__, -0x0001205L, "-4613", "%5d",
+__LINE__, 0x00000192L, " 192", "%7.X",
+__LINE__, 0x000e6c00L, "945152", "%6.1ld",
+__LINE__, 0x00018629L, " 99881", "% d",
+__LINE__, -0x04739c6L, "-4667846", "%-01.3ld",
+__LINE__, 0x00001f42L, "8002", "%d",
+__LINE__, 0x00000cafL, "3247", "%d",
+__LINE__, -0x4992e24L, "-77147684", "%#.6d",
+__LINE__, 0x0000001dL, "1d", "%-0x",
+__LINE__, 0x14d79f03L, "349675267", "%0ld",
+__LINE__, 0x00000dd4L, " 03540", "%#6.5ld",
+__LINE__, 0x0005f30eL, "0X5F30E", "%#X",
+__LINE__, 0x00000157L, "157", "%X",
+__LINE__, -0x9281698L, "-153622168", "%d",
+__LINE__, -0x000004aL, "-74", "%d",
+__LINE__, -0x0010c9eL, "-68766", "%-0d",
+__LINE__, 0x00000059L, "00089", "%.5ld",
+__LINE__, -0x06959e3L, "-6904291", "% 4.d",
+__LINE__, 0xfbea12b1L, "0XFBEA12B1", "%+#X",
+__LINE__, 0xffffdfb1L, "FFFFDFB1", "%2.6X",
+__LINE__, 0x0434faacL, "434faac", "%.5x",
+__LINE__, 0xffffffffL, "ffffffff", "% x",
+__LINE__, 0x00000b32L, "B32", "%0X",
+__LINE__, 0x00000047L, "71", "%.1d",
+__LINE__, 0x00070befL, " 0461807", "% .7d",
+__LINE__, 0x00000038L, "38", "% 0x",
+__LINE__, 0x00000000L, " 0", "%6X",
+__LINE__, 0xfff9c011L, "FFF9C011", "%2X",
+__LINE__, 0xfffffffeL, "fffffffe", "%7x",
+__LINE__, 0xfffffff9L, "FFFFFFF9", "%X",
+__LINE__, -0x016a095L, "-1482901", "%4.0ld",
+__LINE__, -0x000001cL, "-28", "% ld",
+__LINE__, 0xfffd6133L, "0xfffd6133", "%#x",
+__LINE__, 0x000004a4L, "0x4a4", "%#x",
+__LINE__, 0x000003c2L, "0962", "%.4d",
+__LINE__, -0x000323bL, "-12859", "%+#d",
+__LINE__, 0x0f620237L, "F620237", "%X",
+__LINE__, 0x00007863L, "007863", "%.6X",
+__LINE__, 0x0000002cL, " 44", "% #ld",
+__LINE__, 0xfffffff0L, "fffffff0", "%03.6x",
+__LINE__, 0xffff6346L, "FFFF6346", "%1.X",
+__LINE__, 0x00063188L, "63188", "% x",
+__LINE__, 0xfffff91cL, "fffff91c", "%-.3x",
+__LINE__, 0x004cd0b4L, "4CD0B4", "%-2.X",
+__LINE__, 0x06b4d739L, "112514873", "%0.1d",
+__LINE__, -0x0009bebL, "-39915", "%.2d",
+__LINE__, 0x0000831bL, "33563", "%d",
+__LINE__, 0x00000001L, "1", "%X",
+__LINE__, -0x942d76bL, "-155375467", "% #0ld",
+__LINE__, 0xffff2a95L, "FFFF2A95", "%2X",
+__LINE__, 0x00548d5eL, "5541214", "%.3ld",
+__LINE__, 0x0b5e1a01L, "B5E1A01", "% .7X",
+__LINE__, 0xfffffc22L, "fffffc22", "%6x",
+__LINE__, -0x0000dd7L, "-3543", "%-.3ld",
+__LINE__, 0xfffff834L, "FFFFF834", "%X",
+__LINE__, 0x0365f762L, "57014114", "%ld",
+__LINE__, -0x0000003L, "-3", "%d",
+__LINE__, 0x3bd998a3L, "1004116131", "%d",
+__LINE__, 0xfffff6c9L, "FFFFF6C9", "%+X",
+__LINE__, 0xffffded9L, "FFFFDED9", "%-.1X",
+__LINE__, -0x00fbb5aL, "-1031002", "% 1.0d",
+__LINE__, 0xffffffb7L, "ffffffb7", "%6.x",
+__LINE__, 0xff1b8ac3L, "FF1B8AC3", "%-X",
+__LINE__, 0xfffffff2L, "FFFFFFF2", "%00.X",
+__LINE__, -0x000013dL, " -317", "%05.d",
+__LINE__, 0x0000f5e2L, "+62946", "%+0.2ld",
+__LINE__, 0x16ac6358L, "16ac6358", "%x",
+__LINE__, 0xffff8728L, "FFFF8728", "%+X",
+__LINE__, -0x0014a6dL, "-084589", "%0.6ld",
+__LINE__, 0xfc904514L, "FC904514", "%+0X",
+__LINE__, 0x00000004L, "4", "%ld",
+__LINE__, 0xffffffe0L, "ffffffe0", "%+x",
+__LINE__, -0x0a0ffddL, "-10551261", "%+02d",
+__LINE__, -0x0000bbcL, "-3004", "%+d",
+__LINE__, 0x00000006L, " +6", "%+7ld",
+__LINE__, 0x17afa6e5L, "397387493", "%ld",
+__LINE__, 0xfffff6bfL, "fffff6bf", "%+04.4x",
+__LINE__, 0x000001dcL, "01dc", "% 02.4x",
+__LINE__, 0x0000000eL, " 14", "% d",
+__LINE__, 0xfffffff9L, "0XFFFFFFF9", "%#4.X",
+__LINE__, 0x0000005dL, "93", "%0d",
+__LINE__, -0x004fa05L, "-0326149", "%.7d",
+__LINE__, -0x0000018L, "-24", "%ld",
+__LINE__, 0xfffff7ebL, "FFFFF7EB", "%X",
+__LINE__, 0x0072b044L, " 7516228", "% .7ld",
+__LINE__, 0xffffffedL, "0xffffffed", "%#x",
+__LINE__, 0x0010364dL, "10364D", "%X",
+__LINE__, 0xfff90469L, "0XFFF90469", "%#X",
+__LINE__, 0x000001b4L, " 436", "% 0d",
+__LINE__, 0x00000000L, "0", "% X",
+__LINE__, 0xfffffff3L, "fffffff3", "%x",
+__LINE__, 0x19335d40L, "19335d40", "%6x",
+__LINE__, 0x00039c24L, "236580", "%ld",
+__LINE__, 0x000021f7L, "8695", "%0.4ld",
+__LINE__, -0x057b406L, "-5747718", "%d",
+__LINE__, -0x017b371L, "-1553265", "%#ld",
+__LINE__, 0x0003e405L, "254981", "%2.d",
+__LINE__, 0x00000001L, "1", "%-.1x",
+__LINE__, 0x000000aeL, "AE", "%.1X",
+__LINE__, 0xffd85825L, "ffd85825", "%-7.x",
+__LINE__, 0xfffad763L, "fffad763", "%x",
+__LINE__, 0x002431d4L, "2372052", "%6.ld",
+__LINE__, 0x00000003L, "000003", "%-05.6d",
+__LINE__, 0xffffffebL, "0xffffffeb", "%#x",
+__LINE__, 0xff8cf3b0L, "ff8cf3b0", "%x",
+__LINE__, 0xfe88d2ffL, "0xfe88d2ff", "%+#.2x",
+__LINE__, 0xffffff6bL, "ffffff6b", "%6.3x",
+__LINE__, 0xfffffffeL, "fffffffe", "%-x",
+__LINE__, 0xe998945aL, "e998945a", "%2.x",
+__LINE__, 0x03b9c50fL, "3B9C50F", "%+X",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%3.7X",
+__LINE__, 0x000024efL, "24ef", "%+x",
+__LINE__, 0xfffffc04L, "FFFFFC04", "%X",
+__LINE__, 0x0d4bef7cL, " 223080316", "% .1ld",
+__LINE__, -0xc33f3bcL, "-204731324", "%.5ld",
+__LINE__, 0xffffffffL, "0XFFFFFFFF", "%#2X",
+__LINE__, 0x0000e493L, "e493", "%x",
+__LINE__, 0x000001b4L, "1b4", "%x",
+__LINE__, 0xffffffd6L, "0xffffffd6", "% #1x",
+__LINE__, 0x00000001L, "1", "%d",
+__LINE__, -0x0000f28L, "-3880", "%ld",
+__LINE__, 0x00000277L, "631", "%-1ld",
+__LINE__, 0x00000001L, " 1", "%2x",
+__LINE__, -0x0ff4d2cL, "-16731436", "%#ld",
+__LINE__, 0x0bb80344L, "196608836", "%00ld",
+__LINE__, 0xffffffdcL, "FFFFFFDC", "%X",
+__LINE__, 0x00000484L, "1156", "%ld",
+__LINE__, 0x00000341L, "341", "%-.2x",
+__LINE__, 0x0000ee62L, "ee62", "%x",
+__LINE__, 0xfffffe20L, "fffffe20", "%+x",
+__LINE__, -0x00076ebL, "-30443", "%.2d",
+__LINE__, 0x2c4a7407L, "2c4a7407", "% x",
+__LINE__, 0x00000000L, " ", "%3.X",
+__LINE__, 0xffffff60L, "ffffff60", "% 4.x",
+__LINE__, 0x000e4cf2L, "+937202", "%+.5ld",
+__LINE__, 0x00000008L, " 00008", "%06.5X",
+__LINE__, 0x0002f612L, "194066", "%d",
+__LINE__, 0xfffffc96L, "fffffc96", "%-3.3x",
+__LINE__, -0x0000001L, "-1", "% ld",
+__LINE__, 0x00000000L, " ", "% 6.0X",
+__LINE__, 0xfffffff5L, "fffffff5", "%3.x",
+__LINE__, 0x0bfd63a1L, "201155489", "%d",
+__LINE__, -0x1547c214L, "-357024276", "%ld",
+__LINE__, 0x00000004L, "4", "%#0.d",
+__LINE__, -0x000f2f3L, "-62195", "%.2d",
+__LINE__, 0xfff843ddL, "FFF843DD", "%X",
+__LINE__, 0x00966e36L, "9858614", "%.0ld",
+__LINE__, 0x0000782eL, "0X782E", "% #X",
+__LINE__, 0x00bd36c0L, "12400320", "%ld",
+__LINE__, 0x00000000L, "00", "% .2X",
+__LINE__, 0x00000000L, "0", "%1X",
+__LINE__, 0x0003f416L, "3f416 ", "%-6.x",
+__LINE__, -0x00b74bdL, "-750781", "% ld",
+__LINE__, 0x0000138aL, "138a", "% x",
+__LINE__, 0x024df7f0L, "24DF7F0", "% 0.6X",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%X",
+__LINE__, -0x0003284L, "-12932 ", "%-07.ld",
+__LINE__, 0x000094d3L, "94d3", "%x",
+__LINE__, 0x000000bfL, "bf", "%.2x",
+__LINE__, 0x00000000L, "00000", "%-1.5X",
+__LINE__, -0x04899b8L, "-4757944", "%d",
+__LINE__, 0x2b51bf20L, "+726777632", "%+d",
+__LINE__, -0x000000dL, "-13", "%.2d",
+__LINE__, 0x04f78fbdL, "4F78FBD", "% 7.X",
+__LINE__, 0x00011684L, "71300", "%5.d",
+__LINE__, 0x0000539dL, "21405", "%0d",
+__LINE__, 0x00000008L, "000008", "%-3.6X",
+__LINE__, 0xfc7a2cdcL, "fc7a2cdc", "%2.3x",
+__LINE__, 0xffc21da1L, "ffc21da1", "%x",
+__LINE__, 0x00000273L, "273", "%x",
+__LINE__, 0x00000000L, "0", "%#X",
+__LINE__, -0x31cd6b9L, "-52221625", "% d",
+__LINE__, 0xfffffff8L, "FFFFFFF8", "%.0X",
+__LINE__, 0x00000002L, "2", "%#ld",
+__LINE__, 0x00e8922cL, "15241772", "%d",
+__LINE__, 0xfeb19ea7L, "FEB19EA7", "%0.1X",
+__LINE__, 0x00003931L, "014641", "%06ld",
+__LINE__, 0x00000015L, "0X00015", "%#.5X",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%1.X",
+__LINE__, 0xfff17103L, "0XFFF17103", "% #X",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%+X",
+__LINE__, 0x00000002L, "00002", "%.5x",
+__LINE__, 0x00001617L, " 5655", "% 7.d",
+__LINE__, -0x0000010L, "-000016", "%00.6d",
+__LINE__, 0x000000b0L, "B0", "% X",
+__LINE__, 0xfc9362b2L, "FC9362B2", "%-X",
+__LINE__, 0xfc3d8276L, "fc3d8276", "% 1x",
+__LINE__, 0x00001405L, "5125", "%#d",
+__LINE__, 0x02250183L, " 35979651", "% ld",
+__LINE__, 0xffc9b007L, "ffc9b007", "% 4.x",
+__LINE__, 0x00000311L, "785", "%0d",
+__LINE__, 0x0004d273L, " 316019", "% d",
+__LINE__, 0x00000001L, "1", "%1.x",
+__LINE__, 0xffff240fL, "FFFF240F", "%4.X",
+__LINE__, 0x0049cfdaL, "+4837338", "%+ld",
+__LINE__, 0x012f6dd5L, "12F6DD5", "% 6.2X",
+__LINE__, 0x00000002L, "0x2", "%#2.0x",
+__LINE__, 0xfffd834aL, "FFFD834A", "%.6X",
+__LINE__, 0xfe2a40f8L, "0XFE2A40F8", "%#X",
+__LINE__, 0xffffffebL, "ffffffeb", "%x",
+__LINE__, -0x00ac5cbL, "-705995", "%d",
+__LINE__, -0x3021108cL, "-807473292", "% .4d",
+__LINE__, -0x0000035L, "-53", "%-ld",
+__LINE__, -0x1a36475L, "-27485301", "% d",
+__LINE__, -0x0000011L, "-17", "%d",
+__LINE__, 0x000001a3L, "000419", "%.6ld",
+__LINE__, 0x0030a0a8L, "3186856", "%.5ld",
+__LINE__, 0x00000019L, "25", "%d",
+__LINE__, 0xf32deac1L, "F32DEAC1", "%06.2X",
+__LINE__, -0x0000004L, " -00004", "%7.5ld",
+__LINE__, 0x00000000L, "0", "%ld",
+__LINE__, 0x0006bf19L, "442137", "%#0.d",
+__LINE__, 0x566f6c44L, "1450142788", "%1.6d",
+__LINE__, 0xfffffc10L, "fffffc10", "%.2x",
+__LINE__, -0x000e04dL, "-57421", "%+0d",
+__LINE__, 0x00000000L, "0000000", "%+.7X",
+__LINE__, 0x00b5c74dL, " 11913037", "% ld",
+__LINE__, -0x028dfe2L, "-2678754", "%05.1d",
+__LINE__, 0xfffffee0L, "fffffee0", "%0x",
+__LINE__, -0x030c077L, "-3194999", "%-.6d",
+__LINE__, 0x00055ca1L, "055ca1", "%-.6x",
+__LINE__, 0x00000000L, " ", "%7.X",
+__LINE__, 0xfffffe3bL, "FFFFFE3B", "%X",
+__LINE__, 0xffffffffL, "FFFFFFFF", "% 3X",
+__LINE__, 0x00000857L, "2135", "%-#1.d",
+__LINE__, -0x00546a2L, "-345762", "%0.5d",
+__LINE__, 0x0000000bL, "0xb ", "%-#6x",
+__LINE__, 0x00000d2bL, "d2b ", "%-4.0x",
+__LINE__, 0x0ae02b9eL, "AE02B9E", "%X",
+__LINE__, 0xfffffa7bL, "fffffa7b", "%-2.x",
+__LINE__, 0x00000001L, "1", "%X",
+__LINE__, 0x000006adL, "01709", "%05.5ld",
+__LINE__, -0x0000102L, "-258", "%-0.ld",
+__LINE__, 0x00000000L, "0", "%.1X",
+__LINE__, -0x01daa95L, "-1944213", "%-1ld",
+__LINE__, 0x02b99040L, "2B99040", "%2.X",
+__LINE__, 0x1b3d5621L, "1B3D5621", "%X",
+__LINE__, 0x0312d16bL, "51564907", "%-1.7ld",
+__LINE__, 0x000aa76cL, " 698220", "% 2d",
+__LINE__, 0x00000000L, "0", "%ld",
+__LINE__, 0xfff8a4ecL, "FFF8A4EC", "%-X",
+__LINE__, 0xffffe06dL, "ffffe06d", "%x",
+__LINE__, 0x00000003L, "3", "% x",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0xd3e244ddL, "D3E244DD", "%+5X",
+__LINE__, 0x000028b3L, " 28b3", "% 5.x",
+__LINE__, 0x0001acebL, "109803", "%6d",
+__LINE__, 0xfffbc5caL, "0xfffbc5ca", "%-#5x",
+__LINE__, 0x00000097L, " 151", "% 7ld",
+__LINE__, 0x00001fccL, "+8140", "%+d",
+__LINE__, 0xffffffffL, "ffffffff", "%0x",
+__LINE__, -0x00052a9L, "-21161", "%ld",
+__LINE__, 0xfffffc76L, "FFFFFC76", "%.1X",
+__LINE__, -0x2acb012L, "-44871698", "%0.1ld",
+__LINE__, 0xffffff81L, "ffffff81", "%x",
+__LINE__, -0x0018394L, "-99220", "%-ld",
+__LINE__, 0x0000001bL, "1B", "%X",
+__LINE__, 0x00000033L, "51", "%1d",
+__LINE__, 0xffec37e5L, "FFEC37E5", "%-1X",
+__LINE__, -0x000000aL, " -10", "%#5.d",
+__LINE__, -0x0000412L, "-1042", "%ld",
+__LINE__, 0x000cd0b1L, "cd0b1 ", "%-7.5x",
+__LINE__, 0x0b445370L, "B445370", "%+2.0X",
+__LINE__, 0xfffffff3L, "0XFFFFFFF3", "%-#X",
+__LINE__, 0xffff9f33L, "FFFF9F33", "%5.X",
+__LINE__, 0x00010a1eL, "10A1E", "%-2X",
+__LINE__, -0xede156fL, "-249435503", "% 7.1ld",
+__LINE__, 0xfc6d63aaL, "fc6d63aa", "% .6x",
+__LINE__, 0x0000311cL, " 12572", "% ld",
+__LINE__, 0x00001f8aL, "8074", "%00.d",
+__LINE__, 0x00000199L, "199", "%-X",
+__LINE__, 0xfffffc60L, "FFFFFC60", "%+3X",
+__LINE__, -0x000022cL, "-556", "%+0ld",
+__LINE__, 0x021d8407L, "35488775", "%-#.7ld",
+__LINE__, 0x0000020fL, "527", "%d",
+__LINE__, -0x000064bL, "-1611", "%#ld",
+__LINE__, -0x0c15aefL, "-12671727", "%d",
+__LINE__, -0x1f1a6881L, "-521824385", "%ld",
+__LINE__, 0xffffc115L, "ffffc115", "% x",
+__LINE__, 0x00000017L, " 23", "% #ld",
+__LINE__, 0x00000dc1L, "DC1 ", "%-4X",
+__LINE__, 0x000002caL, "2CA", "%X",
+__LINE__, 0x000f052cL, " 984364", "%7.d",
+__LINE__, 0x0000005aL, "0090", "%0.4d",
+__LINE__, -0x001e463L, "-124003", "% 4.ld",
+__LINE__, 0x00000001L, "0000001", "%+.7X",
+__LINE__, 0x00000bfbL, "0000bfb", "%5.7x",
+__LINE__, 0x0002484bL, "149579", "%#1d",
+__LINE__, 0x0043ba18L, "4438552", "%-ld",
+__LINE__, 0x000078f8L, "0X78F8", "%#X",
+__LINE__, 0x00000001L, " 1", "%4d",
+__LINE__, 0x0cedaeedL, "CEDAEED", "%X",
+__LINE__, 0x00000003L, "+3", "%+ld",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "%7.4X",
+__LINE__, 0x00000169L, "361", "%ld",
+__LINE__, 0x00003c7aL, "+15482", "%+ld",
+__LINE__, -0x0159d93L, "-1416595", "% 0.0d",
+__LINE__, 0x0000775cL, "+30556", "%+3.d",
+__LINE__, 0x10284768L, "+271075176", "%+0.0ld",
+__LINE__, -0xf8b610eL, "-260792590", "%0d",
+__LINE__, 0xfdd8d369L, "fdd8d369", "%-.3x",
+__LINE__, 0x000c9495L, "+824469", "%+ld",
+__LINE__, -0x000003fL, " -063", "%7.3d",
+__LINE__, -0x000073bL, "-1851", "%+03.ld",
+__LINE__, 0xfffe4e23L, "0xfffe4e23", "%#.5x",
+__LINE__, 0x0081788cL, "81788c", "%5x",
+__LINE__, -0x015f888L, "-1439880", "%+1d",
+__LINE__, -0x31d64b4L, "-52257972", "%0.2d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%6.5X",
+__LINE__, -0x0000072L, "-114", "%+.1d",
+__LINE__, -0x00000e1L, "-225", "%ld",
+__LINE__, 0x000006a8L, "0x6a8", "%+#x",
+__LINE__, 0xfffe673aL, "fffe673a", "%01.x",
+__LINE__, 0xfff2ee0dL, "FFF2EE0D", "%-X",
+__LINE__, 0x0290320aL, "43004426", "%0ld",
+__LINE__, -0xeb7a832L, "-246917170", "% ld",
+__LINE__, 0x02ae9265L, "2ae9265", "%1.x",
+__LINE__, 0xffffffd2L, "ffffffd2", "%+2.x",
+__LINE__, 0x00e6e858L, "0xe6e858", "%#0.x",
+__LINE__, 0x00000c4aL, "+3146", "%+3.1d",
+__LINE__, -0x6943c1aL, "-110378010", "% 0ld",
+__LINE__, 0x0167b119L, "167b119", "%0x",
+__LINE__, 0xfffffffeL, "fffffffe", "%+x",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%X",
+__LINE__, 0x000b861eL, "755230", "%ld",
+__LINE__, 0x0000015bL, "347", "%-#ld",
+__LINE__, 0xfffffffaL, "0XFFFFFFFA", "%#X",
+__LINE__, 0x000de9e5L, "911845", "%d",
+__LINE__, 0x00000001L, "01", "%.2d",
+__LINE__, 0x000007a5L, "1957", "%0d",
+__LINE__, 0x0000000fL, "f", "%x",
+__LINE__, 0x00c38cbfL, " 12815551", "% .2d",
+__LINE__, -0x7bd1b6eL, "-129833838", "% d",
+__LINE__, -0x000013cL, "-316", "%0d",
+__LINE__, 0x00001aadL, "1AAD", "%-0X",
+__LINE__, 0x0034f903L, "3471619", "%00d",
+__LINE__, 0xff925717L, "ff925717", "%4x",
+__LINE__, 0x00000002L, "02", "%.2d",
+__LINE__, 0x00000f34L, "F34", "%+X",
+__LINE__, 0xffffeefeL, "FFFFEEFE", "%X",
+__LINE__, 0xfffeecb4L, "FFFEECB4", "% 2.X",
+__LINE__, 0x00034421L, "214049", "%0ld",
+__LINE__, 0x00000000L, " 0", "%+6X",
+__LINE__, -0x0000062L, "-98", "%-#2d",
+__LINE__, -0x0000557L, "-1367", "%-4.4d",
+__LINE__, 0xffffe17cL, "FFFFE17C", "%X",
+__LINE__, 0x00000097L, "00097", "%.5X",
+__LINE__, 0xfffcb278L, "FFFCB278", "%0.7X",
+__LINE__, -0x0000001L, "-0001 ", "%-7.4d",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, 0x000002c4L, "708", "%d",
+__LINE__, 0x04946f45L, "4946F45", "%-2.X",
+__LINE__, 0x000000ffL, "00ff", "% 2.4x",
+__LINE__, 0x00073307L, "471815", "%3ld",
+__LINE__, 0x0085b7b6L, "+8763318", "%+ld",
+__LINE__, -0x0000002L, "-2", "%1ld",
+__LINE__, -0x0000001L, "-1", "%-2d",
+__LINE__, -0x00000b5L, " -181", "%7ld",
+__LINE__, -0x0412486L, "-4269190", "%+2.1ld",
+__LINE__, 0xffffffffL, "ffffffff", "%0x",
+__LINE__, 0x0000006dL, "6d", "%x",
+__LINE__, 0x000000daL, "218", "%-.3ld",
+__LINE__, 0xfffffcfeL, "fffffcfe", "%x",
+__LINE__, 0x652e60c7L, "652E60C7", "%7.7X",
+__LINE__, 0x00000035L, " 53", "% #2d",
+__LINE__, 0x000000fcL, "FC", "%-X",
+__LINE__, 0x00000019L, " 25", "% ld",
+__LINE__, 0xfffffcf4L, "fffffcf4", "%6x",
+__LINE__, 0xffffff41L, "ffffff41", "%x",
+__LINE__, 0x00000034L, " 52", "%3.ld",
+__LINE__, 0xffffffb2L, "ffffffb2", "%-x",
+__LINE__, -0x6dc43e7cL, "-1841577596", "% .2ld",
+__LINE__, 0x00000004L, "4", "%d",
+__LINE__, -0x000023bL, "-571", "%ld",
+__LINE__, -0x000004dL, "-77", "%ld",
+__LINE__, 0x0000e3baL, "58298", "%.0ld",
+__LINE__, 0xfffffff2L, "fffffff2", "%0.0x",
+__LINE__, -0x0000020L, "-32", "%ld",
+__LINE__, 0xffffb33eL, "0XFFFFB33E", "%-#X",
+__LINE__, 0x00000000L, " ", "% 4.x",
+__LINE__, 0xffd96f92L, "FFD96F92", "%X",
+__LINE__, 0x0000002eL, " 46", "% 0ld",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, -0x5008ba3L, "-83921827", "%+d",
+__LINE__, 0xfdc1df3dL, "FDC1DF3D", "%0X",
+__LINE__, 0xfc7410e5L, "fc7410e5", "%7x",
+__LINE__, 0xfffffffaL, "FFFFFFFA", "% 6.X",
+__LINE__, 0x00000000L, "0", "%X",
+__LINE__, -0x040fd4eL, "-4259150", "% 05.d",
+__LINE__, 0x0000003bL, " 59", "%3.2d",
+__LINE__, 0xff776dd8L, "ff776dd8", "%x",
+__LINE__, 0x0000055bL, "+1371", "%+#2d",
+__LINE__, 0x00004841L, "4841", "%.1x",
+__LINE__, 0x0229d710L, "36296464", "%-.2ld",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0xfffe8376L, "fffe8376", "%0x",
+__LINE__, 0x000a7b83L, "a7b83", "%x",
+__LINE__, 0x0000000dL, " 013", "%#7.3d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%5.0X",
+__LINE__, 0x00000704L, " 0x704", "%#7.0x",
+__LINE__, 0xfff970b9L, "FFF970B9", "%.1X",
+__LINE__, -0x000b60aL, "-46602", "%+d",
+__LINE__, 0x00000000L, " 00000", "%6.5x",
+__LINE__, 0x00000003L, "3", "%X",
+__LINE__, 0x0000c14bL, "c14b", "%0x",
+__LINE__, 0x066d7860L, "107837536", "%-d",
+__LINE__, 0x00000013L, " 13", "%4.x",
+__LINE__, 0xfff96f18L, "FFF96F18", "%4X",
+__LINE__, 0xffffff30L, "FFFFFF30", "%X",
+__LINE__, 0xffffffffL, "FFFFFFFF", "% .7X",
+__LINE__, -0x72a9e985L, "-1923737989", "%2.d",
+__LINE__, 0x00000002L, "0x2", "%#x",
+__LINE__, 0x0000050eL, "50e", "%2.3x",
+__LINE__, 0x0000605cL, "24668", "%4.1d",
+__LINE__, 0xffffff3eL, "ffffff3e", "%x",
+__LINE__, -0x0000010L, "-16", "%-2d",
+__LINE__, 0x000061aaL, "61AA", "%X",
+__LINE__, 0x000c2ec3L, "C2EC3", "%0X",
+__LINE__, -0x0000001L, "-1", "%-0d",
+__LINE__, 0x00130e17L, "+1248791", "%+.6ld",
+__LINE__, 0x000000efL, "EF", "%-X",
+__LINE__, -0x0000001L, " -1", "%+5ld",
+__LINE__, 0x0000989dL, "39069", "%d",
+__LINE__, 0x00000000L, "0", "%-x",
+__LINE__, 0x00000417L, "417", "%X",
+__LINE__, 0x00005e86L, "5E86", "%+X",
+__LINE__, -0x0007c08L, "-31752", "%ld",
+__LINE__, 0x00da8e0fL, "DA8E0F", "%2.2X",
+__LINE__, -0x3ee095ecL, "-1054905836", "% 0d",
+__LINE__, 0xfffdb5a3L, "fffdb5a3", "%x",
+__LINE__, 0xffffff83L, "FFFFFF83", "%X",
+__LINE__, 0xfff8efd7L, "0xfff8efd7", "%#x",
+__LINE__, 0x00000020L, " 32", "% d",
+__LINE__, 0xfff7c002L, "fff7c002", "%.7x",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, 0x00000000L, " 000", "%05.3X",
+__LINE__, 0xfff190eeL, "FFF190EE", "%X",
+__LINE__, 0x00000a6cL, " 2668", "%#6.ld",
+__LINE__, 0x00037024L, "37024", "%x",
+__LINE__, 0xfffec37fL, "FFFEC37F", "%X",
+__LINE__, 0x007ee9bbL, "8317371", "%#0.ld",
+__LINE__, 0x00000122L, "290", "%ld",
+__LINE__, -0x0013b5fL, "-80735", "%ld",
+__LINE__, 0xfffffff6L, "FFFFFFF6", "%X",
+__LINE__, -0x0000c16L, "-0003094", "%-00.7d",
+__LINE__, -0x00010edL, "-4333", "%ld",
+__LINE__, 0x00000007L, " 0X007", "%#6.3X",
+__LINE__, 0x0053781eL, " 5470238", "% 2d",
+__LINE__, 0xffff03e9L, "0XFFFF03E9", "%+#7.3X",
+__LINE__, 0xfffffdc2L, "0xfffffdc2", "% #4.x",
+__LINE__, -0x00018e1L, "-6369", "%d",
+__LINE__, 0xf3a4abc6L, "F3A4ABC6", "%-.2X",
+__LINE__, 0xfff64a27L, "FFF64A27", "%7.7X",
+__LINE__, 0x00195ae5L, "195AE5", "%+03.X",
+__LINE__, 0xfff8849aL, "fff8849a", "%.1x",
+__LINE__, -0x001b045L, "-110661", "%+ld",
+__LINE__, 0x01e8a106L, "32022790", "%7.ld",
+__LINE__, 0x0008ee94L, "8EE94", "%X",
+__LINE__, 0xfffcdabcL, "FFFCDABC", "%X",
+__LINE__, 0xfda75cd2L, "fda75cd2", "%x",
+__LINE__, 0x00fd505aL, "fd505a", "%x",
+__LINE__, 0x00003748L, "3748", "%+x",
+__LINE__, 0xffffffe5L, "ffffffe5", "% 3.6x",
+__LINE__, -0x1d1c4045L, "-488390725", "%d",
+__LINE__, 0xfffffff9L, "0xfffffff9", "%#x",
+__LINE__, -0x0000001L, "-1", "%-#ld",
+__LINE__, 0x00000191L, "191", "%X",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%-X",
+__LINE__, -0x0000006L, "-6", "%ld",
+__LINE__, 0x00000033L, " 33", "% 4x",
+__LINE__, -0x0159a14L, "-1415700", "% ld",
+__LINE__, 0x000001c3L, "00001c3", "%07x",
+__LINE__, 0xffffe9e2L, "ffffe9e2", "%-x",
+__LINE__, 0x5b19abd9L, "0x5b19abd9", "%-#x",
+__LINE__, 0xffff1baeL, "0xffff1bae", "%#x",
+__LINE__, 0x00000001L, "+1", "%+d",
+__LINE__, 0x006a23c7L, "6A23C7", "%2.X",
+__LINE__, 0x000008a4L, " 8a4", "% 4.1x",
+__LINE__, 0xfffffcd9L, "fffffcd9", "%.1x",
+__LINE__, 0x0000121bL, "121B", "%X",
+__LINE__, 0x001231aaL, "1192362", "%7.d",
+__LINE__, -0x008026dL, "-524909", "%4.2d",
+__LINE__, 0x192ea594L, "422487444", "%ld",
+__LINE__, 0x0001a800L, "108544", "%0d",
+__LINE__, 0x000062f1L, "62f1", "%.4x",
+__LINE__, 0xff8b39b0L, "ff8b39b0", "% x",
+__LINE__, 0x00000001L, "0x1", "%+#x",
+__LINE__, 0x0000144aL, "5194", "%ld",
+__LINE__, 0x00002599L, "9625", "%d",
+__LINE__, 0xffa0a2efL, "ffa0a2ef", "%0x",
+__LINE__, 0xff6712e1L, "FF6712E1", "%0X",
+__LINE__, 0x0007ebb3L, "519091", "%1ld",
+__LINE__, 0x0000000fL, "15 ", "%-4.ld",
+__LINE__, -0x0000096L, "-150", "%2.ld",
+__LINE__, 0x0000004fL, "4F", "%.2X",
+__LINE__, 0xfffffc29L, "fffffc29", "%-4.x",
+__LINE__, 0x00000019L, "19", "%x",
+__LINE__, 0x00000c4eL, "c4e", "%x",
+__LINE__, 0x0000006bL, " 0006B", "%6.5X",
+__LINE__, 0x00c8d2c6L, "c8d2c6", "%.0x",
+__LINE__, -0x256fb8deL, "-628078814", "%ld",
+__LINE__, 0x4f51fcf4L, "4F51FCF4", "%+X",
+__LINE__, 0x000f000eL, "983054", "%1.ld",
+__LINE__, 0xfffff03fL, "fffff03f", "%x",
+__LINE__, 0x0000001dL, " 1D", "%05.X",
+__LINE__, 0x0072ea14L, "72ea14", "%x",
+__LINE__, -0xc6098b9L, "-207657145", "%-7d",
+__LINE__, 0x00000a76L, "2678", "%3ld",
+__LINE__, 0xfff84db3L, "FFF84DB3", "%X",
+__LINE__, 0x0fb52870L, "fb52870", "%+x",
+__LINE__, 0x08bc170aL, "0x8bc170a", "%#x",
+__LINE__, 0xfffeeb00L, "fffeeb00", "%0.5x",
+__LINE__, 0x000ece95L, "970389", "%d",
+__LINE__, 0x00000000L, "0", "%0X",
+__LINE__, 0x07f98e8aL, "7f98e8a", "% x",
+__LINE__, 0x000499ebL, " 499eb", "% 6.x",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%-X",
+__LINE__, 0x0aa45e86L, "178544262", "%#.2d",
+__LINE__, 0xff73387dL, "FF73387D", "%03.X",
+__LINE__, 0xfffffb51L, "FFFFFB51", "%.3X",
+__LINE__, 0xffffffdcL, "ffffffdc", "%6.x",
+__LINE__, 0xffffffedL, "FFFFFFED", "%-X",
+__LINE__, 0x0001c4c2L, "1c4c2", "%0.3x",
+__LINE__, -0x0000001L, "-0000001", "%-#.7d",
+__LINE__, 0x00000007L, "7", "%0.x",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, 0xffffd000L, "ffffd000", "%4.3x",
+__LINE__, 0x00000030L, "48", "%2.d",
+__LINE__, -0x6c121ceL, "-113320398", "%.5ld",
+__LINE__, 0x000001edL, "1ED", "% 3.X",
+__LINE__, 0xfffff0f3L, "FFFFF0F3", "%+.6X",
+__LINE__, 0xffffffecL, "ffffffec", "%x",
+__LINE__, 0x002d5ab8L, "0x2d5ab8", "%-#x",
+__LINE__, 0x0026acffL, "2534655", "%0ld",
+__LINE__, 0x01d90cd7L, "+31001815", "%+.2ld",
+__LINE__, -0x1f7abc0L, "-33008576", "%7.6d",
+__LINE__, 0xfc5babccL, "fc5babcc", "%x",
+__LINE__, -0x9b74892L, "-163006610", "% .6d",
+__LINE__, 0x03931d84L, "59972996", "%0.d",
+__LINE__, 0x07d261ceL, "131228110", "%#ld",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0x00000002L, "2", "%+X",
+__LINE__, -0x0000604L, "-1540", "%+d",
+__LINE__, 0x00000000L, " ", "%7.x",
+__LINE__, 0x00000001L, "1", "%.0X",
+__LINE__, -0x0005a8eL, "-23182", "% d",
+__LINE__, 0x03fb2730L, "3fb2730", "%7.x",
+__LINE__, 0xffffff03L, "ffffff03", "%x",
+__LINE__, 0x00000000L, " ", "%-#3.d",
+__LINE__, 0x04025a4bL, "0X4025A4B", "%+#X",
+__LINE__, -0x0000001L, " -1", "%4.d",
+__LINE__, 0xfffe00a3L, "FFFE00A3", "%+X",
+__LINE__, -0x1b26e3c8L, "-455533512", "% ld",
+__LINE__, 0x000017e5L, "6117", "%d",
+__LINE__, -0x0e4f3b6L, "-15004598", "%0ld",
+__LINE__, 0x00000034L, "52", "%ld",
+__LINE__, 0x0000024cL, " 24C", "%4X",
+__LINE__, 0xfffedf65L, "FFFEDF65", "%-0X",
+__LINE__, -0x000ff1fL, "-65311", "%+#d",
+__LINE__, 0x00000007L, " 7", "%7.x",
+__LINE__, 0x018656aeL, "18656ae", "%3.7x",
+__LINE__, -0x0000004L, "-4", "%d",
+__LINE__, 0x7081292dL, "1887512877", "%d",
+__LINE__, 0x87d3e48cL, "87d3e48c", "%-x",
+__LINE__, 0xf99c516eL, "0xf99c516e", "% #7.4x",
+__LINE__, 0xfffffffaL, "FFFFFFFA", "%-1X",
+__LINE__, -0x000001dL, "-29", "%#ld",
+__LINE__, -0x0000001L, "-1", "%+ld",
+__LINE__, 0x28ab3350L, " 682308432", "% 1d",
+__LINE__, -0x0000006L, "-6", "%ld",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "%.5X",
+__LINE__, -0x0000007L, "-7", "%#d",
+__LINE__, -0x0000328L, " -808", "%6.ld",
+__LINE__, -0x29386f00L, "-691564288", "%.3d",
+__LINE__, -0x059f38aL, "-5895050", "%.4ld",
+__LINE__, 0xfffff888L, "FFFFF888", "%3X",
+__LINE__, 0xffffffdfL, "ffffffdf", "%0.0x",
+__LINE__, -0xb4fc354L, "-189776724", "%2d",
+__LINE__, 0x00058c07L, "363527", "%1.d",
+__LINE__, 0x0a256162L, "a256162", "%x",
+__LINE__, -0x05c87b0L, "-6064048", "%0ld",
+__LINE__, 0xfffffda1L, "fffffda1", "%x",
+__LINE__, 0x000034b7L, "13495", "%d",
+__LINE__, -0x6d1a8918L, "-1830455576", "%.1d",
+__LINE__, 0x00022290L, "139920", "%05ld",
+__LINE__, 0x00000000L, "0", "%-x",
+__LINE__, -0x1f8eafceL, "-529444814", "%4.d",
+__LINE__, -0x7bf32808L, "-2079533064", "% ld",
+__LINE__, 0x0000023cL, "23c", "% x",
+__LINE__, 0x00000039L, "39", "%X",
+__LINE__, -0x000556dL, "-21869", "%ld",
+__LINE__, -0x00000caL, "-202", "%ld",
+__LINE__, 0x00002e28L, "11816", "%-d",
+__LINE__, 0x00000011L, "17", "%-ld",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "%-X",
+__LINE__, 0xfffdd67fL, "0XFFFDD67F", "%#X",
+__LINE__, -0x000003dL, "-61", "%d",
+__LINE__, 0x0000bfceL, "0XBFCE", "%-#5.2X",
+__LINE__, 0xfffffffcL, "fffffffc", "%x",
+__LINE__, -0x00aea17L, "-715287", "%.5d",
+__LINE__, -0x02fce89L, "-3133065", "%0d",
+__LINE__, 0x007f6ed1L, "7F6ED1", "%6X",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%X",
+__LINE__, -0x0002761L, "-10081", "%#6.2d",
+__LINE__, 0x003be8d8L, "3BE8D8", "%-X",
+__LINE__, 0x00000901L, " 2305", "%6.d",
+__LINE__, 0x00049916L, "0301334", "%3.7ld",
+__LINE__, 0x0678ffeaL, "0X678FFEA", "%#4X",
+__LINE__, 0xffffffffL, "ffffffff", "%+.0x",
+__LINE__, -0x31d2ec61L, "-835906657", "%.0d",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%0X",
+__LINE__, -0x0015588L, "-87432", "%d",
+__LINE__, 0xffffff3eL, "ffffff3e", "%.4x",
+__LINE__, 0x0000000aL, "10", "%d",
+__LINE__, -0x0000003L, "-3", "%2.1ld",
+__LINE__, -0x000d29aL, "-53914", "%ld",
+__LINE__, -0x04ccbe0L, "-5032928", "%2.2ld",
+__LINE__, 0x0357c2a5L, "357c2a5", "% 7.x",
+__LINE__, 0x00000009L, " 9", "% 1.ld",
+__LINE__, -0x005908dL, "-364685", "%0d",
+__LINE__, -0x0000de6L, "-3558", "%0ld",
+__LINE__, 0x2d395e6bL, "+758734443", "%+6d",
+__LINE__, 0x001aba58L, "1ABA58", "% X",
+__LINE__, 0x0ceba5abL, "0XCEBA5AB", "%#.1X",
+__LINE__, -0x01a8575L, "-1738101", "% 2ld",
+__LINE__, 0x0000000dL, "13", "%#ld",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, 0x4b856407L, "4b856407", "%5x",
+__LINE__, 0x006f333cL, "6F333C", "%-X",
+__LINE__, 0x000000d0L, "d0", "%x",
+__LINE__, 0x2ecf0d4eL, "2ecf0d4e", "%0x",
+__LINE__, -0x0000188L, "-0000392", "%#1.7ld",
+__LINE__, -0x0000037L, "-55", "%d",
+__LINE__, 0xfffffff1L, "FFFFFFF1", "% .1X",
+__LINE__, 0x00000001L, "0x1", "%#3x",
+__LINE__, 0x000005edL, "5ED", "%3X",
+__LINE__, 0x031183a3L, "31183A3", "%X",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, -0x0018695L, "-99989", "%-0.5ld",
+__LINE__, -0x0000001L, "-01", "%0.2ld",
+__LINE__, 0x00007822L, "7822", "%+x",
+__LINE__, 0x00000000L, "0", "% x",
+__LINE__, 0xfda2461aL, "FDA2461A", "%X",
+__LINE__, 0x065c50efL, "106713327", "%2.ld",
+__LINE__, 0x00000a81L, "a81", "% 0x",
+__LINE__, -0x000022eL, "-558", "%.0ld",
+__LINE__, 0x00013d2fL, "81199", "%.2ld",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%+X",
+__LINE__, 0x000015f9L, "5625", "%04.ld",
+__LINE__, 0x0ab575a2L, "179664290", "%0d",
+__LINE__, 0x0024d07fL, "0X24D07F", "%#X",
+__LINE__, 0x07ee35e1L, "7EE35E1", "%+X",
+__LINE__, -0x00c114cL, "-790860", "%#ld",
+__LINE__, 0x00003be3L, " 15331", "%07.d",
+__LINE__, 0xfff87570L, "FFF87570", "%4.0X",
+__LINE__, -0x14eab419L, "-350925849", "%-ld",
+__LINE__, -0x000001bL, "-27", "%ld",
+__LINE__, 0x167ce2eaL, "0x167ce2ea", "%#0.x",
+__LINE__, -0x00009bcL, "-002492", "% 3.6d",
+__LINE__, 0xfffffdb9L, "0XFFFFFDB9", "%#7.X",
+__LINE__, 0x008b2b9dL, "8B2B9D", "% X",
+__LINE__, 0x000cfec3L, "CFEC3", "% 05X",
+__LINE__, 0x05970be6L, "5970be6", "%x",
+__LINE__, 0x00002780L, "010112", "%2.6d",
+__LINE__, 0x00000005L, "+5", "%+d",
+__LINE__, 0xfffffffbL, "0xfffffffb", "%#3.x",
+__LINE__, 0x00000001L, "1 ", "%-#5.ld",
+__LINE__, -0x0000017L, "-23", "%ld",
+__LINE__, -0x023b943L, "-2341187", "%d",
+__LINE__, 0x0000000dL, "13", "%ld",
+__LINE__, 0x00025a03L, "25a03", "% .5x",
+__LINE__, 0x3e1ebe24L, "3e1ebe24", "% x",
+__LINE__, 0x0000013aL, "0x13a", "%#5.0x",
+__LINE__, 0xfff6f5b3L, "FFF6F5B3", "%4.X",
+__LINE__, -0x0000a8aL, "-2698", "%.3d",
+__LINE__, 0x0009dd5fL, "9dd5f", "%x",
+__LINE__, 0x000003c7L, " 3C7", "%04.2X",
+__LINE__, 0x1bcfa2f2L, "1bcfa2f2", "%+1.x",
+__LINE__, 0x0001b4f4L, "1b4f4", "%+1.x",
+__LINE__, 0x1bc19a90L, "465672848", "%#d",
+__LINE__, 0xffffffffL, "ffffffff", "%+06x",
+__LINE__, -0x0000a88L, "-2696", "%3.d",
+__LINE__, 0x00084a19L, "84A19", "%-X",
+__LINE__, 0xffe1fc8fL, "FFE1FC8F", "%0.1X",
+__LINE__, -0x0000a3aL, "-2618", "%5d",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, -0x5c6183dL, "-96868413", "%+ld",
+__LINE__, -0x0000001L, "-1", "%-d",
+__LINE__, 0x0000faa8L, "64168", "%05.d",
+__LINE__, 0x003913efL, "3740655", "%ld",
+__LINE__, 0x0dde330aL, "232665866", "%#ld",
+__LINE__, 0xfcfb1a7bL, "FCFB1A7B", "%+X",
+__LINE__, 0x07b1a81fL, " 129083423", "% 0d",
+__LINE__, 0x00000001L, "1", "%d",
+__LINE__, 0x00000070L, " 112", "%5ld",
+__LINE__, 0xffff74d9L, "ffff74d9", "%x",
+__LINE__, -0x001ab93L, "-109459", "%03.d",
+__LINE__, 0x0eb6b497L, "EB6B497", "%+X",
+__LINE__, 0x07adbac2L, "128826050", "%#0.4d",
+__LINE__, 0xff747068L, "FF747068", "%6.X",
+__LINE__, -0x190ce98fL, "-420276623", "%06.6ld",
+__LINE__, -0x0000007L, "-7", "%.0d",
+__LINE__, 0x0001240fL, "1240f", "% 3x",
+__LINE__, 0x267ae4a0L, "645588128", "%-#ld",
+__LINE__, -0x0000001L, "-1", "% ld",
+__LINE__, -0x0000066L, "-00102", "%.5ld",
+__LINE__, 0x868fa035L, "868fa035", "%x",
+__LINE__, 0x00000000L, " ", "%-4.ld",
+__LINE__, 0xfffffe72L, "FFFFFE72", "%4.4X",
+__LINE__, 0x00a6b4f4L, "10925300", "%#ld",
+__LINE__, -0x0000002L, "-2", "%00.1d",
+__LINE__, -0x00000a3L, "-163", "%ld",
+__LINE__, 0xfffffffeL, "fffffffe", "% 3.x",
+__LINE__, 0xffe25941L, "ffe25941", "% x",
+__LINE__, 0x0000a20fL, "41487", "%ld",
+__LINE__, -0x000009bL, "-155", "%#.3ld",
+__LINE__, 0x000c5dc1L, "810433", "%4.ld",
+__LINE__, 0x00003ec4L, "16068", "%ld",
+__LINE__, 0x000002f3L, "0755", "%04ld",
+__LINE__, 0xffffff28L, "FFFFFF28", "%.5X",
+__LINE__, -0x08450ffL, "-8671487", "%-3.0ld",
+__LINE__, 0x00000092L, "92", "%x",
+__LINE__, -0x0000317L, "-791", "%d",
+__LINE__, 0x0000000dL, "d", "%x",
+__LINE__, 0x00000036L, "36", "%x",
+__LINE__, -0x112693fL, "-17983807", "%ld",
+__LINE__, 0x00004226L, "16934", "%0.d",
+__LINE__, 0x000001baL, " 442", "% ld",
+__LINE__, 0xfffffffcL, "0XFFFFFFFC", "%#4X",
+__LINE__, 0xffdb3d23L, "0xffdb3d23", "% #x",
+__LINE__, 0x039eb84dL, "39EB84D", "%+.6X",
+__LINE__, 0xffffc7daL, "ffffc7da", "%0x",
+__LINE__, 0xfffffdb6L, "FFFFFDB6", "%6X",
+__LINE__, 0x001b75b0L, "1799600", "%ld",
+__LINE__, 0xfffffca2L, "FFFFFCA2", "%-X",
+__LINE__, 0xffffffbaL, "ffffffba", "%7.4x",
+__LINE__, -0x000124eL, "-4686", "%3.ld",
+__LINE__, -0x000bec0L, "-48832", "% 0d",
+__LINE__, 0xfffffca0L, "fffffca0", "%2.x",
+__LINE__, 0x00b2a462L, "11707490", "%ld",
+__LINE__, 0x0745a647L, "745a647", "%+4.x",
+__LINE__, 0xfffffbacL, "0XFFFFFBAC", "%#3.X",
+__LINE__, -0x0000002L, "-2", "%-0.1d",
+__LINE__, 0x0006cfdbL, "446427", "%#5.d",
+__LINE__, -0x0000001L, "-1", "%d",
+__LINE__, 0x043b134eL, "43B134E", "%X",
+__LINE__, -0x0000015L, "-21", "%ld",
+__LINE__, -0x0000114L, "-276", "%0d",
+__LINE__, -0x0004d4aL, "-19786", "%-d",
+__LINE__, -0x000001cL, "-28", "%ld",
+__LINE__, -0x0cb89fcL, "-13339132", "%ld",
+__LINE__, 0xffffffcfL, "ffffffcf", "%x",
+__LINE__, 0xf6d2387aL, "f6d2387a", "%-x",
+__LINE__, -0x00000cdL, "-205", "%#ld",
+__LINE__, 0x00000000L, "0", "%#x",
+__LINE__, 0xfffffc81L, "fffffc81", "%x",
+__LINE__, 0x00000000L, " 0", "% ld",
+__LINE__, 0x00024fb5L, "24fb5", "%x",
+__LINE__, 0x000012faL, "12FA", "%X",
+__LINE__, 0x0318ce7cL, "51957372", "%0d",
+__LINE__, 0x02280a99L, "2280a99", "%-x",
+__LINE__, 0xffffff5cL, "FFFFFF5C", "%2.X",
+__LINE__, -0x000002eL, " -46", "%7ld",
+__LINE__, -0x04a73e8L, "-4879336", "%4ld",
+__LINE__, 0x000007f3L, "7f3", "% 1.3x",
+__LINE__, 0x00000114L, "0x114", "%#x",
+__LINE__, 0x0000030cL, "30c", "%-x",
+__LINE__, 0x001dd0ddL, "0x1dd0dd", "%+#5.5x",
+__LINE__, 0xfff23de3L, "fff23de3", "%-x",
+__LINE__, -0x0178f9cL, "-1544092", "%d",
+__LINE__, 0x02ded8daL, "2DED8DA", "%X",
+__LINE__, -0x0991672L, "-10032754", "%3.d",
+__LINE__, 0x6943c150L, "6943c150", "%x",
+__LINE__, 0xffffc25dL, "FFFFC25D", "%4X",
+__LINE__, 0x00000c9cL, " 0003228", "% .7d",
+__LINE__, 0xffffffdfL, "FFFFFFDF", "% 6.X",
+__LINE__, 0x0001a145L, " 1a145", "%6.0x",
+__LINE__, 0xffdc832fL, "0xffdc832f", "%#.1x",
+__LINE__, 0x00699f7bL, "699f7b", "%x",
+__LINE__, 0xf9575268L, "F9575268", "%+0X",
+__LINE__, 0x04eb4783L, "82528131", "%-ld",
+__LINE__, -0x0000023L, "-35", "%0ld",
+__LINE__, -0x012b08aL, "-1224842", "%0d",
+__LINE__, 0xffffb587L, "FFFFB587", "%X",
+__LINE__, 0xffffffe9L, "ffffffe9", "%x",
+__LINE__, 0x006b5596L, " 7034262", "% 0d",
+__LINE__, 0x004d0d2aL, "+5049642", "%+ld",
+__LINE__, -0x002a099L, "-172185", "%d",
+__LINE__, 0x00000224L, "548", "%ld",
+__LINE__, 0x03e0cca8L, "65064104", "%d",
+__LINE__, -0x7bb389dL, "-129710237", "%.3ld",
+__LINE__, 0xffc630f5L, "ffc630f5", "%-07.0x",
+__LINE__, 0xfffffff8L, "FFFFFFF8", "%X",
+__LINE__, 0x0030225bL, "3154523", "%#d",
+__LINE__, 0xff7f4e28L, "ff7f4e28", "%+4.x",
+__LINE__, 0x14ee154dL, "+351147341", "%+ld",
+__LINE__, 0x00000003L, "03", "%.2d",
+__LINE__, 0xfe0359d6L, "fe0359d6", "%x",
+__LINE__, 0x002b71c3L, "2847171", "%d",
+__LINE__, 0x055c4d4aL, "55C4D4A", "%-X",
+__LINE__, 0xfffb17d2L, "fffb17d2", "% .0x",
+__LINE__, 0x00000002L, "2", "%x",
+__LINE__, 0x000018e1L, "18E1", "%1.1X",
+__LINE__, 0x00000331L, "817", "%0d",
+__LINE__, -0x0000982L, "-2434 ", "%-06.ld",
+__LINE__, -0x0000168L, "-0000360", "%.7ld",
+__LINE__, 0xffffffe9L, "FFFFFFE9", "%-0.4X",
+__LINE__, 0xe42084efL, "E42084EF", "%X",
+__LINE__, 0x000000aaL, "aa", "%x",
+__LINE__, -0xe8b98b5L, "-244029621", "%+d",
+__LINE__, -0x00000d9L, "-217", "%+2.d",
+__LINE__, 0x0000027bL, "27B", "%+.0X",
+__LINE__, 0x002e52dbL, "3035867", "%-ld",
+__LINE__, -0x00e2ba8L, "-928680", "%0.2ld",
+__LINE__, 0x003b74d8L, "3B74D8", "%X",
+__LINE__, -0x000006fL, "-111", "%+ld",
+__LINE__, 0xf8507e22L, "0XF8507E22", "%-#X",
+__LINE__, 0x0629f4c0L, "103412928", "%-ld",
+__LINE__, -0x000002dL, "-45", "%0d",
+__LINE__, -0x0001db0L, "-7600", "%d",
+__LINE__, -0x00001bbL, " -443", "%5.ld",
+__LINE__, 0xffffd2b9L, "ffffd2b9", "%+x",
+__LINE__, 0xffffe685L, "0XFFFFE685", "%#0.7X",
+__LINE__, 0x0000a4ceL, "A4CE", "% X",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%X",
+__LINE__, 0x0000000cL, "C", "% X",
+__LINE__, 0xfff59369L, "FFF59369", "%7X",
+__LINE__, 0x00000156L, " 156", "%5.X",
+__LINE__, 0x02833aa9L, "+42154665", "%+2d",
+__LINE__, 0x0004a8f3L, "+305395", "%+d",
+__LINE__, 0x01a09267L, "1A09267", "%0.3X",
+__LINE__, 0x000004f1L, "4f1", "%x",
+__LINE__, 0x00000005L, "5", "%x",
+__LINE__, 0x00000119L, " 0281", "% #2.4ld",
+__LINE__, -0x0001a2aL, "-6698", "%ld",
+__LINE__, 0xa3633a57L, "A3633A57", "%7X",
+__LINE__, -0x10bd2970L, "-280832368", "%-d",
+__LINE__, 0xffff9c38L, "ffff9c38", "%x",
+__LINE__, 0xffdbe81eL, "ffdbe81e", "%+6.7x",
+__LINE__, 0xffffffe7L, "FFFFFFE7", "%-3.0X",
+__LINE__, 0x0002f6d6L, "2f6d6", "%5.x",
+__LINE__, 0xffffffffL, "ffffffff", "% x",
+__LINE__, 0xffc2c07aL, "ffc2c07a", "%0.x",
+__LINE__, 0xfcc0e13aL, "FCC0E13A", "%X",
+__LINE__, 0x0000000dL, "d", "% x",
+__LINE__, 0x0016cac8L, "16CAC8", "%-0.3X",
+__LINE__, 0x00945dc1L, "9723329", "%2d",
+__LINE__, 0xf19a1cd1L, "F19A1CD1", "%-X",
+__LINE__, 0x00000003L, "+3", "%+ld",
+__LINE__, 0x00000773L, "1907", "%ld",
+__LINE__, 0x000263e6L, "263e6", "%-x",
+__LINE__, -0x0238b55L, "-2329429", "%d",
+__LINE__, 0x00006c56L, "6C56", "%X",
+__LINE__, 0x0000f34bL, "62283", "%#.0ld",
+__LINE__, -0x1620e21L, "-23203361", "%0ld",
+__LINE__, 0xf9257d6aL, "f9257d6a", "%2x",
+__LINE__, -0x00ed463L, "-971875", "%03.d",
+__LINE__, 0x02bb94c6L, "45847750", "%d",
+__LINE__, 0xffffd20cL, "0XFFFFD20C", "%#X",
+__LINE__, 0x000087d8L, "34776", "%.0d",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%+7.X",
+__LINE__, -0x0009cd5L, "-40149", "%-ld",
+__LINE__, 0xfffff85eL, "FFFFF85E", "% 0.7X",
+__LINE__, -0x0000006L, " -6", "%+#6.ld",
+__LINE__, 0x007ff453L, "0x7ff453", "%-#1.x",
+__LINE__, 0xffffffe6L, "FFFFFFE6", "%2X",
+__LINE__, 0x0000001fL, "0X1F", "%#4X",
+__LINE__, -0x001c157L, "-115031", "%.3ld",
+__LINE__, 0x00096e06L, "617990", "%3.1ld",
+__LINE__, 0x0f77271dL, "259467037", "%d",
+__LINE__, -0x0001403L, "-5123", "%d",
+__LINE__, 0xffffff8aL, "ffffff8a", "%x",
+__LINE__, -0x000010fL, "-271", "%1.ld",
+__LINE__, 0xe573cc4aL, "E573CC4A", "%0X",
+__LINE__, -0x0000d88L, "-3464", "%-d",
+__LINE__, 0x0000000eL, "14", "%#ld",
+__LINE__, -0x000345bL, "-13403", "%#d",
+__LINE__, 0x00000602L, "602", "%+x",
+__LINE__, 0x00000011L, "17", "%#d",
+__LINE__, -0x0000002L, "-2", "%+d",
+__LINE__, 0x030fe6e6L, "51373798", "%d",
+__LINE__, 0x00000007L, "007", "%.3X",
+__LINE__, 0x0001abe0L, "0X1ABE0", "%+#.4X",
+__LINE__, 0xfffffdb7L, "fffffdb7", "%-6x",
+__LINE__, 0xffffff8dL, "FFFFFF8D", "% 02.2X",
+__LINE__, 0xfff12126L, "FFF12126", "%X",
+__LINE__, 0x0208e32dL, "34136877", "%.2d",
+__LINE__, 0x11c04b55L, "297814869", "%ld",
+__LINE__, 0xff1e5ca3L, "0xff1e5ca3", "%#x",
+__LINE__, 0xf9643f09L, "f9643f09", "%x",
+__LINE__, -0x003c6daL, "-247514", "%4d",
+__LINE__, 0xff69d0e7L, "FF69D0E7", "%-X",
+__LINE__, 0x00006ae9L, "0x6ae9", "%#x",
+__LINE__, -0x005aefeL, "-372478", "%d",
+__LINE__, 0x0000000dL, "00013", "%3.5ld",
+__LINE__, 0x00cc185cL, "CC185C", "%X",
+__LINE__, 0x3dd14d9fL, "3DD14D9F", "%1.4X",
+__LINE__, -0x4cc2ad3L, "-80489171", "%1.d",
+__LINE__, 0xfffff79eL, "fffff79e", "%x",
+__LINE__, 0xfffeeb03L, "fffeeb03", "%-1x",
+__LINE__, -0x0b1b15cL, "-11645276", "%0ld",
+__LINE__, -0x06b558dL, "-7034253", "%ld",
+__LINE__, 0xfffffe61L, "fffffe61", "%x",
+__LINE__, -0x0000002L, "-2", "%d",
+__LINE__, -0x0000162L, "-000354", "%-5.6d",
+__LINE__, 0x01a23780L, "27408256", "%d",
+__LINE__, 0xffff3a9bL, "ffff3a9b", "% x",
+__LINE__, 0xfffffdc7L, "0xfffffdc7", "%#4.5x",
+__LINE__, 0x00000000L, "00", "%.2X",
+__LINE__, -0x0000006L, "-6", "%0ld",
+__LINE__, -0x16072c6L, "-23098054", "%#5ld",
+__LINE__, -0x07152b8L, "-7426744", "%01ld",
+__LINE__, 0x0000d6c6L, "0x0d6c6", "%#1.5x",
+__LINE__, 0x00000f7cL, "000f7c", "%+04.6x",
+__LINE__, 0x00000bd0L, "3024", "%4ld",
+__LINE__, 0x0000295eL, "0x295e", "%#x",
+__LINE__, 0x00002e38L, "11832", "%.5d",
+__LINE__, -0xa2f5de4L, "-170876388", "%#d",
+__LINE__, -0x001aa36L, "-109110", "%-#d",
+__LINE__, 0x03012091L, "3012091", "%+2.5X",
+__LINE__, -0x00009edL, "-002541", "%-0.6ld",
+__LINE__, 0x0000001dL, "1d", "%x",
+__LINE__, 0xffffe315L, "FFFFE315", "%+4X",
+__LINE__, 0x0000716bL, "716B", "%X",
+__LINE__, 0xfffb8315L, "0xfffb8315", "%+#x",
+__LINE__, 0x00000132L, "132 ", "%-7.3x",
+__LINE__, 0x00000000L, "+0000000", "%+1.7d",
+__LINE__, 0xe16d27abL, "E16D27AB", "%X",
+__LINE__, 0xffffffe5L, "ffffffe5", "%+x",
+__LINE__, -0x000ab9dL, "-43933", "%ld",
+__LINE__, 0xffd042d6L, "ffd042d6", "%2x",
+__LINE__, 0xffffff9bL, "ffffff9b", "%x",
+__LINE__, 0x000000fbL, "0xfb", "% #1.x",
+__LINE__, 0x0000000fL, " 15", "%#3ld",
+__LINE__, 0xfffba2d8L, "0XFFFBA2D8", "%-#0.X",
+__LINE__, 0xfffffff8L, "0XFFFFFFF8", "% #X",
+__LINE__, 0x00000000L, " ", "%4.ld",
+__LINE__, 0x00000002L, "2", "%+x",
+__LINE__, 0xfffff314L, "FFFFF314", "%-X",
+__LINE__, 0x00000000L, " 0", "% ld",
+__LINE__, -0x0000007L, "-07", "%3.2ld",
+__LINE__, 0xffffdd80L, "FFFFDD80", "%.6X",
+__LINE__, -0x000001bL, "-27", "%-ld",
+__LINE__, -0x0000258L, "-600", "%-0d",
+__LINE__, 0x00016377L, "16377", "%3X",
+__LINE__, 0x00000001L, "1", "%X",
+__LINE__, -0xac5d314L, "-180736788", "%d",
+__LINE__, -0x000036eL, "-878", "% ld",
+__LINE__, 0xfe346af4L, "fe346af4", "%.5x",
+__LINE__, 0xffffffe1L, "ffffffe1", "%-7.6x",
+__LINE__, -0x0a1df07L, "-10608391", "%#.5d",
+__LINE__, 0x000000c9L, " 0XC9", "%+#5.X",
+__LINE__, 0xfffffffeL, "fffffffe", "%x",
+__LINE__, 0xfffffff8L, "fffffff8", "%+x",
+__LINE__, -0x4517255L, "-72446549", "%.6ld",
+__LINE__, 0xfffa3670L, "FFFA3670", "%-6X",
+__LINE__, 0xffffffe0L, "ffffffe0", "%2.x",
+__LINE__, 0xffffffffL, "ffffffff", "%0x",
+__LINE__, 0x0000230dL, "8973", "%#.1d",
+__LINE__, 0x00000238L, "238", "%0X",
+__LINE__, 0xfffce5abL, "FFFCE5AB", "%-X",
+__LINE__, 0x0000002cL, "2C", "%X",
+__LINE__, 0x00000001L, " 1", "%4.ld",
+__LINE__, 0xffffff8dL, "FFFFFF8D", "%-X",
+__LINE__, 0x00069c69L, "433257", "%06d",
+__LINE__, 0xfffffb8dL, "0xfffffb8d", "%#x",
+__LINE__, 0x000d6a2dL, "879149", "%5.5d",
+__LINE__, -0x0001fcbL, " -8139", "%7.ld",
+__LINE__, 0xfff86937L, "fff86937", "%-0x",
+__LINE__, 0x00059cf9L, "367865", "%#.0ld",
+__LINE__, 0x02c5d87aL, "46520442", "%3.ld",
+__LINE__, 0x00000571L, "1393", "%ld",
+__LINE__, 0x0003c73fL, "+247615", "%+4ld",
+__LINE__, 0x0000004fL, "4f", "% 0x",
+__LINE__, 0x00000000L, "0", "%-ld",
+__LINE__, -0x0e5850fL, "-15041807", "% ld",
+__LINE__, -0x0000002L, " -0002", "%7.4d",
+__LINE__, 0xfffffd1bL, "fffffd1b", "%05x",
+__LINE__, 0x0000041cL, " 1052", "% #0.ld",
+__LINE__, -0x0000030L, "-48", "%d",
+__LINE__, -0x0013593L, "-79251", "% #d",
+__LINE__, 0x00000001L, "1", "%+X",
+__LINE__, 0x0000056bL, " 56b", "%4.x",
+__LINE__, -0x0000004L, "-4 ", "%-3d",
+__LINE__, -0x0000003L, "-3", "% ld",
+__LINE__, 0xffff7c14L, "0XFFFF7C14", "%#X",
+__LINE__, 0x02f63dd8L, "49692120", "%.7ld",
+__LINE__, -0x03c51c9L, "-3953097", "%+d",
+__LINE__, 0x00ded685L, "14603909", "%5.ld",
+__LINE__, 0xffffffbaL, "ffffffba", "%x",
+__LINE__, 0x000370e8L, "225512", "%#ld",
+__LINE__, 0x00000003L, "3", "%X",
+__LINE__, -0x0024a64L, "-150116", "%7.d",
+__LINE__, 0xff486ca1L, "ff486ca1", "%x",
+__LINE__, 0x000001cfL, "1CF", "% X",
+__LINE__, -0x0002d7eL, "-11646", "%-0d",
+__LINE__, 0x0a594c65L, "a594c65", "%.4x",
+__LINE__, -0x0000002L, "-0002", "%-5.4ld",
+__LINE__, 0x00000000L, "", "%00.ld",
+__LINE__, 0x00058bc4L, "58BC4", "%3X",
+__LINE__, 0x0002cf8eL, " 184206", "% 0ld",
+__LINE__, 0x000009c7L, "+2503", "%+4.ld",
+__LINE__, 0xed0c984dL, "ED0C984D", "%X",
+__LINE__, -0x0000058L, "-088", "%#.3ld",
+__LINE__, 0x0076083dL, "0X76083D", "%#6X",
+__LINE__, -0x0000001L, "-1", "%#d",
+__LINE__, -0x6bf1777L, "-113186679", "%#ld",
+__LINE__, -0x000011fL, "-287", "%ld",
+__LINE__, 0x001b0e7dL, "1B0E7D", "%-4X",
+__LINE__, 0x000007acL, " 1964", "%5.ld",
+__LINE__, 0x00000005L, "5", "%0.d",
+__LINE__, -0x00003baL, "-954", "%4.0ld",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%X",
+__LINE__, 0x00000019L, "19", "%x",
+__LINE__, 0xffffffe0L, "ffffffe0", "%-.6x",
+__LINE__, 0x0000012aL, " 298", "% d",
+__LINE__, 0x00002c74L, "2c74", "% 4.3x",
+__LINE__, 0x000002d5L, "725", "%d",
+__LINE__, 0x0001c9a9L, "1c9a9", "%-02x",
+__LINE__, 0xffc928c8L, "ffc928c8", "%x",
+__LINE__, -0x03ae51fL, "-3859743", "% #ld",
+__LINE__, 0x0000526dL, "526d", "%x",
+__LINE__, -0x00028f0L, "-10480", "%5ld",
+__LINE__, -0x49b4262L, "-77283938", "%+02.0d",
+__LINE__, 0x028d37f0L, "0x28d37f0", "%+#x",
+__LINE__, 0xd66e0af9L, "D66E0AF9", "%03.X",
+__LINE__, -0x00c7707L, "-816903", "%0d",
+__LINE__, -0x00000d0L, "-208", "%-.1ld",
+__LINE__, 0x0000c328L, "49960", "%d",
+__LINE__, 0x34cb86f1L, "34CB86F1", "%X",
+__LINE__, 0x000000f6L, "F6", "%+X",
+__LINE__, 0x0a3407ecL, "0xa3407ec", "%-#x",
+__LINE__, 0x00007ebcL, "32444", "%#3.d",
+__LINE__, 0xfffd3d65L, "fffd3d65", "%x",
+__LINE__, 0x0007bc82L, "0507010", "%0.7d",
+__LINE__, 0x0005bb93L, "375699", "%ld",
+__LINE__, 0x0ec11cc8L, "0XEC11CC8", "%+#6.2X",
+__LINE__, 0xfffff9c6L, "fffff9c6", "%.5x",
+__LINE__, 0xff05ab70L, "0XFF05AB70", "%-#.3X",
+__LINE__, 0x2328b716L, "589870870", "%d",
+__LINE__, 0x00001a79L, "6777", "%.1d",
+__LINE__, 0xfffee573L, "fffee573", "%0.1x",
+__LINE__, -0x0000929L, " -2345", "%7.d",
+__LINE__, 0xffffff9aL, "FFFFFF9A", "%2.X",
+__LINE__, 0xfffffe60L, "fffffe60", "%.5x",
+__LINE__, 0xfffffcd2L, "fffffcd2", "%.7x",
+__LINE__, 0x00000001L, " 001", "%6.3X",
+__LINE__, 0x00011e9cL, "+73372", "%+0ld",
+__LINE__, 0x0000002aL, "2a", "% x",
+__LINE__, 0xffffffffL, "ffffffff", "%.7x",
+__LINE__, -0x0008ee8L, "-36584", "%ld",
+__LINE__, 0x0000001cL, "28", "%-d",
+__LINE__, 0x000abedaL, "704218", "%d",
+__LINE__, 0x001347f7L, "1347f7", "%3.0x",
+__LINE__, 0x0000023eL, "574", "%3.3ld",
+__LINE__, 0x00000000L, "0", "%-ld",
+__LINE__, -0x0016de0L, "-93664", "%0ld",
+__LINE__, 0xffffff45L, "FFFFFF45", "% X",
+__LINE__, 0x02dfb08cL, "48214156", "%#ld",
+__LINE__, 0x003d73a2L, "3d73a2", "%6.x",
+__LINE__, 0x00147da7L, "1342887", "%#d",
+__LINE__, -0x5ff0f1eL, "-100601630", "%-01ld",
+__LINE__, -0x000000bL, "-11", "%ld",
+__LINE__, 0x00000168L, " 168", "%+6.x",
+__LINE__, 0xffffc28eL, "ffffc28e", "%0x",
+__LINE__, -0x00003a2L, "-930", "%ld",
+__LINE__, 0x0002e56fL, " 189807", "% 1.ld",
+__LINE__, 0x51abf44fL, "0x51abf44f", "%#.7x",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, 0x9581268fL, "9581268F", "%+X",
+__LINE__, 0xffffff3bL, "FFFFFF3B", "%X",
+__LINE__, 0x000083d4L, " 33748", "% #d",
+__LINE__, 0x00000001L, "1", "%x",
+__LINE__, -0x000e51fL, "-58655", "%.0ld",
+__LINE__, 0x0003eacbL, "256715", "%6ld",
+__LINE__, 0x02be09dbL, " 46008795", "% 0.ld",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "% X",
+__LINE__, 0x000084f5L, " 34037", "%6ld",
+__LINE__, -0x1127f99L, "-17989529", "%#d",
+__LINE__, 0x5f6512deL, "5f6512de", "%.7x",
+__LINE__, 0x00000001L, "1", "%x",
+__LINE__, 0xfff74ab5L, "fff74ab5", "%x",
+__LINE__, 0x0eebeb94L, "250342292", "%4.ld",
+__LINE__, 0x0001b846L, "0x1b846", "%#1x",
+__LINE__, 0x001e8c32L, "1E8C32", "%2X",
+__LINE__, -0x0dae932L, "-14346546", "%5.1d",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, -0x0000042L, "-66", "%ld",
+__LINE__, 0xffffff51L, "FFFFFF51", "%0.1X",
+__LINE__, 0x00000043L, "43", "%x",
+__LINE__, 0x04c21f39L, " 79830841", "% 0ld",
+__LINE__, 0x0000061eL, "1566", "%03.3d",
+__LINE__, -0x0000003L, "-3", "%+d",
+__LINE__, 0x015b32dbL, " 22754011", "% .4d",
+__LINE__, 0xfffff181L, "FFFFF181", "%-X",
+__LINE__, 0x000017ecL, "0X17EC", "%#X",
+__LINE__, 0x000d703eL, "880702", "%#ld",
+__LINE__, -0x6d7533a0L, "-1836397472", "%ld",
+__LINE__, 0x0000008aL, " 138", "% d",
+__LINE__, -0x7368794bL, "-1936226635", "%+#d",
+__LINE__, 0x0000000dL, "0XD", "%#X",
+__LINE__, 0x0000030dL, "30D", "% X",
+__LINE__, 0xfffff9feL, "FFFFF9FE", "%5X",
+__LINE__, 0x00001bb2L, "7090", "%d",
+__LINE__, 0x041d2a0cL, "41D2A0C", "%0X",
+__LINE__, 0x00012aeeL, " 76526", "% d",
+__LINE__, 0x0000055fL, "55f", "%.1x",
+__LINE__, 0xffffffffL, "0XFFFFFFFF", "%#1X",
+__LINE__, 0x07b0a971L, "+129018225", "%+.2ld",
+__LINE__, 0xfffffff8L, "FFFFFFF8", "%4X",
+__LINE__, 0x00000001L, "1", "%d",
+__LINE__, 0x00000038L, "+56", "%+2ld",
+__LINE__, 0xfffffc2fL, "fffffc2f", "%+7.x",
+__LINE__, 0x00004477L, "0x4477", "% #x",
+__LINE__, 0x0000000dL, "0XD", "%+#3X",
+__LINE__, 0xf5bf37b1L, "F5BF37B1", "%1.X",
+__LINE__, 0x1a96f431L, "446100529", "%d",
+__LINE__, 0x0037edf3L, "+3665395", "%+#4.5ld",
+__LINE__, 0x0007f2aaL, "520874", "%0ld",
+__LINE__, -0x00051a3L, "-20899", "%+#1.ld",
+__LINE__, 0x0000037fL, "37F", "%0X",
+__LINE__, 0xffffffb4L, "ffffffb4", "%x",
+__LINE__, -0xd984c00L, "-228084736", "%+06ld",
+__LINE__, 0xffffe1beL, "FFFFE1BE", "%X",
+__LINE__, 0xfff20d48L, "FFF20D48", "%+6.0X",
+__LINE__, 0x000028b7L, "0x028b7", "%-#7.5x",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, 0x03f37945L, "66287941", "%d",
+__LINE__, 0xffffffedL, "0XFFFFFFED", "%+#6.4X",
+__LINE__, 0x0000f046L, "f046", "%x",
+__LINE__, 0xe9772b51L, "E9772B51", "%-1.X",
+__LINE__, 0xfffffffeL, "fffffffe", "% x",
+__LINE__, 0xfffffffaL, "0xfffffffa", "%#x",
+__LINE__, 0x00000015L, "15", "%-X",
+__LINE__, 0x0000003cL, "60", "%#ld",
+__LINE__, 0x3103952dL, "822318381", "%0.ld",
+__LINE__, 0x17ba68bbL, "398092475", "%2d",
+__LINE__, 0x000006c4L, "+1732", "%+.2d",
+__LINE__, 0x00000043L, "67", "%#d",
+__LINE__, 0x0043fb55L, "4455253", "%.1ld",
+__LINE__, 0x00004b76L, "4b76", "% 0x",
+__LINE__, 0xfff4c56bL, "FFF4C56B", "%7X",
+__LINE__, 0x00766055L, "766055", "%+5x",
+__LINE__, -0x000009fL, "-159", "%+d",
+__LINE__, 0xffff063fL, "ffff063f", "%-2x",
+__LINE__, 0x00808fc8L, "808fc8", "%x",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, 0x000000f1L, "00000f1", "%+02.7x",
+__LINE__, 0x00000002L, "2", "%X",
+__LINE__, 0x00000000L, "000", "%03d",
+__LINE__, 0xe63f73b2L, "E63F73B2", "% 1X",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%5.1X",
+__LINE__, 0x0d3fa38bL, "222274443", "%1d",
+__LINE__, 0x00000000L, "0", "% X",
+__LINE__, 0x00000001L, " 1", "%04.ld",
+__LINE__, 0x00000046L, "46", "%0X",
+__LINE__, 0x0000761fL, " 30239", "% ld",
+__LINE__, -0x0002517L, "-9495", "%+d",
+__LINE__, 0x00000156L, "156", "% 0x",
+__LINE__, 0x1c55eba2L, "1c55eba2", "%.6x",
+__LINE__, 0x005af80dL, "5af80d", "%.6x",
+__LINE__, 0x0000002eL, "46", "%d",
+__LINE__, -0x0007c0fL, "-31759", "%ld",
+__LINE__, 0xffffe924L, "FFFFE924", "%7X",
+__LINE__, 0x00000174L, "372", "%ld",
+__LINE__, 0xffffffc9L, "0xffffffc9", "%-#x",
+__LINE__, 0x00000020L, "+000032", "%+07d",
+__LINE__, 0xffffe5d9L, "FFFFE5D9", "%4.5X",
+__LINE__, 0xffffffa3L, "FFFFFFA3", "%+.3X",
+__LINE__, 0x00000a03L, "+2563", "%+2d",
+__LINE__, 0x001b58caL, "+1792202", "%+4d",
+__LINE__, 0xffffffc9L, "0xffffffc9", "%+#5x",
+__LINE__, -0x0000003L, "-3", "% d",
+__LINE__, 0xfffffffcL, "fffffffc", "%+0x",
+__LINE__, -0x0000002L, "-02", "%.2d",
+__LINE__, 0x000243fbL, "148475", "%-ld",
+__LINE__, 0x00000001L, "1", "%0d",
+__LINE__, -0x0000672L, "-1650", "%ld",
+__LINE__, -0x0005413L, "-0021523", "% 7.7d",
+__LINE__, 0x00000017L, "0X17", "%#X",
+__LINE__, 0x00000e48L, "3656", "%0d",
+__LINE__, 0xffe79b38L, "ffe79b38", "%-x",
+__LINE__, 0xffffff15L, "FFFFFF15", "%+6.1X",
+__LINE__, 0xfff0272cL, "fff0272c", "%-.5x",
+__LINE__, -0x00b706fL, "-749679", "%1.ld",
+__LINE__, 0x0176aeecL, "176AEEC", "%.1X",
+__LINE__, -0x00005a1L, "-1441", "% 0ld",
+__LINE__, -0x0000002L, "-00002", "%.5d",
+__LINE__, -0xd2e6f5dL, "-221146973", "%1ld",
+__LINE__, -0x0000001L, " -001", "%5.3ld",
+__LINE__, 0x00000001L, " 1", "%05.ld",
+__LINE__, 0x0000749eL, "+29854", "%+#d",
+__LINE__, 0x00000005L, "5", "%d",
+__LINE__, 0xfa7128b0L, "fa7128b0", "%1.x",
+__LINE__, 0xffffbbb4L, "0XFFFFBBB4", "%#.1X",
+__LINE__, 0x0006862fL, "427567", "%d",
+__LINE__, 0x00000002L, "2", "%X",
+__LINE__, 0x000005d4L, "5d4", "% x",
+__LINE__, 0x001387e1L, "1279969", "%-05.0ld",
+__LINE__, -0x0035a56L, "-219734", "%ld",
+__LINE__, -0x4064ecc6L, "-1080356038", "%ld",
+__LINE__, 0x0000360dL, "13837", "%0ld",
+__LINE__, -0xea1a85bL, "-245475419", "%-.2ld",
+__LINE__, 0xffffff2dL, "FFFFFF2D", "%X",
+__LINE__, 0x00000004L, " 0004", "%7.4x",
+__LINE__, 0x00f72ffdL, "F72FFD", "%-X",
+__LINE__, 0x00000fa2L, "fa2 ", "%-5x",
+__LINE__, 0x05ae1f9aL, "95297434", "%#ld",
+__LINE__, 0x0000bf2eL, "48942", "%3.d",
+__LINE__, 0x00000000L, " ", "%1.X",
+__LINE__, 0x01bcb097L, "29143191", "%ld",
+__LINE__, 0x0000009cL, "156 ", "%-4.0d",
+__LINE__, 0xfffffffeL, "fffffffe", "% x",
+__LINE__, 0x00000001L, "1 ", "%-6.d",
+__LINE__, 0xffffffefL, "ffffffef", "%7.x",
+__LINE__, 0xfffffec1L, "fffffec1", "%.5x",
+__LINE__, -0x000000fL, "-15", "%-1d",
+__LINE__, -0x0008426L, "-33830", "%0ld",
+__LINE__, 0x005be0aeL, "5BE0AE", "% X",
+__LINE__, 0x00000009L, " 9", "%+7X",
+__LINE__, -0x0007e18L, "-32280", "%+0.d",
+__LINE__, 0x01697ba1L, " 23690145", "% 5.ld",
+__LINE__, -0x0012042L, "-073794", "%7.6d",
+__LINE__, 0x04e9bd0dL, "4e9bd0d", "%-2x",
+__LINE__, 0xffffffd9L, "FFFFFFD9", "%.2X",
+__LINE__, -0x01b9632L, "-1807922", "%.6ld",
+__LINE__, 0x000000cdL, "205", "%1.ld",
+__LINE__, 0x00000000L, " ", "% .0d",
+__LINE__, 0xff17bbb1L, "ff17bbb1", "%x",
+__LINE__, -0x00146d7L, "-83671", "%+1.ld",
+__LINE__, 0xfffff144L, "fffff144", "%x",
+__LINE__, 0x000f8dbeL, "F8DBE", "%3.X",
+__LINE__, -0x000381cL, "-14364", "%d",
+__LINE__, 0x0000001eL, " 30", "%4.1d",
+__LINE__, 0x00000016L, "22", "%-0d",
+__LINE__, 0x00000002L, "+02", "%+1.2ld",
+__LINE__, 0x0000e803L, "59395", "%d",
+__LINE__, 0xb4c2448dL, "b4c2448d", "%-7x",
+__LINE__, 0x000e697dL, "944509", "%ld",
+__LINE__, 0xfffe6e32L, "0XFFFE6E32", "%#X",
+__LINE__, 0x00000190L, " 190", "%+5.X",
+__LINE__, -0x03a2219L, "-3809817", "%#6.ld",
+__LINE__, -0x000003cL, "-60 ", "%-#4.ld",
+__LINE__, 0x00000000L, " ", "% 03.ld",
+__LINE__, -0x074f922L, "-7665954", "%ld",
+__LINE__, -0x00000f0L, "-240", "%-ld",
+__LINE__, 0xfffe42d2L, "0XFFFE42D2", "%#X",
+__LINE__, 0x000000ddL, "DD", "%X",
+__LINE__, 0x00359abeL, "359ABE", "%.1X",
+__LINE__, 0xffec7bdfL, "FFEC7BDF", "%0.1X",
+__LINE__, 0x0ecddcbaL, "248372410", "%-#3.d",
+__LINE__, 0x00ad0dbcL, "11341244", "%ld",
+__LINE__, -0x0000001L, "-1", "%-d",
+__LINE__, 0x00050841L, "50841", "% .5x",
+__LINE__, 0x01d359e7L, "1d359e7", "%1.x",
+__LINE__, 0xff9efaa3L, "FF9EFAA3", "%X",
+__LINE__, 0x0007ea10L, "+518672", "%+ld",
+__LINE__, -0x000671cL, "-26396", "%1d",
+__LINE__, 0xffffff91L, "0xffffff91", "%#4.4x",
+__LINE__, 0x00000000L, "+", "%+0.0ld",
+__LINE__, -0x002c53eL, "-181566", "%3.d",
+__LINE__, 0xffffff56L, "ffffff56", "%x",
+__LINE__, 0xfffff589L, "FFFFF589", "%+X",
+__LINE__, 0x00024d13L, "24D13", "%-5.2X",
+__LINE__, 0x00000000L, " 0", "%6.1d",
+__LINE__, 0x00a64f33L, "A64F33", "%4.4X",
+__LINE__, 0xffebb57aL, "FFEBB57A", "%5.4X",
+__LINE__, 0xfff3b4a0L, "fff3b4a0", "%2.x",
+__LINE__, 0xffffffd9L, "FFFFFFD9", "%.2X",
+__LINE__, 0x00d37b84L, "13859716", "%d",
+__LINE__, 0x00001e85L, "0001E85", "%0.7X",
+__LINE__, -0x756148fL, "-123081871", "% 7.d",
+__LINE__, -0x0319339L, "-3248953", "%+#.4d",
+__LINE__, -0x00798b8L, "-497848", "%#5ld",
+__LINE__, -0x0000039L, "-57", "%0d",
+__LINE__, -0x000b1d7L, "-45527", "%+0.ld",
+__LINE__, 0xff811fbaL, "FF811FBA", "%+X",
+__LINE__, 0x00000042L, " 66", "% ld",
+__LINE__, 0xfffffe31L, "0XFFFFFE31", "%#X",
+__LINE__, 0x00000073L, "115", "%ld",
+__LINE__, 0x45091a39L, "0x45091a39", "%+#3.x",
+__LINE__, 0x001270f5L, "1270f5", "%-5.6x",
+__LINE__, 0xfffd91fdL, "fffd91fd", "%x",
+__LINE__, -0x0817badL, "-8485805", "%#ld",
+__LINE__, -0x32ad55fL, "-53138783", "%0d",
+__LINE__, 0x00003e57L, "15959", "%0ld",
+__LINE__, -0x0048756L, "-296790", "%2.6d",
+__LINE__, 0xff90f45fL, "FF90F45F", "% X",
+__LINE__, 0x0000e454L, "0e454", "% .5x",
+__LINE__, 0xfffffffcL, "fffffffc", "%x",
+__LINE__, 0xfffffff7L, "FFFFFFF7", "%-2X",
+__LINE__, 0xffdabf0eL, "FFDABF0E", "%+X",
+__LINE__, 0xffffffffL, "0XFFFFFFFF", "%#1X",
+__LINE__, 0x01516650L, "1516650", "% x",
+__LINE__, 0xffffff51L, "FFFFFF51", "%X",
+__LINE__, 0x000000eaL, "234", "%00.d",
+__LINE__, 0x06db60caL, "115040458", "%5.d",
+__LINE__, 0x00000f01L, " 3841", "% d",
+__LINE__, 0x00000009L, "9", "%x",
+__LINE__, 0x299b3ba0L, "299b3ba0", "%6.7x",
+__LINE__, 0x0067f298L, "67f298", "%-2.6x",
+__LINE__, 0xfffffff5L, "FFFFFFF5", "% 2X",
+__LINE__, 0x00102ff9L, "102FF9", "%-.0X",
+__LINE__, 0xffc22393L, "0xffc22393", "% #6x",
+__LINE__, 0x00007db5L, "32181", "%-2ld",
+__LINE__, 0x0000b0a3L, "0xb0a3", "%#0x",
+__LINE__, 0x001ceebbL, "1CEEBB", "%-3.4X",
+__LINE__, 0x00025101L, "0x25101", "%#x",
+__LINE__, -0x0000001L, "-1", "%0ld",
+__LINE__, 0xffffd846L, "FFFFD846", "%+2.3X",
+__LINE__, 0x00001d79L, " 7545", "% 0.1ld",
+__LINE__, -0x0000002L, " -2", "%5d",
+__LINE__, 0xf93b9fdcL, "f93b9fdc", "%5x",
+__LINE__, 0xffff0021L, "FFFF0021", "%6X",
+__LINE__, 0x00007cf9L, "7cf9", "%3.1x",
+__LINE__, -0x0000002L, "-2", "%d",
+__LINE__, 0x00001d84L, "1d84", "%0x",
+__LINE__, -0x033201eL, "-3350558", "%-2.0d",
+__LINE__, 0xfff8a6fbL, "FFF8A6FB", "%+.7X",
+__LINE__, 0x00006fffL, " 28671", "% ld",
+__LINE__, -0x02a274aL, "-2762570", "%d",
+__LINE__, -0x0006628L, "-26152", "%00ld",
+__LINE__, 0x00000011L, "11", "%-x",
+__LINE__, -0x0000ed9L, "-3801", "%0.ld",
+__LINE__, 0xfc5b725dL, "FC5B725D", "%X",
+__LINE__, 0x3530bd4eL, "892386638", "%7.d",
+__LINE__, 0x03bb4ff7L, "62607351", "%#4.7ld",
+__LINE__, 0x00009f86L, "9f86", "%x",
+__LINE__, 0x0000e727L, "59175", "%1d",
+__LINE__, 0xfffffdf2L, "0XFFFFFDF2", "%#X",
+__LINE__, 0x00e60dbfL, "0XE60DBF", "% #1.X",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%+X",
+__LINE__, 0x0a16f44eL, "0XA16F44E", "%#.0X",
+__LINE__, 0x0001f97cL, "1f97c", "% x",
+__LINE__, 0x0000000dL, "13", "%#0ld",
+__LINE__, 0x0000002aL, "42", "%0ld",
+__LINE__, 0x00000007L, " +7", "%+5ld",
+__LINE__, 0xffffff7fL, "FFFFFF7F", "%-X",
+__LINE__, 0x000006a6L, "1702", "%ld",
+__LINE__, 0xfaff2fb1L, "faff2fb1", "% x",
+__LINE__, 0xffff94abL, "ffff94ab", "%x",
+__LINE__, 0x011d611bL, "0X11D611B", "%#2.3X",
+__LINE__, 0x00000000L, " +000", "%+#5.3ld",
+__LINE__, -0x87fcc37L, "-142593079", "%+d",
+__LINE__, -0x0417424L, "-4289572", "%+d",
+__LINE__, 0x03fabc0cL, "3fabc0c", "%x",
+__LINE__, 0xfffff880L, "fffff880", "%-x",
+__LINE__, 0x000002d7L, "2d7", "%-02.x",
+__LINE__, 0x00003e82L, "16002", "%#d",
+__LINE__, -0x0003713L, "-14099", "% 5d",
+__LINE__, -0x0000027L, "-39", "%ld",
+__LINE__, 0x00013098L, "0077976", "%01.7d",
+__LINE__, -0x000000cL, "-12", "%ld",
+__LINE__, -0x00000c0L, "-192", "% ld",
+__LINE__, 0xffbe9285L, "FFBE9285", "%3.X",
+__LINE__, 0x00000046L, "46", "%x",
+__LINE__, 0x00000000L, " ", "%+4.x",
+__LINE__, 0x00011e72L, "73330", "%2.3d",
+__LINE__, -0x5276dd7L, "-86470103", "%d",
+__LINE__, 0x00000013L, "19", "%-02.ld",
+__LINE__, 0x384118a7L, "0X384118A7", "%-#X",
+__LINE__, 0x00000000L, "0", "% #X",
+__LINE__, 0x00000009L, "9", "%#ld",
+__LINE__, 0x00021145L, "135493", "%-ld",
+__LINE__, 0xff188a0cL, "FF188A0C", "%1.X",
+__LINE__, 0xffffffd5L, "ffffffd5", "%0x",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "% 0X",
+__LINE__, 0xffff74a3L, "ffff74a3", "%x",
+__LINE__, 0x01d5a2f8L, "1d5a2f8", "%-0.x",
+__LINE__, 0xfffffef6L, "fffffef6", "%+06.x",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, 0x00000000L, "+0", "%+ld",
+__LINE__, 0xfffffffcL, "fffffffc", "%4.x",
+__LINE__, -0x0000344L, "-0836", "% .4d",
+__LINE__, 0xfffffffdL, "FFFFFFFD", "%0X",
+__LINE__, 0x000a3121L, "667937", "%#4.4ld",
+__LINE__, 0x0001e211L, "0X1E211", "%#X",
+__LINE__, 0x00000c8bL, "00C8B", "%05X",
+__LINE__, 0xfffffffeL, "fffffffe", "%+0x",
+__LINE__, 0x001a53ceL, "1725390", "%d",
+__LINE__, 0x0000057fL, "57f ", "%-7.x",
+__LINE__, -0x0073e4dL, "-474701", "%#ld",
+__LINE__, -0x0000002L, " -2", "% 3.d",
+__LINE__, 0x482dc404L, "482DC404", "%X",
+__LINE__, 0x0000011cL, "11c", "%-.1x",
+__LINE__, 0x00000c12L, " 3090", "%5.3ld",
+__LINE__, 0xfffe1068L, "FFFE1068", "%-.4X",
+__LINE__, -0x0055e88L, "-351880", "%ld",
+__LINE__, 0x000c9cefL, "+826607", "%+d",
+__LINE__, 0xffffffe3L, "ffffffe3", "%0x",
+__LINE__, -0x0000ee9L, "-3817", "%#ld",
+__LINE__, 0xff1f6daaL, "FF1F6DAA", "%X",
+__LINE__, 0xfffffc4eL, "FFFFFC4E", "%5.2X",
+__LINE__, -0x000040aL, "-1034", "%d",
+__LINE__, -0x0000085L, "-00133", "% 01.5d",
+__LINE__, -0x126c797cL, "-309098876", "%5.ld",
+__LINE__, 0x00000039L, " 57", "% d",
+__LINE__, 0xfffffff6L, "0xfffffff6", "%#5.x",
+__LINE__, 0xfffffff4L, "fffffff4", "%7.6x",
+__LINE__, 0x00000003L, "3", "%ld",
+__LINE__, 0x0000f8aeL, "f8ae", "%.0x",
+__LINE__, 0x003ca1cfL, "3973583", "%#3.7d",
+__LINE__, 0x14687009L, "0x14687009", "%+#3x",
+__LINE__, 0xfffff1f7L, "0xfffff1f7", "%#4.5x",
+__LINE__, 0xfffff17aL, "fffff17a", "%3.x",
+__LINE__, 0x0011ea18L, "1174040", "%ld",
+__LINE__, -0x0000019L, "-25", "%03.d",
+__LINE__, 0x00015d72L, "0X15D72", "%-#X",
+__LINE__, 0xffde4a41L, "ffde4a41", "%x",
+__LINE__, 0x00006f1fL, "28447", "%d",
+__LINE__, 0xffffffbdL, "0xffffffbd", "%#.1x",
+__LINE__, 0x000013b9L, "13B9", "%0X",
+__LINE__, -0x00001b9L, "-00441", "%1.5d",
+__LINE__, 0x00000001L, "000001", "%-.6d",
+__LINE__, 0x7b602d8fL, "+2069900687", "%+0ld",
+__LINE__, 0x0005e323L, "+385827", "%+ld",
+__LINE__, 0x00002fceL, "2FCE", "%+0X",
+__LINE__, 0x0000000eL, "0014", "%.4d",
+__LINE__, 0xffffffd6L, "0XFFFFFFD6", "%#4.X",
+__LINE__, 0x037bf361L, "58454881", "%5.ld",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%-7.5X",
+__LINE__, -0x016d4dcL, "-1496284", "%6ld",
+__LINE__, 0x0005be9aL, "0x5be9a", "%-#.5x",
+__LINE__, 0xffffffffL, "ffffffff", "%1x",
+__LINE__, 0x00000055L, " 85", "% 7.d",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, -0x0135392L, "-1266578", "% ld",
+__LINE__, 0x00850f26L, "8720166", "%d",
+__LINE__, 0xffffee39L, "ffffee39", "%0x",
+__LINE__, 0x000000ddL, "221", "%ld",
+__LINE__, 0x00000000L, " ", "%6.d",
+__LINE__, 0x000000d8L, "d8", "%x",
+__LINE__, 0x000007ecL, "002028", "%4.6ld",
+__LINE__, 0x0dab4e67L, "0XDAB4E67", "%#X",
+__LINE__, 0xfffd7c95L, "FFFD7C95", "% 4X",
+__LINE__, 0x0009302dL, "9302D", "%3.1X",
+__LINE__, 0x00000003L, " 3", "% d",
+__LINE__, 0x0000082fL, "82f", "%-x",
+__LINE__, 0x0652517fL, "652517F", "%-.2X",
+__LINE__, -0x1fd8f4e3L, "-534312163", "%d",
+__LINE__, 0x00000176L, "176", "%-x",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, 0x0000001aL, "1A", "%X",
+__LINE__, -0x0005740L, "-22336", "% 0ld",
+__LINE__, 0xffffffffL, "ffffffff", "%6x",
+__LINE__, 0x1b273b80L, "0x1b273b80", "%#x",
+__LINE__, 0x00000065L, "65", "%X",
+__LINE__, 0x6a62138aL, "1784812426", "%2ld",
+__LINE__, 0x000001a2L, "1A2", "%X",
+__LINE__, -0x002aafdL, "-174845", "%02.ld",
+__LINE__, 0x00000014L, "20", "%d",
+__LINE__, -0x00000c7L, " -199", "%7.0ld",
+__LINE__, 0xff545bfdL, "ff545bfd", "%-x",
+__LINE__, -0x002beb9L, "-179897", "%02.2ld",
+__LINE__, -0x00000dfL, "-223", "% 02.d",
+__LINE__, -0x000d569L, "-54633", "%1.ld",
+__LINE__, 0x0000000eL, "14", "%d",
+__LINE__, -0x0077407L, "-488455", "% ld",
+__LINE__, 0x0001be09L, "114185", "%ld",
+__LINE__, -0x0000514L, "-01300", "%+05.5d",
+__LINE__, 0xf1fb397fL, "f1fb397f", "%+x",
+__LINE__, 0xfdb6707cL, "FDB6707C", "%X",
+__LINE__, 0x03cad111L, "3cad111", "%5.x",
+__LINE__, -0x022e72fL, "-2287407", "%d",
+__LINE__, -0xda35f48L, "-228810568", "%d",
+__LINE__, -0x02d1fd4L, "-2957268", "%1.3d",
+__LINE__, 0x0000005fL, "+95", "%+2d",
+__LINE__, 0xfffbf8a1L, "FFFBF8A1", "%4.2X",
+__LINE__, 0x0000071eL, " 71e", "%6.x",
+__LINE__, 0x000cc8a5L, "+837797", "%+03ld",
+__LINE__, 0x000eebe9L, " EEBE9", "%6.X",
+__LINE__, -0x2896b204L, "-680964612", "%d",
+__LINE__, -0x09553f8L, "-9786360", "%d",
+__LINE__, 0x000015d3L, "5587", "%0d",
+__LINE__, 0x0000056dL, " 56d", "%+4.x",
+__LINE__, -0x00624adL, "-402605", "% ld",
+__LINE__, 0xfea64ba5L, "0xfea64ba5", "%#1x",
+__LINE__, 0x004f35c6L, "5191110", "%-ld",
+__LINE__, -0x1441fe4L, "-21241828", "%d",
+__LINE__, 0xffffff95L, "FFFFFF95", "%X",
+__LINE__, 0xfffecf81L, "FFFECF81", "%-2.X",
+__LINE__, -0x00002bbL, "-699", "%-d",
+__LINE__, -0x0000c29L, "-3113", "% 02ld",
+__LINE__, 0x000026a3L, " 9891", "% .4d",
+__LINE__, 0x00000003L, "3", "%-x",
+__LINE__, 0x000007dbL, "+02011", "%+.5ld",
+__LINE__, 0xfff99558L, "FFF99558", "%.1X",
+__LINE__, 0x0000fce6L, "64742", "%4.0d",
+__LINE__, 0x000b7ea2L, "753314", "%ld",
+__LINE__, 0x13e5df30L, "0X13E5DF30", "%#2.X",
+__LINE__, 0x006761c4L, "06761C4", "%6.7X",
+__LINE__, 0xffffff78L, "FFFFFF78", "%0.X",
+__LINE__, 0xfffff1c0L, "0xfffff1c0", "% #x",
+__LINE__, -0x034af1cL, "-3452700", "% 06.1d",
+__LINE__, 0x000000deL, "0000222", "%2.7ld",
+__LINE__, 0x000003d8L, "0x3d8", "%#4.x",
+__LINE__, -0x001a1d1L, "-106961", "%3.1d",
+__LINE__, -0x0000002L, "-2", "% d",
+__LINE__, 0x00001de6L, "+7654", "%+0ld",
+__LINE__, 0x00000001L, "001", "%#.3d",
+__LINE__, -0x53dacf9fL, "-1406848927", "%ld",
+__LINE__, 0xfffffffcL, "fffffffc", "%3.3x",
+__LINE__, -0x00950e8L, "-610536", "%3.6ld",
+__LINE__, 0xff14ade9L, "FF14ADE9", "%6X",
+__LINE__, 0x012f5284L, "0X12F5284", "% #5X",
+__LINE__, 0x00005a21L, " 5a21", "%5x",
+__LINE__, 0x00000638L, "1592", "%2.4ld",
+__LINE__, -0x063017bL, "-6488443", "%ld",
+__LINE__, 0x00000000L, "0", "% X",
+__LINE__, 0xfffe8ef2L, "FFFE8EF2", "%+0X",
+__LINE__, -0x0001c96L, "-7318", "%.3d",
+__LINE__, 0x0000ca7dL, "51837", "%ld",
+__LINE__, 0x00000001L, "1", "%+1x",
+__LINE__, 0xfffff7bcL, "FFFFF7BC", "%X",
+__LINE__, -0x03d15e2L, "-4003298", "%ld",
+__LINE__, 0xfffffffeL, "fffffffe", "% x",
+__LINE__, 0x00066183L, "+418179", "%+7.1ld",
+__LINE__, 0xffffef2eL, "ffffef2e", "%-2.x",
+__LINE__, 0x00000000L, " 000", "%04.3x",
+__LINE__, -0x000000fL, "-15", "% d",
+__LINE__, -0x00001f5L, "-501", "%d",
+__LINE__, 0x0c67f159L, "c67f159", "%6.2x",
+__LINE__, -0x0000006L, "-6", "%.1d",
+__LINE__, 0x00000005L, "0X5", "%+#1X",
+__LINE__, -0x0000002L, " -2", "%6.ld",
+__LINE__, 0xeb2183ecL, "eb2183ec", "% x",
+__LINE__, -0x5e12a322L, "-1578279714", "%d",
+__LINE__, 0x00000001L, "0x1", "%#x",
+__LINE__, -0x0001ea4L, "-7844", "%0d",
+__LINE__, -0x19955a3L, "-26826147", "%d",
+__LINE__, 0x000002a6L, "2A6", "%2.X",
+__LINE__, 0x00000002L, "2", "%X",
+__LINE__, 0xfffffeecL, "fffffeec", "%0.4x",
+__LINE__, 0xfffffffcL, "fffffffc", "%0x",
+__LINE__, 0xffdfe740L, "FFDFE740", "% X",
+__LINE__, -0x0b0b3e7L, "-11580391", "%.1d",
+__LINE__, 0x8e01077cL, "8E01077C", "%5.7X",
+__LINE__, 0x3b6b6d55L, "996896085", "%1.1d",
+__LINE__, 0x000016afL, "5807", "%ld",
+__LINE__, -0x0004900L, "-18688", "%d",
+__LINE__, 0xfffd77bcL, "FFFD77BC", "%X",
+__LINE__, 0x004cbd74L, "5029236", "%0d",
+__LINE__, 0x00000003L, " 00003", "%6.5d",
+__LINE__, 0x0004720fL, "4720f", "% x",
+__LINE__, 0x0e44535dL, "e44535d", "%4x",
+__LINE__, 0xfffffff9L, "FFFFFFF9", "%3.3X",
+__LINE__, -0x0000005L, "-5", "%-d",
+__LINE__, 0x000001a6L, "00001A6", "%1.7X",
+__LINE__, 0x0000004aL, "4A", "%-2.X",
+__LINE__, 0xfffff249L, "FFFFF249", "%X",
+__LINE__, 0x00004345L, "4345", "%x",
+__LINE__, 0x0197041dL, "197041d", "%+0x",
+__LINE__, 0x0000019aL, " 19a", "% 6.x",
+__LINE__, 0xfff98376L, "FFF98376", "%X",
+__LINE__, 0xfc536c41L, "FC536C41", "%X",
+__LINE__, -0x0008d91L, "-36241", "% d",
+__LINE__, 0xf058d69dL, "f058d69d", "%4.x",
+__LINE__, -0x00013efL, "-5103", "%d",
+__LINE__, -0x0000003L, "-3", "%00ld",
+__LINE__, -0x09e80f0L, "-10387696", "%+07ld",
+__LINE__, -0x0222c15L, "-2239509", "%#0.4ld",
+__LINE__, 0x00000004L, "4", "%0ld",
+__LINE__, -0x02c6b0dL, "-2910989", "% 0ld",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%-4X",
+__LINE__, 0xffffff3dL, "FFFFFF3D", "%-.0X",
+__LINE__, -0x0000015L, "-21", "%0d",
+__LINE__, 0x131dfc90L, "+320732304", "%+d",
+__LINE__, 0xffffffffL, "ffffffff", "%+x",
+__LINE__, 0x000035c8L, "13768", "%0ld",
+__LINE__, 0x00000033L, "0x0033", "%#.4x",
+__LINE__, 0x0ce7e8c1L, "0xce7e8c1", "%#.7x",
+__LINE__, 0xfc18b5d2L, "FC18B5D2", "%+.3X",
+__LINE__, 0x00000015L, "21", "%d",
+__LINE__, 0x001a5e7cL, "1a5e7c", "%05x",
+__LINE__, -0x000fbf0L, "-64496", "%ld",
+__LINE__, -0x000a4f7L, "-042231", "%+2.6d",
+__LINE__, -0x0000002L, "-002", "%3.3ld",
+__LINE__, 0x00728878L, "728878", "%0X",
+__LINE__, -0x0000002L, "-2", "%#.1ld",
+__LINE__, -0x00002efL, "-751", "%-0ld",
+__LINE__, 0xfffffff7L, "fffffff7", "%.3x",
+__LINE__, 0x00491867L, "0491867", "%.7X",
+__LINE__, 0x00000d4dL, "3405", "%-ld",
+__LINE__, 0x00234e86L, "234E86", "%0X",
+__LINE__, -0x000001bL, "-27", "%ld",
+__LINE__, 0x00275255L, "2576981", "%.5ld",
+__LINE__, 0xfeacc214L, "0XFEACC214", "%-#3.X",
+__LINE__, -0x0001ce5L, "-7397", "%+#2.2ld",
+__LINE__, 0x089ddb6aL, "144563050", "%d",
+__LINE__, 0x003d5a95L, "3D5A95", "%1X",
+__LINE__, 0x002f0b6dL, "3083117", "%d",
+__LINE__, 0x1e79e228L, "511304232", "%ld",
+__LINE__, 0xfffffe6bL, "FFFFFE6B", "%+0X",
+__LINE__, -0x5104ff3L, "-84955123", "%.4ld",
+__LINE__, 0xfffff1deL, "FFFFF1DE", "%X",
+__LINE__, 0x000000cfL, "+207", "%+.1ld",
+__LINE__, -0x16ad0164L, "-380436836", "%+5.d",
+__LINE__, 0x001fefa6L, "2092966", "%ld",
+__LINE__, 0x00000000L, "00", "%-.2d",
+__LINE__, 0x00195f45L, "195f45", "%+0x",
+__LINE__, 0x00000001L, " 1", "%3.ld",
+__LINE__, -0x00001c9L, "-457", "% ld",
+__LINE__, 0x0002479eL, "149406", "%#ld",
+__LINE__, 0x001ab18bL, "1749387", "%04d",
+__LINE__, 0x00000045L, "69", "%ld",
+__LINE__, 0xfbb13f7dL, "fbb13f7d", "%.2x",
+__LINE__, 0x03ddc208L, "3ddc208", "%x",
+__LINE__, 0x00000007L, "000007", "%#.6d",
+__LINE__, 0x00000000L, "0", "%01X",
+__LINE__, -0x0023110L, "-143632", "%+0.3d",
+__LINE__, 0x00000006L, "06", "%#.2d",
+__LINE__, 0xffff9ec9L, "ffff9ec9", "%7x",
+__LINE__, -0x08afb12L, "-9108242", "% #0.ld",
+__LINE__, 0x00000004L, "4", "%X",
+__LINE__, 0x00059684L, "59684", "%x",
+__LINE__, 0xfff8d8f5L, "FFF8D8F5", "%X",
+__LINE__, 0x00b7027dL, "+11993725", "%+0.7ld",
+__LINE__, 0x0000d814L, "55316", "%0ld",
+__LINE__, 0x03c95a08L, "3c95a08", "%3x",
+__LINE__, -0x0b65f9aL, "-11952026", "%d",
+__LINE__, 0xfd956021L, "fd956021", "%0x",
+__LINE__, 0x000000edL, "ed", "%0x",
+__LINE__, -0x006a80cL, "-436236", "%.6ld",
+__LINE__, 0xfedb109dL, "fedb109d", "%x",
+__LINE__, 0x00000001L, "1", "%X",
+__LINE__, 0x00b3eb71L, " 11791217", "% d",
+__LINE__, 0x00000016L, "16", "%0X",
+__LINE__, 0x000001dbL, " 475", "% ld",
+__LINE__, 0x00465eafL, "4611759", "%0d",
+__LINE__, 0x0001b423L, "1B423", "%0X",
+__LINE__, 0x05df95eaL, "5df95ea", "%+.5x",
+__LINE__, 0x0000000eL, " 14", "%7ld",
+__LINE__, 0xffffb89eL, "ffffb89e", "%+x",
+__LINE__, 0x01259918L, " 19241240", "% d",
+__LINE__, -0x0000f8dL, "-003981", "%+#.6d",
+__LINE__, 0x00054ae0L, "54AE0", "%X",
+__LINE__, -0x4589ed4L, "-72916692", "% ld",
+__LINE__, 0x01017516L, "1017516", "%6X",
+__LINE__, 0xfffb9f15L, "FFFB9F15", "%.2X",
+__LINE__, 0x005f8394L, "5F8394", "%.2X",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, -0x0000001L, " -1", "%7.1ld",
+__LINE__, 0x004367afL, "4417455", "%4.ld",
+__LINE__, 0xffffff86L, "ffffff86", "%4.5x",
+__LINE__, -0x0000d17L, "-3351", "%2.0ld",
+__LINE__, 0xffffff31L, "ffffff31", "%.6x",
+__LINE__, -0x0000001L, "-1", "%ld",
+__LINE__, -0x3d785fabL, "-1031298987", "%d",
+__LINE__, -0x0000002L, "-2", "%-0ld",
+__LINE__, 0x0000019cL, "412", "%d",
+__LINE__, -0x0006f54L, "-28500", "%d",
+__LINE__, 0xfffe3524L, "FFFE3524", "% 6.2X",
+__LINE__, -0x128d3c00L, "-311245824", "%2d",
+__LINE__, -0x3be71293L, "-1004999315", "%d",
+__LINE__, 0x0000659dL, "26013", "%d",
+__LINE__, 0x2d947538L, "+764704056", "%+5d",
+__LINE__, 0xffa2a420L, "FFA2A420", "%0X",
+__LINE__, 0x00000001L, "1", "%d",
+__LINE__, 0x04477c14L, "4477c14", "%.6x",
+__LINE__, -0x06e145bL, "-7214171", "%d",
+__LINE__, 0x00009c01L, "39937", "%-.1d",
+__LINE__, 0xffde174bL, "ffde174b", "% 0x",
+__LINE__, 0x0001fbaeL, "1FBAE", "%01.X",
+__LINE__, -0x06b8406L, "-7046150", "%d",
+__LINE__, 0x000005b8L, "005b8", "%05x",
+__LINE__, -0x02d780bL, "-2979851", "%1d",
+__LINE__, 0x00209e26L, "2137638", "%2d",
+__LINE__, 0x0000041aL, "41A", "%0X",
+__LINE__, 0x2a77f42cL, "2A77F42C", "%02X",
+__LINE__, 0x13b6ee14L, "+330755604", "%+0d",
+__LINE__, -0x0000002L, "-2 ", "%-6.d",
+__LINE__, -0x0001eeeL, "-7918", "% #2.ld",
+__LINE__, 0xffffffffL, "FFFFFFFF", "% .5X",
+__LINE__, 0x20d11927L, "20d11927", "% 0.x",
+__LINE__, -0x0018690L, "-99984", "% ld",
+__LINE__, 0x000002a0L, "2A0", "%-0X",
+__LINE__, -0x0000511L, "-1297", "%+d",
+__LINE__, 0x0e782f31L, "242757425", "%-0.ld",
+__LINE__, 0x2ce06da0L, "752905632", "%#0ld",
+__LINE__, 0x00000062L, "62 ", "%-07x",
+__LINE__, -0x015d9d8L, "-1432024", "% 7d",
+__LINE__, 0xc9125ea8L, "c9125ea8", "%x",
+__LINE__, 0x00000006L, "6", "%.0ld",
+__LINE__, 0x0000019cL, "19c", "%x",
+__LINE__, 0x00000000L, " ", "%6.d",
+__LINE__, 0x00043e89L, "278153", "%0ld",
+__LINE__, 0x3e422abdL, "1044523709", "%ld",
+__LINE__, 0x0220a75dL, "35694429", "%#7.6d",
+__LINE__, 0x0000c21cL, "C21C", "% X",
+__LINE__, 0x000074abL, "29867", "%d",
+__LINE__, 0x056b22aaL, "56B22AA", "%+0.X",
+__LINE__, 0xfffffff9L, "FFFFFFF9", "%X",
+__LINE__, 0x00000000L, "0", "%X",
+__LINE__, 0xf094a4f4L, "f094a4f4", "%+4.x",
+__LINE__, -0x1dad0244L, "-497877572", "%d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%.1X",
+__LINE__, 0xfffffe2dL, "fffffe2d", "%7.x",
+__LINE__, 0x0000042bL, "0x42b", "%#x",
+__LINE__, -0x0000001L, "-1", "% d",
+__LINE__, 0x00e77ef5L, " 15171317", "% 7.ld",
+__LINE__, 0x00006210L, " 25104", "% 06d",
+__LINE__, 0x0011187aL, "1120378", "%-ld",
+__LINE__, -0x000000bL, "-11", "% #ld",
+__LINE__, 0x14cfaff0L, "14cfaff0", "%-2.3x",
+__LINE__, 0xffff74eaL, "FFFF74EA", "%3.X",
+__LINE__, 0x000bfb9dL, "bfb9d", "%x",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%X",
+__LINE__, 0x00014500L, "0X14500", "%#4.X",
+__LINE__, -0x0000001L, "-1", "%#1d",
+__LINE__, -0x0000024L, "-36", "%-0d",
+__LINE__, -0x6528828L, "-106072104", "%d",
+__LINE__, 0x00000075L, " 117", "% #d",
+__LINE__, 0xff027d67L, "ff027d67", "%0x",
+__LINE__, 0x0012b8b3L, "12b8b3", "%0.1x",
+__LINE__, 0x1070147bL, "275780731", "%.6ld",
+__LINE__, 0xffffe88eL, "FFFFE88E", "%1.3X",
+__LINE__, 0xfffffc0dL, "fffffc0d", "%00.6x",
+__LINE__, 0xffd889f5L, "ffd889f5", "%x",
+__LINE__, 0x00000470L, "1136", "%0ld",
+__LINE__, 0x000297f8L, "169976", "%ld",
+__LINE__, 0xfffffffeL, "fffffffe", "%+1x",
+__LINE__, 0x0000064aL, "64a", "%x",
+__LINE__, -0x3d71e43bL, "-1030874171", "%1.d",
+__LINE__, -0x0000004L, "-4 ", "%-3.d",
+__LINE__, 0xfffff132L, "FFFFF132", "%0.0X",
+__LINE__, 0x37b6356fL, "37b6356f", "%-x",
+__LINE__, 0xffffff7aL, "FFFFFF7A", "%.0X",
+__LINE__, 0x00023553L, "23553", "%x",
+__LINE__, 0x39a4c29fL, "39a4c29f", "%+5.x",
+__LINE__, 0xffffffccL, "ffffffcc", "%x",
+__LINE__, 0x0003a83bL, "239675", "%#6ld",
+__LINE__, 0x00000002L, "2", "%0x",
+__LINE__, -0x09b4e8cL, "-10178188", "%+03.ld",
+__LINE__, 0x00000002L, "0000002", "%-#.7ld",
+__LINE__, 0x00000b5eL, "2910", "%-04ld",
+__LINE__, -0x0000254L, "-596", "%+0d",
+__LINE__, 0x00000001L, "1", "%+1.x",
+__LINE__, 0xf8290d3eL, "0XF8290D3E", "% #X",
+__LINE__, 0x00000035L, "035", "%3.3X",
+__LINE__, 0x00131d7dL, "131D7D ", "%-7.6X",
+__LINE__, 0xffdbb36aL, "0xffdbb36a", "%#.6x",
+__LINE__, 0xc7275816L, "c7275816", "%04.x",
+__LINE__, 0x00bae994L, "12249492", "%0ld",
+__LINE__, 0x00000002L, "+2", "%+0.0ld",
+__LINE__, 0xffffffffL, "ffffffff", "%0x",
+__LINE__, 0xffffffe0L, "ffffffe0", "%x",
+__LINE__, 0x00000036L, "36", "%.0X",
+__LINE__, 0xfffffffdL, "FFFFFFFD", "%1X",
+__LINE__, 0xffffffc8L, "ffffffc8", "%+x",
+__LINE__, 0xe71c3689L, "e71c3689", "%x",
+__LINE__, 0x00000007L, "7 ", "%-3.ld",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, 0x00030400L, "030400", "%-4.6x",
+__LINE__, 0xbd8c6fa7L, "BD8C6FA7", "%-6X",
+__LINE__, 0x00000233L, "0000563", "%.7ld",
+__LINE__, 0xfef92e35L, "fef92e35", "%x",
+__LINE__, 0xffff2172L, "ffff2172", "%3x",
+__LINE__, 0x00001233L, "1233", "% X",
+__LINE__, -0x000d2e1L, "-53985", "%-0d",
+__LINE__, -0x3ba8cb5bL, "-1000917851", "%0d",
+__LINE__, -0x4fefb9aL, "-83819418", "%5.ld",
+__LINE__, 0xffffe9ebL, "FFFFE9EB", "%X",
+__LINE__, 0x1e472dc3L, "507981251", "%ld",
+__LINE__, -0x0077046L, "-487494", "%0d",
+__LINE__, 0x0002c4c9L, "+181449", "%+7.d",
+__LINE__, 0xfffffe63L, "fffffe63", "%x",
+__LINE__, 0xfff5a6dbL, "FFF5A6DB", "%X",
+__LINE__, 0x00174442L, "174442", "%-5.0X",
+__LINE__, 0x017891d9L, "17891D9", "%+5.X",
+__LINE__, 0x0261966bL, "261966B", "%-X",
+__LINE__, -0x3e58614dL, "-1045979469", "%ld",
+__LINE__, 0x002c4c41L, "+2903105", "%+01ld",
+__LINE__, 0x0000000cL, "012", "%#.3d",
+__LINE__, 0x0380f73aL, "58783546", "%ld",
+__LINE__, 0x000002c7L, "0000711", "%2.7ld",
+__LINE__, 0x00000002L, " 002", "% 04ld",
+__LINE__, 0x00687ca0L, "687CA0", "%X",
+__LINE__, 0x0000058aL, "1418", "%0ld",
+__LINE__, -0x0000642L, "-1602", "% ld",
+__LINE__, 0x0001f4f1L, "1F4F1", "%X",
+__LINE__, 0x0026d6fcL, "+2545404", "%+4.ld",
+__LINE__, 0x05dd423cL, "+98386492", "%+#ld",
+__LINE__, 0x0000782cL, "0782C", "%3.5X",
+__LINE__, 0xf67d91f8L, "f67d91f8", "%-x",
+__LINE__, 0xffffcf2dL, "ffffcf2d", "%+0x",
+__LINE__, -0x00af8a6L, "-719014", "%0ld",
+__LINE__, -0xe606ef9L, "-241200889", "%ld",
+__LINE__, 0xfe9d87f7L, "fe9d87f7", "%+x",
+__LINE__, 0x00000d44L, "d44", "% 1.x",
+__LINE__, 0x008716f5L, "8716f5", "%2x",
+__LINE__, 0x000027d4L, "27D4", "% X",
+__LINE__, 0xfdfd92eaL, "FDFD92EA", "%-.4X",
+__LINE__, 0xfffe764fL, "FFFE764F", "%X",
+__LINE__, 0xff699032L, "ff699032", "%3.x",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%-3X",
+__LINE__, -0x368ba995L, "-915122581", "%+#.6ld",
+__LINE__, 0xffffffffL, "ffffffff", "%0x",
+__LINE__, 0x0000035eL, " 862", "% 1d",
+__LINE__, 0xfe703e67L, "fe703e67", "%07.0x",
+__LINE__, 0xfffffffeL, "fffffffe", "%4.x",
+__LINE__, 0x000e20cfL, "e20cf", "%0x",
+__LINE__, 0x000063b5L, "0X63B5", "%-#X",
+__LINE__, 0xfffffffaL, "fffffffa", "%+2.x",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%2.X",
+__LINE__, 0xfdfd69daL, "FDFD69DA", "%.0X",
+__LINE__, 0x00002f61L, "0x2f61", "%#3.x",
+__LINE__, 0x00000009L, "9", "%x",
+__LINE__, 0xffffff86L, "ffffff86", "%6x",
+__LINE__, 0xffffffe4L, "ffffffe4", "%0x",
+__LINE__, 0x0062e73bL, "+6481723", "%+0ld",
+__LINE__, -0x2b059130L, "-721785136", "%+d",
+__LINE__, -0x0000073L, "-115", "%d",
+__LINE__, 0xf596efcfL, "f596efcf", "%x",
+__LINE__, 0x0002f1cbL, "2F1CB", "%0X",
+__LINE__, -0x0000635L, "-01589", "%.5ld",
+__LINE__, 0xfffa011aL, "FFFA011A", "%0X",
+__LINE__, 0x00000047L, " 47", "%4X",
+__LINE__, 0xfffffbc0L, "FFFFFBC0", "%5.2X",
+__LINE__, 0x00000015L, "15", "% X",
+__LINE__, 0x002a87a6L, "2a87a6", "%.1x",
+__LINE__, -0x000069cL, "-1692", "%+ld",
+__LINE__, 0xfffffffdL, "fffffffd", "%+x",
+__LINE__, 0xfeda51f5L, "FEDA51F5", "%0X",
+__LINE__, 0x001781a4L, "1781a4", "%-0x",
+__LINE__, 0xe77358d4L, "e77358d4", "%+0x",
+__LINE__, 0x00000084L, " 84", "%3.x",
+__LINE__, 0xffff0cb2L, "FFFF0CB2", "%+5.X",
+__LINE__, 0x0009fa17L, "653847", "%0.0ld",
+__LINE__, -0x0000c92L, "-3218", "%d",
+__LINE__, 0x0004ebbbL, "4ebbb", "%x",
+__LINE__, 0x2e72568cL, "+779245196", "%+#ld",
+__LINE__, 0xffae86a7L, "ffae86a7", "%.7x",
+__LINE__, 0xffdf3f04L, "ffdf3f04", "%x",
+__LINE__, 0x000000c7L, "199", "%2.d",
+__LINE__, -0x0004a55L, "-19029", "%ld",
+__LINE__, 0x00564ef9L, "5656313", "%.6ld",
+__LINE__, 0xffffc205L, "ffffc205", "%+.0x",
+__LINE__, -0x135085d0L, "-324044240", "%#.5d",
+__LINE__, 0xfffffffeL, "fffffffe", "%-7x",
+__LINE__, -0x0000003L, "-3", "%.1ld",
+__LINE__, 0xffda9e0bL, "ffda9e0b", "%+0x",
+__LINE__, 0x00000001L, "1", "%d",
+__LINE__, 0xffffffdaL, "ffffffda", "%.6x",
+__LINE__, 0x5efdb3d1L, "+1593684945", "%+0d",
+__LINE__, -0x00000caL, "-202", "% 4.d",
+__LINE__, -0x0014433L, "-82995", "%.3d",
+__LINE__, -0x0000002L, "-000002", "% .6ld",
+__LINE__, 0x24aac879L, "615172217", "%.7d",
+__LINE__, -0x1db3c1dL, "-31144989", "%+#4ld",
+__LINE__, 0x000945adL, "0x945ad", "%#1x",
+__LINE__, 0x0000000aL, "10", "%#.1ld",
+__LINE__, -0x002a2e5L, "-172773", "%d",
+__LINE__, 0xfffffff3L, "FFFFFFF3", "%5X",
+__LINE__, 0x0000000eL, "e", "%+x",
+__LINE__, 0x335333dcL, "861090780", "%6.d",
+__LINE__, 0xfffa16f4L, "FFFA16F4", "%6X",
+__LINE__, 0xffffc727L, "ffffc727", "%+2.x",
+__LINE__, 0x00000273L, "273", "%x",
+__LINE__, -0x000000fL, "-15", "%-0d",
+__LINE__, 0x00065fbdL, "417725", "%5.1d",
+__LINE__, 0x00000ed5L, "3797", "%d",
+__LINE__, 0x30a40024L, "30A40024", "%3.7X",
+__LINE__, 0x00000054L, "84", "%ld",
+__LINE__, 0x00000515L, "01301", "%.5ld",
+__LINE__, 0x00000897L, "+02199", "%+.5d",
+__LINE__, -0x0001bccL, "-7116", "% ld",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%7X",
+__LINE__, 0x00000013L, "0X13", "%#X",
+__LINE__, 0xffffffffL, "0xffffffff", "% #x",
+__LINE__, 0x00000006L, "6", "%ld",
+__LINE__, -0x00000c3L, "-195", "%1.ld",
+__LINE__, -0x005291eL, "-338206", "%+d",
+__LINE__, 0xffb437a7L, "FFB437A7", "%-0X",
+__LINE__, 0xff8335cbL, "ff8335cb", "%x",
+__LINE__, 0x0000006aL, "6A", "%2X",
+__LINE__, -0x004f629L, "-325161", "% .4d",
+__LINE__, 0x003698efL, "3578095", "%0ld",
+__LINE__, 0x6b5cdf3aL, "6b5cdf3a", "%-x",
+__LINE__, 0xe9bc5c21L, "e9bc5c21", "%+x",
+__LINE__, -0x0000001L, " -1", "%+6.ld",
+__LINE__, 0xfffeffc8L, "FFFEFFC8", "%6.X",
+__LINE__, 0xff070a73L, "ff070a73", "%+.7x",
+__LINE__, 0x0023f8aeL, "2357422", "%07.4ld",
+__LINE__, 0x00000000L, "0", "%X",
+__LINE__, 0x00000016L, "16", "%0X",
+__LINE__, -0x000005aL, " -90", "%4d",
+__LINE__, 0x00000116L, "116", "% .3x",
+__LINE__, 0xfffed024L, "fffed024", "%-x",
+__LINE__, 0xfb907950L, "fb907950", "%.0x",
+__LINE__, 0x0101a1e5L, "101a1e5", "%x",
+__LINE__, -0x09e7684L, "-10385028", "%-#ld",
+__LINE__, 0xffffffffL, "ffffffff", "%1x",
+__LINE__, 0xfffffff6L, "fffffff6", "%x",
+__LINE__, 0x00000078L, "78", "%x",
+__LINE__, 0xe6bca9c9L, "0XE6BCA9C9", "%#.5X",
+__LINE__, -0x0000010L, "-16", "%d",
+__LINE__, -0x1348f685L, "-323548805", "%d",
+__LINE__, 0x4dd85797L, "1306023831", "%ld",
+__LINE__, -0x0000080L, "-128", "%.2d",
+__LINE__, -0xaed13a7L, "-183309223", "%+ld",
+__LINE__, -0x000002fL, "-47", "% d",
+__LINE__, -0x679911fL, "-108630303", "%ld",
+__LINE__, 0xfffff221L, "FFFFF221", "% .7X",
+__LINE__, 0x0007476cL, "7476c", "%x",
+__LINE__, 0xffffe02aL, "0xffffe02a", "%#7x",
+__LINE__, 0x00000ebbL, "0XEBB", "%#X",
+__LINE__, 0xffffffffL, "0XFFFFFFFF", "%-#X",
+__LINE__, 0x00281896L, "281896", "%+1.x",
+__LINE__, 0x0000085dL, " 0X85D", "%#6.3X",
+__LINE__, 0x000112bfL, "112BF", "%X",
+__LINE__, 0xf5518fbfL, "F5518FBF", "% X",
+__LINE__, -0x00c945bL, "-824411", "%ld",
+__LINE__, 0x00001b43L, "0x1b43", "%-#x",
+__LINE__, -0x5872a246L, "-1483907654", "%#7.7ld",
+__LINE__, 0x00001f96L, "8086", "%#d",
+__LINE__, 0xfffffff9L, "FFFFFFF9", "%X",
+__LINE__, -0x006e244L, "-451140", "% .3d",
+__LINE__, -0x0382188L, "-3678600", "%0.2ld",
+__LINE__, 0x00000006L, "6", "%-x",
+__LINE__, 0x00000036L, "54 ", "%-5.d",
+__LINE__, -0x0000439L, " -1081", "%#6.3ld",
+__LINE__, 0xfff911c6L, "FFF911C6", "%X",
+__LINE__, -0x03454dcL, "-3429596", "%d",
+__LINE__, -0x0363e8dL, "-3554957", "%-.2ld",
+__LINE__, 0x00000000L, "000", "%.3X",
+__LINE__, -0x59bb030fL, "-1505428239", "%0ld",
+__LINE__, 0x073c94d8L, "121410776", "%-d",
+__LINE__, -0x001ef94L, "-126868", "%5.1ld",
+__LINE__, 0xfff65fc5L, "FFF65FC5", "%0X",
+__LINE__, 0xfffffff4L, "fffffff4", "%-x",
+__LINE__, 0x00001d83L, "07555", "%5.5d",
+__LINE__, 0x0012b40aL, "1225738", "%ld",
+__LINE__, -0x0000006L, "-6", "%0ld",
+__LINE__, 0xfffffffcL, "fffffffc", "%06.0x",
+__LINE__, -0x0000002L, "-00002", "%#.5ld",
+__LINE__, 0xf9932c1dL, "f9932c1d", "%-x",
+__LINE__, -0x46a31d9L, "-74068441", "%.3ld",
+__LINE__, 0x000987e9L, "987E9", "%1X",
+__LINE__, 0x0000000fL, "15", "%-ld",
+__LINE__, -0x0001c4dL, "-7245", "%ld",
+__LINE__, -0x007deeeL, "-515822", "%2.6d",
+__LINE__, 0xffffffa2L, "FFFFFFA2", "%.6X",
+__LINE__, 0x00000001L, "1", "%-ld",
+__LINE__, 0xfc106bdeL, "fc106bde", "%.4x",
+__LINE__, 0x0002f1f8L, "0x2f1f8", "%#7.x",
+__LINE__, -0x06a290bL, "-6957323", "%-ld",
+__LINE__, -0x0000037L, " -55", "%4ld",
+__LINE__, 0x0000152eL, "5422", "%2.d",
+__LINE__, 0xfffffcb2L, "0XFFFFFCB2", "%#3.X",
+__LINE__, 0x1b7ca086L, "1b7ca086", "%+x",
+__LINE__, 0x00000001L, "1", "%ld",
+__LINE__, 0x006775fcL, "6775fc", "%3.2x",
+__LINE__, 0x0000000eL, "0XE", "%#3.X",
+__LINE__, 0xffffffffL, "0xffffffff", "%+#4.x",
+__LINE__, 0x00001246L, "1246", "%X",
+__LINE__, 0xffffaed6L, "ffffaed6", "%2x",
+__LINE__, -0x3a2dec78L, "-976088184", "% 0ld",
+__LINE__, 0x0001423bL, "1423b", "%01x",
+__LINE__, 0x00000007L, " 0X7", "%#4.X",
+__LINE__, 0x01a7ff5aL, "27787098", "%.4ld",
+__LINE__, -0x0020d05L, "-134405", "%-d",
+__LINE__, 0xffffff9aL, "ffffff9a", "%-.1x",
+__LINE__, 0xffff3557L, "ffff3557", "%x",
+__LINE__, 0x08828e35L, "8828e35", "%+.1x",
+__LINE__, 0x000006b2L, "001714", "%04.6ld",
+__LINE__, 0x00000013L, "19", "%.0ld",
+__LINE__, -0x00341a5L, "-213413", "%#d",
+__LINE__, -0x0000043L, "-67", "%d",
+__LINE__, -0x074dce3L, "-7658723", "%.1d",
+__LINE__, -0x16de2df3L, "-383659507", "% ld",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0x00000ce7L, "ce7", "% 2.1x",
+__LINE__, 0xffecd377L, "ffecd377", "% 0x",
+__LINE__, 0xa4e8465cL, "a4e8465c", "% x",
+__LINE__, 0x000005e8L, "1512", "%d",
+__LINE__, 0x00000513L, "1299", "%d",
+__LINE__, 0xffffffb8L, "FFFFFFB8", "%X",
+__LINE__, 0x00000003L, "00003", "%3.5x",
+__LINE__, -0x0000003L, "-3 ", "%-3.ld",
+__LINE__, 0xad53f01dL, "ad53f01d", "%0x",
+__LINE__, 0x0f1c1daeL, "253500846", "%-#.0d",
+__LINE__, 0xff1753c0L, "0xff1753c0", "%#3.x",
+__LINE__, -0x00389c5L, "-231877", "%d",
+__LINE__, 0x0000016eL, "00016E", "%.6X",
+__LINE__, -0x54d3310fL, "-1423126799", "%-d",
+__LINE__, 0x00000005L, "0X5", "%#.1X",
+__LINE__, 0xfffffffdL, "0XFFFFFFFD", "%#5.3X",
+__LINE__, 0xfffffe0eL, "fffffe0e", "%-x",
+__LINE__, 0xa3c02157L, "a3c02157", "%.5x",
+__LINE__, 0x00005765L, "22373", "%d",
+__LINE__, -0x12668cdL, "-19294413", "%+ld",
+__LINE__, -0x66544daL, "-107300058", "%2d",
+__LINE__, 0x8646c605L, "0X8646C605", "% #X",
+__LINE__, 0x000001f5L, "1F5", "%X",
+__LINE__, 0x01b33ae4L, "28523236", "%5ld",
+__LINE__, 0x000007ceL, "7ce", "%3.x",
+__LINE__, 0x00000355L, "355", "%X",
+__LINE__, 0x000001ceL, "1CE", "% X",
+__LINE__, 0xfffffccdL, "fffffccd", "%7.0x",
+__LINE__, -0x0000001L, "-1", "%0ld",
+__LINE__, 0x000640b6L, "640b6", "%5.x",
+__LINE__, 0x0038c4ecL, "3720428", "%5.4d",
+__LINE__, -0x0f10b5eL, "-15797086", "%2ld",
+__LINE__, 0x256c815fL, "256c815f", "%4.x",
+__LINE__, 0x00000682L, " 1666", "%6ld",
+__LINE__, -0x00000abL, "-171", "%2ld",
+__LINE__, 0x00000003L, "3", "%0d",
+__LINE__, 0x063f5075L, "63F5075", "%X",
+__LINE__, 0xff83b5d0L, "FF83B5D0", "%7.X",
+__LINE__, 0xffffffecL, "ffffffec", "%x",
+__LINE__, 0xffb551c4L, "0XFFB551C4", "% #4.X",
+__LINE__, -0x071f057L, "-7467095", "%3.7d",
+__LINE__, 0x00634879L, "6506617", "%#ld",
+__LINE__, 0x000001d7L, "471", "%d",
+__LINE__, 0x00a7da92L, "A7DA92", "% .4X",
+__LINE__, 0x00000003L, "3 ", "%-2.ld",
+__LINE__, -0x0000004L, "-0004", "%.4d",
+__LINE__, -0x01dea32L, "-1960498", "% #7.d",
+__LINE__, 0x53c4159fL, "53C4159F", "%1.7X",
+__LINE__, -0x1ad7904L, "-28145924", "%#d",
+__LINE__, -0x0000a85L, "-2693", "%ld",
+__LINE__, -0x0000c7dL, "-3197", "%d",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%+0X",
+__LINE__, 0x00000004L, "00004", "%1.5d",
+__LINE__, 0x0000b761L, "46945", "%5ld",
+__LINE__, -0x0ee3b2cL, "-15612716", "%.6d",
+__LINE__, 0x0677a73dL, "677a73d", "% x",
+__LINE__, -0x5f96020L, "-100229152", "% d",
+__LINE__, 0x00000000L, " 0", "%#7X",
+__LINE__, -0x5d1cb5bL, "-97635163", "% ld",
+__LINE__, -0x00a8d8bL, "-691595", "%-0ld",
+__LINE__, 0xffffffa2L, "FFFFFFA2", "%X",
+__LINE__, 0xffffffc9L, "FFFFFFC9", "%X",
+__LINE__, 0x0b180d35L, "B180D35", "%X",
+__LINE__, 0xfc0b94ceL, "fc0b94ce", "%.1x",
+__LINE__, 0x0012cd7bL, "12CD7B", "% X",
+__LINE__, -0x02f1da8L, "-3087784", "%ld",
+__LINE__, -0x000a6f9L, "-42745", "%-ld",
+__LINE__, -0x000006dL, "-109 ", "%-6d",
+__LINE__, 0x00000001L, "+1", "%+0d",
+__LINE__, 0x00000001L, "1", "%1d",
+__LINE__, 0xfffffff8L, "fffffff8", "%5.x",
+__LINE__, -0x00fc4d7L, "-1033431", "%+0.5ld",
+__LINE__, 0xffff41b4L, "0xffff41b4", "%#x",
+__LINE__, -0x0000d37L, "-3383", "%ld",
+__LINE__, 0xffc4e405L, "ffc4e405", "%7x",
+__LINE__, 0xffffffb0L, "FFFFFFB0", "%04X",
+__LINE__, -0x0054477L, "-345207", "%01.ld",
+__LINE__, 0x00512778L, "0x512778", "%#3.0x",
+__LINE__, 0x00000007L, " 7", "%7.d",
+__LINE__, 0x00000008L, " 00008", "% .5ld",
+__LINE__, 0x000053fdL, "21501", "%.4ld",
+__LINE__, 0x0000370cL, "370c", "%2x",
+__LINE__, -0x44670a7L, "-71725223", "%3d",
+__LINE__, 0x00000064L, " 64", "%+5x",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%X",
+__LINE__, 0xf7bbf094L, "f7bbf094", "%3x",
+__LINE__, 0xfffeb268L, "FFFEB268", "%X",
+__LINE__, 0x00001ef0L, "1ef0", "%4.x",
+__LINE__, 0x05ad9aa4L, " 95263396", "% 0.ld",
+__LINE__, 0xf294dca7L, "F294DCA7", "% 4.X",
+__LINE__, -0x0000003L, "-000003", "%.6d",
+__LINE__, 0xfff57471L, "fff57471", "% x",
+__LINE__, 0x0a848cfdL, "176459005", "%d",
+__LINE__, -0x000002eL, "-46", "%.0d",
+__LINE__, 0x00000051L, " +81", "%+5d",
+__LINE__, -0x000072bL, "-0001835", "%06.7d",
+__LINE__, -0x0000002L, " -2", "%+#6ld",
+__LINE__, 0x00000003L, "3", "%x",
+__LINE__, 0xfffd1799L, "FFFD1799", "%6.X",
+__LINE__, 0x00000005L, "5", "%ld",
+__LINE__, 0x0052138bL, "5378955", "%#7.7ld",
+__LINE__, 0x000000c0L, " 192", "% 7ld",
+__LINE__, 0x005b26cdL, "5B26CD", "%X",
+__LINE__, -0x008df17L, "-581399", "%.4ld",
+__LINE__, 0xfffffad8L, "fffffad8", "%-x",
+__LINE__, 0x000006a9L, "6a9", "%.0x",
+__LINE__, -0x003b7f9L, "-243705", "%+0ld",
+__LINE__, 0x005d7ea4L, "6127268", "%ld",
+__LINE__, -0x003cceaL, "-249066", "%+.0ld",
+__LINE__, 0x0000846fL, "846F", "%X",
+__LINE__, 0x00004f79L, "4F79", "%4.X",
+__LINE__, 0xe3e1409cL, "E3E1409C", "%-X",
+__LINE__, 0x07cce2f4L, "7CCE2F4", "%2.X",
+__LINE__, 0x004bcc8bL, "4967563", "%-.5ld",
+__LINE__, 0x7d49665eL, "2101962334", "%ld",
+__LINE__, 0xfffffffcL, "FFFFFFFC", "%.5X",
+__LINE__, 0x0000019eL, "+000414", "%+.6d",
+__LINE__, 0x000027efL, "10223", "%d",
+__LINE__, -0x0000261L, "-609", "%3ld",
+__LINE__, -0x000000eL, "-14", "% 2.ld",
+__LINE__, 0xff3ba3c7L, "ff3ba3c7", "%+5.7x",
+__LINE__, 0xffffffc4L, "FFFFFFC4", "%-1.X",
+__LINE__, 0xfffc5a70L, "0xfffc5a70", "%#4.4x",
+__LINE__, 0x0000d156L, " 53590", "% d",
+__LINE__, -0x0486258L, "-4743768", "%0ld",
+__LINE__, 0x00000000L, " ", "% 2.d",
+__LINE__, 0x04a0ef9fL, "77655967", "%0.6ld",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%X",
+__LINE__, 0x00000019L, "0000019", "%.7x",
+__LINE__, -0x0058d3aL, "-363834", "%ld",
+__LINE__, 0xfffff6b3L, "fffff6b3", "%x",
+__LINE__, 0xfffffff5L, "FFFFFFF5", "%.0X",
+__LINE__, 0x005e1fcbL, "5E1FCB", "%+6X",
+__LINE__, 0xffc3c866L, "0xffc3c866", "%-#.4x",
+__LINE__, 0x00000003L, "3", "%X",
+__LINE__, 0xffa2e961L, "FFA2E961", "%7.4X",
+__LINE__, 0x00000029L, "41", "%d",
+__LINE__, -0x0000035L, "-53", "%d",
+__LINE__, 0x0001b033L, "110643", "%ld",
+__LINE__, 0x004dd51bL, "5100827", "%-2ld",
+__LINE__, -0x000252dL, "-9517", "% d",
+__LINE__, 0xffffdeb2L, "ffffdeb2", "%4.x",
+__LINE__, 0xffe94eabL, "0xffe94eab", "%#x",
+__LINE__, 0xf921edf6L, "f921edf6", "%4.2x",
+__LINE__, 0x0007df97L, "515991", "%4.ld",
+__LINE__, 0x00709bc5L, "709BC5", "%0X",
+__LINE__, -0x0000001L, "-1", "%d",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "%7.3X",
+__LINE__, -0x0063f74L, "-409460", "%+05.0d",
+__LINE__, 0xfffffe9aL, "FFFFFE9A", "%.2X",
+__LINE__, -0x0001ce2L, "-7394", "%.4d",
+__LINE__, 0x000038c5L, "14533", "%ld",
+__LINE__, 0x000000adL, "000ad", "% 5.5x",
+__LINE__, 0xffffbcc4L, "ffffbcc4", "%-5x",
+__LINE__, 0x00000000L, "0", "% X",
+__LINE__, 0x00372877L, "372877", "%.6X",
+__LINE__, 0xffffffd7L, "FFFFFFD7", "%1.X",
+__LINE__, 0xfa58b14bL, "fa58b14b", "%x",
+__LINE__, 0xfffffd9fL, "FFFFFD9F", "%0.7X",
+__LINE__, 0x00000710L, "+1808", "%+#.2ld",
+__LINE__, 0x00000006L, " 6", "%5.0ld",
+__LINE__, 0x0fba9706L, "263886598", "%-6.3d",
+__LINE__, 0xffff420aL, "ffff420a", "%-2x",
+__LINE__, 0x14b9a825L, "14b9a825", "%x",
+__LINE__, 0x0077ffe4L, "77FFE4", "%+.2X",
+__LINE__, 0x00067108L, "422152 ", "%-7.ld",
+__LINE__, 0x00000001L, " 00001", "%6.5X",
+__LINE__, 0x00000000L, "0", "%ld",
+__LINE__, -0x0000001L, " -1", "% 7ld",
+__LINE__, 0x01ddc7a3L, "31311779", "%d",
+__LINE__, -0x2a92f9bL, "-44642203", "% 3ld",
+__LINE__, 0xfffffff9L, "fffffff9", "%4.6x",
+__LINE__, 0x0279a274L, "279a274", "%x",
+__LINE__, 0x2e37ed8eL, "775417230", "%d",
+__LINE__, 0x5ba59f58L, "1537580888", "%-ld",
+__LINE__, 0xffffffe0L, "ffffffe0", "%x",
+__LINE__, 0x3110ae47L, "0X3110AE47", "%+#X",
+__LINE__, 0x000e00b9L, "917689", "%d",
+__LINE__, 0x0000002eL, " 0046", "% 7.4d",
+__LINE__, 0x00000363L, " 867", "%7.d",
+__LINE__, -0x000000bL, "-0011", "% 0.4d",
+__LINE__, 0x000349c8L, " 349C8", "% 7.X",
+__LINE__, -0x01358f1L, "-1267953", "%d",
+__LINE__, -0x0039d3cL, "-236860", "%-.3d",
+__LINE__, 0xffd6de19L, "ffd6de19", "%04.0x",
+__LINE__, -0x0003c54L, "-0015444", "%1.7d",
+__LINE__, -0x0000e17L, "-3607", "%d",
+__LINE__, 0xff0fa3a9L, "ff0fa3a9", "%+3x",
+__LINE__, 0x00000009L, "0000009", "%1.7x",
+__LINE__, 0xfffffc81L, "FFFFFC81", "% X",
+__LINE__, -0x4ef2df5L, "-82783733", "%ld",
+__LINE__, 0x00000013L, "19", "%-ld",
+__LINE__, 0x00000000L, " 0", "%#7x",
+__LINE__, -0x3b9485fdL, "-999589373", "%1.d",
+__LINE__, -0x0000006L, "-00006", "%6.5d",
+__LINE__, 0x0000003fL, "+63", "%+ld",
+__LINE__, 0x000004c5L, "1221", "%1.d",
+__LINE__, 0x003f8a8cL, "4164236", "%d",
+__LINE__, -0x000001eL, "-30", "%-#3d",
+__LINE__, 0xfff9d230L, "FFF9D230", "%+07.3X",
+__LINE__, 0x0147cf17L, "147cf17", "% x",
+__LINE__, 0xffffffebL, "ffffffeb", "%x",
+__LINE__, 0x0000007dL, "00125", "%.5ld",
+__LINE__, 0x000fff56L, "1048406", "%#3d",
+__LINE__, 0x064307a0L, " 105056160", "% 0.3ld",
+__LINE__, 0x007d2860L, "8202336", "%-.2d",
+__LINE__, 0x00a05711L, "a05711", "%x",
+__LINE__, 0x179a7f9eL, "0x179a7f9e", "%+#.3x",
+__LINE__, 0x00000003L, "3", "%X",
+__LINE__, -0x0001d7dL, "-7549", "%#5d",
+__LINE__, 0x0025d3f2L, "+2479090", "%+2.d",
+__LINE__, -0x0000001L, "-1", "%#ld",
+__LINE__, 0xfffffdd5L, "fffffdd5", "%.7x",
+__LINE__, 0x003462b9L, "3433145", "%d",
+__LINE__, 0x00005a81L, "23169", "%d",
+__LINE__, 0xfffffcdbL, "fffffcdb", "%-x",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, 0xfff22085L, "fff22085", "%x",
+__LINE__, 0x00016d72L, " 93554", "% d",
+__LINE__, -0x0000002L, "-2", "%0ld",
+__LINE__, 0xfffffd21L, "fffffd21", "% 0x",
+__LINE__, 0x00000931L, "2353", "%ld",
+__LINE__, 0x00010021L, "10021", "%5.1X",
+__LINE__, -0x000007eL, "-126", "%1.0ld",
+__LINE__, 0xfffffff8L, "fffffff8", "%01.x",
+__LINE__, -0x001d148L, "-119112", "%d",
+__LINE__, -0x0000008L, "-8", "%ld",
+__LINE__, -0x000038eL, "-910", "% ld",
+__LINE__, 0x0039e3e5L, "3793893", "%0.1d",
+__LINE__, 0x0038fb8eL, "38FB8E", "%.2X",
+__LINE__, -0x002dafaL, "-187130", "%ld",
+__LINE__, -0xbec275bL, "-200025947", "%ld",
+__LINE__, 0x1a32f999L, "1A32F999", "%05.4X",
+__LINE__, 0x0000002fL, "2f", "%x",
+__LINE__, -0x0001a5bL, "-6747", "%+3.ld",
+__LINE__, 0x00000762L, " 1890", "%7.ld",
+__LINE__, 0x000000c2L, "000194", "%0.6ld",
+__LINE__, 0xffff002bL, "FFFF002B", "%.4X",
+__LINE__, -0x0019daeL, "-105902", "% .2d",
+__LINE__, 0x0000125fL, "125f", "%+1x",
+__LINE__, -0x000b688L, " -46728", "%#7.d",
+__LINE__, 0x000401caL, "401ca", "%0x",
+__LINE__, 0x00000192L, "402", "%#ld",
+__LINE__, 0xffffffffL, "ffffffff", "%x",
+__LINE__, 0x1e505a0cL, "0X1E505A0C", "%#1.3X",
+__LINE__, 0x000f8f6cL, "1019756", "%d",
+__LINE__, 0x0004a296L, "4a296", "%5.2x",
+__LINE__, 0x00000003L, "3", "% x",
+__LINE__, -0x000d44cL, "-54348", "%#ld",
+__LINE__, 0x00009ae2L, "39650", "%-d",
+__LINE__, 0xffffff3aL, "FFFFFF3A", "% .7X",
+__LINE__, 0x0042350bL, "4338955", "%d",
+__LINE__, 0x000071afL, "71af", "%+.4x",
+__LINE__, 0x00000001L, "0x1", "%#0x",
+__LINE__, 0x00000033L, "00051", "%3.5d",
+__LINE__, 0x00000001L, "1", "%X",
+__LINE__, -0xebfb0e7L, "-247443687", "%+3ld",
+__LINE__, 0x00000027L, "27 ", "%-07.X",
+__LINE__, -0x0004837L, "-18487", "%01d",
+__LINE__, 0x1a8c53daL, "1A8C53DA", "%X",
+__LINE__, -0x0bdb8a9L, "-12433577", "%d",
+__LINE__, -0x0000098L, "-152", "%#ld",
+__LINE__, -0x003b554L, "-243028", "%d",
+__LINE__, 0x000000cbL, "00000CB", "%+.7X",
+__LINE__, 0xfffffedaL, "FFFFFEDA", "%X",
+__LINE__, -0x0000010L, "-16", "%-#d",
+__LINE__, 0x00000006L, "+6", "%+d",
+__LINE__, 0x003c294aL, "+3942730", "%+4.ld",
+__LINE__, 0x00000009L, "9", "%ld",
+__LINE__, 0xfbbdd2bcL, "FBBDD2BC", "% X",
+__LINE__, 0x71c86678L, "+1908958840", "%+0.6ld",
+__LINE__, -0x0b49bffL, "-11836415", "% 6.ld",
+__LINE__, 0xfff416beL, "fff416be", "%3.x",
+__LINE__, 0x00000077L, "+119", "%+d",
+__LINE__, 0xfff1cfaaL, "FFF1CFAA", "% 0.2X",
+__LINE__, 0xfffffffbL, "fffffffb", "% x",
+__LINE__, 0x0000127eL, "4734", "%d",
+__LINE__, 0x00107ad2L, "107ad2", "%+2.6x",
+__LINE__, 0x0006b8e9L, "440553", "%-#d",
+__LINE__, 0x0000eb6fL, "eb6f", "% x",
+__LINE__, 0x00001f18L, "7960", "%0d",
+__LINE__, 0xfffff225L, "fffff225", "%1.5x",
+__LINE__, 0xfffffff9L, "fffffff9", "%+6.x",
+__LINE__, 0x000005b9L, "01465", "%.5ld",
+__LINE__, 0xfffc26b8L, "FFFC26B8", "% X",
+__LINE__, 0x540d580dL, "0X540D580D", "%+#X",
+__LINE__, 0x05ad7094L, "5AD7094", "% 4.7X",
+__LINE__, -0x000019bL, "-411", "% d",
+__LINE__, 0x00000006L, "000006", "%6.6ld",
+__LINE__, 0x0000026aL, "+618", "%+ld",
+__LINE__, 0x0000000bL, "11", "%ld",
+__LINE__, -0x26985d5L, "-40469973", "%#.0ld",
+__LINE__, 0x0000007dL, "7D", "%+02.0X",
+__LINE__, -0x0079ddfL, "-0499167", "%+.7ld",
+__LINE__, 0x0000375fL, "14175", "%0d",
+__LINE__, -0x18de7f99L, "-417234841", "%ld",
+__LINE__, -0x00507ccL, "-329676", "%.0d",
+__LINE__, 0x000029d5L, "29D5", "%-2.1X",
+__LINE__, 0x0000328cL, "328C", "%-3.X",
+__LINE__, 0x016f6234L, "24076852", "%3.ld",
+__LINE__, 0xfffffffcL, "0XFFFFFFFC", "%#.5X",
+__LINE__, 0xfe6163caL, "FE6163CA", "%5.X",
+__LINE__, 0xffffffc2L, "FFFFFFC2", "%X",
+__LINE__, 0x00000087L, "+135", "%+ld",
+__LINE__, 0x00310166L, "310166", "% x",
+__LINE__, 0x00e8c871L, "15255665", "%d",
+__LINE__, 0x000005eeL, "1518", "%ld",
+__LINE__, 0xfcb24306L, "FCB24306", "%X",
+__LINE__, 0x0000000bL, " 11", "%5ld",
+__LINE__, 0x006d11d0L, "0x6d11d0", "%#.0x",
+__LINE__, 0x0010d416L, "1102870", "%#6.5d",
+__LINE__, -0x0047cb3L, "-294067", "%.3d",
+__LINE__, 0x000000c0L, "c0", "%x",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%+X",
+__LINE__, -0x000000aL, "-10", "%d",
+__LINE__, -0x0000007L, "-7", "% ld",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "%-X",
+__LINE__, 0x00000014L, "0x14", "%-#3.1x",
+__LINE__, 0x00003319L, "3319", "% x",
+__LINE__, 0x00000000L, "00", "%+#.2X",
+__LINE__, -0x0000009L, "-9", "% ld",
+__LINE__, -0x0000001L, "-1 ", "%-3ld",
+__LINE__, 0x00262909L, "2500873", "%.5ld",
+__LINE__, 0x33e76560L, "33e76560", "%7.0x",
+__LINE__, -0x0000002L, "-2", "%ld",
+__LINE__, 0x00035ee9L, "35EE9", "%-3.X",
+__LINE__, -0x0000235L, "-565", "%+4.ld",
+__LINE__, -0x3ea63c5L, "-65692613", "%d",
+__LINE__, 0x00000003L, "3", "%ld",
+__LINE__, -0x003362fL, "-210479", "% d",
+__LINE__, -0x1a819f8aL, "-444702602", "%.7d",
+__LINE__, 0x027a4668L, "41567848", "%d",
+__LINE__, 0x0002b025L, "2b025", "%x",
+__LINE__, -0x0000001L, "-001", "%.3ld",
+__LINE__, 0xfffffff0L, "fffffff0", "%-0x",
+__LINE__, -0x0000d4fL, "-3407", "%-ld",
+__LINE__, 0x00000146L, " 326", "% 1.d",
+__LINE__, -0x0000006L, "-6", "%d",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%06.4X",
+__LINE__, 0x376fddaeL, "+930078126", "%+#0ld",
+__LINE__, 0x006d9da3L, "6d9da3", "%1.x",
+__LINE__, -0x0000f28L, "-3880", "%3.2ld",
+__LINE__, 0x0006962cL, " 431660", "% 5d",
+__LINE__, 0x000011dbL, " 4571", "%6.ld",
+__LINE__, 0xffffffa8L, "ffffffa8", "%+x",
+__LINE__, 0x0d886db3L, "D886DB3", "%.7X",
+__LINE__, 0x00000000L, "000000", "%2.6ld",
+__LINE__, 0xfffff6b6L, "FFFFF6B6", "% X",
+__LINE__, -0x0739068L, "-7573608", "%+6.ld",
+__LINE__, 0xfba62553L, "0XFBA62553", "%#X",
+__LINE__, -0x4474bc5L, "-71781317", "%-2ld",
+__LINE__, 0xffffff95L, "FFFFFF95", "% 2.X",
+__LINE__, -0x1d0e1caL, "-30466506", "%+.0d",
+__LINE__, -0x000f3aaL, "-62378", "%ld",
+__LINE__, 0x00000026L, "26", "%1x",
+__LINE__, 0x001c5400L, "1856512", "%-#d",
+__LINE__, 0x03808442L, "3808442", "%X",
+__LINE__, -0x0000081L, "-129", "%+#ld",
+__LINE__, 0x000004aeL, " 1198", "% 3.4d",
+__LINE__, -0x7f4ed54L, "-133492052", "%d",
+__LINE__, 0x00000000L, "+0", "%+ld",
+__LINE__, 0x00000000L, "0", "%+x",
+__LINE__, 0x004c7e46L, "5013062", "%.0d",
+__LINE__, -0x647d7a65L, "-1685944933", "%0.2d",
+__LINE__, 0x00003b59L, "15193", "%-#1d",
+__LINE__, 0xfff3e64dL, "FFF3E64D", "%-X",
+__LINE__, 0x00007022L, "28706", "%-d",
+__LINE__, 0xc28d0ad8L, "c28d0ad8", "%+x",
+__LINE__, -0x005c208L, "-377352", "% ld",
+__LINE__, 0x00cfbadcL, "13613788", "%d",
+__LINE__, 0x000016eaL, "5866", "%0d",
+__LINE__, 0x00000029L, "29", "%X",
+__LINE__, 0xffe16813L, "0XFFE16813", "%+#X",
+__LINE__, 0x00000004L, "4", "%0X",
+__LINE__, -0x0000096L, " -150", "%5d",
+__LINE__, 0x00027ac7L, "162503", "%ld",
+__LINE__, -0x0075de0L, "-482784", "%d",
+__LINE__, 0x005fcff6L, "6279158", "%d",
+__LINE__, 0xffffffefL, "FFFFFFEF", "%3X",
+__LINE__, 0x267b05ecL, "645596652", "%4ld",
+__LINE__, 0xa487b724L, "a487b724", "%x",
+__LINE__, 0x01da2a11L, "31074833", "%-.0ld",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%X",
+__LINE__, 0x0000037aL, "37a", "%x",
+__LINE__, 0x003d0314L, "+3998484", "%+#1d",
+__LINE__, 0x0000011bL, " 283", "%5.2d",
+__LINE__, 0x094f6066L, "94f6066", "%x",
+__LINE__, 0x00000004L, "4", "%X",
+__LINE__, -0x102e14bdL, "-271455421", "% 7.ld",
+__LINE__, 0x000048daL, "0018650", "%07ld",
+__LINE__, -0x24ae0390L, "-615383952", "%0.6d",
+__LINE__, 0xffff5159L, "0XFFFF5159", "%#0X",
+__LINE__, 0xfffd38c3L, "fffd38c3", "%x",
+__LINE__, 0xfffff9eaL, "FFFFF9EA", "%-X",
+__LINE__, -0x000fd28L, "-64808", "% ld",
+__LINE__, 0x002c1bf4L, "2890740", "%-.1d",
+__LINE__, 0x00d00ee7L, "D00EE7", "%0.4X",
+__LINE__, 0x00000cf9L, "3321", "%0d",
+__LINE__, -0x0000001L, "-1", "%-#ld",
+__LINE__, 0xfffffd75L, "FFFFFD75", "%.2X",
+__LINE__, 0x00000012L, "18", "%-d",
+__LINE__, 0xfd44b4b2L, "fd44b4b2", "%+5.x",
+__LINE__, -0x001c53fL, "-116031", "%-#6.d",
+__LINE__, 0x000ff6fdL, "ff6fd", "%2x",
+__LINE__, 0x00000001L, "1", "%0d",
+__LINE__, 0x0120b478L, "120B478", "%.7X",
+__LINE__, 0x0145591eL, "145591E", "%1.4X",
+__LINE__, 0x001f99b9L, "1F99B9", "%.1X",
+__LINE__, 0xffffd078L, "ffffd078", "%-1.5x",
+__LINE__, 0xffffff1aL, "FFFFFF1A", "%-4.6X",
+__LINE__, 0xfffffffaL, "fffffffa", "%x",
+__LINE__, -0x00000b9L, "-185", "%3ld",
+__LINE__, 0x00001cf0L, "7408", "%-ld",
+__LINE__, 0xffffffffL, "FFFFFFFF", "%X",
+__LINE__, 0x00151f30L, "151F30", "%X",
+__LINE__, -0x0000103L, "-259", "%d",
+__LINE__, -0x000303fL, "-12351", "%d",
+__LINE__, 0x000002caL, "714", "%ld",
+__LINE__, -0x0000c55L, "-3157", "%1d",
+__LINE__, 0x00000691L, "01681", "%#.5ld",
+__LINE__, 0x00230537L, "2295095", "%#d",
+__LINE__, 0x032a1faaL, "53092266", "%.4d",
+__LINE__, 0x000050d7L, "20695", "%d",
+__LINE__, -0x0c7ad4cL, "-13086028", "%#.4ld",
+__LINE__, -0x00009d9L, "-2521", "%+d",
+__LINE__, 0xfffffffeL, "fffffffe", "%0x",
+__LINE__, 0xffdec2d9L, "FFDEC2D9", "%5.1X",
+__LINE__, -0x000563cL, "-22076", "%-.2ld",
+__LINE__, 0x0073b36aL, "0x73b36a", "%-#x",
+__LINE__, 0xfffffffdL, "fffffffd", "%x",
+__LINE__, 0x0193ba5aL, "193ba5a", "%1.x",
+__LINE__, 0x00d147b5L, "13715381", "%2.d",
+__LINE__, 0xffffff10L, "ffffff10", "%4x",
+__LINE__, 0x000648d5L, "648d5", "%1.3x",
+__LINE__, 0x00000011L, "11", "%X",
+__LINE__, 0xff259f5bL, "0xff259f5b", "% #.1x",
+__LINE__, 0x00000175L, "175", "%x",
+__LINE__, 0x00000000L, "0", "%ld",
+__LINE__, 0x00000015L, "21", "%#ld",
+__LINE__, 0xfffffffeL, "fffffffe", "%-x",
+__LINE__, 0x00000013L, " 19", "% 0ld",
+__LINE__, -0x0000001L, "-0000001", "% 5.7ld",
+__LINE__, 0x0000139dL, "139D", "%X",
+__LINE__, 0x0041ad18L, "41ad18", "%-.6x",
+__LINE__, -0x00000f9L, "-249", "% 3.d",
+__LINE__, 0x00000076L, "118", "%ld",
+__LINE__, 0x000006f8L, "1784", "%d",
+__LINE__, -0x0000005L, "-5", "%ld",
+__LINE__, -0x00008e7L, "-2279", "%+ld",
+__LINE__, 0x00003f77L, "3F77", "%+0X",
+__LINE__, 0x000ca3f8L, "0XCA3F8", "%+#X",
+__LINE__, -0x00004bfL, "-001215", "%#5.6ld",
+__LINE__, 0x319129abL, "0x319129ab", "%+#x",
+__LINE__, -0x0000002L, "-2", "%ld",
+__LINE__, -0x0f6686eL, "-16148590", "%.6ld",
+__LINE__, 0x0329576bL, "53041003", "%2.d",
+__LINE__, -0x000179eL, "-6046", "%d",
+__LINE__, 0x000002ccL, "+716", "%+1.3ld",
+__LINE__, 0xfffffff7L, "0xfffffff7", "% #x",
+__LINE__, 0x0016eb40L, "1502016", "%ld",
+__LINE__, 0x00000003L, "3", "%-0ld",
+__LINE__, 0x0023e0d6L, "23E0D6", "%-05.X",
+__LINE__, 0xffffa6a4L, "0XFFFFA6A4", "%#X",
+__LINE__, 0x00087664L, "87664", "% .2x",
+__LINE__, -0x0000002L, " -2", "%3.ld",
+__LINE__, 0x003ad85dL, "3AD85D", "%X",
+__LINE__, 0x00002f20L, "12064", "%ld",
+__LINE__, 0x02030bfcL, "2030BFC", "%02.3X",
+__LINE__, 0xfffff36aL, "FFFFF36A", "%X",
+__LINE__, 0xfe0729ffL, "0xfe0729ff", "% #.0x",
+__LINE__, 0xfec15164L, "FEC15164", "%0.2X",
+__LINE__, -0x00169ecL, "-92652", "%+d",
+__LINE__, 0x006d7990L, "0x6d7990", "%#x",
+__LINE__, 0xffcc89e6L, "ffcc89e6", "%x",
+__LINE__, 0x002d7ccaL, "2981066", "%7.7ld",
+__LINE__, -0x1649692bL, "-373909803", "%#ld",
+__LINE__, 0x00664f47L, "664f47", "%+6.x",
+__LINE__, 0x00000000L, "0", "% X",
+__LINE__, 0x00000047L, "000047", "%.6X",
+__LINE__, 0x00000007L, "0000007", "%.7ld",
+__LINE__, 0x00000030L, "30", "%-x",
+__LINE__, -0x25bcbabbL, "-633125563", "% ld",
+__LINE__, 0xfe11c031L, "FE11C031", "%4.6X",
+__LINE__, -0x0000001L, "-0000001", "%.7d",
+__LINE__, 0x00b56d84L, "11890052", "%ld",
+__LINE__, -0x0000b01L, "-0002817", "%+07.7ld",
+__LINE__, 0xffffe4adL, "ffffe4ad", "% 0.0x",
+__LINE__, 0x007760fcL, "7760fc", "%+x",
+__LINE__, 0xffef44d8L, "FFEF44D8", "%X",
+__LINE__, 0xfcb6862eL, "fcb6862e", "%+x",
+__LINE__, -0x0000001L, "-1", "%0d",
+__LINE__, 0xffffffe6L, "FFFFFFE6", "%3.1X",
+__LINE__, 0xff816e27L, "FF816E27", "% 6.X",
+__LINE__, 0x00006415L, "25621", "%ld",
+__LINE__, -0xfae5449L, "-263083081", "%0ld",
+__LINE__, 0x00000001L, " 1", "% 0d",
+__LINE__, 0x00000009L, " 9", "%2.X",
+__LINE__, 0x002d7e18L, "2981400", "%7d",
+__LINE__, -0x00000fcL, "-0000252", "%-#.7d",
+__LINE__, 0x00000003L, "3", "%0x",
+__LINE__, 0x0d46e47fL, "222749823", "%ld",
+__LINE__, 0xfffcbc52L, "FFFCBC52", "%+X",
+__LINE__, 0x00000000L, "0", "%-X",
+__LINE__, 0xfffff0e5L, "fffff0e5", "%x",
+__LINE__, 0xffffffd9L, "FFFFFFD9", "%07X",
+__LINE__, 0x000004eeL, "4ee", "%0x",
+__LINE__, 0xffffffffL, "ffffffff", "%0x",
+__LINE__, -0x0008cb4L, "-036020", "%+3.6ld",
+__LINE__, 0x0000dadaL, "0xdada", "%#0.x",
+__LINE__, 0x0000001aL, "26 ", "%-4d",
+__LINE__, -0x000000cL, " -12", "%04.d",
+__LINE__, 0x0000025cL, " 25c", "%7.x",
+__LINE__, 0xfe9b091eL, "FE9B091E", "%X",
+__LINE__, 0x00000002L, " 2", "%07.ld",
+__LINE__, -0x0004930L, "-18736", "% 6.d",
+__LINE__, 0xffffffe9L, "FFFFFFE9", "%X",
+__LINE__, 0x00000003L, " 3", "%2.ld",
+__LINE__, 0x00000e00L, "3584", "%.4d",
+__LINE__, 0xffff38c2L, "ffff38c2", "%0.x",
+__LINE__, 0xffffffffL, "FFFFFFFF", "% .3X",
+__LINE__, 0xff7c1b2fL, "FF7C1B2F", "%-3.2X",
+__LINE__, -0x0000005L, "-5", "%2d",
+__LINE__, 0x00098775L, "98775", "%x",
+__LINE__, 0x000015ffL, " 15FF", "%6.X",
+__LINE__, 0xfffbe3efL, "FFFBE3EF", "%0.3X",
+__LINE__, -0x0000048L, "-72", "%ld",
+__LINE__, 0x0001488aL, "84106", "%d",
+__LINE__, 0x00000001L, "1", "%x",
+__LINE__, -0x0000002L, "-2", "%-0.0ld",
+__LINE__, -0x0000001L, "-1", "%-d",
+__LINE__, 0x0006616fL, "6616f", "%x",
+__LINE__, 0x3657856dL, "911705453", "%6.d",
+__LINE__, -0x0007222L, "-0029218", "%.7d",
+__LINE__, 0x00041606L, "267782", "%04.5d",
+__LINE__, 0x00000001L, " 1", "%2.ld",
+__LINE__, 0x00000219L, "219", "%0x",
+__LINE__, 0x0ae0184cL, "ae0184c", "%x",
+__LINE__, 0x00003a7dL, " 14973", "%7.ld",
+__LINE__, 0xffffffffL, "0XFFFFFFFF", "%#X",
+__LINE__, -0x0000002L, "-2", "%0ld",
+__LINE__, 0x00002cdfL, "11487", "%0ld",
+__LINE__, -0x000000cL, "-12", "%d",
+__LINE__, -0x000000eL, "-14", "%-#2d",
+__LINE__, 0x00000371L, "881", "%#ld",
+__LINE__, 0x000015beL, " 5566", "%5.ld",
+__LINE__, 0x01525b91L, "22174609", "%#0.0ld",
+__LINE__, 0xff8fc22fL, "FF8FC22F", "% X",
+__LINE__, -0x0007f7bL, "-32635", "%4.ld",
+__LINE__, 0x00007bcaL, "7bca", "%x",
+__LINE__, -0x0000582L, "-1410", "%ld",
+__LINE__, 0x00000047L, " +71", "%+04.2d",
+__LINE__, 0xf8a8dce2L, "f8a8dce2", "%+.6x",
+__LINE__, -0x000de2eL, "-56878", "%.0d",
+__LINE__, 0x019c03c1L, "0X19C03C1", "%#X",
+__LINE__, -0x0f3a43eL, "-15967294", "%ld",
+__LINE__, 0x00009e87L, "40583", "%#5.1d",
+__LINE__, 0x000000b8L, "184", "%0ld",
+__LINE__, -0x000befeL, "-48894", "%2ld",
+__LINE__, -0x002ee1aL, "-192026", "%.2d",
+__LINE__, 0x00004fd8L, "4fd8", "%x",
+__LINE__, 0x0006d57bL, "447867", "%2d",
+__LINE__, 0xfffffa9cL, "FFFFFA9C", "%-X",
+__LINE__, 0x0000000fL, "15", "%ld",
+__LINE__, 0x0005deb2L, "5DEB2", "% X",
+__LINE__, 0x00000007L, "7", "%X",
+__LINE__, 0xffffffc8L, "0XFFFFFFC8", "% #.1X",
+__LINE__, 0xfffff62fL, "FFFFF62F", "%X",
+__LINE__, -0x1a935bbaL, "-445864890", "% 3.5d",
+__LINE__, 0x000b34b4L, "0x0b34b4", "%-#3.6x",
+__LINE__, 0xfffff430L, "FFFFF430", "%X",
+__LINE__, 0x00000b5fL, "+0002911", "%+#.7d",
+__LINE__, 0x00000007L, " 7", "%3ld",
+__LINE__, 0xffffffd8L, "FFFFFFD8", "% .7X",
+__LINE__, 0xfffff544L, "FFFFF544", "%0X",
+__LINE__, -0x353667b9L, "-892757945", "%d",
+__LINE__, 0x00000058L, "0x00058", "%+#.5x",
+__LINE__, 0x39dbcc4aL, "+970705994", "%+0.6ld",
+__LINE__, 0xfffffffdL, "fffffffd", "% 01x",
+__LINE__, 0x00b1c28eL, "+11649678", "%+0ld",
+__LINE__, 0x000066c2L, "0X66C2", "%-#4X",
+__LINE__, 0x007171a2L, "+7434658", "%+07.ld",
+__LINE__, -0x0000001L, "-1", "%-d",
+__LINE__, 0x00000ae0L, "+2784", "%+0d",
+__LINE__, 0x13786a57L, "326658647", "%#5d",
+__LINE__, -0x0000001L, "-1", "%2.ld",
+__LINE__, -0x0168a16L, "-1477142", "%d",
+__LINE__, 0x12df7dd6L, "316636630", "%ld",
+__LINE__, 0x00000000L, "000000", "%1.6d",
+__LINE__, 0x266da2a9L, "644719273", "%ld",
+__LINE__, 0x0000004aL, "74", "%d",
+__LINE__, 0x000102ffL, "00102FF", "%+06.7X",
+__LINE__, 0x17916237L, "0x17916237", "%#5x",
+__LINE__, -0x0003cbbL, "-0015547", "%-.7d",
+__LINE__, 0xe7da2010L, "e7da2010", "%2.4x",
+__LINE__, 0xfffffff3L, "fffffff3", "% .7x",
+__LINE__, 0xfc9b64f8L, "FC9B64F8", "% 7.X",
+__LINE__, 0x000001afL, "431", "%0d",
+__LINE__, 0xffc81796L, "0xffc81796", "%#.5x",
+__LINE__, 0x057a1fbcL, "+91889596", "%+04d",
+__LINE__, 0x00001ae1L, "6881", "%ld",
+__LINE__, 0xfffffff6L, "fffffff6", "%3.0x",
+__LINE__, -0x6b7d5dbL, "-112711131", "%-06.1d",
+__LINE__, 0x008e8a5cL, " 8e8a5c", "%7.0x",
+__LINE__, 0xfe07a9bdL, "fe07a9bd", "%.1x",
+__LINE__, -0x00278e6L, "-162022", "%0ld",
+__LINE__, 0xf98709f5L, "F98709F5", "%X",
+__LINE__, -0x00000c9L, "-201", "% 1.d",
+__LINE__, -0x000001dL, "-00029", "%+2.5ld",
+__LINE__, 0x00000030L, " 48", "% d",
+__LINE__, 0xffd753f4L, "FFD753F4", "%0X",
+__LINE__, 0xfffffffdL, "FFFFFFFD", "%X",
+__LINE__, 0x0000a765L, "a765", "%x",
+__LINE__, 0x0026e2c8L, "26E2C8", "%-0X",
+__LINE__, -0x00003ebL, "-1003", "%3.1ld",
+__LINE__, 0x015d53caL, "22893514", "%0ld",
+__LINE__, -0x0000020L, "-32", "%ld",
+__LINE__, -0x03558ddL, "-3496157", "%1.0ld",
+__LINE__, -0x000007fL, "-127", "%1.d",
+__LINE__, 0xffffc737L, "0xffffc737", "%+#x",
+__LINE__, 0x0000a70dL, " a70d", "%6.x",
+__LINE__, 0x01ea0e31L, "0X1EA0E31", "% #1.X",
+__LINE__, 0x00b5f406L, "0X0B5F406", "%-#.7X",
+__LINE__, 0x0e58fa9aL, "240712346", "%.2d",
+__LINE__, 0xf43ff8a9L, "f43ff8a9", "%+0.6x",
+__LINE__, -0x5d0d3d3L, "-97571795", "%.3ld",
+__LINE__, -0x000027aL, "-634", "%0d",
+__LINE__, 0xffcef248L, "FFCEF248", "%07.X",
+__LINE__, 0x000002dcL, "2dc", "%0x",
+__LINE__, -0x31fa6c1L, "-52405953", "%.2d",
+__LINE__, 0x00000014L, "14", "%X",
+__LINE__, -0x0282f98L, "-2633624", "%ld",
+__LINE__, 0x00005f55L, "24405", "%#d",
+__LINE__, -0x0000004L, "-4", "%d",
+__LINE__, 0x00000001L, "1", "%+x",
+__LINE__, 0x013f47ceL, "13f47ce", "%0.x",
+__LINE__, 0x00143fceL, "1327054", "%.3d",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, 0x00001f9aL, "1F9A", "% X",
+__LINE__, 0x00000cf5L, "cf5", "%x",
+__LINE__, 0xffea9c24L, "ffea9c24", "%x",
+__LINE__, 0xf09f85a7L, "F09F85A7", "%X",
+__LINE__, 0x00001e04L, "7684", "%ld",
+__LINE__, 0xffffc82aL, "ffffc82a", "%7x",
+__LINE__, -0x0000a77L, "-2679", "% d",
+__LINE__, 0x0019a859L, "+1681497", "%+2.6ld",
+__LINE__, -0x00002d7L, "-727", "%ld",
+__LINE__, 0x00011b82L, "72578", "%-#ld",
+__LINE__, 0x00000c32L, "3122", "%ld",
+__LINE__, -0x0000337L, "-823", "%1.d",
+__LINE__, 0x00000004L, "4", "%1ld",
+__LINE__, 0x0000062cL, "1580", "%.1ld",
+__LINE__, 0xffffffd3L, "FFFFFFD3", "% X",
+__LINE__, -0x07b1bf8L, "-8068088", "%#d",
+__LINE__, 0xfffffff9L, "fffffff9", "%x",
+__LINE__, 0x159e6cfbL, "159e6cfb", "%0.x",
+__LINE__, 0x0001148dL, "1148d", "%-.1x",
+__LINE__, 0x003373b7L, "3371959", "%#.0d",
+__LINE__, 0x00001af2L, "1af2", "%.4x",
+__LINE__, -0x0000001L, "-000001", "%+.6ld",
+__LINE__, -0x00001a3L, "-419", "%d",
+__LINE__, 0xfdb232e7L, "fdb232e7", "%5.4x",
+__LINE__, -0x000000dL, "-13", "%d",
+__LINE__, 0x98ec1c74L, "98ec1c74", "% 3x",
+__LINE__, 0xfffffff8L, "fffffff8", "%+1.4x",
+__LINE__, -0x0000d58L, "-3416", "%+#0ld",
+__LINE__, -0x65d1973L, "-106764659", "%.6d",
+__LINE__, -0x0737641L, "-7566913", "%-d",
+__LINE__, 0x0000037cL, "37c", "%+0x",
+__LINE__, 0x0000012cL, "0000300", "%#3.7d",
+__LINE__, 0x00c12d9bL, "12660123", "%1.5ld",
+__LINE__, 0xe7e5e77dL, "e7e5e77d", "%6x",
+__LINE__, 0x1fe0e820L, "1FE0E820", "%-4X",
+__LINE__, 0xc85a793aL, "C85A793A", "%X",
+__LINE__, 0x05f9fe2cL, "100269612", "%#ld",
+__LINE__, 0x00000032L, "0X32", "%+#4.1X",
+__LINE__, 0xfab4ce81L, "fab4ce81", "%3.x",
+__LINE__, -0x0000009L, "-9", "%2.d",
+__LINE__, 0xffff8d2eL, "ffff8d2e", "% 6x",
+__LINE__, 0xfffffffeL, "0xfffffffe", "%#x",
+__LINE__, 0x02960f60L, "2960f60", "%1.x",
+__LINE__, 0x34cf3cbcL, " 885996732", "% 5ld",
+__LINE__, -0x000006eL, "-110", "% d",
+__LINE__, -0x0000001L, "-1", "%-.0d",
+__LINE__, 0x000000b1L, " B1", "%+7X",
+__LINE__, 0xfffff5b4L, "FFFFF5B4", "%01.7X",
+__LINE__, 0x00000086L, "86", "%0X",
+__LINE__, 0x00074367L, " 74367", "% 6x",
+__LINE__, 0x001000d7L, "+1048791", "%+ld",
+__LINE__, 0x00000f35L, " 3893", "% d",
+__LINE__, -0x00000e1L, "-225", "%d",
+__LINE__, 0xffff6694L, "FFFF6694", "%6.X",
+__LINE__, 0x00019cf7L, "19cf7", "%0.x",
+__LINE__, 0x00000046L, "0046", "%+.4X",
+__LINE__, -0x000001fL, "-31", "%ld",
+__LINE__, 0xfff25859L, "fff25859", "%6x",
+__LINE__, 0x21884061L, "562577505", "%#ld",
+__LINE__, 0x01448b7aL, "1448B7A", "%0.1X",
+__LINE__, 0xffffffc0L, "ffffffc0", "%x",
+__LINE__, 0xfffffed5L, "fffffed5", "% 1.0x",
+__LINE__, 0x0e349767L, "E349767", "%.5X",
+__LINE__, 0x00000330L, "816", "%0d",
+__LINE__, -0x0000016L, "-22", "%d",
+__LINE__, 0xffff9babL, "FFFF9BAB", "%X",
+__LINE__, 0xffffee4eL, "ffffee4e", "%x",
+__LINE__, 0x0026beebL, "2539243", "%6.d",
+__LINE__, 0x00002c6cL, "11372", "%.2d",
+__LINE__, -0x000002cL, "-44", "%ld",
+__LINE__, -0x001dcfaL, "-122106", "% d",
+__LINE__, 0x0001683cL, "92220", "%#4.ld",
+__LINE__, 0x09b51fc9L, "9b51fc9", "%+.7x",
+__LINE__, 0x0000001dL, "29", "%0ld",
+__LINE__, -0x83f17e5L, "-138352613", "%ld",
+__LINE__, 0xfa4e2c1bL, "fa4e2c1b", "%x",
+__LINE__, 0x000001f3L, "499", "%0ld",
+__LINE__, 0xffff03e4L, "ffff03e4", "%x",
+__LINE__, 0x000000acL, "+0172", "%+.4ld",
+__LINE__, 0x03c3903bL, "63148091", "%00d",
+__LINE__, 0x0000000dL, "13", "%#d",
+__LINE__, 0x0000002eL, "0X2E", "%#X",
+__LINE__, 0x00006b2dL, "6B2D", "%X",
+__LINE__, 0x0000010bL, " 0010b", "%7.5x",
+__LINE__, 0x0000017aL, " 17a", "%4x",
+__LINE__, 0xfffffffbL, "fffffffb", "%+x",
+__LINE__, 0xffffac6aL, "ffffac6a", "%-.3x",
+__LINE__, -0x0005870L, "-22640", "%0d",
+__LINE__, 0x189c17bcL, "189c17bc", "%x",
+__LINE__, -0x01bbc38L, "-1817656", "%#6.ld",
+__LINE__, -0x3382b55L, "-54012757", "%d",
+__LINE__, -0x0000007L, "-7", "%-ld",
+__LINE__, -0x000c74bL, "-51019", "%ld",
+__LINE__, 0x0001a6f2L, "+108274", "%+#1.ld",
+__LINE__, 0x00077448L, "77448", "%x",
+__LINE__, 0x00000000L, "0", "%x",
+__LINE__, 0xfffff056L, "FFFFF056", "%.3X",
+__LINE__, -0x6f3f9451L, "-1866437713", "%-#3.0ld",
+__LINE__, 0x000000acL, "AC", "%X",
+__LINE__, 0xffc8752fL, "ffc8752f", "%-x",
+__LINE__, 0xfffffe6dL, "FFFFFE6D", "%2.X",
+__LINE__, -0x377f1a5L, "-58192293", "% .2d",
+__LINE__, -0x0000294L, "-660", "%d",
+__LINE__, 0xfffffffeL, "fffffffe", "%-x",
+__LINE__, 0xfffcbbe8L, "0xfffcbbe8", "%-#4.x",
+__LINE__, 0x0022e510L, "+2286864", "%+ld",
+__LINE__, 0xfffffe2aL, "FFFFFE2A", "%0.3X",
+__LINE__, 0xfe29f7c0L, "fe29f7c0", "%x",
+__LINE__, 0xfffe957eL, "FFFE957E", "%X",
+__LINE__, 0x000080f8L, "33016", "%ld",
+__LINE__, 0x0003ee2cL, " 257580", "%7d",
+__LINE__, 0x000003a1L, "929", "%d",
+__LINE__, 0x0000021fL, "21f", "%+x",
+__LINE__, 0xffffffffL, "ffffffff", "%.5x",
+__LINE__, -0x040a988L, "-4237704", "%-d",
+__LINE__, 0x027c8b69L, "41716585", "%ld",
+__LINE__, 0x00000003L, "3", "%-X",
+__LINE__, -0x0000368L, " -872", "%7.d",
+__LINE__, 0x00000d3cL, "3388", "%0.2d",
+__LINE__, -0x33734ccL, "-53949644", "%2ld",
+__LINE__, 0x000003dbL, "3DB", "%X",
+__LINE__, -0x00f154dL, "-988493", "%5d",
+__LINE__, 0x0000000bL, " 11", "%4.ld",
+__LINE__, 0x00000067L, "103", "%-ld",
+__LINE__, -0x0199fceL, "-1679310", "%4d",
+__LINE__, 0x02b6266bL, "2b6266b", "% x",
+__LINE__, -0x006b39dL, "-439197", "%+d",
+__LINE__, 0x00000007L, "7", "%ld",
+__LINE__, 0x0141fc98L, "21101720", "%0ld",
+__LINE__, -0x0008420L, "-33824", "%d",
+__LINE__, 0x0011622bL, "1139243", "%6ld",
+__LINE__, 0x0000001bL, "27", "%-d",
+__LINE__, -0x0030935L, "-198965", "%3d",
+__LINE__, 0x0000001fL, " 1f", "%4.x",
+__LINE__, -0x10782a19L, "-276310553", "%#ld",
+__LINE__, -0x007eac4L, "-518852", "%06.ld",
+__LINE__, 0x0bc4c681L, "197445249", "%6ld",
+__LINE__, 0x000000f5L, "245", "%.3ld",
+__LINE__, 0x00000197L, "197", "%X",
+__LINE__, 0xfffffeabL, "FFFFFEAB", "% X",
+__LINE__, 0x00000f05L, "F05", "%+X",
+__LINE__, 0xffe1b785L, "0xffe1b785", "%#x",
+__LINE__, -0x02d3581L, "-2962817", "%05d",
+__LINE__, 0xffffb994L, "FFFFB994", "%X",
+__LINE__, 0x03d139a3L, "64043427", "%ld",
+__LINE__, -0x0000002L, " -2", "%+4.d",
+__LINE__, -0x043da83L, "-4446851", "%#ld",
+__LINE__, -0x6aad891L, "-111859857", "%7.ld",
+__LINE__, 0x00003e68L, "15976", "%-4.5ld",
+__LINE__, 0xffe4d3eeL, "FFE4D3EE", "%X",
+__LINE__, 0x00000002L, "000002", "%4.6ld",
+__LINE__, 0xffffee32L, "ffffee32", "%4x",
+__LINE__, 0x0cb7dd25L, "cb7dd25", "%3x",
+__LINE__, 0xf773d422L, "F773D422", "%X",
+__LINE__, -0x0b590f7L, "-11899127", "%#d",
+__LINE__, -0x0002c45L, "-11333", "%-#5ld",
+__LINE__, -0x1efc9e4L, "-32492004", "%ld",
+__LINE__, -0x0003b9cL, "-15260", "%d",
+__LINE__, 0x000001b6L, "0X1B6", "%#4X",
+__LINE__, 0x3ce93ec3L, "1021918915", "%.6d",
+__LINE__, 0xffffffffL, "ffffffff", "%-x",
+__LINE__, 0xfffaf0e4L, "fffaf0e4", "%2.x",
+__LINE__, 0x00000002L, "0x2", "%#x",
+__LINE__, 0x0000e806L, "e806", "%4x",
+__LINE__, 0xfffffff0L, "fffffff0", "% 2.x",
+__LINE__, 0xfffffc0eL, "fffffc0e", "%+.4x",
+__LINE__, 0xfd45716eL, "FD45716E", "%.4X",
+__LINE__, 0xfff96fdaL, "FFF96FDA", "%-X",
+__LINE__, 0xff99d08aL, "FF99D08A", "%.5X",
+__LINE__, 0x00000002L, "2", "%-00.d",
+__LINE__, -0x000000fL, " -15", "%6.ld",
+__LINE__, -0x00d321cL, "-864796", "%#1ld",
+__LINE__, 0xff19ff8dL, "ff19ff8d", "%1.5x",
+__LINE__, 0x00000000L, "0000000", "%-.7x",
+__LINE__, 0x0000f50dL, " F50D", "%5X",
+__LINE__, 0x00001688L, " 5768", "%7.ld",
+__LINE__, 0x00000157L, "343", "%2ld",
+__LINE__, 0xfffffffdL, "0xfffffffd", "%+#3x",
+__LINE__, 0x00000d52L, "3410", "%ld",
+__LINE__, 0x00000003L, "3", "%d",
+__LINE__, 0x0001c6d2L, "01c6d2", "%.6x",
+__LINE__, 0x242d65d2L, "606954962", "%#7.ld",
+__LINE__, 0x00000e9fL, "0000E9F", "%5.7X",
+__LINE__, 0x0002d785L, "2D785", "%0X",
+__LINE__, 0x00000167L, "167", "%0X",
+__LINE__, 0xfffff5e5L, "fffff5e5", "% x",
+__LINE__, 0xffb69a04L, "0xffb69a04", "%#0.x",
+__LINE__, 0xfffa012eL, "FFFA012E", "%X",
+__LINE__, 0x0000001aL, "0x1a", "% #x",
+__LINE__, 0xfffb26d3L, "fffb26d3", "%+x",
+__LINE__, -0x00003e6L, " -998", "%7ld",
+__LINE__, 0x00000004L, "4", "%-d",
+__LINE__, 0xfffffd76L, "0XFFFFFD76", "%#7X",
+__LINE__, 0x00000035L, "53", "%ld",
+__LINE__, 0xffc6c190L, "0XFFC6C190", "%#X",
+__LINE__, 0xffffffe2L, "ffffffe2", "%7.0x",
+__LINE__, 0x03ff1b87L, "67050375", "%2.d",
+__LINE__, 0x00020c47L, "0X20C47", "%#X",
+__LINE__, 0x00000000L, "0", "%d",
+__LINE__, 0x0000000eL, "0X000E", "% #.4X",
+__LINE__, -0x00035cdL, "-13773", "%+2.d",
+__LINE__, 0x00005eecL, "5eec", "%1x",
+__LINE__, 0x001da0ffL, "1941759", "%0d",
+__LINE__, 0xf8a9e96aL, "f8a9e96a", "%+x",
+__LINE__, -0x0000120L, "-288 ", "%-#6.d",
+__LINE__, 0x00000000L, "0", "%-X",
+__LINE__, 0x0000152eL, "152E", "%+X",
+__LINE__, -0x0001077L, "-4215", "% 0d",
+__LINE__, 0xffffffd7L, "FFFFFFD7", "%0X",
+__LINE__, 0xfffe097dL, "FFFE097D", "%2X",
+__LINE__, 0xcb982712L, "cb982712", "%x",
+__LINE__, 0xfff39f2eL, "FFF39F2E", "%.5X",
+__LINE__, -0x0058caeL, "-363694", "%+.1d",
+__LINE__, -0x000002bL, "-043", "%#1.3d",
+__LINE__, -0x001e989L, "-125321", "%1d",
+__LINE__, 0x00959ecdL, "9805517", "%d",
+__LINE__, 0xf49df846L, "F49DF846", "%+3X",
+__LINE__, 0xfffffffdL, "fffffffd", "%+.5x",
+__LINE__, -0x000ac76L, "-44150", "%3.ld",
+__LINE__, 0x00000028L, " 0028", "%06.4x",
+__LINE__, 0x000003e8L, "3E8", "%-02X",
+__LINE__, 0x00000012L, "012", "%.3X",
+__LINE__, 0x00000006L, "0X6", "%#X",
+__LINE__, 0x00ef8479L, "+15697017", "%+0.6d",
+__LINE__, 0xffffffe8L, "FFFFFFE8", "%-X",
+__LINE__, 0x773a90f7L, "773a90f7", "%3.5x",
+__LINE__, 0x00096d44L, "96D44", "%-X",
+__LINE__, -0x08a3d96L, "-9059734", "%ld",
+__LINE__, -0x000001aL, "-26", "%00.ld",
+__LINE__, 0x32f57585L, "32f57585", "% x",
+__LINE__, 0x2825f175L, "2825F175", "%X",
+__LINE__, 0x000054ffL, "21759", "%-2d",
+__LINE__, -0x0266cdcL, "-2518236", "%ld",
+__LINE__, 0x0000031dL, "0X31D", "%+#4X",
+__LINE__, 0x0003fc99L, "3fc99", "%x",
+__LINE__, -0x0064624L, "-411172", "%-#d",
+__LINE__, 0x0001b2d9L, "111321", "%-ld",
+__LINE__, -0x000007cL, "-124", "%#d",
+__LINE__, 0xfffffffaL, "FFFFFFFA", "%+X",
+__LINE__, -0x007a5b8L, "-501176", "%+ld",
+__LINE__, 0x0213b583L, "213B583", "%2.X",
+__LINE__, 0xfff12e51L, "FFF12E51", "%+X",
+__LINE__, 0x00052403L, "0336899", "%-0.7d",
+__LINE__, 0xffffffffL, "ffffffff", "%-04.4x",
+__LINE__, 0x00000010L, "0010", "%0.4X",
+__LINE__, 0xffffffb5L, "FFFFFFB5", "%-1.3X",
+__LINE__, -0x0000001L, "-1", "%d",
+__LINE__, 0x0003a2d1L, "3a2d1", "% x",
+__LINE__, 0x00000424L, "1060", "%0ld",
+__LINE__, -0x0000078L, "-120", "%1d",
+__LINE__, 0x00000000L, "0", "%ld",
+__LINE__, 0x00000414L, "1044", "%ld",
+__LINE__, 0x00000072L, "0x072", "%#5.3x",
+__LINE__, 0x0000007aL, "7A", "% X",
+__LINE__, 0x081542a3L, "135611043", "%0d",
+__LINE__, 0xfffb4ce6L, "fffb4ce6", "%4.6x",
+__LINE__, 0x00002ab2L, "2ab2", "%-1x",
+__LINE__, 0x00000000L, " 0", "% 2x",
+__LINE__, 0xfffffa59L, "FFFFFA59", "%2.X",
+__LINE__, 0xffffe22bL, "ffffe22b", "%-x",
+__LINE__, 0xfffffd52L, "FFFFFD52", "%+.2X",
+__LINE__, 0x0000039fL, "927", "%-d",
+__LINE__, 0x0002dea6L, "2dea6", "%0x",
+__LINE__, 0x000216dbL, "136923", "%ld",
+__LINE__, 0x00000013L, "19", "%0d",
+__LINE__, 0x000047ccL, "18380", "%2.2ld",
+__LINE__, -0x0007d10L, "-32016", "%d",
+__LINE__, 0xff9af906L, "FF9AF906", "%0X",
+__LINE__, 0x02cfa224L, "+47161892", "%+0.7d",
+__LINE__, -0x0000022L, "-34", "%1.d",
+__LINE__, 0xfffffff0L, "FFFFFFF0", "%-4X",
+__LINE__, 0x00000029L, " 41", "%6.ld",
+__LINE__, 0xffffff76L, "ffffff76", "%x",
+__LINE__, 0x00000000L, "0", "%+X",
+__LINE__, 0x00000001L, "1", "%d",
+__LINE__, 0xfff6de5aL, "FFF6DE5A", "%X",
+__LINE__, 0x00000002L, "2", "%ld",
+__LINE__, 0x00000025L, "25", "%+x",
+__LINE__, 0xfffffffbL, "FFFFFFFB", "%5.0X",
+__LINE__, 0x0011bbb5L, "1162165", "%0.0ld",
+__LINE__, 0xfffcdc96L, "0XFFFCDC96", "%#X",
+__LINE__, 0x00008f5fL, "8f5f", "%3.1x",
+__LINE__, 0xffa0fa5dL, "0XFFA0FA5D", "%#X",
+__LINE__, 0x00004534L, "4534", "% 0X",
+__LINE__, 0xfffffff9L, "fffffff9", "%.2x",
+__LINE__, 0xffeeae50L, "ffeeae50", "%-x",
+__LINE__, 0x00002964L, " 0010596", "% 0.7d",
+__LINE__, 0x000021c9L, " 21c9", "%6x",
+__LINE__, 0x00000001L, " 1", "% d",
+__LINE__, 0x0002abd8L, "+175064", "%+d",
+__LINE__, 0xffffffadL, "FFFFFFAD", "%+0X",
+__LINE__, 0x00000003L, "3", "%ld",
+__LINE__, 0x0c036da3L, " 201551267", "% .3d",
+__LINE__, -0x004343cL, "-275516", "%+ld",
+__LINE__, 0x00000003L, "003", "% .3x",
+__LINE__, 0xffffe34eL, "ffffe34e", "%x",
+__LINE__, 0x0000e118L, "e118", "%x",
+__LINE__, -0x007d945L, "-514373", "%+#0ld",
+__LINE__, 0x277f1cc5L, "277f1cc5", "% x",
+__LINE__, 0x00003befL, "03bef", "% 0.5x",
+__LINE__, 0xfffffcb9L, "fffffcb9", "%x",
+__LINE__, 0x0003311aL, "209178", "%ld",
+__LINE__, 0x00000000L, " ", "%3.ld",
+__LINE__, 0x05942225L, "5942225", "%x",
+__LINE__, 0xfffceb4cL, "FFFCEB4C", "%-X",
+__LINE__, 0xffd08633L, "ffd08633", "%2.x",
+__LINE__, -0x0000001L, " -1", "%6d",
+__LINE__, 0x000fdb12L, "1039122", "%d",
+__LINE__, 0x00000003L, "3", "% 0X",
+__LINE__, -0x2fd5bf1L, "-50158577", "% 5.ld",
+__LINE__, -0x0089a03L, "-563715", "%-d",
+__LINE__, 0xfffffffeL, "FFFFFFFE", "% X",
+__LINE__, 0x29fdb2baL, "29fdb2ba", "% 0x",
+__LINE__, 0x0000008fL, "8F", "% X",
+__LINE__, 0x00000003L, "3", "%ld",
+__LINE__, 0xffc58445L, "FFC58445", "%.2X",
+__LINE__, -0x00023f6L, "-9206", "%+d",
+__LINE__, 0x00000011L, "11", "%X",
+__LINE__, -0x0000003L, "-0000003", "%-.7d",
+__LINE__, -0x0000003L, "-3", "%#ld",
+__LINE__, 0x001242d9L, "1242D9", "%X",
+__LINE__, -0x48d0c81L, "-76352641", "%7.d",
+__LINE__, -0x001b675L, "-112245", "%#ld",
+__LINE__, 0x00000003L, "3", "%-d",
+__LINE__, 0xfff93fdfL, "0XFFF93FDF", "% #X",
+__LINE__, 0x001a9414L, "1741844", "%#ld",
+__LINE__, 0x0001fd86L, "130438", "%ld",
+__LINE__, 0x010f37a8L, "17774504", "%4.7d",
+__LINE__, 0x00382838L, "0382838", "%3.7X",
+__LINE__, -0x47fd56c2L, "-1207785154", "%ld",
+__LINE__, 0x001981ddL, "1981dd", "%x",
+__LINE__, 0xffffefbaL, "ffffefba", "% 06.x",
+__LINE__, -0x3f402b29L, "-1061169961", "%+#ld",
+__LINE__, -0x395aae44L, "-962244164", "%-1d",
+__LINE__, 0x1fa39f42L, "530816834", "%#d",
+__LINE__, -0x000358dL, "-13709", "%d",
+__LINE__, -0xdc17b8fL, "-230783887", "%ld",
+__LINE__, -0x23c41583L, "-600053123", "%+3.d",
+__LINE__, 0xfffffc16L, "fffffc16", "%x",
+__LINE__, 0x003f1364L, "4133732", "%7.ld",
+__LINE__, 0xffffe691L, "FFFFE691", "%07X",
+__LINE__, 0x07b31d71L, "129178993", "%.7d",
+__LINE__, -0x0019732L, "-104242", "% ld",
+__LINE__, 0x02428167L, "0x2428167", "%#x",
+__LINE__, -0x06c1ecdL, "-7085773", "%.7ld",
+__LINE__, 0xfb01cb4eL, "fb01cb4e", "%x",
+__LINE__, 0x00005a41L, "+23105", "%+ld",
+__LINE__, 0xfffffff4L, "FFFFFFF4", "%-5.X",
+__LINE__, 0x00000005L, " 5", "%4.ld",
+__LINE__, 0xf4ab4b2dL, "F4AB4B2D", "%0.X",
+__LINE__, -0x000fce3L, "-64739", "%+#3.ld",
+__LINE__, 0x000076eaL, " 30442", "%6.2ld",
+__LINE__, 0x00000cb9L, " cb9", "%4.x",
+__LINE__, 0x002f43efL, "3097583", "%1.1ld",
+__LINE__, 0xf5bd0105L, "F5BD0105", "%+X",
+__LINE__, 0x0037954aL, "3642698", "%d",
+__LINE__, 0xfffffff7L, "0XFFFFFFF7", "%-#X",
+__LINE__, 0xffffcedfL, "0xffffcedf", "%#6.7x",
+__LINE__, 0xfffffde4L, "FFFFFDE4", "%2.4X",
+__LINE__, 0x01a6f103L, "1a6f103", "%5.x",
+__LINE__, 0x00000191L, " 191", "%7.0X",
+__LINE__, 0x00000003L, "03", "% .2X",
+__LINE__, -0xd4e3219L, "-223228441", "%6.ld",
+__LINE__, 0x00b0efbdL, "11595709", "%d",
+__LINE__, -0x00000eaL, "-234", "%#3d",
+__LINE__, 0x00000be8L, "BE8 ", "%-5X",
+__LINE__, 0xffffffffL, "ffffffff", "%5.3x",
+__LINE__, -0x267f8c6L, "-40368326", "%d",
+__LINE__, 0x000006edL, "6ED", "%X",
+__LINE__, 0xfdd6c9b6L, "FDD6C9B6", "%X",
+__LINE__, 0x0007ac29L, "7ac29", "%-x",
+__LINE__, 0x00000014L, "14", "%2x",
+__LINE__, 0x123ca563L, "+305964387", "%+ld",
+__LINE__, 0x00000004L, " 4", "%5.d",
+__LINE__, 0xffff877aL, "ffff877a", "%x",
+__LINE__, -0x00003e7L, "-999", "%+0.3d",
+__LINE__, 0x0a68ba6eL, "a68ba6e", "%3.1x",
+__LINE__, 0xfe29c810L, "FE29C810", "%+X",
+#endif
+
+__LINE__, 0x00000000L, "0", "%o",
+__LINE__, 0000000123L, "123", "%o",
+__LINE__, 0000123456L, "0123456", "%#o",
+__LINE__, 0000123456L, "00123456", "%#.8o",
+__LINE__, 0000123456L, " 00123456", "%#10.8o",
+__LINE__, 0x00000123L, "0x00123", "%#07x",
+
+0,
+};
+
+int main()
+{
+ int errcount = 0;
+ int testcount = 0;
+#define BSIZE 1024
+ char buffer[BSIZE];
+ sprint_int_type *iptr;
+#if defined(__cplusplus) && !defined(TEST_LIBIO)
+
+ ostrstream sstr(buffer, BSIZE);
+
+ for (iptr = sprint_ints; iptr->line; iptr++) {
+ sstr.seekp(0);
+ sstr.form(iptr->format_string, iptr->value);
+ sstr << ends;
+ if (strcmp(buffer, iptr->result) != 0) {
+ errcount++;
+ cerr << "Error in line " << iptr->line;
+ cerr << " using \"" << iptr->format_string;
+ cerr << "\". Result is \"" << buffer << "\"; should be: \"";
+ cerr << iptr->result << "\".\n";
+ }
+ testcount++;
+ }
+
+
+ if (errcount == 0) {
+ cerr << "Encountered no errors in " << testcount << " tests.\n";
+ return 0;
+ }
+ else {
+ cerr << "Encountered " << errcount << " errors in "
+ << testcount << " tests.\n";
+ return 1;
+ }
+#else
+ for (iptr = sprint_ints; iptr->line; iptr++)
+ {
+ if (sizeof(int)==2)
+ {
+ /* Cheezy, but effective. */
+ char buf[30];
+ int len = strlen(iptr->format_string);
+
+ strcpy(buf, iptr->format_string);
+ if(buf[len-2] != 'l') {
+ buf[len] = buf[len-1];
+ buf[len-1] = 'l';
+ buf[len+1] = 0;
+ }
+ sprintf(buffer, buf, iptr->value);
+ }
+ else
+ {
+ sprintf(buffer, iptr->format_string, iptr->value);
+ }
+ if (strcmp(buffer, iptr->result) != 0) {
+ errcount++;
+ fprintf(stderr,
+ "Error in line %d using \"%s\". Result is \"%s\"; should be: \"%s\".\n",
+ iptr->line, iptr->format_string, buffer, iptr->result);
+ fprintf(stderr,"%ld\n",iptr->value);
+ }
+ testcount++;
+ }
+
+ if (errcount == 0) {
+ fprintf(stderr, "Encountered no errors in %d tests.\n", testcount);
+ return 0;
+ }
+ else {
+ fprintf(stderr, "Encountered %d errors in %d tests.\n",
+ errcount, testcount);
+ return 1;
+ }
+#endif
+}
diff --git a/libio/tests/tiomanip.cc b/libio/tests/tiomanip.cc
new file mode 100644
index 00000000000..b7dd08a4618
--- /dev/null
+++ b/libio/tests/tiomanip.cc
@@ -0,0 +1,35 @@
+// test the parametrized manipulators
+
+#include <stdlib.h>
+#include <iomanip.h>
+
+main()
+{
+#ifdef _G_NO_TEMPLATES
+ cerr << "(IO manipulators are not supported with this compiler)\n");
+ exit(-1);
+#else
+
+ cout << dec << 1234 << ' '
+ << hex << 1234 << ' '
+ << oct << 1234 << endl;
+
+ //SMANIP<int> x = setw(4);
+ //operator<<(cout, x);
+
+ cout
+ << "("
+ << dec << setw(4) << setfill('*')
+ << 12 << ")\n";
+
+ cout << "(" << 12 << ")\n";
+
+ cout << setiosflags(ios::internal);
+ cout << "(" << setw(6) << -12 << ")\n";
+
+ exit(0);
+#endif
+}
+
+
+
diff --git a/libio/tests/tiomanip.exp b/libio/tests/tiomanip.exp
new file mode 100644
index 00000000000..7a0a7ea5cb2
--- /dev/null
+++ b/libio/tests/tiomanip.exp
@@ -0,0 +1,4 @@
+1234 4d2 2322
+(**12)
+(12)
+(-***12)
diff --git a/libio/tests/tiomisc.cc b/libio/tests/tiomisc.cc
new file mode 100644
index 00000000000..207a3f16e2b
--- /dev/null
+++ b/libio/tests/tiomisc.cc
@@ -0,0 +1,236 @@
+/* Random regression tests etc. */
+
+#include <fstream.h>
+#include <stdio.h>
+#include <strstream.h>
+#include <string.h>
+#include <fcntl.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#define BUF_SIZE 4096
+
+void
+test1 ()
+{
+ fstream f;
+ char buf[BUF_SIZE];
+
+ f.setbuf( buf, BUF_SIZE );
+}
+
+void
+test2 ( )
+{
+ char string[BUF_SIZE];
+ ostrstream s( string, BUF_SIZE );
+
+ s << "Bla bla bla " << 55 << ' ' << 3.23 << '\0' << endl;
+ cout << "Test2: " << string << endl;
+}
+
+
+/* Test case from Joe Buck <jbuck@Synopsys.COM>. */
+
+class special_ofstream : public ofstream {
+public:
+ special_ofstream() : ofstream() {}
+ special_ofstream(int fd) : ofstream(fd) {}
+ special_ofstream(const char *name, int mode=ios::out, int prot=0664) {
+ open(name,mode,prot);
+ }
+ void open(const char *name, int mode=ios::out, int prot=0664);
+};
+
+void special_ofstream::open(const char* name, int mode, int prot) {
+ if (strcmp(name, "<cout>") == 0) {
+ rdbuf()->attach(1);
+ }
+ else if (strcmp(name, "<cerr>") == 0) {
+ rdbuf()->attach(2);
+ setf(unitbuf);
+ }
+ else ofstream::open(name,mode,prot);
+}
+
+void
+test3 ()
+{
+ {
+ special_ofstream o("<cout>");
+ o << "Hello\n";
+ // o is destructed now. This should not close cout
+ }
+ {
+ special_ofstream o("<cout>");
+ o << "Line 2\n";
+ }
+}
+
+void
+getline_test1 ()
+{
+ char buf[1000];
+ char data[] = "#include <iostream.h>\n#include <fstream.h>\n";
+ istrstream infile(data, strlen(data));
+ infile.getline(buf,1000);
+ infile.getline(buf,1000);
+
+ cout << buf << '\n';
+}
+
+// test istream::getline on readng overlong lines.
+void
+getline_test2 ()
+{
+ char data[] = "Line one.\nline 2.\n";
+ char line[100];
+ istrstream strin(data, strlen(data));
+ strin.getline(line, 10);
+ cout << "line: " << line << ", count: " << strin.gcount () << "\n";
+}
+
+void
+getline_test3 ()
+{
+ char data[] = "123456789\nabcdefghijkl.\n";
+ char line[10];
+ istrstream strin(data, strlen(data));
+ strin.getline(line, 10);
+ cout << "line: " << line << ", count: " << strin.gcount () << "\n";
+ strin.getline(line, 10);
+ cout << "line: " << line << ", count: " << strin.gcount () << "\n";
+ assert (!strin.good());
+ strin.clear ();
+ strin.getline(line, 10);
+ cout << "line: " << line << ", count: " << strin.gcount () << "\n";
+}
+
+class A : private ostream
+{
+public:
+ A(streambuf* s);
+ ostream::flush;
+};
+A::A(streambuf* s)
+: ostream(s)
+{
+}
+
+void
+flush1_test()
+{
+ A os(cout.rdbuf());
+ os.flush();
+}
+
+void
+reread_test ()
+{ // This is PR 5486.
+ int tag_char;
+ char *fname = "Makefile";
+ int mode = O_RDONLY;
+ filebuf file_p;
+
+ int fd = ::open(fname, mode, 0666);
+ file_p.attach(fd);
+
+ istream d_istream(&file_p);
+
+ // Read a character from the stream, save it and put it back.
+ tag_char = d_istream.get();
+ int save_char = tag_char;
+ d_istream.putback((char) tag_char);
+
+ // Uncomment then next statement and the next get will be EOF.
+ streampos pos = d_istream.tellg();
+
+ // Re-read the first character
+ tag_char = d_istream.get();
+
+ cout << "reread_test: " << (char)save_char << " " << (char)tag_char << "\n";
+ cout.flush();
+
+}
+
+void *danger_pointer;
+void operator delete (void *p) throw()
+{
+ if (p)
+ {
+ if (p == danger_pointer)
+ fprintf (stderr, "maybe deleted\n");
+
+ free (p);
+ }
+}
+
+struct my_ostream: virtual public ios, public ostream
+{
+ my_ostream (ostream &s): ios (s.rdbuf()) { }
+};
+
+void
+test_destroy ()
+{
+ ofstream fstr ("foo.dat");
+ my_ostream wa (fstr);
+
+ /* Check that sure wa.rdbuf() is only freed once. */
+ danger_pointer = wa.rdbuf ();
+
+ wa << "Hi there" << endl;
+#ifdef _IO_NEW_STREAMS
+ fprintf (stderr, "maybe deleted\n");
+#endif
+}
+
+/* Submitted by Luke Blanshard <luke@cs.wisc.edu>.
+
+ In certain circumstances, the library will write past the end of the
+ buffer it has allocated for a file: You must read from the file,
+ exactly enough bytes that the read pointer is at the end of the
+ buffer. Then you must write to the file, at the same place you just
+ finished reading from.
+
+ "Your patch looks great, and you're welcome to use the test code for any
+ purpose whatever. I hereby renounce my implicit copyright on it." */
+
+void
+test_read_write_flush ()
+{
+ fstream f;
+ char buf[8192];
+
+ for ( int index=0; index < sizeof buf; ++index )
+ buf[index] = (index+1)&63? 'x' : '\n';
+
+ f.open( "foo.dat", ios::in|ios::out|ios::trunc );
+ f.write( buf, sizeof buf );
+
+ f.seekg( 0, ios::beg );
+ f.read( buf, sizeof buf );
+
+// f.seekp( sizeof buf, ios::beg ); // Present or absent, bug still happens.
+ f.write( "a", 1 );
+
+ if ( f.rdbuf()->_IO_write_ptr > f.rdbuf()->_IO_buf_end )
+ cerr << "test_read_write_flush: it's broken.\n";
+ else
+ cout << "test_read_write_flush: the problem isn't showing itself.\n";
+}
+
+int main( )
+{
+ test1 ();
+ test2 ();
+ test3 ();
+ getline_test1 ();
+ getline_test2 ();
+ getline_test3 ();
+ flush1_test ();
+ reread_test ();
+ test_destroy ();
+ test_read_write_flush ();
+ return 0;
+}
diff --git a/libio/tests/tiomisc.exp b/libio/tests/tiomisc.exp
new file mode 100644
index 00000000000..26a3acd33fb
--- /dev/null
+++ b/libio/tests/tiomisc.exp
@@ -0,0 +1,11 @@
+Test2: Bla bla bla 55 3.23
+Hello
+Line 2
+#include <fstream.h>
+line: Line one., count: 10
+line: 123456789, count: 10
+line: abcdefghi, count: 9
+line: jkl., count: 5
+reread_test: # #
+maybe deleted
+test_read_write_flush: the problem isn't showing itself.
diff --git a/libio/tests/tstdiomisc.c b/libio/tests/tstdiomisc.c
new file mode 100644
index 00000000000..cd8e88fd6ce
--- /dev/null
+++ b/libio/tests/tstdiomisc.c
@@ -0,0 +1,43 @@
+#ifndef STDIO_H
+#define STDIO_H <iostdio.h>
+#endif
+#include STDIO_H
+
+void
+t1 ()
+{
+ int n = -1;
+ sscanf ("abc ", "abc %n", &n);
+ printf ("t1: count=%d\n", n);
+}
+
+void
+t2 ()
+{
+ int n;
+ long N;
+ int retval;
+#define SCAN(INPUT, FORMAT, VAR) \
+ VAR = -1; \
+ retval = sscanf (INPUT, FORMAT, &VAR); \
+ printf ("sscanf (\"%s\", \"%s\", &x) => %d, x = %ld\n", \
+ INPUT, FORMAT, retval, (long)VAR);
+
+ SCAN ("12345", "%ld", N);
+ SCAN ("12345", "%llllld", N);
+ SCAN ("12345", "%LLLLLd", N);
+ SCAN ("test ", "%*s%n", n);
+ SCAN ("test ", "%2*s%n", n);
+ SCAN ("12 ", "%l2d", n);
+ SCAN ("12 ", "%2ld", N);
+}
+
+int
+main ()
+{
+ t1 ();
+ t2 ();
+
+ fflush (stdout);
+ return 0;
+}
diff --git a/libio/tests/tstdiomisc.exp b/libio/tests/tstdiomisc.exp
new file mode 100644
index 00000000000..b8ee02dcd6a
--- /dev/null
+++ b/libio/tests/tstdiomisc.exp
@@ -0,0 +1,8 @@
+t1: count=5
+sscanf ("12345", "%ld", &x) => 1, x = 12345
+sscanf ("12345", "%llllld", &x) => 0, x = -1
+sscanf ("12345", "%LLLLLd", &x) => 0, x = -1
+sscanf ("test ", "%*s%n", &x) => 0, x = 4
+sscanf ("test ", "%2*s%n", &x) => 0, x = -1
+sscanf ("12 ", "%l2d", &x) => 0, x = -1
+sscanf ("12 ", "%2ld", &x) => 1, x = 12
diff --git a/libio/testsuite/ChangeLog b/libio/testsuite/ChangeLog
new file mode 100644
index 00000000000..351cbb93dac
--- /dev/null
+++ b/libio/testsuite/ChangeLog
@@ -0,0 +1,49 @@
+Fri Jun 27 18:19:21 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * lib/libio.exp(libio_init): New procedure.
+ (test_libio): Link with a status wrapper if necessary. Strip
+ leading newlines before comparing output. Look for a multilib
+ libiberty directory.
+
+Tue Jun 3 15:17:31 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * lib/libio.exp: Don't use global exec_output variable; the output
+ is returned from remote_load instead.
+
+Tue May 20 17:59:31 1997 Jeffrey A Law (law@cygnus.com)
+
+ * lib/libio.exp: If "slow_simulator" is set, then add
+ -DSLOW_SIMULATOR to the compiler's arguments.
+
+Fri May 16 19:33:39 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * lib/libio.exp: Name the executables after the testcases.
+
+ * libio.tests/tiomisc.exp: Turn off warnings when conpiling.
+
+Thu May 1 17:01:47 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * lib/libio.exp: Link in libiberty.a.
+
+Tue Apr 29 16:34:37 1997 Mike Stump <mrs@cygnus.com>
+
+ * testsuite/lib/libio.exp: Fixup so that we always have the same
+ number of testcases, and so that we have meaningful testcase
+ names.
+
+Tue Apr 29 13:08:41 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * lib/libio.exp: Add support for --tool_opts.
+
+Mon Apr 28 11:26:06 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * Makefile.in: Removed clean rule, as it is added by configure.
+ Remove a lot of unused rules.
+
+Sun Apr 27 15:02:48 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * Makefile.in (clean): Add empty rule for now.
+
+Sat Apr 26 13:41:44 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * New DejaGnu-style testsuite.
diff --git a/libio/testsuite/Makefile.in b/libio/testsuite/Makefile.in
new file mode 100644
index 00000000000..3b88456da7b
--- /dev/null
+++ b/libio/testsuite/Makefile.in
@@ -0,0 +1,89 @@
+# Copyright (C) 1997 Free Software Foundation
+#
+# This file is part of the GNU IO 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.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU CC; see the file COPYING. If not, write to
+# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+srcdir = libio.tests
+
+CFLAGS = -g
+C_FLAGS = $(CFLAGS) -I. -I.. -I$(srcdir) -I$(srcdir)/..
+CXXFLAGS = -g
+CC = gcc
+CXX = gcc
+
+EXPECT = `if [ -f $${rootme}/../../expect/expect ] ; then \
+ echo $${rootme}/../../expect/expect ; \
+ else echo expect ; fi`
+
+RUNTEST = $(RUNTEST_FOR_TARGET)
+
+RUNTESTFLAGS =
+
+RUNTEST_FOR_TARGET = `\
+ if [ -f $${srcdir}/../../dejagnu/runtest ]; then \
+ echo $${srcdir}/../../dejagnu/runtest; \
+ else \
+ if [ "$(host_canonical)" = "$(target_canonical)" ]; then \
+ echo runtest; \
+ else \
+ t='$(program_transform_name)'; echo runtest | sed -e '' $$t; \
+ fi; \
+ fi`
+
+#### package, host, target, and site dependent Makefile fragments come in here.
+##
+
+# See ${MOSTLYCLEAN} in configure.in
+JUNK_TO_CLEAN = tFile tiomisc hounddog putbackdog tiomanip \
+ t?format *.out streamfile ftmp* tstdiomisc foo.dat
+
+.PHONY: info
+info:
+.PHONY: clean-info
+clean-info:
+.PHONY: install-info
+install-info:
+
+check: site.exp all just-check
+
+site.exp: ./config.status Makefile
+ @echo "Making a new config file..."
+ -@rm -f ./tmp?
+ @touch site.exp
+ -@mv site.exp site.bak
+ @echo "## these variables are automatically generated by make ##" > ./tmp0
+ @echo "# Do not edit here. If you wish to override these values" >> ./tmp0
+ @echo "# add them to the last section" >> ./tmp0
+ @echo "set host_alias $(host_alias)" >> ./tmp0
+ @echo "set host_triplet ${host_canonical}" >> ./tmp0
+ @echo "set target_alias $(target_alias)" >> ./tmp0
+ @echo "set target_triplet ${target_canonical}" >> ./tmp0
+ @echo "set build_triplet ${build_canonical}" >> ./tmp0
+ @echo "set srcdir ${srcdir}" >> ./tmp0
+ @echo "set tool libio" >> ./tmp0
+ @echo "## All variables above are generated by configure. Do Not Edit ##" >> ./tmp0
+ @cat ./tmp0 > site.exp
+ @cat site.bak | sed \
+ -e '1,/^## All variables above are.*##/ d' >> site.exp
+ -@rm -f ./tmp?
+
+just-check:
+ rootme=`pwd`; export rootme; \
+ srcdir=${srcdir} ; export srcdir ; \
+ EXPECT=${EXPECT} ; export EXPECT ; \
+ if [ -f $${rootme}/../../expect/expect ] ; then \
+ TCL_LIBRARY=$${srcdir}/../../tcl/library ; \
+ export TCL_LIBRARY ; fi ; \
+ $(RUNTEST) $(RUNTESTFLAGS)
diff --git a/libio/testsuite/config/default.exp b/libio/testsuite/config/default.exp
new file mode 100644
index 00000000000..90967cccc18
--- /dev/null
+++ b/libio/testsuite/config/default.exp
@@ -0,0 +1 @@
+load_lib "standard.exp"
diff --git a/libio/testsuite/configure.in b/libio/testsuite/configure.in
new file mode 100644
index 00000000000..f1bea6a866b
--- /dev/null
+++ b/libio/testsuite/configure.in
@@ -0,0 +1,21 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../../configure.
+
+configdirs=
+srctrigger=libio.tests/hounddog.exp
+srcname="test C++ input/output library, dejagnu style"
+package_makefile_frag=Make.pack
+
+# per-host:
+
+# per-target:
+
+TO_TOPDIR=../../
+ALL=' '
+XCINCLUDES='-I. -I.. -I$(srcdir) -I$(srcdir)/..'
+XCXXINCLUDES='-I. -I.. -I$(srcdir) -I$(srcdir)/..'
+MOSTLYCLEAN='*.o core $(JUNK_TO_CLEAN)'
+(. ${srcdir}/../config.shared) >${package_makefile_frag}
+
+# post-target:
diff --git a/libio/testsuite/lib/libio.exp b/libio/testsuite/lib/libio.exp
new file mode 100644
index 00000000000..22bd3b9c8ff
--- /dev/null
+++ b/libio/testsuite/lib/libio.exp
@@ -0,0 +1,164 @@
+# Copyright (C) 1997 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-lib-g++@prep.ai.mit.edu
+
+# This file was written by Bob Manson. (manson@cygnus.com)
+
+load_lib "libgloss.exp"
+
+global base_dir
+
+proc libio_init { args } {
+ global wrapper_file;
+ global wrap_compile_flags;
+ set wrapper_file "";
+ set wrap_compile_flags "";
+ if [target_info exists needs_status_wrapper] {
+ set result [build_wrapper "testglue.o"];
+ if { $result != "" } {
+ set wrapper_file [lindex $result 0];
+ set wrap_compile_flags [lindex $result 1];
+ } else {
+ warning "Status wrapper failed to build."
+ }
+ }
+}
+#
+# Run the test specified by srcfile and resultfile. compile_args and
+# exec_args are additional arguments to be passed in when compiling and
+# running the testcase, respectively.
+#
+
+proc test_libio { srcfile compile_args inpfile resultfile exec_args } {
+ global LIBIO
+ global srcdir subdir objdir
+ global TOOL_OPTIONS
+ global wrapper_file wrap_compile_flags;
+
+ if { $inpfile != "" } {
+ set inpfile "$srcdir/../tests/$inpfile"
+ }
+
+ set args ""
+ lappend args "additional_flags=-O3";
+ lappend args "additional_flags=-I.. -I$srcdir/.."
+ lappend args "additional_flags=$wrap_compile_flags";
+ lappend args "libs=$wrapper_file";
+ if { $compile_args != "" } {
+ lappend args "additional_flags=$compile_args"
+ }
+
+ if [regexp "\.cc$" $srcfile] {
+ lappend args "additional_flags=-nostdinc++"
+ lappend args "additional_flags=[g++_include_flags]";
+ lappend args "additional_flags=[g++_link_flags]";
+ lappend args "libs=-lstdc++"
+ } else {
+ if [info exists LIBIO] {
+ lappend args "libdir=$LIBIO"
+ } else {
+ lappend args "additional_flags=[libio_link_flags]";
+ }
+ lappend args "libs=-lio"
+ }
+
+ if [target_info exists slow_simulator] then {
+ lappend args "additional_flags=-DSLOW_SIMULATOR"
+ }
+
+ if [info exists TOOL_OPTIONS] {
+ lappend args "additional_options=$TOOL_OPTIONS"
+ }
+
+ set gp [get_multilibs];
+ if { $gp != "" } {
+ if [file exists $gp/libiberty/libiberty.a] {
+ lappend args "libdir=$gp/libiberty";
+ set found_libiberty 1;
+ }
+ }
+ if ![info exists found_libiberty] {
+ set lib [lookfor_file "$objdir" "libiberty/libiberty.a"];
+ if { $lib != "" } {
+ lappend args "libdir=[file dirname $lib]";
+ }
+ }
+ lappend args "libs=-liberty"
+ lappend args "debug";
+
+ set errname "$srcfile"
+ set srcfile "$srcdir/../tests/$srcfile"
+ regsub "\\..*$" "[file tail $srcfile]" "" executable
+ set executable "$objdir/$executable"
+
+ if { [target_compile $srcfile $executable executable $args] != "" } {
+ fail "$errname compilation $exec_args";
+ setup_xfail "*-*-*"
+ fail "$errname execution $exec_args"
+ if { $resultfile != "" } {
+ setup_xfail "*-*-*"
+ fail "$errname output $exec_args"
+ }
+ return;
+ }
+ pass "$errname compilation $exec_args"
+
+ set result [libio_load $executable $exec_args $inpfile];
+ set status [lindex $result 0];
+ set output [lindex $result 1];
+ if { $status == "unsupported" } {
+ unsupported "target does not support loading $srcfile"
+ return;
+ }
+ if { $status != "pass" } {
+ $status "$errname execution $exec_args"
+ setup_xfail "*-*-*"
+ fail "$errname output $exec_args"
+ return;
+ }
+ pass "$errname execution $exec_args"
+
+ if { $resultfile != "" } {
+ set id [open $srcdir/../tests/$resultfile r];
+ set expected ""
+ append expected [read $id];
+ verbose "expected is $expected"
+ verbose "actual is $output"
+ regsub -all "\r" $output "" output
+ regsub "\n+$" $expected "" expected
+ regsub "\n+$" $output "" output
+ regsub "^\n+" $expected "" expected
+ regsub "^\n+" $output "" output
+ if { $expected == $output } {
+ pass "$errname output $exec_args"
+ } else {
+ fail "$errname output $exec_args"
+ }
+ close $id;
+ }
+}
+
+#
+# libio_version -- extract and print the version number of libio
+#
+proc default_libio_version {} {
+ global LIBIO
+}
+
+proc default_libio_start { } {
+}
diff --git a/libio/testsuite/libio.tests/hounddog.exp b/libio/testsuite/libio.tests/hounddog.exp
new file mode 100644
index 00000000000..b51f9f0a4d3
--- /dev/null
+++ b/libio/testsuite/libio.tests/hounddog.exp
@@ -0,0 +1,3 @@
+test_libio hounddog.cc "" hounddog.inp hounddog.exp ""
+test_libio hounddog.cc "" hounddog.inp hounddog.exp "-b0"
+test_libio hounddog.cc "" hounddog.inp hounddog.exp "-b2"
diff --git a/libio/testsuite/libio.tests/putbackdog.exp b/libio/testsuite/libio.tests/putbackdog.exp
new file mode 100644
index 00000000000..30d91a8a5b8
--- /dev/null
+++ b/libio/testsuite/libio.tests/putbackdog.exp
@@ -0,0 +1,3 @@
+test_libio putbackdog.cc "" hounddog.inp hounddog.exp ""
+test_libio putbackdog.cc "" hounddog.inp hounddog.exp "-b0"
+test_libio putbackdog.cc "" hounddog.inp hounddog.exp "-b2"
diff --git a/libio/testsuite/libio.tests/tFile.exp b/libio/testsuite/libio.tests/tFile.exp
new file mode 100644
index 00000000000..f190916d863
--- /dev/null
+++ b/libio/testsuite/libio.tests/tFile.exp
@@ -0,0 +1,3 @@
+test_libio tFile.cc "" tFile.inp tFile.exp ""
+test_libio tFile.cc "" tFile.inp tFile.exp "-b0"
+test_libio tFile.cc "" tFile.inp tFile.exp "-b3"
diff --git a/libio/testsuite/libio.tests/tfformat.exp b/libio/testsuite/libio.tests/tfformat.exp
new file mode 100644
index 00000000000..f0f7113c319
--- /dev/null
+++ b/libio/testsuite/libio.tests/tfformat.exp
@@ -0,0 +1 @@
+test_libio tfformat.c "-DTEST_LIBIO -DTEST_EXACTNESS" "" "" ""
diff --git a/libio/testsuite/libio.tests/tiformat.exp b/libio/testsuite/libio.tests/tiformat.exp
new file mode 100644
index 00000000000..f2d14db5236
--- /dev/null
+++ b/libio/testsuite/libio.tests/tiformat.exp
@@ -0,0 +1 @@
+test_libio tiformat.c "-DTEST_LIBIO" "" "" ""
diff --git a/libio/testsuite/libio.tests/tiomanip.exp b/libio/testsuite/libio.tests/tiomanip.exp
new file mode 100644
index 00000000000..856cefc3cd0
--- /dev/null
+++ b/libio/testsuite/libio.tests/tiomanip.exp
@@ -0,0 +1 @@
+test_libio tiomanip.cc "" "" tiomanip.exp ""
diff --git a/libio/testsuite/libio.tests/tiomisc.exp b/libio/testsuite/libio.tests/tiomisc.exp
new file mode 100644
index 00000000000..71309951bb0
--- /dev/null
+++ b/libio/testsuite/libio.tests/tiomisc.exp
@@ -0,0 +1 @@
+test_libio tiomisc.cc "-w" "" tiomisc.exp ""
diff --git a/libio/testsuite/libio.tests/tstdiomisc.exp b/libio/testsuite/libio.tests/tstdiomisc.exp
new file mode 100644
index 00000000000..01dae9ffe1a
--- /dev/null
+++ b/libio/testsuite/libio.tests/tstdiomisc.exp
@@ -0,0 +1 @@
+test_libio tstdiomisc.c "" "" tstdiomisc.exp ""
diff --git a/libstdc++/ChangeLog b/libstdc++/ChangeLog
new file mode 100644
index 00000000000..48eb5543a18
--- /dev/null
+++ b/libstdc++/ChangeLog
@@ -0,0 +1,823 @@
+Wed Jul 30 10:59:00 1997 Benjamin Kosnik <bkoz@rhino.cygnus.com>
+
+ * stlinst.cc: Add instantiation file for
+ __default_alloc_template<fale, 0> and
+ __malloc_alloc_template<0>
+
+Sun Jun 1 17:03:40 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/bastring.cc (find_last_of): Correct handling of POS.
+ (find_last_not_of): Likewise.
+
+Thu May 1 17:37:10 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in ($(SHLIB)): Add $(LIBCXXFLAGS).
+
+Wed Apr 30 12:06:23 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (IO_DIR): Remove $(MULTIBUILDTOP).
+ (LIBIBERTY_DIR): Likewise.
+ * configure.in: Don't turn on multilib here.
+
+Fri Apr 25 16:09:15 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * testsuite/libstdc++.tests/test.exp, testsuite/lib/libstdc++.exp,
+ testsuite/configure.in, testsuite/Makefile.in,
+ testsuite/config/default.exp, testsuite/ChangeLog: New files.
+
+ * configure.in: Add new testsuite directory to be configured.
+
+Tue Apr 22 19:03:39 1997 Alexandre Oliva <oliva@dcc.unicamp.br>
+
+ * Makefile.in (install): Fix handling of mshlink.
+
+Fri Apr 4 03:25:13 1997 Ulrich Drepper <drepper@cygnus.com>
+
+ * Makefile.in (IO_DIR): Prepend $(MULTIBUILDTOP) to
+ support multilib build.
+ (LIBIBERTY_DIR): Likewise.
+
+ * configure.in: Enable multilibing by default.
+ Update multilib template to read config-ml.in.
+
+Wed Mar 12 16:09:34 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure.in (XCXXINCLUDES): Add the STL directory.
+
+Thu Jan 23 08:08:43 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * stdexcept: Delete dtors for all of the error classes, to match
+ their removal in the Apr 1995 WP.
+ (class overflow_error): Define missing class, added in May 1996 WP.
+
+Mon Nov 18 16:57:25 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (stuff[12]): More rules for my own evil purposes.
+ (CXXFLAGS, CFLAGS): Use -O instead of -O3 so debugging works.
+
+Wed Oct 16 13:47:45 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config/irix5.ml: Do link against the math library.
+ * configure.in: Support shared libs on Irix 6.
+
+Fri Oct 11 18:06:09 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config/linux.ml: Lose version overrides.
+
+ * Makefile.in (MSHLINK): Defaults to .so.2.x
+ (mshlink): Indirect rule for making it.
+
+Tue Sep 24 17:58:31 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Remove new, typeinfo, exception, stddef*.
+ * Move public headers from std/*.h to *.
+
+Sun Sep 22 05:35:55 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in: Remove new, exception, typeinfo handling.
+ * exceptioni.cc, newi.cc, typeinfoi.cc, std/exception.h, std/new.h,
+ std/typeinfo.h, new.h: Remove.
+ * typeinfo, new, exception: Refer to the files with .h in gcc.
+
+Fri Sep 20 14:39:19 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in: Remove references to stl.list.
+ * configure.in (configdirs): Remove stl.
+
+Sat Sep 14 09:42:08 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (stuff): Convenience for me.
+
+ * std/bastring.h: Remove kludge obsoleted by new overloading code.
+
+Fri Sep 6 16:43:21 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * typeinfoi.cc (__dynamic_cast): Fix static_cast.
+ (__rtti_si): Likewise.
+ (dcast): Likewise.
+
+Thu Aug 29 17:06:23 1996 Michael Meissner <meissner@tiktok.cygnus.com>
+
+ * configure.in (i[345]86-*-*): Recognize i686 for pentium pro.
+
+Tue Jul 23 14:27:44 1996 Mike Stump <mrs@cygnus.com>
+
+ * Makefile.in (exceptioni.o): Use -fexceptions now.
+
+Mon Jun 17 13:57:24 1996 Per Bothner <bothner@deneb.cygnus.com>
+
+ * std/bastring.h (class basic_string::remove): Add casts.
+
+ * configure.in: Use EXTRA_DISTCLEAN rather than DISTCLEAN.
+
+Fri Jun 7 14:09:20 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * typeinfoi.cc (BUILTIN): Align typeinfo object like a pointer.
+
+Wed May 29 16:48:35 1996 Mike Stump <mrs@cygnus.com>
+
+ * exceptioni.cc (__throw_bad_exception): Add.
+ * std/exception.h (bad_exception): Add.
+ * std/typeinfo.h: Remove leftovers of bad_cast_object.
+
+Mon May 6 14:04:42 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/complext.h: s/FLOAT/_FLT/g.
+
+Thu May 2 17:26:24 1996 Mike Stump <mrs@cygnus.com>
+
+ * exceptioni.cc (uncaught_exception): New routine.
+ * std/exception.h: Declare it.
+
+Thu Apr 25 13:20:57 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (typeinfoi.o, stdexcepti.o): Use default rule.
+
+Wed Apr 24 18:38:24 1996 Mike Stump <mrs@cygnus.com>
+
+ * exceptioni.cc: Add #pragma implementation.
+ * std/exception.h: Add #pragma interface. Moved exception from
+ stdexcept.
+ * std/stdexcept.h: Moved exception to exception. Fix all constructor
+ arguments to take strings to match ANSI. Moved bad_cast and bad_typeid
+ to typeinfo.
+ * std/typeinfo.h: Moved bad_cast and bad_typeid from stdexcept.
+
+Wed Apr 24 10:43:07 1996 Doug Evans <dje@blues.cygnus.com>
+
+ * Makefile.in (newi.o,cstringi.o,stddefi.o,cstdlibi.o,cmathi.o): Add
+ rules for SunOS VPATH.
+
+Fri Apr 19 17:24:51 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Version 2.8.0b3.
+
+Wed Apr 10 14:38:05 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * typeinfoi.cc (base_info): Pack the latter three fields into 32 bits.
+
+Tue Apr 9 15:49:38 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * typeinfoi.cc: Add 'const'.
+ (__class_type_info): Now just one pointer to an array of structs,
+ rather than four pointers to arrays.
+
+ * typeinfoi.cc (__throw_type_match_rtti): Check for conversion to
+ void* before conversion to base*.
+ (dcast): Handle downcasting to X* given other X subobjects in
+ the most derived type. Ack.
+
+Mon Apr 8 15:20:32 1996 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Permit --enable-shared to specify a list of
+ directories.
+
+Sun Apr 7 22:50:53 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * typeinfoi.cc (__rtti_array): New entry point.
+
+Sat Apr 6 14:41:18 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * exceptioni.cc (__throw_bad_cast): New entry point for compiler.
+ * typeinfoi.cc: Remove __bad_cast_object.
+
+ * typeinfoi.cc: Add nodes for unsigned builtins.
+
+Fri Apr 5 18:16:22 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * typeinfoi.cc, std/typeinfo.h: Total overhaul. Move most
+ everything out of the header, move name field into type_info, add
+ single-inheritance case, rewrite pointer handling, add new
+ compiler interface. Compare addresses to check for equality.
+
+Wed Mar 27 11:54:08 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Version 2.8.0b2.
+
+Fri Mar 8 13:56:18 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/[cs]inst.h: Remove.
+
+Thu Mar 7 07:29:00 1996 Lee Iverson <leei@Canada.AI.SRI.COM>
+
+ * Makefile.in (install): Restore deleted chdir to stl subdir.
+
+Thu Mar 7 15:02:58 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/complext.h: Fix __attribute__ usage.
+
+Wed Feb 28 10:00:24 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Version 2.8.0b1.
+
+Mon Feb 26 17:26:26 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/cstring.h: New approach to changing signatures of string
+ manipulation functions. Still disabled.
+
+Tue Feb 20 18:29:30 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/complext.h (__doapl, __doami, __doaml, __doadv): Helper
+ templates to implement +=, -=, *= and /=, respectively, since
+ member function templates do not apply to class specializations.
+ * std/{f,d,ld}complex.h, std/complext.cc, cinst.cc: Adjust.
+
+ * std/bastring.h: The representation class is now a nested class.
+ * std/bastring.cc: Add templates for static data members.
+ * sinst.cc: Don't provide specializations for static data members.
+ * std/string.h: Use default template parameters.
+
+ * Makefile.in (CXXFLAGS): Remove -pedantic -ansi.
+ (CFLAGS): Ditto.
+
+Wed Feb 14 14:39:07 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/bastring.cc (check_realloc): Fix for sizeof (charT) > 1.
+ From John Hickin <hickin@bnr.ca>.
+
+Wed Jan 10 11:05:04 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/bastring.h (insert): Fix iterator handling.
+ From Joe Buck <jbuck@synopsys.com>.
+
+Mon Jan 8 11:48:03 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/bastring.h (max_size): Fix for sizeof (charT) > 1.
+ * std/bastring.cc (replace): Use it.
+
+ * std/bastring.cc (rfind): Fix for n > length ().
+
+Tue Dec 19 15:13:08 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config/aix.ml (SHFLAGS): Add -Wl,-unix.
+
+Mon Dec 18 12:48:25 1995 Mike Stump <mrs@cygnus.com>
+
+ * Makefile.in (exceptioni.o): Compile with -fhandle-exceptions, so
+ we can unwind through unexpected on machines that don't have a
+ working __unwind_function.
+
+Sun Dec 17 00:28:31 1995 Jeffrey A Law (law@cygnus.com)
+
+ * Makefile.in (install): Make sure shared libraries
+ are installed with mode 555.
+
+Mon Nov 27 15:01:56 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (install): Make shared library links relative.
+ (install): Break up -sf into -s -f.
+ ({M,}SHLINK): Ditto.
+
+Sun Nov 26 22:48:06 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * queue: Include <stack.h> instead of <queue.h>.
+
+Sat Nov 25 11:33:13 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (install): Fix setting of rootme.
+
+Tue Nov 21 14:20:34 1995 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Check ${with_cross_host} rather than comparing
+ ${host} and ${target}.
+
+Tue Nov 14 01:50:52 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (IO_DIR): Delete MULTITOP, MULTISUBDIR.
+ (LIBIBERTY_DIR): Likewise.
+ (INSTALLDIR): Delete MULTISUBDIR.
+ * configure.in: Delete call to cfg-ml-com.in. Call config-ml.in
+ instead of cfg-ml-pos.in.
+ (XCXXINCLUDES): Delete MULTITOP.
+ * stl/configure.in (XCXXINCLUDES): Delete MULTITOP.
+ (config-ml.in): Call instead of cfg-ml-pos.in.
+
+Sun Nov 12 16:44:25 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in (VERSION): Set to 2.7.1.
+
+Thu Nov 9 17:39:28 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * config/{aix,dec-osf,irix5,linux,sol2shm}.ml: Remove LDLIBS defn;
+ no longer needed now that make check sets LD_LIBRARY_PATH.
+
+Wed Nov 8 19:46:35 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * std/bastring.h: Wrap with #ifndef/#define/#endif.
+ * std/cassert.h: Likewise.
+ * std/cinst.h: Likewise.
+ * std/complext.h: Likewise.
+ * std/dcomplex.h: Likewise.
+ * std/fcomplex.h: Likewise.
+ * std/ldcomplex.h: Likewise.
+ * std/sinst.h: Likewise.
+
+Wed Nov 8 16:15:48 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/bastring.cc (getline): Update to September 95 WP. Now we
+ don't set failbit when reading an empty line.
+
+Tue Nov 7 16:09:04 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/bastring.cc (new): Fix for sizeof (charT) != 1.
+
+Sat Nov 4 17:37:16 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/complext.cc (operator / (FLOAT, const complex<FLOAT>&)):
+ Reimplement along the lines of the other operator / templates.
+ From John Eaton <jwe@bevo.che.wisc.edu>.
+
+Sat Nov 4 13:33:50 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in (DISTCLEAN): New, to add target-mkfrag.
+
+Tue Oct 31 13:59:32 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * std/bastring.h: Use size_t for the reference count.
+ * std/bastring.cc (create): Set selfish.
+ From Joe Buck (jbuck@synopsys.com).
+
+Mon Oct 30 23:09:48 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in: Don't bother changing LIBIBERTY for cross,
+ now that we are using target-libiberty instead.
+ * Makefile.in (LIBIBERTY_DIR): Simplify.
+ (LIBIBERTY): Remove.
+
+Wed Oct 11 14:56:49 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * config/sol2shm.ml: New files with -rpath.
+ * configure (*-*-solaris*): Use sol2shm.ml.
+
+Thu Sep 28 09:26:52 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/straits.h (compare, copy, move, set): Fix for non-char charT's.
+ * std/bastring.h (basic_string::remove): Fix for non-char charT's.
+
+Tue Sep 26 15:22:56 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config/irix5.ml: Pass -rpath to links.
+
+Fri Sep 15 00:17:47 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config/linux.ml: Conform to Linux shared library numbering
+ scheme.
+ * Makefile.in: Ditto.
+
+Tue Sep 12 00:28:56 1995 Mike Stump <mrs@cygnus.com>
+
+ * typeinfoi.cc: (__pointer_type_info::__rtti_match): Moved from
+ the headerfile, include all sorts of pointer conversions from 15.3
+ para 2.
+ * std/typeinfo.h (__pointer_type_info::__rtti_match): Moved from here.
+
+Mon Sep 11 23:27:59 1995 Mike Stump <mrs@cygnus.com>
+
+ * std/typeinfo.h (__pointer_type_info::__rtti_match): We no longer
+ have to dereference the object pointer, as the pointer is always
+ passed directly.
+
+Mon Sep 11 19:29:51 1995 Mike Stump <mrs@cygnus.com>
+
+ * std/typeinfo.h (__pointer_type_info::__rtti_match): Define so
+ that pointer conversions can happen on catch type matching.
+ * typeinfoi.cc (__throw_type_match_rtti): Arrange for __rtti_match
+ to be used on pointers.
+
+Tue Sep 5 14:49:19 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * string.h: Remove for now.
+
+Thu Aug 31 14:14:01 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.cc (operator>>): Simplify and fix.
+ (resize): Fix order of arguments to append.
+ (getline): Simplify and fix.
+
+Thu Aug 24 17:44:09 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/cstdlib.h (abs): Provide default implementation for peons
+ without labs.
+
+Tue Aug 22 08:43:07 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/cstdlib.h: Comment out definition of div(long,long) for now,
+ since not all targets have ldiv.
+
+Mon Aug 21 11:46:03 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/cmath.h: Wrap abs(double) with #if ! _G_MATH_H_INLINES.
+
+ * stl.h: Add, for compatibility with ObjectSpace STL.
+
+ * std/complext.cc (operator /): Use abs instead of fabs.
+
+ * std/bastring.h (replace): Update single-character replace method
+ as per my proposal.
+
+ * std/cmath.h: Add abs(float), abs(double) and abs(long double).
+ Add commented-out declarations for other float and long double
+ math functions.
+
+ * std/cstdlib.h: Add abs(long) and div(long,long).
+
+ * Makefile.in (install): Make shared library executable and
+ non-writable. Tidy.
+ (OBJS): Add cstdlibi.o and cmathi.o.
+
+ * Rename implementation files to have different basenames.
+
+Mon Aug 21 00:57:03 1995 Jeffrey A. Law <law@rtl.cygnus.com>
+
+ * Makefile.in (install): Use "cd stl"; no need for $(srcdir)
+ prefix because we're already in $(srcdir).
+
+Tue Jul 25 18:41:29 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * std/stddef.h: Remove obsolete definition of enum capacity.
+
+Sat Jul 22 13:37:01 1995 Doug Evans <dje@canuck.cygnus.com>
+
+ * Makefile.in (IO_DIR): Add multilib support.
+ (LIBIBERTY, LIBIBERTY_OBJS, INSTALLDIR, stdlist): Likewise.
+ (libiberty.a, install): Likewise.
+ * configure.in: Likewise.
+ (XCXXINCLUDES): Likewise.
+ * stl/configure.in: Likewise.
+ (XCXXINCLUDES): Likewise.
+
+Mon Jul 17 09:29:31 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * Makefile.in (typeinfo.o, stdexcept.o): Put an else for the if
+ stmt checking PICFLAG.
+ (stmp-string, bigstmp-string, stmp-complex, bigstmp-complex): Likewise.
+
+Wed Jun 28 17:05:29 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/*.h: Wrap with extern "C++".
+
+ * std/ciso646.h: Don't worry about #undefing the keywords.
+
+Mon Jun 26 19:05:38 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.h (operator!=): If they've included the STL
+ function.h, don't overload the operator templates that it defines.
+
+Fri Jun 23 16:54:17 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (SHLINK): Force link.
+ (install): Ditto.
+
+ * std/bastring.h (terminate): Never reallocate.
+ (alloc): No longer const.
+
+ * std/bastring.cc (create): Always allocate an extra byte.
+ (check_realloc): Always leave room for an extra byte.
+ (*find*): Add missing 'const'.
+
+ * Makefile.in (SHARLIB): Provide a default value.
+
+Tue Jun 20 16:29:52 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/cstring.h: Don't bother tweaking prototypes for now. When
+ we do, we will use new-style casts.
+
+Fri Jun 16 13:57:53 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (VERSION): Update to 2.7.0.
+
+ * config/aix.ml: Build both shared and archive libraries.
+
+Wed Jun 14 21:44:21 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * configure.in (frags): Use linux.ml for Linux/ELF.
+ * config/linux.ml: New file.
+
+Wed Jun 14 17:56:23 1995 Niclas Andersson <nican@ida.liu.se>
+
+ * configure.in: Use xiberty when building cross-compiler.
+
+Wed Jun 14 12:57:47 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/*complex*, std/cinst.h, cinst.cc: Pass by reference to const
+ rather than by value.
+ * std/*complex*: Add member functions real() and imag().
+
+Sat Jun 10 12:14:38 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (bigstmp-string): Call main string object cstrmain.o
+ instead of cstring.o.
+
+Wed Jun 7 11:15:15 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/cstring.h: Use #include_next to pick up <string.h>.
+
+ * string.h: New file.
+
+ * Makefile.in (MOSTLYCLEAN_JUNK): Remove piclist.
+
+ * configure.in (MOSTLYCLEAN): Remove stamp-picdir.
+
+Mon Jun 5 18:36:39 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config/*.ml: Build both shared and archive libraries.
+
+ * configure.in (MOSTLYCLEAN): Remove pic.
+ (frags): Use toplevel pic frags.
+
+ * Makefile.in (piclist): New rule.
+ (SHLIB): Use it.
+ (stl.list): Removed.
+ (typeinfo.o): Also build pic version.
+ (stdexcept.o): Ditto.
+ (*stmp-*): Ditto.
+
+Tue May 30 12:01:14 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/{complext,{f,d,ld}complex}.h: To declare specializations,
+ use friend declarations in the class body...
+ * std/cinst.h: ...rather than macro hackery.
+
+ * Makefile.in (stdlist): Renamed from list.
+
+ * cstdarg: Don't define __CSTDARG__.
+ * complex.h: Similarly.
+
+Tue May 9 19:31:20 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.cc (operator>>): Use an int to store the return value
+ of streambuf::sbumpc.
+ (getline): Ditto.
+ * std/bastring.* (replace): Reverse size_t and charT arguments.
+
+ * configure.in (enable_shared): Support enable_shared under AIX.
+
+ * Makefile.in (SHARLIB): New variable and rule for building an
+ archive library containing a single shared object (for AIX).
+
+Mon May 8 01:43:19 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.h (remove): Forgot one.
+ (empty): And this.
+ Disable copy-on-write if someone takes an iterator.
+
+ * std/bastring.cc (getline): Avoid resizing down if unnecessary.
+ (operator>>): Don't use private methods.
+
+Sun May 7 02:39:56 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.h (insert, replace): Fix.
+ * std/bastring.cc (find_*_of): Fix.
+
+Fri May 5 01:45:10 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.h: Add iterator remove fn. Remove evil default
+ arguments.
+
+ * std/*complex*, std/cinst.h, cinst.cc: s/__complex/complex/g.
+ complex<float> is now specialized. Lose _*_complex in favor of
+ 'explicit' constructors.
+ * std/complex.h: Lose typedef of complex.
+ * std/fcomplex.h: New file.
+ * std/complext.cc (operator<<): Accept more input forms.
+
+ * std/bastring.h: Add iterator insert fns.
+
+Thu May 4 02:30:04 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.*: Update to current draft.
+
+ * std/bastring.*: Reorganize so that the pointer in a string
+ object points to the data rather than the bsrep object, for
+ debugging.
+
+Tue Apr 25 17:15:09 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * configure.in: Update to stay in sync with config.shared.
+
+Mon Apr 24 13:08:46 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/complext.h: Declare hypot. Declare appropriate functions const.
+
+Wed Apr 12 15:26:25 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (typeinfo.o): Don't use $<.
+ (stdexcept.o): Ditto.
+
+Sat Apr 8 15:35:00 1995 Mike Stump <mrs@cygnus.com>
+
+ * std/typeinfo.h: Move bad_cast, bad_typeid and __bad_cast_object
+ from here to stdexcept.
+ * std/stdexcept.h: Ditto.
+ * Makefile.in (stdexcept.o): Added rule to build typeinfo.o with
+ -frtti to support matching of thrown objects with rtti info for
+ bad_cast.
+
+Mon Apr 3 18:13:14 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * typeinfo: New file.
+
+ * Makefile.in (HEADERS): Add typeinfo.
+
+Mon Apr 3 15:06:58 1995 Mike Stump <mrs@cygnus.com>
+
+ * Makefile.in (typeinfo.o): Added rule to build typeinfo.o with
+ -frtti to support matching of thrown objects with rtti info for
+ bad_cast.
+
+Wed Mar 29 15:56:06 1995 Mike Stump <mrs@cygnus.com>
+
+ * typeinfo.cc: (__throw_type_match_rtti): Added to support
+ matching of thrown objects with rtti info.
+
+Thu Mar 23 18:42:30 1995 Jason Merrill <jason@deneb.cygnus.com>
+
+ * Makefile.in (HEADERS): Add stdexcept.
+
+Sun Mar 12 01:25:27 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/typeinfo.h: Add return statements to dummy methods.
+
+Wed Mar 8 16:09:50 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * config/dec-osf.ml: Use -rpath flag.
+
+Fri Feb 17 18:16:46 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/typeinfo.h: Add copyright header.
+
+ * Makefile.in (CXXFLAGS): Add a bunch of warning options to keep
+ me honest.
+
+Thu Feb 16 00:04:49 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in, config/*.ml: Generate shared library on most hosts
+ as libstdc++.so.$(VERSION), with a symlink to libstdc++.so, so that
+ multiple versions can coexist.
+
+Fri Feb 10 02:59:39 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/exception.h: {set_,}{terminate,unexpected} have C++ linkage.
+
+ * Makefile.in: Allow string and complex to be split up either by
+ individual function or into I/O and non-I/O. Default to the
+ latter.
+
+Wed Feb 8 02:39:47 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.h: Start thinking about throwing exceptions.
+
+ * typeinfo.cc: Remove private functions; defining them to call
+ abort () just delays errors until runtime. Define
+ __bad_cast_object.
+
+ * std/exception.h: Standard exceptions are now defined in
+ stdexcept.h. This header now contains declarations of terminate()
+ et al.
+ * exception.cc: Move code from libg++/src/except.c here.
+ * std/typeinfo.h: Define RTTI-related exceptions here.
+ * stdexcept{,.cc},std/stdexcept.h: New files.
+
+Mon Feb 6 18:51:31 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (HEADERS): Resurrect, add new STL header names.
+ (install): Install extensionless headers again.
+ * extensionless headers: Resurrect, add new STL headers.
+ Currently only forward to std/whatever or stl/whatever.
+
+Mon Jan 30 13:53:22 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.h (basic_string (charT, size_t)): Mark explicit.
+
+ * Makefile.in (install): Set rootme when installing stl headers.
+ Only install *.* from std.
+
+Wed Jan 25 02:29:30 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * std/bastring.h (operator=): grab before releasing.
+
+Mon Jan 23 19:54:02 1995 Ronald F. Guilmette <rfg@segfault.us.com>
+
+ * Makefile.in (install): Also install STL headers.
+
+Mon Jan 23 04:09:35 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * Makefile.in (list): Set $rootme before calling make.
+
+Wed Jan 11 19:24:47 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * typeinfo.cc (__rtti_match): Don't try to do pointer arithmetic
+ with a void *.
+
+ * move all headers into std subdirectory and update files accordingly.
+
+Thu Jan 5 01:51:49 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * bastring.ccI (basic_string (size_t, capacity)): s/reserve/::reserve/.
+
+Wed Jan 4 17:27:32 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * exception: s/string/__string/g.
+
+ * configure.in (MOSTLYCLEAN): Add so_locations.
+
+ * bastring.ccI (basic_string (size_t, capacity)): Fix thinko.
+ (various find functions): Ditto.
+
+Fri Dec 30 18:04:00 1994 Mike Stump <mrs@cygnus.com>
+
+ * typeinfo.h: Add support for the built-in type bool.
+
+Fri Dec 30 14:57:02 1994 Mike Stump <mrs@cygnus.com>
+
+ * typeinfo.{cc, h}: Guard against multiple inclusions, and add #p i/i.
+
+Fri Dec 2 17:56:05 1994 Mike Stump <mrs@cygnus.com>
+
+ * libg++ 2.6.2 released.
+
+ * typeinfo.{cc, h} (__rtti_match): Change interface to compiler
+ for dynamic_casting to gear up for exception handling's use of
+ rtti for argument matching.
+
+Tue Nov 29 16:49:32 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in (configdirs): Add stl.
+ * Makefile.in: Build stl, and merge .o files from it.
+
+Thu Nov 17 15:30:57 1994 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * bastring.hI: Add iterator, const_iterator, begin() and end() to
+ basic_string.
+
+Mon Nov 7 16:50:33 1994 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in, configure.in, config/*.ml, tests/Makefile.in,
+ tests/configure.in: Various changes to handle --enable-shared.
+
+Fri Nov 4 19:13:33 1994 Mike Stump <mrs@cygnus.com>
+
+ * exception{,.cc}: Added to support catching bad_cast's.
+
+Thu Nov 3 17:42:13 1994 Mike Stump <mrs@cygnus.com>
+
+ * typeinfo.h (type_info::{name, before}): Add to match draft.
+
+Thu Nov 3 00:56:34 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * Makefile.in (LIBIBERTY_OBJS): Add strerror.o.
+
+Mon Oct 31 15:33:06 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * typeinfo.cc: Fix a bug in the final return.
+ * typeinfo.cc: Fix the ANSI header version number.
+ * typeinfo.h: ditto.
+
+Fri Oct 28 14:23:12 1994 Mike Stump <mrs@cygnus.com>
+
+ * type_info.{cc,h}: Rename to typeinfo to better match current draft.
+
+Wed Oct 26 11:13:53 1994 Kung Hsu (kung@mexican.cygnus.com)
+
+ * type_info.h: new header file for rtti.
+ * type_info.cc: new code file for rtti.
+ * Makefile.in: change to include type_info.o in libstdc++ for rtti.
+
+Sat Oct 15 16:09:51 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * libg++ 2.6.1 released.
+
+ * cinst.hI: Also declare instantiations of out-of-line functions.
+
+Fri Oct 14 15:00:09 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * configure.in (CXXINCLUDES): Use {} to wrap variable name.
+ * tests/configure.in (CXXINCLUDES): Ditto.
+
+ * cinst.hI: Declare instantiations of two-argument functions so
+ overload resolution will work.
+ * complext.hI: Always include cinst.hI.
+
+ * bastring.ccI (operator>>): Tweak.
+
+Tue Oct 11 17:07:49 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * stddef*: Do the #pragma i/i thang.
+
+ * bastring.hI (basic_string::put_at): Use operator[].
+ (basic_string::terminate): Don't necessarily copy the rep.
+
+ * bastring.ccI (operator>>): Avoid shrinking and then re-expanding
+ the string.
+
+ * bastring.*I, sinst.cc: Only allow allocation policy control if
+ _G_ALLOC_CONTROL is defined.
+
+ * Makefile.in (libstdc++.a): Depend on iostream.list and libiberty.a.
+ (../libio/iostream.list): New rule.
+ (../libiberty/libiberty.a): New rule.
+ (OBJS): Add stddef.o.
+
+Sat Oct 8 23:59:45 1994 Jason Merrill (jason@phydeaux.cygnus.com)
+
+ * *: First checkin.
diff --git a/libstdc++/Makefile.in b/libstdc++/Makefile.in
new file mode 100644
index 00000000000..0858516fda5
--- /dev/null
+++ b/libstdc++/Makefile.in
@@ -0,0 +1,307 @@
+# Copyright (C) 1994, 1995 Free Software Foundation
+
+# This file is part of the GNU ANSI C++ 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.
+
+# 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this library; see the file COPYING. If not, write to the Free
+# Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+VERSION = 2.8.0
+
+OBJS = cstringi.o stdexcepti.o cstdlibi.o cmathi.o stlinst.o
+SUBLIBS = $(STAMP)-string $(STAMP)-complex
+
+# C++ headers with no extension
+HEADERS= cassert cctype cerrno cfloat ciso646 climits clocale cmath complex \
+ csetjmp csignal cstdarg cstddef cstdio cstdlib cstring ctime \
+ cwchar cwctype string stdexcept \
+ algorithm deque list map queue set stack vector utility functional \
+ iterator memory numeric
+
+ARLIB = libstdc++.a
+SHLIB = libstdc++.so.$(VERSION)
+SHARLIB = libstdc++-sh.a
+SHLINK = libstdc++.so
+MSHLINK = libstdc++.so.`echo $(VERSION) | sed 's/\([0-9][.][0-9]\).*/\1/'`
+SHFLAGS =
+SHDEPS =
+
+STAMP = bigstmp
+
+LIBS = $(ARLIB)
+
+#### package, host, target, and site dependent Makefile fragments come in here.
+##
+
+IO_DIR = ../libio
+LIBIBERTY_DIR = ../libiberty
+
+LIBIBERTY_OBJS = `cat $(LIBIBERTY_DIR)/needed-list` strerror.o
+
+tooldir = $(exec_prefix)/$(target)
+INSTALLDIR = $(libdir)
+
+MOSTLYCLEAN_JUNK = *stmp-* tlib*.a *.s *.ii stdlist piclist
+CLEAN_JUNK = $(LIBS)
+
+# Remove these for public releases.
+CXXFLAGS = -g -O -Wpointer-arith -Wnested-externs -Woverloaded-virtual -Wbad-function-cast -Winline -Wwrite-strings
+CFLAGS = -g -O -Wpointer-arith -Wnested-externs
+
+.PHONY: libs
+libs: $(LIBS)
+
+stdlist: $(IO_DIR)/iostream.list $(OBJS) $(SUBLIBS) $(LIBIBERTY_DIR)/libiberty.a
+ -rm -f tlist
+ touch tlist
+ echo *.o >> tlist
+ for f in `cat $(IO_DIR)/iostream.list` ; do \
+ echo "$(IO_DIR)/$$f" >> tlist ; \
+ done
+ for f in $(LIBIBERTY_OBJS) ; do \
+ echo "$(LIBIBERTY_DIR)/$$f" >> tlist ; \
+ done
+ mv tlist stdlist
+
+piclist: stdlist
+ -rm -f tlist
+ cp stdlist tlist
+ if [ -n "$(PICFLAG)" ]; then \
+ sed 's,\([A-Za-z_]*\.o\),pic/\1,g' tlist > tlist2 ; \
+ mv tlist2 tlist ; \
+ else true ; fi
+ mv tlist piclist
+
+$(ARLIB): stdlist
+ -rm -f t$(ARLIB)
+ $(AR) $(AR_FLAGS) t$(ARLIB) `cat stdlist`
+ mv t$(ARLIB) $(ARLIB)
+ $(RANLIB) $(ARLIB)
+
+$(SHLIB): piclist
+ $(CXX) $(LIBCXXFLAGS) $(SHFLAGS) -shared -o $(SHLIB) `cat piclist` $(SHDEPS)
+
+$(SHARLIB): $(SHLIB)
+ -rm -f t$(SHARLIB)
+ $(AR) $(AR_FLAGS) t$(SHARLIB) $(SHLIB)
+ mv t$(SHARLIB) $(SHARLIB)
+ $(RANLIB) $(SHARLIB)
+
+$(SHLINK):
+ ln -s -f $(SHLIB) $(SHLINK)
+
+mshlink:
+ @$(MAKE) $(MSHLINK) "SHLINK=$(MSHLINK)"
+
+$(IO_DIR)/iostream.list: force
+ cd $(IO_DIR) ; $(MAKE) $(FLAGS_TO_PASS) iostream.list
+
+$(LIBIBERTY_DIR)/libiberty.a:
+ cd $(LIBIBERTY_DIR) ; $(MAKE) $(FLAGS_TO_PASS)
+
+STRFUNCS = REP MAIN TRAITS ADDSS ADDPS ADDCS ADDSP ADDSC \
+ EQSS EQPS EQSP NESS NEPS NESP LTSS LTPS LTSP GTSS GTPS GTSP \
+ LESS LEPS LESP GESS GEPS GESP
+STRIO = EXTRACT INSERT GETLINE
+
+# These are here for SunOS VPATH.
+cstringi.o: cstringi.cc
+cstdlibi.o: cstdlibi.cc
+cmathi.o: cmathi.cc
+stdexcepti.o: stdexcepti.cc
+stlinst.o: stlinst.cc
+
+# Later do wide strings, too.
+stmp-string: ${srcdir}/sinst.cc ${srcdir}/std/bastring.h \
+ ${srcdir}/std/bastring.cc ${srcdir}/std/straits.h
+ for name in $(STRFUNCS) $(STRIO); do \
+ echo c$${name}; \
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DC -D$${name} ${srcdir}/sinst.cc \
+ -o pic/c$${name}.o; \
+ else true ; fi; \
+ if [ $$? -eq 0 ]; then true; else exit 1; fi; \
+ $(COMPILE.cc) -DC -D$${name} ${srcdir}/sinst.cc -o c$${name}.o; \
+ if [ $$? -eq 0 ]; then true; else exit 1; fi; \
+ done
+ touch stmp-string
+
+bigstmp-string: ${srcdir}/sinst.cc ${srcdir}/std/bastring.h \
+ ${srcdir}/std/bastring.cc ${srcdir}/std/straits.h
+ echo cstring
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DC \
+ `for N in $(STRFUNCS); do echo " -D$${N}"; done` \
+ $(srcdir)/sinst.cc -o pic/cstrmain.o; \
+ else true ; fi
+ $(COMPILE.cc) -DC `for N in $(STRFUNCS); do echo " -D$${N}"; done` \
+ $(srcdir)/sinst.cc -o cstrmain.o
+ echo cstrio
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DC \
+ `for N in $(STRIO); do echo " -D$${N}"; done` \
+ $(srcdir)/sinst.cc -o pic/cstrio.o; \
+ else true ; fi
+ $(COMPILE.cc) -DC `for N in $(STRIO); do echo " -D$${N}"; done` \
+ $(srcdir)/sinst.cc -o cstrio.o
+ touch bigstmp-string
+
+COMFUNCS = MAIN ADDCC ADDCF ADDFC SUBCC SUBCF SUBFC MULCC MULCF MULFC DIVCC \
+ DIVCF DIVFC PLUS MINUS EQCC EQCF EQFC NECC NECF NEFC ABS ARG POLAR \
+ CONJ NORM COS COSH EXP LOG POWCC POWCF POWCI POWFC SIN SINH SQRT
+COMIO = EXTRACT INSERT
+
+stmp-complex: ${srcdir}/cinst.cc ${srcdir}/std/complext.h \
+ ${srcdir}/std/complext.cc ${srcdir}/std/dcomplex.h \
+ ${srcdir}/std/ldcomplex.h
+ for N in $(COMFUNCS) $(COMIO); do \
+ echo f$${N}; \
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DF -D$${N} $(srcdir)/cinst.cc \
+ -o pic/f$${N}.o; \
+ else true ; fi; \
+ if [ $$? -eq 0 ]; then true; else exit 1; fi; \
+ $(COMPILE.cc) -DF -D$${N} ${srcdir}/cinst.cc -o f$${N}.o; \
+ if [ $$? -eq 0 ]; then true; else exit 1; fi; \
+ echo d$${N}; \
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DD -D$${N} $(srcdir)/cinst.cc \
+ -o pic/d$${N}.o; \
+ else true ; fi; \
+ if [ $$? -eq 0 ]; then true; else exit 1; fi; \
+ $(COMPILE.cc) -DD -D$${N} ${srcdir}/cinst.cc -o d$${N}.o; \
+ if [ $$? -eq 0 ]; then true; else exit 1; fi; \
+ echo ld$${N}; \
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DLD -D$${N} $(srcdir)/cinst.cc \
+ -o pic/ld$${N}.o; \
+ else true ; fi; \
+ if [ $$? -eq 0 ]; then true; else exit 1; fi; \
+ $(COMPILE.cc) -DLD -D$${N} ${srcdir}/cinst.cc -o ld$${N}.o; \
+ if [ $$? -eq 0 ]; then true; else exit 1; fi; \
+ done
+ touch stmp-complex
+
+bigstmp-complex: ${srcdir}/cinst.cc ${srcdir}/std/complext.h \
+ ${srcdir}/std/complext.cc ${srcdir}/std/dcomplex.h \
+ ${srcdir}/std/ldcomplex.h
+ echo fcomplex
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DF \
+ `for N in $(COMFUNCS); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o pic/fcomplex.o; \
+ else true ; fi
+ $(COMPILE.cc) -DF `for N in $(COMFUNCS); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o fcomplex.o
+ echo fcomio
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DF \
+ `for N in $(COMIO); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o pic/fcomio.o; \
+ else true ; fi
+ $(COMPILE.cc) -DF `for N in $(COMIO); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o fcomio.o
+ echo dcomplex
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DD \
+ `for N in $(COMFUNCS); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o pic/dcomplex.o; \
+ else true ; fi
+ $(COMPILE.cc) -DD `for N in $(COMFUNCS); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o dcomplex.o
+ echo dcomio
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DD \
+ `for N in $(COMIO); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o pic/dcomio.o; \
+ else true ; fi
+ $(COMPILE.cc) -DD `for N in $(COMIO); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o dcomio.o
+ echo ldcomplex
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DLD \
+ `for N in $(COMFUNCS); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o pic/ldcomplex.o; \
+ else true ; fi
+ $(COMPILE.cc) -DLD `for N in $(COMFUNCS); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o ldcomplex.o
+ echo ldcomio
+ if [ -n "$(PICFLAG)" ]; then \
+ $(COMPILE.cc) $(PICFLAG) -DLD \
+ `for N in $(COMIO); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o pic/ldcomio.o; \
+ else true ; fi
+ $(COMPILE.cc) -DLD `for N in $(COMIO); do echo " -D$${N}"; done` \
+ $(srcdir)/cinst.cc -o ldcomio.o
+ touch bigstmp-complex
+
+.PHONY: install
+install:
+ rootme=`pwd`/ ; export rootme ; \
+ if [ -z "$(MULTISUBDIR)" ]; then \
+ cd $(srcdir); \
+ for FILE in $(HEADERS) *.h std/*.*; do \
+ rm -f $(gxx_includedir)/$$FILE ; \
+ $(INSTALL_DATA) $$FILE $(gxx_includedir)/$$FILE ; \
+ chmod a-x $(gxx_includedir)/$$FILE ; \
+ done ; \
+ cd stl; \
+ for FILE in *.h; do \
+ rm -f $(gxx_includedir)/$$FILE ; \
+ $(INSTALL_DATA) $$FILE $(gxx_includedir)/$$FILE ; \
+ chmod a-x $(gxx_includedir)/$$FILE ; \
+ done ; \
+ else true ; \
+ fi
+ rootme=`pwd`/ ; export rootme ; \
+ for FILE in $(LIBS) ; do \
+ rm -f $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ if [ $$FILE = $(SHLINK) ] ; then \
+ ln -s -f $(SHLIB) $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ elif [ $$FILE = mshlink ]; then \
+ for FILE in $(MSHLINK) ; do \
+ rm -f $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ ln -s -f $$FILE $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ done; \
+ elif [ $$FILE = $(SHLIB) ]; then \
+ $(INSTALL_PROGRAM) $$FILE $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ : On the HP, shared libraries must be mode 555. ;\
+ chmod 555 $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ else \
+ $(INSTALL_DATA) $$FILE $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ $(RANLIB) $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ chmod a-x $(INSTALLDIR)$(MULTISUBDIR)/$$FILE ; \
+ fi ; \
+ done
+ @rootme=`pwd`/ ; export rootme ; \
+ $(MULTIDO) $(FLAGS_TO_PASS) multi-do DO=install
+
+.PHONY: force
+force:
+
+.PHONY: stuff
+stuff:
+ $(MAKE) clean
+ $(MAKE) -C ../libio c++clean
+ $(MAKE) -C ../libg++ clean
+ $(MAKE) check
+ $(MAKE) -C ../libio check
+ $(MAKE) -C ../libg++ check
+
+stuff1:
+ $(MAKE) clean
+ $(MAKE) -C ../libio c++clean
+ $(MAKE) -C ../libg++ clean
+
+stuff2:
+ $(MAKE) check
+ $(MAKE) -C ../libio check
+ $(MAKE) -C ../libg++ check
diff --git a/libstdc++/NEWS b/libstdc++/NEWS
new file mode 100644
index 00000000000..7ffcd56a8f0
--- /dev/null
+++ b/libstdc++/NEWS
@@ -0,0 +1,13 @@
+SUMMARY OF RECENT MAJOR CHANGES to LIBSTDC++.
+(Also check ../libio/NEWS.)
+
+*** Noteworthy changes in libstdc++ version 2.8.0:
+
+* The STL implementation in libstdc++ is now only slightly modified from
+ the HP distribution, thanks to improved template support in gcc 2.8.0.
+
+* The string representation class is now nested in the basic_string
+ template, since this is supported in the new gcc.
+
+* As a result of these and other changes, libstc++ 2.8.0 is not binary
+ compatible with previous releases of libstdc++.
diff --git a/libstdc++/algorithm b/libstdc++/algorithm
new file mode 100644
index 00000000000..472d2416640
--- /dev/null
+++ b/libstdc++/algorithm
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __ALGORITHM__
+#define __ALGORITHM__
+#include <algo.h>
+#endif
diff --git a/libstdc++/cassert b/libstdc++/cassert
new file mode 100644
index 00000000000..b4165bfae7f
--- /dev/null
+++ b/libstdc++/cassert
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CASSERT__
+#define __CASSERT__
+#include <assert.h>
+#endif
diff --git a/libstdc++/cctype b/libstdc++/cctype
new file mode 100644
index 00000000000..e2765aed50a
--- /dev/null
+++ b/libstdc++/cctype
@@ -0,0 +1,7 @@
+// The -*- C++ -*- character type header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CCTYPE__
+#define __CCTYPE__
+#include <ctype.h>
+#endif
diff --git a/libstdc++/cerrno b/libstdc++/cerrno
new file mode 100644
index 00000000000..ce493469597
--- /dev/null
+++ b/libstdc++/cerrno
@@ -0,0 +1,7 @@
+// The -*- C++ -*- error number header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CERRNO__
+#define __CERRNO__
+#include <errno.h>
+#endif
diff --git a/libstdc++/cfloat b/libstdc++/cfloat
new file mode 100644
index 00000000000..cf59eadfb79
--- /dev/null
+++ b/libstdc++/cfloat
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CFLOAT__
+#define __CFLOAT__
+#include <float.h>
+#endif
diff --git a/libstdc++/cinst.cc b/libstdc++/cinst.cc
new file mode 100644
index 00000000000..d28235dd2b5
--- /dev/null
+++ b/libstdc++/cinst.cc
@@ -0,0 +1,155 @@
+// Instantiation file for the -*- C++ -*- complex number classes.
+// Copyright (C) 1994 Free Software Foundation
+
+#ifdef F
+typedef float f;
+#endif
+#ifdef D
+typedef double f;
+#endif
+#ifdef LD
+typedef long double f;
+#endif
+
+#if defined (MAIN) && defined (__GNUG__)
+#ifdef F
+#pragma implementation "fcomplex"
+#endif
+#ifdef D
+#pragma implementation "dcomplex"
+#endif
+#ifdef LD
+#pragma implementation "ldcomplex"
+#endif
+#endif
+
+#if 0
+#define _G_NO_EXTERN_TEMPLATES
+#endif
+#include <std/complext.cc>
+
+typedef complex<f> c;
+typedef const c& ccr;
+
+#ifdef MAIN
+template class complex<f>;
+template c& __doapl (c*, ccr);
+template c& __doaml (c*, ccr);
+template c& __doami (c*, ccr);
+template c& __doadv (c*, ccr);
+#endif
+
+#ifdef ADDCC
+template c operator+ (ccr, ccr);
+#endif
+#ifdef ADDCF
+template c operator+ (ccr, f);
+#endif
+#ifdef ADDFC
+template c operator+ (f, ccr);
+#endif
+#ifdef SUBCC
+template c operator- (ccr, ccr);
+#endif
+#ifdef SUBCF
+template c operator- (ccr, f);
+#endif
+#ifdef SUBFC
+template c operator- (f, ccr);
+#endif
+#ifdef MULCC
+template c operator* (ccr, ccr);
+#endif
+#ifdef MULCF
+template c operator* (ccr, f);
+#endif
+#ifdef MULFC
+template c operator* (f, ccr);
+#endif
+#ifdef DIVCC
+template c operator/ (ccr, ccr);
+#endif
+#ifdef DIVCF
+template c operator/ (ccr, f);
+#endif
+#ifdef DIVFC
+template c operator/ (f, ccr);
+#endif
+#ifdef PLUS
+template c operator+ (ccr);
+#endif
+#ifdef MINUS
+template c operator- (ccr);
+#endif
+#ifdef EQCC
+template bool operator== (ccr, ccr);
+#endif
+#ifdef EQCF
+template bool operator== (ccr, f);
+#endif
+#ifdef EQFC
+template bool operator== (f, ccr);
+#endif
+#ifdef NECC
+template bool operator!= (ccr, ccr);
+#endif
+#ifdef NECF
+template bool operator!= (ccr, f);
+#endif
+#ifdef NEFC
+template bool operator!= (f, ccr);
+#endif
+#ifdef ABS
+template f abs (ccr);
+#endif
+#ifdef ARG
+template f arg (ccr);
+#endif
+#ifdef POLAR
+template c polar (f, f);
+#endif
+#ifdef CONJ
+template c conj (ccr);
+#endif
+#ifdef NORM
+template f norm (ccr);
+#endif
+#ifdef COS
+template c cos (ccr);
+#endif
+#ifdef COSH
+template c cosh (ccr);
+#endif
+#ifdef EXP
+template c exp (ccr);
+#endif
+#ifdef LOG
+template c log (ccr);
+#endif
+#ifdef POWCC
+template c pow (ccr, ccr);
+#endif
+#ifdef POWCF
+template c pow (ccr, f);
+#endif
+#ifdef POWCI
+template c pow (ccr, int);
+#endif
+#ifdef POWFC
+template c pow (f, ccr);
+#endif
+#ifdef SIN
+template c sin (ccr);
+#endif
+#ifdef SINH
+template c sinh (ccr);
+#endif
+#ifdef SQRT
+template c sqrt (ccr);
+#endif
+#ifdef EXTRACT
+template istream& operator>> (istream&, complex<f>&);
+#endif
+#ifdef INSERT
+template ostream& operator<< (ostream&, complex<f>);
+#endif
diff --git a/libstdc++/ciso646 b/libstdc++/ciso646
new file mode 100644
index 00000000000..4d8200d73dc
--- /dev/null
+++ b/libstdc++/ciso646
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CISO646__
+#define __CISO646__
+#include <iso646.h>
+#endif
diff --git a/libstdc++/climits b/libstdc++/climits
new file mode 100644
index 00000000000..1b29b3af01e
--- /dev/null
+++ b/libstdc++/climits
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CLIMITS__
+#define __CLIMITS__
+#include <limits.h>
+#endif
diff --git a/libstdc++/clocale b/libstdc++/clocale
new file mode 100644
index 00000000000..b67cf31c9d2
--- /dev/null
+++ b/libstdc++/clocale
@@ -0,0 +1,7 @@
+// The -*- C++ -*- locale support header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CLOCALE__
+#define __CLOCALE__
+#include <locale.h>
+#endif
diff --git a/libstdc++/cmath b/libstdc++/cmath
new file mode 100644
index 00000000000..b18ea0b428c
--- /dev/null
+++ b/libstdc++/cmath
@@ -0,0 +1,76 @@
+// The -*- C++ -*- math functions header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CMATH__
+#define __CMATH__
+#include <_G_config.h>
+#include <math.h>
+
+#ifdef __GNUG__
+#pragma interface "cmath"
+#endif
+
+extern "C++" {
+#if 0
+float acos (float);
+float asin (float);
+float atan (float);
+float atan2(float, float);
+float ceil (float);
+float cos (float);
+float cosh (float);
+float exp (float);
+float fabs (float);
+float floor(float);
+float fmod (float, float);
+float frexp(float, int*);
+float modf (float, float*);
+float ldexp(float, int);
+float log (float);
+float log10(float);
+float pow (float, float);
+float pow (float, int);
+float sin (float);
+float sinh (float);
+float sqrt (float);
+float tan (float);
+float tanh (float);
+#endif
+
+inline float abs (float x) { return fabs (x); }
+#if ! _G_MATH_H_INLINES /* hpux and SCO define this in math.h */
+inline double abs (double x) { return fabs (x); }
+#endif
+
+#if 0
+double pow(double, int);
+
+long double acos (long double);
+long double asin (long double);
+long double atan (long double);
+long double atan2(long double, long double);
+long double ceil (long double);
+long double cos (long double);
+long double cosh (long double);
+long double exp (long double);
+long double fabs (long double);
+long double floor(long double);
+long double frexp(long double, int*);
+long double fmod (long double, long double);
+long double frexp(long double, int*);
+long double log (long double);
+long double log10(long double);
+long double modf (long double, long double*);
+long double pow (long double, long double);
+long double pow (long double, int);
+long double sin (long double);
+long double sinh (long double);
+long double sqrt (long double);
+long double tan (long double);
+long double tanh (long double);
+#endif
+inline long double abs (long double x) { return fabs (x); }
+
+} // extern "C++"
+
+#endif
diff --git a/libstdc++/cmathi.cc b/libstdc++/cmathi.cc
new file mode 100644
index 00000000000..afd740f013e
--- /dev/null
+++ b/libstdc++/cmathi.cc
@@ -0,0 +1,7 @@
+// Implementation file for the -*- C++ -*- math functions header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifdef __GNUG__
+#pragma implementation "cmath"
+#endif
+#include <cmath>
diff --git a/libstdc++/complex b/libstdc++/complex
new file mode 100644
index 00000000000..bfdd352b462
--- /dev/null
+++ b/libstdc++/complex
@@ -0,0 +1,18 @@
+// Main header for the -*- C++ -*- complex number classes.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __COMPLEX__
+#define __COMPLEX__
+
+#include <std/complext.h>
+
+extern "C++" {
+#define __STD_COMPLEX
+
+// ANSI complex types
+typedef complex<float> float_complex;
+typedef complex<double> double_complex;
+typedef complex<long double> long_double_complex;
+}
+
+#endif
diff --git a/libstdc++/complex.h b/libstdc++/complex.h
new file mode 100644
index 00000000000..2e88de854a6
--- /dev/null
+++ b/libstdc++/complex.h
@@ -0,0 +1,6 @@
+// -*- C++ -*- backward compatiblity header.
+// Copyright (C) 1994 Free Software Foundation
+
+#ifndef __COMPLEX_H__
+#include <complex>
+#endif
diff --git a/libstdc++/config/aix.ml b/libstdc++/config/aix.ml
new file mode 100644
index 00000000000..cd968705e70
--- /dev/null
+++ b/libstdc++/config/aix.ml
@@ -0,0 +1,8 @@
+# AIX has wierd shared/non-shared libraries.
+
+ARLIB = libstdc++-ar.a
+SHLINK = libstdc++.a
+LIBS = $(ARLIB) $(SHLIB) $(SHLINK)
+DEPLIBS = ../$(SHLIB)
+SHDEPS = -lm
+SHFLAGS = -Wl,-unix
diff --git a/libstdc++/config/dec-osf.ml b/libstdc++/config/dec-osf.ml
new file mode 100644
index 00000000000..618c6c89fad
--- /dev/null
+++ b/libstdc++/config/dec-osf.ml
@@ -0,0 +1,6 @@
+# We don't need -fpic on the alpha, so let's install both the shared and
+# non-shared versions.
+
+LIBS = $(ARLIB) $(SHLIB) $(SHLINK)
+DEPLIBS = ../$(SHLIB)
+SHDEPS = -lm
diff --git a/libstdc++/config/elf.ml b/libstdc++/config/elf.ml
new file mode 100644
index 00000000000..2a5f336fe5e
--- /dev/null
+++ b/libstdc++/config/elf.ml
@@ -0,0 +1,8 @@
+# Elf without shared libm -- we have to link with the archive library, even
+# for programs that don't use complex.
+
+LIBS = $(ARLIB) $(SHLIB) $(SHLINK)
+SHFLAGS = -h $(SHLIB)
+DEPLIBS = ../$(SHLIB)
+LDLIBS = -L.. -lstdc++ -lm
+MLDLIBS = -L.. -lstdc++ -lm
diff --git a/libstdc++/config/elfshlibm.ml b/libstdc++/config/elfshlibm.ml
new file mode 100644
index 00000000000..fe2bf3f93bd
--- /dev/null
+++ b/libstdc++/config/elfshlibm.ml
@@ -0,0 +1,6 @@
+# Elf with shared libm, so we can link it into the shared libstdc++.
+
+LIBS = $(ARLIB) $(SHLIB) $(SHLINK)
+SHFLAGS = -h $(SHLIB)
+SHDEPS = -lm
+DEPLIBS = ../$(SHLIB)
diff --git a/libstdc++/config/hpux.ml b/libstdc++/config/hpux.ml
new file mode 100644
index 00000000000..1531fe867f1
--- /dev/null
+++ b/libstdc++/config/hpux.ml
@@ -0,0 +1,6 @@
+# HPUX uses the .sl suffix for shared libraries.
+
+SHLIB = libstdc++.sl
+LIBS = $(ARLIB) $(SHLIB)
+DEPLIBS = ../$(SHLIB)
+SHFLAGS = $(PICFLAG)
diff --git a/libstdc++/config/irix5.ml b/libstdc++/config/irix5.ml
new file mode 100644
index 00000000000..6b334457954
--- /dev/null
+++ b/libstdc++/config/irix5.ml
@@ -0,0 +1,6 @@
+# We don't need -fpic on IRIX, so let's install both the shared and
+# non-shared versions.
+
+LIBS = $(ARLIB) $(SHLIB) $(SHLINK)
+DEPLIBS = ../$(SHLIB)
+SHDEPS = -lm
diff --git a/libstdc++/config/linux.ml b/libstdc++/config/linux.ml
new file mode 100644
index 00000000000..7e6eecee80c
--- /dev/null
+++ b/libstdc++/config/linux.ml
@@ -0,0 +1,6 @@
+# Elf with shared libm, so we can link it into the shared libstdc++.
+
+LIBS = $(ARLIB) $(SHLIB) $(SHLINK) mshlink
+SHFLAGS = -Wl,-soname,$(MSHLINK)
+SHDEPS = -lm
+DEPLIBS = ../$(SHLIB)
diff --git a/libstdc++/config/sol2shm.ml b/libstdc++/config/sol2shm.ml
new file mode 100644
index 00000000000..f02650ce0ab
--- /dev/null
+++ b/libstdc++/config/sol2shm.ml
@@ -0,0 +1,6 @@
+# Solaris2 with shared libm, so we can link it into the shared libstdc++.
+
+LIBS = $(ARLIB) $(SHLIB) $(SHLINK)
+SHFLAGS = -h $(SHLIB)
+SHDEPS = -lm
+DEPLIBS = ../$(SHLIB)
diff --git a/libstdc++/config/sunos4.ml b/libstdc++/config/sunos4.ml
new file mode 100644
index 00000000000..0abc13ce0a1
--- /dev/null
+++ b/libstdc++/config/sunos4.ml
@@ -0,0 +1,9 @@
+# SunOS doesn't provide a shared libm, so we have to link with the archive
+# library, even for programs that don't use complex.
+# SunOS requires a version number in shared library filenames.
+
+LIBS = $(ARLIB) $(SHLIB)
+SHFLAGS = $(PICFLAG)
+DEPLIBS = ../$(SHLIB)
+LDLIBS = -L.. -lstdc++ -lm
+MLDLIBS = -L.. -lstdc++ -lm
diff --git a/libstdc++/configure.in b/libstdc++/configure.in
new file mode 100644
index 00000000000..942c261f9dd
--- /dev/null
+++ b/libstdc++/configure.in
@@ -0,0 +1,85 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../configure.
+
+configdirs="tests testsuite"
+srctrigger=sinst.cc
+srcname="ANSI C++ library"
+package_makefile_frag=Make.pack
+
+# per-host:
+
+# per-target:
+
+echo "# Warning: this fragment is automatically generated" > temp.mt
+frags=
+
+# If they didn't specify --enable-shared, don't generate shared libs.
+case "${enable_shared}" in
+ yes) shared=yes ;;
+ no) shared=no ;;
+ *libstdc++*) shared=yes ;;
+ *) shared=no ;;
+esac
+
+if [ "${shared}" = "yes" ]; then
+ case "${target}" in
+ hppa*-*-*) frags=../../config/mh-papic ;;
+ i[3456]86-*-*) frags=../../config/mh-x86pic ;;
+ *-*-*) frags=../../config/mh-${target_cpu}pic ;;
+ esac
+ case "${target}" in
+ *-dec-osf*) frags="${frags} dec-osf.ml";;
+ *-*-hpux*) frags="${frags} hpux.ml" ;;
+ *-*-irix[56]*) frags="${frags} irix5.ml" ;;
+ *-*-linux*aout*) ;;
+ *-*-linux*) frags="${frags} linux.ml" ;;
+ *-*-sysv4*) frags="${frags} elf.ml" ;;
+ *-*-solaris*) frags="${frags} sol2shm.ml" ;;
+ *-*-sunos4*) frags="${frags} sunos4.ml" ;;
+ *-*-aix*) frags="${frags} aix.ml" ;;
+ esac
+fi
+
+for frag in ${frags}; do
+ frag=${srcdir}/config/$frag
+ if [ -f ${frag} ]; then
+ echo "Appending ${frag} to target-mkfrag"
+ echo "# Following fragment copied from ${frag}" >> temp.mt
+ cat ${frag} >> temp.mt
+ fi
+done
+
+target_makefile_frag=target-mkfrag
+${moveifchange} temp.mt target-mkfrag
+
+LIBDIR=yes
+TO_TOPDIR=../
+ALL='libs'
+XCXXINCLUDES="-I${srcdir} -I${srcdir}/stl -I${TO_TOPDIR}libio -I${srcdir}/${TO_TOPDIR}libio"
+MOSTLYCLEAN='*.o pic stamp-picdir core so_locations $(MOSTLYCLEAN_JUNK)'
+CLEAN='$(CLEAN_JUNK)'
+EXTRA_DISTCLEAN='target-mkfrag'
+
+(. ${srcdir}/${TO_TOPDIR}libio/config.shared) >${package_makefile_frag}
+
+# post-target:
+
+# If cross-compiling, we install in $(tooldir).
+if [ -n "${with_cross_host}" ] ; then
+ rm -f Makefile.tem
+ sed \
+ -e 's|INSTALLDIR.*=.*$|INSTALLDIR = $(tooldir)/lib|' \
+ Makefile >Makefile.tem
+ mv -f Makefile.tem Makefile
+fi
+
+if [ "${srcdir}" = "." ] ; then
+ if [ "${with_target_subdir}" != "." ] ; then
+ . ${with_multisrctop}../../config-ml.in
+ else
+ . ${with_multisrctop}../config-ml.in
+ fi
+else
+ . ${srcdir}/../config-ml.in
+fi
diff --git a/libstdc++/csetjmp b/libstdc++/csetjmp
new file mode 100644
index 00000000000..4bba048dcb5
--- /dev/null
+++ b/libstdc++/csetjmp
@@ -0,0 +1,8 @@
+// The -*- C++ -*- setjmp/longjmp header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CSETJMP__
+#define __CSETJMP__
+#include <setjmp.h>
+#endif
+
diff --git a/libstdc++/csignal b/libstdc++/csignal
new file mode 100644
index 00000000000..6febfb7b2ed
--- /dev/null
+++ b/libstdc++/csignal
@@ -0,0 +1,7 @@
+// The -*- C++ -*- signal handling header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CSIGNAL__
+#define __CSIGNAL__
+#include <signal.h>
+#endif
diff --git a/libstdc++/cstdarg b/libstdc++/cstdarg
new file mode 100644
index 00000000000..324f5a1c19b
--- /dev/null
+++ b/libstdc++/cstdarg
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CSTDARG__
+#define __CSTDARG__
+#include <stdarg.h>
+#endif
diff --git a/libstdc++/cstddef b/libstdc++/cstddef
new file mode 100644
index 00000000000..db5cbe40037
--- /dev/null
+++ b/libstdc++/cstddef
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CSTDDEF__
+#define __CSTDDEF__
+#include <stddef.h>
+#endif
diff --git a/libstdc++/cstdio b/libstdc++/cstdio
new file mode 100644
index 00000000000..1fe1456b5bd
--- /dev/null
+++ b/libstdc++/cstdio
@@ -0,0 +1,7 @@
+// The -*- C++ -*- standard I/O header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CSTDIO__
+#define __CSTDIO__
+#include <stdio.h>
+#endif
diff --git a/libstdc++/cstdlib b/libstdc++/cstdlib
new file mode 100644
index 00000000000..e7c1a5160a5
--- /dev/null
+++ b/libstdc++/cstdlib
@@ -0,0 +1,23 @@
+// The -*- C++ -*- standard library header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CSTDLIB__
+#define __CSTDLIB__
+#include <stdlib.h>
+
+#ifdef __GNUG__
+#pragma interface "cstdlib"
+#endif
+
+extern "C++" {
+
+#if _G_HAS_LABS
+inline long abs(long x) { return labs (x); }
+#else
+inline long abs(long x) { return x >= 0 ? x : -x; }
+#endif
+//inline ldiv_t div(long x, long y) { return ldiv (x, y); }
+
+} // extern "C++"
+
+#endif
diff --git a/libstdc++/cstdlibi.cc b/libstdc++/cstdlibi.cc
new file mode 100644
index 00000000000..abbfa03464a
--- /dev/null
+++ b/libstdc++/cstdlibi.cc
@@ -0,0 +1,7 @@
+// Implementation file for the -*- C++ -*- standard library header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifdef __GNUG__
+#pragma implementation "cstdlib"
+#endif
+#include <cstdlib>
diff --git a/libstdc++/cstring b/libstdc++/cstring
new file mode 100644
index 00000000000..d8d03a765b6
--- /dev/null
+++ b/libstdc++/cstring
@@ -0,0 +1,96 @@
+// The -*- C++ -*- null-terminated string header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CSTRING__
+#define __CSTRING__
+
+#include <string.h>
+
+#if 0 // Let's not bother with this just yet.
+#include <cstddef>
+
+#ifdef __GNUG__
+#pragma interface "cstring"
+#endif
+
+// The ANSI C prototypes for these functions have a const argument type and
+// non-const return type, so we can't use them.
+
+extern "C++" {
+extern inline const char *
+_G_strchr (const char *s, int c)
+{
+ return strchr (s, c);
+}
+
+extern inline char *
+_G_strchr (char *s, int c)
+{
+ return const_cast<char *> (strchr (s, c));
+}
+
+extern inline const char *
+_G_strpbrk (const char *s1, const char *s2)
+{
+ return strpbrk (s1, s2);
+}
+
+extern inline char *
+_G_strpbrk (char *s1, const char *s2)
+{
+ return const_cast<char *> (strpbrk (s1, s2));
+}
+
+extern inline const char *
+_G_strrchr (const char *s, int c)
+{
+ return strrchr (s, c);
+}
+
+extern inline char *
+_G_strrchr (char *s, int c)
+{
+ return const_cast<char *> (strrchr (s, c));
+}
+
+extern inline const char *
+_G_strstr (const char *s1, const char *s2)
+{
+ return strstr (s1, s2);
+}
+
+extern inline char *
+_G_strstr (char *s1, const char *s2)
+{
+ return const_cast<char *> (strstr (s1, s2));
+}
+
+extern inline const void *
+_G_memchr (const void *s, int c, size_t n)
+{
+ return memchr (s, c, n);
+}
+
+extern inline void *
+_G_memchr (void *s, int c, size_t n)
+{
+ return const_cast<void *> (memchr (s, c, n));
+}
+} // extern "C++"
+
+// Lose any vendor macros for these functions.
+#undef strchr
+#undef strpbrk
+#undef strrchr
+#undef strstr
+#undef memchr
+
+// Ewww, namespace pollution. Anyone have a better idea?
+#define strchr _G_strchr
+#define strpbrk _G_strpbrk
+#define strrchr _G_strrchr
+#define strstr _G_strstr
+#define memchr _G_memchr
+#endif // 0
+
+#endif // !defined (__CSTRING__)
diff --git a/libstdc++/cstringi.cc b/libstdc++/cstringi.cc
new file mode 100644
index 00000000000..2676febc9b0
--- /dev/null
+++ b/libstdc++/cstringi.cc
@@ -0,0 +1,7 @@
+// Implementation file for the -*- C++ -*- null-terminated string header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifdef __GNUG__
+#pragma implementation "cstring"
+#endif
+#include <cstring>
diff --git a/libstdc++/ctime b/libstdc++/ctime
new file mode 100644
index 00000000000..0184da5929f
--- /dev/null
+++ b/libstdc++/ctime
@@ -0,0 +1,7 @@
+// The -*- C++ -*- time header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CTIME__
+#define __CTIME__
+#include <time.h>
+#endif
diff --git a/libstdc++/cwchar b/libstdc++/cwchar
new file mode 100644
index 00000000000..1674c12b61f
--- /dev/null
+++ b/libstdc++/cwchar
@@ -0,0 +1,7 @@
+// The -*- C++ -*- wide character header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CWCHAR__
+#define __CWCHAR__
+#include <wchar.h>
+#endif
diff --git a/libstdc++/cwctype b/libstdc++/cwctype
new file mode 100644
index 00000000000..81122012bd0
--- /dev/null
+++ b/libstdc++/cwctype
@@ -0,0 +1,7 @@
+// The -*- C++ -*- wide character type header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __CWCTYPE__
+#define __CWCTYPE__
+#include <wctype.h>
+#endif
diff --git a/libstdc++/deque b/libstdc++/deque
new file mode 100644
index 00000000000..bdc14299a04
--- /dev/null
+++ b/libstdc++/deque
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __DEQUE__
+#define __DEQUE__
+#include <deque.h>
+#endif
diff --git a/libstdc++/functional b/libstdc++/functional
new file mode 100644
index 00000000000..ee8b7f20202
--- /dev/null
+++ b/libstdc++/functional
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __FUNCTIONAL__
+#define __FUNCTIONAL__
+#include <function.h>
+#endif
diff --git a/libstdc++/iterator b/libstdc++/iterator
new file mode 100644
index 00000000000..a0fa054c5ec
--- /dev/null
+++ b/libstdc++/iterator
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __ITERATOR__
+#define __ITERATOR__
+#include <iterator.h>
+#endif
diff --git a/libstdc++/list b/libstdc++/list
new file mode 100644
index 00000000000..475d8443d16
--- /dev/null
+++ b/libstdc++/list
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __LIST__
+#define __LIST__
+#include <list.h>
+#endif
diff --git a/libstdc++/map b/libstdc++/map
new file mode 100644
index 00000000000..0127b9db250
--- /dev/null
+++ b/libstdc++/map
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __MAP__
+#define __MAP__
+#include <map.h>
+#endif
diff --git a/libstdc++/memory b/libstdc++/memory
new file mode 100644
index 00000000000..8328720db6d
--- /dev/null
+++ b/libstdc++/memory
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __MEMORY__
+#define __MEMORY__
+#include <defalloc.h>
+#endif
diff --git a/libstdc++/numeric b/libstdc++/numeric
new file mode 100644
index 00000000000..dcb88737f17
--- /dev/null
+++ b/libstdc++/numeric
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __NUMERIC__
+#define __NUMERIC__
+#include <algo.h>
+#endif
diff --git a/libstdc++/queue b/libstdc++/queue
new file mode 100644
index 00000000000..e71ce343067
--- /dev/null
+++ b/libstdc++/queue
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __QUEUE__
+#define __QUEUE__
+#include <stack.h>
+#endif
diff --git a/libstdc++/set b/libstdc++/set
new file mode 100644
index 00000000000..0353285fe50
--- /dev/null
+++ b/libstdc++/set
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __SET__
+#define __SET__
+#include <set.h>
+#endif
diff --git a/libstdc++/sinst.cc b/libstdc++/sinst.cc
new file mode 100644
index 00000000000..b8856fcd063
--- /dev/null
+++ b/libstdc++/sinst.cc
@@ -0,0 +1,132 @@
+// Instantiation file for the -*- C++ -*- string classes.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification by Takanori Adachi
+// in ANSI X3J16/94-0013R2.
+
+#ifdef __GNUG__
+#ifdef TRAITS
+#ifdef C
+#pragma implementation "std/straits.h"
+#endif
+#endif
+#endif
+
+#include <std/bastring.cc>
+
+#ifdef C
+typedef char c;
+#endif
+#ifdef W
+typedef wchar_t c;
+#endif
+
+#ifdef TRAITS
+template class string_char_traits <c>;
+#endif
+
+typedef basic_string <c> s;
+
+#ifdef MAIN
+template class basic_string <c>;
+#endif
+
+#ifdef ADDSS
+template s operator+ (const s&, const s&);
+#endif
+#ifdef ADDPS
+template s operator+ (const c*, const s&);
+#endif
+#ifdef ADDCS
+template s operator+ (c, const s&);
+#endif
+#ifdef ADDSP
+template s operator+ (const s&, const c*);
+#endif
+#ifdef ADDSC
+template s operator+ (const s&, c);
+#endif
+#ifdef EQSS
+template bool operator== (const s&, const s&);
+#endif
+#ifdef EQPS
+template bool operator== (const c*, const s&);
+#endif
+#ifdef EQSP
+template bool operator== (const s&, const c*);
+#endif
+#ifdef NESS
+template bool operator!= (const s&, const s&);
+#endif
+#ifdef NEPS
+template bool operator!= (const c*, const s&);
+#endif
+#ifdef NESP
+template bool operator!= (const s&, const c*);
+#endif
+#ifdef LTSS
+template bool operator< (const s&, const s&);
+#endif
+#ifdef LTPS
+template bool operator< (const c*, const s&);
+#endif
+#ifdef LTSP
+template bool operator< (const s&, const c*);
+#endif
+#ifdef GTSS
+template bool operator> (const s&, const s&);
+#endif
+#ifdef GTPS
+template bool operator> (const c*, const s&);
+#endif
+#ifdef GTSP
+template bool operator> (const s&, const c*);
+#endif
+#ifdef LESS
+template bool operator<= (const s&, const s&);
+#endif
+#ifdef LEPS
+template bool operator<= (const c*, const s&);
+#endif
+#ifdef LESP
+template bool operator<= (const s&, const c*);
+#endif
+#ifdef GESS
+template bool operator>= (const s&, const s&);
+#endif
+#ifdef GEPS
+template bool operator>= (const c*, const s&);
+#endif
+#ifdef GESP
+template bool operator>= (const s&, const c*);
+#endif
+#ifdef EXTRACT
+template istream& operator>> (istream&, s&);
+#endif // EXTRACT
+#ifdef INSERT
+template ostream& operator<< (ostream&, const s&);
+#endif // INSERT
+#ifdef GETLINE
+template istream& getline (istream&, s&, c);
+#endif
diff --git a/libstdc++/stack b/libstdc++/stack
new file mode 100644
index 00000000000..dfe0c51e181
--- /dev/null
+++ b/libstdc++/stack
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __STACK__
+#define __STACK__
+#include <stack.h>
+#endif
diff --git a/libstdc++/std/bastring.cc b/libstdc++/std/bastring.cc
new file mode 100644
index 00000000000..155656ae5d0
--- /dev/null
+++ b/libstdc++/std/bastring.cc
@@ -0,0 +1,514 @@
+// Member templates for the -*- C++ -*- string classes.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification by Takanori Adachi
+// in ANSI X3J16/94-0013R2.
+
+#include <cstddef>
+#include <std/bastring.h>
+
+extern "C++" {
+template <class charT, class traits>
+inline void * basic_string <charT, traits>::Rep::
+operator new (size_t s, size_t extra)
+{
+ return ::operator new (s + extra * sizeof (charT));
+}
+
+template <class charT, class traits>
+inline size_t basic_string <charT, traits>::Rep::
+#if _G_ALLOC_CONTROL
+default_frob (size_t s)
+#else
+frob_size (size_t s)
+#endif
+{
+ size_t i = 16;
+ while (i < s) i *= 2;
+ return i;
+}
+
+template <class charT, class traits>
+inline basic_string <charT, traits>::Rep * basic_string <charT, traits>::Rep::
+create (size_t extra)
+{
+ extra = frob_size (extra + 1);
+ Rep *p = new (extra) Rep;
+ p->res = extra;
+ p->ref = 1;
+ p->selfish = false;
+ return p;
+}
+
+template <class charT, class traits>
+charT * basic_string <charT, traits>::Rep::
+clone ()
+{
+ Rep *p = Rep::create (len);
+ p->copy (0, data (), len);
+ p->len = len;
+ return p->data ();
+}
+
+template <class charT, class traits>
+inline bool basic_string <charT, traits>::Rep::
+#ifdef _G_ALLOC_CONTROL
+default_excess (size_t s, size_t r)
+#else
+excess_slop (size_t s, size_t r)
+#endif
+{
+ return 2 * (s <= 16 ? 16 : s) < r;
+}
+
+template <class charT, class traits>
+inline bool basic_string <charT, traits>::
+check_realloc (size_t s) const
+{
+ s += sizeof (charT);
+ return (rep ()->ref > 1
+ || s > capacity ()
+ || Rep::excess_slop (s, capacity ()));
+}
+
+template <class charT, class traits>
+void basic_string <charT, traits>::
+alloc (size_t size, bool save)
+{
+ if (! check_realloc (size))
+ return;
+
+ Rep *p = Rep::create (size);
+
+ if (save)
+ {
+ p->copy (0, data (), length ());
+ p->len = length ();
+ }
+ else
+ p->len = 0;
+
+ repup (p);
+}
+
+template <class charT, class traits>
+basic_string <charT, traits>& basic_string <charT, traits>::
+replace (size_t pos1, size_t n1,
+ const basic_string& str, size_t pos2, size_t n2)
+{
+ const size_t len2 = str.length ();
+
+ if (pos1 == 0 && n1 >= length () && pos2 == 0 && n2 >= len2)
+ return operator= (str);
+
+ OUTOFRANGE (pos2 > len2);
+
+ if (n2 > len2 - pos2)
+ n2 = len2 - pos2;
+
+ return replace (pos1, n1, str.data () + pos2, n2);
+}
+
+template <class charT, class traits>
+inline void basic_string <charT, traits>::Rep::
+copy (size_t pos, const charT *s, size_t n)
+{
+ if (n)
+ traits::copy (data () + pos, s, n);
+}
+
+template <class charT, class traits>
+inline void basic_string <charT, traits>::Rep::
+move (size_t pos, const charT *s, size_t n)
+{
+ if (n)
+ traits::move (data () + pos, s, n);
+}
+
+template <class charT, class traits>
+basic_string <charT, traits>& basic_string <charT, traits>::
+replace (size_t pos, size_t n1, const charT* s, size_t n2)
+{
+ const size_t len = length ();
+ OUTOFRANGE (pos > len);
+ if (n1 > len - pos)
+ n1 = len - pos;
+ LENGTHERROR (len - n1 > max_size () - n2);
+ size_t newlen = len - n1 + n2;
+
+ if (check_realloc (newlen))
+ {
+ Rep *p = Rep::create (newlen);
+ p->copy (0, data (), pos);
+ p->copy (pos + n2, data () + pos + n1, len - (pos + n1));
+ p->copy (pos, s, n2);
+ repup (p);
+ }
+ else
+ {
+ rep ()->move (pos + n2, data () + pos + n1, len - (pos + n1));
+ rep ()->copy (pos, s, n2);
+ }
+ rep ()->len = newlen;
+
+ return *this;
+}
+
+template <class charT, class traits>
+inline void basic_string <charT, traits>::Rep::
+set (size_t pos, const charT c, size_t n)
+{
+ traits::set (data () + pos, c, n);
+}
+
+template <class charT, class traits>
+basic_string <charT, traits>& basic_string <charT, traits>::
+replace (size_t pos, size_t n1, size_t n2, charT c)
+{
+ const size_t len = length ();
+ OUTOFRANGE (pos > len);
+ if (n1 > len - pos)
+ n1 = len - pos;
+ LENGTHERROR (len - n1 > max_size () - n2);
+ size_t newlen = len - n1 + n2;
+
+ if (check_realloc (newlen))
+ {
+ Rep *p = Rep::create (newlen);
+ p->copy (0, data (), pos);
+ p->copy (pos + n2, data () + pos + n1, len - (pos + n1));
+ p->set (pos, c, n2);
+ repup (p);
+ }
+ else
+ {
+ rep ()->move (pos + n2, data () + pos + n1, len - (pos + n1));
+ rep ()->set (pos, c, n2);
+ }
+ rep ()->len = newlen;
+
+ return *this;
+}
+
+template <class charT, class traits>
+void basic_string <charT, traits>::
+resize (size_t n, charT c)
+{
+ LENGTHERROR (n > max_size ());
+
+ if (n > length ())
+ append (n - length (), c);
+ else
+ remove (n);
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+copy (charT* s, size_t n, size_t pos)
+{
+ OUTOFRANGE (pos > length ());
+
+ if (n > length () - pos)
+ n = length () - pos;
+
+ traits::copy (s, data () + pos, n);
+ return n;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+find (const charT* s, size_t pos, size_t n) const
+{
+ size_t xpos = pos;
+ for (; xpos + n <= length (); ++xpos)
+ if (traits::eq (data () [xpos], *s)
+ && traits::compare (data () + xpos, s, n) == 0)
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+inline size_t basic_string <charT, traits>::
+_find (const charT* ptr, charT c, size_t xpos, size_t len)
+{
+ for (; xpos < len; ++xpos)
+ if (traits::eq (ptr [xpos], c))
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+find (charT c, size_t pos) const
+{
+ return _find (data (), c, pos, length ());
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+rfind (const charT* s, size_t pos, size_t n) const
+{
+ if (n > length ())
+ return npos;
+
+ size_t xpos = length () - n;
+ if (xpos > pos)
+ xpos = pos;
+
+ for (++xpos; xpos-- > 0; )
+ if (traits::eq (data () [xpos], *s)
+ && traits::compare (data () + xpos, s, n) == 0)
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+rfind (charT c, size_t pos) const
+{
+ if (1 > length ())
+ return npos;
+
+ size_t xpos = length () - 1;
+ if (xpos > pos)
+ xpos = pos;
+
+ for (++xpos; xpos-- > 0; )
+ if (traits::eq (data () [xpos], c))
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+find_first_of (const charT* s, size_t pos, size_t n) const
+{
+ size_t xpos = pos;
+ for (; xpos < length (); ++xpos)
+ if (_find (s, data () [xpos], 0, n) != npos)
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+find_last_of (const charT* s, size_t pos, size_t n) const
+{
+ size_t xpos = length () - 1;
+ if (xpos > pos)
+ xpos = pos;
+ for (; xpos; --xpos)
+ if (_find (s, data () [xpos], 0, n) != npos)
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+find_first_not_of (const charT* s, size_t pos, size_t n) const
+{
+ size_t xpos = pos;
+ for (; xpos < length (); ++xpos)
+ if (_find (s, data () [xpos], 0, n) == npos)
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+find_first_not_of (charT c, size_t pos) const
+{
+ size_t xpos = pos;
+ for (; xpos < length (); ++xpos)
+ if (traits::ne (data () [xpos], c))
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+find_last_not_of (const charT* s, size_t pos, size_t n) const
+{
+ size_t xpos = length () - 1;
+ if (xpos > pos)
+ xpos = pos;
+ for (; xpos; --xpos)
+ if (_find (s, data () [xpos], 0, n) == npos)
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+size_t basic_string <charT, traits>::
+find_last_not_of (charT c, size_t pos) const
+{
+ size_t xpos = length () - 1;
+ if (xpos > pos)
+ xpos = pos;
+ for (; xpos; --xpos)
+ if (traits::ne (data () [xpos], c))
+ return xpos;
+ return npos;
+}
+
+template <class charT, class traits>
+int basic_string <charT, traits>::
+compare (const basic_string& str, size_t pos, size_t n) const
+{
+ OUTOFRANGE (pos > length ());
+
+ size_t rlen = length () - pos;
+ if (rlen > n)
+ rlen = n;
+ if (rlen > str.length ())
+ rlen = str.length ();
+ int r = traits::compare (data () + pos, str.data (), rlen);
+ if (r != 0)
+ return r;
+ if (rlen == n)
+ return 0;
+ return (length () - pos) - str.length ();
+}
+
+template <class charT, class traits>
+int basic_string <charT, traits>::
+compare (const charT* s, size_t pos, size_t n) const
+{
+ OUTOFRANGE (pos > length ());
+
+ size_t rlen = length () - pos;
+ if (rlen > n)
+ rlen = n;
+ int r = traits::compare (data () + pos, s, rlen);
+ if (r != 0)
+ return r;
+ return (length () - pos) - n;
+}
+
+#include <iostream.h>
+
+template <class charT, class traits>
+istream &
+operator>> (istream &is, basic_string <charT, traits> &s)
+{
+ int w = is.width (0);
+ if (is.ipfx0 ())
+ {
+ register streambuf *sb = is.rdbuf ();
+ s.resize (0);
+ while (1)
+ {
+ int ch = sb->sbumpc ();
+ if (ch == EOF)
+ {
+ is.setstate (ios::eofbit);
+ break;
+ }
+ else if (traits::is_del (ch))
+ {
+ sb->sungetc ();
+ break;
+ }
+ s += ch;
+ if (--w == 1)
+ break;
+ }
+ }
+
+ is.isfx ();
+ if (s.length () == 0)
+ is.setstate (ios::failbit);
+
+ return is;
+}
+
+template <class charT, class traits>
+ostream &
+operator<< (ostream &o, const basic_string <charT, traits>& s)
+{
+ return o.write (s.data (), s.length ());
+}
+
+template <class charT, class traits>
+istream&
+getline (istream &is, basic_string <charT, traits>& s, charT delim)
+{
+ if (is.ipfx1 ())
+ {
+ _IO_size_t count = 0;
+ streambuf *sb = is.rdbuf ();
+ s.resize (0);
+
+ while (1)
+ {
+ int ch = sb->sbumpc ();
+ if (ch == EOF)
+ {
+ is.setstate (count == 0
+ ? (ios::failbit|ios::eofbit)
+ : ios::eofbit);
+ break;
+ }
+
+ ++count;
+
+ if (ch == delim)
+ break;
+
+ s += ch;
+
+ if (s.length () == s.npos - 1)
+ {
+ is.setstate (ios::failbit);
+ break;
+ }
+ }
+ }
+
+ // We need to be friends with istream to do this.
+ // is._gcount = count;
+ is.isfx ();
+
+ return is;
+}
+
+template <class charT, class traits>
+basic_string <charT, traits>::Rep
+basic_string<charT, traits>::nilRep = { 0, 0, 1 };
+
+template <class charT, class traits>
+const basic_string <charT, traits>::size_type
+basic_string <charT, traits>::npos;
+
+#ifdef _G_ALLOC_CONTROL
+template <class charT, class traits>
+bool (*basic_string <charT, traits>::Rep::excess_slop) (size_t, size_t)
+ = basic_string <charT, traits>::Rep::default_excess;
+
+template <class charT, class traits>
+size_t (*basic_string <charT, traits>::Rep::frob_size) (size_t)
+ = basic_string <charT, traits>::Rep::default_frob;
+#endif
+
+} // extern "C++"
diff --git a/libstdc++/std/bastring.h b/libstdc++/std/bastring.h
new file mode 100644
index 00000000000..5a2605bd050
--- /dev/null
+++ b/libstdc++/std/bastring.h
@@ -0,0 +1,560 @@
+// Main templates for the -*- C++ -*- string classes.
+// Copyright (C) 1994, 1995 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification by Takanori Adachi
+// in ANSI X3J16/94-0013R2.
+
+#ifndef __BASTRING__
+#define __BASTRING__
+
+#ifdef __GNUG__
+#pragma interface
+#endif
+
+#include <cstddef>
+#include <std/straits.h>
+
+#if _G_USE_EXCEPTIONS
+
+#include <stdexcept>
+#define OUTOFRANGE(cond) \
+ do { if (!(cond)) throw out_of_range (#cond); } while (0)
+#define LENGTHERROR(cond) \
+ do { if (!(cond)) throw length_error (#cond); } while (0)
+
+#else
+
+#include <cassert>
+#define OUTOFRANGE(cond) assert (!(cond))
+#define LENGTHERROR(cond) assert (!(cond))
+
+#endif
+
+extern "C++" {
+class istream; class ostream;
+
+// #include <iterator.h>
+
+template <class charT, class traits = string_char_traits<charT> >
+class basic_string
+{
+private:
+ struct Rep {
+ size_t len, res, ref;
+ bool selfish;
+
+ charT* data () { return reinterpret_cast<charT *>(this + 1); }
+ charT& operator[] (size_t s) { return data () [s]; }
+ charT* grab () { if (selfish) return clone (); ++ref; return data (); }
+ void release () { if (--ref == 0) delete this; }
+
+ inline static void * operator new (size_t, size_t);
+ inline static Rep* create (size_t);
+ charT* clone ();
+
+ inline void copy (size_t, const charT *, size_t);
+ inline void move (size_t, const charT *, size_t);
+ inline void set (size_t, const charT, size_t);
+
+#if _G_ALLOC_CONTROL
+ // These function pointers allow you to modify the allocation policy used
+ // by the string classes. By default they expand by powers of two, but
+ // this may be excessive for space-critical applications.
+
+ // Returns true if ALLOCATED is too much larger than LENGTH
+ static bool (*excess_slop) (size_t length, size_t allocated);
+ inline static bool default_excess (size_t, size_t);
+
+ // Returns a good amount of space to allocate for a string of length LENGTH
+ static size_t (*frob_size) (size_t length);
+ inline static size_t default_frob (size_t);
+#else
+ inline static bool excess_slop (size_t, size_t);
+ inline static size_t frob_size (size_t);
+#endif
+
+ private:
+ Rep &operator= (const Rep &);
+ };
+
+public:
+// types:
+ typedef traits traits_type;
+ typedef charT value_type;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef charT& reference;
+ typedef const charT& const_reference;
+ typedef charT* pointer;
+ typedef const charT* const_pointer;
+ typedef pointer iterator;
+ typedef const_pointer const_iterator;
+#if 0
+ typedef reverse_iterator<iterator, value_type,
+ reference, difference_type> reverse_iterator;
+ typedef reverse_iterator<const_iterator, value_type, const_reference,
+ difference_type> const_reverse_iterator;
+#endif
+ static const size_type npos = static_cast<size_type>(-1);
+
+private:
+ Rep *rep () const { return reinterpret_cast<Rep *>(dat) - 1; }
+ void repup (Rep *p) { rep ()->release (); dat = p->data (); }
+
+public:
+ const charT* data () const
+ { return rep ()->data(); }
+ size_type length () const
+ { return rep ()->len; }
+ size_type size () const
+ { return rep ()->len; }
+ size_type capacity () const
+ { return rep ()->res; }
+ size_type max_size () const
+ { return (npos - 1)/sizeof (charT); } // XXX
+ bool empty () const
+ { return size () == 0; }
+
+// _lib.string.cons_ construct/copy/destroy:
+ basic_string& operator= (const basic_string& str)
+ {
+ if (&str != this) { rep ()->release (); dat = str.rep ()->grab (); }
+ return *this;
+ }
+
+ explicit basic_string (): dat (nilRep.grab ()) { }
+ basic_string (const basic_string& str): dat (str.rep ()->grab ()) { }
+ basic_string (const basic_string& str, size_type pos, size_type n = npos)
+ : dat (nilRep.grab ()) { assign (str, pos, n); }
+ basic_string (const charT* s, size_type n)
+ : dat (nilRep.grab ()) { assign (s, n); }
+ basic_string (const charT* s)
+ : dat (nilRep.grab ()) { assign (s); }
+ basic_string (size_type n, charT c)
+ : dat (nilRep.grab ()) { assign (n, c); }
+#if 0
+ template<class InputIterator>
+ basic_string(InputIterator begin, InputIterator end,
+ Allocator& = Allocator());
+#endif
+
+ ~basic_string ()
+ { rep ()->release (); }
+
+ void swap (basic_string &s) { charT *d = dat; dat = s.dat; s.dat = d; }
+
+ basic_string& append (const basic_string& str, size_type pos = 0,
+ size_type n = npos)
+ { return replace (length (), 0, str, pos, n); }
+ basic_string& append (const charT* s, size_type n)
+ { return replace (length (), 0, s, n); }
+ basic_string& append (const charT* s)
+ { return append (s, traits::length (s)); }
+ basic_string& append (size_type n, charT c)
+ { return replace (length (), 0, n, c); }
+#if 0
+ template<class InputIterator>
+ basic_string& append(InputIterator first, InputIterator last);
+#endif
+
+ basic_string& assign (const basic_string& str, size_type pos = 0,
+ size_type n = npos)
+ { return replace (0, npos, str, pos, n); }
+ basic_string& assign (const charT* s, size_type n)
+ { return replace (0, npos, s, n); }
+ basic_string& assign (const charT* s)
+ { return assign (s, traits::length (s)); }
+ basic_string& assign (size_type n, charT c)
+ { return replace (0, npos, n, c); }
+#if 0
+ template<class InputIterator>
+ basic_string& assign(InputIterator first, InputIterator last);
+#endif
+
+ basic_string& operator= (const charT* s)
+ { return assign (s); }
+ basic_string& operator= (charT c)
+ { return assign (1, c); }
+
+ basic_string& operator+= (const basic_string& rhs)
+ { return append (rhs); }
+ basic_string& operator+= (const charT* s)
+ { return append (s); }
+ basic_string& operator+= (charT c)
+ { return append (1, c); }
+
+ basic_string& insert (size_type pos1, const basic_string& str,
+ size_type pos2 = 0, size_type n = npos)
+ { return replace (pos1, 0, str, pos2, n); }
+ basic_string& insert (size_type pos, const charT* s, size_type n)
+ { return replace (pos, 0, s, n); }
+ basic_string& insert (size_type pos, const charT* s)
+ { return insert (pos, s, traits::length (s)); }
+ basic_string& insert (size_type pos, size_type n, charT c)
+ { return replace (pos, 0, n, c); }
+ iterator insert(iterator p, charT c)
+ { size_type pos = p - begin (); insert (pos, 1, c); return pos +begin (); }
+ iterator insert(iterator p, size_type n, charT c)
+ { size_type pos = p - begin (); insert (pos, n, c); return pos +begin (); }
+#if 0
+ template<class InputIterator>
+ void insert(iterator p, InputIterator first, InputIterator last);
+#endif
+
+ basic_string& remove (size_type pos = 0, size_type n = npos)
+ { return replace (pos, n, (size_type)0, (charT)0); }
+ basic_string& remove (iterator pos)
+ { return replace (pos - begin (), 1, (size_type)0, (charT)0); }
+ basic_string& remove (iterator first, iterator last)
+ { return replace (first - begin (), last - first, (size_type)0, (charT)0);}
+
+ basic_string& replace (size_type pos1, size_type n1, const basic_string& str,
+ size_type pos2 = 0, size_type n2 = npos);
+ basic_string& replace (size_type pos, size_type n1, const charT* s,
+ size_type n2);
+ basic_string& replace (size_type pos, size_type n1, const charT* s)
+ { return replace (pos, n1, s, traits::length (s)); }
+ basic_string& replace (size_type pos, size_type n1, size_type n2, charT c);
+ basic_string& replace (size_type pos, size_type n, charT c)
+ { return replace (pos, n, 1, c); }
+ basic_string& replace (iterator i1, iterator i2, const basic_string& str)
+ { return replace (i1 - begin (), i2 - i1, str); }
+ basic_string& replace (iterator i1, iterator i2, const charT* s, size_type n)
+ { return replace (i1 - begin (), i2 - i1, s, n); }
+ basic_string& replace (iterator i1, iterator i2, const charT* s)
+ { return replace (i1 - begin (), i2 - i1, s); }
+ basic_string& replace (iterator i1, iterator i2, size_type n, charT c)
+ { return replace (i1 - begin (), i2 - i1, n, c); }
+#if 0
+ template<class InputIterator>
+ basic_string& replace(iterator i1, iterator i2,
+ InputIterator j1, InputIterator j2);
+#endif
+
+private:
+ static charT eos () { return traits::eos (); }
+ void unique () { if (rep ()->ref > 1) alloc (capacity (), true); }
+ void selfish () { unique (); rep ()->selfish = true; }
+
+public:
+ charT operator[] (size_type pos) const
+ {
+ if (pos == length ())
+ return eos ();
+ return data ()[pos];
+ }
+
+ reference operator[] (size_type pos)
+ { unique (); return (*rep ())[pos]; }
+
+ reference at (size_type pos)
+ {
+ OUTOFRANGE (pos >= length ());
+ return (*this)[pos];
+ }
+ const_reference at (size_type pos) const
+ {
+ OUTOFRANGE (pos >= length ());
+ return data ()[pos];
+ }
+
+private:
+ void terminate () const
+ { traits::assign ((*rep ())[length ()], eos ()); }
+
+public:
+ const charT* c_str () const
+ { terminate (); return data (); }
+ void resize (size_type n, charT c);
+ void resize (size_type n)
+ { resize (n, eos ()); }
+ void reserve (size_type) { }
+
+ size_type copy (charT* s, size_type n, size_type pos = 0);
+
+ size_type find (const basic_string& str, size_type pos = 0) const
+ { return find (str.data(), pos, str.length()); }
+ size_type find (const charT* s, size_type pos, size_type n) const;
+ size_type find (const charT* s, size_type pos = 0) const
+ { return find (s, pos, traits::length (s)); }
+ size_type find (charT c, size_type pos = 0) const;
+
+ size_type rfind (const basic_string& str, size_type pos = npos) const
+ { return rfind (str.data(), pos, str.length()); }
+ size_type rfind (const charT* s, size_type pos, size_type n) const;
+ size_type rfind (const charT* s, size_type pos = npos) const
+ { return rfind (s, pos, traits::length (s)); }
+ size_type rfind (charT c, size_type pos = npos) const;
+
+ size_type find_first_of (const basic_string& str, size_type pos = 0) const
+ { return find_first_of (str.data(), pos, str.length()); }
+ size_type find_first_of (const charT* s, size_type pos, size_type n) const;
+ size_type find_first_of (const charT* s, size_type pos = 0) const
+ { return find_first_of (s, pos, traits::length (s)); }
+ size_type find_first_of (charT c, size_type pos = 0) const
+ { return find (c, pos); }
+
+ size_type find_last_of (const basic_string& str, size_type pos = npos) const
+ { return find_last_of (str.data(), pos, str.length()); }
+ size_type find_last_of (const charT* s, size_type pos, size_type n) const;
+ size_type find_last_of (const charT* s, size_type pos = npos) const
+ { return find_last_of (s, pos, traits::length (s)); }
+ size_type find_last_of (charT c, size_type pos = npos) const
+ { return rfind (c, pos); }
+
+ size_type find_first_not_of (const basic_string& str, size_type pos = 0) const
+ { return find_first_not_of (str.data(), pos, str.length()); }
+ size_type find_first_not_of (const charT* s, size_type pos, size_type n) const;
+ size_type find_first_not_of (const charT* s, size_type pos = 0) const
+ { return find_first_not_of (s, pos, traits::length (s)); }
+ size_type find_first_not_of (charT c, size_type pos = 0) const;
+
+ size_type find_last_not_of (const basic_string& str, size_type pos = npos) const
+ { return find_last_not_of (str.data(), pos, str.length()); }
+ size_type find_last_not_of (const charT* s, size_type pos, size_type n) const;
+ size_type find_last_not_of (const charT* s, size_type pos = npos) const
+ { return find_last_not_of (s, pos, traits::length (s)); }
+ size_type find_last_not_of (charT c, size_type pos = npos) const;
+
+ basic_string substr (size_type pos = 0, size_type n = npos) const
+ { return basic_string (*this, pos, n); }
+
+ int compare (const basic_string& str, size_type pos = 0, size_type n = npos) const;
+ // There is no 'strncmp' equivalent for charT pointers.
+ int compare (const charT* s, size_type pos, size_type n) const;
+ int compare (const charT* s, size_type pos = 0) const
+ { return compare (s, pos, traits::length (s)); }
+
+ iterator begin () { selfish (); return &(*this)[0]; }
+ iterator end () { selfish (); return &(*this)[length ()]; }
+ const_iterator begin () const { return &(*rep ())[0]; }
+ const_iterator end () const { return &(*rep ())[length ()]; }
+
+#if 0
+ reverse_iterator rbegin() { return reverse_iterator (end ()); }
+ const_reverse_iterator rbegin() const
+ { return const_reverse_iterator (end ()); }
+ reverse_iterator rend() { return reverse_iterator (begin ()); }
+ const_reverse_iterator rend() const
+ { return const reverse_iterator (begin ()); }
+#endif
+
+private:
+ void alloc (size_type size, bool save);
+ static size_type _find (const charT* ptr, charT c, size_type xpos, size_type len);
+ inline bool check_realloc (size_type s) const;
+
+ static Rep nilRep;
+ charT *dat;
+};
+
+template <class charT, class traits>
+inline basic_string <charT, traits>
+operator+ (const basic_string <charT, traits>& lhs,
+ const basic_string <charT, traits>& rhs)
+{
+ basic_string <charT, traits> str (lhs);
+ str.append (rhs);
+ return str;
+}
+
+template <class charT, class traits>
+inline basic_string <charT, traits>
+operator+ (const charT* lhs, const basic_string <charT, traits>& rhs)
+{
+ basic_string <charT, traits> str (lhs);
+ str.append (rhs);
+ return str;
+}
+
+template <class charT, class traits>
+inline basic_string <charT, traits>
+operator+ (charT lhs, const basic_string <charT, traits>& rhs)
+{
+ basic_string <charT, traits> str (1, lhs);
+ str.append (rhs);
+ return str;
+}
+
+template <class charT, class traits>
+inline basic_string <charT, traits>
+operator+ (const basic_string <charT, traits>& lhs, const charT* rhs)
+{
+ basic_string <charT, traits> str (lhs);
+ str.append (rhs);
+ return str;
+}
+
+template <class charT, class traits>
+inline basic_string <charT, traits>
+operator+ (const basic_string <charT, traits>& lhs, charT rhs)
+{
+ basic_string <charT, traits> str (lhs);
+ str.append (1, rhs);
+ return str;
+}
+
+template <class charT, class traits>
+inline bool
+operator== (const basic_string <charT, traits>& lhs,
+ const basic_string <charT, traits>& rhs)
+{
+ return (lhs.compare (rhs) == 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator== (const charT* lhs, const basic_string <charT, traits>& rhs)
+{
+ return (rhs.compare (lhs) == 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator== (const basic_string <charT, traits>& lhs, const charT* rhs)
+{
+ return (lhs.compare (rhs) == 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator!= (const charT* lhs, const basic_string <charT, traits>& rhs)
+{
+ return (rhs.compare (lhs) != 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator!= (const basic_string <charT, traits>& lhs, const charT* rhs)
+{
+ return (lhs.compare (rhs) != 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator< (const basic_string <charT, traits>& lhs,
+ const basic_string <charT, traits>& rhs)
+{
+ return (lhs.compare (rhs) < 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator< (const charT* lhs, const basic_string <charT, traits>& rhs)
+{
+ return (rhs.compare (lhs) > 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator< (const basic_string <charT, traits>& lhs, const charT* rhs)
+{
+ return (lhs.compare (rhs) < 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator> (const charT* lhs, const basic_string <charT, traits>& rhs)
+{
+ return (rhs.compare (lhs) < 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator> (const basic_string <charT, traits>& lhs, const charT* rhs)
+{
+ return (lhs.compare (rhs) > 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator<= (const charT* lhs, const basic_string <charT, traits>& rhs)
+{
+ return (rhs.compare (lhs) >= 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator<= (const basic_string <charT, traits>& lhs, const charT* rhs)
+{
+ return (lhs.compare (rhs) <= 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator>= (const charT* lhs, const basic_string <charT, traits>& rhs)
+{
+ return (rhs.compare (lhs) <= 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator>= (const basic_string <charT, traits>& lhs, const charT* rhs)
+{
+ return (lhs.compare (rhs) >= 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator!= (const basic_string <charT, traits>& lhs,
+ const basic_string <charT, traits>& rhs)
+{
+ return (lhs.compare (rhs) != 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator> (const basic_string <charT, traits>& lhs,
+ const basic_string <charT, traits>& rhs)
+{
+ return (lhs.compare (rhs) > 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator<= (const basic_string <charT, traits>& lhs,
+ const basic_string <charT, traits>& rhs)
+{
+ return (lhs.compare (rhs) <= 0);
+}
+
+template <class charT, class traits>
+inline bool
+operator>= (const basic_string <charT, traits>& lhs,
+ const basic_string <charT, traits>& rhs)
+{
+ return (lhs.compare (rhs) >= 0);
+}
+
+class istream; class ostream;
+template <class charT, class traits> istream&
+operator>> (istream&, basic_string <charT, traits>&);
+template <class charT, class traits> ostream&
+operator<< (ostream&, const basic_string <charT, traits>&);
+template <class charT, class traits> istream&
+getline (istream&, basic_string <charT, traits>&, charT delim = '\n');
+
+} // extern "C++"
+
+#endif
diff --git a/libstdc++/std/complext.cc b/libstdc++/std/complext.cc
new file mode 100644
index 00000000000..d50bf0871f6
--- /dev/null
+++ b/libstdc++/std/complext.cc
@@ -0,0 +1,273 @@
+// Member templates for the -*- C++ -*- complex number classes.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification in the 27 May 1994
+// C++ working paper, ANSI document X3J16/94-0098.
+
+#include <complex>
+
+extern "C++" {
+template <class FLOAT> complex<FLOAT>
+cos (const complex<FLOAT>& x)
+{
+ return complex<FLOAT> (cos (real (x)) * cosh (imag (x)),
+ - sin (real (x)) * sinh (imag (x)));
+}
+
+template <class FLOAT> complex<FLOAT>
+cosh (const complex<FLOAT>& x)
+{
+ return complex<FLOAT> (cosh (real (x)) * cos (imag (x)),
+ sinh (real (x)) * sin (imag (x)));
+}
+
+template <class FLOAT> complex<FLOAT>
+exp (const complex<FLOAT>& x)
+{
+ return polar (FLOAT (exp (real (x))), imag (x));
+}
+
+template <class FLOAT> complex<FLOAT>
+log (const complex<FLOAT>& x)
+{
+ return complex<FLOAT> (log (abs (x)), arg (x));
+}
+
+template <class FLOAT> complex<FLOAT>
+pow (const complex<FLOAT>& x, const complex<FLOAT>& y)
+{
+ FLOAT logr = log (abs (x));
+ FLOAT t = arg (x);
+
+ return polar (FLOAT (exp (logr * real (y) - imag (y) * t)),
+ FLOAT (imag (y) * logr + real (y) * t));
+}
+
+template <class FLOAT> complex<FLOAT>
+pow (const complex<FLOAT>& x, FLOAT y)
+{
+ return exp (FLOAT (y) * log (x));
+}
+
+template <class FLOAT> complex<FLOAT>
+pow (FLOAT x, const complex<FLOAT>& y)
+{
+ return exp (y * FLOAT (log (x)));
+}
+
+template <class FLOAT> complex<FLOAT>
+sin (const complex<FLOAT>& x)
+{
+ return complex<FLOAT> (sin (real (x)) * cosh (imag (x)),
+ cos (real (x)) * sinh (imag (x)));
+}
+
+template <class FLOAT> complex<FLOAT>
+sinh (const complex<FLOAT>& x)
+{
+ return complex<FLOAT> (sinh (real (x)) * cos (imag (x)),
+ cosh (real (x)) * sin (imag (x)));
+}
+
+#include <iostream.h>
+
+template <class FLOAT> istream&
+operator >> (istream& is, complex<FLOAT>& x)
+{
+ FLOAT re, im = 0;
+ char ch = 0;
+
+ if (is.ipfx0 ())
+ {
+ if (is.peek () == '(')
+ is >> ch;
+ is >> re;
+ if (ch == '(')
+ {
+ is >> ch;
+ if (ch == ',')
+ is >> im >> ch;
+ }
+ }
+ is.isfx ();
+
+ if (ch != 0 && ch != ')')
+ is.setstate (ios::failbit);
+ else if (is.good ())
+ x = complex<FLOAT> (re, im);
+
+ return is;
+}
+
+template <class FLOAT> ostream&
+operator << (ostream& os, const complex<FLOAT>& x)
+{
+ return os << '(' << real (x) << ',' << imag (x) << ')';
+}
+
+// The code below is adapted from f2c's libF77, and is subject to this
+// copyright:
+
+/****************************************************************
+Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories 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 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 and Bellcore disclaim all warranties with regard to this
+software, including all implied warranties of merchantability
+and fitness. In no event shall AT&T 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.
+****************************************************************/
+
+template <class FLOAT> complex<FLOAT>&
+__doadv (complex<FLOAT>* ths, const complex<FLOAT>& y)
+{
+ FLOAT ar = abs (y.re);
+ FLOAT ai = abs (y.im);
+ FLOAT nr, ni;
+ FLOAT t, d;
+ if (ar <= ai)
+ {
+ t = y.re / y.im;
+ d = y.im * (1 + t*t);
+ nr = (ths->re * t + ths->im) / d;
+ ni = (ths->im * t - ths->re) / d;
+ }
+ else
+ {
+ t = y.im / y.re;
+ d = y.re * (1 + t*t);
+ nr = (ths->re + ths->im * t) / d;
+ ni = (ths->im - ths->re * t) / d;
+ }
+ ths->re = nr;
+ ths->im = ni;
+ return *ths;
+}
+
+template <class FLOAT> complex<FLOAT>
+operator / (const complex<FLOAT>& x, const complex<FLOAT>& y)
+{
+ FLOAT ar = abs (real (y));
+ FLOAT ai = abs (imag (y));
+ FLOAT nr, ni;
+ FLOAT t, d;
+ if (ar <= ai)
+ {
+ t = real (y) / imag (y);
+ d = imag (y) * (1 + t*t);
+ nr = (real (x) * t + imag (x)) / d;
+ ni = (imag (x) * t - real (x)) / d;
+ }
+ else
+ {
+ t = imag (y) / real (y);
+ d = real (y) * (1 + t*t);
+ nr = (real (x) + imag (x) * t) / d;
+ ni = (imag (x) - real (x) * t) / d;
+ }
+ return complex<FLOAT> (nr, ni);
+}
+
+template <class FLOAT> complex<FLOAT>
+operator / (FLOAT x, const complex<FLOAT>& y)
+{
+ FLOAT ar = abs (real (y));
+ FLOAT ai = abs (imag (y));
+ FLOAT nr, ni;
+ FLOAT t, d;
+ if (ar <= ai)
+ {
+ t = real (y) / imag (y);
+ d = imag (y) * (1 + t*t);
+ nr = x * t / d;
+ ni = -x / d;
+ }
+ else
+ {
+ t = imag (y) / real (y);
+ d = real (y) * (1 + t*t);
+ nr = x / d;
+ ni = -x * t / d;
+ }
+ return complex<FLOAT> (nr, ni);
+}
+
+template <class FLOAT> complex<FLOAT>
+pow (const complex<FLOAT>& xin, int y)
+{
+ if (y == 0)
+ return complex<FLOAT> (1.0);
+ complex<FLOAT> r (1.0);
+ complex<FLOAT> x (xin);
+ if (y < 0)
+ {
+ y = -y;
+ x = 1/x;
+ }
+ for (;;)
+ {
+ if (y & 1)
+ r *= x;
+ if (y >>= 1)
+ x *= x;
+ else
+ return r;
+ }
+}
+
+template <class FLOAT> complex<FLOAT>
+sqrt (const complex<FLOAT>& x)
+{
+ FLOAT r = abs (x);
+ FLOAT nr, ni;
+ if (r == 0.0)
+ nr = ni = r;
+ else if (real (x) > 0)
+ {
+ nr = sqrt (0.5 * (r + real (x)));
+ ni = imag (x) / nr / 2;
+ }
+ else
+ {
+ ni = sqrt (0.5 * (r - real (x)));
+ if (imag (x) < 0)
+ ni = - ni;
+ nr = imag (x) / ni / 2;
+ }
+ return complex<FLOAT> (nr, ni);
+}
+} // extern "C++"
diff --git a/libstdc++/std/complext.h b/libstdc++/std/complext.h
new file mode 100644
index 00000000000..57976f002ce
--- /dev/null
+++ b/libstdc++/std/complext.h
@@ -0,0 +1,423 @@
+// The template and inlines for the -*- C++ -*- complex number classes.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files compiled
+// with a GNU compiler to produce an executable, this does not cause the
+// resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why the
+// executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification in the 27 May 1994
+// C++ working paper, ANSI document X3J16/94-0098.
+
+#ifndef __COMPLEXT__
+#define __COMPLEXT__
+
+#ifdef __GNUG__
+#pragma interface
+#endif
+
+#include <cmath>
+
+#if ! defined (__GNUG__) && ! defined (__attribute__)
+#define __attribute__(foo) /* Ignore. */
+#endif
+
+class istream;
+class ostream;
+
+extern "C++" {
+template <class _FLT>
+class complex
+{
+public:
+ complex (_FLT r = 0, _FLT i = 0): re (r), im (i) { }
+ complex& operator += (const complex&);
+ complex& operator -= (const complex&);
+ complex& operator *= (const complex&);
+ complex& operator /= (const complex&);
+ _FLT real () const { return re; }
+ _FLT imag () const { return im; }
+private:
+ _FLT re, im;
+
+ friend complex& __doapl (complex *, const complex&);
+ friend complex& __doami (complex *, const complex&);
+ friend complex& __doaml (complex *, const complex&);
+ friend complex& __doadv (complex *, const complex&);
+
+ // These functions are specified as friends for purposes of name injection;
+ // they do not actually reference private members.
+ friend _FLT real (const complex&) __attribute__ ((const));
+ friend _FLT imag (const complex&) __attribute__ ((const));
+ friend complex operator + (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator + (const complex&, _FLT) __attribute__ ((const));
+ friend complex operator + (_FLT, const complex&) __attribute__ ((const));
+ friend complex operator - (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator - (const complex&, _FLT) __attribute__ ((const));
+ friend complex operator - (_FLT, const complex&) __attribute__ ((const));
+ friend complex operator * (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator * (const complex&, _FLT) __attribute__ ((const));
+ friend complex operator * (_FLT, const complex&) __attribute__ ((const));
+ friend complex operator / (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator / (const complex&, _FLT) __attribute__ ((const));
+ friend complex operator / (_FLT, const complex&) __attribute__ ((const));
+ friend bool operator == (const complex&, const complex&) __attribute__ ((const));
+ friend bool operator == (const complex&, _FLT) __attribute__ ((const));
+ friend bool operator == (_FLT, const complex&) __attribute__ ((const));
+ friend bool operator != (const complex&, const complex&) __attribute__ ((const));
+ friend bool operator != (const complex&, _FLT) __attribute__ ((const));
+ friend bool operator != (_FLT, const complex&) __attribute__ ((const));
+ friend complex polar (_FLT, _FLT) __attribute__ ((const));
+ friend complex pow (const complex&, const complex&) __attribute__ ((const));
+ friend complex pow (const complex&, _FLT) __attribute__ ((const));
+ friend complex pow (const complex&, int) __attribute__ ((const));
+ friend complex pow (_FLT, const complex&) __attribute__ ((const));
+ friend istream& operator>> (istream&, complex&);
+ friend ostream& operator<< (ostream&, const complex&);
+};
+
+// Declare specializations.
+class complex<float>;
+class complex<double>;
+class complex<long double>;
+
+template <class _FLT>
+inline complex<_FLT>&
+__doapl (complex<_FLT>* ths, const complex<_FLT>& r)
+{
+ ths->re += r.re;
+ ths->im += r.im;
+ return *ths;
+}
+template <class _FLT>
+inline complex<_FLT>&
+complex<_FLT>::operator += (const complex<_FLT>& r)
+{
+ return __doapl (this, r);
+}
+
+template <class _FLT>
+inline complex<_FLT>&
+__doami (complex<_FLT>* ths, const complex<_FLT>& r)
+{
+ ths->re -= r.re;
+ ths->im -= r.im;
+ return *ths;
+}
+template <class _FLT>
+inline complex<_FLT>&
+complex<_FLT>::operator -= (const complex<_FLT>& r)
+{
+ return __doami (this, r);
+}
+
+template <class _FLT>
+inline complex<_FLT>&
+__doaml (complex<_FLT>* ths, const complex<_FLT>& r)
+{
+ _FLT f = ths->re * r.re - ths->im * r.im;
+ ths->im = ths->re * r.im + ths->im * r.re;
+ ths->re = f;
+ return *ths;
+}
+template <class _FLT>
+inline complex<_FLT>&
+complex<_FLT>::operator *= (const complex<_FLT>& r)
+{
+ return __doaml (this, r);
+}
+
+template <class _FLT> complex<_FLT>&
+ __doadv (complex<_FLT>* ths, const complex<_FLT>& r);
+
+template <class _FLT>
+inline complex<_FLT>&
+complex<_FLT>::operator /= (const complex<_FLT>& r)
+{
+ return __doadv (this, r);
+}
+
+template <class _FLT> inline _FLT
+imag (const complex<_FLT>& x) __attribute__ ((const));
+
+template <class _FLT> inline _FLT
+imag (const complex<_FLT>& x)
+{
+ return x.imag ();
+}
+
+template <class _FLT> inline _FLT
+real (const complex<_FLT>& x) __attribute__ ((const));
+
+template <class _FLT> inline _FLT
+real (const complex<_FLT>& x)
+{
+ return x.real ();
+}
+
+template <class _FLT> inline complex<_FLT>
+operator + (const complex<_FLT>& x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator + (const complex<_FLT>& x, const complex<_FLT>& y)
+{
+ return complex<_FLT> (real (x) + real (y), imag (x) + imag (y));
+}
+
+template <class _FLT> inline complex<_FLT>
+operator + (const complex<_FLT>& x, _FLT y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator + (const complex<_FLT>& x, _FLT y)
+{
+ return complex<_FLT> (real (x) + y, imag (x));
+}
+
+template <class _FLT> inline complex<_FLT>
+operator + (_FLT x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator + (_FLT x, const complex<_FLT>& y)
+{
+ return complex<_FLT> (x + real (y), imag (y));
+}
+
+template <class _FLT> inline complex<_FLT>
+operator - (const complex<_FLT>& x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator - (const complex<_FLT>& x, const complex<_FLT>& y)
+{
+ return complex<_FLT> (real (x) - real (y), imag (x) - imag (y));
+}
+
+template <class _FLT> inline complex<_FLT>
+operator - (const complex<_FLT>& x, _FLT y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator - (const complex<_FLT>& x, _FLT y)
+{
+ return complex<_FLT> (real (x) - y, imag (x));
+}
+
+template <class _FLT> inline complex<_FLT>
+operator - (_FLT x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator - (_FLT x, const complex<_FLT>& y)
+{
+ return complex<_FLT> (x - real (y), - imag (y));
+}
+
+template <class _FLT> inline complex<_FLT>
+operator * (const complex<_FLT>& x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator * (const complex<_FLT>& x, const complex<_FLT>& y)
+{
+ return complex<_FLT> (real (x) * real (y) - imag (x) * imag (y),
+ real (x) * imag (y) + imag (x) * real (y));
+}
+
+template <class _FLT> inline complex<_FLT>
+operator * (const complex<_FLT>& x, _FLT y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator * (const complex<_FLT>& x, _FLT y)
+{
+ return complex<_FLT> (real (x) * y, imag (x) * y);
+}
+
+template <class _FLT> inline complex<_FLT>
+operator * (_FLT x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator * (_FLT x, const complex<_FLT>& y)
+{
+ return complex<_FLT> (x * real (y), x * imag (y));
+}
+
+template <class _FLT> complex<_FLT>
+operator / (const complex<_FLT>& x, _FLT y) __attribute__ ((const));
+
+template <class _FLT> complex<_FLT>
+operator / (const complex<_FLT>& x, _FLT y)
+{
+ return complex<_FLT> (real (x) / y, imag (x) / y);
+}
+
+template <class _FLT> inline complex<_FLT>
+operator + (const complex<_FLT>& x) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator + (const complex<_FLT>& x)
+{
+ return x;
+}
+
+template <class _FLT> inline complex<_FLT>
+operator - (const complex<_FLT>& x) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+operator - (const complex<_FLT>& x)
+{
+ return complex<_FLT> (-real (x), -imag (x));
+}
+
+template <class _FLT> inline bool
+operator == (const complex<_FLT>& x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline bool
+operator == (const complex<_FLT>& x, const complex<_FLT>& y)
+{
+ return real (x) == real (y) && imag (x) == imag (y);
+}
+
+template <class _FLT> inline bool
+operator == (const complex<_FLT>& x, _FLT y) __attribute__ ((const));
+
+template <class _FLT> inline bool
+operator == (const complex<_FLT>& x, _FLT y)
+{
+ return real (x) == y && imag (x) == 0;
+}
+
+template <class _FLT> inline bool
+operator == (_FLT x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline bool
+operator == (_FLT x, const complex<_FLT>& y)
+{
+ return x == real (y) && imag (y) == 0;
+}
+
+template <class _FLT> inline bool
+operator != (const complex<_FLT>& x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline bool
+operator != (const complex<_FLT>& x, const complex<_FLT>& y)
+{
+ return real (x) != real (y) || imag (x) != imag (y);
+}
+
+template <class _FLT> inline bool
+operator != (const complex<_FLT>& x, _FLT y) __attribute__ ((const));
+
+template <class _FLT> inline bool
+operator != (const complex<_FLT>& x, _FLT y)
+{
+ return real (x) != y || imag (x) != 0;
+}
+
+template <class _FLT> inline bool
+operator != (_FLT x, const complex<_FLT>& y) __attribute__ ((const));
+
+template <class _FLT> inline bool
+operator != (_FLT x, const complex<_FLT>& y)
+{
+ return x != real (y) || imag (y) != 0;
+}
+
+// Some targets don't provide a prototype for hypot when -ansi.
+extern "C" double hypot (double, double) __attribute__ ((const));
+
+template <class _FLT> inline _FLT
+abs (const complex<_FLT>& x) __attribute__ ((const));
+
+template <class _FLT> inline _FLT
+abs (const complex<_FLT>& x)
+{
+ return hypot (real (x), imag (x));
+}
+
+template <class _FLT> inline _FLT
+arg (const complex<_FLT>& x) __attribute__ ((const));
+
+template <class _FLT> inline _FLT
+arg (const complex<_FLT>& x)
+{
+ return atan2 (imag (x), real (x));
+}
+
+template <class _FLT> inline complex<_FLT>
+polar (_FLT r, _FLT t) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+polar (_FLT r, _FLT t)
+{
+ return complex<_FLT> (r * cos (t), r * sin (t));
+}
+
+template <class _FLT> inline complex<_FLT>
+conj (const complex<_FLT>& x) __attribute__ ((const));
+
+template <class _FLT> inline complex<_FLT>
+conj (const complex<_FLT>& x)
+{
+ return complex<_FLT> (real (x), -imag (x));
+}
+
+template <class _FLT> inline _FLT
+norm (const complex<_FLT>& x) __attribute__ ((const));
+
+template <class _FLT> inline _FLT
+norm (const complex<_FLT>& x)
+{
+ return real (x) * real (x) + imag (x) * imag (x);
+}
+
+// Declarations of templates in complext.ccI
+
+template <class _FLT> complex<_FLT>
+ operator / (const complex<_FLT>&, const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ operator / (_FLT, const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ cos (const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ cosh (const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ exp (const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ log (const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ pow (const complex<_FLT>&, const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ pow (const complex<_FLT>&, _FLT) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ pow (const complex<_FLT>&, int) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ pow (_FLT, const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ sin (const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ sinh (const complex<_FLT>&) __attribute__ ((const));
+template <class _FLT> complex<_FLT>
+ sqrt (const complex<_FLT>&) __attribute__ ((const));
+
+template <class _FLT> istream& operator >> (istream&, complex<_FLT>&);
+template <class _FLT> ostream& operator << (ostream&, const complex<_FLT>&);
+} // extern "C++"
+
+// Specializations and such
+
+#include <std/fcomplex.h>
+#include <std/dcomplex.h>
+#include <std/ldcomplex.h>
+
+#endif
diff --git a/libstdc++/std/dcomplex.h b/libstdc++/std/dcomplex.h
new file mode 100644
index 00000000000..fde3f09ca5c
--- /dev/null
+++ b/libstdc++/std/dcomplex.h
@@ -0,0 +1,94 @@
+// The -*- C++ -*- double_complex class.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification in the 27 May 1994
+// C++ working paper, ANSI document X3J16/94-0098.
+
+#ifndef __DCOMPLEX__
+#define __DCOMPLEX__
+
+#ifdef __GNUG__
+#pragma interface "dcomplex"
+#endif
+
+extern "C++" {
+class complex<double>
+{
+public:
+ complex (double r = 0, double i = 0): re (r), im (i) { }
+ complex (const complex<float>& r): re (r.real ()), im (r.imag ()) { }
+ explicit complex (const complex<long double>& r);
+
+ complex& operator+= (const complex& r) { return __doapl (this, r); }
+ complex& operator-= (const complex& r) { return __doami (this, r); }
+ complex& operator*= (const complex& r) { return __doaml (this, r); }
+ complex& operator/= (const complex& r) { return __doadv (this, r); }
+
+ double real () const { return re; }
+ double imag () const { return im; }
+private:
+ double re, im;
+
+ friend complex& __doapl (complex *, const complex&);
+ friend complex& __doami (complex *, const complex&);
+ friend complex& __doaml (complex *, const complex&);
+ friend complex& __doadv (complex *, const complex&);
+
+ // These functions are specified as friends for purposes of name injection;
+ // they do not actually reference private members.
+ friend double real (const complex& x) { return x.real (); }
+ friend double imag (const complex& x) { return x.imag (); }
+ friend complex operator + (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator + (const complex&, double) __attribute__ ((const));
+ friend complex operator + (double, const complex&) __attribute__ ((const));
+ friend complex operator - (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator - (const complex&, double) __attribute__ ((const));
+ friend complex operator - (double, const complex&) __attribute__ ((const));
+ friend complex operator * (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator * (const complex&, double) __attribute__ ((const));
+ friend complex operator * (double, const complex&) __attribute__ ((const));
+ friend complex operator / (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator / (const complex&, double) __attribute__ ((const));
+ friend complex operator / (double, const complex&) __attribute__ ((const));
+ friend bool operator == (const complex&, const complex&) __attribute__ ((const));
+ friend bool operator == (const complex&, double) __attribute__ ((const));
+ friend bool operator == (double, const complex&) __attribute__ ((const));
+ friend bool operator != (const complex&, const complex&) __attribute__ ((const));
+ friend bool operator != (const complex&, double) __attribute__ ((const));
+ friend bool operator != (double, const complex&) __attribute__ ((const));
+ friend complex polar (double, double) __attribute__ ((const));
+ friend complex pow (const complex&, const complex&) __attribute__ ((const));
+ friend complex pow (const complex&, double) __attribute__ ((const));
+ friend complex pow (const complex&, int) __attribute__ ((const));
+ friend complex pow (double, const complex&) __attribute__ ((const));
+ friend istream& operator>> (istream&, complex&);
+ friend ostream& operator<< (ostream&, const complex&);
+};
+
+inline complex<float>::complex (const complex<double>& r)
+: re (r.real ()), im (r.imag ())
+{ }
+} // extern "C++"
+
+#endif
diff --git a/libstdc++/std/fcomplex.h b/libstdc++/std/fcomplex.h
new file mode 100644
index 00000000000..3a389e08a76
--- /dev/null
+++ b/libstdc++/std/fcomplex.h
@@ -0,0 +1,90 @@
+// The -*- C++ -*- float_complex class.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification in the 27 May 1994
+// C++ working paper, ANSI document X3J16/94-0098.
+
+#ifndef __FCOMPLEX__
+#define __FCOMPLEX__
+
+#ifdef __GNUG__
+#pragma interface "fcomplex"
+#endif
+
+extern "C++" {
+class complex<float>
+{
+public:
+ complex (float r = 0, float i = 0): re (r), im (i) { }
+ explicit complex (const complex<double>& r);
+ explicit complex (const complex<long double>& r);
+
+ complex& operator+= (const complex& r) { return __doapl (this, r); }
+ complex& operator-= (const complex& r) { return __doami (this, r); }
+ complex& operator*= (const complex& r) { return __doaml (this, r); }
+ complex& operator/= (const complex& r) { return __doadv (this, r); }
+
+ float real () const { return re; }
+ float imag () const { return im; }
+private:
+ float re, im;
+
+ friend complex& __doapl (complex *, const complex&);
+ friend complex& __doami (complex *, const complex&);
+ friend complex& __doaml (complex *, const complex&);
+ friend complex& __doadv (complex *, const complex&);
+
+ // These functions are specified as friends for purposes of name injection;
+ // they do not actually reference private members.
+ friend float real (const complex& x) { return x.real (); }
+ friend float imag (const complex& x) { return x.imag (); }
+ friend complex operator + (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator + (const complex&, float) __attribute__ ((const));
+ friend complex operator + (float, const complex&) __attribute__ ((const));
+ friend complex operator - (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator - (const complex&, float) __attribute__ ((const));
+ friend complex operator - (float, const complex&) __attribute__ ((const));
+ friend complex operator * (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator * (const complex&, float) __attribute__ ((const));
+ friend complex operator * (float, const complex&) __attribute__ ((const));
+ friend complex operator / (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator / (const complex&, float) __attribute__ ((const));
+ friend complex operator / (float, const complex&) __attribute__ ((const));
+ friend bool operator == (const complex&, const complex&) __attribute__ ((const));
+ friend bool operator == (const complex&, float) __attribute__ ((const));
+ friend bool operator == (float, const complex&) __attribute__ ((const));
+ friend bool operator != (const complex&, const complex&) __attribute__ ((const));
+ friend bool operator != (const complex&, float) __attribute__ ((const));
+ friend bool operator != (float, const complex&) __attribute__ ((const));
+ friend complex polar (float, float) __attribute__ ((const));
+ friend complex pow (const complex&, const complex&) __attribute__ ((const));
+ friend complex pow (const complex&, float) __attribute__ ((const));
+ friend complex pow (const complex&, int) __attribute__ ((const));
+ friend complex pow (float, const complex&) __attribute__ ((const));
+ friend istream& operator>> (istream&, complex&);
+ friend ostream& operator<< (ostream&, const complex&);
+};
+} // extern "C++"
+
+#endif
diff --git a/libstdc++/std/ldcomplex.h b/libstdc++/std/ldcomplex.h
new file mode 100644
index 00000000000..9feb30326bd
--- /dev/null
+++ b/libstdc++/std/ldcomplex.h
@@ -0,0 +1,98 @@
+// The -*- C++ -*- long_double_complex class.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification in the 27 May 1994
+// C++ working paper, ANSI document X3J16/94-0098.
+
+#ifndef __LDCOMPLEX__
+#define __LDCOMPLEX__
+
+#ifdef __GNUG__
+#pragma interface "ldcomplex"
+#endif
+
+extern "C++" {
+class complex<long double>
+{
+public:
+ complex (long double r = 0, long double i = 0): re (r), im (i) { }
+ complex (const complex<float>& r): re (r.real ()), im (r.imag ()) { }
+ complex (const complex<double>& r): re (r.real ()), im (r.imag ()) { }
+
+ complex& operator+= (const complex& r) { return __doapl (this, r); }
+ complex& operator-= (const complex& r) { return __doami (this, r); }
+ complex& operator*= (const complex& r) { return __doaml (this, r); }
+ complex& operator/= (const complex& r) { return __doadv (this, r); }
+
+ long double real () const { return re; }
+ long double imag () const { return im; }
+private:
+ long double re, im;
+
+ friend complex& __doapl (complex *, const complex&);
+ friend complex& __doami (complex *, const complex&);
+ friend complex& __doaml (complex *, const complex&);
+ friend complex& __doadv (complex *, const complex&);
+
+ // These functions are specified as friends for purposes of name injection;
+ // they do not actually reference private members.
+ friend long double real (const complex& x) { return x.real (); }
+ friend long double imag (const complex& x) { return x.imag (); }
+ friend complex operator + (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator + (const complex&, long double) __attribute__ ((const));
+ friend complex operator + (long double, const complex&) __attribute__ ((const));
+ friend complex operator - (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator - (const complex&, long double) __attribute__ ((const));
+ friend complex operator - (long double, const complex&) __attribute__ ((const));
+ friend complex operator * (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator * (const complex&, long double) __attribute__ ((const));
+ friend complex operator * (long double, const complex&) __attribute__ ((const));
+ friend complex operator / (const complex&, const complex&) __attribute__ ((const));
+ friend complex operator / (const complex&, long double) __attribute__ ((const));
+ friend complex operator / (long double, const complex&) __attribute__ ((const));
+ friend bool operator == (const complex&, const complex&) __attribute__ ((const));
+ friend bool operator == (const complex&, long double) __attribute__ ((const));
+ friend bool operator == (long double, const complex&) __attribute__ ((const));
+ friend bool operator != (const complex&, const complex&) __attribute__ ((const));
+ friend bool operator != (const complex&, long double) __attribute__ ((const));
+ friend bool operator != (long double, const complex&) __attribute__ ((const));
+ friend complex polar (long double, long double) __attribute__ ((const));
+ friend complex pow (const complex&, const complex&) __attribute__ ((const));
+ friend complex pow (const complex&, long double) __attribute__ ((const));
+ friend complex pow (const complex&, int) __attribute__ ((const));
+ friend complex pow (long double, const complex&) __attribute__ ((const));
+ friend istream& operator>> (istream&, complex&);
+ friend ostream& operator<< (ostream&, const complex&);
+};
+
+inline complex<float>::complex (const complex<long double>& r)
+: re (r.real ()), im (r.imag ())
+{ }
+
+inline complex<double>::complex (const complex<long double>& r)
+: re (r.real ()), im (r.imag ())
+{ }
+} // extern "C++"
+
+#endif
diff --git a/libstdc++/std/straits.h b/libstdc++/std/straits.h
new file mode 100644
index 00000000000..c80e7ab7a68
--- /dev/null
+++ b/libstdc++/std/straits.h
@@ -0,0 +1,161 @@
+// Character traits template for the -*- C++ -*- string classes.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Jason Merrill based upon the specification by Takanori Adachi
+// in ANSI X3J16/94-0013R2.
+
+#ifndef __STRING_CHAR_TRAITS__
+#define __STRING_CHAR_TRAITS__
+
+#ifdef __GNUG__
+// For string_char_traits <char>
+#pragma interface "std/straits.h"
+#endif
+
+#include <cstddef>
+
+extern "C++" {
+template <class charT>
+struct string_char_traits {
+ typedef charT char_type; // for users to acquire the basic character type
+
+ // constraints
+
+ static void assign (char_type& c1, const char_type& c2)
+ { c1 = c2; }
+ static bool eq (const char_type& c1, const char_type& c2)
+ { return (c1 == c2); }
+ static bool ne (const char_type& c1, const char_type& c2)
+ { return !(c1 == c2); }
+ static bool lt (const char_type& c1, const char_type& c2)
+ { return (c1 < c2); }
+ static char_type eos () { return char_type(); } // the null character
+ static bool is_del(char_type a) { return 0; }
+ // characteristic function for delimiters of charT
+
+ // speed-up functions
+
+ static int compare (const char_type* s1, const char_type* s2, size_t n)
+ {
+ size_t i;
+ for (i = 0; i < n; ++i)
+ if (ne (s1[i], s2[i]))
+ return lt (s1[i], s2[i]) ? -1 : 1;
+
+ return 0;
+ }
+
+ static size_t length (const char_type* s)
+ {
+ size_t l = 0;
+ while (ne (*s++, eos ()))
+ ++l;
+ return l;
+ }
+
+ static char_type* copy (char_type* s1, const char_type* s2, size_t n)
+ {
+ for (; n--; )
+ assign (s1[n], s2[n]);
+ return s1;
+ }
+
+ static char_type* move (char_type* s1, const char_type* s2, size_t n)
+ {
+ char_type a[n];
+ size_t i;
+ for (i = 0; i < n; ++i)
+ assign (a[i], s2[i]);
+ for (i = 0; i < n; ++i)
+ assign (s1[i], a[i]);
+ return s1;
+ }
+
+ static char_type* set (char_type* s1, const char_type& c, size_t n)
+ {
+ for (; n--; )
+ assign (s1[n], c);
+ return s1;
+ }
+};
+
+class istream;
+class ostream;
+#include <cctype>
+#include <cstring>
+
+struct string_char_traits <char> {
+ typedef char char_type;
+
+ static void assign (char_type& c1, const char_type& c2)
+ { c1 = c2; }
+ static bool eq (const char_type & c1, const char_type& c2)
+ { return (c1 == c2); }
+ static bool ne (const char_type& c1, const char_type& c2)
+ { return (c1 != c2); }
+ static bool lt (const char_type& c1, const char_type& c2)
+ { return (c1 < c2); }
+ static char_type eos () { return 0; }
+ static bool is_del(char_type a) { return isspace(a); }
+
+ static int compare (const char_type* s1, const char_type* s2, size_t n)
+ { return memcmp (s1, s2, n); }
+ static size_t length (const char_type* s)
+ { return strlen (s); }
+ static char_type* copy (char_type* s1, const char_type* s2, size_t n)
+ { return (char_type*) memcpy (s1, s2, n); }
+ static char_type* move (char_type* s1, const char_type* s2, size_t n)
+ { return (char_type*) memmove (s1, s2, n); }
+ static char_type* set (char_type* s1, const char_type& c, size_t n)
+ { return (char_type*) memset (s1, c, n); }
+};
+
+#if 0
+#include <cwctype>
+struct string_char_traits <wchar_t> {
+ typedef wchar_t char_type;
+
+ static void assign (char_type& c1, const char_type& c2)
+ { c1 = c2; }
+ static bool eq (const char_type & c1, const char_type& c2)
+ { return (c1 == c2); }
+ static bool ne (const char_type& c1, const char_type& c2)
+ { return (c1 != c2); }
+ static bool lt (const char_type& c1, const char_type& c2)
+ { return (c1 < c2); }
+ static char_type eos () { return 0; }
+ static bool is_del(char_type a) { return iswspace(a); }
+
+ static int compare (const char_type* s1, const char_type* s2, size_t n)
+ { return wmemcmp (s1, s2, n); }
+ static size_t length (const char_type* s)
+ { return wcslen (s); }
+ static char_type* copy (char_type* s1, const char_type* s2, size_t n)
+ { return wmemcpy (s1, s2, n); }
+ static char_type* set (char_type* s1, const char_type& c, size_t n)
+ { return wmemset (s1, c, n); }
+};
+#endif
+} // extern "C++"
+#endif
diff --git a/libstdc++/stdexcept b/libstdc++/stdexcept
new file mode 100644
index 00000000000..96be4d283b3
--- /dev/null
+++ b/libstdc++/stdexcept
@@ -0,0 +1,93 @@
+// Methods for Exception Support for -*- C++ -*-
+// Copyright (C) 1994, 1995, 1997 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+// As a special exception, if you link this library with files
+// compiled with a GNU compiler to produce an executable, this does not cause
+// the resulting executable to be covered by the GNU General Public License.
+// This exception does not however invalidate any other reasons why
+// the executable file might be covered by the GNU General Public License.
+
+// Written by Mike Stump based upon the specification in the 20 September 1994
+// C++ working paper, ANSI document X3J16/94-0158.
+
+#ifndef __STDEXCEPT__
+#define __STDEXCEPT__
+
+#ifdef __GNUG__
+#pragma interface "stdexcept"
+#endif
+
+#include <exception>
+#include <string>
+
+extern "C++" {
+
+class logic_error : public exception {
+ string _what;
+public:
+ logic_error(const string& what_arg): _what (what_arg) { }
+ virtual const char* what () const { return _what.c_str (); }
+};
+
+class domain_error : public logic_error {
+public:
+ domain_error (const string& what_arg): logic_error (what_arg) { }
+};
+
+class invalid_argument : public logic_error {
+public:
+ invalid_argument (const string& what_arg): logic_error (what_arg) { }
+};
+
+class length_error : public logic_error {
+public:
+ length_error (const string& what_arg): logic_error (what_arg) { }
+};
+
+class out_of_range : public logic_error {
+public:
+ out_of_range (const string& what_arg): logic_error (what_arg) { }
+};
+
+class runtime_error : public exception {
+ string _what;
+public:
+ runtime_error(const string& what_arg): _what (what_arg) { }
+ virtual const char* what () const { return _what.c_str (); }
+protected:
+ runtime_error(): exception () { }
+};
+
+class range_error : public runtime_error {
+public:
+ range_error (const string& what_arg): runtime_error (what_arg) { }
+};
+
+class overflow_error : public runtime_error {
+public:
+ overflow_error (const string& what_arg): runtime_error (what_arg) { }
+};
+
+class underflow_error : public runtime_error {
+public:
+ underflow_error (const string& what_arg): runtime_error (what_arg) { }
+};
+
+} // extern "C++"
+
+#endif
diff --git a/libstdc++/stdexcepti.cc b/libstdc++/stdexcepti.cc
new file mode 100644
index 00000000000..1ab8d889043
--- /dev/null
+++ b/libstdc++/stdexcepti.cc
@@ -0,0 +1,8 @@
+// Implementation file for Exception Support for -*- C++ -*-
+// This file is part of the GNU ANSI C++ Library.
+
+#ifdef __GNUG__
+#pragma implementation "stdexcept"
+#endif
+
+#include <stdexcept>
diff --git a/libstdc++/stl.h b/libstdc++/stl.h
new file mode 100644
index 00000000000..4b270742c9c
--- /dev/null
+++ b/libstdc++/stl.h
@@ -0,0 +1,15 @@
+// -*- C++ -*- compatibility header.
+// This file is part of the GNU ANSI C++ Library.
+
+#include <algorithm>
+#include <deque>
+#include <functional>
+#include <iterator>
+#include <list>
+#include <map>
+#include <memory>
+#include <numeric>
+#include <set>
+#include <stack>
+#include <utility>
+#include <vector>
diff --git a/libstdc++/stl/ChangeLog b/libstdc++/stl/ChangeLog
new file mode 100644
index 00000000000..b519b1811f3
--- /dev/null
+++ b/libstdc++/stl/ChangeLog
@@ -0,0 +1,192 @@
+Tue Aug 5 17:06:01 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * deque.h, function.h, hashtable.h, list.h, rope.h, ropeimpl.h,
+ tree.h: Update to July 31 SGI release.
+
+Fri Jul 18 10:06:56 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * algo.h, defalloc.h, hashtable.h, rope.h, ropeimpl.h, slist.h:
+ Update to June 30 SGI release.
+
+Fri Jul 04 02:17:15 1997 Ulrich Drepper <drepper@cygnus.com>
+
+ * tree.h (rb_tree): Reverse order of member initializations
+ to prevent warnings.
+
+Sun Jun 15 18:17:21 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * *.h: Update to 6/13 SGI release.
+
+Fri May 23 10:56:18 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * stl_config.h: Add support for exceptions with g++.
+
+ * *.h: Update to 5/8 SGI release.
+
+Thu Apr 24 19:00:23 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * *.h: Update to 3/24 SGI release.
+
+Wed Feb 19 18:19:18 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * *.h: Update to 2/18 SGI release.
+
+ * bool.h: Lose.
+
+Mon Feb 10 16:33:23 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * alloc.h: Don't define __USE_MALLOC for g++.
+ * bool.h: Lose g++ case.
+
+ * *.h: Update to 2/4 SGI release.
+
+Mon Jan 13 14:39:16 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * *.h: Update to 1/8 SGI release.
+
+Mon Sep 30 17:56:43 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * alloc.h (__unlock): Never use __lock_release.
+
+Fri Sep 27 19:03:06 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * alloc.h (__default_alloc_template): lock is a friend.
+
+Thu Sep 19 20:10:37 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ Propagate these changes to new STL code:
+ * tree.h: Rearrange member initializers in rb_tree constructors.
+ * vector.h (insert): Cast iterator difference to size_type to
+ avoid warning.
+
+ * *.h: Update to SGI snapshot (fixed).
+ * *.c, Makefile.in, configure.in: Removed.
+
+Sat Sep 14 09:43:06 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * deque.h, list.h, tree.h: Remove kludge obsoleted by new
+ overloading code.
+
+Sat Aug 10 14:59:50 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * tempbuf.cc (__stl_temp_buffer): Align like a pointer.
+
+Wed Jun 26 13:00:44 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * iterator.h: Add default template parameters.
+
+Wed Apr 24 10:45:22 1996 Doug Evans <dje@blues.cygnus.com>
+
+ * Makefile.in (tempbuf.o,random.o): Add rules for SunOS VPATH.
+
+Fri Apr 5 17:52:31 1996 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in (EXTRA_MOSTLYCLEAN): New, to remove stl.list.
+
+Fri Mar 22 14:58:30 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ Propagate these changes to new STL code:
+ * tree.h: Rearrange member initializers in rb_tree constructors.
+ * vector.h (insert): Cast iterator difference to size_type to
+ avoid warning.
+
+Sun Mar 10 07:49:03 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * deque.h (distance_type): Add overload for g++.
+ From Joe Buck.
+
+Thu Feb 22 14:07:12 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * bool.h: Revert.
+ * algo.h bvector.h deque.h function.h iterator.h list.h
+ pair.h stack.h tree.h vector.h: Wrap #include <bool.h> with
+ #ifndef __GNUG__.
+ * defalloc.h list.h deque.h tree.h: Use __GNUG__ to control
+ workarounds.
+
+Wed Feb 21 17:13:02 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * bool.h (TRUE, FALSE): Define for people expecting the bool.h
+ from libg++. Is this a good idea?
+
+Tue Feb 20 18:40:02 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * algo.h bool.h bvector.h defalloc.h deque.h function.h heap.h
+ iterator.h list.h map.h pair.h random.cc stack.h tree.c tree.h
+ vector.h: Revert to HP release with workarounds for missing
+ overloading functionality.
+ * Makefile.in (STL_OBJECTS): Remove tree.o.
+
+Thu Nov 9 17:05:23 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * algo.h algobase.h bvector.h defalloc.h deque.h function.h heap.h
+ iterator.h list.h map.h multimap.h multiset.h pair.h projectn.h
+ set.h stack.h tempbuf.h tree.h vector.h: Wrap #include <bool.h>
+ with #ifndef __GNUG__.
+
+Thu Nov 2 17:05:44 1995 Jason Merrill <jason@yorick.cygnus.com>
+
+ * deque.h (deque<T>::insert): Fix merge typo.
+ * vector.h (value_type): Lose.
+
+Thu Nov 2 14:33:47 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * algo.h, algobase.h, deque.h, function.h, list.h, pair.h, random.cc:
+ Merge in Oct 31 1995 release from HP.
+
+Fri Aug 11 17:11:12 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * list.h: Avoid duplicate construction and destruction of list_nodes.
+ Patch from Klamer Schutte <klamer@ph.tn.tudelft.nl>.
+
+Fri Aug 11 16:45:18 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * algo.h, algobase.h, deque.h: Merged in Jul 12 1995 release from HP.
+
+Mon Jun 5 18:38:56 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (stl.list): Depend on stamp-picdir.
+
+Wed May 17 02:30:47 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * tree.h: Rearrange member initializers in rb_tree constructors.
+
+ * Update to HP's February 7, 1995 release.
+
+Fri May 5 10:45:31 1995 Mike Stump <mrs@cygnus.com>
+
+ * random.cc (seed): Move `for' decl out of `for' statement.
+
+Wed Apr 26 13:09:16 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * configure.in (XCXXINCLUDES): Rename.
+
+Wed Mar 29 19:24:56 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * tree.h (insert): Return a value.
+
+ * vector.h (insert): Cast iterator difference to size_type to
+ avoid warning.
+
+Sun Feb 12 09:12:17 1995 Mike Stump <mrs@cygnus.com>
+
+ * tree.h (rb_tree::max_size): Add definition when using GNU
+ workaround.
+
+Thu Jan 12 01:37:42 1995 deanm@medulla.LABS.TEK.COM (Dean Messing)
+
+ * configure.in (LIBDIR): Set to yes.
+
+Fri Dec 30 18:26:20 1994 Mike Stump <mrs@cygnus.com>
+
+ * iterator.h: Add default template parameters where possible.
+
+Fri Dec 30 16:29:39 1994 Mike Stump <mrs@cygnus.com>
+
+ * algo.h: Change rand to __rand to fix make check on linux systems.
+
+Tue Nov 29 15:30:30 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Initial check-in, based on HP's October 21, 1994.
+
+
diff --git a/libstdc++/stl/README b/libstdc++/stl/README
new file mode 100644
index 00000000000..81bc7cf06ab
--- /dev/null
+++ b/libstdc++/stl/README
@@ -0,0 +1,16 @@
+This directory contains an SGI release of the C++ Standard Template
+Library, slightly modified to work with g++ (version 2.8.0 or newer).
+
+Note that this is based on a pre-Draft Standard for C++.
+Things are likely to change. For example, the header file names
+are very likely to change. The Allocator interface will change. Etc, etc.
+CYGNUS MAKES NO COMMITTMENT (yet) TO SUPPORT BACKWARD COMPATIBILITY FOR STL.
+
+For examples if things that should work, look in the ../tests directory.
+
+DOCUMENTATION:
+See http://www.sgi.com/Technology/STL/ or http://www.dinkumware.com/
+on the World-Wide Web.
+
+ --Jason Merrill
+Cygnus Support jason@cygnus.com
diff --git a/libstdc++/stl/algo.h b/libstdc++/stl/algo.h
new file mode 100644
index 00000000000..69f43c17a64
--- /dev/null
+++ b/libstdc++/stl/algo.h
@@ -0,0 +1,2665 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_ALGO_H
+#define __SGI_STL_ALGO_H
+
+#include <stdlib.h>
+#include <limits.h>
+#include <algobase.h>
+#include <heap.h>
+#include <tempbuf.h>
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+#pragma set woff 1209
+#endif
+
+template <class T>
+inline const T& __median(const T& a, const T& b, const T& c) {
+ if (a < b)
+ if (b < c)
+ return b;
+ else if (a < c)
+ return c;
+ else
+ return a;
+ else if (a < c)
+ return a;
+ else if (b < c)
+ return c;
+ else
+ return b;
+}
+
+template <class T, class Compare>
+inline const T& __median(const T& a, const T& b, const T& c, Compare comp) {
+ if (comp(a, b))
+ if (comp(b, c))
+ return b;
+ else if (comp(a, c))
+ return c;
+ else
+ return a;
+ else if (comp(a, c))
+ return a;
+ else if (comp(b, c))
+ return c;
+ else
+ return b;
+}
+
+template <class InputIterator, class Function>
+Function for_each(InputIterator first, InputIterator last, Function f) {
+ for ( ; first != last; ++first)
+ f(*first);
+ return f;
+}
+
+template <class InputIterator, class T>
+InputIterator find(InputIterator first, InputIterator last, const T& value) {
+ while (first != last && *first != value) ++first;
+ return first;
+}
+
+template <class InputIterator, class Predicate>
+InputIterator find_if(InputIterator first, InputIterator last,
+ Predicate pred) {
+ while (first != last && !pred(*first)) ++first;
+ return first;
+}
+
+template <class ForwardIterator>
+ForwardIterator adjacent_find(ForwardIterator first, ForwardIterator last) {
+ if (first == last) return last;
+ ForwardIterator next = first;
+ while(++next != last) {
+ if (*first == *next) return first;
+ first = next;
+ }
+ return last;
+}
+
+template <class ForwardIterator, class BinaryPredicate>
+ForwardIterator adjacent_find(ForwardIterator first, ForwardIterator last,
+ BinaryPredicate binary_pred) {
+ if (first == last) return last;
+ ForwardIterator next = first;
+ while(++next != last) {
+ if (binary_pred(*first, *next)) return first;
+ first = next;
+ }
+ return last;
+}
+
+template <class InputIterator, class T, class Size>
+void count(InputIterator first, InputIterator last, const T& value,
+ Size& n) {
+ for ( ; first != last; ++first)
+ if (*first == value)
+ ++n;
+}
+
+template <class InputIterator, class Predicate, class Size>
+void count_if(InputIterator first, InputIterator last, Predicate pred,
+ Size& n) {
+ for ( ; first != last; ++first)
+ if (pred(*first))
+ ++n;
+}
+
+#ifdef __STL_CLASS_PARTIAL_SPECIALIZATION
+
+template <class InputIterator, class T>
+iterator_traits<InputIterator>::difference_type
+count(InputIterator first, InputIterator last, const T& value) {
+ iterator_traits<InputIterator>::difference_type n = 0;
+ for ( ; first != last; ++first)
+ if (*first == value)
+ ++n;
+ return n;
+}
+
+template <class InputIterator, class Predicate>
+iterator_traits<InputIterator>::difference_type
+count_if(InputIterator first, InputIterator last, Predicate pred) {
+ iterator_traits<InputIterator>::difference_type n = 0;
+ for ( ; first != last; ++first)
+ if (pred(*first))
+ ++n;
+ return n;
+}
+
+
+#endif /* __STL_CLASS_PARTIAL_SPECIALIZATION */
+
+template <class ForwardIterator1, class ForwardIterator2, class Distance1,
+ class Distance2>
+ForwardIterator1 __search(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2, ForwardIterator2 last2,
+ Distance1*, Distance2*) {
+ Distance1 d1 = 0;
+ distance(first1, last1, d1);
+ Distance2 d2 = 0;
+ distance(first2, last2, d2);
+
+ if (d1 < d2) return last1;
+
+ ForwardIterator1 current1 = first1;
+ ForwardIterator2 current2 = first2;
+
+ while (current2 != last2)
+ if (*current1 == *current2) {
+ ++current1;
+ ++current2;
+ }
+ else {
+ if (d1 == d2)
+ return last1;
+ else {
+ current1 = ++first1;
+ current2 = first2;
+ --d1;
+ }
+ }
+ return first1;
+}
+
+template <class ForwardIterator1, class ForwardIterator2>
+inline ForwardIterator1 search(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2, ForwardIterator2 last2)
+{
+ return __search(first1, last1, first2, last2, distance_type(first1),
+ distance_type(first2));
+}
+
+template <class ForwardIterator1, class ForwardIterator2,
+ class BinaryPredicate, class Distance1, class Distance2>
+ForwardIterator1 __search(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2, ForwardIterator2 last2,
+ BinaryPredicate binary_pred, Distance1*, Distance2*) {
+ Distance1 d1 = 0;
+ distance(first1, last1, d1);
+ Distance2 d2 = 0;
+ distance(first2, last2, d2);
+
+ if (d1 < d2) return last1;
+
+ ForwardIterator1 current1 = first1;
+ ForwardIterator2 current2 = first2;
+
+ while (current2 != last2)
+ if (binary_pred(*current1, *current2)) {
+ ++current1;
+ ++current2;
+ }
+ else {
+ if (d1 == d2)
+ return last1;
+ else {
+ current1 = ++first1;
+ current2 = first2;
+ --d1;
+ }
+ }
+ return first1;
+}
+
+template <class ForwardIterator1, class ForwardIterator2,
+ class BinaryPredicate>
+inline ForwardIterator1 search(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2, ForwardIterator2 last2,
+ BinaryPredicate binary_pred) {
+ return __search(first1, last1, first2, last2, binary_pred,
+ distance_type(first1), distance_type(first2));
+}
+
+template <class ForwardIterator1, class ForwardIterator2>
+ForwardIterator2 swap_ranges(ForwardIterator1 first1, ForwardIterator1 last1,
+ ForwardIterator2 first2) {
+ for ( ; first1 != last1; ++first1, ++first2)
+ iter_swap(first1, first2);
+ return first2;
+}
+
+template <class InputIterator, class OutputIterator, class UnaryOperation>
+OutputIterator transform(InputIterator first, InputIterator last,
+ OutputIterator result, UnaryOperation op) {
+ for ( ; first != last; ++first, ++result)
+ *result = op(*first);
+ return result;
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator,
+ class BinaryOperation>
+OutputIterator transform(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, OutputIterator result,
+ BinaryOperation binary_op) {
+ for ( ; first1 != last1; ++first1, ++first2, ++result)
+ *result = binary_op(*first1, *first2);
+ return result;
+}
+
+template <class ForwardIterator, class T>
+void replace(ForwardIterator first, ForwardIterator last, const T& old_value,
+ const T& new_value) {
+ for ( ; first != last; ++first)
+ if (*first == old_value) *first = new_value;
+}
+
+template <class ForwardIterator, class Predicate, class T>
+void replace_if(ForwardIterator first, ForwardIterator last, Predicate pred,
+ const T& new_value) {
+ for ( ; first != last; ++first)
+ if (pred(*first)) *first = new_value;
+}
+
+template <class InputIterator, class OutputIterator, class T>
+OutputIterator replace_copy(InputIterator first, InputIterator last,
+ OutputIterator result, const T& old_value,
+ const T& new_value) {
+ for ( ; first != last; ++first, ++result)
+ *result = *first == old_value ? new_value : *first;
+ return result;
+}
+
+template <class Iterator, class OutputIterator, class Predicate, class T>
+OutputIterator replace_copy_if(Iterator first, Iterator last,
+ OutputIterator result, Predicate pred,
+ const T& new_value) {
+ for ( ; first != last; ++first, ++result)
+ *result = pred(*first) ? new_value : *first;
+ return result;
+}
+
+template <class ForwardIterator, class Generator>
+void generate(ForwardIterator first, ForwardIterator last, Generator gen) {
+ for ( ; first != last; ++first)
+ *first = gen();
+}
+
+template <class OutputIterator, class Size, class Generator>
+OutputIterator generate_n(OutputIterator first, Size n, Generator gen) {
+ for ( ; n > 0; --n, ++first)
+ *first = gen();
+ return first;
+}
+
+template <class InputIterator, class OutputIterator, class T>
+OutputIterator remove_copy(InputIterator first, InputIterator last,
+ OutputIterator result, const T& value) {
+ for ( ; first != last; ++first)
+ if (*first != value) {
+ *result = *first;
+ ++result;
+ }
+ return result;
+}
+
+template <class InputIterator, class OutputIterator, class Predicate>
+OutputIterator remove_copy_if(InputIterator first, InputIterator last,
+ OutputIterator result, Predicate pred) {
+ for ( ; first != last; ++first)
+ if (!pred(*first)) {
+ *result = *first;
+ ++result;
+ }
+ return result;
+}
+
+template <class ForwardIterator, class T>
+ForwardIterator remove(ForwardIterator first, ForwardIterator last,
+ const T& value) {
+ first = find(first, last, value);
+ ForwardIterator next = first;
+ return first == last ? first : remove_copy(++next, last, first, value);
+}
+
+template <class ForwardIterator, class Predicate>
+ForwardIterator remove_if(ForwardIterator first, ForwardIterator last,
+ Predicate pred) {
+ first = find_if(first, last, pred);
+ ForwardIterator next = first;
+ return first == last ? first : remove_copy_if(++next, last, first, pred);
+}
+
+template <class InputIterator, class ForwardIterator>
+ForwardIterator __unique_copy(InputIterator first, InputIterator last,
+ ForwardIterator result, forward_iterator_tag) {
+ *result = *first;
+ while (++first != last)
+ if (*result != *first) *++result = *first;
+ return ++result;
+}
+
+template <class InputIterator, class BidirectionalIterator>
+inline BidirectionalIterator __unique_copy(InputIterator first,
+ InputIterator last,
+ BidirectionalIterator result,
+ bidirectional_iterator_tag) {
+ return __unique_copy(first, last, result, forward_iterator_tag());
+}
+
+template <class InputIterator, class RandomAccessIterator>
+inline RandomAccessIterator __unique_copy(InputIterator first,
+ InputIterator last,
+ RandomAccessIterator result,
+ random_access_iterator_tag) {
+ return __unique_copy(first, last, result, forward_iterator_tag());
+}
+
+template <class InputIterator, class OutputIterator, class T>
+OutputIterator __unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result, T*) {
+ T value = *first;
+ *result = value;
+ while (++first != last)
+ if (value != *first) {
+ value = *first;
+ *++result = value;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator __unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result,
+ output_iterator_tag) {
+ return __unique_copy(first, last, result, value_type(first));
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result) {
+ if (first == last) return result;
+ return __unique_copy(first, last, result, iterator_category(result));
+}
+template <class InputIterator, class ForwardIterator, class BinaryPredicate>
+ForwardIterator __unique_copy(InputIterator first, InputIterator last,
+ ForwardIterator result,
+ BinaryPredicate binary_pred,
+ forward_iterator_tag) {
+ *result = *first;
+ while (++first != last)
+ if (!binary_pred(*result, *first)) *++result = *first;
+ return ++result;
+}
+
+template <class InputIterator, class BidirectionalIterator,
+ class BinaryPredicate>
+inline BidirectionalIterator __unique_copy(InputIterator first,
+ InputIterator last,
+ BidirectionalIterator result,
+ BinaryPredicate binary_pred,
+ bidirectional_iterator_tag) {
+ return __unique_copy(first, last, result, binary_pred,
+ forward_iterator_tag());
+}
+
+template <class InputIterator, class RandomAccessIterator,
+ class BinaryPredicate>
+inline RandomAccessIterator __unique_copy(InputIterator first,
+ InputIterator last,
+ RandomAccessIterator result,
+ BinaryPredicate binary_pred,
+ random_access_iterator_tag) {
+ return __unique_copy(first, last, result, binary_pred,
+ forward_iterator_tag());
+}
+
+template <class InputIterator, class OutputIterator, class BinaryPredicate,
+ class T>
+OutputIterator __unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result,
+ BinaryPredicate binary_pred, T*) {
+ T value = *first;
+ *result = value;
+ while (++first != last)
+ if (!binary_pred(value, *first)) {
+ value = *first;
+ *++result = value;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator, class BinaryPredicate>
+inline OutputIterator __unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result,
+ BinaryPredicate binary_pred,
+ output_iterator_tag) {
+ return __unique_copy(first, last, result, binary_pred, value_type(first));
+}
+
+template <class InputIterator, class OutputIterator, class BinaryPredicate>
+inline OutputIterator unique_copy(InputIterator first, InputIterator last,
+ OutputIterator result,
+ BinaryPredicate binary_pred) {
+ if (first == last) return result;
+ return __unique_copy(first, last, result, binary_pred,
+ iterator_category(result));
+}
+
+template <class ForwardIterator>
+ForwardIterator unique(ForwardIterator first, ForwardIterator last) {
+ first = adjacent_find(first, last);
+ return unique_copy(first, last, first);
+}
+
+template <class ForwardIterator, class BinaryPredicate>
+ForwardIterator unique(ForwardIterator first, ForwardIterator last,
+ BinaryPredicate binary_pred) {
+ first = adjacent_find(first, last, binary_pred);
+ return unique_copy(first, last, first, binary_pred);
+}
+
+template <class BidirectionalIterator>
+void __reverse(BidirectionalIterator first, BidirectionalIterator last,
+ bidirectional_iterator_tag) {
+ while (true)
+ if (first == last || first == --last)
+ return;
+ else
+ iter_swap(first++, last);
+}
+
+template <class RandomAccessIterator>
+void __reverse(RandomAccessIterator first, RandomAccessIterator last,
+ random_access_iterator_tag) {
+ while (first < last) iter_swap(first++, --last);
+}
+
+template <class BidirectionalIterator>
+inline void reverse(BidirectionalIterator first, BidirectionalIterator last) {
+ __reverse(first, last, iterator_category(first));
+}
+
+template <class BidirectionalIterator, class OutputIterator>
+OutputIterator reverse_copy(BidirectionalIterator first,
+ BidirectionalIterator last,
+ OutputIterator result) {
+ while (first != last) {
+ --last;
+ *result = *last;
+ ++result;
+ }
+ return result;
+}
+
+template <class ForwardIterator, class Distance>
+void __rotate(ForwardIterator first, ForwardIterator middle,
+ ForwardIterator last, Distance*, forward_iterator_tag) {
+ for (ForwardIterator i = middle; ;) {
+ iter_swap(first, i);
+ ++first;
+ ++i;
+ if (first == middle) {
+ if (i == last) return;
+ middle = i;
+ }
+ else if (i == last)
+ i = middle;
+ }
+}
+
+template <class BidirectionalIterator, class Distance>
+void __rotate(BidirectionalIterator first, BidirectionalIterator middle,
+ BidirectionalIterator last, Distance*,
+ bidirectional_iterator_tag) {
+ reverse(first, middle);
+ reverse(middle, last);
+ reverse(first, last);
+}
+
+template <class EuclideanRingElement>
+EuclideanRingElement __gcd(EuclideanRingElement m, EuclideanRingElement n)
+{
+ while (n != 0) {
+ EuclideanRingElement t = m % n;
+ m = n;
+ n = t;
+ }
+ return m;
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+void __rotate_cycle(RandomAccessIterator first, RandomAccessIterator last,
+ RandomAccessIterator initial, Distance shift, T*) {
+ T value = *initial;
+ RandomAccessIterator ptr1 = initial;
+ RandomAccessIterator ptr2 = ptr1 + shift;
+ while (ptr2 != initial) {
+ *ptr1 = *ptr2;
+ ptr1 = ptr2;
+ if (last - ptr2 > shift)
+ ptr2 += shift;
+ else
+ ptr2 = first + (shift - (last - ptr2));
+ }
+ *ptr1 = value;
+}
+
+template <class RandomAccessIterator, class Distance>
+void __rotate(RandomAccessIterator first, RandomAccessIterator middle,
+ RandomAccessIterator last, Distance*,
+ random_access_iterator_tag) {
+ Distance n = __gcd(last - first, middle - first);
+ while (n--)
+ __rotate_cycle(first, last, first + n, middle - first,
+ value_type(first));
+}
+
+template <class ForwardIterator>
+inline void rotate(ForwardIterator first, ForwardIterator middle,
+ ForwardIterator last) {
+ if (first == middle || middle == last) return;
+ __rotate(first, middle, last, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class OutputIterator>
+OutputIterator rotate_copy(ForwardIterator first, ForwardIterator middle,
+ ForwardIterator last, OutputIterator result) {
+ return copy(first, middle, copy(middle, last, result));
+}
+
+template <class RandomAccessIterator, class Distance>
+void __random_shuffle(RandomAccessIterator first, RandomAccessIterator last,
+ Distance*) {
+ if (first == last) return;
+ for (RandomAccessIterator i = first + 1; i != last; ++i)
+#ifdef __STL_NO_DRAND48
+ iter_swap(i, first + Distance(rand() % ((i - first) + 1)));
+#else
+ iter_swap(i, first + Distance(lrand48() % ((i - first) + 1)));
+#endif
+}
+
+template <class RandomAccessIterator>
+inline void random_shuffle(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ __random_shuffle(first, last, distance_type(first));
+}
+
+template <class RandomAccessIterator, class RandomNumberGenerator>
+void random_shuffle(RandomAccessIterator first, RandomAccessIterator last,
+ RandomNumberGenerator& rand) {
+ if (first == last) return;
+ for (RandomAccessIterator i = first + 1; i != last; ++i)
+ iter_swap(i, first + rand((i - first) + 1));
+}
+
+template <class ForwardIterator, class OutputIterator, class Distance>
+OutputIterator random_sample_n(ForwardIterator first, ForwardIterator last,
+ OutputIterator out, const Distance n)
+{
+ Distance remaining = 0;
+ distance(first, last, remaining);
+ Distance m = min(n, remaining);
+
+ while (m > 0) {
+#ifdef __STL_NO_DRAND48
+ if (rand() % remaining < m) {
+#else
+ if (lrand48() % remaining < m) {
+#endif
+ *out = *first;
+ ++out;
+ --m;
+ }
+
+ --remaining;
+ ++first;
+ }
+ return out;
+}
+
+template <class ForwardIterator, class OutputIterator, class Distance,
+ class RandomNumberGenerator>
+OutputIterator random_sample_n(ForwardIterator first, ForwardIterator last,
+ OutputIterator out, const Distance n,
+ RandomNumberGenerator& rand)
+{
+ Distance remaining = 0;
+ distance(first, last, remaining);
+ Distance m = min(n, remaining);
+
+ while (m > 0) {
+ if (rand(remaining) < m) {
+ *out = *first;
+ ++out;
+ --m;
+ }
+
+ --remaining;
+ ++first;
+ }
+ return out;
+}
+
+template <class InputIterator, class RandomAccessIterator, class Distance>
+RandomAccessIterator __random_sample(InputIterator first, InputIterator last,
+ RandomAccessIterator out,
+ const Distance n)
+{
+ Distance m = 0;
+ Distance t = n;
+ for ( ; first != last && m < n; ++m, ++first)
+ out[m] = *first;
+
+ while (first != last) {
+ ++t;
+#ifdef __STL_NO_DRAND48
+ Distance M = rand() % t;
+#else
+ Distance M = lrand48() % t;
+#endif
+ if (M < n)
+ out[M] = *first;
+ ++first;
+ }
+
+ return out + m;
+}
+
+template <class InputIterator, class RandomAccessIterator,
+ class RandomNumberGenerator, class Distance>
+RandomAccessIterator __random_sample(InputIterator first, InputIterator last,
+ RandomAccessIterator out,
+ RandomNumberGenerator& rand,
+ const Distance n)
+{
+ Distance m = 0;
+ Distance t = n;
+ for ( ; first != last && m < n; ++m, ++first)
+ out[m] = *first;
+
+ while (first != last) {
+ ++t;
+ Distance M = rand(t);
+ if (M < n)
+ out[M] = *first;
+ ++first;
+ }
+
+ return out + m;
+}
+
+template <class InputIterator, class RandomAccessIterator>
+inline RandomAccessIterator
+random_sample(InputIterator first, InputIterator last,
+ RandomAccessIterator out_first, RandomAccessIterator out_last)
+{
+ return __random_sample(first, last, out_first, out_last - out_first);
+}
+
+template <class InputIterator, class RandomAccessIterator,
+ class RandomNumberGenerator>
+inline RandomAccessIterator
+random_sample(InputIterator first, InputIterator last,
+ RandomAccessIterator out_first, RandomAccessIterator out_last,
+ RandomNumberGenerator& rand)
+{
+ return __random_sample(first, last, out_first, rand, out_last - out_first);
+}
+
+
+
+template <class BidirectionalIterator, class Predicate>
+BidirectionalIterator partition(BidirectionalIterator first,
+ BidirectionalIterator last, Predicate pred) {
+ while (true) {
+ while (true)
+ if (first == last)
+ return first;
+ else if (pred(*first))
+ ++first;
+ else
+ break;
+ --last;
+ while (true)
+ if (first == last)
+ return first;
+ else if (!pred(*last))
+ --last;
+ else
+ break;
+ iter_swap(first, last);
+ ++first;
+ }
+}
+
+template <class ForwardIterator, class Predicate, class Distance>
+ForwardIterator __inplace_stable_partition(ForwardIterator first,
+ ForwardIterator last,
+ Predicate pred, Distance len) {
+ if (len == 1) return pred(*first) ? last : first;
+ ForwardIterator middle = first;
+ advance(middle, len / 2);
+ ForwardIterator
+ first_cut = __inplace_stable_partition(first, middle, pred, len / 2);
+ ForwardIterator
+ second_cut = __inplace_stable_partition(middle, last, pred,
+ len - len / 2);
+ rotate(first_cut, middle, second_cut);
+ len = 0;
+ distance(middle, second_cut, len);
+ advance(first_cut, len);
+ return first_cut;
+}
+
+template <class ForwardIterator, class Pointer, class Predicate,
+ class Distance>
+ForwardIterator __stable_partition_adaptive(ForwardIterator first,
+ ForwardIterator last,
+ Predicate pred, Distance len,
+ Pointer buffer,
+ Distance buffer_size) {
+ if (len <= buffer_size) {
+ ForwardIterator result1 = first;
+ Pointer result2 = buffer;
+ for ( ; first != last ; ++first)
+ if (pred(*first)) {
+ *result1 = *first;
+ ++result1;
+ }
+ else {
+ *result2 = *first;
+ ++result2;
+ }
+ copy(buffer, result2, result1);
+ return result1;
+ }
+ else {
+ ForwardIterator middle = first;
+ advance(middle, len / 2);
+ ForwardIterator first_cut =
+ __stable_partition_adaptive(first, middle, pred, len / 2,
+ buffer, buffer_size);
+ ForwardIterator second_cut =
+ __stable_partition_adaptive(middle, last, pred, len - len / 2,
+ buffer, buffer_size);
+
+ rotate(first_cut, middle, second_cut);
+ len = 0;
+ distance(middle, second_cut, len);
+ advance(first_cut, len);
+ return first_cut;
+ }
+}
+
+template <class ForwardIterator, class Predicate, class T, class Distance>
+inline ForwardIterator __stable_partition_aux(ForwardIterator first,
+ ForwardIterator last,
+ Predicate pred, T*, Distance*) {
+ temporary_buffer<ForwardIterator, T> buf(first, last);
+ if (buf.size() > 0)
+ return __stable_partition_adaptive(first, last, pred,
+ Distance(buf.requested_size()),
+ buf.begin(), buf.size());
+ else
+ return __inplace_stable_partition(first, last, pred,
+ Distance(buf.requested_size()));
+}
+
+template <class ForwardIterator, class Predicate>
+inline ForwardIterator stable_partition(ForwardIterator first,
+ ForwardIterator last,
+ Predicate pred) {
+ if (first == last)
+ return first;
+ else
+ return __stable_partition_aux(first, last, pred,
+ value_type(first), distance_type(first));
+}
+
+template <class RandomAccessIterator, class T>
+RandomAccessIterator __unguarded_partition(RandomAccessIterator first,
+ RandomAccessIterator last,
+ T pivot) {
+ while (1) {
+ while (*first < pivot) ++first;
+ --last;
+ while (pivot < *last) --last;
+ if (!(first < last)) return first;
+ iter_swap(first, last);
+ ++first;
+ }
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+RandomAccessIterator __unguarded_partition(RandomAccessIterator first,
+ RandomAccessIterator last,
+ T pivot, Compare comp) {
+ while (1) {
+ while (comp(*first, pivot)) ++first;
+ --last;
+ while (comp(pivot, *last)) --last;
+ if (!(first < last)) return first;
+ iter_swap(first, last);
+ ++first;
+ }
+}
+
+const int __stl_threshold = 16;
+
+
+template <class RandomAccessIterator, class T>
+void __unguarded_linear_insert(RandomAccessIterator last, T value) {
+ RandomAccessIterator next = last;
+ --next;
+ while (value < *next) {
+ *last = *next;
+ last = next;
+ --next;
+ }
+ *last = value;
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+void __unguarded_linear_insert(RandomAccessIterator last, T value,
+ Compare comp) {
+ RandomAccessIterator next = last;
+ --next;
+ while (comp(value , *next)) {
+ *last = *next;
+ last = next;
+ --next;
+ }
+ *last = value;
+}
+
+template <class RandomAccessIterator, class T>
+inline void __linear_insert(RandomAccessIterator first,
+ RandomAccessIterator last, T*) {
+ T value = *last;
+ if (value < *first) {
+ copy_backward(first, last, last + 1);
+ *first = value;
+ } else
+ __unguarded_linear_insert(last, value);
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline void __linear_insert(RandomAccessIterator first,
+ RandomAccessIterator last, T*, Compare comp) {
+ T value = *last;
+ if (comp(value, *first)) {
+ copy_backward(first, last, last + 1);
+ *first = value;
+ } else
+ __unguarded_linear_insert(last, value, comp);
+}
+
+template <class RandomAccessIterator>
+void __insertion_sort(RandomAccessIterator first, RandomAccessIterator last) {
+ if (first == last) return;
+ for (RandomAccessIterator i = first + 1; i != last; ++i)
+ __linear_insert(first, i, value_type(first));
+}
+
+template <class RandomAccessIterator, class Compare>
+void __insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp) {
+ if (first == last) return;
+ for (RandomAccessIterator i = first + 1; i != last; ++i)
+ __linear_insert(first, i, value_type(first), comp);
+}
+
+template <class RandomAccessIterator, class T>
+void __unguarded_insertion_sort_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*) {
+ for (RandomAccessIterator i = first; i != last; ++i)
+ __unguarded_linear_insert(i, T(*i));
+}
+
+template <class RandomAccessIterator>
+inline void __unguarded_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ __unguarded_insertion_sort_aux(first, last, value_type(first));
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+void __unguarded_insertion_sort_aux(RandomAccessIterator first,
+ RandomAccessIterator last,
+ T*, Compare comp) {
+ for (RandomAccessIterator i = first; i != last; ++i)
+ __unguarded_linear_insert(i, T(*i), comp);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void __unguarded_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last,
+ Compare comp) {
+ __unguarded_insertion_sort_aux(first, last, value_type(first), comp);
+}
+
+template <class RandomAccessIterator>
+void __final_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ if (last - first > __stl_threshold) {
+ __insertion_sort(first, first + __stl_threshold);
+ __unguarded_insertion_sort(first + __stl_threshold, last);
+ } else
+ __insertion_sort(first, last);
+}
+
+template <class RandomAccessIterator, class Compare>
+void __final_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp) {
+ if (last - first > __stl_threshold) {
+ __insertion_sort(first, first + __stl_threshold, comp);
+ __unguarded_insertion_sort(first + __stl_threshold, last, comp);
+ } else
+ __insertion_sort(first, last, comp);
+}
+
+template <class Size>
+Size __lg(Size n) {
+ Size k;
+ for (k = 0; n != 1; n = n / 2) ++k;
+ return k;
+}
+
+template <class RandomAccessIterator, class T, class Size>
+void __introsort_loop(RandomAccessIterator first,
+ RandomAccessIterator last, T*,
+ Size depth_limit) {
+ while (last - first > __stl_threshold) {
+ if (depth_limit == 0) {
+ partial_sort(first, last, last);
+ return;
+ }
+ --depth_limit;
+ RandomAccessIterator cut = __unguarded_partition
+ (first, last, T(__median(*first, *(first + (last - first)/2),
+ *(last - 1))));
+ __introsort_loop(cut, last, value_type(first), depth_limit);
+ last = cut;
+ }
+}
+
+template <class RandomAccessIterator, class T, class Size, class Compare>
+void __introsort_loop(RandomAccessIterator first,
+ RandomAccessIterator last, T*,
+ Size depth_limit, Compare comp) {
+ while (last - first > __stl_threshold) {
+ if (depth_limit == 0) {
+ partial_sort(first, last, last, comp);
+ return;
+ }
+ --depth_limit;
+ RandomAccessIterator cut = __unguarded_partition
+ (first, last, T(__median(*first, *(first + (last - first)/2),
+ *(last - 1), comp)), comp);
+ __introsort_loop(cut, last, value_type(first), depth_limit, comp);
+ last = cut;
+ }
+}
+
+template <class RandomAccessIterator>
+inline void sort(RandomAccessIterator first, RandomAccessIterator last) {
+ if (first != last) {
+ __introsort_loop(first, last, value_type(first), __lg(last - first) * 2);
+ __final_insertion_sort(first, last);
+ }
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void sort(RandomAccessIterator first, RandomAccessIterator last,
+ Compare comp) {
+ if (first != last) {
+ __introsort_loop(first, last, value_type(first), __lg(last - first) * 2,
+ comp);
+ __final_insertion_sort(first, last, comp);
+ }
+}
+
+
+template <class RandomAccessIterator>
+void __inplace_stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ if (last - first < 15) {
+ __insertion_sort(first, last);
+ return;
+ }
+ RandomAccessIterator middle = first + (last - first) / 2;
+ __inplace_stable_sort(first, middle);
+ __inplace_stable_sort(middle, last);
+ __merge_without_buffer(first, middle, last, middle - first, last - middle);
+}
+
+template <class RandomAccessIterator, class Compare>
+void __inplace_stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp) {
+ if (last - first < 15) {
+ __insertion_sort(first, last, comp);
+ return;
+ }
+ RandomAccessIterator middle = first + (last - first) / 2;
+ __inplace_stable_sort(first, middle, comp);
+ __inplace_stable_sort(middle, last, comp);
+ __merge_without_buffer(first, middle, last, middle - first,
+ last - middle, comp);
+}
+
+template <class RandomAccessIterator1, class RandomAccessIterator2,
+ class Distance>
+void __merge_sort_loop(RandomAccessIterator1 first,
+ RandomAccessIterator1 last,
+ RandomAccessIterator2 result, Distance step_size) {
+ Distance two_step = 2 * step_size;
+
+ while (last - first >= two_step) {
+ result = merge(first, first + step_size,
+ first + step_size, first + two_step, result);
+ first += two_step;
+ }
+
+ step_size = min(Distance(last - first), step_size);
+ merge(first, first + step_size, first + step_size, last, result);
+}
+
+template <class RandomAccessIterator1, class RandomAccessIterator2,
+ class Distance, class Compare>
+void __merge_sort_loop(RandomAccessIterator1 first,
+ RandomAccessIterator1 last,
+ RandomAccessIterator2 result, Distance step_size,
+ Compare comp) {
+ Distance two_step = 2 * step_size;
+
+ while (last - first >= two_step) {
+ result = merge(first, first + step_size,
+ first + step_size, first + two_step, result, comp);
+ first += two_step;
+ }
+ step_size = min(Distance(last - first), step_size);
+
+ merge(first, first + step_size, first + step_size, last, result, comp);
+}
+
+const int __stl_chunk_size = 7;
+
+template <class RandomAccessIterator, class Distance>
+void __chunk_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Distance chunk_size) {
+ while (last - first >= chunk_size) {
+ __insertion_sort(first, first + chunk_size);
+ first += chunk_size;
+ }
+ __insertion_sort(first, last);
+}
+
+template <class RandomAccessIterator, class Distance, class Compare>
+void __chunk_insertion_sort(RandomAccessIterator first,
+ RandomAccessIterator last,
+ Distance chunk_size, Compare comp) {
+ while (last - first >= chunk_size) {
+ __insertion_sort(first, first + chunk_size, comp);
+ first += chunk_size;
+ }
+ __insertion_sort(first, last, comp);
+}
+
+template <class RandomAccessIterator, class Pointer, class Distance>
+void __merge_sort_with_buffer(RandomAccessIterator first,
+ RandomAccessIterator last,
+ Pointer buffer, Distance*) {
+ Distance len = last - first;
+ Pointer buffer_last = buffer + len;
+
+ Distance step_size = __stl_chunk_size;
+ __chunk_insertion_sort(first, last, step_size);
+
+ while (step_size < len) {
+ __merge_sort_loop(first, last, buffer, step_size);
+ step_size *= 2;
+ __merge_sort_loop(buffer, buffer_last, first, step_size);
+ step_size *= 2;
+ }
+}
+
+template <class RandomAccessIterator, class Pointer, class Distance,
+ class Compare>
+void __merge_sort_with_buffer(RandomAccessIterator first,
+ RandomAccessIterator last, Pointer buffer,
+ Distance*, Compare comp) {
+ Distance len = last - first;
+ Pointer buffer_last = buffer + len;
+
+ Distance step_size = __stl_chunk_size;
+ __chunk_insertion_sort(first, last, step_size, comp);
+
+ while (step_size < len) {
+ __merge_sort_loop(first, last, buffer, step_size, comp);
+ step_size *= 2;
+ __merge_sort_loop(buffer, buffer_last, first, step_size, comp);
+ step_size *= 2;
+ }
+}
+
+template <class RandomAccessIterator, class Pointer, class Distance>
+void __stable_sort_adaptive(RandomAccessIterator first,
+ RandomAccessIterator last, Pointer buffer,
+ Distance buffer_size) {
+ Distance len = (last - first + 1) / 2;
+ RandomAccessIterator middle = first + len;
+ if (len > buffer_size) {
+ __stable_sort_adaptive(first, middle, buffer, buffer_size);
+ __stable_sort_adaptive(middle, last, buffer, buffer_size);
+ } else {
+ __merge_sort_with_buffer(first, middle, buffer, (Distance*)0);
+ __merge_sort_with_buffer(middle, last, buffer, (Distance*)0);
+ }
+ __merge_adaptive(first, middle, last, Distance(middle - first),
+ Distance(last - middle), buffer, buffer_size);
+}
+
+template <class RandomAccessIterator, class Pointer, class Distance,
+ class Compare>
+void __stable_sort_adaptive(RandomAccessIterator first,
+ RandomAccessIterator last, Pointer buffer,
+ Distance buffer_size, Compare comp) {
+ Distance len = (last - first + 1) / 2;
+ RandomAccessIterator middle = first + len;
+ if (len > buffer_size) {
+ __stable_sort_adaptive(first, middle, buffer, buffer_size,
+ comp);
+ __stable_sort_adaptive(middle, last, buffer, buffer_size,
+ comp);
+ } else {
+ __merge_sort_with_buffer(first, middle, buffer, (Distance*)0, comp);
+ __merge_sort_with_buffer(middle, last, buffer, (Distance*)0, comp);
+ }
+ __merge_adaptive(first, middle, last, Distance(middle - first),
+ Distance(last - middle), buffer, buffer_size,
+ comp);
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+inline void __stable_sort_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*, Distance*) {
+ temporary_buffer<RandomAccessIterator, T> buf(first, last);
+ if (buf.begin() == 0)
+ __inplace_stable_sort(first, last);
+ else
+ __stable_sort_adaptive(first, last, buf.begin(), Distance(buf.size()));
+}
+
+template <class RandomAccessIterator, class T, class Distance, class Compare>
+inline void __stable_sort_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*, Distance*,
+ Compare comp) {
+ temporary_buffer<RandomAccessIterator, T> buf(first, last);
+ if (buf.begin() == 0)
+ __inplace_stable_sort(first, last, comp);
+ else
+ __stable_sort_adaptive(first, last, buf.begin(), Distance(buf.size()),
+ comp);
+}
+
+template <class RandomAccessIterator>
+inline void stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last) {
+ __stable_sort_aux(first, last, value_type(first), distance_type(first));
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void stable_sort(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp) {
+ __stable_sort_aux(first, last, value_type(first), distance_type(first),
+ comp);
+}
+
+template <class RandomAccessIterator, class T>
+void __partial_sort(RandomAccessIterator first, RandomAccessIterator middle,
+ RandomAccessIterator last, T*) {
+ make_heap(first, middle);
+ for (RandomAccessIterator i = middle; i < last; ++i)
+ if (*i < *first)
+ __pop_heap(first, middle, i, T(*i), distance_type(first));
+ sort_heap(first, middle);
+}
+
+template <class RandomAccessIterator>
+inline void partial_sort(RandomAccessIterator first,
+ RandomAccessIterator middle,
+ RandomAccessIterator last) {
+ __partial_sort(first, middle, last, value_type(first));
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+void __partial_sort(RandomAccessIterator first, RandomAccessIterator middle,
+ RandomAccessIterator last, T*, Compare comp) {
+ make_heap(first, middle, comp);
+ for (RandomAccessIterator i = middle; i < last; ++i)
+ if (comp(*i, *first))
+ __pop_heap(first, middle, i, T(*i), comp, distance_type(first));
+ sort_heap(first, middle, comp);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void partial_sort(RandomAccessIterator first,
+ RandomAccessIterator middle,
+ RandomAccessIterator last, Compare comp) {
+ __partial_sort(first, middle, last, value_type(first), comp);
+}
+
+template <class InputIterator, class RandomAccessIterator, class Distance,
+ class T>
+RandomAccessIterator __partial_sort_copy(InputIterator first,
+ InputIterator last,
+ RandomAccessIterator result_first,
+ RandomAccessIterator result_last,
+ Distance*, T*) {
+ if (result_first == result_last) return result_last;
+ RandomAccessIterator result_real_last = result_first;
+ while(first != last && result_real_last != result_last) {
+ *result_real_last = *first;
+ ++result_real_last;
+ ++first;
+ }
+ make_heap(result_first, result_real_last);
+ while (first != last) {
+ if (*first < *result_first)
+ __adjust_heap(result_first, Distance(0),
+ Distance(result_real_last - result_first), T(*first));
+ ++first;
+ }
+ sort_heap(result_first, result_real_last);
+ return result_real_last;
+}
+
+template <class InputIterator, class RandomAccessIterator>
+inline RandomAccessIterator
+partial_sort_copy(InputIterator first, InputIterator last,
+ RandomAccessIterator result_first,
+ RandomAccessIterator result_last) {
+ return __partial_sort_copy(first, last, result_first, result_last,
+ distance_type(result_first), value_type(first));
+}
+
+template <class InputIterator, class RandomAccessIterator, class Compare,
+ class Distance, class T>
+RandomAccessIterator __partial_sort_copy(InputIterator first,
+ InputIterator last,
+ RandomAccessIterator result_first,
+ RandomAccessIterator result_last,
+ Compare comp, Distance*, T*) {
+ if (result_first == result_last) return result_last;
+ RandomAccessIterator result_real_last = result_first;
+ while(first != last && result_real_last != result_last) {
+ *result_real_last = *first;
+ ++result_real_last;
+ ++first;
+ }
+ make_heap(result_first, result_real_last, comp);
+ while (first != last) {
+ if (comp(*first, *result_first))
+ __adjust_heap(result_first, Distance(0),
+ Distance(result_real_last - result_first), T(*first),
+ comp);
+ ++first;
+ }
+ sort_heap(result_first, result_real_last, comp);
+ return result_real_last;
+}
+
+template <class InputIterator, class RandomAccessIterator, class Compare>
+inline RandomAccessIterator
+partial_sort_copy(InputIterator first, InputIterator last,
+ RandomAccessIterator result_first,
+ RandomAccessIterator result_last, Compare comp) {
+ return __partial_sort_copy(first, last, result_first, result_last, comp,
+ distance_type(result_first), value_type(first));
+}
+
+template <class RandomAccessIterator, class T>
+void __nth_element(RandomAccessIterator first, RandomAccessIterator nth,
+ RandomAccessIterator last, T*) {
+ while (last - first > 3) {
+ RandomAccessIterator cut = __unguarded_partition
+ (first, last, T(__median(*first, *(first + (last - first)/2),
+ *(last - 1))));
+ if (cut <= nth)
+ first = cut;
+ else
+ last = cut;
+ }
+ __insertion_sort(first, last);
+}
+
+template <class RandomAccessIterator>
+inline void nth_element(RandomAccessIterator first, RandomAccessIterator nth,
+ RandomAccessIterator last) {
+ __nth_element(first, nth, last, value_type(first));
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+void __nth_element(RandomAccessIterator first, RandomAccessIterator nth,
+ RandomAccessIterator last, T*, Compare comp) {
+ while (last - first > 3) {
+ RandomAccessIterator cut = __unguarded_partition
+ (first, last, T(__median(*first, *(first + (last - first)/2),
+ *(last - 1), comp)), comp);
+ if (cut <= nth)
+ first = cut;
+ else
+ last = cut;
+ }
+ __insertion_sort(first, last, comp);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void nth_element(RandomAccessIterator first, RandomAccessIterator nth,
+ RandomAccessIterator last, Compare comp) {
+ __nth_element(first, nth, last, value_type(first), comp);
+}
+
+template <class ForwardIterator, class T, class Distance>
+ForwardIterator __lower_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Distance*,
+ forward_iterator_tag) {
+ Distance len = 0;
+ distance(first, last, len);
+ Distance half;
+ ForwardIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ advance(middle, half);
+ if (*middle < value) {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ } else
+ len = half;
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline ForwardIterator __lower_bound(ForwardIterator first,
+ ForwardIterator last,
+ const T& value, Distance*,
+ bidirectional_iterator_tag) {
+ return __lower_bound(first, last, value, (Distance*)0,
+ forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+RandomAccessIterator __lower_bound(RandomAccessIterator first,
+ RandomAccessIterator last, const T& value,
+ Distance*, random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (*middle < value) {
+ first = middle + 1;
+ len = len - half - 1;
+ } else
+ len = half;
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T>
+inline ForwardIterator lower_bound(ForwardIterator first, ForwardIterator last,
+ const T& value) {
+ return __lower_bound(first, last, value, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+ForwardIterator __lower_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Compare comp, Distance*,
+ forward_iterator_tag) {
+ Distance len = 0;
+ distance(first, last, len);
+ Distance half;
+ ForwardIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ advance(middle, half);
+ if (comp(*middle, value)) {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ } else
+ len = half;
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline ForwardIterator __lower_bound(ForwardIterator first,
+ ForwardIterator last,
+ const T& value, Compare comp, Distance*,
+ bidirectional_iterator_tag) {
+ return __lower_bound(first, last, value, comp, (Distance*)0,
+ forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Compare, class Distance>
+RandomAccessIterator __lower_bound(RandomAccessIterator first,
+ RandomAccessIterator last,
+ const T& value, Compare comp, Distance*,
+ random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (comp(*middle, value)) {
+ first = middle + 1;
+ len = len - half - 1;
+ } else
+ len = half;
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Compare>
+inline ForwardIterator lower_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Compare comp) {
+ return __lower_bound(first, last, value, comp, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Distance>
+ForwardIterator __upper_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Distance*,
+ forward_iterator_tag) {
+ Distance len = 0;
+ distance(first, last, len);
+ Distance half;
+ ForwardIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ advance(middle, half);
+ if (value < *middle)
+ len = half;
+ else {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ }
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline ForwardIterator __upper_bound(ForwardIterator first,
+ ForwardIterator last,
+ const T& value, Distance*,
+ bidirectional_iterator_tag) {
+ return __upper_bound(first, last, value, (Distance*)0,
+ forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+RandomAccessIterator __upper_bound(RandomAccessIterator first,
+ RandomAccessIterator last, const T& value,
+ Distance*, random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (value < *middle)
+ len = half;
+ else {
+ first = middle + 1;
+ len = len - half - 1;
+ }
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T>
+inline ForwardIterator upper_bound(ForwardIterator first, ForwardIterator last,
+ const T& value) {
+ return __upper_bound(first, last, value, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+ForwardIterator __upper_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Compare comp, Distance*,
+ forward_iterator_tag) {
+ Distance len = 0;
+ distance(first, last, len);
+ Distance half;
+ ForwardIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ advance(middle, half);
+ if (comp(value, *middle))
+ len = half;
+ else {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ }
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline ForwardIterator __upper_bound(ForwardIterator first,
+ ForwardIterator last,
+ const T& value, Compare comp, Distance*,
+ bidirectional_iterator_tag) {
+ return __upper_bound(first, last, value, comp, (Distance*)0,
+ forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Compare, class Distance>
+RandomAccessIterator __upper_bound(RandomAccessIterator first,
+ RandomAccessIterator last,
+ const T& value, Compare comp, Distance*,
+ random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (comp(value, *middle))
+ len = half;
+ else {
+ first = middle + 1;
+ len = len - half - 1;
+ }
+ }
+ return first;
+}
+
+template <class ForwardIterator, class T, class Compare>
+inline ForwardIterator upper_bound(ForwardIterator first, ForwardIterator last,
+ const T& value, Compare comp) {
+ return __upper_bound(first, last, value, comp, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Distance>
+pair<ForwardIterator, ForwardIterator>
+__equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Distance*, forward_iterator_tag) {
+ Distance len = 0;
+ distance(first, last, len);
+ Distance half;
+ ForwardIterator middle, left, right;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ advance(middle, half);
+ if (*middle < value) {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ } else if (value < *middle)
+ len = half;
+ else {
+ left = lower_bound(first, middle, value);
+ advance(first, len);
+ right = upper_bound(++middle, first, value);
+ return pair<ForwardIterator, ForwardIterator>(left, right);
+ }
+ }
+ return pair<ForwardIterator, ForwardIterator>(first, first);
+}
+
+template <class ForwardIterator, class T, class Distance>
+inline pair<ForwardIterator, ForwardIterator>
+__equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Distance*, bidirectional_iterator_tag) {
+ return __equal_range(first, last, value, (Distance*)0,
+ forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+pair<RandomAccessIterator, RandomAccessIterator>
+__equal_range(RandomAccessIterator first, RandomAccessIterator last,
+ const T& value, Distance*, random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle, left, right;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (*middle < value) {
+ first = middle + 1;
+ len = len - half - 1;
+ } else if (value < *middle)
+ len = half;
+ else {
+ left = lower_bound(first, middle, value);
+ right = upper_bound(++middle, first + len, value);
+ return pair<RandomAccessIterator, RandomAccessIterator>(left,
+ right);
+ }
+ }
+ return pair<RandomAccessIterator, RandomAccessIterator>(first, first);
+}
+
+template <class ForwardIterator, class T>
+inline pair<ForwardIterator, ForwardIterator>
+equal_range(ForwardIterator first, ForwardIterator last, const T& value) {
+ return __equal_range(first, last, value, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+pair<ForwardIterator, ForwardIterator>
+__equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Compare comp, Distance*, forward_iterator_tag) {
+ Distance len = 0;
+ distance(first, last, len);
+ Distance half;
+ ForwardIterator middle, left, right;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first;
+ advance(middle, half);
+ if (comp(*middle, value)) {
+ first = middle;
+ ++first;
+ len = len - half - 1;
+ } else if (comp(value, *middle))
+ len = half;
+ else {
+ left = lower_bound(first, middle, value, comp);
+ advance(first, len);
+ right = upper_bound(++middle, first, value, comp);
+ return pair<ForwardIterator, ForwardIterator>(left, right);
+ }
+ }
+ return pair<ForwardIterator, ForwardIterator>(first, first);
+}
+
+template <class ForwardIterator, class T, class Compare, class Distance>
+inline pair<ForwardIterator, ForwardIterator>
+__equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Compare comp, Distance*, bidirectional_iterator_tag) {
+ return __equal_range(first, last, value, comp, (Distance*)0,
+ forward_iterator_tag());
+}
+
+template <class RandomAccessIterator, class T, class Compare, class Distance>
+pair<RandomAccessIterator, RandomAccessIterator>
+__equal_range(RandomAccessIterator first, RandomAccessIterator last,
+ const T& value, Compare comp, Distance*,
+ random_access_iterator_tag) {
+ Distance len = last - first;
+ Distance half;
+ RandomAccessIterator middle, left, right;
+
+ while (len > 0) {
+ half = len / 2;
+ middle = first + half;
+ if (comp(*middle, value)) {
+ first = middle + 1;
+ len = len - half - 1;
+ } else if (comp(value, *middle))
+ len = half;
+ else {
+ left = lower_bound(first, middle, value, comp);
+ right = upper_bound(++middle, first + len, value, comp);
+ return pair<RandomAccessIterator, RandomAccessIterator>(left,
+ right);
+ }
+ }
+ return pair<RandomAccessIterator, RandomAccessIterator>(first, first);
+}
+
+template <class ForwardIterator, class T, class Compare>
+inline pair<ForwardIterator, ForwardIterator>
+equal_range(ForwardIterator first, ForwardIterator last, const T& value,
+ Compare comp) {
+ return __equal_range(first, last, value, comp, distance_type(first),
+ iterator_category(first));
+}
+
+template <class ForwardIterator, class T>
+bool binary_search(ForwardIterator first, ForwardIterator last,
+ const T& value) {
+ ForwardIterator i = lower_bound(first, last, value);
+ return i != last && !(value < *i);
+}
+
+template <class ForwardIterator, class T, class Compare>
+bool binary_search(ForwardIterator first, ForwardIterator last, const T& value,
+ Compare comp) {
+ ForwardIterator i = lower_bound(first, last, value, comp);
+ return i != last && !comp(value, *i);
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+OutputIterator merge(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result) {
+ while (first1 != last1 && first2 != last2) {
+ if (*first2 < *first1) {
+ *result = *first2;
+ ++first2;
+ }
+ else {
+ *result = *first1;
+ ++first1;
+ }
+ ++result;
+ }
+ return copy(first2, last2, copy(first1, last1, result));
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator,
+ class Compare>
+OutputIterator merge(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ while (first1 != last1 && first2 != last2) {
+ if (comp(*first2, *first1)) {
+ *result = *first2;
+ ++first2;
+ }
+ else {
+ *result = *first1;
+ ++first1;
+ }
+ ++result;
+ }
+ return copy(first2, last2, copy(first1, last1, result));
+}
+
+template <class BidirectionalIterator, class Distance>
+void __merge_without_buffer(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last,
+ Distance len1, Distance len2) {
+ if (len1 == 0 || len2 == 0) return;
+ if (len1 + len2 == 2) {
+ if (*middle < *first) iter_swap(first, middle);
+ return;
+ }
+ BidirectionalIterator first_cut = first;
+ BidirectionalIterator second_cut = middle;
+ Distance len11 = 0;
+ Distance len22 = 0;
+ if (len1 > len2) {
+ len11 = len1 / 2;
+ advance(first_cut, len11);
+ second_cut = lower_bound(middle, last, *first_cut);
+ distance(middle, second_cut, len22);
+ } else {
+ len22 = len2 / 2;
+ advance(second_cut, len22);
+ first_cut = upper_bound(first, middle, *second_cut);
+ distance(first, first_cut, len11);
+ }
+ rotate(first_cut, middle, second_cut);
+ BidirectionalIterator new_middle = first_cut;
+ advance(new_middle, len22);
+ __merge_without_buffer(first, first_cut, new_middle, len11, len22);
+ __merge_without_buffer(new_middle, second_cut, last, len1 - len11,
+ len2 - len22);
+}
+
+template <class BidirectionalIterator, class Distance, class Compare>
+void __merge_without_buffer(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last,
+ Distance len1, Distance len2, Compare comp) {
+ if (len1 == 0 || len2 == 0) return;
+ if (len1 + len2 == 2) {
+ if (comp(*middle, *first)) iter_swap(first, middle);
+ return;
+ }
+ BidirectionalIterator first_cut = first;
+ BidirectionalIterator second_cut = middle;
+ Distance len11 = 0;
+ Distance len22 = 0;
+ if (len1 > len2) {
+ len11 = len1 / 2;
+ advance(first_cut, len11);
+ second_cut = lower_bound(middle, last, *first_cut, comp);
+ distance(middle, second_cut, len22);
+ } else {
+ len22 = len2 / 2;
+ advance(second_cut, len22);
+ first_cut = upper_bound(first, middle, *second_cut, comp);
+ distance(first, first_cut, len11);
+ }
+ rotate(first_cut, middle, second_cut);
+ BidirectionalIterator new_middle = first_cut;
+ advance(new_middle, len22);
+ __merge_without_buffer(first, first_cut, new_middle, len11, len22, comp);
+ __merge_without_buffer(new_middle, second_cut, last, len1 - len11,
+ len2 - len22, comp);
+}
+
+template <class BidirectionalIterator1, class BidirectionalIterator2,
+ class Distance>
+BidirectionalIterator1 __rotate_adaptive(BidirectionalIterator1 first,
+ BidirectionalIterator1 middle,
+ BidirectionalIterator1 last,
+ Distance len1, Distance len2,
+ BidirectionalIterator2 buffer,
+ Distance buffer_size) {
+ BidirectionalIterator2 buffer_end;
+ if (len1 > len2 && len2 <= buffer_size) {
+ buffer_end = copy(middle, last, buffer);
+ copy_backward(first, middle, last);
+ return copy(buffer, buffer_end, first);
+ } else if (len1 <= buffer_size) {
+ buffer_end = copy(first, middle, buffer);
+ copy(middle, last, first);
+ return copy_backward(buffer, buffer_end, last);
+ } else {
+ rotate(first, middle, last);
+ advance(first, len2);
+ return first;
+ }
+}
+
+template <class BidirectionalIterator1, class BidirectionalIterator2,
+ class BidirectionalIterator3>
+BidirectionalIterator3 __merge_backward(BidirectionalIterator1 first1,
+ BidirectionalIterator1 last1,
+ BidirectionalIterator2 first2,
+ BidirectionalIterator2 last2,
+ BidirectionalIterator3 result) {
+ if (first1 == last1) return copy_backward(first2, last2, result);
+ if (first2 == last2) return copy_backward(first1, last1, result);
+ --last1;
+ --last2;
+ while (true) {
+ if (*last2 < *last1) {
+ *--result = *last1;
+ if (first1 == last1) return copy_backward(first2, ++last2, result);
+ --last1;
+ } else {
+ *--result = *last2;
+ if (first2 == last2) return copy_backward(first1, ++last1, result);
+ --last2;
+ }
+ }
+}
+
+template <class BidirectionalIterator1, class BidirectionalIterator2,
+ class BidirectionalIterator3, class Compare>
+BidirectionalIterator3 __merge_backward(BidirectionalIterator1 first1,
+ BidirectionalIterator1 last1,
+ BidirectionalIterator2 first2,
+ BidirectionalIterator2 last2,
+ BidirectionalIterator3 result,
+ Compare comp) {
+ if (first1 == last1) return copy_backward(first2, last2, result);
+ if (first2 == last2) return copy_backward(first1, last1, result);
+ --last1;
+ --last2;
+ while (true) {
+ if (comp(*last2, *last1)) {
+ *--result = *last1;
+ if (first1 == last1) return copy_backward(first2, ++last2, result);
+ --last1;
+ } else {
+ *--result = *last2;
+ if (first2 == last2) return copy_backward(first1, ++last1, result);
+ --last2;
+ }
+ }
+}
+
+template <class BidirectionalIterator, class Distance, class Pointer>
+void __merge_adaptive(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, Distance len1, Distance len2,
+ Pointer buffer, Distance buffer_size) {
+ if (len1 <= len2 && len1 <= buffer_size) {
+ Pointer end_buffer = copy(first, middle, buffer);
+ merge(buffer, end_buffer, middle, last, first);
+ } else if (len2 <= buffer_size) {
+ Pointer end_buffer = copy(middle, last, buffer);
+ __merge_backward(first, middle, buffer, end_buffer, last);
+ } else {
+ BidirectionalIterator first_cut = first;
+ BidirectionalIterator second_cut = middle;
+ Distance len11 = 0;
+ Distance len22 = 0;
+ if (len1 > len2) {
+ len11 = len1 / 2;
+ advance(first_cut, len11);
+ second_cut = lower_bound(middle, last, *first_cut);
+ distance(middle, second_cut, len22);
+ } else {
+ len22 = len2 / 2;
+ advance(second_cut, len22);
+ first_cut = upper_bound(first, middle, *second_cut);
+ distance(first, first_cut, len11);
+ }
+ BidirectionalIterator new_middle =
+ __rotate_adaptive(first_cut, middle, second_cut, len1 - len11,
+ len22, buffer, buffer_size);
+ __merge_adaptive(first, first_cut, new_middle, len11, len22, buffer,
+ buffer_size);
+ __merge_adaptive(new_middle, second_cut, last, len1 - len11,
+ len2 - len22, buffer, buffer_size);
+ }
+}
+
+template <class BidirectionalIterator, class Distance, class Pointer,
+ class Compare>
+void __merge_adaptive(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, Distance len1, Distance len2,
+ Pointer buffer, Distance buffer_size, Compare comp) {
+ if (len1 <= len2 && len1 <= buffer_size) {
+ Pointer end_buffer = copy(first, middle, buffer);
+ merge(buffer, end_buffer, middle, last, first, comp);
+ } else if (len2 <= buffer_size) {
+ Pointer end_buffer = copy(middle, last, buffer);
+ __merge_backward(first, middle, buffer, end_buffer, last, comp);
+ } else {
+ BidirectionalIterator first_cut = first;
+ BidirectionalIterator second_cut = middle;
+ Distance len11 = 0;
+ Distance len22 = 0;
+ if (len1 > len2) {
+ len11 = len1 / 2;
+ advance(first_cut, len11);
+ second_cut = lower_bound(middle, last, *first_cut, comp);
+ distance(middle, second_cut, len22);
+ } else {
+ len22 = len2 / 2;
+ advance(second_cut, len22);
+ first_cut = upper_bound(first, middle, *second_cut, comp);
+ distance(first, first_cut, len11);
+ }
+ BidirectionalIterator new_middle =
+ __rotate_adaptive(first_cut, middle, second_cut, len1 - len11,
+ len22, buffer, buffer_size);
+ __merge_adaptive(first, first_cut, new_middle, len11, len22, buffer,
+ buffer_size, comp);
+ __merge_adaptive(new_middle, second_cut, last, len1 - len11,
+ len2 - len22, buffer, buffer_size, comp);
+ }
+}
+
+template <class BidirectionalIterator, class T, class Distance>
+inline void __inplace_merge_aux(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, T*, Distance*) {
+ Distance len1 = 0;
+ distance(first, middle, len1);
+ Distance len2 = 0;
+ distance(middle, last, len2);
+
+ temporary_buffer<BidirectionalIterator, T> buf(first, last);
+ if (buf.begin() == 0)
+ __merge_without_buffer(first, middle, last, len1, len2);
+ else
+ __merge_adaptive(first, middle, last, len1, len2,
+ buf.begin(), Distance(buf.size()));
+}
+
+template <class BidirectionalIterator, class T, class Distance, class Compare>
+inline void __inplace_merge_aux(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, T*, Distance*,
+ Compare comp) {
+ Distance len1 = 0;
+ distance(first, middle, len1);
+ Distance len2 = 0;
+ distance(middle, last, len2);
+
+ temporary_buffer<BidirectionalIterator, T> buf(first, last);
+ if (buf.begin() == 0)
+ __merge_without_buffer(first, middle, last, len1, len2, comp);
+ else
+ __merge_adaptive(first, middle, last, len1, len2,
+ buf.begin(), Distance(buf.size()),
+ comp);
+}
+
+template <class BidirectionalIterator>
+inline void inplace_merge(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last) {
+ if (first == middle || middle == last) return;
+ __inplace_merge_aux(first, middle, last, value_type(first),
+ distance_type(first));
+}
+
+template <class BidirectionalIterator, class Compare>
+inline void inplace_merge(BidirectionalIterator first,
+ BidirectionalIterator middle,
+ BidirectionalIterator last, Compare comp) {
+ if (first == middle || middle == last) return;
+ __inplace_merge_aux(first, middle, last, value_type(first),
+ distance_type(first), comp);
+}
+
+template <class InputIterator1, class InputIterator2>
+bool includes(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2) {
+ while (first1 != last1 && first2 != last2)
+ if (*first2 < *first1)
+ return false;
+ else if(*first1 < *first2)
+ ++first1;
+ else
+ ++first1, ++first2;
+
+ return first2 == last2;
+}
+
+template <class InputIterator1, class InputIterator2, class Compare>
+bool includes(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2, Compare comp) {
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first2, *first1))
+ return false;
+ else if(comp(*first1, *first2))
+ ++first1;
+ else
+ ++first1, ++first2;
+
+ return first2 == last2;
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+OutputIterator set_union(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result) {
+ while (first1 != last1 && first2 != last2) {
+ if (*first1 < *first2) {
+ *result = *first1;
+ ++first1;
+ }
+ else if (*first2 < *first1) {
+ *result = *first2;
+ ++first2;
+ }
+ else {
+ *result = *first1;
+ ++first1;
+ ++first2;
+ }
+ ++result;
+ }
+ return copy(first2, last2, copy(first1, last1, result));
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator,
+ class Compare>
+OutputIterator set_union(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ while (first1 != last1 && first2 != last2) {
+ if (comp(*first1, *first2)) {
+ *result = *first1;
+ ++first1;
+ }
+ else if (comp(*first2, *first1)) {
+ *result = *first2;
+ ++first2;
+ }
+ else {
+ *result = *first1;
+ ++first1;
+ ++first2;
+ }
+ ++result;
+ }
+ return copy(first2, last2, copy(first1, last1, result));
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+OutputIterator set_intersection(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result) {
+ while (first1 != last1 && first2 != last2)
+ if (*first1 < *first2)
+ ++first1;
+ else if (*first2 < *first1)
+ ++first2;
+ else {
+ *result = *first1;
+ ++first1;
+ ++first2;
+ ++result;
+ }
+ return result;
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator,
+ class Compare>
+OutputIterator set_intersection(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first1, *first2))
+ ++first1;
+ else if (comp(*first2, *first1))
+ ++first2;
+ else {
+ *result = *first1;
+ ++first1;
+ ++first2;
+ ++result;
+ }
+ return result;
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+OutputIterator set_difference(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result) {
+ while (first1 != last1 && first2 != last2)
+ if (*first1 < *first2) {
+ *result = *first1;
+ ++first1;
+ ++result;
+ }
+ else if (*first2 < *first1)
+ ++first2;
+ else {
+ ++first1;
+ ++first2;
+ }
+ return copy(first1, last1, result);
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator,
+ class Compare>
+OutputIterator set_difference(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first1, *first2)) {
+ *result = *first1;
+ ++first1;
+ ++result;
+ }
+ else if (comp(*first2, *first1))
+ ++first2;
+ else {
+ ++first1;
+ ++first2;
+ }
+ return copy(first1, last1, result);
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator>
+OutputIterator set_symmetric_difference(InputIterator1 first1,
+ InputIterator1 last1,
+ InputIterator2 first2,
+ InputIterator2 last2,
+ OutputIterator result) {
+ while (first1 != last1 && first2 != last2)
+ if (*first1 < *first2) {
+ *result = *first1;
+ ++first1;
+ ++result;
+ }
+ else if (*first2 < *first1) {
+ *result = *first2;
+ ++first2;
+ ++result;
+ }
+ else {
+ ++first1;
+ ++first2;
+ }
+ return copy(first2, last2, copy(first1, last1, result));
+}
+
+template <class InputIterator1, class InputIterator2, class OutputIterator,
+ class Compare>
+OutputIterator set_symmetric_difference(InputIterator1 first1,
+ InputIterator1 last1,
+ InputIterator2 first2,
+ InputIterator2 last2,
+ OutputIterator result, Compare comp) {
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first1, *first2)) {
+ *result = *first1;
+ ++first1;
+ ++result;
+ }
+ else if (comp(*first2, *first1)) {
+ *result = *first2;
+ ++first2;
+ ++result;
+ }
+ else {
+ ++first1;
+ ++first2;
+ }
+ return copy(first2, last2, copy(first1, last1, result));
+}
+
+template <class ForwardIterator>
+ForwardIterator max_element(ForwardIterator first, ForwardIterator last) {
+ if (first == last) return first;
+ ForwardIterator result = first;
+ while (++first != last)
+ if (*result < *first) result = first;
+ return result;
+}
+
+template <class ForwardIterator, class Compare>
+ForwardIterator max_element(ForwardIterator first, ForwardIterator last,
+ Compare comp) {
+ if (first == last) return first;
+ ForwardIterator result = first;
+ while (++first != last)
+ if (comp(*result, *first)) result = first;
+ return result;
+}
+
+template <class ForwardIterator>
+ForwardIterator min_element(ForwardIterator first, ForwardIterator last) {
+ if (first == last) return first;
+ ForwardIterator result = first;
+ while (++first != last)
+ if (*first < *result) result = first;
+ return result;
+}
+
+template <class ForwardIterator, class Compare>
+ForwardIterator min_element(ForwardIterator first, ForwardIterator last,
+ Compare comp) {
+ if (first == last) return first;
+ ForwardIterator result = first;
+ while (++first != last)
+ if (comp(*first, *result)) result = first;
+ return result;
+}
+
+template <class BidirectionalIterator>
+bool next_permutation(BidirectionalIterator first,
+ BidirectionalIterator last) {
+ if (first == last) return false;
+ BidirectionalIterator i = first;
+ ++i;
+ if (i == last) return false;
+ i = last;
+ --i;
+
+ for(;;) {
+ BidirectionalIterator ii = i;
+ --i;
+ if (*i < *ii) {
+ BidirectionalIterator j = last;
+ while (!(*i < *--j));
+ iter_swap(i, j);
+ reverse(ii, last);
+ return true;
+ }
+ if (i == first) {
+ reverse(first, last);
+ return false;
+ }
+ }
+}
+
+template <class BidirectionalIterator, class Compare>
+bool next_permutation(BidirectionalIterator first, BidirectionalIterator last,
+ Compare comp) {
+ if (first == last) return false;
+ BidirectionalIterator i = first;
+ ++i;
+ if (i == last) return false;
+ i = last;
+ --i;
+
+ for(;;) {
+ BidirectionalIterator ii = i;
+ --i;
+ if (comp(*i, *ii)) {
+ BidirectionalIterator j = last;
+ while (!comp(*i, *--j));
+ iter_swap(i, j);
+ reverse(ii, last);
+ return true;
+ }
+ if (i == first) {
+ reverse(first, last);
+ return false;
+ }
+ }
+}
+
+template <class BidirectionalIterator>
+bool prev_permutation(BidirectionalIterator first,
+ BidirectionalIterator last) {
+ if (first == last) return false;
+ BidirectionalIterator i = first;
+ ++i;
+ if (i == last) return false;
+ i = last;
+ --i;
+
+ for(;;) {
+ BidirectionalIterator ii = i;
+ --i;
+ if (*ii < *i) {
+ BidirectionalIterator j = last;
+ while (!(*--j < *i));
+ iter_swap(i, j);
+ reverse(ii, last);
+ return true;
+ }
+ if (i == first) {
+ reverse(first, last);
+ return false;
+ }
+ }
+}
+
+template <class BidirectionalIterator, class Compare>
+bool prev_permutation(BidirectionalIterator first, BidirectionalIterator last,
+ Compare comp) {
+ if (first == last) return false;
+ BidirectionalIterator i = first;
+ ++i;
+ if (i == last) return false;
+ i = last;
+ --i;
+
+ for(;;) {
+ BidirectionalIterator ii = i;
+ --i;
+ if (comp(*ii, *i)) {
+ BidirectionalIterator j = last;
+ while (!comp(*--j, *i));
+ iter_swap(i, j);
+ reverse(ii, last);
+ return true;
+ }
+ if (i == first) {
+ reverse(first, last);
+ return false;
+ }
+ }
+}
+
+template <class InputIterator, class T>
+T accumulate(InputIterator first, InputIterator last, T init) {
+ for ( ; first != last; ++first)
+ init = init + *first;
+ return init;
+}
+
+template <class InputIterator, class T, class BinaryOperation>
+T accumulate(InputIterator first, InputIterator last, T init,
+ BinaryOperation binary_op) {
+ for ( ; first != last; ++first)
+ init = binary_op(init, *first);
+ return init;
+}
+
+template <class InputIterator1, class InputIterator2, class T>
+T inner_product(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, T init) {
+ for ( ; first1 != last1; ++first1, ++first2)
+ init = init + (*first1 * *first2);
+ return init;
+}
+
+template <class InputIterator1, class InputIterator2, class T,
+ class BinaryOperation1, class BinaryOperation2>
+T inner_product(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, T init, BinaryOperation1 binary_op1,
+ BinaryOperation2 binary_op2) {
+ for ( ; first1 != last1; ++first1, ++first2)
+ init = binary_op1(init, binary_op2(*first1, *first2));
+ return init;
+}
+
+template <class InputIterator, class OutputIterator, class T>
+OutputIterator __partial_sum(InputIterator first, InputIterator last,
+ OutputIterator result, T*) {
+ T value = *first;
+ while (++first != last) {
+ value = value + *first;
+ *++result = value;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator>
+OutputIterator partial_sum(InputIterator first, InputIterator last,
+ OutputIterator result) {
+ if (first == last) return result;
+ *result = *first;
+ return __partial_sum(first, last, result, value_type(first));
+}
+
+template <class InputIterator, class OutputIterator, class T,
+ class BinaryOperation>
+OutputIterator __partial_sum(InputIterator first, InputIterator last,
+ OutputIterator result, T*,
+ BinaryOperation binary_op) {
+ T value = *first;
+ while (++first != last) {
+ value = binary_op(value, *first);
+ *++result = value;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator, class BinaryOperation>
+OutputIterator partial_sum(InputIterator first, InputIterator last,
+ OutputIterator result, BinaryOperation binary_op) {
+ if (first == last) return result;
+ *result = *first;
+ return __partial_sum(first, last, result, value_type(first), binary_op);
+}
+
+template <class InputIterator, class OutputIterator, class T>
+OutputIterator __adjacent_difference(InputIterator first, InputIterator last,
+ OutputIterator result, T*) {
+ T value = *first;
+ while (++first != last) {
+ T tmp = *first;
+ *++result = tmp - value;
+ value = tmp;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator>
+OutputIterator adjacent_difference(InputIterator first, InputIterator last,
+ OutputIterator result) {
+ if (first == last) return result;
+ *result = *first;
+ return __adjacent_difference(first, last, result, value_type(first));
+}
+
+template <class InputIterator, class OutputIterator, class T,
+ class BinaryOperation>
+OutputIterator __adjacent_difference(InputIterator first, InputIterator last,
+ OutputIterator result, T*,
+ BinaryOperation binary_op) {
+ T value = *first;
+ while (++first != last) {
+ T tmp = *first;
+ *++result = binary_op(tmp, value);
+ value = tmp;
+ }
+ return ++result;
+}
+
+template <class InputIterator, class OutputIterator, class BinaryOperation>
+OutputIterator adjacent_difference(InputIterator first, InputIterator last,
+ OutputIterator result,
+ BinaryOperation binary_op) {
+ if (first == last) return result;
+ *result = *first;
+ return __adjacent_difference(first, last, result, value_type(first),
+ binary_op);
+}
+
+// Returns x ** n, where n >= 0. Note that "multiplication"
+// is required to be associative, but not necessarily commutative.
+
+template <class T, class Integer, class MonoidOperation>
+T power(T x, Integer n, MonoidOperation op) {
+ if (n == 0)
+ return identity_element(op);
+ else {
+ while (n % 2 == 0) {
+ n /= 2;
+ x = op(x, x);
+ }
+
+ T result = x;
+ n /= 2;
+ while (n != 0) {
+ x = op(x, x);
+ if (n % 2 != 0)
+ result = op(result, x);
+ n /= 2;
+ }
+ return result;
+ }
+}
+
+template <class T, class Integer>
+inline T power(T x, Integer n) {
+ return power(x, n, multiplies<T>());
+}
+
+
+template <class ForwardIterator, class T>
+void iota(ForwardIterator first, ForwardIterator last, T value) {
+ while (first != last) *first++ = value++;
+}
+
+template <class RandomAccessIterator, class Distance>
+bool __is_heap(RandomAccessIterator first, RandomAccessIterator last,
+ Distance*)
+{
+ const Distance n = last - first;
+
+ Distance parent = 0;
+ for (Distance child = 1; child < n; ++child) {
+ if (first[parent] < first[child])
+ return false;
+ if (child % 2 == 0)
+ ++parent;
+ }
+ return true;
+}
+
+template <class RandomAccessIterator>
+inline bool is_heap(RandomAccessIterator first, RandomAccessIterator last)
+{
+ return __is_heap(first, last, distance_type(first));
+}
+
+
+template <class RandomAccessIterator, class Distance, class StrictWeakOrdering>
+bool __is_heap(RandomAccessIterator first, RandomAccessIterator last,
+ StrictWeakOrdering comp,
+ Distance*)
+{
+ const Distance n = last - first;
+
+ Distance parent = 0;
+ for (Distance child = 1; child < n; ++child) {
+ if (comp(first[parent], first[child]))
+ return false;
+ if (child % 2 == 0)
+ ++parent;
+ }
+ return true;
+}
+
+template <class RandomAccessIterator, class StrictWeakOrdering>
+inline bool is_heap(RandomAccessIterator first, RandomAccessIterator last,
+ StrictWeakOrdering comp)
+{
+ return __is_heap(first, last, comp, distance_type(first));
+}
+
+
+template <class ForwardIterator>
+bool is_sorted(ForwardIterator first, ForwardIterator last)
+{
+ if (first == last)
+ return true;
+
+ ForwardIterator next = first;
+ for (++next; next != last; first = next, ++next) {
+ if (*next < *first)
+ return false;
+ }
+
+ return true;
+}
+
+template <class ForwardIterator, class StrictWeakOrdering>
+bool is_sorted(ForwardIterator first, ForwardIterator last,
+ StrictWeakOrdering comp)
+{
+ if (first == last)
+ return true;
+
+ ForwardIterator next = first;
+ for (++next; next != last; first = next, ++next) {
+ if (comp(*next, *first))
+ return false;
+ }
+
+ return true;
+}
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+#pragma reset woff 1209
+#endif
+
+#endif /* __SGI_STL_ALGO_H */
diff --git a/libstdc++/stl/algobase.h b/libstdc++/stl/algobase.h
new file mode 100644
index 00000000000..0a17f48b2e7
--- /dev/null
+++ b/libstdc++/stl/algobase.h
@@ -0,0 +1,841 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef _SGI_STL_ALGOBASE_H
+#define _SGI_STL_ALGOBASE_H
+
+#include <string.h>
+#include <limits.h>
+#include <function.h>
+#include <pair.h>
+#include <iterator.h>
+#include <new.h>
+#include <type_traits.h>
+
+template <class ForwardIterator1, class ForwardIterator2, class T>
+inline void __iter_swap(ForwardIterator1 a, ForwardIterator2 b, T*) {
+ T tmp = *a;
+ *a = *b;
+ *b = tmp;
+}
+
+template <class ForwardIterator1, class ForwardIterator2>
+inline void iter_swap(ForwardIterator1 a, ForwardIterator2 b) {
+ __iter_swap(a, b, value_type(a));
+}
+
+template <class T>
+inline void swap(T& a, T& b) {
+ T tmp = a;
+ a = b;
+ b = tmp;
+}
+
+#ifdef __BORLANDC__
+#include <stdlib.h>
+#else
+
+template <class T>
+inline const T& min(const T& a, const T& b) {
+ return b < a ? b : a;
+}
+
+template <class T>
+inline const T& max(const T& a, const T& b) {
+ return a < b ? b : a;
+}
+
+#endif
+
+template <class T, class Compare>
+inline const T& min(const T& a, const T& b, Compare comp) {
+ return comp(b, a) ? b : a;
+}
+
+template <class T, class Compare>
+inline const T& max(const T& a, const T& b, Compare comp) {
+ return comp(a, b) ? b : a;
+}
+
+template <class InputIterator, class Distance>
+inline void __distance(InputIterator first, InputIterator last, Distance& n,
+ input_iterator_tag) {
+ while (first != last) { ++first; ++n; }
+}
+
+template <class ForwardIterator, class Distance>
+inline void __distance(ForwardIterator first, ForwardIterator last,
+ Distance& n,
+ forward_iterator_tag) {
+ while (first != last) { ++first; ++n; }
+}
+
+template <class BidirectionalIterator, class Distance>
+inline void __distance(BidirectionalIterator first, BidirectionalIterator last,
+ Distance& n, bidirectional_iterator_tag) {
+ while (first != last) { ++first; ++n; }
+}
+
+template <class RandomAccessIterator, class Distance>
+inline void __distance(RandomAccessIterator first, RandomAccessIterator last,
+ Distance& n, random_access_iterator_tag) {
+ n += last - first;
+}
+
+template <class InputIterator, class Distance>
+inline void distance(InputIterator first, InputIterator last, Distance& n) {
+ __distance(first, last, n, iterator_category(first));
+}
+
+#ifdef __STL_CLASS_PARTIAL_SPECIALIZATION
+
+template <class InputIterator>
+inline iterator_traits<InputIterator>::difference_type
+__distance(InputIterator first, InputIterator last, input_iterator_tag) {
+ iterator_traits<InputIterator>::difference_type n = 0;
+ while (first != last) {
+ ++first; ++n;
+ }
+ return n;
+}
+
+template <class ForwardIterator>
+inline iterator_traits<ForwardIterator>::difference_type
+__distance(ForwardIterator first, ForwardIterator last, forward_iterator_tag) {
+ return __distance(first, last, input_iterator_tag());
+}
+
+template <class BidirectionalIterator>
+inline iterator_traits<BidirectionalIterator>::difference_type
+__distance(BidirectionalIterator first, BidirectionalIterator last,
+ bidirectional_iterator_tag) {
+ return __distance(first, last, input_iterator_tag());
+}
+
+template <class RandomAccessIterator>
+inline iterator_traits<RandomAccessIterator>::difference_type
+__distance(RandomAccessIterator first, RandomAccessIterator last,
+ random_access_iterator_tag) {
+ return last - first;
+}
+
+template <class InputIterator>
+inline iterator_traits<InputIterator>::difference_type
+distance(InputIterator first, InputIterator last) {
+ return __distance(first, last,
+ iterator_traits<InputIterator>::iterator_category());
+}
+
+#endif /* __STL_CLASS_PARTIAL_SPECIALIZATION */
+
+template <class InputIterator, class Distance>
+inline void __advance(InputIterator& i, Distance n, input_iterator_tag) {
+ while (n--) ++i;
+}
+
+template <class ForwardIterator, class Distance>
+inline void __advance(ForwardIterator& i, Distance n, forward_iterator_tag) {
+ while (n--) ++i;
+}
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+#pragma set woff 1183
+#endif
+
+template <class BidirectionalIterator, class Distance>
+inline void __advance(BidirectionalIterator& i, Distance n,
+ bidirectional_iterator_tag) {
+ if (n >= 0)
+ while (n--) ++i;
+ else
+ while (n++) --i;
+}
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+#pragma reset woff 1183
+#endif
+
+template <class RandomAccessIterator, class Distance>
+inline void __advance(RandomAccessIterator& i, Distance n,
+ random_access_iterator_tag) {
+ i += n;
+}
+
+template <class InputIterator, class Distance>
+inline void advance(InputIterator& i, Distance n) {
+ __advance(i, n, iterator_category(i));
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator __copy(InputIterator first, InputIterator last,
+ OutputIterator result, input_iterator_tag)
+{
+ for ( ; first != last; ++result, ++first)
+ *result = *first;
+ return result;
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator __copy(InputIterator first, InputIterator last,
+ OutputIterator result, forward_iterator_tag)
+{
+ return __copy(first, last, result, input_iterator_tag());
+}
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator __copy(InputIterator first, InputIterator last,
+ OutputIterator result, bidirectional_iterator_tag)
+{
+ return __copy(first, last, result, input_iterator_tag());
+}
+
+template <class RandomAccessIterator, class OutputIterator, class Distance>
+inline OutputIterator
+__copy_d(RandomAccessIterator first, RandomAccessIterator last,
+ OutputIterator result, Distance*)
+{
+ for (Distance n = last - first; n > 0; --n, ++result, ++first)
+ *result = *first;
+ return result;
+}
+
+template <class RandomAccessIterator, class OutputIterator>
+inline OutputIterator
+__copy(RandomAccessIterator first, RandomAccessIterator last,
+ OutputIterator result, random_access_iterator_tag)
+{
+ return __copy_d(first, last, result, distance_type(first));
+}
+
+template <class InputIterator, class OutputIterator>
+struct __copy_dispatch
+{
+ OutputIterator operator()(InputIterator first, InputIterator last,
+ OutputIterator result) {
+ return __copy(first, last, result, iterator_category(first));
+ }
+};
+
+#ifdef __STL_CLASS_PARTIAL_SPECIALIZATION
+
+template <class T>
+inline T* __copy_t(const T* first, const T* last, T* result, __true_type) {
+ memmove(result, first, sizeof(T) * (last - first));
+ return result + (last - first);
+}
+
+template <class T>
+inline T* __copy_t(const T* first, const T* last, T* result, __false_type) {
+ return __copy_d(first, last, result, (ptrdiff_t*) 0);
+}
+
+template <class T>
+struct __copy_dispatch<T*, T*>
+{
+ T* operator()(T* first, T* last, T* result) {
+ return __copy_t(first, last, result,
+ __type_traits<T>::has_trivial_assignment_operator());
+ }
+};
+
+template <class T>
+struct __copy_dispatch<const T*, T*>
+{
+ T* operator()(const T* first, const T* last, T* result) {
+ return __copy_t(first, last, result,
+ __type_traits<T>::has_trivial_assignment_operator());
+ }
+};
+
+#endif /* __STL_CLASS_PARTIAL_SPECIALIZATION */
+
+template <class InputIterator, class OutputIterator>
+inline OutputIterator copy(InputIterator first, InputIterator last,
+ OutputIterator result)
+{
+ return __copy_dispatch<InputIterator,OutputIterator>()(first, last, result);
+}
+
+inline char* copy(const char* first, const char* last, char* result) {
+ memmove(result, first, last - first);
+ return result + (last - first);
+}
+
+inline wchar_t* copy(const wchar_t* first, const wchar_t* last,
+ wchar_t* result) {
+ memmove(result, first, sizeof(wchar_t) * (last - first));
+ return result + (last - first);
+}
+
+template <class BidirectionalIterator1, class BidirectionalIterator2>
+inline BidirectionalIterator2 __copy_backward(BidirectionalIterator1 first,
+ BidirectionalIterator1 last,
+ BidirectionalIterator2 result) {
+ while (first != last) *--result = *--last;
+ return result;
+}
+
+
+template <class BidirectionalIterator1, class BidirectionalIterator2>
+struct __copy_backward_dispatch
+{
+ BidirectionalIterator2 operator()(BidirectionalIterator1 first,
+ BidirectionalIterator1 last,
+ BidirectionalIterator2 result) {
+ return __copy_backward(first, last, result);
+ }
+};
+
+#ifdef __STL_CLASS_PARTIAL_SPECIALIZATION
+
+template <class T>
+inline T* __copy_backward_t(const T* first, const T* last, T* result,
+ __true_type) {
+ const ptrdiff_t N = last - first;
+ memmove(result - N, first, sizeof(T) * N);
+ return result - N;
+}
+
+template <class T>
+inline T* __copy_backward_t(const T* first, const T* last, T* result,
+ __false_type) {
+ return __copy_backward(first, last, result);
+}
+
+template <class T>
+struct __copy_backward_dispatch<T*, T*>
+{
+ T* operator()(T* first, T* last, T* result) {
+ return
+ __copy_backward_t(first, last, result,
+ __type_traits<T>::has_trivial_assignment_operator());
+ }
+};
+
+template <class T>
+struct __copy_backward_dispatch<const T*, T*>
+{
+ T* operator()(const T* first, const T* last, T* result) {
+ return
+ __copy_backward_t(first, last, result,
+ __type_traits<T>::has_trivial_assignment_operator());
+ }
+};
+
+#endif /* __STL_CLASS_PARTIAL_SPECIALIZATION */
+
+template <class BidirectionalIterator1, class BidirectionalIterator2>
+inline BidirectionalIterator2 copy_backward(BidirectionalIterator1 first,
+ BidirectionalIterator1 last,
+ BidirectionalIterator2 result) {
+ return __copy_backward_dispatch<BidirectionalIterator1,
+ BidirectionalIterator2>()(first, last,
+ result);
+}
+
+template <class InputIterator, class Size, class OutputIterator>
+OutputIterator __copy_n(InputIterator first, Size count,
+ OutputIterator result,
+ input_iterator_tag) {
+ for ( ; count > 0; --count, ++first, ++result)
+ *result = *first;
+ return result;
+}
+
+template <class ForwardIterator, class Size, class OutputIterator>
+inline OutputIterator __copy_n(ForwardIterator first, Size count,
+ OutputIterator result,
+ forward_iterator_tag) {
+ return __copy_n(first, count, result, input_iterator_tag());
+}
+
+template <class BidirectionalIterator, class Size, class OutputIterator>
+inline OutputIterator __copy_n(BidirectionalIterator first, Size count,
+ OutputIterator result,
+ bidirectional_iterator_tag) {
+ return __copy_n(first, count, result, input_iterator_tag());
+}
+
+template <class RandomAccessIterator, class Size, class OutputIterator>
+inline OutputIterator __copy_n(RandomAccessIterator first, Size count,
+ OutputIterator result,
+ random_access_iterator_tag) {
+ return copy(first, first + count, result);
+}
+
+template <class InputIterator, class Size, class OutputIterator>
+inline OutputIterator copy_n(InputIterator first, Size count,
+ OutputIterator result) {
+ return __copy_n(first, count, result, iterator_category(first));
+}
+
+template <class ForwardIterator, class T>
+void fill(ForwardIterator first, ForwardIterator last, const T& value) {
+ for ( ; first != last; ++first)
+ *first = value;
+}
+
+template <class OutputIterator, class Size, class T>
+OutputIterator fill_n(OutputIterator first, Size n, const T& value) {
+ for ( ; n > 0; --n, ++first)
+ *first = value;
+ return first;
+}
+
+template <class InputIterator1, class InputIterator2>
+pair<InputIterator1, InputIterator2> mismatch(InputIterator1 first1,
+ InputIterator1 last1,
+ InputIterator2 first2) {
+ while (first1 != last1 && *first1 == *first2) {
+ ++first1;
+ ++first2;
+ }
+ return pair<InputIterator1, InputIterator2>(first1, first2);
+}
+
+template <class InputIterator1, class InputIterator2, class BinaryPredicate>
+pair<InputIterator1, InputIterator2> mismatch(InputIterator1 first1,
+ InputIterator1 last1,
+ InputIterator2 first2,
+ BinaryPredicate binary_pred) {
+ while (first1 != last1 && binary_pred(*first1, *first2)) {
+ ++first1;
+ ++first2;
+ }
+ return pair<InputIterator1, InputIterator2>(first1, first2);
+}
+
+template <class InputIterator1, class InputIterator2>
+inline bool equal(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2) {
+ for ( ; first1 != last1; ++first1, ++first2)
+ if (*first1 != *first2)
+ return false;
+ return true;
+}
+
+template <class InputIterator1, class InputIterator2, class BinaryPredicate>
+inline bool equal(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, BinaryPredicate binary_pred) {
+ for ( ; first1 != last1; ++first1, ++first2)
+ if (!binary_pred(*first1, *first2))
+ return false;
+ return true;
+}
+
+template <class InputIterator1, class InputIterator2>
+bool lexicographical_compare(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2) {
+ for ( ; first1 != last1 && first2 != last2; ++first1, ++first2) {
+ if (*first1 < *first2)
+ return true;
+ if (*first2 < *first1)
+ return false;
+ }
+ return first1 == last1 && first2 != last2;
+}
+
+template <class InputIterator1, class InputIterator2, class Compare>
+bool lexicographical_compare(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ Compare comp) {
+ for ( ; first1 != last1 && first2 != last2; ++first1, ++first2) {
+ if (comp(*first1, *first2))
+ return true;
+ if (comp(*first2, *first1))
+ return false;
+ }
+ return first1 == last1 && first2 != last2;
+}
+
+inline bool
+lexicographical_compare(const unsigned char* first1,
+ const unsigned char* last1,
+ const unsigned char* first2,
+ const unsigned char* last2)
+{
+ const size_t len1 = last1 - first1;
+ const size_t len2 = last2 - first2;
+ const int result = memcmp(first1, first2, min(len1, len2));
+ return result != 0 ? result < 0 : len1 < len2;
+}
+
+inline bool lexicographical_compare(const char* first1, const char* last1,
+ const char* first2, const char* last2)
+{
+#if CHAR_MAX == SCHAR_MAX
+ return lexicographical_compare((const signed char*) first1,
+ (const signed char*) last1,
+ (const signed char*) first2,
+ (const signed char*) last2);
+#else
+ return lexicographical_compare((const unsigned char*) first1,
+ (const unsigned char*) last1,
+ (const unsigned char*) first2,
+ (const unsigned char*) last2);
+#endif
+}
+
+template <class InputIterator1, class InputIterator2>
+int lexicographical_compare_3way(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2)
+{
+ while (first1 != last1 && first2 != last2) {
+ if (*first1 < *first2) return -1;
+ if (*first2 < *first1) return 1;
+ ++first1; ++first2;
+ }
+ if (first2 == last2) {
+ return !(first1 == last1);
+ } else {
+ return -1;
+ }
+}
+
+inline int
+lexicographical_compare_3way(const unsigned char* first1,
+ const unsigned char* last1,
+ const unsigned char* first2,
+ const unsigned char* last2)
+{
+ const int len1 = last1 - first1;
+ const int len2 = last2 - first2;
+ const int result = memcmp(first1, first2, min(len1, len2));
+ return result == 0 ? len1 - len2 : result;
+}
+
+inline int lexicographical_compare_3way(const char* first1, const char* last1,
+ const char* first2, const char* last2)
+{
+#if CHAR_MAX == SCHAR_MAX
+ return lexicographical_compare_3way(
+ (const signed char*) first1,
+ (const signed char*) last1,
+ (const signed char*) first2,
+ (const signed char*) last2);
+#else
+ return lexicographical_compare_3way((const unsigned char*) first1,
+ (const unsigned char*) last1,
+ (const unsigned char*) first2,
+ (const unsigned char*) last2);
+#endif
+}
+
+template <class T>
+inline void destroy(T* pointer) {
+ pointer->~T();
+}
+
+template <class T1, class T2>
+inline void construct(T1* p, const T2& value) {
+ new (p) T1(value);
+}
+
+template <class ForwardIterator>
+inline void
+__destroy_aux(ForwardIterator first, ForwardIterator last, __false_type) {
+ for ( ; first < last; ++first)
+ destroy(&*first);
+}
+
+template <class ForwardIterator>
+inline void __destroy_aux(ForwardIterator, ForwardIterator, __true_type) {
+}
+
+template <class ForwardIterator, class T>
+inline void __destroy(ForwardIterator first, ForwardIterator last, T*) {
+ __destroy_aux(first, last, __type_traits<T>::has_trivial_destructor());
+}
+
+template <class ForwardIterator>
+inline void destroy(ForwardIterator first, ForwardIterator last) {
+ __destroy(first, last, value_type(first));
+}
+
+inline void destroy(char*, char*) {}
+inline void destroy(wchar_t*, wchar_t*) {}
+
+// Valid if copy construction is equivalent to assignment, and if the
+// destructor is trivial.
+template <class InputIterator, class ForwardIterator>
+inline ForwardIterator
+__uninitialized_copy_aux(InputIterator first, InputIterator last,
+ ForwardIterator result,
+ __true_type) {
+ return copy(first, last, result);
+}
+
+template <class InputIterator, class ForwardIterator>
+ForwardIterator
+__uninitialized_copy_aux(InputIterator first, InputIterator last,
+ ForwardIterator result,
+ __false_type) {
+ ForwardIterator cur = result;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for ( ; first != last; ++first, ++cur)
+ construct(&*cur, *first);
+ return cur;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(result, cur);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+
+template <class InputIterator, class ForwardIterator, class T>
+inline ForwardIterator
+__uninitialized_copy(InputIterator first, InputIterator last,
+ ForwardIterator result, T*) {
+ return __uninitialized_copy_aux(first, last, result,
+ __type_traits<T>::is_POD_type());
+}
+
+template <class InputIterator, class ForwardIterator>
+inline ForwardIterator
+ uninitialized_copy(InputIterator first, InputIterator last,
+ ForwardIterator result) {
+ return __uninitialized_copy(first, last, result, value_type(result));
+}
+
+inline char* uninitialized_copy(const char* first, const char* last,
+ char* result) {
+ memmove(result, first, last - first);
+ return result + (last - first);
+}
+
+inline wchar_t* uninitialized_copy(const wchar_t* first, const wchar_t* last,
+ wchar_t* result) {
+ memmove(result, first, sizeof(wchar_t) * (last - first));
+ return result + (last - first);
+}
+
+template <class InputIterator, class Size, class ForwardIterator>
+ForwardIterator __uninitialized_copy_n(InputIterator first, Size count,
+ ForwardIterator result,
+ input_iterator_tag) {
+ ForwardIterator cur = result;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for ( ; count > 0 ; --count, ++first, ++cur)
+ construct(&*cur, *first);
+ return cur;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(result, cur);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+template <class ForwardIterator1, class Size, class ForwardIterator>
+inline ForwardIterator
+__uninitialized_copy_n(ForwardIterator1 first, Size count,
+ ForwardIterator result,
+ forward_iterator_tag) {
+ return __uninitialized_copy_n(first, count, result, input_iterator_tag());
+}
+
+template <class BidirectionalIterator, class Size, class ForwardIterator>
+inline ForwardIterator
+__uninitialized_copy_n(BidirectionalIterator first, Size count,
+ ForwardIterator result,
+ bidirectional_iterator_tag) {
+ return __uninitialized_copy_n(first, count, result, input_iterator_tag());
+}
+
+template <class RandomAccessIterator, class Size, class ForwardIterator>
+inline ForwardIterator
+__uninitialized_copy_n(RandomAccessIterator first, Size count,
+ ForwardIterator result,
+ random_access_iterator_tag) {
+ return uninitialized_copy(first, first + count, result);
+}
+
+template <class InputIterator, class Size, class ForwardIterator>
+inline ForwardIterator uninitialized_copy_n(InputIterator first, Size count,
+ ForwardIterator result) {
+ return __uninitialized_copy_n(first, count, result,
+ iterator_category(first));
+}
+
+// Valid if copy construction is equivalent to assignment, and if the
+// destructor is trivial.
+template <class ForwardIterator, class T>
+inline void
+__uninitialized_fill_aux(ForwardIterator first, ForwardIterator last,
+ const T& x, __true_type)
+{
+ fill(first, last, x);
+}
+
+template <class ForwardIterator, class T>
+void
+__uninitialized_fill_aux(ForwardIterator first, ForwardIterator last,
+ const T& x, __false_type)
+{
+ ForwardIterator cur = first;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for ( ; cur != last; ++cur)
+ construct(&*cur, x);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(first, cur);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+template <class ForwardIterator, class T, class T1>
+inline void __uninitialized_fill(ForwardIterator first, ForwardIterator last,
+ const T& x, T1*) {
+ __uninitialized_fill_aux(first, last, x,
+ __type_traits<T1>::is_POD_type());
+}
+
+template <class ForwardIterator, class T>
+inline void uninitialized_fill(ForwardIterator first, ForwardIterator last,
+ const T& x) {
+ __uninitialized_fill(first, last, x, value_type(first));
+}
+
+// Valid if copy construction is equivalent to assignment, and if the
+// destructor is trivial.
+template <class ForwardIterator, class Size, class T>
+inline ForwardIterator
+__uninitialized_fill_n_aux(ForwardIterator first, Size n,
+ const T& x, __true_type) {
+ return fill_n(first, n, x);
+}
+
+template <class ForwardIterator, class Size, class T>
+ForwardIterator
+__uninitialized_fill_n_aux(ForwardIterator first, Size n,
+ const T& x, __false_type) {
+ ForwardIterator cur = first;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for ( ; n > 0; --n, ++cur)
+ construct(&*cur, x);
+ return cur;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(first, cur);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+template <class ForwardIterator, class Size, class T, class T1>
+inline ForwardIterator __uninitialized_fill_n(ForwardIterator first, Size n,
+ const T& x, T1*) {
+ return __uninitialized_fill_n_aux(first, n, x,
+ __type_traits<T1>::is_POD_type());
+}
+
+template <class ForwardIterator, class Size, class T>
+inline ForwardIterator uninitialized_fill_n(ForwardIterator first, Size n,
+ const T& x) {
+ return __uninitialized_fill_n(first, n, x, value_type(first));
+}
+
+// Copies [first1, last1) into [result, result + (last1 - first1)), and
+// copies [first2, last2) into
+// [result, result + (last1 - first1) + (last2 - first2)).
+
+template <class InputIterator1, class InputIterator2, class ForwardIterator>
+inline ForwardIterator
+__uninitialized_copy_copy(InputIterator1 first1, InputIterator1 last1,
+ InputIterator2 first2, InputIterator2 last2,
+ ForwardIterator result) {
+ ForwardIterator mid = uninitialized_copy(first1, last1, result);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ return uninitialized_copy(first2, last2, mid);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(result, mid);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+// Fills [result, mid) with x, and copies [first, last) into
+// [mid, mid + (last - first)).
+template <class ForwardIterator, class T, class InputIterator>
+inline ForwardIterator
+__uninitialized_fill_copy(ForwardIterator result, ForwardIterator mid,
+ const T& x,
+ InputIterator first, InputIterator last) {
+ uninitialized_fill(result, mid, x);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ return uninitialized_copy(first, last, mid);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(result, mid);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+// Copies [first1, last1) into [first2, first2 + (last1 - first1)), and
+// fills [first2 + (last1 - first1), last2) with x.
+template <class InputIterator, class ForwardIterator, class T>
+inline void
+__uninitialized_copy_fill(InputIterator first1, InputIterator last1,
+ ForwardIterator first2, ForwardIterator last2,
+ const T& x) {
+ ForwardIterator mid2 = uninitialized_copy(first1, last1, first2);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ uninitialized_fill(mid2, last2, x);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(first2, mid2);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+#endif /* _SGI_STL_ALGOBASE_H */
diff --git a/libstdc++/stl/alloc.h b/libstdc++/stl/alloc.h
new file mode 100644
index 00000000000..917ce8fdb80
--- /dev/null
+++ b/libstdc++/stl/alloc.h
@@ -0,0 +1,674 @@
+/*
+ * Copyright (c) 1996-1997
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __ALLOC_H
+#define __ALLOC_H
+
+#include <stl_config.h>
+
+#ifdef __SUNPRO_CC
+# define __PRIVATE public
+ // Extra access restrictions prevent us from really making some things
+ // private.
+#else
+# define __PRIVATE private
+#endif
+
+#ifdef __STL_STATIC_TEMPLATE_MEMBER_BUG
+# define __USE_MALLOC
+#endif
+
+
+// This implements some standard node allocators. These are
+// NOT the same as the allocators in the C++ draft standard or in
+// in the original STL. They do not encapsulate different pointer
+// types; indeed we assume that there is only one pointer type.
+// The allocation primitives are intended to allocate individual objects,
+// not larger arenas as with the original STL allocators.
+
+#if 0
+# include <new>
+# define __THROW_BAD_ALLOC throw bad_alloc
+#elif !defined(__THROW_BAD_ALLOC)
+# include <iostream.h>
+# define __THROW_BAD_ALLOC cerr << "out of memory" << endl; exit(1)
+#endif
+
+#ifndef __ALLOC
+# define __ALLOC alloc
+#endif
+#ifdef __STL_WIN32THREADS
+# include <windows.h>
+// This must precede stl_config.h
+#endif
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#ifndef __RESTRICT
+# define __RESTRICT
+#endif
+
+#if !defined(_PTHREADS) && !defined(_NOTHREADS) \
+ && !defined(__STL_SGI_THREADS) && !defined(__STL_WIN32THREADS)
+# define _NOTHREADS
+#endif
+
+# ifdef _PTHREADS
+ // POSIX Threads
+ // This is dubious, since this is likely to be a high contention
+ // lock. Performance may not be adequate.
+# include <pthread.h>
+# define __NODE_ALLOCATOR_LOCK \
+ if (threads) pthread_mutex_lock(&__node_allocator_lock)
+# define __NODE_ALLOCATOR_UNLOCK \
+ if (threads) pthread_mutex_unlock(&__node_allocator_lock)
+# define __NODE_ALLOCATOR_THREADS true
+# define __VOLATILE volatile // Needed at -O3 on SGI
+# endif
+# ifdef __STL_WIN32THREADS
+ // The lock needs to be initialized by constructing an allocator
+ // objects of the right type. We do that here explicitly for alloc.
+# define __NODE_ALLOCATOR_LOCK \
+ EnterCriticalSection(&__node_allocator_lock)
+# define __NODE_ALLOCATOR_UNLOCK \
+ LeaveCriticalSection(&__node_allocator_lock)
+# define __NODE_ALLOCATOR_THREADS true
+# define __VOLATILE volatile // may not be needed
+# endif /* WIN32THREADS */
+# ifdef __STL_SGI_THREADS
+ // This should work without threads, with sproc threads, or with
+ // pthreads. It is suboptimal in all cases.
+ // It is unlikely to even compile on nonSGI machines.
+# include <malloc.h>
+# define __NODE_ALLOCATOR_LOCK if (threads && __us_rsthread_malloc) \
+ { __lock(&__node_allocator_lock); }
+# define __NODE_ALLOCATOR_UNLOCK if (threads && __us_rsthread_malloc) \
+ { __unlock(&__node_allocator_lock); }
+# define __NODE_ALLOCATOR_THREADS true
+# define __VOLATILE volatile // Needed at -O3 on SGI
+# endif
+# ifdef _NOTHREADS
+// Thread-unsafe
+# define __NODE_ALLOCATOR_LOCK
+# define __NODE_ALLOCATOR_UNLOCK
+# define __NODE_ALLOCATOR_THREADS false
+# define __VOLATILE
+# endif
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+#pragma set woff 1174
+#endif
+
+// Malloc-based allocator. Typically slower than default alloc below.
+// Typically thread-safe and more storage efficient.
+#ifdef __STL_STATIC_TEMPLATE_MEMBER_BUG
+# ifdef __DECLARE_GLOBALS_HERE
+ void (* __malloc_alloc_oom_handler)() = 0;
+ // g++ 2.7.2 does not handle static template data members.
+# else
+ extern void (* __malloc_alloc_oom_handler)();
+# endif
+#endif
+
+template <int inst>
+class __malloc_alloc_template {
+
+private:
+
+static void *oom_malloc(size_t);
+
+static void *oom_realloc(void *, size_t);
+
+#ifndef __STL_STATIC_TEMPLATE_MEMBER_BUG
+ static void (* __malloc_alloc_oom_handler)();
+#endif
+
+public:
+
+static void * allocate(size_t n)
+{
+ void *result = malloc(n);
+ if (0 == result) result = oom_malloc(n);
+ return result;
+}
+
+static void deallocate(void *p, size_t /* n */)
+{
+ free(p);
+}
+
+static void * reallocate(void *p, size_t /* old_sz */, size_t new_sz)
+{
+ void * result = realloc(p, new_sz);
+ if (0 == result) result = oom_realloc(p, new_sz);
+ return result;
+}
+
+static void (* set_malloc_handler(void (*f)()))()
+{
+ void (* old)() = __malloc_alloc_oom_handler;
+ __malloc_alloc_oom_handler = f;
+ return(old);
+}
+
+};
+
+// malloc_alloc out-of-memory handling
+
+#ifndef __STL_STATIC_TEMPLATE_MEMBER_BUG
+template <int inst>
+void (* __malloc_alloc_template<inst>::__malloc_alloc_oom_handler)() = 0;
+#endif
+
+template <int inst>
+void * __malloc_alloc_template<inst>::oom_malloc(size_t n)
+{
+ void (* my_malloc_handler)();
+ void *result;
+
+ for (;;) {
+ my_malloc_handler = __malloc_alloc_oom_handler;
+ if (0 == my_malloc_handler) { __THROW_BAD_ALLOC; }
+ (*my_malloc_handler)();
+ result = malloc(n);
+ if (result) return(result);
+ }
+}
+
+template <int inst>
+void * __malloc_alloc_template<inst>::oom_realloc(void *p, size_t n)
+{
+ void (* my_malloc_handler)();
+ void *result;
+
+ for (;;) {
+ my_malloc_handler = __malloc_alloc_oom_handler;
+ if (0 == my_malloc_handler) { __THROW_BAD_ALLOC; }
+ (*my_malloc_handler)();
+ result = realloc(p, n);
+ if (result) return(result);
+ }
+}
+
+typedef __malloc_alloc_template<0> malloc_alloc;
+
+template<class T, class Alloc>
+class simple_alloc {
+
+public:
+ static T *allocate(size_t n)
+ { return 0 == n? 0 : (T*) Alloc::allocate(n * sizeof (T)); }
+ static T *allocate(void)
+ { return (T*) Alloc::allocate(sizeof (T)); }
+ static void deallocate(T *p, size_t n)
+ { if (0 != n) Alloc::deallocate(p, n * sizeof (T)); }
+ static void deallocate(T *p)
+ { Alloc::deallocate(p, sizeof (T)); }
+};
+
+// Allocator adaptor to check size arguments for debugging.
+// Reports errors using assert. Checking can be disabled with
+// NDEBUG, but it's far better to just use the underlying allocator
+// instead when no checking is desired.
+// There is some evidence that this can confuse Purify.
+template <class Alloc>
+class debug_alloc {
+
+private:
+
+enum {extra = 8}; // Size of space used to store size. Note
+ // that this must be large enough to preserve
+ // alignment.
+
+public:
+
+static void * allocate(size_t n)
+{
+ char *result = (char *)Alloc::allocate(n + extra);
+ *(size_t *)result = n;
+ return result + extra;
+}
+
+static void deallocate(void *p, size_t n)
+{
+ char * real_p = (char *)p - extra;
+ assert(*(size_t *)real_p == n);
+ Alloc::deallocate(real_p, n + extra);
+}
+
+static void * reallocate(void *p, size_t old_sz, size_t new_sz)
+{
+ char * real_p = (char *)p - extra;
+ assert(*(size_t *)real_p == old_sz);
+ char * result = (char *)
+ Alloc::reallocate(real_p, old_sz + extra, new_sz + extra);
+ *(size_t *)result = new_sz;
+ return result + extra;
+}
+
+
+};
+
+
+# ifdef __USE_MALLOC
+
+typedef malloc_alloc alloc;
+typedef malloc_alloc single_client_alloc;
+
+# else
+
+
+// Default node allocator.
+// With a reasonable compiler, this should be roughly as fast as the
+// original STL class-specific allocators, but with less fragmentation.
+// Default_alloc_template parameters are experimental and MAY
+// DISAPPEAR in the future. Clients should just use alloc for now.
+//
+// Important implementation properties:
+// 1. If the client request an object of size > __MAX_BYTES, the resulting
+// object will be obtained directly from malloc.
+// 2. In all other cases, we allocate an object of size exactly
+// ROUND_UP(requested_size). Thus the client has enough size
+// information that we can return the object to the proper free list
+// without permanently losing part of the object.
+//
+
+// The first template parameter specifies whether more than one thread
+// may use this allocator. It is safe to allocate an object from
+// one instance of a default_alloc and deallocate it with another
+// one. This effectively transfers its ownership to the second one.
+// This may have undesirable effects on reference locality.
+// The second parameter is unreferenced and serves only to allow the
+// creation of multiple default_alloc instances.
+// Node that containers built on different allocator instances have
+// different types, limiting the utility of this approach.
+#ifdef __SUNPRO_CC
+// breaks if we make these template class members:
+ enum {__ALIGN = 8};
+ enum {__MAX_BYTES = 128};
+ enum {__NFREELISTS = __MAX_BYTES/__ALIGN};
+#endif
+
+template <bool threads, int inst>
+class __default_alloc_template {
+
+private:
+ // Really we should use static const int x = N
+ // instead of enum { x = N }, but few compilers accept the former.
+# ifndef __SUNPRO_CC
+ enum {__ALIGN = 8};
+ enum {__MAX_BYTES = 128};
+ enum {__NFREELISTS = __MAX_BYTES/__ALIGN};
+# endif
+ static size_t ROUND_UP(size_t bytes) {
+ return (((bytes) + __ALIGN-1) & ~(__ALIGN - 1));
+ }
+__PRIVATE:
+ union obj {
+ union obj * free_list_link;
+ char client_data[1]; /* The client sees this. */
+ };
+private:
+# ifdef __SUNPRO_CC
+ static obj * __VOLATILE free_list[];
+ // Specifying a size results in duplicate def for 4.1
+# else
+ static obj * __VOLATILE free_list[__NFREELISTS];
+# endif
+ static size_t FREELIST_INDEX(size_t bytes) {
+ return (((bytes) + __ALIGN-1)/__ALIGN - 1);
+ }
+
+ // Returns an object of size n, and optionally adds to size n free list.
+ static void *refill(size_t n);
+ // Allocates a chunk for nobjs of size size. nobjs may be reduced
+ // if it is inconvenient to allocate the requested number.
+ static char *chunk_alloc(size_t size, int &nobjs);
+
+ // Chunk allocation state.
+ static char *start_free;
+ static char *end_free;
+ static size_t heap_size;
+
+# ifdef __STL_SGI_THREADS
+ static volatile unsigned long __node_allocator_lock;
+ static void __lock(volatile unsigned long *);
+ static inline void __unlock(volatile unsigned long *);
+# endif
+
+# ifdef _PTHREADS
+ static pthread_mutex_t __node_allocator_lock;
+# endif
+
+# ifdef __STL_WIN32THREADS
+ static CRITICAL_SECTION __node_allocator_lock;
+ static bool __node_allocator_lock_initialized;
+
+ public:
+ __default_alloc_template() {
+ // This assumes the first constructor is called before threads
+ // are started.
+ if (!__node_allocator_lock_initialized) {
+ InitializeCriticalSection(&__node_allocator_lock);
+ __node_allocator_lock_initialized = true;
+ }
+ }
+ private:
+# endif
+
+ class lock {
+ public:
+ lock() { __NODE_ALLOCATOR_LOCK; }
+ ~lock() { __NODE_ALLOCATOR_UNLOCK; }
+ };
+ friend class lock;
+
+public:
+
+ /* n must be > 0 */
+ static void * allocate(size_t n)
+ {
+ obj * __VOLATILE * my_free_list;
+ obj * __RESTRICT result;
+
+ if (n > __MAX_BYTES) {
+ return(malloc_alloc::allocate(n));
+ }
+ my_free_list = free_list + FREELIST_INDEX(n);
+ // Acquire the lock here with a constructor call.
+ // This ensures that it is released in exit or during stack
+ // unwinding.
+ /*REFERENCED*/
+ lock lock_instance;
+ result = *my_free_list;
+ if (result == 0) {
+ void *r = refill(ROUND_UP(n));
+ return r;
+ }
+ *my_free_list = result -> free_list_link;
+ return (result);
+ };
+
+ /* p may not be 0 */
+ static void deallocate(void *p, size_t n)
+ {
+ obj *q = (obj *)p;
+ obj * __VOLATILE * my_free_list;
+
+ if (n > __MAX_BYTES) {
+ malloc_alloc::deallocate(p, n);
+ return;
+ }
+ my_free_list = free_list + FREELIST_INDEX(n);
+ // acquire lock
+ /*REFERENCED*/
+ lock lock_instance;
+ q -> free_list_link = *my_free_list;
+ *my_free_list = q;
+ // lock is released here
+ }
+
+ static void * reallocate(void *p, size_t old_sz, size_t new_sz);
+
+} ;
+
+typedef __default_alloc_template<__NODE_ALLOCATOR_THREADS, 0> alloc;
+typedef __default_alloc_template<false, 0> single_client_alloc;
+
+
+
+/* We allocate memory in large chunks in order to avoid fragmenting */
+/* the malloc heap too much. */
+/* We assume that size is properly aligned. */
+/* We hold the allocation lock. */
+template <bool threads, int inst>
+char*
+__default_alloc_template<threads, inst>::chunk_alloc(size_t size, int& nobjs)
+{
+ char * result;
+ size_t total_bytes = size * nobjs;
+ size_t bytes_left = end_free - start_free;
+
+ if (bytes_left >= total_bytes) {
+ result = start_free;
+ start_free += total_bytes;
+ return(result);
+ } else if (bytes_left >= size) {
+ nobjs = bytes_left/size;
+ total_bytes = size * nobjs;
+ result = start_free;
+ start_free += total_bytes;
+ return(result);
+ } else {
+ size_t bytes_to_get = 2 * total_bytes + ROUND_UP(heap_size >> 4);
+ // Try to make use of the left-over piece.
+ if (bytes_left > 0) {
+ obj * __VOLATILE * my_free_list =
+ free_list + FREELIST_INDEX(bytes_left);
+
+ ((obj *)start_free) -> free_list_link = *my_free_list;
+ *my_free_list = (obj *)start_free;
+ }
+ start_free = (char *)malloc(bytes_to_get);
+ if (0 == start_free) {
+ int i;
+ obj * __VOLATILE * my_free_list, *p;
+ // Try to make do with what we have. That can't
+ // hurt. We do not try smaller requests, since that tends
+ // to result in disaster on multi-process machines.
+ for (i = size; i <= __MAX_BYTES; i += __ALIGN) {
+ my_free_list = free_list + FREELIST_INDEX(i);
+ p = *my_free_list;
+ if (0 != p) {
+ *my_free_list = p -> free_list_link;
+ start_free = (char *)p;
+ end_free = start_free + i;
+ return(chunk_alloc(size, nobjs));
+ // Any leftover piece will eventually make it to the
+ // right free list.
+ }
+ }
+ start_free = (char *)malloc_alloc::allocate(bytes_to_get);
+ // This should either throw an
+ // exception or remedy the situation. Thus we assume it
+ // succeeded.
+ }
+ heap_size += bytes_to_get;
+ end_free = start_free + bytes_to_get;
+ return(chunk_alloc(size, nobjs));
+ }
+}
+
+
+/* Returns an object of size n, and optionally adds to size n free list.*/
+/* We assume that n is properly aligned. */
+/* We hold the allocation lock. */
+template <bool threads, int inst>
+void* __default_alloc_template<threads, inst>::refill(size_t n)
+{
+ int nobjs = 20;
+ char * chunk = chunk_alloc(n, nobjs);
+ obj * __VOLATILE * my_free_list;
+ obj * result;
+ obj * current_obj, * next_obj;
+ int i;
+
+ if (1 == nobjs) return(chunk);
+ my_free_list = free_list + FREELIST_INDEX(n);
+
+ /* Build free list in chunk */
+ result = (obj *)chunk;
+ *my_free_list = next_obj = (obj *)(chunk + n);
+ for (i = 1; ; i++) {
+ current_obj = next_obj;
+ next_obj = (obj *)((char *)next_obj + n);
+ if (nobjs - 1 == i) {
+ current_obj -> free_list_link = 0;
+ break;
+ } else {
+ current_obj -> free_list_link = next_obj;
+ }
+ }
+ return(result);
+}
+
+template <bool threads, int inst>
+void*
+__default_alloc_template<threads, inst>::reallocate(void *p,
+ size_t old_sz,
+ size_t new_sz)
+{
+ void * result;
+ size_t copy_sz;
+
+ if (old_sz > __MAX_BYTES && new_sz > __MAX_BYTES) {
+ return(realloc(p, new_sz));
+ }
+ if (ROUND_UP(old_sz) == ROUND_UP(new_sz)) return(p);
+ result = allocate(new_sz);
+ copy_sz = new_sz > old_sz? old_sz : new_sz;
+ memcpy(result, p, copy_sz);
+ deallocate(p, old_sz);
+ return(result);
+}
+
+#ifdef _PTHREADS
+ template <bool threads, int inst>
+ pthread_mutex_t
+ __default_alloc_template<threads, inst>::__node_allocator_lock
+ = PTHREAD_MUTEX_INITIALIZER;
+#endif
+
+#ifdef __STL_WIN32THREADS
+ template <bool threads, int inst> CRITICAL_SECTION
+ __default_alloc_template<threads, inst>::__node_allocator_lock;
+
+ template <bool threads, int inst> bool
+ __default_alloc_template<threads, inst>::__node_allocator_lock_initialized
+ = false;
+#endif
+
+#ifdef __STL_SGI_THREADS
+#include <mutex.h>
+#include <time.h>
+// Somewhat generic lock implementations. We need only test-and-set
+// and some way to sleep. These should work with both SGI pthreads
+// and sproc threads. They may be useful on other systems.
+template <bool threads, int inst>
+volatile unsigned long
+__default_alloc_template<threads, inst>::__node_allocator_lock = 0;
+
+#if __mips < 3 || !(defined (_ABIN32) || defined(_ABI64)) || defined(__GNUC__)
+# define __test_and_set(l,v) test_and_set(l,v)
+#endif
+
+template <bool threads, int inst>
+void
+__default_alloc_template<threads, inst>::__lock(volatile unsigned long *lock)
+{
+ const unsigned low_spin_max = 30; // spin cycles if we suspect uniprocessor
+ const unsigned high_spin_max = 1000; // spin cycles for multiprocessor
+ static unsigned spin_max = low_spin_max;
+ unsigned my_spin_max;
+ static unsigned last_spins = 0;
+ unsigned my_last_spins;
+ static struct timespec ts = {0, 1000};
+ unsigned junk;
+# define __ALLOC_PAUSE junk *= junk; junk *= junk; junk *= junk; junk *= junk
+ int i;
+
+ if (!__test_and_set((unsigned long *)lock, 1)) {
+ return;
+ }
+ my_spin_max = spin_max;
+ my_last_spins = last_spins;
+ for (i = 0; i < my_spin_max; i++) {
+ if (i < my_last_spins/2 || *lock) {
+ __ALLOC_PAUSE;
+ continue;
+ }
+ if (!__test_and_set((unsigned long *)lock, 1)) {
+ // got it!
+ // Spinning worked. Thus we're probably not being scheduled
+ // against the other process with which we were contending.
+ // Thus it makes sense to spin longer the next time.
+ last_spins = i;
+ spin_max = high_spin_max;
+ return;
+ }
+ }
+ // We are probably being scheduled against the other process. Sleep.
+ spin_max = low_spin_max;
+ for (;;) {
+ if (!__test_and_set((unsigned long *)lock, 1)) {
+ return;
+ }
+ nanosleep(&ts, 0);
+ }
+}
+
+template <bool threads, int inst>
+inline void
+__default_alloc_template<threads, inst>::__unlock(volatile unsigned long *lock)
+{
+# if defined(__GNUC__) && __mips >= 3
+ asm("sync");
+ *lock = 0;
+# elif __mips >= 3 && (defined (_ABIN32) || defined(_ABI64))
+ __lock_release(lock);
+# else
+ *lock = 0;
+ // This is not sufficient on many multiprocessors, since
+ // writes to protected variables and the lock may be reordered.
+# endif
+}
+#endif
+
+template <bool threads, int inst>
+char *__default_alloc_template<threads, inst>::start_free = 0;
+
+template <bool threads, int inst>
+char *__default_alloc_template<threads, inst>::end_free = 0;
+
+template <bool threads, int inst>
+size_t __default_alloc_template<threads, inst>::heap_size = 0;
+
+template <bool threads, int inst>
+__default_alloc_template<threads, inst>::obj * __VOLATILE
+__default_alloc_template<threads, inst> ::free_list[
+# ifdef __SUNPRO_CC
+ __NFREELISTS
+# else
+ __default_alloc_template<threads, inst>::__NFREELISTS
+# endif
+] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, };
+// The 16 zeros are necessary to make version 4.1 of the SunPro
+// compiler happy. Otherwise it appears to allocate too little
+// space for the array.
+
+# ifdef __STL_WIN32THREADS
+ // Create one to get critical section initialized.
+ // We do this onece per file, but only the first constructor
+ // does anything.
+ static alloc __node_allocator_dummy_instance;
+# endif
+
+#endif /* ! __USE_MALLOC */
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+#pragma reset woff 1174
+#endif
+
+#endif /* __NODE_ALLOC_H */
diff --git a/libstdc++/stl/bvector.h b/libstdc++/stl/bvector.h
new file mode 100644
index 00000000000..27878799aea
--- /dev/null
+++ b/libstdc++/stl/bvector.h
@@ -0,0 +1,585 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+// vector<bool> is replaced by bit_vector at present because partial
+// specialization is not yet implemented.
+
+#ifndef __SGI_STL_BVECTOR_H
+#define __SGI_STL_BVECTOR_H
+
+#include <stddef.h>
+#include <algobase.h>
+#include <alloc.h>
+
+
+#define __WORD_BIT (int(CHAR_BIT*sizeof(unsigned int)))
+
+class bit_vector {
+public:
+ typedef bool value_type;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+
+ class iterator;
+ class const_iterator;
+
+ class reference {
+ friend class iterator;
+ friend class const_iterator;
+ protected:
+ unsigned int* p;
+ unsigned int mask;
+ reference(unsigned int* x, unsigned int y) : p(x), mask(y) {}
+ public:
+ reference() : p(0), mask(0) {}
+ operator bool() const { return !(!(*p & mask)); }
+ reference& operator=(bool x) {
+ if (x)
+ *p |= mask;
+ else
+ *p &= ~mask;
+ return *this;
+ }
+ reference& operator=(const reference& x) { return *this = bool(x); }
+ bool operator==(const reference& x) const {
+ return bool(*this) == bool(x);
+ }
+ bool operator<(const reference& x) const {
+ return bool(*this) < bool(x);
+ }
+ void flip() { *p ^= mask; }
+ };
+
+ typedef bool const_reference;
+
+ typedef reference bit_reference;
+ typedef const_reference bit_const_reference;
+
+ class iterator : public random_access_iterator<bool, difference_type> {
+ friend class bit_vector;
+ friend class const_iterator;
+ public:
+ typedef bit_reference reference;
+ protected:
+ unsigned int* p;
+ unsigned int offset;
+ void bump_up() {
+ if (offset++ == __WORD_BIT - 1) {
+ offset = 0;
+ ++p;
+ }
+ }
+ void bump_down() {
+ if (offset-- == 0) {
+ offset = __WORD_BIT - 1;
+ --p;
+ }
+ }
+ public:
+ iterator() : p(0), offset(0) {}
+ iterator(unsigned int* x, unsigned int y) : p(x), offset(y) {}
+ reference operator*() const { return reference(p, 1U << offset); }
+ iterator& operator++() {
+ bump_up();
+ return *this;
+ }
+ iterator operator++(int) {
+ iterator tmp = *this;
+ bump_up();
+ return tmp;
+ }
+ iterator& operator--() {
+ bump_down();
+ return *this;
+ }
+ iterator operator--(int) {
+ iterator tmp = *this;
+ bump_down();
+ return tmp;
+ }
+ iterator& operator+=(difference_type i) {
+ difference_type n = i + offset;
+ p += n / __WORD_BIT;
+ n = n % __WORD_BIT;
+ if (n < 0) {
+ offset = n + __WORD_BIT;
+ --p;
+ } else
+ offset = n;
+ return *this;
+ }
+ iterator& operator-=(difference_type i) {
+ *this += -i;
+ return *this;
+ }
+ iterator operator+(difference_type i) const {
+ iterator tmp = *this;
+ return tmp += i;
+ }
+ iterator operator-(difference_type i) const {
+ iterator tmp = *this;
+ return tmp -= i;
+ }
+ difference_type operator-(iterator x) const {
+ return __WORD_BIT * (p - x.p) + offset - x.offset;
+ }
+ reference operator[](difference_type i) { return *(*this + i); }
+ bool operator==(const iterator& x) const {
+ return p == x.p && offset == x.offset;
+ }
+ bool operator!=(const iterator& x) const {
+ return p != x.p || offset != x.offset;
+ }
+ bool operator<(iterator x) const {
+ return p < x.p || (p == x.p && offset < x.offset);
+ }
+ };
+
+ class const_iterator : public random_access_iterator<bool, difference_type>
+ {
+ friend class bit_vector;
+ public:
+ typedef bit_const_reference reference;
+ protected:
+ unsigned int* p;
+ unsigned int offset;
+ void bump_up() {
+ if (offset++ == __WORD_BIT - 1) {
+ offset = 0;
+ ++p;
+ }
+ }
+ void bump_down() {
+ if (offset-- == 0) {
+ offset = __WORD_BIT - 1;
+ --p;
+ }
+ }
+ public:
+ const_iterator() : p(0), offset(0) {}
+ const_iterator(unsigned int* x, unsigned int y) : p(x), offset(y) {}
+ const_iterator(const iterator& x) : p(x.p), offset(x.offset) {}
+ const_reference operator*() const {
+ return bit_vector::reference(p, 1U << offset);
+ }
+ const_iterator& operator++() {
+ bump_up();
+ return *this;
+ }
+ const_iterator operator++(int) {
+ const_iterator tmp = *this;
+ bump_up();
+ return tmp;
+ }
+ const_iterator& operator--() {
+ bump_down();
+ return *this;
+ }
+ const_iterator operator--(int) {
+ const_iterator tmp = *this;
+ bump_down();
+ return tmp;
+ }
+ const_iterator& operator+=(difference_type i) {
+ difference_type n = i + offset;
+ p += n / __WORD_BIT;
+ n = n % __WORD_BIT;
+ if (n < 0) {
+ offset = n + __WORD_BIT;
+ --p;
+ } else
+ offset = n;
+ return *this;
+ }
+ const_iterator& operator-=(difference_type i) {
+ *this += -i;
+ return *this;
+ }
+ const_iterator operator+(difference_type i) const {
+ const_iterator tmp = *this;
+ return tmp += i;
+ }
+ const_iterator operator-(difference_type i) const {
+ const_iterator tmp = *this;
+ return tmp -= i;
+ }
+ difference_type operator-(const_iterator x) const {
+ return __WORD_BIT * (p - x.p) + offset - x.offset;
+ }
+ const_reference operator[](difference_type i) {
+ return *(*this + i);
+ }
+ bool operator==(const const_iterator& x) const {
+ return p == x.p && offset == x.offset;
+ }
+ bool operator!=(const const_iterator& x) const {
+ return p != x.p || offset != x.offset;
+ }
+ bool operator<(const_iterator x) const {
+ return p < x.p || (p == x.p && offset < x.offset);
+ }
+ };
+
+ typedef reverse_iterator<const_iterator, value_type, const_reference,
+ difference_type> const_reverse_iterator;
+ typedef reverse_iterator<iterator, value_type, reference, difference_type>
+ reverse_iterator;
+
+protected:
+ typedef simple_alloc<unsigned int, alloc> data_allocator;
+ iterator start;
+ iterator finish;
+ unsigned int* end_of_storage;
+ unsigned int* bit_alloc(size_type n) {
+ return data_allocator::allocate((n + __WORD_BIT - 1)/__WORD_BIT);
+ }
+ void deallocate() {
+ if (start.p)
+ data_allocator::deallocate(start.p, end_of_storage - start.p);
+ }
+ void initialize(size_type n) {
+ unsigned int* q = bit_alloc(n);
+ end_of_storage = q + (n + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ finish = start + n;
+ }
+ void insert_aux(iterator position, bool x) {
+ if (finish.p != end_of_storage) {
+ copy_backward(position, finish, finish + 1);
+ *position = x;
+ ++finish;
+ } else {
+ size_type len = size() ? 2 * size() : __WORD_BIT;
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ *i++ = x;
+ finish = copy(position, end(), i);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void initialize_range(InputIterator first, InputIterator last,
+ input_iterator_tag) {
+ start = iterator();
+ finish = iterator();
+ end_of_storage = 0;
+ for ( ; first != last; ++first)
+ push_back(*first);
+ }
+
+ template <class ForwardIterator>
+ void initialize_range(ForwardIterator first, ForwardIterator last,
+ forward_iterator_tag) {
+ size_type n = 0;
+ distance(first, last, n);
+ initialize(n);
+ copy(first, last, start);
+ }
+
+ template <class BidirectionalIterator>
+ void initialize_range(BidirectionalIterator first,
+ BidirectionalIterator last,
+ bidirectional_iterator_tag) {
+ initialize_range(first, last, forward_iterator_tag());
+ }
+
+ template <class RandomAccessIterator>
+ void initialize_range(RandomAccessIterator first,
+ RandomAccessIterator last,
+ random_access_iterator_tag) {
+ initialize_range(first, last, forward_iterator_tag());
+ }
+
+ template <class InputIterator>
+ void insert_range(iterator pos,
+ InputIterator first, InputIterator last,
+ input_iterator_tag) {
+ for ( ; first != last; ++first) {
+ pos = insert(pos, *first);
+ ++pos;
+ }
+ }
+
+ template <class ForwardIterator>
+ void insert_range(iterator position,
+ ForwardIterator first, ForwardIterator last,
+ forward_iterator_tag) {
+ if (first != last) {
+ size_type n = 0;
+ distance(first, last, n);
+ if (capacity() - size() >= n) {
+ copy_backward(position, end(), finish + n);
+ copy(first, last, position);
+ finish += n;
+ }
+ else {
+ size_type len = size() + max(size(), n);
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ i = copy(first, last, i);
+ finish = copy(position, end(), i);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+ }
+
+ template <class BidirectionalIterator>
+ void insert_range(iterator pos,
+ BidirectionalIterator first, BidirectionalIterator last,
+ bidirectional_iterator_tag) {
+ insert_range(pos, first, last, forward_iterator_tag());
+ }
+
+ template <class RandomAccessIterator>
+ void insert_range(iterator pos,
+ RandomAccessIterator first, RandomAccessIterator last,
+ random_access_iterator_tag) {
+ insert_range(pos, first, last, forward_iterator_tag());
+ }
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ typedef bit_vector self;
+public:
+ iterator begin() { return start; }
+ const_iterator begin() const { return start; }
+ iterator end() { return finish; }
+ const_iterator end() const { return finish; }
+
+ reverse_iterator rbegin() { return reverse_iterator(end()); }
+ const_reverse_iterator rbegin() const {
+ return const_reverse_iterator(end());
+ }
+ reverse_iterator rend() { return reverse_iterator(begin()); }
+ const_reverse_iterator rend() const {
+ return const_reverse_iterator(begin());
+ }
+
+ size_type size() const { return size_type(end() - begin()); }
+ size_type max_size() const { return size_type(-1); }
+ size_type capacity() const {
+ return size_type(const_iterator(end_of_storage, 0) - begin());
+ }
+ bool empty() const { return begin() == end(); }
+ reference operator[](size_type n) { return *(begin() + n); }
+ const_reference operator[](size_type n) const { return *(begin() + n); }
+ bit_vector() : start(iterator()), finish(iterator()), end_of_storage(0) {}
+ bit_vector(size_type n, bool value) {
+ initialize(n);
+ fill(start.p, end_of_storage, value ? ~0 : 0);
+ }
+ bit_vector(int n, bool value) {
+ initialize(n);
+ fill(start.p, end_of_storage, value ? ~0 : 0);
+ }
+ bit_vector(long n, bool value) {
+ initialize(n);
+ fill(start.p, end_of_storage, value ? ~0 : 0);
+ }
+ explicit bit_vector(size_type n) {
+ initialize(n);
+ fill(start.p, end_of_storage, 0);
+ }
+ bit_vector(const self& x) {
+ initialize(x.size());
+ copy(x.begin(), x.end(), start);
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ bit_vector(InputIterator first, InputIterator last) {
+ initialize_range(first, last, iterator_category(first));
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ bit_vector(const_iterator first, const_iterator last) {
+ size_type n = 0;
+ distance(first, last, n);
+ initialize(n);
+ copy(first, last, start);
+ }
+ bit_vector(const bool* first, const bool* last) {
+ size_type n = 0;
+ distance(first, last, n);
+ initialize(n);
+ copy(first, last, start);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ ~bit_vector() { deallocate(); }
+ self& operator=(const self& x) {
+ if (&x == this) return *this;
+ if (x.size() > capacity()) {
+ deallocate();
+ initialize(x.size());
+ }
+ copy(x.begin(), x.end(), begin());
+ finish = begin() + x.size();
+ return *this;
+ }
+ void reserve(size_type n) {
+ if (capacity() < n) {
+ unsigned int* q = bit_alloc(n);
+ finish = copy(begin(), end(), iterator(q, 0));
+ deallocate();
+ start = iterator(q, 0);
+ end_of_storage = q + (n + __WORD_BIT - 1)/__WORD_BIT;
+ }
+ }
+ reference front() { return *begin(); }
+ const_reference front() const { return *begin(); }
+ reference back() { return *(end() - 1); }
+ const_reference back() const { return *(end() - 1); }
+ void push_back(bool x) {
+ if (finish.p != end_of_storage)
+ *finish++ = x;
+ else
+ insert_aux(end(), x);
+ }
+ void swap(bit_vector& x) {
+ ::swap(start, x.start);
+ ::swap(finish, x.finish);
+ ::swap(end_of_storage, x.end_of_storage);
+ }
+ iterator insert(iterator position, bool x = bool()) {
+ size_type n = position - begin();
+ if (finish.p != end_of_storage && position == end())
+ *finish++ = x;
+ else
+ insert_aux(position, x);
+ return begin() + n;
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator> void insert(iterator position,
+ InputIterator first,
+ InputIterator last) {
+ insert_range(position, first, last, iterator_category(first));
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ void insert(iterator position, const_iterator first,
+ const_iterator last) {
+ if (first == last) return;
+ size_type n = 0;
+ distance(first, last, n);
+ if (capacity() - size() >= n) {
+ copy_backward(position, end(), finish + n);
+ copy(first, last, position);
+ finish += n;
+ } else {
+ size_type len = size() + max(size(), n);
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ i = copy(first, last, i);
+ finish = copy(position, end(), i);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+
+ void insert(iterator position, const bool* first, const bool* last) {
+ if (first == last) return;
+ size_type n = 0;
+ distance(first, last, n);
+ if (capacity() - size() >= n) {
+ copy_backward(position, end(), finish + n);
+ copy(first, last, position);
+ finish += n;
+ } else {
+ size_type len = size() + max(size(), n);
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ i = copy(first, last, i);
+ finish = copy(position, end(), i);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ void insert(iterator position, size_type n, bool x) {
+ if (n == 0) return;
+ if (capacity() - size() >= n) {
+ copy_backward(position, end(), finish + n);
+ fill(position, position + n, x);
+ finish += n;
+ } else {
+ size_type len = size() + max(size(), n);
+ unsigned int* q = bit_alloc(len);
+ iterator i = copy(begin(), position, iterator(q, 0));
+ fill_n(i, n, x);
+ finish = copy(position, end(), i + n);
+ deallocate();
+ end_of_storage = q + (len + __WORD_BIT - 1)/__WORD_BIT;
+ start = iterator(q, 0);
+ }
+ }
+
+ void insert(iterator pos, int n, bool x) { insert(pos, (size_type)n, x); }
+ void insert(iterator pos, long n, bool x) { insert(pos, (size_type)n, x); }
+
+ void pop_back() { --finish; }
+ void erase(iterator position) {
+ if (position + 1 != end())
+ copy(position + 1, end(), position);
+ --finish;
+ }
+ void erase(iterator first, iterator last) {
+ finish = copy(last, end(), first);
+ }
+ void resize(size_type new_size, bool x = bool()) {
+ if (new_size < size())
+ erase(begin() + new_size, end());
+ else
+ insert(end(), new_size - size(), x);
+ }
+ void clear() { erase(begin(), end()); }
+};
+
+inline bool operator==(const bit_vector& x, const bit_vector& y) {
+ return x.size() == y.size() && equal(x.begin(), x.end(), y.begin());
+}
+
+inline bool operator<(const bit_vector& x, const bit_vector& y) {
+ return lexicographical_compare(x.begin(), x.end(), y.begin(), y.end());
+}
+
+inline void swap(bit_vector::reference x, bit_vector::reference y) {
+ bool tmp = x;
+ x = y;
+ y = tmp;
+}
+
+#undef __WORD_BIT
+
+#endif /* __SGI_STL_BVECTOR_H */
diff --git a/libstdc++/stl/defalloc.h b/libstdc++/stl/defalloc.h
new file mode 100644
index 00000000000..e7d24d38c84
--- /dev/null
+++ b/libstdc++/stl/defalloc.h
@@ -0,0 +1,87 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+//
+// Inclusion of this file is DEPRECATED.
+// This is the original HP default allocator.
+// DO NOT USE THIS FILE unless you have an old container implementation
+// that requires an allocator with the HP-style interface.
+// SGI STL uses a different allocator interface.
+// SGI-style allocators are not parametrized with respect to
+// the object type; they traffic in void * pointers.
+// This file is not included by any other SGI STL header.
+//
+
+#ifndef DEFALLOC_H
+#define DEFALLOC_H
+
+#include <new.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <iostream.h>
+#include <algobase.h>
+
+
+template <class T>
+inline T* allocate(ptrdiff_t size, T*) {
+ set_new_handler(0);
+ T* tmp = (T*)(::operator new((size_t)(size * sizeof(T))));
+ if (tmp == 0) {
+ cerr << "out of memory" << endl;
+ exit(1);
+ }
+ return tmp;
+}
+
+
+template <class T>
+inline void deallocate(T* buffer) {
+ ::operator delete(buffer);
+}
+
+template <class T>
+class allocator {
+public:
+ typedef T value_type;
+ typedef T* pointer;
+ typedef const T* const_pointer;
+ typedef T& reference;
+ typedef const T& const_reference;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ pointer allocate(size_type n) {
+ return ::allocate((difference_type)n, (pointer)0);
+ }
+ void deallocate(pointer p) { ::deallocate(p); }
+ pointer address(reference x) { return (pointer)&x; }
+ const_pointer const_address(const_reference x) {
+ return (const_pointer)&x;
+ }
+ size_type init_page_size() {
+ return max(size_type(1), size_type(4096/sizeof(T)));
+ }
+ size_type max_size() const {
+ return max(size_type(1), size_type(UINT_MAX/sizeof(T)));
+ }
+};
+
+class allocator<void> {
+public:
+ typedef void* pointer;
+};
+
+
+
+#endif
diff --git a/libstdc++/stl/deque.h b/libstdc++/stl/deque.h
new file mode 100644
index 00000000000..6685abffe7c
--- /dev/null
+++ b/libstdc++/stl/deque.h
@@ -0,0 +1,1452 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1997
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_DEQUE_H
+#define __SGI_STL_DEQUE_H
+
+/* Class invariants:
+ * For any nonsingular iterator i:
+ * i.node is the address of an element in the map array. The
+ * contents of i.node is a pointer to the beginning of a node.
+ * i.first == *(i.node)
+ * i.last == i.first + node_size
+ * i.cur is a pointer in the range [i.first, i.last). NOTE:
+ * the implication of this is that i.cur is always a dereferenceable
+ * pointer, even if i is a past-the-end iterator.
+ * Start and Finish are always nonsingular iterators. NOTE: this means
+ * that an empty deque must have one node, and that a deque
+ * with N elements, where N is the buffer size, must have two nodes.
+ * For every node other than start.node and finish.node, every element
+ * in the node is an initialized object. If start.node == finish.node,
+ * then [start.cur, finish.cur) are initialized objects, and
+ * the elements outside that range are uninitialized storage. Otherwise,
+ * [start.cur, start.last) and [finish.first, finish.cur) are initialized
+ * objects, and [start.first, start.cur) and [finish.cur, finish.last)
+ * are uninitialized storage.
+ * [map, map + map_size) is a valid, non-empty range.
+ * [start.node, finish.node] is a valid range contained within
+ * [map, map + map_size).
+ * A pointer in the range [map, map + map_size) points to an allocated
+ * node if and only if the pointer is in the range [start.node, finish.node].
+ */
+
+
+/*
+ * In previous versions of deque, node_size was fixed by the
+ * implementation. In this version, however, users can select
+ * the node size. Deque has three template parameters; the third,
+ * a number of type size_t, is the number of elements per node.
+ * If the third template parameter is 0 (which is the default),
+ * then deque will use a default node size.
+ *
+ * The only reason for using an alternate node size is if your application
+ * requires a different performance tradeoff than the default. If,
+ * for example, your program contains many deques each of which contains
+ * only a few elements, then you might want to save memory (possibly
+ * by sacrificing some speed) by using smaller nodes.
+ *
+ * Unfortunately, some compilers have trouble with non-type template
+ * parameters; stl_config.h defines __STL_NON_TYPE_TMPL_PARAM_BUG if
+ * that is the case. If your compiler is one of them, then you will
+ * not be able to use alternate node sizes; you will have to use the
+ * default value.
+ */
+
+#include <stddef.h>
+#include <algobase.h>
+#include <alloc.h>
+
+// Note: this function is simply a kludge to work around several compilers'
+// bugs in handling constant expressions.
+inline size_t __deque_buf_size(size_t n, size_t sz)
+{
+ return n != 0 ? n : (sz < 512 ? size_t(512 / sz) : size_t(1));
+}
+
+#ifndef __STL_NON_TYPE_TMPL_PARAM_BUG
+template <class T, class Ref, size_t BufSiz>
+struct __deque_iterator {
+ typedef __deque_iterator<T, T&, BufSiz> iterator;
+ typedef __deque_iterator<T, const T&, BufSiz> const_iterator;
+ static size_t buffer_size() {return __deque_buf_size(BufSiz, sizeof(T)); }
+#else /* __STL_NON_TYPE_TMPL_PARAM_BUG */
+template <class T, class Ref>
+struct __deque_iterator {
+ typedef __deque_iterator<T, T&> iterator;
+ typedef __deque_iterator<T, const T&> const_iterator;
+ static size_t buffer_size() {return __deque_buf_size(0, sizeof(T)); }
+#endif
+
+ typedef random_access_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef pointer* map_pointer;
+
+ typedef __deque_iterator self;
+
+ pointer cur;
+ pointer first;
+ pointer last;
+ map_pointer node;
+
+ __deque_iterator(pointer x, map_pointer y)
+ : cur(x), first(*y), last(*y + buffer_size()), node(y) {}
+ __deque_iterator() : cur(0), first(0), last(0), node(0) {}
+ __deque_iterator(const iterator& x)
+ : cur(x.cur), first(x.first), last(x.last), node(x.node) {}
+
+ Ref operator*() const { return *cur; }
+
+ difference_type operator-(const self& x) const {
+ return buffer_size() * (node - x.node - 1) +
+ (cur - first) + (x.last - x.cur);
+ }
+
+ self& operator++() {
+ ++cur;
+ if (cur == last) {
+ set_node(node + 1);
+ cur = first;
+ }
+ return *this;
+ }
+ self operator++(int) {
+ self tmp = *this;
+ ++*this;
+ return tmp;
+ }
+
+ self& operator--() {
+ if (cur == first) {
+ set_node(node - 1);
+ cur = last;
+ }
+ --cur;
+ return *this;
+ }
+ self operator--(int) {
+ self tmp = *this;
+ --*this;
+ return tmp;
+ }
+
+ self& operator+=(difference_type n) {
+ difference_type offset = n + (cur - first);
+ if (offset >= 0 && offset < buffer_size())
+ cur += n;
+ else {
+ difference_type node_offset =
+ offset > 0 ? offset / buffer_size()
+ : -difference_type((-offset - 1) / buffer_size()) - 1;
+ set_node(node + node_offset);
+ cur = first + (offset - node_offset * buffer_size());
+ }
+ return *this;
+ }
+
+ self operator+(difference_type n) const {
+ self tmp = *this;
+ return tmp += n;
+ }
+
+ self& operator-=(difference_type n) { return *this += -n; }
+
+ self operator-(difference_type n) const {
+ self tmp = *this;
+ return tmp -= n;
+ }
+
+ Ref operator[](difference_type n) const { return *(*this + n); }
+
+ bool operator==(const self& x) const { return cur == x.cur; }
+ bool operator!=(const self& x) const { return !(*this == x); }
+ bool operator<(const self& x) const {
+ return (node == x.node) ? (cur < x.cur) : (node < x.node);
+ }
+
+ void set_node(map_pointer new_node) {
+ node = new_node;
+ first = *new_node;
+ last = first + buffer_size();
+ }
+};
+
+#ifndef __STL_NON_TYPE_TMPL_PARAM_BUG
+
+template <class T, class Ref, size_t BufSiz>
+inline random_access_iterator_tag
+iterator_category(const __deque_iterator<T, Ref, BufSiz>&) {
+ return random_access_iterator_tag();
+}
+
+template <class T, class Ref, size_t BufSiz>
+inline T* value_type(const __deque_iterator<T, Ref, BufSiz>&) { return 0; }
+
+template <class T, class Ref, size_t BufSiz>
+inline ptrdiff_t* distance_type(const __deque_iterator<T, Ref, BufSiz>&) {
+ return 0;
+}
+
+#else /* __STL_NON_TYPE_TMPL_PARAM_BUG */
+
+template <class T, class Ref>
+inline random_access_iterator_tag
+iterator_category(const __deque_iterator<T, Ref>&) {
+ return random_access_iterator_tag();
+}
+
+template <class T, class Ref>
+inline T* value_type(const __deque_iterator<T, Ref>&) { return 0; }
+
+template <class T, class Ref>
+inline ptrdiff_t* distance_type(const __deque_iterator<T, Ref>&) {
+ return 0;
+}
+
+#endif /* __STL_NON_TYPE_TMPL_PARAM_BUG */
+
+
+// See __deque_buf_size(). The only reason that the default value is 0
+// is as a workaround for bugs in the way that some compilers handle
+// constant expressions.
+template <class T, class Alloc = alloc, size_t BufSiz = 0>
+class deque {
+public: // Basic types
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+
+public: // Iterators
+#ifndef __STL_NON_TYPE_TMPL_PARAM_BUG
+ typedef __deque_iterator<value_type, reference, BufSiz> iterator;
+ typedef __deque_iterator<value_type, const_reference, BufSiz> const_iterator;
+#else /* __STL_NON_TYPE_TMPL_PARAM_BUG */
+ typedef __deque_iterator<value_type, reference> iterator;
+ typedef __deque_iterator<value_type, const_reference> const_iterator;
+#endif /* __STL_NON_TYPE_TMPL_PARAM_BUG */
+ typedef reverse_iterator<const_iterator, value_type, const_reference,
+ difference_type>
+ const_reverse_iterator;
+ typedef reverse_iterator<iterator, value_type, reference, difference_type>
+ reverse_iterator;
+
+protected: // Internal typedefs
+ typedef pointer* map_pointer;
+ typedef simple_alloc<value_type, Alloc> data_allocator;
+ typedef simple_alloc<pointer, Alloc> map_allocator;
+
+ static size_type buffer_size() {
+ return __deque_buf_size(BufSiz, sizeof(value_type));
+ }
+ static size_type initial_map_size() { return 8; }
+
+protected: // Data members
+ iterator start;
+ iterator finish;
+
+ map_pointer map;
+ size_type map_size;
+
+public: // Basic accessors
+ iterator begin() { return start; }
+ iterator end() { return finish; }
+ const_iterator begin() const { return start; }
+ const_iterator end() const { return finish; }
+
+ reverse_iterator rbegin() { return reverse_iterator(finish); }
+ reverse_iterator rend() { return reverse_iterator(start); }
+ const_reverse_iterator rbegin() const {
+ return const_reverse_iterator(finish);
+ }
+ const_reverse_iterator rend() const {
+ return const_reverse_iterator(start);
+ }
+
+ reference operator[](size_type n) { return start[n]; }
+ const_reference operator[](size_type n) const { return start[n]; }
+
+ reference front() { return *start; }
+ reference back() {
+ iterator tmp = finish;
+ --tmp;
+ return *tmp;
+ }
+ const_reference front() const { return *start; }
+ const_reference back() const {
+ const_iterator tmp = finish;
+ --tmp;
+ return *tmp;
+ }
+
+ size_type size() const { return finish - start;; }
+ size_type max_size() const { return size_type(-1); }
+ bool empty() const { return finish == start; }
+
+public: // Constructor, destructor.
+ deque()
+ : start(), finish(), map(0), map_size(0)
+ {
+ create_map_and_nodes(0);
+ }
+
+ deque(const deque& x)
+ : start(), finish(), map(0), map_size(0)
+ {
+ create_map_and_nodes(x.size());
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ uninitialized_copy(x.begin(), x.end(), start);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_map_and_nodes();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+ deque(size_type n, const value_type& value)
+ : start(), finish(), map(0), map_size(0) {
+ fill_initialize(n, value);
+ }
+
+ deque(int n, const value_type& value)
+ : start(), finish(), map(0), map_size(0) {
+ fill_initialize(n, value);
+ }
+
+ deque(long n, const value_type& value)
+ : start(), finish(), map(0), map_size(0) {
+ fill_initialize(n, value);
+ }
+
+ explicit deque(size_type n)
+ : start(), finish(), map(0), map_size(0) {
+ fill_initialize(n, value_type());
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+ template <class InputIterator>
+ deque(InputIterator first, InputIterator last)
+ : start(), finish(), map(0), map_size(0)
+ {
+ range_initialize(first, last, iterator_category(first));
+ }
+
+#else /* __STL_MEMBER_TEMPLATES */
+
+ deque(const value_type* first, const value_type* last)
+ : start(), finish(), map(0), map_size(0)
+ {
+ create_map_and_nodes(last - first);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ uninitialized_copy(first, last, start);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_map_and_nodes();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+ deque(const_iterator first, const_iterator last)
+ : start(), finish(), map(0), map_size(0)
+ {
+ create_map_and_nodes(last - first);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ uninitialized_copy(first, last, start);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_map_and_nodes();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ ~deque() {
+ destroy(start, finish);
+ destroy_map_and_nodes();
+ }
+
+ deque& operator= (const deque& x) {
+ const size_type len = size();
+ if (&x != this) {
+ if (len >= x.size())
+ erase(copy(x.begin(), x.end(), start), finish);
+ else {
+ const_iterator mid = x.begin() + len;
+ copy(x.begin(), mid, start);
+ insert(finish, mid, x.end());
+ }
+ }
+ return *this;
+ }
+
+ void swap(deque& x) {
+ ::swap(start, x.start);
+ ::swap(finish, x.finish);
+ ::swap(map, x.map);
+ ::swap(map_size, x.map_size);
+ }
+
+public: // push_* and pop_*
+
+ void push_back(const value_type& t) {
+ if (finish.cur != finish.last - 1) {
+ construct(finish.cur, t);
+ ++finish.cur;
+ }
+ else
+ push_back_aux(t);
+ }
+
+ void push_front(const value_type& t) {
+ if (start.cur != start.first) {
+ construct(start.cur - 1, t);
+ --start.cur;
+ }
+ else
+ push_front_aux(t);
+ }
+
+ void pop_back() {
+ if (finish.cur != finish.first) {
+ --finish.cur;
+ destroy(finish.cur);
+ }
+ else
+ pop_back_aux();
+ }
+
+ void pop_front() {
+ if (start.cur != start.last - 1) {
+ destroy(start.cur);
+ ++start.cur;
+ }
+ else
+ pop_front_aux();
+ }
+
+public: // Insert
+
+ iterator insert(iterator position, const value_type& x) {
+ if (position.cur == start.cur) {
+ push_front(x);
+ return start;
+ }
+ else if (position.cur == finish.cur) {
+ push_back(x);
+ iterator tmp = finish;
+ --tmp;
+ return tmp;
+ }
+ else {
+ return insert_aux(position, x);
+ }
+ }
+
+ iterator insert(iterator position) { return insert(position, value_type()); }
+
+ void insert(iterator pos, size_type n, const value_type& x);
+
+ void insert(iterator pos, int n, const value_type& x) {
+ insert(pos, (size_type) n, x);
+ }
+ void insert(iterator pos, long n, const value_type& x) {
+ insert(pos, (size_type) n, x);
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+ template <class InputIterator>
+ void insert(iterator pos, InputIterator first, InputIterator last) {
+ insert(pos, first, last, iterator_category(first));
+ }
+
+#else /* __STL_MEMBER_TEMPLATES */
+
+ void insert(iterator pos, const value_type* first, const value_type* last);
+ void insert(iterator pos, const_iterator first, const_iterator last);
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ void resize(size_type new_size, const value_type& x) {
+ const size_type len = size();
+ if (new_size < len)
+ erase(start + new_size, finish);
+ else
+ insert(finish, new_size - len, x);
+ }
+
+ void resize(size_type new_size) { resize(new_size, value_type()); }
+
+public: // Erase
+ void erase(iterator pos) {
+ iterator next = pos;
+ ++next;
+ if (pos - start < size() / 2) {
+ copy_backward(start, pos, next);
+ pop_front();
+ }
+ else {
+ copy(next, finish, pos);
+ pop_back();
+ }
+ }
+
+ void erase(iterator first, iterator last);
+ void clear();
+
+protected: // Internal construction/destruction
+
+ void create_map_and_nodes(size_type num_elements);
+ void destroy_map_and_nodes();
+ void fill_initialize(size_type n, const value_type& value);
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+ template <class InputIterator>
+ void range_initialize(InputIterator first, InputIterator last,
+ input_iterator_tag);
+
+ template <class ForwardIterator>
+ void range_initialize(ForwardIterator first, ForwardIterator last,
+ forward_iterator_tag);
+
+ template <class BidirectionalIterator>
+ void range_initialize(BidirectionalIterator first,
+ BidirectionalIterator last,
+ bidirectional_iterator_tag) {
+ range_initialize(first, last, forward_iterator_tag());
+ }
+
+ template <class RandomAccessIterator>
+ void range_initialize(RandomAccessIterator first, RandomAccessIterator last,
+ random_access_iterator_tag) {
+ range_initialize(first, last, forward_iterator_tag());
+ }
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+protected: // Internal push_* and pop_*
+
+ void push_back_aux(const value_type& t);
+ void push_front_aux(const value_type& t);
+ void pop_back_aux();
+ void pop_front_aux();
+
+protected: // Internal insert functions
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+ template <class InputIterator>
+ void insert(iterator pos, InputIterator first, InputIterator last,
+ input_iterator_tag);
+
+ template <class ForwardIterator>
+ void insert(iterator pos, ForwardIterator first, ForwardIterator last,
+ forward_iterator_tag);
+
+ template <class BidirectionalIterator>
+ void insert(iterator pos,
+ BidirectionalIterator first, BidirectionalIterator last,
+ bidirectional_iterator_tag) {
+ insert(pos, first, last, forward_iterator_tag());
+ }
+
+ template <class RandomAccessIterator>
+ void insert(iterator pos,
+ RandomAccessIterator first, RandomAccessIterator last,
+ random_access_iterator_tag) {
+ insert(pos, first, last, forward_iterator_tag());
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ iterator insert_aux(iterator pos, const value_type& x);
+ void insert_aux(iterator pos, size_type n, const value_type& x);
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+ template <class ForwardIterator>
+ void insert_aux(iterator pos, ForwardIterator first, ForwardIterator last,
+ size_type n);
+
+#else /* __STL_MEMBER_TEMPLATES */
+
+ void insert_aux(iterator pos,
+ const value_type* first, const value_type* last,
+ size_type n);
+
+ void insert_aux(iterator pos, const_iterator first, const_iterator last,
+ size_type n);
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ iterator reserve_elements_at_front(size_type n) {
+ size_type vacancies = start.cur - start.first;
+ if (n > vacancies)
+ new_elements_at_front(n - vacancies);
+ return start - n;
+ }
+
+ iterator reserve_elements_at_back(size_type n) {
+ size_type vacancies = (finish.last - finish.cur) - 1;
+ if (n > vacancies)
+ new_elements_at_back(n - vacancies);
+ return finish + n;
+ }
+
+ void new_elements_at_front(size_type new_elements);
+ void new_elements_at_back(size_type new_elements);
+
+ void destroy_nodes_at_front(iterator before_start);
+ void destroy_nodes_at_back(iterator after_finish);
+
+protected: // Allocation of map and nodes
+
+ // Makes sure the map has space for new nodes. Does not actually
+ // add the nodes. Can invalidate map pointers. (And consequently,
+ // deque iterators.)
+
+ void reserve_map_at_back (size_type nodes_to_add = 1) {
+ if (nodes_to_add + 1 > map_size - (finish.node - map))
+ reallocate_map(nodes_to_add, false);
+ }
+
+ void reserve_map_at_front (size_type nodes_to_add = 1) {
+ if (nodes_to_add > start.node - map)
+ reallocate_map(nodes_to_add, true);
+ }
+
+ void reallocate_map(size_type nodes_to_add, bool add_at_front);
+
+ pointer allocate_node() { return data_allocator::allocate(buffer_size()); }
+ void deallocate_node(pointer n) {
+ data_allocator::deallocate(n, buffer_size());
+ }
+
+#ifdef __STL_NON_TYPE_TMPL_PARAM_BUG
+public:
+ bool operator==(const deque<T, Alloc, 0>& x) const {
+ return size() == x.size() && equal(begin(), end(), x.begin());
+ }
+ bool operator!=(const deque<T, Alloc, 0>& x) const {
+ return size() != x.size() || !equal(begin(), end(), x.begin());
+ }
+ bool operator<(const deque<T, Alloc, 0>& x) const {
+ return lexicographical_compare(begin(), end(), x.begin(), x.end());
+ }
+#endif /* __STL_NON_TYPE_TMPL_PARAM_BUG */
+};
+
+// Non-inline member functions
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::insert(iterator pos,
+ size_type n, const value_type& x) {
+ if (pos.cur == start.cur) {
+ iterator new_start = reserve_elements_at_front(n);
+ uninitialized_fill(new_start, start, x);
+ start = new_start;
+ }
+ else if (pos.cur == finish.cur) {
+ iterator new_finish = reserve_elements_at_back(n);
+ uninitialized_fill(finish, new_finish, x);
+ finish = new_finish;
+ }
+ else
+ insert_aux(pos, n, x);
+}
+
+#ifndef __STL_MEMBER_TEMPLATES
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::insert(iterator pos,
+ const value_type* first,
+ const value_type* last) {
+ size_type n = last - first;
+ if (pos.cur == start.cur) {
+ iterator new_start = reserve_elements_at_front(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif
+ uninitialized_copy(first, last, new_start);
+ start = new_start;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_front(new_start);
+ throw;
+ }
+# endif
+ }
+ else if (pos.cur == finish.cur) {
+ iterator new_finish = reserve_elements_at_back(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif
+ uninitialized_copy(first, last, finish);
+ finish = new_finish;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_back(new_finish);
+ throw;
+ }
+# endif
+ }
+ else
+ insert_aux(pos, first, last, n);
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::insert(iterator pos,
+ const_iterator first,
+ const_iterator last)
+{
+ size_type n = last - first;
+ if (pos.cur == start.cur) {
+ iterator new_start = reserve_elements_at_front(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif
+ uninitialized_copy(first, last, new_start);
+ start = new_start;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_front(new_start);
+ throw;
+ }
+# endif
+ }
+ else if (pos.cur == finish.cur) {
+ iterator new_finish = reserve_elements_at_back(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif
+ uninitialized_copy(first, last, finish);
+ finish = new_finish;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_back(new_finish);
+ throw;
+ }
+# endif
+ }
+ else
+ insert_aux(pos, first, last, n);
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::erase(iterator first, iterator last) {
+ if (first == start && last == finish)
+ clear();
+ else {
+ difference_type n = last - first;
+ difference_type elems_before = first - start;
+ if (elems_before < (size() - n) / 2) {
+ copy_backward(start, first, last);
+ iterator new_start = start + n;
+ destroy(start, new_start);
+ for (map_pointer cur = start.node; cur < new_start.node; ++cur)
+ data_allocator::deallocate(*cur, buffer_size());
+ start = new_start;
+ }
+ else {
+ copy(last, finish, first);
+ iterator new_finish = finish - n;
+ destroy(new_finish, finish);
+ for (map_pointer cur = new_finish.node + 1; cur <= finish.node; ++cur)
+ data_allocator::deallocate(*cur, buffer_size());
+ finish = new_finish;
+ }
+ }
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::clear() {
+ for (map_pointer node = start.node + 1; node < finish.node; ++node) {
+ destroy(*node, *node + buffer_size());
+ data_allocator::deallocate(*node, buffer_size());
+ }
+
+ if (start.node != finish.node) {
+ destroy(start.cur, start.last);
+ destroy(finish.first, finish.cur);
+ data_allocator::deallocate(finish.first, buffer_size());
+ }
+ else
+ destroy(start.cur, finish.cur);
+
+ finish = start;
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::create_map_and_nodes(size_type num_elements) {
+ size_type num_nodes = num_elements / buffer_size() + 1;
+
+ map_size = max(initial_map_size(), num_nodes + 2);
+ map = map_allocator::allocate(map_size);
+
+ map_pointer nstart = map + (map_size - num_nodes) / 2;
+ map_pointer nfinish = nstart + num_nodes - 1;
+
+ map_pointer cur;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for (cur = nstart; cur <= nfinish; ++cur)
+ *cur = allocate_node();
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ for (map_pointer n = nstart; n < cur; ++n)
+ deallocate_node(*n);
+ map_allocator::deallocate(map, map_size);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+
+ start.set_node(nstart);
+ finish.set_node(nfinish);
+ start.cur = start.first;
+ finish.cur = finish.first + num_elements % buffer_size();
+}
+
+// This is only used as a cleanup function in catch clauses.
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::destroy_map_and_nodes() {
+ for (map_pointer cur = start.node; cur <= finish.node; ++cur)
+ deallocate_node(*cur);
+ map_allocator::deallocate(map, map_size);
+}
+
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::fill_initialize(size_type n,
+ const value_type& value) {
+ create_map_and_nodes(n);
+ map_pointer cur;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for (cur = start.node; cur < finish.node; ++cur)
+ uninitialized_fill(*cur, *cur + buffer_size(), value);
+ uninitialized_fill(finish.first, finish.cur, value);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ for (map_pointer n = start.node; n < cur; ++n)
+ destroy(*cur, *cur + buffer_size());
+ destroy_map_and_nodes();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+template <class T, class Alloc, size_t BufSize>
+template <class InputIterator>
+void deque<T, Alloc, BufSize>::range_initialize(InputIterator first,
+ InputIterator last,
+ input_iterator_tag) {
+ create_map_and_nodes(0);
+ for ( ; first != last; ++first)
+ push_back(*first);
+}
+
+template <class T, class Alloc, size_t BufSize>
+template <class ForwardIterator>
+void deque<T, Alloc, BufSize>::range_initialize(ForwardIterator first,
+ ForwardIterator last,
+ forward_iterator_tag) {
+ size_type n = 0;
+ distance(first, last, n);
+ create_map_and_nodes(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ uninitialized_copy(first, last, start);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_map_and_nodes();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+// Called only if finish.cur == finish.last - 1.
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::push_back_aux(const value_type& t) {
+ value_type t_copy = t;
+ reserve_map_at_back();
+ *(finish.node + 1) = allocate_node();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ construct(finish.cur, t_copy);
+ finish.set_node(finish.node + 1);
+ finish.cur = finish.first;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ deallocate_node(*(finish.node + 1));
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+// Called only if start.cur == start.first.
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::push_front_aux(const value_type& t) {
+ value_type t_copy = t;
+ reserve_map_at_front();
+ *(start.node - 1) = allocate_node();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ start.set_node(start.node - 1);
+ start.cur = start.last - 1;
+ construct(start.cur, t_copy);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ start.set_node(start.node + 1);
+ start.cur = start.first;
+ deallocate_node(*(start.node - 1));
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+// Called only if finish.cur == finish.first.
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>:: pop_back_aux() {
+ deallocate_node(finish.first);
+ finish.set_node(finish.node - 1);
+ finish.cur = finish.last - 1;
+ destroy(finish.cur);
+}
+
+// Called only if start.cur == start.last - 1. Note that if the deque
+// has at least one element (a necessary precondition for this member
+// function), and if start.cur == start.last, then the deque must have
+// at least two nodes.
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::pop_front_aux() {
+ destroy(start.cur);
+ deallocate_node(start.first);
+ start.set_node(start.node + 1);
+ start.cur = start.first;
+}
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+template <class T, class Alloc, size_t BufSize>
+template <class InputIterator>
+void deque<T, Alloc, BufSize>::insert(iterator pos,
+ InputIterator first, InputIterator last,
+ input_iterator_tag) {
+ copy(first, last, inserter(*this, pos));
+}
+
+template <class T, class Alloc, size_t BufSize>
+template <class ForwardIterator>
+void deque<T, Alloc, BufSize>::insert(iterator pos,
+ ForwardIterator first,
+ ForwardIterator last,
+ forward_iterator_tag) {
+ size_type n = 0;
+ distance(first, last, n);
+ if (pos.cur == start.cur) {
+ iterator new_start = reserve_elements_at_front(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif
+ uninitialized_copy(first, last, new_start);
+ start = new_start;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_front(new_start);
+ throw;
+ }
+# endif
+ }
+ else if (pos.cur == finish.cur) {
+ iterator new_finish = reserve_elements_at_back(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif
+ uninitialized_copy(first, last, finish);
+ finish = new_finish;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_back(new_finish);
+ throw;
+ }
+# endif
+ }
+ else
+ insert_aux(pos, first, last, n);
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+template <class T, class Alloc, size_t BufSize>
+deque<T, Alloc, BufSize>::iterator
+deque<T, Alloc, BufSize>::insert_aux(iterator pos, const value_type& x) {
+ difference_type index = pos - start;
+ value_type x_copy = x;
+ if (index < size() / 2) {
+ push_front(front());
+ iterator front1 = start;
+ ++front1;
+ iterator front2 = front1;
+ ++front2;
+ pos = start + index;
+ iterator pos1 = pos;
+ ++pos1;
+ copy(front2, pos1, front1);
+ }
+ else {
+ push_back(back());
+ iterator back1 = finish;
+ --back1;
+ iterator back2 = back1;
+ --back2;
+ pos = start + index;
+ copy_backward(pos, back2, back1);
+ }
+ *pos = x_copy;
+ return pos;
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::insert_aux(iterator pos,
+ size_type n, const value_type& x) {
+ const difference_type elems_before = pos - start;
+ size_type length = size();
+ value_type x_copy = x;
+ if (elems_before < length / 2) {
+ iterator new_start = reserve_elements_at_front(n);
+ iterator old_start = start;
+ pos = start + elems_before;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (elems_before >= n) {
+ iterator start_n = start + n;
+ uninitialized_copy(start, start_n, new_start);
+ start = new_start;
+ copy(start_n, pos, old_start);
+ fill(pos - n, pos, x_copy);
+ }
+ else {
+ __uninitialized_copy_fill(start, pos, new_start, start, x_copy);
+ start = new_start;
+ fill(old_start, pos, x_copy);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_front(new_start);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ else {
+ iterator new_finish = reserve_elements_at_back(n);
+ iterator old_finish = finish;
+ const difference_type elems_after = length - elems_before;
+ pos = finish - elems_after;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (elems_after > n) {
+ iterator finish_n = finish - n;
+ uninitialized_copy(finish_n, finish, finish);
+ finish = new_finish;
+ copy_backward(pos, finish_n, old_finish);
+ fill(pos, pos + n, x_copy);
+ }
+ else {
+ __uninitialized_fill_copy(finish, pos + n, x_copy, pos, finish);
+ finish = new_finish;
+ fill(pos, old_finish, x_copy);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_back(new_finish);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+}
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+template <class T, class Alloc, size_t BufSize>
+template <class ForwardIterator>
+void deque<T, Alloc, BufSize>::insert_aux(iterator pos,
+ ForwardIterator first,
+ ForwardIterator last,
+ size_type n)
+{
+ const difference_type elems_before = pos - start;
+ size_type length = size();
+ if (elems_before < length / 2) {
+ iterator new_start = reserve_elements_at_front(n);
+ iterator old_start = start;
+ pos = start + elems_before;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (elems_before >= n) {
+ iterator start_n = start + n;
+ uninitialized_copy(start, start_n, new_start);
+ start = new_start;
+ copy(start_n, pos, old_start);
+ copy(first, last, pos - n);
+ }
+ else {
+ ForwardIterator mid = first;
+ advance(mid, n - elems_before);
+ __uninitialized_copy_copy(start, pos, first, mid, new_start);
+ start = new_start;
+ copy(mid, last, old_start);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_front(new_start);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ else {
+ iterator new_finish = reserve_elements_at_back(n);
+ iterator old_finish = finish;
+ const difference_type elems_after = length - elems_before;
+ pos = finish - elems_after;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (elems_after > n) {
+ iterator finish_n = finish - n;
+ uninitialized_copy(finish_n, finish, finish);
+ finish = new_finish;
+ copy_backward(pos, finish_n, old_finish);
+ copy(first, last, pos);
+ }
+ else {
+ ForwardIterator mid = first;
+ advance(mid, elems_after);
+ __uninitialized_copy_copy(mid, last, pos, finish, finish);
+ finish = new_finish;
+ copy(first, mid, pos);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_back(new_finish);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+}
+
+#else /* __STL_MEMBER_TEMPLATES */
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::insert_aux(iterator pos,
+ const value_type* first,
+ const value_type* last,
+ size_type n)
+{
+ const difference_type elems_before = pos - start;
+ size_type length = size();
+ if (elems_before < length / 2) {
+ iterator new_start = reserve_elements_at_front(n);
+ iterator old_start = start;
+ pos = start + elems_before;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (elems_before >= n) {
+ iterator start_n = start + n;
+ uninitialized_copy(start, start_n, new_start);
+ start = new_start;
+ copy(start_n, pos, old_start);
+ copy(first, last, pos - n);
+ }
+ else {
+ const value_type* mid = first + (n - elems_before);
+ __uninitialized_copy_copy(start, pos, first, mid, new_start);
+ start = new_start;
+ copy(mid, last, old_start);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_front(new_start);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ else {
+ iterator new_finish = reserve_elements_at_back(n);
+ iterator old_finish = finish;
+ const difference_type elems_after = length - elems_before;
+ pos = finish - elems_after;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (elems_after > n) {
+ iterator finish_n = finish - n;
+ uninitialized_copy(finish_n, finish, finish);
+ finish = new_finish;
+ copy_backward(pos, finish_n, old_finish);
+ copy(first, last, pos);
+ }
+ else {
+ const value_type* mid = first + elems_after;
+ __uninitialized_copy_copy(mid, last, pos, finish, finish);
+ finish = new_finish;
+ copy(first, mid, pos);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_back(new_finish);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::insert_aux(iterator pos,
+ const_iterator first,
+ const_iterator last,
+ size_type n)
+{
+ const difference_type elems_before = pos - start;
+ size_type length = size();
+ if (elems_before < length / 2) {
+ iterator new_start = reserve_elements_at_front(n);
+ iterator old_start = start;
+ pos = start + elems_before;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (elems_before >= n) {
+ iterator start_n = start + n;
+ uninitialized_copy(start, start_n, new_start);
+ start = new_start;
+ copy(start_n, pos, old_start);
+ copy(first, last, pos - n);
+ }
+ else {
+ const_iterator mid = first + (n - elems_before);
+ __uninitialized_copy_copy(start, pos, first, mid, new_start);
+ start = new_start;
+ copy(mid, last, old_start);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_front(new_start);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ else {
+ iterator new_finish = reserve_elements_at_back(n);
+ iterator old_finish = finish;
+ const difference_type elems_after = length - elems_before;
+ pos = finish - elems_after;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (elems_after > n) {
+ iterator finish_n = finish - n;
+ uninitialized_copy(finish_n, finish, finish);
+ finish = new_finish;
+ copy_backward(pos, finish_n, old_finish);
+ copy(first, last, pos);
+ }
+ else {
+ const_iterator mid = first + elems_after;
+ __uninitialized_copy_copy(mid, last, pos, finish, finish);
+ finish = new_finish;
+ copy(first, mid, pos);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy_nodes_at_back(new_finish);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::new_elements_at_front(size_type new_elements) {
+ size_type new_nodes = (new_elements + buffer_size() - 1) / buffer_size();
+ reserve_map_at_front(new_nodes);
+ size_type i;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for (i = 1; i <= new_nodes; ++i)
+ *(start.node - i) = allocate_node();
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ for (size_type j = 1; j < i; ++j)
+ deallocate_node(*(start.node - j));
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::new_elements_at_back(size_type new_elements) {
+ size_type new_nodes = (new_elements + buffer_size() - 1) / buffer_size();
+ reserve_map_at_back(new_nodes);
+ size_type i;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for (i = 1; i <= new_nodes; ++i)
+ *(finish.node + i) = allocate_node();
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ for (size_type j = 1; j < i; ++j)
+ deallocate_node(*(finish.node + j));
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::destroy_nodes_at_front(iterator before_start) {
+ for (map_pointer n = before_start.node; n < start.node; ++n)
+ deallocate_node(*n);
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::destroy_nodes_at_back(iterator after_finish) {
+ for (map_pointer n = after_finish.node; n > finish.node; --n)
+ deallocate_node(*n);
+}
+
+template <class T, class Alloc, size_t BufSize>
+void deque<T, Alloc, BufSize>::reallocate_map(size_type nodes_to_add,
+ bool add_at_front) {
+ size_type old_num_nodes = finish.node - start.node + 1;
+ size_type new_num_nodes = old_num_nodes + nodes_to_add;
+
+ map_pointer new_nstart;
+ if (map_size > 2 * new_num_nodes) {
+ new_nstart = map + (map_size - new_num_nodes) / 2
+ + (add_at_front ? nodes_to_add : 0);
+ if (new_nstart < start.node)
+ copy(start.node, finish.node + 1, new_nstart);
+ else
+ copy_backward(start.node, finish.node + 1, new_nstart + old_num_nodes);
+ }
+ else {
+ size_type new_map_size = map_size + max(map_size, nodes_to_add) + 2;
+
+ map_pointer new_map = map_allocator::allocate(new_map_size);
+ new_nstart = new_map + (new_map_size - new_num_nodes) / 2
+ + (add_at_front ? nodes_to_add : 0);
+ copy(start.node, finish.node + 1, new_nstart);
+ map_allocator::deallocate(map, map_size);
+
+ map = new_map;
+ map_size = new_map_size;
+ }
+
+ start.set_node(new_nstart);
+ finish.set_node(new_nstart + old_num_nodes - 1);
+}
+
+
+// Nonmember functions.
+
+#ifndef __STL_NON_TYPE_TMPL_PARAM_BUG
+
+template <class T, class Alloc, size_t BufSiz>
+bool operator==(const deque<T, Alloc, BufSiz>& x,
+ const deque<T, Alloc, BufSiz>& y) {
+ return x.size() == y.size() && equal(x.begin(), x.end(), y.begin());
+}
+
+template <class T, class Alloc, size_t BufSiz>
+bool operator<(const deque<T, Alloc, BufSiz>& x,
+ const deque<T, Alloc, BufSiz>& y) {
+ return lexicographical_compare(x.begin(), x.end(), y.begin(), y.end());
+}
+
+#endif /* __STL_NON_TYPE_TMPL_PARAM_BUG */
+
+
+#endif /* __SGI_STL_DEQUE_H */
+
diff --git a/libstdc++/stl/function.h b/libstdc++/stl/function.h
new file mode 100644
index 00000000000..e4f4713235b
--- /dev/null
+++ b/libstdc++/stl/function.h
@@ -0,0 +1,634 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_FUNCTION_H
+#define __SGI_STL_FUNCTION_H
+
+#include <stddef.h>
+#include <stl_config.h>
+
+template <class T>
+inline bool operator!=(const T& x, const T& y) {
+ return !(x == y);
+}
+
+template <class T>
+inline bool operator>(const T& x, const T& y) {
+ return y < x;
+}
+
+template <class T>
+inline bool operator<=(const T& x, const T& y) {
+ return !(y < x);
+}
+
+template <class T>
+inline bool operator>=(const T& x, const T& y) {
+ return !(x < y);
+}
+
+template <class Arg, class Result>
+struct unary_function {
+ typedef Arg argument_type;
+ typedef Result result_type;
+};
+
+template <class Arg1, class Arg2, class Result>
+struct binary_function {
+ typedef Arg1 first_argument_type;
+ typedef Arg2 second_argument_type;
+ typedef Result result_type;
+};
+
+template <class T>
+struct plus : public binary_function<T, T, T> {
+ T operator()(const T& x, const T& y) const { return x + y; }
+};
+
+template <class T>
+struct minus : public binary_function<T, T, T> {
+ T operator()(const T& x, const T& y) const { return x - y; }
+};
+
+template <class T>
+struct multiplies : public binary_function<T, T, T> {
+ T operator()(const T& x, const T& y) const { return x * y; }
+};
+
+template <class T>
+struct divides : public binary_function<T, T, T> {
+ T operator()(const T& x, const T& y) const { return x / y; }
+};
+
+template <class T> inline T identity_element(plus<T>) { return T(0); }
+
+template <class T> inline T identity_element(multiplies<T>) { return T(1); }
+
+template <class T>
+struct modulus : public binary_function<T, T, T> {
+ T operator()(const T& x, const T& y) const { return x % y; }
+};
+
+template <class T>
+struct negate : public unary_function<T, T> {
+ T operator()(const T& x) const { return -x; }
+};
+
+template <class T>
+struct equal_to : public binary_function<T, T, bool> {
+ bool operator()(const T& x, const T& y) const { return x == y; }
+};
+
+template <class T>
+struct not_equal_to : public binary_function<T, T, bool> {
+ bool operator()(const T& x, const T& y) const { return x != y; }
+};
+
+template <class T>
+struct greater : public binary_function<T, T, bool> {
+ bool operator()(const T& x, const T& y) const { return x > y; }
+};
+
+template <class T>
+struct less : public binary_function<T, T, bool> {
+ bool operator()(const T& x, const T& y) const { return x < y; }
+};
+
+template <class T>
+struct greater_equal : public binary_function<T, T, bool> {
+ bool operator()(const T& x, const T& y) const { return x >= y; }
+};
+
+template <class T>
+struct less_equal : public binary_function<T, T, bool> {
+ bool operator()(const T& x, const T& y) const { return x <= y; }
+};
+
+template <class T>
+struct logical_and : public binary_function<T, T, bool> {
+ bool operator()(const T& x, const T& y) const { return x && y; }
+};
+
+template <class T>
+struct logical_or : public binary_function<T, T, bool> {
+ bool operator()(const T& x, const T& y) const { return x || y; }
+};
+
+template <class T>
+struct logical_not : public unary_function<T, bool> {
+ bool operator()(const T& x) const { return !x; }
+};
+
+template <class Predicate>
+class unary_negate
+ : public unary_function<typename Predicate::argument_type, bool> {
+protected:
+ Predicate pred;
+public:
+ explicit unary_negate(const Predicate& x) : pred(x) {}
+ bool operator()(const argument_type& x) const { return !pred(x); }
+};
+
+template <class Predicate>
+inline unary_negate<Predicate> not1(const Predicate& pred) {
+ return unary_negate<Predicate>(pred);
+}
+
+template <class Predicate>
+class binary_negate
+ : public binary_function<typename Predicate::first_argument_type,
+ typename Predicate::second_argument_type,
+ bool> {
+protected:
+ Predicate pred;
+public:
+ explicit binary_negate(const Predicate& x) : pred(x) {}
+ bool operator()(const first_argument_type& x,
+ const second_argument_type& y) const {
+ return !pred(x, y);
+ }
+};
+
+template <class Predicate>
+inline binary_negate<Predicate> not2(const Predicate& pred) {
+ return binary_negate<Predicate>(pred);
+}
+
+template <class Operation>
+class binder1st
+ : public unary_function<typename Operation::second_argument_type,
+ typename Operation::result_type> {
+protected:
+ Operation op;
+ typename Operation::first_argument_type value;
+public:
+ binder1st(const Operation& x,
+ const typename Operation::first_argument_type& y)
+ : op(x), value(y) {}
+ result_type operator()(const argument_type& x) const {
+ return op(value, x);
+ }
+};
+
+template <class Operation, class T>
+inline binder1st<Operation> bind1st(const Operation& op, const T& x) {
+ typedef typename Operation::first_argument_type arg1_type;
+ return binder1st<Operation>(op, arg1_type(x));
+}
+
+template <class Operation>
+class binder2nd
+ : public unary_function<typename Operation::first_argument_type,
+ typename Operation::result_type> {
+protected:
+ Operation op;
+ typename Operation::second_argument_type value;
+public:
+ binder2nd(const Operation& x,
+ const typename Operation::second_argument_type& y)
+ : op(x), value(y) {}
+ result_type operator()(const argument_type& x) const {
+ return op(x, value);
+ }
+};
+
+template <class Operation, class T>
+inline binder2nd<Operation> bind2nd(const Operation& op, const T& x) {
+ typedef typename Operation::second_argument_type arg2_type;
+ return binder2nd<Operation>(op, arg2_type(x));
+}
+
+template <class Operation1, class Operation2>
+class unary_compose : public unary_function<typename Operation2::argument_type,
+ typename Operation1::result_type> {
+protected:
+ Operation1 op1;
+ Operation2 op2;
+public:
+ unary_compose(const Operation1& x, const Operation2& y) : op1(x), op2(y) {}
+ result_type operator()(const argument_type& x) const {
+ return op1(op2(x));
+ }
+};
+
+template <class Operation1, class Operation2>
+inline unary_compose<Operation1, Operation2> compose1(const Operation1& op1,
+ const Operation2& op2) {
+ return unary_compose<Operation1, Operation2>(op1, op2);
+}
+
+template <class Operation1, class Operation2, class Operation3>
+class binary_compose
+ : public unary_function<typename Operation2::argument_type,
+ typename Operation1::result_type> {
+protected:
+ Operation1 op1;
+ Operation2 op2;
+ Operation3 op3;
+public:
+ binary_compose(const Operation1& x, const Operation2& y,
+ const Operation3& z) : op1(x), op2(y), op3(z) { }
+ result_type operator()(const argument_type& x) const {
+ return op1(op2(x), op3(x));
+ }
+};
+
+template <class Operation1, class Operation2, class Operation3>
+inline binary_compose<Operation1, Operation2, Operation3>
+compose2(const Operation1& op1, const Operation2& op2, const Operation3& op3) {
+ return binary_compose<Operation1, Operation2, Operation3>(op1, op2, op3);
+}
+
+template <class Arg, class Result>
+class pointer_to_unary_function : public unary_function<Arg, Result> {
+protected:
+ Result (*ptr)(Arg);
+public:
+ pointer_to_unary_function() {}
+ explicit pointer_to_unary_function(Result (*x)(Arg)) : ptr(x) {}
+ Result operator()(Arg x) const { return ptr(x); }
+};
+
+template <class Arg, class Result>
+inline pointer_to_unary_function<Arg, Result> ptr_fun(Result (*x)(Arg)) {
+ return pointer_to_unary_function<Arg, Result>(x);
+}
+
+template <class Arg1, class Arg2, class Result>
+class pointer_to_binary_function : public binary_function<Arg1, Arg2, Result> {
+protected:
+ Result (*ptr)(Arg1, Arg2);
+public:
+ pointer_to_binary_function() {}
+ explicit pointer_to_binary_function(Result (*x)(Arg1, Arg2)) : ptr(x) {}
+ Result operator()(Arg1 x, Arg2 y) const { return ptr(x, y); }
+};
+
+template <class Arg1, class Arg2, class Result>
+inline pointer_to_binary_function<Arg1, Arg2, Result>
+ptr_fun(Result (*x)(Arg1, Arg2)) {
+ return pointer_to_binary_function<Arg1, Arg2, Result>(x);
+}
+
+template <class T>
+struct identity : public unary_function<T, T> {
+ const T& operator()(const T& x) const { return x; }
+};
+
+template <class Pair>
+struct select1st : public unary_function<Pair, typename Pair::first_type> {
+ const typename Pair::first_type& operator()(const Pair& x) const
+ {
+ return x.first;
+ }
+};
+
+template <class Pair>
+struct select2nd : public unary_function<Pair, typename Pair::second_type> {
+ const typename Pair::second_type& operator()(const Pair& x) const
+ {
+ return x.second;
+ }
+};
+
+template <class Arg1, class Arg2>
+struct project1st : public binary_function<Arg1, Arg2, Arg1> {
+ Arg1 operator()(const Arg1& x, const Arg2&) const { return x; }
+};
+
+template <class Arg1, class Arg2>
+struct project2nd : public binary_function<Arg1, Arg2, Arg2> {
+ Arg2 operator()(const Arg1&, const Arg2& y) const { return y; }
+};
+
+template <class Result>
+struct constant_void_fun
+{
+ typedef Result result_type;
+ result_type val;
+ constant_void_fun(const result_type& v) : val(v) {}
+ const result_type& operator()() const { return val; }
+};
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Result, class Argument = Result>
+#else
+template <class Result, class Argument>
+#endif
+struct constant_unary_fun : public unary_function<Argument, Result> {
+ result_type val;
+ constant_unary_fun(const result_type& v) : val(v) {}
+ const result_type& operator()(const argument_type&) const { return val; }
+};
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Result, class Arg1 = Result, class Arg2 = Arg1>
+#else
+template <class Result, class Arg1, class Arg2>
+#endif
+struct constant_binary_fun : public binary_function<Arg1, Arg2, Result> {
+ result_type val;
+ constant_binary_fun(const result_type& v) : val(v) {}
+ const result_type& operator()(const first_argument_type&,
+ const second_argument_type&) const {
+ return val;
+ }
+};
+
+template <class Result>
+inline constant_void_fun<Result> constant0(const Result& val)
+{
+ return constant_void_fun<Result>(val);
+}
+
+template <class Result>
+inline constant_unary_fun<Result,Result> constant1(const Result& val)
+{
+ return constant_unary_fun<Result,Result>(val);
+}
+
+template <class Result>
+inline constant_binary_fun<Result,Result,Result> constant2(const Result& val)
+{
+ return constant_binary_fun<Result,Result,Result>(val);
+}
+
+// Note: this code assumes that int is 32 bits.
+class subtractive_rng : public unary_function<unsigned int, unsigned int> {
+private:
+ unsigned int table[55];
+ size_t index1;
+ size_t index2;
+public:
+ unsigned int operator()(unsigned int limit) {
+ index1 = (index1 + 1) % 55;
+ index2 = (index2 + 1) % 55;
+ table[index1] = table[index1] - table[index2];
+ return table[index1] % limit;
+ }
+
+ void initialize(unsigned int seed)
+ {
+ unsigned int k = 1;
+ table[54] = seed;
+ size_t i;
+ for (i = 0; i < 54; i++) {
+ size_t ii = (21 * (i + 1) % 55) - 1;
+ table[ii] = k;
+ k = seed - k;
+ seed = table[ii];
+ }
+ for (int loop = 0; loop < 4; loop++) {
+ for (i = 0; i < 55; i++)
+ table[i] = table[i] - table[(1 + i + 30) % 55];
+ }
+ index1 = 0;
+ index2 = 31;
+ }
+
+ subtractive_rng(unsigned int seed) { initialize(seed); }
+ subtractive_rng() { initialize(161803398u); }
+};
+
+
+// Adaptor function objects: pointers to member functions.
+
+// There are a total of 16 = 2^4 function objects in this family.
+// (1) Member functions taking no arguments vs member functions taking
+// one argument.
+// (2) Call through pointer vs call through reference.
+// (3) Member function with void return type vs member function with
+// non-void return type.
+// (4) Const vs non-const member function.
+
+// Note that choice (4) is not present in the 8/97 draft C++ standard,
+// which only allows these adaptors to be used with non-const functions.
+// This is likely to be recified before the standard becomes final.
+// Note also that choice (3) is nothing more than a workaround: according
+// to the draft, compilers should handle void and non-void the same way.
+// This feature is not yet widely implemented, though. You can only use
+// member functions returning void if your compiler supports partial
+// specialization.
+
+// All of this complexity is in the function objects themselves. You can
+// ignore it by using the helper function mem_fun, mem_fun_ref,
+// mem_fun1, and mem_fun1_ref, which create whichever type of adaptor
+// is appropriate.
+
+
+template <class S, class T>
+class mem_fun_t : public unary_function<T*, S> {
+public:
+ explicit mem_fun_t(S (T::*pf)()) : f(pf) {}
+ S operator()(T* p) const { return (p->*f)(); }
+private:
+ S (T::*f)();
+};
+
+template <class S, class T>
+class const_mem_fun_t : public unary_function<const T*, S> {
+public:
+ explicit const_mem_fun_t(S (T::*pf)() const) : f(pf) {}
+ S operator()(const T* p) const { return (p->*f)(); }
+private:
+ S (T::*f)() const;
+};
+
+
+template <class S, class T>
+class mem_fun_ref_t : public unary_function<T, S> {
+public:
+ explicit mem_fun_ref_t(S (T::*pf)()) : f(pf) {}
+ S operator()(T& r) const { return (r.*f)(); }
+private:
+ S (T::*f)();
+};
+
+template <class S, class T>
+class const_mem_fun_ref_t : public unary_function<T, S> {
+public:
+ explicit const_mem_fun_ref_t(S (T::*pf)() const) : f(pf) {}
+ S operator()(const T& r) const { return (r.*f)(); }
+private:
+ S (T::*f)() const;
+};
+
+template <class S, class T, class A>
+class mem_fun1_t : public binary_function<T*, A, S> {
+public:
+ explicit mem_fun1_t(S (T::*pf)(A)) : f(pf) {}
+ S operator()(T* p, A x) const { return (p->*f)(x); }
+private:
+ S (T::*f)(A);
+};
+
+template <class S, class T, class A>
+class const_mem_fun1_t : public binary_function<const T*, A, S> {
+public:
+ explicit const_mem_fun1_t(S (T::*pf)(A) const) : f(pf) {}
+ S operator()(const T* p, A x) const { return (p->*f)(x); }
+private:
+ S (T::*f)(A) const;
+};
+
+template <class S, class T, class A>
+class mem_fun1_ref_t : public binary_function<T, A, S> {
+public:
+ explicit mem_fun1_ref_t(S (T::*pf)(A)) : f(pf) {}
+ S operator()(T& r, A x) const { return (r.*f)(x); }
+private:
+ S (T::*f)(A);
+};
+
+template <class S, class T, class A>
+class const_mem_fun1_ref_t : public binary_function<T, A, S> {
+public:
+ explicit const_mem_fun1_ref_t(S (T::*pf)(A) const) : f(pf) {}
+ S operator()(const T& r, A x) const { return (r.*f)(x); }
+private:
+ S (T::*f)(A) const;
+};
+
+#ifdef __STL_CLASS_PARTIAL_SPECIALIZATION
+
+template <class T>
+class mem_fun_t<void, T> : public unary_function<T*, void> {
+public:
+ explicit mem_fun_t(void (T::*pf)()) : f(pf) {}
+ void operator()(T* p) const { (p->*f)(); }
+private:
+ void (T::*f)();
+};
+
+template <class T>
+class const_mem_fun_t<void, T> : public unary_function<const T*, void> {
+public:
+ explicit const_mem_fun_t(void (T::*pf)() const) : f(pf) {}
+ void operator()(const T* p) const { (p->*f)(); }
+private:
+ void (T::*f)() const;
+};
+
+template <class T>
+class mem_fun_ref_t<void, T> : public unary_function<T, void> {
+public:
+ explicit mem_fun_ref_t(void (T::*pf)()) : f(pf) {}
+ void operator()(T& r) const { (r.*f)(); }
+private:
+ void (T::*f)();
+};
+
+template <class T>
+class const_mem_fun_ref_t<void, T> : public unary_function<T, void> {
+public:
+ explicit const_mem_fun_ref_t(void (T::*pf)() const) : f(pf) {}
+ void operator()(const T& r) const { (r.*f)(); }
+private:
+ void (T::*f)() const;
+};
+
+template <class T, class A>
+class mem_fun1_t<void, T, A> : public binary_function<T*, A, void> {
+public:
+ explicit mem_fun1_t(void (T::*pf)(A)) : f(pf) {}
+ void operator()(T* p, A x) const { (p->*f)(x); }
+private:
+ void (T::*f)(A);
+};
+
+template <class T, class A>
+class const_mem_fun1_t<void, T, A> : public binary_function<const T*, A, void> {
+public:
+ explicit const_mem_fun1_t(void (T::*pf)(A) const) : f(pf) {}
+ void operator()(const T* p, A x) const { (p->*f)(x); }
+private:
+ void (T::*f)(A) const;
+};
+
+template <class T, class A>
+class mem_fun1_ref_t<void, T, A> : public binary_function<T, A, void> {
+public:
+ explicit mem_fun1_ref_t(void (T::*pf)(A)) : f(pf) {}
+ void operator()(T& r, A x) const { (r.*f)(x); }
+private:
+ void (T::*f)(A);
+};
+
+template <class T, class A>
+class const_mem_fun1_ref_t<void, T, A> : public binary_function<T, A, void> {
+public:
+ explicit const_mem_fun1_ref_t(void (T::*pf)(A) const) : f(pf) {}
+ void operator()(const T& r, A x) const { (r.*f)(x); }
+private:
+ void (T::*f)(A) const;
+};
+
+#endif /* __STL_CLASS_PARTIAL_SPECIALIZATION */
+
+// Mem_fun adaptor helper functions. There are only four:
+// mem_fun, mem_fun_ref, mem_fun1, mem_fun1_ref.
+
+template <class S, class T>
+inline mem_fun_t<S,T> mem_fun(S (T::*f)()) {
+ return mem_fun_t<S,T>(f);
+}
+
+template <class S, class T>
+inline const_mem_fun_t<S,T> mem_fun(S (T::*f)() const) {
+ return const_mem_fun_t<S,T>(f);
+}
+
+template <class S, class T>
+inline mem_fun_ref_t<S,T> mem_fun_ref(S (T::*f)()) {
+ return mem_fun_ref_t<S,T>(f);
+}
+
+template <class S, class T>
+inline const_mem_fun_ref_t<S,T> mem_fun_ref(S (T::*f)() const) {
+ return const_mem_fun_ref_t<S,T>(f);
+}
+
+template <class S, class T, class A>
+inline mem_fun1_t<S,T,A> mem_fun1(S (T::*f)(A)) {
+ return mem_fun1_t<S,T,A>(f);
+}
+
+template <class S, class T, class A>
+inline const_mem_fun1_t<S,T,A> mem_fun1(S (T::*f)(A) const) {
+ return const_mem_fun1_t<S,T,A>(f);
+}
+
+template <class S, class T, class A>
+inline mem_fun1_ref_t<S,T,A> mem_fun1_ref(S (T::*f)(A)) {
+ return mem_fun1_ref_t<S,T,A>(f);
+}
+
+template <class S, class T, class A>
+inline const_mem_fun1_ref_t<S,T,A> mem_fun1_ref(S (T::*f)(A) const) {
+ return const_mem_fun1_ref_t<S,T,A>(f);
+}
+
+#endif /* __SGI_STL_FUNCTION_H */
diff --git a/libstdc++/stl/hash_map.h b/libstdc++/stl/hash_map.h
new file mode 100644
index 00000000000..c52b9936e7b
--- /dev/null
+++ b/libstdc++/stl/hash_map.h
@@ -0,0 +1,319 @@
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_HASH_MAP_H
+#define __SGI_STL_HASH_MAP_H
+
+#ifndef __SGI_STL_HASHTABLE_H
+#include <hashtable.h>
+#endif /* __SGI_STL_HASHTABLE_H */
+
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Key, class T, class HashFcn = hash<Key>,
+ class EqualKey = equal_to<Key>,
+ class Alloc = alloc>
+#else
+template <class Key, class T, class HashFcn, class EqualKey,
+ class Alloc = alloc>
+#endif
+class hash_map
+{
+private:
+ typedef hashtable<pair<const Key, T>, Key, HashFcn,
+ select1st<pair<const Key, T> >, EqualKey, Alloc> ht;
+ ht rep;
+
+public:
+ typedef ht::key_type key_type;
+ typedef ht::value_type value_type;
+ typedef ht::hasher hasher;
+ typedef ht::key_equal key_equal;
+ typedef T data_type;
+
+ typedef ht::size_type size_type;
+ typedef ht::difference_type difference_type;
+ typedef ht::pointer pointer;
+ typedef ht::const_pointer const_pointer;
+ typedef ht::reference reference;
+ typedef ht::const_reference const_reference;
+
+ typedef ht::iterator iterator;
+ typedef ht::const_iterator const_iterator;
+
+ hasher hash_funct() const { return rep.hash_funct(); }
+ key_equal key_eq() const { return rep.key_eq(); }
+
+public:
+ hash_map() : rep(100, hasher(), key_equal()) {}
+ explicit hash_map(size_type n) : rep(n, hasher(), key_equal()) {}
+ hash_map(size_type n, const hasher& hf) : rep(n, hf, key_equal()) {}
+ hash_map(size_type n, const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ hash_map(InputIterator f, InputIterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ template <class InputIterator>
+ hash_map(InputIterator f, InputIterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ template <class InputIterator>
+ hash_map(InputIterator f, InputIterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ template <class InputIterator>
+ hash_map(InputIterator f, InputIterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+
+#else
+ hash_map(const value_type* f, const value_type* l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ hash_map(const value_type* f, const value_type* l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ hash_map(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ hash_map(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+
+ hash_map(const_iterator f, const_iterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ hash_map(const_iterator f, const_iterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ hash_map(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ hash_map(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+#endif /*__STL_MEMBER_TEMPLATES */
+
+public:
+ size_type size() const { return rep.size(); }
+ size_type max_size() const { return rep.max_size(); }
+ bool empty() const { return rep.empty(); }
+ void swap(hash_map& hs) { rep.swap(hs.rep); }
+ friend bool operator==(const hash_map<Key,T,HashFcn,EqualKey,Alloc>&,
+ const hash_map<Key,T,HashFcn,EqualKey,Alloc>&);
+
+ iterator begin() { return rep.begin(); }
+ iterator end() { return rep.end(); }
+ const_iterator begin() const { return rep.begin(); }
+ const_iterator end() const { return rep.end(); }
+
+public:
+ pair<iterator, bool> insert(const value_type& obj)
+ { return rep.insert_unique(obj); }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(InputIterator f, InputIterator l) { rep.insert_unique(f,l); }
+#else
+ void insert(const value_type* f, const value_type* l) {
+ rep.insert_unique(f,l);
+ }
+ void insert(const_iterator f, const_iterator l) { rep.insert_unique(f, l); }
+#endif /*__STL_MEMBER_TEMPLATES */
+ pair<iterator, bool> insert_noresize(const value_type& obj)
+ { return rep.insert_unique_noresize(obj); }
+
+ iterator find(const key_type& key) { return rep.find(key); }
+ const_iterator find(const key_type& key) const { return rep.find(key); }
+
+ T& operator[](const key_type& key)
+ {
+ return rep.find_or_insert(value_type(key, T())).second;
+ }
+
+ size_type count(const key_type& key) const { return rep.count(key); }
+
+ pair<iterator, iterator> equal_range(const key_type& key)
+ { return rep.equal_range(key); }
+ pair<const_iterator, const_iterator> equal_range(const key_type& key) const
+ { return rep.equal_range(key); }
+
+ size_type erase(const key_type& key) {return rep.erase(key); }
+ void erase(iterator it) { rep.erase(it); }
+ void erase(iterator f, iterator l) { rep.erase(f, l); }
+ void clear() { rep.clear(); }
+
+public:
+ void resize(size_type hint) { rep.resize(hint); }
+ size_type bucket_count() const { return rep.bucket_count(); }
+ size_type max_bucket_count() const { return rep.max_bucket_count(); }
+ size_type elems_in_bucket(size_type n) const
+ { return rep.elems_in_bucket(n); }
+};
+
+template <class Key, class T, class HashFcn, class EqualKey, class Alloc>
+inline bool operator==(const hash_map<Key, T, HashFcn, EqualKey, Alloc>& hm1,
+ const hash_map<Key, T, HashFcn, EqualKey, Alloc>& hm2)
+{
+ return hm1.rep == hm2.rep;
+}
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Key, class T, class HashFcn = hash<Key>,
+ class EqualKey = equal_to<Key>,
+ class Alloc = alloc>
+#else
+template <class Key, class T, class HashFcn, class EqualKey,
+ class Alloc = alloc>
+#endif
+class hash_multimap
+{
+private:
+ typedef hashtable<pair<const Key, T>, Key, HashFcn,
+ select1st<pair<const Key, T> >, EqualKey, Alloc> ht;
+ ht rep;
+
+public:
+ typedef ht::key_type key_type;
+ typedef ht::value_type value_type;
+ typedef ht::hasher hasher;
+ typedef ht::key_equal key_equal;
+ typedef T data_type;
+
+ typedef ht::size_type size_type;
+ typedef ht::difference_type difference_type;
+ typedef ht::pointer pointer;
+ typedef ht::const_pointer const_pointer;
+ typedef ht::reference reference;
+ typedef ht::const_reference const_reference;
+
+ typedef ht::iterator iterator;
+ typedef ht::const_iterator const_iterator;
+
+ hasher hash_funct() const { return rep.hash_funct(); }
+ key_equal key_eq() const { return rep.key_eq(); }
+
+public:
+ hash_multimap() : rep(100, hasher(), key_equal()) {}
+ explicit hash_multimap(size_type n) : rep(n, hasher(), key_equal()) {}
+ hash_multimap(size_type n, const hasher& hf) : rep(n, hf, key_equal()) {}
+ hash_multimap(size_type n, const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ hash_multimap(InputIterator f, InputIterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ template <class InputIterator>
+ hash_multimap(InputIterator f, InputIterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ template <class InputIterator>
+ hash_multimap(InputIterator f, InputIterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ template <class InputIterator>
+ hash_multimap(InputIterator f, InputIterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+
+#else
+ hash_multimap(const value_type* f, const value_type* l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ hash_multimap(const value_type* f, const value_type* l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ hash_multimap(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ hash_multimap(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+
+ hash_multimap(const_iterator f, const_iterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ hash_multimap(const_iterator f, const_iterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ hash_multimap(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ hash_multimap(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+#endif /*__STL_MEMBER_TEMPLATES */
+
+public:
+ size_type size() const { return rep.size(); }
+ size_type max_size() const { return rep.max_size(); }
+ bool empty() const { return rep.empty(); }
+ void swap(hash_multimap& hs) { rep.swap(hs.rep); }
+ friend bool operator==(const hash_multimap<Key,T,HashFcn,EqualKey,Alloc>&,
+ const hash_multimap<Key,T,HashFcn,EqualKey,Alloc>&);
+
+ iterator begin() { return rep.begin(); }
+ iterator end() { return rep.end(); }
+ const_iterator begin() const { return rep.begin(); }
+ const_iterator end() const { return rep.end(); }
+
+public:
+ iterator insert(const value_type& obj) { return rep.insert_equal(obj); }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(InputIterator f, InputIterator l) { rep.insert_equal(f,l); }
+#else
+ void insert(const value_type* f, const value_type* l) {
+ rep.insert_equal(f,l);
+ }
+ void insert(const_iterator f, const_iterator l) { rep.insert_equal(f, l); }
+#endif /*__STL_MEMBER_TEMPLATES */
+ iterator insert_noresize(const value_type& obj)
+ { return rep.insert_equal_noresize(obj); }
+
+ iterator find(const key_type& key) { return rep.find(key); }
+ const_iterator find(const key_type& key) const { return rep.find(key); }
+
+ size_type count(const key_type& key) const { return rep.count(key); }
+
+ pair<iterator, iterator> equal_range(const key_type& key)
+ { return rep.equal_range(key); }
+ pair<const_iterator, const_iterator> equal_range(const key_type& key) const
+ { return rep.equal_range(key); }
+
+ size_type erase(const key_type& key) {return rep.erase(key); }
+ void erase(iterator it) { rep.erase(it); }
+ void erase(iterator f, iterator l) { rep.erase(f, l); }
+ void clear() { rep.clear(); }
+
+public:
+ void resize(size_type hint) { rep.resize(hint); }
+ size_type bucket_count() const { return rep.bucket_count(); }
+ size_type max_bucket_count() const { return rep.max_bucket_count(); }
+ size_type elems_in_bucket(size_type n) const
+ { return rep.elems_in_bucket(n); }
+};
+
+template <class Key, class T, class HF, class EqKey, class Alloc>
+inline bool operator==(const hash_multimap<Key, T, HF, EqKey, Alloc>& hm1,
+ const hash_multimap<Key, T, HF, EqKey, Alloc>& hm2)
+{
+ return hm1.rep == hm2.rep;
+}
+
+#endif /* __SGI_STL_HASH_MAP_H */
diff --git a/libstdc++/stl/hash_set.h b/libstdc++/stl/hash_set.h
new file mode 100644
index 00000000000..2c7125eb7e5
--- /dev/null
+++ b/libstdc++/stl/hash_set.h
@@ -0,0 +1,306 @@
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_HASH_SET_H
+#define __SGI_STL_HASH_SET_H
+
+#ifndef __SGI_STL_HASHTABLE_H
+#include <hashtable.h>
+#endif /* __SGI_STL_HASHTABLE_H */
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Value, class HashFcn = hash<Value>,
+ class EqualKey = equal_to<Value>,
+ class Alloc = alloc>
+#else
+template <class Value, class HashFcn, class EqualKey, class Alloc = alloc>
+#endif
+class hash_set
+{
+private:
+ typedef hashtable<Value, Value, HashFcn, identity<Value>,
+ EqualKey, Alloc> ht;
+ ht rep;
+
+public:
+ typedef ht::key_type key_type;
+ typedef ht::value_type value_type;
+ typedef ht::hasher hasher;
+ typedef ht::key_equal key_equal;
+
+ typedef ht::size_type size_type;
+ typedef ht::difference_type difference_type;
+ typedef ht::const_pointer pointer;
+ typedef ht::const_pointer const_pointer;
+ typedef ht::const_reference reference;
+ typedef ht::const_reference const_reference;
+
+ typedef ht::const_iterator iterator;
+ typedef ht::const_iterator const_iterator;
+
+ hasher hash_funct() const { return rep.hash_funct(); }
+ key_equal key_eq() const { return rep.key_eq(); }
+
+public:
+ hash_set() : rep(100, hasher(), key_equal()) {}
+ explicit hash_set(size_type n) : rep(n, hasher(), key_equal()) {}
+ hash_set(size_type n, const hasher& hf) : rep(n, hf, key_equal()) {}
+ hash_set(size_type n, const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ hash_set(InputIterator f, InputIterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ template <class InputIterator>
+ hash_set(InputIterator f, InputIterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ template <class InputIterator>
+ hash_set(InputIterator f, InputIterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ template <class InputIterator>
+ hash_set(InputIterator f, InputIterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+#else
+
+ hash_set(const value_type* f, const value_type* l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ hash_set(const value_type* f, const value_type* l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ hash_set(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ hash_set(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+
+ hash_set(const_iterator f, const_iterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ hash_set(const_iterator f, const_iterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_unique(f, l); }
+ hash_set(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_unique(f, l); }
+ hash_set(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_unique(f, l); }
+#endif /*__STL_MEMBER_TEMPLATES */
+
+public:
+ size_type size() const { return rep.size(); }
+ size_type max_size() const { return rep.max_size(); }
+ bool empty() const { return rep.empty(); }
+ void swap(hash_set& hs) { rep.swap(hs.rep); }
+ friend bool operator==(const hash_set<Value,HashFcn,EqualKey,Alloc>&,
+ const hash_set<Value,HashFcn,EqualKey,Alloc>&);
+
+ iterator begin() const { return rep.begin(); }
+ iterator end() const { return rep.end(); }
+
+public:
+ pair<iterator, bool> insert(const value_type& obj)
+ {
+ pair<ht::iterator, bool> p = rep.insert_unique(obj);
+ return pair<iterator, bool>(p.first, p.second);
+ }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(InputIterator f, InputIterator l) { rep.insert_unique(f,l); }
+#else
+ void insert(const value_type* f, const value_type* l) {
+ rep.insert_unique(f,l);
+ }
+ void insert(const_iterator f, const_iterator l) {rep.insert_unique(f, l); }
+#endif /*__STL_MEMBER_TEMPLATES */
+ pair<iterator, bool> insert_noresize(const value_type& obj)
+ {
+ pair<ht::iterator, bool> p = rep.insert_unique_noresize(obj);
+ return pair<iterator, bool>(p.first, p.second);
+ }
+
+ iterator find(const key_type& key) const { return rep.find(key); }
+
+ size_type count(const key_type& key) const { return rep.count(key); }
+
+ pair<iterator, iterator> equal_range(const key_type& key) const
+ { return rep.equal_range(key); }
+
+ size_type erase(const key_type& key) {return rep.erase(key); }
+ void erase(iterator it) { rep.erase(it); }
+ void erase(iterator f, iterator l) { rep.erase(f, l); }
+ void clear() { rep.clear(); }
+
+public:
+ void resize(size_type hint) { rep.resize(hint); }
+ size_type bucket_count() const { return rep.bucket_count(); }
+ size_type max_bucket_count() const { return rep.max_bucket_count(); }
+ size_type elems_in_bucket(size_type n) const
+ { return rep.elems_in_bucket(n); }
+};
+
+template <class Value, class HashFcn, class EqualKey, class Alloc>
+inline bool operator==(const hash_set<Value, HashFcn, EqualKey, Alloc>& hs1,
+ const hash_set<Value, HashFcn, EqualKey, Alloc>& hs2)
+{
+ return hs1.rep == hs2.rep;
+}
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Value, class HashFcn = hash<Value>,
+ class EqualKey = equal_to<Value>,
+ class Alloc = alloc>
+#else
+template <class Value, class HashFcn, class EqualKey, class Alloc = alloc>
+#endif
+class hash_multiset
+{
+private:
+ typedef hashtable<Value, Value, HashFcn, identity<Value>,
+ EqualKey, Alloc> ht;
+ ht rep;
+
+public:
+ typedef ht::key_type key_type;
+ typedef ht::value_type value_type;
+ typedef ht::hasher hasher;
+ typedef ht::key_equal key_equal;
+
+ typedef ht::size_type size_type;
+ typedef ht::difference_type difference_type;
+ typedef ht::const_pointer pointer;
+ typedef ht::const_pointer const_pointer;
+ typedef ht::const_reference reference;
+ typedef ht::const_reference const_reference;
+
+ typedef ht::const_iterator iterator;
+ typedef ht::const_iterator const_iterator;
+
+ hasher hash_funct() const { return rep.hash_funct(); }
+ key_equal key_eq() const { return rep.key_eq(); }
+
+public:
+ hash_multiset() : rep(100, hasher(), key_equal()) {}
+ explicit hash_multiset(size_type n) : rep(n, hasher(), key_equal()) {}
+ hash_multiset(size_type n, const hasher& hf) : rep(n, hf, key_equal()) {}
+ hash_multiset(size_type n, const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ hash_multiset(InputIterator f, InputIterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ template <class InputIterator>
+ hash_multiset(InputIterator f, InputIterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ template <class InputIterator>
+ hash_multiset(InputIterator f, InputIterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ template <class InputIterator>
+ hash_multiset(InputIterator f, InputIterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+#else
+
+ hash_multiset(const value_type* f, const value_type* l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ hash_multiset(const value_type* f, const value_type* l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ hash_multiset(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ hash_multiset(const value_type* f, const value_type* l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+
+ hash_multiset(const_iterator f, const_iterator l)
+ : rep(100, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ hash_multiset(const_iterator f, const_iterator l, size_type n)
+ : rep(n, hasher(), key_equal()) { rep.insert_equal(f, l); }
+ hash_multiset(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf)
+ : rep(n, hf, key_equal()) { rep.insert_equal(f, l); }
+ hash_multiset(const_iterator f, const_iterator l, size_type n,
+ const hasher& hf, const key_equal& eql)
+ : rep(n, hf, eql) { rep.insert_equal(f, l); }
+#endif /*__STL_MEMBER_TEMPLATES */
+
+public:
+ size_type size() const { return rep.size(); }
+ size_type max_size() const { return rep.max_size(); }
+ bool empty() const { return rep.empty(); }
+ void swap(hash_multiset& hs) { rep.swap(hs.rep); }
+ friend bool operator==(const hash_multiset<Value,HashFcn,EqualKey,Alloc>&,
+ const hash_multiset<Value,HashFcn,EqualKey,Alloc>&);
+
+ iterator begin() const { return rep.begin(); }
+ iterator end() const { return rep.end(); }
+
+public:
+ iterator insert(const value_type& obj) { return rep.insert_equal(obj); }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(InputIterator f, InputIterator l) { rep.insert_equal(f,l); }
+#else
+ void insert(const value_type* f, const value_type* l) {
+ rep.insert_equal(f,l);
+ }
+ void insert(const_iterator f, const_iterator l) { rep.insert_equal(f, l); }
+#endif /*__STL_MEMBER_TEMPLATES */
+ iterator insert_noresize(const value_type& obj)
+ { return rep.insert_equal_noresize(obj); }
+
+ iterator find(const key_type& key) const { return rep.find(key); }
+
+ size_type count(const key_type& key) const { return rep.count(key); }
+
+ pair<iterator, iterator> equal_range(const key_type& key) const
+ { return rep.equal_range(key); }
+
+ size_type erase(const key_type& key) {return rep.erase(key); }
+ void erase(iterator it) { rep.erase(it); }
+ void erase(iterator f, iterator l) { rep.erase(f, l); }
+ void clear() { rep.clear(); }
+
+public:
+ void resize(size_type hint) { rep.resize(hint); }
+ size_type bucket_count() const { return rep.bucket_count(); }
+ size_type max_bucket_count() const { return rep.max_bucket_count(); }
+ size_type elems_in_bucket(size_type n) const
+ { return rep.elems_in_bucket(n); }
+};
+
+template <class Val, class HashFcn, class EqualKey, class Alloc>
+inline bool operator==(const hash_multiset<Val, HashFcn, EqualKey, Alloc>& hs1,
+ const hash_multiset<Val, HashFcn, EqualKey, Alloc>& hs2)
+{
+ return hs1.rep == hs2.rep;
+}
+
+
+#endif /* __SGI_STL_HASH_SET_H */
diff --git a/libstdc++/stl/hashtable.h b/libstdc++/stl/hashtable.h
new file mode 100644
index 00000000000..420d7a8545a
--- /dev/null
+++ b/libstdc++/stl/hashtable.h
@@ -0,0 +1,1013 @@
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_HASHTABLE_H
+#define __SGI_STL_HASHTABLE_H
+
+// Hashtable class, used to implement the hashed associative containers
+// hash_set, hash_map, hash_multiset, and hash_multimap.
+
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <algo.h>
+#include <vector.h>
+
+
+template <class Key> struct hash { };
+
+inline size_t __stl_hash_string(const char* s)
+{
+ unsigned long h = 0;
+ for ( ; *s; ++s)
+ h = 5*h + *s;
+
+ return size_t(h);
+}
+
+struct hash<char*>
+{
+ size_t operator()(const char* s) const { return __stl_hash_string(s); }
+};
+
+struct hash<const char*>
+{
+ size_t operator()(const char* s) const { return __stl_hash_string(s); }
+};
+
+struct hash<char> {
+ size_t operator()(char x) const { return x; }
+};
+struct hash<unsigned char> {
+ size_t operator()(unsigned char x) const { return x; }
+};
+struct hash<signed char> {
+ size_t operator()(unsigned char x) const { return x; }
+};
+struct hash<short> {
+ size_t operator()(short x) const { return x; }
+};
+struct hash<unsigned short> {
+ size_t operator()(unsigned short x) const { return x; }
+};
+struct hash<int> {
+ size_t operator()(int x) const { return x; }
+};
+struct hash<unsigned int> {
+ size_t operator()(unsigned int x) const { return x; }
+};
+struct hash<long> {
+ size_t operator()(long x) const { return x; }
+};
+struct hash<unsigned long> {
+ size_t operator()(unsigned long x) const { return x; }
+};
+
+template <class Value>
+struct __hashtable_node
+{
+ __hashtable_node* next;
+ Value val;
+};
+
+template <class Value, class Key, class HashFcn,
+ class ExtractKey, class EqualKey, class Alloc = alloc>
+class hashtable;
+
+template <class Value, class Key, class HashFcn,
+ class ExtractKey, class EqualKey, class Alloc>
+struct __hashtable_iterator;
+
+template <class Value, class Key, class HashFcn,
+ class ExtractKey, class EqualKey, class Alloc>
+struct __hashtable_const_iterator;
+
+template <class Value, class Key, class HashFcn,
+ class ExtractKey, class EqualKey, class Alloc>
+struct __hashtable_iterator {
+ typedef hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>
+ hashtable;
+ typedef __hashtable_iterator<Value, Key, HashFcn,
+ ExtractKey, EqualKey, Alloc>
+ iterator;
+ typedef __hashtable_const_iterator<Value, Key, HashFcn,
+ ExtractKey, EqualKey, Alloc>
+ const_iterator;
+ typedef __hashtable_node<Value> node;
+
+ typedef forward_iterator_tag iterator_category;
+ typedef Value value_type;
+ typedef ptrdiff_t difference_type;
+ typedef size_t size_type;
+ typedef Value& reference;
+ typedef const Value& const_reference;
+ typedef Value* pointer;
+
+ node* cur;
+ hashtable* ht;
+
+ __hashtable_iterator(node* n, hashtable* tab) : cur(n), ht(tab) {}
+ __hashtable_iterator() {}
+ reference operator*() const { return cur->val; }
+ iterator& operator++();
+ iterator operator++(int);
+ bool operator==(const iterator& it) const { return cur == it.cur; }
+ bool operator!=(const iterator& it) const { return cur != it.cur; }
+};
+
+
+template <class Value, class Key, class HashFcn,
+ class ExtractKey, class EqualKey, class Alloc>
+struct __hashtable_const_iterator {
+ typedef hashtable<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>
+ hashtable;
+ typedef __hashtable_iterator<Value, Key, HashFcn,
+ ExtractKey, EqualKey, Alloc>
+ iterator;
+ typedef __hashtable_const_iterator<Value, Key, HashFcn,
+ ExtractKey, EqualKey, Alloc>
+ const_iterator;
+ typedef __hashtable_node<Value> node;
+
+ typedef forward_iterator_tag iterator_category;
+ typedef Value value_type;
+ typedef ptrdiff_t difference_type;
+ typedef size_t size_type;
+ typedef Value& reference;
+ typedef const Value& const_reference;
+ typedef Value* pointer;
+
+ const node* cur;
+ const hashtable* ht;
+
+ __hashtable_const_iterator(const node* n, const hashtable* tab)
+ : cur(n), ht(tab) {}
+ __hashtable_const_iterator() {}
+ __hashtable_const_iterator(const iterator& it) : cur(it.cur), ht(it.ht) {}
+ const_reference operator*() const { return cur->val; }
+ const_iterator& operator++();
+ const_iterator operator++(int);
+ bool operator==(const const_iterator& it) const { return cur == it.cur; }
+ bool operator!=(const const_iterator& it) const { return cur != it.cur; }
+};
+
+// Note: assumes long is at least 32 bits.
+static const int __stl_num_primes = 28;
+static const unsigned long __stl_prime_list[__stl_num_primes] =
+{
+ 53, 97, 193, 389, 769,
+ 1543, 3079, 6151, 12289, 24593,
+ 49157, 98317, 196613, 393241, 786433,
+ 1572869, 3145739, 6291469, 12582917, 25165843,
+ 50331653, 100663319, 201326611, 402653189, 805306457,
+ 1610612741, 3221225473, 4294967291
+};
+
+inline unsigned long __stl_next_prime(unsigned long n)
+{
+ const unsigned long* first = __stl_prime_list;
+ const unsigned long* last = __stl_prime_list + __stl_num_primes;
+ const unsigned long* pos = lower_bound(first, last, n);
+ return pos == last ? *(last - 1) : *pos;
+}
+
+
+template <class Value, class Key, class HashFcn,
+ class ExtractKey, class EqualKey,
+ class Alloc>
+class hashtable {
+public:
+ typedef Key key_type;
+ typedef Value value_type;
+ typedef HashFcn hasher;
+ typedef EqualKey key_equal;
+
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef value_type* pointer;
+ typedef const value_type* const_pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+
+ hasher hash_funct() const { return hash; }
+ key_equal key_eq() const { return equals; }
+
+private:
+ hasher hash;
+ key_equal equals;
+ ExtractKey get_key;
+
+ typedef __hashtable_node<Value> node;
+ typedef simple_alloc<node, Alloc> node_allocator;
+
+ vector<node*,Alloc> buckets;
+ size_type num_elements;
+
+public:
+ typedef __hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey,
+ Alloc>
+ iterator;
+
+ typedef __hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey,
+ Alloc>
+ const_iterator;
+
+ friend struct
+ __hashtable_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>;
+ friend struct
+ __hashtable_const_iterator<Value, Key, HashFcn, ExtractKey, EqualKey, Alloc>;
+
+public:
+ hashtable(size_type n,
+ const HashFcn& hf,
+ const EqualKey& eql,
+ const ExtractKey& ext)
+ : hash(hf), equals(eql), get_key(ext), num_elements(0)
+ {
+ initialize_buckets(n);
+ }
+
+ hashtable(size_type n,
+ const HashFcn& hf,
+ const EqualKey& eql)
+ : hash(hf), equals(eql), get_key(ExtractKey()), num_elements(0)
+ {
+ initialize_buckets(n);
+ }
+
+ hashtable(const hashtable& ht)
+ : hash(ht.hash), equals(ht.equals), get_key(ht.get_key), num_elements(0)
+ {
+ copy_from(ht);
+ }
+
+ hashtable& operator= (const hashtable& ht)
+ {
+ if (&ht != this) {
+ clear();
+ hash = ht.hash;
+ equals = ht.equals;
+ get_key = ht.get_key;
+ copy_from(ht);
+ }
+ return *this;
+ }
+
+ ~hashtable() { clear(); }
+
+ size_type size() const { return num_elements; }
+ size_type max_size() const { return size_type(-1); }
+ bool empty() const { return size() == 0; }
+
+ void swap(hashtable& ht)
+ {
+ ::swap(hash, ht.hash);
+ ::swap(equals, ht.equals);
+ ::swap(get_key, ht.get_key);
+ buckets.swap(ht.buckets);
+ ::swap(num_elements, ht.num_elements);
+ }
+
+ iterator begin()
+ {
+ for (size_type n = 0; n < buckets.size(); ++n)
+ if (buckets[n])
+ return iterator(buckets[n], this);
+ return end();
+ }
+
+ iterator end() { return iterator(0, this); }
+
+ const_iterator begin() const
+ {
+ for (size_type n = 0; n < buckets.size(); ++n)
+ if (buckets[n])
+ return const_iterator(buckets[n], this);
+ return end();
+ }
+
+ const_iterator end() const { return const_iterator(0, this); }
+
+ friend bool operator== (const hashtable<Value, Key,
+ HashFcn, ExtractKey, EqualKey,
+ Alloc>&,
+ const hashtable<Value, Key,
+ HashFcn, ExtractKey, EqualKey,
+ Alloc>&);
+
+public:
+
+ size_type bucket_count() const { return buckets.size(); }
+
+ size_type max_bucket_count() const
+ { return __stl_prime_list[__stl_num_primes - 1]; }
+
+ size_type elems_in_bucket(size_type bucket) const
+ {
+ size_type result = 0;
+ for (node* cur = buckets[bucket]; cur; cur = cur->next)
+ result += 1;
+ return result;
+ }
+
+ pair<iterator, bool> insert_unique(const value_type& obj)
+ {
+ resize(num_elements + 1);
+ return insert_unique_noresize(obj);
+ }
+
+ iterator insert_equal(const value_type& obj)
+ {
+ resize(num_elements + 1);
+ return insert_equal_noresize(obj);
+ }
+
+ pair<iterator, bool> insert_unique_noresize(const value_type& obj);
+ iterator insert_equal_noresize(const value_type& obj);
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert_unique(InputIterator f, InputIterator l)
+ {
+ insert_unique(f, l, iterator_category(f));
+ }
+
+ template <class InputIterator>
+ void insert_equal(InputIterator f, InputIterator l)
+ {
+ insert_equal(f, l, iterator_category(f));
+ }
+
+ template <class InputIterator>
+ void insert_unique(InputIterator f, InputIterator l,
+ input_iterator_tag)
+ {
+ for ( ; f != l; ++f)
+ insert_unique(*f);
+ }
+
+ template <class InputIterator>
+ void insert_equal(InputIterator f, InputIterator l,
+ input_iterator_tag)
+ {
+ for ( ; f != l; ++f)
+ insert_equal(*f);
+ }
+
+ template <class ForwardIterator>
+ void insert_unique(ForwardIterator f, ForwardIterator l,
+ forward_iterator_tag)
+ {
+ size_type n = 0;
+ distance(f, l, n);
+ resize(num_elements + n);
+ for ( ; n > 0; --n, ++f)
+ insert_unique_noresize(*f);
+ }
+
+ template <class ForwardIterator>
+ void insert_equal(ForwardIterator f, ForwardIterator l,
+ forward_iterator_tag)
+ {
+ size_type n = 0;
+ distance(f, l, n);
+ resize(num_elements + n);
+ for ( ; n > 0; --n, ++f)
+ insert_equal_noresize(*f);
+ }
+
+ template <class BidirectionalIterator>
+ void insert_unique(BidirectionalIterator f, BidirectionalIterator l,
+ bidirectional_iterator_tag)
+ {
+ insert_unique(f, l, forward_iterator_tag());
+ }
+
+ template <class BidirectionalIterator>
+ void insert_equal(BidirectionalIterator f, BidirectionalIterator l,
+ bidirectional_iterator_tag)
+ {
+ insert_equal(f, l, forward_iterator_tag());
+ }
+
+ template <class RandomAccessIterator>
+ void insert_unique(RandomAccessIterator f, RandomAccessIterator l,
+ random_access_iterator_tag)
+ {
+ insert_unique(f, l, forward_iterator_tag());
+ }
+
+ template <class RandomAccessIterator>
+ void insert_equal(RandomAccessIterator f, RandomAccessIterator l,
+ random_access_iterator_tag)
+ {
+ insert_equal(f, l, forward_iterator_tag());
+ }
+
+#else /* __STL_MEMBER_TEMPLATES */
+ void insert_unique(const value_type* f, const value_type* l)
+ {
+ size_type n = l - f;
+ resize(num_elements + n);
+ for ( ; n > 0; --n, ++f)
+ insert_unique_noresize(*f);
+ }
+
+ void insert_equal(const value_type* f, const value_type* l)
+ {
+ size_type n = l - f;
+ resize(num_elements + n);
+ for ( ; n > 0; --n, ++f)
+ insert_equal_noresize(*f);
+ }
+
+ void insert_unique(const_iterator f, const_iterator l)
+ {
+ size_type n = 0;
+ distance(f, l, n);
+ resize(num_elements + n);
+ for ( ; n > 0; --n, ++f)
+ insert_unique_noresize(*f);
+ }
+
+ void insert_equal(const_iterator f, const_iterator l)
+ {
+ size_type n = 0;
+ distance(f, l, n);
+ resize(num_elements + n);
+ for ( ; n > 0; --n, ++f)
+ insert_equal_noresize(*f);
+ }
+#endif /*__STL_MEMBER_TEMPLATES */
+
+ reference find_or_insert(const value_type& obj);
+
+ iterator find(const key_type& key)
+ {
+ size_type n = bkt_num_key(key);
+ node* first;
+ for ( first = buckets[n];
+ first && !equals(get_key(first->val), key);
+ first = first->next)
+ {}
+ return iterator(first, this);
+ }
+
+ const_iterator find(const key_type& key) const
+ {
+ size_type n = bkt_num_key(key);
+ const node* first;
+ for ( first = buckets[n];
+ first && !equals(get_key(first->val), key);
+ first = first->next)
+ {}
+ return const_iterator(first, this);
+ }
+
+ size_type count(const key_type& key) const
+ {
+ const size_type n = bkt_num_key(key);
+ size_type result = 0;
+
+ for (const node* cur = buckets[n]; cur; cur = cur->next)
+ if (equals(get_key(cur->val), key))
+ ++result;
+ return result;
+ }
+
+ pair<iterator, iterator> equal_range(const key_type& key);
+ pair<const_iterator, const_iterator> equal_range(const key_type& key) const;
+
+ size_type erase(const key_type& key);
+ void erase(const iterator& it);
+ void erase(iterator first, iterator last);
+
+ void erase(const const_iterator& it);
+ void erase(const_iterator first, const_iterator last);
+
+ void resize(size_type num_elements_hint);
+ void clear();
+
+private:
+ size_type next_size(size_type n) const { return __stl_next_prime(n); }
+
+ void initialize_buckets(size_type n)
+ {
+ const size_type n_buckets = next_size(n);
+ buckets.reserve(n_buckets);
+ buckets.insert(buckets.end(), n_buckets, (node*) 0);
+ num_elements = 0;
+ }
+
+ size_type bkt_num_key(const key_type& key) const
+ {
+ return bkt_num_key(key, buckets.size());
+ }
+
+ size_type bkt_num(const value_type& obj) const
+ {
+ return bkt_num_key(get_key(obj));
+ }
+
+ size_type bkt_num_key(const key_type& key, size_t n) const
+ {
+ return hash(key) % n;
+ }
+
+ size_type bkt_num(const value_type& obj, size_t n) const
+ {
+ return bkt_num_key(get_key(obj), n);
+ }
+
+ node* new_node(const value_type& obj)
+ {
+ node* n = node_allocator::allocate();
+ n->next = 0;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ construct(&n->val, obj);
+ return n;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ node_allocator::deallocate(n);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+ void delete_node(node* n)
+ {
+ destroy(&n->val);
+ node_allocator::deallocate(n);
+ }
+
+ void erase_bucket(const size_type n, node* first, node* last);
+ void erase_bucket(const size_type n, node* last);
+
+ void copy_from(const hashtable& ht);
+
+};
+
+template <class V, class K, class HF, class ExK, class EqK, class A>
+__hashtable_iterator<V, K, HF, ExK, EqK, A>&
+__hashtable_iterator<V, K, HF, ExK, EqK, A>::operator++()
+{
+ const node* old = cur;
+ cur = cur->next;
+ if (!cur) {
+ size_type bucket = ht->bkt_num(old->val);
+ while (!cur && ++bucket < ht->buckets.size())
+ cur = ht->buckets[bucket];
+ }
+ return *this;
+}
+
+template <class V, class K, class HF, class ExK, class EqK, class A>
+inline __hashtable_iterator<V, K, HF, ExK, EqK, A>
+__hashtable_iterator<V, K, HF, ExK, EqK, A>::operator++(int)
+{
+ iterator tmp = *this;
+ ++*this;
+ return tmp;
+}
+
+template <class V, class K, class HF, class ExK, class EqK, class A>
+__hashtable_const_iterator<V, K, HF, ExK, EqK, A>&
+__hashtable_const_iterator<V, K, HF, ExK, EqK, A>::operator++()
+{
+ const node* old = cur;
+ cur = cur->next;
+ if (!cur) {
+ size_type bucket = ht->bkt_num(old->val);
+ while (!cur && ++bucket < ht->buckets.size())
+ cur = ht->buckets[bucket];
+ }
+ return *this;
+}
+
+template <class V, class K, class HF, class ExK, class EqK, class A>
+inline __hashtable_const_iterator<V, K, HF, ExK, EqK, A>
+__hashtable_const_iterator<V, K, HF, ExK, EqK, A>::operator++(int)
+{
+ const_iterator tmp = *this;
+ ++*this;
+ return tmp;
+}
+
+
+template <class V, class K, class HF, class ExK, class EqK, class All>
+inline forward_iterator_tag
+iterator_category(const __hashtable_iterator<V, K, HF, ExK, EqK, All>&)
+{
+ return forward_iterator_tag();
+}
+
+template <class V, class K, class HF, class ExK, class EqK, class All>
+inline V* value_type(const __hashtable_iterator<V, K, HF, ExK, EqK, All>&)
+{
+ return (V*) 0;
+}
+
+template <class V, class K, class HF, class ExK, class EqK, class All>
+inline hashtable<V, K, HF, ExK, EqK, All>::difference_type*
+distance_type(const __hashtable_iterator<V, K, HF, ExK, EqK, All>&)
+{
+ return (hashtable<V, K, HF, ExK, EqK, All>::difference_type*) 0;
+}
+
+template <class V, class K, class HF, class ExK, class EqK, class All>
+inline forward_iterator_tag
+iterator_category(const __hashtable_const_iterator<V, K, HF, ExK, EqK, All>&)
+{
+ return forward_iterator_tag();
+}
+
+template <class V, class K, class HF, class ExK, class EqK, class All>
+inline V*
+value_type(const __hashtable_const_iterator<V, K, HF, ExK, EqK, All>&)
+{
+ return (V*) 0;
+}
+
+template <class V, class K, class HF, class ExK, class EqK, class All>
+inline hashtable<V, K, HF, ExK, EqK, All>::difference_type*
+distance_type(const __hashtable_const_iterator<V, K, HF, ExK, EqK, All>&)
+{
+ return (hashtable<V, K, HF, ExK, EqK, All>::difference_type*) 0;
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+bool operator==(const hashtable<V, K, HF, Ex, Eq, A>& ht1,
+ const hashtable<V, K, HF, Ex, Eq, A>& ht2)
+{
+ typedef hashtable<V, K, HF, Ex, Eq, A>::node node;
+ if (ht1.buckets.size() != ht2.buckets.size())
+ return false;
+ for (int n = 0; n < ht1.buckets.size(); ++n) {
+ node* cur1 = ht1.buckets[n];
+ node* cur2 = ht2.buckets[n];
+ for ( ; cur1 && cur2 && cur1->val == cur2->val;
+ cur1 = cur1->next, cur2 = cur2->next)
+ {}
+ if (cur1 || cur2)
+ return false;
+ }
+ return true;
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+pair<hashtable<V, K, HF, Ex, Eq, A>::iterator, bool>
+hashtable<V, K, HF, Ex, Eq, A>::insert_unique_noresize(const value_type& obj)
+{
+ const size_type n = bkt_num(obj);
+ node* first = buckets[n];
+
+ for (node* cur = first; cur; cur = cur->next)
+ if (equals(get_key(cur->val), get_key(obj)))
+ return pair<iterator, bool>(iterator(cur, this), false);
+
+ node* tmp = new_node(obj);
+ tmp->next = first;
+ buckets[n] = tmp;
+ ++num_elements;
+ return pair<iterator, bool>(iterator(tmp, this), true);
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+hashtable<V, K, HF, Ex, Eq, A>::iterator
+hashtable<V, K, HF, Ex, Eq, A>::insert_equal_noresize(const value_type& obj)
+{
+ const size_type n = bkt_num(obj);
+ node* first = buckets[n];
+
+ for (node* cur = first; cur; cur = cur->next)
+ if (equals(get_key(cur->val), get_key(obj))) {
+ node* tmp = new_node(obj);
+ tmp->next = cur->next;
+ cur->next = tmp;
+ ++num_elements;
+ return iterator(tmp, this);
+ }
+
+ node* tmp = new_node(obj);
+ tmp->next = first;
+ buckets[n] = tmp;
+ ++num_elements;
+ return iterator(tmp, this);
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+hashtable<V, K, HF, Ex, Eq, A>::reference
+hashtable<V, K, HF, Ex, Eq, A>::find_or_insert(const value_type& obj)
+{
+ resize(num_elements + 1);
+
+ size_type n = bkt_num(obj);
+ node* first = buckets[n];
+
+ for (node* cur = first; cur; cur = cur->next)
+ if (equals(get_key(cur->val), get_key(obj)))
+ return cur->val;
+
+ node* tmp = new_node(obj);
+ tmp->next = first;
+ buckets[n] = tmp;
+ ++num_elements;
+ return tmp->val;
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+pair<hashtable<V, K, HF, Ex, Eq, A>::iterator,
+ hashtable<V, K, HF, Ex, Eq, A>::iterator>
+hashtable<V, K, HF, Ex, Eq, A>::equal_range(const key_type& key)
+{
+ typedef pair<iterator, iterator> pii;
+ const size_type n = bkt_num_key(key);
+
+ for (node* first = buckets[n]; first; first = first->next) {
+ if (equals(get_key(first->val), key)) {
+ for (node* cur = first->next; cur; cur = cur->next)
+ if (!equals(get_key(cur->val), key))
+ return pii(iterator(first, this), iterator(cur, this));
+ for (size_type m = n + 1; m < buckets.size(); ++m)
+ if (buckets[m])
+ return pii(iterator(first, this),
+ iterator(buckets[m], this));
+ return pii(iterator(first, this), end());
+ }
+ }
+ return pii(end(), end());
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+pair<hashtable<V, K, HF, Ex, Eq, A>::const_iterator,
+ hashtable<V, K, HF, Ex, Eq, A>::const_iterator>
+hashtable<V, K, HF, Ex, Eq, A>::equal_range(const key_type& key) const
+{
+ typedef pair<const_iterator, const_iterator> pii;
+ const size_type n = bkt_num_key(key);
+
+ for (const node* first = buckets[n] ; first; first = first->next) {
+ if (equals(get_key(first->val), key)) {
+ for (const node* cur = first->next; cur; cur = cur->next)
+ if (!equals(get_key(cur->val), key))
+ return pii(const_iterator(first, this),
+ const_iterator(cur, this));
+ for (size_type m = n + 1; m < buckets.size(); ++m)
+ if (buckets[m])
+ return pii(const_iterator(first, this),
+ const_iterator(buckets[m], this));
+ return pii(const_iterator(first, this), end());
+ }
+ }
+ return pii(end(), end());
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+hashtable<V, K, HF, Ex, Eq, A>::size_type
+hashtable<V, K, HF, Ex, Eq, A>::erase(const key_type& key)
+{
+ const size_type n = bkt_num_key(key);
+ node* first = buckets[n];
+ size_type erased = 0;
+
+ if (first) {
+ node* cur = first;
+ node* next = cur->next;
+ while (next) {
+ if (equals(get_key(next->val), key)) {
+ cur->next = next->next;
+ delete_node(next);
+ next = cur->next;
+ ++erased;
+ --num_elements;
+ }
+ else {
+ cur = next;
+ next = cur->next;
+ }
+ }
+ if (equals(get_key(first->val), key)) {
+ buckets[n] = first->next;
+ delete_node(first);
+ ++erased;
+ --num_elements;
+ }
+ }
+ return erased;
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+void hashtable<V, K, HF, Ex, Eq, A>::erase(const iterator& it)
+{
+ if (node* const p = it.cur) {
+ const size_type n = bkt_num(p->val);
+ node* cur = buckets[n];
+
+ if (cur == p) {
+ buckets[n] = cur->next;
+ delete_node(cur);
+ --num_elements;
+ }
+ else {
+ node* next = cur->next;
+ while (next) {
+ if (next == p) {
+ cur->next = next->next;
+ delete_node(next);
+ --num_elements;
+ break;
+ }
+ else {
+ cur = next;
+ next = cur->next;
+ }
+ }
+ }
+ }
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+void hashtable<V, K, HF, Ex, Eq, A>::erase(iterator first, iterator last)
+{
+ size_type f_bucket = first.cur ? bkt_num(first.cur->val) : buckets.size();
+ size_type l_bucket = last.cur ? bkt_num(last.cur->val) : buckets.size();
+
+ if (first.cur == last.cur)
+ return;
+ else if (f_bucket == l_bucket)
+ erase_bucket(f_bucket, first.cur, last.cur);
+ else {
+ erase_bucket(f_bucket, first.cur, 0);
+ for (size_type n = f_bucket + 1; n < l_bucket; ++n)
+ erase_bucket(n, 0);
+ if (l_bucket != buckets.size())
+ erase_bucket(l_bucket, last.cur);
+ }
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+inline void
+hashtable<V, K, HF, Ex, Eq, A>::erase(const_iterator first,
+ const_iterator last)
+{
+ erase(iterator(const_cast<hashtable::node*>(first.cur),
+ const_cast<hashtable*>(first.ht)),
+ iterator(const_cast<hashtable::node*>(last.cur),
+ const_cast<hashtable*>(last.ht)));
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+inline void
+hashtable<V, K, HF, Ex, Eq, A>::erase(const const_iterator& it)
+{
+ erase(iterator(const_cast<hashtable::node*>(it.cur),
+ const_cast<hashtable*>(it.ht)));
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+void hashtable<V, K, HF, Ex, Eq, A>::resize(size_type num_elements_hint)
+{
+ const size_type old_n = buckets.size();
+ if (num_elements_hint > old_n) {
+ const size_type n = next_size(num_elements_hint);
+ if (n > old_n) {
+ vector<node*, A> tmp(n, (node*) 0);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for (size_type bucket = 0; bucket < old_n; ++bucket) {
+ node* first = buckets[bucket];
+ while (first) {
+ size_type new_bucket = bkt_num(first->val, n);
+ buckets[bucket] = first->next;
+ first->next = tmp[new_bucket];
+ tmp[new_bucket] = first;
+ first = buckets[bucket];
+ }
+ }
+ buckets.swap(tmp);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ for (size_type bucket = 0; bucket < tmp.size(); ++bucket) {
+ while (tmp[bucket]) {
+ node* next = tmp[bucket]->next;
+ delete_node(tmp[bucket]);
+ tmp[bucket] = next;
+ }
+ }
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ }
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+void hashtable<V, K, HF, Ex, Eq, A>::erase_bucket(const size_type n,
+ node* first, node* last)
+{
+ node* cur = buckets[n];
+ if (cur == first)
+ erase_bucket(n, last);
+ else {
+ node* next;
+ for (next = cur->next; next != first; cur = next, next = cur->next)
+ ;
+ while (next) {
+ cur->next = next->next;
+ delete_node(next);
+ next = cur->next;
+ --num_elements;
+ }
+ }
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+void
+hashtable<V, K, HF, Ex, Eq, A>::erase_bucket(const size_type n, node* last)
+{
+ node* cur = buckets[n];
+ while (cur != last) {
+ node* next = cur->next;
+ delete_node(cur);
+ cur = next;
+ buckets[n] = cur;
+ --num_elements;
+ }
+}
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+void hashtable<V, K, HF, Ex, Eq, A>::clear()
+{
+ for (size_type i = 0; i < buckets.size(); ++i) {
+ node* cur = buckets[i];
+ while (cur != 0) {
+ node* next = cur->next;
+ delete_node(cur);
+ cur = next;
+ }
+ buckets[i] = 0;
+ }
+ num_elements = 0;
+}
+
+
+template <class V, class K, class HF, class Ex, class Eq, class A>
+void hashtable<V, K, HF, Ex, Eq, A>::copy_from(const hashtable& ht)
+{
+ buckets.clear();
+ buckets.reserve(ht.buckets.size());
+ buckets.insert(buckets.end(), ht.buckets.size(), (node*) 0);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ for (size_type i = 0; i < ht.buckets.size(); ++i) {
+ if (const node* cur = ht.buckets[i]) {
+ node* copy = new_node(cur->val);
+ buckets[i] = copy;
+
+ for (node* next = cur->next; next; cur = next, next = cur->next) {
+ copy->next = new_node(next->val);
+ copy = copy->next;
+ }
+ }
+ }
+ num_elements = ht.num_elements;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+}
+
+
+#endif /* __SGI_STL_HASHTABLE_H */
diff --git a/libstdc++/stl/heap.h b/libstdc++/stl/heap.h
new file mode 100644
index 00000000000..b24afafadd6
--- /dev/null
+++ b/libstdc++/stl/heap.h
@@ -0,0 +1,204 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_HEAP_H
+#define __SGI_STL_HEAP_H
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+#pragma set woff 1209
+#endif
+
+template <class RandomAccessIterator, class Distance, class T>
+void __push_heap(RandomAccessIterator first, Distance holeIndex,
+ Distance topIndex, T value) {
+ Distance parent = (holeIndex - 1) / 2;
+ while (holeIndex > topIndex && *(first + parent) < value) {
+ *(first + holeIndex) = *(first + parent);
+ holeIndex = parent;
+ parent = (holeIndex - 1) / 2;
+ }
+ *(first + holeIndex) = value;
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+inline void __push_heap_aux(RandomAccessIterator first,
+ RandomAccessIterator last, Distance*, T*) {
+ __push_heap(first, Distance((last - first) - 1), Distance(0),
+ T(*(last - 1)));
+}
+
+template <class RandomAccessIterator>
+inline void push_heap(RandomAccessIterator first, RandomAccessIterator last) {
+ __push_heap_aux(first, last, distance_type(first), value_type(first));
+}
+
+template <class RandomAccessIterator, class Distance, class T, class Compare>
+void __push_heap(RandomAccessIterator first, Distance holeIndex,
+ Distance topIndex, T value, Compare comp) {
+ Distance parent = (holeIndex - 1) / 2;
+ while (holeIndex > topIndex && comp(*(first + parent), value)) {
+ *(first + holeIndex) = *(first + parent);
+ holeIndex = parent;
+ parent = (holeIndex - 1) / 2;
+ }
+ *(first + holeIndex) = value;
+}
+
+template <class RandomAccessIterator, class Compare, class Distance, class T>
+inline void __push_heap_aux(RandomAccessIterator first,
+ RandomAccessIterator last, Compare comp,
+ Distance*, T*) {
+ __push_heap(first, Distance((last - first) - 1), Distance(0),
+ T(*(last - 1)), comp);
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void push_heap(RandomAccessIterator first, RandomAccessIterator last,
+ Compare comp) {
+ __push_heap_aux(first, last, comp, distance_type(first), value_type(first));
+}
+
+template <class RandomAccessIterator, class Distance, class T>
+void __adjust_heap(RandomAccessIterator first, Distance holeIndex,
+ Distance len, T value) {
+ Distance topIndex = holeIndex;
+ Distance secondChild = 2 * holeIndex + 2;
+ while (secondChild < len) {
+ if (*(first + secondChild) < *(first + (secondChild - 1)))
+ secondChild--;
+ *(first + holeIndex) = *(first + secondChild);
+ holeIndex = secondChild;
+ secondChild = 2 * (secondChild + 1);
+ }
+ if (secondChild == len) {
+ *(first + holeIndex) = *(first + (secondChild - 1));
+ holeIndex = secondChild - 1;
+ }
+ __push_heap(first, holeIndex, topIndex, value);
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+inline void __pop_heap(RandomAccessIterator first, RandomAccessIterator last,
+ RandomAccessIterator result, T value, Distance*) {
+ *result = *first;
+ __adjust_heap(first, Distance(0), Distance(last - first), value);
+}
+
+template <class RandomAccessIterator, class T>
+inline void __pop_heap_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*) {
+ __pop_heap(first, last - 1, last - 1, T(*(last - 1)), distance_type(first));
+}
+
+template <class RandomAccessIterator>
+inline void pop_heap(RandomAccessIterator first, RandomAccessIterator last) {
+ __pop_heap_aux(first, last, value_type(first));
+}
+
+template <class RandomAccessIterator, class Distance, class T, class Compare>
+void __adjust_heap(RandomAccessIterator first, Distance holeIndex,
+ Distance len, T value, Compare comp) {
+ Distance topIndex = holeIndex;
+ Distance secondChild = 2 * holeIndex + 2;
+ while (secondChild < len) {
+ if (comp(*(first + secondChild), *(first + (secondChild - 1))))
+ secondChild--;
+ *(first + holeIndex) = *(first + secondChild);
+ holeIndex = secondChild;
+ secondChild = 2 * (secondChild + 1);
+ }
+ if (secondChild == len) {
+ *(first + holeIndex) = *(first + (secondChild - 1));
+ holeIndex = secondChild - 1;
+ }
+ __push_heap(first, holeIndex, topIndex, value, comp);
+}
+
+template <class RandomAccessIterator, class T, class Compare, class Distance>
+inline void __pop_heap(RandomAccessIterator first, RandomAccessIterator last,
+ RandomAccessIterator result, T value, Compare comp,
+ Distance*) {
+ *result = *first;
+ __adjust_heap(first, Distance(0), Distance(last - first), value, comp);
+}
+
+template <class RandomAccessIterator, class T, class Compare>
+inline void __pop_heap_aux(RandomAccessIterator first,
+ RandomAccessIterator last, T*, Compare comp) {
+ __pop_heap(first, last - 1, last - 1, T(*(last - 1)), comp,
+ distance_type(first));
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void pop_heap(RandomAccessIterator first, RandomAccessIterator last,
+ Compare comp) {
+ __pop_heap_aux(first, last, value_type(first), comp);
+}
+
+template <class RandomAccessIterator, class T, class Distance>
+void __make_heap(RandomAccessIterator first, RandomAccessIterator last, T*,
+ Distance*) {
+ if (last - first < 2) return;
+ Distance len = last - first;
+ Distance parent = (len - 2)/2;
+
+ while (true) {
+ __adjust_heap(first, parent, len, T(*(first + parent)));
+ if (parent == 0) return;
+ parent--;
+ }
+}
+
+template <class RandomAccessIterator>
+inline void make_heap(RandomAccessIterator first, RandomAccessIterator last) {
+ __make_heap(first, last, value_type(first), distance_type(first));
+}
+
+template <class RandomAccessIterator, class Compare, class T, class Distance>
+void __make_heap(RandomAccessIterator first, RandomAccessIterator last,
+ Compare comp, T*, Distance*) {
+ if (last - first < 2) return;
+ Distance len = last - first;
+ Distance parent = (len - 2)/2;
+
+ while (true) {
+ __adjust_heap(first, parent, len, T(*(first + parent)), comp);
+ if (parent == 0) return;
+ parent--;
+ }
+}
+
+template <class RandomAccessIterator, class Compare>
+inline void make_heap(RandomAccessIterator first, RandomAccessIterator last,
+ Compare comp) {
+ __make_heap(first, last, comp, value_type(first), distance_type(first));
+}
+
+template <class RandomAccessIterator>
+void sort_heap(RandomAccessIterator first, RandomAccessIterator last) {
+ while (last - first > 1) pop_heap(first, last--);
+}
+
+template <class RandomAccessIterator, class Compare>
+void sort_heap(RandomAccessIterator first, RandomAccessIterator last,
+ Compare comp) {
+ while (last - first > 1) pop_heap(first, last--, comp);
+}
+
+#if defined(__sgi) && !defined(__GNUC__) && (_MIPS_SIM != _MIPS_SIM_ABI32)
+#pragma reset woff 1209
+#endif
+
+#endif /* __SGI_STL_HEAP_H */
diff --git a/libstdc++/stl/iterator.h b/libstdc++/stl/iterator.h
new file mode 100644
index 00000000000..bdd2260596a
--- /dev/null
+++ b/libstdc++/stl/iterator.h
@@ -0,0 +1,598 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_ITERATOR_H
+#define __SGI_STL_ITERATOR_H
+
+#include <stddef.h>
+#include <iostream.h>
+#include <function.h>
+
+struct input_iterator_tag {};
+struct output_iterator_tag {};
+struct forward_iterator_tag {};
+struct bidirectional_iterator_tag {};
+struct random_access_iterator_tag {};
+
+template <class T, class Distance> struct input_iterator {
+ typedef input_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef Distance difference_type;
+ typedef T* pointer;
+ typedef T& reference;
+};
+
+struct output_iterator {
+ typedef output_iterator_tag iterator_category;
+};
+
+template <class T, class Distance> struct forward_iterator {
+ typedef forward_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef Distance difference_type;
+ typedef T* pointer;
+ typedef T& reference;
+};
+
+
+template <class T, class Distance> struct bidirectional_iterator {
+ typedef bidirectional_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef Distance difference_type;
+ typedef T* pointer;
+ typedef T& reference;
+};
+
+template <class T, class Distance> struct random_access_iterator {
+ typedef random_access_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef Distance difference_type;
+ typedef T* pointer;
+ typedef T& reference;
+};
+
+#if 0
+template <class Category, class T, class Distance = ptrdiff_t,
+ class Pointer = T*, class Reference = T&>
+struct iterator {
+ typedef Category iterator_category;
+ typedef T value_type;
+ typedef Distance difference_type;
+ typedef Pointer pointer;
+ typedef Reference reference;
+};
+#endif
+
+#ifdef __STL_CLASS_PARTIAL_SPECIALIZATION
+
+template <class Iterator>
+struct iterator_traits {
+ typedef typename Iterator::iterator_category iterator_category;
+ typedef typename Iterator::value_type value_type;
+ typedef typename Iterator::difference_type difference_type;
+ typedef typename Iterator::pointer pointer;
+ typedef typename Iterator::reference reference;
+};
+
+template <class T>
+struct iterator_traits<T*> {
+ typedef random_access_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef ptrdiff_t difference_type;
+ typedef T* pointer;
+ typedef T& reference;
+};
+
+#endif /* __STL_CLASS_PARTIAL_SPECIALIZATION */
+
+template <class T, class Distance>
+inline input_iterator_tag
+iterator_category(const input_iterator<T, Distance>&) {
+ return input_iterator_tag();
+}
+
+inline output_iterator_tag iterator_category(const output_iterator&) {
+ return output_iterator_tag();
+}
+
+template <class T, class Distance>
+inline forward_iterator_tag
+iterator_category(const forward_iterator<T, Distance>&) {
+ return forward_iterator_tag();
+}
+
+template <class T, class Distance>
+inline bidirectional_iterator_tag
+iterator_category(const bidirectional_iterator<T, Distance>&) {
+ return bidirectional_iterator_tag();
+}
+
+template <class T, class Distance>
+inline random_access_iterator_tag
+iterator_category(const random_access_iterator<T, Distance>&) {
+ return random_access_iterator_tag();
+}
+
+template <class T>
+inline random_access_iterator_tag iterator_category(const T*) {
+ return random_access_iterator_tag();
+}
+
+template <class T, class Distance>
+inline T* value_type(const input_iterator<T, Distance>&) {
+ return (T*)(0);
+}
+
+template <class T, class Distance>
+inline T* value_type(const forward_iterator<T, Distance>&) {
+ return (T*)(0);
+}
+
+template <class T, class Distance>
+inline T* value_type(const bidirectional_iterator<T, Distance>&) {
+ return (T*)(0);
+}
+
+template <class T, class Distance>
+inline T* value_type(const random_access_iterator<T, Distance>&) {
+ return (T*)(0);
+}
+
+template <class T>
+inline T* value_type(const T*) { return (T*)(0); }
+
+template <class T, class Distance>
+inline Distance* distance_type(const input_iterator<T, Distance>&) {
+ return (Distance*)(0);
+}
+
+template <class T, class Distance>
+inline Distance* distance_type(const forward_iterator<T, Distance>&) {
+ return (Distance*)(0);
+}
+
+template <class T, class Distance>
+inline Distance*
+distance_type(const bidirectional_iterator<T, Distance>&) {
+ return (Distance*)(0);
+}
+
+template <class T, class Distance>
+inline Distance*
+distance_type(const random_access_iterator<T, Distance>&) {
+ return (Distance*)(0);
+}
+
+template <class T>
+inline ptrdiff_t* distance_type(const T*) { return (ptrdiff_t*)(0); }
+
+template <class Container>
+class back_insert_iterator {
+protected:
+ Container* container;
+public:
+ typedef output_iterator_tag iterator_category;
+
+ explicit back_insert_iterator(Container& x) : container(&x) {}
+ back_insert_iterator<Container>&
+ operator=(const typename Container::value_type& value) {
+ container->push_back(value);
+ return *this;
+ }
+ back_insert_iterator<Container>& operator*() { return *this; }
+ back_insert_iterator<Container>& operator++() { return *this; }
+ back_insert_iterator<Container>& operator++(int) { return *this; }
+};
+
+template <class Container>
+inline output_iterator_tag
+iterator_category(const back_insert_iterator<Container>&)
+{
+ return output_iterator_tag();
+}
+
+template <class Container>
+inline back_insert_iterator<Container> back_inserter(Container& x) {
+ return back_insert_iterator<Container>(x);
+}
+
+template <class Container>
+class front_insert_iterator {
+protected:
+ Container* container;
+public:
+ typedef output_iterator_tag iterator_category;
+
+ explicit front_insert_iterator(Container& x) : container(&x) {}
+ front_insert_iterator<Container>&
+ operator=(const typename Container::value_type& value) {
+ container->push_front(value);
+ return *this;
+ }
+ front_insert_iterator<Container>& operator*() { return *this; }
+ front_insert_iterator<Container>& operator++() { return *this; }
+ front_insert_iterator<Container>& operator++(int) { return *this; }
+};
+
+template <class Container>
+inline output_iterator_tag
+iterator_category(const front_insert_iterator<Container>&)
+{
+ return output_iterator_tag();
+}
+
+template <class Container>
+inline front_insert_iterator<Container> front_inserter(Container& x) {
+ return front_insert_iterator<Container>(x);
+}
+
+template <class Container>
+class insert_iterator {
+protected:
+ Container* container;
+ typename Container::iterator iter;
+public:
+ typedef output_iterator_tag iterator_category;
+
+ insert_iterator(Container& x, typename Container::iterator i)
+ : container(&x), iter(i) {}
+ insert_iterator<Container>&
+ operator=(const typename Container::value_type& value) {
+ iter = container->insert(iter, value);
+ ++iter;
+ return *this;
+ }
+ insert_iterator<Container>& operator*() { return *this; }
+ insert_iterator<Container>& operator++() { return *this; }
+ insert_iterator<Container>& operator++(int) { return *this; }
+};
+
+template <class Container>
+inline output_iterator_tag
+iterator_category(const insert_iterator<Container>&)
+{
+ return output_iterator_tag();
+}
+
+template <class Container, class Iterator>
+inline insert_iterator<Container> inserter(Container& x, Iterator i) {
+ typedef typename Container::iterator iter;
+ return insert_iterator<Container>(x, iter(i));
+}
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class BidirectionalIterator, class T, class Reference = T&,
+ class Distance = ptrdiff_t>
+#else
+template <class BidirectionalIterator, class T, class Reference,
+ class Distance>
+#endif
+class reverse_bidirectional_iterator {
+ typedef reverse_bidirectional_iterator<BidirectionalIterator, T, Reference,
+ Distance> self;
+ friend bool operator==(const self& x, const self& y);
+protected:
+ BidirectionalIterator current;
+public:
+ typedef bidirectional_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef Distance difference_type;
+ typedef T* pointer;
+ typedef Reference reference;
+
+ reverse_bidirectional_iterator() {}
+ explicit reverse_bidirectional_iterator(BidirectionalIterator x)
+ : current(x) {}
+ BidirectionalIterator base() { return current; }
+ Reference operator*() const {
+ BidirectionalIterator tmp = current;
+ return *--tmp;
+ }
+ self& operator++() {
+ --current;
+ return *this;
+ }
+ self operator++(int) {
+ self tmp = *this;
+ --current;
+ return tmp;
+ }
+ self& operator--() {
+ ++current;
+ return *this;
+ }
+ self operator--(int) {
+ self tmp = *this;
+ ++current;
+ return tmp;
+ }
+};
+
+
+template <class BidirectionalIterator, class T, class Reference,
+ class Distance>
+inline bidirectional_iterator_tag
+iterator_category(const reverse_bidirectional_iterator<BidirectionalIterator,
+ T,
+ Reference, Distance>&) {
+ return bidirectional_iterator_tag();
+}
+
+template <class BidirectionalIterator, class T, class Reference,
+ class Distance>
+inline T*
+value_type(const reverse_bidirectional_iterator<BidirectionalIterator, T,
+ Reference, Distance>&) {
+ return (T*) 0;
+}
+
+template <class BidirectionalIterator, class T, class Reference,
+ class Distance>
+inline Distance*
+distance_type(const reverse_bidirectional_iterator<BidirectionalIterator, T,
+ Reference, Distance>&) {
+ return (Distance*) 0;
+}
+
+template <class BidirectionalIterator, class T, class Reference,
+ class Distance>
+inline bool operator==(
+ const reverse_bidirectional_iterator<BidirectionalIterator, T, Reference,
+ Distance>& x,
+ const reverse_bidirectional_iterator<BidirectionalIterator, T, Reference,
+ Distance>& y) {
+ return x.current == y.current;
+}
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class RandomAccessIterator, class T, class Reference = T&,
+ class Distance = ptrdiff_t>
+#else
+template <class RandomAccessIterator, class T, class Reference,
+ class Distance>
+#endif
+class reverse_iterator {
+ typedef reverse_iterator<RandomAccessIterator, T, Reference, Distance>
+ self;
+ friend bool operator==(const self& x, const self& y);
+ friend bool operator<(const self& x, const self& y);
+ friend Distance operator-(const self& x, const self& y);
+ friend self operator+(Distance n, const self& x);
+protected:
+ RandomAccessIterator current;
+public:
+ typedef random_access_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef Distance difference_type;
+ typedef T* pointer;
+ typedef Reference reference;
+
+ reverse_iterator() {}
+ explicit reverse_iterator(RandomAccessIterator x) : current(x) {}
+ RandomAccessIterator base() { return current; }
+ Reference operator*() const { return *(current - 1); }
+ self& operator++() {
+ --current;
+ return *this;
+ }
+ self operator++(int) {
+ self tmp = *this;
+ --current;
+ return tmp;
+ }
+ self& operator--() {
+ ++current;
+ return *this;
+ }
+ self operator--(int) {
+ self tmp = *this;
+ ++current;
+ return tmp;
+ }
+ self operator+(Distance n) const {
+ return self(current - n);
+ }
+ self& operator+=(Distance n) {
+ current -= n;
+ return *this;
+ }
+ self operator-(Distance n) const {
+ return self(current + n);
+ }
+ self& operator-=(Distance n) {
+ current += n;
+ return *this;
+ }
+ Reference operator[](Distance n) { return *(*this + n); }
+};
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline random_access_iterator_tag
+iterator_category(const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>&) {
+ return random_access_iterator_tag();
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline T* value_type(const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>&) {
+ return (T*) 0;
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline Distance* distance_type(const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>&) {
+ return (Distance*) 0;
+}
+
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline bool operator==(const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& x,
+ const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& y) {
+ return x.current == y.current;
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline bool operator<(const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& x,
+ const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& y) {
+ return y.current < x.current;
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline Distance operator-(const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& x,
+ const reverse_iterator<RandomAccessIterator, T,
+ Reference, Distance>& y) {
+ return y.current - x.current;
+}
+
+template <class RandomAccessIterator, class T, class Reference, class Distance>
+inline reverse_iterator<RandomAccessIterator, T, Reference, Distance>
+operator+(Distance n,
+ const reverse_iterator<RandomAccessIterator, T, Reference,
+ Distance>& x) {
+ return reverse_iterator<RandomAccessIterator, T, Reference, Distance>
+ (x.current - n);
+}
+
+
+template <class ForwardIterator, class T>
+class raw_storage_iterator {
+protected:
+ ForwardIterator iter;
+public:
+ typedef output_iterator_tag iterator_category;
+
+ explicit raw_storage_iterator(ForwardIterator x) : iter(x) {}
+ raw_storage_iterator<ForwardIterator, T>& operator*() { return *this; }
+ raw_storage_iterator<ForwardIterator, T>& operator=(const T& element) {
+ construct(&*iter, element);
+ return *this;
+ }
+ raw_storage_iterator<ForwardIterator, T>& operator++() {
+ ++iter;
+ return *this;
+ }
+ raw_storage_iterator<ForwardIterator, T> operator++(int) {
+ raw_storage_iterator<ForwardIterator, T> tmp = *this;
+ ++iter;
+ return tmp;
+ }
+};
+
+template <class ForwardIterator, class T>
+inline output_iterator_tag
+iterator_category(const raw_storage_iterator<ForwardIterator, T>&)
+{
+ return output_iterator_tag();
+}
+
+template <class T, class Distance = ptrdiff_t>
+class istream_iterator {
+friend bool operator==(const istream_iterator<T, Distance>& x,
+ const istream_iterator<T, Distance>& y);
+protected:
+ istream* stream;
+ T value;
+ bool end_marker;
+ void read() {
+ end_marker = (*stream) ? true : false;
+ if (end_marker) *stream >> value;
+ end_marker = (*stream) ? true : false;
+ }
+public:
+ typedef input_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef Distance difference_type;
+ typedef T* pointer;
+ typedef T& reference;
+
+ istream_iterator() : stream(&cin), end_marker(false) {}
+ istream_iterator(istream& s) : stream(&s) { read(); }
+ const T& operator*() const { return value; }
+ istream_iterator<T, Distance>& operator++() {
+ read();
+ return *this;
+ }
+ istream_iterator<T, Distance> operator++(int) {
+ istream_iterator<T, Distance> tmp = *this;
+ read();
+ return tmp;
+ }
+};
+
+template <class T, class Distance>
+inline input_iterator_tag
+iterator_category(const istream_iterator<T, Distance>&) {
+ return input_iterator_tag();
+}
+
+template <class T, class Distance>
+inline T* value_type(const istream_iterator<T, Distance>&) { return (T*) 0; }
+
+template <class T, class Distance>
+inline Distance* distance_type(const istream_iterator<T, Distance>&) {
+ return (Distance*) 0;
+}
+
+template <class T, class Distance>
+bool operator==(const istream_iterator<T, Distance>& x,
+ const istream_iterator<T, Distance>& y) {
+ return x.stream == y.stream && x.end_marker == y.end_marker ||
+ x.end_marker == false && y.end_marker == false;
+}
+
+template <class T>
+class ostream_iterator {
+protected:
+ ostream* stream;
+ const char* string;
+public:
+ typedef output_iterator_tag iterator_category;
+
+ ostream_iterator(ostream& s) : stream(&s), string(0) {}
+ ostream_iterator(ostream& s, const char* c) : stream(&s), string(c) {}
+ ostream_iterator<T>& operator=(const T& value) {
+ *stream << value;
+ if (string) *stream << string;
+ return *this;
+ }
+ ostream_iterator<T>& operator*() { return *this; }
+ ostream_iterator<T>& operator++() { return *this; }
+ ostream_iterator<T>& operator++(int) { return *this; }
+};
+
+template <class T>
+inline output_iterator_tag
+iterator_category(const ostream_iterator<T>&) {
+ return output_iterator_tag();
+}
+
+#endif /* __SGI_STL_ITERATOR_H */
diff --git a/libstdc++/stl/list.h b/libstdc++/stl/list.h
new file mode 100644
index 00000000000..b26692b5c82
--- /dev/null
+++ b/libstdc++/stl/list.h
@@ -0,0 +1,624 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_LIST_H
+#define __SGI_STL_LIST_H
+
+#include <stddef.h>
+#include <algobase.h>
+#include <iterator.h>
+#include <alloc.h>
+
+template <class T>
+struct __list_node {
+ typedef void* void_pointer;
+ void_pointer next;
+ void_pointer prev;
+ T data;
+};
+
+template<class T, class Ref>
+struct __list_iterator {
+ typedef __list_iterator<T, T&> iterator;
+ typedef __list_iterator<T, const T&> const_iterator;
+ typedef __list_iterator<T, Ref> self;
+
+ typedef bidirectional_iterator_tag iterator_category;
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef __list_node<T>* link_type;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+
+ link_type node;
+
+ __list_iterator(link_type x) : node(x) {}
+ __list_iterator() {}
+ __list_iterator(const iterator& x) : node(x.node) {}
+
+ bool operator==(const self& x) const { return node == x.node; }
+ bool operator!=(const self& x) const { return node != x.node; }
+ Ref operator*() const { return (*node).data; }
+
+ self& operator++() {
+ node = (link_type)((*node).next);
+ return *this;
+ }
+ self operator++(int) {
+ self tmp = *this;
+ ++*this;
+ return tmp;
+ }
+ self& operator--() {
+ node = (link_type)((*node).prev);
+ return *this;
+ }
+ self operator--(int) {
+ self tmp = *this;
+ --*this;
+ return tmp;
+ }
+};
+
+
+template <class T, class Ref>
+inline bidirectional_iterator_tag
+iterator_category(const __list_iterator<T, Ref>&) {
+ return bidirectional_iterator_tag();
+}
+
+template <class T, class Ref>
+inline T*
+value_type(const __list_iterator<T, Ref>&) {
+ return 0;
+}
+
+template <class T, class Ref>
+inline ptrdiff_t*
+distance_type(const __list_iterator<T, Ref>&) {
+ return 0;
+}
+
+
+template <class T, class Alloc = alloc>
+class list {
+protected:
+ typedef void* void_pointer;
+ typedef __list_node<T> list_node;
+ typedef simple_alloc<list_node, Alloc> list_node_allocator;
+public:
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef list_node* link_type;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+
+public:
+ typedef __list_iterator<T, T&> iterator;
+ typedef __list_iterator<T, const T&> const_iterator;
+
+ typedef reverse_bidirectional_iterator<const_iterator, value_type,
+ const_reference, difference_type>
+ const_reverse_iterator;
+ typedef reverse_bidirectional_iterator<iterator, value_type, reference,
+ difference_type>
+ reverse_iterator;
+
+protected:
+ link_type get_node() { return list_node_allocator::allocate(); }
+ void put_node(link_type p) { list_node_allocator::deallocate(p); }
+
+ link_type create_node(const T& x) {
+ link_type p = get_node();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ construct(&p->data, x);
+ return p;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ put_node(p);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ void destroy_node(link_type p) {
+ destroy(&p->data);
+ put_node(p);
+ }
+
+protected:
+ void empty_initialize() {
+ node = get_node();
+ node->next = node;
+ node->prev = node;
+ }
+
+ void fill_initialize(size_type n, const T& value) {
+ empty_initialize();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ insert(begin(), n, value);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ put_node(node);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void range_initialize(InputIterator first, InputIterator last) {
+ empty_initialize();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ insert(begin(), first, last);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ put_node(node);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ void range_initialize(const T* first, const T* last) {
+ empty_initialize();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ insert(begin(), first, last);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ put_node(node);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ void range_initialize(const_iterator first, const_iterator last) {
+ empty_initialize();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ insert(begin(), first, last);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ put_node(node);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+protected:
+ link_type node;
+
+public:
+ list() { empty_initialize(); }
+
+ iterator begin() { return (link_type)((*node).next); }
+ const_iterator begin() const { return (link_type)((*node).next); }
+ iterator end() { return node; }
+ const_iterator end() const { return node; }
+ reverse_iterator rbegin() { return reverse_iterator(end()); }
+ const_reverse_iterator rbegin() const {
+ return const_reverse_iterator(end());
+ }
+ reverse_iterator rend() { return reverse_iterator(begin()); }
+ const_reverse_iterator rend() const {
+ return const_reverse_iterator(begin());
+ }
+ bool empty() const { return node->next == node; }
+ size_type size() const {
+ size_type result = 0;
+ distance(begin(), end(), result);
+ return result;
+ }
+ size_type max_size() const { return size_type(-1); }
+ reference front() { return *begin(); }
+ const_reference front() const { return *begin(); }
+ reference back() { return *(--end()); }
+ const_reference back() const { return *(--end()); }
+ void swap(list<T, Alloc>& x) { ::swap(node, x.node); }
+ iterator insert(iterator position, const T& x) {
+ link_type tmp = create_node(x);
+ tmp->next = position.node;
+ tmp->prev = position.node->prev;
+ (link_type(position.node->prev))->next = tmp;
+ position.node->prev = tmp;
+ return tmp;
+ }
+ iterator insert(iterator position) { return insert(position, T()); }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(iterator position, InputIterator first, InputIterator last);
+#else /* __STL_MEMBER_TEMPLATES */
+ void insert(iterator position, const T* first, const T* last);
+ void insert(iterator position,
+ const_iterator first, const_iterator last);
+#endif /* __STL_MEMBER_TEMPLATES */
+ void insert(iterator pos, size_type n, const T& x);
+ void insert(iterator pos, int n, const T& x) {
+ insert(pos, (size_type)n, x);
+ }
+ void insert(iterator pos, long n, const T& x) {
+ insert(pos, (size_type)n, x);
+ }
+
+ void push_front(const T& x) { insert(begin(), x); }
+ void push_back(const T& x) { insert(end(), x); }
+ void erase(iterator position) {
+ (link_type(position.node->prev))->next = position.node->next;
+ (link_type(position.node->next))->prev = position.node->prev;
+ destroy_node(position.node);
+ }
+ void erase(iterator first, iterator last);
+ void resize(size_type new_size, const T& x);
+ void resize(size_type new_size) { resize(new_size, T()); }
+ void clear();
+
+ void pop_front() { erase(begin()); }
+ void pop_back() {
+ iterator tmp = end();
+ erase(--tmp);
+ }
+ list(size_type n, const T& value) { fill_initialize(n, value); }
+ list(int n, const T& value) { fill_initialize(n, value); }
+ list(long n, const T& value) { fill_initialize(n, value); }
+ explicit list(size_type n) { fill_initialize(n, T()); }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ list(InputIterator first, InputIterator last) {
+ range_initialize(first, last);
+ }
+
+#else /* __STL_MEMBER_TEMPLATES */
+ list(const T* first, const T* last) { range_initialize(first, last); }
+ list(const_iterator first, const_iterator last) {
+ range_initialize(first, last);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+ list(const list<T, Alloc>& x) {
+ range_initialize(x.begin(), x.end());
+ }
+ ~list() {
+ clear();
+ put_node(node);
+ }
+ list<T, Alloc>& operator=(const list<T, Alloc>& x);
+
+protected:
+ void transfer(iterator position, iterator first, iterator last) {
+ if (position != last) {
+ (*(link_type((*last.node).prev))).next = position.node;
+ (*(link_type((*first.node).prev))).next = last.node;
+ (*(link_type((*position.node).prev))).next = first.node;
+ link_type tmp = link_type((*position.node).prev);
+ (*position.node).prev = (*last.node).prev;
+ (*last.node).prev = (*first.node).prev;
+ (*first.node).prev = tmp;
+ }
+ }
+
+public:
+ void splice(iterator position, list& x) {
+ if (!x.empty())
+ transfer(position, x.begin(), x.end());
+ }
+ void splice(iterator position, list&, iterator i) {
+ iterator j = i;
+ ++j;
+ if (position == i || position == j) return;
+ transfer(position, i, j);
+ }
+ void splice(iterator position, list&, iterator first, iterator last) {
+ if (first != last)
+ transfer(position, first, last);
+ }
+ void remove(const T& value);
+ void unique();
+ void merge(list& x);
+ void reverse();
+ void sort();
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class Predicate> void remove_if(Predicate);
+ template <class BinaryPredicate> void unique(BinaryPredicate);
+ template <class StrictWeakOrdering> void merge(list&, StrictWeakOrdering);
+ template <class StrictWeakOrdering> void sort(StrictWeakOrdering);
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ friend bool operator== (const list& x, const list& y);
+};
+
+template <class T, class Alloc>
+inline bool operator==(const list<T,Alloc>& x, const list<T,Alloc>& y) {
+ typedef list<T,Alloc>::link_type link_type;
+ link_type e1 = x.node;
+ link_type e2 = y.node;
+ link_type n1 = (link_type) e1->next;
+ link_type n2 = (link_type) e2->next;
+ for ( ; n1 != e1 && n2 != e2 ;
+ n1 = (link_type) n1->next, n2 = (link_type) n2->next)
+ if (n1->data != n2->data)
+ return false;
+ return n1 == e1 && n2 == e2;
+}
+
+template <class T, class Alloc>
+inline bool operator<(const list<T, Alloc>& x, const list<T, Alloc>& y) {
+ return lexicographical_compare(x.begin(), x.end(), y.begin(), y.end());
+}
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+template <class T, class Alloc> template <class InputIterator>
+void list<T, Alloc>::insert(iterator position,
+ InputIterator first, InputIterator last) {
+ for ( ; first != last; ++first)
+ insert(position, *first);
+}
+
+#else /* __STL_MEMBER_TEMPLATES */
+
+template <class T, class Alloc>
+void list<T, Alloc>::insert(iterator position, const T* first, const T* last) {
+ for ( ; first != last; ++first)
+ insert(position, *first);
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::insert(iterator position,
+ const_iterator first, const_iterator last) {
+ for ( ; first != last; ++first)
+ insert(position, *first);
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+template <class T, class Alloc>
+void list<T, Alloc>::insert(iterator position, size_type n, const T& x) {
+ for ( ; n > 0; --n)
+ insert(position, x);
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::erase(iterator first, iterator last) {
+ while (first != last) erase(first++);
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::resize(size_type new_size, const T& x)
+{
+ size_type len = size();
+ if (new_size < len) {
+ iterator f;
+ if (new_size < len / 2) {
+ f = begin();
+ advance(f, new_size);
+ }
+ else {
+ f = end();
+ advance(f, difference_type(len) - difference_type(new_size));
+ }
+ erase(f, end());
+ }
+ else
+ insert(end(), new_size - len, x);
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::clear()
+{
+ link_type cur = (link_type) node->next;
+ while (cur != node) {
+ link_type tmp = cur;
+ cur = (link_type) cur->next;
+ destroy_node(tmp);
+ }
+ node->next = node;
+ node->prev = node;
+}
+
+template <class T, class Alloc>
+list<T, Alloc>& list<T, Alloc>::operator=(const list<T, Alloc>& x) {
+ if (this != &x) {
+ iterator first1 = begin();
+ iterator last1 = end();
+ const_iterator first2 = x.begin();
+ const_iterator last2 = x.end();
+ while (first1 != last1 && first2 != last2) *first1++ = *first2++;
+ if (first2 == last2)
+ erase(first1, last1);
+ else
+ insert(last1, first2, last2);
+ }
+ return *this;
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::remove(const T& value) {
+ iterator first = begin();
+ iterator last = end();
+ while (first != last) {
+ iterator next = first;
+ ++next;
+ if (*first == value) erase(first);
+ first = next;
+ }
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::unique() {
+ iterator first = begin();
+ iterator last = end();
+ if (first == last) return;
+ iterator next = first;
+ while (++next != last) {
+ if (*first == *next)
+ erase(next);
+ else
+ first = next;
+ next = first;
+ }
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::merge(list<T, Alloc>& x) {
+ iterator first1 = begin();
+ iterator last1 = end();
+ iterator first2 = x.begin();
+ iterator last2 = x.end();
+ while (first1 != last1 && first2 != last2)
+ if (*first2 < *first1) {
+ iterator next = first2;
+ transfer(first1, first2, ++next);
+ first2 = next;
+ }
+ else
+ ++first1;
+ if (first2 != last2) transfer(last1, first2, last2);
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::reverse() {
+ if (node->next == node || link_type(node->next)->next == node) return;
+ iterator first = begin();
+ ++first;
+ while (first != end()) {
+ iterator old = first;
+ ++first;
+ transfer(begin(), old, first);
+ }
+}
+
+template <class T, class Alloc>
+void list<T, Alloc>::sort() {
+ if (node->next == node || link_type(node->next)->next == node) return;
+ list<T, Alloc> carry;
+ list<T, Alloc> counter[64];
+ int fill = 0;
+ while (!empty()) {
+ carry.splice(carry.begin(), *this, begin());
+ int i = 0;
+ while(i < fill && !counter[i].empty()) {
+ counter[i].merge(carry);
+ carry.swap(counter[i++]);
+ }
+ carry.swap(counter[i]);
+ if (i == fill) ++fill;
+ }
+
+ for (int i = 1; i < fill; ++i) counter[i].merge(counter[i-1]);
+ swap(counter[fill-1]);
+}
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+template <class T, class Alloc> template <class Predicate>
+void list<T, Alloc>::remove_if(Predicate pred) {
+ iterator first = begin();
+ iterator last = end();
+ while (first != last) {
+ iterator next = first;
+ ++next;
+ if (pred(*first)) erase(first);
+ first = next;
+ }
+}
+
+template <class T, class Alloc> template <class BinaryPredicate>
+void list<T, Alloc>::unique(BinaryPredicate binary_pred) {
+ iterator first = begin();
+ iterator last = end();
+ if (first == last) return;
+ iterator next = first;
+ while (++next != last) {
+ if (binary_pred(*first, *next))
+ erase(next);
+ else
+ first = next;
+ next = first;
+ }
+}
+
+template <class T, class Alloc> template <class StrictWeakOrdering>
+void list<T, Alloc>::merge(list<T, Alloc>& x, StrictWeakOrdering comp) {
+ iterator first1 = begin();
+ iterator last1 = end();
+ iterator first2 = x.begin();
+ iterator last2 = x.end();
+ while (first1 != last1 && first2 != last2)
+ if (comp(*first2, *first1)) {
+ iterator next = first2;
+ transfer(first1, first2, ++next);
+ first2 = next;
+ }
+ else
+ ++first1;
+ if (first2 != last2) transfer(last1, first2, last2);
+}
+
+template <class T, class Alloc> template <class StrictWeakOrdering>
+void list<T, Alloc>::sort(StrictWeakOrdering comp) {
+ if (node->next == node || link_type(node->next)->next == node) return;
+ list<T, Alloc> carry;
+ list<T, Alloc> counter[64];
+ int fill = 0;
+ while (!empty()) {
+ carry.splice(carry.begin(), *this, begin());
+ int i = 0;
+ while(i < fill && !counter[i].empty()) {
+ counter[i].merge(carry, comp);
+ carry.swap(counter[i++]);
+ }
+ carry.swap(counter[i]);
+ if (i == fill) ++fill;
+ }
+
+ for (int i = 1; i < fill; ++i) counter[i].merge(counter[i-1], comp);
+ swap(counter[fill-1]);
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+#endif /* __SGI_STL_LIST_H */
diff --git a/libstdc++/stl/map.h b/libstdc++/stl/map.h
new file mode 100644
index 00000000000..5c9d6b1bf3b
--- /dev/null
+++ b/libstdc++/stl/map.h
@@ -0,0 +1,188 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_MAP_H
+#define __SGI_STL_MAP_H
+
+#include <tree.h>
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Key, class T, class Compare = less<Key>, class Alloc = alloc>
+#else
+template <class Key, class T, class Compare, class Alloc = alloc>
+#endif
+class map {
+public:
+
+// typedefs:
+
+ typedef Key key_type;
+ typedef T data_type;
+ typedef pair<const Key, T> value_type;
+ typedef Compare key_compare;
+
+ class value_compare
+ : public binary_function<value_type, value_type, bool> {
+ friend class map<Key, T, Compare, Alloc>;
+ protected :
+ Compare comp;
+ value_compare(Compare c) : comp(c) {}
+ public:
+ bool operator()(const value_type& x, const value_type& y) const {
+ return comp(x.first, y.first);
+ }
+ };
+
+private:
+ typedef rb_tree<key_type, value_type,
+ select1st<value_type>, key_compare, Alloc> rep_type;
+ rep_type t; // red-black tree representing map
+public:
+ typedef rep_type::pointer pointer;
+ typedef rep_type::reference reference;
+ typedef rep_type::const_reference const_reference;
+ typedef rep_type::iterator iterator;
+ typedef rep_type::const_iterator const_iterator;
+ typedef rep_type::reverse_iterator reverse_iterator;
+ typedef rep_type::const_reverse_iterator const_reverse_iterator;
+ typedef rep_type::size_type size_type;
+ typedef rep_type::difference_type difference_type;
+
+ // allocation/deallocation
+
+ map() : t(Compare()) {}
+ explicit map(const Compare& comp) : t(comp) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ map(InputIterator first, InputIterator last)
+ : t(Compare()) { t.insert_unique(first, last); }
+
+ template <class InputIterator>
+ map(InputIterator first, InputIterator last, const Compare& comp)
+ : t(comp) { t.insert_unique(first, last); }
+#else
+ map(const value_type* first, const value_type* last)
+ : t(Compare()) { t.insert_unique(first, last); }
+ map(const value_type* first, const value_type* last, const Compare& comp)
+ : t(comp) { t.insert_unique(first, last); }
+
+ map(const_iterator first, const_iterator last)
+ : t(Compare()) { t.insert_unique(first, last); }
+ map(const_iterator first, const_iterator last, const Compare& comp)
+ : t(comp) { t.insert_unique(first, last); }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ map(const map<Key, T, Compare, Alloc>& x) : t(x.t) {}
+ map<Key, T, Compare, Alloc>& operator=(const map<Key, T, Compare, Alloc>& x)
+ {
+ t = x.t;
+ return *this;
+ }
+
+ // accessors:
+
+ key_compare key_comp() const { return t.key_comp(); }
+ value_compare value_comp() const { return value_compare(t.key_comp()); }
+ iterator begin() { return t.begin(); }
+ const_iterator begin() const { return t.begin(); }
+ iterator end() { return t.end(); }
+ const_iterator end() const { return t.end(); }
+ reverse_iterator rbegin() { return t.rbegin(); }
+ const_reverse_iterator rbegin() const { return t.rbegin(); }
+ reverse_iterator rend() { return t.rend(); }
+ const_reverse_iterator rend() const { return t.rend(); }
+ bool empty() const { return t.empty(); }
+ size_type size() const { return t.size(); }
+ size_type max_size() const { return t.max_size(); }
+ T& operator[](const key_type& k) {
+ return (*((insert(value_type(k, T()))).first)).second;
+ }
+ void swap(map<Key, T, Compare, Alloc>& x) { t.swap(x.t); }
+
+ // insert/erase
+
+ pair<iterator,bool> insert(const value_type& x) { return t.insert_unique(x); }
+ iterator insert(iterator position, const value_type& x) {
+ return t.insert_unique(position, x);
+ }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(InputIterator first, InputIterator last) {
+ t.insert_unique(first, last);
+ }
+#else
+ void insert(const value_type* first, const value_type* last) {
+ t.insert_unique(first, last);
+ }
+ void insert(const_iterator first, const_iterator last) {
+ t.insert_unique(first, last);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ void erase(iterator position) { t.erase(position); }
+ size_type erase(const key_type& x) { return t.erase(x); }
+ void erase(iterator first, iterator last) { t.erase(first, last); }
+ void clear() { t.clear(); }
+
+ // map operations:
+
+ iterator find(const key_type& x) { return t.find(x); }
+ const_iterator find(const key_type& x) const { return t.find(x); }
+ size_type count(const key_type& x) const { return t.count(x); }
+ iterator lower_bound(const key_type& x) {return t.lower_bound(x); }
+ const_iterator lower_bound(const key_type& x) const {
+ return t.lower_bound(x);
+ }
+ iterator upper_bound(const key_type& x) {return t.upper_bound(x); }
+ const_iterator upper_bound(const key_type& x) const {
+ return t.upper_bound(x);
+ }
+
+ pair<iterator,iterator> equal_range(const key_type& x) {
+ return t.equal_range(x);
+ }
+ pair<const_iterator,const_iterator> equal_range(const key_type& x) const {
+ return t.equal_range(x);
+ }
+ friend bool operator==(const map&, const map&);
+ friend bool operator<(const map&, const map&);
+};
+
+template <class Key, class T, class Compare, class Alloc>
+inline bool operator==(const map<Key, T, Compare, Alloc>& x,
+ const map<Key, T, Compare, Alloc>& y) {
+ return x.t == y.t;
+}
+
+template <class Key, class T, class Compare, class Alloc>
+inline bool operator<(const map<Key, T, Compare, Alloc>& x,
+ const map<Key, T, Compare, Alloc>& y) {
+ return x.t < y.t;
+}
+
+#endif /* __SGI_STL_MAP_H */
+
diff --git a/libstdc++/stl/multimap.h b/libstdc++/stl/multimap.h
new file mode 100644
index 00000000000..f15880af39d
--- /dev/null
+++ b/libstdc++/stl/multimap.h
@@ -0,0 +1,182 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_MULTIMAP_H
+#define __SGI_STL_MULTIMAP_H
+
+#include <tree.h>
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Key, class T, class Compare = less<Key>, class Alloc = alloc>
+#else
+template <class Key, class T, class Compare, class Alloc = alloc>
+#endif
+class multimap {
+public:
+
+// typedefs:
+
+ typedef Key key_type;
+ typedef T data_type;
+ typedef pair<const Key, T> value_type;
+ typedef Compare key_compare;
+
+ class value_compare : public binary_function<value_type, value_type, bool> {
+ friend class multimap<Key, T, Compare, Alloc>;
+ protected:
+ Compare comp;
+ value_compare(Compare c) : comp(c) {}
+ public:
+ bool operator()(const value_type& x, const value_type& y) const {
+ return comp(x.first, y.first);
+ }
+ };
+
+private:
+ typedef rb_tree<key_type, value_type,
+ select1st<value_type>, key_compare, Alloc> rep_type;
+ rep_type t; // red-black tree representing multimap
+public:
+ typedef rep_type::pointer pointer;
+ typedef rep_type::reference reference;
+ typedef rep_type::const_reference const_reference;
+ typedef rep_type::iterator iterator;
+ typedef rep_type::const_iterator const_iterator;
+ typedef rep_type::reverse_iterator reverse_iterator;
+ typedef rep_type::const_reverse_iterator const_reverse_iterator;
+ typedef rep_type::size_type size_type;
+ typedef rep_type::difference_type difference_type;
+
+// allocation/deallocation
+
+ multimap() : t(Compare()) { }
+ explicit multimap(const Compare& comp) : t(comp) { }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ multimap(InputIterator first, InputIterator last)
+ : t(Compare()) { t.insert_equal(first, last); }
+
+ template <class InputIterator>
+ multimap(InputIterator first, InputIterator last, const Compare& comp)
+ : t(comp) { t.insert_equal(first, last); }
+#else
+ multimap(const value_type* first, const value_type* last)
+ : t(Compare()) { t.insert_equal(first, last); }
+ multimap(const value_type* first, const value_type* last,
+ const Compare& comp)
+ : t(comp) { t.insert_equal(first, last); }
+
+ multimap(const_iterator first, const_iterator last)
+ : t(Compare()) { t.insert_equal(first, last); }
+ multimap(const_iterator first, const_iterator last, const Compare& comp)
+ : t(comp) { t.insert_equal(first, last); }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ multimap(const multimap<Key, T, Compare, Alloc>& x) : t(x.t) { }
+ multimap<Key, T, Compare, Alloc>&
+ operator=(const multimap<Key, T, Compare, Alloc>& x) {
+ t = x.t;
+ return *this;
+ }
+
+ // accessors:
+
+ key_compare key_comp() const { return t.key_comp(); }
+ value_compare value_comp() const { return value_compare(t.key_comp()); }
+ iterator begin() { return t.begin(); }
+ const_iterator begin() const { return t.begin(); }
+ iterator end() { return t.end(); }
+ const_iterator end() const { return t.end(); }
+ reverse_iterator rbegin() { return t.rbegin(); }
+ const_reverse_iterator rbegin() const { return t.rbegin(); }
+ reverse_iterator rend() { return t.rend(); }
+ const_reverse_iterator rend() const { return t.rend(); }
+ bool empty() const { return t.empty(); }
+ size_type size() const { return t.size(); }
+ size_type max_size() const { return t.max_size(); }
+ void swap(multimap<Key, T, Compare, Alloc>& x) { t.swap(x.t); }
+
+ // insert/erase
+
+ iterator insert(const value_type& x) { return t.insert_equal(x); }
+ iterator insert(iterator position, const value_type& x) {
+ return t.insert_equal(position, x);
+ }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(InputIterator first, InputIterator last) {
+ t.insert_equal(first, last);
+ }
+#else
+ void insert(const value_type* first, const value_type* last) {
+ t.insert_equal(first, last);
+ }
+ void insert(const_iterator first, const_iterator last) {
+ t.insert_equal(first, last);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+ void erase(iterator position) { t.erase(position); }
+ size_type erase(const key_type& x) { return t.erase(x); }
+ void erase(iterator first, iterator last) { t.erase(first, last); }
+ void clear() { t.clear(); }
+
+ // multimap operations:
+
+ iterator find(const key_type& x) { return t.find(x); }
+ const_iterator find(const key_type& x) const { return t.find(x); }
+ size_type count(const key_type& x) const { return t.count(x); }
+ iterator lower_bound(const key_type& x) {return t.lower_bound(x); }
+ const_iterator lower_bound(const key_type& x) const {
+ return t.lower_bound(x);
+ }
+ iterator upper_bound(const key_type& x) {return t.upper_bound(x); }
+ const_iterator upper_bound(const key_type& x) const {
+ return t.upper_bound(x);
+ }
+ pair<iterator,iterator> equal_range(const key_type& x) {
+ return t.equal_range(x);
+ }
+ pair<const_iterator,const_iterator> equal_range(const key_type& x) const {
+ return t.equal_range(x);
+ }
+ friend bool operator==(const multimap&, const multimap&);
+ friend bool operator<(const multimap&, const multimap&);
+};
+
+template <class Key, class T, class Compare, class Alloc>
+inline bool operator==(const multimap<Key, T, Compare, Alloc>& x,
+ const multimap<Key, T, Compare, Alloc>& y) {
+ return x.t == y.t;
+}
+
+template <class Key, class T, class Compare, class Alloc>
+inline bool operator<(const multimap<Key, T, Compare, Alloc>& x,
+ const multimap<Key, T, Compare, Alloc>& y) {
+ return x.t < y.t;
+}
+
+#endif /* __SGI_STL_MULTIMAP_H */
diff --git a/libstdc++/stl/multiset.h b/libstdc++/stl/multiset.h
new file mode 100644
index 00000000000..3df4557b18f
--- /dev/null
+++ b/libstdc++/stl/multiset.h
@@ -0,0 +1,167 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_MULTISET_H
+#define __SGI_STL_MULTISET_H
+
+#include <tree.h>
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Key, class Compare = less<Key>, class Alloc = alloc>
+#else
+template <class Key, class Compare, class Alloc = alloc>
+#endif
+class multiset {
+public:
+ // typedefs:
+
+ typedef Key key_type;
+ typedef Key value_type;
+ typedef Compare key_compare;
+ typedef Compare value_compare;
+private:
+ typedef rb_tree<key_type, value_type,
+ identity<value_type>, key_compare, Alloc> rep_type;
+ rep_type t; // red-black tree representing multiset
+public:
+ typedef rep_type::const_pointer pointer;
+ typedef rep_type::const_reference reference;
+ typedef rep_type::const_reference const_reference;
+ typedef rep_type::const_iterator iterator;
+ typedef rep_type::const_iterator const_iterator;
+ typedef rep_type::const_reverse_iterator reverse_iterator;
+ typedef rep_type::const_reverse_iterator const_reverse_iterator;
+ typedef rep_type::size_type size_type;
+ typedef rep_type::difference_type difference_type;
+
+ // allocation/deallocation
+
+ multiset() : t(Compare()) {}
+ explicit multiset(const Compare& comp) : t(comp) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ multiset(InputIterator first, InputIterator last)
+ : t(Compare()) { t.insert_equal(first, last); }
+ template <class InputIterator>
+ multiset(InputIterator first, InputIterator last, const Compare& comp)
+ : t(comp) { t.insert_equal(first, last); }
+#else
+ multiset(const value_type* first, const value_type* last)
+ : t(Compare()) { t.insert_equal(first, last); }
+ multiset(const value_type* first, const value_type* last,
+ const Compare& comp)
+ : t(comp) { t.insert_equal(first, last); }
+
+ multiset(const_iterator first, const_iterator last)
+ : t(Compare()) { t.insert_equal(first, last); }
+ multiset(const_iterator first, const_iterator last, const Compare& comp)
+ : t(comp) { t.insert_equal(first, last); }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ multiset(const multiset<Key, Compare, Alloc>& x) : t(x.t) {}
+ multiset<Key, Compare, Alloc>&
+ operator=(const multiset<Key, Compare, Alloc>& x) {
+ t = x.t;
+ return *this;
+ }
+
+ // accessors:
+
+ key_compare key_comp() const { return t.key_comp(); }
+ value_compare value_comp() const { return t.key_comp(); }
+ iterator begin() const { return t.begin(); }
+ iterator end() const { return t.end(); }
+ reverse_iterator rbegin() const { return t.rbegin(); }
+ reverse_iterator rend() const { return t.rend(); }
+ bool empty() const { return t.empty(); }
+ size_type size() const { return t.size(); }
+ size_type max_size() const { return t.max_size(); }
+ void swap(multiset<Key, Compare, Alloc>& x) { t.swap(x.t); }
+
+ // insert/erase
+ iterator insert(const value_type& x) {
+ return t.insert_equal(x);
+ }
+ iterator insert(iterator position, const value_type& x) {
+ return t.insert_equal((rep_type::iterator&)position, x);
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(InputIterator first, InputIterator last) {
+ t.insert_equal(first, last);
+ }
+#else
+ void insert(const value_type* first, const value_type* last) {
+ t.insert_equal(first, last);
+ }
+ void insert(const_iterator first, const_iterator last) {
+ t.insert_equal(first, last);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+ void erase(iterator position) {
+ t.erase((rep_type::iterator&)position);
+ }
+ size_type erase(const key_type& x) {
+ return t.erase(x);
+ }
+ void erase(iterator first, iterator last) {
+ t.erase((rep_type::iterator&)first,
+ (rep_type::iterator&)last);
+ }
+ void clear() { t.clear(); }
+
+ // multiset operations:
+
+ iterator find(const key_type& x) const { return t.find(x); }
+ size_type count(const key_type& x) const { return t.count(x); }
+ iterator lower_bound(const key_type& x) const {
+ return t.lower_bound(x);
+ }
+ iterator upper_bound(const key_type& x) const {
+ return t.upper_bound(x);
+ }
+ pair<iterator,iterator> equal_range(const key_type& x) const {
+ return t.equal_range(x);
+ }
+ friend bool operator==(const multiset&, const multiset&);
+ friend bool operator<(const multiset&, const multiset&);
+};
+
+template <class Key, class Compare, class Alloc>
+inline bool operator==(const multiset<Key, Compare, Alloc>& x,
+ const multiset<Key, Compare, Alloc>& y) {
+ return x.t == y.t;
+}
+
+template <class Key, class Compare, class Alloc>
+inline bool operator<(const multiset<Key, Compare, Alloc>& x,
+ const multiset<Key, Compare, Alloc>& y) {
+ return x.t < y.t;
+}
+
+#endif /* __SGI_STL_MULTISET_H */
diff --git a/libstdc++/stl/pair.h b/libstdc++/stl/pair.h
new file mode 100644
index 00000000000..ca20d8baf8a
--- /dev/null
+++ b/libstdc++/stl/pair.h
@@ -0,0 +1,63 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef PAIR_H
+#define PAIR_H
+
+#include <stl_config.h>
+
+template <class T1, class T2>
+struct pair {
+ typedef T1 first_type;
+ typedef T2 second_type;
+
+ T1 first;
+ T2 second;
+ pair() : first(T1()), second(T2()) {}
+ pair(const T1& a, const T2& b) : first(a), second(b) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class U1, class U2>
+ pair(const pair<U1, U2>& p) : first(p.first), second(p.second) {}
+#endif
+};
+
+template <class T1, class T2>
+inline bool operator==(const pair<T1, T2>& x, const pair<T1, T2>& y) {
+ return x.first == y.first && x.second == y.second;
+}
+
+template <class T1, class T2>
+inline bool operator<(const pair<T1, T2>& x, const pair<T1, T2>& y) {
+ return x.first < y.first || (!(y.first < x.first) && x.second < y.second);
+}
+
+template <class T1, class T2>
+inline pair<T1, T2> make_pair(const T1& x, const T2& y) {
+ return pair<T1, T2>(x, y);
+}
+
+#endif
diff --git a/libstdc++/stl/pthread_alloc.h b/libstdc++/stl/pthread_alloc.h
new file mode 100644
index 00000000000..a2aeaa1290e
--- /dev/null
+++ b/libstdc++/stl/pthread_alloc.h
@@ -0,0 +1,344 @@
+/*
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __PTHREAD_ALLOC_H
+#define __PTHREAD_ALLOC_H
+
+// Pthread-specific node allocator.
+// This is similar to the default allocator, except that free-list
+// information is kept separately for each thread, avoiding locking.
+// This should be reasonably fast even in the presence of threads.
+// The down side is that storage may not be well-utilized.
+// It is not an error to allocate memory in thread A and deallocate
+// it n thread B. But this effectively transfers ownership of the memory,
+// so that it can only be reallocated by thread B. Thus this can effectively
+// result in a storage leak if it's done on a regular basis.
+// It can also result in frequent sharing of
+// cache lines among processors, with potentially serious performance
+// consequences.
+
+
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#include <pthread.h>
+#include <alloc.h>
+#ifndef __RESTRICT
+# define __RESTRICT
+#endif
+
+// Note that this class has nonstatic members. We instantiate it once
+// per thread.
+template <bool dummy>
+class __pthread_alloc_template {
+
+private:
+ enum {ALIGN = 8};
+ enum {MAX_BYTES = 128}; // power of 2
+ enum {NFREELISTS = MAX_BYTES/ALIGN};
+
+ union obj {
+ union obj * free_list_link;
+ char client_data[ALIGN]; /* The client sees this. */
+ };
+
+ // Per instance state
+ obj* volatile free_list[NFREELISTS];
+ __pthread_alloc_template<dummy>* next; // Free list link
+
+ static size_t ROUND_UP(size_t bytes) {
+ return (((bytes) + ALIGN-1) & ~(ALIGN - 1));
+ }
+ static size_t FREELIST_INDEX(size_t bytes) {
+ return (((bytes) + ALIGN-1)/ALIGN - 1);
+ }
+
+ // Returns an object of size n, and optionally adds to size n free list.
+ void *refill(size_t n);
+ // Allocates a chunk for nobjs of size size. nobjs may be reduced
+ // if it is inconvenient to allocate the requested number.
+ static char *chunk_alloc(size_t size, int &nobjs);
+
+ // Chunk allocation state. And other shared state.
+ // Protected by chunk_allocator_lock.
+ static pthread_mutex_t chunk_allocator_lock;
+ static char *start_free;
+ static char *end_free;
+ static size_t heap_size;
+ static __pthread_alloc_template<dummy>* free_allocators;
+ static pthread_key_t key;
+ static bool key_initialized;
+ // Pthread key under which allocator is stored.
+ // Allocator instances that are currently unclaimed by any thread.
+ static void destructor(void *instance);
+ // Function to be called on thread exit to reclaim allocator
+ // instance.
+ static __pthread_alloc_template<dummy> *new_allocator();
+ // Return a recycled or new allocator instance.
+ static __pthread_alloc_template<dummy> *get_allocator_instance();
+ // ensure that the current thread has an associated
+ // allocator instance.
+ class lock {
+ public:
+ lock () { pthread_mutex_lock(&chunk_allocator_lock); }
+ ~lock () { pthread_mutex_unlock(&chunk_allocator_lock); }
+ };
+ friend class lock;
+
+
+public:
+
+ __pthread_alloc_template() : next(0)
+ {
+ memset((void *)free_list, 0, NFREELISTS * sizeof(obj *));
+ }
+
+ /* n must be > 0 */
+ static void * allocate(size_t n)
+ {
+ obj * volatile * my_free_list;
+ obj * __RESTRICT result;
+ __pthread_alloc_template<dummy>* a;
+
+ if (n > MAX_BYTES) {
+ return(malloc(n));
+ }
+ if (!key_initialized ||
+ !(a = (__pthread_alloc_template<dummy>*)
+ pthread_getspecific(key))) {
+ a = get_allocator_instance();
+ }
+ my_free_list = a -> free_list + FREELIST_INDEX(n);
+ result = *my_free_list;
+ if (result == 0) {
+ void *r = a -> refill(ROUND_UP(n));
+ return r;
+ }
+ *my_free_list = result -> free_list_link;
+ return (result);
+ };
+
+ /* p may not be 0 */
+ static void deallocate(void *p, size_t n)
+ {
+ obj *q = (obj *)p;
+ obj * volatile * my_free_list;
+ __pthread_alloc_template<dummy>* a;
+
+ if (n > MAX_BYTES) {
+ free(p);
+ return;
+ }
+ if (!key_initialized ||
+ !(a = (__pthread_alloc_template<dummy>*)
+ pthread_getspecific(key))) {
+ a = get_allocator_instance();
+ }
+ my_free_list = a->free_list + FREELIST_INDEX(n);
+ q -> free_list_link = *my_free_list;
+ *my_free_list = q;
+ }
+
+ static void * reallocate(void *p, size_t old_sz, size_t new_sz);
+
+} ;
+
+typedef __pthread_alloc_template<false> pthread_alloc;
+
+
+template <bool dummy>
+void __pthread_alloc_template<dummy>::destructor(void * instance)
+{
+ __pthread_alloc_template<dummy>* a =
+ (__pthread_alloc_template<dummy>*)instance;
+ a -> next = free_allocators;
+ free_allocators = a;
+}
+
+template <bool dummy>
+__pthread_alloc_template<dummy>*
+__pthread_alloc_template<dummy>::new_allocator()
+{
+ if (0 != free_allocators) {
+ __pthread_alloc_template<dummy>* result = free_allocators;
+ free_allocators = free_allocators -> next;
+ return result;
+ } else {
+ return new __pthread_alloc_template<dummy>;
+ }
+}
+
+template <bool dummy>
+__pthread_alloc_template<dummy>*
+__pthread_alloc_template<dummy>::get_allocator_instance()
+{
+ __pthread_alloc_template<dummy>* result;
+ if (!key_initialized) {
+ /*REFERENCED*/
+ lock lock_instance;
+ if (!key_initialized) {
+ if (pthread_key_create(&key, destructor)) {
+ abort(); // failed
+ }
+ key_initialized = true;
+ }
+ }
+ result = new_allocator();
+ if (pthread_setspecific(key, result)) abort();
+ return result;
+}
+
+/* We allocate memory in large chunks in order to avoid fragmenting */
+/* the malloc heap too much. */
+/* We assume that size is properly aligned. */
+template <bool dummy>
+char *__pthread_alloc_template<dummy>
+::chunk_alloc(size_t size, int &nobjs)
+{
+ {
+ char * result;
+ size_t total_bytes;
+ size_t bytes_left;
+ /*REFERENCED*/
+ lock lock_instance; // Acquire lock for this routine
+
+ total_bytes = size * nobjs;
+ bytes_left = end_free - start_free;
+ if (bytes_left >= total_bytes) {
+ result = start_free;
+ start_free += total_bytes;
+ return(result);
+ } else if (bytes_left >= size) {
+ nobjs = bytes_left/size;
+ total_bytes = size * nobjs;
+ result = start_free;
+ start_free += total_bytes;
+ return(result);
+ } else {
+ size_t bytes_to_get = 2 * total_bytes + ROUND_UP(heap_size >> 4);
+ // Try to make use of the left-over piece.
+ if (bytes_left > 0) {
+ __pthread_alloc_template<dummy>* a =
+ (__pthread_alloc_template<dummy>*)pthread_getspecific(key);
+ obj * volatile * my_free_list =
+ a->free_list + FREELIST_INDEX(bytes_left);
+
+ ((obj *)start_free) -> free_list_link = *my_free_list;
+ *my_free_list = (obj *)start_free;
+ }
+# ifdef _SGI_SOURCE
+ // Try to get memory that's aligned on something like a
+ // cache line boundary, so as to avoid parceling out
+ // parts of the same line to different threads and thus
+ // possibly different processors.
+ {
+ const int cache_line_size = 128; // probable upper bound
+ bytes_to_get &= ~(cache_line_size-1);
+ start_free = (char *)memalign(cache_line_size, bytes_to_get);
+ if (0 == start_free) {
+ start_free = (char *)malloc_alloc::allocate(bytes_to_get);
+ }
+ }
+# else /* !SGI_SOURCE */
+ start_free = (char *)malloc_alloc::allocate(bytes_to_get);
+# endif
+ heap_size += bytes_to_get;
+ end_free = start_free + bytes_to_get;
+ }
+ }
+ // lock is released here
+ return(chunk_alloc(size, nobjs));
+}
+
+
+/* Returns an object of size n, and optionally adds to size n free list.*/
+/* We assume that n is properly aligned. */
+/* We hold the allocation lock. */
+template <bool dummy>
+void *__pthread_alloc_template<dummy>
+::refill(size_t n)
+{
+ int nobjs = 128;
+ char * chunk = chunk_alloc(n, nobjs);
+ obj * volatile * my_free_list;
+ obj * result;
+ obj * current_obj, * next_obj;
+ int i;
+
+ if (1 == nobjs) {
+ return(chunk);
+ }
+ my_free_list = free_list + FREELIST_INDEX(n);
+
+ /* Build free list in chunk */
+ result = (obj *)chunk;
+ *my_free_list = next_obj = (obj *)(chunk + n);
+ for (i = 1; ; i++) {
+ current_obj = next_obj;
+ next_obj = (obj *)((char *)next_obj + n);
+ if (nobjs - 1 == i) {
+ current_obj -> free_list_link = 0;
+ break;
+ } else {
+ current_obj -> free_list_link = next_obj;
+ }
+ }
+ return(result);
+}
+
+template <bool dummy>
+void *__pthread_alloc_template<dummy>
+::reallocate(void *p, size_t old_sz, size_t new_sz)
+{
+ void * result;
+ size_t copy_sz;
+
+ if (old_sz > MAX_BYTES && new_sz > MAX_BYTES) {
+ return(realloc(p, new_sz));
+ }
+ if (ROUND_UP(old_sz) == ROUND_UP(new_sz)) return(p);
+ result = allocate(new_sz);
+ copy_sz = new_sz > old_sz? old_sz : new_sz;
+ memcpy(result, p, copy_sz);
+ deallocate(p, old_sz);
+ return(result);
+}
+
+template <bool dummy>
+__pthread_alloc_template<dummy> *
+__pthread_alloc_template<dummy>::free_allocators = 0;
+
+template <bool dummy>
+pthread_key_t __pthread_alloc_template<dummy>::key;
+
+template <bool dummy>
+bool __pthread_alloc_template<dummy>::key_initialized = false;
+
+template <bool dummy>
+pthread_mutex_t __pthread_alloc_template<dummy>::chunk_allocator_lock
+= PTHREAD_MUTEX_INITIALIZER;
+
+template <bool dummy>
+char *__pthread_alloc_template<dummy>
+::start_free = 0;
+
+template <bool dummy>
+char *__pthread_alloc_template<dummy>
+::end_free = 0;
+
+template <bool dummy>
+size_t __pthread_alloc_template<dummy>
+::heap_size = 0;
+
+
+#endif /* __NODE_ALLOC_H */
diff --git a/libstdc++/stl/rope.h b/libstdc++/stl/rope.h
new file mode 100644
index 00000000000..105eb05d0cc
--- /dev/null
+++ b/libstdc++/stl/rope.h
@@ -0,0 +1,2055 @@
+/*
+ * Copyright (c) 1997
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef _ROPE_H
+# define _ROPE_H
+
+# include <iterator.h>
+# include <algobase.h>
+# include <algo.h>
+# include <function.h>
+# include <stddef.h>
+# include <alloc.h>
+# include <hashtable.h>
+# ifdef __GC
+# define __GC_CONST const
+# else
+# define __GC_CONST // constant except for deallocation
+# endif
+# ifdef __STL_SGI_THREADS
+# include <mutex.h>
+# endif
+
+// The end-of-C-string character.
+// This is what the draft standard says it should be.
+template <class charT>
+inline charT __eos(charT*) { return charT(); }
+
+// Test for basic character types.
+// For basic character types leaves having a trailing eos.
+template <class charT>
+inline bool __is_basic_char_type(charT* c) { return false; }
+template <class charT>
+inline bool __is_one_byte_char_type(charT* c) { return false; }
+
+inline bool __is_basic_char_type(char* c) { return true; }
+inline bool __is_one_byte_char_type(char* c) { return true; }
+inline bool __is_basic_char_type(wchar_t* c) { return true; }
+
+// Store an eos iff charT is a basic character type.
+// Do not reference __eos if it isn't.
+template <class charT>
+inline void __cond_store_eos(charT& c) {}
+
+inline void __cond_store_eos(char& c) { c = 0; }
+inline void __cond_store_eos(wchar_t& c) { c = 0; }
+
+
+// rope<charT,Alloc> is a sequence of charT.
+// Ropes appear to be mutable, but update operations
+// really copy enough of the data structure to leave the original
+// valid. Thus ropes can be logically copied by just copying
+// a pointer value.
+// The __eos function is used for those functions that
+// convert to/from C-like strings to detect the end of the string.
+// __compare is used as the character comparison function.
+template <class charT>
+class char_producer {
+ public:
+ virtual ~char_producer() {};
+ virtual void operator()(size_t start_pos, size_t len, charT* buffer)
+ = 0;
+ // Buffer should really be an arbitrary output iterator.
+ // That way we could flatten directly into an ostream, etc.
+ // This is thoroughly impossible, since iterator types don't
+ // have runtime descriptions.
+};
+
+// Sequence buffers:
+//
+// Sequence must provide an append operation that appends an
+// array to the sequence. Sequence buffers are useful only if
+// appending an entire array is cheaper than appending element by element.
+// This is true for many string representations.
+// This should perhaps inherit from ostream<sequence::value_type>
+// and be implemented correspondingly, so that they can be used
+// for formatted. For the sake of portability, we don't do this yet.
+//
+// For now, sequence buffers behave as output iterators. But they also
+// behave a little like basic_ostringstream<sequence::value_type> and a
+// little like containers.
+
+template<class sequence, size_t buf_sz = 100
+# if defined(__sgi) && !defined(__GNUC__)
+# define __TYPEDEF_WORKAROUND
+ ,class v = typename sequence::value_type
+# endif
+ >
+// The 3rd parameter works around a common compiler bug.
+class sequence_buffer : public output_iterator {
+ public:
+# ifndef __TYPEDEF_WORKAROUND
+ typedef typename sequence::value_type value_type;
+# else
+ typedef v value_type;
+# endif
+ protected:
+ sequence *prefix;
+ value_type buffer[buf_sz];
+ size_t buf_count;
+ public:
+ void flush() {
+ prefix->append(buffer, buffer + buf_count);
+ buf_count = 0;
+ }
+ ~sequence_buffer() { flush(); }
+ sequence_buffer() : prefix(0), buf_count(0) {}
+ sequence_buffer(const sequence_buffer & x) {
+ prefix = x.prefix;
+ buf_count = x.buf_count;
+ copy(x.buffer, x.buffer + x.buf_count, buffer);
+ }
+ sequence_buffer(sequence_buffer & x) {
+ x.flush();
+ prefix = x.prefix;
+ buf_count = 0;
+ }
+ sequence_buffer(sequence& s) : prefix(&s), buf_count(0) {}
+ sequence_buffer& operator= (sequence_buffer& x) {
+ x.flush();
+ prefix = x.prefix;
+ buf_count = 0;
+ return *this;
+ }
+ sequence_buffer& operator= (const sequence_buffer& x) {
+ prefix = x.prefix;
+ buf_count = x.buf_count;
+ copy(x.buffer, x.buffer + x.buf_count, buffer);
+ return *this;
+ }
+ void push_back(value_type x)
+ {
+ if (buf_count < buf_sz) {
+ buffer[buf_count] = x;
+ ++buf_count;
+ } else {
+ flush();
+ buffer[0] = x;
+ buf_count = 1;
+ }
+ }
+ void append(value_type *s, size_t len)
+ {
+ if (len + buf_count <= buf_sz) {
+ size_t i, j;
+ for (i = buf_count, j = 0; j < len; i++, j++) {
+ buffer[i] = s[j];
+ }
+ buf_count += len;
+ } else if (0 == buf_count) {
+ prefix->append(s, s + len);
+ } else {
+ flush();
+ append(s, len);
+ }
+ }
+ sequence_buffer& write(value_type *s, size_t len)
+ {
+ append(s, len);
+ return *this;
+ }
+ sequence_buffer& put(value_type x)
+ {
+ push_back(x);
+ return *this;
+ }
+ sequence_buffer& operator=(const value_type& rhs)
+ {
+ push_back(rhs);
+ return *this;
+ }
+ sequence_buffer& operator*() { return *this; }
+ sequence_buffer& operator++() { return *this; }
+ sequence_buffer& operator++(int) { return *this; }
+};
+
+// The following should be treated as private, at least for now.
+template<class charT>
+class __rope_char_consumer {
+ public:
+ // If we had member templates, these should not be virtual.
+ // For now we need to use run-time parametrization where
+ // compile-time would do. Hence this should all be private
+ // for now.
+ // The symmetry with char_producer is accidental and temporary.
+ virtual ~__rope_char_consumer() {};
+ virtual bool operator()(const charT* buffer, size_t len) = 0;
+};
+
+//
+// What follows should really be local to rope. Unfortunately,
+// that doesn't work, since it makes it impossible to define generic
+// equality on rope iterators. According to the draft standard, the
+// template parameters for such an equality operator cannot be inferred
+// from the occurence of a member class as a parameter.
+// (SGI compilers in fact allow this, but the result wouldn't be
+// portable.)
+// Similarly, some of the static member functions are member functions
+// only to avoid polluting the global namespace, and to circumvent
+// restrictions on type inference for template functions.
+//
+
+template<class CharT, class Alloc=__ALLOC> class rope;
+template<class CharT, class Alloc> struct __rope_RopeConcatenation;
+template<class CharT, class Alloc> struct __rope_RopeLeaf;
+template<class CharT, class Alloc> struct __rope_RopeFunction;
+template<class CharT, class Alloc> struct __rope_RopeSubstring;
+template<class CharT, class Alloc> class __rope_iterator;
+template<class CharT, class Alloc> class __rope_const_iterator;
+template<class CharT, class Alloc> class __rope_charT_ref_proxy;
+template<class CharT, class Alloc> class __rope_charT_ptr_proxy;
+
+//
+// The internal data structure for representing a rope. This is
+// private to the implementation. A rope is really just a pointer
+// to one of these.
+//
+// A few basic functions for manipulating this data structure
+// are members of RopeBase. Most of the more complex algorithms
+// are implemented as rope members.
+//
+// Some of the static member functions of RopeBase have identically
+// named functions in rope that simply invoke the RopeBase versions.
+//
+
+template<class charT, class Alloc>
+struct __rope_RopeBase {
+ typedef rope<charT,Alloc> my_rope;
+ typedef simple_alloc<__rope_RopeConcatenation<charT,Alloc>, Alloc> CAlloc;
+ typedef simple_alloc<__rope_RopeLeaf<charT,Alloc>, Alloc> LAlloc;
+ typedef simple_alloc<__rope_RopeFunction<charT,Alloc>, Alloc> FAlloc;
+ typedef simple_alloc<__rope_RopeSubstring<charT,Alloc>, Alloc> SAlloc;
+ public:
+ enum { max_rope_depth = 45 };
+ enum {leaf, concat, substringfn, function} tag:8;
+ bool is_balanced:8;
+ unsigned char depth;
+ size_t size;
+ __GC_CONST charT * c_string;
+ /* Flattened version of string, if needed. */
+ /* typically 0. */
+ /* If it's not 0, then the memory is owned */
+ /* by this node. */
+ /* In the case of a leaf, this may point to */
+ /* the same memory as the data field. */
+# ifndef __GC
+# if defined(__STL_WIN32THREADS)
+ long refcount; // InterlockedIncrement wants a long *
+# else
+ size_t refcount;
+# endif
+ // We count references from rope instances
+ // and references from other rope nodes. We
+ // do not count const_iterator references.
+ // Iterator references are counted so that rope modifications
+ // can be detected after the fact.
+ // Generally function results are counted, i.e.
+ // a pointer returned by a function is included at the
+ // point at which the pointer is returned.
+ // The recipient should decrement the count if the
+ // result is not needed.
+ // Generally function arguments are not reflected
+ // in the reference count. The callee should increment
+ // the count before saving the argument someplace that
+ // will outlive the call.
+# endif
+# ifndef __GC
+# ifdef __STL_SGI_THREADS
+ // Reference counting with multiple threads and no
+ // hardware or thread package support is pretty awful.
+ // Mutexes are normally too expensive.
+ // We'll assume a COMPARE_AND_SWAP(destp, old, new)
+ // operation, which might be cheaper.
+# if __mips < 3 || !(defined (_ABIN32) || defined(_ABI64))
+# define __add_and_fetch(l,v) add_then_test((unsigned long *)l,v)
+# endif
+ void init_refcount_lock() {}
+ void incr_refcount ()
+ {
+ __add_and_fetch(&refcount, 1);
+ }
+ size_t decr_refcount ()
+ {
+ return __add_and_fetch(&refcount, (size_t)(-1));
+ }
+# elif defined(__STL_WIN32THREADS)
+ void init_refcount_lock() {}
+ void incr_refcount ()
+ {
+ InterlockedIncrement(&refcount);
+ }
+ size_t decr_refcount ()
+ {
+ return InterlockedDecrement(&refcount);
+ }
+# elif defined(_PTHREADS)
+ // This should be portable, but performance is expected
+ // to be quite awful. This really needs platform specific
+ // code.
+ pthread_mutex_t refcount_lock;
+ void init_refcount_lock() {
+ pthread_mutex_init(&refcount_lock, 0);
+ }
+ void incr_refcount ()
+ {
+ pthread_mutex_lock(&refcount_lock);
+ ++refcount;
+ pthread_mutex_unlock(&refcount_lock);
+ }
+ size_t decr_refcount ()
+ {
+ size_t result;
+ pthread_mutex_lock(&refcount_lock);
+ result = --refcount;
+ pthread_mutex_unlock(&refcount_lock);
+ return result;
+ }
+# else
+ void init_refcount_lock() {}
+ void incr_refcount ()
+ {
+ ++refcount;
+ }
+ size_t decr_refcount ()
+ {
+ --refcount;
+ return refcount;
+ }
+# endif
+# else
+ void incr_refcount () {}
+# endif
+ static void free_string(charT *, size_t len);
+ // Deallocate data section of a leaf.
+ // This shouldn't be a member function.
+ // But its hard to do anything else at the
+ // moment, because it's templatized w.r.t.
+ // an allocator.
+ // Does nothing if __GC is defined.
+# ifndef __GC
+ void free_c_string();
+ void free_tree();
+ // Deallocate t. Assumes t is not 0.
+ void unref_nonnil()
+ {
+ if (0 == decr_refcount()) free_tree();
+ }
+ void ref_nonnil()
+ {
+ incr_refcount();
+ }
+ static void unref(__rope_RopeBase* t)
+ {
+ if (0 != t) {
+ t -> unref_nonnil();
+ }
+ }
+ static void ref(__rope_RopeBase* t)
+ {
+ if (0 != t) t -> incr_refcount();
+ }
+# else /* __GC */
+ void unref_nonnil() {}
+ void ref_nonnil() {}
+ static void unref(__rope_RopeBase* t) {}
+ static void ref(__rope_RopeBase* t) {}
+ static void fn_finalization_proc(void * tree, void *);
+# endif
+
+ // The data fields of leaves are allocated with some
+ // extra space, to accomodate future growth and for basic
+ // character types, to hold a trailing eos character.
+ enum { alloc_granularity = 8 };
+ static size_t rounded_up_size(size_t n) {
+ size_t size_with_eos;
+
+ if (__is_basic_char_type((charT *)0)) {
+ size_with_eos = (n + 1) * sizeof(charT);
+ } else {
+ size_with_eos = n * sizeof(charT);
+ }
+# ifdef __GC
+ return size_with_eos;
+# else
+ // Allow slop for in-place expansion.
+ return (size_with_eos + alloc_granularity-1)
+ &~ (alloc_granularity-1);
+# endif
+ }
+};
+
+template<class charT, class Alloc>
+struct __rope_RopeLeaf : public __rope_RopeBase<charT,Alloc> {
+ public: // Apparently needed by VC++
+ __GC_CONST charT* data; /* Not necessarily 0 terminated. */
+ /* The allocated size is */
+ /* rounded_up_size(size), except */
+ /* in the GC case, in which it */
+ /* doesn't matter. */
+};
+
+template<class charT, class Alloc>
+struct __rope_RopeConcatenation : public __rope_RopeBase<charT,Alloc> {
+ public:
+ __rope_RopeBase<charT,Alloc>* left;
+ __rope_RopeBase<charT,Alloc>* right;
+};
+
+template<class charT, class Alloc>
+struct __rope_RopeFunction : public __rope_RopeBase<charT,Alloc> {
+ public:
+ char_producer<charT>* fn;
+# ifndef __GC
+ bool delete_when_done; // Char_producer is owned by the
+ // rope and should be explicitly
+ // deleted when the rope becomes
+ // inaccessible.
+# else
+ // In the GC case, we either register the rope for
+ // finalization, or not. Thus the field is unnecessary;
+ // the information is stored in the collector data structures.
+# endif
+};
+// Substring results are usually represented using just
+// concatenation nodes. But in the case of very long flat ropes
+// or ropes with a functional representation that isn't practical.
+// In that case, we represent the result as a special case of
+// RopeFunction, whose char_producer points back to the rope itself.
+// In all cases except repeated substring operations and
+// deallocation, we treat the result as a RopeFunction.
+template<class charT, class Alloc>
+struct __rope_RopeSubstring: public __rope_RopeFunction<charT,Alloc>,
+ public char_producer<charT> {
+ public:
+ __rope_RopeBase<charT,Alloc> * base; // not 0
+ size_t start;
+ virtual ~__rope_RopeSubstring() {}
+ virtual void operator()(size_t start_pos, size_t req_len,
+ charT *buffer) {
+ switch(base -> tag) {
+ case function:
+ case substringfn:
+ {
+ char_producer<charT> *fn =
+ ((__rope_RopeFunction<charT,Alloc> *)base) -> fn;
+ __stl_assert(start_pos + req_len <= size);
+ __stl_assert(start + size <= base -> size);
+ (*fn)(start_pos + start, req_len, buffer);
+ }
+ break;
+ case leaf:
+ {
+ __GC_CONST charT * s =
+ ((__rope_RopeLeaf<charT,Alloc> *)base) -> data;
+ uninitialized_copy_n(s + start_pos + start, req_len,
+ buffer);
+ }
+ break;
+ default:
+ __stl_assert(false);
+ }
+ }
+ __rope_RopeSubstring(__rope_RopeBase<charT,Alloc> * b, size_t s, size_t l) :
+ base(b), start(s) {
+# ifndef __GC
+ refcount = 1;
+ init_refcount_lock();
+ base -> ref_nonnil();
+# endif
+ size = l;
+ tag = substringfn;
+ depth = 0;
+ c_string = 0;
+ fn = this;
+ }
+};
+
+
+// Self-destructing pointers to RopeBase.
+// These are not conventional smart pointers. Their
+// only purpose in life is to ensure that unref is called
+// on the pointer either at normal exit or if an exception
+// is raised. It is the caller's responsibility to
+// adjust reference counts when these pointers are initialized
+// or assigned to. (This convention significantly reduces
+// the number of potentially expensive reference count
+// updates.)
+#ifndef __GC
+ template<class charT, class Alloc>
+ struct __rope_self_destruct_ptr {
+ __rope_RopeBase<charT,Alloc> * ptr;
+ ~__rope_self_destruct_ptr() { __rope_RopeBase<charT,Alloc>::unref(ptr); }
+# ifdef __STL_USE_EXCEPTIONS
+ __rope_self_destruct_ptr() : ptr(0) {};
+# else
+ __rope_self_destruct_ptr() {};
+# endif
+ __rope_self_destruct_ptr(__rope_RopeBase<charT,Alloc> * p) : ptr(p) {}
+ __rope_RopeBase<charT,Alloc> & operator*() { return *ptr; }
+ __rope_RopeBase<charT,Alloc> * operator->() { return ptr; }
+ operator __rope_RopeBase<charT,Alloc> *() { return ptr; }
+ __rope_self_destruct_ptr & operator= (__rope_RopeBase<charT,Alloc> * x)
+ { ptr = x; return *this; }
+ };
+#endif
+
+// unwind-protect
+# ifdef __STL_USE_EXCEPTIONS
+# define __STL_TRY try {
+# define __STL_UNWIND(action) } catch(...) { action; throw; }
+# define __STL_ALWAYS(action) action; } catch(...) { action; throw; }
+# else
+# define __STL_TRY {
+# define __STL_UNWIND(action) }
+# define __STL_ALWAYS(action) action; }
+# endif
+// Dereferencing a nonconst iterator has to return something
+// that behaves almost like a reference. It's not possible to
+// return an actual reference since assignment requires extra
+// work. And we would get into the same problems as with the
+// CD2 version of basic_string.
+template<class charT, class Alloc>
+class __rope_charT_ref_proxy {
+ friend class rope<charT,Alloc>;
+ friend class __rope_iterator<charT,Alloc>;
+ friend class __rope_charT_ptr_proxy<charT,Alloc>;
+# ifdef __GC
+ typedef __rope_RopeBase<charT,Alloc> * self_destruct_ptr;
+# else
+ typedef __rope_self_destruct_ptr<charT,Alloc> self_destruct_ptr;
+# endif
+ typedef __rope_RopeBase<charT,Alloc> RopeBase;
+ typedef rope<charT,Alloc> my_rope;
+ size_t pos;
+ charT current;
+ bool current_valid;
+ my_rope * root; // The whole rope.
+ public:
+ __rope_charT_ref_proxy(my_rope * r, size_t p) :
+ pos(p), root(r), current_valid(false) {}
+ __rope_charT_ref_proxy(my_rope * r, size_t p,
+ charT c) :
+ pos(p), root(r), current(c), current_valid(true) {}
+ operator charT () const;
+ __rope_charT_ref_proxy& operator= (charT c);
+ __rope_charT_ptr_proxy<charT,Alloc> operator& () const;
+ __rope_charT_ref_proxy& operator= (const __rope_charT_ref_proxy& c) {
+ return operator=((charT)c);
+ }
+};
+
+template<class charT, class Alloc>
+class __rope_charT_ptr_proxy {
+ friend class __rope_charT_ref_proxy<charT,Alloc>;
+ size_t pos;
+ charT current;
+ bool current_valid;
+ rope<charT,Alloc> * root; // The whole rope.
+ public:
+ __rope_charT_ptr_proxy(const __rope_charT_ref_proxy<charT,Alloc> & x) :
+ pos(x.pos), root(x.root), current_valid(x.current_valid),
+ current(x.current) {}
+ __rope_charT_ptr_proxy(const __rope_charT_ptr_proxy & x) :
+ pos(x.pos), root(x.root), current_valid(x.current_valid),
+ current(x.current) {}
+ __rope_charT_ptr_proxy() {}
+ __rope_charT_ptr_proxy(charT * x) : root(0), pos(0) {
+ __stl_assert(0 == x);
+ }
+ __rope_charT_ptr_proxy& operator= (const __rope_charT_ptr_proxy& x) {
+ pos = x.pos;
+ current = x.current;
+ current_valid = x.current_valid;
+ root = x.root;
+ return *this;
+ }
+ friend bool operator==
+ (const __rope_charT_ptr_proxy<charT,Alloc> & x,
+ const __rope_charT_ptr_proxy<charT,Alloc> & y);
+ __rope_charT_ref_proxy<charT,Alloc> operator *() const {
+ if (current_valid) {
+ return __rope_charT_ref_proxy<charT,Alloc>(root, pos, current);
+ } else {
+ return __rope_charT_ref_proxy<charT,Alloc>(root, pos);
+ }
+ }
+};
+
+// Rope iterators:
+// Unlike in the C version, we cache only part of the stack
+// for rope iterators, since they must be efficiently copyable.
+// When we run out of cache, we have to reconstruct the iterator
+// value.
+// Pointers from iterators are not included in reference counts.
+// Iterators are assumed to be thread private. Ropes can
+// be shared.
+
+template<class charT, class Alloc>
+class __rope_iterator_base:
+ public random_access_iterator<charT, ptrdiff_t> {
+ friend class rope<charT, Alloc>;
+ public:
+ typedef __rope_RopeBase<charT,Alloc> RopeBase;
+ // Borland doesnt want this to be protected.
+ protected:
+ enum { path_cache_len = 4 }; // Must be <= 9.
+ enum { iterator_buf_len = 15 };
+ size_t current_pos;
+ RopeBase * root; // The whole rope.
+ size_t leaf_pos; // Starting position for current leaf
+ __GC_CONST charT * buf_start;
+ // Buffer possibly
+ // containing current char.
+ __GC_CONST charT * buf_ptr;
+ // Pointer to current char in buffer.
+ // != 0 ==> buffer valid.
+ __GC_CONST charT * buf_end;
+ // One past last valid char in buffer.
+ // What follows is the path cache. We go out of our
+ // way to make this compact.
+ // Path_end contains the bottom section of the path from
+ // the root to the current leaf.
+ const RopeBase * path_end[path_cache_len];
+ int leaf_index; // Last valid pos in path_end;
+ // path_end[0] ... path_end[leaf_index-1]
+ // point to concatenation nodes.
+ unsigned char path_directions;
+ // (path_directions >> i) & 1 is 1
+ // iff we got from path_end[leaf_index - i - 1]
+ // to path_end[leaf_index - i] by going to the
+ // right. Assumes path_cache_len <= 9.
+ charT tmp_buf[iterator_buf_len];
+ // Short buffer for surrounding chars.
+ // This is useful primarily for
+ // RopeFunctions. We put the buffer
+ // here to avoid locking in the
+ // multithreaded case.
+ // The cached path is generally assumed to be valid
+ // only if the buffer is valid.
+ static void setbuf(__rope_iterator_base &x);
+ // Set buffer contents given
+ // path cache.
+ static void setcache(__rope_iterator_base &x);
+ // Set buffer contents and
+ // path cache.
+ static void setcache_for_incr(__rope_iterator_base &x);
+ // As above, but assumes path
+ // cache is valid for previous posn.
+ __rope_iterator_base() {}
+ __rope_iterator_base(RopeBase * root, size_t pos):
+ root(root), current_pos(pos), buf_ptr(0) {}
+ __rope_iterator_base(const __rope_iterator_base& x) {
+ if (0 != x.buf_ptr) {
+ *this = x;
+ } else {
+ current_pos = x.current_pos;
+ root = x.root;
+ buf_ptr = 0;
+ }
+ }
+ void incr(size_t n);
+ void decr(size_t n);
+ public:
+ size_t index() const { return current_pos; }
+};
+
+template<class charT, class Alloc> class __rope_iterator;
+
+template<class charT, class Alloc>
+class __rope_const_iterator : public __rope_iterator_base<charT,Alloc> {
+ friend class rope<charT,Alloc>;
+ protected:
+ __rope_const_iterator(const RopeBase * root, size_t pos):
+ __rope_iterator_base<charT,Alloc>(
+ const_cast<RopeBase *>(root), pos)
+ // Only nonconst iterators modify root ref count
+ {}
+
+ public:
+ __rope_const_iterator() {};
+ __rope_const_iterator(const __rope_const_iterator & x) :
+ __rope_iterator_base<charT,Alloc>(x) { }
+ __rope_const_iterator(const __rope_iterator<charT,Alloc> & x);
+ __rope_const_iterator(const rope<charT,Alloc> &r, size_t pos) :
+ __rope_iterator_base<charT,Alloc>(r.tree_ptr, pos) {}
+ __rope_const_iterator& operator= (const __rope_const_iterator & x) {
+ if (0 != x.buf_ptr) {
+ *this = x;
+ } else {
+ current_pos = x.current_pos;
+ root = x.root;
+ buf_ptr = 0;
+ }
+ return(*this);
+ }
+ const charT& operator*() {
+ if (0 == buf_ptr) setcache(*this);
+ return *buf_ptr;
+ }
+ __rope_const_iterator& operator++() {
+ __GC_CONST charT * next;
+ if (0 != buf_ptr && (next = buf_ptr + 1) < buf_end) {
+ buf_ptr = next;
+ ++current_pos;
+ } else {
+ incr(1);
+ }
+ return *this;
+ }
+ __rope_const_iterator& operator+=(ptrdiff_t n) {
+ if (n >= 0) {
+ incr(n);
+ } else {
+ decr(-n);
+ }
+ return *this;
+ }
+ __rope_const_iterator& operator--() {
+ decr(1);
+ return *this;
+ }
+ __rope_const_iterator& operator-=(ptrdiff_t n) {
+ if (n >= 0) {
+ decr(n);
+ } else {
+ incr(-n);
+ }
+ return *this;
+ }
+ __rope_const_iterator operator++(int) {
+ size_t old_pos = current_pos;
+ incr(1);
+ return __rope_const_iterator<charT,Alloc>(root, old_pos);
+ // This makes a subsequent dereference expensive.
+ // Perhaps we should instead copy the iterator
+ // if it has a valid cache?
+ }
+ __rope_const_iterator operator--(int) {
+ size_t old_pos = current_pos;
+ decr(1);
+ return __rope_const_iterator<charT,Alloc>(root, old_pos);
+ }
+ friend __rope_const_iterator<charT,Alloc> operator-
+ (const __rope_const_iterator<charT,Alloc> & x,
+ ptrdiff_t n);
+ friend __rope_const_iterator<charT,Alloc> operator+
+ (const __rope_const_iterator<charT,Alloc> & x,
+ ptrdiff_t n);
+ friend __rope_const_iterator<charT,Alloc> operator+
+ (ptrdiff_t n,
+ const __rope_const_iterator<charT,Alloc> & x);
+ charT operator[](size_t n) {
+ return rope<charT,Alloc>::fetch(root, current_pos + n);
+ }
+ friend bool operator==
+ (const __rope_const_iterator<charT,Alloc> & x,
+ const __rope_const_iterator<charT,Alloc> & y);
+ friend bool operator<
+ (const __rope_const_iterator<charT,Alloc> & x,
+ const __rope_const_iterator<charT,Alloc> & y);
+ friend ptrdiff_t operator-
+ (const __rope_const_iterator<charT,Alloc> & x,
+ const __rope_const_iterator<charT,Alloc> & y);
+};
+
+template<class charT, class Alloc>
+class __rope_iterator : public __rope_iterator_base<charT,Alloc> {
+ friend class rope<charT,Alloc>;
+ protected:
+ rope<charT,Alloc> * root_rope;
+ // root is treated as a cached version of this,
+ // and is used to detect changes to the underlying
+ // rope.
+ // Root is included in the reference count.
+ // This is necessary so that we can detect changes reliably.
+ // Unfortunately, it requires careful bookkeeping for the
+ // nonGC case.
+ __rope_iterator(rope<charT,Alloc> * r, size_t pos):
+ __rope_iterator_base<charT,Alloc>(r -> tree_ptr, pos),
+ root_rope(r) {
+ RopeBase::ref(root);
+ }
+ void check();
+ public:
+ rope<charT,Alloc>& container() { return *root_rope; }
+ __rope_iterator() {
+ root = 0; // Needed for reference counting.
+ };
+ __rope_iterator(const __rope_iterator & x) :
+ __rope_iterator_base<charT,Alloc>(x) {
+ root_rope = x.root_rope;
+ RopeBase::ref(root);
+ }
+ __rope_iterator(rope<charT,Alloc>& r, size_t pos);
+ ~__rope_iterator() {
+ RopeBase::unref(root);
+ }
+ __rope_iterator& operator= (const __rope_iterator & x) {
+ RopeBase *old = root;
+
+ RopeBase::ref(x.root);
+ if (0 != x.buf_ptr) {
+ *this = x;
+ } else {
+ current_pos = x.current_pos;
+ root = x.root;
+ root_rope = x.root_rope;
+ buf_ptr = 0;
+ }
+ RopeBase::unref(old);
+ return(*this);
+ }
+ __rope_charT_ref_proxy<charT,Alloc> operator*() {
+ check();
+ if (0 == buf_ptr) {
+ return __rope_charT_ref_proxy<charT,Alloc>(root_rope, current_pos);
+ } else {
+ return __rope_charT_ref_proxy<charT,Alloc>(root_rope,
+ current_pos, *buf_ptr);
+ }
+ }
+ __rope_iterator& operator++() {
+ incr(1);
+ return *this;
+ }
+ __rope_iterator& operator+=(difference_type n) {
+ if (n >= 0) {
+ incr(n);
+ } else {
+ decr(-n);
+ }
+ return *this;
+ }
+ __rope_iterator& operator--() {
+ decr(1);
+ return *this;
+ }
+ __rope_iterator& operator-=(difference_type n) {
+ if (n >= 0) {
+ decr(n);
+ } else {
+ incr(-n);
+ }
+ return *this;
+ }
+ __rope_iterator operator++(int) {
+ size_t old_pos = current_pos;
+ incr(1);
+ return __rope_iterator<charT,Alloc>(root_rope, old_pos);
+ }
+ __rope_iterator operator--(int) {
+ size_t old_pos = current_pos;
+ decr(1);
+ return __rope_iterator<charT,Alloc>(root_rope, old_pos);
+ }
+ __rope_charT_ref_proxy<charT,Alloc> operator[](ptrdiff_t n) {
+ return __rope_charT_ref_proxy<charT,Alloc>(root_rope, current_pos + n);
+ }
+ friend bool operator==
+ (const __rope_iterator<charT,Alloc> & x,
+ const __rope_iterator<charT,Alloc> & y);
+ friend bool operator<
+ (const __rope_iterator<charT,Alloc> & x,
+ const __rope_iterator<charT,Alloc> & y);
+ friend ptrdiff_t operator-
+ (const __rope_iterator<charT,Alloc> & x,
+ const __rope_iterator<charT,Alloc> & y);
+ friend __rope_iterator<charT,Alloc> operator-
+ (const __rope_iterator<charT,Alloc> & x,
+ ptrdiff_t n);
+ friend __rope_iterator<charT,Alloc> operator+
+ (const __rope_iterator<charT,Alloc> & x,
+ ptrdiff_t n);
+ friend __rope_iterator<charT,Alloc> operator+
+ (ptrdiff_t n,
+ const __rope_iterator<charT,Alloc> & x);
+
+};
+
+template <class charT, class Alloc>
+class rope {
+ public:
+ typedef charT value_type;
+ typedef ptrdiff_t difference_type;
+ typedef size_t size_type;
+ typedef const charT& const_reference;
+ typedef const charT* const_pointer;
+ typedef __rope_iterator<charT,Alloc> iterator;
+ typedef __rope_const_iterator<charT,Alloc> const_iterator;
+ typedef __rope_charT_ref_proxy<charT,Alloc> reference;
+ typedef __rope_charT_ptr_proxy<charT,Alloc> pointer;
+
+ friend class __rope_iterator<charT,Alloc>;
+ friend class __rope_const_iterator<charT,Alloc>;
+ friend struct __rope_RopeBase<charT,Alloc>;
+ friend class __rope_iterator_base<charT,Alloc>;
+ friend class __rope_charT_ptr_proxy<charT,Alloc>;
+ friend class __rope_charT_ref_proxy<charT,Alloc>;
+ friend struct __rope_RopeSubstring<charT,Alloc>;
+
+ protected:
+ typedef __GC_CONST charT * cstrptr;
+# ifdef __STL_SGI_THREADS
+ static cstrptr atomic_swap(cstrptr *p, cstrptr q) {
+# if __mips < 3 || !(defined (_ABIN32) || defined(_ABI64))
+ return (cstrptr) test_and_set((unsigned long *)p,
+ (unsigned long)q);
+# else
+ return (cstrptr) __test_and_set((unsigned long *)p,
+ (unsigned long)q);
+# endif
+ }
+# elif defined(__STL_WIN32THREADS)
+ static cstrptr atomic_swap(cstrptr *p, cstrptr q) {
+ return (cstrptr) InterlockedExchange((LPLONG)p, (LONG)q);
+ }
+# elif defined(_PTHREADS)
+ // This should be portable, but performance is expected
+ // to be quite awful. This really needs platform specific
+ // code.
+ static pthread_mutex_t swap_lock;
+ static cstrptr atomic_swap(cstrptr *p, cstrptr q) {
+ pthread_mutex_lock(&swap_lock);
+ cstrptr result = *p;
+ *p = q;
+ pthread_mutex_unlock(&swap_lock);
+ return result;
+ }
+# else
+ static cstrptr atomic_swap(cstrptr *p, cstrptr q) {
+ cstrptr result = *p;
+ *p = q;
+ return result;
+ }
+# endif
+
+ static charT empty_c_str[1];
+
+ typedef simple_alloc<__rope_RopeConcatenation<charT,Alloc>, Alloc> CAlloc;
+ typedef simple_alloc<__rope_RopeLeaf<charT,Alloc>, Alloc> LAlloc;
+ typedef simple_alloc<__rope_RopeFunction<charT,Alloc>, Alloc> FAlloc;
+ typedef simple_alloc<__rope_RopeSubstring<charT,Alloc>, Alloc> SAlloc;
+ static bool is0(charT c) { return c == __eos((charT *)0); }
+ enum { copy_max = 23 };
+ // For strings shorter than copy_max, we copy to
+ // concatenate.
+
+ typedef __rope_RopeBase<charT,Alloc> RopeBase;
+ typedef __rope_RopeConcatenation<charT,Alloc> RopeConcatenation;
+ typedef __rope_RopeLeaf<charT,Alloc> RopeLeaf;
+ typedef __rope_RopeFunction<charT,Alloc> RopeFunction;
+ typedef __rope_RopeSubstring<charT,Alloc> RopeSubstring;
+
+ // The only data member of a rope:
+ RopeBase *tree_ptr;
+
+ // Retrieve a character at the indicated position.
+ static charT fetch(RopeBase * r, size_type pos);
+
+# ifndef __GC
+ // Obtain a pointer to the character at the indicated position.
+ // The pointer can be used to change the character.
+ // If such a pointer cannot be produced, as is frequently the
+ // case, 0 is returned instead.
+ // (Returns nonzero only if all nodes in the path have a refcount
+ // of 1.)
+ static charT * fetch_ptr(RopeBase * r, size_type pos);
+# endif
+
+ static bool apply_to_pieces(
+ // should be template parameter
+ __rope_char_consumer<charT>& c,
+ const RopeBase * r,
+ size_t begin, size_t end);
+ // begin and end are assumed to be in range.
+
+# ifndef __GC
+ static void unref(RopeBase* t)
+ {
+ RopeBase::unref(t);
+ }
+ static void ref(RopeBase* t)
+ {
+ RopeBase::ref(t);
+ }
+# else /* __GC */
+ static void unref(RopeBase* t) {}
+ static void ref(RopeBase* t) {}
+# endif
+
+
+# ifdef __GC
+ typedef __rope_RopeBase<charT,Alloc> * self_destruct_ptr;
+# else
+ typedef __rope_self_destruct_ptr<charT,Alloc> self_destruct_ptr;
+# endif
+
+ // Result is counted in refcount.
+ static RopeBase * substring(RopeBase * base,
+ size_t start, size_t endp1);
+
+ static RopeBase * concat_char_iter(RopeBase * r,
+ const charT *iter, size_t slen);
+ // Concatenate rope and char ptr, copying s.
+ // Should really take an arbitrary iterator.
+ // Result is counted in refcount.
+ static RopeBase * destr_concat_char_iter(RopeBase * r,
+ const charT *iter, size_t slen)
+ // As above, but one reference to r is about to be
+ // destroyed. Thus the pieces may be recycled if all
+ // relevent reference counts are 1.
+# ifdef __GC
+ // We can't really do anything since refcounts are unavailable.
+ { return concat_char_iter(r, iter, slen); }
+# else
+ ;
+# endif
+
+ static RopeBase * concat(RopeBase *left, RopeBase *right);
+ // General concatenation on RopeBase. Result
+ // has refcount of 1. Adjusts argument refcounts.
+
+ public:
+ void apply_to_pieces( size_t begin, size_t end,
+ __rope_char_consumer<charT>& c) const {
+ apply_to_pieces(c, tree_ptr, begin, end);
+ }
+
+
+ protected:
+
+ static size_t rounded_up_size(size_t n) {
+ return RopeBase::rounded_up_size(n);
+ }
+
+ static size_t allocated_capacity(size_t n) {
+ if (__is_basic_char_type((charT *)0)) {
+ return rounded_up_size(n) - 1;
+ } else {
+ return rounded_up_size(n);
+ }
+ }
+
+ // s should really be an arbitrary input iterator.
+ // Adds a trailing NULL for basic char types.
+ static charT * alloc_copy(const charT *s, size_t size)
+ {
+ charT * result = (charT *)
+ Alloc::allocate(rounded_up_size(size));
+
+ uninitialized_copy_n(s, size, result);
+ __cond_store_eos(result[size]);
+ return(result);
+ }
+
+ // Basic constructors for rope tree nodes.
+ // These return tree nodes with a 0 reference count.
+ static RopeLeaf * RopeLeaf_from_char_ptr(__GC_CONST charT *s,
+ size_t size);
+ // Takes ownership of its argument.
+ // Result has refcount 1.
+ // In the nonGC, basic_char_type case it assumes that s
+ // is eos-terminated.
+ // In the nonGC case, it was allocated from Alloc with
+ // rounded_up_size(size).
+
+ // Concatenation of nonempty strings.
+ // Always builds a concatenation node.
+ // Rebalances if the result is too deep.
+ // Result has refcount 1.
+ // Does not increment left and right ref counts even though
+ // they are referenced.
+ static RopeBase * tree_concat(RopeBase * left, RopeBase * right);
+
+ // Result has refcount 1.
+ // If delete_fn is true, then fn is deleted when the rope
+ // becomes inaccessible.
+ static RopeFunction * RopeFunction_from_fn
+ (char_producer<charT> *fn, size_t size,
+ bool delete_fn);
+
+ // Concatenation helper functions
+ static RopeLeaf * leaf_concat_char_iter
+ (RopeLeaf * r, const charT * iter, size_t slen);
+ // Concatenate by copying leaf.
+ // should take an arbitrary iterator
+ // result has refcount 1.
+# ifndef __GC
+ static RopeLeaf * destr_leaf_concat_char_iter
+ (RopeLeaf * r, const charT * iter, size_t slen);
+ // A version that potentially clobbers r if r -> refcount == 1.
+# endif
+
+ // A helper function for exponentiating strings.
+ // This uses a nonstandard refcount convention.
+ // The result has refcount 0.
+ struct concat_fn;
+ friend struct rope<charT,Alloc>::concat_fn;
+
+ struct concat_fn
+ : binary_function<RopeBase *, RopeBase *, RopeBase *> {
+ RopeBase * operator() (RopeBase * x, RopeBase *y) {
+ RopeBase * result;
+ x -> ref_nonnil();
+ y -> ref_nonnil();
+ __STL_TRY
+ result = tree_concat(x, y);
+# ifndef __GC
+ result -> refcount = 0;
+# endif
+ __STL_UNWIND(unref(x); unref(y));
+ return result;
+ // In the nonGC case, x and y must remain accessible through
+ // the result. Use of concat could result on a memory leak.
+ }
+ };
+
+ friend RopeBase* identity_element(concat_fn) { return 0; }
+
+ static size_t char_ptr_len(const charT * s);
+ // slightly generalized strlen
+
+ rope(RopeBase *t) : tree_ptr(t) { }
+
+
+ // Copy r to the CharT buffer.
+ // Returns buffer + r -> size.
+ // Assumes that buffer is uninitialized.
+ static charT * flatten(RopeBase * r, charT * buffer);
+
+ // Again, with explicit starting position and length.
+ // Assumes that buffer is uninitialized.
+ static charT * flatten(RopeBase * r,
+ size_t start, size_t len,
+ charT * buffer);
+
+ static const unsigned long min_len[RopeBase::max_rope_depth + 1];
+
+ static bool is_balanced(RopeBase *r)
+ { return (r -> size >= min_len[r -> depth]); }
+
+ static bool is_almost_balanced(RopeBase *r)
+ { return (r -> depth == 0 ||
+ r -> size >= min_len[r -> depth - 1]); }
+
+ static bool is_roughly_balanced(RopeBase *r)
+ { return (r -> depth <= 1 ||
+ r -> size >= min_len[r -> depth - 2]); }
+
+ // Assumes the result is not empty.
+ static RopeBase * concat_and_set_balanced(RopeBase *left,
+ RopeBase *right)
+ {
+ RopeBase * result = concat(left, right);
+ if (is_balanced(result)) result -> is_balanced = true;
+ return result;
+ }
+
+ // The basic rebalancing operation. Logically copies the
+ // rope. The result has refcount of 1. The client will
+ // usually decrement the reference count of r.
+ // The result isd within height 2 of balanced by the above
+ // definition.
+ static RopeBase * balance(RopeBase * r);
+
+ // Add all unbalanced subtrees to the forest of balanceed trees.
+ // Used only by balance.
+ static void add_to_forest(RopeBase *r, RopeBase **forest);
+
+ // Add r to forest, assuming r is already balanced.
+ static void add_leaf_to_forest(RopeBase *r, RopeBase **forest);
+
+ // Print to stdout, exposing structure
+ static void dump(RopeBase * r, int indent = 0);
+
+ // Return -1, 0, or 1 if x < y, x == y, or x > y resp.
+ static int compare(const RopeBase *x, const RopeBase *y);
+
+ public:
+ bool empty() const { return 0 == tree_ptr; }
+
+ // Comparison member function. This is public only for those
+ // clients that need a ternary comparison. Others
+ // should use the comparison operators below.
+ int compare(const rope &y) const {
+ return compare(tree_ptr, y.tree_ptr);
+ }
+
+ rope(const charT *s)
+ {
+ size_t len = char_ptr_len(s);
+
+ if (0 == len) {
+ tree_ptr = 0;
+ } else {
+ tree_ptr = RopeLeaf_from_char_ptr(alloc_copy(s, len), len);
+# ifndef __GC
+ __stl_assert(1 == tree_ptr -> refcount);
+# endif
+ }
+ }
+
+ rope(const charT *s, size_t len)
+ {
+ if (0 == len) {
+ tree_ptr = 0;
+ } else {
+ tree_ptr = RopeLeaf_from_char_ptr(alloc_copy(s, len), len);
+ }
+ }
+
+ rope(const charT *s, charT *e)
+ {
+ size_t len = e - s;
+
+ if (0 == len) {
+ tree_ptr = 0;
+ } else {
+ tree_ptr = RopeLeaf_from_char_ptr(alloc_copy(s, len), len);
+ }
+ }
+
+ rope(const const_iterator& s, const const_iterator& e)
+ {
+ tree_ptr = substring(s.root, s.current_pos, e.current_pos);
+ }
+
+ rope(const iterator& s, const iterator& e)
+ {
+ tree_ptr = substring(s.root, s.current_pos, e.current_pos);
+ }
+
+ rope(charT c)
+ {
+ charT * buf = (charT *)Alloc::allocate(rounded_up_size(1));
+
+ construct(buf, c);
+ tree_ptr = RopeLeaf_from_char_ptr(buf, 1);
+ }
+
+ rope(size_t n, charT c);
+
+ // Should really be templatized with respect to the iterator type
+ // and use sequence_buffer. (It should perhaps use sequence_buffer
+ // even now.)
+ rope(const charT *i, const charT *j)
+ {
+ if (i == j) {
+ tree_ptr = 0;
+ } else {
+ size_t len = j - i;
+ tree_ptr = RopeLeaf_from_char_ptr(alloc_copy(i, len), len);
+ }
+ }
+
+ rope()
+ {
+ tree_ptr = 0;
+ }
+
+ // Construct a rope from a function that can compute its members
+ rope(char_producer<charT> *fn, size_t len, bool delete_fn)
+ {
+ tree_ptr = RopeFunction_from_fn(fn, len, delete_fn);
+ }
+
+ rope(const rope &x)
+ {
+ tree_ptr = x.tree_ptr;
+ ref(tree_ptr);
+ }
+
+ ~rope()
+ {
+ unref(tree_ptr);
+ }
+
+ rope& operator=(const rope& x)
+ {
+ RopeBase *old = tree_ptr;
+ tree_ptr = x.tree_ptr;
+ ref(tree_ptr);
+ unref(old);
+ return(*this);
+ }
+
+ void push_back(charT x)
+ {
+ RopeBase *old = tree_ptr;
+ tree_ptr = concat_char_iter(tree_ptr, &x, 1);
+ unref(old);
+ }
+
+ void pop_back()
+ {
+ RopeBase *old = tree_ptr;
+ tree_ptr = substring(tree_ptr, 0, tree_ptr -> size - 1);
+ unref(old);
+ }
+
+ charT back() const
+ {
+ return fetch(tree_ptr, tree_ptr -> size - 1);
+ }
+
+ void push_front(const charT& x)
+ {
+ RopeBase *old = tree_ptr;
+ charT *buf = alloc_copy(&x, 1);
+ RopeBase *left;
+
+ __STL_TRY
+ left = RopeLeaf_from_char_ptr(buf, 1);
+ __STL_UNWIND(RopeBase::free_string(buf, 1))
+ __STL_TRY
+ tree_ptr = concat(left, tree_ptr);
+ unref(old);
+ __STL_ALWAYS(unref(left))
+ }
+
+ void pop_front()
+ {
+ RopeBase *old = tree_ptr;
+ tree_ptr = substring(tree_ptr, 1, tree_ptr -> size);
+ unref(old);
+ }
+
+ charT front() const
+ {
+ return fetch(tree_ptr, 0);
+ }
+
+ void balance()
+ {
+ RopeBase *old = tree_ptr;
+ tree_ptr = balance(tree_ptr);
+ unref(old);
+ }
+
+ void copy(charT * buffer) const {
+ destroy(buffer, buffer + size());
+ flatten(tree_ptr, buffer);
+ }
+
+ // This is the copy function from the standard, but
+ // with the arguments reordered to make it consistent with the
+ // rest of the interface.
+ // Note that this guaranteed not to compile if the draft standard
+ // order is assumed.
+ size_type copy(size_type pos, size_type n, charT *buffer) const {
+ size_t sz = size();
+ size_t len = (pos + n > sz? sz - pos : n);
+
+ destroy(buffer, buffer + len);
+ flatten(tree_ptr, pos, len, buffer);
+ return len;
+ }
+
+ // Print to stdout, exposing structure. May be useful for
+ // performance debugging.
+ void dump() {
+ dump(tree_ptr);
+ }
+
+ // Convert to 0 terminated string in new allocated memory.
+ // Embedded 0s in the input do not terminate the copy.
+ const charT * c_str() const;
+
+ // As above, but lso use the flattened representation as the
+ // the new rope representation.
+ const charT * replace_with_c_str();
+
+ // Reclaim memory for the c_str generated flattened string.
+ // Intentionally undocumented, since it's hard to say when this
+ // is safe for multiple threads.
+ void delete_c_str () {
+ if (0 == tree_ptr) return;
+ if (RopeBase::leaf == tree_ptr -> tag
+ && ((RopeLeaf *)tree_ptr) -> data == tree_ptr -> c_string) {
+ // Representation shared
+ return;
+ }
+# ifndef __GC
+ tree_ptr -> free_c_string();
+# endif
+ tree_ptr -> c_string = 0;
+ }
+
+ charT operator[] (size_type pos) const {
+ return fetch(tree_ptr, pos);
+ }
+
+ charT at(size_type pos) const {
+ // if (pos >= size()) throw out_of_range;
+ return (*this)[pos];
+ }
+
+ const_iterator begin() const {
+ return(const_iterator(tree_ptr, 0));
+ }
+
+ // An easy way to get a const iterator from a non-const container.
+ const_iterator const_begin() const {
+ return(const_iterator(tree_ptr, 0));
+ }
+
+ const_iterator end() const {
+ return(const_iterator(tree_ptr, size()));
+ }
+
+ const_iterator const_end() const {
+ return(const_iterator(tree_ptr, size()));
+ }
+
+ size_type size() const {
+ return(0 == tree_ptr? 0 : tree_ptr -> size);
+ }
+
+ size_type length() const {
+ return size();
+ }
+
+ size_type max_size() const {
+ return min_len[RopeBase::max_rope_depth-1] - 1;
+ // Guarantees that the result can be sufficirntly
+ // balanced. Longer ropes will probably still work,
+ // but it's harder to make guarantees.
+ }
+
+ typedef reverse_iterator<const_iterator, value_type, const_reference,
+ difference_type> const_reverse_iterator;
+
+ const_reverse_iterator rbegin() const {
+ return const_reverse_iterator(end());
+ }
+
+ const_reverse_iterator const_rbegin() const {
+ return const_reverse_iterator(end());
+ }
+
+ const_reverse_iterator rend() const {
+ return const_reverse_iterator(begin());
+ }
+
+ const_reverse_iterator const_rend() const {
+ return const_reverse_iterator(begin());
+ }
+
+ friend rope<charT,Alloc> operator+ (const rope<charT,Alloc> &left,
+ const rope<charT,Alloc> &right);
+
+ friend rope<charT,Alloc> operator+ (const rope<charT,Alloc> &left,
+ const charT* right);
+
+ friend rope<charT,Alloc> operator+ (const rope<charT,Alloc> &left,
+ charT right);
+
+ // The symmetric cases are intentionally omitted, since they're presumed
+ // to be less common, and we don't handle them as well.
+
+ // The following should really be templatized.
+ // The first argument should be an input iterator or
+ // forward iterator with value_type charT.
+ rope& append(const charT* iter, size_t n) {
+ RopeBase* result = destr_concat_char_iter(tree_ptr, iter, n);
+ unref(tree_ptr);
+ tree_ptr = result;
+ return *this;
+ }
+
+ rope& append(const charT* c_string) {
+ size_t len = char_ptr_len(c_string);
+ append(c_string, len);
+ return(*this);
+ }
+
+ rope& append(const charT* s, const charT* e) {
+ RopeBase* result =
+ destr_concat_char_iter(tree_ptr, s, e - s);
+ unref(tree_ptr);
+ tree_ptr = result;
+ return *this;
+ }
+
+ rope& append(const_iterator s, const_iterator e) {
+ __stl_assert(s.root == e.root);
+ self_destruct_ptr appendee(substring(s.root, s.current_pos,
+ e.current_pos));
+ RopeBase* result = concat(tree_ptr, (RopeBase *)appendee);
+ unref(tree_ptr);
+ tree_ptr = result;
+ return *this;
+ }
+
+ rope& append(charT c) {
+ RopeBase* result = destr_concat_char_iter(tree_ptr, &c, 1);
+ unref(tree_ptr);
+ tree_ptr = result;
+ return *this;
+ }
+
+ rope& append() { return append(charT()); }
+
+ rope& append(const rope& y) {
+ RopeBase* result = concat(tree_ptr, y.tree_ptr);
+ unref(tree_ptr);
+ tree_ptr = result;
+ return *this;
+ }
+
+ rope& append(size_t n, charT c) {
+ rope<charT,Alloc> last(n, c);
+ return append(last);
+ }
+
+ void swap(rope& b) {
+ RopeBase * tmp = tree_ptr;
+ tree_ptr = b.tree_ptr;
+ b.tree_ptr = tmp;
+ }
+
+
+ protected:
+ // Result is included in refcount.
+ static RopeBase * replace(RopeBase *old, size_t pos1,
+ size_t pos2, RopeBase *r) {
+ if (0 == old) { ref(r); return r; }
+ self_destruct_ptr left(substring(old, 0, pos1));
+ self_destruct_ptr right(substring(old, pos2, old -> size));
+ RopeBase * result;
+
+ if (0 == r) {
+ result = concat(left, right);
+ } else {
+ self_destruct_ptr left_result(concat(left, r));
+ result = concat(left_result, right);
+ }
+ return result;
+ }
+
+ public:
+ void insert(size_t p, const rope& r) {
+ RopeBase * result = replace(tree_ptr, p, p,
+ r.tree_ptr);
+ unref(tree_ptr);
+ tree_ptr = result;
+ }
+
+ void insert(size_t p, size_t n, charT c) {
+ rope<charT,Alloc> r(n,c);
+ insert(p, r);
+ }
+
+ void insert(size_t p, const charT * i, size_t n) {
+ self_destruct_ptr left(substring(tree_ptr, 0, p));
+ self_destruct_ptr right(substring(tree_ptr, p, size()));
+ self_destruct_ptr left_result(concat_char_iter(left, i, n));
+ RopeBase * result =
+ concat(left_result, right);
+ unref(tree_ptr);
+ tree_ptr = result;
+ }
+
+ void insert(size_t p, const charT * c_string) {
+ insert(p, c_string, char_ptr_len(c_string));
+ }
+
+ void insert(size_t p, charT c) {
+ insert(p, &c, 1);
+ }
+
+ void insert(size_t p) {
+ charT c = charT();
+ insert(p, &c, 1);
+ }
+
+ void insert(size_t p, const charT *i, const charT *j) {
+ rope r(i, j);
+ insert(p, r);
+ }
+
+ void insert(size_t p, const const_iterator& i,
+ const const_iterator& j) {
+ rope r(i, j);
+ insert(p, r);
+ }
+
+ void insert(size_t p, const iterator& i,
+ const iterator& j) {
+ rope r(i, j);
+ insert(p, r);
+ }
+
+ // (position, length) versions of replace operations:
+
+ void replace(size_t p, size_t n, const rope& r) {
+ RopeBase * result = replace(tree_ptr, p, p + n,
+ r.tree_ptr);
+ unref(tree_ptr);
+ tree_ptr = result;
+ }
+
+ void replace(size_t p, size_t n, const charT *i, size_t i_len) {
+ rope r(i, i_len);
+ replace(p, n, r);
+ }
+
+ void replace(size_t p, size_t n, charT c) {
+ rope r(c);
+ replace(p, n, r);
+ }
+
+ void replace(size_t p, size_t n, const charT *c_string) {
+ rope r(c_string);
+ replace(p, n, r);
+ }
+
+ void replace(size_t p, size_t n, const charT *i, const charT *j) {
+ rope r(i, j);
+ replace(p, n, r);
+ }
+
+ void replace(size_t p, size_t n,
+ const const_iterator& i, const const_iterator& j) {
+ rope r(i, j);
+ replace(p, n, r);
+ }
+
+ void replace(size_t p, size_t n,
+ const iterator& i, const iterator& j) {
+ rope r(i, j);
+ replace(p, n, r);
+ }
+
+ // Single character variants:
+ void replace(size_t p, charT c) {
+ iterator i(this, p);
+ *i = c;
+ }
+
+ void replace(size_t p, const rope& r) {
+ replace(p, 1, r);
+ }
+
+ void replace(size_t p, const charT *i, size_t i_len) {
+ replace(p, 1, i, i_len);
+ }
+
+ void replace(size_t p, const charT *c_string) {
+ replace(p, 1, c_string);
+ }
+
+ void replace(size_t p, const charT *i, const charT *j) {
+ replace(p, 1, i, j);
+ }
+
+ void replace(size_t p, const const_iterator& i,
+ const const_iterator& j) {
+ replace(p, 1, i, j);
+ }
+
+ void replace(size_t p, const iterator& i,
+ const iterator& j) {
+ replace(p, 1, i, j);
+ }
+
+ // Erase, (position, size) variant.
+ void erase(size_t p, size_t n) {
+ RopeBase * result = replace(tree_ptr, p, p + n, 0);
+ unref(tree_ptr);
+ tree_ptr = result;
+ }
+
+ // Erase, single character
+ void erase(size_t p) {
+ erase(p, p + 1);
+ }
+
+ // Insert, iterator variants.
+ iterator insert(const iterator& p, const rope& r)
+ { insert(p.index(), r); return p; }
+ iterator insert(const iterator& p, size_t n, charT c)
+ { insert(p.index(), n, c); return p; }
+ iterator insert(const iterator& p, charT c)
+ { insert(p.index(), c); return p; }
+ iterator insert(const iterator& p )
+ { insert(p.index()); return p; }
+ iterator insert(const iterator& p, const charT *c_string)
+ { insert(p.index(), c_string); return p; }
+ iterator insert(const iterator& p, const charT *i, size_t n)
+ { insert(p.index(), i, n); return p; }
+ iterator insert(const iterator& p, const charT *i, const charT *j)
+ { insert(p.index(), i, j); return p; }
+ iterator insert(const iterator& p,
+ const const_iterator& i, const const_iterator& j)
+ { insert(p.index(), i, j); return p; }
+ iterator insert(const iterator& p,
+ const iterator& i, const iterator& j)
+ { insert(p.index(), i, j); return p; }
+
+ // Replace, range variants.
+ void replace(const iterator& p, const iterator& q,
+ const rope& r)
+ { replace(p.index(), q.index() - p.index(), r); }
+ void replace(const iterator& p, const iterator& q, charT c)
+ { replace(p.index(), q.index() - p.index(), c); }
+ void replace(const iterator& p, const iterator& q,
+ const charT * c_string)
+ { replace(p.index(), q.index() - p.index(), c_string); }
+ void replace(const iterator& p, const iterator& q,
+ const charT *i, size_t n)
+ { replace(p.index(), q.index() - p.index(), i, n); }
+ void replace(const iterator& p, const iterator& q,
+ const charT *i, const charT *j)
+ { replace(p.index(), q.index() - p.index(), i, j); }
+ void replace(const iterator& p, const iterator& q,
+ const const_iterator& i, const const_iterator& j)
+ { replace(p.index(), q.index() - p.index(), i, j); }
+ void replace(const iterator& p, const iterator& q,
+ const iterator& i, const iterator& j)
+ { replace(p.index(), q.index() - p.index(), i, j); }
+
+ // Replace, iterator variants.
+ void replace(const iterator& p, const rope& r)
+ { replace(p.index(), r); }
+ void replace(const iterator& p, charT c)
+ { replace(p.index(), c); }
+ void replace(const iterator& p, const charT * c_string)
+ { replace(p.index(), c_string); }
+ void replace(const iterator& p, const charT *i, size_t n)
+ { replace(p.index(), i, n); }
+ void replace(const iterator& p, const charT *i, const charT *j)
+ { replace(p.index(), i, j); }
+ void replace(const iterator& p, const_iterator i, const_iterator j)
+ { replace(p.index(), i, j); }
+ void replace(const iterator& p, iterator i, iterator j)
+ { replace(p.index(), i, j); }
+
+ // Iterator and range variants of erase
+ void erase(const iterator &p, const iterator &q)
+ { erase(p.index(), q.index() - p.index()); }
+ void erase(const iterator &p)
+ { erase(p.index(), 1); }
+
+ rope substr(size_t start, size_t len = 1) const {
+ return rope<charT,Alloc>(
+ substring(tree_ptr, start, start + len));
+ }
+
+ rope substr(iterator start, iterator end) const {
+ return rope<charT,Alloc>(
+ substring(tree_ptr, start.index(), end.index()));
+ }
+
+ rope substr(iterator start) const {
+ size_t pos = start.index();
+ return rope<charT,Alloc>(
+ substring(tree_ptr, pos, pos + 1));
+ }
+
+ rope substr(const_iterator start, const_iterator end) const {
+ // This might eventually take advantage of the cache in the
+ // iterator.
+ return rope<charT,Alloc>
+ (substring(tree_ptr, start.index(), end.index()));
+ }
+
+ rope<charT,Alloc> substr(const_iterator start) {
+ size_t pos = start.index();
+ return rope<charT,Alloc>(substring(tree_ptr, pos, pos + 1));
+ }
+
+ size_type find(charT c, size_type pos = 0) const;
+ size_type find(charT *s, size_type pos = 0) const {
+ const_iterator result = search(const_begin() + pos, const_end(),
+ s, s + char_ptr_len(s));
+ return result.index();
+ }
+
+ iterator mutable_begin() {
+ return(iterator(this, 0));
+ }
+
+ iterator mutable_end() {
+ return(iterator(this, size()));
+ }
+
+ typedef reverse_iterator<iterator, value_type, reference,
+ difference_type> reverse_iterator;
+
+ reverse_iterator mutable_rbegin() {
+ return reverse_iterator(mutable_end());
+ }
+
+ reverse_iterator mutable_rend() {
+ return reverse_iterator(mutable_begin());
+ }
+
+ reference mutable_reference_at(size_type pos) {
+ return reference(this, pos);
+ }
+
+# ifdef __STD_STUFF
+ reference operator[] (size_type pos) {
+ return charT_ref_proxy(this, pos);
+ }
+
+ reference at(size_type pos) {
+ // if (pos >= size()) throw out_of_range;
+ return (*this)[pos];
+ }
+
+ void resize(size_type n, charT c) {}
+ void resize(size_type n) {}
+ void reserve(size_type res_arg = 0) {}
+ size_type capacity() const {
+ return max_size();
+ }
+
+ // Stuff below this line is dangerous because it's error prone.
+ // I would really like to get rid of it.
+ // copy function with funny arg ordering.
+ size_type copy(charT *buffer, size_type n, size_type pos = 0)
+ const {
+ return copy(pos, n, buffer);
+ }
+
+ iterator end() { return mutable_end(); }
+
+ iterator begin() { return mutable_begin(); }
+
+ reverse_iterator rend() { return mutable_rend(); }
+
+ reverse_iterator rbegin() { return mutable_rbegin(); }
+
+# else
+
+ const_iterator end() { return const_end(); }
+
+ const_iterator begin() { return const_begin(); }
+
+ const_reverse_iterator rend() { return const_rend(); }
+
+ const_reverse_iterator rbegin() { return const_rbegin(); }
+
+# endif
+
+};
+
+template <class charT, class Alloc>
+inline bool operator== (const __rope_const_iterator<charT,Alloc> & x,
+ const __rope_const_iterator<charT,Alloc> & y) {
+ return (x.current_pos == y.current_pos && x.root == y.root);
+}
+
+template <class charT, class Alloc>
+inline bool operator< (const __rope_const_iterator<charT,Alloc> & x,
+ const __rope_const_iterator<charT,Alloc> & y) {
+ return (x.current_pos < y.current_pos);
+}
+
+template <class charT, class Alloc>
+inline ptrdiff_t operator-(const __rope_const_iterator<charT,Alloc> & x,
+ const __rope_const_iterator<charT,Alloc> & y) {
+ return x.current_pos - y.current_pos;
+}
+
+template <class charT, class Alloc>
+inline __rope_const_iterator<charT,Alloc>
+operator-(const __rope_const_iterator<charT,Alloc> & x,
+ ptrdiff_t n) {
+ return __rope_const_iterator<charT,Alloc>(x.root, x.current_pos - n);
+}
+
+template <class charT, class Alloc>
+inline __rope_const_iterator<charT,Alloc>
+operator+(const __rope_const_iterator<charT,Alloc> & x,
+ ptrdiff_t n) {
+ return __rope_const_iterator<charT,Alloc>(x.root, x.current_pos + n);
+}
+
+template <class charT, class Alloc>
+inline __rope_const_iterator<charT,Alloc>
+operator+(ptrdiff_t n,
+ const __rope_const_iterator<charT,Alloc> & x) {
+ return __rope_const_iterator<charT,Alloc>(x.root, x.current_pos + n);
+}
+
+template <class charT, class Alloc>
+inline bool operator== (const __rope_iterator<charT,Alloc> & x,
+ const __rope_iterator<charT,Alloc> & y) {
+ return (x.current_pos == y.current_pos && x.root_rope == y.root_rope);
+}
+
+template <class charT, class Alloc>
+inline bool operator< (const __rope_iterator<charT,Alloc> & x,
+ const __rope_iterator<charT,Alloc> & y) {
+ return (x.current_pos < y.current_pos);
+}
+
+template <class charT, class Alloc>
+inline ptrdiff_t operator-(const __rope_iterator<charT,Alloc> & x,
+ const __rope_iterator<charT,Alloc> & y) {
+ return x.current_pos - y.current_pos;
+}
+
+template <class charT, class Alloc>
+inline __rope_iterator<charT,Alloc>
+operator-(const __rope_iterator<charT,Alloc> & x,
+ ptrdiff_t n) {
+ return __rope_iterator<charT,Alloc>(x.root_rope, x.current_pos - n);
+}
+
+template <class charT, class Alloc>
+inline __rope_iterator<charT,Alloc>
+operator+(const __rope_iterator<charT,Alloc> & x,
+ ptrdiff_t n) {
+ return __rope_iterator<charT,Alloc>(x.root_rope, x.current_pos + n);
+}
+
+template <class charT, class Alloc>
+inline __rope_iterator<charT,Alloc>
+operator+(ptrdiff_t n,
+ const __rope_iterator<charT,Alloc> & x) {
+ return __rope_iterator<charT,Alloc>(x.root_rope, x.current_pos + n);
+}
+
+template <class charT, class Alloc>
+inline
+rope<charT,Alloc>
+operator+ (const rope<charT,Alloc> &left,
+ const rope<charT,Alloc> &right)
+{
+ return rope<charT,Alloc>
+ (rope<charT,Alloc>::concat(left.tree_ptr, right.tree_ptr));
+ // Inlining this should make it possible to keep left and
+ // right in registers.
+}
+
+template <class charT, class Alloc>
+inline
+rope<charT,Alloc>&
+operator+= (rope<charT,Alloc> &left,
+ const rope<charT,Alloc> &right)
+{
+ left.append(right);
+ return left;
+}
+
+template <class charT, class Alloc>
+inline
+rope<charT,Alloc>
+operator+ (const rope<charT,Alloc> &left,
+ const charT* right) {
+ size_t rlen = rope<charT,Alloc>::char_ptr_len(right);
+ return rope<charT,Alloc>
+ (rope<charT,Alloc>::concat_char_iter(left.tree_ptr, right, rlen));
+}
+
+template <class charT, class Alloc>
+inline
+rope<charT,Alloc>&
+operator+= (rope<charT,Alloc> &left,
+ const charT* right) {
+ left.append(right);
+ return left;
+}
+
+template <class charT, class Alloc>
+inline
+rope<charT,Alloc>
+operator+ (const rope<charT,Alloc> &left, charT right) {
+ return rope<charT,Alloc>
+ (rope<charT,Alloc>::concat_char_iter(left.tree_ptr, &right, 1));
+}
+
+template <class charT, class Alloc>
+inline
+rope<charT,Alloc>&
+operator+= (rope<charT,Alloc> &left, charT right) {
+ left.append(right);
+ return left;
+}
+
+template <class charT, class Alloc>
+bool
+operator< (const rope<charT,Alloc> &left, const rope<charT,Alloc> &right) {
+ return left.compare(right) < 0;
+}
+
+template <class charT, class Alloc>
+bool
+operator== (const rope<charT,Alloc> &left, const rope<charT,Alloc> &right) {
+ return left.compare(right) == 0;
+}
+
+template <class charT, class Alloc>
+inline bool operator== (const __rope_charT_ptr_proxy<charT,Alloc> & x,
+ const __rope_charT_ptr_proxy<charT,Alloc> & y) {
+ return (x.pos == y.pos && x.root == y.root);
+}
+
+template<class charT, class Alloc>
+ostream& operator<< (ostream& o, const rope<charT, Alloc>& r);
+
+typedef rope<char, __ALLOC> crope;
+typedef rope<wchar_t, __ALLOC> wrope;
+
+inline crope::reference __mutable_reference_at(crope& c, size_t i)
+{
+ return c.mutable_reference_at(i);
+}
+
+inline wrope::reference __mutable_reference_at(wrope& c, size_t i)
+{
+ return c.mutable_reference_at(i);
+}
+
+inline void swap(crope x, crope y) { x.swap(y); }
+inline void swap(wrope x, wrope y) { x.swap(y); }
+
+// Hash functions should probably be revisited later:
+struct hash<crope>
+{
+ size_t operator()(const crope& str) const
+ {
+ size_t sz = str.size();
+
+ if (0 == sz) return 0;
+ return 13*str[0] + 5*str[sz - 1] + sz;
+ }
+};
+
+struct hash<wrope>
+{
+ size_t operator()(const wrope& str) const
+ {
+ size_t sz = str.size();
+
+ if (0 == sz) return 0;
+ return 13*str[0] + 5*str[sz - 1] + sz;
+ }
+};
+
+# include <ropeimpl.h>
+# endif /* _ROPE_H */
diff --git a/libstdc++/stl/ropeimpl.h b/libstdc++/stl/ropeimpl.h
new file mode 100644
index 00000000000..b90bc08928b
--- /dev/null
+++ b/libstdc++/stl/ropeimpl.h
@@ -0,0 +1,1510 @@
+/*
+ * Copyright (c) 1997
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#if defined(_MSC_VER)
+# include <ostream>
+#else
+# include <iostream.h>
+#endif
+
+// Set buf_start, buf_end, and buf_ptr appropriately, filling tmp_buf
+// if necessary. Assumes path_end[leaf_index] and leaf_pos are correct.
+// Results in a valid buf_ptr if the iterator can be legitimately
+// dereferenced.
+template <class charT, class Alloc>
+void __rope_iterator_base<charT,Alloc>::setbuf
+(__rope_iterator_base<charT,Alloc> &x)
+{
+ const RopeBase * leaf = x.path_end[x.leaf_index];
+ size_t leaf_pos = x.leaf_pos;
+ size_t pos = x.current_pos;
+
+ switch(leaf -> tag) {
+ case RopeBase::leaf:
+ x.buf_start = ((__rope_RopeLeaf<charT,Alloc> *)leaf) -> data;
+ x.buf_ptr = x.buf_start + (pos - leaf_pos);
+ x.buf_end = x.buf_start + leaf -> size;
+ break;
+ case RopeBase::function:
+ case RopeBase::substringfn:
+ {
+ size_t len = iterator_buf_len;
+ size_t buf_start_pos = leaf_pos;
+ size_t leaf_end = leaf_pos + leaf -> size;
+ char_producer<charT> *fn =
+ ((__rope_RopeFunction<charT,Alloc> *)leaf) -> fn;
+
+ if (buf_start_pos + len <= pos) {
+ buf_start_pos = pos - len/4;
+ if (buf_start_pos + len > leaf_end) {
+ buf_start_pos = leaf_end - len;
+ }
+ }
+ if (buf_start_pos + len > leaf_end) {
+ len = leaf_end - buf_start_pos;
+ }
+ (*fn)(buf_start_pos - leaf_pos, len, x.tmp_buf);
+ x.buf_ptr = x.tmp_buf + (pos - buf_start_pos);
+ x.buf_start = x.tmp_buf;
+ x.buf_end = x.tmp_buf + len;
+ }
+ break;
+ default:
+ __stl_assert(0);
+ }
+}
+
+// Set path and buffer inside a rope iterator. We assume that
+// pos and root are already set.
+template <class charT, class Alloc>
+void __rope_iterator_base<charT,Alloc>::setcache
+(__rope_iterator_base<charT,Alloc> &x)
+{
+ const RopeBase * path[RopeBase::max_rope_depth+1];
+ const RopeBase * curr_rope;
+ int curr_depth = -1; /* index into path */
+ size_t curr_start_pos = 0;
+ size_t pos = x.current_pos;
+ unsigned char dirns = 0; // Bit vector indicating right turns in the path
+
+ __stl_assert(pos <= x.root -> size);
+ if (pos >= x.root -> size) {
+ x.buf_ptr = 0;
+ return;
+ }
+ curr_rope = x.root;
+ if (0 != curr_rope -> c_string) {
+ /* Treat the root as a leaf. */
+ x.buf_start = curr_rope -> c_string;
+ x.buf_end = curr_rope -> c_string + curr_rope -> size;
+ x.buf_ptr = curr_rope -> c_string + pos;
+ x.path_end[0] = curr_rope;
+ x.leaf_index = 0;
+ x.leaf_pos = 0;
+ return;
+ }
+ for(;;) {
+ ++curr_depth;
+ __stl_assert(curr_depth <= RopeBase::max_rope_depth);
+ path[curr_depth] = curr_rope;
+ switch(curr_rope -> tag) {
+ case RopeBase::leaf:
+ case RopeBase::function:
+ case RopeBase::substringfn:
+ x.leaf_pos = curr_start_pos;
+ goto done;
+ case RopeBase::concat:
+ {
+ __rope_RopeConcatenation<charT,Alloc> *c =
+ (__rope_RopeConcatenation<charT,Alloc> *)curr_rope;
+ RopeBase * left = c -> left;
+ size_t left_len = left -> size;
+
+ dirns <<= 1;
+ if (pos >= curr_start_pos + left_len) {
+ dirns |= 1;
+ curr_rope = c -> right;
+ curr_start_pos += left_len;
+ } else {
+ curr_rope = left;
+ }
+ }
+ break;
+ }
+ }
+ done:
+ // Copy last section of path into path_end.
+ {
+ int i = -1;
+ int j = curr_depth + 1 - path_cache_len;
+
+ if (j < 0) j = 0;
+ while (j <= curr_depth) {
+ x.path_end[++i] = path[j++];
+ }
+ x.leaf_index = i;
+ }
+ x.path_directions = dirns;
+ setbuf(x);
+}
+
+// Specialized version of the above. Assumes that
+// the path cache is valid for the previous position.
+template <class charT, class Alloc>
+void __rope_iterator_base<charT,Alloc>::setcache_for_incr
+(__rope_iterator_base<charT,Alloc> &x)
+{
+ int current_index = x.leaf_index;
+ const RopeBase * current_node = x.path_end[current_index];
+ size_t len = current_node -> size;
+ size_t node_start_pos = x.leaf_pos;
+ unsigned char dirns = x.path_directions;
+ __rope_RopeConcatenation<charT,Alloc> * c;
+
+ __stl_assert(x.current_pos <= x.root -> size);
+ if (x.current_pos - node_start_pos < len) {
+ /* More stuff in this leaf, we just didn't cache it. */
+ setbuf(x);
+ return;
+ }
+ __stl_assert(node_start_pos + len == x.current_pos);
+ // node_start_pos is starting position of last_node.
+ while (--current_index >= 0) {
+ if (!(dirns & 1) /* Path turned left */) break;
+ current_node = x.path_end[current_index];
+ c = (__rope_RopeConcatenation<charT,Alloc> *)current_node;
+ // Otherwise we were in the right child. Thus we should pop
+ // the concatenation node.
+ node_start_pos -= c -> left -> size;
+ dirns >>= 1;
+ }
+ if (current_index < 0) {
+ // We underflowed the cache. Punt.
+ setcache(x);
+ return;
+ }
+ current_node = x.path_end[current_index];
+ c = (__rope_RopeConcatenation<charT,Alloc> *)current_node;
+ // current_node is a concatenation node. We are positioned on the first
+ // character in its right child.
+ // node_start_pos is starting position of current_node.
+ node_start_pos += c -> left -> size;
+ current_node = c -> right;
+ x.path_end[++current_index] = current_node;
+ dirns |= 1;
+ while (RopeBase::concat == current_node -> tag) {
+ ++current_index;
+ if (path_cache_len == current_index) {
+ int i;
+ for (i = 0; i < path_cache_len-1; i++) {
+ x.path_end[i] = x.path_end[i+1];
+ }
+ --current_index;
+ }
+ current_node =
+ ((__rope_RopeConcatenation<charT,Alloc> *)current_node) -> left;
+ x.path_end[current_index] = current_node;
+ dirns <<= 1;
+ // node_start_pos is unchanged.
+ }
+ x.leaf_index = current_index;
+ x.leaf_pos = node_start_pos;
+ x.path_directions = dirns;
+ setbuf(x);
+}
+
+template <class charT, class Alloc>
+void __rope_iterator_base<charT,Alloc>::incr(size_t n) {
+ current_pos += n;
+ if (0 != buf_ptr) {
+ size_t chars_left = buf_end - buf_ptr;
+ if (chars_left > n) {
+ buf_ptr += n;
+ } else if (chars_left == n) {
+ buf_ptr += n;
+ setcache_for_incr(*this);
+ } else {
+ buf_ptr = 0;
+ }
+ }
+}
+
+template <class charT, class Alloc>
+void __rope_iterator_base<charT,Alloc>::decr(size_t n) {
+ if (0 != buf_ptr) {
+ size_t chars_left = buf_ptr - buf_start;
+ if (chars_left >= n) {
+ buf_ptr -= n;
+ } else {
+ buf_ptr = 0;
+ }
+ }
+ current_pos -= n;
+}
+
+template <class charT, class Alloc>
+void __rope_iterator<charT,Alloc>::check() {
+ if (root_rope -> tree_ptr != root) {
+ // Rope was modified. Get things fixed up.
+ RopeBase::unref(root);
+ root = root_rope -> tree_ptr;
+ RopeBase::ref(root);
+ buf_ptr = 0;
+ }
+}
+
+template <class charT, class Alloc>
+inline __rope_const_iterator<charT, Alloc>::__rope_const_iterator
+(const __rope_iterator<charT,Alloc> & x)
+: __rope_iterator_base<charT,Alloc>(x) { }
+
+template <class charT, class Alloc>
+inline __rope_iterator<charT,Alloc>::__rope_iterator
+(rope<charT,Alloc>& r, size_t pos)
+ : __rope_iterator_base<charT,Alloc>(r.tree_ptr, pos), root_rope(&r) {
+ RopeBase::ref(root);
+}
+
+template <class charT, class Alloc>
+inline size_t rope<charT,Alloc>::char_ptr_len(const charT *s)
+{
+ const charT *p = s;
+
+ while (!is0(*p)) { ++p; }
+ return(p - s);
+}
+
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeLeaf *
+rope<charT,Alloc>::RopeLeaf_from_char_ptr(__GC_CONST charT *s, size_t size)
+{
+ RopeLeaf *t = LAlloc::allocate();
+
+ t -> tag = RopeBase::leaf;
+ if (__is_basic_char_type((charT *)0)) {
+ // already eos terminated.
+ t -> c_string = s;
+ } else {
+ t -> c_string = 0;
+ }
+ t -> is_balanced = true;
+ t -> depth = 0;
+ t -> size = size;
+ t -> data = s;
+# ifndef __GC
+ t -> refcount = 1;
+ t -> init_refcount_lock();
+# endif
+ return (t);
+}
+
+# ifdef __GC
+template <class charT, class Alloc>
+void __rope_RopeBase<charT,Alloc>::fn_finalization_proc(void * tree, void *)
+{
+ delete ((__rope_RopeFunction<charT,Alloc> *)tree) -> fn;
+}
+# endif
+
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeFunction *
+rope<charT,Alloc>::RopeFunction_from_fn
+(char_producer<charT> *fn, size_t size, bool delete_fn)
+{
+ if (0 == size) return 0;
+ RopeFunction *t = FAlloc::allocate();
+ t -> tag = RopeBase::function;
+ t -> c_string = 0;
+ t -> is_balanced = true;
+ t -> depth = 0;
+ t -> size = size;
+ t -> fn = fn;
+# ifdef __GC
+ if (delete_fn) {
+ GC_REGISTER_FINALIZER(t, RopeBase::fn_finalization_proc, 0, 0, 0);
+ }
+# else
+ t -> delete_when_done = delete_fn;
+ t -> refcount = 1;
+ t -> init_refcount_lock();
+# endif
+ return (t);
+}
+
+#ifndef __GC
+
+template <class charT, class Alloc>
+inline void __rope_RopeBase<charT,Alloc>::free_c_string()
+{
+ charT * cstr = c_string;
+ if (0 != cstr) {
+ size_t sz = size + 1;
+ destroy(cstr, cstr + sz);
+ Alloc::deallocate(cstr, sz);
+ }
+}
+
+template <class charT, class Alloc>
+inline void __rope_RopeBase<charT,Alloc>::free_string(charT* s, size_t n)
+{
+ if (!__is_basic_char_type((charT *)0)) {
+ destroy(s, s + n);
+ }
+ Alloc::deallocate(s, rounded_up_size(n));
+}
+
+template <class charT, class Alloc>
+void __rope_RopeBase<charT,Alloc>::free_tree()
+{
+ switch(tag) {
+ case leaf:
+ {
+ __rope_RopeLeaf<charT,Alloc> * l =
+ (__rope_RopeLeaf<charT,Alloc> *)this;
+ charT * d = l -> data;
+
+ if (d != c_string) {
+ free_c_string();
+ }
+ free_string(d, size);
+ LAlloc::deallocate(l);
+ }
+ break;
+ case concat:
+ {
+ __rope_RopeConcatenation<charT,Alloc> * c =
+ (__rope_RopeConcatenation<charT,Alloc> *)this;
+ __rope_RopeBase * left = c -> left;
+ __rope_RopeBase * right = c -> right;
+ free_c_string();
+ left -> unref_nonnil();
+ right -> unref_nonnil();
+ CAlloc::deallocate(c);
+ }
+ break;
+ case function:
+ {
+ __rope_RopeFunction<charT,Alloc> * fn =
+ (__rope_RopeFunction<charT,Alloc> *)this;
+ free_c_string();
+ if ( fn -> delete_when_done) {
+ delete fn -> fn;
+ }
+ FAlloc::deallocate(fn);
+ break;
+ }
+ case substringfn:
+ {
+ __rope_RopeSubstring<charT,Alloc> * ss =
+ (__rope_RopeSubstring<charT,Alloc> *)this;
+ __rope_RopeBase *base = ss -> base;
+ free_c_string();
+ base -> unref_nonnil();
+ SAlloc::deallocate(ss);
+ break;
+ }
+ }
+}
+#else
+
+template <class charT, class Alloc>
+inline void __rope_RopeBase<charT,Alloc>::free_string(charT* s, size_t n)
+{}
+
+#endif
+
+
+// Concatenate a C string onto a leaf rope by copying the rope data.
+// Used for short ropes.
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeLeaf *
+rope<charT,Alloc>::leaf_concat_char_iter
+ (RopeLeaf * r, const charT * iter, size_t len)
+{
+ size_t old_len = r -> size;
+ charT * new_data = (charT *)
+ Alloc::allocate(rounded_up_size(old_len + len));
+ RopeLeaf * result;
+
+ uninitialized_copy_n(r -> data, old_len, new_data);
+ uninitialized_copy_n(iter, len, new_data + old_len);
+ __cond_store_eos(new_data[old_len + len]);
+ __STL_TRY
+ result = RopeLeaf_from_char_ptr(new_data, old_len + len);
+ __STL_UNWIND(RopeBase::free_string(new_data, old_len + len));
+ return result;
+}
+
+#ifndef __GC
+// As above, but it's OK to clobber original if refcount is 1
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeLeaf *
+rope<charT,Alloc>::destr_leaf_concat_char_iter
+ (RopeLeaf * r, const charT * iter, size_t len)
+{
+ __stl_assert(r -> refcount >= 1);
+ if (r -> refcount > 1) return leaf_concat_char_iter(r, iter, len);
+ size_t old_len = r -> size;
+ if (allocated_capacity(old_len) >= old_len + len) {
+ // The space has been partially initialized for the standard
+ // character types. But that doesn't matter for those types.
+ uninitialized_copy_n(iter, len, r -> data + old_len);
+ if (__is_basic_char_type((charT *)0)) {
+ __cond_store_eos(r -> data[old_len + len]);
+ __stl_assert(r -> c_string == r -> data);
+ } else if (r -> c_string != r -> data && 0 != r -> c_string) {
+ r -> free_c_string();
+ r -> c_string = 0;
+ }
+ r -> size = old_len + len;
+ __stl_assert(r -> refcount == 1);
+ r -> refcount = 2;
+ return r;
+ } else {
+ RopeLeaf * result = leaf_concat_char_iter(r, iter, len);
+ __stl_assert(result -> refcount == 1);
+ return result;
+ }
+}
+#endif
+
+// Assumes left and right are not 0.
+// Result has ref count 1.
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeBase *
+rope<charT,Alloc>::tree_concat (RopeBase * left, RopeBase * right)
+{
+ RopeConcatenation * result = CAlloc::allocate();
+ unsigned char child_depth = left -> depth;
+ size_t rsize;
+
+ result -> tag = RopeBase::concat;
+ result -> c_string = 0;
+ result -> is_balanced = false;
+ result -> size = rsize = left -> size + right -> size;
+ if (right -> depth > child_depth) child_depth = right -> depth;
+ unsigned char depth = child_depth + 1;
+ result -> depth = depth;
+ result -> left = left;
+ result -> right = right;
+# ifndef __GC
+ result -> refcount = 1;
+ result -> init_refcount_lock();
+# endif
+ if (depth > 20 && (rsize < 1000 || depth > RopeBase::max_rope_depth)) {
+ RopeBase * balanced;
+
+ __STL_TRY
+ balanced = balance(result);
+# ifndef __GC
+ if (result != balanced) {
+ __stl_assert(1 == result -> refcount
+ && 1 == balanced -> refcount);
+ }
+# endif
+ __STL_ALWAYS(result -> unref_nonnil());
+ return balanced;
+ } else {
+ return result;
+ }
+}
+
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeBase * rope<charT,Alloc>::concat_char_iter
+ (RopeBase * r, const charT *s, size_t slen)
+{
+ RopeBase *result;
+ if (0 == slen) {
+ ref(r);
+ return r;
+ }
+ if (0 == r) return RopeLeaf_from_char_ptr(alloc_copy(s, slen), slen);
+ if (RopeBase::leaf == r -> tag && r -> size + slen <= copy_max) {
+ result = leaf_concat_char_iter((RopeLeaf *)r, s, slen);
+# ifndef __GC
+ __stl_assert(1 == result -> refcount);
+# endif
+ return result;
+ }
+ if (RopeBase::concat == r -> tag
+ && RopeBase::leaf == ((RopeConcatenation *)r) -> right -> tag) {
+ RopeLeaf *right = (RopeLeaf *)(((RopeConcatenation *)r) -> right);
+ if (right -> size + slen <= copy_max) {
+ RopeBase * left = ((RopeConcatenation *)r) -> left;
+ left -> ref_nonnil();
+ __STL_TRY
+ result = tree_concat(left,
+ leaf_concat_char_iter((RopeLeaf *)right,
+ s, slen));
+ __STL_UNWIND(unref(left));
+# ifndef __GC
+ __stl_assert(1 == result -> refcount);
+# endif
+ return result;
+ }
+ }
+ __STL_TRY
+ r -> ref_nonnil();
+ result = tree_concat(r, RopeLeaf_from_char_ptr(alloc_copy(s, slen),
+ slen));
+ __STL_UNWIND(unref(r));
+# ifndef __GC
+ __stl_assert(1 == result -> refcount);
+# endif
+ return result;
+}
+
+#ifndef __GC
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeBase * rope<charT,Alloc>
+::destr_concat_char_iter
+ (RopeBase * r, const charT *s, size_t slen)
+{
+ RopeBase *result;
+ if (0 == r) return RopeLeaf_from_char_ptr(alloc_copy(s, slen), slen);
+ size_t count = r -> refcount;
+ size_t orig_size = r -> size;
+ __stl_assert(count >= 1);
+ if (count > 1) return concat_char_iter(r, s, slen);
+ if (0 == slen) {
+ r -> refcount = 2; // One more than before
+ return r;
+ }
+ if (orig_size + slen <= copy_max && RopeBase::leaf == r -> tag) {
+ result = destr_leaf_concat_char_iter((RopeLeaf *)r, s, slen);
+ return result;
+ }
+ if (RopeBase::concat == r -> tag) {
+ RopeLeaf *right = (RopeLeaf *)(((RopeConcatenation *)r) -> right);
+ if (RopeBase::leaf == right -> tag
+ && right -> size + slen <= copy_max) {
+ RopeBase * new_right = destr_leaf_concat_char_iter(right, s, slen);
+ if (right == new_right) {
+ __stl_assert(new_right -> refcount == 2);
+ new_right -> refcount = 1;
+ } else {
+ __stl_assert(new_right -> refcount >= 1);
+ right -> unref_nonnil();
+ }
+ __stl_assert(r -> refcount == 1);
+ r -> refcount = 2; // One more than before.
+ ((RopeConcatenation *)r) -> right = new_right;
+ r -> size = orig_size + slen;
+ if (0 != r -> c_string) {
+ r -> free_c_string();
+ r -> c_string = 0;
+ }
+ return r;
+ }
+ }
+ charT * cpy = alloc_copy(s, slen);
+ r -> ref_nonnil();
+ __STL_TRY
+ result = tree_concat(r, RopeLeaf_from_char_ptr(cpy, slen));
+ __STL_UNWIND(unref(r); RopeBase::free_string(cpy,slen))
+ __stl_assert(1 == result -> refcount);
+ return result;
+}
+#endif /* !__GC */
+
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeBase *
+rope<charT,Alloc>::concat(RopeBase * left, RopeBase * right)
+{
+ if (0 == left) {
+ ref(right);
+ return right;
+ }
+ if (0 == right) {
+ left -> ref_nonnil();
+ return left;
+ }
+ if (RopeBase::leaf == right -> tag) {
+ if (RopeBase::leaf == left -> tag) {
+ if (right -> size + left -> size <= copy_max) {
+ return leaf_concat_char_iter((RopeLeaf *)left,
+ ((RopeLeaf *)right) -> data,
+ right -> size);
+ }
+ } else if (RopeBase::concat == left -> tag
+ && RopeBase::leaf ==
+ ((RopeConcatenation *)left) -> right -> tag) {
+ RopeLeaf * leftright =
+ (RopeLeaf *)(((RopeConcatenation *)left) -> right);
+ if (leftright -> size + right -> size <= copy_max) {
+ RopeBase * leftleft = ((RopeConcatenation *)left) -> left;
+ RopeBase * rest = leaf_concat_char_iter(leftright,
+ ((RopeLeaf *)right) -> data,
+ right -> size);
+ leftleft -> ref_nonnil();
+ __STL_TRY
+ return(tree_concat(leftleft, rest));
+ __STL_UNWIND(unref(left); unref(rest))
+ }
+ }
+ }
+ left -> ref_nonnil();
+ right -> ref_nonnil();
+ return(tree_concat(left, right));
+}
+
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeBase *
+rope<charT,Alloc>::substring(RopeBase * base, size_t start, size_t endp1)
+{
+ if (0 == base) return 0;
+ size_t len = base -> size;
+ size_t adj_endp1;
+ const size_t lazy_threshold = 128;
+
+ if (endp1 >= len) {
+ if (0 == start) {
+ base -> ref_nonnil();
+ return base;
+ } else {
+ adj_endp1 = len;
+ }
+ } else {
+ adj_endp1 = endp1;
+ }
+ switch(base -> tag) {
+ case RopeBase::concat:
+ {
+ RopeConcatenation *c = (RopeConcatenation *)base;
+ RopeBase *left = c -> left;
+ RopeBase *right = c -> right;
+ size_t left_len = left -> size;
+ RopeBase * result;
+
+ if (adj_endp1 <= left_len) {
+ return substring(left, start, endp1);
+ } else if (start >= left_len) {
+ return substring(right, start - left_len,
+ adj_endp1 - left_len);
+ }
+ self_destruct_ptr left_result(substring(left, start,
+ left_len));
+ self_destruct_ptr right_result(
+ substring(right, 0, endp1 - left_len));
+ result = concat(left_result, right_result);
+# ifndef __GC
+ __stl_assert(1 == result -> refcount);
+# endif
+ return result;
+ }
+ case RopeBase::leaf:
+ {
+ RopeLeaf * l = (RopeLeaf *)base;
+ RopeLeaf * result;
+ __GC_CONST charT *section;
+ size_t result_len;
+ if (start >= adj_endp1) return 0;
+ result_len = adj_endp1 - start;
+ if (result_len > lazy_threshold) goto lazy;
+# ifdef __GC
+ section = l -> data + start;
+ result = RopeLeaf_from_char_ptr(section, result_len);
+ result -> c_string = 0; // Not eos terminated.
+# else
+ section = alloc_copy(l -> data + start, result_len);
+ // We should sometimes create substring node instead.
+ __STL_TRY
+ result = RopeLeaf_from_char_ptr(section, result_len);
+ __STL_UNWIND(RopeBase::free_string(section, result_len))
+# endif
+ return result;
+ }
+ case RopeBase::substringfn:
+ // Avoid introducing mutiple layers of substring nodes.
+ {
+ RopeSubstring *old = (RopeSubstring *)base;
+ size_t result_len;
+ if (start >= adj_endp1) return 0;
+ result_len = adj_endp1 - start;
+ if (result_len > lazy_threshold) {
+ RopeSubstring * space = SAlloc::allocate();
+ RopeSubstring * result =
+ new(space) RopeSubstring(old -> base,
+ start + old -> start,
+ adj_endp1 - start);
+ return result;
+ } // else fall through:
+ }
+ case RopeBase::function:
+ {
+ RopeFunction * f = (RopeFunction *)base;
+ charT *section;
+ size_t result_len;
+ if (start >= adj_endp1) return 0;
+ result_len = adj_endp1 - start;
+
+ if (result_len > lazy_threshold) goto lazy;
+ section = (charT *)
+ Alloc::allocate(rounded_up_size(result_len));
+ __STL_TRY
+ (*(f -> fn))(start, result_len, section);
+ __STL_UNWIND(RopeBase::free_string(section, result_len));
+ __cond_store_eos(section[result_len]);
+ return RopeLeaf_from_char_ptr(section, result_len);
+ }
+ }
+ /*NOTREACHED*/
+ __stl_assert(false);
+ lazy:
+ {
+ // Create substring node.
+ RopeSubstring * space = SAlloc::allocate();
+ RopeSubstring * result = new(space) RopeSubstring(base, start,
+ adj_endp1 - start);
+ return result;
+ }
+}
+
+template<class charT>
+class __rope_flatten_char_consumer : public __rope_char_consumer<charT> {
+ private:
+ charT * buf_ptr;
+ public:
+ charT * buffer;
+ __rope_flatten_char_consumer(charT * buffer) {
+ buf_ptr = buffer;
+ };
+ ~__rope_flatten_char_consumer() {}
+ bool operator() (const charT* leaf, size_t n) {
+ uninitialized_copy_n(leaf, n, buf_ptr);
+ buf_ptr += n;
+ return true;
+ }
+};
+
+template<class charT>
+class __rope_find_char_char_consumer : public __rope_char_consumer<charT> {
+ private:
+ charT pattern;
+ public:
+ size_t count; // Number of nonmatching characters
+ __rope_find_char_char_consumer(charT p) : pattern(p), count(0) {}
+ ~__rope_find_char_char_consumer() {}
+ bool operator() (const charT* leaf, size_t n) {
+ size_t i;
+ for (i = 0; i < n; i++) {
+ if (leaf[i] == pattern) {
+ count += i; return false;
+ }
+ }
+ count += n; return true;
+ }
+};
+
+template<class charT>
+class __rope_insert_char_consumer : public __rope_char_consumer<charT> {
+ private:
+ typedef ostream insert_ostream;
+ insert_ostream & o;
+ public:
+ charT * buffer;
+ __rope_insert_char_consumer(insert_ostream & writer) : o(writer) {};
+ ~__rope_insert_char_consumer() { };
+ // Caller is presumed to own the ostream
+ bool operator() (const charT* leaf, size_t n);
+ // Returns true to continue traversal.
+};
+
+template<class charT>
+bool __rope_insert_char_consumer<charT>::operator()
+ (const charT * leaf, size_t n)
+{
+ size_t i;
+ // We assume that formatting is set up correctly for each element.
+ for (i = 0; i < n; i++) o << leaf[i];
+ return true;
+}
+
+inline bool __rope_insert_char_consumer<char>::operator()
+ (const char * leaf, size_t n)
+{
+ size_t i;
+ for (i = 0; i < n; i++) o.put(leaf[i]);
+ return true;
+}
+
+#if !defined(_MSC_VER) && !defined(__BORLANDC__)
+// I couldn't get this to work work with the VC++ version of basic_ostream.
+inline bool __rope_insert_char_consumer<wchar_t>::operator()
+ (const wchar_t * leaf, size_t n)
+{
+ size_t i;
+ for (i = 0; i < n; i++) o.put(leaf[i]);
+ return true;
+}
+#endif /* !_MSC_VER && !BORLAND */
+
+template <class charT, class Alloc>
+bool rope<charT, Alloc>::apply_to_pieces(
+ __rope_char_consumer<charT>& c,
+ const RopeBase * r,
+ size_t begin, size_t end)
+{
+ if (0 == r) return true;
+ switch(r -> tag) {
+ case RopeBase::concat:
+ {
+ RopeConcatenation *conc = (RopeConcatenation *)r;
+ RopeBase *left = conc -> left;
+ size_t left_len = left -> size;
+ if (begin < left_len) {
+ size_t left_end = min(left_len, end);
+ if (!apply_to_pieces(c, left, begin, left_end)) {
+ return false;
+ }
+ }
+ if (end > left_len) {
+ RopeBase *right = conc -> right;
+ size_t right_start = max(left_len, begin);
+ if (!apply_to_pieces(c, right,
+ right_start - left_len,
+ end - left_len)) {
+ return false;
+ }
+ }
+ }
+ return true;
+ case RopeBase::leaf:
+ {
+ RopeLeaf * l = (RopeLeaf *)r;
+ return c(l -> data + begin, end - begin);
+ }
+ case RopeBase::function:
+ case RopeBase::substringfn:
+ {
+ RopeFunction * f = (RopeFunction *)r;
+ size_t len = end - begin;
+ bool result;
+ charT * buffer = (charT *)
+ Alloc::allocate(len * sizeof(charT));
+ __STL_TRY
+ (*(f -> fn))(begin, end, buffer);
+ result = c(buffer, len);
+ __STL_ALWAYS(Alloc::deallocate(buffer, len * sizeof(charT)))
+ return result;
+ }
+ default:
+ __stl_assert(false);
+ /*NOTREACHED*/
+ return false;
+ }
+}
+
+inline void __rope_fill(ostream& o, size_t n)
+{
+ char f = cout.fill();
+ size_t i;
+
+ for (i = 0; i < n; i++) o.put(f);
+}
+
+
+template <class charT> inline bool __rope_is_simple(charT *c) { return false; }
+inline bool __rope_is_simple(char * c) { return true; }
+inline bool __rope_is_simple(wchar_t * c) { return true; }
+
+
+template<class charT, class Alloc>
+ostream& operator<< (ostream& o, const rope<charT, Alloc>& r)
+{
+ size_t w = o.width();
+ bool left = o.flags() & ios::left;
+ size_t pad_len;
+ size_t rope_len = r.size();
+ __rope_insert_char_consumer<charT> c(o);
+ bool is_simple = __rope_is_simple((charT *)0);
+
+ if (rope_len < w) {
+ pad_len = w - rope_len;
+ } else {
+ pad_len = 0;
+ }
+ if (!is_simple) o.width(w/rope_len);
+ __STL_TRY
+ if (is_simple && !left && pad_len > 0) {
+ __rope_fill(o, pad_len);
+ }
+ r.apply_to_pieces(0, r.size(), c);
+ if (is_simple && left && pad_len > 0) {
+ __rope_fill(o, pad_len);
+ }
+ __STL_ALWAYS(if (!is_simple) o.width(w))
+ return o;
+}
+
+template <class charT, class Alloc>
+charT *
+rope<charT,Alloc>::flatten(RopeBase * r,
+ size_t start, size_t len,
+ charT * buffer)
+{
+ __rope_flatten_char_consumer<charT> c(buffer);
+ apply_to_pieces(c, r, start, start + len);
+ return(buffer + len);
+}
+
+template <class charT, class Alloc>
+size_t
+rope<charT,Alloc>::find(charT pattern, size_t start) const
+{
+ __rope_find_char_char_consumer<charT> c(pattern);
+ apply_to_pieces(c, tree_ptr, start, size());
+ return start + c.count;
+}
+
+template <class charT, class Alloc>
+charT *
+rope<charT,Alloc>::flatten(RopeBase * r, charT * buffer)
+{
+ if (0 == r) return buffer;
+ switch(r -> tag) {
+ case RopeBase::concat:
+ {
+ RopeConcatenation *c = (RopeConcatenation *)r;
+ RopeBase *left = c -> left;
+ RopeBase *right = c -> right;
+ charT * rest = flatten(left, buffer);
+ return flatten(right, rest);
+ }
+ case RopeBase::leaf:
+ {
+ RopeLeaf * l = (RopeLeaf *)r;
+ return copy_n(l -> data, l -> size, buffer);
+ }
+ case RopeBase::function:
+ case RopeBase::substringfn:
+ // We dont yet do anything with substring nodes.
+ // This needs to be fixed before ropefiles will work well.
+ {
+ RopeFunction * f = (RopeFunction *)r;
+ (*(f -> fn))(0, f -> size, buffer);
+ return buffer + f -> size;
+ }
+ default:
+ __stl_assert(false);
+ /*NOTREACHED*/
+ return 0;
+ }
+}
+
+
+// This needs work for charT != char
+template <class charT, class Alloc>
+void
+rope<charT,Alloc>::dump(RopeBase * r, int indent)
+{
+ for (int i = 0; i < indent; i++) putchar(' ');
+ if (0 == r) {
+ printf("NULL\n"); return;
+ }
+ if (RopeBase::concat == r -> tag) {
+ RopeConcatenation *c = (RopeConcatenation *)r;
+ RopeBase *left = c -> left;
+ RopeBase *right = c -> right;
+
+# ifdef __GC
+ printf("Concatenation %p (depth = %d, len = %ld, %s balanced)\n",
+ r, r -> depth, r -> size, r -> is_balanced? "" : "not");
+# else
+ printf("Concatenation %p (rc = %ld, depth = %d, len = %ld, %s balanced)\n",
+ r, r -> refcount, r -> depth, r -> size,
+ r -> is_balanced? "" : "not");
+# endif
+ dump(left, indent + 2);
+ dump(right, indent + 2);
+ return;
+ } else {
+ char * kind;
+
+ switch (r -> tag) {
+ case RopeBase::leaf:
+ kind = "Leaf";
+ break;
+ case RopeBase::function:
+ kind = "Function";
+ break;
+ case RopeBase::substringfn:
+ kind = "Function representing substring";
+ break;
+ default:
+ kind = "(corrupted kind field!)";
+ }
+# ifdef __GC
+ printf("%s %p (depth = %d, len = %ld) ",
+ kind, r, r -> depth, r -> size);
+# else
+ printf("%s %p (rc = %ld, depth = %d, len = %ld) ",
+ kind, r, r -> refcount, r -> depth, r -> size);
+# endif
+ if (__is_one_byte_char_type((charT *)0)) {
+ const int max_len = 40;
+ self_destruct_ptr prefix(substring(r, 0, max_len));
+ charT buffer[max_len + 1];
+ bool too_big = r -> size > prefix-> size;
+
+ flatten(prefix, buffer);
+ buffer[prefix -> size] = __eos((charT *)0);
+ printf("%s%s\n", (char *)buffer, too_big? "...\n" : "\n");
+ } else {
+ printf("\n");
+ }
+ }
+}
+
+template <class charT, class Alloc>
+const unsigned long
+rope<charT,Alloc>::min_len[__rope_RopeBase<charT,Alloc>::max_rope_depth + 1] = {
+/* 0 */1, /* 1 */2, /* 2 */3, /* 3 */5, /* 4 */8, /* 5 */13, /* 6 */21,
+/* 7 */34, /* 8 */55, /* 9 */89, /* 10 */144, /* 11 */233, /* 12 */377,
+/* 13 */610, /* 14 */987, /* 15 */1597, /* 16 */2584, /* 17 */4181,
+/* 18 */6765, /* 19 */10946, /* 20 */17711, /* 21 */28657, /* 22 */46368,
+/* 23 */75025, /* 24 */121393, /* 25 */196418, /* 26 */317811,
+/* 27 */514229, /* 28 */832040, /* 29 */1346269, /* 30 */2178309,
+/* 31 */3524578, /* 32 */5702887, /* 33 */9227465, /* 34 */14930352,
+/* 35 */24157817, /* 36 */39088169, /* 37 */63245986, /* 38 */102334155,
+/* 39 */165580141, /* 40 */267914296, /* 41 */433494437,
+/* 42 */701408733, /* 43 */1134903170, /* 44 */1836311903,
+/* 45 */2971215073 };
+// These are Fibonacci numbers < 2**32.
+
+template <class charT, class Alloc>
+rope<charT,Alloc>::RopeBase *
+rope<charT,Alloc>::balance(RopeBase *r)
+{
+ RopeBase * forest[RopeBase::max_rope_depth + 1];
+ RopeBase * result = 0;
+ int i;
+ // Inariant:
+ // The concatenation of forest in descending order is equal to r.
+ // forest[i].size >= min_len[i]
+ // forest[i].depth = i
+ // References from forest are included in refcount.
+
+ for (i = 0; i <= RopeBase::max_rope_depth; ++i) forest[i] = 0;
+ __STL_TRY
+ add_to_forest(r, forest);
+ for (i = 0; i <= RopeBase::max_rope_depth; ++i) if (0 != forest[i]) {
+# ifndef __GC
+ self_destruct_ptr old(result);
+# endif
+ result = concat(forest[i], result);
+ forest[i] -> unref_nonnil();
+ }
+ __STL_UNWIND(for(i = 0; i <= RopeBase::max_rope_depth; i++)
+ unref(forest[i]))
+ if (result -> depth > RopeBase::max_rope_depth) abort();
+ return(result);
+}
+
+
+template <class charT, class Alloc>
+void
+rope<charT,Alloc>::add_to_forest(RopeBase *r, RopeBase **forest)
+{
+ if (r -> is_balanced) {
+ add_leaf_to_forest(r, forest);
+ return;
+ }
+ __stl_assert(r -> tag == RopeBase::concat);
+ {
+ RopeConcatenation *c = (RopeConcatenation *)r;
+
+ add_to_forest(c -> left, forest);
+ add_to_forest(c -> right, forest);
+ }
+}
+
+
+template <class charT, class Alloc>
+void
+rope<charT,Alloc>::add_leaf_to_forest(RopeBase *r, RopeBase **forest)
+{
+ self_destruct_ptr insertee(r); // included in refcount
+ self_destruct_ptr too_tiny(0); // included in refcount
+ int i; // forest[0..i-1] is empty
+ size_t s = insertee -> size;
+
+ ref(r);
+ for (i = 0; s >= min_len[i+1]/* not this bucket */; ++i) {
+ if (0 != forest[i]) {
+# ifndef __GC
+ self_destruct_ptr old(too_tiny);
+# endif
+ too_tiny = concat_and_set_balanced(forest[i], too_tiny);
+ forest[i] -> unref_nonnil();
+ forest[i] = 0;
+ }
+ }
+ {
+# ifndef __GC
+ self_destruct_ptr old(insertee);
+# endif
+ insertee = concat_and_set_balanced(too_tiny, insertee);
+ }
+ unref(too_tiny); // too_tiny is dead.
+ too_tiny = 0; // Needed for exception safety.
+ __stl_assert(is_almost_balanced(insertee));
+ __stl_assert(insertee -> depth <= r -> depth + 1);
+ for (;; ++i) {
+ if (0 != forest[i]) {
+# ifndef __GC
+ self_destruct_ptr old(insertee);
+# endif
+ insertee = concat_and_set_balanced(forest[i], insertee);
+ forest[i] -> unref_nonnil();
+ forest[i] = 0;
+ __stl_assert(is_almost_balanced(insertee));
+ }
+ __stl_assert(min_len[i] <= insertee -> size);
+ __stl_assert(forest[i] == 0);
+ if (i == RopeBase::max_rope_depth
+ || insertee -> size < min_len[i+1]) {
+ forest[i] = insertee;
+ insertee = 0;
+ // refcount is OK since insertee is now dead.
+ return;
+ }
+ }
+}
+
+template <class charT, class Alloc>
+charT
+rope<charT,Alloc>::fetch(RopeBase *r, size_type i)
+{
+ __GC_CONST charT * cstr = r -> c_string;
+
+ __stl_assert(i < r -> size);
+ if (0 != cstr) return cstr[i];
+ for(;;) {
+ switch(r -> tag) {
+ case RopeBase::concat:
+ {
+ RopeConcatenation *c = (RopeConcatenation *)r;
+ RopeBase *left = c -> left;
+ size_t left_len = left -> size;
+
+ if (i >= left_len) {
+ i -= left_len;
+ r = c -> right;
+ } else {
+ r = left;
+ }
+ }
+ break;
+ case RopeBase::leaf:
+ {
+ RopeLeaf * l = (RopeLeaf *)r;
+ return l -> data[i];
+ }
+ case RopeBase::function:
+ case RopeBase::substringfn:
+ {
+ RopeFunction * f = (RopeFunction *)r;
+ charT result;
+
+ (*(f -> fn))(i, 1, &result);
+ return result;
+ }
+ }
+ }
+}
+
+# ifndef __GC
+// Return a uniquely referenced character slot for the given
+// position, or 0 if that's not possible.
+template <class charT, class Alloc>
+charT*
+rope<charT,Alloc>::fetch_ptr(RopeBase *r, size_type i)
+{
+ RopeBase * clrstack[RopeBase::max_rope_depth];
+ size_t csptr = 0;
+
+ for(;;) {
+ if (r -> refcount > 1) return 0;
+ switch(r -> tag) {
+ case RopeBase::concat:
+ {
+ RopeConcatenation *c = (RopeConcatenation *)r;
+ RopeBase *left = c -> left;
+ size_t left_len = left -> size;
+
+ if (c -> c_string != 0) clrstack[csptr++] = c;
+ if (i >= left_len) {
+ i -= left_len;
+ r = c -> right;
+ } else {
+ r = left;
+ }
+ }
+ break;
+ case RopeBase::leaf:
+ {
+ RopeLeaf * l = (RopeLeaf *)r;
+ if (l -> c_string != l -> data && l -> c_string != 0)
+ clrstack[csptr++] = l;
+ while (csptr > 0) {
+ -- csptr;
+ RopeBase * d = clrstack[csptr];
+ d -> free_c_string();
+ d -> c_string = 0;
+ }
+ return l -> data + i;
+ }
+ case RopeBase::function:
+ case RopeBase::substringfn:
+ return 0;
+ }
+ }
+}
+# endif /* __GC */
+
+// The following could be implemented trivially using
+// lexicographical_compare_3way.
+// We do a little more work to avoid dealing with rope iterators for
+// flat strings.
+template <class charT, class Alloc>
+int
+rope<charT,Alloc>::compare (const RopeBase *left, const RopeBase *right)
+{
+ size_t left_len;
+ size_t right_len;
+
+ if (0 == right) return 0 != left;
+ if (0 == left) return -1;
+ left_len = left -> size;
+ right_len = right -> size;
+ if (RopeBase::leaf == left -> tag) {
+ RopeLeaf *l = (RopeLeaf *) left;
+ if (RopeBase::leaf == right -> tag) {
+ RopeLeaf *r = (RopeLeaf *) right;
+ return lexicographical_compare_3way(
+ l -> data, l -> data + left_len,
+ r -> data, r -> data + right_len);
+ } else {
+ const_iterator rstart(right, 0);
+ const_iterator rend(right, right_len);
+ return lexicographical_compare_3way(
+ l -> data, l -> data + left_len,
+ rstart, rend);
+ }
+ } else {
+ const_iterator lstart(left, 0);
+ const_iterator lend(left, left_len);
+ if (RopeBase::leaf == right -> tag) {
+ RopeLeaf *r = (RopeLeaf *) right;
+ return lexicographical_compare_3way(
+ lstart, lend,
+ r -> data, r -> data + right_len);
+ } else {
+ const_iterator rstart(right, 0);
+ const_iterator rend(right, right_len);
+ return lexicographical_compare_3way(
+ lstart, lend,
+ rstart, rend);
+ }
+ }
+}
+
+// Assignment to reference proxies.
+template <class charT, class Alloc>
+__rope_charT_ref_proxy<charT, Alloc>&
+__rope_charT_ref_proxy<charT, Alloc>::operator= (charT c) {
+ RopeBase * old = root -> tree_ptr;
+# ifndef __GC
+ // First check for the case in which everything is uniquely
+ // referenced. In that case we can do this destructively.
+ charT * charT_ptr = my_rope::fetch_ptr(old, pos);
+ if (0 != charT_ptr) {
+ *charT_ptr = c;
+ return *this;
+ }
+# endif
+ self_destruct_ptr left(my_rope::substring(old, 0, pos));
+ self_destruct_ptr right(my_rope::substring(old, pos+1, old -> size));
+ self_destruct_ptr result_left(my_rope::destr_concat_char_iter(left, &c, 1));
+# ifndef __GC
+ __stl_assert(left == result_left || 1 == result_left -> refcount);
+# endif
+ RopeBase * result =
+ my_rope::concat(result_left, right);
+# ifndef __GC
+ __stl_assert(1 <= result -> refcount);
+ RopeBase::unref(old);
+# endif
+ root -> tree_ptr = result;
+ return *this;
+}
+
+template <class charT, class Alloc>
+inline __rope_charT_ref_proxy<charT, Alloc>::operator charT () const
+{
+ if (current_valid) {
+ return current;
+ } else {
+ return my_rope::fetch(root->tree_ptr, pos);
+ }
+}
+template <class charT, class Alloc>
+__rope_charT_ptr_proxy<charT, Alloc>
+__rope_charT_ref_proxy<charT, Alloc>::operator& () const {
+ return __rope_charT_ptr_proxy<charT, Alloc>(*this);
+}
+
+template <class charT, class Alloc>
+rope<charT, Alloc>::rope(size_t n, charT c)
+{
+ RopeBase * result;
+ const size_t exponentiate_threshold = 32;
+ size_t exponent;
+ size_t rest;
+ charT *rest_buffer;
+ RopeBase * remainder;
+
+ if (0 == n) { tree_ptr = 0; return; }
+ exponent = n / exponentiate_threshold;
+ rest = n % exponentiate_threshold;
+ if (0 == rest) {
+ remainder = 0;
+ } else {
+ rest_buffer = (charT *)Alloc::allocate(rounded_up_size(rest));
+ uninitialized_fill_n(rest_buffer, rest, c);
+ __cond_store_eos(rest_buffer[rest]);
+ __STL_TRY
+ remainder = RopeLeaf_from_char_ptr(rest_buffer, rest);
+ __STL_UNWIND(RopeBase::free_string(rest_buffer, rest))
+ }
+ __STL_TRY
+ if (exponent != 0) {
+ charT * base_buffer =
+ (charT *)Alloc::allocate(
+ rounded_up_size(exponentiate_threshold));
+ self_destruct_ptr base_leaf;
+ uninitialized_fill_n(base_buffer, exponentiate_threshold, c);
+ __cond_store_eos(base_buffer[exponentiate_threshold]);
+ __STL_TRY
+ base_leaf = RopeLeaf_from_char_ptr(base_buffer,
+ exponentiate_threshold);
+ __STL_UNWIND(RopeBase::free_string(base_buffer, exponentiate_threshold))
+ if (1 == exponent) {
+ result = base_leaf;
+# ifndef __GC
+ __stl_assert(1 == result -> refcount);
+ result -> refcount = 2; // will be decremented when base_leaf disappears
+# endif
+ } else {
+ result = power((RopeBase *)base_leaf, exponent, concat_fn());
+# ifndef __GC
+ __stl_assert(0 == result -> refcount);
+ result -> refcount = 1;
+# endif
+ }
+ if (0 != remainder) {
+# ifndef __GC
+ __stl_assert(1 == remainder -> refcount);
+# endif
+ result = tree_concat(result, remainder);
+ }
+ // All partial results computed by power must be used.
+ } else {
+ result = remainder;
+ }
+ __STL_UNWIND(unref(remainder));
+# ifndef __GC
+ __stl_assert(0 == result || 1 == result -> refcount);
+# endif
+ tree_ptr = result;
+}
+
+template<class charT, class Alloc> charT rope<charT,Alloc>::empty_c_str[1];
+
+# ifdef _PTHREADS
+ template<class charT, class Alloc>
+ pthread_mutex_t rope<charT,Alloc>::swap_lock = PTHREAD_MUTEX_INITIALIZER;
+# endif
+
+template<class charT, class Alloc>
+const charT * rope<charT,Alloc>::c_str() const {
+ if (0 == tree_ptr) {
+ empty_c_str[0] = __eos((charT *)0); // Possibly redundant,
+ // but probably fast.
+ return empty_c_str;
+ }
+ __GC_CONST charT * old_c_string = tree_ptr -> c_string;
+ if (0 != old_c_string) return(old_c_string);
+ size_t s = size();
+ charT * result = (charT *)Alloc::allocate((s + 1)*sizeof(charT));
+ flatten(tree_ptr, result);
+ result[s] = __eos((charT *)0);
+# ifdef __GC
+ tree_ptr -> c_string = result;
+# else
+ if ((old_c_string = atomic_swap(&(tree_ptr -> c_string), result)) != 0) {
+ // It must have been added in the interim. Hence it had to have been
+ // separately allocated. Deallocate the old copy, since we just
+ // replaced it.
+ destroy(old_c_string, old_c_string + s + 1);
+ Alloc::deallocate(old_c_string, s + 1);
+ }
+# endif
+ return(result);
+}
+
+template<class charT, class Alloc>
+const charT * rope<charT,Alloc>::replace_with_c_str() {
+ if (0 == tree_ptr) {
+ empty_c_str[0] = __eos((charT *)0);
+ return empty_c_str;
+ }
+ __GC_CONST charT * old_c_string = tree_ptr -> c_string;
+ if (RopeBase::leaf == tree_ptr -> tag && 0 != old_c_string) {
+ return(old_c_string);
+ }
+ size_t s = size();
+ charT * result = (charT *)Alloc::allocate(rounded_up_size(s));
+ flatten(tree_ptr, result);
+ result[s] = __eos((charT *)0);
+ tree_ptr -> unref_nonnil();
+ tree_ptr = RopeLeaf_from_char_ptr(result, s);
+ return(result);
+}
+
+// Algorithm specializations. More should be added.
+
+#ifndef _MSC_VER
+// I couldn't get this to work with VC++
+template<class charT,class Alloc>
+void
+__rope_rotate(__rope_iterator<charT,Alloc> first,
+ __rope_iterator<charT,Alloc> middle,
+ __rope_iterator<charT,Alloc> last) {
+ __stl_assert(first.container() == middle.container()
+ && middle.container() == last.container());
+ rope<charT,Alloc>& r(first.container());
+ rope<charT,Alloc> prefix = r.substr(0, first.index());
+ rope<charT,Alloc> suffix = r.substr(last.index(), r.size() - last.index());
+ rope<charT,Alloc> part1 = r.substr(middle.index(),
+ last.index() - middle.index());
+ rope<charT,Alloc> part2 = r.substr(first.index(),
+ middle.index() - first.index());
+ r = prefix;
+ r += part1;
+ r += part2;
+ r += suffix;
+}
+
+inline void rotate(__rope_iterator<char,__ALLOC> first,
+ __rope_iterator<char,__ALLOC> middle,
+ __rope_iterator<char,__ALLOC> last) {
+ __rope_rotate(first, middle, last);
+}
+
+# if 0
+// Probably not useful for several reasons:
+// - for SGIs 7.1 compiler and probably some others,
+// this forces lots of rope<wchar_t, ...> instantiations, creating a
+// code bloat and compile time problem. (Fixed in 7.2.)
+// - wchar_t is 4 bytes wide on most UNIX platforms, making it unattractive
+// for unicode strings. Unsigned short may be a better character
+// type.
+inline void rotate(__rope_iterator<wchar_t,__ALLOC> first,
+ __rope_iterator<wchar_t,__ALLOC> middle,
+ __rope_iterator<wchar_t,__ALLOC> last) {
+ __rope_rotate(first, middle, last);
+}
+# endif
+#endif /* _MSC_VER */
diff --git a/libstdc++/stl/set.h b/libstdc++/stl/set.h
new file mode 100644
index 00000000000..6a79a625653
--- /dev/null
+++ b/libstdc++/stl/set.h
@@ -0,0 +1,167 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_SET_H
+#define __SGI_STL_SET_H
+
+#include <tree.h>
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class Key, class Compare = less<Key>, class Alloc = alloc>
+#else
+template <class Key, class Compare, class Alloc = alloc>
+#endif
+class set {
+public:
+ // typedefs:
+
+ typedef Key key_type;
+ typedef Key value_type;
+ typedef Compare key_compare;
+ typedef Compare value_compare;
+private:
+ typedef rb_tree<key_type, value_type,
+ identity<value_type>, key_compare, Alloc> rep_type;
+ rep_type t; // red-black tree representing set
+public:
+ typedef rep_type::const_pointer pointer;
+ typedef rep_type::const_reference reference;
+ typedef rep_type::const_reference const_reference;
+ typedef rep_type::const_iterator iterator;
+ typedef rep_type::const_iterator const_iterator;
+ typedef rep_type::const_reverse_iterator reverse_iterator;
+ typedef rep_type::const_reverse_iterator const_reverse_iterator;
+ typedef rep_type::size_type size_type;
+ typedef rep_type::difference_type difference_type;
+
+ // allocation/deallocation
+
+ set() : t(Compare()) {}
+ explicit set(const Compare& comp) : t(comp) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ set(InputIterator first, InputIterator last)
+ : t(Compare()) { t.insert_unique(first, last); }
+
+ template <class InputIterator>
+ set(InputIterator first, InputIterator last, const Compare& comp)
+ : t(comp) { t.insert_unique(first, last); }
+#else
+ set(const value_type* first, const value_type* last)
+ : t(Compare()) { t.insert_unique(first, last); }
+ set(const value_type* first, const value_type* last, const Compare& comp)
+ : t(comp) { t.insert_unique(first, last); }
+
+ set(const_iterator first, const_iterator last)
+ : t(Compare()) { t.insert_unique(first, last); }
+ set(const_iterator first, const_iterator last, const Compare& comp)
+ : t(comp) { t.insert_unique(first, last); }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ set(const set<Key, Compare, Alloc>& x) : t(x.t) {}
+ set<Key, Compare, Alloc>& operator=(const set<Key, Compare, Alloc>& x) {
+ t = x.t;
+ return *this;
+ }
+
+ // accessors:
+
+ key_compare key_comp() const { return t.key_comp(); }
+ value_compare value_comp() const { return t.key_comp(); }
+ iterator begin() const { return t.begin(); }
+ iterator end() const { return t.end(); }
+ reverse_iterator rbegin() const { return t.rbegin(); }
+ reverse_iterator rend() const { return t.rend(); }
+ bool empty() const { return t.empty(); }
+ size_type size() const { return t.size(); }
+ size_type max_size() const { return t.max_size(); }
+ void swap(set<Key, Compare, Alloc>& x) { t.swap(x.t); }
+
+ // insert/erase
+ typedef pair<iterator, bool> pair_iterator_bool;
+ pair<iterator,bool> insert(const value_type& x) {
+ pair<rep_type::iterator, bool> p = t.insert_unique(x);
+ return pair<iterator, bool>(p.first, p.second);
+ }
+ iterator insert(iterator position, const value_type& x) {
+ return t.insert_unique((rep_type::iterator&)position, x);
+ }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(InputIterator first, InputIterator last) {
+ t.insert_unique(first, last);
+ }
+#else
+ void insert(const_iterator first, const_iterator last) {
+ t.insert_unique(first, last);
+ }
+ void insert(const value_type* first, const value_type* last) {
+ t.insert_unique(first, last);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+ void erase(iterator position) {
+ t.erase((rep_type::iterator&)position);
+ }
+ size_type erase(const key_type& x) {
+ return t.erase(x);
+ }
+ void erase(iterator first, iterator last) {
+ t.erase((rep_type::iterator&)first,
+ (rep_type::iterator&)last);
+ }
+ void clear() { t.clear(); }
+
+ // set operations:
+
+ iterator find(const key_type& x) const { return t.find(x); }
+ size_type count(const key_type& x) const { return t.count(x); }
+ iterator lower_bound(const key_type& x) const {
+ return t.lower_bound(x);
+ }
+ iterator upper_bound(const key_type& x) const {
+ return t.upper_bound(x);
+ }
+ pair<iterator,iterator> equal_range(const key_type& x) const {
+ return t.equal_range(x);
+ }
+ friend bool operator==(const set&, const set&);
+ friend bool operator<(const set&, const set&);
+};
+
+template <class Key, class Compare, class Alloc>
+inline bool operator==(const set<Key, Compare, Alloc>& x,
+ const set<Key, Compare, Alloc>& y) {
+ return x.t == y.t;
+}
+
+template <class Key, class Compare, class Alloc>
+inline bool operator<(const set<Key, Compare, Alloc>& x,
+ const set<Key, Compare, Alloc>& y) {
+ return x.t < y.t;
+}
+
+#endif /* __SGI_STL_SET_H */
diff --git a/libstdc++/stl/slist.h b/libstdc++/stl/slist.h
new file mode 100644
index 00000000000..bb99920185f
--- /dev/null
+++ b/libstdc++/stl/slist.h
@@ -0,0 +1,729 @@
+/*
+ * Copyright (c) 1997
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __SGI_STL_SLIST_H
+#define __SGI_STL_SLIST_H
+
+#include <algobase.h>
+#include <alloc.h>
+
+struct __slist_node_base
+{
+ __slist_node_base* next;
+};
+
+inline __slist_node_base* __slist_make_link(__slist_node_base* prev_node,
+ __slist_node_base* new_node)
+{
+ new_node->next = prev_node->next;
+ prev_node->next = new_node;
+ return new_node;
+}
+
+inline __slist_node_base* __slist_previous(__slist_node_base* head,
+ const __slist_node_base* node)
+{
+ while (head && head->next != node)
+ head = head->next;
+ return head;
+}
+
+inline const __slist_node_base* __slist_previous(const __slist_node_base* head,
+ const __slist_node_base* node)
+{
+ while (head && head->next != node)
+ head = head->next;
+ return head;
+}
+
+inline void __slist_splice_after(__slist_node_base* pos,
+ __slist_node_base* before_first,
+ __slist_node_base* before_last)
+{
+ if (pos != before_first && pos != before_last) {
+ __slist_node_base* first = before_first->next;
+ __slist_node_base* after = pos->next;
+ before_first->next = before_last->next;
+ pos->next = first;
+ before_last->next = after;
+ }
+}
+
+inline __slist_node_base* __slist_reverse(__slist_node_base* node)
+{
+ __slist_node_base* result = node;
+ node = node->next;
+ result->next = 0;
+ while(node) {
+ __slist_node_base* next = node->next;
+ node->next = result;
+ result = node;
+ node = next;
+ }
+ return result;
+}
+
+template <class T>
+struct __slist_node : public __slist_node_base
+{
+ T data;
+};
+
+struct __slist_iterator_base
+{
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef forward_iterator_tag iterator_category;
+
+ __slist_node_base* node;
+
+ __slist_iterator_base(__slist_node_base* x) : node(x) {}
+ void incr() { node = node->next; }
+
+ bool operator==(const __slist_iterator_base& x) const {
+ return node == x.node;
+ }
+ bool operator!=(const __slist_iterator_base& x) const {
+ return node != x.node;
+ }
+};
+
+template <class T, class Ref>
+struct __slist_iterator : public __slist_iterator_base
+{
+ typedef __slist_iterator<T, T&> iterator;
+ typedef __slist_iterator<T, const T&> const_iterator;
+ typedef __slist_iterator<T, Ref> self;
+
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef __slist_node<T> list_node;
+
+ __slist_iterator(list_node* x) : __slist_iterator_base(x) {}
+ __slist_iterator() : __slist_iterator_base(0) {}
+ __slist_iterator(const iterator& x) : __slist_iterator_base(x.node) {}
+
+ Ref operator*() const { return ((list_node*) node)->data; }
+ self& operator++()
+ {
+ incr();
+ return *this;
+ }
+ self operator++(int)
+ {
+ self tmp = *this;
+ incr();
+ return tmp;
+ }
+};
+
+inline ptrdiff_t*
+distance_type(const __slist_iterator_base&)
+{
+ return 0;
+}
+
+inline forward_iterator_tag
+iterator_category(const __slist_iterator_base&)
+{
+ return forward_iterator_tag();
+}
+
+template <class T, class Ref>
+inline T*
+value_type(const __slist_iterator<T, Ref>&) {
+ return 0;
+}
+
+inline size_t __slist_size(__slist_node_base* node)
+{
+ size_t result = 0;
+ for ( ; node != 0; node = node->next)
+ ++result;
+ return result;
+}
+
+template <class T, class Alloc = alloc>
+class slist
+{
+public:
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+
+ typedef __slist_iterator<T, reference> iterator;
+ typedef __slist_iterator<T, const_reference> const_iterator;
+
+private:
+ typedef __slist_node<T> list_node;
+ typedef __slist_node_base list_node_base;
+ typedef __slist_iterator_base iterator_base;
+ typedef simple_alloc<list_node, Alloc> list_node_allocator;
+
+ static list_node* create_node(const value_type& x) {
+ list_node* node = list_node_allocator::allocate();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ construct(&node->data, x);
+ node->next = 0;
+ return node;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ list_node_allocator::deallocate(node);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+ static void destroy_node(list_node* node) {
+ destroy(&node->data);
+ list_node_allocator::deallocate(node);
+ }
+
+ void fill_initialize(size_type n, const value_type& x) {
+ head.next = 0;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ _insert_after_fill(&head, n, x);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void range_initialize(InputIterator first, InputIterator last) {
+ head.next = 0;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ _insert_after_range(&head, first, last);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ void range_initialize(const value_type* first, const value_type* last) {
+ head.next = 0;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ _insert_after_range(&head, first, last);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ void range_initialize(const_iterator first, const_iterator last) {
+ head.next = 0;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ _insert_after_range(&head, first, last);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ clear();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+private:
+ list_node_base head;
+
+public:
+ slist() { head.next = 0; }
+
+ slist(size_type n, const value_type& x) { fill_initialize(n, x); }
+ slist(int n, const value_type& x) { fill_initialize(n, x); }
+ slist(long n, const value_type& x) { fill_initialize(n, x); }
+ explicit slist(size_type n) { fill_initialize(n, value_type()); }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ slist(InputIterator first, InputIterator last) {
+ range_initialize(first, last);
+ }
+
+#else /* __STL_MEMBER_TEMPLATES */
+ slist(const_iterator first, const_iterator last) {
+ range_initialize(first, last);
+ }
+ slist(const value_type* first, const value_type* last) {
+ range_initialize(first, last);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ slist(const slist& L) { range_initialize(L.begin(), L.end()); }
+
+ slist& operator= (const slist& L);
+
+ ~slist() { clear(); }
+
+public:
+
+ iterator begin() { return iterator((list_node*)head.next); }
+ const_iterator begin() const { return const_iterator((list_node*)head.next);}
+
+ iterator end() { return iterator(0); }
+ const_iterator end() const { return const_iterator(0); }
+
+ size_type size() const { return __slist_size(head.next); }
+
+ size_type max_size() const { return size_type(-1); }
+
+ bool empty() const { return head.next == 0; }
+
+ void swap(slist& L)
+ {
+ list_node_base* tmp = head.next;
+ head.next = L.head.next;
+ L.head.next = tmp;
+ }
+
+public:
+ friend bool operator==(const slist<T, Alloc>& L1, const slist<T, Alloc>& L2);
+
+public:
+
+ reference front() { return ((list_node*) head.next)->data; }
+ const_reference front() const { return ((list_node*) head.next)->data; }
+ void push_front(const value_type& x) {
+ __slist_make_link(&head, create_node(x));
+ }
+ void pop_front() {
+ list_node* node = (list_node*) head.next;
+ head.next = node->next;
+ destroy_node(node);
+ }
+
+ iterator previous(const_iterator pos) {
+ return iterator((list_node*) __slist_previous(&head, pos.node));
+ }
+ const_iterator previous(const_iterator pos) const {
+ return const_iterator((list_node*) __slist_previous(&head, pos.node));
+ }
+
+private:
+ list_node* _insert_after(list_node_base* pos, const value_type& x) {
+ return (list_node*) (__slist_make_link(pos, create_node(x)));
+ }
+
+ void _insert_after_fill(list_node_base* pos,
+ size_type n, const value_type& x) {
+ for (size_type i = 0; i < n; ++i)
+ pos = __slist_make_link(pos, create_node(x));
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InIter>
+ void _insert_after_range(list_node_base* pos, InIter first, InIter last) {
+ while (first != last) {
+ pos = __slist_make_link(pos, create_node(*first));
+ ++first;
+ }
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ void _insert_after_range(list_node_base* pos,
+ const_iterator first, const_iterator last) {
+ while (first != last) {
+ pos = __slist_make_link(pos, create_node(*first));
+ ++first;
+ }
+ }
+ void _insert_after_range(list_node_base* pos,
+ const value_type* first, const value_type* last) {
+ while (first != last) {
+ pos = __slist_make_link(pos, create_node(*first));
+ ++first;
+ }
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ void erase_after(list_node_base* pos) {
+ list_node* next = (list_node*) (pos->next);
+ pos->next = next->next;
+ destroy_node(next);
+ }
+
+ void erase_after(list_node_base* before_first, list_node_base* last_node) {
+ list_node* cur = (list_node*) (before_first->next);
+ while (cur != last_node) {
+ list_node* tmp = cur;
+ cur = (list_node*) cur->next;
+ destroy_node(tmp);
+ }
+ before_first->next = last_node;
+ }
+
+
+public:
+
+ iterator insert_after(iterator pos, const value_type& x) {
+ return iterator(_insert_after(pos.node, x));
+ }
+
+ iterator insert_after(iterator pos) {
+ return insert_after(pos, value_type());
+ }
+
+ void insert_after(iterator pos, size_type n, const value_type& x) {
+ _insert_after_fill(pos.node, n, x);
+ }
+ void insert_after(iterator pos, int n, const value_type& x) {
+ _insert_after_fill(pos.node, (size_type) n, x);
+ }
+ void insert_after(iterator pos, long n, const value_type& x) {
+ _insert_after_fill(pos.node, (size_type) n, x);
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InIter>
+ void insert_after(iterator pos, InIter first, InIter last) {
+ _insert_after_range(pos.node, first, last);
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ void insert_after(iterator pos, const_iterator first, const_iterator last) {
+ _insert_after_range(pos.node, first, last);
+ }
+ void insert_after(iterator pos,
+ const value_type* first, const value_type* last) {
+ _insert_after_range(pos.node, first, last);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ iterator insert(iterator pos, const value_type& x) {
+ return iterator(_insert_after(__slist_previous(&head, pos.node), x));
+ }
+
+ iterator insert(iterator pos) {
+ return iterator(_insert_after(__slist_previous(&head, pos.node),
+ value_type()));
+ }
+
+ void insert(iterator pos, size_type n, const value_type& x) {
+ _insert_after_fill(__slist_previous(&head, pos.node), n, x);
+ }
+ void insert(iterator pos, int n, const value_type& x) {
+ _insert_after_fill(__slist_previous(&head, pos.node), (size_type) n, x);
+ }
+ void insert(iterator pos, long n, const value_type& x) {
+ _insert_after_fill(__slist_previous(&head, pos.node), (size_type) n, x);
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InIter>
+ void insert(iterator pos, InIter first, InIter last) {
+ _insert_after_range(__slist_previous(&head, pos.node), first, last);
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ void insert(iterator pos, const_iterator first, const_iterator last) {
+ _insert_after_range(__slist_previous(&head, pos.node), first, last);
+ }
+ void insert(iterator pos, const value_type* first, const value_type* last) {
+ _insert_after_range(__slist_previous(&head, pos.node), first, last);
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+
+public:
+ void erase_after(iterator pos) { erase_after(pos.node); }
+ void erase_after(iterator before_first, iterator last) {
+ erase_after(before_first.node, last.node);
+ }
+
+ void erase(iterator pos) { erase_after(__slist_previous(&head, pos.node)); }
+ void erase(iterator first, iterator last) {
+ erase_after(__slist_previous(&head, first.node), last.node);
+ }
+
+ void resize(size_type new_size, const T& x);
+ void resize(size_type new_size) { resize(new_size, T()); }
+ void clear() { erase_after(&head, 0); }
+
+public:
+ // Moves the range [before_first + 1, before_last + 1) to *this,
+ // inserting it immediately after pos. This is constant time.
+ void splice_after(iterator pos,
+ iterator before_first, iterator before_last)
+ {
+ if (before_first != before_last)
+ __slist_splice_after(pos.node, before_first.node, before_last.node);
+ }
+
+ // Moves the element that follows prev to *this, inserting it immediately
+ // after pos. This is constant time.
+ void splice_after(iterator pos, iterator prev)
+ {
+ __slist_splice_after(pos.node, prev.node, prev.node->next);
+ }
+
+
+ // Linear in distance(begin(), pos), and linear in L.size().
+ void splice(iterator pos, slist& L) {
+ if (L.head.next)
+ __slist_splice_after(__slist_previous(&head, pos.node),
+ &L.head,
+ __slist_previous(&L.head, 0));
+ }
+
+ // Linear in distance(begin(), pos), and in distance(L.begin(), i).
+ void splice(iterator pos, slist& L, iterator i) {
+ __slist_splice_after(__slist_previous(&head, pos.node),
+ __slist_previous(&L.head, i.node),
+ i.node);
+ }
+
+ // Linear in distance(begin(), pos), in distance(L.begin(), first),
+ // and in distance(first, last).
+ void splice(iterator pos, slist& L, iterator first, iterator last)
+ {
+ if (first != last)
+ __slist_splice_after(__slist_previous(&head, pos.node),
+ __slist_previous(&L.head, first.node),
+ __slist_previous(first.node, last.node));
+ }
+
+public:
+ void reverse() { if (head.next) head.next = __slist_reverse(head.next); }
+
+ void remove(const T& val);
+ void unique();
+ void merge(slist& L);
+ void sort();
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class Predicate> void remove_if(Predicate pred);
+ template <class BinaryPredicate> void unique(BinaryPredicate pred);
+ template <class StrictWeakOrdering> void merge(slist&, StrictWeakOrdering);
+ template <class StrictWeakOrdering> void sort(StrictWeakOrdering comp);
+#endif /* __STL_MEMBER_TEMPLATES */
+};
+
+template <class T, class Alloc>
+slist<T, Alloc>& slist<T,Alloc>::operator=(const slist<T, Alloc>& L)
+{
+ if (&L != this) {
+ list_node_base* p1 = &head;
+ list_node* n1 = (list_node*) head.next;
+ const list_node* n2 = (const list_node*) L.head.next;
+ while (n1 && n2) {
+ n1->data = n2->data;
+ p1 = n1;
+ n1 = (list_node*) n1->next;
+ n2 = (const list_node*) n2->next;
+ }
+ if (n2 == 0)
+ erase_after(p1, 0);
+ else
+ _insert_after_range(p1,
+ const_iterator((list_node*)n2), const_iterator(0));
+ }
+ return *this;
+}
+
+template <class T, class Alloc>
+bool operator==(const slist<T, Alloc>& L1, const slist<T, Alloc>& L2)
+{
+ typedef typename slist<T,Alloc>::list_node list_node;
+ list_node* n1 = (list_node*) L1.head.next;
+ list_node* n2 = (list_node*) L2.head.next;
+ while (n1 && n2 && n1->data == n2->data) {
+ n1 = (list_node*) n1->next;
+ n2 = (list_node*) n2->next;
+ }
+ return n1 == 0 && n2 == 0;
+}
+
+template <class T, class Alloc>
+inline bool operator<(const slist<T, Alloc>& L1, const slist<T, Alloc>& L2)
+{
+ return lexicographical_compare(L1.begin(), L1.end(), L2.begin(), L2.end());
+}
+
+template <class T, class Alloc>
+void slist<T, Alloc>::resize(size_type len, const T& x)
+{
+ list_node_base* cur = &head;
+ while (cur->next != 0 && len > 0) {
+ --len;
+ cur = cur->next;
+ }
+ if (cur->next)
+ erase_after(cur, 0);
+ else
+ _insert_after_fill(cur, len, x);
+}
+
+template <class T, class Alloc>
+void slist<T,Alloc>::remove(const T& val)
+{
+ list_node_base* cur = &head;
+ while (cur && cur->next) {
+ if (((list_node*) cur->next)->data == val)
+ erase_after(cur);
+ else
+ cur = cur->next;
+ }
+}
+
+template <class T, class Alloc>
+void slist<T,Alloc>::unique()
+{
+ list_node_base* cur = head.next;
+ if (cur) {
+ while (cur->next) {
+ if (((list_node*)cur)->data == ((list_node*)(cur->next))->data)
+ erase_after(cur);
+ else
+ cur = cur->next;
+ }
+ }
+}
+
+template <class T, class Alloc>
+void slist<T,Alloc>::merge(slist<T,Alloc>& L)
+{
+ list_node_base* n1 = &head;
+ while (n1->next && L.head.next) {
+ if (((list_node*) L.head.next)->data < ((list_node*) n1->next)->data)
+ __slist_splice_after(n1, &L.head, L.head.next);
+ n1 = n1->next;
+ }
+ if (L.head.next) {
+ n1->next = L.head.next;
+ L.head.next = 0;
+ }
+}
+
+template <class T, class Alloc>
+void slist<T,Alloc>::sort()
+{
+ if (head.next && head.next->next) {
+ slist carry;
+ slist counter[64];
+ int fill = 0;
+ while (!empty()) {
+ __slist_splice_after(&carry.head, &head, head.next);
+ int i = 0;
+ while (i < fill && !counter[i].empty()) {
+ counter[i].merge(carry);
+ carry.swap(counter[i]);
+ ++i;
+ }
+ carry.swap(counter[i]);
+ if (i == fill)
+ ++fill;
+ }
+
+ for (int i = 1; i < fill; ++i)
+ counter[i].merge(counter[i-1]);
+ this->swap(counter[fill-1]);
+ }
+}
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+template <class T, class Alloc>
+template <class Predicate> void slist<T,Alloc>::remove_if(Predicate pred)
+{
+ list_node_base* cur = &head;
+ while (cur->next) {
+ if (pred(((list_node*) cur->next)->data))
+ erase_after(cur);
+ else
+ cur = cur->next;
+ }
+}
+
+template <class T, class Alloc> template <class BinaryPredicate>
+void slist<T,Alloc>::unique(BinaryPredicate pred)
+{
+ list_node* cur = (list_node*) head.next;
+ if (cur) {
+ while (cur->next) {
+ if (pred(((list_node*)cur)->data, ((list_node*)(cur->next))->data))
+ erase_after(cur);
+ else
+ cur = (list_node*) cur->next;
+ }
+ }
+}
+
+template <class T, class Alloc> template <class StrictWeakOrdering>
+void slist<T,Alloc>::merge(slist<T,Alloc>& L, StrictWeakOrdering comp)
+{
+ list_node_base* n1 = &head;
+ while (n1->next && L.head.next) {
+ if (comp(((list_node*) L.head.next)->data,
+ ((list_node*) n1->next)->data))
+ __slist_splice_after(n1, &L.head, L.head.next);
+ n1 = n1->next;
+ }
+ if (L.head.next) {
+ n1->next = L.head.next;
+ L.head.next = 0;
+ }
+}
+
+template <class T, class Alloc> template <class StrictWeakOrdering>
+void slist<T,Alloc>::sort(StrictWeakOrdering comp)
+{
+ if (head.next && head.next->next) {
+ slist carry;
+ slist counter[64];
+ int fill = 0;
+ while (!empty()) {
+ __slist_splice_after(&carry.head, &head, head.next);
+ int i = 0;
+ while (i < fill && !counter[i].empty()) {
+ counter[i].merge(carry, comp);
+ carry.swap(counter[i]);
+ ++i;
+ }
+ carry.swap(counter[i]);
+ if (i == fill)
+ ++fill;
+ }
+
+ for (int i = 1; i < fill; ++i)
+ counter[i].merge(counter[i-1], comp);
+ this->swap(counter[fill-1]);
+ }
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+#endif /* __SGI_STL_SLIST_H */
diff --git a/libstdc++/stl/stack.h b/libstdc++/stl/stack.h
new file mode 100644
index 00000000000..cc025bb70e1
--- /dev/null
+++ b/libstdc++/stl/stack.h
@@ -0,0 +1,171 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef STACK_H
+#define STACK_H
+
+#include <function.h>
+#include <heap.h>
+#include <vector.h>
+#include <deque.h>
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class T, class Sequence = deque<T> >
+#else
+template <class T, class Sequence>
+#endif
+class stack {
+ friend bool operator==(const stack<T, Sequence>& x,
+ const stack<T, Sequence>& y);
+ friend bool operator<(const stack<T, Sequence>& x,
+ const stack<T, Sequence>& y);
+public:
+ typedef typename Sequence::value_type value_type;
+ typedef typename Sequence::size_type size_type;
+protected:
+ Sequence c;
+public:
+ bool empty() const { return c.empty(); }
+ size_type size() const { return c.size(); }
+ value_type& top() { return c.back(); }
+ const value_type& top() const { return c.back(); }
+ void push(const value_type& x) { c.push_back(x); }
+ void pop() { c.pop_back(); }
+};
+
+template <class T, class Sequence>
+bool operator==(const stack<T, Sequence>& x, const stack<T, Sequence>& y) {
+ return x.c == y.c;
+}
+
+template <class T, class Sequence>
+bool operator<(const stack<T, Sequence>& x, const stack<T, Sequence>& y) {
+ return x.c < y.c;
+}
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class T, class Sequence = deque<T> >
+#else
+template <class T, class Sequence>
+#endif
+class queue {
+friend bool operator==(const queue<T, Sequence>& x, const queue<T, Sequence>& y);
+friend bool operator<(const queue<T, Sequence>& x, const queue<T, Sequence>& y);
+public:
+ typedef typename Sequence::value_type value_type;
+ typedef typename Sequence::size_type size_type;
+protected:
+ Sequence c;
+public:
+ bool empty() const { return c.empty(); }
+ size_type size() const { return c.size(); }
+ value_type& front() { return c.front(); }
+ const value_type& front() const { return c.front(); }
+ value_type& back() { return c.back(); }
+ const value_type& back() const { return c.back(); }
+ void push(const value_type& x) { c.push_back(x); }
+ void pop() { c.pop_front(); }
+};
+
+template <class T, class Sequence>
+bool operator==(const queue<T, Sequence>& x, const queue<T, Sequence>& y) {
+ return x.c == y.c;
+}
+
+template <class T, class Sequence>
+bool operator<(const queue<T, Sequence>& x, const queue<T, Sequence>& y) {
+ return x.c < y.c;
+}
+
+#ifndef __STL_LIMITED_DEFAULT_TEMPLATES
+template <class T, class Sequence = vector<T>,
+ class Compare = less<typename Sequence::value_type> >
+#else
+template <class T, class Sequence, class Compare>
+#endif
+class priority_queue {
+public:
+ typedef typename Sequence::value_type value_type;
+ typedef typename Sequence::size_type size_type;
+protected:
+ Sequence c;
+ Compare comp;
+public:
+ priority_queue() : c() {}
+ explicit priority_queue(const Compare& x) : c(), comp(x) {}
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ priority_queue(InputIterator first, InputIterator last, const Compare& x)
+ : c(first, last), comp(x) { make_heap(c.begin(), c.end(), comp); }
+ template <class InputIterator>
+ priority_queue(InputIterator first, InputIterator last)
+ : c(first, last) { make_heap(c.begin(), c.end(), comp); }
+#else /* __STL_MEMBER_TEMPLATES */
+ priority_queue(const value_type* first, const value_type* last,
+ const Compare& x) : c(first, last), comp(x) {
+ make_heap(c.begin(), c.end(), comp);
+ }
+ priority_queue(const value_type* first, const value_type* last)
+ : c(first, last) { make_heap(c.begin(), c.end(), comp); }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ bool empty() const { return c.empty(); }
+ size_type size() const { return c.size(); }
+ const value_type& top() const { return c.front(); }
+ void push(const value_type& x) {
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ c.push_back(x);
+ push_heap(c.begin(), c.end(), comp);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ c.clear();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+ void pop() {
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ pop_heap(c.begin(), c.end(), comp);
+ c.pop_back();
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ c.clear();
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+};
+
+// no equality is provided
+
+#endif
diff --git a/libstdc++/stl/stl_config.h b/libstdc++/stl/stl_config.h
new file mode 100644
index 00000000000..fa29fdd3253
--- /dev/null
+++ b/libstdc++/stl/stl_config.h
@@ -0,0 +1,170 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ * Copyright (c) 1997
+ * Silicon Graphics
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ */
+
+#ifndef __STL_CONFIG_H
+# define __STL_CONFIG_H
+
+// What this file does.
+// (1) Defines bool, true, and false if the compiler doesn't do so already.
+// (2) Defines __STL_NO_DRAND48 if the compiler's standard library does
+// not support the drand48() function.
+// (3) Defines __STL_STATIC_TEMPLATE_MEMBER_BUG if the compiler can't
+// handle static members of template classes.
+// (4) Defines 'typename' as a null macro if the compiler does not support
+// the typename keyword.
+// (5) Defines __STL_CLASS_PARTIAL_SPECIALIZATION if the compiler
+// supports partial specialization of template classes.
+// (6) Defines __STL_MEMBER_TEMPLATES if the compiler supports
+// template members of classes.
+// (7) Defines 'explicit' as a null macro if the compiler does not support
+// the explicit keyword.
+// (8) Defines __STL_LIMITED_DEFAULT_TEMPLATES if the compiler is
+// unable to handle default template parameters that depend on
+// previous template parameters.
+// (9) Defines __STL_NON_TYPE_TMPL_PARAM_BUG if the compiler has
+// trouble performing function template argument deduction for
+// non-type template parameters.
+// (10) Defines __STL_USE_EXCEPTIONS if the compiler (in the current
+// compilation mode) supports exceptions.
+// (11) Defines __STL_SGI_THREADS if this is being compiled on an SGI
+// compiler, and if the user hasn't selected pthreads or no threads
+// instead.
+// (12) Defines __STL_WIN32THREADS if this is being compiled on a
+// WIN32 compiler in multithreaded mode.
+// (13) Defines __stl_assert either as a test or as a null macro,
+// depending on whether or not __STL_ASSERTIONS is defined.
+
+# if defined(__sgi) && !defined(__GNUC__)
+# if !defined(_BOOL)
+# define __STL_NEED_BOOL
+# endif
+# if !defined(_TYPENAME_IS_KEYWORD)
+# define __STL_NEED_TYPENAME
+# endif
+# ifdef _PARTIAL_SPECIALIZATION_OF_CLASS_TEMPLATES
+# define __STL_CLASS_PARTIAL_SPECIALIZATION
+# endif
+# ifdef _MEMBER_TEMPLATES
+# define __STL_MEMBER_TEMPLATES
+# endif
+# if !defined(_EXPLICIT_IS_KEYWORD)
+# define __STL_NEED_EXPLICIT
+# endif
+# ifdef __EXCEPTIONS
+# define __STL_USE_EXCEPTIONS
+# endif
+# if !defined(_NOTHREADS) && !defined(_PTHREADS)
+# define __STL_SGI_THREADS
+# endif
+# endif
+
+# ifdef __GNUC__
+# if 0 && (__GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 8))
+# define __STL_STATIC_TEMPLATE_MEMBER_BUG
+# define __STL_NEED_TYPENAME
+# define __STL_NEED_EXPLICIT
+# else
+# define __STL_CLASS_PARTIAL_SPECIALIZATION
+# endif
+# ifdef __EXCEPTIONS
+# define __STL_USE_EXCEPTIONS
+# endif
+# endif
+
+# if defined(__SUNPRO_CC)
+# define __STL_NEED_BOOL
+# define __STL_NEED_TYPENAME
+# define __STL_NEED_EXPLICIT
+# define __STL_USE_EXCEPTIONS
+# endif
+
+# if defined(__COMO__)
+# define __STL_MEMBER_TEMPLATES
+# define __STL_CLASS_PARTIAL_SPECIALIZATION
+# define __STL_USE_EXCEPTIONS
+# endif
+
+# if defined(_MSC_VER)
+# if _MSC_VER > 1000
+# include <yvals.h>
+# else
+# define __STL_NEED_BOOL
+# endif
+# define __STL_NO_DRAND48
+# define __STL_NEED_TYPENAME
+# if _MSC_VER < 1100
+# define __STL_NEED_EXPLICIT
+# endif
+# define __STL_NON_TYPE_TMPL_PARAM_BUG
+# ifdef _CPPUNWIND
+# define __STL_USE_EXCEPTIONS
+# endif
+# ifdef _MT
+# define __STL_WIN32THREADS
+# endif
+# endif
+
+# if defined(__BORLANDC__)
+# define __STL_NO_DRAND48
+# define __STL_NEED_TYPENAME
+# define __STL_LIMITED_DEFAULT_TEMPLATES
+# define __STL_NON_TYPE_TMPL_PARAM_BUG
+# ifdef _CPPUNWIND
+# define __STL_USE_EXCEPTIONS
+# endif
+# ifdef __MT__
+# define __STL_WIN32THREADS
+# endif
+# endif
+
+
+# if defined(__STL_NEED_BOOL)
+ typedef int bool;
+# define true 1
+# define false 0
+# undef __STL_NEED_BOOL
+# endif
+
+# ifdef __STL_NEED_TYPENAME
+# define typename
+# undef __STL_NEED_TYPENAME
+# endif
+
+# ifdef __STL_NEED_EXPLICIT
+# define explicit
+# undef __STL_NEED_EXPLICIT
+# endif
+
+#ifdef __STL_ASSERTIONS
+# include <stdio.h>
+# define __stl_assert(expr) \
+ if (!(expr)) { fprintf(stderr, "%s:%d STL assertion failure: %s\n", \
+ __FILE__, __LINE__, # expr); abort(); }
+#else
+# define __stl_assert(expr)
+#endif
+
+#endif /* __STL_CONFIG_H */
diff --git a/libstdc++/stl/tempbuf.h b/libstdc++/stl/tempbuf.h
new file mode 100644
index 00000000000..18d995252d8
--- /dev/null
+++ b/libstdc++/stl/tempbuf.h
@@ -0,0 +1,121 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_TEMPBUF_H
+#define __SGI_STL_TEMPBUF_H
+
+#include <limits.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <pair.h>
+#include <type_traits.h>
+
+template <class T>
+pair<T*, ptrdiff_t> get_temporary_buffer(ptrdiff_t len, T*) {
+ if (len > ptrdiff_t(INT_MAX / sizeof(T)))
+ len = INT_MAX / sizeof(T);
+
+ while (len > 0) {
+ T* tmp = (T*) malloc((size_t)len * sizeof(T));
+ if (tmp != 0)
+ return pair<T*, ptrdiff_t>(tmp, len);
+ len /= 2;
+ }
+
+ return pair<T*, ptrdiff_t>((T*)0, 0);
+}
+
+template <class T>
+void return_temporary_buffer(T* p) {
+ free(p);
+}
+
+template <class ForwardIterator,
+ class T /* = iterator_traits<ForwardIterator>::value_type */>
+class temporary_buffer {
+private:
+ ptrdiff_t original_len;
+ ptrdiff_t len;
+ T* buffer;
+
+ void allocate_buffer() {
+ original_len = len;
+ buffer = 0;
+
+ if (len > (ptrdiff_t)(INT_MAX / sizeof(T)))
+ len = INT_MAX / sizeof(T);
+
+ while (len > 0) {
+ buffer = (T*) malloc(len * sizeof(T));
+ if (buffer)
+ break;
+ len /= 2;
+ }
+ }
+
+ void initialize_buffer(const T&, __true_type) {}
+ void initialize_buffer(const T& val, __false_type) {
+ uninitialized_fill_n(buffer, len, val);
+ }
+
+public:
+ ptrdiff_t size() const { return len; }
+ ptrdiff_t requested_size() const { return original_len; }
+ T* begin() { return buffer; }
+ T* end() { return buffer + len; }
+
+ temporary_buffer(ForwardIterator first, ForwardIterator last) {
+#ifdef __STL_USE_EXCEPTIONS
+ try {
+#endif
+ len = 0;
+ distance(first, last, len);
+ allocate_buffer();
+ if (len > 0)
+ initialize_buffer(*first,
+ __type_traits<T>::has_trivial_default_constructor());
+#ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ free(buffer);
+ buffer = 0;
+ len = 0;
+ throw;
+ }
+#endif
+ }
+
+ ~temporary_buffer() {
+ destroy(buffer, buffer + len);
+ free(buffer);
+ }
+
+private:
+ temporary_buffer(const temporary_buffer&) {}
+ void operator=(const temporary_buffer&) {}
+};
+
+#endif /* __SGI_STL_TEMPBUF_H */
diff --git a/libstdc++/stl/tree.h b/libstdc++/stl/tree.h
new file mode 100644
index 00000000000..0429c1a421d
--- /dev/null
+++ b/libstdc++/stl/tree.h
@@ -0,0 +1,1085 @@
+/*
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ */
+
+#ifndef __SGI_STL_TREE_H
+#define __SGI_STL_TREE_H
+
+/*
+
+Red-black tree class, designed for use in implementing STL
+associative containers (set, multiset, map, and multimap). The
+insertion and deletion algorithms are based on those in Cormen,
+Leiserson, and Rivest, Introduction to Algorithms (MIT Press, 1990),
+except that
+
+(1) the header cell is maintained with links not only to the root
+but also to the leftmost node of the tree, to enable constant time
+begin(), and to the rightmost node of the tree, to enable linear time
+performance when used with the generic set algorithms (set_union,
+etc.);
+
+(2) when a node being deleted has two children its successor node is
+relinked into its place, rather than copied, so that the only
+iterators invalidated are those referring to the deleted node.
+
+*/
+
+#include <stddef.h>
+#include <algobase.h>
+#include <iterator.h>
+#include <alloc.h>
+
+
+typedef bool __rb_tree_color_type;
+const __rb_tree_color_type __rb_tree_red = false;
+const __rb_tree_color_type __rb_tree_black = true;
+
+struct __rb_tree_node_base
+{
+ typedef __rb_tree_color_type color_type;
+ typedef __rb_tree_node_base* base_ptr;
+
+ color_type color;
+ base_ptr parent;
+ base_ptr left;
+ base_ptr right;
+
+ static base_ptr minimum(base_ptr x)
+ {
+ while (x->left != 0) x = x->left;
+ return x;
+ }
+
+ static base_ptr maximum(base_ptr x)
+ {
+ while (x->right != 0) x = x->right;
+ return x;
+ }
+};
+
+template <class Value>
+struct __rb_tree_node : public __rb_tree_node_base
+{
+ typedef __rb_tree_node<Value>* link_type;
+ Value value_field;
+};
+
+
+struct __rb_tree_base_iterator
+{
+ typedef __rb_tree_node_base::base_ptr base_ptr;
+ typedef bidirectional_iterator_tag iterator_category;
+ typedef ptrdiff_t difference_type;
+ base_ptr node;
+
+ void increment()
+ {
+ if (node->right != 0) {
+ node = node->right;
+ while (node->left != 0)
+ node = node->left;
+ }
+ else {
+ base_ptr y = node->parent;
+ while (node == y->right) {
+ node = y;
+ y = y->parent;
+ }
+ if (node->right != y)
+ node = y;
+ }
+ }
+
+ void decrement()
+ {
+ if (node->color == __rb_tree_red &&
+ node->parent->parent == node)
+ node = node->right;
+ else if (node->left != 0) {
+ base_ptr y = node->left;
+ while (y->right != 0)
+ y = y->right;
+ node = y;
+ }
+ else {
+ base_ptr y = node->parent;
+ while (node == y->left) {
+ node = y;
+ y = y->parent;
+ }
+ node = y;
+ }
+ }
+};
+
+template <class Value, class Ref>
+struct __rb_tree_iterator : public __rb_tree_base_iterator
+{
+ typedef Value value_type;
+ typedef Value& reference;
+ typedef const Value& const_reference;
+ typedef Value* pointer;
+ typedef __rb_tree_iterator<Value, reference> iterator;
+ typedef __rb_tree_iterator<Value, const_reference> const_iterator;
+ typedef __rb_tree_iterator<Value, Ref> self;
+ typedef __rb_tree_node<Value>* link_type;
+
+ __rb_tree_iterator() {}
+ __rb_tree_iterator(link_type x) { node = x; }
+ __rb_tree_iterator(const iterator& it) { node = it.node; }
+
+ Ref operator*() const { return link_type(node)->value_field; }
+
+ self& operator++() { increment(); return *this; }
+ self operator++(int) {
+ self tmp = *this;
+ increment();
+ return tmp;
+ }
+
+ self& operator--() { decrement(); return *this; }
+ self operator--(int) {
+ self tmp = *this;
+ decrement();
+ return tmp;
+ }
+};
+
+inline bool operator==(const __rb_tree_base_iterator& x,
+ const __rb_tree_base_iterator& y) {
+ return x.node == y.node;
+}
+
+inline bool operator!=(const __rb_tree_base_iterator& x,
+ const __rb_tree_base_iterator& y) {
+ return x.node != y.node;
+}
+
+inline bidirectional_iterator_tag
+iterator_category(const __rb_tree_base_iterator&) {
+ return bidirectional_iterator_tag();
+}
+
+inline __rb_tree_base_iterator::difference_type*
+distance_type(const __rb_tree_base_iterator&) {
+ return (__rb_tree_base_iterator::difference_type*) 0;
+}
+
+template <class Value, class Ref>
+inline Value* value_type(const __rb_tree_iterator<Value, Ref>&) {
+ return (Value*) 0;
+}
+
+inline void
+__rb_tree_rotate_left(__rb_tree_node_base* x, __rb_tree_node_base*& root)
+{
+ __rb_tree_node_base* y = x->right;
+ x->right = y->left;
+ if (y->left !=0)
+ y->left->parent = x;
+ y->parent = x->parent;
+
+ if (x == root)
+ root = y;
+ else if (x == x->parent->left)
+ x->parent->left = y;
+ else
+ x->parent->right = y;
+ y->left = x;
+ x->parent = y;
+}
+
+inline void
+__rb_tree_rotate_right(__rb_tree_node_base* x, __rb_tree_node_base*& root)
+{
+ __rb_tree_node_base* y = x->left;
+ x->left = y->right;
+ if (y->right != 0)
+ y->right->parent = x;
+ y->parent = x->parent;
+
+ if (x == root)
+ root = y;
+ else if (x == x->parent->right)
+ x->parent->right = y;
+ else
+ x->parent->left = y;
+ y->right = x;
+ x->parent = y;
+}
+
+inline void
+__rb_tree_rebalance(__rb_tree_node_base* x, __rb_tree_node_base*& root)
+{
+ x->color = __rb_tree_red;
+ while (x != root && x->parent->color == __rb_tree_red) {
+ if (x->parent == x->parent->parent->left) {
+ __rb_tree_node_base* y = x->parent->parent->right;
+ if (y && y->color == __rb_tree_red) {
+ x->parent->color = __rb_tree_black;
+ y->color = __rb_tree_black;
+ x->parent->parent->color = __rb_tree_red;
+ x = x->parent->parent;
+ }
+ else {
+ if (x == x->parent->right) {
+ x = x->parent;
+ __rb_tree_rotate_left(x, root);
+ }
+ x->parent->color = __rb_tree_black;
+ x->parent->parent->color = __rb_tree_red;
+ __rb_tree_rotate_right(x->parent->parent, root);
+ }
+ }
+ else {
+ __rb_tree_node_base* y = x->parent->parent->left;
+ if (y && y->color == __rb_tree_red) {
+ x->parent->color = __rb_tree_black;
+ y->color = __rb_tree_black;
+ x->parent->parent->color = __rb_tree_red;
+ x = x->parent->parent;
+ }
+ else {
+ if (x == x->parent->left) {
+ x = x->parent;
+ __rb_tree_rotate_right(x, root);
+ }
+ x->parent->color = __rb_tree_black;
+ x->parent->parent->color = __rb_tree_red;
+ __rb_tree_rotate_left(x->parent->parent, root);
+ }
+ }
+ }
+ root->color = __rb_tree_black;
+}
+
+inline __rb_tree_node_base*
+__rb_tree_rebalance_for_erase(__rb_tree_node_base* z,
+ __rb_tree_node_base*& root,
+ __rb_tree_node_base*& leftmost,
+ __rb_tree_node_base*& rightmost)
+{
+ __rb_tree_node_base* y = z;
+ __rb_tree_node_base* x = 0;
+ __rb_tree_node_base* x_parent = 0;
+ if (y->left == 0) // z has at most one non-null child. y == z.
+ x = y->right; // x might be null.
+ else
+ if (y->right == 0) // z has exactly one non-null child. y == z.
+ x = y->left; // x is not null.
+ else { // z has two non-null children. Set y to
+ y = y->right; // z's successor. x might be null.
+ while (y->left != 0)
+ y = y->left;
+ x = y->right;
+ }
+ if (y != z) { // relink y in place of z. y is z's successor
+ z->left->parent = y;
+ y->left = z->left;
+ if (y != z->right) {
+ x_parent = y->parent;
+ if (x) x->parent = y->parent;
+ y->parent->left = x; // y must be a left child
+ y->right = z->right;
+ z->right->parent = y;
+ }
+ else
+ x_parent = y;
+ if (root == z)
+ root = y;
+ else if (z->parent->left == z)
+ z->parent->left = y;
+ else
+ z->parent->right = y;
+ y->parent = z->parent;
+ ::swap(y->color, z->color);
+ y = z;
+ // y now points to node to be actually deleted
+ }
+ else { // y == z
+ x_parent = y->parent;
+ if (x) x->parent = y->parent;
+ if (root == z)
+ root = x;
+ else
+ if (z->parent->left == z)
+ z->parent->left = x;
+ else
+ z->parent->right = x;
+ if (leftmost == z)
+ if (z->right == 0) // z->left must be null also
+ leftmost = z->parent;
+ // makes leftmost == header if z == root
+ else
+ leftmost = __rb_tree_node_base::minimum(x);
+ if (rightmost == z)
+ if (z->left == 0) // z->right must be null also
+ rightmost = z->parent;
+ // makes rightmost == header if z == root
+ else // x == z->left
+ rightmost = __rb_tree_node_base::maximum(x);
+ }
+ if (y->color != __rb_tree_red) {
+ while (x != root && (x == 0 || x->color == __rb_tree_black))
+ if (x == x_parent->left) {
+ __rb_tree_node_base* w = x_parent->right;
+ if (w->color == __rb_tree_red) {
+ w->color = __rb_tree_black;
+ x_parent->color = __rb_tree_red;
+ __rb_tree_rotate_left(x_parent, root);
+ w = x_parent->right;
+ }
+ if ((w->left == 0 || w->left->color == __rb_tree_black) &&
+ (w->right == 0 || w->right->color == __rb_tree_black)) {
+ w->color = __rb_tree_red;
+ x = x_parent;
+ x_parent = x_parent->parent;
+ } else {
+ if (w->right == 0 || w->right->color == __rb_tree_black) {
+ if (w->left) w->left->color = __rb_tree_black;
+ w->color = __rb_tree_red;
+ __rb_tree_rotate_right(w, root);
+ w = x_parent->right;
+ }
+ w->color = x_parent->color;
+ x_parent->color = __rb_tree_black;
+ if (w->right) w->right->color = __rb_tree_black;
+ __rb_tree_rotate_left(x_parent, root);
+ break;
+ }
+ } else { // same as above, with right <-> left.
+ __rb_tree_node_base* w = x_parent->left;
+ if (w->color == __rb_tree_red) {
+ w->color = __rb_tree_black;
+ x_parent->color = __rb_tree_red;
+ __rb_tree_rotate_right(x_parent, root);
+ w = x_parent->left;
+ }
+ if ((w->right == 0 || w->right->color == __rb_tree_black) &&
+ (w->left == 0 || w->left->color == __rb_tree_black)) {
+ w->color = __rb_tree_red;
+ x = x_parent;
+ x_parent = x_parent->parent;
+ } else {
+ if (w->left == 0 || w->left->color == __rb_tree_black) {
+ if (w->right) w->right->color = __rb_tree_black;
+ w->color = __rb_tree_red;
+ __rb_tree_rotate_left(w, root);
+ w = x_parent->left;
+ }
+ w->color = x_parent->color;
+ x_parent->color = __rb_tree_black;
+ if (w->left) w->left->color = __rb_tree_black;
+ __rb_tree_rotate_right(x_parent, root);
+ break;
+ }
+ }
+ if (x) x->color = __rb_tree_black;
+ }
+ return y;
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare,
+ class Alloc = alloc>
+class rb_tree {
+protected:
+ typedef void* void_pointer;
+ typedef __rb_tree_node_base* base_ptr;
+ typedef __rb_tree_node<Value> rb_tree_node;
+ typedef simple_alloc<rb_tree_node, Alloc> rb_tree_node_allocator;
+ typedef __rb_tree_color_type color_type;
+public:
+ typedef Key key_type;
+ typedef Value value_type;
+ typedef value_type* pointer;
+ typedef const value_type* const_pointer;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef rb_tree_node* link_type;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+protected:
+ link_type get_node() { return rb_tree_node_allocator::allocate(); }
+ void put_node(link_type p) { rb_tree_node_allocator::deallocate(p); }
+
+ link_type create_node(const value_type& x) {
+ link_type tmp = get_node();
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ construct(&tmp->value_field, x);
+ return tmp;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ put_node(tmp);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+ link_type clone_node(link_type x) {
+ link_type tmp = create_node(x->value_field);
+ tmp->color = x->color;
+ tmp->left = 0;
+ tmp->right = 0;
+ return tmp;
+ }
+
+ void destroy_node(link_type p) {
+ destroy(&p->value_field);
+ put_node(p);
+ }
+
+protected:
+ size_type node_count; // keeps track of size of tree
+ link_type header;
+ Compare key_compare;
+
+ link_type& root() const { return (link_type&) header->parent; }
+ link_type& leftmost() const { return (link_type&) header->left; }
+ link_type& rightmost() const { return (link_type&) header->right; }
+
+ static link_type& left(link_type x) { return (link_type&)(x->left); }
+ static link_type& right(link_type x) { return (link_type&)(x->right); }
+ static link_type& parent(link_type x) { return (link_type&)(x->parent); }
+ static reference value(link_type x) { return x->value_field; }
+ static const Key& key(link_type x) { return KeyOfValue()(value(x)); }
+ static color_type& color(link_type x) { return (color_type&)(x->color); }
+
+ static link_type& left(base_ptr x) { return (link_type&)(x->left); }
+ static link_type& right(base_ptr x) { return (link_type&)(x->right); }
+ static link_type& parent(base_ptr x) { return (link_type&)(x->parent); }
+ static reference value(base_ptr x) { return ((link_type)x)->value_field; }
+ static const Key& key(base_ptr x) { return KeyOfValue()(value(link_type(x)));}
+ static color_type& color(base_ptr x) { return (color_type&)(link_type(x)->color); }
+
+ static link_type minimum(link_type x) {
+ return (link_type) __rb_tree_node_base::minimum(x);
+ }
+ static link_type maximum(link_type x) {
+ return (link_type) __rb_tree_node_base::maximum(x);
+ }
+
+public:
+ typedef __rb_tree_iterator<value_type, reference> iterator;
+ typedef __rb_tree_iterator<value_type, const_reference> const_iterator;
+
+ typedef reverse_bidirectional_iterator<iterator, value_type, reference,
+ difference_type>
+ reverse_iterator;
+ typedef reverse_bidirectional_iterator<const_iterator, value_type,
+ const_reference, difference_type>
+ const_reverse_iterator;
+private:
+ iterator __insert(base_ptr x, base_ptr y, const value_type& v);
+ link_type __copy(link_type x, link_type p);
+ void __erase(link_type x);
+ void init() {
+ header = get_node();
+ color(header) = __rb_tree_red; // used to distinguish header from
+ // root, in iterator.operator++
+ root() = 0;
+ leftmost() = header;
+ rightmost() = header;
+ }
+public:
+ // allocation/deallocation
+ rb_tree(const Compare& comp = Compare())
+ : key_compare(comp), node_count(0) { init(); }
+
+ rb_tree(const rb_tree<Key, Value, KeyOfValue, Compare, Alloc>& x)
+ : key_compare(x.key_compare), node_count(0) {
+ header = get_node();
+ color(header) = __rb_tree_red;
+ if (x.root() == 0) {
+ root() = 0;
+ leftmost() = header;
+ rightmost() = header;
+ }
+ else {
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ root() = __copy(x.root(), header);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ put_node(header);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ leftmost() = minimum(root());
+ rightmost() = maximum(root());
+ }
+ node_count = x.node_count;
+ }
+ ~rb_tree() {
+ clear();
+ put_node(header);
+ }
+ rb_tree<Key, Value, KeyOfValue, Compare, Alloc>&
+ operator=(const rb_tree<Key, Value, KeyOfValue, Compare, Alloc>& x);
+
+public:
+ // accessors:
+ Compare key_comp() const { return key_compare; }
+ iterator begin() { return leftmost(); }
+ const_iterator begin() const { return leftmost(); }
+ iterator end() { return header; }
+ const_iterator end() const { return header; }
+ reverse_iterator rbegin() { return reverse_iterator(end()); }
+ const_reverse_iterator rbegin() const {
+ return const_reverse_iterator(end());
+ }
+ reverse_iterator rend() { return reverse_iterator(begin()); }
+ const_reverse_iterator rend() const {
+ return const_reverse_iterator(begin());
+ }
+ bool empty() const { return node_count == 0; }
+ size_type size() const { return node_count; }
+ size_type max_size() const { return size_type(-1); }
+
+ void swap(rb_tree<Key, Value, KeyOfValue, Compare, Alloc>& t) {
+ ::swap(header, t.header);
+ ::swap(node_count, t.node_count);
+ ::swap(key_compare, t.key_compare);
+ }
+
+public:
+ // insert/erase
+ pair<iterator,bool> insert_unique(const value_type& x);
+ iterator insert_equal(const value_type& x);
+
+ iterator insert_unique(iterator position, const value_type& x);
+ iterator insert_equal(iterator position, const value_type& x);
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert_unique(InputIterator first, InputIterator last);
+ template <class InputIterator>
+ void insert_equal(InputIterator first, InputIterator last);
+#else /* __STL_MEMBER_TEMPLATES */
+ void insert_unique(const_iterator first, const_iterator last);
+ void insert_unique(const value_type* first, const value_type* last);
+ void insert_equal(const_iterator first, const_iterator last);
+ void insert_equal(const value_type* first, const value_type* last);
+#endif /* __STL_MEMBER_TEMPLATES */
+
+ void erase(iterator position);
+ size_type erase(const key_type& x);
+ void erase(iterator first, iterator last);
+ void erase(const key_type* first, const key_type* last);
+ void clear() {
+ if (node_count != 0) {
+ __erase(root());
+ leftmost() = header;
+ root() = 0;
+ rightmost() = header;
+ node_count = 0;
+ }
+ }
+
+public:
+ // set operations:
+ iterator find(const key_type& x);
+ const_iterator find(const key_type& x) const;
+ size_type count(const key_type& x) const;
+ iterator lower_bound(const key_type& x);
+ const_iterator lower_bound(const key_type& x) const;
+ iterator upper_bound(const key_type& x);
+ const_iterator upper_bound(const key_type& x) const;
+ pair<iterator,iterator> equal_range(const key_type& x);
+ pair<const_iterator, const_iterator> equal_range(const key_type& x) const;
+
+public:
+ // Debugging.
+ bool __rb_verify() const;
+};
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+inline bool operator==(const rb_tree<Key, Value, KeyOfValue, Compare, Alloc>& x,
+ const rb_tree<Key, Value, KeyOfValue, Compare, Alloc>& y) {
+ return x.size() == y.size() && equal(x.begin(), x.end(), y.begin());
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+inline bool operator<(const rb_tree<Key, Value, KeyOfValue, Compare, Alloc>& x,
+ const rb_tree<Key, Value, KeyOfValue, Compare, Alloc>& y) {
+ return lexicographical_compare(x.begin(), x.end(), y.begin(), y.end());
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>&
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::
+operator=(const rb_tree<Key, Value, KeyOfValue, Compare, Alloc>& x) {
+ if (this != &x) {
+ // Note that Key may be a constant type.
+ clear();
+ node_count = 0;
+ key_compare = x.key_compare;
+ if (x.root() == 0) {
+ root() = 0;
+ leftmost() = header;
+ rightmost() = header;
+ }
+ else {
+ root() = __copy(x.root(), header);
+ leftmost() = minimum(root());
+ rightmost() = maximum(root());
+ node_count = x.node_count;
+ }
+ }
+ return *this;
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::iterator
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::
+__insert(base_ptr x_, base_ptr y_, const Value& v) {
+ link_type x = (link_type) x_;
+ link_type y = (link_type) y_;
+ link_type z;
+
+ if (y == header || x != 0 || key_compare(KeyOfValue()(v), key(y))) {
+ z = create_node(v);
+ left(y) = z; // also makes leftmost() = z when y == header
+ if (y == header) {
+ root() = z;
+ rightmost() = z;
+ }
+ else if (y == leftmost())
+ leftmost() = z; // maintain leftmost() pointing to min node
+ }
+ else {
+ z = create_node(v);
+ right(y) = z;
+ if (y == rightmost())
+ rightmost() = z; // maintain rightmost() pointing to max node
+ }
+ parent(z) = y;
+ left(z) = 0;
+ right(z) = 0;
+ __rb_tree_rebalance(z, header->parent);
+ ++node_count;
+ return iterator(z);
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::iterator
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::insert_equal(const Value& v)
+{
+ link_type y = header;
+ link_type x = root();
+ while (x != 0) {
+ y = x;
+ x = key_compare(KeyOfValue()(v), key(x)) ? left(x) : right(x);
+ }
+ return __insert(x, y, v);
+}
+
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+pair<rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::iterator, bool>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::insert_unique(const Value& v)
+{
+ link_type y = header;
+ link_type x = root();
+ bool comp = true;
+ while (x != 0) {
+ y = x;
+ comp = key_compare(KeyOfValue()(v), key(x));
+ x = comp ? left(x) : right(x);
+ }
+ iterator j = iterator(y);
+ if (comp)
+ if (j == begin())
+ return pair<iterator,bool>(__insert(x, y, v), true);
+ else
+ --j;
+ if (key_compare(key(j.node), KeyOfValue()(v)))
+ return pair<iterator,bool>(__insert(x, y, v), true);
+ return pair<iterator,bool>(j, false);
+}
+
+
+template <class Key, class Val, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Val, KeyOfValue, Compare, Alloc>::iterator
+rb_tree<Key, Val, KeyOfValue, Compare, Alloc>::insert_unique(iterator position,
+ const Val& v) {
+ if (position.node == header->left) // begin()
+ if (size() > 0 && key_compare(KeyOfValue()(v), key(position.node)))
+ return __insert(position.node, position.node, v);
+ // first argument just needs to be non-null
+ else
+ return insert_unique(v).first;
+ else if (position.node == header) // end()
+ if (key_compare(key(rightmost()), KeyOfValue()(v)))
+ return __insert(0, rightmost(), v);
+ else
+ return insert_unique(v).first;
+ else {
+ iterator before = position;
+ --before;
+ if (key_compare(key(before.node), KeyOfValue()(v))
+ && key_compare(KeyOfValue()(v), key(position.node)))
+ if (right(before.node) == 0)
+ return __insert(0, before.node, v);
+ else
+ return __insert(position.node, position.node, v);
+ // first argument just needs to be non-null
+ else
+ return insert_unique(v).first;
+ }
+}
+
+template <class Key, class Val, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Val, KeyOfValue, Compare, Alloc>::iterator
+rb_tree<Key, Val, KeyOfValue, Compare, Alloc>::insert_equal(iterator position,
+ const Val& v) {
+ if (position.node == header->left) // begin()
+ if (size() > 0 && key_compare(KeyOfValue()(v), key(position.node)))
+ return __insert(position.node, position.node, v);
+ // first argument just needs to be non-null
+ else
+ return insert_equal(v);
+ else if (position.node == header) // end()
+ if (!key_compare(KeyOfValue()(v), key(rightmost())))
+ return __insert(0, rightmost(), v);
+ else
+ return insert_equal(v);
+ else {
+ iterator before = position;
+ --before;
+ if (!key_compare(KeyOfValue()(v), key(before.node))
+ && !key_compare(key(position.node), KeyOfValue()(v)))
+ if (right(before.node) == 0)
+ return __insert(0, before.node, v);
+ else
+ return __insert(position.node, position.node, v);
+ // first argument just needs to be non-null
+ else
+ return insert_equal(v);
+ }
+}
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+template <class K, class V, class KoV, class Cmp, class Al> template<class II>
+void rb_tree<K, V, KoV, Cmp, Al>::insert_equal(II first, II last) {
+ for ( ; first != last; ++first)
+ insert_equal(*first);
+}
+
+template <class K, class V, class KoV, class Cmp, class Al> template<class II>
+void rb_tree<K, V, KoV, Cmp, Al>::insert_unique(II first, II last) {
+ for ( ; first != last; ++first)
+ insert_unique(*first);
+}
+
+#else /* __STL_MEMBER_TEMPLATES */
+
+template <class K, class V, class KoV, class Cmp, class Al>
+void
+rb_tree<K, V, KoV, Cmp, Al>::insert_equal(const V* first, const V* last) {
+ for ( ; first != last; ++first)
+ insert_equal(*first);
+}
+
+template <class K, class V, class KoV, class Cmp, class Al>
+void
+rb_tree<K, V, KoV, Cmp, Al>::insert_equal(const_iterator first,
+ const_iterator last) {
+ for ( ; first != last; ++first)
+ insert_equal(*first);
+}
+
+template <class K, class V, class KoV, class Cmp, class A>
+void
+rb_tree<K, V, KoV, Cmp, A>::insert_unique(const V* first, const V* last) {
+ for ( ; first != last; ++first)
+ insert_unique(*first);
+}
+
+template <class K, class V, class KoV, class Cmp, class A>
+void
+rb_tree<K, V, KoV, Cmp, A>::insert_unique(const_iterator first,
+ const_iterator last) {
+ for ( ; first != last; ++first)
+ insert_unique(*first);
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+inline void
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::erase(iterator position) {
+ link_type y = (link_type) __rb_tree_rebalance_for_erase(position.node,
+ header->parent,
+ header->left,
+ header->right);
+ destroy_node(y);
+ --node_count;
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::size_type
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::erase(const Key& x) {
+ pair<iterator,iterator> p = equal_range(x);
+ size_type n = 0;
+ distance(p.first, p.second, n);
+ erase(p.first, p.second);
+ return n;
+}
+
+template <class K, class V, class KeyOfValue, class Compare, class Alloc>
+rb_tree<K, V, KeyOfValue, Compare, Alloc>::link_type
+rb_tree<K, V, KeyOfValue, Compare, Alloc>::__copy(link_type x, link_type p) {
+ // structural copy. x and p must be non-null.
+ link_type top = clone_node(x);
+ top->parent = p;
+
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ if (x->right)
+ top->right = __copy(right(x), top);
+ p = top;
+ x = left(x);
+
+ while (x != 0) {
+ link_type y = clone_node(x);
+ p->left = y;
+ y->parent = p;
+ if (x->right)
+ y->right = __copy(right(x), y);
+ p = y;
+ x = left(x);
+ }
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ __erase(top);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+
+ return top;
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+void rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::__erase(link_type x) {
+ // erase without rebalancing
+ while (x != 0) {
+ __erase(right(x));
+ link_type y = left(x);
+ destroy_node(x);
+ x = y;
+ }
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+void rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::erase(iterator first,
+ iterator last) {
+ if (first == begin() && last == end())
+ clear();
+ else
+ while (first != last) erase(first++);
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+void rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::erase(const Key* first,
+ const Key* last) {
+ while (first != last) erase(*first++);
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::iterator
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::find(const Key& k) {
+ link_type y = header; // Last node which is not less than k.
+ link_type x = root(); // Current node.
+
+ while (x != 0)
+ if (!key_compare(key(x), k))
+ y = x, x = left(x);
+ else
+ x = right(x);
+
+ iterator j = iterator(y);
+ return (j == end() || key_compare(k, key(j.node))) ? end() : j;
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::const_iterator
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::find(const Key& k) const {
+ link_type y = header; /* Last node which is not less than k. */
+ link_type x = root(); /* Current node. */
+
+ while (x != 0) {
+ if (!key_compare(key(x), k))
+ y = x, x = left(x);
+ else
+ x = right(x);
+ }
+ const_iterator j = const_iterator(y);
+ return (j == end() || key_compare(k, key(j.node))) ? end() : j;
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::size_type
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::count(const Key& k) const {
+ pair<const_iterator, const_iterator> p = equal_range(k);
+ size_type n = 0;
+ distance(p.first, p.second, n);
+ return n;
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::iterator
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::lower_bound(const Key& k) {
+ link_type y = header; /* Last node which is not less than k. */
+ link_type x = root(); /* Current node. */
+
+ while (x != 0)
+ if (!key_compare(key(x), k))
+ y = x, x = left(x);
+ else
+ x = right(x);
+
+ return iterator(y);
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::const_iterator
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::lower_bound(const Key& k) const {
+ link_type y = header; /* Last node which is not less than k. */
+ link_type x = root(); /* Current node. */
+
+ while (x != 0)
+ if (!key_compare(key(x), k))
+ y = x, x = left(x);
+ else
+ x = right(x);
+
+ return const_iterator(y);
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::iterator
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::upper_bound(const Key& k) {
+ link_type y = header; /* Last node which is greater than k. */
+ link_type x = root(); /* Current node. */
+
+ while (x != 0)
+ if (key_compare(k, key(x)))
+ y = x, x = left(x);
+ else
+ x = right(x);
+
+ return iterator(y);
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::const_iterator
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::upper_bound(const Key& k) const {
+ link_type y = header; /* Last node which is greater than k. */
+ link_type x = root(); /* Current node. */
+
+ while (x != 0)
+ if (key_compare(k, key(x)))
+ y = x, x = left(x);
+ else
+ x = right(x);
+
+ return const_iterator(y);
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+inline pair<rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::iterator,
+ rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::iterator>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::equal_range(const Key& k) {
+ return pair<iterator, iterator>(lower_bound(k), upper_bound(k));
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+inline pair<rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::const_iterator,
+ rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::const_iterator>
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::equal_range(const Key& k) const {
+ return pair<const_iterator,const_iterator>(lower_bound(k), upper_bound(k));
+}
+
+inline int __black_count(__rb_tree_node_base* node, __rb_tree_node_base* root)
+{
+ if (node == 0)
+ return 0;
+ else {
+ int bc = node->color == __rb_tree_black ? 1 : 0;
+ if (node == root)
+ return bc;
+ else
+ return bc + __black_count(node->parent, root);
+ }
+}
+
+template <class Key, class Value, class KeyOfValue, class Compare, class Alloc>
+bool
+rb_tree<Key, Value, KeyOfValue, Compare, Alloc>::__rb_verify() const
+{
+ if (node_count == 0 || begin() == end())
+ return node_count == 0 && begin() == end() &&
+ header->left == header && header->right == header;
+
+ int len = __black_count(leftmost(), root());
+ for (const_iterator it = begin(); it != end(); ++it) {
+ link_type x = (link_type) it.node;
+ link_type L = left(x);
+ link_type R = right(x);
+
+ if (x->color == __rb_tree_red)
+ if ((L && L->color == __rb_tree_red) ||
+ (R && R->color == __rb_tree_red))
+ return false;
+
+ if (L && key_compare(key(x), key(L)))
+ return false;
+ if (R && key_compare(key(R), key(x)))
+ return false;
+
+ if (!L && !R && __black_count(x, root()) != len)
+ return false;
+ }
+
+ if (leftmost() != __rb_tree_node_base::minimum(root()))
+ return false;
+ if (rightmost() != __rb_tree_node_base::maximum(root()))
+ return false;
+
+ return true;
+}
+
+#endif /* __SGI_STL_TREE_H */
diff --git a/libstdc++/stl/type_traits.h b/libstdc++/stl/type_traits.h
new file mode 100644
index 00000000000..6ca0137709d
--- /dev/null
+++ b/libstdc++/stl/type_traits.h
@@ -0,0 +1,227 @@
+/*
+ *
+ * Copyright (c) 1997
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __TYPE_TRAITS_H
+#define __TYPE_TRAITS_H
+
+#include <stl_config.h>
+
+/*
+This header file provides a framework for allowing compile time dispatch
+based on type attributes. This is useful when writing template code.
+For example, when making a copy of an array of an unknown type, it helps
+to know if the type has a trivial copy constructor or not, to help decide
+if a memcpy can be used.
+
+The class template __type_traits provides a series of typedefs each of
+which is either __true_type or __false_type. The argument to
+__type_traits can be any type. The typedefs within this template will
+attain their correct values by one of these means:
+ 1. The general instantiation contain conservative values which work
+ for all types.
+ 2. Specializations may be declared to make distinctions between types.
+ 3. Some compilers (such as the Silicon Graphics N32 and N64 compilers)
+ will automatically provide the appropriate specializations for all
+ types.
+
+EXAMPLE:
+
+//Copy an array of elements which have non-trivial copy constructors
+template <class T> void copy(T* source,T* destination,int n,__false_type);
+//Copy an array of elements which have trivial copy constructors. Use memcpy.
+template <class T> void copy(T* source,T* destination,int n,__true_type);
+
+//Copy an array of any type by using the most efficient copy mechanism
+template <class T> inline void copy(T* source,T* destination,int n) {
+ copy(source,destination,n,__type_traits<T>::has_trivial_copy_constructor());
+}
+*/
+
+
+struct __true_type {
+};
+
+struct __false_type {
+};
+
+template <class type>
+struct __type_traits {
+ typedef __true_type this_dummy_member_must_be_first;
+ /* Do not remove this member. It informs a compiler which
+ automatically specializes __type_traits that this
+ __type_traits template is special. It just makes sure that
+ things work if an implementation is using a template
+ called __type_traits for something unrelated. */
+
+ /* The following restrictions should be observed for the sake of
+ compilers which automatically produce type specific specializations
+ of this class:
+ - You may reorder the members below if you wish
+ - You may remove any of the members below if you wish
+ - You must not rename members without making the corresponding
+ name change in the compiler
+ - Members you add will be treated like regular members unless
+ you add the appropriate support in the compiler. */
+
+
+ typedef __false_type has_trivial_default_constructor;
+ typedef __false_type has_trivial_copy_constructor;
+ typedef __false_type has_trivial_assignment_operator;
+ typedef __false_type has_trivial_destructor;
+ typedef __false_type is_POD_type;
+};
+
+
+
+// Provide some specializations. This is harmless for compilers that
+// have built-in __types_traits support, and essential for compilers
+// that don't.
+
+struct __type_traits<char> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<signed char> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<unsigned char> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<short> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<unsigned short> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<int> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<unsigned int> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<long> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<unsigned long> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<float> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<double> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<long double> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+#ifdef __STL_CLASS_PARTIAL_SPECIALIZATION
+
+template <class T>
+struct __type_traits<T*> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+#else /* __STL_CLASS_PARTIAL_SPECIALIZATION */
+
+struct __type_traits<char*> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<signed char*> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+struct __type_traits<unsigned char*> {
+ typedef __true_type has_trivial_default_constructor;
+ typedef __true_type has_trivial_copy_constructor;
+ typedef __true_type has_trivial_assignment_operator;
+ typedef __true_type has_trivial_destructor;
+ typedef __true_type is_POD_type;
+};
+
+#endif /* __STL_CLASS_PARTIAL_SPECIALIZATION */
+
+
+#endif /* __TYPE_TRAITS_H */
diff --git a/libstdc++/stl/vector.h b/libstdc++/stl/vector.h
new file mode 100644
index 00000000000..bb6a404766b
--- /dev/null
+++ b/libstdc++/stl/vector.h
@@ -0,0 +1,544 @@
+/*
+ *
+ * Copyright (c) 1994
+ * Hewlett-Packard Company
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Hewlett-Packard Company makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ *
+ *
+ * Copyright (c) 1996
+ * Silicon Graphics Computer Systems, Inc.
+ *
+ * Permission to use, copy, modify, distribute and sell this software
+ * and its documentation for any purpose is hereby granted without fee,
+ * provided that the above copyright notice appear in all copies and
+ * that both that copyright notice and this permission notice appear
+ * in supporting documentation. Silicon Graphics makes no
+ * representations about the suitability of this software for any
+ * purpose. It is provided "as is" without express or implied warranty.
+ */
+
+#ifndef __SGI_STL_VECTOR_H
+#define __SGI_STL_VECTOR_H
+
+#include <stddef.h>
+#include <algobase.h>
+#include <alloc.h>
+
+template <class T, class Alloc = alloc>
+class vector {
+public:
+ typedef T value_type;
+ typedef value_type* pointer;
+ typedef value_type* iterator;
+ typedef const value_type* const_iterator;
+ typedef value_type& reference;
+ typedef const value_type& const_reference;
+ typedef size_t size_type;
+ typedef ptrdiff_t difference_type;
+ typedef reverse_iterator<const_iterator, value_type, const_reference,
+ difference_type> const_reverse_iterator;
+ typedef reverse_iterator<iterator, value_type, reference, difference_type>
+ reverse_iterator;
+protected:
+ typedef simple_alloc<value_type, Alloc> data_allocator;
+ iterator start;
+ iterator finish;
+ iterator end_of_storage;
+ void insert_aux(iterator position, const T& x);
+ void deallocate() {
+ if (start) data_allocator::deallocate(start, end_of_storage - start);
+ }
+public:
+ iterator begin() { return start; }
+ const_iterator begin() const { return start; }
+ iterator end() { return finish; }
+ const_iterator end() const { return finish; }
+ reverse_iterator rbegin() { return reverse_iterator(end()); }
+ const_reverse_iterator rbegin() const {
+ return const_reverse_iterator(end());
+ }
+ reverse_iterator rend() { return reverse_iterator(begin()); }
+ const_reverse_iterator rend() const {
+ return const_reverse_iterator(begin());
+ }
+ size_type size() const { return size_type(end() - begin()); }
+ size_type max_size() const { return size_type(-1); }
+ size_type capacity() const { return size_type(end_of_storage - begin()); }
+ bool empty() const { return begin() == end(); }
+ reference operator[](size_type n) { return *(begin() + n); }
+ const_reference operator[](size_type n) const { return *(begin() + n); }
+ vector() : start(0), finish(0), end_of_storage(0) {}
+ vector(size_type n, const T& value) {
+ start = allocate_and_fill(n, value);
+ finish = start + n;
+ end_of_storage = finish;
+ }
+ explicit vector(size_type n) {
+ start = allocate_and_fill(n, T());
+ finish = start + n;
+ end_of_storage = finish;
+ }
+ vector(const vector<T, Alloc>& x) {
+ start = allocate_and_copy(x.end() - x.begin(), x.begin(), x.end());
+ finish = start + (x.end() - x.begin());
+ end_of_storage = finish;
+ }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ vector(InputIterator first, InputIterator last) :
+ start(0), finish(0), end_of_storage(0) {
+ range_initialize(first, last, iterator_category(first));
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ vector(const_iterator first, const_iterator last) {
+ size_type n = 0;
+ distance(first, last, n);
+ start = allocate_and_copy(n, first, last);
+ finish = start + n;
+ end_of_storage = finish;
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+ ~vector() {
+ destroy(start, finish);
+ deallocate();
+ }
+ vector<T, Alloc>& operator=(const vector<T, Alloc>& x);
+ void reserve(size_type n) {
+ if (capacity() < n) {
+ const size_type old_size = size();
+ const iterator tmp = allocate_and_copy(n, start, finish);
+ destroy(start, finish);
+ deallocate();
+ start = tmp;
+ finish = tmp + old_size;
+ end_of_storage = start + n;
+ }
+ }
+ reference front() { return *begin(); }
+ const_reference front() const { return *begin(); }
+ reference back() { return *(end() - 1); }
+ const_reference back() const { return *(end() - 1); }
+ void push_back(const T& x) {
+ if (finish != end_of_storage) {
+ construct(finish, x);
+ ++finish;
+ } else
+ insert_aux(end(), x);
+ }
+ void swap(vector<T, Alloc>& x) {
+ ::swap(start, x.start);
+ ::swap(finish, x.finish);
+ ::swap(end_of_storage, x.end_of_storage);
+ }
+ iterator insert(iterator position, const T& x) {
+ size_type n = position - begin();
+ if (finish != end_of_storage && position == end()) {
+ construct(finish, x);
+ ++finish;
+ } else
+ insert_aux(position, x);
+ return begin() + n;
+ }
+ iterator insert(iterator position) { return insert(position, T()); }
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void insert(iterator position, InputIterator first, InputIterator last) {
+ range_insert(position, first, last, iterator_category(first));
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ void insert(iterator position,
+ const_iterator first, const_iterator last);
+#endif /* __STL_MEMBER_TEMPLATES */
+ void insert (iterator position, size_type n, const T& x);
+ void pop_back() {
+ --finish;
+ destroy(finish);
+ }
+ void erase(iterator position) {
+ if (position + 1 != end())
+ copy(position + 1, finish, position);
+ --finish;
+ destroy(finish);
+ }
+ void erase(iterator first, iterator last) {
+ iterator i = copy(last, finish, first);
+ destroy(i, finish);
+ finish = finish - (last - first);
+ }
+ void resize(size_type new_size, const T& x) {
+ if (new_size < size())
+ erase(begin() + new_size, end());
+ else
+ insert(end(), new_size - size(), x);
+ }
+ void resize(size_type new_size) { resize(new_size, T()); }
+ void clear() { erase(begin(), end()); }
+
+protected:
+ iterator allocate_and_fill(size_type n, const T& x) {
+ iterator result = data_allocator::allocate(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ uninitialized_fill_n(result, n, x);
+ return result;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ data_allocator::deallocate(result, n);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class ForwardIterator>
+ iterator allocate_and_copy(size_type n,
+ ForwardIterator first, ForwardIterator last) {
+ iterator result = data_allocator::allocate(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ uninitialized_copy(first, last, result);
+ return result;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ data_allocator::deallocate(result, n);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+#else /* __STL_MEMBER_TEMPLATES */
+ iterator allocate_and_copy(size_type n,
+ const_iterator first, const_iterator last) {
+ iterator result = data_allocator::allocate(n);
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ uninitialized_copy(first, last, result);
+ return result;
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ data_allocator::deallocate(result, n);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+
+
+#ifdef __STL_MEMBER_TEMPLATES
+ template <class InputIterator>
+ void range_initialize(InputIterator first, InputIterator last,
+ input_iterator_tag) {
+ for ( ; first != last; ++first)
+ push_back(*first);
+ }
+
+ // This function is only called by the constructor. We have to worry
+ // about resource leaks, but not about maintaining invariants.
+ template <class ForwardIterator>
+ void range_initialize(ForwardIterator first, ForwardIterator last,
+ forward_iterator_tag) {
+ size_type n = 0;
+ distance(first, last, n);
+ start = allocate_and_copy(n, first, last);
+ finish = start + n;
+ end_of_storage = finish;
+ }
+
+ template <class BidirectionalIterator>
+ void range_initialize(BidirectionalIterator first,
+ BidirectionalIterator last,
+ bidirectional_iterator_tag) {
+ range_initialize(first, last, forward_iterator_tag());
+ }
+
+ template <class RandomAccessIterator>
+ void range_initialize(RandomAccessIterator first,
+ RandomAccessIterator last,
+ random_access_iterator_tag) {
+ range_initialize(first, last, forward_iterator_tag());
+ }
+
+ template <class InputIterator>
+ void range_insert(iterator pos,
+ InputIterator first, InputIterator last,
+ input_iterator_tag);
+
+ template <class ForwardIterator>
+ void range_insert(iterator pos,
+ ForwardIterator first, ForwardIterator last,
+ forward_iterator_tag);
+
+ template <class BidirectionalIterator>
+ void range_insert(iterator pos,
+ BidirectionalIterator first, BidirectionalIterator last,
+ bidirectional_iterator_tag) {
+ range_insert(pos, first, last, forward_iterator_tag());
+ }
+
+ template <class RandomAccessIterator>
+ void range_insert(iterator pos,
+ RandomAccessIterator first, RandomAccessIterator last,
+ random_access_iterator_tag) {
+ range_insert(pos, first, last, forward_iterator_tag());
+ }
+#endif /* __STL_MEMBER_TEMPLATES */
+};
+
+template <class T, class Alloc>
+inline bool operator==(const vector<T, Alloc>& x, const vector<T, Alloc>& y) {
+ return x.size() == y.size() && equal(x.begin(), x.end(), y.begin());
+}
+
+template <class T, class Alloc>
+inline bool operator<(const vector<T, Alloc>& x, const vector<T, Alloc>& y) {
+ return lexicographical_compare(x.begin(), x.end(), y.begin(), y.end());
+}
+
+
+
+template <class T, class Alloc>
+vector<T, Alloc>& vector<T, Alloc>::operator=(const vector<T, Alloc>& x) {
+ if (&x != this) {
+ if (x.size() > capacity()) {
+ const iterator tmp = allocate_and_copy(x.end() - x.begin(),
+ x.begin(), x.end());
+ destroy(start, finish);
+ deallocate();
+ start = tmp;
+ end_of_storage = start + (x.end() - x.begin());
+ }
+ else if (size() >= x.size()) {
+ iterator i = copy(x.begin(), x.end(), begin());
+ destroy(i, finish);
+ }
+ else {
+ copy(x.begin(), x.begin() + size(), start);
+ uninitialized_copy(x.begin() + size(), x.end(), finish);
+ }
+ finish = start + x.size();
+ }
+ return *this;
+}
+
+template <class T, class Alloc>
+void vector<T, Alloc>::insert_aux(iterator position, const T& x) {
+ if (finish != end_of_storage) {
+ construct(finish, *(finish - 1));
+ ++finish;
+ T x_copy = x;
+ copy_backward(position, finish - 2, finish - 1);
+ *position = x_copy;
+ }
+ else {
+ const size_type old_size = size();
+ const size_type len = old_size != 0 ? 2 * old_size : 1;
+ const iterator new_start = data_allocator::allocate(len);
+ iterator new_finish = new_start;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ new_finish = uninitialized_copy(start, position, new_start);
+ construct(new_finish, x);
+ ++new_finish;
+ new_finish = uninitialized_copy(position, finish, new_finish);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(new_start, new_finish);
+ data_allocator::deallocate(new_start, len);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ destroy(begin(), end());
+ deallocate();
+ start = new_start;
+ finish = new_finish;
+ end_of_storage = new_start + len;
+ }
+}
+
+template <class T, class Alloc>
+void vector<T, Alloc>::insert(iterator position, size_type n, const T& x) {
+ if (n != 0) {
+ if (size_type (end_of_storage - finish) >= n) {
+ T x_copy = x;
+ const size_type elems_after = finish - position;
+ const iterator old_finish = finish;
+ if (elems_after > n) {
+ uninitialized_copy(finish - n, finish, finish);
+ finish += n;
+ copy_backward(position, old_finish - n, old_finish);
+ fill(position, position + n, x_copy);
+ }
+ else {
+ uninitialized_fill_n(finish, n - elems_after, x_copy);
+ finish += n - elems_after;
+ uninitialized_copy(position, old_finish, finish);
+ finish += elems_after;
+ fill(position, old_finish, x_copy);
+ }
+ }
+ else {
+ const size_type old_size = size();
+ const size_type len = old_size + max(old_size, n);
+ const iterator new_start = data_allocator::allocate(len);
+ iterator new_finish = new_start;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ new_finish = uninitialized_copy(start, position, new_start);
+ new_finish = uninitialized_fill_n(new_finish, n, x);
+ new_finish = uninitialized_copy(position, finish, new_finish);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(new_start, new_finish);
+ data_allocator::deallocate(new_start, len);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ destroy(start, finish);
+ deallocate();
+ start = new_start;
+ finish = new_finish;
+ end_of_storage = new_start + len;
+ }
+ }
+}
+
+#ifdef __STL_MEMBER_TEMPLATES
+
+template <class T, class Alloc> template <class InputIterator>
+void vector<T, Alloc>::range_insert(iterator pos,
+ InputIterator first, InputIterator last,
+ input_iterator_tag) {
+ for ( ; first != last; ++first) {
+ pos = insert(pos, *first);
+ ++pos;
+ }
+}
+
+template <class T, class Alloc> template <class ForwardIterator>
+void vector<T, Alloc>::range_insert(iterator position,
+ ForwardIterator first,
+ ForwardIterator last,
+ forward_iterator_tag) {
+ if (first != last) {
+ size_type n = 0;
+ distance(first, last, n);
+ if (size_type (end_of_storage - finish) >= n) {
+ const size_type elems_after = finish - position;
+ const iterator old_finish = finish;
+ if (elems_after > n) {
+ uninitialized_copy(finish - n, finish, finish);
+ finish += n;
+ copy_backward(position, old_finish - n, old_finish);
+ copy(first, last, position);
+ }
+ else {
+ ForwardIterator mid = first;
+ advance(mid, elems_after);
+ uninitialized_copy(mid, last, finish);
+ finish += n - elems_after;
+ uninitialized_copy(position, old_finish, finish);
+ finish += elems_after;
+ copy(first, mid, position);
+ }
+ }
+ else {
+ const size_type old_size = size();
+ const size_type len = old_size + max(old_size, n);
+ const iterator new_start = data_allocator::allocate(len);
+ iterator new_finish = new_start;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ new_finish = uninitialized_copy(start, position, new_start);
+ new_finish = uninitialized_copy(first, last, new_finish);
+ new_finish = uninitialized_copy(position, finish, new_finish);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(new_start, new_finish);
+ data_allocator::deallocate(new_start, len);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ destroy(start, finish);
+ deallocate();
+ start = new_start;
+ finish = new_finish;
+ end_of_storage = new_start + len;
+ }
+ }
+}
+
+#else /* __STL_MEMBER_TEMPLATES */
+
+template <class T, class Alloc>
+void vector<T, Alloc>::insert(iterator position,
+ const_iterator first,
+ const_iterator last) {
+ if (first != last) {
+ size_type n = 0;
+ distance(first, last, n);
+ if (end_of_storage - finish >= n) {
+ const size_type elems_after = finish - position;
+ const iterator old_finish = finish;
+ if (elems_after > n) {
+ uninitialized_copy(finish - n, finish, finish);
+ finish += n;
+ copy_backward(position, old_finish - n, old_finish);
+ copy(first, last, position);
+ }
+ else {
+ uninitialized_copy(first + elems_after, last, finish);
+ finish += n - elems_after;
+ uninitialized_copy(position, old_finish, finish);
+ finish += elems_after;
+ copy(first, first + elems_after, position);
+ }
+ }
+ else {
+ const size_type old_size = size();
+ const size_type len = old_size + max(old_size, n);
+ const iterator new_start = data_allocator::allocate(len);
+ iterator new_finish = new_start;
+# ifdef __STL_USE_EXCEPTIONS
+ try {
+# endif /* __STL_USE_EXCEPTIONS */
+ new_finish = uninitialized_copy(start, position, new_start);
+ new_finish = uninitialized_copy(first, last, new_finish);
+ new_finish = uninitialized_copy(position, finish, new_finish);
+# ifdef __STL_USE_EXCEPTIONS
+ }
+ catch(...) {
+ destroy(new_start, new_finish);
+ data_allocator::deallocate(new_start, len);
+ throw;
+ }
+# endif /* __STL_USE_EXCEPTIONS */
+ destroy(start, finish);
+ deallocate();
+ start = new_start;
+ finish = new_finish;
+ end_of_storage = new_start + len;
+ }
+ }
+}
+
+#endif /* __STL_MEMBER_TEMPLATES */
+
+#endif /* __SGI_STL_VECTOR_H */
diff --git a/libstdc++/stlinst.cc b/libstdc++/stlinst.cc
new file mode 100644
index 00000000000..dc55ce32274
--- /dev/null
+++ b/libstdc++/stlinst.cc
@@ -0,0 +1,8 @@
+// Instantiation file for the -*- C++ -*- Standard Library allocator templates
+// This file is part of the GNU ANSI C++ Library.
+
+#include <alloc.h>
+
+template class __default_alloc_template<false, 0>;
+
+template class __malloc_alloc_template<0>;
diff --git a/libstdc++/string b/libstdc++/string
new file mode 100644
index 00000000000..fa6f1abaa70
--- /dev/null
+++ b/libstdc++/string
@@ -0,0 +1,13 @@
+// Main header for the -*- C++ -*- string classes.
+
+#ifndef __STRING__
+#define __STRING__
+
+#include <std/bastring.h>
+
+extern "C++" {
+typedef basic_string <char> string;
+// typedef basic_string <wchar_t> wstring;
+} // extern "C++"
+
+#endif
diff --git a/libstdc++/tests/ChangeLog b/libstdc++/tests/ChangeLog
new file mode 100644
index 00000000000..7f884a126e5
--- /dev/null
+++ b/libstdc++/tests/ChangeLog
@@ -0,0 +1,87 @@
+Wed Jun 11 11:00:10 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * tmap.cc: Explicitly instantiate allocator classes.
+ * tvector.cc, tlist.cc: Likewise.
+
+Fri May 16 18:38:05 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * tcomplex.cc (main): If we're using short doubles, compensate for
+ roundoff in result of pow(a,b).
+
+Thu May 1 17:37:53 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * configure.in (CHECK): Add $(CXXFLAGS).
+ * Makefile.in (tcomplex): Add $(CXXFLAGS).
+
+Fri Apr 25 16:07:46 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * configure.in: Change "check" to "check-old". Add do-nothing
+ check target.
+
+Sun Nov 3 12:44:48 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * tstring.cc: Treat string literals as const.
+
+Tue Sep 24 18:00:20 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * tstring.cc, tcomplex.cc: Remove gratuitous uses of std/.
+
+Mon Jun 17 14:05:50 1996 Per Bothner <bothner@deneb.cygnus.com>
+
+ * tlist.cc (test_splice): New test.
+
+Fri Mar 22 16:08:36 1996 Jason Merrill <jason@yorick.cygnus.com>
+
+ * Makefile.in (VERSION): 2.8.0.
+
+ * tlist.cc, tmap.cc, tvector.cc: Remove explicit instantiation
+ directive.
+
+Sat Nov 18 19:52:26 1995 Mike Stump <mrs@cygnus.com>
+
+ * Makefile.in: Update version to 2.7.1.
+
+Tue May 9 19:36:54 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * tstring.cc (decltest): Adjust single-character test.
+
+Fri May 5 14:35:19 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * tcomplex.*: Update to reflect that operator<< now
+ accepts more forms of input.
+
+Thu Apr 27 15:34:58 1995 Brendan Kehoe (brendan@lisa.cygnus.com)
+
+ * configure.in: Update to stay in sync with config.shared.
+
+Thu Feb 16 00:08:28 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (VERSION, SHLIB): Define.
+
+Tue Jan 24 02:36:24 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in (CXXFLAGS): Don't set.
+
+Mon Jan 23 04:12:10 1995 Jason Merrill <jason@python.cygnus.com>
+
+ * tlist.cc (plus): Remove.
+
+Thu Jan 19 19:41:07 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in: Don't set LD_LIBRARY_PATH. Users will have to set
+ it themselves.
+
+Mon Jan 16 13:57:34 1995 Jason Merrill <jason@phydeaux.cygnus.com>
+
+ * Makefile.in: Update to reflect header movement.
+
+Wed Dec 14 19:55:45 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * configure.in: Fix quoting problem. Reported nu H.J.Lu.
+
+Tue Nov 29 16:46:56 1994 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * Makefile.in, configure.in: Re-write to avoid duplication.
+ * {tvector,tmap,tlist}.{cc,exp}, configure.in: New tests for STL.
+
+
diff --git a/libstdc++/tests/Makefile.in b/libstdc++/tests/Makefile.in
new file mode 100644
index 00000000000..8c3a9ef2f38
--- /dev/null
+++ b/libstdc++/tests/Makefile.in
@@ -0,0 +1,35 @@
+# Copyright (C) 1994 Free Software Foundation
+
+# This file is part of the GNU ANSI C++ 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.
+
+# 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 General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this library; see the file COPYING. If not, write to the Free
+# Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+VERSION = 2.8.0
+SHLIB = libstdc++.so.$(VERSION)
+
+DEPLIBS = ../libstdc++.a
+LDLIBS = -L.. -lstdc++
+MDEPLIBS = $(DEPLIBS)
+MLDLIBS = $(LDLIBS) -lm
+
+#### package, host, target, and site dependent Makefile fragments come in here.
+##
+
+tcomplex.o: ${srcdir}/../std/complext.h ${srcdir}/../std/dcomplex.h
+tcomplex: tcomplex.o $(MDEPLIBS)
+ $(CXX) $(CXXFLAGS) -o tcomplex tcomplex.o $(MLDLIBS)
+
+tstring.o: ${srcdir}/../std/bastring.h
+
+# NOTE: Rules for following tests are generated by $(srcdir)/configure.in !!!
+
diff --git a/libstdc++/tests/configure.in b/libstdc++/tests/configure.in
new file mode 100644
index 00000000000..ebcef863523
--- /dev/null
+++ b/libstdc++/tests/configure.in
@@ -0,0 +1,50 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../../configure.
+
+configdirs=
+srctrigger=tcomplex.cc
+srcname="tests for ANSI C++ library"
+package_makefile_frag=Make.pack
+
+# per-host:
+
+# per-target:
+
+target_makefile_frag=../target-mkfrag
+
+TO_TOPDIR=../../
+ALL=' '
+XCXXINCLUDES="-I${srcdir}/.. -I${srcdir}/../stl -I${TO_TOPDIR}libio -I${srcdir}/${TO_TOPDIR}libio"
+SIMPLE_TESTS='tstring tlist tmap tvector'
+TESTS="tcomplex ${SIMPLE_TESTS}"
+MOSTLYCLEAN="*.o core ${TESTS} *.out"
+(. ${srcdir}/${TO_TOPDIR}libio/config.shared) >${package_makefile_frag}
+
+# post-target:
+
+CHECK=""
+
+for TEST in ${SIMPLE_TESTS} ; do
+ echo "${TEST}: ${TEST}.o" '$(DEPLIBS)
+ $(CXX) $(CXXFLAGS) -o' "${TEST} ${TEST}.o" '$(LDLIBS)
+' >> Makefile
+done
+
+for TEST in ${TESTS} ; do
+ echo ".PHONY: check-${TEST}" >>Makefile
+ if [ -f ${srcdir}/${TEST}.inp ] ; then
+ echo "check-${TEST}: ${TEST}" '$(srcdir)'"/${TEST}.inp
+ ./${TEST} < "'$(srcdir)'"/${TEST}.inp > ${TEST}.out 2>&1" >>Makefile
+ else
+ echo "check-${TEST}: ${TEST}
+ ./${TEST} > ${TEST}.out 2>&1" >>Makefile
+ fi
+ echo ' diff -c $(srcdir)/'"${TEST}.exp ${TEST}.out" >>Makefile
+ CHECK="${CHECK} check-${TEST}"
+done
+echo "
+check:
+check-old: ${CHECK}" >>Makefile
+
+
diff --git a/libstdc++/tests/tcomplex.cc b/libstdc++/tests/tcomplex.cc
new file mode 100644
index 00000000000..5311f0d8b7a
--- /dev/null
+++ b/libstdc++/tests/tcomplex.cc
@@ -0,0 +1,151 @@
+// Tests for the -*- C++ -*- complex number classes.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#include <assert.h>
+#include <iostream.h>
+#include <complex>
+
+// to test near-equality
+
+const double eps = 0.000001;
+
+static void close_enough(const double_complex& a, const double_complex& b)
+{
+ assert(fabs(real(a) - real(b)) < eps &&
+ fabs(imag(a) - imag(b)) < eps);
+}
+
+
+void test3(double_complex& a, double_complex& b, double_complex& c)
+{
+
+ close_enough(-(-a) , a);
+ close_enough((a + b) , (b + a));
+ close_enough((a + (-b)) , (a - b));
+ close_enough((a * b) , (b * a));
+ close_enough((a * (-b)) , -(a * b));
+ close_enough((a / (-b)) , -(a / b));
+ close_enough((a - b) , -(b - a));
+ close_enough((a + (b + c)) , ((a + b) + c));
+ close_enough((a * (b * c)) , ((a * b) * c));
+ close_enough((a * (b + c)) , ((a * b) + (a * c)));
+ close_enough(((a - b) + b) , a);
+ close_enough(((a + b) - b) , a);
+ close_enough(((a * b) / b) , a);
+ close_enough(((a / b) * b) , a);
+
+
+ double_complex x = a;
+ x *= b;
+ close_enough(x , (a * b));
+ x += c;
+ close_enough(x , ((a * b) + c));
+ x -= a;
+ close_enough(x , (((a * b) + c) - a));
+ x /= b;
+ close_enough(x , ((((a * b) + c) - a) / b));
+
+}
+
+main()
+{
+ double_complex one = 1.0;
+ double_complex i (0.0, 1.0);
+ double_complex neg_one = -1.0;
+
+ cout << "double_complex one = " << one << "\n";
+ cout << "i = " << i << "\n";
+ cout << "neg_one = " << neg_one << "\n";
+ cout << "sqrt(neg_one) = " << sqrt(neg_one) << "\n";
+
+ double_complex a (2.0, 3.0);
+ double_complex b (4.0, 5.0);
+
+ cout << "a = " << a << "\n";
+ cout << "b = " << b << "\n";
+
+ cout << "a + one = " << (a + one) << "\n";
+ (close_enough((a+one), double_complex(3.0, 3.0)));
+ cout << "a - one = " << (a - one) << "\n";
+ (close_enough((a-one), double_complex(1.0, 3.0)));
+ cout << "a * one = " << (a * one) << "\n";
+ (close_enough((a*one), a));
+ cout << "a / one = " << (a / one) << "\n";
+ (close_enough((a/one), a));
+
+ cout << "a + b = " << (a + b) << "\n";
+ (close_enough((a+b), double_complex(6.0, 8.0)));
+ cout << "a - b = " << (a - b) << "\n";
+ (close_enough((a-b), double_complex(-2.0, -2.0)));
+ cout << "a * b = " << (a * b) << "\n";
+ (close_enough((a*b), double_complex(-7.0, 22.0)));
+ cout << "a / b = " << (a / b) << "\n";
+ (close_enough((a/b), double_complex(0.5609760976, 0.0487804878)));
+
+ double_complex c;
+
+ c = a; cout << "c = a; c += b = " << (c += b) << "\n";
+ c = a; cout << "c = a; c -= b = " << (c -= b) << "\n";
+ c = a; cout << "c = a; c *= b = " << (c *= b) << "\n";
+ c = a; cout << "c = a; c /= b = " << (c /= b) << "\n";
+
+ cout << "-a = " << (-a) << "\n";
+ cout << "real(a) = " << real(a) << "\n";
+ assert(real(a) == 2.0);
+ cout << "imag(a) = " << imag(a) << "\n";
+ assert(imag(a) == 3.0);
+ cout << "conj(a) = " << conj(a) << "\n";
+ assert(conj(a) == double_complex(2.0, -3.0));
+ cout << "norm(a) = " << norm(a) << "\n";
+ assert(norm(a) == 13.0);
+
+ cout << "abs(a) = " << abs(a) << "\n";
+ cout << "arg(a) = " << arg(a) << "\n";
+ cout << "cos(a) = " << cos(a) << "\n";
+ cout << "sin(a) = " << sin(a) << "\n";
+ cout << "cosh(a) = " << cosh(a) << "\n";
+ cout << "sinh(a) = " << sinh(a) << "\n";
+ cout << "log(a) = " << log(a) << "\n";
+ cout << "exp(a) = " << exp(a) << "\n";
+ cout << "sqrt(a) = " << sqrt(a) << "\n";
+ cout << "pow(a, 2) = " << pow(a, 2) << "\n";
+ {
+ double_complex p = pow(a, b);
+ if(sizeof(float)==sizeof(double)) {
+ long w = (long)(p.imag()*100000);
+ if (w==-98642)
+ p=double_complex(-0.753046,-0.986429);
+ }
+ cout << "pow(a, b) = " << p << "\n";
+ }
+
+ double_complex d (10, 20);
+ double_complex e = pow(a, 2);
+
+ test3(one, one, one);
+ test3(a, a, a);
+ test3(a, b, d);
+ test3(e, i, b);
+ test3(d, d, i);
+
+ cout << "enter a complex number in form a or (a) or (a, b): ";
+ cin >> c;
+ cout << "number = " << c << "\n";
+
+ cout << "\nEnd of test\n";
+ return 0;
+}
diff --git a/libstdc++/tests/tcomplex.exp b/libstdc++/tests/tcomplex.exp
new file mode 100644
index 00000000000..5bef15cd376
--- /dev/null
+++ b/libstdc++/tests/tcomplex.exp
@@ -0,0 +1,37 @@
+double_complex one = (1,0)
+i = (0,1)
+neg_one = (-1,0)
+sqrt(neg_one) = (0,1)
+a = (2,3)
+b = (4,5)
+a + one = (3,3)
+a - one = (1,3)
+a * one = (2,3)
+a / one = (2,3)
+a + b = (6,8)
+a - b = (-2,-2)
+a * b = (-7,22)
+a / b = (0.560976,0.0487805)
+c = a; c += b = (6,8)
+c = a; c -= b = (-2,-2)
+c = a; c *= b = (-7,22)
+c = a; c /= b = (0.560976,0.0487805)
+-a = (-2,-3)
+real(a) = 2
+imag(a) = 3
+conj(a) = (2,-3)
+norm(a) = 13
+abs(a) = 3.60555
+arg(a) = 0.982794
+cos(a) = (-4.18963,-9.10923)
+sin(a) = (9.1545,-4.16891)
+cosh(a) = (-3.72455,0.511823)
+sinh(a) = (-3.59056,0.530921)
+log(a) = (1.28247,0.982794)
+exp(a) = (-7.31511,1.04274)
+sqrt(a) = (1.67415,0.895977)
+pow(a, 2) = (-5,12)
+pow(a, b) = (-0.753046,-0.986429)
+enter a complex number in form a or (a) or (a, b): number = (1.2,-34)
+
+End of test
diff --git a/libstdc++/tests/tcomplex.inp b/libstdc++/tests/tcomplex.inp
new file mode 100644
index 00000000000..c4e1d84660f
--- /dev/null
+++ b/libstdc++/tests/tcomplex.inp
@@ -0,0 +1 @@
+(1.2, -34)
diff --git a/libstdc++/tests/tlist.cc b/libstdc++/tests/tlist.cc
new file mode 100644
index 00000000000..8a8be91c05f
--- /dev/null
+++ b/libstdc++/tests/tlist.cc
@@ -0,0 +1,165 @@
+/*
+ test/demo of generic lists
+*/
+
+#include <assert.h>
+
+#define tassert(ex) {if ((ex)) cerr << #ex << "\n"; \
+ else _assert(#ex, __FILE__,__LINE__); }
+
+#include <iostream.h>
+#include "list.h"
+#include "algo.h"
+
+bool int_compare(int a, int b)
+{
+ return a < b;
+}
+
+int inc(int x)
+{
+ return x + 1;
+}
+
+void print(list<int>& l)
+{
+ for (list<int>::iterator it = l.begin(); it != l.end(); it++)
+ cout << *it << " ";
+ cout << "\n";
+}
+
+int is_odd(int x)
+{
+ return x & 1;
+}
+
+int is_even(int x)
+{
+ return (x & 1) == 0;
+}
+
+void sequence(list<int>& a, int lo, int hi)
+{
+ back_insert_iterator<list<int> > it(a);
+ while (lo <= hi)
+ *it++ = lo++;
+}
+
+int old_rand = 9999;
+
+int get_rand()
+{
+ old_rand = ((long)old_rand * (long)1243) % (long)971;
+ return old_rand;
+}
+
+void randseq(list<int>& a, int n)
+{
+ back_insert_iterator<list<int> > it(a);
+ while (--n >= 0)
+ *it++ = get_rand() % 50;
+}
+
+int array1 [] = { 9, 16, 36 };
+int array2 [] = { 1, 4 };
+
+int test_splice ()
+{
+ list<int> l1 (array1, array1 + 3);
+ list<int> l2 (array2, array2 + 2);
+ list<int>::iterator i1 = l1.begin ();
+ l1.splice (i1, l2);
+ list<int>::iterator i2 = l1.begin ();
+ while (i2 != l1.end ())
+ cout << *i2++ << endl;
+ return 0;
+}
+
+main()
+{
+ list<int> a; int i;
+ list<int>::iterator it, bit;
+ sequence(a, 1, 20);
+ cout << "\nlist<int> a = sequence(1, 20);\n"; print(a);
+ for (it = a.begin (), i = 0; it != a.end (); it++, i++)
+ assert (*it == i + 1);
+ list<int> b;
+ randseq(b, 20);
+ cout << "\nlist<int> b = randseq(20);\n"; print(b);
+ list<int> c;
+ c.insert (c.end(), a.begin(), a.end());
+ c.insert (c.end(), b.begin(), b.end());
+ cout << "\nlist<int> c = a and b;\n"; print(c);
+
+ list<int> d;
+ for (it = a.begin(); it != a.end(); it++)
+ d.insert(d.end (), inc(*it));
+ cout << "\nlist<int> d = map(inc, a);\n"; print(d);
+
+ list<int> e;
+ back_insert_iterator<list<int> > e_insertor (e);
+ reverse_copy (a.begin(), a.end (), e_insertor);
+ cout << "\nlist<int> e = reverse(a);\n"; print(e);
+
+ list<int> f;
+ for (it = a.begin(); it != a.end(); it++)
+ if (is_odd (*it))
+ f.insert(f.end (), *it);
+ cout << "\nlist<int> f = select(is_odd, a);\n"; print(f);
+ list<int> ff;
+ for (it = f.begin(); it != f.end(); it++)
+ if (is_even (*it))
+ ff.insert(ff.end (), *it);
+ assert(ff.empty());
+
+ int red = 0;
+ for (it = a.begin(); it != a.end(); it++)
+ red += *it;
+ cout << "\nint red = a.reduce(plus, 0);\n"; cout << red;
+ it = a.begin(); ++it; ++it;
+ int second = *it;
+ cout << "\nint second = a[2];\n"; cout << second;
+ list<int> g;
+ for (it = a.begin(), bit = b.begin(); it != a.end () && bit != b.end (); )
+ g.insert (g.end (), *it++ + *bit++);
+ cout << "\nlist<int> g = combine(plus, a, b);\n"; print(g);
+#if 1
+ for (it = g.begin(); it != g.end(); )
+ {
+ bit = it++;
+ if (is_odd (*bit))
+ g.erase (bit);
+ }
+#else
+ g.remove_if (is_odd);
+#endif
+ cout << "\ng.del(is_odd);\n"; print(g);
+
+ ff.erase (ff.begin (), ff.end());
+ for (it = g.begin(); it != g.end(); it++)
+ if (is_odd (*it))
+ ff.insert (ff.end (), *it);
+ assert(ff.empty());
+
+ b.sort();
+ for (it = b.begin(); bit = it++, it != b.end (); ) assert (*it >= *bit);
+ cout << "\nb.sort(int_compare);\n"; print(b);
+
+ list<int> h;
+ back_insert_iterator<list<int> > h_insertor (h);
+ merge (a.begin (), a.end (), b.begin (), b.end (), h_insertor, int_compare);
+ cout << "\nlist<int> h = merge(a, b, int_compare);\n"; print(h);
+ for (it = h.begin(); bit = it++, it != h.end (); ) assert (*it >= *bit);
+
+ cout << "\nh via iterator:\n";
+ for (it = h.begin(); it != h.end (); it++)
+ cout << *it << ", ";
+ cout << "\n";
+
+ test_splice ();
+
+ cout << "\ndone\n";
+}
+
+template class __malloc_alloc_template<0>;
+template class __default_alloc_template<false, 0>;
diff --git a/libstdc++/tests/tlist.exp b/libstdc++/tests/tlist.exp
new file mode 100644
index 00000000000..65f7806826f
--- /dev/null
+++ b/libstdc++/tests/tlist.exp
@@ -0,0 +1,44 @@
+
+list<int> a = sequence(1, 20);
+1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+
+list<int> b = randseq(20);
+28 27 5 17 44 6 9 40 15 26 49 35 15 48 13 27 25 25 9 6
+
+list<int> c = a and b;
+1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 28 27 5 17 44 6 9 40 15 26 49 35 15 48 13 27 25 25 9 6
+
+list<int> d = map(inc, a);
+2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
+
+list<int> e = reverse(a);
+20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
+
+list<int> f = select(is_odd, a);
+1 3 5 7 9 11 13 15 17 19
+
+int red = a.reduce(plus, 0);
+210
+int second = a[2];
+3
+list<int> g = combine(plus, a, b);
+29 29 8 21 49 12 16 48 24 36 60 47 28 62 28 43 42 43 28 26
+
+g.del(is_odd);
+8 12 16 48 24 36 60 28 62 28 42 28 26
+
+b.sort(int_compare);
+5 6 6 9 9 13 15 15 17 25 25 26 27 27 28 35 40 44 48 49
+
+list<int> h = merge(a, b, int_compare);
+1 2 3 4 5 5 6 6 6 7 8 9 9 9 10 11 12 13 13 14 15 15 15 16 17 17 18 19 20 25 25 26 27 27 28 35 40 44 48 49
+
+h via iterator:
+1, 2, 3, 4, 5, 5, 6, 6, 6, 7, 8, 9, 9, 9, 10, 11, 12, 13, 13, 14, 15, 15, 15, 16, 17, 17, 18, 19, 20, 25, 25, 26, 27, 27, 28, 35, 40, 44, 48, 49,
+1
+4
+9
+16
+36
+
+done
diff --git a/libstdc++/tests/tmap.cc b/libstdc++/tests/tmap.cc
new file mode 100644
index 00000000000..2c164c932a9
--- /dev/null
+++ b/libstdc++/tests/tmap.cc
@@ -0,0 +1,69 @@
+#include <map.h>
+#include <algo.h>
+#include <iostream.h>
+#include <function.h>
+
+int SIZE;
+
+#if 0
+/* Crashes compiler */
+#define int_less less<int>
+#else
+struct int_less {
+ bool operator() (int x, int y) const { return x < y; }
+};
+struct str_less {
+ bool operator() (char* x, char* y) const { return strcmp(x,y) < 0; }
+};
+#endif
+
+#if 0
+void add(int x[], int y[], map<int,int, int_less>& a)
+{
+ for (int i = 0; i < SIZE; ++i) a[x[i]] = y[i];
+}
+#endif
+
+int
+main(int argv, char** argc)
+{
+#if 0
+ if (argv > 1)
+ {
+ SIZE = abs(atoi(argc[1]));
+ SIZE &= ~1;
+ }
+ else
+ SIZE = 100;
+ nums = new int[SIZE];
+ odds = new int[SIZE];
+ perm = new int[SIZE];
+#endif
+
+ map<int, int, int_less> my_map;
+
+ map<char*, int, str_less> phones;
+
+ my_map[4] = 40;
+ my_map[2] = 20;
+
+ // The (char*) is needed because g++ doesn't
+ // convert char[] to char* in this context.
+ phones[(char*)"tom"] = 2345;
+ phones[(char*)"dick"] = 5678;
+ phones[(char*)"harry"] = 7654;
+
+ cout << "2 -> " << my_map[2] << endl;
+ cout << "4 -> " << my_map[4] << endl;
+
+ map<int, int, int_less>::iterator it = my_map.begin();
+ for ( ; it != my_map.end(); it++)
+ cout << "my_map[" << (*it).first << "] = " << (*it).second << endl;
+
+ map<char*, int, str_less>::iterator pit = phones.begin();
+ for ( ; pit != phones.end(); pit++)
+ cout << "phones[" << (*pit).first << "] = " << (*pit).second << endl;
+}
+
+template class __malloc_alloc_template<0>;
+template class __default_alloc_template<false, 0>;
diff --git a/libstdc++/tests/tmap.exp b/libstdc++/tests/tmap.exp
new file mode 100644
index 00000000000..b7b5df249fb
--- /dev/null
+++ b/libstdc++/tests/tmap.exp
@@ -0,0 +1,7 @@
+2 -> 20
+4 -> 40
+my_map[2] = 20
+my_map[4] = 40
+phones[dick] = 5678
+phones[harry] = 7654
+phones[tom] = 2345
diff --git a/libstdc++/tests/tstring.cc b/libstdc++/tests/tstring.cc
new file mode 100644
index 00000000000..d4f65c55b6e
--- /dev/null
+++ b/libstdc++/tests/tstring.cc
@@ -0,0 +1,189 @@
+// Tests for the -*- C++ -*- string classes.
+// Copyright (C) 1994 Free Software Foundation
+
+// This file is part of the GNU ANSI C++ 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.
+
+// 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 General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this library; see the file COPYING. If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#include <string>
+#include <iostream.h>
+#include <stdlib.h>
+#include <assert.h>
+
+string X = "Hello";
+string Y = "world";
+string N = "123";
+string c;
+const char* s = ",";
+
+void decltest()
+{
+ string x;
+ cout << "an empty string:" << x << "\n";
+ assert(x == "");
+
+ string y = "Hello";
+ cout << "A string initialized to Hello:" << y << "\n";
+ assert(y == "Hello");
+
+ if (y[y.length()-1] == 'o')
+ y = y + '\n';
+ assert(y == "Hello\n");
+ y = "Hello";
+
+ string a = y;
+ cout << "A string initialized to previous string:" << a << "\n";
+ assert(a == "Hello");
+ assert(a == y);
+
+ string b (a, 1, 2);
+ cout << "A string initialized to (previous string, 1, 2):" << b << "\n";
+ assert(b == "el");
+
+ char ch = '@';
+ string z (1, ch);
+ cout << "A string initialized to @:" << z << "\n";
+ assert (z == "@");
+
+ string n ("20");
+ cout << "A string initialized to 20:" << n << "\n";
+ assert(n == "20");
+
+ int i = atoi(n.c_str ());
+ double f = atof(n.c_str ());
+ cout << "n = " << n << " atoi(n) = " << i << " atof(n) = " << f << "\n";
+ assert(i == 20);
+ assert(f == 20);
+
+}
+
+void cattest()
+{
+ string x = X;
+ string y = Y;
+ string z = x + y;
+ cout << "z = x + y = " << z << "\n";
+ assert(z == "Helloworld");
+
+ x += y;
+ cout << "x += y; x = " << x << "\n";
+ assert(x == "Helloworld");
+
+ y = Y;
+ x = X;
+ y.insert (0, x);
+ cout << "y.insert (0, x); y = " << y << "\n";
+ assert(y == "Helloworld");
+
+ y = Y;
+ x = X;
+ x = x + y + x;
+ cout << "x = x + y + x; x = " << x << "\n";
+ assert(x == "HelloworldHello");
+
+ y = Y;
+ x = X;
+ x = y + x + x;
+ cout << "x = y + x + x; x = " << x << "\n";
+ assert(x == "worldHelloHello");
+
+ x = X;
+ y = Y;
+ z = x + s + ' ' + y.substr (y.find ('w'), 1) + y.substr (y.find ('w') + 1) + ".";
+ cout << "z = x + s + + y.substr (y.find (w), 1) + y.substr (y.find (w) + 1) + . = " << z << "\n";
+ assert(z == "Hello, world.");
+}
+
+void comparetest()
+{
+ string x = X;
+ string y = Y;
+ string n = N;
+ string z = x + y;
+
+ assert(x != y);
+ assert(x == "Hello");
+ assert(x != z.substr (0, 4));
+ assert(x.compare (y) < 0);
+ assert(x.compare (z.substr (0, 6)) < 0);
+
+ assert(x.find ("lo") == 3);
+ assert(x.find ("l", 2) == 2);
+ assert(x.rfind ("l") == 3);
+}
+
+void substrtest()
+{
+ string x = X;
+
+ char ch = x[0];
+ cout << "ch = x[0] = " << ch << "\n";
+ assert(ch == 'H');
+
+ string z = x.substr (2, 3);
+ cout << "z = x.substr (2, 3) = " << z << "\n";
+ assert(z == "llo");
+
+ x.replace (2, 2, "r");
+ cout << "x.replace (2, 2, r); x = " << x << "\n";
+ assert(x == "Hero");
+
+ x = X;
+ x.replace (0, 1, 'j');
+ cout << "x.replace (0, 1, 'j'); x = " << x << "\n";
+ assert(x == "jello");
+}
+
+void iotest()
+{
+ string z;
+ cout << "enter a word:";
+ cin >> z;
+ cout << "word =" << z << " ";
+ cout << "length = " << z.length() << "\n";
+}
+
+void identitytest(string a, string b)
+{
+ string x = a;
+ string y = b;
+ x += b;
+ y.insert (0, a);
+ assert((a + b) == x);
+ assert((a + b) == y);
+ assert(x == y);
+
+ assert((a + b + a) == (a + (b + a)));
+
+ x.remove (x.rfind (b));
+ assert(x == a);
+
+ y.replace (0, y.rfind (b), b);
+ assert(y == (b + b));
+ y.replace (y.find (b), b.length (), a);
+ assert(y == (a + b));
+}
+
+int main()
+{
+ decltest();
+ cattest();
+ comparetest();
+ substrtest();
+ identitytest(X, X);
+ identitytest(X, Y);
+ identitytest(X+Y+N+X+Y+N, "A string that will be used in identitytest but is otherwise just another useless string.");
+ iotest();
+ cout << "\nEnd of test\n";
+ return 0;
+}
diff --git a/libstdc++/tests/tstring.exp b/libstdc++/tests/tstring.exp
new file mode 100644
index 00000000000..3333ab1231d
--- /dev/null
+++ b/libstdc++/tests/tstring.exp
@@ -0,0 +1,20 @@
+an empty string:
+A string initialized to Hello:Hello
+A string initialized to previous string:Hello
+A string initialized to (previous string, 1, 2):el
+A string initialized to @:@
+A string initialized to 20:20
+n = 20 atoi(n) = 20 atof(n) = 20
+z = x + y = Helloworld
+x += y; x = Helloworld
+y.insert (0, x); y = Helloworld
+x = x + y + x; x = HelloworldHello
+x = y + x + x; x = worldHelloHello
+z = x + s + + y.substr (y.find (w), 1) + y.substr (y.find (w) + 1) + . = Hello, world.
+ch = x[0] = H
+z = x.substr (2, 3) = llo
+x.replace (2, 2, r); x = Hero
+x.replace (0, 1, 'j'); x = jello
+enter a word:word =abcdefghijklmnopqrstuvwxyz length = 26
+
+End of test
diff --git a/libstdc++/tests/tstring.inp b/libstdc++/tests/tstring.inp
new file mode 100644
index 00000000000..b0883f382e1
--- /dev/null
+++ b/libstdc++/tests/tstring.inp
@@ -0,0 +1 @@
+abcdefghijklmnopqrstuvwxyz
diff --git a/libstdc++/tests/tvector.cc b/libstdc++/tests/tvector.cc
new file mode 100644
index 00000000000..8b5f8091cf6
--- /dev/null
+++ b/libstdc++/tests/tvector.cc
@@ -0,0 +1,23 @@
+#include <vector.h>
+#include <iostream.h>
+#include <algo.h>
+
+main ()
+{
+ cout << "Fill of C array:\n";
+ char x[50];
+ fill (x, x+50, '/');
+ fill (x+1, x+49, '*');
+ copy (x, x+50, ostream_iterator<char>(cout));
+
+ cout << "\nFill of vector<char>:\n";
+
+ vector<char> cvec;
+ cvec.insert (cvec.begin(), 50, '/');
+ fill (cvec.begin()+1, cvec.end()-1, '-');
+ copy (cvec.begin(), cvec.end(), ostream_iterator<char>(cout));
+ cout << endl;
+}
+
+template class __malloc_alloc_template<0>;
+template class __default_alloc_template<false, 0>;
diff --git a/libstdc++/tests/tvector.exp b/libstdc++/tests/tvector.exp
new file mode 100644
index 00000000000..84a9d1bf3a4
--- /dev/null
+++ b/libstdc++/tests/tvector.exp
@@ -0,0 +1,4 @@
+Fill of C array:
+/************************************************/
+Fill of vector<char>:
+/------------------------------------------------/
diff --git a/libstdc++/testsuite/ChangeLog b/libstdc++/testsuite/ChangeLog
new file mode 100644
index 00000000000..b49367e9d4c
--- /dev/null
+++ b/libstdc++/testsuite/ChangeLog
@@ -0,0 +1,54 @@
+Wed Aug 6 18:43:23 1997 Jason Merrill <jason@yorick.cygnus.com>
+
+ * lib/libstdc++.exp: Remove libio_link_flags.
+
+Thu Jul 17 14:54:58 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * lib/libstdc++.exp (base_dir): Move from here...
+ (test_libstdc++): To here.
+ (LIBSTDCPP): Delete unused global decl.
+
+Tue Jun 17 01:46:49 1997 Bob Manson <manson@farmer>
+
+ * lib/libstdc++.exp: Strip off leading LFs from both the pattern
+ being matched against and the output from the board. Find the
+ correct multilib libstdc++ to link with. Use g++_link_flags
+ and libio_link_flags. Link in the status wrapper if needed.
+ (libstdc++_init): New procedure.
+
+Tue Jun 3 17:16:39 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * lib/libstdc++.exp: Don't use global exec_output variable; the
+ output is returned from remote_load instead.
+
+Tue Apr 29 17:20:05 1997 Mike Stump <mrs@cygnus.com>
+
+ * lib/libstdc++.exp: Fixup so that $compile_args works better.
+ * libstdc++.tests/test.exp: Also run with -O.
+
+Tue Apr 29 16:34:37 1997 Mike Stump <mrs@cygnus.com>
+
+ * testsuite/lib/libstdc++.exp: Fixup so that we always have the
+ same number of testcases, and so that we have meaningful testcase
+ names.
+
+Tue Apr 29 13:05:14 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * lib/libstdc++.exp: Add support for --tool_opts.
+
+Mon Apr 28 11:10:25 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * Makefile.in: Add comment so target Makefile fragments get added.
+ Removed clean rule, because it is added by configure.
+
+ * configure.in (TESTS): Add.
+
+Sun Apr 27 15:03:10 1997 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * Makefile.in (clean): Add empty rule for now.
+
+Fri Apr 25 18:59:14 1997 Bob Manson <manson@charmed.cygnus.com>
+
+ * lib/libstdc++.exp(test_libstdc++): Return on error. Generate a
+ FAIL if the compile fails. Remove CRs from the output from the
+ testcase.
diff --git a/libstdc++/testsuite/Makefile.in b/libstdc++/testsuite/Makefile.in
new file mode 100644
index 00000000000..9ead33e22fc
--- /dev/null
+++ b/libstdc++/testsuite/Makefile.in
@@ -0,0 +1,66 @@
+# Copyright (C) 1997 Free Software Foundation
+#
+# This file is part of the GNU IO 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.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU CC; see the file COPYING. If not, write to
+# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+srcdir = libstdc++.tests
+
+EXPECT = `if [ -f $${rootme}/../../expect/expect ] ; then \
+ echo $${rootme}/../../expect/expect ; \
+ else echo expect ; fi`
+
+RUNTEST = `if [ -f $${srcdir}/../../dejagnu/runtest ] ; then \
+ echo $${srcdir}/../../dejagnu/runtest ; \
+ else echo runtest; fi`
+RUNTESTFLAGS =
+
+#### package, host, target, and site dependent Makefile fragments come in here.
+##
+
+.PHONY: all
+all:
+
+.PHONY: check
+check: site.exp all just-check
+
+site.exp: ./config.status Makefile
+ @echo "Making a new config file..."
+ -@rm -f ./tmp?
+ @touch site.exp
+ -@mv site.exp site.bak
+ @echo "## these variables are automatically generated by make ##" > ./tmp0
+ @echo "# Do not edit here. If you wish to override these values" >> ./tmp0
+ @echo "# add them to the last section" >> ./tmp0
+ @echo "set host_alias $(host_alias)" >> ./tmp0
+ @echo "set host_triplet ${host_canonical}" >> ./tmp0
+ @echo "set target_alias $(target_alias)" >> ./tmp0
+ @echo "set target_triplet ${target_canonical}" >> ./tmp0
+ @echo "set build_triplet ${build_canonical}" >> ./tmp0
+ @echo "set srcdir ${srcdir}" >> ./tmp0
+ @echo "set tool libstdc++" >> ./tmp0
+ @echo "## All variables above are generated by configure. Do Not Edit ##" >> ./tmp0
+ @cat ./tmp0 > site.exp
+ @cat site.bak | sed \
+ -e '1,/^## All variables above are.*##/ d' >> site.exp
+ -@rm -f ./tmp?
+
+just-check:
+ rootme=`pwd`; export rootme; \
+ srcdir=${srcdir} ; export srcdir ; \
+ EXPECT=${EXPECT} ; export EXPECT ; \
+ if [ -f $${rootme}/../../expect/expect ] ; then \
+ TCL_LIBRARY=$${srcdir}/../../tcl/library ; \
+ export TCL_LIBRARY ; fi ; \
+ $(RUNTEST) $(RUNTESTFLAGS)
diff --git a/libstdc++/testsuite/config/default.exp b/libstdc++/testsuite/config/default.exp
new file mode 100644
index 00000000000..90967cccc18
--- /dev/null
+++ b/libstdc++/testsuite/config/default.exp
@@ -0,0 +1 @@
+load_lib "standard.exp"
diff --git a/libstdc++/testsuite/configure.in b/libstdc++/testsuite/configure.in
new file mode 100644
index 00000000000..21a6c8c59b6
--- /dev/null
+++ b/libstdc++/testsuite/configure.in
@@ -0,0 +1,23 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../../configure.
+
+configdirs=
+srctrigger=configure.in
+srcname="tests for ANSI C++ library, dejagnu style"
+package_makefile_frag=Make.pack
+
+# per-host:
+
+# per-target:
+
+target_makefile_frag=../target-mkfrag
+
+TO_TOPDIR=../../
+ALL=' '
+XCXXINCLUDES="-I${srcdir}/.. -I${srcdir}/../stl -I${TO_TOPDIR}libio -I${srcdir}/${TO_TOPDIR}libio"
+TESTS="tcomplex tstring tlist tmap tvector"
+MOSTLYCLEAN="*.o core ${TESTS} *.out"
+(. ${srcdir}/${TO_TOPDIR}libio/config.shared) >${package_makefile_frag}
+
+# post-target:
diff --git a/libstdc++/testsuite/lib/libstdc++.exp b/libstdc++/testsuite/lib/libstdc++.exp
new file mode 100644
index 00000000000..588f72a3a94
--- /dev/null
+++ b/libstdc++/testsuite/lib/libstdc++.exp
@@ -0,0 +1,165 @@
+# Copyright (C) 1997 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-lib-g++@prep.ai.mit.edu
+
+# This file was written by Bob Manson. (manson@cygnus.com)
+
+load_lib "libgloss.exp"
+
+global tmpdir
+
+if ![info exists tmpdir] {
+ set tmpdir "/tmp"
+}
+
+#
+# Build the status wrapper library as needed.
+#
+proc libstdc++_init { args } {
+ global wrapper_file;
+ global wrap_compile_flags;
+ set wrapper_file "";
+ set wrap_compile_flags "";
+ if [target_info exists needs_status_wrapper] {
+ set result [build_wrapper "testglue.o"];
+ if { $result != "" } {
+ set wrapper_file [lindex $result 0];
+ set wrap_compile_flags [lindex $result 1];
+ } else {
+ warning "Status wrapper failed to build."
+ }
+ }
+}
+#
+# Run the test specified by srcfile and resultfile. compile_args and
+# exec_args are additional arguments to be passed in when compiling and
+# running the testcase, respectively.
+#
+
+proc test_libstdc++ { options srcfile compile_args inpfile resultfile exec_args } {
+ global base_dir
+ global LIBSTDCPP
+ global srcdir subdir objdir
+ global TOOL_OPTIONS
+
+ if [info exists LIBSTDCPP] {
+ set libstdcpp $LIBSTDCPP;
+ } else {
+ set gp [get_multilibs];
+ if { $gp != "" } {
+ if [file exists "$gp/libstdc++/libstdc++.a"] {
+ set libstdcpp "-L$gp/libstdc++ -lstdc++";
+ }
+ }
+ if ![info exists libstdcpp] {
+ set libstdcpp [findfile $base_dir/../../libstdc++/libstdc++.a "-L$base_dir/../../libstdc++ -lstdc++" -lstdc++]
+ }
+ }
+
+ verbose "using LIBSTDCPP = $libstdcpp" 2
+ set args ""
+ if { $compile_args != "" } {
+ lappend args "additional_flags=$compile_args"
+ }
+ lappend args "incdir=.."
+ lappend args "incdir=$srcdir/.."
+ lappend args "incdir=$srcdir/../stl"
+ lappend args "incdir=."
+ if [info exists TOOL_OPTIONS] {
+ lappend args "additional_flags=$TOOL_OPTIONS"
+ }
+
+ global wrapper_file wrap_compile_flags;
+ # We have to include libio, for _G_config.h.
+ lappend args "additional_flags=$wrap_compile_flags";
+ lappend args "libs=$wrapper_file";
+ lappend args "libs=$libstdcpp";
+ lappend args "additional_flags=[libio_include_flags]"
+ lappend args "additional_flags=[g++_link_flags]"
+ lappend args debug
+
+ regsub "^.*/(\[^/.\]+)\[.\]\[^/]*$" "$srcfile" "\\1" out
+ set executable "${objdir}/$out"
+ set errname "[file tail $srcfile]"
+ if { $compile_args != "" } {
+ set errname "$errname $compile_args"
+ }
+
+ if { [target_compile $srcfile "$executable" executable $args] != "" } {
+ fail "$errname compilation"
+ setup_xfail "*-*-*"
+ fail "$errname execution"
+ setup_xfail "*-*-*"
+ fail "$errname output"
+ return;
+ }
+ pass "$errname compilation"
+
+ set result [libstdc++_load $executable "$exec_args" "$inpfile"];
+ set status [lindex $result 0];
+ set output [lindex $result 1];
+ $status "$errname execution"
+ if { $status != "pass" } {
+ setup_xfail "*-*-*"
+ fail "$errname output"
+ return;
+ }
+
+ verbose "resultfile is $resultfile"
+ set id [open $resultfile r];
+ set expected ""
+ append expected [read $id];
+ regsub -all "\r" "$output" "" output;
+ regsub "\n*$" $expected "" expected
+ regsub "\n*$" $output "" output
+ regsub "^\n*" $expected "" expected
+ regsub "^\n*" $output "" output
+ regsub -all "\[ \t\]\[ \t\]*" $expected " " expected
+ regsub -all "\[ \t\]*\n\n*" $expected "\n" expected
+ regsub -all "\[ \t\]\[ \t\]*" $output " " output
+ regsub -all "\[ \t\]*\n\n*" $output "\n" output
+ verbose "expected is $expected"
+ verbose "actual is $output"
+ set passed 0;
+ if {$options == "regexp_match"} {
+ if [regexp $expected $output] {
+ set passed 1;
+ }
+ } else {
+ if { $expected == $output } {
+ set passed 1;
+ }
+ }
+ if { $passed == 1 } {
+ pass "$errname output"
+ } else {
+ clone_output "expected was $expected"
+ clone_output "output was $output"
+ fail "$errname output"
+ }
+ close $id;
+}
+
+#
+# libstdc++_version -- extract and print the version number of libstdc++p
+#
+proc default_libstdc++_version {} {
+}
+
+proc default_libstdc++_start { } {
+}
diff --git a/libstdc++/testsuite/libstdc++.tests/test.exp b/libstdc++/testsuite/libstdc++.tests/test.exp
new file mode 100644
index 00000000000..7368cfb282e
--- /dev/null
+++ b/libstdc++/testsuite/libstdc++.tests/test.exp
@@ -0,0 +1,34 @@
+global srcdir subdir
+
+catch "glob -nocomplain $srcdir/$subdir/../../tests/*.exp" srcfiles
+verbose "srcfiles are $srcfiles"
+
+set prefix ""
+foreach x $srcfiles {
+ regsub "\\.exp$" $x "" prefix
+ set bname [file tail $prefix]
+ set args ""
+ if [file exists $srcdir/$subdir/${bname}.arg] {
+ set id [open "$srcdir/$subdir/${bname}.arg" r];
+ set args [read -nonewline $id];
+ close $id;
+ }
+ if [file exists $srcdir/$subdir/${bname}.xpo] {
+ set resfile "$srcdir/$subdir/${bname}.xpo"
+ set options "regexp_match"
+ } else {
+ set resfile "${prefix}.exp"
+ set options ""
+ }
+
+ if [file exists ${prefix}.inp] {
+ set inpfile ${prefix}.inp
+ } else {
+ set inpfile ""
+ }
+
+ verbose "inpfile is $inpfile"
+
+ test_libstdc++ $options "${prefix}.cc" "" $inpfile $resfile $args
+ test_libstdc++ $options "${prefix}.cc" "-O" $inpfile $resfile $args
+}
diff --git a/libstdc++/utility b/libstdc++/utility
new file mode 100644
index 00000000000..fb79aa78274
--- /dev/null
+++ b/libstdc++/utility
@@ -0,0 +1,8 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __UTILITY__
+#define __UTILITY__
+#include <function.h>
+#include <pair.h>
+#endif
diff --git a/libstdc++/vector b/libstdc++/vector
new file mode 100644
index 00000000000..79f73593751
--- /dev/null
+++ b/libstdc++/vector
@@ -0,0 +1,7 @@
+// -*- C++ -*- forwarding header.
+// This file is part of the GNU ANSI C++ Library.
+
+#ifndef __VECTOR__
+#define __VECTOR__
+#include <vector.h>
+#endif
diff --git a/ltconfig b/ltconfig
new file mode 100755
index 00000000000..7bba4e6b37f
--- /dev/null
+++ b/ltconfig
@@ -0,0 +1,1064 @@
+#! /bin/sh
+
+# ltconfig - Create a system-specific libtool.
+# When updating this script, search for LINENUM and fix line number refs.
+# Generated automatically from ltconfig.in by configure.
+# Copyright (C) 1996, 1997, Free Software Foundation, Inc.
+# Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
+#
+# This file 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# A lot of this script is taken from autoconf-2.10.
+
+# The name of this program.
+progname=`echo "$0" | sed 's%^.*/%%'`
+
+# Constants:
+PROGRAM=ltconfig
+PACKAGE=libtool
+VERSION=1.0
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.c 1>&5'
+rm="rm -f"
+
+help="Try \`$progname --help' for more information."
+
+# Global variables:
+can_build_shared=yes
+enable_shared=yes
+# All known linkers require a `.a' archive for static linking.
+enable_static=yes
+ltmain=
+silent=
+srcdir=
+ac_config_guess=
+ac_config_sub=
+host=
+nonopt=
+verify_host=yes
+with_gcc=no
+with_gnu_ld=no
+
+old_AR="$AR"
+old_CC="$CC"
+old_CFLAGS="$CFLAGS"
+old_CPPFLAGS="$CPPFLAGS"
+old_LD="$LD"
+old_LN_S="$LN_S"
+old_RANLIB="$RANLIB"
+
+test -z "$AR" && AR=ar
+
+# Parse the command line options.
+args=
+prev=
+for option
+do
+ case "$option" in
+ -*=*) optarg=`echo "$option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) optarg= ;;
+ esac
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$prev"; then
+ eval "$prev=\$option"
+ prev=
+ continue
+ fi
+
+ case "$option" in
+ --help) cat <<EOM
+Usage: $progname [OPTION]... LTMAIN [HOST]
+
+Generate a system-specific libtool script.
+
+ --disable-shared do not build shared libraries
+ --disable-static do not build static libraries
+ --help display this help and exit
+ --no-verify do not verify that HOST is a valid host type
+ --quiet same as \`--silent'
+ --silent don't print informational messages
+ --srcdir=DIR find \`config.guess' in DIR
+ --version output version information and exit
+ --with-gcc assume that the GNU C compiler will be used
+ --with-gnu-ld assume that the C compiler uses the GNU linker
+
+LTMAIN is the \`ltmain.sh' shell script fragment that provides basic libtool
+functionality.
+
+HOST is the canonical host system name [default=guessed].
+EOM
+ exit 0
+ ;;
+
+ --disable-shared) enable_shared=no ;;
+
+ --disable-static) enable_static=no ;;
+
+ --quiet | --silent) silent=yes ;;
+
+ --srcdir) prev=srcdir ;;
+ --srcdir=*) srcdir="$optarg" ;;
+
+ --no-verify) verify_host=no ;;
+
+ --version) echo "$PROGRAM (GNU $PACKAGE) $VERSION"; exit 0 ;;
+
+ --with-gcc) with_gcc=yes ;;
+ --with-gnu-ld) with_gnu_ld=yes ;;
+
+ -*)
+ echo "$progname: unrecognized option \`$option'" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ ;;
+
+ *)
+ if test -z "$ltmain"; then
+ ltmain="$option"
+ elif test -z "$host"; then
+# FIXME This generates an unnecessary warning for sparc-sun-solaris4.1.3_U1
+# if test -n "`echo $option| sed 's/[-a-z0-9.]//g'`"; then
+# echo "$progname: warning \`$option' is not a valid host type" 1>&2
+# fi
+ host="$option"
+ else
+ echo "$progname: too many arguments" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi ;;
+ esac
+done
+
+if test -z "$ltmain"; then
+ echo "$progname: you must specify a LTMAIN file" 1>&2
+ echo "$help" 1>&2
+ exit 1
+fi
+
+if test -f "$ltmain"; then :
+else
+ echo "$progname: warning: \`$ltmain' does not exist" 1>&2
+fi
+
+# Quote any args containing shell metacharacters.
+ltconfig_args=
+for arg
+do
+ case "$arg" in
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ltconfig_args="$ltconfig_args '$arg'" ;;
+ *) ltconfig_args="$ltconfig_args $arg" ;;
+ esac
+done
+
+# A relevant subset of AC_INIT.
+
+# 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
+# 5 compiler messages saved in config.log
+# 6 checking for... messages and results
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>>./config.log
+
+# NLS nuisances.
+# Only set LANG and LC_ALL to C if already set.
+# These must not be set unconditionally because not all systems understand
+# e.g. LANG=C (notably SCO).
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+
+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
+
+if test -z "$srcdir"; then
+ # Assume the source directory is the same one as the path to ltmain.sh.
+ srcdir=`echo "$ltmain" | sed 's%/[^/]*$%%'`
+ test "$srcdir" = "$ltmain" && srcdir=.
+fi
+
+if test "$verify_host" = yes; then
+ # Check for config.guess and config.sub.
+ ac_aux_dir=
+ for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/config.guess; then
+ ac_aux_dir=$ac_dir
+ break
+ fi
+ done
+ if test -z "$ac_aux_dir"; then
+ echo "$progname: cannot find config.guess in $srcdir $srcdir/.. $srcdir/../.." 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+ ac_config_guess=$ac_aux_dir/config.guess
+ ac_config_sub=$ac_aux_dir/config.sub
+
+ # Make sure we can run config.sub.
+ if $ac_config_sub sun4 >/dev/null 2>&1; then :
+ else
+ echo "$progname: cannot run $ac_config_sub" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ echo $ac_n "checking host system type""... $ac_c" 1>&6
+
+ host_alias=$host
+ case "$host_alias" in
+ "")
+ if host_alias=`$ac_config_guess`; then :
+ else
+ echo "$progname: cannot guess host type; you must specify one" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi ;;
+ esac
+ host=`$ac_config_sub $host_alias`
+ echo "$ac_t""$host" 1>&6
+
+elif test -z "$host"; then
+ echo "$progname: you must specify a host type if you use \`--no-verify'" 1>&2
+ echo "$help" 1>&2
+ exit 1
+else
+ host_alias=$host
+fi
+
+# Transform *-*-linux* to *-*-linux-gnu*, to support old configure scripts.
+case "$host" in
+*-*-linux-gnu*) ;;
+*-*-linux*) host=`echo $host | sed 's/^\(.*-.*-linux\)\(.*\)$/\1-gnu\2/'`
+esac
+
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+
+# Determine commands to create old-style static archives.
+old_archive_cmds='$AR cru $oldlib$oldobjs'
+old_postinstall_cmds='chmod 644 $oldlib'
+
+# If RANLIB is not set, then run the test.
+if test "${RANLIB+set}" != "set"; then
+ result=no
+
+ echo $ac_n "checking for ranlib... $ac_c" 1>&6
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/ranlib; then
+ RANLIB="ranlib"
+ result="ranlib"
+ break
+ fi
+ done
+ IFS="$save_ifs"
+
+ echo $ac_t "$result" 1>&6
+fi
+
+if test -n "$RANLIB"; then
+ old_archive_cmds="$old_archive_cmds;\$RANLIB \$oldlib"
+ old_postinstall_cmds="$old_postinstall_cmds;\$RANLIB \$oldlib"
+fi
+
+# Check to see if we are using GCC.
+if test "$with_gcc" != yes || test -z "$CC"; then
+ # If CC is not set, then try to find GCC or a usable CC.
+ if test -z "$CC"; then
+ echo $ac_n "checking for gcc... $ac_c" 1>&6
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ for dir in $PATH; do
+ IFS="$save_ifs"
+ test -z "$dir" && dir=.
+ if test -f $dir/gcc; then
+ CC="gcc"
+ break
+ fi
+ done
+ IFS="$save_ifs"
+
+ if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+ fi
+
+ # Not "gcc", so try "cc", rejecting "/usr/ucb/cc".
+ if test -z "$CC"; then
+ echo $ac_n "checking for cc... $ac_c" 1>&6
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:"
+ cc_rejected=no
+ for dir in $PATH; do
+ test -z "$dir" && dir=.
+ if test -f $dir/cc; then
+ if test "$dir/cc" = "/usr/ucb/cc"; then
+ cc_rejected=yes
+ continue
+ fi
+ CC="cc"
+ break
+ fi
+ done
+ IFS="$save_ifs"
+ if test $cc_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same name, so the bogon will be chosen
+ # first if we set CC to just the name; use the full file name.
+ shift
+ set dummy "$dir/cc" "$@"
+ shift
+ CC="$@"
+ fi
+ fi
+
+ if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+
+ if test -z "$CC"; then
+ echo "$progname: error: no acceptable cc found in \$PATH" 1>&2
+ exit 1
+ fi
+ fi
+
+ # Now see if the compiler is really GCC.
+ with_gcc=no
+ echo $ac_n "checking whether we are using GNU C... $ac_c" 1>&6
+
+ trap "$rm conftest.c; exit 1" 1 2 15
+ $rm conftest.c
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+ # LINENUM
+ if { ac_try='${CC-cc} -E conftest.c'; { (eval echo $progname:378: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ with_gcc=yes
+ fi
+ $rm conftest.c
+ echo $ac_t "$with_gcc" 1>&6
+fi
+
+# Allow CC to be a program name with arguments.
+set dummy $CC
+compiler="$2"
+
+echo $ac_n "checking for $compiler option to produce PIC... $ac_c" 1>&6
+pic_flag=
+profile_flag_pattern=
+special_shlib_compile_flags=
+wl=
+link_static_flag=
+
+if test "$with_gcc" = yes; then
+ pic_flag='-fPIC'
+ profile_flag_pattern='-pg?'
+ wl='-Wl,'
+ link_static_flag='-static'
+else
+ # PORTME Check for PIC flags for the system compiler.
+ case "$host_os" in
+ aix3* | aix4*)
+ # FIXME All rs/6000 code is PIC, but is there any non-rs/6000 AIX platform?
+ pic_flag=
+ link_static_flag='-bnso -bI:/lib/syscalls.exp'
+ ;;
+
+ hpux9* | hpux10*)
+ # FIXME is there a better link_static_flag that works with the bundled CC?
+ wl='-Wl,'
+ link_static_flag='${wl}-a ${wl}archive'
+ pic_flag='+Z'
+ ;;
+
+ irix5* | irix6*)
+ wl='-Wl,'
+ link_static_flag='-non_shared'
+ # PIC (with -KPIC) is the default.
+ pic_flag=
+ ;;
+
+ osf3* | osf4*)
+ # FIXME - pic_flag is probably required for hppa*-osf* and i860-osf*
+ wl='-Wl,'
+ link_static_flag='-non_shared'
+ ;;
+
+ sco3.2v5*)
+ pic_flag='-Kpic'
+ link_static_flag='-dn'
+ special_shlib_compile_flags='-belf'
+ ;;
+
+ solaris2*)
+ pic_flag='-KPIC'
+ link_static_flag='-Bstatic'
+ wl='-Wl,'
+ ;;
+
+ sunos4*)
+ pic_flag='-PIC'
+ link_static_flag='-Bstatic'
+ wl='-Qoption ld '
+ ;;
+
+ *)
+ can_build_shared=no
+ ;;
+ esac
+fi
+
+case "$host_cpu" in
+rs6000 | powerpc | powerpcle)
+ # Yippee! All RS/6000 and PowerPC code is position-independent.
+ pic_flag=
+ ;;
+esac
+
+if test -n "$pic_flag"; then
+ echo $ac_t "$pic_flag" 1>&6
+ pic_flag=" $pic_flag"
+else
+ echo $ac_t none 1>&6
+fi
+
+# Check for any special shared library compilation flags.
+if test -n "$special_shlib_compile_flags"; then
+ echo "$progname: warning: \`$CC' requires \`$special_shlib_compile_flags' to build shared libraries" 1>&2
+ if echo "$old_CC $old_CFLAGS " | egrep -e "[ ]$special_shlib_compile_flags[ ]" >/dev/null; then :
+ else
+ echo "$progname: add \`$special_shlib_compile_flags' to the CC or CFLAGS env variable and reconfigure" 1>&2
+ can_build_shared=no
+ fi
+fi
+
+# See if we are using a broken GCC collect2 program.
+if test "$with_gcc" = yes; then
+ echo $ac_n "checking for broken GCC collect2... $ac_c" 1>&6
+
+ # FIXME: Run a test here, instead of relying on the canonical system name.
+ case "$host_os" in
+ aix3*)
+ can_build_shared=no
+ echo $ac_t yes 1>&6
+ echo "$progname: to build shared libraries, set the CC env variable to \`xlc' and reconfigure" 1>&2
+ ;;
+ *)
+ echo $ac_t no 1>&6
+ ;;
+ esac
+fi
+
+echo $ac_n "checking for $compiler option to statically link programs... $ac_c" 1>&6
+if test -n "$link_static_flag"; then
+ echo $ac_t "$link_static_flag" 1>&6
+else
+ echo $ac_t none 1>&6
+fi
+
+if test -z "$LN_S"; then
+ # Check to see if we can use ln -s, or we need hard links.
+ echo $ac_n "checking whether ln -s works... $ac_c" 1>&6
+ rm -f conftestdata
+ if ln -s X conftestdata 2>/dev/null; then
+ rm -f conftestdata
+ LN_S="ln -s"
+ else
+ LN_S=ln
+ fi
+ if test "$LN_S" = "ln -s"; then
+ echo "$ac_t"yes 1>&6
+ else
+ echo "$ac_t"no 1>&6
+ fi
+fi
+
+if test "$with_gnu_ld" != yes || test -z "$LD"; then
+ if test -z "$LD"; then
+ if test "$with_gnu_ld" = yes; then
+ echo $ac_n "checking for GNU ld... $ac_c" 1>&6
+ else
+ echo $ac_n "checking for non-GNU ld... $ac_c" 1>&6
+ fi
+
+ 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/ld"; then
+ LD="$ac_dir/ld"
+ # Check to see if the program is GNU ld. I'd rather use --version,
+ # but apparently some GNU ld's only accept -v.
+ # Break only if it was the GNU/non-GNU ld that we prefer.
+ if "$LD" -v 2>&1 < /dev/null | egrep '(GNU ld|with BFD)' > /dev/null; then
+ test "$with_gnu_ld" = yes && break
+ else
+ test "$with_gnu_ld" != yes && break
+ fi
+ fi
+ done
+ IFS="$ac_save_ifs"
+
+ if test -n "$LD"; then
+ echo "$ac_t""$LD" 1>&6
+ else
+ echo "$ac_t""no" 1>&6
+ fi
+
+ if test -z "$LD"; then
+ echo "$progname: error: no acceptable ld found in \$PATH" 1>&2
+ exit 1
+ fi
+ fi
+
+ echo $ac_n "checking whether we are using GNU ld... $ac_c" 1>&6
+ # I'd rather use --version here, but apparently some GNU ld's only accept -v.
+ if $LD -v 2>&1 </dev/null | egrep '(GNU ld|with BFD)' > /dev/null; then
+ with_gnu_ld=yes
+ fi
+ echo $ac_t "$with_gnu_ld" 1>&6
+fi
+
+# See if the linker supports building shared libraries.
+echo $ac_n "checking whether the linker ($LD) supports shared libraries... $ac_c" 1>&6
+
+allow_undefined_flag=
+archive_cmds=
+export_dynamic_flag=
+hardcode_libdir_flag_spec=
+hardcode_libdir_separator=
+hardcode_direct=no
+hardcode_minus_L=no
+hardcode_runpath_var=no
+hardcode_shlibpath_var=unsupported
+runpath_var=
+
+ld_shlibs=yes
+if test "$with_gnu_ld" = yes; then
+ # See if GNU ld supports shared libraries.
+
+ case "$host_os" in
+ sunos4*)
+ ld_shlibs=yes
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ *)
+ if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
+ runpath_var=LD_RUN_PATH
+ hardcode_runpath_var=yes
+ ld_shlibs=yes
+ else
+ ld_shlibs=no
+ fi
+ ;;
+ esac
+
+ if test "$ld_shlibs" = yes; then
+ archive_cmds='$cc -shared ${wl}-soname $wl$soname -o $lib$libobjs$deplibs'
+ hardcode_libdir_flag_spec='${wl}-rpath $wl$libdir'
+ export_dynamic_flag='${wl}-export-dynamic'
+ fi
+else
+ # PORTME fill in a description of your system's linker (not GNU ld)
+ case "$host_os" in
+ aix3*)
+ allow_undefined_flag=unsupported
+ archive_cmds='/usr/ucb/nm$libobjs | egrep \" [BD] \" | sed \"s/^.* //\" > $lib.exp;$LD -o $objdir/$soname$libobjs -bE:$lib.exp -T512 -H512 -bM:SRE -lc$deplibs;$AR cru $lib $objdir/$soname'
+ # Note: this linker hardcodes the directories in LIBPATH if there
+ # are no directories specified by -L.
+ hardcode_minus_L=yes
+ ;;
+
+ aix4*)
+ allow_undefined_flag=unsupported
+ archive_cmds='/bin/nm -B$libobjs | egrep \" [BD] \" | sed \"s/^.* //\" > $lib.exp;$cc -o $objdir/$soname$libobjs ${wl}-bE:$lib.exp ${wl}-bM:SRE ${wl}-bnoentry$deplibs;$AR cru $lib $objdir/$soname'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ ;;
+
+ # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
+ # support. Future versions do this automatically, but an explicit c++rt0.o
+ # doesn't break anything, and helps significantly (at the cost of a little
+ # extra space).
+ freebsd2.2*)
+ archive_cmds='$LD -Bshareable -o $lib$libobjs$deplibs /usr/lib/c++rt0.o'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ # Unfortunately, older versions of FreeBSD 2 don't have this feature.
+ freebsd2*)
+ archive_cmds='$LD -Bshareable -o $lib$libobjs$deplibs'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ # FreeBSD 3, at last, uses gcc -shared to do shared libraries.
+ freebsd3*)
+ archive_cmds='$CC -shared -o $lib$libobjs$deplibs'
+ hardcode_direct=yes
+ hardcode_minusL=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ hpux9*)
+ archive_cmds='$rm $objdir/$soname;$LD -b +s +b $install_libdir -o $objdir/$soname$libobjs$deplibs;mv $objdir/$soname $lib'
+ hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ ;;
+
+ hpux10*)
+ archive_cmds='$LD -b +h $soname +s +b $install_libdir -o $lib$libobjs$deplibs'
+ hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ ;;
+
+ irix5* | irix6*)
+ archive_cmds='$LD -shared -o $lib -soname $soname -set_version $verstring$libobjs -lc$deplibs'
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ ;;
+
+ netbsd* | openbsd*)
+ # Tested with NetBSD 1.2 ld
+ archive_cmds='$LD -Bshareable -o $lib$libobjs$deplibs'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_direct=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ osf3* | osf4*)
+ allow_undefined_flag=' -expect_unresolved'
+ archive_cmds='$LD -shared${allow_undefined_flag} -o $lib -soname $soname -set_version $verstring$libobjs -lc$deplibs'
+ hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
+ hardcode_libdir_separator=:
+ ;;
+
+ sco3.2v5*)
+ archive_cmds='$LD -G -o $lib$libobjs$deplibs'
+ hardcode_direct=yes
+ ;;
+
+ solaris2*)
+ archive_cmds='$LD -G -z text -h $soname -o $lib$libobjs$deplibs'
+ hardcode_libdir_flag_spec='-R$libdir'
+ hardcode_shlibpath_var=no
+ ;;
+
+ sunos4*)
+ archive_cmds='$LD -assert pure-text -Bstatic -o $lib$libobjs'
+ hardcode_libdir_flag_spec='-L$libdir'
+ hardcode_direct=yes
+ hardcode_minus_L=yes
+ hardcode_shlibpath_var=no
+ ;;
+
+ *)
+ ld_shlibs=no
+ can_build_shared=no
+ ;;
+ esac
+fi
+echo $ac_t "$ld_shlibs" 1>&6
+
+# Check hardcoding attributes.
+echo $ac_n "checking how to hardcode library paths into programs... $ac_c" 1>&6
+hardcode_action=
+if test -n "$hardcode_libdir_flag_spec" || \
+ test "$hardcode_runpath_var" = yes; then
+
+ # We can hardcode non-existant directories.
+ if test "$hardcode_direct" != no && \
+ test "$hardcode_minus_L" != no && \
+ test "$hardcode_shlibpath_var" != no; then
+
+ # Linking always hardcodes the temporary library directory.
+ hardcode_action=relink
+ else
+ # We can link without hardcoding, and we can hardcode nonexisting dirs.
+ hardcode_action=immediate
+ fi
+elif test "$hardcode_direct" != yes && \
+ test "$hardcode_minus_L" != yes && \
+ test "$hardcode_shlibpath_var" != yes; then
+ # We can't hardcode anything.
+ hardcode_action=unsupported
+else
+ # We can only hardcode existing directories.
+ hardcode_action=relink
+fi
+echo $ac_t "$hardcode_action" 1>&6
+test "$hardcode_action" = unsupported && can_build_shared=no
+
+
+reload_flag=
+reload_cmds='$LD$reload_flag -o $output$reload_objs'
+echo $ac_n "checking for $LD option to reload object files... $ac_c" 1>&6
+# PORTME Some linker may need a different reload flag.
+reload_flag='-r'
+echo $ac_t "$reload_flag"
+test -n "$reload_flag" && reload_flag=" $reload_flag"
+
+# PORTME Fill in your ld.so characteristics
+library_names_spec=
+soname_spec=
+postinstall_cmds=
+finish_cmds=
+shlibpath_var=
+version_type=none
+dynamic_linker="$host_os ld.so"
+
+echo $ac_n "checking dynamic linker characteristics... $ac_c" 1>&6
+case "$host_os" in
+aix3* | aix4*)
+ version_type=linux
+ library_names_spec='$libname.so.$versuffix $libname.a'
+ shlibpath_var=LIBPATH
+
+ # AIX has no versioning support, so we append a major version to the name.
+ soname_spec='$libname.so.$major'
+ ;;
+
+freebsd2* | freebsd3*)
+ version_type=sunos
+ library_names_spec='$libname.so.$versuffix $libname.so'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+gnu*)
+ version_type=sunos
+ library_names_spec='$libname.so.$versuffix'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+hpux9* | hpux10*)
+ # Give a soname corresponding to the major version so that dld.sl refuses to
+ # link against other versions.
+ dynamic_linker="$host_os dld.sl"
+ version_type=sunos
+ shlibpath_var=SHLIB_PATH
+ library_names_spec='$libname.sl.$versuffix $libname.sl.$major $libname.sl'
+ soname_spec='$libname.sl.$major'
+ # HP-UX runs *really* slowly unless shared libraries are mode 555.
+ postinstall_cmds='chmod 555 $lib'
+ ;;
+
+irix5* | irix6*)
+ version_type=osf
+ soname_spec='$libname.so'
+ library_names_spec='$libname.so.$versuffix $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+# No shared lib support for Linux oldld, aout, or coff.
+linux-gnuoldld* | linux-gnuaout* | linux-gnucoff*)
+ dynamic_linker=no
+ ;;
+
+# This must be Linux ELF.
+linux-gnu*)
+ version_type=linux
+ library_names_spec='$libname.so.$versuffix $libname.so.$major $libname.so'
+ soname_spec='$libname.so.$major'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+
+ if test -f /lib/ld.so.1; then
+ dynamic_linker='GNU ld.so'
+ else
+ # Only the GNU ld.so supports shared libraries on MkLinux.
+ case "$host_cpu" in
+ powerpc*) dynamic_linker=no ;;
+ *) dynamic_linker='Linux ld.so' ;;
+ esac
+ fi
+ ;;
+
+netbsd* | openbsd*)
+ version_type=sunos
+ library_names_spec='$libname.so.$versuffix'
+ finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+osf3* | osf4*)
+ version_type=osf
+ soname_spec='$libname.so'
+ library_names_spec='$libname.so.$versuffix $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+sco3.2v5*)
+ version_type=osf
+ soname_spec='$libname.so.$major'
+ library_names_spec='$libname.so.$versuffix $libname.so.$major $libname.so'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+solaris2*)
+ version_type=linux
+ library_names_spec='$libname.so.$versuffix $libname.so.$major $libname.so'
+ soname_spec='$libname.so.$major'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+sunos4*)
+ version_type=sunos
+ library_names_spec='$libname.so.$versuffix'
+ finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
+ shlibpath_var=LD_LIBRARY_PATH
+ ;;
+
+*)
+ dynamic_linker=no
+ ;;
+esac
+echo "$ac_t""$dynamic_linker"
+test "$dynamic_linker" = no && can_build_shared=no
+
+# FIXME need to add library stripping features
+# strip -x works for most platforms, though not for static libraries on NetBSD
+# HP-UX requires "-r" for library stripping
+striplib=
+old_striplib=
+
+#echo $ac_n "checking for static library strip program... $ac_c" 1>&6
+#if test -n "$old_striplib"; then
+# echo $ac_t "$old_striplib" 1>&6
+#else
+# echo $ac_t none 1>&6
+#fi
+
+#if test "$can_build_shared" = yes; then
+# echo $ac_n "checking for shared library strip program... $ac_c" 1>&6
+#
+# if test -n "$striplib"; then
+# echo $ac_t "$striplib" 1>&6
+# else
+# echo $ac_t none 1>&6
+# fi
+#fi
+
+# Report the consequences.
+echo "checking if libtool supports shared libraries... $can_build_shared" 1>&6
+
+echo $ac_n "checking whether to build shared libraries... $ac_c" 1>&6
+test "$can_build_shared" = "no" && enable_shared=no
+
+# On AIX, shared libraries and static libraries use the same namespace.
+case "$host_os" in
+aix*)
+ test "$enable_shared" = yes && enable_static=no
+ if test -n "$RANLIB"; then
+ archive_cmds="$archive_cmds;\$RANLIB \$lib"
+ postinstall_cmds='$RANLIB $lib'
+ fi
+ ;;
+esac
+
+echo "$ac_t""$enable_shared" 1>&6
+
+# Make sure either enable_shared or enable_static is yes.
+test "$enable_shared" = yes || enable_static=yes
+
+echo "checking whether to build static libraries... $enable_static" 1>&6
+
+ofile=libtool
+trap "$rm $ofile; exit 1" 1 2 15
+echo creating $ofile
+rm -fr $ofile
+cat <<EOF > $ofile
+#! /bin/sh
+
+# libtool - Provide generalized library-building support services.
+#
+# Generated automatically by $PROGRAM - GNU $PACKAGE $VERSION
+# This program was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# CC="$old_CC" CFLAGS="$old_CFLAGS" CPPFLAGS="$old_CPPFLAGS" \\
+# LD="$old_LD" RANLIB="$old_RANLIB" LN_S="$old_LN_S" \\
+# $0$ltconfig_args
+#
+# Compiler and other test output produced by $progname, useful for
+# debugging $progname, is in ./config.log if it exists.
+
+# The version of $progname that generated this script.
+LTCONFIG_VERSION="$VERSION"
+
+# Whether or not to build libtool libraries.
+build_libtool_libs=$enable_shared
+
+# Whether or not to build old-style libraries.
+build_old_libs=$enable_static
+
+# The host system.
+host_alias="$host_alias"
+host="$host"
+
+# The archiver.
+AR='$AR'
+
+# The linker used to build libraries.
+LD='$LD'
+
+# Whether we need hard or soft links.
+LN_S='$LN_S'
+
+# How to create reloadable object files.
+reload_flag='$reload_flag'
+reload_cmds='$reload_cmds'
+
+# How to pass a linker flag through the compiler.
+wl='$wl'
+
+# Additional compiler flags for building library objects.
+pic_flag='$pic_flag'
+
+# Compiler flag to prevent dynamic linking.
+link_static_flag='$link_static_flag'
+
+# Compiler flag to allow reflexive dlopens.
+export_dynamic_flag='$export_dynamic_flag'
+
+# Pattern to match compiler flags for creating libNAME_p libraries:
+profile_flag_pattern='$profile_flag_pattern'
+
+# Library versioning type.
+version_type=$version_type
+
+# List of archive names. First name is the real one, the rest are links.
+# The last name is the one that the linker finds with -lNAME.
+library_names_spec='$library_names_spec'
+
+# The coded name of the library, if different from the real name.
+soname_spec='$soname_spec'
+
+# Commands used to build and install an old-style archive.
+RANLIB='$RANLIB'
+old_archive_cmds='$old_archive_cmds'
+old_postinstall_cmds='$old_postinstall_cmds'
+
+# Commands used to build and install a shared archive.
+archive_cmds='$archive_cmds'
+postinstall_cmds='$postinstall_cmds'
+
+# Flag that allows shared libraries with undefined symbols to be built.
+allow_undefined_flag='$allow_undefined_flag'
+
+# Commands used to finish a libtool library installation in a directory.
+finish_cmds='$finish_cmds'
+
+# How to strip a library file.
+striplib='$striplib'
+old_striplib='$old_striplib'
+
+# This is the shared library runtime path variable.
+runpath_var=$runpath_var
+
+# This is the shared library path variable.
+shlibpath_var=$shlibpath_var
+
+# How to hardcode a shared library path into an executable.
+hardcode_action=$hardcode_action
+
+# Flag to hardcode \$libdir into a binary during linking.
+# This must work even if \$libdir does not exist.
+hardcode_libdir_flag_spec='$hardcode_libdir_flag_spec'
+
+# Whether we need a single -rpath flag with a separated argument.
+hardcode_libdir_separator='$hardcode_libdir_separator'
+
+# Set to yes if using DIR/libNAME.so during linking hardcodes DIR into the
+# resulting binary.
+hardcode_direct=$hardcode_direct
+
+# Set to yes if using the -LDIR flag during linking hardcodes DIR into the
+# resulting binary.
+hardcode_minus_L=$hardcode_minus_L
+
+# Set to yes if using RUNPATH_VAR=DIR during linking hardcodes DIR into the
+# resulting binary.
+hardcode_runpath_var=$hardcode_runpath_var
+
+# Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into
+# the resulting binary.
+hardcode_shlibpath_var=$hardcode_shlibpath_var
+
+EOF
+
+# Detect if we are using a relative or absolute path to ltmain.sh.
+case "$ltmain" in
+/*) cat <<EOF2 >> $ofile
+# Execute the libtool backend.
+. $ltmain
+EOF2
+ ;;
+*) cat <<EOF3 >> $ofile
+# Find the path to this script.
+thisdir=\`echo "\$0" | sed -e 's%/[^/]*\$%%'\`
+test "X\$0" = "X\$thisdir" && thisdir=.
+
+# Execute the libtool backend.
+. \$thisdir/$ltmain
+EOF3
+ ;;
+esac
+
+echo 'exit 1' >> $ofile
+
+chmod +x $ofile
+exit 0
+
+# Local Variables:
+# mode:shell-script
+# sh-indentation:2
+# End:
diff --git a/ltmain.sh b/ltmain.sh
new file mode 100644
index 00000000000..cda618977f0
--- /dev/null
+++ b/ltmain.sh
@@ -0,0 +1,1819 @@
+# ltmain.sh - Provide generalized library-building support services.
+# Generated automatically from ltmain.sh.in by configure.
+# Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+# Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
+#
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# The name of this program.
+progname=`echo "$0" | sed 's%^.*/%%'`
+
+# Constants.
+PROGRAM=ltmain.sh
+PACKAGE=libtool
+VERSION=1.0
+
+default_mode=
+help="Try \`$progname --help' for more information."
+magic="%%%MAGIC variable%%%"
+mkdir="mkdir"
+mv="mv -f"
+objdir=.libs
+rm="rm -f"
+
+if test "$LTCONFIG_VERSION" != "$VERSION"; then
+ echo "$progname: ltconfig version \`$LTCONFIG_VERSION' does not match $PROGRAM version \`$VERSION'" 1>&2
+ echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2
+ exit 1
+fi
+
+#
+if test "$build_libtool_libs" != yes && test "$build_old_libs" != yes; then
+ echo "$progname: not configured to build any kind of library" 1>&2
+ echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2
+ exit 1
+fi
+
+# Global variables.
+mode=$default_mode
+nonopt=
+prev=
+prevopt=
+run=
+show=echo
+show_help=
+
+# Parse our command line options once, thoroughly.
+while test $# -gt 0
+do
+ arg="$1"
+ shift
+
+ case "$arg" in
+ -*=*) optarg=`echo "$arg" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) optarg= ;;
+ esac
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$prev"; then
+ eval "$prev=\$arg"
+ prev=
+ prevopt=
+ continue
+ fi
+
+ # Have we seen a non-optional argument yet?
+ case "$arg" in
+ --help)
+ show_help=yes
+ ;;
+
+ --version)
+ echo "$PROGRAM (GNU $PACKAGE) $VERSION"
+ exit 0
+ ;;
+
+ --dry-run | -n)
+ run=:
+ ;;
+
+ --features)
+ echo "host: $host"
+ if test "$build_libtool_libs" = yes; then
+ echo "enable shared libraries"
+ else
+ echo "disable shared libraries"
+ fi
+ if test "$build_old_libs" = yes; then
+ echo "enable static libraries"
+ else
+ echo "disable static libraries"
+ fi
+ exit 0
+ ;;
+
+ --finish) mode="finish" ;;
+
+ --mode) prevopt="--mode" prev=mode ;;
+ --mode=*) mode="$optarg" ;;
+
+ -*)
+ echo "$progname: unrecognized option \`$arg'" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ ;;
+
+ *)
+ nonopt="$arg"
+ break
+ ;;
+ esac
+done
+
+
+if test -n "$prevopt"; then
+ echo "$progname: option \`$prevopt' requires an argument" 1>&2
+ echo "$help" 1>&2
+ exit 1
+fi
+
+
+if test -z "$show_help"; then
+
+ # Infer the operation mode.
+ if test -z "$mode"; then
+ case "$nonopt" in
+ *cc)
+ mode=link
+ for arg
+ do
+ case "$arg" in
+ -c)
+ mode=compile
+ break
+ ;;
+ esac
+ done
+ ;;
+ *install*|cp)
+ mode=install
+ ;;
+ *rm)
+ mode=uninstall
+ ;;
+ *.la)
+ mode=dlname
+ ;;
+ *)
+ # Just use the default operation mode.
+ if test -z "$mode"; then
+ if test -n "$nonopt"; then
+ echo "$progname: warning: cannot infer operation mode from \`$nonopt'" 1>&2
+ else
+ echo "$progname: warning: cannot infer operation mode without MODE-ARGS" 1>&2
+ fi
+ fi
+ ;;
+ esac
+ fi
+
+ # Change the help message to a mode-specific one.
+ generic_help="$help"
+ help="Try \`$progname --help --mode=$mode' for more information."
+
+ # These modes are in order of execution frequency so that they run quickly.
+ case "$mode" in
+ # libtool compile mode
+ compile)
+ progname="$progname: compile"
+ # Get the compilation command and the source file.
+ base_compile="$nonopt"
+ lastarg=
+ srcfile=
+
+ for arg
+ do
+ # Quote any args containing shell metacharacters.
+ case "$arg" in
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*|*\"*)
+ quote_arg="'$arg'" ;;
+ *) quote_arg="$arg" ;;
+ esac
+
+ base_compile="$base_compile$lastarg"
+ srcfile="$quote_arg"
+ lastarg=" $srcfile"
+ done
+
+ # Get the name of the library object.
+ libobj=`echo "$srcfile" | sed -e 's%^.*/%%'`
+
+ # Recognize several different file suffixes.
+ xform='[cCFSf]'
+ case "$libobj" in
+ *.c++) xform='c++' ;;
+ *.cc) xform=cc ;;
+ *.cpp) xform=cpp ;;
+ *.cxx) xform=cxx ;;
+ *.f90) xform=f90 ;;
+ *.for) xform='for' ;;
+ esac
+
+ libobj=`echo "$libobj" | sed -e "s/\.$xform$/.lo/"`
+
+ case "$libobj" in
+ *.lo) obj=`echo "$libobj" | sed -e 's/\.lo$/.o/'` ;;
+ *)
+ echo "$progname: cannot determine name of library object from \`$srcfile'" 1>&2
+ exit 1
+ ;;
+ esac
+
+ if test -z "$base_compile"; then
+ echo "$progname: you must specify a compilation command" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ # Delete any leftover library objects.
+ if test "$build_old_libs" = yes; then
+ $run $rm $obj $libobj
+ trap "$run $rm $obj $libobj; exit 1" 1 2 15
+ else
+ $run $rm $libobj
+ trap "$run $rm $libobj; exit 1" 1 2 15
+ fi
+
+ # Only build a PIC object if we are building libtool libraries.
+ if test "$build_libtool_libs" = yes; then
+ # All platforms use -DPIC, to notify preprocessed assembler code.
+ $show "$base_compile$pic_flag -DPIC $srcfile"
+ if $run eval "$base_compile$pic_flag -DPIC $srcfile"; then :
+ else
+ test -n "$obj" && $run $rm $obj
+ exit 1
+ fi
+
+ # If we have no pic_flag, then copy the object into place and finish.
+ if test -z "$pic_flag"; then
+ $show "$LN_S $obj $libobj"
+ $run $LN_S $obj $libobj
+ exit $?
+ fi
+
+ # Just move the object, then go on to compile the next one
+ $show "$mv $obj $libobj"
+ $run $mv $obj $libobj || exit 1
+ fi
+
+ # Only build a position-dependent object if we build old libraries.
+ if test "$build_old_libs" = yes; then
+ $show "$base_compile $srcfile"
+ if $run eval "$base_compile $srcfile"; then :
+ else
+ $run $rm $obj $libobj
+ exit 1
+ fi
+ fi
+
+ # Create an invalid libtool object if no PIC, so that we don't accidentally
+ # link it into a program.
+ if test "$build_libtool_libs" != yes; then
+ $show "echo timestamp > $libobj"
+ $run eval "echo timestamp > $libobj" || exit $?
+ fi
+
+ exit 0
+ ;;
+
+ # libtool link mode
+ link)
+ progname="$progname: link"
+ # Go through the arguments, transforming them on the way.
+ cc="$nonopt"
+ args="$cc"
+ allow_undefined=no
+ compile_command="$cc"
+ finalize_command="$cc"
+ compile_shlibpath=
+ finalize_shlibpath=
+ deplibs=
+ export_dynamic=no
+ hardcode_libdirs=
+ install_libdir=
+ libobjs=
+ link_against_libtool_libs=
+ link_static=
+ ltlibs=
+ objs=
+ prev=
+ prevarg=
+ perm_rpath=
+ temp_rpath=
+ vinfo=
+
+ # We need to know -static, to get the right output filenames.
+ for arg
+ do
+ case "$arg" in
+ -static)
+ build_libtool_libs=no
+ build_old_libs=yes
+ break
+ ;;
+ esac
+ done
+
+ for arg
+ do
+ # If the previous option needs an argument, assign it.
+ if test -n "$prev"; then
+ case "$prev" in
+ output)
+ compile_command="$compile_command @OUTPUT@"
+ finalize_command="$finalize_command @OUTPUT@"
+ args="$args $arg"
+ ;;
+ esac
+
+ eval "$prev=\$arg"
+ prev=
+
+ continue
+ fi
+
+ args="$args $arg"
+ prevarg="$arg"
+
+ case "$arg" in
+ -allow-undefined) allow_undefined=yes ;;
+
+ -export-dynamic)
+ export_dynamic=yes
+ compile_command="$compile_command $export_dynamic_flag"
+ finalize_command="$finalize_command $export_dynamic_flag"
+ continue
+ ;;
+
+ -L*)
+ dir=`echo "$arg" | sed 's%^-L\(.*\)$%\1%'`
+ case "$dir" in
+ /*)
+ ;;
+ *)
+ echo "$progname: \`-L$dir' cannot specify a relative directory" 1>&2
+ exit 1
+ ;;
+ esac
+ deplibs="$deplibs $arg"
+ ;;
+
+ -l*) deplibs="$deplibs $arg" ;;
+
+ -o) prev=output ;;
+
+ -rpath)
+ prev=install_libdir
+ continue
+ ;;
+
+ -static)
+ link_static="`eval echo \"$link_static_flag\"`"
+ compile_command="$compile_command $link_static"
+ continue
+ ;;
+
+ -version-file)
+ echo "$progname: \`-version-file' has been replaced by \`-version-info'" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ ;;
+
+ -version-info)
+ prev=vinfo
+ continue
+ ;;
+
+ -*) cc="$cc $arg" ;; # Some other compiler flag.
+
+ *.o)
+ # A standard object.
+ objs="$objs $arg"
+ ;;
+
+ *.a)
+ # Find the relevant object directory and library name.
+ file=`echo "$arg" | sed 's%^.*/%%'`
+ dir=`echo "$arg" | sed 's%/[^/]*$%/%'`
+ test "$dir" = "$arg" && dir=
+
+ # Standard archive.
+ objs="$objs $arg"
+ ;;
+
+ *.lo)
+ # A library object.
+ libobjs="$libobjs $arg"
+ ;;
+
+ *.la)
+ # A libtool-controlled library.
+
+ libdir=
+ library_names=
+ old_library=
+
+ # Check to see that this really is a libtool archive.
+ if egrep "^# Generated by $PROGRAM" $arg >/dev/null 2>&1; then :
+ else
+ echo "$progname: \`$arg' is not a valid libtool archive" 1>&2
+ exit 1
+ fi
+
+ # If there is no directory component, then add one.
+ case "$arg" in
+ */*) . $arg ;;
+ *) . ./$arg ;;
+ esac
+
+ if test -z "$libdir"; then
+ echo "$progname: \`$arg' contains no -rpath information" 1>&2
+ exit 1
+ fi
+
+ # Get the name of the library we link against.
+ linklib=
+ for l in $old_library $library_names; do
+ linklib="$l"
+ done
+
+ if test -z "$linklib"; then
+ echo "$progname: cannot find name of link library for \`$arg'" 1>&2
+ exit 1
+ fi
+
+ # Find the relevant object directory and library name.
+ name=`echo "$arg" | sed 's%^.*/%%; s/\.la$//; s/^lib//'`
+ dir=`echo "$arg" | sed 's%/[^/]*$%%'`
+ if test "$dir" = "$arg"; then
+ dir="$objdir"
+ else
+ dir="$dir/$objdir"
+ fi
+
+ if test "$build_libtool_libs" = yes && test -n "$library_names"; then
+ link_against_libtool_libs="$link_against_libtool_libs $arg"
+ if test -n "$shlibpath_var"; then
+ # Make sure the rpath contains only unique directories.
+ case "$temp_rpath " in
+ "* $dir *") ;;
+ *) temp_rpath="$temp_rpath $dir" ;;
+ esac
+ fi
+
+ if test -n "$hardcode_libdir_flag_spec"; then
+ if test -n "$hardcode_libdir_separator"; then
+ if test -z "$hardcode_libdirs"; then
+ # Put the magic libdir with the hardcode flag.
+ hardcode_libdirs="$libdir"
+ libdir="@HARDCODE_LIBDIRS@"
+ else
+ # Just accumulate the libdirs.
+ hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
+ libdir=
+ fi
+ fi
+
+ if test -n "$libdir"; then
+ hardcode_libdir_flag=`eval echo \"$hardcode_libdir_flag_spec\"`
+ compile_command="$compile_command $hardcode_libdir_flag"
+ finalize_command="$finalize_command $hardcode_libdir_flag"
+ fi
+ elif test "$hardcode_runpath_var" = yes; then
+ # Do the same for the permanent run path.
+ case "$perm_rpath " in
+ "* $libdir *") ;;
+ *) perm_rpath="$perm_rpath $libdir" ;;
+ esac
+ fi
+
+
+ case "$hardcode_action" in
+ immediate)
+ if test "$hardcode_direct" = no; then
+ compile_command="$compile_command $dir/$linklib"
+ elif test "$hardcode_minus_L" = no; then
+ compile_command="$compile_command -L$dir -l$name"
+ elif test "$hardcode_shlibpath_var" = no; then
+ compile_shlibpath="$compile_shlibpath$dir:"
+ compile_command="$compile_command -l$name"
+ fi
+ ;;
+
+ relink)
+ # We need an absolute path.
+ case "$dir" in
+ /*) ;;
+ *)
+ absdir=`cd "$dir" && pwd`
+ if test -z "$absdir"; then
+ echo "$progname: cannot determine absolute directory name of \`$dir'" 1>&2
+ exit 1
+ fi
+ dir="$absdir"
+ ;;
+ esac
+
+ if test "$hardcode_direct" = yes; then
+ compile_command="$compile_command $dir/$linklib"
+ elif test "$hardcode_minus_L" = yes; then
+ compile_command="$compile_command -L$dir -l$name"
+ elif test "$hardcode_shlibpath_var" = yes; then
+ compile_shlibpath="$compile_shlibpath$dir:"
+ compile_command="$compile_command -l$name"
+ fi
+ ;;
+
+ *)
+ echo "$progname: \`$hardcode_action' is an unknown hardcode action" 1>&2
+ exit 1
+ ;;
+ esac
+
+ # Finalize command for both is simple: just hardcode it.
+ if test "$hardcode_direct" = yes; then
+ finalize_command="$finalize_command $libdir/$linklib"
+ elif test "$hardcode_minus_L" = yes; then
+ finalize_command="$finalize_command -L$libdir -l$name"
+ elif test "$hardcode_shlibpath_var" = yes; then
+ finalize_shlibpath="$finalize_shlibpath$libdir:"
+ finalize_command="$finalize_command -l$name"
+ else
+ # We can't seem to hardcode it, guess we'll fake it.
+ finalize_command="$finalize_command -L$libdir -l$name"
+ fi
+ else
+ # Transform directly to old archives if we don't build new libraries.
+ if test -n "$pic_flag" && test -z "$old_library"; then
+ echo "$progname: cannot find static library for \`$arg'" 1>&2
+ exit 1
+ fi
+ test -n "$old_library" && linklib="$old_library"
+ compile_command="$compile_command $dir/$linklib"
+ finalize_command="$finalize_command $dir/$linklib"
+ fi
+ continue
+ ;;
+
+ *)
+ echo "$progname: unknown file suffix for \`$arg'" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ ;;
+ esac
+
+ compile_command="$compile_command $arg"
+ finalize_command="$finalize_command $arg"
+ done
+
+ if test -n "$prev"; then
+ echo "$progname: the \`$prevarg' option requires an argument" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ # Substitute the hardcoded libdirs into the compile commands.
+ if test "$hardcode_libdir_colon_separated" = yes; then
+ compile_command=`echo "$compile_command" | sed "s%@HARDCODE_LIBDIRS@%$hardcode_libdirs%g"`
+ finalize_command=`echo "$finalize_command" | sed "s%@HARDCODE_LIBDIRS@%$hardcode_libdirs%g"`
+ fi
+
+ oldlib=
+ oldobjs=
+ case "$output" in
+ "")
+ echo "$progname: you must specify an output file" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ ;;
+
+ */*)
+ echo "$progname: output file \`$output' must have no directory components" 1>&2
+ exit 1
+ ;;
+
+ *.la)
+ libname=`echo "$output" | sed 's/\.la$//'`
+
+ # All the library-specific variables (install_libdir is set above).
+ library_names=
+ old_library=
+ dlname=
+ current=0
+ revision=0
+ age=0
+
+ if test -n "$objs"; then
+ echo "$progname: cannot build libtool library \`$output' from non-libtool objects:$objs" 2>&1
+ exit 1
+ fi
+
+ # How the heck are we supposed to write a wrapper for a shared library?
+ if test -n "$link_against_libtool_libs"; then
+ echo "$progname: libtool library \`$output' may not depend on uninstalled libraries:$link_against_libtool_libs" 1>&2
+ exit 1
+ fi
+
+ if test -z "$install_libdir"; then
+ echo "$progname: you must specify an installation directory with \`-rpath'" 1>&2
+ exit 1
+ fi
+
+ # Parse the version information argument.
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=':'
+ set dummy $vinfo
+ IFS="$save_ifs"
+
+ if test -n "$5"; then
+ echo "$progname: too many parameters to \`-version-info'" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ test -n "$2" && current="$2"
+ test -n "$3" && revision="$3"
+ test -n "$4" && age="$4"
+
+ # Check that each of the things are valid numbers.
+ case "$current" in
+ 0 | [1-9] | [1-9][0-9]*) ;;
+ *)
+ echo "$progname: CURRENT \`$current' is not a nonnegative integer" 1>&2
+ echo "$progname: \`$vinfo' is not valid version information" 1>&2
+ exit 1
+ ;;
+ esac
+
+ case "$revision" in
+ 0 | [1-9] | [1-9][0-9]*) ;;
+ *)
+ echo "$progname: REVISION \`$revision' is not a nonnegative integer" 1>&2
+ echo "$progname: \`$vinfo' is not valid version information" 1>&2
+ exit 1
+ ;;
+ esac
+
+ case "$age" in
+ 0 | [1-9] | [1-9][0-9]*) ;;
+ *)
+ echo "$progname: AGE \`$age' is not a nonnegative integer" 1>&2
+ echo "$progname: \`$vinfo' is not valid version information" 1>&2
+ exit 1
+ ;;
+ esac
+
+ if test $age -gt $current; then
+ echo "$progname: AGE \`$age' is greater than the current interface number \`$current'" 1>&2
+ echo "$progname: \`$vinfo' is not valid version information" 1>&2
+ exit 1
+ fi
+
+ # Calculate the version variables.
+ version_vars="version_type current age revision"
+ case "$version_type" in
+ none) ;;
+
+ linux)
+ version_vars="$version_vars major versuffix"
+ major=`expr $current - $age`
+ versuffix="$major.$age.$revision"
+ ;;
+
+ osf)
+ version_vars="$version_vars versuffix verstring"
+ major=`expr $current - $age`
+ versuffix="$current.$age.$revision"
+ verstring="$versuffix"
+
+ # Add in all the interfaces that we are compatible with.
+ loop=$age
+ while test $loop != 0; do
+ iface=`expr $current - $loop`
+ loop=`expr $loop - 1`
+ verstring="$verstring:${iface}.0"
+ done
+
+ # Make executables depend on our current version.
+ verstring="$verstring:${current}.0"
+ ;;
+
+ sunos)
+ version_vars="$version_vars major versuffix"
+ major="$current"
+ versuffix="$current.$revision"
+ ;;
+
+ *)
+ echo "$progname: unknown library version type \`$version_type'" 1>&2
+ echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2
+ exit 1
+ ;;
+ esac
+
+ # Create the output directory, or remove our outputs if we need to.
+ if test -d $objdir; then
+ $show "$rm $objdir/$libname.*"
+ $run $rm $objdir/$libname.*
+ else
+ $show "$mkdir $objdir"
+ $run $mkdir $objdir || exit $?
+ fi
+
+ # Check to see if the archive will have undefined symbols.
+ if test "$allow_undefined" = yes; then
+ if test "$allow_undefined_flag" = unsupported; then
+ echo "$progname: warning: undefined symbols not allowed in $host shared libraries" 1>&2
+ build_libtool_libs=no
+ fi
+ else
+ # Clear the flag.
+ allow_undefined_flag=
+ fi
+
+ if test "$build_libtool_libs" = yes; then
+ # Get the real and link names of the library.
+ library_names=`eval echo \"$library_names_spec\"`
+ set dummy $library_names
+ realname="$2"
+ shift; shift
+
+ if test -n "$soname_spec"; then
+ soname=`eval echo \"$soname_spec\"`
+ else
+ soname="$realname"
+ fi
+
+ lib="$objdir/$realname"
+ linknames=
+ for link
+ do
+ linknames="$linknames $link"
+ done
+
+ # Use standard objects if they are PIC.
+ test -z "$pic_flag" && libobjs=`echo "$libobjs " | sed 's/\.lo /.o /g; s/ $//g'`
+
+ # Do each of the archive commands.
+ cmds=`eval echo \"$archive_cmds\"`
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=';'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+
+ # Create links to the real library.
+ for link in $linknames; do
+ $show "(cd $objdir && $LN_S $realname $link)"
+ $run eval "(cd $objdir && $LN_S $realname $link)" || exit $?
+ done
+
+ # If -export-dynamic was specified, set the dlname.
+ if test "$export_dynamic" = yes; then
+ # On all known operating systems, these are identical.
+ dlname="$soname"
+ fi
+ fi
+ ;;
+
+ *.lo | *.o)
+ if test -n "$link_against_libtool_libs"; then
+ echo "$progname: error: cannot link libtool libraries into reloadable objects" 1>&2
+ exit 1
+ fi
+
+ if test -n "$deplibs"; then
+ echo "$progname: warning: \`-l' and \`-L' are ignored while creating objects" 1>&2
+ fi
+
+ if test -n "$install_libdir"; then
+ echo "$progname: warning: \`-rpath' is ignored while creating objects" 1>&2
+ fi
+
+ if test -n "$vinfo"; then
+ echo "$progname: warning: \`-version-info' is ignored while creating objects" 1>&2
+ fi
+
+ case "$output" in
+ *.lo)
+ if test -n "$objs"; then
+ echo "$progname: cannot build library object \`$output' from non-libtool objects" 1>&2
+ exit 1
+ fi
+ libobj="$output"
+ obj=`echo "$output" | sed 's/\.lo$/.o/'`
+ ;;
+ *)
+ libobj=
+ obj="$output"
+ ;;
+ esac
+
+ # Delete the old objects.
+ $run $rm $obj $libobj
+
+ # Create the old-style object.
+ reload_objs="$objs"`echo "$libobjs " | sed 's/[^ ]*\.a //g; s/\.lo /.o /g; s/ $//g'`
+
+ output="$obj"
+ cmds=`eval echo \"$reload_cmds\"`
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=';'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+
+ # Exit if we aren't doing a library object file.
+ test -z "$libobj" && exit 0
+
+ if test "$build_libtool_libs" != yes; then
+ # Create an invalid libtool object if no PIC, so that we don't
+ # accidentally link it into a program.
+ $show "echo timestamp > $libobj"
+ $run eval "echo timestamp > $libobj" || exit $?
+ exit 0
+ fi
+
+ if test -n "$pic_flag"; then
+ # Only do commands if we really have different PIC objects.
+ reload_objs="$libobjs"
+ output="$libobj"
+ cmds=`eval echo \"$reload_cmds\"`
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=';'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ else
+ # Just create a symlink.
+ $show "$LN_S $obj $libobj"
+ $run $LN_S $obj $libobj || exit 1
+ fi
+
+ exit 0
+ ;;
+
+ *)
+ if test -n "$install_libdir"; then
+ echo "$progname: warning: \`-rpath' is ignored while linking programs" 1>&2
+ fi
+
+ if test -n "$vinfo"; then
+ echo "$progname: warning: \`-version-info' is ignored while linking programs" 1>&2
+ fi
+
+ if test -n "$libobjs"; then
+ # Transform all the library objects into standard objects.
+ compile_command=`echo "$compile_command " | sed 's/\.lo /.o /g; s/ $//'`
+ finalize_command=`echo "$finalize_command " | sed 's/\.lo /.o /g; s/ $//'`
+ fi
+
+ if test -z "$link_against_libtool_libs" || test "$build_libtool_libs" != yes; then
+ # Replace the output file specification.
+ compile_command=`echo "$compile_command" | sed 's%@OUTPUT@%'"$output"'%g'`
+ finalize_command=`echo "$finalize_command" | sed 's%@OUTPUT@%'"$output"'%g'`
+
+ # We have no uninstalled library dependencies, so finalize right now.
+ $show "$compile_command"
+ $run $compile_command
+ status=$?
+
+ # If we failed to link statically, then try again.
+ if test $status -ne 0 && test -n "$link_static"; then
+ echo "$progname: cannot link \`$output' statically; retrying semi-dynamically" 1>&2
+ compile_command=`echo "$compile_command " | sed "s% $link_static % %;s/ $//"`
+ $show "$finalize_command"
+ $run $finalize_command
+ status=$?
+ fi
+ exit $status
+ fi
+
+ # Replace the output file specification.
+ compile_command=`echo "$compile_command" | sed 's%@OUTPUT@%'"$objdir/$output"'%g'`
+ finalize_command=`echo "$finalize_command" | sed 's%@OUTPUT@%'"$objdir/$output"'T%g'`
+
+ # Create the binary in the object directory, then wrap it.
+ if test -d $objdir; then :
+ else
+ $show "$mkdir $objdir"
+ $run $mkdir $objdir || exit $?
+ fi
+
+ if test -n "$shlibpath_var"; then
+ # We should set the shlibpath_var
+ rpath=
+ for dir in $temp_rpath; do
+ case "$dir" in
+ /*)
+ # Absolute path.
+ rpath="$rpath$dir:"
+ ;;
+ *)
+ # Relative path: add a thisdir entry.
+ rpath="$rpath\$thisdir/$dir:"
+ ;;
+ esac
+ done
+ temp_rpath="$rpath"
+ fi
+
+ # Delete the old output file.
+ $run $rm $output
+
+ if test -n "$compile_shlibpath"; then
+ compile_command="$shlibpath_var=\"$compile_shlibpath\$$shlibpath_var\" $compile_command"
+ fi
+ if test -n "$finalize_shlibpath"; then
+ finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command"
+ fi
+
+ if test -n "$perm_rpath"; then
+ # We should set the runpath_var.
+ rpath=
+ for dir in $perm_rpath; do
+ rpath="$rpath$dir:"
+ done
+ compile_command="$runpath_var=\"$rpath\$$runpath_var\" $compile_command"
+ finalize_command="$runpath_var=\"$rpath\$$runpath_var\" $finalize_command"
+ fi
+
+ case "$hardcode_action" in
+ relink)
+ # AGH! Flame the AIX and HP-UX people for me, will ya?
+ echo "$progname: warning: using a buggy system linker" 1>&2
+ echo "$progname: relinking will be required before \`$output' can be installed" 1>&2
+ ;;
+ esac
+
+ $show "$compile_command"
+ $run eval "$compile_command" || exit $?
+
+ # Now create the wrapper script.
+ echo "creating $output"
+
+ # Only actually do things if our run command is non-null.
+ if test -z "$run"; then
+ $rm $output
+ trap "$rm $output; exit 1" 1 2 15
+
+ cat > $output <<EOF
+#! /bin/sh
+
+# $output - temporary wrapper script for $objdir/$output
+# Generated by $PROGRAM - GNU $PACKAGE $VERSION
+#
+# The $output program cannot be directly executed until all the libtool
+# libraries that it depends on are installed.
+#
+# This wrapper script should never be moved out of \``pwd`'.
+# If it is, it will not operate correctly.
+
+# This environment variable determines our operation mode.
+if test "\$libtool_install_magic" = "$magic"; then
+ # install mode needs the following variables:
+ link_against_libtool_libs='$link_against_libtool_libs'
+ finalize_command='$finalize_command'
+else
+ # Find the directory that this script lives in.
+ thisdir=\`echo \$0 | sed 's%/[^/]*$%%'\`
+ test "x\$thisdir" = "x\$0" && thisdir=.
+
+ # Try to get the absolute directory name.
+ absdir=\`cd "\$thisdir" && pwd\`
+ test -n "\$absdir" && thisdir="\$absdir"
+
+ progdir="\$thisdir/$objdir"
+ program="$output"
+
+ if test -f "\$progdir/\$program"; then
+ # Run the actual program with our arguments.
+ args=
+ for arg
+ do
+ # Quote arguments (to preserve shell metacharacters).
+ args="\$args '\$arg'"
+ done
+
+ # Export the path to the program.
+ PATH="\$progdir:\$PATH"
+ export PATH
+EOF
+
+ # Export our shlibpath_var if we have one.
+ if test -n "$shlibpath_var" && test -n "$temp_rpath"; then
+ cat >> $output <<EOF
+
+ # Add our own library path to $shlibpath_var
+ $shlibpath_var="$temp_rpath\$$shlibpath_var"
+
+ # Some systems cannot cope with colon-terminated $shlibpath_var
+ $shlibpath_var=\`echo \$$shlibpath_var | sed -e 's/:*\$//'\`
+
+ export $shlibpath_var
+EOF
+ fi
+
+ cat >> $output <<EOF
+
+ eval "exec \$program \$args"
+
+ echo "\$0: cannot exec \$program \$args"
+ exit 1
+ else
+ # The program doesn't exist.
+ echo "\$0: error: \$progdir/\$program does not exist" 1>&2
+ echo "This script is just a wrapper for \$program." 1>&2
+ echo "See the $PACKAGE documentation for more information." 1>&2
+ exit 1
+ fi
+fi
+EOF
+ chmod +x $output
+ fi
+ exit 0
+ ;;
+ esac
+
+
+ # See if we need to build an old-fashioned archive.
+ if test "$build_old_libs" = "yes"; then
+ # Now set the variables for building old libraries.
+ oldlib="$objdir/$libname.a"
+
+ # Transform .lo files to .o files.
+ oldobjs="$objs"`echo "$libobjs " | sed 's/[^ ]*\.a //g; s/\.lo /.o /g; s/ $//g'`
+
+ if test -d "$objdir"; then
+ $show "$rm $oldlib"
+ $run $rm $oldlib
+ else
+ $show "$mkdir $objdir"
+ $run $mkdir $objdir
+ fi
+
+ # Do each command in the archive commands.
+ cmds=`eval echo \"$old_archive_cmds\"`
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=';'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ fi
+
+ # Now create the libtool archive.
+ case "$output" in
+ *.la)
+ old_library=
+ test "$build_old_libs" = yes && old_library="$libname.a"
+
+ echo "creating $output"
+
+ # Only create the output if not a dry run.
+ if test -z "$run"; then
+ cat > $output <<EOF
+# $output - a libtool library file
+# Generated by $PROGRAM - GNU $PACKAGE $VERSION
+
+# The name that we can dlopen(3).
+dlname='$dlname'
+
+# Names of this library.
+library_names='$library_names'
+
+# The name of the static archive.
+old_library='$old_library'
+
+# Version information for $libname.
+current=$current
+age=$age
+revision=$revision
+
+# Directory that this library needs to be installed in:
+libdir='$install_libdir'
+EOF
+ fi
+
+ # Do a symbolic link so that the libtool archive can be found in
+ # LD_LIBRARY_PATH before the program is installed.
+ $show "(cd $objdir && $LN_S ../$output $output)"
+ $run eval "(cd $objdir && $LN_S ../$output $output)" || exit 1
+ ;;
+ esac
+ exit 0
+ ;;
+
+ # libtool install mode
+ install)
+ progname="$progname: install"
+
+ # The first argument is the name of the installation program.
+ install_prog="$nonopt"
+
+ # CYGNUS LOCAL: Handle /bin/sh at the start.
+ if test "$install_prog" = "/bin/sh"; then
+ install_prog=$1
+ shift
+ fi
+
+ # We need to accept at least all the BSD install flags.
+ dest=
+ files=
+ opts=
+ prev=
+ install_type=
+ isdir=
+ stripme=
+ for arg
+ do
+ if test -n "$dest"; then
+ files="$files $dest"
+ dest="$arg"
+ continue
+ fi
+
+ case "$arg" in
+ -d) isdir=yes ;;
+ -f) prev="-f" ;;
+ -g) prev="-g" ;;
+ -m) prev="-m" ;;
+ -o) prev="-o" ;;
+ -s)
+ stripme=" -s"
+ continue
+ ;;
+ -*) ;;
+
+ *)
+ # If the previous option needed an argument, then skip it.
+ if test -n "$prev"; then
+ prev=
+ else
+ dest="$arg"
+ continue
+ fi
+ ;;
+ esac
+ install_prog="$install_prog $arg"
+ done
+
+ if test -z "$install_prog"; then
+ echo "$progname: you must specify an install program" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ if test -n "$prev"; then
+ echo "$progname: the \`$prev' option requires an argument" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ if test -z "$files"; then
+ if test -z "$dest"; then
+ echo "$progname: no file or destination specified" 1>&2
+ else
+ echo "$progname: you must specify a destination" 1>&2
+ fi
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ # Strip any trailing slash from the destination.
+ dest=`echo "$dest" | sed 's%/$%%'`
+
+ # Check to see that the destination is a directory.
+ test -d "$dest" && isdir=yes
+ if test -n "$isdir"; then
+ destdir="$dest"
+ destname=
+ else
+ destdir=`echo "$dest" | sed 's%/[^/]*$%%'`
+ test "$destdir" = "$dest" && destdir=.
+ destname=`echo "$dest" | sed 's%^.*/%%'`
+
+ # Not a directory, so check to see that there is only one file specified.
+ set dummy $files
+ if test $# -gt 2; then
+ echo "$progname: \`$dest' is not a directory" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+ fi
+ case "$destdir" in
+ /*) ;;
+ *)
+ for file in $files; do
+ case "$file" in
+ *.lo) ;;
+ *)
+ echo "$progname: \`$destdir' must be an absolute directory name" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ ;;
+ esac
+ done
+ ;;
+ esac
+
+ staticlibs=
+ future_libdirs=
+ current_libdirs=
+ for file in $files; do
+
+ # Do each installation.
+ case "$file" in
+ *.a)
+ # Do the static libraries later.
+ staticlibs="$staticlibs $file"
+ ;;
+
+ *.la)
+ # Check to see that this really is a libtool archive.
+ if egrep "^# Generated by $PROGRAM" $file >/dev/null 2>&1; then :
+ else
+ echo "$progname: \`$file' is not a valid libtool archive" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ library_names=
+ old_library=
+ # If there is no directory component, then add one.
+ case "$file" in
+ */*) . $file ;;
+ *) . ./$file ;;
+ esac
+
+ # Add the libdir to current_libdirs if it is the destination.
+ if test "$destdir" = "$libdir"; then
+ case "$current_libdirs " in
+ "* $libdir *") ;;
+ *) current_libdirs="$current_libdirs $libdir" ;;
+ esac
+ else
+ # Note the libdir as a future libdir.
+ case "$future_libdirs " in
+ "* $libdir *") ;;
+ *) future_libdirs="$future_libdirs $libdir" ;;
+ esac
+ fi
+
+ dir="`echo "$file" | sed 's%/[^/]*$%%'`/"
+ test "$dir" = "$file/" && dir=
+ dir="$dir$objdir"
+
+ # See the names of the shared library.
+ set dummy $library_names
+ if test -n "$2"; then
+ realname="$2"
+ shift
+ shift
+
+ # Install the shared library and build the symlinks.
+ $show "$install_prog $dir/$realname $destdir/$realname"
+ $run eval "$install_prog $dir/$realname $destdir/$realname" || exit $?
+ test "X$dlname" = "X$realname" && dlname=
+
+ # Support stripping libraries.
+ if test -n "$stripme"; then
+ if test -n "$striplib"; then
+ $show "$striplib $destdir/$realname"
+ $run $striplib $destdir/$realname || exit $?
+ else
+ echo "$progname: warning: no library stripping program" 1>&2
+ fi
+ fi
+
+ if test $# -gt 0; then
+ # Delete the old symlinks.
+ rmcmd="$rm"
+ for linkname
+ do
+ rmcmd="$rmcmd $destdir/$linkname"
+ done
+ $show "$rmcmd"
+ $run $rmcmd
+
+ # ... and create new ones.
+ for linkname
+ do
+ test "X$dlname" = "X$linkname" && dlname=
+ $show "(cd $destdir && $LN_S $realname $linkname)"
+ $run eval "(cd $destdir && $LN_S $realname $linkname)"
+ done
+ fi
+
+ if test -n "$dlname"; then
+ # Install the dynamically-loadable library.
+ $show "$install_prog $dir/$dlname $destdir/$dlname"
+ $run eval "$install_prog $dir/$dlname $destdir/$dlname" || exit $?
+ fi
+
+ # Do each command in the postinstall commands.
+ lib="$destdir/$realname"
+ cmds=`eval echo \"$postinstall_cmds\"`
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=';'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ fi
+
+ # Install the pseudo-library for information purposes.
+ name=`echo "$file" | sed 's%^.*/%%'`
+ $show "$install_prog $file $destdir/$name"
+ $run $install_prog $file $destdir/$name || exit $?
+
+ # Maybe install the static library, too.
+ test -n "$old_library" && staticlibs="$staticlibs $dir/$old_library"
+ ;;
+
+ *.lo)
+ # Install (i.e. copy) a libtool object.
+
+ # Figure out destination file name, if it wasn't already specified.
+ if test -n "$destname"; then
+ destfile="$destdir/$destname"
+ else
+ destfile=`echo "$file" | sed 's%^.*/%%;'`
+ destfile="$destdir/$destfile"
+ fi
+
+ # Deduce the name of the destination old-style object file.
+ case "$destfile" in
+ *.lo)
+ staticdest=`echo "$destfile" | sed 's/\.lo$/\.o/;'`
+ ;;
+ *.o)
+ staticdest="$destfile"
+ destfile=
+ ;;
+ *)
+ echo "$progname: cannot copy a libtool object to \`$destfile'" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ ;;
+ esac
+
+ # Install the libtool object if requested.
+ if test -n "$destfile"; then
+ $show "$install_prog $file $destfile"
+ $run $install_prog $file $destfile || exit $?
+ fi
+
+ # Install the old object if enabled.
+ if test "$build_old_libs" = yes; then
+ # Deduce the name of the old-style object file.
+ staticobj=`echo "$file" | sed 's/\.lo$/\.o/;'`
+
+ $show "$install_prog $staticobj $staticdest"
+ $run $install_prog $staticobj $staticdest || exit $?
+ fi
+ exit 0
+ ;;
+
+ *)
+ # Do a test to see if this is really a libtool program.
+ if egrep "^# Generated by $PROGRAM" $file >/dev/null 2>&1; then
+ # This variable tells wrapper scripts just to set variables rather
+ # than running their programs.
+ libtool_install_magic="$magic"
+ link_against_libtool_libs=
+ finalize_command=
+
+ # If there is no directory component, then add one.
+ case "$file" in
+ */*) . $file ;;
+ *) . ./$file ;;
+ esac
+
+ # Check the variables that should have been set.
+ if test -z "$link_against_libtool_libs" || test -z "$finalize_command"; then
+ echo "$progname: invalid libtool wrapper script \`$file'" 1>&2
+ exit 1
+ fi
+
+ finalize=yes
+ for lib in $link_against_libtool_libs; do
+ # Check to see that each library is installed.
+ libdir=
+ if test -f "$lib"; then
+ # If there is no directory component, then add one.
+ case "$lib" in
+ */*) . $lib ;;
+ *) . ./$lib ;;
+ esac
+ fi
+ libfile="$libdir/`echo "$lib" | sed 's%^.*/%%g'`"
+ if test -z "$libdir"; then
+ echo "$progname: warning: \`$lib' contains no -rpath information" 1>&2
+ elif test -f "$libfile"; then :
+ else
+ echo "$progname: warning: \`$lib' has not been installed in \`$libdir'" 1>&2
+ finalize=no
+ fi
+ done
+
+ if test "$hardcode_action" = relink; then
+ if test "$finalize" = yes; then
+ echo "$progname: warning: relinking \`$file' on behalf of your buggy system linker" 1>&2
+ $show "$finalize_command"
+ if $run $finalize_command; then :
+ else
+ echo "$progname: error: relink \`$file' with the above command before installing it" 1>&2
+ continue
+ fi
+ file="$objdir/$file"T
+ else
+ echo "$progname: warning: cannot relink \`$file' on behalf of your buggy system linker" 1>&2
+ fi
+ else
+ # Install the binary that we compiled earlier.
+ dir=`echo "$file" | sed 's%/[^/]*$%%'`
+ if test "$file" = "$dir"; then
+ file="$objdir/$file"
+ else
+ file="$dir/$objdir/`echo "$file" | sed 's%^.*/%%'`"
+ fi
+ fi
+ fi
+
+ $show "$install_prog$stripme $file $dest"
+ $run $install_prog$stripme $file $dest || exit $?
+ ;;
+ esac
+ done
+
+ for file in $staticlibs; do
+ name=`echo "$file" | sed 's%^.*/%%'`
+
+ # Set up the ranlib parameters.
+ oldlib="$destdir/$name"
+
+ $show "$install_prog $file $oldlib"
+ $run $install_prog $file $oldlib || exit $?
+
+ # Support stripping libraries.
+ if test -n "$stripme"; then
+ if test -n "$old_striplib"; then
+ $show "$old_striplib $oldlib"
+ $run $old_striplib $oldlib || exit $?
+ else
+ echo "$progname: warning: no static library stripping program" 1>&2
+ fi
+ fi
+
+ # Do each command in the postinstall commands.
+ cmds=`eval echo \"$old_postinstall_cmds\"`
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=';'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd" || exit $?
+ done
+ IFS="$save_ifs"
+ done
+
+ if test -n "$future_libdirs"; then
+ echo "$progname: warning: remember to run \`$progname --finish$future_libdirs'" 1>&2
+ fi
+
+ if test -n "$current_libdirs"; then
+ # Maybe just do a dry run.
+ test -n "$run" && current_libdirs=" -n$current_libdirs"
+ exec $0 --finish$current_libdirs
+ exit 1
+ fi
+
+ exit 0
+ ;;
+
+ # libtool dlname mode
+ dlname)
+ progname="$progname: dlname"
+ ltlibs="$nonopt"
+ for lib
+ do
+ ltlibs="$ltlibs $lib"
+ done
+
+ if test -z "$ltlibs"; then
+ echo "$progname: you must specify at least one LTLIBRARY" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ # Now check to make sure each one is a valid libtool library.
+ status=0
+ for lib in $ltlibs; do
+ dlname=
+ libdir=
+ library_names=
+
+ # Check to see that this really is a libtool archive.
+ if egrep "^# Generated by $PROGRAM" $arg >/dev/null 2>&1; then :
+ else
+ echo "$progname: \`$arg' is not a valid libtool archive" 1>&2
+ status=1
+ continue
+ fi
+
+ # If there is no directory component, then add one.
+ case "$arg" in
+ */*) . $arg ;;
+ *) . ./$arg ;;
+ esac
+
+ if test -z "$libdir"; then
+ echo "$progname: \`$arg' contains no -rpath information" 1>&2
+ status=1
+ elif test -n "$dlname"; then
+ echo "$libdir/$dlname"
+ elif test -z "$library_names"; then
+ echo "$progname: \`$arg' is not a shared library" 1>&2
+ status=1
+ else
+ echo "$progname: \`$arg' was not linked with \`-export-dynamic'" 1>&2
+ status=1
+ fi
+ done
+ exit $status
+ ;;
+
+ # libtool finish mode
+ finish)
+ progname="$progname: finish"
+ libdirs="$nonopt"
+
+ if test -n "$finish_cmds" && test -n "$libdirs"; then
+ for dir
+ do
+ libdirs="$libdirs $dir"
+ done
+
+ for libdir in $libdirs; do
+ # Do each command in the postinstall commands.
+ cmds=`eval echo \"$finish_cmds\"`
+ IFS="${IFS= }"; save_ifs="$IFS"; IFS=';'
+ for cmd in $cmds; do
+ IFS="$save_ifs"
+ $show "$cmd"
+ $run eval "$cmd"
+ done
+ IFS="$save_ifs"
+ done
+ fi
+
+ echo "To link against installed libraries in LIBDIR, users may have to:"
+ if test -n "$shlibpath_var"; then
+ echo " - add LIBDIR to their \`$shlibpath_var' environment variable"
+ fi
+ echo " - use the \`-LLIBDIR' linker flag"
+ exit 0
+ ;;
+
+ # libtool uninstall mode
+ uninstall)
+ progname="$progname: uninstall"
+ rm="$nonopt"
+ files=
+
+ for arg
+ do
+ case "$arg" in
+ -*) rm="$rm $arg" ;;
+ *) files="$files $arg" ;;
+ esac
+ done
+
+ if test -z "$rm"; then
+ echo "$progname: you must specify an RM program" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ fi
+
+ for file in $files; do
+ dir=`echo "$file" | sed -e 's%/[^/]*$%%'`
+ test "$dir" = "$file" && dir=.
+ name=`echo "$file" | sed -e 's%^.*/%%'`
+
+ rmfiles="$file"
+
+ case "$name" in
+ *.la)
+ # Possibly a libtool archive, so verify it.
+ if egrep "^# Generated by $PROGRAM" $file >/dev/null 2>&1; then
+ . $dir/$name
+
+ # Delete the libtool libraries and symlinks.
+ for n in $library_names; do
+ rmfiles="$rmfiles $dir/$n"
+ test "X$n" = "X$dlname" && dlname=
+ done
+ test -n "$dlname" && rmfiles="$rmfiles $dir/$dlname"
+ test -n "$old_library" && rmfiles="$rmfiles $dir/$old_library"
+
+ # FIXME: should reinstall the best remaining shared library.
+ fi
+ ;;
+
+ *.lo)
+ if test "$build_old_libs" = yes; then
+ oldobj=`echo "$name" | sed 's/\.lo$/\.o/'`
+ rmfiles="$rmfiles $dir/$oldobj"
+ fi
+ ;;
+ esac
+
+ $show "$rm $rmfiles"
+ $run $rm $rmfiles
+ done
+ exit 0
+ ;;
+
+ NONE)
+ echo "$progname: you must specify a MODE" 1>&2
+ echo "$generic_help" 1>&2
+ exit 1
+ ;;
+ esac
+
+ echo "$progname: invalid operation mode \`$mode'" 1>&2
+ echo "$generic_help" 1>&2
+ exit 1
+fi # test -z "$show_help"
+
+# We need to display help for each of the modes.
+case "$mode" in
+NONE) cat <<EOF
+Usage: $progname [OPTION]... [MODE-ARG]...
+
+Provide generalized library-building support services.
+
+-n, --dry-run display commands without modifying any files
+ --features display configuration information and exit
+ --finish same as \`--mode=finish'
+ --help display this help message and exit
+ --mode=MODE use operation mode MODE [default=inferred from MODE-ARGS]
+ --version print version information
+
+MODE must be one of the following:
+
+ compile compile a source file into a libtool object
+ dlname print filenames to use to \`dlopen' libtool libraries
+ finish complete the installation of libtool libraries
+ install install libraries or executables
+ link create a library or an executable
+ uninstall remove libraries from an installed directory
+
+MODE-ARGS vary depending on the MODE. Try \`$progname --help --mode=MODE' for
+a more detailed description of MODE.
+EOF
+ ;;
+
+compile)
+ cat <<EOF
+Usage: $progname [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE
+
+Compile a source file into a libtool library object.
+
+COMPILE-COMMAND is a command to be used in creating a \`standard' object file
+from the given SOURCEFILE.
+
+The output file name is determined by removing the directory component from
+SOURCEFILE, then substituting the C source code suffix \`.c' with the
+library object suffix, \`.lo'.
+EOF
+ ;;
+
+dlname)
+ cat <<EOF
+Usage: $progname [OPTION]... --mode=dlname LTLIBRARY...
+
+Print filenames to use to \`dlopen' libtool libraries.
+
+Each LTLIBRARY is the name of a dynamically loadable libtool library (one that
+was linked using the \`-export-dynamic' option).
+
+The names to use are printed to standard output, one per line.
+EOF
+ ;;
+
+finish)
+ cat <<EOF
+Usage: $progname [OPTION]... --mode=finish [LIBDIR]...
+
+Complete the installation of libtool libraries.
+
+Each LIBDIR is a directory that contains libtool libraries.
+
+The commands that this mode executes may require superuser privileges. Use
+the \`--dry-run' option if you just want to see what would be executed.
+EOF
+ ;;
+
+install)
+ cat <<EOF
+Usage: $progname [OPTION]... --mode=install INSTALL-COMMAND...
+
+Install executables or libraries.
+
+INSTALL-COMMAND is the installation command. The first component should be
+either the \`install' or \`cp' program.
+
+The rest of the components are interpreted as arguments to that command (only
+BSD-compatible install options are recognized).
+EOF
+ ;;
+
+link)
+ cat <<EOF
+Usage: $progname [OPTION]... --mode=link LINK-COMMAND...
+
+Link object files or libraries together to form another library, or to
+create an executable program.
+
+LINK-COMMAND is a command using the C compiler that you would use to create
+a program from several object files.
+
+The following components of LINK-COMMAND are treated specially:
+
+ -allow-undefined allow a libtool library to reference undefined symbols
+ -export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3)
+ -LLIBDIR search LIBDIR for required installed libraries
+ -lNAME OUTPUT-FILE requires the installed library libNAME
+ -o OUTPUT-FILE create OUTPUT-FILE from the specified objects
+ -rpath LIBDIR the created library will eventually be installed in LIBDIR
+ -static do not do any dynamic linking or shared library creation
+ -version-info CURRENT[:REVISION[:AGE]]
+ specify library version info [each variable defaults to 0]
+
+All other options (arguments beginning with \`-') are ignored.
+
+Every other argument is treated as a filename. Files ending in \`.la' are
+treated as uninstalled libtool libraries, other files are standard or library
+object files.
+
+If the OUTPUT-FILE ends in \`.la', then a libtool library is created, only
+library objects (\`.lo' files) may be specified, and \`-rpath' is required.
+
+If OUTPUT-FILE ends in \`.a', then a standard library is created using \`ar'
+and \`ranlib'.
+
+If OUTPUT-FILE ends in \`.lo' or \`.o', then a reloadable object file is
+created, otherwise an executable program is created.
+EOF
+ ;;
+
+uninstall)
+ cat <<EOF
+Usage: $progname [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE...
+
+Remove libraries from an installation directory.
+
+RM is the name of the program to use to delete files associated with each FILE
+(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
+to RM.
+
+If FILE is a libtool library, all the files associated with it are deleted.
+Otherwise, only FILE itself is deleted using RM.
+EOF
+ ;;
+
+*)
+ echo "$progname: invalid operation mode \`$mode'" 1>&2
+ echo "$help" 1>&2
+ exit 1
+ ;;
+esac
+
+case "$mode" in
+archive|compile)
+ echo
+ echo "Try \`$progname --help' for more information about other modes."
+ ;;
+esac
+
+exit 0
+
+# Local Variables:
+# mode:shell-script
+# sh-indentation:2
+# End:
diff --git a/missing b/missing
new file mode 100755
index 00000000000..a6abd069801
--- /dev/null
+++ b/missing
@@ -0,0 +1,134 @@
+#! /bin/sh
+# Common stub for a few missing GNU programs while installing.
+# Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+# Franc,ois Pinard <pinard@iro.umontreal.ca>, 1996.
+
+# This program 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.
+
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+if test $# -eq 0; then
+ echo 1>&2 "Try \`$0 --help' for more information"
+ exit 1
+fi
+
+case "$1" in
+
+ -h|--h|--he|--hel|--help)
+ echo "\
+$0 [OPTION]... PROGRAM [ARGUMENT]...
+
+Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an
+error status if there is no known handling for PROGRAM.
+
+Options:
+ -h, --help display this help and exit
+ -v, --version output version information and exit
+
+Supported PROGRAM values:
+ aclocal touch file \`aclocal.m4'
+ autoconf touch file \`configure'
+ autoheader touch file \`config.h.in'
+ automake touch all \`Makefile.in' files
+ bison touch file \`y.tab.c'
+ makeinfo touch the output file
+ yacc touch file \`y.tab.c'"
+ ;;
+
+ -v|--v|--ve|--ver|--vers|--versi|--versio|--version)
+ echo "missing - GNU libit 0.0"
+ ;;
+
+ -*)
+ echo 1>&2 "$0: Unknown \`$1' option"
+ echo 1>&2 "Try \`$0 --help' for more information"
+ exit 1
+ ;;
+
+ aclocal)
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified \`acinclude.m4' or \`configure.in'. You might want
+ to install the \`Automake' and \`Perl' packages. Grab them from
+ any GNU archive site."
+ touch aclocal.m4
+ ;;
+
+ autoconf)
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified \`configure.in'. You might want to install the
+ \`Autoconf' and \`GNU m4' packages. Grab them from any GNU
+ archive site."
+ touch configure
+ ;;
+
+ autoheader)
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified \`acconfig.h' or \`configure.in'. You might want
+ to install the \`Autoconf' and \`GNU m4' packages. Grab them
+ from any GNU archive site."
+ touch config.h.in
+ ;;
+
+ automake)
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified \`Makefile.am', \`acinclude.m4' or \`configure.in'.
+ You might want to install the \`Automake' and \`Perl' packages.
+ Grab them from any GNU archive site."
+ find . -type f -name Makefile.am -print \
+ | sed 's/^\(.*\).am$/touch \1.in/' \
+ | sh
+ ;;
+
+ bison|yacc)
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified a \`.y' file. You may need the \`Bison' package
+ in order for those modifications to take effect. You can get
+ \`Bison' from any GNU archive site."
+ touch y.tab.c
+ ;;
+
+ makeinfo)
+ echo 1>&2 "\
+WARNING: \`$1' is missing on your system. You should only need it if
+ you modified a \`.texi' or \`.texinfo' file, or any other file
+ indirectly affecting the aspect of the manual. The spurious
+ call might also be the consequence of using a buggy \`make' (AIX,
+ DU, IRIX). You might want to install the \`Texinfo' package or
+ the \`GNU make' package. Grab either from any GNU archive site."
+ file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'`
+ if test -z "$file"; then
+ file=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'`
+ file=`sed -n '/^@setfilename/ { s/.* \([^ ]*\) *$/\1/; p; q; }' $file`
+ fi
+ touch $file
+ ;;
+
+ *)
+ echo 1>&2 "\
+WARNING: \`$1' is needed, and you do not seem to have it handy on your
+ system. You might have modified some files without having the
+ proper tools for further handling them. Check the \`README' file,
+ it often tells you about the needed prerequirements for installing
+ this package. You may also peek at any GNU archive site, in case
+ some other package would contain this missing \`$1' program."
+ exit 1
+ ;;
+esac
+
+exit 0
diff --git a/mkinstalldirs b/mkinstalldirs
new file mode 100755
index 00000000000..cc8783edce3
--- /dev/null
+++ b/mkinstalldirs
@@ -0,0 +1,36 @@
+#! /bin/sh
+# mkinstalldirs --- make directory hierarchy
+# Author: Noah Friedman <friedman@prep.ai.mit.edu>
+# Created: 1993-05-16
+# Last modified: 1994-03-25
+# Public domain
+
+errstatus=0
+
+for file in ${1+"$@"} ; do
+ set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
+ shift
+
+ pathcomp=
+ for d in ${1+"$@"} ; do
+ pathcomp="$pathcomp$d"
+ case "$pathcomp" in
+ -* ) pathcomp=./$pathcomp ;;
+ esac
+
+ if test ! -d "$pathcomp"; then
+ echo "mkdir $pathcomp" 1>&2
+ mkdir "$pathcomp" > /dev/null 2>&1 || lasterr=$?
+ fi
+
+ if test ! -d "$pathcomp"; then
+ errstatus=$lasterr
+ fi
+
+ pathcomp="$pathcomp/"
+ done
+done
+
+exit $errstatus
+
+# mkinstalldirs ends here
diff --git a/move-if-change b/move-if-change
new file mode 100755
index 00000000000..565825f35bc
--- /dev/null
+++ b/move-if-change
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+# Copyright (C) 1996 Free Software Foundation, Inc.
+#
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+if
+test -r $2
+then
+if
+cmp $1 $2 > /dev/null
+then
+echo $2 is unchanged
+rm -f $1
+else
+mv -f $1 $2
+fi
+else
+mv -f $1 $2
+fi
diff --git a/mpw-README b/mpw-README
new file mode 100644
index 00000000000..767140b5b26
--- /dev/null
+++ b/mpw-README
@@ -0,0 +1,376 @@
+This is basic information about the Macintosh(tm) MPW(tm) port of the
+GNU tools. The information below applies to both native and cross
+compilers.
+
+(Please note that there are two versions of this file; "mpw-README"
+is the source form, and "Read Me for MPW" is the distribution form.
+"Read Me for MPW" has 8-bit chars such as \Option-d embedded in it.)
+
+INSTALLING GNU TOOLS
+
+* System Requirements
+
+To use these tools, you will need a Mac with a 68020 or better or else
+any PowerMac, System 7.1 or later, and MPW 3.3 or 3.4. You will *not*
+need any other MPW compiler unless you want to rebuild from sources,
+nor even any include files, unless you are building actual Mac
+applications. For PowerMac native you will need PPCLink, however;
+also the executables are PowerPC-only.
+
+* Automated Installation
+
+The simplest way to install GNU tools is to run the Install script.
+The script will copy things to where you want to keep them, will build
+a UserStartup file with settings corresponding to where things were
+copied, and offer to put that UserStartup file in your MPW folder.
+
+The Install script does not alter anything in the System Folder, and
+it does not take any action without confirmation.
+
+The Install script will be at the top level of the binary
+distribution, or at the top level of the object directory if
+rebuilding from source. (The sources include a file called
+"mpw-install" at the top level, but it is the source to the Install
+script and cannot be run directly.)
+
+* Manual Installation
+
+If you don't want to run the Install script, you can do installation
+manually; this section describes the steps involved.
+
+The GNU tools can go in any directory that is in your {Commands} list.
+We generally put all the tools somewhere like {Boot}Cygnus:latest:bin,
+and then add to a UserStartup file:
+
+ set Commands "{Boot}Cygnus:latest:bin:,{Commands}"
+
+However, the cpp and cc1 programs of GCC are not normally stored here.
+Instead, they will be in a "lib" directory that is alongside "bin",
+and organized by target and version underneath, with names like
+
+ :lib:gcc-lib:<target>:cygnus-<version>:
+
+If you build and install everything yourself according to the build
+instructions below, then you will not have any problems. However, you
+may discover that GCC seems unable to find the right cpp and cc1;
+usually this will be because directory names have changed. (Even
+renaming your hard disk will make this happen.) In such cases, you
+have several choices. One is just to add this directory to
+{Commands}, but then you will not be able to get any other cpp or cc1,
+such as those used by a different target or version. Another way is
+to rename your disk and directories to match the prefix used when the
+tools were compiled. Finally, you can set the variable
+GCC_EXEC_PREFIX to point to the library directory:
+
+ set GCC_EXEC_PREFIX MyDisk:Stuff:lib:gcc-lib:
+ export GCC_EXEC_PREFIX
+
+You may also want to edit MPW's HEXA 128 resource. When GCC is built
+using a native GCC, it is compiled to use a special stack allocator
+function alloca(). While this is very efficient, it means that GCC
+will need considerable stack space to run, especially when compiling
+large programs with optimization turned on. You give MPW more stack
+by editing the HEXA 128 resource of the MPW Shell. A value of "0008
+0000" gives 512K of stack size, which is usually sufficient.
+
+USING GNU TOOLS
+
+* Using Native PowerMac GCC
+
+Using a native PowerMac GCC to produce MPW tools or MacOS applications
+is more complicated than just "gC foo.c", although no more complicated
+than with other Mac compilers.
+
+To build a native PowerMac MPW tool, use this sequence, where hello.c
+is the usual "hello world" program, and genericcfrg.r is the Rez file
+with the code fragment resource:
+
+gC -I{CIncludes} -fno-builtin -Dpascal= -c -g hello.c
+PPCLink hello.o -o hello \Option-d
+ "{PPCLibraries}"StdCRuntime.o \Option-d
+ "{SharedLibraries}"InterfaceLib \Option-d
+ "{SharedLibraries}"StdCLib \Option-d
+ "{PPCLibraries}"PPCToolLibs.o \Option-d
+ "{PPCLibraries}"PPCCRuntime.o \Option-d
+ "{GCCPPCLibraries}"libgcc.xcoff
+rez -d APPNAME='"'hello'"' GenericCFRG.r -o hello
+setfile -t 'MPST' -c 'MPS ' hello
+
+The same sequence works to build a MacOS application, but you set the file
+type to 'APPL' and don't link in PPCToolLibs.o. For further details on
+using MPW to build Mac applications, see the general MPW documentation.
+
+Recent versions of PPCLink have an option to generate the code
+fragment resource and automatically set creator and file type;
+here is what GenericCFRG.r should look like if you have an older
+PPCLink or are using GNU ld:
+
+#include "CodeFragmentTypes.r"
+
+resource 'cfrg' (0) {
+ {
+ kPowerPC,
+ kFullLib,
+ kNoVersionNum,kNoVersionNum,
+ 0,0,
+ kIsApp,kOnDiskFlat,kZeroOffset,kWholeFork,
+ APPNAME // must be defined on Rez command line with -d option
+ }
+};
+
+In general this port of GCC supports the same option syntax and
+behavior as its Unix counterpart. It also has similar compilation
+rules, so it will run the assembler on .s files and so forth.
+
+The GCC manual includes full information on the available options.
+One option that may be especially useful is "-v", which shows you what
+tools and options are being used; unlike most Mac C compilers, GCC
+directs assembly and linking in addition to compilation.
+
+MPW GCC does feature two extensions to the option syntax; '-d macro=name'
+works just as '-Dmacro=name' does in Unix, and '-i directory' works the
+same as '-Idirectory'.
+
+MPW GCC supports the usual Pascal-style strings and alignment pragmas.
+
+To find standard include files you can set the variable GCCIncludes:
+
+ set GCCIncludes MyDisk:MyIncludes:
+ export GCCIncludes
+
+GCCIncludes is similar to MPW's CIncludes or CW's MWCIncludes. In
+order to use MPW's usual include files, just say:
+
+ set GCCIncludes "{CIncludes}"
+ export GCCIncludes
+
+* Using GCC as a Cross-Compiler
+
+If you have a cross-compiler, and you have all of the correct
+target-side crt0 and libraries available, then to compile and link a
+file "foo.c", you can say just
+
+ gC foo.c
+
+The output file will be an MPW binary file named "a.out"; the format
+of the contents will depend on which target is in use, so for instance
+a MIPS-targeting GCC will produce ECOFF or ELF executables.
+
+Note that using MPW include files with a cross-compiler is somewhat
+dangerous.
+
+* Using the Assembler and Friends
+
+The assembler ("as") and linker ("ld") are faithful ports of their
+Unix counterparts. Similarly, the binutils "ar", "cplusfilt", "nm",
+"objcopy", "objdump", "ranlib", "size", "strings", and "strip" are all
+like they are under Unix. (Note that "cplusfilt" is usually called
+"c++filt" under Unix.)
+
+* Using GDB
+
+There are two flavors of GDB. "gdb" is an MPW tool that works very
+much like it does in Unix; put a command into the MPW worksheet and
+type the <enter> key to send it to GDB. While "gdb" is running, you
+cannot do anything else in MPW, although you can switch to other
+Mac applications and use them.
+
+"SiowGDB" is also a Mac application, but it is GDB using the SIOW
+package to provide console emulation. Commands are exactly as for the
+MPW tool, but since this is its own application, you can switch
+between it and MPW.
+
+BUILDING GNU TOOLS
+
+This port of the GNU tools uses a configure script similar to
+that used for GNU tools under Unix, but rewritten for MPW. As with
+Unix configuration, there is an "object" directory that may be
+different from the "source" directory. In the example commands below,
+we will assume that we are currently in the object directory, and that
+the source directory is "{Boot}Cygnus:src:".
+
+* Requirements for Building
+
+In addition to the sources, you will need a set of tools that the
+configure and build scripts assume to be available. These tools
+(and their versions, if relevant) are as follows:
+
+ byacc tool
+ flex (2.3.7) tool (and Flex.skel file)
+ forward-include script
+ MoveIfChange script
+ mpw-touch script
+ mpw-true script
+ NewFolderRecursive script
+ null-command script
+ open-brace script
+ sed (1.13) tool
+ tr-7to8 script
+ true script
+
+The scripts are in the sources, under utils:mpw:. You must arrange to
+get the other tools yourself (they are readily available from the
+"usual" net sites, and are also on many CDROMS). In addition, there
+will usually be a set of these available at ftp.cygnus.com, in pub/mac.
+
+You may put the build tools in your usual Tools or Scripts
+directories, or keep them in a separate directories. We prefer to
+make a directory called "buildtools" and we put this in one of our
+UserStartup files:
+
+ set Commands "{Boot}Cygnus:buildtools:,{Commands}"
+
+Flex uses an environment variable FLEX_SKELETON to locate its skeleton
+file, so you need to do something like this, preferably in a UserStartup:
+
+ Set FLEX_SKELETON "{Boot}"Cygnus:buildtools:Flex.skel
+ Export FLEX_SKELETON
+
+* Configuring
+
+Before you can build anything, you must configure. You do this by
+creating an directory where object files will be stored, setdirectory
+to that directory and do a configure command:
+
+ {Boot}Cygnus:src:mpw-configure --target <name> --cc <compiler> --srcdir {Boot}Cygnus:src: --prefix <whatever>
+
+If the source directory is not in your {Commands} list, then you must
+supply a full pathname to mpw-configure, since mpw-configure invokes
+itself after switching into each subdirectory. Using a relative
+pathname, even something like ':mpw-configure', will therefore not work.
+
+<name> must be a known target. Valid ones include "m68k-apple-macos",
+"powerpc-apple-macos", "i386-unknown-go32", "mips-idt-ecoff", and
+"sh-hitachi-hms". Not all target types are accepted for all of the
+tools yet.
+
+<compiler> must be the name of the compiler to use. It defaults to "mpwc".
+
+ (m68k)
+ mpwc MPW C
+ sc68k Symantec C
+ mwc68k Metrowerks C (Codewarrior)
+ gcc68k GCC
+
+ (powerpc)
+ ppcc PPCC
+ mrc Macintosh on RisC (Mister C, aka(?) Frankenstein)
+ scppc Symantec C
+ mwcppc Metrowerks C (Codewarrior)
+ gccppc GCC
+
+Not all compilers will compile all tools equally well! For m68k Macs,
+MPW C has the best record so far (it has problems, but they can be
+worked around), while for PowerMacs, CodeWarrior is the only compiler
+that has successfully compiled everything into running code.
+
+<prefix> is the path that "gcc" will prepend when looking for tools
+to execute. GCC_EXEC_PREFIX overrides this value, so you need not
+include it if you plan to use GCC_EXEC_PREFIX.
+
+As an example, here is the configure line that you could use to build
+native PowerMac GCC:
+
+"{Boot}"Cygnus:src:mpw-configure --cc mwcppc --target powerpc-apple-macos --srcdir "{Boot}"Cygnus:src: --prefix "{Boot}"GNUTools:
+
+* Building
+
+If you use CodeWarrior, you *must* first set MWCIncludes to
+{CIncludes}. This is because you will be building MPW tools, and
+their standard I/O works by making references to data that is part of
+the MPW Shell, which means that the code must be compiled and linked
+with macros that refer to that data, and those macros are in
+{CIncludes}, not the default {MWCIncludes}. Without this change, you
+will encounter problems compiling libiberty/mpw.c, but tweaking that
+file only masks the real problem, and does not fix it.
+
+The command
+
+ mpw-build
+
+will build everything. Building will take over an hour on a Quadra 800
+or PowerMac 8100/110, longer if the sources are on a shared volume.
+
+You may see some warnings; these are mostly likely benign, typically
+disagreements about declarations of library and system functions.
+
+* Installing
+
+To install the just-built tools, use the command
+
+ mpw-build install
+
+This part of the installation procedure just copies files to the
+location specified at configure time by <prefix>, and, in some cases,
+renames them from temporary internal names to their usual names. This
+install process is *not* the same as what the Install script does;
+Install can copy tools from the installation location chosen at
+configuration time to a user-chosen place, and sets up a UserStartup
+file. Note that while the Install script is optional, the install
+build action performs some tasks would be very hard to replicate
+manually, so you should always do it before using the tools.
+
+* Known Problems With Using Various Compilers to Build
+
+Most versions of MPW C have problems with compiling GNU software.
+
+MPW C 3.2.x has preprocessing bugs that render it incapable of
+compiling the BFD library, so it can't be used at all for building BFD.
+
+MPW C 3.3, 3.3.1, and 3.3.2 will spontaneously claim to have found
+errors in the source code, but in fact the code is perfectly fine. If
+this happens, just set the working directory back to the top-level
+objdir (where the configure command above was performed), and type
+"mpw-build all" again. If it goes on through the supposed error, then
+you got one of the spurious errors. A full build may require a number
+of these restarts.
+
+MPW C 3.3.3 seems to work OK, at least with the aid of a number of
+workarounds that are in the sources (look for #ifdef MPW_C).
+
+Versions of MPW Make earlier than 4.0d2 have exhibited bizarre behavior,
+failure to substitute variables and the like.
+
+Metrowerks CW6 PPC linker (MWLinkPPC) seems to do bad things with memory
+if the "Modern Memory Manager" is turned on (in the Memory control panel),
+but works OK if it is turned off.
+
+Metrowerks CW6 loses bigtime compiling opcodes:ppc-opc.c, which has
+some deeply nested macros. (CW7 is OK.) There is a way to patch the
+file, by substituting constant values. If you need to do this,
+contact shebs@cygnus.com for details.
+
+<Gestalt.h> is missing from {CIncludes} in the MPW version that comes
+with CW7. You can just copy the one in CW7's {MWCIncludes}.
+
+CW8 and later have changes to headers and such that will require changes
+to the source in order to be able to use them to rebuild.
+
+KNOWN BUGS
+
+The declarations for memcpy and memcmp in some versions of header files
+may conflict with GCC's builtin definition. Either use -fno-builtin
+or ignore the warnings.
+
+This is not a bug, but - watch out for cr/nl translation! For instance,
+if config/mpw-mh-mpw is not properly translated because it has been
+copied or updated separately, then everything will almost build, but
+you will get puzzling error messages from make or the compiler.
+
+'/' or ' ' embedded in any device, directory, or file name may or may
+not work.
+
+objcopy -O srec foo.o makes random output filenames.
+
+Mac-x-mips requires -mgas but Unix hosts don't.
+
+GDB will frequently require a '/' on the front of a device name in order
+to recognize it as an absolute rather than a relative pathname.
+
+GDB doesn't seem to use the printer port correctly, although it tries.
+
+The cursor doesn't always spin as much as it should. To get elaborate
+statistics and warnings about spin rates, add this to UserStartup:
+
+ set MEASURE_SPIN all
+ export MEASURE_SPIN
diff --git a/mpw-build.in b/mpw-build.in
new file mode 100644
index 00000000000..86d9530fa3b
--- /dev/null
+++ b/mpw-build.in
@@ -0,0 +1,204 @@
+# Top-level script fragment to build everything for MPW.
+
+Set savedir "`Directory`"
+
+#Set Echo 1
+
+Set ThisScript "{0}"
+
+Set objdir ":"
+
+Set verify 0
+
+Set BuildTarget "none"
+
+# Parse arguments.
+
+Loop
+ Break If {#} == 0
+ If "{BuildTarget}" =~ /none/
+ Set BuildTarget "{1}"
+ Else
+ Echo Only one build target allowed, ignoring "{1}"
+ End If
+ Shift 1
+End Loop
+
+If "{BuildTarget}" =~ /none/
+ Set BuildTarget "all"
+End If
+
+If {verify} == 1
+ Echo "#" Doing "{ThisScript}" "{BuildTarget}" in "`Directory`" ...
+End If
+
+Set ranmake 0
+
+If "`Exists Makefile`" != ""
+ Echo "Set Echo 1" >{BuildTarget}.makeout
+ Make -f Makefile {BuildTarget} >>{BuildTarget}.makeout
+ {BuildTarget}.makeout
+ Delete {BuildTarget}.makeout
+ Set ranmake 1
+End If
+
+If "`Exists Makefile.PPC`" != ""
+ Echo "Set Echo 1" >{BuildTarget}.makeout.ppc
+ Make -f Makefile.PPC {BuildTarget} >>{BuildTarget}.makeout.ppc
+ {BuildTarget}.makeout.ppc
+ Delete {BuildTarget}.makeout.ppc
+ Set ranmake 1
+End If
+
+If {ranmake} == 1
+ Exit
+End If
+
+# Dispatch on various pseudo-targets.
+
+If "{BuildTarget}" =~ /all/
+ Echo Started `Date`
+ "{ThisScript}" all-gcc
+ "{ThisScript}" all-gdb
+ Echo Finished `Date`
+Else If "{BuildTarget}" =~ /all-libiberty/
+ "{ThisScript}" do-libiberty
+Else If "{BuildTarget}" =~ /all-bfd/
+ "{ThisScript}" do-bfd
+Else If "{BuildTarget}" =~ /all-opcodes/
+ "{ThisScript}" do-opcodes
+Else If "{BuildTarget}" =~ /all-byacc/
+ "{ThisScript}" do-byacc
+Else If "{BuildTarget}" =~ /all-flex/
+ "{ThisScript}" all-libiberty
+ "{ThisScript}" do-flex
+Else If "{BuildTarget}" =~ /all-binutils/
+ "{ThisScript}" all-libiberty
+ "{ThisScript}" all-bfd
+ "{ThisScript}" all-opcodes
+ "{ThisScript}" do-binutils
+Else If "{BuildTarget}" =~ /all-gas/
+ "{ThisScript}" all-libiberty
+ "{ThisScript}" all-bfd
+ "{ThisScript}" all-opcodes
+ "{ThisScript}" do-gas
+Else If "{BuildTarget}" =~ /all-gcc/
+ "{ThisScript}" all-libiberty
+ "{ThisScript}" all-gas
+ "{ThisScript}" all-binutils
+ "{ThisScript}" all-ld
+ "{ThisScript}" do-gcc
+Else If "{BuildTarget}" =~ /all-gdb/
+ "{ThisScript}" all-libiberty
+ "{ThisScript}" all-bfd
+ "{ThisScript}" all-opcodes
+ "{ThisScript}" do-gdb
+Else If "{BuildTarget}" =~ /all-grez/
+ "{ThisScript}" all-libiberty
+ "{ThisScript}" all-bfd
+ "{ThisScript}" do-grez
+Else If "{BuildTarget}" =~ /all-ld/
+ "{ThisScript}" all-libiberty
+ "{ThisScript}" all-bfd
+ "{ThisScript}" all-opcodes
+ "{ThisScript}" do-ld
+Else If "{BuildTarget}" =~ /do-byacc/
+ SetDirectory :byacc:
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-flex/
+ SetDirectory :flex:
+ ::mpw-build _bootstrap
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-bfd/
+ SetDirectory :bfd:
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-libiberty/
+ SetDirectory :libiberty:
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-opcodes/
+ SetDirectory :opcodes:
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-binutils/
+ SetDirectory :binutils:
+ ::mpw-build stamps
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-gas/
+ SetDirectory :gas:
+ ::mpw-build stamps
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-gcc/
+ SetDirectory :gcc:
+ :mpw-build all
+Else If "{BuildTarget}" =~ /do-gdb/
+ SetDirectory :gdb:
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-grez/
+ SetDirectory :grez:
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-ld/
+ SetDirectory :ld:
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /do-newlib/
+ SetDirectory :newlib:
+ ::mpw-build all
+Else If "{BuildTarget}" =~ /install/
+ "{ThisScript}" install-only-top
+ "{ThisScript}" install-binutils
+ "{ThisScript}" install-gas
+ "{ThisScript}" install-gcc
+ "{ThisScript}" install-ld
+ "{ThisScript}" install-gdb
+Else If "{BuildTarget}" =~ /install-binutils/
+ SetDirectory :binutils:
+ ::mpw-build install
+Else If "{BuildTarget}" =~ /install-gas/
+ SetDirectory :gas:
+ ::mpw-build install
+Else If "{BuildTarget}" =~ /install-gcc/
+ SetDirectory :gcc:
+ :mpw-build install
+Else If "{BuildTarget}" =~ /install-gdb/
+ SetDirectory :gdb:
+ ::mpw-build install
+Else If "{BuildTarget}" =~ /install-grez/
+ SetDirectory :grez:
+ ::mpw-build install
+Else If "{BuildTarget}" =~ /install-ld/
+ SetDirectory :ld:
+ ::mpw-build install
+Else If "{BuildTarget}" =~ /install-only/
+ "{ThisScript}" install-only-top
+ "{ThisScript}" install-only-binutils
+ "{ThisScript}" install-only-gas
+ "{ThisScript}" install-only-gcc
+ "{ThisScript}" install-only-gdb
+ "{ThisScript}" install-only-ld
+Else If "{BuildTarget}" =~ /install-only-binutils/
+ SetDirectory :binutils:
+ ::mpw-build install-only
+Else If "{BuildTarget}" =~ /install-only-gas/
+ SetDirectory :gas:
+ ::mpw-build install-only
+Else If "{BuildTarget}" =~ /install-only-gcc/
+ SetDirectory :gcc:
+ :mpw-build install-only
+Else If "{BuildTarget}" =~ /install-only-gdb/
+ SetDirectory :gdb:
+ ::mpw-build install-only
+Else If "{BuildTarget}" =~ /install-only-grez/
+ SetDirectory :grez:
+ ::mpw-build install-only
+Else If "{BuildTarget}" =~ /install-only-ld/
+ SetDirectory :ld:
+ ::mpw-build install-only
+Else If "{BuildTarget}" =~ /install-only-top/
+ NewFolderRecursive "{prefix}"
+ If "{prefix}" != "`Directory`"
+ Duplicate -y 'Read Me for MPW' "{prefix}"'Read Me for MPW'
+ Duplicate -y Install "{prefix}"Install
+ End If
+Else
+ Echo {BuildTarget} not understood, ignoring
+End If
+
+SetDirectory "{savedir}"
diff --git a/mpw-config.in b/mpw-config.in
new file mode 100644
index 00000000000..8028737a8b6
--- /dev/null
+++ b/mpw-config.in
@@ -0,0 +1,113 @@
+# Configuration fragment for Cygnus source tree.
+
+# Check that we can find all the special tools that we will need.
+# The test for sed is semi-pointless, because it's already been invoked
+# by the calculation of target_cpu in the main configure script, but
+# the test will also show which one is being used.
+
+Set Exit 0
+Echo byacc is `Which byacc`
+Echo flex is `Which flex`
+Echo forward-include is `Which forward-include`
+Echo MoveIfChange is `Which MoveIfChange`
+Echo mpw-touch is `Which mpw-touch`
+Echo mpw-true is `Which mpw-true`
+Echo NewFolderRecursive is `Which NewFolderRecursive`
+Echo null-command is `Which null-command`
+Echo open-brace is `Which open-brace`
+Echo sed is `Which sed`
+Echo 'tr-7to8' is `Which tr-7to8`
+Echo true is `Which true`
+Set Exit 1
+
+Set host_libs "mmalloc libiberty opcodes bfd readline gash tcl tk tclX"
+
+Set host_tools "texinfo byacc flex bison binutils ld gas gcc gdb make patch \Option-d
+ prms send-pr gprof gdbtest tgas etc expect dejagnu sim bash \Option-d
+ m4 autoconf ispell grep diff rcs cvs fileutils shellutils time \Option-d
+ textutils wdiff find emacs emacs19 uudecode hello tar gzip indent \Option-d
+ recode release sed utils guile perl apache inet gawk"
+
+Set target_libs "newlib"
+
+Set target_tools "examples"
+
+# Configure the resource compiler if targeting Macs.
+If {target_os} =~ /macos/ || {target_os} =~ /mpw/
+ Set host_tools "{host_tools} grez"
+End If
+
+Set configdirs "{host_libs} {host_tools} {target_libs} {target_tools}"
+Export configdirs
+
+# Make up a special include directory that tools will share.
+
+If "`Exists "{objdir}"extra-include`" == ""
+ NewFolder "{objdir}"extra-include
+End If
+
+Set edir "{objdir}extra-include:"
+
+forward-include "{srcdir}"include:mpw:sys:file.h "{edir}"'sys/file.h'
+forward-include "{srcdir}"include:mpw:sys:ioctl.h "{edir}"'sys/ioctl.h'
+forward-include "{srcdir}"include:mpw:sys:param.h "{edir}"'sys/param.h'
+forward-include "{srcdir}"include:mpw:sys:resource.h "{edir}"'sys/resource.h'
+forward-include "{srcdir}"include:mpw:sys:stat.h "{edir}"'sys/stat.h'
+forward-include "{srcdir}"include:mpw:sys:time.h "{edir}"'sys/time.h'
+forward-include "{srcdir}"include:mpw:sys:types.h "{edir}"'sys/types.h'
+
+forward-include "{srcroot}"include:aout:aout64.h "{edir}"'aout/aout64.h'
+forward-include "{srcroot}"include:aout:ar.h "{edir}"'aout/ar.h'
+forward-include "{srcroot}"include:aout:ranlib.h "{edir}"'aout/ranlib.h'
+forward-include "{srcroot}"include:aout:reloc.h "{edir}"'aout/reloc.h'
+forward-include "{srcroot}"include:aout:stab.def "{edir}"'aout/stab.def'
+forward-include "{srcroot}"include:aout:stab_gnu.h "{edir}"'aout/stab_gnu.h'
+
+If "`Exists "{srcroot}"include:aout:"{target_cpu}".h`" != ""
+ forward-include "{srcroot}"include:aout:"{target_cpu}".h "{edir}"'aout/'"{target_cpu}"'.h'
+End If
+
+forward-include "{srcroot}"include:coff:ecoff.h "{edir}"'coff/ecoff.h'
+forward-include "{srcroot}"include:coff:internal.h "{edir}"'coff/internal.h'
+forward-include "{srcroot}"include:coff:sym.h "{edir}"'coff/sym.h'
+forward-include "{srcroot}"include:coff:symconst.h "{edir}"'coff/symconst.h'
+
+If "`Exists "{srcroot}"include:coff:"{target_cpu}".h`" != ""
+ forward-include "{srcroot}"include:coff:"{target_cpu}".h "{edir}"'coff/'"{target_cpu}"'.h'
+End If
+If "{target_cpu}" =~ /powerpc/
+ forward-include "{srcroot}"include:coff:rs6000.h "{edir}"'coff/rs6000.h'
+End If
+
+forward-include "{srcroot}"include:elf:common.h "{edir}"'elf/common.h'
+forward-include "{srcroot}"include:elf:dwarf.h "{edir}"'elf/dwarf.h'
+forward-include "{srcroot}"include:elf:dwarf2.h "{edir}"'elf/dwarf2.h'
+forward-include "{srcroot}"include:elf:external.h "{edir}"'elf/external.h'
+forward-include "{srcroot}"include:elf:internal.h "{edir}"'elf/internal.h'
+
+# Believe it or not, GDB needs this for all targets.
+forward-include "{srcroot}"include:elf:mips.h "{edir}"'elf/mips.h'
+
+If "`Exists "{srcroot}"include:elf:"{target_cpu}".h`" != ""
+ forward-include "{srcroot}"include:elf:"{target_cpu}".h "{edir}"'elf/'"{target_cpu}"'.h'
+End If
+If "{target_cpu}" =~ /powerpc/
+ forward-include "{srcroot}"include:elf:ppc.h "{edir}"'elf/ppc.h'
+End If
+
+If "`Exists "{srcroot}"include:opcode:"{target_cpu}".h`" != ""
+ forward-include "{srcroot}"include:opcode:"{target_cpu}".h "{edir}"'opcode/'"{target_cpu}"'.h'
+End If
+If "{target_cpu}" =~ /powerpc/
+ forward-include "{srcroot}"include:opcode:ppc.h "{edir}"'opcode/ppc.h'
+End If
+
+# Add some bfd includes that get mentioned outside the bfd dir.
+
+forward-include "{srcroot}"bfd:libcoff.h "{edir}"'bfd/libcoff.h'
+forward-include "{srcroot}"bfd:libecoff.h "{edir}"'bfd/libecoff.h'
+
+# Translate random files into MPW-only character set.
+
+tr-7to8 "{srcdir}"mpw-README > "{objdir}Read Me for MPW"
+tr-7to8 "{srcdir}"mpw-install > "{objdir}"Install
diff --git a/mpw-configure b/mpw-configure
new file mode 100644
index 00000000000..cf45148ec63
--- /dev/null
+++ b/mpw-configure
@@ -0,0 +1,448 @@
+# Configuration script
+# Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+### WARNING
+### This script must NOT use any 8-bit chars!
+### WARNING
+
+# This is an MPW Shell script that sets everything up for compilation,
+# mainly creating directories, and editing copies of files.
+
+Set savedir "`Directory`"
+
+#Set Echo 1
+
+Set ThisScript "{0}"
+
+Set srcroot "--------"
+
+Set srcdir ":"
+
+Set objdir ":"
+
+Set prefix "{MPW}":GNUTools:
+
+Set exec_prefix ""
+
+Set bindir ""
+
+Set host_alias "m68k-apple-mpw"
+
+Set target_alias {host_alias}
+
+Set host_cc "mpwc"
+
+Set with_gnu_ld 0
+
+Set helpoutput 0
+
+Set recurse 1
+
+Set verify 0
+Set verifystr ""
+
+Set enable_options ""
+Set disable_options ""
+
+# Parse arguments.
+
+Loop
+ Break If {#} == 0
+ If "{1}" =~ /--cc/
+ Set host_cc "{2}"
+ Shift 1
+ Else If "{1}" =~ /--bindir/
+ Set bindir "{2}"
+ Shift 1
+ Else If "{1}" =~ /--disable-?+/
+ Set `Echo {1} | sed -e 's/--disable-/enable_/'` no
+ Set disable_options "{disable_options} '{1}'"
+ Else If "{1}" =~ /--enable-?+/
+ Set `Echo {1} | sed -e 's/--enable-/enable_/'` yes
+ Set enable_options "{enable_options} '{1}'"
+ Else If "{1}" =~ /--exec-prefix/
+ Set exec_prefix "{2}"
+ Shift 1
+ Else If "{1}" =~ /--help/
+ Set helpoutput 1
+ Else If "{1}" =~ /--host/
+ Set host_alias "{2}"
+ Shift 1
+ Else If "{1}" =~ /--norecursion/
+ Set recurse 0
+ Else If "{1}" =~ /--prefix/
+ Set prefix "{2}"
+ Shift 1
+ Else If "{1}" =~ /--srcdir/
+ Set srcdir "{2}"
+ Shift 1
+ Else If "{1}" =~ /--srcroot/
+ Set srcroot "{2}"
+ Shift 1
+ Else If "{1}" =~ /--target/
+ Set target_alias "{2}"
+ Shift 1
+ Else If "{1}" =~ /-v/
+ Set verify 1
+ Set verifystr "-v"
+ Else If "{1}" =~ /--with-gnu-ld/
+ Set with_gnu_ld 1
+ Else
+ Echo -n 'mpw-configure: Unrecognized option: "'
+ Echo -n "{1}"
+ Echo '"; use --help for usage.'
+ Exit 1
+ End If
+ Shift 1
+End Loop
+
+If {helpoutput} == 1
+ Echo "Usage: mpw-configure [OPTIONS]"
+ Echo ""
+ Echo "Options: [defaults in brackets]"
+ Echo "--bindir DIR directory for binaries []"
+ Echo "--cc CC use C compiler CC [mpwc]"
+ Echo "--disable-FOO do not include feature FOO"
+ Echo "--enable-FOO include feature FOO"
+ Echo "--exec-prefix DIR install host-dependent files into DIR []"
+ Echo "--help print this message"
+ Echo "--host HOST configure for HOST [m68k-apple-mpw]"
+ Echo "--norecursion configure this directory only [recurse]"
+ Echo "--prefix DIR install into DIR [{MPW}:GNUTools:]"
+ Echo "--srcdir DIR find the sources in DIR [:]"
+ Echo "--srcroot DIR find the toplevel sources in DIR [:]"
+ Echo "--target TARGET configure for TARGET [TARGET=HOST]"
+ Echo "-v verbose"
+ Echo "--with-gnu-ld link using GNU ld [no]"
+ Exit 0
+End If
+
+Set Exit 0
+
+# Default exec_prefix from prefix.
+
+If "{exec_prefix}" == ""
+ Set exec_prefix "{prefix}"
+End If
+
+If "{bindir}" == ""
+ Set bindir "{prefix}"bin:
+End If
+
+# Point to the correct set of tools to use with the chosen compiler.
+
+If "{host_cc}" =~ /mpwc/
+ Set host_alias "m68k-apple-mpw"
+ Set cc_name '{CC_MPW_C}'
+ Set segment_flag '-s '
+ Set ar_name '{AR_LIB}'
+ Set ranlib_name '{RANLIB_NULL}'
+ Set cc_ld_name '{CC_LD_LINK}'
+ Set prog_ext_name '{PROG_EXT_68K}'
+ Set extralibs_name '{EXTRALIBS_C}'
+ Set makepef_name '{MAKEPEF_NULL}'
+ Set rez_name '{REZ_68K}'
+Else If "{host_cc}" =~ /sc68k/
+ Set host_alias "m68k-apple-mpw"
+ Set cc_name '{CC_SC}'
+ Set segment_flag '-s '
+ Set ar_name '{AR_LIB}'
+ Set ranlib_name '{RANLIB_NULL}'
+ Set cc_ld_name '{CC_LD_LINK}'
+ Set prog_ext_name '{PROG_EXT_68K}'
+ Set extralibs_name '{EXTRALIBS_C}'
+ Set makepef_name '{MAKEPEF_NULL}'
+ Set rez_name '{REZ_68K}'
+Else If "{host_cc}" =~ /mwc68k/
+ Set host_alias "m68k-apple-mpw"
+ Set cc_name '{CC_MWC68K}'
+ Set segment_flag '-s '
+ Set ar_name '{AR_MWLINK68K}'
+ Set ranlib_name '{RANLIB_NULL}'
+ Set cc_ld_name '{CC_LD_MWLINK68K}'
+ Set prog_ext_name '{PROG_EXT_68K}'
+ Set extralibs_name '{EXTRALIBS_MWC68K}'
+ Set makepef_name '{MAKEPEF_NULL}'
+ Set rez_name '{REZ_68K}'
+Else If "{host_cc}" =~ /gcc68k/
+ Set host_alias "m68k-apple-mpw"
+ Set cc_name '{CC_68K_GCC}'
+ Set segment_flag '-s '
+ Set ar_name '{AR_68K_AR}'
+ Set ranlib_name '{RANLIB_RANLIB}'
+ Set cc_ld_name '{CC_68K_GCC}'
+ Set prog_ext_name '{PROG_EXT_68K}'
+ Set extralibs_name '{EXTRALIBS_C}'
+ Set makepef_name '{MAKEPEF_NULL}'
+ Set rez_name '{REZ_68K}'
+Else If "{host_cc}" =~ /ppcc/
+ Set host_alias "powerpc-apple-mpw"
+ Set cc_name '{CC_PPCC}'
+ Set segment_flag '-d ___s_e_g___='
+ Set ar_name '{AR_PPCLINK}'
+ Set ranlib_name '{RANLIB_NULL}'
+ Set cc_ld_name '{CC_LD_PPCLINK}'
+ Set prog_ext_name '{PROG_EXT_XCOFF}'
+ Set extralibs_name '{EXTRALIBS_PPC}'
+ Set makepef_name '{MAKEPEF_PPC}'
+ Set rez_name '{REZ_PPC}'
+Else If "{host_cc}" =~ /mrc/
+ Set host_alias "powerpc-apple-mpw"
+ Set cc_name '{CC_MRC}'
+ Set segment_flag '-d ___s_e_g___='
+ Set ar_name '{AR_PPCLINK}'
+ Set ranlib_name '{RANLIB_NULL}'
+ Set cc_ld_name '{CC_LD_PPCLINK}'
+ Set prog_ext_name '{PROG_EXT_XCOFF}'
+ Set extralibs_name '{EXTRALIBS_PPC}'
+ Set makepef_name '{MAKEPEF_PPC}'
+ Set rez_name '{REZ_PPC}'
+Else If "{host_cc}" =~ /scppc/
+ Set host_alias "powerpc-apple-mpw"
+ Set cc_name '{CC_SC}'
+ Set segment_flag '-d ___s_e_g___='
+ Set ar_name '{AR_PPCLINK}'
+ Set ranlib_name '{RANLIB_NULL}'
+ Set cc_ld_name '{CC_LD_PPCLINK}'
+ Set prog_ext_name '{PROG_EXT_XCOFF}'
+ Set extralibs_name '{EXTRALIBS_PPC}'
+ Set makepef_name '{MAKEPEF_PPC}'
+ Set rez_name '{REZ_PPC}'
+Else If "{host_cc}" =~ /mwcppc/
+ Set host_alias "powerpc-apple-mpw"
+ Set cc_name '{CC_MWCPPC}'
+ Set segment_flag '-d ___s_e_g___='
+ Set ar_name '{AR_MWLINKPPC}'
+ Set ranlib_name '{RANLIB_NULL}'
+ Set cc_ld_name '{CC_LD_MWLINKPPC}'
+ # Misleading, but we don't need a PEF step.
+ Set prog_ext_name '{PROG_EXT_68K}'
+ Set extralibs_name '{EXTRALIBS_MWCPPC}'
+ Set makepef_name '{MAKEPEF_NULL}'
+ Set rez_name '{REZ_PPC}'
+Else If "{host_cc}" =~ /gccppc/
+ Set host_alias "powerpc-apple-mpw"
+ Set cc_name '{CC_PPC_GCC}'
+ Set segment_flag '-d ___s_e_g___='
+ Set ar_name '{AR_PPCLINK}'
+ If {with_gnu_ld} == 1
+ Set ranlib_name '{RANLIB_RANLIB}'
+ Set cc_ld_name '{CC_LD_GLD}'
+ Else
+ Set ranlib_name '{RANLIB_NULL}'
+ Set cc_ld_name '{CC_LD_PPCLINK}'
+ End If
+ Set prog_ext_name '{PROG_EXT_XCOFF}'
+ Set extralibs_name '{EXTRALIBS_PPC}'
+ Set makepef_name '{MAKEPEF_PPC}'
+ Set rez_name '{REZ_PPC}'
+Else
+ Echo "{host_cc}" is not a known MPW compiler type
+End If
+
+Set dash_c_flag ''
+If "{host_cc}" =~ /gcc68k/
+ Set dash_c_flag '-c'
+Else If "{host_cc}" =~ /gccppc/
+ Set dash_c_flag '-c'
+End If
+
+# (should interpret aliases if not in canonical form)
+
+Set host_canonical "{host_alias}"
+
+Set target_canonical "{target_alias}"
+
+Set configdirs ""
+
+If "{srcroot}" =~ /--------/
+ Set srcroot "{srcdir}"
+End If
+If "`Exists "{srcdir}"`" == ""
+ Echo Source directory {srcdir} does not exist!
+ Exit 1
+End If
+If "`Exists "{srcroot}"`" == ""
+ Echo Top-level source directory {srcroot} does not exist!
+ Exit 1
+End If
+
+Set target_cpu "`echo {target_canonical} | sed 's/^\(.*\)-\(.*\)-\(.*\)$/\1/'`"
+Set target_vendor "`echo {target_canonical} | sed 's/^\(.*\)-\(.*\)-\(.*\)$/\2/'`"
+Set target_os "`echo {target_canonical} | sed 's/^\(.*\)-\(.*\)-\(.*\)$/\3/'`"
+
+# Create a file that is guaranteed to be older than any other here.
+
+If "`Exists "{objdir}"_oldest`" == ""
+ mpw-touch _oldest
+End If
+
+# Record this before creating any files, makefiles sometimes mention
+# dependencies on config.status.
+
+Echo "# This directory was configured as follows:" >config.new
+Echo "{ThisScript} --host {host_alias} --target {target_alias} --srcdir {srcdir} --srcroot {srcroot} --prefix {prefix} --cc {host_cc} {verifystr} {enable_options} {disable_options} --norecursion" >>config.new
+MoveIfChange config.new config.status
+
+If "`Exists "{srcdir}"mpw-config.in`" != ""
+ tr-7to8 "{srcdir}"mpw-config.in >"{objdir}"mpw-config.in
+ Execute "{objdir}"mpw-config.in
+End If
+
+# Start Makefile construction by defining all the variables chosen by
+# configuration.
+
+Echo "# This Makefile produced by mpw-configure. Changes may get lost!" > "{objdir}"Makefile.tem
+Echo "srcroot = " {srcroot} >> "{objdir}"Makefile.tem
+Echo "topsrcdir = " {srcroot} >> "{objdir}"Makefile.tem
+Echo "srcdir = " {srcdir} >> "{objdir}"Makefile.tem
+Echo "mpw_prefix = " {prefix} >> "{objdir}"Makefile.tem
+Echo "mpw_exec_prefix = " {exec_prefix} >> "{objdir}"Makefile.tem
+Echo "mpw_bindir = " {bindir} >> "{objdir}"Makefile.tem
+Echo "host_alias = " {host_alias} >> "{objdir}"Makefile.tem
+Echo "target_alias = " {target_alias} >> "{objdir}"Makefile.tem
+Echo "target_cpu = " {target_cpu} >> "{objdir}"Makefile.tem
+Echo "target_vendor = " {target_vendor} >> "{objdir}"Makefile.tem
+Echo "target_os = " {target_os} >> "{objdir}"Makefile.tem
+Echo "target_canonical = " {target_canonical} >> "{objdir}"Makefile.tem
+Echo "host_makefile_frag = " >> "{objdir}"Makefile.tem
+Echo "target_makefile_frag = " >> "{objdir}"Makefile.tem
+Echo "CC = " {cc_name} >> "{objdir}"Makefile.tem
+Echo "AR = " {ar_name} >> "{objdir}"Makefile.tem
+Echo "RANLIB = " {ranlib_name} >> "{objdir}"Makefile.tem
+Echo "CC_LD = " {cc_ld_name} >> "{objdir}"Makefile.tem
+Echo "PROG_EXT = " {prog_ext_name} >> "{objdir}"Makefile.tem
+Echo "EXTRALIBS = " {extralibs_name} >> "{objdir}"Makefile.tem
+Echo "MAKEPEF = " {makepef_name} >> "{objdir}"Makefile.tem
+Echo "REZ = " {rez_name} >> "{objdir}"Makefile.tem
+
+If {host_cc} =~ /gccppc/
+ Echo -n "dq =\Option-d\Option-d\Option-d" > "{objdir}"Makefile.tem0
+ Echo '"' >> "{objdir}"Makefile.tem0
+ tr-7to8 "{objdir}"Makefile.tem0 >>"{objdir}"Makefile.tem
+Else
+ Echo -n "dq ='" >> "{objdir}"Makefile.tem
+ Echo -n '"' >> "{objdir}"Makefile.tem
+ Echo "'" >> "{objdir}"Makefile.tem
+End If
+
+# Append the master set of definitions for the various compilers.
+
+If "`Exists "{srcdir}"config:mpw-mh-mpw`" != ""
+ tr-7to8 "{srcdir}"config:mpw-mh-mpw >>"{objdir}"Makefile.tem
+Else If "`Exists "{srcroot}"config:mpw-mh-mpw`" != ""
+ tr-7to8 "{srcroot}"config:mpw-mh-mpw >>"{objdir}"Makefile.tem
+Else
+ Echo "can't find a host config file!"
+ Exit 0
+End If
+
+# Append anything produced by the directory's mpw-config.in.
+
+If "`Exists "{objdir}"mk.tmp`" != ""
+ Catenate "{objdir}"mk.tmp >>"{objdir}"Makefile.tem
+ # An mpw-config.in might change so as not to create this
+ # anymore, so get rid of it now to be safe.
+ Delete -i -y "{objdir}"mk.tmp
+End If
+
+# If there are sed scripts to edit the Unix Makefile.in, use them; otherwise
+# use an mpw-make.in if present.
+
+If "`Exists "{srcdir}"mpw-make.sed`" != ""
+ If "`Exists "{objdir}"hacked_Makefile.in`" != ""
+ Set MakefileIn "{objdir}"hacked_Makefile.in
+ Else
+ Set MakefileIn "{srcdir}"Makefile.in
+ End If
+ # Find the generic makefile editing script.
+ If "`Exists "{srcroot}"config:mpw:g-mpw-make.sed`" != ""
+ sed -f "{srcroot}"config:mpw:g-mpw-make.sed "{MakefileIn}" >"{objdir}"Makefile.tem1
+ Else If "`Exists "{srcroot}"utils:mpw:g-mpw-make.sed`" != ""
+ sed -f "{srcroot}"utils:mpw:g-mpw-make.sed "{MakefileIn}" >"{objdir}"Makefile.tem1
+ Else If "`Exists "{srcdir}"g-mpw-make.sed`" != ""
+ sed -f "{srcdir}"g-mpw-make.sed "{MakefileIn}" >"{objdir}"Makefile.tem1
+ Else
+ Echo Warning: g-mpw-make.sed not found, copying "{MakefileIn}" verbatim...
+ Catenate "{MakefileIn}" >"{objdir}"Makefile.tem1
+ End If
+ sed -f "{srcdir}"mpw-make.sed "{objdir}"Makefile.tem1 >"{objdir}"Makefile.tem2
+ sed -e 's/^prefix = .*$/prefix = {mpw_prefix}/g' -e 's/^exec_prefix = .*$/exec_prefix = {mpw_exec_prefix}/g' -e 's/^bindir = @bindir@/bindir = {mpw_bindir}/g' "{objdir}"Makefile.tem2 >"{objdir}"Makefile.tem3
+ sed -e "s/@DASH_C_FLAG@/{dash_c_flag}/" -e "s/@SEGMENT_FLAG(\([^)]*\))@/{segment_flag}\1/" "{objdir}"Makefile.tem3 >"{objdir}"mpw-make.in
+ tr-7to8 "{objdir}"mpw-make.in >>"{objdir}"Makefile.tem
+ If "`Exists "{objdir}"mk.sed`" != ""
+ sed -f "{objdir}"mk.sed "{objdir}"Makefile.tem >"{objdir}"Makefile.tem2
+ Rename -y "{objdir}"Makefile.tem2 "{objdir}"Makefile.tem
+ End If
+ MoveIfChange "{objdir}"Makefile.tem "{objdir}"Makefile
+ Delete -i -y "{objdir}"Makefile.tem[12]
+ If {verify} == 1
+ Echo Created Makefile in "`Directory`"
+ End If
+Else If "`Exists "{srcdir}"mpw-make.in`" != ""
+ sed -e 's/^prefix = .*$/prefix = {mpw_prefix}/g' "{srcdir}"mpw-make.in >"{objdir}"Makefile.tem1
+ sed -e "s/@DASH_C_FLAG@/{dash_c_flag}/" -e "s/@SEGMENT_FLAG(\([^)]*\))@/{segment_flag}}\1/" "{objdir}"Makefile.tem1 >"{objdir}"Makefile.tem2
+ tr-7to8 "{objdir}"Makefile.tem2 >>"{objdir}"Makefile.tem
+ If "`Exists "{objdir}"mk.sed`" != ""
+ sed -f "{objdir}"mk.sed "{objdir}"Makefile.tem >"{objdir}"Makefile.tem2
+ Rename -y "{objdir}"Makefile.tem2 "{objdir}"Makefile.tem
+ End If
+ MoveIfChange "{objdir}"Makefile.tem "{objdir}"Makefile
+ Delete -i -y "{objdir}"Makefile.tem[12]
+ If {verify} == 1
+ Echo Created Makefile in "`Directory`"
+ End If
+End If
+
+# Produce a build script if the source is defined.
+
+If "`Exists "{srcdir}"mpw-build.in`" != ""
+ Echo "Set srcroot " {srcroot} > "{objdir}"mpw-build.tem
+ Echo "Set srcdir " {srcdir} >> "{objdir}"mpw-build.tem
+ Echo "Set target_canonical " {target_canonical} >> "{objdir}"mpw-build.tem
+ Echo "Set prefix " {prefix} >> "{objdir}"mpw-build.tem
+ tr-7to8 "{srcdir}"mpw-build.in >>"{objdir}"mpw-build.tem
+ MoveIfChange "{objdir}"mpw-build.tem "{objdir}"mpw-build
+ If {verify} == 1
+ Echo Created mpw-build in "`Directory`"
+ End If
+End If
+
+# Apply ourselves recursively to the list of subdirectories to configure.
+
+If {recurse} == 1
+ For subdir In {configdirs}
+ Set savedir "`Directory`"
+ If "`Exists "{srcdir}{subdir}:"`" == ""
+ If {verify} == 1
+ Echo No "{srcdir}{subdir}:" found, skipping
+ End If
+ Continue
+ End If
+ If {verify} == 1
+ Echo Configuring {subdir}...
+ End If
+ If "`Exists "{objdir}{subdir}:"`" == ""
+ NewFolder "{objdir}{subdir}"
+ End If
+ SetDirectory "{objdir}{subdir}:"
+ "{ThisScript}" --target "{target_canonical}" --srcdir "{srcdir}{subdir}:" --srcroot "{srcroot}" --prefix "{prefix}" --cc "{host_cc}" {verifystr} {enable_options} {disable_options}
+ SetDirectory "{savedir}"
+ End For
+End If
+
+SetDirectory "{savedir}"
diff --git a/symlink-tree b/symlink-tree
new file mode 100755
index 00000000000..096582db6eb
--- /dev/null
+++ b/symlink-tree
@@ -0,0 +1,48 @@
+#!/bin/sh
+# Create a symlink tree.
+#
+# Syntax: symlink-tree srcdir "ignore1 ignore2 ..."
+#
+# where srcdir is the directory to create a symlink tree to,
+# and "ignoreN" is a list of files/directories to ignore.
+
+prog=$0
+srcdir=$1
+ignore="$2"
+
+ignore_additional=". .. CVS"
+
+# If we were invoked with a relative path name, adjust ${prog} to work
+# in subdirs.
+case ${prog} in
+/*) ;;
+*) prog=../${prog} ;;
+esac
+
+# Set newsrcdir to something subdirectories can use.
+case ${srcdir} in
+/*) newsrcdir=${srcdir} ;;
+*) newsrcdir=../${srcdir} ;;
+esac
+
+for f in `ls -a ${srcdir}`; do
+ if [ -d ${srcdir}/$f ]; then
+ found=
+ for i in ${ignore} ${ignore_additional}; do
+ if [ "$f" = "$i" ]; then
+ found=yes
+ fi
+ done
+ if [ -z "${found}" ]; then
+ echo "$f ..working in"
+ if [ -d $f ]; then true; else mkdir $f; fi
+ (cd $f; ${prog} ${newsrcdir}/$f "${ignore}")
+ fi
+ else
+ echo "$f ..linked"
+ rm -f $f
+ ln -s ${srcdir}/$f .
+ fi
+done
+
+exit 0
diff --git a/texinfo/COPYING b/texinfo/COPYING
new file mode 100644
index 00000000000..916d1f0f284
--- /dev/null
+++ b/texinfo/COPYING
@@ -0,0 +1,339 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, 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 software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, 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 redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+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 give any other recipients of the Program a copy of this License
+along with the Program.
+
+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 Program or any portion
+of it, thus forming a work based on the Program, 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) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+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 Program, 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 Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) 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; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, 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 executable. 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.
+
+If distribution of executable or 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 counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program 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.
+
+ 5. 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 Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program 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.
+
+ 7. 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 Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program 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 Program.
+
+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.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program 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.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the 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 Program
+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 Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, 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
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "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 PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. 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 PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), 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 Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ This program 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 of the License, or
+ (at your option) any later version.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) 19yy name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/texinfo/ChangeLog b/texinfo/ChangeLog
new file mode 100644
index 00000000000..f4efc18de74
--- /dev/null
+++ b/texinfo/ChangeLog
@@ -0,0 +1,2389 @@
+Mon Jul 28 17:26:48 1997 Rob Savoye <rob@chinadoll.cygnus.com>
+
+ * aclocal.m4: Add CYGWIN and EXEEXT autoconf macros.
+ * configure.in: Use CYGWIN and EXEEXT autoconf macro to look for
+ win32 dependencies.
+ * configure: Regenerated with autoconf 2.12.
+ * Makefile.in: Add $(EXEEXT) to all executables.
+ * makeinfo/Makefile.in: Add $(EXEEXT) to all executables.
+ * util/Makefile.in: Add $(EXEEXT) to all executables.
+
+Mon May 26 12:44:43 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * texinfo.tex: Update to newest FSF version (2.201).
+
+Wed Feb 12 11:15:16 1997 Michael Meissner <meissner@cygnus.com>
+
+ * util/texindex.c (main): Make main an int function, not void.
+
+Sat Jun 29 18:56:07 1996 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: if ac_cv_c_cross is yes, don't run the
+ AC_FUNC_SETVBUF_REVERSED call since it tries to do a run
+ test. This allows texinfo to build for cygwin32 Canadian
+ crosses/natives
+ * configure: regenerate
+
+Wed Jun 26 12:48:10 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (bindir, libdir, mandir, infodir): Use autoconf-set
+ values.
+ * configure.in (AC_PREREQ): autoconf 2.5 or higher.
+ * configure: Rebuilt.
+ * emacs/Makefile.in (bindir, libdir, mandir, infodir): Use
+ autoconf-set values.
+ * info/Makefile.in (bindir, libdir, mandir, infodir): Use
+ autoconf-set values.
+ * libtxi/Makefile.in (bindir, libdir, mandir, infodir): Use
+ autoconf-set values.
+ * makeinfo/Makefile.in (bindir, libdir, mandir, infodir):
+ Use autoconf-set values.
+ * util/Makefile.in (bindir, libdir, mandir, infodir): Use
+ autoconf-set values.
+
+Fri Oct 4 07:49:49 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Version 3.9.
+
+ * Makefile.in (install): Say to install texinfo.tex manually.
+
+ * util/texi2dvi,
+ * util/texindex.c,
+ * makeinfo/makeinfo.c,
+ * info/info.c: Include only the current year in the copyright message.
+
+ * util/texi2dvi: Exit successfully.
+ From: Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>.
+
+Thu Oct 3 12:58:32 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Rename install.sh to the preferred install-sh.
+
+ * Makefile.in (VERSION),
+ * util/texi2dvi,
+ * util/texindex.c,
+ * util/install-info.c,
+ * makeinfo/makeinfo.c (minor_version, print_version_info),
+ * info/info.c: Update version number.
+
+ * util/texi2dvi: Only show diff if verbose.
+
+ * util/install-info.c (main): Check for a missing dir file as well
+ as a missing info files.
+ (main): At start of a node, completely initialize the newly-malloced
+ node structure.
+
+ * texinfo.texi: Fix incorrect uses of @key,
+ insert missing newline in Installing Dir Entries' @menu item,
+ document install-info invocation.
+
+ * Makefile.in (DISTFILES): Do not put .gdbinit's in distribution.
+ (dist): Use || instead of && (and invert sense) so make doesn't think
+ the command failed.
+ (dist): Exclude more junk.
+
+ * makeinfo/makeinfo.c (cm_xref): Back out patch from Tom T., since
+ we generate a good-enough error message that is suppressible
+ without it.
+
+ * util/gen-dir-node: The recommended name for the top-level info
+ file is dir, not dir.info.
+
+ * util/install-info.c (main): At `Mark the end of the Top node',
+ make sure the node name is non-NULL before comparing it. From
+ lvirden@cas.org.
+
+ * configure.in (AC_REPLACE_FUNCS): Use this for memcpy, memmove,
+ and strdup.
+ (AC_CHECK_FUNCS): Instead of this.
+ Because both bcopy and memmove are missing on the 3b2, as reported by
+ Gaylen Miller <gaylen@proaxis.com>, hence we must provide our own.
+ * libtxi/Makefile.in (LIBOBJS): New variable.
+ (OBJS): Include it.
+ * libtxi/memcpy.c, libtxi/memmove.c, libtxi/strdup.c: New files,
+ taken from fileutils 3.13.
+ * makeinfo/makeinfo.c,
+ * info/clib.c (strdup): Move to libtxi.
+
+Wed Oct 2 18:23:30 1996 Karl Berry <karl@cs.umb.edu>
+
+ * info/info-utils.h (memcpy) [!HAVE_MEMCPY],
+ * info/termdep.h (memcpy) [!HAVE_MEMCPY],
+ * makeinfo/makeinfo.c (memmove) [!HAVE_MEMMOVE]: Remove this
+ #ifdef, as we now include it in libtxi if missing.
+
+Tue Oct 1 17:41:52 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/Makefile.in (install),
+ * info/Makefile.in (install),
+ * Makefile.in (install): Use new option name --info-dir instead of
+ --infodir.
+
+ * makeinfo/multi.c (out_char): New fn. Replace all calls to
+ putc/fprintf with calls to this.
+
+ * util/install-info.c: Rename --infodir to info-dir.
+
+Mon Sep 30 10:07:21 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Version 3.8.
+
+ * texinfo.tex: Untabify.
+
+ * texinfo.tex (\ptexl, \ptexL): Do not save, we have our own
+ commands now.
+ (\onepageout): Reformat for readability, and call \indexdummies
+ to avoid expansion of Texinfo commands (e.g., accents) in \write's.
+ (\,, \dotaccent, \ringaccent, \tieaccent, \ubaraccent, udotaccent,
+ \questiondown, \exclamdown, \dotless): New macros.
+ (\l): Let plain TeX definition remain, instead of switching
+ to ``lisp'' font.
+ (\multitable): Ensure space between the columns,
+ insert struts to make interline spacing constant,
+ use real strut instead of a box containing `Xy'.
+ (\indexdummies): Do not define \rm, \char, but
+ do define \@, \{, \}, \dotless, and \,. And \t should generate
+ \t, not \r.
+ (\indexnofonts): Define \, and \dotless as \indexdummyfont,
+ and let \@ be @.
+ (\doind): Reformat for readability, and use temp control sequence
+ names that actually make sense.
+ (\doublecolumnout, \pagesofar, \enddoublecolumns): Restore
+ Knuth's original code to avoid spurious overfull vbox messages.
+ (No boxes are actually overfull).
+ (\shortcontents): Do not allow hyphenations.
+ (\dochapentry, \tocentry): Make glue above and below flexible, to allow
+ better page breaks.
+ (\tex): Reset \, to its plain TeX meaning,
+ and do not reset \l.
+
+ * COPYING: Update for new FSF address (from gcc dist).
+
+ * libtxi/Makefile.in: Various simplifications.
+
+Sun Sep 29 12:58:44 1996 Karl Berry <karl@cs.umb.edu>
+
+ * util/texi2dvi: Use $progname instead of $0 for --version.
+
+ * util/install-info.c (xmalloc, xrealloc): Declare malloc and
+ realloc as returning void *,
+ to avoid ptr/int problems on Digital Unix.
+
+ * info/tilde.c (tilde_expand_word): Declare getenv as returning char *,
+ to avoid warning on Digital Unix.
+
+ * makeinfo/multi.c (multitable_active): Declare extern here to
+ avoid ld warning on rs6000.
+
+ * util/texindex.c (usage): Avoid ??' trigraph.
+
+ * util/install-info.c: Include <sys/fcntl.h> or <fnctl.h>,
+ according to HAVE_SYS_FCNTL_H,
+ and only include <sys/file.h> if HAVE_SYS_FILE_H.
+ (readlines): Oops, had NULL's and 0's reversed for ptr/int members.
+
+ * info/terminal.c (terminal_goto_xy): Remove spurious extra ;.
+
+ * util/install-info.c: Untabify. (input_sections): Initialize.
+ (find_lines): Initialize the terminating element of the array.
+ (print_help): Document --infodir.
+ (main): Compare the basename of infile sans .info to the dir entry,
+ not infile itself.
+ * util/Makefile.in (clean): Remove the install-info binary.
+
+ * info/Makefile.in (distclean): Remove *.info* files.
+
+ * Makefile.in (install),
+ * info/Makefile.in (install),
+ * makeinfo/Makefile.in (install): Use --infodir instead of --info-file.
+
+ * info/info.c,
+ * makeinfo/makeinfo.c: Avoid newlines in string constants for the
+ sake of SunOS cc.
+
+ * makeinfo/multi.c: Do not assume ANSI C.
+
+ * info/info.texi: Oops, need @end vtable for a @vtable.
+
+Sat Sep 28 16:31:28 1996 Karl Berry <karl@cs.umb.edu>
+
+ * Makefile.in (texinfo): Do not depend on sub-all, as then
+ makeinfo is always run. Instead, depend on texinfo.texi.
+
+ * makeinfo/Makefile.in (info, dvi): New targets.
+ makeinfo.info, makeinfo.dvi: Do not depend on macro.texi for now.
+
+ * info/Makefile.in (install): Must call install-info twice.
+
+ * info/info-stnd.texi,
+ * info/info.texi,
+ * makeinfo/makeinfo.texi: Include direntry.
+
+ * emacs/Makefile.in: Use && after cd, etc.
+
+ * texinfo.texi: Kludges so makeinfo -E will not create spurious
+ differences. Add new direntries.
+
+ * util/install-info.c,
+ * util/texindex.c,
+ * makeinfo/makeinfo.c,
+ * info/info.c: Standardize --version output.
+
+ * makeinfo/makeinfo.c (defun_internal): Don't insert index command
+ if expanding macros.
+ (cm_footnotestyle): Don't change the footnote style if it was set
+ on the command line.
+
+ * util/texi2dvi: Recompute original index files each time through loop.
+ Make indentation uniform.
+ Use same basename for the temp input files.
+ Standardize --version output.
+
+ * info/Makefile.in (install),
+ * makeinfo/Makefile.in (install): Insert $(POST_INSTALL).
+
+Fri Sep 27 13:27:30 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.texi (Format with texi2dvi): Rewrite now that the script
+ runs in a loop.
+
+ * info/Makefile.in (MAKEINFO): Simplify to ../makeinfo/makeinfo.
+
+Fri Sep 27 00:26:03 1996 Miles Bader <miles@gnu.ai.mit.edu>
+
+ * info/terminal.c [HAVE_TERMIOS_H] (terminal_prep_terminal,
+ terminal_unprep_terminal): Add code for termios.
+ [HAVE_TERMIOS_H] (original_termios, ttybuff): New variables.
+ * info/termdep.h: [HAVE_TERMIOS_H]: Add include of <termios.h>.
+ * configure.in: Add check for <termios.h>.
+
+Thu Sep 26 10:46:34 1996 Karl Berry <karl@cs.umb.edu>
+
+ * emacs/texnfo-upd.el,
+ * emacs/texinfo.el,
+ * emacs/texinfmt.el: Update from bob for new Texinfo commands, etc.
+
+ * emacs/info.el, emacs/informat.el, emacs/makeinfo.el,
+ emacs/texnfo-tex.el: Update from Emacs 19.34 dist.
+
+ * emacs/elisp-comp: Use TMPDIR if set.
+
+ * util/Makefile.in (libdir): Remove.
+
+ * makeinfo/Makefile.in (install),
+ * Makefile.in (install),
+ * info/Makefile.in (install): Run install-info.
+ (libdir): Remove.
+
+ * texinfo.texi: Various fixes as I make this go through TeX.
+
+ * util/install-info.c: Quote newlines in help message.
+
+ * util/texi2dvi (texi2dvi): Run TeX until the aux/index files
+ stabilize, instead of just twice. From: David Shaw
+ <daves@gsms01.alcatel.com.au>.
+
+Tue Sep 24 14:43:03 1996 Karl Berry <karl@cs.umb.edu>
+
+ * dir: Blank dir file for installation on new systems.
+
+Mon Sep 23 12:18:43 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (args_from_string): Do not back up at a };
+ that leads to an infinite loop.
+
+Sat Sep 21 17:48:04 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (cm_xref): Do not seg fault if outside of
+ any node. From: Tom Tromey <tromey@creche.cygnus.com>.
+ (cm_ctrl): Make obsolete.
+
+Tue Sep 17 13:30:08 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.tex (\inforef): Move to more appropriate place.
+ (\pounds): Remove spurious extra $.
+ (\email): Typeset argument in angle brackets.
+ (\macro): Use \doignore for robustness, instead of just letting TeX
+ parse the argument.
+ (\unmacro): Define.
+
+Sat Sep 14 16:17:35 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.texi: Document multitables, new ISBN number.
+
+Wed Sep 11 18:01:24 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/multi.c (struct env): Remove unused output_position
+ field; this needs to be global.
+ (setup_multitable_parameters): Implement template-defined multitables.
+ (output_multitable_row): Remove trailing whitespace.
+
+ * makeinfo/makeinfo.c (_READ_BUFFER_GROWTH, struct _defines):
+ Remove leading underscore for POSIX/ANSI pedants.
+ (init_conversion): Initialize output_position here.
+ (init_paragraph): Instead of here, where it loses with the
+ multitable calls, eventually resulting in negative counts to the
+ write call when the output file is split.
+
+ * texinfo.texi: First cut at macro documentation.
+ Change accent doc to use tables.
+ Remove whitespace experiments, they are now the default.
+
+Mon Sep 9 14:16:24 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c: Use putc instead of fprintf where possible.
+ (cm_accent): Put _ from @ubaraccent after argument.
+
+ * util/texindex.c (strerror) [!strerror]: Conditionalize
+ declaration.
+
+Sat Sep 7 14:13:24 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (commandTable): Obsolete @setchapterstyle.
+
+Thu Sep 5 15:45:11 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (convert_from_loaded_file): Oops, fix
+ wording of initial output comment.
+
+ * makeinfo/makeinfo.c (cm_angle_brackets): Rename from cm_key.
+ (commandTable): @email should produce angle brackets.
+ @key: Change name.
+
+Tue Sep 3 14:52:17 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.tex (\hsize): Decrease.
+ (\hoffset): Increase.
+ (\setleading): Decrease dramatically.
+ This change affects 8.5x11 format only.
+
+ * texinfo.texi: Document accent commands.
+
+Mon Sep 2 11:10:49 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (commandTable): Deprecate @ichapter and
+ @titlespec.
+ Move all the deprecated @i<section> commands to the end of the list.
+
+ * texinfo.texi: Document @pounds{} and @centerchap{}.
+
+ * texinfo.tex (\centerchfplain): Rewrite to use \chfplain, and to
+ actually center.
+ (\unnchfplain): Just call \chfplain.
+ (\chfplain): Rewrite to be generally callable.
+ (\centerparametersmaybe): Hook, a no-op except with @centerchap.
+
+Sun Sep 1 15:01:49 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.texi: Document @<whitespace>, rearrange spacing section.
+
+ * makeinfo.c (commandTable): Make @. @? @! insert themselves,
+ not be sentence-non-enders. They are sentence *enders*. Also,
+ make @\t and @\n insert a normal space character, not themselves.
+ Also, define @hyphenation.
+ (insert_space): New function.
+ (cm_ignore_sentence_ender): Remove this.
+ (flush_output): Check only for META-SPC, not META-<sentence-ender>.
+
+Fri Aug 30 18:55:30 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.texi: Document @- and @hyphenation{}.
+ Miscellanous fixes.
+
+ * makeinfo/makeinfo.c (commandTable): Define @- as cm_no_op, since
+ makeinfo doesn't do hyphenation.
+
+Thu Aug 29 13:05:38 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.tex (\key): Do not uppercase the argument; key names
+ can be mixed case, e.g., `Control'.
+
+ * makeinfo/makeinfo.c: @infotop, @infounnumbered,
+ @infounnumberedsec, @infounnumberedsubsec,
+ @infounnumberedsubsubsec, @infoappendix, @infoappendixsec,
+ @infoappendixsubsec, @infoappendixsubsubsec, @infochapter,
+ @infosection, @infosubsection, @infosubsubsection:
+ Remove these long-since obsolete commands.
+ @iappendix, @iappendixsection, @iappendixsec, @iappendixsubsec,
+ @iappendixsubsubsec, @ichapter, @isection, @isubsection,
+ @isubsubsection, @iunnumbered, @iunnumberedsec, @iunnumberedsubsec,
+ @iunnumberedsubsubsec:
+ Deprecate these.
+ @infoinclude:
+ Obsolete this.
+ @,: Have to take an argument, since have to do @,{c} not c@,; can't
+ feasibly implement the latter in TeX.
+
+ * makeinfo/makeinfo.c: Rename @d to @udotaccent, since this is
+ relatively infrequently used.
+
+Tue Aug 27 14:58:56 1996 Karl Berry <karl@cs.umb.edu>
+
+ * info/info.c (print_short_help),
+ * util/install-info.c (print_help),
+ * util/texi2dvi,
+ * makeinfo/makeinfo.c (usage) Include bug reporting address.
+
+Mon Aug 26 15:27:17 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (commandTable): Remove @input, @medbreak,
+ @smallbreak, @overfullrule, @br.
+
+Sun Aug 25 17:25:48 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (commandTable): Unify commands that perform
+ the same operation, such as cm_file, cm_samp, cm_email,
+ etc., which all do cm_code.
+
+ * texinfo.texi: Document @ifhtml ... @end ifhtml. Change
+ `PlainTeX' to `plain TeX'.
+
+Fri Aug 23 16:03:16 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.tex (\pounds): New Texinfo command @pounds{}.
+ (\parskip): New smaller value.
+ (\chapheadingskip, \secheadingskip, \subsecheadingskip): New smaller
+ values, both for 8.5x11 and @smallbook formats. From Bob.
+
+ * makeinfo/makeinfo.c (cm_special_char): @pounds{} prints a #.
+ (commandTable): Add new command @pounds.
+
+Tue Aug 20 13:47:20 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (CommandTable): Restore "!", accidentally
+ removed previously.
+
+ * texinfo.tex (\key): Typeset a lozenge around the argument (from
+ gildea@intouchsys.com).
+ * makeinfo/makeinfo.c (cm_key): Surround arg with <...> to match
+ new lozenge style in TeX.
+
+Wed Aug 14 16:59:23 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.texi: Propagate change from rms.
+
+Tue Aug 13 11:33:27 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.texi: Propagate change from rms.
+
+ * texinfo.texi: Document other @headings options.
+
+Sun Aug 11 13:19:42 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (cm_accent, cm_special_char, cm_dotless):
+ New functions.
+ (CommandTable): Add new commands for all of plain.tex's
+ accents and non-English characters.
+
+Fri Aug 9 14:12:07 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (convert_from_loaded_file): Say we're making
+ ``text'' file if no_headers. Also, use `input_filename' instead
+ of just `name' for clarity.
+ (suffixes): Check for no suffix last, i.e., prefer `foo.texi' as an
+ input file to `foo'. (The latter is probably a binary.)
+
+Mon Aug 5 13:52:39 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.tex (\heading, \subheading, \subsubheading): Can no
+ longer call the nonexistent \*secheadingi series. Instead, call
+ \plain*secheading.
+ (\plainsubsecheading, \plainsubsubsecheading): New macros, by analogy
+ with \plainsecheading.
+ (\unnumberedsubseczzz, \unnumberedsubsubseczzz): Call them.
+
+Sun Aug 4 16:46:10 1996 Karl Berry <karl@cs.umb.edu>
+
+ * makeinfo/makeinfo.c (flush_output): Mask out eighth bit, that we
+ turned on in non-sentence enders.
+
+Sat Aug 3 14:03:10 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.tex (\HEADINGSdouble, \HEADINGSsingle,
+ HEADINGSdoubleafter, \HEADINGSsingleafter, \CHAPPAGoff,
+ \CHAPPAGon, \CHAPPAGodd): Set \contentsalignmacro, analogous to
+ \pagealignmacro.
+ (\startcontents): Call \contentsalignmacro instead of \pagealignmacro.
+
+Mon Jul 29 14:44:33 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.tex (\indexfonts): Make leading be 12pt. Otherwise, it's
+ too crammed.
+ (\smalllispx): Remove \setleading{10pt}. That was too small.
+ (\doprintindex): Do not call \tex ... \Etex. Index files are Texinfo
+ source, not TeX source, except for using \ instead of @ as the
+ escape character (for now).
+
+Sun Jul 28 13:37:05 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.tex (paragraphindent): Move to more reasonable place in
+ the source file.
+ (chapfonts, secfonts, subsecfonts, indexfonts): Call \setleading.
+ (\chfplain, \secheading, \plainsecheading, \subsecheading,
+ \subsubheading): Rewrite to properly \hangindent the title.
+ (\sectionheading): New generic macro to print section titles.
+
+ * texinfo.texi: Update the `Obtaining TeX' node.
+
+Fri Jul 26 14:11:48 1996 Karl Berry <karl@cs.umb.edu>
+
+ * util/texi2dvi: Do macro expansion with makeinfo before running TeX.
+ Various expansion safety measures added for test; avoid use of -o.
+
+ * makeinfo/makeinfo.c (usage): More usage message tweaks.
+
+Fri Jul 26 11:55:37 1996 Karl Berry <karl@laurie>
+
+ * util/texi2dvi: Format usage message to conform to the other *utils.
+
+Thu Jul 25 17:05:47 1996 Karl Berry <karl@cs.umb.edu>
+
+ * emacs/Makefile.in: Do not compile the Elisp by default. We
+ don't install it, so it confuses people to compile it.
+
+Sun Jul 21 07:20:09 1996 Karl Berry <karl@cs.umb.edu>
+
+ * util/Makefile.in (install-info): Dependency should be
+ install-info.o, not install-info. Also, update copyright years.
+
+ * makeinfo/makeinfo.c (cm_printindex): Don't call execute_string
+ to print index entries, we've already done the expansion now.
+
+ * makeinfo/makeinfo.h: Add copyright. Finish merge of rms changes.
+ * makeinfo/makeinfo.c: Finish merge, add my expansion changes again.
+ * makeinfo/multi.c: Add copyright message.
+
+Fri Jul 19 10:35:22 1996 Karl Berry <karl@cs.umb.edu>
+
+ * info/info.c: Update copyright date.
+
+ * info/info.texi,
+ * util/install-info.c,
+ * emacs/Makefile.in,
+ * emacs/texnfo-tex.el,
+ * emacs/Makefile.in: Change FSF address.
+
+ * Merged changes from bfox -- below, plus multitable changes, plus
+ lots more.
+
+ Sun Apr 14 08:49:50 1996 Brian J. Fox <bfox@nirvana.samsara.com>
+
+ * makeinfo/makeinfo.c (remember_node_reference): Numerous commands
+ call remember_node_reference. If a node has not yet been defined,
+ use the empty string as the current node for those cases.
+
+ Mon Feb 12 17:35:38 1996 Brian J. Fox <bfox@nirvana.samsara.com>
+
+ * makeinfo/makeinfo.c (push_node_filename): Clean up calls to
+ xmalloc and xrealloc. Only have to call xrealloc.
+
+ Fri Jan 26 08:00:38 1996 Brian J. Fox <bfox@nirvana.samsara.com>
+
+ * info/session.c (info_input_buffer_space_available): Fix typo
+ which forced the limitation of the sizeof (int) instead of sizeof
+ (buffer).
+
+ * Makefile.in (PACKVER): now at 3.8. Add TERMIOS support to
+ Info. Minor bugs fixed in Makeinfo.
+
+Sat Jul 13 11:58:57 1996 Karl Berry <karl@cs.umb.edu>
+
+ * texinfo.texi (ftable vtable): Mention example.
+
+Sun Jun 30 14:59:51 1996 Karl Berry <karl@goldman.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (cm_email): New function for new @email command.
+ * texinfo.texi (email): New node documenting it.
+
+Wed Apr 17 18:07:34 1996 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (cm_kbd): Do nothing if in @example or @code.
+ (struct brace_element): New field in_fixed_with_font.
+ (remember_brace_1): Save in_fixed_with_font.
+ (pop_and_call_brace): Restore in_fixed_with_font.
+ (cm_code): Don't decrement in_fixed_with_font at end of construct.
+ (struct istack_elt): New field in_fixed_with_font.
+ (push_insertion, pop_insertion): Save and restore in_fixed_with_font.
+ (end_insertion): Don't decrement in_fixed_with_font here.
+ (not_fixed_width): New function.
+ (cm_sc, cm_var, cm_italic, cm_roman, cm_titlefont):
+ Use not_fixed_width.
+
+Sat Apr 13 23:22:05 1996 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * util/install-info.c (main): Fatal error if no input file spec'd.
+ Look for START-INFO-DIR-ENTRY, not BEGIN-INFO-DIR-ENTRY.
+
+Thu Apr 11 18:21:50 1996 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (cm_enddots): New function.
+ (self_delimiting): Accept -, ^ and ".
+ (CommandTable): Add commands -, ^, ", enddots, centerchap.
+
+Sun Mar 24 12:18:32 1996 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (enum insertion_type): Add `direntry'.
+ (insertion_type_names): Add "direntry".
+ (cm_dircategory): New function.
+ (cm_direntry): New function.
+ (CommandTable): Add "dircategory" and "direntry".
+ (insert_string): New function.
+ (end_insertion): Handle direntry.
+ (begin_insertion): Handle direntry.
+
+Sun Mar 24 11:10:05 1996 Karl Berry <karl@spiff.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (cm_url): New function for new @url command.
+
+Fri Feb 23 21:14:40 1996 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * info/Makefile.in (install, uninstall): Use manprefix.
+
+Fri Feb 23 19:50:18 1996 Richard Stallman <rms@whiz-bang.gnu.ai.mit.edu>
+
+ * util/Makefile.in (install-info, install-info.o): New targets.
+ (all): Depend on install-info.
+ (install, uninstall): Operate on install-info.
+
+ * install-info.c: New file.
+
+Wed Jan 3 10:01:45 1996 Brian J. Fox <bfox@nirvana.datawave.net>
+
+ * makeinfo/makeinfo.c (make_index_entries_unique): Be a little bit
+ stricter about what makes two index entries identical.
+
+Fri Dec 29 13:00:24 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * makeinfo/makeinfo.c (Whole File): Add @detailmenu for allowing
+ detailed menu listings to appear while still defaulting nodes.
+
+Wed Dec 27 13:54:30 1995 Brian Fox <bfox@albert.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (cm_code): Always notice that we are in
+ fixed_width_font, even if other formatting changes are not to take
+ place.
+
+Sat Dec 23 11:48:43 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * info/man.c: (clean_manpage) Remove ^L's from page.
+
+ * makeinfo/makeinfo.c (get_brace_args): Change some memcpy's to
+ memmoves.
+
+ * info/info.c (main): Prefer caseless matches over partial
+ matches.
+
+ * Makefile.in (All Subdir Targets): Change suggested by Debian
+ people which allows errors in recursive makes to kill the
+ top-level make.
+
+ * makeinfo/Makefile.in (makeinfo.dvi): New target.
+
+ * info/info.c (main): Print version of containing texinfo package.
+
+ * makeinfo/makeinfo.c (flush_output): Don't strip high-bit from
+ sentence_enders.
+ Print the version number of the containing texinfo package.
+
+ * info/man.c (locate_manpage_xref): Count the 0th entry.
+
+ * makeinfo/makeinfo.c (cm_menu): If a menu is seen before a node
+ has been defined, warn, and create the node `Top'.
+
+Wed Jun 21 03:19:39 1995 Brian Fox <bfox@albert.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (cm_infoinclude): Clean up after printing
+ error if the file couldn't be included.
+ (discard_braces): Print errors only for those unmatched open
+ braces that belong to a texinfo command.
+
+ * */Makefile.in: Use @CFLAGS@ and @LDFLAGS@.
+
+ * makeinfo/makeinfo.c: End `node_search_string' and friends with a
+ terminating null character.
+
+Wed Jun 21 01:23:49 1995 Jim Meyering (meyering@comco.com)
+
+ * makeinfo/makeinfo.c: Close comment after #endif.
+
+Tue Jun 20 04:58:26 1995 Brian Fox <bfox@albert.gnu.ai.mit.edu>
+
+ * emacs/Makefile.in (install): Fix typo: "fle" -> "file".
+
+ * Makefile.in (VERSION): Bump to 3.6
+
+ * info/clib.c: Include general.h for `info_toupper' and friends.
+
+ * info/clib.h: strncmp and strncascmp return an int. What kind of
+ drugs was I on?
+
+Mon Jun 19 23:34:47 1995 Brian Fox <bfox@albert.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (make_index_entries_unique): Copy the last
+ index entry.
+
+Mon Jun 19 21:55:49 1995 Noah Friedman <friedman@prep.ai.mit.edu>
+
+ * util/texi2dvi (--version): New option.
+ Cosmetic changes.
+
+Mon Jun 19 16:06:40 1995 Brian Fox <bfox@albert.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c (cm_macro): Fix typo. `x != y' is not the
+ same as `x |= y'.
+
+ * info/Makefile.in (exec_prefix): Use @exec_prefix@ not $(prefix).
+ * makeinfo/Makefile.in (exec_prefix): Use @exec_prefix@ not $(prefix).
+ * util/Makefile.in (exec_prefix): Use @exec_prefix@ not $(prefix).
+ * libtxi/Makefile.in (exec_prefix): Use @exec_prefix@ not $(prefix).
+
+ * emacs/Makefile.in (uninstall): New target.
+ (install): Use the definition of $(lispdir), don't dynamically
+ find it. Use INSTALL_DATA not cp.
+ (exec_prefix): use @exec_prefix@ not $(prefix).
+
+ * makeinfo/makeinfo.c (apply): If there isn't an actual argument
+ for a named argument, default it to "".
+
+ * Makefile.in (VERSION): Now at 3.5.
+ (texinfo): Make ./makeinfo/makeinfo depend on sub-all for parallel
+ makes.
+
+ * emacs/Makefile.in (ELISP_OBJS): Explictly declare .el and .elc
+ in the SUFFIXES list.
+
+ * makeinfo/makeinfo.c (cm_today): Special case for losing alpha.
+ * (minor_version): Increase to 63.
+
+ * info/info.c (version_string): Now at 2.14.
+ * info/tilde.c: Declare getenv to return (char *).
+ * info/window.c (build_message_buffer): Jump through hoops to keep
+ DEC Alpha's happy.
+
+ * info/xmalloc.c: Declare malloc and realloc as (void *) returning
+ functions.
+
+Sun Jun 18 12:47:21 1995 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * emacs/detexinfo.el (detexinfo-line-cmds-without-arg):
+ Handle ifhtml.
+
+Fri Jun 16 13:48:14 1995 Brian Fox <bfox@albert.gnu.ai.mit.edu>
+
+ * util/texindex.c: Update TEXINDEX_VERSION_STRING for texinfo 3.4
+
+ * (All *.c *.h *.in): Change FSF old address to new.
+ * texinfo.texi (Obtaining TeX): Change FSF old address to new
+ address. Change Old phone numbers to new phone numbers.
+
+ * Makefile.in (VERSION): Change to 3.4.
+
+Thu Jun 15 22:49:07 1995 Robert J. Chassell <bob@hill.gnu.ai.mit.edu>
+
+ * texinfo.texi, emacs/=development/cover.texi: update
+ Texinfo distribution package version number
+
+Thu Jun 15 09:23:02 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * info/info.c: (minor_version): Set to 13.
+
+ * info/clib.c,h: New files gather together replacement functions
+ for those POSIX-style C library functions that are not present on
+ the target system.
+
+ * info/Makefile.in (SRCS): Add clib.c and clib.h. makedoc now
+ needs clib.o to build on systems missing various string.h stuff.
+
+ * info/variables.c (whole file): Call strdup, not savestring.
+ * info/tilde.c (whole file): Call strdup, not savestring.
+ * info/search.c (whole file): Call strdup, not savestring.
+ * info/nodes.c (whole file): Call strdup, not savestring.
+ * info/nodemenu.c (whole file): Call strdup, not savestring.
+ * info/man.c (whole file): Call strdup, not savestring.
+ * info/makedoc.c (whole file): Call strdup, not savestring.
+ * info/m-x.c (whole file): Call strdup, not savestring.
+ * info/info.c (whole file): Call strdup, not savestring.
+ * info/indices.c (whole file): Call strdup, not savestring.
+ * info/echo_area.c (whole file): Call strdup, not savestring.
+ * info/session.c (whole file): Call strdup, not savestring.
+ * info/filesys.c (whole file): Call strdup, not savestring.
+
+ * makeinfo/makeinfo.c (minor_version): Change to 1.62.
+ * makeinfo/makeinfo.c (get_execution_string): Initialize `i' to 0
+ in case there are no execution_strings.
+
+Wed Jun 14 17:48:06 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * texinfo.texi: include "texinfo.tex", not "texinfo".
+ * info/session.c (forget_window_and_nodes): Place a sequence point
+ in between "info_windows[i] = info_windows[++i];" as per various
+ compiler experts.
+
+ * makeinfo/makeinfo.c (strdup): Create this function if the system
+ doesn't have it.
+ (discard_insertions): Use the insertion's filename, not the
+ current input file.
+ (push_insertion): Remember the current input file with each
+ insertion.
+ (pop_insertion): Free storage used by remembered input file.
+
+ * makeinfo/makeinfo.c (whole file): Use `strdup' instead of
+ `savestring'.
+ * configure.in: Check for `strdup'.
+
+Wed Jun 14 15:58:51 1995 Brian Fox <bfox@albert.gnu.ai.mit.edu>
+
+ * libtxi/Makefile.in (prefix): Use @prefix@, not /usr/local/
+
+Wed Jun 14 10:50:57 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * Makefile.in (DISTFILES): Don't include *.elc files in the list
+ of files to distribute.
+ (installdirs): Include `emacs' in the list of sub-dirs with
+ Makefile.in's.
+
+ * emacs/elisp-comp: Shell script which batch compiles the *.el files.
+ * emacs/Makefile.in: New file contains targets to build the elc files.
+ * configure.in: Add `emacs/Makefile' to the list of created makefiles.
+ * makeinfo/makeinfo.c (whole file): Give every function a return
+ type. All cm_xxx functions are now void. Add declarations for
+ functions to top of file.
+
+Mon Jun 12 12:00:57 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * info/man.c (reference_section_starters): Add versions of "SEE
+ ALSO" and "RELATED INFORMATION" with tabs instead of spaces as
+ well.
+
+ * util/texindex.c: Back out changes for OFF_T. Explicity coerce
+ the result of lseek to a long, and use longs everywhere.
+
+ * texinfo.texi: Change "@end shorttitlepage" to "@end titlepage".
+ * makeinfo/makeinfo.c: Make @shorttitlepage ignore the rest of the
+ line.
+
+ * util/texindex.c (strrchr): Create if not present.
+ Test for HAVE_STRCHR and HAVE_STRING_H.
+ (main): Make PROGRAM_NAME be just the last path componenet of argv[0].
+ (decode_command): Rewrite.
+ (usage): Rewrite. Now texindex handles --version.
+
+ * makeinfo/makeinfo.c (make_index_entries_unique): Rewrite from
+ scratch.
+
+ * Don't distribute created info files with texinfo. After all,
+ the user will have the tools necessary to create them, yes?
+
+ * Makefile.in (distclean): Remove *.log
+
+ * info/man.c (read_from_fd): Change timeout value for select to 15
+ seconds. Some systems (e.g., albert.ai.mit.edu) actually need
+ more than 10 seconds to format a man page.
+
+ * info/tilde.c: Fix typo in declaration for
+ `tilde_expansion_failure_hook'.
+
+Wed Jun 7 13:36:53 1995 Brian Fox <bfox@albert.gnu.ai.mit.edu>
+
+ * info/tilde.h: Change type of tilde_expansion_failure_hook to
+ a pointer to a function returning a (char *).
+ * info/tilde.c: Change type of tilde_expansion_failure_hook to a
+ pointer to function returning a (char *).
+
+ * makeinfo/makeinfo.c (get_execution_string): Don't use `i' in the
+ latter assignment, use `execution_strings_index' instead.
+
+ * info/man.c (read_from_fd): Change logic to avoid using FIONREAD.
+
+ * info/xmalloc.c (xrealloc): Use (void *), not (caddr_t *).
+ * info/xmalloc.c (xmalloc): Use (void *), not (caddr_t *).
+
+ * Makefile.in (DISTFILES): Don't find RCS no "=" directories.
+
+ * util/Makefile.in (prefix): Use @prefix@ as the value.
+ * info/Makefile.in (prefix): Use @prefix@ as the value.
+ * makeinfo/Makefile.in (prefix): Use @prefix@ as the value.
+
+Wed Jun 7 12:29:28 1995 Robert J. Chassell <bob@hill.gnu.ai.mit.edu>
+
+ * texinfo.texi: Correct minor typos.
+
+ * emacs/texinfmt.el: Don't require @shorttitlepage to be inside
+ of @iftex ... @end iftex
+
+Mon May 8 18:33:52 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * info/nodes.c: #include "man.h" if HANDLE_MAN_PAGES.
+ (info_get_node_of_file_buffer): If the file buffer is one
+ associated with manpages, call the manpage node finding
+ function instead.
+ (info_find_file_internal): If the file buffer is one associated
+ with manpages, avoid doing any file I/O.
+ (info_reload_file_buffer_contents): Ditto.
+ (info_find_file_internal): Call create_manpage_file_buffer instead
+ of info_load_file_internal.
+
+ * info/info.c: #include "man.h" if HANDLE_MAN_PAGES.
+ (main): If the initial node cannot be found, perhaps find it as a
+ manpage.
+ * info/info-utils.c: #include "man.h" if HANDLE_MAN_PAGES.
+ (info_xrefs_of_node): If handling man pages, and this is a manpage
+ node, use xrefs_of_manpage.
+
+ * info/session.c (info_set_input_from_file): Only fclose (stream)
+ if it is non-null and not stdin.
+ #include "man.h" if HANDLE_MAN_PAGES.
+ (info_menu_or_ref_item): If handling man pages, and this is a
+ manpage node, get the xrefs from manpage_xrefs_in_binding.
+ (info_man): Compile in for M-x man if handling man pages.
+ (info_move_to_xref): If handling man pages, and the current node
+ is a manpage node, use locate_manpage_xref to get xrefs.
+
+Thu May 4 08:55:23 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * info/info.c (main): If the output device is not a terminal, and
+ no output filename has been specified, make user_output_filename
+ be "-", so that the info is written to stdout, and turn on the
+ dumping of subnodes.
+
+Thu Apr 13 18:05:06 1995 Daniel Hagerty <hag@churchy.gnu.ai.mit.edu>
+
+ * texinfo.texi: Fixed @end titlepage/@end shorttitlepage
+
+Sat Apr 8 12:51:49 1995 Roland McGrath <roland@churchy.gnu.ai.mit.edu>
+
+ * makeinfo/makeinfo.c [! HAVE_STRERROR] (strerror): New function,
+ snarfed from ../info/filesys.c.
+ (cm_infoinclude): Use strerror instead of sys_errlist.
+
+Tue Apr 4 18:44:00 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * util/texindex.c (sort_offline): Change TOTAL to be an off_t.
+ * util/texindex.c (sort_in_core): Change TOTAL to be an off_t.
+ * util/texindex.c (MAX_IN_CORE_SORT): Cast to off_t.
+
+Sun Apr 2 16:20:13 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * info/Makefile.in: Define DEFAULT_INFOPATH in case we are
+ compiling in the current directory.
+ * info/Makefile.in (info.o): Add filesys.h because of DEFAULT_INFOPATH.
+ * info/(search.c,h, nodes.c info-utils.c) Use strcasecmp and
+ strncasecmp instead of stricmp and strnicmp. Define strcasecmp
+ and strncasecmp in search.c if !HAVE_STRCASECMP.
+ * info/search.c: If HAVE_STRING_H include it.
+ * info/nodes.c: If HAVE_STRING_H include it.
+ * info/info-utils.c: If HAVE_STRING_H include it.
+ * info/info.h: If HAVE_STRING_H include it.
+ * configure.in (AC_HAVE_FUNCS): Check for strcasecmp.
+ * makeinfo/makeinfo.c (strcasecmp): Define if !HAVE_STRCASECMP.
+ * makeinfo/makeinfo.c (entire file): Use `strcasecmp' instead of
+ `stricmp'.
+ * makeinfo/makeinfo.c (cm_ifeq): New command takes three args.
+ Compares first two, executes remainder if the first two are
+ string-wise eq.
+ * makeinfo/makeinfo.c (ifhtml): Add to command list. Shouldn't be
+ used, but it is by people who don't want to hack macros.
+
+Sat Apr 1 09:20:14 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * makeinfo/makeinfo.c (begin_insertion): Fix reversed arguments to
+ line_error.
+
+ * info/info-stnd.texi: Use "end" footnote style instead of "separate".
+
+ * info/Makefile.in: Change "rm -f" to $(RM).
+
+ * info/general.h: Define zero_mem in terms of memset if we have
+ it, else in terms of bzero if we have that, else as inline code.
+
+ * info/NEWS: Updated to reflect changes in 2.11.
+
+Fri Mar 31 22:38:31 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * Makefile (DISTFILES): Don't include *.a, *orig, nor *.e
+ files.
+ (DISTFILES):
+
+Sat Mar 4 12:16:29 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * Makefile.in: Use @prefix@ instead of hardwired `/usr/local'.
+ Clean up makefile rules which make in subdirs.
+ (ALL_SUBDIRS): Add makeinfo/macros to list of subdirectories.
+
+ * configure.in (AC_CHECK_FUNCS): Add `bcopy' to list of things to
+ check for.
+
+Fri Mar 3 13:54:10 1995 Robert J. Chassell <bob@hill.gnu.ai.mit.edu>
+
+ * texinfo.texi: Minor changes for incremental new edition 2.20.
+
+Fri Mar 3 19:01:36 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * filesys.c (filesys_read_info_file): Local variable ST_SIZE is a
+ long which has the value of finfo->st_size casted to it.
+ * nodes.c (whole file): Similar changes.
+
+ These changes and the following for makedoc.c were required for
+ proper operation on HPm68k NetBSD.
+
+Mon Feb 27 15:16:27 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * makedoc.c (process_one_file): Local variable FILE_SIZE is a long
+ which has the value of finfo.st_size casted to it.
+
+
+Fri Mar 3 18:58:38 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * makeinfo.c (find_and_load): Cast fileinfo.st_size to a long for
+ internal use. This makes things work on NetBSD.
+
+
+Fri Mar 3 13:54:10 1995 Robert J. Chassell <bob@hill.gnu.ai.mit.edu>
+
+ * texinfo.texi: Minor changes for incremental new edition 2.20.
+
+Fri Mar 3 09:41:39 1995 Brian J. Fox <bfox@wizard.datawave.net>
+
+ * configure.in (TERMLIBS): Use AC_CHECK_LIB instead of
+ AC_HAVE_LIBRARY.
+
+Mon Jan 9 16:55:31 1995 Brian Fox <bfox@churchy.gnu.ai.mit.edu>
+
+ * Makefile.in (DISTFILES): Add the directory EMACS-BACKUPS to the
+ list of things to avoid distributing.
+
+Tue Nov 29 17:48:37 1994 David J. MacKenzie <djm@duality.gnu.ai.mit.edu>
+
+ * configure.in: Check for off_t.
+ * util/texindex.c (main): Use it.
+
+Fri Nov 11 14:46:28 1994 David J. MacKenzie <djm@duality.gnu.ai.mit.edu>
+
+ * configure.in: Update for Autoconf v2.
+
+Thu Oct 13 02:17:38 1994 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * emacs/detexinfo.el (detexinfo): Handle @!, @?, @^, @".
+
+Mon Aug 1 03:26:13 1994 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
+ * texindex.c: Move the memset define down past string.h include.
+
+Tue Jun 28 14:21:43 1994 David J. MacKenzie (djm@churchy.gnu.ai.mit.edu)
+
+ * makeinfo/makeinfo.c: Add --help option.
+ (usage): Take args for stream and error code.
+ Change callers.
+ (print_version_info): Write to stdout, not stderr.
+
+Wed May 18 18:55:24 1994 Brian J. Fox (bfox@ai.mit.edu)
+
+ * info/session.c (forget_window_and_nodes): Negate test for
+ internal_info_node_p. We only want to free the text if it is
+ not an internal node.
+
+Thu Mar 10 03:07:18 1994 Richard Stallman (rms@mole.gnu.ai.mit.edu)
+
+ * texindex.c (memset): Fix invalid parm name (was 0).
+
+Thu Feb 10 12:56:52 1994 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * makeinfo/makeinfo.c (current_item_function): Don't loop if elt
+ is NULL.
+
+Wed Feb 9 12:21:09 1994 Brian J. Fox (bfox@ai.mit.edu)
+
+ * makeinfo/makeinfo.c (minor_version): Release now at 1.60.
+
+ * makeinfo/makeinfo.c (expand_filename): Additional fixes. Now
+ when called with NULL filename, makes an output filename from the
+ input filename.
+ (convert_from_loaded_file): If REQUIRE_SETFILENAME is #defined (no
+ longer the default case) then error if no @setfilename was found
+ in the file. If REQUIRE_SETFILENAME is not #defined, the input
+ file starts either at the first line, or at the second line if the
+ first line contains the text "\input", and the output filename is
+ the input file name without directory and with ".info" replacing
+ any extension found.
+ (convert_from_loaded_file): Fixed bug in search for first
+ occurence of "@setfilename".
+
+Tue Feb 8 14:16:58 1994 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * configure.in: Check for sys/file.h.
+ info/dir.c, info/filesys.c, info/makedoc.c, info/nodes.c,
+ info/session.c, info/termdep.h, makeinfo/makeinfo.c
+ [HAVE_SYS_FILE_H]: Include <sys/file.h>.
+
+ * makeinfo/makeinfo.c (convert_from_loaded_file): Print
+ real_output_filename instead of output_filename, so user knows
+ exactly where output file is going.
+
+ Fri Jun 11 14:34:30 1993 Ian Lance Taylor (ian@cygnus.com)
+ * configure.in: Check for sigprocmask and sigsetmask.
+ * info/signals.h (HAVE_SIGSETMASK): Don't define.
+ (HAVE_SIGPROCMASK): Use instead of _POSIX_VERSION.
+ (BLOCK_SIGNAL, UNBLOCK_SIGNAL): If neither HAVE_SIGPROCMASK nor
+ HAVE_SIGSETMASK is defined, define these to do nothing.
+ * info/signals.c (sigprocmask): Don't compile if HAVE_SIGSETMASK
+ is not defined.
+
+ * info/terminal.c (terminal_prep_terminal): Don't clobber VINTR
+ and VQUIT in conditionals.
+
+Mon Feb 7 18:10:22 1994 Brian J. Fox (bfox@ai.mit.edu)
+
+ * makeinfo/makeinfo.c (full_pathname): Correct to really return
+ the full pathname of the input argument. Now makeinfo
+ /foo/bar.texi, where /foo/bar.texi contains "@setfilename
+ bar.info", correctly leaves the output file in "./bar.info".
+ Note that "@setfilename ../bar.info" still works; this is already
+ an absolute pathname.
+
+Sat Feb 5 13:04:05 1994 Brian J. Fox (bfox@ai.mit.edu)
+
+ * makeinfo/makeinfo.c: Version 1.59 released.
+
+ * makeinfo/makeinfo.c (whole file): Large number of changes allow
+ the "-E filename" option to be used to write a macro expanded
+ output file. On a file which contains no @include's and no
+ @macro's, the output file is identical to the input file.
+
+ * makeinfo/makeinfo.c (declarations): Remove cm_tex (). It is
+ never used since it is implemented with `command_name_condition'.
+
+ * makeinfo/makeinfo.c (add_char): Shift braces following the
+ current break point if we have deleted any characters.
+ (adjust_braces_following): New function adjusts all of the markers
+ in the brace stack which follow HERE by AMOUNT. This fixes a bug
+ where (for example) @var{} immediately following a line break
+ which is the end of a sentence modified the output incorrectly.
+
+Wed Feb 2 14:14:03 1994 Brian J. Fox (bfox@ai.mit.edu)
+
+ * makeinfo: Version 1.58.
+
+ * makeinfo/makeinfo.c (cm_node): Add extra hair to allow
+ backtracking through execution strings. Add extra hair to allow
+ the first node seen after a @top node is seen to adjust the
+ sectioning level of the @top node and associated menus.
+ Fix a few typos.
+ Add facility for macros to invoke the original definition. This
+ works by not allowing a single macro to recurse. Mutual recursion
+ is also disallowed with this plan.
+
+ * makeinfo/macros: New directory contains shippable macros.
+ * makeinfo/macros/simpledoc.texi: Macros which simplify the most
+ common uses of TeXinfo. See the example file.
+ Macros are now a reasonable way to get people started using
+ TeXinfo.
+
+Mon Jan 31 12:54:36 1994 Brian J. Fox (bfox@ai.mit.edu)
+
+ * makeinfo/makeinfo.c (minor_version): Increase to 57.
+
+ * makeinfo/makeinfo.c (cm_node): Call execute_string on the node,
+ next, prev, and up pointers.
+ (reader_loop): Change logic for `@bye'. No longer required at the
+ ends of executed strings.
+ (execute_string): Do not append `@bye' to the string to execute.
+
+ * makeinfo/makeinfo.c (whole file): Use COMMAND_PREFIX instead of
+ hardcoding `@' character in strings and searches.
+
+ * makeinfo/makeinfo.c (read_command): If HAVE_MACROS is defined,
+ then recognize and execute macros here.
+ (CommandTable): Add "macro" and "unmacro" to table if HAVE_MACROS
+ is defined.
+
+ * makeinfo/makeinfo.c (cm_macro, cm_unmacro, execute_macro)
+ makeinfo/makeinfo.c (get_macro_args, find_macro, add_macro)
+ makeinfo/makeinfo.c (delete_macro, array_len, apply):
+ New functions implement macro facility if HAVE_MACROS is
+ defined.
+
+ * makeinfo/macro.texi (new file): Examples of using the new macro
+ facility.
+
+Mon Jan 31 10:24:52 1994 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * makeinfo/makeinfo.c (executing_string): Restore global
+ declaration.
+
+Mon Jan 24 23:48:26 1994 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * texinfo.texi: Various typo fixes from Bob Chassell
+ <bob@gnu.ai.mit.edu>.
+
+Thu Jan 6 13:34:21 1994 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * texinfo.texi: Turned on smallbook format and @set smallbook.
+
+Wed Dec 15 20:08:43 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * info/filesys.h (DEFAULT_INFOPATH): Added /usr/local/info,
+ /opt/gnu/info, /usr/share/info, and /usr/local/share/info.
+
+Tue Dec 14 19:10:20 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * libtxi/Makefile.in (ALLOCA): Define from configure.
+
+Fri Dec 10 04:33:12 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/texi2dvi: Put under RCS control.
+
+Sun Dec 26 11:55:46 1993 Brian J. Fox (bfox@ai.mit.edu)
+
+ * info/session.c (info_numeric_digit_arg_loop): Fix doc string.
+
+ * info/infodoc.c (create_internal_info_help_node): Print out list
+ of functions which have to keystroke equivalent if we support
+ NAMED_FUNCTIONS.
+
+ * info/filesys.c (compress_suffixes): Add ".gz" for "gunzip" to
+ alist.
+
+ * info/footnotes.c (make_footnotes_node): If refs[i] doesn't have
+ a nodename, then it couldn't be a reference to a footnote.
+
+ * info/nodemenu.c (get_visited_nodes): Handle the case where
+ filter_func has left no possible buffers to select.
+
+Sat Dec 25 10:35:56 1993 Brian J. Fox (bfox@ai.mit.edu)
+
+ * info/infodoc.c (create_internal_info_help_node): Conditionalize
+ generation of the help node based on the #define
+ HELP_NODE_GETS_REGENERATED. When this is not set (the default)
+ the help node is generated exactly once, and is not gc'able.
+ Otherwise, a new node is always created for the help window, and
+ the old node gets garbage collected by the gc system.
+ (info_find_or_create_help_window): Conditionalize window node
+ selected based on the #define HELP_NODE_GETS_REGENERATED.
+
+ * info/dir.c (add_menu_to_file_buffer): Place exactly one blank
+ line between directory entries.
+
+ * info/info.c (version_string): Update minor version to "11".
+
+ * info/info.h: Update comment to "2.11".
+
+ * info/dir.c (maybe_build_dir_node): Only add the contents of a
+ new file if it is not identical to the file of the DIR buffer.
+
+ * info/nodes.c (info_get_node): Call `maybe_build_dir_node' on
+ "dir" as well as "localdir" to mimic emacs-19.22 "dir" merging
+ behaviour.
+
+Fri Dec 3 13:41:44 1993 Brian J. Fox (bfox@ai.mit.edu)
+
+ * info/info-utils.c (canonicalize_whitespace): Suppress whitespace
+ found at the start of STRING.
+
+Sat Nov 20 14:00:50 1993 Brian J. Fox (bfox@hippie)
+
+ * info/indices.c (DECLARE_INFO_COMMAND): Fix typo in assignment to
+ `old_offset' (= instead of ==).
+
+Tue Nov 2 12:22:40 1993 Brian J. Fox (bfox@ai.mit.edu)
+
+ * makeinfo/makeinfo.c (make_index_entries_unique): New function
+ makes a sorted array have all unique entries by appending numbers
+ to the ends of strings.
+ (sort_index): Call `make_index_entries_unique'.
+
+Mon Sep 20 12:04:05 1993 Brian J. Fox (bfox@ai.mit.edu)
+
+ * makeinfo/makeinfo.c (get_execution_string): New Function returns
+ a pointer to an EXECUTION_STRING structure.
+ (execute_string): No longer uses a static string; call
+ `get_execution_string' instead in order to get a free buffer for
+ consing.
+
+Sun May 23 07:00:20 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * Texinfo 3.1 released.
+
+Sat May 22 18:21:27 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * info/info.c (info_patch_level): Increment constant to 1.
+
+ * info/Makefile.in (DEFAULT_INFOPATH): Default definition deleted.
+ Makefile.in: Put it here instead.
+ * Makefile.in (MDEFINES): Add DEFAULT_INFOPATH.
+
+ * configure.in: check for vfprintf and vsprintf.
+
+ * makeinfo/makeinfo.c: Version 1.55.
+
+ * makeinfo/makeinfo.c (add_word_args, execute_string) [HAVE_VARARGS_H]:
+ Don't use this definition unless HAVE_VSPRINTF is also defined.
+ (error, line_error, warning) [HAVE_VARARGS_H]: Don't use this
+ definition unless HAVE_VFPRINTF is also defined.
+ Remove indentation of all cpp directives, except for #pragma.
+
+Fri May 21 14:34:24 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * texinfo.texi: Rename to texi.texi.
+ Change @setfilenname and START-INFO-DIR-ENTRY to `texi.info'.
+
+ * Makefile.in (MDEFINES): Pass LDFLAGS to sub-makes.
+ (realclean): Delete `configure'.
+ Changed all references to texinfo.info to texi.info
+
+ * configure.in: Add AC_PROG_RANLIB, and AC_CONST.
+ Check for `rindex' function.
+ Check for varargs.h.
+ Clean up symbol names for header files so a single AC_HAVE_HEADERS
+ can be used.
+ (AC_INIT): Use texi.texi instead of makeinfo/makeinfo.c
+
+ * info/info-utils.h: Copy definitions of bcopy, index, and rindex
+ (with appropriate #ifdef wrappers) from termdep.h. These are
+ included by a mutually exclusive set of files.
+
+ * info/termdep.h [HAVE_SYS_PTEM]: Use HAVE_SYS_PTEM_H instead.
+
+ * info/terminal.c, info/termdep.h [HAVE_TERMIO]: Use HAVE_TERMIO_H
+ instead.
+
+ * info/makedoc.c, info/filesys.c [!O_RDONLY]: Include fcntl.h or
+ sys/fnctl.h, depending on whether HAVE_SYS_FCNTL_H is set.
+
+ * info/termdep.h: Remove all indentation in #-exprs.
+ Remove old assumptions about bcopy, index, and rindex.
+ [HAVE_BCOPY]: Define bcopy.
+ [HAVE_RINDEX]: Define index and rindex.
+
+ * info/nodes.c (info_get_node): Don't call stricmp if nodename is
+ NULL. Remove indentation in #-exprs.
+
+ * info/echo_area.c (echo_area_stack_depth): Declare static.
+
+ * info/Makefile.in (DEFAULT_INFOPATH): Make separate Makefile
+ variable so it can be overridden more easily by the user. Add `.'
+ to beginning of path.
+ (clean): Delete core.* (386bsd core files).
+ (MAKEDOC): Variable removed. Refer to `makedoc' explicitly.
+ (funs.h): Add `:' commands after if, to avoid spurious nonzero
+ exit statuses.
+
+ * info/userdoc.texi: Improved comments explaining its purpose.
+
+ * makeinfo/makeinfo.c [HAVE_VARARGS_H]: Include varargs.h.
+ (error, line_error, warning, add_word_args,
+ execute_string)[HAVE_VARARGS_H]: New versions that
+ use varargs. From bfox.
+
+ * makeinfo/Makefile.in (clean): Delete core.* (386bsd core files).
+
+ * util/Makefile.in (clean): Remove core.* (386bsd core files).
+
+ * libtxi/Makefile.in: Remove all references to $(common).
+ (RANLIB): New variable, set from autoconf.
+ (libtxi.a): Use $(RANLIB) instead of `ranlib' in target rules.
+ (clean): Delete core.* (386bsd core files).
+
+Tue May 18 12:08:24 1993 Robert J. Chassell (bob at grackle.stockbridge.ma.us)
+
+ * emacs/texinfmt.el (texinfo-format-refill): Do not fill a section
+ title line with the asterisks, hyphens, etc. that underline
+ it in any circumstance.
+
+Sun May 16 13:53:43 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/mkinstalldirs: handle relative pathnames.
+
+Fri May 14 20:18:49 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/mkinstalldirs: initialize IFS if unset.
+
+Tue May 11 06:33:14 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * makeinfo/makeinfo.c (cm_item): don't dereference item_func if NULL.
+
+Mon May 10 14:50:31 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * Texinfo 3.0 released.
+
+ * Makefile.in (ALLOCA): Provide for substitution.
+
+Mon May 10 10:12:53 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * emacs/texinfmt.el (texinfmt-version): Updated year.
+
+Fri Apr 16 04:48:03 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * makeinfo/makeinfo.c: Version 1.54 from bfox.
+
+ * util/fixfonts: Replace instances of `[..]' with `test'.
+ Use more portable `test' arguments: `z$foo = z' instead of `! $foo'.
+ Robustify quoting in eval assignments.
+ (textfmdir, texpkdir, texgfdir): Don't override definition from
+ environment, if any.
+ Trap EXIT, SIGHUP, SIGINT, SIGQUIT, SIGTERM to delete temp files
+ instead of trying to remove them explicitly before calling exit.
+ When changing cwd, do so in subshell, in case various tex*dir
+ variables are relative.
+ Don't use `head', `dirname', or `basename'. These don't behave
+ consistently and/or don't even exist on some systems. They can
+ all be emulated with `sed' anyway.
+ (tempfile2_line1): New variable. Use it instead of running
+ process to extract first line out of tempfile2 multiple times.
+ Eliminate some gratuitous uses of $tempfile2, such as in for loops.
+
+Fri Mar 26 23:25:13 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * texinfo.texi: @setfilename texinfo.info.
+
+ * makeinfo/makeinfo.c (reader_loop, end_insertion): Fix typos in
+ comments.
+ (handle_variable_internal): Handle the case that there further
+ menu text after a false ifset/ifclear.
+
+ * util/texi2dvi: Version 0.4
+ Replace all instances of `[ ... ]' with `test'.
+ Updated bug-reporting address.
+
+Thu Mar 25 12:31:30 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * info/Makefile.in (install): Install info.1 man page.
+ (uninstall): Remove installed info.1 man page.
+
+ * info/infoman.texi: Standalone manual renamed to info-stnd.texi.
+ Makefile.in: Targets updated appropriately.
+
+ * info/Makefile.in (LDEFS): New variable. Use it for info-local
+ macros, since DEFS will be inherited from parent make and any
+ local definitions will get clobbered.
+
+ * info/RELEASE: Renamed to info/NEWS.
+
+ * README: New file.
+
+ * Makefile.in (topclean): New target.
+
+ * Getting-started: Renamed to INTRODUCTION. Former name is too
+ long (over 14 chars).
+
+ * New-features: Renamed to NEWS.
+
+ * Makefile.in (MDEFINES): Set it.
+
+ * Makefile.in (dist): Use --gzip option to tar to make sure
+ resulting file is compressed with gzip. Change tar file
+ extension from `.Z' to `.z'.
+
+ * Makefile.in (DISTFILES): Filter out any file or directory names
+ starting with `='.
+
+ * fixfonts: Moved to util/fixfonts.
+
+ * RELEASE: Deleted.
+
+ * makeinfo/Makefile.in (VPATH): Use $(srcdir), not @srcdir@.
+ (common): Use ../libtxi, not ../common.
+ (makeinfo.in): Run makeinfo with --no-split.
+
+ * makeinfo/makeinfo.texi: Changes from bob.
+
+ * util/Makefile.in (VPATH): Use $(srcdir), not @srcdir@.
+ (common): Use ../libtxi, not ../common.
+
+ * util/fixfonts: Moved from top-level directory.
+
+Wed Mar 24 10:21:31 1993 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-format-region): Do not require
+ `@setfilename' line; delete `\input texinfo' line if part of
+ region.
+
+ * emacs/texinfmt.el (texinfo-raise-lower-sections): Raise or lower the
+ hierarchical level of chapters, sections, etc. according to
+ `@raisesections' and `@lowersections' commands.
+
+Thu Mar 18 16:02:27 1993 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfo.el (texinfo-show-structure): Indent *Occur* buffer
+ according to the structure of the file.
+
+Sat Mar 6 05:16:44 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/texi2dvi: use ${1+"$@"}, not just "$@".
+
+Tue Feb 2 08:38:06 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * info/Makefile.in: Replace all "--nosplit" arguments to makeinfo
+ with "--no-split"
+
+Sun Jan 31 18:16:58 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/texi2dvi: Don't put .dvi and related auxillary files in same
+ directory as source files. Put them in current directory instead.
+ (TEXINPUTS_orig): New variable.
+ (file_texi): Variable removed.
+ (filename_texi): New variable.
+ (command_line_filename): Use this wherever references to file_texi
+ occured except in setting filename_noext.
+ (TEXINPUTS): Current directory and source directory where input
+ file resides prepended to standard path before invoking TeX.
+
+Wed Jan 27 16:24:37 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/Makefile.in: overhauled.
+
+Tue Jan 26 21:04:23 1993 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * Makefile.in, info/Makefile.in, makeinfo/Makefile.in: Overhauled.
+
+ * configure.in: Renamed from texinfo.in.
+ Incorporated makeinfo/makeinfo.in, info/info.in, and
+ util/util.in. Create all child Makefiles.
+
+ * makeinfo/makeinfo.in, info/info.in: Deleted (incorporated into
+ top configure.in).
+
+ * util/util.in: Deleted (incorporated into ../configure.in).
+
+Mon Jan 25 10:59:49 1993 Brian Fox (bfox@cubit)
+
+ * info/info.c: New version 2.9; new variable INFO_PATCH_LEVEL
+ appears in the version string if it is non-zero. New function
+ version_string () produces the current version string, as in 2.8-p1.
+
+ * info/dir.c: New file implements Gillespies `localdir' hacks.
+
+ * info/nodes.c (info_get_node): Now calls maybe_build_dir_node ()
+ if the file name to look for is "dir".
+
+ * info/nodes.h: New flag N_CannotGC unconditionally prevents garbage
+ collection of a file buffer's contents. Used when "dir" is made
+ from at least one "localdir".
+
+Fri Jan 22 11:36:42 1993 Brian Fox (bfox@cubit)
+
+ * info/footnotes.c: Do not declare auto_footnotes_p as "extern" in
+ this file.
+
+Thu Jan 21 08:57:08 1993 Brian Fox (bfox@cubit)
+
+ * info/info.c: New version 2.8.
+
+ * info/userdoc.texi, info/infoman.texi, info/info.texi: Fully
+ document Info; create both online and printed manual versions.
+ "userdoc.texi" contains exactly the documentation for GNU Info 2.x.
+ "infoman.texi" is a wrapper for that file; it is meant to produce
+ printed documentation. "info.texi" has the user documentation as a
+ complete chapter within itself, but continues to contain the Info
+ tutorial.
+
+ * info/makedoc.c: Convert "ea_" into "echo_area_" when creating the
+ command name.
+
+Fri Jan 15 16:50:35 1993 Brian Fox (bfox@cubit)
+
+ * info/search.c (skip_node_characters): New argument NEWLINES_OKAY if
+ non-zero says that newlines should be skipped over during parsing.
+
+ * info/info-utils.c (info_parse_node): New argument NEWLINES_OKAY if
+ non-zero says that newlines should be skipped while parsing out
+ the nodename specification.
+
+Wed Jan 13 14:42:33 1993 Brian Fox (bfox@cubit)
+
+ * info/makedoc.c: Remove "info_" from the front of the command name
+ before installing it.
+
+ * info/session.c (info_menu_or_ref_item): A label of "Menu" is okay if
+ the builder is not info_menu_of_node ();
+
+ * info/m-x.c: New function replace_in_documentation () replaces \\[foo]
+ with the keystrokes you type to get that command. Now used in
+ indices.c, info.c, infodoc.c.
+
+Mon Jan 11 10:27:41 1993 Brian Fox (bfox@cubit)
+
+ * info/variables.c, h: New files contain describe-variable and stuff
+ moved out of m-x.c.
+
+ * info/m-x.c: Move VARIABLE_ALIST and variable functions into
+ variables.c. Add documentation string to variable definition.
+
+ * info/echo_area.c (push_echo_area): Zero the contents of
+ echo_area_completion_items after pushing the vars.
+
+Sat Jan 9 11:59:47 1993 Brian Fox (bfox@cubit)
+
+ * info/Makefile.in: Add footnotes.c,h,o to the appropriate Makefile
+ variables.
+
+ * info/window.c (window_tile_windows): New function divides the
+ available space among the visible windows.
+
+ * info/session.c (info_tile_windows): New function calls
+ window_tile_windows.
+
+ * info/footnotes.c, footnotes.h: New file implements functions for
+ aiding automatic footnote display when entering a node which has
+ footnotes.
+
+ * info/m-x.c: New user-variable "automatic-footnotes".
+
+ * info/window.c (window_physical_lines) New function counts the
+ carriage returns found in NODE.
+
+Wed Jan 6 11:24:19 1993 Brian Fox (bfox@cubit)
+
+ * info/general.h: #include <unistd.h> if we have it.
+
+Tue Jan 5 11:12:33 1993 Brian Fox (bfox@cubit)
+
+ * info/info-utils.c (info_concatenate_references): If either arg is
+ NULL, return the other arg.
+
+ * info/indices.c (info_indices_of_file_buffer): Simplified and
+ corrected loop through tags/nodes of file buffer looking for
+ indices.
+
+ * info/search.c (skip_node_characters): Rewrite "if" statement for
+ clarification and conciseness.
+
+Fri Jan 1 03:18:26 1993 Brian Fox (bfox@cubit)
+
+ * info/info.in: Check for setvbuf (), and check to see whether the args
+ are reversed.
+
+ * info/dribble.c (open_dribble_file) Check HAVE_SETVBUF and
+ SETVBUF_REVERSED when setting the buffering on info_dribble_file.
+
+Thu Dec 31 20:14:13 1992 Brian Fox (bfox@cubit)
+
+ * info/session.c (info_select_reference) If the node couldn't be found,
+ look for the label as a filename (i.e., "(LABEL)Top").
+
+Wed Dec 30 01:57:50 1992 Brian Fox (bfox@cubit)
+
+ * New Version 2.7 Beta.
+
+ * info/echo_area.c: Numerous functions now do something with the
+ numeric argument. Kill ring implemented, as well as yank and
+ yank_pop. Also transpose-chars.
+
+ * info/window.c (window_make_modeline): Check node->flags for
+ N_IsCompressed and display "zz" in the modeline if the node comes
+ from a file which is compressed on disk.
+
+Mon Dec 28 17:33:12 1992 Brian Fox (bfox@cubit)
+
+ * info/filesys.c, info/nodes.c: New member of FILE_BUFFER "FILESIZE"
+ contains the size of file_buffer->contents. finfo.st_size is no
+ longer relied upon to read the contents of files, since the new
+ function (filesys_read_info_file) can read compressed files.
+
+ * info/filesys.c (info_find_fullpath) If a file starts with a slash (or
+ tilde expansion causes it to start with a slash) still call
+ info_find_file_in_path () on it so that we can find files with
+ compression suffixes.
+
+ * info/m-x.c: New variable "gc-compressed-files".
+
+Tue Dec 22 03:45:28 1992 Brian Fox (bfox@cubit)
+
+ * info/info.c: Version 2.6 Beta.
+
+ * info/indices.c (info_index_next): Improve the final search for the
+ matched index entry.
+
+ * info/session.c (move_to_screen_line): New function implements `M-r'.
+ Given a numeric argument, move point to the start of that line in
+ the current window; without an arg, move to the center line.
+ * infomap.c: Put move_to_screen_line () on `M-r'.
+
+ * info/nodes.c (adjust_nodestart): Don't set N_UpdateTags unless the
+ node came from a tags table.
+
+ * info/nodes.c (info_find_file_internal): If the filename being looked
+ for doesn't start with a `/', then additionally compare the
+ filename against the fullpath of the file buffer sans the
+ directory name. This can happen when selecting nodemenu items.
+
+Mon Dec 21 10:07:18 1992 Brian Fox (bfox@cubit)
+
+ * info/session.c, info/display.c: Remove all references to
+ active_window_ch, active_window_cv, cursor_h, and cursor_v. The
+ single function display_cursor_at_point () is used for all cursor
+ movement, and to place the terminal's cursor at the right location
+ on the screen.
+
+Sat Dec 19 12:01:33 1992 Brian Fox (bfox@cubit)
+
+ * info/nodemenu.c: New file implements a few functions for manipulating
+ previously visited nodes. `list-visited-nodes' produces a menu of
+ the nodes that could be reached by info_history_node () in some
+ window. `select-visited-node' is similar to `list-visited-node'
+ followed by `info-menu-item', but doesn't display a window with
+ the visited nodes menu.
+
+ * info/session.c (info_numeric_arg_digit_loop): If redisplay had been
+ interrupted, then redisplay all of the windows while waiting for
+ input.
+
+ * info/display.c (display_was_interrupted_p): New variable keeps track
+ of interrupted display. Used in
+ info/session.c:info_numeric_arg_digit_loop ().
+
+ * info/session.c (info_global_next, info_global_prev): Use the numeric
+ argument passed to determine how many nodes to move.
+
+ * info/session.c (info_scroll_forward, info_scroll_backward): If the
+ invoking key is not SPC or DEL only do Page Only scrolling.
+
+Thu Dec 17 01:34:22 1992 Brian Fox (bfox@cubit)
+
+ * info/display.c (display_update_one_window): Allow W_NoWrap to affect
+ window display.
+
+ * info/window.c (calculate_line_starts): Now takes a WINDOW * as an
+ argument, and simply does the calculation, placing the results
+ into window->line_starts and window->line_count. It also handles
+ W_NoWrap in window->flags.
+
+Mon Dec 14 02:18:55 1992 Brian Fox (bfox@cubit)
+
+ * info/session.c (info_backward_scroll): Don't try to get previous node
+ if the top of the node isn't currently being displayed.
+
+ * info/window.c (window_adjust_pagetop) Use new variable
+ "window_scroll_step" to attempt to control the amount which the
+ window scrolls.
+
+ * info/m-x.c (info_variables) Add "scroll-step" to the list.
+
+Thu Dec 10 08:52:10 1992 Brian Fox (bfox@cubit)
+
+ * info/m-x.c: New variable entry show-index-matches. When set to
+ non-zero the matched portion of the search string is indicated
+ with ` and '. Perhaps I should use `|' inst|ea|d?
+
+ * info/echo_area.c (ea_possible_completions): Always build completions
+ before checking to see how many there were.
+
+ * info/info-utils.c: (info_concatenate_references): New utility
+ function concatenates references.
+
+ * info/Makefile.in: Add indices.c and indices.h to SRCS and HDRS.
+ Add indices.c to CMDFILES.
+
+ * info/indices.c, info/indices.h: New file implements `i' and `,'
+ commands of info, and provides index searching capabilities.
+
+ * info/echo_area.c (info_read_completing_in_echo_area): Split off into
+ separate callable function info_read_completing_internal ().
+
+ * info/echo_area.c (info_read_maybe_completing): New function calls
+ info_read_completing_internal () with non-forcing argument.
+
+ * info/session.c: Rename down_next_upnext_or_error () and
+ prev_up_or_error () to forward_move_node_structure (), and
+ backward_move_node_structure (). Implement new commands
+ info_global_next () and info_global_prev ().
+
+ * info/infomap.c (initialize_info_keymaps): Bind `[' and `]' to
+ backward_, forward_move_node_structure () respectively.
+
+ * info/session.c (info_menu_digit): Called with "0" as arg, select the
+ last menu item.
+
+ * info/infomap.c (initialize_info_keymaps): "0" calls
+ info_menu_digit ().
+
+ * info/session.c (info_move_to_xref): Take dir into account when there
+ are xrefs and menu items in the node and we are wrapping
+ backwards.
+
+Tue Dec 8 09:57:58 1992 Brian Fox (bfox@cubit)
+
+ * info/info.c: Version 2.5 Beta.
+
+ * info/terminal.c (terminal_insert_lines, terminal_delete_lines) Do not
+ expect tgoto to return a new string; it returns the address of a
+ static buffer.
+
+ * info/infodoc.c (info_find_or_create_help_window) Correct check for
+ prior existing help node.
+
+ * info/m-x.c (set_variable): Allow variables to have a list of choices.
+ Add new variable scroll-behaviour.
+
+ * info/session.c (down_next_upnext_or_error, prev_up_or_error) New
+ functions implement user-controlled behaviour when attempting to
+ scroll past the bottom or top of a node. New variable
+ info_scroll_behaviour is user visible as "scroll-behaviour".
+
+ * info/session.c (info_scroll_forward, info_scroll_backward) Call new
+ functions for user-controlled scroll behaviour.
+
+ * info/terminal.c (terminal_initialize_terminal) Set PC from BC not
+ from BUFFER.
+
+Mon Dec 7 11:26:12 1992 Brian Fox (bfox@cubit)
+
+ * util/texindex.c: Change EXIT_SUCCESS and EXIT_FATAL to TI_NO_ERROR
+ and TI_FATAL_ERROR respectively. This avoids namespace conflicts
+ on NeXT 2.0.
+
+Sat Dec 5 00:07:59 1992 Brian Fox (bfox@cubit)
+
+ * info/info.c: New option "--subnodes" says to recursively dump the
+ menus of the nodes that you wish to dump. Menu items which point
+ to external nodes are not dumped, and no node is dumped twice.
+
+Thu Dec 3 16:11:02 1992 Brian Fox (bfox@cubit)
+
+ * info/session.c (info_error) Don't ring the bell if
+ info_error_rings_bell_p is zero. (info_abort_key) Ring the bell
+ if printing "Quit" in the echo area wouldn't do it.
+
+ * info/m-x.c (set_variable) New functions allows setting of
+ variables in the echo area. Currently, only visilble-bell and
+ errors-ring-bell are implemented.
+
+Wed Dec 2 13:11:37 1992 Brian Fox (bfox@cubit)
+
+ * info/nodes.c, info/makedoc.c: If O_RDONLY is not defined by
+ sys/file.h, include sys/fcntl.h.
+
+ * info/filesys.c (info_file_in_path): Expand leading tildes found
+ within directory names.
+
+ * info/terminal.c (terminal_initialize_terminal) Set ospeed to 13 if
+ not settable any other way. It is an index into an array of
+ output speeds.
+
+ * info/display.c (free_display) Do not free a NULL display.
+
+ * info/display.c (string_width): New functions returns the width of
+ STRING when printed at HPOS.
+
+Sun Nov 29 01:24:42 1992 Brian Fox (bfox@cubit)
+
+ * info/info.c: New version 2.4 beta.
+
+ * info/general.h: #define info_toupper and info_tolower which check
+ their arguments before performing any conversion.
+
+ * info/search.c, info/echo_area.c: Use info_toupper.
+
+Sat Nov 28 14:23:24 1992 Brian Fox (bfox@cubit)
+
+ * info/session.c (info_scroll_forward, info_scroll_backward) If at
+ last/first page of the node, and the last command was
+ forward/backward, do info_next/prev/_node.
+
+ * info/session.c: New function info_select_reference_this_line gets
+ menu or cross reference immediately.
+
+ * info/infomap.c (initialize_info_keymaps): Add info_keymap[LFD] to
+ invoke info_select_reference_this_line ().
+
+ * info/session.c (info_last_reference) Rename to
+ info_history_reference. Wrote info_last_reference, and
+ info_first_reference which go to the last or first node of an info
+ file.
+
+Fri Nov 27 00:59:02 1992 Brian Fox (bfox@cubit)
+
+ * info/info.c: New version 2.3. Completed implementing contents of
+ TODO file.
+
+ * info/session.c (info_redraw_display): Fix C-l with numeric arg.
+
+Thu Nov 26 20:14:18 1992 Brian Fox (bfox@cubit)
+
+ * info/m-x.c: New file implements reading named commands in the echo
+ area, along with a new function "info-set-screen-height".
+ Compilation of this file and some code in others controlled by the
+ Makefile variable NAMED_COMMANDS (set to -DNAMED_COMMANDS).
+
+ * info/window.c (window_new_screen_size) Rewrite from scratch, allowing
+ clean growth and shrinkage of the screen. New variable
+ window_deletion_notifier is a pointer to a function to call when
+ the screen changes size, and some windows have to get deleted.
+ The function is called with the window to be deleted as an
+ argument, and it should clean up dangling references to that
+ window.
+
+ * info/session.c (initialize_info_session): Set
+ window_deletion_function to forget_window_and_nodes.
+
+ * info/display.c (display_update_one_window): If the first row of the
+ window to display wouldn't appear in the_screen, don't try to
+ display it. This happens when the screen has been made
+ unreasonably small, and we attempt to display the echo area.
+
+Tue Nov 24 00:47:20 1992 Brian Fox (bfox@cubit)
+
+ * Release Info 2.2.
+
+ * info/session.c: New functions implement reading typeahead and
+ implement C-g flushing typed ahead characters.
+ (info_search_internal): allows C-g to exit multi-file searches.
+
+Mon Nov 23 01:53:35 1992 Brian Fox (bfox@cubit)
+
+ * info/nodes.c: Remove calls to sscanf (), replacing them with calls to
+ atol (), since that is much faster.
+ (get_nodes_of_tags_table) Only check for "(Indirect)" if we
+ haven't parsed any nodes out of the tags table. Increase the
+ amount that file_buffer->nodes grows to 100 from 50. These two
+ together sufficiently speed up the parsing process.
+
+ * info/nodes.c: info_get_node_of_file_buffer_tags (),
+ info_get_node_of_file_buffer_nodes (): Search the appropriate list
+ and return a node. This was simply a cut and paste edit to
+ functionalize the code.
+
+ * info/TODO: Remove suggestion for partial tag parsing, since tag
+ parsing is much faster now.
+
+Sat Nov 21 02:48:23 1992 Brian Fox (bfox@cubit)
+
+ * info/makedoc.c: New File replaces makedoc.sh shell script.
+
+ * info/infomap.c: Install info_isearch (on C-s) and
+ info_reverse_isearch (on C-r) for Info windows.
+
+ * info/session.c (incremental_search, info_isearch,
+ info_reverse_isearch) New functions implement incremental
+ searching.
+
+Fri Nov 20 00:01:35 1992 Brian Fox (bfox@cubit)
+
+ * info/terminal.c (terminal_initialize_terminal): Declare and set up
+ `ospeed'. Turn off C-s and C-q processing.
+
+ * info/session.c (info_show_point) When this function is called, the
+ desired result is to show the point immediately. So now it calls
+ set_window_pagetop () if the new pagetop is not the same as the
+ old one. This means that info_prev_line (), info_next_line (),
+ info_forward_word (), and info_backward_word () can all scroll the
+ window if they have to.
+
+Thu Nov 19 12:27:07 1992 Brian Fox (bfox@cubit)
+
+ * info/session.c (set_window_pagetop): Add scrolling to make this
+ faster.
+
+ * info/echo_area.c (push/pop_echo_area): Remember the list of items to
+ complete over.
+
+ * info/session.c (info_forward_char): Don't let point get equal to
+ nodelen, only to nodelen - 1.
+
+ * info/display.c: New function display_scroll_display () scrolls the
+ rmembered display as well as the text on the actual display.
+
+ * info/terminal.c: New functions terminal_scroll_terminal (),
+ terminal_scroll_down (), and terminal_scroll_up (). All
+ implemented using "al" and "dl" termcap capabilities. (i.e.,
+ insert and delete line).
+
+Wed Nov 18 15:05:14 1992 Brian Fox (bfox@cubit)
+
+ * info/termdep.h: Only define HAVE_FCNTL_H if !aix and !ultrix.
+
+Tue Nov 17 20:35:08 1992 Brian Fox (bfox@cubit)
+
+ * First Beta Release of Info 2.0.
+
+Sun Nov 1 02:21:05 1992 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/texi2dvi (--force): Option removed. Always run tex at least
+ once, don't bother checking if .dvi file is newer than source.
+
+Fri Oct 30 02:16:28 1992 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/texi2dvi (-D): debugging option renamed from '-d'.
+ Made check to enable debugging more terse.
+ When checking if index files have changed, use
+ variable $this_file instead of $file in for loop.
+ (file_texi): wherever the variable $file was used to reference
+ the texinfo file, substituted $file_texi.
+
+Sat Oct 17 07:30:34 1992 Brian J. Fox (bfox@helios)
+
+ * util/texindex.c: Remove references to USG replacing them with a
+ define declaring the actual feature required or missing.
+
+Thu Oct 15 16:17:47 1992 Robert J. Chassell (bob@nutrimat.gnu.ai.mit.edu)
+
+ * emacs/texinfmt.el (texinfo-format-setfilename): Remove date from
+ Info file header so regression testing is easier.
+
+Tue Sep 15 16:28:35 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfmt-version): New variable.
+ (texinfo-format-setfilename): Include date and
+ version in Info file header.
+ Better documentation for @definfoenclose
+ Handle whitespace after @end iftex, etc.
+
+Thu Sep 3 09:25:37 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el: Fix typo re `texinfo-sequential-node-update.'
+
+Tue Aug 18 08:56:24 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-value): Revise syntax.
+
+ * emacs/texnfo-upd.el (texinfo-start-menu-description):
+ New function to insert title as description in a menu.
+ (texinfo-make-menu-list): Remove automatic title insertion.
+
+ * emacs/texinfo.el (texinfo-mode-map): Add keybinding for
+ texinfo-start-menu-description.
+
+Wed Jul 29 11:58:53 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-set): Revise to set a string to the flag.
+ (texinfo-value): @value{flag}: New command which inserts the
+ string to which the flag is set.
+
+Tue Jul 7 15:10:52 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el (texinfo-master-menu): Error message if file
+ contains too few nodes for a master menu.
+ (texinfo-insert-master-menu-list): Only attempt to insert detailed
+ master menu if there is one.
+
+Wed Jun 10 15:26:18 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-append-refill): Refill properly when lines
+ begin with within-paragraph @-commands.
+
+Tue Jun 9 12:28:11 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el: Add `texinfo-deffn-formatting-property' and
+ `texinfo-defun-indexing-property' to @deffn commands.
+
+Mon Jun 8 11:52:01 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el: Replace `(mark-whole-buffer)' with
+ `(push-mark (point-max) t) (goto-char (point-min))'
+ to avoid `Mark set' messages.
+
+Fri Jun 5 15:15:16 1992 Robert J. Chassell (bob@kropotkin.gnu.ai.mit.edu)
+
+ * emacs/texnfo-upd.el (texinfo-check-for-node-name): Offer section
+ title as prompt.
+ (texinfo-copy-next-section-title): Copy title correctly.
+
+Thu May 28 20:34:17 1992 Robert J. Chassell (bob@hill.gnu.ai.mit.edu)
+
+ * emacs/texinfmt.el: @vtable defined, parallel to @ftable, for
+ variables.
+ (texinfo-append-refill): set case-fold-search nil so @TeX is not
+ confused with @tex.
+
+Thu Mar 26 21:36:41 1992 Robert J. Chassell (bob@kropotkin.gnu.ai.mit.edu)
+
+ * emacs/makeinfo.el: Rename temp buffer from `*Makeinfo*' back to
+ `*compilation*' so `next-error' works; unfortunately,
+ `*compilation*' is written into the code as the name
+ `next-error' needs.
+ Rename `makeinfo-recenter-makeinfo-buffer' back to
+ `makeinfo-recenter-makeinfo-buffer'
+
+Thu May 14 21:14:25 1992 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/fixfonts: Enclosed most variable references with "" to prevent
+ potential globbing and other weirdness. Eliminated uses of
+ ${var-value}, which unfortunately isn't portable.
+
+ * util/texi2dvi: rewritten from scratch.
+
+Sat Apr 18 23:46:25 1992 Charles Hannum (mycroft@hal.gnu.ai.mit.edu)
+
+ * util/fixfonts: Re-evaluate prefix and libdir if inherited (to resolve
+ variable references from make).
+ (texlibdir): Don't add '/tex', since it's already there.
+
+Fri Apr 10 14:51:23 1992 Noah Friedman (friedman@prep.ai.mit.edu)
+
+ * util/fixfonts: set prefix and libdir only if they are not already
+ defined (i.e. not inherited from the environment).
+ Changed default path for libdir to be consistent with Makefile.
+
+Tue Mar 3 13:17:42 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el (texinfo-insert-master-menu-list): Insert a
+ master menu only after `Top' node and before next node.
+ (texinfo-copy-menu): Error message if menu empty.
+
+Mon Feb 24 15:47:49 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-format-region): Make sure region ends in a
+ newline.
+ (texinfo-itemize-item): Recognize all non-whitespace on same line
+ as @item command.
+
+Sat Feb 22 02:15:00 1992 Brian Fox (bfox at gnuwest.fsf.org)
+
+ * util/texindex.c: New version 1.45 has cleanups, should compile under
+ VMS quietly.
+
+Wed Feb 12 10:50:51 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/makeinfo.el: Rename temp buffer as *Makeinfo*.
+ Rename `makeinfo-recenter-compilation-buffer'.
+ (makeinfo-buffer): Offer to save buffer if it is modified.
+ (makeinfo-compile): Do not offer to save other buffers.
+ (makeinfo-compilation-sentinel): Switch to Info file.
+
+Tue Feb 4 13:07:39 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-print-index): Format so that node names in
+ the index are lined up.
+
+Mon Feb 3 09:08:14 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-itemize-item): Format entry when text
+ is on the same line as @item command. Also, handle @-commands.
+ (texinfo-format-region, texinfo-format-buffer-1): Set fill column
+ to local value of Texinfo buffer.
+
+ * emacs/texnfo-upd.el (texinfo-pointer-name): Find only those
+ section commands that are accompanied by `@node' lines.
+
+Tue Jan 14 16:10:16 1992 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el: Ensure that no commands depend on the value of
+ case-fold-search.
+
+Fri Jan 10 15:13:55 1992 Robert J. Chassell (bob at kropotkin)
+
+ * emacs/texinfmt.el (texinfo-append-refill): Replace use of
+ unsupported function `looking-at-backward' with
+ `re-search-backward'.
+
+Mon Dec 23 23:46:42 1991 David J. MacKenzie (djm at wookumz.gnu.ai.mit.edu)
+
+ * util/texindex.c: Change POSIX ifdefs to HAVE_UNISTD_H and
+ _POSIX_VERSION.
+
+Mon Dec 16 15:01:36 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-append-refill): New function appends
+ @refill to all appropriate paragraphs so you no longer need to
+ append @refill command yourself.
+ (texinfo-format-region, texinfo-format-buffer-1,
+ texinfo-format-include): Call `texinfo-append-refill'.
+
+Fri Dec 6 01:25:09 1991 David J. MacKenzie (djm at wookumz.gnu.ai.mit.edu)
+
+ * util/texindex.c: Conditionalize on _AIX (which is predefined) instead
+ of AIX, just like makeinfo does.
+
+Tue Nov 26 10:21:04 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el (texinfo-section-types-regexp): `@subtitle' no
+ longer treated as subsection.
+
+Sat Nov 16 08:27:42 1991 Richard Stallman (rms at mole.gnu.ai.mit.edu)
+
+ * util/fixfonts: New file, from Karl Berry.
+
+Tue Nov 12 16:13:24 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el: Create @end smalllisp.
+
+Mon Nov 11 16:50:13 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfo.el (texinfo-environment-regexp): Add all other block
+ enclosing Texinfo commands.
+
+Thu Nov 7 10:23:51 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfo.el (texinfo-insert-@end): Attempt to insert correct end
+ command statement, eg, @end table. Fails with nested lists.
+ (texinfo-insert-*): Accept prefix arg to surround following N
+ words with braces for command.
+
+Thu Oct 31 21:31:41 1991 Robert J. Chassell (bob at kropotki)
+
+ * emacs/texinfmt.el (texinfo-clear): Clear flag even if flag not
+ previously set.
+
+Wed Oct 23 11:15:58 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfo.el (texinfo-mode): page-delimiter now finds top node as
+ well as chapters.
+
+Tue Oct 22 11:46:12 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-do-flushright): Test whether a line is too
+ long for the flush right command (line length must be less than
+ the value of fill column).
+
+ * emacs/texnfo-tex.el (texinfo-tex-buffer): Prompt for original file
+ even if point moved to *texinfo-tex-shell*.
+ texinfo-tex-original-file: variable to hold file name.
+
+Wed Oct 16 08:32:05 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-format-center): Expand string before
+ centering so @-commands not included.
+
+Thu Oct 10 22:01:47 1991 Robert J. Chassell (bob at kropotki)
+
+ * emacs/texnfo-tex.el (texinfo-show-tex-print-queue): Do not kill a
+ running process; do start a process none exists.
+
+Thu Sep 26 21:58:47 1991 Robert J. Chassell (bob at kropotki)
+
+ * util/texi2dvi: Misc. bugs fixed.
+
+ * emacs/texinfo.el: Remove extraneous references to TeX.
+
+Thu Sep 19 20:45:29 1991 Robert J. Chassell (bob at kropotki)
+
+ * emacs/texinfmt.el: add @cartouche as a noop (makes box with rounded
+ corners in TeX)
+
+Tue Sep 10 20:44:57 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el (texinfo-make-one-menu): Copy node-name correctly
+ for message.
+
+Thu Aug 29 17:54:07 1991 Robert J. Chassell (bob at kropotki)
+
+ * emacs/texnfo-tex.el (texinfo-quit-tex-job): Do not set mark.
+
+Wed Aug 21 10:36:21 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el: (texinfo-copy-menu-title): Copy title as it
+ should rather than node line.
+
+Mon Aug 5 15:27:12 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el (texinfo-format-convert): Changed regexp that
+ looks for three hyphens in a row to find those between word
+ constituent characters, as now, for Oxford Univ. style dashes and
+ also between spaces, for Cambridge Univ. Press style dashes.
+
+ * emacs/texnfo-tex.el (texinfo-tex-start-shell): Runs "/bin/sh" so
+ `explicit-shell-file-name' is not set globally.
+
+ * emacs/texnfo-upd.el: Rewrite messages.
+ (texinfo-find-higher-level-node): Stop search at limit.
+ (texinfo-copy-menu-title): Rewrite to handle outer include files.
+ (texinfo-multi-file-update): Update all nodes properly;
+ rewrite doc string and interactive.
+
+Sat Aug 3 10:46:13 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-upd.el (texinfo-all-menus-update): Fixed typo that
+ caused the function to create a master menu when it shouldn't.
+
+ * emacs/texinfo.el (texinfo-mode): Make `indent-tabs-mode' a local
+ variable and set to nil to prevent TABs troubles with TeX.
+
+Wed Jul 31 11:07:08 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texnfo-tex.el (texinfo-quit-tex-job): New function: quit
+ currently running TeX job, by sending an `x' to it.
+ (texinfo-tex-shell-sentinel): New function to
+ restart texinfo-tex-shell after it is killed.
+ (texinfo-kill-tex-job): Rewrite to use kill-process rather than
+ quit-process; uses `texinfo-tex-shell-sentinel' to restart
+ texinfo-tex-shell after it is killed.
+ (texinfo-tex-region, texinfo-tex-buffer): Replace
+ texinfo-kill-tex-job with quit-process.
+
+ * emacs/texinfo.el (texinfo-define-common-keys): Add keybinding for
+ texinfo-quit-tex-job
+
+Wed Jul 10 15:15:03 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el: New commands @set, @clear, @ifset...@end
+ ifset, and @ifclear...@end ifclear.
+ Definition functions rewritten to make them easier to
+ maintain.
+
+Wed Jul 3 19:37:04 1991 Robert J. Chassell (bob at kropotki)
+
+ * emacs/texinfmt.el (texinfo-format-deftypefn-index): Remove reference
+ to data-type to make consistent with texinfo.tex and makeinfo.
+ texinfo.el: Fix page-delimiter and texinfo-chapter-level-regexp
+ variables.
+
+Thu Jun 27 18:35:36 1991 Robert J. Chassell (bob at nutrimat)
+
+ * emacs/texinfmt.el: Add @dmn as `texinfo-format-noop'.
+ texinfo2.texi: Document @dmn.
+ texinfmt.el (texinfo{,-end}-{eleterate,ecapitate} renamed
+ {alphaenumerate, capsenumerate}.
+
+Fri Jun 14 12:46:32 1991 Robert J. Chassell (bob at churchy.gnu.ai.mit.edu)
+
+ * emacs/texinfmt.el (texinfo-format-defun-1): @defivar prints name
+ correctly.
+
+Thu Jun 6 21:38:33 1991 Robert J. Chassell (bob at churchy.gnu.ai.mit.edu)
+
+ * emacs/texinfo.el (texinfo-mode): Set page delimiter to
+ 'texinfo-chapter-level-regexp' so that page commands work by
+ chapter or equivalent.
+
+ * emacs/texinfmt.el (texinfo-format-defun-1): @defop prints name
+ correctly.
+ (batch-texinfo-format): replace unsupported
+ 'buffer-disable-undo' with 'buffer-flush-undo'
+
+Fri Apr 5 15:17:17 1991 Robert J. Chassell (bob at wookumz.gnu.ai.mit.edu)
+
+ * emacs/makeinfo.el (makeinfo-compilation-sentinel): Check for
+ existance of makeinfo-temp-file to avoid harmless error message.
+ texinfo2.texi: Minor typos fixed.
+
+Thu Mar 28 19:13:24 1991 Robert J. Chassell (bob at pogo.gnu.ai.mit.edu)
+
+ * util/texi2dvi: Revised.
+
+Mon Mar 11 12:35:51 1991 Robert J. Chassell (bob at grackle)
+
+ * emacs/texinfmt.el: (@footnotestyle): New command to set
+ footnotestyle.
+ (@paragraphindent): New command to set indentation.
+ (texinfo-format-refill): Add indentation feature so as to
+ indent paragraph or leave indentation asis before refilling
+ according to value set by @paragraphindent command.
+ (texinfo-format-region): Insert header, if any, into Info buffer.
+ (texinfo-format-separate-node, texinfo-format-end-node): Run
+ texinfo-format-scan on footnote text only once.
+ (texinfo-format-scan): Shorten `---' to `--'.
+
+ * emacs/texinfo.el: Define key for `texinfo-master-menu'; define
+ start and end of header expressions.
+
+ * emacs/texnfo-upd.el (texinfo-all-menus-update): Update
+ pre-existing master menu, if there is one.
+
+Fri May 11 14:36:07 1990 Richard Stallman (rms at sugar-bombs.ai.mit.edu)
+
+ * util/texindex.c: Rename `lines' to `nlines'.
+ (bzero): Pass arg to lib$movc5 through non-register var.
+ (perror_with_file, pfatal_with_file): Move extern decls and includes
+ to top of file.
+ [VMS]: If not using VMS C, define away `noshare' keyword.
+ Include perror.h.
+
+Mon Jul 11 18:02:29 1988 Chris Hanson (cph at kleph)
+
+ * util/texindex.c (indexify): when comparing to initial strings to
+ decide whether to change the header, must use `strncmp' to avoid
+ comparing entire strings of which initials are a substring.
+
+Sun Jun 26 18:46:16 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu)
+
+ * util/texindex.c (sort_in_core, sort_offline, parsefile):
+ Give up on input file if any line doesn't start with backslash.
diff --git a/texinfo/INSTALL b/texinfo/INSTALL
new file mode 100644
index 00000000000..a2c8722ccaf
--- /dev/null
+++ b/texinfo/INSTALL
@@ -0,0 +1,181 @@
+Basic Installation
+==================
+
+ These are generic installation instructions.
+
+ The `configure' shell script attempts to guess correct values for
+various system-dependent variables used during compilation. It uses
+those values to create a `Makefile' in each directory of the package.
+It may also create one or more `.h' files containing system-dependent
+definitions. Finally, it creates a shell script `config.status' that
+you can run in the future to recreate the current configuration, a file
+`config.cache' that saves the results of its tests to speed up
+reconfiguring, and a file `config.log' containing compiler output
+(useful mainly for debugging `configure').
+
+ If you need to do unusual things to compile the package, please try
+to figure out how `configure' could check whether to do them, and mail
+diffs or instructions to the address given in the `README' so they can
+be considered for the next release. If at some point `config.cache'
+contains results you don't want to keep, you may remove or edit it.
+
+ The file `configure.in' is used to create `configure' by a program
+called `autoconf'. You only need `configure.in' if you want to change
+it or regenerate `configure' using a newer version of `autoconf'.
+
+The simplest way to compile this package is:
+
+ 1. `cd' to the directory containing the package's source code and type
+ `./configure' to configure the package for your system. If you're
+ using `csh' on an old version of System V, you might need to type
+ `sh ./configure' instead to prevent `csh' from trying to execute
+ `configure' itself.
+
+ Running `configure' takes awhile. While running, it prints some
+ messages telling which features it is checking for.
+
+ 2. Type `make' to compile the package.
+
+ 3. Optionally, type `make check' to run any self-tests that come with
+ the package.
+
+ 4. Type `make install' to install the programs and any data files and
+ documentation.
+
+ 5. You can remove the program binaries and object files from the
+ source code directory by typing `make clean'. To also remove the
+ files that `configure' created (so you can compile the package for
+ a different kind of computer), type `make distclean'. There is
+ also a `make maintainer-clean' target, but that is intended mainly
+ for the package's developers. If you use it, you may have to get
+ all sorts of other programs in order to regenerate files that came
+ with the distribution.
+
+Compilers and Options
+=====================
+
+ Some systems require unusual options for compilation or linking that
+the `configure' script does not know about. You can give `configure'
+initial values for variables by setting them in the environment. Using
+a Bourne-compatible shell, you can do that on the command line like
+this:
+ CC=c89 CFLAGS=-O2 LIBS=-lposix ./configure
+
+Or on systems that have the `env' program, you can do it like this:
+ env CPPFLAGS=-I/usr/local/include LDFLAGS=-s ./configure
+
+Compiling For Multiple Architectures
+====================================
+
+ You can compile the package for more than one kind of computer at the
+same time, by placing the object files for each architecture in their
+own directory. To do this, you must use a version of `make' that
+supports the `VPATH' variable, such as GNU `make'. `cd' to the
+directory where you want the object files and executables to go and run
+the `configure' script. `configure' automatically checks for the
+source code in the directory that `configure' is in and in `..'.
+
+ If you have to use a `make' that does not supports the `VPATH'
+variable, you have to compile the package for one architecture at a time
+in the source code directory. After you have installed the package for
+one architecture, use `make distclean' before reconfiguring for another
+architecture.
+
+Installation Names
+==================
+
+ By default, `make install' will install the package's files in
+`/usr/local/bin', `/usr/local/man', etc. You can specify an
+installation prefix other than `/usr/local' by giving `configure' the
+option `--prefix=PATH'.
+
+ You can specify separate installation prefixes for
+architecture-specific files and architecture-independent files. If you
+give `configure' the option `--exec-prefix=PATH', the package will use
+PATH as the prefix for installing programs and libraries.
+Documentation and other data files will still use the regular prefix.
+
+ In addition, if you use an unusual directory layout you can give
+options like `--bindir=PATH' to specify different values for particular
+kinds of files. Run `configure --help' for a list of the directories
+you can set and what kinds of files go in them.
+
+ If the package supports it, you can cause programs to be installed
+with an extra prefix or suffix on their names by giving `configure' the
+option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'.
+
+Optional Features
+=================
+
+ Some packages pay attention to `--enable-FEATURE' options to
+`configure', where FEATURE indicates an optional part of the package.
+They may also pay attention to `--with-PACKAGE' options, where PACKAGE
+is something like `gnu-as' or `x' (for the X Window System). The
+`README' should mention any `--enable-' and `--with-' options that the
+package recognizes.
+
+ For packages that use the X Window System, `configure' can usually
+find the X include and library files automatically, but if it doesn't,
+you can use the `configure' options `--x-includes=DIR' and
+`--x-libraries=DIR' to specify their locations.
+
+Specifying the System Type
+==========================
+
+ There may be some features `configure' can not figure out
+automatically, but needs to determine by the type of host the package
+will run on. Usually `configure' can figure that out, but if it prints
+a message saying it can not guess the host type, give it the
+`--host=TYPE' option. TYPE can either be a short name for the system
+type, such as `sun4', or a canonical name with three fields:
+ CPU-COMPANY-SYSTEM
+
+See the file `config.sub' for the possible values of each field. If
+`config.sub' isn't included in this package, then this package doesn't
+need to know the host type.
+
+ If you are building compiler tools for cross-compiling, you can also
+use the `--target=TYPE' option to select the type of system they will
+produce code for and the `--build=TYPE' option to select the type of
+system on which you are compiling the package.
+
+Sharing Defaults
+================
+
+ If you want to set default values for `configure' scripts to share,
+you can create a site shell script called `config.site' that gives
+default values for variables like `CC', `cache_file', and `prefix'.
+`configure' looks for `PREFIX/share/config.site' if it exists, then
+`PREFIX/etc/config.site' if it exists. Or, you can set the
+`CONFIG_SITE' environment variable to the location of the site script.
+A warning: not all `configure' scripts look for a site script.
+
+Operation Controls
+==================
+
+ `configure' recognizes the following options to control how it
+operates.
+
+`--cache-file=FILE'
+ Use and save the results of the tests in FILE instead of
+ `./config.cache'. Set FILE to `/dev/null' to disable caching, for
+ debugging `configure'.
+
+`--help'
+ Print a summary of the options to `configure', and exit.
+
+`--quiet'
+`--silent'
+`-q'
+ Do not print messages saying which checks are being made.
+
+`--srcdir=DIR'
+ Look for the package's source code in directory DIR. Usually
+ `configure' can determine that directory automatically.
+
+`--version'
+ Print the version of Autoconf used to generate the `configure'
+ script, and exit.
+
+`configure' also accepts some other, not widely useful, options.
+
diff --git a/texinfo/INTRODUCTION b/texinfo/INTRODUCTION
new file mode 100644
index 00000000000..1d298ca36a7
--- /dev/null
+++ b/texinfo/INTRODUCTION
@@ -0,0 +1,119 @@
+Getting Started with Texinfo
+============================
+
+25 March 1993
+
+Most of the installation instructions are described in the file `INSTALL'.
+One additional note to make is that if your info files are in a nonstandard
+place (i.e. not in the `info' directory immediately under $prefix) you may
+wish to change the default info path as specified via DEFAULT_INFOPATH in
+info/Makefile.in.
+
+"Texinfo" is a documentation system that uses a single source file to
+produce both on-line information and printed output. Using Texinfo,
+you can create a printed document with the normal features of a book,
+including chapters, sections, cross references, and indices. From the
+same Texinfo source file, you can create a menu-driven, on-line Info
+file with nodes, menus, cross references, and indices.
+
+The name of the Texinfo source documentation file is `texinfo.texi'.
+You can produce both on-line information and printed output from this
+source file. The documentation describes Texinfo in detail, including
+how to write Texinfo files, how to format them for both hard copy and
+Info, and how to install Info files.
+
+To get started, you need to create either a printed manual or an
+on-line Info file from the `texinfo.texi' file. You do not need to
+create both, although you will probably want both eventually.
+
+To learn how to use Info, read the info documentation. You can do this in
+one of two ways: using the standalone `info' program, or using Info mode in
+GNU Emacs.
+
+ * If you want to use the `info' program, type
+
+ $ info -f info-stnd
+
+ * If you want to use Emacs, start up emacs and type `C-h i' [M-x info].
+ Follow the instructions to learn how to use Info.
+
+After learning how to use Info, you can read the Texinfo documentation.
+Using the standalone `info', type the following at the shell prompt:
+
+ $ info -f texinfo
+
+To use read this manual in Emacs, you first need to edit the Info-directory
+menu (the file `dir' in the system info directory) to contain the
+appropriate node. To learn how to do this, see node: Add in the Info
+documentation.
+
+The Texinfo documentation describes Texinfo in detail; among other things,
+it tells how to install Info files in the usual manner. (See node: Install
+an Info File.)
+
+The `info-stnd.info' file describes the standalone Info reader in detail. To
+read this file, type
+
+ $ info -f info-stnd
+
+If you are using GNU Emacs, you may want to install the Emacs Lisp files
+permanently. Move them them to a directory in the load-path for Emacs;
+otherwise Emacs will not be able to load the autoloaded support files, such
+as `texinfmt.el'.
+
+The `texinfo.el' file contains the autoload commands; it is the only
+file that needs to be loaded initially. If your Emacs does not
+automatically load `texinfo.el', you can tell it to do so by placing
+the following in `default.el' or in your `.emacs' file:
+
+ (load "texinfo")
+
+
+To create a printed manual
+==========================
+
+You need:
+
+ * The `tex' program, which typesets the manual using TeX.
+ * The `texinfo.tex' definition file that tells TeX how to typeset
+ a Texinfo file.
+ * The `texindex' program, which sorts the unsorted index files
+ created by TeX.
+ * A printing program such as `lp' or `lpr',
+ * A printer.
+
+This Texinfo distribution package contains `texinfo.tex', the C source
+for `texindex', and the handy shell script `texi2dvi'. The `tex'
+program is not part of this distribution, but is available separately.
+(See `How to Obtain TeX' in the Texinfo documentation.)
+
+ * Install `tex'. (`texindex' is installed automagically by
+ `make install' in this distribution.)
+
+ * Move the `texinfo.tex' file to an appropriate directory; the current
+ directory will do. (`/usr/local/lib/tex/inputs' might be a good place.
+ See ``Preparing to Use TeX'' in the Texinfo manual, for more
+ information.)
+
+After following those instructions, type the following to make the .dvi
+files:
+
+ $ make texinfo.dvi
+ $ (cd info; make info.dvi info-stnd.dvi)
+ $ (cd makeinfo; make makeinfo.dvi)
+
+You can then print the resulting .dvi files with the `lpr' command (on BSD
+systems. On SysV systems the command is `lp'. Consult your man pages for
+more information).
+
+For example, the command to print the texinfo.dvi file might be:
+
+ $ lpr -d texinfo.dvi
+
+The name of the printing command depends on the system; `lpr -d' is
+common, and is illustrated here. You may use a different name for the
+printing command.
+
+Please report bugs to bug-texinfo@prep.ai.mit.edu.
+
+Happy formatting.
diff --git a/texinfo/Makefile.in b/texinfo/Makefile.in
new file mode 100644
index 00000000000..4a5083853eb
--- /dev/null
+++ b/texinfo/Makefile.in
@@ -0,0 +1,244 @@
+# Makefile for Texinfo distribution.
+# $Id: Makefile.in,v 1.11 1996/10/04 18:40:33 karl Exp $
+#
+# Copyright (C) 1993, 96 Free Software Foundation, Inc.
+
+# This program 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.
+
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#### Start of system configuration section. ####
+
+srcdir = @srcdir@
+VPATH = $(srcdir):$(common)
+
+common = $(srcdir)/libtxi
+
+EXEEXT = @EXEEXT@
+CC = @CC@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+LN = ln
+RM = rm -f
+TAR = tar
+MKDIR = mkdir
+
+DEFS = @DEFS@
+LIBS = @LIBS@
+LOADLIBES = $(LIBS)
+
+ALLOCA = @ALLOCA@
+
+SHELL = /bin/sh
+
+CFLAGS = @CFLAGS@
+LDFLAGS = @LDFLAGS@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+# Prefix for each installed program, normally empty or `g'.
+binprefix =
+# Prefix for each installed man page, normally empty or `g'.
+manprefix =
+mandir = @mandir@/man$(manext)
+manext = 1
+infodir = @infodir@
+
+# For info program.
+DEFAULT_INFOPATH = $(infodir):.
+
+#### End of system configuration section. ####
+
+VERSION = 3.9
+DISTNAME = texinfo-$(VERSION)
+
+# Subdirectories that have makefiles
+SUBDIRS = libtxi makeinfo info util emacs
+
+# All subdirectories that go into a distribution
+ALL_SUBDIRS = $(SUBDIRS) makeinfo/macros
+
+MDEFINES = bindir='$(bindir)' mandir='$(mandir)' manext='$(manext)' \
+ prefix='$(prefix)' binprefix='$(binprefix)' \
+ manprefix='$(manprefix)' infodir='$(infodir)' CFLAGS='$(CFLAGS)' \
+ CC='$(CC)' ALLOCA='$(ALLOCA)' LDFLAGS='$(LDFLAGS)' \
+ DEFAULT_INFOPATH='$(DEFAULT_INFOPATH)' \
+ INSTALL='$(INSTALL)' INSTALL_DATA='$(INSTALL_DATA)' \
+ INSTALL_PROGRAM='$(INSTALL_PROGRAM)'
+
+all: sub-all texinfo
+
+check:
+installcheck:
+dvi: texinfo.dvi license.dvi lgpl.dvi
+ @for dir in $(SUBDIRS); do cd $$dir; $(MAKE) $(FLAGS_TO_PASS) $@; cd ..; done
+
+install: all installdirs
+ test -f $(infodir)/dir || $(INSTALL_DATA) $(srcdir)/dir $(infodir)
+ for dir in $(SUBDIRS); do \
+ echo making $@ in $$dir; \
+ (cd $$dir && $(MAKE) $(MDEFINES) $@ || exit 1); \
+ done
+ d=$(srcdir); test -f ./texinfo && d=.; \
+ (cd $$d && for f in texinfo* ; do \
+ $(INSTALL_DATA) $$f $(infodir)/$$f; done)
+ $(POST_INSTALL)
+ ./util/install-info --info-dir=$(infodir) $(infodir)/texinfo
+ @echo Please install $(srcdir)/texinfo.tex manually.
+
+installdirs:
+ -$(SHELL) $(srcdir)/util/mkinstalldirs $(bindir) $(datadir) $(infodir) $(mandir)
+
+.PHONY: install-info
+install-info: info
+ for dir in $(SUBDIRS); do \
+ echo making $@ in $$dir; \
+ (cd $$dir && $(MAKE) $(MDEFINES) $@ || exit 1); \
+ done
+ d=$(srcdir); test -f ./texinfo && d=.; \
+ (cd $$d; \
+ for f in texinfo* ; do \
+ $(INSTALL_DATA) $$f $(infodir)/$$f; \
+ done)
+
+uninstall:
+ for dir in $(SUBDIRS); do \
+ echo making $@ in $$dir; \
+ (cd $$dir && $(MAKE) $(MDEFINES) $@ || exit 1); \
+ done
+ $(RM) $(infodir)/texinfo $(infodir)/texinfo-*
+
+Makefile: Makefile.in config.status
+ $(SHELL) ./config.status
+
+config.status: configure
+ $(SHELL) ./config.status --recheck
+
+#configure: configure.in
+# cd $(srcdir) && autoconf
+
+sub-all TAGS:
+ for dir in $(SUBDIRS); do \
+ echo making $@ in $$dir; \
+ (cd $$dir && $(MAKE) $(MDEFINES) $@ || exit 1); \
+ done
+.PHONY: sub-all
+
+clean mostlyclean:
+ for dir in $(SUBDIRS); do \
+ echo making $@ in $$dir; \
+ (cd $$dir && $(MAKE) $(MDEFINES) $@ || exit 1); \
+ done
+
+distclean: clean texclean
+ for dir in $(SUBDIRS); do \
+ echo making $@ in $$dir; \
+ (cd $$dir && $(MAKE) $(MDEFINES) $@ || exit 1); \
+ done
+ $(RM) Makefile *.status *.cache *.log texinfo texinfo-? texinfo-??
+
+texclean:
+ $(RM) *.aux *.cp *.cps *.dvi *.fn *.fns *.ky *.kys *.pg *.pgs
+ $(RM) *.toc *.tp *.tps *.vr *.vrs
+
+realclean: distclean
+
+# Let's hope we weren't cross-compiling.
+# If we depend on sub-all, this always gets remade. Annoying.
+info texinfo: texinfo.texi
+ ./makeinfo/makeinfo$(EXEEXT) -I$(srcdir) texinfo.texi
+.PHONY: info
+
+texinfo.dvi:
+ PATH="$(srcdir)/util:$${PATH}" TEXINPUTS="$(srcdir):$(common):$${TEXINPUTS}" texi2dvi $(srcdir)/texinfo.texi
+.PHONY: dvi
+
+license.info: $(srcdir)/license.texi
+ $(MAKEINFO) -I$(srcdir) -o license.info $(srcdir)/license.texi
+
+license.dvi: $(srcdir)/license.texi
+ PATH="$(srcdir)/util:$${PATH}" TEXINPUTS="$(srcdir):$(common):$${TEXINPUTS}" texi2dvi $(srcdir)/license.texi
+
+lgpl.info: $(srcdir)/liblic.texi
+ $(MAKEINFO) -I$(srcdir) -o lgpl.info $(srcdir)/liblic.texi
+
+lgpl.dvi: $(srcdir)/liblic.texi
+ PATH="$(srcdir)/util:$${PATH}" TEXINPUTS="$(srcdir):$(common):$${TEXINPUTS}" texi2dvi $(srcdir)/liblic.texi
+ mv liblic.dvi lgpl.dvi
+
+dist: DISTFILES
+ $(RM) -r $(DISTNAME)
+ $(MKDIR) $(DISTNAME)
+ for d in `find . -type d ! -name RCS -print`; do \
+ d=`echo $$d | grep -v '[@=]'`; \
+ test -z "$$d" || test "$$d" = . || test "$$d" = "./$(DISTNAME)" \
+ || mkdir $(DISTNAME)/$$d; done
+ for f in `cat DISTFILES`; do \
+ $(LN) $(srcdir)/$$f $(DISTNAME)/$$f || \
+ { echo copying $$f; cp -p $(srcdir)/$$f $(DISTNAME)/$$f ; } \
+ done
+ (cd $(DISTNAME); $(MAKE) $(MFLAGS) distclean)
+ $(TAR) chvf - $(DISTNAME) | gzip >$(DISTNAME).tar.gz
+ $(RM) -r $(DISTNAME)
+
+# Gets rid of most of the unwanted files. Verify manually (if necessary)
+# that this produces a list of all the files desired in the distribution.
+DISTFILES: force
+ (cd $(srcdir); find . ! -type d -print) \
+ | sed '/\/RCS\//d; \
+ /\/EMACS-BACKUPS\//d; \
+ /\.tar.*/d; \
+ /~$$/d; /\.o$$/d; \
+ /\.gdbinit$$/d; \
+ /\.orig$$/d; \
+ /\#$$/d; \
+ /\/info\/info$$/d; \
+ /\.info$$/d; \
+ /\.elc/d; \
+ /\/makeinfo\/makeinfo$$/d; \
+ /\/$(DISTNAME)\/.*$$/d; \
+ /\/util\/texindex$$/d; \
+ /texinfo$$/d; \
+ /texinfo-[0-9]+$$/d; \
+ /\/.*\.BAK$$/d; \
+ /\/.*\.a$$/d; \
+ /\/core$$/d; \
+ /\/*\.core$$/d; \
+ /\/core\..*$$/d; \
+ /\/a.out$$/d; \
+ /\/[=@]/d; \
+ /\/conftest\.c$$/d; \
+ /\/DISTFILES$$/d; \
+ /\/foo$$/d; \
+ /\/bar$$/d; \
+ /\.toc$$/d; \
+ /\.bak$$/d; \
+ /\.aux$$/d; /\.log$$/d; \
+ /\.cps$$/d; /\.cp$$/d; \
+ /\.fns$$/d; /\.fn$$/d; \
+ /\.tps$$/d; /\.tp$$/d; \
+ /\.vrs$$/d; /\.vr$$/d; \
+ /\.pgs$$/d; /\.pg$$/d; \
+ /\.kys$$/d; /\.ky$$/d; \
+ /\.ops$$/d; /\.op$$/d; \
+ s/^.\///; /^\.$$/d;' \
+ | sort | uniq > DISTFILES
+
+force:
+
+# Prevent GNU make v3 from overflowing arg limit on SysV.
+.NOEXPORT:
diff --git a/texinfo/NEWS b/texinfo/NEWS
new file mode 100644
index 00000000000..ffc70933396
--- /dev/null
+++ b/texinfo/NEWS
@@ -0,0 +1,93 @@
+This file records noteworthy changes.
+
+3.9 (4 October 1996)
+* makeinfo:
+ - Give a suppressible (with --no-validate) error for references
+ outside of any node.
+ - Keep track of multitable output correctly for split files; this
+ caused nodes after the first multitable to be ``undefined''.
+* install-info:
+ - Rename --infodir option to --info-dir.
+ - More robust error checking to avoid various crashes.
+* configure: Include replacements for memcpy and memmove functions in
+ the distribution, in case they are missing.
+
+3.8 (30 September 1996)
+* Define and/or document new and/or previously existing commands:
+ Accents: @" @' @, @" @= @^ @` @~ @H @d @dotaccent @dotless @ringaccent
+ @tieaccent @u @ubaraccent @v
+ Special characters: @AA @AE @L @O @OE @aa @ae @exclamdown @l @o @oe
+ @pounds @questiondown @ss
+ Special punctuation: @! @? @enddots
+ dir file maintenance: @dircategory @direntry; also new program, install-info
+ HTML support: @email @url @ifhtml...@end ifhtml
+ Macros: @macro @unmacro
+ Tables: @multitable @tab
+ Hyphenation: @- @hyphenation
+ Spacing: @ @<TAB> @<NEWLINE>
+ Sectioning:
+ @headings singleafter/doubleafter (change heading style after current page)
+ @centerchap
+ @setchapterstyle
+ Other:
+ @shorttitlepage (simple title pages)
+ @detailmenu...@end detailmenu (help makeinfo parse master menus)
+* Makeinfo prefers an input file named `foo.texinfo' or `foo.texi' or
+ `foo.txinfo' to just `foo' (the latter most likely being an executable).
+* Makeinfo implements @. @! @? correctly, as end-of-sentence punctuation.
+* @key marks its argument with a lozenge in TeX and <...> in Info.
+* TeX output has substantially decreased interline spacing and other
+ formatting changes.
+* Remove these obsolete and never-documented commands:
+ @infotop
+ @infoappendix @infoappendixsec @infoappendixsubsec @infoappendixsubsubsec
+ @infochapter @infosection @infosubsection @infosubsubsection
+ @infounnumbered @infounnumberedsec @infounnumberedsubsec
+ @infounnumberedsubsubsec
+ @input
+ @smallbreak @medbreak
+ @overfullrule
+ @br
+* Deprecate these obsolete commands, to be removed in the next release:
+ @ctrl
+ @infoinclude
+ @iappendix @iappendixsection @iappendixsec @iappendixsubsec
+ @iappendixsubsubsec
+ @ichapter @isection @isubsection @isubsubsection
+ @iunnumbered @iunnumberedsec @iunnumberedsubsec @iunnumberedsubsubsec
+ @setchapterstyle
+ @titlespec
+
+3.7 (24 December 1995)
+* Have --version print texinfo release number as well as the individual
+ program version.
+* Better man page cleaning.
+* Update Elisp files from current Emacs release.
+
+3.6 (21 June 1995)
+* Unmatched brace error reporting improved.
+* Missing comment terminator prevented compilation.
+
+3.5 (20 June 1995)
+* Autoconf update.
+* Support for parallel makes.
+* make install does not install Elisp files.
+
+3.4 (19 June 1995)
+* Handle @ifhtml in Elisp.
+* Update FSF address.
+
+3.3 (15 June 1995)
+* Portability changes.
+* Compile Elisp files.
+* Don't distribute .info* files.
+
+3.2 (9 June 1995)
+* Standalone Info can read Unix man pages.
+* New commands: @! @? @^ @" @enddots.
+* makeinfo -E does macro expansion (and nothing else).
+
+3.1 (23 May 1993)
+Just bug fixes, see ChangeLog for full details.
+
+texinfo-3.0: first release of Texinfo version 2, with many new commands.
diff --git a/texinfo/README b/texinfo/README
new file mode 100644
index 00000000000..357a98fb555
--- /dev/null
+++ b/texinfo/README
@@ -0,0 +1,163 @@
+Texinfo, Version 3
+==================
+
+This is the README file for version 3 of the Texinfo distribution.
+Files within this distribution have their own version and edition
+numbers. When you refer to a file, please mention its own number, as
+well as the version number of the Texinfo distribution.
+
+PLEASE REPORT BUGS TO: bug-texinfo@prep.ai.mit.edu
+
+Texinfo is a documentation system that uses a single source file to
+produce both on-line information and printed output. This means that
+instead of writing two different documents, one for the on-line help
+or other on-line information and the other for a typeset manual or
+other printed work, you need write only one document. When the work
+is revised, you need revise only one document. You can read the
+on-line information, known as an "Info file", with an Info
+documentation-reading program. By convention, Texinfo source file
+names end with a `.texi' or `.texinfo' extension. Texinfo is
+described in the Texinfo manual (the file ./texinfo.texi).
+
+You can write and format Texinfo files into Info files within GNU Emacs,
+and read them using the Emacs Info reader. If you do not have Emacs,
+you can format Texinfo files into Info files using `makeinfo' and read
+them using `info'. Use TeX, which is not included in this package (see
+`How to Obtain TeX' in the Texinfo manual for information), to typeset
+Texinfo files for printing.
+
+For instructions on compiling and installing info, makeinfo, texi2dvi,
+and texindex, please read the file `INSTALL'. The Emacs Lisp files are
+not installed by default; to install them, use `make install' in the
+`emacs' subdirectory. The Info tree uses a file `dir' as its root node;
+a sample `dir' file is included in the distribution, but not installed
+anywhere. Use it or not as you like.
+
+This distribution includes (but is not limited to) the following files:
+
+ README This file.
+
+ INTRODUCTION This file tells you how to create
+ readable files from the Texinfo source
+ files in this distribution.
+
+Texinfo source files:
+
+ texinfo.texi This manual describes Texinfo. It
+ tells how to use Texinfo to write
+ documentation, how to use Texinfo mode
+ in GNU Emacs, how to use TeX,
+ makeinfo, and the Emacs Lisp Texinfo
+ formatting commands.
+
+ info.texi This manual tells you how to use
+ Info. This document comes as part of
+ GNU Emacs. If you do not have Emacs,
+ you can format this Texinfo source
+ file with makeinfo or TeX and then
+ read the resulting Info file with the
+ standalone Info reader that is part of
+ this distribution.
+
+ info-stnd.texi This manual tells you how to use
+ the standalone GNU Info reader that is
+ included in this distribution as a C
+ source file, `info.c'.
+
+ makeinfo.texi This manual tells you how to use
+ makeinfo. The same information is
+ contained in a chapter of the Texinfo
+ manual; it has been extracted here for
+ your convenience.
+
+
+Printing related files:
+
+ texinfo.tex This TeX definitions file tells
+ the TeX program how to typeset a
+ Texinfo file into a DVI file ready for
+ printing.
+
+ texindex.c This file contains the source for
+ the `texindex' program that generates
+ sorted indices used by TeX when
+ typesetting a file for printing.
+
+ texi2dvi This is a shell script for
+ producing an indexed DVI file using
+ TeX and texindex. Must be used if the
+ source document uses Texinfo @macros.
+
+
+GNU Emacs related files:
+
+ texinfmt.el This Emacs Lisp file provides the
+ functions that GNU Emacs uses to
+ format a Texinfo file into an Info
+ file.
+
+ texinfo.el This file provides Texinfo mode
+ for GNU Emacs.
+
+ texnfo-upd.el These files provides commands to
+ texnfo-tex.el help you write Texinfo files
+ makeinfo.el using GNU Emacs Texinfo mode.
+
+ detexinfo.el This extra utility file contains functions
+ to remove Texinfo commands from a
+ Texinfo source file.
+
+ info.el These are the standard GNU Emacs
+ informat.el Info reading and support files,
+ included here for your convenience.
+
+
+Source files for standalone C programs:
+
+ makeinfo.c This file contains the source for
+ the `makeinfo' program that you can
+ use to create an Info file from a
+ Texinfo file.
+
+ info.c This file contains the source for
+ the `info' program that you can use to
+ view Info files on an ASCII terminal.
+
+ getopt.c Various support files
+ getopt1.c
+ getopt.h
+
+
+C Installation files:
+
+ configure This file creates creates a Makefile
+ which in turn creates an `info' or
+ `makeinfo' executable, or a C sources
+ distribution.
+
+ configure.in This is a template for creating
+ `configure' using m4 macros.
+
+ Makefile.in This is a template for `configure'
+ to use to make a Makefile.
+
+
+Other files:
+
+ NEWS This contains a summary of new
+ features since the first edition
+ of Texinfo.
+
+ info.1 This is a `man' page that briefly
+ describes the standalone `info'
+ program.
+
+ fixfonts This is a shell script to install the
+ `lcircle10' TeX fonts as an alias for
+ the `circle10' fonts. In some older
+ TeX distributions the names are
+ different.
+
+ tex3patch This handles a bug for version
+ 3.0 of TeX that does not occur in
+ more recent versions.
diff --git a/texinfo/TODO b/texinfo/TODO
new file mode 100644
index 00000000000..de5b571722f
--- /dev/null
+++ b/texinfo/TODO
@@ -0,0 +1,35 @@
+If you are interested in working on any of these,
+email bug-texinfo@prep.ai.mit.edu.
+
+* Use Automake.
+
+* Use a config header file instead of @DEFS@.
+
+* A detexinfo program, like detex or delatex. This command would
+ strip all the texinfo commands out, and would be used as a filter on
+ the way to a speller. An option would be to NOT strip comments out.
+ makeinfo --no-headers come close.
+
+* Change bars. This is difficult or impossible in TeX,
+ unfortunately. To do it right requires device driver support.
+
+* The dark corner symbol for the gawk manual.
+
+* Better i18n support, including support for 8-bit input
+ characters. Requires fonts, and the DC fonts are not (as of this
+ writing) free.
+
+* @exercise/@answer command for, e.g., gawk.
+
+* @figure.
+
+* HTML output in makeinfo.
+
+* Include a complete functional summary, a la a reference card, in the manual.
+
+* Use @ as the escape character, and Texinfo syntax generally, in the
+ table of contents, aux, and index files. Eliminate all the crazy
+ redefinitions of every Texinfo command (which lists always seem to be
+ incomplete).
+
+* Improve the manuals for makeinfo, standalone info, etc.
diff --git a/texinfo/aclocal.m4 b/texinfo/aclocal.m4
new file mode 100644
index 00000000000..556a341489c
--- /dev/null
+++ b/texinfo/aclocal.m4
@@ -0,0 +1,45 @@
+dnl aclocal.m4 generated automatically by aclocal 1.2
+
+# Check to see if we're running under Cygwin32, without using
+# AC_CANONICAL_*. If so, set output variable CYGWIN32 to "yes".
+# Otherwise set it to "no".
+
+dnl AM_CYGWIN32()
+AC_DEFUN(AM_CYGWIN32,
+[AC_CACHE_CHECK(for Cygwin32 environment, am_cv_cygwin32,
+[AC_TRY_COMPILE(,[int main () { return __CYGWIN32__; }],
+am_cv_cygwin32=yes, am_cv_cygwin32=no)
+rm -f conftest*])
+CYGWIN32=
+test "$am_cv_cygwin32" = yes && CYGWIN32=yes])
+
+# Check to see if we're running under Win32, without using
+# AC_CANONICAL_*. If so, set output variable EXEEXT to ".exe".
+# Otherwise set it to "".
+
+dnl AM_EXEEXT()
+dnl This knows we add .exe if we're building in the Cygwin32
+dnl environment. But if we're not, then it compiles a test program
+dnl to see if there is a suffix for executables.
+AC_DEFUN(AM_EXEEXT,
+dnl AC_REQUIRE([AC_PROG_CC])AC_REQUIRE([AM_CYGWIN32])
+AC_MSG_CHECKING([for executable suffix])
+[AC_CACHE_VAL(am_cv_exeext,
+[if test "$CYGWIN32" = yes; then
+am_cv_exeext=.exe
+else
+cat > am_c_test.c << 'EOF'
+int main() {
+/* Nothing needed here */
+}
+EOF
+${CC-cc} -o am_c_test $CFLAGS $CPPFLAGS $LDFLAGS am_c_test.c $LIBS 1>&5
+am_cv_exeext=`ls am_c_test.* | grep -v am_c_test.c | sed -e s/am_c_test//`
+rm -f am_c_test*])
+test x"${am_cv_exeext}" = x && am_cv_exeext=no
+fi
+EXEEXT=""
+test x"${am_cv_exeext}" != xno && EXEEXT=${am_cv_exeext}
+AC_MSG_RESULT(${am_cv_exeext})
+AC_SUBST(EXEEXT)])
+
diff --git a/texinfo/configure b/texinfo/configure
new file mode 100755
index 00000000000..f6ecd822667
--- /dev/null
+++ b/texinfo/configure
@@ -0,0 +1,2025 @@
+#! /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=texinfo.texi
+
+# 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
+
+
+
+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.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:553: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ for ac_prog in ginstall installbsd scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ # OSF/1 installbsd also uses dspmsg, but is usable.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# 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:605: 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
+
+
+# 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:635: 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:664: 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:712: 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 <<EOF
+#line 722 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:726: \"$ac_link\") 1>&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:746: 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:751: 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 <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:760: \"$ac_try\") 1>&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:775: 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
+
+echo $ac_n "checking for POSIXized ISC""... $ac_c" 1>&6
+echo "configure:803: checking for POSIXized ISC" >&5
+if test -d /etc/conf/kconfig.d &&
+ grep _POSIX_VERSION /usr/include/sys/unistd.h >/dev/null 2>&1
+then
+ echo "$ac_t""yes" 1>&6
+ ISC=yes # If later tests want to check for ISC.
+ cat >> confdefs.h <<\EOF
+#define _POSIX_SOURCE 1
+EOF
+
+ if test "$GCC" = yes; then
+ CC="$CC -posix"
+ else
+ CC="$CC -Xp"
+ fi
+else
+ echo "$ac_t""no" 1>&6
+ ISC=
+fi
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:824: 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 <<EOF
+#line 839 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:845: \"$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 <<EOF
+#line 856 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:862: \"$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 "minix/config.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for minix/config.h""... $ac_c" 1>&6
+echo "configure:886: checking for minix/config.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
+#line 891 "configure"
+#include "confdefs.h"
+#include <minix/config.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:896: \"$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
+ MINIX=yes
+else
+ echo "$ac_t""no" 1>&6
+MINIX=
+fi
+
+if test "$MINIX" = yes; then
+ cat >> confdefs.h <<\EOF
+#define _POSIX_SOURCE 1
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define _POSIX_1_SOURCE 2
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define _MINIX 1
+EOF
+
+fi
+
+
+echo $ac_n "checking for Cygwin32 environment""... $ac_c" 1>&6
+echo "configure:935: checking for Cygwin32 environment" >&5
+if eval "test \"`echo '$''{'am_cv_cygwin32'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 940 "configure"
+#include "confdefs.h"
+
+int main() {
+int main () { return __CYGWIN32__; }
+; return 0; }
+EOF
+if { (eval echo configure:947: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ am_cv_cygwin32=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ am_cv_cygwin32=no
+fi
+rm -f conftest*
+rm -f conftest*
+fi
+
+echo "$ac_t""$am_cv_cygwin32" 1>&6
+CYGWIN32=
+test "$am_cv_cygwin32" = yes && CYGWIN32=yes
+echo $ac_n "checking for executable suffix""... $ac_c" 1>&6
+echo "configure:964: checking for executable suffix" >&5
+if eval "test \"`echo '$''{'am_cv_exeext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$CYGWIN32" = yes; then
+am_cv_exeext=.exe
+else
+cat > am_c_test.c << 'EOF'
+int main() {
+/* Nothing needed here */
+}
+EOF
+${CC-cc} -o am_c_test $CFLAGS $CPPFLAGS $LDFLAGS am_c_test.c $LIBS 1>&5
+am_cv_exeext=`ls am_c_test.* | grep -v am_c_test.c | sed -e s/am_c_test//`
+rm -f am_c_test*
+fi
+
+test x"${am_cv_exeext}" = x && am_cv_exeext=no
+fi
+EXEEXT=""
+test x"${am_cv_exeext}" != xno && EXEEXT=${am_cv_exeext}
+echo "$ac_t""${am_cv_exeext}" 1>&6
+
+
+# Needed on sysV68 for sigblock, sigsetmask.
+echo $ac_n "checking for sigblock in -lbsd""... $ac_c" 1>&6
+echo "configure:990: checking for sigblock in -lbsd" >&5
+ac_lib_var=`echo bsd'_'sigblock | 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="-lbsd $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 998 "configure"
+#include "confdefs.h"
+/* 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 sigblock();
+
+int main() {
+sigblock()
+; return 0; }
+EOF
+if { (eval echo configure:1009: \"$ac_link\") 1>&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
+ ac_tr_lib=HAVE_LIB`echo bsd | sed -e 's/[^a-zA-Z0-9_]/_/g' \
+ -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_lib 1
+EOF
+
+ LIBS="-lbsd $LIBS"
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+TERMLIBS=
+for termlib in curses ncurses termcap terminfo termlib ; do
+ echo $ac_n "checking for tputs in -l${termlib}""... $ac_c" 1>&6
+echo "configure:1040: checking for tputs in -l${termlib}" >&5
+ac_lib_var=`echo ${termlib}'_'tputs | 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="-l${termlib} $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1048 "configure"
+#include "confdefs.h"
+/* 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 tputs();
+
+int main() {
+tputs()
+; return 0; }
+EOF
+if { (eval echo configure:1059: \"$ac_link\") 1>&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
+ TERMLIBS="${TERMLIBS} -l${termlib}"; break
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+done
+
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+echo "configure:1083: 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 <<EOF
+#line 1088 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1096: \"$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
+#line 1113 "configure"
+#include "confdefs.h"
+#include <string.h>
+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
+#line 1131 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+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 <<EOF
+#line 1152 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#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:1163: \"$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
+
+for ac_hdr in unistd.h termios.h termio.h strings.h string.h varargs.h \
+ sys/time.h sys/fcntl.h sys/ttold.h sys/ptem.h sys/file.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1191: 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
+#line 1196 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1201: \"$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 <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+echo $ac_n "checking for off_t""... $ac_c" 1>&6
+echo "configure:1229: checking for off_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_off_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1234 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "off_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_off_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_off_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_off_t" 1>&6
+if test $ac_cv_type_off_t = no; then
+ cat >> confdefs.h <<\EOF
+#define off_t long
+EOF
+
+fi
+
+echo $ac_n "checking for working const""... $ac_c" 1>&6
+echo "configure:1262: 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 <<EOF
+#line 1267 "configure"
+#include "confdefs.h"
+
+int main() {
+
+/* Ultrix mips cc rejects this. */
+typedef int charset[2]; const charset x;
+/* SunOS 4.1.1 cc rejects this. */
+char const *const *ccp;
+char **p;
+/* NEC SVR4.0.2 mips cc rejects this. */
+struct point {int x, y;};
+static struct point const zero = {0,0};
+/* AIX XL C 1.02.0.0 rejects this.
+ It does not let you subtract one const X* pointer from another in an arm
+ of an if-expression whose if-part is not a constant expression */
+const char *g = "string";
+ccp = &g + (g ? g-g : 0);
+/* HPUX 7.0 cc rejects these. */
+++ccp;
+p = (char**) ccp;
+ccp = (char const *const *) p;
+{ /* SCO 3.2v4 cc rejects this. */
+ char *t;
+ char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+ *t++ = 0;
+}
+{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
+ int x[] = {25, 17};
+ const int *foo = &x[0];
+ ++foo;
+}
+{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+ typedef const int *iptr;
+ iptr p = 0;
+ ++p;
+}
+{ /* AIX XL C 1.02.0.0 rejects this saying
+ "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+ struct s { int j; const int *ap[3]; };
+ struct s *b; b->j = 5;
+}
+{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+ const int foo = 10;
+}
+
+; return 0; }
+EOF
+if { (eval echo configure:1316: \"$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 whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6
+echo "configure:1337: 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 <<EOF
+#line 1342 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <time.h>
+int main() {
+struct tm *tp; tp->tm_sec;
+; return 0; }
+EOF
+if { (eval echo configure:1350: \"$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
+
+
+# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works
+# for constant arguments. Useless!
+echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6
+echo "configure:1374: checking for working alloca.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_alloca_h'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1379 "configure"
+#include "confdefs.h"
+#include <alloca.h>
+int main() {
+char *p = alloca(2 * sizeof(int));
+; return 0; }
+EOF
+if { (eval echo configure:1386: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ ac_cv_header_alloca_h=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_alloca_h=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_header_alloca_h" 1>&6
+if test $ac_cv_header_alloca_h = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_ALLOCA_H 1
+EOF
+
+fi
+
+echo $ac_n "checking for alloca""... $ac_c" 1>&6
+echo "configure:1407: checking for alloca" >&5
+if eval "test \"`echo '$''{'ac_cv_func_alloca_works'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1412 "configure"
+#include "confdefs.h"
+
+#ifdef __GNUC__
+# define alloca __builtin_alloca
+#else
+# if HAVE_ALLOCA_H
+# include <alloca.h>
+# else
+# ifdef _AIX
+ #pragma alloca
+# else
+# ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+# endif
+# endif
+# endif
+#endif
+
+int main() {
+char *p = (char *) alloca(1);
+; return 0; }
+EOF
+if { (eval echo configure:1435: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
+ rm -rf conftest*
+ ac_cv_func_alloca_works=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_func_alloca_works=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_func_alloca_works" 1>&6
+if test $ac_cv_func_alloca_works = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_ALLOCA 1
+EOF
+
+fi
+
+if test $ac_cv_func_alloca_works = no; then
+ # The SVR3 libPW and SVR4 libucb both contain incompatible functions
+ # that cause trouble. Some versions do not even contain alloca or
+ # contain a buggy version. If you still want to use their alloca,
+ # use ar to extract alloca.o from them instead of compiling alloca.c.
+ ALLOCA=alloca.o
+ cat >> confdefs.h <<\EOF
+#define C_ALLOCA 1
+EOF
+
+
+echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6
+echo "configure:1467: checking whether alloca needs Cray hooks" >&5
+if eval "test \"`echo '$''{'ac_cv_os_cray'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1472 "configure"
+#include "confdefs.h"
+#if defined(CRAY) && ! defined(CRAY2)
+webecray
+#else
+wenotbecray
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "webecray" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_os_cray=yes
+else
+ rm -rf conftest*
+ ac_cv_os_cray=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_os_cray" 1>&6
+if test $ac_cv_os_cray = yes; then
+for ac_func in _getb67 GETB67 getb67; do
+ echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1497: 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 <<EOF
+#line 1502 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* 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:1525: \"$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
+ cat >> confdefs.h <<EOF
+#define CRAY_STACKSEG_END $ac_func
+EOF
+
+ break
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+done
+fi
+
+echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6
+echo "configure:1552: checking stack direction for C alloca" >&5
+if eval "test \"`echo '$''{'ac_cv_c_stack_direction'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$cross_compiling" = yes; then
+ ac_cv_c_stack_direction=0
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1560 "configure"
+#include "confdefs.h"
+find_stack_direction ()
+{
+ static char *addr = 0;
+ auto char dummy;
+ if (addr == 0)
+ {
+ addr = &dummy;
+ return find_stack_direction ();
+ }
+ else
+ return (&dummy > addr) ? 1 : -1;
+}
+main ()
+{
+ exit (find_stack_direction() < 0);
+}
+EOF
+if { (eval echo configure:1579: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_c_stack_direction=1
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_stack_direction=-1
+fi
+rm -fr conftest*
+fi
+
+fi
+
+echo "$ac_t""$ac_cv_c_stack_direction" 1>&6
+cat >> confdefs.h <<EOF
+#define STACK_DIRECTION $ac_cv_c_stack_direction
+EOF
+
+fi
+
+if test "$ac_cv_c_cross" = no; then
+ echo $ac_n "checking whether setvbuf arguments are reversed""... $ac_c" 1>&6
+echo "configure:1602: checking whether setvbuf arguments are reversed" >&5
+if eval "test \"`echo '$''{'ac_cv_func_setvbuf_reversed'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$cross_compiling" = yes; then
+ { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1610 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+/* If setvbuf has the reversed format, exit 0. */
+main () {
+ /* This call has the arguments reversed.
+ A reversed system may check and see that the address of main
+ is not _IOLBF, _IONBF, or _IOFBF, and return nonzero. */
+ if (setvbuf(stdout, _IOLBF, (char *) main, BUFSIZ) != 0)
+ exit(1);
+ putc('\r', stdout);
+ exit(0); /* Non-reversed systems segv here. */
+}
+EOF
+if { (eval echo configure:1624: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_func_setvbuf_reversed=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_func_setvbuf_reversed=no
+fi
+rm -fr conftest*
+fi
+
+rm -f core core.* *.core
+fi
+
+echo "$ac_t""$ac_cv_func_setvbuf_reversed" 1>&6
+if test $ac_cv_func_setvbuf_reversed = yes; then
+ cat >> confdefs.h <<\EOF
+#define SETVBUF_REVERSED 1
+EOF
+
+fi
+
+fi
+for ac_func in setvbuf getcwd memset bzero strchr strcasecmp \
+ vfprintf vsprintf strerror sigprocmask sigsetmask
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1652: 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 <<EOF
+#line 1657 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* 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:1680: \"$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 <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+for ac_func in memcpy memmove strdup
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1707: 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 <<EOF
+#line 1712 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* 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:1735: \"$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 <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+LIBOBJS="$LIBOBJS ${ac_func}.o"
+fi
+done
+
+
+
+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 <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/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
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile libtxi/Makefile makeinfo/Makefile info/Makefile util/Makefile emacs/Makefile " | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > 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%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@RANLIB@%$RANLIB%g
+s%@CC@%$CC%g
+s%@CPP@%$CPP%g
+s%@EXEEXT@%$EXEEXT%g
+s%@TERMLIBS@%$TERMLIBS%g
+s%@ALLOCA@%$ALLOCA%g
+s%@LIBOBJS@%$LIBOBJS%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 <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile libtxi/Makefile makeinfo/Makefile info/Makefile util/Makefile emacs/Makefile "}
+EOF
+cat >> $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" ;;
+ ?:*) 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
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ 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
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $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/texinfo/configure.in b/texinfo/configure.in
new file mode 100644
index 00000000000..321923d4753
--- /dev/null
+++ b/texinfo/configure.in
@@ -0,0 +1,48 @@
+dnl Process this file with autoconf to produce a configure script.
+dnl $Id: configure.in,v 1.3 1996/10/03 18:33:52 karl Exp $
+AC_PREREQ(2.5)
+AC_INIT(texinfo.texi)
+
+dnl Checks for programs.
+dnl AC_PROG_GCC_TRADITIONAL
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+
+AC_ISC_POSIX
+AC_MINIX
+
+AM_CYGWIN32
+AM_EXEEXT
+
+dnl Checks for libraries.
+# Needed on sysV68 for sigblock, sigsetmask.
+AC_CHECK_LIB(bsd, sigblock)
+
+TERMLIBS=
+for termlib in curses ncurses termcap terminfo termlib ; do
+ AC_CHECK_LIB(${termlib}, tputs,
+ [TERMLIBS="${TERMLIBS} -l${termlib}"; break])
+done
+AC_SUBST(TERMLIBS)
+
+dnl Checks for header files.
+AC_HEADER_STDC
+AC_CHECK_HEADERS(unistd.h termios.h termio.h strings.h string.h varargs.h \
+ sys/time.h sys/fcntl.h sys/ttold.h sys/ptem.h sys/file.h)
+
+dnl Checks for typedefs, structures, and compiler characteristics.
+AC_TYPE_OFF_T
+AC_C_CONST
+AC_STRUCT_TM
+
+dnl Checks for library functions.
+AC_FUNC_ALLOCA
+if test "$ac_cv_c_cross" = no; then
+ AC_FUNC_SETVBUF_REVERSED
+fi
+AC_CHECK_FUNCS(setvbuf getcwd memset bzero strchr strcasecmp \
+ vfprintf vsprintf strerror sigprocmask sigsetmask)
+dnl strcasecmp, strerror, xmalloc, xrealloc, probably others should be added.
+AC_REPLACE_FUNCS(memcpy memmove strdup)
+
+AC_OUTPUT(Makefile libtxi/Makefile makeinfo/Makefile info/Makefile util/Makefile emacs/Makefile
diff --git a/texinfo/dir b/texinfo/dir
new file mode 100644
index 00000000000..8f7e01d7867
--- /dev/null
+++ b/texinfo/dir
@@ -0,0 +1,16 @@
+$Id: dir,v 1.1 1997/08/21 22:57:52 jason Exp $
+This is the file .../info/dir, which contains the topmost node of the
+Info hierarchy. The first time you invoke Info you start off
+looking at that node, which is (dir)Top.
+
+File: dir Node: Top This is the top of the INFO tree
+
+ This (the Directory node) gives a menu of major topics.
+ Typing "q" exits, "?" lists all Info commands, "d" returns here,
+ "h" gives a primer for first-timers,
+ "mEmacs<Return>" visits the Emacs topic, etc.
+
+ In Emacs, you can click mouse button 2 on a menu item or cross reference
+ to select it.
+
+* Menu:
diff --git a/texinfo/dir-example b/texinfo/dir-example
new file mode 100644
index 00000000000..3b9bd72e3d7
--- /dev/null
+++ b/texinfo/dir-example
@@ -0,0 +1,309 @@
+This is the directory file `dir' a.k.a. `DIR', which contains the
+topmost node of the Info hierarchy. This file is merely made available
+for your hacking pleasure, not official or standard in any way.
+If it doesn't make sense to you, or you don't like it, ignore it.
+
+$Id: dir-example,v 1.1 1997/08/21 22:57:52 jason Exp $
+
+File: dir Node: Top This is the top of the INFO tree.
+
+This node gives a menu of the major topics accessible through Info.
+
+ `q' quits;
+ `?' lists all Info commands;
+ `h' starts the Info tutorial;
+ `mTexinfo RET' visits the Texinfo manual, etc.
+
+* Menu:
+
+GNU packages
+* Bash: (bash). Bourne again shell.
+* Cpio: (cpio). Cpio archiver.
+* DC: (dc). Postfix arbitrary expression calculator.
+* Diff: (diff). Comparing and merging programs.
+* Ed: (ed). Line editor.
+* Emacs: (emacs). Extensible self-documenting text editor.
+* File utilities: (fileutils). GNU file utilities.
+* Finding files: (find). Operating on files matching certain criteria.
+* Font utilities: (fontu). Programs for font manipulation.
+* Gawk: (gawk). A text processing and scanning language.
+* Gzip: (gzip). General (de)compression.
+* Identifier DB: (id-utils). Identifier database utilities.
+* Ispell: (ispell). Interactive spelling corrector.
+* M4: (m4). Macro processor.
+* Make: (make). Remake files automatically.
+* Ptx: (ptx). Permuted index generator.
+* Shar: (sharutils). Shell archiver, uudecode/uuencode.
+* Shell utilities: (sh-utils). GNU shell utilities.
+* Tar: (tar). ``Tape'' archiver.
+* Text utilities: (textutils). GNU text utilities.
+* Time: (time). Measuring program resource usage.
+* UUCP: (uucp). Copying between machines, offline.
+* Wdiff: (wdiff). Word-by-word comparison.
+
+GNU programming tools
+* As: (as). Assembler.
+* Binutils: (binutils). ar/copy/objdump/nm/size/strip/ranlib.
+* Bison: (bison). LALR(1) parser generator.
+* CPP: (cpp). C preprocessor.
+* CVS: (cvs). Concurrent versions system for source control.
+* DejaGnu: (dejagnu). Testing framework.
+* Flex: (flex). A fast scanner generator.
+* Gasp: (gasp). GNU Assembler preprocessor.
+* Libtool: (libtool). Generic library support script.
+* GCC: (gcc). C compiler.
+* GDB: (gdb). Source-level debugger for C and C++.
+* Gperf: (gperf). Perfect hash function generator.
+* Gprof: (gprof). Profiler.
+* Indent: (indent). Prettyprinter for programs.
+* Ld: (ld). Linker.
+
+Texinfo documentation system
+* Info: (info). Documentation browsing system.
+* Texinfo: (texinfo). The GNU documentation format.
+* install-info: (texinfo)Invoking install-info. Updating info/dir entries.
+* texi2dvi: (texinfo)Format with texi2dvi. Printing Texinfo documentation.
+* texindex: (texinfo)Format with tex/texindex. Sorting Texinfo index files.
+* info program: (info-stnd). Standalone Info-reading program.
+* makeinfo: (makeinfo). Convert Texinfo source to Info or plain ASCII.
+
+GNU Emacs Lisp
+* Elisp: (elisp). GNU Emacs Lisp reference manual.
+* Intro Elisp: (emacs-lisp-intro). Introduction to Elisp programming.
+
+* Calc: (calc). Calculator and more.
+* CC-mode: (ccmode). Editing C, C++, and Objective C.
+* Common Lisp: (cl). Partial Common Lisp support for Emacs Lisp.
+* Dired-x: (dired-x). Extra directory editor features.
+* Edebug: (edebug). Source-level debugger for Emacs Lisp.
+* Ediff: (ediff). Comprehensive visual interface to diff & patch.
+* EDB: (edb). Database for Emacs.
+* Forms: (forms). Fill-in-the-form data entry.
+* Gmhist: (gmhist). Generic minibuffer history.
+* GNUS: (gnus). Netnews reading and posting.
+* Mailcrypt: (mailcrypt). Use PGP in Emacs.
+* MH-E: (mh-e). Emacs interface to the MH mail system.
+* PCL-CVS: (pcl-cvs). Emacs front end to CVS.
+* Supercite: (sc). Supercite for including other people's words.
+* VIP: (vip). vi emulation.
+* VIPER: (viper). The new VI-emulation mode in Emacs-19.29.
+* VM: (vm). Mail reader.
+* W3: (w3). WWW browser.
+
+GNU admin
+* Autoconf: (autoconf). Automatic generation of package configuration.
+* Automake: (automake). Making Makefile.in's.
+* Configure: (configure). Cygnus configure.
+* Gettext: (gettext). Internationalization.
+* Gnats: (gnats). Cygnus bug tracking system.
+* Maintaining: (maintain). Maintaining GNU software.
+* Remsync: (remsync). Remote synchronization of directory trees.
+* Send PR: (send-pr). Cygnus bug reporting for Gnats.
+* Source config: (cfg-paper). Some theory on configuring source packages.
+* Standards: (standards). GNU coding standards.
+
+GNU libraries
+* Annotate: (annotate). High-level GDB to GUI's.
+* BFD: (bfd). Binary file descriptors for object file IO.
+* GDB library: (libgdb). Application programming interface to GDB.
+* GDBM: (gdbm). Hashed databases.
+* History: (history). Recall previous lines of input.
+* Iostream: (iostream). C++ input/output.
+* Libc: (libc). C library.
+* Libg++: (libg++). C++ classes.
+* Mmalloc: (mmalloc). Memory-mapped malloc.
+* Readline: (readline). General command-line interface.
+* Regex: (regex). Regular expressions.
+* Termcap: (termcap). All about /etc/termcap.
+
+GNU programming documentation
+* GDB internals: (gdbint). Debugger internals.
+* Ld internals: (ldint). GNU linker internals.
+* Stabs: (stabs). Symbol table debugging information format.
+
+DOS
+* Demacs: (demacs). GNU Emacs for DOS.
+* GNUish: (gnuish). GNU utilities for DOS.
+
+TeX things
+* Afm2tfm: (dvips)Invoking afm2tfm. Making Type 1 fonts available to TeX.
+* Dvips: (dvips). DVI-to-PostScript translator.
+* Eplain: (eplain). Expanding on plain TeX.
+* Kpathsearch: (kpathsea). File lookup along search paths.
+* LaTeX: (latex). LaTeX.
+* MakeIndex: (makeindex). Index creation for TeX.
+* Naming fonts: (fontname). Filenames for TeX fonts.
+* TeXDraw: (texdraw). Drawing PostScript diagrams within TeX.
+* Web2c: (web2c). TeX, Metafont, and their companion programs.
+
+Other things
+* Amd: (amdref). Filesystem automounter.
+* CMUCL: (cmu-user). CMU Common Lisp.
+* File headers: (filehdr). Bibliographic information for computer files.
+* HTML: (snafu). Hypertext Markup Language 2.0 specification.
+* Jargon: (jargon). The jargon file.
+* Perl: (perl). Practical extraction and report language.
+* PRCS: (prcs). Project revision control system.
+* Screen: (screen). Virtual screen manager.
+* UMB C.S. Dept.: (csinfo). UMass/Boston Computer Science Dept. info.
+
+Individual utilities
+* aid: (id-utils)aid invocation. Matching strings.
+* ar: (binutils)ar. Create/modify/extract archives.
+* at-pr: (gnats)at-pr. Bug report timely reminders.
+* autoreconf: (autoconf)Invoking autoreconf. Remake multiple configure's.
+* autoscan: (autoconf)Invoking autoscan. Automate initial configure.in.
+* awk: (Gawk)Invoking gawk. Text processing and scanning.
+* basename: (sh-utils)basename invocation. Strip directory and suffix.
+* bibtex: (web2c)BibTeX invocation. Maintaining bibliographies.
+* c++filt: (binutils)c++filt. Demangle C++ symbols.
+* cat: (textutils)cat invocation. Concatenate and write files.
+* chgrp: (fileutils)chgrp invocation. Change file groups.
+* chmod: (fileutils)chmod invocation. Change file permissions.
+* chown: (fileutils)chown invocation. Change file owners/groups.
+* chroot: (sh-utils)chroot invocation. Specify the root directory.
+* cksum: (textutils)cksum invocation. Print POSIX CRC checksum.
+* cmp: (diff)Invoking cmp. Character-by-character diff.
+* comm: (textutils)comm invocation. Compare sorted files by line.
+* cp: (fileutils)cp invocation. Copy files.
+* csplit: (textutils)csplit invocation. Split by context.
+* cut: (textutils)cut invocation. Print selected parts of lines.
+* date: (sh-utils)date invocation. Print/set system date and time.
+* dd: (fileutils)dd invocation. Copy and convert a file.
+* df: (fileutils)df invocation. Report filesystems' disk usage.
+* diff3: (diff)Invoking diff3. Three-way diff.
+* dir: (fileutils)dir invocation. List directories briefly.
+* dirname: (sh-utils)dirname invocation. Strip non-directory suffix.
+* dmp: (web2c)Dmp invocation. Troff->MPX (MetaPost pictures).
+* du: (fileutils)du invocation. Report on disk usage.
+* dvicopy: (web2c)DVIcopy invocation. Virtual font expansion
+* dvitomp: (web2c)DVItoMP invocation. DVI to MPX (MetaPost pictures).
+* dvitype: (web2c)DVItype invocation. DVI to human-readable text.
+* echo: (sh-utils)echo invocation. Print a line of text.
+* edit-pr: (gnats)Invoking edit-pr. Changing bugs.
+* eid: (id-utils)eid invocation. Invoking an editor on matches.
+* emacsclient: (emacs)Emacs Server. Connecting to a running Emacs.
+* emacsserver: (emacs)Emacs Server. Connecting to a running Emacs.
+* env: (sh-utils)env invocation. Modify the environment.
+* etags: (emacs)Create Tags Table. Creating a TAGS table.
+* expand: (textutils)expand invocation. Convert tabs to spaces.
+* expr: (sh-utils)expr invocation. Evaluate expressions.
+* false: (sh-utils)false invocation. Do nothing, unsuccessfully.
+* fid: (id-utils)fid invocation. Listing a file's identifiers.
+* file-pr: (gnats)file-pr. Processing incoming traffic.
+* find: (find)Invoking find. Finding and acting on files.
+* fmt: (textutils)fmt invocation. Reformat paragraph text.
+* fold: (textutils)fold invocation. Wrap long input lines.
+* g++: (gcc)Invoking G++. The GNU C++ compiler.
+* gftodvi: (web2c)GFtoDVI invocation. Generic font proofsheets.
+* gftopk: (web2c)GFtoPK invocation. Generic to packed fonts.
+* gftype: (web2c)GFtype invocation. GF to human-readable text.
+* gid: (id-utils)gid invocation. Listing all matching lines.
+* groups: (sh-utils)groups invocation. Print group names a user is in.
+* gunzip: (gzip)Overview. Decompression.
+* head: (textutils)head invocation. Output the first part of files.
+* hostname: (sh-utils)hostname invocation. Print or set system name.
+* id: (sh-utils)id invocation. Print real/effective uid/gid.
+* idx: (id-utils)idx invocation. Testing mkid scanners.
+* ifnames: (autoconf)Invoking ifnames. List conditionals in source.
+* iid: (id-utils)iid invocation. Interactive complex queries.
+* inimf: (web2c)inimf invocation. Initial Metafont.
+* inimp: (web2c)inimp invocation. Initial MetaPost.
+* initex: (web2c)initex invocation. Initial TeX.
+* install: (fileutils)install invocation. Copy and change attributes.
+* join: (textutils)join invocation. Join lines on a common field.
+* kpsewhich: (kpathsea)Invoking kpsewhich. TeX file searching.
+* lid: (id-utils)lid invocation. Matching identifier patterns.
+* ln: (fileutils)ln invocation. Make links between files.
+* locate: (find)Invoking locate. Finding files in a database.
+* logname: (sh-utils)logname invocation. Print current login name.
+* ls: (fileutils)ls invocation. List directory contents.
+* makempx: (web2c)MakeMPX invocation. MetaPost label typesetting.
+* maketexmf: (kpathsea)MakeTeX scripts. MF source generation.
+* maketexpk: (kpathsea)MakeTeX scripts. PK bitmap generation.
+* maketextex: (kpathsea)MakeTeX scripts. TeX source generation.
+* maketextfm: (kpathsea)MakeTeX scripts. TeX font metric generation.
+* mf: (web2c)mf invocation. Creating typeface families.
+* mft: (web2c)MFT invocation. Prettyprinting Metafont source.
+* mkdir: (fileutils)mkdir invocation. Create directories.
+* mkfifo: (fileutils)mkfifo invocation. Create FIFOs: (named pipes).
+* mkid: (id-utils)mkid invocation. Creating an ID database.
+* mknod: (fileutils)mknod invocation. Create special files.
+* mp: (web2c)mp invocation. Creating technical diagrams.
+* mpto: (web2c)MPto invocation. MetaPost label extraction.
+* mv: (fileutils)mv invocation. Rename files.
+* newer: (web2c)Newer invocation. Compare modification times.
+* nice: (sh-utils)nice invocation. Modify scheduling priority.
+* nl: (textutils)nl invocation. Number lines and write files.
+* nlmconv: (binutils)nlmconv. Convert object to NetWare LM.
+* nm: (binutils)nm. List symbols in object files.
+* nohup: (sh-utils)nohup invocation. Immunize to hangups.
+* objcopy: (binutils)objcopy. Copy/translate object files.
+* objdump: (binutils)objdump. Display info from object files.
+* od: (textutils)od invocation. Dump files in octal, etc.
+* paste: (textutils)paste invocation. Merge lines of files.
+* patch: (diff)Invoking patch. Automatically applying diffs.
+* patgen: (web2c)Patgen invocation. Creating hyphenation patterns.
+* pathchk: (sh-utils)pathchk invocation. Check file name portability.
+* pid: (id-utils)pid invocation. Looking up filenames.
+* pktogf: (web2c)PKtoGF invocation. Packed to generic fonts.
+* pktype: (web2c)PKtype invocation. PK to human-readable text.
+* pltotf: (web2c)PLtoTF invocation. Property list to TFM.
+* pooltype: (web2c)Pooltype invocation. Display WEB pool files.
+* pr-addr: (gnats)pr-addr. Bug report address retrieval.
+* pr-edit: (gnats)pr-edit. The edit-pr driver.
+* pr: (textutils)pr invocation. Paginate or columnate files.
+* printenv: (sh-utils)printenv invocation. Print environment variables.
+* printf: (sh-utils)printf invocation. Format and print data.
+* pwd: (sh-utils)pwd invocation. Print working directory.
+* query-pr: (gnats)Invoking query-pr. Bug searching/reporting.
+* queue-pr: (gnats)queue-pr. Handling incoming traffic.
+* ranlib: (binutils)ranlib. Index archive file contents.
+* rm: (fileutils)rm invocation. Remove files.
+* rmdir: (fileutils)rmdir invocation. Remove empty directories.
+* sdiff: (diff)Invoking sdiff. Interactively merge files.
+* send-pr: (gnats)Invoking send-pr. Submitting bugs.
+* shar: (sharutils)shar invocation. Create shell archive.
+* size: (binutils)size. List object file section sizes.
+* sleep: (sh-utils)sleep invocation. Delay for a specified time.
+* sort: (textutils)sort invocation. Sort text files.
+* split: (textutils)split invocation. Split into fixed-size pieces.
+* strings: (binutils)strings. List printable strings.
+* strip: (binutils)strip. Discard symbols.
+* stty: (sh-utils)stty invocation. Print/change terminal settings.
+* su: (sh-utils)su invocation. Modify user and group id.
+* sum: (textutils)sum invocation. Print traditional checksum.
+* sync: (fileutils)sync invocation. Synchronize memory and disk.
+* tabs: (tput)Invoking tabs. Tab settings.
+* tac: (textutils)tac invocation. Reverse files.
+* tail: (textutils)tail invocation. Output the last part of files.
+* tangle: (web2c)Tangle invocation. WEB to Pascal.
+* tee: (sh-utils)tee invocation. Redirect to multiple files.
+* test: (sh-utils)test invocation. File/string tests.
+* tex: (web2c)tex invocation. Typesetting.
+* tftopl: (web2c)TFtoPL invocation. TFM -> property list.
+* touch: (fileutils)touch invocation. Change file timestamps.
+* tput: (tput)Invoking tput. Termcap in shell scripts.
+* tr: (textutils)tr invocation. Translate characters.
+* true: (sh-utils)true invocation. Do nothing, successfully.
+* tty: (sh-utils)tty invocation. Print terminal name.
+* uname: (sh-utils)uname invocation. Print system information.
+* unexpand: (textutils)unexpand invocation. Convert spaces to tabs.
+* uniq: (textutils)uniq invocation. Uniqify files.
+* unshar: (sharutils)unshar invocation. Extract from shell archive.
+* updatedb: (find)Invoking updatedb. Building the locate database.
+* users: (sh-utils)users invocation. Print current user names.
+* vdir: (fileutils)vdir invocation. List directories verbosely.
+* vftovp: (web2c)VFtoVP invocation. Virtual font -> virtual pl.
+* view-pr: (gnats)Invoking view-pr. Showing bug reports.
+* virmf: (web2c)virmf invocation. Virgin Metafont.
+* virmp: (web2c)virmp invocation. Virgin MetaPost.
+* virtex: (web2c)virtex invocation. Virgin TeX.
+* vptovf: (web2c)VPtoVF invocation. Virtual pl -> virtual font.
+* wc: (textutils)wc invocation. Byte, word, and line counts.
+* weave: (web2c)Weave invocation. WEB to TeX.
+* who: (sh-utils)who invocation. Print who is logged in.
+* whoami: (sh-utils)whoami invocation. Print effective user id.
+* xargs: (find)Invoking xargs. Operating on many files.
+* yes: (sh-utils)yes invocation. Print a string indefinitely.
+* zcat: (gzip)Overview. Decompression to stdout.
diff --git a/texinfo/dir.info-template b/texinfo/dir.info-template
new file mode 100644
index 00000000000..5f3df62a2c1
--- /dev/null
+++ b/texinfo/dir.info-template
@@ -0,0 +1,67 @@
+info
+--
+intro
+send-pr
+README
+COPYING
+COPYING.LIB
+--
+gcc
+g++
+reno-1
+cpp
+--
+gdb
+gdbint
+stabs
+--
+binutils
+ld
+as
+--
+dejagnu
+--
+make
+flex
+bison
+byacc
+gperf
+gprof
+--
+libc
+libg++
+iostream
+libm
+--
+bfd
+readline
+libiberty
+regex
+termcap
+--
+emacs
+elisp
+ange-ftp
+calc
+calendar
+cl
+forms
+gnus
+vip
+vm
+--
+ispell
+diff
+patch
+wdiff
+m4
+--
+texinfo
+makeinfo
+--
+autoconf
+configure
+cfg-paper
+--
+standards
+
diff --git a/texinfo/emacs/Makefile.in b/texinfo/emacs/Makefile.in
new file mode 100644
index 00000000000..5f19d1abea9
--- /dev/null
+++ b/texinfo/emacs/Makefile.in
@@ -0,0 +1,91 @@
+# Makefile for Texinfo/emacs.
+# Copyright (C) 1995, 96 Free Software Foundation, Inc.
+# $Id: Makefile.in,v 1.1 1997/08/21 22:57:56 jason Exp $
+
+# This program 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.
+
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# Author: Brian J. Fox (bfox@ai.mit.edu)
+#
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+SHELL = /bin/sh
+RM = rm -f
+
+
+ELISP_SRCS = info.el makeinfo.el texinfo.el texnfo-upd.el \
+ texnfo-tex.el texinfmt.el informat.el detexinfo.el
+ELISP_OBJS = info.elc makeinfo.elc texinfo.elc texnfo-upd.elc \
+ texnfo-tex.elc texinfmt.elc informat.elc detexinfo.elc
+
+.SUFFIXES: .el .elc
+
+.el.elc:
+ $(srcdir)/elisp-comp $<
+
+all:
+sub-all: all
+
+dvi:
+install-info:
+
+elisp: $(ELISP_OBJS)
+.PHONY: elisp
+
+# Nobody likes any of these install targets. Fine. Install it
+# manually, then.
+install:
+ @echo Please install the Emacs Lisp files manually.
+
+uninstall:
+ @echo Please uninstall the Emacs Lisp files manually.
+
+# install: $(ELISP_OBJS)
+# @(echo "(print (car load-path))" >/tmp/elc.$$$$; \
+# lispdir=`emacs -batch -q -l /tmp/elc.$$$$ -nw | grep site-lisp`; \
+# rm /tmp/elc.$$$$; \
+# if [ "$$lispdir" != "" ]; then \
+# lispdir=`echo $$lispdir | sed -e 's/"//g'`; \
+# echo "Installing .elc files in $$lispdir."; \
+# $(CP) $(ELISP_OBJS) $$lispdir; \
+# else \
+# echo "To install the elisp files, please copy *.elc to the"; \
+# echo "emacs site-lisp directory."; \
+# fi)
+#
+# install: $(ELISP_OBJS)
+# for file in $(ELISP_OBJS); do \
+# $(INSTALL_DATA) $$file $(lispdir); \
+# done
+#
+# uninstall: $(ELISP_OBJS)
+# cd $(lispdir) && rm -f $(ELISP_OBJS)
+#
+informat.elc: info.elc
+makeinfo.elc: texinfo.elc
+texinfmt.elc: texinfo.elc
+texinfmt.elc: texnfo-upd.elc
+
+Makefile: $(srcdir)/Makefile.in ../config.status
+ cd .. && sh config.status
+
+realclean distclean: clean
+ $(RM) Makefile *.log
+
+clean: FORCE
+ $(RM) *.elc
+
+FORCE:
+
diff --git a/texinfo/emacs/detexinfo.el b/texinfo/emacs/detexinfo.el
new file mode 100644
index 00000000000..fda99091c49
--- /dev/null
+++ b/texinfo/emacs/detexinfo.el
@@ -0,0 +1,250 @@
+;;; Here is a handy keybinding:
+
+(global-set-key "\C-x\\" 'detexinfo)
+
+;;;;;;;;;;;;;;;; detexinfo.el ;;;;;;;;;;;;;;;;
+;;;
+;;; Remove Texinfo commands from a Texinfo source file.
+;;;
+;;; Copyright (C) 1991, 1992 Free Software Foundation
+;;; Robert J. Chassell
+;;; bugs to bug-texinfo@prep.ai.mit.edu
+;;;
+;;; ==> test version <==
+;;; Fails if Texinfo source file contains formatting errors.
+;;;
+;;; Version 0.05 - 3 Jun 1992
+;;; Add to list of removed commands. Improve messages.
+;;;
+;;; Version 0.04 - 27 Jan 1992
+;;; Rewrite to insert detexinfo'd text into a temporary buffer.
+;;;
+;;; Version 0.03 - 27 Dec 1991
+;;; Improved messages.
+;;;
+;;; Version 0.02 - 13 Nov 1991
+;;; detexinfo-remove-inline-cmd, detexinfo-syntax-table: Handle
+;;; nested commands.
+;;; detexinfo: Handle nested @'s, eg @samp{@}} and @samp{@@};
+;;; replace @TeX{} with TeX.
+;;;
+;;; Version 0.01 - 13 Nov 1991
+;;;
+;;; Based on detex.el, by Bengt Martensson, 4 Oct 1987
+;;;
+;;;;;;;;;;;;;;;;
+
+(defvar detexinfo-buffer-name "*detexinfo*"
+ "*Name of the temporary buffer used by \\[detexinfo].")
+
+(defvar detexinfo-syntax-table nil)
+
+(if detexinfo-syntax-table
+ nil
+ (setq detexinfo-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\[ "." detexinfo-syntax-table)
+ (modify-syntax-entry ?\] "." detexinfo-syntax-table)
+ (modify-syntax-entry ?\" "." detexinfo-syntax-table)
+ (modify-syntax-entry ?\\ "." detexinfo-syntax-table)
+ (modify-syntax-entry ?\( "." detexinfo-syntax-table)
+ (modify-syntax-entry ?\) "." detexinfo-syntax-table)
+ (modify-syntax-entry ?{ "(}" detexinfo-syntax-table)
+ (modify-syntax-entry ?} "){" detexinfo-syntax-table))
+
+(defun detexinfo ()
+ "Remove Texinfo commands from current buffer, copying result to new buffer.
+BUG: Fails if Texinfo source file contains formatting errors."
+ (interactive)
+ (let ((input-buffer (current-buffer)))
+ ;; Find a buffer to use.
+ (switch-to-buffer (get-buffer-create detexinfo-buffer-name))
+ (setq major-mode 'detexinfo-mode)
+ (set-syntax-table detexinfo-syntax-table)
+ (erase-buffer)
+ (insert-buffer-substring input-buffer)
+
+ ;; Replace @{ and @} with %#* and *#% temporarily, so @samp{@{} works.
+ ;; What is a better way of doing this??
+ (goto-char (point-min))
+ (while (search-forward "@{" nil t) ; e.g., @samp{@{}
+ (replace-match "%#*"))
+ (goto-char (point-min))
+ (while (search-forward "@}" nil t)
+ (forward-char -3) ; e.g., @samp{@@}
+ (if (looking-at "@") ; Two @@ in a row
+ (progn
+ (delete-char 2)
+ (insert "%&%#"))
+ (forward-char 1)
+ (delete-char 2)
+ (insert "*#%")))
+
+ (goto-char (point-min))
+ ;; Remove @refill, the only inline command without braces.
+ (while (search-forward "@refill" nil t)
+ (replace-match ""))
+ ;; Replace @TeX{} with TeX
+ (goto-char (point-min))
+ (while (search-forward "@TeX{}" nil t) (replace-match "TeX" t t))
+
+ (detexinfo-remove-line-cmds-without-arg)
+ (detexinfo-remove-inline-cmds-without-arg)
+ (detexinfo-remove-inline-cmds-keep-arg)
+ (detexinfo-remove-line-cmds-deletable-arg)
+ (detexinfo-remove-line-cmds-maybe-delete-arg)
+ (detexinfo-remove-line-cmds-keep-arg)
+
+ ;; Now replace %#*, *#%, and %&%# with {, }, and @@.
+ (goto-char (point-min))
+ (while (search-forward "%#*" nil t)
+ (replace-match "{"))
+ (goto-char (point-min))
+ (while (search-forward "*#%" nil t)
+ (replace-match "}"))
+ (goto-char (point-min))
+ (while (search-forward "%&%#" nil t)
+ (replace-match "@@"))
+
+ ;; Scan for remaining two character @-commands
+ (goto-char (point-min))
+ (while (search-forward "@" nil t)
+ (cond ((looking-at "[*:]")
+ (delete-region (1- (point)) (1+ (point))))
+ ((looking-at "[{}^@.'`]\"?!")
+ (delete-region (1- (point)) (point)))))
+
+ (goto-char (point-min))
+ (message "Done...removed Texinfo commands from buffer. You may save it.")))
+
+(defun detexinfo-remove-whole-line (cmd)
+ "Delete Texinfo line command CMD at beginning of line and rest of line."
+ (goto-char (point-min))
+ (while
+ (re-search-forward
+ (concat "^@" cmd "[ \n]+") (point-max) t)
+ (goto-char (match-beginning 0))
+ (delete-region
+ (point) (save-excursion (end-of-line) (1+ (point))))))
+
+(defun detexinfo-remove-inline-cmd (cmd)
+ "Delete Texinfo inline command CMD, eg. @point, @code."
+ (goto-char (point-min))
+ (while
+ (re-search-forward (concat "@" cmd "{") (point-max) t)
+ (save-excursion
+ (forward-char -1)
+ (forward-sexp 1)
+ (delete-char -1)) ; delete right brace
+ (delete-region (point) (match-beginning 0))))
+
+;;;;;;;;;;;;;;;;
+
+;;; 1. @setfilename and other line commands with args to delete
+
+(defvar detexinfo-line-cmds-deletable-arg
+ '("enumerate" "ftable" "vtable" "itemize" "table"
+ "setfilename" "settitle" "setchapternewpage"
+ "footnotestyle" "paragraphindent"
+ "include" "need" "sp"
+ "clear" "ifclear" "ifset" "set"
+ "defcodeindex" "defindex" "syncodeindex" "synindex")
+ "List of Texinfo commands whose arguments should be deleted.")
+
+(defun detexinfo-remove-line-cmds-deletable-arg ()
+ "Delete Texinfo line commands together with their args, eg @setfilename."
+ (message "Removing commands such as @enumerate...with their arguments...")
+ (mapcar 'detexinfo-remove-whole-line
+ detexinfo-line-cmds-deletable-arg))
+
+;;; 2. @cindex and other cmds with args that may be deleted
+;;; This list is here just to make it easier to revise the
+;;; categories. In particular, you might want to keep the index entries.
+
+(defvar detexinfo-line-cmds-maybe-delete-arg
+ '("cindex" "findex" "kindex" "pindex" "tindex" "vindex" "node"
+ "c" "comment" "end" "headings" "printindex" "vskip"
+ "evenfooting" "evenheading" "everyfooting" "everyheading"
+ "oddfooting" "oddheading")
+ "List of Texinfo commands whose arguments may possibly be deleted.")
+
+(defun detexinfo-remove-line-cmds-maybe-delete-arg ()
+ "Delete Texinfo line commands together with their arguments, eg, @cindex."
+ (message "Removing commands such as @cindex...with their arguments...")
+ (mapcar 'detexinfo-remove-whole-line
+ detexinfo-line-cmds-maybe-delete-arg))
+
+;;; 3. @chapter and other line cmds with args to keep.
+
+(defvar detexinfo-line-cmds-keep-arg
+ '("top" "chapter" "section" "subsection" "subsubsection"
+ "unnumbered" "unnumberedsec" "unnumberedsubsec" "unnumberedsubsubsec"
+ "majorheading" "chapheading" "heading" "subheading" "subsubheading"
+ "appendix" "appendixsec" "appendixsubsec" "appendixsubsubsec"
+ "item" "itemx"
+ "title" "subtitle" "center" "author" "exdent"
+ "defcv" "deffn" "defivar" "defmac" "defmethod" "defop" "defopt"
+ "defspec" "deftp" "deftypefn" "deftypefun" "deftypvr"
+ "deftypevar" "defun" "defvar" "defvr")
+ "List of Texinfo line commands whose arguments should be kept.")
+
+(defun detexinfo-remove-line-cmds-keep-arg ()
+ "Delete Texinfo line commands but keep their arguments, eg @chapter."
+ (message "Removing commands such as @chapter...but not their arguments...")
+ (mapcar 'detexinfo-remove-line-cmd-keep-arg
+ detexinfo-line-cmds-keep-arg))
+
+(defun detexinfo-remove-line-cmd-keep-arg (cmd)
+ "Delete Texinfo line command CMD but keep its argument, eg @chapter."
+ (goto-char (point-min))
+ (while
+ (re-search-forward
+ (concat "^@" cmd "[ \n]+") (point-max) t)
+ (delete-region (match-beginning 0) (match-end 0))))
+
+;;; 4. @bye and other line commands without args.
+
+(defvar detexinfo-line-cmds-without-arg
+ '("bye" "contents" "display" "example" "finalout"
+ "flushleft" "flushright" "format" "group" "ifhtml" "ifinfo" "iftex"
+ "ignore" "lisp" "menu" "noindent" "page" "quotation"
+ "shortcontents" "smallbook" "smallexample" "smalllisp"
+ "summarycontents" "tex" "thischapter" "thischaptername"
+ "thisfile" "thispage" "thissection" "thistitle" "titlepage")
+ "List of Texinfo commands without arguments that should be deleted.")
+
+(defun detexinfo-remove-line-cmds-without-arg ()
+ "Delete line Texinfo commands that lack args, eg. @example."
+ (message "Removing commands such as @example...that lack arguments...")
+ (mapcar 'detexinfo-remove-whole-line
+ detexinfo-line-cmds-without-arg))
+
+;;; 5. @equiv and other inline cmds without args.
+
+(defvar detexinfo-inline-cmds-without-arg
+ '("equiv" "error" "expansion" "point" "print" "result"
+ "asis" "br" "bullet" "dots" "minus" "today")
+ "List of Texinfo inline commands without arguments that should be deleted.")
+
+(defun detexinfo-remove-inline-cmds-without-arg ()
+ "Delete Texinfo inline commands in that lack arguments."
+ (message "Removing within line commands such as @result...")
+ (mapcar 'detexinfo-remove-inline-cmd
+ detexinfo-inline-cmds-without-arg))
+
+;;; 6. @code and other inline cmds with args to keep
+
+(defvar detexinfo-inline-cmds-keep-arg
+ '("b" "cartouche" "cite" "code" "copyright" "ctrl" "dfn" "dmn"
+ "emph" "file" "footnote" "i" "inforef"
+ "kbd" "key" "pxref" "r" "ref" "samp" "sc" "titlefont"
+ "strong" "t" "var" "w" "xref")
+ "List of Texinfo inline commands with arguments that should be kept.")
+
+(defun detexinfo-remove-inline-cmds-keep-arg ()
+ "Delete Texinfo inline commands but keep its arg, eg. @code."
+ (message
+ "Removing within line commands such as @code...but not their arguments...")
+ (mapcar 'detexinfo-remove-inline-cmd
+ detexinfo-inline-cmds-keep-arg))
+
+;;;;;;;;;;;;;;;; end detexinfo.el ;;;;;;;;;;;;;;;;
diff --git a/texinfo/emacs/elisp-comp b/texinfo/emacs/elisp-comp
new file mode 100755
index 00000000000..72b204d68b5
--- /dev/null
+++ b/texinfo/emacs/elisp-comp
@@ -0,0 +1,7 @@
+#!/bin/sh
+# $Id: elisp-comp,v 1.1 1997/08/21 22:57:57 jason Exp $
+# Trivial script to compile the Elisp files.
+setpath=${TMPDIR-/tmp}/elc.$$
+echo "(setq load-path (cons nil load-path))" > $setpath
+emacs -batch -l $setpath -f batch-byte-compile "$@"
+rm -f $setpath
diff --git a/texinfo/emacs/info.el b/texinfo/emacs/info.el
new file mode 100644
index 00000000000..ead6ab92c98
--- /dev/null
+++ b/texinfo/emacs/info.el
@@ -0,0 +1,1846 @@
+;;; info.el --- info package for Emacs.
+
+;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 Emacs 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 Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Note that nowadays we expect info files to be made using makeinfo.
+
+;;; Code:
+
+(defvar Info-history nil
+ "List of info nodes user has visited.
+Each element of list is a list (FILENAME NODENAME BUFFERPOS).")
+
+(defvar Info-enable-edit nil
+ "*Non-nil means the \\<Info-mode-map>\\[Info-edit] command in Info can edit the current node.
+This is convenient if you want to write info files by hand.
+However, we recommend that you not do this.
+It is better to write a Texinfo file and generate the Info file from that,
+because that gives you a printed manual as well.")
+
+(defvar Info-enable-active-nodes nil
+ "Non-nil allows Info to execute Lisp code associated with nodes.
+The Lisp code is executed when the node is selected.")
+(put 'Info-enable-active-nodes 'risky-local-variable t)
+
+(defvar Info-fontify t
+ "*Non-nil enables highlighting and fonts in Info nodes.")
+
+(defvar Info-fontify-maximum-menu-size 30000
+ "*Maximum size of menu to fontify if `Info-fontify' is non-nil.")
+
+(defvar Info-directory-list
+ (let ((path (getenv "INFOPATH"))
+ ;; This is for older Emacs versions
+ ;; which might get this info.el from the Texinfo distribution.
+ (path-separator (if (boundp 'path-separator) path-separator
+ (if (eq system-type 'ms-dos) ";" ":")))
+ (source (expand-file-name "info/" source-directory))
+ (sibling (if installation-directory
+ (expand-file-name "info/" installation-directory)))
+ alternative)
+ (if path
+ (let ((list nil)
+ idx)
+ (while (> (length path) 0)
+ (setq idx (or (string-match path-separator path) (length path))
+ list (cons (substring path 0 idx) list)
+ path (substring path (min (1+ idx)
+ (length path)))))
+ (nreverse list))
+ (if (and sibling (file-exists-p sibling))
+ (setq alternative sibling)
+ (setq alternative source))
+ (if (or (member alternative Info-default-directory-list)
+ (not (file-exists-p alternative))
+ ;; On DOS/NT, we use movable executables always,
+ ;; and we must always find the Info dir at run time.
+ (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
+ nil
+ ;; Use invocation-directory for Info only if we used it for
+ ;; exec-directory also.
+ (not (string= exec-directory
+ (expand-file-name "lib-src/"
+ installation-directory)))))
+ Info-default-directory-list
+ (reverse (cons alternative
+ (cdr (reverse Info-default-directory-list)))))))
+ "List of directories to search for Info documentation files.
+nil means not yet initialized. In this case, Info uses the environment
+variable INFOPATH to initialize it, or `Info-default-directory-list'
+if there is no INFOPATH variable in the environment.
+The last element of `Info-default-directory-list' is the directory
+where Emacs installs the Info files that come with it.
+
+If you run the Emacs executable from the `src' directory in the Emacs
+source tree, the `info' directory in the source tree is used as the last
+element, in place of the installation Info directory. This is useful
+when you run a version of Emacs without installing it.")
+
+(defvar Info-additional-directory-list nil
+ "List of additional directories to search for Info documentation files.
+These directories are not searched for merging the `dir' file.")
+
+(defvar Info-current-file nil
+ "Info file that Info is now looking at, or nil.
+This is the name that was specified in Info, not the actual file name.
+It doesn't contain directory names or file name extensions added by Info.")
+
+(defvar Info-current-subfile nil
+ "Info subfile that is actually in the *info* buffer now,
+or nil if current info file is not split into subfiles.")
+
+(defvar Info-current-node nil
+ "Name of node that Info is now looking at, or nil.")
+
+(defvar Info-tag-table-marker (make-marker)
+ "Marker pointing at beginning of current Info file's tag table.
+Marker points nowhere if file has no tag table.")
+
+(defvar Info-current-file-completions nil
+ "Cached completion list for current Info file.")
+
+(defvar Info-index-alternatives nil
+ "List of possible matches for last Info-index command.")
+
+(defvar Info-standalone nil
+ "Non-nil if Emacs was started solely as an Info browser.")
+
+(defvar Info-suffix-list
+ (if (eq system-type 'ms-dos)
+ '( (".gz" . "gunzip")
+ (".z" . "gunzip")
+ (".inf" . nil)
+ ("" . nil))
+ '( (".info.Z" . "uncompress")
+ (".info.Y" . "unyabba")
+ (".info.gz" . "gunzip")
+ (".info.z" . "gunzip")
+ (".info" . nil)
+ (".Z" . "uncompress")
+ (".Y" . "unyabba")
+ (".gz" . "gunzip")
+ (".z" . "gunzip")
+ ("" . nil)))
+ "List of file name suffixes and associated decoding commands.
+Each entry should be (SUFFIX . STRING); the file is given to
+the command as standard input. If STRING is nil, no decoding is done.
+Because the SUFFIXes are tried in order, the empty string should
+be last in the list.")
+
+;; Concatenate SUFFIX onto FILENAME. SUFFIX should start with a dot.
+;; First, on ms-dos, delete some of the extension in FILENAME
+;; to make room.
+(defun info-insert-file-contents-1 (filename suffix)
+ (if (not (eq system-type 'ms-dos))
+ (concat filename suffix)
+ (let* ((sans-exts (file-name-sans-extension filename))
+ ;; How long is the extension in FILENAME (not counting the dot).
+ (ext-len (max 0 (- (length filename) (length sans-exts) 1)))
+ ext-left)
+ ;; SUFFIX starts with a dot. If FILENAME already has one,
+ ;; get rid of the one in SUFFIX (unless suffix is empty).
+ (or (and (<= ext-len 0)
+ (not (eq (aref filename (1- (length filename))) ?.)))
+ (= (length suffix) 0)
+ (setq suffix (substring suffix 1)))
+ ;; How many chars of that extension should we keep?
+ (setq ext-left (min ext-len (max 0 (- 3 (length suffix)))))
+ ;; Get rid of the rest of the extension, and add SUFFIX.
+ (concat (substring filename 0 (- (length filename)
+ (- ext-len ext-left)))
+ suffix))))
+
+(defun info-insert-file-contents (filename &optional visit)
+ "Insert the contents of an info file in the current buffer.
+Do the right thing if the file has been compressed or zipped."
+ (let ((tail Info-suffix-list)
+ fullname decoder)
+ (if (file-exists-p filename)
+ ;; FILENAME exists--see if that name contains a suffix.
+ ;; If so, set DECODE accordingly.
+ (progn
+ (while (and tail
+ (not (string-match
+ (concat (regexp-quote (car (car tail))) "$")
+ filename)))
+ (setq tail (cdr tail)))
+ (setq fullname filename
+ decoder (cdr (car tail))))
+ ;; Try adding suffixes to FILENAME and see if we can find something.
+ (while (and tail
+ (not (file-exists-p (info-insert-file-contents-1
+ filename (car (car tail))))))
+ (setq tail (cdr tail)))
+ ;; If we found a file with a suffix, set DECODER according to the suffix
+ ;; and set FULLNAME to the file's actual name.
+ (setq fullname (info-insert-file-contents-1 filename (car (car tail)))
+ decoder (cdr (car tail)))
+ (or tail
+ (error "Can't find %s or any compressed version of it" filename)))
+ ;; check for conflict with jka-compr
+ (if (and (featurep 'jka-compr)
+ (jka-compr-installed-p)
+ (jka-compr-get-compression-info fullname))
+ (setq decoder nil))
+ (insert-file-contents fullname visit)
+ (if decoder
+ (let ((buffer-read-only nil)
+ (default-directory (or (file-name-directory fullname)
+ default-directory)))
+ (call-process-region (point-min) (point-max) decoder t t)))))
+
+;;;###autoload (add-hook 'same-window-buffer-names "*info*")
+
+;;;###autoload
+(defun info (&optional file)
+ "Enter Info, the documentation browser.
+Optional argument FILE specifies the file to examine;
+the default is the top-level directory of Info.
+
+In interactive use, a prefix argument directs this command
+to read a file name from the minibuffer.
+
+The search path for Info files is in the variable `Info-directory-list'.
+The top-level Info directory is made by combining all the files named `dir'
+in all the directories in that path."
+ (interactive (if current-prefix-arg
+ (list (read-file-name "Info file name: " nil nil t))))
+ (if file
+ (Info-goto-node (concat "(" file ")"))
+ (if (get-buffer "*info*")
+ (pop-to-buffer "*info*")
+ (Info-directory))))
+
+;;;###autoload
+(defun info-standalone ()
+ "Run Emacs as a standalone Info reader.
+Usage: emacs -f info-standalone [filename]
+In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself."
+ (setq Info-standalone t)
+ (if (and command-line-args-left
+ (not (string-match "^-" (car command-line-args-left))))
+ (condition-case err
+ (progn
+ (info (car command-line-args-left))
+ (setq command-line-args-left (cdr command-line-args-left)))
+ (error (send-string-to-terminal
+ (format "%s\n" (if (eq (car-safe err) 'error)
+ (nth 1 err) err)))
+ (save-buffers-kill-emacs)))
+ (info)))
+
+;; Go to an info node specified as separate filename and nodename.
+;; no-going-back is non-nil if recovering from an error in this function;
+;; it says do not attempt further (recursive) error recovery.
+(defun Info-find-node (filename nodename &optional no-going-back)
+ ;; Convert filename to lower case if not found as specified.
+ ;; Expand it.
+ (if filename
+ (let (temp temp-downcase found)
+ (setq filename (substitute-in-file-name filename))
+ (if (string= (downcase filename) "dir")
+ (setq found t)
+ (let ((dirs (if (string-match "^\\./" filename)
+ ;; If specified name starts with `./'
+ ;; then just try current directory.
+ '("./")
+ (if (file-name-absolute-p filename)
+ ;; No point in searching for an
+ ;; absolute file name
+ '(nil)
+ (if Info-additional-directory-list
+ (append Info-directory-list
+ Info-additional-directory-list)
+ Info-directory-list)))))
+ ;; Search the directory list for file FILENAME.
+ (while (and dirs (not found))
+ (setq temp (expand-file-name filename (car dirs)))
+ (setq temp-downcase
+ (expand-file-name (downcase filename) (car dirs)))
+ ;; Try several variants of specified name.
+ (let ((suffix-list Info-suffix-list))
+ (while (and suffix-list (not found))
+ (cond ((file-exists-p
+ (info-insert-file-contents-1
+ temp (car (car suffix-list))))
+ (setq found temp))
+ ((file-exists-p
+ (info-insert-file-contents-1
+ temp-downcase (car (car suffix-list))))
+ (setq found temp-downcase)))
+ (setq suffix-list (cdr suffix-list))))
+ (setq dirs (cdr dirs)))))
+ (if found
+ (setq filename found)
+ (error "Info file %s does not exist" filename))))
+ ;; Record the node we are leaving.
+ (if (and Info-current-file (not no-going-back))
+ (setq Info-history
+ (cons (list Info-current-file Info-current-node (point))
+ Info-history)))
+ ;; Go into info buffer.
+ (switch-to-buffer "*info*")
+ (buffer-disable-undo (current-buffer))
+ (or (eq major-mode 'Info-mode)
+ (Info-mode))
+ (widen)
+ (setq Info-current-node nil)
+ (unwind-protect
+ (progn
+ ;; Switch files if necessary
+ (or (null filename)
+ (equal Info-current-file filename)
+ (let ((buffer-read-only nil))
+ (setq Info-current-file nil
+ Info-current-subfile nil
+ Info-current-file-completions nil
+ Info-index-alternatives nil
+ buffer-file-name nil)
+ (erase-buffer)
+ (if (eq filename t)
+ (Info-insert-dir)
+ (info-insert-file-contents filename t)
+ (setq default-directory (file-name-directory filename)))
+ (set-buffer-modified-p nil)
+ ;; See whether file has a tag table. Record the location if yes.
+ (set-marker Info-tag-table-marker nil)
+ (goto-char (point-max))
+ (forward-line -8)
+ ;; Use string-equal, not equal, to ignore text props.
+ (or (string-equal nodename "*")
+ (not (search-forward "\^_\nEnd tag table\n" nil t))
+ (let (pos)
+ ;; We have a tag table. Find its beginning.
+ ;; Is this an indirect file?
+ (search-backward "\nTag table:\n")
+ (setq pos (point))
+ (if (save-excursion
+ (forward-line 2)
+ (looking-at "(Indirect)\n"))
+ ;; It is indirect. Copy it to another buffer
+ ;; and record that the tag table is in that buffer.
+ (save-excursion
+ (let ((buf (current-buffer)))
+ (set-buffer (get-buffer-create " *info tag table*"))
+ (buffer-disable-undo (current-buffer))
+ (setq case-fold-search t)
+ (erase-buffer)
+ (insert-buffer-substring buf)
+ (set-marker Info-tag-table-marker
+ (match-end 0))))
+ (set-marker Info-tag-table-marker pos))))
+ (setq Info-current-file
+ (if (eq filename t) "dir" filename))))
+ ;; Use string-equal, not equal, to ignore text props.
+ (if (string-equal nodename "*")
+ (progn (setq Info-current-node nodename)
+ (Info-set-mode-line))
+ ;; Search file for a suitable node.
+ (let ((guesspos (point-min))
+ (regexp (concat "Node: *" (regexp-quote nodename) " *[,\t\n\177]")))
+ ;; First get advice from tag table if file has one.
+ ;; Also, if this is an indirect info file,
+ ;; read the proper subfile into this buffer.
+ (if (marker-position Info-tag-table-marker)
+ (save-excursion
+ (set-buffer (marker-buffer Info-tag-table-marker))
+ (goto-char Info-tag-table-marker)
+ (if (re-search-forward regexp nil t)
+ (progn
+ (setq guesspos (read (current-buffer)))
+ ;; If this is an indirect file,
+ ;; determine which file really holds this node
+ ;; and read it in.
+ (if (not (eq (current-buffer) (get-buffer "*info*")))
+ (setq guesspos
+ (Info-read-subfile guesspos))))
+ (error "No such node: %s" nodename))))
+ (goto-char (max (point-min) (- guesspos 1000)))
+ ;; Now search from our advised position (or from beg of buffer)
+ ;; to find the actual node.
+ (catch 'foo
+ (while (search-forward "\n\^_" nil t)
+ (forward-line 1)
+ (let ((beg (point)))
+ (forward-line 1)
+ (if (re-search-backward regexp beg t)
+ (throw 'foo t))))
+ (error "No such node: %s" nodename)))
+ (Info-select-node)))
+ ;; If we did not finish finding the specified node,
+ ;; go back to the previous one.
+ (or Info-current-node no-going-back (null Info-history)
+ (let ((hist (car Info-history)))
+ (setq Info-history (cdr Info-history))
+ (Info-find-node (nth 0 hist) (nth 1 hist) t)
+ (goto-char (nth 2 hist)))))
+ (goto-char (point-min)))
+
+;; Cache the contents of the (virtual) dir file, once we have merged
+;; it for the first time, so we can save time subsequently.
+(defvar Info-dir-contents nil)
+
+;; Cache for the directory we decided to use for the default-directory
+;; of the merged dir text.
+(defvar Info-dir-contents-directory nil)
+
+;; Record the file attributes of all the files from which we
+;; constructed Info-dir-contents.
+(defvar Info-dir-file-attributes nil)
+
+;; Construct the Info directory node by merging the files named `dir'
+;; from various directories. Set the *info* buffer's
+;; default-directory to the first directory we actually get any text
+;; from.
+(defun Info-insert-dir ()
+ (if (and Info-dir-contents Info-dir-file-attributes
+ ;; Verify that none of the files we used has changed
+ ;; since we used it.
+ (eval (cons 'and
+ (mapcar '(lambda (elt)
+ (let ((curr (file-attributes (car elt))))
+ ;; Don't compare the access time.
+ (if curr (setcar (nthcdr 4 curr) 0))
+ (setcar (nthcdr 4 (cdr elt)) 0)
+ (equal (cdr elt) curr)))
+ Info-dir-file-attributes))))
+ (insert Info-dir-contents)
+ (let ((dirs Info-directory-list)
+ buffers buffer others nodes dirs-done)
+
+ (setq Info-dir-file-attributes nil)
+
+ ;; Search the directory list for the directory file.
+ (while dirs
+ (let ((truename (file-truename (expand-file-name (car dirs)))))
+ (or (member truename dirs-done)
+ (member (directory-file-name truename) dirs-done)
+ ;; Try several variants of specified name.
+ ;; Try upcasing, appending `.info', or both.
+ (let* (file
+ (attrs
+ (or
+ (progn (setq file (expand-file-name "dir" truename))
+ (file-attributes file))
+ (progn (setq file (expand-file-name "DIR" truename))
+ (file-attributes file))
+ (progn (setq file (expand-file-name "dir.info" truename))
+ (file-attributes file))
+ (progn (setq file (expand-file-name "DIR.INFO" truename))
+ (file-attributes file)))))
+ (setq dirs-done
+ (cons truename
+ (cons (directory-file-name truename)
+ dirs-done)))
+ (if attrs
+ (save-excursion
+ (or buffers
+ (message "Composing main Info directory..."))
+ (set-buffer (generate-new-buffer "info dir"))
+ (insert-file-contents file)
+ (setq buffers (cons (current-buffer) buffers)
+ Info-dir-file-attributes
+ (cons (cons file attrs)
+ Info-dir-file-attributes))))))
+ (or (cdr dirs) (setq Info-dir-contents-directory (car dirs)))
+ (setq dirs (cdr dirs))))
+
+ (or buffers
+ (error "Can't find the Info directory node"))
+ ;; Distinguish the dir file that comes with Emacs from all the
+ ;; others. Yes, that is really what this is supposed to do.
+ ;; If it doesn't work, fix it.
+ (setq buffer (car buffers)
+ others (cdr buffers))
+
+ ;; Insert the entire original dir file as a start; note that we've
+ ;; already saved its default directory to use as the default
+ ;; directory for the whole concatenation.
+ (insert-buffer buffer)
+
+ ;; Look at each of the other buffers one by one.
+ (while others
+ (let ((other (car others)))
+ ;; In each, find all the menus.
+ (save-excursion
+ (set-buffer other)
+ (goto-char (point-min))
+ ;; Find each menu, and add an elt to NODES for it.
+ (while (re-search-forward "^\\* Menu:" nil t)
+ (let (beg nodename end)
+ (forward-line 1)
+ (setq beg (point))
+ (search-backward "\n\^_")
+ (search-forward "Node: ")
+ (setq nodename (Info-following-node-name))
+ (search-forward "\n\^_" nil 'move)
+ (beginning-of-line)
+ (setq end (point))
+ (setq nodes (cons (list nodename other beg end) nodes))))))
+ (setq others (cdr others)))
+ ;; Add to the main menu a menu item for each other node.
+ (re-search-forward "^\\* Menu:")
+ (forward-line 1)
+ (let ((menu-items '("top"))
+ (nodes nodes)
+ (case-fold-search t)
+ (end (save-excursion (search-forward "\^_" nil t) (point))))
+ (while nodes
+ (let ((nodename (car (car nodes))))
+ (save-excursion
+ (or (member (downcase nodename) menu-items)
+ (re-search-forward (concat "^\\* "
+ (regexp-quote nodename)
+ "::")
+ end t)
+ (progn
+ (insert "* " nodename "::" "\n")
+ (setq menu-items (cons nodename menu-items))))))
+ (setq nodes (cdr nodes))))
+ ;; Now take each node of each of the other buffers
+ ;; and merge it into the main buffer.
+ (while nodes
+ (let ((nodename (car (car nodes))))
+ (goto-char (point-min))
+ ;; Find the like-named node in the main buffer.
+ (if (re-search-forward (concat "\n\^_.*\n.*Node: "
+ (regexp-quote nodename)
+ "[,\n\t]")
+ nil t)
+ (progn
+ (search-forward "\n\^_" nil 'move)
+ (beginning-of-line)
+ (insert "\n"))
+ ;; If none exists, add one.
+ (goto-char (point-max))
+ (insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n"))
+ ;; Merge the text from the other buffer's menu
+ ;; into the menu in the like-named node in the main buffer.
+ (apply 'insert-buffer-substring (cdr (car nodes))))
+ (setq nodes (cdr nodes)))
+ ;; Kill all the buffers we just made.
+ (while buffers
+ (kill-buffer (car buffers))
+ (setq buffers (cdr buffers)))
+ (message "Composing main Info directory...done"))
+ (setq Info-dir-contents (buffer-string)))
+ (setq default-directory Info-dir-contents-directory))
+
+(defun Info-read-subfile (nodepos)
+ (set-buffer (marker-buffer Info-tag-table-marker))
+ (goto-char (point-min))
+ (search-forward "\n\^_")
+ (let (lastfilepos
+ lastfilename)
+ (forward-line 2)
+ (catch 'foo
+ (while (not (looking-at "\^_"))
+ (if (not (eolp))
+ (let ((beg (point))
+ thisfilepos thisfilename)
+ (search-forward ": ")
+ (setq thisfilename (buffer-substring beg (- (point) 2)))
+ (setq thisfilepos (read (current-buffer)))
+ ;; read in version 19 stops at the end of number.
+ ;; Advance to the next line.
+ (forward-line 1)
+ (if (> thisfilepos nodepos)
+ (throw 'foo t))
+ (setq lastfilename thisfilename)
+ (setq lastfilepos thisfilepos))
+ (forward-line 1))))
+ (set-buffer (get-buffer "*info*"))
+ (or (equal Info-current-subfile lastfilename)
+ (let ((buffer-read-only nil))
+ (setq buffer-file-name nil)
+ (widen)
+ (erase-buffer)
+ (info-insert-file-contents lastfilename)
+ (set-buffer-modified-p nil)
+ (setq Info-current-subfile lastfilename)))
+ (goto-char (point-min))
+ (search-forward "\n\^_")
+ (+ (- nodepos lastfilepos) (point))))
+
+;; Select the info node that point is in.
+(defun Info-select-node ()
+ (save-excursion
+ ;; Find beginning of node.
+ (search-backward "\n\^_")
+ (forward-line 2)
+ ;; Get nodename spelled as it is in the node.
+ (re-search-forward "Node:[ \t]*")
+ (setq Info-current-node
+ (buffer-substring-no-properties (point)
+ (progn
+ (skip-chars-forward "^,\t\n")
+ (point))))
+ (Info-set-mode-line)
+ ;; Find the end of it, and narrow.
+ (beginning-of-line)
+ (let (active-expression)
+ (narrow-to-region (point)
+ (if (re-search-forward "\n[\^_\f]" nil t)
+ (prog1
+ (1- (point))
+ (if (looking-at "[\n\^_\f]*execute: ")
+ (progn
+ (goto-char (match-end 0))
+ (setq active-expression
+ (read (current-buffer))))))
+ (point-max)))
+ (if Info-enable-active-nodes (eval active-expression))
+ (if Info-fontify (Info-fontify-node))
+ (run-hooks 'Info-selection-hook))))
+
+(defun Info-set-mode-line ()
+ (setq mode-line-buffer-identification
+ (concat
+ "Info: ("
+ (if Info-current-file
+ (file-name-nondirectory Info-current-file)
+ "")
+ ")"
+ (or Info-current-node ""))))
+
+;; Go to an info node specified with a filename-and-nodename string
+;; of the sort that is found in pointers in nodes.
+
+(defun Info-goto-node (nodename)
+ "Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME."
+ (interactive (list (Info-read-node-name "Goto node: ")))
+ (let (filename)
+ (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
+ nodename)
+ (setq filename (if (= (match-beginning 1) (match-end 1))
+ ""
+ (substring nodename (match-beginning 2) (match-end 2)))
+ nodename (substring nodename (match-beginning 3) (match-end 3)))
+ (let ((trim (string-match "\\s *\\'" filename)))
+ (if trim (setq filename (substring filename 0 trim))))
+ (let ((trim (string-match "\\s *\\'" nodename)))
+ (if trim (setq nodename (substring nodename 0 trim))))
+ (if transient-mark-mode (deactivate-mark))
+ (Info-find-node (if (equal filename "") nil filename)
+ (if (equal nodename "") "Top" nodename))))
+
+;; This function is used as the "completion table" while reading a node name.
+;; It does completion using the alist in completion-table
+;; unless STRING starts with an open-paren.
+(defun Info-read-node-name-1 (string predicate code)
+ (let ((no-completion (and (> (length string) 0) (eq (aref string 0) ?\())))
+ (cond ((eq code nil)
+ (if no-completion
+ string
+ (try-completion string completion-table predicate)))
+ ((eq code t)
+ (if no-completion
+ nil
+ (all-completions string completion-table predicate)))
+ ((eq code 'lambda)
+ (if no-completion
+ t
+ (assoc string completion-table))))))
+
+(defun Info-read-node-name (prompt &optional default)
+ (let* ((completion-ignore-case t)
+ (completion-table (Info-build-node-completions))
+ (nodename (completing-read prompt 'Info-read-node-name-1)))
+ (if (equal nodename "")
+ (or default
+ (Info-read-node-name prompt))
+ nodename)))
+
+(defun Info-build-node-completions ()
+ (or Info-current-file-completions
+ (let ((compl nil))
+ (save-excursion
+ (save-restriction
+ (if (marker-buffer Info-tag-table-marker)
+ (progn
+ (set-buffer (marker-buffer Info-tag-table-marker))
+ (widen)
+ (goto-char Info-tag-table-marker)
+ (while (re-search-forward "\nNode: \\(.*\\)\177" nil t)
+ (setq compl
+ (cons (list (buffer-substring (match-beginning 1)
+ (match-end 1)))
+ compl))))
+ (widen)
+ (goto-char (point-min))
+ (while (search-forward "\n\^_" nil t)
+ (forward-line 1)
+ (let ((beg (point)))
+ (forward-line 1)
+ (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]"
+ beg t)
+ (setq compl
+ (cons (list (buffer-substring (match-beginning 1)
+ (match-end 1)))
+ compl))))))))
+ (setq Info-current-file-completions compl))))
+
+(defun Info-restore-point (hl)
+ "If this node has been visited, restore the point value when we left."
+ (while hl
+ (if (and (equal (nth 0 (car hl)) Info-current-file)
+ ;; Use string-equal, not equal, to ignore text props.
+ (string-equal (nth 1 (car hl)) Info-current-node))
+ (progn
+ (goto-char (nth 2 (car hl)))
+ (setq hl nil)) ;terminate the while at next iter
+ (setq hl (cdr hl)))))
+
+(defvar Info-last-search nil
+ "Default regexp for \\<Info-mode-map>\\[Info-search] command to search for.")
+
+(defun Info-search (regexp)
+ "Search for REGEXP, starting from point, and select node it's found in."
+ (interactive "sSearch (regexp): ")
+ (if transient-mark-mode (deactivate-mark))
+ (if (equal regexp "")
+ (setq regexp Info-last-search)
+ (setq Info-last-search regexp))
+ (let ((found ()) current
+ (onode Info-current-node)
+ (ofile Info-current-file)
+ (opoint (point))
+ (osubfile Info-current-subfile))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if (null Info-current-subfile)
+ (progn (re-search-forward regexp) (setq found (point)))
+ (condition-case err
+ (progn (re-search-forward regexp) (setq found (point)))
+ (search-failed nil)))))
+ (if (not found) ;can only happen in subfile case -- else would have erred
+ (unwind-protect
+ (let ((list ()))
+ (set-buffer (marker-buffer Info-tag-table-marker))
+ (goto-char (point-min))
+ (search-forward "\n\^_\nIndirect:")
+ (save-restriction
+ (narrow-to-region (point)
+ (progn (search-forward "\n\^_")
+ (1- (point))))
+ (goto-char (point-min))
+ (search-forward (concat "\n" osubfile ": "))
+ (beginning-of-line)
+ (while (not (eobp))
+ (re-search-forward "\\(^.*\\): [0-9]+$")
+ (goto-char (+ (match-end 1) 2))
+ (setq list (cons (cons (read (current-buffer))
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))
+ list))
+ (goto-char (1+ (match-end 0))))
+ (setq list (nreverse list)
+ current (car (car list))
+ list (cdr list)))
+ (while list
+ (message "Searching subfile %s..." (cdr (car list)))
+ (Info-read-subfile (car (car list)))
+ (setq list (cdr list))
+;; (goto-char (point-min))
+ (if (re-search-forward regexp nil t)
+ (setq found (point) list ())))
+ (if found
+ (message "")
+ (signal 'search-failed (list regexp))))
+ (if (not found)
+ (progn (Info-read-subfile opoint)
+ (goto-char opoint)
+ (Info-select-node)))))
+ (widen)
+ (goto-char found)
+ (Info-select-node)
+ ;; Use string-equal, not equal, to ignore text props.
+ (or (and (string-equal onode Info-current-node)
+ (equal ofile Info-current-file))
+ (setq Info-history (cons (list ofile onode opoint)
+ Info-history)))))
+
+;; Extract the value of the node-pointer named NAME.
+;; If there is none, use ERRORNAME in the error message;
+;; if ERRORNAME is nil, just return nil.
+(defun Info-extract-pointer (name &optional errorname)
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line 1)
+ (if (re-search-backward (concat name ":") nil t)
+ (progn
+ (goto-char (match-end 0))
+ (Info-following-node-name))
+ (if (eq errorname t)
+ nil
+ (error "Node has no %s" (capitalize (or errorname name)))))))
+
+;; Return the node name in the buffer following point.
+;; ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp
+;; saying which chas may appear in the node name.
+(defun Info-following-node-name (&optional allowedchars)
+ (skip-chars-forward " \t")
+ (buffer-substring-no-properties
+ (point)
+ (progn
+ (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]"))
+ (skip-chars-forward (concat (or allowedchars "^,\t\n") "("))
+ (if (looking-at "(")
+ (skip-chars-forward "^)")))
+ (skip-chars-backward " ")
+ (point))))
+
+(defun Info-next ()
+ "Go to the next node of this node."
+ (interactive)
+ (Info-goto-node (Info-extract-pointer "next")))
+
+(defun Info-prev ()
+ "Go to the previous node of this node."
+ (interactive)
+ (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous")))
+
+(defun Info-up ()
+ "Go to the superior node of this node."
+ (interactive)
+ (Info-goto-node (Info-extract-pointer "up"))
+ (Info-restore-point Info-history))
+
+(defun Info-last ()
+ "Go back to the last node visited."
+ (interactive)
+ (or Info-history
+ (error "This is the first Info node you looked at"))
+ (let (filename nodename opoint)
+ (setq filename (car (car Info-history)))
+ (setq nodename (car (cdr (car Info-history))))
+ (setq opoint (car (cdr (cdr (car Info-history)))))
+ (setq Info-history (cdr Info-history))
+ (Info-find-node filename nodename)
+ (setq Info-history (cdr Info-history))
+ (goto-char opoint)))
+
+(defun Info-directory ()
+ "Go to the Info directory node."
+ (interactive)
+ (Info-find-node "dir" "top"))
+
+(defun Info-follow-reference (footnotename)
+ "Follow cross reference named NAME to the node it refers to.
+NAME may be an abbreviation of the reference name."
+ (interactive
+ (let ((completion-ignore-case t)
+ completions default alt-default (start-point (point)) str i bol eol)
+ (save-excursion
+ ;; Store end and beginning of line.
+ (end-of-line)
+ (setq eol (point))
+ (beginning-of-line)
+ (setq bol (point))
+
+ (goto-char (point-min))
+ (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
+ (setq str (buffer-substring
+ (match-beginning 1)
+ (1- (point))))
+ ;; See if this one should be the default.
+ (and (null default)
+ (<= (match-beginning 0) start-point)
+ (<= start-point (point))
+ (setq default t))
+ ;; See if this one should be the alternate default.
+ (and (null alt-default)
+ (and (<= bol (match-beginning 0))
+ (<= (point) eol))
+ (setq alt-default t))
+ (setq i 0)
+ (while (setq i (string-match "[ \n\t]+" str i))
+ (setq str (concat (substring str 0 i) " "
+ (substring str (match-end 0))))
+ (setq i (1+ i)))
+ ;; Record as a completion and perhaps as default.
+ (if (eq default t) (setq default str))
+ (if (eq alt-default t) (setq alt-default str))
+ (setq completions
+ (cons (cons str nil)
+ completions))))
+ ;; If no good default was found, try an alternate.
+ (or default
+ (setq default alt-default))
+ ;; If only one cross-reference found, then make it default.
+ (if (eq (length completions) 1)
+ (setq default (car (car completions))))
+ (if completions
+ (let ((input (completing-read (if default
+ (concat "Follow reference named: ("
+ default ") ")
+ "Follow reference named: ")
+ completions nil t)))
+ (list (if (equal input "")
+ default input)))
+ (error "No cross-references in this node"))))
+ (let (target beg i (str (concat "\\*note " (regexp-quote footnotename))))
+ (while (setq i (string-match " " str i))
+ (setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
+ (setq i (+ i 6)))
+ (save-excursion
+ (goto-char (point-min))
+ (or (re-search-forward str nil t)
+ (error "No cross-reference named %s" footnotename))
+ (goto-char (+ (match-beginning 0) 5))
+ (setq target
+ (Info-extract-menu-node-name "Bad format cross reference" t)))
+ (while (setq i (string-match "[ \t\n]+" target i))
+ (setq target (concat (substring target 0 i) " "
+ (substring target (match-end 0))))
+ (setq i (+ i 1)))
+ (Info-goto-node target)))
+
+(defun Info-extract-menu-node-name (&optional errmessage multi-line)
+ (skip-chars-forward " \t\n")
+ (let ((beg (point))
+ str i)
+ (skip-chars-forward "^:")
+ (forward-char 1)
+ (setq str
+ (if (looking-at ":")
+ (buffer-substring-no-properties beg (1- (point)))
+ (skip-chars-forward " \t\n")
+ (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n"))))
+ (while (setq i (string-match "\n" str i))
+ (aset str i ?\ ))
+ ;; Collapse multiple spaces.
+ (while (string-match " +" str)
+ (setq str (replace-match " " t t str)))
+ str))
+
+;; No one calls this.
+;;(defun Info-menu-item-sequence (list)
+;; (while list
+;; (Info-menu (car list))
+;; (setq list (cdr list))))
+
+(defun Info-complete-menu-item (string predicate action)
+ (let ((case-fold-search t))
+ (cond ((eq action nil)
+ (let (completions
+ (pattern (concat "\n\\* \\("
+ (regexp-quote string)
+ "[^:\t\n]*\\):")))
+ (save-excursion
+ (set-buffer Info-complete-menu-buffer)
+ (goto-char (point-min))
+ (search-forward "\n* Menu:")
+ (while (re-search-forward pattern nil t)
+ (setq completions (cons (cons (format "%s"
+ (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))
+ (match-beginning 1))
+ completions))))
+ (try-completion string completions predicate)))
+ ((eq action t)
+ (let (completions
+ (pattern (concat "\n\\* \\("
+ (regexp-quote string)
+ "[^:\t\n]*\\):")))
+ (save-excursion
+ (set-buffer Info-complete-menu-buffer)
+ (goto-char (point-min))
+ (search-forward "\n* Menu:")
+ (while (re-search-forward pattern nil t)
+ (setq completions (cons (cons (format "%s"
+ (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))
+ (match-beginning 1))
+ completions))))
+ (all-completions string completions predicate)))
+ (t
+ (save-excursion
+ (set-buffer Info-complete-menu-buffer)
+ (goto-char (point-min))
+ (search-forward "\n* Menu:")
+ (re-search-forward (concat "\n\\* "
+ (regexp-quote string)
+ ":")
+ nil t))))))
+
+
+(defun Info-menu (menu-item)
+ "Go to node for menu item named (or abbreviated) NAME.
+Completion is allowed, and the menu item point is on is the default."
+ (interactive
+ (let ((completions '())
+ ;; If point is within a menu item, use that item as the default
+ (default nil)
+ (p (point))
+ beg
+ (last nil))
+ (save-excursion
+ (goto-char (point-min))
+ (if (not (search-forward "\n* menu:" nil t))
+ (error "No menu in this node"))
+ (setq beg (point))
+ (and (< (point) p)
+ (save-excursion
+ (goto-char p)
+ (end-of-line)
+ (re-search-backward "\n\\* \\([^:\t\n]*\\):" beg t)
+ (setq default (format "%s" (buffer-substring
+ (match-beginning 1)
+ (match-end 1)))))))
+ (let ((item nil))
+ (while (null item)
+ (setq item (let ((completion-ignore-case t)
+ (Info-complete-menu-buffer (current-buffer)))
+ (completing-read (if default
+ (format "Menu item (default %s): "
+ default)
+ "Menu item: ")
+ 'Info-complete-menu-item nil t)))
+ ;; we rely on the fact that completing-read accepts an input
+ ;; of "" even when the require-match argument is true and ""
+ ;; is not a valid possibility
+ (if (string= item "")
+ (if default
+ (setq item default)
+ ;; ask again
+ (setq item nil))))
+ (list item))))
+ ;; there is a problem here in that if several menu items have the same
+ ;; name you can only go to the node of the first with this command.
+ (Info-goto-node (Info-extract-menu-item menu-item)))
+
+(defun Info-extract-menu-item (menu-item)
+ (setq menu-item (regexp-quote menu-item))
+ (save-excursion
+ (goto-char (point-min))
+ (or (search-forward "\n* menu:" nil t)
+ (error "No menu in this node"))
+ (or (re-search-forward (concat "\n\\* " menu-item ":") nil t)
+ (re-search-forward (concat "\n\\* " menu-item) nil t)
+ (error "No such item in menu"))
+ (beginning-of-line)
+ (forward-char 2)
+ (Info-extract-menu-node-name)))
+
+;; If COUNT is nil, use the last item in the menu.
+(defun Info-extract-menu-counting (count)
+ (save-excursion
+ (goto-char (point-min))
+ (or (search-forward "\n* menu:" nil t)
+ (error "No menu in this node"))
+ (if count
+ (or (search-forward "\n* " nil t count)
+ (error "Too few items in menu"))
+ (while (search-forward "\n* " nil t)
+ nil))
+ (Info-extract-menu-node-name)))
+
+(defun Info-nth-menu-item ()
+ "Go to the node of the Nth menu item.
+N is the digit argument used to invoke this command."
+ (interactive)
+ (Info-goto-node
+ (Info-extract-menu-counting
+ (- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0))))
+
+(defun Info-top-node ()
+ "Go to the Top node of this file."
+ (interactive)
+ (Info-goto-node "Top"))
+
+(defun Info-final-node ()
+ "Go to the final node in this file."
+ (interactive)
+ (Info-goto-node "Top")
+ (let (Info-history)
+ ;; Go to the last node in the menu of Top.
+ (Info-goto-node (Info-extract-menu-counting nil))
+ ;; If the last node in the menu is not last in pointer structure,
+ ;; move forward until we can't go any farther.
+ (while (Info-forward-node t t) nil)
+ ;; Then keep moving down to last subnode, unless we reach an index.
+ (while (and (not (string-match "\\<index\\>" Info-current-node))
+ (save-excursion (search-forward "\n* Menu:" nil t)))
+ (Info-goto-node (Info-extract-menu-counting nil)))))
+
+(defun Info-forward-node (&optional not-down no-error)
+ "Go forward one node, considering all nodes as forming one sequence."
+ (interactive)
+ (goto-char (point-min))
+ (forward-line 1)
+ ;; three possibilities, in order of priority:
+ ;; 1. next node is in a menu in this node (but not in an index)
+ ;; 2. next node is next at same level
+ ;; 3. next node is up and next
+ (cond ((and (not not-down)
+ (save-excursion (search-forward "\n* menu:" nil t))
+ (not (string-match "\\<index\\>" Info-current-node)))
+ (Info-goto-node (Info-extract-menu-counting 1))
+ t)
+ ((save-excursion (search-backward "next:" nil t))
+ (Info-next)
+ t)
+ ((and (save-excursion (search-backward "up:" nil t))
+ ;; Use string-equal, not equal, to ignore text props.
+ (not (string-equal (downcase (Info-extract-pointer "up"))
+ "top")))
+ (let ((old-node Info-current-node))
+ (Info-up)
+ (let (Info-history success)
+ (unwind-protect
+ (setq success (Info-forward-node t no-error))
+ (or success (Info-goto-node old-node))))))
+ (no-error nil)
+ (t (error "No pointer forward from this node"))))
+
+(defun Info-backward-node ()
+ "Go backward one node, considering all nodes as forming one sequence."
+ (interactive)
+ (let ((prevnode (Info-extract-pointer "prev[ious]*" t))
+ (upnode (Info-extract-pointer "up" t)))
+ (cond ((and upnode (string-match "(" upnode))
+ (error "First node in file"))
+ ((and upnode (or (null prevnode)
+ ;; Use string-equal, not equal,
+ ;; to ignore text properties.
+ (string-equal (downcase prevnode)
+ (downcase upnode))))
+ (Info-up))
+ (prevnode
+ ;; If we move back at the same level,
+ ;; go down to find the last subnode*.
+ (Info-prev)
+ (let (Info-history)
+ (while (and (not (string-match "\\<index\\>" Info-current-node))
+ (save-excursion (search-forward "\n* Menu:" nil t)))
+ (Info-goto-node (Info-extract-menu-counting nil)))))
+ (t
+ (error "No pointer backward from this node")))))
+
+(defun Info-exit ()
+ "Exit Info by selecting some other buffer."
+ (interactive)
+ (if Info-standalone
+ (save-buffers-kill-emacs)
+ (switch-to-buffer (prog1 (other-buffer (current-buffer))
+ (bury-buffer (current-buffer))))))
+
+(defun Info-next-menu-item ()
+ (interactive)
+ (save-excursion
+ (forward-line -1)
+ (search-forward "\n* menu:" nil t)
+ (or (search-forward "\n* " nil t)
+ (error "No more items in menu"))
+ (Info-goto-node (Info-extract-menu-node-name))))
+
+(defun Info-last-menu-item ()
+ (interactive)
+ (save-excursion
+ (forward-line 1)
+ (let ((beg (save-excursion
+ (and (search-backward "\n* menu:" nil t)
+ (point)))))
+ (or (and beg (search-backward "\n* " beg t))
+ (error "No previous items in menu")))
+ (Info-goto-node (save-excursion
+ (goto-char (match-end 0))
+ (Info-extract-menu-node-name)))))
+
+(defmacro Info-no-error (&rest body)
+ (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil)))
+
+(defun Info-next-preorder ()
+ "Go to the next subnode or the next node, or go up a level."
+ (interactive)
+ (cond ((Info-no-error (Info-next-menu-item)))
+ ((Info-no-error (Info-next)))
+ ((Info-no-error (Info-up))
+ ;; Since we have already gone thru all the items in this menu,
+ ;; go up to the end of this node.
+ (goto-char (point-max))
+ ;; Since logically we are done with the node with that menu,
+ ;; move on from it.
+ (Info-next-preorder))
+ (t
+ (error "No more nodes"))))
+
+(defun Info-last-preorder ()
+ "Go to the last node, popping up a level if there is none."
+ (interactive)
+ (cond ((Info-no-error
+ (Info-last-menu-item)
+ ;; If we go down a menu item, go to the end of the node
+ ;; so we can scroll back through it.
+ (goto-char (point-max)))
+ ;; Keep going down, as long as there are nested menu nodes.
+ (while (Info-no-error
+ (Info-last-menu-item)
+ ;; If we go down a menu item, go to the end of the node
+ ;; so we can scroll back through it.
+ (goto-char (point-max))))
+ (recenter -1))
+ ((Info-no-error (Info-prev))
+ (goto-char (point-max))
+ (while (Info-no-error
+ (Info-last-menu-item)
+ ;; If we go down a menu item, go to the end of the node
+ ;; so we can scroll back through it.
+ (goto-char (point-max))))
+ (recenter -1))
+ ((Info-no-error (Info-up))
+ (goto-char (point-min))
+ (or (search-forward "\n* Menu:" nil t)
+ (goto-char (point-max))))
+ (t (error "No previous nodes"))))
+
+(defun Info-scroll-up ()
+ "Scroll one screenful forward in Info, considering all nodes as one sequence.
+Once you scroll far enough in a node that its menu appears on the screen,
+the next scroll moves into its first subnode. When you scroll past
+the end of a node, that goes to the next node or back up to the parent node."
+ (interactive)
+ (if (or (< (window-start) (point-min))
+ (> (window-start) (point-max)))
+ (set-window-start (selected-window) (point)))
+ (let ((virtual-end (save-excursion
+ (goto-char (point-min))
+ (if (search-forward "\n* Menu:" nil t)
+ (point)
+ (point-max)))))
+ (if (or (< virtual-end (window-start))
+ (pos-visible-in-window-p virtual-end))
+ (Info-next-preorder)
+ (scroll-up))))
+
+(defun Info-scroll-down ()
+ "Scroll one screenful back in Info, considering all nodes as one sequence.
+Within the menu of a node, this goes to its last subnode.
+When you scroll past the beginning of a node, that goes to the
+previous node or back up to the parent node."
+ (interactive)
+ (if (or (< (window-start) (point-min))
+ (> (window-start) (point-max)))
+ (set-window-start (selected-window) (point)))
+ (let* ((current-point (point))
+ (virtual-end (save-excursion
+ (beginning-of-line)
+ (setq current-point (point))
+ (goto-char (point-min))
+ (search-forward "\n* Menu:"
+ current-point
+ t))))
+ (if (or virtual-end (pos-visible-in-window-p (point-min)))
+ (Info-last-preorder)
+ (scroll-down))))
+
+(defun Info-next-reference (&optional recur)
+ "Move cursor to the next cross-reference or menu item in the node."
+ (interactive)
+ (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
+ (old-pt (point)))
+ (or (eobp) (forward-char 1))
+ (or (re-search-forward pat nil t)
+ (progn
+ (goto-char (point-min))
+ (or (re-search-forward pat nil t)
+ (progn
+ (goto-char old-pt)
+ (error "No cross references in this node")))))
+ (goto-char (match-beginning 0))
+ (if (looking-at "\\* Menu:")
+ (if recur
+ (error "No cross references in this node")
+ (Info-next-reference t)))))
+
+(defun Info-prev-reference (&optional recur)
+ "Move cursor to the previous cross-reference or menu item in the node."
+ (interactive)
+ (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
+ (old-pt (point)))
+ (or (re-search-backward pat nil t)
+ (progn
+ (goto-char (point-max))
+ (or (re-search-backward pat nil t)
+ (progn
+ (goto-char old-pt)
+ (error "No cross references in this node")))))
+ (goto-char (match-beginning 0))
+ (if (looking-at "\\* Menu:")
+ (if recur
+ (error "No cross references in this node")
+ (Info-prev-reference t)))))
+
+(defun Info-index (topic)
+ "Look up a string in the index for this file.
+The index is defined as the first node in the top-level menu whose
+name contains the word \"Index\", plus any immediately following
+nodes whose names also contain the word \"Index\".
+If there are no exact matches to the specified topic, this chooses
+the first match which is a case-insensitive substring of a topic.
+Use the `,' command to see the other matches.
+Give a blank topic name to go to the Index node itself."
+ (interactive "sIndex topic: ")
+ (let ((orignode Info-current-node)
+ (rnode nil)
+ (pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)"
+ (regexp-quote topic)))
+ node)
+ (Info-goto-node "Top")
+ (or (search-forward "\n* menu:" nil t)
+ (error "No index"))
+ (or (re-search-forward "\n\\* \\(.*\\<Index\\>\\)" nil t)
+ (error "No index"))
+ (goto-char (match-beginning 1))
+ ;; Here, and subsequently in this function,
+ ;; we bind Info-history to nil for internal node-switches
+ ;; so that we don't put junk in the history.
+ ;; In the first Info-goto-node call, above, we do update the history
+ ;; because that is what the user's previous node choice into it.
+ (let ((Info-history nil))
+ (Info-goto-node (Info-extract-menu-node-name)))
+ (or (equal topic "")
+ (let ((matches nil)
+ (exact nil)
+ (Info-history nil)
+ found)
+ (while
+ (progn
+ (goto-char (point-min))
+ (while (re-search-forward pattern nil t)
+ (setq matches
+ (cons (list (buffer-substring (match-beginning 1)
+ (match-end 1))
+ (buffer-substring (match-beginning 2)
+ (match-end 2))
+ Info-current-node
+ (string-to-int (concat "0"
+ (buffer-substring
+ (match-beginning 3)
+ (match-end 3)))))
+ matches)))
+ (and (setq node (Info-extract-pointer "next" t))
+ (string-match "\\<Index\\>" node)))
+ (Info-goto-node node))
+ (or matches
+ (progn
+ (Info-goto-node orignode)
+ (error "No `%s' in index" topic)))
+ ;; Here it is a feature that assoc is case-sensitive.
+ (while (setq found (assoc topic matches))
+ (setq exact (cons found exact)
+ matches (delq found matches)))
+ (setq Info-index-alternatives (nconc exact (nreverse matches)))
+ (Info-index-next 0)))))
+
+(defun Info-index-next (num)
+ "Go to the next matching index item from the last `i' command."
+ (interactive "p")
+ (or Info-index-alternatives
+ (error "No previous `i' command in this file"))
+ (while (< num 0)
+ (setq num (+ num (length Info-index-alternatives))))
+ (while (> num 0)
+ (setq Info-index-alternatives
+ (nconc (cdr Info-index-alternatives)
+ (list (car Info-index-alternatives)))
+ num (1- num)))
+ (Info-goto-node (nth 1 (car Info-index-alternatives)))
+ (if (> (nth 3 (car Info-index-alternatives)) 0)
+ (forward-line (nth 3 (car Info-index-alternatives)))
+ (forward-line 3) ; don't search in headers
+ (let ((name (car (car Info-index-alternatives))))
+ (Info-find-index-name name)))
+ (message "Found `%s' in %s. %s"
+ (car (car Info-index-alternatives))
+ (nth 2 (car Info-index-alternatives))
+ (if (cdr Info-index-alternatives)
+ "(Press `,' for more)"
+ "(Only match)")))
+
+(defun Info-find-index-name (name)
+ "Move point to the place within the current node where NAME is defined."
+ (if (or (re-search-forward (format
+ "[a-zA-Z]+: %s\\( \\|$\\)"
+ (regexp-quote name)) nil t)
+ (search-forward (format "`%s'" name) nil t)
+ (and (string-match "\\`.*\\( (.*)\\)\\'" name)
+ (search-forward
+ (format "`%s'" (substring name 0 (match-beginning 1)))
+ nil t))
+ (search-forward name nil t))
+ (beginning-of-line)
+ (goto-char (point-min))))
+
+(defun Info-undefined ()
+ "Make command be undefined in Info."
+ (interactive)
+ (ding))
+
+(defun Info-help ()
+ "Enter the Info tutorial."
+ (interactive)
+ (delete-other-windows)
+ (Info-find-node "info"
+ (if (< (window-height) 23)
+ "Help-Small-Screen"
+ "Help")))
+
+(defun Info-summary ()
+ "Display a brief summary of all Info commands."
+ (interactive)
+ (save-window-excursion
+ (switch-to-buffer "*Help*")
+ (erase-buffer)
+ (insert (documentation 'Info-mode))
+ (help-mode)
+ (goto-char (point-min))
+ (let (ch flag)
+ (while (progn (setq flag (not (pos-visible-in-window-p (point-max))))
+ (message (if flag "Type Space to see more"
+ "Type Space to return to Info"))
+ (if (not (eq ?\ (setq ch (read-event))))
+ (progn (setq unread-command-events (list ch)) nil)
+ flag))
+ (scroll-up)))
+ (bury-buffer "*Help*")))
+
+(defun Info-get-token (pos start all &optional errorstring)
+ "Return the token around POS,
+POS must be somewhere inside the token
+START is a regular expression which will match the
+ beginning of the tokens delimited string
+ALL is a regular expression with a single
+ parenthesized subpattern which is the token to be
+ returned. E.g. '{\(.*\)}' would return any string
+ enclosed in braces around POS.
+SIG optional fourth argument, controls action on no match
+ nil: return nil
+ t: beep
+ a string: signal an error, using that string."
+ (save-excursion
+ (goto-char pos)
+ (re-search-backward start (max (point-min) (- pos 200)) 'yes)
+ (let (found)
+ (while (and (re-search-forward all (min (point-max) (+ pos 200)) 'yes)
+ (not (setq found (and (<= (match-beginning 0) pos)
+ (> (match-end 0) pos))))))
+ (if (and found (<= (match-beginning 0) pos)
+ (> (match-end 0) pos))
+ (buffer-substring (match-beginning 1) (match-end 1))
+ (cond ((null errorstring)
+ nil)
+ ((eq errorstring t)
+ (beep)
+ nil)
+ (t
+ (error "No %s around position %d" errorstring pos)))))))
+
+(defun Info-mouse-follow-nearest-node (click)
+ "\\<Info-mode-map>Follow a node reference near point.
+Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where you click.
+At end of the node's text, moves to the next node, or up if none."
+ (interactive "e")
+ (let* ((start (event-start click))
+ (window (car start))
+ (pos (car (cdr start))))
+ (select-window window)
+ (goto-char pos))
+ (and (not (Info-try-follow-nearest-node))
+ (save-excursion (forward-line 1) (eobp))
+ (Info-next-preorder)))
+
+(defun Info-follow-nearest-node ()
+ "\\<Info-mode-map>Follow a node reference near point.
+Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where point is.
+If no reference to follow, moves to the next node, or up if none."
+ (interactive)
+ (or (Info-try-follow-nearest-node)
+ (Info-next-preorder)))
+
+;; Common subroutine.
+(defun Info-try-follow-nearest-node ()
+ "Follow a node reference near point. Return non-nil if successful."
+ (let (node)
+ (cond
+ ((setq node (Info-get-token (point) "\\*note[ \n]"
+ "\\*note[ \n]\\([^:]*\\):"))
+ (Info-follow-reference node))
+ ((setq node (Info-get-token (point) "\\* " "\\* \\([^:]*\\)::"))
+ (Info-goto-node node))
+ ((setq node (Info-get-token (point) "\\* " "\\* \\([^:]*\\):"))
+ (Info-menu node))
+ ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)"))
+ (Info-goto-node node))
+ ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)"))
+ (Info-goto-node node))
+ ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)"))
+ (Info-goto-node "Top"))
+ ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
+ (Info-goto-node node)))
+ node))
+
+(defvar Info-mode-map nil
+ "Keymap containing Info commands.")
+(if Info-mode-map
+ nil
+ (setq Info-mode-map (make-keymap))
+ (suppress-keymap Info-mode-map)
+ (define-key Info-mode-map "." 'beginning-of-buffer)
+ (define-key Info-mode-map " " 'Info-scroll-up)
+ (define-key Info-mode-map "\C-m" 'Info-follow-nearest-node)
+ (define-key Info-mode-map "\t" 'Info-next-reference)
+ (define-key Info-mode-map "\e\t" 'Info-prev-reference)
+ (define-key Info-mode-map "1" 'Info-nth-menu-item)
+ (define-key Info-mode-map "2" 'Info-nth-menu-item)
+ (define-key Info-mode-map "3" 'Info-nth-menu-item)
+ (define-key Info-mode-map "4" 'Info-nth-menu-item)
+ (define-key Info-mode-map "5" 'Info-nth-menu-item)
+ (define-key Info-mode-map "6" 'Info-nth-menu-item)
+ (define-key Info-mode-map "7" 'Info-nth-menu-item)
+ (define-key Info-mode-map "8" 'Info-nth-menu-item)
+ (define-key Info-mode-map "9" 'Info-nth-menu-item)
+ (define-key Info-mode-map "0" 'undefined)
+ (define-key Info-mode-map "?" 'Info-summary)
+ (define-key Info-mode-map "]" 'Info-forward-node)
+ (define-key Info-mode-map "[" 'Info-backward-node)
+ (define-key Info-mode-map "<" 'Info-top-node)
+ (define-key Info-mode-map ">" 'Info-final-node)
+ (define-key Info-mode-map "b" 'beginning-of-buffer)
+ (define-key Info-mode-map "d" 'Info-directory)
+ (define-key Info-mode-map "e" 'Info-edit)
+ (define-key Info-mode-map "f" 'Info-follow-reference)
+ (define-key Info-mode-map "g" 'Info-goto-node)
+ (define-key Info-mode-map "h" 'Info-help)
+ (define-key Info-mode-map "i" 'Info-index)
+ (define-key Info-mode-map "l" 'Info-last)
+ (define-key Info-mode-map "m" 'Info-menu)
+ (define-key Info-mode-map "n" 'Info-next)
+ (define-key Info-mode-map "p" 'Info-prev)
+ (define-key Info-mode-map "q" 'Info-exit)
+ (define-key Info-mode-map "s" 'Info-search)
+ ;; For consistency with Rmail.
+ (define-key Info-mode-map "\M-s" 'Info-search)
+ (define-key Info-mode-map "t" 'Info-top-node)
+ (define-key Info-mode-map "u" 'Info-up)
+ (define-key Info-mode-map "," 'Info-index-next)
+ (define-key Info-mode-map "\177" 'Info-scroll-down)
+ (define-key Info-mode-map [mouse-2] 'Info-mouse-follow-nearest-node)
+ )
+
+;; Info mode is suitable only for specially formatted data.
+(put 'info-mode 'mode-class 'special)
+
+(defun Info-mode ()
+ "\\<Info-mode-map>
+Info mode provides commands for browsing through the Info documentation tree.
+Documentation in Info is divided into \"nodes\", each of which discusses
+one topic and contains references to other nodes which discuss related
+topics. Info has commands to follow the references and show you other nodes.
+
+\\[Info-help] Invoke the Info tutorial.
+
+Selecting other nodes:
+\\[Info-mouse-follow-nearest-node]
+ Follow a node reference you click on.
+ This works with menu items, cross references, and
+ the \"next\", \"previous\" and \"up\", depending on where you click.
+\\[Info-next] Move to the \"next\" node of this node.
+\\[Info-prev] Move to the \"previous\" node of this node.
+\\[Info-up] Move \"up\" from this node.
+\\[Info-menu] Pick menu item specified by name (or abbreviation).
+ Picking a menu item causes another node to be selected.
+\\[Info-directory] Go to the Info directory node.
+\\[Info-follow-reference] Follow a cross reference. Reads name of reference.
+\\[Info-last] Move to the last node you were at.
+\\[Info-index] Look up a topic in this file's Index and move to that node.
+\\[Info-index-next] (comma) Move to the next match from a previous `i' command.
+
+Moving within a node:
+\\[Info-scroll-up] Normally, scroll forward a full screen. If the end of the buffer is
+already visible, try to go to the next menu entry, or up if there is none.
+\\[Info-scroll-down] Normally, scroll backward. If the beginning of the buffer is
+already visible, try to go to the previous menu entry, or up if there is none.
+\\[beginning-of-buffer] Go to beginning of node.
+
+Advanced commands:
+\\[Info-exit] Quit Info: reselect previously selected buffer.
+\\[Info-edit] Edit contents of selected node.
+1 Pick first item in node's menu.
+2, 3, 4, 5 Pick second ... fifth item in node's menu.
+\\[Info-goto-node] Move to node specified by name.
+ You may include a filename as well, as (FILENAME)NODENAME.
+\\[universal-argument] \\[info] Move to new Info file with completion.
+\\[Info-search] Search through this Info file for specified regexp,
+ and select the node in which the next occurrence is found.
+\\[Info-next-reference] Move cursor to next cross-reference or menu item.
+\\[Info-prev-reference] Move cursor to previous cross-reference or menu item."
+ (kill-all-local-variables)
+ (setq major-mode 'Info-mode)
+ (setq mode-name "Info")
+ (use-local-map Info-mode-map)
+ (set-syntax-table text-mode-syntax-table)
+ (setq local-abbrev-table text-mode-abbrev-table)
+ (setq case-fold-search t)
+ (setq buffer-read-only t)
+ (make-local-variable 'Info-current-file)
+ (make-local-variable 'Info-current-subfile)
+ (make-local-variable 'Info-current-node)
+ (make-local-variable 'Info-tag-table-marker)
+ (make-local-variable 'Info-history)
+ (make-local-variable 'Info-index-alternatives)
+ (if (memq (framep (selected-frame)) '(x pc))
+ (progn
+ (make-face 'info-node)
+ (make-face 'info-menu-5)
+ (make-face 'info-xref)
+ (or (face-differs-from-default-p 'info-node)
+ (if (face-differs-from-default-p 'bold-italic)
+ (copy-face 'bold-italic 'info-node)
+ (copy-face 'bold 'info-node)))
+ (or (face-differs-from-default-p 'info-menu-5)
+ (set-face-underline-p 'info-menu-5 t))
+ (or (face-differs-from-default-p 'info-xref)
+ (copy-face 'bold 'info-xref)))
+ (setq Info-fontify nil))
+ (Info-set-mode-line)
+ (run-hooks 'Info-mode-hook))
+
+(defvar Info-edit-map nil
+ "Local keymap used within `e' command of Info.")
+(if Info-edit-map
+ nil
+ (setq Info-edit-map (nconc (make-sparse-keymap) text-mode-map))
+ (define-key Info-edit-map "\C-c\C-c" 'Info-cease-edit))
+
+;; Info-edit mode is suitable only for specially formatted data.
+(put 'info-edit-mode 'mode-class 'special)
+
+(defun Info-edit-mode ()
+ "Major mode for editing the contents of an Info node.
+Like text mode with the addition of `Info-cease-edit'
+which returns to Info mode for browsing.
+\\{Info-edit-map}"
+ (use-local-map Info-edit-map)
+ (setq major-mode 'Info-edit-mode)
+ (setq mode-name "Info Edit")
+ (kill-local-variable 'mode-line-buffer-identification)
+ (setq buffer-read-only nil)
+ (force-mode-line-update)
+ (buffer-enable-undo (current-buffer))
+ (run-hooks 'Info-edit-mode-hook))
+
+(defun Info-edit ()
+ "Edit the contents of this Info node.
+Allowed only if variable `Info-enable-edit' is non-nil."
+ (interactive)
+ (or Info-enable-edit
+ (error "Editing info nodes is not enabled"))
+ (Info-edit-mode)
+ (message "%s" (substitute-command-keys
+ "Editing: Type \\<Info-edit-map>\\[Info-cease-edit] to return to info")))
+
+(defun Info-cease-edit ()
+ "Finish editing Info node; switch back to Info proper."
+ (interactive)
+ ;; Do this first, so nothing has changed if user C-g's at query.
+ (and (buffer-modified-p)
+ (y-or-n-p "Save the file? ")
+ (save-buffer))
+ (use-local-map Info-mode-map)
+ (setq major-mode 'Info-mode)
+ (setq mode-name "Info")
+ (Info-set-mode-line)
+ (setq buffer-read-only t)
+ (force-mode-line-update)
+ (and (marker-position Info-tag-table-marker)
+ (buffer-modified-p)
+ (message "Tags may have changed. Use Info-tagify if necessary")))
+
+(defvar Info-file-list-for-emacs
+ '("ediff" "forms" "gnus" "info" ("mh" . "mh-e") "sc")
+ "List of Info files that describe Emacs commands.
+An element can be a file name, or a list of the form (PREFIX . FILE)
+where PREFIX is a name prefix and FILE is the file to look in.
+If the element is just a file name, the file name also serves as the prefix.")
+
+(defun Info-find-emacs-command-nodes (command)
+ "Return a list of locations documenting COMMAND.
+The `info-file' property of COMMAND says which Info manual to search.
+If COMMAND has no property, the variable `Info-file-list-for-emacs'
+defines heuristics for which Info manual to try.
+The locations are of the format used in Info-history, i.e.
+\(FILENAME NODENAME BUFFERPOS\)."
+ (let ((where '())
+ (cmd-desc (concat "^\\* " (regexp-quote (symbol-name command))
+ ":\\s *\\(.*\\)\\.$"))
+ (info-file "emacs")) ;default
+ ;; Determine which info file this command is documented in.
+ (if (get command 'info-file)
+ (setq info-file (get command 'info-file))
+ ;; If it doesn't say explicitly, test its name against
+ ;; various prefixes that we know.
+ (let ((file-list Info-file-list-for-emacs))
+ (while file-list
+ (let* ((elt (car file-list))
+ (name (if (consp elt)
+ (car elt)
+ elt))
+ (file (if (consp elt) (cdr elt) elt))
+ (regexp (concat "\\`" (regexp-quote name)
+ "\\(\\'\\|-\\)")))
+ (if (string-match regexp (symbol-name command))
+ (setq info-file file file-list nil))
+ (setq file-list (cdr file-list))))))
+ (save-excursion
+ (condition-case nil
+ (Info-find-node info-file "Command Index")
+ ;; Some manuals may not have a separate Command Index node,
+ ;; so try just Index instead.
+ (error
+ (Info-find-node info-file "Index")))
+ ;; Take the index node off the Info history.
+ (setq Info-history (cdr Info-history))
+ (goto-char (point-max))
+ (while (re-search-backward cmd-desc nil t)
+ (setq where (cons (list Info-current-file
+ (buffer-substring
+ (match-beginning 1)
+ (match-end 1))
+ 0)
+ where)))
+ where)))
+
+;;;###autoload
+(defun Info-goto-emacs-command-node (command)
+ "Go to the Info node in the Emacs manual for command COMMAND.
+The command is found by looking up in Emacs manual's Command Index
+or in another manual found via COMMAND's `info-file' property or
+the variable `Info-file-list-for-emacs'."
+ (interactive "CFind documentation for command: ")
+ (or (commandp command)
+ (signal 'wrong-type-argument (list 'commandp command)))
+ (let ((where (Info-find-emacs-command-nodes command)))
+ (if where
+ (let ((num-matches (length where)))
+ ;; Get Info running, and pop to it in another window.
+ (save-window-excursion
+ (info))
+ (pop-to-buffer "*info*")
+ (Info-find-node (car (car where))
+ (car (cdr (car where))))
+ (if (> num-matches 1)
+ (progn
+ ;; Info-find-node already pushed (car where) onto
+ ;; Info-history. Put the other nodes that were found on
+ ;; the history.
+ (setq Info-history (nconc (cdr where) Info-history))
+ (message "Found %d other entr%s. Use %s to see %s."
+ (1- num-matches)
+ (if (> num-matches 2) "ies" "y")
+ (substitute-command-keys "\\[Info-last]")
+ (if (> num-matches 2) "them" "it")))))
+ (error "Couldn't find documentation for %s" command))))
+
+;;;###autoload
+(defun Info-goto-emacs-key-command-node (key)
+ "Go to the Info node in the Emacs manual the command bound to KEY, a string.
+Interactively, if the binding is execute-extended-command, a command is read.
+The command is found by looking up in Emacs manual's Command Index
+or in another manual found via COMMAND's `info-file' property or
+the variable `Info-file-list-for-emacs'."
+ (interactive "kFind documentation for key:")
+ (let ((command (key-binding key)))
+ (cond ((null command)
+ (message "%s is undefined" (key-description key)))
+ ((and (interactive-p)
+ (eq command 'execute-extended-command))
+ (Info-goto-emacs-command-node
+ (read-command "Find documentation for command: ")))
+ (t
+ (Info-goto-emacs-command-node command)))))
+
+(defvar Info-title-face-alist
+ '((?* bold underline)
+ (?= bold-italic underline)
+ (?- italic underline))
+ "*Alist of face or list of faces to use for pseudo-underlined titles.
+The alist key is the character the title is underlined with (?*, ?= or ?-).")
+
+(defun Info-fontify-node ()
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ (if (looking-at "^File: [^,: \t]+,?[ \t]+")
+ (progn
+ (goto-char (match-end 0))
+ (while
+ (looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?")
+ (goto-char (match-end 0))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face 'info-xref)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'mouse-face 'highlight))))
+ (goto-char (point-min))
+ (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\)$"
+ nil t)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face
+ (cdr (assq (preceding-char) Info-title-face-alist)))
+ (put-text-property (match-end 1) (match-end 2)
+ 'invisible t))
+ (goto-char (point-min))
+ (while (re-search-forward "\\*Note[ \n\t]+\\([^:]*\\):" nil t)
+ (if (= (char-after (1- (match-beginning 0))) ?\") ; hack
+ nil
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face 'info-xref)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'mouse-face 'highlight)))
+ (goto-char (point-min))
+ (if (and (search-forward "\n* Menu:" nil t)
+ (not (string-match "\\<Index\\>" Info-current-node))
+ ;; Don't take time to annotate huge menus
+ (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
+ (let ((n 0))
+ (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t)
+ (setq n (1+ n))
+ (if (memq n '(5 9)) ; visual aids to help with 1-9 keys
+ (put-text-property (match-beginning 0)
+ (1+ (match-beginning 0))
+ 'face 'info-menu-5))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face 'info-node)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'mouse-face 'highlight))))
+ (set-buffer-modified-p nil))))
+
+(provide 'info)
+
+;;; info.el ends here
diff --git a/texinfo/emacs/informat.el b/texinfo/emacs/informat.el
new file mode 100644
index 00000000000..0b195b9e620
--- /dev/null
+++ b/texinfo/emacs/informat.el
@@ -0,0 +1,429 @@
+;;; informat.el --- info support functions package for Emacs
+
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: help
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 Emacs 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 Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'info)
+
+;;;###autoload
+(defun Info-tagify ()
+ "Create or update Info-file tag table in current buffer."
+ (interactive)
+ ;; Save and restore point and restrictions.
+ ;; save-restrictions would not work
+ ;; because it records the old max relative to the end.
+ ;; We record it relative to the beginning.
+ (message "Tagifying %s ..." (file-name-nondirectory (buffer-file-name)))
+ (let ((omin (point-min))
+ (omax (point-max))
+ (nomax (= (point-max) (1+ (buffer-size))))
+ (opoint (point)))
+ (unwind-protect
+ (progn
+ (widen)
+ (goto-char (point-min))
+ (if (search-forward "\^_\nIndirect:\n" nil t)
+ (message "Cannot tagify split info file")
+ (let ((regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
+ (case-fold-search t)
+ list)
+ (while (search-forward "\n\^_" nil t)
+ ;; We want the 0-origin character position of the ^_.
+ ;; That is the same as the Emacs (1-origin) position
+ ;; of the newline before it.
+ (let ((beg (match-beginning 0)))
+ (forward-line 2)
+ (if (re-search-backward regexp beg t)
+ (setq list
+ (cons (list (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 1))
+ beg)
+ list)))))
+ (goto-char (point-max))
+ (forward-line -8)
+ (let ((buffer-read-only nil))
+ (if (search-forward "\^_\nEnd tag table\n" nil t)
+ (let ((end (point)))
+ (search-backward "\nTag table:\n")
+ (beginning-of-line)
+ (delete-region (point) end)))
+ (goto-char (point-max))
+ (insert "\^_\f\nTag table:\n")
+ (move-marker Info-tag-table-marker (point))
+ (setq list (nreverse list))
+ (while list
+ (insert "Node: " (car (car list)) ?\177)
+ (princ (car (cdr (car list))) (current-buffer))
+ (insert ?\n)
+ (setq list (cdr list)))
+ (insert "\^_\nEnd tag table\n")))))
+ (goto-char opoint)
+ (narrow-to-region omin (if nomax (1+ (buffer-size))
+ (min omax (point-max))))))
+ (message "Tagifying %s ... done" (file-name-nondirectory (buffer-file-name))))
+
+;;;###autoload
+(defun Info-split ()
+ "Split an info file into an indirect file plus bounded-size subfiles.
+Each subfile will be up to 50,000 characters plus one node.
+
+To use this command, first visit a large Info file that has a tag
+table. The buffer is modified into a (small) indirect info file which
+should be saved in place of the original visited file.
+
+The subfiles are written in the same directory the original file is
+in, with names generated by appending `-' and a number to the original
+file name. The indirect file still functions as an Info file, but it
+contains just the tag table and a directory of subfiles."
+
+ (interactive)
+ (if (< (buffer-size) 70000)
+ (error "This is too small to be worth splitting"))
+ (goto-char (point-min))
+ (search-forward "\^_")
+ (forward-char -1)
+ (let ((start (point))
+ (chars-deleted 0)
+ subfiles
+ (subfile-number 1)
+ (case-fold-search t)
+ (filename (file-name-sans-versions buffer-file-name)))
+ (goto-char (point-max))
+ (forward-line -8)
+ (setq buffer-read-only nil)
+ (or (search-forward "\^_\nEnd tag table\n" nil t)
+ (error "Tag table required; use M-x Info-tagify"))
+ (search-backward "\nTag table:\n")
+ (if (looking-at "\nTag table:\n\^_")
+ (error "Tag table is just a skeleton; use M-x Info-tagify"))
+ (beginning-of-line)
+ (forward-char 1)
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (goto-char (point-min))
+ (while (< (1+ (point)) (point-max))
+ (goto-char (min (+ (point) 50000) (point-max)))
+ (search-forward "\^_" nil 'move)
+ (setq subfiles
+ (cons (list (+ start chars-deleted)
+ (concat (file-name-nondirectory filename)
+ (format "-%d" subfile-number)))
+ subfiles))
+ ;; Put a newline at end of split file, to make Unix happier.
+ (insert "\n")
+ (write-region (point-min) (point)
+ (concat filename (format "-%d" subfile-number)))
+ (delete-region (1- (point)) (point))
+ ;; Back up over the final ^_.
+ (forward-char -1)
+ (setq chars-deleted (+ chars-deleted (- (point) start)))
+ (delete-region start (point))
+ (setq subfile-number (1+ subfile-number))))
+ (while subfiles
+ (goto-char start)
+ (insert (nth 1 (car subfiles))
+ (format ": %d" (1- (car (car subfiles))))
+ "\n")
+ (setq subfiles (cdr subfiles)))
+ (goto-char start)
+ (insert "\^_\nIndirect:\n")
+ (search-forward "\nTag Table:\n")
+ (insert "(Indirect)\n")))
+
+;;;###autoload
+(defun Info-validate ()
+ "Check current buffer for validity as an Info file.
+Check that every node pointer points to an existing node."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (search-forward "\nTag table:\n(Indirect)\n" nil t)
+ (error "Don't yet know how to validate indirect info files: \"%s\""
+ (buffer-name (current-buffer))))
+ (goto-char (point-min))
+ (let ((allnodes '(("*")))
+ (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
+ (case-fold-search t)
+ (tags-losing nil)
+ (lossages ()))
+ (while (search-forward "\n\^_" nil t)
+ (forward-line 1)
+ (let ((beg (point)))
+ (forward-line 1)
+ (if (re-search-backward regexp beg t)
+ (let ((name (downcase
+ (buffer-substring-no-properties
+ (match-beginning 1)
+ (progn
+ (goto-char (match-end 1))
+ (skip-chars-backward " \t")
+ (point))))))
+ (if (assoc name allnodes)
+ (setq lossages
+ (cons (list name "Duplicate node-name" nil)
+ lossages))
+ (setq allnodes
+ (cons (list name
+ (progn
+ (end-of-line)
+ (and (re-search-backward
+ "prev[ious]*:" beg t)
+ (progn
+ (goto-char (match-end 0))
+ (downcase
+ (Info-following-node-name)))))
+ beg)
+ allnodes)))))))
+ (goto-char (point-min))
+ (while (search-forward "\n\^_" nil t)
+ (forward-line 1)
+ (let ((beg (point))
+ thisnode next)
+ (forward-line 1)
+ (if (re-search-backward regexp beg t)
+ (save-restriction
+ (search-forward "\n\^_" nil 'move)
+ (narrow-to-region beg (point))
+ (setq thisnode (downcase
+ (buffer-substring-no-properties
+ (match-beginning 1)
+ (progn
+ (goto-char (match-end 1))
+ (skip-chars-backward " \t")
+ (point)))))
+ (end-of-line)
+ (and (search-backward "next:" nil t)
+ (setq next (Info-validate-node-name "invalid Next"))
+ (assoc next allnodes)
+ (if (equal (car (cdr (assoc next allnodes)))
+ thisnode)
+ ;; allow multiple `next' pointers to one node
+ (let ((tem lossages))
+ (while tem
+ (if (and (equal (car (cdr (car tem)))
+ "should have Previous")
+ (equal (car (car tem))
+ next))
+ (setq lossages (delq (car tem) lossages)))
+ (setq tem (cdr tem))))
+ (setq lossages
+ (cons (list next
+ "should have Previous"
+ thisnode)
+ lossages))))
+ (end-of-line)
+ (if (re-search-backward "prev[ious]*:" nil t)
+ (Info-validate-node-name "invalid Previous"))
+ (end-of-line)
+ (if (search-backward "up:" nil t)
+ (Info-validate-node-name "invalid Up"))
+ (if (re-search-forward "\n* Menu:" nil t)
+ (while (re-search-forward "\n\\* " nil t)
+ (Info-validate-node-name
+ (concat "invalid menu item "
+ (buffer-substring (point)
+ (save-excursion
+ (skip-chars-forward "^:")
+ (point))))
+ (Info-extract-menu-node-name))))
+ (goto-char (point-min))
+ (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t)
+ (goto-char (+ (match-beginning 0) 5))
+ (skip-chars-forward " \n")
+ (Info-validate-node-name
+ (concat "invalid reference "
+ (buffer-substring (point)
+ (save-excursion
+ (skip-chars-forward "^:")
+ (point))))
+ (Info-extract-menu-node-name "Bad format cross-reference")))))))
+ (setq tags-losing (not (Info-validate-tags-table)))
+ (if (or lossages tags-losing)
+ (with-output-to-temp-buffer " *problems in info file*"
+ (while lossages
+ (princ "In node \"")
+ (princ (car (car lossages)))
+ (princ "\", ")
+ (let ((tem (nth 1 (car lossages))))
+ (cond ((string-match "\n" tem)
+ (princ (substring tem 0 (match-beginning 0)))
+ (princ "..."))
+ (t
+ (princ tem))))
+ (if (nth 2 (car lossages))
+ (progn
+ (princ ": ")
+ (let ((tem (nth 2 (car lossages))))
+ (cond ((string-match "\n" tem)
+ (princ (substring tem 0 (match-beginning 0)))
+ (princ "..."))
+ (t
+ (princ tem))))))
+ (terpri)
+ (setq lossages (cdr lossages)))
+ (if tags-losing (princ "\nTags table must be recomputed\n")))
+ ;; Here if info file is valid.
+ ;; If we already made a list of problems, clear it out.
+ (save-excursion
+ (if (get-buffer " *problems in info file*")
+ (progn
+ (set-buffer " *problems in info file*")
+ (kill-buffer (current-buffer)))))
+ (message "File appears valid"))))))
+
+(defun Info-validate-node-name (kind &optional name)
+ (if name
+ nil
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (if (= (following-char) ?\()
+ nil
+ (setq name
+ (buffer-substring-no-properties
+ (point)
+ (progn
+ (skip-chars-forward "^,\t\n")
+ (skip-chars-backward " ")
+ (point))))))
+ (if (null name)
+ nil
+ (setq name (downcase name))
+ (or (and (> (length name) 0) (= (aref name 0) ?\())
+ (assoc name allnodes)
+ (setq lossages
+ (cons (list thisnode kind name) lossages))))
+ name)
+
+(defun Info-validate-tags-table ()
+ (goto-char (point-min))
+ (if (not (search-forward "\^_\nEnd tag table\n" nil t))
+ t
+ (not (catch 'losing
+ (let* ((end (match-beginning 0))
+ (start (progn (search-backward "\nTag table:\n")
+ (1- (match-end 0))))
+ tem)
+ (setq tem allnodes)
+ (while tem
+ (goto-char start)
+ (or (equal (car (car tem)) "*")
+ (search-forward (concat "Node: "
+ (car (car tem))
+ "\177")
+ end t)
+ (throw 'losing 'x))
+ (setq tem (cdr tem)))
+ (goto-char (1+ start))
+ (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$")
+ (setq tem (downcase (buffer-substring-no-properties
+ (match-beginning 1)
+ (match-end 1))))
+ (setq tem (assoc tem allnodes))
+ (if (or (not tem)
+ (< 1000 (progn
+ (goto-char (match-beginning 2))
+ (setq tem (- (car (cdr (cdr tem)))
+ (read (current-buffer))))
+ (if (> tem 0) tem (- tem)))))
+ (throw 'losing 'y))
+ (forward-line 1)))
+ (if (looking-at "\^_\n")
+ (forward-line 1))
+ (or (looking-at "End tag table\n")
+ (throw 'losing 'z))
+ nil))))
+
+;;;###autoload
+(defun batch-info-validate ()
+ "Runs `Info-validate' on the files remaining on the command line.
+Must be used only with -batch, and kills Emacs on completion.
+Each file will be processed even if an error occurred previously.
+For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\""
+ (if (not noninteractive)
+ (error "batch-info-validate may only be used -batch."))
+ (let ((version-control t)
+ (auto-save-default nil)
+ (find-file-run-dired nil)
+ (kept-old-versions 259259)
+ (kept-new-versions 259259))
+ (let ((error 0)
+ file
+ (files ()))
+ (while command-line-args-left
+ (setq file (expand-file-name (car command-line-args-left)))
+ (cond ((not (file-exists-p file))
+ (message ">> %s does not exist!" file)
+ (setq error 1
+ command-line-args-left (cdr command-line-args-left)))
+ ((file-directory-p file)
+ (setq command-line-args-left (nconc (directory-files file)
+ (cdr command-line-args-left))))
+ (t
+ (setq files (cons file files)
+ command-line-args-left (cdr command-line-args-left)))))
+ (while files
+ (setq file (car files)
+ files (cdr files))
+ (let ((lose nil))
+ (condition-case err
+ (progn
+ (if buffer-file-name (kill-buffer (current-buffer)))
+ (find-file file)
+ (buffer-disable-undo (current-buffer))
+ (set-buffer-modified-p nil)
+ (fundamental-mode)
+ (let ((case-fold-search nil))
+ (goto-char (point-max))
+ (cond ((search-backward "\n\^_\^L\nTag table:\n" nil t)
+ (message "%s already tagified" file))
+ ((< (point-max) 30000)
+ (message "%s too small to bother tagifying" file))
+ (t
+ (Info-tagify))))
+ (let ((loss-name " *problems in info file*"))
+ (message "Checking validity of info file %s..." file)
+ (if (get-buffer loss-name)
+ (kill-buffer loss-name))
+ (Info-validate)
+ (if (not (get-buffer loss-name))
+ nil ;(message "Checking validity of info file %s... OK" file)
+ (message "----------------------------------------------------------------------")
+ (message ">> PROBLEMS IN INFO FILE %s" file)
+ (save-excursion
+ (set-buffer loss-name)
+ (princ (buffer-substring-no-properties
+ (point-min) (point-max))))
+ (message "----------------------------------------------------------------------")
+ (setq error 1 lose t)))
+ (if (and (buffer-modified-p)
+ (not lose))
+ (progn (message "Saving modified %s" file)
+ (save-buffer))))
+ (error (message ">> Error: %s" (prin1-to-string err))))))
+ (kill-emacs error))))
+
+;;; informat.el ends here
diff --git a/texinfo/emacs/makeinfo.el b/texinfo/emacs/makeinfo.el
new file mode 100644
index 00000000000..a649d522156
--- /dev/null
+++ b/texinfo/emacs/makeinfo.el
@@ -0,0 +1,247 @@
+;;; makeinfo.el --- run makeinfo conveniently
+
+;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.
+
+;; Author: Robert J. Chassell
+;; Maintainer: FSF
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 Emacs 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 Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; The Texinfo mode `makeinfo' related commands are:
+
+;; makeinfo-region to run makeinfo on the current region.
+;; makeinfo-buffer to run makeinfo on the current buffer, or
+;; with optional prefix arg, on current region
+;; kill-compilation to kill currently running makeinfo job
+;; makeinfo-recenter-makeinfo-buffer to redisplay *compilation* buffer
+
+;;; Keybindings (defined in `texinfo.el')
+
+;; makeinfo bindings
+; (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region)
+; (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer)
+; (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation)
+; (define-key texinfo-mode-map "\C-c\C-m\C-l"
+; 'makeinfo-recenter-compilation-buffer)
+
+;;; Code:
+
+;;; Variables used by `makeinfo'
+
+(require 'compile)
+
+(defvar makeinfo-run-command "makeinfo"
+ "*Command used to run `makeinfo' subjob.
+The name of the file is appended to this string, separated by a space.")
+
+(defvar makeinfo-options "--fill-column=70"
+ "*String containing options for running `makeinfo'.
+Do not include `--footnote-style' or `--paragraph-indent';
+the proper way to specify those is with the Texinfo commands
+`@footnotestyle` and `@paragraphindent'.")
+
+(require 'texinfo)
+
+(defvar makeinfo-compilation-process nil
+ "Process that runs `makeinfo'. Should start out nil.")
+
+(defvar makeinfo-temp-file nil
+ "Temporary file name used for text being sent as input to `makeinfo'.")
+
+(defvar makeinfo-output-file-name nil
+ "Info file name used for text output by `makeinfo'.")
+
+
+;;; The `makeinfo' function definitions
+
+(defun makeinfo-region (region-beginning region-end)
+ "Make Info file from region of current Texinfo file, and switch to it.
+
+This command does not offer the `next-error' feature since it would
+apply to a temporary file, not the original; use the `makeinfo-buffer'
+command to gain use of `next-error'."
+
+ (interactive "r")
+ (let (filename-or-header
+ filename-or-header-beginning
+ filename-or-header-end)
+ ;; Cannot use `let' for makeinfo-temp-file or
+ ;; makeinfo-output-file-name since `makeinfo-compilation-sentinel'
+ ;; needs them.
+
+ (setq makeinfo-temp-file
+ (concat
+ (make-temp-name
+ (substring (buffer-file-name)
+ 0
+ (or (string-match "\\.tex" (buffer-file-name))
+ (length (buffer-file-name)))))
+ ".texinfo"))
+
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((search-end (save-excursion (forward-line 100) (point))))
+ ;; Find and record the Info filename,
+ ;; or else explain that a filename is needed.
+ (if (re-search-forward
+ "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
+ search-end t)
+ (setq makeinfo-output-file-name
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (error
+ "The texinfo file needs a line saying: @setfilename <name>"))
+
+ ;; Find header and specify its beginning and end.
+ (goto-char (point-min))
+ (if (and
+ (prog1
+ (search-forward tex-start-of-header search-end t)
+ (beginning-of-line)
+ ;; Mark beginning of header.
+ (setq filename-or-header-beginning (point)))
+ (prog1
+ (search-forward tex-end-of-header nil t)
+ (beginning-of-line)
+ ;; Mark end of header
+ (setq filename-or-header-end (point))))
+
+ ;; Insert the header into the temporary file.
+ (write-region
+ (min filename-or-header-beginning region-beginning)
+ filename-or-header-end
+ makeinfo-temp-file nil nil)
+
+ ;; Else no header; insert @filename line into temporary file.
+ (goto-char (point-min))
+ (search-forward "@setfilename" search-end t)
+ (beginning-of-line)
+ (setq filename-or-header-beginning (point))
+ (forward-line 1)
+ (setq filename-or-header-end (point))
+ (write-region
+ (min filename-or-header-beginning region-beginning)
+ filename-or-header-end
+ makeinfo-temp-file nil nil))
+
+ ;; Insert the region into the file.
+ (write-region
+ (max region-beginning filename-or-header-end)
+ region-end
+ makeinfo-temp-file t nil)
+
+ ;; Run the `makeinfo-compile' command in the *compilation* buffer
+ (save-excursion
+ (makeinfo-compile
+ (concat makeinfo-run-command
+ " "
+ makeinfo-options
+ " "
+ makeinfo-temp-file)
+ "Use `makeinfo-buffer' to gain use of the `next-error' command"
+ nil)))))))
+
+;;; Actually run makeinfo. COMMAND is the command to run.
+;;; ERROR-MESSAGE is what to say when next-error can't find another error.
+;;; If PARSE-ERRORS is non-nil, do try to parse error messages.
+(defun makeinfo-compile (command error-message parse-errors)
+ (let ((buffer
+ (compile-internal command error-message nil
+ (and (not parse-errors)
+ ;; If we do want to parse errors, pass nil.
+ ;; Otherwise, use this function, which won't
+ ;; ever find any errors.
+ '(lambda (&rest ignore)
+ (setq compilation-error-list nil))))))
+ (set-process-sentinel (get-buffer-process buffer)
+ 'makeinfo-compilation-sentinel)))
+
+;; Delete makeinfo-temp-file after processing is finished,
+;; and visit Info file.
+;; This function is called when the compilation process changes state.
+;; Based on `compilation-sentinel' in compile.el
+(defun makeinfo-compilation-sentinel (proc msg)
+ (compilation-sentinel proc msg)
+ (if (and makeinfo-temp-file (file-exists-p makeinfo-temp-file))
+ (delete-file makeinfo-temp-file))
+ ;; Always use the version on disk.
+ (if (get-file-buffer makeinfo-output-file-name)
+ (progn (set-buffer makeinfo-output-file-name)
+ (revert-buffer t t))
+ (find-file makeinfo-output-file-name))
+ (goto-char (point-min)))
+
+(defun makeinfo-buffer ()
+ "Make Info file from current buffer.
+
+Use the \\[next-error] command to move to the next error
+\(if there are errors\)."
+
+ (interactive)
+ (cond ((null buffer-file-name)
+ (error "Buffer not visiting any file"))
+ ((buffer-modified-p)
+ (if (y-or-n-p "Buffer modified; do you want to save it? ")
+ (save-buffer))))
+
+ ;; Find and record the Info filename,
+ ;; or else explain that a filename is needed.
+ (save-excursion
+ (goto-char (point-min))
+ (let ((search-end (save-excursion (forward-line 100) (point))))
+ (if (re-search-forward
+ "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
+ search-end t)
+ (setq makeinfo-output-file-name
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (error
+ "The texinfo file needs a line saying: @setfilename <name>"))))
+
+ (save-excursion
+ (makeinfo-compile
+ (concat makeinfo-run-command " " makeinfo-options
+ " " buffer-file-name)
+ "No more errors."
+ t)))
+
+(defun makeinfo-recenter-compilation-buffer (linenum)
+ "Redisplay `*compilation*' buffer so most recent output can be seen.
+The last line of the buffer is displayed on
+line LINE of the window, or centered if LINE is nil."
+ (interactive "P")
+ (let ((makeinfo-buffer (get-buffer "*compilation*"))
+ (old-buffer (current-buffer)))
+ (if (null makeinfo-buffer)
+ (message "No *compilation* buffer")
+ (pop-to-buffer makeinfo-buffer)
+ (bury-buffer makeinfo-buffer)
+ (goto-char (point-max))
+ (recenter (if linenum
+ (prefix-numeric-value linenum)
+ (/ (window-height) 2)))
+ (pop-to-buffer old-buffer)
+ )))
+
+;;; Place `provide' at end of file.
+(provide 'makeinfo)
+
+;;; makeinfo.el ends here
+
diff --git a/texinfo/emacs/new-useful-setqs b/texinfo/emacs/new-useful-setqs
new file mode 100644
index 00000000000..4241ae429ef
--- /dev/null
+++ b/texinfo/emacs/new-useful-setqs
@@ -0,0 +1,180 @@
+;; -*- Mode: Emacs-Lisp -*-
+
+;; This is the `new-useful-setqs' file
+;; This overrides old defvars since they were revised.
+
+(setq texinfmt-version "2.35 of 10 September 1996")
+
+(setq texinfo-master-menu-header
+ "\n@detailmenu\n --- The Detailed Node Listing ---\n")
+
+(setq texinfo-environment-regexp
+ (concat
+ "^@"
+ "\\("
+ "cartouche\\|"
+ "display\\|"
+ "end\\|"
+ "enumerate\\|"
+ "example\\|"
+ "f?table\\|"
+ "flushleft\\|"
+ "flushright\\|"
+ "format\\|"
+ "group\\|"
+ "ifhtml\\|"
+ "ifinfo\\|"
+ "iftex\\|"
+ "ignore\\|"
+ "itemize\\|"
+ "lisp\\|"
+ "macro\\|"
+ "multitable\\|"
+ "quotation\\|"
+ "smallexample\\|"
+ "smalllisp\\|"
+ "tex"
+ "\\)")
+)
+
+(setq texinfo-no-refill-regexp
+ (concat
+ "^@"
+ "\\("
+ "example\\|"
+ "smallexample\\|"
+ "lisp\\|"
+ "smalllisp\\|"
+ "display\\|"
+ "format\\|"
+ "flushleft\\|"
+ "flushright\\|"
+ "menu\\|"
+ "multitable\\|"
+ "titlepage\\|"
+ "iftex\\|"
+ "ifhtml\\|"
+ "tex\\|"
+ "html"
+ "\\)"))
+
+
+(setq texinfo-accent-commands
+ (concat
+ "@OE\\|"
+ "@oe\\|"
+ "@AA\\|"
+ "@aa\\|"
+ "@AE\\|"
+ "@ae\\|"
+ "@ss\\|"
+ "@^\\|"
+ "@`\\|"
+ "@'\\|"
+ "@\"\\|"
+ "@,\\|"
+ "@=\\|"
+ "@~\\|"
+ "@questiondown{\\|"
+ "@exclamdown{\\|"
+ "@L{\\|"
+ "@l{\\|"
+ "@O{\\|"
+ "@o{\\|"
+ "@dotaccent{\\|"
+ "@ubaraccent{\\|"
+ "@d{\\|"
+ "@H{\\|"
+ "@ringaccent{\\|"
+ "@tieaccent{\\|"
+ "@u{\\|"
+ "@v{\\|"
+ "@dotless{"
+ ))
+
+(setq texinfo-part-of-para-regexp
+ (concat
+ "^@"
+ "\\("
+ "b{\\|"
+ "bullet{\\|"
+ "cite{\\|"
+ "code{\\|"
+ "emph{\\|"
+ "equiv{\\|"
+ "error{\\|"
+ "expansion{\\|"
+ "file{\\|"
+ "i{\\|"
+ "inforef{\\|"
+ "kbd{\\|"
+ "key{\\|"
+ "lisp{\\|"
+ "email{\\|"
+ "minus{\\|"
+ "point{\\|"
+ "print{\\|"
+ "pxref{\\|"
+ "r{\\|"
+ "ref{\\|"
+ "result{\\|"
+ "samp{\\|"
+ "sc{\\|"
+ "t{\\|"
+ "TeX{\\|"
+ "today{\\|"
+ "url{\\|"
+ "var{\\|"
+ "w{\\|"
+ "xref{\\|"
+ "@-\\|" ; @- is a descretionary hyphen (not an accent) (a noop).
+ texinfo-accent-commands
+ "\\)"
+ ))
+
+(setq texinfo-raisesections-alist
+ '((@chapter . @chapter) ; Cannot go higher
+ (@unnumbered . @unnumbered)
+ (@centerchap . @unnumbered)
+
+ (@majorheading . @majorheading)
+ (@chapheading . @chapheading)
+ (@appendix . @appendix)
+
+ (@section . @chapter)
+ (@unnumberedsec . @unnumbered)
+ (@heading . @chapheading)
+ (@appendixsec . @appendix)
+
+ (@subsection . @section)
+ (@unnumberedsubsec . @unnumberedsec)
+ (@subheading . @heading)
+ (@appendixsubsec . @appendixsec)
+
+ (@subsubsection . @subsection)
+ (@unnumberedsubsubsec . @unnumberedsubsec)
+ (@subsubheading . @subheading)
+ (@appendixsubsubsec . @appendixsubsec)))
+
+(setq texinfo-lowersections-alist
+ '((@chapter . @section)
+ (@unnumbered . @unnumberedsec)
+ (@centerchap . @unnumberedsec)
+ (@majorheading . @heading)
+ (@chapheading . @heading)
+ (@appendix . @appendixsec)
+
+ (@section . @subsection)
+ (@unnumberedsec . @unnumberedsubsec)
+ (@heading . @subheading)
+ (@appendixsec . @appendixsubsec)
+
+ (@subsection . @subsubsection)
+ (@unnumberedsubsec . @unnumberedsubsubsec)
+ (@subheading . @subsubheading)
+ (@appendixsubsec . @appendixsubsubsec)
+
+ (@subsubsection . @subsubsection) ; Cannot go lower.
+ (@unnumberedsubsubsec . @unnumberedsubsubsec)
+ (@subsubheading . @subsubheading)
+ (@appendixsubsubsec . @appendixsubsubsec)))
diff --git a/texinfo/emacs/texinfmt.el b/texinfo/emacs/texinfmt.el
new file mode 100644
index 00000000000..c0d09635a8d
--- /dev/null
+++ b/texinfo/emacs/texinfmt.el
@@ -0,0 +1,3979 @@
+;;; texinfmt.el --- format Texinfo files into Info files.
+
+;; Copyright (C) 1985, 1986, 1988, 1990, 1991,
+;; 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
+
+;; Author: Robert J. Chassell
+;; Date: 10 Sep 1996
+;; Maintainer: Robert J. Chassell <bug-texinfo@prep.ai.mit.edu>
+;; Keywords: maint, tex, docs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 Emacs 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 Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+;;; Emacs lisp functions to convert Texinfo files to Info files.
+
+(defvar texinfmt-version "2.35 of 10 September 1996")
+
+(defun texinfmt-version (&optional here)
+ "Show the version of texinfmt.el in the minibuffer.
+If optional argument HERE is non-nil, insert info at point."
+ (interactive "P")
+ (let ((version-string
+ (format "Version of \`texinfmt.el\': %s" texinfmt-version)))
+ (if here
+ (insert version-string)
+ (if (interactive-p)
+ (message "%s" version-string)
+ version-string))))
+
+
+;;; Variable definitions
+
+(require 'texinfo) ; So `texinfo-footnote-style' is defined.
+(require 'texnfo-upd) ; So `texinfo-section-types-regexp' is defined.
+
+(defvar texinfo-format-syntax-table nil)
+
+(defvar texinfo-vindex)
+(defvar texinfo-findex)
+(defvar texinfo-cindex)
+(defvar texinfo-pindex)
+(defvar texinfo-tindex)
+(defvar texinfo-kindex)
+(defvar texinfo-last-node)
+(defvar texinfo-node-names)
+(defvar texinfo-enclosure-list)
+(defvar texinfo-alias-list)
+
+(defvar texinfo-command-start)
+(defvar texinfo-command-end)
+(defvar texinfo-command-name)
+(defvar texinfo-defun-type)
+(defvar texinfo-last-node-pos)
+(defvar texinfo-stack)
+(defvar texinfo-short-index-cmds-alist)
+(defvar texinfo-short-index-format-cmds-alist)
+(defvar texinfo-format-filename)
+(defvar texinfo-footnote-number)
+(defvar texinfo-start-of-header)
+(defvar texinfo-end-of-header)
+(defvar texinfo-raisesections-alist)
+(defvar texinfo-lowersections-alist)
+
+;;; Syntax table
+
+(if texinfo-format-syntax-table
+ nil
+ (setq texinfo-format-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\" " " texinfo-format-syntax-table)
+ (modify-syntax-entry ?\\ " " texinfo-format-syntax-table)
+ (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table)
+ (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table)
+ (modify-syntax-entry ?\[ "." texinfo-format-syntax-table)
+ (modify-syntax-entry ?\] "." texinfo-format-syntax-table)
+ (modify-syntax-entry ?\( "." texinfo-format-syntax-table)
+ (modify-syntax-entry ?\) "." texinfo-format-syntax-table)
+ (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table)
+ (modify-syntax-entry ?} "){" texinfo-format-syntax-table)
+ (modify-syntax-entry ?\' "." texinfo-format-syntax-table))
+
+
+;;; Top level buffer and region formatting functions
+
+;;;###autoload
+(defun texinfo-format-buffer (&optional notagify)
+ "Process the current buffer as texinfo code, into an Info file.
+The Info file output is generated in a buffer visiting the Info file
+names specified in the @setfilename command.
+
+Non-nil argument (prefix, if interactive) means don't make tag table
+and don't split the file if large. You can use Info-tagify and
+Info-split to do these manually."
+ (interactive "P")
+ (let ((lastmessage "Formatting Info file..."))
+ (message lastmessage)
+ (texinfo-format-buffer-1)
+ (if notagify
+ nil
+ (if (> (buffer-size) 30000)
+ (progn
+ (message (setq lastmessage "Making tags table for Info file..."))
+ (Info-tagify)))
+ (if (> (buffer-size) 100000)
+ (progn
+ (message (setq lastmessage "Splitting Info file..."))
+ (Info-split))))
+ (message (concat lastmessage
+ (if (interactive-p) "done. Now save it." "done.")))))
+
+(defvar texinfo-region-buffer-name "*Info Region*"
+ "*Name of the temporary buffer used by \\[texinfo-format-region].")
+
+;;;###autoload
+(defun texinfo-format-region (region-beginning region-end)
+ "Convert the current region of the Texinfo file to Info format.
+This lets you see what that part of the file will look like in Info.
+The command is bound to \\[texinfo-format-region]. The text that is
+converted to Info is stored in a temporary buffer."
+ (interactive "r")
+ (message "Converting region to Info format...")
+ (let (texinfo-command-start
+ texinfo-command-end
+ texinfo-command-name
+ texinfo-vindex
+ texinfo-findex
+ texinfo-cindex
+ texinfo-pindex
+ texinfo-tindex
+ texinfo-kindex
+ texinfo-stack
+ (texinfo-format-filename "")
+ texinfo-example-start
+ texinfo-last-node-pos
+ texinfo-last-node
+ texinfo-node-names
+ (texinfo-footnote-number 0)
+ last-input-buffer
+ (fill-column-for-info fill-column)
+ (input-buffer (current-buffer))
+ (input-directory default-directory)
+ (header-text "")
+ (header-beginning 1)
+ (header-end 1))
+
+;;; Copy lines between beginning and end of header lines,
+;;; if any, or else copy the `@setfilename' line, if any.
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((search-end (save-excursion (forward-line 100) (point))))
+ (if (or
+ ;; Either copy header text.
+ (and
+ (prog1
+ (search-forward tex-start-of-header search-end t)
+ (forward-line 1)
+ ;; Mark beginning of header.
+ (setq header-beginning (point)))
+ (prog1
+ (search-forward tex-end-of-header nil t)
+ (beginning-of-line)
+ ;; Mark end of header
+ (setq header-end (point))))
+ ;; Or copy @filename line.
+ (prog2
+ (goto-char (point-min))
+ (search-forward "@setfilename" search-end t)
+ (beginning-of-line)
+ (setq header-beginning (point))
+ (forward-line 1)
+ (setq header-end (point))))
+
+ ;; Copy header
+ (setq header-text
+ (buffer-substring
+ (min header-beginning region-beginning)
+ header-end))))))
+
+;;; Find a buffer to use.
+ (switch-to-buffer (get-buffer-create texinfo-region-buffer-name))
+ (erase-buffer)
+ ;; Insert the header into the buffer.
+ (insert header-text)
+ ;; Insert the region into the buffer.
+ (insert-buffer-substring
+ input-buffer
+ (max region-beginning header-end)
+ region-end)
+ ;; Make sure region ends in a newline.
+ (or (= (preceding-char) ?\n)
+ (insert "\n"))
+
+ (goto-char (point-min))
+ (texinfo-mode)
+ (message "Converting region to Info format...")
+ (setq fill-column fill-column-for-info)
+ ;; Install a syntax table useful for scanning command operands.
+ (set-syntax-table texinfo-format-syntax-table)
+
+ ;; Insert @include files so `texinfo-raise-lower-sections' can
+ ;; work on them without losing track of multiple
+ ;; @raise/@lowersections commands.
+ (while (re-search-forward "^@include" nil t)
+ (setq texinfo-command-end (point))
+ (let ((filename (concat input-directory
+ (texinfo-parse-line-arg))))
+ (re-search-backward "^@include")
+ (delete-region (point) (save-excursion (forward-line 1) (point)))
+ (message "Reading included file: %s" filename)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (+ (point) (car (cdr (insert-file-contents filename)))))
+ (goto-char (point-min))
+ ;; Remove `@setfilename' line from included file, if any,
+ ;; so @setfilename command not duplicated.
+ (if (re-search-forward
+ "^@setfilename" (save-excursion (forward-line 100) (point)) t)
+ (progn
+ (beginning-of-line)
+ (delete-region
+ (point) (save-excursion (forward-line 1) (point)))))))))
+
+ ;; Raise or lower level of each section, if necessary.
+ (goto-char (point-min))
+ (texinfo-raise-lower-sections)
+ ;; Append @refill to appropriate paragraphs for filling.
+ (goto-char (point-min))
+ (texinfo-append-refill)
+ ;; If the region includes the effective end of the data,
+ ;; discard everything after that.
+ (goto-char (point-max))
+ (if (re-search-backward "^@bye" nil t)
+ (delete-region (point) (point-max)))
+ ;; Make sure buffer ends in a newline.
+ (or (= (preceding-char) ?\n)
+ (insert "\n"))
+ ;; Don't use a previous value of texinfo-enclosure-list.
+ (setq texinfo-enclosure-list nil)
+ (setq texinfo-alias-list nil)
+
+ (goto-char (point-min))
+ (if (looking-at "\\\\input[ \t]+texinfo")
+ (delete-region (point) (save-excursion (forward-line 1) (point))))
+
+ ;; Insert Info region title text.
+ (goto-char (point-min))
+ (if (search-forward
+ "@setfilename" (save-excursion (forward-line 100) (point)) t)
+ (progn
+ (setq texinfo-command-end (point))
+ (beginning-of-line)
+ (setq texinfo-command-start (point))
+ (let ((arg (texinfo-parse-arg-discard)))
+ (insert " "
+ texinfo-region-buffer-name
+ " buffer for: `")
+ (insert (file-name-nondirectory (expand-file-name arg)))
+ (insert "', -*-Text-*-\n")))
+ ;; Else no `@setfilename' line
+ (insert " "
+ texinfo-region-buffer-name
+ " buffer -*-Text-*-\n"))
+ (insert "produced by `texinfo-format-region'\n"
+ "from a region in: "
+ (if (buffer-file-name input-buffer)
+ (concat "`"
+ (file-name-sans-versions
+ (file-name-nondirectory
+ (buffer-file-name input-buffer)))
+ "'")
+ (concat "buffer `" (buffer-name input-buffer) "'"))
+ "\nusing `texinfmt.el' version "
+ texinfmt-version
+ ".\n\n")
+
+ ;; Now convert for real.
+ (goto-char (point-min))
+ (texinfo-format-scan)
+ (goto-char (point-min))
+
+ (message "Done.")))
+
+
+;;; Primary internal formatting function for the whole buffer.
+
+(defun texinfo-format-buffer-1 ()
+ (let (texinfo-format-filename
+ texinfo-example-start
+ texinfo-command-start
+ texinfo-command-end
+ texinfo-command-name
+ texinfo-last-node
+ texinfo-last-node-pos
+ texinfo-vindex
+ texinfo-findex
+ texinfo-cindex
+ texinfo-pindex
+ texinfo-tindex
+ texinfo-kindex
+ texinfo-stack
+ texinfo-node-names
+ (texinfo-footnote-number 0)
+ last-input-buffer
+ outfile
+ (fill-column-for-info fill-column)
+ (input-buffer (current-buffer))
+ (input-directory default-directory))
+ (setq texinfo-enclosure-list nil)
+ (setq texinfo-alias-list nil)
+ (save-excursion
+ (goto-char (point-min))
+ (or (search-forward "@setfilename" nil t)
+ (error "Texinfo file needs an `@setfilename FILENAME' line."))
+ (setq texinfo-command-end (point))
+ (setq outfile (texinfo-parse-line-arg)))
+ (find-file outfile)
+ (texinfo-mode)
+ (setq fill-column fill-column-for-info)
+ (set-syntax-table texinfo-format-syntax-table)
+ (erase-buffer)
+ (insert-buffer-substring input-buffer)
+ (message "Converting %s to Info format..." (buffer-name input-buffer))
+
+ ;; Insert @include files so `texinfo-raise-lower-sections' can
+ ;; work on them without losing track of multiple
+ ;; @raise/@lowersections commands.
+ (goto-char (point-min))
+ (while (re-search-forward "^@include" nil t)
+ (setq texinfo-command-end (point))
+ (let ((filename (concat input-directory
+ (texinfo-parse-line-arg))))
+ (re-search-backward "^@include")
+ (delete-region (point) (save-excursion (forward-line 1) (point)))
+ (message "Reading included file: %s" filename)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (+ (point) (car (cdr (insert-file-contents filename)))))
+ (goto-char (point-min))
+ ;; Remove `@setfilename' line from included file, if any,
+ ;; so @setfilename command not duplicated.
+ (if (re-search-forward
+ "^@setfilename"
+ (save-excursion (forward-line 100) (point)) t)
+ (progn
+ (beginning-of-line)
+ (delete-region
+ (point) (save-excursion (forward-line 1) (point)))))))))
+ ;; Raise or lower level of each section, if necessary.
+ (goto-char (point-min))
+ (texinfo-raise-lower-sections)
+ ;; Append @refill to appropriate paragraphs
+ (goto-char (point-min))
+ (texinfo-append-refill)
+ (goto-char (point-min))
+ (search-forward "@setfilename")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ ;; Remove @bye at end of file, if it is there.
+ (goto-char (point-max))
+ (if (search-backward "@bye" nil t)
+ (delete-region (point) (point-max)))
+ ;; Make sure buffer ends in a newline.
+ (or (= (preceding-char) ?\n)
+ (insert "\n"))
+ ;; Scan the whole buffer, converting to Info format.
+ (texinfo-format-scan)
+ ;; Return data for indices.
+ (goto-char (point-min))
+ (list outfile
+ texinfo-vindex texinfo-findex texinfo-cindex
+ texinfo-pindex texinfo-tindex texinfo-kindex)))
+
+
+;;; Perform non-@-command file conversions: quotes and hyphens
+
+(defun texinfo-format-convert (min max)
+ ;; Convert left and right quotes to typewriter font quotes.
+ (goto-char min)
+ (while (search-forward "``" max t)
+ (replace-match "\""))
+ (goto-char min)
+ (while (search-forward "''" max t)
+ (replace-match "\""))
+ ;; Convert three hyphens in a row to two.
+ (goto-char min)
+ (while (re-search-forward "\\( \\|\\w\\)\\(---\\)\\( \\|\\w\\)" max t)
+ (delete-region (1+ (match-beginning 2)) (+ 2 (match-beginning
+ 2)))))
+
+
+;;; Handle paragraph filling
+
+;; Keep as concatinated lists for ease of maintenance
+
+(defvar texinfo-no-refill-regexp
+ (concat
+ "^@"
+ "\\("
+ "example\\|"
+ "smallexample\\|"
+ "lisp\\|"
+ "smalllisp\\|"
+ "display\\|"
+ "format\\|"
+ "flushleft\\|"
+ "flushright\\|"
+ "menu\\|"
+ "multitable\\|"
+ "titlepage\\|"
+ "iftex\\|"
+ "ifhtml\\|"
+ "tex\\|"
+ "html"
+ "\\)")
+ "Regexp specifying environments in which paragraphs are not filled.")
+
+(defvar texinfo-accent-commands
+ (concat
+ "@^\\|"
+ "@`\\|"
+ "@'\\|"
+ "@\"\\|"
+ "@,\\|"
+ "@=\\|"
+ "@~\\|"
+ "@OE{\\|"
+ "@oe{\\|"
+ "@AA{\\|"
+ "@aa{\\|"
+ "@AE{\\|"
+ "@ae{\\|"
+ "@ss{\\|"
+ "@questiondown{\\|"
+ "@exclamdown{\\|"
+ "@L{\\|"
+ "@l{\\|"
+ "@O{\\|"
+ "@o{\\|"
+ "@dotaccent{\\|"
+ "@ubaraccent{\\|"
+ "@d{\\|"
+ "@H{\\|"
+ "@ringaccent{\\|"
+ "@tieaccent{\\|"
+ "@u{\\|"
+ "@v{\\|"
+ "@dotless{"
+ ))
+
+(defvar texinfo-part-of-para-regexp
+ (concat
+ "^@"
+ "\\("
+ "b{\\|"
+ "bullet{\\|"
+ "cite{\\|"
+ "code{\\|"
+ "emph{\\|"
+ "equiv{\\|"
+ "error{\\|"
+ "expansion{\\|"
+ "file{\\|"
+ "i{\\|"
+ "inforef{\\|"
+ "kbd{\\|"
+ "key{\\|"
+ "lisp{\\|"
+ "email{\\|"
+ "minus{\\|"
+ "point{\\|"
+ "print{\\|"
+ "pxref{\\|"
+ "r{\\|"
+ "ref{\\|"
+ "result{\\|"
+ "samp{\\|"
+ "sc{\\|"
+ "t{\\|"
+ "TeX{\\|"
+ "today{\\|"
+ "url{\\|"
+ "var{\\|"
+ "w{\\|"
+ "xref{\\|"
+ "@-\\|" ; @- is a descretionary hyphen (not an accent) (a noop).
+ texinfo-accent-commands
+ "\\)"
+ )
+ "Regexp specifying @-commands found within paragraphs.")
+
+(defun texinfo-append-refill ()
+ "Append @refill at end of each paragraph that should be filled.
+Do not append @refill to paragraphs within @example and similar environments.
+Do not append @refill to paragraphs containing @w{TEXT} or @*."
+
+ ;; It is necessary to append @refill before other processing because
+ ;; the other processing removes information that tells Texinfo
+ ;; whether the text should or should not be filled.
+
+ (while (< (point) (point-max))
+ (let ((refill-blank-lines "^[ \t\n]*$")
+ (case-fold-search nil)) ; Don't confuse @TeX and @tex....
+ (beginning-of-line)
+ ;; 1. Skip over blank lines;
+ ;; skip over lines beginning with @-commands,
+ ;; but do not skip over lines
+ ;; that are no-refill environments such as @example or
+ ;; that begin with within-paragraph @-commands such as @code.
+ (while (and (looking-at (concat "^@\\|^\\\\\\|" refill-blank-lines))
+ (not (looking-at
+ (concat
+ "\\("
+ texinfo-no-refill-regexp
+ "\\|"
+ texinfo-part-of-para-regexp
+ "\\)")))
+ (< (point) (point-max)))
+ (forward-line 1))
+ ;; 2. Skip over @example and similar no-refill environments.
+ (if (looking-at texinfo-no-refill-regexp)
+ (let ((environment
+ (buffer-substring (match-beginning 1) (match-end 1))))
+ (progn (re-search-forward (concat "^@end " environment) nil t)
+ (forward-line 1)))
+ ;; Else
+ ;; 3. Do not refill a paragraph containing @w or @*, or ending
+ ;; with @<newline> followed by a newline.
+ (if (or
+ (>= (point) (point-max))
+ (re-search-forward
+ "@w{\\|@\\*\\|@\n\n"
+ (save-excursion
+ (forward-paragraph)
+ (forward-line 1)
+ (point)) t))
+ ;; Go to end of paragraph and do nothing.
+ (forward-paragraph)
+ ;; 4. Else go to end of paragraph and insert @refill
+ (forward-paragraph)
+ (forward-line -1)
+ (end-of-line)
+ (delete-region
+ (point)
+ (save-excursion (skip-chars-backward " \t") (point)))
+ ;; `looking-at-backward' not available in v. 18.57
+ ;; (if (not (looking-at-backward "@refill\\|@bye")) ;)
+ (if (not (re-search-backward
+ "@refill\\|@bye"
+ (save-excursion (beginning-of-line) (point))
+ t))
+ (insert "@refill"))
+ (forward-line 1))))))
+
+
+;;; Handle `@raisesections' and `@lowersections' commands
+
+;; These commands change the hierarchical level of chapter structuring
+;; commands.
+;;
+;; @raisesections changes @subsection to @section,
+;; @section to @chapter,
+;; etc.
+;;
+;; @lowersections changes @chapter to @section
+;; @subsection to @subsubsection,
+;; etc.
+;;
+;; An @raisesections/@lowersections command changes only those
+;; structuring commands that follow the @raisesections/@lowersections
+;; command.
+;;
+;; Repeated @raisesections/@lowersections continue to raise or lower
+;; the heading level.
+;;
+;; An @lowersections command cancels an @raisesections command, and
+;; vice versa.
+;;
+;; You cannot raise or lower "beyond" chapters or subsubsections, but
+;; trying to do so does not elicit an error---you just get more
+;; headings that mean the same thing as you keep raising or lowering
+;; (for example, after a single @raisesections, both @chapter and
+;; @section produce chapter headings).
+
+(defun texinfo-raise-lower-sections ()
+ "Raise or lower the hierarchical level of chapters, sections, etc.
+
+This function acts according to `@raisesections' and `@lowersections'
+commands in the Texinfo file.
+
+For example, an `@lowersections' command is useful if you wish to
+include what is written as an outer or standalone Texinfo file in
+another Texinfo file as an inner, included file. The `@lowersections'
+command changes chapters to sections, sections to subsections and so
+on.
+
+@raisesections changes @subsection to @section,
+ @section to @chapter,
+ @heading to @chapheading,
+ etc.
+
+@lowersections changes @chapter to @section,
+ @subsection to @subsubsection,
+ @heading to @subheading,
+ etc.
+
+An `@raisesections' or `@lowersections' command changes only those
+structuring commands that follow the `@raisesections' or
+`@lowersections' command.
+
+An `@lowersections' command cancels an `@raisesections' command, and
+vice versa.
+
+Repeated use of the commands continue to raise or lower the hierarchical
+level a step at a time.
+
+An attempt to raise above `chapters' reproduces chapter commands; an
+attempt to lower below subsubsections reproduces subsubsection
+commands."
+
+ ;; `texinfo-section-types-regexp' is defined in `texnfo-upd.el';
+ ;; it is a regexp matching chapter, section, other headings
+ ;; (but not the top node).
+
+ (let (type (level 0))
+ (while
+ (re-search-forward
+ (concat
+ "\\(\\(^@\\(raise\\|lower\\)sections\\)\\|\\("
+ texinfo-section-types-regexp
+ "\\)\\)")
+ nil t)
+ (beginning-of-line)
+ (save-excursion (setq type (read (current-buffer))))
+ (cond
+
+ ;; 1. Increment level
+ ((eq type '@raisesections)
+ (setq level (1+ level))
+ (delete-region
+ (point) (save-excursion (forward-line 1) (point))))
+
+ ;; 2. Decrement level
+ ((eq type '@lowersections)
+ (setq level (1- level))
+ (delete-region
+ (point) (save-excursion (forward-line 1) (point))))
+
+ ;; Now handle structuring commands
+ ((cond
+
+ ;; 3. Raise level when positive
+ ((> level 0)
+ (let ((count level)
+ (new-level type))
+ (while (> count 0)
+ (setq new-level
+ (cdr (assq new-level texinfo-raisesections-alist)))
+ (setq count (1- count)))
+ (kill-word 1)
+ (insert (symbol-name new-level))))
+
+ ;; 4. Do nothing except move point when level is zero
+ ((= level 0) (forward-line 1))
+
+ ;; 5. Lower level when positive
+ ((< level 0)
+ (let ((count level)
+ (new-level type))
+ (while (< count 0)
+ (setq new-level
+ (cdr (assq new-level texinfo-lowersections-alist)))
+ (setq count (1+ count)))
+ (kill-word 1)
+ (insert (symbol-name new-level))))))))))
+
+(defvar texinfo-raisesections-alist
+ '((@chapter . @chapter) ; Cannot go higher
+ (@unnumbered . @unnumbered)
+ (@centerchap . @unnumbered)
+
+ (@majorheading . @majorheading)
+ (@chapheading . @chapheading)
+ (@appendix . @appendix)
+
+ (@section . @chapter)
+ (@unnumberedsec . @unnumbered)
+ (@heading . @chapheading)
+ (@appendixsec . @appendix)
+
+ (@subsection . @section)
+ (@unnumberedsubsec . @unnumberedsec)
+ (@subheading . @heading)
+ (@appendixsubsec . @appendixsec)
+
+ (@subsubsection . @subsection)
+ (@unnumberedsubsubsec . @unnumberedsubsec)
+ (@subsubheading . @subheading)
+ (@appendixsubsubsec . @appendixsubsec))
+ "*An alist of next higher levels for chapters, sections. etc.
+For example, section to chapter, subsection to section.
+Used by `texinfo-raise-lower-sections'.
+The keys specify types of section; the values correspond to the next
+higher types.")
+
+(defvar texinfo-lowersections-alist
+ '((@chapter . @section)
+ (@unnumbered . @unnumberedsec)
+ (@centerchap . @unnumberedsec)
+ (@majorheading . @heading)
+ (@chapheading . @heading)
+ (@appendix . @appendixsec)
+
+ (@section . @subsection)
+ (@unnumberedsec . @unnumberedsubsec)
+ (@heading . @subheading)
+ (@appendixsec . @appendixsubsec)
+
+ (@subsection . @subsubsection)
+ (@unnumberedsubsec . @unnumberedsubsubsec)
+ (@subheading . @subsubheading)
+ (@appendixsubsec . @appendixsubsubsec)
+
+ (@subsubsection . @subsubsection) ; Cannot go lower.
+ (@unnumberedsubsubsec . @unnumberedsubsubsec)
+ (@subsubheading . @subsubheading)
+ (@appendixsubsubsec . @appendixsubsubsec))
+ "*An alist of next lower levels for chapters, sections. etc.
+For example, chapter to section, section to subsection.
+Used by `texinfo-raise-lower-sections'.
+The keys specify types of section; the values correspond to the next
+lower types.")
+
+
+;;; Perform those texinfo-to-info conversions that apply to the whole input
+;;; uniformly.
+
+(defun texinfo-format-scan ()
+ (texinfo-format-convert (point-min) (point-max))
+ ;; Scan for @-commands.
+ (goto-char (point-min))
+ (while (search-forward "@" nil t)
+ ;;
+ ;; These are the single-character accent commands: @^ @` @' @" @= @~
+ ;; In Info, they are simply quoted and the @ deleted.
+ ;; Other single-character commands:
+ ;; @* forces a line break,
+ ;; @- is a discretionary hyphenation point; does nothing in Info.
+ ;; @<space>, @<tab>, @<newline> each produce a single space,
+ ;; unless followed by a newline.
+ ;;
+ ;; Old version 2.34 expression: (looking-at "[@{}^'` *\"?!]")
+ (if (looking-at "[@{}^'`\"=~ \t\n*?!-]")
+ ;; @*, causes a line break.
+ (cond
+ ;; @*, a line break
+ ((= (following-char) ?*)
+ ;; remove command
+ (delete-region (1- (point)) (1+ (point)))
+ ;; insert return if not at end of line;
+ ;; else line is already broken.
+ (if (not (= (following-char) ?\n))
+ (insert ?\n)))
+ ;; @-, deleted
+ ((= (following-char) ?-)
+ (delete-region (1- (point)) (1+ (point))))
+ ;; @<space>, @<tab>, @<newline>: produce a single space,
+ ;; unless followed by a newline.
+ ((= (following-char) ? )
+ (delete-region (1- (point)) (1+ (point)))
+ ;; insert single space if not at end of line;
+ ;; else line is already broken.
+ (if (not (= (following-char) ?\n))
+ (insert ? )))
+ ((= (following-char) ?\t)
+ (delete-region (1- (point)) (1+ (point)))
+ ;; insert single space if not at end of line;
+ ;; else line is already broken.
+ (if (not (= (following-char) ?\n))
+ (insert ? )))
+ ;; following char is a carriage return
+ ((= (following-char) ?
+)
+ ;; remove command
+ (delete-region (1- (point)) (1+ (point)))
+ ;; insert single space if not at end of line;
+ ;; else line is already broken.
+ (if (not (= (following-char) ?\n))
+ (insert ? )))
+ ;; Otherwise: the other characters are simply quoted. Delete the @.
+ (t
+ (delete-char -1)
+ (forward-char 1)))
+ ;; @ is followed by a command-word; find the end of the word.
+ (setq texinfo-command-start (1- (point)))
+ (if (= (char-syntax (following-char)) ?w)
+ (forward-word 1)
+ (forward-char 1))
+ (setq texinfo-command-end (point))
+ ;; Handle let aliasing
+ (setq texinfo-command-name
+ (let (trial
+ (cmdname
+ (buffer-substring
+ (1+ texinfo-command-start) texinfo-command-end)))
+ (while (setq trial (assoc cmdname texinfo-alias-list))
+ (setq cmdname (cdr trial)))
+ (intern cmdname)))
+ ;; Call the handler for this command.
+ (let ((enclosure-type
+ (assoc
+ (symbol-name texinfo-command-name)
+ texinfo-enclosure-list)))
+ (if enclosure-type
+ (progn
+ (insert
+ (car (car (cdr enclosure-type)))
+ (texinfo-parse-arg-discard)
+ (car (cdr (car (cdr enclosure-type)))))
+ (goto-char texinfo-command-start))
+ (let ((cmd (get texinfo-command-name 'texinfo-format)))
+ (if cmd (funcall cmd) (texinfo-unsupported)))))))
+
+ (cond (texinfo-stack
+ (goto-char (nth 2 (car texinfo-stack)))
+ (error "Unterminated @%s" (car (car texinfo-stack))))))
+
+(put 'begin 'texinfo-format 'texinfo-format-begin)
+(defun texinfo-format-begin ()
+ (texinfo-format-begin-end 'texinfo-format))
+
+(put 'end 'texinfo-format 'texinfo-format-end)
+(defun texinfo-format-end ()
+ (texinfo-format-begin-end 'texinfo-end))
+
+(defun texinfo-format-begin-end (prop)
+ (setq texinfo-command-name (intern (texinfo-parse-line-arg)))
+ (let ((cmd (get texinfo-command-name prop)))
+ (if cmd (funcall cmd)
+ (texinfo-unsupported))))
+
+;;; Parsing functions
+
+(defun texinfo-parse-line-arg ()
+ "Return argument of @-command as string.
+Argument is separated from command either by a space or by a brace.
+If a space, return rest of line, with beginning and ending white
+space removed. If a brace, return string between braces.
+Leave point after argument."
+ (goto-char texinfo-command-end)
+ (let ((start (point)))
+ (cond ((looking-at " ")
+ (skip-chars-forward " ")
+ (setq start (point))
+ (end-of-line)
+ (skip-chars-backward " ")
+ (delete-region (point) (progn (end-of-line) (point)))
+ (setq texinfo-command-end (1+ (point))))
+ ((looking-at "{")
+ (setq start (1+ (point)))
+ (forward-list 1)
+ (setq texinfo-command-end (point))
+ (forward-char -1))
+ (t
+ (error "Invalid texinfo command arg format")))
+ (prog1 (buffer-substring start (point))
+ (if (eolp) (forward-char 1)))))
+
+(defun texinfo-parse-expanded-arg ()
+ (goto-char texinfo-command-end)
+ (let ((start (point))
+ marker)
+ (cond ((looking-at " ")
+ (skip-chars-forward " ")
+ (setq start (point))
+ (end-of-line)
+ (setq texinfo-command-end (1+ (point))))
+ ((looking-at "{")
+ (setq start (1+ (point)))
+ (forward-list 1)
+ (setq texinfo-command-end (point))
+ (forward-char -1))
+ (t
+ (error "Invalid texinfo command arg format")))
+ (setq marker (move-marker (make-marker) texinfo-command-end))
+ (texinfo-format-expand-region start (point))
+ (setq texinfo-command-end (marker-position marker))
+ (move-marker marker nil)
+ (prog1 (buffer-substring start (point))
+ (if (eolp) (forward-char 1)))))
+
+(defun texinfo-format-expand-region (start end)
+ (save-restriction
+ (narrow-to-region start end)
+ (let (texinfo-command-start
+ texinfo-command-end
+ texinfo-command-name
+ texinfo-stack)
+ (texinfo-format-scan))
+ (goto-char (point-max))))
+
+(defun texinfo-parse-arg-discard ()
+ "Delete command and argument; return argument of command."
+ (prog1 (texinfo-parse-line-arg)
+ (texinfo-discard-command)))
+
+(defun texinfo-discard-command ()
+ (delete-region texinfo-command-start texinfo-command-end))
+
+(defun texinfo-optional-braces-discard ()
+ "Discard braces following command, if any."
+ (goto-char texinfo-command-end)
+ (let ((start (point)))
+ (cond ((looking-at "[ \t]*\n")) ; do nothing
+ ((looking-at "{") ; remove braces, if any
+ (forward-list 1)
+ (setq texinfo-command-end (point)))
+ (t
+ (error
+ "Invalid `texinfo-optional-braces-discard' format \(need braces?\)")))
+ (delete-region texinfo-command-start texinfo-command-end)))
+
+(defun texinfo-format-parse-line-args ()
+ (let ((start (1- (point)))
+ next beg end
+ args)
+ (skip-chars-forward " ")
+ (while (not (eolp))
+ (setq beg (point))
+ (re-search-forward "[\n,]")
+ (setq next (point))
+ (if (bolp) (setq next (1- next)))
+ (forward-char -1)
+ (skip-chars-backward " ")
+ (setq end (point))
+ (setq args (cons (if (> end beg) (buffer-substring beg end))
+ args))
+ (goto-char next)
+ (skip-chars-forward " "))
+ (if (eolp) (forward-char 1))
+ (setq texinfo-command-end (point))
+ (nreverse args)))
+
+(defun texinfo-format-parse-args ()
+ (let ((start (1- (point)))
+ next beg end
+ args)
+ (search-forward "{")
+ (save-excursion
+ (texinfo-format-expand-region
+ (point)
+ (save-excursion (up-list 1) (1- (point)))))
+ ;; The following does not handle cross references of the form:
+ ;; `@xref{bullet, , @code{@@bullet}@{@}}.' because the
+ ;; re-search-forward finds the first right brace after the second
+ ;; comma.
+ (while (/= (preceding-char) ?\})
+ (skip-chars-forward " \t\n")
+ (setq beg (point))
+ (re-search-forward "[},]")
+ (setq next (point))
+ (forward-char -1)
+ (skip-chars-backward " \t\n")
+ (setq end (point))
+ (cond ((< beg end)
+ (goto-char beg)
+ (while (search-forward "\n" end t)
+ (replace-match " "))))
+ (setq args (cons (if (> end beg) (buffer-substring beg end))
+ args))
+ (goto-char next))
+ (if (eolp) (forward-char 1))
+ (setq texinfo-command-end (point))
+ (nreverse args)))
+
+(defun texinfo-format-parse-defun-args ()
+ (goto-char texinfo-command-end)
+ (let ((start (point)))
+ (end-of-line)
+ (setq texinfo-command-end (1+ (point)))
+ (let ((marker (move-marker (make-marker) texinfo-command-end)))
+ (texinfo-format-expand-region start (point))
+ (setq texinfo-command-end (marker-position marker))
+ (move-marker marker nil))
+ (goto-char start)
+ (let ((args '())
+ beg end)
+ (skip-chars-forward " ")
+ (while (not (eolp))
+ (cond ((looking-at "{")
+ (setq beg (1+ (point)))
+ (forward-list 1)
+ (setq end (1- (point))))
+ (t
+ (setq beg (point))
+ (re-search-forward "[\n ]")
+ (forward-char -1)
+ (setq end (point))))
+ (setq args (cons (buffer-substring beg end) args))
+ (skip-chars-forward " "))
+ (forward-char 1)
+ (nreverse args))))
+
+(defun texinfo-discard-line ()
+ (goto-char texinfo-command-end)
+ (skip-chars-forward " \t")
+ (or (eolp)
+ (error "Extraneous text at end of command line."))
+ (goto-char texinfo-command-start)
+ (or (bolp)
+ (error "Extraneous text at beginning of command line."))
+ (delete-region (point) (progn (forward-line 1) (point))))
+
+(defun texinfo-discard-line-with-args ()
+ (goto-char texinfo-command-start)
+ (delete-region (point) (progn (forward-line 1) (point))))
+
+
+;;; @setfilename
+
+;; Only `texinfo-format-buffer' handles @setfilename with this
+;; definition; `texinfo-format-region' handles @setfilename, if any,
+;; specially.
+(put 'setfilename 'texinfo-format 'texinfo-format-setfilename)
+(defun texinfo-format-setfilename ()
+ (let ((arg (texinfo-parse-arg-discard)))
+ (message "Formatting Info file: %s" arg)
+ (setq texinfo-format-filename
+ (file-name-nondirectory (expand-file-name arg)))
+ (insert "Info file: "
+ texinfo-format-filename ", -*-Text-*-\n"
+ ;; Date string removed so that regression testing is easier.
+ ;; "produced on "
+ ;; (substring (current-time-string) 8 10) " "
+ ;; (substring (current-time-string) 4 7) " "
+ ;; (substring (current-time-string) -4) " "
+ "produced by `texinfo-format-buffer'\n"
+ "from file"
+ (if (buffer-file-name input-buffer)
+ (concat " `"
+ (file-name-sans-versions
+ (file-name-nondirectory
+ (buffer-file-name input-buffer)))
+ "'")
+ (concat "buffer `" (buffer-name input-buffer) "'"))
+ "\nusing `texinfmt.el' version "
+ texinfmt-version
+ ".\n\n")))
+
+;;; @node, @menu, @detailmenu
+
+(put 'node 'texinfo-format 'texinfo-format-node)
+(put 'nwnode 'texinfo-format 'texinfo-format-node)
+(defun texinfo-format-node ()
+ (let* ((args (texinfo-format-parse-line-args))
+ (name (nth 0 args))
+ (next (nth 1 args))
+ (prev (nth 2 args))
+ (up (nth 3 args)))
+ (texinfo-discard-command)
+ (setq texinfo-last-node name)
+ (let ((tem (downcase name)))
+ (if (assoc tem texinfo-node-names)
+ (error "Duplicate node name: %s" name)
+ (setq texinfo-node-names (cons (list tem) texinfo-node-names))))
+ (setq texinfo-footnote-number 0)
+ ;; insert "\n\^_" unconditionally since this is what info is looking for
+ (insert "\n\^_\nFile: " texinfo-format-filename
+ ", Node: " name)
+ (if next
+ (insert ", Next: " next))
+ (if prev
+ (insert ", Prev: " prev))
+ (if up
+ (insert ", Up: " up))
+ (insert ?\n)
+ (setq texinfo-last-node-pos (point))))
+
+(put 'menu 'texinfo-format 'texinfo-format-menu)
+(defun texinfo-format-menu ()
+ (texinfo-discard-line)
+ (insert "* Menu:\n\n"))
+
+(put 'menu 'texinfo-end 'texinfo-discard-command)
+
+;; The @detailmenu should be removed eventually.
+
+;; According to Karl Berry, 31 August 1996:
+;;
+;; You don't like, I don't like it. I agree, it would be better just to
+;; fix the bug [in `makeinfo']. .. At this point, since inserting those
+;; two commands in the Elisp fn is trivial, I don't especially want to
+;; expend more effort...
+;;
+;; I added a couple sentences of documentation to the manual (putting the
+;; blame on makeinfo where it belongs :-().
+
+(put 'detailmenu 'texinfo-format 'texinfo-discard-line)
+(put 'detailmenu 'texinfo-end 'texinfo-discard-command)
+
+;; (Also see `texnfo-upd.el')
+
+
+;;; Cross references
+
+;; @xref {NODE, FNAME, NAME, FILE, DOCUMENT}
+;; -> *Note FNAME: (FILE)NODE
+;; If FILE is missing,
+;; *Note FNAME: NODE
+;; If FNAME is empty and NAME is present
+;; *Note NAME: Node
+;; If both NAME and FNAME are missing
+;; *Note NODE::
+;; texinfo ignores the DOCUMENT argument.
+;; -> See section <xref to NODE> [NAME, else NODE], page <xref to NODE>
+;; If FILE is specified, (FILE)NODE is used for xrefs.
+;; If fifth argument DOCUMENT is specified, produces
+;; See section <xref to NODE> [NAME, else NODE], page <xref to NODE>
+;; of DOCUMENT
+
+;; @ref a reference that does not put `See' or `see' in
+;; the hardcopy and is the same as @xref in Info
+(put 'ref 'texinfo-format 'texinfo-format-xref)
+
+(put 'xref 'texinfo-format 'texinfo-format-xref)
+(defun texinfo-format-xref ()
+ (let ((args (texinfo-format-parse-args)))
+ (texinfo-discard-command)
+ (insert "*Note ")
+ (let ((fname (or (nth 1 args) (nth 2 args))))
+ (if (null (or fname (nth 3 args)))
+ (insert (car args) "::")
+ (insert (or fname (car args)) ": ")
+ (if (nth 3 args)
+ (insert "(" (nth 3 args) ")"))
+ (insert (car args))))))
+
+(put 'pxref 'texinfo-format 'texinfo-format-pxref)
+(defun texinfo-format-pxref ()
+ (texinfo-format-xref)
+ (or (save-excursion
+ (forward-char -2)
+ (looking-at "::"))
+ (insert ".")))
+
+;; @inforef{NODE, FNAME, FILE}
+;; Like @xref{NODE, FNAME,,FILE} in texinfo.
+;; In Tex, generates "See Info file FILE, node NODE"
+(put 'inforef 'texinfo-format 'texinfo-format-inforef)
+(defun texinfo-format-inforef ()
+ (let ((args (texinfo-format-parse-args)))
+ (texinfo-discard-command)
+ (if (nth 1 args)
+ (insert "*Note " (nth 1 args) ": (" (nth 2 args) ")" (car args))
+ (insert "*Note " "(" (nth 2 args) ")" (car args) "::"))))
+
+
+;;; Section headings
+
+(put 'majorheading 'texinfo-format 'texinfo-format-chapter)
+(put 'chapheading 'texinfo-format 'texinfo-format-chapter)
+(put 'ichapter 'texinfo-format 'texinfo-format-chapter)
+(put 'chapter 'texinfo-format 'texinfo-format-chapter)
+(put 'iappendix 'texinfo-format 'texinfo-format-chapter)
+(put 'appendix 'texinfo-format 'texinfo-format-chapter)
+(put 'iunnumbered 'texinfo-format 'texinfo-format-chapter)
+(put 'top 'texinfo-format 'texinfo-format-chapter)
+(put 'unnumbered 'texinfo-format 'texinfo-format-chapter)
+(put 'centerchap 'texinfo-format 'texinfo-format-chapter)
+(defun texinfo-format-chapter ()
+ (texinfo-format-chapter-1 ?*))
+
+(put 'heading 'texinfo-format 'texinfo-format-section)
+(put 'isection 'texinfo-format 'texinfo-format-section)
+(put 'section 'texinfo-format 'texinfo-format-section)
+(put 'iappendixsection 'texinfo-format 'texinfo-format-section)
+(put 'appendixsection 'texinfo-format 'texinfo-format-section)
+(put 'iappendixsec 'texinfo-format 'texinfo-format-section)
+(put 'appendixsec 'texinfo-format 'texinfo-format-section)
+(put 'iunnumberedsec 'texinfo-format 'texinfo-format-section)
+(put 'unnumberedsec 'texinfo-format 'texinfo-format-section)
+(defun texinfo-format-section ()
+ (texinfo-format-chapter-1 ?=))
+
+(put 'subheading 'texinfo-format 'texinfo-format-subsection)
+(put 'isubsection 'texinfo-format 'texinfo-format-subsection)
+(put 'subsection 'texinfo-format 'texinfo-format-subsection)
+(put 'iappendixsubsec 'texinfo-format 'texinfo-format-subsection)
+(put 'appendixsubsec 'texinfo-format 'texinfo-format-subsection)
+(put 'iunnumberedsubsec 'texinfo-format 'texinfo-format-subsection)
+(put 'unnumberedsubsec 'texinfo-format 'texinfo-format-subsection)
+(defun texinfo-format-subsection ()
+ (texinfo-format-chapter-1 ?-))
+
+(put 'subsubheading 'texinfo-format 'texinfo-format-subsubsection)
+(put 'isubsubsection 'texinfo-format 'texinfo-format-subsubsection)
+(put 'subsubsection 'texinfo-format 'texinfo-format-subsubsection)
+(put 'iappendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
+(put 'appendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
+(put 'iunnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
+(put 'unnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
+(defun texinfo-format-subsubsection ()
+ (texinfo-format-chapter-1 ?.))
+
+(defun texinfo-format-chapter-1 (belowchar)
+ (let ((arg (texinfo-parse-arg-discard)))
+ (message "Formatting: %s ... " arg) ; So we can see where we are.
+ (insert ?\n arg ?\n "@SectionPAD " belowchar ?\n)
+ (forward-line -2)))
+
+(put 'SectionPAD 'texinfo-format 'texinfo-format-sectionpad)
+(defun texinfo-format-sectionpad ()
+ (let ((str (texinfo-parse-arg-discard)))
+ (forward-char -1)
+ (let ((column (current-column)))
+ (forward-char 1)
+ (while (> column 0)
+ (insert str)
+ (setq column (1- column))))
+ (insert ?\n)))
+
+
+;;; Space controlling commands: @. and @:, and the soft hyphen.
+
+(put '\. 'texinfo-format 'texinfo-format-\.)
+(defun texinfo-format-\. ()
+ (texinfo-discard-command)
+ (insert "."))
+
+(put '\: 'texinfo-format 'texinfo-format-\:)
+(defun texinfo-format-\: ()
+ (texinfo-discard-command))
+
+(put '\- 'texinfo-format 'texinfo-format-soft-hyphen)
+(defun texinfo-format-soft-hyphen ()
+ (texinfo-discard-command))
+
+
+;;; @center, @sp, and @br
+
+(put 'center 'texinfo-format 'texinfo-format-center)
+(defun texinfo-format-center ()
+ (let ((arg (texinfo-parse-expanded-arg)))
+ (texinfo-discard-command)
+ (insert arg)
+ (insert ?\n)
+ (save-restriction
+ (goto-char (1- (point)))
+ (let ((indent-tabs-mode nil))
+ (center-line)))))
+
+(put 'sp 'texinfo-format 'texinfo-format-sp)
+(defun texinfo-format-sp ()
+ (let* ((arg (texinfo-parse-arg-discard))
+ (num (read arg)))
+ (insert-char ?\n num)))
+
+(put 'br 'texinfo-format 'texinfo-format-paragraph-break)
+(defun texinfo-format-paragraph-break ()
+ "Force a paragraph break.
+If used within a line, follow `@br' with braces."
+ (texinfo-optional-braces-discard)
+ ;; insert one return if at end of line;
+ ;; else insert two returns, to generate a blank line.
+ (if (= (following-char) ?\n)
+ (insert ?\n)
+ (insert-char ?\n 2)))
+
+
+;;; @footnote and @footnotestyle
+
+;; In Texinfo, footnotes are created with the `@footnote' command.
+;; This command is followed immediately by a left brace, then by the text of
+;; the footnote, and then by a terminating right brace. The
+;; template for a footnote is:
+;;
+;; @footnote{TEXT}
+;;
+;; Info has two footnote styles:
+;;
+;; * In the End of node style, all the footnotes for a single node
+;; are placed at the end of that node. The footnotes are
+;; separated from the rest of the node by a line of dashes with
+;; the word `Footnotes' within it.
+;;
+;; * In the Separate node style, all the footnotes for a single node
+;; are placed in an automatically constructed node of their own.
+
+;; Footnote style is specified by the @footnotestyle command, either
+;; @footnotestyle separate
+;; or
+;; @footnotestyle end
+;;
+;; The default is separate
+
+(defvar texinfo-footnote-style "separate"
+ "Footnote style, either separate or end.")
+
+(put 'footnotestyle 'texinfo-format 'texinfo-footnotestyle)
+(defun texinfo-footnotestyle ()
+ "Specify whether footnotes are at end of node or in separate nodes.
+Argument is either end or separate."
+ (setq texinfo-footnote-style (texinfo-parse-arg-discard)))
+
+(defvar texinfo-footnote-number)
+
+(put 'footnote 'texinfo-format 'texinfo-format-footnote)
+(defun texinfo-format-footnote ()
+ "Format a footnote in either end of node or separate node style.
+The texinfo-footnote-style variable controls which style is used."
+ (setq texinfo-footnote-number (1+ texinfo-footnote-number))
+ (cond ((string= texinfo-footnote-style "end")
+ (texinfo-format-end-node))
+ ((string= texinfo-footnote-style "separate")
+ (texinfo-format-separate-node))))
+
+(defun texinfo-format-separate-node ()
+ "Format footnote in Separate node style, with notes in own node.
+The node is constructed automatically."
+ (let* (start
+ (arg (texinfo-parse-line-arg))
+ (node-name-beginning
+ (save-excursion
+ (re-search-backward
+ "^File: \\w+\\(\\w\\|\\s_\\|\\.\\|,\\)*[ \t]+Node:")
+ (match-end 0)))
+ (node-name
+ (save-excursion
+ (buffer-substring
+ (progn (goto-char node-name-beginning) ; skip over node command
+ (skip-chars-forward " \t") ; and over spaces
+ (point))
+ (if (search-forward
+ ","
+ (save-excursion (end-of-line) (point)) t) ; bound search
+ (1- (point))
+ (end-of-line) (point))))))
+ (texinfo-discard-command) ; remove or insert whitespace, as needed
+ (delete-region (save-excursion (skip-chars-backward " \t\n") (point))
+ (point))
+ (insert (format " (%d) (*Note %s-Footnotes::)"
+ texinfo-footnote-number node-name))
+ (fill-paragraph nil)
+ (save-excursion
+ (if (re-search-forward "^@node" nil 'move)
+ (forward-line -1))
+
+ ;; two cases: for the first footnote, we must insert a node header;
+ ;; for the second and subsequent footnotes, we need only insert
+ ;; the text of the footnote.
+
+ (if (save-excursion
+ (re-search-backward
+ (concat node-name "-Footnotes, Up: ")
+ node-name-beginning
+ t))
+ (progn ; already at least one footnote
+ (setq start (point))
+ (insert (format "\n(%d) %s\n" texinfo-footnote-number arg))
+ (fill-region start (point)))
+ ;; else not yet a footnote
+ (insert "\n\^_\nFile: " texinfo-format-filename
+ " Node: " node-name "-Footnotes, Up: " node-name "\n")
+ (setq start (point))
+ (insert (format "\n(%d) %s\n" texinfo-footnote-number arg))
+ (fill-region start (point))))))
+
+(defun texinfo-format-end-node ()
+ "Format footnote in the End of node style, with notes at end of node."
+ (let (start
+ (arg (texinfo-parse-line-arg)))
+ (texinfo-discard-command) ; remove or insert whitespace, as needed
+ (delete-region (save-excursion (skip-chars-backward " \t\n") (point))
+ (point))
+ (insert (format " (%d) " texinfo-footnote-number))
+ (fill-paragraph nil)
+ (save-excursion
+ (if (search-forward "\n--------- Footnotes ---------\n" nil t)
+ (progn ; already have footnote, put new one before end of node
+ (if (re-search-forward "^@node" nil 'move)
+ (forward-line -1))
+ (setq start (point))
+ (insert (format "\n(%d) %s\n" texinfo-footnote-number arg))
+ (fill-region start (point)))
+ ;; else no prior footnote
+ (if (re-search-forward "^@node" nil 'move)
+ (forward-line -1))
+ (insert "\n--------- Footnotes ---------\n")
+ (setq start (point))
+ (insert (format "\n(%d) %s\n" texinfo-footnote-number arg))))))
+
+
+;;; @itemize, @enumerate, and similar commands
+
+;; @itemize pushes (itemize "COMMANDS" STARTPOS) on texinfo-stack.
+;; @enumerate pushes (enumerate 0 STARTPOS).
+;; @item dispatches to the texinfo-item prop of the first elt of the list.
+;; For itemize, this puts in and rescans the COMMANDS.
+;; For enumerate, this increments the number and puts it in.
+;; In either case, it puts a Backspace at the front of the line
+;; which marks it not to be indented later.
+;; All other lines get indented by 5 when the @end is reached.
+
+(defvar texinfo-stack-depth 0
+ "Count of number of unpopped texinfo-push-stack calls.
+Used by @refill indenting command to avoid indenting within lists, etc.")
+
+(defun texinfo-push-stack (check arg)
+ (setq texinfo-stack-depth (1+ texinfo-stack-depth))
+ (setq texinfo-stack
+ (cons (list check arg texinfo-command-start)
+ texinfo-stack)))
+
+(defun texinfo-pop-stack (check)
+ (setq texinfo-stack-depth (1- texinfo-stack-depth))
+ (if (null texinfo-stack)
+ (error "Unmatched @end %s" check))
+ (if (not (eq (car (car texinfo-stack)) check))
+ (error "@end %s matches @%s"
+ check (car (car texinfo-stack))))
+ (prog1 (cdr (car texinfo-stack))
+ (setq texinfo-stack (cdr texinfo-stack))))
+
+(put 'itemize 'texinfo-format 'texinfo-itemize)
+(defun texinfo-itemize ()
+ (texinfo-push-stack
+ 'itemize
+ (progn (skip-chars-forward " \t")
+ (if (eolp)
+ "@bullet"
+ (texinfo-parse-line-arg))))
+ (texinfo-discard-line-with-args)
+ (setq fill-column (- fill-column 5)))
+
+(put 'itemize 'texinfo-end 'texinfo-end-itemize)
+(defun texinfo-end-itemize ()
+ (setq fill-column (+ fill-column 5))
+ (texinfo-discard-command)
+ (let ((stacktop
+ (texinfo-pop-stack 'itemize)))
+ (texinfo-do-itemize (nth 1 stacktop))))
+
+(put 'enumerate 'texinfo-format 'texinfo-enumerate)
+(defun texinfo-enumerate ()
+ (texinfo-push-stack
+ 'enumerate
+ (progn (skip-chars-forward " \t")
+ (if (eolp)
+ 1
+ (read (current-buffer)))))
+ (if (and (symbolp (car (cdr (car texinfo-stack))))
+ (> 1 (length (symbol-name (car (cdr (car texinfo-stack)))))))
+ (error
+ "@enumerate: Use a number or letter, eg: 1, A, a, 3, B, or d." ))
+ (texinfo-discard-line-with-args)
+ (setq fill-column (- fill-column 5)))
+
+(put 'enumerate 'texinfo-end 'texinfo-end-enumerate)
+(defun texinfo-end-enumerate ()
+ (setq fill-column (+ fill-column 5))
+ (texinfo-discard-command)
+ (let ((stacktop
+ (texinfo-pop-stack 'enumerate)))
+ (texinfo-do-itemize (nth 1 stacktop))))
+
+;; @alphaenumerate never became a standard part of Texinfo
+(put 'alphaenumerate 'texinfo-format 'texinfo-alphaenumerate)
+(defun texinfo-alphaenumerate ()
+ (texinfo-push-stack 'alphaenumerate (1- ?a))
+ (setq fill-column (- fill-column 5))
+ (texinfo-discard-line))
+
+(put 'alphaenumerate 'texinfo-end 'texinfo-end-alphaenumerate)
+(defun texinfo-end-alphaenumerate ()
+ (setq fill-column (+ fill-column 5))
+ (texinfo-discard-command)
+ (let ((stacktop
+ (texinfo-pop-stack 'alphaenumerate)))
+ (texinfo-do-itemize (nth 1 stacktop))))
+
+;; @capsenumerate never became a standard part of Texinfo
+(put 'capsenumerate 'texinfo-format 'texinfo-capsenumerate)
+(defun texinfo-capsenumerate ()
+ (texinfo-push-stack 'capsenumerate (1- ?A))
+ (setq fill-column (- fill-column 5))
+ (texinfo-discard-line))
+
+(put 'capsenumerate 'texinfo-end 'texinfo-end-capsenumerate)
+(defun texinfo-end-capsenumerate ()
+ (setq fill-column (+ fill-column 5))
+ (texinfo-discard-command)
+ (let ((stacktop
+ (texinfo-pop-stack 'capsenumerate)))
+ (texinfo-do-itemize (nth 1 stacktop))))
+
+;; At the @end, indent all the lines within the construct
+;; except those marked with backspace. FROM says where
+;; construct started.
+(defun texinfo-do-itemize (from)
+ (save-excursion
+ (while (progn (forward-line -1)
+ (>= (point) from))
+ (if (= (following-char) ?\b)
+ (save-excursion
+ (delete-char 1)
+ (end-of-line)
+ (delete-char 6))
+ (if (not (looking-at "[ \t]*$"))
+ (save-excursion (insert " ")))))))
+
+(put 'item 'texinfo-format 'texinfo-item)
+(put 'itemx 'texinfo-format 'texinfo-item)
+(defun texinfo-item ()
+ (funcall (get (car (car texinfo-stack)) 'texinfo-item)))
+
+(put 'itemize 'texinfo-item 'texinfo-itemize-item)
+(defun texinfo-itemize-item ()
+ ;; (texinfo-discard-line) ; Did not handle text on same line as @item.
+ (delete-region (1+ (point)) (save-excursion (beginning-of-line) (point)))
+ (if (looking-at "[ \t]*[^ \t\n]+")
+ ;; Text on same line as @item command.
+ (insert "\b " (nth 1 (car texinfo-stack)) " \n")
+ ;; Else text on next line.
+ (insert "\b " (nth 1 (car texinfo-stack)) " "))
+ (forward-line -1))
+
+(put 'enumerate 'texinfo-item 'texinfo-enumerate-item)
+(defun texinfo-enumerate-item ()
+ (texinfo-discard-line)
+ (let (enumerating-symbol)
+ (cond ((integerp (car (cdr (car texinfo-stack))))
+ (setq enumerating-symbol (car (cdr (car texinfo-stack))))
+ (insert ?\b (format "%3d. " enumerating-symbol) ?\n)
+ (setcar (cdr (car texinfo-stack)) (1+ enumerating-symbol)))
+ ((symbolp (car (cdr (car texinfo-stack))))
+ (setq enumerating-symbol
+ (symbol-name (car (cdr (car texinfo-stack)))))
+ (if (or (equal ?\[ (string-to-char enumerating-symbol))
+ (equal ?\{ (string-to-char enumerating-symbol)))
+ (error
+ "Too many items in enumerated list; alphabet ends at Z."))
+ (insert ?\b (format "%3s. " enumerating-symbol) ?\n)
+ (setcar (cdr (car texinfo-stack))
+ (make-symbol
+ (char-to-string
+ (1+
+ (string-to-char enumerating-symbol))))))
+ (t
+ (error
+ "@enumerate: Use a number or letter, eg: 1, A, a, 3, B or d." )))
+ (forward-line -1)))
+
+(put 'alphaenumerate 'texinfo-item 'texinfo-alphaenumerate-item)
+(defun texinfo-alphaenumerate-item ()
+ (texinfo-discard-line)
+ (let ((next (1+ (car (cdr (car texinfo-stack))))))
+ (if (> next ?z)
+ (error "More than 26 items in @alphaenumerate; get a bigger alphabet."))
+ (setcar (cdr (car texinfo-stack)) next)
+ (insert "\b " next ". \n"))
+ (forward-line -1))
+
+(put 'capsenumerate 'texinfo-item 'texinfo-capsenumerate-item)
+(defun texinfo-capsenumerate-item ()
+ (texinfo-discard-line)
+ (let ((next (1+ (car (cdr (car texinfo-stack))))))
+ (if (> next ?Z)
+ (error "More than 26 items in @capsenumerate; get a bigger alphabet."))
+ (setcar (cdr (car texinfo-stack)) next)
+ (insert "\b " next ". \n"))
+ (forward-line -1))
+
+
+;;; @table
+
+;; The `@table' command produces two-column tables.
+
+(put 'table 'texinfo-format 'texinfo-table)
+(defun texinfo-table ()
+ (texinfo-push-stack
+ 'table
+ (progn (skip-chars-forward " \t")
+ (if (eolp)
+ "@asis"
+ (texinfo-parse-line-arg))))
+ (texinfo-discard-line-with-args)
+ (setq fill-column (- fill-column 5)))
+
+(put 'table 'texinfo-item 'texinfo-table-item)
+(defun texinfo-table-item ()
+ (let ((arg (texinfo-parse-arg-discard))
+ (itemfont (car (cdr (car texinfo-stack)))))
+ (insert ?\b itemfont ?\{ arg "}\n \n"))
+ (forward-line -2))
+
+(put 'table 'texinfo-end 'texinfo-end-table)
+(defun texinfo-end-table ()
+ (setq fill-column (+ fill-column 5))
+ (texinfo-discard-command)
+ (let ((stacktop
+ (texinfo-pop-stack 'table)))
+ (texinfo-do-itemize (nth 1 stacktop))))
+
+;; @description appears to be an undocumented variant on @table that
+;; does not require an arg. It fails in texinfo.tex 2.58 and is not
+;; part of makeinfo.c The command appears to be a relic of the past.
+(put 'description 'texinfo-end 'texinfo-end-table)
+(put 'description 'texinfo-format 'texinfo-description)
+(defun texinfo-description ()
+ (texinfo-push-stack 'table "@asis")
+ (setq fill-column (- fill-column 5))
+ (texinfo-discard-line))
+
+
+;;; @ftable, @vtable
+
+;; The `@ftable' and `@vtable' commands are like the `@table' command
+;; but they also insert each entry in the first column of the table
+;; into the function or variable index.
+
+;; Handle the @ftable and @vtable commands:
+
+(put 'ftable 'texinfo-format 'texinfo-ftable)
+(put 'vtable 'texinfo-format 'texinfo-vtable)
+
+(defun texinfo-ftable () (texinfo-indextable 'ftable))
+(defun texinfo-vtable () (texinfo-indextable 'vtable))
+
+(defun texinfo-indextable (table-type)
+ (texinfo-push-stack table-type (texinfo-parse-arg-discard))
+ (setq fill-column (- fill-column 5)))
+
+;; Handle the @item commands within ftable and vtable:
+
+(put 'ftable 'texinfo-item 'texinfo-ftable-item)
+(put 'vtable 'texinfo-item 'texinfo-vtable-item)
+
+(defun texinfo-ftable-item () (texinfo-indextable-item 'texinfo-findex))
+(defun texinfo-vtable-item () (texinfo-indextable-item 'texinfo-vindex))
+
+(defun texinfo-indextable-item (index-type)
+ (let ((item (texinfo-parse-arg-discard))
+ (itemfont (car (cdr (car texinfo-stack))))
+ (indexvar index-type))
+ (insert ?\b itemfont ?\{ item "}\n \n")
+ (set indexvar
+ (cons
+ (list item texinfo-last-node)
+ (symbol-value indexvar)))
+ (forward-line -2)))
+
+;; Handle @end ftable, @end vtable
+
+(put 'ftable 'texinfo-end 'texinfo-end-ftable)
+(put 'vtable 'texinfo-end 'texinfo-end-vtable)
+
+(defun texinfo-end-ftable () (texinfo-end-indextable 'ftable))
+(defun texinfo-end-vtable () (texinfo-end-indextable 'vtable))
+
+(defun texinfo-end-indextable (table-type)
+ (setq fill-column (+ fill-column 5))
+ (texinfo-discard-command)
+ (let ((stacktop
+ (texinfo-pop-stack table-type)))
+ (texinfo-do-itemize (nth 1 stacktop))))
+
+
+;;; @multitable ... @end multitable
+
+;; Produce a multi-column table, with as many columns as desired.
+;;
+;; A multi-column table has this template:
+;;
+;; @multitable {A1} {A2} {A3}
+;; @item A1 @tab A2 @tab A3
+;; @item B1 @tab B2 @tab B3
+;; @item C1 @tab C2 @tab C3
+;; @end multitable
+;;
+;; where the width of the text in brackets specifies the width of the
+;; respective column.
+;;
+;; Or else:
+;;
+;; @multitable @columnfractions .25 .3 .45
+;; @item A1 @tab A2 @tab A3
+;; @item B1 @tab B2 @tab B3
+;; @end multitable
+;;
+;; where the fractions specify the width of each column as a percent
+;; of the current width of the text (i.e., of the fill-column).
+;;
+;; Long lines of text are filled within columns.
+;;
+;; Using the Emacs Lisp formatter, texinfmt.el,
+;; the whitespace between columns can be increased by setting
+;; `extra-inter-column-width' to a value greater than 0. By default,
+;; there is at least one blank space between columns.
+;;
+;; The Emacs Lisp formatter, texinfmt.el, ignores the following four
+;; commands that are defined in texinfo.tex for printed output.
+;;
+;; @multitableparskip,
+;; @multitableparindent,
+;; @multitablecolmargin,
+;; @multitablelinespace.
+
+;; How @multitable works.
+;; =====================
+;;
+;; `texinfo-multitable' reads the @multitable line and determines from it
+;; how wide each column should be.
+;;
+;; Also, it pushes this information, along with an identifying symbol,
+;; onto the `texinfo-stack'. At the @end multitable command, the stack
+;; is checked for its matching @multitable command, and then popped, or
+;; else an error is signaled. Also, this command pushes the location of
+;; the start of the table onto the stack.
+;;
+;; `texinfo-end-multitable' checks the `texinfo-stack' that the @end
+;; multitable truly is ending a corresponding beginning, and if it is,
+;; pops the stack.
+;;
+;; `texinfo-multitable-widths' is called by `texinfo-multitable'.
+;; The function returns a list of the widths of each column in a
+;; multi-column table, based on the information supplied by the arguments
+;; to the @multitable command (by arguments, I mean the text on the rest
+;; of the @multitable line, not the remainder of the multi-column table
+;; environment).
+;;
+;; `texinfo-multitable-item' formats a row within a multicolumn table.
+;; This command is executed when texinfmt sees @item inside @multitable.
+;; Cells in row are separated by `@tab's. Widths of cells are specified
+;; by the arguments in the @multitable line. Cells are filled. All cells
+;; are made to be the same height by padding their bottoms, as needed,
+;; with blanks.
+;;
+;; `texinfo-multitable-extract-row' is called by `texinfo-multitable-item'.
+;; This function returns the text in a multitable row, as a string.
+;; The start of a row is marked by an @item and the end of row is the
+;; beginning of next @item or beginning of the @end multitable line.
+;; Cells within a row are separated by @tab.
+;;
+;; Note that @tab, the cell separators, are not treated as independent
+;; Texinfo commands.
+
+(defvar extra-inter-column-width 0
+"*Insert NUMBER of additional columns of whitespace between entries of
+a multi-column table.")
+
+(defvar multitable-temp-buffer-name "*multitable-temporary-buffer*")
+(defvar multitable-temp-rectangle-name "texinfo-multitable-temp-")
+
+;; These commands are defined in texinfo.tex for printed output.
+(put 'multitableparskip 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'multitableparindent 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'multitablecolmargin 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'multitablelinespace 'texinfo-format 'texinfo-discard-line-with-args)
+
+(put 'multitable 'texinfo-format 'texinfo-multitable)
+(defun texinfo-multitable ()
+ "Produce multi-column tables.
+
+A multi-column table has this template:
+
+ @multitable {A1} {A2} {A3}
+ @item A1 @tab A2 @tab A3
+ @item B1 @tab B2 @tab B3
+ @item C1 @tab C2 @tab C3
+ @end multitable
+
+where the width of the text in brackets specifies the width of the
+respective column.
+
+Or else:
+
+ @multitable @columnfractions .25 .3 .45
+ @item A1 @tab A2 @tab A3
+ @item B1 @tab B2 @tab B3
+ @end multitable
+
+where the fractions specify the width of each column as a percent
+of the current width of the text (i.e., of the fill-column).
+
+Long lines of text are filled within columns.
+
+Using the Emacs Lisp formatter, texinfmt.el,
+the whitespace between columns can be increased by setting
+`extra-inter-column-width' to a value greater than 0. By default,
+there is at least one blank space between columns.
+
+The Emacs Lisp formatter, texinfmt.el, ignores the following four
+commands that are defined in texinfo.tex for printed output.
+
+ @multitableparskip,
+ @multitableparindent,
+ @multitablecolmargin,
+ @multitablelinespace."
+
+;; This function pushes information onto the `texinfo-stack'.
+;; A stack element consists of:
+;; - type-of-command, i.e., multitable
+;; - the information about column widths, and
+;; - the position of texinfo-command-start.
+;; e.g., ('multitable (1 2 3 4) 123)
+;; The command line is then deleted.
+ (texinfo-push-stack
+ 'multitable
+ ;; push width information on stack
+ (texinfo-multitable-widths))
+ (texinfo-discard-line-with-args))
+
+(put 'multitable 'texinfo-end 'texinfo-end-multitable)
+(defun texinfo-end-multitable ()
+ "Discard the @end multitable line and pop the stack of multitable."
+ (texinfo-discard-command)
+ (texinfo-pop-stack 'multitable))
+
+(defun texinfo-multitable-widths ()
+ "Return list of widths of each column in a multi-column table."
+ (let (texinfo-multitable-width-list)
+ ;; Fractions format:
+ ;; @multitable @columnfractions .25 .3 .45
+ ;;
+ ;; Template format:
+ ;; @multitable {Column 1 template} {Column 2} {Column 3 example}
+ ;; Place point before first argument
+ (skip-chars-forward " \t")
+ (cond
+ ;; Check for common misspelling
+ ((looking-at "@columnfraction ")
+ (error "In @multitable, @columnfractions misspelled"))
+ ;; Case 1: @columnfractions .25 .3 .45
+ ((looking-at "@columnfractions")
+ (forward-word 1)
+ (while (not (eolp))
+ (setq texinfo-multitable-width-list
+ (cons
+ (truncate
+ (1-
+ (* fill-column (read (get-buffer (current-buffer))))))
+ texinfo-multitable-width-list))))
+ ;;
+ ;; Case 2: {Column 1 template} {Column 2} {Column 3 example}
+ ((looking-at "{")
+ (let ((start-of-templates (point)))
+ (while (not (eolp))
+ (skip-chars-forward " \t")
+ (let* ((start-of-template (1+ (point)))
+ (end-of-template
+ ;; forward-sexp works with braces in Texinfo mode
+ (progn (forward-sexp 1) (1- (point)))))
+ (setq texinfo-multitable-width-list
+ (cons (- end-of-template start-of-template)
+ texinfo-multitable-width-list))
+ ;; Remove carriage return from within a template, if any.
+ ;; This helps those those who want to use more than
+ ;; one line's worth of words in @multitable line.
+ (narrow-to-region start-of-template end-of-template)
+ (goto-char (point-min))
+ (while (search-forward "
+" nil t)
+ (delete-char -1))
+ (goto-char (point-max))
+ (widen)
+ (forward-char 1)))))
+ ;;
+ ;; Case 3: Trouble
+ (t
+ (error
+ "You probably need to specify column widths for @multitable correctly.")))
+ ;; Check whether columns fit on page.
+ (let ((desired-columns
+ (+
+ ;; between column spaces
+ (length texinfo-multitable-width-list)
+ ;; additional between column spaces, if any
+ extra-inter-column-width
+ ;; sum of spaces for each entry
+ (apply '+ texinfo-multitable-width-list))))
+ (if (> desired-columns fill-column)
+ (error
+ (format
+ "Multi-column table width, %d chars, is greater than page width, %d chars."
+ desired-columns fill-column))))
+ texinfo-multitable-width-list))
+
+;; @item A1 @tab A2 @tab A3
+(defun texinfo-multitable-extract-row ()
+ "Return multitable row, as a string.
+End of row is beginning of next @item or beginning of @end.
+Cells within rows are separated by @tab."
+ (skip-chars-forward " \t")
+ (let* ((start (point))
+ (end (progn
+ (re-search-forward "@item\\|@end")
+ (match-beginning 0)))
+ (row (progn (goto-char end)
+ (skip-chars-backward " ")
+ ;; remove whitespace at end of argument
+ (delete-region (point) end)
+ (buffer-substring start (point)))))
+ (delete-region texinfo-command-start end)
+ row))
+
+(put 'multitable 'texinfo-item 'texinfo-multitable-item)
+(defun texinfo-multitable-item ()
+ "Format a row within a multicolumn table.
+Cells in row are separated by @tab.
+Widths of cells are specified by the arguments in the @multitable line.
+All cells are made to be the same height.
+This command is executed when texinfmt sees @item inside @multitable."
+ (let ((original-buffer (current-buffer))
+ (table-widths (reverse (car (cdr (car texinfo-stack)))))
+ (existing-fill-column fill-column)
+ start
+ end
+ (table-column 0)
+ (table-entry-height 0)
+ ;; unformatted row looks like: A1 @tab A2 @tab A3
+ ;; extract-row command deletes the source line in the table.
+ (unformated-row (texinfo-multitable-extract-row)))
+ ;; Use a temporary buffer
+ (set-buffer (get-buffer-create multitable-temp-buffer-name))
+ (delete-region (point-min) (point-max))
+ (insert unformated-row)
+ (goto-char (point-min))
+;; 1. Check for correct number of @tab in line.
+ (let ((tab-number 1)) ; one @tab between two columns
+ (while (search-forward "@tab" nil t)
+ (setq tab-number (1+ tab-number)))
+ (if (/= tab-number (length table-widths))
+ (error "Wrong number of @tab's in a @multitable row.")))
+ (goto-char (point-min))
+;; 2. Format each cell, and copy to a rectangle
+ ;; buffer looks like this: A1 @tab A2 @tab A3
+ ;; Cell #1: format up to @tab
+ ;; Cell #2: format up to @tab
+ ;; Cell #3: format up to eob
+ (while (not (eobp))
+ (setq start (point))
+ (setq end (save-excursion
+ (if (search-forward "@tab" nil 'move)
+ ;; Delete the @tab command, including the @-sign
+ (delete-region
+ (point)
+ (progn (forward-word -1) (1- (point)))))
+ (point)))
+ ;; Set fill-column *wider* than needed to produce inter-column space
+ (setq fill-column (+ 1
+ extra-inter-column-width
+ (nth table-column table-widths)))
+ (narrow-to-region start end)
+ ;; Remove whitespace before and after entry.
+ (skip-chars-forward " ")
+ (delete-region (point) (save-excursion (beginning-of-line) (point)))
+ (goto-char (point-max))
+ (skip-chars-backward " ")
+ (delete-region (point) (save-excursion (end-of-line) (point)))
+ ;; Temorarily set texinfo-stack to nil so texinfo-format-scan
+ ;; does not see an unterminated @multitable.
+ (let (texinfo-stack) ; nil
+ (texinfo-format-scan))
+ (let (fill-prefix) ; no fill prefix
+ (fill-region (point-min) (point-max)))
+ (setq table-entry-height
+ (max table-entry-height (count-lines (point-min) (point-max))))
+;; 3. Move point to end of bottom line, and pad that line to fill column.
+ (goto-char (point-min))
+ (forward-line (1- table-entry-height))
+ (let* ((beg (point)) ; beginning of line
+ ;; add one more space for inter-column spacing
+ (needed-whitespace
+ (1+
+ (- fill-column
+ (-
+ (progn (end-of-line) (point)) ; end of existing line
+ beg)))))
+ (insert (make-string
+ (if (> needed-whitespace 0) needed-whitespace 1)
+ ? )))
+ ;; now, put formatted cell into a rectangle
+ (set (intern (concat multitable-temp-rectangle-name
+ (int-to-string table-column)))
+ (extract-rectangle (point-min) (point)))
+ (delete-region (point-min) (point))
+ (goto-char (point-max))
+ (setq table-column (1+ table-column))
+ (widen))
+;; 4. Add extra lines to rectangles so all are of same height
+ (let ((total-number-of-columns table-column)
+ (column-number 0)
+ here)
+ (while (> table-column 0)
+ (let ((this-rectangle (int-to-string table-column)))
+ (while (< (length this-rectangle) table-entry-height)
+ (setq this-rectangle (append this-rectangle '("")))))
+ (setq table-column (1- table-column)))
+;; 5. Insert formatted rectangles in original buffer
+ (switch-to-buffer original-buffer)
+ (open-line table-entry-height)
+ (while (< column-number total-number-of-columns)
+ (setq here (point))
+ (insert-rectangle
+ (eval (intern
+ (concat multitable-temp-rectangle-name
+ (int-to-string column-number)))))
+ (goto-char here)
+ (end-of-line)
+ (setq column-number (1+ column-number))))
+ (kill-buffer multitable-temp-buffer-name)
+ (setq fill-column existing-fill-column)))
+
+
+;;; @ifinfo, @iftex, @tex, @ifhtml, @html
+
+(put 'ifinfo 'texinfo-format 'texinfo-discard-line)
+(put 'ifinfo 'texinfo-end 'texinfo-discard-command)
+
+(put 'iftex 'texinfo-format 'texinfo-format-iftex)
+(defun texinfo-format-iftex ()
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end iftex[ \t]*\n")
+ (point))))
+
+(put 'ifhtml 'texinfo-format 'texinfo-format-ifhtml)
+(defun texinfo-format-ifhtml ()
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end ifhtml[ \t]*\n")
+ (point))))
+
+(put 'tex 'texinfo-format 'texinfo-format-tex)
+(defun texinfo-format-tex ()
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end tex[ \t]*\n")
+ (point))))
+
+(put 'html 'texinfo-format 'texinfo-format-html)
+(defun texinfo-format-html ()
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end html[ \t]*\n")
+ (point))))
+
+
+;;; @titlepage
+
+(put 'titlepage 'texinfo-format 'texinfo-format-titlepage)
+(defun texinfo-format-titlepage ()
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end titlepage[ \t]*\n")
+ (point))))
+
+(put 'endtitlepage 'texinfo-format 'texinfo-discard-line)
+
+;; @titlespec an alternative titling command; ignored by Info
+
+(put 'titlespec 'texinfo-format 'texinfo-format-titlespec)
+(defun texinfo-format-titlespec ()
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end titlespec[ \t]*\n")
+ (point))))
+
+(put 'endtitlespec 'texinfo-format 'texinfo-discard-line)
+
+
+;;; @today
+
+(put 'today 'texinfo-format 'texinfo-format-today)
+
+;; Produces Day Month Year style of output. eg `1 Jan 1900'
+;; The `@today{}' command requires a pair of braces, like `@dots{}'.
+(defun texinfo-format-today ()
+ (texinfo-parse-arg-discard)
+ (insert (format "%s %s %s"
+ (substring (current-time-string) 8 10)
+ (substring (current-time-string) 4 7)
+ (substring (current-time-string) -4))))
+
+
+;;; @ignore
+
+(put 'ignore 'texinfo-format 'texinfo-format-ignore)
+(defun texinfo-format-ignore ()
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end ignore[ \t]*\n")
+ (point))))
+
+(put 'endignore 'texinfo-format 'texinfo-discard-line)
+
+
+;;; Define the Info enclosure command: @definfoenclose
+
+;; A `@definfoenclose' command may be used to define a highlighting
+;; command for Info, but not for TeX. A command defined using
+;; `@definfoenclose' marks text by enclosing it in strings that precede
+;; and follow the text.
+;;
+;; Presumably, if you define a command with `@definfoenclose` for Info,
+;; you will also define the same command in the TeX definitions file,
+;; `texinfo.tex' in a manner appropriate for typesetting.
+;;
+;; Write a `@definfoenclose' command on a line and follow it with three
+;; arguments separated by commas (commas are used as separators in an
+;; `@node' line in the same way). The first argument to
+;; `@definfoenclose' is the @-command name \(without the `@'\); the
+;; second argument is the Info start delimiter string; and the third
+;; argument is the Info end delimiter string. The latter two arguments
+;; enclose the highlighted text in the Info file. A delimiter string
+;; may contain spaces. Neither the start nor end delimiter is
+;; required. However, if you do not provide a start delimiter, you
+;; must follow the command name with two commas in a row; otherwise,
+;; the Info formatting commands will misinterpret the end delimiter
+;; string as a start delimiter string.
+;;
+;; If you do a @definfoenclose{} on the name of a pre-defined macro (such
+;; as @emph{}, @strong{}, @tt{}, or @i{}) the enclosure definition will
+;; override the built-in definition.
+;;
+;; An enclosure command defined this way takes one argument in braces.
+;;
+;; For example, you can write:
+;;
+;; @ifinfo
+;; @definfoenclose phoo, //, \\
+;; @end ifinfo
+;;
+;; near the beginning of a Texinfo file at the beginning of the lines
+;; to define `@phoo' as an Info formatting command that inserts `//'
+;; before and `\\' after the argument to `@phoo'. You can then write
+;; `@phoo{bar}' wherever you want `//bar\\' highlighted in Info.
+;;
+;; Also, for TeX formatting, you could write
+;;
+;; @iftex
+;; @global@let@phoo=@i
+;; @end iftex
+;;
+;; to define `@phoo' as a command that causes TeX to typeset
+;; the argument to `@phoo' in italics.
+;;
+;; Note that each definition applies to its own formatter: one for TeX,
+;; the other for texinfo-format-buffer or texinfo-format-region.
+;;
+;; Here is another example: write
+;;
+;; @definfoenclose headword, , :
+;;
+;; near the beginning of the file, to define `@headword' as an Info
+;; formatting command that inserts nothing before and a colon after the
+;; argument to `@headword'.
+
+(put 'definfoenclose 'texinfo-format 'texinfo-define-info-enclosure)
+(defun texinfo-define-info-enclosure ()
+ (let* ((args (texinfo-format-parse-line-args))
+ (command-name (nth 0 args))
+ (beginning-delimiter (or (nth 1 args) ""))
+ (end-delimiter (or (nth 2 args) "")))
+ (texinfo-discard-command)
+ (setq texinfo-enclosure-list
+ (cons
+ (list command-name
+ (list
+ beginning-delimiter
+ end-delimiter))
+ texinfo-enclosure-list))))
+
+
+;;; @var, @code and the like
+
+(put 'var 'texinfo-format 'texinfo-format-var)
+;; @sc a small caps font for TeX; formatted as `var' in Info
+(put 'sc 'texinfo-format 'texinfo-format-var)
+(defun texinfo-format-var ()
+ (insert (upcase (texinfo-parse-arg-discard)))
+ (goto-char texinfo-command-start))
+
+(put 'url 'texinfo-format 'texinfo-format-code)
+(put 'cite 'texinfo-format 'texinfo-format-code)
+(put 'code 'texinfo-format 'texinfo-format-code)
+(put 'file 'texinfo-format 'texinfo-format-code)
+(put 'samp 'texinfo-format 'texinfo-format-code)
+(defun texinfo-format-code ()
+ (insert "`" (texinfo-parse-arg-discard) "'")
+ (goto-char texinfo-command-start))
+
+(put 'emph 'texinfo-format 'texinfo-format-emph)
+(put 'strong 'texinfo-format 'texinfo-format-emph)
+(defun texinfo-format-emph ()
+ (insert "*" (texinfo-parse-arg-discard) "*")
+ (goto-char texinfo-command-start))
+
+(put 'dfn 'texinfo-format 'texinfo-format-defn)
+(put 'defn 'texinfo-format 'texinfo-format-defn)
+(defun texinfo-format-defn ()
+ (insert "\"" (texinfo-parse-arg-discard) "\"")
+ (goto-char texinfo-command-start))
+
+(put 'email 'texinfo-format 'texinfo-format-key)
+(put 'key 'texinfo-format 'texinfo-format-key)
+(defun texinfo-format-key ()
+ (insert "<" (texinfo-parse-arg-discard) ">")
+ (goto-char texinfo-command-start))
+
+(put 'bullet 'texinfo-format 'texinfo-format-bullet)
+(defun texinfo-format-bullet ()
+ "Insert an asterisk.
+If used within a line, follow `@bullet' with braces."
+ (texinfo-optional-braces-discard)
+ (insert "*"))
+
+
+;;; @kbd
+
+;; Inside of @example ... @end example and similar environments,
+;; @kbd does nothing; but outside of such environments, it places
+;; single quotation markes around its argument.
+
+(defvar texinfo-format-kbd-regexp
+ (concat
+ "^@"
+ "\\("
+ "example\\|"
+ "smallexample\\|"
+ "lisp\\|"
+ "smalllisp"
+ "\\)")
+ "Regexp specifying environments in which @kbd does not put `...'
+ around argument.")
+
+(defvar texinfo-format-kbd-end-regexp
+ (concat
+ "^@end "
+ "\\("
+ "example\\|"
+ "smallexample\\|"
+ "lisp\\|"
+ "smalllisp"
+ "\\)")
+ "Regexp specifying end of environments in which @kbd does not put `...'
+ around argument. (See `texinfo-format-kbd-regexp')")
+
+(put 'kbd 'texinfo-format 'texinfo-format-kbd)
+(defun texinfo-format-kbd ()
+ "Place single quote marks around arg, except in @example and similar."
+ ;; Search forward for @end example closer than an @example.
+ ;; Can stop search at nearest @node or texinfo-section-types-regexp
+ (let* ((stop
+ (save-excursion
+ (re-search-forward
+ (concat "^@node\\|\\(" texinfo-section-types-regexp "\\)")
+ nil
+ 'move-to-end) ; if necessary, return point at end of buffer
+ (point)))
+ (example-location
+ (save-excursion
+ (re-search-forward texinfo-format-kbd-regexp stop 'move-to-end)
+ (point)))
+ (end-example-location
+ (save-excursion
+ (re-search-forward texinfo-format-kbd-end-regexp stop 'move-to-end)
+ (point))))
+ ;; If inside @example, @end example will be closer than @example
+ ;; or end of search i.e., end-example-location less than example-location
+ (if (>= end-example-location example-location)
+ ;; outside an @example or equivalent
+ (insert "`" (texinfo-parse-arg-discard) "'")
+ ;; else, in @example; do not surround with `...'
+ (insert (texinfo-parse-arg-discard)))
+ (goto-char texinfo-command-start)))
+
+
+;;; @example, @lisp, @quotation, @display, @smalllisp, @smallexample
+
+(put 'display 'texinfo-format 'texinfo-format-example)
+(put 'example 'texinfo-format 'texinfo-format-example)
+(put 'lisp 'texinfo-format 'texinfo-format-example)
+(put 'quotation 'texinfo-format 'texinfo-format-example)
+(put 'smallexample 'texinfo-format 'texinfo-format-example)
+(put 'smalllisp 'texinfo-format 'texinfo-format-example)
+(defun texinfo-format-example ()
+ (texinfo-push-stack 'example nil)
+ (setq fill-column (- fill-column 5))
+ (texinfo-discard-line))
+
+(put 'example 'texinfo-end 'texinfo-end-example)
+(put 'display 'texinfo-end 'texinfo-end-example)
+(put 'lisp 'texinfo-end 'texinfo-end-example)
+(put 'quotation 'texinfo-end 'texinfo-end-example)
+(put 'smallexample 'texinfo-end 'texinfo-end-example)
+(put 'smalllisp 'texinfo-end 'texinfo-end-example)
+(defun texinfo-end-example ()
+ (setq fill-column (+ fill-column 5))
+ (texinfo-discard-command)
+ (let ((stacktop
+ (texinfo-pop-stack 'example)))
+ (texinfo-do-itemize (nth 1 stacktop))))
+
+(put 'exdent 'texinfo-format 'texinfo-format-exdent)
+(defun texinfo-format-exdent ()
+ (texinfo-discard-command)
+ (delete-region (point)
+ (progn
+ (skip-chars-forward " ")
+ (point)))
+ (insert ?\b)
+ ;; Cancel out the deletion that texinfo-do-itemize
+ ;; is going to do at the end of this line.
+ (save-excursion
+ (end-of-line)
+ (insert "\n ")))
+
+
+;;; @cartouche
+
+;; The @cartouche command is a noop in Info; in a printed manual,
+;; it makes a box with rounded corners.
+
+(put 'cartouche 'texinfo-format 'texinfo-discard-line)
+(put 'cartouche 'texinfo-end 'texinfo-discard-command)
+
+
+;;; @flushleft and @format
+
+;; The @flushleft command left justifies every line but leaves the
+;; right end ragged. As far as Info is concerned, @flushleft is a
+;; `do-nothing' command
+
+;; The @format command is similar to @example except that it does not
+;; indent; this means that in Info, @format is similar to @flushleft.
+
+(put 'format 'texinfo-format 'texinfo-format-flushleft)
+(put 'flushleft 'texinfo-format 'texinfo-format-flushleft)
+(defun texinfo-format-flushleft ()
+ (texinfo-discard-line))
+
+(put 'format 'texinfo-end 'texinfo-end-flushleft)
+(put 'flushleft 'texinfo-end 'texinfo-end-flushleft)
+(defun texinfo-end-flushleft ()
+ (texinfo-discard-command))
+
+
+;;; @flushright
+
+;; The @flushright command right justifies every line but leaves the
+;; left end ragged. Spaces and tabs at the right ends of lines are
+;; removed so that visible text lines up on the right side.
+
+(put 'flushright 'texinfo-format 'texinfo-format-flushright)
+(defun texinfo-format-flushright ()
+ (texinfo-push-stack 'flushright nil)
+ (texinfo-discard-line))
+
+(put 'flushright 'texinfo-end 'texinfo-end-flushright)
+(defun texinfo-end-flushright ()
+ (texinfo-discard-command)
+
+ (let ((stacktop
+ (texinfo-pop-stack 'flushright)))
+
+ (texinfo-do-flushright (nth 1 stacktop))))
+
+(defun texinfo-do-flushright (from)
+ (save-excursion
+ (while (progn (forward-line -1)
+ (>= (point) from))
+
+ (beginning-of-line)
+ (insert
+ (make-string
+ (- fill-column
+ (save-excursion
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (delete-region (point) (progn (end-of-line) (point)))
+ (current-column)))
+ ? )))))
+
+
+;;; @ctrl, @TeX, @copyright, @minus, @dots, @enddots, @pounds
+
+(put 'ctrl 'texinfo-format 'texinfo-format-ctrl)
+(defun texinfo-format-ctrl ()
+ (let ((str (texinfo-parse-arg-discard)))
+ (insert (logand 31 (aref str 0)))))
+
+(put 'TeX 'texinfo-format 'texinfo-format-TeX)
+(defun texinfo-format-TeX ()
+ (texinfo-parse-arg-discard)
+ (insert "TeX"))
+
+(put 'copyright 'texinfo-format 'texinfo-format-copyright)
+(defun texinfo-format-copyright ()
+ (texinfo-parse-arg-discard)
+ (insert "(C)"))
+
+(put 'minus 'texinfo-format 'texinfo-format-minus)
+(defun texinfo-format-minus ()
+ "Insert a minus sign.
+If used within a line, follow `@minus' with braces."
+ (texinfo-optional-braces-discard)
+ (insert "-"))
+
+(put 'dots 'texinfo-format 'texinfo-format-dots)
+(defun texinfo-format-dots ()
+ (texinfo-parse-arg-discard)
+ (insert "..."))
+
+(put 'enddots 'texinfo-format 'texinfo-format-enddots)
+(defun texinfo-format-enddots ()
+ (texinfo-parse-arg-discard)
+ (insert "...."))
+
+(put 'pounds 'texinfo-format 'texinfo-format-pounds)
+(defun texinfo-format-pounds ()
+ (texinfo-parse-arg-discard)
+ (insert "#"))
+
+
+;;; Refilling and indenting: @refill, @paragraphindent, @noindent
+
+;;; Indent only those paragraphs that are refilled as a result of an
+;;; @refill command.
+
+;; * If the value is `asis', do not change the existing indentation at
+;; the starts of paragraphs.
+
+;; * If the value zero, delete any existing indentation.
+
+;; * If the value is greater than zero, indent each paragraph by that
+;; number of spaces.
+
+;;; But do not refill paragraphs with an @refill command that are
+;;; preceded by @noindent or are part of a table, list, or deffn.
+
+(defvar texinfo-paragraph-indent "asis"
+ "Number of spaces for @refill to indent a paragraph; else to leave as is.")
+
+(put 'paragraphindent 'texinfo-format 'texinfo-paragraphindent)
+
+(defun texinfo-paragraphindent ()
+ "Specify the number of spaces for @refill to indent a paragraph.
+Default is to leave the number of spaces as is."
+ (let ((arg (texinfo-parse-arg-discard)))
+ (if (string= "asis" arg)
+ (setq texinfo-paragraph-indent "asis")
+ (setq texinfo-paragraph-indent (string-to-int arg)))))
+
+(put 'refill 'texinfo-format 'texinfo-format-refill)
+(defun texinfo-format-refill ()
+ "Refill paragraph. Also, indent first line as set by @paragraphindent.
+Default is to leave paragraph indentation as is."
+ (texinfo-discard-command)
+ (forward-paragraph -1)
+ (if (looking-at "[ \t\n]*$") (forward-line 1))
+ ;; Do not indent if an entry in a list, table, or deffn,
+ ;; or if paragraph is preceded by @noindent.
+ ;; Otherwise, indent
+ (cond
+ ;; delete a @noindent line and do not indent paragraph
+ ((save-excursion (forward-line -1)
+ (looking-at "^@noindent"))
+ (forward-line -1)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ;; do nothing if "asis"
+ ((equal texinfo-paragraph-indent "asis"))
+ ;; do no indenting in list, etc.
+ ((> texinfo-stack-depth 0))
+ ;; otherwise delete existing whitespace and indent
+ (t
+ (delete-region (point) (progn (skip-chars-forward " \t") (point)))
+ (insert (make-string texinfo-paragraph-indent ? ))))
+ (forward-paragraph 1)
+ (forward-line -1)
+ (end-of-line)
+ ;; Do not fill a section title line with asterisks, hyphens, etc. that
+ ;; are used to underline it. This could occur if the line following
+ ;; the underlining is not an index entry and has text within it.
+ (let* ((previous-paragraph-separate paragraph-separate)
+ (paragraph-separate
+ (concat paragraph-separate "\\|[-=.]+\\|\\*\\*+"))
+ (previous-paragraph-start paragraph-start)
+ (paragraph-start
+ (concat paragraph-start "\\|[-=.]+\\|\\*\\*+")))
+ (unwind-protect
+ (fill-paragraph nil)
+ (setq paragraph-separate previous-paragraph-separate)
+ (setq paragraph-start previous-paragraph-start))))
+
+(put 'noindent 'texinfo-format 'texinfo-noindent)
+(defun texinfo-noindent ()
+ (save-excursion
+ (forward-paragraph 1)
+ (if (search-backward "@refill"
+ (save-excursion (forward-line -1) (point)) t)
+ () ; leave @noindent command so @refill command knows not to indent
+ ;; else
+ (texinfo-discard-line))))
+
+
+;;; Index generation
+
+(put 'vindex 'texinfo-format 'texinfo-format-vindex)
+(defun texinfo-format-vindex ()
+ (texinfo-index 'texinfo-vindex))
+
+(put 'cindex 'texinfo-format 'texinfo-format-cindex)
+(defun texinfo-format-cindex ()
+ (texinfo-index 'texinfo-cindex))
+
+(put 'findex 'texinfo-format 'texinfo-format-findex)
+(defun texinfo-format-findex ()
+ (texinfo-index 'texinfo-findex))
+
+(put 'pindex 'texinfo-format 'texinfo-format-pindex)
+(defun texinfo-format-pindex ()
+ (texinfo-index 'texinfo-pindex))
+
+(put 'tindex 'texinfo-format 'texinfo-format-tindex)
+(defun texinfo-format-tindex ()
+ (texinfo-index 'texinfo-tindex))
+
+(put 'kindex 'texinfo-format 'texinfo-format-kindex)
+(defun texinfo-format-kindex ()
+ (texinfo-index 'texinfo-kindex))
+
+(defun texinfo-index (indexvar)
+ (let ((arg (texinfo-parse-expanded-arg)))
+ (texinfo-discard-command)
+ (set indexvar
+ (cons (list arg
+ texinfo-last-node
+ ;; Region formatting may not provide last node position.
+ (if texinfo-last-node-pos
+ (1+ (count-lines texinfo-last-node-pos (point)))
+ 1))
+ (symbol-value indexvar)))))
+
+(defconst texinfo-indexvar-alist
+ '(("cp" . texinfo-cindex)
+ ("fn" . texinfo-findex)
+ ("vr" . texinfo-vindex)
+ ("tp" . texinfo-tindex)
+ ("pg" . texinfo-pindex)
+ ("ky" . texinfo-kindex)))
+
+
+;;; @defindex @defcodeindex
+(put 'defindex 'texinfo-format 'texinfo-format-defindex)
+(put 'defcodeindex 'texinfo-format 'texinfo-format-defindex)
+
+(defun texinfo-format-defindex ()
+ (let* ((index-name (texinfo-parse-arg-discard)) ; eg: `aa'
+ (indexing-command (intern (concat index-name "index")))
+ (index-formatting-command ; eg: `texinfo-format-aaindex'
+ (intern (concat "texinfo-format-" index-name "index")))
+ (index-alist-name ; eg: `texinfo-aaindex'
+ (intern (concat "texinfo-" index-name "index"))))
+
+ (set index-alist-name nil)
+
+ (put indexing-command ; eg, aaindex
+ 'texinfo-format
+ index-formatting-command) ; eg, texinfo-format-aaindex
+
+ ;; eg: "aa" . texinfo-aaindex
+ (or (assoc index-name texinfo-indexvar-alist)
+ (setq texinfo-indexvar-alist
+ (cons
+ (cons index-name
+ index-alist-name)
+ texinfo-indexvar-alist)))
+
+ (fset index-formatting-command
+ (list 'lambda 'nil
+ (list 'texinfo-index
+ (list 'quote index-alist-name))))))
+
+
+;;; @synindex @syncodeindex
+
+(put 'synindex 'texinfo-format 'texinfo-format-synindex)
+(put 'syncodeindex 'texinfo-format 'texinfo-format-synindex)
+
+(defun texinfo-format-synindex ()
+ (let* ((args (texinfo-parse-arg-discard))
+ (second (cdr (read-from-string args)))
+ (joiner (symbol-name (car (read-from-string args))))
+ (joined (symbol-name (car (read-from-string args second)))))
+
+ (if (assoc joiner texinfo-short-index-cmds-alist)
+ (put
+ (cdr (assoc joiner texinfo-short-index-cmds-alist))
+ 'texinfo-format
+ (or (cdr (assoc joined texinfo-short-index-format-cmds-alist))
+ (intern (concat "texinfo-format-" joined "index"))))
+ (put
+ (intern (concat joiner "index"))
+ 'texinfo-format
+ (or (cdr(assoc joined texinfo-short-index-format-cmds-alist))
+ (intern (concat "texinfo-format-" joined "index")))))))
+
+(defconst texinfo-short-index-cmds-alist
+ '(("cp" . cindex)
+ ("fn" . findex)
+ ("vr" . vindex)
+ ("tp" . tindex)
+ ("pg" . pindex)
+ ("ky" . kindex)))
+
+(defconst texinfo-short-index-format-cmds-alist
+ '(("cp" . texinfo-format-cindex)
+ ("fn" . texinfo-format-findex)
+ ("vr" . texinfo-format-vindex)
+ ("tp" . texinfo-format-tindex)
+ ("pg" . texinfo-format-pindex)
+ ("ky" . texinfo-format-kindex)))
+
+
+;;; Sort and index (for VMS)
+
+;; Sort an index which is in the current buffer between START and END.
+;; Used on VMS, where the `sort' utility is not available.
+(defun texinfo-sort-region (start end)
+ (require 'sort)
+ (save-restriction
+ (narrow-to-region start end)
+ (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun)))
+
+;; Subroutine for sorting an index.
+;; At start of a line, return a string to sort the line under.
+(defun texinfo-sort-startkeyfun ()
+ (let ((line
+ (buffer-substring (point) (save-excursion (end-of-line) (point)))))
+ ;; Canonicalize whitespace and eliminate funny chars.
+ (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line)
+ (setq line (concat (substring line 0 (match-beginning 0))
+ " "
+ (substring line (match-end 0) (length line)))))
+ line))
+
+
+;;; @printindex
+
+(put 'printindex 'texinfo-format 'texinfo-format-printindex)
+
+(defun texinfo-format-printindex ()
+ (let ((indexelts (symbol-value
+ (cdr (assoc (texinfo-parse-arg-discard)
+ texinfo-indexvar-alist))))
+ opoint)
+ (insert "\n* Menu:\n\n")
+ (setq opoint (point))
+ (texinfo-print-index nil indexelts)
+
+ (if (memq system-type '(vax-vms windows-nt ms-dos))
+ (texinfo-sort-region opoint (point))
+ (shell-command-on-region opoint (point) "sort -fd" 1))))
+
+(defun texinfo-print-index (file indexelts)
+ (while indexelts
+ (if (stringp (car (car indexelts)))
+ (progn
+ (insert "* " (car (car indexelts)) ": " )
+ (indent-to 32)
+ (insert
+ (if file (concat "(" file ")") "")
+ (nth 1 (car indexelts)) ".")
+ (indent-to 54)
+ (insert
+ (if (nth 2 (car indexelts))
+ (format " %d." (nth 2 (car indexelts)))
+ "")
+ "\n"))
+ ;; index entries from @include'd file
+ (texinfo-print-index (nth 1 (car indexelts))
+ (nth 2 (car indexelts))))
+ (setq indexelts (cdr indexelts))))
+
+
+;;; Glyphs: @equiv, @error, etc
+
+;; @equiv to show that two expressions are equivalent
+;; @error to show an error message
+;; @expansion to show what a macro expands to
+;; @point to show the location of point in an example
+;; @print to show what an evaluated expression prints
+;; @result to indicate the value returned by an expression
+
+(put 'equiv 'texinfo-format 'texinfo-format-equiv)
+(defun texinfo-format-equiv ()
+ (texinfo-parse-arg-discard)
+ (insert "=="))
+
+(put 'error 'texinfo-format 'texinfo-format-error)
+(defun texinfo-format-error ()
+ (texinfo-parse-arg-discard)
+ (insert "error-->"))
+
+(put 'expansion 'texinfo-format 'texinfo-format-expansion)
+(defun texinfo-format-expansion ()
+ (texinfo-parse-arg-discard)
+ (insert "==>"))
+
+(put 'point 'texinfo-format 'texinfo-format-point)
+(defun texinfo-format-point ()
+ (texinfo-parse-arg-discard)
+ (insert "-!-"))
+
+(put 'print 'texinfo-format 'texinfo-format-print)
+(defun texinfo-format-print ()
+ (texinfo-parse-arg-discard)
+ (insert "-|"))
+
+(put 'result 'texinfo-format 'texinfo-format-result)
+(defun texinfo-format-result ()
+ (texinfo-parse-arg-discard)
+ (insert "=>"))
+
+
+;;; Accent commands
+
+;; Info presumes a plain ASCII output, so the accented characters do
+;; not look as they would if typeset, or output with a different
+;; character set.
+
+;; See the `texinfo-accent-commands' variable
+;; in the section for `texinfo-append-refill'.
+;; Also, see the defun for `texinfo-format-scan'
+;; for single-character accent commands.
+
+;; Command Info output Name
+
+;; These do not have braces:
+;; @^ ==> ^ circumflex accent
+;; @` ==> ` grave accent
+;; @' ==> ' acute accent
+;; @" ==> " umlaut accent
+;; @= ==> = overbar accent
+;; @~ ==> ~ tilde accent
+
+;; These have braces, but take no argument:
+;; @OE{} ==> OE French-OE-ligature
+;; @oe{} ==> oe
+;; @AA{} ==> AA Scandinavian-A-with-circle
+;; @aa{} ==> aa
+;; @AE{} ==> AE Latin-Scandinavian-AE
+;; @ae{} ==> ae
+;; @ss{} ==> ss German-sharp-S
+
+;; @questiondown{} ==> ? upside-down-question-mark
+;; @exclamdown{} ==> ! upside-down-exclamation-mark
+;; @L{} ==> L/ Polish suppressed-L (Lslash)
+;; @l{} ==> l/ Polish suppressed-L (Lslash) (lower case)
+;; @O{} ==> O/ Scandinavian O-with-slash
+;; @o{} ==> o/ Scandinavian O-with-slash (lower case)
+
+;; These have braces, and take an argument:
+;; @,{c} ==> c, cedilla accent
+;; @dotaccent{o} ==> .o overdot-accent
+;; @ubaraccent{o} ==> _o underbar-accent
+;; @udotaccent{o} ==> o-. underdot-accent
+;; @H{o} ==> ""o long Hungarian umlaut
+;; @ringaccent{o} ==> *o ring accent
+;; @tieaccent{oo} ==> [oo tie after accent
+;; @u{o} ==> (o breve accent
+;; @v{o} ==> <o hacek accent
+;; @dotless{i} ==> i dotless i and dotless j
+
+;; ==========
+
+;; Note: The defun texinfo-format-scan
+;; looks at "[@{}^'`\",=~ *?!-]"
+;; In the case of @*, a line break is inserted;
+;; in the other cases, the characters are simply quoted and the @ is deleted.
+;; Thus, `texinfo-format-scan' handles the following
+;; single-character accent commands: @^ @` @' @" @, @- @= @~
+
+;; @^ ==> ^ circumflex accent
+;; (put '^ 'texinfo-format 'texinfo-format-circumflex-accent)
+;; (defun texinfo-format-circumflex-accent ()
+;; (texinfo-discard-command)
+;; (insert "^"))
+;;
+;; @` ==> ` grave accent
+;; (put '\` 'texinfo-format 'texinfo-format-grave-accent)
+;; (defun texinfo-format-grave-accent ()
+;; (texinfo-discard-command)
+;; (insert "\`"))
+;;
+;; @' ==> ' acute accent
+;; (put '\' 'texinfo-format 'texinfo-format-acute-accent)
+;; (defun texinfo-format-acute-accent ()
+;; (texinfo-discard-command)
+;; (insert "'"))
+;;
+;; @" ==> " umlaut accent
+;; (put '\" 'texinfo-format 'texinfo-format-umlaut-accent)
+;; (defun texinfo-format-umlaut-accent ()
+;; (texinfo-discard-command)
+;; (insert "\""))
+;;
+;; @= ==> = overbar accent
+;; (put '= 'texinfo-format 'texinfo-format-overbar-accent)
+;; (defun texinfo-format-overbar-accent ()
+;; (texinfo-discard-command)
+;; (insert "="))
+;;
+;; @~ ==> ~ tilde accent
+;; (put '~ 'texinfo-format 'texinfo-format-tilde-accent)
+;; (defun texinfo-format-tilde-accent ()
+;; (texinfo-discard-command)
+;; (insert "~"))
+
+;; @OE{} ==> OE French-OE-ligature
+(put 'OE 'texinfo-format 'texinfo-format-French-OE-ligature)
+(defun texinfo-format-French-OE-ligature ()
+ (insert "OE" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @oe{} ==> oe
+(put 'oe 'texinfo-format 'texinfo-format-French-oe-ligature)
+(defun texinfo-format-French-oe-ligature () ; lower case
+ (insert "oe" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @AA{} ==> AA Scandinavian-A-with-circle
+(put 'AA 'texinfo-format 'texinfo-format-Scandinavian-A-with-circle)
+(defun texinfo-format-Scandinavian-A-with-circle ()
+ (insert "AA" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @aa{} ==> aa
+(put 'aa 'texinfo-format 'texinfo-format-Scandinavian-a-with-circle)
+(defun texinfo-format-Scandinavian-a-with-circle () ; lower case
+ (insert "aa" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @AE{} ==> AE Latin-Scandinavian-AE
+(put 'AE 'texinfo-format 'texinfo-format-Latin-Scandinavian-AE)
+(defun texinfo-format-Latin-Scandinavian-AE ()
+ (insert "AE" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @ae{} ==> ae
+(put 'ae 'texinfo-format 'texinfo-format-Latin-Scandinavian-ae)
+(defun texinfo-format-Latin-Scandinavian-ae () ; lower case
+ (insert "ae" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @ss{} ==> ss German-sharp-S
+(put 'ss 'texinfo-format 'texinfo-format-German-sharp-S)
+(defun texinfo-format-German-sharp-S ()
+ (insert "ss" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @questiondown{} ==> ? upside-down-question-mark
+(put 'questiondown 'texinfo-format 'texinfo-format-upside-down-question-mark)
+(defun texinfo-format-upside-down-question-mark ()
+ (insert "?" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @exclamdown{} ==> ! upside-down-exclamation-mark
+(put 'exclamdown 'texinfo-format 'texinfo-format-upside-down-exclamation-mark)
+(defun texinfo-format-upside-down-exclamation-mark ()
+ (insert "!" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @L{} ==> L/ Polish suppressed-L (Lslash)
+(put 'L 'texinfo-format 'texinfo-format-Polish-suppressed-L)
+(defun texinfo-format-Polish-suppressed-L ()
+ (insert (texinfo-parse-arg-discard) "/L")
+ (goto-char texinfo-command-start))
+
+;; @l{} ==> l/ Polish suppressed-L (Lslash) (lower case)
+(put 'l 'texinfo-format 'texinfo-format-Polish-suppressed-l-lower-case)
+(defun texinfo-format-Polish-suppressed-l-lower-case ()
+ (insert (texinfo-parse-arg-discard) "/l")
+ (goto-char texinfo-command-start))
+
+
+;; @O{} ==> O/ Scandinavian O-with-slash
+(put 'O 'texinfo-format 'texinfo-format-Scandinavian-O-with-slash)
+(defun texinfo-format-Scandinavian-O-with-slash ()
+ (insert (texinfo-parse-arg-discard) "O/")
+ (goto-char texinfo-command-start))
+
+;; @o{} ==> o/ Scandinavian O-with-slash (lower case)
+(put 'o 'texinfo-format 'texinfo-format-Scandinavian-o-with-slash-lower-case)
+(defun texinfo-format-Scandinavian-o-with-slash-lower-case ()
+ (insert (texinfo-parse-arg-discard) "o/")
+ (goto-char texinfo-command-start))
+
+;; Take arguments
+
+;; @,{c} ==> c, cedilla accent
+(put ', 'texinfo-format 'texinfo-format-cedilla-accent)
+(defun texinfo-format-cedilla-accent ()
+ (insert (texinfo-parse-arg-discard) ",")
+ (goto-char texinfo-command-start))
+
+
+;; @dotaccent{o} ==> .o overdot-accent
+(put 'dotaccent 'texinfo-format 'texinfo-format-overdot-accent)
+(defun texinfo-format-overdot-accent ()
+ (insert "." (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @ubaraccent{o} ==> _o underbar-accent
+(put 'ubaraccent 'texinfo-format 'texinfo-format-underbar-accent)
+(defun texinfo-format-underbar-accent ()
+ (insert "_" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @udotaccent{o} ==> o-. underdot-accent
+(put 'udotaccent 'texinfo-format 'texinfo-format-underdot-accent)
+(defun texinfo-format-underdot-accent ()
+ (insert (texinfo-parse-arg-discard) "-.")
+ (goto-char texinfo-command-start))
+
+;; @H{o} ==> ""o long Hungarian umlaut
+(put 'H 'texinfo-format 'texinfo-format-long-Hungarian-umlaut)
+(defun texinfo-format-long-Hungarian-umlaut ()
+ (insert "\"\"" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @ringaccent{o} ==> *o ring accent
+(put 'ringaccent 'texinfo-format 'texinfo-format-ring-accent)
+(defun texinfo-format-ring-accent ()
+ (insert "*" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @tieaccent{oo} ==> [oo tie after accent
+(put 'tieaccent 'texinfo-format 'texinfo-format-tie-after-accent)
+(defun texinfo-format-tie-after-accent ()
+ (insert "[" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+
+;; @u{o} ==> (o breve accent
+(put 'u 'texinfo-format 'texinfo-format-breve-accent)
+(defun texinfo-format-breve-accent ()
+ (insert "(" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @v{o} ==> <o hacek accent
+(put 'v 'texinfo-format 'texinfo-format-hacek-accent)
+(defun texinfo-format-hacek-accent ()
+ (insert "<" (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+
+;; @dotless{i} ==> i dotless i and dotless j
+(put 'dotless 'texinfo-format 'texinfo-format-dotless)
+(defun texinfo-format-dotless ()
+ (insert (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+
+;;; Definition formatting: @deffn, @defun, etc
+
+;; What definition formatting produces:
+;;
+;; @deffn category name args...
+;; In Info, `Category: name ARGS'
+;; In index: name: node. line#.
+;;
+;; @defvr category name
+;; In Info, `Category: name'
+;; In index: name: node. line#.
+;;
+;; @deftp category name attributes...
+;; `category name attributes...' Note: @deftp args in lower case.
+;; In index: name: node. line#.
+;;
+;; Specialized function-like or variable-like entity:
+;;
+;; @defun, @defmac, @defspec, @defvar, @defopt
+;;
+;; @defun name args In Info, `Function: name ARGS'
+;; @defmac name args In Info, `Macro: name ARGS'
+;; @defvar name In Info, `Variable: name'
+;; etc.
+;; In index: name: node. line#.
+;;
+;; Generalized typed-function-like or typed-variable-like entity:
+;; @deftypefn category data-type name args...
+;; In Info, `Category: data-type name args...'
+;; @deftypevr category data-type name
+;; In Info, `Category: data-type name'
+;; In index: name: node. line#.
+;;
+;; Specialized typed-function-like or typed-variable-like entity:
+;; @deftypefun data-type name args...
+;; In Info, `Function: data-type name ARGS'
+;; In index: name: node. line#.
+;;
+;; @deftypevar data-type name
+;; In Info, `Variable: data-type name'
+;; In index: name: node. line#. but include args after name!?
+;;
+;; Generalized object oriented entity:
+;; @defop category class name args...
+;; In Info, `Category on class: name ARG'
+;; In index: name on class: node. line#.
+;;
+;; @defcv category class name
+;; In Info, `Category of class: name'
+;; In index: name of class: node. line#.
+;;
+;; Specialized object oriented entity:
+;; @defmethod class name args...
+;; In Info, `Method on class: name ARGS'
+;; In index: name on class: node. line#.
+;;
+;; @defivar class name
+;; In Info, `Instance variable of class: name'
+;; In index: name of class: node. line#.
+
+
+;;; The definition formatting functions
+
+(defun texinfo-format-defun ()
+ (texinfo-push-stack 'defun nil)
+ (setq fill-column (- fill-column 5))
+ (texinfo-format-defun-1 t))
+
+(defun texinfo-end-defun ()
+ (setq fill-column (+ fill-column 5))
+ (texinfo-discard-command)
+ (let ((start (nth 1 (texinfo-pop-stack 'defun))))
+ (texinfo-do-itemize start)
+ ;; Delete extra newline inserted after header.
+ (save-excursion
+ (goto-char start)
+ (delete-char -1))))
+
+(defun texinfo-format-defunx ()
+ (texinfo-format-defun-1 nil))
+
+(defun texinfo-format-defun-1 (first-p)
+ (let ((parse-args (texinfo-format-parse-defun-args))
+ (texinfo-defun-type (get texinfo-command-name 'texinfo-defun-type)))
+ (texinfo-discard-command)
+ ;; Delete extra newline inserted after previous header line.
+ (if (not first-p)
+ (delete-char -1))
+ (funcall
+ (get texinfo-command-name 'texinfo-deffn-formatting-property) parse-args)
+ ;; Insert extra newline so that paragraph filling does not mess
+ ;; with header line.
+ (insert "\n\n")
+ (rplaca (cdr (cdr (car texinfo-stack))) (point))
+ (funcall
+ (get texinfo-command-name 'texinfo-defun-indexing-property) parse-args)))
+
+;;; Formatting the first line of a definition
+
+;; @deffn, @defvr, @deftp
+(put 'deffn 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
+(put 'deffnx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
+(put 'defvr 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
+(put 'defvrx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
+(put 'deftp 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
+(put 'deftpx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
+(defun texinfo-format-deffn (parsed-args)
+ ;; Generalized function-like, variable-like, or generic data-type entity:
+ ;; @deffn category name args...
+ ;; In Info, `Category: name ARGS'
+ ;; @deftp category name attributes...
+ ;; `category name attributes...' Note: @deftp args in lower case.
+ (let ((category (car parsed-args))
+ (name (car (cdr parsed-args)))
+ (args (cdr (cdr parsed-args))))
+ (insert " -- " category ": " name)
+ (while args
+ (insert " "
+ (if (or (= ?& (aref (car args) 0))
+ (eq (eval (car texinfo-defun-type)) 'deftp-type))
+ (car args)
+ (upcase (car args))))
+ (setq args (cdr args)))))
+
+;; @defun, @defmac, @defspec, @defvar, @defopt: Specialized, simple
+(put 'defun 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defunx 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defmac 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defmacx 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defspec 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defspecx 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defvar 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defvarx 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defopt 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(put 'defoptx 'texinfo-deffn-formatting-property
+ 'texinfo-format-specialized-defun)
+(defun texinfo-format-specialized-defun (parsed-args)
+ ;; Specialized function-like or variable-like entity:
+ ;; @defun name args In Info, `Function: Name ARGS'
+ ;; @defmac name args In Info, `Macro: Name ARGS'
+ ;; @defvar name In Info, `Variable: Name'
+ ;; Use cdr of texinfo-defun-type to determine category:
+ (let ((category (car (cdr texinfo-defun-type)))
+ (name (car parsed-args))
+ (args (cdr parsed-args)))
+ (insert " -- " category ": " name)
+ (while args
+ (insert " "
+ (if (= ?& (aref (car args) 0))
+ (car args)
+ (upcase (car args))))
+ (setq args (cdr args)))))
+
+;; @deftypefn, @deftypevr: Generalized typed
+(put 'deftypefn 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
+(put 'deftypefnx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
+(put 'deftypevr 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
+(put 'deftypevrx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
+(defun texinfo-format-deftypefn (parsed-args)
+ ;; Generalized typed-function-like or typed-variable-like entity:
+ ;; @deftypefn category data-type name args...
+ ;; In Info, `Category: data-type name args...'
+ ;; @deftypevr category data-type name
+ ;; In Info, `Category: data-type name'
+ ;; Note: args in lower case, unless modified in command line.
+ (let ((category (car parsed-args))
+ (data-type (car (cdr parsed-args)))
+ (name (car (cdr (cdr parsed-args))))
+ (args (cdr (cdr (cdr parsed-args)))))
+ (insert " -- " category ": " data-type " " name)
+ (while args
+ (insert " " (car args))
+ (setq args (cdr args)))))
+
+;; @deftypefun, @deftypevar: Specialized typed
+(put 'deftypefun 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun)
+(put 'deftypefunx 'texinfo-deffn-formatting-property
+ 'texinfo-format-deftypefun)
+(put 'deftypevar 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun)
+(put 'deftypevarx 'texinfo-deffn-formatting-property
+ 'texinfo-format-deftypefun)
+(defun texinfo-format-deftypefun (parsed-args)
+ ;; Specialized typed-function-like or typed-variable-like entity:
+ ;; @deftypefun data-type name args...
+ ;; In Info, `Function: data-type name ARGS'
+ ;; @deftypevar data-type name
+ ;; In Info, `Variable: data-type name'
+ ;; Note: args in lower case, unless modified in command line.
+ ;; Use cdr of texinfo-defun-type to determine category:
+ (let ((category (car (cdr texinfo-defun-type)))
+ (data-type (car parsed-args))
+ (name (car (cdr parsed-args)))
+ (args (cdr (cdr parsed-args))))
+ (insert " -- " category ": " data-type " " name)
+ (while args
+ (insert " " (car args))
+ (setq args (cdr args)))))
+
+;; @defop: Generalized object-oriented
+(put 'defop 'texinfo-deffn-formatting-property 'texinfo-format-defop)
+(put 'defopx 'texinfo-deffn-formatting-property 'texinfo-format-defop)
+(defun texinfo-format-defop (parsed-args)
+ ;; Generalized object oriented entity:
+ ;; @defop category class name args...
+ ;; In Info, `Category on class: name ARG'
+ ;; Note: args in upper case; use of `on'
+ (let ((category (car parsed-args))
+ (class (car (cdr parsed-args)))
+ (name (car (cdr (cdr parsed-args))))
+ (args (cdr (cdr (cdr parsed-args)))))
+ (insert " -- " category " on " class ": " name)
+ (while args
+ (insert " " (upcase (car args)))
+ (setq args (cdr args)))))
+
+;; @defcv: Generalized object-oriented
+(put 'defcv 'texinfo-deffn-formatting-property 'texinfo-format-defcv)
+(put 'defcvx 'texinfo-deffn-formatting-property 'texinfo-format-defcv)
+(defun texinfo-format-defcv (parsed-args)
+ ;; Generalized object oriented entity:
+ ;; @defcv category class name
+ ;; In Info, `Category of class: name'
+ ;; Note: args in upper case; use of `of'
+ (let ((category (car parsed-args))
+ (class (car (cdr parsed-args)))
+ (name (car (cdr (cdr parsed-args))))
+ (args (cdr (cdr (cdr parsed-args)))))
+ (insert " -- " category " of " class ": " name)
+ (while args
+ (insert " " (upcase (car args)))
+ (setq args (cdr args)))))
+
+;; @defmethod: Specialized object-oriented
+(put 'defmethod 'texinfo-deffn-formatting-property 'texinfo-format-defmethod)
+(put 'defmethodx 'texinfo-deffn-formatting-property 'texinfo-format-defmethod)
+(defun texinfo-format-defmethod (parsed-args)
+ ;; Specialized object oriented entity:
+ ;; @defmethod class name args...
+ ;; In Info, `Method on class: name ARGS'
+ ;; Note: args in upper case; use of `on'
+ ;; Use cdr of texinfo-defun-type to determine category:
+ (let ((category (car (cdr texinfo-defun-type)))
+ (class (car parsed-args))
+ (name (car (cdr parsed-args)))
+ (args (cdr (cdr parsed-args))))
+ (insert " -- " category " on " class ": " name)
+ (while args
+ (insert " " (upcase (car args)))
+ (setq args (cdr args)))))
+
+;; @defivar: Specialized object-oriented
+(put 'defivar 'texinfo-deffn-formatting-property 'texinfo-format-defivar)
+(put 'defivarx 'texinfo-deffn-formatting-property 'texinfo-format-defivar)
+(defun texinfo-format-defivar (parsed-args)
+ ;; Specialized object oriented entity:
+ ;; @defivar class name
+ ;; In Info, `Instance variable of class: name'
+ ;; Note: args in upper case; use of `of'
+ ;; Use cdr of texinfo-defun-type to determine category:
+ (let ((category (car (cdr texinfo-defun-type)))
+ (class (car parsed-args))
+ (name (car (cdr parsed-args)))
+ (args (cdr (cdr parsed-args))))
+ (insert " -- " category " of " class ": " name)
+ (while args
+ (insert " " (upcase (car args)))
+ (setq args (cdr args)))))
+
+
+;;; Indexing for definitions
+
+;; An index entry has three parts: the `entry proper', the node name, and the
+;; line number. Depending on the which command is used, the entry is
+;; formatted differently:
+;;
+;; @defun,
+;; @defmac,
+;; @defspec,
+;; @defvar,
+;; @defopt all use their 1st argument as the entry-proper
+;;
+;; @deffn,
+;; @defvr,
+;; @deftp
+;; @deftypefun
+;; @deftypevar all use their 2nd argument as the entry-proper
+;;
+;; @deftypefn,
+;; @deftypevr both use their 3rd argument as the entry-proper
+;;
+;; @defmethod uses its 2nd and 1st arguments as an entry-proper
+;; formatted: NAME on CLASS
+
+;; @defop uses its 3rd and 2nd arguments as an entry-proper
+;; formatted: NAME on CLASS
+;;
+;; @defivar uses its 2nd and 1st arguments as an entry-proper
+;; formatted: NAME of CLASS
+;;
+;; @defcv uses its 3rd and 2nd argument as an entry-proper
+;; formatted: NAME of CLASS
+
+(put 'defun 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defunx 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defmac 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defmacx 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defspec 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defspecx 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defvar 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defvarx 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defopt 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(put 'defoptx 'texinfo-defun-indexing-property 'texinfo-index-defun)
+(defun texinfo-index-defun (parsed-args)
+ ;; use 1st parsed-arg as entry-proper
+ ;; `index-list' will be texinfo-findex or the like
+ (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
+ (set index-list
+ (cons
+ ;; Three elements: entry-proper, node-name, line-number
+ (list
+ (car parsed-args)
+ texinfo-last-node
+ ;; Region formatting may not provide last node position.
+ (if texinfo-last-node-pos
+ (1+ (count-lines texinfo-last-node-pos (point)))
+ 1))
+ (symbol-value index-list)))))
+
+(put 'deffn 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'deffnx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'defvr 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'defvrx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'deftp 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'deftpx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'deftypefun 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'deftypefunx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'deftypevar 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(put 'deftypevarx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
+(defun texinfo-index-deffn (parsed-args)
+ ;; use 2nd parsed-arg as entry-proper
+ ;; `index-list' will be texinfo-findex or the like
+ (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
+ (set index-list
+ (cons
+ ;; Three elements: entry-proper, node-name, line-number
+ (list
+ (car (cdr parsed-args))
+ texinfo-last-node
+ ;; Region formatting may not provide last node position.
+ (if texinfo-last-node-pos
+ (1+ (count-lines texinfo-last-node-pos (point)))
+ 1))
+ (symbol-value index-list)))))
+
+(put 'deftypefn 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
+(put 'deftypefnx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
+(put 'deftypevr 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
+(put 'deftypevrx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
+(defun texinfo-index-deftypefn (parsed-args)
+ ;; use 3rd parsed-arg as entry-proper
+ ;; `index-list' will be texinfo-findex or the like
+ (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
+ (set index-list
+ (cons
+ ;; Three elements: entry-proper, node-name, line-number
+ (list
+ (car (cdr (cdr parsed-args)))
+ texinfo-last-node
+ ;; Region formatting may not provide last node position.
+ (if texinfo-last-node-pos
+ (1+ (count-lines texinfo-last-node-pos (point)))
+ 1))
+ (symbol-value index-list)))))
+
+(put 'defmethod 'texinfo-defun-indexing-property 'texinfo-index-defmethod)
+(put 'defmethodx 'texinfo-defun-indexing-property 'texinfo-index-defmethod)
+(defun texinfo-index-defmethod (parsed-args)
+ ;; use 2nd on 1st parsed-arg as entry-proper
+ ;; `index-list' will be texinfo-findex or the like
+ (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
+ (set index-list
+ (cons
+ ;; Three elements: entry-proper, node-name, line-number
+ (list
+ (format "%s on %s"
+ (car (cdr parsed-args))
+ (car parsed-args))
+ texinfo-last-node
+ ;; Region formatting may not provide last node position.
+ (if texinfo-last-node-pos
+ (1+ (count-lines texinfo-last-node-pos (point)))
+ 1))
+ (symbol-value index-list)))))
+
+(put 'defop 'texinfo-defun-indexing-property 'texinfo-index-defop)
+(put 'defopx 'texinfo-defun-indexing-property 'texinfo-index-defop)
+(defun texinfo-index-defop (parsed-args)
+ ;; use 3rd on 2nd parsed-arg as entry-proper
+ ;; `index-list' will be texinfo-findex or the like
+ (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
+ (set index-list
+ (cons
+ ;; Three elements: entry-proper, node-name, line-number
+ (list
+ (format "%s on %s"
+ (car (cdr (cdr parsed-args)))
+ (car (cdr parsed-args)))
+ texinfo-last-node
+ ;; Region formatting may not provide last node position.
+ (if texinfo-last-node-pos
+ (1+ (count-lines texinfo-last-node-pos (point)))
+ 1))
+ (symbol-value index-list)))))
+
+(put 'defivar 'texinfo-defun-indexing-property 'texinfo-index-defivar)
+(put 'defivarx 'texinfo-defun-indexing-property 'texinfo-index-defivar)
+(defun texinfo-index-defivar (parsed-args)
+ ;; use 2nd of 1st parsed-arg as entry-proper
+ ;; `index-list' will be texinfo-findex or the like
+ (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
+ (set index-list
+ (cons
+ ;; Three elements: entry-proper, node-name, line-number
+ (list
+ (format "%s of %s"
+ (car (cdr parsed-args))
+ (car parsed-args))
+ texinfo-last-node
+ ;; Region formatting may not provide last node position.
+ (if texinfo-last-node-pos
+ (1+ (count-lines texinfo-last-node-pos (point)))
+ 1))
+ (symbol-value index-list)))))
+
+(put 'defcv 'texinfo-defun-indexing-property 'texinfo-index-defcv)
+(put 'defcvx 'texinfo-defun-indexing-property 'texinfo-index-defcv)
+(defun texinfo-index-defcv (parsed-args)
+ ;; use 3rd of 2nd parsed-arg as entry-proper
+ ;; `index-list' will be texinfo-findex or the like
+ (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
+ (set index-list
+ (cons
+ ;; Three elements: entry-proper, node-name, line-number
+ (list
+ (format "%s of %s"
+ (car (cdr (cdr parsed-args)))
+ (car (cdr parsed-args)))
+ texinfo-last-node
+ ;; Region formatting may not provide last node position.
+ (if texinfo-last-node-pos
+ (1+ (count-lines texinfo-last-node-pos (point)))
+ 1))
+ (symbol-value index-list)))))
+
+
+;;; Properties for definitions
+
+;; Each definition command has six properties:
+;;
+;; 1. texinfo-deffn-formatting-property to format definition line
+;; 2. texinfo-defun-indexing-property to create index entry
+;; 3. texinfo-format formatting command
+;; 4. texinfo-end end formatting command
+;; 5. texinfo-defun-type type of deffn to format
+;; 6. texinfo-defun-index type of index to use
+;;
+;; The `x' forms of each definition command are used for the second
+;; and subsequent header lines.
+
+;; The texinfo-deffn-formatting-property and texinfo-defun-indexing-property
+;; are listed just before the appropriate formatting and indexing commands.
+
+(put 'deffn 'texinfo-format 'texinfo-format-defun)
+(put 'deffnx 'texinfo-format 'texinfo-format-defunx)
+(put 'deffn 'texinfo-end 'texinfo-end-defun)
+(put 'deffn 'texinfo-defun-type '('deffn-type nil))
+(put 'deffnx 'texinfo-defun-type '('deffn-type nil))
+(put 'deffn 'texinfo-defun-index 'texinfo-findex)
+(put 'deffnx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'defun 'texinfo-format 'texinfo-format-defun)
+(put 'defunx 'texinfo-format 'texinfo-format-defunx)
+(put 'defun 'texinfo-end 'texinfo-end-defun)
+(put 'defun 'texinfo-defun-type '('defun-type "Function"))
+(put 'defunx 'texinfo-defun-type '('defun-type "Function"))
+(put 'defun 'texinfo-defun-index 'texinfo-findex)
+(put 'defunx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'defmac 'texinfo-format 'texinfo-format-defun)
+(put 'defmacx 'texinfo-format 'texinfo-format-defunx)
+(put 'defmac 'texinfo-end 'texinfo-end-defun)
+(put 'defmac 'texinfo-defun-type '('defun-type "Macro"))
+(put 'defmacx 'texinfo-defun-type '('defun-type "Macro"))
+(put 'defmac 'texinfo-defun-index 'texinfo-findex)
+(put 'defmacx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'defspec 'texinfo-format 'texinfo-format-defun)
+(put 'defspecx 'texinfo-format 'texinfo-format-defunx)
+(put 'defspec 'texinfo-end 'texinfo-end-defun)
+(put 'defspec 'texinfo-defun-type '('defun-type "Special form"))
+(put 'defspecx 'texinfo-defun-type '('defun-type "Special form"))
+(put 'defspec 'texinfo-defun-index 'texinfo-findex)
+(put 'defspecx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'defvr 'texinfo-format 'texinfo-format-defun)
+(put 'defvrx 'texinfo-format 'texinfo-format-defunx)
+(put 'defvr 'texinfo-end 'texinfo-end-defun)
+(put 'defvr 'texinfo-defun-type '('deffn-type nil))
+(put 'defvrx 'texinfo-defun-type '('deffn-type nil))
+(put 'defvr 'texinfo-defun-index 'texinfo-vindex)
+(put 'defvrx 'texinfo-defun-index 'texinfo-vindex)
+
+(put 'defvar 'texinfo-format 'texinfo-format-defun)
+(put 'defvarx 'texinfo-format 'texinfo-format-defunx)
+(put 'defvar 'texinfo-end 'texinfo-end-defun)
+(put 'defvar 'texinfo-defun-type '('defun-type "Variable"))
+(put 'defvarx 'texinfo-defun-type '('defun-type "Variable"))
+(put 'defvar 'texinfo-defun-index 'texinfo-vindex)
+(put 'defvarx 'texinfo-defun-index 'texinfo-vindex)
+
+(put 'defconst 'texinfo-format 'texinfo-format-defun)
+(put 'defconstx 'texinfo-format 'texinfo-format-defunx)
+(put 'defconst 'texinfo-end 'texinfo-end-defun)
+(put 'defconst 'texinfo-defun-type '('defun-type "Constant"))
+(put 'defconstx 'texinfo-defun-type '('defun-type "Constant"))
+(put 'defconst 'texinfo-defun-index 'texinfo-vindex)
+(put 'defconstx 'texinfo-defun-index 'texinfo-vindex)
+
+(put 'defcmd 'texinfo-format 'texinfo-format-defun)
+(put 'defcmdx 'texinfo-format 'texinfo-format-defunx)
+(put 'defcmd 'texinfo-end 'texinfo-end-defun)
+(put 'defcmd 'texinfo-defun-type '('defun-type "Command"))
+(put 'defcmdx 'texinfo-defun-type '('defun-type "Command"))
+(put 'defcmd 'texinfo-defun-index 'texinfo-findex)
+(put 'defcmdx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'defopt 'texinfo-format 'texinfo-format-defun)
+(put 'defoptx 'texinfo-format 'texinfo-format-defunx)
+(put 'defopt 'texinfo-end 'texinfo-end-defun)
+(put 'defopt 'texinfo-defun-type '('defun-type "User Option"))
+(put 'defoptx 'texinfo-defun-type '('defun-type "User Option"))
+(put 'defopt 'texinfo-defun-index 'texinfo-vindex)
+(put 'defoptx 'texinfo-defun-index 'texinfo-vindex)
+
+(put 'deftp 'texinfo-format 'texinfo-format-defun)
+(put 'deftpx 'texinfo-format 'texinfo-format-defunx)
+(put 'deftp 'texinfo-end 'texinfo-end-defun)
+(put 'deftp 'texinfo-defun-type '('deftp-type nil))
+(put 'deftpx 'texinfo-defun-type '('deftp-type nil))
+(put 'deftp 'texinfo-defun-index 'texinfo-tindex)
+(put 'deftpx 'texinfo-defun-index 'texinfo-tindex)
+
+;;; Object-oriented stuff is a little hairier.
+
+(put 'defop 'texinfo-format 'texinfo-format-defun)
+(put 'defopx 'texinfo-format 'texinfo-format-defunx)
+(put 'defop 'texinfo-end 'texinfo-end-defun)
+(put 'defop 'texinfo-defun-type '('defop-type nil))
+(put 'defopx 'texinfo-defun-type '('defop-type nil))
+(put 'defop 'texinfo-defun-index 'texinfo-findex)
+(put 'defopx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'defmethod 'texinfo-format 'texinfo-format-defun)
+(put 'defmethodx 'texinfo-format 'texinfo-format-defunx)
+(put 'defmethod 'texinfo-end 'texinfo-end-defun)
+(put 'defmethod 'texinfo-defun-type '('defmethod-type "Method"))
+(put 'defmethodx 'texinfo-defun-type '('defmethod-type "Method"))
+(put 'defmethod 'texinfo-defun-index 'texinfo-findex)
+(put 'defmethodx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'defcv 'texinfo-format 'texinfo-format-defun)
+(put 'defcvx 'texinfo-format 'texinfo-format-defunx)
+(put 'defcv 'texinfo-end 'texinfo-end-defun)
+(put 'defcv 'texinfo-defun-type '('defop-type nil))
+(put 'defcvx 'texinfo-defun-type '('defop-type nil))
+(put 'defcv 'texinfo-defun-index 'texinfo-vindex)
+(put 'defcvx 'texinfo-defun-index 'texinfo-vindex)
+
+(put 'defivar 'texinfo-format 'texinfo-format-defun)
+(put 'defivarx 'texinfo-format 'texinfo-format-defunx)
+(put 'defivar 'texinfo-end 'texinfo-end-defun)
+(put 'defivar 'texinfo-defun-type '('defmethod-type "Instance variable"))
+(put 'defivarx 'texinfo-defun-type '('defmethod-type "Instance variable"))
+(put 'defivar 'texinfo-defun-index 'texinfo-vindex)
+(put 'defivarx 'texinfo-defun-index 'texinfo-vindex)
+
+;;; Typed functions and variables
+
+(put 'deftypefn 'texinfo-format 'texinfo-format-defun)
+(put 'deftypefnx 'texinfo-format 'texinfo-format-defunx)
+(put 'deftypefn 'texinfo-end 'texinfo-end-defun)
+(put 'deftypefn 'texinfo-defun-type '('deftypefn-type nil))
+(put 'deftypefnx 'texinfo-defun-type '('deftypefn-type nil))
+(put 'deftypefn 'texinfo-defun-index 'texinfo-findex)
+(put 'deftypefnx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'deftypefun 'texinfo-format 'texinfo-format-defun)
+(put 'deftypefunx 'texinfo-format 'texinfo-format-defunx)
+(put 'deftypefun 'texinfo-end 'texinfo-end-defun)
+(put 'deftypefun 'texinfo-defun-type '('deftypefun-type "Function"))
+(put 'deftypefunx 'texinfo-defun-type '('deftypefun-type "Function"))
+(put 'deftypefun 'texinfo-defun-index 'texinfo-findex)
+(put 'deftypefunx 'texinfo-defun-index 'texinfo-findex)
+
+(put 'deftypevr 'texinfo-format 'texinfo-format-defun)
+(put 'deftypevrx 'texinfo-format 'texinfo-format-defunx)
+(put 'deftypevr 'texinfo-end 'texinfo-end-defun)
+(put 'deftypevr 'texinfo-defun-type '('deftypefn-type nil))
+(put 'deftypevrx 'texinfo-defun-type '('deftypefn-type nil))
+(put 'deftypevr 'texinfo-defun-index 'texinfo-vindex)
+(put 'deftypevrx 'texinfo-defun-index 'texinfo-vindex)
+
+(put 'deftypevar 'texinfo-format 'texinfo-format-defun)
+(put 'deftypevarx 'texinfo-format 'texinfo-format-defunx)
+(put 'deftypevar 'texinfo-end 'texinfo-end-defun)
+(put 'deftypevar 'texinfo-defun-type '('deftypevar-type "Variable"))
+(put 'deftypevarx 'texinfo-defun-type '('deftypevar-type "Variable"))
+(put 'deftypevar 'texinfo-defun-index 'texinfo-vindex)
+(put 'deftypevarx 'texinfo-defun-index 'texinfo-vindex)
+
+
+;;; @set, @clear, @ifset, @ifclear
+
+;; If a flag is set with @set FLAG, then text between @ifset and @end
+;; ifset is formatted normally, but if the flag is is cleared with
+;; @clear FLAG, then the text is not formatted; it is ignored.
+
+;; If a flag is cleared with @clear FLAG, then text between @ifclear
+;; and @end ifclear is formatted normally, but if the flag is is set with
+;; @set FLAG, then the text is not formatted; it is ignored. @ifclear
+;; is the opposite of @ifset.
+
+;; If a flag is set to a string with @set FLAG,
+;; replace @value{FLAG} with the string.
+;; If a flag with a value is cleared,
+;; @value{FLAG} is invalid,
+;; as if there had never been any @set FLAG previously.
+
+(put 'clear 'texinfo-format 'texinfo-clear)
+(defun texinfo-clear ()
+ "Clear the value of the flag."
+ (let* ((arg (texinfo-parse-arg-discard))
+ (flag (car (read-from-string arg)))
+ (value (substring arg (cdr (read-from-string arg)))))
+ (put flag 'texinfo-whether-setp 'flag-cleared)
+ (put flag 'texinfo-set-value "")))
+
+(put 'set 'texinfo-format 'texinfo-set)
+(defun texinfo-set ()
+ "Set the value of the flag, optionally to a string.
+The command `@set foo This is a string.'
+sets flag foo to the value: `This is a string.'
+The command `@value{foo}' expands to the value."
+ (let* ((arg (texinfo-parse-arg-discard))
+ (flag (car (read-from-string arg)))
+ (value (substring arg (cdr (read-from-string arg)))))
+ (put flag 'texinfo-whether-setp 'flag-set)
+ (put flag 'texinfo-set-value value)))
+
+(put 'value 'texinfo-format 'texinfo-value)
+(defun texinfo-value ()
+ "Insert the string to which the flag is set.
+The command `@set foo This is a string.'
+sets flag foo to the value: `This is a string.'
+The command `@value{foo}' expands to the value."
+ (let ((arg (texinfo-parse-arg-discard)))
+ (cond ((and
+ (eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
+ 'flag-set)
+ (get (car (read-from-string arg)) 'texinfo-set-value))
+ (insert (get (car (read-from-string arg)) 'texinfo-set-value)))
+ ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
+ 'flag-cleared)
+ (insert (format "{No value for \"%s\"}" arg)))
+ ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) nil)
+ (insert (format "{No value for \"%s\"}" arg))))))
+
+(put 'ifset 'texinfo-end 'texinfo-discard-command)
+(put 'ifset 'texinfo-format 'texinfo-if-set)
+(defun texinfo-if-set ()
+ "If set, continue formatting; else do not format region up to @end ifset"
+ (let ((arg (texinfo-parse-arg-discard)))
+ (cond
+ ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
+ 'flag-set)
+ ;; Format the text (i.e., do not remove it); do nothing here.
+ ())
+ ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
+ 'flag-cleared)
+ ;; Clear region (i.e., cause the text to be ignored).
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end ifset[ \t]*\n")
+ (point))))
+ ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
+ nil)
+ ;; In this case flag is neither set nor cleared.
+ ;; Act as if set, i.e. do nothing.
+ ()))))
+
+(put 'ifclear 'texinfo-end 'texinfo-discard-command)
+(put 'ifclear 'texinfo-format 'texinfo-if-clear)
+(defun texinfo-if-clear ()
+ "If clear, continue formatting; if set, do not format up to @end ifset"
+ (let ((arg (texinfo-parse-arg-discard)))
+ (cond
+ ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
+ 'flag-set)
+ ;; Clear region (i.e., cause the text to be ignored).
+ (delete-region texinfo-command-start
+ (progn (re-search-forward "@end ifclear[ \t]*\n")
+ (point))))
+ ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
+ 'flag-cleared)
+ ;; Format the text (i.e., do not remove it); do nothing here.
+ ())
+ ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
+ nil)
+ ;; In this case flag is neither set nor cleared.
+ ;; Act as if clear, i.e. do nothing.
+ ()))))
+
+
+;;; @ifeq
+
+(put 'ifeq 'texinfo-format 'texinfo-format-ifeq)
+(defun texinfo-format-ifeq ()
+ "If ARG1 and ARG2 caselessly string compare to same string, performs COMMAND.
+Otherwise produces no output.
+
+Thus:
+ @ifeq{ arg1 , arg1 , @code{foo}} bar
+
+ ==> `foo' bar.
+but
+ @ifeq{ arg1 , arg2 , @code{foo}} bar
+
+ ==> bar
+
+Note that the Texinfo command and its arguments must be arguments to
+the @ifeq command."
+ ;; compare-buffer-substrings does not exist in version 18; don't use
+ (goto-char texinfo-command-end)
+ (let* ((case-fold-search t)
+ (stop (save-excursion (forward-sexp 1) (point)))
+ start end
+ ;; @ifeq{arg1, arg2, @command{optional-args}}
+ (arg1
+ (progn
+ (forward-char 1)
+ (skip-chars-forward " ")
+ (setq start (point))
+ (search-forward "," stop t)
+ (skip-chars-backward ", ")
+ (buffer-substring start (point))))
+ (arg2
+ (progn
+ (search-forward "," stop t)
+ (skip-chars-forward " ")
+ (setq start (point))
+ (search-forward "," stop t)
+ (skip-chars-backward ", ")
+ (buffer-substring start (point))))
+ (texinfo-command
+ (progn
+ (search-forward "," stop t)
+ (skip-chars-forward " ")
+ (setq start (point))
+ (goto-char (1- stop))
+ (skip-chars-backward " ")
+ (buffer-substring start (point)))))
+ (delete-region texinfo-command-start stop)
+ (if (equal arg1 arg2)
+ (insert texinfo-command))
+ (goto-char texinfo-command-start)))
+
+
+;;; Process included files: `@include' command
+
+;; Updated 19 October 1990
+;; In the original version, include files were ignored by Info but
+;; incorporated in to the printed manual. To make references to the
+;; included file, the Texinfo source file has to refer to the included
+;; files using the `(filename)nodename' format for referring to other
+;; Info files. Also, the included files had to be formatted on their
+;; own. It was just like they were another file.
+
+;; Currently, include files are inserted into the buffer that is
+;; formatted for Info. If large, the resulting info file is split and
+;; tagified. For current include files to work, the master menu must
+;; refer to all the nodes, and the highest level nodes in the include
+;; files must have the correct next, prev, and up pointers.
+
+;; The included file may have an @setfilename and even an @settitle,
+;; but not an `\input texinfo' line.
+
+;; Updated 24 March 1993
+;; In order for @raisesections and @lowersections to work, included
+;; files must be inserted into the buffer holding the outer file
+;; before other Info formatting takes place. So @include is no longer
+;; is treated like other @-commands.
+(put 'include 'texinfo-format 'texinfo-format-noop)
+
+;; Original definition:
+;; (defun texinfo-format-include ()
+;; (let ((filename (texinfo-parse-arg-discard))
+;; (default-directory input-directory)
+;; subindex)
+;; (setq subindex
+;; (save-excursion
+;; (progn (find-file
+;; (cond ((file-readable-p (concat filename ".texinfo"))
+;; (concat filename ".texinfo"))
+;; ((file-readable-p (concat filename ".texi"))
+;; (concat filename ".texi"))
+;; ((file-readable-p (concat filename ".tex"))
+;; (concat filename ".tex"))
+;; ((file-readable-p filename)
+;; filename)
+;; (t (error "@include'd file %s not found"
+;; filename))))
+;; (texinfo-format-buffer-1))))
+;; (texinfo-subindex 'texinfo-vindex (car subindex) (nth 1 subindex))
+;; (texinfo-subindex 'texinfo-findex (car subindex) (nth 2 subindex))
+;; (texinfo-subindex 'texinfo-cindex (car subindex) (nth 3 subindex))
+;; (texinfo-subindex 'texinfo-pindex (car subindex) (nth 4 subindex))
+;; (texinfo-subindex 'texinfo-tindex (car subindex) (nth 5 subindex))
+;; (texinfo-subindex 'texinfo-kindex (car subindex) (nth 6 subindex))))
+;;
+;;(defun texinfo-subindex (indexvar file content)
+;; (set indexvar (cons (list 'recurse file content)
+;; (symbol-value indexvar))))
+
+;; Second definition:
+;; (put 'include 'texinfo-format 'texinfo-format-include)
+;; (defun texinfo-format-include ()
+;; (let ((filename (concat input-directory
+;; (texinfo-parse-arg-discard)))
+;; (default-directory input-directory))
+;; (message "Reading: %s" filename)
+;; (save-excursion
+;; (save-restriction
+;; (narrow-to-region
+;; (point)
+;; (+ (point) (car (cdr (insert-file-contents filename)))))
+;; (goto-char (point-min))
+;; (texinfo-append-refill)
+;; (texinfo-format-convert (point-min) (point-max))))
+;; (setq last-input-buffer input-buffer) ; to bypass setfilename
+;; ))
+
+
+;;; Numerous commands do nothing in Info
+;; These commands are defined in texinfo.tex for printed output.
+
+
+;;; various noops, such as @b{foo}, that take arguments in braces
+
+(put 'b 'texinfo-format 'texinfo-format-noop)
+(put 'i 'texinfo-format 'texinfo-format-noop)
+(put 'r 'texinfo-format 'texinfo-format-noop)
+(put 't 'texinfo-format 'texinfo-format-noop)
+(put 'w 'texinfo-format 'texinfo-format-noop)
+(put 'asis 'texinfo-format 'texinfo-format-noop)
+(put 'dmn 'texinfo-format 'texinfo-format-noop)
+(put 'math 'texinfo-format 'texinfo-format-noop)
+(put 'titlefont 'texinfo-format 'texinfo-format-noop)
+(defun texinfo-format-noop ()
+ (insert (texinfo-parse-arg-discard))
+ (goto-char texinfo-command-start))
+
+;; @hyphenation command discards an argument within braces
+(put 'hyphenation 'texinfo-format 'texinfo-discard-command-and-arg)
+(defun texinfo-discard-command-and-arg ()
+ "Discard both @-command and its argument in braces."
+ (goto-char texinfo-command-end)
+ (forward-list 1)
+ (setq texinfo-command-end (point))
+ (delete-region texinfo-command-start texinfo-command-end))
+
+
+;;; Do nothing commands, such as @smallbook, that have no args and no braces
+;; These must appear on a line of their own
+
+(put 'bye 'texinfo-format 'texinfo-discard-line)
+(put 'smallbook 'texinfo-format 'texinfo-discard-line)
+(put 'finalout 'texinfo-format 'texinfo-discard-line)
+(put 'overfullrule 'texinfo-format 'texinfo-discard-line)
+(put 'smallbreak 'texinfo-format 'texinfo-discard-line)
+(put 'medbreak 'texinfo-format 'texinfo-discard-line)
+(put 'bigbreak 'texinfo-format 'texinfo-discard-line)
+
+
+;;; These noop commands discard the rest of the line.
+
+(put 'c 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'comment 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'contents 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'group 'texinfo-end 'texinfo-discard-line-with-args)
+(put 'group 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'headings 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'setchapterstyle 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'hsize 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'itemindent 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'lispnarrowing 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'need 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'nopara 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'page 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'parindent 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'setq 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'settitle 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'setx 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'shortcontents 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'shorttitlepage 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'summarycontents 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'input 'texinfo-format 'texinfo-discard-line-with-args)
+(put 'dircategory 'texinfo-format 'texinfo-discard-line-with-args)
+
+
+;;; Some commands cannot be handled
+
+(defun texinfo-unsupported ()
+ (error "%s is not handled by texinfo"
+ (buffer-substring texinfo-command-start texinfo-command-end)))
+
+;;; Batch formatting
+
+(defun batch-texinfo-format ()
+ "Runs texinfo-format-buffer on the files remaining on the command line.
+Must be used only with -batch, and kills emacs on completion.
+Each file will be processed even if an error occurred previously.
+For example, invoke
+ \"emacs -batch -funcall batch-texinfo-format $docs/ ~/*.texinfo\"."
+ (if (not noninteractive)
+ (error "batch-texinfo-format may only be used -batch."))
+ (let ((version-control t)
+ (auto-save-default nil)
+ (find-file-run-dired nil)
+ (kept-old-versions 259259)
+ (kept-new-versions 259259))
+ (let ((error 0)
+ file
+ (files ()))
+ (while command-line-args-left
+ (setq file (expand-file-name (car command-line-args-left)))
+ (cond ((not (file-exists-p file))
+ (message ">> %s does not exist!" file)
+ (setq error 1
+ command-line-args-left (cdr command-line-args-left)))
+ ((file-directory-p file)
+ (setq command-line-args-left
+ (nconc (directory-files file)
+ (cdr command-line-args-left))))
+ (t
+ (setq files (cons file files)
+ command-line-args-left (cdr command-line-args-left)))))
+ (while files
+ (setq file (car files)
+ files (cdr files))
+ (condition-case err
+ (progn
+ (if buffer-file-name (kill-buffer (current-buffer)))
+ (find-file file)
+ (buffer-disable-undo (current-buffer))
+ (set-buffer-modified-p nil)
+ (texinfo-mode)
+ (message "texinfo formatting %s..." file)
+ (texinfo-format-buffer nil)
+ (if (buffer-modified-p)
+ (progn (message "Saving modified %s" (buffer-file-name))
+ (save-buffer))))
+ (error
+ (message ">> Error: %s" (prin1-to-string err))
+ (message ">> point at")
+ (let ((s (buffer-substring (point)
+ (min (+ (point) 100)
+ (point-max))))
+ (tem 0))
+ (while (setq tem (string-match "\n+" s tem))
+ (setq s (concat (substring s 0 (match-beginning 0))
+ "\n>> "
+ (substring s (match-end 0)))
+ tem (1+ tem)))
+ (message ">> %s" s))
+ (setq error 1))))
+ (kill-emacs error))))
+
+
+;;; Place `provide' at end of file.
+(provide 'texinfmt)
+
+;;; texinfmt.el ends here.
diff --git a/texinfo/emacs/texinfo.el b/texinfo/emacs/texinfo.el
new file mode 100644
index 00000000000..0a1ab13401e
--- /dev/null
+++ b/texinfo/emacs/texinfo.el
@@ -0,0 +1,932 @@
+;;; texinfo.el--major mode for editing Texinfo files.
+
+;; Copyright (C) 1985, '88, '89, '90, '91,
+;; '92, '93, '96 Free Software Foundation, Inc.
+
+;; Author: Robert J. Chassell
+;; Date: 6 Sep 1996
+;; Maintainer: bug-texinfo@prep.ai.mit.edu
+;; Keywords: maint, tex, docs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 Emacs 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 Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Autoloads:
+
+(autoload 'makeinfo-region
+ "makeinfo"
+ "Make Info file from region of current Texinfo file, and switch to it.
+
+This command does not offer the `next-error' feature since it would
+apply to a temporary file, not the original; use the `makeinfo-buffer'
+command to gain use of `next-error'."
+ t nil)
+
+(autoload 'makeinfo-buffer
+ "makeinfo"
+ "Make Info file from current buffer.
+
+Use the \\[next-error] command to move to the next error
+\(if there are errors\)."
+ t nil)
+
+(autoload 'kill-compilation
+ "compile"
+ "Kill the process made by the \\[compile] command."
+ t nil)
+
+(autoload 'makeinfo-recenter-compilation-buffer
+ "makeinfo"
+ "Redisplay `*compilation*' buffer so most recent output can be seen.
+The last line of the buffer is displayed on
+line LINE of the window, or centered if LINE is nil."
+ t nil)
+
+(autoload 'texinfo-update-node
+ "texnfo-upd"
+ "Without any prefix argument, update the node in which point is located.
+Non-nil argument (prefix, if interactive) means update the nodes in the
+marked region.
+
+The functions for creating or updating nodes and menus, and their
+keybindings, are:
+
+ texinfo-update-node (&optional region-p) \\[texinfo-update-node]
+ texinfo-every-node-update () \\[texinfo-every-node-update]
+ texinfo-sequential-node-update (&optional region-p)
+
+ texinfo-make-menu (&optional region-p) \\[texinfo-make-menu]
+ texinfo-all-menus-update () \\[texinfo-all-menus-update]
+ texinfo-master-menu ()
+
+ texinfo-indent-menu-description (column &optional region-p)
+
+The `texinfo-column-for-description' variable specifies the column to
+which menu descriptions are indented. Its default value is 32."
+ t nil)
+
+(autoload 'texinfo-every-node-update
+ "texnfo-upd"
+ "Update every node in a Texinfo file."
+ t nil)
+
+(autoload 'texinfo-sequential-node-update
+ "texnfo-upd"
+ "Update one node (or many) in a Texinfo file with sequential pointers.
+
+This function causes the `Next' or `Previous' pointer to point to the
+immediately preceding or following node, even if it is at a higher or
+lower hierarchical level in the document. Continually pressing `n' or
+`p' takes you straight through the file.
+
+Without any prefix argument, update the node in which point is located.
+Non-nil argument (prefix, if interactive) means update the nodes in the
+marked region.
+
+This command makes it awkward to navigate among sections and
+subsections; it should be used only for those documents that are meant
+to be read like a novel rather than a reference, and for which the
+Info `g*' command is inadequate."
+ t nil)
+
+(autoload 'texinfo-make-menu
+ "texnfo-upd"
+ "Without any prefix argument, make or update a menu.
+Make the menu for the section enclosing the node found following point.
+
+Non-nil argument (prefix, if interactive) means make or update menus
+for nodes within or part of the marked region.
+
+Whenever a menu exists, and is being updated, the descriptions that
+are associated with node names in the pre-existing menu are
+incorporated into the new menu. Otherwise, the nodes' section titles
+are inserted as descriptions."
+ t nil)
+
+(autoload 'texinfo-all-menus-update
+ "texnfo-upd"
+ "Update every regular menu in a Texinfo file.
+Remove pre-existing master menu, if there is one.
+
+If called with a non-nil argument, this function first updates all the
+nodes in the buffer before updating the menus."
+ t nil)
+
+(autoload 'texinfo-master-menu
+ "texnfo-upd"
+ "Make a master menu for a whole Texinfo file.
+Non-nil argument (prefix, if interactive) means first update all
+existing nodes and menus. Remove pre-existing master menu, if there is one.
+
+This function creates a master menu that follows the top node. The
+master menu includes every entry from all the other menus. It
+replaces any existing ordinary menu that follows the top node.
+
+If called with a non-nil argument, this function first updates all the
+menus in the buffer (incorporating descriptions from pre-existing
+menus) before it constructs the master menu.
+
+The function removes the detailed part of an already existing master
+menu. This action depends on the pre-existing master menu using the
+standard `texinfo-master-menu-header'.
+
+The master menu has the following format, which is adapted from the
+recommendation in the Texinfo Manual:
+
+ * The first part contains the major nodes in the Texinfo file: the
+ nodes for the chapters, chapter-like sections, and the major
+ appendices. This includes the indices, so long as they are in
+ chapter-like sections, such as unnumbered sections.
+
+ * The second and subsequent parts contain a listing of the other,
+ lower level menus, in order. This way, an inquirer can go
+ directly to a particular node if he or she is searching for
+ specific information.
+
+Each of the menus in the detailed node listing is introduced by the
+title of the section containing the menu."
+ t nil)
+
+(autoload 'texinfo-indent-menu-description
+ "texnfo-upd"
+ "Indent every description in menu following point to COLUMN.
+Non-nil argument (prefix, if interactive) means indent every
+description in every menu in the region. Does not indent second and
+subsequent lines of a multi-line description."
+ t nil)
+
+(autoload 'texinfo-insert-node-lines
+ "texnfo-upd"
+ "Insert missing `@node' lines in region of Texinfo file.
+Non-nil argument (prefix, if interactive) means also to insert the
+section titles as node names; and also to insert the section titles as
+node names in pre-existing @node lines that lack names."
+ t nil)
+
+(autoload 'texinfo-start-menu-description
+ "texnfo-upd"
+ "In this menu entry, insert the node's section title as a description.
+Position point at beginning of description ready for editing.
+Do not insert a title if the line contains an existing description.
+
+You will need to edit the inserted text since a useful description
+complements the node name rather than repeats it as a title does."
+ t nil)
+
+(autoload 'texinfo-multiple-files-update
+ "texnfo-upd"
+ "Update first node pointers in each file included in OUTER-FILE;
+create or update main menu in the outer file that refers to such nodes.
+This does not create or update menus or pointers within the included files.
+
+With optional MAKE-MASTER-MENU argument (prefix arg, if interactive),
+insert a master menu in OUTER-FILE. This does not create or update
+menus or pointers within the included files.
+
+With optional UPDATE-EVERYTHING argument (numeric prefix arg, if
+interactive), update all the menus and all the `Next', `Previous', and
+`Up' pointers of all the files included in OUTER-FILE before inserting
+a master menu in OUTER-FILE.
+
+The command also updates the `Top' level node pointers of OUTER-FILE.
+
+Notes:
+
+ * this command does NOT save any files--you must save the
+ outer file and any modified, included files.
+
+ * except for the `Top' node, this command does NOT handle any
+ pre-existing nodes in the outer file; hence, indices must be
+ enclosed in an included file.
+
+Requirements:
+
+ * each of the included files must contain exactly one highest
+ hierarchical level node,
+ * this highest node must be the first node in the included file,
+ * each highest hierarchical level node must be of the same type.
+
+Thus, normally, each included file contains one, and only one,
+chapter."
+ t nil)
+
+
+;;; Code:
+
+;;; Don't you dare insert any `require' calls at top level in this file--rms.
+
+;;; Syntax table
+
+(defvar texinfo-mode-syntax-table nil)
+
+(if texinfo-mode-syntax-table
+ nil
+ (setq texinfo-mode-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\" " " texinfo-mode-syntax-table)
+ (modify-syntax-entry ?\\ " " texinfo-mode-syntax-table)
+ (modify-syntax-entry ?@ "\\" texinfo-mode-syntax-table)
+ (modify-syntax-entry ?\^q "\\" texinfo-mode-syntax-table)
+ (modify-syntax-entry ?\[ "(]" texinfo-mode-syntax-table)
+ (modify-syntax-entry ?\] ")[" texinfo-mode-syntax-table)
+ (modify-syntax-entry ?{ "(}" texinfo-mode-syntax-table)
+ (modify-syntax-entry ?} "){" texinfo-mode-syntax-table)
+ (modify-syntax-entry ?\' "w" texinfo-mode-syntax-table))
+
+;; Written by Wolfgang Bangerth <zcg51122@rpool1.rus.uni-stuttgart.de>
+;; To override this example, set either `imenu-generic-expression'
+;; or `imenu-create-index-function'.
+(defvar texinfo-imenu-generic-expression
+ '((nil "^@node[ \t]+\\([^,\n]*\\)" 1)
+ ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1))
+
+ "Imenu generic expression for TexInfo mode. See `imenu-generic-expression'.")
+
+(defvar texinfo-font-lock-keywords
+ '(;; All but the first 2 had an OVERRIDE of t.
+ ;; It didn't seem to be any better, and it's slower--simon.
+ ("^\\(@c\\|@comment\\)\\>.*" . font-lock-comment-face) ;comments
+ ;; Robert J. Chassell <bob@gnu.ai.mit.edu> says remove this line.
+ ;("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t)
+ ("@\\([a-zA-Z]+\\|[^ \t\n]\\)" 1 font-lock-keyword-face) ;commands
+ ("^\\*\\(.*\\)[\t ]*$" 1 font-lock-function-name-face t) ;menu items
+ ("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face)
+ ("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face)
+ ("@\\(samp\\|code\\|var\\|math\\){\\([^}]+\\)"
+ 2 font-lock-variable-name-face)
+ ("@\\(cite\\|xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-reference-face)
+ ("@\\(end\\|itemx?\\) +\\(.+\\)" 2 font-lock-function-name-face keep)
+ )
+ "Additional expressions to highlight in TeXinfo mode.")
+
+(defvar texinfo-section-list
+ '(("top" 1)
+ ("majorheading" 1)
+ ("chapter" 2)
+ ("unnumbered" 2)
+ ("appendix" 2)
+ ("chapheading" 2)
+ ("section" 3)
+ ("unnumberedsec" 3)
+ ("appendixsec" 3)
+ ("heading" 3)
+ ("subsection" 4)
+ ("unnumberedsubsec" 4)
+ ("appendixsubsec" 4)
+ ("subheading" 4)
+ ("subsubsection" 5)
+ ("unnumberedsubsubsec" 5)
+ ("appendixsubsubsec" 5)
+ ("subsubheading" 5))
+ "Alist of sectioning commands and their relative level.")
+
+(defun texinfo-outline-level ()
+ ;; Calculate level of current texinfo outline heading.
+ (save-excursion
+ (if (bobp)
+ 0
+ (forward-char 1)
+ (let* ((word (buffer-substring-no-properties
+ (point) (progn (forward-word 1) (point))))
+ (entry (assoc word texinfo-section-list)))
+ (if entry
+ (nth 1 entry)
+ 5)))))
+
+
+;;; Keybindings
+(defvar texinfo-mode-map nil)
+
+;;; Keys common both to Texinfo mode and to TeX shell.
+
+(defun texinfo-define-common-keys (keymap)
+ "Define the keys both in Texinfo mode and in the texinfo-tex-shell."
+ (define-key keymap "\C-c\C-t\C-k" 'tex-kill-job)
+ (define-key keymap "\C-c\C-t\C-x" 'texinfo-quit-job)
+ (define-key keymap "\C-c\C-t\C-l" 'tex-recenter-output-buffer)
+ (define-key keymap "\C-c\C-t\C-d" 'texinfo-delete-from-print-queue)
+ (define-key keymap "\C-c\C-t\C-q" 'tex-show-print-queue)
+ (define-key keymap "\C-c\C-t\C-p" 'texinfo-tex-print)
+ (define-key keymap "\C-c\C-t\C-i" 'texinfo-texindex)
+
+ (define-key keymap "\C-c\C-t\C-r" 'texinfo-tex-region)
+ (define-key keymap "\C-c\C-t\C-b" 'texinfo-tex-buffer))
+
+;; Mode documentation displays commands in reverse order
+;; from how they are listed in the texinfo-mode-map.
+
+(if texinfo-mode-map
+ nil
+ (setq texinfo-mode-map (make-sparse-keymap))
+
+ ;; bindings for `texnfo-tex.el'
+ (texinfo-define-common-keys texinfo-mode-map)
+
+ ;; bindings for `makeinfo.el'
+ (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation)
+ (define-key texinfo-mode-map "\C-c\C-m\C-l"
+ 'makeinfo-recenter-compilation-buffer)
+ (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region)
+ (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer)
+
+ ;; bindings for `texinfmt.el'
+ (define-key texinfo-mode-map "\C-c\C-e\C-r" 'texinfo-format-region)
+ (define-key texinfo-mode-map "\C-c\C-e\C-b" 'texinfo-format-buffer)
+
+ ;; bindings for updating nodes and menus
+
+ (define-key texinfo-mode-map "\C-c\C-um" 'texinfo-master-menu)
+
+ (define-key texinfo-mode-map "\C-c\C-u\C-m" 'texinfo-make-menu)
+ (define-key texinfo-mode-map "\C-c\C-u\C-n" 'texinfo-update-node)
+ (define-key texinfo-mode-map "\C-c\C-u\C-e" 'texinfo-every-node-update)
+ (define-key texinfo-mode-map "\C-c\C-u\C-a" 'texinfo-all-menus-update)
+
+ (define-key texinfo-mode-map "\C-c\C-s" 'texinfo-show-structure)
+
+ (define-key texinfo-mode-map "\C-c}" 'up-list)
+ (define-key texinfo-mode-map "\C-c]" 'up-list)
+ (define-key texinfo-mode-map "\C-c{" 'texinfo-insert-braces)
+
+ ;; bindings for inserting strings
+
+ (define-key texinfo-mode-map "\C-c\C-c\C-d" 'texinfo-start-menu-description)
+
+ (define-key texinfo-mode-map "\C-c\C-cv" 'texinfo-insert-@var)
+ (define-key texinfo-mode-map "\C-c\C-ct" 'texinfo-insert-@table)
+ (define-key texinfo-mode-map "\C-c\C-cs" 'texinfo-insert-@samp)
+ (define-key texinfo-mode-map "\C-c\C-co" 'texinfo-insert-@noindent)
+ (define-key texinfo-mode-map "\C-c\C-cn" 'texinfo-insert-@node)
+ (define-key texinfo-mode-map "\C-c\C-ck" 'texinfo-insert-@kbd)
+ (define-key texinfo-mode-map "\C-c\C-ci" 'texinfo-insert-@item)
+ (define-key texinfo-mode-map "\C-c\C-cf" 'texinfo-insert-@file)
+ (define-key texinfo-mode-map "\C-c\C-cx" 'texinfo-insert-@example)
+ (define-key texinfo-mode-map "\C-c\C-ce" 'texinfo-insert-@end)
+ (define-key texinfo-mode-map "\C-c\C-cd" 'texinfo-insert-@dfn)
+ (define-key texinfo-mode-map "\C-c\C-cc" 'texinfo-insert-@code))
+
+
+;;; Texinfo mode
+
+(defvar texinfo-chapter-level-regexp
+ "chapter\\|unnumbered \\|appendix \\|majorheading\\|chapheading"
+ "Regular expression matching Texinfo chapter-level headings.
+This does not match `@node' and does not match the `@top' command.")
+
+;;;###autoload
+(defun texinfo-mode ()
+ "Major mode for editing Texinfo files.
+
+ It has these extra commands:
+\\{texinfo-mode-map}
+
+ These are files that are used as input for TeX to make printed manuals
+and also to be turned into Info files with \\[makeinfo-buffer] or
+the `makeinfo' program. These files must be written in a very restricted and
+modified version of TeX input format.
+
+ Editing commands are like text-mode except that the syntax table is
+set up so expression commands skip Texinfo bracket groups. To see
+what the Info version of a region of the Texinfo file will look like,
+use \\[makeinfo-region], which runs `makeinfo' on the current region.
+
+ You can show the structure of a Texinfo file with \\[texinfo-show-structure].
+This command shows the structure of a Texinfo file by listing the
+lines with the @-sign commands for @chapter, @section, and the like.
+These lines are displayed in another window called the *Occur* window.
+In that window, you can position the cursor over one of the lines and
+use \\[occur-mode-goto-occurrence], to jump to the corresponding spot
+in the Texinfo file.
+
+ In addition, Texinfo mode provides commands that insert various
+frequently used @-sign commands into the buffer. You can use these
+commands to save keystrokes. And you can insert balanced braces with
+\\[texinfo-insert-braces] and later use the command \\[up-list] to
+move forward past the closing brace.
+
+Also, Texinfo mode provides functions for automatically creating or
+updating menus and node pointers. These functions
+
+ * insert the `Next', `Previous' and `Up' pointers of a node,
+ * insert or update the menu for a section, and
+ * create a master menu for a Texinfo source file.
+
+Here are the functions:
+
+ texinfo-update-node \\[texinfo-update-node]
+ texinfo-every-node-update \\[texinfo-every-node-update]
+ texinfo-sequential-node-update
+
+ texinfo-make-menu \\[texinfo-make-menu]
+ texinfo-all-menus-update \\[texinfo-all-menus-update]
+ texinfo-master-menu
+
+ texinfo-indent-menu-description (column &optional region-p)
+
+The `texinfo-column-for-description' variable specifies the column to
+which menu descriptions are indented.
+
+Passed an argument (a prefix argument, if interactive), the
+`texinfo-update-node' and `texinfo-make-menu' functions do their jobs
+in the region.
+
+To use the updating commands, you must structure your Texinfo file
+hierarchically, such that each `@node' line, with the exception of the
+Top node, is accompanied by some kind of section line, such as an
+`@chapter' or `@section' line.
+
+If the file has a `top' node, it must be called `top' or `Top' and
+be the first node in the file.
+
+Entering Texinfo mode calls the value of text-mode-hook, and then the
+value of texinfo-mode-hook."
+ (interactive)
+ (text-mode)
+ (setq mode-name "Texinfo")
+ (setq major-mode 'texinfo-mode)
+ (use-local-map texinfo-mode-map)
+ (set-syntax-table texinfo-mode-syntax-table)
+ (make-local-variable 'page-delimiter)
+ (setq page-delimiter
+ (concat
+ "^@node [ \t]*[Tt]op\\|^@\\("
+ texinfo-chapter-level-regexp
+ "\\)"))
+ (make-local-variable 'require-final-newline)
+ (setq require-final-newline t)
+ (make-local-variable 'indent-tabs-mode)
+ (setq indent-tabs-mode nil)
+ (make-local-variable 'paragraph-separate)
+ (setq paragraph-separate (concat "^\b\\|^@[a-zA-Z]*[ \n]\\|" paragraph-separate))
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat "^\b\\|^@[a-zA-Z]*[ \n]\\|" paragraph-start))
+ (make-local-variable 'fill-column)
+ (setq fill-column 72)
+ (make-local-variable 'comment-start)
+ (setq comment-start "@c ")
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip "@c +")
+ (make-local-variable 'words-include-escapes)
+ (setq words-include-escapes t)
+ (make-local-variable 'imenu-generic-expression)
+ (setq imenu-generic-expression texinfo-imenu-generic-expression)
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(texinfo-font-lock-keywords t))
+ (make-local-variable 'outline-regexp)
+ (setq outline-regexp
+ (concat "@\\("
+ (mapconcat 'car texinfo-section-list "\\>\\|")
+ "\\>\\)"))
+ (make-local-variable 'outline-level)
+ (setq outline-level 'texinfo-outline-level)
+ (make-local-variable 'tex-start-of-header)
+ (setq tex-start-of-header "%**start")
+ (make-local-variable 'tex-end-of-header)
+ (setq tex-end-of-header "%**end")
+ (run-hooks 'text-mode-hook 'texinfo-mode-hook))
+
+
+;;; Insert string commands
+
+;; Keep as concatinated lists for ease of maintenance
+(defconst texinfo-environment-regexp
+ (concat
+ "^@"
+ "\\("
+ "cartouche\\|"
+ "display\\|"
+ "end\\|"
+ "enumerate\\|"
+ "example\\|"
+ "f?table\\|"
+ "flushleft\\|"
+ "flushright\\|"
+ "format\\|"
+ "group\\|"
+ "ifhtml\\|"
+ "ifinfo\\|"
+ "iftex\\|"
+ "ignore\\|"
+ "itemize\\|"
+ "lisp\\|"
+ "macro\\|"
+ "multitable\\|"
+ "quotation\\|"
+ "smallexample\\|"
+ "smalllisp\\|"
+ "tex"
+ "\\)")
+ "Regexp for environment-like TexInfo list commands.
+ Subexpression 1 is what goes into the corresponding `@end' statement.")
+
+;; The following texinfo-insert-@end command not only inserts a SPC
+;; after the @end, but tries to find out what belongs there. It is
+;; not very smart: it does not understand nested lists.
+
+(defun texinfo-insert-@end ()
+ "Insert the matching `@end' for the last Texinfo command that needs one."
+ (interactive)
+ (let ((depth 1) string)
+ (save-excursion
+ (while (and (> depth 0)
+ (re-search-backward texinfo-environment-regexp nil t)
+ (if (looking-at "@end")
+ (setq depth (1+ depth))
+ (setq depth (1- depth)))))
+ (looking-at texinfo-environment-regexp)
+ (if (zerop depth)
+ (setq string
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ (insert "@end ")
+ (if string (insert string "\n"))))
+
+;; The following insert commands accept a prefix arg N, which is the
+;; number of words (actually s-exprs) that should be surrounded by
+;; braces. Thus you can first paste a variable name into a .texinfo
+;; buffer, then say C-u 1 C-c C-c v at the beginning of the just
+;; pasted variable name to put @var{...} *around* the variable name.
+;; Operate on previous word or words with negative arg.
+
+;; These commands use texinfo-insert-@-with-arg
+(defun texinfo-insert-@-with-arg (string &optional arg)
+ (if arg
+ (progn
+ (setq arg (prefix-numeric-value arg))
+ (if (< arg 0)
+ (progn
+ (skip-chars-backward " \t\n\r\f")
+ (save-excursion
+ (forward-sexp arg)
+ (insert "@" string "{"))
+ (insert "}"))
+ (skip-chars-forward " \t\n\r\f")
+ (insert "@" string "{")
+ (forward-sexp arg)
+ (insert "}")))
+ (insert "@" string "{}")
+ (backward-char)))
+
+(defun texinfo-insert-braces ()
+ "Make a pair of braces and be poised to type inside of them.
+Use \\[up-list] to move forward out of the braces."
+ (interactive)
+ (insert "{}")
+ (backward-char))
+
+(defun texinfo-insert-@code (&optional arg)
+ "Insert a `@code{...}' command in a Texinfo buffer.
+A numeric argument says how many words the braces should surround.
+The default is not to surround any existing words with the braces."
+ (interactive "P")
+ (texinfo-insert-@-with-arg "code" arg))
+
+(defun texinfo-insert-@dfn (&optional arg)
+ "Insert a `@dfn{...}' command in a Texinfo buffer.
+A numeric argument says how many words the braces should surround.
+The default is not to surround any existing words with the braces."
+ (interactive "P")
+ (texinfo-insert-@-with-arg "dfn" arg))
+
+(defun texinfo-insert-@example ()
+ "Insert the string `@example' in a Texinfo buffer."
+ (interactive)
+ (insert "@example\n"))
+
+(defun texinfo-insert-@file (&optional arg)
+ "Insert a `@file{...}' command in a Texinfo buffer.
+A numeric argument says how many words the braces should surround.
+The default is not to surround any existing words with the braces."
+ (interactive "P")
+ (texinfo-insert-@-with-arg "file" arg))
+
+(defun texinfo-insert-@item ()
+ "Insert the string `@item' in a Texinfo buffer."
+ (interactive)
+ (insert "@item")
+ (newline))
+
+(defun texinfo-insert-@kbd (&optional arg)
+ "Insert a `@kbd{...}' command in a Texinfo buffer.
+A numeric argument says how many words the braces should surround.
+The default is not to surround any existing words with the braces."
+ (interactive "P")
+ (texinfo-insert-@-with-arg "kbd" arg))
+
+(defun texinfo-insert-@node ()
+ "Insert the string `@node' in a Texinfo buffer.
+This also inserts on the following line a comment indicating
+the order of arguments to @node."
+ (interactive)
+ (insert "@node \n@comment node-name, next, previous, up")
+ (forward-line -1)
+ (forward-char 6))
+
+(defun texinfo-insert-@noindent ()
+ "Insert the string `@noindent' in a Texinfo buffer."
+ (interactive)
+ (insert "@noindent\n"))
+
+(defun texinfo-insert-@samp (&optional arg)
+ "Insert a `@samp{...}' command in a Texinfo buffer.
+A numeric argument says how many words the braces should surround.
+The default is not to surround any existing words with the braces."
+ (interactive "P")
+ (texinfo-insert-@-with-arg "samp" arg))
+
+(defun texinfo-insert-@table (&optional arg)
+ "Insert the string `@table' in a Texinfo buffer."
+ (interactive "P")
+ (insert "@table "))
+
+(defun texinfo-insert-@var (&optional arg)
+ "Insert a `@var{}' command in a Texinfo buffer.
+A numeric argument says how many words the braces should surround.
+The default is not to surround any existing words with the braces."
+ (interactive "P")
+ (texinfo-insert-@-with-arg "var" arg))
+
+;;; Texinfo file structure
+
+;; These are defined in texnfo-upd.el.
+;; texinfo-section-types-regexp
+;; texinfo-section-level-regexp
+;; texinfo-subsection-level-regexp
+;; texinfo-subsubsection-level-regexp
+
+;; `texinfo-show-structure' requires texnfo-upd.el
+(defun texinfo-show-structure (&optional nodes-too)
+ "Show the structure of a Texinfo file.
+List the lines in the file that begin with the @-sign commands for
+@chapter, @section, and the like.
+
+With optional argument (prefix if interactive), list both the lines
+with @-sign commands for @chapter, @section, and the like, and list
+@node lines.
+
+Lines with structuring commands beginning in them are displayed in
+another buffer named `*Occur*'. In that buffer, you can move point to
+one of those lines and then use \\<occur-mode-map>\\[occur-mode-goto-occurrence],
+to jump to the corresponding spot in the Texinfo source file."
+
+ (interactive "P")
+ (require 'texnfo-upd)
+ (save-excursion
+ (goto-char (point-min))
+ (if nodes-too
+ (occur (concat "\\(^@node\\)\\|" texinfo-section-types-regexp))
+ (occur texinfo-section-types-regexp)))
+ (pop-to-buffer "*Occur*")
+ (goto-char (point-min))
+ (flush-lines "-----")
+ ;; Now format the "*Occur*" buffer to show the structure.
+ ;; Thanks to ceder@signum.se (Per Cederqvist)
+ (goto-char (point-max))
+ (let ((margin 5))
+ (while (re-search-backward "^ *[0-9]*:" nil 0)
+ (re-search-forward ":")
+ (setq margin
+ (cond
+ ((looking-at
+ (concat "@\\(" texinfo-chapter-level-regexp "\\)")) 5)
+ ;; ((looking-at "@chapter ") 5)
+ ;; ((looking-at "@unnumbered ") 5)
+ ;; ((looking-at "@appendix ") 5)
+ ;; ((looking-at "@majorheading ") 5)
+ ;; ((looking-at "@chapheading ") 5)
+
+ ((looking-at
+ (concat "@\\(" texinfo-section-level-regexp "\\)")) 9)
+ ;; ((looking-at "@section ") 9)
+ ;; ((looking-at "@unnumberedsec ") 9)
+ ;; ((looking-at "@appendixsec ") 9)
+ ;; ((looking-at "@heading ") 9)
+
+ ((looking-at
+ (concat "@\\(" texinfo-subsection-level-regexp "\\)")) 13)
+ ;; ((looking-at "@subsection ") 13)
+ ;; ((looking-at "@unnumberedsubsec ") 13)
+ ;; ((looking-at "@appendixsubsec ") 13)
+ ;; ((looking-at "@subheading ") 13)
+
+ ((looking-at
+ (concat "@\\(" texinfo-subsubsection-level-regexp "\\)")) 17)
+ ;; ((looking-at "@subsubsection ") 17)
+ ;; ((looking-at "@unnumberedsubsubsec ") 17)
+ ;; ((looking-at "@appendixsubsubsec ") 17)
+ ;; ((looking-at "@subsubheading ") 17)
+ (t margin)))
+ (indent-to-column margin)
+ (beginning-of-line))))
+
+;;; The tex and print function definitions:
+
+(defvar texinfo-texi2dvi-command "texi2dvi"
+ "*Command used by `texinfo-tex-buffer' to run TeX and texindex on a buffer.")
+
+(defvar texinfo-tex-command "tex"
+ "*Command used by `texinfo-tex-region' to run TeX on a region.")
+
+(defvar texinfo-texindex-command "texindex"
+ "*Command used by `texinfo-texindex' to sort unsorted index files.")
+
+(defvar texinfo-delete-from-print-queue-command "lprm"
+ "*Command string used to delete a job from the line printer queue.
+Command is used by \\[texinfo-delete-from-print-queue] based on
+number provided by a previous \\[tex-show-print-queue]
+command.")
+
+(defvar texinfo-tex-trailer "@bye"
+ "String appended after a region sent to TeX by `texinfo-tex-region'.")
+
+(defun texinfo-tex-region (beg end)
+ "Run TeX on the current region.
+This works by writing a temporary file (`tex-zap-file') in the directory
+that is the value of `tex-directory', then running TeX on that file.
+
+The first line of the buffer is copied to the
+temporary file; and if the buffer has a header, it is written to the
+temporary file before the region itself. The buffer's header is all lines
+between the strings defined by `tex-start-of-header' and `tex-end-of-header'
+inclusive. The header must start in the first 100 lines.
+
+The value of `texinfo-tex-trailer' is appended to the temporary file after the region."
+ (interactive "r")
+ (require 'tex-mode)
+ (if (get-buffer "*tex-shell*")
+ (tex-kill-job)
+ (tex-start-shell))
+ (or tex-zap-file (setq tex-zap-file (make-temp-name "#tz")))
+ (let ((tex-out-file (concat tex-zap-file ".tex"))
+ (temp-buffer (get-buffer-create " tex-Output-Buffer"))
+ (zap-directory
+ (file-name-as-directory (expand-file-name tex-directory))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line 100)
+ (let ((search-end (point))
+ (hbeg (point-min)) (hend (point-min))
+ (default-directory zap-directory))
+ (goto-char (point-min))
+
+ ;; Copy first line, the `\input texinfo' line, to temp file
+ (write-region (point)
+ (save-excursion (end-of-line) (point))
+ tex-out-file nil nil)
+
+ ;; Don't copy first line twice if region includes it.
+ (forward-line 1)
+ (if (< beg (point)) (setq beg (point)))
+
+ ;; Initialize the temp file with either the header or nothing
+ (if (search-forward tex-start-of-header search-end t)
+ (progn
+ (beginning-of-line)
+ (setq hbeg (point)) ; Mark beginning of header.
+ (if (search-forward tex-end-of-header nil t)
+ (progn (beginning-of-line)
+ (setq hend (point))) ; Mark end of header.
+ (setq hbeg (point-min))))) ; Else no header.
+
+ ;; Copy header to temp file.
+ (write-region (min hbeg beg) hend tex-out-file t nil)
+
+ ;; Copy region to temp file.
+ (write-region (max beg hend) end tex-out-file t nil))
+
+ ;; This is a kludge to insert the tex-trailer into the tex-out-file.
+ ;; We have to create a special buffer in which to insert
+ ;; the tex-trailer first because there is no function with
+ ;; which to append a literal string directly to a file.
+ (let ((local-tex-trailer texinfo-tex-trailer))
+ (set-buffer temp-buffer)
+ (erase-buffer)
+ ;; make sure trailer isn't hidden by a comment
+ (insert-string "\n")
+ (if local-tex-trailer (insert-string local-tex-trailer))
+ (tex-set-buffer-directory temp-buffer zap-directory)
+ (write-region (point-min) (point-max) tex-out-file t nil))
+
+;;; The following is sufficient in Emacs 19.
+;;; (write-region (concat "\n" texinfo-tex-trailer) nil
+;;; tex-out-file t nil)
+ ))
+
+ (tex-set-buffer-directory "*tex-shell*" zap-directory)
+ (tex-send-command tex-shell-cd-command zap-directory)
+ (tex-send-command texinfo-tex-command tex-out-file)
+ ;; alternatively:
+ ;; (send-string "tex-shell" (concat tex-shell-cd-command " "
+ ;; zap-directory "\n"))
+ ;; (send-string "tex-shell" (concat texinfo-tex-command " "
+ ;; tex-out-file "\n"))
+ (tex-recenter-output-buffer 0)))
+
+(defun texinfo-tex-buffer ()
+ "Run TeX on visited file, once or twice, to make a correct `.dvi' file."
+ (interactive)
+
+ ;; Make sure TeX shell is running.
+ (require 'tex-mode)
+ (if (get-buffer "*tex-shell*")
+ (quit-process (get-process "tex-shell") t)
+ (tex-start-shell))
+
+ (cond ((null buffer-file-name)
+ (error "Buffer not visiting any file!"))
+ ((buffer-modified-p)
+ (error "Buffer has been modified since last saved!")))
+
+ (setq tex-zap-file buffer-file-name)
+
+ (tex-send-command tex-shell-cd-command (file-name-directory tex-zap-file))
+
+ (tex-send-command texinfo-texi2dvi-command tex-zap-file)
+
+ ;; alternatively:
+ ;; (send-string "tex-shell"
+ ;; (concat tex-shell-cd-command
+ ;; " " (file-name-directory tex-zap-file) "\n"))
+ ;; )
+ ;;
+ ;; (send-string "tex-shell"
+ ;; (concat texinfo-texi2dvi-command " " tex-zap-file "\n"))
+
+
+ (tex-recenter-output-buffer 0))
+
+(defun texinfo-texindex ()
+ "Run `texindex' on unsorted index files.
+The index files are made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
+This runs the shell command defined by `texinfo-texindex-command'."
+ (interactive)
+ (require 'tex-mode)
+ (tex-send-command texinfo-texindex-command (concat tex-zap-file ".??"))
+ ;; alternatively
+ ;; (send-string "tex-shell"
+ ;; (concat texinfo-texindex-command
+ ;; " " tex-zap-file ".??" "\n"))
+ (tex-recenter-output-buffer nil))
+
+(defun texinfo-tex-print ()
+ "Print `.dvi' file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
+This runs the shell command defined by `tex-dvi-print-command'."
+ (interactive)
+ (require 'tex-mode)
+ (tex-send-command tex-dvi-print-command (concat tex-zap-file ".dvi"))
+ ;; alternatively:
+ ;; (send-string "tex-shell"
+ ;; (concat tex-dvi-print-command
+ ;; " " tex-zap-file ".dvi" "\n"))
+ (tex-recenter-output-buffer nil))
+
+(defun texinfo-quit-job ()
+ "Quit currently running TeX job, by sending an `x' to it."
+ (interactive)
+ (if (not (get-process "tex-shell"))
+ (error "No TeX shell running"))
+ (tex-send-command "x"))
+;; alternatively:
+;; save-excursion
+;; (set-buffer (get-buffer "*tex-shell*"))
+;; (goto-char (point-max))
+;; (insert "x")
+;; (comint-send-input)
+
+(defun texinfo-delete-from-print-queue (job-number)
+ "Delete job from the line printer spooling queue.
+You are prompted for the job number (use a number shown by a previous
+\\[tex-show-print-queue] command)."
+ (interactive "nPrinter job number for deletion: ")
+ (require 'tex-mode)
+ (if (tex-shell-running)
+ (tex-kill-job)
+ (tex-start-shell))
+ (tex-send-command texinfo-delete-from-print-queue-command job-number)
+ ;; alternatively
+ ;; (send-string "tex-shell"
+ ;; (concat
+ ;; texinfo-delete-from-print-queue-command
+ ;; " "
+ ;; job-number"\n"))
+ (tex-recenter-output-buffer nil))
+
+(provide 'texinfo)
+
+;;; texinfo.el ends here
diff --git a/texinfo/emacs/texnfo-tex.el b/texinfo/emacs/texnfo-tex.el
new file mode 100644
index 00000000000..225ea685c04
--- /dev/null
+++ b/texinfo/emacs/texnfo-tex.el
@@ -0,0 +1,346 @@
+;;;; texnfo-tex.el
+
+;;; Texinfo mode TeX and hardcopy printing commands.
+
+;; These commands are for running TeX on a region of a Texinfo file in
+;; GNU Emacs, or on the whole buffer, and for printing the resulting
+;; DVI file.
+
+;;; Version 2.07 22 October 1991
+;;; Robert J. Chassell
+;;; Please send bug reports to: bug-texinfo@prep.ai.mit.edu
+
+;;; Copyright (C) 1989, 1990, 1991 Free Software Foundation, Inc.
+
+
+;;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 Emacs 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 Emacs; see the file COPYING. If not, write to
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+
+
+;;; The Texinfo mode TeX related commands are:
+
+; texinfo-tex-region to run tex on the current region.
+; texinfo-tex-buffer to run tex on the current buffer.
+; texinfo-texindex to sort unsorted index files.
+; texinfo-tex-print to print the .dvi file made by tex.
+; texinfo-kill-tex-job to kill the currently running tex job.
+; texinfo-recenter-tex-output-buffer to redisplay tex output buffer.
+; texinfo-show-tex-print-queue to show the print queue.
+
+
+;;; Keys common both to Texinfo mode and to TeX shell.
+
+;; Defined in `texinfo.el'
+; (defun texinfo-define-common-keys (keymap)
+; "Define the keys both in Texinfo mode and in the texinfo-tex-shell."
+; (define-key keymap "\C-c\C-t\C-k" 'texinfo-kill-tex-job)
+; (define-key keymap "\C-c\C-t\C-x" 'texinfo-quit-tex-job)
+; (define-key keymap "\C-c\C-t\C-l" 'texinfo-recenter-tex-output-buffer)
+; (define-key keymap "\C-c\C-t\C-d" 'texinfo-delete-from-tex-print-queue)
+; (define-key keymap "\C-c\C-t\C-q" 'texinfo-show-tex-print-queue)
+; (define-key keymap "\C-c\C-t\C-p" 'texinfo-tex-print)
+; (define-key keymap "\C-c\C-t\C-i" 'texinfo-texindex)
+; (define-key keymap "\C-c\C-t\C-r" 'texinfo-tex-region)
+; (define-key keymap "\C-c\C-t\C-b" 'texinfo-tex-buffer))
+
+;; See also texinfo-tex-start-shell.
+;; The following is executed in the `texinfo.el' file
+;(texinfo-define-common-keys texinfo-mode-map)
+
+
+;;; Variable definitions:
+
+(require 'shell)
+
+(defvar texinfo-tex-shell-cd-command "cd"
+ "Command to give to shell running TeX to change directory.")
+
+(defvar texinfo-tex-command "tex"
+ "*Command used by texinfo-tex-region to run tex on a region.")
+
+(defvar texinfo-texindex-command "texindex"
+ "*Command used by texinfo-texindex to sort unsorted index files.")
+
+(defvar texinfo-tex-dvi-print-command "lpr -d"
+ "*Command string used by \\[tex-print] to print a .dvi file.")
+
+(defvar texinfo-show-tex-queue-command "lpq"
+ "*Command string used to show the Texinfo TeX print queue.
+Command is used by \\[texinfo-show-tex-print-queue] and it
+should show the queue that \\[texinfo-tex-print] puts jobs on.")
+
+(defvar texinfo-delete-from-print-queue-command "lprm"
+ "*Command string used to delete a job from the line printer queue.
+Command is used by \\[texinfo-delete-from-tex-print-queue] based on
+number provided by a previous \\[texinfo-show-tex-print-queue]
+command.")
+
+(defvar texinfo-tex-trailer "@bye"
+ "String appended after a region sent to TeX by texinfo-tex-region.")
+
+(defvar texinfo-tex-original-file ""
+ "Original name of file on which to run TeX.")
+
+(defvar texinfo-tex-temp-file nil
+ "Temporary file name used for text being sent as input to TeX.")
+
+(defvar texinfo-tex-root-temp-file nil
+ "Temporary file name used for text being sent as input to TeX.")
+
+
+;;; Texinfo TeX main functions
+
+(defun texinfo-tex-region (beginning end)
+ "Run tex on the current region.
+
+A temporary file is written in the default directory, and tex is run
+in that directory. The first line of the file is copied to the
+temporary file; and if the buffer has a header, it is written to the
+temporary file before the region itself. The buffer's header is all
+lines between the strings defined by texinfo-start-of-header and
+texinfo-end-of-header inclusive. The header must start in the first 100
+lines. The value of texinfo-tex-trailer is appended to the temporary file
+after the region."
+
+ (interactive "r")
+ (if (get-buffer "*texinfo-tex-shell*")
+ (quit-process (get-process "texinfo-tex-shell") t)
+ (texinfo-tex-start-shell))
+
+ (setq texinfo-tex-root-temp-file
+ (expand-file-name
+ (make-temp-name
+ (prin1-to-string (read (buffer-name))))))
+
+ (let ((texinfo-tex-temp-file (concat texinfo-tex-root-temp-file ".tex")))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line 100)
+ (let ((search-end (point))
+ (header-beginning (point-min)) (header-end (point-min)))
+ (goto-char (point-min))
+ ;; Copy first line, the `\input texinfo' line, to temp file
+ (write-region (point)
+ (save-excursion (forward-line 1) (point))
+ texinfo-tex-temp-file nil nil)
+ ;; Don't copy first line twice if region includes it.
+ (forward-line 1)
+ (if (< beginning (point)) (setq beginning (point)))
+ ;; Initialize the temp file with either the header or nothing
+ (if (search-forward texinfo-start-of-header search-end t)
+ (progn
+ (beginning-of-line)
+ (setq header-beginning (point)) ; Mark beginning of header.
+ (if (search-forward texinfo-end-of-header nil t)
+ (progn (beginning-of-line)
+ (setq header-end (point))) ; Mark end of header.
+ (setq header-beginning (point-min))))) ; Else no header.
+ ;; Copy header to temp file.
+ (write-region
+ (min header-beginning beginning )
+ header-end
+ texinfo-tex-temp-file t nil)
+ ;; Copy region to temp file.
+ (write-region
+ (max beginning header-end)
+ end
+ texinfo-tex-temp-file t nil)
+ ;; This is a kludge to insert the texinfo-tex-trailer into the
+ ;; texinfo-tex-temp-file. We have to create a special buffer
+ ;; in which to insert the texinfo-tex-trailer first because there is
+ ;; no function with which to append a literal string directly
+ ;; to a file.
+ (let ((local-tex-trailer texinfo-tex-trailer)
+ (temp-buffer (get-buffer-create " texinfo-trailer-buffer")))
+ (set-buffer temp-buffer)
+ (erase-buffer)
+ ;; make sure trailer isn't hidden by a comment
+ (insert-string "\n")
+ (if local-tex-trailer (insert local-tex-trailer))
+ (write-region (point-min) (point-max)
+ texinfo-tex-temp-file t nil)))
+ (set-process-sentinel (get-process "texinfo-tex-shell")
+ 'texinfo-tex-shell-sentinel)
+ (send-string "texinfo-tex-shell"
+ (concat texinfo-tex-shell-cd-command " "
+ default-directory "\n"))
+ (send-string "texinfo-tex-shell"
+ (concat texinfo-tex-command " "
+ texinfo-tex-temp-file "\n "))
+ (texinfo-recenter-tex-output-buffer 0)))))
+
+(defun texinfo-tex-buffer (buffer)
+ "Run TeX on current buffer.
+After running TeX the first time, you may have to run \\[texinfo-texindex]
+and then \\[texinfo-tex-buffer] again."
+ (interactive
+ (list
+ ;; Sometimes you put point into *texinfo-tex-shell*; this prompts
+ ;; you for the correct file regardless.
+ (if (and
+ (string= (buffer-name (current-buffer)) "*texinfo-tex-shell*")
+ texinfo-tex-root-temp-file)
+ (read-string (format "Run TeX on: ")
+ texinfo-tex-original-file)
+ (read-string (format "Run TeX on: ") (buffer-name (current-buffer))))))
+
+ ;; Set to original buffer if in *texinfo-tex-shell*; otherwise,
+ ;; record name of current buffer.
+ (if (string= (buffer-name (current-buffer)) "*texinfo-tex-shell*")
+ (set-buffer buffer)
+ (setq texinfo-tex-original-file
+ (buffer-name (current-buffer))))
+
+ (if (get-buffer "*texinfo-tex-shell*")
+ (quit-process (get-process "texinfo-tex-shell") t)
+ (texinfo-tex-start-shell))
+ (cond ((null buffer-file-name)
+ (error "Buffer not visiting any file!"))
+ ((buffer-modified-p)
+ (error "Buffer has been modified since last saved!"))
+ (t (set-process-sentinel (get-process "texinfo-tex-shell")
+ 'texinfo-tex-shell-sentinel)
+ (send-string "texinfo-tex-shell"
+ (concat texinfo-tex-shell-cd-command
+ " "
+ (file-name-directory
+ (buffer-file-name
+ (get-buffer buffer)))
+ "\n"))
+ (send-string "texinfo-tex-shell"
+ (concat texinfo-tex-command " " buffer "\n "))
+
+ ;; so the texinfo-tex-print command works
+ (setq texinfo-tex-root-temp-file
+ (substring buffer 0
+ (or (string-match "\\.tex" buffer)
+ (length buffer))))
+
+ (texinfo-recenter-tex-output-buffer 0))))
+
+(defun texinfo-texindex ()
+ "Run texindex on unsorted index files.
+The index files are made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
+Runs the shell command defined by texinfo-texindex-command."
+ (interactive)
+ (send-string "texinfo-tex-shell"
+ (concat texinfo-texindex-command
+ " " texinfo-tex-root-temp-file ".??" "\n"))
+ (texinfo-recenter-tex-output-buffer nil))
+
+(defun texinfo-tex-print ()
+ "Print .dvi file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
+Runs the shell command defined by texinfo-tex-dvi-print-command."
+ (interactive)
+ (send-string "texinfo-tex-shell"
+ (concat texinfo-tex-dvi-print-command
+ " " texinfo-tex-root-temp-file ".dvi" "\n"))
+ (texinfo-recenter-tex-output-buffer nil))
+
+
+;;; Texinfo TeX utility functions
+
+(defun texinfo-tex-start-shell ()
+ (save-excursion
+ (require 'texinfo)
+ (set-buffer (make-shell "texinfo-tex-shell" "/bin/sh" nil "-v"))
+ (setq texinfo-tex-shell-map (copy-keymap shell-mode-map))
+ (texinfo-define-common-keys texinfo-tex-shell-map)
+ (use-local-map texinfo-tex-shell-map)
+ (run-hooks 'texinfo-tex-shell-hook)
+ (if (zerop (buffer-size))
+ (sleep-for 1))))
+
+(defun texinfo-quit-tex-job ()
+ "Quit currently running TeX job, by sending an `x' to it."
+ (interactive)
+ (if (not (get-process "texinfo-tex-shell"))
+ (error "No TeX shell running."))
+ (save-excursion
+ (set-buffer (get-buffer "*texinfo-tex-shell*"))
+ (goto-char (point-max))
+ (insert "x")
+ (shell-send-input)))
+
+(defun texinfo-kill-tex-job ()
+ "Kill the currently running TeX job."
+ (interactive)
+ (if (get-process "texinfo-tex-shell")
+ ;; Use `texinfo-tex-shell-sentinel' to restart
+ ;; texinfo-tex-shell after it is killed.
+ (kill-process (get-process "texinfo-tex-shell"))))
+
+(defun texinfo-tex-shell-sentinel (process event)
+ "Restart texinfo-tex-shell after it is killed."
+ (if (equal event "killed\n")
+ (save-excursion
+ (set-buffer "*texinfo-tex-shell*")
+ (insert "\n")
+ (texinfo-tex-start-shell))))
+
+(defun texinfo-recenter-tex-output-buffer (linenum)
+ "Redisplay buffer of TeX job output so that most recent output can be seen.
+The last line of the buffer is displayed on
+line LINE of the window, or centered if LINE is nil."
+ (interactive "P")
+ (let ((texinfo-tex-shell (get-buffer "*texinfo-tex-shell*"))
+ (old-buffer (current-buffer)))
+ (if (null texinfo-tex-shell)
+ (message "No TeX output buffer")
+ (pop-to-buffer texinfo-tex-shell)
+ (bury-buffer texinfo-tex-shell)
+ (goto-char (point-max))
+ (recenter (if linenum
+ (prefix-numeric-value linenum)
+ (/ (window-height) 2)))
+ (pop-to-buffer old-buffer)
+ )))
+
+(defun texinfo-show-tex-print-queue ()
+ "Show the print queue that \\[texinfo-tex-print] put your job on.
+Runs the shell command defined by texinfo-show-tex-queue-command."
+ (interactive)
+ (if (not (texinfo-tex-shell-running-p))
+ (texinfo-tex-start-shell))
+ (send-string "texinfo-tex-shell"
+ (concat texinfo-show-tex-queue-command "\n"))
+ (texinfo-recenter-tex-output-buffer nil))
+
+(defun texinfo-delete-from-tex-print-queue (job-number)
+ "Delete job from the line printer spooling queue.
+You are prompted for the job number (shown by a previous
+\\[texinfo-show-tex-print-queue] command."
+ (interactive "nPrinter job number for deletion: ")
+ (if (texinfo-tex-shell-running-p)
+ (texinfo-kill-tex-job)
+ (texinfo-tex-start-shell))
+ (send-string "texinfo-tex-shell"
+ (concat
+ texinfo-delete-from-print-queue-command
+ " "
+ job-number"\n"))
+ (texinfo-recenter-tex-output-buffer nil))
+
+(defun texinfo-tex-shell-running-p ()
+ (and (get-process "texinfo-tex-shell")
+ (eq (process-status (get-process "texinfo-tex-shell")) 'run)))
+
+
+;;; Place `provide' at end of file.
+(provide 'texnfo-tex)
+;;;;;;;;;;;;;;;; end texnfo-tex.el ;;;;;;;;;;;;;;;;
diff --git a/texinfo/emacs/texnfo-upd.el b/texinfo/emacs/texnfo-upd.el
new file mode 100644
index 00000000000..4827fe5f819
--- /dev/null
+++ b/texinfo/emacs/texnfo-upd.el
@@ -0,0 +1,2058 @@
+;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
+
+;; Copyright 1989, 1990, 1991, 1992, 1996 Free Software Foundation, Inc.
+
+;; Author: Robert J. Chassell
+;; Date: 12 Sep 1996
+;; Maintainer: Robert J. Chassell <bug-texinfo@prep.ai.mit.edu>
+;; Keywords: maint, tex, docs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 Emacs 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 Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Known bug: update commands fail to ignore @ignore.
+
+;; Summary: how to use the updating commands
+
+;; The node and menu updating functions automatically
+
+;; * insert missing `@node' lines,
+;; * insert the `Next', `Previous' and `Up' pointers of a node,
+;; * insert or update the menu for a section,
+;; * create a master menu for a Texinfo source file.
+;;
+;; Passed an argument, the `texinfo-update-node' and
+;; `texinfo-make-menu' functions do their jobs in the region.
+;;
+;; In brief, the functions for creating or updating nodes and menus, are:
+;;
+;; texinfo-update-node (&optional region-p)
+;; texinfo-every-node-update ()
+;; texinfo-sequential-node-update (&optional region-p)
+;;
+;; texinfo-make-menu (&optional region-p)
+;; texinfo-all-menus-update ()
+;; texinfo-master-menu ()
+;;
+;; texinfo-insert-node-lines (&optional title-p)
+;;
+;; texinfo-indent-menu-description (column &optional region-p)
+
+;; The `texinfo-column-for-description' variable specifies the column to
+;; which menu descriptions are indented.
+
+;; Texinfo file structure
+;; ----------------------
+
+;; To use the updating commands, you must structure your Texinfo file
+;; hierarchically. Each `@node' line, with the exception of the top
+;; node, must be accompanied by some kind of section line, such as an
+;; `@chapter' or `@section' line. Each node-line/section-line
+;; combination must look like this:
+
+;; @node Lists and Tables, Cross References, Structuring, Top
+;; @comment node-name, next, previous, up
+;; @chapter Making Lists and Tables
+
+;; or like this (without the `@comment' line):
+
+;; @node Lists and Tables, Cross References, Structuring, Top
+;; @chapter Making Lists and Tables
+
+;; If the file has a `top' node, it must be called `top' or `Top' and
+;; be the first node in the file.
+
+
+;;; The update node functions described in detail
+
+;; The `texinfo-update-node' function without an argument inserts
+;; the correct next, previous and up pointers for the node in which
+;; point is located (i.e., for the node preceding point).
+
+;; With an argument, the `texinfo-update-node' function inserts the
+;; correct next, previous and up pointers for the nodes inside the
+;; region.
+
+;; It does not matter whether the `@node' line has pre-existing
+;; `Next', `Previous', or `Up' pointers in it. They are removed.
+
+;; The `texinfo-every-node-update' function runs `texinfo-update-node'
+;; on the whole buffer.
+
+;; The `texinfo-sequential-node-update' function inserts the
+;; immediately following and preceding node into the `Next' or
+;; `Previous' pointers regardless of their hierarchical level. This is
+;; only useful for certain kinds of text, like a novel, which you go
+;; through sequentially.
+
+
+;;; The menu making functions described in detail
+
+;; The `texinfo-make-menu' function without an argument creates or
+;; updates a menu for the section encompassing the node that follows
+;; point. With an argument, it makes or updates menus for the nodes
+;; within or part of the marked region.
+
+;; Whenever an existing menu is updated, the descriptions from
+;; that menu are incorporated into the new menu. This is done by copying
+;; descriptions from the existing menu to the entries in the new menu
+;; that have the same node names. If the node names are different, the
+;; descriptions are not copied to the new menu.
+
+;; Menu entries that refer to other Info files are removed since they
+;; are not a node within current buffer. This is a deficiency.
+
+;; The `texinfo-all-menus-update' function runs `texinfo-make-menu'
+;; on the whole buffer.
+
+;; The `texinfo-master-menu' function creates an extended menu located
+;; after the top node. (The file must have a top node.) The function
+;; first updates all the regular menus in the buffer (incorporating the
+;; descriptions from pre-existing menus), and then constructs a master
+;; menu that includes every entry from every other menu. (However, the
+;; function cannot update an already existing master menu; if one
+;; exists, it must be removed before calling the function.)
+
+;; The `texinfo-indent-menu-description' function indents every
+;; description in the menu following point, to the specified column.
+;; Non-nil argument (prefix, if interactive) means indent every
+;; description in every menu in the region. This function does not
+;; indent second and subsequent lines of a multi-line description.
+
+;; The `texinfo-insert-node-lines' function inserts `@node' before the
+;; `@chapter', `@section', and such like lines of a region in a Texinfo
+;; file where the `@node' lines are missing.
+;;
+;; With a non-nil argument (prefix, if interactive), the function not
+;; only inserts `@node' lines but also inserts the chapter or section
+;; titles as the names of the corresponding nodes; and inserts titles
+;; as node names in pre-existing `@node' lines that lack names.
+;;
+;; Since node names should be more concise than section or chapter
+;; titles, node names so inserted will need to be edited manually.
+
+
+;;; Code:
+
+;;; The menu making functions
+
+(defun texinfo-make-menu (&optional region-p)
+ "Without any prefix argument, make or update a menu.
+Make the menu for the section enclosing the node found following point.
+
+Non-nil argument (prefix, if interactive) means make or update menus
+for nodes within or part of the marked region.
+
+Whenever a menu exists, and is being updated, the descriptions that
+are associated with node names in the pre-existing menu are
+incorporated into the new menu. Otherwise, the nodes' section titles
+are inserted as descriptions."
+
+ (interactive "P")
+ (if (not region-p)
+ (let ((level (texinfo-hierarchic-level)))
+ (texinfo-make-one-menu level)
+ (message "Done...updated the menu. You may save the buffer."))
+ ;; else
+ (message "Making or updating menus in %s... " (buffer-name))
+ (let ((beginning (region-beginning))
+ (region-end (region-end))
+ (level (progn ; find section type following point
+ (goto-char (region-beginning))
+ (texinfo-hierarchic-level))))
+ (if (= region-end beginning)
+ (error "Please mark a region!"))
+ (save-excursion
+ (save-restriction
+ (widen)
+
+ (while (texinfo-find-lower-level-node level region-end)
+ (setq level (texinfo-hierarchic-level)) ; new, lower level
+ (texinfo-make-one-menu level))
+
+ (while (and (< (point) region-end)
+ (texinfo-find-higher-level-node level region-end))
+ (setq level (texinfo-hierarchic-level))
+ (while (texinfo-find-lower-level-node level region-end)
+ (setq level (texinfo-hierarchic-level)) ; new, lower level
+ (texinfo-make-one-menu level))))))
+ (message "Done...updated menus. You may save the buffer.")))
+
+(defun texinfo-make-one-menu (level)
+ "Make a menu of all the appropriate nodes in this section.
+`Appropriate nodes' are those associated with sections that are
+at the level specified by LEVEL. Point is left at the end of menu."
+ (let*
+ ((case-fold-search t)
+ (beginning
+ (save-excursion
+ (goto-char (texinfo-update-menu-region-beginning level))
+ (end-of-line)
+ (point)))
+ (end (texinfo-update-menu-region-end level))
+ (first (texinfo-menu-first-node beginning end))
+ (node-name (progn
+ (goto-char beginning)
+ (beginning-of-line)
+ (texinfo-copy-node-name)))
+ (new-menu-list (texinfo-make-menu-list beginning end level)))
+ (if (texinfo-old-menu-p beginning first)
+ (progn
+ (texinfo-incorporate-descriptions new-menu-list)
+ (texinfo-incorporate-menu-entry-names new-menu-list)
+ (texinfo-delete-old-menu beginning first)))
+ (texinfo-insert-menu new-menu-list node-name)))
+
+(defun texinfo-all-menus-update (&optional update-all-nodes-p)
+ "Update every regular menu in a Texinfo file.
+Update pre-existing master menu, if there is one.
+
+If called with a non-nil argument, this function first updates all the
+nodes in the buffer before updating the menus."
+ (interactive "P")
+ (let ((case-fold-search t)
+ master-menu-p)
+ (save-excursion
+ (push-mark (point-max) t)
+ (goto-char (point-min))
+ (message "Checking for a master menu in %s ... "(buffer-name))
+ (save-excursion
+ (if (re-search-forward texinfo-master-menu-header nil t)
+ ;; Remove detailed master menu listing
+ (progn
+ (setq master-menu-p t)
+ (goto-char (match-beginning 0))
+ (let ((end-of-detailed-menu-descriptions
+ (save-excursion ; beginning of end menu line
+ (goto-char (texinfo-menu-end))
+ (beginning-of-line) (forward-char -1)
+ (point))))
+ (delete-region (point) end-of-detailed-menu-descriptions)))))
+
+ (if update-all-nodes-p
+ (progn
+ (message "Updating all nodes in %s ... " (buffer-name))
+ (sleep-for 2)
+ (push-mark (point-max) t)
+ (goto-char (point-min))
+ ;; Using the mark to pass bounds this way
+ ;; is kludgy, but it's not worth fixing. -- rms.
+ (let ((mark-active t))
+ (texinfo-update-node t))))
+
+ (message "Updating all menus in %s ... " (buffer-name))
+ (sleep-for 2)
+ (push-mark (point-max) t)
+ (goto-char (point-min))
+ ;; Using the mark to pass bounds this way
+ ;; is kludgy, but it's not worth fixing. -- rms.
+ (let ((mark-active t))
+ (texinfo-make-menu t))
+
+ (if master-menu-p
+ (progn
+ (message "Updating the master menu in %s... " (buffer-name))
+ (sleep-for 2)
+ (texinfo-master-menu nil))))
+
+ (message "Done...updated all the menus. You may save the buffer.")))
+
+(defun texinfo-find-lower-level-node (level region-end)
+ "Search forward from point for node at any level lower than LEVEL.
+Search is limited to the end of the marked region, REGION-END,
+and to the end of the menu region for the level.
+
+Return t if the node is found, else nil. Leave point at the beginning
+of the node if one is found; else do not move point."
+ (let ((case-fold-search t))
+ (if (and (< (point) region-end)
+ (re-search-forward
+ (concat
+ "\\(^@node\\).*\n" ; match node line
+ "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any
+ "\\|" ; or
+ "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any
+ (eval (cdr (assoc level texinfo-update-menu-lower-regexps))))
+ ;; the next higher level node marks the end of this
+ ;; section, and no lower level node will be found beyond
+ ;; this position even if region-end is farther off
+ (texinfo-update-menu-region-end level)
+ t))
+ (goto-char (match-beginning 1)))))
+
+(defun texinfo-find-higher-level-node (level region-end)
+ "Search forward from point for node at any higher level than argument LEVEL.
+Search is limited to the end of the marked region, REGION-END.
+
+Return t if the node is found, else nil. Leave point at the beginning
+of the node if one is found; else do not move point."
+ (let ((case-fold-search t))
+ (cond
+ ((or (string-equal "top" level) (string-equal "chapter" level))
+ (if (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" region-end t)
+ (progn (beginning-of-line) t)))
+ (t
+ (if (re-search-forward
+ (concat
+ "\\(^@node\\).*\n" ; match node line
+ "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any
+ "\\|" ; or
+ "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any
+ (eval (cdr (assoc level texinfo-update-menu-higher-regexps))))
+ region-end t)
+ (progn (beginning-of-line) t))))))
+
+
+;;; Making the list of new menu entries
+
+(defun texinfo-make-menu-list (beginning end level)
+ "Make a list of node names and their descriptions.
+Point is left at the end of the menu region, but the menu is not inserted.
+
+First argument is position from which to start making menu list;
+second argument is end of region in which to try to locate entries;
+third argument is the level of the nodes that are the entries.
+
+Node names and descriptions are dotted pairs of strings. Each pair is
+an element of the list. If the description does not exist, the
+element consists only of the node name."
+ (goto-char beginning)
+ (let (new-menu-list)
+ (while (texinfo-menu-locate-entry-p level end)
+ (setq new-menu-list
+ (cons (cons
+ (texinfo-copy-node-name)
+ (prog1 "" (forward-line 1)))
+ ;; Use following to insert section titles automatically.
+ ;; (texinfo-copy-section-title))
+ new-menu-list)))
+ (reverse new-menu-list)))
+
+(defun texinfo-menu-locate-entry-p (level search-end)
+ "Find a node that will be part of menu for this section.
+First argument is a string such as \"section\" specifying the general
+hierarchical level of the menu; second argument is a position
+specifying the end of the search.
+
+The function returns t if the node is found, else nil. It searches
+forward from point, and leaves point at the beginning of the node.
+
+The function finds entries of the same type. Thus `subsections' and
+`unnumberedsubsecs' will appear in the same menu."
+ (let ((case-fold-search t))
+ (if (re-search-forward
+ (concat
+ "\\(^@node\\).*\n" ; match node line
+ "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any
+ "\\|" ; or
+ "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any
+ (eval
+ (cdr (assoc level texinfo-update-menu-same-level-regexps))))
+ search-end
+ t)
+ (goto-char (match-beginning 1)))))
+
+(defun texinfo-copy-node-name ()
+ "Return the node name as a string.
+
+Start with point at the beginning of the node line; copy the text
+after the node command up to the first comma on the line, if any, and
+return the text as a string. Leaves point at the beginning of the
+line. If there is no node name, returns an empty string."
+
+ (save-excursion
+ (buffer-substring
+ (progn (forward-word 1) ; skip over node command
+ (skip-chars-forward " \t") ; and over spaces
+ (point))
+ (if (search-forward
+ ","
+ (save-excursion (end-of-line) (point)) t) ; bound search
+ (1- (point))
+ (end-of-line) (point)))))
+
+(defun texinfo-copy-section-title ()
+ "Return the title of the section as a string.
+The title is used as a description line in the menu when one does not
+already exist.
+
+Move point to the beginning of the appropriate section line by going
+to the start of the text matched by last regexp searched for, which
+must have been done by `texinfo-menu-locate-entry-p'."
+
+ ;; could use the same re-search as in `texinfo-menu-locate-entry-p'
+ ;; instead of using `match-beginning'; such a variation would be
+ ;; more general, but would waste information already collected
+
+ (goto-char (match-beginning 7)) ; match section name
+
+ (buffer-substring
+ (progn (forward-word 1) ; skip over section type
+ (skip-chars-forward " \t") ; and over spaces
+ (point))
+ (progn (end-of-line) (point))))
+
+
+;;; Handling the old menu
+
+(defun texinfo-old-menu-p (beginning first)
+ "Move point to the beginning of the menu for this section, if any.
+Otherwise move point to the end of the first node of this section.
+Return t if a menu is found, nil otherwise.
+
+First argument is the position of the beginning of the section in which
+the menu will be located; second argument is the position of the first
+node within the section.
+
+If no menu is found, the function inserts two newlines just before the
+end of the section, and leaves point there where a menu ought to be."
+ (goto-char beginning)
+ (if (not (re-search-forward "^@menu" first 'goto-end))
+ (progn (insert "\n\n") (forward-line -2) nil)
+ t))
+
+(defun texinfo-incorporate-descriptions (new-menu-list)
+ "Copy the old menu line descriptions that exist to the new menu.
+
+Point must be at beginning of old menu.
+
+If the node-name of the new menu is found in the old menu, insert the
+old description into the new entry.
+
+For this function, the new menu is a list made up of lists of dotted
+pairs in which the first element of the pair is the node name and the
+second element the description. The new menu is changed destructively.
+The old menu is the menu as it appears in the texinfo file."
+
+ (let ((new-menu-list-pointer new-menu-list)
+ (end-of-menu (texinfo-menu-end)))
+ (while new-menu-list
+ (save-excursion ; keep point at beginning of menu
+ (if (re-search-forward
+ ;; Existing nodes can have the form
+ ;; * NODE NAME:: DESCRIPTION
+ ;; or
+ ;; * MENU ITEM: NODE NAME. DESCRIPTION.
+ ;;
+ ;; Recognize both when looking for the description.
+ (concat "\\* \\(" ; so only menu entries are found
+ (car (car new-menu-list)) "::"
+ "\\|"
+ ".*: " (car (car new-menu-list)) "[.,\t\n]"
+ "\\)"
+ ) ; so only complete entries are found
+ end-of-menu
+ t)
+ (setcdr (car new-menu-list)
+ (texinfo-menu-copy-old-description end-of-menu))))
+ (setq new-menu-list (cdr new-menu-list)))
+ (setq new-menu-list new-menu-list-pointer)))
+
+(defun texinfo-incorporate-menu-entry-names (new-menu-list)
+ "Copy any old menu entry names to the new menu.
+
+Point must be at beginning of old menu.
+
+If the node-name of the new menu entry cannot be found in the old
+menu, do nothing.
+
+For this function, the new menu is a list made up of lists of dotted
+pairs in which the first element of the pair is the node name and the
+second element is the description (or nil).
+
+If we find an existing menu entry name, we change the first element of
+the pair to be another dotted pair in which the car is the menu entry
+name and the cdr is the node name.
+
+NEW-MENU-LIST is changed destructively. The old menu is the menu as it
+appears in the texinfo file."
+
+ (let ((new-menu-list-pointer new-menu-list)
+ (end-of-menu (texinfo-menu-end)))
+ (while new-menu-list
+ (save-excursion ; keep point at beginning of menu
+ (if (re-search-forward
+ ;; Existing nodes can have the form
+ ;; * NODE NAME:: DESCRIPTION
+ ;; or
+ ;; * MENU ITEM: NODE NAME. DESCRIPTION.
+ ;;
+ ;; We're interested in the second case.
+ (concat "\\* " ; so only menu entries are found
+ "\\(.*\\): " (car (car new-menu-list)) "[.,\t\n]")
+ end-of-menu
+ t)
+ (setcar
+ (car new-menu-list) ; replace the node name
+ (cons (buffer-substring (match-beginning 1) (match-end 1))
+ (car (car new-menu-list)))))
+ (setq new-menu-list (cdr new-menu-list))))
+ (setq new-menu-list new-menu-list-pointer)))
+
+(defun texinfo-menu-copy-old-description (end-of-menu)
+ "Return description field of old menu line as string.
+Point must be located just after the node name. Point left before description.
+Single argument, END-OF-MENU, is position limiting search."
+ (skip-chars-forward "[:.,\t\n ]+")
+ ;; don't copy a carriage return at line beginning with asterisk!
+ ;; do copy a description that begins with an `@'!
+ ;; !! Known bug: does not copy descriptions starting with ^|\{?* etc.
+ (if (and (looking-at "\\(\\w+\\|@\\)")
+ (not (looking-at "\\(^\\* \\|^@end menu\\)")))
+ (buffer-substring
+ (point)
+ (save-excursion
+ (re-search-forward "\\(^\\* \\|^@end menu\\)" end-of-menu t)
+ (forward-line -1)
+ (end-of-line) ; go to end of last description line
+ (point)))
+ ""))
+
+(defun texinfo-menu-end ()
+ "Return position of end of menu. Does not change location of point.
+Signal an error if not end of menu."
+ (save-excursion
+ (if (re-search-forward "^@end menu" nil t)
+ (point)
+ (error "Menu does not have an end."))))
+
+(defun texinfo-delete-old-menu (beginning first)
+ "Delete the old menu. Point must be in or after menu.
+First argument is position of the beginning of the section in which
+the menu will be located; second argument is the position of the first
+node within the section."
+ ;; No third arg to search, so error if search fails.
+ (re-search-backward "^@menu" beginning)
+ (delete-region (point)
+ (save-excursion
+ (re-search-forward "^@end menu" first)
+ (point))))
+
+
+;;; Inserting new menu
+
+;; try 32, but perhaps 24 is better
+(defvar texinfo-column-for-description 32
+ "*Column at which descriptions start in a Texinfo menu.")
+
+(defun texinfo-insert-menu (menu-list node-name)
+ "Insert formatted menu at point.
+Indents the first line of the description, if any, to the value of
+texinfo-column-for-description.
+
+MENU-LIST has form:
+
+ \(\(\"node-name1\" . \"description\"\)
+ \(\"node-name2\" . \"description\"\) ... \)
+
+However, the description field might be nil.
+
+Also, the node-name field might itself be a dotted pair (call it P) of
+strings instead of just a string. In that case, the car of P
+is the menu entry name, and the cdr of P is the node name."
+
+ (insert "@menu\n")
+ (while menu-list
+ ;; Every menu entry starts with a star and a space.
+ (insert "* ")
+
+ ;; Insert the node name (and menu entry name, if present).
+ (let ((node-part (car (car menu-list))))
+ (if (stringp node-part)
+ ;; "Double colon" entry line; menu entry and node name are the same,
+ (insert (format "%s::" node-part))
+ ;; "Single colon" entry line; menu entry and node name are different.
+ (insert (format "%s: %s." (car node-part) (cdr node-part)))))
+
+ ;; Insert the description, if present.
+ (if (cdr (car menu-list))
+ (progn
+ ;; Move to right place.
+ (indent-to texinfo-column-for-description 2)
+ ;; Insert description.
+ (insert (format "%s" (cdr (car menu-list))))))
+
+ (insert "\n") ; end this menu entry
+ (setq menu-list (cdr menu-list)))
+ (insert "@end menu")
+ (message
+ "Updated \"%s\" level menu following node: %s ... " level node-name))
+
+
+;;; Starting menu descriptions by inserting titles
+
+(defun texinfo-start-menu-description ()
+ "In this menu entry, insert the node's section title as a description.
+Position point at beginning of description ready for editing.
+Do not insert a title if the line contains an existing description.
+
+You will need to edit the inserted text since a useful description
+complements the node name rather than repeats it as a title does."
+
+ (interactive)
+ (let (beginning end node-name title)
+ (save-excursion
+ (beginning-of-line)
+ (if (search-forward "* " (save-excursion (end-of-line) (point)) t)
+ (progn (skip-chars-forward " \t")
+ (setq beginning (point)))
+ (error "This is not a line in a menu!"))
+
+ (cond
+ ;; "Double colon" entry line; menu entry and node name are the same,
+ ((search-forward "::" (save-excursion (end-of-line) (point)) t)
+ (if (looking-at "[ \t]*[^ \t\n]+")
+ (error "Descriptive text already exists."))
+ (skip-chars-backward ": \t")
+ (setq node-name (buffer-substring beginning (point))))
+
+ ;; "Single colon" entry line; menu entry and node name are different.
+ ((search-forward ":" (save-excursion (end-of-line) (point)) t)
+ (skip-chars-forward " \t")
+ (setq beginning (point))
+ ;; Menu entry line ends in a period, comma, or tab.
+ (if (re-search-forward "[.,\t]"
+ (save-excursion (forward-line 1) (point)) t)
+ (progn
+ (if (looking-at "[ \t]*[^ \t\n]+")
+ (error "Descriptive text already exists."))
+ (skip-chars-backward "., \t")
+ (setq node-name (buffer-substring beginning (point))))
+ ;; Menu entry line ends in a return.
+ (re-search-forward ".*\n"
+ (save-excursion (forward-line 1) (point)) t)
+ (skip-chars-backward " \t\n")
+ (setq node-name (buffer-substring beginning (point)))
+ (if (= 0 (length node-name))
+ (error "No node name on this line.")
+ (insert "."))))
+ (t (error "No node name on this line.")))
+ ;; Search for node that matches node name, and copy the section title.
+ (if (re-search-forward
+ (concat
+ "^@node[ \t]+"
+ node-name
+ ".*\n" ; match node line
+ "\\("
+ "\\(\\(^@c \\|^@comment\\).*\n\\)" ; match comment line, if any
+ "\\|" ; or
+ "\\(^@ifinfo[ ]*\n\\)" ; ifinfo line, if any
+ "\\)?")
+ nil t)
+ (progn
+ (setq title
+ (buffer-substring
+ ;; skip over section type
+ (progn (forward-word 1)
+ ;; and over spaces
+ (skip-chars-forward " \t")
+ (point))
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))))
+ (error "Cannot find node to match node name in menu entry.")))
+ ;; Return point to the menu and insert the title.
+ (end-of-line)
+ (delete-region
+ (point)
+ (save-excursion (skip-chars-backward " \t") (point)))
+ (indent-to texinfo-column-for-description 2)
+ (save-excursion (insert title))))
+
+
+;;; Handling description indentation
+
+;; Since the make-menu functions indent descriptions, these functions
+;; are useful primarily for indenting a single menu specially.
+
+(defun texinfo-indent-menu-description (column &optional region-p)
+ "Indent every description in menu following point to COLUMN.
+Non-nil argument (prefix, if interactive) means indent every
+description in every menu in the region. Does not indent second and
+subsequent lines of a multi-line description."
+
+ (interactive
+ "nIndent menu descriptions to (column number): \nP")
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if (not region-p)
+ (progn
+ (re-search-forward "^@menu")
+ (texinfo-menu-indent-description column)
+ (message
+ "Indented descriptions in menu. You may save the buffer."))
+ ;;else
+ (message "Indenting every menu description in region... ")
+ (goto-char (region-beginning))
+ (while (and (< (point) (region-end))
+ (texinfo-locate-menu-p))
+ (forward-line 1)
+ (texinfo-menu-indent-description column))
+ (message "Indenting done. You may save the buffer.")))))
+
+(defun texinfo-menu-indent-description (to-column-number)
+ "Indent the Texinfo file menu description to TO-COLUMN-NUMBER.
+Start with point just after the word `menu' in the `@menu' line and
+leave point on the line before the `@end menu' line. Does not indent
+second and subsequent lines of a multi-line description."
+ (let* ((beginning-of-next-line (point)))
+ (while (< beginning-of-next-line
+ (save-excursion ; beginning of end menu line
+ (goto-char (texinfo-menu-end))
+ (beginning-of-line)
+ (point)))
+
+ (if (re-search-forward "\\* \\(.*::\\|.*: [^.,\t\n]+[.,\t]\\)"
+ (texinfo-menu-end)
+ t)
+ (progn
+ (let ((beginning-white-space (point)))
+ (skip-chars-forward " \t") ; skip over spaces
+ (if (looking-at "\\(@\\|\\w\\)+") ; if there is text
+ (progn
+ ;; remove pre-existing indentation
+ (delete-region beginning-white-space (point))
+ (indent-to-column to-column-number))))))
+ ;; position point at beginning of next line
+ (forward-line 1)
+ (setq beginning-of-next-line (point)))))
+
+
+;;; Making the master menu
+
+(defun texinfo-master-menu (update-all-nodes-menus-p)
+ "Make a master menu for a whole Texinfo file.
+Non-nil argument (prefix, if interactive) means first update all
+existing nodes and menus. Remove pre-existing master menu, if there is one.
+
+This function creates a master menu that follows the top node. The
+master menu includes every entry from all the other menus. It
+replaces any existing ordinary menu that follows the top node.
+
+If called with a non-nil argument, this function first updates all the
+menus in the buffer (incorporating descriptions from pre-existing
+menus) before it constructs the master menu.
+
+The function removes the detailed part of an already existing master
+menu. This action depends on the pre-existing master menu using the
+standard `texinfo-master-menu-header'.
+
+The master menu has the following format, which is adapted from the
+recommendation in the Texinfo Manual:
+
+ * The first part contains the major nodes in the Texinfo file: the
+ nodes for the chapters, chapter-like sections, and the major
+ appendices. This includes the indices, so long as they are in
+ chapter-like sections, such as unnumbered sections.
+
+ * The second and subsequent parts contain a listing of the other,
+ lower level menus, in order. This way, an inquirer can go
+ directly to a particular node if he or she is searching for
+ specific information.
+
+Each of the menus in the detailed node listing is introduced by the
+title of the section containing the menu."
+
+ (interactive "P")
+ (let ((case-fold-search t))
+ (widen)
+ (goto-char (point-min))
+
+ ;; Move point to location after `top'.
+ (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
+ (error "This buffer needs a Top node!"))
+
+ (let ((first-chapter
+ (save-excursion
+ (or (re-search-forward "^@node" nil t)
+ (error "Too few nodes for a master menu!"))
+ (point))))
+ (if (re-search-forward texinfo-master-menu-header first-chapter t)
+ ;; Remove detailed master menu listing
+ (progn
+ (goto-char (match-beginning 0))
+ (let ((end-of-detailed-menu-descriptions
+ (save-excursion ; beginning of end menu line
+ (goto-char (texinfo-menu-end))
+ (beginning-of-line) (forward-char -1)
+ (point))))
+ (delete-region (point) end-of-detailed-menu-descriptions)))))
+
+ (if update-all-nodes-menus-p
+ (progn
+ (message "Making a master menu in %s ...first updating all nodes... "
+ (buffer-name))
+ (sleep-for 2)
+ (push-mark (point-max) t)
+ (goto-char (point-min))
+ (texinfo-update-node t)
+
+ (message "Updating all menus in %s ... " (buffer-name))
+ (sleep-for 2)
+ (push-mark (point-max) t)
+ (goto-char (point-min))
+ (texinfo-make-menu t)))
+
+ (message "Now making the master menu in %s... " (buffer-name))
+ (sleep-for 2)
+ (goto-char (point-min))
+ (texinfo-insert-master-menu-list
+ (texinfo-master-menu-list))
+
+ ;; Remove extra newlines that texinfo-insert-master-menu-list
+ ;; may have inserted.
+
+ (save-excursion
+ (goto-char (point-min))
+
+ (if (re-search-forward texinfo-master-menu-header nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (insert "\n")
+ (delete-blank-lines)
+ (goto-char (point-min))))
+
+ (re-search-forward "^@menu")
+ (forward-line -1)
+ (delete-blank-lines)
+
+ (re-search-forward "^@end menu")
+ (forward-line 1)
+ (delete-blank-lines))
+
+ (message
+ "Done...completed making master menu. You may save the buffer.")))
+
+(defun texinfo-master-menu-list ()
+ "Return a list of menu entries and header lines for the master menu.
+
+Start with the menu for chapters and indices and then find each
+following menu and the title of the node preceding that menu.
+
+The master menu list has this form:
+
+ \(\(\(... \"entry-1-2\" \"entry-1\"\) \"title-1\"\)
+ \(\(... \"entry-2-2\" \"entry-2-1\"\) \"title-2\"\)
+ ...\)
+
+However, there does not need to be a title field."
+
+ (let (master-menu-list)
+ (while (texinfo-locate-menu-p)
+ (setq master-menu-list
+ (cons (list
+ (texinfo-copy-menu)
+ (texinfo-copy-menu-title))
+ master-menu-list)))
+ (reverse master-menu-list)))
+
+(defun texinfo-insert-master-menu-list (master-menu-list)
+ "Format and insert the master menu in the current buffer."
+ (goto-char (point-min))
+ ;; Insert a master menu only after `Top' node and before next node
+ ;; \(or include file if there is no next node\).
+ (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
+ (error "This buffer needs a Top node!"))
+ (let ((first-chapter
+ (save-excursion (re-search-forward "^@node\\|^@include") (point))))
+ (if (not (re-search-forward "^@menu" first-chapter t))
+ (error
+ "Buffer lacks ordinary `Top' menu in which to insert master.")))
+ (beginning-of-line)
+ (delete-region ; buffer must have ordinary top menu
+ (point)
+ (save-excursion (re-search-forward "^@end menu") (point)))
+
+ (save-excursion ; leave point at beginning of menu
+ ;; Handle top of menu
+ (insert "\n@menu\n")
+ ;; Insert chapter menu entries
+ (setq this-very-menu-list (reverse (car (car master-menu-list))))
+ ;; Tell user what is going on.
+ (message "Inserting chapter menu entry: %s ... " this-very-menu-list)
+ (while this-very-menu-list
+ (insert "* " (car this-very-menu-list) "\n")
+ (setq this-very-menu-list (cdr this-very-menu-list)))
+
+ (setq master-menu-list (cdr master-menu-list))
+
+ ;; Only insert detailed master menu if there is one....
+ (if (car (car master-menu-list))
+;; @detailmenu added 5 Sept 1996 at Karl Berry's request to avert a
+;; bug in `makeinfo'; all agree this is a bad kluge and should
+;; eventually be removed. @detailmenu ... @end detailmenu is a noop
+;; in `texinfmt.el' See @end detailmenu below
+;; also see `texinfo-all-menus-update' above, `texinfo-master-menu',
+;; `texinfo-multiple-files-update'
+ (insert texinfo-master-menu-header))
+
+ ;; Now, insert all the other menus
+
+ ;; The menu master-menu-list has a form like this:
+ ;; ((("beta" "alpha") "title-A")
+ ;; (("delta" "gamma") "title-B"))
+
+ (while master-menu-list
+
+ (message
+ "Inserting menu for %s .... " (car (cdr (car master-menu-list))))
+ ;; insert title of menu section
+ (insert "\n" (car (cdr (car master-menu-list))) "\n\n")
+
+ ;; insert each menu entry
+ (setq this-very-menu-list (reverse (car (car master-menu-list))))
+ (while this-very-menu-list
+ (insert "* " (car this-very-menu-list) "\n")
+ (setq this-very-menu-list (cdr this-very-menu-list)))
+
+ (setq master-menu-list (cdr master-menu-list)))
+
+ ;; Finish menu
+;; @detailmenu (see note above)
+ (insert "\n@end detailmenu")
+ (insert "\n@end menu\n\n")))
+
+(defvar texinfo-master-menu-header
+ "\n@detailmenu\n --- The Detailed Node Listing ---\n"
+ "String inserted before lower level entries in Texinfo master menu.
+It comes after the chapter-level menu entries.")
+
+(defun texinfo-locate-menu-p ()
+ "Find the next menu in the texinfo file.
+If found, leave point after word `menu' on the `@menu' line, and return t.
+If a menu is not found, do not move point and return nil."
+ (re-search-forward "\\(^@menu\\)" nil t))
+
+(defun texinfo-copy-menu-title ()
+ "Return the title of the section preceding the menu as a string.
+If such a title cannot be found, return an empty string. Do not move
+point."
+ (let ((case-fold-search t))
+ (save-excursion
+ (if (re-search-backward
+ (concat
+ "\\(^@top"
+ "\\|" ; or
+ texinfo-section-types-regexp ; all other section types
+ "\\)")
+ nil
+ t)
+ (progn
+ (beginning-of-line)
+ (forward-word 1) ; skip over section type
+ (skip-chars-forward " \t") ; and over spaces
+ (buffer-substring
+ (point)
+ (progn (end-of-line) (point))))
+ ""))))
+
+(defun texinfo-copy-menu ()
+ "Return the entries of an existing menu as a list.
+Start with point just after the word `menu' in the `@menu' line
+and leave point on the line before the `@end menu' line."
+ (let* (this-menu-list
+ (end-of-menu (texinfo-menu-end)) ; position of end of `@end menu'
+ (last-entry (save-excursion ; position of beginning of
+ ; last `* ' entry
+ (goto-char end-of-menu)
+ ;; handle multi-line description
+ (if (not (re-search-backward "^\\* " nil t))
+ (error "No entries in menu."))
+ (point))))
+ (while (< (point) last-entry)
+ (if (re-search-forward "^\\* " end-of-menu t)
+ (progn
+ (setq this-menu-list
+ (cons
+ (buffer-substring
+ (point)
+ ;; copy multi-line descriptions
+ (save-excursion
+ (re-search-forward "\\(^\\* \\|^@e\\)" nil t)
+ (- (point) 3)))
+ this-menu-list)))))
+ this-menu-list))
+
+
+;;; Determining the hierarchical level in the texinfo file
+
+(defun texinfo-specific-section-type ()
+ "Return the specific type of next section, as a string.
+For example, \"unnumberedsubsec\". Return \"top\" for top node.
+
+Searches forward for a section. Hence, point must be before the
+section whose type will be found. Does not move point. Signal an
+error if the node is not the top node and a section is not found."
+ (let ((case-fold-search t))
+ (save-excursion
+ (cond
+ ((re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
+;;; Following search limit by cph but causes a bug
+;;; (save-excursion
+;;; (end-of-line)
+;;; (point))
+ nil
+ t)
+ "top")
+ ((re-search-forward texinfo-section-types-regexp nil t)
+ (buffer-substring-no-properties
+ (progn (beginning-of-line) ; copy its name
+ (1+ (point)))
+ (progn (forward-word 1)
+ (point))))
+ (t
+ (error
+ "texinfo-specific-section-type: Chapter or section not found."))))))
+
+(defun texinfo-hierarchic-level ()
+ "Return the general hierarchal level of the next node in a texinfo file.
+Thus, a subheading or appendixsubsec is of type subsection."
+ (let ((case-fold-search t))
+ (cdr (assoc
+ (texinfo-specific-section-type)
+ texinfo-section-to-generic-alist))))
+
+
+;;; Locating the major positions
+
+(defun texinfo-update-menu-region-beginning (level)
+ "Locate beginning of higher level section this section is within.
+Return position of the beginning of the node line; do not move point.
+Thus, if this level is subsection, searches backwards for section node.
+Only argument is a string of the general type of section."
+ (let ((case-fold-search t))
+ ;; !! Known bug: if section immediately follows top node, this
+ ;; returns the beginning of the buffer as the beginning of the
+ ;; higher level section.
+ (cond
+ ((or (string-equal "top" level)
+ (string-equal "chapter" level))
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)
+ (beginning-of-line)
+ (point)))
+ (t
+ (save-excursion
+ (re-search-backward
+ (concat
+ "\\(^@node\\).*\n" ; match node line
+ "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any
+ "\\|" ; or
+ "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any
+ (eval
+ (cdr (assoc level texinfo-update-menu-higher-regexps))))
+ nil
+ 'goto-beginning)
+ (point))))))
+
+(defun texinfo-update-menu-region-end (level)
+ "Locate end of higher level section this section is within.
+Return position; do not move point. Thus, if this level is a
+subsection, find the node for the section this subsection is within.
+If level is top or chapter, returns end of file. Only argument is a
+string of the general type of section."
+ (let ((case-fold-search t))
+ (save-excursion
+ (if (re-search-forward
+ (concat
+ "\\(^@node\\).*\n" ; match node line
+ "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any
+ "\\|" ; or
+ "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any
+ (eval
+ ;; Never finds end of level above chapter so goes to end.
+ (cdr (assoc level texinfo-update-menu-higher-regexps))))
+ nil
+ 'goto-end)
+ (match-beginning 1)
+ (point-max)))))
+
+(defun texinfo-menu-first-node (beginning end)
+ "Locate first node of the section the menu will be placed in.
+Return position; do not move point.
+The menu will be located just before this position.
+
+First argument is the position of the beginning of the section in
+which the menu will be located; second argument is the position of the
+end of that region; it limits the search."
+
+ (save-excursion
+ (goto-char beginning)
+ (forward-line 1)
+ (re-search-forward "^@node" end t)
+ (beginning-of-line)
+ (point)))
+
+
+;;; Alists and regular expressions for defining hierarchical levels
+
+(defvar texinfo-section-to-generic-alist
+ '(("top" . "top")
+
+ ("chapter" . "chapter")
+ ("unnumbered" . "chapter")
+ ("majorheading" . "chapter")
+ ("chapheading" . "chapter")
+ ("appendix" . "chapter")
+
+ ("section" . "section")
+ ("unnumberedsec" . "section")
+ ("heading" . "section")
+ ("appendixsec" . "section")
+
+ ("subsection" . "subsection")
+ ("unnumberedsubsec" . "subsection")
+ ("subheading" . "subsection")
+ ("appendixsubsec" . "subsection")
+
+ ("subsubsection" . "subsubsection")
+ ("unnumberedsubsubsec" . "subsubsection")
+ ("subsubheading" . "subsubsection")
+ ("appendixsubsubsec" . "subsubsection"))
+ "*An alist of specific and corresponding generic Texinfo section types.
+The keys are strings specifying specific types of section; the values
+are strings of their corresponding general types.")
+
+;; We used to look for just sub, but that found @subtitle.
+(defvar texinfo-section-types-regexp
+ "^@\\(chapter \\|sect\\|subs\\|subh\\|unnum\\|major\\|chapheading \\|heading \\|appendix\\)"
+ "Regexp matching chapter, section, other headings (but not the top node).")
+
+(defvar texinfo-chapter-level-regexp
+ "chapter\\|unnumbered \\|appendix \\|majorheading\\|chapheading"
+ "Regular expression matching just the Texinfo chapter level headings.")
+
+(defvar texinfo-section-level-regexp
+ "section\\|unnumberedsec\\|heading \\|appendixsec"
+ "Regular expression matching just the Texinfo section level headings.")
+
+(defvar texinfo-subsection-level-regexp
+ "subsection\\|unnumberedsubsec\\|subheading\\|appendixsubsec"
+ "Regular expression matching just the Texinfo subsection level headings.")
+
+(defvar texinfo-subsubsection-level-regexp
+ "subsubsection\\|unnumberedsubsubsec\\|subsubheading\\|appendixsubsubsec"
+ "Regular expression matching just the Texinfo subsubsection level headings.")
+
+(defvar texinfo-update-menu-same-level-regexps
+ '(("top" . "top[ \t]+")
+ ("chapter" .
+ (concat "\\(^@\\)\\(" texinfo-chapter-level-regexp "\\)[ \t]*"))
+ ("section" .
+ (concat "\\(^@\\)\\(" texinfo-section-level-regexp "\\)[ \t]*"))
+ ("subsection" .
+ (concat "\\(^@\\)\\(" texinfo-subsection-level-regexp "\\)[ \t]+"))
+ ("subsubsection" .
+ (concat "\\(^@\\)\\(" texinfo-subsubsection-level-regexp "\\)[ \t]+")))
+ "*Regexps for searching for same level sections in a Texinfo file.
+The keys are strings specifying the general hierarchical level in the
+document; the values are regular expressions.")
+
+(defvar texinfo-update-menu-higher-regexps
+ '(("top" . "^@node [ \t]*DIR")
+ ("chapter" . "^@node [ \t]*top[ \t]*\\(,\\|$\\)")
+ ("section" .
+ (concat
+ "\\(^@\\("
+ texinfo-chapter-level-regexp
+ "\\)[ \t]*\\)"))
+ ("subsection" .
+ (concat
+ "\\(^@\\("
+ texinfo-section-level-regexp
+ "\\|"
+ texinfo-chapter-level-regexp
+ "\\)[ \t]*\\)"))
+ ("subsubsection" .
+ (concat
+ "\\(^@\\("
+ texinfo-subsection-level-regexp
+ "\\|"
+ texinfo-section-level-regexp
+ "\\|"
+ texinfo-chapter-level-regexp
+ "\\)[ \t]*\\)")))
+ "*Regexps for searching for higher level sections in a Texinfo file.
+The keys are strings specifying the general hierarchical level in the
+document; the values are regular expressions.")
+
+(defvar texinfo-update-menu-lower-regexps
+ '(("top" .
+ (concat
+ "\\(^@\\("
+ texinfo-chapter-level-regexp
+ "\\|"
+ texinfo-section-level-regexp
+ "\\|"
+ texinfo-subsection-level-regexp
+ "\\|"
+ texinfo-subsubsection-level-regexp
+ "\\)[ \t]*\\)"))
+ ("chapter" .
+ (concat
+ "\\(^@\\("
+ texinfo-section-level-regexp
+ "\\|"
+ texinfo-subsection-level-regexp
+ "\\|"
+ texinfo-subsubsection-level-regexp
+ "\\)[ \t]*\\)"))
+ ("section" .
+ (concat
+ "\\(^@\\("
+ texinfo-subsection-level-regexp
+ "\\|"
+ texinfo-subsubsection-level-regexp
+ "\\)[ \t]+\\)"))
+ ("subsection" .
+ (concat
+ "\\(^@\\("
+ texinfo-subsubsection-level-regexp
+ "\\)[ \t]+\\)"))
+ ("subsubsection" . "nothing lower"))
+ "*Regexps for searching for lower level sections in a Texinfo file.
+The keys are strings specifying the general hierarchical level in the
+document; the values are regular expressions.")
+
+
+;;; Updating a node
+
+;;;###autoload
+(defun texinfo-update-node (&optional region-p)
+ "Without any prefix argument, update the node in which point is located.
+Non-nil argument (prefix, if interactive) means update the nodes in the
+marked region.
+
+The functions for creating or updating nodes and menus, and their
+keybindings, are:
+
+ texinfo-update-node (&optional region-p) \\[texinfo-update-node]
+ texinfo-every-node-update () \\[texinfo-every-node-update]
+ texinfo-sequential-node-update (&optional region-p)
+
+ texinfo-make-menu (&optional region-p) \\[texinfo-make-menu]
+ texinfo-all-menus-update () \\[texinfo-all-menus-update]
+ texinfo-master-menu ()
+
+ texinfo-indent-menu-description (column &optional region-p)
+
+The `texinfo-column-for-description' variable specifies the column to
+which menu descriptions are indented. Its default value is 32."
+
+ (interactive "P")
+ (if (not region-p)
+ ;; update a single node
+ (let ((auto-fill-function nil) (auto-fill-hook nil))
+ (if (not (re-search-backward "^@node" (point-min) t))
+ (error "Node line not found before this position."))
+ (texinfo-update-the-node)
+ (message "Done...updated the node. You may save the buffer."))
+ ;; else
+ (let ((auto-fill-function nil)
+ (auto-fill-hook nil)
+ (beginning (region-beginning))
+ (end (region-end)))
+ (if (= end beginning)
+ (error "Please mark a region!"))
+ (save-restriction
+ (narrow-to-region beginning end)
+ (goto-char beginning)
+ (push-mark (point) t)
+ (while (re-search-forward "^@node" (point-max) t)
+ (beginning-of-line)
+ (texinfo-update-the-node))
+ (message "Done...updated nodes in region. You may save the buffer.")))))
+
+;;;###autoload
+(defun texinfo-every-node-update ()
+ "Update every node in a Texinfo file."
+ (interactive)
+ (save-excursion
+ (push-mark (point-max) t)
+ (goto-char (point-min))
+ ;; Using the mark to pass bounds this way
+ ;; is kludgy, but it's not worth fixing. -- rms.
+ (let ((mark-active t))
+ (texinfo-update-node t))
+ (message "Done...updated every node. You may save the buffer.")))
+
+(defun texinfo-update-the-node ()
+ "Update one node. Point must be at the beginning of node line.
+Leave point at the end of the node line."
+ (texinfo-check-for-node-name)
+ (texinfo-delete-existing-pointers)
+ (message "Updating node: %s ... " (texinfo-copy-node-name))
+ (save-restriction
+ (widen)
+ (let*
+ ((case-fold-search t)
+ (level (texinfo-hierarchic-level))
+ (beginning (texinfo-update-menu-region-beginning level))
+ (end (texinfo-update-menu-region-end level)))
+ (if (string-equal level "top")
+ (texinfo-top-pointer-case)
+ ;; else
+ (texinfo-insert-pointer beginning end level 'next)
+ (texinfo-insert-pointer beginning end level 'previous)
+ (texinfo-insert-pointer beginning end level 'up)
+ (texinfo-clean-up-node-line)))))
+
+(defun texinfo-top-pointer-case ()
+ "Insert pointers in the Top node. This is a special case.
+
+The `Next' pointer is a pointer to a chapter or section at a lower
+hierarchical level in the file. The `Previous' and `Up' pointers are
+to `(dir)'. Point must be at the beginning of the node line, and is
+left at the end of the node line."
+
+ (texinfo-clean-up-node-line)
+ (insert ", "
+ (save-excursion
+ ;; There may be an @chapter or other such command between
+ ;; the top node line and the next node line, as a title
+ ;; for an `ifinfo' section. This @chapter command must
+ ;; must be skipped. So the procedure is to search for
+ ;; the next `@node' line, and then copy its name.
+ (if (re-search-forward "^@node" nil t)
+ (progn
+ (beginning-of-line)
+ (texinfo-copy-node-name))
+ " "))
+ ", (dir), (dir)"))
+
+(defun texinfo-check-for-node-name ()
+ "Determine whether the node has a node name. Prompt for one if not.
+Point must be at beginning of node line. Does not move point."
+ (save-excursion
+ (let ((initial (texinfo-copy-next-section-title)))
+ ;; This is not clean. Use `interactive' to read the arg.
+ (forward-word 1) ; skip over node command
+ (skip-chars-forward " \t") ; and over spaces
+ (if (not (looking-at "[^,\t\n ]+")) ; regexp based on what Info looks for
+ ; alternatively, use "[a-zA-Z]+"
+ (let ((node-name
+ (read-from-minibuffer
+ "Node name (use no @, commas, colons, or apostrophes): "
+ initial)))
+ (insert " " node-name))))))
+
+(defun texinfo-delete-existing-pointers ()
+ "Delete `Next', `Previous', and `Up' pointers.
+Starts from the current position of the cursor, and searches forward
+on the line for a comma and if one is found, deletes the rest of the
+line, including the comma. Leaves point at beginning of line."
+ (let ((eol-point (save-excursion (end-of-line) (point))))
+ (if (search-forward "," eol-point t)
+ (delete-region (1- (point)) eol-point)))
+ (beginning-of-line))
+
+(defun texinfo-find-pointer (beginning end level direction)
+ "Move point to section associated with next, previous, or up pointer.
+Return type of pointer (either 'normal or 'no-pointer).
+
+The first and second arguments bound the search for a pointer to the
+beginning and end, respectively, of the enclosing higher level
+section. The third argument is a string specifying the general kind
+of section such as \"chapter\" or \"section\". When looking for the
+`Next' pointer, the section found will be at the same hierarchical
+level in the Texinfo file; when looking for the `Previous' pointer,
+the section found will be at the same or higher hierarchical level in
+the Texinfo file; when looking for the `Up' pointer, the section found
+will be at some level higher in the Texinfo file. The fourth argument
+\(one of 'next, 'previous, or 'up\) specifies whether to find the
+`Next', `Previous', or `Up' pointer."
+ (let ((case-fold-search t))
+ (cond ((eq direction 'next)
+ (forward-line 3) ; skip over current node
+ ;; Search for section commands accompanied by node lines;
+ ;; ignore section commands in the middle of nodes.
+ (if (re-search-forward
+ ;; A `Top' node is never a next pointer, so won't find it.
+ (concat
+ ;; Match node line.
+ "\\(^@node\\).*\n"
+ ;; Match comment or ifinfo line, if any
+ "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?"
+ (eval
+ (cdr (assoc level texinfo-update-menu-same-level-regexps))))
+ end
+ t)
+ 'normal
+ 'no-pointer))
+ ((eq direction 'previous)
+ (if (re-search-backward
+ (concat
+ "\\("
+ ;; Match node line.
+ "\\(^@node\\).*\n"
+ ;; Match comment or ifinfo line, if any
+ "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?"
+ (eval
+ (cdr (assoc level texinfo-update-menu-same-level-regexps)))
+ "\\|"
+ ;; Match node line.
+ "\\(^@node\\).*\n"
+ ;; Match comment or ifinfo line, if any
+ "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?"
+ (eval
+ (cdr (assoc level texinfo-update-menu-higher-regexps)))
+ "\\|"
+ ;; Handle `Top' node specially.
+ "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
+ "\\)")
+ beginning
+ t)
+ 'normal
+ 'no-pointer))
+ ((eq direction 'up)
+ (if (re-search-backward
+ (concat
+ "\\("
+ ;; Match node line.
+ "\\(^@node\\).*\n"
+ ;; Match comment or ifinfo line, if any
+ "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?"
+ (eval (cdr (assoc level texinfo-update-menu-higher-regexps)))
+ "\\|"
+ ;; Handle `Top' node specially.
+ "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
+ "\\)")
+ (save-excursion
+ (goto-char beginning)
+ (beginning-of-line)
+ (point))
+ t)
+ 'normal
+ 'no-pointer))
+ (t
+ (error "texinfo-find-pointer: lack proper arguments")))))
+
+(defun texinfo-pointer-name (kind)
+ "Return the node name preceding the section command.
+The argument is the kind of section, either normal or no-pointer."
+ (let (name)
+ (cond ((eq kind 'normal)
+ (end-of-line) ; this handles prev node top case
+ (re-search-backward ; when point is already
+ "^@node" ; at the beginning of @node line
+ (save-excursion (forward-line -3))
+ t)
+ (setq name (texinfo-copy-node-name)))
+ ((eq kind 'no-pointer)
+ (setq name " "))) ; put a blank in the pointer slot
+ name))
+
+(defun texinfo-insert-pointer (beginning end level direction)
+ "Insert the `Next', `Previous' or `Up' node name at point.
+Move point forward.
+
+The first and second arguments bound the search for a pointer to the
+beginning and end, respectively, of the enclosing higher level
+section. The third argument is the hierarchical level of the Texinfo
+file, a string such as \"section\". The fourth argument is direction
+towards which the pointer is directed, one of `next, `previous, or
+'up."
+
+ (end-of-line)
+ (insert
+ ", "
+ (save-excursion
+ (texinfo-pointer-name
+ (texinfo-find-pointer beginning end level direction)))))
+
+(defun texinfo-clean-up-node-line ()
+ "Remove extra commas, if any, at end of node line."
+ (end-of-line)
+ (skip-chars-backward ", ")
+ (delete-region (point) (save-excursion (end-of-line) (point))))
+
+
+;;; Updating nodes sequentially
+;; These sequential update functions insert `Next' or `Previous'
+;; pointers that point to the following or preceding nodes even if they
+;; are at higher or lower hierarchical levels. This means that if a
+;; section contains one or more subsections, the section's `Next'
+;; pointer will point to the subsection and not the following section.
+;; (The subsection to which `Next' points will most likely be the first
+;; item on the section's menu.)
+
+;;;###autoload
+(defun texinfo-sequential-node-update (&optional region-p)
+ "Update one node (or many) in a Texinfo file with sequential pointers.
+
+This function causes the `Next' or `Previous' pointer to point to the
+immediately preceding or following node, even if it is at a higher or
+lower hierarchical level in the document. Continually pressing `n' or
+`p' takes you straight through the file.
+
+Without any prefix argument, update the node in which point is located.
+Non-nil argument (prefix, if interactive) means update the nodes in the
+marked region.
+
+This command makes it awkward to navigate among sections and
+subsections; it should be used only for those documents that are meant
+to be read like a novel rather than a reference, and for which the
+Info `g*' command is inadequate."
+
+ (interactive "P")
+ (if (not region-p)
+ ;; update a single node
+ (let ((auto-fill-function nil) (auto-fill-hook nil))
+ (if (not (re-search-backward "^@node" (point-min) t))
+ (error "Node line not found before this position."))
+ (texinfo-sequentially-update-the-node)
+ (message
+ "Done...sequentially updated the node . You may save the buffer."))
+ ;; else
+ (let ((auto-fill-function nil)
+ (auto-fill-hook nil)
+ (beginning (region-beginning))
+ (end (region-end)))
+ (if (= end beginning)
+ (error "Please mark a region!"))
+ (save-restriction
+ (narrow-to-region beginning end)
+ (goto-char beginning)
+ (push-mark (point) t)
+ (while (re-search-forward "^@node" (point-max) t)
+ (beginning-of-line)
+ (texinfo-sequentially-update-the-node))
+ (message
+ "Done...updated the nodes in sequence. You may save the buffer.")))))
+
+(defun texinfo-sequentially-update-the-node ()
+ "Update one node such that the pointers are sequential.
+A `Next' or `Previous' pointer points to any preceding or following node,
+regardless of its hierarchical level."
+
+ (texinfo-check-for-node-name)
+ (texinfo-delete-existing-pointers)
+ (message
+ "Sequentially updating node: %s ... " (texinfo-copy-node-name))
+ (save-restriction
+ (widen)
+ (let*
+ ((case-fold-search t)
+ (level (texinfo-hierarchic-level)))
+ (if (string-equal level "top")
+ (texinfo-top-pointer-case)
+ ;; else
+ (texinfo-sequentially-insert-pointer level 'next)
+ (texinfo-sequentially-insert-pointer level 'previous)
+ (texinfo-sequentially-insert-pointer level 'up)
+ (texinfo-clean-up-node-line)))))
+
+(defun texinfo-sequentially-find-pointer (level direction)
+ "Find next or previous pointer sequentially in Texinfo file, or up pointer.
+Move point to section associated with the pointer. Find point even if
+it is in a different section.
+
+Return type of pointer (either 'normal or 'no-pointer).
+
+The first argument is a string specifying the general kind of section
+such as \"chapter\" or \"section\". The section found will be at the
+same hierarchical level in the Texinfo file, or, in the case of the up
+pointer, some level higher. The second argument (one of 'next,
+'previous, or 'up) specifies whether to find the `Next', `Previous',
+or `Up' pointer."
+ (let ((case-fold-search t))
+ (cond ((eq direction 'next)
+ (forward-line 3) ; skip over current node
+ (if (re-search-forward
+ texinfo-section-types-regexp
+ (point-max)
+ t)
+ 'normal
+ 'no-pointer))
+ ((eq direction 'previous)
+ (if (re-search-backward
+ texinfo-section-types-regexp
+ (point-min)
+ t)
+ 'normal
+ 'no-pointer))
+ ((eq direction 'up)
+ (if (re-search-backward
+ (eval (cdr (assoc level texinfo-update-menu-higher-regexps)))
+ beginning
+ t)
+ 'normal
+ 'no-pointer))
+ (t
+ (error "texinfo-sequential-find-pointer: lack proper arguments")))))
+
+(defun texinfo-sequentially-insert-pointer (level direction)
+ "Insert the `Next', `Previous' or `Up' node name at point.
+Move point forward.
+
+The first argument is the hierarchical level of the Texinfo file, a
+string such as \"section\". The second argument is direction, one of
+`next, `previous, or 'up."
+
+ (end-of-line)
+ (insert
+ ", "
+ (save-excursion
+ (texinfo-pointer-name
+ (texinfo-sequentially-find-pointer level direction)))))
+
+
+;;; Inserting `@node' lines
+;; The `texinfo-insert-node-lines' function inserts `@node' lines as needed
+;; before the `@chapter', `@section', and such like lines of a region
+;; in a Texinfo file.
+
+(defun texinfo-insert-node-lines (beginning end &optional title-p)
+ "Insert missing `@node' lines in region of Texinfo file.
+Non-nil argument (prefix, if interactive) means also to insert the
+section titles as node names; and also to insert the section titles as
+node names in pre-existing @node lines that lack names."
+ (interactive "r\nP")
+
+ ;; Use marker; after inserting node lines, leave point at end of
+ ;; region and mark at beginning.
+
+ (let (beginning-marker end-marker title last-section-position)
+
+ ;; Save current position on mark ring and set mark to end.
+ (push-mark end t)
+ (setq end-marker (mark-marker))
+
+ (goto-char beginning)
+ (while (re-search-forward
+ texinfo-section-types-regexp
+ end-marker
+ 'end)
+ ;; Copy title if desired.
+ (if title-p
+ (progn
+ (beginning-of-line)
+ (forward-word 1)
+ (skip-chars-forward " \t")
+ (setq title (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))))
+ ;; Insert node line if necessary.
+ (if (re-search-backward
+ "^@node"
+ ;; Avoid finding previous node line if node lines are close.
+ (or last-section-position
+ (save-excursion (forward-line -2) (point))) t)
+ ;; @node is present, and point at beginning of that line
+ (forward-word 1) ; Leave point just after @node.
+ ;; Else @node missing; insert one.
+ (beginning-of-line) ; Beginning of `@section' line.
+ (insert "@node\n")
+ (backward-char 1)) ; Leave point just after `@node'.
+ ;; Insert title if desired.
+ (if title-p
+ (progn
+ (skip-chars-forward " \t")
+ ;; Use regexp based on what info looks for
+ ;; (alternatively, use "[a-zA-Z]+");
+ ;; this means we only insert a title if none exists.
+ (if (not (looking-at "[^,\t\n ]+"))
+ (progn
+ (beginning-of-line)
+ (forward-word 1)
+ (insert " " title)
+ (message "Inserted title %s ... " title)))))
+ ;; Go forward beyond current section title.
+ (re-search-forward texinfo-section-types-regexp
+ (save-excursion (forward-line 3) (point)) t)
+ (setq last-section-position (point))
+ (forward-line 1))
+
+ ;; Leave point at end of region, mark at beginning.
+ (set-mark beginning)
+
+ (if title-p
+ (message
+ "Done inserting node lines and titles. You may save the buffer.")
+ (message "Done inserting node lines. You may save the buffer."))))
+
+
+;;; Update and create menus for multi-file Texinfo sources
+
+;; 1. M-x texinfo-multiple-files-update
+;;
+;; Read the include file list of an outer Texinfo file and
+;; update all highest level nodes in the files listed and insert a
+;; main menu in the outer file after its top node.
+
+;; 2. C-u M-x texinfo-multiple-files-update
+;;
+;; Same as 1, but insert a master menu. (Saves reupdating lower
+;; level menus and nodes.) This command simply reads every menu,
+;; so if the menus are wrong, the master menu will be wrong.
+;; Similarly, if the lower level node pointers are wrong, they
+;; will stay wrong.
+
+;; 3. C-u 2 M-x texinfo-multiple-files-update
+;;
+;; Read the include file list of an outer Texinfo file and
+;; update all nodes and menus in the files listed and insert a
+;; master menu in the outer file after its top node.
+
+;;; Note: these functions:
+;;;
+;;; * Do not save or delete any buffers. You may fill up your memory.
+;;; * Do not handle any pre-existing nodes in outer file.
+;;; Hence, you may need a file for indices.
+
+
+;;; Auxiliary functions for multiple file updating
+
+(defun texinfo-multi-file-included-list (outer-file)
+ "Return a list of the included files in OUTER-FILE."
+ (let ((included-file-list (list outer-file))
+ start)
+ (save-excursion
+ (switch-to-buffer (find-file-noselect outer-file))
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward "^@include" nil t)
+ (skip-chars-forward " \t")
+ (setq start (point))
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (setq included-file-list
+ (cons (buffer-substring start (point))
+ included-file-list)))
+ (nreverse included-file-list))))
+
+(defun texinfo-copy-next-section-title ()
+ "Return the name of the immediately following section as a string.
+
+Start with point at the beginning of the node line. Leave point at the
+same place. If there is no title, returns an empty string."
+
+ (save-excursion
+ (end-of-line)
+ (let ((node-end (or
+ (save-excursion
+ (if (re-search-forward "\\(^@node\\)" nil t)
+ (match-beginning 0)))
+ (point-max))))
+ (if (re-search-forward texinfo-section-types-regexp node-end t)
+ (progn
+ (beginning-of-line)
+ ;; copy title
+ (let ((title
+ (buffer-substring
+ (progn (forward-word 1) ; skip over section type
+ (skip-chars-forward " \t") ; and over spaces
+ (point))
+ (progn (end-of-line) (point)))))
+ title))
+ ""))))
+
+(defun texinfo-multi-file-update (files &optional update-everything)
+ "Update first node pointers in each file in FILES.
+Return a list of the node names.
+
+The first file in the list is an outer file; the remaining are
+files included in the outer file with `@include' commands.
+
+If optional arg UPDATE-EVERYTHING non-nil, update every menu and
+pointer in each of the included files.
+
+Also update the `Top' level node pointers of the outer file.
+
+Requirements:
+
+ * the first file in the FILES list must be the outer file,
+ * each of the included files must contain exactly one highest
+ hierarchical level node,
+ * this node must be the first node in the included file,
+ * each highest hierarchical level node must be of the same type.
+
+Thus, normally, each included file contains one, and only one,
+chapter."
+
+;; The menu-list has the form:
+;;
+;; \(\(\"node-name1\" . \"title1\"\)
+;; \(\"node-name2\" . \"title2\"\) ... \)
+;;
+;; However, there does not need to be a title field and this function
+;; does not fill it; however a comment tells you how to do so.
+;; You would use the title field if you wanted to insert titles in the
+;; description slot of a menu as a description.
+
+ (let ((case-fold-search t)
+ menu-list)
+
+ ;; Find the name of the first node of the first included file.
+ (switch-to-buffer (find-file-noselect (car (cdr files))))
+ (widen)
+ (goto-char (point-min))
+ (if (not (re-search-forward "^@node" nil t))
+ (error "No `@node' line found in %s !" (buffer-name)))
+ (beginning-of-line)
+ (texinfo-check-for-node-name)
+ (setq next-node-name (texinfo-copy-node-name))
+
+ (setq menu-list
+ (cons (cons
+ next-node-name
+ (prog1 "" (forward-line 1)))
+ ;; Use following to insert section titles automatically.
+ ;; (texinfo-copy-next-section-title)
+ menu-list))
+
+ ;; Go to outer file
+ (switch-to-buffer (find-file-noselect (car files)))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
+ (error "This buffer needs a Top node!"))
+ (beginning-of-line)
+ (texinfo-delete-existing-pointers)
+ (end-of-line)
+ (insert ", " next-node-name ", (dir), (dir)")
+ (beginning-of-line)
+ (setq previous-node-name "Top")
+ (setq files (cdr files))
+
+ (while files
+
+ (if (not (cdr files))
+ ;; No next file
+ (setq next-node-name "")
+ ;; Else,
+ ;; find the name of the first node in the next file.
+ (switch-to-buffer (find-file-noselect (car (cdr files))))
+ (widen)
+ (goto-char (point-min))
+ (if (not (re-search-forward "^@node" nil t))
+ (error "No `@node' line found in %s !" (buffer-name)))
+ (beginning-of-line)
+ (texinfo-check-for-node-name)
+ (setq next-node-name (texinfo-copy-node-name))
+ (setq menu-list
+ (cons (cons
+ next-node-name
+ (prog1 "" (forward-line 1)))
+ ;; Use following to insert section titles automatically.
+ ;; (texinfo-copy-next-section-title)
+ menu-list)))
+
+ ;; Go to node to be updated.
+ (switch-to-buffer (find-file-noselect (car files)))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^@node" nil t))
+ (error "No `@node' line found in %s !" (buffer-name)))
+ (beginning-of-line)
+
+ ;; Update other menus and nodes if requested.
+ (if update-everything (texinfo-all-menus-update t))
+
+ (beginning-of-line)
+ (texinfo-delete-existing-pointers)
+ (end-of-line)
+ (insert ", " next-node-name ", " previous-node-name ", " up-node-name)
+
+ (beginning-of-line)
+ (setq previous-node-name (texinfo-copy-node-name))
+
+ (setq files (cdr files)))
+ (nreverse menu-list)))
+
+(defun texinfo-multi-files-insert-main-menu (menu-list)
+ "Insert formatted main menu at point.
+Indents the first line of the description, if any, to the value of
+texinfo-column-for-description."
+
+ (insert "@menu\n")
+ (while menu-list
+ ;; Every menu entry starts with a star and a space.
+ (insert "* ")
+
+ ;; Insert the node name (and menu entry name, if present).
+ (let ((node-part (car (car menu-list))))
+ (if (stringp node-part)
+ ;; "Double colon" entry line; menu entry and node name are the same,
+ (insert (format "%s::" node-part))
+ ;; "Single colon" entry line; menu entry and node name are different.
+ (insert (format "%s: %s." (car node-part) (cdr node-part)))))
+
+ ;; Insert the description, if present.
+ (if (cdr (car menu-list))
+ (progn
+ ;; Move to right place.
+ (indent-to texinfo-column-for-description 2)
+ ;; Insert description.
+ (insert (format "%s" (cdr (car menu-list))))))
+
+ (insert "\n") ; end this menu entry
+ (setq menu-list (cdr menu-list)))
+ (insert "@end menu"))
+
+(defun texinfo-multi-file-master-menu-list (files-list)
+ "Return master menu list from files in FILES-LIST.
+Menu entries in each file collected using `texinfo-master-menu-list'.
+
+The first file in FILES-LIST must be the outer file; the others must
+be the files included within it. A main menu must already exist."
+ (save-excursion
+ (let (master-menu-list)
+ (while files-list
+ (switch-to-buffer (find-file-noselect (car files-list)))
+ (message "Working on: %s " (current-buffer))
+ (goto-char (point-min))
+ (setq master-menu-list
+ (append master-menu-list (texinfo-master-menu-list)))
+ (setq files-list (cdr files-list)))
+ master-menu-list)))
+
+
+;;; The multiple-file update function
+
+(defun texinfo-multiple-files-update
+ (outer-file &optional update-everything make-master-menu)
+ "Update first node pointers in each file included in OUTER-FILE;
+create or update the `Top' level node pointers and the main menu in
+the outer file that refers to such nodes. This does not create or
+update menus or pointers within the included files.
+
+With optional MAKE-MASTER-MENU argument (prefix arg, if interactive),
+insert a master menu in OUTER-FILE in addition to creating or updating
+pointers in the first @node line in each included file and creating or
+updating the `Top' level node pointers of the outer file. This does
+not create or update other menus and pointers within the included
+files.
+
+With optional UPDATE-EVERYTHING argument (numeric prefix arg, if
+interactive), update all the menus and all the `Next', `Previous', and
+`Up' pointers of all the files included in OUTER-FILE before inserting
+a master menu in OUTER-FILE. Also, update the `Top' level node
+pointers of OUTER-FILE.
+
+Notes:
+
+ * this command does NOT save any files--you must save the
+ outer file and any modified, included files.
+
+ * except for the `Top' node, this command does NOT handle any
+ pre-existing nodes in the outer file; hence, indices must be
+ enclosed in an included file.
+
+Requirements:
+
+ * each of the included files must contain exactly one highest
+ hierarchical level node,
+ * this highest node must be the first node in the included file,
+ * each highest hierarchical level node must be of the same type.
+
+Thus, normally, each included file contains one, and only one,
+chapter."
+
+ (interactive (cons
+ (read-string
+ "Name of outer `include' file: "
+ (buffer-file-name))
+ (cond ((not current-prefix-arg)
+ '(nil nil))
+ ((listp current-prefix-arg)
+ '(t nil)) ; make-master-menu
+ ((numberp current-prefix-arg)
+ '(t t)) ; update-everything
+ )))
+
+ (let* ((included-file-list (texinfo-multi-file-included-list outer-file))
+ (files included-file-list)
+ main-menu-list
+ next-node-name
+ previous-node-name
+ (up-node-name "Top"))
+
+;;; Update the pointers
+;;; and collect the names of the nodes and titles
+ (setq main-menu-list (texinfo-multi-file-update files update-everything))
+
+;;; Insert main menu
+
+ ;; Go to outer file
+ (switch-to-buffer (find-file-noselect (car included-file-list)))
+ (if (texinfo-old-menu-p
+ (point-min)
+ (save-excursion
+ (re-search-forward "^@include")
+ (beginning-of-line)
+ (point)))
+
+ ;; If found, leave point after word `menu' on the `@menu' line.
+ (progn
+ (texinfo-incorporate-descriptions main-menu-list)
+ ;; Delete existing menu.
+ (beginning-of-line)
+ (delete-region
+ (point)
+ (save-excursion (re-search-forward "^@end menu") (point)))
+ ;; Insert main menu
+ (texinfo-multi-files-insert-main-menu main-menu-list))
+
+ ;; Else no current menu; insert it before `@include'
+ (texinfo-multi-files-insert-main-menu main-menu-list))
+
+;;; Insert master menu
+
+ (if make-master-menu
+ (progn
+ ;; First, removing detailed part of any pre-existing master menu
+ (goto-char (point-min))
+ (if (re-search-forward texinfo-master-menu-header nil t)
+ ;; Remove detailed master menu listing
+ (progn
+ (goto-char (match-beginning 0))
+ (let ((end-of-detailed-menu-descriptions
+ (save-excursion ; beginning of end menu line
+ (goto-char (texinfo-menu-end))
+ (beginning-of-line) (forward-char -1)
+ (point))))
+ (delete-region (point) end-of-detailed-menu-descriptions))))
+
+ ;; Create a master menu and insert it
+ (texinfo-insert-master-menu-list
+ (texinfo-multi-file-master-menu-list
+ included-file-list)))))
+
+ ;; Remove unwanted extra lines.
+ (save-excursion
+ (goto-char (point-min))
+
+ (re-search-forward "^@menu")
+ (forward-line -1)
+ (insert "\n") ; Ensure at least one blank line.
+ (delete-blank-lines)
+
+ (re-search-forward "^@end menu")
+ (forward-line 1)
+ (insert "\n") ; Ensure at least one blank line.
+ (delete-blank-lines))
+
+ (message "Multiple files updated."))
+
+
+;;; Place `provide' at end of file.
+(provide 'texnfo-upd)
+
+;;; texnfo-upd.el ends here
diff --git a/texinfo/gen-info-dir b/texinfo/gen-info-dir
new file mode 100755
index 00000000000..ede0daa7e7b
--- /dev/null
+++ b/texinfo/gen-info-dir
@@ -0,0 +1,101 @@
+#!/bin/sh
+#
+# generate an Info directory, given a directory of Info files and a
+# list of entries. The output will be suitable for a dir.info file,
+# in the order given in the skeleton file
+
+INFODIR=$1
+if [ $# = 2 ] ; then
+ SKELETON=$2
+else
+ SKELETON=/dev/null
+fi
+
+skip=
+
+if [ $# -gt 2 ] ; then
+ echo usage: $0 info-directory [ skeleton-file ] 1>&2
+ exit 1
+else
+ true
+fi
+
+if [ ! -d ${INFODIR} ] ; then
+ echo "$0: first argument must specify a directory"
+ exit 1
+fi
+
+infofiles=`(cd ${INFODIR}; ls *.info | sort | sed "s/dir\.info//")`
+template=`cat ${SKELETON}`
+
+### output the dir.info header
+echo "-*- Text -*-"
+echo "This file was generated automatically by the gen-info-dir script."
+echo "This version was generated on `date`"
+echo "by `whoami`@`hostname` for `(cd ${INFODIR}; pwd)`"
+
+cat << moobler
+
+This is the file .../info/dir, which contains the topmost node of the
+Info hierarchy. The first time you invoke Info you start off
+looking at that node, which is (dir)Top.
+
+File: dir Node: Top This is the top of the INFO tree
+ This (the Directory node) gives a menu of major topics.
+ Typing "d" returns here, "q" exits, "?" lists all INFO commands, "h"
+ gives a primer for first-timers, "mTexinfo<Return>" visits Texinfo topic,
+ etc.
+ --- PLEASE ADD DOCUMENTATION TO THIS TREE. (See INFO topic first.) ---
+
+* Menu: The list of major topics begins on the next line.
+
+moobler
+
+
+### go through the list of files in the template. If an info file
+### exists, grab the ENTRY information from it. If there is no entry
+### info, then create a minimal dir entry, otherwise use the given info.
+###
+### Then remove that file from the list of existing files. If any
+### additional files remain (ones that don't have a template entry),
+### then generate entries for those in the same way, putting the info for
+### those at the very end....
+
+for file in ${template} ; do
+ if [ "${file}" = "--" ] ; then
+ skip=1
+ else
+ if [ -f ${INFODIR}/${file}.info ] ; then
+ entry=`sed -e '1,/START-INFO-DIR-ENTRY/d' -e '/END-INFO-DIR-ENTRY/,$d' ${INFODIR}/${file}.info`
+ if [ ! -z "${skip}" ] ; then
+ echo
+ skip=
+ fi
+
+ if [ ! -z "${entry}" ] ; then
+ echo "${entry}"
+ else
+ echo "* ${file}: (${file})."
+ fi
+
+ infofiles=`echo ${infofiles} | sed -e "s/${file}\.info//"`
+ fi
+ fi
+done
+
+if [ -z "${infofiles}" ] ; then
+ exit 0
+else
+ echo
+fi
+
+for file in ${infofiles}; do
+ entry=`sed -e '1,/START-INFO-DIR-ENTRY/d' -e '/END-INFO-DIR-ENTRY/,$d' ${INFODIR}/${file}`
+
+ if [ ! -z "${entry}" ] ; then
+ echo "${entry}"
+ else
+ echo "* ${file}: (${file})."
+ fi
+done
+
diff --git a/texinfo/gpl.texinfo b/texinfo/gpl.texinfo
new file mode 100644
index 00000000000..ce7d62ec8f8
--- /dev/null
+++ b/texinfo/gpl.texinfo
@@ -0,0 +1,398 @@
+@c This GPL is meant to be included from other files.
+@c To format a standalone GPL, use license.texi.
+
+@center Version 2, June 1991
+
+@display
+Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc. 675
+Mass Ave, Boston, MA 02111-1307, USA
+
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+@end display
+
+@unnumberedsec Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software---to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, 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 software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, 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 redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+@iftex
+@unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+@end iftex
+@ifinfo
+@center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+@end ifinfo
+
+@enumerate 0
+@item
+This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The ``Program'', below,
+refers to any such program or work, and a ``work based on the Program''
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term ``modification''.) Each licensee is addressed as ``you''.
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+@item
+You may copy and distribute verbatim copies of the Program's
+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 give any other recipients of the Program a copy of this License
+along with the Program.
+
+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.
+
+@item
+You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+@enumerate a
+@item
+You must cause the modified files to carry prominent notices
+stating that you changed the files and the date of any change.
+
+@item
+You must cause any work that you distribute or publish, that in
+whole or in part contains or is derived from the Program or any
+part thereof, to be licensed as a whole at no charge to all third
+parties under the terms of this License.
+
+@item
+If the modified program normally reads commands interactively
+when run, you must cause it, when started running for such
+interactive use in the most ordinary way, to print or display an
+announcement including an appropriate copyright notice and a
+notice that there is no warranty (or else, saying that you provide
+a warranty) and that users may redistribute the program under
+these conditions, and telling the user how to view a copy of this
+License. (Exception: if the Program itself is interactive but
+does not normally print such an announcement, your work based on
+the Program is not required to print an announcement.)
+@end enumerate
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+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 Program, 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 Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+@item
+You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+@enumerate a
+@item
+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; or,
+
+@item
+Accompany it with a written offer, valid for at least three
+years, to give any third party, for a charge no more than your
+cost of physically performing source distribution, a complete
+machine-readable copy of the corresponding source code, to be
+distributed under the terms of Sections 1 and 2 above on a medium
+customarily used for software interchange; or,
+
+@item
+Accompany it with the information you received as to the offer
+to distribute corresponding source code. (This alternative is
+allowed only for noncommercial distribution and only if you
+received the program in object code or executable form with such
+an offer, in accord with Subsection b above.)
+@end enumerate
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, 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 executable. 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.
+
+If distribution of executable or 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 counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+@item
+You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program 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.
+
+@item
+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 Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+@item
+Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program 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.
+
+@item
+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 Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program 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 Program.
+
+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.
+
+@item
+If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program 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.
+
+@item
+The Free Software Foundation may publish revised and/or new versions
+of the 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 Program
+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 Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+@item
+If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, 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.
+
+@iftex
+@vskip -@baselineskip
+@vskip -@baselineskip
+@heading NO WARRANTY
+@end iftex
+@ifinfo
+@center NO WARRANTY
+@end ifinfo
+
+@item
+BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM ``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 PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+@item
+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 PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+@end enumerate
+
+@iftex
+@heading END OF TERMS AND CONDITIONS
+@end iftex
+@ifinfo
+@center END OF TERMS AND CONDITIONS
+@end ifinfo
+
+@page
+@unnumberedsec How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. 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.
+
+@smallexample
+@var{one line to give the program's name and an idea of what it does.}
+Copyright (C) 19@var{yy} @var{name of author}
+
+This program 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
+of the License, or (at your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+@end smallexample
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+@smallexample
+Gnomovision version 69, Copyright (C) 19@var{yy} @var{name of author}
+Gnomovision comes with ABSOLUTELY NO WARRANTY; for details
+type `show w'. This is free software, and you are welcome
+to redistribute it under certain conditions; type `show c'
+for details.
+@end smallexample
+
+The hypothetical commands @samp{show w} and @samp{show c} should show
+the appropriate parts of the General Public License. Of course, the
+commands you use may be called something other than @samp{show w} and
+@samp{show c}; they could even be mouse-clicks or menu items---whatever
+suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a ``copyright disclaimer'' for the program, if
+necessary. Here is a sample; alter the names:
+
+@example
+@group
+Yoyodyne, Inc., hereby disclaims all copyright
+interest in the program `Gnomovision'
+(which makes passes at compilers) written
+by James Hacker.
+
+@var{signature of Ty Coon}, 1 April 1989
+Ty Coon, President of Vice
+@end group
+@end example
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/texinfo/info/Makefile.in b/texinfo/info/Makefile.in
new file mode 100644
index 00000000000..776872ef68e
--- /dev/null
+++ b/texinfo/info/Makefile.in
@@ -0,0 +1,232 @@
+# Makefile for texinfo/info. -*- Indented-Text -*-
+# $Id: Makefile.in,v 1.1 1997/08/21 22:57:59 jason Exp $
+#
+# Copyright (C) 1993,96 Free Software Foundation, Inc.
+
+# This program 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.
+
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#### Start of system configuration section. ####
+
+srcdir = @srcdir@
+VPATH = $(srcdir):$(common)
+
+common = $(srcdir)/../libtxi
+util = $(srcdir)/../util
+
+EXEEXT = @EXEEXT@
+CC = @CC@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+LN = ln
+RM = rm -f
+MKDIR = mkdir
+MAKEINFO= ../makeinfo/makeinfo$(EXEEXT)
+
+DEFS = @DEFS@
+
+LDEFS = -DHANDLE_MAN_PAGES -DNAMED_FUNCTIONS=1 -DDEFAULT_INFOPATH='"$(DEFAULT_INFOPATH)"'
+
+TERMLIBS = @TERMLIBS@
+LIBS = $(TERMLIBS) -L../libtxi -ltxi @LIBS@
+LOADLIBES = $(LIBS)
+
+SHELL = /bin/sh
+
+CFLAGS = @CFLAGS@
+LDFLAGS = @LDFLAGS@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+# Prefix for each installed program, normally empty or `g'.
+binprefix =
+# Prefix for each installed man page, normally empty or `g'.
+manprefix =
+mandir = @mandir@/man1
+manext = 1
+infodir = @infodir@
+DEFAULT_INFOPATH= $(infodir):.
+
+#### End of system configuration section. ####
+
+SRCS = dir.c display.c echo_area.c filesys.c \
+ info-utils.c info.c infodoc.c infomap.c \
+ m-x.c nodes.c search.c session.c \
+ signals.c terminal.c tilde.c window.c \
+ xmalloc.c indices.c makedoc.c nodemenu.c \
+ footnotes.c dribble.c variables.c gc.c man.c \
+ clib.c
+
+HDRS = display.h doc.h echo_area.h filesys.h \
+ general.h getopt.h info-utils.h info.h \
+ infomap.h nodes.h search.h session.h \
+ signals.h termdep.h terminal.h tilde.h \
+ indices.h window.h footnotes.h dribble.h \
+ variables.h gc.h clib.h
+
+OBJS = dir.o display.o doc.o echo_area.o filesys.o info-utils.o info.o \
+ infodoc.o infomap.o m-x.o nodes.o search.o session.o signals.o \
+ terminal.o tilde.o window.o indices.o xmalloc.o nodemenu.o \
+ footnotes.o dribble.o variables.o gc.o man.o clib.o
+
+# The names of files which declare info commands.
+CMDFILES = $(srcdir)/session.c $(srcdir)/echo_area.c $(srcdir)/infodoc.c \
+ $(srcdir)/m-x.c $(srcdir)/indices.c $(srcdir)/nodemenu.c \
+ $(srcdir)/footnotes.c $(srcdir)/variables.c
+
+# The name of the program which builds documentation structure from CMDFILES.
+MAKEDOC_OBJECTS = makedoc.o clib.o xmalloc.o
+MAKEDOC_SOURCE = makedoc.c clib.c xmalloc.c
+
+infofiles = info.info info-stnd.info
+
+.c.o:
+ $(CC) -c $(CPPFLAGS) $(LDEFS) $(DEFS) -I. -I$(srcdir) -I$(common) $(CFLAGS) $<
+
+all: info$(EXEEXT) $(infofiles)
+sub-all: all
+
+dvi: all-dvi
+
+install: all
+ $(INSTALL_PROGRAM) info$(EXEEXT) $(bindir)/$(binprefix)info$(EXEEXT)
+ -$(INSTALL_DATA) $(srcdir)/info.1 $(mandir)/$(manprefix)info.$(manext)
+ $(POST_INSTALL)
+
+install-info:
+ -d=$(srcdir); test -f ./info.info && d=.; $(INSTALL_DATA) $$d/info.info $(infodir)/info.info
+ -d=$(srcdir); test -f ./info-stnd.info && d=.; $(INSTALL_DATA) $$d/info-stnd.info $(infodir)/info-stnd.info
+ ../util/install-info --info-dir=$(infodir) $(infodir)/info.info
+ ../util/install-info --info-dir=$(infodir) $(infodir)/info-stnd.info
+
+uninstall:
+ $(RM) $(bindir)/info$(EXEEXT)
+ $(RM) $(infodir)/info.info
+ $(RM) $(infodir)/info-stnd.info
+ $(RM) $(mandir)/$(manprefix)info.$(manext)
+
+info$(EXEEXT): $(OBJS) ../libtxi/libtxi.a
+ $(CC) $(LDFLAGS) -o $@ $(OBJS) $(LOADLIBES)
+
+all-info: info.info info-stnd.info
+
+info.info: info.texi
+ $(MAKEINFO) --no-split -I$(srcdir) info.texi
+
+info-stnd.info: info-stnd.texi
+ $(MAKEINFO) --no-split -I$(srcdir) info-stnd.texi
+
+dvi all-dvi: info.dvi info-stnd.dvi
+info.dvi: info.texi
+ PATH="$(util):$${PATH}" TEXINPUTS="$(srcdir):$(common):$${TEXINPUTS}" texi2dvi $(srcdir)/info.texi
+
+info-stnd.dvi: info-stnd.texi
+ PATH="$(util):$${PATH}" TEXINPUTS="$(srcdir):$(common):$${TEXINPUTS}" texi2dvi $(srcdir)/info-stnd.texi
+
+makedoc$(EXEEXT): $(MAKEDOC_OBJECTS) ../libtxi/libtxi.a
+ $(CC) $(LDFLAGS) -o $@ $(MAKEDOC_OBJECTS) $(LOADLIBES)
+
+Makefile: $(srcdir)/Makefile.in ../config.status
+ cd ..; $(SHELL) config.status
+
+clean:
+ $(RM) info$(EXEEXT) funs.h doc.c makedoc$(EXEEXT) $(OBJS) $(MAKEDOC_OBJECTS)
+
+distclean: clean texclean
+ $(RM) Makefile config.status config.cache *~ core core.* *.core
+ $(RM) *.BAK makedoc-TAGS TAGS \#* *.info*
+
+mostlyclean: clean
+
+realclean: distclean
+ $(RM) info.info info-stnd.info
+
+TAGS: $(SRCS) makedoc-TAGS
+ etags $(SRCS)
+ cat makedoc-TAGS >>TAGS && $(RM) makedoc-TAGS
+
+makedoc-TAGS: $(CMDFILES)
+ ./makedoc -tags $(CMDFILES) >makedoc-TAGS
+
+texclean:
+ $(RM) *.toc *.aux *.log *.cp *.fn *.tp *.vr *.pg *.ky *.cps
+ $(RM) *.tps *.fns *.kys *.pgs *.vrs
+
+check: info
+
+# The files `doc.c' and `funs.h' are created by ./makedoc run over the source
+# files which contain DECLARE_INFO_COMMAND. `funs.h' is a header file
+# listing the functions found. `doc.c' is a structure containing pointers
+# to those functions along with completable names and documentation strings.
+funs.h: makedoc$(EXEEXT) $(CMDFILES)
+ -@if test -f funs.h; then mv -f funs.h old-funs.h; fi; :
+ -@if test -f doc.c; then mv -f doc.c old-doc.c; fi; :
+ ./makedoc$(EXEEXT) $(CMDFILES)
+ -@if cmp -s old-funs.h funs.h; then mv old-funs.h funs.h; \
+ else $(RM) old-funs.h; fi; :
+ -@if cmp -s old-doc.c doc.c; then mv old-doc.c doc.c; \
+ else $(RM) old-doc.c; fi; :
+
+doc.c: funs.h
+dribble.o: dribble.c dribble.h
+display.o: display.c
+echo_area.o: echo_area.c
+filesys.o: filesys.c
+info-utils.o: info-utils.c
+info.o: info.c filesys.h
+infodoc.o: infodoc.c
+infomap.o: infomap.c
+m-x.o: m-x.c
+nodes.o: nodes.c
+search.o: search.c
+session.o: session.c
+signals.o: signals.c
+terminal.o: terminal.c
+tilde.o: tilde.c
+window.o: window.c
+xmalloc.o: xmalloc.c
+indices.o: indices.c
+makedoc.o: makedoc.c
+
+dir.o: dir.c
+display.o: nodes.h info-utils.h search.h
+display.o: terminal.h window.h display.h
+echo_area.o: info.h
+filesys.o: general.h tilde.h filesys.h
+footnotes.o: footnotes.h
+info-utils.o: info-utils.h nodes.h search.h
+info.o: info.h $(common)/getopt.h
+infodoc.o: info.h doc.h
+infomap.o: infomap.h funs.h
+gc.o: info.h
+m-x.o: info.h
+nodes.o: search.h filesys.h
+nodes.o: nodes.h info-utils.h
+search.o: general.h search.h nodes.h
+session.o: info.h
+signals.o: info.h signals.h
+terminal.o: terminal.h termdep.h
+tilde.o: tilde.h
+variables.c: variables.h
+window.o: nodes.h window.h display.h
+window.o: info-utils.h search.h infomap.h
+
+# Prevent GNU make v3 from overflowing arg limit on SysV.
+.NOEXPORT:
+
+# eof
diff --git a/texinfo/info/NEWS b/texinfo/info/NEWS
new file mode 100644
index 00000000000..b13fb1531b5
--- /dev/null
+++ b/texinfo/info/NEWS
@@ -0,0 +1,200 @@
+This release of Info is version 2.11. Please read the file README.
+
+Version 2.11, Sat Apr 1 09:15:21 1995
+
+Changes since 2.7 beta:
+
+Although the basic code remains the same, there are numerous nits
+fixed, including some display bugs, and a memory leak. Some changes
+that have taken place with larger impact include the way in which the
+(dir) node is built; I have added in support for "localdir"
+directories among other things. Info files may be stored in
+compressed formats, and in their own subdirectories; menu items which
+do not explicitly name the node to which they are attached have the
+menu item name looked up as an Info file if it is not found within the
+current document. This means that the menu item:
+
+* Info:: The Info documentation reader.
+
+in (dir) refers to the info node "(info)Top".
+
+Please see the ChangeLog and documentation for details on other
+changes.
+
+Version 2.7 beta, Wed Dec 30 02:02:38 1992
+Version 2.6 beta, Tue Dec 22 03:58:07 1992
+Version 2.5 beta, Tue Dec 8 14:50:35 1992
+Version 2.4 beta, Sat Nov 28 14:34:02 1992
+Version 2.3 beta, Fri Nov 27 01:04:13 1992
+Version 2.2 beta, Tue Nov 24 09:36:08 1992
+Version 2.1 beta, Tue Nov 17 23:29:36 1992
+
+Changes since 2.5 beta:
+
+Note that versions 2.6 and 2.7 Beta were only released to a select group.
+
+* "info-" removed from the front of M-x commands.
+
+* Automatic footnote display. When you enter a node which contains
+ footnotes, and the variable "automatic-footnotes" is "On", Info pops
+ up a window containing the footnotes. Likewise, when you leave that
+ node, the window containing the footnotes goes away.
+
+* Cleaner built in documentation, and documentation functions.
+
+ Use:
+ o `M-x describe-variable' to read a variable's documenation
+ o `M-x describe-key' to find out what a particular keystroke does.
+ o `M-x describe-function' to read a function's documentation.
+ o `M-x where-is' to find out what keys invoke a particular function.
+
+* Info can "tile" the displayed windows (via "M-x tile-windows"). If
+ the variable "automatic-tiling" is "On", then splitting a window or
+ deleting a window causes the remaining windows to be retiled.
+
+* You can save every keystroke you type in a "dribble file" by using the
+ `--dribble FILENAME' option. You can initially read keystrokes from an
+ alternate input stream with `--restore FILENAME', or by redirecting
+ input on the command line `info < old-dribble'.
+
+* New behaviour of menu items. If the label is the same as the
+ target node name, and the node couldn't be found in the current file,
+ treat the label as a file name. For example, a menu entry in "DIR"
+ might contain:
+
+ * Emacs:: Cool text-editor.
+
+ Info would not find the node "(dir)Emacs", so just plain "(emacs)"
+ would be tried.
+
+* New variable "ISO-Latin" allows you to use European machines with
+ 8-bit character sets.
+
+* Cleanups in echo area reading, and redisplay. Cleanups in handling the
+ window which shows possible completions.
+
+* Info can now read files that have been compressed. An array in filesys.c
+ maps extensions to programs that can decompress stdin, and write the results
+ to stdout. Currently, ".Z"/uncompress, ".z"/gunzip, and ".Y"/unyabba are
+ supported. The modeline for a compressed file shows "zz" in it.
+
+* There is a new variable "gc-compressed-files" which, if non-zero, says
+ it is okay to reclaim the file buffer space allocated to a file which
+ was compressed, if, and only if, that file's contents do not appear in
+ any history node.
+
+* New file `nodemenu.c' implements a few functions for manipulating
+ previously visited nodes. `C-x C-b' (list-visited-nodes) produces a
+ menu of the nodes that could be reached by info-history-node in some
+ window. `C-x b' (select-visited-node) is similar, but reads one of
+ the node names with completion.
+
+* Keystroke `M-r' (move_to_screen_line) allows the user to place the cursor at
+ the start of a specific screen line. Without a numeric argument, place the
+ cursor on the center line; with an arg, place the cursor on that line.
+
+* Interruptible display implemented. Basic display speedups and hacks.
+* The message "*** Tags Out of Date ***" now means what it says.
+* Index searching with `,' (info-index-next) has been improved.
+* When scrolling with C-v, C-M-v, or M-v, only "Page Only" scrolling
+ will happen.
+
+* Continous scrolling (along with `]' (info-global-next) and `['
+ (info-global-prev) works better. `]' and `[' accept numeric
+ arguments, moving that many nodes in that case.
+
+* `C-x w' (info-toggle-wrap) controls how lines wider than the width
+ of the screen are displayed. If a line is too long, a `$' is
+ displayed in the rightmost column of the window.
+
+* There are some new variables for controlling the behaviour of Info
+ interactively. The current list of variables is as follows:
+
+ Variable Name Default Value Description
+ ------------- ------------- -----------
+ `automatic-footnotes' On When "On", footnotes appear and
+ disappear automatically.
+
+ `automatic-tiling' Off When "On", creating of deleting a
+ window resizes other windows.
+
+ `visible-bell' Off If non-zero, try to use a visible bell.
+
+ `errors-ring-bell' On If non-zero, errors cause a ring.
+
+ `show-index-match' On If non-zero, the portion of the string
+ matched is highlighted by changing its
+ case.
+
+ `scroll-behaviour' Continuous One of "Continuous", "Next Only", or
+ "Page Only". "Page Only" prevents you from
+ scrolling past the bottom or top of a node.
+ "Next Only" causes the Next or Prev node to
+ be selected when you scroll past the bottom
+ or top of a node. "Continous" moves
+ linearly through the files hierchichal
+ structure.
+
+ `scroll-step' 0 Controls how scrolling is done for you when
+ the cursor moves out of the current window.
+ Non-zero means it is the number of lines
+ you would like the screen to shift. A
+ value of 0 means to center the line
+ containing the cursor in the window.
+
+ `gc-compressed-files' Off If non-zero means it is okay to reclaim the
+ file buffer space allocated to a file which
+ was compressed, if, and only if, that
+ file's contents do not appear in the node
+ list of any window.
+
+ `ISO-Latin' Off Non-zero means that you are using an ISO
+ Latin character set. By default, standard
+ ASCII characters are assumed.
+________________________________________
+This release of Info is version 2.5 beta.
+
+Changes since 2.4 beta:
+
+* Index (i) and (,) commands fully implemented.
+* "configure" script now shipped with Info.
+* New function "set-variable" allows users to set various variables.
+* User-settable behaviour on end or beginning of node scrolling. This
+ supercedes the SPC and DEL changes in 2.3 beta.
+
+________________________________________
+This release of Info is version 2.4 beta.
+
+Changes since 2.3 beta:
+
+* info-last-node now means move to the last node of this info file.
+* info-history-node means move backwards through this window's node history.
+* info-first-node moves to the first node in the Info file. This node is
+ not necessarily "Top"!
+* SPC and DEL can select the Next or Prev node after printing an informative
+ message when pressed at the end/beg of a node.
+
+----------------------------------------
+This release of Info is version 2.3 beta.
+
+Changes since 2.2 beta:
+
+* M-x command lines if NAMED_COMMANDS is #defined. Variable in Makefile.
+* Screen height changes made quite robust.
+* Interactive function "set-screen-height" implements user height changes.
+* Scrolling on some terminals is faster now.
+* C-l with numeric arguement is fixed.
+
+----------------------------------------
+This release of Info is version 2.2 beta.
+
+Changes since 2.0:
+
+* C-g can now interrupt multi-file searches.
+* Incremental search is fully implemented.
+* Loading large tag tables is much faster now.
+* makedoc.c replaces shell script, speeding incremental builds.
+* Scrolling in redisplay is implemented.
+* Recursive uses of the echo area made more robust.
+* Garbage collection of unreferenced nodes.
+
diff --git a/texinfo/info/README b/texinfo/info/README
new file mode 100644
index 00000000000..d8f1ab624d8
--- /dev/null
+++ b/texinfo/info/README
@@ -0,0 +1,37 @@
+The file NEWS contains information about what has changed since the last
+release.
+
+The file ../INSTALL contains instructions on how to install Info.
+
+
+Info 2.0 is a complete rewrite of the original standalone Info I wrote in
+1987, the first program I wrote for rms. That program was something like
+my second Unix program ever, and my die-hard machine language coding habits
+tended to show through. I found the original Info hard to read and
+maintain, and thus decided to write this one.
+
+The rewrite consists of about 12,000 lines of code written in about 12
+days. I believe this version of Info to be in much better shape than the
+original Info, and the only reason it is in Beta test is because of its
+short life span.
+
+Info 2.0 is substantially different from its original standalone
+predecessor. It appears almost identical to the GNU Emacs version, but has
+the advantages of smaller size, ease of portability, and a built in library
+which can be used in other programs (to get or display documentation from
+Info files, for example).
+
+I eagerly await responses to this newer version of Info; comments on its
+portability, ease of use and user interface, code quality, and general
+usefulness are all of interest to me, and I will appreciate any comments
+that you would care to make.
+
+A full listing of the commands available in Info can be gotten by typing
+`?' while within an Info window. This produces a node in a window which
+can be viewed just like any Info node.
+
+Please send your comments, bug reports, and suggestions to
+
+ bug-texinfo@prep.ai.mit.edu
+
+--Brian Fox <bfox@ai.mit.edu>
diff --git a/texinfo/info/clib.c b/texinfo/info/clib.c
new file mode 100644
index 00000000000..0f913370bf3
--- /dev/null
+++ b/texinfo/info/clib.c
@@ -0,0 +1,112 @@
+/* clib.c: Functions which we normally expect to find in the C library.
+ $Id: clib.c,v 1.1 1997/08/21 22:57:59 jason Exp $
+
+ This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h>
+
+#if defined (HAVE_UNISTD_H)
+#include <unistd.h>
+#endif
+
+#if defined (HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+
+#if defined (HAVE_STRING_H)
+#include <string.h>
+#endif
+
+#include <sys/errno.h>
+
+extern void *xmalloc (), *xrealloc ();
+#include "general.h"
+
+#if !defined (errno)
+extern int errno;
+#endif
+
+#if !defined (HAVE_STRERROR)
+extern char *sys_errlist[];
+extern int sys_nerr;
+
+char *
+strerror (num)
+ int num;
+{
+ if (num >= sys_nerr)
+ return ("");
+ else
+ return (sys_errlist[num]);
+}
+#endif /* !HAVE_STRERROR */
+
+#if !defined (HAVE_STRCASECMP)
+/* This Unix doesn't have the strcasecmp () function. */
+int
+strcasecmp (string1, string2)
+ char *string1, *string2;
+{
+ char ch1, ch2;
+
+ for (;;)
+ {
+ ch1 = *string1++;
+ ch2 = *string2++;
+
+ if (!(ch1 | ch2))
+ return (0);
+
+ ch1 = info_toupper (ch1);
+ ch2 = info_toupper (ch2);
+
+ if (ch1 != ch2)
+ return (ch1 - ch2);
+ }
+}
+
+/* Compare at most COUNT characters from string1 to string2. Case
+ doesn't matter. */
+int
+strncasecmp (string1, string2, count)
+ char *string1, *string2;
+ int count;
+{
+ register char ch1, ch2;
+
+ while (count)
+ {
+ ch1 = *string1++;
+ ch2 = *string2++;
+
+ ch1 = info_toupper (ch1);
+ ch2 = info_toupper (ch2);
+
+ if (ch1 == ch2)
+ count--;
+ else
+ break;
+ }
+ return (count);
+}
+#endif /* !STRCASECMP */
+
diff --git a/texinfo/info/clib.h b/texinfo/info/clib.h
new file mode 100644
index 00000000000..c559fe51b60
--- /dev/null
+++ b/texinfo/info/clib.h
@@ -0,0 +1,42 @@
+/* clib.h: Declarations of functions which appear in clib.c (or libc.a). */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_CLIB_H_)
+#define _CLIB_H_
+
+#if !defined (HAVE_STRDUP)
+extern char *strdup ();
+#endif
+
+#if !defined (HAVE_STRERROR)
+extern char *strerror ();
+#endif
+
+#if !defined (HAVE_STRCASECMP)
+extern int strcasecmp ();
+extern int strncasecmp ();
+#endif
+
+#endif /* !_CLIB_H_ */
+
+
diff --git a/texinfo/info/dir.c b/texinfo/info/dir.c
new file mode 100644
index 00000000000..4ccf8561310
--- /dev/null
+++ b/texinfo/info/dir.c
@@ -0,0 +1,273 @@
+/* dir.c -- How to build a special "dir" node from "localdir" files. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#if defined (HAVE_SYS_FILE_H)
+#include <sys/file.h>
+#endif /* HAVE_SYS_FILE_H */
+#include <sys/errno.h>
+#include "info-utils.h"
+#include "filesys.h"
+#include "tilde.h"
+
+/* The "dir" node can be built from the contents of a file called "dir",
+ with the addition of the menus of every file named in the array
+ dirs_to_add which are found in INFOPATH. */
+
+static void add_menu_to_file_buffer (), insert_text_into_fb_at_binding ();
+static void build_dir_node_internal ();
+
+static char *dirs_to_add[] = {
+ "dir", "localdir", (char *)NULL
+};
+
+void
+maybe_build_dir_node (dirname)
+ char *dirname;
+{
+ FILE_BUFFER *dir_buffer;
+ int path_index, update_tags;
+ char *this_dir;
+
+ /* Check to see if the file has already been built. If so, then
+ do not build it again. */
+ dir_buffer = info_find_file (dirname);
+
+ /* If there is no "dir" in the current info path, we cannot build one
+ from nothing. */
+ if (!dir_buffer)
+ return;
+
+ /* If this directory has already been built, return now. */
+ if (dir_buffer->flags & N_CannotGC)
+ return;
+
+ path_index = update_tags = 0;
+
+ /* Using each element of the path, check for one of the files in
+ DIRS_TO_ADD. Do not check for "localdir.info.Z" or anything else.
+ Only files explictly named are eligible. This is a design decision.
+ There can be an info file name "localdir.info" which contains
+ information on the setting up of "localdir" files. */
+ while (this_dir = extract_colon_unit (infopath, &path_index))
+ {
+ register int da_index;
+ char *from_file;
+
+ /* Expand a leading tilde if one is present. */
+ if (*this_dir == '~')
+ {
+ char *tilde_expanded_dirname;
+
+ tilde_expanded_dirname = tilde_expand_word (this_dir);
+ if (tilde_expanded_dirname != this_dir)
+ {
+ free (this_dir);
+ this_dir = tilde_expanded_dirname;
+ }
+ }
+
+ /* For every file named in DIRS_TO_ADD found in the search path,
+ add the contents of that file's menu to our "dir" node. */
+ for (da_index = 0; from_file = dirs_to_add[da_index]; da_index++)
+ {
+ struct stat finfo;
+ char *fullpath;
+ int namelen, statable;
+
+ namelen = strlen (from_file);
+
+ fullpath = (char *)xmalloc (3 + strlen (this_dir) + namelen);
+ strcpy (fullpath, this_dir);
+ if (fullpath[strlen (fullpath) - 1] != '/')
+ strcat (fullpath, "/");
+ strcat (fullpath, from_file);
+
+ statable = (stat (fullpath, &finfo) == 0);
+
+ /* Only add the contents of this file if it is not identical to the
+ file of the DIR buffer. */
+ if ((statable && S_ISREG (finfo.st_mode)) &&
+ (strcmp (dir_buffer->fullpath, fullpath) != 0))
+ {
+ long filesize;
+ char *contents;
+
+ contents = filesys_read_info_file (fullpath, &filesize, &finfo);
+
+ if (contents)
+ {
+ update_tags++;
+ add_menu_to_file_buffer (contents, filesize, dir_buffer);
+ free (contents);
+ }
+ }
+
+ free (fullpath);
+ }
+ free (this_dir);
+ }
+
+ if (update_tags)
+ build_tags_and_nodes (dir_buffer);
+
+ /* Flag that the dir buffer has been built. */
+ dir_buffer->flags |= N_CannotGC;
+}
+
+/* Given CONTENTS and FB (a file buffer), add the menu found in CONTENTS
+ to the menu found in FB->contents. Second argument SIZE is the total
+ size of CONTENTS. */
+static void
+add_menu_to_file_buffer (contents, size, fb)
+ char *contents;
+ long size;
+ FILE_BUFFER *fb;
+{
+ SEARCH_BINDING contents_binding, fb_binding;
+ long contents_offset, fb_offset;
+
+ contents_binding.buffer = contents;
+ contents_binding.start = 0;
+ contents_binding.end = size;
+ contents_binding.flags = S_FoldCase | S_SkipDest;
+
+ fb_binding.buffer = fb->contents;
+ fb_binding.start = 0;
+ fb_binding.end = fb->filesize;
+ fb_binding.flags = S_FoldCase | S_SkipDest;
+
+ /* Move to the start of the menus in CONTENTS and FB. */
+ contents_offset = search_forward (INFO_MENU_LABEL, &contents_binding);
+ fb_offset = search_forward (INFO_MENU_LABEL, &fb_binding);
+
+ /* If there is no menu in CONTENTS, quit now. */
+ if (contents_offset == -1)
+ return;
+
+ /* There is a menu in CONTENTS, and contents_offset points to the first
+ character following the menu starter string. Skip all whitespace
+ and newline characters. */
+ contents_offset += skip_whitespace_and_newlines (contents + contents_offset);
+
+ /* If there is no menu in FB, make one. */
+ if (fb_offset == -1)
+ {
+ /* Find the start of the second node in this file buffer. If there
+ is only one node, we will be adding the contents to the end of
+ this node. */
+ fb_offset = find_node_separator (&fb_binding);
+
+ /* If not even a single node separator, give up. */
+ if (fb_offset == -1)
+ return;
+
+ fb_binding.start = fb_offset;
+ fb_binding.start +=
+ skip_node_separator (fb_binding.buffer + fb_binding.start);
+
+ /* Try to find the next node separator. */
+ fb_offset = find_node_separator (&fb_binding);
+
+ /* If found one, consider that the start of the menu. Otherwise, the
+ start of this menu is the end of the file buffer (i.e., fb->size). */
+ if (fb_offset != -1)
+ fb_binding.start = fb_offset;
+ else
+ fb_binding.start = fb_binding.end;
+
+ insert_text_into_fb_at_binding
+ (fb, &fb_binding, INFO_MENU_LABEL, strlen (INFO_MENU_LABEL));
+
+ fb_binding.buffer = fb->contents;
+ fb_binding.start = 0;
+ fb_binding.end = fb->filesize;
+ fb_offset = search_forward (INFO_MENU_LABEL, &fb_binding);
+ if (fb_offset == -1)
+ abort ();
+ }
+
+ /* CONTENTS_OFFSET and FB_OFFSET point to the starts of the menus that
+ appear in their respective buffers. Add the remainder of CONTENTS
+ to the end of FB's menu. */
+ fb_binding.start = fb_offset;
+ fb_offset = find_node_separator (&fb_binding);
+ if (fb_offset != -1)
+ fb_binding.start = fb_offset;
+ else
+ fb_binding.start = fb_binding.end;
+
+ /* Leave exactly one blank line between directory entries. */
+ {
+ int num_found = 0;
+
+ while ((fb_binding.start > 0) &&
+ (whitespace_or_newline (fb_binding.buffer[fb_binding.start - 1])))
+ {
+ num_found++;
+ fb_binding.start--;
+ }
+
+ /* Optimize if possible. */
+ if (num_found >= 2)
+ {
+ fb_binding.buffer[fb_binding.start++] = '\n';
+ fb_binding.buffer[fb_binding.start++] = '\n';
+ }
+ else
+ {
+ /* Do it the hard way. */
+ insert_text_into_fb_at_binding (fb, &fb_binding, "\n\n", 2);
+ fb_binding.start += 2;
+ }
+ }
+
+ /* Insert the new menu. */
+ insert_text_into_fb_at_binding
+ (fb, &fb_binding, contents + contents_offset, size - contents_offset);
+}
+
+static void
+insert_text_into_fb_at_binding (fb, binding, text, textlen)
+ FILE_BUFFER *fb;
+ SEARCH_BINDING *binding;
+ char *text;
+ int textlen;
+{
+ char *contents;
+ long start, end;
+
+ start = binding->start;
+ end = fb->filesize;
+
+ contents = (char *)xmalloc (fb->filesize + textlen + 1);
+ memcpy (contents, fb->contents, start);
+ memcpy (contents + start, text, textlen);
+ memcpy (contents + start + textlen, fb->contents + start, end - start);
+ free (fb->contents);
+ fb->contents = contents;
+ fb->filesize += textlen;
+ fb->finfo.st_size = fb->filesize;
+}
diff --git a/texinfo/info/display.c b/texinfo/info/display.c
new file mode 100644
index 00000000000..0194afafa20
--- /dev/null
+++ b/texinfo/info/display.c
@@ -0,0 +1,561 @@
+/* display.c -- How to display Info windows. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "display.h"
+
+extern int info_any_buffered_input_p (); /* Found in session.c. */
+
+static void free_display ();
+static DISPLAY_LINE **make_display ();
+
+/* An array of display lines which tell us what is currently visible on
+ the display. */
+DISPLAY_LINE **the_display = (DISPLAY_LINE **)NULL;
+
+/* Non-zero means do no output. */
+int display_inhibited = 0;
+
+/* Initialize THE_DISPLAY to WIDTH and HEIGHT, with nothing in it. */
+void
+display_initialize_display (width, height)
+ int width, height;
+{
+ free_display (the_display);
+ the_display = make_display (width, height);
+ display_clear_display (the_display);
+}
+
+/* Clear all of the lines in DISPLAY making the screen blank. */
+void
+display_clear_display (display)
+ DISPLAY_LINE **display;
+{
+ register int i;
+ register DISPLAY_LINE *display_line;
+
+ for (i = 0; display_line = display[i]; i++)
+ {
+ display[i]->text[0] = '\0';
+ display[i]->textlen = 0;
+ display[i]->inverse = 0;
+ }
+}
+
+/* Non-zero if we didn't completely redisplay a window. */
+int display_was_interrupted_p = 0;
+
+/* Update the windows pointed to by WINDOW in the_display. This actually
+ writes the text on the screen. */
+void
+display_update_display (window)
+ WINDOW *window;
+{
+ register WINDOW *win;
+
+ display_was_interrupted_p = 0;
+
+ /* For every window in the list, check contents against the display. */
+ for (win = window; win; win = win->next)
+ {
+ /* Only re-display visible windows which need updating. */
+ if (((win->flags & W_WindowVisible) == 0) ||
+ ((win->flags & W_UpdateWindow) == 0) ||
+ (win->height == 0))
+ continue;
+
+ display_update_one_window (win);
+ if (display_was_interrupted_p)
+ break;
+ }
+
+ /* Always update the echo area. */
+ display_update_one_window (the_echo_area);
+}
+
+/* Display WIN on the_display. Unlike display_update_display (), this
+ function only does one window. */
+void
+display_update_one_window (win)
+ WINDOW *win;
+{
+ register char *nodetext; /* Current character to display. */
+ register char *last_node_char; /* Position of the last character in node. */
+ register int i; /* General use index. */
+ char *printed_line; /* Buffer for a printed line. */
+ int pl_index = 0; /* Index into PRINTED_LINE. */
+ int line_index = 0; /* Number of lines done so far. */
+ DISPLAY_LINE **display = the_display;
+
+ /* If display is inhibited, that counts as an interrupted display. */
+ if (display_inhibited)
+ display_was_interrupted_p = 1;
+
+ /* If the window has no height, or display is inhibited, quit now. */
+ if (!win->height || display_inhibited)
+ return;
+
+ /* If the window's first row doesn't appear in the_screen, then it
+ cannot be displayed. This can happen when the_echo_area is the
+ window to be displayed, and the screen has shrunk to less than one
+ line. */
+ if ((win->first_row < 0) || (win->first_row > the_screen->height))
+ return;
+
+ /* Print each line in the window into our local buffer, and then
+ check the contents of that buffer against the display. If they
+ differ, update the display. */
+ printed_line = (char *)xmalloc (1 + win->width);
+
+ if (!win->node || !win->line_starts)
+ goto done_with_node_display;
+
+ nodetext = win->line_starts[win->pagetop];
+ last_node_char = win->node->contents + win->node->nodelen;
+
+ for (; nodetext < last_node_char; nodetext++)
+ {
+ char *rep, *rep_carried_over, rep_temp[2];
+ int replen;
+
+ if (isprint (*nodetext))
+ {
+ rep_temp[0] = *nodetext;
+ replen = 1;
+ rep_temp[1] = '\0';
+ rep = rep_temp;
+ }
+ else
+ {
+ if (*nodetext == '\r' || *nodetext == '\n')
+ {
+ replen = win->width - pl_index;
+ }
+ else
+ {
+ rep = printed_representation (*nodetext, pl_index);
+ replen = strlen (rep);
+ }
+ }
+
+ /* If this character can be printed without passing the width of
+ the line, then stuff it into the line. */
+ if (replen + pl_index < win->width)
+ {
+ /* Optimize if possible. */
+ if (replen == 1)
+ {
+ printed_line[pl_index++] = *rep;
+ }
+ else
+ {
+ for (i = 0; i < replen; i++)
+ printed_line[pl_index++] = rep[i];
+ }
+ }
+ else
+ {
+ DISPLAY_LINE *entry;
+
+ /* If this character cannot be printed in this line, we have
+ found the end of this line as it would appear on the screen.
+ Carefully print the end of the line, and then compare. */
+ if (*nodetext == '\n' || *nodetext == '\r' || *nodetext == '\t')
+ {
+ printed_line[pl_index] = '\0';
+ rep_carried_over = (char *)NULL;
+ }
+ else
+ {
+ /* The printed representation of this character extends into
+ the next line. Remember the offset of the last character
+ printed out of REP so that we can carry the character over
+ to the next line. */
+ for (i = 0; pl_index < (win->width - 1);)
+ printed_line[pl_index++] = rep[i++];
+
+ rep_carried_over = rep + i;
+
+ /* If printing the last character in this window couldn't
+ possibly cause the screen to scroll, place a backslash
+ in the rightmost column. */
+ if (1 + line_index + win->first_row < the_screen->height)
+ {
+ if (win->flags & W_NoWrap)
+ printed_line[pl_index++] = '$';
+ else
+ printed_line[pl_index++] = '\\';
+ }
+ printed_line[pl_index] = '\0';
+ }
+
+ /* We have the exact line as it should appear on the screen.
+ Check to see if this line matches the one already appearing
+ on the screen. */
+ entry = display[line_index + win->first_row];
+
+ /* If the screen line is inversed, then we have to clear
+ the line from the screen first. Why, I don't know. */
+ if (entry->inverse)
+ {
+ terminal_goto_xy (0, line_index + win->first_row);
+ terminal_clear_to_eol ();
+ entry->inverse = 0;
+ entry->text[0] = '\0';
+ entry->textlen = 0;
+ }
+
+ /* Find the offset where these lines differ. */
+ for (i = 0; i < pl_index; i++)
+ if (printed_line[i] != entry->text[i])
+ break;
+
+ /* If the lines are not the same length, or if they differed
+ at all, we must do some redrawing. */
+ if ((i != pl_index) || (pl_index != entry->textlen))
+ {
+ /* Move to the proper point on the terminal. */
+ terminal_goto_xy (i, line_index + win->first_row);
+
+ /* If there is any text to print, print it. */
+ if (i != pl_index)
+ terminal_put_text (printed_line + i);
+
+ /* If the printed text didn't extend all the way to the edge
+ of the window, and text was appearing between here and the
+ edge of the window, clear from here to the end of the line. */
+ if ((pl_index < win->width && pl_index < entry->textlen) ||
+ (entry->inverse))
+ terminal_clear_to_eol ();
+
+ fflush (stdout);
+
+ /* Update the display text buffer. */
+ strcpy (entry->text + i, printed_line + i);
+ entry->textlen = pl_index;
+
+ /* Lines showing node text are not in inverse. Only modelines
+ have that distinction. */
+ entry->inverse = 0;
+ }
+
+ /* We have done at least one line. Increment our screen line
+ index, and check against the bottom of the window. */
+ if (++line_index == win->height)
+ break;
+
+ /* A line has been displayed, and the screen reflects that state.
+ If there is typeahead pending, then let that typeahead be read
+ now, instead of continuing with the display. */
+ if (info_any_buffered_input_p ())
+ {
+ free (printed_line);
+ display_was_interrupted_p = 1;
+ return;
+ }
+
+ /* Reset PL_INDEX to the start of the line. */
+ pl_index = 0;
+
+ /* If there are characters from REP left to print, stuff them
+ into the buffer now. */
+ if (rep_carried_over)
+ for (; rep[pl_index]; pl_index++)
+ printed_line[pl_index] = rep[pl_index];
+
+ /* If this window has chosen not to wrap lines, skip to the end
+ of the physical line in the buffer, and start a new line here. */
+ if (pl_index && (win->flags & W_NoWrap))
+ {
+ char *begin;
+
+ pl_index = 0;
+ printed_line[0] = '\0';
+
+ begin = nodetext;
+
+ while ((nodetext < last_node_char) && (*nodetext != '\n'))
+ nodetext++;
+ }
+ }
+ }
+
+ done_with_node_display:
+ /* We have reached the end of the node or the end of the window. If it
+ is the end of the node, then clear the lines of the window from here
+ to the end of the window. */
+ for (; line_index < win->height; line_index++)
+ {
+ DISPLAY_LINE *entry = display[line_index + win->first_row];
+
+ /* If this line has text on it then make it go away. */
+ if (entry && entry->textlen)
+ {
+ entry->textlen = 0;
+ entry->text[0] = '\0';
+
+ terminal_goto_xy (0, line_index + win->first_row);
+ terminal_clear_to_eol ();
+ }
+ }
+
+ /* Finally, if this window has a modeline it might need to be redisplayed.
+ Check the window's modeline against the one in the display, and update
+ if necessary. */
+ if ((win->flags & W_InhibitMode) == 0)
+ {
+ window_make_modeline (win);
+ line_index = win->first_row + win->height;
+
+ /* This display line must both be in inverse, and have the same
+ contents. */
+ if ((!display[line_index]->inverse) ||
+ (strcmp (display[line_index]->text, win->modeline) != 0))
+ {
+ terminal_goto_xy (0, line_index);
+ terminal_begin_inverse ();
+ terminal_put_text (win->modeline);
+ terminal_end_inverse ();
+ strcpy (display[line_index]->text, win->modeline);
+ display[line_index]->inverse = 1;
+ display[line_index]->textlen = strlen (win->modeline);
+ fflush (stdout);
+ }
+ }
+
+ /* Okay, this window doesn't need updating anymore. */
+ win->flags &= ~W_UpdateWindow;
+ free (printed_line);
+ fflush (stdout);
+}
+
+/* Scroll the region of the_display starting at START, ending at END, and
+ moving the lines AMOUNT lines. If AMOUNT is less than zero, the lines
+ are moved up in the screen, otherwise down. Actually, it is possible
+ for no scrolling to take place in the case that the terminal doesn't
+ support it. This doesn't matter to us. */
+void
+display_scroll_display (start, end, amount)
+ int start, end, amount;
+{
+ register int i, last;
+ DISPLAY_LINE *temp;
+
+ /* If this terminal cannot do scrolling, give up now. */
+ if (!terminal_can_scroll)
+ return;
+
+ /* If there isn't anything displayed on the screen because it is too
+ small, quit now. */
+ if (!the_display[0])
+ return;
+
+ /* If there is typeahead pending, then don't actually do any scrolling. */
+ if (info_any_buffered_input_p ())
+ return;
+
+ /* Do it on the screen. */
+ terminal_scroll_terminal (start, end, amount);
+
+ /* Now do it in the display buffer so our contents match the screen. */
+ if (amount > 0)
+ {
+ last = end + amount;
+
+ /* Shift the lines to scroll right into place. */
+ for (i = 0; i < (end - start); i++)
+ {
+ temp = the_display[last - i];
+ the_display[last - i] = the_display[end - i];
+ the_display[end - i] = temp;
+ }
+
+ /* The lines have been shifted down in the buffer. Clear all of the
+ lines that were vacated. */
+ for (i = start; i != (start + amount); i++)
+ {
+ the_display[i]->text[0] = '\0';
+ the_display[i]->textlen = 0;
+ the_display[i]->inverse = 0;
+ }
+ }
+
+ if (amount < 0)
+ {
+ last = start + amount;
+ for (i = 0; i < (end - start); i++)
+ {
+ temp = the_display[last + i];
+ the_display[last + i] = the_display[start + i];
+ the_display[start + i] = temp;
+ }
+
+ /* The lines have been shifted up in the buffer. Clear all of the
+ lines that are left over. */
+ for (i = end + amount; i != end; i++)
+ {
+ the_display[i]->text[0] = '\0';
+ the_display[i]->textlen = 0;
+ the_display[i]->inverse = 0;
+ }
+ }
+}
+
+/* Try to scroll lines in WINDOW. OLD_PAGETOP is the pagetop of WINDOW before
+ having had its line starts recalculated. OLD_STARTS is the list of line
+ starts that used to appear in this window. OLD_COUNT is the number of lines
+ that appear in the OLD_STARTS array. */
+void
+display_scroll_line_starts (window, old_pagetop, old_starts, old_count)
+ WINDOW *window;
+ int old_pagetop, old_count;
+ char **old_starts;
+{
+ register int i, old, new; /* Indices into the line starts arrays. */
+ int last_new, last_old; /* Index of the last visible line. */
+ int old_first, new_first; /* Index of the first changed line. */
+ int unchanged_at_top = 0;
+ int already_scrolled = 0;
+
+ /* Locate the first line which was displayed on the old window. */
+ old_first = old_pagetop;
+ new_first = window->pagetop;
+
+ /* Find the last line currently visible in this window. */
+ last_new = window->pagetop + (window->height - 1);
+ if (last_new > window->line_count)
+ last_new = window->line_count - 1;
+
+ /* Find the last line which used to be currently visible in this window. */
+ last_old = old_pagetop + (window->height - 1);
+ if (last_old > old_count)
+ last_old = old_count - 1;
+
+ for (old = old_first, new = new_first;
+ old < last_old && new < last_new;
+ old++, new++)
+ if (old_starts[old] != window->line_starts[new])
+ break;
+ else
+ unchanged_at_top++;
+
+ /* Loop through the old lines looking for a match in the new lines. */
+ for (old = old_first + unchanged_at_top; old < last_old; old++)
+ {
+ for (new = new_first; new < last_new; new++)
+ if (old_starts[old] == window->line_starts[new])
+ {
+ /* Find the extent of the matching lines. */
+ for (i = 0; (old + i) < last_old; i++)
+ if (old_starts[old + i] != window->line_starts[new + i])
+ break;
+
+ /* Scroll these lines if there are enough of them. */
+ {
+ int start, end, amount;
+
+ start = (window->first_row
+ + ((old + already_scrolled) - old_pagetop));
+ amount = new - (old + already_scrolled);
+ end = window->first_row + window->height;
+
+ /* If we are shifting the block of lines down, then the last
+ AMOUNT lines will become invisible. Thus, don't bother
+ scrolling them. */
+ if (amount > 0)
+ end -= amount;
+
+ if ((end - start) > 0)
+ {
+ display_scroll_display (start, end, amount);
+
+ /* Some lines have been scrolled. Simulate the scrolling
+ by offsetting the value of the old index. */
+ old += i;
+ already_scrolled += amount;
+ }
+ }
+ }
+ }
+}
+
+/* Move the screen cursor to directly over the current character in WINDOW. */
+void
+display_cursor_at_point (window)
+ WINDOW *window;
+{
+ int vpos, hpos;
+
+ vpos = window_line_of_point (window) - window->pagetop + window->first_row;
+ hpos = window_get_cursor_column (window);
+ terminal_goto_xy (hpos, vpos);
+}
+
+/* **************************************************************** */
+/* */
+/* Functions Static to this File */
+/* */
+/* **************************************************************** */
+
+/* Make a DISPLAY_LINE ** with width and height. */
+static DISPLAY_LINE **
+make_display (width, height)
+ int width, height;
+{
+ register int i;
+ DISPLAY_LINE **display;
+
+ display = (DISPLAY_LINE **)xmalloc ((1 + height) * sizeof (DISPLAY_LINE *));
+
+ for (i = 0; i < height; i++)
+ {
+ display[i] = (DISPLAY_LINE *)xmalloc (sizeof (DISPLAY_LINE));
+ display[i]->text = (char *)xmalloc (1 + width);
+ display[i]->textlen = 0;
+ display[i]->inverse = 0;
+ }
+ display[i] = (DISPLAY_LINE *)NULL;
+ return (display);
+}
+
+/* Free the storage allocated to DISPLAY. */
+static void
+free_display (display)
+ DISPLAY_LINE **display;
+{
+ register int i;
+ register DISPLAY_LINE *display_line;
+
+ if (!display)
+ return;
+
+ for (i = 0; display_line = display[i]; i++)
+ {
+ free (display_line->text);
+ free (display_line);
+ }
+ free (display);
+}
diff --git a/texinfo/info/display.h b/texinfo/info/display.h
new file mode 100644
index 00000000000..d8bd5a166fe
--- /dev/null
+++ b/texinfo/info/display.h
@@ -0,0 +1,76 @@
+/* display.h -- How the display in Info is done. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_DISPLAY_H_)
+#define _DISPLAY_H_
+
+#include "info-utils.h"
+#include "terminal.h"
+
+typedef struct {
+ char *text; /* Text of the line as it appears. */
+ int textlen; /* Printable Length of TEXT. */
+ int inverse; /* Non-zero means this line is inverse. */
+} DISPLAY_LINE;
+
+/* An array of display lines which tell us what is currently visible on
+ the display. */
+extern DISPLAY_LINE **the_display;
+
+/* Non-zero means do no output. */
+extern int display_inhibited;
+
+/* Non-zero if we didn't completely redisplay a window. */
+extern int display_was_interrupted_p;
+
+/* Initialize THE_DISPLAY to WIDTH and HEIGHT, with nothing in it. */
+extern void display_initialize_display ();
+
+/* Clear all of the lines in DISPLAY making the screen blank. */
+extern void display_clear_display ();
+
+/* Update the windows pointed to by WINDOWS in THE_DISPLAY. This actually
+ writes the text on the screen. */
+extern void display_update_display ();
+
+/* Display WIN on THE_DISPLAY. Unlike display_update_display (), this
+ function only does one window. */
+extern void display_update_one_window ();
+
+/* Move the screen cursor to directly over the current character in WINDOW. */
+extern void display_cursor_at_point ();
+
+/* Scroll the region of the_display starting at START, ending at END, and
+ moving the lines AMOUNT lines. If AMOUNT is less than zero, the lines
+ are moved up in the screen, otherwise down. Actually, it is possible
+ for no scrolling to take place in the case that the terminal doesn't
+ support it. This doesn't matter to us. */
+extern void display_scroll_display ();
+
+/* Try to scroll lines in WINDOW. OLD_PAGETOP is the pagetop of WINDOW before
+ having had its line starts recalculated. OLD_STARTS is the list of line
+ starts that used to appear in this window. OLD_COUNT is the number of lines
+ that appear in the OLD_STARTS array. */
+extern void display_scroll_line_starts ();
+
+#endif /* !_DISPLAY_H_ */
diff --git a/texinfo/info/doc.h b/texinfo/info/doc.h
new file mode 100644
index 00000000000..8afc28f7446
--- /dev/null
+++ b/texinfo/info/doc.h
@@ -0,0 +1,58 @@
+/* doc.h -- Structure associating function pointers with documentation. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_DOC_H_)
+#define _DOC_H_
+
+#if !defined (NULL)
+# define NULL 0x0
+#endif /* !NULL */
+
+#if !defined (__FUNCTION_DEF)
+# define __FUNCTION_DEF
+typedef int Function ();
+typedef void VFunction ();
+#endif /* _FUNCTION_DEF */
+
+typedef struct {
+ VFunction *func;
+#if defined (NAMED_FUNCTIONS)
+ char *func_name;
+#endif /* NAMED_FUNCTIONS */
+ char *doc;
+} FUNCTION_DOC;
+
+extern FUNCTION_DOC function_doc_array[];
+
+extern char *function_documentation ();
+extern char *key_documentation ();
+extern char *pretty_keyname ();
+extern char *replace_in_documentation ();
+extern void info_document_key ();
+extern void dump_map_to_message_buffer ();
+
+#if defined (NAMED_FUNCTIONS)
+extern char *function_name ();
+extern VFunction *named_function ();
+#endif /* NAMED_FUNCTIONS */
+#endif /* !_DOC_H_ */
diff --git a/texinfo/info/dribble.c b/texinfo/info/dribble.c
new file mode 100644
index 00000000000..8e16cea4e45
--- /dev/null
+++ b/texinfo/info/dribble.c
@@ -0,0 +1,71 @@
+/* dribble.c -- Dribble files for Info. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h>
+#include "dribble.h"
+
+/* When non-zero, it is a stream to write all input characters to for the
+ duration of this info session. */
+FILE *info_dribble_file = (FILE *)NULL;
+
+/* Open a dribble file named NAME, perhaps closing an already open one.
+ This sets the global variable INFO_DRIBBLE_FILE to the open stream. */
+void
+open_dribble_file (name)
+ char *name;
+{
+ /* Perhaps close existing dribble file. */
+ close_dribble_file ();
+
+ info_dribble_file = fopen (name, "w");
+
+#if defined (HAVE_SETVBUF)
+ if (info_dribble_file)
+# if defined (SETVBUF_REVERSED)
+ setvbuf (info_dribble_file, _IONBF, (char *)NULL, 1);
+# else
+ setvbuf (info_dribble_file, (char *)NULL, _IONBF, 1);
+# endif /* !SETVBUF_REVERSED */
+#endif /* HAVE_SETVBUF */
+}
+
+/* If there is a dribble file already open, close it. */
+void
+close_dribble_file ()
+{
+ if (info_dribble_file)
+ {
+ fflush (info_dribble_file);
+ fclose (info_dribble_file);
+ info_dribble_file = (FILE *)NULL;
+ }
+}
+
+/* Write some output to our existing dribble file. */
+void
+dribble (byte)
+ unsigned char byte;
+{
+ if (info_dribble_file)
+ fwrite (&byte, sizeof (unsigned char), 1, info_dribble_file);
+}
diff --git a/texinfo/info/dribble.h b/texinfo/info/dribble.h
new file mode 100644
index 00000000000..5647b40529e
--- /dev/null
+++ b/texinfo/info/dribble.h
@@ -0,0 +1,41 @@
+/* dribble.h -- Functions and vars declared in dribble.c. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_DRIBBLE_H_)
+#define _DRIBBLE_H_
+
+/* When non-zero, it is a stream to write all input characters to for the
+ duration of this info session. */
+extern FILE *info_dribble_file;
+
+/* Open a dribble file named NAME, perhaps closing an already open one.
+ This sets the global variable INFO_DRIBBLE_FILE to the open stream. */
+extern void open_dribble_file ();
+
+/* If there is a dribble file already open, close it. */
+extern void close_dribble_file ();
+
+/* Write some output to our existing dribble file. */
+extern void dribble ();
+
+#endif /* !_DRIBBLE_H_ */
diff --git a/texinfo/info/echo_area.c b/texinfo/info/echo_area.c
new file mode 100644
index 00000000000..265e9880425
--- /dev/null
+++ b/texinfo/info/echo_area.c
@@ -0,0 +1,1508 @@
+/* echo_area.c -- How to read a line in the echo area. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+
+#if defined (FD_SET)
+# if defined (hpux)
+# define fd_set_cast(x) (int *)(x)
+# else
+# define fd_set_cast(x) (fd_set *)(x)
+# endif /* !hpux */
+#endif /* FD_SET */
+
+/* Non-zero means that C-g was used to quit reading input. */
+int info_aborted_echo_area = 0;
+
+/* Non-zero means that the echo area is being used to read input. */
+int echo_area_is_active = 0;
+
+/* The address of the last command executed in the echo area. */
+VFunction *ea_last_executed_command = (VFunction *)NULL;
+
+/* Non-zero means that the last command executed while reading input
+ killed some text. */
+int echo_area_last_command_was_kill = 0;
+
+/* Variables which hold on to the current state of the input line. */
+static char input_line[1 + EA_MAX_INPUT];
+static char *input_line_prompt;
+static int input_line_point;
+static int input_line_beg;
+static int input_line_end;
+static NODE input_line_node = {
+ (char *)NULL, (char *)NULL, (char *)NULL, input_line, EA_MAX_INPUT, 0
+};
+
+static void echo_area_initialize_node ();
+static void push_echo_area (), pop_echo_area ();
+static int echo_area_stack_depth (), echo_area_stack_contains_completions_p ();
+
+static void ea_kill_text ();
+
+/* Non-zero means we force the user to complete. */
+static int echo_area_must_complete_p = 0;
+static int completions_window_p ();
+
+/* If non-null, this is a window which was specifically created to display
+ possible completions output. We remember it so we can delete it when
+ appropriate. */
+static WINDOW *echo_area_completions_window = (WINDOW *)NULL;
+
+/* Variables which keep track of the window which was active prior to
+ entering the echo area. */
+static WINDOW *calling_window = (WINDOW *)NULL;
+static NODE *calling_window_node = (NODE *)NULL;
+static long calling_window_point = 0;
+static long calling_window_pagetop = 0;
+
+/* Remember the node and pertinent variables of the calling window. */
+static void
+remember_calling_window (window)
+ WINDOW *window;
+{
+ /* Only do this if the calling window is not the completions window, or,
+ if it is the completions window and there is no other window. */
+ if (!completions_window_p (window) ||
+ ((window == windows) && !(window->next)))
+ {
+ calling_window = window;
+ calling_window_node = window->node;
+ calling_window_point = window->point;
+ calling_window_pagetop = window->pagetop;
+ }
+}
+
+/* Restore the caller's window so that it shows the node that it was showing
+ on entry to info_read_xxx_echo_area (). */
+static void
+restore_calling_window ()
+{
+ register WINDOW *win, *compwin = (WINDOW *)NULL;
+
+ /* If the calling window is still visible, and it is the window that
+ we used for completions output, then restore the calling window. */
+ for (win = windows; win; win = win->next)
+ {
+ if (completions_window_p (win))
+ compwin = win;
+
+ if (win == calling_window && win == compwin)
+ {
+ window_set_node_of_window (calling_window, calling_window_node);
+ calling_window->point = calling_window_point;
+ calling_window->pagetop = calling_window_pagetop;
+ compwin = (WINDOW *)NULL;
+ break;
+ }
+ }
+
+ /* Delete the completions window if it is still present, it isn't the
+ last window on the screen, and there aren't any prior echo area reads
+ pending which created a completions window. */
+ if (compwin)
+ {
+ if ((compwin != windows || windows->next) &&
+ !echo_area_stack_contains_completions_p ())
+ {
+ WINDOW *next;
+ int pagetop, start, end, amount;
+
+ next = compwin->next;
+ if (next)
+ {
+ start = next->first_row;
+ end = start + next->height;
+ amount = - (compwin->height + 1);
+ pagetop = next->pagetop;
+ }
+
+ info_delete_window_internal (compwin);
+
+ /* This is not necessary because info_delete_window_internal ()
+ calls echo_area_inform_of_deleted_window (), which does the
+ right thing. */
+#if defined (UNNECESSARY)
+ echo_area_completions_window = (WINDOW *)NULL;
+#endif /* UNNECESSARY */
+
+ if (next)
+ {
+ display_scroll_display (start, end, amount);
+ next->pagetop = pagetop;
+ display_update_display (windows);
+ }
+ }
+ }
+}
+
+/* Set up a new input line with PROMPT. */
+static void
+initialize_input_line (prompt)
+ char *prompt;
+{
+ input_line_prompt = prompt;
+ if (prompt)
+ strcpy (input_line, prompt);
+ else
+ input_line[0] = '\0';
+
+ input_line_beg = input_line_end = input_line_point = strlen (prompt);
+}
+
+static char *
+echo_area_after_read ()
+{
+ char *return_value;
+
+ if (info_aborted_echo_area)
+ {
+ info_aborted_echo_area = 0;
+ return_value = (char *)NULL;
+ }
+ else
+ {
+ if (input_line_beg == input_line_end)
+ return_value = strdup ("");
+ else
+ {
+ int line_len = input_line_end - input_line_beg;
+ return_value = (char *) xmalloc (1 + line_len);
+ strncpy (return_value, &input_line[input_line_beg], line_len);
+ return_value[line_len] = '\0';
+ }
+ }
+ return (return_value);
+}
+
+/* Read a line of text in the echo area. Return a malloc ()'ed string,
+ or NULL if the user aborted out of this read. WINDOW is the currently
+ active window, so that we can restore it when we need to. PROMPT, if
+ non-null, is a prompt to print before reading the line. */
+char *
+info_read_in_echo_area (window, prompt)
+ WINDOW *window;
+ char *prompt;
+{
+ char *line;
+
+ /* If the echo area is already active, remember the current state. */
+ if (echo_area_is_active)
+ push_echo_area ();
+
+ /* Initialize our local variables. */
+ initialize_input_line (prompt);
+
+ /* Initialize the echo area for the first (but maybe not the last) time. */
+ echo_area_initialize_node ();
+
+ /* Save away the original node of this window, and the window itself,
+ so echo area commands can temporarily use this window. */
+ remember_calling_window (window);
+
+ /* Let the rest of Info know that the echo area is active. */
+ echo_area_is_active++;
+ active_window = the_echo_area;
+
+ /* Read characters in the echo area. */
+ info_read_and_dispatch ();
+
+ echo_area_is_active--;
+
+ /* Restore the original active window and show point in it. */
+ active_window = calling_window;
+ restore_calling_window ();
+ display_cursor_at_point (active_window);
+ fflush (stdout);
+
+ /* Get the value of the line. */
+ line = echo_area_after_read ();
+
+ /* If there is a previous loop waiting for us, restore it now. */
+ if (echo_area_is_active)
+ pop_echo_area ();
+
+ /* Return the results to the caller. */
+ return (line);
+}
+
+/* (re) Initialize the echo area node. */
+static void
+echo_area_initialize_node ()
+{
+ register int i;
+
+ for (i = input_line_end; i < sizeof (input_line); i++)
+ input_line[i] = ' ';
+
+ input_line[i - 1] = '\n';
+ window_set_node_of_window (the_echo_area, &input_line_node);
+ input_line[input_line_end] = '\n';
+}
+
+/* Prepare to read characters in the echo area. This can initialize the
+ echo area node, but its primary purpose is to side effect the input
+ line buffer contents. */
+void
+echo_area_prep_read ()
+{
+ if (the_echo_area->node != &input_line_node)
+ echo_area_initialize_node ();
+
+ the_echo_area->point = input_line_point;
+ input_line[input_line_end] = '\n';
+ display_update_one_window (the_echo_area);
+ display_cursor_at_point (active_window);
+}
+
+
+/* **************************************************************** */
+/* */
+/* Echo Area Movement Commands */
+/* */
+/* **************************************************************** */
+
+DECLARE_INFO_COMMAND (ea_forward, "Move forward a character")
+{
+ if (count < 0)
+ ea_backward (window, -count, key);
+ else
+ {
+ input_line_point += count;
+ if (input_line_point > input_line_end)
+ input_line_point = input_line_end;
+ }
+}
+
+DECLARE_INFO_COMMAND (ea_backward, "Move backward a character")
+{
+ if (count < 0)
+ ea_forward (window, -count, key);
+ else
+ {
+ input_line_point -= count;
+ if (input_line_point < input_line_beg)
+ input_line_point = input_line_beg;
+ }
+}
+
+DECLARE_INFO_COMMAND (ea_beg_of_line, "Move to the start of this line")
+{
+ input_line_point = input_line_beg;
+}
+
+DECLARE_INFO_COMMAND (ea_end_of_line, "Move to the end of this line")
+{
+ input_line_point = input_line_end;
+}
+
+#define alphabetic(c) (islower (c) || isupper (c) || isdigit (c))
+
+/* Move forward a word in the input line. */
+DECLARE_INFO_COMMAND (ea_forward_word, "Move forward a word")
+{
+ int c;
+
+ if (count < 0)
+ ea_backward_word (window, -count, key);
+ else
+ {
+ while (count--)
+ {
+ if (input_line_point == input_line_end)
+ return;
+
+ /* If we are not in a word, move forward until we are in one.
+ Then, move forward until we hit a non-alphabetic character. */
+ c = input_line[input_line_point];
+
+ if (!alphabetic (c))
+ {
+ while (++input_line_point < input_line_end)
+ {
+ c = input_line[input_line_point];
+ if (alphabetic (c))
+ break;
+ }
+ }
+
+ if (input_line_point == input_line_end)
+ return;
+
+ while (++input_line_point < input_line_end)
+ {
+ c = input_line[input_line_point];
+ if (!alphabetic (c))
+ break;
+ }
+ }
+ }
+}
+
+DECLARE_INFO_COMMAND (ea_backward_word, "Move backward a word")
+{
+ int c;
+
+ if (count < 0)
+ ea_forward_word (window, -count, key);
+ else
+ {
+ while (count--)
+ {
+ if (input_line_point == input_line_beg)
+ return;
+
+ /* Like ea_forward_word (), except that we look at the
+ characters just before point. */
+
+ c = input_line[input_line_point - 1];
+
+ if (!alphabetic (c))
+ {
+ while ((--input_line_point) != input_line_beg)
+ {
+ c = input_line[input_line_point - 1];
+ if (alphabetic (c))
+ break;
+ }
+ }
+
+ while (input_line_point != input_line_beg)
+ {
+ c = input_line[input_line_point - 1];
+ if (!alphabetic (c))
+ break;
+ else
+ --input_line_point;
+ }
+ }
+ }
+}
+
+DECLARE_INFO_COMMAND (ea_delete, "Delete the character under the cursor")
+{
+ register int i;
+
+ if (count < 0)
+ ea_rubout (window, -count, key);
+ else
+ {
+ if (input_line_point == input_line_end)
+ return;
+
+ if (info_explicit_arg || count > 1)
+ {
+ int orig_point;
+
+ orig_point = input_line_point;
+ ea_forward (window, count, key);
+ ea_kill_text (orig_point, input_line_point);
+ input_line_point = orig_point;
+ }
+ else
+ {
+ for (i = input_line_point; i < input_line_end; i++)
+ input_line[i] = input_line[i + 1];
+
+ input_line_end--;
+ }
+ }
+}
+
+DECLARE_INFO_COMMAND (ea_rubout, "Delete the character behind the cursor")
+{
+ if (count < 0)
+ ea_delete (window, -count, key);
+ else
+ {
+ int start;
+
+ if (input_line_point == input_line_beg)
+ return;
+
+ start = input_line_point;
+ ea_backward (window, count, key);
+
+ if (info_explicit_arg || count > 1)
+ ea_kill_text (start, input_line_point);
+ else
+ ea_delete (window, count, key);
+ }
+}
+
+DECLARE_INFO_COMMAND (ea_abort, "Cancel or quit operation")
+{
+ /* If any text, just discard it, and restore the calling window's node.
+ If no text, quit. */
+ if (input_line_end != input_line_beg)
+ {
+ terminal_ring_bell ();
+ input_line_end = input_line_point = input_line_beg;
+ if (calling_window->node != calling_window_node)
+ restore_calling_window ();
+ }
+ else
+ info_aborted_echo_area = 1;
+}
+
+DECLARE_INFO_COMMAND (ea_newline, "Accept (or force completion of) this line")
+{
+ /* Stub does nothing. Simply here to see if it has been executed. */
+}
+
+DECLARE_INFO_COMMAND (ea_quoted_insert, "Insert next character verbatim")
+{
+ unsigned char character;
+
+ character = info_get_another_input_char ();
+ ea_insert (window, count, character);
+}
+
+DECLARE_INFO_COMMAND (ea_insert, "Insert this character")
+{
+ register int i;
+
+ if ((input_line_end + 1) == EA_MAX_INPUT)
+ {
+ terminal_ring_bell ();
+ return;
+ }
+
+ for (i = input_line_end + 1; i != input_line_point; i--)
+ input_line[i] = input_line[i - 1];
+
+ input_line[input_line_point] = key;
+ input_line_point++;
+ input_line_end++;
+}
+
+DECLARE_INFO_COMMAND (ea_tab_insert, "Insert a TAB character")
+{
+ ea_insert (window, count, '\t');
+}
+
+/* Transpose the characters at point. If point is at the end of the line,
+ then transpose the characters before point. */
+DECLARE_INFO_COMMAND (ea_transpose_chars, "Transpose characters at point")
+{
+ /* Handle conditions that would make it impossible to transpose
+ characters. */
+ if (!count || !input_line_point || (input_line_end - input_line_beg) < 2)
+ return;
+
+ while (count)
+ {
+ int t;
+ if (input_line_point == input_line_end)
+ {
+ t = input_line[input_line_point - 1];
+
+ input_line[input_line_point - 1] = input_line[input_line_point - 2];
+ input_line[input_line_point - 2] = t;
+ }
+ else
+ {
+ t = input_line[input_line_point];
+
+ input_line[input_line_point] = input_line[input_line_point - 1];
+ input_line[input_line_point - 1] = t;
+
+ if (count < 0 && input_line_point != input_line_beg)
+ input_line_point--;
+ else
+ input_line_point++;
+ }
+
+ if (count < 0)
+ count++;
+ else
+ count--;
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Echo Area Killing and Yanking */
+/* */
+/* **************************************************************** */
+
+static char **kill_ring = (char **)NULL;
+static int kill_ring_index = 0; /* Number of kills appearing in KILL_RING. */
+static int kill_ring_slots = 0; /* Number of slots allocated to KILL_RING. */
+static int kill_ring_loc = 0; /* Location of current yank pointer. */
+
+/* The largest number of kills that we remember at one time. */
+static int max_retained_kills = 15;
+
+DECLARE_INFO_COMMAND (ea_yank, "Yank back the contents of the last kill")
+{
+ register int i;
+ register char *text;
+
+ if (!kill_ring_index)
+ {
+ inform_in_echo_area ("Kill ring is empty");
+ return;
+ }
+
+ text = kill_ring[kill_ring_loc];
+
+ for (i = 0; text[i]; i++)
+ ea_insert (window, 1, text[i]);
+}
+
+/* If the last command was yank, or yank_pop, and the text just before
+ point is identical to the current kill item, then delete that text
+ from the line, rotate the index down, and yank back some other text. */
+DECLARE_INFO_COMMAND (ea_yank_pop, "Yank back a previous kill")
+{
+ register int len;
+
+ if (((ea_last_executed_command != ea_yank) &&
+ (ea_last_executed_command != ea_yank_pop)) ||
+ (kill_ring_index == 0))
+ return;
+
+ len = strlen (kill_ring[kill_ring_loc]);
+
+ /* Delete the last yanked item from the line. */
+ {
+ register int i, counter;
+
+ counter = input_line_end - input_line_point;
+
+ for (i = input_line_point - len; counter; i++, counter--)
+ input_line[i] = input_line[i + len];
+
+ input_line_end -= len;
+ input_line_point -= len;
+ }
+
+ /* Get a previous kill, and yank that. */
+ kill_ring_loc--;
+ if (kill_ring_loc < 0)
+ kill_ring_loc = kill_ring_index - 1;
+
+ ea_yank (window, count, key);
+}
+
+/* Delete the text from point to end of line. */
+DECLARE_INFO_COMMAND (ea_kill_line, "Kill to the end of the line")
+{
+ if (count < 0)
+ {
+ ea_kill_text (input_line_point, input_line_beg);
+ input_line_point = input_line_beg;
+ }
+ else
+ ea_kill_text (input_line_point, input_line_end);
+}
+
+/* Delete the text from point to beg of line. */
+DECLARE_INFO_COMMAND (ea_backward_kill_line,
+ "Kill to the beginning of the line")
+{
+ if (count < 0)
+ ea_kill_text (input_line_point, input_line_end);
+ else
+ {
+ ea_kill_text (input_line_point, input_line_beg);
+ input_line_point = input_line_beg;
+ }
+}
+
+/* Delete from point to the end of the current word. */
+DECLARE_INFO_COMMAND (ea_kill_word, "Kill the word following the cursor")
+{
+ int orig_point = input_line_point;
+
+ if (count < 0)
+ ea_backward_kill_word (window, -count, key);
+ else
+ {
+ ea_forward_word (window, count, key);
+
+ if (input_line_point != orig_point)
+ ea_kill_text (orig_point, input_line_point);
+
+ input_line_point = orig_point;
+ }
+}
+
+/* Delete from point to the start of the current word. */
+DECLARE_INFO_COMMAND (ea_backward_kill_word,
+ "Kill the word preceding the cursor")
+{
+ int orig_point = input_line_point;
+
+ if (count < 0)
+ ea_kill_word (window, -count, key);
+ else
+ {
+ ea_backward_word (window, count, key);
+
+ if (input_line_point != orig_point)
+ ea_kill_text (orig_point, input_line_point);
+ }
+}
+
+/* The way to kill something. This appends or prepends to the last
+ kill, if the last command was a kill command. If FROM is less
+ than TO, then the killed text is appended to the most recent kill,
+ otherwise it is prepended. If the last command was not a kill command,
+ then a new slot is made for this kill. */
+static void
+ea_kill_text (from, to)
+ int from, to;
+{
+ register int i, counter, distance;
+ int killing_backwards, slot;
+ char *killed_text;
+
+ killing_backwards = (from > to);
+
+ /* If killing backwards, reverse the values of FROM and TO. */
+ if (killing_backwards)
+ {
+ int temp = from;
+ from = to;
+ to = temp;
+ }
+
+ /* Remember the text that we are about to delete. */
+ distance = to - from;
+ killed_text = (char *)xmalloc (1 + distance);
+ strncpy (killed_text, &input_line[from], distance);
+ killed_text[distance] = '\0';
+
+ /* Actually delete the text from the line. */
+ counter = input_line_end - to;
+
+ for (i = from; counter; i++, counter--)
+ input_line[i] = input_line[i + distance];
+
+ input_line_end -= distance;
+
+ /* If the last command was a kill, append or prepend the killed text to
+ the last command's killed text. */
+ if (echo_area_last_command_was_kill)
+ {
+ char *old, *new;
+
+ slot = kill_ring_loc;
+ old = kill_ring[slot];
+ new = (char *)xmalloc (1 + strlen (old) + strlen (killed_text));
+
+ if (killing_backwards)
+ {
+ /* Prepend TEXT to current kill. */
+ strcpy (new, killed_text);
+ strcat (new, old);
+ }
+ else
+ {
+ /* Append TEXT to current kill. */
+ strcpy (new, old);
+ strcat (new, killed_text);
+ }
+
+ free (old);
+ free (killed_text);
+ kill_ring[slot] = new;
+ }
+ else
+ {
+ /* Try to store the kill in a new slot, unless that would cause there
+ to be too many remembered kills. */
+ slot = kill_ring_index;
+
+ if (slot == max_retained_kills)
+ slot = 0;
+
+ if (slot + 1 > kill_ring_slots)
+ kill_ring = (char **) xrealloc
+ (kill_ring,
+ (kill_ring_slots += max_retained_kills) * sizeof (char *));
+
+ if (slot != kill_ring_index)
+ free (kill_ring[slot]);
+ else
+ kill_ring_index++;
+
+ kill_ring[slot] = killed_text;
+
+ kill_ring_loc = slot;
+ }
+
+ /* Notice that the last command was a kill. */
+ echo_area_last_command_was_kill++;
+}
+
+/* **************************************************************** */
+/* */
+/* Echo Area Completion */
+/* */
+/* **************************************************************** */
+
+/* Pointer to an array of REFERENCE to complete over. */
+static REFERENCE **echo_area_completion_items = (REFERENCE **)NULL;
+
+/* Sorted array of REFERENCE * which is the possible completions found in
+ the variable echo_area_completion_items. If there is only one element,
+ it is the only possible completion. */
+static REFERENCE **completions_found = (REFERENCE **)NULL;
+static int completions_found_index = 0;
+static int completions_found_slots = 0;
+
+/* The lowest common denominator found while completing. */
+static REFERENCE *LCD_completion;
+
+/* Internal functions used by the user calls. */
+static void build_completions (), completions_must_be_rebuilt ();
+
+/* Variable which holds the output of completions. */
+static NODE *possible_completions_output_node = (NODE *)NULL;
+
+static char *compwin_name = "*Completions*";
+
+/* Return non-zero if WINDOW is a window used for completions output. */
+static int
+completions_window_p (window)
+ WINDOW *window;
+{
+ int result = 0;
+
+ if (internal_info_node_p (window->node) &&
+ (strcmp (window->node->nodename, compwin_name) == 0))
+ result = 1;
+
+ return (result);
+}
+
+/* Workhorse for completion readers. If FORCE is non-zero, the user cannot
+ exit unless the line read completes, or is empty. */
+char *
+info_read_completing_internal (window, prompt, completions, force)
+ WINDOW *window;
+ char *prompt;
+ REFERENCE **completions;
+ int force;
+{
+ char *line;
+
+ /* If the echo area is already active, remember the current state. */
+ if (echo_area_is_active)
+ push_echo_area ();
+
+ echo_area_must_complete_p = force;
+
+ /* Initialize our local variables. */
+ initialize_input_line (prompt);
+
+ /* Initialize the echo area for the first (but maybe not the last) time. */
+ echo_area_initialize_node ();
+
+ /* Save away the original node of this window, and the window itself,
+ so echo area commands can temporarily use this window. */
+ remember_calling_window (window);
+
+ /* Save away the list of items to complete over. */
+ echo_area_completion_items = completions;
+ completions_must_be_rebuilt ();
+
+ active_window = the_echo_area;
+ echo_area_is_active++;
+
+ /* Read characters in the echo area. */
+ while (1)
+ {
+ info_read_and_dispatch ();
+
+ line = echo_area_after_read ();
+
+ /* Force the completion to take place if the user hasn't accepted
+ a default or aborted, and if FORCE is active. */
+ if (force && line && *line && completions)
+ {
+ register int i;
+
+ build_completions ();
+
+ /* If there is only one completion, then make the line be that
+ completion. */
+ if (completions_found_index == 1)
+ {
+ free (line);
+ line = strdup (completions_found[0]->label);
+ break;
+ }
+
+ /* If one of the completions matches exactly, then that is okay, so
+ return the current line. */
+ for (i = 0; i < completions_found_index; i++)
+ if (strcasecmp (completions_found[i]->label, line) == 0)
+ {
+ free (line);
+ line = strdup (completions_found[i]->label);
+ break;
+ }
+
+ /* If no match, go back and try again. */
+ if (i == completions_found_index)
+ {
+ inform_in_echo_area ("Not complete");
+ continue;
+ }
+ }
+ break;
+ }
+ echo_area_is_active--;
+
+ /* Restore the original active window and show point in it. */
+ active_window = calling_window;
+ restore_calling_window ();
+ display_cursor_at_point (active_window);
+ fflush (stdout);
+
+ echo_area_completion_items = (REFERENCE **)NULL;
+ completions_must_be_rebuilt ();
+
+ /* If there is a previous loop waiting for us, restore it now. */
+ if (echo_area_is_active)
+ pop_echo_area ();
+
+ return (line);
+}
+
+/* Read a line in the echo area with completion over COMPLETIONS. */
+char *
+info_read_completing_in_echo_area (window, prompt, completions)
+ WINDOW *window;
+ char *prompt;
+ REFERENCE **completions;
+{
+ return (info_read_completing_internal (window, prompt, completions, 1));
+}
+
+/* Read a line in the echo area allowing completion over COMPLETIONS, but
+ not requiring it. */
+char *
+info_read_maybe_completing (window, prompt, completions)
+ WINDOW *window;
+ char *prompt;
+ REFERENCE **completions;
+{
+ return (info_read_completing_internal (window, prompt, completions, 0));
+}
+
+DECLARE_INFO_COMMAND (ea_possible_completions, "List possible completions")
+{
+ if (!echo_area_completion_items)
+ {
+ ea_insert (window, count, key);
+ return;
+ }
+
+ build_completions ();
+
+ if (!completions_found_index)
+ {
+ terminal_ring_bell ();
+ inform_in_echo_area ("No completions");
+ }
+ else if ((completions_found_index == 1) && (key != '?'))
+ {
+ inform_in_echo_area ("Sole completion");
+ }
+ else
+ {
+ register int i, l;
+ int limit, count, max_label = 0;
+
+ initialize_message_buffer ();
+ printf_to_message_buffer
+ ("There %s %d ", completions_found_index == 1 ? "is" : "are",
+ completions_found_index);
+ printf_to_message_buffer
+ ("completion%s:\n", completions_found_index == 1 ? "" : "s");
+
+ /* Find the maximum length of a label. */
+ for (i = 0; i < completions_found_index; i++)
+ {
+ int len = strlen (completions_found[i]->label);
+ if (len > max_label)
+ max_label = len;
+ }
+
+ max_label += 4;
+
+ /* Find out how many columns we should print in. */
+ limit = calling_window->width / max_label;
+ if (limit != 1 && (limit * max_label == calling_window->width))
+ limit--;
+
+ /* Avoid a possible floating exception. If max_label > width then
+ the limit will be 0 and a divide-by-zero fault will result. */
+ if (limit == 0)
+ limit = 1;
+
+ /* How many iterations of the printing loop? */
+ count = (completions_found_index + (limit - 1)) / limit;
+
+ /* Watch out for special case. If the number of completions is less
+ than LIMIT, then just do the inner printing loop. */
+ if (completions_found_index < limit)
+ count = 1;
+
+ /* Print the sorted items, up-and-down alphabetically. */
+ for (i = 0; i < count; i++)
+ {
+ register int j;
+
+ for (j = 0, l = i; j < limit; j++)
+ {
+ if (l >= completions_found_index)
+ break;
+ else
+ {
+ char *label;
+ int printed_length, k;
+
+ label = completions_found[l]->label;
+ printed_length = strlen (label);
+ printf_to_message_buffer ("%s", label);
+
+ if (j + 1 < limit)
+ {
+ for (k = 0; k < max_label - printed_length; k++)
+ printf_to_message_buffer (" ");
+ }
+ }
+ l += count;
+ }
+ printf_to_message_buffer ("\n");
+ }
+
+ /* Make a new node to hold onto possible completions. Don't destroy
+ dangling pointers. */
+ {
+ NODE *temp;
+
+ temp = message_buffer_to_node ();
+ add_gcable_pointer (temp->contents);
+ name_internal_node (temp, compwin_name);
+ possible_completions_output_node = temp;
+ }
+
+ /* Find a suitable window for displaying the completions output.
+ First choice is an existing window showing completions output.
+ If there is only one window, and it is large, make another
+ (smaller) window, and use that one. Otherwise, use the caller's
+ window. */
+ {
+ WINDOW *compwin;
+
+ compwin = get_internal_info_window (compwin_name);
+
+ if (!compwin)
+ {
+ /* If we can split the window to display most of the completion
+ items, then do so. */
+ if (calling_window->height > (count * 2))
+ {
+ int start, end, pagetop;
+
+ active_window = calling_window;
+
+ /* Perhaps we can scroll this window on redisplay. */
+ start = calling_window->first_row;
+ pagetop = calling_window->pagetop;
+
+ compwin =
+ window_make_window (possible_completions_output_node);
+ active_window = the_echo_area;
+ window_change_window_height
+ (compwin, -(compwin->height - (count + 2)));
+
+ window_adjust_pagetop (calling_window);
+ remember_calling_window (calling_window);
+
+#if defined (SPLIT_BEFORE_ACTIVE)
+ /* If the pagetop hasn't changed, scrolling the calling
+ window is a reasonable thing to do. */
+ if (pagetop == calling_window->pagetop)
+ {
+ end = start + calling_window->height;
+ display_scroll_display
+ (start, end, calling_window->prev->height + 1);
+ }
+#else /* !SPLIT_BEFORE_ACTIVE */
+ /* If the pagetop has changed, set the new pagetop here. */
+ if (pagetop != calling_window->pagetop)
+ {
+ int newtop = calling_window->pagetop;
+ calling_window->pagetop = pagetop;
+ set_window_pagetop (calling_window, newtop);
+ }
+#endif /* !SPLIT_BEFORE_ACTIVE */
+
+ echo_area_completions_window = compwin;
+ remember_window_and_node (compwin, compwin->node);
+ }
+ else
+ compwin = calling_window;
+ }
+
+ if (compwin->node != possible_completions_output_node)
+ {
+ window_set_node_of_window
+ (compwin, possible_completions_output_node);
+ remember_window_and_node (compwin, compwin->node);
+ }
+
+ display_update_display (windows);
+ }
+ }
+}
+
+DECLARE_INFO_COMMAND (ea_complete, "Insert completion")
+{
+ if (!echo_area_completion_items)
+ {
+ ea_insert (window, count, key);
+ return;
+ }
+
+ /* If KEY is SPC, and we are not forcing completion to take place, simply
+ insert the key. */
+ if (!echo_area_must_complete_p && key == SPC)
+ {
+ ea_insert (window, count, key);
+ return;
+ }
+
+ if (ea_last_executed_command == ea_complete)
+ {
+ /* If the keypress is a SPC character, and we have already tried
+ completing once, and there are several completions, then check
+ the batch of completions to see if any continue with a space.
+ If there are some, insert the space character and continue. */
+ if (key == SPC && completions_found_index > 1)
+ {
+ register int i, offset;
+
+ offset = input_line_end - input_line_beg;
+
+ for (i = 0; i < completions_found_index; i++)
+ if (completions_found[i]->label[offset] == ' ')
+ break;
+
+ if (completions_found[i])
+ ea_insert (window, 1, ' ');
+ else
+ {
+ ea_possible_completions (window, count, key);
+ return;
+ }
+ }
+ else
+ {
+ ea_possible_completions (window, count, key);
+ return;
+ }
+ }
+
+ input_line_point = input_line_end;
+ build_completions ();
+
+ if (!completions_found_index)
+ terminal_ring_bell ();
+ else if (LCD_completion->label[0] == '\0')
+ ea_possible_completions (window, count, key);
+ else
+ {
+ register int i;
+ input_line_point = input_line_end = input_line_beg;
+ for (i = 0; LCD_completion->label[i]; i++)
+ ea_insert (window, 1, LCD_completion->label[i]);
+ }
+}
+
+/* Utility REFERENCE used to store possible LCD. */
+static REFERENCE LCD_reference = { (char *)NULL, (char *)NULL, (char *)NULL };
+
+static void remove_completion_duplicates ();
+
+/* Variables which remember the state of the most recent call
+ to build_completions (). */
+static char *last_completion_request = (char *)NULL;
+static REFERENCE **last_completion_items = (REFERENCE **)NULL;
+
+/* How to tell the completion builder to reset internal state. */
+static void
+completions_must_be_rebuilt ()
+{
+ maybe_free (last_completion_request);
+ last_completion_request = (char *)NULL;
+ last_completion_items = (REFERENCE **)NULL;
+}
+
+/* Build a list of possible completions from echo_area_completion_items,
+ and the contents of input_line. */
+static void
+build_completions ()
+{
+ register int i, len;
+ register REFERENCE *entry;
+ char *request;
+ int informed_of_lengthy_job = 0;
+
+ /* If there are no items to complete over, exit immediately. */
+ if (!echo_area_completion_items)
+ {
+ completions_found_index = 0;
+ LCD_completion = (REFERENCE *)NULL;
+ return;
+ }
+
+ /* Check to see if this call to build completions is the same as the last
+ call to build completions. */
+ len = input_line_end - input_line_beg;
+ request = (char *)xmalloc (1 + len);
+ strncpy (request, &input_line[input_line_beg], len);
+ request[len] = '\0';
+
+ if (last_completion_request && last_completion_items &&
+ last_completion_items == echo_area_completion_items &&
+ (strcmp (last_completion_request, request) == 0))
+ {
+ free (request);
+ return;
+ }
+
+ maybe_free (last_completion_request);
+ last_completion_request = request;
+ last_completion_items = echo_area_completion_items;
+
+ /* Always start at the beginning of the list. */
+ completions_found_index = 0;
+ LCD_completion = (REFERENCE *)NULL;
+
+ for (i = 0; entry = echo_area_completion_items[i]; i++)
+ {
+ if (strncasecmp (request, entry->label, len) == 0)
+ add_pointer_to_array (entry, completions_found_index,
+ completions_found, completions_found_slots,
+ 20, REFERENCE *);
+
+ if (!informed_of_lengthy_job && completions_found_index > 100)
+ {
+ informed_of_lengthy_job = 1;
+ window_message_in_echo_area ("Building completions...");
+ }
+ }
+
+ if (!completions_found_index)
+ return;
+
+ /* Sort and prune duplicate entries from the completions array. */
+ remove_completion_duplicates ();
+
+ /* If there is only one completion, just return that. */
+ if (completions_found_index == 1)
+ {
+ LCD_completion = completions_found[0];
+ return;
+ }
+
+ /* Find the least common denominator. */
+ {
+ long shortest = 100000;
+
+ for (i = 1; i < completions_found_index; i++)
+ {
+ register int j;
+ int c1, c2;
+
+ for (j = 0;
+ (c1 = info_tolower (completions_found[i - 1]->label[j])) &&
+ (c2 = info_tolower (completions_found[i]->label[j]));
+ j++)
+ if (c1 != c2)
+ break;
+
+ if (shortest > j)
+ shortest = j;
+ }
+
+ maybe_free (LCD_reference.label);
+ LCD_reference.label = (char *)xmalloc (1 + shortest);
+ strncpy (LCD_reference.label, completions_found[0]->label, shortest);
+ LCD_reference.label[shortest] = '\0';
+ LCD_completion = &LCD_reference;
+ }
+
+ if (informed_of_lengthy_job)
+ echo_area_initialize_node ();
+}
+
+/* Function called by qsort. */
+static int
+compare_references (entry1, entry2)
+ REFERENCE **entry1, **entry2;
+{
+ return (strcasecmp ((*entry1)->label, (*entry2)->label));
+}
+
+/* Prune duplicate entries from COMPLETIONS_FOUND. */
+static void
+remove_completion_duplicates ()
+{
+ register int i, j;
+ REFERENCE **temp;
+ int newlen;
+
+ if (!completions_found_index)
+ return;
+
+ /* Sort the items. */
+ qsort (completions_found, completions_found_index, sizeof (REFERENCE *),
+ compare_references);
+
+ for (i = 0, newlen = 1; i < completions_found_index - 1; i++)
+ {
+ if (strcmp (completions_found[i]->label,
+ completions_found[i + 1]->label) == 0)
+ completions_found[i] = (REFERENCE *)NULL;
+ else
+ newlen++;
+ }
+
+ /* We have marked all the dead slots. It is faster to copy the live slots
+ twice than to prune the dead slots one by one. */
+ temp = (REFERENCE **)xmalloc ((1 + newlen) * sizeof (REFERENCE *));
+ for (i = 0, j = 0; i < completions_found_index; i++)
+ if (completions_found[i])
+ temp[j++] = completions_found[i];
+
+ for (i = 0; i < newlen; i++)
+ completions_found[i] = temp[i];
+
+ completions_found[i] = (REFERENCE *)NULL;
+ completions_found_index = newlen;
+ free (temp);
+}
+
+/* Scroll the "other" window. If there is a window showing completions, scroll
+ that one, otherwise scroll the window which was active on entering the read
+ function. */
+DECLARE_INFO_COMMAND (ea_scroll_completions_window, "Scroll the completions window")
+{
+ WINDOW *compwin;
+ int old_pagetop;
+
+ compwin = get_internal_info_window (compwin_name);
+
+ if (!compwin)
+ compwin = calling_window;
+
+ old_pagetop = compwin->pagetop;
+
+ /* Let info_scroll_forward () do the work, and print any messages that
+ need to be displayed. */
+ info_scroll_forward (compwin, count, key);
+}
+
+/* Function which gets called when an Info window is deleted while the
+ echo area is active. WINDOW is the window which has just been deleted. */
+void
+echo_area_inform_of_deleted_window (window)
+ WINDOW *window;
+{
+ /* If this is the calling_window, forget what we remembered about it. */
+ if (window == calling_window)
+ {
+ if (active_window != the_echo_area)
+ remember_calling_window (active_window);
+ else
+ remember_calling_window (windows);
+ }
+
+ /* If this window was the echo_area_completions_window, then notice that
+ the window has been deleted. */
+ if (window == echo_area_completions_window)
+ echo_area_completions_window = (WINDOW *)NULL;
+}
+
+/* **************************************************************** */
+/* */
+/* Pushing and Popping the Echo Area */
+/* */
+/* **************************************************************** */
+
+/* Push and Pop the echo area. */
+typedef struct {
+ char *line;
+ char *prompt;
+ REFERENCE **comp_items;
+ int point, beg, end;
+ int must_complete;
+ NODE node;
+ WINDOW *compwin;
+} PUSHED_EA;
+
+static PUSHED_EA **pushed_echo_areas = (PUSHED_EA **)NULL;
+static int pushed_echo_areas_index = 0;
+static int pushed_echo_areas_slots = 0;
+
+/* Pushing the echo_area has a side effect of zeroing the completion_items. */
+static void
+push_echo_area ()
+{
+ PUSHED_EA *pushed;
+
+ pushed = (PUSHED_EA *)xmalloc (sizeof (PUSHED_EA));
+ pushed->line = strdup (input_line);
+ pushed->prompt = input_line_prompt;
+ pushed->point = input_line_point;
+ pushed->beg = input_line_beg;
+ pushed->end = input_line_end;
+ pushed->node = input_line_node;
+ pushed->comp_items = echo_area_completion_items;
+ pushed->must_complete = echo_area_must_complete_p;
+ pushed->compwin = echo_area_completions_window;
+
+ add_pointer_to_array (pushed, pushed_echo_areas_index, pushed_echo_areas,
+ pushed_echo_areas_slots, 4, PUSHED_EA *);
+
+ echo_area_completion_items = (REFERENCE **)NULL;
+}
+
+static void
+pop_echo_area ()
+{
+ PUSHED_EA *popped;
+
+ popped = pushed_echo_areas[--pushed_echo_areas_index];
+
+ strcpy (input_line, popped->line);
+ free (popped->line);
+ input_line_prompt = popped->prompt;
+ input_line_point = popped->point;
+ input_line_beg = popped->beg;
+ input_line_end = popped->end;
+ input_line_node = popped->node;
+ echo_area_completion_items = popped->comp_items;
+ echo_area_must_complete_p = popped->must_complete;
+ echo_area_completions_window = popped->compwin;
+ completions_must_be_rebuilt ();
+
+ /* If the completion window no longer exists, forget about it. */
+ if (echo_area_completions_window)
+ {
+ register WINDOW *win;
+
+ for (win = windows; win; win = win->next)
+ if (echo_area_completions_window == win)
+ break;
+
+ /* If the window wasn't found, then it has already been deleted. */
+ if (!win)
+ echo_area_completions_window = (WINDOW *)NULL;
+ }
+
+ free (popped);
+}
+
+static int
+echo_area_stack_depth ()
+{
+ return (pushed_echo_areas_index);
+}
+
+/* Returns non-zero if any of the prior stacked calls to read in the echo
+ area produced a completions window. */
+static int
+echo_area_stack_contains_completions_p ()
+{
+ register int i;
+
+ for (i = 0; i < pushed_echo_areas_index; i++)
+ if (pushed_echo_areas[i]->compwin)
+ return (1);
+
+ return (0);
+}
+
+/* **************************************************************** */
+/* */
+/* Error Messages While Reading in Echo Area */
+/* */
+/* **************************************************************** */
+
+#if defined (HAVE_SYS_TIME_H)
+# include <sys/time.h>
+# define HAVE_STRUCT_TIMEVAL
+#endif /* HAVE_SYS_TIME_H */
+
+static void
+pause_or_input ()
+{
+#if defined (FD_SET)
+ struct timeval timer;
+ fd_set readfds;
+ int ready;
+
+ FD_ZERO (&readfds);
+ FD_SET (fileno (stdin), &readfds);
+ timer.tv_sec = 2;
+ timer.tv_usec = 750;
+ ready = select (1, &readfds, (fd_set *)NULL, (fd_set *)NULL, &timer);
+#endif /* FD_SET */
+}
+
+/* Print MESSAGE right after the end of the current line, and wait
+ for input or 2.75 seconds, whichever comes first. Then flush the
+ informational message that was printed. */
+void
+inform_in_echo_area (message)
+ char *message;
+{
+ register int i;
+ char *text;
+
+ text = strdup (message);
+ for (i = 0; text[i] && text[i] != '\n'; i++);
+ text[i] = '\0';
+
+ echo_area_initialize_node ();
+ sprintf (&input_line[input_line_end], "%s[%s]\n",
+ echo_area_is_active ? " ": "", text);
+ free (text);
+ the_echo_area->point = input_line_point;
+ display_update_one_window (the_echo_area);
+ display_cursor_at_point (active_window);
+ fflush (stdout);
+ pause_or_input ();
+ echo_area_initialize_node ();
+}
diff --git a/texinfo/info/echo_area.h b/texinfo/info/echo_area.h
new file mode 100644
index 00000000000..09c2bc7e22e
--- /dev/null
+++ b/texinfo/info/echo_area.h
@@ -0,0 +1,63 @@
+/* echo_area.h -- Functions used in reading information from the echo area. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_ECHO_AREA_H_)
+#define _ECHO_AREA_H_
+
+#define EA_MAX_INPUT 256
+
+extern int echo_area_is_active, info_aborted_echo_area;
+
+/* Non-zero means that the last command executed while reading input
+ killed some text. */
+extern int echo_area_last_command_was_kill;
+
+extern void inform_in_echo_area (), echo_area_inform_of_deleted_window ();
+extern void echo_area_prep_read ();
+extern VFunction *ea_last_executed_command;
+
+/* Read a line of text in the echo area. Return a malloc ()'ed string,
+ or NULL if the user aborted out of this read. WINDOW is the currently
+ active window, so that we can restore it when we need to. PROMPT, if
+ non-null, is a prompt to print before reading the line. */
+extern char *info_read_in_echo_area ();
+
+/* Read a line in the echo area with completion over COMPLETIONS.
+ Takes arguments of WINDOW, PROMPT, and COMPLETIONS, a REFERENCE **. */
+char *info_read_completing_in_echo_area ();
+
+/* Read a line in the echo area allowing completion over COMPLETIONS, but
+ not requiring it. Takes arguments of WINDOW, PROMPT, and COMPLETIONS,
+ a REFERENCE **. */
+extern char *info_read_maybe_completing ();
+
+extern void ea_insert (), ea_quoted_insert ();
+extern void ea_beg_of_line (), ea_backward (), ea_delete (), ea_end_of_line ();
+extern void ea_forward (), ea_abort (), ea_rubout (), ea_complete ();
+extern void ea_newline (), ea_kill_line (), ea_transpose_chars ();
+extern void ea_yank (), ea_tab_insert (), ea_possible_completions ();
+extern void ea_backward_word (), ea_kill_word (), ea_forward_word ();
+extern void ea_yank_pop (), ea_backward_kill_word ();
+extern void ea_scroll_completions_window ();
+
+#endif /* _ECHO_AREA_H_ */
diff --git a/texinfo/info/filesys.c b/texinfo/info/filesys.c
new file mode 100644
index 00000000000..e684bf81f7b
--- /dev/null
+++ b/texinfo/info/filesys.c
@@ -0,0 +1,617 @@
+/* filesys.c -- File system specific functions for hacking this system. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#if defined (HAVE_SYS_FILE_H)
+#include <sys/file.h>
+#endif /* HAVE_SYS_FILE_H */
+#include <sys/errno.h>
+#include "general.h"
+#include "tilde.h"
+#include "filesys.h"
+
+#if !defined (O_RDONLY)
+#if defined (HAVE_SYS_FCNTL_H)
+#include <sys/fcntl.h>
+#else /* !HAVE_SYS_FCNTL_H */
+#include <fcntl.h>
+#endif /* !HAVE_SYS_FCNTL_H */
+#endif /* !O_RDONLY */
+
+#if !defined (errno)
+extern int errno;
+#endif /* !errno */
+
+/* Found in info-utils.c. */
+extern char *filename_non_directory ();
+
+#if !defined (BUILDING_LIBRARY)
+/* Found in session.c */
+extern int info_windows_initialized_p;
+
+/* Found in window.c. */
+extern void message_in_echo_area (), unmessage_in_echo_area ();
+#endif /* !BUILDING_LIBRARY */
+
+/* Local to this file. */
+static char *info_file_in_path (), *lookup_info_filename ();
+static void remember_info_filename (), maybe_initialize_infopath ();
+
+#if !defined (NULL)
+# define NULL 0x0
+#endif /* !NULL */
+
+typedef struct {
+ char *suffix;
+ char *decompressor;
+} COMPRESSION_ALIST;
+
+static char *info_suffixes[] = {
+ "",
+ ".info",
+ "-info",
+ (char *)NULL
+};
+
+static COMPRESSION_ALIST compress_suffixes[] = {
+ { ".Z", "uncompress" },
+ { ".Y", "unyabba" },
+ { ".z", "gunzip" },
+ { ".gz", "gunzip" },
+ { (char *)NULL, (char *)NULL }
+};
+
+/* The path on which we look for info files. You can initialize this
+ from the environment variable INFOPATH if there is one, or you can
+ call info_add_path () to add paths to the beginning or end of it.
+ You can call zap_infopath () to make the path go away. */
+char *infopath = (char *)NULL;
+static int infopath_size = 0;
+
+/* Expand the filename in PARTIAL to make a real name for this operating
+ system. This looks in INFO_PATHS in order to find the correct file.
+ If it can't find the file, it returns NULL. */
+static char *local_temp_filename = (char *)NULL;
+static int local_temp_filename_size = 0;
+
+char *
+info_find_fullpath (partial)
+ char *partial;
+{
+ int initial_character;
+ char *temp;
+
+ filesys_error_number = 0;
+
+ maybe_initialize_infopath ();
+
+ if (partial && (initial_character = *partial))
+ {
+ char *expansion;
+
+ expansion = lookup_info_filename (partial);
+
+ if (expansion)
+ return (expansion);
+
+ /* If we have the full path to this file, we still may have to add
+ various extensions to it. I guess we have to stat this file
+ after all. */
+ if (initial_character == '/')
+ temp = info_file_in_path (partial + 1, "/");
+ else if (initial_character == '~')
+ {
+ expansion = tilde_expand_word (partial);
+ if (*expansion == '/')
+ {
+ temp = info_file_in_path (expansion + 1, "/");
+ free (expansion);
+ }
+ else
+ temp = expansion;
+ }
+ else if (initial_character == '.' &&
+ (partial[1] == '/' || (partial[1] == '.' && partial[2] == '/')))
+ {
+ if (local_temp_filename_size < 1024)
+ local_temp_filename = (char *)xrealloc
+ (local_temp_filename, (local_temp_filename_size = 1024));
+#if defined (HAVE_GETCWD)
+ if (!getcwd (local_temp_filename, local_temp_filename_size))
+#else /* !HAVE_GETCWD */
+ if (!getwd (local_temp_filename))
+#endif /* !HAVE_GETCWD */
+ {
+ filesys_error_number = errno;
+ return (partial);
+ }
+
+ strcat (local_temp_filename, "/");
+ strcat (local_temp_filename, partial);
+ return (local_temp_filename);
+ }
+ else
+ temp = info_file_in_path (partial, infopath);
+
+ if (temp)
+ {
+ remember_info_filename (partial, temp);
+ if (strlen (temp) > local_temp_filename_size)
+ local_temp_filename = (char *) xrealloc
+ (local_temp_filename,
+ (local_temp_filename_size = (50 + strlen (temp))));
+ strcpy (local_temp_filename, temp);
+ free (temp);
+ return (local_temp_filename);
+ }
+ }
+ return (partial);
+}
+
+/* Scan the list of directories in PATH looking for FILENAME. If we find
+ one that is a regular file, return it as a new string. Otherwise, return
+ a NULL pointer. */
+static char *
+info_file_in_path (filename, path)
+ char *filename, *path;
+{
+ struct stat finfo;
+ char *temp_dirname;
+ int statable, dirname_index;
+
+ dirname_index = 0;
+
+ while (temp_dirname = extract_colon_unit (path, &dirname_index))
+ {
+ register int i, pre_suffix_length;
+ char *temp;
+
+ /* Expand a leading tilde if one is present. */
+ if (*temp_dirname == '~')
+ {
+ char *expanded_dirname;
+
+ expanded_dirname = tilde_expand_word (temp_dirname);
+ free (temp_dirname);
+ temp_dirname = expanded_dirname;
+ }
+
+ temp = (char *)xmalloc (30 + strlen (temp_dirname) + strlen (filename));
+ strcpy (temp, temp_dirname);
+ if (temp[(strlen (temp)) - 1] != '/')
+ strcat (temp, "/");
+ strcat (temp, filename);
+
+ pre_suffix_length = strlen (temp);
+
+ free (temp_dirname);
+
+ for (i = 0; info_suffixes[i]; i++)
+ {
+ strcpy (temp + pre_suffix_length, info_suffixes[i]);
+
+ statable = (stat (temp, &finfo) == 0);
+
+ /* If we have found a regular file, then use that. Else, if we
+ have found a directory, look in that directory for this file. */
+ if (statable)
+ {
+ if (S_ISREG (finfo.st_mode))
+ {
+ return (temp);
+ }
+ else if (S_ISDIR (finfo.st_mode))
+ {
+ char *newpath, *filename_only, *newtemp;
+
+ newpath = strdup (temp);
+ filename_only = filename_non_directory (filename);
+ newtemp = info_file_in_path (filename_only, newpath);
+
+ free (newpath);
+ if (newtemp)
+ {
+ free (temp);
+ return (newtemp);
+ }
+ }
+ }
+ else
+ {
+ /* Add various compression suffixes to the name to see if
+ the file is present in compressed format. */
+ register int j, pre_compress_suffix_length;
+
+ pre_compress_suffix_length = strlen (temp);
+
+ for (j = 0; compress_suffixes[j].suffix; j++)
+ {
+ strcpy (temp + pre_compress_suffix_length,
+ compress_suffixes[j].suffix);
+
+ statable = (stat (temp, &finfo) == 0);
+ if (statable && (S_ISREG (finfo.st_mode)))
+ return (temp);
+ }
+ }
+ }
+ free (temp);
+ }
+ return ((char *)NULL);
+}
+
+/* Given a string containing units of information separated by colons,
+ return the next one pointed to by IDX, or NULL if there are no more.
+ Advance IDX to the character after the colon. */
+char *
+extract_colon_unit (string, idx)
+ char *string;
+ int *idx;
+{
+ register int i, start;
+
+ i = start = *idx;
+ if ((i >= strlen (string)) || !string)
+ return ((char *) NULL);
+
+ while (string[i] && string[i] != ':')
+ i++;
+ if (i == start)
+ {
+ return ((char *) NULL);
+ }
+ else
+ {
+ char *value;
+
+ value = (char *) xmalloc (1 + (i - start));
+ strncpy (value, &string[start], (i - start));
+ value[i - start] = '\0';
+ if (string[i])
+ ++i;
+ *idx = i;
+ return (value);
+ }
+}
+
+/* A structure which associates a filename with its expansion. */
+typedef struct {
+ char *filename;
+ char *expansion;
+} FILENAME_LIST;
+
+/* An array of remembered arguments and results. */
+static FILENAME_LIST **names_and_files = (FILENAME_LIST **)NULL;
+static int names_and_files_index = 0;
+static int names_and_files_slots = 0;
+
+/* Find the result for having already called info_find_fullpath () with
+ FILENAME. */
+static char *
+lookup_info_filename (filename)
+ char *filename;
+{
+ if (filename && names_and_files)
+ {
+ register int i;
+ for (i = 0; names_and_files[i]; i++)
+ {
+ if (strcmp (names_and_files[i]->filename, filename) == 0)
+ return (names_and_files[i]->expansion);
+ }
+ }
+ return (char *)NULL;;
+}
+
+/* Add a filename and its expansion to our list. */
+static void
+remember_info_filename (filename, expansion)
+ char *filename, *expansion;
+{
+ FILENAME_LIST *new;
+
+ if (names_and_files_index + 2 > names_and_files_slots)
+ {
+ int alloc_size;
+ names_and_files_slots += 10;
+
+ alloc_size = names_and_files_slots * sizeof (FILENAME_LIST *);
+
+ names_and_files =
+ (FILENAME_LIST **) xrealloc (names_and_files, alloc_size);
+ }
+
+ new = (FILENAME_LIST *)xmalloc (sizeof (FILENAME_LIST));
+ new->filename = strdup (filename);
+ new->expansion = expansion ? strdup (expansion) : (char *)NULL;
+
+ names_and_files[names_and_files_index++] = new;
+ names_and_files[names_and_files_index] = (FILENAME_LIST *)NULL;
+}
+
+static void
+maybe_initialize_infopath ()
+{
+ if (!infopath_size)
+ {
+ infopath = (char *)
+ xmalloc (infopath_size = (1 + strlen (DEFAULT_INFOPATH)));
+
+ strcpy (infopath, DEFAULT_INFOPATH);
+ }
+}
+
+/* Add PATH to the list of paths found in INFOPATH. 2nd argument says
+ whether to put PATH at the front or end of INFOPATH. */
+void
+info_add_path (path, where)
+ char *path;
+ int where;
+{
+ int len;
+
+ if (!infopath)
+ {
+ infopath = (char *)xmalloc (infopath_size = 200 + strlen (path));
+ infopath[0] = '\0';
+ }
+
+ len = strlen (path) + strlen (infopath);
+
+ if (len + 2 >= infopath_size)
+ infopath = (char *)xrealloc (infopath, (infopath_size += (2 * len) + 2));
+
+ if (!*infopath)
+ strcpy (infopath, path);
+ else if (where == INFOPATH_APPEND)
+ {
+ strcat (infopath, ":");
+ strcat (infopath, path);
+ }
+ else if (where == INFOPATH_PREPEND)
+ {
+ char *temp = strdup (infopath);
+ strcpy (infopath, path);
+ strcat (infopath, ":");
+ strcat (infopath, temp);
+ free (temp);
+ }
+}
+
+/* Make INFOPATH have absolutely nothing in it. */
+void
+zap_infopath ()
+{
+ if (infopath)
+ free (infopath);
+
+ infopath = (char *)NULL;
+ infopath_size = 0;
+}
+
+/* Read the contents of PATHNAME, returning a buffer with the contents of
+ that file in it, and returning the size of that buffer in FILESIZE.
+ FINFO is a stat struct which has already been filled in by the caller.
+ If the file cannot be read, return a NULL pointer. */
+char *
+filesys_read_info_file (pathname, filesize, finfo)
+ char *pathname;
+ long *filesize;
+ struct stat *finfo;
+{
+ long st_size;
+
+ *filesize = filesys_error_number = 0;
+
+ if (compressed_filename_p (pathname))
+ return (filesys_read_compressed (pathname, filesize, finfo));
+ else
+ {
+ int descriptor;
+ char *contents;
+
+ descriptor = open (pathname, O_RDONLY, 0666);
+
+ /* If the file couldn't be opened, give up. */
+ if (descriptor < 0)
+ {
+ filesys_error_number = errno;
+ return ((char *)NULL);
+ }
+
+ /* Try to read the contents of this file. */
+ st_size = (long) finfo->st_size;
+ contents = (char *)xmalloc (1 + st_size);
+ if ((read (descriptor, contents, st_size)) != st_size)
+ {
+ filesys_error_number = errno;
+ close (descriptor);
+ free (contents);
+ return ((char *)NULL);
+ }
+
+ close (descriptor);
+
+ *filesize = st_size;
+ return (contents);
+ }
+}
+
+/* Typically, pipe buffers are 4k. */
+#define BASIC_PIPE_BUFFER (4 * 1024)
+
+/* We use some large multiple of that. */
+#define FILESYS_PIPE_BUFFER_SIZE (16 * BASIC_PIPE_BUFFER)
+
+char *
+filesys_read_compressed (pathname, filesize, finfo)
+ char *pathname;
+ long *filesize;
+ struct stat *finfo;
+{
+ FILE *stream;
+ char *command, *decompressor;
+ char *contents = (char *)NULL;
+
+ *filesize = filesys_error_number = 0;
+
+ decompressor = filesys_decompressor_for_file (pathname);
+
+ if (!decompressor)
+ return ((char *)NULL);
+
+ command = (char *)xmalloc (10 + strlen (pathname) + strlen (decompressor));
+ sprintf (command, "%s < %s", decompressor, pathname);
+
+#if !defined (BUILDING_LIBRARY)
+ if (info_windows_initialized_p)
+ {
+ char *temp;
+
+ temp = (char *)xmalloc (5 + strlen (command));
+ sprintf (temp, "%s...", command);
+ message_in_echo_area ("%s", temp);
+ free (temp);
+ }
+#endif /* !BUILDING_LIBRARY */
+
+ stream = popen (command, "r");
+ free (command);
+
+ /* Read chunks from this file until there are none left to read. */
+ if (stream)
+ {
+ int offset, size;
+ char *chunk;
+
+ offset = size = 0;
+ chunk = (char *)xmalloc (FILESYS_PIPE_BUFFER_SIZE);
+
+ while (1)
+ {
+ int bytes_read;
+
+ bytes_read = fread (chunk, 1, FILESYS_PIPE_BUFFER_SIZE, stream);
+
+ if (bytes_read + offset >= size)
+ contents = (char *)xrealloc
+ (contents, size += (2 * FILESYS_PIPE_BUFFER_SIZE));
+
+ memcpy (contents + offset, chunk, bytes_read);
+ offset += bytes_read;
+ if (bytes_read != FILESYS_PIPE_BUFFER_SIZE)
+ break;
+ }
+
+ free (chunk);
+ pclose (stream);
+ contents = (char *)xrealloc (contents, offset + 1);
+ *filesize = offset;
+ }
+ else
+ {
+ filesys_error_number = errno;
+ }
+
+#if !defined (BUILDING_LIBARARY)
+ if (info_windows_initialized_p)
+ unmessage_in_echo_area ();
+#endif /* !BUILDING_LIBRARY */
+ return (contents);
+}
+
+/* Return non-zero if FILENAME belongs to a compressed file. */
+int
+compressed_filename_p (filename)
+ char *filename;
+{
+ char *decompressor;
+
+ /* Find the final extension of this filename, and see if it matches one
+ of our known ones. */
+ decompressor = filesys_decompressor_for_file (filename);
+
+ if (decompressor)
+ return (1);
+ else
+ return (0);
+}
+
+/* Return the command string that would be used to decompress FILENAME. */
+char *
+filesys_decompressor_for_file (filename)
+ char *filename;
+{
+ register int i;
+ char *extension = (char *)NULL;
+
+ /* Find the final extension of FILENAME, and see if it appears in our
+ list of known compression extensions. */
+ for (i = strlen (filename) - 1; i > 0; i--)
+ if (filename[i] == '.')
+ {
+ extension = filename + i;
+ break;
+ }
+
+ if (!extension)
+ return ((char *)NULL);
+
+ for (i = 0; compress_suffixes[i].suffix; i++)
+ if (strcmp (extension, compress_suffixes[i].suffix) == 0)
+ return (compress_suffixes[i].decompressor);
+
+ return ((char *)NULL);
+}
+
+/* The number of the most recent file system error. */
+int filesys_error_number = 0;
+
+/* A function which returns a pointer to a static buffer containing
+ an error message for FILENAME and ERROR_NUM. */
+static char *errmsg_buf = (char *)NULL;
+static int errmsg_buf_size = 0;
+
+char *
+filesys_error_string (filename, error_num)
+ char *filename;
+ int error_num;
+{
+ int len;
+ char *result;
+
+ if (error_num == 0)
+ return ((char *)NULL);
+
+ result = strerror (error_num);
+
+ len = 4 + strlen (filename) + strlen (result);
+ if (len >= errmsg_buf_size)
+ errmsg_buf = (char *)xrealloc (errmsg_buf, (errmsg_buf_size = 2 + len));
+
+ sprintf (errmsg_buf, "%s: %s", filename, result);
+ return (errmsg_buf);
+}
+
diff --git a/texinfo/info/filesys.h b/texinfo/info/filesys.h
new file mode 100644
index 00000000000..130a52a6357
--- /dev/null
+++ b/texinfo/info/filesys.h
@@ -0,0 +1,84 @@
+/* filesys.h -- External declarations of functions and vars in filesys.c. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_FILESYS_H_)
+#define _FILESYS_H_
+
+/* The path on which we look for info files. You can initialize this
+ from the environment variable INFOPATH if there is one, or you can
+ call info_add_path () to add paths to the beginning or end of it. */
+extern char *infopath;
+
+/* Make INFOPATH have absolutely nothing in it. */
+extern void zap_infopath ();
+
+/* Add PATH to the list of paths found in INFOPATH. 2nd argument says
+ whether to put PATH at the front or end of INFOPATH. */
+extern void info_add_path ();
+
+/* Defines that are passed along with the pathname to info_add_path (). */
+#define INFOPATH_PREPEND 0
+#define INFOPATH_APPEND 1
+
+/* Expand the filename in PARTIAL to make a real name for this operating
+ system. This looks in INFO_PATHS in order to find the correct file.
+ If it can't find the file, it returns NULL. */
+extern char *info_find_fullpath ();
+
+/* Read the contents of PATHNAME, returning a buffer with the contents of
+ that file in it, and returning the size of that buffer in FILESIZE.
+ FINFO is a stat struct which has already been filled in by the caller.
+ If the file cannot be read, return a NULL pointer. */
+extern char *filesys_read_info_file ();
+extern char *filesys_read_compressed ();
+
+/* Return the command string that would be used to decompress FILENAME. */
+extern char *filesys_decompressor_for_file ();
+extern int compressed_filename_p ();
+
+/* A function which returns a pointer to a static buffer containing
+ an error message for FILENAME and ERROR_NUM. */
+extern char *filesys_error_string ();
+
+/* The number of the most recent file system error. */
+extern int filesys_error_number;
+
+/* Given a string containing units of information separated by colons,
+ return the next one pointed to by IDX, or NULL if there are no more.
+ Advance IDX to the character after the colon. */
+extern char *extract_colon_unit ();
+
+/* The default value of INFOPATH. */
+#if !defined (DEFAULT_INFOPATH)
+! # define DEFAULT_INFOPATH "/usr/local/info:/usr/info:/usr/local/lib/info:/usr/lib/info:/usr/local/gnu/info:/usr/local/gnu/lib/info:/usr/gnu/info:/usr/gnu/lib/info:/opt/gnu/info:/usr/share/info:/usr/share/lib/info:/usr/local/share/info:/usr/local/share/lib/info:/usr/gnu/lib/emacs/info:/usr/local/gnu/lib/emacs/info:/usr/local/lib/emacs/info:/usr/local/emacs/info:."
+#endif /* !DEFAULT_INFOPATH */
+
+#if !defined (S_ISREG) && defined (S_IFREG)
+# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
+#endif /* !S_ISREG && S_IFREG */
+
+#if !defined (S_ISDIR) && defined (S_IFDIR)
+# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
+#endif /* !S_ISDIR && S_IFDIR */
+
+#endif /* !_FILESYS_H_ */
diff --git a/texinfo/info/footnotes.c b/texinfo/info/footnotes.c
new file mode 100644
index 00000000000..35a0f352de8
--- /dev/null
+++ b/texinfo/info/footnotes.c
@@ -0,0 +1,265 @@
+/* footnotes.c -- Some functions for manipulating footnotes. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+
+/* Non-zero means attempt to show footnotes when displaying a new window. */
+int auto_footnotes_p = 1;
+
+static char *footnote_nodename = "*Footnotes*";
+
+#define FOOTNOTE_HEADER_FORMAT \
+ "*** Footnotes appearing in the node \"%s\" ***\n"
+
+/* Find the window currently showing footnotes. */
+static WINDOW *
+find_footnotes_window ()
+{
+ WINDOW *win;
+
+ /* Try to find an existing window first. */
+ for (win = windows; win; win = win->next)
+ if (internal_info_node_p (win->node) &&
+ (strcmp (win->node->nodename, footnote_nodename) == 0))
+ break;
+
+ return (win);
+}
+
+/* Manufacture a node containing the footnotes of this node, and
+ return the manufactured node. If NODE has no footnotes, return a
+ NULL pointer. */
+NODE *
+make_footnotes_node (node)
+ NODE *node;
+{
+ NODE *fn_node, *result = (NODE *)NULL;
+ long fn_start;
+
+ /* Make the initial assumption that the footnotes appear as simple
+ text within this windows node. */
+ fn_node = node;
+
+ /* See if this node contains the magic footnote label. */
+ fn_start =
+ info_search_in_node (FOOTNOTE_LABEL, node, 0, (WINDOW *)NULL, 1);
+
+ /* If it doesn't, check to see if it has an associated footnotes node. */
+ if (fn_start == -1)
+ {
+ REFERENCE **refs;
+
+ refs = info_xrefs_of_node (node);
+
+ if (refs)
+ {
+ register int i;
+ char *refname;
+
+ refname = (char *)xmalloc
+ (1 + strlen ("-Footnotes") + strlen (node->nodename));
+
+ strcpy (refname, node->nodename);
+ strcat (refname, "-Footnotes");
+
+ for (i = 0; refs[i]; i++)
+ if ((refs[i]->nodename != (char *)NULL) &&
+ (strcmp (refs[i]->nodename, refname) == 0))
+ {
+ char *filename;
+
+ filename = node->parent;
+ if (!filename)
+ filename = node->filename;
+
+ fn_node = info_get_node (filename, refname);
+
+ if (fn_node)
+ fn_start = 0;
+
+ break;
+ }
+
+ free (refname);
+ info_free_references (refs);
+ }
+ }
+
+ /* If we never found the start of a footnotes area, quit now. */
+ if (fn_start == -1)
+ return ((NODE *)NULL);
+
+ /* Make the new node. */
+ result = (NODE *)xmalloc (sizeof (NODE));
+ result->flags = 0;
+
+ /* Get the size of the footnotes appearing within this node. */
+ {
+ char *header;
+ long text_start = fn_start;
+
+ header = (char *)xmalloc
+ (1 + strlen (node->nodename) + strlen (FOOTNOTE_HEADER_FORMAT));
+ sprintf (header, FOOTNOTE_HEADER_FORMAT, node->nodename);
+
+ /* Move the start of the displayed text to right after the first line.
+ This effectively skips either "---- footno...", or "File: foo...". */
+ while (text_start < fn_node->nodelen)
+ if (fn_node->contents[text_start++] == '\n')
+ break;
+
+ result->nodelen = strlen (header) + fn_node->nodelen - text_start;
+
+ /* Set the contents of this node. */
+ result->contents = (char *)xmalloc (1 + result->nodelen);
+ sprintf (result->contents, "%s", header);
+ memcpy (result->contents + strlen (header),
+ fn_node->contents + text_start, fn_node->nodelen - text_start);
+
+ name_internal_node (result, footnote_nodename);
+ free (header);
+ }
+
+#if defined (NOTDEF)
+ /* If the footnotes were gleaned from the node that we were called with,
+ shorten the calling node's display length. */
+ if (fn_node == node)
+ narrow_node (node, 0, fn_start);
+#endif /* NOTDEF */
+
+ return (result);
+}
+
+/* Create or delete the footnotes window depending on whether footnotes
+ exist in WINDOW's node or not. Returns FN_FOUND if footnotes were found
+ and displayed. Returns FN_UNFOUND if there were no footnotes found
+ in WINDOW's node. Returns FN_UNABLE if there were footnotes, but the
+ window to show them couldn't be made. */
+int
+info_get_or_remove_footnotes (window)
+ WINDOW *window;
+{
+ WINDOW *fn_win;
+ NODE *new_footnotes;
+
+ fn_win = find_footnotes_window ();
+
+ /* If we are in the footnotes window, change nothing. */
+ if (fn_win == window)
+ return (FN_FOUND);
+
+ /* Try to find footnotes for this window's node. */
+ new_footnotes = make_footnotes_node (window->node);
+
+ /* If there was a window showing footnotes, and there are no footnotes
+ for the current window, delete the old footnote window. */
+ if (fn_win && !new_footnotes)
+ {
+ if (windows->next)
+ info_delete_window_internal (fn_win);
+ }
+
+ /* If there are footnotes for this window's node, but no window around
+ showing footnotes, try to make a new window. */
+ if (new_footnotes && !fn_win)
+ {
+ WINDOW *old_active;
+ WINDOW *last, *win;
+
+ /* Always make this window be the last one appearing in the list. Find
+ the last window in the chain. */
+ for (win = windows, last = windows; win; last = win, win = win->next);
+
+ /* Try to split this window, and make the split window the one to
+ contain the footnotes. */
+ old_active = active_window;
+ active_window = last;
+ fn_win = window_make_window (new_footnotes);
+ active_window = old_active;
+
+ if (!fn_win)
+ {
+ free (new_footnotes->contents);
+ free (new_footnotes);
+
+ /* If we are hacking automatic footnotes, and there are footnotes
+ but we couldn't display them, print a message to that effect. */
+ if (auto_footnotes_p)
+ inform_in_echo_area ("Footnotes could not be displayed");
+ return (FN_UNABLE);
+ }
+ }
+
+ /* If there are footnotes, and there is a window to display them,
+ make that window be the number of lines appearing in the footnotes. */
+ if (new_footnotes && fn_win)
+ {
+ window_set_node_of_window (fn_win, new_footnotes);
+
+ window_change_window_height
+ (fn_win, fn_win->line_count - fn_win->height);
+
+ remember_window_and_node (fn_win, new_footnotes);
+ add_gcable_pointer (new_footnotes->contents);
+ }
+
+ if (!new_footnotes)
+ return (FN_UNFOUND);
+ else
+ return (FN_FOUND);
+}
+
+/* Show the footnotes associated with this node in another window. */
+DECLARE_INFO_COMMAND (info_show_footnotes,
+ "Show the footnotes associated with this node in another window")
+{
+ int result;
+
+ /* A negative argument means just make the window go away. */
+ if (count < 0)
+ {
+ WINDOW *fn_win = find_footnotes_window ();
+
+ /* If there is an old footnotes window, and it isn't the only window
+ on the screen, delete it. */
+ if (fn_win && windows->next)
+ info_delete_window_internal (fn_win);
+ }
+ else
+ {
+ int result;
+
+ result = info_get_or_remove_footnotes (window);
+
+ switch (result)
+ {
+ case FN_UNFOUND:
+ info_error (NO_FOOT_NODE);
+ break;
+
+ case FN_UNABLE:
+ info_error (WIN_TOO_SMALL);
+ break;
+ }
+ }
+}
diff --git a/texinfo/info/footnotes.h b/texinfo/info/footnotes.h
new file mode 100644
index 00000000000..89b1b3578e6
--- /dev/null
+++ b/texinfo/info/footnotes.h
@@ -0,0 +1,46 @@
+/* footnotes.h -- Some functions for manipulating footnotes. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_FOOTNOTES_H_)
+#define _FOOTNOTES_H_
+
+/* Magic string which indicates following text is footnotes. */
+#define FOOTNOTE_LABEL "---------- Footnotes ----------"
+
+#define FN_FOUND 0
+#define FN_UNFOUND 1
+#define FN_UNABLE 2
+
+
+/* Create or delete the footnotes window depending on whether footnotes
+ exist in WINDOW's node or not. Returns FN_FOUND if footnotes were found
+ and displayed. Returns FN_UNFOUND if there were no footnotes found
+ in WINDOW's node. Returns FN_UNABLE if there were footnotes, but the
+ window to show them couldn't be made. */
+extern int info_get_or_remove_footnotes ();
+
+/* Non-zero means attempt to show footnotes when displaying a new window. */
+extern int auto_footnotes_p;
+
+#endif /* !_FOOTNOTES_H_ */
+
diff --git a/texinfo/info/gc.c b/texinfo/info/gc.c
new file mode 100644
index 00000000000..3b9b0907f51
--- /dev/null
+++ b/texinfo/info/gc.c
@@ -0,0 +1,95 @@
+/* gc.c -- Functions to remember and garbage collect unused node contents. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+
+/* Array of pointers to the contents of gc-able nodes. A pointer on this
+ list can be garbage collected when no info window contains a node whose
+ contents member match the pointer. */
+static char **gcable_pointers = (char **)NULL;
+static int gcable_pointers_index = 0;
+static int gcable_pointers_slots = 0;
+
+/* Add POINTER to the list of garbage collectible pointers. A pointer
+ is not actually garbage collected until no info window contains a node
+ whose contents member is equal to the pointer. */
+void
+add_gcable_pointer (pointer)
+ char *pointer;
+{
+ gc_pointers ();
+ add_pointer_to_array (pointer, gcable_pointers_index, gcable_pointers,
+ gcable_pointers_slots, 10, char *);
+}
+
+/* Grovel the list of info windows and gc-able pointers finding those
+ node->contents which are collectible, and free them. */
+void
+gc_pointers ()
+{
+ register int i, j, k;
+ INFO_WINDOW *iw;
+ char **new = (char **)NULL;
+ int new_index = 0;
+ int new_slots = 0;
+
+ if (!info_windows || !gcable_pointers_index)
+ return;
+
+ for (i = 0; iw = info_windows[i]; i++)
+ {
+ for (j = 0; j < iw->nodes_index; j++)
+ {
+ NODE *node = iw->nodes[j];
+
+ /* If this node->contents appears in our list of gcable_pointers,
+ it is not gc-able, so save it. */
+ for (k = 0; k < gcable_pointers_index; k++)
+ if (gcable_pointers[k] == node->contents)
+ {
+ add_pointer_to_array
+ (node->contents, new_index, new, new_slots, 10, char *);
+ break;
+ }
+ }
+ }
+
+ /* We have gathered all of the pointers which need to be saved. Free any
+ of the original pointers which do not appear in the new list. */
+ for (i = 0; i < gcable_pointers_index; i++)
+ {
+ for (j = 0; j < new_index; j++)
+ if (gcable_pointers[i] == new[j])
+ break;
+
+ /* If we got all the way through the new list, then the old pointer
+ can be garbage collected. */
+ if (new && !new[j])
+ free (gcable_pointers[i]);
+ }
+
+ free (gcable_pointers);
+ gcable_pointers = new;
+ gcable_pointers_slots = new_slots;
+ gcable_pointers_index = new_index;
+}
diff --git a/texinfo/info/gc.h b/texinfo/info/gc.h
new file mode 100644
index 00000000000..876062ad249
--- /dev/null
+++ b/texinfo/info/gc.h
@@ -0,0 +1,36 @@
+/* gc.h -- Functions for garbage collecting unused node contents. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_GC_H_)
+#define _GC_H_
+
+/* Add POINTER to the list of garbage collectible pointers. A pointer
+ is not actually garbage collected until no info window contains a node
+ whose contents member is equal to the pointer. */
+extern void add_gcable_pointer ();
+
+/* Grovel the list of info windows and gc-able pointers finding those
+ node->contents which are collectible, and free them. */
+extern void gc_pointers ();
+
+#endif /* !_GC_H_ */
diff --git a/texinfo/info/general.h b/texinfo/info/general.h
new file mode 100644
index 00000000000..4b97dc8d8da
--- /dev/null
+++ b/texinfo/info/general.h
@@ -0,0 +1,94 @@
+/* general.h -- Some generally useful defines. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_GENERAL_H_)
+#define _GENERAL_H_
+
+extern void *xmalloc (), *xrealloc ();
+
+#if defined (HAVE_UNISTD_H)
+# include <unistd.h>
+#endif /* HAVE_UNISTD_H */
+
+#if defined (HAVE_STRING_H)
+# include <string.h>
+#else
+# include <strings.h>
+#endif /* !HAVE_STRING_H */
+
+#include "clib.h"
+
+#define info_toupper(x) (islower (x) ? toupper (x) : x)
+#define info_tolower(x) (isupper (x) ? tolower (x) : x)
+
+#if !defined (whitespace)
+# define whitespace(c) ((c == ' ') || (c == '\t'))
+#endif /* !whitespace */
+
+#if !defined (whitespace_or_newline)
+# define whitespace_or_newline(c) (whitespace (c) || (c == '\n'))
+#endif /* !whitespace_or_newline */
+
+#if !defined (__FUNCTION_DEF)
+# define __FUNCTION_DEF
+typedef int Function ();
+typedef void VFunction ();
+typedef char *CFunction ();
+#endif /* _FUNCTION_DEF */
+
+/* Add POINTER to the list of pointers found in ARRAY. SLOTS is the number
+ of slots that have already been allocated. INDEX is the index into the
+ array where POINTER should be added. GROW is the number of slots to grow
+ ARRAY by, in the case that it needs growing. TYPE is a cast of the type
+ of object stored in ARRAY (e.g., NODE_ENTRY *. */
+#define add_pointer_to_array(pointer, idx, array, slots, grow, type) \
+ do { \
+ if (idx + 2 >= slots) \
+ array = (type *)(xrealloc (array, (slots += grow) * sizeof (type))); \
+ array[idx++] = (type)pointer; \
+ array[idx] = (type)NULL; \
+ } while (0)
+
+#define maybe_free(x) do { if (x) free (x); } while (0)
+
+#if !defined (zero_mem) && defined (HAVE_MEMSET)
+# define zero_mem(mem, length) memset (mem, 0, length)
+#endif /* !zero_mem && HAVE_MEMSET */
+
+#if !defined (zero_mem) && defined (HAVE_BZERO)
+# define zero_mem(mem, length) bzero (mem, length)
+#endif /* !zero_mem && HAVE_BZERO */
+
+#if !defined (zero_mem)
+# define zero_mem(mem, length) \
+ do { \
+ register int zi; \
+ register unsigned char *place; \
+ \
+ place = (unsigned char *)mem; \
+ for (zi = 0; zi < length; zi++) \
+ place[zi] = 0; \
+ } while (0)
+#endif /* !zero_mem */
+
+#endif /* !_GENERAL_H_ */
diff --git a/texinfo/info/indices.c b/texinfo/info/indices.c
new file mode 100644
index 00000000000..6848884288b
--- /dev/null
+++ b/texinfo/info/indices.c
@@ -0,0 +1,667 @@
+/* indices.c -- Commands for dealing with an Info file Index. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+#include "indices.h"
+
+/* User-visible variable controls the output of info-index-next. */
+int show_index_match = 1;
+
+/* In the Info sense, an index is a menu. This variable holds the last
+ parsed index. */
+static REFERENCE **index_index = (REFERENCE **)NULL;
+
+/* The offset of the most recently selected index element. */
+static int index_offset = 0;
+
+/* Variable which holds the last string searched for. */
+static char *index_search = (char *)NULL;
+
+/* A couple of "globals" describing where the initial index was found. */
+static char *initial_index_filename = (char *)NULL;
+static char *initial_index_nodename = (char *)NULL;
+
+/* A structure associating index names with index offset ranges. */
+typedef struct {
+ char *name; /* The nodename of this index. */
+ int first; /* The index in our list of the first entry. */
+ int last; /* The index in our list of the last entry. */
+} INDEX_NAME_ASSOC;
+
+/* An array associating index nodenames with index offset ranges. */
+static INDEX_NAME_ASSOC **index_nodenames = (INDEX_NAME_ASSOC **)NULL;
+static int index_nodenames_index = 0;
+static int index_nodenames_slots = 0;
+
+/* Add the name of NODE, and the range of the associated index elements
+ (passed in ARRAY) to index_nodenames. */
+static void
+add_index_to_index_nodenames (array, node)
+ REFERENCE **array;
+ NODE *node;
+{
+ register int i, last;
+ INDEX_NAME_ASSOC *assoc;
+
+ for (last = 0; array[last]; last++);
+ assoc = (INDEX_NAME_ASSOC *)xmalloc (sizeof (INDEX_NAME_ASSOC));
+ assoc->name = strdup (node->nodename);
+
+ if (!index_nodenames_index)
+ {
+ assoc->first = 0;
+ assoc->last = last;
+ }
+ else
+ {
+ for (i = 0; index_nodenames[i + 1]; i++);
+ assoc->first = 1 + index_nodenames[i]->last;
+ assoc->last = assoc->first + last;
+ }
+ add_pointer_to_array
+ (assoc, index_nodenames_index, index_nodenames, index_nodenames_slots,
+ 10, INDEX_NAME_ASSOC *);
+}
+
+/* Find and return the indices of WINDOW's file. The indices are defined
+ as the first node in the file containing the word "Index" and any
+ immediately following nodes whose names also contain "Index". All such
+ indices are concatenated and the result returned. If WINDOW's info file
+ doesn't have any indices, a NULL pointer is returned. */
+REFERENCE **
+info_indices_of_window (window)
+ WINDOW *window;
+{
+ FILE_BUFFER *fb;
+
+ fb = file_buffer_of_window (window);
+
+ return (info_indices_of_file_buffer (fb));
+}
+
+REFERENCE **
+info_indices_of_file_buffer (file_buffer)
+ FILE_BUFFER *file_buffer;
+{
+ register int i;
+ REFERENCE **result = (REFERENCE **)NULL;
+
+ /* No file buffer, no indices. */
+ if (!file_buffer)
+ return ((REFERENCE **)NULL);
+
+ /* Reset globals describing where the index was found. */
+ maybe_free (initial_index_filename);
+ maybe_free (initial_index_nodename);
+ initial_index_filename = (char *)NULL;
+ initial_index_nodename = (char *)NULL;
+
+ if (index_nodenames)
+ {
+ for (i = 0; index_nodenames[i]; i++)
+ {
+ free (index_nodenames[i]->name);
+ free (index_nodenames[i]);
+ }
+
+ index_nodenames_index = 0;
+ index_nodenames[0] = (INDEX_NAME_ASSOC *)NULL;
+ }
+
+ /* Grovel the names of the nodes found in this file. */
+ if (file_buffer->tags)
+ {
+ TAG *tag;
+
+ for (i = 0; tag = file_buffer->tags[i]; i++)
+ {
+ if (string_in_line ("Index", tag->nodename) != -1)
+ {
+ NODE *node;
+ REFERENCE **menu;
+
+ /* Found one. Get its menu. */
+ node = info_get_node (tag->filename, tag->nodename);
+ if (!node)
+ continue;
+
+ /* Remember the filename and nodename of this index. */
+ initial_index_filename = strdup (file_buffer->filename);
+ initial_index_nodename = strdup (tag->nodename);
+
+ menu = info_menu_of_node (node);
+
+ /* If we have a menu, add this index's nodename and range
+ to our list of index_nodenames. */
+ if (menu)
+ {
+ add_index_to_index_nodenames (menu, node);
+
+ /* Concatenate the references found so far. */
+ result = info_concatenate_references (result, menu);
+ }
+ free (node);
+ }
+ }
+ }
+
+ /* If there is a result, clean it up so that every entry has a filename. */
+ for (i = 0; result && result[i]; i++)
+ if (!result[i]->filename)
+ result[i]->filename = strdup (file_buffer->filename);
+
+ return (result);
+}
+
+DECLARE_INFO_COMMAND (info_index_search,
+ "Look up a string in the index for this file")
+{
+ FILE_BUFFER *fb;
+ char *line;
+
+ /* Reset the index offset, since this is not the info-index-next command. */
+ index_offset = 0;
+
+ /* The user is selecting a new search string, so flush the old one. */
+ maybe_free (index_search);
+ index_search = (char *)NULL;
+
+ /* If this window's file is not the same as the one that we last built an
+ index for, build and remember an index now. */
+ fb = file_buffer_of_window (window);
+ if (!initial_index_filename ||
+ (strcmp (initial_index_filename, fb->filename) != 0))
+ {
+ info_free_references (index_index);
+ window_message_in_echo_area ("Finding index entries...");
+ index_index = info_indices_of_file_buffer (fb);
+ }
+
+ /* If there is no index, quit now. */
+ if (!index_index)
+ {
+ info_error ("No indices found.");
+ return;
+ }
+
+ /* Okay, there is an index. Let the user select one of the members of it. */
+ line =
+ info_read_maybe_completing (window, "Index entry: ", index_index);
+
+ window = active_window;
+
+ /* User aborted? */
+ if (!line)
+ {
+ info_abort_key (active_window, 1, 0);
+ return;
+ }
+
+ /* Empty line means move to the Index node. */
+ if (!*line)
+ {
+ free (line);
+
+ if (initial_index_filename && initial_index_nodename)
+ {
+ NODE *node;
+
+ node =
+ info_get_node (initial_index_filename, initial_index_nodename);
+ set_remembered_pagetop_and_point (window);
+ window_set_node_of_window (window, node);
+ remember_window_and_node (window, node);
+ window_clear_echo_area ();
+ return;
+ }
+ }
+
+ /* The user typed either a completed index label, or a partial string.
+ Find an exact match, or, failing that, the first index entry containing
+ the partial string. So, we just call info_next_index_match () with minor
+ manipulation of INDEX_OFFSET. */
+ {
+ int old_offset;
+
+ /* Start the search right after/before this index. */
+ if (count < 0)
+ {
+ register int i;
+ for (i = 0; index_index[i]; i++);
+ index_offset = i;
+ }
+ else
+ index_offset = -1;
+
+ old_offset = index_offset;
+
+ /* The "last" string searched for is this one. */
+ index_search = line;
+
+ /* Find it, or error. */
+ info_next_index_match (window, count, 0);
+
+ /* If the search failed, return the index offset to where it belongs. */
+ if (index_offset == old_offset)
+ index_offset = 0;
+ }
+}
+
+DECLARE_INFO_COMMAND (info_next_index_match,
+ "Go to the next matching index item from the last `\\[index-search]' command")
+{
+ register int i;
+ int partial, dir;
+ NODE *node;
+
+ /* If there is no previous search string, the user hasn't built an index
+ yet. */
+ if (!index_search)
+ {
+ info_error ("No previous index search string.");
+ return;
+ }
+
+ /* If there is no index, that is an error. */
+ if (!index_index)
+ {
+ info_error ("No index entries.");
+ return;
+ }
+
+ /* The direction of this search is controlled by the value of the
+ numeric argument. */
+ if (count < 0)
+ dir = -1;
+ else
+ dir = 1;
+
+ /* Search for the next occurence of index_search. First try to find
+ an exact match. */
+ partial = 0;
+
+ for (i = index_offset + dir; (i > -1) && (index_index[i]); i += dir)
+ if (strcmp (index_search, index_index[i]->label) == 0)
+ break;
+
+ /* If that failed, look for the next substring match. */
+ if ((i < 0) || (!index_index[i]))
+ {
+ for (i = index_offset + dir; (i > -1) && (index_index[i]); i += dir)
+ if (string_in_line (index_search, index_index[i]->label) != -1)
+ break;
+
+ if ((i > -1) && (index_index[i]))
+ partial = string_in_line (index_search, index_index[i]->label);
+ }
+
+ /* If that failed, print an error. */
+ if ((i < 0) || (!index_index[i]))
+ {
+ info_error ("No %sindex entries containing \"%s\".",
+ index_offset > 0 ? "more " : "", index_search);
+ return;
+ }
+
+ /* Okay, we found the next one. Move the offset to the current entry. */
+ index_offset = i;
+
+ /* Report to the user on what we have found. */
+ {
+ register int j;
+ char *name = "CAN'T SEE THIS";
+ char *match;
+
+ for (j = 0; index_nodenames[j]; j++)
+ {
+ if ((i >= index_nodenames[j]->first) &&
+ (i <= index_nodenames[j]->last))
+ {
+ name = index_nodenames[j]->name;
+ break;
+ }
+ }
+
+ /* If we had a partial match, indicate to the user which part of the
+ string matched. */
+ match = strdup (index_index[i]->label);
+
+ if (partial && show_index_match)
+ {
+ int j, ls, start, upper;
+
+ ls = strlen (index_search);
+ start = partial - ls;
+ upper = isupper (match[start]) ? 1 : 0;
+
+ for (j = 0; j < ls; j++)
+ if (upper)
+ match[j + start] = info_tolower (match[j + start]);
+ else
+ match[j + start] = info_toupper (match[j + start]);
+ }
+
+ {
+ char *format;
+
+ format = replace_in_documentation
+ ("Found \"%s\" in %s. (`\\[next-index-match]' tries to find next.)");
+
+ window_message_in_echo_area (format, match, name);
+ }
+
+ free (match);
+ }
+
+ /* Select the node corresponding to this index entry. */
+ node = info_get_node (index_index[i]->filename, index_index[i]->nodename);
+
+ if (!node)
+ {
+ info_error (CANT_FILE_NODE,
+ index_index[i]->filename, index_index[i]->nodename);
+ return;
+ }
+
+ set_remembered_pagetop_and_point (window);
+ window_set_node_of_window (window, node);
+ remember_window_and_node (window, node);
+
+
+ /* Try to find an occurence of LABEL in this node. */
+ {
+ long start, loc;
+
+ start = window->line_starts[1] - window->node->contents;
+ loc = info_target_search_node (node, index_index[i]->label, start);
+
+ if (loc != -1)
+ {
+ window->point = loc;
+ window_adjust_pagetop (window);
+ }
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Info APROPOS: Search every known index. */
+/* */
+/* **************************************************************** */
+
+/* For every menu item in DIR, search the indices of that file for
+ SEARCH_STRING. */
+REFERENCE **
+apropos_in_all_indices (search_string, inform)
+ char *search_string;
+ int inform;
+{
+ register int i, dir_index;
+ REFERENCE **all_indices = (REFERENCE **)NULL;
+ REFERENCE **dir_menu = (REFERENCE **)NULL;
+ NODE *dir_node;
+ int printed = 0;
+
+ dir_node = info_get_node ("dir", "Top");
+ if (dir_node)
+ dir_menu = info_menu_of_node (dir_node);
+
+ if (!dir_menu)
+ return;
+
+ /* For every menu item in DIR, get the associated node's file buffer and
+ read the indices of that file buffer. Gather all of the indices into
+ one large one. */
+ for (dir_index = 0; dir_menu[dir_index]; dir_index++)
+ {
+ REFERENCE **this_index, *this_item;
+ NODE *this_node;
+ FILE_BUFFER *this_fb;
+
+ this_item = dir_menu[dir_index];
+
+ if (!this_item->filename)
+ {
+ if (dir_node->parent)
+ this_item->filename = strdup (dir_node->parent);
+ else
+ this_item->filename = strdup (dir_node->filename);
+ }
+
+ /* Find this node. If we cannot find it, try using the label of the
+ entry as a file (i.e., "(LABEL)Top"). */
+ this_node = info_get_node (this_item->filename, this_item->nodename);
+
+ if (!this_node && this_item->nodename &&
+ (strcmp (this_item->label, this_item->nodename) == 0))
+ this_node = info_get_node (this_item->label, "Top");
+
+ if (!this_node)
+ continue;
+
+ /* Get the file buffer associated with this node. */
+ {
+ char *files_name;
+
+ files_name = this_node->parent;
+ if (!files_name)
+ files_name = this_node->filename;
+
+ this_fb = info_find_file (files_name);
+
+ if (this_fb && inform)
+ message_in_echo_area ("Scanning indices of \"%s\"...", files_name);
+
+ this_index = info_indices_of_file_buffer (this_fb);
+ free (this_node);
+
+ if (this_fb && inform)
+ unmessage_in_echo_area ();
+ }
+
+ if (this_index)
+ {
+ /* Remember the filename which contains this set of references. */
+ for (i = 0; this_index && this_index[i]; i++)
+ if (!this_index[i]->filename)
+ this_index[i]->filename = strdup (this_fb->filename);
+
+ /* Concatenate with the other indices. */
+ all_indices = info_concatenate_references (all_indices, this_index);
+ }
+ }
+
+ info_free_references (dir_menu);
+
+ /* Build a list of the references which contain SEARCH_STRING. */
+ if (all_indices)
+ {
+ REFERENCE *entry, **apropos_list = (REFERENCE **)NULL;
+ int apropos_list_index = 0;
+ int apropos_list_slots = 0;
+
+ for (i = 0; (entry = all_indices[i]); i++)
+ {
+ if (string_in_line (search_string, entry->label) != -1)
+ {
+ add_pointer_to_array
+ (entry, apropos_list_index, apropos_list, apropos_list_slots,
+ 100, REFERENCE *);
+ }
+ else
+ {
+ maybe_free (entry->label);
+ maybe_free (entry->filename);
+ maybe_free (entry->nodename);
+ free (entry);
+ }
+ }
+
+ free (all_indices);
+ all_indices = apropos_list;
+ }
+ return (all_indices);
+}
+
+#define APROPOS_NONE \
+ "No available info files reference \"%s\" in their indices."
+
+void
+info_apropos (string)
+ char *string;
+{
+ REFERENCE **apropos_list;
+
+ apropos_list = apropos_in_all_indices (string, 0);
+
+ if (!apropos_list)
+ {
+ info_error (APROPOS_NONE, string);
+ }
+ else
+ {
+ register int i;
+ REFERENCE *entry;
+
+ for (i = 0; (entry = apropos_list[i]); i++)
+ fprintf (stderr, "\"(%s)%s\" -- %s\n",
+ entry->filename, entry->nodename, entry->label);
+ }
+ info_free_references (apropos_list);
+}
+
+static char *apropos_list_nodename = "*Apropos*";
+
+DECLARE_INFO_COMMAND (info_index_apropos,
+ "Grovel all known info file's indices for a string and build a menu")
+{
+ char *line;
+
+ line = info_read_in_echo_area (window, "Index apropos: ");
+
+ window = active_window;
+
+ /* User aborted? */
+ if (!line)
+ {
+ info_abort_key (window, 1, 1);
+ return;
+ }
+
+ /* User typed something? */
+ if (*line)
+ {
+ REFERENCE **apropos_list;
+ NODE *apropos_node;
+
+ apropos_list = apropos_in_all_indices (line, 1);
+
+ if (!apropos_list)
+ {
+ info_error (APROPOS_NONE, line);
+ }
+ else
+ {
+ register int i;
+ char *line_buffer;
+
+ initialize_message_buffer ();
+ printf_to_message_buffer
+ ("\n* Menu: Nodes whoses indices contain \"%s\":\n", line);
+ line_buffer = (char *)xmalloc (500);
+
+ for (i = 0; apropos_list[i]; i++)
+ {
+ int len;
+ sprintf (line_buffer, "* (%s)%s::",
+ apropos_list[i]->filename, apropos_list[i]->nodename);
+ len = pad_to (36, line_buffer);
+ sprintf (line_buffer + len, "%s", apropos_list[i]->label);
+ printf_to_message_buffer ("%s\n", line_buffer);
+ }
+ free (line_buffer);
+ }
+
+ apropos_node = message_buffer_to_node ();
+ add_gcable_pointer (apropos_node->contents);
+ name_internal_node (apropos_node, apropos_list_nodename);
+
+ /* Even though this is an internal node, we don't want the window
+ system to treat it specially. So we turn off the internalness
+ of it here. */
+ apropos_node->flags &= ~N_IsInternal;
+
+ /* Find/Create a window to contain this node. */
+ {
+ WINDOW *new;
+ NODE *node;
+
+ set_remembered_pagetop_and_point (window);
+
+ /* If a window is visible and showing an apropos list already,
+ re-use it. */
+ for (new = windows; new; new = new->next)
+ {
+ node = new->node;
+
+ if (internal_info_node_p (node) &&
+ (strcmp (node->nodename, apropos_list_nodename) == 0))
+ break;
+ }
+
+ /* If we couldn't find an existing window, try to use the next window
+ in the chain. */
+ if (!new && window->next)
+ new = window->next;
+
+ /* If we still don't have a window, make a new one to contain
+ the list. */
+ if (!new)
+ {
+ WINDOW *old_active;
+
+ old_active = active_window;
+ active_window = window;
+ new = window_make_window ((NODE *)NULL);
+ active_window = old_active;
+ }
+
+ /* If we couldn't make a new window, use this one. */
+ if (!new)
+ new = window;
+
+ /* Lines do not wrap in this window. */
+ new->flags |= W_NoWrap;
+
+ window_set_node_of_window (new, apropos_node);
+ remember_window_and_node (new, apropos_node);
+ active_window = new;
+ }
+ info_free_references (apropos_list);
+ }
+ free (line);
+
+ if (!info_error_was_printed)
+ window_clear_echo_area ();
+}
+
diff --git a/texinfo/info/indices.h b/texinfo/info/indices.h
new file mode 100644
index 00000000000..265b1472ba8
--- /dev/null
+++ b/texinfo/info/indices.h
@@ -0,0 +1,39 @@
+/* indices.h -- Functions defined in indices.c. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_INDICES_H_)
+#define _INDICES_H_
+
+/* User-visible variable controls the output of info-index-next. */
+extern int show_index_match;
+
+extern REFERENCE **info_indices_of_window (), **info_indices_of_file_buffer ();
+extern void info_apropos ();
+
+/* For every menu item in DIR, search the indices of that file for STRING. */
+REFERENCE **apropos_in_all_indices ();
+
+/* User visible functions declared in indices.c. */
+extern void info_index_search (), info_next_index_match ();
+
+#endif /* !_INDICES_H_ */
diff --git a/texinfo/info/info-stnd.texi b/texinfo/info/info-stnd.texi
new file mode 100644
index 00000000000..1e2fccb1d8e
--- /dev/null
+++ b/texinfo/info/info-stnd.texi
@@ -0,0 +1,1365 @@
+\input texinfo @c -*-texinfo-*-
+@comment %**start of header
+@setfilename info-stnd.info
+@settitle GNU Info
+@set InfoProgVer 2.11
+@paragraphindent none
+@footnotestyle end
+@synindex vr cp
+@synindex fn cp
+@synindex ky cp
+@comment %**end of header
+@comment $Id: info-stnd.texi,v 1.1 1997/08/21 22:58:01 jason Exp $
+
+@dircategory Texinfo documentation system
+@direntry
+* info program: (info-stnd). Standalone Info-reading program.
+@end direntry
+
+@ifinfo
+This file documents GNU Info, a program for viewing the on-line formatted
+versions of Texinfo files. This documentation is different from the
+documentation for the Info reader that is part of GNU Emacs. If you do
+not know how to use Info, but have a working Info reader, you should
+read that documentation first.
+
+Copyright @copyright{} 1992, 93, 96 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries a copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+@end ignore
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+sections entitled ``Copying'' and ``GNU General Public License'' are
+included exactly as in the original, and provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+approved by the Free Software Foundation.
+@end ifinfo
+
+@titlepage
+@title GNU Info User's Guide
+@subtitle For GNU Info version @value{InfoProgVer}
+@author Brian J. Fox (bfox@@ai.mit.edu)
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1992, 1993 Free Software Foundation
+
+Permission is granted to make and distribute verbatim copies of this
+manual provided the copyright notice and this permission notice are
+preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided also that the
+sections entitled ``Copying'' and ``GNU General Public License'' are
+included exactly as in the original, and provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation
+approved by the Free Software Foundation.
+@end titlepage
+
+@ifinfo
+@node Top, What is Info, (dir), (dir)
+@top The GNU Info Program
+
+This file documents GNU Info, a program for viewing the on-line
+formatted versions of Texinfo files, version @value{InfoProgVer}. This
+documentation is different from the documentation for the Info reader
+that is part of GNU Emacs.
+@end ifinfo
+
+@menu
+* What is Info::
+* Options:: Options you can pass on the command line.
+* Cursor Commands:: Commands which move the cursor within a node.
+* Scrolling Commands:: Commands for moving the node around
+ in a window.
+* Node Commands:: Commands for selecting a new node.
+* Searching Commands:: Commands for searching an Info file.
+* Xref Commands:: Commands for selecting cross references.
+* Window Commands:: Commands which manipulate multiple windows.
+* Printing Nodes:: How to print out the contents of a node.
+* Miscellaneous Commands:: A few commands that defy categories.
+* Variables:: How to change the default behavior of Info.
+* GNU Info Global Index:: Global index containing keystrokes,
+ command names, variable names,
+ and general concepts.
+@end menu
+
+@node What is Info, Options, Top, Top
+@chapter What is Info?
+
+@iftex
+This file documents GNU Info, a program for viewing the on-line formatted
+versions of Texinfo files, version @value{InfoProgVer}.
+@end iftex
+
+@dfn{Info} is a program which is used to view Info files on an ASCII
+terminal. @dfn{Info files} are the result of processing Texinfo files
+with the program @code{makeinfo} or with one of the Emacs commands, such
+as @code{M-x texinfo-format-buffer}. Texinfo itself is a documentation
+system that uses a single source file to produce both on-line
+information and printed output. You can typeset and print the
+files that you read in Info.@refill
+
+@node Options, Cursor Commands, What is Info, Top
+@chapter Command Line Options
+@cindex command line options
+@cindex arguments, command line
+
+GNU Info accepts several options to control the initial node being
+viewed, and to specify which directories to search for Info files. Here
+is a template showing an invocation of GNU Info from the shell:
+
+@example
+info [--@var{option-name} @var{option-value}] @var{menu-item}@dots{}
+@end example
+
+The following @var{option-names} are available when invoking Info from
+the shell:
+
+@table @code
+@cindex directory path
+@item --directory @var{directory-path}
+@itemx -d @var{directory-path}
+Add @var{directory-path} to the list of directory paths searched when
+Info needs to find a file. You may issue @code{--directory} multiple
+times; once for each directory which contains Info files.
+Alternatively, you may specify a value for the environment variable
+@code{INFOPATH}; if @code{--directory} is not given, the value of
+@code{INFOPATH} is used. The value of @code{INFOPATH} is a colon
+separated list of directory names. If you do not supply @code{INFOPATH}
+or @code{--directory-path}, Info uses a default path.
+
+@item --file @var{filename}
+@itemx -f @var{filename}
+@cindex Info file, selecting
+Specify a particular Info file to visit. By default, Info visits
+the file @code{dir}; if you use this option, Info will start with
+@code{(@var{filename})Top} as the first file and node.
+
+@item --node @var{nodename}
+@itemx -n @var{nodename}
+@cindex node, selecting
+Specify a particular node to visit in the initial file that Info
+loads. This is especially useful in conjunction with
+@code{--file}@footnote{Of course, you can specify both the file and node
+in a @code{--node} command; but don't forget to escape the open and
+close parentheses from the shell as in: @code{info --node
+"(emacs)Buffers"}}. You may specify @code{--node} multiple times; for
+an interactive Info, each @var{nodename} is visited in its own window,
+for a non-interactive Info (such as when @code{--output} is given) each
+@var{nodename} is processed sequentially.
+
+@item --output @var{filename}
+@itemx -o @var{filename}
+@cindex file, outputting to
+@cindex outputting to a file
+Specify @var{filename} as the name of a file to which to direct output.
+Each node that Info visits will be output to @var{filename} instead of
+interactively viewed. A value of @code{-} for @var{filename} specifies
+the standard output.
+
+@item --subnodes
+@cindex @code{--subnodes}, command line option
+This option only has meaning when given in conjunction with
+@code{--output}. It means to recursively output the nodes appearing in
+the menus of each node being output. Menu items which resolve to
+external Info files are not output, and neither are menu items which are
+members of an index. Each node is only output once.
+
+@item --help
+@itemx -h
+Produces a relatively brief description of the available Info options.
+
+@item --version
+@cindex version information
+Prints the version information of Info and exits.
+
+@item @var{menu-item}
+@cindex menu, following
+Info treats its remaining arguments as the names of menu items. The
+first argument is a menu item in the initial node visited, while
+the second argument is a menu item in the first argument's node.
+You can easily move to the node of your choice by specifying the menu
+names which describe the path to that node. For example,
+
+@example
+info emacs buffers
+@end example
+
+@noindent
+first selects the menu item @samp{Emacs} in the node @samp{(dir)Top},
+and then selects the menu item @samp{Buffers} in the node
+@samp{(emacs)Top}.
+@end table
+
+@node Cursor Commands, Scrolling Commands, Options, Top
+@chapter Moving the Cursor
+@cindex cursor, moving
+
+Many people find that reading screens of text page by page is made
+easier when one is able to indicate particular pieces of text with some
+kind of pointing device. Since this is the case, GNU Info (both the
+Emacs and standalone versions) have several commands which allow you to
+move the cursor about the screen. The notation used in this manual to
+describe keystrokes is identical to the notation used within the Emacs
+manual, and the GNU Readline manual. @xref{Characters, , Character
+Conventions, emacs, the GNU Emacs Manual}, if you are unfamiliar with the
+notation.
+
+The following table lists the basic cursor movement commands in Info.
+Each entry consists of the key sequence you should type to execute the
+cursor movement, the @code{M-x}@footnote{@code{M-x} is also a command; it
+invokes @code{execute-extended-command}. @xref{M-x, , Executing an
+extended command, emacs, the GNU Emacs Manual}, for more detailed
+information.} command name (displayed in parentheses), and a short
+description of what the command does. All of the cursor motion commands
+can take an @dfn{numeric} argument (@pxref{Miscellaneous Commands,
+@code{universal-argument}}), to find out how to supply them. With a
+numeric argument, the motion commands are simply executed that
+many times; for example, a numeric argument of 4 given to
+@code{next-line} causes the cursor to move down 4 lines. With a
+negative numeric argument, the motion is reversed; an argument of -4
+given to the @code{next-line} command would cause the cursor to move
+@emph{up} 4 lines.
+
+@table @asis
+@item @code{C-n} (@code{next-line})
+@kindex C-n
+@findex next-line
+Move the cursor down to the next line.
+
+@item @code{C-p} (@code{prev-line})
+@kindex C-p
+@findex prev-line
+Move the cursor up to the previous line.
+
+@item @code{C-a} (@code{beginning-of-line})
+@kindex C-a, in Info windows
+@findex beginning-of-line
+Move the cursor to the start of the current line.
+
+@item @code{C-e} (@code{end-of-line})
+@kindex C-e, in Info windows
+@findex end-of-line
+Move the cursor to the end of the current line.
+
+@item @code{C-f} (@code{forward-char})
+@kindex C-f, in Info windows
+@findex forward-char
+Move the cursor forward a character.
+
+@item @code{C-b} (@code{backward-char})
+@kindex C-b, in Info windows
+@findex backward-char
+Move the cursor backward a character.
+
+@item @code{M-f} (@code{forward-word})
+@kindex M-f, in Info windows
+@findex forward-word
+Move the cursor forward a word.
+
+@item @code{M-b} (@code{backward-word})
+@kindex M-b, in Info windows
+@findex backward-word
+Move the cursor backward a word.
+
+@item @code{M-<} (@code{beginning-of-node})
+@itemx @code{b}
+@kindex b, in Info windows
+@kindex M-<
+@findex beginning-of-node
+Move the cursor to the start of the current node.
+
+@item @code{M->} (@code{end-of-node})
+@kindex M->
+@findex end-of-node
+Move the cursor to the end of the current node.
+
+@item @code{M-r} (@code{move-to-window-line})
+@kindex M-r
+@findex move-to-window-line
+Move the cursor to a specific line of the window. Without a numeric
+argument, @code{M-r} moves the cursor to the start of the line in the
+center of the window. With a numeric argument of @var{n}, @code{M-r}
+moves the cursor to the start of the @var{n}th line in the window.
+@end table
+
+@node Scrolling Commands, Node Commands, Cursor Commands, Top
+@chapter Moving Text Within a Window
+@cindex scrolling
+
+Sometimes you are looking at a screenful of text, and only part of the
+current paragraph you are reading is visible on the screen. The
+commands detailed in this section are used to shift which part of the
+current node is visible on the screen.
+
+@table @asis
+@item @code{SPC} (@code{scroll-forward})
+@itemx @code{C-v}
+@kindex SPC, in Info windows
+@kindex C-v
+@findex scroll-forward
+Shift the text in this window up. That is, show more of the node which
+is currently below the bottom of the window. With a numeric argument,
+show that many more lines at the bottom of the window; a numeric
+argument of 4 would shift all of the text in the window up 4 lines
+(discarding the top 4 lines), and show you four new lines at the bottom
+of the window. Without a numeric argument, @key{SPC} takes the bottom
+two lines of the window and places them at the top of the window,
+redisplaying almost a completely new screenful of lines.
+
+@item @code{DEL} (@code{scroll-backward})
+@itemx @code{M-v}
+@kindex DEL, in Info windows
+@kindex M-v
+@findex scroll-backward
+Shift the text in this window down. The inverse of
+@code{scroll-forward}.
+@end table
+
+@cindex scrolling through node structure
+The @code{scroll-forward} and @code{scroll-backward} commands can also
+move forward and backward through the node structure of the file. If
+you press @key{SPC} while viewing the end of a node, or @key{DEL} while
+viewing the beginning of a node, what happens is controlled by the
+variable @code{scroll-behavior}. @xref{Variables,
+@code{scroll-behavior}}, for more information.
+
+@table @asis
+@item @code{C-l} (@code{redraw-display})
+@kindex C-l
+@findex redraw-display
+Redraw the display from scratch, or shift the line containing the cursor
+to a specified location. With no numeric argument, @samp{C-l} clears
+the screen, and then redraws its entire contents. Given a numeric
+argument of @var{n}, the line containing the cursor is shifted so that
+it is on the @var{n}th line of the window.
+
+@item @code{C-x w} (@code{toggle-wrap})
+@kindex C-w
+@findex toggle-wrap
+Toggles the state of line wrapping in the current window. Normally,
+lines which are longer than the screen width @dfn{wrap}, i.e., they are
+continued on the next line. Lines which wrap have a @samp{\} appearing
+in the rightmost column of the screen. You can cause such lines to be
+terminated at the rightmost column by changing the state of line
+wrapping in the window with @code{C-x w}. When a line which needs more
+space than one screen width to display is displayed, a @samp{$} appears
+in the rightmost column of the screen, and the remainder of the line is
+invisible.
+@end table
+
+@node Node Commands, Searching Commands, Scrolling Commands, Top
+@chapter Selecting a New Node
+@cindex nodes, selection of
+
+This section details the numerous Info commands which select a new node
+to view in the current window.
+
+The most basic node commands are @samp{n}, @samp{p}, @samp{u}, and
+@samp{l}.
+
+When you are viewing a node, the top line of the node contains some Info
+@dfn{pointers} which describe where the next, previous, and up nodes
+are. Info uses this line to move about the node structure of the file
+when you use the following commands:
+
+@table @asis
+@item @code{n} (@code{next-node})
+@kindex n
+@findex next-node
+Select the `Next' node.
+
+@item @code{p} (@code{prev-node})
+@kindex p
+@findex prev-node
+Select the `Prev' node.
+
+@item @code{u} (@code{up-node})
+@kindex u
+@findex up-node
+Select the `Up' node.
+@end table
+
+You can easily select a node that you have already viewed in this window
+by using the @samp{l} command -- this name stands for "last", and
+actually moves through the list of already visited nodes for this
+window. @samp{l} with a negative numeric argument moves forward through
+the history of nodes for this window, so you can quickly step between
+two adjacent (in viewing history) nodes.
+
+@table @asis
+@item @code{l} (@code{history-node})
+@kindex l
+@findex history-node
+Select the most recently selected node in this window.
+@end table
+
+Two additional commands make it easy to select the most commonly
+selected nodes; they are @samp{t} and @samp{d}.
+
+@table @asis
+@item @code{t} (@code{top-node})
+@kindex t
+@findex top-node
+Select the node @samp{Top} in the current Info file.
+
+@item @code{d} (@code{dir-node})
+@kindex d
+@findex dir-node
+Select the directory node (i.e., the node @samp{(dir)}).
+@end table
+
+Here are some other commands which immediately result in the selection
+of a different node in the current window:
+
+@table @asis
+@item @code{<} (@code{first-node})
+@kindex <
+@findex first-node
+Selects the first node which appears in this file. This node is most
+often @samp{Top}, but it does not have to be.
+
+@item @code{>} (@code{last-node})
+@kindex >
+@findex last-node
+Select the last node which appears in this file.
+
+@item @code{]} (@code{global-next-node})
+@kindex ]
+@findex global-next-node
+Move forward or down through node structure. If the node that you are
+currently viewing has a @samp{Next} pointer, that node is selected.
+Otherwise, if this node has a menu, the first menu item is selected. If
+there is no @samp{Next} and no menu, the same process is tried with the
+@samp{Up} node of this node.
+
+@item @code{[} (@code{global-prev-node})
+@kindex [
+@findex global-prev-node
+Move backward or up through node structure. If the node that you are
+currently viewing has a @samp{Prev} pointer, that node is selected.
+Otherwise, if the node has an @samp{Up} pointer, that node is selected,
+and if it has a menu, the last item in the menu is selected.
+@end table
+
+You can get the same behavior as @code{global-next-node} and
+@code{global-prev-node} while simply scrolling through the file with
+@key{SPC} and @key{DEL}; @xref{Variables, @code{scroll-behavior}}, for
+more information.
+
+@table @asis
+@item @code{g} (@code{goto-node})
+@kindex g
+@findex goto-node
+Read the name of a node and select it. No completion is done while
+reading the node name, since the desired node may reside in a separate
+file. The node must be typed exactly as it appears in the Info file. A
+file name may be included as with any node specification, for example
+
+@example
+@code{g(emacs)Buffers}
+@end example
+
+finds the node @samp{Buffers} in the Info file @file{emacs}.
+
+@item @code{C-x k} (@code{kill-node})
+@kindex C-x k
+@findex kill-node
+Kill a node. The node name is prompted for in the echo area, with a
+default of the current node. @dfn{Killing} a node means that Info tries
+hard to forget about it, removing it from the list of history nodes kept
+for the window where that node is found. Another node is selected in
+the window which contained the killed node.
+
+@item @code{C-x C-f} (@code{view-file})
+@kindex C-x C-f
+@findex view-file
+Read the name of a file and selects the entire file. The command
+@example
+@code{C-x C-f @var{filename}}
+@end example
+is equivalent to typing
+@example
+@code{g(@var{filename})*}
+@end example
+
+@item @code{C-x C-b} (@code{list-visited-nodes})
+@kindex C-x C-b
+@findex list-visited-nodes
+Make a window containing a menu of all of the currently visited nodes.
+This window becomes the selected window, and you may use the standard
+Info commands within it.
+
+@item @code{C-x b} (@code{select-visited-node})
+@kindex C-x b
+@findex select-visited-node
+Select a node which has been previously visited in a visible window.
+This is similar to @samp{C-x C-b} followed by @samp{m}, but no window is
+created.
+@end table
+
+@node Searching Commands, Xref Commands, Node Commands, Top
+@chapter Searching an Info File
+@cindex searching
+
+GNU Info allows you to search for a sequence of characters throughout an
+entire Info file, search through the indices of an Info file, or find
+areas within an Info file which discuss a particular topic.
+
+@table @asis
+@item @code{s} (@code{search})
+@kindex s
+@findex search
+Read a string in the echo area and search for it.
+
+@item @code{C-s} (@code{isearch-forward})
+@kindex C-s
+@findex isearch-forward
+Interactively search forward through the Info file for a string as you
+type it.
+
+@item @code{C-r} (@code{isearch-backward})
+@kindex C-r
+@findex isearch-backward
+Interactively search backward through the Info file for a string as
+you type it.
+
+@item @code{i} (@code{index-search})
+@kindex i
+@findex index-search
+Look up a string in the indices for this Info file, and select a node
+where the found index entry points to.
+
+@item @code{,} (@code{next-index-match})
+@kindex ,
+@findex next-index-match
+Move to the node containing the next matching index item from the last
+@samp{i} command.
+@end table
+
+The most basic searching command is @samp{s} (@code{search}). The
+@samp{s} command prompts you for a string in the echo area, and then
+searches the remainder of the Info file for an occurrence of that string.
+If the string is found, the node containing it is selected, and the
+cursor is left positioned at the start of the found string. Subsequent
+@samp{s} commands show you the default search string within @samp{[} and
+@samp{]}; pressing @key{RET} instead of typing a new string will use the
+default search string.
+
+@dfn{Incremental searching} is similar to basic searching, but the
+string is looked up while you are typing it, instead of waiting until
+the entire search string has been specified.
+
+@node Xref Commands, Window Commands, Searching Commands, Top
+@chapter Selecting Cross References
+
+We have already discussed the @samp{Next}, @samp{Prev}, and @samp{Up}
+pointers which appear at the top of a node. In addition to these
+pointers, a node may contain other pointers which refer you to a
+different node, perhaps in another Info file. Such pointers are called
+@dfn{cross references}, or @dfn{xrefs} for short.
+
+@menu
+* Parts of an Xref:: What a cross reference is made of.
+* Selecting Xrefs:: Commands for selecting menu or note items.
+@end menu
+
+@node Parts of an Xref, Selecting Xrefs, , Xref Commands
+@section Parts of an Xref
+
+Cross references have two major parts: the first part is called the
+@dfn{label}; it is the name that you can use to refer to the cross
+reference, and the second is the @dfn{target}; it is the full name of
+the node that the cross reference points to.
+
+The target is separated from the label by a colon @samp{:}; first the
+label appears, and then the target. For example, in the sample menu
+cross reference below, the single colon separates the label from the
+target.
+
+@example
+* Foo Label: Foo Target. More information about Foo.
+@end example
+
+Note the @samp{.} which ends the name of the target. The @samp{.} is
+not part of the target; it serves only to let Info know where the target
+name ends.
+
+A shorthand way of specifying references allows two adjacent colons to
+stand for a target name which is the same as the label name:
+
+@example
+* Foo Commands:: Commands pertaining to Foo.
+@end example
+
+In the above example, the name of the target is the same as the name of
+the label, in this case @code{Foo Commands}.
+
+You will normally see two types of cross reference while viewing nodes:
+@dfn{menu} references, and @dfn{note} references. Menu references
+appear within a node's menu; they begin with a @samp{*} at the beginning
+of a line, and continue with a label, a target, and a comment which
+describes what the contents of the node pointed to contains.
+
+Note references appear within the body of the node text; they begin with
+@code{*Note}, and continue with a label and a target.
+
+Like @samp{Next}, @samp{Prev}, and @samp{Up} pointers, cross references
+can point to any valid node. They are used to refer you to a place
+where more detailed information can be found on a particular subject.
+Here is a cross reference which points to a node within the Texinfo
+documentation: @xref{xref, , Writing an Xref, texinfo, the Texinfo
+Manual}, for more information on creating your own texinfo cross
+references.
+
+@node Selecting Xrefs, , Parts of an Xref, Xref Commands
+@section Selecting Xrefs
+
+The following table lists the Info commands which operate on menu items.
+
+@table @asis
+@item @code{1} (@code{menu-digit})
+@itemx @code{2} @dots{} @code{9}
+@cindex 1 @dots{} 9, in Info windows
+@kindex 1 @dots{} 9, in Info windows
+@findex menu-digit
+Within an Info window, pressing a single digit, (such as @samp{1}),
+selects that menu item, and places its node in the current window.
+For convenience, there is one exception; pressing @samp{0} selects the
+@emph{last} item in the node's menu.
+
+@item @code{0} (@code{last-menu-item})
+@kindex 0, in Info windows
+@findex last-menu-item
+Select the last item in the current node's menu.
+
+@item @code{m} (@code{menu-item})
+@kindex m
+@findex menu-item
+Reads the name of a menu item in the echo area and selects its node.
+Completion is available while reading the menu label.
+
+@item @code{M-x find-menu}
+@findex find-menu
+Move the cursor to the start of this node's menu.
+@end table
+
+This table lists the Info commands which operate on note cross references.
+
+@table @asis
+@item @code{f} (@code{xref-item})
+@itemx @code{r}
+@kindex f
+@kindex r
+@findex xref-item
+Reads the name of a note cross reference in the echo area and selects
+its node. Completion is available while reading the cross reference
+label.
+@end table
+
+Finally, the next few commands operate on menu or note references alike:
+
+@table @asis
+@item @code{TAB} (@code{move-to-next-xref})
+@kindex TAB, in Info windows
+@findex move-to-next-xref
+Move the cursor to the start of the next nearest menu item or note
+reference in this node. You can then use @key{RET}
+(@code{select-reference-this-line}) to select the menu or note reference.
+
+@item @code{M-TAB} (@code{move-to-prev-xref})
+@kindex M-TAB, in Info windows
+@findex move-to-prev-xref
+Move the cursor the start of the nearest previous menu item or note
+reference in this node.
+
+@item @code{RET} (@code{select-reference-this-line})
+@kindex RET, in Info windows
+@findex select-reference-this-line
+Select the menu item or note reference appearing on this line.
+@end table
+
+@node Window Commands, Printing Nodes, Xref Commands, Top
+@chapter Manipulating Multiple Windows
+@cindex windows, manipulating
+
+A @dfn{window} is a place to show the text of a node. Windows have a
+view area where the text of the node is displayed, and an associated
+@dfn{mode line}, which briefly describes the node being viewed.
+
+GNU Info supports multiple windows appearing in a single screen; each
+window is separated from the next by its modeline. At any time, there
+is only one @dfn{active} window, that is, the window in which the cursor
+appears. There are commands available for creating windows, changing
+the size of windows, selecting which window is active, and for deleting
+windows.
+
+@menu
+* The Mode Line:: What appears in the mode line?
+* Basic Windows:: Manipulating windows in Info.
+* The Echo Area:: Used for displaying errors and reading input.
+@end menu
+
+@node The Mode Line, Basic Windows, , Window Commands
+@section The Mode Line
+
+A @dfn{mode line} is a line of inverse video which appears at the bottom
+of an Info window. It describes the contents of the window just above
+it; this information includes the name of the file and node appearing in
+that window, the number of screen lines it takes to display the node,
+and the percentage of text that is above the top of the window. It can
+also tell you if the indirect tags table for this Info file needs to be
+updated, and whether or not the Info file was compressed when stored on
+disk.
+
+Here is a sample mode line for a window containing an uncompressed file
+named @file{dir}, showing the node @samp{Top}.
+
+@example
+@group
+-----Info: (dir)Top, 40 lines --Top---------------------------------------
+ ^^ ^ ^^^ ^^
+ (file)Node #lines where
+@end group
+@end example
+
+When a node comes from a file which is compressed on disk, this is
+indicated in the mode line with two small @samp{z}'s. In addition, if
+the Info file containing the node has been split into subfiles, the name
+of the subfile containing the node appears in the modeline as well:
+
+@example
+--zz-Info: (emacs)Top, 291 lines --Top-- Subfile: emacs-1.Z---------------
+@end example
+
+When Info makes a node internally, such that there is no corresponding
+info file on disk, the name of the node is surrounded by asterisks
+(@samp{*}). The name itself tells you what the contents of the window
+are; the sample mode line below shows an internally constructed node
+showing possible completions:
+
+@example
+-----Info: *Completions*, 7 lines --All-----------------------------------
+@end example
+
+@node Basic Windows, The Echo Area, The Mode Line, Window Commands
+@section Window Commands
+
+It can be convenient to view more than one node at a time. To allow
+this, Info can display more than one @dfn{window}. Each window has its
+own mode line (@pxref{The Mode Line}) and history of nodes viewed in that
+window (@pxref{Node Commands, , @code{history-node}}).
+
+@table @asis
+@item @code{C-x o} (@code{next-window})
+@cindex windows, selecting
+@kindex C-x o
+@findex next-window
+Select the next window on the screen. Note that the echo area can only be
+selected if it is already in use, and you have left it temporarily.
+Normally, @samp{C-x o} simply moves the cursor into the next window on
+the screen, or if you are already within the last window, into the first
+window on the screen. Given a numeric argument, @samp{C-x o} moves over
+that many windows. A negative argument causes @samp{C-x o} to select
+the previous window on the screen.
+
+@item @code{M-x prev-window}
+@findex prev-window
+Select the previous window on the screen. This is identical to
+@samp{C-x o} with a negative argument.
+
+@item @code{C-x 2} (@code{split-window})
+@cindex windows, creating
+@kindex C-x 2
+@findex split-window
+Split the current window into two windows, both showing the same node.
+Each window is one half the size of the original window, and the cursor
+remains in the original window. The variable @code{automatic-tiling}
+can cause all of the windows on the screen to be resized for you
+automatically, please @pxref{Variables, , automatic-tiling} for more
+information.
+
+@item @code{C-x 0} (@code{delete-window})
+@cindex windows, deleting
+@kindex C-x 0
+@findex delete-window
+Delete the current window from the screen. If you have made too many
+windows and your screen appears cluttered, this is the way to get rid of
+some of them.
+
+@item @code{C-x 1} (@code{keep-one-window})
+@kindex C-x 1
+@findex keep-one-window
+Delete all of the windows excepting the current one.
+
+@item @code{ESC C-v} (@code{scroll-other-window})
+@kindex ESC C-v, in Info windows
+@findex scroll-other-window
+Scroll the other window, in the same fashion that @samp{C-v} might
+scroll the current window. Given a negative argument, scroll the
+"other" window backward.
+
+@item @code{C-x ^} (@code{grow-window})
+@kindex C-x ^
+@findex grow-window
+Grow (or shrink) the current window. Given a numeric argument, grow
+the current window that many lines; with a negative numeric argument,
+shrink the window instead.
+
+@item @code{C-x t} (@code{tile-windows})
+@cindex tiling
+@kindex C-x t
+@findex tile-windows
+Divide the available screen space among all of the visible windows.
+Each window is given an equal portion of the screen in which to display
+its contents. The variable @code{automatic-tiling} can cause
+@code{tile-windows} to be called when a window is created or deleted.
+@xref{Variables, , @code{automatic-tiling}}.
+@end table
+
+@node The Echo Area, , Basic Windows, Window Commands
+@section The Echo Area
+@cindex echo area
+
+The @dfn{echo area} is a one line window which appears at the bottom of
+the screen. It is used to display informative or error messages, and to
+read lines of input from you when that is necessary. Almost all of the
+commands available in the echo area are identical to their Emacs
+counterparts, so please refer to that documentation for greater depth of
+discussion on the concepts of editing a line of text. The following
+table briefly lists the commands that are available while input is being
+read in the echo area:
+
+@table @asis
+@item @code{C-f} (@code{echo-area-forward})
+@kindex C-f, in the echo area
+@findex echo-area-forward
+Move forward a character.
+
+@item @code{C-b} (@code{echo-area-backward})
+@kindex C-b, in the echo area
+@findex echo-area-backward
+Move backward a character.
+
+@item @code{C-a} (@code{echo-area-beg-of-line})
+@kindex C-a, in the echo area
+@findex echo-area-beg-of-line
+Move to the start of the input line.
+
+@item @code{C-e} (@code{echo-area-end-of-line})
+@kindex C-e, in the echo area
+@findex echo-area-end-of-line
+Move to the end of the input line.
+
+@item @code{M-f} (@code{echo-area-forward-word})
+@kindex M-f, in the echo area
+@findex echo-area-forward-word
+Move forward a word.
+
+@item @code{M-b} (@code{echo-area-backward-word})
+@kindex M-b, in the echo area
+@findex echo-area-backward-word
+Move backward a word.
+
+@item @code{C-d} (@code{echo-area-delete})
+@kindex C-d, in the echo area
+@findex echo-area-delete
+Delete the character under the cursor.
+
+@item @code{DEL} (@code{echo-area-rubout})
+@kindex DEL, in the echo area
+@findex echo-area-rubout
+Delete the character behind the cursor.
+
+@item @code{C-g} (@code{echo-area-abort})
+@kindex C-g, in the echo area
+@findex echo-area-abort
+Cancel or quit the current operation. If completion is being read,
+@samp{C-g} discards the text of the input line which does not match any
+completion. If the input line is empty, @samp{C-g} aborts the calling
+function.
+
+@item @code{RET} (@code{echo-area-newline})
+@kindex RET, in the echo area
+@findex echo-area-newline
+Accept (or forces completion of) the current input line.
+
+@item @code{C-q} (@code{echo-area-quoted-insert})
+@kindex C-q, in the echo area
+@findex echo-area-quoted-insert
+Insert the next character verbatim. This is how you can insert control
+characters into a search string, for example.
+
+@item @var{printing character} (@code{echo-area-insert})
+@kindex printing characters, in the echo area
+@findex echo-area-insert
+Insert the character.
+
+@item @code{M-TAB} (@code{echo-area-tab-insert})
+@kindex M-TAB, in the echo area
+@findex echo-area-tab-insert
+Insert a TAB character.
+
+@item @code{C-t} (@code{echo-area-transpose-chars})
+@kindex C-t, in the echo area
+@findex echo-area-transpose-chars
+Transpose the characters at the cursor.
+@end table
+
+The next group of commands deal with @dfn{killing}, and @dfn{yanking}
+text. For an in depth discussion of killing and yanking,
+@pxref{Killing, , Killing and Deleting, emacs, the GNU Emacs Manual}
+
+@table @asis
+@item @code{M-d} (@code{echo-area-kill-word})
+@kindex M-d, in the echo area
+@findex echo-area-kill-word
+Kill the word following the cursor.
+
+@item @code{M-DEL} (@code{echo-area-backward-kill-word})
+@kindex M-DEL, in the echo area
+@findex echo-area-backward-kill-word
+Kill the word preceding the cursor.
+
+@item @code{C-k} (@code{echo-area-kill-line})
+@kindex C-k, in the echo area
+@findex echo-area-kill-line
+Kill the text from the cursor to the end of the line.
+
+@item @code{C-x DEL} (@code{echo-area-backward-kill-line})
+@kindex C-x DEL, in the echo area
+@findex echo-area-backward-kill-line
+Kill the text from the cursor to the beginning of the line.
+
+@item @code{C-y} (@code{echo-area-yank})
+@kindex C-y, in the echo area
+@findex echo-area-yank
+Yank back the contents of the last kill.
+
+@item @code{M-y} (@code{echo-area-yank-pop})
+@kindex M-y, in the echo area
+@findex echo-area-yank-pop
+Yank back a previous kill, removing the last yanked text first.
+@end table
+
+Sometimes when reading input in the echo area, the command that needed
+input will only accept one of a list of several choices. The choices
+represent the @dfn{possible completions}, and you must respond with one
+of them. Since there are a limited number of responses you can make,
+Info allows you to abbreviate what you type, only typing as much of the
+response as is necessary to uniquely identify it. In addition, you can
+request Info to fill in as much of the response as is possible; this
+is called @dfn{completion}.
+
+The following commands are available when completing in the echo area:
+
+@table @asis
+@item @code{TAB} (@code{echo-area-complete})
+@itemx @code{SPC}
+@kindex TAB, in the echo area
+@kindex SPC, in the echo area
+@findex echo-area-complete
+Insert as much of a completion as is possible.
+
+@item @code{?} (@code{echo-area-possible-completions})
+@kindex ?, in the echo area
+@findex echo-area-possible-completions
+Display a window containing a list of the possible completions of what
+you have typed so far. For example, if the available choices are:
+
+@example
+@group
+bar
+foliate
+food
+forget
+@end group
+@end example
+
+@noindent
+and you have typed an @samp{f}, followed by @samp{?}, the possible
+completions would contain:
+
+@example
+@group
+foliate
+food
+forget
+@end group
+@end example
+
+@noindent
+i.e., all of the choices which begin with @samp{f}. Pressing @key{SPC}
+or @key{TAB} would result in @samp{fo} appearing in the echo area, since
+all of the choices which begin with @samp{f} continue with @samp{o}.
+Now, typing @samp{l} followed by @samp{TAB} results in @samp{foliate}
+appearing in the echo area, since that is the only choice which begins
+with @samp{fol}.
+
+@item @code{ESC C-v} (@code{echo-area-scroll-completions-window})
+@kindex ESC C-v, in the echo area
+@findex echo-area-scroll-completions-window
+Scroll the completions window, if that is visible, or the "other"
+window if not.
+@end table
+
+@node Printing Nodes, Miscellaneous Commands, Window Commands, Top
+@chapter Printing Out Nodes
+@cindex printing
+
+You may wish to print out the contents of a node as a quick reference
+document for later use. Info provides you with a command for doing
+this. In general, we recommend that you use @TeX{} to format the
+document and print sections of it, by running @code{tex} on the Texinfo
+source file.
+
+@table @asis
+@item @code{M-x print-node}
+@findex print-node
+@cindex INFO_PRINT_COMMAND, environment variable
+Pipe the contents of the current node through the command in the
+environment variable @code{INFO_PRINT_COMMAND}. If the variable does not
+exist, the node is simply piped to @code{lpr}.
+@end table
+
+@node Miscellaneous Commands, Variables, Printing Nodes, Top
+@chapter Miscellaneous Commands
+
+GNU Info contains several commands which self-document GNU Info:
+
+@table @asis
+@item @code{M-x describe-command}
+@cindex functions, describing
+@cindex commands, describing
+@findex describe-command
+Read the name of an Info command in the echo area and then display a
+brief description of what that command does.
+
+@item @code{M-x describe-key}
+@cindex keys, describing
+@findex describe-key
+Read a key sequence in the echo area, and then display the name and
+documentation of the Info command that the key sequence invokes.
+
+@item @code{M-x describe-variable}
+Read the name of a variable in the echo area and then display a brief
+description of what the variable affects.
+
+@item @code{M-x where-is}
+@findex where-is
+Read the name of an Info command in the echo area, and then display
+a key sequence which can be typed in order to invoke that command.
+
+@item @code{C-h} (@code{get-help-window})
+@itemx @code{?}
+@kindex C-h
+@kindex ?, in Info windows
+@findex get-help-window
+Create (or Move into) the window displaying @code{*Help*}, and place
+a node containing a quick reference card into it. This window displays
+the most concise information about GNU Info available.
+
+@item @code{h} (@code{get-info-help-node})
+@kindex h
+@findex get-info-help-node
+Try hard to visit the node @code{(info)Help}. The Info file
+@file{info.texi} distributed with GNU Info contains this node. Of
+course, the file must first be processed with @code{makeinfo}, and then
+placed into the location of your Info directory.
+@end table
+
+Here are the commands for creating a numeric argument:
+
+@table @asis
+@item @code{C-u} (@code{universal-argument})
+@cindex numeric arguments
+@kindex C-u
+@findex universal-argument
+Start (or multiply by 4) the current numeric argument. @samp{C-u} is
+a good way to give a small numeric argument to cursor movement or
+scrolling commands; @samp{C-u C-v} scrolls the screen 4 lines, while
+@samp{C-u C-u C-n} moves the cursor down 16 lines.
+
+@item @code{M-1} (@code{add-digit-to-numeric-arg})
+@itemx @code{M-2} @dots{} @code{M-9}
+@kindex M-1 @dots{} M-9
+@findex add-digit-to-numeric-arg
+Add the digit value of the invoking key to the current numeric
+argument. Once Info is reading a numeric argument, you may just type
+the digits of the argument, without the Meta prefix. For example, you
+might give @samp{C-l} a numeric argument of 32 by typing:
+
+@example
+@kbd{C-u 3 2 C-l}
+@end example
+
+@noindent
+or
+
+@example
+@kbd{M-3 2 C-l}
+@end example
+@end table
+
+@samp{C-g} is used to abort the reading of a multi-character key
+sequence, to cancel lengthy operations (such as multi-file searches) and
+to cancel reading input in the echo area.
+
+@table @asis
+@item @code{C-g} (@code{abort-key})
+@cindex cancelling typeahead
+@cindex cancelling the current operation
+@kindex C-g, in Info windows
+@findex abort-key
+Cancel current operation.
+@end table
+
+The @samp{q} command of Info simply quits running Info.
+
+@table @asis
+@item @code{q} (@code{quit})
+@cindex quitting
+@kindex q
+@findex quit
+Exit GNU Info.
+@end table
+
+If the operating system tells GNU Info that the screen is 60 lines tall,
+and it is actually only 40 lines tall, here is a way to tell Info that
+the operating system is correct.
+
+@table @asis
+@item @code{M-x set-screen-height}
+@findex set-screen-height
+@cindex screen, changing the height of
+Read a height value in the echo area and set the height of the
+displayed screen to that value.
+@end table
+
+Finally, Info provides a convenient way to display footnotes which might
+be associated with the current node that you are viewing:
+
+@table @asis
+@item @code{ESC C-f} (@code{show-footnotes})
+@kindex ESC C-f
+@findex show-footnotes
+@cindex footnotes, displaying
+Show the footnotes (if any) associated with the current node in another
+window. You can have Info automatically display the footnotes
+associated with a node when the node is selected by setting the variable
+@code{automatic-footnotes}. @xref{Variables, , @code{automatic-footnotes}}.
+@end table
+
+@node Variables, GNU Info Global Index, Miscellaneous Commands, Top
+@chapter Manipulating Variables
+
+GNU Info contains several @dfn{variables} whose values are looked at by
+various Info commands. You can change the values of these variables,
+and thus change the behavior of Info to more closely match your
+environment and Info file reading manner.
+
+@table @asis
+@item @code{M-x set-variable}
+@cindex variables, setting
+@findex set-variable
+Read the name of a variable, and the value for it, in the echo area and
+then set the variable to that value. Completion is available when
+reading the variable name; often, completion is available when reading
+the value to give to the variable, but that depends on the variable
+itself. If a variable does @emph{not} supply multiple choices to
+complete over, it expects a numeric value.
+
+@item @code{M-x describe-variable}
+@cindex variables, describing
+@findex describe-variable
+Read the name of a variable in the echo area and then display a brief
+description of what the variable affects.
+@end table
+
+Here is a list of the variables that you can set in Info.
+
+@table @code
+@item automatic-footnotes
+@vindex automatic-footnotes
+When set to @code{On}, footnotes appear and disappear automatically.
+This variable is @code{On} by default. When a node is selected, a
+window containing the footnotes which appear in that node is created,
+and the footnotes are displayed within the new window. The window that
+Info creates to contain the footnotes is called @samp{*Footnotes*}. If
+a node is selected which contains no footnotes, and a @samp{*Footnotes*}
+window is on the screen, the @samp{*Footnotes*} window is deleted.
+Footnote windows created in this fashion are not automatically tiled so
+that they can use as little of the display as is possible.
+
+@item automatic-tiling
+@vindex automatic-tiling
+When set to @code{On}, creating or deleting a window resizes other
+windows. This variable is @code{Off} by default. Normally, typing
+@samp{C-x 2} divides the current window into two equal parts. When
+@code{automatic-tiling} is set to @code{On}, all of the windows are
+resized automatically, keeping an equal number of lines visible in each
+window. There are exceptions to the automatic tiling; specifically, the
+windows @samp{*Completions*} and @samp{*Footnotes*} are @emph{not}
+resized through automatic tiling; they remain their original size.
+
+@item visible-bell
+@vindex visible-bell
+When set to @code{On}, GNU Info attempts to flash the screen instead of
+ringing the bell. This variable is @code{Off} by default. Of course,
+Info can only flash the screen if the terminal allows it; in the case
+that the terminal does not allow it, the setting of this variable has no
+effect. However, you can make Info perform quietly by setting the
+@code{errors-ring-bell} variable to @code{Off}.
+
+@item errors-ring-bell
+@vindex errors-ring-bell
+When set to @code{On}, errors cause the bell to ring. The default
+setting of this variable is @code{On}.
+
+@item gc-compressed-files
+@vindex gc-compressed-files
+When set to @code{On}, Info garbage collects files which had to be
+uncompressed. The default value of this variable is @code{Off}.
+Whenever a node is visited in Info, the Info file containing that node
+is read into core, and Info reads information about the tags and nodes
+contained in that file. Once the tags information is read by Info, it
+is never forgotten. However, the actual text of the nodes does not need
+to remain in core unless a particular Info window needs it. For
+non-compressed files, the text of the nodes does not remain in core when
+it is no longer in use. But de-compressing a file can be a time
+consuming operation, and so Info tries hard not to do it twice.
+@code{gc-compressed-files} tells Info it is okay to garbage collect the
+text of the nodes of a file which was compressed on disk.
+
+@item show-index-match
+@vindex show-index-match
+When set to @code{On}, the portion of the matched search string is
+highlighted in the message which explains where the matched search
+string was found. The default value of this variable is @code{On}.
+When Info displays the location where an index match was found,
+(@pxref{Searching Commands, , @code{next-index-match}}), the portion of the
+string that you had typed is highlighted by displaying it in the inverse
+case from its surrounding characters.
+
+@item scroll-behavior
+@vindex scroll-behavior
+Control what happens when forward scrolling is requested at the end of
+a node, or when backward scrolling is requested at the beginning of a
+node. The default value for this variable is @code{Continuous}. There
+are three possible values for this variable:
+
+@table @code
+@item Continuous
+Try to get the first item in this node's menu, or failing that, the
+@samp{Next} node, or failing that, the @samp{Next} of the @samp{Up}.
+This behavior is identical to using the @samp{]}
+(@code{global-next-node}) and @samp{[} (@code{global-prev-node})
+commands.
+
+@item Next Only
+Only try to get the @samp{Next} node.
+
+@item Page Only
+Simply give up, changing nothing. If @code{scroll-behavior} is
+@code{Page Only}, no scrolling command can change the node that is being
+viewed.
+@end table
+
+@item scroll-step
+@vindex scroll-step
+The number of lines to scroll when the cursor moves out of the window.
+Scrolling happens automatically if the cursor has moved out of the
+visible portion of the node text when it is time to display. Usually
+the scrolling is done so as to put the cursor on the center line of the
+current window. However, if the variable @code{scroll-step} has a
+nonzero value, Info attempts to scroll the node text by that many lines;
+if that is enough to bring the cursor back into the window, that is what
+is done. The default value of this variable is 0, thus placing the
+cursor (and the text it is attached to) in the center of the window.
+Setting this variable to 1 causes a kind of "smooth scrolling" which
+some people prefer.
+
+@item ISO-Latin
+@cindex ISO Latin characters
+@vindex ISO-Latin
+When set to @code{On}, Info accepts and displays ISO Latin characters.
+By default, Info assumes an ASCII character set. @code{ISO-Latin} tells
+Info that it is running in an environment where the European standard
+character set is in use, and allows you to input such characters to
+Info, as well as display them.
+@end table
+
+
+
+@c the following is incomplete
+@ignore
+@c node Info for Sys Admins
+@c chapter Info for System Administrators
+
+This text describes some common ways of setting up an Info hierarchy
+from scratch, and details the various options that are available when
+installing Info. This text is designed for the person who is installing
+GNU Info on the system; although users may find the information present
+in this section interesting, none of it is vital to understanding how to
+use GNU Info.
+
+@menu
+* Setting the INFOPATH:: Where are my Info files kept?
+* Editing the DIR node:: What goes in `DIR', and why?
+* Storing Info files:: Alternate formats allow flexibility in setups.
+* Using `localdir':: Building DIR on the fly.
+* Example setups:: Some common ways to organize Info files.
+@end menu
+
+@c node Setting the INFOPATH
+@c section Setting the INFOPATH
+
+Where are my Info files kept?
+
+@c node Editing the DIR node
+@c section Editing the DIR node
+
+What goes in `DIR', and why?
+
+@c node Storing Info files
+@c section Storing Info files
+
+Alternate formats allow flexibility in setups.
+
+@c node Using `localdir'
+@c section Using `localdir'
+
+Building DIR on the fly.
+
+@c node Example setups
+@c section Example setups
+
+Some common ways to organize Info files.
+@end ignore
+
+@node GNU Info Global Index, , Variables, Top
+@appendix Global Index
+
+@printindex cp
+
+@contents
+@bye
diff --git a/texinfo/info/info-utils.c b/texinfo/info/info-utils.c
new file mode 100644
index 00000000000..6af3dd0e2ca
--- /dev/null
+++ b/texinfo/info/info-utils.c
@@ -0,0 +1,672 @@
+/* info-utils.c -- Useful functions for manipulating Info file quirks. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h> /* For "NULL". Yechhh! */
+#include <ctype.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#if defined (HAVE_STRING_H)
+# include <string.h>
+#endif /* HAVE_STRING_H */
+#include "info-utils.h"
+
+#if defined (HANDLE_MAN_PAGES)
+# include "man.h"
+#endif /* HANDLE_MAN_PAGES */
+
+/* When non-zero, various display and input functions handle ISO Latin
+ character sets correctly. */
+int ISO_Latin_p = 0;
+
+/* Variable which holds the most recent filename parsed as a result of
+ calling info_parse_xxx (). */
+char *info_parsed_filename = (char *)NULL;
+
+/* Variable which holds the most recent nodename parsed as a result of
+ calling info_parse_xxx (). */
+char *info_parsed_nodename = (char *)NULL;
+
+/* Functions to remember a filename or nodename for later return. */
+static void save_filename (), saven_filename ();
+static void save_nodename (), saven_nodename ();
+
+/* How to get a reference (either menu or cross). */
+static REFERENCE **info_references_internal ();
+
+/* Parse the filename and nodename out of STRING. If STRING doesn't
+ contain a filename (i.e., it is NOT (FILENAME)NODENAME) then set
+ INFO_PARSED_FILENAME to NULL. If second argument NEWLINES_OKAY is
+ non-zero, it says to allow the nodename specification to cross a
+ newline boundary (i.e., only `,', `.', or `TAB' can end the spec). */
+void
+info_parse_node (string, newlines_okay)
+ char *string;
+ int newlines_okay;
+{
+ register int i = 0;
+
+ /* Default the answer. */
+ save_filename ((char *)NULL);
+ save_nodename ((char *)NULL);
+
+ /* Special case of nothing passed. Return nothing. */
+ if (!string || !*string)
+ return;
+
+ string += skip_whitespace (string);
+
+ /* Check for (FILENAME)NODENAME. */
+ if (*string == '(')
+ {
+ i = 0;
+ /* Advance past the opening paren. */
+ string++;
+
+ /* Find the closing paren. */
+ while (string[i] && string[i] != ')')
+ i++;
+
+ /* Remember parsed filename. */
+ saven_filename (string, i);
+
+ /* Point directly at the nodename. */
+ string += i;
+
+ if (*string)
+ string++;
+ }
+
+ /* Parse out nodename. */
+ i = skip_node_characters (string, newlines_okay);
+ saven_nodename (string, i);
+ canonicalize_whitespace (info_parsed_nodename);
+ if (info_parsed_nodename && !*info_parsed_nodename)
+ {
+ free (info_parsed_nodename);
+ info_parsed_nodename = (char *)NULL;
+ }
+}
+
+/* Return the node addressed by LABEL in NODE (usually one of "Prev:",
+ "Next:", "Up:", "File:", or "Node:". After a call to this function,
+ the global INFO_PARSED_NODENAME and INFO_PARSED_FILENAME contain
+ the information. */
+void
+info_parse_label (label, node)
+ char *label;
+ NODE *node;
+{
+ register int i;
+ char *nodeline;
+
+ /* Default answer to failure. */
+ save_nodename ((char *)NULL);
+ save_filename ((char *)NULL);
+
+ /* Find the label in the first line of this node. */
+ nodeline = node->contents;
+ i = string_in_line (label, nodeline);
+
+ if (i == -1)
+ return;
+
+ nodeline += i;
+ nodeline += skip_whitespace (nodeline);
+ info_parse_node (nodeline, DONT_SKIP_NEWLINES);
+}
+
+/* **************************************************************** */
+/* */
+/* Finding and Building Menus */
+/* */
+/* **************************************************************** */
+
+/* Return a NULL terminated array of REFERENCE * which represents the menu
+ found in NODE. If there is no menu in NODE, just return a NULL pointer. */
+REFERENCE **
+info_menu_of_node (node)
+ NODE *node;
+{
+ long position;
+ SEARCH_BINDING search;
+ REFERENCE **menu = (REFERENCE **)NULL;
+
+ search.buffer = node->contents;
+ search.start = 0;
+ search.end = node->nodelen;
+ search.flags = S_FoldCase;
+
+ /* Find the start of the menu. */
+ position = search_forward (INFO_MENU_LABEL, &search);
+
+ if (position == -1)
+ return ((REFERENCE **) NULL);
+
+ /* We have the start of the menu now. Glean menu items from the rest
+ of the node. */
+ search.start = position + strlen (INFO_MENU_LABEL);
+ search.start += skip_line (search.buffer + search.start);
+ search.start--;
+ menu = info_menu_items (&search);
+ return (menu);
+}
+
+/* Return a NULL terminated array of REFERENCE * which represents the cross
+ refrences found in NODE. If there are no cross references in NODE, just
+ return a NULL pointer. */
+REFERENCE **
+info_xrefs_of_node (node)
+ NODE *node;
+{
+ SEARCH_BINDING search;
+
+#if defined (HANDLE_MAN_PAGES)
+ if (node->flags & N_IsManPage)
+ return (xrefs_of_manpage (node));
+#endif
+
+ search.buffer = node->contents;
+ search.start = 0;
+ search.end = node->nodelen;
+ search.flags = S_FoldCase;
+
+ return (info_xrefs (&search));
+}
+
+/* Glean menu entries from BINDING->buffer + BINDING->start until we
+ have looked at the entire contents of BINDING. Return an array
+ of REFERENCE * that represents each menu item in this range. */
+REFERENCE **
+info_menu_items (binding)
+ SEARCH_BINDING *binding;
+{
+ return (info_references_internal (INFO_MENU_ENTRY_LABEL, binding));
+}
+
+/* Glean cross references from BINDING->buffer + BINDING->start until
+ BINDING->end. Return an array of REFERENCE * that represents each
+ cross reference in this range. */
+REFERENCE **
+info_xrefs (binding)
+ SEARCH_BINDING *binding;
+{
+ return (info_references_internal (INFO_XREF_LABEL, binding));
+}
+
+/* Glean cross references or menu items from BINDING. Return an array
+ of REFERENCE * that represents the items found. */
+static REFERENCE **
+info_references_internal (label, binding)
+ char *label;
+ SEARCH_BINDING *binding;
+{
+ SEARCH_BINDING search;
+ REFERENCE **refs = (REFERENCE **)NULL;
+ int refs_index = 0, refs_slots = 0;
+ int searching_for_menu_items = 0;
+ long position;
+
+ search.buffer = binding->buffer;
+ search.start = binding->start;
+ search.end = binding->end;
+ search.flags = S_FoldCase | S_SkipDest;
+
+ searching_for_menu_items = (strcasecmp (label, INFO_MENU_ENTRY_LABEL) == 0);
+
+ while ((position = search_forward (label, &search)) != -1)
+ {
+ int offset, start;
+ char *refdef;
+ REFERENCE *entry;
+
+ search.start = position;
+ search.start += skip_whitespace (search.buffer + search.start);
+ start = search.start - binding->start;
+ refdef = search.buffer + search.start;
+ offset = string_in_line (":", refdef);
+
+ /* When searching for menu items, if no colon, there is no
+ menu item on this line. */
+ if (offset == -1)
+ {
+ if (searching_for_menu_items)
+ continue;
+ else
+ {
+ int temp;
+
+ temp = skip_line (refdef);
+ offset = string_in_line (":", refdef + temp);
+ if (offset == -1)
+ continue; /* Give up? */
+ else
+ offset += temp;
+ }
+ }
+
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->filename = (char *)NULL;
+ entry->nodename = (char *)NULL;
+ entry->label = (char *)xmalloc (offset);
+ strncpy (entry->label, refdef, offset - 1);
+ entry->label[offset - 1] = '\0';
+ canonicalize_whitespace (entry->label);
+
+ refdef += offset;
+ entry->start = start;
+ entry->end = refdef - binding->buffer;
+
+ /* If this reference entry continues with another ':' then the
+ nodename is the same as the label. */
+ if (*refdef == ':')
+ {
+ entry->nodename = strdup (entry->label);
+ }
+ else
+ {
+ /* This entry continues with a specific nodename. Parse the
+ nodename from the specification. */
+
+ refdef += skip_whitespace_and_newlines (refdef);
+
+ if (searching_for_menu_items)
+ info_parse_node (refdef, DONT_SKIP_NEWLINES);
+ else
+ info_parse_node (refdef, SKIP_NEWLINES);
+
+ if (info_parsed_filename)
+ entry->filename = strdup (info_parsed_filename);
+
+ if (info_parsed_nodename)
+ entry->nodename = strdup (info_parsed_nodename);
+ }
+
+ add_pointer_to_array
+ (entry, refs_index, refs, refs_slots, 50, REFERENCE *);
+ }
+ return (refs);
+}
+
+/* Get the entry associated with LABEL in MENU. Return a pointer to the
+ REFERENCE if found, or NULL. */
+REFERENCE *
+info_get_labeled_reference (label, references)
+ char *label;
+ REFERENCE **references;
+{
+ register int i;
+ REFERENCE *entry;
+
+ for (i = 0; references && (entry = references[i]); i++)
+ {
+ if (strcmp (label, entry->label) == 0)
+ return (entry);
+ }
+ return ((REFERENCE *)NULL);
+}
+
+/* A utility function for concatenating REFERENCE **. Returns a new
+ REFERENCE ** which is the concatenation of REF1 and REF2. The REF1
+ and REF2 arrays are freed, but their contents are not. */
+REFERENCE **
+info_concatenate_references (ref1, ref2)
+ REFERENCE **ref1, **ref2;
+{
+ register int i, j;
+ REFERENCE **result;
+ int size;
+
+ /* With one argument passed as NULL, simply return the other arg. */
+ if (!ref1)
+ return (ref2);
+ else if (!ref2)
+ return (ref1);
+
+ /* Get the total size of the slots that we will need. */
+ for (i = 0; ref1[i]; i++);
+ size = i;
+ for (i = 0; ref2[i]; i++);
+ size += i;
+
+ result = (REFERENCE **)xmalloc ((1 + size) * sizeof (REFERENCE *));
+
+ /* Copy the contents over. */
+ for (i = 0; ref1[i]; i++)
+ result[i] = ref1[i];
+
+ j = i;
+ for (i = 0; ref2[i]; i++)
+ result[j++] = ref2[i];
+
+ result[j] = (REFERENCE *)NULL;
+ free (ref1);
+ free (ref2);
+ return (result);
+}
+
+/* Free the data associated with REFERENCES. */
+void
+info_free_references (references)
+ REFERENCE **references;
+{
+ register int i;
+ REFERENCE *entry;
+
+ if (references)
+ {
+ for (i = 0; references && (entry = references[i]); i++)
+ {
+ maybe_free (entry->label);
+ maybe_free (entry->filename);
+ maybe_free (entry->nodename);
+
+ free (entry);
+ }
+
+ free (references);
+ }
+}
+
+/* Search for sequences of whitespace or newlines in STRING, replacing
+ all such sequences with just a single space. Remove whitespace from
+ start and end of string. */
+void
+canonicalize_whitespace (string)
+ char *string;
+{
+ register int i, j;
+ int len, whitespace_found, whitespace_loc;
+ char *temp;
+
+ if (!string)
+ return;
+
+ len = strlen (string);
+ temp = (char *)xmalloc (1 + len);
+
+ /* Search for sequences of whitespace or newlines. Replace all such
+ sequences in the string with just a single space. */
+
+ whitespace_found = 0;
+ for (i = 0, j = 0; string[i]; i++)
+ {
+ if (whitespace_or_newline (string[i]))
+ {
+ whitespace_found++;
+ whitespace_loc = i;
+ continue;
+ }
+ else
+ {
+ if (whitespace_found && whitespace_loc)
+ {
+ whitespace_found = 0;
+
+ /* Suppress whitespace at start of string. */
+ if (j)
+ temp[j++] = ' ';
+ }
+
+ temp[j++] = string[i];
+ }
+ }
+
+ /* Kill trailing whitespace. */
+ if (j && whitespace (temp[j - 1]))
+ j--;
+
+ temp[j] = '\0';
+ strcpy (string, temp);
+ free (temp);
+}
+
+/* String representation of a char returned by printed_representation (). */
+static char the_rep[10];
+
+/* Return a pointer to a string which is the printed representation
+ of CHARACTER if it were printed at HPOS. */
+char *
+printed_representation (character, hpos)
+ unsigned char character;
+ int hpos;
+{
+ register int i = 0;
+ int printable_limit;
+
+ if (ISO_Latin_p)
+ printable_limit = 160;
+ else
+ printable_limit = 127;
+
+ if (character == '\177')
+ {
+ the_rep[i++] = '^';
+ the_rep[i++] = '?';
+ }
+ else if (iscntrl (character))
+ {
+ switch (character)
+ {
+ case '\r':
+ case '\n':
+ the_rep[i++] = character;
+ break;
+
+ case '\t':
+ {
+ int tw;
+
+ tw = ((hpos + 8) & 0xf8) - hpos;
+ while (i < tw)
+ the_rep[i++] = ' ';
+ }
+ break;
+
+ default:
+ the_rep[i++] = '^';
+ the_rep[i++] = (character | 0x40);
+ }
+ }
+ else if (character > printable_limit)
+ {
+ sprintf (the_rep + i, "\\%0o", character);
+ i = strlen (the_rep);
+ }
+ else
+ the_rep[i++] = character;
+
+ the_rep[i] = '\0';
+
+ return (the_rep);
+}
+
+
+/* **************************************************************** */
+/* */
+/* Functions Static To This File */
+/* */
+/* **************************************************************** */
+
+/* Amount of space allocated to INFO_PARSED_FILENAME via xmalloc (). */
+static int parsed_filename_size = 0;
+
+/* Amount of space allocated to INFO_PARSED_NODENAME via xmalloc (). */
+static int parsed_nodename_size = 0;
+
+static void save_string (), saven_string ();
+
+/* Remember FILENAME in PARSED_FILENAME. An empty FILENAME is translated
+ to a NULL pointer in PARSED_FILENAME. */
+static void
+save_filename (filename)
+ char *filename;
+{
+ save_string (filename, &info_parsed_filename, &parsed_filename_size);
+}
+
+/* Just like save_filename (), but you pass the length of the string. */
+static void
+saven_filename (filename, len)
+ char *filename;
+ int len;
+{
+ saven_string (filename, len,
+ &info_parsed_filename, &parsed_filename_size);
+}
+
+/* Remember NODENAME in PARSED_NODENAME. An empty NODENAME is translated
+ to a NULL pointer in PARSED_NODENAME. */
+static void
+save_nodename (nodename)
+ char *nodename;
+{
+ save_string (nodename, &info_parsed_nodename, &parsed_nodename_size);
+}
+
+/* Just like save_nodename (), but you pass the length of the string. */
+static void
+saven_nodename (nodename, len)
+ char *nodename;
+ int len;
+{
+ saven_string (nodename, len,
+ &info_parsed_nodename, &parsed_nodename_size);
+}
+
+/* Remember STRING in STRING_P. STRING_P should currently have STRING_SIZE_P
+ bytes allocated to it. An empty STRING is translated to a NULL pointer
+ in STRING_P. */
+static void
+save_string (string, string_p, string_size_p)
+ char *string;
+ char **string_p;
+ int *string_size_p;
+{
+ if (!string || !*string)
+ {
+ if (*string_p)
+ free (*string_p);
+
+ *string_p = (char *)NULL;
+ *string_size_p = 0;
+ }
+ else
+ {
+ if (strlen (string) >= *string_size_p)
+ *string_p = (char *)xrealloc
+ (*string_p, (*string_size_p = 1 + strlen (string)));
+
+ strcpy (*string_p, string);
+ }
+}
+
+/* Just like save_string (), but you also pass the length of STRING. */
+static void
+saven_string (string, len, string_p, string_size_p)
+ char *string;
+ int len;
+ char **string_p;
+ int *string_size_p;
+{
+ if (!string)
+ {
+ if (*string_p)
+ free (*string_p);
+
+ *string_p = (char *)NULL;
+ *string_size_p = 0;
+ }
+ else
+ {
+ if (len >= *string_size_p)
+ *string_p = (char *)xrealloc (*string_p, (*string_size_p = 1 + len));
+
+ strncpy (*string_p, string, len);
+ (*string_p)[len] = '\0';
+ }
+}
+
+/* Return a pointer to the part of PATHNAME that simply defines the file. */
+char *
+filename_non_directory (pathname)
+ char *pathname;
+{
+ char *filename;
+
+ filename = (char *) strrchr (pathname, '/');
+
+ if (filename)
+ filename++;
+ else
+ filename = pathname;
+
+ return (filename);
+}
+
+/* Return non-zero if NODE is one especially created by Info. */
+int
+internal_info_node_p (node)
+ NODE *node;
+{
+#if defined (NEVER)
+ if (node &&
+ (node->filename && !*node->filename) &&
+ !node->parent && node->nodename)
+ return (1);
+ else
+ return (0);
+#else
+ return ((node != (NODE *)NULL) && ((node->flags & N_IsInternal) != 0));
+#endif /* !NEVER */
+}
+
+/* Make NODE appear to be one especially created by Info. */
+void
+name_internal_node (node, name)
+ NODE *node;
+ char *name;
+{
+ if (!node)
+ return;
+
+ node->filename = "";
+ node->parent = (char *)NULL;
+ node->nodename = name;
+ node->flags |= N_IsInternal;
+}
+
+/* Return the window displaying NAME, the name of an internally created
+ Info window. */
+WINDOW *
+get_internal_info_window (name)
+ char *name;
+{
+ WINDOW *win;
+
+ for (win = windows; win; win = win->next)
+ if (internal_info_node_p (win->node) &&
+ (strcmp (win->node->nodename, name) == 0))
+ break;
+
+ return (win);
+}
diff --git a/texinfo/info/info-utils.h b/texinfo/info/info-utils.h
new file mode 100644
index 00000000000..9f17a39f88b
--- /dev/null
+++ b/texinfo/info/info-utils.h
@@ -0,0 +1,140 @@
+/* info-utils.h -- Exported functions and variables from info-util.c.
+ $Id: info-utils.h,v 1.1 1997/08/21 22:58:02 jason Exp $
+
+ This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_INFO_UTILS_H_)
+#define _INFO_UTILS_H_
+
+#if !defined (HAVE_STRCHR)
+# undef strchr
+# undef strrchr
+# define strchr index
+# define strrchr rindex
+#endif /* !HAVE_STRCHR */
+
+#include "nodes.h"
+#include "window.h"
+#include "search.h"
+
+/* Structure which describes a node reference, such as a menu entry or
+ cross reference. Arrays of such references can be built by calling
+ info_menus_of_node () or info_xrefs_of_node (). */
+typedef struct {
+ char *label; /* User Label. */
+ char *filename; /* File where this node can be found. */
+ char *nodename; /* Name of the node. */
+ int start, end; /* Offsets within the containing node of LABEL. */
+} REFERENCE;
+
+/* When non-zero, various display and input functions handle ISO Latin
+ character sets correctly. */
+extern int ISO_Latin_p;
+
+/* Variable which holds the most recent filename parsed as a result of
+ calling info_parse_xxx (). */
+extern char *info_parsed_filename;
+
+/* Variable which holds the most recent nodename parsed as a result of
+ calling info_parse_xxx (). */
+extern char *info_parsed_nodename;
+
+/* Parse the filename and nodename out of STRING. If STRING doesn't
+ contain a filename (i.e., it is NOT (FILENAME)NODENAME) then set
+ INFO_PARSED_FILENAME to NULL. If second argument NEWLINES_OKAY is
+ non-zero, it says to allow the nodename specification to cross a
+ newline boundary (i.e., only `,', `.', or `TAB' can end the spec). */
+void info_parse_node ();
+
+/* Return a NULL terminated array of REFERENCE * which represents the menu
+ found in NODE. If there is no menu in NODE, just return a NULL pointer. */
+extern REFERENCE **info_menu_of_node ();
+
+/* Return a NULL terminated array of REFERENCE * which represents the cross
+ refrences found in NODE. If there are no cross references in NODE, just
+ return a NULL pointer. */
+extern REFERENCE **info_xrefs_of_node ();
+
+/* Glean cross references from BINDING->buffer + BINDING->start until
+ BINDING->end. Return an array of REFERENCE * that represents each
+ cross reference in this range. */
+extern REFERENCE **info_xrefs ();
+
+/* Get the entry associated with LABEL in REFERENCES. Return a pointer to
+ the reference if found, or NULL. */
+extern REFERENCE *info_get_labeled_reference ();
+
+/* Glean menu entries from BINDING->buffer + BINDING->start until we
+ have looked at the entire contents of BINDING. Return an array
+ of REFERENCE * that represents each menu item in this range. */
+extern REFERENCE **info_menu_items ();
+
+/* A utility function for concatenating REFERENCE **. Returns a new
+ REFERENCE ** which is the concatenation of REF1 and REF2. The REF1
+ and REF2 arrays are freed, but their contents are not. */
+REFERENCE **info_concatenate_references ();
+
+/* Free the data associated with REFERENCES. */
+extern void info_free_references ();
+
+/* Search for sequences of whitespace or newlines in STRING, replacing
+ all such sequences with just a single space. Remove whitespace from
+ start and end of string. */
+void canonicalize_whitespace ();
+
+/* Return a pointer to a string which is the printed representation
+ of CHARACTER if it were printed at HPOS. */
+extern char *printed_representation ();
+
+/* Return a pointer to the part of PATHNAME that simply defines the file. */
+extern char *filename_non_directory ();
+
+/* Return non-zero if NODE is one especially created by Info. */
+extern int internal_info_node_p ();
+
+/* Make NODE appear to be one especially created by Info, and give it NAME. */
+extern void name_internal_node ();
+
+/* Return the window displaying NAME, the name of an internally created
+ Info window. */
+extern WINDOW *get_internal_info_window ();
+
+/* Return the node addressed by LABEL in NODE (usually one of "Prev:",
+ "Next:", "Up:", "File:", or "Node:". After a call to this function,
+ the global INFO_PARSED_NODENAME and INFO_PARSED_FILENAME contain
+ the information. */
+extern void info_parse_label (/* label, node */);
+
+#define info_label_was_found \
+ (info_parsed_nodename != NULL || info_parsed_filename != NULL)
+
+#define info_file_label_of_node(n) info_parse_label (INFO_FILE_LABEL, n)
+#define info_next_label_of_node(n) info_parse_label (INFO_NEXT_LABEL, n)
+#define info_up_label_of_node(n) info_parse_label (INFO_UP_LABEL, n)
+#define info_prev_label_of_node(n) \
+ do { \
+ info_parse_label (INFO_PREV_LABEL, n); \
+ if (!info_label_was_found) \
+ info_parse_label (INFO_ALTPREV_LABEL, n); \
+ } while (0)
+
+#endif /* !_INFO_UTILS_H_ */
diff --git a/texinfo/info/info.1 b/texinfo/info/info.1
new file mode 100644
index 00000000000..f95687303d2
--- /dev/null
+++ b/texinfo/info/info.1
@@ -0,0 +1,229 @@
+.TH info 1 "7th December 1990"
+.SH NAME
+info \- GNU's hypertext system
+.SH SYNOPSIS
+.B info
+[
+.B \-\-option-name option-value
+]
+.B \menu-item...
+.SH COPYRIGHT
+.if n Copyright (C) 1989, 1993 Free Software Foundation, Inc.
+.if t Copyright \(co 1989, 1993 Free Software Foundation, Inc.
+.SH DESCRIPTION
+.LP
+The GNU project has a hypertext system called
+.I Info
+which allows the same source file to be either printed as a
+paper manual, or viewed using
+.B info.
+It is possible to use the
+.B info
+program from inside Emacs, or to use the stand-alone version described here.
+This manual page gives a brief summary of its capabilities.
+
+.SH OPTIONS
+.TP
+.B \-\-directory directory-path
+Add
+.B directory-path
+to the list of directory paths searched when
+.B info
+needs to find a file. You may issue
+.B \-\-directory
+multiple times.
+Alternatively, you may specify a value for the environment variable
+.B INFOPATH;
+if
+.B \-\-directory
+is not given, the value of
+.B INFOPATH
+is used. The value of
+.B INFOPATH
+is a colon separated list of directory names. If you do not supply either
+.B INFOPATH
+or
+.B \-\-directory-path,
+.B info
+uses a default path.
+.TP
+.B \-f filename
+Specify a particular
+.B info
+file to visit. By default,
+.B info
+visits
+the file
+.B dir;
+if you use this option,
+.B info
+will start with
+.B (FILENAME)Top
+as the first file and node.
+.TP
+.B \-n nodename
+Specify a particular node to visit in the initial file that
+.B info
+loads. This is especially useful in conjunction with
+.B \-\-file.
+You may specify
+.B \-\-node
+multiple times.
+.TP
+.B -o file
+Direct output to
+.B file
+instead of starting an interactive
+.B info
+session.
+.TP
+.B \-h
+Produce a relatively brief description of the available
+.B info
+options.
+.TP
+.B \-\-version
+Print the version information of
+.B info
+and exit.
+.TP
+.B menu-item
+.B info
+treats its remaining arguments as the names of menu items.
+The first argument is a menu item in the initial node visited,
+while the second argument is a menu item in the first argument's
+node. You can easily move to the node of your choice by
+specifying the menu names which describe the path to that node.
+For example,
+
+.B info emacs buffers
+
+first selects the menu item
+.B emacs
+in the node
+.B (dir)Top,
+and then selects the menu item
+.B buffers
+in the node
+.B (emacs)Top.
+.SH COMMANDS
+When in
+.B info
+the following commands are available:
+.TP
+.B h
+Invoke the Info tutorial.
+.TP
+.B ?
+Get a short summary of
+.B info
+commands.
+.TP
+.B h
+Select the
+.B info
+node from the main directory; this is much more complete than just
+using
+.B ?.
+.TP
+.B Ctrl-g
+Abort whatever you are doing.
+.TP
+.B Ctrl-l
+Redraw the screen.
+.PP
+Selecting other nodes:
+.TP
+.B n
+Move to the "next" node of this node.
+.TP
+.B p
+Move to the "previous" node of this node.
+.TP
+.B u
+Move to this node's "up" node.
+.TP
+.B m
+Pick a menu item specified by name. Picking a menu item causes another
+node to be selected. You do not need to type a complete nodename; if
+you type a few letters and then a space or tab
+.B info
+will will try to fill in the rest of the nodename. If you ask for further
+completion without typing any more characters you'll be given a list
+of possibilities; you can also get the list with
+.B ?.
+If you type a few characters and then hit return
+.B info
+will try to do a completion, and if it is ambigous use the first possibility.
+.TP
+.B f
+Follow a cross reference. You are asked for the name of the reference,
+using command completion as for
+.B m.
+.TP
+.B l
+Move to the last node you were at.
+.PP
+Moving within a node:
+.TP
+.B Space
+Scroll forward a page.
+.TP
+.B DEL
+Scroll backward a page.
+.TP
+.B b
+Go to the beginning of this node.
+.PP
+Advanced commands:
+.TP
+.B q
+Quit
+.B info.
+.TP
+.B 1
+Pick first item in node's menu.
+.TP
+.B 2 \-\- 5
+Pick second ... fifth item in node's menu.
+.TP
+.B g
+Move to node specified by name. You may include a filename as well,
+as
+.B (FILENAME)NODENAME.
+.TP
+.B s
+Search through this
+.B info
+file for a specified string, and select the node in which
+the next occurrence is found.
+.TP
+.B M-x print-node
+Pipe the contents of the current node through the command in the
+environment variable
+.B INFO_PRINT_COMMAND.
+If the variable does not exist, the node is simply piped to
+.B lpr.
+.SH ENVIRONMENT
+.TP
+.B INFOPATH
+A colon-separated list of directories to search for
+.B info
+files. Used if
+.B \-\-directory
+is not given.
+.TP
+.B INFO_PRINT_COMMAND
+The command used for printing.
+.SH SEE ALSO
+.BR emacs (1)
+.SH AUTHOR
+.RS
+Brian Fox, Free Software Foundation
+.br
+bfox@ai.mit.edu
+.SH MANUAL AUTHOR
+.RS
+Robert Lupton; updated by Robert J. Chassell.
+.br
+rhl@astro.princeton.edu; bob@gnu.ai.mit.edu
diff --git a/texinfo/info/info.c b/texinfo/info/info.c
new file mode 100644
index 00000000000..223df55acb2
--- /dev/null
+++ b/texinfo/info/info.c
@@ -0,0 +1,565 @@
+/* info.c -- Display nodes of Info files in multiple windows. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+#include "dribble.h"
+#include "getopt.h"
+#if defined (HANDLE_MAN_PAGES)
+# include "man.h"
+#endif /* HANDLE_MAN_PAGES */
+
+/* The version numbers of this version of Info. */
+int info_major_version = 2;
+int info_minor_version = 16;
+int info_patch_level = 0;
+
+/* Non-zero means search all indices for APROPOS_SEARCH_STRING. */
+static int apropos_p = 0;
+
+/* Variable containing the string to search for when apropos_p is non-zero. */
+static char *apropos_search_string = (char *)NULL;
+
+/* Non-zero means print version info only. */
+static int print_version_p = 0;
+
+/* Non-zero means print a short description of the options. */
+static int print_help_p = 0;
+
+/* Array of the names of nodes that the user specified with "--node" on the
+ command line. */
+static char **user_nodenames = (char **)NULL;
+static int user_nodenames_index = 0;
+static int user_nodenames_slots = 0;
+
+/* String specifying the first file to load. This string can only be set
+ by the user specifying "--file" on the command line. */
+static char *user_filename = (char *)NULL;
+
+/* String specifying the name of the file to dump nodes to. This value is
+ filled if the user speficies "--output" on the command line. */
+static char *user_output_filename = (char *)NULL;
+
+/* Non-zero indicates that when "--output" is specified, all of the menu
+ items of the specified nodes (and their subnodes as well) should be
+ dumped in the order encountered. This basically can print a book. */
+int dump_subnodes = 0;
+
+/* Structure describing the options that Info accepts. We pass this structure
+ to getopt_long (). If you add or otherwise change this structure, you must
+ also change the string which follows it. */
+#define APROPOS_OPTION 1
+#define DRIBBLE_OPTION 2
+#define RESTORE_OPTION 3
+static struct option long_options[] = {
+ { "apropos", 1, 0, APROPOS_OPTION },
+ { "directory", 1, 0, 'd' },
+ { "node", 1, 0, 'n' },
+ { "file", 1, 0, 'f' },
+ { "subnodes", 0, &dump_subnodes, 1 },
+ { "output", 1, 0, 'o' },
+ { "help", 0, &print_help_p, 1 },
+ { "version", 0, &print_version_p, 1 },
+ { "dribble", 1, 0, DRIBBLE_OPTION },
+ { "restore", 1, 0, RESTORE_OPTION },
+ {NULL, 0, NULL, 0}
+};
+
+/* String describing the shorthand versions of the long options found above. */
+static char *short_options = "d:n:f:o:s";
+
+/* When non-zero, the Info window system has been initialized. */
+int info_windows_initialized_p = 0;
+
+/* Some "forward" declarations. */
+static void usage (), info_short_help (), remember_info_program_name ();
+
+
+/* **************************************************************** */
+/* */
+/* Main Entry Point to the Info Program */
+/* */
+/* **************************************************************** */
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ int getopt_long_index; /* Index returned by getopt_long (). */
+ NODE *initial_node; /* First node loaded by Info. */
+
+ remember_info_program_name (argv[0]);
+
+ while (1)
+ {
+ int option_character;
+
+ option_character = getopt_long
+ (argc, argv, short_options, long_options, &getopt_long_index);
+
+ /* getopt_long () returns EOF when there are no more long options. */
+ if (option_character == EOF)
+ break;
+
+ /* If this is a long option, then get the short version of it. */
+ if (option_character == 0 && long_options[getopt_long_index].flag == 0)
+ option_character = long_options[getopt_long_index].val;
+
+ /* Case on the option that we have received. */
+ switch (option_character)
+ {
+ case 0:
+ break;
+
+ /* User wants to add a directory. */
+ case 'd':
+ info_add_path (optarg, INFOPATH_PREPEND);
+ break;
+
+ /* User is specifying a particular node. */
+ case 'n':
+ add_pointer_to_array (optarg, user_nodenames_index, user_nodenames,
+ user_nodenames_slots, 10, char *);
+ break;
+
+ /* User is specifying a particular Info file. */
+ case 'f':
+ if (user_filename)
+ free (user_filename);
+
+ user_filename = strdup (optarg);
+ break;
+
+ /* User is specifying the name of a file to output to. */
+ case 'o':
+ if (user_output_filename)
+ free (user_output_filename);
+ user_output_filename = strdup (optarg);
+ break;
+
+ /* User is specifying that she wishes to dump the subnodes of
+ the node that she is dumping. */
+ case 's':
+ dump_subnodes = 1;
+ break;
+
+ /* User has specified a string to search all indices for. */
+ case APROPOS_OPTION:
+ apropos_p = 1;
+ maybe_free (apropos_search_string);
+ apropos_search_string = strdup (optarg);
+ break;
+
+ /* User has specified a dribble file to receive keystrokes. */
+ case DRIBBLE_OPTION:
+ close_dribble_file ();
+ open_dribble_file (optarg);
+ break;
+
+ /* User has specified an alternate input stream. */
+ case RESTORE_OPTION:
+ info_set_input_from_file (optarg);
+ break;
+
+ default:
+ usage ();
+ }
+ }
+
+ /* If the output device is not a terminal, and no output filename has been
+ specified, make user_output_filename be "-", so that the info is written
+ to stdout, and turn on the dumping of subnodes. */
+ if ((!isatty (fileno (stdout))) && (user_output_filename == (char *)NULL))
+ {
+ user_output_filename = strdup ("-");
+ dump_subnodes = 1;
+ }
+
+ /* If the user specified --version, then show the version and exit. */
+ if (print_version_p)
+ {
+ printf ("GNU Info (Texinfo 3.9) %s\n", version_string ());
+ puts ("Copyright (C) 1996 Free Software Foundation, Inc.\n\
+There is NO warranty. You may redistribute this software\n\
+under the terms of the GNU General Public License.\n\
+For more information about these matters, see the files named COPYING.");
+ exit (0);
+ }
+
+ /* If the `--help' option was present, show the help and exit. */
+ if (print_help_p)
+ {
+ info_short_help ();
+ exit (0);
+ }
+
+ /* If the user hasn't specified a path for Info files, default that path
+ now. */
+ if (!infopath)
+ {
+ char *path_from_env, *getenv ();
+
+ path_from_env = getenv ("INFOPATH");
+
+ if (path_from_env)
+ info_add_path (path_from_env, INFOPATH_PREPEND);
+ else
+ info_add_path (DEFAULT_INFOPATH, INFOPATH_PREPEND);
+ }
+
+ /* If the user specified a particular filename, add the path of that
+ file to the contents of INFOPATH. */
+ if (user_filename)
+ {
+ char *directory_name, *temp;
+
+ directory_name = strdup (user_filename);
+ temp = filename_non_directory (directory_name);
+
+ if (temp != directory_name)
+ {
+ *temp = 0;
+ info_add_path (directory_name, INFOPATH_PREPEND);
+ }
+
+ free (directory_name);
+ }
+
+ /* If the user wants to search every known index for a given string,
+ do that now, and report the results. */
+ if (apropos_p)
+ {
+ info_apropos (apropos_search_string);
+ exit (0);
+ }
+
+ /* Get the initial Info node. It is either "(dir)Top", or what the user
+ specifed with values in user_filename and user_nodenames. */
+ if (user_nodenames)
+ initial_node = info_get_node (user_filename, user_nodenames[0]);
+ else
+ initial_node = info_get_node (user_filename, (char *)NULL);
+
+ /* If we couldn't get the initial node, this user is in trouble. */
+ if (!initial_node)
+ {
+ if (info_recent_file_error)
+ info_error (info_recent_file_error);
+ else
+ info_error
+ (CANT_FIND_NODE, user_nodenames ? user_nodenames[0] : "Top");
+ exit (1);
+ }
+
+ /* Special cases for when the user specifies multiple nodes. If we are
+ dumping to an output file, dump all of the nodes specified. Otherwise,
+ attempt to create enough windows to handle the nodes that this user wants
+ displayed. */
+ if (user_nodenames_index > 1)
+ {
+ free (initial_node);
+
+ if (user_output_filename)
+ dump_nodes_to_file
+ (user_filename, user_nodenames, user_output_filename, dump_subnodes);
+ else
+ begin_multiple_window_info_session (user_filename, user_nodenames);
+
+ exit (0);
+ }
+
+ /* If there are arguments remaining, they are the names of menu items
+ in sequential info files starting from the first one loaded. That
+ file name is either "dir", or the contents of user_filename if one
+ was specified. */
+ while (optind != argc)
+ {
+ REFERENCE **menu;
+ REFERENCE *entry;
+ NODE *node;
+ char *arg;
+ static char *first_arg = (char *)NULL;
+
+ /* Remember the name of the menu entry we want. */
+ arg = argv[optind++];
+
+ if (first_arg == (char *)NULL)
+ first_arg = arg;
+
+ /* Build and return a list of the menu items in this node. */
+ menu = info_menu_of_node (initial_node);
+
+ /* If there wasn't a menu item in this node, stop here, but let
+ the user continue to use Info. Perhaps they wanted this node
+ and didn't realize it. */
+ if (!menu)
+ {
+#if defined (HANDLE_MAN_PAGES)
+ if (first_arg == arg)
+ {
+ node = make_manpage_node (first_arg);
+ if (node)
+ goto maybe_got_node;
+ }
+#endif /* HANDLE_MAN_PAGES */
+ begin_info_session_with_error
+ (initial_node, "There is no menu in this node.");
+ exit (0);
+ }
+
+ /* Find the specified menu item. */
+ entry = info_get_labeled_reference (arg, menu);
+
+ /* If the item wasn't found, search the list sloppily. Perhaps this
+ user typed "buffer" when they really meant "Buffers". */
+ if (!entry)
+ {
+ register int i;
+ int best_guess = -1;
+
+ for (i = 0; entry = menu[i]; i++)
+ {
+ if (strcasecmp (entry->label, arg) == 0)
+ break;
+ else
+ if (strncasecmp (entry->label, arg, strlen (arg)) == 0)
+ best_guess = i;
+ }
+
+ if (!entry && best_guess != -1)
+ entry = menu[best_guess];
+ }
+
+ /* If we failed to find the reference, start Info with the current
+ node anyway. It is probably a misspelling. */
+ if (!entry)
+ {
+ char *error_message = "There is no menu item \"%s\" in this node.";
+
+#if defined (HANDLE_MAN_PAGES)
+ if (first_arg == arg)
+ {
+ node = make_manpage_node (first_arg);
+ if (node)
+ goto maybe_got_node;
+ }
+#endif /* HANDLE_MAN_PAGES */
+
+ info_free_references (menu);
+
+ /* If we were supposed to dump this node, complain. */
+ if (user_output_filename)
+ info_error (error_message, arg);
+ else
+ begin_info_session_with_error (initial_node, error_message, arg);
+
+ exit (0);
+ }
+
+ /* We have found the reference that the user specified. Clean it
+ up a little bit. */
+ if (!entry->filename)
+ {
+ if (initial_node->parent)
+ entry->filename = strdup (initial_node->parent);
+ else
+ entry->filename = strdup (initial_node->filename);
+ }
+
+ /* Find this node. If we can find it, then turn the initial_node
+ into this one. If we cannot find it, try using the label of the
+ entry as a file (i.e., "(LABEL)Top"). Otherwise the Info file is
+ malformed in some way, and we will just use the current value of
+ initial node. */
+ node = info_get_node (entry->filename, entry->nodename);
+
+#if defined (HANDLE_MAN_PAGES)
+ if ((first_arg == arg) && !node)
+ {
+ node = make_manpage_node (first_arg);
+ if (node)
+ goto maybe_got_node;
+ }
+#endif /* HANDLE_MAN_PAGES */
+
+ if (!node && entry->nodename &&
+ (strcmp (entry->label, entry->nodename) == 0))
+ node = info_get_node (entry->label, "Top");
+
+ maybe_got_node:
+ if (node)
+ {
+ free (initial_node);
+ initial_node = node;
+ info_free_references (menu);
+ }
+ else
+ {
+ char *temp = strdup (entry->label);
+ char *error_message;
+
+ error_message = "Unable to find the node referenced by \"%s\".";
+
+ info_free_references (menu);
+
+ /* If we were trying to dump the node, then give up. Otherwise,
+ start the session with an error message. */
+ if (user_output_filename)
+ info_error (error_message, temp);
+ else
+ begin_info_session_with_error (initial_node, error_message, temp);
+
+ exit (0);
+ }
+ }
+
+ /* If the user specified that this node should be output, then do that
+ now. Otherwise, start the Info session with this node. */
+ if (user_output_filename)
+ dump_node_to_file (initial_node, user_output_filename, dump_subnodes);
+ else
+ begin_info_session (initial_node);
+
+ exit (0);
+}
+
+/* Return a string describing the current version of Info. */
+char *
+version_string ()
+{
+ static char *vstring = (char *)NULL;
+
+ if (!vstring)
+ {
+ vstring = (char *)xmalloc (50);
+ sprintf (vstring, "%d.%d", info_major_version, info_minor_version);
+ if (info_patch_level)
+ sprintf (vstring + strlen (vstring), "-p%d", info_patch_level);
+ }
+ return (vstring);
+}
+
+/* **************************************************************** */
+/* */
+/* Error Handling for Info */
+/* */
+/* **************************************************************** */
+
+static char *program_name = (char *)NULL;
+
+static void
+remember_info_program_name (fullpath)
+ char *fullpath;
+{
+ char *filename;
+
+ filename = filename_non_directory (fullpath);
+ program_name = strdup (filename);
+}
+
+/* Non-zero if an error has been signalled. */
+int info_error_was_printed = 0;
+
+/* Non-zero means ring terminal bell on errors. */
+int info_error_rings_bell_p = 1;
+
+/* Print FORMAT with ARG1 and ARG2. If the window system was initialized,
+ then the message is printed in the echo area. Otherwise, a message is
+ output to stderr. */
+void
+info_error (format, arg1, arg2)
+ char *format;
+ void *arg1, *arg2;
+{
+ info_error_was_printed = 1;
+
+ if (!info_windows_initialized_p || display_inhibited)
+ {
+ fprintf (stderr, "%s: ", program_name);
+ fprintf (stderr, format, arg1, arg2);
+ fprintf (stderr, "\n");
+ fflush (stderr);
+ }
+ else
+ {
+ if (!echo_area_is_active)
+ {
+ if (info_error_rings_bell_p)
+ terminal_ring_bell ();
+ window_message_in_echo_area (format, arg1, arg2);
+ }
+ else
+ {
+ NODE *temp;
+
+ temp = build_message_node (format, arg1, arg2);
+ if (info_error_rings_bell_p)
+ terminal_ring_bell ();
+ inform_in_echo_area (temp->contents);
+ free (temp->contents);
+ free (temp);
+ }
+ }
+}
+
+/* Produce a very brief descripton of the available options and exit with
+ an error. */
+static void
+usage ()
+{
+ fprintf (stderr,"%s\n%s\n%s\n%s\n%s\n",
+"Usage: info [-d dir-path] [-f info-file] [-o output-file] [-n node-name]...",
+" [--directory dir-path] [--file info-file] [--node node-name]...",
+" [--help] [--output output-file] [--subnodes] [--version]",
+" [--dribble dribble-file] [--restore from-file]",
+" [menu-selection ...]");
+ exit (1);
+}
+
+/* Produce a scaled down description of the available options to Info. */
+static void
+info_short_help ()
+{
+ puts ("\
+Here is a quick description of Info's options. For a more complete\n\
+description of how to use Info, type `info info options'.\n\
+\n\
+ --directory DIR Add DIR to INFOPATH.\n\
+ --dribble FILENAME Remember user keystrokes in FILENAME.\n\
+ --file FILENAME Specify Info file to visit.\n\
+ --node NODENAME Specify nodes in first visited Info file.\n\
+ --output FILENAME Output selected nodes to FILENAME.\n\
+ --restore FILENAME Read initial keystrokes from FILENAME.\n\
+ --subnodes Recursively output menu items.\n\
+ --help Get this help message.\n\
+ --version Display Info's version information.\n\
+\n\
+Remaining arguments to Info are treated as the names of menu\n\
+items in the initial node visited. You can easily move to the\n\
+node of your choice by specifying the menu names which describe\n\
+the path to that node. For example, `info emacs buffers'.\n\
+\n\
+Email bug reports to bug-texinfo@prep.ai.mit.edu.");
+
+ exit (0);
+}
diff --git a/texinfo/info/info.h b/texinfo/info/info.h
new file mode 100644
index 00000000000..a8759227758
--- /dev/null
+++ b/texinfo/info/info.h
@@ -0,0 +1,100 @@
+/* info.h -- Header file which includes all of the other headers. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_INFO_H_)
+#define _INFO_H_
+
+#include <stdio.h>
+#include <ctype.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#if defined (HAVE_STRING_H)
+#include <string.h>
+#endif /* HAVE_STRING_H */
+#include "filesys.h"
+#include "display.h"
+#include "session.h"
+#include "echo_area.h"
+#include "doc.h"
+#include "footnotes.h"
+#include "gc.h"
+
+/* A structure associating the nodes visited in a particular window. */
+typedef struct {
+ WINDOW *window; /* The window that this list is attached to. */
+ NODE **nodes; /* Array of nodes visited in this window. */
+ int *pagetops; /* For each node in NODES, the pagetop. */
+ long *points; /* For each node in NODES, the point. */
+ int current; /* Index in NODES of the current node. */
+ int nodes_index; /* Index where to add the next node. */
+ int nodes_slots; /* Number of slots allocated to NODES. */
+} INFO_WINDOW;
+
+/* Array of structures describing for each window which nodes have been
+ visited in that window. */
+extern INFO_WINDOW **info_windows;
+
+/* For handling errors. If you initialize the window system, you should
+ also set info_windows_initialized_p to non-zero. It is used by the
+ info_error () function to determine how to format and output errors. */
+extern int info_windows_initialized_p;
+
+/* Non-zero if an error message has been printed. */
+extern int info_error_was_printed;
+
+/* Non-zero means ring terminal bell on errors. */
+extern int info_error_rings_bell_p;
+
+/* Print FORMAT with ARG1 and ARG2. If the window system was initialized,
+ then the message is printed in the echo area. Otherwise, a message is
+ output to stderr. */
+extern void info_error ();
+
+/* The version numbers of Info. */
+extern int info_major_version, info_minor_version, info_patch_level;
+
+/* How to get the version string for this version of Info. Returns
+ something similar to "2.11". */
+extern char *version_string ();
+
+/* Error message defines. */
+#define CANT_FIND_NODE "Cannot find the node \"%s\"."
+#define CANT_FILE_NODE "Cannot find the node \"(%s)%s\"."
+#define CANT_FIND_WIND "Cannot find a window!"
+#define CANT_FIND_POINT "Point doesn't appear within this window's node!"
+#define CANT_KILL_LAST "Cannot delete the last window."
+#define NO_MENU_NODE "No menu in this node."
+#define NO_FOOT_NODE "No footnotes in this node."
+#define NO_XREF_NODE "No cross references in this node."
+#define NO_POINTER "No \"%s\" pointer for this node."
+#define UNKNOWN_COMMAND "Unknown Info command `%c'. `?' for help."
+#define TERM_TOO_DUMB "Terminal type \"%s\" is not smart enough to run Info."
+#define AT_NODE_BOTTOM "You are already at the last page of this node."
+#define AT_NODE_TOP "You are already at the first page of this node."
+#define ONE_WINDOW "Only one window."
+#define WIN_TOO_SMALL "Resulting window would be too small."
+#define CANT_MAKE_HELP \
+"There isn't enough room to make a help window. Please delete a window."
+
+#endif /* !_INFO_H_ */
+
diff --git a/texinfo/info/info.texi b/texinfo/info/info.texi
new file mode 100644
index 00000000000..efc3077e339
--- /dev/null
+++ b/texinfo/info/info.texi
@@ -0,0 +1,929 @@
+\input texinfo @c -*-texinfo-*-
+@comment %**start of header
+@setfilename info.info
+@settitle Info 1.0
+@comment %**end of header
+@comment $Id: info.texi,v 1.1 1997/08/21 22:58:02 jason Exp $
+
+@ifinfo
+@c This is a dir.info fragment to support semi-automated addition of
+@c manuals to an info tree.
+@format
+START-INFO-DIR-ENTRY
+* info: (info). Reading GNU online documentation.
+END-INFO-DIR-ENTRY
+@end format
+@end ifinfo
+
+@iftex
+@finalout
+@end iftex
+@dircategory Texinfo documentation system
+@direntry
+* Info: (info). Documentation browsing system.
+@end direntry
+
+@ifinfo
+This file describes how to use Info,
+the on-line, menu-driven GNU documentation system.
+
+Copyright (C) 1989, 92, 96 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@end ifinfo
+
+@titlepage
+@sp 11
+@center @titlefont{Info}
+@sp 2
+@center The
+@sp 2
+@center On-line, Menu-driven
+@sp 2
+@center GNU Documentation System
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1989, 1992, 1993 Free Software Foundation, Inc.
+@sp 2
+
+Published by the Free Software Foundation @*
+59 Temple Place - Suite 330 @*
+Boston, MA 02111-1307, USA.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@end titlepage
+
+@ifinfo
+@node Top, Getting Started, (dir), (dir)
+@top Info: An Introduction
+
+Info is a program for reading documentation, which you are using now.
+
+To learn how to use Info, type the command @kbd{h}. It brings you
+to a programmed instruction sequence.
+
+@c Need to make sure that `Info-help' goes to the right node,
+@c which is the first node of the first chapter. (It should.)
+@c (Info-find-node "info"
+@c (if (< (window-height) 23)
+@c "Help-Small-Screen"
+@c "Help")))
+
+To learn advanced Info commands, type @kbd{n} twice. This brings you to
+@cite{Info for Experts}, skipping over the `Getting Started' chapter.
+@end ifinfo
+
+@menu
+* Getting Started:: Getting started using an Info reader.
+* Advanced Info:: Advanced commands within Info.
+* Create an Info File:: How to make your own Info file.
+* The Standalone Info Program: (info-stnd.info).
+@end menu
+
+@node Getting Started, Advanced Info, Top, Top
+@comment node-name, next, previous, up
+@chapter Getting Started
+
+This first part of the Info manual describes how to get around inside
+of Info. The second part of the manual describes various advanced
+Info commands, and how to write an Info as distinct from a Texinfo
+file. The third part is about how to generate Info files from
+Texinfo files.
+
+@iftex
+This manual is primarily designed for use on a computer, so that you can
+try Info commands while reading about them. Reading it on paper is less
+effective, since you must take it on faith that the commands described
+really do what the manual says. By all means go through this manual now
+that you have it; but please try going through the on-line version as
+well.
+
+There are two ways of looking at the online version of this manual:
+
+@enumerate
+@item
+Type @code{info} at your shell's command line. This approach uses a
+small stand-alone program designed just to read Info files.
+
+@item
+Type @code{emacs} at the command line; then type @kbd{C-h i} (Control
+@kbd{h}, followed by @kbd{i}). This approach uses the Info mode of the
+Emacs program, an editor with many other capabilities.
+@end enumerate
+
+In either case, then type @kbd{mInfo} (just the letters), followed by
+@key{RET}---the ``Return'' or ``Enter'' key. At this point, you should
+be ready to follow the instructions in this manual as you read them on
+the screen.
+@c FIXME! (pesch@cygnus.com, 14 dec 1992)
+@c Is it worth worrying about what-if the beginner goes to somebody
+@c else's Emacs session, which already has an Info running in the middle
+@c of something---in which case these simple instructions won't work?
+@end iftex
+
+@menu
+* Help-Small-Screen:: Starting Info on a Small Screen
+* Help:: How to use Info
+* Help-P:: Returning to the Previous node
+* Help-^L:: The Space, Rubout, B and ^L commands.
+* Help-M:: Menus
+* Help-Adv:: Some advanced Info commands
+* Help-Q:: Quitting Info
+@end menu
+
+@node Help-Small-Screen, Help, , Getting Started
+@comment node-name, next, previous, up
+@section Starting Info on a Small Screen
+
+@iftex
+(In Info, you only see this section if your terminal has a small
+number of lines; most readers pass by it without seeing it.)
+@end iftex
+
+Since your terminal has an unusually small number of lines on its
+screen, it is necessary to give you special advice at the beginning.
+
+If you see the text @samp{--All----} at near the bottom right corner
+of the screen, it means the entire text you are looking at fits on the
+screen. If you see @samp{--Top----} instead, it means that there is
+more text below that does not fit. To move forward through the text
+and see another screen full, press the Space bar, @key{SPC}. To move
+back up, press the key labeled @samp{Backspace} or @key{Delete}.
+
+@ifinfo
+Here are 40 lines of junk, so you can try Spaces and Deletes and
+see what they do. At the end are instructions of what you should do
+next.
+
+This is line 17 @*
+This is line 18 @*
+This is line 19 @*
+This is line 20 @*
+This is line 21 @*
+This is line 22 @*
+This is line 23 @*
+This is line 24 @*
+This is line 25 @*
+This is line 26 @*
+This is line 27 @*
+This is line 28 @*
+This is line 29 @*
+This is line 30 @*
+This is line 31 @*
+This is line 32 @*
+This is line 33 @*
+This is line 34 @*
+This is line 35 @*
+This is line 36 @*
+This is line 37 @*
+This is line 38 @*
+This is line 39 @*
+This is line 40 @*
+This is line 41 @*
+This is line 42 @*
+This is line 43 @*
+This is line 44 @*
+This is line 45 @*
+This is line 46 @*
+This is line 47 @*
+This is line 48 @*
+This is line 49 @*
+This is line 50 @*
+This is line 51 @*
+This is line 52 @*
+This is line 53 @*
+This is line 54 @*
+This is line 55 @*
+This is line 56 @*
+
+If you have managed to get here, go back to the beginning with
+Delete, and come back here again, then you understand Space and
+Delete. So now type an @kbd{n} ---just one character; don't type
+the quotes and don't type the Return key afterward--- to
+get to the normal start of the course.
+@end ifinfo
+
+@node Help, Help-P, Help-Small-Screen, Getting Started
+@comment node-name, next, previous, up
+@section How to use Info
+
+You are talking to the program Info, for reading documentation.
+
+ Right now you are looking at one @dfn{Node} of Information.
+A node contains text describing a specific topic at a specific
+level of detail. This node's topic is ``how to use Info''.
+
+ The top line of a node is its @dfn{header}. This node's header (look at
+it now) says that it is the node named @samp{Help} in the file
+@file{info}. It says that the @samp{Next} node after this one is the node
+called @samp{Help-P}. An advanced Info command lets you go to any node
+whose name you know.
+
+ Besides a @samp{Next}, a node can have a @samp{Previous} or an @samp{Up}.
+This node has a @samp{Previous} but no @samp{Up}, as you can see.
+
+ Now it is time to move on to the @samp{Next} node, named @samp{Help-P}.
+
+>> Type @samp{n} to move there. Type just one character;
+ do not type the quotes and do not type a @key{RET} afterward.
+
+@samp{>>} in the margin means it is really time to try a command.
+
+@node Help-P, Help-^L, Help, Getting Started
+@comment node-name, next, previous, up
+@section Returning to the Previous node
+
+This node is called @samp{Help-P}. The @samp{Previous} node, as you see,
+is @samp{Help}, which is the one you just came from using the @kbd{n}
+command. Another @kbd{n} command now would take you to the next
+node, @samp{Help-^L}.
+
+>> But do not do that yet. First, try the @kbd{p} command, which takes
+ you to the @samp{Previous} node. When you get there, you can do an
+ @kbd{n} again to return here.
+
+ This all probably seems insultingly simple so far, but @emph{do not} be
+led into skimming. Things will get more complicated soon. Also,
+do not try a new command until you are told it is time to. Otherwise,
+you may make Info skip past an important warning that was coming up.
+
+>> Now do an @kbd{n} to get to the node @samp{Help-^L} and learn more.
+
+@node Help-^L, Help-M, Help-P, Getting Started
+@comment node-name, next, previous, up
+@section The Space, Delete, B and ^L commands.
+
+ This node's header tells you that you are now at node @samp{Help-^L}, and
+that @kbd{p} would get you back to @samp{Help-P}. The node's title is
+underlined; it says what the node is about (most nodes have titles).
+
+ This is a big node and it does not all fit on your display screen.
+You can tell that there is more that is not visible because you
+can see the string @samp{--Top-----} rather than @samp{--All----} near
+the bottom right corner of the screen.
+
+ The Space, Delete and @kbd{B} commands exist to allow you to ``move
+around'' in a node that does not all fit on the screen at once.
+Space moves forward, to show what was below the bottom of the screen.
+Delete moves backward, to show what was above the top of the screen
+(there is not anything above the top until you have typed some spaces).
+
+>> Now try typing a Space (afterward, type a Delete to return here).
+
+ When you type the space, the two lines that were at the bottom of
+the screen appear at the top, followed by more lines. Delete takes
+the two lines from the top and moves them to the bottom,
+@emph{usually}, but if there are not a full screen's worth of lines
+above them they may not make it all the way to the bottom.
+
+ If you type Space when there is no more to see, it rings the
+bell and otherwise does nothing. The same goes for Delete when
+the header of the node is visible.
+
+ If your screen is ever garbaged, you can tell Info to print it out
+again by typing @kbd{C-l} (@kbd{Control-L}, that is---hold down ``Control'' and
+type an @key{L} or @kbd{l}).
+
+>> Type @kbd{C-l} now.
+
+ To move back to the beginning of the node you are on, you can type
+a lot of Deletes. You can also type simply @kbd{b} for beginning.
+>> Try that now. (We have put in enough verbiage to push this past
+the first screenful, but screens are so big nowadays that perhaps it
+isn't enough. You may need to shrink your Emacs or Info window.)
+Then come back, with Spaces.
+
+ If your screen is very tall, all of this node might fit at once.
+In that case, "b" won't do anything. Sorry; what can we do?
+
+ You have just learned a considerable number of commands. If you
+want to use one but have trouble remembering which, you should type
+a @key{?} which prints out a brief list of commands. When you are
+finished looking at the list, make it go away by typing a @key{SPC}.
+
+>> Type a @key{?} now. After it finishes, type a @key{SPC}.
+
+ (If you are using the standalone Info reader, type `l' to return here.)
+
+ From now on, you will encounter large nodes without warning, and
+will be expected to know how to use Space and Delete to move
+around in them without being told. Since not all terminals have
+the same size screen, it would be impossible to warn you anyway.
+
+>> Now type @kbd{n} to see the description of the @kbd{m} command.
+
+@node Help-M, Help-Adv, Help-^L, Getting Started
+@comment node-name, next, previous, up
+@section Menus
+
+Menus and the @kbd{m} command
+
+ With only the @kbd{n} and @kbd{p} commands for moving between nodes, nodes
+are restricted to a linear sequence. Menus allow a branching
+structure. A menu is a list of other nodes you can move to. It is
+actually just part of the text of the node formatted specially so that
+Info can interpret it. The beginning of a menu is always identified
+by a line which starts with @samp{* Menu:}. A node contains a menu if and
+only if it has a line in it which starts that way. The only menu you
+can use at any moment is the one in the node you are in. To use a
+menu in any other node, you must move to that node first.
+
+ After the start of the menu, each line that starts with a @samp{*}
+identifies one subtopic. The line usually contains a brief name
+for the subtopic (followed by a @samp{:}), the name of the node that talks
+about that subtopic, and optionally some further description of the
+subtopic. Lines in the menu that do not start with a @samp{*} have no
+special meaning---they are only for the human reader's benefit and do
+not define additional subtopics. Here is an example:
+
+@example
+* Foo: FOO's Node This tells about FOO
+@end example
+
+The subtopic name is Foo, and the node describing it is @samp{FOO's Node}.
+The rest of the line is just for the reader's Information.
+[[ But this line is not a real menu item, simply because there is
+no line above it which starts with @samp{* Menu:}.]]
+
+ When you use a menu to go to another node (in a way that will be
+described soon), what you specify is the subtopic name, the first
+thing in the menu line. Info uses it to find the menu line, extracts
+the node name from it, and goes to that node. The reason that there
+is both a subtopic name and a node name is that the node name must be
+meaningful to the computer and may therefore have to be ugly looking.
+The subtopic name can be chosen just to be convenient for the user to
+specify. Often the node name is convenient for the user to specify
+and so both it and the subtopic name are the same. There is an
+abbreviation for this:
+
+@example
+* Foo:: This tells about FOO
+@end example
+
+@noindent
+This means that the subtopic name and node name are the same; they are
+both @samp{Foo}.
+
+>> Now use Spaces to find the menu in this node, then come back to
+ the front with a @kbd{b} and some Spaces. As you see, a menu is
+ actually visible in its node. If you cannot find a menu in a node
+ by looking at it, then the node does not have a menu and the
+ @kbd{m} command is not available.
+
+ The command to go to one of the subnodes is @kbd{m}---but @emph{do
+not do it yet!} Before you use @kbd{m}, you must understand the
+difference between commands and arguments. So far, you have learned
+several commands that do not need arguments. When you type one, Info
+processes it and is instantly ready for another command. The @kbd{m}
+command is different: it is incomplete without the @dfn{name of the
+subtopic}. Once you have typed @kbd{m}, Info tries to read the
+subtopic name.
+
+ Now look for the line containing many dashes near the bottom of the
+screen. There is one more line beneath that one, but usually it is
+blank. If it is empty, Info is ready for a command, such as @kbd{n}
+or @kbd{b} or Space or @kbd{m}. If that line contains text ending
+in a colon, it mean Info is trying to read the @dfn{argument} to a
+command. At such times, commands do not work, because Info tries to
+use them as the argument. You must either type the argument and
+finish the command you started, or type @kbd{Control-g} to cancel the
+command. When you have done one of those things, the line becomes
+blank again.
+
+ The command to go to a subnode via a menu is @kbd{m}. After you type
+the @kbd{m}, the line at the bottom of the screen says @samp{Menu item: }.
+You must then type the name of the subtopic you want, and end it with
+a @key{RET}.
+
+ You can abbreviate the subtopic name. If the abbreviation is not
+unique, the first matching subtopic is chosen. Some menus put
+the shortest possible abbreviation for each subtopic name in capital
+letters, so you can see how much you need to type. It does not
+matter whether you use upper case or lower case when you type the
+subtopic. You should not put any spaces at the end, or inside of the
+item name, except for one space where a space appears in the item in
+the menu.
+
+ You can also use the @dfn{completion} feature to help enter the subtopic
+name. If you type the Tab key after entering part of a name, it will
+magically fill in more of the name---as much as follows uniquely from
+what you have entered.
+
+ If you move the cursor to one of the menu subtopic lines, then you do
+not need to type the argument: you just type a Return, and it stands for
+the subtopic of the line you are on.
+
+Here is a menu to give you a chance to practice.
+
+* Menu: The menu starts here.
+
+This menu gives you three ways of going to one place, Help-FOO.
+
+* Foo: Help-FOO. A node you can visit for fun.@*
+* Bar: Help-FOO. Strange! two ways to get to the same place.@*
+* Help-FOO:: And yet another!@*
+
+
+>> Now type just an @kbd{m} and see what happens:
+
+ Now you are ``inside'' an @kbd{m} command. Commands cannot be used
+now; the next thing you will type must be the name of a subtopic.
+
+ You can change your mind about doing the @kbd{m} by typing Control-g.
+
+>> Try that now; notice the bottom line clear.
+
+>> Then type another @kbd{m}.
+
+>> Now type @samp{BAR} item name. Do not type Return yet.
+
+ While you are typing the item name, you can use the Delete key to
+cancel one character at a time if you make a mistake.
+
+>> Type one to cancel the @samp{R}. You could type another @samp{R} to
+ replace it. You do not have to, since @samp{BA} is a valid abbreviation.
+
+>> Now you are ready to go. Type a @key{RET}.
+
+ After visiting Help-FOO, you should return here.
+
+>> Type @kbd{n} to see more commands.
+
+@c If a menu appears at the end of this node, remove it.
+@c It is an accident of the menu updating command.
+
+Here is another way to get to Help-FOO, a menu. You can ignore this
+if you want, or else try it (but then please come back to here).
+
+@menu
+* Help-FOO::
+@end menu
+
+@node Help-FOO, , , Help-M
+@comment node-name, next, previous, up
+@subsection The @kbd{u} command
+
+ Congratulations! This is the node @samp{Help-FOO}. Unlike the other
+nodes you have seen, this one has an @samp{Up}: @samp{Help-M}, the node you
+just came from via the @kbd{m} command. This is the usual
+convention---the nodes you reach from a menu have @samp{Up} nodes that lead
+back to the menu. Menus move Down in the tree, and @samp{Up} moves Up.
+@samp{Previous}, on the other hand, is usually used to ``stay on the same
+level but go backwards''
+
+ You can go back to the node @samp{Help-M} by typing the command
+@kbd{u} for ``Up''. That puts you at the @emph{front} of the
+node---to get back to where you were reading you have to type
+some @key{SPC}s.
+
+>> Now type @kbd{u} to move back up to @samp{Help-M}.
+
+@node Help-Adv, Help-Q, Help-M, Getting Started
+@comment node-name, next, previous, up
+@section Some advanced Info commands
+
+ The course is almost over, so please stick with it to the end.
+
+ If you have been moving around to different nodes and wish to
+retrace your steps, the @kbd{l} command (@kbd{l} for @dfn{last}) will
+do that, one node-step at a time. As you move from node to node, Info
+records the nodes where you have been in a special history list. The
+@kbd{l} command revisits nodes in the history list; each successive
+@kbd{l} command moves one step back through the history.
+
+ If you have been following directions, ad @kbd{l} command now will get
+you back to @samp{Help-M}. Another @kbd{l} command would undo the
+@kbd{u} and get you back to @samp{Help-FOO}. Another @kbd{l} would undo
+the @kbd{m} and get you back to @samp{Help-M}.
+
+>> Try typing three @kbd{l}'s, pausing in between to see what each
+ @kbd{l} does.
+
+Then follow directions again and you will end up back here.
+
+ Note the difference between @kbd{l} and @kbd{p}: @kbd{l} moves to
+where @emph{you} last were, whereas @kbd{p} always moves to the node
+which the header says is the @samp{Previous} node (from this node, to
+@samp{Help-M}).
+
+ The @samp{d} command gets you instantly to the Directory node.
+This node, which is the first one you saw when you entered Info,
+has a menu which leads (directly, or indirectly through other menus),
+to all the nodes that exist.
+
+>> Try doing a @samp{d}, then do an @kbd{l} to return here (yes,
+ @emph{do} return).
+
+ Sometimes, in Info documentation, you will see a cross reference.
+Cross references look like this: @xref{Help-Cross, Cross}. That is a
+real, live cross reference which is named @samp{Cross} and points at
+the node named @samp{Help-Cross}.
+
+ If you wish to follow a cross reference, you must use the @samp{f}
+command. The @samp{f} must be followed by the cross reference name
+(in this case, @samp{Cross}). While you enter the name, you can use the
+Delete key to edit your input. If you change your mind about following
+any reference, you can use @kbd{Control-g} to cancel the command.
+
+ Completion is available in the @samp{f} command; you can complete among
+all the cross reference names in the current node by typing a Tab.
+
+>> Type @samp{f}, followed by @samp{Cross}, and a @key{RET}.
+
+ To get a list of all the cross references in the current node, you can
+type @kbd{?} after an @samp{f}. The @samp{f} continues to await a
+cross reference name even after printing the list, so if you don't
+actually want to follow a reference, you should type a @kbd{Control-g}
+to cancel the @samp{f}.
+
+>> Type "f?" to get a list of the cross references in this node. Then
+ type a @kbd{Control-g} and see how the @samp{f} gives up.
+
+>> Now type @kbd{n} to see the last node of the course.
+
+@c If a menu appears at the end of this node, remove it.
+@c It is an accident of the menu updating command.
+
+@node Help-Cross, , , Help-Adv
+@comment node-name, next, previous, up
+@unnumberedsubsec The node reached by the cross reference in Info
+
+ This is the node reached by the cross reference named @samp{Cross}.
+
+ While this node is specifically intended to be reached by a cross
+reference, most cross references lead to nodes that ``belong''
+someplace else far away in the structure of Info. So you cannot expect
+the footnote to have a @samp{Next}, @samp{Previous} or @samp{Up} pointing back to
+where you came from. In general, the @kbd{l} (el) command is the only
+way to get back there.
+
+>> Type @kbd{l} to return to the node where the cross reference was.
+
+@node Help-Q, , Help-Adv, Getting Started
+@comment node-name, next, previous, up
+@section Quitting Info
+
+ To get out of Info, back to what you were doing before, type @kbd{q}
+for @dfn{Quit}.
+
+ This is the end of the course on using Info. There are some other
+commands that are meant for experienced users; they are useful, and you
+can find them by looking in the directory node for documentation on
+Info. Finding them will be a good exercise in using Info in the usual
+manner.
+
+>> Type @samp{d} to go to the Info directory node; then type
+ @samp{mInfo} and Return, to get to the node about Info and
+ see what other help is available.
+
+@node Advanced Info, Create an Info File, Getting Started, Top
+@comment node-name, next, previous, up
+@chapter Info for Experts
+
+This chapter describes various advanced Info commands, and how to write
+an Info as distinct from a Texinfo file. (However, in most cases, writing a
+Texinfo file is better, since you can use it @emph{both} to generate an
+Info file and to make a printed manual. @xref{Top,, Overview of
+Texinfo, texinfo, Texinfo: The GNU Documentation Format}.)
+
+@menu
+* Expert:: Advanced Info commands: g, s, e, and 1 - 5.
+* Add:: Describes how to add new nodes to the hierarchy.
+ Also tells what nodes look like.
+* Menus:: How to add to or create menus in Info nodes.
+* Cross-refs:: How to add cross-references to Info nodes.
+* Tags:: How to make tag tables for Info files.
+* Checking:: Checking an Info File
+* Emacs Info Variables:: Variables modifying the behavior of Emacs Info.
+@end menu
+
+@node Expert, Add, , Advanced Info
+@comment node-name, next, previous, up
+@section Advanced Info Commands
+
+@kbd{g}, @kbd{s}, @kbd{1}, -- @kbd{9}, and @kbd{e}
+
+If you know a node's name, you can go there by typing @kbd{g}, the
+name, and @key{RET}. Thus, @kbd{gTop@key{RET}} would go to the node
+called @samp{Top} in this file (its directory node).
+@kbd{gExpert@key{RET}} would come back here.
+
+Unlike @kbd{m}, @kbd{g} does not allow the use of abbreviations.
+
+To go to a node in another file, you can include the filename in the
+node name by putting it at the front, in parentheses. Thus,
+@kbd{g(dir)Top@key{RET}} would go to the Info Directory node, which is
+node @samp{Top} in the file @file{dir}.
+
+The node name @samp{*} specifies the whole file. So you can look at
+all of the current file by typing @kbd{g*@key{RET}} or all of any
+other file with @kbd{g(FILENAME)@key{RET}}.
+
+The @kbd{s} command allows you to search a whole file for a string.
+It switches to the next node if and when that is necessary. You
+type @kbd{s} followed by the string to search for, terminated by
+@key{RET}. To search for the same string again, just @kbd{s} followed
+by @key{RET} will do. The file's nodes are scanned in the order
+they are in in the file, which has no necessary relationship to the
+order that they may be in in the tree structure of menus and @samp{next} pointers.
+But normally the two orders are not very different. In any case,
+you can always do a @kbd{b} to find out what node you have reached, if
+the header is not visible (this can happen, because @kbd{s} puts your
+cursor at the occurrence of the string, not at the beginning of the
+node).
+
+If you grudge the system each character of type-in it requires, you
+might like to use the commands @kbd{1}, @kbd{2}, @kbd{3}, @kbd{4}, ...
+@kbd{9}. They are short for the @kbd{m} command together with an
+argument. @kbd{1} goes through the first item in the current node's
+menu; @kbd{2} goes through the second item, etc.
+
+If you display supports multiple fonts, and you are using Emacs' Info
+mode to read Info files, the @samp{*} for the fifth menu item is
+underlines, and so is the @samp{*} for the ninth item; these underlines
+make it easy to see at a glance which number to use for an item.
+
+On ordinary terminals, you won't have underlining. If you need to
+actually count items, it is better to use @kbd{m} instead, and specify
+the name.
+
+The Info command @kbd{e} changes from Info mode to an ordinary
+Emacs editing mode, so that you can edit the text of the current node.
+Type @kbd{C-c C-c} to switch back to Info. The @kbd{e} command is allowed
+only if the variable @code{Info-enable-edit} is non-@code{nil}.
+
+@node Add, Menus, Expert, Advanced Info
+@comment node-name, next, previous, up
+@section Adding a new node to Info
+
+To add a new topic to the list in the Info directory, you must:
+@enumerate
+@item
+Create some nodes, in some file, to document that topic.
+@item
+Put that topic in the menu in the directory. @xref{Menus, Menu}.
+@end enumerate
+
+Usually, the way to create the nodes is with Texinfo @pxref{Top,, Overview of
+Texinfo, texinfo, Texinfo: The GNU Documentation Format}); this has the
+advantage that you can also make a printed manual from them. However,
+if hyou want to edit an Info file, here is how.
+
+ The new node can live in an existing documentation file, or in a new
+one. It must have a @key{^_} character before it (invisible to the
+user; this node has one but you cannot see it), and it ends with either
+a @key{^_}, a @key{^L}, or the end of file. Note: If you put in a
+@key{^L} to end a new node, be sure that there is a @key{^_} after it
+to start the next one, since @key{^L} cannot @emph{start} a node.
+Also, a nicer way to make a node boundary be a page boundary as well
+is to put a @key{^L} @emph{right after} the @key{^_}.
+
+ The @key{^_} starting a node must be followed by a newline or a
+@key{^L} newline, after which comes the node's header line. The
+header line must give the node's name (by which Info finds it),
+and state the names of the @samp{Next}, @samp{Previous}, and @samp{Up} nodes (if
+there are any). As you can see, this node's @samp{Up} node is the node
+@samp{Top}, which points at all the documentation for Info. The @samp{Next}
+node is @samp{Menus}.
+
+ The keywords @dfn{Node}, @dfn{Previous}, @dfn{Up}, and @dfn{Next},
+may appear in any order, anywhere in the header line, but the
+recommended order is the one in this sentence. Each keyword must be
+followed by a colon, spaces and tabs, and then the appropriate name.
+The name may be terminated with a tab, a comma, or a newline. A space
+does not end it; node names may contain spaces. The case of letters
+in the names is insignificant.
+
+ A node name has two forms. A node in the current file is named by
+what appears after the @samp{Node: } in that node's first line. For
+example, this node's name is @samp{Add}. A node in another file is
+named by @samp{(@var{filename})@var{node-within-file}}, as in
+@samp{(info)Add} for this node. If the file name starts with ``./'',
+then it is relative to the current directory; otherwise, it is relative
+starting from the standard Info file directory of your site.
+The name @samp{(@var{filename})Top} can be abbreviated to just
+@samp{(@var{filename})}. By convention, the name @samp{Top} is used for
+the ``highest'' node in any single file---the node whose @samp{Up} points
+out of the file. The Directory node is @file{(dir)}. The @samp{Top} node
+of a document file listed in the Directory should have an @samp{Up:
+(dir)} in it.
+
+ The node name @kbd{*} is special: it refers to the entire file.
+Thus, @kbd{g*} shows you the whole current file. The use of the
+node @kbd{*} is to make it possible to make old-fashioned,
+unstructured files into nodes of the tree.
+
+ The @samp{Node:} name, in which a node states its own name, must not
+contain a filename, since Info when searching for a node does not
+expect one to be there. The @samp{Next}, @samp{Previous} and @samp{Up} names may
+contain them. In this node, since the @samp{Up} node is in the same file,
+it was not necessary to use one.
+
+ Note that the nodes in this file have a file name in the header
+line. The file names are ignored by Info, but they serve as comments
+to help identify the node for the user.
+
+@node Menus, Cross-refs, Add, Advanced Info
+@comment node-name, next, previous, up
+@section How to Create Menus
+
+ Any node in the Info hierarchy may have a @dfn{menu}---a list of subnodes.
+The @kbd{m} command searches the current node's menu for the topic which it
+reads from the terminal.
+
+ A menu begins with a line starting with @samp{* Menu:}. The rest of the
+line is a comment. After the starting line, every line that begins
+with a @samp{* } lists a single topic. The name of the topic--the
+argument that the user must give to the @kbd{m} command to select this
+topic---comes right after the star and space, and is followed by a
+colon, spaces and tabs, and the name of the node which discusses that
+topic. The node name, like node names following @samp{Next}, @samp{Previous}
+and @samp{Up}, may be terminated with a tab, comma, or newline; it may also
+be terminated with a period.
+
+ If the node name and topic name are the same, then rather than
+giving the name twice, the abbreviation @samp{* NAME::} may be used
+(and should be used, whenever possible, as it reduces the visual
+clutter in the menu).
+
+ It is considerate to choose the topic names so that they differ
+from each other very near the beginning---this allows the user to type
+short abbreviations. In a long menu, it is a good idea to capitalize
+the beginning of each item name which is the minimum acceptable
+abbreviation for it (a long menu is more than 5 or so entries).
+
+ The nodes listed in a node's menu are called its ``subnodes'', and
+it is their ``superior''. They should each have an @samp{Up:} pointing at
+the superior. It is often useful to arrange all or most of the
+subnodes in a sequence of @samp{Next} and @samp{Previous} pointers so that someone who
+wants to see them all need not keep revisiting the Menu.
+
+ The Info Directory is simply the menu of the node @samp{(dir)Top}---that
+is, node @samp{Top} in file @file{.../info/dir}. You can put new entries
+in that menu just like any other menu. The Info Directory is @emph{not} the
+same as the file directory called @file{info}. It happens that many of
+Info's files live on that file directory, but they do not have to; and
+files on that directory are not automatically listed in the Info
+Directory node.
+
+ Also, although the Info node graph is claimed to be a ``hierarchy'',
+in fact it can be @emph{any} directed graph. Shared structures and
+pointer cycles are perfectly possible, and can be used if they are
+appropriate to the meaning to be expressed. There is no need for all
+the nodes in a file to form a connected structure. In fact, this file
+has two connected components. You are in one of them, which is under
+the node @samp{Top}; the other contains the node @samp{Help} which the
+@kbd{h} command goes to. In fact, since there is no garbage
+collector, nothing terrible happens if a substructure is not pointed
+to, but such a substructure is rather useless since nobody can
+ever find out that it exists.
+
+@node Cross-refs, Tags, Menus, Advanced Info
+@comment node-name, next, previous, up
+@section Creating Cross References
+
+ A cross reference can be placed anywhere in the text, unlike a menu
+item which must go at the front of a line. A cross reference looks
+like a menu item except that it has @samp{*note} instead of @kbd{*}.
+It @emph{cannot} be terminated by a @samp{)}, because @samp{)}'s are
+so often part of node names. If you wish to enclose a cross reference
+in parentheses, terminate it with a period first. Here are two
+examples of cross references pointers:
+
+@example
+*Note details: commands. (See *note 3: Full Proof.)
+@end example
+
+They are just examples. The places they ``lead to'' do not really exist!
+
+@node Tags, Checking, Cross-refs, Advanced Info
+@comment node-name, next, previous, up
+@section Tag Tables for Info Files
+
+ You can speed up the access to nodes of a large Info file by giving
+it a tag table. Unlike the tag table for a program, the tag table for
+an Info file lives inside the file itself and is used
+automatically whenever Info reads in the file.
+
+ To make a tag table, go to a node in the file using Emacs Info mode and type
+@kbd{M-x Info-tagify}. Then you must use @kbd{C-x C-s} to save the
+file.
+
+ Once the Info file has a tag table, you must make certain it is up
+to date. If, as a result of deletion of text, any node moves back
+more than a thousand characters in the file from the position
+recorded in the tag table, Info will no longer be able to find that
+node. To update the tag table, use the @code{Info-tagify} command again.
+
+ An Info file tag table appears at the end of the file and looks like
+this:
+
+@example
+^_
+Tag Table:
+File: info, Node: Cross-refs^?21419
+File: info, Node: Tags^?22145
+^_
+End Tag Table
+@end example
+
+@noindent
+Note that it contains one line per node, and this line contains
+the beginning of the node's header (ending just after the node name),
+a Delete character, and the character position in the file of the
+beginning of the node.
+
+@node Checking, Emacs Info Variables, Tags, Advanced Info
+@comment node-name, next, previous, up
+@section Checking an Info File
+
+ When creating an Info file, it is easy to forget the name of a node
+when you are making a pointer to it from another node. If you put in
+the wrong name for a node, this is not detected until someone
+tries to go through the pointer using Info. Verification of the Info
+file is an automatic process which checks all pointers to nodes and
+reports any pointers which are invalid. Every @samp{Next}, @samp{Previous}, and
+@samp{Up} is checked, as is every menu item and every cross reference. In
+addition, any @samp{Next} which does not have a @samp{Previous} pointing back is
+reported. Only pointers within the file are checked, because checking
+pointers to other files would be terribly slow. But those are usually
+few.
+
+ To check an Info file, do @kbd{M-x Info-validate} while looking at
+any node of the file with Emacs Info mode.
+
+@node Emacs Info Variables, , Checking, Advanced Info
+@section Emacs Info-mode Variables
+
+The following variables may modify the behaviour of Info-mode in Emacs;
+you may wish to set one or several of these variables interactively, or
+in your @file{~/.emacs} init file. @xref{Examining, Examining and Setting
+Variables, Examining and Setting Variables, emacs, The GNU Emacs
+Manual}.
+
+@vtable @code
+@item Info-enable-edit
+Set to @code{nil}, disables the @samp{e} (@code{Info-edit}) command. A
+non-@code{nil} value enables it. @xref{Add, Edit}.
+
+@item Info-enable-active-nodes
+When set to a non-@code{nil} value, allows Info to execute Lisp code
+associated with nodes. The Lisp code is executed when the node is
+selected.
+
+@item Info-directory-list
+The list of directories to search for Info files. Each element is a
+string (directory name) or @code{nil} (try default directory).
+
+@item Info-directory
+The standard directory for Info documentation files. Only used when the
+function @code{Info-directory} is called.
+@end vtable
+
+@node Create an Info File, , Advanced Info, Top
+@comment node-name, next, previous, up
+@chapter Creating an Info File from a Makeinfo file
+
+@code{makeinfo} is a utility that converts a Texinfo file into an Info
+file; @code{texinfo-format-region} and @code{texinfo-format-buffer} are
+GNU Emacs functions that do the same.
+
+@xref{Create an Info File, , Creating an Info File, texinfo, the Texinfo
+Manual}, to learn how to create an Info file from a Texinfo file.
+
+@xref{Top,, Overview of Texinfo, texinfo, Texinfo: The GNU Documentation
+Format}, to learn how to write a Texinfo file.
+
+@bye
diff --git a/texinfo/info/infodoc.c b/texinfo/info/infodoc.c
new file mode 100644
index 00000000000..35675095e70
--- /dev/null
+++ b/texinfo/info/infodoc.c
@@ -0,0 +1,771 @@
+/* infodoc.c -- Functions which build documentation nodes. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+
+/* Normally we do not define HELP_NODE_GETS_REGENERATED because the
+ contents of the help node currently can never change once an info
+ session has been started. You should consider defining this in
+ the case that you place information about dynamic variables in the
+ help text. When that happens, the contents of the help node will
+ change dependent on the value of those variables, and the user will
+ expect to see those changes. */
+/* #define HELP_NODE_GETS_REGENERATED 1 */
+
+/* **************************************************************** */
+/* */
+/* Info Help Windows */
+/* */
+/* **************************************************************** */
+
+/* The name of the node used in the help window. */
+static char *info_help_nodename = "*Info Help*";
+
+/* A node containing printed key bindings and their documentation. */
+static NODE *internal_info_help_node = (NODE *)NULL;
+
+/* A pointer to the contents of the help node. */
+static char *internal_info_help_node_contents = (char *)NULL;
+
+/* The static text which appears in the internal info help node. */
+static char *info_internal_help_text[] = {
+ "Basic Commands in Info Windows",
+ "******************************",
+ "",
+ " h Invoke the Info tutorial.",
+ "",
+ "Selecting other nodes:",
+ "----------------------",
+ " n Move to the \"next\" node of this node.",
+ " p Move to the \"previous\" node of this node.",
+ " u Move \"up\" from this node.",
+ " m Pick menu item specified by name.",
+ " Picking a menu item causes another node to be selected.",
+ " f Follow a cross reference. Reads name of reference.",
+ " l Move to the last node seen in this window.",
+ " d Move to the `directory' node. Equivalent to `g(DIR)'.",
+ "",
+ "Moving within a node:",
+ "---------------------",
+ " SPC Scroll forward a page.",
+ " DEL Scroll backward a page.",
+ " b Go to the beginning of this node.",
+ " e Go to the end of this node.",
+ "",
+ "\"Advanced\" commands:",
+ "--------------------",
+ " q Quit Info.",
+ " 1 Pick first item in node's menu.",
+ " 2-9 Pick second ... ninth item in node's menu.",
+ " 0 Pick last item in node's menu.",
+ " g Move to node specified by name.",
+ " You may include a filename as well, as in (FILENAME)NODENAME.",
+ " s Search through this Info file for a specified string,",
+ " and select the node in which the next occurrence is found.",
+ (char *)NULL
+};
+
+static char *where_is (), *where_is_internal ();
+
+void
+dump_map_to_message_buffer (prefix, map)
+ char *prefix;
+ Keymap map;
+{
+ register int i;
+
+ for (i = 0; i < 256; i++)
+ {
+ if (map[i].type == ISKMAP)
+ {
+ char *new_prefix, *keyname;
+
+ keyname = pretty_keyname (i);
+ new_prefix = (char *)
+ xmalloc (3 + strlen (prefix) + strlen (keyname));
+ sprintf (new_prefix, "%s%s%s ", prefix, *prefix ? " " : "", keyname);
+
+ dump_map_to_message_buffer (new_prefix, (Keymap)map[i].function);
+ free (new_prefix);
+ }
+ else if (map[i].function)
+ {
+ register int last;
+ char *doc, *name;
+
+ doc = function_documentation (map[i].function);
+ name = function_name (map[i].function);
+
+ if (!*doc)
+ continue;
+
+ /* Find out if there is a series of identical functions, as in
+ ea_insert (). */
+ for (last = i + 1; last < 256; last++)
+ if ((map[last].type != ISFUNC) ||
+ (map[last].function != map[i].function))
+ break;
+
+ if (last - 1 != i)
+ {
+ printf_to_message_buffer
+ ("%s%s .. ", prefix, pretty_keyname (i));
+ printf_to_message_buffer
+ ("%s%s\t", prefix, pretty_keyname (last - 1));
+ i = last - 1;
+ }
+ else
+ printf_to_message_buffer ("%s%s\t", prefix, pretty_keyname (i));
+
+#if defined (NAMED_FUNCTIONS)
+ /* Print the name of the function, and some padding before the
+ documentation string is printed. */
+ {
+ int length_so_far;
+ int desired_doc_start = 40; /* Must be multiple of 8. */
+
+ printf_to_message_buffer ("(%s)", name);
+ length_so_far = message_buffer_length_this_line ();
+
+ if ((desired_doc_start + strlen (doc)) >= the_screen->width)
+ printf_to_message_buffer ("\n ");
+ else
+ {
+ while (length_so_far < desired_doc_start)
+ {
+ printf_to_message_buffer ("\t");
+ length_so_far += character_width ('\t', length_so_far);
+ }
+ }
+ }
+#endif /* NAMED_FUNCTIONS */
+ printf_to_message_buffer ("%s\n", doc);
+ }
+ }
+}
+
+/* How to create internal_info_help_node. */
+static void
+create_internal_info_help_node ()
+{
+ register int i;
+ char *contents = (char *)NULL;
+ NODE *node;
+
+#if !defined (HELP_NODE_GETS_REGENERATED)
+ if (internal_info_help_node_contents)
+ contents = internal_info_help_node_contents;
+#endif /* !HELP_NODE_GETS_REGENERATED */
+
+ if (!contents)
+ {
+ int printed_one_mx = 0;
+
+ initialize_message_buffer ();
+
+ for (i = 0; info_internal_help_text[i]; i++)
+ printf_to_message_buffer ("%s\n", info_internal_help_text[i]);
+
+ printf_to_message_buffer ("---------------------\n\n");
+ printf_to_message_buffer ("The current search path is:\n");
+ printf_to_message_buffer (" \"%s\"\n", infopath);
+ printf_to_message_buffer ("---------------------\n\n");
+ printf_to_message_buffer ("Commands available in Info windows:\n\n");
+ dump_map_to_message_buffer ("", info_keymap);
+ printf_to_message_buffer ("---------------------\n\n");
+ printf_to_message_buffer ("Commands available in the echo area:\n\n");
+ dump_map_to_message_buffer ("", echo_area_keymap);
+
+#if defined (NAMED_FUNCTIONS)
+ /* Get a list of the M-x commands which have no keystroke equivs. */
+ for (i = 0; function_doc_array[i].func; i++)
+ {
+ VFunction *func = function_doc_array[i].func;
+
+ if ((!where_is_internal (info_keymap, func)) &&
+ (!where_is_internal (echo_area_keymap, func)))
+ {
+ if (!printed_one_mx)
+ {
+ printf_to_message_buffer ("---------------------\n\n");
+ printf_to_message_buffer
+ ("The following commands can only be invoked via M-x:\n\n");
+ printed_one_mx = 1;
+ }
+
+ printf_to_message_buffer
+ ("M-x %s\n %s\n",
+ function_doc_array[i].func_name,
+ replace_in_documentation (function_doc_array[i].doc));
+ }
+ }
+
+ if (printed_one_mx)
+ printf_to_message_buffer ("\n");
+#endif /* NAMED_FUNCTIONS */
+
+ printf_to_message_buffer
+ ("%s", replace_in_documentation
+ ("--- Use `\\[history-node]' or `\\[kill-node]' to exit ---\n"));
+ node = message_buffer_to_node ();
+ internal_info_help_node_contents = node->contents;
+ }
+ else
+ {
+ /* We already had the right contents, so simply use them. */
+ node = build_message_node ("", 0, 0);
+ free (node->contents);
+ node->contents = contents;
+ node->nodelen = 1 + strlen (contents);
+ }
+
+ internal_info_help_node = node;
+
+ /* Do not GC this node's contents. It never changes, and we never need
+ to delete it once it is made. If you change some things (such as
+ placing information about dynamic variables in the help text) then
+ you will need to allow the contents to be gc'd, and you will have to
+ arrange to always regenerate the help node. */
+#if defined (HELP_NODE_GETS_REGENERATED)
+ add_gcable_pointer (internal_info_help_node->contents);
+#endif
+
+ name_internal_node (internal_info_help_node, info_help_nodename);
+
+ /* Even though this is an internal node, we don't want the window
+ system to treat it specially. So we turn off the internalness
+ of it here. */
+ internal_info_help_node->flags &= ~N_IsInternal;
+}
+
+/* Return a window which is the window showing help in this Info. */
+static WINDOW *
+info_find_or_create_help_window ()
+{
+ WINDOW *help_window, *eligible, *window;
+
+ eligible = (WINDOW *)NULL;
+ help_window = get_internal_info_window (info_help_nodename);
+
+ /* If we couldn't find the help window, then make it. */
+ if (!help_window)
+ {
+ int max = 0;
+
+ for (window = windows; window; window = window->next)
+ {
+ if (window->height > max)
+ {
+ max = window->height;
+ eligible = window;
+ }
+ }
+
+ if (!eligible)
+ return ((WINDOW *)NULL);
+ }
+#if !defined (HELP_NODE_GETS_REGENERATED)
+ else
+ return (help_window);
+#endif /* !HELP_NODE_GETS_REGENERATED */
+
+ /* Make sure that we have a node containing the help text. */
+ create_internal_info_help_node ();
+
+ /* Either use the existing window to display the help node, or create
+ a new window if there was no existing help window. */
+ if (!help_window)
+ {
+ /* Split the largest window into 2 windows, and show the help text
+ in that window. */
+ if (eligible->height > 30)
+ {
+ active_window = eligible;
+ help_window = window_make_window (internal_info_help_node);
+ }
+ else
+ {
+ set_remembered_pagetop_and_point (active_window);
+ window_set_node_of_window (active_window, internal_info_help_node);
+ help_window = active_window;
+ }
+ }
+ else
+ {
+ /* Case where help node always gets regenerated, and we have an
+ existing window in which to place the node. */
+ if (active_window != help_window)
+ {
+ set_remembered_pagetop_and_point (active_window);
+ active_window = help_window;
+ }
+ window_set_node_of_window (active_window, internal_info_help_node);
+ }
+ remember_window_and_node (help_window, help_window->node);
+ return (help_window);
+}
+
+/* Create or move to the help window. */
+DECLARE_INFO_COMMAND (info_get_help_window, "Display help message")
+{
+ WINDOW *help_window;
+
+ help_window = info_find_or_create_help_window ();
+ if (help_window)
+ {
+ active_window = help_window;
+ active_window->flags |= W_UpdateWindow;
+ }
+ else
+ {
+ info_error (CANT_MAKE_HELP);
+ }
+}
+
+/* Show the Info help node. This means that the "info" file is installed
+ where it can easily be found on your system. */
+DECLARE_INFO_COMMAND (info_get_info_help_node, "Visit Info node `(info)Help'")
+{
+ NODE *node;
+ char *nodename;
+
+ /* If there is a window on the screen showing the node "(info)Help" or
+ the node "(info)Help-Small-Screen", simply select that window. */
+ {
+ WINDOW *win;
+
+ for (win = windows; win; win = win->next)
+ {
+ if (win->node && win->node->filename &&
+ (strcasecmp
+ (filename_non_directory (win->node->filename), "info") == 0) &&
+ ((strcmp (win->node->nodename, "Help") == 0) ||
+ (strcmp (win->node->nodename, "Help-Small-Screen") == 0)))
+ {
+ active_window = win;
+ return;
+ }
+ }
+ }
+
+ /* If the current window is small, show the small screen help. */
+ if (active_window->height < 24)
+ nodename = "Help-Small-Screen";
+ else
+ nodename = "Help";
+
+ /* Try to get the info file for Info. */
+ node = info_get_node ("Info", nodename);
+
+ if (!node)
+ {
+ if (info_recent_file_error)
+ info_error (info_recent_file_error);
+ else
+ info_error (CANT_FILE_NODE, "Info", nodename);
+ }
+ else
+ {
+ /* If the current window is very large (greater than 45 lines),
+ then split it and show the help node in another window.
+ Otherwise, use the current window. */
+
+ if (active_window->height > 45)
+ active_window = window_make_window (node);
+ else
+ {
+ set_remembered_pagetop_and_point (active_window);
+ window_set_node_of_window (active_window, node);
+ }
+
+ remember_window_and_node (active_window, node);
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Groveling Info Keymaps and Docs */
+/* */
+/* **************************************************************** */
+
+/* Return the documentation associated with the Info command FUNCTION. */
+char *
+function_documentation (function)
+ VFunction *function;
+{
+ register int i;
+
+ for (i = 0; function_doc_array[i].func; i++)
+ if (function == function_doc_array[i].func)
+ break;
+
+ return (replace_in_documentation (function_doc_array[i].doc));
+}
+
+#if defined (NAMED_FUNCTIONS)
+/* Return the user-visible name of the function associated with the
+ Info command FUNCTION. */
+char *
+function_name (function)
+
+ VFunction *function;
+{
+ register int i;
+
+ for (i = 0; function_doc_array[i].func; i++)
+ if (function == function_doc_array[i].func)
+ break;
+
+ return (function_doc_array[i].func_name);
+}
+
+/* Return a pointer to the function named NAME. */
+VFunction *
+named_function (name)
+ char *name;
+{
+ register int i;
+
+ for (i = 0; function_doc_array[i].func; i++)
+ if (strcmp (function_doc_array[i].func_name, name) == 0)
+ break;
+
+ return (function_doc_array[i].func);
+}
+#endif /* NAMED_FUNCTIONS */
+
+/* Return the documentation associated with KEY in MAP. */
+char *
+key_documentation (key, map)
+ char key;
+ Keymap map;
+{
+ VFunction *function = map[key].function;
+
+ if (function)
+ return (function_documentation (function));
+ else
+ return ((char *)NULL);
+}
+
+DECLARE_INFO_COMMAND (describe_key, "Print documentation for KEY")
+{
+ char keyname[50];
+ int keyname_index = 0;
+ unsigned char keystroke;
+ char *rep;
+ Keymap map;
+
+ keyname[0] = '\0';
+ map = window->keymap;
+
+ while (1)
+ {
+ message_in_echo_area ("Describe key: %s", keyname);
+ keystroke = info_get_input_char ();
+ unmessage_in_echo_area ();
+
+ if (Meta_p (keystroke) && (!ISO_Latin_p || key < 160))
+ {
+ if (map[ESC].type != ISKMAP)
+ {
+ window_message_in_echo_area
+ ("ESC %s is undefined.", pretty_keyname (UnMeta (keystroke)));
+ return;
+ }
+
+ strcpy (keyname + keyname_index, "ESC ");
+ keyname_index = strlen (keyname);
+ keystroke = UnMeta (keystroke);
+ map = (Keymap)map[ESC].function;
+ }
+
+ /* Add the printed representation of KEYSTROKE to our keyname. */
+ rep = pretty_keyname (keystroke);
+ strcpy (keyname + keyname_index, rep);
+ keyname_index = strlen (keyname);
+
+ if (map[keystroke].function == (VFunction *)NULL)
+ {
+ message_in_echo_area ("%s is undefined.", keyname);
+ return;
+ }
+ else if (map[keystroke].type == ISKMAP)
+ {
+ map = (Keymap)map[keystroke].function;
+ strcat (keyname, " ");
+ keyname_index = strlen (keyname);
+ continue;
+ }
+ else
+ {
+ char *message, *fundoc, *funname = "";
+
+#if defined (NAMED_FUNCTIONS)
+ funname = function_name (map[keystroke].function);
+#endif /* NAMED_FUNCTIONS */
+
+ fundoc = function_documentation (map[keystroke].function);
+
+ message = (char *)xmalloc
+ (10 + strlen (keyname) + strlen (fundoc) + strlen (funname));
+
+#if defined (NAMED_FUNCTIONS)
+ sprintf (message, "%s (%s): %s.", keyname, funname, fundoc);
+#else
+ sprintf (message, "%s is defined to %s.", keyname, fundoc);
+#endif /* !NAMED_FUNCTIONS */
+
+ window_message_in_echo_area ("%s", message);
+ free (message);
+ break;
+ }
+ }
+}
+
+/* How to get the pretty printable name of a character. */
+static char rep_buffer[30];
+
+char *
+pretty_keyname (key)
+ unsigned char key;
+{
+ char *rep;
+
+ if (Meta_p (key))
+ {
+ char temp[20];
+
+ rep = pretty_keyname (UnMeta (key));
+
+ sprintf (temp, "ESC %s", rep);
+ strcpy (rep_buffer, temp);
+ rep = rep_buffer;
+ }
+ else if (Control_p (key))
+ {
+ switch (key)
+ {
+ case '\n': rep = "LFD"; break;
+ case '\t': rep = "TAB"; break;
+ case '\r': rep = "RET"; break;
+ case ESC: rep = "ESC"; break;
+
+ default:
+ sprintf (rep_buffer, "C-%c", UnControl (key));
+ rep = rep_buffer;
+ }
+ }
+ else
+ {
+ switch (key)
+ {
+ case ' ': rep = "SPC"; break;
+ case DEL: rep = "DEL"; break;
+ default:
+ rep_buffer[0] = key;
+ rep_buffer[1] = '\0';
+ rep = rep_buffer;
+ }
+ }
+ return (rep);
+}
+
+/* Replace the names of functions with the key that invokes them. */
+char *
+replace_in_documentation (string)
+ char *string;
+{
+ register int i, start, next;
+ static char *result = (char *)NULL;
+
+ maybe_free (result);
+ result = (char *)xmalloc (1 + strlen (string));
+
+ i = next = start = 0;
+
+ /* Skip to the beginning of a replaceable function. */
+ for (i = start; string[i]; i++)
+ {
+ /* Is this the start of a replaceable function name? */
+ if (string[i] == '\\' && string[i + 1] == '[')
+ {
+ char *fun_name, *rep;
+ VFunction *function;
+
+ /* Copy in the old text. */
+ strncpy (result + next, string + start, i - start);
+ next += (i - start);
+ start = i + 2;
+
+ /* Move to the end of the function name. */
+ for (i = start; string[i] && (string[i] != ']'); i++);
+
+ fun_name = (char *)xmalloc (1 + i - start);
+ strncpy (fun_name, string + start, i - start);
+ fun_name[i - start] = '\0';
+
+ /* Find a key which invokes this function in the info_keymap. */
+ function = named_function (fun_name);
+
+ /* If the internal documentation string fails, there is a
+ serious problem with the associated command's documentation.
+ We croak so that it can be fixed immediately. */
+ if (!function)
+ abort ();
+
+ rep = where_is (info_keymap, function);
+ strcpy (result + next, rep);
+ next = strlen (result);
+
+ start = i;
+ if (string[i])
+ start++;
+ }
+ }
+ strcpy (result + next, string + start);
+ return (result);
+}
+
+/* Return a string of characters which could be typed from the keymap
+ MAP to invoke FUNCTION. */
+static char *where_is_rep = (char *)NULL;
+static int where_is_rep_index = 0;
+static int where_is_rep_size = 0;
+
+static char *
+where_is (map, function)
+ Keymap map;
+ VFunction *function;
+{
+ char *rep;
+
+ if (!where_is_rep_size)
+ where_is_rep = (char *)xmalloc (where_is_rep_size = 100);
+ where_is_rep_index = 0;
+
+ rep = where_is_internal (map, function);
+
+ /* If it couldn't be found, return "M-x Foo". */
+ if (!rep)
+ {
+ char *name;
+
+ name = function_name (function);
+
+ if (name)
+ sprintf (where_is_rep, "M-x %s", name);
+
+ rep = where_is_rep;
+ }
+ return (rep);
+}
+
+/* Return the printed rep of FUNCTION as found in MAP, or NULL. */
+static char *
+where_is_internal (map, function)
+ Keymap map;
+ VFunction *function;
+{
+ register int i;
+
+ /* If the function is directly invokable in MAP, return the representation
+ of that keystroke. */
+ for (i = 0; i < 256; i++)
+ if ((map[i].type == ISFUNC) && map[i].function == function)
+ {
+ sprintf (where_is_rep + where_is_rep_index, "%s", pretty_keyname (i));
+ return (where_is_rep);
+ }
+
+ /* Okay, search subsequent maps for this function. */
+ for (i = 0; i < 256; i++)
+ {
+ if (map[i].type == ISKMAP)
+ {
+ int saved_index = where_is_rep_index;
+ char *rep;
+
+ sprintf (where_is_rep + where_is_rep_index, "%s ",
+ pretty_keyname (i));
+
+ where_is_rep_index = strlen (where_is_rep);
+ rep = where_is_internal ((Keymap)map[i].function, function);
+
+ if (rep)
+ return (where_is_rep);
+
+ where_is_rep_index = saved_index;
+ }
+ }
+
+ return ((char *)NULL);
+}
+
+extern char *read_function_name ();
+
+DECLARE_INFO_COMMAND (info_where_is,
+ "Show what to type to execute a given command")
+{
+ char *command_name;
+
+ command_name = read_function_name ("Where is command: ", window);
+
+ if (!command_name)
+ {
+ info_abort_key (active_window, count, key);
+ return;
+ }
+
+ if (*command_name)
+ {
+ VFunction *function;
+
+ function = named_function (command_name);
+
+ if (function)
+ {
+ char *location;
+
+ location = where_is (active_window->keymap, function);
+
+ if (!location)
+ {
+ info_error ("`%s' is not on any keys", command_name);
+ }
+ else
+ {
+ if (strncmp (location, "M-x ", 4) == 0)
+ window_message_in_echo_area
+ ("%s can only be invoked via %s.", command_name, location);
+ else
+ window_message_in_echo_area
+ ("%s can be invoked via %s.", command_name, location);
+ }
+ }
+ else
+ info_error ("There is no function named `%s'", command_name);
+ }
+
+ free (command_name);
+}
diff --git a/texinfo/info/infomap.c b/texinfo/info/infomap.c
new file mode 100644
index 00000000000..3f24f1f55d5
--- /dev/null
+++ b/texinfo/info/infomap.c
@@ -0,0 +1,274 @@
+/* infomap.c -- Keymaps for Info. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "stdio.h"
+#include "ctype.h"
+#include "infomap.h"
+#include "funs.h"
+
+/* Return a new keymap which has all the uppercase letters mapped to run
+ the function info_do_lowercase_version (). */
+Keymap
+keymap_make_keymap ()
+{
+ register int i;
+ Keymap keymap;
+
+ keymap = (Keymap)xmalloc (256 * sizeof (KEYMAP_ENTRY));
+
+ for (i = 0; i < 256; i++)
+ {
+ keymap[i].type = ISFUNC;
+ keymap[i].function = (VFunction *)NULL;
+ }
+
+ for (i = 'A'; i < ('Z' + 1); i++)
+ {
+ keymap[i].type = ISFUNC;
+ keymap[i].function = info_do_lowercase_version;
+ }
+
+ return (keymap);
+}
+
+/* Return a new keymap which is a copy of MAP. */
+Keymap
+keymap_copy_keymap (map)
+ Keymap map;
+{
+ register int i;
+ Keymap keymap;
+
+ keymap = keymap_make_keymap ();
+
+ for (i = 0; i < 256; i++)
+ {
+ keymap[i].type = map[i].type;
+ keymap[i].function = map[i].function;
+ }
+ return (keymap);
+}
+
+/* Free the keymap and it's descendents. */
+void
+keymap_discard_keymap (map)
+ Keymap (map);
+{
+ register int i;
+
+ if (!map)
+ return;
+
+ for (i = 0; i < 256; i++)
+ {
+ switch (map[i].type)
+ {
+ case ISFUNC:
+ break;
+
+ case ISKMAP:
+ keymap_discard_keymap ((Keymap)map[i].function);
+ break;
+
+ }
+ }
+}
+
+/* Initialize the standard info keymaps. */
+
+Keymap info_keymap = (Keymap)NULL;
+Keymap echo_area_keymap = (Keymap)NULL;
+
+void
+initialize_info_keymaps ()
+{
+ register int i;
+ Keymap map;
+
+ if (!info_keymap)
+ {
+ info_keymap = keymap_make_keymap ();
+ info_keymap[ESC].type = ISKMAP;
+ info_keymap[ESC].function = (VFunction *)keymap_make_keymap ();
+ info_keymap[Control ('x')].type = ISKMAP;
+ info_keymap[Control ('x')].function = (VFunction *)keymap_make_keymap ();
+ echo_area_keymap = keymap_make_keymap ();
+ echo_area_keymap[ESC].type = ISKMAP;
+ echo_area_keymap[ESC].function = (VFunction *)keymap_make_keymap ();
+ echo_area_keymap[Control ('x')].type = ISKMAP;
+ echo_area_keymap[Control ('x')].function =
+ (VFunction *)keymap_make_keymap ();
+ }
+
+ /* Bind numeric arg functions for both echo area and info window maps. */
+ for (i = '0'; i < '9' + 1; i++)
+ {
+ ((Keymap) info_keymap[ESC].function)[i].function =
+ ((Keymap) echo_area_keymap[ESC].function)[i].function =
+ info_add_digit_to_numeric_arg;
+ }
+ ((Keymap) info_keymap[ESC].function)['-'].function =
+ ((Keymap) echo_area_keymap[ESC].function)['-'].function =
+ info_add_digit_to_numeric_arg;
+
+ /* Bind the echo area routines. */
+ map = echo_area_keymap;
+
+ /* Bind the echo area insert routines. */
+ for (i = 0; i < 160; i++)
+ if (isprint (i))
+ map[i].function = ea_insert;
+
+ map[Control ('a')].function = ea_beg_of_line;
+ map[Control ('b')].function = ea_backward;
+ map[Control ('d')].function = ea_delete;
+ map[Control ('e')].function = ea_end_of_line;
+ map[Control ('f')].function = ea_forward;
+ map[Control ('g')].function = ea_abort;
+ map[Control ('h')].function = ea_rubout;
+ map[Control ('k')].function = ea_kill_line;
+ map[Control ('l')].function = info_redraw_display;
+ map[Control ('q')].function = ea_quoted_insert;
+ map[Control ('t')].function = ea_transpose_chars;
+ map[Control ('u')].function = info_universal_argument;
+ map[Control ('y')].function = ea_yank;
+
+ map[LFD].function = ea_newline;
+ map[RET].function = ea_newline;
+ map[SPC].function = ea_complete;
+ map[TAB].function = ea_complete;
+ map['?'].function = ea_possible_completions;
+ map[DEL].function = ea_rubout;
+
+ /* Bind the echo area ESC keymap. */
+ map = (Keymap)echo_area_keymap[ESC].function;
+
+ map[Control ('g')].function = ea_abort;
+ map[Control ('v')].function = ea_scroll_completions_window;
+ map['b'].function = ea_backward_word;
+ map['d'].function = ea_kill_word;
+ map['f'].function = ea_forward_word;
+#if defined (NAMED_FUNCTIONS)
+ /* map['x'].function = info_execute_command; */
+#endif /* NAMED_FUNCTIONS */
+ map['y'].function = ea_yank_pop;
+ map['?'].function = ea_possible_completions;
+ map[TAB].function = ea_tab_insert;
+ map[DEL].function = ea_backward_kill_word;
+
+ /* Bind the echo area Control-x keymap. */
+ map = (Keymap)echo_area_keymap[Control ('x')].function;
+
+ map['o'].function = info_next_window;
+ map[DEL].function = ea_backward_kill_line;
+
+ /* Bind commands for Info window keymaps. */
+ map = info_keymap;
+ map[TAB].function = info_move_to_next_xref;
+ map[LFD].function = info_select_reference_this_line;
+ map[RET].function = info_select_reference_this_line;
+ map[SPC].function = info_scroll_forward;
+ map[Control ('a')].function = info_beginning_of_line;
+ map[Control ('b')].function = info_backward_char;
+ map[Control ('e')].function = info_end_of_line;
+ map[Control ('f')].function = info_forward_char;
+ map[Control ('g')].function = info_abort_key;
+ map[Control ('h')].function = info_get_help_window;
+ map[Control ('l')].function = info_redraw_display;
+ map[Control ('n')].function = info_next_line;
+ map[Control ('p')].function = info_prev_line;
+ map[Control ('r')].function = isearch_backward;
+ map[Control ('s')].function = isearch_forward;
+ map[Control ('u')].function = info_universal_argument;
+ map[Control ('v')].function = info_scroll_forward;
+ map[','].function = info_next_index_match;
+
+ for (i = '1'; i < '9' + 1; i++)
+ map[i].function = info_menu_digit;
+ map['0'].function = info_last_menu_item;
+
+ map['<'].function = info_first_node;
+ map['>'].function = info_last_node;
+ map['?'].function = info_get_help_window;
+ map['['].function = info_global_prev_node;
+ map[']'].function = info_global_next_node;
+
+ map['b'].function = info_beginning_of_node;
+ map['d'].function = info_dir_node;
+ map['e'].function = info_end_of_node;
+ map['f'].function = info_xref_item;
+ map['g'].function = info_goto_node;
+ map['h'].function = info_get_info_help_node;
+ map['i'].function = info_index_search;
+ map['l'].function = info_history_node;
+ map['m'].function = info_menu_item;
+ map['n'].function = info_next_node;
+ map['p'].function = info_prev_node;
+ map['q'].function = info_quit;
+ map['r'].function = info_xref_item;
+ map['s'].function = info_search;
+ map['t'].function = info_top_node;
+ map['u'].function = info_up_node;
+ map[DEL].function = info_scroll_backward;
+
+ /* Bind members in the ESC map for Info windows. */
+ map = (Keymap)info_keymap[ESC].function;
+ map[Control ('f')].function = info_show_footnotes;
+ map[Control ('g')].function = info_abort_key;
+ map[TAB].function = info_move_to_prev_xref;
+ map[Control ('v')].function = info_scroll_other_window;
+ map['<'].function = info_beginning_of_node;
+ map['>'].function = info_end_of_node;
+ map['b'].function = info_backward_word;
+ map['f'].function = info_forward_word;
+ map['r'].function = info_move_to_window_line;
+ map['v'].function = info_scroll_backward;
+#if defined (NAMED_FUNCTIONS)
+ map['x'].function = info_execute_command;
+#endif /* NAMED_FUNCTIONS */
+
+ /* Bind members in the Control-X map for Info windows. */
+ map = (Keymap)info_keymap[Control ('x')].function;
+
+ map[Control ('b')].function = list_visited_nodes;
+ map[Control ('c')].function = info_quit;
+ map[Control ('f')].function = info_view_file;
+ map[Control ('g')].function = info_abort_key;
+ map[Control ('v')].function = info_view_file;
+ map['0'].function = info_delete_window;
+ map['1'].function = info_keep_one_window;
+ map['2'].function = info_split_window;
+ map['^'].function = info_grow_window;
+ map['b'].function = select_visited_node;
+ map['k'].function = info_kill_node;
+ map['o'].function = info_next_window;
+ map['t'].function = info_tile_windows;
+ map['w'].function = info_toggle_wrap;
+}
+
+/* Strings which represent the sequence of characters that the arrow keys
+ produce. If these keys begin with ESC, and the second character of the
+ sequence does not conflict with an existing binding in the Meta keymap,
+ then bind the keys to do what C-p, C-n, C-f, and C-b do. */
+extern char *term_ku, *term_kd, *term_kr, *term_kl;
+
diff --git a/texinfo/info/infomap.h b/texinfo/info/infomap.h
new file mode 100644
index 00000000000..faf93884fd5
--- /dev/null
+++ b/texinfo/info/infomap.h
@@ -0,0 +1,82 @@
+/* infomap.h -- Description of a keymap in Info and related functions. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_INFOMAP_H_)
+#define _INFOMAP_H_
+
+#include "general.h"
+
+#define ESC '\033'
+#define DEL '\177'
+#define TAB '\011'
+#define RET '\r'
+#define LFD '\n'
+#define SPC ' '
+
+#define meta_character_threshold (DEL + 1)
+#define control_character_threshold (SPC)
+
+#define meta_character_bit 0x80
+#define control_character_bit 0x40
+
+#define Meta_p(c) (((c) > meta_character_threshold))
+#define Control_p(c) ((c) < control_character_threshold)
+
+#define Meta(c) ((c) | (meta_character_bit))
+#define UnMeta(c) ((c) & (~meta_character_bit))
+#define Control(c) ((toupper (c)) & (~control_character_bit))
+#define UnControl(c) (tolower ((c) | control_character_bit))
+
+/* A keymap contains one entry for each key in the ASCII set.
+ Each entry consists of a type and a pointer.
+ FUNCTION is the address of a function to run, or the
+ address of a keymap to indirect through.
+ TYPE says which kind of thing FUNCTION is. */
+typedef struct {
+ char type;
+ VFunction *function;
+} KEYMAP_ENTRY;
+
+typedef KEYMAP_ENTRY *Keymap;
+
+/* The values that TYPE can have in a keymap entry. */
+#define ISFUNC 0
+#define ISKMAP 1
+
+extern Keymap info_keymap;
+extern Keymap echo_area_keymap;
+
+/* Return a new keymap which has all the uppercase letters mapped to run
+ the function info_do_lowercase_version (). */
+extern Keymap keymap_make_keymap ();
+
+/* Return a new keymap which is a copy of MAP. */
+extern Keymap keymap_copy_keymap ();
+
+/* Free MAP and it's descendents. */
+extern void keymap_discard_keymap ();
+
+/* Initialize the info keymaps. */
+extern void initialize_info_keymaps ();
+
+#endif /* !_INFOMAP_H_ */
diff --git a/texinfo/info/m-x.c b/texinfo/info/m-x.c
new file mode 100644
index 00000000000..03ac1a52232
--- /dev/null
+++ b/texinfo/info/m-x.c
@@ -0,0 +1,195 @@
+/* m-x.c -- Meta-X minibuffer reader. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+
+/* **************************************************************** */
+/* */
+/* Reading Named Commands */
+/* */
+/* **************************************************************** */
+
+/* Read the name of an Info function in the echo area and return the
+ name. A return value of NULL indicates that no function name could
+ be read. */
+char *
+read_function_name (prompt, window)
+ char *prompt;
+ WINDOW *window;
+{
+ register int i;
+ char *line;
+ REFERENCE **array = (REFERENCE **)NULL;
+ int array_index = 0, array_slots = 0;
+
+ /* Make an array of REFERENCE which actually contains the names of
+ the functions available in Info. */
+ for (i = 0; function_doc_array[i].func; i++)
+ {
+ REFERENCE *entry;
+
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->label = strdup (function_doc_array[i].func_name);
+ entry->nodename = (char *)NULL;
+ entry->filename = (char *)NULL;
+
+ add_pointer_to_array
+ (entry, array_index, array, array_slots, 200, REFERENCE *);
+ }
+
+ line = info_read_completing_in_echo_area (window, prompt, array);
+
+ info_free_references (array);
+
+ if (!echo_area_is_active)
+ window_clear_echo_area ();
+
+ return (line);
+}
+
+DECLARE_INFO_COMMAND (describe_command,
+ "Read the name of an Info command and describe it")
+{
+ char *line;
+
+ line = read_function_name ("Describe command: ", window);
+
+ if (!line)
+ {
+ info_abort_key (active_window, count, key);
+ return;
+ }
+
+ /* Describe the function named in "LINE". */
+ if (*line)
+ {
+ char *fundoc;
+ VFunction *fun;
+
+ fun = named_function (line);
+
+ if (!fun)
+ return;
+
+ window_message_in_echo_area ("%s: %s.",
+ line, function_documentation (fun));
+ }
+ free (line);
+}
+
+DECLARE_INFO_COMMAND (info_execute_command,
+ "Read a command name in the echo area and execute it")
+{
+ char *line;
+
+ /* Ask the completer to read a reference for us. */
+ if (info_explicit_arg || count != 1)
+ {
+ char *prompt;
+
+ prompt = (char *)xmalloc (20);
+ sprintf (prompt, "%d M-x ", count);
+ line = read_function_name (prompt, window);
+ }
+ else
+ line = read_function_name ("M-x ", window);
+
+ /* User aborted? */
+ if (!line)
+ {
+ info_abort_key (active_window, count, key);
+ return;
+ }
+
+ /* User accepted "default"? (There is none.) */
+ if (!*line)
+ {
+ free (line);
+ return;
+ }
+
+ /* User wants to execute a named command. Do it. */
+ {
+ VFunction *function;
+
+ if ((active_window != the_echo_area) &&
+ (strncmp (line, "echo-area-", 10) == 0))
+ {
+ free (line);
+ info_error ("Cannot execute an `echo-area' command here.");
+ return;
+ }
+
+ function = named_function (line);
+ free (line);
+
+ if (!function)
+ return;
+
+ (*function) (active_window, count, 0);
+ }
+}
+
+/* Okay, now that we have M-x, let the user set the screen height. */
+DECLARE_INFO_COMMAND (set_screen_height,
+ "Set the height of the displayed window")
+{
+ int new_height;
+
+ if (info_explicit_arg || count != 1)
+ new_height = count;
+ else
+ {
+ char prompt[80];
+ char *line;
+
+ new_height = screenheight;
+
+ sprintf (prompt, "Set screen height to (%d): ", new_height);
+
+ line = info_read_in_echo_area (window, prompt);
+
+ /* If the user aborted, do that now. */
+ if (!line)
+ {
+ info_abort_key (active_window, count, 0);
+ return;
+ }
+
+ /* Find out what the new height is supposed to be. */
+ if (*line)
+ new_height = atoi (line);
+
+ /* Clear the echo area if it isn't active. */
+ if (!echo_area_is_active)
+ window_clear_echo_area ();
+
+ free (line);
+ }
+
+ terminal_clear_screen ();
+ display_clear_display (the_display);
+ screenheight = new_height;
+ display_initialize_display (screenwidth, screenheight);
+ window_new_screen_size (screenwidth, screenheight);
+}
diff --git a/texinfo/info/makedoc.c b/texinfo/info/makedoc.c
new file mode 100644
index 00000000000..c0c4587ff18
--- /dev/null
+++ b/texinfo/info/makedoc.c
@@ -0,0 +1,481 @@
+/* makedoc.c -- Make DOC.C and FUNS.H from input files. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+/* This program grovels the contents of the source files passed as arguments
+ and writes out a file of function pointers and documentation strings, and
+ a header file which describes the contents. This only does the functions
+ declared with DECLARE_INFO_COMMAND. */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <sys/types.h>
+#if defined (HAVE_SYS_FILE_H)
+#include <sys/file.h>
+#endif /* HAVE_SYS_FILE_H */
+#include <sys/stat.h>
+#include "general.h"
+
+#if !defined (O_RDONLY)
+#if defined (HAVE_SYS_FCNTL_H)
+#include <sys/fcntl.h>
+#else /* !HAVE_SYS_FCNTL_H */
+#include <fcntl.h>
+#endif /* !HAVE_SYS_FCNTL_H */
+#endif /* !O_RDONLY */
+
+extern void *xmalloc (), *xrealloc ();
+static void fatal_file_error ();
+
+/* Name of the header file which receives the declarations of functions. */
+static char *funs_filename = "funs.h";
+
+/* Name of the documentation to function pointer file. */
+static char *doc_filename = "doc.c";
+
+static char *doc_header[] = {
+ "/* doc.c -- Generated structure containing function names and doc strings.",
+ "",
+ " This file was automatically made from various source files with the",
+ " command \"%s\". DO NOT EDIT THIS FILE, only \"%s.c\".",
+ (char *)NULL
+};
+
+static char *doc_header_1[] = {
+ " An entry in the array FUNCTION_DOC_ARRAY is made for each command",
+ " found in the above files; each entry consists of a function pointer,",
+#if defined (NAMED_FUNCTIONS)
+ " a string which is the user-visible name of the function,",
+#endif /* NAMED_FUNCTIONS */
+ " and a string which documents its purpose. */",
+ "",
+ "#include \"doc.h\"",
+ "#include \"funs.h\"",
+ "",
+ "FUNCTION_DOC function_doc_array[] = {",
+ "",
+ (char *)NULL
+};
+
+/* How to remember the locations of the functions found so that Emacs
+ can use the information in a tag table. */
+typedef struct {
+ char *name; /* Name of the tag. */
+ int line; /* Line number at which it appears. */
+ long char_offset; /* Character offset at which it appears. */
+} EMACS_TAG;
+
+typedef struct {
+ char *filename; /* Name of the file containing entries. */
+ long entrylen; /* Total number of characters in tag block. */
+ EMACS_TAG **entries; /* Entries found in FILENAME. */
+ int entries_index;
+ int entries_slots;
+} EMACS_TAG_BLOCK;
+
+EMACS_TAG_BLOCK **emacs_tags = (EMACS_TAG_BLOCK **)NULL;
+int emacs_tags_index = 0;
+int emacs_tags_slots = 0;
+
+#define DECLARATION_STRING "\nDECLARE_INFO_COMMAND"
+
+static void process_one_file ();
+static void maybe_dump_tags ();
+static FILE *must_fopen ();
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ register int i;
+ int tags_only = 0;
+ FILE *funs_stream, *doc_stream;
+
+ for (i = 1; i < argc; i++)
+ if (strcmp (argv[i], "-tags") == 0)
+ {
+ tags_only++;
+ break;
+ }
+
+ if (tags_only)
+ {
+ funs_filename = "/dev/null";
+ doc_filename = "/dev/null";
+ }
+
+ funs_stream = must_fopen (funs_filename, "w");
+ doc_stream = must_fopen (doc_filename, "w");
+
+ fprintf (funs_stream,
+ "/* %s -- Generated declarations for Info commands. */\n",
+ funs_filename);
+
+ for (i = 0; doc_header[i]; i++)
+ {
+ fprintf (doc_stream, doc_header[i], argv[0], argv[0]);
+ fprintf (doc_stream, "\n");
+ }
+
+ fprintf (doc_stream,
+ " Source files groveled to make this file include:\n\n");
+
+ for (i = 1; i < argc; i++)
+ fprintf (doc_stream, "\t%s\n", argv[i]);
+
+ fprintf (doc_stream, "\n");
+
+ for (i = 0; doc_header_1[i]; i++)
+ fprintf (doc_stream, "%s\n", doc_header_1[i]);
+
+
+ for (i = 1; i < argc; i++)
+ {
+ char *curfile;
+ curfile = argv[i];
+
+ if (*curfile == '-')
+ continue;
+
+ fprintf (doc_stream, "/* Commands found in \"%s\". */\n", curfile);
+ fprintf (funs_stream, "\n/* Functions declared in \"%s\". */\n",
+ curfile);
+
+ process_one_file (curfile, doc_stream, funs_stream);
+ }
+
+ fprintf (doc_stream,
+ " { (VFunction *)NULL, (char *)NULL, (char *)NULL }\n};\n");
+
+ fclose (funs_stream);
+ fclose (doc_stream);
+
+ if (tags_only)
+ maybe_dump_tags (stdout);
+ exit (0);
+}
+
+/* Dumping out the contents of an Emacs tags table. */
+static void
+maybe_dump_tags (stream)
+ FILE *stream;
+{
+ register int i;
+
+ /* Print out the information for each block. */
+ for (i = 0; i < emacs_tags_index; i++)
+ {
+ register int j;
+ register EMACS_TAG_BLOCK *block;
+ register EMACS_TAG *etag;
+ long block_len;
+
+ block_len = 0;
+ block = emacs_tags[i];
+
+ /* Calculate the length of the dumped block first. */
+ for (j = 0; j < block->entries_index; j++)
+ {
+ char digits[30];
+ etag = block->entries[j];
+ block_len += 3 + strlen (etag->name);
+ sprintf (digits, "%d,%d", etag->line, etag->char_offset);
+ block_len += strlen (digits);
+ }
+
+ /* Print out the defining line. */
+ fprintf (stream, "\f\n%s,%d\n", block->filename, block_len);
+
+ /* Print out the individual tags. */
+ for (j = 0; j < block->entries_index; j++)
+ {
+ etag = block->entries[j];
+
+ fprintf (stream, "%s,\177%d,%d\n",
+ etag->name, etag->line, etag->char_offset);
+ }
+ }
+}
+
+/* Keeping track of names, line numbers and character offsets of functions
+ found in source files. */
+static EMACS_TAG_BLOCK *
+make_emacs_tag_block (filename)
+ char *filename;
+{
+ EMACS_TAG_BLOCK *block;
+
+ block = (EMACS_TAG_BLOCK *)xmalloc (sizeof (EMACS_TAG_BLOCK));
+ block->filename = strdup (filename);
+ block->entrylen = 0;
+ block->entries = (EMACS_TAG **)NULL;
+ block->entries_index = 0;
+ block->entries_slots = 0;
+ return (block);
+}
+
+static void
+add_tag_to_block (block, name, line, char_offset)
+ EMACS_TAG_BLOCK *block;
+ char *name;
+ int line;
+ long char_offset;
+{
+ EMACS_TAG *tag;
+
+ tag = (EMACS_TAG *)xmalloc (sizeof (EMACS_TAG));
+ tag->name = name;
+ tag->line = line;
+ tag->char_offset = char_offset;
+ add_pointer_to_array (tag, block->entries_index, block->entries,
+ block->entries_slots, 50, EMACS_TAG *);
+}
+
+/* Read the file represented by FILENAME into core, and search it for Info
+ function declarations. Output the declarations in various forms to the
+ DOC_STREAM and FUNS_STREAM. */
+static void
+process_one_file (filename, doc_stream, funs_stream)
+ char *filename;
+ FILE *doc_stream, *funs_stream;
+{
+ int descriptor, decl_len;
+ char *buffer, *decl_str;
+ struct stat finfo;
+ long offset;
+ long file_size;
+ EMACS_TAG_BLOCK *block;
+
+ if (stat (filename, &finfo) == -1)
+ fatal_file_error (filename);
+
+ descriptor = open (filename, O_RDONLY, 0666);
+
+ if (descriptor == -1)
+ fatal_file_error (filename);
+
+ file_size = (long) finfo.st_size;
+ buffer = (char *)xmalloc (1 + file_size);
+ read (descriptor, buffer, file_size);
+ close (descriptor);
+
+ offset = 0;
+ decl_str = DECLARATION_STRING;
+ decl_len = strlen (decl_str);
+
+ block = make_emacs_tag_block (filename);
+
+ while (1)
+ {
+ long point = 0;
+ long line_start = 0;
+ int line_number = 0;
+
+ char *func, *doc;
+#if defined (NAMED_FUNCTIONS)
+ char *func_name;
+#endif /* NAMED_FUNCTIONS */
+
+ for (; offset < (file_size - decl_len); offset++)
+ {
+ if (buffer[offset] == '\n')
+ {
+ line_number++;
+ line_start = offset + 1;
+ }
+
+ if (strncmp (buffer + offset, decl_str, decl_len) == 0)
+ {
+ offset += decl_len;
+ point = offset;
+ break;
+ }
+ }
+
+ if (!point)
+ break;
+
+ /* Skip forward until we find the open paren. */
+ while (point < file_size)
+ {
+ if (buffer[point] == '\n')
+ {
+ line_number++;
+ line_start = point + 1;
+ }
+ else if (buffer[point] == '(')
+ break;
+
+ point++;
+ }
+
+ while (point++ < file_size)
+ {
+ if (!whitespace_or_newline (buffer[point]))
+ break;
+ else if (buffer[point] == '\n')
+ {
+ line_number++;
+ line_start = point + 1;
+ }
+ }
+
+ if (point >= file_size)
+ break;
+
+ /* Now looking at name of function. Get it. */
+ for (offset = point; buffer[offset] != ','; offset++);
+ func = (char *)xmalloc (1 + (offset - point));
+ strncpy (func, buffer + point, offset - point);
+ func[offset - point] = '\0';
+
+ /* Remember this tag in the current block. */
+ {
+ char *tag_name;
+
+ tag_name = (char *)xmalloc (1 + (offset - line_start));
+ strncpy (tag_name, buffer + line_start, offset - line_start);
+ tag_name[offset - line_start] = '\0';
+ add_tag_to_block (block, tag_name, line_number, point);
+ }
+
+#if defined (NAMED_FUNCTIONS)
+ /* Generate the user-visible function name from the function's name. */
+ {
+ register int i;
+ char *name_start;
+
+ name_start = func;
+
+ if (strncmp (name_start, "info_", 5) == 0)
+ name_start += 5;
+
+ func_name = strdup (name_start);
+
+ /* Fix up "ea" commands. */
+ if (strncmp (func_name, "ea_", 3) == 0)
+ {
+ char *temp_func_name;
+
+ temp_func_name = (char *)xmalloc (10 + strlen (func_name));
+ strcpy (temp_func_name, "echo_area_");
+ strcat (temp_func_name, func_name + 3);
+ free (func_name);
+ func_name = temp_func_name;
+ }
+
+ for (i = 0; func_name[i]; i++)
+ if (func_name[i] == '_')
+ func_name[i] = '-';
+ }
+#endif /* NAMED_FUNCTIONS */
+
+ /* Find doc string. */
+ point = offset + 1;
+
+ while (point < file_size)
+ {
+ if (buffer[point] == '\n')
+ {
+ line_number++;
+ line_start = point + 1;
+ }
+
+ if (buffer[point] == '"')
+ break;
+ else
+ point++;
+ }
+
+ offset = point + 1;
+
+ while (offset < file_size)
+ {
+ if (buffer[offset] == '\n')
+ {
+ line_number++;
+ line_start = offset + 1;
+ }
+
+ if (buffer[offset] == '\\')
+ offset += 2;
+ else if (buffer[offset] == '"')
+ break;
+ else
+ offset++;
+ }
+
+ offset++;
+ if (offset >= file_size)
+ break;
+
+ doc = (char *)xmalloc (1 + (offset - point));
+ strncpy (doc, buffer + point, offset - point);
+ doc[offset - point] = '\0';
+
+#if defined (NAMED_FUNCTIONS)
+ fprintf (doc_stream, " { %s, \"%s\", %s },\n", func, func_name, doc);
+ free (func_name);
+#else /* !NAMED_FUNCTIONS */
+ fprintf (doc_stream, " { %s, %s },\n", func, doc);
+#endif /* !NAMED_FUNCTIONS */
+
+ fprintf (funs_stream, "extern void %s ();\n", func);
+ free (func);
+ free (doc);
+ }
+ free (buffer);
+
+ /* If we created any tags, remember this file on our global list. Otherwise,
+ free the memory already allocated to it. */
+ if (block->entries)
+ add_pointer_to_array (block, emacs_tags_index, emacs_tags,
+ emacs_tags_slots, 10, EMACS_TAG_BLOCK *);
+ else
+ {
+ free (block->filename);
+ free (block);
+ }
+}
+
+static void
+fatal_file_error (filename)
+ char *filename;
+{
+ fprintf (stderr, "Couldn't manipulate the file %s.\n", filename);
+ exit (2);
+}
+
+static FILE *
+must_fopen (filename, mode)
+ char *filename, *mode;
+{
+ FILE *stream;
+
+ stream = fopen (filename, mode);
+ if (!stream)
+ fatal_file_error (filename);
+
+ return (stream);
+}
+
diff --git a/texinfo/info/man.c b/texinfo/info/man.c
new file mode 100644
index 00000000000..b899ec1d273
--- /dev/null
+++ b/texinfo/info/man.c
@@ -0,0 +1,643 @@
+/* man.c: How to read and format man files. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox Thu May 4 09:17:52 1995 (bfox@ai.mit.edu). */
+
+#include "info.h"
+#include <sys/ioctl.h>
+#include <sys/file.h>
+#include "signals.h"
+#if defined (HAVE_SYS_TIME_H)
+#include <sys/time.h>
+#endif
+#if defined (HAVE_SYS_WAIT_H)
+#include <sys/wait.h>
+#endif
+#include "tilde.h"
+
+#include "man.h"
+
+#if !defined (_POSIX_VERSION)
+#define pid_t int
+#endif
+
+#if defined (FD_SET)
+# if defined (hpux)
+# define fd_set_cast(x) (int *)(x)
+# else
+# define fd_set_cast(x) (fd_set *)(x)
+# endif /* !hpux */
+#endif /* FD_SET */
+
+static char *read_from_fd ();
+static void clean_manpage ();
+static NODE *manpage_node_of_file_buffer ();
+static char *get_manpage_contents ();
+
+NODE *
+make_manpage_node (pagename)
+ char *pagename;
+{
+ return (info_get_node (MANPAGE_FILE_BUFFER_NAME, pagename));
+}
+
+NODE *
+get_manpage_node (file_buffer, pagename)
+ FILE_BUFFER *file_buffer;
+ char *pagename;
+{
+ NODE *node;
+
+ node = manpage_node_of_file_buffer (file_buffer, pagename);
+
+ if (!node)
+ {
+ char *page;
+
+ page = get_manpage_contents (pagename);
+
+ if (page)
+ {
+ char header[1024];
+ long oldsize, newsize;
+ int hlen, plen;
+
+ sprintf (header, "\n\n%c\n%s %s, %s %s, %s (dir)\n\n",
+ INFO_COOKIE,
+ INFO_FILE_LABEL, file_buffer->filename,
+ INFO_NODE_LABEL, pagename,
+ INFO_UP_LABEL);
+ oldsize = file_buffer->filesize;
+ hlen = strlen (header);
+ plen = strlen (page);
+ newsize = (oldsize + hlen + plen);
+ file_buffer->contents =
+ (char *)xrealloc (file_buffer->contents, 1 + newsize);
+ memcpy (file_buffer->contents + oldsize, header, hlen);
+ oldsize += hlen;
+ memcpy (file_buffer->contents + oldsize, page, plen);
+ file_buffer->contents[newsize] = '\0';
+ file_buffer->filesize = newsize;
+ file_buffer->finfo.st_size = newsize;
+ build_tags_and_nodes (file_buffer);
+ free (page);
+ }
+
+ node = manpage_node_of_file_buffer (file_buffer, pagename);
+ }
+
+ return (node);
+}
+
+FILE_BUFFER *
+create_manpage_file_buffer ()
+{
+ FILE_BUFFER *file_buffer;
+ struct stat *finfo;
+
+ file_buffer = make_file_buffer ();
+ file_buffer->filename = strdup (MANPAGE_FILE_BUFFER_NAME);
+ file_buffer->fullpath = strdup (MANPAGE_FILE_BUFFER_NAME);
+ file_buffer->finfo.st_size = 0;
+ file_buffer->filesize = 0;
+ file_buffer->contents = (char *)NULL;
+ file_buffer->flags = (N_IsInternal | N_CannotGC | N_IsManPage);
+
+ return (file_buffer);
+}
+
+/* Scan the list of directories in PATH looking for FILENAME. If we find
+ one that is an executable file, return it as a new string. Otherwise,
+ return a NULL pointer. */
+static char *
+executable_file_in_path (filename, path)
+ char *filename, *path;
+{
+ struct stat finfo;
+ char *temp_dirname;
+ int statable, dirname_index;
+
+ dirname_index = 0;
+
+ while (temp_dirname = extract_colon_unit (path, &dirname_index))
+ {
+ register int i;
+ char *temp;
+
+ /* Expand a leading tilde if one is present. */
+ if (*temp_dirname == '~')
+ {
+ char *expanded_dirname;
+
+ expanded_dirname = tilde_expand_word (temp_dirname);
+ free (temp_dirname);
+ temp_dirname = expanded_dirname;
+ }
+
+ temp = (char *)xmalloc (30 + strlen (temp_dirname) + strlen (filename));
+ strcpy (temp, temp_dirname);
+ if (temp[(strlen (temp)) - 1] != '/')
+ strcat (temp, "/");
+ strcat (temp, filename);
+
+ free (temp_dirname);
+
+ statable = (stat (temp, &finfo) == 0);
+
+ /* If we have found a regular executable file, then use it. */
+ if ((statable) && (S_ISREG (finfo.st_mode)) &&
+ (access (temp, X_OK) == 0))
+ return (temp);
+ else
+ free (temp);
+ }
+ return ((char *)NULL);
+}
+
+/* Return the full pathname of the system man page formatter. */
+static char *
+find_man_formatter ()
+{
+ return (executable_file_in_path ("man", (char *)getenv ("PATH")));
+}
+
+static char *manpage_pagename = (char *)NULL;
+static char *manpage_section = (char *)NULL;
+
+static void
+get_page_and_section (pagename)
+ char *pagename;
+{
+ register int i;
+
+ if (manpage_pagename)
+ free (manpage_pagename);
+
+ if (manpage_section)
+ free (manpage_section);
+
+ manpage_pagename = (char *)NULL;
+ manpage_section = (char *)NULL;
+
+ for (i = 0; pagename[i] != '\0' && pagename[i] != '('; i++);
+
+ manpage_pagename = (char *)xmalloc (1 + i);
+ strncpy (manpage_pagename, pagename, i);
+ manpage_pagename[i] = '\0';
+
+ if (pagename[i] == '(')
+ {
+ int start;
+
+ start = i + 1;
+
+ for (i = start; pagename[i] != '\0' && pagename[i] != ')'; i++);
+
+ manpage_section = (char *)xmalloc (1 + (i - start));
+ strncpy (manpage_section, pagename + start, (i - start));
+ manpage_section[i - start] = '\0';
+ }
+}
+
+static void
+reap_children (sig)
+ int sig;
+{
+ unsigned int status;
+ wait (&status);
+}
+
+static char *
+get_manpage_contents (pagename)
+ char *pagename;
+{
+ static char *formatter_args[4] = { (char *)NULL };
+ int pipes[2];
+ pid_t child;
+ char *formatted_page = (char *)NULL;
+ char *section = (char *)NULL;
+ int arg_index = 1;
+
+ if (formatter_args[0] == (char *)NULL)
+ formatter_args[0] = find_man_formatter ();
+
+ if (formatter_args[0] == (char *)NULL)
+ return ((char *)NULL);
+
+ get_page_and_section (pagename);
+
+ if (manpage_section != (char *)NULL)
+ formatter_args[arg_index++] = manpage_section;
+
+ formatter_args[arg_index++] = manpage_pagename;
+ formatter_args[arg_index] = (char *)NULL;
+
+ /* Open a pipe to this program, read the output, and save it away
+ in FORMATTED_PAGE. The reader end of the pipe is pipes[0]; the
+ writer end is pipes[1]. */
+ pipe (pipes);
+
+ signal (SIGCHLD, reap_children);
+
+ child = fork ();
+
+ if (child == -1)
+ return ((char *)NULL);
+
+ if (child != 0)
+ {
+ /* In the parent, close the writing end of the pipe, and read from
+ the exec'd child. */
+ close (pipes[1]);
+ formatted_page = read_from_fd (pipes[0]);
+ close (pipes[0]);
+ }
+ else
+ {
+ /* In the child, close the read end of the pipe, make the write end
+ of the pipe be stdout, and execute the man page formatter. */
+ close (pipes[0]);
+ close (fileno (stderr));
+ close (fileno (stdin)); /* Don't print errors. */
+ dup2 (pipes[1], fileno (stdout));
+
+ execv (formatter_args[0], formatter_args);
+
+ /* If we get here, we couldn't exec, so close out the pipe and
+ exit. */
+ close (pipes[1]);
+ exit (0);
+ }
+
+ /* If we have the page, then clean it up. */
+ if (formatted_page)
+ clean_manpage (formatted_page);
+
+ return (formatted_page);
+}
+
+static void
+clean_manpage (manpage)
+ char *manpage;
+{
+ register int i, j;
+ int newline_count = 0;
+ char *newpage;
+
+ newpage = (char *)xmalloc (1 + strlen (manpage));
+
+ for (i = 0, j = 0; newpage[j] = manpage[i]; i++, j++)
+ {
+ if (manpage[i] == '\n')
+ newline_count++;
+ else
+ newline_count = 0;
+
+ if (newline_count == 3)
+ {
+ j--;
+ newline_count--;
+ }
+
+ if (manpage[i] == '\b' || manpage[i] == '\f')
+ j -= 2;
+ }
+
+ newpage[j++] = '\0';
+
+ strcpy (manpage, newpage);
+ free (newpage);
+}
+
+static NODE *
+manpage_node_of_file_buffer (file_buffer, pagename)
+ FILE_BUFFER *file_buffer;
+ char *pagename;
+{
+ NODE *node = (NODE *)NULL;
+ TAG *tag = (TAG *)NULL;
+
+ if (file_buffer->contents)
+ {
+ register int i;
+
+ for (i = 0; tag = file_buffer->tags[i]; i++)
+ {
+ if (strcasecmp (pagename, tag->nodename) == 0)
+ break;
+ }
+ }
+
+ if (tag)
+ {
+ node = (NODE *)xmalloc (sizeof (NODE));
+ node->filename = file_buffer->filename;
+ node->nodename = tag->nodename;
+ node->contents = file_buffer->contents + tag->nodestart;
+ node->nodelen = tag->nodelen;
+ node->flags = 0;
+ node->parent = (char *)NULL;
+ node->flags = (N_HasTagsTable | N_IsManPage);
+ node->contents += skip_node_separator (node->contents);
+ }
+
+ return (node);
+}
+
+static char *
+read_from_fd (fd)
+ int fd;
+{
+ struct timeval timeout;
+ char *buffer = (char *)NULL;
+ int bsize = 0;
+ int bindex = 0;
+ int select_result;
+#if defined (FD_SET)
+ fd_set read_fds;
+
+ timeout.tv_sec = 15;
+ timeout.tv_usec = 0;
+
+ FD_ZERO (&read_fds);
+ FD_SET (fd, &read_fds);
+
+ select_result = select (fd + 1, fd_set_cast (&read_fds), 0, 0, &timeout);
+#else /* !FD_SET */
+ select_result = 1;
+#endif /* !FD_SET */
+
+ switch (select_result)
+ {
+ case 0:
+ case -1:
+ break;
+
+ default:
+ {
+ int amount_read;
+ int done = 0;
+
+ while (!done)
+ {
+ while ((bindex + 1024) > (bsize))
+ buffer = (char *)xrealloc (buffer, (bsize += 1024));
+ buffer[bindex] = '\0';
+
+ amount_read = read (fd, buffer + bindex, 1023);
+
+ if (amount_read < 0)
+ {
+ done = 1;
+ }
+ else
+ {
+ bindex += amount_read;
+ buffer[bindex] = '\0';
+ if (amount_read == 0)
+ done = 1;
+ }
+ }
+ }
+ }
+
+ if ((buffer != (char *)NULL) && (*buffer == '\0'))
+ {
+ free (buffer);
+ buffer = (char *)NULL;
+ }
+
+ return (buffer);
+}
+
+static char *reference_section_starters[] =
+{
+ "\nRELATED INFORMATION",
+ "\nRELATED\tINFORMATION",
+ "RELATED INFORMATION\n",
+ "RELATED\tINFORMATION\n",
+ "\nSEE ALSO",
+ "\nSEE\tALSO",
+ "SEE ALSO\n",
+ "SEE\tALSO\n",
+ (char *)NULL
+};
+
+static SEARCH_BINDING frs_binding;
+
+static SEARCH_BINDING *
+find_reference_section (node)
+ NODE *node;
+{
+ register int i;
+ long position = -1;
+
+ frs_binding.buffer = node->contents;
+ frs_binding.start = 0;
+ frs_binding.end = node->nodelen;
+ frs_binding.flags = S_SkipDest;
+
+ for (i = 0; reference_section_starters[i] != (char *)NULL; i++)
+ {
+ position = search_forward (reference_section_starters[i], &frs_binding);
+ if (position != -1)
+ break;
+ }
+
+ if (position == -1)
+ return ((SEARCH_BINDING *)NULL);
+
+ /* We found the start of the reference section, and point is right after
+ the string which starts it. The text from here to the next header
+ (or end of buffer) contains the only references in this manpage. */
+ frs_binding.start = position;
+
+ for (i = frs_binding.start; i < frs_binding.end - 2; i++)
+ {
+ if ((frs_binding.buffer[i] == '\n') &&
+ (!whitespace (frs_binding.buffer[i + 1])))
+ {
+ frs_binding.end = i;
+ break;
+ }
+ }
+
+ return (&frs_binding);
+}
+
+REFERENCE **
+xrefs_of_manpage (node)
+ NODE *node;
+{
+ SEARCH_BINDING *reference_section;
+ REFERENCE **refs = (REFERENCE **)NULL;
+ int refs_index = 0;
+ int refs_slots = 0;
+ long position;
+
+ reference_section = find_reference_section (node);
+
+ if (reference_section == (SEARCH_BINDING *)NULL)
+ return ((REFERENCE **)NULL);
+
+ /* Grovel the reference section building a list of references found there.
+ A reference is alphabetic characters followed by non-whitespace text
+ within parenthesis. */
+ reference_section->flags = 0;
+
+ while ((position = search_forward ("(", reference_section)) != -1)
+ {
+ register int start, end;
+
+ for (start = position; start > reference_section->start; start--)
+ if (whitespace (reference_section->buffer[start]))
+ break;
+
+ start++;
+
+ for (end = position; end < reference_section->end; end++)
+ {
+ if (whitespace (reference_section->buffer[end]))
+ {
+ end = start;
+ break;
+ }
+
+ if (reference_section->buffer[end] == ')')
+ {
+ end++;
+ break;
+ }
+ }
+
+ if (end != start)
+ {
+ REFERENCE *entry;
+ int len = end - start;
+
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->label = (char *)xmalloc (1 + len);
+ strncpy (entry->label, (reference_section->buffer) + start, len);
+ entry->label[len] = '\0';
+ entry->filename = strdup (node->filename);
+ entry->nodename = strdup (entry->label);
+ entry->start = start;
+ entry->end = end;
+
+ add_pointer_to_array
+ (entry, refs_index, refs, refs_slots, 10, REFERENCE *);
+ }
+
+ reference_section->start = position + 1;
+ }
+
+ return (refs);
+}
+
+long
+locate_manpage_xref (node, start, dir)
+ NODE *node;
+ long start;
+ int dir;
+{
+ register int i, count;
+ REFERENCE **refs;
+ long position = -1;
+
+ refs = xrefs_of_manpage (node);
+
+ if (refs)
+ {
+ register int i, count;
+ REFERENCE *entry;
+
+ for (i = 0; refs[i]; i++);
+ count = i;
+
+ if (dir > 0)
+ {
+ for (i = 0; entry = refs[i]; i++)
+ if (entry->start > start)
+ {
+ position = entry->start;
+ break;
+ }
+ }
+ else
+ {
+ for (i = count - 1; i > -1; i--)
+ {
+ entry = refs[i];
+
+ if (entry->start < start)
+ {
+ position = entry->start;
+ break;
+ }
+ }
+ }
+
+ info_free_references (refs);
+ }
+ return (position);
+}
+
+/* This one was a little tricky. The binding buffer that is passed in has
+ a START and END value of 0 -- strlen (window-line-containing-point).
+ The BUFFER is a pointer to the start of that line. */
+REFERENCE **
+manpage_xrefs_in_binding (node, binding)
+ NODE *node;
+ SEARCH_BINDING *binding;
+{
+ register int i;
+ REFERENCE **all_refs = xrefs_of_manpage (node);
+ REFERENCE **brefs = (REFERENCE **)NULL;
+ REFERENCE *entry;
+ int brefs_index = 0;
+ int brefs_slots = 0;
+ int start, end;
+
+ if (!all_refs)
+ return ((REFERENCE **)NULL);
+
+ start = binding->start + (binding->buffer - node->contents);
+ end = binding->end + (binding->buffer - node->contents);
+
+ for (i = 0; entry = all_refs[i]; i++)
+ {
+ if ((entry->start > start) && (entry->end < end))
+ {
+ add_pointer_to_array
+ (entry, brefs_index, brefs, brefs_slots, 10, REFERENCE *);
+ }
+ else
+ {
+ maybe_free (entry->label);
+ maybe_free (entry->filename);
+ maybe_free (entry->nodename);
+ free (entry);
+ }
+ }
+
+ free (all_refs);
+ return (brefs);
+}
diff --git a/texinfo/info/man.h b/texinfo/info/man.h
new file mode 100644
index 00000000000..1584e260687
--- /dev/null
+++ b/texinfo/info/man.h
@@ -0,0 +1,36 @@
+/* man.h: Defines and external function declarations for man.c */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Author: Brian J. Fox (bfox@ai.mit.edu) Sat May 6 16:19:13 1995. */
+
+#if !defined (_MAN_H_)
+#define _MAN_H_
+
+#define MANPAGE_FILE_BUFFER_NAME "*manpages*"
+
+extern NODE *make_manpage_node (/* char *pagename */);
+extern NODE *get_manpage_node (/* FILE_BUFFER *file_buffer, char *pagename */);
+extern FILE_BUFFER *create_manpage_file_buffer (/* void */);
+extern long locate_manpage_xref (/* NODE *node, long start, int dir */);
+extern REFERENCE **xrefs_of_manpage (/* NODE *node */);
+extern REFERENCE **manpage_xrefs_in_binding (/* NODE *node, SEARCH_BINDING *binding */);
+
+#endif /* !_MAN_H_ */
diff --git a/texinfo/info/nodemenu.c b/texinfo/info/nodemenu.c
new file mode 100644
index 00000000000..33044157bd2
--- /dev/null
+++ b/texinfo/info/nodemenu.c
@@ -0,0 +1,329 @@
+/* nodemenu.c -- Produce a menu of all visited nodes. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+
+/* Return a line describing the format of a node information line. */
+static char *
+nodemenu_format_info ()
+{
+ return ("\n\
+* Menu:\n\
+ (File)Node Lines Size Containing File\n\
+ ---------- ----- ---- ---------------");
+}
+
+/* Produce a formatted line of information about NODE. Here is what we want
+ the output listing to look like:
+
+* Menu:
+ (File)Node Lines Size Containing File
+ ---------- ----- ---- ---------------
+* (emacs)Buffers:: 48 2230 /usr/gnu/info/emacs/emacs-1
+* (autoconf)Writing configure.in:: 123 58789 /usr/gnu/info/autoconf/autoconf-1
+* (dir)Top:: 40 589 /usr/gnu/info/dir
+*/
+static char *
+format_node_info (node)
+ NODE *node;
+{
+ register int i, len;
+ char *parent, *containing_file;
+ static char *line_buffer = (char *)NULL;
+
+ if (!line_buffer)
+ line_buffer = (char *)xmalloc (1000);
+
+ if (node->parent)
+ {
+ parent = filename_non_directory (node->parent);
+ if (!parent)
+ parent = node->parent;
+ }
+ else
+ parent = (char *)NULL;
+
+ containing_file = node->filename;
+
+ if (!parent && !*containing_file)
+ sprintf (line_buffer, "* %s::", node->nodename);
+ else
+ {
+ char *file = (char *)NULL;
+
+ if (parent)
+ file = parent;
+ else
+ file = filename_non_directory (containing_file);
+
+ if (!file)
+ file = containing_file;
+
+ if (!*file)
+ file = "dir";
+
+ sprintf (line_buffer, "* (%s)%s::", file, node->nodename);
+ }
+
+ len = pad_to (36, line_buffer);
+
+ {
+ int lines = 1;
+
+ for (i = 0; i < node->nodelen; i++)
+ if (node->contents[i] == '\n')
+ lines++;
+
+ sprintf (line_buffer + len, "%d", lines);
+ }
+
+ len = pad_to (44, line_buffer);
+ sprintf (line_buffer + len, "%d", node->nodelen);
+
+ if (node->filename && *(node->filename))
+ {
+ len = pad_to (51, line_buffer);
+ sprintf (line_buffer + len, node->filename);
+ }
+
+ return (strdup (line_buffer));
+}
+
+/* Little string comparison routine for qsort (). */
+static int
+compare_strings (string1, string2)
+ char **string1, **string2;
+{
+ return (strcasecmp (*string1, *string2));
+}
+
+/* The name of the nodemenu node. */
+static char *nodemenu_nodename = "*Node Menu*";
+
+/* Produce an informative listing of all the visited nodes, and return it
+ in a node. If FILTER_FUNC is non-null, it is a function which filters
+ which nodes will appear in the listing. FILTER_FUNC takes an argument
+ of NODE, and returns non-zero if the node should appear in the listing. */
+NODE *
+get_visited_nodes (filter_func)
+ Function *filter_func;
+{
+ register int i, iw_index;
+ INFO_WINDOW *info_win;
+ NODE *node;
+ char **lines = (char **)NULL;
+ int lines_index = 0, lines_slots = 0;
+
+ if (!info_windows)
+ return ((NODE *)NULL);
+
+ for (iw_index = 0; info_win = info_windows[iw_index]; iw_index++)
+ {
+ for (i = 0; i < info_win->nodes_index; i++)
+ {
+ node = info_win->nodes[i];
+
+ /* We skip mentioning "*Node Menu*" nodes. */
+ if (internal_info_node_p (node) &&
+ (strcmp (node->nodename, nodemenu_nodename) == 0))
+ continue;
+
+ if (node && (!filter_func || (*filter_func) (node)))
+ {
+ char *line;
+
+ line = format_node_info (node);
+ add_pointer_to_array
+ (line, lines_index, lines, lines_slots, 20, char *);
+ }
+ }
+ }
+
+ /* Sort the array of information lines, if there are any. */
+ if (lines)
+ {
+ register int j, newlen;
+ char **temp;
+
+ qsort (lines, lines_index, sizeof (char *), compare_strings);
+
+ /* Delete duplicates. */
+ for (i = 0, newlen = 1; i < lines_index - 1; i++)
+ {
+ if (strcmp (lines[i], lines[i + 1]) == 0)
+ {
+ free (lines[i]);
+ lines[i] = (char *)NULL;
+ }
+ else
+ newlen++;
+ }
+
+ /* We have free ()'d and marked all of the duplicate slots.
+ Copy the live slots rather than pruning the dead slots. */
+ temp = (char **)xmalloc ((1 + newlen) * sizeof (char *));
+ for (i = 0, j = 0; i < lines_index; i++)
+ if (lines[i])
+ temp[j++] = lines[i];
+
+ temp[j] = (char *)NULL;
+ free (lines);
+ lines = temp;
+ lines_index = newlen;
+ }
+
+ initialize_message_buffer ();
+
+ printf_to_message_buffer
+ ("%s", replace_in_documentation
+ ("Here is the menu of nodes you have recently visited.\n\
+Select one from this menu, or use `\\[history-node]' in another window.\n"));
+
+ printf_to_message_buffer ("%s\n", nodemenu_format_info ());
+
+ for (i = 0; (lines != (char **)NULL) && (i < lines_index); i++)
+ {
+ printf_to_message_buffer ("%s\n", lines[i]);
+ free (lines[i]);
+ }
+
+ if (lines)
+ free (lines);
+
+ node = message_buffer_to_node ();
+ add_gcable_pointer (node->contents);
+ return (node);
+}
+
+DECLARE_INFO_COMMAND (list_visited_nodes,
+ "Make a window containing a menu of all of the currently visited nodes")
+{
+ WINDOW *new;
+ NODE *node;
+
+ set_remembered_pagetop_and_point (window);
+
+ /* If a window is visible and showing the buffer list already, re-use it. */
+ for (new = windows; new; new = new->next)
+ {
+ node = new->node;
+
+ if (internal_info_node_p (node) &&
+ (strcmp (node->nodename, nodemenu_nodename) == 0))
+ break;
+ }
+
+ /* If we couldn't find an existing window, try to use the next window
+ in the chain. */
+ if (!new && window->next)
+ new = window->next;
+
+ /* If we still don't have a window, make a new one to contain the list. */
+ if (!new)
+ {
+ WINDOW *old_active;
+
+ old_active = active_window;
+ active_window = window;
+ new = window_make_window ((NODE *)NULL);
+ active_window = old_active;
+ }
+
+ /* If we couldn't make a new window, use this one. */
+ if (!new)
+ new = window;
+
+ /* Lines do not wrap in this window. */
+ new->flags |= W_NoWrap;
+ node = get_visited_nodes ((Function *)NULL);
+ name_internal_node (node, nodemenu_nodename);
+
+ /* Even if this is an internal node, we don't want the window
+ system to treat it specially. So we turn off the internalness
+ of it here. */
+ node->flags &= ~N_IsInternal;
+
+ /* If this window is already showing a node menu, reuse the existing node
+ slot. */
+ {
+ int remember_me = 1;
+
+#if defined (NOTDEF)
+ if (internal_info_node_p (new->node) &&
+ (strcmp (new->node->nodename, nodemenu_nodename) == 0))
+ remember_me = 0;
+#endif /* NOTDEF */
+
+ window_set_node_of_window (new, node);
+
+ if (remember_me)
+ remember_window_and_node (new, node);
+ }
+
+ active_window = new;
+}
+
+DECLARE_INFO_COMMAND (select_visited_node,
+ "Select a node which has been previously visited in a visible window")
+{
+ char *line;
+ NODE *node;
+ REFERENCE **menu;
+
+ node = get_visited_nodes ((Function *)NULL);
+
+ menu = info_menu_of_node (node);
+ free (node);
+
+ line =
+ info_read_completing_in_echo_area (window, "Select visited node: ", menu);
+
+ window = active_window;
+
+ /* User aborts, just quit. */
+ if (!line)
+ {
+ info_abort_key (window, 0, 0);
+ info_free_references (menu);
+ return;
+ }
+
+ if (*line)
+ {
+ REFERENCE *entry;
+
+ /* Find the selected label in the references. */
+ entry = info_get_labeled_reference (line, menu);
+
+ if (!entry)
+ info_error ("The reference disappeared! (%s).", line);
+ else
+ info_select_reference (window, entry);
+ }
+
+ free (line);
+ info_free_references (menu);
+
+ if (!info_error_was_printed)
+ window_clear_echo_area ();
+}
diff --git a/texinfo/info/nodes.c b/texinfo/info/nodes.c
new file mode 100644
index 00000000000..8995c78195f
--- /dev/null
+++ b/texinfo/info/nodes.c
@@ -0,0 +1,1207 @@
+/* nodes.c -- How to get an Info file and node. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <sys/types.h>
+#if defined (HAVE_SYS_FILE_H)
+#include <sys/file.h>
+#endif /* HAVE_SYS_FILE_H */
+#include <sys/errno.h>
+#include <sys/stat.h>
+#if defined (HAVE_STRING_H)
+#include <string.h>
+#endif /* HAVE_STRING_H */
+#include "nodes.h"
+#include "search.h"
+#include "filesys.h"
+#include "info-utils.h"
+
+#if defined (HANDLE_MAN_PAGES)
+# include "man.h"
+#endif /* HANDLE_MAN_PAGES */
+
+#if !defined (O_RDONLY)
+#if defined (HAVE_SYS_FCNTL_H)
+#include <sys/fcntl.h>
+#else /* !HAVE_SYS_FCNTL_H */
+#include <fcntl.h>
+#endif /* !HAVE_SYS_FCNTL_H */
+#endif /* !O_RDONLY */
+
+#if !defined (errno)
+extern int errno;
+#endif /* !errno */
+
+/* **************************************************************** */
+/* */
+/* Functions Static to this File */
+/* */
+/* **************************************************************** */
+
+static void forget_info_file (), remember_info_file ();
+static void free_file_buffer_tags (), free_info_tag ();
+static void get_nodes_of_tags_table (), get_nodes_of_info_file ();
+static void get_tags_of_indirect_tags_table ();
+static void info_reload_file_buffer_contents ();
+static char *adjust_nodestart ();
+static FILE_BUFFER *info_load_file_internal (), *info_find_file_internal ();
+static NODE *info_node_of_file_buffer_tags ();
+
+static long get_node_length ();
+
+/* Magic number that RMS used to decide how much a tags table pointer could
+ be off by. I feel that it should be much smaller, like on the order of
+ 4. */
+#define DEFAULT_INFO_FUDGE 1000
+
+/* Passed to *_internal functions. INFO_GET_TAGS says to do what is
+ neccessary to fill in the nodes or tags arrays in FILE_BUFFER. */
+#define INFO_NO_TAGS 0
+#define INFO_GET_TAGS 1
+
+/* **************************************************************** */
+/* */
+/* Global Variables */
+/* */
+/* **************************************************************** */
+
+/* When non-zero, this is a string describing the recent file error. */
+char *info_recent_file_error = (char *)NULL;
+
+/* The list of already loaded nodes. */
+FILE_BUFFER **info_loaded_files = (FILE_BUFFER **)NULL;
+
+/* The number of slots currently allocated to LOADED_FILES. */
+int info_loaded_files_slots = 0;
+
+/* **************************************************************** */
+/* */
+/* Public Functions for Node Manipulation */
+/* */
+/* **************************************************************** */
+
+/* Used to build "dir" menu from "localdir" files found in INFOPATH. */
+extern void maybe_build_dir_node ();
+
+/* Return a pointer to a NODE structure for the Info node (FILENAME)NODENAME.
+ FILENAME can be passed as NULL, in which case the filename of "dir" is used.
+ NODENAME can be passed as NULL, in which case the nodename of "Top" is used.
+ If the node cannot be found, return a NULL pointer. */
+NODE *
+info_get_node (filename, nodename)
+ char *filename, *nodename;
+{
+ FILE_BUFFER *file_buffer;
+ NODE *node;
+
+ file_buffer = (FILE_BUFFER *)NULL;
+ info_recent_file_error = (char *)NULL;
+
+ info_parse_node (nodename, DONT_SKIP_NEWLINES);
+ nodename = (char *)NULL;
+
+ if (info_parsed_filename)
+ filename = info_parsed_filename;
+
+ if (info_parsed_nodename)
+ nodename = info_parsed_nodename;
+
+ /* If FILENAME is not specified, it defaults to "dir". */
+ if (!filename)
+ filename = "dir";
+
+ /* If the file to be looked up is "dir", build the contents from all of
+ the "dir"s and "localdir"s found in INFOPATH. */
+ if (strcasecmp (filename, "dir") == 0)
+ maybe_build_dir_node (filename);
+
+ /* Find the correct info file. */
+ file_buffer = info_find_file (filename);
+
+ if (!file_buffer)
+ {
+ if (filesys_error_number)
+ info_recent_file_error =
+ filesys_error_string (filename, filesys_error_number);
+ return ((NODE *)NULL);
+ }
+
+ node = info_get_node_of_file_buffer (nodename, file_buffer);
+ /* If the node looked for was "Top", try again looking for the node under
+ a slightly different name. */
+ if (!node && (nodename == NULL || strcasecmp (nodename, "Top") == 0))
+ {
+ node = info_get_node_of_file_buffer ("Top", file_buffer);
+ if (!node)
+ node = info_get_node_of_file_buffer ("top", file_buffer);
+ if (!node)
+ node = info_get_node_of_file_buffer ("TOP", file_buffer);
+ }
+ return (node);
+}
+
+/* Return a pointer to a NODE structure for the Info node NODENAME in
+ FILE_BUFFER. NODENAME can be passed as NULL, in which case the
+ nodename of "Top" is used. If the node cannot be found, return a
+ NULL pointer. */
+NODE *
+info_get_node_of_file_buffer (nodename, file_buffer)
+ char *nodename;
+ FILE_BUFFER *file_buffer;
+{
+ NODE *node = (NODE *)NULL;
+
+ /* If we are unable to find the file, we have to give up. There isn't
+ anything else we can do. */
+ if (!file_buffer)
+ return ((NODE *)NULL);
+
+ /* If the file buffer was gc'ed, reload the contents now. */
+ if (!file_buffer->contents)
+ info_reload_file_buffer_contents (file_buffer);
+
+ /* If NODENAME is not specified, it defaults to "Top". */
+ if (!nodename)
+ nodename = "Top";
+
+ /* If the name of the node that we wish to find is exactly "*", then the
+ node body is the contents of the entire file. Create and return such
+ a node. */
+ if (strcmp (nodename, "*") == 0)
+ {
+ node = (NODE *)xmalloc (sizeof (NODE));
+ node->filename = file_buffer->fullpath;
+ node->parent = (char *)NULL;
+ node->nodename = strdup ("*");
+ node->contents = file_buffer->contents;
+ node->nodelen = file_buffer->filesize;
+ node->flags = 0;
+ }
+#if defined (HANDLE_MAN_PAGES)
+ /* If the file buffer is the magic one associated with manpages, call
+ the manpage node finding function instead. */
+ else if (file_buffer->flags & N_IsManPage)
+ {
+ node = get_manpage_node (file_buffer, nodename);
+ }
+#endif /* HANDLE_MAN_PAGES */
+ /* If this is the "main" info file, it might contain a tags table. Search
+ the tags table for an entry which matches the node that we want. If
+ there is a tags table, get the file which contains this node, but don't
+ bother building a node list for it. */
+ else if (file_buffer->tags)
+ {
+ node = info_node_of_file_buffer_tags (file_buffer, nodename);
+ }
+
+ /* Return the results of our node search. */
+ return (node);
+}
+
+/* Locate the file named by FILENAME, and return the information structure
+ describing this file. The file may appear in our list of loaded files
+ already, or it may not. If it does not already appear, find the file,
+ and add it to the list of loaded files. If the file cannot be found,
+ return a NULL FILE_BUFFER *. */
+FILE_BUFFER *
+info_find_file (filename)
+ char *filename;
+{
+ return (info_find_file_internal (filename, INFO_GET_TAGS));
+}
+
+/* Load the info file FILENAME, remembering information about it in a
+ file buffer. */
+FILE_BUFFER *
+info_load_file (filename)
+ char *filename;
+{
+ return (info_load_file_internal (filename, INFO_GET_TAGS));
+}
+
+
+/* **************************************************************** */
+/* */
+/* Private Functions Implementation */
+/* */
+/* **************************************************************** */
+
+/* The workhorse for info_find_file (). Non-zero 2nd argument says to
+ try to build a tags table (or otherwise glean the nodes) for this
+ file once found. By default, we build the tags table, but when this
+ function is called by info_get_node () when we already have a valid
+ tags table describing the nodes, it is unnecessary. */
+static FILE_BUFFER *
+info_find_file_internal (filename, get_tags)
+ char *filename;
+ int get_tags;
+{
+ register int i;
+ register FILE_BUFFER *file_buffer;
+
+ /* First try to find the file in our list of already loaded files. */
+ if (info_loaded_files)
+ {
+ for (i = 0; file_buffer = info_loaded_files[i]; i++)
+ if ((strcmp (filename, file_buffer->filename) == 0) ||
+ (strcmp (filename, file_buffer->fullpath) == 0) ||
+ ((*filename != '/') &&
+ strcmp (filename,
+ filename_non_directory (file_buffer->fullpath)) == 0))
+ {
+ struct stat new_info, *old_info;
+
+ /* This file is loaded. If the filename that we want is
+ specifically "dir", then simply return the file buffer. */
+ if (strcasecmp (filename_non_directory (filename), "dir") == 0)
+ return (file_buffer);
+
+#if defined (HANDLE_MAN_PAGES)
+ /* Do the same for the magic MANPAGE file. */
+ if (file_buffer->flags & N_IsManPage)
+ return (file_buffer);
+#endif /* HANDLE_MAN_PAGES */
+
+ /* The file appears to be already loaded, and it is not "dir".
+ Check to see if it has changed since the last time it was
+ loaded. */
+ if (stat (file_buffer->fullpath, &new_info) == -1)
+ {
+ filesys_error_number = errno;
+ return ((FILE_BUFFER *)NULL);
+ }
+
+ old_info = &file_buffer->finfo;
+
+ if ((new_info.st_size != old_info->st_size) ||
+ (new_info.st_mtime != old_info->st_mtime))
+ {
+ /* The file has changed. Forget that we ever had loaded it
+ in the first place. */
+ forget_info_file (filename);
+ break;
+ }
+ else
+ {
+ /* The info file exists, and has not changed since the last
+ time it was loaded. If the caller requested a nodes list
+ for this file, and there isn't one here, build the nodes
+ for this file_buffer. In any case, return the file_buffer
+ object. */
+ if (get_tags && !file_buffer->tags)
+ build_tags_and_nodes (file_buffer);
+
+ return (file_buffer);
+ }
+ }
+ }
+
+ /* The file wasn't loaded. Try to load it now. */
+#if defined (HANDLE_MAN_PAGES)
+ /* If the name of the file that we want is our special file buffer for
+ Unix manual pages, then create the file buffer, and return it now. */
+ if (strcasecmp (filename, MANPAGE_FILE_BUFFER_NAME) == 0)
+ file_buffer = create_manpage_file_buffer ();
+ else
+#endif /* HANDLE_MAN_PAGES */
+ file_buffer = info_load_file_internal (filename, get_tags);
+
+ /* If the file was loaded, remember the name under which it was found. */
+ if (file_buffer)
+ remember_info_file (file_buffer);
+
+ return (file_buffer);
+}
+
+/* The workhorse function for info_load_file (). Non-zero second argument
+ says to build a list of tags (or nodes) for this file. This is the
+ default behaviour when info_load_file () is called, but it is not
+ necessary when loading a subfile for which we already have tags. */
+static FILE_BUFFER *
+info_load_file_internal (filename, get_tags)
+ char *filename;
+ int get_tags;
+{
+ char *fullpath, *contents;
+ long filesize;
+ struct stat finfo;
+ int retcode;
+ FILE_BUFFER *file_buffer = (FILE_BUFFER *)NULL;
+
+ /* Get the full pathname of this file, as known by the info system.
+ That is to say, search along INFOPATH and expand tildes, etc. */
+ fullpath = info_find_fullpath (filename);
+
+ /* Did we actually find the file? */
+ retcode = stat (fullpath, &finfo);
+
+ /* If the file referenced by the name returned from info_find_fullpath ()
+ doesn't exist, then try again with the last part of the filename
+ appearing in lowercase. */
+ if (retcode < 0)
+ {
+ char *lowered_name;
+ char *basename;
+
+ lowered_name = strdup (filename);
+ basename = (char *) strrchr (lowered_name, '/');
+
+ if (basename)
+ basename++;
+ else
+ basename = lowered_name;
+
+ while (*basename)
+ {
+ if (isupper (*basename))
+ *basename = tolower (*basename);
+
+ basename++;
+ }
+
+ fullpath = info_find_fullpath (lowered_name);
+ free (lowered_name);
+
+ retcode = stat (fullpath, &finfo);
+ }
+
+ /* If the file wasn't found, give up, returning a NULL pointer. */
+ if (retcode < 0)
+ {
+ filesys_error_number = errno;
+ return ((FILE_BUFFER *)NULL);
+ }
+
+ /* Otherwise, try to load the file. */
+ contents = filesys_read_info_file (fullpath, &filesize, &finfo);
+
+ if (!contents)
+ return ((FILE_BUFFER *)NULL);
+
+ /* The file was found, and can be read. Allocate FILE_BUFFER and fill
+ in the various members. */
+ file_buffer = make_file_buffer ();
+ file_buffer->filename = strdup (filename);
+ file_buffer->fullpath = strdup (fullpath);
+ file_buffer->finfo = finfo;
+ file_buffer->filesize = filesize;
+ file_buffer->contents = contents;
+ if (file_buffer->filesize != file_buffer->finfo.st_size)
+ file_buffer->flags |= N_IsCompressed;
+
+ /* If requested, build the tags and nodes for this file buffer. */
+ if (get_tags)
+ build_tags_and_nodes (file_buffer);
+
+ return (file_buffer);
+}
+
+/* Grovel FILE_BUFFER->contents finding tags and nodes, and filling in the
+ various slots. This can also be used to rebuild a tag or node table. */
+void
+build_tags_and_nodes (file_buffer)
+ FILE_BUFFER *file_buffer;
+{
+ SEARCH_BINDING binding;
+ long position;
+
+ free_file_buffer_tags (file_buffer);
+ file_buffer->flags &= ~N_HasTagsTable;
+
+ /* See if there is a tags table in this info file. */
+ binding.buffer = file_buffer->contents;
+ binding.start = file_buffer->filesize;
+ binding.end = binding.start - 1000;
+ if (binding.end < 0)
+ binding.end = 0;
+ binding.flags = S_FoldCase;
+
+ position = search_backward (TAGS_TABLE_END_LABEL, &binding);
+
+ /* If there is a tag table, find the start of it, and grovel over it
+ extracting tag information. */
+ if (position != -1)
+ while (1)
+ {
+ long tags_table_begin, tags_table_end;
+
+ binding.end = position;
+ binding.start = binding.end - 5 - strlen (TAGS_TABLE_END_LABEL);
+ if (binding.start < 0)
+ binding.start = 0;
+
+ position = find_node_separator (&binding);
+
+ /* For this test, (and all others here) failure indicates a bogus
+ tags table. Grovel the file. */
+ if (position == -1)
+ break;
+
+ /* Remember the end of the tags table. */
+ binding.start = position;
+ tags_table_end = binding.start;
+ binding.end = 0;
+
+ /* Locate the start of the tags table. */
+ position = search_backward (TAGS_TABLE_BEG_LABEL, &binding);
+
+ if (position == -1)
+ break;
+
+ binding.end = position;
+ binding.start = binding.end - 5 - strlen (TAGS_TABLE_BEG_LABEL);
+ position = find_node_separator (&binding);
+
+ if (position == -1)
+ break;
+
+ /* The file contains a valid tags table. Fill the FILE_BUFFER's
+ tags member. */
+ file_buffer->flags |= N_HasTagsTable;
+ tags_table_begin = position;
+
+ /* If this isn't an indirect tags table, just remember the nodes
+ described locally in this tags table. Note that binding.end
+ is pointing to just after the beginning label. */
+ binding.start = binding.end;
+ binding.end = file_buffer->filesize;
+
+ if (!looking_at (TAGS_TABLE_IS_INDIRECT_LABEL, &binding))
+ {
+ binding.start = tags_table_begin;
+ binding.end = tags_table_end;
+ get_nodes_of_tags_table (file_buffer, &binding);
+ return;
+ }
+ else
+ {
+ /* This is an indirect tags table. Build TAGS member. */
+ SEARCH_BINDING indirect;
+
+ indirect.start = tags_table_begin;
+ indirect.end = 0;
+ indirect.buffer = binding.buffer;
+ indirect.flags = S_FoldCase;
+
+ position = search_backward (INDIRECT_TAGS_TABLE_LABEL, &indirect);
+
+ if (position == -1)
+ {
+ /* This file is malformed. Give up. */
+ return;
+ }
+
+ indirect.start = position;
+ indirect.end = tags_table_begin;
+ binding.start = tags_table_begin;
+ binding.end = tags_table_end;
+ get_tags_of_indirect_tags_table (file_buffer, &indirect, &binding);
+ return;
+ }
+ }
+
+ /* This file doesn't contain any kind of tags table. Grovel the
+ file and build node entries for it. */
+ get_nodes_of_info_file (file_buffer);
+}
+
+/* Search through FILE_BUFFER->contents building an array of TAG *,
+ one entry per each node present in the file. Store the tags in
+ FILE_BUFFER->tags, and the number of allocated slots in
+ FILE_BUFFER->tags_slots. */
+static void
+get_nodes_of_info_file (file_buffer)
+ FILE_BUFFER *file_buffer;
+{
+ long nodestart;
+ int tags_index = 0;
+ SEARCH_BINDING binding;
+
+ binding.buffer = file_buffer->contents;
+ binding.start = 0;
+ binding.end = file_buffer->filesize;
+ binding.flags = S_FoldCase;
+
+ while ((nodestart = find_node_separator (&binding)) != -1)
+ {
+ int start, end;
+ char *nodeline;
+ TAG *entry;
+
+ /* Skip past the characters just found. */
+ binding.start = nodestart;
+ binding.start += skip_node_separator (binding.buffer + binding.start);
+
+ /* Move to the start of the line defining the node. */
+ nodeline = binding.buffer + binding.start;
+
+ /* Find "Node:" */
+ start = string_in_line (INFO_NODE_LABEL, nodeline);
+
+ /* If not there, this is not the start of a node. */
+ if (start == -1)
+ continue;
+
+ /* Find the start of the nodename. */
+ start += skip_whitespace (nodeline + start);
+
+ /* Find the end of the nodename. */
+ end = start +
+ skip_node_characters (nodeline + start, DONT_SKIP_NEWLINES);
+
+ /* Okay, we have isolated the node name, and we know where the
+ node starts. Remember this information in a NODE structure. */
+ entry = (TAG *)xmalloc (sizeof (TAG));
+ entry->nodename = (char *)xmalloc (1 + (end - start));
+ strncpy (entry->nodename, nodeline + start, end - start);
+ entry->nodename[end - start] = '\0';
+ entry->nodestart = nodestart;
+ {
+ SEARCH_BINDING node_body;
+
+ node_body.buffer = binding.buffer + binding.start;
+ node_body.start = 0;
+ node_body.end = binding.end - binding.start;
+ node_body.flags = S_FoldCase;
+ entry->nodelen = get_node_length (&node_body);
+ }
+
+ entry->filename = file_buffer->fullpath;
+
+ /* Add this tag to the array of tag structures in this FILE_BUFFER. */
+ add_pointer_to_array (entry, tags_index, file_buffer->tags,
+ file_buffer->tags_slots, 100, TAG *);
+ }
+}
+
+/* Return the length of the node which starts at BINDING. */
+static long
+get_node_length (binding)
+ SEARCH_BINDING *binding;
+{
+ register int i;
+ char *body;
+
+ /* From the Info-RFC file:
+ [A node] ends with either a ^_, a ^L, or the end of file. */
+ for (i = binding->start, body = binding->buffer; i < binding->end; i++)
+ {
+ if (body[i] == INFO_FF || body[i] == INFO_COOKIE)
+ break;
+ }
+ return ((long) i - binding->start);
+}
+
+/* Build and save the array of nodes in FILE_BUFFER by searching through the
+ contents of BUFFER_BINDING for a tags table, and groveling the contents. */
+static void
+get_nodes_of_tags_table (file_buffer, buffer_binding)
+ FILE_BUFFER *file_buffer;
+ SEARCH_BINDING *buffer_binding;
+{
+ int offset, tags_index = 0;
+ SEARCH_BINDING *search;
+ long position;
+
+ search = copy_binding (buffer_binding);
+
+ /* Find the start of the tags table. */
+ position = find_tags_table (search);
+
+ /* If none, we're all done. */
+ if (position == -1)
+ return;
+
+ /* Move to one character before the start of the actual table. */
+ search->start = position;
+ search->start += skip_node_separator (search->buffer + search->start);
+ search->start += strlen (TAGS_TABLE_BEG_LABEL);
+ search->start--;
+
+ /* The tag table consists of lines containing node names and positions.
+ Do each line until we find one that doesn't contain a node name. */
+ while ((position = search_forward ("\n", search)) != -1)
+ {
+ TAG *entry;
+ char *nodedef;
+
+ /* Prepare to skip this line. */
+ search->start = position;
+ search->start++;
+
+ /* Skip past informative "(Indirect)" tags table line. */
+ if (!tags_index && looking_at (TAGS_TABLE_IS_INDIRECT_LABEL, search))
+ continue;
+
+ /* Find the label preceding the node name. */
+ offset =
+ string_in_line (INFO_NODE_LABEL, search->buffer + search->start);
+
+ /* If not there, not a defining line, so we must be out of the
+ tags table. */
+ if (offset == -1)
+ break;
+
+ /* Point to the beginning of the node definition. */
+ search->start += offset;
+ nodedef = search->buffer + search->start;
+ nodedef += skip_whitespace (nodedef);
+
+ /* Move past the node's name. */
+ for (offset = 0;
+ (nodedef[offset]) && (nodedef[offset] != INFO_TAGSEP);
+ offset++);
+
+ if (nodedef[offset] != INFO_TAGSEP)
+ continue;
+
+ entry = (TAG *)xmalloc (sizeof (TAG));
+ entry->nodename = (char *)xmalloc (1 + offset);
+ strncpy (entry->nodename, nodedef, offset);
+ entry->nodename[offset] = '\0';
+ offset++;
+ entry->nodestart = (long) atol (nodedef + offset);
+
+ /* We don't know the length of this node yet. */
+ entry->nodelen = -1;
+
+ /* The filename of this node is currently known as the same as the
+ name of this file. */
+ entry->filename = file_buffer->fullpath;
+
+ /* Add this node structure to the array of node structures in this
+ FILE_BUFFER. */
+ add_pointer_to_array (entry, tags_index, file_buffer->tags,
+ file_buffer->tags_slots, 100, TAG *);
+ }
+ free (search);
+}
+
+/* A structure used only in get_tags_of_indirect_tags_table () to hold onto
+ an intermediate value. */
+typedef struct {
+ char *filename;
+ long first_byte;
+} SUBFILE;
+
+/* Remember in FILE_BUFFER the nodenames, subfilenames, and offsets within the
+ subfiles of every node which appears in TAGS_BINDING. The 2nd argument is
+ a binding surrounding the indirect files list. */
+static void
+get_tags_of_indirect_tags_table (file_buffer, indirect_binding, tags_binding)
+ FILE_BUFFER *file_buffer;
+ SEARCH_BINDING *indirect_binding, *tags_binding;
+{
+ register int i;
+ SUBFILE **subfiles = (SUBFILE **)NULL;
+ int subfiles_index = 0, subfiles_slots = 0;
+ TAG *entry;
+
+ /* First get the list of tags from the tags table. Then lookup the
+ associated file in the indirect list for each tag, and update it. */
+ get_nodes_of_tags_table (file_buffer, tags_binding);
+
+ /* We have the list of tags in file_buffer->tags. Get the list of
+ subfiles from the indirect table. */
+ {
+ char *start, *end, *line;
+ SUBFILE *subfile;
+
+ start = indirect_binding->buffer + indirect_binding->start;
+ end = indirect_binding->buffer + indirect_binding->end;
+ line = start;
+
+ while (line < end)
+ {
+ int colon;
+
+ colon = string_in_line (":", line);
+
+ if (colon == -1)
+ break;
+
+ subfile = (SUBFILE *)xmalloc (sizeof (SUBFILE));
+ subfile->filename = (char *)xmalloc (colon);
+ strncpy (subfile->filename, line, colon - 1);
+ subfile->filename[colon - 1] = '\0';
+ subfile->first_byte = (long) atol (line + colon);
+
+ add_pointer_to_array
+ (subfile, subfiles_index, subfiles, subfiles_slots, 10, SUBFILE *);
+
+ while (*line++ != '\n');
+ }
+ }
+
+ /* If we have successfully built the indirect files table, then
+ merge the information in the two tables. */
+ if (!subfiles)
+ {
+ free_file_buffer_tags (file_buffer);
+ return;
+ }
+ else
+ {
+ register int tags_index;
+ long header_length;
+ SEARCH_BINDING binding;
+
+ /* Find the length of the header of the file containing the indirect
+ tags table. This header appears at the start of every file. We
+ want the absolute position of each node within each subfile, so
+ we subtract the start of the containing subfile from the logical
+ position of the node, and then add the length of the header in. */
+ binding.buffer = file_buffer->contents;
+ binding.start = 0;
+ binding.end = file_buffer->filesize;
+ binding.flags = S_FoldCase;
+
+ header_length = find_node_separator (&binding);
+ if (header_length == -1)
+ header_length = 0;
+
+ /* Build the file buffer's list of subfiles. */
+ {
+ char *containing_dir, *temp;
+ int len_containing_dir;
+
+ containing_dir = strdup (file_buffer->fullpath);
+ temp = (char *) strrchr (containing_dir, '/');
+
+ if (temp)
+ *temp = '\0';
+
+ len_containing_dir = strlen (containing_dir);
+
+ for (i = 0; subfiles[i]; i++);
+
+ file_buffer->subfiles = (char **) xmalloc ((1 + i) * sizeof (char *));
+
+ for (i = 0; subfiles[i]; i++)
+ {
+ char *fullpath;
+
+ fullpath = (char *) xmalloc
+ (2 + strlen (subfiles[i]->filename) + len_containing_dir);
+
+ sprintf (fullpath, "%s/%s",
+ containing_dir, subfiles[i]->filename);
+
+ file_buffer->subfiles[i] = fullpath;
+ }
+ file_buffer->subfiles[i] = (char *)NULL;
+ free (containing_dir);
+ }
+
+ /* For each node in the file's tags table, remember the starting
+ position. */
+ for (tags_index = 0;
+ entry = file_buffer->tags[tags_index];
+ tags_index++)
+ {
+ for (i = 0;
+ subfiles[i] && entry->nodestart >= subfiles[i]->first_byte;
+ i++);
+
+ /* If the Info file containing the indirect tags table is
+ malformed, then give up. */
+ if (!i)
+ {
+ /* The Info file containing the indirect tags table is
+ malformed. Give up. */
+ for (i = 0; subfiles[i]; i++)
+ {
+ free (subfiles[i]->filename);
+ free (subfiles[i]);
+ free (file_buffer->subfiles[i]);
+ }
+ file_buffer->subfiles = (char **)NULL;
+ free_file_buffer_tags (file_buffer);
+ return;
+ }
+
+ /* SUBFILES[i] is the index of the first subfile whose logical
+ first byte is greater than the logical offset of this node's
+ starting position. This means that the subfile directly
+ preceding this one is the one containing the node. */
+
+ entry->filename = file_buffer->subfiles[i - 1];
+ entry->nodestart -= subfiles[i -1]->first_byte;
+ entry->nodestart += header_length;
+ entry->nodelen = -1;
+ }
+
+ /* We have successfully built the tags table. Remember that it
+ was indirect. */
+ file_buffer->flags |= N_TagsIndirect;
+ }
+
+ /* Free the structures assigned to SUBFILES. Free the names as well
+ as the structures themselves, then finally, the array. */
+ for (i = 0; subfiles[i]; i++)
+ {
+ free (subfiles[i]->filename);
+ free (subfiles[i]);
+ }
+ free (subfiles);
+}
+
+/* Return the node from FILE_BUFFER which matches NODENAME by searching
+ the tags table in FILE_BUFFER. If the node could not be found, return
+ a NULL pointer. */
+static NODE *
+info_node_of_file_buffer_tags (file_buffer, nodename)
+ FILE_BUFFER *file_buffer;
+ char *nodename;
+{
+ register int i;
+ TAG *tag;
+
+ for (i = 0; tag = file_buffer->tags[i]; i++)
+ if (strcmp (nodename, tag->nodename) == 0)
+ {
+ FILE_BUFFER *subfile;
+
+ subfile = info_find_file_internal (tag->filename, INFO_NO_TAGS);
+
+ if (!subfile)
+ return ((NODE *)NULL);
+
+ if (!subfile->contents)
+ {
+ info_reload_file_buffer_contents (subfile);
+
+ if (!subfile->contents)
+ return ((NODE *)NULL);
+ }
+
+ /* If we were able to find this file and load it, then return
+ the node within it. */
+ {
+ NODE *node;
+
+ node = (NODE *)xmalloc (sizeof (NODE));
+ node->filename = (subfile->fullpath);
+ node->nodename = tag->nodename;
+ node->contents = subfile->contents + tag->nodestart;
+ node->flags = 0;
+ node->parent = (char *)NULL;
+
+ if (file_buffer->flags & N_HasTagsTable)
+ {
+ node->flags |= N_HasTagsTable;
+
+ if (file_buffer->flags & N_TagsIndirect)
+ {
+ node->flags |= N_TagsIndirect;
+ node->parent = file_buffer->fullpath;
+ }
+ }
+
+ if (subfile->flags & N_IsCompressed)
+ node->flags |= N_IsCompressed;
+
+ /* If TAG->nodelen hasn't been calculated yet, then we aren't
+ in a position to trust the entry pointer. Adjust things so
+ that ENTRY->nodestart gets the exact address of the start of
+ the node separator which starts this node, and NODE->contents
+ gets the address of the line defining this node. If we cannot
+ do that, the node isn't really here. */
+ if (tag->nodelen == -1)
+ {
+ int min, max;
+ char *node_sep;
+ SEARCH_BINDING node_body;
+ char *buff_end;
+
+ min = max = DEFAULT_INFO_FUDGE;
+
+ if (tag->nodestart < DEFAULT_INFO_FUDGE)
+ min = tag->nodestart;
+
+ if (DEFAULT_INFO_FUDGE >
+ (subfile->filesize - tag->nodestart))
+ max = subfile->filesize - tag->nodestart;
+
+ /* NODE_SEP gets the address of the separator which defines
+ this node, or (char *)NULL if the node wasn't found.
+ NODE->contents is side-effected to point to right after
+ the separator. */
+ node_sep = adjust_nodestart (node, min, max);
+ if (node_sep == (char *)NULL)
+ {
+ free (node);
+ return ((NODE *)NULL);
+ }
+ /* Readjust tag->nodestart. */
+ tag->nodestart = node_sep - subfile->contents;
+
+ /* Calculate the length of the current node. */
+ buff_end = subfile->contents + subfile->filesize;
+
+ node_body.buffer = node->contents;
+ node_body.start = 0;
+ node_body.end = buff_end - node_body.buffer;
+ node_body.flags = 0;
+ tag->nodelen = get_node_length (&node_body);
+ }
+ else
+ {
+ /* Since we know the length of this node, we have already
+ adjusted tag->nodestart to point to the exact start of
+ it. Simply skip the node separator. */
+ node->contents += skip_node_separator (node->contents);
+ }
+
+ node->nodelen = tag->nodelen;
+ return (node);
+ }
+ }
+
+ /* There was a tag table for this file, and the node wasn't found.
+ Return NULL, since this file doesn't contain the desired node. */
+ return ((NODE *)NULL);
+}
+
+/* **************************************************************** */
+/* */
+/* Managing file_buffers, nodes, and tags. */
+/* */
+/* **************************************************************** */
+
+/* Create a new, empty file buffer. */
+FILE_BUFFER *
+make_file_buffer ()
+{
+ FILE_BUFFER *file_buffer;
+
+ file_buffer = (FILE_BUFFER *)xmalloc (sizeof (FILE_BUFFER));
+ file_buffer->filename = file_buffer->fullpath = (char *)NULL;
+ file_buffer->contents = (char *)NULL;
+ file_buffer->tags = (TAG **)NULL;
+ file_buffer->subfiles = (char **)NULL;
+ file_buffer->tags_slots = 0;
+ file_buffer->flags = 0;
+
+ return (file_buffer);
+}
+
+/* Add FILE_BUFFER to our list of already loaded info files. */
+static void
+remember_info_file (file_buffer)
+ FILE_BUFFER *file_buffer;
+{
+ int i;
+
+ for (i = 0; info_loaded_files && info_loaded_files[i]; i++)
+ ;
+
+ add_pointer_to_array (file_buffer, i, info_loaded_files,
+ info_loaded_files_slots, 10, FILE_BUFFER *);
+}
+
+/* Forget the contents, tags table, nodes list, and names of FILENAME. */
+static void
+forget_info_file (filename)
+ char *filename;
+{
+ register int i;
+ FILE_BUFFER *file_buffer;
+
+ if (!info_loaded_files)
+ return;
+
+ for (i = 0; file_buffer = info_loaded_files[i]; i++)
+ if ((strcmp (filename, file_buffer->filename) == 0) ||
+ (strcmp (filename, file_buffer->fullpath) == 0))
+ {
+ free (file_buffer->filename);
+ free (file_buffer->fullpath);
+
+ if (file_buffer->contents)
+ free (file_buffer->contents);
+
+ /* Note that free_file_buffer_tags () also kills the subfiles
+ list, since the subfiles list is only of use in conjunction
+ with tags. */
+ free_file_buffer_tags (file_buffer);
+
+ while (info_loaded_files[i] = info_loaded_files[++i])
+ ;
+
+ break;
+ }
+}
+
+/* Free the tags (if any) associated with FILE_BUFFER. */
+static void
+free_file_buffer_tags (file_buffer)
+ FILE_BUFFER *file_buffer;
+{
+ register int i;
+
+ if (file_buffer->tags)
+ {
+ register TAG *tag;
+
+ for (i = 0; tag = file_buffer->tags[i]; i++)
+ free_info_tag (tag);
+
+ free (file_buffer->tags);
+ file_buffer->tags = (TAG **)NULL;
+ file_buffer->tags_slots = 0;
+ }
+
+ if (file_buffer->subfiles)
+ {
+ for (i = 0; file_buffer->subfiles[i]; i++)
+ free (file_buffer->subfiles[i]);
+
+ free (file_buffer->subfiles);
+ file_buffer->subfiles = (char **)NULL;
+ }
+}
+
+/* Free the data associated with TAG, as well as TAG itself. */
+static void
+free_info_tag (tag)
+ TAG *tag;
+{
+ free (tag->nodename);
+
+ /* We don't free tag->filename, because that filename is part of the
+ subfiles list for the containing FILE_BUFFER. free_info_tags ()
+ will free the subfiles when it is appropriate. */
+
+ free (tag);
+}
+
+/* Load the contents of FILE_BUFFER->contents. This function is called
+ when a file buffer was loaded, and then in order to conserve memory, the
+ file buffer's contents were freed and the pointer was zero'ed. Note that
+ the file was already loaded at least once successfully, so the tags and/or
+ nodes members are still correctly filled. */
+static void
+info_reload_file_buffer_contents (fb)
+ FILE_BUFFER *fb;
+{
+
+#if defined (HANDLE_MAN_PAGES)
+ /* If this is the magic manpage node, don't try to reload, just give up. */
+ if (fb->flags & N_IsManPage)
+ return;
+#endif
+
+ fb->flags &= ~N_IsCompressed;
+
+ /* Let the filesystem do all the work for us. */
+ fb->contents =
+ filesys_read_info_file (fb->fullpath, &(fb->filesize), &(fb->finfo));
+ if (fb->filesize != (long) (fb->finfo.st_size))
+ fb->flags |= N_IsCompressed;
+}
+
+/* Return the actual starting memory location of NODE, side-effecting
+ NODE->contents. MIN and MAX are bounds for a search if one is necessary.
+ Because of the way that tags are implemented, the physical nodestart may
+ not actually be where the tag says it is. If that is the case, but the
+ node was found anyway, set N_UpdateTags in NODE->flags. If the node is
+ found, return non-zero. NODE->contents is returned positioned right after
+ the node separator that precedes this node, while the return value is
+ position directly on the separator that precedes this node. If the node
+ could not be found, return a NULL pointer. */
+static char *
+adjust_nodestart (node, min, max)
+ NODE *node;
+ int min, max;
+{
+ long position;
+ SEARCH_BINDING node_body;
+
+ /* Define the node body. */
+ node_body.buffer = node->contents;
+ node_body.start = 0;
+ node_body.end = max;
+ node_body.flags = 0;
+
+ /* Try the optimal case first. Who knows? This file may actually be
+ formatted (mostly) correctly. */
+ if (node_body.buffer[0] != INFO_COOKIE && min > 2)
+ node_body.buffer -= 3;
+
+ position = find_node_separator (&node_body);
+
+ /* If we found a node start, then check it out. */
+ if (position != -1)
+ {
+ int sep_len;
+
+ sep_len = skip_node_separator (node->contents);
+
+ /* If we managed to skip a node separator, then check for this node
+ being the right one. */
+ if (sep_len != 0)
+ {
+ char *nodedef, *nodestart;
+ int offset;
+
+ nodestart = node_body.buffer + position + sep_len;
+ nodedef = nodestart;
+ offset = string_in_line (INFO_NODE_LABEL, nodedef);
+
+ if (offset != -1)
+ {
+ nodedef += offset;
+ nodedef += skip_whitespace (nodedef);
+ offset = skip_node_characters (nodedef, DONT_SKIP_NEWLINES);
+ if ((offset == strlen (node->nodename)) &&
+ (strncmp (node->nodename, nodedef, offset) == 0))
+ {
+ node->contents = nodestart;
+ return (node_body.buffer + position);
+ }
+ }
+ }
+ }
+
+ /* Oh well, I guess we have to try to find it in a larger area. */
+ node_body.buffer = node->contents - min;
+ node_body.start = 0;
+ node_body.end = min + max;
+ node_body.flags = 0;
+
+ position = find_node_in_binding (node->nodename, &node_body);
+
+ /* If the node couldn't be found, we lose big. */
+ if (position == -1)
+ return ((char *)NULL);
+
+ /* Otherwise, the node was found, but the tags table could need updating
+ (if we used a tag to get here, that is). Set the flag in NODE->flags. */
+ node->contents = node_body.buffer + position;
+ node->contents += skip_node_separator (node->contents);
+ if (node->flags & N_HasTagsTable)
+ node->flags |= N_UpdateTags;
+ return (node_body.buffer + position);
+}
diff --git a/texinfo/info/nodes.h b/texinfo/info/nodes.h
new file mode 100644
index 00000000000..7ddea17ddda
--- /dev/null
+++ b/texinfo/info/nodes.h
@@ -0,0 +1,168 @@
+/* nodes.h -- How we represent nodes internally. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_NODES_H_)
+#define _NODES_H_
+
+#include "general.h"
+
+/* **************************************************************** */
+/* */
+/* User Code Interface */
+/* */
+/* **************************************************************** */
+
+/* Callers generally only want the node itself. This structure is used
+ to pass node information around. None of the information in this
+ structure should ever be directly freed. The structure itself can
+ be passed to free (). Note that NODE->parent is non-null if this
+ node's file is a subfile. In that case, NODE->parent is the logical
+ name of the file containing this node. Both names are given as full
+ paths, so you might have: node->filename = "/usr/gnu/info/emacs-1",
+ with node->parent = "/usr/gnu/info/emacs". */
+typedef struct {
+ char *filename; /* The physical file containing this node. */
+ char *parent; /* Non-null is the logical file name. */
+ char *nodename; /* The name of this node. */
+ char *contents; /* Characters appearing in this node. */
+ long nodelen; /* The length of the CONTENTS member. */
+ int flags; /* See immediately below. */
+} NODE;
+
+/* Defines that can appear in NODE->flags. All informative. */
+#define N_HasTagsTable 0x01 /* This node was found through a tags table. */
+#define N_TagsIndirect 0x02 /* The tags table was an indirect one. */
+#define N_UpdateTags 0x04 /* The tags table is out of date. */
+#define N_IsCompressed 0x08 /* The file is compressed on disk. */
+#define N_IsInternal 0x10 /* This node was made by Info. */
+#define N_CannotGC 0x20 /* File buffer cannot be gc'ed. */
+#define N_IsManPage 0x40 /* This node is a Un*x manpage. */
+
+/* **************************************************************** */
+/* */
+/* Internal Data Structures */
+/* */
+/* **************************************************************** */
+
+/* Some defines describing details about Info file contents. */
+
+/* String Constants. */
+#define INFO_FILE_LABEL "File:"
+#define INFO_NODE_LABEL "Node:"
+#define INFO_PREV_LABEL "Prev:"
+#define INFO_ALTPREV_LABEL "Previous:"
+#define INFO_NEXT_LABEL "Next:"
+#define INFO_UP_LABEL "Up:"
+#define INFO_MENU_LABEL "\n* Menu:"
+#define INFO_MENU_ENTRY_LABEL "\n* "
+#define INFO_XREF_LABEL "*Note"
+#define TAGS_TABLE_END_LABEL "\nEnd Tag Table"
+#define TAGS_TABLE_BEG_LABEL "Tag Table:\n"
+#define INDIRECT_TAGS_TABLE_LABEL "Indirect:\n"
+#define TAGS_TABLE_IS_INDIRECT_LABEL "(Indirect)"
+
+/* Character Constants. */
+#define INFO_COOKIE '\037'
+#define INFO_FF '\014'
+#define INFO_TAGSEP '\177'
+
+/* For each logical file that we have loaded, we keep a list of the names
+ of the nodes that are found in that file. A pointer to a node in an
+ info file is called a "tag". For split files, the tag pointer is
+ "indirect"; that is, the pointer also contains the name of the split
+ file where the node can be found. For non-split files, the filename
+ member in the structure below simply contains the name of the current
+ file. The following structure describes a single node within a file. */
+typedef struct {
+ char *filename; /* The file where this node can be found. */
+ char *nodename; /* The node pointed to by this tag. */
+ long nodestart; /* The offset of the start of this node. */
+ long nodelen; /* The length of this node. */
+} TAG;
+
+/* The following structure is used to remember information about the contents
+ of Info files that we have loaded at least once before. The FINFO member
+ is present so that we can reload the file if it has been modified since
+ last being loaded. All of the arrays appearing within this structure
+ are NULL terminated, and each array which can change size has a
+ corresponding SLOTS member which says how many slots have been allocated
+ (with malloc ()) for this array. */
+typedef struct {
+ char *filename; /* The filename used to find this file. */
+ char *fullpath; /* The full pathname of this info file. */
+ struct stat finfo; /* Information about this file. */
+ char *contents; /* The contents of this particular file. */
+ long filesize; /* The number of bytes this file expands to. */
+ char **subfiles; /* If non-null, the list of subfiles. */
+ TAG **tags; /* If non-null, the indirect tags table. */
+ int tags_slots; /* Number of slots allocated for TAGS. */
+ int flags; /* Various flags. Mimics of N_* flags. */
+} FILE_BUFFER;
+
+/* **************************************************************** */
+/* */
+/* Externally Visible Functions */
+/* */
+/* **************************************************************** */
+
+/* Array of FILE_BUFFER * which represents the currently loaded info files. */
+extern FILE_BUFFER **info_loaded_files;
+
+/* The number of slots currently allocated to INFO_LOADED_FILES. */
+extern int info_loaded_files_slots;
+
+/* Locate the file named by FILENAME, and return the information structure
+ describing this file. The file may appear in our list of loaded files
+ already, or it may not. If it does not already appear, find the file,
+ and add it to the list of loaded files. If the file cannot be found,
+ return a NULL FILE_BUFFER *. */
+extern FILE_BUFFER *info_find_file ();
+
+/* Force load the file named FILENAME, and return the information structure
+ describing this file. Even if the file was already loaded, this loads
+ a new buffer, rebuilds tags and nodes, and returns a new FILE_BUFFER *. */
+extern FILE_BUFFER *info_load_file ();
+
+/* Return a pointer to a NODE structure for the Info node (FILENAME)NODENAME.
+ FILENAME can be passed as NULL, in which case the filename of "dir" is used.
+ NODENAME can be passed as NULL, in which case the nodename of "Top" is used.
+ If the node cannot be found, return a NULL pointer. */
+extern NODE *info_get_node ();
+
+/* Return a pointer to a NODE structure for the Info node NODENAME in
+ FILE_BUFFER. NODENAME can be passed as NULL, in which case the
+ nodename of "Top" is used. If the node cannot be found, return a
+ NULL pointer. */
+extern NODE *info_get_node_of_file_buffer ();
+
+/* Grovel FILE_BUFFER->contents finding tags and nodes, and filling in the
+ various slots. This can also be used to rebuild a tag or node table. */
+extern void build_tags_and_nodes ();
+
+/* When non-zero, this is a string describing the most recent file error. */
+extern char *info_recent_file_error;
+
+/* Create a new, empty file buffer. */
+extern FILE_BUFFER *make_file_buffer ();
+
+#endif /* !_NODES_H_ */
diff --git a/texinfo/info/search.c b/texinfo/info/search.c
new file mode 100644
index 00000000000..c5fd47794b0
--- /dev/null
+++ b/texinfo/info/search.c
@@ -0,0 +1,519 @@
+/* search.c -- How to search large bodies of text. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <ctype.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "general.h"
+#include "search.h"
+#include "nodes.h"
+
+#if !defined (NULL)
+# define NULL 0x0
+#endif /* !NULL */
+
+/* The search functions take two arguments:
+
+ 1) a string to search for, and
+
+ 2) a pointer to a SEARCH_BINDING which contains the buffer, start,
+ and end of the search.
+
+ They return a long, which is the offset from the start of the buffer
+ at which the match was found. An offset of -1 indicates failure. */
+
+/* A function which makes a binding with buffer and bounds. */
+SEARCH_BINDING *
+make_binding (buffer, start, end)
+ char *buffer;
+ long start, end;
+{
+ SEARCH_BINDING *binding;
+
+ binding = (SEARCH_BINDING *)xmalloc (sizeof (SEARCH_BINDING));
+ binding->buffer = buffer;
+ binding->start = start;
+ binding->end = end;
+ binding->flags = 0;
+
+ return (binding);
+}
+
+/* Make a copy of BINDING without duplicating the data. */
+SEARCH_BINDING *
+copy_binding (binding)
+ SEARCH_BINDING *binding;
+{
+ SEARCH_BINDING *copy;
+
+ copy = make_binding (binding->buffer, binding->start, binding->end);
+ copy->flags = binding->flags;
+ return (copy);
+}
+
+
+/* **************************************************************** */
+/* */
+/* The Actual Searching Functions */
+/* */
+/* **************************************************************** */
+
+/* Search forwards or backwards for the text delimited by BINDING.
+ The search is forwards if BINDING->start is greater than BINDING->end. */
+long
+search (string, binding)
+ char *string;
+ SEARCH_BINDING *binding;
+{
+ long result;
+
+ /* If the search is backwards, then search backwards, otherwise forwards. */
+ if (binding->start > binding->end)
+ result = search_backward (string, binding);
+ else
+ result = search_forward (string, binding);
+
+ return (result);
+}
+
+/* Search forwards for STRING through the text delimited in BINDING. */
+long
+search_forward (string, binding)
+ char *string;
+ SEARCH_BINDING *binding;
+{
+ register int c, i, len;
+ register char *buff, *end;
+ char *alternate = (char *)NULL;
+
+ len = strlen (string);
+
+ /* We match characters in the search buffer against STRING and ALTERNATE.
+ ALTERNATE is a case reversed version of STRING; this is cheaper than
+ case folding each character before comparison. Alternate is only
+ used if the case folding bit is turned on in the passed BINDING. */
+
+ if (binding->flags & S_FoldCase)
+ {
+ alternate = strdup (string);
+
+ for (i = 0; i < len; i++)
+ {
+ if (islower (alternate[i]))
+ alternate[i] = toupper (alternate[i]);
+ else if (isupper (alternate[i]))
+ alternate[i] = tolower (alternate[i]);
+ }
+ }
+
+ buff = binding->buffer + binding->start;
+ end = binding->buffer + binding->end + 1;
+
+ while (buff < (end - len))
+ {
+ for (i = 0; i < len; i++)
+ {
+ c = buff[i];
+
+ if ((c != string[i]) && (!alternate || c != alternate[i]))
+ break;
+ }
+
+ if (!string[i])
+ {
+ if (alternate)
+ free (alternate);
+ if (binding->flags & S_SkipDest)
+ buff += len;
+ return ((long) (buff - binding->buffer));
+ }
+
+ buff++;
+ }
+
+ if (alternate)
+ free (alternate);
+
+ return ((long) -1);
+}
+
+/* Search for STRING backwards through the text delimited in BINDING. */
+long
+search_backward (input_string, binding)
+ char *input_string;
+ SEARCH_BINDING *binding;
+{
+ register int c, i, len;
+ register char *buff, *end;
+ char *string;
+ char *alternate = (char *)NULL;
+
+ len = strlen (input_string);
+
+ /* Reverse the characters in the search string. */
+ string = (char *)xmalloc (1 + len);
+ for (c = 0, i = len - 1; input_string[c]; c++, i--)
+ string[i] = input_string[c];
+
+ string[c] = '\0';
+
+ /* We match characters in the search buffer against STRING and ALTERNATE.
+ ALTERNATE is a case reversed version of STRING; this is cheaper than
+ case folding each character before comparison. ALTERNATE is only
+ used if the case folding bit is turned on in the passed BINDING. */
+
+ if (binding->flags & S_FoldCase)
+ {
+ alternate = strdup (string);
+
+ for (i = 0; i < len; i++)
+ {
+ if (islower (alternate[i]))
+ alternate[i] = toupper (alternate[i]);
+ else if (isupper (alternate[i]))
+ alternate[i] = tolower (alternate[i]);
+ }
+ }
+
+ buff = binding->buffer + binding->start - 1;
+ end = binding->buffer + binding->end;
+
+ while (buff > (end + len))
+ {
+ for (i = 0; i < len; i++)
+ {
+ c = *(buff - i);
+
+ if (c != string[i] && (alternate && c != alternate[i]))
+ break;
+ }
+
+ if (!string[i])
+ {
+ free (string);
+ if (alternate)
+ free (alternate);
+
+ if (binding->flags & S_SkipDest)
+ buff -= len;
+ return ((long) (1 + (buff - binding->buffer)));
+ }
+
+ buff--;
+ }
+
+ free (string);
+ if (alternate)
+ free (alternate);
+
+ return ((long) -1);
+}
+
+/* Find STRING in LINE, returning the offset of the end of the string.
+ Return an offset of -1 if STRING does not appear in LINE. The search
+ is bound by the end of the line (i.e., either NEWLINE or 0). */
+int
+string_in_line (string, line)
+ char *string, *line;
+{
+ register int end;
+ SEARCH_BINDING binding;
+
+ /* Find the end of the line. */
+ for (end = 0; line[end] && line[end] != '\n'; end++);
+
+ /* Search for STRING within these confines. */
+ binding.buffer = line;
+ binding.start = 0;
+ binding.end = end;
+ binding.flags = S_FoldCase | S_SkipDest;
+
+ return (search_forward (string, &binding));
+}
+
+/* Return non-zero if STRING is the first text to appear at BINDING. */
+int
+looking_at (string, binding)
+ char *string;
+ SEARCH_BINDING *binding;
+{
+ long search_end;
+
+ search_end = search (string, binding);
+
+ /* If the string was not found, SEARCH_END is -1. If the string was found,
+ but not right away, SEARCH_END is != binding->start. Otherwise, the
+ string was found at binding->start. */
+ return (search_end == binding->start);
+}
+
+/* **************************************************************** */
+/* */
+/* Small String Searches */
+/* */
+/* **************************************************************** */
+
+/* Function names that start with "skip" are passed a string, and return
+ an offset from the start of that string. Function names that start
+ with "find" are passed a SEARCH_BINDING, and return an absolute position
+ marker of the item being searched for. "Find" functions return a value
+ of -1 if the item being looked for couldn't be found. */
+
+/* Return the index of the first non-whitespace character in STRING. */
+int
+skip_whitespace (string)
+ char *string;
+{
+ register int i;
+
+ for (i = 0; string && whitespace (string[i]); i++);
+ return (i);
+}
+
+/* Return the index of the first non-whitespace or newline character in
+ STRING. */
+int
+skip_whitespace_and_newlines (string)
+ char *string;
+{
+ register int i;
+
+ for (i = 0; string && (whitespace (string[i]) || string[i] == '\n'); i++);
+ return (i);
+}
+
+/* Return the index of the first whitespace character in STRING. */
+int
+skip_non_whitespace (string)
+ char *string;
+{
+ register int i;
+
+ for (i = 0; string && !whitespace (string[i]); i++);
+ return (i);
+}
+
+/* Return the index of the first non-node character in STRING. Note that
+ this function contains quite a bit of hair to ignore periods in some
+ special cases. This is because we here at GNU ship some info files which
+ contain nodenames that contain periods. No such nodename can start with
+ a period, or continue with whitespace, newline, or ')' immediately following
+ the period. If second argument NEWLINES_OKAY is non-zero, newlines should
+ be skipped while parsing out the nodename specification. */
+int
+skip_node_characters (string, newlines_okay)
+ char *string;
+ int newlines_okay;
+{
+ register int c, i = 0;
+ int paren_seen = 0;
+ int paren = 0;
+
+ /* Handle special case. This is when another function has parsed out the
+ filename component of the node name, and we just want to parse out the
+ nodename proper. In that case, a period at the start of the nodename
+ indicates an empty nodename. */
+ if (string && *string == '.')
+ return (0);
+
+ if (string && *string == '(')
+ {
+ paren++;
+ paren_seen++;
+ i++;
+ }
+
+ for (; string && (c = string[i]); i++)
+ {
+ if (paren)
+ {
+ if (c == '(')
+ paren++;
+ else if (c == ')')
+ paren--;
+
+ continue;
+ }
+
+ /* If the character following the close paren is a space or period,
+ then this node name has no more characters associated with it. */
+ if (c == '\t' ||
+ c == ',' ||
+ c == INFO_TAGSEP ||
+ ((!newlines_okay) && (c == '\n')) ||
+ ((paren_seen && string[i - 1] == ')') &&
+ (c == ' ' || c == '.')) ||
+ (c == '.' &&
+ ((!string[i + 1]) ||
+ (whitespace_or_newline (string[i + 1])) ||
+ (string[i + 1] == ')'))))
+ break;
+ }
+ return (i);
+}
+
+
+/* **************************************************************** */
+/* */
+/* Searching FILE_BUFFER's */
+/* */
+/* **************************************************************** */
+
+/* Return the absolute position of the first occurence of a node separator in
+ BINDING-buffer. The search starts at BINDING->start. Return -1 if no node
+ separator was found. */
+long
+find_node_separator (binding)
+ SEARCH_BINDING *binding;
+{
+ register long i;
+ char *body;
+
+ body = binding->buffer;
+
+ /* A node is started by [^L]^_[^L]\n. That is to say, the C-l's are
+ optional, but the DELETE and NEWLINE are not. This separator holds
+ true for all separated elements in an Info file, including the tags
+ table (if present) and the indirect tags table (if present). */
+ for (i = binding->start; i < binding->end - 1; i++)
+ if (((body[i] == INFO_FF && body[i + 1] == INFO_COOKIE) &&
+ (body[i + 2] == '\n' ||
+ (body[i + 2] == INFO_FF && body[i + 3] == '\n'))) ||
+ ((body[i] == INFO_COOKIE) &&
+ (body[i + 1] == '\n' ||
+ (body[i + 1] == INFO_FF && body[i + 2] == '\n'))))
+ return (i);
+ return (-1);
+}
+
+/* Return the length of the node separator characters that BODY is
+ currently pointing at. */
+int
+skip_node_separator (body)
+ char *body;
+{
+ register int i;
+
+ i = 0;
+
+ if (body[i] == INFO_FF)
+ i++;
+
+ if (body[i++] != INFO_COOKIE)
+ return (0);
+
+ if (body[i] == INFO_FF)
+ i++;
+
+ if (body[i++] != '\n')
+ return (0);
+
+ return (i);
+}
+
+/* Return the number of characters from STRING to the start of
+ the next line. */
+int
+skip_line (string)
+ char *string;
+{
+ register int i;
+
+ for (i = 0; string && string[i] && string[i] != '\n'; i++);
+
+ if (string[i] == '\n')
+ i++;
+
+ return (i);
+}
+
+/* Return the absolute position of the beginning of a tags table in this
+ binding starting the search at binding->start. */
+long
+find_tags_table (binding)
+ SEARCH_BINDING *binding;
+{
+ SEARCH_BINDING search;
+ long position;
+
+ search.buffer = binding->buffer;
+ search.start = binding->start;
+ search.end = binding->end;
+ search.flags = S_FoldCase;
+
+ while ((position = find_node_separator (&search)) != -1 )
+ {
+ search.start = position;
+ search.start += skip_node_separator (search.buffer + search.start);
+
+ if (looking_at (TAGS_TABLE_BEG_LABEL, &search))
+ return (position);
+ }
+ return (-1);
+}
+
+/* Return the absolute position of the node named NODENAME in BINDING.
+ This is a brute force search, and we wish to avoid it when possible.
+ This function is called when a tag (indirect or otherwise) doesn't
+ really point to the right node. It returns the absolute position of
+ the separator preceding the node. */
+long
+find_node_in_binding (nodename, binding)
+ char *nodename;
+ SEARCH_BINDING *binding;
+{
+ register long position;
+ register int offset, namelen;
+ SEARCH_BINDING search;
+
+ namelen = strlen (nodename);
+
+ search.buffer = binding->buffer;
+ search.start = binding->start;
+ search.end = binding->end;
+ search.flags = 0;
+
+ while ((position = find_node_separator (&search)) != -1)
+ {
+ search.start = position;
+ search.start += skip_node_separator (search.buffer + search.start);
+
+ offset = string_in_line (INFO_NODE_LABEL, search.buffer + search.start);
+
+ if (offset == -1)
+ continue;
+
+ search.start += offset;
+ search.start += skip_whitespace (search.buffer + search.start);
+ offset = skip_node_characters
+ (search.buffer + search.start, DONT_SKIP_NEWLINES);
+
+ /* Notice that this is an exact match. You cannot grovel through
+ the buffer with this function looking for random nodes. */
+ if ((offset == namelen) &&
+ (search.buffer[search.start] == nodename[0]) &&
+ (strncmp (search.buffer + search.start, nodename, offset) == 0))
+ return (position);
+ }
+ return (-1);
+}
diff --git a/texinfo/info/search.h b/texinfo/info/search.h
new file mode 100644
index 00000000000..72695c3f0b6
--- /dev/null
+++ b/texinfo/info/search.h
@@ -0,0 +1,75 @@
+/* search.h -- Structure used to search large bodies of text, with bounds. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+/* The search functions take two arguments:
+
+ 1) a string to search for, and
+
+ 2) a pointer to a SEARCH_BINDING which contains the buffer, start,
+ and end of the search.
+
+ They return a long, which is the offset from the start of the buffer
+ at which the match was found. An offset of -1 indicates failure. */
+
+#if !defined (_SEARCH_H_)
+#define _SEARCH_H_
+
+typedef struct {
+ char *buffer; /* The buffer of text to search. */
+ long start; /* Offset of the start of the search. */
+ long end; /* Offset of the end of the searh. */
+ int flags; /* Flags controlling the type of search. */
+} SEARCH_BINDING;
+
+#define S_FoldCase 0x01 /* Set means fold case in searches. */
+#define S_SkipDest 0x02 /* Set means return pointing after the dest. */
+
+SEARCH_BINDING *make_binding (), *copy_binding ();
+extern long search_forward (), search_backward (), search ();
+extern int looking_at ();
+
+/* Note that STRING_IN_LINE () always returns the offset of the 1st character
+ after the string. */
+extern int string_in_line ();
+
+/* Some unixes don't have strcasecmp or strncasecmp. */
+#if !defined (HAVE_STRCASECMP)
+extern int strcasecmp (), strncasecmp ();
+#endif /* !HAVE_STRCASECMP */
+
+/* Function names that start with "skip" are passed a string, and return
+ an offset from the start of that string. Function names that start
+ with "find" are passed a SEARCH_BINDING, and return an absolute position
+ marker of the item being searched for. "Find" functions return a value
+ of -1 if the item being looked for couldn't be found. */
+extern int skip_whitespace (), skip_non_whitespace ();
+extern int skip_whitespace_and_newlines (), skip_line ();
+extern int skip_node_characters (), skip_node_separator ();
+#define DONT_SKIP_NEWLINES 0
+#define SKIP_NEWLINES 1
+
+extern long find_node_separator (), find_tags_table ();
+extern long find_node_in_binding ();
+
+#endif /* !_SEARCH_H_ */
+
diff --git a/texinfo/info/session.c b/texinfo/info/session.c
new file mode 100644
index 00000000000..be3076c9ac1
--- /dev/null
+++ b/texinfo/info/session.c
@@ -0,0 +1,4263 @@
+/* session.c -- The user windowing interface to Info. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+#if defined (HAVE_SYS_FILE_H)
+#include <sys/file.h>
+#endif /* HAVE_SYS_FILE_H */
+#include <sys/ioctl.h>
+#include <fcntl.h>
+
+#if defined (HAVE_SYS_TIME_H)
+# include <sys/time.h>
+# define HAVE_STRUCT_TIMEVAL
+#endif /* HAVE_SYS_TIME_H */
+
+#if defined (HANDLE_MAN_PAGES)
+# include "man.h"
+#endif
+
+static void info_clear_pending_input (), info_set_pending_input ();
+static void info_handle_pointer ();
+
+/* **************************************************************** */
+/* */
+/* Running an Info Session */
+/* */
+/* **************************************************************** */
+
+/* The place that we are reading input from. */
+static FILE *info_input_stream = (FILE *)NULL;
+
+/* The last executed command. */
+VFunction *info_last_executed_command = (VFunction *)NULL;
+
+/* Becomes non-zero when 'q' is typed to an Info window. */
+int quit_info_immediately = 0;
+
+/* Array of structures describing for each window which nodes have been
+ visited in that window. */
+INFO_WINDOW **info_windows = (INFO_WINDOW **)NULL;
+
+/* Where to add the next window, if we need to add one. */
+static int info_windows_index = 0;
+
+/* Number of slots allocated to INFO_WINDOWS. */
+static int info_windows_slots = 0;
+
+void remember_window_and_node (), forget_window_and_nodes ();
+void initialize_info_session (), info_session ();
+void display_startup_message_and_start ();
+
+/* Begin an info session finding the nodes specified by FILENAME and NODENAMES.
+ For each loaded node, create a new window. Always split the largest of the
+ available windows. */
+void
+begin_multiple_window_info_session (filename, nodenames)
+ char *filename;
+ char **nodenames;
+{
+ register int i;
+ WINDOW *window = (WINDOW *)NULL;
+
+ for (i = 0; nodenames[i]; i++)
+ {
+ NODE *node;
+
+ node = info_get_node (filename, nodenames[i]);
+
+ if (!node)
+ break;
+
+ /* If this is the first node, initialize the info session. */
+ if (!window)
+ {
+ initialize_info_session (node);
+ window = active_window;
+ }
+ else
+ {
+ /* Find the largest window in WINDOWS, and make that be the active
+ one. Then split it and add our window and node to the list
+ of remembered windows and nodes. Then tile the windows. */
+ register WINDOW *win, *largest = (WINDOW *)NULL;
+ int max_height = 0;
+
+ for (win = windows; win; win = win->next)
+ if (win->height > max_height)
+ {
+ max_height = win->height;
+ largest = win;
+ }
+
+ if (!largest)
+ {
+ display_update_display (windows);
+ info_error (CANT_FIND_WIND);
+ info_session ();
+ exit (0);
+ }
+
+ active_window = largest;
+ window = window_make_window (node);
+ if (window)
+ {
+ window_tile_windows (TILE_INTERNALS);
+ remember_window_and_node (window, node);
+ }
+ else
+ {
+ display_update_display (windows);
+ info_error (WIN_TOO_SMALL);
+ info_session ();
+ exit (0);
+ }
+ }
+ }
+ display_startup_message_and_start ();
+}
+
+/* Start an info session with INITIAL_NODE, and an error message in the echo
+ area made from FORMAT and ARG. */
+void
+begin_info_session_with_error (initial_node, format, arg)
+ NODE *initial_node;
+ char *format;
+ void *arg;
+{
+ initialize_info_session (initial_node);
+ info_error (format, arg, (void *)NULL);
+ info_session ();
+}
+
+/* Start an info session with INITIAL_NODE. */
+void
+begin_info_session (initial_node)
+ NODE *initial_node;
+{
+ initialize_info_session (initial_node);
+ display_startup_message_and_start ();
+}
+
+void
+display_startup_message_and_start ()
+{
+ char *format;
+
+ format = replace_in_documentation
+ ("Welcome to Info version %s. \"\\[get-help-window]\" for help, \"\\[menu-item]\" for menu item.");
+
+ window_message_in_echo_area (format, version_string ());
+ info_session ();
+}
+
+/* Run an info session with an already initialized window and node. */
+void
+info_session ()
+{
+ terminal_prep_terminal ();
+ display_update_display (windows);
+ info_last_executed_command = (VFunction *)NULL;
+ info_read_and_dispatch ();
+ /* On program exit, leave the cursor at the bottom of the window, and
+ restore the terminal I/O. */
+ terminal_goto_xy (0, screenheight - 1);
+ terminal_clear_to_eol ();
+ fflush (stdout);
+ terminal_unprep_terminal ();
+ close_dribble_file ();
+}
+
+/* Here is a window-location dependent event loop. Called from the
+ functions info_session (), and from read_xxx_in_echo_area (). */
+void
+info_read_and_dispatch ()
+{
+ unsigned char key;
+ int done;
+ done = 0;
+
+ while (!done && !quit_info_immediately)
+ {
+ int lk;
+
+ /* If we haven't just gone up or down a line, there is no
+ goal column for this window. */
+ if ((info_last_executed_command != info_next_line) &&
+ (info_last_executed_command != info_prev_line))
+ active_window->goal_column = -1;
+
+ if (echo_area_is_active)
+ {
+ lk = echo_area_last_command_was_kill;
+ echo_area_prep_read ();
+ }
+
+ if (!info_any_buffered_input_p ())
+ display_update_display (windows);
+
+ display_cursor_at_point (active_window);
+ info_initialize_numeric_arg ();
+
+ initialize_keyseq ();
+ key = info_get_input_char ();
+
+ /* No errors yet. We just read a character, that's all. Only clear
+ the echo_area if it is not currently active. */
+ if (!echo_area_is_active)
+ window_clear_echo_area ();
+
+ info_error_was_printed = 0;
+
+ /* Do the selected command. */
+ info_dispatch_on_key (key, active_window->keymap);
+
+ if (echo_area_is_active)
+ {
+ /* Echo area commands that do killing increment the value of
+ ECHO_AREA_LAST_COMMAND_WAS_KILL. Thus, if there is no
+ change in the value of this variable, the last command
+ executed was not a kill command. */
+ if (lk == echo_area_last_command_was_kill)
+ echo_area_last_command_was_kill = 0;
+
+ if (ea_last_executed_command == ea_newline ||
+ info_aborted_echo_area)
+ {
+ ea_last_executed_command = (VFunction *)NULL;
+ done = 1;
+ }
+
+ if (info_last_executed_command == info_quit)
+ quit_info_immediately = 1;
+ }
+ else if (info_last_executed_command == info_quit)
+ done = 1;
+ }
+}
+
+/* Found in signals.c */
+extern void initialize_info_signal_handler ();
+
+/* Initialize the first info session by starting the terminal, window,
+ and display systems. */
+void
+initialize_info_session (node)
+ NODE *node;
+{
+ char *getenv (), *term_name;
+
+ term_name = getenv ("TERM");
+ terminal_initialize_terminal (term_name);
+
+ if (terminal_is_dumb_p)
+ {
+ if (!term_name)
+ term_name = "dumb";
+
+ info_error (TERM_TOO_DUMB, term_name);
+ exit (1);
+ }
+
+ terminal_clear_screen ();
+ initialize_info_keymaps ();
+ window_initialize_windows (screenwidth, screenheight);
+ initialize_info_signal_handler ();
+ display_initialize_display (screenwidth, screenheight);
+ info_set_node_of_window (active_window, node);
+
+ /* Tell the window system how to notify us when a window needs to be
+ asynchronously deleted (e.g., user resizes window very small). */
+ window_deletion_notifier = forget_window_and_nodes;
+
+ /* If input has not been redirected yet, make it come from STDIN. */
+ if (!info_input_stream)
+ info_input_stream = stdin;
+
+ info_windows_initialized_p = 1;
+}
+
+/* Tell Info that input is coming from the file FILENAME. */
+void
+info_set_input_from_file (filename)
+ char *filename;
+{
+ FILE *stream;
+
+ stream = fopen (filename, "r");
+
+ if (!stream)
+ return;
+
+ if ((info_input_stream != (FILE *)NULL) &&
+ (info_input_stream != stdin))
+ fclose (info_input_stream);
+
+ info_input_stream = stream;
+
+ if (stream != stdin)
+ display_inhibited = 1;
+}
+
+/* Return the INFO_WINDOW containing WINDOW, or NULL if there isn't one. */
+static INFO_WINDOW *
+get_info_window_of_window (window)
+ WINDOW *window;
+{
+ register int i;
+ INFO_WINDOW *info_win = (INFO_WINDOW *)NULL;
+
+ for (i = 0; info_windows && (info_win = info_windows[i]); i++)
+ if (info_win->window == window)
+ break;
+
+ return (info_win);
+}
+
+/* Reset the remembered pagetop and point of WINDOW to WINDOW's current
+ values if the window and node are the same as the current one being
+ displayed. */
+void
+set_remembered_pagetop_and_point (window)
+ WINDOW *window;
+{
+ INFO_WINDOW *info_win;
+
+ info_win = get_info_window_of_window (window);
+
+ if (!info_win)
+ return;
+
+ if (info_win->nodes_index &&
+ (info_win->nodes[info_win->current] == window->node))
+ {
+ info_win->pagetops[info_win->current] = window->pagetop;
+ info_win->points[info_win->current] = window->point;
+ }
+}
+
+void
+remember_window_and_node (window, node)
+ WINDOW *window;
+ NODE *node;
+{
+ INFO_WINDOW *info_win;
+
+ /* See if we already have this window in our list. */
+ info_win = get_info_window_of_window (window);
+
+ /* If the window wasn't already on our list, then make a new entry. */
+ if (!info_win)
+ {
+ info_win = (INFO_WINDOW *)xmalloc (sizeof (INFO_WINDOW));
+ info_win->window = window;
+ info_win->nodes = (NODE **)NULL;
+ info_win->pagetops = (int *)NULL;
+ info_win->points = (long *)NULL;
+ info_win->current = 0;
+ info_win->nodes_index = 0;
+ info_win->nodes_slots = 0;
+
+ add_pointer_to_array (info_win, info_windows_index, info_windows,
+ info_windows_slots, 10, INFO_WINDOW *);
+ }
+
+ /* If this node, the current pagetop, and the current point are the
+ same as the last saved node and pagetop, don't really add this to
+ the list of history nodes. */
+ {
+ int ni = info_win->nodes_index - 1;
+
+ if ((ni != -1) &&
+ (info_win->nodes[ni]->contents == node->contents) &&
+ (info_win->pagetops[ni] == window->pagetop) &&
+ (info_win->points[ni] == window->point))
+ return;
+ }
+
+ /* Remember this node, the currently displayed pagetop, and the current
+ location of point in this window. Because we are updating pagetops
+ and points as well as nodes, it is more efficient to avoid the
+ add_pointer_to_array macro here. */
+ if (info_win->nodes_index + 2 >= info_win->nodes_slots)
+ {
+ info_win->nodes = (NODE **)
+ xrealloc (info_win->nodes,
+ (info_win->nodes_slots += 20) * sizeof (NODE *));
+
+ info_win->pagetops = (int *)
+ xrealloc (info_win->pagetops, info_win->nodes_slots * sizeof (int));
+
+ info_win->points = (long *)
+ xrealloc (info_win->points, info_win->nodes_slots * sizeof (long));
+ }
+
+ info_win->nodes[info_win->nodes_index] = node;
+ info_win->pagetops[info_win->nodes_index] = window->pagetop;
+ info_win->points[info_win->nodes_index] = window->point;
+ info_win->current = info_win->nodes_index++;
+ info_win->nodes[info_win->nodes_index] = (NODE *)NULL;
+ info_win->pagetops[info_win->nodes_index] = 0;
+ info_win->points[info_win->nodes_index] = 0;
+}
+
+#define DEBUG_FORGET_WINDOW_AND_NODES
+#if defined (DEBUG_FORGET_WINDOW_AND_NODES)
+static void
+consistency_check_info_windows ()
+{
+ register int i;
+ INFO_WINDOW *info_win;
+
+ for (i = 0; i < info_windows_index; i++)
+ {
+ WINDOW *win;
+
+ for (win = windows; win; win = win->next)
+ if (win == info_windows[i]->window)
+ break;
+
+ if (!win)
+ abort ();
+ }
+}
+#endif /* DEBUG_FORGET_WINDOW_AND_NODES */
+
+/* Remove WINDOW and its associated list of nodes from INFO_WINDOWS. */
+void
+forget_window_and_nodes (window)
+ WINDOW *window;
+{
+ register int i;
+ INFO_WINDOW *info_win = (INFO_WINDOW *)NULL;
+
+ for (i = 0; info_windows && (info_win = info_windows[i]); i++)
+ if (info_win->window == window)
+ break;
+
+ /* If we found the window to forget, then do so. */
+ if (info_win)
+ {
+ while (i < info_windows_index)
+ {
+ info_windows[i] = info_windows[i + 1];
+ i++;
+ }
+
+ info_windows_index--;
+ info_windows[info_windows_index] = (INFO_WINDOW *)NULL;
+
+ if (info_win->nodes)
+ {
+ /* Free the node structures which held onto internal node contents
+ here. This doesn't free the contents; we have a garbage collector
+ which does that. */
+ for (i = 0; info_win->nodes[i]; i++)
+ if (internal_info_node_p (info_win->nodes[i]))
+ free (info_win->nodes[i]);
+ free (info_win->nodes);
+
+ maybe_free (info_win->pagetops);
+ maybe_free (info_win->points);
+ }
+
+ free (info_win);
+ }
+#if defined (DEBUG_FORGET_WINDOW_AND_NODES)
+ consistency_check_info_windows ();
+#endif /* DEBUG_FORGET_WINDOW_AND_NODES */
+}
+
+/* Set WINDOW to show NODE. Remember the new window in our list of Info
+ windows. If we are doing automatic footnote display, also try to display
+ the footnotes for this window. */
+void
+info_set_node_of_window (window, node)
+ WINDOW *window;
+ NODE *node;
+{
+ /* Put this node into the window. */
+ window_set_node_of_window (window, node);
+
+ /* Remember this node and window in our list of info windows. */
+ remember_window_and_node (window, node);
+
+ /* If doing auto-footnote display/undisplay, show the footnotes belonging
+ to this window's node. */
+ if (auto_footnotes_p)
+ info_get_or_remove_footnotes (window);
+}
+
+
+/* **************************************************************** */
+/* */
+/* Info Movement Commands */
+/* */
+/* **************************************************************** */
+
+/* Change the pagetop of WINDOW to DESIRED_TOP, perhaps scrolling the screen
+ to do so. */
+void
+set_window_pagetop (window, desired_top)
+ WINDOW *window;
+ int desired_top;
+{
+ int point_line, old_pagetop;
+
+ if (desired_top < 0)
+ desired_top = 0;
+ else if (desired_top > window->line_count)
+ desired_top = window->line_count - 1;
+
+ if (window->pagetop == desired_top)
+ return;
+
+ old_pagetop = window->pagetop;
+ window->pagetop = desired_top;
+
+ /* Make sure that point appears in this window. */
+ point_line = window_line_of_point (window);
+ if ((point_line < window->pagetop) ||
+ ((point_line - window->pagetop) > window->height - 1))
+ window->point =
+ window->line_starts[window->pagetop] - window->node->contents;
+
+ window->flags |= W_UpdateWindow;
+
+ /* Find out which direction to scroll, and scroll the window in that
+ direction. Do this only if there would be a savings in redisplay
+ time. This is true if the amount to scroll is less than the height
+ of the window, and if the number of lines scrolled would be greater
+ than 10 % of the window's height. */
+ if (old_pagetop < desired_top)
+ {
+ int start, end, amount;
+
+ amount = desired_top - old_pagetop;
+
+ if ((amount >= window->height) ||
+ (((window->height - amount) * 10) < window->height))
+ return;
+
+ start = amount + window->first_row;
+ end = window->height + window->first_row;
+
+ display_scroll_display (start, end, -amount);
+ }
+ else
+ {
+ int start, end, amount;
+
+ amount = old_pagetop - desired_top;
+
+ if ((amount >= window->height) ||
+ (((window->height - amount) * 10) < window->height))
+ return;
+
+ start = window->first_row;
+ end = (window->first_row + window->height) - amount;
+ display_scroll_display (start, end, amount);
+ }
+}
+
+/* Immediately make WINDOW->point visible on the screen, and move the
+ terminal cursor there. */
+static void
+info_show_point (window)
+ WINDOW *window;
+{
+ int old_pagetop;
+
+ old_pagetop = window->pagetop;
+ window_adjust_pagetop (window);
+ if (old_pagetop != window->pagetop)
+ {
+ int new_pagetop;
+
+ new_pagetop = window->pagetop;
+ window->pagetop = old_pagetop;
+ set_window_pagetop (window, new_pagetop);
+ }
+
+ if (window->flags & W_UpdateWindow)
+ display_update_one_window (window);
+
+ display_cursor_at_point (window);
+}
+
+/* Move WINDOW->point from OLD line index to NEW line index. */
+static void
+move_to_new_line (old, new, window)
+ int old, new;
+ WINDOW *window;
+{
+ if (old == -1)
+ {
+ info_error (CANT_FIND_POINT);
+ }
+ else
+ {
+ int goal;
+
+ if (new >= window->line_count || new < 0)
+ return;
+
+ goal = window_get_goal_column (window);
+ window->goal_column = goal;
+
+ window->point = window->line_starts[new] - window->node->contents;
+ window->point += window_chars_to_goal (window->line_starts[new], goal);
+ info_show_point (window);
+ }
+}
+
+/* Move WINDOW's point down to the next line if possible. */
+DECLARE_INFO_COMMAND (info_next_line, "Move down to the next line")
+{
+ int old_line, new_line;
+
+ if (count < 0)
+ info_prev_line (window, -count, key);
+ else
+ {
+ old_line = window_line_of_point (window);
+ new_line = old_line + count;
+ move_to_new_line (old_line, new_line, window);
+ }
+}
+
+/* Move WINDOW's point up to the previous line if possible. */
+DECLARE_INFO_COMMAND (info_prev_line, "Move up to the previous line")
+{
+ int old_line, new_line;
+
+ if (count < 0)
+ info_next_line (window, -count, key);
+ else
+ {
+ old_line = window_line_of_point (window);
+ new_line = old_line - count;
+ move_to_new_line (old_line, new_line, window);
+ }
+}
+
+/* Move WINDOW's point to the end of the true line. */
+DECLARE_INFO_COMMAND (info_end_of_line, "Move to the end of the line")
+{
+ register int point, len;
+ register char *buffer;
+
+ buffer = window->node->contents;
+ len = window->node->nodelen;
+
+ for (point = window->point;
+ (point < len) && (buffer[point] != '\n');
+ point++);
+
+ if (point != window->point)
+ {
+ window->point = point;
+ info_show_point (window);
+ }
+}
+
+/* Move WINDOW's point to the beginning of the true line. */
+DECLARE_INFO_COMMAND (info_beginning_of_line, "Move to the start of the line")
+{
+ register int point;
+ register char *buffer;
+
+ buffer = window->node->contents;
+ point = window->point;
+
+ for (; (point) && (buffer[point - 1] != '\n'); point--);
+
+ /* If at a line start alreay, do nothing. */
+ if (point != window->point)
+ {
+ window->point = point;
+ info_show_point (window);
+ }
+}
+
+/* Move point forward in the node. */
+DECLARE_INFO_COMMAND (info_forward_char, "Move forward a character")
+{
+ if (count < 0)
+ info_backward_char (window, -count, key);
+ else
+ {
+ window->point += count;
+
+ if (window->point >= window->node->nodelen)
+ window->point = window->node->nodelen - 1;
+
+ info_show_point (window);
+ }
+}
+
+/* Move point backward in the node. */
+DECLARE_INFO_COMMAND (info_backward_char, "Move backward a character")
+{
+ if (count < 0)
+ info_forward_char (window, -count, key);
+ else
+ {
+ window->point -= count;
+
+ if (window->point < 0)
+ window->point = 0;
+
+ info_show_point (window);
+ }
+}
+
+#define alphabetic(c) (islower (c) || isupper (c) || isdigit (c))
+
+/* Move forward a word in this node. */
+DECLARE_INFO_COMMAND (info_forward_word, "Move forward a word")
+{
+ long point;
+ char *buffer;
+ int end, c;
+
+ if (count < 0)
+ {
+ info_backward_word (window, -count, key);
+ return;
+ }
+
+ point = window->point;
+ buffer = window->node->contents;
+ end = window->node->nodelen;
+
+ while (count)
+ {
+ if (point + 1 >= end)
+ return;
+
+ /* If we are not in a word, move forward until we are in one.
+ Then, move forward until we hit a non-alphabetic character. */
+ c = buffer[point];
+
+ if (!alphabetic (c))
+ {
+ while (++point < end)
+ {
+ c = buffer[point];
+ if (alphabetic (c))
+ break;
+ }
+ }
+
+ if (point >= end) return;
+
+ while (++point < end)
+ {
+ c = buffer[point];
+ if (!alphabetic (c))
+ break;
+ }
+ --count;
+ }
+ window->point = point;
+ info_show_point (window);
+}
+
+DECLARE_INFO_COMMAND (info_backward_word, "Move backward a word")
+{
+ long point;
+ char *buffer;
+ int c;
+
+ if (count < 0)
+ {
+ info_forward_word (window, -count, key);
+ return;
+ }
+
+ buffer = window->node->contents;
+ point = window->point;
+
+ while (count)
+ {
+ if (point == 0)
+ break;
+
+ /* Like info_forward_word (), except that we look at the
+ characters just before point. */
+
+ c = buffer[point - 1];
+
+ if (!alphabetic (c))
+ {
+ while (--point)
+ {
+ c = buffer[point - 1];
+ if (alphabetic (c))
+ break;
+ }
+ }
+
+ while (point)
+ {
+ c = buffer[point - 1];
+ if (!alphabetic (c))
+ break;
+ else
+ --point;
+ }
+ --count;
+ }
+ window->point = point;
+ info_show_point (window);
+}
+
+/* Here is a list of time counter names which correspond to ordinal numbers.
+ It is used to print "once" instead of "1". */
+static char *counter_names[] = {
+ "not at all", "once", "twice", "three", "four", "five", "six",
+ (char *)NULL
+};
+
+/* Buffer used to return values from times_description (). */
+static char td_buffer[50];
+
+/* Function returns a static string fully describing the number of times
+ present in COUNT. */
+static char *
+times_description (count)
+ int count;
+{
+ register int i;
+
+ td_buffer[0] = '\0';
+
+ for (i = 0; counter_names[i]; i++)
+ if (count == i)
+ break;
+
+ if (counter_names[i])
+ sprintf (td_buffer, "%s%s", counter_names[i], count > 2 ? " times" : "");
+ else
+ sprintf (td_buffer, "%d times", count);
+
+ return (td_buffer);
+}
+
+/* Variable controlling the behaviour of default scrolling when you are
+ already at the bottom of a node. Possible values are defined in session.h.
+ The meanings are:
+
+ IS_Continuous Try to get first menu item, or failing that, the
+ "Next:" pointer, or failing that, the "Up:" and
+ "Next:" of the up.
+ IS_NextOnly Try to get "Next:" menu item.
+ IS_PageOnly Simply give up at the bottom of a node. */
+
+int info_scroll_behaviour = IS_Continuous;
+
+/* Choices used by the completer when reading a value for the user-visible
+ variable "scroll-behaviour". */
+char *info_scroll_choices[] = {
+ "Continuous", "Next Only", "Page Only", (char *)NULL
+};
+
+/* Move to 1st menu item, Next, Up/Next, or error in this window. */
+static void
+forward_move_node_structure (window, behaviour)
+ WINDOW *window;
+ int behaviour;
+{
+ switch (behaviour)
+ {
+ case IS_PageOnly:
+ info_error (AT_NODE_BOTTOM);
+ break;
+
+ case IS_NextOnly:
+ info_next_label_of_node (window->node);
+ if (!info_parsed_nodename && !info_parsed_filename)
+ info_error ("No \"Next\" pointer for this node.");
+ else
+ {
+ window_message_in_echo_area ("Following \"Next\" node...");
+ info_handle_pointer ("Next", window);
+ }
+ break;
+
+ case IS_Continuous:
+ {
+ /* First things first. If this node contains a menu, move down
+ into the menu. */
+ {
+ REFERENCE **menu;
+
+ menu = info_menu_of_node (window->node);
+
+ if (menu)
+ {
+ info_free_references (menu);
+ window_message_in_echo_area ("Selecting first menu item...");
+ info_menu_digit (window, 1, '1');
+ return;
+ }
+ }
+
+ /* Okay, this node does not contain a menu. If it contains a
+ "Next:" pointer, use that. */
+ info_next_label_of_node (window->node);
+ if (info_label_was_found)
+ {
+ window_message_in_echo_area ("Selecting \"Next\" node...");
+ info_handle_pointer ("Next", window);
+ return;
+ }
+
+ /* Okay, there wasn't a "Next:" for this node. Move "Up:" until we
+ can move "Next:". If that isn't possible, complain that there
+ are no more nodes. */
+ {
+ int up_counter, old_current;
+ INFO_WINDOW *info_win;
+
+ /* Remember the current node and location. */
+ info_win = get_info_window_of_window (window);
+ old_current = info_win->current;
+
+ /* Back up through the "Up:" pointers until we have found a "Next:"
+ that isn't the same as the first menu item found in that node. */
+ up_counter = 0;
+ while (!info_error_was_printed)
+ {
+ info_up_label_of_node (window->node);
+ if (info_label_was_found)
+ {
+ info_handle_pointer ("Up", window);
+ if (info_error_was_printed)
+ continue;
+
+ up_counter++;
+
+ info_next_label_of_node (window->node);
+
+ /* If no "Next" pointer, keep backing up. */
+ if (!info_label_was_found)
+ continue;
+
+ /* If this node's first menu item is the same as this node's
+ Next pointer, keep backing up. */
+ if (!info_parsed_filename)
+ {
+ REFERENCE **menu;
+ char *next_nodename;
+
+ /* Remember the name of the Next node, since reading
+ the menu can overwrite the contents of the
+ info_parsed_xxx strings. */
+ next_nodename = strdup (info_parsed_nodename);
+
+ menu = info_menu_of_node (window->node);
+ if (menu &&
+ (strcmp
+ (menu[0]->nodename, next_nodename) == 0))
+ {
+ info_free_references (menu);
+ free (next_nodename);
+ continue;
+ }
+ else
+ {
+ /* Restore the world to where it was before
+ reading the menu contents. */
+ info_free_references (menu);
+ free (next_nodename);
+ info_next_label_of_node (window->node);
+ }
+ }
+
+ /* This node has a "Next" pointer, and it is not the
+ same as the first menu item found in this node. */
+ window_message_in_echo_area
+ ("Moving \"Up\" %s, then \"Next\".",
+ times_description (up_counter));
+
+ info_handle_pointer ("Next", window);
+ return;
+ }
+ else
+ {
+ /* No more "Up" pointers. Print an error, and call it
+ quits. */
+ register int i;
+
+ for (i = 0; i < up_counter; i++)
+ {
+ info_win->nodes_index--;
+ free (info_win->nodes[info_win->nodes_index]);
+ info_win->nodes[info_win->nodes_index] = (NODE *)NULL;
+ }
+ info_win->current = old_current;
+ window->node = info_win->nodes[old_current];
+ window->pagetop = info_win->pagetops[old_current];
+ window->point = info_win->points[old_current];
+ recalculate_line_starts (window);
+ window->flags |= W_UpdateWindow;
+ info_error ("No more nodes.");
+ }
+ }
+ }
+ break;
+ }
+ }
+}
+
+/* Move Prev, Up or error in WINDOW depending on BEHAVIOUR. */
+static void
+backward_move_node_structure (window, behaviour)
+ WINDOW *window;
+ int behaviour;
+{
+ switch (behaviour)
+ {
+ case IS_PageOnly:
+ info_error (AT_NODE_TOP);
+ break;
+
+ case IS_NextOnly:
+ info_prev_label_of_node (window->node);
+ if (!info_parsed_nodename && !info_parsed_filename)
+ info_error ("No \"Prev\" for this node.");
+ else
+ {
+ window_message_in_echo_area ("Moving \"Prev\" in this window.");
+ info_handle_pointer ("Prev", window);
+ }
+ break;
+
+ case IS_Continuous:
+ info_prev_label_of_node (window->node);
+
+ if (!info_parsed_nodename && !info_parsed_filename)
+ {
+ info_up_label_of_node (window->node);
+ if (!info_parsed_nodename && !info_parsed_filename)
+ info_error ("No \"Prev\" or \"Up\" for this node.");
+ else
+ {
+ window_message_in_echo_area ("Moving \"Up\" in this window.");
+ info_handle_pointer ("Up", window);
+ }
+ }
+ else
+ {
+ REFERENCE **menu;
+ int inhibit_menu_traversing = 0;
+
+ /* Watch out! If this node's Prev is the same as the Up, then
+ move Up. Otherwise, we could move Prev, and then to the last
+ menu item in the Prev. This would cause the user to loop
+ through a subsection of the info file. */
+ if (!info_parsed_filename && info_parsed_nodename)
+ {
+ char *pnode;
+
+ pnode = strdup (info_parsed_nodename);
+ info_up_label_of_node (window->node);
+
+ if (!info_parsed_filename && info_parsed_nodename &&
+ strcmp (info_parsed_nodename, pnode) == 0)
+ {
+ /* The nodes are the same. Inhibit moving to the last
+ menu item. */
+ free (pnode);
+ inhibit_menu_traversing = 1;
+ }
+ else
+ {
+ free (pnode);
+ info_prev_label_of_node (window->node);
+ }
+ }
+
+ /* Move to the previous node. If this node now contains a menu,
+ and we have not inhibited movement to it, move to the node
+ corresponding to the last menu item. */
+ window_message_in_echo_area ("Moving \"Prev\" in this window.");
+ info_handle_pointer ("Prev", window);
+
+ if (!inhibit_menu_traversing)
+ {
+ while (!info_error_was_printed &&
+ (menu = info_menu_of_node (window->node)))
+ {
+ info_free_references (menu);
+ window_message_in_echo_area
+ ("Moving to \"Prev\"'s last menu item.");
+ info_menu_digit (window, 1, '0');
+ }
+ }
+ }
+ break;
+ }
+}
+
+/* Move continuously forward through the node structure of this info file. */
+DECLARE_INFO_COMMAND (info_global_next_node,
+ "Move forwards or down through node structure")
+{
+ if (count < 0)
+ info_global_prev_node (window, -count, key);
+ else
+ {
+ while (count && !info_error_was_printed)
+ {
+ forward_move_node_structure (window, IS_Continuous);
+ count--;
+ }
+ }
+}
+
+/* Move continuously backward through the node structure of this info file. */
+DECLARE_INFO_COMMAND (info_global_prev_node,
+ "Move backwards or up through node structure")
+{
+ if (count < 0)
+ info_global_next_node (window, -count, key);
+ else
+ {
+ while (count && !info_error_was_printed)
+ {
+ backward_move_node_structure (window, IS_Continuous);
+ count--;
+ }
+ }
+}
+
+/* Show the next screen of WINDOW's node. */
+DECLARE_INFO_COMMAND (info_scroll_forward, "Scroll forward in this window")
+{
+ if (count < 0)
+ info_scroll_backward (window, -count, key);
+ else
+ {
+ int desired_top;
+
+ /* Without an explicit numeric argument, scroll the bottom two
+ lines to the top of this window, Or, if at bottom of window,
+ and the user wishes to scroll through nodes get the "Next" node
+ for this window. */
+ if (!info_explicit_arg && count == 1)
+ {
+ desired_top = window->pagetop + (window->height - 2);
+
+ /* If there are no more lines to scroll here, error, or get
+ another node, depending on INFO_SCROLL_BEHAVIOUR. */
+ if (desired_top > window->line_count)
+ {
+ int behaviour = info_scroll_behaviour;
+
+ /* Here is a hack. If the key being used is not SPC, do the
+ PageOnly behaviour. */
+ if (key != SPC && key != DEL)
+ behaviour = IS_PageOnly;
+
+ forward_move_node_structure (window, behaviour);
+ return;
+ }
+ }
+ else
+ desired_top = window->pagetop + count;
+
+ if (desired_top >= window->line_count)
+ desired_top = window->line_count - 2;
+
+ if (window->pagetop > desired_top)
+ return;
+ else
+ set_window_pagetop (window, desired_top);
+ }
+}
+
+/* Show the previous screen of WINDOW's node. */
+DECLARE_INFO_COMMAND (info_scroll_backward, "Scroll backward in this window")
+{
+ if (count < 0)
+ info_scroll_forward (window, -count, key);
+ else
+ {
+ int desired_top;
+
+ /* Without an explicit numeric argument, scroll the top two lines
+ to the bottom of this window, or move to the previous, or Up'th
+ node. */
+ if (!info_explicit_arg && count == 1)
+ {
+ desired_top = window->pagetop - (window->height - 2);
+
+ if ((desired_top < 0) && (window->pagetop == 0))
+ {
+ int behaviour = info_scroll_behaviour;
+
+ /* Same kind of hack as in info_scroll_forward. If the key
+ used to invoke this command is not DEL, do only the PageOnly
+ behaviour. */
+ if (key != DEL && key != SPC)
+ behaviour = IS_PageOnly;
+
+ backward_move_node_structure (window, behaviour);
+ return;
+ }
+ }
+ else
+ desired_top = window->pagetop - count;
+
+ if (desired_top < 0)
+ desired_top = 0;
+
+ set_window_pagetop (window, desired_top);
+ }
+}
+
+/* Move to the beginning of the node. */
+DECLARE_INFO_COMMAND (info_beginning_of_node, "Move to the start of this node")
+{
+ window->pagetop = window->point = 0;
+ window->flags |= W_UpdateWindow;
+}
+
+/* Move to the end of the node. */
+DECLARE_INFO_COMMAND (info_end_of_node, "Move to the end of this node")
+{
+ window->point = window->node->nodelen - 1;
+ info_show_point (window);
+}
+
+/* **************************************************************** */
+/* */
+/* Commands for Manipulating Windows */
+/* */
+/* **************************************************************** */
+
+/* Make the next window in the chain be the active window. */
+DECLARE_INFO_COMMAND (info_next_window, "Select the next window")
+{
+ if (count < 0)
+ {
+ info_prev_window (window, -count, key);
+ return;
+ }
+
+ /* If no other window, error now. */
+ if (!windows->next && !echo_area_is_active)
+ {
+ info_error (ONE_WINDOW);
+ return;
+ }
+
+ while (count--)
+ {
+ if (window->next)
+ window = window->next;
+ else
+ {
+ if (window == the_echo_area || !echo_area_is_active)
+ window = windows;
+ else
+ window = the_echo_area;
+ }
+ }
+
+ if (active_window != window)
+ {
+ if (auto_footnotes_p)
+ info_get_or_remove_footnotes (window);
+
+ window->flags |= W_UpdateWindow;
+ active_window = window;
+ }
+}
+
+/* Make the previous window in the chain be the active window. */
+DECLARE_INFO_COMMAND (info_prev_window, "Select the previous window")
+{
+ if (count < 0)
+ {
+ info_next_window (window, -count, key);
+ return;
+ }
+
+ /* Only one window? */
+
+ if (!windows->next && !echo_area_is_active)
+ {
+ info_error (ONE_WINDOW);
+ return;
+ }
+
+ while (count--)
+ {
+ /* If we are in the echo area, or if the echo area isn't active and we
+ are in the first window, find the last window in the chain. */
+ if (window == the_echo_area ||
+ (window == windows && !echo_area_is_active))
+ {
+ register WINDOW *win, *last;
+
+ for (win = windows; win; win = win->next)
+ last = win;
+
+ window = last;
+ }
+ else
+ {
+ if (window == windows)
+ window = the_echo_area;
+ else
+ window = window->prev;
+ }
+ }
+
+ if (active_window != window)
+ {
+ if (auto_footnotes_p)
+ info_get_or_remove_footnotes (window);
+
+ window->flags |= W_UpdateWindow;
+ active_window = window;
+ }
+}
+
+/* Split WINDOW into two windows, both showing the same node. If we
+ are automatically tiling windows, re-tile after the split. */
+DECLARE_INFO_COMMAND (info_split_window, "Split the current window")
+{
+ WINDOW *split, *old_active;
+ int pagetop;
+
+ /* Remember the current pagetop of the window being split. If it doesn't
+ change, we can scroll its contents around after the split. */
+ pagetop = window->pagetop;
+
+ /* Make the new window. */
+ old_active = active_window;
+ active_window = window;
+ split = window_make_window (window->node);
+ active_window = old_active;
+
+ if (!split)
+ {
+ info_error (WIN_TOO_SMALL);
+ }
+ else
+ {
+#if defined (SPLIT_BEFORE_ACTIVE)
+ /* Try to scroll the old window into its new postion. */
+ if (pagetop == window->pagetop)
+ {
+ int start, end, amount;
+
+ start = split->first_row;
+ end = start + window->height;
+ amount = split->height + 1;
+ display_scroll_display (start, end, amount);
+ }
+#else /* !SPLIT_BEFORE_ACTIVE */
+ /* Make sure point still appears in the active window. */
+ info_show_point (window);
+#endif /* !SPLIT_BEFORE_ACTIVE */
+
+ /* If the window just split was one internal to Info, try to display
+ something else in it. */
+ if (internal_info_node_p (split->node))
+ {
+ register int i, j;
+ INFO_WINDOW *iw;
+ NODE *node = (NODE *)NULL;
+ char *filename;
+
+ for (i = 0; iw = info_windows[i]; i++)
+ {
+ for (j = 0; j < iw->nodes_index; j++)
+ if (!internal_info_node_p (iw->nodes[j]))
+ {
+ if (iw->nodes[j]->parent)
+ filename = iw->nodes[j]->parent;
+ else
+ filename = iw->nodes[j]->filename;
+
+ node = info_get_node (filename, iw->nodes[j]->nodename);
+ if (node)
+ {
+ window_set_node_of_window (split, node);
+ i = info_windows_index - 1;
+ break;
+ }
+ }
+ }
+ }
+ split->pagetop = window->pagetop;
+
+ if (auto_tiling_p)
+ window_tile_windows (DONT_TILE_INTERNALS);
+ else
+ window_adjust_pagetop (split);
+
+ remember_window_and_node (split, split->node);
+ }
+}
+
+/* Delete WINDOW, forgetting the list of last visited nodes. If we are
+ automatically displaying footnotes, show or remove the footnotes
+ window. If we are automatically tiling windows, re-tile after the
+ deletion. */
+DECLARE_INFO_COMMAND (info_delete_window, "Delete the current window")
+{
+ if (!windows->next)
+ {
+ info_error (CANT_KILL_LAST);
+ }
+ else if (window->flags & W_WindowIsPerm)
+ {
+ info_error ("Cannot delete a permanent window");
+ }
+ else
+ {
+ info_delete_window_internal (window);
+
+ if (auto_footnotes_p)
+ info_get_or_remove_footnotes (active_window);
+
+ if (auto_tiling_p)
+ window_tile_windows (DONT_TILE_INTERNALS);
+ }
+}
+
+/* Do the physical deletion of WINDOW, and forget this window and
+ associated nodes. */
+void
+info_delete_window_internal (window)
+ WINDOW *window;
+{
+ if (windows->next && ((window->flags & W_WindowIsPerm) == 0))
+ {
+ /* We not only delete the window from the display, we forget it from
+ our list of remembered windows. */
+ forget_window_and_nodes (window);
+ window_delete_window (window);
+
+ if (echo_area_is_active)
+ echo_area_inform_of_deleted_window (window);
+ }
+}
+
+/* Just keep WINDOW, deleting all others. */
+DECLARE_INFO_COMMAND (info_keep_one_window, "Delete all other windows")
+{
+ int num_deleted; /* The number of windows we deleted. */
+ int pagetop, start, end;
+
+ /* Remember a few things about this window. We may be able to speed up
+ redisplay later by scrolling its contents. */
+ pagetop = window->pagetop;
+ start = window->first_row;
+ end = start + window->height;
+
+ num_deleted = 0;
+
+ while (1)
+ {
+ WINDOW *win;
+
+ /* Find an eligible window and delete it. If no eligible windows
+ are found, we are done. A window is eligible for deletion if
+ is it not permanent, and it is not WINDOW. */
+ for (win = windows; win; win = win->next)
+ if (win != window && ((win->flags & W_WindowIsPerm) == 0))
+ break;
+
+ if (!win)
+ break;
+
+ info_delete_window_internal (win);
+ num_deleted++;
+ }
+
+ /* Scroll the contents of this window into the right place so that the
+ user doesn't have to wait any longer than necessary for redisplay. */
+ if (num_deleted)
+ {
+ int amount;
+
+ amount = (window->first_row - start);
+ amount -= (window->pagetop - pagetop);
+ display_scroll_display (start, end, amount);
+ }
+
+ window->flags |= W_UpdateWindow;
+}
+
+/* Scroll the "other" window of WINDOW. */
+DECLARE_INFO_COMMAND (info_scroll_other_window, "Scroll the other window")
+{
+ WINDOW *other;
+
+ /* If only one window, give up. */
+ if (!windows->next)
+ {
+ info_error (ONE_WINDOW);
+ return;
+ }
+
+ other = window->next;
+
+ if (!other)
+ other = window->prev;
+
+ info_scroll_forward (other, count, key);
+}
+
+/* Change the size of WINDOW by AMOUNT. */
+DECLARE_INFO_COMMAND (info_grow_window, "Grow (or shrink) this window")
+{
+ window_change_window_height (window, count);
+}
+
+/* When non-zero, tiling takes place automatically when info_split_window
+ is called. */
+int auto_tiling_p = 0;
+
+/* Tile all of the visible windows. */
+DECLARE_INFO_COMMAND (info_tile_windows,
+ "Divide the available screen space among the visible windows")
+{
+ window_tile_windows (TILE_INTERNALS);
+}
+
+/* Toggle the state of this window's wrapping of lines. */
+DECLARE_INFO_COMMAND (info_toggle_wrap,
+ "Toggle the state of line wrapping in the current window")
+{
+ window_toggle_wrap (window);
+}
+
+/* **************************************************************** */
+/* */
+/* Info Node Commands */
+/* */
+/* **************************************************************** */
+
+/* Using WINDOW for various defaults, select the node referenced by ENTRY
+ in it. If the node is selected, the window and node are remembered. */
+void
+info_select_reference (window, entry)
+ WINDOW *window;
+ REFERENCE *entry;
+{
+ NODE *node;
+ char *filename, *nodename, *file_system_error;
+
+ file_system_error = (char *)NULL;
+
+ filename = entry->filename;
+ if (!filename)
+ filename = window->node->parent;
+ if (!filename)
+ filename = window->node->filename;
+
+ if (filename)
+ filename = strdup (filename);
+
+ if (entry->nodename)
+ nodename = strdup (entry->nodename);
+ else
+ nodename = strdup ("Top");
+
+ node = info_get_node (filename, nodename);
+
+ /* Try something a little weird. If the node couldn't be found, and the
+ reference was of the form "foo::", see if the entry->label can be found
+ as a file, with a node of "Top". */
+ if (!node)
+ {
+ if (info_recent_file_error)
+ file_system_error = strdup (info_recent_file_error);
+
+ if (entry->nodename && (strcmp (entry->nodename, entry->label) == 0))
+ {
+ node = info_get_node (entry->label, "Top");
+ if (!node && info_recent_file_error)
+ {
+ maybe_free (file_system_error);
+ file_system_error = strdup (info_recent_file_error);
+ }
+ }
+ }
+
+ if (!node)
+ {
+ if (file_system_error)
+ info_error (file_system_error);
+ else
+ info_error (CANT_FIND_NODE, nodename);
+ }
+
+ maybe_free (file_system_error);
+ maybe_free (filename);
+ maybe_free (nodename);
+
+ if (node)
+ {
+ set_remembered_pagetop_and_point (window);
+ info_set_node_of_window (window, node);
+ }
+}
+
+/* Parse the node specification in LINE using WINDOW to default the filename.
+ Select the parsed node in WINDOW and remember it, or error if the node
+ couldn't be found. */
+static void
+info_parse_and_select (line, window)
+ char *line;
+ WINDOW *window;
+{
+ REFERENCE entry;
+
+ info_parse_node (line, DONT_SKIP_NEWLINES);
+
+ entry.nodename = info_parsed_nodename;
+ entry.filename = info_parsed_filename;
+ entry.label = "*info-parse-and-select*";
+
+ info_select_reference (window, &entry);
+}
+
+/* Given that the values of INFO_PARSED_FILENAME and INFO_PARSED_NODENAME
+ are previously filled, try to get the node represented by them into
+ WINDOW. The node should have been pointed to by the LABEL pointer of
+ WINDOW->node. */
+static void
+info_handle_pointer (label, window)
+ char *label;
+ WINDOW *window;
+{
+ if (info_parsed_filename || info_parsed_nodename)
+ {
+ char *filename, *nodename;
+ NODE *node;
+
+ filename = nodename = (char *)NULL;
+
+ if (info_parsed_filename)
+ filename = strdup (info_parsed_filename);
+ else
+ {
+ if (window->node->parent)
+ filename = strdup (window->node->parent);
+ else if (window->node->filename)
+ filename = strdup (window->node->filename);
+ }
+
+ if (info_parsed_nodename)
+ nodename = strdup (info_parsed_nodename);
+ else
+ nodename = strdup ("Top");
+
+ node = info_get_node (filename, nodename);
+
+ if (node)
+ {
+ INFO_WINDOW *info_win;
+
+ info_win = get_info_window_of_window (window);
+ if (info_win)
+ {
+ info_win->pagetops[info_win->current] = window->pagetop;
+ info_win->points[info_win->current] = window->point;
+ }
+ set_remembered_pagetop_and_point (window);
+ info_set_node_of_window (window, node);
+ }
+ else
+ {
+ if (info_recent_file_error)
+ info_error (info_recent_file_error);
+ else
+ info_error (CANT_FILE_NODE, filename, nodename);
+ }
+
+ free (filename);
+ free (nodename);
+ }
+ else
+ {
+ info_error (NO_POINTER, label);
+ }
+}
+
+/* Make WINDOW display the "Next:" node of the node currently being
+ displayed. */
+DECLARE_INFO_COMMAND (info_next_node, "Select the `Next' node")
+{
+ info_next_label_of_node (window->node);
+ info_handle_pointer ("Next", window);
+}
+
+/* Make WINDOW display the "Prev:" node of the node currently being
+ displayed. */
+DECLARE_INFO_COMMAND (info_prev_node, "Select the `Prev' node")
+{
+ info_prev_label_of_node (window->node);
+ info_handle_pointer ("Prev", window);
+}
+
+/* Make WINDOW display the "Up:" node of the node currently being
+ displayed. */
+DECLARE_INFO_COMMAND (info_up_node, "Select the `Up' node")
+{
+ info_up_label_of_node (window->node);
+ info_handle_pointer ("Up", window);
+}
+
+/* Make WINDOW display the last node of this info file. */
+DECLARE_INFO_COMMAND (info_last_node, "Select the last node in this file")
+{
+ register int i;
+ FILE_BUFFER *fb = file_buffer_of_window (window);
+ NODE *node = (NODE *)NULL;
+
+ if (fb && fb->tags)
+ {
+ for (i = 0; fb->tags[i]; i++);
+ node = info_get_node (fb->filename, fb->tags[i - 1]->nodename);
+ }
+
+ if (!node)
+ info_error ("This window has no additional nodes");
+ else
+ {
+ set_remembered_pagetop_and_point (window);
+ info_set_node_of_window (window, node);
+ }
+}
+
+/* Make WINDOW display the first node of this info file. */
+DECLARE_INFO_COMMAND (info_first_node, "Select the first node in this file")
+{
+ FILE_BUFFER *fb = file_buffer_of_window (window);
+ NODE *node = (NODE *)NULL;
+
+ if (fb && fb->tags)
+ node = info_get_node (fb->filename, fb->tags[0]->nodename);
+
+ if (!node)
+ info_error ("This window has no additional nodes");
+ else
+ {
+ set_remembered_pagetop_and_point (window);
+ info_set_node_of_window (window, node);
+ }
+}
+
+/* Make WINDOW display the previous node displayed in this window. */
+DECLARE_INFO_COMMAND (info_history_node,
+ "Select the most recently selected node")
+{
+ INFO_WINDOW *info_win;
+
+ /* Find the INFO_WINDOW which contains WINDOW. */
+ info_win = get_info_window_of_window (window);
+
+ if (!info_win)
+ {
+ info_error ("Requested window is not present!");
+ return;
+ }
+
+ set_remembered_pagetop_and_point (window);
+ if (!info_win->current)
+ {
+ if (info_win->nodes_index > 1)
+ {
+ window_message_in_echo_area
+ ("Now wrapped around to beginning of history.");
+ info_win->current = info_win->nodes_index;
+ }
+ else
+ {
+ info_error ("No earlier nodes in this window.");
+ return;
+ }
+ }
+
+ info_win->current--;
+ window_set_node_of_window (window, info_win->nodes[info_win->current]);
+ window->pagetop = info_win->pagetops[info_win->current];
+ window->point = info_win->points[info_win->current];
+ window->flags |= W_UpdateWindow;
+ if (auto_footnotes_p)
+ info_get_or_remove_footnotes (window);
+}
+
+/* Select the last menu item in WINDOW->node. */
+DECLARE_INFO_COMMAND (info_last_menu_item,
+ "Select the last item in this node's menu")
+{
+ info_menu_digit (window, 1, '0');
+}
+
+/* Use KEY (a digit) to select the Nth menu item in WINDOW->node. */
+DECLARE_INFO_COMMAND (info_menu_digit, "Select this menu item")
+{
+ register int i, item;
+ register REFERENCE *entry, **menu;
+
+ menu = info_menu_of_node (window->node);
+
+ if (!menu)
+ {
+ info_error (NO_MENU_NODE);
+ return;
+ }
+
+ /* We have the menu. See if there are this many items in it. */
+ item = key - '0';
+
+ /* Special case. Item "0" is the last item in this menu. */
+ if (item == 0)
+ for (i = 0; menu[i + 1]; i++);
+ else
+ {
+ for (i = 0; entry = menu[i]; i++)
+ if (i == item - 1)
+ break;
+ }
+
+ if (menu[i])
+ info_select_reference (window, menu[i]);
+ else
+ info_error ("There aren't %d items in this menu.", item);
+
+ info_free_references (menu);
+ return;
+}
+
+/* Read a menu or followed reference from the user defaulting to the
+ reference found on the current line, and select that node. The
+ reading is done with completion. BUILDER is the function used
+ to build the list of references. ASK_P is non-zero if the user
+ should be prompted, or zero to select the default item. */
+static void
+info_menu_or_ref_item (window, count, key, builder, ask_p)
+ WINDOW *window;
+ int count;
+ unsigned char key;
+ REFERENCE **(*builder) ();
+ int ask_p;
+{
+ REFERENCE **menu, *entry, *defentry = (REFERENCE *)NULL;
+ char *line;
+
+ menu = (*builder) (window->node);
+
+ if (!menu)
+ {
+ if (builder == info_menu_of_node)
+ info_error (NO_MENU_NODE);
+ else
+ info_error (NO_XREF_NODE);
+ return;
+ }
+
+ /* Default the selected reference to the one which is on the line that
+ point is in. */
+ {
+ REFERENCE **refs = (REFERENCE **)NULL;
+ int point_line;
+
+ point_line = window_line_of_point (window);
+
+ if (point_line != -1)
+ {
+ SEARCH_BINDING binding;
+
+ binding.buffer = window->node->contents;
+ binding.start = window->line_starts[point_line] - binding.buffer;
+ if (window->line_starts[point_line + 1])
+ binding.end = window->line_starts[point_line + 1] - binding.buffer;
+ else
+ binding.end = window->node->nodelen;
+ binding.flags = 0;
+
+ if (builder == info_menu_of_node)
+ {
+ if (point_line)
+ {
+ binding.start--;
+ refs = info_menu_items (&binding);
+ }
+ }
+ else
+ {
+#if defined (HANDLE_MAN_PAGES)
+ if (window->node->flags & N_IsManPage)
+ refs = manpage_xrefs_in_binding (window->node, &binding);
+ else
+#endif /* HANDLE_MAN_PAGES */
+ refs = info_xrefs (&binding);
+ }
+
+ if (refs)
+ {
+ if ((strcmp (refs[0]->label, "Menu") != 0) ||
+ (builder == info_xrefs_of_node))
+ {
+ int which = 0;
+
+ /* Find the closest reference to point. */
+ if (builder == info_xrefs_of_node)
+ {
+ int closest = -1;
+
+ for (; refs[which]; which++)
+ {
+ if ((window->point >= refs[which]->start) &&
+ (window->point <= refs[which]->end))
+ {
+ closest = which;
+ break;
+ }
+ else if (window->point < refs[which]->start)
+ {
+ break;
+ }
+ }
+ if (closest == -1)
+ which--;
+ else
+ which = closest;
+ }
+
+ defentry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ defentry->label = strdup (refs[which]->label);
+ defentry->filename = refs[which]->filename;
+ defentry->nodename = refs[which]->nodename;
+
+ if (defentry->filename)
+ defentry->filename = strdup (defentry->filename);
+ if (defentry->nodename)
+ defentry->nodename = strdup (defentry->nodename);
+ }
+ info_free_references (refs);
+ }
+ }
+ }
+
+ /* If we are going to ask the user a question, do it now. */
+ if (ask_p)
+ {
+ char *prompt;
+
+ /* Build the prompt string. */
+ if (defentry)
+ prompt = (char *)xmalloc (20 + strlen (defentry->label));
+ else
+ prompt = (char *)xmalloc (20);
+
+ if (builder == info_menu_of_node)
+ {
+ if (defentry)
+ sprintf (prompt, "Menu item (%s): ", defentry->label);
+ else
+ sprintf (prompt, "Menu item: ");
+ }
+ else
+ {
+ if (defentry)
+ sprintf (prompt, "Follow xref (%s): ", defentry->label);
+ else
+ sprintf (prompt, "Follow xref: ");
+ }
+
+ line = info_read_completing_in_echo_area (window, prompt, menu);
+ free (prompt);
+
+ window = active_window;
+
+ /* User aborts, just quit. */
+ if (!line)
+ {
+ maybe_free (defentry);
+ info_free_references (menu);
+ info_abort_key (window, 0, 0);
+ return;
+ }
+
+ /* If we had a default and the user accepted it, use that. */
+ if (!*line)
+ {
+ free (line);
+ if (defentry)
+ line = strdup (defentry->label);
+ else
+ line = (char *)NULL;
+ }
+ }
+ else
+ {
+ /* Not going to ask any questions. If we have a default entry, use
+ that, otherwise return. */
+ if (!defentry)
+ return;
+ else
+ line = strdup (defentry->label);
+ }
+
+ if (line)
+ {
+ /* Find the selected label in the references. */
+ entry = info_get_labeled_reference (line, menu);
+
+ if (!entry && defentry)
+ info_error ("The reference disappeared! (%s).", line);
+ else
+ {
+ NODE *orig;
+
+ orig = window->node;
+ info_select_reference (window, entry);
+ if ((builder == info_xrefs_of_node) && (window->node != orig))
+ {
+ long offset;
+ long start;
+
+ if (window->line_count > 0)
+ start = window->line_starts[1] - window->node->contents;
+ else
+ start = 0;
+
+ offset =
+ info_target_search_node (window->node, entry->label, start);
+
+ if (offset != -1)
+ {
+ window->point = offset;
+ window_adjust_pagetop (window);
+ }
+ }
+ }
+
+ free (line);
+ if (defentry)
+ {
+ free (defentry->label);
+ maybe_free (defentry->filename);
+ maybe_free (defentry->nodename);
+ free (defentry);
+ }
+ }
+
+ info_free_references (menu);
+
+ if (!info_error_was_printed)
+ window_clear_echo_area ();
+}
+
+/* Read a line (with completion) which is the name of a menu item,
+ and select that item. */
+DECLARE_INFO_COMMAND (info_menu_item, "Read a menu item and select its node")
+{
+ info_menu_or_ref_item (window, count, key, info_menu_of_node, 1);
+}
+
+/* Read a line (with completion) which is the name of a reference to
+ follow, and select the node. */
+DECLARE_INFO_COMMAND
+ (info_xref_item, "Read a footnote or cross reference and select its node")
+{
+ info_menu_or_ref_item (window, count, key, info_xrefs_of_node, 1);
+}
+
+/* Position the cursor at the start of this node's menu. */
+DECLARE_INFO_COMMAND (info_find_menu, "Move to the start of this node's menu")
+{
+ SEARCH_BINDING binding;
+ long position;
+
+ binding.buffer = window->node->contents;
+ binding.start = 0;
+ binding.end = window->node->nodelen;
+ binding.flags = S_FoldCase | S_SkipDest;
+
+ position = search (INFO_MENU_LABEL, &binding);
+
+ if (position == -1)
+ info_error (NO_MENU_NODE);
+ else
+ {
+ window->point = position;
+ window_adjust_pagetop (window);
+ window->flags |= W_UpdateWindow;
+ }
+}
+
+/* Visit as many menu items as is possible, each in a separate window. */
+DECLARE_INFO_COMMAND (info_visit_menu,
+ "Visit as many menu items at once as possible")
+{
+ register int i;
+ REFERENCE *entry, **menu;
+
+ menu = info_menu_of_node (window->node);
+
+ if (!menu)
+ info_error (NO_MENU_NODE);
+
+ for (i = 0; (!info_error_was_printed) && (entry = menu[i]); i++)
+ {
+ WINDOW *new;
+
+ new = window_make_window (window->node);
+ window_tile_windows (TILE_INTERNALS);
+
+ if (!new)
+ info_error (WIN_TOO_SMALL);
+ else
+ {
+ active_window = new;
+ info_select_reference (new, entry);
+ }
+ }
+}
+
+/* Read a line of input which is a node name, and go to that node. */
+DECLARE_INFO_COMMAND (info_goto_node, "Read a node name and select it")
+{
+ char *line;
+ NODE *node;
+
+#define GOTO_COMPLETES
+#if defined (GOTO_COMPLETES)
+ /* Build a completion list of all of the known nodes. */
+ {
+ register int fbi, i;
+ FILE_BUFFER *current;
+ REFERENCE **items = (REFERENCE **)NULL;
+ int items_index = 0;
+ int items_slots = 0;
+
+ current = file_buffer_of_window (window);
+
+ for (fbi = 0; info_loaded_files && info_loaded_files[fbi]; fbi++)
+ {
+ FILE_BUFFER *fb;
+ REFERENCE *entry;
+ int this_is_the_current_fb;
+
+ fb = info_loaded_files[fbi];
+ this_is_the_current_fb = (current == fb);
+
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->filename = entry->nodename = (char *)NULL;
+ entry->label = (char *)xmalloc (4 + strlen (fb->filename));
+ sprintf (entry->label, "(%s)*", fb->filename);
+
+ add_pointer_to_array
+ (entry, items_index, items, items_slots, 10, REFERENCE *);
+
+ if (fb->tags)
+ {
+ for (i = 0; fb->tags[i]; i++)
+ {
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->filename = entry->nodename = (char *)NULL;
+ entry->label = (char *) xmalloc
+ (4 + strlen (fb->filename) + strlen (fb->tags[i]->nodename));
+ sprintf (entry->label, "(%s)%s",
+ fb->filename, fb->tags[i]->nodename);
+
+ add_pointer_to_array
+ (entry, items_index, items, items_slots, 100, REFERENCE *);
+ }
+
+ if (this_is_the_current_fb)
+ {
+ for (i = 0; fb->tags[i]; i++)
+ {
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->filename = entry->nodename = (char *)NULL;
+ entry->label = strdup (fb->tags[i]->nodename);
+ add_pointer_to_array (entry, items_index, items,
+ items_slots, 100, REFERENCE *);
+ }
+ }
+ }
+ }
+ line = info_read_maybe_completing (window, "Goto Node: ", items);
+ info_free_references (items);
+ }
+#else /* !GOTO_COMPLETES */
+ line = info_read_in_echo_area (window, "Goto Node: ");
+#endif /* !GOTO_COMPLETES */
+
+ /* If the user aborted, quit now. */
+ if (!line)
+ {
+ info_abort_key (window, 0, 0);
+ return;
+ }
+
+ canonicalize_whitespace (line);
+
+ if (*line)
+ info_parse_and_select (line, window);
+
+ free (line);
+ if (!info_error_was_printed)
+ window_clear_echo_area ();
+}
+
+#if defined (HANDLE_MAN_PAGES)
+DECLARE_INFO_COMMAND (info_man, "Read a manpage reference and select it")
+{
+ char *line;
+ NODE *node;
+
+ line = info_read_in_echo_area (window, "Get Manpage: ");
+
+ if (!line)
+ {
+ info_abort_key (window, 0, 0);
+ return;
+ }
+
+ canonicalize_whitespace (line);
+
+ if (*line)
+ {
+ char *goto_command;
+
+ goto_command = (char *)xmalloc
+ (4 + strlen (MANPAGE_FILE_BUFFER_NAME) + strlen (line));
+
+ sprintf (goto_command, "(%s)%s", MANPAGE_FILE_BUFFER_NAME, line);
+
+ info_parse_and_select (goto_command, window);
+ free (goto_command);
+ }
+
+ free (line);
+ if (!info_error_was_printed)
+ window_clear_echo_area ();
+}
+#endif /* HANDLE_MAN_PAGES */
+
+/* Move to the "Top" node in this file. */
+DECLARE_INFO_COMMAND (info_top_node, "Select the node `Top' in this file")
+{
+ info_parse_and_select ("Top", window);
+}
+
+/* Move to the node "(dir)Top". */
+DECLARE_INFO_COMMAND (info_dir_node, "Select the node `(dir)'")
+{
+ info_parse_and_select ("(dir)Top", window);
+}
+
+/* Try to delete the current node appearing in this window, showing the most
+ recently selected node in this window. */
+DECLARE_INFO_COMMAND (info_kill_node, "Kill this node")
+{
+ register int iw, i;
+ register INFO_WINDOW *info_win;
+ char *nodename = (char *)NULL;
+ NODE *temp = (NODE *)NULL;
+
+ /* Read the name of a node to kill. The list of available nodes comes
+ from the nodes appearing in the current window configuration. */
+ {
+ REFERENCE **menu = (REFERENCE **)NULL;
+ int menu_index = 0, menu_slots = 0;
+ char *default_nodename, *prompt;
+
+ for (iw = 0; info_win = info_windows[iw]; iw++)
+ {
+ REFERENCE *entry;
+
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->label = strdup (info_win->window->node->nodename);
+ entry->filename = entry->nodename = (char *)NULL;
+
+ add_pointer_to_array
+ (entry, menu_index, menu, menu_slots, 10, REFERENCE *);
+ }
+
+ default_nodename = strdup (active_window->node->nodename);
+ prompt = (char *)xmalloc (40 + strlen (default_nodename));
+ sprintf (prompt, "Kill node (%s): ", default_nodename);
+
+ nodename = info_read_completing_in_echo_area (window, prompt, menu);
+ free (prompt);
+ info_free_references (menu);
+ if (nodename && !*nodename)
+ {
+ free (nodename);
+ nodename = default_nodename;
+ }
+ else
+ free (default_nodename);
+ }
+
+ /* If there is no nodename to kill, quit now. */
+ if (!nodename)
+ {
+ info_abort_key (window, 0, 0);
+ return;
+ }
+
+ /* If there is a nodename, find it in our window list. */
+ for (iw = 0; info_win = info_windows[iw]; iw++)
+ if (strcmp (nodename, info_win->nodes[info_win->current]->nodename) == 0)
+ break;
+
+ if (!info_win)
+ {
+ if (*nodename)
+ info_error ("Cannot kill the node `%s'", nodename);
+ else
+ window_clear_echo_area ();
+
+ return;
+ }
+
+ /* If there are no more nodes left anywhere to view, complain and exit. */
+ if (info_windows_index == 1 && info_windows[0]->nodes_index == 1)
+ {
+ info_error ("Cannot kill the last node");
+ return;
+ }
+
+ /* INFO_WIN contains the node that the user wants to stop viewing.
+ Delete this node from the list of nodes previously shown in this
+ window. */
+ for (i = info_win->current; i < info_win->nodes_index; i++)
+ info_win->nodes[i] = info_win->nodes[i++];
+
+ /* There is one less node in this window's history list. */
+ info_win->nodes_index--;
+
+ /* Make this window show the most recent history node. */
+ info_win->current = info_win->nodes_index - 1;
+
+ /* If there aren't any nodes left in this window, steal one from the
+ next window. */
+ if (info_win->current < 0)
+ {
+ INFO_WINDOW *stealer;
+ int which, pagetop;
+ long point;
+
+ if (info_windows[iw + 1])
+ stealer = info_windows[iw + 1];
+ else
+ stealer = info_windows[0];
+
+ /* If the node being displayed in the next window is not the most
+ recently loaded one, get the most recently loaded one. */
+ if ((stealer->nodes_index - 1) != stealer->current)
+ which = stealer->nodes_index - 1;
+
+ /* Else, if there is another node behind the stealers current node,
+ use that one. */
+ else if (stealer->current > 0)
+ which = stealer->current - 1;
+
+ /* Else, just use the node appearing in STEALER's window. */
+ else
+ which = stealer->current;
+
+ /* Copy this node. */
+ {
+ NODE *copy;
+
+ temp = stealer->nodes[which];
+ point = stealer->points[which];
+ pagetop = stealer->pagetops[which];
+
+ copy = (NODE *)xmalloc (sizeof (NODE));
+ copy->filename = temp->filename;
+ copy->parent = temp->parent;
+ copy->nodename = temp->nodename;
+ copy->contents = temp->contents;
+ copy->nodelen = temp->nodelen;
+ copy->flags = temp->flags;
+
+ temp = copy;
+ }
+
+ window_set_node_of_window (info_win->window, temp);
+ window->point = point;
+ window->pagetop = pagetop;
+ remember_window_and_node (info_win->window, temp);
+ }
+ else
+ {
+ temp = info_win->nodes[info_win->current];
+ window_set_node_of_window (info_win->window, temp);
+ }
+ if (!info_error_was_printed)
+ window_clear_echo_area ();
+}
+
+/* Read the name of a file and select the entire file. */
+DECLARE_INFO_COMMAND (info_view_file, "Read the name of a file and select it")
+{
+ char *line;
+
+ line = info_read_in_echo_area (window, "Find file: ");
+ if (!line)
+ {
+ info_abort_key (active_window, 1, 0);
+ return;
+ }
+
+ if (*line)
+ {
+ NODE *node;
+
+ node = info_get_node (line, "*");
+ if (!node)
+ {
+ if (info_recent_file_error)
+ info_error (info_recent_file_error);
+ else
+ info_error ("Cannot find \"%s\".", line);
+ }
+ else
+ {
+ set_remembered_pagetop_and_point (active_window);
+ info_set_node_of_window (window, node);
+ }
+ free (line);
+ }
+
+ if (!info_error_was_printed)
+ window_clear_echo_area ();
+}
+
+/* **************************************************************** */
+/* */
+/* Dumping and Printing Nodes */
+/* */
+/* **************************************************************** */
+
+#define VERBOSE_NODE_DUMPING
+static void write_node_to_stream ();
+static void dump_node_to_stream ();
+static void initialize_dumping ();
+
+/* Dump the nodes specified by FILENAME and NODENAMES to the file named
+ in OUTPUT_FILENAME. If DUMP_SUBNODES is non-zero, recursively dump
+ the nodes which appear in the menu of each node dumped. */
+void
+dump_nodes_to_file (filename, nodenames, output_filename, dump_subnodes)
+ char *filename;
+ char **nodenames;
+ char *output_filename;
+ int dump_subnodes;
+{
+ register int i;
+ FILE *output_stream;
+
+ /* Get the stream to print the nodes to. Special case of an output
+ filename of "-" means to dump the nodes to stdout. */
+ if (strcmp (output_filename, "-") == 0)
+ output_stream = stdout;
+ else
+ output_stream = fopen (output_filename, "w");
+
+ if (!output_stream)
+ {
+ info_error ("Could not create output file \"%s\".", output_filename);
+ return;
+ }
+
+ /* Print each node to stream. */
+ initialize_dumping ();
+ for (i = 0; nodenames[i]; i++)
+ dump_node_to_stream (filename, nodenames[i], output_stream, dump_subnodes);
+
+ if (output_stream != stdout)
+ fclose (output_stream);
+
+#if defined (VERBOSE_NODE_DUMPING)
+ info_error ("Done.");
+#endif /* VERBOSE_NODE_DUMPING */
+}
+
+/* A place to remember already dumped nodes. */
+static char **dumped_already = (char **)NULL;
+static int dumped_already_index = 0;
+static int dumped_already_slots = 0;
+
+static void
+initialize_dumping ()
+{
+ dumped_already_index = 0;
+}
+
+/* Get and print the node specified by FILENAME and NODENAME to STREAM.
+ If DUMP_SUBNODES is non-zero, recursively dump the nodes which appear
+ in the menu of each node dumped. */
+static void
+dump_node_to_stream (filename, nodename, stream, dump_subnodes)
+ char *filename, *nodename;
+ FILE *stream;
+ int dump_subnodes;
+{
+ register int i;
+ NODE *node;
+
+ node = info_get_node (filename, nodename);
+
+ if (!node)
+ {
+ if (info_recent_file_error)
+ info_error (info_recent_file_error);
+ else
+ {
+ if (filename && *nodename != '(')
+ info_error
+ (CANT_FILE_NODE, filename_non_directory (filename), nodename);
+ else
+ info_error (CANT_FIND_NODE, nodename);
+ }
+ return;
+ }
+
+ /* If we have already dumped this node, don't dump it again. */
+ for (i = 0; i < dumped_already_index; i++)
+ if (strcmp (node->nodename, dumped_already[i]) == 0)
+ {
+ free (node);
+ return;
+ }
+ add_pointer_to_array (node->nodename, dumped_already_index, dumped_already,
+ dumped_already_slots, 50, char *);
+
+#if defined (VERBOSE_NODE_DUMPING)
+ /* Maybe we should print some information about the node being output. */
+ if (node->filename)
+ info_error ("Writing node \"(%s)%s\"...",
+ filename_non_directory (node->filename), node->nodename);
+ else
+ info_error ("Writing node \"%s\"...", node->nodename);
+#endif /* VERBOSE_NODE_DUMPING */
+
+ write_node_to_stream (node, stream);
+
+ /* If we are dumping subnodes, get the list of menu items in this node,
+ and dump each one recursively. */
+ if (dump_subnodes)
+ {
+ REFERENCE **menu = (REFERENCE **)NULL;
+
+ /* If this node is an Index, do not dump the menu references. */
+ if (string_in_line ("Index", node->nodename) == -1)
+ menu = info_menu_of_node (node);
+
+ if (menu)
+ {
+ for (i = 0; menu[i]; i++)
+ {
+ /* We don't dump Info files which are different than the
+ current one. */
+ if (!menu[i]->filename)
+ dump_node_to_stream
+ (filename, menu[i]->nodename, stream, dump_subnodes);
+ }
+ info_free_references (menu);
+ }
+ }
+
+ free (node);
+}
+
+/* Dump NODE to FILENAME. If DUMP_SUBNODES is non-zero, recursively dump
+ the nodes which appear in the menu of each node dumped. */
+void
+dump_node_to_file (node, filename, dump_subnodes)
+ NODE *node;
+ char *filename;
+ int dump_subnodes;
+{
+ FILE *output_stream;
+ char *nodes_filename;
+
+ /* Get the stream to print this node to. Special case of an output
+ filename of "-" means to dump the nodes to stdout. */
+ if (strcmp (filename, "-") == 0)
+ output_stream = stdout;
+ else
+ output_stream = fopen (filename, "w");
+
+ if (!output_stream)
+ {
+ info_error ("Could not create output file \"%s\".", filename);
+ return;
+ }
+
+ if (node->parent)
+ nodes_filename = node->parent;
+ else
+ nodes_filename = node->filename;
+
+ initialize_dumping ();
+ dump_node_to_stream
+ (nodes_filename, node->nodename, output_stream, dump_subnodes);
+
+ if (output_stream != stdout)
+ fclose (output_stream);
+
+#if defined (VERBOSE_NODE_DUMPING)
+ info_error ("Done.");
+#endif /* VERBOSE_NODE_DUMPING */
+}
+
+#if !defined (DEFAULT_INFO_PRINT_COMMAND)
+# define DEFAULT_INFO_PRINT_COMMAND "lpr"
+#endif /* !DEFAULT_INFO_PRINT_COMMAND */
+
+DECLARE_INFO_COMMAND (info_print_node,
+ "Pipe the contents of this node through INFO_PRINT_COMMAND")
+{
+ print_node (window->node);
+}
+
+/* Print NODE on a printer piping it into INFO_PRINT_COMMAND. */
+void
+print_node (node)
+ NODE *node;
+{
+ char *print_command, *getenv ();
+ FILE *printer_pipe;
+
+ print_command = getenv ("INFO_PRINT_COMMAND");
+
+ if (!print_command || !*print_command)
+ print_command = DEFAULT_INFO_PRINT_COMMAND;
+
+ printer_pipe = popen (print_command, "w");
+
+ if (!printer_pipe)
+ {
+ info_error ("Cannot open pipe to \"%s\".", print_command);
+ return;
+ }
+
+#if defined (VERBOSE_NODE_DUMPING)
+ /* Maybe we should print some information about the node being output. */
+ if (node->filename)
+ info_error ("Printing node \"(%s)%s\"...",
+ filename_non_directory (node->filename), node->nodename);
+ else
+ info_error ("Printing node \"%s\"...", node->nodename);
+#endif /* VERBOSE_NODE_DUMPING */
+
+ write_node_to_stream (node, printer_pipe);
+ pclose (printer_pipe);
+
+#if defined (VERBOSE_NODE_DUMPING)
+ info_error ("Done.");
+#endif /* VERBOSE_NODE_DUMPING */
+}
+
+static void
+write_node_to_stream (node, stream)
+ NODE *node;
+ FILE *stream;
+{
+ fwrite (node->contents, 1, node->nodelen, stream);
+}
+
+/* **************************************************************** */
+/* */
+/* Info Searching Commands */
+/* */
+/* **************************************************************** */
+
+/* Variable controlling the garbage collection of files briefly visited
+ during searches. Such files are normally gc'ed, unless they were
+ compressed to begin with. If this variable is non-zero, it says
+ to gc even those file buffer contents which had to be uncompressed. */
+int gc_compressed_files = 0;
+
+static void info_gc_file_buffers ();
+
+static char *search_string = (char *)NULL;
+static int search_string_index = 0;
+static int search_string_size = 0;
+static int isearch_is_active = 0;
+
+/* Return the file buffer which belongs to WINDOW's node. */
+FILE_BUFFER *
+file_buffer_of_window (window)
+ WINDOW *window;
+{
+ /* If this window has no node, then it has no file buffer. */
+ if (!window->node)
+ return ((FILE_BUFFER *)NULL);
+
+ if (window->node->parent)
+ return (info_find_file (window->node->parent));
+
+ if (window->node->filename)
+ return (info_find_file (window->node->filename));
+
+ return ((FILE_BUFFER *)NULL);
+}
+
+/* Search for STRING in NODE starting at START. Return -1 if the string
+ was not found, or the location of the string if it was. If WINDOW is
+ passed as non-null, set the window's node to be NODE, its point to be
+ the found string, and readjust the window's pagetop. Final argument
+ DIR says which direction to search in. If it is positive, search
+ forward, else backwards. */
+long
+info_search_in_node (string, node, start, window, dir)
+ char *string;
+ NODE *node;
+ long start;
+ WINDOW *window;
+ int dir;
+{
+ SEARCH_BINDING binding;
+ long offset;
+
+ binding.buffer = node->contents;
+ binding.start = start;
+ binding.end = node->nodelen;
+ binding.flags = S_FoldCase;
+
+ if (dir < 0)
+ {
+ binding.end = 0;
+ binding.flags |= S_SkipDest;
+ }
+
+ if (binding.start < 0)
+ return (-1);
+
+ /* For incremental searches, we always wish to skip past the string. */
+ if (isearch_is_active)
+ binding.flags |= S_SkipDest;
+
+ offset = search (string, &binding);
+
+ if (offset != -1 && window)
+ {
+ set_remembered_pagetop_and_point (window);
+ if (window->node != node)
+ window_set_node_of_window (window, node);
+ window->point = offset;
+ window_adjust_pagetop (window);
+ }
+ return (offset);
+}
+
+/* Search NODE, looking for the largest possible match of STRING. Start the
+ search at START. Return the absolute position of the match, or -1, if
+ no part of the string could be found. */
+long
+info_target_search_node (node, string, start)
+ NODE *node;
+ char *string;
+ long start;
+{
+ register int i;
+ long offset;
+ char *target;
+
+ target = strdup (string);
+ i = strlen (target);
+
+ /* Try repeatedly searching for this string while removing words from
+ the end of it. */
+ while (i)
+ {
+ target[i] = '\0';
+ offset = info_search_in_node (target, node, start, (WINDOW *)NULL, 1);
+
+ if (offset != -1)
+ break;
+
+ /* Delete the last word from TARGET. */
+ for (; i && (!whitespace (target[i]) && (target[i] != ',')); i--);
+ }
+ free (target);
+ return (offset);
+}
+
+/* Search for STRING starting in WINDOW at point. If the string is found
+ in this node, set point to that position. Otherwise, get the file buffer
+ associated with WINDOW's node, and search through each node in that file.
+ If the search fails, return non-zero, else zero. Side-effect window
+ leaving the node and point where the string was found current. */
+static char *last_searched_for_string = (char *)NULL;
+static int
+info_search_internal (string, window, dir)
+ char *string;
+ WINDOW *window;
+ int dir;
+{
+ register int i;
+ FILE_BUFFER *file_buffer;
+ char *initial_nodename;
+ long ret, start = 0;
+
+ file_buffer = file_buffer_of_window (window);
+ initial_nodename = window->node->nodename;
+
+ if ((info_last_executed_command == info_search) &&
+ (last_searched_for_string) &&
+ (strcmp (last_searched_for_string, string) == 0))
+ {
+ ret = info_search_in_node
+ (string, window->node, window->point + dir, window, dir);
+ }
+ else
+ {
+ ret = info_search_in_node
+ (string, window->node, window->point, window, dir);
+ }
+
+ maybe_free (last_searched_for_string);
+ last_searched_for_string = strdup (string);
+
+ if (ret != -1)
+ {
+ /* We won! */
+ if (!echo_area_is_active && !isearch_is_active)
+ window_clear_echo_area ();
+ return (0);
+ }
+
+ /* The string wasn't found in the current node. Search through the
+ window's file buffer, iff the current node is not "*". */
+ if (!file_buffer || (strcmp (initial_nodename, "*") == 0))
+ return (-1);
+
+ /* If this file has tags, search through every subfile, starting at
+ this node's subfile and node. Otherwise, search through the
+ file's node list. */
+ if (file_buffer->tags)
+ {
+ register int current_tag, number_of_tags;
+ char *last_subfile;
+ TAG *tag;
+
+ /* Find number of tags and current tag. */
+ last_subfile = (char *)NULL;
+ for (i = 0; file_buffer->tags[i]; i++)
+ if (strcmp (initial_nodename, file_buffer->tags[i]->nodename) == 0)
+ {
+ current_tag = i;
+ last_subfile = file_buffer->tags[i]->filename;
+ }
+
+ number_of_tags = i;
+
+ /* If there is no last_subfile, our tag wasn't found. */
+ if (!last_subfile)
+ return (-1);
+
+ /* Search through subsequent nodes, wrapping around to the top
+ of the info file until we find the string or return to this
+ window's node and point. */
+ while (1)
+ {
+ NODE *node;
+
+ /* Allow C-g to quit the search, failing it if pressed. */
+ return_if_control_g (-1);
+
+ current_tag += dir;
+
+ if (current_tag < 0)
+ current_tag = number_of_tags - 1;
+ else if (current_tag == number_of_tags)
+ current_tag = 0;
+
+ tag = file_buffer->tags[current_tag];
+
+ if (!echo_area_is_active && (last_subfile != tag->filename))
+ {
+ window_message_in_echo_area
+ ("Searching subfile \"%s\"...",
+ filename_non_directory (tag->filename));
+
+ last_subfile = tag->filename;
+ }
+
+ node = info_get_node (file_buffer->filename, tag->nodename);
+
+ if (!node)
+ {
+ /* If not doing i-search... */
+ if (!echo_area_is_active)
+ {
+ if (info_recent_file_error)
+ info_error (info_recent_file_error);
+ else
+ info_error (CANT_FILE_NODE,
+ filename_non_directory (file_buffer->filename),
+ tag->nodename);
+ }
+ return (-1);
+ }
+
+ if (dir < 0)
+ start = tag->nodelen;
+
+ ret =
+ info_search_in_node (string, node, start, window, dir);
+
+ /* Did we find the string in this node? */
+ if (ret != -1)
+ {
+ /* Yes! We win. */
+ remember_window_and_node (window, node);
+ if (!echo_area_is_active)
+ window_clear_echo_area ();
+ return (0);
+ }
+
+ /* No. Free this node, and make sure that we haven't passed
+ our starting point. */
+ free (node);
+
+ if (strcmp (initial_nodename, tag->nodename) == 0)
+ return (-1);
+ }
+ }
+ return (-1);
+}
+
+DECLARE_INFO_COMMAND (info_search, "Read a string and search for it")
+{
+ char *line, *prompt;
+ int result, old_pagetop;
+ int direction;
+
+ if (count < 0)
+ direction = -1;
+ else
+ direction = 1;
+
+ /* Read a string from the user, defaulting the search to SEARCH_STRING. */
+ if (!search_string)
+ {
+ search_string = (char *)xmalloc (search_string_size = 100);
+ search_string[0] = '\0';
+ }
+
+ prompt = (char *)xmalloc (50 + strlen (search_string));
+
+ sprintf (prompt, "%s for string [%s]: ",
+ direction < 0 ? "Search backward" : "Search",
+ search_string);
+
+ line = info_read_in_echo_area (window, prompt);
+ free (prompt);
+
+ if (!line)
+ {
+ info_abort_key ();
+ return;
+ }
+
+ if (*line)
+ {
+ if (strlen (line) + 1 > search_string_size)
+ search_string = (char *)
+ xrealloc (search_string, (search_string_size += 50 + strlen (line)));
+
+ strcpy (search_string, line);
+ search_string_index = strlen (line);
+ free (line);
+ }
+
+ old_pagetop = active_window->pagetop;
+ result = info_search_internal (search_string, active_window, direction);
+
+ if (result != 0 && !info_error_was_printed)
+ info_error ("Search failed.");
+ else if (old_pagetop != active_window->pagetop)
+ {
+ int new_pagetop;
+
+ new_pagetop = active_window->pagetop;
+ active_window->pagetop = old_pagetop;
+ set_window_pagetop (active_window, new_pagetop);
+ if (auto_footnotes_p)
+ info_get_or_remove_footnotes (active_window);
+ }
+
+ /* Perhaps free the unreferenced file buffers that were searched, but
+ not retained. */
+ info_gc_file_buffers ();
+}
+
+/* **************************************************************** */
+/* */
+/* Incremental Searching */
+/* */
+/* **************************************************************** */
+
+static void incremental_search ();
+
+DECLARE_INFO_COMMAND (isearch_forward,
+ "Search interactively for a string as you type it")
+{
+ incremental_search (window, count, key);
+}
+
+DECLARE_INFO_COMMAND (isearch_backward,
+ "Search interactively for a string as you type it")
+{
+ incremental_search (window, -count, key);
+}
+
+/* Incrementally search for a string as it is typed. */
+/* The last accepted incremental search string. */
+static char *last_isearch_accepted = (char *)NULL;
+
+/* The current incremental search string. */
+static char *isearch_string = (char *)NULL;
+static int isearch_string_index = 0;
+static int isearch_string_size = 0;
+static unsigned char isearch_terminate_search_key = ESC;
+
+/* Structure defining the current state of an incremental search. */
+typedef struct {
+ WINDOW_STATE_DECL; /* The node, pagetop and point. */
+ int search_index; /* Offset of the last char in the search string. */
+ int direction; /* The direction that this search is heading in. */
+ int failing; /* Whether or not this search failed. */
+} SEARCH_STATE;
+
+/* Array of search states. */
+static SEARCH_STATE **isearch_states = (SEARCH_STATE **)NULL;
+static int isearch_states_index = 0;
+static int isearch_states_slots = 0;
+
+/* Push the state of this search. */
+static void
+push_isearch (window, search_index, direction, failing)
+ WINDOW *window;
+ int search_index, direction, failing;
+{
+ SEARCH_STATE *state;
+
+ state = (SEARCH_STATE *)xmalloc (sizeof (SEARCH_STATE));
+ window_get_state (window, state);
+ state->search_index = search_index;
+ state->direction = direction;
+ state->failing = failing;
+
+ add_pointer_to_array (state, isearch_states_index, isearch_states,
+ isearch_states_slots, 20, SEARCH_STATE *);
+}
+
+/* Pop the state of this search to WINDOW, SEARCH_INDEX, and DIRECTION. */
+static void
+pop_isearch (window, search_index, direction, failing)
+ WINDOW *window;
+ int *search_index, *direction, *failing;
+{
+ SEARCH_STATE *state;
+
+ if (isearch_states_index)
+ {
+ isearch_states_index--;
+ state = isearch_states[isearch_states_index];
+ window_set_state (window, state);
+ *search_index = state->search_index;
+ *direction = state->direction;
+ *failing = state->failing;
+
+ free (state);
+ isearch_states[isearch_states_index] = (SEARCH_STATE *)NULL;
+ }
+}
+
+/* Free the memory used by isearch_states. */
+static void
+free_isearch_states ()
+{
+ register int i;
+
+ for (i = 0; i < isearch_states_index; i++)
+ {
+ free (isearch_states[i]);
+ isearch_states[i] = (SEARCH_STATE *)NULL;
+ }
+ isearch_states_index = 0;
+}
+
+/* Display the current search in the echo area. */
+static void
+show_isearch_prompt (dir, string, failing_p)
+ int dir;
+ unsigned char *string;
+ int failing_p;
+{
+ register int i;
+ char *prefix, *prompt, *p_rep;
+ int prompt_len, p_rep_index, p_rep_size;
+
+ if (dir < 0)
+ prefix = "I-search backward: ";
+ else
+ prefix = "I-search: ";
+
+ p_rep_index = p_rep_size = 0;
+ p_rep = (char *)NULL;
+ for (i = 0; string[i]; i++)
+ {
+ char *rep;
+
+ switch (string[i])
+ {
+ case ' ': rep = " "; break;
+ case LFD: rep = "\\n"; break;
+ case TAB: rep = "\\t"; break;
+ default:
+ rep = pretty_keyname (string[i]);
+ }
+ if ((p_rep_index + strlen (rep) + 1) >= p_rep_size)
+ p_rep = (char *)xrealloc (p_rep, p_rep_size += 100);
+
+ strcpy (p_rep + p_rep_index, rep);
+ p_rep_index += strlen (rep);
+ }
+
+ prompt_len = strlen (prefix) + p_rep_index + 20;
+ prompt = (char *)xmalloc (prompt_len);
+ sprintf (prompt, "%s%s%s", failing_p ? "Failing " : "", prefix,
+ p_rep ? p_rep : "");
+
+ window_message_in_echo_area ("%s", prompt);
+ maybe_free (p_rep);
+ free (prompt);
+ display_cursor_at_point (active_window);
+}
+
+static void
+incremental_search (window, count, ignore)
+ WINDOW *window;
+ int count;
+ unsigned char ignore;
+{
+ unsigned char key;
+ int last_search_result, search_result, dir;
+ SEARCH_STATE mystate, orig_state;
+
+ if (count < 0)
+ dir = -1;
+ else
+ dir = 1;
+
+ last_search_result = search_result = 0;
+
+ window_get_state (window, &orig_state);
+
+ isearch_string_index = 0;
+ if (!isearch_string_size)
+ isearch_string = (char *)xmalloc (isearch_string_size = 50);
+
+ /* Show the search string in the echo area. */
+ isearch_string[isearch_string_index] = '\0';
+ show_isearch_prompt (dir, isearch_string, search_result);
+
+ isearch_is_active = 1;
+
+ while (isearch_is_active)
+ {
+ VFunction *func = (VFunction *)NULL;
+ int quoted = 0;
+
+ /* If a recent display was interrupted, then do the redisplay now if
+ it is convenient. */
+ if (!info_any_buffered_input_p () && display_was_interrupted_p)
+ {
+ display_update_one_window (window);
+ display_cursor_at_point (active_window);
+ }
+
+ /* Read a character and dispatch on it. */
+ key = info_get_input_char ();
+ window_get_state (window, &mystate);
+
+ if (key == DEL)
+ {
+ /* User wants to delete one level of search? */
+ if (!isearch_states_index)
+ {
+ terminal_ring_bell ();
+ continue;
+ }
+ else
+ {
+ pop_isearch
+ (window, &isearch_string_index, &dir, &search_result);
+ isearch_string[isearch_string_index] = '\0';
+ show_isearch_prompt (dir, isearch_string, search_result);
+ goto after_search;
+ }
+ }
+ else if (key == Control ('q'))
+ {
+ key = info_get_input_char ();
+ quoted = 1;
+ }
+
+ /* We are about to search again, or quit. Save the current search. */
+ push_isearch (window, isearch_string_index, dir, search_result);
+
+ if (quoted)
+ goto insert_and_search;
+
+ if (!Meta_p (key) || (ISO_Latin_p && key < 160))
+ {
+ func = window->keymap[key].function;
+
+ /* If this key invokes an incremental search, then this means that
+ we will either search again in the same direction, search
+ again in the reverse direction, or insert the last search
+ string that was accepted through incremental searching. */
+ if (func == isearch_forward || func == isearch_backward)
+ {
+ if ((func == isearch_forward && dir > 0) ||
+ (func == isearch_backward && dir < 0))
+ {
+ /* If the user has typed no characters, then insert the
+ last successful search into the current search string. */
+ if (isearch_string_index == 0)
+ {
+ /* Of course, there must be something to insert. */
+ if (last_isearch_accepted)
+ {
+ if (strlen (last_isearch_accepted) + 1 >=
+ isearch_string_size)
+ isearch_string = (char *)
+ xrealloc (isearch_string,
+ isearch_string_size += 10 +
+ strlen (last_isearch_accepted));
+ strcpy (isearch_string, last_isearch_accepted);
+ isearch_string_index = strlen (isearch_string);
+ goto search_now;
+ }
+ else
+ continue;
+ }
+ else
+ {
+ /* Search again in the same direction. This means start
+ from a new place if the last search was successful. */
+ if (search_result == 0)
+ window->point += dir;
+ }
+ }
+ else
+ {
+ /* Reverse the direction of the search. */
+ dir = -dir;
+ }
+ }
+ else if (isprint (key) || func == (VFunction *)NULL)
+ {
+ insert_and_search:
+
+ if (isearch_string_index + 2 >= isearch_string_size)
+ isearch_string = (char *)xrealloc
+ (isearch_string, isearch_string_size += 100);
+
+ isearch_string[isearch_string_index++] = key;
+ isearch_string[isearch_string_index] = '\0';
+ goto search_now;
+ }
+ else if (func == info_abort_key)
+ {
+ /* If C-g pressed, and the search is failing, pop the search
+ stack back to the last unfailed search. */
+ if (isearch_states_index && (search_result != 0))
+ {
+ terminal_ring_bell ();
+ while (isearch_states_index && (search_result != 0))
+ pop_isearch
+ (window, &isearch_string_index, &dir, &search_result);
+ isearch_string[isearch_string_index] = '\0';
+ show_isearch_prompt (dir, isearch_string, search_result);
+ continue;
+ }
+ else
+ goto exit_search;
+ }
+ else
+ goto exit_search;
+ }
+ else
+ {
+ exit_search:
+ /* The character is not printable, or it has a function which is
+ non-null. Exit the search, remembering the search string. If
+ the key is not the same as the isearch_terminate_search_key,
+ then push it into pending input. */
+ if (isearch_string_index && func != info_abort_key)
+ {
+ maybe_free (last_isearch_accepted);
+ last_isearch_accepted = strdup (isearch_string);
+ }
+
+ if (key != isearch_terminate_search_key)
+ info_set_pending_input (key);
+
+ if (func == info_abort_key)
+ {
+ if (isearch_states_index)
+ window_set_state (window, &orig_state);
+ }
+
+ if (!echo_area_is_active)
+ window_clear_echo_area ();
+
+ if (auto_footnotes_p)
+ info_get_or_remove_footnotes (active_window);
+
+ isearch_is_active = 0;
+ continue;
+ }
+
+ /* Search for the contents of isearch_string. */
+ search_now:
+ show_isearch_prompt (dir, isearch_string, search_result);
+
+ if (search_result == 0)
+ {
+ /* Check to see if the current search string is right here. If
+ we are looking at it, then don't bother calling the search
+ function. */
+ if (((dir < 0) &&
+ (strncasecmp (window->node->contents + window->point,
+ isearch_string, isearch_string_index) == 0)) ||
+ ((dir > 0) &&
+ ((window->point - isearch_string_index) >= 0) &&
+ (strncasecmp (window->node->contents +
+ (window->point - (isearch_string_index - 1)),
+ isearch_string, isearch_string_index) == 0)))
+ {
+ if (dir > 0)
+ window->point++;
+ }
+ else
+ search_result = info_search_internal (isearch_string, window, dir);
+ }
+
+ /* If this search failed, and we didn't already have a failed search,
+ then ring the terminal bell. */
+ if (search_result != 0 && last_search_result == 0)
+ terminal_ring_bell ();
+
+ after_search:
+ show_isearch_prompt (dir, isearch_string, search_result);
+
+ if (search_result == 0)
+ {
+ if ((mystate.node == window->node) &&
+ (mystate.pagetop != window->pagetop))
+ {
+ int newtop = window->pagetop;
+ window->pagetop = mystate.pagetop;
+ set_window_pagetop (window, newtop);
+ }
+ display_update_one_window (window);
+ display_cursor_at_point (window);
+ }
+
+ last_search_result = search_result;
+ }
+
+ /* Free the memory used to remember each search state. */
+ free_isearch_states ();
+
+ /* Perhaps GC some file buffers. */
+ info_gc_file_buffers ();
+
+ /* After searching, leave the window in the correct state. */
+ if (!echo_area_is_active)
+ window_clear_echo_area ();
+}
+
+/* GC some file buffers. A file buffer can be gc-ed if there we have
+ no nodes in INFO_WINDOWS that reference this file buffer's contents.
+ Garbage collecting a file buffer means to free the file buffers
+ contents. */
+static void
+info_gc_file_buffers ()
+{
+ register int fb_index, iw_index, i;
+ register FILE_BUFFER *fb;
+ register INFO_WINDOW *iw;
+
+ if (!info_loaded_files)
+ return;
+
+ for (fb_index = 0; fb = info_loaded_files[fb_index]; fb_index++)
+ {
+ int fb_referenced_p = 0;
+
+ /* If already gc-ed, do nothing. */
+ if (!fb->contents)
+ continue;
+
+ /* If this file had to be uncompressed, check to see if we should
+ gc it. This means that the user-variable "gc-compressed-files"
+ is non-zero. */
+ if ((fb->flags & N_IsCompressed) && !gc_compressed_files)
+ continue;
+
+ /* If this file's contents are not gc-able, move on. */
+ if (fb->flags & N_CannotGC)
+ continue;
+
+ /* Check each INFO_WINDOW to see if it has any nodes which reference
+ this file. */
+ for (iw_index = 0; iw = info_windows[iw_index]; iw_index++)
+ {
+ for (i = 0; iw->nodes && iw->nodes[i]; i++)
+ {
+ if ((strcmp (fb->fullpath, iw->nodes[i]->filename) == 0) ||
+ (strcmp (fb->filename, iw->nodes[i]->filename) == 0))
+ {
+ fb_referenced_p = 1;
+ break;
+ }
+ }
+ }
+
+ /* If this file buffer wasn't referenced, free its contents. */
+ if (!fb_referenced_p)
+ {
+ free (fb->contents);
+ fb->contents = (char *)NULL;
+ }
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Traversing and Selecting References */
+/* */
+/* **************************************************************** */
+
+/* Move to the next or previous cross reference in this node. */
+static void
+info_move_to_xref (window, count, key, dir)
+ WINDOW *window;
+ int count;
+ unsigned char key;
+ int dir;
+{
+ long firstmenu, firstxref;
+ long nextmenu, nextxref;
+ long placement = -1;
+ long start = 0;
+ NODE *node = window->node;
+
+ if (dir < 0)
+ start = node->nodelen;
+
+ /* This search is only allowed to fail if there is no menu or cross
+ reference in the current node. Otherwise, the first menu or xref
+ found is moved to. */
+
+ firstmenu = info_search_in_node
+ (INFO_MENU_ENTRY_LABEL, node, start, (WINDOW *)NULL, dir);
+
+ /* FIRSTMENU may point directly to the line defining the menu. Skip that
+ and go directly to the first item. */
+
+ if (firstmenu != -1)
+ {
+ char *text = node->contents + firstmenu;
+
+ if (strncmp (text, INFO_MENU_LABEL, strlen (INFO_MENU_LABEL)) == 0)
+ firstmenu = info_search_in_node
+ (INFO_MENU_ENTRY_LABEL, node, firstmenu + dir, (WINDOW *)NULL, dir);
+ }
+
+ firstxref =
+ info_search_in_node (INFO_XREF_LABEL, node, start, (WINDOW *)NULL, dir);
+
+#if defined (HANDLE_MAN_PAGES)
+ if ((firstxref == -1) && (node->flags & N_IsManPage))
+ {
+ firstxref = locate_manpage_xref (node, start, dir);
+ }
+#endif /* HANDLE_MAN_PAGES */
+
+ if (firstmenu == -1 && firstxref == -1)
+ {
+ info_error ("No cross references in this node.");
+ return;
+ }
+
+ /* There is at least one cross reference or menu entry in this node.
+ Try hard to find the next available one. */
+
+ nextmenu = info_search_in_node
+ (INFO_MENU_ENTRY_LABEL, node, window->point + dir, (WINDOW *)NULL, dir);
+
+ nextxref = info_search_in_node
+ (INFO_XREF_LABEL, node, window->point + dir, (WINDOW *)NULL, dir);
+
+#if defined (HANDLE_MAN_PAGES)
+ if ((nextxref == -1) && (node->flags & N_IsManPage) && (firstxref != -1))
+ nextxref = locate_manpage_xref (node, window->point + dir, dir);
+#endif /* HANDLE_MAN_PAGES */
+
+ /* Ignore "Menu:" as a menu item. */
+ if (nextmenu != -1)
+ {
+ char *text = node->contents + nextmenu;
+
+ if (strncmp (text, INFO_MENU_LABEL, strlen (INFO_MENU_LABEL)) == 0)
+ nextmenu = info_search_in_node
+ (INFO_MENU_ENTRY_LABEL, node, nextmenu + dir, (WINDOW *)NULL, dir);
+ }
+
+ /* If there is both a next menu entry, and a next xref entry, choose the
+ one which occurs first. Otherwise, select the one which actually
+ appears in this node following point. */
+ if (nextmenu != -1 && nextxref != -1)
+ {
+ if (((dir == 1) && (nextmenu < nextxref)) ||
+ ((dir == -1) && (nextmenu > nextxref)))
+ placement = nextmenu + 1;
+ else
+ placement = nextxref;
+ }
+ else if (nextmenu != -1)
+ placement = nextmenu + 1;
+ else if (nextxref != -1)
+ placement = nextxref;
+
+ /* If there was neither a menu or xref entry appearing in this node after
+ point, choose the first menu or xref entry appearing in this node. */
+ if (placement == -1)
+ {
+ if (firstmenu != -1 && firstxref != -1)
+ {
+ if (((dir == 1) && (firstmenu < firstxref)) ||
+ ((dir == -1) && (firstmenu > firstxref)))
+ placement = firstmenu + 1;
+ else
+ placement = firstxref;
+ }
+ else if (firstmenu != -1)
+ placement = firstmenu + 1;
+ else
+ placement = firstxref;
+ }
+ window->point = placement;
+ window_adjust_pagetop (window);
+ window->flags |= W_UpdateWindow;
+}
+
+DECLARE_INFO_COMMAND (info_move_to_prev_xref,
+ "Move to the previous cross reference")
+{
+ if (count < 0)
+ info_move_to_prev_xref (window, -count, key);
+ else
+ info_move_to_xref (window, count, key, -1);
+}
+
+DECLARE_INFO_COMMAND (info_move_to_next_xref,
+ "Move to the next cross reference")
+{
+ if (count < 0)
+ info_move_to_next_xref (window, -count, key);
+ else
+ info_move_to_xref (window, count, key, 1);
+}
+
+/* Select the menu item or reference that appears on this line. */
+DECLARE_INFO_COMMAND (info_select_reference_this_line,
+ "Select reference or menu item appearing on this line")
+{
+ char *line;
+ NODE *orig;
+
+ line = window->line_starts[window_line_of_point (window)];
+ orig = window->node;
+
+ /* If this line contains a menu item, select that one. */
+ if (strncmp ("* ", line, 2) == 0)
+ info_menu_or_ref_item (window, count, key, info_menu_of_node, 0);
+ else
+ info_menu_or_ref_item (window, count, key, info_xrefs_of_node, 0);
+}
+
+/* **************************************************************** */
+/* */
+/* Miscellaneous Info Commands */
+/* */
+/* **************************************************************** */
+
+/* What to do when C-g is pressed in a window. */
+DECLARE_INFO_COMMAND (info_abort_key, "Cancel current operation")
+{
+ /* If error printing doesn't oridinarily ring the bell, do it now,
+ since C-g always rings the bell. Otherwise, let the error printer
+ do it. */
+ if (!info_error_rings_bell_p)
+ terminal_ring_bell ();
+ info_error ("Quit");
+
+ info_initialize_numeric_arg ();
+ info_clear_pending_input ();
+ info_last_executed_command = (VFunction *)NULL;
+}
+
+/* Move the cursor to the desired line of the window. */
+DECLARE_INFO_COMMAND (info_move_to_window_line,
+ "Move to the cursor to a specific line of the window")
+{
+ int line;
+
+ /* With no numeric argument of any kind, default to the center line. */
+ if (!info_explicit_arg && count == 1)
+ line = (window->height / 2) + window->pagetop;
+ else
+ {
+ if (count < 0)
+ line = (window->height + count) + window->pagetop;
+ else
+ line = window->pagetop + count;
+ }
+
+ /* If the line doesn't appear in this window, make it do so. */
+ if ((line - window->pagetop) >= window->height)
+ line = window->pagetop + (window->height - 1);
+
+ /* If the line is too small, make it fit. */
+ if (line < window->pagetop)
+ line = window->pagetop;
+
+ /* If the selected line is past the bottom of the node, force it back. */
+ if (line >= window->line_count)
+ line = window->line_count - 1;
+
+ window->point = (window->line_starts[line] - window->node->contents);
+}
+
+/* Clear the screen and redraw its contents. Given a numeric argument,
+ move the line the cursor is on to the COUNT'th line of the window. */
+DECLARE_INFO_COMMAND (info_redraw_display, "Redraw the display")
+{
+ if ((!info_explicit_arg && count == 1) || echo_area_is_active)
+ {
+ terminal_clear_screen ();
+ display_clear_display (the_display);
+ window_mark_chain (windows, W_UpdateWindow);
+ display_update_display (windows);
+ }
+ else
+ {
+ int desired_line, point_line;
+ int new_pagetop;
+
+ point_line = window_line_of_point (window) - window->pagetop;
+
+ if (count < 0)
+ desired_line = window->height + count;
+ else
+ desired_line = count;
+
+ if (desired_line < 0)
+ desired_line = 0;
+
+ if (desired_line >= window->height)
+ desired_line = window->height - 1;
+
+ if (desired_line == point_line)
+ return;
+
+ new_pagetop = window->pagetop + (point_line - desired_line);
+
+ set_window_pagetop (window, new_pagetop);
+ }
+}
+/* This command does nothing. It is the fact that a key is bound to it
+ that has meaning. See the code at the top of info_session (). */
+DECLARE_INFO_COMMAND (info_quit, "Quit using Info")
+{}
+
+
+/* **************************************************************** */
+/* */
+/* Reading Keys and Dispatching on Them */
+/* */
+/* **************************************************************** */
+
+/* Declaration only. Special cased in info_dispatch_on_key (). */
+DECLARE_INFO_COMMAND (info_do_lowercase_version, "")
+{}
+
+static void
+dispatch_error (keyseq)
+ char *keyseq;
+{
+ char *rep;
+
+ rep = pretty_keyseq (keyseq);
+
+ if (!echo_area_is_active)
+ info_error ("Unknown command (%s).", rep);
+ else
+ {
+ char *temp;
+
+ temp = (char *)xmalloc (1 + strlen (rep) + strlen ("\"\" is invalid"));
+
+ sprintf (temp, "\"%s\" is invalid", rep);
+ terminal_ring_bell ();
+ inform_in_echo_area (temp);
+ free (temp);
+ }
+}
+
+/* Keeping track of key sequences. */
+static char *info_keyseq = (char *)NULL;
+static char keyseq_rep[100];
+static int info_keyseq_index = 0;
+static int info_keyseq_size = 0;
+static int info_keyseq_displayed_p = 0;
+
+/* Initialize the length of the current key sequence. */
+void
+initialize_keyseq ()
+{
+ info_keyseq_index = 0;
+ info_keyseq_displayed_p = 0;
+}
+
+/* Add CHARACTER to the current key sequence. */
+void
+add_char_to_keyseq (character)
+ char character;
+{
+ if (info_keyseq_index + 2 >= info_keyseq_size)
+ info_keyseq = (char *)xrealloc (info_keyseq, info_keyseq_size += 10);
+
+ info_keyseq[info_keyseq_index++] = character;
+ info_keyseq[info_keyseq_index] = '\0';
+}
+
+/* Return the pretty printable string which represents KEYSEQ. */
+char *
+pretty_keyseq (keyseq)
+ char *keyseq;
+{
+ register int i;
+
+ keyseq_rep[0] = '\0';
+
+ for (i = 0; keyseq[i]; i++)
+ {
+ sprintf (keyseq_rep + strlen (keyseq_rep), "%s%s",
+ strlen (keyseq_rep) ? " " : "",
+ pretty_keyname (keyseq[i]));
+ }
+
+ return (keyseq_rep);
+}
+
+/* Display the current value of info_keyseq. If argument EXPECTING is
+ non-zero, input is expected to be read after the key sequence is
+ displayed, so add an additional prompting character to the sequence. */
+void
+display_info_keyseq (expecting_future_input)
+ int expecting_future_input;
+{
+ char *rep;
+
+ rep = pretty_keyseq (info_keyseq);
+ if (expecting_future_input)
+ strcat (rep, "-");
+
+ if (echo_area_is_active)
+ inform_in_echo_area (rep);
+ else
+ {
+ window_message_in_echo_area (rep);
+ display_cursor_at_point (active_window);
+ }
+ info_keyseq_displayed_p = 1;
+}
+
+/* Called by interactive commands to read a keystroke. */
+unsigned char
+info_get_another_input_char ()
+{
+ int ready = 0;
+
+ /* If there isn't any input currently available, then wait a
+ moment looking for input. If we don't get it fast enough,
+ prompt a little bit with the current key sequence. */
+ if (!info_keyseq_displayed_p &&
+ !info_any_buffered_input_p () &&
+ !info_input_pending_p ())
+ {
+#if defined (FD_SET)
+ struct timeval timer;
+ fd_set readfds;
+
+ FD_ZERO (&readfds);
+ FD_SET (fileno (info_input_stream), &readfds);
+ timer.tv_sec = 1;
+ timer.tv_usec = 750;
+ ready = select (1, &readfds, (fd_set *)NULL, (fd_set *)NULL, &timer);
+#endif /* FD_SET */
+ }
+
+ if (!ready)
+ display_info_keyseq (1);
+
+ return (info_get_input_char ());
+}
+
+/* Do the command associated with KEY in MAP. If the associated command is
+ really a keymap, then read another key, and dispatch into that map. */
+void
+info_dispatch_on_key (key, map)
+ unsigned char key;
+ Keymap map;
+{
+ if (Meta_p (key) && (!ISO_Latin_p || map[key].function != ea_insert))
+ {
+ if (map[ESC].type == ISKMAP)
+ {
+ map = (Keymap)map[ESC].function;
+ add_char_to_keyseq (ESC);
+ key = UnMeta (key);
+ info_dispatch_on_key (key, map);
+ }
+ else
+ {
+ dispatch_error (info_keyseq);
+ }
+ return;
+ }
+
+ switch (map[key].type)
+ {
+ case ISFUNC:
+ {
+ VFunction *func;
+
+ func = map[key].function;
+ if (func != (VFunction *)NULL)
+ {
+ /* Special case info_do_lowercase_version (). */
+ if (func == info_do_lowercase_version)
+ {
+ info_dispatch_on_key (tolower (key), map);
+ return;
+ }
+
+ add_char_to_keyseq (key);
+
+ if (info_keyseq_displayed_p)
+ display_info_keyseq (0);
+
+ {
+ WINDOW *where;
+
+ where = active_window;
+ (*map[key].function)
+ (active_window, info_numeric_arg * info_numeric_arg_sign, key);
+
+ /* If we have input pending, then the last command was a prefix
+ command. Don't change the value of the last function vars.
+ Otherwise, remember the last command executed in the var
+ appropriate to the window in which it was executed. */
+ if (!info_input_pending_p ())
+ {
+ if (where == the_echo_area)
+ ea_last_executed_command = map[key].function;
+ else
+ info_last_executed_command = map[key].function;
+ }
+ }
+ }
+ else
+ {
+ add_char_to_keyseq (key);
+ dispatch_error (info_keyseq);
+ return;
+ }
+ }
+ break;
+
+ case ISKMAP:
+ add_char_to_keyseq (key);
+ if (map[key].function != (VFunction *)NULL)
+ {
+ unsigned char newkey;
+
+ newkey = info_get_another_input_char ();
+ info_dispatch_on_key (newkey, (Keymap)map[key].function);
+ }
+ else
+ {
+ dispatch_error (info_keyseq);
+ return;
+ }
+ break;
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Numeric Arguments */
+/* */
+/* **************************************************************** */
+
+/* Handle C-u style numeric args, as well as M--, and M-digits. */
+
+/* Non-zero means that an explicit argument has been passed to this
+ command, as in C-u C-v. */
+int info_explicit_arg = 0;
+
+/* The sign of the numeric argument. */
+int info_numeric_arg_sign = 1;
+
+/* The value of the argument itself. */
+int info_numeric_arg = 1;
+
+/* Add the current digit to the argument in progress. */
+DECLARE_INFO_COMMAND (info_add_digit_to_numeric_arg,
+ "Add this digit to the current numeric argument")
+{
+ info_numeric_arg_digit_loop (window, 0, key);
+}
+
+/* C-u, universal argument. Multiply the current argument by 4.
+ Read a key. If the key has nothing to do with arguments, then
+ dispatch on it. If the key is the abort character then abort. */
+DECLARE_INFO_COMMAND (info_universal_argument,
+ "Start (or multiply by 4) the current numeric argument")
+{
+ info_numeric_arg *= 4;
+ info_numeric_arg_digit_loop (window, 0, 0);
+}
+
+/* Create a default argument. */
+void
+info_initialize_numeric_arg ()
+{
+ info_numeric_arg = info_numeric_arg_sign = 1;
+ info_explicit_arg = 0;
+}
+
+DECLARE_INFO_COMMAND (info_numeric_arg_digit_loop,
+ "Internally used by \\[universal-argument]")
+{
+ unsigned char pure_key;
+ Keymap keymap = window->keymap;
+
+ while (1)
+ {
+ if (key)
+ pure_key = key;
+ else
+ {
+ if (display_was_interrupted_p && !info_any_buffered_input_p ())
+ display_update_display (windows);
+
+ if (active_window != the_echo_area)
+ display_cursor_at_point (active_window);
+
+ pure_key = key = info_get_another_input_char ();
+
+ if (Meta_p (key))
+ add_char_to_keyseq (ESC);
+
+ add_char_to_keyseq (UnMeta (key));
+ }
+
+ if (Meta_p (key))
+ key = UnMeta (key);
+
+ if (keymap[key].type == ISFUNC &&
+ keymap[key].function == info_universal_argument)
+ {
+ info_numeric_arg *= 4;
+ key = 0;
+ continue;
+ }
+
+ if (isdigit (key))
+ {
+ if (info_explicit_arg)
+ info_numeric_arg = (info_numeric_arg * 10) + (key - '0');
+ else
+ info_numeric_arg = (key - '0');
+ info_explicit_arg = 1;
+ }
+ else
+ {
+ if (key == '-' && !info_explicit_arg)
+ {
+ info_numeric_arg_sign = -1;
+ info_numeric_arg = 1;
+ }
+ else
+ {
+ info_keyseq_index--;
+ info_dispatch_on_key (pure_key, keymap);
+ return;
+ }
+ }
+ key = 0;
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Input Character Buffering */
+/* */
+/* **************************************************************** */
+
+/* Character waiting to be read next. */
+static int pending_input_character = 0;
+
+/* How to make there be no pending input. */
+static void
+info_clear_pending_input ()
+{
+ pending_input_character = 0;
+}
+
+/* How to set the pending input character. */
+static void
+info_set_pending_input (key)
+ unsigned char key;
+{
+ pending_input_character = key;
+}
+
+/* How to see if there is any pending input. */
+unsigned char
+info_input_pending_p ()
+{
+ return (pending_input_character);
+}
+
+/* Largest number of characters that we can read in advance. */
+#define MAX_INFO_INPUT_BUFFERING 512
+
+static int pop_index = 0, push_index = 0;
+static unsigned char info_input_buffer[MAX_INFO_INPUT_BUFFERING];
+
+/* Add KEY to the buffer of characters to be read. */
+static void
+info_push_typeahead (key)
+ unsigned char key;
+{
+ /* Flush all pending input in the case of C-g pressed. */
+ if (key == Control ('g'))
+ {
+ push_index = pop_index;
+ info_set_pending_input (Control ('g'));
+ }
+ else
+ {
+ info_input_buffer[push_index++] = key;
+ if (push_index >= sizeof (info_input_buffer))
+ push_index = 0;
+ }
+}
+
+/* Return the amount of space available in INFO_INPUT_BUFFER for new chars. */
+static int
+info_input_buffer_space_available ()
+{
+ if (pop_index > push_index)
+ return (pop_index - push_index);
+ else
+ return (sizeof (info_input_buffer) - (push_index - pop_index));
+}
+
+/* Get a key from the buffer of characters to be read.
+ Return the key in KEY.
+ Result is non-zero if there was a key, or 0 if there wasn't. */
+static int
+info_get_key_from_typeahead (key)
+ unsigned char *key;
+{
+ if (push_index == pop_index)
+ return (0);
+
+ *key = info_input_buffer[pop_index++];
+
+ if (pop_index >= sizeof (info_input_buffer))
+ pop_index = 0;
+
+ return (1);
+}
+
+int
+info_any_buffered_input_p ()
+{
+ info_gather_typeahead ();
+ return (push_index != pop_index);
+}
+
+/* Push KEY into the *front* of the input buffer. Returns non-zero if
+ successful, zero if there is no space left in the buffer. */
+static int
+info_replace_key_to_typeahead (key)
+ unsigned char key;
+{
+ if (info_input_buffer_space_available ())
+ {
+ pop_index--;
+ if (pop_index < 0)
+ pop_index = sizeof (info_input_buffer) - 1;
+ info_input_buffer[pop_index] = key;
+ return (1);
+ }
+ return (0);
+}
+
+/* If characters are available to be read, then read them and stuff them into
+ info_input_buffer. Otherwise, do nothing. */
+void
+info_gather_typeahead ()
+{
+ register int i = 0;
+ int tty, space_avail;
+ long chars_avail;
+ unsigned char input[MAX_INFO_INPUT_BUFFERING];
+
+ tty = fileno (info_input_stream);
+ chars_avail = 0;
+
+ space_avail = info_input_buffer_space_available ();
+
+ /* If we can just find out how many characters there are to read, do so. */
+#if defined (FIONREAD)
+ {
+ ioctl (tty, FIONREAD, &chars_avail);
+
+ if (chars_avail > space_avail)
+ chars_avail = space_avail;
+
+ if (chars_avail)
+ read (tty, &input[0], chars_avail);
+ }
+#else /* !FIONREAD */
+# if defined (O_NDELAY)
+ {
+ int flags;
+
+ flags = fcntl (tty, F_GETFL, 0);
+
+ fcntl (tty, F_SETFL, (flags | O_NDELAY));
+ chars_avail = read (tty, &input[0], space_avail);
+ fcntl (tty, F_SETFL, flags);
+
+ if (chars_avail == -1)
+ chars_avail = 0;
+ }
+# endif /* O_NDELAY */
+#endif /* !FIONREAD */
+
+ while (i < chars_avail)
+ {
+ info_push_typeahead (input[i]);
+ i++;
+ }
+}
+
+/* How to read a single character. */
+unsigned char
+info_get_input_char ()
+{
+ unsigned char keystroke;
+
+ info_gather_typeahead ();
+
+ if (pending_input_character)
+ {
+ keystroke = pending_input_character;
+ pending_input_character = 0;
+ }
+ else if (info_get_key_from_typeahead (&keystroke) == 0)
+ {
+ int rawkey;
+
+ rawkey = getc (info_input_stream);
+ keystroke = rawkey;
+
+ if (rawkey == EOF)
+ {
+ if (info_input_stream != stdin)
+ {
+ fclose (info_input_stream);
+ info_input_stream = stdin;
+ display_inhibited = 0;
+ display_update_display (windows);
+ display_cursor_at_point (active_window);
+ rawkey = getc (info_input_stream);
+ keystroke = rawkey;
+ }
+
+ if (rawkey == EOF)
+ {
+ terminal_unprep_terminal ();
+ close_dribble_file ();
+ exit (0);
+ }
+ }
+ }
+
+ if (info_dribble_file)
+ dribble (keystroke);
+
+ return (keystroke);
+}
diff --git a/texinfo/info/session.h b/texinfo/info/session.h
new file mode 100644
index 00000000000..98b8ccf695f
--- /dev/null
+++ b/texinfo/info/session.h
@@ -0,0 +1,146 @@
+/* session.h -- Functions found in session.c. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_SESSION_H_)
+#define _SESSION_H_
+
+#include "general.h"
+#include "dribble.h"
+
+/* All commands that can be invoked from within info_session () receive
+ arguments in the same way. This simple define declares the header
+ of a function named NAME, with associated documentation DOC. The
+ documentation string is groveled out of the source files by the
+ utility program `makedoc', which is also responsible for making
+ the documentation/function-pointer maps. */
+#define DECLARE_INFO_COMMAND(name, doc) \
+void name (window, count, key) WINDOW *window; int count; unsigned char key;
+
+/* Variables found in session.h. */
+extern VFunction *info_last_executed_command;
+
+/* Variable controlling the garbage collection of files briefly visited
+ during searches. Such files are normally gc'ed, unless they were
+ compressed to begin with. If this variable is non-zero, it says
+ to gc even those file buffer contents which had to be uncompressed. */
+extern int gc_compressed_files;
+
+/* When non-zero, tiling takes place automatically when info_split_window
+ is called. */
+extern int auto_tiling_p;
+
+/* Variable controlling the behaviour of default scrolling when you are
+ already at the bottom of a node. */
+extern int info_scroll_behaviour;
+extern char *info_scroll_choices[];
+
+/* Values for info_scroll_behaviour. */
+#define IS_Continuous 0 /* Try to get first menu item, or failing that, the
+ "Next:" pointer, or failing that, the "Up:" and
+ "Next:" of the up. */
+#define IS_NextOnly 1 /* Try to get "Next:" menu item. */
+#define IS_PageOnly 2 /* Simply give up at the bottom of a node. */
+
+/* Utility functions found in session.c */
+extern void info_dispatch_on_key ();
+extern unsigned char info_get_input_char (), info_get_another_input_char ();
+extern unsigned char info_input_pending_p ();
+extern void remember_window_and_node (), set_remembered_pagetop_and_point ();
+extern void set_window_pagetop (), info_set_node_of_window ();
+extern char *pretty_keyseq ();
+extern void initialize_keyseq (), add_char_to_keyseq ();
+extern void info_gather_typeahead ();
+extern FILE_BUFFER *file_buffer_of_window ();
+extern long info_search_in_node (), info_target_search_node ();
+extern void info_select_reference ();
+extern int info_any_buffered_input_p ();
+extern void print_node ();
+extern void dump_node_to_file (), dump_nodes_to_file ();
+
+/* Do the physical deletion of WINDOW, and forget this window and
+ associated nodes. */
+extern void info_delete_window_internal ();
+
+/* Tell Info that input is coming from the file FILENAME. */
+extern void info_set_input_from_file ();
+
+#define return_if_control_g(val) \
+ do { \
+ info_gather_typeahead (); \
+ if (info_input_pending_p () == Control ('g')) \
+ return (val); \
+ } while (0)
+
+/* The names of the functions that run an info session. */
+
+/* Starting an info session. */
+extern void begin_multiple_window_info_session (), begin_info_session ();
+extern void begin_info_session_with_error (), info_session ();
+extern void info_read_and_dispatch ();
+
+/* Moving the point within a node. */
+extern void info_next_line (), info_prev_line ();
+extern void info_end_of_line (), info_beginning_of_line ();
+extern void info_forward_char (), info_backward_char ();
+extern void info_forward_word (), info_backward_word ();
+extern void info_beginning_of_node (), info_end_of_node ();
+extern void info_move_to_prev_xref (), info_move_to_next_xref ();
+
+/* Scrolling text within a window. */
+extern void info_scroll_forward (), info_scroll_backward ();
+extern void info_redraw_display (), info_toggle_wrap ();
+extern void info_move_to_window_line ();
+
+/* Manipulating multiple windows. */
+extern void info_split_window (), info_delete_window ();
+extern void info_keep_one_window (), info_grow_window ();
+extern void info_scroll_other_window (), info_tile_windows ();
+extern void info_next_window (), info_prev_window ();
+
+/* Selecting nodes. */
+extern void info_next_node (), info_prev_node (), info_up_node ();
+extern void info_last_node (), info_first_node (), info_history_node ();
+extern void info_goto_node (), info_top_node (), info_dir_node ();
+extern void info_global_next_node (), info_global_prev_node ();
+extern void info_kill_node (), info_view_file ();
+
+/* Selecting cross references. */
+extern void info_menu_digit (), info_menu_item (), info_xref_item ();
+extern void info_find_menu (), info_select_reference_this_line ();
+
+/* Hacking numeric arguments. */
+extern int info_explicit_arg, info_numeric_arg, info_numeric_arg_sign;
+
+extern void info_add_digit_to_numeric_arg (), info_universal_argument ();
+extern void info_initialize_numeric_arg (), info_numeric_arg_digit_loop ();
+
+/* Searching commands. */
+extern void info_search (), isearch_forward (), isearch_backward ();
+
+/* Dumping and printing nodes. */
+extern void info_print_node ();
+
+/* Miscellaneous commands. */
+extern void info_abort_key (), info_quit (), info_do_lowercase_version ();
+
+#endif /* _SESSION_H_ */
diff --git a/texinfo/info/signals.c b/texinfo/info/signals.c
new file mode 100644
index 00000000000..a60777fe597
--- /dev/null
+++ b/texinfo/info/signals.c
@@ -0,0 +1,173 @@
+/* signals.c -- Install and maintain Info signal handlers. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+#include "signals.h"
+
+/* **************************************************************** */
+/* */
+/* Pretending That We Have POSIX Signals */
+/* */
+/* **************************************************************** */
+
+#if !defined (HAVE_SIGPROCMASK) && defined (HAVE_SIGSETMASK)
+/* Perform OPERATION on NEWSET, perhaps leaving information in OLDSET. */
+static void
+sigprocmask (operation, newset, oldset)
+ int operation, *newset, *oldset;
+{
+ switch (operation)
+ {
+ case SIG_UNBLOCK:
+ sigsetmask (sigblock (0) & ~(*newset));
+ break;
+
+ case SIG_BLOCK:
+ *oldset = sigblock (*newset);
+ break;
+
+ case SIG_SETMASK:
+ sigsetmask (*newset);
+ break;
+
+ default:
+ abort ();
+ }
+}
+#endif /* !HAVE_SIGPROCMASK && HAVE_SIGSETMASK */
+
+/* **************************************************************** */
+/* */
+/* Signal Handling for Info */
+/* */
+/* **************************************************************** */
+
+typedef void SigHandlerType;
+typedef SigHandlerType SigHandler ();
+
+static SigHandlerType info_signal_handler ();
+static SigHandler *old_TSTP, *old_TTOU, *old_TTIN;
+static SigHandler *old_WINCH, *old_INT;
+
+void
+initialize_info_signal_handler ()
+{
+#if defined (SIGTSTP)
+ old_TSTP = (SigHandler *) signal (SIGTSTP, info_signal_handler);
+ old_TTOU = (SigHandler *) signal (SIGTTOU, info_signal_handler);
+ old_TTIN = (SigHandler *) signal (SIGTTIN, info_signal_handler);
+#endif /* SIGTSTP */
+
+#if defined (SIGWINCH)
+ old_WINCH = (SigHandler *) signal (SIGWINCH, info_signal_handler);
+#endif
+
+#if defined (SIGINT)
+ old_INT = (SigHandler *) signal (SIGINT, info_signal_handler);
+#endif
+}
+
+static void
+redisplay_after_signal ()
+{
+ terminal_clear_screen ();
+ display_clear_display (the_display);
+ window_mark_chain (windows, W_UpdateWindow);
+ display_update_display (windows);
+ display_cursor_at_point (active_window);
+ fflush (stdout);
+}
+
+static SigHandlerType
+info_signal_handler (sig)
+ int sig;
+{
+ SigHandler **old_signal_handler;
+
+ switch (sig)
+ {
+#if defined (SIGTSTP)
+ case SIGTSTP:
+ case SIGTTOU:
+ case SIGTTIN:
+#endif
+#if defined (SIGINT)
+ case SIGINT:
+#endif
+ {
+#if defined (SIGTSTP)
+ if (sig == SIGTSTP)
+ old_signal_handler = &old_TSTP;
+ if (sig == SIGTTOU)
+ old_signal_handler = &old_TTOU;
+ if (sig == SIGTTIN)
+ old_signal_handler = &old_TTIN;
+#endif /* SIGTSTP */
+ if (sig == SIGINT)
+ old_signal_handler = &old_INT;
+
+ /* For stop signals, restore the terminal IO, leave the cursor
+ at the bottom of the window, and stop us. */
+ terminal_goto_xy (0, screenheight - 1);
+ terminal_clear_to_eol ();
+ fflush (stdout);
+ terminal_unprep_terminal ();
+ signal (sig, *old_signal_handler);
+ UNBLOCK_SIGNAL (sig);
+ kill (getpid (), sig);
+
+ /* The program is returning now. Restore our signal handler,
+ turn on terminal handling, redraw the screen, and place the
+ cursor where it belongs. */
+ terminal_prep_terminal ();
+ *old_signal_handler = (SigHandler *) signal (sig, info_signal_handler);
+ redisplay_after_signal ();
+ fflush (stdout);
+ }
+ break;
+
+#if defined (SIGWINCH)
+ case SIGWINCH:
+ {
+ /* Turn off terminal IO, tell our parent that the window has changed,
+ then reinitialize the terminal and rebuild our windows. */
+ old_signal_handler = &old_WINCH;
+ terminal_goto_xy (0, 0);
+ fflush (stdout);
+ terminal_unprep_terminal ();
+ signal (sig, *old_signal_handler);
+ UNBLOCK_SIGNAL (sig);
+ kill (getpid (), sig);
+
+ /* After our old signal handler returns... */
+ terminal_get_screen_size ();
+ terminal_prep_terminal ();
+ display_initialize_display (screenwidth, screenheight);
+ window_new_screen_size (screenwidth, screenheight, (VFunction *)NULL);
+ *old_signal_handler = (SigHandler *) signal (sig, info_signal_handler);
+ redisplay_after_signal ();
+ }
+ break;
+#endif /* SIGWINCH */
+ }
+}
diff --git a/texinfo/info/signals.h b/texinfo/info/signals.h
new file mode 100644
index 00000000000..ab87a3b5495
--- /dev/null
+++ b/texinfo/info/signals.h
@@ -0,0 +1,89 @@
+/* signals.h -- Header to include system dependent signal definitions. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_SIGNALS_H_)
+#define _SIGNALS_H_
+
+#include <signal.h>
+
+#if !defined (HAVE_SIGPROCMASK) && !defined (sigmask)
+# define sigmask(x) (1 << ((x)-1))
+#endif /* !HAVE_SIGPROCMASK && !sigmask */
+
+#if !defined (HAVE_SIGPROCMASK)
+# if !defined (SIG_BLOCK)
+# define SIG_UNBLOCK 1
+# define SIG_BLOCK 2
+# define SIG_SETMASK 3
+# endif /* SIG_BLOCK */
+
+/* Type of a signal set. */
+# define sigset_t int
+
+/* Make SET have no signals in it. */
+# define sigemptyset(set) (*(set) = (sigset_t)0x0)
+
+/* Make SET have the full range of signal specifications possible. */
+# define sigfillset(set) (*(set) = (sigset_t)0xffffffffff)
+
+/* Add SIG to the contents of SET. */
+# define sigaddset(set, sig) *(set) |= sigmask (sig)
+
+/* Delete SIG from the contents of SET. */
+# define sigdelset(set, sig) *(set) &= ~(sigmask (sig))
+
+/* Tell if SET contains SIG. */
+# define sigismember(set, sig) (*(set) & (sigmask (sig)))
+
+/* Suspend the process until the reception of one of the signals
+ not present in SET. */
+# define sigsuspend(set) sigpause (*(set))
+#endif /* !HAVE_SIGPROCMASK */
+
+#if defined (HAVE_SIGPROCMASK) || defined (HAVE_SIGSETMASK)
+/* These definitions are used both in POSIX and non-POSIX implementations. */
+
+#define BLOCK_SIGNAL(sig) \
+ do { \
+ sigset_t nvar, ovar; \
+ sigemptyset (&nvar); \
+ sigemptyset (&ovar); \
+ sigaddset (&nvar, sig); \
+ sigprocmask (SIG_BLOCK, &nvar, &ovar); \
+ } while (0)
+
+#define UNBLOCK_SIGNAL(sig) \
+ do { \
+ sigset_t nvar, ovar; \
+ sigemptyset (&ovar); \
+ sigemptyset (&nvar); \
+ sigaddset (&nvar, sig); \
+ sigprocmask (SIG_UNBLOCK, &nvar, &ovar); \
+ } while (0)
+
+#else /* !HAVE_SIGPROCMASK && !HAVE_SIGSETMASK */
+# define BLOCK_SIGNAL(sig)
+# define UNBLOCK_SIGNAL(sig)
+#endif /* !HAVE_SIGPROCMASK && !HAVE_SIGSETMASK */
+
+#endif /* !_SIGNALS_H_ */
diff --git a/texinfo/info/termdep.h b/texinfo/info/termdep.h
new file mode 100644
index 00000000000..4f8ce9057cc
--- /dev/null
+++ b/texinfo/info/termdep.h
@@ -0,0 +1,76 @@
+/* termdep.h -- System things that terminal.c depends on.
+ $Id: termdep.h,v 1.3 1996/10/02 22:23:52 karl Exp $
+
+ This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_TERMDEP_H_)
+# define _TERMDEP_H_
+
+#if defined (HAVE_SYS_FCNTL_H)
+# include <sys/fcntl.h>
+#else
+# include <fcntl.h>
+#endif /* !HAVE_SYS_FCNTL_H */
+
+#if defined (HAVE_SYS_FILE_H)
+# include <sys/file.h>
+#endif /* HAVE_SYS_FILE_H */
+
+#if defined (HAVE_STRINGS_H)
+# include <strings.h>
+#else
+# if defined (HAVE_STRING_H)
+# include <string.h>
+# endif
+#endif
+
+#if defined (HAVE_TERMIOS_H)
+# include <termios.h>
+#else
+# if defined (HAVE_TERMIO_H)
+# include <termio.h>
+# if defined (HAVE_SYS_PTEM_H)
+# if defined (M_UNIX) || !defined (M_XENIX)
+# include <sys/stream.h>
+# include <sys/ptem.h>
+# undef TIOCGETC
+# else /* M_XENIX */
+# define tchars tc
+# endif /* M_XENIX */
+# endif /* HAVE_SYS_PTEM_H */
+# else /* !HAVE_TERMIO_H */
+# include <sgtty.h>
+# endif /* !HAVE_TERMIO_H */
+#endif /* !HAVE_TERMIOS_H */
+
+#if defined (HAVE_SYS_TTOLD_H)
+# include <sys/ttold.h>
+#endif /* HAVE_SYS_TTOLD_H */
+
+#if !defined (HAVE_STRCHR)
+# undef strchr
+# undef strrchr
+# define strchr index
+# define strrchr rindex
+#endif /* !HAVE_STRCHR */
+
+#endif /* _TERMDEP_H_ */
diff --git a/texinfo/info/terminal.c b/texinfo/info/terminal.c
new file mode 100644
index 00000000000..9c1017696c6
--- /dev/null
+++ b/texinfo/info/terminal.c
@@ -0,0 +1,769 @@
+/* terminal.c -- How to handle the physical terminal for Info. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ This file has appeared in prior works by the Free Software Foundation;
+ thus it carries copyright dates from 1988 through 1993.
+
+ Copyright (C) 1988, 89, 90, 91, 92, 93, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include "terminal.h"
+#include "termdep.h"
+
+extern void *xmalloc (), *xrealloc ();
+
+/* The Unix termcap interface code. */
+
+extern int tgetnum (), tgetflag (), tgetent ();
+extern char *tgetstr (), *tgoto ();
+extern char *getenv ();
+extern void tputs ();
+
+/* Function "hooks". If you make one of these point to a function, that
+ function is called when appropriate instead of its namesake. Your
+ function is called with exactly the same arguments that were passed
+ to the namesake function. */
+VFunction *terminal_begin_inverse_hook = (VFunction *)NULL;
+VFunction *terminal_end_inverse_hook = (VFunction *)NULL;
+VFunction *terminal_prep_terminal_hook = (VFunction *)NULL;
+VFunction *terminal_unprep_terminal_hook = (VFunction *)NULL;
+VFunction *terminal_up_line_hook = (VFunction *)NULL;
+VFunction *terminal_down_line_hook = (VFunction *)NULL;
+VFunction *terminal_clear_screen_hook = (VFunction *)NULL;
+VFunction *terminal_clear_to_eol_hook = (VFunction *)NULL;
+VFunction *terminal_get_screen_size_hook = (VFunction *)NULL;
+VFunction *terminal_goto_xy_hook = (VFunction *)NULL;
+VFunction *terminal_initialize_terminal_hook = (VFunction *)NULL;
+VFunction *terminal_new_terminal_hook = (VFunction *)NULL;
+VFunction *terminal_put_text_hook = (VFunction *)NULL;
+VFunction *terminal_ring_bell_hook = (VFunction *)NULL;
+VFunction *terminal_write_chars_hook = (VFunction *)NULL;
+VFunction *terminal_scroll_terminal_hook = (VFunction *)NULL;
+
+/* **************************************************************** */
+/* */
+/* Terminal and Termcap */
+/* */
+/* **************************************************************** */
+
+/* On Solaris2, sys/types.h #includes sys/reg.h, which #defines PC.
+ Unfortunately, PC is a global variable used by the termcap library. */
+#undef PC
+
+/* TERMCAP requires these variables, whether we access them or not. */
+char PC;
+char *BC, *UP;
+short ospeed;
+
+/* A buffer which holds onto the current terminal description, and a pointer
+ used to float within it. */
+static char *term_buffer = (char *)NULL;
+static char *term_string_buffer = (char *)NULL;
+
+/* Some strings to control terminal actions. These are output by tputs (). */
+static char *term_goto, *term_clreol, *term_cr, *term_clrpag;
+static char *term_begin_use, *term_end_use;
+static char *term_AL, *term_DL, *term_al, *term_dl;
+
+/* How to go up a line. */
+static char *term_up;
+
+/* How to go down a line. */
+static char *term_dn;
+
+/* An audible bell, if the terminal can be made to make noise. */
+static char *audible_bell;
+
+/* A visible bell, if the terminal can be made to flash the screen. */
+static char *visible_bell;
+
+/* The string to write to turn on the meta key, if this term has one. */
+static char *term_mm;
+
+/* The string to write to turn off the meta key, if this term has one. */
+static char *term_mo;
+
+/* The string to turn on inverse mode, if this term has one. */
+static char *term_invbeg;
+
+/* The string to turn off inverse mode, if this term has one. */
+static char *term_invend;
+
+static void
+output_character_function (c)
+ int c;
+{
+ putc (c, stdout);
+}
+
+/* Macro to send STRING to the terminal. */
+#define send_to_terminal(string) \
+ do { \
+ if (string) \
+ tputs (string, 1, output_character_function); \
+ } while (0)
+
+/* Tell the terminal that we will be doing cursor addressable motion. */
+static void
+terminal_begin_using_terminal ()
+{
+ send_to_terminal (term_begin_use);
+}
+
+/* Tell the terminal that we will not be doing any more cursor addressable
+ motion. */
+static void
+terminal_end_using_terminal ()
+{
+ send_to_terminal (term_end_use);
+}
+
+/* **************************************************************** */
+/* */
+/* Necessary Terminal Functions */
+/* */
+/* **************************************************************** */
+
+/* The functions and variables on this page implement the user visible
+ portion of the terminal interface. */
+
+/* The width and height of the terminal. */
+int screenwidth, screenheight;
+
+/* Non-zero means this terminal can't really do anything. */
+int terminal_is_dumb_p = 0;
+
+/* Non-zero means that this terminal has a meta key. */
+int terminal_has_meta_p = 0;
+
+/* Non-zero means that this terminal can produce a visible bell. */
+int terminal_has_visible_bell_p = 0;
+
+/* Non-zero means to use that visible bell if at all possible. */
+int terminal_use_visible_bell_p = 0;
+
+/* Non-zero means that the terminal can do scrolling. */
+int terminal_can_scroll = 0;
+
+/* The key sequences output by the arrow keys, if this terminal has any. */
+char *term_ku = (char *)NULL;
+char *term_kd = (char *)NULL;
+char *term_kr = (char *)NULL;
+char *term_kl = (char *)NULL;
+
+/* Move the cursor to the terminal location of X and Y. */
+void
+terminal_goto_xy (x, y)
+ int x, y;
+{
+ if (terminal_goto_xy_hook)
+ (*terminal_goto_xy_hook) (x, y);
+ else
+ {
+ if (term_goto)
+ tputs (tgoto (term_goto, x, y), 1, output_character_function);
+ }
+}
+
+/* Print STRING to the terminal at the current position. */
+void
+terminal_put_text (string)
+ char *string;
+{
+ if (terminal_put_text_hook)
+ (*terminal_put_text_hook) (string);
+ else
+ {
+ printf ("%s", string);
+ }
+}
+
+/* Print NCHARS from STRING to the terminal at the current position. */
+void
+terminal_write_chars (string, nchars)
+ char *string;
+ int nchars;
+{
+ if (terminal_write_chars_hook)
+ (*terminal_write_chars_hook) (string, nchars);
+ else
+ {
+ if (nchars)
+ fwrite (string, 1, nchars, stdout);
+ }
+}
+
+/* Clear from the current position of the cursor to the end of the line. */
+void
+terminal_clear_to_eol ()
+{
+ if (terminal_clear_to_eol_hook)
+ (*terminal_clear_to_eol_hook) ();
+ else
+ {
+ send_to_terminal (term_clreol);
+ }
+}
+
+/* Clear the entire terminal screen. */
+void
+terminal_clear_screen ()
+{
+ if (terminal_clear_screen_hook)
+ (*terminal_clear_screen_hook) ();
+ else
+ {
+ send_to_terminal (term_clrpag);
+ }
+}
+
+/* Move the cursor up one line. */
+void
+terminal_up_line ()
+{
+ if (terminal_up_line_hook)
+ (*terminal_up_line_hook) ();
+ else
+ {
+ send_to_terminal (term_up);
+ }
+}
+
+/* Move the cursor down one line. */
+void
+terminal_down_line ()
+{
+ if (terminal_down_line_hook)
+ (*terminal_down_line_hook) ();
+ else
+ {
+ send_to_terminal (term_dn);
+ }
+}
+
+/* Turn on reverse video if possible. */
+void
+terminal_begin_inverse ()
+{
+ if (terminal_begin_inverse_hook)
+ (*terminal_begin_inverse_hook) ();
+ else
+ {
+ send_to_terminal (term_invbeg);
+ }
+}
+
+/* Turn off reverse video if possible. */
+void
+terminal_end_inverse ()
+{
+ if (terminal_end_inverse_hook)
+ (*terminal_end_inverse_hook) ();
+ else
+ {
+ send_to_terminal (term_invend);
+ }
+}
+
+/* Ring the terminal bell. The bell is run visibly if it both has one and
+ terminal_use_visible_bell_p is non-zero. */
+void
+terminal_ring_bell ()
+{
+ if (terminal_ring_bell_hook)
+ (*terminal_ring_bell_hook) ();
+ else
+ {
+ if (terminal_has_visible_bell_p && terminal_use_visible_bell_p)
+ send_to_terminal (visible_bell);
+ else
+ send_to_terminal (audible_bell);
+ }
+}
+
+/* At the line START, delete COUNT lines from the terminal display. */
+static void
+terminal_delete_lines (start, count)
+ int start, count;
+{
+ int lines;
+
+ /* Normalize arguments. */
+ if (start < 0)
+ start = 0;
+
+ lines = screenheight - start;
+ terminal_goto_xy (0, start);
+ if (term_DL)
+ tputs (tgoto (term_DL, 0, count), lines, output_character_function);
+ else
+ {
+ while (count--)
+ tputs (term_dl, lines, output_character_function);
+ }
+
+ fflush (stdout);
+}
+
+/* At the line START, insert COUNT lines in the terminal display. */
+static void
+terminal_insert_lines (start, count)
+ int start, count;
+{
+ int lines;
+
+ /* Normalize arguments. */
+ if (start < 0)
+ start = 0;
+
+ lines = screenheight - start;
+ terminal_goto_xy (0, start);
+
+ if (term_AL)
+ tputs (tgoto (term_AL, 0, count), lines, output_character_function);
+ else
+ {
+ while (count--)
+ tputs (term_al, lines, output_character_function);
+ }
+
+ fflush (stdout);
+}
+
+/* Scroll an area of the terminal, starting with the region from START
+ to END, AMOUNT lines. If AMOUNT is negative, the lines are scrolled
+ towards the top of the screen, else they are scrolled towards the
+ bottom of the screen. */
+void
+terminal_scroll_terminal (start, end, amount)
+ int start, end, amount;
+{
+ if (!terminal_can_scroll)
+ return;
+
+ /* Any scrolling at all? */
+ if (amount == 0)
+ return;
+
+ if (terminal_scroll_terminal_hook)
+ (*terminal_scroll_terminal_hook) (start, end, amount);
+ else
+ {
+ /* If we are scrolling down, delete AMOUNT lines at END. Then insert
+ AMOUNT lines at START. */
+ if (amount > 0)
+ {
+ terminal_delete_lines (end, amount);
+ terminal_insert_lines (start, amount);
+ }
+
+ /* If we are scrolling up, delete AMOUNT lines before START. This
+ actually does the upwards scroll. Then, insert AMOUNT lines
+ after the already scrolled region (i.e., END - AMOUNT). */
+ if (amount < 0)
+ {
+ int abs_amount = -amount;
+ terminal_delete_lines (start - abs_amount, abs_amount);
+ terminal_insert_lines (end - abs_amount, abs_amount);
+ }
+ }
+}
+
+/* Re-initialize the terminal considering that the TERM/TERMCAP variable
+ has changed. */
+void
+terminal_new_terminal (terminal_name)
+ char *terminal_name;
+{
+ if (terminal_new_terminal_hook)
+ (*terminal_new_terminal_hook) (terminal_name);
+ else
+ {
+ terminal_initialize_terminal (terminal_name);
+ }
+}
+
+/* Set the global variables SCREENWIDTH and SCREENHEIGHT. */
+void
+terminal_get_screen_size ()
+{
+ if (terminal_get_screen_size_hook)
+ (*terminal_get_screen_size_hook) ();
+ else
+ {
+ screenwidth = screenheight = 0;
+
+#if defined (TIOCGWINSZ)
+ {
+ struct winsize window_size;
+
+ if (ioctl (fileno (stdout), TIOCGWINSZ, &window_size) == 0)
+ {
+ screenwidth = (int) window_size.ws_col;
+ screenheight = (int) window_size.ws_row;
+ }
+ }
+#endif /* TIOCGWINSZ */
+
+ /* Environment variable COLUMNS overrides setting of "co". */
+ if (screenwidth <= 0)
+ {
+ char *sw = getenv ("COLUMNS");
+
+ if (sw)
+ screenwidth = atoi (sw);
+
+ if (screenwidth <= 0)
+ screenwidth = tgetnum ("co");
+ }
+
+ /* Environment variable LINES overrides setting of "li". */
+ if (screenheight <= 0)
+ {
+ char *sh = getenv ("LINES");
+
+ if (sh)
+ screenheight = atoi (sh);
+
+ if (screenheight <= 0)
+ screenheight = tgetnum ("li");
+ }
+
+ /* If all else fails, default to 80x24 terminal. */
+ if (screenwidth <= 0)
+ screenwidth = 80;
+
+ if (screenheight <= 0)
+ screenheight = 24;
+ }
+}
+
+/* Initialize the terminal which is known as TERMINAL_NAME. If this terminal
+ doesn't have cursor addressability, TERMINAL_IS_DUMB_P becomes non-zero.
+ The variables SCREENHEIGHT and SCREENWIDTH are set to the dimensions that
+ this terminal actually has. The variable TERMINAL_HAS_META_P becomes non-
+ zero if this terminal supports a Meta key. Finally, the terminal screen is
+ cleared. */
+void
+terminal_initialize_terminal (terminal_name)
+ char *terminal_name;
+{
+ char *term, *buffer;
+
+ terminal_is_dumb_p = 0;
+
+ if (terminal_initialize_terminal_hook)
+ {
+ (*terminal_initialize_terminal_hook) (terminal_name);
+ return;
+ }
+
+ term = terminal_name ? terminal_name : getenv ("TERM");
+
+ if (!term_string_buffer)
+ term_string_buffer = (char *)xmalloc (2048);
+
+ if (!term_buffer)
+ term_buffer = (char *)xmalloc (2048);
+
+ buffer = term_string_buffer;
+
+ term_clrpag = term_cr = term_clreol = (char *)NULL;
+
+ if (!term)
+ term = "dumb";
+
+ if (tgetent (term_buffer, term) <= 0)
+ {
+ terminal_is_dumb_p = 1;
+ screenwidth = 80;
+ screenheight = 24;
+ term_cr = "\r";
+ term_up = term_dn = audible_bell = visible_bell = (char *)NULL;
+ term_ku = term_kd = term_kl = term_kr = (char *)NULL;
+ return;
+ }
+
+ BC = tgetstr ("pc", &buffer);
+ PC = BC ? *BC : 0;
+
+#if defined (TIOCGETP)
+ {
+ struct sgttyb sg;
+
+ if (ioctl (fileno (stdout), TIOCGETP, &sg) != -1)
+ ospeed = sg.sg_ospeed;
+ else
+ ospeed = B9600;
+ }
+#else
+ ospeed = B9600;
+#endif /* !TIOCGETP */
+
+ term_cr = tgetstr ("cr", &buffer);
+ term_clreol = tgetstr ("ce", &buffer);
+ term_clrpag = tgetstr ("cl", &buffer);
+ term_goto = tgetstr ("cm", &buffer);
+
+ /* Find out about this terminals scrolling capability. */
+ term_AL = tgetstr ("AL", &buffer);
+ term_DL = tgetstr ("DL", &buffer);
+ term_al = tgetstr ("al", &buffer);
+ term_dl = tgetstr ("dl", &buffer);
+
+ terminal_can_scroll = ((term_AL || term_al) && (term_DL || term_dl));
+
+ term_invbeg = tgetstr ("mr", &buffer);
+ if (term_invbeg)
+ term_invend = tgetstr ("me", &buffer);
+ else
+ term_invend = (char *)NULL;
+
+ if (!term_cr)
+ term_cr = "\r";
+
+ terminal_get_screen_size ();
+
+ term_up = tgetstr ("up", &buffer);
+ term_dn = tgetstr ("dn", &buffer);
+ visible_bell = tgetstr ("vb", &buffer);
+ terminal_has_visible_bell_p = (visible_bell != (char *)NULL);
+ audible_bell = tgetstr ("bl", &buffer);
+ if (!audible_bell)
+ audible_bell = "\007";
+ term_begin_use = tgetstr ("ti", &buffer);
+ term_end_use = tgetstr ("te", &buffer);
+
+ /* Check to see if this terminal has a meta key. */
+ terminal_has_meta_p = (tgetflag ("km") || tgetflag ("MT"));
+ if (terminal_has_meta_p)
+ {
+ term_mm = tgetstr ("mm", &buffer);
+ term_mo = tgetstr ("mo", &buffer);
+ }
+ else
+ {
+ term_mm = (char *)NULL;
+ term_mo = (char *)NULL;
+ }
+
+ /* Attempt to find the arrow keys. */
+ term_ku = tgetstr ("ku", &buffer);
+ term_kd = tgetstr ("kd", &buffer);
+ term_kr = tgetstr ("kr", &buffer);
+ term_kl = tgetstr ("kl", &buffer);
+
+ /* If this terminal is not cursor addressable, then it is really dumb. */
+ if (!term_goto)
+ terminal_is_dumb_p = 1;
+
+ terminal_begin_using_terminal ();
+}
+
+/* **************************************************************** */
+/* */
+/* How to Read Characters From the Terminal */
+/* */
+/* **************************************************************** */
+
+#if defined (TIOCGETC)
+/* A buffer containing the terminal interrupt characters upon entry
+ to Info. */
+struct tchars original_tchars;
+#endif
+
+#if defined (TIOCGLTC)
+/* A buffer containing the local terminal mode characters upon entry
+ to Info. */
+struct ltchars original_ltchars;
+#endif
+
+#if defined (HAVE_TERMIOS_H)
+struct termios original_termios, ttybuff;
+#else
+# if defined (HAVE_TERMIO_H)
+/* A buffer containing the terminal mode flags upon entry to info. */
+struct termio original_termio, ttybuff;
+# else /* !HAVE_TERMIO_H */
+/* Buffers containing the terminal mode flags upon entry to info. */
+int original_tty_flags = 0;
+int original_lmode;
+struct sgttyb ttybuff;
+# endif /* !HAVE_TERMIO_H */
+#endif /* !HAVE_TERMIOS_H */
+
+/* Prepare to start using the terminal to read characters singly. */
+void
+terminal_prep_terminal ()
+{
+ int tty;
+
+ if (terminal_prep_terminal_hook)
+ {
+ (*terminal_prep_terminal_hook) ();
+ return;
+ }
+
+ tty = fileno (stdin);
+
+#if defined (HAVE_TERMIOS_H)
+ tcgetattr (tty, &original_termios);
+ tcgetattr (tty, &ttybuff);
+#else
+# if defined (HAVE_TERMIO_H)
+ ioctl (tty, TCGETA, &original_termio);
+ ioctl (tty, TCGETA, &ttybuff);
+# endif
+#endif
+
+#if defined (HAVE_TERMIOS_H) || defined (HAVE_TERMIO_H)
+ ttybuff.c_iflag &= (~ISTRIP & ~INLCR & ~IGNCR & ~ICRNL & ~IXON);
+ ttybuff.c_oflag &= (~ONLCR & ~OCRNL);
+ ttybuff.c_lflag &= (~ICANON & ~ECHO);
+
+ ttybuff.c_cc[VMIN] = 1;
+ ttybuff.c_cc[VTIME] = 0;
+
+ if (ttybuff.c_cc[VINTR] == '\177')
+ ttybuff.c_cc[VINTR] = -1;
+
+ if (ttybuff.c_cc[VQUIT] == '\177')
+ ttybuff.c_cc[VQUIT] = -1;
+#endif
+
+#if defined (HAVE_TERMIOS_H)
+ tcsetattr (tty, TCSANOW, &ttybuff);
+#else
+# if defined (HAVE_TERMIO_H)
+ ioctl (tty, TCSETA, &ttybuff);
+# endif
+#endif
+
+#if !defined (HAVE_TERMIOS_H) && !defined (HAVE_TERMIO_H)
+ ioctl (tty, TIOCGETP, &ttybuff);
+
+ if (!original_tty_flags)
+ original_tty_flags = ttybuff.sg_flags;
+
+ /* Make this terminal pass 8 bits around while we are using it. */
+# if defined (PASS8)
+ ttybuff.sg_flags |= PASS8;
+# endif /* PASS8 */
+
+# if defined (TIOCLGET) && defined (LPASS8)
+ {
+ int flags;
+ ioctl (tty, TIOCLGET, &flags);
+ original_lmode = flags;
+ flags |= LPASS8;
+ ioctl (tty, TIOCLSET, &flags);
+ }
+# endif /* TIOCLGET && LPASS8 */
+
+# if defined (TIOCGETC)
+ {
+ struct tchars temp;
+
+ ioctl (tty, TIOCGETC, &original_tchars);
+ temp = original_tchars;
+
+ /* C-s and C-q. */
+ temp.t_startc = temp.t_stopc = -1;
+
+ /* Often set to C-d. */
+ temp.t_eofc = -1;
+
+ /* If the a quit or interrupt character conflicts with one of our
+ commands, then make it go away. */
+ if (temp.t_intrc == '\177')
+ temp.t_intrc = -1;
+
+ if (temp.t_quitc == '\177')
+ temp.t_quitc = -1;
+
+ ioctl (tty, TIOCSETC, &temp);
+ }
+# endif /* TIOCGETC */
+
+# if defined (TIOCGLTC)
+ {
+ struct ltchars temp;
+
+ ioctl (tty, TIOCGLTC, &original_ltchars);
+ temp = original_ltchars;
+
+ /* Make the interrupt keys go away. Just enough to make people happy. */
+ temp.t_lnextc = -1; /* C-v. */
+ temp.t_dsuspc = -1; /* C-y. */
+ temp.t_flushc = -1; /* C-o. */
+ ioctl (tty, TIOCSLTC, &temp);
+ }
+# endif /* TIOCGLTC */
+
+ ttybuff.sg_flags &= ~ECHO;
+ ttybuff.sg_flags |= CBREAK;
+ ioctl (tty, TIOCSETN, &ttybuff);
+#endif /* !HAVE_TERMIOS_H && !HAVE_TERMIO_H */
+}
+
+/* Restore the tty settings back to what they were before we started using
+ this terminal. */
+void
+terminal_unprep_terminal ()
+{
+ int tty;
+
+ if (terminal_unprep_terminal_hook)
+ {
+ (*terminal_unprep_terminal_hook) ();
+ return;
+ }
+
+ tty = fileno (stdin);
+
+#if defined (HAVE_TERMIOS_H)
+ tcsetattr (tty, TCSANOW, &original_termios);
+#else
+# if defined (HAVE_TERMIO_H)
+ ioctl (tty, TCSETA, &original_termio);
+# else /* !HAVE_TERMIO_H */
+ ioctl (tty, TIOCGETP, &ttybuff);
+ ttybuff.sg_flags = original_tty_flags;
+ ioctl (tty, TIOCSETN, &ttybuff);
+
+# if defined (TIOCGETC)
+ ioctl (tty, TIOCSETC, &original_tchars);
+# endif /* TIOCGETC */
+
+# if defined (TIOCGLTC)
+ ioctl (tty, TIOCSLTC, &original_ltchars);
+# endif /* TIOCGLTC */
+
+# if defined (TIOCLGET) && defined (LPASS8)
+ ioctl (tty, TIOCLSET, &original_lmode);
+# endif /* TIOCLGET && LPASS8 */
+
+# endif /* !HAVE_TERMIO_H */
+#endif /* !HAVE_TERMIOS_H */
+ terminal_end_using_terminal ();
+}
+
diff --git a/texinfo/info/terminal.h b/texinfo/info/terminal.h
new file mode 100644
index 00000000000..7cb115835c6
--- /dev/null
+++ b/texinfo/info/terminal.h
@@ -0,0 +1,129 @@
+/* terminal.h -- The external interface to terminal I/O. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_TERMINAL_H_)
+#define _TERMINAL_H_
+
+/* We use the following data type to talk about pointers to functions. */
+#if !defined (__FUNCTION_DEF)
+# define __FUNCTION_DEF
+typedef int Function ();
+typedef void VFunction ();
+#endif /* _FUNCTION_DEF */
+
+/* For almost every function externally visible from terminal.c, there is
+ a corresponding "hook" function which can be bound in order to replace
+ the functionality of the one found in terminal.c. This is how we go
+ about implemented X window display. */
+
+/* The width and height of the terminal. */
+extern int screenwidth, screenheight;
+
+/* Non-zero means this terminal can't really do anything. */
+extern int terminal_is_dumb_p;
+
+/* Non-zero means that this terminal has a meta key. */
+extern int terminal_has_meta_p;
+
+/* Non-zero means that this terminal can produce a visible bell. */
+extern int terminal_has_visible_bell_p;
+
+/* Non-zero means to use that visible bell if at all possible. */
+extern int terminal_use_visible_bell_p;
+
+/* Non-zero means that this terminal can scroll lines up and down. */
+extern int terminal_can_scroll;
+
+/* Initialize the terminal which is known as TERMINAL_NAME. If this terminal
+ doesn't have cursor addressability, TERMINAL_IS_DUMB_P becomes non-zero.
+ The variables SCREENHEIGHT and SCREENWIDTH are set to the dimensions that
+ this terminal actually has. The variable TERMINAL_HAS_META_P becomes non-
+ zero if this terminal supports a Meta key. */
+extern void terminal_initialize_terminal ();
+extern VFunction *terminal_initialize_terminal_hook;
+
+/* Return the current screen width and height in the variables
+ SCREENWIDTH and SCREENHEIGHT. */
+extern void terminal_get_screen_size ();
+extern VFunction *terminal_get_screen_size_hook;
+
+/* Save and restore tty settings. */
+extern void terminal_prep_terminal (), terminal_unprep_terminal ();
+extern VFunction *terminal_prep_terminal_hook, *terminal_unprep_terminal_hook;
+
+/* Re-initialize the terminal to TERMINAL_NAME. */
+extern void terminal_new_terminal ();
+extern VFunction *terminal_new_terminal_hook;
+
+/* Move the cursor to the terminal location of X and Y. */
+extern void terminal_goto_xy ();
+extern VFunction *terminal_goto_xy_hook;
+
+/* Print STRING to the terminal at the current position. */
+extern void terminal_put_text ();
+extern VFunction *terminal_put_text_hook;
+
+/* Print NCHARS from STRING to the terminal at the current position. */
+extern void terminal_write_chars ();
+extern VFunction *terminal_write_chars_hook;
+
+/* Clear from the current position of the cursor to the end of the line. */
+extern void terminal_clear_to_eol ();
+extern VFunction *terminal_clear_to_eol_hook;
+
+/* Clear the entire terminal screen. */
+extern void terminal_clear_screen ();
+extern VFunction *terminal_clear_screen_hook;
+
+/* Move the cursor up one line. */
+extern void terminal_up_line ();
+extern VFunction *terminal_up_line_hook;
+
+/* Move the cursor down one line. */
+extern void terminal_down_line ();
+extern VFunction *terminal_down_line_hook;
+
+/* Turn on reverse video if possible. */
+extern void terminal_begin_inverse ();
+extern VFunction *terminal_begin_inverse_hook;
+
+/* Turn off reverse video if possible. */
+extern void terminal_end_inverse ();
+extern VFunction *terminal_end_inverse_hook;
+
+/* Scroll an area of the terminal, starting with the region from START
+ to END, AMOUNT lines. If AMOUNT is negative, the lines are scrolled
+ towards the top of the screen, else they are scrolled towards the
+ bottom of the screen. */
+extern void terminal_scroll_terminal ();
+extern VFunction *terminal_scroll_terminal_hook;
+
+/* Ring the terminal bell. The bell is run visibly if it both has one and
+ terminal_use_visible_bell_p is non-zero. */
+extern void terminal_ring_bell ();
+extern VFunction *terminal_ring_bell_hook;
+
+/* The key sequences output by the arrow keys, if this terminal has any. */
+extern char *term_ku, *term_kd, *term_kr, *term_kl;
+
+#endif /* !_TERMINAL_H_ */
diff --git a/texinfo/info/tilde.c b/texinfo/info/tilde.c
new file mode 100644
index 00000000000..817f9092c30
--- /dev/null
+++ b/texinfo/info/tilde.c
@@ -0,0 +1,376 @@
+/* tilde.c -- Tilde expansion code (~/foo := $HOME/foo).
+ $Id: tilde.c,v 1.1 1997/08/21 22:58:05 jason Exp $
+
+ This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1988, 89, 90, 91, 92, 93, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if defined (__GNUC__)
+# define alloca __builtin_alloca
+#else /* !__GNUC__ */
+# if defined (_AIX)
+ #pragma alloca
+# else /* !_AIX */
+# if defined (HAVE_ALLOCA_H)
+# include <alloca.h>
+# endif /* HAVE_ALLOCA_H */
+# endif /* !AIX */
+#endif /* !__GNUC__ */
+
+#if defined (HAVE_STDLIB_H)
+#include <stdlib.h>
+#endif
+
+#include "tilde.h"
+#include <pwd.h>
+
+#if defined (HAVE_STRING_H)
+#include <string.h>
+#endif
+
+#include "clib.h"
+
+#if !defined (NULL)
+# define NULL 0x0
+#endif
+
+#if defined (TEST) || defined (STATIC_MALLOC)
+static void *xmalloc (), *xrealloc ();
+#else
+extern void *xmalloc (), *xrealloc ();
+#endif /* TEST || STATIC_MALLOC */
+
+/* The default value of tilde_additional_prefixes. This is set to
+ whitespace preceding a tilde so that simple programs which do not
+ perform any word separation get desired behaviour. */
+static char *default_prefixes[] =
+ { " ~", "\t~", (char *)NULL };
+
+/* The default value of tilde_additional_suffixes. This is set to
+ whitespace or newline so that simple programs which do not
+ perform any word separation get desired behaviour. */
+static char *default_suffixes[] =
+ { " ", "\n", (char *)NULL };
+
+/* If non-null, this contains the address of a function to call if the
+ standard meaning for expanding a tilde fails. The function is called
+ with the text (sans tilde, as in "foo"), and returns a malloc()'ed string
+ which is the expansion, or a NULL pointer if there is no expansion. */
+CFunction *tilde_expansion_failure_hook = (CFunction *)NULL;
+
+/* When non-null, this is a NULL terminated array of strings which
+ are duplicates for a tilde prefix. Bash uses this to expand
+ `=~' and `:~'. */
+char **tilde_additional_prefixes = default_prefixes;
+
+/* When non-null, this is a NULL terminated array of strings which match
+ the end of a username, instead of just "/". Bash sets this to
+ `:' and `=~'. */
+char **tilde_additional_suffixes = default_suffixes;
+
+/* Find the start of a tilde expansion in STRING, and return the index of
+ the tilde which starts the expansion. Place the length of the text
+ which identified this tilde starter in LEN, excluding the tilde itself. */
+static int
+tilde_find_prefix (string, len)
+ char *string;
+ int *len;
+{
+ register int i, j, string_len;
+ register char **prefixes = tilde_additional_prefixes;
+
+ string_len = strlen (string);
+ *len = 0;
+
+ if (!*string || *string == '~')
+ return (0);
+
+ if (prefixes)
+ {
+ for (i = 0; i < string_len; i++)
+ {
+ for (j = 0; prefixes[j]; j++)
+ {
+ if (strncmp (string + i, prefixes[j], strlen (prefixes[j])) == 0)
+ {
+ *len = strlen (prefixes[j]) - 1;
+ return (i + *len);
+ }
+ }
+ }
+ }
+ return (string_len);
+}
+
+/* Find the end of a tilde expansion in STRING, and return the index of
+ the character which ends the tilde definition. */
+static int
+tilde_find_suffix (string)
+ char *string;
+{
+ register int i, j, string_len;
+ register char **suffixes = tilde_additional_suffixes;
+
+ string_len = strlen (string);
+
+ for (i = 0; i < string_len; i++)
+ {
+ if (string[i] == '/' || !string[i])
+ break;
+
+ for (j = 0; suffixes && suffixes[j]; j++)
+ {
+ if (strncmp (string + i, suffixes[j], strlen (suffixes[j])) == 0)
+ return (i);
+ }
+ }
+ return (i);
+}
+
+/* Return a new string which is the result of tilde expanding STRING. */
+char *
+tilde_expand (string)
+ char *string;
+{
+ char *result, *tilde_expand_word ();
+ int result_size, result_index;
+
+ result_size = result_index = 0;
+ result = (char *)NULL;
+
+ /* Scan through STRING expanding tildes as we come to them. */
+ while (1)
+ {
+ register int start, end;
+ char *tilde_word, *expansion;
+ int len;
+
+ /* Make START point to the tilde which starts the expansion. */
+ start = tilde_find_prefix (string, &len);
+
+ /* Copy the skipped text into the result. */
+ if ((result_index + start + 1) > result_size)
+ result = (char *)xrealloc (result, 1 + (result_size += (start + 20)));
+
+ strncpy (result + result_index, string, start);
+ result_index += start;
+
+ /* Advance STRING to the starting tilde. */
+ string += start;
+
+ /* Make END be the index of one after the last character of the
+ username. */
+ end = tilde_find_suffix (string);
+
+ /* If both START and END are zero, we are all done. */
+ if (!start && !end)
+ break;
+
+ /* Expand the entire tilde word, and copy it into RESULT. */
+ tilde_word = (char *)xmalloc (1 + end);
+ strncpy (tilde_word, string, end);
+ tilde_word[end] = '\0';
+ string += end;
+
+ expansion = tilde_expand_word (tilde_word);
+ free (tilde_word);
+
+ len = strlen (expansion);
+ if ((result_index + len + 1) > result_size)
+ result = (char *)xrealloc (result, 1 + (result_size += (len + 20)));
+
+ strcpy (result + result_index, expansion);
+ result_index += len;
+ free (expansion);
+ }
+
+ result[result_index] = '\0';
+
+ return (result);
+}
+
+/* Do the work of tilde expansion on FILENAME. FILENAME starts with a
+ tilde. If there is no expansion, call tilde_expansion_failure_hook. */
+char *
+tilde_expand_word (filename)
+ char *filename;
+{
+ char *dirname;
+
+ dirname = filename ? strdup (filename) : (char *)NULL;
+
+ if (dirname && *dirname == '~')
+ {
+ char *temp_name;
+ if (!dirname[1] || dirname[1] == '/')
+ {
+ /* Prepend $HOME to the rest of the string. */
+ extern char *getenv ();
+ char *temp_home = getenv ("HOME");
+
+ /* If there is no HOME variable, look up the directory in
+ the password database. */
+ if (!temp_home)
+ {
+ struct passwd *entry;
+
+ entry = (struct passwd *) getpwuid (getuid ());
+ if (entry)
+ temp_home = entry->pw_dir;
+ }
+
+ temp_name = (char *)
+ alloca (1 + strlen (&dirname[1])
+ + (temp_home ? strlen (temp_home) : 0));
+ temp_name[0] = '\0';
+ if (temp_home)
+ strcpy (temp_name, temp_home);
+ strcat (temp_name, &dirname[1]);
+ free (dirname);
+ dirname = strdup (temp_name);
+ }
+ else
+ {
+ struct passwd *user_entry;
+ char *username = (char *)alloca (257);
+ int i, c;
+
+ for (i = 1; c = dirname[i]; i++)
+ {
+ if (c == '/')
+ break;
+ else
+ username[i - 1] = c;
+ }
+ username[i - 1] = '\0';
+
+ if (!(user_entry = (struct passwd *) getpwnam (username)))
+ {
+ /* If the calling program has a special syntax for
+ expanding tildes, and we couldn't find a standard
+ expansion, then let them try. */
+ if (tilde_expansion_failure_hook)
+ {
+ char *expansion;
+
+ expansion = (*tilde_expansion_failure_hook) (username);
+
+ if (expansion)
+ {
+ temp_name = (char *)alloca
+ (1 + strlen (expansion) + strlen (&dirname[i]));
+ strcpy (temp_name, expansion);
+ strcat (temp_name, &dirname[i]);
+ free (expansion);
+ goto return_name;
+ }
+ }
+ /* We shouldn't report errors. */
+ }
+ else
+ {
+ temp_name = (char *)alloca
+ (1 + strlen (user_entry->pw_dir) + strlen (&dirname[i]));
+ strcpy (temp_name, user_entry->pw_dir);
+ strcat (temp_name, &dirname[i]);
+ return_name:
+ free (dirname);
+ dirname = strdup (temp_name);
+ }
+ endpwent ();
+ }
+ }
+ return (dirname);
+}
+
+
+#if defined (TEST)
+#undef NULL
+#include <stdio.h>
+
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ char *result, line[512];
+ int done = 0;
+
+ while (!done)
+ {
+ printf ("~expand: ");
+ fflush (stdout);
+
+ if (!gets (line))
+ strcpy (line, "done");
+
+ if ((strcmp (line, "done") == 0) ||
+ (strcmp (line, "quit") == 0) ||
+ (strcmp (line, "exit") == 0))
+ {
+ done = 1;
+ break;
+ }
+
+ result = tilde_expand (line);
+ printf (" --> %s\n", result);
+ free (result);
+ }
+ exit (0);
+}
+
+static void memory_error_and_abort ();
+
+static void *
+xmalloc (bytes)
+ int bytes;
+{
+ void *temp = (void *)malloc (bytes);
+
+ if (!temp)
+ memory_error_and_abort ();
+ return (temp);
+}
+
+static void *
+xrealloc (pointer, bytes)
+ void *pointer;
+ int bytes;
+{
+ void *temp;
+
+ if (!pointer)
+ temp = (char *)malloc (bytes);
+ else
+ temp = (char *)realloc (pointer, bytes);
+
+ if (!temp)
+ memory_error_and_abort ();
+
+ return (temp);
+}
+
+static void
+memory_error_and_abort ()
+{
+ fprintf (stderr, "readline: Out of virtual memory!\n");
+ abort ();
+}
+#endif /* TEST */
+
diff --git a/texinfo/info/tilde.h b/texinfo/info/tilde.h
new file mode 100644
index 00000000000..d66aee95015
--- /dev/null
+++ b/texinfo/info/tilde.h
@@ -0,0 +1,58 @@
+/* tilde.h: Externally available variables and function in libtilde.a. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ This file has appeared in prior works by the Free Software Foundation;
+ thus it carries copyright dates from 1988 through 1993.
+
+ Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993 Free Software
+ Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+/* Function pointers can be declared as (Function *)foo. */
+#if !defined (__FUNCTION_DEF)
+# define __FUNCTION_DEF
+typedef int Function ();
+typedef void VFunction ();
+typedef char *CFunction ();
+#endif /* _FUNCTION_DEF */
+
+/* If non-null, this contains the address of a function to call if the
+ standard meaning for expanding a tilde fails. The function is called
+ with the text (sans tilde, as in "foo"), and returns a malloc()'ed string
+ which is the expansion, or a NULL pointer if there is no expansion. */
+extern CFunction *tilde_expansion_failure_hook;
+
+/* When non-null, this is a NULL terminated array of strings which
+ are duplicates for a tilde prefix. Bash uses this to expand
+ `=~' and `:~'. */
+extern char **tilde_additional_prefixes;
+
+/* When non-null, this is a NULL terminated array of strings which match
+ the end of a username, instead of just "/". Bash sets this to
+ `:' and `=~'. */
+extern char **tilde_additional_suffixes;
+
+/* Return a new string which is the result of tilde expanding STRING. */
+extern char *tilde_expand ();
+
+/* Do the work of tilde expansion on FILENAME. FILENAME starts with a
+ tilde. If there is no expansion, call tilde_expansion_failure_hook. */
+extern char *tilde_expand_word ();
+
diff --git a/texinfo/info/userdoc.texi b/texinfo/info/userdoc.texi
new file mode 100644
index 00000000000..f9349c65c50
--- /dev/null
+++ b/texinfo/info/userdoc.texi
@@ -0,0 +1,1270 @@
+@c This file is meant to be included in any arbitrary piece of
+@c documentation that wishes to describe the info program. Some day
+@c info-stnd.texi should probably use this file instead of duplicating
+@c its contents.
+@c
+@c This file documents the use of the standalone GNU Info program,
+@c versions 2.7 and later.
+
+@ifclear InfoProgVer
+@set InfoProgVer 2.11
+@end ifclear
+@synindex vr cp
+@synindex fn cp
+@synindex ky cp
+
+@heading What is Info?
+
+This text documents the use of the GNU Info program, version
+@value{InfoProgVer}.
+
+@dfn{Info} is a program which is used to view info files on an ASCII
+terminal. @dfn{info files} are the result of processing texinfo files
+with the program @code{makeinfo} or with the Emacs command @code{M-x
+texinfo-format-buffer}. Finally, @dfn{texinfo} is a documentation
+language which allows a printed manual and online documentation (an info
+file) to be produced from a single source file.
+
+@menu
+* Options:: Options you can pass on the command line.
+* Cursor Commands:: Commands which move the cursor within a node.
+* Scrolling Commands:: Commands for moving the node around in a window.
+* Node Commands:: Commands for selecting a new node.
+* Searching Commands:: Commands for searching an info file.
+* Xref Commands:: Commands for selecting cross references.
+* Window Commands:: Commands which manipulate multiple windows.
+* Printing Nodes:: How to print out the contents of a node.
+* Miscellaneous Commands:: A few commands that defy categories.
+* Variables:: How to change the default behaviour of Info.
+@ifset NOTSET
+* Info for Sys Admins:: How to setup Info. Using special options.
+@end ifset
+@ifset STANDALONE
+* GNU Info Global Index:: Global index containing keystrokes, command names,
+ variable names, and general concepts.
+@end ifset
+@end menu
+
+@node Options
+@chapter Command Line Options
+@cindex command line options
+@cindex arguments, command line
+
+GNU Info accepts several options to control the initial node being
+viewed, and to specify which directories to search for info files. Here
+is a template showing an invocation of GNU Info from the shell:
+
+@example
+info [--@var{option-name} @var{option-value}] @var{menu-item}@dots{}
+@end example
+
+The following @var{option-names} are available when invoking Info from
+the shell:
+
+@table @code
+@cindex directory path
+@item --directory @var{directory-path}
+@itemx -d @var{directory-path}
+Adds @var{directory-path} to the list of directory paths searched when
+Info needs to find a file. You may issue @code{--directory} multiple
+times; once for each directory which contains info files.
+Alternatively, you may specify a value for the environment variable
+@code{INFOPATH}; if @code{--directory} is not given, the value of
+@code{INFOPATH} is used. The value of @code{INFOPATH} is a colon
+separated list of directory names. If you do not supply
+@code{INFOPATH} or @code{--directory-path} a default path is used.
+
+@item --file @var{filename}
+@itemx -f @var{filename}
+@cindex info file, selecting
+Specifies a particular info file to visit. Instead of visiting the file
+@code{dir}, Info will start with @code{(@var{filename})Top} as the first
+file and node.
+
+@item --node @var{nodename}
+@itemx -n @var{nodename}
+@cindex node, selecting
+Specifies a particular node to visit in the initial file loaded. This
+is especially useful in conjunction with @code{--file}@footnote{Of
+course, you can specify both the file and node in a @code{--node}
+command; but don't forget to escape the open and close parentheses from
+the shell as in: @code{info --node '(emacs)Buffers'}}. You may specify
+@code{--node} multiple times; for an interactive Info, each
+@var{nodename} is visited in its own window, for a non-interactive Info
+(such as when @code{--output} is given) each @var{nodename} is processed
+sequentially.
+
+@item --output @var{filename}
+@itemx -o @var{filename}
+@cindex file, outputting to
+@cindex outputting to a file
+Specify @var{filename} as the name of a file to output to. Each node
+that Info visits will be output to @var{filename} instead of
+interactively viewed. A value of @code{-} for @var{filename} specifies
+the standard output.
+
+@item --subnodes
+@cindex @code{--subnodes}, command line option
+This option only has meaning when given in conjunction with
+@code{--output}. It means to recursively output the nodes appearing in
+the menus of each node being output. Menu items which resolve to
+external info files are not output, and neither are menu items which are
+members of an index. Each node is only output once.
+
+@item --help
+@itemx -h
+Produces a relatively brief description of the available Info options.
+
+@item --version
+@cindex version information
+Prints the version information of Info and exits.
+
+@item @var{menu-item}
+@cindex menu, following
+Remaining arguments to Info are treated as the names of menu items. The
+first argument would be a menu item in the initial node visited, while
+the second argument would be a menu item in the first argument's node.
+You can easily move to the node of your choice by specifying the menu
+names which describe the path to that node. For example,
+
+@example
+info emacs buffers
+@end example
+
+first selects the menu item @samp{Emacs} in the node @samp{(dir)Top},
+and then selects the menu item @samp{Buffers} in the node
+@samp{(emacs)Top}.
+
+@end table
+
+@node Cursor Commands
+@chapter Moving the Cursor
+@cindex cursor, moving
+Many people find that reading screens of text page by page is made
+easier when one is able to indicate particular pieces of text with some
+kind of pointing device. Since this is the case, GNU Info (both the
+Emacs and standalone versions) have several commands which allow you to
+move the cursor about the screen. The notation used in this manual to
+describe keystrokes is identical to the notation used within the Emacs
+manual, and the GNU Readline manual. @xref{Characters, , Character
+Conventions, emacs, the GNU Emacs Manual}, if you are unfamilar with the
+notation.
+
+The following table lists the basic cursor movement commands in Info.
+Each entry consists of the key sequence you should type to execute the
+cursor movement, the @code{M-x}@footnote{@code{M-x} is also a command; it
+invokes @code{execute-extended-command}. @xref{M-x, , Executing an
+extended command, emacs, the GNU Emacs Manual}, for more detailed
+information.} command name (displayed in parentheses), and a short
+description of what the command does. All of the cursor motion commands
+can take an @dfn{numeric} argument (@pxref{Miscellaneous Commands,
+@code{universal-argument}}), to find out how to supply them. With a
+numeric argument, the motion commands are simply executed that
+many times; for example, a numeric argument of 4 given to
+@code{next-line} causes the cursor to move down 4 lines. With a
+negative numeric argument, the motion is reversed; an argument of -4
+given to the @code{next-line} command would cause the cursor to move
+@emph{up} 4 lines.
+
+@table @asis
+@item @code{C-n} (@code{next-line})
+@kindex C-n
+@findex next-line
+Moves the cursor down to the next line.
+
+@item @code{C-p} (@code{prev-line})
+@kindex C-p
+@findex prev-line
+Move the cursor up to the previous line.
+
+@item @code{C-a} (@code{beginning-of-line})
+@kindex C-a, in Info windows
+@findex beginning-of-line
+Move the cursor to the start of the current line.
+
+@item @code{C-e} (@code{end-of-line})
+@kindex C-e, in Info windows
+@findex end-of-line
+Moves the cursor to the end of the current line.
+
+@item @code{C-f} (@code{forward-char})
+@kindex C-f, in Info windows
+@findex forward-char
+Move the cursor forward a character.
+
+@item @code{C-b} (@code{backward-char})
+@kindex C-b, in Info windows
+@findex backward-char
+Move the cursor backward a character.
+
+@item @code{M-f} (@code{forward-word})
+@kindex M-f, in Info windows
+@findex forward-word
+Moves the cursor forward a word.
+
+@item @code{M-b} (@code{backward-word})
+@kindex M-b, in Info winows
+@findex backward-word
+Moves the cursor backward a word.
+
+@item @code{M-<} (@code{beginning-of-node})
+@itemx @code{b}
+@kindex b, in Info winows
+@kindex M-<
+@findex beginning-of-node
+Moves the cursor to the start of the current node.
+
+@item @code{M->} (@code{end-of-node})
+@kindex M->
+@findex end-of-node
+Moves the cursor to the end of the current node.
+
+@item @code{M-r} (@code{move-to-window-line})
+@kindex M-r
+@findex move-to-window-line
+Moves the cursor to a specific line of the window. Without a numeric
+argument, @code{M-r} moves the cursor to the start of the line in the
+center of the window. With a numeric argument of @var{n}, @code{M-r}
+moves the cursor to the start of the @var{n}th line in the window.
+@end table
+
+@node Scrolling Commands
+@chapter Moving Text Within a Window
+@cindex scrolling
+
+Sometimes you are looking at a screenful of text, and only part of the
+current paragraph you are reading is visible on the screen. The
+commands detailed in this section are used to shift which part of the
+current node is visible on the screen.
+
+@table @asis
+@item @code{SPC} (@code{scroll-forward})
+@itemx @code{C-v}
+@kindex SPC, in Info windows
+@kindex C-v
+@findex scroll-forward
+Shift the text in this window up. That is, show more of the node which
+is currently below the bottom of the window. With a numeric argument,
+show that many more lines at the bottom of the window; a numeric
+argument of 4 would shift all of the text in the window up 4 lines
+(discarding the top 4 lines), and show you four new lines at the bottom
+of the window. Without a numeric argument, @key{SPC} takes the bottom
+two lines of the window and places them at the top of the window,
+redisplaying almost a completely new screenful of lines.
+
+@item @code{DEL} (@code{scroll-backward})
+@itemx @code{M-v}
+@kindex DEL, in Info windows
+@kindex M-v
+@findex scroll-backward
+Shift the text in this window down. The inverse of
+@code{scroll-forward}.
+
+@end table
+
+@cindex scrolling through node structure
+The @code{scroll-forward} and @code{scroll-backward} commands can also
+move forward and backward through the node structure of the file. If
+you press @key{SPC} while viewing the end of a node, or @key{DEL} while
+viewing the beginning of a node, what happens is controlled by the
+variable @code{scroll-behaviour}. @xref{Variables,
+@code{scroll-behaviour}}, for more information.
+
+@table @asis
+@item @code{C-l} (@code{redraw-display})
+@kindex C-l
+@findex redraw-display
+Redraw the display from scratch, or shift the line containing the cursor
+to a specified location. With no numeric argument, @samp{C-l} clears
+the screen, and then redraws its entire contents. Given a numeric
+argument of @var{n}, the line containing the cursor is shifted so that
+it is on the @var{n}th line of the window.
+
+@item @code{C-x w} (@code{toggle-wrap})
+@kindex C-w
+@findex toggle-wrap
+Toggles the state of line wrapping in the current window. Normally,
+lines which are longer than the screen width @dfn{wrap}, i.e., they are
+continued on the next line. Lines which wrap have a @samp{\} appearing
+in the rightmost column of the screen. You can cause such lines to be
+terminated at the rightmost column by changing the state of line
+wrapping in the window with @code{C-x w}. When a line which needs more
+space than one screen width to display is displayed, a @samp{$} appears
+in the rightmost column of the screen, and the remainder of the line is
+invisible.
+@end table
+
+@node Node Commands
+@chapter Selecting a New Node
+@cindex nodes, selection of
+
+This section details the numerous Info commands which select a new node
+to view in the current window.
+
+The most basic node commands are @samp{n}, @samp{p}, @samp{u}, and
+@samp{l}.
+
+When you are viewing a node, the top line of the node contains some Info
+@dfn{pointers} which describe where the next, previous, and up nodes
+are. Info uses this line to move about the node structure of the file
+when you use the following commands:
+
+@table @asis
+@item @code{n} (@code{next-node})
+@kindex n
+@findex next-node
+Selects the `Next' node.
+
+@item @code{p} (@code{prev-node})
+@kindex p
+@findex prev-node
+Selects the `Prev' node.
+
+@item @code{u} (@code{up-node})
+@kindex u
+@findex up-node
+Selects the `Up' node.
+@end table
+
+You can easily select a node that you have already viewed in this window
+by using the @samp{l} command -- this name stands for "last", and
+actually moves through the list of already visited nodes for this
+window. @samp{l} with a negative numeric argument moves forward through
+the history of nodes for this window, so you can quickly step between
+two adjacent (in viewing history) nodes.
+
+@table @asis
+@item @code{l} (@code{history-node})
+@kindex l
+@findex history-node
+Selects the most recently selected node in this window.
+@end table
+
+Two additional commands make it easy to select the most commonly
+selected nodes; they are @samp{t} and @samp{d}.
+
+@table @asis
+@item @code{t} (@code{top-node})
+@kindex t
+@findex top-node
+Selects the node @samp{Top} in the current info file.
+
+@item @code{d} (@code{dir-node})
+@kindex d
+@findex dir-node
+Selects the directory node (i.e., the node @samp{(dir)}).
+@end table
+
+Here are some other commands which immediately result in the selection
+of a different node in the current window:
+
+@table @asis
+@item @code{<} (@code{first-node})
+@kindex <
+@findex first-node
+Selects the first node which appears in this file. This node is most
+often @samp{Top}, but it doesn't have to be.
+
+@item @code{>} (@code{last-node})
+@kindex >
+@findex last-node
+Selects the last node which appears in this file.
+
+@item @code{]} (@code{global-next-node})
+@kindex ]
+@findex global-next-node
+Moves forward or down through node structure. If the node that you are
+currently viewing has a @samp{Next} pointer, that node is selected.
+Otherwise, if this node has a menu, the first menu item is selected. If
+there is no @samp{Next} and no menu, the same process is tried with the
+@samp{Up} node of this node.
+
+@item @code{[} (@code{global-prev-node})
+@kindex [
+@findex global-prev-node
+Moves backward or up through node structure. If the node that you are
+currently viewing has a @samp{Prev} pointer, that node is selected.
+Otherwise, if the node has an @samp{Up} pointer, that node is selected,
+and if it has a menu, the last item in the menu is selected.
+@end table
+
+You can get the same behaviour as @code{global-next-node} and
+@code{global-prev-node} while simply scrolling through the file with
+@key{SPC} and @key{DEL}; @xref{Variables, @code{scroll-behaviour}}, for
+more information.
+
+@table @asis
+@item @code{g} (@code{goto-node})
+@kindex g
+@findex goto-node
+Reads the name of a node and selects it. No completion is done while
+reading the node name, since the desired node may reside in a separate
+file. The node must be typed exactly as it appears in the info file. A
+file name may be included as with any node specification, for example
+
+@example
+@code{g(emacs)Buffers}
+@end example
+
+finds the node @samp{Buffers} in the info file @file{emacs}.
+
+@item @code{C-x k} (@code{kill-node})
+@kindex C-x k
+@findex kill-node
+Kills a node. The node name is prompted for in the echo area, with a
+default of the current node. @dfn{Killing} a node means that Info tries
+hard to forget about it, removing it from the list of history nodes kept
+for the window where that node is found. Another node is selected in
+the window which contained the killed node.
+
+@item @code{C-x C-f} (@code{view-file})
+@kindex C-x C-f
+@findex view-file
+Reads the name of a file and selects the entire file. The command
+@example
+@code{C-x C-f @var{filename}}
+@end example
+is equivalent to typing
+@example
+@code{g(@var{filename})*}
+@end example
+
+@item @code{C-x C-b} (@code{list-visited-nodes})
+@kindex C-x C-b
+@findex list-visited-nodes
+Makes a window containing a menu of all of the currently visited nodes.
+This window becomes the selected window, and you may use the standard
+Info commands within it.
+
+@item @code{C-x b} (@code{select-visited-node})
+@kindex C-x b
+@findex select-visited-node
+Selects a node which has been previously visited in a visible window.
+This is similar to @samp{C-x C-b} followed by @samp{m}, but no window is
+created.
+@end table
+
+@node Searching Commands
+@chapter Searching an Info File
+@cindex searching
+
+GNU Info allows you to search for a sequence of characters throughout an
+entire info file, search through the indices of an info file, or find
+areas within an info file which discuss a particular topic.
+
+@table @asis
+@item @code{s} (@code{search})
+@kindex s
+@findex search
+Reads a string in the echo area and searches for it.
+
+@item @code{C-s} (@code{isearch-forward})
+@kindex C-s
+@findex isearch-forward
+Interactively searches forward through the info file for a string as you
+type it.
+
+@item @code{C-r} (@code{isearch-backward})
+@kindex C-r
+@findex isearch-backward
+Interactively searches backward through the info file for a string as
+you type it.
+
+@item @code{i} (@code{index-search})
+@kindex i
+@findex index-search
+Looks up a string in the indices for this info file, and selects a node
+where the found index entry points to.
+
+@item @code{,} (@code{next-index-match})
+@kindex ,
+@findex next-index-match
+Moves to the node containing the next matching index item from the last
+@samp{i} command.
+@end table
+
+The most basic searching command is @samp{s} (@code{search}). The
+@samp{s} command prompts you for a string in the echo area, and then
+searches the remainder of the info file for an ocurrence of that string.
+If the string is found, the node containing it is selected, and the
+cursor is left positioned at the start of the found string. Subsequent
+@samp{s} commands show you the default search string within @samp{[} and
+@samp{]}; pressing @key{RET} instead of typing a new string will use the
+default search string.
+
+@dfn{Incremental searching} is similar to basic searching, but the
+string is looked up while you are typing it, instead of waiting until
+the entire search string has been specified.
+
+@node Xref Commands
+@chapter Selecting Cross References
+
+We have already discussed the @samp{Next}, @samp{Prev}, and @samp{Up}
+pointers which appear at the top of a node. In addition to these
+pointers, a node may contain other pointers which refer you to a
+different node, perhaps in another info file. Such pointers are called
+@dfn{cross references}, or @dfn{xrefs} for short.
+
+@menu
+* Parts of an Xref:: What a cross reference is made of.
+* Selecting Xrefs:: Commands for selecting menu or note items.
+@end menu
+
+@node Parts of an Xref
+@section Parts of an Xref
+
+Cross references have two major parts: the first part is called the
+@dfn{label}; it is the name that you can use to refer to the cross
+reference, and the second is the @dfn{target}; it is the full name of
+the node that the cross reference points to.
+
+The target is separated from the label by a colon @samp{:}; first the
+label appears, and then the target. For example, in the sample menu
+cross reference below, the single colon separates the label from the
+target.
+
+@example
+* Foo Label: Foo Target. More information about Foo.
+@end example
+
+Note the @samp{.} which ends the name of the target. The @samp{.} is
+not part of the target; it serves only to let Info know where the target
+name ends.
+
+A shorthand way of specifying references allows two adjacent colons to
+stand for a target name which is the same as the label name:
+
+@example
+* Foo Commands:: Commands pertaining to Foo.
+@end example
+
+In the above example, the name of the target is the same as the name of
+the label, in this case @code{Foo Commands}.
+
+You will normally see two types of cross references while viewing nodes:
+@dfn{menu} references, and @dfn{note} references. Menu references
+appear within a node's menu; they begin with a @samp{*} at the beginning
+of a line, and continue with a label, a target, and a comment which
+describes what the contents of the node pointed to contains.
+
+Note references appear within the body of the node text; they begin with
+@code{*Note}, and continue with a label and a target.
+
+Like @samp{Next}, @samp{Prev} and @samp{Up} pointers, cross references
+can point to any valid node. They are used to refer you to a place
+where more detailed information can be found on a particular subject.
+Here is a cross reference which points to a node within the Texinfo
+documentation: @xref{xref, , Writing an Xref, texinfo, the Texinfo
+Manual}, for more information on creating your own texinfo cross
+references.
+
+@node Selecting Xrefs
+@section Selecting Xrefs
+
+The following table lists the Info commands which operate on menu items.
+
+@table @asis
+@item @code{1} (@code{menu-digit})
+@itemx @code{2} @dots{} @code{9}
+@cindex 1 @dots{} 9, in Info windows
+@kindex 1 @dots{} 9, in Info windows
+@findex menu-digit
+Within an Info window, pressing a single digit, (such as @samp{1}),
+selects that menu item, and places its node in the current window.
+For convenience, there is one exception; pressing @samp{0} selects the
+@emph{last} item in the node's menu.
+
+@item @code{0} (@code{last-menu-item})
+@kindex 0, in Info windows
+@findex last-menu-item
+Select the last item in the current node's menu.
+
+@item @code{m} (@code{menu-item})
+@kindex m
+@findex menu-item
+Reads the name of a menu item in the echo area and selects its node.
+Completion is available while reading the menu label.
+
+@item @code{M-x find-menu}
+@findex find-menu
+Moves the cursor to the start of this node's menu.
+@end table
+
+This table lists the Info commands which operate on note cross references.
+
+@table @asis
+@item @code{f} (@code{xref-item})
+@itemx @code{r}
+@kindex f
+@kindex r
+@findex xref-item
+Reads the name of a note cross reference in the echo area and selects
+its node. Completion is available while reading the cross reference
+label.
+@end table
+
+Finally, the next few commands operate on menu or note references alike:
+
+@table @asis
+@item @code{TAB} (@code{move-to-next-xref})
+@kindex TAB, in Info windows
+@findex move-to-next-xref
+Moves the cursor to the start of the next nearest menu item or note
+reference in this node. You can then use @key{RET}
+(@code{select-reference-this-line} to select the menu or note reference.
+
+@item @code{M-TAB} (@code{move-to-prev-xref})
+@kindex M-TAB, in Info windows
+@findex move-to-prev-xref
+Moves the cursor the start of the nearest previous menu item or note
+reference in this node.
+
+@item @code{RET} (@code{select-reference-this-line})
+@kindex RET, in Info windows
+@findex select-reference-this-line
+Selects the menu item or note reference appearing on this line.
+@end table
+
+@node Window Commands
+@chapter Manipulating Multiple Windows
+@cindex windows, manipulating
+
+A @dfn{window} is a place to show the text of a node. Windows have a
+view area where the text of the node is displayed, and an associated
+@dfn{mode line}, which briefly describes the node being viewed.
+
+GNU Info supports multiple windows appearing in a single screen; each
+window is separated from the next by its modeline. At any time, there
+is only one @dfn{active} window, that is, the window in which the cursor
+appears. There are commands available for creating windows, changing
+the size of windows, selecting which window is active, and for deleting
+windows.
+
+@menu
+* The Mode Line:: What appears in the mode line?
+* Basic Windows:: Manipulating windows in Info.
+* The Echo Area:: Used for displaying errors and reading input.
+@end menu
+
+@node The Mode Line
+@section The Mode Line
+
+A @dfn{mode line} is a line of inverse video which appears at the bottom
+of an info window. It describes the contents of the window just above
+it; this information includes the name of the file and node appearing in
+that window, the number of screen lines it takes to display the node,
+and the percentage of text that is above the top of the window. It can
+also tell you if the indirect tags table for this info file needs to be
+updated, and whether or not the info file was compressed when stored on
+disk.
+
+Here is a sample mode line for a window containing an uncompressed file
+named @file{dir}, showing the node @samp{Top}.
+
+@example
+-----Info: (dir)Top, 40 lines --Top---------------------------------------
+ ^^ ^ ^^^ ^^
+ (file)Node #lines where
+@end example
+
+When a node comes from a file which is compressed on disk, this is
+indicated in the mode line with two small @samp{z}'s. In addition, if
+the info file containing the node has been split into subfiles, the name
+of the subfile containing the node appears in the modeline as well:
+
+@example
+--zz-Info: (emacs)Top, 291 lines --Top-- Subfile: emacs-1.Z---------------
+@end example
+
+When Info makes a node internally, such that there is no corresponding
+info file on disk, the name of the node is surrounded by asterisks
+(@samp{*}). The name itself tells you what the contents of the window
+are; the sample mode line below shows an internally constructed node
+showing possible completions:
+
+@example
+-----Info: *Completions*, 7 lines --All-----------------------------------
+@end example
+
+@node Basic Windows
+@section Window Commands
+
+It can be convenient to view more than one node at a time. To allow
+this, Info can display more than one @dfn{window}. Each window has its
+own mode line (@pxref{The Mode Line}) and history of nodes viewed in that
+window (@pxref{Node Commands, , @code{history-node}}).
+
+@table @asis
+@item @code{C-x o} (@code{next-window})
+@cindex windows, selecting
+@kindex C-x o
+@findex next-window
+Selects the next window on the screen. Note that the echo area can only be
+selected if it is already in use, and you have left it temporarily.
+Normally, @samp{C-x o} simply moves the cursor into the next window on
+the screen, or if you are already within the last window, into the first
+window on the screen. Given a numeric argument, @samp{C-x o} moves over
+that many windows. A negative argument causes @samp{C-x o} to select
+the previous window on the screen.
+
+@item @code{M-x prev-window}
+@findex prev-window
+Selects the previous window on the screen. This is identical to
+@samp{C-x o} with a negative argument.
+
+@item @code{C-x 2} (@code{split-window})
+@cindex windows, creating
+@kindex C-x 2
+@findex split-window
+Splits the current window into two windows, both showing the same node.
+Each window is one half the size of the original window, and the cursor
+remains in the original window. The variable @code{automatic-tiling}
+can cause all of the windows on the screen to be resized for you
+automatically, please @pxref{Variables, , automatic-tiling} for more
+information.
+
+@item @code{C-x 0} (@code{delete-window})
+@cindex windows, deleting
+@kindex C-x 0
+@findex delete-window
+Deletes the current window from the screen. If you have made too many
+windows and your screen appears cluttered, this is the way to get rid of
+some of them.
+
+@item @code{C-x 1} (@code{keep-one-window})
+@kindex C-x 1
+@findex keep-one-window
+Deletes all of the windows excepting the current one.
+
+@item @code{ESC C-v} (@code{scroll-other-window})
+@kindex ESC C-v, in Info windows
+@findex scroll-other-window
+Scrolls the other window, in the same fashion that @samp{C-v} might
+scroll the current window. Given a negative argument, the "other"
+window is scrolled backward.
+
+@item @code{C-x ^} (@code{grow-window})
+@kindex C-x ^
+@findex grow-window
+Grows (or shrinks) the current window. Given a numeric argument, grows
+the current window that many lines; with a negative numeric argument,
+the window is shrunk instead.
+
+@item @code{C-x t} (@code{tile-windows})
+@cindex tiling
+@kindex C-x t
+@findex tile-windows
+Divides the available screen space among all of the visible windows.
+Each window is given an equal portion of the screen in which to display
+its contents. The variable @code{automatic-tiling} can cause
+@code{tile-windows} to be called when a window is created or deleted.
+@xref{Variables, , @code{automatic-tiling}}.
+@end table
+
+@node The Echo Area
+@section The Echo Area
+@cindex echo area
+
+The @dfn{echo area} is a one line window which appears at the bottom of
+the screen. It is used to display informative or error messages, and to
+read lines of input from you when that is necessary. Almost all of the
+commands available in the echo area are identical to their Emacs
+counterparts, so please refer to that documentation for greater depth of
+discussion on the concepts of editing a line of text. The following
+table briefly lists the commands that are available while input is being
+read in the echo area:
+
+@table @asis
+@item @code{C-f} (@code{echo-area-forward})
+@kindex C-f, in the echo area
+@findex echo-area-forward
+Moves forward a character.
+
+@item @code{C-b} (@code{echo-area-backward})
+@kindex C-b, in the echo area
+@findex echo-area-backward
+Moves backward a character.
+
+@item @code{C-a} (@code{echo-area-beg-of-line})
+@kindex C-a, in the echo area
+@findex echo-area-beg-of-line
+Moves to the start of the input line.
+
+@item @code{C-e} (@code{echo-area-end-of-line})
+@kindex C-e, in the echo area
+@findex echo-area-end-of-line
+Moves to the end of the input line.
+
+@item @code{M-f} (@code{echo-area-forward-word})
+@kindex M-f, in the echo area
+@findex echo-area-forward-word
+Moves forward a word.
+
+@item @code{M-b} (@code{echo-area-backward-word})
+@kindex M-b, in the echo area
+@findex echo-area-backward-word
+Moves backward a word.
+
+@item @code{C-d} (@code{echo-area-delete})
+@kindex C-d, in the echo area
+@findex echo-area-delete
+Deletes the character under the cursor.
+
+@item @code{DEL} (@code{echo-area-rubout})
+@kindex DEL, in the echo area
+@findex echo-area-rubout
+Deletes the character behind the cursor.
+
+@item @code{C-g} (@code{echo-area-abort})
+@kindex C-g, in the echo area
+@findex echo-area-abort
+Cancels or quits the current operation. If completion is being read,
+@samp{C-g} discards the text of the input line which does not match any
+completion. If the input line is empty, @samp{C-g} aborts the calling
+function.
+
+@item @code{RET} (@code{echo-area-newline})
+@kindex RET, in the echo area
+@findex echo-area-newline
+Accepts (or forces completion of) the current input line.
+
+@item @code{C-q} (@code{echo-area-quoted-insert})
+@kindex C-q, in the echo area
+@findex echo-area-quoted-insert
+Inserts the next character verbatim. This is how you can insert control
+characters into a search string, for example.
+
+@item @var{printing character} (@code{echo-area-insert})
+@kindex printing characters, in the echo area
+@findex echo-area-insert
+Inserts the character.
+
+@item @code{M-TAB} (@code{echo-area-tab-insert})
+@kindex M-TAB, in the echo area
+@findex echo-area-tab-insert
+Inserts a TAB character.
+
+@item @code{C-t} (@code{echo-area-transpose-chars})
+@kindex C-t, in the echo area
+@findex echo-area-transpose-chars
+Transposes the characters at the cursor.
+@end table
+
+The next group of commands deal with @dfn{killing}, and @dfn{yanking}
+text. For an in depth discussion of killing and yanking,
+@pxref{Killing, , Killing and Deleting, emacs, the GNU Emacs Manual}
+
+@table @asis
+@item @code{M-d} (@code{echo-area-kill-word})
+@kindex M-d, in the echo area
+@findex echo-area-kill-word
+Kills the word following the cursor.
+
+@item @code{M-DEL} (@code{echo-area-backward-kill-word})
+@kindex M-DEL, in the echo area
+@findex echo-area-backward-kill-word
+Kills the word preceding the cursor.
+
+@item @code{C-k} (@code{echo-area-kill-line})
+@kindex C-k, in the echo area
+@findex echo-area-kill-line
+Kills the text from the cursor to the end of the line.
+
+@item @code{C-x DEL} (@code{echo-area-backward-kill-line})
+@kindex C-x DEL, in the echo area
+@findex echo-area-backward-kill-line
+Kills the text from the cursor to the beginning of the line.
+
+@item @code{C-y} (@code{echo-area-yank})
+@kindex C-y, in the echo area
+@findex echo-area-yank
+Yanks back the contents of the last kill.
+
+@item @code{M-y} (@code{echo-area-yank-pop})
+@kindex M-y, in the echo area
+@findex echo-area-yank-pop
+Yanks back a previous kill, removing the last yanked text first.
+@end table
+
+Sometimes when reading input in the echo area, the command that needed
+input will only accept one of a list of several choices. The choices
+represent the @dfn{possible completions}, and you must respond with one
+of them. Since there are a limited number of responses you can make,
+Info allows you to abbreviate what you type, only typing as much of the
+response as is necessary to uniquely identify it. In addition, you can
+request Info to fill in as much of the response as is possible; this
+is called @dfn{completion}.
+
+The following commands are available when completing in the echo area:
+
+@table @asis
+@item @code{TAB} (@code{echo-area-complete})
+@itemx @code{SPC}
+@kindex TAB, in the echo area
+@kindex SPC, in the echo area
+@findex echo-area-complete
+Inserts as much of a completion as is possible.
+
+@item @code{?} (@code{echo-area-possible-completions})
+@kindex ?, in the echo area
+@findex echo-area-possible-completions
+Displays a window containing a list of the possible completions of what
+you have typed so far. For example, if the available choices are:
+@example
+bar
+foliate
+food
+forget
+@end example
+and you have typed an @samp{f}, followed by @samp{?}, the possible
+completions would contain:
+@example
+foliate
+food
+forget
+@end example
+i.e., all of the choices which begin with @samp{f}. Pressing @key{SPC}
+or @key{TAB} would result in @samp{fo} appearing in the echo area, since
+all of the choices which begin with @samp{f} continue with @samp{o}.
+Now, typing @samp{l} followed by @samp{TAB} results in @samp{foliate}
+appearing in the echo area, since that is the only choice which begins
+with @samp{fol}.
+
+@item @code{ESC C-v} (@code{echo-area-scroll-completions-window})
+@kindex ESC C-v, in the echo area
+@findex echo-area-scroll-completions-window
+Scrolls the completions window, if that is visible, or the "other"
+window if not.
+@end table
+
+@node Printing Nodes
+@chapter Printing Out Nodes
+@cindex printing
+
+You may wish to print out the contents of a node as a quick reference
+document for later use. Info provides you with a command for doing
+this. In general, we recommend that you use @TeX{} to format the
+document and print sections of it, by running @code{tex} on the texinfo
+source file.
+
+@table @asis
+@item @code{M-x print-node}
+@findex print-node
+@cindex INFO_PRINT_COMMAND, environment variable
+Pipes the contents of the current node through the command in the
+environment variable @code{INFO_PRINT_COMMAND}. If the variable doesn't
+exist, the node is simply piped to @code{lpr}.
+@end table
+
+@node Miscellaneous Commands
+@chapter Miscellaneous Commands
+
+GNU Info contains several commands which self-document GNU Info:
+
+@table @asis
+@item @code{M-x describe-command}
+@cindex functions, describing
+@cindex commands, describing
+@findex describe-command
+Reads the name of an Info command in the echo area and then displays a
+brief description of what that command does.
+
+@item @code{M-x describe-key}
+@cindex keys, describing
+@findex describe-key
+Reads a key sequence in the echo area, and then displays the name and
+documentation of the Info command that the key sequence invokes.
+
+@item @code{M-x describe-variable}
+Reads the name of a variable in the echo area and then displays a brief
+description of what the variable affects.
+
+@item @code{M-x where-is}
+@findex where-is
+Reads the name of an Info command in the echo area, and then displays
+a key sequence which can be typed in order to invoke that command.
+
+@item @code{C-h} (@code{get-help-window})
+@itemx @code{?}
+@kindex C-h
+@kindex ?, in Info windows
+@findex get-help-window
+Creates (or moves into) the window displaying @code{*Help*}, and places
+a node containing a quick reference card into it. This window displays
+the most concise information about GNU Info available.
+
+@item @code{h} (@code{get-info-help-node})
+@kindex h
+@findex get-info-help-node
+Tries hard to visit the node @code{(info)Help}. The info file
+@file{info.texi} distributed with GNU Info contains this node. Of
+course, the file must first be processed with @code{makeinfo}, and then
+placed into the location of your info directory.
+@end table
+
+Here are the commands for creating a numeric argument:
+
+@table @asis
+@item @code{C-u} (@code{universal-argument})
+@cindex numeric arguments
+@kindex C-u
+@findex universal-argument
+Starts (or multiplies by 4) the current numeric argument. @samp{C-u} is
+a good way to give a small numeric argument to cursor movement or
+scrolling commands; @samp{C-u C-v} scrolls the screen 4 lines, while
+@samp{C-u C-u C-n} moves the cursor down 16 lines.
+
+@item @code{M-1} (@code{add-digit-to-numeric-arg})
+@itemx @code{M-2} @dots{} @code{M-9}
+@kindex M-1 @dots{} M-9
+@findex add-digit-to-numeric-arg
+Adds the digit value of the invoking key to the current numeric
+argument. Once Info is reading a numeric argument, you may just type
+the digits of the argument, without the Meta prefix. For example, you
+might give @samp{C-l} a numeric argument of 32 by typing:
+
+@example
+@kbd{C-u 3 2 C-l}
+@end example
+or
+@example
+@kbd{M-3 2 C-l}
+@end example
+@end table
+
+@samp{C-g} is used to abort the reading of a multi-character key
+sequence, to cancel lengthy operations (such as multi-file searches) and
+to cancel reading input in the echo area.
+
+@table @asis
+@item @code{C-g} (@code{abort-key})
+@cindex cancelling typeahead
+@cindex cancelling the current operation
+@kindex C-g, in Info windows
+@findex abort-key
+Cancels current operation.
+@end table
+
+The @samp{q} command of Info simply quits running Info.
+
+@table @asis
+@item @code{q} (@code{quit})
+@cindex quitting
+@kindex q
+@findex quit
+Exits GNU Info.
+@end table
+
+If the operating system tells GNU Info that the screen is 60 lines tall,
+and it is actually only 40 lines tall, here is a way to tell Info that
+the operating system is correct.
+
+@table @asis
+@item @code{M-x set-screen-height}
+@findex set-screen-height
+@cindex screen, changing the height of
+Reads a height value in the echo area and sets the height of the
+displayed screen to that value.
+@end table
+
+Finally, Info provides a convenient way to display footnotes which might
+be associated with the current node that you are viewing:
+
+@table @asis
+@item @code{ESC C-f} (@code{show-footnotes})
+@kindex ESC C-f
+@findex show-footnotes
+@cindex footnotes, displaying
+Shows the footnotes (if any) associated with the current node in another
+window. You can have Info automatically display the footnotes
+associated with a node when the node is selected by setting the variable
+@code{automatic-footnotes}. @xref{Variables, , @code{automatic-footnotes}}.
+@end table
+
+@node Variables
+@chapter Manipulating Variables
+
+GNU Info contains several @dfn{variables} whose values are looked at by various
+Info commands. You can change the values of these variables, and thus
+change the behaviour of Info to more closely match your environment and
+info file reading manner.
+
+@table @asis
+@item @code{M-x set-variable}
+@cindex variables, setting
+@findex set-variable
+Reads the name of a variable, and the value for it, in the echo area and
+then sets the variable to that value. Completion is available when
+reading the variable name; often, completion is available when reading
+the value to give to the variable, but that depends on the variable
+itself. If a variable does @emph{not} supply multiple choices to
+complete over, it expects a numeric value.
+
+@item @code{M-x describe-variable}
+@cindex variables, describing
+@findex describe-variable
+Reads the name of a variable in the echo area and then displays a brief
+description of what the variable affects.
+@end table
+
+Here is a list of the variables that you can set in Info.
+
+@table @code
+@item automatic-footnotes
+@vindex automatic-footnotes
+When set to @code{On}, footnotes appear and disappear automatically.
+This variable is @code{On} by default. When a node is selected, a
+window containing the footnotes which appear in that node is created,
+and the footnotes are displayed within the new window. The window that
+Info creates to contain the footnotes is called @samp{*Footnotes*}. If
+a node is selected which contains no footnotes, and a @samp{*Footnotes*}
+window is on the screen, the @samp{*Footnotes*} window is deleted.
+Footnote windows created in this fashion are not automatically tiled so
+that they can use as little of the display as is possible.
+
+@item automatic-tiling
+@vindex automatic-tiling
+When set to @code{On}, creating or deleting a window resizes other
+windows. This variable is @code{Off} by default. Normally, typing
+@samp{C-x 2} divides the current window into two equal parts. When
+@code{automatic-tiling} is set to @code{On}, all of the windows are
+resized automatically, keeping an equal number of lines visible in each
+window. There are exceptions to the automatic tiling; specifically, the
+windows @samp{*Completions*} and @samp{*Footnotes*} are @emph{not}
+resized through automatic tiling; they remain their original size.
+
+@item visible-bell
+@vindex visible-bell
+When set to @code{On}, GNU Info attempts to flash the screen instead of
+ringing the bell. This variable is @code{Off} by default. Of course,
+Info can only flash the screen if the terminal allows it; in the case
+that the terminal does not allow it, the setting of this variable has no
+effect. However, you can make Info perform quietly by setting the
+@code{errors-ring-bell} variable to @code{Off}.
+
+@item errors-ring-bell
+@vindex errors-ring-bell
+When set to @code{On}, errors cause the bell to ring. The default
+setting of this variable is @code{On}.
+
+@item gc-compressed-files
+@vindex gc-compressed-files
+When set to @code{On}, Info garbage collects files which had to be
+uncompressed. The default value of this variable is @code{Off}.
+Whenever a node is visited in Info, the info file containing that node
+is read into core, and Info reads information about the tags and nodes
+contained in that file. Once the tags information is read by Info, it
+is never forgotten. However, the actual text of the nodes does not need
+to remain in core unless a particular info window needs it. For
+non-compressed files, the text of the nodes does not remain in core when
+it is no longer in use. But de-compressing a file can be a time
+consuming operation, and so Info tries hard not to do it twice.
+@code{gc-compressed-files} tells Info it is okay to garbage collect the
+text of the nodes of a file which was compressed on disk.
+
+@item show-index-match
+@vindex show-index-match
+When set to @code{On}, the portion of the matched search string is
+highlighted in the message which explains where the matched search
+string was found. The default value of this variable is @code{On}.
+When Info displays the location where an index match was found,
+(@pxref{Searching Commands, , @code{next-index-match}}), the portion of the
+string that you had typed is highlighted by displaying it in the inverse
+case from its surrounding characters.
+
+@item scroll-behaviour
+@vindex scroll-behaviour
+Controls what happens when forward scrolling is requested at the end of
+a node, or when backward scrolling is requested at the beginning of a
+node. The default value for this variable is @code{Continuous}. There
+are three possible values for this variable:
+
+@table @code
+@item Continuous
+Tries to get the first item in this node's menu, or failing that, the
+@samp{Next} node, or failing that, the @samp{Next} of the @samp{Up}.
+This behaviour is identical to using the @samp{]}
+(@code{global-next-node}) and @samp{[} (@code{global-prev-node})
+commands.
+
+@item Next Only
+Only tries to get the @samp{Next} node.
+
+@item Page Only
+Simply gives up, changing nothing. If @code{scroll-behaviour} is
+@code{Page Only}, no scrolling command can change the node that is being
+viewed.
+@end table
+
+@item scroll-step
+@vindex scroll-step
+The number of lines to scroll when the cursor moves out of the window.
+Scrolling happens automatically if the cursor has moved out of the
+visible portion of the node text when it is time to display. Usually
+the scrolling is done so as to put the cursor on the center line of the
+current window. However, if the variable @code{scroll-step} has a
+nonzero value, Info attempts to scroll the node text by that many lines;
+if that is enough to bring the cursor back into the window, that is what
+is done. The default value of this variable is 0, thus placing the
+cursor (and the text it is attached to) in the center of the window.
+Setting this variable to 1 causes a kind of "smooth scrolling" which
+some people prefer.
+
+@item ISO-Latin
+@cindex ISO Latin characters
+@vindex ISO-Latin
+When set to @code{On}, Info accepts and displays ISO Latin characters.
+By default, Info assumes an ASCII character set. @code{ISO-Latin} tells
+Info that it is running in an environment where the European standard
+character set is in use, and allows you to input such characters to
+Info, as well as display them.
+@end table
+
+@c The following node and its children are currently unfinished. Please feel
+@c free to finish it!
+
+@ifset NOTSET
+@node Info for Sys Admins
+@chapter Info for System Administrators
+
+This text describes some common ways of setting up an Info heierarchy
+from scratch, and details the various options that are available when
+installing Info. This text is designed for the person who is installing
+GNU Info on the system; although users may find the information present
+in this section interesting, none of it is vital to understanding how to
+use GNU Info.
+
+@menu
+* Setting the INFOPATH:: Where are my Info files kept?
+* Editing the DIR node:: What goes in `DIR', and why?
+* Storing Info files:: Alternate formats allow flexibilty in setups.
+* Using `localdir':: Building DIR on the fly.
+* Example setups:: Some common ways to origanize Info files.
+@end menu
+
+@node Setting the INFOPATH
+@section Setting the INFOPATH
+Where are my Info files kept?
+
+@node Editing the DIR node
+@section Editing the DIR node
+What goes in `DIR', and why?
+
+@node Storing Info files
+@section Storing Info files
+Alternate formats allow flexibilty in setups.
+
+@node Using `localdir'
+@section Using `localdir'
+Building DIR on the fly.
+
+@node Example setups
+@section Example setups
+Some common ways to origanize Info files.
+@end ifset
+
+@ifset STANDALONE
+@node GNU Info Global Index
+@appendix Global Index
+@printindex cp
+@end ifset
diff --git a/texinfo/info/variables.c b/texinfo/info/variables.c
new file mode 100644
index 00000000000..7798701c124
--- /dev/null
+++ b/texinfo/info/variables.c
@@ -0,0 +1,272 @@
+/* variables.c -- How to manipulate user visible variables in Info. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include "info.h"
+#include "variables.h"
+
+/* **************************************************************** */
+/* */
+/* User Visible Variables in Info */
+/* */
+/* **************************************************************** */
+
+/* Choices used by the completer when reading a zero/non-zero value for
+ a variable. */
+static char *on_off_choices[] = { "Off", "On", (char *)NULL };
+
+VARIABLE_ALIST info_variables[] = {
+ { "automatic-footnotes",
+ "When \"On\", footnotes appear and disappear automatically",
+ &auto_footnotes_p, (char **)on_off_choices },
+
+ { "automatic-tiling",
+ "When \"On\", creating or deleting a window resizes other windows",
+ &auto_tiling_p, (char **)on_off_choices },
+
+ { "visible-bell",
+ "When \"On\", flash the screen instead of ringing the bell",
+ &terminal_use_visible_bell_p, (char **)on_off_choices },
+
+ { "errors-ring-bell",
+ "When \"On\", errors cause the bell to ring",
+ &info_error_rings_bell_p, (char **)on_off_choices },
+
+ { "gc-compressed-files",
+ "When \"On\", Info garbage collects files which had to be uncompressed",
+ &gc_compressed_files, (char **)on_off_choices },
+ { "show-index-match",
+ "When \"On\", the portion of the matched search string is highlighted",
+ &show_index_match, (char **)on_off_choices },
+
+ { "scroll-behaviour",
+ "Controls what happens when scrolling is requested at the end of a node",
+ &info_scroll_behaviour, (char **)info_scroll_choices },
+
+ { "scroll-step",
+ "The number lines to scroll when the cursor moves out of the window",
+ &window_scroll_step, (char **)NULL },
+
+ { "ISO-Latin",
+ "When \"On\", Info accepts and displays ISO Latin characters",
+ &ISO_Latin_p, (char **)on_off_choices },
+
+ { (char *)NULL, (char *)NULL, (int *)NULL, (char **)NULL }
+};
+
+DECLARE_INFO_COMMAND (describe_variable, "Explain the use of a variable")
+{
+ VARIABLE_ALIST *var;
+ char *description;
+
+ /* Get the variable's name. */
+ var = read_variable_name ("Describe variable: ", window);
+
+ if (!var)
+ return;
+
+ description = (char *)xmalloc (20 + strlen (var->name) + strlen (var->doc));
+
+ if (var->choices)
+ sprintf (description, "%s (%s): %s.",
+ var->name, var->choices[*(var->value)], var->doc);
+ else
+ sprintf (description, "%s (%d): %s.", var->name, *(var->value), var->doc);
+
+ window_message_in_echo_area ("%s", description);
+ free (description);
+}
+
+DECLARE_INFO_COMMAND (set_variable, "Set the value of an Info variable")
+{
+ VARIABLE_ALIST *var;
+ char *line;
+
+ /* Get the variable's name and value. */
+ var = read_variable_name ("Set variable: ", window);
+
+ if (!var)
+ return;
+
+ /* Read a new value for this variable. */
+ {
+ char prompt[100];
+
+ if (!var->choices)
+ {
+ int potential_value;
+
+ if (info_explicit_arg || count != 1)
+ potential_value = count;
+ else
+ potential_value = *(var->value);
+
+ sprintf (prompt, "Set %s to value (%d): ",
+ var->name, potential_value);
+ line = info_read_in_echo_area (active_window, prompt);
+
+ /* If no error was printed, clear the echo area. */
+ if (!info_error_was_printed)
+ window_clear_echo_area ();
+
+ /* User aborted? */
+ if (!line)
+ return;
+
+ /* If the user specified a value, get that, otherwise, we are done. */
+ canonicalize_whitespace (line);
+ if (*line)
+ *(var->value) = atoi (line);
+ else
+ *(var->value) = potential_value;
+
+ free (line);
+ }
+ else
+ {
+ register int i;
+ REFERENCE **array = (REFERENCE **)NULL;
+ int array_index = 0;
+ int array_slots = 0;
+
+ for (i = 0; var->choices[i]; i++)
+ {
+ REFERENCE *entry;
+
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->label = strdup (var->choices[i]);
+ entry->nodename = (char *)NULL;
+ entry->filename = (char *)NULL;
+
+ add_pointer_to_array
+ (entry, array_index, array, array_slots, 10, REFERENCE *);
+ }
+
+ sprintf (prompt, "Set %s to value (%s): ",
+ var->name, var->choices[*(var->value)]);
+
+ /* Ask the completer to read a variable value for us. */
+ line = info_read_completing_in_echo_area (window, prompt, array);
+
+ info_free_references (array);
+
+ if (!echo_area_is_active)
+ window_clear_echo_area ();
+
+ /* User aborted? */
+ if (!line)
+ {
+ info_abort_key (active_window, 0, 0);
+ return;
+ }
+
+ /* User accepted default choice? If so, no change. */
+ if (!*line)
+ {
+ free (line);
+ return;
+ }
+
+ /* Find the choice in our list of choices. */
+ for (i = 0; var->choices[i]; i++)
+ if (strcmp (var->choices[i], line) == 0)
+ break;
+
+ if (var->choices[i])
+ *(var->value) = i;
+ }
+ }
+}
+
+/* Read the name of an Info variable in the echo area and return the
+ address of a VARIABLE_ALIST member. A return value of NULL indicates
+ that no variable could be read. */
+VARIABLE_ALIST *
+read_variable_name (prompt, window)
+ char *prompt;
+ WINDOW *window;
+{
+ register int i;
+ char *line;
+ REFERENCE **variables;
+
+ /* Get the completion array of variable names. */
+ variables = make_variable_completions_array ();
+
+ /* Ask the completer to read a variable for us. */
+ line =
+ info_read_completing_in_echo_area (window, prompt, variables);
+
+ info_free_references (variables);
+
+ if (!echo_area_is_active)
+ window_clear_echo_area ();
+
+ /* User aborted? */
+ if (!line)
+ {
+ info_abort_key (active_window, 0, 0);
+ return ((VARIABLE_ALIST *)NULL);
+ }
+
+ /* User accepted "default"? (There is none.) */
+ if (!*line)
+ {
+ free (line);
+ return ((VARIABLE_ALIST *)NULL);
+ }
+
+ /* Find the variable in our list of variables. */
+ for (i = 0; info_variables[i].name; i++)
+ if (strcmp (info_variables[i].name, line) == 0)
+ break;
+
+ if (!info_variables[i].name)
+ return ((VARIABLE_ALIST *)NULL);
+ else
+ return (&(info_variables[i]));
+}
+
+/* Make an array of REFERENCE which actually contains the names of the
+ variables available in Info. */
+REFERENCE **
+make_variable_completions_array ()
+{
+ register int i;
+ REFERENCE **array = (REFERENCE **)NULL;
+ int array_index = 0, array_slots = 0;
+
+ for (i = 0; info_variables[i].name; i++)
+ {
+ REFERENCE *entry;
+
+ entry = (REFERENCE *)xmalloc (sizeof (REFERENCE));
+ entry->label = strdup (info_variables[i].name);
+ entry->nodename = (char *)NULL;
+ entry->filename = (char *)NULL;
+
+ add_pointer_to_array
+ (entry, array_index, array, array_slots, 200, REFERENCE *);
+ }
+
+ return (array);
+}
diff --git a/texinfo/info/variables.h b/texinfo/info/variables.h
new file mode 100644
index 00000000000..85bde27737b
--- /dev/null
+++ b/texinfo/info/variables.h
@@ -0,0 +1,64 @@
+/* variables.h -- Description of user visible variables in Info. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_VARIABLES_H_)
+#define _VARIABLES_H_
+
+/* A variable (in the Info sense) is an integer value with a user-visible
+ name. You may supply an array of strings to complete over when the
+ variable is set; in that case, the variable is set to the index of the
+ string that the user chose. If you supply a null list, the user can
+ set the variable to a numeric value. */
+
+/* Structure describing a user visible variable. */
+typedef struct {
+ char *name; /* Polite name. */
+ char *doc; /* Documentation string. */
+ int *value; /* Address of value. */
+ char **choices; /* Array of strings or NULL if numeric only. */
+} VARIABLE_ALIST;
+
+/* Read the name of an Info variable in the echo area and return the
+ address of a VARIABLE_ALIST member. A return value of NULL indicates
+ that no variable could be read. */
+extern VARIABLE_ALIST *read_variable_name ();
+
+/* Make an array of REFERENCE which actually contains the names of the
+ variables available in Info. */
+extern REFERENCE **make_variable_completions_array ();
+
+/* Set the value of an info variable. */
+extern void set_variable ();
+
+/* The list of user-visible variables. */
+extern int auto_footnotes_p;
+extern int auto_tiling_p;
+extern int terminal_use_visible_bell_p;
+extern int info_error_rings_bell_p;
+extern int gc_compressed_files;
+extern int show_index_match;
+extern int info_scroll_behaviour;
+extern int window_scroll_step;
+extern int ISO_Latin_p;
+
+#endif /* _VARIABLES_H_ */
diff --git a/texinfo/info/window.c b/texinfo/info/window.c
new file mode 100644
index 00000000000..304e89c0c75
--- /dev/null
+++ b/texinfo/info/window.c
@@ -0,0 +1,1482 @@
+/* window.c -- Windows in Info. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include "nodes.h"
+#include "window.h"
+#include "display.h"
+#include "info-utils.h"
+#include "infomap.h"
+
+/* The window which describes the screen. */
+WINDOW *the_screen = (WINDOW *)NULL;
+
+/* The window which describes the echo area. */
+WINDOW *the_echo_area = (WINDOW *)NULL;
+
+/* The list of windows in Info. */
+WINDOW *windows = (WINDOW *)NULL;
+
+/* Pointer to the active window in WINDOW_LIST. */
+WINDOW *active_window = (WINDOW *)NULL;
+
+/* The size of the echo area in Info. It never changes, irregardless of the
+ size of the screen. */
+#define ECHO_AREA_HEIGHT 1
+
+/* Macro returns the amount of space that the echo area truly requires relative
+ to the entire screen. */
+#define echo_area_required (1 + the_echo_area->height)
+
+/* Initalize the window system by creating THE_SCREEN and THE_ECHO_AREA.
+ Create the first window ever.
+ You pass the dimensions of the total screen size. */
+void
+window_initialize_windows (width, height)
+ int width, height;
+{
+ the_screen = (WINDOW *)xmalloc (sizeof (WINDOW));
+ the_echo_area = (WINDOW *)xmalloc (sizeof (WINDOW));
+ windows = (WINDOW *)xmalloc (sizeof (WINDOW));
+ active_window = windows;
+
+ zero_mem (the_screen, sizeof (WINDOW));
+ zero_mem (the_echo_area, sizeof (WINDOW));
+ zero_mem (active_window, sizeof (WINDOW));
+
+ /* None of these windows has a goal column yet. */
+ the_echo_area->goal_column = -1;
+ active_window->goal_column = -1;
+ the_screen->goal_column = -1;
+
+ /* The active and echo_area windows are visible.
+ The echo_area is permanent.
+ The screen is permanent. */
+ active_window->flags = W_WindowVisible;
+ the_echo_area->flags = W_WindowIsPerm | W_InhibitMode | W_WindowVisible;
+ the_screen->flags = W_WindowIsPerm;
+
+ /* The height of the echo area never changes. It is statically set right
+ here, and it must be at least 1 line for display. The size of the
+ initial window cannot be the same size as the screen, since the screen
+ includes the echo area. So, we make the height of the initial window
+ equal to the screen's displayable region minus the height of the echo
+ area. */
+ the_echo_area->height = ECHO_AREA_HEIGHT;
+ active_window->height = the_screen->height - 1 - the_echo_area->height;
+ window_new_screen_size (width, height, (VFunction *)NULL);
+
+ /* The echo area uses a different keymap than normal info windows. */
+ the_echo_area->keymap = echo_area_keymap;
+ active_window->keymap = info_keymap;
+}
+
+/* Given that the size of the screen has changed to WIDTH and HEIGHT
+ from whatever it was before (found in the_screen->height, ->width),
+ change the size (and possibly location) of each window in the screen.
+ If a window would become too small, call the function DELETER on it,
+ after deleting the window from our chain of windows. If DELETER is NULL,
+ nothing extra is done. The last window can never be deleted, but it can
+ become invisible. */
+
+/* If non-null, a function to call with WINDOW as argument when the function
+ window_new_screen_size () has deleted WINDOW. */
+VFunction *window_deletion_notifier = (VFunction *)NULL;
+
+void
+window_new_screen_size (width, height)
+ int width, height;
+{
+ register WINDOW *win;
+ int delta_height, delta_each, delta_leftover;
+ int numwins;
+
+ /* If no change, do nothing. */
+ if (width == the_screen->width && height == the_screen->height)
+ return;
+
+ /* If the new window height is too small, make it be zero. */
+ if (height < (WINDOW_MIN_SIZE + the_echo_area->height))
+ height = 0;
+ if (width < 0)
+ width = 0;
+
+ /* Find out how many windows will change. */
+ for (numwins = 0, win = windows; win; win = win->next, numwins++);
+
+ /* See if some windows will need to be deleted. This is the case if
+ the screen is getting smaller, and the available space divided by
+ the number of windows is less than WINDOW_MIN_SIZE. In that case,
+ delete some windows and try again until there is either enough
+ space to divy up among the windows, or until there is only one
+ window left. */
+ while ((height - echo_area_required) / numwins <= WINDOW_MIN_SIZE)
+ {
+ /* If only one window, make the size of it be zero, and return
+ immediately. */
+ if (!windows->next)
+ {
+ windows->height = 0;
+ maybe_free (windows->line_starts);
+ windows->line_starts = (char **)NULL;
+ windows->line_count = 0;
+ break;
+ }
+
+ /* If we have some temporary windows, delete one of them. */
+ for (win = windows; win; win = win->next)
+ if (win->flags & W_TempWindow)
+ break;
+
+ /* Otherwise, delete the first window, and try again. */
+ if (!win)
+ win = windows;
+
+ if (window_deletion_notifier)
+ (*window_deletion_notifier) (win);
+
+ window_delete_window (win);
+ numwins--;
+ }
+
+ /* The screen has changed height and width. */
+ delta_height = height - the_screen->height; /* This is how much. */
+ the_screen->height = height; /* This is the new height. */
+ the_screen->width = width; /* This is the new width. */
+
+ /* Set the start of the echo area. */
+ the_echo_area->first_row = height - the_echo_area->height;
+ the_echo_area->width = width;
+
+ /* Check to see if the screen can really be changed this way. */
+ if ((!windows->next) && ((windows->height == 0) && (delta_height < 0)))
+ return;
+
+ /* Divide the change in height among the available windows. */
+ delta_each = delta_height / numwins;
+ delta_leftover = delta_height - (delta_each * numwins);
+
+ /* Change the height of each window in the chain by delta_each. Change
+ the height of the last window in the chain by delta_each and by the
+ leftover amount of change. Change the width of each window to be
+ WIDTH. */
+ for (win = windows; win; win = win->next)
+ {
+ if ((win->width != width) && ((win->flags & W_InhibitMode) == 0))
+ {
+ win->width = width;
+ maybe_free (win->modeline);
+ win->modeline = (char *)xmalloc (1 + width);
+ }
+
+ win->height += delta_each;
+
+ /* If the previous height of this window was zero, it was the only
+ window, and it was not visible. Thus we need to compensate for
+ the echo_area. */
+ if (win->height == delta_each)
+ win->height -= (1 + the_echo_area->height);
+
+ /* If this is not the first window in the chain, then change the
+ first row of it. We cannot just add delta_each to the first row,
+ since this window's first row is the sum of the collective increases
+ that have gone before it. So we just add one to the location of the
+ previous window's modeline. */
+ if (win->prev)
+ win->first_row = (win->prev->first_row + win->prev->height) + 1;
+
+ /* The last window in the chain gets the extra space (or shrinkage). */
+ if (!win->next)
+ win->height += delta_leftover;
+
+ if (win->node)
+ recalculate_line_starts (win);
+
+ win->flags |= W_UpdateWindow;
+ }
+
+ /* If the screen got smaller, check over the windows just shrunk to
+ keep them within bounds. Some of the windows may have gotten smaller
+ than WINDOW_MIN_HEIGHT in which case some of the other windows are
+ larger than the available display space in the screen. Because of our
+ intial test above, we know that there is enough space for all of the
+ windows. */
+ if ((delta_each < 0) && ((windows->height != 0) && windows->next))
+ {
+ int avail;
+
+ avail = the_screen->height - (numwins + the_echo_area->height);
+ win = windows;
+
+ while (win)
+ {
+ if ((win->height < WINDOW_MIN_HEIGHT) ||
+ (win->height > avail))
+ {
+ WINDOW *lastwin;
+
+ /* Split the space among the available windows. */
+ delta_each = avail / numwins;
+ delta_leftover = avail - (delta_each * numwins);
+
+ for (win = windows; win; win = win->next)
+ {
+ lastwin = win;
+ if (win->prev)
+ win->first_row =
+ (win->prev->first_row + win->prev->height) + 1;
+ win->height = delta_each;
+ }
+
+ /* Give the leftover space (if any) to the last window. */
+ lastwin->height += delta_leftover;
+ break;
+ }
+ else
+ win= win->next;
+ }
+ }
+}
+
+/* Make a new window showing NODE, and return that window structure.
+ If NODE is passed as NULL, then show the node showing in the active
+ window. If the window could not be made return a NULL pointer. The
+ active window is not changed.*/
+WINDOW *
+window_make_window (node)
+ NODE *node;
+{
+ WINDOW *window;
+
+ if (!node)
+ node = active_window->node;
+
+ /* If there isn't enough room to make another window, return now. */
+ if ((active_window->height / 2) < WINDOW_MIN_SIZE)
+ return ((WINDOW *)NULL);
+
+ /* Make and initialize the new window.
+ The fudging about with -1 and +1 is because the following window in the
+ chain cannot start at window->height, since that is where the modeline
+ for the previous window is displayed. The inverse adjustment is made
+ in window_delete_window (). */
+ window = (WINDOW *)xmalloc (sizeof (WINDOW));
+ window->width = the_screen->width;
+ window->height = (active_window->height / 2) - 1;
+#if defined (SPLIT_BEFORE_ACTIVE)
+ window->first_row = active_window->first_row;
+#else
+ window->first_row = active_window->first_row +
+ (active_window->height - window->height);
+#endif
+ window->keymap = info_keymap;
+ window->goal_column = -1;
+ window->modeline = (char *)xmalloc (1 + window->width);
+ window->line_starts = (char **)NULL;
+ window->flags = W_UpdateWindow | W_WindowVisible;
+ window_set_node_of_window (window, node);
+
+ /* Adjust the height of the old active window. */
+ active_window->height -= (window->height + 1);
+#if defined (SPLIT_BEFORE_ACTIVE)
+ active_window->first_row += (window->height + 1);
+#endif
+ active_window->flags |= W_UpdateWindow;
+
+ /* Readjust the new and old windows so that their modelines and contents
+ will be displayed correctly. */
+#if defined (NOTDEF)
+ /* We don't have to do this for WINDOW since window_set_node_of_window ()
+ already did. */
+ window_adjust_pagetop (window);
+ window_make_modeline (window);
+#endif /* NOTDEF */
+
+ /* We do have to readjust the existing active window. */
+ window_adjust_pagetop (active_window);
+ window_make_modeline (active_window);
+
+#if defined (SPLIT_BEFORE_ACTIVE)
+ /* This window is just before the active one. The active window gets
+ bumped down one. The active window is not changed. */
+ window->next = active_window;
+
+ window->prev = active_window->prev;
+ active_window->prev = window;
+
+ if (window->prev)
+ window->prev->next = window;
+ else
+ windows = window;
+#else
+ /* This window is just after the active one. Which window is active is
+ not changed. */
+ window->prev = active_window;
+ window->next = active_window->next;
+ active_window->next = window;
+ if (window->next)
+ window->next->prev = window;
+#endif /* !SPLIT_BEFORE_ACTIVE */
+ return (window);
+}
+
+/* These useful macros make it possible to read the code in
+ window_change_window_height (). */
+#define grow_me_shrinking_next(me, next, diff) \
+ do { \
+ me->height += diff; \
+ next->height -= diff; \
+ next->first_row += diff; \
+ window_adjust_pagetop (next); \
+ } while (0)
+
+#define grow_me_shrinking_prev(me, prev, diff) \
+ do { \
+ me->height += diff; \
+ prev->height -= diff; \
+ me->first_row -=diff; \
+ window_adjust_pagetop (prev); \
+ } while (0)
+
+#define shrink_me_growing_next(me, next, diff) \
+ do { \
+ me->height -= diff; \
+ next->height += diff; \
+ next->first_row -= diff; \
+ window_adjust_pagetop (next); \
+ } while (0)
+
+#define shrink_me_growing_prev(me, prev, diff) \
+ do { \
+ me->height -= diff; \
+ prev->height += diff; \
+ me->first_row += diff; \
+ window_adjust_pagetop (prev); \
+ } while (0)
+
+/* Change the height of WINDOW by AMOUNT. This also automagically adjusts
+ the previous and next windows in the chain. If there is only one user
+ window, then no change takes place. */
+void
+window_change_window_height (window, amount)
+ WINDOW *window;
+ int amount;
+{
+ register WINDOW *win, *prev, *next;
+
+ /* If there is only one window, or if the amount of change is zero,
+ return immediately. */
+ if (!windows->next || amount == 0)
+ return;
+
+ /* Find this window in our chain. */
+ for (win = windows; win; win = win->next)
+ if (win == window)
+ break;
+
+ /* If the window is isolated (i.e., doesn't appear in our window list,
+ then quit now. */
+ if (!win)
+ return;
+
+ /* Change the height of this window by AMOUNT, if that is possible.
+ It can be impossible if there isn't enough available room on the
+ screen, or if the resultant window would be too small. */
+
+ prev = window->prev;
+ next = window->next;
+
+ /* WINDOW decreasing in size? */
+ if (amount < 0)
+ {
+ int abs_amount = -amount; /* It is easier to deal with this way. */
+
+ /* If the resultant window would be too small, stop here. */
+ if ((window->height - abs_amount) < WINDOW_MIN_HEIGHT)
+ return;
+
+ /* If we have two neighboring windows, choose the smaller one to get
+ larger. */
+ if (next && prev)
+ {
+ if (prev->height < next->height)
+ shrink_me_growing_prev (window, prev, abs_amount);
+ else
+ shrink_me_growing_next (window, next, abs_amount);
+ }
+ else if (next)
+ shrink_me_growing_next (window, next, abs_amount);
+ else
+ shrink_me_growing_prev (window, prev, abs_amount);
+ }
+
+ /* WINDOW increasing in size? */
+ if (amount > 0)
+ {
+ int total_avail, next_avail = 0, prev_avail = 0;
+
+ if (next)
+ next_avail = next->height - WINDOW_MIN_SIZE;
+
+ if (prev)
+ prev_avail = prev->height - WINDOW_MIN_SIZE;
+
+ total_avail = next_avail + prev_avail;
+
+ /* If there isn't enough space available to grow this window, give up. */
+ if (amount > total_avail)
+ return;
+
+ /* If there aren't two neighboring windows, or if one of the neighbors
+ is larger than the other one by at least AMOUNT, grow that one. */
+ if ((next && !prev) || ((next_avail - amount) >= prev_avail))
+ grow_me_shrinking_next (window, next, amount);
+ else if ((prev && !next) || ((prev_avail - amount) >= next_avail))
+ grow_me_shrinking_prev (window, prev, amount);
+ else
+ {
+ int change;
+
+ /* This window has two neighbors. They both must be shrunk in to
+ make enough space for WINDOW to grow. Make them both the same
+ size. */
+ if (prev_avail > next_avail)
+ {
+ change = prev_avail - next_avail;
+ grow_me_shrinking_prev (window, prev, change);
+ amount -= change;
+ }
+ else
+ {
+ change = next_avail - prev_avail;
+ grow_me_shrinking_next (window, next, change);
+ amount -= change;
+ }
+
+ /* Both neighbors are the same size. Split the difference in
+ AMOUNT between them. */
+ while (amount)
+ {
+ window->height++;
+ amount--;
+
+ /* Odd numbers grow next, even grow prev. */
+ if (amount & 1)
+ {
+ prev->height--;
+ window->first_row--;
+ }
+ else
+ {
+ next->height--;
+ next->first_row++;
+ }
+ }
+ window_adjust_pagetop (prev);
+ window_adjust_pagetop (next);
+ }
+ }
+ if (prev)
+ prev->flags |= W_UpdateWindow;
+
+ if (next)
+ next->flags |= W_UpdateWindow;
+
+ window->flags |= W_UpdateWindow;
+ window_adjust_pagetop (window);
+}
+
+/* Tile all of the windows currently displayed in the global variable
+ WINDOWS. If argument STYLE is TILE_INTERNALS, tile windows displaying
+ internal nodes as well, otherwise do not change the height of such
+ windows. */
+void
+window_tile_windows (style)
+ int style;
+{
+ WINDOW *win, *last_adjusted;
+ int numwins, avail, per_win_height, leftover;
+ int do_internals;
+
+ numwins = avail = 0;
+ do_internals = (style == TILE_INTERNALS);
+
+ for (win = windows; win; win = win->next)
+ if (do_internals || !win->node ||
+ (win->node->flags & N_IsInternal) == 0)
+ {
+ avail += win->height;
+ numwins++;
+ }
+
+ if (numwins <= 1 || !the_screen->height)
+ return;
+
+ /* Find the size for each window. Divide the size of the usable portion
+ of the screen by the number of windows. */
+ per_win_height = avail / numwins;
+ leftover = avail - (per_win_height * numwins);
+
+ last_adjusted = (WINDOW *)NULL;
+ for (win = windows; win; win = win->next)
+ {
+ if (do_internals || !win->node ||
+ (win->node->flags & N_IsInternal) == 0)
+ {
+ last_adjusted = win;
+ win->height = per_win_height;
+ }
+ }
+
+ if (last_adjusted)
+ last_adjusted->height += leftover;
+
+ /* Readjust the first_row of every window in the chain. */
+ for (win = windows; win; win = win->next)
+ {
+ if (win->prev)
+ win->first_row = win->prev->first_row + win->prev->height + 1;
+
+ window_adjust_pagetop (win);
+ win->flags |= W_UpdateWindow;
+ }
+}
+
+/* Toggle the state of line wrapping in WINDOW. This can do a bit of fancy
+ redisplay. */
+void
+window_toggle_wrap (window)
+ WINDOW *window;
+{
+ if (window->flags & W_NoWrap)
+ window->flags &= ~W_NoWrap;
+ else
+ window->flags |= W_NoWrap;
+
+ if (window != the_echo_area)
+ {
+ char **old_starts;
+ int old_lines, old_pagetop;
+
+ old_starts = window->line_starts;
+ old_lines = window->line_count;
+ old_pagetop = window->pagetop;
+
+ calculate_line_starts (window);
+
+ /* Make sure that point appears within this window. */
+ window_adjust_pagetop (window);
+
+ /* If the pagetop hasn't changed maybe we can do some scrolling now
+ to speed up the display. Many of the line starts will be the same,
+ so scrolling here is a very good optimization.*/
+ if (old_pagetop == window->pagetop)
+ display_scroll_line_starts
+ (window, old_pagetop, old_starts, old_lines);
+ maybe_free (old_starts);
+ }
+ window->flags |= W_UpdateWindow;
+}
+
+/* Set WINDOW to display NODE. */
+void
+window_set_node_of_window (window, node)
+ WINDOW *window;
+ NODE *node;
+{
+ window->node = node;
+ window->pagetop = 0;
+ window->point = 0;
+ recalculate_line_starts (window);
+ window->flags |= W_UpdateWindow;
+ window_adjust_pagetop (window);
+ window_make_modeline (window);
+}
+
+/* Delete WINDOW from the list of known windows. If this window was the
+ active window, make the next window in the chain be the active window.
+ If the active window is the next or previous window, choose that window
+ as the recipient of the extra space. Otherwise, prefer the next window. */
+void
+window_delete_window (window)
+ WINDOW *window;
+{
+ WINDOW *next, *prev, *window_to_fix;
+
+ next = window->next;
+ prev = window->prev;
+
+ /* You cannot delete the only window or a permanent window. */
+ if ((!next && !prev) || (window->flags & W_WindowIsPerm))
+ return;
+
+ if (next)
+ next->prev = prev;
+
+ if (!prev)
+ windows = next;
+ else
+ prev->next = next;
+
+ if (window->line_starts)
+ free (window->line_starts);
+
+ if (window->modeline)
+ free (window->modeline);
+
+ if (window == active_window)
+ {
+ /* If there isn't a next window, then there must be a previous one,
+ since we cannot delete the last window. If there is a next window,
+ prefer to use that as the active window. */
+ if (next)
+ active_window = next;
+ else
+ active_window = prev;
+ }
+
+ if (next && active_window == next)
+ window_to_fix = next;
+ else if (prev && active_window == prev)
+ window_to_fix = prev;
+ else if (next)
+ window_to_fix = next;
+ else if (prev)
+ window_to_fix = prev;
+ else
+ window_to_fix = windows;
+
+ if (window_to_fix->first_row > window->first_row)
+ {
+ int diff;
+
+ /* Try to adjust the visible part of the node so that as little
+ text as possible has to move. */
+ diff = window_to_fix->first_row - window->first_row;
+ window_to_fix->first_row = window->first_row;
+
+ window_to_fix->pagetop -= diff;
+ if (window_to_fix->pagetop < 0)
+ window_to_fix->pagetop = 0;
+ }
+
+ /* The `+ 1' is to offset the difference between the first_row locations.
+ See the code in window_make_window (). */
+ window_to_fix->height += window->height + 1;
+ window_to_fix->flags |= W_UpdateWindow;
+
+ free (window);
+}
+
+/* For every window in CHAIN, set the flags member to have FLAG set. */
+void
+window_mark_chain (chain, flag)
+ WINDOW *chain;
+ int flag;
+{
+ register WINDOW *win;
+
+ for (win = chain; win; win = win->next)
+ win->flags |= flag;
+}
+
+/* For every window in CHAIN, clear the flags member of FLAG. */
+void
+window_unmark_chain (chain, flag)
+ WINDOW *chain;
+ int flag;
+{
+ register WINDOW *win;
+
+ for (win = chain; win; win = win->next)
+ win->flags &= ~flag;
+}
+
+/* Return the number of characters it takes to display CHARACTER on the
+ screen at HPOS. */
+int
+character_width (character, hpos)
+ int character, hpos;
+{
+ int printable_limit = 127;
+ int width = 1;
+
+ if (ISO_Latin_p)
+ printable_limit = 160;
+
+ if (character > printable_limit)
+ width = 3;
+ else if (iscntrl (character))
+ {
+ switch (character)
+ {
+ case '\r':
+ case '\n':
+ width = the_screen->width - hpos;
+ break;
+ case '\t':
+ width = ((hpos + 8) & 0xf8) - hpos;
+ break;
+ default:
+ width = 2;
+ }
+ }
+ else if (character == DEL)
+ width = 2;
+
+ return (width);
+}
+
+/* Return the number of characters it takes to display STRING on the screen
+ at HPOS. */
+int
+string_width (string, hpos)
+ char *string;
+ int hpos;
+{
+ register int i, width, this_char_width;
+
+ for (width = 0, i = 0; string[i]; i++)
+ {
+ this_char_width = character_width (string[i], hpos);
+ width += this_char_width;
+ hpos += this_char_width;
+ }
+ return (width);
+}
+
+/* Quickly guess the approximate number of lines to that NODE would
+ take to display. This really only counts carriage returns. */
+int
+window_physical_lines (node)
+ NODE *node;
+{
+ register int i, lines;
+ char *contents;
+
+ if (!node)
+ return (0);
+
+ contents = node->contents;
+ for (i = 0, lines = 1; i < node->nodelen; i++)
+ if (contents[i] == '\n')
+ lines++;
+
+ return (lines);
+}
+
+/* Calculate a list of line starts for the node belonging to WINDOW. The line
+ starts are pointers to the actual text within WINDOW->NODE. */
+void
+calculate_line_starts (window)
+ WINDOW *window;
+{
+ register int i, hpos;
+ char **line_starts = (char **)NULL;
+ int line_starts_index = 0, line_starts_slots = 0;
+ int bump_index;
+ NODE *node;
+
+ window->line_starts = (char **)NULL;
+ window->line_count = 0;
+ node = window->node;
+
+ if (!node)
+ return;
+
+ /* Grovel the node starting at the top, and for each line calculate the
+ width of the characters appearing in that line. Add each line start
+ to our array. */
+ i = 0;
+ hpos = 0;
+ bump_index = 0;
+
+ while (i < node->nodelen)
+ {
+ char *line = node->contents + i;
+ unsigned int cwidth, c;
+
+ add_pointer_to_array (line, line_starts_index, line_starts,
+ line_starts_slots, 100, char *);
+ if (bump_index)
+ {
+ i++;
+ bump_index = 0;
+ }
+
+ while (1)
+ {
+ c = node->contents[i];
+ cwidth = character_width (c, hpos);
+
+ /* If this character fits within this line, just do the next one. */
+ if ((hpos + cwidth) < window->width)
+ {
+ i++;
+ hpos += cwidth;
+ continue;
+ }
+ else
+ {
+ /* If this character would position the cursor at the start of
+ the next printed screen line, then do the next line. */
+ if (c == '\n' || c == '\r' || c == '\t')
+ {
+ i++;
+ hpos = 0;
+ break;
+ }
+ else
+ {
+ /* This character passes the window width border. Postion
+ the cursor after the printed character, but remember this
+ line start as where this character is. A bit tricky. */
+
+ /* If this window doesn't wrap lines, proceed to the next
+ physical line here. */
+ if (window->flags & W_NoWrap)
+ {
+ hpos = 0;
+ while (i < node->nodelen && node->contents[i] != '\n')
+ i++;
+
+ if (node->contents[i] == '\n')
+ i++;
+ }
+ else
+ {
+ hpos = the_screen->width - hpos;
+ bump_index++;
+ }
+ break;
+ }
+ }
+ }
+ }
+ window->line_starts = line_starts;
+ window->line_count = line_starts_index;
+}
+
+/* Given WINDOW, recalculate the line starts for the node it displays. */
+void
+recalculate_line_starts (window)
+ WINDOW *window;
+{
+ maybe_free (window->line_starts);
+ calculate_line_starts (window);
+}
+
+/* Global variable control redisplay of scrolled windows. If non-zero, it
+ is the desired number of lines to scroll the window in order to make
+ point visible. A user might set this to 1 for smooth scrolling. If
+ set to zero, the line containing point is centered within the window. */
+int window_scroll_step = 0;
+
+/* Adjust the pagetop of WINDOW such that the cursor point will be visible. */
+void
+window_adjust_pagetop (window)
+ WINDOW *window;
+{
+ register int line = 0;
+ char *contents;
+
+ if (!window->node)
+ return;
+
+ contents = window->node->contents;
+
+ /* Find the first printed line start which is after WINDOW->point. */
+ for (line = 0; line < window->line_count; line++)
+ {
+ char *line_start;
+
+ line_start = window->line_starts[line];
+
+ if ((line_start - contents) > window->point)
+ break;
+ }
+
+ /* The line index preceding the line start which is past point is the
+ one containing point. */
+ line--;
+
+ /* If this line appears in the current displayable page, do nothing.
+ Otherwise, adjust the top of the page to make this line visible. */
+ if ((line < window->pagetop) ||
+ (line - window->pagetop > (window->height - 1)))
+ {
+ /* The user-settable variable "scroll-step" is used to attempt
+ to make point visible, iff it is non-zero. If that variable
+ is zero, then the line containing point is centered within
+ the window. */
+ if (window_scroll_step < window->height)
+ {
+ if ((line < window->pagetop) &&
+ ((window->pagetop - window_scroll_step) <= line))
+ window->pagetop -= window_scroll_step;
+ else if ((line - window->pagetop > (window->height - 1)) &&
+ ((line - (window->pagetop + window_scroll_step)
+ < window->height)))
+ window->pagetop += window_scroll_step;
+ else
+ window->pagetop = line - ((window->height - 1) / 2);
+ }
+ else
+ window->pagetop = line - ((window->height - 1) / 2);
+
+ if (window->pagetop < 0)
+ window->pagetop = 0;
+ window->flags |= W_UpdateWindow;
+ }
+}
+
+/* Return the index of the line containing point. */
+int
+window_line_of_point (window)
+ WINDOW *window;
+{
+ register int i, start = 0;
+
+ /* Try to optimize. Check to see if point is past the pagetop for
+ this window, and if so, start searching forward from there. */
+ if ((window->pagetop > -1 && window->pagetop < window->line_count) &&
+ (window->line_starts[window->pagetop] - window->node->contents)
+ <= window->point)
+ start = window->pagetop;
+
+ for (i = start; i < window->line_count; i++)
+ {
+ if ((window->line_starts[i] - window->node->contents) > window->point)
+ break;
+ }
+
+ return (i - 1);
+}
+
+/* Get and return the goal column for this window. */
+int
+window_get_goal_column (window)
+ WINDOW *window;
+{
+ if (!window->node)
+ return (-1);
+
+ if (window->goal_column != -1)
+ return (window->goal_column);
+
+ /* Okay, do the work. Find the printed offset of the cursor
+ in this window. */
+ return (window_get_cursor_column (window));
+}
+
+/* Get and return the printed column offset of the cursor in this window. */
+int
+window_get_cursor_column (window)
+ WINDOW *window;
+{
+ int i, hpos, end;
+ char *line;
+
+ i = window_line_of_point (window);
+
+ if (i < 0)
+ return (-1);
+
+ line = window->line_starts[i];
+ end = window->point - (line - window->node->contents);
+
+ for (hpos = 0, i = 0; i < end; i++)
+ hpos += character_width (line[i], hpos);
+
+ return (hpos);
+}
+
+/* Count the number of characters in LINE that precede the printed column
+ offset of GOAL. */
+int
+window_chars_to_goal (line, goal)
+ char *line;
+ int goal;
+{
+ register int i, check, hpos;
+
+ for (hpos = 0, i = 0; line[i] != '\n'; i++)
+ {
+
+ check = hpos + character_width (line[i], hpos);
+
+ if (check > goal)
+ break;
+
+ hpos = check;
+ }
+ return (i);
+}
+
+/* Create a modeline for WINDOW, and store it in window->modeline. */
+void
+window_make_modeline (window)
+ WINDOW *window;
+{
+ register int i;
+ char *modeline;
+ char location_indicator[4];
+ int lines_remaining;
+
+ /* Only make modelines for those windows which have one. */
+ if (window->flags & W_InhibitMode)
+ return;
+
+ /* Find the number of lines actually displayed in this window. */
+ lines_remaining = window->line_count - window->pagetop;
+
+ if (window->pagetop == 0)
+ {
+ if (lines_remaining <= window->height)
+ strcpy (location_indicator, "All");
+ else
+ strcpy (location_indicator, "Top");
+ }
+ else
+ {
+ if (lines_remaining <= window->height)
+ strcpy (location_indicator, "Bot");
+ else
+ {
+ float pt, lc;
+ int percentage;
+
+ pt = (float)window->pagetop;
+ lc = (float)window->line_count;
+
+ percentage = 100 * (pt / lc);
+
+ sprintf (location_indicator, "%2d%%", percentage);
+ }
+ }
+
+ /* Calculate the maximum size of the information to stick in MODELINE. */
+ {
+ int modeline_len = 0;
+ char *parent = (char *)NULL, *filename = "*no file*";
+ char *nodename = "*no node*";
+ char *update_message = (char *)NULL;
+ NODE *node = window->node;
+
+ if (node)
+ {
+ if (node->nodename)
+ nodename = node->nodename;
+
+ if (node->parent)
+ {
+ parent = filename_non_directory (node->parent);
+ modeline_len += strlen ("Subfile: ") + strlen (node->filename);
+ }
+
+ if (node->filename)
+ filename = filename_non_directory (node->filename);
+
+ if (node->flags & N_UpdateTags)
+ update_message = "--*** Tags out of Date ***";
+ }
+
+ if (update_message)
+ modeline_len += strlen (update_message);
+ modeline_len += strlen (filename);
+ modeline_len += strlen (nodename);
+ modeline_len += 4; /* strlen (location_indicator). */
+
+ /* 10 for the decimal representation of the number of lines in this
+ node, and the remainder of the text that can appear in the line. */
+ modeline_len += 10 + strlen ("-----Info: (), lines ----, ");
+ modeline_len += window->width;
+
+ modeline = (char *)xmalloc (1 + modeline_len);
+
+ /* Special internal windows have no filename. */
+ if (!parent && !*filename)
+ sprintf (modeline, "-%s---Info: %s, %d lines --%s--",
+ (window->flags & W_NoWrap) ? "$" : "-",
+ nodename, window->line_count, location_indicator);
+ else
+ sprintf (modeline, "-%s%s-Info: (%s)%s, %d lines --%s--",
+ (window->flags & W_NoWrap) ? "$" : "-",
+ (node && (node->flags & N_IsCompressed)) ? "zz" : "--",
+ parent ? parent : filename,
+ nodename, window->line_count, location_indicator);
+
+ if (parent)
+ sprintf (modeline + strlen (modeline), " Subfile: %s", filename);
+
+ if (update_message)
+ sprintf (modeline + strlen (modeline), "%s", update_message);
+
+ i = strlen (modeline);
+
+ if (i >= window->width)
+ modeline[window->width] = '\0';
+ else
+ {
+ while (i < window->width)
+ modeline[i++] = '-';
+ modeline[i] = '\0';
+ }
+
+ strcpy (window->modeline, modeline);
+ free (modeline);
+ }
+}
+
+/* Make WINDOW start displaying at PERCENT percentage of its node. */
+void
+window_goto_percentage (window, percent)
+ WINDOW *window;
+ int percent;
+{
+ int desired_line;
+
+ if (!percent)
+ desired_line = 0;
+ else
+ desired_line =
+ (int) ((float)window->line_count * ((float)percent / 100.0));
+
+ window->pagetop = desired_line;
+ window->point =
+ window->line_starts[window->pagetop] - window->node->contents;
+ window->flags |= W_UpdateWindow;
+ window_make_modeline (window);
+}
+
+/* Get the state of WINDOW, and save it in STATE. */
+void
+window_get_state (window, state)
+ WINDOW *window;
+ WINDOW_STATE *state;
+{
+ state->node = window->node;
+ state->pagetop = window->pagetop;
+ state->point = window->point;
+}
+
+/* Set the node, pagetop, and point of WINDOW. */
+void
+window_set_state (window, state)
+ WINDOW *window;
+ WINDOW_STATE *state;
+{
+ if (window->node != state->node)
+ window_set_node_of_window (window, state->node);
+ window->pagetop = state->pagetop;
+ window->point = state->point;
+}
+
+
+/* **************************************************************** */
+/* */
+/* Manipulating Home-Made Nodes */
+/* */
+/* **************************************************************** */
+
+/* A place to buffer echo area messages. */
+static NODE *echo_area_node = (NODE *)NULL;
+
+/* Make the node of the_echo_area be an empty one. */
+static void
+free_echo_area ()
+{
+ if (echo_area_node)
+ {
+ maybe_free (echo_area_node->contents);
+ free (echo_area_node);
+ }
+
+ echo_area_node = (NODE *)NULL;
+ window_set_node_of_window (the_echo_area, echo_area_node);
+}
+
+/* Clear the echo area, removing any message that is already present.
+ The echo area is cleared immediately. */
+void
+window_clear_echo_area ()
+{
+ free_echo_area ();
+ display_update_one_window (the_echo_area);
+}
+
+/* Make a message appear in the echo area, built from FORMAT, ARG1 and ARG2.
+ The arguments are treated similar to printf () arguments, but not all of
+ printf () hair is present. The message appears immediately. If there was
+ already a message appearing in the echo area, it is removed. */
+void
+window_message_in_echo_area (format, arg1, arg2)
+ char *format;
+ void *arg1, *arg2;
+{
+ free_echo_area ();
+ echo_area_node = build_message_node (format, arg1, arg2);
+ window_set_node_of_window (the_echo_area, echo_area_node);
+ display_update_one_window (the_echo_area);
+}
+
+/* Place a temporary message in the echo area built from FORMAT, ARG1
+ and ARG2. The message appears immediately, but does not destroy
+ any existing message. A future call to unmessage_in_echo_area ()
+ restores the old contents. */
+static NODE **old_echo_area_nodes = (NODE **)NULL;
+static int old_echo_area_nodes_index = 0;
+static int old_echo_area_nodes_slots = 0;
+
+void
+message_in_echo_area (format, arg1, arg2)
+ char *format;
+ void *arg1, *arg2;
+{
+ if (echo_area_node)
+ {
+ add_pointer_to_array (echo_area_node, old_echo_area_nodes_index,
+ old_echo_area_nodes, old_echo_area_nodes_slots,
+ 4, NODE *);
+ }
+ echo_area_node = (NODE *)NULL;
+ window_message_in_echo_area (format, arg1, arg2);
+}
+
+void
+unmessage_in_echo_area ()
+{
+ free_echo_area ();
+
+ if (old_echo_area_nodes_index)
+ echo_area_node = old_echo_area_nodes[--old_echo_area_nodes_index];
+
+ window_set_node_of_window (the_echo_area, echo_area_node);
+ display_update_one_window (the_echo_area);
+}
+
+/* A place to build a message. */
+static char *message_buffer = (char *)NULL;
+static int message_buffer_index = 0;
+static int message_buffer_size = 0;
+
+/* Ensure that there is enough space to stuff LENGTH characters into
+ MESSAGE_BUFFER. */
+static void
+message_buffer_resize (length)
+ int length;
+{
+ if (!message_buffer)
+ {
+ message_buffer_size = length + 1;
+ message_buffer = (char *)xmalloc (message_buffer_size);
+ message_buffer_index = 0;
+ }
+
+ while (message_buffer_size <= message_buffer_index + length)
+ message_buffer = (char *)
+ xrealloc (message_buffer,
+ message_buffer_size += 100 + (2 * length));
+}
+
+/* Format MESSAGE_BUFFER with the results of printing FORMAT with ARG1 and
+ ARG2. */
+static void
+build_message_buffer (format, arg1, arg2)
+ char *format;
+ void *arg1, *arg2;
+{
+ register int i, len;
+ void *args[2];
+ int arg_index = 0;
+
+ args[0] = arg1;
+ args[1] = arg2;
+
+ len = strlen (format);
+
+ message_buffer_resize (len);
+
+ for (i = 0; format[i]; i++)
+ {
+ if (format[i] != '%')
+ {
+ message_buffer[message_buffer_index++] = format[i];
+ len--;
+ }
+ else
+ {
+ char c;
+
+ c = format[++i];
+
+ switch (c)
+ {
+ case '%': /* Insert a percent sign. */
+ message_buffer_resize (len + 1);
+ message_buffer[message_buffer_index++] = '%';
+ break;
+
+ case 's': /* Insert the current arg as a string. */
+ {
+ char *string;
+ int string_len;
+
+ string = (char *)args[arg_index++];
+ string_len = strlen (string);
+
+ message_buffer_resize (len + string_len);
+ sprintf
+ (message_buffer + message_buffer_index, "%s", string);
+ message_buffer_index += string_len;
+ }
+ break;
+
+ case 'd': /* Insert the current arg as an integer. */
+ {
+ long long_val;
+ int integer;
+
+ long_val = (long)args[arg_index++];
+ integer = (int)long_val;
+
+ message_buffer_resize (len + 32);
+ sprintf
+ (message_buffer + message_buffer_index, "%d", integer);
+ message_buffer_index = strlen (message_buffer);
+ }
+ break;
+
+ case 'c': /* Insert the current arg as a character. */
+ {
+ long long_val;
+ int character;
+
+ long_val = (long)args[arg_index++];
+ character = (int)long_val;
+
+ message_buffer_resize (len + 1);
+ message_buffer[message_buffer_index++] = character;
+ }
+ break;
+
+ default:
+ abort ();
+ }
+ }
+ }
+ message_buffer[message_buffer_index] = '\0';
+}
+
+/* Build a new node which has FORMAT printed with ARG1 and ARG2 as the
+ contents. */
+NODE *
+build_message_node (format, arg1, arg2)
+ char *format;
+ void *arg1, *arg2;
+{
+ NODE *node;
+
+ message_buffer_index = 0;
+ build_message_buffer (format, arg1, arg2);
+
+ node = message_buffer_to_node ();
+ return (node);
+}
+
+/* Convert the contents of the message buffer to a node. */
+NODE *
+message_buffer_to_node ()
+{
+ NODE *node;
+
+ node = (NODE *)xmalloc (sizeof (NODE));
+ node->filename = (char *)NULL;
+ node->parent = (char *)NULL;
+ node->nodename = (char *)NULL;
+ node->flags = 0;
+
+ /* Make sure that this buffer ends with a newline. */
+ node->nodelen = 1 + strlen (message_buffer);
+ node->contents = (char *)xmalloc (1 + node->nodelen);
+ strcpy (node->contents, message_buffer);
+ node->contents[node->nodelen - 1] = '\n';
+ node->contents[node->nodelen] = '\0';
+ return (node);
+}
+
+/* Useful functions can be called from outside of window.c. */
+void
+initialize_message_buffer ()
+{
+ message_buffer_index = 0;
+}
+
+/* Print FORMAT with ARG1,2 to the end of the current message buffer. */
+void
+printf_to_message_buffer (format, arg1, arg2)
+ char *format;
+ void *arg1, *arg2;
+{
+ build_message_buffer (format, arg1, arg2);
+}
+
+/* Return the current horizontal position of the "cursor" on the most
+ recently output message buffer line. */
+int
+message_buffer_length_this_line ()
+{
+ register int i;
+
+ if (!message_buffer_index)
+ return (0);
+
+ for (i = message_buffer_index; i && message_buffer[i - 1] != '\n'; i--);
+
+ return (string_width (message_buffer + i, 0));
+}
+
+/* Pad STRING to COUNT characters by inserting blanks. */
+int
+pad_to (count, string)
+ int count;
+ char *string;
+{
+ register int i;
+
+ i = strlen (string);
+
+ if (i >= count)
+ string[i++] = ' ';
+ else
+ {
+ while (i < count)
+ string[i++] = ' ';
+ }
+ string[i] = '\0';
+
+ return (i);
+}
diff --git a/texinfo/info/window.h b/texinfo/info/window.h
new file mode 100644
index 00000000000..5bde64a10ac
--- /dev/null
+++ b/texinfo/info/window.h
@@ -0,0 +1,229 @@
+/* window.h -- Structure and flags used in manipulating Info windows. */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ Copyright (C) 1993 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (_WINDOW_H_)
+#define _WINDOW_H_
+
+#include "nodes.h"
+#include "infomap.h"
+
+/* Smallest number of visible lines in a window. The actual height is
+ always one more than this number because each window has a modeline. */
+#define WINDOW_MIN_HEIGHT 2
+
+/* Smallest number of screen lines that can be used to fully present a
+ window. This number includes the modeline of the window. */
+#define WINDOW_MIN_SIZE (WINDOW_MIN_HEIGHT + 1)
+
+/* The exact same elements are used within the WINDOW_STATE structure and a
+ subsection of the WINDOW structure. We could define a structure which
+ contains this elements, and include that structure in each of WINDOW_STATE
+ and WINDOW. But that would lead references in the code such as
+ window->state->node which we would like to avoid. Instead, we #define the
+ elements here, and simply include the define in both data structures. Thus,
+ if you need to change window state information, here is where you would
+ do it. NB> The last element does NOT end with a semi-colon. */
+#define WINDOW_STATE_DECL \
+ NODE *node; /* The node displayed in this window. */ \
+ int pagetop; /* LINE_STARTS[PAGETOP] is first line in WINDOW. */ \
+ long point /* Offset within NODE of the cursor position. */
+
+/* Structure which defines a window. Windows are doubly linked, next
+ and prev. The list of windows is kept on WINDOWS. The structure member
+ window->height is the total height of the window. The position location
+ (0, window->height + window->first_row) is the first character of this
+ windows modeline. The number of lines that can be displayed in a window
+ is equal to window->height - 1. */
+typedef struct __window__ {
+ struct __window__ *next; /* Next window in this chain. */
+ struct __window__ *prev; /* Previous window in this chain. */
+ int width; /* Width of this window. */
+ int height; /* Height of this window. */
+ int first_row; /* Offset of the first line in the_screen. */
+ int goal_column; /* The column we would like the cursor to appear in. */
+ Keymap keymap; /* Keymap used to read commands in this window. */
+ WINDOW_STATE_DECL; /* Node, pagetop and point. */
+ char *modeline; /* Calculated text of the modeline for this window. */
+ char **line_starts; /* Array of printed line starts for this node. */
+ int line_count; /* Number of lines appearing in LINE_STARTS. */
+ int flags; /* See below for details. */
+} WINDOW;
+
+typedef struct {
+ WINDOW_STATE_DECL; /* What gets saved. */
+} WINDOW_STATE;
+
+#define W_UpdateWindow 0x01 /* WINDOW needs updating. */
+#define W_WindowIsPerm 0x02 /* This WINDOW is a permanent object. */
+#define W_WindowVisible 0x04 /* This WINDOW is currently visible. */
+#define W_InhibitMode 0x08 /* This WINDOW has no modeline. */
+#define W_NoWrap 0x10 /* Lines do not wrap in this window. */
+#define W_InputWindow 0x20 /* Window accepts input. */
+#define W_TempWindow 0x40 /* Window is less important. */
+
+extern WINDOW *windows; /* List of visible Info windows. */
+extern WINDOW *active_window; /* The currently active window. */
+extern WINDOW *the_screen; /* The Info screen is just another window. */
+extern WINDOW *the_echo_area; /* THE_ECHO_AREA is a window in THE_SCREEN. */
+
+/* Global variable control redisplay of scrolled windows. If non-zero, it
+ is the desired number of lines to scroll the window in order to make
+ point visible. A user might set this to 1 for smooth scrolling. If
+ set to zero, the line containing point is centered within the window. */
+extern int window_scroll_step;
+
+ /* Make the modeline member for WINDOW. */
+extern void window_make_modeline ();
+
+/* Initalize the window system by creating THE_SCREEN and THE_ECHO_AREA.
+ Create the first window ever, and make it permanent.
+ You pass WIDTH and HEIGHT; the dimensions of the total screen size. */
+extern void window_initialize_windows ();
+
+/* Make a new window showing NODE, and return that window structure.
+ The new window is made to be the active window. If NODE is passed
+ as NULL, then show the node showing in the active window. If the
+ window could not be made return a NULL pointer. The active window
+ is not changed.*/
+extern WINDOW *window_make_window ();
+
+/* Delete WINDOW from the list of known windows. If this window was the
+ active window, make the next window in the chain be the active window,
+ or the previous window in the chain if there is no next window. */
+extern void window_delete_window ();
+
+/* A function to call when the screen changes size, and some windows have
+ to get deleted. The function is called with the window to be deleted
+ as an argument, and it can't do anything about the window getting deleted;
+ it can only clean up dangling references to that window. */
+extern VFunction *window_deletion_notifier;
+
+/* Set WINDOW to display NODE. */
+extern void window_set_node_of_window ();
+
+/* Tell the window system that the size of the screen has changed. This
+ causes lots of interesting things to happen. The permanent windows
+ are resized, as well as every visible window. You pass WIDTH and HEIGHT;
+ the dimensions of the total screen size. */
+extern void window_new_screen_size ();
+
+/* Change the height of WINDOW by AMOUNT. This also automagically adjusts
+ the previous and next windows in the chain. If there is only one user
+ window, then no change takes place. */
+extern void window_change_window_height ();
+
+/* Adjust the pagetop of WINDOW such that the cursor point will be visible. */
+extern void window_adjust_pagetop ();
+
+/* Tile all of the windows currently displayed in the global variable
+ WINDOWS. If argument DO_INTERNALS is non-zero, tile windows displaying
+ internal nodes as well. */
+#define DONT_TILE_INTERNALS 0
+#define TILE_INTERNALS 1
+extern void window_tile_windows ();
+
+/* Toggle the state of line wrapping in WINDOW. This can do a bit of fancy
+ redisplay. */
+extern void window_toggle_wrap ();
+
+/* For every window in CHAIN, set the flags member to have FLAG set. */
+extern void window_mark_chain ();
+
+/* For every window in CHAIN, clear the flags member of FLAG. */
+extern void window_unmark_chain ();
+
+/* Make WINDOW start displaying at PERCENT percentage of its node. */
+extern void window_goto_percentage ();
+
+/* Build a new node which has FORMAT printed with ARG1 and ARG2 as the
+ contents. */
+extern NODE *build_message_node ();
+
+/* Useful functions can be called from outside of window.c. */
+extern void initialize_message_buffer ();
+
+/* Print FORMAT with ARG1,2 to the end of the current message buffer. */
+extern void printf_to_message_buffer ();
+
+/* Convert the contents of the message buffer to a node. */
+extern NODE *message_buffer_to_node ();
+
+/* Return the length of the most recently printed line in message buffer. */
+extern int message_buffer_length_this_line ();
+
+/* Pad STRING to COUNT characters by inserting blanks. */
+extern int pad_to ();
+
+/* Make a message appear in the echo area, built from FORMAT, ARG1 and ARG2.
+ The arguments are treated similar to printf () arguments, but not all of
+ printf () hair is present. The message appears immediately. If there was
+ already a message appearing in the echo area, it is removed. */
+extern void window_message_in_echo_area ();
+
+/* Place a temporary message in the echo area built from FORMAT, ARG1
+ and ARG2. The message appears immediately, but does not destroy
+ any existing message. A future call to unmessage_in_echo_area ()
+ restores the old contents. */
+extern void message_in_echo_area ();
+extern void unmessage_in_echo_area ();
+
+/* Clear the echo area, removing any message that is already present.
+ The echo area is cleared immediately. */
+extern void window_clear_echo_area ();
+
+/* Quickly guess the approximate number of lines to that NODE would
+ take to display. This really only counts carriage returns. */
+extern int window_physical_lines ();
+
+/* Calculate a list of line starts for the node belonging to WINDOW. The line
+ starts are pointers to the actual text within WINDOW->NODE. */
+extern void calculate_line_starts ();
+
+/* Given WINDOW, recalculate the line starts for the node it displays. */
+extern void recalculate_line_starts ();
+
+/* Return the number of characters it takes to display CHARACTER on the
+ screen at HPOS. */
+extern int character_width ();
+
+/* Return the number of characters it takes to display STRING on the
+ screen at HPOS. */
+extern int string_width ();
+
+/* Return the index of the line containing point. */
+extern int window_line_of_point ();
+
+/* Get and return the goal column for this window. */
+extern int window_get_goal_column ();
+
+/* Get and return the printed column offset of the cursor in this window. */
+extern int window_get_cursor_column ();
+
+/* Get and Set the node, pagetop, and point of WINDOW. */
+extern void window_get_state (), window_set_state ();
+
+/* Count the number of characters in LINE that precede the printed column
+ offset of GOAL. */
+extern int window_chars_to_goal ();
+
+#endif /* !_WINDOW_H_ */
diff --git a/texinfo/info/xmalloc.c b/texinfo/info/xmalloc.c
new file mode 100644
index 00000000000..156989ed711
--- /dev/null
+++ b/texinfo/info/xmalloc.c
@@ -0,0 +1,80 @@
+/* xmalloc.c -- safe versions of malloc and realloc */
+
+/* This file is part of GNU Info, a program for reading online documentation
+ stored in Info format.
+
+ This file has appeared in prior works by the Free Software Foundation;
+ thus it carries copyright dates from 1988 through 1993.
+
+ Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993 Free Software
+ Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+#if !defined (ALREADY_HAVE_XMALLOC)
+#include <stdio.h>
+#include <sys/types.h>
+
+extern void *malloc (), *realloc ();
+static void memory_error_and_abort ();
+
+/* **************************************************************** */
+/* */
+/* Memory Allocation and Deallocation. */
+/* */
+/* **************************************************************** */
+
+/* Return a pointer to free()able block of memory large enough
+ to hold BYTES number of bytes. If the memory cannot be allocated,
+ print an error message and abort. */
+void *
+xmalloc (bytes)
+ int bytes;
+{
+ void *temp = malloc (bytes);
+
+ if (!temp)
+ memory_error_and_abort ("xmalloc");
+ return (temp);
+}
+
+void *
+xrealloc (pointer, bytes)
+ void *pointer;
+ int bytes;
+{
+ void *temp;
+
+ if (!pointer)
+ temp = malloc (bytes);
+ else
+ temp = realloc (pointer, bytes);
+
+ if (!temp)
+ memory_error_and_abort ("xrealloc");
+
+ return (temp);
+}
+
+static void
+memory_error_and_abort (fname)
+ char *fname;
+{
+ fprintf (stderr, "%s: Out of virtual memory!\n", fname);
+ abort ();
+}
+#endif /* !ALREADY_HAVE_XMALLOC */
diff --git a/texinfo/install-sh b/texinfo/install-sh
new file mode 100755
index 00000000000..2c212ccf4ae
--- /dev/null
+++ b/texinfo/install-sh
@@ -0,0 +1,250 @@
+#! /bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission. M.I.T. makes no representations about the
+# suitability of this software for any purpose. It is provided "as is"
+# without express or implied warranty.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+#
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -d) dir_arg=true
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ -t=*) transformarg=`echo $1 | sed 's/-t=//'`
+ shift
+ continue;;
+
+ -b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ # this colon is to work around a 386BSD /bin/sh bug
+ :
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+else
+ true
+fi
+
+if [ x"$dir_arg" != x ]; then
+ dst=$src
+ src=""
+
+ if [ -d $dst ]; then
+ instcmd=:
+ else
+ instcmd=mkdir
+ fi
+else
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad
+# if $src (and thus $dsttmp) contains '*'.
+
+ if [ -f $src -o -d $src ]
+ then
+ true
+ else
+ echo "install: $src does not exist"
+ exit 1
+ fi
+
+ if [ x"$dst" = x ]
+ then
+ echo "install: no destination specified"
+ exit 1
+ else
+ true
+ fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+ if [ -d $dst ]
+ then
+ dst="$dst"/`basename $src`
+ else
+ true
+ fi
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+# this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='
+'
+IFS="${IFS-${defaultIFS}}"
+
+oIFS="${IFS}"
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS="${oIFS}"
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+ pathcomp="${pathcomp}${1}"
+ shift
+
+ if [ ! -d "${pathcomp}" ] ;
+ then
+ $mkdirprog "${pathcomp}"
+ else
+ true
+ fi
+
+ pathcomp="${pathcomp}/"
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+ $doit $instcmd $dst &&
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+ if [ x"$transformarg" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ dstfile=`basename $dst $transformbasename |
+ sed $transformarg`$transformbasename
+ fi
+
+# don't allow the sed command to completely eliminate the filename
+
+ if [ x"$dstfile" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ true
+ fi
+
+# Make a temp file name in the proper directory.
+
+ dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+ $doit $instcmd $src $dsttmp &&
+
+ trap "rm -f ${dsttmp}" 0 &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing. If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
+
+# Now rename the file to the real destination.
+
+ $doit $rmcmd -f $dstdir/$dstfile &&
+ $doit $mvcmd $dsttmp $dstdir/$dstfile
+
+fi &&
+
+
+exit 0
diff --git a/texinfo/lgpl.texinfo b/texinfo/lgpl.texinfo
new file mode 100644
index 00000000000..5a57ff9620a
--- /dev/null
+++ b/texinfo/lgpl.texinfo
@@ -0,0 +1,548 @@
+@c This LGPL is meant to be included from other files.
+@c To format a standalone LGPL, use liblic.texi.
+
+@ifset lgpl-appendix
+@appendix GNU LIBRARY GENERAL PUBLIC LICENSE
+@end ifset
+
+@ifclear lgpl-appendix
+@unnumbered GNU LIBRARY GENERAL PUBLIC LICENSE
+@end ifclear
+@center Version 2, June 1991
+
+@display
+Copyright @copyright{} 1991 Free Software Foundation, Inc.
+59 Temple Place - Suite 330, Boston, MA 02111-1307, 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.]
+@end display
+
+@unnumberedsec 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.
+
+@iftex
+@unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+@end iftex
+@ifinfo
+@center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+@end ifinfo
+
+@enumerate 0
+@item
+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.
+
+@item
+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.
+
+@item
+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:
+
+@enumerate a
+@item
+The modified work must itself be a software library.
+
+@item
+You must cause the files modified to carry prominent notices
+stating that you changed the files and the date of any change.
+
+@item
+You must cause the whole of the work to be licensed at no
+charge to all third parties under the terms of this License.
+
+@item
+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.)
+@end enumerate
+
+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.
+
+@item
+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.
+
+@item
+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.
+
+@item
+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.
+
+@item
+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:
+
+@enumerate a
+@item
+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.)
+
+@item
+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.
+
+@item
+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.
+
+@item
+Verify that the user has already received a copy of these
+materials or that you have already sent this user a copy.
+@end enumerate
+
+ 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.
+
+@item
+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:
+
+@enumerate a
+@item
+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.
+
+@item
+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.
+@end enumerate
+
+@item
+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.
+
+@item
+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.
+
+@item
+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.
+
+@item
+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.
+
+@item
+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.
+
+@item
+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.
+
+@item
+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.
+
+@iftex
+@heading NO WARRANTY
+@end iftex
+@ifinfo
+@center NO WARRANTY
+@end ifinfo
+
+@item
+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.
+
+@item
+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 enumerate
+
+@iftex
+@heading END OF TERMS AND CONDITIONS
+@end iftex
+@ifinfo
+@center END OF TERMS AND CONDITIONS
+@end ifinfo
+
+@page
+@unnumberedsec 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.
+
+@smallexample
+@var{one line to give the library's name and an idea of what it does.}
+Copyright (C) @var{year} @var{name of author}
+
+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., 59 Temple Place - Suite 330, Cambridge,
+MA 02139, USA.
+@end smallexample
+
+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:
+
+@example
+Yoyodyne, Inc., hereby disclaims all copyright interest in
+the library `Frob' (a library for tweaking knobs) written
+by James Random Hacker.
+
+@var{signature of Ty Coon}, 1 April 1990
+Ty Coon, President of Vice
+@end example
+
+That's all there is to it!
diff --git a/texinfo/liblic.texi b/texinfo/liblic.texi
new file mode 100644
index 00000000000..b7ede0e35e5
--- /dev/null
+++ b/texinfo/liblic.texi
@@ -0,0 +1,23 @@
+\input texinfo
+@setfilename lgpl.info
+
+@ifinfo
+@format
+START-INFO-DIR-ENTRY
+* COPYING LIBS: (lgpl). The GNU Library General Public License
+END-INFO-DIR-ENTRY
+@end format
+@end ifinfo
+
+@settitle LGPL
+@iftex
+@headings doubleafter
+@setchapternewpage off
+@end iftex
+@finalout
+
+@clear lgpl-appendix
+@node Top, , (dir), (dir)
+@include lgpl.texinfo
+
+@bye
diff --git a/texinfo/libtxi/Makefile.in b/texinfo/libtxi/Makefile.in
new file mode 100644
index 00000000000..a067cb9be5e
--- /dev/null
+++ b/texinfo/libtxi/Makefile.in
@@ -0,0 +1,84 @@
+# Makefile for GNU texinfo/libtxi. -*- Indented-Text -*-
+# $Id: Makefile.in,v 1.3 1996/10/03 18:32:28 karl Exp $
+
+# Copyright (C) 1993, 96 Free Software Foundation, Inc.
+
+# This program 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.
+
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+SHELL = /bin/sh
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+CC = @CC@
+AR = ar
+RANLIB = @RANLIB@
+
+DEFS = @DEFS@
+LIBS = @LIBS@
+LOADLIBES = $(LIBS)
+
+CFLAGS = @CFLAGS@
+LDFLAGS = @LDFLAGS@
+
+# This is normally inherited from parent make, but if someone wants to
+# build libtxi.a alone, this variable will still be properly defined.
+ALLOCA = @ALLOCA@
+
+# Standard functions that may be missing.
+LIBOBJS = @LIBOBJS@
+
+SRCS = getopt.c getopt1.c bzero.c getopt.h
+OBJS = getopt.o getopt1.o bzero.o $(ALLOCA) $(LIBOBJS)
+
+PROGS = libtxi.a
+
+all: $(PROGS)
+sub-all: all
+
+.c.o:
+ $(CC) -c $(CPPFLAGS) -I. -I$(srcdir) $(DEFS) $(CFLAGS) $<
+
+libtxi.a: $(OBJS)
+ rm -f $@
+ $(AR) cq $@ $(OBJS)
+ $(RANLIB) $@
+
+getopt.o: getopt.c getopt.h
+getopt1.o: getopt1.c getopt.h
+alloca.o: alloca.c
+
+install:
+uninstall:
+dvi:
+install-info:
+
+TAGS: $(SRCS)
+ etags $(SRCS)
+
+clean:
+ rm -f *.o a.out core core.* $(PROGS)
+
+mostlyclean: clean
+
+distclean: clean
+ rm -f Makefile config.status TAGS ID
+
+realclean: distclean
+
+Makefile: Makefile.in ../config.status
+ cd .. && sh config.status
+
+# Prevent GNU make v3 from overflowing arg limit on SysV.
+.NOEXPORT:
diff --git a/texinfo/libtxi/alloca.c b/texinfo/libtxi/alloca.c
new file mode 100644
index 00000000000..8f98b73dbb9
--- /dev/null
+++ b/texinfo/libtxi/alloca.c
@@ -0,0 +1,504 @@
+/* alloca.c -- allocate automatically reclaimed memory
+ (Mostly) portable public-domain implementation -- D A Gwyn
+
+ This implementation of the PWB library alloca function,
+ which is used to allocate space off the run-time stack so
+ that it is automatically reclaimed upon procedure exit,
+ was inspired by discussions with J. Q. Johnson of Cornell.
+ J.Otto Tennant <jot@cray.com> contributed the Cray support.
+
+ There are some preprocessor constants that can
+ be defined when compiling for your specific system, for
+ improved efficiency; however, the defaults should be okay.
+
+ The general concept of this implementation is to keep
+ track of all alloca-allocated blocks, and reclaim any
+ that are found to be deeper in the stack than the current
+ invocation. This heuristic does not reclaim storage as
+ soon as it becomes invalid, but it will do so eventually.
+
+ As a special case, alloca(0) reclaims storage without
+ allocating any. It is a good idea to use alloca(0) in
+ your main control loop, etc. to force garbage collection. */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifdef emacs
+#include "blockinput.h"
+#endif
+
+/* If compiling with GCC 2, this file's not needed. */
+#if !defined (__GNUC__) || __GNUC__ < 2
+
+/* If someone has defined alloca as a macro,
+ there must be some other way alloca is supposed to work. */
+#ifndef alloca
+
+#ifdef emacs
+#ifdef static
+/* actually, only want this if static is defined as ""
+ -- this is for usg, in which emacs must undefine static
+ in order to make unexec workable
+ */
+#ifndef STACK_DIRECTION
+you
+lose
+-- must know STACK_DIRECTION at compile-time
+#endif /* STACK_DIRECTION undefined */
+#endif /* static */
+#endif /* emacs */
+
+/* If your stack is a linked list of frames, you have to
+ provide an "address metric" ADDRESS_FUNCTION macro. */
+
+#if defined (CRAY) && defined (CRAY_STACKSEG_END)
+long i00afunc ();
+#define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
+#else
+#define ADDRESS_FUNCTION(arg) &(arg)
+#endif
+
+#if __STDC__
+typedef void *pointer;
+#else
+typedef char *pointer;
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+/* Different portions of Emacs need to call different versions of
+ malloc. The Emacs executable needs alloca to call xmalloc, because
+ ordinary malloc isn't protected from input signals. On the other
+ hand, the utilities in lib-src need alloca to call malloc; some of
+ them are very simple, and don't have an xmalloc routine.
+
+ Non-Emacs programs expect this to call use xmalloc.
+
+ Callers below should use malloc. */
+
+#ifndef emacs
+#define malloc xmalloc
+#endif
+extern pointer malloc ();
+
+/* Define STACK_DIRECTION if you know the direction of stack
+ growth for your system; otherwise it will be automatically
+ deduced at run-time.
+
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown */
+
+#ifndef STACK_DIRECTION
+#define STACK_DIRECTION 0 /* Direction unknown. */
+#endif
+
+#if STACK_DIRECTION != 0
+
+#define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
+
+#else /* STACK_DIRECTION == 0; need run-time code. */
+
+static int stack_dir; /* 1 or -1 once known. */
+#define STACK_DIR stack_dir
+
+static void
+find_stack_direction ()
+{
+ static char *addr = NULL; /* Address of first `dummy', once known. */
+ auto char dummy; /* To get stack address. */
+
+ if (addr == NULL)
+ { /* Initial entry. */
+ addr = ADDRESS_FUNCTION (dummy);
+
+ find_stack_direction (); /* Recurse once. */
+ }
+ else
+ {
+ /* Second entry. */
+ if (ADDRESS_FUNCTION (dummy) > addr)
+ stack_dir = 1; /* Stack grew upward. */
+ else
+ stack_dir = -1; /* Stack grew downward. */
+ }
+}
+
+#endif /* STACK_DIRECTION == 0 */
+
+/* An "alloca header" is used to:
+ (a) chain together all alloca'ed blocks;
+ (b) keep track of stack depth.
+
+ It is very important that sizeof(header) agree with malloc
+ alignment chunk size. The following default should work okay. */
+
+#ifndef ALIGN_SIZE
+#define ALIGN_SIZE sizeof(double)
+#endif
+
+typedef union hdr
+{
+ char align[ALIGN_SIZE]; /* To force sizeof(header). */
+ struct
+ {
+ union hdr *next; /* For chaining headers. */
+ char *deep; /* For stack depth measure. */
+ } h;
+} header;
+
+static header *last_alloca_header = NULL; /* -> last alloca header. */
+
+/* Return a pointer to at least SIZE bytes of storage,
+ which will be automatically reclaimed upon exit from
+ the procedure that called alloca. Originally, this space
+ was supposed to be taken from the current stack frame of the
+ caller, but that method cannot be made to work for some
+ implementations of C, for example under Gould's UTX/32. */
+
+pointer
+alloca (size)
+ unsigned size;
+{
+ auto char probe; /* Probes stack depth: */
+ register char *depth = ADDRESS_FUNCTION (probe);
+
+#if STACK_DIRECTION == 0
+ if (STACK_DIR == 0) /* Unknown growth direction. */
+ find_stack_direction ();
+#endif
+
+ /* Reclaim garbage, defined as all alloca'd storage that
+ was allocated from deeper in the stack than currently. */
+
+ {
+ register header *hp; /* Traverses linked list. */
+
+#ifdef emacs
+ BLOCK_INPUT;
+#endif
+
+ for (hp = last_alloca_header; hp != NULL;)
+ if ((STACK_DIR > 0 && hp->h.deep > depth)
+ || (STACK_DIR < 0 && hp->h.deep < depth))
+ {
+ register header *np = hp->h.next;
+
+ free ((pointer) hp); /* Collect garbage. */
+
+ hp = np; /* -> next header. */
+ }
+ else
+ break; /* Rest are not deeper. */
+
+ last_alloca_header = hp; /* -> last valid storage. */
+
+#ifdef emacs
+ UNBLOCK_INPUT;
+#endif
+ }
+
+ if (size == 0)
+ return NULL; /* No allocation required. */
+
+ /* Allocate combined header + user data storage. */
+
+ {
+ register pointer new = malloc (sizeof (header) + size);
+ /* Address of header. */
+
+ if (new == 0)
+ abort();
+
+ ((header *) new)->h.next = last_alloca_header;
+ ((header *) new)->h.deep = depth;
+
+ last_alloca_header = (header *) new;
+
+ /* User storage begins just after header. */
+
+ return (pointer) ((char *) new + sizeof (header));
+ }
+}
+
+#if defined (CRAY) && defined (CRAY_STACKSEG_END)
+
+#ifdef DEBUG_I00AFUNC
+#include <stdio.h>
+#endif
+
+#ifndef CRAY_STACK
+#define CRAY_STACK
+#ifndef CRAY2
+/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
+struct stack_control_header
+ {
+ long shgrow:32; /* Number of times stack has grown. */
+ long shaseg:32; /* Size of increments to stack. */
+ long shhwm:32; /* High water mark of stack. */
+ long shsize:32; /* Current size of stack (all segments). */
+ };
+
+/* The stack segment linkage control information occurs at
+ the high-address end of a stack segment. (The stack
+ grows from low addresses to high addresses.) The initial
+ part of the stack segment linkage control information is
+ 0200 (octal) words. This provides for register storage
+ for the routine which overflows the stack. */
+
+struct stack_segment_linkage
+ {
+ long ss[0200]; /* 0200 overflow words. */
+ long sssize:32; /* Number of words in this segment. */
+ long ssbase:32; /* Offset to stack base. */
+ long:32;
+ long sspseg:32; /* Offset to linkage control of previous
+ segment of stack. */
+ long:32;
+ long sstcpt:32; /* Pointer to task common address block. */
+ long sscsnm; /* Private control structure number for
+ microtasking. */
+ long ssusr1; /* Reserved for user. */
+ long ssusr2; /* Reserved for user. */
+ long sstpid; /* Process ID for pid based multi-tasking. */
+ long ssgvup; /* Pointer to multitasking thread giveup. */
+ long sscray[7]; /* Reserved for Cray Research. */
+ long ssa0;
+ long ssa1;
+ long ssa2;
+ long ssa3;
+ long ssa4;
+ long ssa5;
+ long ssa6;
+ long ssa7;
+ long sss0;
+ long sss1;
+ long sss2;
+ long sss3;
+ long sss4;
+ long sss5;
+ long sss6;
+ long sss7;
+ };
+
+#else /* CRAY2 */
+/* The following structure defines the vector of words
+ returned by the STKSTAT library routine. */
+struct stk_stat
+ {
+ long now; /* Current total stack size. */
+ long maxc; /* Amount of contiguous space which would
+ be required to satisfy the maximum
+ stack demand to date. */
+ long high_water; /* Stack high-water mark. */
+ long overflows; /* Number of stack overflow ($STKOFEN) calls. */
+ long hits; /* Number of internal buffer hits. */
+ long extends; /* Number of block extensions. */
+ long stko_mallocs; /* Block allocations by $STKOFEN. */
+ long underflows; /* Number of stack underflow calls ($STKRETN). */
+ long stko_free; /* Number of deallocations by $STKRETN. */
+ long stkm_free; /* Number of deallocations by $STKMRET. */
+ long segments; /* Current number of stack segments. */
+ long maxs; /* Maximum number of stack segments so far. */
+ long pad_size; /* Stack pad size. */
+ long current_address; /* Current stack segment address. */
+ long current_size; /* Current stack segment size. This
+ number is actually corrupted by STKSTAT to
+ include the fifteen word trailer area. */
+ long initial_address; /* Address of initial segment. */
+ long initial_size; /* Size of initial segment. */
+ };
+
+/* The following structure describes the data structure which trails
+ any stack segment. I think that the description in 'asdef' is
+ out of date. I only describe the parts that I am sure about. */
+
+struct stk_trailer
+ {
+ long this_address; /* Address of this block. */
+ long this_size; /* Size of this block (does not include
+ this trailer). */
+ long unknown2;
+ long unknown3;
+ long link; /* Address of trailer block of previous
+ segment. */
+ long unknown5;
+ long unknown6;
+ long unknown7;
+ long unknown8;
+ long unknown9;
+ long unknown10;
+ long unknown11;
+ long unknown12;
+ long unknown13;
+ long unknown14;
+ };
+
+#endif /* CRAY2 */
+#endif /* not CRAY_STACK */
+
+#ifdef CRAY2
+/* Determine a "stack measure" for an arbitrary ADDRESS.
+ I doubt that "lint" will like this much. */
+
+static long
+i00afunc (long *address)
+{
+ struct stk_stat status;
+ struct stk_trailer *trailer;
+ long *block, size;
+ long result = 0;
+
+ /* We want to iterate through all of the segments. The first
+ step is to get the stack status structure. We could do this
+ more quickly and more directly, perhaps, by referencing the
+ $LM00 common block, but I know that this works. */
+
+ STKSTAT (&status);
+
+ /* Set up the iteration. */
+
+ trailer = (struct stk_trailer *) (status.current_address
+ + status.current_size
+ - 15);
+
+ /* There must be at least one stack segment. Therefore it is
+ a fatal error if "trailer" is null. */
+
+ if (trailer == 0)
+ abort ();
+
+ /* Discard segments that do not contain our argument address. */
+
+ while (trailer != 0)
+ {
+ block = (long *) trailer->this_address;
+ size = trailer->this_size;
+ if (block == 0 || size == 0)
+ abort ();
+ trailer = (struct stk_trailer *) trailer->link;
+ if ((block <= address) && (address < (block + size)))
+ break;
+ }
+
+ /* Set the result to the offset in this segment and add the sizes
+ of all predecessor segments. */
+
+ result = address - block;
+
+ if (trailer == 0)
+ {
+ return result;
+ }
+
+ do
+ {
+ if (trailer->this_size <= 0)
+ abort ();
+ result += trailer->this_size;
+ trailer = (struct stk_trailer *) trailer->link;
+ }
+ while (trailer != 0);
+
+ /* We are done. Note that if you present a bogus address (one
+ not in any segment), you will get a different number back, formed
+ from subtracting the address of the first block. This is probably
+ not what you want. */
+
+ return (result);
+}
+
+#else /* not CRAY2 */
+/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
+ Determine the number of the cell within the stack,
+ given the address of the cell. The purpose of this
+ routine is to linearize, in some sense, stack addresses
+ for alloca. */
+
+static long
+i00afunc (long address)
+{
+ long stkl = 0;
+
+ long size, pseg, this_segment, stack;
+ long result = 0;
+
+ struct stack_segment_linkage *ssptr;
+
+ /* Register B67 contains the address of the end of the
+ current stack segment. If you (as a subprogram) store
+ your registers on the stack and find that you are past
+ the contents of B67, you have overflowed the segment.
+
+ B67 also points to the stack segment linkage control
+ area, which is what we are really interested in. */
+
+ stkl = CRAY_STACKSEG_END ();
+ ssptr = (struct stack_segment_linkage *) stkl;
+
+ /* If one subtracts 'size' from the end of the segment,
+ one has the address of the first word of the segment.
+
+ If this is not the first segment, 'pseg' will be
+ nonzero. */
+
+ pseg = ssptr->sspseg;
+ size = ssptr->sssize;
+
+ this_segment = stkl - size;
+
+ /* It is possible that calling this routine itself caused
+ a stack overflow. Discard stack segments which do not
+ contain the target address. */
+
+ while (!(this_segment <= address && address <= stkl))
+ {
+#ifdef DEBUG_I00AFUNC
+ fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
+#endif
+ if (pseg == 0)
+ break;
+ stkl = stkl - pseg;
+ ssptr = (struct stack_segment_linkage *) stkl;
+ size = ssptr->sssize;
+ pseg = ssptr->sspseg;
+ this_segment = stkl - size;
+ }
+
+ result = address - this_segment;
+
+ /* If you subtract pseg from the current end of the stack,
+ you get the address of the previous stack segment's end.
+ This seems a little convoluted to me, but I'll bet you save
+ a cycle somewhere. */
+
+ while (pseg != 0)
+ {
+#ifdef DEBUG_I00AFUNC
+ fprintf (stderr, "%011o %011o\n", pseg, size);
+#endif
+ stkl = stkl - pseg;
+ ssptr = (struct stack_segment_linkage *) stkl;
+ size = ssptr->sssize;
+ pseg = ssptr->sspseg;
+ result += size;
+ }
+ return (result);
+}
+
+#endif /* not CRAY2 */
+#endif /* CRAY */
+
+#endif /* no alloca */
+#endif /* not GCC version 2 */
diff --git a/texinfo/libtxi/bzero.c b/texinfo/libtxi/bzero.c
new file mode 100644
index 00000000000..e73738234fd
--- /dev/null
+++ b/texinfo/libtxi/bzero.c
@@ -0,0 +1,44 @@
+/*
+ * Copyright (C) 1993 Free Software Foundation, Inc.
+ *
+ * This program 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.
+ *
+ * This program 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 this program; if not, you can either send email to this
+ * program's author (see below) or write to: The Free Software Foundation,
+ * Inc.; 59 Temple Place - Suite 330. Boston, MA 02111-1307, USA.
+ */
+
+#if !defined (HAVE_MEMSET) && !defined (HAVE_BZERO)
+
+void
+bzero (b, length)
+ register char *b;
+ register int length;
+{
+#ifdef VMS /* but this is definitely VMS-specific */
+ short zero = 0;
+ long max_str = 65535;
+
+ while (length > max_str)
+ {
+ (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b);
+ length -= max_str;
+ b += max_str;
+ }
+ (void) LIB$MOVC5 (&zero, &zero, &zero, &length, b);
+#else
+ while (length-- > 0)
+ *b++ = 0;
+#endif /* not VMS */
+}
+
+#endif /* not HAVE_MEMSET && not HAVE_BZERO */
diff --git a/texinfo/libtxi/getopt.c b/texinfo/libtxi/getopt.c
new file mode 100644
index 00000000000..36ebf5c5b03
--- /dev/null
+++ b/texinfo/libtxi/getopt.c
@@ -0,0 +1,762 @@
+/* Getopt for GNU.
+ NOTE: getopt is now part of the C library, so if you don't know what
+ "Keep this file name-space clean" means, talk to roland@gnu.ai.mit.edu
+ before changing it!
+
+ Copyright (C) 1987, 88, 89, 90, 91, 92, 93, 94, 95
+ Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+/* This tells Alpha OSF/1 not to define a getopt prototype in <stdio.h>.
+ Ditto for AIX 3.2 and <stdlib.h>. */
+#ifndef _NO_PROTO
+#define _NO_PROTO
+#endif
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#if !defined (__STDC__) || !__STDC__
+/* This is a separate conditional since some stdc systems
+ reject `defined (const)'. */
+#ifndef const
+#define const
+#endif
+#endif
+
+#include <stdio.h>
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+ actually compiling the library itself. This code is part of the GNU C
+ Library, but also included in many other GNU distributions. Compiling
+ and linking in this code is a waste when using the GNU C library
+ (especially if it is a shared library). Rather than having every GNU
+ program understand `configure --with-gnu-libc' and omit the object files,
+ it is simpler to just do this in the source for each such file. */
+
+#if defined (_LIBC) || !defined (__GNU_LIBRARY__)
+
+
+/* This needs to come after some library #include
+ to get __GNU_LIBRARY__ defined. */
+#ifdef __GNU_LIBRARY__
+/* Don't include stdlib.h for non-GNU C libraries because some of them
+ contain conflicting prototypes for getopt. */
+#include <stdlib.h>
+#endif /* GNU C library. */
+
+/* This is for other GNU distributions with internationalized messages.
+ The GNU C Library itself does not yet support such messages. */
+#if HAVE_LIBINTL_H
+# include <libintl.h>
+#else
+# define gettext(msgid) (msgid)
+#endif
+
+/* This version of `getopt' appears to the caller like standard Unix `getopt'
+ but it behaves differently for the user, since it allows the user
+ to intersperse the options with the other arguments.
+
+ As `getopt' works, it permutes the elements of ARGV so that,
+ when it is done, all the options precede everything else. Thus
+ all application programs are extended to handle flexible argument order.
+
+ Setting the environment variable POSIXLY_CORRECT disables permutation.
+ Then the behavior is completely standard.
+
+ GNU application programs can use a third alternative mode in which
+ they can distinguish the relative order of options and other arguments. */
+
+#include "getopt.h"
+
+/* For communication from `getopt' to the caller.
+ When `getopt' finds an option that takes an argument,
+ the argument value is returned here.
+ Also, when `ordering' is RETURN_IN_ORDER,
+ each non-option ARGV-element is returned here. */
+
+char *optarg = NULL;
+
+/* Index in ARGV of the next element to be scanned.
+ This is used for communication to and from the caller
+ and for communication between successive calls to `getopt'.
+
+ On entry to `getopt', zero means this is the first call; initialize.
+
+ When `getopt' returns EOF, this is the index of the first of the
+ non-option elements that the caller should itself scan.
+
+ Otherwise, `optind' communicates from one call to the next
+ how much of ARGV has been scanned so far. */
+
+/* XXX 1003.2 says this must be 1 before any call. */
+int optind = 0;
+
+/* The next char to be scanned in the option-element
+ in which the last option character we returned was found.
+ This allows us to pick up the scan where we left off.
+
+ If this is zero, or a null string, it means resume the scan
+ by advancing to the next ARGV-element. */
+
+static char *nextchar;
+
+/* Callers store zero here to inhibit the error message
+ for unrecognized options. */
+
+int opterr = 1;
+
+/* Set to an option character which was unrecognized.
+ This must be initialized on some systems to avoid linking in the
+ system's own getopt implementation. */
+
+int optopt = '?';
+
+/* Describe how to deal with options that follow non-option ARGV-elements.
+
+ If the caller did not specify anything,
+ the default is REQUIRE_ORDER if the environment variable
+ POSIXLY_CORRECT is defined, PERMUTE otherwise.
+
+ REQUIRE_ORDER means don't recognize them as options;
+ stop option processing when the first non-option is seen.
+ This is what Unix does.
+ This mode of operation is selected by either setting the environment
+ variable POSIXLY_CORRECT, or using `+' as the first character
+ of the list of option characters.
+
+ PERMUTE is the default. We permute the contents of ARGV as we scan,
+ so that eventually all the non-options are at the end. This allows options
+ to be given in any order, even with programs that were not written to
+ expect this.
+
+ RETURN_IN_ORDER is an option available to programs that were written
+ to expect options and other ARGV-elements in any order and that care about
+ the ordering of the two. We describe each non-option ARGV-element
+ as if it were the argument of an option with character code 1.
+ Using `-' as the first character of the list of option characters
+ selects this mode of operation.
+
+ The special argument `--' forces an end of option-scanning regardless
+ of the value of `ordering'. In the case of RETURN_IN_ORDER, only
+ `--' can cause `getopt' to return EOF with `optind' != ARGC. */
+
+static enum
+{
+ REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER
+} ordering;
+
+/* Value of POSIXLY_CORRECT environment variable. */
+static char *posixly_correct;
+
+#ifdef __GNU_LIBRARY__
+/* We want to avoid inclusion of string.h with non-GNU libraries
+ because there are many ways it can cause trouble.
+ On some systems, it contains special magic macros that don't work
+ in GCC. */
+#include <string.h>
+#define my_index strchr
+#else
+
+/* Avoid depending on library functions or files
+ whose names are inconsistent. */
+
+char *getenv ();
+
+static char *
+my_index (str, chr)
+ const char *str;
+ int chr;
+{
+ while (*str)
+ {
+ if (*str == chr)
+ return (char *) str;
+ str++;
+ }
+ return 0;
+}
+
+/* If using GCC, we can safely declare strlen this way.
+ If not using GCC, it is ok not to declare it. */
+#ifdef __GNUC__
+/* Note that Motorola Delta 68k R3V7 comes with GCC but not stddef.h.
+ That was relevant to code that was here before. */
+#if !defined (__STDC__) || !__STDC__
+/* gcc with -traditional declares the built-in strlen to return int,
+ and has done so at least since version 2.4.5. -- rms. */
+extern int strlen (const char *);
+#endif /* not __STDC__ */
+#endif /* __GNUC__ */
+
+#endif /* not __GNU_LIBRARY__ */
+
+/* Handle permutation of arguments. */
+
+/* Describe the part of ARGV that contains non-options that have
+ been skipped. `first_nonopt' is the index in ARGV of the first of them;
+ `last_nonopt' is the index after the last of them. */
+
+static int first_nonopt;
+static int last_nonopt;
+
+/* Exchange two adjacent subsequences of ARGV.
+ One subsequence is elements [first_nonopt,last_nonopt)
+ which contains all the non-options that have been skipped so far.
+ The other is elements [last_nonopt,optind), which contains all
+ the options processed since those non-options were skipped.
+
+ `first_nonopt' and `last_nonopt' are relocated so that they describe
+ the new indices of the non-options in ARGV after they are moved. */
+
+static void
+exchange (argv)
+ char **argv;
+{
+ int bottom = first_nonopt;
+ int middle = last_nonopt;
+ int top = optind;
+ char *tem;
+
+ /* Exchange the shorter segment with the far end of the longer segment.
+ That puts the shorter segment into the right place.
+ It leaves the longer segment in the right place overall,
+ but it consists of two parts that need to be swapped next. */
+
+ while (top > middle && middle > bottom)
+ {
+ if (top - middle > middle - bottom)
+ {
+ /* Bottom segment is the short one. */
+ int len = middle - bottom;
+ register int i;
+
+ /* Swap it with the top part of the top segment. */
+ for (i = 0; i < len; i++)
+ {
+ tem = argv[bottom + i];
+ argv[bottom + i] = argv[top - (middle - bottom) + i];
+ argv[top - (middle - bottom) + i] = tem;
+ }
+ /* Exclude the moved bottom segment from further swapping. */
+ top -= len;
+ }
+ else
+ {
+ /* Top segment is the short one. */
+ int len = top - middle;
+ register int i;
+
+ /* Swap it with the bottom part of the bottom segment. */
+ for (i = 0; i < len; i++)
+ {
+ tem = argv[bottom + i];
+ argv[bottom + i] = argv[middle + i];
+ argv[middle + i] = tem;
+ }
+ /* Exclude the moved top segment from further swapping. */
+ bottom += len;
+ }
+ }
+
+ /* Update records for the slots the non-options now occupy. */
+
+ first_nonopt += (optind - last_nonopt);
+ last_nonopt = optind;
+}
+
+/* Initialize the internal data when the first call is made. */
+
+static const char *
+_getopt_initialize (optstring)
+ const char *optstring;
+{
+ /* Start processing options with ARGV-element 1 (since ARGV-element 0
+ is the program name); the sequence of previously skipped
+ non-option ARGV-elements is empty. */
+
+ first_nonopt = last_nonopt = optind = 1;
+
+ nextchar = NULL;
+
+ posixly_correct = getenv ("POSIXLY_CORRECT");
+
+ /* Determine how to handle the ordering of options and nonoptions. */
+
+ if (optstring[0] == '-')
+ {
+ ordering = RETURN_IN_ORDER;
+ ++optstring;
+ }
+ else if (optstring[0] == '+')
+ {
+ ordering = REQUIRE_ORDER;
+ ++optstring;
+ }
+ else if (posixly_correct != NULL)
+ ordering = REQUIRE_ORDER;
+ else
+ ordering = PERMUTE;
+
+ return optstring;
+}
+
+/* Scan elements of ARGV (whose length is ARGC) for option characters
+ given in OPTSTRING.
+
+ If an element of ARGV starts with '-', and is not exactly "-" or "--",
+ then it is an option element. The characters of this element
+ (aside from the initial '-') are option characters. If `getopt'
+ is called repeatedly, it returns successively each of the option characters
+ from each of the option elements.
+
+ If `getopt' finds another option character, it returns that character,
+ updating `optind' and `nextchar' so that the next call to `getopt' can
+ resume the scan with the following option character or ARGV-element.
+
+ If there are no more option characters, `getopt' returns `EOF'.
+ Then `optind' is the index in ARGV of the first ARGV-element
+ that is not an option. (The ARGV-elements have been permuted
+ so that those that are not options now come last.)
+
+ OPTSTRING is a string containing the legitimate option characters.
+ If an option character is seen that is not listed in OPTSTRING,
+ return '?' after printing an error message. If you set `opterr' to
+ zero, the error message is suppressed but we still return '?'.
+
+ If a char in OPTSTRING is followed by a colon, that means it wants an arg,
+ so the following text in the same ARGV-element, or the text of the following
+ ARGV-element, is returned in `optarg'. Two colons mean an option that
+ wants an optional arg; if there is text in the current ARGV-element,
+ it is returned in `optarg', otherwise `optarg' is set to zero.
+
+ If OPTSTRING starts with `-' or `+', it requests different methods of
+ handling the non-option ARGV-elements.
+ See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above.
+
+ Long-named options begin with `--' instead of `-'.
+ Their names may be abbreviated as long as the abbreviation is unique
+ or is an exact match for some defined option. If they have an
+ argument, it follows the option name in the same ARGV-element, separated
+ from the option name by a `=', or else the in next ARGV-element.
+ When `getopt' finds a long-named option, it returns 0 if that option's
+ `flag' field is nonzero, the value of the option's `val' field
+ if the `flag' field is zero.
+
+ The elements of ARGV aren't really const, because we permute them.
+ But we pretend they're const in the prototype to be compatible
+ with other systems.
+
+ LONGOPTS is a vector of `struct option' terminated by an
+ element containing a name which is zero.
+
+ LONGIND returns the index in LONGOPT of the long-named option found.
+ It is only valid when a long-named option has been found by the most
+ recent call.
+
+ If LONG_ONLY is nonzero, '-' as well as '--' can introduce
+ long-named options. */
+
+int
+_getopt_internal (argc, argv, optstring, longopts, longind, long_only)
+ int argc;
+ char *const *argv;
+ const char *optstring;
+ const struct option *longopts;
+ int *longind;
+ int long_only;
+{
+ optarg = NULL;
+
+ if (optind == 0)
+ {
+ optstring = _getopt_initialize (optstring);
+ optind = 1; /* Don't scan ARGV[0], the program name. */
+ }
+
+ if (nextchar == NULL || *nextchar == '\0')
+ {
+ /* Advance to the next ARGV-element. */
+
+ if (ordering == PERMUTE)
+ {
+ /* If we have just processed some options following some non-options,
+ exchange them so that the options come first. */
+
+ if (first_nonopt != last_nonopt && last_nonopt != optind)
+ exchange ((char **) argv);
+ else if (last_nonopt != optind)
+ first_nonopt = optind;
+
+ /* Skip any additional non-options
+ and extend the range of non-options previously skipped. */
+
+ while (optind < argc
+ && (argv[optind][0] != '-' || argv[optind][1] == '\0'))
+ optind++;
+ last_nonopt = optind;
+ }
+
+ /* The special ARGV-element `--' means premature end of options.
+ Skip it like a null option,
+ then exchange with previous non-options as if it were an option,
+ then skip everything else like a non-option. */
+
+ if (optind != argc && !strcmp (argv[optind], "--"))
+ {
+ optind++;
+
+ if (first_nonopt != last_nonopt && last_nonopt != optind)
+ exchange ((char **) argv);
+ else if (first_nonopt == last_nonopt)
+ first_nonopt = optind;
+ last_nonopt = argc;
+
+ optind = argc;
+ }
+
+ /* If we have done all the ARGV-elements, stop the scan
+ and back over any non-options that we skipped and permuted. */
+
+ if (optind == argc)
+ {
+ /* Set the next-arg-index to point at the non-options
+ that we previously skipped, so the caller will digest them. */
+ if (first_nonopt != last_nonopt)
+ optind = first_nonopt;
+ return EOF;
+ }
+
+ /* If we have come to a non-option and did not permute it,
+ either stop the scan or describe it to the caller and pass it by. */
+
+ if ((argv[optind][0] != '-' || argv[optind][1] == '\0'))
+ {
+ if (ordering == REQUIRE_ORDER)
+ return EOF;
+ optarg = argv[optind++];
+ return 1;
+ }
+
+ /* We have found another option-ARGV-element.
+ Skip the initial punctuation. */
+
+ nextchar = (argv[optind] + 1
+ + (longopts != NULL && argv[optind][1] == '-'));
+ }
+
+ /* Decode the current option-ARGV-element. */
+
+ /* Check whether the ARGV-element is a long option.
+
+ If long_only and the ARGV-element has the form "-f", where f is
+ a valid short option, don't consider it an abbreviated form of
+ a long option that starts with f. Otherwise there would be no
+ way to give the -f short option.
+
+ On the other hand, if there's a long option "fubar" and
+ the ARGV-element is "-fu", do consider that an abbreviation of
+ the long option, just like "--fu", and not "-f" with arg "u".
+
+ This distinction seems to be the most useful approach. */
+
+ if (longopts != NULL
+ && (argv[optind][1] == '-'
+ || (long_only && (argv[optind][2] || !my_index (optstring, argv[optind][1])))))
+ {
+ char *nameend;
+ const struct option *p;
+ const struct option *pfound = NULL;
+ int exact = 0;
+ int ambig = 0;
+ int indfound;
+ int option_index;
+
+ for (nameend = nextchar; *nameend && *nameend != '='; nameend++)
+ /* Do nothing. */ ;
+
+ /* Test all long options for either exact match
+ or abbreviated matches. */
+ for (p = longopts, option_index = 0; p->name; p++, option_index++)
+ if (!strncmp (p->name, nextchar, nameend - nextchar))
+ {
+ if (nameend - nextchar == strlen (p->name))
+ {
+ /* Exact match found. */
+ pfound = p;
+ indfound = option_index;
+ exact = 1;
+ break;
+ }
+ else if (pfound == NULL)
+ {
+ /* First nonexact match found. */
+ pfound = p;
+ indfound = option_index;
+ }
+ else
+ /* Second or later nonexact match found. */
+ ambig = 1;
+ }
+
+ if (ambig && !exact)
+ {
+ if (opterr)
+ fprintf (stderr, gettext ("%s: option `%s' is ambiguous\n"),
+ argv[0], argv[optind]);
+ nextchar += strlen (nextchar);
+ optind++;
+ return '?';
+ }
+
+ if (pfound != NULL)
+ {
+ option_index = indfound;
+ optind++;
+ if (*nameend)
+ {
+ /* Don't test has_arg with >, because some C compilers don't
+ allow it to be used on enums. */
+ if (pfound->has_arg)
+ optarg = nameend + 1;
+ else
+ {
+ if (opterr)
+ if (argv[optind - 1][1] == '-')
+ /* --option */
+ fprintf (stderr,
+ gettext ("%s: option `--%s' doesn't allow an argument\n"),
+ argv[0], pfound->name);
+ else
+ /* +option or -option */
+ fprintf (stderr,
+ gettext ("%s: option `%c%s' doesn't allow an argument\n"),
+ argv[0], argv[optind - 1][0], pfound->name);
+
+ nextchar += strlen (nextchar);
+ return '?';
+ }
+ }
+ else if (pfound->has_arg == 1)
+ {
+ if (optind < argc)
+ optarg = argv[optind++];
+ else
+ {
+ if (opterr)
+ fprintf (stderr,
+ gettext ("%s: option `%s' requires an argument\n"),
+ argv[0], argv[optind - 1]);
+ nextchar += strlen (nextchar);
+ return optstring[0] == ':' ? ':' : '?';
+ }
+ }
+ nextchar += strlen (nextchar);
+ if (longind != NULL)
+ *longind = option_index;
+ if (pfound->flag)
+ {
+ *(pfound->flag) = pfound->val;
+ return 0;
+ }
+ return pfound->val;
+ }
+
+ /* Can't find it as a long option. If this is not getopt_long_only,
+ or the option starts with '--' or is not a valid short
+ option, then it's an error.
+ Otherwise interpret it as a short option. */
+ if (!long_only || argv[optind][1] == '-'
+ || my_index (optstring, *nextchar) == NULL)
+ {
+ if (opterr)
+ {
+ if (argv[optind][1] == '-')
+ /* --option */
+ fprintf (stderr, gettext ("%s: unrecognized option `--%s'\n"),
+ argv[0], nextchar);
+ else
+ /* +option or -option */
+ fprintf (stderr, gettext ("%s: unrecognized option `%c%s'\n"),
+ argv[0], argv[optind][0], nextchar);
+ }
+ nextchar = (char *) "";
+ optind++;
+ return '?';
+ }
+ }
+
+ /* Look at and handle the next short option-character. */
+
+ {
+ char c = *nextchar++;
+ char *temp = my_index (optstring, c);
+
+ /* Increment `optind' when we start to process its last character. */
+ if (*nextchar == '\0')
+ ++optind;
+
+ if (temp == NULL || c == ':')
+ {
+ if (opterr)
+ {
+ if (posixly_correct)
+ /* 1003.2 specifies the format of this message. */
+ fprintf (stderr, gettext ("%s: illegal option -- %c\n"),
+ argv[0], c);
+ else
+ fprintf (stderr, gettext ("%s: invalid option -- %c\n"),
+ argv[0], c);
+ }
+ optopt = c;
+ return '?';
+ }
+ if (temp[1] == ':')
+ {
+ if (temp[2] == ':')
+ {
+ /* This is an option that accepts an argument optionally. */
+ if (*nextchar != '\0')
+ {
+ optarg = nextchar;
+ optind++;
+ }
+ else
+ optarg = NULL;
+ nextchar = NULL;
+ }
+ else
+ {
+ /* This is an option that requires an argument. */
+ if (*nextchar != '\0')
+ {
+ optarg = nextchar;
+ /* If we end this ARGV-element by taking the rest as an arg,
+ we must advance to the next element now. */
+ optind++;
+ }
+ else if (optind == argc)
+ {
+ if (opterr)
+ {
+ /* 1003.2 specifies the format of this message. */
+ fprintf (stderr,
+ gettext ("%s: option requires an argument -- %c\n"),
+ argv[0], c);
+ }
+ optopt = c;
+ if (optstring[0] == ':')
+ c = ':';
+ else
+ c = '?';
+ }
+ else
+ /* We already incremented `optind' once;
+ increment it again when taking next ARGV-elt as argument. */
+ optarg = argv[optind++];
+ nextchar = NULL;
+ }
+ }
+ return c;
+ }
+}
+
+int
+getopt (argc, argv, optstring)
+ int argc;
+ char *const *argv;
+ const char *optstring;
+{
+ return _getopt_internal (argc, argv, optstring,
+ (const struct option *) 0,
+ (int *) 0,
+ 0);
+}
+
+#endif /* _LIBC or not __GNU_LIBRARY__. */
+
+#ifdef TEST
+
+/* Compile with -DTEST to make an executable for use in testing
+ the above definition of `getopt'. */
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ int c;
+ int digit_optind = 0;
+
+ while (1)
+ {
+ int this_option_optind = optind ? optind : 1;
+
+ c = getopt (argc, argv, "abc:d:0123456789");
+ if (c == EOF)
+ break;
+
+ switch (c)
+ {
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ if (digit_optind != 0 && digit_optind != this_option_optind)
+ printf ("digits occur in two different argv-elements.\n");
+ digit_optind = this_option_optind;
+ printf ("option %c\n", c);
+ break;
+
+ case 'a':
+ printf ("option a\n");
+ break;
+
+ case 'b':
+ printf ("option b\n");
+ break;
+
+ case 'c':
+ printf ("option c with value `%s'\n", optarg);
+ break;
+
+ case '?':
+ break;
+
+ default:
+ printf ("?? getopt returned character code 0%o ??\n", c);
+ }
+ }
+
+ if (optind < argc)
+ {
+ printf ("non-option ARGV-elements: ");
+ while (optind < argc)
+ printf ("%s ", argv[optind++]);
+ printf ("\n");
+ }
+
+ exit (0);
+}
+
+#endif /* TEST */
diff --git a/texinfo/libtxi/getopt.h b/texinfo/libtxi/getopt.h
new file mode 100644
index 00000000000..952f4830d3d
--- /dev/null
+++ b/texinfo/libtxi/getopt.h
@@ -0,0 +1,129 @@
+/* Declarations for getopt.
+ Copyright (C) 1989, 90, 91, 92, 93, 94 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifndef _GETOPT_H
+#define _GETOPT_H 1
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* For communication from `getopt' to the caller.
+ When `getopt' finds an option that takes an argument,
+ the argument value is returned here.
+ Also, when `ordering' is RETURN_IN_ORDER,
+ each non-option ARGV-element is returned here. */
+
+extern char *optarg;
+
+/* Index in ARGV of the next element to be scanned.
+ This is used for communication to and from the caller
+ and for communication between successive calls to `getopt'.
+
+ On entry to `getopt', zero means this is the first call; initialize.
+
+ When `getopt' returns EOF, this is the index of the first of the
+ non-option elements that the caller should itself scan.
+
+ Otherwise, `optind' communicates from one call to the next
+ how much of ARGV has been scanned so far. */
+
+extern int optind;
+
+/* Callers store zero here to inhibit the error message `getopt' prints
+ for unrecognized options. */
+
+extern int opterr;
+
+/* Set to an option character which was unrecognized. */
+
+extern int optopt;
+
+/* Describe the long-named options requested by the application.
+ The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
+ of `struct option' terminated by an element containing a name which is
+ zero.
+
+ The field `has_arg' is:
+ no_argument (or 0) if the option does not take an argument,
+ required_argument (or 1) if the option requires an argument,
+ optional_argument (or 2) if the option takes an optional argument.
+
+ If the field `flag' is not NULL, it points to a variable that is set
+ to the value given in the field `val' when the option is found, but
+ left unchanged if the option is not found.
+
+ To have a long-named option do something other than set an `int' to
+ a compiled-in constant, such as set a value from `optarg', set the
+ option's `flag' field to zero and its `val' field to a nonzero
+ value (the equivalent single-letter option character, if there is
+ one). For long options that have a zero `flag' field, `getopt'
+ returns the contents of the `val' field. */
+
+struct option
+{
+#if defined (__STDC__) && __STDC__
+ const char *name;
+#else
+ char *name;
+#endif
+ /* has_arg can't be an enum because some compilers complain about
+ type mismatches in all the code that assumes it is an int. */
+ int has_arg;
+ int *flag;
+ int val;
+};
+
+/* Names for the values of the `has_arg' field of `struct option'. */
+
+#define no_argument 0
+#define required_argument 1
+#define optional_argument 2
+
+#if defined (__STDC__) && __STDC__
+#ifdef __GNU_LIBRARY__
+/* Many other libraries have conflicting prototypes for getopt, with
+ differences in the consts, in stdlib.h. To avoid compilation
+ errors, only prototype getopt for the GNU C library. */
+extern int getopt (int argc, char *const *argv, const char *shortopts);
+#else /* not __GNU_LIBRARY__ */
+extern int getopt ();
+#endif /* __GNU_LIBRARY__ */
+extern int getopt_long (int argc, char *const *argv, const char *shortopts,
+ const struct option *longopts, int *longind);
+extern int getopt_long_only (int argc, char *const *argv,
+ const char *shortopts,
+ const struct option *longopts, int *longind);
+
+/* Internal only. Users should not call this directly. */
+extern int _getopt_internal (int argc, char *const *argv,
+ const char *shortopts,
+ const struct option *longopts, int *longind,
+ int long_only);
+#else /* not __STDC__ */
+extern int getopt ();
+extern int getopt_long ();
+extern int getopt_long_only ();
+
+extern int _getopt_internal ();
+#endif /* __STDC__ */
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _GETOPT_H */
diff --git a/texinfo/libtxi/getopt1.c b/texinfo/libtxi/getopt1.c
new file mode 100644
index 00000000000..7cf0bfb0138
--- /dev/null
+++ b/texinfo/libtxi/getopt1.c
@@ -0,0 +1,180 @@
+/* getopt_long and getopt_long_only entry points for GNU getopt.
+ Copyright (C) 1987, 88, 89, 90, 91, 92, 1993, 1994
+ Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include "getopt.h"
+
+#if !defined (__STDC__) || !__STDC__
+/* This is a separate conditional since some stdc systems
+ reject `defined (const)'. */
+#ifndef const
+#define const
+#endif
+#endif
+
+#include <stdio.h>
+
+/* Comment out all this code if we are using the GNU C Library, and are not
+ actually compiling the library itself. This code is part of the GNU C
+ Library, but also included in many other GNU distributions. Compiling
+ and linking in this code is a waste when using the GNU C library
+ (especially if it is a shared library). Rather than having every GNU
+ program understand `configure --with-gnu-libc' and omit the object files,
+ it is simpler to just do this in the source for each such file. */
+
+#if defined (_LIBC) || !defined (__GNU_LIBRARY__)
+
+
+/* This needs to come after some library #include
+ to get __GNU_LIBRARY__ defined. */
+#ifdef __GNU_LIBRARY__
+#include <stdlib.h>
+#else
+char *getenv ();
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+int
+getopt_long (argc, argv, options, long_options, opt_index)
+ int argc;
+ char *const *argv;
+ const char *options;
+ const struct option *long_options;
+ int *opt_index;
+{
+ return _getopt_internal (argc, argv, options, long_options, opt_index, 0);
+}
+
+/* Like getopt_long, but '-' as well as '--' can indicate a long option.
+ If an option that starts with '-' (not '--') doesn't match a long option,
+ but does match a short option, it is parsed as a short option
+ instead. */
+
+int
+getopt_long_only (argc, argv, options, long_options, opt_index)
+ int argc;
+ char *const *argv;
+ const char *options;
+ const struct option *long_options;
+ int *opt_index;
+{
+ return _getopt_internal (argc, argv, options, long_options, opt_index, 1);
+}
+
+
+#endif /* _LIBC or not __GNU_LIBRARY__. */
+
+#ifdef TEST
+
+#include <stdio.h>
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ int c;
+ int digit_optind = 0;
+
+ while (1)
+ {
+ int this_option_optind = optind ? optind : 1;
+ int option_index = 0;
+ static struct option long_options[] =
+ {
+ {"add", 1, 0, 0},
+ {"append", 0, 0, 0},
+ {"delete", 1, 0, 0},
+ {"verbose", 0, 0, 0},
+ {"create", 0, 0, 0},
+ {"file", 1, 0, 0},
+ {0, 0, 0, 0}
+ };
+
+ c = getopt_long (argc, argv, "abc:d:0123456789",
+ long_options, &option_index);
+ if (c == EOF)
+ break;
+
+ switch (c)
+ {
+ case 0:
+ printf ("option %s", long_options[option_index].name);
+ if (optarg)
+ printf (" with arg %s", optarg);
+ printf ("\n");
+ break;
+
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ if (digit_optind != 0 && digit_optind != this_option_optind)
+ printf ("digits occur in two different argv-elements.\n");
+ digit_optind = this_option_optind;
+ printf ("option %c\n", c);
+ break;
+
+ case 'a':
+ printf ("option a\n");
+ break;
+
+ case 'b':
+ printf ("option b\n");
+ break;
+
+ case 'c':
+ printf ("option c with value `%s'\n", optarg);
+ break;
+
+ case 'd':
+ printf ("option d with value `%s'\n", optarg);
+ break;
+
+ case '?':
+ break;
+
+ default:
+ printf ("?? getopt returned character code 0%o ??\n", c);
+ }
+ }
+
+ if (optind < argc)
+ {
+ printf ("non-option ARGV-elements: ");
+ while (optind < argc)
+ printf ("%s ", argv[optind++]);
+ printf ("\n");
+ }
+
+ exit (0);
+}
+
+#endif /* TEST */
diff --git a/texinfo/libtxi/memcpy.c b/texinfo/libtxi/memcpy.c
new file mode 100644
index 00000000000..521625464cd
--- /dev/null
+++ b/texinfo/libtxi/memcpy.c
@@ -0,0 +1,20 @@
+/* Copy LEN bytes starting at SRCADDR to DESTADDR. Result undefined
+ if the source overlaps with the destination.
+ Return DESTADDR. */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+char *
+memcpy (destaddr, srcaddr, len)
+ char *destaddr;
+ const char *srcaddr;
+ int len;
+{
+ char *dest = destaddr;
+
+ while (len-- > 0)
+ *destaddr++ = *srcaddr++;
+ return dest;
+}
diff --git a/texinfo/libtxi/memmove.c b/texinfo/libtxi/memmove.c
new file mode 100644
index 00000000000..d7bdd7cd995
--- /dev/null
+++ b/texinfo/libtxi/memmove.c
@@ -0,0 +1,24 @@
+/* memmove.c -- copy memory.
+ Copy LENGTH bytes from SOURCE to DEST. Does not null-terminate.
+ In the public domain.
+ By David MacKenzie <djm@gnu.ai.mit.edu>. */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+void
+memmove (dest, source, length)
+ char *dest;
+ const char *source;
+ unsigned length;
+{
+ if (source < dest)
+ /* Moving from low mem to hi mem; start at end. */
+ for (source += length, dest += length; length; --length)
+ *--dest = *--source;
+ else if (source != dest)
+ /* Moving from hi mem to low mem; start at beginning. */
+ for (; length; --length)
+ *dest++ = *source++;
+}
diff --git a/texinfo/libtxi/strdup.c b/texinfo/libtxi/strdup.c
new file mode 100644
index 00000000000..1d60f13948a
--- /dev/null
+++ b/texinfo/libtxi/strdup.c
@@ -0,0 +1,43 @@
+/* strdup.c -- return a newly allocated copy of a string
+ Copyright (C) 1990 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#ifdef STDC_HEADERS
+#include <string.h>
+#include <stdlib.h>
+#else
+char *malloc ();
+char *strcpy ();
+#endif
+
+/* Return a newly allocated copy of STR,
+ or 0 if out of memory. */
+
+char *
+strdup (str)
+ const char *str;
+{
+ char *newstr;
+
+ newstr = (char *) malloc (strlen (str) + 1);
+ if (newstr)
+ strcpy (newstr, str);
+ return newstr;
+}
diff --git a/texinfo/license.texi b/texinfo/license.texi
new file mode 100644
index 00000000000..c23a4dc8095
--- /dev/null
+++ b/texinfo/license.texi
@@ -0,0 +1,24 @@
+\input texinfo
+@setfilename license.info
+
+@ifinfo
+@format
+START-INFO-DIR-ENTRY
+* COPYING: (license). The GNU General Public License
+END-INFO-DIR-ENTRY
+@end format
+@end ifinfo
+
+@settitle GPL
+@iftex
+@headings doubleafter
+@setchapternewpage off
+@end iftex
+@finalout
+
+@node Top, , (dir), (dir)
+@unnumbered GNU GENERAL PUBLIC LICENSE
+
+@include gpl.texinfo
+
+@bye
diff --git a/texinfo/makeinfo/Makefile.in b/texinfo/makeinfo/Makefile.in
new file mode 100644
index 00000000000..fe81fcdff5e
--- /dev/null
+++ b/texinfo/makeinfo/Makefile.in
@@ -0,0 +1,116 @@
+# Makefile for GNU makeinfo.
+# $Id: Makefile.in,v 1.1 1997/08/21 22:58:07 jason Exp $
+#
+# Copyright (C) 1993, 96 Free Software Foundation, Inc.
+
+# This program 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.
+
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#### Start of system configuration section. ####
+
+srcdir = @srcdir@
+VPATH = $(srcdir):$(common)
+
+common = $(srcdir)/../libtxi
+
+EXEEXT = @EXEEXT@
+CC = @CC@
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+LN = ln
+RM = rm -f
+MKDIR = mkdir
+
+DEFS = @DEFS@
+LIBS = -L../libtxi -ltxi @LIBS@
+LOADLIBES = $(LIBS)
+
+SHELL = /bin/sh
+
+CFLAGS = @CFLAGS@
+LDFLAGS = @LDFLAGS@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+# Prefix for each installed program, normally empty or `g'.
+binprefix =
+infodir = @infodir@
+
+#### End of system configuration section. ####
+
+SRCS = makeinfo.c multi.c
+OBJS = makeinfo.o multi.o
+
+PROGS = makeinfo$(EXEEXT)
+
+all: $(PROGS) makeinfo.info
+sub-all: all
+
+.c.o:
+ $(CC) -c $(CPPFLAGS) -I. -I$(srcdir) -I$(common) $(DEFS) $(CFLAGS) $<
+
+makeinfo$(EXEEXT): $(OBJS) ../libtxi/libtxi.a
+ $(CC) $(LDFLAGS) -o makeinfo $(OBJS) $(LOADLIBES)
+
+../libtxi/libtxi.a:
+ (cd ../libtxi && $(MAKE) $(MFLAGS) libtxi.a)
+
+makeinfo.o: makeinfo.c $(common)/getopt.h
+
+$(OBJS): makeinfo.h
+
+info makeinfo.info: ./makeinfo makeinfo.texi #macro.texi
+ ./makeinfo --no-split -I$(srcdir) makeinfo.texi
+
+# makeinfo.texi: ./makeinfo makeinfo.mki
+# ./makeinfo -E makeinfo.texi -I$(srcdir) makeinfo.mki
+
+dvi makeinfo.dvi: ./makeinfo makeinfo.texi #macro.texi
+ $(srcdir)/../util/texi2dvi makeinfo.txi
+
+install: all
+ $(INSTALL_PROGRAM) makeinfo$(EXEEXT) $(bindir)/$(binprefix)makeinfo$(EXEEXT)
+ -d=$(srcdir); test -f ./makeinfo.info && d=.; $(INSTALL_DATA) $$d/makeinfo.info $(infodir)/makeinfo.info
+ $(POST_INSTALL)
+
+install-info:
+ -d=$(srcdir); test -f ./makeinfo.info && d=.; $(INSTALL_DATA) $$d/makeinfo.info $(infodir)/makeinfo.info
+ ../util/install-info --info-dir=$(infodir) $(infodir)/makeinfo.info
+
+uninstall:
+ for f in $(PROGS); do rm -f $(bindir)/$(binprefix)$$f; done
+ rm -f $(infodir)/makeinfo.info
+
+TAGS: $(SRCS)
+ etags $(SRCS)
+
+clean:
+ rm -f *.o a.out core core.* $(PROGS)
+
+mostlyclean: clean
+
+distclean: clean
+ rm -f TAGS Makefile config.status *.info */*.info
+
+realclean: distclean
+maintainer-clean: distclean
+
+Makefile: Makefile.in ../config.status
+ cd .. && sh config.status
+
+# Prevent GNU make v3 from overflowing arg limit on SysV.
+.NOEXPORT:
diff --git a/texinfo/makeinfo/macro.texi b/texinfo/makeinfo/macro.texi
new file mode 100644
index 00000000000..8a3fe802392
--- /dev/null
+++ b/texinfo/makeinfo/macro.texi
@@ -0,0 +1,177 @@
+@c This file is included in makeinfo.texi.
+@c
+@ifinfo
+@comment Here are some useful examples of the macro facility.
+
+@c Simply insert the right version of the texinfo name.
+@macro texinfo{}
+TeXinfo
+@end macro
+
+@macro dfn{text}
+@dfn{\text\}
+@cpindex \text\
+@end macro
+
+@c Define a macro which expands to a pretty version of the name of the
+@c Makeinfo program.
+@macro makeinfo{}
+@code{Makeinfo}
+@end macro
+
+@c Define a macro which is used to define other macros. This one makes
+@c a macro which creates a node and gives it a sectioning command. Note
+@c that the created macro uses the original definition within the
+@c expansion text. This takes advantage of the non-recursion feature of
+@c macro execution.
+@macro node_define{orig-name}
+@macro \orig-name\{title}
+@node \title\
+@\orig-name\ \title\
+@end macro
+@end macro
+
+@c Now actually define a new set of sectioning commands.
+@node_define {chapter}
+@node_define {section}
+@node_define {subsection}
+@end ifinfo
+
+@chapter The Macro Facility
+
+This chapter describes the new macro facility.
+
+A @dfn{macro} is a command that you define in terms of other commands.
+It doesn't exist as a @texinfo{} command until you define it as part of
+the input file to @makeinfo{}. Once the command exists, it behaves much
+as any other @texinfo{} command. Macros are a useful way to ease the
+details and tedium of writing a `correct' info file. The following
+sections explain how to write and invoke macros.
+
+@menu
+* How to Use Macros in @texinfo{}::
+ How to use the macro facility.
+
+* Using Macros Recursively::
+ How to write a macro which does (or doesn't) recurse.
+
+* Using @texinfo{} Macros As Arguments::
+ Passing a macro as an argument.
+@end menu
+
+@section How to Use Macros in @texinfo{}
+
+Using macros in @texinfo{} is easy. First you define the macro. After
+that, the macro command is available as a normal @texinfo{} command.
+Here is what a definition looks like:
+
+@example
+@@macro @var{name}@{@var{arg1}, @var{@dots{}} @var{argn}@}
+@var{@texinfo{} commands@dots{}}
+@@end macro
+@end example
+
+The arguments that you specify that the macro takes are expanded with
+the actual parameters used when calling the macro if they are seen
+surrounded by backslashes. For example, here is a definition of
+@code{@@codeitem}, a macro which can be used wherever @code{@@item} can
+be used, but which surrounds its argument with @code{@@code@{@dots{}@}}.
+
+@example
+@@macro codeitem@{item@}
+@@item @@code@{\item\@}
+@@end macro
+@end example
+
+When the macro is expanded, all of the text between the @code{@@macro}
+and @code{@@end macro} is inserted into the document at the expansion
+point, with the actual parameters substituted for the named parameters.
+So, a call to the above macro might look like:
+
+@example
+@@codeitem@{Foo@}
+@end example
+
+and @makeinfo{} would execute the following code:
+
+@example
+@@item @@code@{Foo@}
+@end example
+
+A special case is made for macros which only take a single argument, and
+which are invoked without any brace characters (i.e.,
+@samp{@{}@dots{}@samp{@}}) surrounding an argument; the rest of the line
+is supplied as is as the sole argument to the macro. This special case
+allows one to redefine some standard @texinfo{} commands without
+modifying the input file. Along with the non-recursive action of macro
+invocation, one can easily redefine the sectioning commands to also
+provide index entries:
+
+@example
+@@macro chapter@{name@}
+@@chapter \name\
+@@findex \name\
+@@end macro
+@end example
+
+Thus, the text:
+
+@example
+@@chapter strlen
+@end example
+
+will expand to:
+
+@example
+@@chapter strlen
+@@findex strlen
+@end example
+
+@section Using Macros Recursively
+
+Normally, while a particular macro is executing, any call to that macro
+will be seen as a call to a builtin @texinfo{} command. This allows one
+to redefine a builtin @texinfo{} command as a macro, and then use that
+command within the definition of the macro itself. For example, one
+might wish to make sure that whereever a term was defined with
+@code{@@dfn@{@dots{}@}}, the location of the definition would appear
+in the concept index for the manual. Here is a macro which redefines
+@code{@@dfn} to do just that:
+
+@example
+@@macro dfn@{text@}
+@@dfn@{\text\@}
+@@cpindex \text\
+@@end macro
+@end example
+
+Note that we used the builtin @texinfo{} command @code{@@dfn} within our
+overriding macro definition.
+
+This behaviour itself can be overridden for macro execution by writing a
+special @dfn{macro control command} in the definition of the macro. The
+command is considered special because it doesn't affect the output text
+directly, rather, it affects the way in which the macro is defined. One
+such special command is @code{@@allow-recursion}.
+
+@example
+@@macro silly@{arg@}
+@@allow-recursion
+\arg\
+@@end macro
+@end example
+
+Now @code{@@silly} is a macro that can be used within a call to itself:
+
+@example
+This text @@silly@{@@silly@{some text@}@} is ``some text''.
+@end example
+
+@section Using @texinfo{} Macros As Arguments
+
+@printindex cp
+How to use @texinfo{} macros as arguments to other @texinfo{} macros.
+
+@bye
+
+
diff --git a/texinfo/makeinfo/macros/example.texi b/texinfo/makeinfo/macros/example.texi
new file mode 100644
index 00000000000..d3554ff3ddc
--- /dev/null
+++ b/texinfo/makeinfo/macros/example.texi
@@ -0,0 +1,224 @@
+\input texinfo @c -*-texinfo-*-
+@comment %**start of header
+@setfilename example.info
+@set VERSION 1.58
+@paragraphindent none
+@comment %**end of header
+
+@include simpledoc.texi
+
+@document {@makeinfo{}, Brian J. Fox,
+This file is an extract from the @cite{@texinfo{}} manual.@*
+It documents @makeinfo{}\, a program that converts @texinfo{} files into
+Info files.
+}
+
+@menu
+* What is @makeinfo{}?::
+* Controlling Paragraph Formats::
+* Command Line Options::
+* Pointer Validation::
+@end menu
+
+@section What is @makeinfo{}?
+
+@iftex
+This file documents the use of the @code{makeinfo} program, versions
+@value{VERSION} and later. It is an extract from the @cite{TeXinfo} manual.
+@end iftex
+
+@makeinfo{} is a program for converting @dfn{@texinfo{}} files into
+@dfn{@Info{}} files. @texinfo{} is a documentation system that uses a
+single source file to produce both on-line information and printed output.
+
+You can read the on-line information using @Info{}; type @code{info} to
+learn about @Info{}.
+@ifinfo
+@xref{Top, Texinfo, Overview of Texinfo, texinfo, Texinfo},
+@end ifinfo
+@iftex
+See the @cite{TeXinfo} manual,
+@end iftex
+to learn about the TeXinfo documentation system.
+
+@section Controlling Paragraph Formats
+
+In general, @makeinfo{} @dfn{fills} the paragraphs that it outputs
+to an @Info{} file. Filling is the process of breaking and connecting
+lines so that lines are the same length as or shorter than the number
+specified as the fill column. Lines are broken between words. With
+@makeinfo{}, you can control:
+
+@itemize @bullet
+@item
+The width of each paragraph (the @dfn{fill-column}).
+@item
+The amount of indentation that the first line of
+each paragraph receives (the @dfn{paragraph-indentation}).
+@end itemize
+
+@section Command Line Options
+
+The following command line options are available for @makeinfo{}.
+
+@need 100
+@table @code
+@item -D @var{var}
+Cause @var{var} to be defined. This is equivalent to
+@code{@@set @var{var}} in the Texinfo file.
+
+@need 150
+@item --error-limit @var{limit}
+Set the maximum number of errors that @makeinfo{} will report
+before exiting (on the assumption that continuing would be useless).
+The default number of errors that can be reported before
+@makeinfo{} gives up is 100.@refill
+
+@need 150
+@item --fill-column @var{width}
+Specify the maximum number of columns in a line; this is the right-hand
+edge of a line. Paragraphs that are filled will be filled to this
+width. The default value for @code{fill-column} is 72.
+
+@item --footnote-style @var{style}
+Set the footnote style to @var{style}, either @samp{end} for the end
+node style or @samp{separate} for the separate node style. The value
+set by this option overrides the value set in a Texinfo file by an
+@code{@@footnotestyle} command. When the footnote style is
+@samp{separate}, @makeinfo{} makes a new node containing the
+footnotes found in the current node. When the footnote style is
+@samp{end}, @makeinfo{} places the footnote references at the end
+of the current node.
+
+@need 150
+@item -I @var{dir}
+Add @code{dir} to the directory search list for finding files that are
+included using the @code{@@include} command. By default,
+@makeinfo{} searches only the current directory.
+
+@need 150
+@item --no-headers
+Do not include menus or node lines in the output. This results in an
+@sc{ascii} file that you cannot read in Info since it does not contain
+the requisite nodes or menus; but you can print such a file in a
+single, typewriter-like font and produce acceptable output.
+
+@need 150
+@item --no-split
+Suppress the splitting stage of @makeinfo{}. Normally, large
+output files (where the size is greater than 70k bytes) are split into
+smaller subfiles, each one approximately 50k bytes. If you specify
+@samp{--no-split}, @makeinfo{} will not split up the output
+file.
+
+@need 100
+@item --no-pointer-validate
+@item --no-validate
+Suppress the pointer-validation phase of @makeinfo{}. Normally,
+after a Texinfo file is processed, some consistency checks are made to
+ensure that cross references can be resolved, etc.
+@xref{Pointer Validation}.
+
+@need 150
+@item --no-warn
+Suppress the output of warning messages. This does @emph{not}
+suppress the output of error messages, only warnings. You might
+want this if the file you are creating has examples of Texinfo cross
+references within it, and the nodes that are referenced do not actually
+exist.
+
+@item --no-number-footnotes
+Supress automatic footnote numbering. By default, @makeinfo{}
+numbers each footnote sequentially in a single node, resetting the
+current footnote number to 1 at the start of each node.
+
+@need 150
+@item --output @var{file}
+@itemx -o @var{file}
+Specify that the output should be directed to @var{file} and not to the
+file name specified in the @code{@@setfilename} command found in the Texinfo
+source. @var{file} can be the special token @samp{-}, which specifies
+standard output.
+
+@need 150
+@item --paragraph-indent @var{indent}
+Set the paragraph indentation style to @var{indent}. The value set by
+this option overrides the value set in a Texinfo file by an
+@code{@@paragraphindent} command. The value of @var{indent} is
+interpreted as follows:
+
+@itemize @bullet
+@item
+If the value of @var{indent} is @samp{asis}, do not change the
+existing indentation at the starts of paragraphs.
+
+@item
+If the value of @var{indent} is zero, delete any existing
+indentation.
+
+@item
+If the value of @var{indent} is greater than zero, indent each
+paragraph by that number of spaces.
+@end itemize
+
+@need 100
+@item --reference-limit @var{limit}
+Set the value of the number of references to a node that
+@makeinfo{} will make without reporting a warning. If a node has more
+than this number of references in it, @makeinfo{} will make the
+references but also report a warning.
+
+@need 150
+@item -U @var{var}
+Cause @var{var} to be undefined. This is equivalent to
+@code{@@clear @var{var}} in the Texinfo file.
+
+@need 100
+@item --verbose
+Cause @makeinfo{} to display messages saying what it is doing.
+Normally, @makeinfo{} only outputs messages if there are errors or
+warnings.
+
+@need 100
+@item --version
+Report the version number of this copy of @makeinfo{}.
+@end table
+
+@section Pointer Validation
+@cindex Pointer validation with @makeinfo{}
+@cindex Validation of pointers
+
+If you do not suppress pointer-validation (by using the
+@samp{--no-pointer-validation} option), @makeinfo{}
+will check the validity of the final Info file. Mostly,
+this means ensuring that nodes you have referenced
+really exist. Here is a complete list of what is
+checked:
+
+@enumerate
+@item
+If a `Next', `Previous', or `Up' node reference is a reference to a
+node in the current file and is not an external reference such as to
+@file{(dir)}, then the referenced node must exist.
+
+@item
+In every node, if the `Previous' node is different from the `Up' node,
+then the `Previous' node must also be pointed to by a `Next' node.
+
+@item
+Every node except the `Top' node must have an `Up' pointer.
+
+@item
+The node referenced by an `Up' pointer must contain a reference to the
+current node in some manner other than through a `Next' reference.
+This includes menu entries and cross references.
+
+@item
+If the `Next' reference of a node is not the same as the `Next' reference
+of the `Up' reference, then the node referenced by the `Next' pointer
+must have a `Previous' pointer that points back to the current node.
+This rule allows the last node in a section to point to the first node
+of the next chapter.
+@end enumerate
+
+@bye
diff --git a/texinfo/makeinfo/macros/html.texi b/texinfo/makeinfo/macros/html.texi
new file mode 100644
index 00000000000..60760825c68
--- /dev/null
+++ b/texinfo/makeinfo/macros/html.texi
@@ -0,0 +1,269 @@
+@c html.texi: -*- Texinfo -*- Macros which support HTML output.
+
+@c Copyright (c) 1995 Brian Fox (bfox@ai.mit.edu)
+@c Author: Brian J. Fox (bfox@ai.mit.edu) Sat Apr 1 20:30:54 1995.
+@c
+@c I didn't want to write this myself, because I wanted some HTML wizard
+@c to get everything exactly right. However, rms continues to believe
+@c that the macro system is not a good idea. I couldn't disagree more,
+@c so I am writing this as an example of how useful such macros can be.
+
+@macro html
+@set html
+<html>
+@end macro
+
+@c
+@c The first step is to define the macros which really only have meaning
+@c when producing output for HTML.
+
+@c
+@c @anchor{Brian Fox, http://www.ua.com/users/bfox/}
+@c
+@macro anchor{text, link}
+@ifset html
+<a href="\link\">\text\</a>
+@end ifset
+@ifclear html
+\text\
+@end ifclear
+@end macro
+
+@macro pre{}
+@ifset html
+<pre>
+@end ifset
+@end macro
+
+@macro endpre{}
+@ifset html
+</pre>
+@end ifset
+@end macro
+
+@macro TeX
+@ifset html
+<i>T</i>e<i>X</i>
+@end ifset
+@ifclear html
+@TeX{}
+@end ifclear
+@end macro
+
+@macro paragraph{}
+@ifset html
+<p>
+@end ifset
+@end macro
+
+@c
+@c @email{bfox@@ai.mit.edu}
+@c
+@macro email{address}
+@anchor{mailto:\address\, \address\}
+@end macro
+
+@c
+@c Redefine the TeXinfo commands which have direct HTML counterparts.
+@c
+
+@macro html-define-0arg{command, html-insertion}
+@macro \command\
+@ifset html
+\html-insertion\
+@end ifset
+@ifclear html
+@\command\
+@end ifclear
+@end macro
+@end macro
+
+@macro html-define-1arg{command, html-insertion}
+@macro \command\{arg}
+@ifset html
+\html-insertion\
+@end ifset
+@ifclear html
+@\command\{\arg\}
+@end ifclear
+@end macro
+@end macro
+
+@macro html-define-line{command, html-insertion}
+@macro \command\{line}
+@ifset html
+\html-insertion\
+@end ifset
+@ifclear html
+@\command\ \line\
+@end ifclear
+@end macro
+@end macro
+
+@html-define-0arg{*, <br>}
+@html-define-1arg{b, <b>\\arg\\</b>}
+@html-define-1arg{code, <tt><b>\\arg\\</b></tt>}
+@html-define-line{itemize, <ul>}
+@html-define-line{item,<p><li>}
+@html-define-line{heading,<h1>\\line\\</h1>}
+@html-define-0arg{bye, </html>}
+
+@c
+@c Define into nothing the macros which do nothing in html.
+@c
+@html-define-line{group,}
+
+@c
+@c Define a macro which is used to define other macros. This one makes
+@c a macro which creates an HTML header line. No sectioning commands
+@c are used. This takes advantage of the non-recursion feature of
+@c macro execution.
+@macro node_define{orig-name, header-style}
+@macro \orig-name\{title}
+@ifset html
+@node \title\
+<a name="\title\"><\header-style\>\title\</\header-style\></a>
+@end ifset
+@ifclear html
+@\orig-name\ \title\
+@end ifclear
+@end macro
+@end macro
+
+@c
+@c The same as NODE_DEFINE, but italicized.
+@macro inode_define{orig-name, header-style}
+@macro \orig-name\{title}
+@ifset html
+@node \title\
+<a name="\title\"><\header-style\><i>\title\</i></\header-style\></a>
+@end ifset
+@ifclear html
+@\orig-name\ \title\
+@end ifclear
+@end macro
+@end macro
+
+@c Ignore @node commands.
+@html-define-line{node,}
+
+@c Here is a special one for "@top".
+@macro top{title}
+@end macro
+
+@c Now actually define a new set of sectioning commands.
+@node_define {appendix, h1}
+@node_define {appendixsec, h2}
+@node_define {appendixsubsec, h3}
+@node_define {appendixsubsubsec, h4}
+@node_define {chapter, h1}
+@node_define {section, h2}
+@node_define {subsection, h3}
+@node_define {subsubsec, h4}
+@node_define {unnumbered, h1}
+@node_define {unnumberedsec, h2}
+@node_define {unnumberedsubsec, h3}
+@node_define {unnumberedsubsubsec, h4}
+
+@c The italicized analogues.
+@inode_define {iappendix, h1}
+@inode_define {iappendixsec, h2}
+@inode_define {iappendixsubsec, h3}
+@inode_define {iappendixsubsubsec, h4}
+@inode_define {ichapter, h1}
+@inode_define {isection, h2}
+@inode_define {isubsection, h3}
+@inode_define {isubsubsec, h4}
+@inode_define {iunnumbered, h1}
+@inode_define {iunnumberedsec, h2}
+@inode_define {iunnumberedsubsec, h3}
+@inode_define {iunnumberedsubsubsec, h4}
+
+@c Manual starter:
+@c
+@c Pass arguments of TITLE, AUTHOR, and a short DESCRIPTION.
+@c Immediately following, insert the Top node's menu.
+@c
+@c Typical usage:
+@c
+@c @document{Makeinfo, Brian J. Fox, This file documents the use of the
+@c @code{makeinfo} program\, versions 1.61 and later.}
+@c
+@c @menu
+@c * What is @makeinfo{}?::
+@c @end menu
+@macro document{title, author, description}
+@ifinfo
+\description\
+
+Copyright @copyright{} 1995 \author\
+Copyright @copyright{} 1995 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the copyright holders.
+@end ifinfo
+
+@titlepage
+@title \title\
+@author \author\
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1995 \author\
+Copyright @copyright{} 1995 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the copyright holders.
+@end titlepage
+
+@top{\title\}
+
+\description\
+@end macro
+
+@html-define-line{end,
+@ifeq{"\\line\\"\, "ifinfo"\, @end ifinfo}
+@ifeq{"\\line\\"\, "ifset"\, @end ifset}
+@ifeq{"\\line\\"\, "ifclear"\, @end ifclear}
+@ifeq{"\\line\\"\, "cartouche"\, @end cartouche}
+@ifeq{"\\line\\"\, "menu"\, @end menu}
+@ifeq{"\\line\\"\, "itemize"\, </ul>}
+@ifeq{"\\line\\"\, "enumerate"\, </ul>}
+@ifeq{"\\line\\"\, "table"\, </ul>}
+@ifeq{"\\line\\"\, "ftable"\, </ul>}
+@ifeq{"\\line\\"\, "vtable"\, </ul>}
+@ifeq{"\\line\\"\, "menu"\, xxx}
+@ifeq{"\\line\\"\, "quotation"\, </pre>}
+@ifeq{"\\line\\"\, "example"\, </tt></pre>}
+@ifeq{"\\line\\"\, "smallexample"\, </tt></pre>}
+@ifeq{"\\line\\"\, "lisp"\, </tt></pre>}
+@ifeq{"\\line\\"\, "format"\, </tt></pre>}
+@ifeq{"\\line\\"\, "display"\, </tt></pre>}
+@ifeq{"\\line\\"\, "group"}}
diff --git a/texinfo/makeinfo/macros/multifmt.texi b/texinfo/makeinfo/macros/multifmt.texi
new file mode 100644
index 00000000000..0f2eb32a585
--- /dev/null
+++ b/texinfo/makeinfo/macros/multifmt.texi
@@ -0,0 +1,41 @@
+@c multiformat.texi: -*- Texinfo -*- \input texinfo.tex
+
+@c Copyright (c) 1995 Universal Access, Inc
+@c Author: Brian J. Fox (bfox@ua.com) Sun Apr 2 07:56:23 1995.
+@setfilename multiformat.info
+
+@include html.texi
+
+@ifset html
+@html
+@end ifset
+
+@node First Node, First Section, (dir), (dir)
+@chapter First Chapter
+Here is some text that belongs in the first chapter. Nothing very
+exciting happens here, but this is enough text to span a couple of
+lines, and we feel that is important.
+@paragraph
+
+This is the second paragraph of the first chapter. Note that the
+formatting commands in @code{HTML} seem to do the right thing, as do the
+commands when invoked in @code{Texinfo} mode and in @TeX{}.
+
+@node First Section, , First Node, First Node
+@isection First Section
+
+Here is some text in the first section of the first chapter. We are
+trying very hard to examine the output here to see exactly how proper it
+is. If I wasn't so tired, we could probably see it already.
+@paragraph
+
+Here is a list of items:
+@paragraph
+
+@itemize @bullet
+@item Here is the first item.
+@item Here is the second item.
+@end itemize
+
+@bye
+
diff --git a/texinfo/makeinfo/macros/res-samp.texi b/texinfo/makeinfo/macros/res-samp.texi
new file mode 100644
index 00000000000..5b4e869e0c3
--- /dev/null
+++ b/texinfo/makeinfo/macros/res-samp.texi
@@ -0,0 +1,32 @@
+\input texinfo.tex
+@setfilename resume-example.info
+
+@include resume.texi
+
+@name Brian J. Fox
+@email bfox@@ai.mit.edu
+@street 116 Barranca Ave, Ste. B
+@city Santa Barbara
+@state CA
+@zip 93109
+@phone (805) 564-2192
+
+@resume
+
+@block{EDUCATION}
+@entry{
+12/11/59,
+12/11/63,
+My Mom's House,
+Learning at home with my mother.,
+This was the most learning I ever did.}
+
+@entry{12/11/63, 12/11/77, Brookline\, MA, Learning in the public school system.}
+@entry{12/11/78, 12/11/81, Santa Barbara\, CA, Learning in life
+experience\, and three months at Santa Barbara City College.}
+
+@block{WORK EXPERIENCE}
+@entry{12/11/59, 12/11/75, Mom's house, Various and sundry tasks\,
+including washing dishes and clothes\, and toilet training.}
+@entry{3 months ago, present, Terrapin\, Inc., hacking up Unix systems\, breaking @code{LOGO} worlds\, terrorizing surrounding neighborhood.}
+@bye
diff --git a/texinfo/makeinfo/macros/resume.texi b/texinfo/makeinfo/macros/resume.texi
new file mode 100644
index 00000000000..a4dc5d04be9
--- /dev/null
+++ b/texinfo/makeinfo/macros/resume.texi
@@ -0,0 +1,64 @@
+@c
+@c Reusme writing macros. Produce a very specific format.
+@c
+
+@c A macro which creates a macro. The resultant macro can be called to
+@c set a variable which has the same name as the macro. Use
+@c @value{name} to get the value set in @name{}.
+@macro make-var-macro{macro-name}
+@macro \macro-name\{value}
+@quote-arg
+@set \macro-name\ \value\
+@end macro
+@end macro
+
+@make-var-macro{name}
+@make-var-macro{street}
+@make-var-macro{city}
+@make-var-macro{state}
+@make-var-macro{zip}
+@make-var-macro{phone}
+@make-var-macro{email}
+
+@c Give all of the above variable/macros a null value to start.
+@name
+@street
+@city
+@state
+@zip
+@phone
+@email
+
+@c A typical heading for a resume block is a non-indented line.
+@macro block{title}
+@paragraphindent none
+@comment @noindent
+@heading \title\
+@end macro
+
+@c A typical entry in a resume has a from-date, a to-date, a location,
+@c a job title, and a longer descrition body.
+
+@macro entry{from-date, to-date, where, what, body}
+@paragraphindent 8
+@b{\where\: \what\ (\from-date\ --- \to-date\)}
+@paragraphindent 3
+
+\body\
+@paragraphindent none
+@end macro
+
+@macro address{}
+@value{name}@*
+@value{street}@*
+@value{city}, @value{state}@*
+@value{zip}@*
+@value{phone}
+@end macro
+
+@macro resume{}
+@center @value{name}@*
+@center @value{street}@*
+@center @value{city}, @value{state} @value{zip}@*
+@center @value{email}
+@end macro
diff --git a/texinfo/makeinfo/macros/simpledoc.texi b/texinfo/makeinfo/macros/simpledoc.texi
new file mode 100644
index 00000000000..576cb9b8e41
--- /dev/null
+++ b/texinfo/makeinfo/macros/simpledoc.texi
@@ -0,0 +1,135 @@
+
+@comment Here are some useful examples of the macro facility.
+
+@c Simply insert the right version of the texinfo name.
+@macro texinfo{}
+TeXinfo
+@end macro
+
+@c Define a macro which expands to a pretty version of the name of the
+@c Makeinfo program.
+@macro makeinfo{}
+@code{Makeinfo}
+@end macro
+
+@c Simple insert the right version of the Info name.
+@macro Info{}
+@code{Info}
+@end macro
+
+@c Define a macro which is used to define other macros. This one makes
+@c a macro which creates a node and gives it a sectioning command. Note
+@c that the created macro uses the original definition within the
+@c expansion text. This takes advantage of the non-recursion feature of
+@c macro execution.
+@macro node_define{orig-name}
+@macro \orig-name\{title}
+@node \title\
+@\orig-name\ \title\
+@end macro
+@end macro
+
+@c Here is a special one for "@top", causing the node name to be "Top",
+@c but leaving the section name as the specified title.
+@macro top{title}
+@node Top
+@top \title\
+@end macro
+
+@c Now actually define a new set of sectioning commands.
+@node_define {appendix}
+@node_define {appendixsec}
+@node_define {appendixsubsec}
+@node_define {appendixsubsubsec}
+@node_define {chapter}
+@node_define {section}
+@node_define {subsection}
+@node_define {subsubsec}
+@node_define {unnumbered}
+@node_define {unnumberedsec}
+@node_define {unnumberedsubsec}
+@node_define {unnumberedsubsubsec}
+
+@c The italicized analogues.
+@node_define {iappendix}
+@node_define {iappendixsec}
+@node_define {iappendixsubsec}
+@node_define {iappendixsubsubsec}
+@node_define {ichapter}
+@node_define {isection}
+@node_define {isubsection}
+@node_define {isubsubsec}
+@node_define {iunnumbered}
+@node_define {iunnumberedsec}
+@node_define {iunnumberedsubsec}
+@node_define {iunnumberedsubsubsec}
+
+@c Manual starter:
+@c
+@c Pass arguments of TITLE, AUTHOR, and a short DESCRIPTION.
+@c Immediately following, insert the Top node's menu.
+@c
+@c Typical usage:
+@c
+@c @document{Makeinfo, Brian J. Fox, This file documents the use of the
+@c @code{makeinfo} program\, versions 1.58 and later.}
+@c
+@c @menu
+@c * What is @makeinfo{}?::
+@c @end menu
+
+@macro document{title, author, description}
+@ifinfo
+\description\
+
+Copyright @copyright{} 1994 \author\
+Copyright @copyright{} 1994 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the copyright holders.
+@end ifinfo
+
+@titlepage
+@title \title\
+@author \author\
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1994 \author\
+Copyright @copyright{} 1994 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the copyright holders.
+@end titlepage
+
+@top{\title\}
+
+\description\
+@end macro
diff --git a/texinfo/makeinfo/makeinfo.c b/texinfo/makeinfo/makeinfo.c
new file mode 100644
index 00000000000..ee12ef27e71
--- /dev/null
+++ b/texinfo/makeinfo/makeinfo.c
@@ -0,0 +1,9349 @@
+/* Makeinfo -- convert texinfo format files into info files.
+ $Id: makeinfo.c,v 1.37 1996/10/04 18:20:52 karl Exp $
+
+ Copyright (C) 1987, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Makeinfo is authored by Brian Fox (bfox@ai.mit.edu). */
+
+int major_version = 1;
+int minor_version = 67;
+
+/* You can change some of the behaviour of Makeinfo by changing the
+ following defines: */
+
+/* Define INDENT_PARAGRAPHS_IN_TABLE if you want the paragraphs which
+ appear within an @table, @ftable, or @itemize environment to have
+ standard paragraph indentation. Without this, such paragraphs have
+ no starting indentation. */
+/* #define INDENT_PARAGRAPHS_IN_TABLE */
+
+/* Define DEFAULT_INDENTATION_INCREMENT as an integer which is the amount
+ that @example should increase indentation by. This incremement is used
+ for all insertions which indent the enclosed text. */
+#define DEFAULT_INDENTATION_INCREMENT 5
+
+/* Define PARAGRAPH_START_INDENT to be the amount of indentation that
+ the first lines of paragraphs receive by default, where no other
+ value has been specified. Users can change this value on the command
+ line, with the --paragraph-indent option, or within the texinfo file,
+ with the @paragraphindent command. */
+#define PARAGRAPH_START_INDENT 3
+
+/* Define DEFAULT_PARAGRAPH_SPACING as the number of blank lines that you
+ wish to appear between paragraphs. A value of 1 creates a single blank
+ line between paragraphs. Paragraphs are defined by 2 or more consecutive
+ newlines in the input file (i.e., one or more blank lines). */
+#define DEFAULT_PARAGRAPH_SPACING 1
+
+/* Define HAVE_MACROS to enable the macro facility of Texinfo. Using this
+ facility, users can create their own command procedures with arguments. */
+#define HAVE_MACROS
+
+
+/* Indent #pragma so that older Cpp's don't try to parse it. */
+#if defined (_AIX)
+ # pragma alloca
+#endif /* _AIX */
+
+#include <stdio.h>
+#include <sys/types.h>
+#include <ctype.h>
+#include <sys/stat.h>
+#include <pwd.h>
+#include <errno.h>
+
+#if defined (HAVE_VARARGS_H)
+#include <varargs.h>
+#endif /* HAVE_VARARGS_H */
+#include "getopt.h"
+
+#if defined (HAVE_UNISTD_H)
+#include <unistd.h>
+#endif /* HAVE_UNISTD_H */
+
+#if defined (VMS)
+#include <perror.h>
+#endif
+
+#if defined (HAVE_STRING_H)
+#include <string.h>
+#else
+#include <strings.h>
+#endif /* !HAVE_STRING_H */
+
+#if defined (TM_IN_SYS_TIME)
+#include <sys/time.h>
+#else
+#include <time.h>
+#endif /* !TM_IN_SYS_TIME */
+
+#if defined (HAVE_SYS_FCNTL_H)
+#include <sys/fcntl.h>
+#else
+#include <fcntl.h>
+#endif /* !HAVE_SYS_FCNTL_H */
+
+#if defined (HAVE_SYS_FILE_H)
+#include <sys/file.h>
+#endif /* HAVE_SYS_FILE_H */
+
+#if defined (__GNUC__)
+#define alloca __builtin_alloca
+#else
+#if defined(HAVE_ALLOCA_H)
+#include <alloca.h>
+#else /* !HAVE_ALLOCA_H */
+#if !defined (_AIX)
+extern char *alloca ();
+#endif /* !_AIX */
+#endif /* !HAVE_ALLOCA_H */
+#endif /* !__GNUC__ */
+
+void *xmalloc (), *xrealloc ();
+#if defined (__osf__)
+extern void *malloc (), *realloc ();
+#endif /* __osf__ */
+
+char **get_brace_args ();
+int array_len ();
+void free_array ();
+static void isolate_nodename ();
+
+#define COMPILING_MAKEINFO
+#include "makeinfo.h"
+
+/* Non-zero means that we are currently hacking the insides of an
+ insertion which would use a fixed width font. */
+static int in_fixed_width_font = 0;
+
+/* Non-zero means that start_paragraph () MUST be called before we pay
+ any attention to close_paragraph () calls. */
+int must_start_paragraph = 0;
+
+/* Non-zero means a string is in execution, as opposed to a file. */
+static int executing_string = 0;
+
+#if defined (HAVE_MACROS)
+/* If non-NULL, this is an output stream to write the full macro expansion
+ of the input text to. The resultant file is another texinfo file, but
+ missing @include, @infoinclude, @macro, and macro invocations. Instead,
+ all of the text is placed within the file. */
+FILE *macro_expansion_output_stream = (FILE *)NULL;
+
+/* Here is a structure used to remember input text strings and offsets
+ within them. */
+typedef struct {
+ char *pointer; /* Pointer to the input text. */
+ int offset; /* Offset of the last character output. */
+} ITEXT;
+
+static ITEXT **itext_info = (ITEXT **)NULL;
+static int itext_size = 0;
+
+/* Non-zero means to inhibit the writing of macro expansions to the output
+ stream. This is used in special cases where the output has already been
+ written. */
+int me_inhibit_expansion = 0;
+
+ITEXT *remember_itext ();
+void forget_itext (), me_append_before_this_command ();
+void append_to_expansion_output (), write_region_to_macro_output ();
+void maybe_write_itext (), me_execute_string ();
+#endif /* HAVE_MACROS */
+
+/* Some systems don't declare this function in pwd.h. */
+struct passwd *getpwnam ();
+
+/* **************************************************************** */
+/* */
+/* Global Variables */
+/* */
+/* **************************************************************** */
+
+/* Global pointer to argv[0]. */
+char *progname;
+
+/* Return non-zero if STRING is the text at input_text + input_text_offset,
+ else zero. */
+#define looking_at(string) \
+ (strncmp (input_text + input_text_offset, string, strlen (string)) == 0)
+
+/* And writing to the output. */
+
+/* The output file name. */
+char *output_filename = (char *)NULL;
+char *pretty_output_filename;
+
+/* Name of the output file that the user elected to pass on the command line.
+ Such a name overrides any name found with the @setfilename command. */
+char *command_output_filename = (char *)NULL;
+
+/* A colon separated list of directories to search for files included
+ with @include. This can be controlled with the `-I' option to makeinfo. */
+char *include_files_path = (char *)NULL;
+
+/* Current output stream. */
+FILE *output_stream;
+
+/* Position in the output file. */
+int output_position;
+
+#define INITIAL_PARAGRAPH_SPACE 5000
+int paragraph_buffer_len = INITIAL_PARAGRAPH_SPACE;
+
+/* Filling.. */
+/* Non-zero indicates that filling will take place on long lines. */
+int filling_enabled = 1;
+
+/* Non-zero means that words are not to be split, even in long lines. This
+ gets changed for cm_w (). */
+int non_splitting_words = 0;
+
+/* Non-zero indicates that filling a line also indents the new line. */
+int indented_fill = 0;
+
+/* The amount of indentation to add at the starts of paragraphs.
+ 0 means don't change existing indentation at paragraph starts.
+ > 0 is amount to indent new paragraphs by.
+ < 0 means indent to column zero by removing indentation if necessary.
+
+ This is normally zero, but some people prefer paragraph starts to be
+ somewhat more indented than paragraph bodies. A pretty value for
+ this is 3. */
+int paragraph_start_indent = PARAGRAPH_START_INDENT;
+
+/* Non-zero means that the use of paragraph_start_indent is inhibited.
+ @example uses this to line up the left columns of the example text.
+ A negative value for this variable is incremented each time it is used.
+ @noindent uses this to inhibit indentation for a single paragraph. */
+int inhibit_paragraph_indentation = 0;
+
+/* Indentation that is pending insertion. We have this for hacking lines
+ which look blank, but contain whitespace. We want to treat those as
+ blank lines. */
+int pending_indent = 0;
+
+/* The amount that indentation increases/decreases by. */
+int default_indentation_increment = DEFAULT_INDENTATION_INCREMENT;
+
+/* Non-zero indicates that indentation is temporarily turned off. */
+int no_indent = 1;
+
+/* Non-zero means forcing output text to be flushright. */
+int force_flush_right = 0;
+
+/* Non-zero means that the footnote style for this document was set on
+ the command line, which overrides any other settings. */
+int footnote_style_preset = 0;
+
+/* Non-zero means that we automatically number footnotes that have no
+ specified marker. */
+int number_footnotes = 1;
+
+/* The current footnote number in this node. Each time a new node is
+ started this is reset to 1. */
+int current_footnote_number = 1;
+
+/* Command name in the process of being hacked. */
+char *command;
+
+/* The index in our internal command table of the currently
+ executing command. */
+int command_index;
+
+/* A search string which is used to find a line defining a node. */
+char node_search_string[] =
+ { '\n', COMMAND_PREFIX, 'n', 'o', 'd', 'e', ' ', '\0' };
+
+/* A search string which is used to find a line defining a menu. */
+char menu_search_string[] =
+ { '\n', COMMAND_PREFIX, 'm', 'e', 'n', 'u', '\0' };
+
+/* A search string which is used to find the first @setfilename. */
+char setfilename_search[] =
+ { COMMAND_PREFIX,
+ 's', 'e', 't', 'f', 'i', 'l', 'e', 'n', 'a', 'm', 'e', '\0' };
+
+/* A stack of file information records. If a new file is read in with
+ "@input", we remember the old input file state on this stack. */
+typedef struct fstack
+{
+ struct fstack *next;
+ char *filename;
+ char *text;
+ int size;
+ int offset;
+ int line_number;
+} FSTACK;
+
+FSTACK *filestack = (FSTACK *) NULL;
+
+/* Stuff for nodes. */
+/* The current nodes node name. */
+char *current_node = (char *)NULL;
+
+/* The current nodes section level. */
+int current_section = 0;
+
+/* The filename of the current input file. This is never freed. */
+char *node_filename = (char *)NULL;
+
+/* What we remember for each node. */
+typedef struct tentry
+{
+ struct tentry *next_ent;
+ char *node; /* name of this node. */
+ char *prev; /* name of "Prev:" for this node. */
+ char *next; /* name of "Next:" for this node. */
+ char *up; /* name of "Up:" for this node. */
+ int position; /* output file position of this node. */
+ int line_no; /* defining line in source file. */
+ char *filename; /* The file that this node was found in. */
+ int touched; /* non-zero means this node has been referenced. */
+ int flags; /* Room for growth. Right now, contains 1 bit. */
+} TAG_ENTRY;
+
+/* If node-a has a "Next" for node-b, but node-b has no "Prev" for node-a,
+ we turn on this flag bit in node-b's tag entry. This means that when
+ it is time to validate node-b, we don't report an additional error
+ if there was no "Prev" field. */
+#define PREV_ERROR 0x1
+#define NEXT_ERROR 0x2
+#define UP_ERROR 0x4
+#define NO_WARN 0x8
+#define IS_TOP 0x10
+
+TAG_ENTRY *tag_table = (TAG_ENTRY *) NULL;
+
+#if defined (HAVE_MACROS)
+#define ME_RECURSE 0x01
+#define ME_QUOTE_ARG 0x02
+
+/* Macro definitions for user-defined commands. */
+typedef struct {
+ char *name; /* Name of the macro. */
+ char **arglist; /* Args to replace when executing. */
+ char *body; /* Macro body. */
+ char *source_file; /* File where this macro is defined. */
+ int source_lineno; /* Line number within FILENAME. */
+ int inhibited; /* Non-zero means make find_macro () fail. */
+ int flags; /* ME_RECURSE, ME_QUOTE_ARG, etc. */
+} MACRO_DEF;
+
+void add_macro (), execute_macro ();
+MACRO_DEF *find_macro (), *delete_macro ();
+#endif /* HAVE_MACROS */
+
+/* Menu reference, *note reference, and validation hacking. */
+
+/* The various references that we know about. */
+enum reftype
+{
+ menu_reference, followed_reference
+};
+
+/* A structure to remember references with. A reference to a node is
+ either an entry in a menu, or a cross-reference made with [px]ref. */
+typedef struct node_ref
+{
+ struct node_ref *next;
+ char *node; /* Name of node referred to. */
+ char *containing_node; /* Name of node containing this reference. */
+ int line_no; /* Line number where the reference occurs. */
+ int section; /* Section level where the reference occurs. */
+ char *filename; /* Name of file where the reference occurs. */
+ enum reftype type; /* Type of reference, either menu or note. */
+} NODE_REF;
+
+/* The linked list of such structures. */
+NODE_REF *node_references = (NODE_REF *) NULL;
+
+/* Flag which tells us whether to examine menu lines or not. */
+int in_menu = 0;
+
+/* Flag which tells us how to examine menu lines. */
+int in_detailmenu = 0;
+
+/* Non-zero means that we have seen "@top" once already. */
+int top_node_seen = 0;
+
+/* Non-zero means that we have seen a non-"@top" node already. */
+int non_top_node_seen = 0;
+
+/* Flags controlling the operation of the program. */
+
+/* Default is to notify users of bad choices. */
+int print_warnings = 1;
+
+/* Default is to check node references. */
+int validating = 1;
+
+/* Non-zero means do not output "Node: Foo" for node separations. */
+int no_headers = 0;
+
+/* Number of errors that we tolerate on a given fileset. */
+int max_error_level = 100;
+
+/* Maximum number of references to a single node before complaining. */
+int reference_warning_limit = 1000;
+
+/* Non-zero means print out information about what is going on when it
+ is going on. */
+int verbose_mode = 0;
+
+/* Non-zero means to be relaxed about the input file. This is useful when
+ we can successfully format the input, but it doesn't strictly match our
+ somewhat pedantic ideas of correctness. Right now, it affects what
+ @table and @itemize do without arguments. */
+int allow_lax_format = 0;
+
+/* The list of commands that we hack in texinfo. Each one
+ has an associated function. When the command is encountered in the
+ text, the associated function is called with START as the argument.
+ If the function expects arguments in braces, it remembers itself on
+ the stack. When the corresponding close brace is encountered, the
+ function is called with END as the argument. */
+
+#define START 0
+#define END 1
+
+typedef struct brace_element
+{
+ struct brace_element *next;
+ COMMAND_FUNCTION *proc;
+ int pos, line;
+ int in_fixed_width_font;
+} BRACE_ELEMENT;
+
+BRACE_ELEMENT *brace_stack = (BRACE_ELEMENT *) NULL;
+
+/* Forward declarations. */
+#if !defined (HAVE_STRDUP)
+extern char *strdup ();
+#endif /* HAVE_STRDUP */
+
+extern void do_multitable ();
+
+void print_version_info ();
+void usage ();
+void push_node_filename (), pop_node_filename ();
+void remember_error ();
+void convert_from_stream (), convert_from_file (), convert_from_loaded_file ();
+void init_internals (), init_paragraph (), init_brace_stack ();
+void init_insertion_stack (), init_indices ();
+void init_tag_table (), write_tag_table (), write_tag_table_internal ();
+void validate_file (), validate_other_references (), split_file ();
+void free_node_references (), do_enumeration (), handle_variable ();
+void handle_variable_internal ();
+void execute_string ();
+void normalize_node_name ();
+void undefindex (), top_defindex (), gen_defindex ();
+void define_user_command ();
+void free_pending_notes (), output_pending_notes ();
+
+void reader_loop (), read_command ();
+void remember_brace (), remember_brace_1 ();
+void pop_and_call_brace (), discard_braces ();
+void add_word_args (), add_word (), add_char (), insert (), flush_output ();
+void insert_string ();
+void close_paragraph_with_lines (), close_paragraph ();
+void ignore_blank_line ();
+void do_flush_right_indentation ();
+void start_paragraph (), indent ();
+
+void insert_self (), insert_space (), cm_ignore_line ();
+
+void
+ cm_TeX (), cm_asterisk (), cm_bullet (), cm_cite (),
+ cm_code (), cm_copyright (), cm_ctrl (), cm_dfn (), cm_dircategory (),
+ cm_direntry (), cm_dots (), cm_emph (), cm_enddots (),
+ cm_kbd (), cm_angle_brackets (), cm_no_op (), cm_not_fixed_width (),
+ cm_strong (), cm_var (), cm_w ();
+
+/* Sectioning. */
+void
+ cm_chapter (), cm_unnumbered (), cm_appendix (), cm_top (),
+ cm_section (), cm_unnumberedsec (), cm_appendixsec (),
+ cm_subsection (), cm_unnumberedsubsec (), cm_appendixsubsec (),
+ cm_subsubsection (), cm_unnumberedsubsubsec (), cm_appendixsubsubsec (),
+ cm_heading (), cm_chapheading (), cm_subheading (), cm_subsubheading (),
+ cm_majorheading (), cm_raisesections (), cm_lowersections ();
+
+/* All @defxxx commands map to cm_defun, most accent commands map to
+ cm_accent, most non-English letters map to cm_special_char. */
+void cm_defun (), cm_accent (), cm_special_char (), cm_dotless ();
+
+void
+ cm_node (), cm_menu (), cm_xref (), cm_ftable (), cm_vtable (), cm_pxref (),
+ cm_inforef (), cm_quotation (), cm_display (), cm_itemize (),
+ cm_enumerate (), cm_tab (), cm_table (), cm_itemx (), cm_noindent (),
+ cm_setfilename (), cm_br (), cm_sp (), cm_page (), cm_group (),
+ cm_center (), cm_include (), cm_bye (), cm_item (), cm_end (),
+ cm_ifinfo (), cm_kindex (), cm_cindex (),
+ cm_findex (), cm_pindex (), cm_vindex (), cm_tindex (),
+ cm_synindex (), cm_printindex (), cm_minus (), cm_footnote (),
+ cm_example (), cm_smallexample (), cm_lisp (), cm_format (), cm_exdent (),
+ cm_defindex (), cm_defcodeindex (), cm_sc (), cm_result (), cm_expansion (),
+ cm_equiv (), cm_print (), cm_error (), cm_point (), cm_today (),
+ cm_flushleft (), cm_flushright (), cm_smalllisp (), cm_finalout (),
+ cm_cartouche (), cm_detailmenu (), cm_multitable ();
+
+/* Conditionals. */
+void cm_set (), cm_clear (), cm_ifset (), cm_ifclear ();
+void cm_value (), cm_ifeq ();
+
+#if defined (HAVE_MACROS)
+/* Define a user-defined command which is simple substitution. */
+void cm_macro (), cm_unmacro ();
+#endif /* HAVE_MACROS */
+
+/* Options. */
+void cm_paragraphindent (), cm_footnotestyle ();
+
+/* Internals. */
+void command_name_condition (), misplaced_brace (), cm_obsolete (),
+ cm_ideprecated ();
+
+typedef struct
+{
+ char *name;
+ COMMAND_FUNCTION *proc;
+ int argument_in_braces;
+} COMMAND;
+
+/* Stuff for defining commands on the fly. */
+COMMAND **user_command_array = (COMMAND **) NULL;
+int user_command_array_len = 0;
+
+#define NO_BRACE_ARGS 0
+#define BRACE_ARGS 1
+
+static COMMAND CommandTable[] = {
+ { "\t", insert_space, NO_BRACE_ARGS },
+ { "\n", insert_space, NO_BRACE_ARGS },
+ { " ", insert_self, NO_BRACE_ARGS },
+ { "!", insert_self, NO_BRACE_ARGS },
+ { "\"", insert_self, NO_BRACE_ARGS },
+ { "'", insert_self, NO_BRACE_ARGS },
+ { "*", cm_asterisk, NO_BRACE_ARGS },
+ { ",", cm_accent, BRACE_ARGS },
+ { "-", cm_no_op, NO_BRACE_ARGS },
+ { ".", insert_self, NO_BRACE_ARGS },
+ { ":", cm_no_op, NO_BRACE_ARGS },
+ { "=", insert_self, NO_BRACE_ARGS },
+ { "?", insert_self, NO_BRACE_ARGS },
+ { "@", insert_self, NO_BRACE_ARGS },
+ { "^", insert_self, NO_BRACE_ARGS },
+ { "`", insert_self, NO_BRACE_ARGS },
+ { "{", insert_self, NO_BRACE_ARGS },
+ { "|", cm_no_op, NO_BRACE_ARGS },
+ { "}", insert_self, NO_BRACE_ARGS },
+ { "~", insert_self, NO_BRACE_ARGS },
+ { "AA", insert_self, BRACE_ARGS },
+ { "AE", insert_self, BRACE_ARGS },
+ { "H", cm_accent, BRACE_ARGS },
+ { "L", cm_special_char, BRACE_ARGS },
+ { "O", cm_special_char, BRACE_ARGS },
+ { "OE", insert_self, BRACE_ARGS },
+ { "TeX", cm_TeX, BRACE_ARGS },
+ { "aa", insert_self, BRACE_ARGS },
+ { "ae", insert_self, BRACE_ARGS },
+ { "appendix", cm_appendix, NO_BRACE_ARGS },
+ { "appendixsection", cm_appendixsec, NO_BRACE_ARGS },
+ { "appendixsec", cm_appendixsec, NO_BRACE_ARGS },
+ { "appendixsubsec", cm_appendixsubsec, NO_BRACE_ARGS },
+ { "appendixsubsubsec", cm_appendixsubsubsec, NO_BRACE_ARGS },
+ { "asis", cm_no_op, BRACE_ARGS },
+ { "b", cm_not_fixed_width, BRACE_ARGS },
+ { "bullet", cm_bullet, BRACE_ARGS },
+ { "bye", cm_bye, NO_BRACE_ARGS },
+ { "c", cm_ignore_line, NO_BRACE_ARGS },
+ { "cartouche", cm_cartouche, NO_BRACE_ARGS },
+ { "center", cm_center, NO_BRACE_ARGS },
+ { "centerchap", cm_unnumbered, NO_BRACE_ARGS },
+ { "chapheading", cm_chapheading, NO_BRACE_ARGS },
+ { "chapter", cm_chapter, NO_BRACE_ARGS },
+ { "cindex", cm_cindex, NO_BRACE_ARGS },
+ { "cite", cm_cite, BRACE_ARGS },
+ { "clear", cm_clear, NO_BRACE_ARGS },
+ { "code", cm_code, BRACE_ARGS },
+ { "comment", cm_ignore_line, NO_BRACE_ARGS },
+ { "contents", cm_no_op, NO_BRACE_ARGS },
+ { "copyright", cm_copyright, BRACE_ARGS },
+ { "ctrl", cm_obsolete, BRACE_ARGS },
+ { "defcodeindex", cm_defcodeindex, NO_BRACE_ARGS },
+ { "defindex", cm_defindex, NO_BRACE_ARGS },
+/* The `def' commands. */
+ { "defcv", cm_defun, NO_BRACE_ARGS },
+ { "defcvx", cm_defun, NO_BRACE_ARGS },
+ { "deffn", cm_defun, NO_BRACE_ARGS },
+ { "deffnx", cm_defun, NO_BRACE_ARGS },
+ { "defivar", cm_defun, NO_BRACE_ARGS },
+ { "defivarx", cm_defun, NO_BRACE_ARGS },
+ { "defmac", cm_defun, NO_BRACE_ARGS },
+ { "defmacx", cm_defun, NO_BRACE_ARGS },
+ { "defmethod", cm_defun, NO_BRACE_ARGS },
+ { "defmethodx", cm_defun, NO_BRACE_ARGS },
+ { "defop", cm_defun, NO_BRACE_ARGS },
+ { "defopt", cm_defun, NO_BRACE_ARGS },
+ { "defoptx", cm_defun, NO_BRACE_ARGS },
+ { "defopx", cm_defun, NO_BRACE_ARGS },
+ { "defspec", cm_defun, NO_BRACE_ARGS },
+ { "defspecx", cm_defun, NO_BRACE_ARGS },
+ { "deftp", cm_defun, NO_BRACE_ARGS },
+ { "deftpx", cm_defun, NO_BRACE_ARGS },
+ { "deftypefn", cm_defun, NO_BRACE_ARGS },
+ { "deftypefnx", cm_defun, NO_BRACE_ARGS },
+ { "deftypefun", cm_defun, NO_BRACE_ARGS },
+ { "deftypefunx", cm_defun, NO_BRACE_ARGS },
+ { "deftypemethod", cm_defun, NO_BRACE_ARGS },
+ { "deftypemethodx", cm_defun, NO_BRACE_ARGS },
+ { "deftypevar", cm_defun, NO_BRACE_ARGS },
+ { "deftypevarx", cm_defun, NO_BRACE_ARGS },
+ { "deftypevr", cm_defun, NO_BRACE_ARGS },
+ { "deftypevrx", cm_defun, NO_BRACE_ARGS },
+ { "defun", cm_defun, NO_BRACE_ARGS },
+ { "defunx", cm_defun, NO_BRACE_ARGS },
+ { "defvar", cm_defun, NO_BRACE_ARGS },
+ { "defvarx", cm_defun, NO_BRACE_ARGS },
+ { "defvr", cm_defun, NO_BRACE_ARGS },
+ { "defvrx", cm_defun, NO_BRACE_ARGS },
+/* The end of the `def' commands. */
+ { "detailmenu", cm_detailmenu, NO_BRACE_ARGS },
+ { "dfn", cm_dfn, BRACE_ARGS },
+ { "dircategory", cm_dircategory, NO_BRACE_ARGS },
+ { "direntry", cm_direntry, NO_BRACE_ARGS },
+ { "display", cm_display, NO_BRACE_ARGS },
+ { "dmn", cm_no_op, BRACE_ARGS },
+ { "dotaccent", cm_accent, BRACE_ARGS },
+ { "dotless", cm_dotless, BRACE_ARGS },
+ { "dots", cm_dots, BRACE_ARGS },
+ { "email", cm_angle_brackets, BRACE_ARGS },
+ { "emph", cm_emph, BRACE_ARGS },
+ { "end", cm_end, NO_BRACE_ARGS },
+ { "enddots", cm_enddots, BRACE_ARGS },
+ { "enumerate", cm_enumerate, NO_BRACE_ARGS },
+ { "equiv", cm_equiv, BRACE_ARGS },
+ { "error", cm_error, BRACE_ARGS },
+ { "example", cm_example, NO_BRACE_ARGS },
+ { "exclamdown", cm_special_char, BRACE_ARGS },
+ { "exdent", cm_exdent, NO_BRACE_ARGS },
+ { "expansion", cm_expansion, BRACE_ARGS },
+ { "file", cm_code, BRACE_ARGS },
+ { "finalout", cm_no_op, NO_BRACE_ARGS },
+ { "findex", cm_findex, NO_BRACE_ARGS },
+ { "flushleft", cm_flushleft, NO_BRACE_ARGS },
+ { "flushright", cm_flushright, NO_BRACE_ARGS },
+ { "footnote", cm_footnote, NO_BRACE_ARGS}, /* self-arg eater */
+ { "footnotestyle", cm_footnotestyle, NO_BRACE_ARGS },
+ { "format", cm_format, NO_BRACE_ARGS },
+ { "ftable", cm_ftable, NO_BRACE_ARGS },
+ { "group", cm_group, NO_BRACE_ARGS },
+ { "heading", cm_heading, NO_BRACE_ARGS },
+ { "headings", cm_ignore_line, NO_BRACE_ARGS },
+ { "hyphenation", cm_no_op, BRACE_ARGS },
+ { "i", cm_not_fixed_width, BRACE_ARGS },
+ { "ifclear", cm_ifclear, NO_BRACE_ARGS },
+ { "ifeq", cm_ifeq, NO_BRACE_ARGS },
+ { "ifhtml", command_name_condition, NO_BRACE_ARGS },
+ { "ifinfo", cm_ifinfo, NO_BRACE_ARGS },
+ { "ifset", cm_ifset, NO_BRACE_ARGS },
+ { "iftex", command_name_condition, NO_BRACE_ARGS },
+ { "ignore", command_name_condition, NO_BRACE_ARGS },
+ { "include", cm_include, NO_BRACE_ARGS },
+ { "inforef", cm_inforef, BRACE_ARGS },
+ { "item", cm_item, NO_BRACE_ARGS },
+ { "itemize", cm_itemize, NO_BRACE_ARGS },
+ { "itemx", cm_itemx, NO_BRACE_ARGS },
+ { "kbd", cm_kbd, BRACE_ARGS },
+ { "key", cm_angle_brackets, BRACE_ARGS },
+ { "kindex", cm_kindex, NO_BRACE_ARGS },
+ { "l", cm_special_char, BRACE_ARGS },
+ { "lisp", cm_lisp, NO_BRACE_ARGS },
+ { "lowersections", cm_lowersections, NO_BRACE_ARGS },
+#if defined (HAVE_MACROS)
+ { "macro", cm_macro, NO_BRACE_ARGS },
+#endif
+ { "majorheading", cm_majorheading, NO_BRACE_ARGS },
+ { "math", cm_no_op, BRACE_ARGS },
+ { "menu", cm_menu, NO_BRACE_ARGS },
+ { "minus", cm_minus, BRACE_ARGS },
+ { "multitable", cm_multitable, NO_BRACE_ARGS },
+ { "need", cm_ignore_line, NO_BRACE_ARGS },
+ { "node", cm_node, NO_BRACE_ARGS },
+ { "noindent", cm_noindent, NO_BRACE_ARGS },
+ { "nwnode", cm_node, NO_BRACE_ARGS },
+ { "o", cm_special_char, BRACE_ARGS },
+ { "oe", insert_self, BRACE_ARGS },
+ { "page", cm_no_op, NO_BRACE_ARGS },
+ { "paragraphindent", cm_paragraphindent, NO_BRACE_ARGS },
+ { "pindex", cm_pindex, NO_BRACE_ARGS },
+ { "point", cm_point, BRACE_ARGS },
+ { "pounds", cm_special_char, BRACE_ARGS },
+ { "print", cm_print, BRACE_ARGS },
+ { "printindex", cm_printindex, NO_BRACE_ARGS },
+ { "pxref", cm_pxref, BRACE_ARGS },
+ { "questiondown", cm_special_char, BRACE_ARGS },
+ { "quotation", cm_quotation, NO_BRACE_ARGS },
+ { "r", cm_not_fixed_width, BRACE_ARGS },
+ { "raisesections", cm_raisesections, NO_BRACE_ARGS },
+ { "ref", cm_xref, BRACE_ARGS },
+ { "refill", cm_no_op, NO_BRACE_ARGS },
+ { "result", cm_result, BRACE_ARGS },
+ { "ringaccent", cm_accent, BRACE_ARGS },
+ { "samp", cm_code, BRACE_ARGS },
+ { "sc", cm_sc, BRACE_ARGS },
+ { "section", cm_section, NO_BRACE_ARGS },
+ { "set", cm_set, NO_BRACE_ARGS },
+ { "setchapternewpage", cm_ignore_line, NO_BRACE_ARGS },
+ { "setchapterstyle", cm_obsolete, NO_BRACE_ARGS },
+ { "setfilename", cm_setfilename, NO_BRACE_ARGS },
+ { "settitle", cm_ignore_line, NO_BRACE_ARGS },
+ { "shortcontents", cm_no_op, NO_BRACE_ARGS },
+ { "shorttitlepage", cm_ignore_line, NO_BRACE_ARGS },
+ { "smallbook", cm_ignore_line, NO_BRACE_ARGS },
+ { "smallexample", cm_smallexample, NO_BRACE_ARGS },
+ { "smalllisp", cm_smalllisp, NO_BRACE_ARGS },
+ { "sp", cm_sp, NO_BRACE_ARGS },
+ { "ss", insert_self, BRACE_ARGS },
+ { "strong", cm_strong, BRACE_ARGS },
+ { "subheading", cm_subheading, NO_BRACE_ARGS },
+ { "subsection", cm_subsection, NO_BRACE_ARGS },
+ { "subsubheading", cm_subsubheading, NO_BRACE_ARGS },
+ { "subsubsection", cm_subsubsection, NO_BRACE_ARGS },
+ { "summarycontents", cm_no_op, NO_BRACE_ARGS },
+ { "syncodeindex", cm_synindex, NO_BRACE_ARGS },
+ { "synindex", cm_synindex, NO_BRACE_ARGS },
+ { "t", cm_no_op, BRACE_ARGS },
+ { "tab", cm_tab, NO_BRACE_ARGS },
+ { "table", cm_table, NO_BRACE_ARGS },
+ { "tex", command_name_condition, NO_BRACE_ARGS },
+ { "tieaccent", cm_accent, BRACE_ARGS },
+ { "tindex", cm_tindex, NO_BRACE_ARGS },
+ { "titlefont", cm_not_fixed_width, BRACE_ARGS },
+ { "titlepage", command_name_condition, NO_BRACE_ARGS },
+ { "today", cm_today, BRACE_ARGS },
+ { "top", cm_top, NO_BRACE_ARGS },
+ { "u", cm_accent, BRACE_ARGS },
+ { "ubaraccent", cm_accent, BRACE_ARGS },
+ { "udotaccent", cm_accent, BRACE_ARGS },
+#if defined (HAVE_MACROS)
+ { "unmacro", cm_unmacro, NO_BRACE_ARGS },
+#endif
+ { "unnumbered", cm_unnumbered, NO_BRACE_ARGS },
+ { "unnumberedsec", cm_unnumberedsec, NO_BRACE_ARGS },
+ { "unnumberedsubsec", cm_unnumberedsubsec, NO_BRACE_ARGS },
+ { "unnumberedsubsubsec", cm_unnumberedsubsubsec, NO_BRACE_ARGS },
+ { "url", cm_code, BRACE_ARGS },
+ { "v", cm_accent, BRACE_ARGS },
+ { "value", cm_value, BRACE_ARGS },
+ { "var", cm_var, BRACE_ARGS },
+ { "vindex", cm_vindex, NO_BRACE_ARGS },
+ { "vtable", cm_vtable, NO_BRACE_ARGS },
+ { "w", cm_w, BRACE_ARGS },
+ { "xref", cm_xref, BRACE_ARGS },
+
+ /* Deprecated commands. These used to be for italics. */
+ { "iappendix", cm_ideprecated, NO_BRACE_ARGS },
+ { "iappendixsec", cm_ideprecated, NO_BRACE_ARGS },
+ { "iappendixsection", cm_ideprecated, NO_BRACE_ARGS },
+ { "iappendixsubsec", cm_ideprecated, NO_BRACE_ARGS },
+ { "iappendixsubsubsec", cm_ideprecated, NO_BRACE_ARGS },
+ { "ichapter", cm_ideprecated, NO_BRACE_ARGS },
+ { "isection", cm_ideprecated, NO_BRACE_ARGS },
+ { "isubsection", cm_ideprecated, NO_BRACE_ARGS },
+ { "isubsubsection", cm_ideprecated, NO_BRACE_ARGS },
+ { "iunnumbered", cm_ideprecated, NO_BRACE_ARGS },
+ { "iunnumberedsec", cm_ideprecated, NO_BRACE_ARGS },
+ { "iunnumberedsubsec", cm_ideprecated, NO_BRACE_ARGS },
+ { "iunnumberedsubsubsec", cm_ideprecated, NO_BRACE_ARGS },
+
+ /* Now @include does what this was supposed to. */
+ { "infoinclude", cm_obsolete, NO_BRACE_ARGS },
+ { "titlespec", cm_obsolete, NO_BRACE_ARGS },
+
+ {(char *) NULL, (COMMAND_FUNCTION *) NULL}, NO_BRACE_ARGS};
+
+struct option long_options[] =
+{
+ { "error-limit", 1, 0, 'e' }, /* formerly -el */
+ { "fill-column", 1, 0, 'f' }, /* formerly -fc */
+ { "footnote-style", 1, 0, 's' }, /* formerly -ft */
+ { "no-headers", 0, &no_headers, 1 }, /* Do not output Node: foo */
+ { "no-pointer-validate", 0, &validating, 0 }, /* formerly -nv */
+ { "no-validate", 0, &validating, 0 }, /* formerly -nv */
+ { "no-split", 0, &splitting, 0 }, /* formerly -ns */
+ { "no-warn", 0, &print_warnings, 0 }, /* formerly -nw */
+#if defined (HAVE_MACROS)
+ { "macro-expand", 1, 0, 'E' },
+#endif /* HAVE_MACROS */
+ { "number-footnotes", 0, &number_footnotes, 1 },
+ { "no-number-footnotes", 0, &number_footnotes, 0 },
+ { "output", 1, 0, 'o' },
+ { "paragraph-indent", 1, 0, 'p' }, /* formerly -pi */
+ { "reference-limit", 1, 0, 'r' }, /* formerly -rl */
+ { "verbose", 0, &verbose_mode, 1 }, /* formerly -verbose */
+ { "help", 0, 0, 'h' },
+ { "version", 0, 0, 'V' },
+ {NULL, 0, NULL, 0}
+};
+
+/* Values for calling handle_variable_internal (). */
+#define SET 1
+#define CLEAR 2
+#define IFSET 3
+#define IFCLEAR 4
+
+/* **************************************************************** */
+/* */
+/* Main () Start of code */
+/* */
+/* **************************************************************** */
+
+/* For each file mentioned in the command line, process it, turning
+ Texinfo commands into wonderfully formatted output text. */
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ extern int errors_printed;
+ char *filename_part ();
+ int c, ind;
+ int reading_from_stdin = 0;
+
+ /* The name of this program is the last filename in argv[0]. */
+ progname = filename_part (argv[0]);
+
+ /* Parse argument flags from the input line. */
+ while ((c = getopt_long
+ (argc, argv,
+#if defined (HAVE_MACROS)
+ "D:E:U:I:f:o:p:e:r:s:V",
+#else
+ "D:U:I:f:o:p:e:r:s:V",
+#endif /* !HAVE_MACROS */
+ long_options, &ind))
+ != EOF)
+ {
+ if (c == 0 && long_options[ind].flag == 0)
+ c = long_options[ind].val;
+
+ switch (c)
+ {
+ /* User specified variable to set or clear? */
+ case 'D':
+ case 'U':
+ handle_variable_internal ((c == 'D') ? SET : CLEAR, optarg);
+ break;
+
+#if defined (HAVE_MACROS)
+ /* Use specified a macro expansion output file? */
+ case 'E':
+ if (!macro_expansion_output_stream)
+ {
+ macro_expansion_output_stream = fopen (optarg, "w");
+ if (!macro_expansion_output_stream)
+ error ("Couldn't open macro expansion output \"%s\"", optarg);
+ }
+ else
+ error ("Cannot specify more than one macro expansion output");
+ break;
+#endif /* HAVE_MACROS */
+
+ /* User specified include file path? */
+ case 'I':
+ if (!include_files_path)
+ include_files_path = strdup (".");
+
+ include_files_path = (char *)
+ xrealloc (include_files_path,
+ 2 + strlen (include_files_path) + strlen (optarg));
+ strcat (include_files_path, ":");
+ strcat (include_files_path, optarg);
+ break;
+
+ /* User specified fill_column? */
+ case 'f':
+ if (sscanf (optarg, "%d", &fill_column) != 1)
+ {
+ fprintf (stderr,
+ "%s: --fill-column arg must be numeric, not `%s'.\n",
+ progname, optarg);
+ usage (FATAL);
+ }
+ break;
+
+ /* User specified output file? */
+ case 'o':
+ command_output_filename = strdup (optarg);
+ break;
+
+ /* User specified paragraph indent (paragraph_start_index)? */
+ case 'p':
+ if (set_paragraph_indent (optarg) < 0)
+ {
+ fprintf (stderr,
+ "%s: --paragraph-indent arg must be numeric/none/asis, not `%s'.\n",
+ progname, optarg);
+ usage (FATAL);
+ }
+ break;
+
+ /* User specified error level? */
+ case 'e':
+ if (sscanf (optarg, "%d", &max_error_level) != 1)
+ {
+ fprintf (stderr,
+ "%s: --error-limit arg must be numeric, not `%s'.\n",
+ progname, optarg);
+ }
+ usage (stderr, FATAL);
+ break;
+
+ /* User specified reference warning limit? */
+ case 'r':
+ if (sscanf (optarg, "%d", &reference_warning_limit) != 1)
+ {
+ fprintf (stderr,
+ "%s: --reference-limit arg must be numeric, not `%s'.\n",
+ progname, optarg);
+ usage (FATAL);
+ }
+ break;
+
+ /* User specified footnote style? */
+ case 's':
+ if (set_footnote_style (optarg) < 0)
+ {
+ fprintf (stderr,
+ "%s: --footnote-style arg must be `separate' or `end', not `%s'.\n",
+ progname, optarg);
+ usage (FATAL);
+ }
+ footnote_style_preset = 1;
+ break;
+
+ case 'h':
+ usage (NO_ERROR);
+ break;
+
+ /* User requested version info? */
+ case 'V':
+ print_version_info ();
+ puts ("Copyright (C) 1996 Free Software Foundation, Inc.\n\
+There is NO warranty. You may redistribute this software\n\
+under the terms of the GNU General Public License.\n\
+For more information about these matters, see the files named COPYING.");
+ exit (NO_ERROR);
+ break;
+
+ case '?':
+ usage (FATAL);
+ break;
+ }
+ }
+
+ if (optind == argc)
+ {
+ /* Check to see if input is a file. If so, process that. */
+ if (!isatty (fileno (stdin)))
+ reading_from_stdin = 1;
+ else
+ {
+ fprintf (stderr, "%s: missing file argument.\n", progname);
+ usage (FATAL);
+ }
+ }
+
+ /* If the user has specified --no-headers, this should imply --no-split.
+ Do that here. I think it might also imply that we should ignore the
+ setfilename at the top of the file, but this might break some FSF things,
+ so I will hold off on that. */
+ if (no_headers)
+ {
+ splitting = 0;
+
+ /* If the user has not specified an output file, then use stdout by
+ default. */
+ if (!command_output_filename)
+ command_output_filename = strdup ("-");
+ }
+
+ if (verbose_mode)
+ print_version_info ();
+
+ /* Remaining arguments are file names of texinfo files.
+ Convert them, one by one. */
+ if (!reading_from_stdin)
+ {
+ while (optind != argc)
+ convert_from_file (argv[optind++]);
+ }
+ else
+ convert_from_stream (stdin, "stdin");
+
+ if (errors_printed)
+ return (SYNTAX);
+ else
+ return (NO_ERROR);
+}
+
+/* Display the version info of this invocation of Makeinfo. */
+void
+print_version_info ()
+{
+ printf ("GNU Makeinfo (Texinfo 3.9) %d.%d\n", major_version, minor_version);
+}
+
+/* **************************************************************** */
+/* */
+/* Generic Utilities */
+/* */
+/* **************************************************************** */
+
+static void
+memory_error (callers_name, bytes_wanted)
+ char *callers_name;
+ int bytes_wanted;
+{
+ char printable_string[80];
+
+ sprintf (printable_string,
+ "Virtual memory exhausted in %s ()! Needed %d bytes.",
+ callers_name, bytes_wanted);
+
+ error (printable_string);
+ abort ();
+}
+
+/* Just like malloc, but kills the program in case of fatal error. */
+void *
+xmalloc (nbytes)
+ unsigned int nbytes;
+{
+ void *temp = (void *) malloc (nbytes);
+
+ if (nbytes && temp == (void *)NULL)
+ memory_error ("xmalloc", nbytes);
+
+ return (temp);
+}
+
+/* Like realloc (), but barfs if there isn't enough memory. */
+void *
+xrealloc (pointer, nbytes)
+ void *pointer;
+ unsigned int nbytes;
+{
+ void *temp;
+
+ if (!pointer)
+ temp = (void *)xmalloc (nbytes);
+ else
+ temp = (void *)realloc (pointer, nbytes);
+
+ if (nbytes && !temp)
+ memory_error ("xrealloc", nbytes);
+
+ return (temp);
+}
+
+/* If EXIT_VALUE is zero, print the full usage message to stdout.
+ Otherwise, just say to use --help for more info.
+ Then exit with EXIT_VALUE. */
+void
+usage (exit_value)
+ int exit_value;
+{
+ if (exit_value != 0)
+ fprintf (stderr, "Try `%s --help' for more information.\n", progname);
+ else
+ printf ("Usage: %s [OPTION]... TEXINFO-FILE...\n\
+\n\
+Translate Texinfo source documentation to a format suitable for reading\n\
+with GNU Info.\n\
+\n\
+Options:\n\
+-D VAR define a variable, as with @set.\n\
+-E MACRO-OFILE process macros only, output texinfo source.\n\
+-I DIR add DIR to the directory search list for @include.\n\
+-U VAR undefine a variable, as with @clear.\n\
+--error-limit NUM quit after NUM errors (default %d).\n\
+--fill-column NUM break lines at NUM characters (default %d).\n\
+--footnote-style STYLE output footnotes according to STYLE:\n\
+ `separate' to place footnotes in their own node,\n\
+ `end' to place the footnotes at the end of\n\
+ the node in which they are defined (the default).\n\
+--help display this help and exit.\n\
+--no-validate suppress node cross-reference validation.\n\
+--no-warn suppress warnings (but not errors).\n\
+--no-split suppress splitting of large files.\n\
+--no-headers suppress node separators and Node: Foo headers.\n\
+--output FILE, -o FILE output to FILE, and ignore any @setfilename.\n\
+--paragraph-indent NUM indent paragraphs with NUM spaces (default %d).\n\
+--reference-limit NUM complain about at most NUM references (default %d).\n\
+--verbose report about what is being done.\n\
+--version display version information and exit.\n\
+\n\
+Email bug reports to bug-texinfo@prep.ai.mit.edu.\n\
+",
+ progname, paragraph_start_indent,
+ fill_column, max_error_level, reference_warning_limit);
+ exit (exit_value);
+}
+
+/* Manipulating Lists */
+
+typedef struct generic_list {
+ struct generic_list *next;
+} GENERIC_LIST;
+
+/* Reverse the chain of structures in LIST. Output the new head
+ of the chain. You should always assign the output value of this
+ function to something, or you will lose the chain. */
+GENERIC_LIST *
+reverse_list (list)
+ register GENERIC_LIST *list;
+{
+ register GENERIC_LIST *next;
+ register GENERIC_LIST *prev = (GENERIC_LIST *) NULL;
+
+ while (list)
+ {
+ next = list->next;
+ list->next = prev;
+ prev = list;
+ list = next;
+ }
+ return (prev);
+}
+
+/* Pushing and Popping Files */
+
+/* Find and load the file named FILENAME. Return a pointer to
+ the loaded file, or NULL if it can't be loaded. */
+char *
+find_and_load (filename)
+ char *filename;
+{
+ struct stat fileinfo;
+ long file_size;
+ int file = -1, n, i, count = 0;
+ char *fullpath, *result, *get_file_info_in_path ();
+
+ result = fullpath = (char *)NULL;
+
+ fullpath = get_file_info_in_path (filename, include_files_path, &fileinfo);
+
+ if (!fullpath)
+ goto error_exit;
+
+ filename = fullpath;
+ file_size = (long) fileinfo.st_size;
+
+ file = open (filename, O_RDONLY);
+ if (file < 0)
+ goto error_exit;
+
+ /* Load the file. */
+ result = (char *)xmalloc (1 + file_size);
+
+ /* VMS stat lies about the st_size value. The actual number of
+ readable bytes is always less than this value. The arcane
+ mysteries of VMS/RMS are too much to probe, so this hack
+ suffices to make things work. */
+#if defined (VMS)
+ while ((n = read (file, result + count, file_size)) > 0)
+ count += n;
+ if (n == -1)
+#else /* !VMS */
+ count = file_size;
+ if (read (file, result, file_size) != file_size)
+#endif /* !VMS */
+ error_exit:
+ {
+ if (result)
+ free (result);
+
+ if (fullpath)
+ free (fullpath);
+
+ if (file != -1)
+ close (file);
+
+ return ((char *) NULL);
+ }
+ close (file);
+
+ /* Set the globals to the new file. */
+ input_text = result;
+ size_of_input_text = count;
+ input_filename = fullpath;
+ node_filename = strdup (fullpath);
+ input_text_offset = 0;
+ line_number = 1;
+ /* Not strictly necessary. This magic prevents read_token () from doing
+ extra unnecessary work each time it is called (that is a lot of times).
+ The SIZE_OF_INPUT_TEXT is one past the actual end of the text. */
+ input_text[size_of_input_text] = '\n';
+ return (result);
+}
+
+/* Save the state of the current input file. */
+void
+pushfile ()
+{
+ FSTACK *newstack = (FSTACK *) xmalloc (sizeof (FSTACK));
+ newstack->filename = input_filename;
+ newstack->text = input_text;
+ newstack->size = size_of_input_text;
+ newstack->offset = input_text_offset;
+ newstack->line_number = line_number;
+ newstack->next = filestack;
+
+ filestack = newstack;
+ push_node_filename ();
+}
+
+/* Make the current file globals be what is on top of the file stack. */
+void
+popfile ()
+{
+ FSTACK *tos = filestack;
+
+ if (!tos)
+ abort (); /* My fault. I wonder what I did? */
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ {
+ maybe_write_itext (input_text, input_text_offset);
+ forget_itext (input_text);
+ }
+#endif /* HAVE_MACROS */
+
+ /* Pop the stack. */
+ filestack = filestack->next;
+
+ /* Make sure that commands with braces have been satisfied. */
+ if (!executing_string)
+ discard_braces ();
+
+ /* Get the top of the stack into the globals. */
+ input_filename = tos->filename;
+ input_text = tos->text;
+ size_of_input_text = tos->size;
+ input_text_offset = tos->offset;
+ line_number = tos->line_number;
+ free (tos);
+
+ /* Go back to the (now) current node. */
+ pop_node_filename ();
+}
+
+/* Flush all open files on the file stack. */
+void
+flush_file_stack ()
+{
+ while (filestack)
+ {
+ char *fname = input_filename;
+ char *text = input_text;
+ popfile ();
+ free (fname);
+ free (text);
+ }
+}
+
+int node_filename_stack_index = 0;
+int node_filename_stack_size = 0;
+char **node_filename_stack = (char **)NULL;
+
+void
+push_node_filename ()
+{
+ if (node_filename_stack_index + 1 > node_filename_stack_size)
+ node_filename_stack = (char **)xrealloc
+ (node_filename_stack, (node_filename_stack_size += 10) * sizeof (char *));
+
+ node_filename_stack[node_filename_stack_index] = node_filename;
+ node_filename_stack_index++;
+}
+
+void
+pop_node_filename ()
+{
+ node_filename = node_filename_stack[--node_filename_stack_index];
+}
+
+/* Return just the simple part of the filename; i.e. the
+ filename without the path information, or extensions.
+ This conses up a new string. */
+char *
+filename_part (filename)
+ char *filename;
+{
+ char *basename;
+
+ basename = strrchr (filename, '/');
+ if (!basename)
+ basename = filename;
+ else
+ basename++;
+
+ basename = strdup (basename);
+#if defined (REMOVE_OUTPUT_EXTENSIONS)
+
+ /* See if there is an extension to remove. If so, remove it. */
+ {
+ char *temp;
+
+ temp = strrchr (basename, '.');
+ if (temp)
+ *temp = '\0';
+ }
+#endif /* REMOVE_OUTPUT_EXTENSIONS */
+ return (basename);
+}
+
+/* Return the pathname part of filename. This can be NULL. */
+char *
+pathname_part (filename)
+ char *filename;
+{
+ char *expand_filename ();
+ char *result = (char *) NULL;
+ register int i;
+
+ filename = expand_filename (filename, "");
+
+ i = strlen (filename) - 1;
+
+ while (i && filename[i] != '/')
+ i--;
+ if (filename[i] == '/')
+ i++;
+
+ if (i)
+ {
+ result = (char *)xmalloc (1 + i);
+ strncpy (result, filename, i);
+ result[i] = '\0';
+ }
+ free (filename);
+ return (result);
+}
+
+char *
+filename_non_directory (name)
+ char *name;
+{
+ register int i;
+
+ for (i = strlen (name) - 1; i; i--)
+ if (name[i] == '/')
+ return (strdup (name + i + 1));
+
+ return (strdup (name));
+}
+
+/* Return the expansion of FILENAME. */
+char *
+expand_filename (filename, input_name)
+ char *filename, *input_name;
+{
+ register int i;
+ char *full_pathname ();
+
+ if (filename)
+ filename = full_pathname (filename);
+ else
+ {
+ filename = filename_non_directory (input_name);
+
+ if (!*filename)
+ {
+ free (filename);
+ filename = strdup ("noname.texi");
+ }
+
+ for (i = strlen (filename) - 1; i; i--)
+ if (filename[i] == '.')
+ break;
+
+ if (!i)
+ i = strlen (filename);
+
+ if (i + 6 > (strlen (filename)))
+ filename = (char *)xrealloc (filename, i + 6);
+ strcpy (filename + i, ".info");
+ return (filename);
+ }
+
+ if (filename[0] == '.' || filename[0] == '/')
+ return (filename);
+
+ if (filename[0] != '/' && input_name[0] == '/')
+ {
+ /* Make it so that relative names work. */
+ char *result;
+
+ i = strlen (input_name) - 1;
+
+ result = (char *)xmalloc (1 + strlen (input_name) + strlen (filename));
+ strcpy (result, input_name);
+
+ while (result[i] != '/' && i)
+ i--;
+
+ if (result[i] == '/')
+ i++;
+
+ strcpy (&result[i], filename);
+ free (filename);
+ return (result);
+ }
+ return (filename);
+}
+
+/* Return the full path to FILENAME. */
+char *
+full_pathname (filename)
+ char *filename;
+{
+ int initial_character;
+ char *result;
+
+ /* No filename given? */
+ if (!filename || !(initial_character = *filename))
+ return (strdup (""));
+
+ /* Already absolute? */
+ if ((initial_character == '/') ||
+ ((strncmp (filename, "./", 2) == 0) ||
+ (strncmp (filename, "../", 3) == 0)))
+ return (strdup (filename));
+
+ if (initial_character != '~')
+ {
+ char *localdir;
+
+ localdir = (char *)xmalloc (1025);
+#if defined (HAVE_GETCWD)
+ if (!getcwd (localdir, 1024))
+#else /* !HAVE_GETCWD */
+ if (!getwd (localdir))
+#endif /* !HAVE_GETCWD */
+ {
+ fprintf (stderr, "%s: getwd: %s, %s\n",
+ progname, filename, localdir);
+ exit (1);
+ }
+
+ strcat (localdir, "/");
+ strcat (localdir, filename);
+ result = strdup (localdir);
+ free (localdir);
+ }
+ else
+ {
+ if (filename[1] == '/')
+ {
+ /* Return the concatenation of the environment variable HOME
+ and the rest of the string. */
+ char *temp_home;
+
+ temp_home = (char *) getenv ("HOME");
+ result = (char *)xmalloc (strlen (&filename[1])
+ + 1
+ + temp_home ? strlen (temp_home)
+ : 0);
+ *result = '\0';
+
+ if (temp_home)
+ strcpy (result, temp_home);
+
+ strcat (result, &filename[1]);
+ }
+ else
+ {
+ struct passwd *user_entry;
+ int i, c;
+ char *username = (char *)xmalloc (257);
+
+ for (i = 1; c = filename[i]; i++)
+ {
+ if (c == '/')
+ break;
+ else
+ username[i - 1] = c;
+ }
+ if (c)
+ username[i - 1] = '\0';
+
+ user_entry = getpwnam (username);
+
+ if (!user_entry)
+ return (strdup (filename));
+
+ result = (char *)xmalloc (1 + strlen (user_entry->pw_dir)
+ + strlen (&filename[i]));
+ strcpy (result, user_entry->pw_dir);
+ strcat (result, &filename[i]);
+ }
+ }
+ return (result);
+}
+
+char *
+output_name_from_input_name (name)
+ char *name;
+{
+ return (expand_filename ((char *)NULL, name));
+}
+
+/* **************************************************************** */
+/* */
+/* Error Handling */
+/* */
+/* **************************************************************** */
+
+/* Number of errors encountered. */
+int errors_printed = 0;
+
+/* Print the last error gotten from the file system. */
+int
+fs_error (filename)
+ char *filename;
+{
+ remember_error ();
+ perror (filename);
+ return (0);
+}
+
+/* Print an error message, and return false. */
+#if defined (HAVE_VARARGS_H) && defined (HAVE_VFPRINTF)
+
+int
+error (va_alist)
+ va_dcl
+{
+ char *format;
+ va_list args;
+
+ remember_error ();
+ va_start (args);
+ format = va_arg (args, char *);
+ vfprintf (stderr, format, args);
+ va_end (args);
+ putc ('\n', stderr);
+}
+
+/* Just like error (), but print the line number as well. */
+int
+line_error (va_alist)
+ va_dcl
+{
+ char *format;
+ va_list args;
+
+ remember_error ();
+ va_start (args);
+ format = va_arg (args, char *);
+ fprintf (stderr, "%s:%d: ", input_filename, line_number);
+ vfprintf (stderr, format, args);
+ fprintf (stderr, ".\n");
+ va_end (args);
+ return ((int) 0);
+}
+
+int
+warning (va_alist)
+ va_dcl
+{
+ char *format;
+ va_list args;
+
+ va_start (args);
+ format = va_arg (args, char *);
+ if (print_warnings)
+ {
+ fprintf (stderr, "%s:%d: Warning: ", input_filename, line_number);
+ vfprintf (stderr, format, args);
+ fprintf (stderr, ".\n");
+ }
+ va_end (args);
+ return ((int) 0);
+}
+
+#else /* !(HAVE_VARARGS_H && HAVE_VFPRINTF) */
+
+int
+error (format, arg1, arg2, arg3, arg4, arg5)
+ char *format;
+{
+ remember_error ();
+ fprintf (stderr, format, arg1, arg2, arg3, arg4, arg5);
+ putc ('\n', stderr);
+ return ((int) 0);
+}
+
+/* Just like error (), but print the line number as well. */
+int
+line_error (format, arg1, arg2, arg3, arg4, arg5)
+ char *format;
+{
+ remember_error ();
+ fprintf (stderr, "%s:%d: ", input_filename, line_number);
+ fprintf (stderr, format, arg1, arg2, arg3, arg4, arg5);
+ fprintf (stderr, ".\n");
+ return ((int) 0);
+}
+
+int
+warning (format, arg1, arg2, arg3, arg4, arg5)
+ char *format;
+{
+ if (print_warnings)
+ {
+ fprintf (stderr, "%s:%d: Warning: ", input_filename, line_number);
+ fprintf (stderr, format, arg1, arg2, arg3, arg4, arg5);
+ fprintf (stderr, ".\n");
+ }
+ return ((int) 0);
+}
+
+#endif /* !(HAVE_VARARGS_H && HAVE_VFPRINTF) */
+
+/* Remember that an error has been printed. If this is the first
+ error printed, then tell them which program is printing them.
+ If more than max_error_level have been printed, then exit the
+ program. */
+void
+remember_error ()
+{
+ errors_printed++;
+ if (max_error_level && (errors_printed > max_error_level))
+ {
+ fprintf (stderr, "Too many errors! Gave up.\n");
+ flush_file_stack ();
+ cm_bye ();
+ exit (1);
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Hacking Tokens and Strings */
+/* */
+/* **************************************************************** */
+
+/* Return the next token as a string pointer. We cons the string. */
+char *
+read_token ()
+{
+ int i, character;
+ char *result;
+
+ /* If the first character to be read is self-delimiting, then that
+ is the command itself. */
+ character = curchar ();
+ if (self_delimiting (character))
+ {
+ input_text_offset++;
+
+ if (character == '\n')
+ line_number++;
+
+ result = strdup (" ");
+ *result = character;
+ return (result);
+ }
+
+ for (i = 0; ((input_text_offset != size_of_input_text)
+ && (character = curchar ())
+ && command_char (character));
+ i++, input_text_offset++);
+ result = (char *)xmalloc (i + 1);
+ memcpy (result, &input_text[input_text_offset - i], i);
+ result[i] = '\0';
+ return (result);
+}
+
+/* Return non-zero if CHARACTER is self-delimiting. */
+int
+self_delimiting (character)
+ int character;
+{
+ /* @; and @\ are not Texinfo commands, but they are listed here
+ anyway. I don't know why. --karl, 10aug96. */
+ return member (character, "~{|}`^\\@?=;:.-,*\'\" !\n\t");
+}
+
+/* Clear whitespace from the front and end of string. */
+void
+canon_white (string)
+ char *string;
+{
+ int len = strlen (string);
+ int x;
+
+ if (!len)
+ return;
+
+ for (x = 0; x < len; x++)
+ {
+ if (!cr_or_whitespace (string[x]))
+ {
+ strcpy (string, string + x);
+ break;
+ }
+ }
+ len = strlen (string);
+ if (len)
+ len--;
+ while (len > -1 && cr_or_whitespace (string[len]))
+ len--;
+ string[len + 1] = '\0';
+}
+
+/* Bash STRING, replacing all whitespace with just one space. */
+void
+fix_whitespace (string)
+ char *string;
+{
+ char *temp = (char *)xmalloc (strlen (string) + 1);
+ int string_index = 0;
+ int temp_index = 0;
+ int c;
+
+ canon_white (string);
+
+ while (string[string_index])
+ {
+ c = temp[temp_index++] = string[string_index++];
+
+ if (c == ' ' || c == '\n' || c == '\t')
+ {
+ temp[temp_index - 1] = ' ';
+ while ((c = string[string_index]) && (c == ' ' ||
+ c == '\t' ||
+ c == '\n'))
+ string_index++;
+ }
+ }
+ temp[temp_index] = '\0';
+ strcpy (string, temp);
+ free (temp);
+}
+
+/* Discard text until the desired string is found. The string is
+ included in the discarded text. */
+void
+discard_until (string)
+ char *string;
+{
+ int temp = search_forward (string, input_text_offset);
+
+ int tt = (temp < 0) ? size_of_input_text : temp + strlen (string);
+ int from = input_text_offset;
+
+ /* Find out what line we are on. */
+ while (from != tt)
+ if (input_text[from++] == '\n')
+ line_number++;
+
+ if (temp < 0)
+ {
+ input_text_offset = size_of_input_text - strlen (string);
+
+ if (strcmp (string, "\n") != 0)
+ {
+ line_error ("Expected `%s'", string);
+ return;
+ }
+ }
+ else
+ input_text_offset = temp;
+
+ input_text_offset += strlen (string);
+}
+
+/* Read characters from the file until we are at MATCH.
+ Place the characters read into STRING.
+ On exit input_text_offset is after the match string.
+ Return the offset where the string starts. */
+int
+get_until (match, string)
+ char *match, **string;
+{
+ int len, current_point, x, new_point, tem;
+
+ current_point = x = input_text_offset;
+ new_point = search_forward (match, input_text_offset);
+
+ if (new_point < 0)
+ new_point = size_of_input_text;
+ len = new_point - current_point;
+
+ /* Keep track of which line number we are at. */
+ tem = new_point + (strlen (match) - 1);
+ while (x != tem)
+ if (input_text[x++] == '\n')
+ line_number++;
+
+ *string = (char *)xmalloc (len + 1);
+
+ memcpy (*string, &input_text[current_point], len);
+ (*string)[len] = '\0';
+
+ /* Now leave input_text_offset in a consistent state. */
+ input_text_offset = tem;
+
+ if (input_text_offset > size_of_input_text)
+ input_text_offset = size_of_input_text;
+
+ return (new_point);
+}
+
+/* Read characters from the file until we are at MATCH or end of line.
+ Place the characters read into STRING. */
+void
+get_until_in_line (match, string)
+ char *match, **string;
+{
+ int real_bottom, temp;
+
+ real_bottom = size_of_input_text;
+ temp = search_forward ("\n", input_text_offset);
+
+ if (temp < 0)
+ temp = size_of_input_text;
+
+ size_of_input_text = temp;
+ get_until (match, string);
+ size_of_input_text = real_bottom;
+}
+
+void
+get_rest_of_line (string)
+ char **string;
+{
+ get_until ("\n", string);
+ canon_white (*string);
+
+ if (curchar () == '\n') /* as opposed to the end of the file... */
+ {
+ line_number++;
+ input_text_offset++;
+ }
+}
+
+/* Backup the input pointer to the previous character, keeping track
+ of the current line number. */
+void
+backup_input_pointer ()
+{
+ if (input_text_offset)
+ {
+ input_text_offset--;
+ if (curchar () == '\n')
+ line_number--;
+ }
+}
+
+/* Read characters from the file until we are at MATCH or closing brace.
+ Place the characters read into STRING. */
+void
+get_until_in_braces (match, string)
+ char *match, **string;
+{
+ int i, brace = 0;
+ int match_len = strlen (match);
+ char *temp;
+
+ for (i = input_text_offset; i < size_of_input_text; i++)
+ {
+ if (input_text[i] == '{')
+ brace++;
+ else if (input_text[i] == '}')
+ brace--;
+ else if (input_text[i] == '\n')
+ line_number++;
+
+ if (brace < 0 ||
+ (brace == 0 && strncmp (input_text + i, match, match_len) == 0))
+ break;
+ }
+
+ match_len = i - input_text_offset;
+ temp = (char *)xmalloc (2 + match_len);
+ strncpy (temp, input_text + input_text_offset, match_len);
+ temp[match_len] = '\0';
+ input_text_offset = i;
+ *string = temp;
+}
+
+/* **************************************************************** */
+/* */
+/* Converting the File */
+/* */
+/* **************************************************************** */
+
+/* Convert the file named by NAME. The output is saved on the file
+ named as the argument to the @setfilename command. */
+static char *suffixes[] = {
+ ".texinfo",
+ ".texi",
+ ".txinfo",
+ "",
+ (char *)NULL
+};
+
+void
+initialize_conversion ()
+{
+ init_tag_table ();
+ init_indices ();
+ init_internals ();
+ init_paragraph ();
+
+ /* This is used for splitting the output file and for doing section
+ headings. It was previously initialized in `init_paragraph', but its
+ use there loses with the `init_paragraph' calls done by the
+ multitable code; the tag indices get reset to zero. */
+ output_position = 0;
+}
+
+/* We read in multiples of 4k, simply because it is a typical pipe size
+ on unix systems. */
+#define READ_BUFFER_GROWTH (4 * 4096)
+
+/* Convert the texinfo file coming from the open stream STREAM. Assume the
+ source of the stream is named NAME. */
+void
+convert_from_stream (stream, name)
+ FILE *stream;
+ char *name;
+{
+ char *buffer = (char *)NULL;
+ int buffer_offset = 0, buffer_size = 0;
+
+ initialize_conversion ();
+
+ /* Read until the end of the stream. This isn't strictly correct, since
+ the texinfo input may end before the stream ends, but it is a quick
+ working hueristic. */
+ while (!feof (stream))
+ {
+ int count;
+
+ if (buffer_offset + (READ_BUFFER_GROWTH + 1) >= buffer_size)
+ buffer = (char *)
+ xrealloc (buffer, (buffer_size += READ_BUFFER_GROWTH));
+
+ count = fread (buffer + buffer_offset, 1, READ_BUFFER_GROWTH, stream);
+
+ if (count < 0)
+ {
+ perror (name);
+ exit (FATAL);
+ }
+
+ buffer_offset += count;
+ if (count == 0)
+ break;
+ }
+
+ /* Set the globals to the new file. */
+ input_text = buffer;
+ size_of_input_text = buffer_offset;
+ input_filename = strdup (name);
+ node_filename = strdup (name);
+ input_text_offset = 0;
+ line_number = 1;
+
+ /* Not strictly necessary. This magic prevents read_token () from doing
+ extra unnecessary work each time it is called (that is a lot of times).
+ The SIZE_OF_INPUT_TEXT is one past the actual end of the text. */
+ input_text[size_of_input_text] = '\n';
+
+ convert_from_loaded_file (name);
+}
+
+void
+convert_from_file (name)
+ char *name;
+{
+ register int i;
+ char *filename = (char *)xmalloc (strlen (name) + 50);
+
+ initialize_conversion ();
+
+ /* Try to load the file specified by NAME, concatenated with our
+ various suffixes. Prefer files like `makeinfo.texi' to
+ `makeinfo'. */
+ for (i = 0; suffixes[i]; i++)
+ {
+ strcpy (filename, name);
+ strcat (filename, suffixes[i]);
+
+ if (find_and_load (filename))
+ break;
+
+ if (!suffixes[i][0] && strrchr (filename, '.'))
+ {
+ fs_error (filename);
+ free (filename);
+ return;
+ }
+ }
+
+ if (!suffixes[i])
+ {
+ fs_error (name);
+ free (filename);
+ return;
+ }
+
+ input_filename = filename;
+
+ convert_from_loaded_file (name);
+}
+
+void
+convert_from_loaded_file (name)
+ char *name;
+{
+ char *expand_filename (), *filename_part ();
+ char *real_output_filename = (char *)NULL;
+
+#if defined (HAVE_MACROS)
+ remember_itext (input_text, 0);
+#endif /* HAVE_MACROS */
+
+ /* Search this file looking for the special string which starts conversion.
+ Once found, we may truly begin. */
+ input_text_offset = 0;
+ while (input_text_offset >= 0)
+ {
+ input_text_offset =
+ search_forward (setfilename_search, input_text_offset);
+
+ if ((input_text_offset == 0) ||
+ ((input_text_offset > 0) &&
+ (input_text[input_text_offset -1] == '\n')))
+ break;
+ else if (input_text_offset > 0)
+ input_text_offset++;
+ }
+
+ if (input_text_offset < 0)
+ {
+ if (!command_output_filename)
+ {
+#if defined (REQUIRE_SETFILENAME)
+ error ("No `%s' found in `%s'", setfilename_search, name);
+ goto finished;
+#else
+ register int i, end_of_first_line;
+
+ /* Find the end of the first line in the file. */
+ for (i = 0; i < size_of_input_text - 1; i++)
+ if (input_text[i] == '\n')
+ break;
+
+ end_of_first_line = i + 1;
+
+ input_text_offset = 0;
+
+ for (i = 0; i < end_of_first_line; i++)
+ {
+ if ((input_text[i] == '\\') &&
+ (strncmp (input_text + i + 1, "include", 7) == 0))
+ {
+ input_text_offset = end_of_first_line;
+ break;
+ }
+ }
+ command_output_filename = output_name_from_input_name (name);
+#endif /* !REQUIRE_SETFILENAME */
+ }
+ }
+ else
+ input_text_offset += strlen (setfilename_search);
+
+ if (!command_output_filename)
+ get_until ("\n", &output_filename);
+ else
+ {
+ if (input_text_offset != -1)
+ discard_until ("\n");
+ else
+ input_text_offset = 0;
+
+ real_output_filename = output_filename = command_output_filename;
+ command_output_filename = (char *)NULL;
+ }
+
+ canon_white (output_filename);
+
+ if (real_output_filename &&
+ strcmp (real_output_filename, "-") == 0)
+ {
+ real_output_filename = strdup (real_output_filename);
+ output_stream = stdout;
+ splitting = 0; /* Cannot split when writing to stdout. */
+ }
+ else
+ {
+ if (!real_output_filename)
+ real_output_filename = expand_filename (output_filename, name);
+ else
+ real_output_filename = strdup (real_output_filename);
+
+ output_stream = fopen (real_output_filename, "w");
+ }
+
+ if (output_stream != stdout)
+ printf ("Making %s file `%s' from `%s'.\n",
+ no_headers ? "text" : "info", output_filename, input_filename);
+
+ if (output_stream == NULL)
+ {
+ fs_error (real_output_filename);
+ goto finished;
+ }
+
+ /* Make the displayable filename from output_filename. Only the base
+ portion of the filename need be displayed. */
+ if (output_stream != stdout)
+ pretty_output_filename = filename_part (output_filename);
+ else
+ pretty_output_filename = strdup ("stdout");
+
+ /* For this file only, count the number of newlines from the top of
+ the file to here. This way, we keep track of line numbers for
+ error reporting. Line_number starts at 1, since the user isn't
+ zero-based. */
+ {
+ int temp = 0;
+ line_number = 1;
+ while (temp != input_text_offset)
+ if (input_text[temp++] == '\n')
+ line_number++;
+ }
+
+ if (!no_headers)
+ {
+ add_word_args ("This is Info file %s, produced by Makeinfo version %d.%d",
+ output_filename, major_version, minor_version);
+ add_word_args (" from the input file %s.\n", input_filename);
+ }
+
+ close_paragraph ();
+ reader_loop ();
+
+finished:
+ close_paragraph ();
+ flush_file_stack ();
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ fclose (macro_expansion_output_stream);
+#endif /* HAVE_MACROS */
+
+ if (output_stream != NULL)
+ {
+ output_pending_notes ();
+ free_pending_notes ();
+ if (tag_table != NULL)
+ {
+ tag_table = (TAG_ENTRY *) reverse_list (tag_table);
+ if (!no_headers)
+ write_tag_table ();
+ }
+
+ if (output_stream != stdout)
+ fclose (output_stream);
+
+ /* If validating, then validate the entire file right now. */
+ if (validating)
+ validate_file (tag_table);
+
+ /* This used to test && !errors_printed.
+ But some files might have legit warnings. So split anyway. */
+ if (splitting)
+ split_file (real_output_filename, 0);
+ }
+ free (real_output_filename);
+}
+
+void
+free_and_clear (pointer)
+ char **pointer;
+{
+ if ((*pointer) != (char *) NULL)
+ {
+ free (*pointer);
+ *pointer = (char *) NULL;
+ }
+}
+
+ /* Initialize some state. */
+void
+init_internals ()
+{
+ free_and_clear (&current_node);
+ free_and_clear (&output_filename);
+ free_and_clear (&command);
+ free_and_clear (&input_filename);
+ free_node_references ();
+ init_insertion_stack ();
+ init_brace_stack ();
+ command_index = 0;
+ in_menu = 0;
+ in_detailmenu = 0;
+ top_node_seen = 0;
+ non_top_node_seen = 0;
+}
+
+void
+init_paragraph ()
+{
+ free_and_clear (&output_paragraph);
+ output_paragraph = (unsigned char *)xmalloc (paragraph_buffer_len);
+ output_paragraph[0] = '\0';
+ output_paragraph_offset = 0;
+ output_column = 0;
+ paragraph_is_open = 0;
+ current_indent = 0;
+}
+
+/* Okay, we are ready to start the conversion. Call the reader on
+ some text, and fill the text as it is output. Handle commands by
+ remembering things like open braces and the current file position on a
+ stack, and when the corresponding close brace is found, you can call
+ the function with the proper arguments. */
+void
+reader_loop ()
+{
+ int character;
+ int done = 0;
+ int dash_count = 0;
+
+ while (!done)
+ {
+ if (input_text_offset >= size_of_input_text)
+ break;
+
+ character = curchar ();
+
+ if (!in_fixed_width_font &&
+ (character == '\'' || character == '`') &&
+ input_text[input_text_offset + 1] == character)
+ {
+ input_text_offset++;
+ character = '"';
+ }
+
+ if (character == '-')
+ {
+ dash_count++;
+ if (dash_count == 2 && !in_fixed_width_font)
+ {
+ input_text_offset++;
+ continue;
+ }
+ }
+ else
+ {
+ dash_count = 0;
+ }
+
+ /* If this is a whitespace character, then check to see if the line
+ is blank. If so, advance to the carriage return. */
+ if (whitespace (character))
+ {
+ register int i = input_text_offset + 1;
+
+ while (i < size_of_input_text && whitespace (input_text[i]))
+ i++;
+
+ if (i == size_of_input_text || input_text[i] == '\n')
+ {
+ if (i == size_of_input_text)
+ i--;
+
+ input_text_offset = i;
+ character = curchar ();
+ }
+ }
+
+ if (character == '\n')
+ {
+ line_number++;
+
+ /* Check for a menu entry here, since the "escape sequence"
+ that begins menu entries is "\n* ". */
+ if (in_menu && input_text_offset + 1 < size_of_input_text)
+ {
+ char *glean_node_from_menu (), *tem;
+
+ /* Note that the value of TEM is discarded, since it is
+ gauranteed to be NULL when glean_node_from_menu () is
+ called with a non-zero argument. */
+ if (!in_detailmenu)
+ tem = glean_node_from_menu (1);
+ }
+ }
+
+ switch (character)
+ {
+ case COMMAND_PREFIX:
+ read_command ();
+ break;
+
+ case '{':
+
+ /* Special case. I'm not supposed to see this character by itself.
+ If I do, it means there is a syntax error in the input text.
+ Report the error here, but remember this brace on the stack so
+ you can ignore its partner. */
+
+ line_error ("Misplaced `{'");
+ remember_brace (misplaced_brace);
+
+ /* Don't advance input_text_offset since this happens in
+ remember_brace ().
+ input_text_offset++;
+ */
+ break;
+
+ case '}':
+ pop_and_call_brace ();
+ input_text_offset++;
+ break;
+
+ default:
+ add_char (character);
+ input_text_offset++;
+ }
+ }
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ maybe_write_itext (input_text, input_text_offset);
+#endif /* HAVE_MACROS */
+}
+
+/* Find the command corresponding to STRING. If the command
+ is found, return a pointer to the data structure. Otherwise
+ return (-1). */
+COMMAND *
+get_command_entry (string)
+ char *string;
+{
+ register int i;
+
+ for (i = 0; CommandTable[i].name; i++)
+ if (strcmp (CommandTable[i].name, string) == 0)
+ return (&CommandTable[i]);
+
+ /* This command is not in our predefined command table. Perhaps
+ it is a user defined command. */
+ for (i = 0; i < user_command_array_len; i++)
+ if (user_command_array[i] &&
+ (strcmp (user_command_array[i]->name, string) == 0))
+ return (user_command_array[i]);
+
+ /* Nope, we never heard of this command. */
+ return ((COMMAND *) -1);
+}
+
+/* input_text_offset is right at the command prefix character.
+ Read the next token to determine what to do. */
+void
+read_command ()
+{
+ COMMAND *entry;
+
+ input_text_offset++;
+ free_and_clear (&command);
+ command = read_token ();
+
+#if defined (HAVE_MACROS)
+ /* Check to see if this command is a macro. If so, execute it here. */
+ {
+ MACRO_DEF *def;
+
+ def = find_macro (command);
+
+ if (def)
+ {
+ /* We disallow recursive use of a macro call. Inhibit the expansion
+ of this macro during the life of its execution. */
+ if (!(def->flags & ME_RECURSE))
+ def->inhibited = 1;
+
+ execute_macro (def);
+
+ if (!(def->flags & ME_RECURSE))
+ def->inhibited = 0;
+
+ return;
+ }
+ }
+#endif /* HAVE_MACROS */
+
+ entry = get_command_entry (command);
+
+ if (entry == (COMMAND *)-1)
+ {
+ line_error ("Unknown command `%s'", command);
+ return;
+ }
+
+ if (entry->argument_in_braces)
+ remember_brace (entry->proc);
+
+ (*(entry->proc)) (START, output_paragraph_offset, 0);
+}
+
+/* Return the string which invokes PROC; a pointer to a function. */
+char *
+find_proc_name (proc)
+ COMMAND_FUNCTION *proc;
+{
+ register int i;
+
+ for (i = 0; CommandTable[i].name; i++)
+ if (proc == CommandTable[i].proc)
+ return (CommandTable[i].name);
+ return ("NO_NAME!");
+}
+
+void
+init_brace_stack ()
+{
+ brace_stack = (BRACE_ELEMENT *) NULL;
+}
+
+void
+remember_brace (proc)
+ COMMAND_FUNCTION *proc;
+{
+ if (curchar () != '{')
+ line_error ("%c%s expected `{..}'", COMMAND_PREFIX, command);
+ else
+ input_text_offset++;
+ remember_brace_1 (proc, output_paragraph_offset);
+}
+
+/* Remember the current output position here. Save PROC
+ along with it so you can call it later. */
+void
+remember_brace_1 (proc, position)
+ COMMAND_FUNCTION *proc;
+ int position;
+{
+ BRACE_ELEMENT *new = (BRACE_ELEMENT *) xmalloc (sizeof (BRACE_ELEMENT));
+ new->next = brace_stack;
+ new->proc = proc;
+ new->pos = position;
+ new->line = line_number;
+ new->in_fixed_width_font = in_fixed_width_font;
+ brace_stack = new;
+}
+
+/* Pop the top of the brace stack, and call the associated function
+ with the args END and POS. */
+void
+pop_and_call_brace ()
+{
+ BRACE_ELEMENT *temp;
+ COMMAND_FUNCTION *proc;
+ int pos;
+
+ if (brace_stack == (BRACE_ELEMENT *) NULL)
+ {
+ line_error ("Unmatched }");
+ return;
+ }
+
+ pos = brace_stack->pos;
+ proc = brace_stack->proc;
+ in_fixed_width_font = brace_stack->in_fixed_width_font;
+ temp = brace_stack->next;
+ free (brace_stack);
+ brace_stack = temp;
+
+ (*proc) (END, pos, output_paragraph_offset);
+}
+
+/* Shift all of the markers in `brace_stack' by AMOUNT. */
+void
+adjust_braces_following (here, amount)
+ int here, amount;
+{
+ register BRACE_ELEMENT *stack = brace_stack;
+
+ while (stack)
+ {
+ if (stack->pos >= here)
+ stack->pos += amount;
+ stack = stack->next;
+ }
+}
+
+/* You call discard_braces () when you shouldn't have any braces on the stack.
+ I used to think that this happens for commands that don't take arguments
+ in braces, but that was wrong because of things like @code{foo @@}. So now
+ I only detect it at the beginning of nodes. */
+void
+discard_braces ()
+{
+ if (!brace_stack)
+ return;
+
+ while (brace_stack)
+ {
+ if (brace_stack->proc != misplaced_brace)
+ {
+ char *proc_name;
+ int temp_line_number = line_number;
+
+ line_number = brace_stack->line;
+ proc_name = find_proc_name (brace_stack->proc);
+ line_error ("%c%s missing close brace", COMMAND_PREFIX, proc_name);
+ line_number = temp_line_number;
+ pop_and_call_brace ();
+ }
+ else
+ {
+ BRACE_ELEMENT *temp;
+ temp = brace_stack->next;
+ free (brace_stack);
+ brace_stack = temp;
+ }
+ }
+}
+
+int
+get_char_len (character)
+ int character;
+{
+ /* Return the printed length of the character. */
+ int len;
+
+ switch (character)
+ {
+ case '\t':
+ len = (output_column + 8) & 0xf7;
+ if (len > fill_column)
+ len = fill_column - output_column;
+ else
+ len = len - output_column;
+ break;
+
+ case '\n':
+ len = fill_column - output_column;
+ break;
+
+ default:
+ if (character < ' ')
+ len = 2;
+ else
+ len = 1;
+ }
+ return (len);
+}
+
+#if defined (HAVE_VARARGS_H) && defined (HAVE_VSPRINTF)
+
+void
+add_word_args (va_alist)
+ va_dcl
+{
+ char buffer[1000];
+ char *format;
+ va_list args;
+
+ va_start (args);
+ format = va_arg (args, char *);
+ vsprintf (buffer, format, args);
+ va_end (args);
+ add_word (buffer);
+}
+
+#else /* !(HAVE_VARARGS_H && HAVE_VSPRINTF) */
+
+void
+add_word_args (format, arg1, arg2, arg3, arg4, arg5)
+ char *format;
+{
+ char buffer[1000];
+ sprintf (buffer, format, arg1, arg2, arg3, arg4, arg5);
+ add_word (buffer);
+}
+
+#endif /* !(HAVE_VARARGS_H && HAVE_VSPRINTF) */
+
+/* Add STRING to output_paragraph. */
+void
+add_word (string)
+ char *string;
+{
+ while (*string)
+ add_char (*string++);
+}
+
+/* Non-zero if the last character inserted has the syntax class of NEWLINE. */
+int last_char_was_newline = 1;
+
+/* The actual last inserted character. Note that this may be something
+ other than NEWLINE even if last_char_was_newline is 1. */
+int last_inserted_character = 0;
+
+/* Non-zero means that a newline character has already been
+ inserted, so close_paragraph () should insert one less. */
+int line_already_broken = 0;
+
+/* When non-zero we have finished an insertion (see end_insertion ()) and we
+ want to ignore false continued paragraph closings. */
+int insertion_paragraph_closed = 0;
+
+/* Non-zero means attempt to make all of the lines have fill_column width. */
+int do_justification = 0;
+
+/* Add the character to the current paragraph. If filling_enabled is
+ non-zero, then do filling as well. */
+void
+add_char (character)
+ int character;
+{
+ /* If we are avoiding outputting headers, and we are currently
+ in a menu, then simply return. */
+ if (no_headers && (in_menu || in_detailmenu))
+ return;
+
+ /* If we are adding a character now, then we don't have to
+ ignore close_paragraph () calls any more. */
+ if (must_start_paragraph && character != '\n')
+ {
+ must_start_paragraph = 0;
+ line_already_broken = 0; /* The line is no longer broken. */
+ if (current_indent > output_column)
+ {
+ indent (current_indent - output_column);
+ output_column = current_indent;
+ }
+ }
+
+ if (non_splitting_words && member (character, " \t\n"))
+ character = ' ' | 0x80;
+
+ insertion_paragraph_closed = 0;
+
+ switch (character)
+ {
+ case '\n':
+ if (!filling_enabled)
+ {
+ insert ('\n');
+
+ if (force_flush_right)
+ {
+ close_paragraph ();
+ /* Hack to force single blank lines out in this mode. */
+ flush_output ();
+ }
+
+ output_column = 0;
+
+ if (!no_indent && paragraph_is_open)
+ indent (output_column = current_indent);
+ break;
+ }
+ else /* CHARACTER is newline, and filling is enabled. */
+ {
+ if (sentence_ender (last_inserted_character))
+ {
+ insert (' ');
+ output_column++;
+ last_inserted_character = character;
+ }
+ }
+
+ if (last_char_was_newline)
+ {
+ close_paragraph ();
+ pending_indent = 0;
+ }
+ else
+ {
+ last_char_was_newline = 1;
+ insert (' ');
+ output_column++;
+ }
+ break;
+
+ default:
+ {
+ int len = get_char_len (character);
+ int suppress_insert = 0;
+
+ if ((character == ' ') && (last_char_was_newline))
+ {
+ if (!paragraph_is_open)
+ {
+ pending_indent++;
+ return;
+ }
+ }
+
+ if (!paragraph_is_open)
+ {
+ start_paragraph ();
+
+ /* If the paragraph is supposed to be indented a certain way,
+ then discard all of the pending whitespace. Otherwise, we
+ let the whitespace stay. */
+ if (!paragraph_start_indent)
+ indent (pending_indent);
+ pending_indent = 0;
+ }
+
+ if ((output_column += len) > fill_column)
+ {
+ if (filling_enabled)
+ {
+ int temp = output_paragraph_offset;
+ while (--temp > 0 && output_paragraph[temp] != '\n')
+ {
+ /* If we have found a space, we have the place to break
+ the line. */
+ if (output_paragraph[temp] == ' ')
+ {
+ /* Remove trailing whitespace from output. */
+ while (temp && whitespace (output_paragraph[temp - 1]))
+ temp--;
+
+ output_paragraph[temp++] = '\n';
+
+ /* We have correctly broken the line where we want
+ to. What we don't want is spaces following where
+ we have decided to break the line. We get rid of
+ them. */
+ {
+ int t1 = temp;
+
+ for (;; t1++)
+ {
+ if (t1 == output_paragraph_offset)
+ {
+ if (whitespace (character))
+ suppress_insert = 1;
+ break;
+ }
+ if (!whitespace (output_paragraph[t1]))
+ break;
+ }
+
+ if (t1 != temp)
+ {
+ adjust_braces_following (temp, (- (t1 - temp)));
+ strncpy ((char *) &output_paragraph[temp],
+ (char *) &output_paragraph[t1],
+ (output_paragraph_offset - t1));
+ output_paragraph_offset -= (t1 - temp);
+ }
+ }
+
+ /* Filled, but now indent if that is right. */
+ if (indented_fill && current_indent)
+ {
+ int buffer_len = ((output_paragraph_offset - temp)
+ + current_indent);
+ char *temp_buffer = (char *)xmalloc (buffer_len);
+ int indentation = 0;
+
+ /* We have to shift any markers that are in
+ front of the wrap point. */
+ adjust_braces_following (temp, current_indent);
+
+ while (current_indent > 0 &&
+ indentation != current_indent)
+ temp_buffer[indentation++] = ' ';
+
+ strncpy ((char *) &temp_buffer[current_indent],
+ (char *) &output_paragraph[temp],
+ buffer_len - current_indent);
+
+ if (output_paragraph_offset + buffer_len
+ >= paragraph_buffer_len)
+ {
+ unsigned char *tt = xrealloc
+ (output_paragraph,
+ (paragraph_buffer_len += buffer_len));
+ output_paragraph = tt;
+ }
+ strncpy ((char *) &output_paragraph[temp],
+ temp_buffer, buffer_len);
+ output_paragraph_offset += current_indent;
+ free (temp_buffer);
+ }
+ output_column = 0;
+ while (temp < output_paragraph_offset)
+ output_column +=
+ get_char_len (output_paragraph[temp++]);
+ output_column += len;
+ break;
+ }
+ }
+ }
+ }
+
+ if (!suppress_insert)
+ {
+ insert (character);
+ last_inserted_character = character;
+ }
+ last_char_was_newline = 0;
+ line_already_broken = 0;
+ }
+ }
+}
+
+/* Insert CHARACTER into `output_paragraph'. */
+void
+insert (character)
+ int character;
+{
+ output_paragraph[output_paragraph_offset++] = character;
+ if (output_paragraph_offset == paragraph_buffer_len)
+ {
+ output_paragraph =
+ xrealloc (output_paragraph, (paragraph_buffer_len += 100));
+ }
+}
+
+/* Insert the null-terminated string STRING into `output_paragraph'. */
+void
+insert_string (string)
+ char *string;
+{
+ while (*string)
+ insert (*string++);
+}
+
+/* Remove upto COUNT characters of whitespace from the
+ the current output line. If COUNT is less than zero,
+ then remove until none left. */
+void
+kill_self_indent (count)
+ int count;
+{
+ /* Handle infinite case first. */
+ if (count < 0)
+ {
+ output_column = 0;
+ while (output_paragraph_offset)
+ {
+ if (whitespace (output_paragraph[output_paragraph_offset - 1]))
+ output_paragraph_offset--;
+ else
+ break;
+ }
+ }
+ else
+ {
+ while (output_paragraph_offset && count--)
+ if (whitespace (output_paragraph[output_paragraph_offset - 1]))
+ output_paragraph_offset--;
+ else
+ break;
+ }
+}
+
+/* Non-zero means do not honor calls to flush_output (). */
+static int flushing_ignored = 0;
+
+/* Prevent calls to flush_output () from having any effect. */
+void
+inhibit_output_flushing ()
+{
+ flushing_ignored++;
+}
+
+/* Allow calls to flush_output () to write the paragraph data. */
+void
+uninhibit_output_flushing ()
+{
+ flushing_ignored--;
+}
+
+void
+flush_output ()
+{
+ register int i;
+
+ if (!output_paragraph_offset || flushing_ignored)
+ return;
+
+ for (i = 0; i < output_paragraph_offset; i++)
+ {
+ /* If we turned on the 8th bit for a space
+ inside @w, turn it back off for output. */
+ if (output_paragraph[i] & meta_character_bit)
+ {
+ int temp = UNMETA (output_paragraph[i]);
+ if (temp == ' ')
+ output_paragraph[i] &= 0x7f;
+ }
+ }
+
+ fwrite (output_paragraph, 1, output_paragraph_offset, output_stream);
+
+ output_position += output_paragraph_offset;
+ output_paragraph_offset = 0;
+}
+
+/* How to close a paragraph controlling the number of lines between
+ this one and the last one. */
+
+/* Paragraph spacing is controlled by this variable. It is the number of
+ blank lines that you wish to appear between paragraphs. A value of
+ 1 creates a single blank line between paragraphs. */
+int paragraph_spacing = DEFAULT_PARAGRAPH_SPACING;
+
+/* Close the current paragraph, leaving no blank lines between them. */
+void
+close_single_paragraph ()
+{
+ close_paragraph_with_lines (0);
+}
+
+/* Close a paragraph after an insertion has ended. */
+void
+close_insertion_paragraph ()
+{
+ if (!insertion_paragraph_closed)
+ {
+ /* Close the current paragraph, breaking the line. */
+ close_single_paragraph ();
+
+ /* Start a new paragraph here, inserting whatever indention is correct
+ for the now current insertion level (one above the one that we are
+ ending). */
+ start_paragraph ();
+
+ /* Tell close_paragraph () that the previous line has already been
+ broken, so it should insert one less newline. */
+ line_already_broken = 1;
+
+ /* Let functions such as add_char () know that we have already found a
+ newline. */
+ ignore_blank_line ();
+ }
+ else
+ {
+ /* If the insertion paragraph is closed already, then we are seeing
+ two `@end' commands in a row. Note that the first one we saw was
+ handled in the first part of this if-then-else clause, and at that
+ time start_paragraph () was called, partially to handle the proper
+ indentation of the current line. However, the indentation level
+ may have just changed again, so we may have to outdent the current
+ line to the new indentation level. */
+ if (current_indent < output_column)
+ kill_self_indent (output_column - current_indent);
+ }
+
+ insertion_paragraph_closed = 1;
+}
+
+void
+close_paragraph_with_lines (lines)
+ int lines;
+{
+ int old_spacing = paragraph_spacing;
+ paragraph_spacing = lines;
+ close_paragraph ();
+ paragraph_spacing = old_spacing;
+}
+
+/* Close the currently open paragraph. */
+void
+close_paragraph ()
+{
+ register int i;
+
+ /* The insertion paragraph is no longer closed. */
+ insertion_paragraph_closed = 0;
+
+ if (paragraph_is_open && !must_start_paragraph)
+ {
+ register int tindex, c;
+
+ tindex = output_paragraph_offset;
+
+ /* Back up to last non-newline/space character, forcing all such
+ subsequent characters to be newlines. This isn't strictly
+ necessary, but a couple of functions use the presence of a newline
+ to make decisions. */
+ for (tindex = output_paragraph_offset - 1; tindex >= 0; --tindex)
+ {
+ c = output_paragraph[tindex];
+
+ if (c == ' '|| c == '\n')
+ output_paragraph[tindex] = '\n';
+ else
+ break;
+ }
+
+ /* All trailing whitespace is ignored. */
+ output_paragraph_offset = ++tindex;
+
+ /* Break the line if that is appropriate. */
+ if (paragraph_spacing >= 0)
+ insert ('\n');
+
+ /* Add as many blank lines as is specified in PARAGRAPH_SPACING. */
+ if (!force_flush_right)
+ {
+ for (i = 0; i < (paragraph_spacing - line_already_broken); i++)
+ insert ('\n');
+ }
+
+ /* If we are doing flush right indentation, then do it now
+ on the paragraph (really a single line). */
+ if (force_flush_right)
+ do_flush_right_indentation ();
+
+ flush_output ();
+ paragraph_is_open = 0;
+ no_indent = 0;
+ output_column = 0;
+ }
+ ignore_blank_line ();
+}
+
+/* Make the last line just read look as if it were only a newline. */
+void
+ignore_blank_line ()
+{
+ last_inserted_character = '\n';
+ last_char_was_newline = 1;
+}
+
+/* Align the end of the text in output_paragraph with fill_column. */
+void
+do_flush_right_indentation ()
+{
+ char *temp;
+ int temp_len;
+
+ kill_self_indent (-1);
+
+ if (output_paragraph[0] != '\n')
+ {
+ output_paragraph[output_paragraph_offset] = '\0';
+
+ if (output_paragraph_offset < fill_column)
+ {
+ register int i;
+
+ if (fill_column >= paragraph_buffer_len)
+ output_paragraph =
+ xrealloc (output_paragraph,
+ (paragraph_buffer_len += fill_column));
+
+ temp_len = strlen ((char *)output_paragraph);
+ temp = (char *)xmalloc (temp_len + 1);
+ memcpy (temp, (char *)output_paragraph, temp_len);
+
+ for (i = 0; i < fill_column - output_paragraph_offset; i++)
+ output_paragraph[i] = ' ';
+
+ memcpy ((char *)output_paragraph + i, temp, temp_len);
+ free (temp);
+ output_paragraph_offset = fill_column;
+ }
+ }
+}
+
+/* Begin a new paragraph. */
+void
+start_paragraph ()
+{
+ /* First close existing one. */
+ if (paragraph_is_open)
+ close_paragraph ();
+
+ /* In either case, the insertion paragraph is no longer closed. */
+ insertion_paragraph_closed = 0;
+
+ /* However, the paragraph is open! */
+ paragraph_is_open = 1;
+
+ /* If we MUST_START_PARAGRAPH, that simply means that start_paragraph ()
+ had to be called before we would allow any other paragraph operations
+ to have an effect. */
+ if (!must_start_paragraph)
+ {
+ int amount_to_indent = 0;
+
+ /* If doing indentation, then insert the appropriate amount. */
+ if (!no_indent)
+ {
+ if (inhibit_paragraph_indentation)
+ {
+ amount_to_indent = current_indent;
+ if (inhibit_paragraph_indentation < 0)
+ inhibit_paragraph_indentation++;
+ }
+ else if (paragraph_start_indent < 0)
+ amount_to_indent = current_indent;
+ else
+ amount_to_indent = current_indent + paragraph_start_indent;
+
+ if (amount_to_indent >= output_column)
+ {
+ amount_to_indent -= output_column;
+ indent (amount_to_indent);
+ output_column += amount_to_indent;
+ }
+ }
+ }
+ else
+ must_start_paragraph = 0;
+}
+
+/* Insert the indentation specified by AMOUNT. */
+void
+indent (amount)
+ int amount;
+{
+ register BRACE_ELEMENT *elt = brace_stack;
+
+ /* For every START_POS saved within the brace stack which will be affected
+ by this indentation, bump that start pos forward. */
+ while (elt)
+ {
+ if (elt->pos >= output_paragraph_offset)
+ elt->pos += amount;
+ elt = elt->next;
+ }
+
+ while (--amount >= 0)
+ insert (' ');
+}
+
+/* Search forward for STRING in input_text.
+ FROM says where where to start. */
+int
+search_forward (string, from)
+ char *string;
+ int from;
+{
+ int len = strlen (string);
+
+ while (from < size_of_input_text)
+ {
+ if (strncmp (input_text + from, string, len) == 0)
+ return (from);
+ from++;
+ }
+ return (-1);
+}
+
+/* Whoops, Unix doesn't have strcasecmp. */
+
+/* Case independent string compare. */
+#if !defined (HAVE_STRCASECMP)
+int
+strcasecmp (string1, string2)
+ char *string1, *string2;
+{
+ char ch1, ch2;
+
+ for (;;)
+ {
+ ch1 = *string1++;
+ ch2 = *string2++;
+
+ if (!(ch1 | ch2))
+ return (0);
+
+ ch1 = coerce_to_upper (ch1);
+ ch2 = coerce_to_upper (ch2);
+
+ if (ch1 != ch2)
+ return (ch1 - ch2);
+ }
+}
+#endif /* !HAVE_STRCASECMP */
+
+void
+init_insertion_stack ()
+{
+ insertion_stack = (INSERTION_ELT *) NULL;
+}
+
+/* Return the type of the current insertion. */
+enum insertion_type
+current_insertion_type ()
+{
+ if (!insertion_level)
+ return (bad_type);
+ else
+ return (insertion_stack->insertion);
+}
+
+/* Return a pointer to the string which is the function to wrap around
+ items. */
+char *
+current_item_function ()
+{
+ register int level, done;
+ register INSERTION_ELT *elt;
+
+ level = insertion_level;
+ elt = insertion_stack;
+ done = 0;
+
+ /* Skip down through the stack until we find a non-conditional insertion. */
+ while (!done && (elt != NULL))
+ {
+ switch (elt->insertion)
+ {
+ case ifinfo:
+ case ifset:
+ case ifclear:
+ case cartouche:
+ elt = elt->next;
+ level--;
+ break;
+
+ default:
+ done = 1;
+ }
+ }
+
+ if (!level)
+ return ((char *) NULL);
+ else
+ return (elt->item_function);
+}
+
+char *
+get_item_function ()
+{
+ char *item_function;
+ get_rest_of_line (&item_function);
+ backup_input_pointer ();
+ canon_white (item_function);
+ return (item_function);
+}
+
+ /* Push the state of the current insertion on the stack. */
+void
+push_insertion (type, item_function)
+ enum insertion_type type;
+ char *item_function;
+{
+ INSERTION_ELT *new = (INSERTION_ELT *) xmalloc (sizeof (INSERTION_ELT));
+
+ new->item_function = item_function;
+ new->filling_enabled = filling_enabled;
+ new->indented_fill = indented_fill;
+ new->insertion = type;
+ new->line_number = line_number;
+ new->filename = strdup (input_filename);
+ new->inhibited = inhibit_paragraph_indentation;
+ new->in_fixed_width_font = in_fixed_width_font;
+ new->next = insertion_stack;
+ insertion_stack = new;
+ insertion_level++;
+}
+
+ /* Pop the value on top of the insertion stack into the
+ global variables. */
+void
+pop_insertion ()
+{
+ INSERTION_ELT *temp = insertion_stack;
+
+ if (temp == (INSERTION_ELT *) NULL)
+ return;
+
+ in_fixed_width_font = temp->in_fixed_width_font;
+ inhibit_paragraph_indentation = temp->inhibited;
+ filling_enabled = temp->filling_enabled;
+ indented_fill = temp->indented_fill;
+ free_and_clear (&(temp->item_function));
+ free_and_clear (&(temp->filename));
+ insertion_stack = insertion_stack->next;
+ free (temp);
+ insertion_level--;
+}
+
+ /* Return a pointer to the print name of this
+ enumerated type. */
+char *
+insertion_type_pname (type)
+ enum insertion_type type;
+{
+ if ((int) type < (int) bad_type)
+ return (insertion_type_names[(int) type]);
+ else
+ return ("Broken-Type in insertion_type_pname");
+}
+
+/* Return the insertion_type associated with NAME.
+ If the type is not one of the known ones, return BAD_TYPE. */
+enum insertion_type
+find_type_from_name (name)
+ char *name;
+{
+ int index = 0;
+ while (index < (int) bad_type)
+ {
+ if (strcmp (name, insertion_type_names[index]) == 0)
+ return (enum insertion_type) index;
+ index++;
+ }
+ return (bad_type);
+}
+
+int
+defun_insertion (type)
+ enum insertion_type type;
+{
+ return
+ ((type == deffn)
+ || (type == defun)
+ || (type == defmac)
+ || (type == defspec)
+ || (type == defvr)
+ || (type == defvar)
+ || (type == defopt)
+ || (type == deftypefn)
+ || (type == deftypefun)
+ || (type == deftypevr)
+ || (type == deftypevar)
+ || (type == defcv)
+ || (type == defivar)
+ || (type == defop)
+ || (type == defmethod)
+ || (type == deftypemethod)
+ || (type == deftp));
+}
+
+/* MAX_NS is the maximum nesting level for enumerations. I picked 100
+ which seemed reasonable. This doesn't control the number of items,
+ just the number of nested lists. */
+#define max_stack_depth 100
+#define ENUM_DIGITS 1
+#define ENUM_ALPHA 2
+typedef struct {
+ int enumtype;
+ int enumval;
+} DIGIT_ALPHA;
+
+DIGIT_ALPHA enumstack[max_stack_depth];
+int enumstack_offset = 0;
+int current_enumval = 1;
+int current_enumtype = ENUM_DIGITS;
+char *enumeration_arg = (char *)NULL;
+
+void
+start_enumerating (at, type)
+ int at, type;
+{
+ if ((enumstack_offset + 1) == max_stack_depth)
+ {
+ line_error ("Enumeration stack overflow");
+ return;
+ }
+ enumstack[enumstack_offset].enumtype = current_enumtype;
+ enumstack[enumstack_offset].enumval = current_enumval;
+ enumstack_offset++;
+ current_enumval = at;
+ current_enumtype = type;
+}
+
+void
+stop_enumerating ()
+{
+ --enumstack_offset;
+ if (enumstack_offset < 0)
+ enumstack_offset = 0;
+
+ current_enumval = enumstack[enumstack_offset].enumval;
+ current_enumtype = enumstack[enumstack_offset].enumtype;
+}
+
+/* Place a letter or digits into the output stream. */
+void
+enumerate_item ()
+{
+ char temp[10];
+
+ if (current_enumtype == ENUM_ALPHA)
+ {
+ if (current_enumval == ('z' + 1) || current_enumval == ('Z' + 1))
+ {
+ current_enumval = ((current_enumval - 1) == 'z' ? 'a' : 'A');
+ warning ("Lettering overflow, restarting at %c", current_enumval);
+ }
+ sprintf (temp, "%c. ", current_enumval);
+ }
+ else
+ sprintf (temp, "%d. ", current_enumval);
+
+ indent (output_column += (current_indent - strlen (temp)));
+ add_word (temp);
+ current_enumval++;
+}
+
+/* This is where the work for all the "insertion" style
+ commands is done. A huge switch statement handles the
+ various setups, and generic code is on both sides. */
+void
+begin_insertion (type)
+ enum insertion_type type;
+{
+ int no_discard = 0;
+
+ if (defun_insertion (type))
+ {
+ push_insertion (type, strdup (""));
+ no_discard++;
+ }
+ else
+ push_insertion (type, get_item_function ());
+
+ switch (type)
+ {
+ case menu:
+ if (!no_headers)
+ close_paragraph ();
+
+ filling_enabled = no_indent = 0;
+ inhibit_paragraph_indentation = 1;
+
+ if (!no_headers)
+ add_word ("* Menu:\n");
+
+ in_menu++;
+ no_discard++;
+ break;
+
+ case detailmenu:
+
+ if (!in_menu)
+ {
+ if (!no_headers)
+ close_paragraph ();
+
+ filling_enabled = no_indent = 0;
+ inhibit_paragraph_indentation = 1;
+
+ no_discard++;
+ }
+
+ in_detailmenu++;
+ break;
+
+ case direntry:
+ close_single_paragraph ();
+ filling_enabled = no_indent = 0;
+ inhibit_paragraph_indentation = 1;
+ insert_string ("START-INFO-DIR-ENTRY\n");
+ break;
+
+ /* I think @quotation is meant to do filling.
+ If you don't want filling, then use @display. */
+ case quotation:
+ close_single_paragraph ();
+ last_char_was_newline = no_indent = 0;
+ indented_fill = filling_enabled = 1;
+ inhibit_paragraph_indentation = 1;
+ current_indent += default_indentation_increment;
+ break;
+
+ case display:
+ case example:
+ case smallexample:
+ case lisp:
+ case smalllisp:
+ /* Just like @example, but no indentation. */
+ case format:
+
+ close_single_paragraph ();
+ inhibit_paragraph_indentation = 1;
+ in_fixed_width_font++;
+ filling_enabled = 0;
+ last_char_was_newline = 0;
+
+ if (type != format)
+ current_indent += default_indentation_increment;
+
+ break;
+
+ case multitable:
+ do_multitable ();
+ break;
+
+ case table:
+ case ftable:
+ case vtable:
+ case itemize:
+ close_single_paragraph ();
+ current_indent += default_indentation_increment;
+ filling_enabled = indented_fill = 1;
+#if defined (INDENT_PARAGRAPHS_IN_TABLE)
+ inhibit_paragraph_indentation = 0;
+#else
+ inhibit_paragraph_indentation = 1;
+#endif /* !INDENT_PARAGRAPHS_IN_TABLE */
+
+ /* Make things work for losers who forget the itemize syntax. */
+ if (allow_lax_format && (type == itemize))
+ {
+ if (!(*insertion_stack->item_function))
+ {
+ free (insertion_stack->item_function);
+ insertion_stack->item_function = strdup ("@bullet");
+ insertion_stack->item_function[0] = COMMAND_PREFIX;
+ }
+ }
+
+ if (!*insertion_stack->item_function)
+ {
+ line_error ("%s requires an argument: the formatter for %citem",
+ insertion_type_pname (type), COMMAND_PREFIX);
+ }
+ break;
+
+ case enumerate:
+ close_single_paragraph ();
+ no_indent = 0;
+#if defined (INDENT_PARAGRAPHS_IN_TABLE)
+ inhibit_paragraph_indentation = 0;
+#else
+ inhibit_paragraph_indentation = 1;
+#endif /* !INDENT_PARAGRAPHS_IN_TABLE */
+
+ current_indent += default_indentation_increment;
+ filling_enabled = indented_fill = 1;
+
+ if (isdigit (*enumeration_arg))
+ start_enumerating (atoi (enumeration_arg), ENUM_DIGITS);
+ else
+ start_enumerating (*enumeration_arg, ENUM_ALPHA);
+ break;
+
+ /* Does nothing special in makeinfo. */
+ case group:
+ /* Only close the paragraph if we are not inside of an @example. */
+ if (!insertion_stack->next ||
+ insertion_stack->next->insertion != example)
+ close_single_paragraph ();
+ break;
+
+ /* Insertions that are no-ops in info, but do something in TeX. */
+ case ifinfo:
+ case ifset:
+ case ifclear:
+ case cartouche:
+ if (in_menu)
+ no_discard++;
+ break;
+
+ case deffn:
+ case defun:
+ case defmac:
+ case defspec:
+ case defvr:
+ case defvar:
+ case defopt:
+ case deftypefn:
+ case deftypefun:
+ case deftypevr:
+ case deftypevar:
+ case defcv:
+ case defivar:
+ case defop:
+ case defmethod:
+ case deftypemethod:
+ case deftp:
+ inhibit_paragraph_indentation = 1;
+ filling_enabled = indented_fill = 1;
+ current_indent += default_indentation_increment;
+ no_indent = 0;
+ break;
+
+ case flushleft:
+ close_single_paragraph ();
+ inhibit_paragraph_indentation = 1;
+ filling_enabled = indented_fill = no_indent = 0;
+ break;
+
+ case flushright:
+ close_single_paragraph ();
+ filling_enabled = indented_fill = no_indent = 0;
+ inhibit_paragraph_indentation = 1;
+ force_flush_right++;
+ break;
+ }
+
+ if (!no_discard)
+ discard_until ("\n");
+}
+
+/* Try to end the insertion with the specified TYPE.
+ TYPE, with a value of bad_type, gets translated to match
+ the value currently on top of the stack.
+ Otherwise, if TYPE doesn't match the top of the insertion stack,
+ give error. */
+void
+end_insertion (type)
+ enum insertion_type type;
+{
+ enum insertion_type temp_type;
+
+ if (!insertion_level)
+ return;
+
+ temp_type = current_insertion_type ();
+
+ if (type == bad_type)
+ type = temp_type;
+
+ if (type != temp_type)
+ {
+ line_error
+ ("`%cend' expected `%s', but saw `%s'", COMMAND_PREFIX,
+ insertion_type_pname (temp_type), insertion_type_pname (type));
+ return;
+ }
+
+ pop_insertion ();
+
+ switch (type)
+ {
+ /* Insertions which have no effect on paragraph formatting. */
+ case ifinfo:
+ case ifset:
+ case ifclear:
+ break;
+
+ case direntry:
+ insert_string ("END-INFO-DIR-ENTRY\n\n");
+ close_insertion_paragraph ();
+ break;
+
+ case detailmenu:
+ in_detailmenu--; /* No longer hacking menus. */
+ if (!in_menu)
+ {
+ if (!no_headers)
+ close_insertion_paragraph ();
+ }
+ break;
+
+ case menu:
+ in_menu--; /* No longer hacking menus. */
+ if (!no_headers)
+ close_insertion_paragraph ();
+ break;
+
+ case multitable:
+ end_multitable ();
+ break;
+
+ case enumerate:
+ stop_enumerating ();
+ close_insertion_paragraph ();
+ current_indent -= default_indentation_increment;
+ break;
+
+ case flushleft:
+ case group:
+ case cartouche:
+ close_insertion_paragraph ();
+ break;
+
+ case format:
+ case display:
+ case example:
+ case smallexample:
+ case lisp:
+ case smalllisp:
+ case quotation:
+
+ /* @format is the only fixed_width insertion without a change
+ in indentation. */
+ if (type != format)
+ current_indent -= default_indentation_increment;
+
+ /* The ending of one of these insertions always marks the
+ start of a new paragraph. */
+ close_insertion_paragraph ();
+ break;
+
+ case table:
+ case ftable:
+ case vtable:
+ case itemize:
+ current_indent -= default_indentation_increment;
+ break;
+
+ case flushright:
+ force_flush_right--;
+ close_insertion_paragraph ();
+ break;
+
+ /* Handle the @defun style insertions with a default clause. */
+ default:
+ current_indent -= default_indentation_increment;
+ close_insertion_paragraph ();
+ break;
+ }
+}
+
+/* Insertions cannot cross certain boundaries, such as node beginnings. In
+ code that creates such boundaries, you should call discard_insertions ()
+ before doing anything else. It prints the errors for you, and cleans up
+ the insertion stack. */
+void
+discard_insertions ()
+{
+ int real_line_number = line_number;
+ while (insertion_stack)
+ {
+ if (insertion_stack->insertion == ifinfo ||
+ insertion_stack->insertion == ifset ||
+ insertion_stack->insertion == ifclear)
+ break;
+ else
+ {
+ char *offender;
+ char *current_filename;
+
+ current_filename = input_filename;
+ offender = (char *)insertion_type_pname (insertion_stack->insertion);
+ input_filename = insertion_stack->filename;
+ line_number = insertion_stack->line_number;
+ line_error ("This `%s' doesn't have a matching `%cend %s'", offender,
+ COMMAND_PREFIX, offender);
+ input_filename = current_filename;
+ pop_insertion ();
+ }
+ }
+ line_number = real_line_number;
+}
+
+/* The Texinfo commands. */
+
+/* Commands which insert their own names. */
+void
+insert_self (arg)
+ int arg;
+{
+ if (arg == START)
+ add_word (command);
+}
+
+void
+insert_space (arg)
+ int arg;
+{
+ if (arg == START)
+ add_char (' ');
+}
+
+/* Force a line break in the output. */
+void
+cm_asterisk ()
+{
+ close_single_paragraph ();
+#if !defined (ASTERISK_NEW_PARAGRAPH)
+ cm_noindent ();
+#endif /* ASTERISK_NEW_PARAGRAPH */
+}
+
+/* Insert ellipsis. */
+void
+cm_dots (arg)
+ int arg;
+{
+ if (arg == START)
+ add_word ("...");
+}
+
+/* Insert ellipsis for sentence end. */
+void
+cm_enddots (arg)
+ int arg;
+{
+ if (arg == START)
+ add_word ("....");
+}
+
+void
+cm_bullet (arg)
+ int arg;
+{
+ if (arg == START)
+ add_char ('*');
+}
+
+void
+cm_minus (arg)
+ int arg;
+{
+ if (arg == START)
+ add_char ('-');
+}
+
+/* Insert "TeX". */
+void
+cm_TeX (arg)
+ int arg;
+{
+ if (arg == START)
+ add_word ("TeX");
+}
+
+/* Copyright symbol. */
+void
+cm_copyright (arg)
+ int arg;
+{
+ if (arg == START)
+ add_word ("(C)");
+}
+
+/* Accent commands that take explicit arguments. */
+void
+cm_accent (arg)
+ int arg;
+{
+ if (arg == START)
+ {
+ if (strcmp (command, "dotaccent") == 0) /* overdot */
+ add_char ('.');
+ else if (strcmp (command, "H") == 0) /* Hungarian umlaut */
+ add_word ("''");
+ else if (strcmp (command, "ringaccent") == 0)
+ add_char ('*');
+ else if (strcmp (command, "tieaccent") == 0)
+ add_char ('[');
+ else if (strcmp (command, "u") == 0) /* breve */
+ add_char ('(');
+ else if (strcmp (command, "v") == 0) /* hacek/check */
+ add_char ('<');
+ }
+ else if (arg == END)
+ {
+ if (strcmp (command, "ubaraccent") == 0) /* underbar */
+ add_char ('_');
+ else if (strcmp (command, "udotaccent") == 0) /* underdot */
+ add_word ("-.");
+ else if (strcmp (command, ",") == 0) /* cedilla */
+ add_word (",");
+ }
+}
+
+/* Non-English letters/characters that don't insert themselves. */
+void
+cm_special_char (arg)
+{
+ if (arg == START)
+ {
+ if ((*command == 'L' || *command == 'l'
+ || *command == 'O' || *command == 'o')
+ && command[1] == 0)
+ {
+ /* Lslash lslash Oslash oslash */
+ add_char (*command);
+ add_char ('/');
+ }
+ else if (strcmp (command, "exclamdown") == 0)
+ add_char ('!');
+ else if (strcmp (command, "pounds") == 0)
+ add_char ('#');
+ else if (strcmp (command, "questiondown") == 0)
+ add_char ('?');
+ else
+ fprintf (stderr, "How did @%s end up in cm_special_char?\n", command);
+ }
+}
+
+/* Dotless i or j. */
+void
+cm_dotless (arg, start, end)
+ int arg, start, end;
+{
+ if (arg == END)
+ {
+ if (output_paragraph[start] != 'i' && output_paragraph[start] != 'j')
+ /* This error message isn't perfect if the argument is multiple
+ characters, but it doesn't seem worth getting right. */
+ line_error ("%c%s expects `i' or `j' as argument, not `%c'",
+ COMMAND_PREFIX, command, output_paragraph[start]);
+
+ else if (end - start != 1)
+ line_error ("%c%s expects a single character `i' or `j' as argument",
+ COMMAND_PREFIX, command);
+
+ /* We've already inserted the `i' or `j', so nothing to do. */
+ }
+}
+
+#if defined (__osf__)
+#define LOCALTIME_CAST(x) (time_t *)(x)
+#else
+#define LOCALTIME_CAST(x) (x)
+#endif
+
+void
+cm_today (arg)
+ int arg;
+{
+ static char * months [12] =
+ { "January", "February", "March", "April", "May", "June", "July",
+ "August", "September", "October", "November", "December" };
+ if (arg == START)
+ {
+ long timer = time (0);
+ struct tm *ts = localtime (LOCALTIME_CAST (&timer));
+ add_word_args
+ ("%d %s %d",
+ (ts -> tm_mday),
+ (months [ts -> tm_mon]),
+ ((ts -> tm_year) + 1900));
+ }
+}
+
+void
+cm_code (arg)
+ int arg;
+{
+ extern int printing_index;
+
+ if (arg == START)
+ {
+ in_fixed_width_font++;
+
+ if (!printing_index)
+ add_char ('`');
+ }
+ else
+ {
+ if (!printing_index)
+ add_char ('\'');
+ }
+}
+
+void
+cm_kbd (arg)
+ int arg;
+{
+ /* People use @kbd in an example to get the "user input" font.
+ We don't want quotes in that case. */
+ if (!in_fixed_width_font)
+ cm_code (arg);
+}
+
+void
+cm_angle_brackets (arg)
+ int arg;
+{
+ add_char (arg == START ? '<' : '>');
+}
+
+/* Convert the character at position into a true control character. */
+void
+cm_ctrl (arg, start, end)
+ int arg, start, end;
+{
+ /* Should we allow multiple character arguments? I think yes. */
+ if (arg == END)
+ {
+ register int i, character;
+#if defined (NO_MULTIPLE_CTRL)
+ if ((end - start) != 1)
+ line_error ("%c%s expects a single character as an argument",
+ COMMAND_PREFIX, command);
+ else
+#endif
+ for (i = start; i < end; i++)
+ {
+ character = output_paragraph[i];
+
+ if (isletter (character))
+ output_paragraph[i] = CTL (coerce_to_upper (character));
+ }
+ }
+}
+
+/* Handle a command that switches to a non-fixed-width font. */
+void
+not_fixed_width (arg)
+ int arg;
+{
+ if (arg == START)
+ in_fixed_width_font = 0;
+}
+
+/* Small caps in makeinfo has to do just all caps. */
+void
+cm_sc (arg, start_pos, end_pos)
+ int arg, start_pos, end_pos;
+{
+ not_fixed_width (arg);
+
+ if (arg == END)
+ {
+ while (start_pos < end_pos)
+ {
+ output_paragraph[start_pos] =
+ coerce_to_upper (output_paragraph[start_pos]);
+ start_pos++;
+ }
+ }
+}
+
+/* @var in makeinfo just uppercases the text. */
+void
+cm_var (arg, start_pos, end_pos)
+ int arg, start_pos, end_pos;
+{
+ not_fixed_width (arg);
+
+ if (arg == END)
+ {
+ while (start_pos < end_pos)
+ {
+ output_paragraph[start_pos] =
+ coerce_to_upper (output_paragraph[start_pos]);
+ start_pos++;
+ }
+ }
+}
+
+void
+cm_dfn (arg, position)
+ int arg, position;
+{
+ add_char ('"');
+}
+
+void
+cm_emph (arg)
+ int arg;
+{
+ add_char ('*');
+}
+
+void
+cm_strong (arg, position)
+ int arg, position;
+{
+ cm_emph (arg);
+}
+
+void
+cm_cite (arg, position)
+ int arg, position;
+{
+ if (arg == START)
+ add_word ("`");
+ else
+ add_word ("'");
+}
+
+/* No highlighting, but argument switches fonts. */
+void
+cm_not_fixed_width (arg, start, end)
+ int arg, start, end;
+{
+ not_fixed_width (arg);
+}
+
+/* Various commands are NOP's. */
+void
+cm_no_op ()
+{
+}
+
+/* Prevent the argument from being split across two lines. */
+void
+cm_w (arg, start, end)
+ int arg, start, end;
+{
+ if (arg == START)
+ non_splitting_words++;
+ else
+ non_splitting_words--;
+}
+
+
+/* Explain that this command is obsolete, thus the user shouldn't
+ do anything with it. */
+void
+cm_obsolete (arg, start, end)
+ int arg, start, end;
+{
+ if (arg == START)
+ warning ("The command `%c%s' is obsolete", COMMAND_PREFIX, command);
+}
+
+/* Insert the text following input_text_offset up to the end of the line
+ in a new, separate paragraph. Directly underneath it, insert a
+ line of WITH_CHAR, the same length of the inserted text. */
+void
+insert_and_underscore (with_char)
+ int with_char;
+{
+ register int i, len;
+ int old_no_indent, starting_pos, ending_pos;
+ char *temp;
+
+ close_paragraph ();
+ filling_enabled = indented_fill = 0;
+ old_no_indent = no_indent;
+ no_indent = 1;
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ append_to_expansion_output (input_text_offset + 1);
+#endif /* HAVE_MACROS */
+
+ get_rest_of_line (&temp);
+
+ starting_pos = output_position + output_paragraph_offset;
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ {
+ char *temp1;
+
+ temp1 = (char *)xmalloc (2 + strlen (temp));
+ sprintf (temp1, "%s\n", temp);
+ remember_itext (input_text, input_text_offset);
+ me_execute_string (temp1);
+ free (temp1);
+ }
+ else
+#endif /* HAVE_MACROS */
+ execute_string ("%s\n", temp);
+
+ ending_pos = output_position + output_paragraph_offset;
+ free (temp);
+
+ len = (ending_pos - starting_pos) - 1;
+ for (i = 0; i < len; i++)
+ add_char (with_char);
+ insert ('\n');
+ close_paragraph ();
+ filling_enabled = 1;
+ no_indent = old_no_indent;
+}
+
+/* Here is a structure which associates sectioning commands with
+ an integer, hopefully to reflect the `depth' of the current
+ section. */
+struct {
+ char *name;
+ int level;
+} section_alist[] = {
+ { "unnumberedsubsubsec", 5 },
+ { "unnumberedsubsec", 4 },
+ { "unnumberedsec", 3 },
+ { "unnumbered", 2 },
+ { "appendixsubsubsec", 5 },
+ { "appendixsubsec", 4 },
+ { "appendixsec", 3 },
+ { "appendixsection", 3 },
+ { "appendix", 2 },
+ { "subsubsec", 5 },
+ { "subsubsection", 5 },
+ { "subsection", 4 },
+ { "section", 3 },
+ { "chapter", 2 },
+ { "top", 1 },
+
+ { (char *)NULL, 0 }
+};
+
+/* Amount to offset the name of sectioning commands to levels by. */
+int section_alist_offset = 0;
+
+/* Shift the meaning of @section to @chapter. */
+void
+cm_raisesections ()
+{
+ discard_until ("\n");
+ section_alist_offset--;
+}
+
+/* Shift the meaning of @chapter to @section. */
+void
+cm_lowersections ()
+{
+ discard_until ("\n");
+ section_alist_offset++;
+}
+
+/* Return an integer which identifies the type section present in TEXT. */
+int
+what_section (text)
+ char *text;
+{
+ register int i, j;
+ char *t;
+
+ find_section_command:
+ for (j = 0; text[j] && cr_or_whitespace (text[j]); j++);
+ if (text[j] != COMMAND_PREFIX)
+ return (-1);
+
+ text = text + j + 1;
+
+ /* We skip @c, @comment, and @?index commands. */
+ if ((strncmp (text, "comment", strlen ("comment")) == 0) ||
+ (text[0] == 'c' && cr_or_whitespace (text[1])) ||
+ (strcmp (text + 1, "index") == 0))
+ {
+ while (*text++ != '\n');
+ goto find_section_command;
+ }
+
+ /* Handle italicized sectioning commands. */
+ if (*text == 'i')
+ text++;
+
+ for (j = 0; text[j] && !cr_or_whitespace (text[j]); j++);
+
+ for (i = 0; t = section_alist[i].name; i++)
+ {
+ if (j == strlen (t) && strncmp (t, text, j) == 0)
+ {
+ int return_val;
+
+ return_val = (section_alist[i].level + section_alist_offset);
+
+ if (return_val < 0)
+ return_val = 0;
+ else if (return_val > 5)
+ return_val = 5;
+ return (return_val);
+ }
+ }
+ return (-1);
+}
+
+/* Set the level of @top to LEVEL. Return the old level of @top. */
+int
+set_top_section_level (level)
+ int level;
+{
+ register int i, result = -1;
+
+ for (i = 0; section_alist[i].name; i++)
+ if (strcmp (section_alist[i].name, "top") == 0)
+ {
+ result = section_alist[i].level;
+ section_alist[i].level = level;
+ break;
+ }
+ return (result);
+}
+
+/* Treat this just like @unnumbered. The only difference is
+ in node defaulting. */
+void
+cm_top ()
+{
+ /* It is an error to have more than one @top. */
+ if (top_node_seen)
+ {
+ TAG_ENTRY *tag = tag_table;
+
+ line_error ("There already is a node having %ctop as a section",
+ COMMAND_PREFIX);
+
+ while (tag != (TAG_ENTRY *)NULL)
+ {
+ if ((tag->flags & IS_TOP))
+ {
+ int old_line_number = line_number;
+ char *old_input_filename = input_filename;
+
+ line_number = tag->line_no;
+ input_filename = tag->filename;
+ line_error ("Here is the %ctop node", COMMAND_PREFIX);
+ input_filename = old_input_filename;
+ line_number = old_line_number;
+ return;
+ }
+ tag = tag->next_ent;
+ }
+ }
+ else
+ {
+ top_node_seen = 1;
+
+ /* It is an error to use @top before you have used @node. */
+ if (!tag_table)
+ {
+ char *top_name;
+
+ get_rest_of_line (&top_name);
+ free (top_name);
+ line_error ("%ctop used before %cnode, defaulting to %s",
+ COMMAND_PREFIX, COMMAND_PREFIX, top_name);
+ execute_string ("@node Top, , (dir), (dir)\n@top %s\n", top_name);
+ return;
+ }
+
+ cm_unnumbered ();
+
+ /* The most recently defined node is the top node. */
+ tag_table->flags |= IS_TOP;
+
+ /* Now set the logical hierarchical level of the Top node. */
+ {
+ int orig_offset = input_text_offset;
+
+ input_text_offset = search_forward (node_search_string, orig_offset);
+
+ if (input_text_offset > 0)
+ {
+ int this_section;
+
+ /* We have encountered a non-top node, so mark that one exists. */
+ non_top_node_seen = 1;
+
+ /* Move to the end of this line, and find out what the
+ sectioning command is here. */
+ while (input_text[input_text_offset] != '\n')
+ input_text_offset++;
+
+ if (input_text_offset < size_of_input_text)
+ input_text_offset++;
+
+ this_section = what_section (input_text + input_text_offset);
+
+ /* If we found a sectioning command, then give the top section
+ a level of this section - 1. */
+ if (this_section != -1)
+ set_top_section_level (this_section - 1);
+ }
+ input_text_offset = orig_offset;
+ }
+ }
+}
+
+/* Organized by level commands. That is, "*" == chapter, "=" == section. */
+char *scoring_characters = "*=-.";
+
+void
+sectioning_underscore (command)
+ char *command;
+{
+ char character;
+ char *temp;
+ int level;
+
+ temp = (char *)xmalloc (2 + strlen (command));
+ temp[0] = COMMAND_PREFIX;
+ strcpy (&temp[1], command);
+ level = what_section (temp);
+ free (temp);
+ level -= 2;
+
+ if (level < 0)
+ level = 0;
+
+ character = scoring_characters[level];
+
+ insert_and_underscore (character);
+}
+
+/* The command still works, but prints a warning message in addition. */
+void
+cm_ideprecated (arg, start, end)
+ int arg, start, end;
+{
+ warning ("The command `%c%s' is obsolete; use `%c%s' instead",
+ COMMAND_PREFIX, command, COMMAND_PREFIX, command + 1);
+ sectioning_underscore (command + 1);
+}
+
+/* The remainder of the text on this line is a chapter heading. */
+void
+cm_chapter ()
+{
+ sectioning_underscore ("chapter");
+}
+
+/* The remainder of the text on this line is a section heading. */
+void
+cm_section ()
+{
+ sectioning_underscore ("section");
+}
+
+/* The remainder of the text on this line is a subsection heading. */
+void
+cm_subsection ()
+{
+ sectioning_underscore ("subsection");
+}
+
+/* The remainder of the text on this line is a subsubsection heading. */
+void
+cm_subsubsection ()
+{
+ sectioning_underscore ("subsubsection");
+}
+
+/* The remainder of the text on this line is an unnumbered heading. */
+void
+cm_unnumbered ()
+{
+ cm_chapter ();
+}
+
+/* The remainder of the text on this line is an unnumbered section heading. */
+void
+cm_unnumberedsec ()
+{
+ cm_section ();
+}
+
+/* The remainder of the text on this line is an unnumbered
+ subsection heading. */
+void
+cm_unnumberedsubsec ()
+{
+ cm_subsection ();
+}
+
+/* The remainder of the text on this line is an unnumbered
+ subsubsection heading. */
+void
+cm_unnumberedsubsubsec ()
+{
+ cm_subsubsection ();
+}
+
+/* The remainder of the text on this line is an appendix heading. */
+void
+cm_appendix ()
+{
+ cm_chapter ();
+}
+
+/* The remainder of the text on this line is an appendix section heading. */
+void
+cm_appendixsec ()
+{
+ cm_section ();
+}
+
+/* The remainder of the text on this line is an appendix subsection heading. */
+void
+cm_appendixsubsec ()
+{
+ cm_subsection ();
+}
+
+/* The remainder of the text on this line is an appendix
+ subsubsection heading. */
+void
+cm_appendixsubsubsec ()
+{
+ cm_subsubsection ();
+}
+
+/* Compatibility functions substitute for chapter, section, etc. */
+void
+cm_majorheading ()
+{
+ cm_chapheading ();
+}
+
+void
+cm_chapheading ()
+{
+ cm_chapter ();
+}
+
+void
+cm_heading ()
+{
+ cm_section ();
+}
+
+void
+cm_subheading ()
+{
+ cm_subsection ();
+}
+
+void
+cm_subsubheading ()
+{
+ cm_subsubsection ();
+}
+
+/* **************************************************************** */
+/* */
+/* Adding nodes, and making tags */
+/* */
+/* **************************************************************** */
+
+/* Start a new tag table. */
+void
+init_tag_table ()
+{
+ while (tag_table != (TAG_ENTRY *) NULL)
+ {
+ TAG_ENTRY *temp = tag_table;
+ free (temp->node);
+ free (temp->prev);
+ free (temp->next);
+ free (temp->up);
+ tag_table = tag_table->next_ent;
+ free (temp);
+ }
+}
+
+void
+write_tag_table ()
+{
+ write_tag_table_internal (0); /* Not indirect. */
+}
+
+void
+write_tag_table_indirect ()
+{
+ write_tag_table_internal (1);
+}
+
+/* Write out the contents of the existing tag table.
+ INDIRECT_P says how to format the output. */
+void
+write_tag_table_internal (indirect_p)
+ int indirect_p;
+{
+ TAG_ENTRY *node = tag_table;
+ int old_indent = no_indent;
+
+ no_indent = 1;
+ filling_enabled = 0;
+ must_start_paragraph = 0;
+ close_paragraph ();
+
+ if (!indirect_p)
+ {
+ no_indent = 1;
+ insert ('\n');
+ }
+
+ add_word_args ("\037\nTag Table:\n%s", indirect_p ? "(Indirect)\n" : "");
+
+ while (node != (TAG_ENTRY *) NULL)
+ {
+ execute_string ("Node: %s", node->node);
+ add_word_args ("\177%d\n", node->position);
+ node = node->next_ent;
+ }
+
+ add_word ("\037\nEnd Tag Table\n");
+ flush_output ();
+ no_indent = old_indent;
+}
+
+char *
+get_node_token ()
+{
+ char *string;
+
+ get_until_in_line (",", &string);
+
+ if (curchar () == ',')
+ input_text_offset++;
+
+ canon_white (string);
+
+ /* Force all versions of "top" to be "Top". */
+ normalize_node_name (string);
+
+ return (string);
+}
+
+/* Convert "top" and friends into "Top". */
+void
+normalize_node_name (string)
+ char *string;
+{
+ if (strcasecmp (string, "Top") == 0)
+ strcpy (string, "Top");
+}
+
+/* Look up NAME in the tag table, and return the associated
+ tag_entry. If the node is not in the table return NULL. */
+TAG_ENTRY *
+find_node (name)
+ char *name;
+{
+ TAG_ENTRY *tag = tag_table;
+
+ while (tag != (TAG_ENTRY *) NULL)
+ {
+ if (strcmp (tag->node, name) == 0)
+ return (tag);
+ tag = tag->next_ent;
+ }
+ return ((TAG_ENTRY *) NULL);
+}
+
+/* Remember NODE and associates. */
+void
+remember_node (node, prev, next, up, position, line_no, no_warn)
+ char *node, *prev, *next, *up;
+ int position, line_no, no_warn;
+{
+ /* Check for existence of this tag already. */
+ if (validating)
+ {
+ register TAG_ENTRY *tag = find_node (node);
+ if (tag)
+ {
+ line_error ("Node `%s' multiply defined (%d is first definition)",
+ node, tag->line_no);
+ return;
+ }
+ }
+
+ /* First, make this the current node. */
+ current_node = node;
+
+ /* Now add it to the list. */
+ {
+ TAG_ENTRY *new = (TAG_ENTRY *) xmalloc (sizeof (TAG_ENTRY));
+ new->node = node;
+ new->prev = prev;
+ new->next = next;
+ new->up = up;
+ new->position = position;
+ new->line_no = line_no;
+ new->filename = node_filename;
+ new->touched = 0; /* not yet referenced. */
+ new->flags = 0;
+ if (no_warn)
+ new->flags |= NO_WARN;
+ new->next_ent = tag_table;
+ tag_table = new;
+ }
+}
+
+/* The order is: nodename, nextnode, prevnode, upnode.
+ If all of the NEXT, PREV, and UP fields are empty, they are defaulted.
+ You must follow a node command which has those fields defaulted
+ with a sectioning command (e.g. @chapter) giving the "level" of that node.
+ It is an error not to do so.
+ The defaults come from the menu in this node's parent. */
+void
+cm_node ()
+{
+ char *node, *prev, *next, *up;
+ int new_node_pos, defaulting, this_section, no_warn = 0;
+ extern int already_outputting_pending_notes;
+
+ if (strcmp (command, "nwnode") == 0)
+ no_warn = 1;
+
+ /* Get rid of unmatched brace arguments from previous commands. */
+ discard_braces ();
+
+ /* There also might be insertions left lying around that haven't been
+ ended yet. Do that also. */
+ discard_insertions ();
+
+ if (!already_outputting_pending_notes)
+ {
+ close_paragraph ();
+ output_pending_notes ();
+ free_pending_notes ();
+ }
+
+ filling_enabled = indented_fill = 0;
+ new_node_pos = output_position;
+ current_footnote_number = 1;
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ append_to_expansion_output (input_text_offset + 1);
+#endif /* HAVE_MACROS */
+
+ node = get_node_token ();
+ next = get_node_token ();
+ prev = get_node_token ();
+ up = get_node_token ();
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ remember_itext (input_text, input_text_offset);
+#endif /* HAVE_MACROS */
+
+ no_indent = 1;
+ if (!no_headers)
+ {
+ add_word_args ("\037\nFile: %s, Node: ", pretty_output_filename);
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ me_execute_string (node);
+ else
+#endif /* HAVE_MACROS */
+ execute_string ("%s", node);
+ filling_enabled = indented_fill = 0;
+ }
+
+ /* Check for defaulting of this node's next, prev, and up fields. */
+ defaulting = ((strlen (next) == 0) &&
+ (strlen (prev) == 0) &&
+ (strlen (up) == 0));
+
+ this_section = what_section (input_text + input_text_offset);
+
+ /* If we are defaulting, then look at the immediately following
+ sectioning command (error if none) to determine the node's
+ level. Find the node that contains the menu mentioning this node
+ that is one level up (error if not found). That node is the "Up"
+ of this node. Default the "Next" and "Prev" from the menu. */
+ if (defaulting)
+ {
+ NODE_REF *last_ref = (NODE_REF *)NULL;
+ NODE_REF *ref = node_references;
+
+ if ((this_section < 0) && (strcmp (node, "Top") != 0))
+ {
+ char *polite_section_name = "top";
+ int i;
+
+ for (i = 0; section_alist[i].name; i++)
+ if (section_alist[i].level == current_section + 1)
+ {
+ polite_section_name = section_alist[i].name;
+ break;
+ }
+
+ line_error
+ ("Node `%s' requires a sectioning command (e.g. %c%s)",
+ node, COMMAND_PREFIX, polite_section_name);
+ }
+ else
+ {
+ if (strcmp (node, "Top") == 0)
+ {
+ /* Default the NEXT pointer to be the first menu item in
+ this node, if there is a menu in this node. We have to
+ try very hard to find the menu, as it may be obscured
+ by execution_strings which are on the filestack. For
+ every member of the filestack which has a FILENAME
+ member which is identical to the current INPUT_FILENAME,
+ search forward from that offset. */
+ int saved_input_text_offset = input_text_offset;
+ int saved_size_of_input_text = size_of_input_text;
+ char *saved_input_text = input_text;
+ FSTACK *next_file = filestack;
+
+ int orig_offset, orig_size;
+ char *glean_node_from_menu ();
+
+ /* No matter what, make this file point back at `(dir)'. */
+ free (up); up = strdup ("(dir)");
+
+ while (1)
+ {
+ orig_offset = input_text_offset;
+ orig_size =
+ search_forward (node_search_string, orig_offset);
+
+ if (orig_size < 0)
+ orig_size = size_of_input_text;
+
+ input_text_offset =
+ search_forward (menu_search_string, orig_offset);
+
+ if (input_text_offset > -1)
+ {
+ char *nodename_from_menu = (char *)NULL;
+
+ input_text_offset =
+ search_forward ("\n* ", input_text_offset);
+
+ if (input_text_offset != -1)
+ nodename_from_menu = glean_node_from_menu (0);
+
+ if (nodename_from_menu)
+ {
+ free (next); next = nodename_from_menu;
+ break;
+ }
+ }
+
+ /* We got here, so it hasn't been found yet. Try
+ the next file on the filestack if there is one. */
+ if (next_file &&
+ (strcmp (next_file->filename, input_filename) == 0))
+ {
+ input_text = next_file->text;
+ input_text_offset = next_file->offset;
+ size_of_input_text = next_file->size;
+ next_file = next_file->next;
+ }
+ else
+ {
+ /* No more input files to check. */
+ break;
+ }
+ }
+
+ input_text = saved_input_text;
+ input_text_offset = saved_input_text_offset;
+ size_of_input_text = saved_size_of_input_text;
+ }
+ }
+
+ /* Fix the level of the menu references in the Top node, iff it
+ was declared with @top, and no subsequent reference was found. */
+ if (top_node_seen && !non_top_node_seen)
+ {
+ /* Then this is the first non-@top node seen. */
+ int level;
+
+ level = set_top_section_level (this_section - 1);
+ non_top_node_seen = 1;
+
+ while (ref)
+ {
+ if (ref->section == level)
+ ref->section = this_section - 1;
+ ref = ref->next;
+ }
+
+ ref = node_references;
+ }
+
+ while (ref)
+ {
+ if (ref->section == (this_section - 1) &&
+ ref->type == menu_reference &&
+ strcmp (ref->node, node) == 0)
+ {
+ char *containing_node = ref->containing_node;
+
+ free (up);
+ up = strdup (containing_node);
+
+ if (last_ref &&
+ last_ref->type == menu_reference &&
+ (strcmp (last_ref->containing_node,
+ containing_node) == 0))
+ {
+ free (next);
+ next = strdup (last_ref->node);
+ }
+
+ while ((ref->section == this_section - 1) &&
+ (ref->next) &&
+ (ref->next->type != menu_reference))
+ ref = ref->next;
+
+ if (ref->next && ref->type == menu_reference &&
+ (strcmp (ref->next->containing_node,
+ containing_node) == 0))
+ {
+ free (prev);
+ prev = strdup (ref->next->node);
+ }
+ else if (!ref->next &&
+ strcasecmp (ref->containing_node, "Top") == 0)
+ {
+ free (prev);
+ prev = strdup (ref->containing_node);
+ }
+ break;
+ }
+ last_ref = ref;
+ ref = ref->next;
+ }
+ }
+
+#if defined (HAVE_MACROS)
+ /* Insert the correct args if we are expanding macros, and the node's
+ pointers weren't defaulted. */
+ if (macro_expansion_output_stream && !defaulting)
+ {
+ char *temp;
+ int op_orig = output_paragraph_offset;
+
+ temp = (char *)xmalloc (3 + strlen (next));
+ sprintf (temp, ", %s", next);
+ me_execute_string (temp);
+ free (temp);
+
+ temp = (char *)xmalloc (3 + strlen (prev));
+ sprintf (temp, ", %s", prev);
+ me_execute_string (temp);
+ free (temp);
+
+ temp = (char *)xmalloc (4 + strlen (up));
+ sprintf (temp, ", %s", up);
+ me_execute_string (temp);
+ free (temp);
+
+ output_paragraph_offset = op_orig;
+ }
+#endif /* HAVE_MACROS */
+
+ if (!no_headers)
+ {
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ me_inhibit_expansion++;
+#endif /* HAVE_MACROS */
+
+ if (*next)
+ {
+ execute_string (", Next: %s", next);
+ filling_enabled = indented_fill = 0;
+ }
+
+ if (*prev)
+ {
+ execute_string (", Prev: %s", prev);
+ filling_enabled = indented_fill = 0;
+ }
+
+ if (*up)
+ {
+ execute_string (", Up: %s", up);
+ filling_enabled = indented_fill = 0;
+ }
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ me_inhibit_expansion--;
+#endif /* HAVE_MACROS */
+ }
+
+ close_paragraph ();
+ no_indent = 0;
+
+ if (!*node)
+ {
+ line_error ("No node name specified for `%c%s' command",
+ COMMAND_PREFIX, command);
+ free (node);
+ free (next);
+ free (prev);
+ free (up);
+ }
+ else
+ {
+ if (!*next) { free (next); next = (char *)NULL; }
+ if (!*prev) { free (prev); prev = (char *)NULL; }
+ if (!*up) { free (up); up = (char *)NULL; }
+ remember_node (node, prev, next, up, new_node_pos, line_number, no_warn);
+ }
+
+ /* Change the section only if there was a sectioning command. */
+ if (this_section >= 0)
+ current_section = this_section;
+
+ filling_enabled = 1;
+}
+
+/* Validation of an info file.
+ Scan through the list of tag entries touching the Prev, Next, and Up
+ elements of each. It is an error not to be able to touch one of them,
+ except in the case of external node references, such as "(DIR)".
+
+ If the Prev is different from the Up,
+ then the Prev node must have a Next pointing at this node.
+
+ Every node except Top must have an Up.
+ The Up node must contain some sort of reference, other than a Next,
+ to this node.
+
+ If the Next is different from the Next of the Up,
+ then the Next node must have a Prev pointing at this node. */
+void
+validate_file (tag_table)
+ TAG_ENTRY *tag_table;
+{
+ char *old_input_filename = input_filename;
+ TAG_ENTRY *tags = tag_table;
+
+ while (tags != (TAG_ENTRY *) NULL)
+ {
+ register TAG_ENTRY *temp_tag;
+
+ input_filename = tags->filename;
+ line_number = tags->line_no;
+
+ /* If this is a "no warn" node, don't validate it in any way. */
+ if (tags->flags & NO_WARN)
+ {
+ tags = tags->next_ent;
+ continue;
+ }
+
+ /* If this node has a Next, then make sure that the Next exists. */
+ if (tags->next)
+ {
+ validate (tags->next, tags->line_no, "Next");
+
+ /* If the Next node exists, and there is no Up, then make
+ sure that the Prev of the Next points back. */
+ if (temp_tag = find_node (tags->next))
+ {
+ char *prev;
+
+ if (temp_tag->flags & NO_WARN)
+ {
+ /* Do nothing if we aren't supposed to issue warnings
+ about this node. */
+ }
+ else
+ {
+ prev = temp_tag->prev;
+ if (!prev || (strcmp (prev, tags->node) != 0))
+ {
+ line_error ("Node `%s''s Next field not pointed back to",
+ tags->node);
+ line_number = temp_tag->line_no;
+ input_filename = temp_tag->filename;
+ line_error
+ ("This node (`%s') is the one with the bad `Prev'",
+ temp_tag->node);
+ input_filename = tags->filename;
+ line_number = tags->line_no;
+ temp_tag->flags |= PREV_ERROR;
+ }
+ }
+ }
+ }
+
+ /* Validate the Prev field if there is one, and we haven't already
+ complained about it in some way. You don't have to have a Prev
+ field at this stage. */
+ if (!(tags->flags & PREV_ERROR) && tags->prev)
+ {
+ int valid = validate (tags->prev, tags->line_no, "Prev");
+
+ if (!valid)
+ tags->flags |= PREV_ERROR;
+ else
+ {
+ /* If the Prev field is not the same as the Up field,
+ then the node pointed to by the Prev field must have
+ a Next field which points to this node. */
+ if (tags->up && (strcmp (tags->prev, tags->up) != 0))
+ {
+ temp_tag = find_node (tags->prev);
+
+ /* If we aren't supposed to issue warnings about the
+ target node, do nothing. */
+ if (!temp_tag || (temp_tag->flags & NO_WARN))
+ {
+ /* Do nothing. */
+ }
+ else
+ {
+ if (!temp_tag->next ||
+ (strcmp (temp_tag->next, tags->node) != 0))
+ {
+ line_error
+ ("Node `%s''s Prev field not pointed back to",
+ tags->node);
+ line_number = temp_tag->line_no;
+ input_filename = temp_tag->filename;
+ line_error
+ ("This node (`%s') is the one with the bad `Next'",
+ temp_tag->node);
+ input_filename = tags->filename;
+ line_number = tags->line_no;
+ temp_tag->flags |= NEXT_ERROR;
+ }
+ }
+ }
+ }
+ }
+
+ if (!tags->up && (strcasecmp (tags->node, "Top") != 0))
+ line_error ("Node `%s' is missing an \"Up\" field", tags->node);
+ else if (tags->up)
+ {
+ int valid = validate (tags->up, tags->line_no, "Up");
+
+ /* If node X has Up: Y, then warn if Y fails to have a menu item
+ or note pointing at X, if Y isn't of the form "(Y)". */
+ if (valid && *tags->up != '(')
+ {
+ NODE_REF *nref, *tref, *list;
+ NODE_REF *find_node_reference ();
+
+ tref = (NODE_REF *) NULL;
+ list = node_references;
+
+ for (;;)
+ {
+ if (!(nref = find_node_reference (tags->node, list)))
+ break;
+
+ if (strcmp (nref->containing_node, tags->up) == 0)
+ {
+ if (nref->type != menu_reference)
+ {
+ tref = nref;
+ list = nref->next;
+ }
+ else
+ break;
+ }
+ list = nref->next;
+ }
+
+ if (!nref)
+ {
+ temp_tag = find_node (tags->up);
+ line_number = temp_tag->line_no;
+ input_filename = temp_tag->filename;
+ if (!tref)
+ line_error (
+"`%s' has an Up field of `%s', but `%s' has no menu item for `%s'",
+ tags->node, tags->up, tags->up, tags->node);
+ line_number = tags->line_no;
+ input_filename = tags->filename;
+ }
+ }
+ }
+ tags = tags->next_ent;
+ }
+
+ validate_other_references (node_references);
+ /* We have told the user about the references which didn't exist.
+ Now tell him about the nodes which aren't referenced. */
+
+ tags = tag_table;
+ while (tags != (TAG_ENTRY *) NULL)
+ {
+ /* If this node is a "no warn" node, do nothing. */
+ if (tags->flags & NO_WARN)
+ {
+ tags = tags->next_ent;
+ continue;
+ }
+
+ /* Special hack. If the node in question appears to have
+ been referenced more than REFERENCE_WARNING_LIMIT times,
+ give a warning. */
+ if (tags->touched > reference_warning_limit)
+ {
+ input_filename = tags->filename;
+ line_number = tags->line_no;
+ warning ("Node `%s' has been referenced %d times",
+ tags->node, tags->touched);
+ }
+
+ if (tags->touched == 0)
+ {
+ input_filename = tags->filename;
+ line_number = tags->line_no;
+
+ /* Notice that the node "Top" is special, and doesn't have to
+ be referenced. */
+ if (strcasecmp (tags->node, "Top") != 0)
+ warning ("Unreferenced node `%s'", tags->node);
+ }
+ tags = tags->next_ent;
+ }
+ input_filename = old_input_filename;
+}
+
+/* Return 1 if tag correctly validated, or 0 if not. */
+int
+validate (tag, line, label)
+ char *tag;
+ int line;
+ char *label;
+{
+ TAG_ENTRY *result;
+
+ /* If there isn't a tag to verify, or if the tag is in another file,
+ then it must be okay. */
+ if (!tag || !*tag || *tag == '(')
+ return (1);
+
+ /* Otherwise, the tag must exist. */
+ result = find_node (tag);
+
+ if (!result)
+ {
+ line_number = line;
+ line_error (
+"Validation error. `%s' field points to node `%s', which doesn't exist",
+ label, tag);
+ return (0);
+ }
+ result->touched++;
+ return (1);
+}
+
+/* Split large output files into a series of smaller files. Each file
+ is pointed to in the tag table, which then gets written out as the
+ original file. The new files have the same name as the original file
+ with a "-num" attached. SIZE is the largest number of bytes to allow
+ in any single split file. */
+void
+split_file (filename, size)
+ char *filename;
+ int size;
+{
+ char *root_filename, *root_pathname;
+ char *the_file, *filename_part ();
+ struct stat fileinfo;
+ long file_size;
+ char *the_header;
+ int header_size;
+
+ /* Can only do this to files with tag tables. */
+ if (!tag_table)
+ return;
+
+ if (size == 0)
+ size = DEFAULT_SPLIT_SIZE;
+
+ if ((stat (filename, &fileinfo) != 0) ||
+ (((long) fileinfo.st_size) < SPLIT_SIZE_THRESHOLD))
+ return;
+ file_size = (long) fileinfo.st_size;
+
+ the_file = find_and_load (filename);
+ if (!the_file)
+ return;
+
+ root_filename = filename_part (filename);
+ root_pathname = pathname_part (filename);
+
+ if (!root_pathname)
+ root_pathname = strdup ("");
+
+ /* Start splitting the file. Walk along the tag table
+ outputting sections of the file. When we have written
+ all of the nodes in the tag table, make the top-level
+ pointer file, which contains indirect pointers and
+ tags for the nodes. */
+ {
+ int which_file = 1;
+ TAG_ENTRY *tags = tag_table;
+ char *indirect_info = (char *)NULL;
+
+ /* Remember the `header' of this file. The first tag in the file is
+ the bottom of the header; the top of the file is the start. */
+ the_header = (char *)xmalloc (1 + (header_size = tags->position));
+ memcpy (the_header, the_file, header_size);
+
+ while (tags)
+ {
+ int file_top, file_bot, limit;
+
+ /* Have to include the Control-_. */
+ file_top = file_bot = tags->position;
+ limit = file_top + size;
+
+ /* If the rest of this file is only one node, then
+ that is the entire subfile. */
+ if (!tags->next_ent)
+ {
+ int i = tags->position + 1;
+ char last_char = the_file[i];
+
+ while (i < file_size)
+ {
+ if ((the_file[i] == '\037') &&
+ ((last_char == '\n') ||
+ (last_char == '\014')))
+ break;
+ else
+ last_char = the_file[i];
+ i++;
+ }
+ file_bot = i;
+ tags = tags->next_ent;
+ goto write_region;
+ }
+
+ /* Otherwise, find the largest number of nodes that can fit in
+ this subfile. */
+ for (; tags; tags = tags->next_ent)
+ {
+ if (!tags->next_ent)
+ {
+ /* This entry is the last node. Search forward for the end
+ of this node, and that is the end of this file. */
+ int i = tags->position + 1;
+ char last_char = the_file[i];
+
+ while (i < file_size)
+ {
+ if ((the_file[i] == '\037') &&
+ ((last_char == '\n') ||
+ (last_char == '\014')))
+ break;
+ else
+ last_char = the_file[i];
+ i++;
+ }
+ file_bot = i;
+
+ if (file_bot < limit)
+ {
+ tags = tags->next_ent;
+ goto write_region;
+ }
+ else
+ {
+ /* Here we want to write out everything before the last
+ node, and then write the last node out in a file
+ by itself. */
+ file_bot = tags->position;
+ goto write_region;
+ }
+ }
+
+ if (tags->next_ent->position > limit)
+ {
+ if (tags->position == file_top)
+ tags = tags->next_ent;
+
+ file_bot = tags->position;
+
+ write_region:
+ {
+ int fd;
+ char *split_filename;
+
+ split_filename = (char *) xmalloc
+ (10 + strlen (root_pathname) + strlen (root_filename));
+ sprintf
+ (split_filename,
+ "%s%s-%d", root_pathname, root_filename, which_file);
+
+ fd = open
+ (split_filename, O_WRONLY | O_TRUNC | O_CREAT, 0666);
+
+ if ((fd < 0) ||
+ (write (fd, the_header, header_size) != header_size) ||
+ (write (fd, the_file + file_top, file_bot - file_top)
+ != (file_bot - file_top)) ||
+ ((close (fd)) < 0))
+ {
+ perror (split_filename);
+ if (fd != -1)
+ close (fd);
+ exit (FATAL);
+ }
+
+ if (!indirect_info)
+ {
+ indirect_info = the_file + file_top;
+ sprintf (indirect_info, "\037\nIndirect:\n");
+ indirect_info += strlen (indirect_info);
+ }
+
+ sprintf (indirect_info, "%s-%d: %d\n",
+ root_filename, which_file, file_top);
+
+ free (split_filename);
+ indirect_info += strlen (indirect_info);
+ which_file++;
+ break;
+ }
+ }
+ }
+ }
+
+ /* We have sucessfully created the subfiles. Now write out the
+ original again. We must use `output_stream', or
+ write_tag_table_indirect () won't know where to place the output. */
+ output_stream = fopen (filename, "w");
+ if (!output_stream)
+ {
+ perror (filename);
+ exit (FATAL);
+ }
+
+ {
+ int distance = indirect_info - the_file;
+ fwrite (the_file, 1, distance, output_stream);
+
+ /* Inhibit newlines. */
+ paragraph_is_open = 0;
+
+ write_tag_table_indirect ();
+ fclose (output_stream);
+ free (the_header);
+ free (the_file);
+ return;
+ }
+ }
+}
+
+/* Some menu hacking. This is used to remember menu references while
+ reading the input file. After the output file has been written, if
+ validation is on, then we use the contents of NODE_REFERENCES as a
+ list of nodes to validate. */
+char *
+reftype_type_string (type)
+ enum reftype type;
+{
+ switch (type)
+ {
+ case menu_reference:
+ return ("Menu");
+ case followed_reference:
+ return ("Followed-Reference");
+ default:
+ return ("Internal-bad-reference-type");
+ }
+}
+
+/* Remember this node name for later validation use. */
+void
+remember_node_reference (node, line, type)
+ char *node;
+ int line;
+ enum reftype type;
+{
+ NODE_REF *temp = (NODE_REF *) xmalloc (sizeof (NODE_REF));
+
+ temp->next = node_references;
+ temp->node = strdup (node);
+ temp->line_no = line;
+ temp->section = current_section;
+ temp->type = type;
+ temp->containing_node = strdup (current_node ? current_node : "");
+ temp->filename = node_filename;
+
+ node_references = temp;
+}
+
+void
+validate_other_references (ref_list)
+ register NODE_REF *ref_list;
+{
+ char *old_input_filename = input_filename;
+
+ while (ref_list != (NODE_REF *) NULL)
+ {
+ input_filename = ref_list->filename;
+ validate (ref_list->node, ref_list->line_no,
+ reftype_type_string (ref_list->type));
+ ref_list = ref_list->next;
+ }
+ input_filename = old_input_filename;
+}
+
+/* Find NODE in REF_LIST. */
+NODE_REF *
+find_node_reference (node, ref_list)
+ char *node;
+ register NODE_REF *ref_list;
+{
+ while (ref_list)
+ {
+ if (strcmp (node, ref_list->node) == 0)
+ break;
+ ref_list = ref_list->next;
+ }
+ return (ref_list);
+}
+
+void
+free_node_references ()
+{
+ register NODE_REF *list, *temp;
+
+ list = node_references;
+
+ while (list)
+ {
+ temp = list;
+ free (list->node);
+ free (list->containing_node);
+ list = list->next;
+ free (temp);
+ }
+ node_references = (NODE_REF *) NULL;
+}
+
+ /* This function gets called at the start of every line while inside of
+ a menu. It checks to see if the line starts with "* ", and if so,
+ remembers the node reference that this menu refers to.
+ input_text_offset is at the \n just before the line start. */
+#define menu_starter "* "
+char *
+glean_node_from_menu (remember_reference)
+ int remember_reference;
+{
+ int i, orig_offset = input_text_offset;
+ char *nodename;
+
+ if (strncmp (&input_text[input_text_offset + 1],
+ menu_starter,
+ strlen (menu_starter)) != 0)
+ return ((char *)NULL);
+ else
+ input_text_offset += strlen (menu_starter) + 1;
+
+ get_until_in_line (":", &nodename);
+ if (curchar () == ':')
+ input_text_offset++;
+ canon_white (nodename);
+
+ if (curchar () == ':')
+ goto save_node;
+
+ free (nodename);
+ get_rest_of_line (&nodename);
+
+ /* Special hack: If the nodename follows the menu item name,
+ then we have to read the rest of the line in order to find
+ out what the nodename is. But we still have to read the
+ line later, in order to process any formatting commands that
+ might be present. So un-count the carriage return that has just
+ been counted. */
+ line_number--;
+
+ isolate_nodename (nodename);
+
+save_node:
+ input_text_offset = orig_offset;
+ normalize_node_name (nodename);
+ i = strlen (nodename);
+ if (i && nodename[i - 1] == ':')
+ nodename[i - 1] = '\0';
+
+ if (remember_reference)
+ {
+ remember_node_reference (nodename, line_number, menu_reference);
+ free (nodename);
+ return ((char *)NULL);
+ }
+ else
+ return (nodename);
+}
+
+static void
+isolate_nodename (nodename)
+ char *nodename;
+{
+ register int i, c;
+ int paren_seen, paren;
+
+ if (!nodename)
+ return;
+
+ canon_white (nodename);
+ paren_seen = paren = i = 0;
+
+ if (*nodename == '.' || !*nodename)
+ {
+ *nodename = '\0';
+ return;
+ }
+
+ if (*nodename == '(')
+ {
+ paren++;
+ paren_seen++;
+ i++;
+ }
+
+ for (; c = nodename[i]; i++)
+ {
+ if (paren)
+ {
+ if (c == '(')
+ paren++;
+ else if (c == ')')
+ paren--;
+
+ continue;
+ }
+
+ /* If the character following the close paren is a space, then this
+ node has no more characters associated with it. */
+ if (c == '\t' ||
+ c == '\n' ||
+ c == ',' ||
+ ((paren_seen && nodename[i - 1] == ')') &&
+ (c == ' ' || c == '.')) ||
+ (c == '.' &&
+ ((!nodename[i + 1] ||
+ (cr_or_whitespace (nodename[i + 1])) ||
+ (nodename[i + 1] == ')')))))
+ break;
+ }
+ nodename[i] = '\0';
+}
+
+void
+cm_menu ()
+{
+ if (current_node == (char *)NULL)
+ {
+ warning ("%cmenu seen before a node has been defined", COMMAND_PREFIX);
+ warning ("Creating `TOP' node.");
+ execute_string ("@node Top");
+ }
+ begin_insertion (menu);
+}
+
+void
+cm_detailmenu ()
+{
+ if (current_node == (char *)NULL)
+ {
+ warning ("%cmenu seen before a node has been defined", COMMAND_PREFIX);
+ warning ("Creating `TOP' node.");
+ execute_string ("@node Top");
+ }
+ begin_insertion (detailmenu);
+}
+
+/* **************************************************************** */
+/* */
+/* Cross Reference Hacking */
+/* */
+/* **************************************************************** */
+
+char *
+get_xref_token ()
+{
+ char *string;
+
+ get_until_in_braces (",", &string);
+ if (curchar () == ',')
+ input_text_offset++;
+ fix_whitespace (string);
+ return (string);
+}
+
+int px_ref_flag = 0; /* Controls initial output string. */
+
+/* Make a cross reference. */
+void
+cm_xref (arg)
+{
+ if (arg == START)
+ {
+ char *arg1, *arg2, *arg3, *arg4, *arg5;
+
+ arg1 = get_xref_token ();
+ arg2 = get_xref_token ();
+ arg3 = get_xref_token ();
+ arg4 = get_xref_token ();
+ arg5 = get_xref_token ();
+
+ add_word_args ("%s", px_ref_flag ? "*note " : "*Note ");
+
+ if (*arg5 || *arg4)
+ {
+ char *node_name;
+
+ if (!*arg2)
+ {
+ if (*arg3)
+ node_name = arg3;
+ else
+ node_name = arg1;
+ }
+ else
+ node_name = arg2;
+
+ execute_string ("%s: (%s)%s", node_name, arg4, arg1);
+ /* Free all of the arguments found. */
+ if (arg1) free (arg1);
+ if (arg2) free (arg2);
+ if (arg3) free (arg3);
+ if (arg4) free (arg4);
+ if (arg5) free (arg5);
+ return;
+ }
+ else
+ remember_node_reference (arg1, line_number, followed_reference);
+
+ if (*arg3)
+ {
+ if (!*arg2)
+ execute_string ("%s: %s", arg3, arg1);
+ else
+ execute_string ("%s: %s", arg2, arg1);
+ }
+ else
+ {
+ if (*arg2)
+ execute_string ("%s: %s", arg2, arg1);
+ else
+ execute_string ("%s::", arg1);
+ }
+
+ /* Free all of the arguments found. */
+ if (arg1) free (arg1);
+ if (arg2) free (arg2);
+ if (arg3) free (arg3);
+ if (arg4) free (arg4);
+ if (arg5) free (arg5);
+ }
+ else
+ {
+ /* Check to make sure that the next non-whitespace character is either
+ a period or a comma. input_text_offset is pointing at the "}" which
+ ended the xref or pxref command. */
+ int temp = input_text_offset + 1;
+
+ if (output_paragraph[output_paragraph_offset - 2] == ':' &&
+ output_paragraph[output_paragraph_offset - 1] == ':')
+ return;
+ while (temp < size_of_input_text)
+ {
+ if (cr_or_whitespace (input_text[temp]))
+ temp++;
+ else
+ {
+ if (input_text[temp] == '.' ||
+ input_text[temp] == ',' ||
+ input_text[temp] == '\t')
+ return;
+ else
+ {
+ line_error (
+ "Cross-reference must be terminated with a period or a comma");
+ return;
+ }
+ }
+ }
+ }
+}
+
+void
+cm_pxref (arg)
+ int arg;
+{
+ if (arg == START)
+ {
+ px_ref_flag++;
+ cm_xref (arg);
+ px_ref_flag--;
+ }
+ else
+ add_char ('.');
+}
+
+void
+cm_inforef (arg)
+ int arg;
+{
+ if (arg == START)
+ {
+ char *node, *pname, *file;
+
+ node = get_xref_token ();
+ pname = get_xref_token ();
+ file = get_xref_token ();
+
+ execute_string ("*note %s: (%s)%s", pname, file, node);
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Insertion Command Stubs */
+/* */
+/* **************************************************************** */
+
+void
+cm_quotation ()
+{
+ begin_insertion (quotation);
+}
+
+void
+cm_example ()
+{
+ begin_insertion (example);
+}
+
+void
+cm_smallexample ()
+{
+ begin_insertion (smallexample);
+}
+
+void
+cm_lisp ()
+{
+ begin_insertion (lisp);
+}
+
+void
+cm_smalllisp ()
+{
+ begin_insertion (smalllisp);
+}
+
+/* @cartouche/@end cartouche draws box with rounded corners in
+ TeX output. Right now, just a NOP insertion. */
+void
+cm_cartouche ()
+{
+ begin_insertion (cartouche);
+}
+
+void
+cm_format ()
+{
+ begin_insertion (format);
+}
+
+void
+cm_display ()
+{
+ begin_insertion (display);
+}
+
+void
+cm_direntry ()
+{
+ if (no_headers)
+ command_name_condition ();
+ else
+ begin_insertion (direntry);
+}
+
+void
+cm_itemize ()
+{
+ begin_insertion (itemize);
+}
+
+void
+cm_enumerate ()
+{
+ do_enumeration (enumerate, "1");
+}
+
+/* Start an enumeration insertion of type TYPE. If the user supplied
+ no argument on the line, then use DEFAULT_STRING as the initial string. */
+void
+do_enumeration (type, default_string)
+ int type;
+ char *default_string;
+{
+ get_until_in_line (".", &enumeration_arg);
+ canon_white (enumeration_arg);
+
+ if (!*enumeration_arg)
+ {
+ free (enumeration_arg);
+ enumeration_arg = strdup (default_string);
+ }
+
+ if (!isdigit (*enumeration_arg) && !isletter (*enumeration_arg))
+ {
+ warning ("%s requires a letter or a digit", insertion_type_pname (type));
+
+ switch (type)
+ {
+ case enumerate:
+ default_string = "1";
+ break;
+ }
+ enumeration_arg = strdup (default_string);
+ }
+ begin_insertion (type);
+}
+
+void
+cm_table ()
+{
+ begin_insertion (table);
+}
+
+void
+cm_multitable ()
+{
+ begin_insertion (multitable); /* @@ */
+}
+
+void
+cm_ftable ()
+{
+ begin_insertion (ftable);
+}
+
+void
+cm_vtable ()
+{
+ begin_insertion (vtable);
+}
+
+void
+cm_group ()
+{
+ begin_insertion (group);
+}
+
+void
+cm_ifinfo ()
+{
+ begin_insertion (ifinfo);
+}
+
+/* Begin an insertion where the lines are not filled or indented. */
+void
+cm_flushleft ()
+{
+ begin_insertion (flushleft);
+}
+
+/* Begin an insertion where the lines are not filled, and each line is
+ forced to the right-hand side of the page. */
+void
+cm_flushright ()
+{
+ begin_insertion (flushright);
+}
+
+/* **************************************************************** */
+/* */
+/* Conditional Handling */
+/* */
+/* **************************************************************** */
+
+/* A structure which contains `defined' variables. */
+typedef struct defines {
+ struct defines *next;
+ char *name;
+ char *value;
+} DEFINE;
+
+/* The linked list of `set' defines. */
+DEFINE *defines = (DEFINE *)NULL;
+
+/* Add NAME to the list of `set' defines. */
+void
+set (name, value)
+ char *name;
+ char *value;
+{
+ DEFINE *temp;
+
+ for (temp = defines; temp; temp = temp->next)
+ if (strcmp (name, temp->name) == 0)
+ {
+ free (temp->value);
+ temp->value = strdup (value);
+ return;
+ }
+
+ temp = (DEFINE *)xmalloc (sizeof (DEFINE));
+ temp->next = defines;
+ temp->name = strdup (name);
+ temp->value = strdup (value);
+ defines = temp;
+}
+
+/* Remove NAME from the list of `set' defines. */
+void
+clear (name)
+ char *name;
+{
+ register DEFINE *temp, *last;
+
+ last = (DEFINE *)NULL;
+ temp = defines;
+
+ while (temp)
+ {
+ if (strcmp (temp->name, name) == 0)
+ {
+ if (last)
+ last->next = temp->next;
+ else
+ defines = temp->next;
+
+ free (temp->name);
+ free (temp->value);
+ free (temp);
+ break;
+ }
+ last = temp;
+ temp = temp->next;
+ }
+}
+
+/* Return the value of NAME. The return value is NULL if NAME is unset. */
+char *
+set_p (name)
+ char *name;
+{
+ register DEFINE *temp;
+
+ for (temp = defines; temp; temp = temp->next)
+ if (strcmp (temp->name, name) == 0)
+ return (temp->value);
+
+ return ((char *)NULL);
+}
+
+/* Conditionally parse based on the current command name. */
+void
+command_name_condition ()
+{
+ char *discarder;
+
+ discarder = (char *)xmalloc (8 + strlen (command));
+
+ sprintf (discarder, "\n%cend %s", COMMAND_PREFIX, command);
+ discard_until (discarder);
+ discard_until ("\n");
+
+ free (discarder);
+}
+
+/* Create a variable whose name appears as the first word on this line. */
+void
+cm_set ()
+{
+ handle_variable (SET);
+}
+
+/* Remove a variable whose name appears as the first word on this line. */
+void
+cm_clear ()
+{
+ handle_variable (CLEAR);
+}
+
+void
+cm_ifset ()
+{
+ handle_variable (IFSET);
+}
+
+void
+cm_ifclear ()
+{
+ handle_variable (IFCLEAR);
+}
+
+/* This command takes braces, but we parse the contents specially, so we
+ don't use the standard brace popping code.
+
+ The syntax @ifeq{arg1, arg2, texinfo-commands} performs texinfo-commands
+ if ARG1 and ARG2 caselessly string compare to the same string, otherwise,
+ it produces no output. */
+void
+cm_ifeq ()
+{
+ register int i;
+ char **arglist;
+
+ arglist = get_brace_args (0);
+
+ if (arglist)
+ {
+ if (array_len (arglist) > 1)
+ {
+ if ((strcasecmp (arglist[0], arglist[1]) == 0) &&
+ (arglist[2] != (char *)NULL))
+ execute_string ("%s\n", arglist[2]);
+ }
+
+ free_array (arglist);
+ }
+}
+
+void
+cm_value (arg, start_pos, end_pos)
+ int arg, start_pos, end_pos;
+{
+ if (arg == END)
+ {
+ char *name, *value;
+ name = (char *)&output_paragraph[start_pos];
+ output_paragraph[end_pos] = '\0';
+ name = strdup (name);
+ value = set_p (name);
+ output_column -= end_pos - start_pos;
+ output_paragraph_offset = start_pos;
+
+ if (value)
+ execute_string ("%s", value);
+ else
+ add_word_args ("{No Value For \"%s\"}", name);
+
+ free (name);
+ }
+}
+
+/* Set, clear, or conditionalize based on ACTION. */
+void
+handle_variable (action)
+ int action;
+{
+ char *name;
+
+ get_rest_of_line (&name);
+ backup_input_pointer ();
+ canon_white (name);
+ handle_variable_internal (action, name);
+ free (name);
+}
+
+void
+handle_variable_internal (action, name)
+ int action;
+ char *name;
+{
+ char *temp;
+ int delimiter, additional_text_present = 0;
+
+ /* Only the first word of NAME is a valid tag. */
+ temp = name;
+ delimiter = 0;
+ while (*temp && (delimiter || !whitespace (*temp)))
+ {
+/* #if defined (SET_WITH_EQUAL) */
+ if (*temp == '"' || *temp == '\'')
+ {
+ if (*temp == delimiter)
+ delimiter = 0;
+ else
+ delimiter = *temp;
+ }
+/* #endif SET_WITH_EQUAL */
+ temp++;
+ }
+
+ if (*temp)
+ additional_text_present++;
+
+ *temp = '\0';
+
+ if (!*name)
+ line_error ("%c%s requires a name", COMMAND_PREFIX, command);
+ else
+ {
+ switch (action)
+ {
+ case SET:
+ {
+ char *value;
+
+#if defined (SET_WITH_EQUAL)
+ /* Allow a value to be saved along with a variable. The value is
+ the text following an `=' sign in NAME, if any is present. */
+
+ for (value = name; *value && *value != '='; value++);
+
+ if (*value)
+ *value++ = '\0';
+
+ if (*value == '"' || *value == '\'')
+ {
+ value++;
+ value[strlen (value) - 1] = '\0';
+ }
+
+#else /* !SET_WITH_EQUAL */
+ /* The VALUE of NAME is the remainder of the line sans
+ whitespace. */
+ if (additional_text_present)
+ {
+ value = temp + 1;
+ canon_white (value);
+ }
+ else
+ value = "";
+#endif /* !SET_WITH_VALUE */
+
+ set (name, value);
+ }
+ break;
+
+ case CLEAR:
+ clear (name);
+ break;
+
+ case IFSET:
+ case IFCLEAR:
+ /* If IFSET and NAME is not set, or if IFCLEAR and NAME is set,
+ read lines from the the file until we reach a matching
+ "@end CONDITION". This means that we only take note of
+ "@ifset/clear" and "@end" commands. */
+ {
+ char condition[8];
+ int condition_len;
+
+ if (action == IFSET)
+ strcpy (condition, "ifset");
+ else
+ strcpy (condition, "ifclear");
+
+ condition_len = strlen (condition);
+
+ if ((action == IFSET && !set_p (name)) ||
+ (action == IFCLEAR && set_p (name)))
+ {
+ int level = 0, done = 0;
+
+ while (!done)
+ {
+ char *freeable_line, *line;
+
+ get_rest_of_line (&freeable_line);
+
+ for (line = freeable_line; whitespace (*line); line++);
+
+ if (*line == COMMAND_PREFIX &&
+ (strncmp (line + 1, condition, condition_len) == 0))
+ level++;
+ else if (strncmp (line, "@end", 4) == 0)
+ {
+ char *cname = line + 4;
+ char *temp;
+
+ while (*cname && whitespace (*cname))
+ cname++;
+ temp = cname;
+
+ while (*temp && !whitespace (*temp))
+ temp++;
+ *temp = '\0';
+
+ if (strcmp (cname, condition) == 0)
+ {
+ if (!level)
+ {
+ done = 1;
+ }
+ else
+ level--;
+ }
+ }
+ free (freeable_line);
+ }
+ /* We found the end of a false @ifset/ifclear. If we are
+ in a menu, back up over the newline that ends the ifset,
+ since that newline may also begin the next menu entry. */
+ break;
+ }
+ else
+ {
+ if (action == IFSET)
+ begin_insertion (ifset);
+ else
+ begin_insertion (ifclear);
+ }
+ }
+ break;
+ }
+ }
+}
+
+/* Execution of random text not in file. */
+
+typedef struct {
+ char *string; /* The string buffer. */
+ int size; /* The size of the buffer. */
+ int in_use; /* Non-zero means string currently in use. */
+} EXECUTION_STRING;
+
+static EXECUTION_STRING **execution_strings = (EXECUTION_STRING **)NULL;
+static int execution_strings_index = 0;
+static int execution_strings_slots = 0;
+
+EXECUTION_STRING *
+get_execution_string (initial_size)
+ int initial_size;
+{
+ register int i = 0;
+ EXECUTION_STRING *es = (EXECUTION_STRING *)NULL;
+
+ if (execution_strings)
+ {
+ for (i = 0; i < execution_strings_index; i++)
+ if (execution_strings[i] && (execution_strings[i]->in_use == 0))
+ {
+ es = execution_strings[i];
+ break;
+ }
+ }
+
+ if (!es)
+ {
+ if (execution_strings_index + 1 >= execution_strings_slots)
+ {
+ execution_strings = (EXECUTION_STRING **)xrealloc
+ (execution_strings,
+ (execution_strings_slots += 3) * sizeof (EXECUTION_STRING *));
+ for (; i < execution_strings_slots; i++)
+ execution_strings[i] = (EXECUTION_STRING *)NULL;
+ }
+
+ execution_strings[execution_strings_index] =
+ (EXECUTION_STRING *)xmalloc (sizeof (EXECUTION_STRING));
+ es = execution_strings[execution_strings_index];
+ execution_strings_index++;
+
+ es->size = 0;
+ es->string = (char *)NULL;
+ es->in_use = 0;
+ }
+
+ if (initial_size > es->size)
+ {
+ es->string = (char *) xrealloc (es->string, initial_size);
+ es->size = initial_size;
+ }
+ return (es);
+}
+
+/* Execute the string produced by formatting the ARGs with FORMAT. This
+ is like submitting a new file with @include. */
+#if defined (HAVE_VARARGS_H) && defined (HAVE_VSPRINTF)
+void
+execute_string (va_alist)
+ va_dcl
+{
+ EXECUTION_STRING *es;
+ char *temp_string;
+ char *format;
+ va_list args;
+
+ es = get_execution_string (4000);
+ temp_string = es->string;
+ es->in_use = 1;
+
+ va_start (args);
+ format = va_arg (args, char *);
+ vsprintf (temp_string, format, args);
+ va_end (args);
+
+#else /* !(HAVE_VARARGS_H && HAVE_VSPRINTF) */
+
+void
+execute_string (format, arg1, arg2, arg3, arg4, arg5)
+ char *format;
+{
+ EXECUTION_STRING *es;
+ char *temp_string;
+
+ es = get_execution_string (4000);
+ temp_string = es->string;
+ es->in_use = 1;
+
+ sprintf (temp_string, format, arg1, arg2, arg3, arg4, arg5);
+
+#endif /* !(HAVE_VARARGS_H && HAVE_VSPRINTF) */
+
+ pushfile ();
+ input_text_offset = 0;
+ input_text = temp_string;
+ input_filename = strdup (input_filename);
+ size_of_input_text = strlen (temp_string);
+
+ executing_string++;
+ reader_loop ();
+ free (input_filename);
+
+ popfile ();
+ executing_string--;
+ es->in_use = 0;
+}
+
+
+/* Return what would be output for STR, i.e., expand Texinfo commands.
+ If IMPLICIT_CODE is set, expand @code{STR}. */
+
+char *
+expansion (str, implicit_code)
+ char *str;
+ int implicit_code;
+{
+ int length;
+ char *result;
+
+ /* Inhibit any real output. */
+ int start = output_paragraph_offset;
+ int saved_paragraph_is_open = paragraph_is_open;
+
+ inhibit_output_flushing ();
+ execute_string (implicit_code ? "@code{%s}" : "%s", str);
+ uninhibit_output_flushing ();
+
+ /* Copy the expansion from the buffer. */
+ length = output_paragraph_offset - start;
+ result = xmalloc (1 + length);
+ memcpy (result, (char *) (output_paragraph + start), length);
+ result[length] = 0;
+
+ /* Pretend it never happened. */
+ output_paragraph_offset = start;
+ paragraph_is_open = saved_paragraph_is_open;
+
+ return result;
+}
+
+/* @itemx, @item. */
+
+static int itemx_flag = 0;
+
+void
+cm_itemx ()
+{
+ itemx_flag++;
+ cm_item ();
+ itemx_flag--;
+}
+
+void
+cm_item ()
+{
+ char *rest_of_line, *item_func;
+
+ /* Can only hack "@item" while inside of an insertion. */
+ if (insertion_level)
+ {
+ INSERTION_ELT *stack = insertion_stack;
+ int original_input_text_offset;
+
+ skip_whitespace ();
+ original_input_text_offset = input_text_offset;
+
+ get_rest_of_line (&rest_of_line);
+ canon_white (rest_of_line);
+ item_func = current_item_function ();
+
+ /* Okay, do the right thing depending on which insertion function
+ is active. */
+
+ switch_top:
+ switch (stack->insertion)
+ {
+ case multitable:
+ multitable_item ();
+ /* Ultra special hack. It appears that some people incorrectly
+ place text directly after the @item, instead of on a new line
+ by itself. This happens to work in TeX, so I make it work
+ here. */
+ if (*rest_of_line)
+ {
+ line_number--;
+ input_text_offset = original_input_text_offset;
+ }
+ break;
+
+ case ifinfo:
+ case ifset:
+ case ifclear:
+ case cartouche:
+ stack = stack->next;
+ if (!stack)
+ goto no_insertion;
+ else
+ goto switch_top;
+ break;
+
+ case menu:
+ case quotation:
+ case example:
+ case smallexample:
+ case lisp:
+ case format:
+ case display:
+ case group:
+ line_error ("The `%c%s' command is meaningless within a `@%s' block",
+ COMMAND_PREFIX, command,
+ insertion_type_pname (current_insertion_type ()));
+ break;
+
+ case itemize:
+ case enumerate:
+ if (itemx_flag)
+ {
+ line_error ("%citemx is not meaningful inside of a `%s' block",
+ COMMAND_PREFIX,
+ insertion_type_pname (current_insertion_type ()));
+ }
+ else
+ {
+ start_paragraph ();
+ kill_self_indent (-1);
+ filling_enabled = indented_fill = 1;
+
+ if (current_insertion_type () == itemize)
+ {
+ indent (output_column = current_indent - 2);
+
+ /* I need some way to determine whether this command
+ takes braces or not. I believe the user can type
+ either "@bullet" or "@bullet{}". Of course, they
+ can also type "o" or "#" or whatever else they want. */
+ if (item_func && *item_func)
+ {
+ if (*item_func == COMMAND_PREFIX)
+ if (item_func[strlen (item_func) - 1] != '}')
+ execute_string ("%s{}", item_func);
+ else
+ execute_string ("%s", item_func);
+ else
+ execute_string ("%s", item_func);
+ }
+ insert (' ');
+ output_column++;
+ }
+ else
+ enumerate_item ();
+
+ /* Special hack. This makes close paragraph ignore you until
+ the start_paragraph () function has been called. */
+ must_start_paragraph = 1;
+
+ /* Ultra special hack. It appears that some people incorrectly
+ place text directly after the @item, instead of on a new line
+ by itself. This happens to work in TeX, so I make it work
+ here. */
+ if (*rest_of_line)
+ {
+ line_number--;
+ input_text_offset = original_input_text_offset;
+ }
+ }
+ break;
+
+ case table:
+ case ftable:
+ case vtable:
+ {
+ /* Get rid of extra characters. */
+ kill_self_indent (-1);
+
+ /* close_paragraph () almost does what we want. The problem
+ is when paragraph_is_open, and last_char_was_newline, and
+ the last newline has been turned into a space, because
+ filling_enabled. I handle it here. */
+ if (last_char_was_newline && filling_enabled && paragraph_is_open)
+ insert ('\n');
+ close_paragraph ();
+
+#if defined (INDENT_PARAGRAPHS_IN_TABLE)
+ /* Indent on a new line, but back up one indentation level. */
+ {
+ int t;
+
+ t = inhibit_paragraph_indentation;
+ inhibit_paragraph_indentation = 1;
+ /* At this point, inserting any non-whitespace character will
+ force the existing indentation to be output. */
+ add_char ('i');
+ inhibit_paragraph_indentation = t;
+ }
+#else /* !INDENT_PARAGRAPHS_IN_TABLE */
+ add_char ('i');
+#endif /* !INDENT_PARAGRAPHS_IN_TABLE */
+
+ output_paragraph_offset--;
+ kill_self_indent (default_indentation_increment + 1);
+
+ /* Add item's argument to the line. */
+ filling_enabled = 0;
+ if (item_func && *item_func)
+ execute_string ("%s{%s}", item_func, rest_of_line);
+ else
+ execute_string ("%s", rest_of_line);
+
+ if (current_insertion_type () == ftable)
+ execute_string ("%cfindex %s\n", COMMAND_PREFIX, rest_of_line);
+
+ if (current_insertion_type () == vtable)
+ execute_string ("%cvindex %s\n", COMMAND_PREFIX, rest_of_line);
+
+ /* Start a new line, and let start_paragraph ()
+ do the indenting of it for you. */
+ close_single_paragraph ();
+ indented_fill = filling_enabled = 1;
+ }
+ }
+ free (rest_of_line);
+ }
+ else
+ {
+ no_insertion:
+ line_error ("%c%s found outside of an insertion block",
+ COMMAND_PREFIX, command);
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* Defun and Friends */
+/* */
+/* **************************************************************** */
+
+#define DEFUN_SELF_DELIMITING(c) \
+ (((c) == '(') \
+ || ((c) == ')') \
+ || ((c) == '[') \
+ || ((c) == ']'))
+
+struct token_accumulator
+{
+ unsigned int length;
+ unsigned int index;
+ char **tokens;
+};
+
+void
+initialize_token_accumulator (accumulator)
+ struct token_accumulator *accumulator;
+{
+ (accumulator->length) = 0;
+ (accumulator->index) = 0;
+ (accumulator->tokens) = NULL;
+}
+
+void
+accumulate_token (accumulator, token)
+ struct token_accumulator *accumulator;
+ char *token;
+{
+ if ((accumulator->index) >= (accumulator->length))
+ {
+ (accumulator->length) += 10;
+ (accumulator->tokens) = (char **) xrealloc
+ (accumulator->tokens, (accumulator->length * sizeof (char *)));
+ }
+ accumulator->tokens[accumulator->index] = token;
+ accumulator->index += 1;
+}
+
+char *
+copy_substring (start, end)
+ char *start;
+ char *end;
+{
+ char *result, *scan, *scan_result;
+
+ result = (char *) xmalloc ((end - start) + 1);
+ scan_result = result;
+ scan = start;
+
+ while (scan < end)
+ *scan_result++ = *scan++;
+
+ *scan_result = '\0';
+ return (result);
+}
+
+/* Given `string' pointing at an open brace, skip forward and return a
+ pointer to just past the matching close brace. */
+int
+scan_group_in_string (string_pointer)
+ char **string_pointer;
+{
+ register int c;
+ register char *scan_string;
+ register unsigned int level = 1;
+
+ scan_string = (*string_pointer) + 1;
+
+ while (1)
+ {
+ if (level == 0)
+ {
+ (*string_pointer) = scan_string;
+ return (1);
+ }
+ c = (*scan_string++);
+ if (c == '\0')
+ {
+ /* Tweak line_number to compensate for fact that
+ we gobbled the whole line before coming here. */
+ line_number -= 1;
+ line_error ("Missing `}' in %cdef arg", COMMAND_PREFIX);
+ line_number += 1;
+ (*string_pointer) = (scan_string - 1);
+ return (0);
+ }
+ if (c == '{')
+ level += 1;
+ if (c == '}')
+ level -= 1;
+ }
+}
+
+/* Return a list of tokens from the contents of `string'.
+ Commands and brace-delimited groups count as single tokens.
+ Contiguous whitespace characters are converted to a token
+ consisting of a single space. */
+char **
+args_from_string (string)
+ char *string;
+{
+ struct token_accumulator accumulator;
+ register char *scan_string = string;
+ char *token_start, *token_end;
+
+ initialize_token_accumulator (&accumulator);
+
+ while ((*scan_string) != '\0')
+ {
+ /* Replace arbitrary whitespace by a single space. */
+ if (whitespace (*scan_string))
+ {
+ scan_string += 1;
+ while (whitespace (*scan_string))
+ scan_string += 1;
+ accumulate_token ((&accumulator), (strdup (" ")));
+ continue;
+ }
+
+ /* Commands count as single tokens. */
+ if ((*scan_string) == COMMAND_PREFIX)
+ {
+ token_start = scan_string;
+ scan_string += 1;
+ if (self_delimiting (*scan_string))
+ scan_string += 1;
+ else
+ {
+ register int c;
+ while (1)
+ {
+ c = *scan_string++;
+
+ if ((c == '\0') || (c == '{') || (whitespace (c)))
+ {
+ scan_string -= 1;
+ break;
+ }
+ }
+
+ if (*scan_string == '{')
+ {
+ char *s = scan_string;
+ (void) scan_group_in_string (&s);
+ scan_string = s;
+ }
+ }
+ token_end = scan_string;
+ }
+
+ /* Parentheses and brackets are self-delimiting. */
+ else if (DEFUN_SELF_DELIMITING (*scan_string))
+ {
+ token_start = scan_string;
+ scan_string += 1;
+ token_end = scan_string;
+ }
+
+ /* Open brace introduces a group that is a single token. */
+ else if (*scan_string == '{')
+ {
+ char *s = scan_string;
+ int balanced = scan_group_in_string (&s);
+
+ token_start = scan_string + 1;
+ scan_string = s;
+ token_end = balanced ? (scan_string - 1) : scan_string;
+ }
+
+ /* Otherwise a token is delimited by whitespace, parentheses,
+ brackets, or braces. A token is also ended by a command. */
+ else
+ {
+ token_start = scan_string;
+
+ while (1)
+ {
+ register int c;
+
+ c = *scan_string++;
+
+ /* Do not back up if we're looking at a }; since the only
+ valid }'s are those matched with {'s, we want to give
+ an error. If we back up, we go into an infinite loop. */
+ if (!c || whitespace (c) || DEFUN_SELF_DELIMITING (c)
+ || c == '{')
+ {
+ scan_string--;
+ break;
+ }
+
+ /* If we encounter a command embedded within a token,
+ then end the token. */
+ if (c == COMMAND_PREFIX)
+ {
+ scan_string--;
+ break;
+ }
+ }
+ token_end = scan_string;
+ }
+
+ accumulate_token
+ (&accumulator, copy_substring (token_start, token_end));
+ }
+ accumulate_token (&accumulator, NULL);
+ return (accumulator.tokens);
+}
+
+void
+process_defun_args (defun_args, auto_var_p)
+ char **defun_args;
+ int auto_var_p;
+{
+ int pending_space = 0;
+
+ while (1)
+ {
+ char *defun_arg = *defun_args++;
+
+ if (defun_arg == NULL)
+ break;
+
+ if (defun_arg[0] == ' ')
+ {
+ pending_space = 1;
+ continue;
+ }
+
+ if (pending_space)
+ {
+ add_char (' ');
+ pending_space = 0;
+ }
+
+ if (DEFUN_SELF_DELIMITING (defun_arg[0]))
+ add_char (defun_arg[0]);
+ else if (defun_arg[0] == '&')
+ add_word (defun_arg);
+ else if (defun_arg[0] == COMMAND_PREFIX)
+ execute_string ("%s", defun_arg);
+ else if (auto_var_p)
+ execute_string ("%cvar{%s}", COMMAND_PREFIX, defun_arg);
+ else
+ add_word (defun_arg);
+ }
+}
+
+char *
+next_nonwhite_defun_arg (arg_pointer)
+ char ***arg_pointer;
+{
+ char **scan = (*arg_pointer);
+ char *arg = (*scan++);
+
+ if ((arg != 0) && (*arg == ' '))
+ arg = *scan++;
+
+ if (arg == 0)
+ scan -= 1;
+
+ *arg_pointer = scan;
+
+ return ((arg == 0) ? "" : arg);
+}
+
+/* Make the defun type insertion.
+ TYPE says which insertion this is.
+ X_P says not to start a new insertion if non-zero. */
+void
+defun_internal (type, x_p)
+ enum insertion_type type;
+ int x_p;
+{
+ enum insertion_type base_type;
+ char **defun_args, **scan_args;
+ char *category, *defined_name, *type_name, *type_name2;
+
+ {
+ char *line;
+ get_rest_of_line (&line);
+ defun_args = (args_from_string (line));
+ free (line);
+ }
+
+ scan_args = defun_args;
+
+ switch (type)
+ {
+ case defun:
+ category = "Function";
+ base_type = deffn;
+ break;
+ case defmac:
+ category = "Macro";
+ base_type = deffn;
+ break;
+ case defspec:
+ category = "Special Form";
+ base_type = deffn;
+ break;
+ case defvar:
+ category = "Variable";
+ base_type = defvr;
+ break;
+ case defopt:
+ category = "User Option";
+ base_type = defvr;
+ break;
+ case deftypefun:
+ category = "Function";
+ base_type = deftypefn;
+ break;
+ case deftypevar:
+ category = "Variable";
+ base_type = deftypevr;
+ break;
+ case defivar:
+ category = "Instance Variable";
+ base_type = defcv;
+ break;
+ case defmethod:
+ category = "Method";
+ base_type = defop;
+ break;
+ case deftypemethod:
+ category = "Method";
+ base_type = deftypemethod;
+ break;
+ default:
+ category = next_nonwhite_defun_arg (&scan_args);
+ base_type = type;
+ break;
+ }
+
+ if ((base_type == deftypefn)
+ || (base_type == deftypevr)
+ || (base_type == defcv)
+ || (base_type == defop)
+ || (base_type == deftypemethod))
+ type_name = next_nonwhite_defun_arg (&scan_args);
+
+ if (base_type == deftypemethod)
+ type_name2 = next_nonwhite_defun_arg (&scan_args);
+
+ defined_name = next_nonwhite_defun_arg (&scan_args);
+
+ /* This hack exists solely for the purposes of formatting the texinfo
+ manual. I couldn't think of a better way. The token might be
+ a simple @@ followed immediately by more text. If this is the case,
+ then the next defun arg is part of this one, and we should concatenate
+ them. */
+ if (*scan_args && **scan_args && !whitespace (**scan_args) &&
+ (strcmp (defined_name, "@@") == 0))
+ {
+ char *tem = (char *)xmalloc (3 + strlen (scan_args[0]));
+
+ sprintf (tem, "@@%s", scan_args[0]);
+
+ free (scan_args[0]);
+ scan_args[0] = tem;
+ scan_args++;
+ defined_name = tem;
+ }
+
+ if (!x_p)
+ begin_insertion (type);
+
+ /* Write the definition header line.
+ This should start at the normal indentation. */
+ current_indent -= default_indentation_increment;
+ start_paragraph ();
+
+ switch (base_type)
+ {
+ case deffn:
+ case defvr:
+ case deftp:
+ execute_string (" -- %s: %s", category, defined_name);
+ break;
+ case deftypefn:
+ case deftypevr:
+ execute_string (" -- %s: %s %s", category, type_name, defined_name);
+ break;
+ case defcv:
+ execute_string (" -- %s of %s: %s", category, type_name, defined_name);
+ break;
+ case defop:
+ execute_string (" -- %s on %s: %s", category, type_name, defined_name);
+ break;
+ case deftypemethod:
+ execute_string (" -- %s on %s: %s %s", category, type_name, type_name2,
+ defined_name);
+ break;
+ }
+ current_indent += default_indentation_increment;
+
+ /* Now process the function arguments, if any.
+ If these carry onto the next line, they should be indented by two
+ increments to distinguish them from the body of the definition,
+ which is indented by one increment. */
+ current_indent += default_indentation_increment;
+
+ switch (base_type)
+ {
+ case deffn:
+ case defop:
+ process_defun_args (scan_args, 1);
+ break;
+ case deftp:
+ case deftypefn:
+ case deftypemethod:
+ process_defun_args (scan_args, 0);
+ break;
+ }
+ current_indent -= default_indentation_increment;
+ close_single_paragraph ();
+
+ if (!macro_expansion_output_stream)
+ /* Make an entry in the appropriate index unless we are just
+ expanding macros. */
+ switch (base_type)
+ {
+ case deffn:
+ case deftypefn:
+ execute_string ("%cfindex %s\n", COMMAND_PREFIX, defined_name);
+ break;
+ case defvr:
+ case deftypevr:
+ case defcv:
+ execute_string ("%cvindex %s\n", COMMAND_PREFIX, defined_name);
+ break;
+ case defop:
+ case deftypemethod:
+ execute_string ("%cfindex %s on %s\n",
+ COMMAND_PREFIX, defined_name, type_name);
+ break;
+ case deftp:
+ execute_string ("%ctindex %s\n", COMMAND_PREFIX, defined_name);
+ break;
+ }
+
+ /* Deallocate the token list. */
+ scan_args = defun_args;
+ while (1)
+ {
+ char * arg = (*scan_args++);
+ if (arg == NULL)
+ break;
+ free (arg);
+ }
+ free (defun_args);
+}
+
+/* Add an entry for a function, macro, special form, variable, or option.
+ If the name of the calling command ends in `x', then this is an extra
+ entry included in the body of an insertion of the same type. */
+void
+cm_defun ()
+{
+ int x_p;
+ enum insertion_type type;
+ char *temp = strdup (command);
+
+ x_p = (command[strlen (command) - 1] == 'x');
+
+ if (x_p)
+ temp[strlen (temp) - 1] = '\0';
+
+ type = find_type_from_name (temp);
+ free (temp);
+
+ /* If we are adding to an already existing insertion, then make sure
+ that we are already in an insertion of type TYPE. */
+ if (x_p &&
+ (!insertion_level || insertion_stack->insertion != type))
+ {
+ line_error ("Must be in a `%s' insertion in order to use `%s'x",
+ command, command);
+ discard_until ("\n");
+ return;
+ }
+
+ defun_internal (type, x_p);
+}
+
+/* End existing insertion block. */
+void
+cm_end ()
+{
+ char *temp;
+ enum insertion_type type;
+
+ if (!insertion_level)
+ {
+ line_error ("Unmatched `%c%s'", COMMAND_PREFIX, command);
+ return;
+ }
+
+ get_rest_of_line (&temp);
+ canon_white (temp);
+
+ if (strlen (temp) == 0)
+ line_error ("`%c%s' needs something after it", COMMAND_PREFIX, command);
+
+ type = find_type_from_name (temp);
+
+ if (type == bad_type)
+ {
+ line_error ("Bad argument to `%s', `%s', using `%s'",
+ command, temp, insertion_type_pname (current_insertion_type ()));
+ }
+ end_insertion (type);
+ free (temp);
+}
+
+/* **************************************************************** */
+/* */
+/* Other Random Commands */
+/* */
+/* **************************************************************** */
+
+/* This says to inhibit the indentation of the next paragraph, but
+ not of following paragraphs. */
+void
+cm_noindent ()
+{
+ if (!inhibit_paragraph_indentation)
+ inhibit_paragraph_indentation = -1;
+}
+
+/* I don't know exactly what to do with this. Should I allow
+ someone to switch filenames in the middle of output? Since the
+ file could be partially written, this doesn't seem to make sense.
+ Another option: ignore it, since they don't *really* want to
+ switch files. Finally, complain, or at least warn. */
+void
+cm_setfilename ()
+{
+ char *filename;
+ get_rest_of_line (&filename);
+ /* warning ("`@%s %s' encountered and ignored", command, filename); */
+ free (filename);
+}
+
+void
+cm_ignore_line ()
+{
+ discard_until ("\n");
+}
+
+/* @br can be immediately followed by `{}', so we have to read those here.
+ It should simply close the paragraph. */
+void
+cm_br ()
+{
+ if (looking_at ("{}"))
+ input_text_offset += 2;
+
+ if (curchar () == '\n')
+ {
+ input_text_offset++;
+ line_number++;
+ }
+
+ close_paragraph ();
+}
+
+ /* Insert the number of blank lines passed as argument. */
+void
+cm_sp ()
+{
+ int lines;
+ char *line;
+
+ get_rest_of_line (&line);
+
+ if (sscanf (line, "%d", &lines) != 1)
+ {
+ line_error ("%csp requires a positive numeric argument", COMMAND_PREFIX);
+ }
+ else
+ {
+ if (lines < 0)
+ lines = 0;
+
+ while (lines--)
+ add_char ('\n');
+ }
+ free (line);
+}
+
+/* @dircategory LINE outputs INFO-DIR-SECTION LINE,
+ but not if --no-headers. */
+
+void
+cm_dircategory ()
+{
+ char *line, *p;
+
+ get_rest_of_line (&line);;
+
+ if (! no_headers)
+ {
+ insert_string ("INFO-DIR-SECTION ");
+ insert_string (line);
+ insert ('\n');
+ }
+
+ free (line);
+}
+
+/* Start a new line with just this text on it.
+ Then center the line of text.
+ This always ends the current paragraph. */
+void
+cm_center ()
+{
+ register int i, start, length;
+ int fudge_factor = 1;
+ unsigned char *line;
+
+ close_paragraph ();
+ filling_enabled = indented_fill = 0;
+ cm_noindent ();
+ start = output_paragraph_offset;
+ inhibit_output_flushing ();
+ get_rest_of_line ((char **)&line);
+ execute_string ("%s", (char *)line);
+ free (line);
+ uninhibit_output_flushing ();
+
+ i = output_paragraph_offset - 1;
+ while (i > (start - 1) && output_paragraph[i] == '\n')
+ i--;
+
+ output_paragraph_offset = ++i;
+ length = output_paragraph_offset - start;
+
+ if (length < (fill_column - fudge_factor))
+ {
+ line = (unsigned char *)xmalloc (1 + length);
+ memcpy (line, (char *)(output_paragraph + start), length);
+
+ i = (fill_column - fudge_factor - length) / 2;
+ output_paragraph_offset = start;
+
+ while (i--)
+ insert (' ');
+
+ for (i = 0; i < length; i++)
+ insert (line[i]);
+
+ free (line);
+ }
+
+ insert ('\n');
+ close_paragraph ();
+ filling_enabled = 1;
+}
+
+/* Show what an expression returns. */
+void
+cm_result (arg)
+ int arg;
+{
+ if (arg == END)
+ add_word ("=>");
+}
+
+/* What an expression expands to. */
+void
+cm_expansion (arg)
+ int arg;
+{
+ if (arg == END)
+ add_word ("==>");
+}
+
+/* Indicates two expressions are equivalent. */
+void
+cm_equiv (arg)
+ int arg;
+{
+ if (arg == END)
+ add_word ("==");
+}
+
+/* What an expression may print. */
+void
+cm_print (arg)
+ int arg;
+{
+ if (arg == END)
+ add_word ("-|");
+}
+
+/* An error signaled. */
+void
+cm_error (arg)
+ int arg;
+{
+ if (arg == END)
+ add_word ("error-->");
+}
+
+/* The location of point in an example of a buffer. */
+void
+cm_point (arg)
+ int arg;
+{
+ if (arg == END)
+ add_word ("-!-");
+}
+
+/* Start a new line with just this text on it.
+ The text is outdented one level if possible. */
+void
+cm_exdent ()
+{
+ char *line;
+ int i = current_indent;
+
+ if (current_indent)
+ current_indent -= default_indentation_increment;
+
+ get_rest_of_line (&line);
+ close_single_paragraph ();
+ execute_string ("%s", line);
+ current_indent = i;
+ free (line);
+ close_single_paragraph ();
+}
+
+#if !defined (HAVE_STRERROR)
+extern char *sys_errlist[];
+extern int sys_nerr;
+
+char *
+strerror (num)
+ int num;
+{
+ if (num >= sys_nerr)
+ return ("Unknown file system error");
+ else
+ return (sys_errlist[num]);
+}
+#endif /* !HAVE_STRERROR */
+
+/* Remember this file, and move onto the next. */
+void
+cm_include ()
+{
+ char *filename;
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ me_append_before_this_command ();
+#endif /* HAVE_MACROS */
+
+ close_paragraph ();
+ get_rest_of_line (&filename);
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ remember_itext (input_text, input_text_offset);
+#endif /* HAVE_MACROS */
+
+ pushfile ();
+
+ /* In verbose mode we print info about including another file. */
+ if (verbose_mode)
+ {
+ register int i = 0;
+ register FSTACK *stack = filestack;
+
+ for (i = 0, stack = filestack; stack; stack = stack->next, i++);
+
+ i *= 2;
+
+ printf ("%*s", i, "");
+ printf ("%c%s %s\n", COMMAND_PREFIX, command, filename);
+ fflush (stdout);
+ }
+
+ if (!find_and_load (filename))
+ {
+ extern int errno;
+
+ popfile ();
+ line_number--;
+
+ /* Cannot "@include foo", in line 5 of "/wh/bar". */
+ line_error ("`%c%s %s': %s", COMMAND_PREFIX, command, filename,
+ strerror (errno));
+
+ free (filename);
+ return;
+ }
+ else
+ {
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ remember_itext (input_text, input_text_offset);
+#endif /* HAVE_MACROS */
+ reader_loop ();
+ }
+ free (filename);
+ popfile ();
+}
+
+/* The other side of a malformed expression. */
+void
+misplaced_brace ()
+{
+ line_error ("Misplaced `}'");
+}
+
+/* Signals end of processing. Easy to make this happen. */
+void
+cm_bye ()
+{
+ input_text_offset = size_of_input_text;
+}
+
+/* **************************************************************** */
+/* */
+/* Indexing Stuff */
+/* */
+/* **************************************************************** */
+
+
+/* An index element... */
+typedef struct index_elt
+{
+ struct index_elt *next;
+ char *entry; /* The index entry itself. */
+ char *node; /* The node from whence it came. */
+ int code; /* Non-zero means add `@code{...}' when
+ printing this element. */
+ int defining_line; /* Line number where this entry was written. */
+} INDEX_ELT;
+
+/* A list of short-names for each index, and the index to that index in our
+ index array, the_indices. In addition, for each index, it is remembered
+ whether that index is a code index or not. Code indices have @code{}
+ inserted around the first word when they are printed with printindex. */
+typedef struct
+{
+ char *name;
+ int index;
+ int code;
+} INDEX_ALIST;
+
+INDEX_ALIST **name_index_alist = (INDEX_ALIST **) NULL;
+
+/* An array of pointers. Each one is for a different index. The
+ "synindex" command changes which array slot is pointed to by a
+ given "index". */
+INDEX_ELT **the_indices = (INDEX_ELT **) NULL;
+
+/* The number of defined indices. */
+int defined_indices = 0;
+
+/* We predefine these. */
+#define program_index 0
+#define function_index 1
+#define concept_index 2
+#define variable_index 3
+#define datatype_index 4
+#define key_index 5
+
+void
+init_indices ()
+{
+ int i;
+
+ /* Create the default data structures. */
+
+ /* Initialize data space. */
+ if (!the_indices)
+ {
+ the_indices = (INDEX_ELT **) xmalloc ((1 + defined_indices) *
+ sizeof (INDEX_ELT *));
+ the_indices[defined_indices] = (INDEX_ELT *) NULL;
+
+ name_index_alist = (INDEX_ALIST **) xmalloc ((1 + defined_indices) *
+ sizeof (INDEX_ALIST *));
+ name_index_alist[defined_indices] = (INDEX_ALIST *) NULL;
+ }
+
+ /* If there were existing indices, get rid of them now. */
+ for (i = 0; i < defined_indices; i++)
+ undefindex (name_index_alist[i]->name);
+
+ /* Add the default indices. */
+ top_defindex ("pg", 0);
+ top_defindex ("fn", 1); /* "fn" is a code index. */
+ top_defindex ("cp", 0);
+ top_defindex ("vr", 0);
+ top_defindex ("tp", 0);
+ top_defindex ("ky", 0);
+
+}
+
+/* Find which element in the known list of indices has this name.
+ Returns -1 if NAME isn't found. */
+int
+find_index_offset (name)
+ char *name;
+{
+ register int i;
+ for (i = 0; i < defined_indices; i++)
+ if (name_index_alist[i] &&
+ strcmp (name, name_index_alist[i]->name) == 0)
+ return (name_index_alist[i]->index);
+ return (-1);
+}
+
+/* Return a pointer to the entry of (name . index) for this name.
+ Return NULL if the index doesn't exist. */
+INDEX_ALIST *
+find_index (name)
+ char *name;
+{
+ int offset = find_index_offset (name);
+ if (offset > -1)
+ return (name_index_alist[offset]);
+ else
+ return ((INDEX_ALIST *) NULL);
+}
+
+/* Given an index name, return the offset in the_indices of this index,
+ or -1 if there is no such index. */
+int
+translate_index (name)
+ char *name;
+{
+ INDEX_ALIST *which = find_index (name);
+
+ if (which)
+ return (which->index);
+ else
+ return (-1);
+}
+
+/* Return the index list which belongs to NAME. */
+INDEX_ELT *
+index_list (name)
+ char *name;
+{
+ int which = translate_index (name);
+ if (which < 0)
+ return ((INDEX_ELT *) -1);
+ else
+ return (the_indices[which]);
+}
+
+/* Please release me, let me go... */
+void
+free_index (index)
+ INDEX_ELT *index;
+{
+ INDEX_ELT *temp;
+
+ while ((temp = index) != (INDEX_ELT *) NULL)
+ {
+ free (temp->entry);
+ free (temp->node);
+ index = index->next;
+ free (temp);
+ }
+}
+
+/* Flush an index by name. */
+void
+undefindex (name)
+ char *name;
+{
+ int i;
+ int which = find_index_offset (name);
+
+ if (which < 0)
+ return;
+
+ i = name_index_alist[which]->index;
+
+ free_index (the_indices[i]);
+ the_indices[i] = (INDEX_ELT *) NULL;
+
+ free (name_index_alist[which]->name);
+ free (name_index_alist[which]);
+ name_index_alist[which] = (INDEX_ALIST *) NULL;
+}
+
+/* Define an index known as NAME. We assign the slot number.
+ CODE if non-zero says to make this a code index. */
+void
+defindex (name, code)
+ char *name;
+ int code;
+{
+ register int i, slot;
+
+ /* If it already exists, flush it. */
+ undefindex (name);
+
+ /* Try to find an empty slot. */
+ slot = -1;
+ for (i = 0; i < defined_indices; i++)
+ if (!name_index_alist[i])
+ {
+ slot = i;
+ break;
+ }
+
+ if (slot < 0)
+ {
+ /* No such luck. Make space for another index. */
+ slot = defined_indices;
+ defined_indices++;
+
+ name_index_alist = (INDEX_ALIST **)
+ xrealloc ((char *)name_index_alist,
+ (1 + defined_indices) * sizeof (INDEX_ALIST *));
+ the_indices = (INDEX_ELT **)
+ xrealloc ((char *)the_indices,
+ (1 + defined_indices) * sizeof (INDEX_ELT *));
+ }
+
+ /* We have a slot. Start assigning. */
+ name_index_alist[slot] = (INDEX_ALIST *) xmalloc (sizeof (INDEX_ALIST));
+ name_index_alist[slot]->name = strdup (name);
+ name_index_alist[slot]->index = slot;
+ name_index_alist[slot]->code = code;
+
+ the_indices[slot] = (INDEX_ELT *) NULL;
+}
+
+/* Add the arguments to the current index command to the index NAME. */
+void
+index_add_arg (name)
+ char *name;
+{
+ int which;
+ char *index_entry;
+ INDEX_ALIST *tem;
+
+ tem = find_index (name);
+
+ which = tem ? tem->index : -1;
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ append_to_expansion_output (input_text_offset + 1);
+#endif /* HAVE_MACROS */
+
+ get_rest_of_line (&index_entry);
+ ignore_blank_line ();
+
+#if defined (HAVE_MACROS)
+ if (macro_expansion_output_stream)
+ {
+ int op_orig;
+
+ remember_itext (input_text, input_text_offset);
+ op_orig = output_paragraph_offset;
+ me_execute_string (index_entry);
+ me_execute_string ("\n");
+ output_paragraph_offset = op_orig;
+ }
+#endif /* HAVE_MACROS */
+
+ if (which < 0)
+ {
+ line_error ("Unknown index reference `%s'", name);
+ free (index_entry);
+ }
+ else
+ {
+ INDEX_ELT *new = (INDEX_ELT *) xmalloc (sizeof (INDEX_ELT));
+ new->next = the_indices[which];
+ new->entry = index_entry;
+ new->node = current_node;
+ new->code = tem->code;
+ new->defining_line = line_number - 1;
+ the_indices[which] = new;
+ }
+}
+
+#define INDEX_COMMAND_SUFFIX "index"
+
+/* The function which user defined index commands call. */
+void
+gen_index ()
+{
+ char *name = strdup (command);
+ if (strlen (name) >= strlen ("index"))
+ name[strlen (name) - strlen ("index")] = '\0';
+ index_add_arg (name);
+ free (name);
+}
+
+void
+top_defindex (name, code)
+ char *name;
+ int code;
+{
+ char *temp;
+
+ temp = (char *) xmalloc (1 + strlen (name) + strlen ("index"));
+ sprintf (temp, "%sindex", name);
+ define_user_command (temp, gen_index, 0);
+ defindex (name, code);
+ free (temp);
+}
+
+/* Define a new index command. Arg is name of index. */
+void
+cm_defindex ()
+{
+ gen_defindex (0);
+}
+
+void
+cm_defcodeindex ()
+{
+ gen_defindex (1);
+}
+
+void
+gen_defindex (code)
+ int code;
+{
+ char *name;
+ get_rest_of_line (&name);
+
+ if (find_index (name))
+ {
+ line_error ("Index `%s' already exists", name);
+ free (name);
+ return;
+ }
+ else
+ {
+ char *temp = (char *) alloca (1 + strlen (name) + strlen ("index"));
+ sprintf (temp, "%sindex", name);
+ define_user_command (temp, gen_index, 0);
+ defindex (name, code);
+ free (name);
+ }
+}
+
+/* Append LIST2 to LIST1. Return the head of the list. */
+INDEX_ELT *
+index_append (head, tail)
+ INDEX_ELT *head, *tail;
+{
+ register INDEX_ELT *t_head = head;
+
+ if (!t_head)
+ return (tail);
+
+ while (t_head->next)
+ t_head = t_head->next;
+ t_head->next = tail;
+ return (head);
+}
+
+/* Expects 2 args, on the same line. Both are index abbreviations.
+ Make the first one be a synonym for the second one, i.e. make the
+ first one have the same index as the second one. */
+void
+cm_synindex ()
+{
+ int redirector, redirectee;
+ char *temp;
+
+ skip_whitespace ();
+ get_until_in_line (" ", &temp);
+ redirectee = find_index_offset (temp);
+ skip_whitespace ();
+ free_and_clear (&temp);
+ get_until_in_line (" ", &temp);
+ redirector = find_index_offset (temp);
+ free (temp);
+ if (redirector < 0 || redirectee < 0)
+ {
+ line_error ("Unknown index reference");
+ }
+ else
+ {
+ /* I think that we should let the user make indices synonymous to
+ each other without any lossage of info. This means that one can
+ say @synindex cp dt anywhere in the file, and things that used to
+ be in cp will go into dt. */
+ INDEX_ELT *i1 = the_indices[redirectee], *i2 = the_indices[redirector];
+
+ if (i1 || i2)
+ {
+ if (i1)
+ the_indices[redirectee] = index_append (i1, i2);
+ else
+ the_indices[redirectee] = index_append (i2, i1);
+ }
+
+ name_index_alist[redirectee]->index =
+ name_index_alist[redirector]->index;
+ }
+}
+
+void
+cm_pindex () /* Pinhead index. */
+{
+ index_add_arg ("pg");
+}
+
+void
+cm_vindex () /* Variable index. */
+{
+ index_add_arg ("vr");
+}
+
+void
+cm_kindex () /* Key index. */
+{
+ index_add_arg ("ky");
+}
+
+void
+cm_cindex () /* Concept index. */
+{
+ index_add_arg ("cp");
+}
+
+void
+cm_findex () /* Function index. */
+{
+ index_add_arg ("fn");
+}
+
+void
+cm_tindex () /* Data Type index. */
+{
+ index_add_arg ("tp");
+}
+
+/* Sorting the index. */
+int
+index_element_compare (element1, element2)
+ INDEX_ELT **element1, **element2;
+{
+ return (strcasecmp ((*element1)->entry, (*element2)->entry));
+}
+
+/* Force all index entries to be unique. */
+void
+make_index_entries_unique (array, count)
+ INDEX_ELT **array;
+ int count;
+{
+ register int i, j;
+ INDEX_ELT **copy;
+ int counter = 1;
+
+ copy = (INDEX_ELT **)xmalloc ((1 + count) * sizeof (INDEX_ELT *));
+
+ for (i = 0, j = 0; i < count; i++)
+ {
+ if ((i == (count - 1)) ||
+ (array[i]->node != array[i + 1]->node) ||
+ (strcmp (array[i]->entry, array[i + 1]->entry) != 0))
+ copy[j++] = array[i];
+ else
+ {
+ free (array[i]->entry);
+ free (array[i]);
+ }
+ }
+ copy[j] = (INDEX_ELT *)NULL;
+
+ /* Now COPY contains only unique entries. Duplicated entries in the
+ original array have been freed. Replace the current array with
+ the copy, fixing the NEXT pointers. */
+ for (i = 0; copy[i] != (INDEX_ELT *)NULL; i++)
+ {
+
+ copy[i]->next = copy[i + 1];
+
+ /* Fix entry names which are the same. They point to different nodes,
+ so we make the entry name unique. */
+ if ((copy[i + 1] != (INDEX_ELT *)NULL) &&
+ (strcmp (copy[i]->entry, copy[i + 1]->entry) == 0))
+ {
+ char *new_entry_name;
+
+ new_entry_name = (char *)xmalloc (10 + strlen (copy[i]->entry));
+ sprintf (new_entry_name, "%s <%d>", copy[i]->entry, counter);
+ free (copy[i]->entry);
+ copy[i]->entry = new_entry_name;
+ counter++;
+ }
+ else
+ counter = 1;
+
+ array[i] = copy[i];
+ }
+ array[i] = (INDEX_ELT *)NULL;
+
+ /* Free the storage used only by COPY. */
+ free (copy);
+}
+
+/* Sort the index passed in INDEX, returning an array of
+ pointers to elements. The array is terminated with a NULL
+ pointer. We call qsort because it's supposed to be fast.
+ I think this looks bad. */
+INDEX_ELT **
+sort_index (index)
+ INDEX_ELT *index;
+{
+ INDEX_ELT *temp = index;
+ INDEX_ELT **array;
+ int count = 0;
+
+ while (temp != (INDEX_ELT *) NULL)
+ {
+ count++;
+ temp = temp->next;
+ }
+
+ /* We have the length. Make an array. */
+
+ array = (INDEX_ELT **) xmalloc ((count + 1) * sizeof (INDEX_ELT *));
+ count = 0;
+ temp = index;
+
+ while (temp != (INDEX_ELT *) NULL)
+ {
+ array[count++] = temp;
+
+ /* Maybe should set line number to the defining_line? Any errors
+ have already been given, though, I think. */
+
+ /* If this particular entry should be printed as a "code" index,
+ then wrap the entry with "@code{...}". */
+ array[count - 1]->entry = expansion (temp->entry, index->code);
+
+ temp = temp->next;
+ }
+ array[count] = (INDEX_ELT *) NULL; /* terminate the array. */
+
+ /* Sort the array. */
+ qsort (array, count, sizeof (INDEX_ELT *), index_element_compare);
+ make_index_entries_unique (array, count);
+ return (array);
+}
+
+/* Non-zero means that we are in the middle of printing an index. */
+int printing_index = 0;
+
+/* Takes one arg, a short name of an index to print.
+ Outputs a menu of the sorted elements of the index. */
+void
+cm_printindex ()
+{
+ int item;
+ INDEX_ELT *index;
+ INDEX_ELT **array;
+ char *index_name;
+ unsigned line_length;
+ char *line;
+ int saved_inhibit_paragraph_indentation = inhibit_paragraph_indentation;
+ int saved_filling_enabled = filling_enabled;
+
+ close_paragraph ();
+ get_rest_of_line (&index_name);
+
+ index = index_list (index_name);
+ if (index == (INDEX_ELT *)-1)
+ {
+ line_error ("Unknown index name `%s'", index_name);
+ free (index_name);
+ return;
+ }
+ else
+ free (index_name);
+
+ /* Do this before sorting, so execute_string in index_element_compare
+ will give the same results as when we actually print. */
+ printing_index = 1;
+ filling_enabled = 0;
+ inhibit_paragraph_indentation = 1;
+ array = sort_index (index);
+
+ close_paragraph ();
+ add_word ("* Menu:\n\n");
+
+#if defined (HAVE_MACROS)
+ me_inhibit_expansion++;
+#endif /* HAVE_MACROS */
+
+ /* This will probably be enough. */
+ line_length = 100;
+ line = xmalloc (line_length);
+
+ for (item = 0; (index = array[item]); item++)
+ {
+ /* A pathological document might have an index entry outside of any
+ node. Don't crash. Perhaps should warn. */
+ char *index_node = index->node ? index->node : "(none)";
+ unsigned new_length = strlen (index->entry) + strlen (index_node);
+
+ if (new_length > line_length)
+ {
+ line_length = new_length + 6; /* * : .\0 */
+ line = xrealloc (line, line_length);
+ }
+
+ /* Print the entry, nicely formatted. We've already expanded any
+ commands, including any implicit @code. Thus, can't call
+ execute_string, since @@ has turned into @. */
+ sprintf (line, "* %-37s %s.\n", index->entry, index_node);
+ line[2 + strlen (index->entry)] = ':';
+ insert_string (line);
+
+ /* Previous `output_paragraph' from growing to the size of the
+ whole index. */
+ flush_output ();
+ }
+
+ free (line);
+
+#if defined (HAVE_MACROS)
+ me_inhibit_expansion--;
+#endif /* HAVE_MACROS */
+
+ printing_index = 0;
+ free (array);
+ close_single_paragraph ();
+ filling_enabled = saved_filling_enabled;
+ inhibit_paragraph_indentation = saved_inhibit_paragraph_indentation;
+}
+
+/* User-defined commands. */
+
+void
+define_user_command (name, proc, needs_braces_p)
+ char *name;
+ COMMAND_FUNCTION *proc;
+ int needs_braces_p;
+{
+ int slot = user_command_array_len;
+ user_command_array_len++;
+
+ if (!user_command_array)
+ user_command_array = (COMMAND **) xmalloc (1 * sizeof (COMMAND *));
+
+ user_command_array = (COMMAND **) xrealloc (user_command_array,
+ (1 + user_command_array_len) *
+ sizeof (COMMAND *));
+
+ user_command_array[slot] = (COMMAND *) xmalloc (sizeof (COMMAND));
+ user_command_array[slot]->name = strdup (name);
+ user_command_array[slot]->proc = proc;
+ user_command_array[slot]->argument_in_braces = needs_braces_p;
+}
+
+/* Set the paragraph indentation variable to the value specified in STRING.
+ Values can be:
+ `asis': Don't change existing indentation.
+ `none': Remove existing indentation.
+ NUM: Indent NUM spaces at the starts of paragraphs.
+ Note that if NUM is zero, we assume `none'.
+
+ Returns 0 if successful, or non-zero if STRING isn't one of the above. */
+int
+set_paragraph_indent (string)
+ char *string;
+{
+ if (strcmp (string, "asis") == 0)
+ paragraph_start_indent = 0;
+ else if (strcmp (string, "none") == 0)
+ paragraph_start_indent = -1;
+ else
+ {
+ if (sscanf (string, "%d", &paragraph_start_indent) != 1)
+ return (-1);
+ else
+ {
+ if (paragraph_start_indent == 0)
+ paragraph_start_indent = -1;
+ }
+ }
+ return (0);
+}
+
+void
+cm_paragraphindent ()
+{
+ char *arg;
+
+ get_rest_of_line (&arg);
+ if (set_paragraph_indent (arg) != 0)
+ line_error ("Bad argument to %c%s", COMMAND_PREFIX, command);
+
+ free (arg);
+}
+
+/* Some support for footnotes. */
+
+/* Footnotes are a new construct in Info. We don't know the best method
+ of implementing them for sure, so we present two possiblities.
+
+ SeparateNode:
+ Make them look like followed references, with the reference
+ destinations in a makeinfo manufactured node or,
+
+ EndNode:
+ Make them appear at the bottom of the node that they originally
+ appeared in. */
+#define SeparateNode 0
+#define EndNode 1
+
+int footnote_style = EndNode;
+int first_footnote_this_node = 1;
+int footnote_count = 0;
+
+/* Set the footnote style based on he style identifier in STRING. */
+int
+set_footnote_style (string)
+ char *string;
+{
+ if ((strcasecmp (string, "separate") == 0) ||
+ (strcasecmp (string, "MN") == 0))
+ footnote_style = SeparateNode;
+ else if ((strcasecmp (string, "end") == 0) ||
+ (strcasecmp (string, "EN") == 0))
+ footnote_style = EndNode;
+ else
+ return (-1);
+
+ return (0);
+}
+
+void
+cm_footnotestyle ()
+{
+ char *arg;
+
+ get_rest_of_line (&arg);
+
+ /* If set on command line, do not change the footnote style. */
+ if (!footnote_style_preset && set_footnote_style (arg) != 0)
+ line_error ("Bad argument to %c%s", COMMAND_PREFIX, command);
+
+ free (arg);
+}
+
+typedef struct fn
+{
+ struct fn *next;
+ char *marker;
+ char *note;
+} FN;
+
+FN *pending_notes = (FN *) NULL;
+
+/* A method for remembering footnotes. Note that this list gets output
+ at the end of the current node. */
+void
+remember_note (marker, note)
+ char *marker, *note;
+{
+ FN *temp = (FN *) xmalloc (sizeof (FN));
+
+ temp->marker = strdup (marker);
+ temp->note = strdup (note);
+ temp->next = pending_notes;
+ pending_notes = temp;
+ footnote_count++;
+}
+
+/* How to get rid of existing footnotes. */
+void
+free_pending_notes ()
+{
+ FN *temp;
+
+ while ((temp = pending_notes) != (FN *) NULL)
+ {
+ free (temp->marker);
+ free (temp->note);
+ pending_notes = pending_notes->next;
+ free (temp);
+ }
+ first_footnote_this_node = 1;
+ footnote_count = 0;
+}
+
+/* What to do when you see a @footnote construct. */
+
+ /* Handle a "footnote".
+ footnote *{this is a footnote}
+ where "*" is the marker character for this note. */
+void
+cm_footnote ()
+{
+ char *marker;
+ char *note;
+
+ get_until ("{", &marker);
+ canon_white (marker);
+
+ /* Read the argument in braces. */
+ if (curchar () != '{')
+ {
+ line_error ("`%c%s' expected more than just `%s'. It needs something in `{...}'",
+ COMMAND_PREFIX, command, marker);
+ free (marker);
+ return;
+ }
+ else
+ {
+ int braces = 1;
+ int temp = ++input_text_offset;
+ int len;
+
+ while (braces)
+ {
+ if (temp == size_of_input_text)
+ {
+ line_error ("No closing brace for footnote `%s'", marker);
+ return;
+ }
+
+ if (input_text[temp] == '{')
+ braces++;
+ else if (input_text[temp] == '}')
+ braces--;
+ else if (input_text[temp] == '\n')
+ line_number ++;
+
+ temp++;
+ }
+
+ len = (temp - input_text_offset) - 1;
+ note = (char *)xmalloc (len + 1);
+ strncpy (note, &input_text[input_text_offset], len);
+ note[len] = '\0';
+ input_text_offset = temp;
+ }
+
+ if (!current_node || !*current_node)
+ {
+ line_error ("Footnote defined without parent node");
+ free (marker);
+ free (note);
+ return;
+ }
+
+ if (!*marker)
+ {
+ free (marker);
+
+ if (number_footnotes)
+ {
+ marker = (char *)xmalloc (10);
+ sprintf (marker, "%d", current_footnote_number);
+ current_footnote_number++;
+ }
+ else
+ marker = strdup ("*");
+ }
+
+ remember_note (marker, note);
+
+ /* Your method should at least insert MARKER. */
+ switch (footnote_style)
+ {
+ case SeparateNode:
+ add_word_args ("(%s)", marker);
+ if (first_footnote_this_node)
+ {
+ char *temp_string;
+
+ temp_string = (char *)
+ xmalloc ((strlen (current_node)) + (strlen ("-Footnotes")) + 1);
+
+ add_word_args (" (*note %s-Footnotes::)", current_node);
+ strcpy (temp_string, current_node);
+ strcat (temp_string, "-Footnotes");
+ remember_node_reference (temp_string, line_number, followed_reference);
+ free (temp_string);
+ first_footnote_this_node = 0;
+ }
+ break;
+
+ case EndNode:
+ add_word_args ("(%s)", marker);
+ break;
+
+ default:
+ break;
+ }
+ free (marker);
+ free (note);
+}
+
+/* Non-zero means that we are currently in the process of outputting
+ footnotes. */
+int already_outputting_pending_notes = 0;
+
+/* Output the footnotes. We are at the end of the current node. */
+void
+output_pending_notes ()
+{
+ FN *footnote = pending_notes;
+
+ if (!pending_notes)
+ return;
+
+ switch (footnote_style)
+ {
+ case SeparateNode:
+ {
+ char *old_current_node = current_node;
+ char *old_command = strdup (command);
+
+ already_outputting_pending_notes++;
+ execute_string ("%cnode %s-Footnotes,,,%s\n",
+ COMMAND_PREFIX, current_node, current_node);
+ already_outputting_pending_notes--;
+ current_node = old_current_node;
+ free (command);
+ command = old_command;
+ }
+ break;
+
+ case EndNode:
+ close_paragraph ();
+ in_fixed_width_font++;
+ execute_string ("---------- Footnotes ----------\n\n");
+ in_fixed_width_font--;
+ break;
+ }
+
+ /* Handle the footnotes in reverse order. */
+ {
+ FN **array = (FN **) xmalloc ((footnote_count + 1) * sizeof (FN *));
+
+ array[footnote_count] = (FN *) NULL;
+
+ while (--footnote_count > -1)
+ {
+ array[footnote_count] = footnote;
+ footnote = footnote->next;
+ }
+
+ filling_enabled = 1;
+ indented_fill = 1;
+
+ while (footnote = array[++footnote_count])
+ {
+
+ switch (footnote_style)
+ {
+ case SeparateNode:
+ case EndNode:
+ execute_string ("(%s) %s", footnote->marker, footnote->note);
+ close_paragraph ();
+ break;
+ }
+ }
+ close_paragraph ();
+ free (array);
+ }
+}
+
+/* **************************************************************** */
+/* */
+/* User definable Macros (text substitution) */
+/* */
+/* **************************************************************** */
+
+#if defined (HAVE_MACROS)
+
+/* Array of macros and definitions. */
+MACRO_DEF **macro_list = (MACRO_DEF **)NULL;
+
+int macro_list_len = 0; /* Number of elements. */
+int macro_list_size = 0; /* Number of slots in total. */
+
+/* Return the macro definition of NAME or NULL if NAME is not defined. */
+MACRO_DEF *
+find_macro (name)
+ char *name;
+{
+ register int i;
+ register MACRO_DEF *def;
+
+ def = (MACRO_DEF *)NULL;
+ for (i = 0; macro_list && (def = macro_list[i]); i++)
+ {
+ if ((!def->inhibited) && (strcmp (def->name, name) == 0))
+ break;
+ }
+ return (def);
+}
+
+/* Add the macro NAME with ARGLIST and BODY to the list of defined macros.
+ SOURCE_FILE is the name of the file where this definition can be found,
+ and SOURCE_LINENO is the line number within that file. If a macro already
+ exists with NAME, then a warning is produced, and that previous
+ definition is overwritten. */
+void
+add_macro (name, arglist, body, source_file, source_lineno, flags)
+ char *name;
+ char **arglist;
+ char *body;
+ char *source_file;
+ int source_lineno, flags;
+{
+ register MACRO_DEF *def;
+
+ def = find_macro (name);
+
+ if (!def)
+ {
+ if (macro_list_len + 2 >= macro_list_size)
+ macro_list = (MACRO_DEF **)xrealloc
+ (macro_list, ((macro_list_size += 10) * sizeof (MACRO_DEF *)));
+
+ macro_list[macro_list_len] = (MACRO_DEF *)xmalloc (sizeof (MACRO_DEF));
+ macro_list[macro_list_len + 1] = (MACRO_DEF *)NULL;
+
+ def = macro_list[macro_list_len];
+ macro_list_len += 1;
+ def->name = name;
+ }
+ else
+ {
+ char *temp_filename = input_filename;
+ int temp_line = line_number;
+
+ warning ("The macro `%s' is previously defined", name);
+
+ input_filename = def->source_file;
+ line_number = def->source_lineno;
+
+ warning ("Here is the previous definition of `%s'", name);
+
+ input_filename = temp_filename;
+ line_number = temp_line;
+
+ if (def->arglist)
+ {
+ register int i;
+
+ for (i = 0; def->arglist[i]; i++)
+ free (def->arglist[i]);
+
+ free (def->arglist);
+ }
+ free (def->source_file);
+ free (def->body);
+ }
+
+ def->source_file = strdup (source_file);
+ def->source_lineno = source_lineno;
+ def->body = body;
+ def->arglist = arglist;
+ def->inhibited = 0;
+ def->flags = flags;
+}
+
+/* Delete the macro with name NAME. The macro is deleted from the list,
+ but it is also returned. If there was no macro defined, NULL is
+ returned. */
+MACRO_DEF *
+delete_macro (name)
+ char *name;
+{
+ register int i;
+ register MACRO_DEF *def;
+
+ def = (MACRO_DEF *)NULL;
+
+ for (i = 0; macro_list && (def = macro_list[i]); i++)
+ if (strcmp (def->name, name) == 0)
+ {
+ memmove (macro_list + i, macro_list + i + 1,
+ ((macro_list_len + 1) - i) * sizeof (MACRO_DEF *));
+ break;
+ }
+ return (def);
+}
+
+/* Return the arglist on the current line. This can behave in two different
+ ways, depending on the variable BRACES_REQUIRED_FOR_MACRO_ARGS. */
+int braces_required_for_macro_args = 0;
+
+char **
+get_macro_args (def)
+ MACRO_DEF *def;
+{
+ register int i;
+ char *word;
+
+ /* Quickly check to see if this macro has been invoked with any arguments.
+ If not, then don't skip any of the following whitespace. */
+ for (i = input_text_offset; i < size_of_input_text; i++)
+ if (!cr_or_whitespace (input_text[i]))
+ break;
+
+ if (input_text[i] != '{')
+ {
+ if (braces_required_for_macro_args)
+ {
+ return ((char **)NULL);
+ }
+ else
+ {
+ /* Braces are not required to fill out the macro arguments. If
+ this macro takes one argument, it is considered to be the
+ remainder of the line, sans whitespace. */
+ if (def->arglist && def->arglist[0] && !def->arglist[1])
+ {
+ char **arglist;
+
+ get_rest_of_line (&word);
+ if (input_text[input_text_offset - 1] == '\n')
+ input_text_offset--;
+ /* canon_white (word); */
+ arglist = (char **)xmalloc (2 * sizeof (char *));
+ arglist[0] = word;
+ arglist[1] = (char *)NULL;
+ return (arglist);
+ }
+ else
+ {
+ /* The macro either took no arguments, or took more than
+ one argument. In that case, it must be invoked with
+ arguments surrounded by braces. */
+ return ((char **)NULL);
+ }
+ }
+ }
+ return (get_brace_args (def->flags & ME_QUOTE_ARG));
+}
+
+/* Substitute actual parameters for named parameters in body.
+ The named parameters which appear in BODY must by surrounded
+ reverse slashes, as in \foo\. */
+char *
+apply (named, actuals, body)
+ char **named, **actuals, *body;
+{
+ register int i;
+ int new_body_index, new_body_size;
+ char *new_body, *text;
+ int length_of_actuals;
+
+ length_of_actuals = array_len (actuals);
+ new_body_size = strlen (body);
+ new_body = (char *)xmalloc (1 + new_body_size);
+
+ /* Copy chars from BODY into NEW_BODY. */
+ i = 0; new_body_index = 0;
+
+ while (1)
+ {
+ if (!body[i])
+ break;
+
+ if (body[i] != '\\')
+ new_body[new_body_index++] = body[i++];
+ else
+ {
+ /* Snarf parameter name, check against named parameters. */
+ char *param;
+ int param_start, which, len;
+
+ param_start = ++i;
+ while ((body[i]) && (body[i] != '\\'))
+ i++;
+
+ len = i - param_start;
+ param = (char *)xmalloc (1 + len);
+ memcpy (param, body + param_start, len);
+ param[len] = '\0';
+
+ if (body[i])
+ i++;
+
+ /* Now check against named parameters. */
+ for (which = 0; named && named[which]; which++)
+ if (strcmp (named[which], param) == 0)
+ break;
+
+ if (named[which])
+ {
+ if (which < length_of_actuals)
+ text = actuals[which];
+ else
+ text = (char *)NULL;
+
+ if (!text)
+ text = "";
+
+ len = strlen (text);
+ }
+ else
+ {
+ len += 2;
+ text = (char *)xmalloc (1 + len);
+ sprintf (text, "\\%s\\", param);
+ }
+
+ if ((2 + strlen (param)) < len)
+ new_body = (char *)xrealloc
+ (new_body, new_body_size += (1 + len));
+
+ free (param);
+
+ strcpy (new_body + new_body_index, text);
+ new_body_index += len;
+
+ if (!named[which])
+ free (text);
+ }
+ }
+ new_body[new_body_index] = '\0';
+ return (new_body);
+}
+
+/* Execute the macro passed in DEF, a pointer to a MACRO_DEF. */
+void
+execute_macro (def)
+ MACRO_DEF *def;
+{
+ register int i;
+ char **arglist;
+ int num_args;
+ char *execution_string = (char *)NULL;
+
+ if (macro_expansion_output_stream && !me_inhibit_expansion)
+ me_append_before_this_command ();
+
+ /* Find out how many arguments this macro definition takes. */
+ num_args = array_len (def->arglist);
+
+ /* Gather the arguments present on the line if there are any. */
+ arglist = get_macro_args (def);
+
+ if (num_args < array_len (arglist))
+ {
+ free_array (arglist);
+ line_error ("Macro `%s' called with too many args", def->name);
+ return;
+ }
+
+ if (def->body)
+ execution_string = apply (def->arglist, arglist, def->body);
+
+ free_array (arglist);
+
+ if (def->body)
+ {
+ if (macro_expansion_output_stream && !me_inhibit_expansion)
+ {
+ remember_itext (input_text, input_text_offset);
+ me_execute_string (execution_string);
+ }
+ else
+ execute_string ("%s", execution_string);
+
+ free (execution_string);
+ }
+}
+
+/* Read and remember the definition of a macro. */
+void
+cm_macro ()
+{
+ register int i;
+ char *name, **arglist, *body, *line;
+ int body_size, body_index;
+ int depth = 1;
+ int defining_line = line_number;
+ int flags = 0;
+
+ arglist = (char **)NULL;
+ body = (char *)NULL;
+ body_size = 0;
+ body_index = 0;
+
+ if (macro_expansion_output_stream)
+ me_append_before_this_command ();
+
+ skip_whitespace ();
+
+ /* Get the name of the macro. This is the set of characters which are
+ not whitespace and are not `{' immediately following the @macro. */
+ {
+ int start = input_text_offset;
+ int len;
+
+ for (i = start;
+ (i < size_of_input_text) &&
+ (input_text[i] != '{') &&
+ (!cr_or_whitespace (input_text[i]));
+ i++);
+
+ len = i - start;
+ name = (char *)xmalloc (1 + len);
+ strncpy (name, input_text + start, len);
+ name[len] = '\0';
+ input_text_offset = i;
+ }
+
+ skip_whitespace ();
+
+ /* It is not required that the definition of a macro includes an arglist.
+ If not, don't try to get the named parameters, just use a null list. */
+ if (curchar () == '{')
+ {
+ int arglist_index = 0, arglist_size = 0;
+ int gathering_words = 1;
+ char *word = (char *)NULL;
+ int character;
+
+ /* Read the words inside of the braces which determine the arglist.
+ These words will be replaced within the body of the macro at
+ execution time. */
+
+ input_text_offset++;
+ skip_whitespace_and_newlines ();
+
+ while (gathering_words)
+ {
+ int len;
+
+ for (i = input_text_offset;
+ character = input_text[i];
+ i++)
+ {
+ switch (character)
+ {
+ case '\n':
+ line_number++;
+ case ' ':
+ case '\t':
+ case ',':
+ case '}':
+ /* Found the end of the current arglist word. Save it. */
+ len = i - input_text_offset;
+ word = (char *)xmalloc (1 + len);
+ strncpy (word, input_text + input_text_offset, len);
+ word[len] = '\0';
+ input_text_offset = i;
+
+ /* Advance to the comma or close-brace that signified
+ the end of the argument. */
+ while ((character = curchar ())
+ && character != ','
+ && character != '}')
+ {
+ input_text_offset++;
+ if (character == '\n')
+ line_number++;
+ }
+
+ /* Add the word to our list of words. */
+ if ((arglist_index + 2) >= arglist_size)
+ arglist = (char **)xrealloc
+ (arglist, (arglist_size += 10) * sizeof (char *));
+
+ arglist[arglist_index++] = word;
+ arglist[arglist_index] = (char *)NULL;
+ break;
+ }
+
+ if (character == '}')
+ {
+ input_text_offset++;
+ gathering_words = 0;
+ break;
+ }
+
+ if (character == ',')
+ {
+ input_text_offset++;
+ skip_whitespace_and_newlines ();
+ i = input_text_offset - 1;
+ }
+ }
+ }
+ }
+
+ /* Read the text carefully until we find an "@end macro" which
+ matches this one. The text in between is the body of the macro. */
+ skip_whitespace_and_newlines ();
+
+ while (depth)
+ {
+ if ((input_text_offset + 9) > size_of_input_text)
+ {
+ int temp_line = line_number;
+ line_number = defining_line;
+ line_error ("%cend macro not found", COMMAND_PREFIX);
+ line_number = temp_line;
+ return;
+ }
+
+ get_rest_of_line (&line);
+
+ /* Handle commands only meaningful within a macro. */
+ if ((*line == COMMAND_PREFIX) && (depth == 1) &&
+ (strncmp (line + 1, "allow-recursion", 15) == 0) &&
+ (line[16] == '\0' || whitespace (line[16])))
+ {
+ for (i = 16; whitespace (line[i]); i++);
+ strcpy (line, line + i);
+ flags |= ME_RECURSE;
+ if (!*line)
+ {
+ free (line);
+ continue;
+ }
+ }
+
+ if ((*line == COMMAND_PREFIX) && (depth == 1) &&
+ (strncmp (line + 1, "quote-arg", 9) == 0) &&
+ (line[10] == '\0' || whitespace (line[10])))
+ {
+ for (i = 10; whitespace (line[i]); i++);
+ strcpy (line, line + i);
+
+ if (arglist && arglist[0] && !arglist[1])
+ {
+ flags |= ME_QUOTE_ARG;
+ if (!*line)
+ {
+ free (line);
+ continue;
+ }
+ }
+ else
+ {
+ line_error ("%cquote-arg only useful when the macro takes a single argument",
+ COMMAND_PREFIX);
+ }
+ }
+
+ if ((*line == COMMAND_PREFIX) &&
+ (strncmp (line + 1, "macro ", 6) == 0))
+ depth++;
+
+ if ((*line == COMMAND_PREFIX) &&
+ (strncmp (line + 1, "end macro", 9) == 0))
+ depth--;
+
+ if (depth)
+ {
+ if ((body_index + strlen (line) + 3) >= body_size)
+ body = (char *)xrealloc
+ (body, body_size += 3 + strlen (line));
+ strcpy (body + body_index, line);
+ body_index += strlen (line);
+ body[body_index++] = '\n';
+ body[body_index] = '\0';
+ }
+ free (line);
+ }
+
+ /* We now have the name, the arglist, and the body. However, BODY
+ includes the final newline which preceded the `@end macro' text.
+ Delete it. */
+ if (body && strlen (body))
+ body[strlen (body) - 1] = '\0';
+
+ add_macro (name, arglist, body, input_filename, defining_line, flags);
+
+ if (macro_expansion_output_stream)
+ remember_itext (input_text, input_text_offset);
+}
+
+void
+cm_unmacro ()
+{
+ register int i;
+ char *line, *name;
+ MACRO_DEF *def;
+
+ if (macro_expansion_output_stream)
+ me_append_before_this_command ();
+
+ get_rest_of_line (&line);
+ canon_white (line);
+
+ for (i = 0; line[i] && !whitespace (line[i]); i++);
+ name = (char *)xmalloc (i);
+ strncpy (name, line, i);
+ name[i] = '\0';
+
+ def = delete_macro (name);
+
+ if (def)
+ {
+ free (def->source_file);
+ free (def->name);
+ free (def->body);
+
+ if (def->arglist)
+ {
+ register int i;
+
+ for (i = 0; def->arglist[i]; i++)
+ free (def->arglist[i]);
+
+ free (def->arglist);
+ }
+
+ free (def);
+ }
+
+ free (line);
+ free (name);
+
+ if (macro_expansion_output_stream)
+ remember_itext (input_text, input_text_offset);
+}
+
+/* How to output sections of the input file verbatim. */
+
+/* Set the value of POINTER's offset to OFFSET. */
+ITEXT *
+remember_itext (pointer, offset)
+ char *pointer;
+ int offset;
+{
+ register int i;
+ ITEXT *itext = (ITEXT *)NULL;
+
+ /* If we have no info, initialize a blank list. */
+ if (!itext_info)
+ {
+ itext_info = (ITEXT **)xmalloc ((itext_size = 10) * sizeof (ITEXT *));
+ for (i = 0; i < itext_size; i++)
+ itext_info[i] = (ITEXT *)NULL;
+ }
+
+ /* If the pointer is already present in the list, then set the offset. */
+ for (i = 0; i < itext_size; i++)
+ if ((itext_info[i] != (ITEXT *)NULL) &&
+ (itext_info[i]->pointer == pointer))
+ {
+ itext = itext_info[i];
+ itext_info[i]->offset = offset;
+ break;
+ }
+
+ if (i == itext_size)
+ {
+ /* Find a blank slot, (or create a new one), and remember the
+ pointer and offset. */
+ for (i = 0; i < itext_size; i++)
+ if (itext_info[i] == (ITEXT *)NULL)
+ break;
+
+ /* If not found, then add some slots. */
+ if (i == itext_size)
+ {
+ register int j;
+
+ itext_info = (ITEXT **)xrealloc
+ (itext_info, (itext_size += 10) * sizeof (ITEXT *));
+
+ for (j = i; j < itext_size; j++)
+ itext_info[j] = (ITEXT *)NULL;
+ }
+
+ /* Now add the pointer and the offset. */
+ itext_info[i] = (ITEXT *)xmalloc (sizeof (ITEXT));
+ itext_info[i]->pointer = pointer;
+ itext_info[i]->offset = offset;
+ itext = itext_info[i];
+ }
+ return (itext);
+}
+
+/* Forget the input text associated with POINTER. */
+void
+forget_itext (pointer)
+ char *pointer;
+{
+ register int i;
+
+ for (i = 0; i < itext_size; i++)
+ if (itext_info[i] && (itext_info[i]->pointer == pointer))
+ {
+ free (itext_info[i]);
+ itext_info[i] = (ITEXT *)NULL;
+ break;
+ }
+}
+
+/* Append the text which appeared in input_text from the last offset to
+ the character just before the command that we are currently executing. */
+void
+me_append_before_this_command ()
+{
+ register int i;
+
+ for (i = input_text_offset; i && (input_text[i] != COMMAND_PREFIX); i--);
+ maybe_write_itext (input_text, i);
+}
+
+/* Similar to execute_string (), but only takes a single string argument,
+ and remembers the input text location, etc. */
+void
+me_execute_string (execution_string)
+ char *execution_string;
+{
+ pushfile ();
+ input_text_offset = 0;
+ input_text = execution_string;
+ input_filename = strdup (input_filename);
+ size_of_input_text = strlen (execution_string);
+
+ remember_itext (execution_string, 0);
+
+ executing_string++;
+ reader_loop ();
+ popfile ();
+ executing_string--;
+}
+
+/* Append the text which appears in input_text from the last offset to
+ the current OFFSET. */
+void
+append_to_expansion_output (offset)
+ int offset;
+{
+ register int i;
+ ITEXT *itext = (ITEXT *)NULL;
+
+ for (i = 0; i < itext_size; i++)
+ if (itext_info[i] && itext_info[i]->pointer == input_text)
+ {
+ itext = itext_info[i];
+ break;
+ }
+
+ if (!itext)
+ itext = remember_itext (input_text, 0);
+
+ if (offset > itext->offset)
+ {
+ write_region_to_macro_output
+ (input_text, itext->offset, offset);
+ remember_itext (input_text, offset);
+ }
+}
+
+/* Only write this input text iff it appears in our itext list. */
+void
+maybe_write_itext (pointer, offset)
+ char *pointer;
+ int offset;
+{
+ register int i;
+ ITEXT *itext = (ITEXT *)NULL;
+
+ for (i = 0; i < itext_size; i++)
+ if (itext_info[i] && (itext_info[i]->pointer == pointer))
+ {
+ itext = itext_info[i];
+ break;
+ }
+
+ if (itext && (itext->offset < offset))
+ {
+ write_region_to_macro_output (itext->pointer, itext->offset, offset);
+ remember_itext (pointer, offset);
+ }
+}
+
+void
+write_region_to_macro_output (string, start, end)
+ char *string;
+ int start, end;
+{
+ if (macro_expansion_output_stream)
+ fwrite (string + start, 1, end - start, macro_expansion_output_stream);
+}
+
+#endif /* HAVE_MACROS */
+
+/* Return the length of the array in ARRAY. */
+int
+array_len (array)
+ char **array;
+{
+ register int i = 0;
+
+ if (array)
+ for (i = 0; array[i] != (char *)NULL; i++);
+
+ return (i);
+}
+
+void
+free_array (array)
+ char **array;
+{
+ if (array)
+ {
+ register int i;
+
+ for (i = 0; array[i] != (char *)NULL; i++)
+ free (array[i]);
+
+ free (array);
+ }
+}
+
+/* Function is used even when we don't have macros. Although, I have
+ to admit, it is unlikely that you would have a use for it if you
+ aren't using macros. */
+char **
+get_brace_args (quote_single)
+ int quote_single;
+{
+ char **arglist, *word;
+ int arglist_index, arglist_size;
+ int character, escape_seen, start;
+ int depth = 1;
+
+ /* There is an arglist in braces here, so gather the args inside of it. */
+ skip_whitespace_and_newlines ();
+ input_text_offset++;
+ arglist = (char **)NULL;
+ arglist_index = arglist_size = 0;
+
+ get_arg:
+ skip_whitespace_and_newlines ();
+ start = input_text_offset;
+ escape_seen = 0;
+
+ while (character = curchar ())
+ {
+ if (character == '\\')
+ {
+ input_text_offset += 2;
+ escape_seen = 1;
+ }
+ else if (character == '{')
+ {
+ depth++;
+ input_text_offset++;
+ }
+ else if ((character == ',' && !quote_single) ||
+ ((character == '}') && depth == 1))
+ {
+ int len = input_text_offset - start;
+
+ if (len || (character != '}'))
+ {
+ word = (char *)xmalloc (1 + len);
+ strncpy (word, input_text + start, len);
+ word[len] = '\0';
+
+ /* Clean up escaped characters. */
+ if (escape_seen)
+ {
+ register int i;
+
+ for (i = 0; word[i]; i++)
+ if (word[i] == '\\')
+ memmove (word + i, word + i + 1,
+ 1 + strlen (word + i + 1));
+ }
+
+ if (arglist_index + 2 >= arglist_size)
+ arglist = (char **)xrealloc
+ (arglist, (arglist_size += 10) * sizeof (char *));
+
+ arglist[arglist_index++] = word;
+ arglist[arglist_index] = (char *)NULL;
+ }
+
+ input_text_offset++;
+ if (character == '}')
+ break;
+ else
+ goto get_arg;
+ }
+ else if (character == '}')
+ {
+ depth--;
+ input_text_offset++;
+ }
+ else
+ {
+ input_text_offset++;
+ if (character == '\n') line_number++;
+ }
+ }
+ return (arglist);
+}
+
+/* **************************************************************** */
+/* */
+/* Looking For Include Files */
+/* */
+/* **************************************************************** */
+
+/* Given a string containing units of information separated by colons,
+ return the next one pointed to by INDEX, or NULL if there are no more.
+ Advance INDEX to the character after the colon. */
+char *
+extract_colon_unit (string, index)
+ char *string;
+ int *index;
+{
+ int i, start;
+
+ i = *index;
+
+ if (!string || (i >= strlen (string)))
+ return ((char *)NULL);
+
+ /* Each call to this routine leaves the index pointing at a colon if
+ there is more to the path. If I is > 0, then increment past the
+ `:'. If I is 0, then the path has a leading colon. Trailing colons
+ are handled OK by the `else' part of the if statement; an empty
+ string is returned in that case. */
+ if (i && string[i] == ':')
+ i++;
+
+ start = i;
+
+ while (string[i] && string[i] != ':') i++;
+
+ *index = i;
+
+ if (i == start)
+ {
+ if (string[i])
+ (*index)++;
+
+ /* Return "" in the case of a trailing `:'. */
+ return (strdup (""));
+ }
+ else
+ {
+ char *value;
+
+ value = (char *)xmalloc (1 + (i - start));
+ strncpy (value, &string[start], (i - start));
+ value [i - start] = '\0';
+
+ return (value);
+ }
+}
+
+/* Return the full pathname for FILENAME by searching along PATH.
+ When found, return the stat () info for FILENAME in FINFO.
+ If PATH is NULL, only the current directory is searched.
+ If the file could not be found, return a NULL pointer. */
+char *
+get_file_info_in_path (filename, path, finfo)
+ char *filename, *path;
+ struct stat *finfo;
+{
+ char *dir;
+ int result, index = 0;
+
+ if (path == (char *)NULL)
+ path = ".";
+
+ /* Handle absolute pathnames. "./foo", "/foo", "../foo". */
+ if (*filename == '/' ||
+ (*filename == '.' &&
+ (filename[1] == '/' ||
+ (filename[1] == '.' && filename[2] == '/'))))
+ {
+ if (stat (filename, finfo) == 0)
+ return (strdup (filename));
+ else
+ return ((char *)NULL);
+ }
+
+ while (dir = extract_colon_unit (path, &index))
+ {
+ char *fullpath;
+
+ if (!*dir)
+ {
+ free (dir);
+ dir = strdup (".");
+ }
+
+ fullpath = (char *)xmalloc (2 + strlen (dir) + strlen (filename));
+ sprintf (fullpath, "%s/%s", dir, filename);
+ free (dir);
+
+ result = stat (fullpath, finfo);
+
+ if (result == 0)
+ return (fullpath);
+ else
+ free (fullpath);
+ }
+ return ((char *)NULL);
+}
diff --git a/texinfo/makeinfo/makeinfo.h b/texinfo/makeinfo/makeinfo.h
new file mode 100644
index 00000000000..399764eb88b
--- /dev/null
+++ b/texinfo/makeinfo/makeinfo.h
@@ -0,0 +1,193 @@
+/* makeinfo.h -- Declarations for Makeinfo.
+ $Id: makeinfo.h,v 1.1 1997/08/21 22:58:08 jason Exp $
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ Written by Brian Fox (bfox@ai.mit.edu). */
+
+/* Why, oh why, did I ever listen to rms when he said:
+ "Don't make lots of small files, just make one big one!" I've
+ regretted it ever since with this program, and with readline.
+ bfox@ai.mit.edu Thu Jul 11 07:54:32 1996 */
+
+#if !defined (MAKEINFO_H)
+#define MAKEINFO_H
+
+#if defined (COMPILING_MAKEINFO)
+# define DECLARE(type, var, init) type var = init
+#else
+# define DECLARE(type, var, init) extern type var
+#endif
+
+enum insertion_type
+{
+ menu, detailmenu, quotation, lisp, smalllisp, example, smallexample,
+ display, itemize, format, enumerate, cartouche, multitable, table,
+ ftable, vtable, group, ifinfo, flushleft, flushright, ifset,
+ ifclear, deffn, defun, defmac, defspec, defvr, defvar, defopt,
+ deftypefn, deftypefun, deftypevr, deftypevar, defcv, defivar, defop,
+ defmethod, deftypemethod, deftp, direntry, bad_type
+};
+
+DECLARE (int, insertion_level, 0);
+
+#if defined (COMPILING_MAKEINFO)
+char *insertion_type_names[] =
+{
+ "menu", "detailmenu", "quotation", "lisp", "smalllisp", "example",
+ "smallexample", "display", "itemize", "format", "enumerate",
+ "cartouche", "multitable", "table", "ftable", "vtable", "group",
+ "ifinfo", "flushleft", "flushright", "ifset", "ifclear", "deffn",
+ "defun", "defmac", "defspec", "defvr", "defvar", "defopt",
+ "deftypefn", "deftypefun", "deftypevr", "deftypevar", "defcv",
+ "defivar", "defop", "defmethod", "deftypemethod", "deftp", "direntry",
+ "bad_type"
+};
+#endif
+
+typedef struct istack_elt
+{
+ struct istack_elt *next;
+ char *item_function;
+ char *filename;
+ int line_number;
+ int filling_enabled;
+ int indented_fill;
+ enum insertion_type insertion;
+ int inhibited;
+ int in_fixed_width_font;
+} INSERTION_ELT;
+
+DECLARE (INSERTION_ELT *, insertion_stack, (INSERTION_ELT *)NULL);
+
+/* Current output stream. */
+DECLARE (FILE *, output_stream, (FILE *)NULL);
+
+/* Output paragraph buffer. */
+DECLARE (unsigned char *, output_paragraph, (unsigned char *)NULL);
+
+/* Offset into OUTPUT_PARAGRAPH. */
+DECLARE (int, output_paragraph_offset, 0);
+
+/* The output paragraph "cursor" horizontal position. */
+DECLARE (int, output_column, 0);
+
+/* Non-zero means output_paragraph contains text. */
+DECLARE (int, paragraph_is_open, 0);
+
+/* The amount of indentation to apply at the start of each line. */
+DECLARE (int, current_indent, 0);
+
+/* nonzero if we are currently processing a multitable command */
+DECLARE (int, multitable_active, 0);
+
+/* The column at which long lines are broken. */
+DECLARE (int, fill_column, 72);
+
+/* The current input file state. */
+DECLARE (char *, input_filename, (char *)NULL);
+DECLARE (char *, input_text, (char *)NULL);
+DECLARE (int, size_of_input_text, 0);
+DECLARE (int, input_text_offset, 0);
+DECLARE (int, line_number, 0);
+
+#define curchar() input_text[input_text_offset]
+/* **************************************************************** */
+/* */
+/* Global Defines */
+/* */
+/* **************************************************************** */
+
+/* Error levels */
+#define NO_ERROR 0
+#define SYNTAX 2
+#define FATAL 4
+
+/* C's standard macros don't check to make sure that the characters being
+ changed are within range. So I have to check explicitly. */
+
+/* GNU Library doesn't have toupper(). Until GNU gets this fixed, I will
+ have to do it. */
+#ifndef toupper
+#define toupper(c) ((c) - 32)
+#endif
+
+#define coerce_to_upper(c) ((islower(c) ? toupper(c) : (c)))
+#define coerce_to_lower(c) ((isupper(c) ? tolower(c) : (c)))
+
+#define control_character_bit 0x40 /* %01000000, must be off. */
+#define meta_character_bit 0x080/* %10000000, must be on. */
+#define CTL(c) ((c) & (~control_character_bit))
+#define UNCTL(c) coerce_to_upper(((c)|control_character_bit))
+#define META(c) ((c) | (meta_character_bit))
+#define UNMETA(c) ((c) & (~meta_character_bit))
+
+#define whitespace(c) (((c) == '\t') || ((c) == ' '))
+#define sentence_ender(c) ((c) == '.' || (c) == '?' || (c) == '!')
+#define cr_or_whitespace(c) (((c) == '\t') || ((c) == ' ') || ((c) == '\n'))
+
+#ifndef isletter
+#define isletter(c) (((c) >= 'A' && (c) <= 'Z') || ((c) >= 'a' && (c) <= 'z'))
+#endif
+
+#ifndef isupper
+#define isupper(c) ((c) >= 'A' && (c) <= 'Z')
+#endif
+
+#ifndef isdigit
+#define isdigit(c) ((c) >= '0' && (c) <= '9')
+#endif
+
+#ifndef digit_value
+#define digit_value(c) ((c) - '0')
+#endif
+
+#define member(c, s) (strchr (s, c) != NULL)
+
+#define COMMAND_PREFIX '@'
+
+/* Stuff for splitting large files. */
+#define SPLIT_SIZE_THRESHOLD 70000 /* What's good enough for Stallman... */
+#define DEFAULT_SPLIT_SIZE 50000 /* Is probably good enough for me. */
+
+DECLARE (int, splitting, 1); /* Defaults to true for now. */
+
+typedef void COMMAND_FUNCTION (); /* So I can say COMMAND_FUNCTION *foo; */
+
+#define command_char(c) ((!whitespace(c)) && \
+ ((c) != '\n') && \
+ ((c) != '{') && \
+ ((c) != '}') && \
+ ((c) != '='))
+
+#define skip_whitespace() \
+ while ((input_text_offset != size_of_input_text) && \
+ whitespace (curchar())) \
+ input_text_offset++
+
+#define skip_whitespace_and_newlines() \
+ do { \
+ while ((input_text_offset != size_of_input_text) && \
+ (whitespace (curchar ()) || (curchar () == '\n'))) \
+ { \
+ if (curchar () == '\n') \
+ line_number++; \
+ input_text_offset++; \
+ } \
+ } while (0)
+
+#endif /* !MAKEINFO_H */
diff --git a/texinfo/makeinfo/makeinfo.texi b/texinfo/makeinfo/makeinfo.texi
new file mode 100644
index 00000000000..04c136875ab
--- /dev/null
+++ b/texinfo/makeinfo/makeinfo.texi
@@ -0,0 +1,311 @@
+\input texinfo @c -*-texinfo-*-
+@comment %**start of header
+@setfilename makeinfo.info
+@set VERSION 1.61
+@paragraphindent none
+@comment %**start of header
+@comment $Id: makeinfo.texi,v 1.1 1997/08/21 22:58:08 jason Exp $
+
+@ifinfo
+@format
+START-INFO-DIR-ENTRY
+* makeinfo: (makeinfo). Making info files from texinfo files.
+END-INFO-DIR-ENTRY
+@end format
+@end ifinfo
+
+@dircategory Texinfo documentation system
+@direntry
+* makeinfo: (makeinfo). Convert Texinfo source to Info or plain ASCII.
+@end direntry
+
+@ifinfo
+This file is an extract from the @cite{Texinfo} manual.@*
+It documents Makeinfo, a program that converts Texinfo
+files into Info files.
+
+Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@end ifinfo
+
+@titlepage
+@title GNU Makeinfo
+@author Brian J. Fox and Robert J. Chassell
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@end titlepage
+
+@node Top
+@chapter What is @code{makeinfo}?
+
+@iftex
+This file documents the use of the @code{makeinfo} program, versions
+@value{VERSION} and later. It is an extract from the @cite{Texinfo} manual.
+@end iftex
+
+@code{makeinfo} is a program for converting @dfn{Texinfo} files into @dfn{Info}
+files. Texinfo is a documentation system that uses a single source file to
+produce both on-line information and printed output.
+
+You can read the on-line information using Info; type @code{info} to
+learn about Info.
+@ifinfo
+@xref{Top, Texinfo, Overview of Texinfo, Texinfo, Texinfo},
+@end ifinfo
+@iftex
+See the @cite{Texinfo} manual,
+@end iftex
+to learn about the Texinfo documentation system.
+
+@menu
+* Formatting Control:: Controlling the width of lines, paragraph
+ indentation, and other similar formatting.
+
+* Options:: Command line options which control the
+ behaviour of Makeinfo.
+
+* Pointer Validation:: How Makeinfo can help you to track node
+ references through complex Texinfo files.
+
+* Index:: Index of Concepts.
+@end menu
+
+@c Removed this for 3.8 until it's time to rewrite it.
+@c * The Macro Facility:: Makeinfo allows the use of @dfn{macros}.
+
+@node Formatting Control
+@section Controlling Paragraph Formats
+
+Without any special options, @code{makeinfo} @dfn{fills} the paragraphs that
+it outputs to an Info file. Filling is the process of breaking and connecting
+lines so that lines are the same length as or shorter than the number
+specified as the fill column. Lines are broken between words. With
+@code{makeinfo}, you can control:
+
+@itemize @bullet
+@item
+The width of each paragraph (the @dfn{fill-column}).
+@item
+The amount of indentation that the first line of
+each paragraph receives (the @dfn{paragraph-indentation}).
+@end itemize
+
+@node Options
+@section Command Line Options
+
+The following command line options are available for @code{makeinfo}.
+
+@need 100
+@table @code
+@item -D @var{var}
+Cause @var{var} to be defined. This is equivalent to
+@code{@@set @var{var}} in the Texinfo file.
+
+@need 150
+@item --error-limit @var{limit}
+Set the maximum number of errors that @code{makeinfo} will report
+before exiting (on the assumption that continuing would be useless).
+The default number of errors that can be reported before
+@code{makeinfo} gives up is 100.@refill
+
+@need 150
+@item --fill-column @var{width}
+Specify the maximum number of columns in a line; this is the right-hand
+edge of a line. Paragraphs that are filled will be filled to this
+width. The default value for @code{fill-column} is 72.
+@refill
+
+@item --footnote-style @var{style}
+Set the footnote style to @var{style}, either @samp{end} for the end
+node style or @samp{separate} for the separate node style. The value
+set by this option overrides the value set in a Texinfo file by an
+@code{@@footnotestyle} command. When the footnote style is
+@samp{separate}, @code{makeinfo} makes a new node containing the
+footnotes found in the current node. When the footnote style is
+@samp{end}, @code{makeinfo} places the footnote references at the end
+of the current node.@refill
+
+@need 150
+@item -I @var{dir}
+Add @code{dir} to the directory search list for finding files that are
+included using the @code{@@include} command. By default,
+@code{makeinfo} searches only the current directory.
+
+@need 150
+@item --no-headers
+Do not include menus or node lines in the output. This results in an
+@sc{ascii} file that you cannot read in Info since it does not contain
+the requisite nodes or menus; but you can print such a file in a
+single, typewriter-like font and produce acceptable output.
+
+@need 150
+@item --no-split
+Suppress the splitting stage of @code{makeinfo}. Normally, large
+output files (where the size is greater than 70k bytes) are split into
+smaller subfiles, each one approximately 50k bytes. If you specify
+@samp{--no-split}, @code{makeinfo} will not split up the output
+file.@refill
+
+@need 100
+@item --no-pointer-validate
+@item --no-validate
+Suppress the pointer-validation phase of @code{makeinfo}. Normally,
+after a Texinfo file is processed, some consistency checks are made to
+ensure that cross references can be resolved, etc.
+@xref{Pointer Validation}.@refill
+
+@need 150
+@item --no-warn
+Suppress the output of warning messages. This does @emph{not}
+suppress the output of error messages, only warnings. You might
+want this if the file you are creating has examples of Texinfo cross
+references within it, and the nodes that are referenced do not actually
+exist.@refill
+
+@item --no-number-footnotes
+Supress automatic footnote numbering. By default, @code{makeinfo}
+numbers each footnote sequentially in a single node, resetting the
+current footnote number to 1 at the start of each node.
+
+@need 150
+@item --output @var{file}
+@itemx -o @var{file}
+Specify that the output should be directed to @var{file} and not to the
+file name specified in the @code{@@setfilename} command found in the Texinfo
+source. @var{file} can be the special token @samp{-}, which specifies
+standard output.
+
+@need 150
+@item --paragraph-indent @var{indent}
+Set the paragraph indentation style to @var{indent}. The value set by
+this option overrides the value set in a Texinfo file by an
+@code{@@paragraphindent} command. The value of @var{indent} is
+interpreted as follows:@refill
+
+@itemize @bullet
+@item
+If the value of @var{indent} is @samp{asis}, do not change the
+existing indentation at the starts of paragraphs.@refill
+
+@item
+If the value of @var{indent} is zero, delete any existing
+indentation.@refill
+
+@item
+If the value of @var{indent} is greater than zero, indent each
+paragraph by that number of spaces.@refill
+@end itemize
+
+@need 100
+@item --reference-limit @var{limit}
+Set the value of the number of references to a node that
+@code{makeinfo} will make without reporting a warning. If a node has more
+than this number of references in it, @code{makeinfo} will make the
+references but also report a warning.@refill
+
+@need 150
+@item -U @var{var}
+Cause @var{var} to be undefined. This is equivalent to
+@code{@@clear @var{var}} in the Texinfo file.
+
+@need 100
+@item --verbose
+Cause @code{makeinfo} to display messages saying what it is doing.
+Normally, @code{makeinfo} only outputs messages if there are errors or
+warnings.@refill
+
+@need 100
+@item --version
+Report the version number of this copy of @code{makeinfo}.@refill
+
+@item --help
+Show a summary of the commend line arguments to @code{makeinfo}.
+@end table
+
+@node Pointer Validation
+@section Pointer Validation
+@cindex Pointer validation with @code{makeinfo}
+@cindex Validation of pointers
+
+If you do not suppress pointer-validation (by using the
+@samp{--no-pointer-validation} option), @code{makeinfo}
+will check the validity of the final Info file. Mostly,
+this means ensuring that nodes you have referenced
+really exist. Here is a complete list of what is
+checked:@refill
+
+@enumerate
+@item
+If a `Next', `Previous', or `Up' node reference is a reference to a
+node in the current file and is not an external reference such as to
+@file{(dir)}, then the referenced node must exist.@refill
+
+@item
+In every node, if the `Previous' node is different from the `Up' node,
+then the `Previous' node must also be pointed to by a `Next' node.@refill
+
+@item
+Every node except the `Top' node must have an `Up' pointer.@refill
+
+@item
+The node referenced by an `Up' pointer must contain a reference to the
+current node in some manner other than through a `Next' reference.
+This includes menu entries and cross references.@refill
+
+@item
+If the `Next' reference of a node is not the same as the `Next' reference
+of the `Up' reference, then the node referenced by the `Next' pointer
+must have a `Previous' pointer that points back to the current node.
+This rule allows the last node in a section to point to the first node
+of the next chapter.@refill
+@end enumerate
+
+@c We don't want to advertise redefining commands.
+@c lowersections
+@c include macro.texi
+@c raisesections
+
+@lowersections
+@node Index
+@appendix Index
+@printindex cp
+@raisesections
+
+@contents
+@bye
diff --git a/texinfo/makeinfo/multi.c b/texinfo/makeinfo/multi.c
new file mode 100644
index 00000000000..5d4bb70b28e
--- /dev/null
+++ b/texinfo/makeinfo/multi.c
@@ -0,0 +1,418 @@
+/* multi.c -- Multitable stuff for makeinfo.
+ $Id: multi.c,v 1.1 1997/08/21 22:58:08 jason Exp $
+
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#include <stdio.h>
+#include "makeinfo.h"
+
+#define MAXCOLS 100 /* remove this limit later @@ */
+
+
+/*
+ * Output environments. This is a hack grafted onto existing
+ * structure. The "output environment" used to consist of the
+ * global variables `output_paragraph', `fill_column', etc.
+ * Routines like add_char would manipulate these variables.
+ *
+ * Now, when formatting a multitable, we maintain separate environments
+ * for each column. That way we can build up the columns separately
+ * and write them all out at once. The "current" output environment"
+ * is still kept in those global variables, so that the old output
+ * routines don't have to change. But we provide routines to save
+ * and restore these variables in an "environment table". The
+ * `select_output_environment' function switches from one output
+ * environment to another.
+ *
+ * Environment #0 (i.e. element #0 of the table) is the regular
+ * environment that is used when we're not formatting a multitable.
+ *
+ * Environment #N (where N = 1,2,3,...) is the env. for column #N of
+ * the table, when a multitable is active.
+ */
+
+/* contents of an output environment */
+/* some more vars may end up being needed here later @@ */
+struct env
+{
+ unsigned char *output_paragraph;
+ int output_paragraph_offset;
+ int output_column;
+ int paragraph_is_open;
+ int current_indent;
+ int fill_column;
+} envs[MAXCOLS]; /* the environment table */
+
+/* index in environment table of currently selected environment */
+static int current_env_no;
+
+/* column number of last column in current multitable */
+static int last_column;
+
+/* flags indicating whether horizontal and vertical separators need
+ to be drawn, separating rows and columns in the current multitable. */
+static int hsep, vsep;
+
+void
+do_multitable ()
+{
+ int ncolumns;
+
+ /*
+ * multitable strategy:
+ * for each item {
+ * for each column in an item {
+ * initialize a new paragraph
+ * do ordinary formatting into the new paragraph
+ * save the paragraph away
+ * repeat if there are more paragraphs in the column
+ * }
+ * dump out the saved paragraphs and free the storage
+ * }
+ */
+
+ if (multitable_active)
+ {
+ line_error ("Multitables cannot be nested");
+ return;
+ }
+
+ /* scan the current item function to get the field widths
+ and number of columns, and set up the output environment list
+ accordingly. */
+ ncolumns = setup_multitable_parameters ();
+ if (hsep)
+ draw_horizontal_separator ();
+
+ /* The next @item command will direct stdout into the first column
+ and start processing. @tab will then switch to the next column,
+ and @item will flush out the saved output and return to the first
+ column. Environment #1 is the first column. (Environment #0 is
+ the normal output) */
+
+ ++multitable_active;
+}
+
+/* Read the parameters for a multitable from the current command
+ line, save the parameters away, and return the
+ number of columns. */
+int
+setup_multitable_parameters ()
+{
+ char *params = insertion_stack->item_function;
+ int nchars;
+ float columnfrac;
+ char command[200];
+ int i = 1;
+
+ /* We implement @hsep and @vsep even though TeX doesn't.
+ We don't get mixing of @columnfractions and templates right,
+ but TeX doesn't either. */
+ hsep = vsep = 0;
+
+ while (*params) {
+ while (whitespace (*params))
+ params++;
+
+ if (*params == '@') {
+ sscanf (params, "%s%n", command, &nchars);
+ params += nchars;
+ if (strcmp (command, "@hsep") == 0)
+ hsep++;
+ else if (strcmp (command, "@vsep") == 0)
+ vsep++;
+ else if (strcmp (command, "@columnfractions") == 0) {
+ /* Clobber old environments and create new ones,
+ starting at #1. Environment #0 is the normal standard output,
+ so we don't mess with it. */
+ for ( ; i <= MAXCOLS; i++) {
+ if (sscanf (params, "%f%n", &columnfrac, &nchars) < 1)
+ goto done;
+ params += nchars;
+ setup_output_environment (i, (int) (columnfrac * fill_column + .5));
+ }
+ }
+
+ } else if (*params == '{') {
+ char *start = params;
+ while ((*params != '}' || params[-1] == '@') && *params) {
+ params++;
+ }
+ /* This gives us two spaces between columns. Seems reasonable.
+ Really should expand the text, though, so a template of
+ `@code{foo}' has a width of three, not ten. Also have to match
+ braces, then. */
+ setup_output_environment (i++, params++ - start);
+
+ } else {
+ warning ("ignoring stray text `%s' after @multitable", params);
+ break;
+ }
+ }
+
+done:
+
+ flush_output ();
+ inhibit_output_flushing ();
+
+ last_column = i - 1;
+ return last_column;
+}
+
+/* Initialize environment number ENV_NO, of width WIDTH.
+ The idea is that we're going to use one environment for each column of
+ a multitable, so we can build them up separately and print them
+ all out at the end. */
+int
+setup_output_environment (env_no, width)
+ int env_no;
+ int width;
+{
+ int old_env = select_output_environment (env_no);
+
+ /* clobber old environment and set width of new one */
+ init_paragraph ();
+
+ /* make our change */
+ fill_column = width;
+
+ /* Save new environment and restore previous one. */
+ select_output_environment (old_env);
+
+ return env_no;
+}
+
+/* Direct current output to environment number N. Used when
+ switching work from one column of a multitable to the next.
+ Returns previous environment number. */
+int
+select_output_environment (n)
+ int n;
+{
+ struct env *e = &envs[current_env_no];
+ int old_env_no = current_env_no;
+
+ /* stash current env info from global vars into the old environment */
+ e->output_paragraph = output_paragraph;
+ e->output_paragraph_offset = output_paragraph_offset;
+ e->output_column = output_column;
+ e->paragraph_is_open = paragraph_is_open;
+ e->current_indent = current_indent;
+ e->fill_column = fill_column;
+
+ /* now copy new environment into global vars */
+ current_env_no = n;
+ e = &envs[current_env_no];
+ output_paragraph = e->output_paragraph;
+ output_paragraph_offset = e->output_paragraph_offset;
+ output_column = e->output_column;
+ paragraph_is_open = e->paragraph_is_open;
+ current_indent = e->current_indent;
+ fill_column = e->fill_column;
+ return old_env_no;
+}
+
+/* advance to the next environment number */
+int
+nselect_next_environment ()
+{
+ if (current_env_no >= last_column) {
+ line_error ("Too many columns in multitable item (max %d)", last_column);
+ return 1;
+ }
+ select_output_environment (current_env_no + 1);
+}
+
+
+static void output_multitable_row ();
+
+/* start a new item (row) of a multitable */
+multitable_item ()
+{
+ if (!multitable_active) {
+ /* impossible, I think. */
+ error ("multitable item not in active multitable");
+ exit (1);
+ }
+ if (current_env_no > 0) {
+ output_multitable_row ();
+ }
+ /* start at column 1 */
+ select_output_environment (1);
+ if (!output_paragraph) {
+ line_error ("Cannot select column #%d in multitable", current_env_no);
+ exit (FATAL);
+ }
+
+ init_column ();
+
+ return 0;
+}
+
+/* do anything needed at the beginning of processing a
+ multitable column. */
+init_column ()
+{
+ /* don't indent 1st paragraph in the item */
+ cm_noindent ();
+
+ /* throw away possible whitespace after @item or @tab command */
+ skip_whitespace ();
+}
+
+/* Output a row. Have to keep `output_position' up-to-date for each
+ character we output, or the tags table will be off, leading to
+ chopped-off output files and undefined nodes (because they're in the
+ wrong file, etc.). Perhaps it would be better to accumulate this
+ value somewhere and add it once at the end of the table, or return it
+ as the value, but this seems simplest. */
+
+static void
+out_char (ch)
+ int ch;
+{
+ extern int output_position;
+ putc (ch, output_stream);
+ output_position++;
+}
+
+
+static void
+output_multitable_row ()
+{
+ int i, j, remaining;
+
+ /* offset in the output paragraph of the next char needing
+ to be output for that column. */
+ int offset[MAXCOLS];
+
+ for (i = 0; i <= last_column; i++)
+ offset[i] = 0;
+
+ /* select the current environment, to make sure the env variables
+ get updated */
+ select_output_environment (current_env_no);
+
+#define CHAR_ADDR(n) (offset[i] + (n))
+#define CHAR_AT(n) (envs[i].output_paragraph[CHAR_ADDR(n)])
+
+ /* remove trailing whitespace from each column */
+ for (i = 1; i <= last_column; i++) {
+ while (cr_or_whitespace (CHAR_AT (envs[i].output_paragraph_offset - 1))) {
+ envs[i].output_paragraph_offset--;
+ }
+ }
+
+ /* read the current line from each column, outputting them all
+ pasted together. Do this til all lines are output from all
+ columns. */
+ for (;;) {
+ remaining = 0;
+ /* first, see if there is any work to do */
+ for (i = 1; i <= last_column; i++) {
+ if (CHAR_ADDR (0) < envs[i].output_paragraph_offset) {
+ remaining = 1;
+ break;
+ }
+ }
+ if (!remaining)
+ break;
+
+ if (vsep)
+ out_char ('|');
+
+ for (i = 1; i <= last_column; i++) {
+ for (j = 0; CHAR_ADDR (j) < envs[i].output_paragraph_offset; j++) {
+ if (CHAR_AT (j) == '\n')
+ break;
+ out_char (CHAR_AT (j));
+ }
+ offset[i] += j + 1; /* skip last text plus skip the newline */
+ for (; j <= envs[i].fill_column; j++)
+ out_char (' ');
+ if (vsep)
+ out_char ('|'); /* draw column separator */
+ }
+ out_char ('\n'); /* end of line */
+ }
+
+ if (hsep)
+ draw_horizontal_separator ();
+
+ /* Now dispose of the buffered output. */
+ for (i = 1; i <= last_column; i++) {
+ select_output_environment (i);
+ init_paragraph ();
+ }
+}
+
+#undef CHAR_AT
+#undef CHAR_ADDR
+
+int
+draw_horizontal_separator ()
+{
+ int i, j;
+ if (vsep)
+ out_char ('+');
+ for (i = 1; i <= last_column; i++) {
+ for (j = 0; j <= envs[i].fill_column; j++)
+ out_char ('-');
+ if (vsep)
+ out_char ('+');
+ }
+ out_char ('\n');
+}
+
+/* select a new column in current row of multitable */
+void
+cm_tab ()
+{
+ if (!multitable_active)
+ error ("ignoring @tab outside of multitable");
+
+ nselect_next_environment ();
+ init_column ();
+}
+
+/* close a multitable, flushing its output and resetting
+ whatever needs resetting */
+void
+end_multitable ()
+{
+ int i;
+
+ output_multitable_row ();
+
+ /* Multitables cannot be nested. Otherwise, we'd have to save the
+ previous output environment number on a stack somewhere, and then
+ restore to that environment. */
+ select_output_environment (0);
+ close_paragraph ();
+ insert ('\n'); /* we swallow newlines, so insert one of our own */
+
+ multitable_active = 0;
+ uninhibit_output_flushing ();
+
+#if 0
+ printf ("** Multicolumn output from last row:\n");
+ for (i = 1; i <= last_column; i++) {
+ select_output_environment (i);
+ printf ("* column #%d: output = %s\n", i, output_paragraph);
+ }
+#endif
+}
diff --git a/texinfo/makeinfo/multiformat.texi b/texinfo/makeinfo/multiformat.texi
new file mode 100644
index 00000000000..0c6c467dc0d
--- /dev/null
+++ b/texinfo/makeinfo/multiformat.texi
@@ -0,0 +1,40 @@
+@c multiformat.texi: -*- Texinfo -*- \input texinfo.tex
+
+@c Copyright (c) 1995 Universal Access, Inc
+@c Author: Brian J. Fox (bfox@ua.com) Sun Apr 2 07:56:23 1995.
+@setfilename multiformat.info
+
+@include html.texi
+
+@ifset html
+@html
+@end ifset
+
+@node First Node, First Section, (dir), (dir)
+@chapter First Chapter
+Here is some text that belongs in the first chapter. Nothing very
+exciting happens here, but this is enough text to span a couple of
+lines, and we feel that is important.
+@paragraph
+
+This is the second paragraph of the first chapter. Note that the
+formatting commands in @code{HTML} seem to do the right thing, as do the
+commands when invoked in @code{Texinfo} mode and in @TeX{}.
+
+@node First Section, , First Node, First Node
+@isection First Section
+
+Here is some text in the first section of the first chapter. We are
+trying very hard to examine the output here to see exactly how proper it
+is. If I wasn't so tired, we could probably see it already.
+@paragraph
+
+Here is a list of items:
+@paragraph
+
+@itemize @bullet
+@item Here is the first item.
+@item Here is the second item.
+@end itemize
+
+@bye
diff --git a/texinfo/testsuite/ChangeLog b/texinfo/testsuite/ChangeLog
new file mode 100644
index 00000000000..72366e2db68
--- /dev/null
+++ b/texinfo/testsuite/ChangeLog
@@ -0,0 +1,37 @@
+Thu Oct 3 15:31:09 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (clean): Move config.log to distclean.
+
+Wed Oct 2 16:01:58 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * configure.in: Switch to autoconf configure.in
+ * configure: New.
+ * Makefile.in: Use autoconf-substituted values.
+ (clean): Remove config.log.
+ (distclean): Remove config.cache.
+
+Tue May 17 15:49:09 1994 Bill Cox (bill@rtl.cygnus.com)
+
+ * config/unix.exp: Replace error proc calls with perror calls.
+
+Mon Apr 11 17:37:09 1994 Bill Cox (bill@rtl.cygnus.com)
+
+ * Makefile.in (EXPECT, RUNTEST): Set these for the check goal.
+
+Mon Apr 11 10:31:00 1994 Bill Cox (bill@rtl.cygnus.com)
+
+ * Makefile.in (check): Set TCL_LIBRARY for runtest.
+
+Fri Jun 18 23:16:04 1993 Jim Kingdon (kingdon@lioth.cygnus.com)
+
+ * makeinfo.0/atnode.exp, text/atnode.texi: Add test for at sign
+ in node name.
+
+Wed May 19 13:02:59 1993 Jim Kingdon (kingdon@cygnus.com)
+
+ * makeinfo.0/conditions.exp, text/conditions.texi: Add test for bug
+ currently being worked around in GDB manual.
+
+May 1993 Roland Pesch (pesch@cygnus.com)
+
+ * New directory.
diff --git a/texinfo/testsuite/Makefile.in b/texinfo/testsuite/Makefile.in
new file mode 100644
index 00000000000..4920a6290c0
--- /dev/null
+++ b/texinfo/testsuite/Makefile.in
@@ -0,0 +1,100 @@
+# Makefile for regression testing GNU texinfo.
+# Copyright (C) 1987, 88, 90, 91, 92, 93, 1994 Free Software Foundation, Inc.
+
+#This file is part of GNU texinfo.
+
+#texinfo 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.
+
+#texinfo 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 CC; see the file COPYING. If not, write to
+#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+prefix = @prefix@
+
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+tooldir = $(libdir)/$(target_alias)
+
+datadir = @datadir@/deja-gnu
+
+EXPECT = `if [ -f $${rootme}/../../expect/expect ] ; \
+ then echo $${rootme}/../../expect/expect ; \
+ else echo expect; fi`
+
+RUNTEST = `if [ -f ${srcdir}/../../dejagnu/runtest ] ; \
+ then echo ${srcdir}/../../dejagnu/runtest ; \
+ else echo runtest ; fi`
+RUNTESTFLAGS =
+FLAGS_TO_PASS =
+
+#### host, target, and site specific Makefile frags come in here.
+
+all:
+
+info:
+
+install-info:
+
+check: site.exp all
+ rootme=`pwd`; export rootme; \
+ srcdir=${srcdir} ; export srcdir ; \
+ EXPECT=${EXPECT} ; export EXPECT ; \
+ if [ -f $${rootme}/../../expect/expect ] ; then \
+ TCL_LIBRARY=$${srcdir}/../../tcl/library ; \
+ export TCL_LIBRARY ; fi ; \
+ $(RUNTEST) $(RUNTESTFLAGS) $(FLAGS_TO_PASS) --tool makeinfo \
+ --srcdir $(srcdir) --target $(target_canonical)
+
+site.exp: ./config.status Makefile
+ @echo "Making a new config file..."
+ -@rm -f ./tmp?
+ @touch site.exp
+
+ -@mv site.exp site.bak
+ @echo "## these variables are automatically generated by make ##" > ./tmp0
+ @echo "# Do not edit here. If you wish to override these values" >> ./tmp0
+ @echo "# add them to the last section" >> ./tmp0
+ @echo "set host_os ${host_os}" >> ./tmp0
+ @echo "set host_alias ${host_alias}" >> ./tmp0
+ @echo "set host_cpu ${host_cpu}" >> ./tmp0
+ @echo "set host_vendor ${host_vendor}" >> ./tmp0
+ @echo "set target_os ${target_os}" >> ./tmp0
+ @echo "set target_alias ${target_alias}" >> ./tmp0
+ @echo "set target_cpu ${target_cpu}" >> ./tmp0
+ @echo "set target_vendor ${target_vendor}" >> ./tmp0
+ @echo "set host_triplet ${host_canonical}" >> ./tmp0
+ @echo "set target_triplet ${target_canonical}" >> ./tmp0
+ @echo "set tool binutils" >> ./tmp0
+ @echo "set srcdir ${srcdir}" >> ./tmp0
+ @echo "set objdir `pwd`" >> ./tmp0
+ @echo "set MAKEINFO makeinfo" >> ./tmp0
+ @echo "## All variables above are generated by configure. Do Not Edit ##" >> ./tmp0
+ @cat ./tmp0 > site.exp
+ @cat site.bak | sed \
+ -e '1,/^## All variables above are.*##/ d' >> site.exp
+ -@rm -f ./tmp?
+
+install:
+uninstall:
+
+clean:
+ -rm -f *~ */*~ core *.info* *.log *.sum *.plog *.psum
+
+distclean: clean
+ -rm -f Makefile config.status site.exp config.cache config.log
+
+Makefile : $(srcdir)/Makefile.in $(host_makefile_frag) $(target_makefile_frag)
+ $(SHELL) ./config.status
+
diff --git a/texinfo/testsuite/config/unix.exp b/texinfo/testsuite/config/unix.exp
new file mode 100644
index 00000000000..12b38ba0ec6
--- /dev/null
+++ b/texinfo/testsuite/config/unix.exp
@@ -0,0 +1,29 @@
+load_lib utils.exp ;# Get the file of utilities for Texinfo tests
+
+default MAKEINFO makeinfo ;# ensure Tcl var MAKEINFO has value
+
+# Ensure we can execute this tool
+if [is_executable $MAKEINFO] then {
+ verbose "$MAKEINFO is executable\n" 1
+} else {
+ perror "$MAKEINFO: cannot execute\n"
+ exit 1 ;# no point in running any makeinfo tests
+}
+
+# makeinfo_start undefined by choice;
+# 1) it makes it clearer where the output is to start
+# $MAKEINFO directly with `catch' from each test case,
+# and
+# 2) this takes no more lines than it would to call makeinfo_start
+
+proc makeinfo_exit {} {}
+
+proc makeinfo_version {} {
+ global MAKEINFO
+ set tmp [ exec $MAKEINFO --version ]
+ regexp "version.*$" $tmp vn ;# "vn" undef if pattern not found
+ if [info exists vn] then {
+ clone_output "[which $MAKEINFO] $vn\n"
+ }
+}
+
diff --git a/texinfo/testsuite/configure b/texinfo/testsuite/configure
new file mode 100755
index 00000000000..5337df459f3
--- /dev/null
+++ b/texinfo/testsuite/configure
@@ -0,0 +1,707 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.10
+# 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=
+
+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.10"
+ 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 LANG and LC_ALL to C if already set.
+# These must not be set unconditionally because not all systems understand
+# e.g. LANG=C (notably SCO).
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LANG+set}" = set; then LANG=C; export LANG; 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=makeinfo.0/atnode.exp
+
+# 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'
+
+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
+
+
+
+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
+# 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 |
+ sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \
+ >> 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 <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/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.10"
+ 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" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > 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
+
+CEOF
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[: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 relative srcdir, etc. 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
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file
+fi; done
+rm -f conftest.subs
+
+
+
+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/texinfo/testsuite/configure.in b/texinfo/testsuite/configure.in
new file mode 100644
index 00000000000..8cf18763df0
--- /dev/null
+++ b/texinfo/testsuite/configure.in
@@ -0,0 +1,5 @@
+dnl Process this file with autoconf to produce a configure script.
+AC_PREREQ(2.5)
+AC_INIT(makeinfo.0/atnode.exp)
+
+AC_OUTPUT(Makefile)
diff --git a/texinfo/testsuite/lib/utils.exp b/texinfo/testsuite/lib/utils.exp
new file mode 100644
index 00000000000..713e9f2332a
--- /dev/null
+++ b/texinfo/testsuite/lib/utils.exp
@@ -0,0 +1,31 @@
+# utils.exp, a collection of Tcl/Expect utilities for texinfo tests.
+
+# ----------default--------------------------------------------
+# default VAR VALUE
+# Check whether VAR exists and has a nonempty value;
+# if not, use VALUE as the default
+# -------------------------------------------------------------
+proc default {varname varval} {
+ upvar $varname outervar
+ if { ![info exists outervar] || [string match {} $outervar] } then {
+ verbose "Defaulting $varname to $varval\n" 1
+ set outervar $varval
+ } else {
+ verbose "$varname retains existing value $outervar\n" 1
+ }
+ return
+}
+
+
+# ----------is_executable--------------------------------------
+# is_executable NAME
+# Boolean predicate: is NAME an executable file
+# somewhere on our PATH?
+# -------------------------------------------------------------
+proc is_executable {name} {
+ if [ file executable [which $name] ] then {
+ return 1
+ } else {
+ return 0
+ }
+}
diff --git a/texinfo/testsuite/makeinfo.0/atnode.exp b/texinfo/testsuite/makeinfo.0/atnode.exp
new file mode 100644
index 00000000000..19724347cbb
--- /dev/null
+++ b/texinfo/testsuite/makeinfo.0/atnode.exp
@@ -0,0 +1,19 @@
+# Lessons:
+# 1) may use \ to continue long lines
+# 2) Careful in specifying string end on string match, to be sure
+# to exclude errors! (cf output from nonsense.exp)
+
+catch "exec $MAKEINFO -o ./atnode.info $srcdir/text/atnode.texi" maki_out
+
+verbose "Makeinfo output: $maki_out" 1
+
+setup_xfail "*-*-*"
+if [string match \
+ "Making*file*atnode*from*atnode.texi'." \
+ "$maki_out" \
+ ] then {
+ pass "at sign in node name"
+} else {
+ fail "at sign in node name"
+}
+clear_xfail "*-*-*"
diff --git a/texinfo/testsuite/makeinfo.0/conditions.exp b/texinfo/testsuite/makeinfo.0/conditions.exp
new file mode 100644
index 00000000000..c62c66a2a04
--- /dev/null
+++ b/texinfo/testsuite/makeinfo.0/conditions.exp
@@ -0,0 +1,21 @@
+# Lessons:
+# 1) may use \ to continue long lines
+# 2) Careful in specifying string end on string match, to be sure
+# to exclude errors! (cf output from nonsense.exp)
+
+catch "exec $MAKEINFO -o ./conditions.info $srcdir/text/conditions.texi" maki_out
+
+verbose "Makeinfo output: $maki_out" 1
+
+# The gdb manual works around this by putting a blank line after the pair of
+# @end if* commands.
+setup_xfail "*-*-*"
+if [string match \
+ "Making*file*conditions*from*conditions.texi'." \
+ "$maki_out" \
+ ] then {
+ pass "texinfo conditions"
+} else {
+ fail "texinfo conditions"
+}
+clear_xfail "*-*-*"
diff --git a/texinfo/testsuite/makeinfo.0/mini.exp b/texinfo/testsuite/makeinfo.0/mini.exp
new file mode 100644
index 00000000000..17d48bdee61
--- /dev/null
+++ b/texinfo/testsuite/makeinfo.0/mini.exp
@@ -0,0 +1,17 @@
+# Lessons:
+# 1) may use \ to continue long lines
+# 2) Careful in specifying string end on string match, to be sure
+# to exclude errors! (cf output from nonsense.exp)
+
+catch "exec $MAKEINFO -o ./mini.info $srcdir/text/minimal.texi" maki_out
+
+verbose "Makeinfo output: $maki_out" 1
+
+if [string match \
+ "Making*file*mini*from*minimal.texi'." \
+ "$maki_out" \
+ ] then {
+ pass "minimal source file"
+} else {
+ fail "minimal source file"
+}
diff --git a/texinfo/testsuite/makeinfo.0/missnode.exp b/texinfo/testsuite/makeinfo.0/missnode.exp
new file mode 100644
index 00000000000..fb278f08cfb
--- /dev/null
+++ b/texinfo/testsuite/makeinfo.0/missnode.exp
@@ -0,0 +1,25 @@
+#set real_verbose [set verbose]
+#set verbose 2
+catch "exec $MAKEINFO -o ./missnode.info $srcdir/text/missnode.texi" maki_out
+
+verbose "Makeinfo output: $maki_out" 1
+
+if [string match \
+ "*Validation error*Next*doesn't exist*" \
+ "$maki_out" \
+ ] then {
+ pass "missing Next detection"
+} else {
+ fail "missing Next detection"
+}
+
+if [string match \
+ "*Validation error*Menu*doesn't exist*" \
+ "$maki_out" \
+ ] then {
+ pass "missing menu entry detection"
+} else {
+ fail "missing menu entry detection"
+}
+
+#set verbose [set real_verbose]
diff --git a/texinfo/testsuite/makeinfo.0/nonsense.exp b/texinfo/testsuite/makeinfo.0/nonsense.exp
new file mode 100644
index 00000000000..3b19f2680fc
--- /dev/null
+++ b/texinfo/testsuite/makeinfo.0/nonsense.exp
@@ -0,0 +1,12 @@
+catch "exec $MAKEINFO -o ./nonsense.info $srcdir/text/nonsense.texi" maki_out
+
+verbose "Makeinfo output: $maki_out" 1
+
+if [string match \
+ "*Unknown info command*" \
+ "$maki_out" \
+ ] then {
+ pass "unknown command detection"
+} else {
+ fail "unknown command detection"
+}
diff --git a/texinfo/testsuite/makeinfo.0/not.exp b/texinfo/testsuite/makeinfo.0/not.exp
new file mode 100644
index 00000000000..3c5ac5a5964
--- /dev/null
+++ b/texinfo/testsuite/makeinfo.0/not.exp
@@ -0,0 +1,15 @@
+# lessons:
+# 1) ALL expected args to a cmd on one line!
+# 2) `*' at end of string match pattern essential---match *complete* string!
+# 3) $srcdir (at least when .) expanded in dir where runtest invoked---
+# NOT dir where test lives!
+# 4) stderr already folded into stdout; no need for 2>&1 or such things
+
+catch "exec $MAKEINFO $srcdir/text/not.texi" maki_out
+verbose "Makeinfo output: $maki_out" 1
+
+if [string match "No*setfilename*found*in*" "$maki_out"] then {
+ pass "@setfilename required"
+} else {
+ fail "@setfilename required"
+}
diff --git a/texinfo/testsuite/makeinfo.0/smstruct.exp b/texinfo/testsuite/makeinfo.0/smstruct.exp
new file mode 100644
index 00000000000..1a0c00f275c
--- /dev/null
+++ b/texinfo/testsuite/makeinfo.0/smstruct.exp
@@ -0,0 +1,14 @@
+catch "exec $MAKEINFO -o ./smstruct.info $srcdir/text/smstruct.texi" maki_out
+
+verbose "Makeinfo output: $maki_out" 1
+
+if [string match \
+ "Making*file*smstruct*from*smstruct.texi'." \
+ "$maki_out" \
+ ] then {
+ pass "structured source file"
+} else {
+ fail "structured source file"
+}
+
+
diff --git a/texinfo/testsuite/text/atnode.texi b/texinfo/testsuite/text/atnode.texi
new file mode 100644
index 00000000000..443738d19aa
--- /dev/null
+++ b/texinfo/testsuite/text/atnode.texi
@@ -0,0 +1,21 @@
+@setfilename atnode
+
+@node Top
+@c @top Toity
+
+@menu
+* @@string:: A node with an at sign in its name
+* Joke:: A node without an at sign in its name
+@end menu
+
+@node @@string
+@chapter On the Nature of Strings
+
+They can be thick or thin.
+
+@node Joke
+@chapter Stop me if You've Heard this One
+
+These three strings (@pxref{@@string}), walked into a bar, and...
+
+@bye
diff --git a/texinfo/testsuite/text/conditions.texi b/texinfo/testsuite/text/conditions.texi
new file mode 100644
index 00000000000..5c4a3209720
--- /dev/null
+++ b/texinfo/testsuite/text/conditions.texi
@@ -0,0 +1,26 @@
+@setfilename conditions
+@set foo1
+@clear foo2
+@clear bar
+@node Top
+@top Test of conditions
+@menu
+@ifclear bar
+@ifset foo1
+* Foo1:: This text should be included.
+@end ifset
+@ifset foo2
+* Foo2:: This text should not be included.
+@end ifset
+@end ifclear
+* Foo3:: And we have no blank line here.
+@end menu
+@node Foo1
+@chapter Foo1
+@ifset foo2
+@node Foo2
+@chapter Foo2
+@end ifset
+@node Foo3
+@chapter Foo3
+@bye
diff --git a/texinfo/testsuite/text/dfltnode.texi b/texinfo/testsuite/text/dfltnode.texi
new file mode 100644
index 00000000000..3800f42d853
--- /dev/null
+++ b/texinfo/testsuite/text/dfltnode.texi
@@ -0,0 +1,21 @@
+@setfilename smstruct
+
+@node Top
+@top Hoity
+
+@menu
+* First:: The Very First Node
+* Second:: Another Whole Node
+@end menu
+
+@node First
+@chapter The Very First Node
+
+This node is a real node, yes indeed.
+
+@node Second
+@chapter Another Whole Node
+
+Will wonders never cease?
+
+@bye
diff --git a/texinfo/testsuite/text/minimal.texi b/texinfo/testsuite/text/minimal.texi
new file mode 100644
index 00000000000..682881d4fd3
--- /dev/null
+++ b/texinfo/testsuite/text/minimal.texi
@@ -0,0 +1,2 @@
+@setfilename mini
+@bye
diff --git a/texinfo/testsuite/text/missnode.texi b/texinfo/testsuite/text/missnode.texi
new file mode 100644
index 00000000000..db997de8632
--- /dev/null
+++ b/texinfo/testsuite/text/missnode.texi
@@ -0,0 +1,22 @@
+@setfilename missingnode
+
+@node Top, First,,
+@top Hoity
+
+@menu
+* First:: The very first node
+* Second:: Another whole node
+* Third:: No such thing
+@end menu
+
+@node First, Second, Top, Top
+@chapter The Very First Node
+
+This node is a real node, yes indeed.
+
+@node Second, Third, First, Top
+@chapter Another Whole Node
+
+Will wonders never cease?
+
+@bye
diff --git a/texinfo/testsuite/text/nonsense.texi b/texinfo/testsuite/text/nonsense.texi
new file mode 100644
index 00000000000..b84fb3d7080
--- /dev/null
+++ b/texinfo/testsuite/text/nonsense.texi
@@ -0,0 +1,3 @@
+@setfilename mini
+@nonsense
+@bye
diff --git a/texinfo/testsuite/text/not.texi b/texinfo/testsuite/text/not.texi
new file mode 100644
index 00000000000..a8d29b95088
--- /dev/null
+++ b/texinfo/testsuite/text/not.texi
@@ -0,0 +1 @@
+Ceci n'est pas un fichier Texinfo.
diff --git a/texinfo/testsuite/text/smstruct.texi b/texinfo/testsuite/text/smstruct.texi
new file mode 100644
index 00000000000..64f98ea2337
--- /dev/null
+++ b/texinfo/testsuite/text/smstruct.texi
@@ -0,0 +1,21 @@
+@setfilename smstruct
+
+@node Top, First,,
+@top Hoity
+
+@menu
+* First:: The Very First Node
+* Second:: Another Whole Node
+@end menu
+
+@node First, Second, Top, Top
+@chapter The Very First Node
+
+This node is a real node, yes indeed.
+
+@node Second,,First,Top
+@chapter Another Whole Node
+
+Will wonders never cease?
+
+@bye
diff --git a/texinfo/texinfo.tex b/texinfo/texinfo.tex
new file mode 100644
index 00000000000..96345315e30
--- /dev/null
+++ b/texinfo/texinfo.tex
@@ -0,0 +1,4800 @@
+%% TeX macros to handle Texinfo files.
+%% $Id: texinfo.tex,v 1.1 1997/08/21 22:57:53 jason Exp $
+
+% Copyright (C) 1985, 86, 88, 90, 91, 92, 93,
+% 94, 95, 96, 97 Free Software Foundation, Inc.
+
+%This texinfo.tex file 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.
+
+%This texinfo.tex file 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 this texinfo.tex file; see the file COPYING. If not, write
+%to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+%Boston, MA 02111-1307, USA.
+
+
+%In other words, you are welcome to use, share and improve this program.
+%You are forbidden to forbid anyone else to use, share and improve
+%what you give them. Help stamp out software-hoarding!
+
+
+% Send bug reports to bug-texinfo@prep.ai.mit.edu.
+% Please include a *precise* test case in each bug report.
+
+
+% Make it possible to create a .fmt file just by loading this file:
+% if the underlying format is not loaded, start by loading it now.
+% Added by gildea November 1993.
+\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
+
+% This automatically updates the version number based on RCS.
+\def\deftexinfoversion$#1: #2 ${\def\texinfoversion{#2}}
+\deftexinfoversion$Revision: 1.1 $
+\message{Loading texinfo package [Version \texinfoversion]:}
+
+% If in a .fmt file, print the version number
+% and turn on active characters that we couldn't do earlier because
+% they might have appeared in the input file name.
+\everyjob{\message{[Texinfo version \texinfoversion]}\message{}
+ \catcode`+=\active \catcode`\_=\active}
+
+% Save some parts of plain tex whose names we will redefine.
+
+\let\ptexb=\b
+\let\ptexbullet=\bullet
+\let\ptexc=\c
+\let\ptexcomma=\,
+\let\ptexdot=\.
+\let\ptexdots=\dots
+\let\ptexend=\end
+\let\ptexequiv = \equiv
+\let\ptexi=\i
+\let\ptexlbrace=\{
+\let\ptexrbrace=\}
+\let\ptexstar=\*
+\let\ptext=\t
+
+% Be sure we're in horizontal mode when doing a tie, since we make space
+% equivalent to this in @example-like environments. Otherwise, a space
+% at the beginning of a line will start with \penalty -- and
+% since \penalty is valid in vertical mode, we'd end up putting the
+% penalty on the vertical list instead of in the new paragraph.
+{\catcode`@ = 11
+ % Avoid using \@M directly, because that causes trouble
+ % if the definition is written into an index file.
+ \global\let\tiepenalty = \@M
+ \gdef\tie{\leavevmode\penalty\tiepenalty\ }
+}
+
+
+\message{Basics,}
+\chardef\other=12
+
+% If this character appears in an error message or help string, it
+% starts a new line in the output.
+\newlinechar = `^^J
+
+% Set up fixed words for English.
+\ifx\putwordChapter\undefined{\gdef\putwordChapter{Chapter}}\fi%
+\def\putwordInfo{Info}%
+\ifx\putwordSee\undefined{\gdef\putwordSee{See}}\fi%
+\ifx\putwordsee\undefined{\gdef\putwordsee{see}}\fi%
+\ifx\putwordfile\undefined{\gdef\putwordfile{file}}\fi%
+\ifx\putwordpage\undefined{\gdef\putwordpage{page}}\fi%
+\ifx\putwordsection\undefined{\gdef\putwordsection{section}}\fi%
+\ifx\putwordSection\undefined{\gdef\putwordSection{Section}}\fi%
+\ifx\putwordTableofContents\undefined{\gdef\putwordTableofContents{Table of Contents}}\fi%
+\ifx\putwordShortContents\undefined{\gdef\putwordShortContents{Short Contents}}\fi%
+\ifx\putwordAppendix\undefined{\gdef\putwordAppendix{Appendix}}\fi%
+
+% Ignore a token.
+%
+\def\gobble#1{}
+
+\hyphenation{ap-pen-dix}
+\hyphenation{mini-buf-fer mini-buf-fers}
+\hyphenation{eshell}
+
+% Margin to add to right of even pages, to left of odd pages.
+\newdimen \bindingoffset
+\newdimen \normaloffset
+\newdimen\pagewidth \newdimen\pageheight
+
+% Sometimes it is convenient to have everything in the transcript file
+% and nothing on the terminal. We don't just call \tracingall here,
+% since that produces some useless output on the terminal.
+%
+\def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}%
+\def\loggingall{\tracingcommands2 \tracingstats2
+ \tracingpages1 \tracingoutput1 \tracinglostchars1
+ \tracingmacros2 \tracingparagraphs1 \tracingrestores1
+ \showboxbreadth\maxdimen\showboxdepth\maxdimen
+}%
+
+% For @cropmarks command.
+% Do @cropmarks to get crop marks.
+%
+\newif\ifcropmarks
+\let\cropmarks = \cropmarkstrue
+%
+% Dimensions to add cropmarks at corners.
+% Added by P. A. MacKay, 12 Nov. 1986
+%
+\newdimen\cornerlong \newdimen\cornerthick
+\newdimen\topandbottommargin
+\newdimen\outerhsize \newdimen\outervsize
+\cornerlong=1pc\cornerthick=.3pt % These set size of cropmarks
+\outerhsize=7in
+%\outervsize=9.5in
+% Alternative @smallbook page size is 9.25in
+\outervsize=9.25in
+\topandbottommargin=.75in
+
+% Main output routine.
+\chardef\PAGE = 255
+\output = {\onepageout{\pagecontents\PAGE}}
+
+\newbox\headlinebox
+\newbox\footlinebox
+
+% \onepageout takes a vbox as an argument. Note that \pagecontents
+% does insertions, but you have to call it yourself.
+\def\onepageout#1{%
+ \ifcropmarks \hoffset=0pt \else \hoffset=\normaloffset \fi
+ %
+ \ifodd\pageno \advance\hoffset by \bindingoffset
+ \else \advance\hoffset by -\bindingoffset\fi
+ %
+ % Do this outside of the \shipout so @code etc. will be expanded in
+ % the headline as they should be, not taken literally (outputting ''code).
+ \setbox\headlinebox = \vbox{\let\hsize=\pagewidth \makeheadline}%
+ \setbox\footlinebox = \vbox{\let\hsize=\pagewidth \makefootline}%
+ %
+ {%
+ % Have to do this stuff outside the \shipout because we want it to
+ % take effect in \write's, yet the group defined by the \vbox ends
+ % before the \shipout runs.
+ %
+ \escapechar = `\\ % use backslash in output files.
+ \indexdummies % don't expand commands in the output.
+ \normalturnoffactive % \ in index entries must not stay \, e.g., if
+ % the page break happens to be in the middle of an example.
+ \shipout\vbox{%
+ \ifcropmarks \vbox to \outervsize\bgroup
+ \hsize = \outerhsize
+ \line{\ewtop\hfil\ewtop}%
+ \nointerlineskip
+ \line{%
+ \vbox{\moveleft\cornerthick\nstop}%
+ \hfill
+ \vbox{\moveright\cornerthick\nstop}%
+ }%
+ \vskip\topandbottommargin
+ \line\bgroup
+ \hfil % center the page within the outer (page) hsize.
+ \ifodd\pageno\hskip\bindingoffset\fi
+ \vbox\bgroup
+ \fi
+ %
+ \unvbox\headlinebox
+ \pagebody{#1}%
+ \unvbox\footlinebox
+ %
+ \ifcropmarks
+ \egroup % end of \vbox\bgroup
+ \hfil\egroup % end of (centering) \line\bgroup
+ \vskip\topandbottommargin plus1fill minus1fill
+ \boxmaxdepth = \cornerthick
+ \line{%
+ \vbox{\moveleft\cornerthick\nsbot}%
+ \hfill
+ \vbox{\moveright\cornerthick\nsbot}%
+ }%
+ \nointerlineskip
+ \line{\ewbot\hfil\ewbot}%
+ \egroup % \vbox from first cropmarks clause
+ \fi
+ }% end of \shipout\vbox
+ }% end of group with \turnoffactive
+ \advancepageno
+ \ifnum\outputpenalty>-20000 \else\dosupereject\fi
+}
+
+\newinsert\margin \dimen\margin=\maxdimen
+
+\def\pagebody#1{\vbox to\pageheight{\boxmaxdepth=\maxdepth #1}}
+{\catcode`\@ =11
+\gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi
+% marginal hacks, juha@viisa.uucp (Juha Takala)
+\ifvoid\margin\else % marginal info is present
+ \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi
+\dimen@=\dp#1 \unvbox#1
+\ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi
+\ifr@ggedbottom \kern-\dimen@ \vfil \fi}
+}
+
+% Here are the rules for the cropmarks. Note that they are
+% offset so that the space between them is truly \outerhsize or \outervsize
+% (P. A. MacKay, 12 November, 1986)
+%
+\def\ewtop{\vrule height\cornerthick depth0pt width\cornerlong}
+\def\nstop{\vbox
+ {\hrule height\cornerthick depth\cornerlong width\cornerthick}}
+\def\ewbot{\vrule height0pt depth\cornerthick width\cornerlong}
+\def\nsbot{\vbox
+ {\hrule height\cornerlong depth\cornerthick width\cornerthick}}
+
+% Parse an argument, then pass it to #1. The argument is the rest of
+% the input line (except we remove a trailing comment). #1 should be a
+% macro which expects an ordinary undelimited TeX argument.
+%
+\def\parsearg#1{%
+ \let\next = #1%
+ \begingroup
+ \obeylines
+ \futurelet\temp\parseargx
+}
+
+% If the next token is an obeyed space (from an @example environment or
+% the like), remove it and recurse. Otherwise, we're done.
+\def\parseargx{%
+ % \obeyedspace is defined far below, after the definition of \sepspaces.
+ \ifx\obeyedspace\temp
+ \expandafter\parseargdiscardspace
+ \else
+ \expandafter\parseargline
+ \fi
+}
+
+% Remove a single space (as the delimiter token to the macro call).
+{\obeyspaces %
+ \gdef\parseargdiscardspace {\futurelet\temp\parseargx}}
+
+{\obeylines %
+ \gdef\parseargline#1^^M{%
+ \endgroup % End of the group started in \parsearg.
+ %
+ % First remove any @c comment, then any @comment.
+ % Result of each macro is put in \toks0.
+ \argremovec #1\c\relax %
+ \expandafter\argremovecomment \the\toks0 \comment\relax %
+ %
+ % Call the caller's macro, saved as \next in \parsearg.
+ \expandafter\next\expandafter{\the\toks0}%
+ }%
+}
+
+% Since all \c{,omment} does is throw away the argument, we can let TeX
+% do that for us. The \relax here is matched by the \relax in the call
+% in \parseargline; it could be more or less anything, its purpose is
+% just to delimit the argument to the \c.
+\def\argremovec#1\c#2\relax{\toks0 = {#1}}
+\def\argremovecomment#1\comment#2\relax{\toks0 = {#1}}
+
+% \argremovec{,omment} might leave us with trailing spaces, though; e.g.,
+% @end itemize @c foo
+% will have two active spaces as part of the argument with the
+% `itemize'. Here we remove all active spaces from #1, and assign the
+% result to \toks0.
+%
+% This loses if there are any *other* active characters besides spaces
+% in the argument -- _ ^ +, for example -- since they get expanded.
+% Fortunately, Texinfo does not define any such commands. (If it ever
+% does, the catcode of the characters in questionwill have to be changed
+% here.) But this means we cannot call \removeactivespaces as part of
+% \argremovec{,omment}, since @c uses \parsearg, and thus the argument
+% that \parsearg gets might well have any character at all in it.
+%
+\def\removeactivespaces#1{%
+ \begingroup
+ \ignoreactivespaces
+ \edef\temp{#1}%
+ \global\toks0 = \expandafter{\temp}%
+ \endgroup
+}
+
+% Change the active space to expand to nothing.
+%
+\begingroup
+ \obeyspaces
+ \gdef\ignoreactivespaces{\obeyspaces\let =\empty}
+\endgroup
+
+
+\def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next}
+
+%% These are used to keep @begin/@end levels from running away
+%% Call \inENV within environments (after a \begingroup)
+\newif\ifENV \ENVfalse \def\inENV{\ifENV\relax\else\ENVtrue\fi}
+\def\ENVcheck{%
+\ifENV\errmessage{Still within an environment. Type Return to continue.}
+\endgroup\fi} % This is not perfect, but it should reduce lossage
+
+% @begin foo is the same as @foo, for now.
+\newhelp\EMsimple{Type <Return> to continue.}
+
+\outer\def\begin{\parsearg\beginxxx}
+
+\def\beginxxx #1{%
+\expandafter\ifx\csname #1\endcsname\relax
+{\errhelp=\EMsimple \errmessage{Undefined command @begin #1}}\else
+\csname #1\endcsname\fi}
+
+% @end foo executes the definition of \Efoo.
+%
+\def\end{\parsearg\endxxx}
+\def\endxxx #1{%
+ \removeactivespaces{#1}%
+ \edef\endthing{\the\toks0}%
+ %
+ \expandafter\ifx\csname E\endthing\endcsname\relax
+ \expandafter\ifx\csname \endthing\endcsname\relax
+ % There's no \foo, i.e., no ``environment'' foo.
+ \errhelp = \EMsimple
+ \errmessage{Undefined command `@end \endthing'}%
+ \else
+ \unmatchedenderror\endthing
+ \fi
+ \else
+ % Everything's ok; the right environment has been started.
+ \csname E\endthing\endcsname
+ \fi
+}
+
+% There is an environment #1, but it hasn't been started. Give an error.
+%
+\def\unmatchedenderror#1{%
+ \errhelp = \EMsimple
+ \errmessage{This `@end #1' doesn't have a matching `@#1'}%
+}
+
+% Define the control sequence \E#1 to give an unmatched @end error.
+%
+\def\defineunmatchedend#1{%
+ \expandafter\def\csname E#1\endcsname{\unmatchedenderror{#1}}%
+}
+
+
+% Single-spacing is done by various environments (specifically, in
+% \nonfillstart and \quotations).
+\newskip\singlespaceskip \singlespaceskip = 12.5pt
+\def\singlespace{%
+ % Why was this kern here? It messes up equalizing space above and below
+ % environments. --karl, 6may93
+ %{\advance \baselineskip by -\singlespaceskip
+ %\kern \baselineskip}%
+ \setleading \singlespaceskip
+}
+
+%% Simple single-character @ commands
+
+% @@ prints an @
+% Kludge this until the fonts are right (grr).
+\def\@{{\tt \char '100}}
+
+% This is turned off because it was never documented
+% and you can use @w{...} around a quote to suppress ligatures.
+%% Define @` and @' to be the same as ` and '
+%% but suppressing ligatures.
+%\def\`{{`}}
+%\def\'{{'}}
+
+% Used to generate quoted braces.
+\def\mylbrace {{\tt \char '173}}
+\def\myrbrace {{\tt \char '175}}
+\let\{=\mylbrace
+\let\}=\myrbrace
+\begingroup
+ % Definitions to produce actual \{ & \} command in an index.
+ \catcode`\{ = 12 \catcode`\} = 12
+ \catcode`\[ = 1 \catcode`\] = 2
+ \catcode`\@ = 0 \catcode`\\ = 12
+ @gdef@lbracecmd[\{]%
+ @gdef@rbracecmd[\}]%
+@endgroup
+
+% Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent
+% Others are defined by plain TeX: @` @' @" @^ @~ @= @v @H.
+\let\, = \c
+\let\dotaccent = \.
+\def\ringaccent#1{{\accent23 #1}}
+\let\tieaccent = \t
+\let\ubaraccent = \b
+\let\udotaccent = \d
+
+% Other special characters: @questiondown @exclamdown
+% Plain TeX defines: @AA @AE @O @OE @L (and lowercase versions) @ss.
+\def\questiondown{?`}
+\def\exclamdown{!`}
+
+% Dotless i and dotless j, used for accents.
+\def\imacro{i}
+\def\jmacro{j}
+\def\dotless#1{%
+ \def\temp{#1}%
+ \ifx\temp\imacro \ptexi
+ \else\ifx\temp\jmacro \j
+ \else \errmessage{@dotless can be used only with i or j}%
+ \fi\fi
+}
+
+% @: forces normal size whitespace following.
+\def\:{\spacefactor=1000 }
+
+% @* forces a line break.
+\def\*{\hfil\break\hbox{}\ignorespaces}
+
+% @. is an end-of-sentence period.
+\def\.{.\spacefactor=3000 }
+
+% @enddots{} is an end-of-sentence ellipsis.
+\gdef\enddots{$\mathinner{\ldotp\ldotp\ldotp\ldotp}$\spacefactor=3000}
+
+% @! is an end-of-sentence bang.
+\gdef\!{!\spacefactor=3000 }
+
+% @? is an end-of-sentence query.
+\gdef\?{?\spacefactor=3000 }
+
+% @w prevents a word break. Without the \leavevmode, @w at the
+% beginning of a paragraph, when TeX is still in vertical mode, would
+% produce a whole line of output instead of starting the paragraph.
+\def\w#1{\leavevmode\hbox{#1}}
+
+% @group ... @end group forces ... to be all on one page, by enclosing
+% it in a TeX vbox. We use \vtop instead of \vbox to construct the box
+% to keep its height that of a normal line. According to the rules for
+% \topskip (p.114 of the TeXbook), the glue inserted is
+% max (\topskip - \ht (first item), 0). If that height is large,
+% therefore, no glue is inserted, and the space between the headline and
+% the text is small, which looks bad.
+%
+\def\group{\begingroup
+ \ifnum\catcode13=\active \else
+ \errhelp = \groupinvalidhelp
+ \errmessage{@group invalid in context where filling is enabled}%
+ \fi
+ %
+ % The \vtop we start below produces a box with normal height and large
+ % depth; thus, TeX puts \baselineskip glue before it, and (when the
+ % next line of text is done) \lineskip glue after it. (See p.82 of
+ % the TeXbook.) Thus, space below is not quite equal to space
+ % above. But it's pretty close.
+ \def\Egroup{%
+ \egroup % End the \vtop.
+ \endgroup % End the \group.
+ }%
+ %
+ \vtop\bgroup
+ % We have to put a strut on the last line in case the @group is in
+ % the midst of an example, rather than completely enclosing it.
+ % Otherwise, the interline space between the last line of the group
+ % and the first line afterwards is too small. But we can't put the
+ % strut in \Egroup, since there it would be on a line by itself.
+ % Hence this just inserts a strut at the beginning of each line.
+ \everypar = {\strut}%
+ %
+ % Since we have a strut on every line, we don't need any of TeX's
+ % normal interline spacing.
+ \offinterlineskip
+ %
+ % OK, but now we have to do something about blank
+ % lines in the input in @example-like environments, which normally
+ % just turn into \lisppar, which will insert no space now that we've
+ % turned off the interline space. Simplest is to make them be an
+ % empty paragraph.
+ \ifx\par\lisppar
+ \edef\par{\leavevmode \par}%
+ %
+ % Reset ^^M's definition to new definition of \par.
+ \obeylines
+ \fi
+ %
+ % Do @comment since we are called inside an environment such as
+ % @example, where each end-of-line in the input causes an
+ % end-of-line in the output. We don't want the end-of-line after
+ % the `@group' to put extra space in the output. Since @group
+ % should appear on a line by itself (according to the Texinfo
+ % manual), we don't worry about eating any user text.
+ \comment
+}
+%
+% TeX puts in an \escapechar (i.e., `@') at the beginning of the help
+% message, so this ends up printing `@group can only ...'.
+%
+\newhelp\groupinvalidhelp{%
+group can only be used in environments such as @example,^^J%
+where each line of input produces a line of output.}
+
+% @need space-in-mils
+% forces a page break if there is not space-in-mils remaining.
+
+\newdimen\mil \mil=0.001in
+
+\def\need{\parsearg\needx}
+
+% Old definition--didn't work.
+%\def\needx #1{\par %
+%% This method tries to make TeX break the page naturally
+%% if the depth of the box does not fit.
+%{\baselineskip=0pt%
+%\vtop to #1\mil{\vfil}\kern -#1\mil\penalty 10000
+%\prevdepth=-1000pt
+%}}
+
+\def\needx#1{%
+ % Go into vertical mode, so we don't make a big box in the middle of a
+ % paragraph.
+ \par
+ %
+ % Don't add any leading before our big empty box, but allow a page
+ % break, since the best break might be right here.
+ \allowbreak
+ \nointerlineskip
+ \vtop to #1\mil{\vfil}%
+ %
+ % TeX does not even consider page breaks if a penalty added to the
+ % main vertical list is 10000 or more. But in order to see if the
+ % empty box we just added fits on the page, we must make it consider
+ % page breaks. On the other hand, we don't want to actually break the
+ % page after the empty box. So we use a penalty of 9999.
+ %
+ % There is an extremely small chance that TeX will actually break the
+ % page at this \penalty, if there are no other feasible breakpoints in
+ % sight. (If the user is using lots of big @group commands, which
+ % almost-but-not-quite fill up a page, TeX will have a hard time doing
+ % good page breaking, for example.) However, I could not construct an
+ % example where a page broke at this \penalty; if it happens in a real
+ % document, then we can reconsider our strategy.
+ \penalty9999
+ %
+ % Back up by the size of the box, whether we did a page break or not.
+ \kern -#1\mil
+ %
+ % Do not allow a page break right after this kern.
+ \nobreak
+}
+
+% @br forces paragraph break
+
+\let\br = \par
+
+% @dots{} output some dots
+
+\def\dots{$\ldots$}
+
+% @page forces the start of a new page
+
+\def\page{\par\vfill\supereject}
+
+% @exdent text....
+% outputs text on separate line in roman font, starting at standard page margin
+
+% This records the amount of indent in the innermost environment.
+% That's how much \exdent should take out.
+\newskip\exdentamount
+
+% This defn is used inside fill environments such as @defun.
+\def\exdent{\parsearg\exdentyyy}
+\def\exdentyyy #1{{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break}}
+
+% This defn is used inside nofill environments such as @example.
+\def\nofillexdent{\parsearg\nofillexdentyyy}
+\def\nofillexdentyyy #1{{\advance \leftskip by -\exdentamount
+\leftline{\hskip\leftskip{\rm#1}}}}
+
+% @inmargin{TEXT} puts TEXT in the margin next to the current paragraph.
+
+\def\inmargin#1{%
+\strut\vadjust{\nobreak\kern-\strutdepth
+ \vtop to \strutdepth{\baselineskip\strutdepth\vss
+ \llap{\rightskip=\inmarginspacing \vbox{\noindent #1}}\null}}}
+\newskip\inmarginspacing \inmarginspacing=1cm
+\def\strutdepth{\dp\strutbox}
+
+%\hbox{{\rm#1}}\hfil\break}}
+
+% @include file insert text of that file as input.
+% Allow normal characters that we make active in the argument (a file name).
+\def\include{\begingroup
+ \catcode`\\=12
+ \catcode`~=12
+ \catcode`^=12
+ \catcode`_=12
+ \catcode`|=12
+ \catcode`<=12
+ \catcode`>=12
+ \catcode`+=12
+ \parsearg\includezzz}
+% Restore active chars for included file.
+\def\includezzz#1{\endgroup\begingroup
+ % Read the included file in a group so nested @include's work.
+ \def\thisfile{#1}%
+ \input\thisfile
+\endgroup}
+
+\def\thisfile{}
+
+% @center line outputs that line, centered
+
+\def\center{\parsearg\centerzzz}
+\def\centerzzz #1{{\advance\hsize by -\leftskip
+\advance\hsize by -\rightskip
+\centerline{#1}}}
+
+% @sp n outputs n lines of vertical space
+
+\def\sp{\parsearg\spxxx}
+\def\spxxx #1{\vskip #1\baselineskip}
+
+% @comment ...line which is ignored...
+% @c is the same as @comment
+% @ignore ... @end ignore is another way to write a comment
+
+\def\comment{\catcode 64=\other \catcode 123=\other \catcode 125=\other%
+\parsearg \commentxxx}
+
+\def\commentxxx #1{\catcode 64=0 \catcode 123=1 \catcode 125=2 }
+
+\let\c=\comment
+
+% @paragraphindent is defined for the Info formatting commands only.
+\let\paragraphindent=\comment
+
+% Prevent errors for section commands.
+% Used in @ignore and in failing conditionals.
+\def\ignoresections{%
+\let\chapter=\relax
+\let\unnumbered=\relax
+\let\top=\relax
+\let\unnumberedsec=\relax
+\let\unnumberedsection=\relax
+\let\unnumberedsubsec=\relax
+\let\unnumberedsubsection=\relax
+\let\unnumberedsubsubsec=\relax
+\let\unnumberedsubsubsection=\relax
+\let\section=\relax
+\let\subsec=\relax
+\let\subsubsec=\relax
+\let\subsection=\relax
+\let\subsubsection=\relax
+\let\appendix=\relax
+\let\appendixsec=\relax
+\let\appendixsection=\relax
+\let\appendixsubsec=\relax
+\let\appendixsubsection=\relax
+\let\appendixsubsubsec=\relax
+\let\appendixsubsubsection=\relax
+\let\contents=\relax
+\let\smallbook=\relax
+\let\titlepage=\relax
+}
+
+% Used in nested conditionals, where we have to parse the Texinfo source
+% and so want to turn off most commands, in case they are used
+% incorrectly.
+%
+\def\ignoremorecommands{%
+ \let\defcodeindex = \relax
+ \let\defcv = \relax
+ \let\deffn = \relax
+ \let\deffnx = \relax
+ \let\defindex = \relax
+ \let\defivar = \relax
+ \let\defmac = \relax
+ \let\defmethod = \relax
+ \let\defop = \relax
+ \let\defopt = \relax
+ \let\defspec = \relax
+ \let\deftp = \relax
+ \let\deftypefn = \relax
+ \let\deftypefun = \relax
+ \let\deftypevar = \relax
+ \let\deftypevr = \relax
+ \let\defun = \relax
+ \let\defvar = \relax
+ \let\defvr = \relax
+ \let\ref = \relax
+ \let\xref = \relax
+ \let\printindex = \relax
+ \let\pxref = \relax
+ \let\settitle = \relax
+ \let\setchapternewpage = \relax
+ \let\setchapterstyle = \relax
+ \let\everyheading = \relax
+ \let\evenheading = \relax
+ \let\oddheading = \relax
+ \let\everyfooting = \relax
+ \let\evenfooting = \relax
+ \let\oddfooting = \relax
+ \let\headings = \relax
+ \let\include = \relax
+ \let\lowersections = \relax
+ \let\down = \relax
+ \let\raisesections = \relax
+ \let\up = \relax
+ \let\set = \relax
+ \let\clear = \relax
+ \let\item = \relax
+}
+
+% Ignore @ignore ... @end ignore.
+%
+\def\ignore{\doignore{ignore}}
+
+% Also ignore @ifinfo, @ifhtml, @html, @menu, and @direntry text.
+%
+\def\ifinfo{\doignore{ifinfo}}
+\def\ifhtml{\doignore{ifhtml}}
+\def\html{\doignore{html}}
+\def\menu{\doignore{menu}}
+\def\direntry{\doignore{direntry}}
+
+% Also ignore @macro ... @end macro. The user must run texi2dvi,
+% which runs makeinfo to do macro expansion. Ignore @unmacro, too.
+\def\macro{\doignore{macro}}
+\let\unmacro = \comment
+
+
+% @dircategory CATEGORY -- specify a category of the dir file
+% which this file should belong to. Ignore this in TeX.
+\let\dircategory = \comment
+
+% Ignore text until a line `@end #1'.
+%
+\def\doignore#1{\begingroup
+ % Don't complain about control sequences we have declared \outer.
+ \ignoresections
+ %
+ % Define a command to swallow text until we reach `@end #1'.
+ \long\def\doignoretext##1\end #1{\enddoignore}%
+ %
+ % Make sure that spaces turn into tokens that match what \doignoretext wants.
+ \catcode32 = 10
+ %
+ % And now expand that command.
+ \doignoretext
+}
+
+% What we do to finish off ignored text.
+%
+\def\enddoignore{\endgroup\ignorespaces}%
+
+\newif\ifwarnedobs\warnedobsfalse
+\def\obstexwarn{%
+ \ifwarnedobs\relax\else
+ % We need to warn folks that they may have trouble with TeX 3.0.
+ % This uses \immediate\write16 rather than \message to get newlines.
+ \immediate\write16{}
+ \immediate\write16{***WARNING*** for users of Unix TeX 3.0!}
+ \immediate\write16{This manual trips a bug in TeX version 3.0 (tex hangs).}
+ \immediate\write16{If you are running another version of TeX, relax.}
+ \immediate\write16{If you are running Unix TeX 3.0, kill this TeX process.}
+ \immediate\write16{ Then upgrade your TeX installation if you can.}
+ \immediate\write16{ (See ftp://ftp.gnu.ai.mit.edu/pub/gnu/TeX.README.)}
+ \immediate\write16{If you are stuck with version 3.0, run the}
+ \immediate\write16{ script ``tex3patch'' from the Texinfo distribution}
+ \immediate\write16{ to use a workaround.}
+ \immediate\write16{}
+ \global\warnedobstrue
+ \fi
+}
+
+% **In TeX 3.0, setting text in \nullfont hangs tex. For a
+% workaround (which requires the file ``dummy.tfm'' to be installed),
+% uncomment the following line:
+%%%%%\font\nullfont=dummy\let\obstexwarn=\relax
+
+% Ignore text, except that we keep track of conditional commands for
+% purposes of nesting, up to an `@end #1' command.
+%
+\def\nestedignore#1{%
+ \obstexwarn
+ % We must actually expand the ignored text to look for the @end
+ % command, so that nested ignore constructs work. Thus, we put the
+ % text into a \vbox and then do nothing with the result. To minimize
+ % the change of memory overflow, we follow the approach outlined on
+ % page 401 of the TeXbook: make the current font be a dummy font.
+ %
+ \setbox0 = \vbox\bgroup
+ % Don't complain about control sequences we have declared \outer.
+ \ignoresections
+ %
+ % Define `@end #1' to end the box, which will in turn undefine the
+ % @end command again.
+ \expandafter\def\csname E#1\endcsname{\egroup\ignorespaces}%
+ %
+ % We are going to be parsing Texinfo commands. Most cause no
+ % trouble when they are used incorrectly, but some commands do
+ % complicated argument parsing or otherwise get confused, so we
+ % undefine them.
+ %
+ % We can't do anything about stray @-signs, unfortunately;
+ % they'll produce `undefined control sequence' errors.
+ \ignoremorecommands
+ %
+ % Set the current font to be \nullfont, a TeX primitive, and define
+ % all the font commands to also use \nullfont. We don't use
+ % dummy.tfm, as suggested in the TeXbook, because not all sites
+ % might have that installed. Therefore, math mode will still
+ % produce output, but that should be an extremely small amount of
+ % stuff compared to the main input.
+ %
+ \nullfont
+ \let\tenrm = \nullfont \let\tenit = \nullfont \let\tensl = \nullfont
+ \let\tenbf = \nullfont \let\tentt = \nullfont \let\smallcaps = \nullfont
+ \let\tensf = \nullfont
+ % Similarly for index fonts (mostly for their use in
+ % smallexample)
+ \let\indrm = \nullfont \let\indit = \nullfont \let\indsl = \nullfont
+ \let\indbf = \nullfont \let\indtt = \nullfont \let\indsc = \nullfont
+ \let\indsf = \nullfont
+ %
+ % Don't complain when characters are missing from the fonts.
+ \tracinglostchars = 0
+ %
+ % Don't bother to do space factor calculations.
+ \frenchspacing
+ %
+ % Don't report underfull hboxes.
+ \hbadness = 10000
+ %
+ % Do minimal line-breaking.
+ \pretolerance = 10000
+ %
+ % Do not execute instructions in @tex
+ \def\tex{\doignore{tex}}
+}
+
+% @set VAR sets the variable VAR to an empty value.
+% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE.
+%
+% Since we want to separate VAR from REST-OF-LINE (which might be
+% empty), we can't just use \parsearg; we have to insert a space of our
+% own to delimit the rest of the line, and then take it out again if we
+% didn't need it. Make sure the catcode of space is correct to avoid
+% losing inside @example, for instance.
+%
+\def\set{\begingroup\catcode` =10
+ \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR.
+ \parsearg\setxxx}
+\def\setxxx#1{\setyyy#1 \endsetyyy}
+\def\setyyy#1 #2\endsetyyy{%
+ \def\temp{#2}%
+ \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty
+ \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted.
+ \fi
+ \endgroup
+}
+% Can't use \xdef to pre-expand #2 and save some time, since \temp or
+% \next or other control sequences that we've defined might get us into
+% an infinite loop. Consider `@set foo @cite{bar}'.
+\def\setzzz#1#2 \endsetzzz{\expandafter\gdef\csname SET#1\endcsname{#2}}
+
+% @clear VAR clears (i.e., unsets) the variable VAR.
+%
+\def\clear{\parsearg\clearxxx}
+\def\clearxxx#1{\global\expandafter\let\csname SET#1\endcsname=\relax}
+
+% @value{foo} gets the text saved in variable foo.
+%
+\def\value{\begingroup
+ \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR.
+ \valuexxx}
+\def\valuexxx#1{%
+ \expandafter\ifx\csname SET#1\endcsname\relax
+ {\{No value for ``#1''\}}%
+ \else
+ \csname SET#1\endcsname
+ \fi
+\endgroup}
+
+% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined
+% with @set.
+%
+\def\ifset{\parsearg\ifsetxxx}
+\def\ifsetxxx #1{%
+ \expandafter\ifx\csname SET#1\endcsname\relax
+ \expandafter\ifsetfail
+ \else
+ \expandafter\ifsetsucceed
+ \fi
+}
+\def\ifsetsucceed{\conditionalsucceed{ifset}}
+\def\ifsetfail{\nestedignore{ifset}}
+\defineunmatchedend{ifset}
+
+% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been
+% defined with @set, or has been undefined with @clear.
+%
+\def\ifclear{\parsearg\ifclearxxx}
+\def\ifclearxxx #1{%
+ \expandafter\ifx\csname SET#1\endcsname\relax
+ \expandafter\ifclearsucceed
+ \else
+ \expandafter\ifclearfail
+ \fi
+}
+\def\ifclearsucceed{\conditionalsucceed{ifclear}}
+\def\ifclearfail{\nestedignore{ifclear}}
+\defineunmatchedend{ifclear}
+
+% @iftex always succeeds; we read the text following, through @end
+% iftex). But `@end iftex' should be valid only after an @iftex.
+%
+\def\iftex{\conditionalsucceed{iftex}}
+\defineunmatchedend{iftex}
+
+% We can't just want to start a group at @iftex (for example) and end it
+% at @end iftex, since then @set commands inside the conditional have no
+% effect (they'd get reverted at the end of the group). So we must
+% define \Eiftex to redefine itself to be its previous value. (We can't
+% just define it to fail again with an ``unmatched end'' error, since
+% the @ifset might be nested.)
+%
+\def\conditionalsucceed#1{%
+ \edef\temp{%
+ % Remember the current value of \E#1.
+ \let\nece{prevE#1} = \nece{E#1}%
+ %
+ % At the `@end #1', redefine \E#1 to be its previous value.
+ \def\nece{E#1}{\let\nece{E#1} = \nece{prevE#1}}%
+ }%
+ \temp
+}
+
+% We need to expand lots of \csname's, but we don't want to expand the
+% control sequences after we've constructed them.
+%
+\def\nece#1{\expandafter\noexpand\csname#1\endcsname}
+
+% @asis just yields its argument. Used with @table, for example.
+%
+\def\asis#1{#1}
+
+% @math means output in math mode.
+% We don't use $'s directly in the definition of \math because control
+% sequences like \math are expanded when the toc file is written. Then,
+% we read the toc file back, the $'s will be normal characters (as they
+% should be, according to the definition of Texinfo). So we must use a
+% control sequence to switch into and out of math mode.
+%
+% This isn't quite enough for @math to work properly in indices, but it
+% seems unlikely it will ever be needed there.
+%
+\let\implicitmath = $
+\def\math#1{\implicitmath #1\implicitmath}
+
+% @bullet and @minus need the same treatment as @math, just above.
+\def\bullet{\implicitmath\ptexbullet\implicitmath}
+\def\minus{\implicitmath-\implicitmath}
+
+\def\node{\ENVcheck\parsearg\nodezzz}
+\def\nodezzz#1{\nodexxx [#1,]}
+\def\nodexxx[#1,#2]{\gdef\lastnode{#1}}
+\let\nwnode=\node
+\let\lastnode=\relax
+
+\def\donoderef{\ifx\lastnode\relax\else
+\expandafter\expandafter\expandafter\setref{\lastnode}\fi
+\global\let\lastnode=\relax}
+
+\def\unnumbnoderef{\ifx\lastnode\relax\else
+\expandafter\expandafter\expandafter\unnumbsetref{\lastnode}\fi
+\global\let\lastnode=\relax}
+
+\def\appendixnoderef{\ifx\lastnode\relax\else
+\expandafter\expandafter\expandafter\appendixsetref{\lastnode}\fi
+\global\let\lastnode=\relax}
+
+% @refill is a no-op.
+\let\refill=\relax
+
+% @setfilename is done at the beginning of every texinfo file.
+% So open here the files we need to have open while reading the input.
+% This makes it possible to make a .fmt file for texinfo.
+\def\setfilename{%
+ \readauxfile
+ \opencontents
+ \openindices
+ \fixbackslash % Turn off hack to swallow `\input texinfo'.
+ \global\let\setfilename=\comment % Ignore extra @setfilename cmds.
+ \comment % Ignore the actual filename.
+}
+
+% @bye.
+\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend}
+
+% \def\macro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\macroxxx}
+% \def\macroxxx#1#2 \end macro{%
+% \expandafter\gdef\macrotemp#1{#2}%
+% \endgroup}
+
+%\def\linemacro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\linemacroxxx}
+%\def\linemacroxxx#1#2 \end linemacro{%
+%\let\parsearg=\relax
+%\edef\macrotempx{\csname M\butfirst\expandafter\string\macrotemp\endcsname}%
+%\expandafter\xdef\macrotemp{\parsearg\macrotempx}%
+%\expandafter\gdef\macrotempx#1{#2}%
+%\endgroup}
+
+%\def\butfirst#1{}
+
+
+\message{fonts,}
+
+% Font-change commands.
+
+% Texinfo supports the sans serif font style, which plain TeX does not.
+% So we set up a \sf analogous to plain's \rm, etc.
+\newfam\sffam
+\def\sf{\fam=\sffam \tensf}
+\let\li = \sf % Sometimes we call it \li, not \sf.
+
+% We don't need math for this one.
+\def\ttsl{\tenttsl}
+
+%% Try out Computer Modern fonts at \magstephalf
+\let\mainmagstep=\magstephalf
+
+% Set the font macro #1 to the font named #2, adding on the
+% specified font prefix (normally `cm').
+% #3 is the font's design size, #4 is a scale factor
+\def\setfont#1#2#3#4{\font#1=\fontprefix#2#3 scaled #4}
+
+% Use cm as the default font prefix.
+% To specify the font prefix, you must define \fontprefix
+% before you read in texinfo.tex.
+\ifx\fontprefix\undefined
+\def\fontprefix{cm}
+\fi
+% Support font families that don't use the same naming scheme as CM.
+\def\rmshape{r}
+\def\rmbshape{bx} %where the normal face is bold
+\def\bfshape{b}
+\def\bxshape{bx}
+\def\ttshape{tt}
+\def\ttbshape{tt}
+\def\ttslshape{sltt}
+\def\itshape{ti}
+\def\itbshape{bxti}
+\def\slshape{sl}
+\def\slbshape{bxsl}
+\def\sfshape{ss}
+\def\sfbshape{ss}
+\def\scshape{csc}
+\def\scbshape{csc}
+
+\ifx\bigger\relax
+\let\mainmagstep=\magstep1
+\setfont\textrm\rmshape{12}{1000}
+\setfont\texttt\ttshape{12}{1000}
+\else
+\setfont\textrm\rmshape{10}{\mainmagstep}
+\setfont\texttt\ttshape{10}{\mainmagstep}
+\fi
+% Instead of cmb10, you many want to use cmbx10.
+% cmbx10 is a prettier font on its own, but cmb10
+% looks better when embedded in a line with cmr10.
+\setfont\textbf\bfshape{10}{\mainmagstep}
+\setfont\textit\itshape{10}{\mainmagstep}
+\setfont\textsl\slshape{10}{\mainmagstep}
+\setfont\textsf\sfshape{10}{\mainmagstep}
+\setfont\textsc\scshape{10}{\mainmagstep}
+\setfont\textttsl\ttslshape{10}{\mainmagstep}
+\font\texti=cmmi10 scaled \mainmagstep
+\font\textsy=cmsy10 scaled \mainmagstep
+
+% A few fonts for @defun, etc.
+\setfont\defbf\bxshape{10}{\magstep1} %was 1314
+\setfont\deftt\ttshape{10}{\magstep1}
+\def\df{\let\tentt=\deftt \let\tenbf = \defbf \bf}
+
+% Fonts for indices and small examples (9pt).
+% We actually use the slanted font rather than the italic,
+% because texinfo normally uses the slanted fonts for that.
+% Do not make many font distinctions in general in the index, since they
+% aren't very useful.
+\setfont\ninett\ttshape{9}{1000}
+\setfont\indrm\rmshape{9}{1000}
+\setfont\indit\slshape{9}{1000}
+\let\indsl=\indit
+\let\indtt=\ninett
+\let\indttsl=\ninett
+\let\indsf=\indrm
+\let\indbf=\indrm
+\setfont\indsc\scshape{10}{900}
+\font\indi=cmmi9
+\font\indsy=cmsy9
+
+% Chapter (and unnumbered) fonts (17.28pt).
+\setfont\chaprm\rmbshape{12}{\magstep2}
+\setfont\chapit\itbshape{10}{\magstep3}
+\setfont\chapsl\slbshape{10}{\magstep3}
+\setfont\chaptt\ttbshape{12}{\magstep2}
+\setfont\chapttsl\ttslshape{10}{\magstep3}
+\setfont\chapsf\sfbshape{12}{\magstep2}
+\let\chapbf=\chaprm
+\setfont\chapsc\scbshape{10}{\magstep3}
+\font\chapi=cmmi12 scaled \magstep2
+\font\chapsy=cmsy10 scaled \magstep3
+
+% Section fonts (14.4pt).
+\setfont\secrm\rmbshape{12}{\magstep1}
+\setfont\secit\itbshape{10}{\magstep2}
+\setfont\secsl\slbshape{10}{\magstep2}
+\setfont\sectt\ttbshape{12}{\magstep1}
+\setfont\secttsl\ttslshape{10}{\magstep2}
+\setfont\secsf\sfbshape{12}{\magstep1}
+\let\secbf\secrm
+\setfont\secsc\scbshape{10}{\magstep2}
+\font\seci=cmmi12 scaled \magstep1
+\font\secsy=cmsy10 scaled \magstep2
+
+% \setfont\ssecrm\bxshape{10}{\magstep1} % This size an font looked bad.
+% \setfont\ssecit\itshape{10}{\magstep1} % The letters were too crowded.
+% \setfont\ssecsl\slshape{10}{\magstep1}
+% \setfont\ssectt\ttshape{10}{\magstep1}
+% \setfont\ssecsf\sfshape{10}{\magstep1}
+
+%\setfont\ssecrm\bfshape{10}{1315} % Note the use of cmb rather than cmbx.
+%\setfont\ssecit\itshape{10}{1315} % Also, the size is a little larger than
+%\setfont\ssecsl\slshape{10}{1315} % being scaled magstep1.
+%\setfont\ssectt\ttshape{10}{1315}
+%\setfont\ssecsf\sfshape{10}{1315}
+
+%\let\ssecbf=\ssecrm
+
+% Subsection fonts (13.15pt).
+\setfont\ssecrm\rmbshape{12}{\magstephalf}
+\setfont\ssecit\itbshape{10}{1315}
+\setfont\ssecsl\slbshape{10}{1315}
+\setfont\ssectt\ttbshape{12}{\magstephalf}
+\setfont\ssecttsl\ttslshape{10}{\magstep1}
+\setfont\ssecsf\sfbshape{12}{\magstephalf}
+\let\ssecbf\ssecrm
+\setfont\ssecsc\scbshape{10}{\magstep1}
+\font\sseci=cmmi12 scaled \magstephalf
+\font\ssecsy=cmsy10 scaled \magstep1
+% The smallcaps and symbol fonts should actually be scaled \magstep1.5,
+% but that is not a standard magnification.
+
+% Fonts for title page:
+\setfont\titlerm\rmbshape{12}{\magstep3}
+\let\authorrm = \secrm
+
+% In order for the font changes to affect most math symbols and letters,
+% we have to define the \textfont of the standard families. Since
+% texinfo doesn't allow for producing subscripts and superscripts, we
+% don't bother to reset \scriptfont and \scriptscriptfont (which would
+% also require loading a lot more fonts).
+%
+\def\resetmathfonts{%
+ \textfont0 = \tenrm \textfont1 = \teni \textfont2 = \tensy
+ \textfont\itfam = \tenit \textfont\slfam = \tensl \textfont\bffam = \tenbf
+ \textfont\ttfam = \tentt \textfont\sffam = \tensf
+}
+
+
+% The font-changing commands redefine the meanings of \tenSTYLE, instead
+% of just \STYLE. We do this so that font changes will continue to work
+% in math mode, where it is the current \fam that is relevant in most
+% cases, not the current font. Plain TeX does \def\bf{\fam=\bffam
+% \tenbf}, for example. By redefining \tenbf, we obviate the need to
+% redefine \bf itself.
+\def\textfonts{%
+ \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl
+ \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc
+ \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy \let\tenttsl=\textttsl
+ \resetmathfonts}
+\def\chapfonts{%
+ \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl
+ \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc
+ \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy \let\tenttsl=\chapttsl
+ \resetmathfonts \setleading{19pt}}
+\def\secfonts{%
+ \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl
+ \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc
+ \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy \let\tenttsl=\secttsl
+ \resetmathfonts \setleading{16pt}}
+\def\subsecfonts{%
+ \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl
+ \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc
+ \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy \let\tenttsl=\ssecttsl
+ \resetmathfonts \setleading{15pt}}
+\let\subsubsecfonts = \subsecfonts % Maybe make sssec fonts scaled magstephalf?
+\def\indexfonts{%
+ \let\tenrm=\indrm \let\tenit=\indit \let\tensl=\indsl
+ \let\tenbf=\indbf \let\tentt=\indtt \let\smallcaps=\indsc
+ \let\tensf=\indsf \let\teni=\indi \let\tensy=\indsy \let\tenttsl=\indttsl
+ \resetmathfonts \setleading{12pt}}
+
+% Set up the default fonts, so we can use them for creating boxes.
+%
+\textfonts
+
+% Count depth in font-changes, for error checks
+\newcount\fontdepth \fontdepth=0
+
+% Fonts for short table of contents.
+\setfont\shortcontrm\rmshape{12}{1000}
+\setfont\shortcontbf\bxshape{12}{1000}
+\setfont\shortcontsl\slshape{12}{1000}
+
+%% Add scribe-like font environments, plus @l for inline lisp (usually sans
+%% serif) and @ii for TeX italic
+
+% \smartitalic{ARG} outputs arg in italics, followed by an italic correction
+% unless the following character is such as not to need one.
+\def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else\/\fi\fi\fi}
+\def\smartitalic#1{{\sl #1}\futurelet\next\smartitalicx}
+
+\let\i=\smartitalic
+\let\var=\smartitalic
+\let\dfn=\smartitalic
+\let\emph=\smartitalic
+\let\cite=\smartitalic
+
+\def\b#1{{\bf #1}}
+\let\strong=\b
+
+% We can't just use \exhyphenpenalty, because that only has effect at
+% the end of a paragraph. Restore normal hyphenation at the end of the
+% group within which \nohyphenation is presumably called.
+%
+\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation}
+\def\restorehyphenation{\hyphenchar\font = `- }
+
+\def\t#1{%
+ {\tt \rawbackslash \frenchspacing #1}%
+ \null
+}
+\let\ttfont=\t
+\def\samp #1{`\tclose{#1}'\null}
+\setfont\smallrm\rmshape{8}{1000}
+\font\smallsy=cmsy9
+\def\key#1{{\smallrm\textfont2=\smallsy \leavevmode\hbox{%
+ \raise0.4pt\hbox{$\langle$}\kern-.08em\vtop{%
+ \vbox{\hrule\kern-0.4pt
+ \hbox{\raise0.4pt\hbox{\vphantom{$\langle$}}#1}}%
+ \kern-0.4pt\hrule}%
+ \kern-.06em\raise0.4pt\hbox{$\rangle$}}}}
+% The old definition, with no lozenge:
+%\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null}
+\def\ctrl #1{{\tt \rawbackslash \hat}#1}
+
+\let\file=\samp
+
+% @code is a modification of @t,
+% which makes spaces the same size as normal in the surrounding text.
+\def\tclose#1{%
+ {%
+ % Change normal interword space to be same as for the current font.
+ \spaceskip = \fontdimen2\font
+ %
+ % Switch to typewriter.
+ \tt
+ %
+ % But `\ ' produces the large typewriter interword space.
+ \def\ {{\spaceskip = 0pt{} }}%
+ %
+ % Turn off hyphenation.
+ \nohyphenation
+ %
+ \rawbackslash
+ \frenchspacing
+ #1%
+ }%
+ \null
+}
+
+% We *must* turn on hyphenation at `-' and `_' in \code.
+% Otherwise, it is too hard to avoid overfull hboxes
+% in the Emacs manual, the Library manual, etc.
+
+% Unfortunately, TeX uses one parameter (\hyphenchar) to control
+% both hyphenation at - and hyphenation within words.
+% We must therefore turn them both off (\tclose does that)
+% and arrange explicitly to hyphenate at a dash.
+% -- rms.
+{
+\catcode`\-=\active
+\catcode`\_=\active
+\catcode`\|=\active
+\global\def\code{\begingroup \catcode`\-=\active \let-\codedash \catcode`\_=\active \let_\codeunder \codex}
+% The following is used by \doprintindex to insure that long function names
+% wrap around. It is necessary for - and _ to be active before the index is
+% read from the file, as \entry parses the arguments long before \code is
+% ever called. -- mycroft
+% _ is always active; and it shouldn't be \let = to an _ that is a
+% subscript character anyway. Then, @cindex @samp{_} (for example)
+% fails. --karl
+\global\def\indexbreaks{%
+ \catcode`\-=\active \let-\realdash
+}
+}
+
+\def\realdash{-}
+\def\codedash{-\discretionary{}{}{}}
+\def\codeunder{\ifusingtt{\normalunderscore\discretionary{}{}{}}{\_}}
+\def\codex #1{\tclose{#1}\endgroup}
+
+%\let\exp=\tclose %Was temporary
+
+% @kbd is like @code, except that if the argument is just one @key command,
+% then @kbd has no effect.
+%
+\def\xkey{\key}
+\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}%
+\ifx\one\xkey\ifx\threex\three \key{#2}%
+\else{\tclose{\ttsl\look}}\fi
+\else{\tclose{\ttsl\look}}\fi}
+
+% @url, @email. Quotes do not seem necessary.
+\let\url=\code % perhaps include a hypertex \special eventually
+% rms does not like the angle brackets --karl, 17may97.
+%\def\email#1{$\langle${\tt #1}$\rangle$}
+\let\email=\code
+
+% Check if we are currently using a typewriter font. Since all the
+% Computer Modern typewriter fonts have zero interword stretch (and
+% shrink), and it is reasonable to expect all typewriter fonts to have
+% this property, we can check that font parameter.
+%
+\def\ifmonospace{\ifdim\fontdimen3\font=0pt }
+
+% Typeset a dimension, e.g., `in' or `pt'. The only reason for the
+% argument is to make the input look right: @dmn{pt} instead of
+% @dmn{}pt.
+%
+\def\dmn#1{\thinspace #1}
+
+\def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par}
+
+% @l was never documented to mean ``switch to the Lisp font'',
+% and it is not used as such in any manual I can find. We need it for
+% Polish suppressed-l. --karl, 22sep96.
+%\def\l#1{{\li #1}\null}
+
+\def\r#1{{\rm #1}} % roman font
+% Use of \lowercase was suggested.
+\def\sc#1{{\smallcaps#1}} % smallcaps font
+\def\ii#1{{\it #1}} % italic font
+
+% @pounds{} is a sterling sign.
+\def\pounds{{\it\$}}
+
+
+\message{page headings,}
+
+\newskip\titlepagetopglue \titlepagetopglue = 1.5in
+\newskip\titlepagebottomglue \titlepagebottomglue = 2pc
+
+% First the title page. Must do @settitle before @titlepage.
+\def\titlefont#1{{\titlerm #1}}
+
+\newif\ifseenauthor
+\newif\iffinishedtitlepage
+
+\def\shorttitlepage{\parsearg\shorttitlepagezzz}
+\def\shorttitlepagezzz #1{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}%
+ \endgroup\page\hbox{}\page}
+
+\def\titlepage{\begingroup \parindent=0pt \textfonts
+ \let\subtitlerm=\tenrm
+% I deinstalled the following change because \cmr12 is undefined.
+% This change was not in the ChangeLog anyway. --rms.
+% \let\subtitlerm=\cmr12
+ \def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}%
+ %
+ \def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines}%
+ %
+ % Leave some space at the very top of the page.
+ \vglue\titlepagetopglue
+ %
+ % Now you can print the title using @title.
+ \def\title{\parsearg\titlezzz}%
+ \def\titlezzz##1{\leftline{\titlefont{##1}}
+ % print a rule at the page bottom also.
+ \finishedtitlepagefalse
+ \vskip4pt \hrule height 4pt width \hsize \vskip4pt}%
+ % No rule at page bottom unless we print one at the top with @title.
+ \finishedtitlepagetrue
+ %
+ % Now you can put text using @subtitle.
+ \def\subtitle{\parsearg\subtitlezzz}%
+ \def\subtitlezzz##1{{\subtitlefont \rightline{##1}}}%
+ %
+ % @author should come last, but may come many times.
+ \def\author{\parsearg\authorzzz}%
+ \def\authorzzz##1{\ifseenauthor\else\vskip 0pt plus 1filll\seenauthortrue\fi
+ {\authorfont \leftline{##1}}}%
+ %
+ % Most title ``pages'' are actually two pages long, with space
+ % at the top of the second. We don't want the ragged left on the second.
+ \let\oldpage = \page
+ \def\page{%
+ \iffinishedtitlepage\else
+ \finishtitlepage
+ \fi
+ \oldpage
+ \let\page = \oldpage
+ \hbox{}}%
+% \def\page{\oldpage \hbox{}}
+}
+
+\def\Etitlepage{%
+ \iffinishedtitlepage\else
+ \finishtitlepage
+ \fi
+ % It is important to do the page break before ending the group,
+ % because the headline and footline are only empty inside the group.
+ % If we use the new definition of \page, we always get a blank page
+ % after the title page, which we certainly don't want.
+ \oldpage
+ \endgroup
+ \HEADINGSon
+}
+
+\def\finishtitlepage{%
+ \vskip4pt \hrule height 2pt width \hsize
+ \vskip\titlepagebottomglue
+ \finishedtitlepagetrue
+}
+
+%%% Set up page headings and footings.
+
+\let\thispage=\folio
+
+\newtoks \evenheadline % Token sequence for heading line of even pages
+\newtoks \oddheadline % Token sequence for heading line of odd pages
+\newtoks \evenfootline % Token sequence for footing line of even pages
+\newtoks \oddfootline % Token sequence for footing line of odd pages
+
+% Now make Tex use those variables
+\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline
+ \else \the\evenheadline \fi}}
+\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline
+ \else \the\evenfootline \fi}\HEADINGShook}
+\let\HEADINGShook=\relax
+
+% Commands to set those variables.
+% For example, this is what @headings on does
+% @evenheading @thistitle|@thispage|@thischapter
+% @oddheading @thischapter|@thispage|@thistitle
+% @evenfooting @thisfile||
+% @oddfooting ||@thisfile
+
+\def\evenheading{\parsearg\evenheadingxxx}
+\def\oddheading{\parsearg\oddheadingxxx}
+\def\everyheading{\parsearg\everyheadingxxx}
+
+\def\evenfooting{\parsearg\evenfootingxxx}
+\def\oddfooting{\parsearg\oddfootingxxx}
+\def\everyfooting{\parsearg\everyfootingxxx}
+
+{\catcode`\@=0 %
+
+\gdef\evenheadingxxx #1{\evenheadingyyy #1@|@|@|@|\finish}
+\gdef\evenheadingyyy #1@|#2@|#3@|#4\finish{%
+\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\oddheadingxxx #1{\oddheadingyyy #1@|@|@|@|\finish}
+\gdef\oddheadingyyy #1@|#2@|#3@|#4\finish{%
+\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\everyheadingxxx #1{\everyheadingyyy #1@|@|@|@|\finish}
+\gdef\everyheadingyyy #1@|#2@|#3@|#4\finish{%
+\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}
+\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\evenfootingxxx #1{\evenfootingyyy #1@|@|@|@|\finish}
+\gdef\evenfootingyyy #1@|#2@|#3@|#4\finish{%
+\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\oddfootingxxx #1{\oddfootingyyy #1@|@|@|@|\finish}
+\gdef\oddfootingyyy #1@|#2@|#3@|#4\finish{%
+\global\oddfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+
+\gdef\everyfootingxxx #1{\everyfootingyyy #1@|@|@|@|\finish}
+\gdef\everyfootingyyy #1@|#2@|#3@|#4\finish{%
+\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}
+\global\oddfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
+%
+}% unbind the catcode of @.
+
+% @headings double turns headings on for double-sided printing.
+% @headings single turns headings on for single-sided printing.
+% @headings off turns them off.
+% @headings on same as @headings double, retained for compatibility.
+% @headings after turns on double-sided headings after this page.
+% @headings doubleafter turns on double-sided headings after this page.
+% @headings singleafter turns on single-sided headings after this page.
+% By default, they are off at the start of a document,
+% and turned `on' after @end titlepage.
+
+\def\headings #1 {\csname HEADINGS#1\endcsname}
+
+\def\HEADINGSoff{
+\global\evenheadline={\hfil} \global\evenfootline={\hfil}
+\global\oddheadline={\hfil} \global\oddfootline={\hfil}}
+\HEADINGSoff
+% When we turn headings on, set the page number to 1.
+% For double-sided printing, put current file name in lower left corner,
+% chapter name on inside top of right hand pages, document
+% title on inside top of left hand pages, and page numbers on outside top
+% edge of all pages.
+\def\HEADINGSdouble{
+\global\pageno=1
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\folio\hfil\thistitle}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chapoddpage
+}
+\let\contentsalignmacro = \chappager
+
+% For single-sided printing, chapter title goes across top left of page,
+% page number on top right.
+\def\HEADINGSsingle{
+\global\pageno=1
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chappager
+}
+\def\HEADINGSon{\HEADINGSdouble}
+
+\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex}
+\let\HEADINGSdoubleafter=\HEADINGSafter
+\def\HEADINGSdoublex{%
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\folio\hfil\thistitle}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chapoddpage
+}
+
+\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex}
+\def\HEADINGSsinglex{%
+\global\evenfootline={\hfil}
+\global\oddfootline={\hfil}
+\global\evenheadline={\line{\thischapter\hfil\folio}}
+\global\oddheadline={\line{\thischapter\hfil\folio}}
+\global\let\contentsalignmacro = \chappager
+}
+
+% Subroutines used in generating headings
+% Produces Day Month Year style of output.
+\def\today{\number\day\space
+\ifcase\month\or
+January\or February\or March\or April\or May\or June\or
+July\or August\or September\or October\or November\or December\fi
+\space\number\year}
+
+% Use this if you want the Month Day, Year style of output.
+%\def\today{\ifcase\month\or
+%January\or February\or March\or April\or May\or June\or
+%July\or August\or September\or October\or November\or December\fi
+%\space\number\day, \number\year}
+
+% @settitle line... specifies the title of the document, for headings
+% It generates no output of its own
+
+\def\thistitle{No Title}
+\def\settitle{\parsearg\settitlezzz}
+\def\settitlezzz #1{\gdef\thistitle{#1}}
+
+
+\message{tables,}
+
+% @tabs -- simple alignment
+
+% These don't work. For one thing, \+ is defined as outer.
+% So these macros cannot even be defined.
+
+%\def\tabs{\parsearg\tabszzz}
+%\def\tabszzz #1{\settabs\+#1\cr}
+%\def\tabline{\parsearg\tablinezzz}
+%\def\tablinezzz #1{\+#1\cr}
+%\def\&{&}
+
+% Tables -- @table, @ftable, @vtable, @item(x), @kitem(x), @xitem(x).
+
+% default indentation of table text
+\newdimen\tableindent \tableindent=.8in
+% default indentation of @itemize and @enumerate text
+\newdimen\itemindent \itemindent=.3in
+% margin between end of table item and start of table text.
+\newdimen\itemmargin \itemmargin=.1in
+
+% used internally for \itemindent minus \itemmargin
+\newdimen\itemmax
+
+% Note @table, @vtable, and @vtable define @item, @itemx, etc., with
+% these defs.
+% They also define \itemindex
+% to index the item name in whatever manner is desired (perhaps none).
+
+\newif\ifitemxneedsnegativevskip
+
+\def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi}
+
+\def\internalBitem{\smallbreak \parsearg\itemzzz}
+\def\internalBitemx{\itemxpar \parsearg\itemzzz}
+
+\def\internalBxitem "#1"{\def\xitemsubtopix{#1} \smallbreak \parsearg\xitemzzz}
+\def\internalBxitemx "#1"{\def\xitemsubtopix{#1} \itemxpar \parsearg\xitemzzz}
+
+\def\internalBkitem{\smallbreak \parsearg\kitemzzz}
+\def\internalBkitemx{\itemxpar \parsearg\kitemzzz}
+
+\def\kitemzzz #1{\dosubind {kw}{\code{#1}}{for {\bf \lastfunction}}%
+ \itemzzz {#1}}
+
+\def\xitemzzz #1{\dosubind {kw}{\code{#1}}{for {\bf \xitemsubtopic}}%
+ \itemzzz {#1}}
+
+\def\itemzzz #1{\begingroup %
+ \advance\hsize by -\rightskip
+ \advance\hsize by -\tableindent
+ \setbox0=\hbox{\itemfont{#1}}%
+ \itemindex{#1}%
+ \nobreak % This prevents a break before @itemx.
+ %
+ % Be sure we are not still in the middle of a paragraph.
+ %{\parskip = 0in
+ %\par
+ %}%
+ %
+ % If the item text does not fit in the space we have, put it on a line
+ % by itself, and do not allow a page break either before or after that
+ % line. We do not start a paragraph here because then if the next
+ % command is, e.g., @kindex, the whatsit would get put into the
+ % horizontal list on a line by itself, resulting in extra blank space.
+ \ifdim \wd0>\itemmax
+ %
+ % Make this a paragraph so we get the \parskip glue and wrapping,
+ % but leave it ragged-right.
+ \begingroup
+ \advance\leftskip by-\tableindent
+ \advance\hsize by\tableindent
+ \advance\rightskip by0pt plus1fil
+ \leavevmode\unhbox0\par
+ \endgroup
+ %
+ % We're going to be starting a paragraph, but we don't want the
+ % \parskip glue -- logically it's part of the @item we just started.
+ \nobreak \vskip-\parskip
+ %
+ % Stop a page break at the \parskip glue coming up. Unfortunately
+ % we can't prevent a possible page break at the following
+ % \baselineskip glue.
+ \nobreak
+ \endgroup
+ \itemxneedsnegativevskipfalse
+ \else
+ % The item text fits into the space. Start a paragraph, so that the
+ % following text (if any) will end up on the same line. Since that
+ % text will be indented by \tableindent, we make the item text be in
+ % a zero-width box.
+ \noindent
+ \rlap{\hskip -\tableindent\box0}\ignorespaces%
+ \endgroup%
+ \itemxneedsnegativevskiptrue%
+ \fi
+}
+
+\def\item{\errmessage{@item while not in a table}}
+\def\itemx{\errmessage{@itemx while not in a table}}
+\def\kitem{\errmessage{@kitem while not in a table}}
+\def\kitemx{\errmessage{@kitemx while not in a table}}
+\def\xitem{\errmessage{@xitem while not in a table}}
+\def\xitemx{\errmessage{@xitemx while not in a table}}
+
+%% Contains a kludge to get @end[description] to work
+\def\description{\tablez{\dontindex}{1}{}{}{}{}}
+
+\def\table{\begingroup\inENV\obeylines\obeyspaces\tablex}
+{\obeylines\obeyspaces%
+\gdef\tablex #1^^M{%
+\tabley\dontindex#1 \endtabley}}
+
+\def\ftable{\begingroup\inENV\obeylines\obeyspaces\ftablex}
+{\obeylines\obeyspaces%
+\gdef\ftablex #1^^M{%
+\tabley\fnitemindex#1 \endtabley
+\def\Eftable{\endgraf\afterenvbreak\endgroup}%
+\let\Etable=\relax}}
+
+\def\vtable{\begingroup\inENV\obeylines\obeyspaces\vtablex}
+{\obeylines\obeyspaces%
+\gdef\vtablex #1^^M{%
+\tabley\vritemindex#1 \endtabley
+\def\Evtable{\endgraf\afterenvbreak\endgroup}%
+\let\Etable=\relax}}
+
+\def\dontindex #1{}
+\def\fnitemindex #1{\doind {fn}{\code{#1}}}%
+\def\vritemindex #1{\doind {vr}{\code{#1}}}%
+
+{\obeyspaces %
+\gdef\tabley#1#2 #3 #4 #5 #6 #7\endtabley{\endgroup%
+\tablez{#1}{#2}{#3}{#4}{#5}{#6}}}
+
+\def\tablez #1#2#3#4#5#6{%
+\aboveenvbreak %
+\begingroup %
+\def\Edescription{\Etable}% Necessary kludge.
+\let\itemindex=#1%
+\ifnum 0#3>0 \advance \leftskip by #3\mil \fi %
+\ifnum 0#4>0 \tableindent=#4\mil \fi %
+\ifnum 0#5>0 \advance \rightskip by #5\mil \fi %
+\def\itemfont{#2}%
+\itemmax=\tableindent %
+\advance \itemmax by -\itemmargin %
+\advance \leftskip by \tableindent %
+\exdentamount=\tableindent
+\parindent = 0pt
+\parskip = \smallskipamount
+\ifdim \parskip=0pt \parskip=2pt \fi%
+\def\Etable{\endgraf\afterenvbreak\endgroup}%
+\let\item = \internalBitem %
+\let\itemx = \internalBitemx %
+\let\kitem = \internalBkitem %
+\let\kitemx = \internalBkitemx %
+\let\xitem = \internalBxitem %
+\let\xitemx = \internalBxitemx %
+}
+
+% This is the counter used by @enumerate, which is really @itemize
+
+\newcount \itemno
+
+\def\itemize{\parsearg\itemizezzz}
+
+\def\itemizezzz #1{%
+ \begingroup % ended by the @end itemsize
+ \itemizey {#1}{\Eitemize}
+}
+
+\def\itemizey #1#2{%
+\aboveenvbreak %
+\itemmax=\itemindent %
+\advance \itemmax by -\itemmargin %
+\advance \leftskip by \itemindent %
+\exdentamount=\itemindent
+\parindent = 0pt %
+\parskip = \smallskipamount %
+\ifdim \parskip=0pt \parskip=2pt \fi%
+\def#2{\endgraf\afterenvbreak\endgroup}%
+\def\itemcontents{#1}%
+\let\item=\itemizeitem}
+
+% Set sfcode to normal for the chars that usually have another value.
+% These are `.?!:;,'
+\def\frenchspacing{\sfcode46=1000 \sfcode63=1000 \sfcode33=1000
+ \sfcode58=1000 \sfcode59=1000 \sfcode44=1000 }
+
+% \splitoff TOKENS\endmark defines \first to be the first token in
+% TOKENS, and \rest to be the remainder.
+%
+\def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}%
+
+% Allow an optional argument of an uppercase letter, lowercase letter,
+% or number, to specify the first label in the enumerated list. No
+% argument is the same as `1'.
+%
+\def\enumerate{\parsearg\enumeratezzz}
+\def\enumeratezzz #1{\enumeratey #1 \endenumeratey}
+\def\enumeratey #1 #2\endenumeratey{%
+ \begingroup % ended by the @end enumerate
+ %
+ % If we were given no argument, pretend we were given `1'.
+ \def\thearg{#1}%
+ \ifx\thearg\empty \def\thearg{1}\fi
+ %
+ % Detect if the argument is a single token. If so, it might be a
+ % letter. Otherwise, the only valid thing it can be is a number.
+ % (We will always have one token, because of the test we just made.
+ % This is a good thing, since \splitoff doesn't work given nothing at
+ % all -- the first parameter is undelimited.)
+ \expandafter\splitoff\thearg\endmark
+ \ifx\rest\empty
+ % Only one token in the argument. It could still be anything.
+ % A ``lowercase letter'' is one whose \lccode is nonzero.
+ % An ``uppercase letter'' is one whose \lccode is both nonzero, and
+ % not equal to itself.
+ % Otherwise, we assume it's a number.
+ %
+ % We need the \relax at the end of the \ifnum lines to stop TeX from
+ % continuing to look for a <number>.
+ %
+ \ifnum\lccode\expandafter`\thearg=0\relax
+ \numericenumerate % a number (we hope)
+ \else
+ % It's a letter.
+ \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax
+ \lowercaseenumerate % lowercase letter
+ \else
+ \uppercaseenumerate % uppercase letter
+ \fi
+ \fi
+ \else
+ % Multiple tokens in the argument. We hope it's a number.
+ \numericenumerate
+ \fi
+}
+
+% An @enumerate whose labels are integers. The starting integer is
+% given in \thearg.
+%
+\def\numericenumerate{%
+ \itemno = \thearg
+ \startenumeration{\the\itemno}%
+}
+
+% The starting (lowercase) letter is in \thearg.
+\def\lowercaseenumerate{%
+ \itemno = \expandafter`\thearg
+ \startenumeration{%
+ % Be sure we're not beyond the end of the alphabet.
+ \ifnum\itemno=0
+ \errmessage{No more lowercase letters in @enumerate; get a bigger
+ alphabet}%
+ \fi
+ \char\lccode\itemno
+ }%
+}
+
+% The starting (uppercase) letter is in \thearg.
+\def\uppercaseenumerate{%
+ \itemno = \expandafter`\thearg
+ \startenumeration{%
+ % Be sure we're not beyond the end of the alphabet.
+ \ifnum\itemno=0
+ \errmessage{No more uppercase letters in @enumerate; get a bigger
+ alphabet}
+ \fi
+ \char\uccode\itemno
+ }%
+}
+
+% Call itemizey, adding a period to the first argument and supplying the
+% common last two arguments. Also subtract one from the initial value in
+% \itemno, since @item increments \itemno.
+%
+\def\startenumeration#1{%
+ \advance\itemno by -1
+ \itemizey{#1.}\Eenumerate\flushcr
+}
+
+% @alphaenumerate and @capsenumerate are abbreviations for giving an arg
+% to @enumerate.
+%
+\def\alphaenumerate{\enumerate{a}}
+\def\capsenumerate{\enumerate{A}}
+\def\Ealphaenumerate{\Eenumerate}
+\def\Ecapsenumerate{\Eenumerate}
+
+% Definition of @item while inside @itemize.
+
+\def\itemizeitem{%
+\advance\itemno by 1
+{\let\par=\endgraf \smallbreak}%
+\ifhmode \errmessage{In hmode at itemizeitem}\fi
+{\parskip=0in \hskip 0pt
+\hbox to 0pt{\hss \itemcontents\hskip \itemmargin}%
+\vadjust{\penalty 1200}}%
+\flushcr}
+
+% @multitable macros
+% Amy Hendrickson, 8/18/94, 3/6/96
+%
+% @multitable ... @end multitable will make as many columns as desired.
+% Contents of each column will wrap at width given in preamble. Width
+% can be specified either with sample text given in a template line,
+% or in percent of \hsize, the current width of text on page.
+
+% Table can continue over pages but will only break between lines.
+
+% To make preamble:
+%
+% Either define widths of columns in terms of percent of \hsize:
+% @multitable @columnfractions .25 .3 .45
+% @item ...
+%
+% Numbers following @columnfractions are the percent of the total
+% current hsize to be used for each column. You may use as many
+% columns as desired.
+
+
+% Or use a template:
+% @multitable {Column 1 template} {Column 2 template} {Column 3 template}
+% @item ...
+% using the widest term desired in each column.
+%
+% For those who want to use more than one line's worth of words in
+% the preamble, break the line within one argument and it
+% will parse correctly, i.e.,
+%
+% @multitable {Column 1 template} {Column 2 template} {Column 3
+% template}
+% Not:
+% @multitable {Column 1 template} {Column 2 template}
+% {Column 3 template}
+
+% Each new table line starts with @item, each subsequent new column
+% starts with @tab. Empty columns may be produced by supplying @tab's
+% with nothing between them for as many times as empty columns are needed,
+% ie, @tab@tab@tab will produce two empty columns.
+
+% @item, @tab, @multitable or @end multitable do not need to be on their
+% own lines, but it will not hurt if they are.
+
+% Sample multitable:
+
+% @multitable {Column 1 template} {Column 2 template} {Column 3 template}
+% @item first col stuff @tab second col stuff @tab third col
+% @item
+% first col stuff
+% @tab
+% second col stuff
+% @tab
+% third col
+% @item first col stuff @tab second col stuff
+% @tab Many paragraphs of text may be used in any column.
+%
+% They will wrap at the width determined by the template.
+% @item@tab@tab This will be in third column.
+% @end multitable
+
+% Default dimensions may be reset by user.
+% @multitableparskip is vertical space between paragraphs in table.
+% @multitableparindent is paragraph indent in table.
+% @multitablecolmargin is horizontal space to be left between columns.
+% @multitablelinespace is space to leave between table items, baseline
+% to baseline.
+% 0pt means it depends on current normal line spacing.
+
+%%%%
+% Dimensions
+
+\newskip\multitableparskip
+\newskip\multitableparindent
+\newdimen\multitablecolspace
+\newskip\multitablelinespace
+\multitableparskip=0pt
+\multitableparindent=6pt
+\multitablecolspace=12pt
+\multitablelinespace=0pt
+
+%%%%
+% Macros used to set up halign preamble:
+\let\endsetuptable\relax
+\def\xendsetuptable{\endsetuptable}
+\let\columnfractions\relax
+\def\xcolumnfractions{\columnfractions}
+\newif\ifsetpercent
+
+%% 2/1/96, to allow fractions to be given with more than one digit.
+\def\pickupwholefraction#1 {\global\advance\colcount by1 %
+\expandafter\xdef\csname col\the\colcount\endcsname{.#1\hsize}%
+\setuptable}
+
+\newcount\colcount
+\def\setuptable#1{\def\firstarg{#1}%
+\ifx\firstarg\xendsetuptable\let\go\relax%
+\else
+ \ifx\firstarg\xcolumnfractions\global\setpercenttrue%
+ \else
+ \ifsetpercent
+ \let\go\pickupwholefraction % In this case arg of setuptable
+ % is the decimal point before the
+ % number given in percent of hsize.
+ % We don't need this so we don't use it.
+ \else
+ \global\advance\colcount by1
+ \setbox0=\hbox{#1 }% Add a normal word space as a separator;
+ % typically that is always in the input, anyway.
+ \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}%
+ \fi%
+ \fi%
+\ifx\go\pickupwholefraction\else\let\go\setuptable\fi%
+\fi\go}
+
+%%%%
+% multitable syntax
+\def\tab{&\hskip1sp\relax} % 2/2/96
+ % tiny skip here makes sure this column space is
+ % maintained, even if it is never used.
+
+
+%%%%
+% @multitable ... @end multitable definitions:
+
+\def\multitable{\parsearg\dotable}
+
+\def\dotable#1{\bgroup
+\let\item\cr
+\tolerance=9500
+\hbadness=9500
+\setmultitablespacing
+\parskip=\multitableparskip
+\parindent=\multitableparindent
+\overfullrule=0pt
+\global\colcount=0\relax%
+\def\Emultitable{\global\setpercentfalse\global\everycr{}\cr\egroup\egroup}%
+ % To parse everything between @multitable and @item :
+\setuptable#1 \endsetuptable
+ % Need to reset this to 0 after \setuptable.
+\global\colcount=0\relax%
+ %
+ % This preamble sets up a generic column definition, which will
+ % be used as many times as user calls for columns.
+ % \vtop will set a single line and will also let text wrap and
+ % continue for many paragraphs if desired.
+\halign\bgroup&\global\advance\colcount by 1\relax%
+\multistrut\vtop{\hsize=\expandafter\csname col\the\colcount\endcsname
+ % In order to keep entries from bumping into each other
+ % we will add a \leftskip of \multitablecolspace to all columns after
+ % the first one.
+ % If a template has been used, we will add \multitablecolspace
+ % to the width of each template entry.
+ % If user has set preamble in terms of percent of \hsize
+ % we will use that dimension as the width of the column, and
+ % the \leftskip will keep entries from bumping into each other.
+ % Table will start at left margin and final column will justify at
+ % right margin.
+\ifnum\colcount=1
+\else
+ \ifsetpercent
+ \else
+ % If user has <not> set preamble in terms of percent of \hsize
+ % we will advance \hsize by \multitablecolspace
+ \advance\hsize by \multitablecolspace
+ \fi
+ % In either case we will make \leftskip=\multitablecolspace:
+\leftskip=\multitablecolspace
+\fi
+ % Ignoring space at the beginning and end avoids an occasional spurious
+ % blank line, when TeX decides to break the line at the space before the
+ % box from the multistrut, so the strut ends up on a line by itself.
+ % For example:
+ % @multitable @columnfractions .11 .89
+ % @item @code{#}
+ % @tab Legal holiday which is valid in major parts of the whole country.
+ % Is automatically provided with highlighting sequences respectively marking
+ % characters.
+ \noindent\ignorespaces##\unskip\multistrut}\cr
+ % \everycr will reset column counter, \colcount, at the end of
+ % each line. Every column entry will cause \colcount to advance by one.
+ % The table preamble
+ % looks at the current \colcount to find the correct column width.
+\global\everycr{\noalign{%
+% \filbreak%% keeps underfull box messages off when table breaks over pages.
+% Maybe so, but it also creates really weird page breaks when the table
+% breaks over pages Wouldn't \vfil be better? Wait until the problem
+% manifests itself, so it can be fixed for real --karl.
+\global\colcount=0\relax}}
+}
+
+\def\setmultitablespacing{% test to see if user has set \multitablelinespace.
+% If so, do nothing. If not, give it an appropriate dimension based on
+% current baselineskip.
+\ifdim\multitablelinespace=0pt
+%% strut to put in table in case some entry doesn't have descenders,
+%% to keep lines equally spaced
+\let\multistrut = \strut
+%% Test to see if parskip is larger than space between lines of
+%% table. If not, do nothing.
+%% If so, set to same dimension as multitablelinespace.
+\else
+\gdef\multistrut{\vrule height\multitablelinespace depth\dp0
+width0pt\relax} \fi
+\ifdim\multitableparskip>\multitablelinespace
+\global\multitableparskip=\multitablelinespace
+\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
+ %% than skip between lines in the table.
+\fi%
+\ifdim\multitableparskip=0pt
+\global\multitableparskip=\multitablelinespace
+\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
+ %% than skip between lines in the table.
+\fi}
+
+
+\message{indexing,}
+% Index generation facilities
+
+% Define \newwrite to be identical to plain tex's \newwrite
+% except not \outer, so it can be used within \newindex.
+{\catcode`\@=11
+\gdef\newwrite{\alloc@7\write\chardef\sixt@@n}}
+
+% \newindex {foo} defines an index named foo.
+% It automatically defines \fooindex such that
+% \fooindex ...rest of line... puts an entry in the index foo.
+% It also defines \fooindfile to be the number of the output channel for
+% the file that accumulates this index. The file's extension is foo.
+% The name of an index should be no more than 2 characters long
+% for the sake of vms.
+
+\def\newindex #1{
+\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file
+\openout \csname#1indfile\endcsname \jobname.#1 % Open the file
+\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex
+\noexpand\doindex {#1}}
+}
+
+% @defindex foo == \newindex{foo}
+
+\def\defindex{\parsearg\newindex}
+
+% Define @defcodeindex, like @defindex except put all entries in @code.
+
+\def\newcodeindex #1{
+\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file
+\openout \csname#1indfile\endcsname \jobname.#1 % Open the file
+\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex
+\noexpand\docodeindex {#1}}
+}
+
+\def\defcodeindex{\parsearg\newcodeindex}
+
+% @synindex foo bar makes index foo feed into index bar.
+% Do this instead of @defindex foo if you don't want it as a separate index.
+\def\synindex #1 #2 {%
+\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname
+\expandafter\let\csname#1indfile\endcsname=\synindexfoo
+\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex
+\noexpand\doindex {#2}}%
+}
+
+% @syncodeindex foo bar similar, but put all entries made for index foo
+% inside @code.
+\def\syncodeindex #1 #2 {%
+\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname
+\expandafter\let\csname#1indfile\endcsname=\synindexfoo
+\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex
+\noexpand\docodeindex {#2}}%
+}
+
+% Define \doindex, the driver for all \fooindex macros.
+% Argument #1 is generated by the calling \fooindex macro,
+% and it is "foo", the name of the index.
+
+% \doindex just uses \parsearg; it calls \doind for the actual work.
+% This is because \doind is more useful to call from other macros.
+
+% There is also \dosubind {index}{topic}{subtopic}
+% which makes an entry in a two-level index such as the operation index.
+
+\def\doindex#1{\edef\indexname{#1}\parsearg\singleindexer}
+\def\singleindexer #1{\doind{\indexname}{#1}}
+
+% like the previous two, but they put @code around the argument.
+\def\docodeindex#1{\edef\indexname{#1}\parsearg\singlecodeindexer}
+\def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}}
+
+\def\indexdummies{%
+% Take care of the plain tex accent commands.
+\def\"{\realbackslash "}%
+\def\`{\realbackslash `}%
+\def\'{\realbackslash '}%
+\def\^{\realbackslash ^}%
+\def\~{\realbackslash ~}%
+\def\={\realbackslash =}%
+\def\b{\realbackslash b}%
+\def\c{\realbackslash c}%
+\def\d{\realbackslash d}%
+\def\u{\realbackslash u}%
+\def\v{\realbackslash v}%
+\def\H{\realbackslash H}%
+% Take care of the plain tex special European modified letters.
+\def\oe{\realbackslash oe}%
+\def\ae{\realbackslash ae}%
+\def\aa{\realbackslash aa}%
+\def\OE{\realbackslash OE}%
+\def\AE{\realbackslash AE}%
+\def\AA{\realbackslash AA}%
+\def\o{\realbackslash o}%
+\def\O{\realbackslash O}%
+\def\l{\realbackslash l}%
+\def\L{\realbackslash L}%
+\def\ss{\realbackslash ss}%
+% Take care of texinfo commands likely to appear in an index entry.
+% (Must be a way to avoid doing expansion at all, and thus not have to
+% laboriously list every single command here.)
+\def\@{@}% will be @@ when we switch to @ as escape char.
+%\let\{ = \lbracecmd
+%\let\} = \rbracecmd
+\def\_{{\realbackslash _}}%
+\def\w{\realbackslash w }%
+\def\bf{\realbackslash bf }%
+%\def\rm{\realbackslash rm }%
+\def\sl{\realbackslash sl }%
+\def\sf{\realbackslash sf}%
+\def\tt{\realbackslash tt}%
+\def\gtr{\realbackslash gtr}%
+\def\less{\realbackslash less}%
+\def\hat{\realbackslash hat}%
+%\def\char{\realbackslash char}%
+\def\TeX{\realbackslash TeX}%
+\def\dots{\realbackslash dots }%
+\def\copyright{\realbackslash copyright }%
+\def\tclose##1{\realbackslash tclose {##1}}%
+\def\code##1{\realbackslash code {##1}}%
+\def\dotless##1{\realbackslash dotless {##1}}%
+\def\samp##1{\realbackslash samp {##1}}%
+\def\,##1{\realbackslash ,{##1}}%
+\def\t##1{\realbackslash t {##1}}%
+\def\r##1{\realbackslash r {##1}}%
+\def\i##1{\realbackslash i {##1}}%
+\def\b##1{\realbackslash b {##1}}%
+\def\sc##1{\realbackslash sc {##1}}%
+\def\cite##1{\realbackslash cite {##1}}%
+\def\key##1{\realbackslash key {##1}}%
+\def\file##1{\realbackslash file {##1}}%
+\def\var##1{\realbackslash var {##1}}%
+\def\kbd##1{\realbackslash kbd {##1}}%
+\def\dfn##1{\realbackslash dfn {##1}}%
+\def\emph##1{\realbackslash emph {##1}}%
+\unsepspaces
+}
+
+% If an index command is used in an @example environment, any spaces
+% therein should become regular spaces in the raw index file, not the
+% expansion of \tie (\\leavevmode \penalty \@M \ ).
+{\obeyspaces
+ \gdef\unsepspaces{\obeyspaces\let =\space}}
+
+% \indexnofonts no-ops all font-change commands.
+% This is used when outputting the strings to sort the index by.
+\def\indexdummyfont#1{#1}
+\def\indexdummytex{TeX}
+\def\indexdummydots{...}
+
+\def\indexnofonts{%
+% Just ignore accents.
+\let\,=\indexdummyfont
+\let\"=\indexdummyfont
+\let\`=\indexdummyfont
+\let\'=\indexdummyfont
+\let\^=\indexdummyfont
+\let\~=\indexdummyfont
+\let\==\indexdummyfont
+\let\b=\indexdummyfont
+\let\c=\indexdummyfont
+\let\d=\indexdummyfont
+\let\u=\indexdummyfont
+\let\v=\indexdummyfont
+\let\H=\indexdummyfont
+\let\dotless=\indexdummyfont
+% Take care of the plain tex special European modified letters.
+\def\oe{oe}%
+\def\ae{ae}%
+\def\aa{aa}%
+\def\OE{OE}%
+\def\AE{AE}%
+\def\AA{AA}%
+\def\o{o}%
+\def\O{O}%
+\def\l{l}%
+\def\L{L}%
+\def\ss{ss}%
+\let\w=\indexdummyfont
+\let\t=\indexdummyfont
+\let\r=\indexdummyfont
+\let\i=\indexdummyfont
+\let\b=\indexdummyfont
+\let\emph=\indexdummyfont
+\let\strong=\indexdummyfont
+\let\cite=\indexdummyfont
+\let\sc=\indexdummyfont
+%Don't no-op \tt, since it isn't a user-level command
+% and is used in the definitions of the active chars like <, >, |...
+%\let\tt=\indexdummyfont
+\let\tclose=\indexdummyfont
+\let\code=\indexdummyfont
+\let\file=\indexdummyfont
+\let\samp=\indexdummyfont
+\let\kbd=\indexdummyfont
+\let\key=\indexdummyfont
+\let\var=\indexdummyfont
+\let\TeX=\indexdummytex
+\let\dots=\indexdummydots
+\def\@{@}%
+}
+
+% To define \realbackslash, we must make \ not be an escape.
+% We must first make another character (@) an escape
+% so we do not become unable to do a definition.
+
+{\catcode`\@=0 \catcode`\\=\other
+@gdef@realbackslash{\}}
+
+\let\indexbackslash=0 %overridden during \printindex.
+
+\let\SETmarginindex=\relax %initialize!
+% workhorse for all \fooindexes
+% #1 is name of index, #2 is stuff to put there
+\def\doind #1#2{%
+ % Put the index entry in the margin if desired.
+ \ifx\SETmarginindex\relax\else
+ \insert\margin{\hbox{\vrule height8pt depth3pt width0pt #2}}%
+ \fi
+ {%
+ \count255=\lastpenalty
+ {%
+ \indexdummies % Must do this here, since \bf, etc expand at this stage
+ \escapechar=`\\
+ {%
+ \let\folio=0% We will expand all macros now EXCEPT \folio.
+ \def\rawbackslashxx{\indexbackslash}% \indexbackslash isn't defined now
+ % so it will be output as is; and it will print as backslash.
+ %
+ % First process the index-string with all font commands turned off
+ % to get the string to sort by.
+ {\indexnofonts \xdef\indexsorttmp{#2}}%
+ %
+ % Now produce the complete index entry, with both the sort key and the
+ % original text, including any font commands.
+ \toks0 = {#2}%
+ \edef\temp{%
+ \write\csname#1indfile\endcsname{%
+ \realbackslash entry{\indexsorttmp}{\folio}{\the\toks0}}%
+ }%
+ \temp
+ }%
+ }%
+ \penalty\count255
+ }%
+}
+
+\def\dosubind #1#2#3{%
+{\count10=\lastpenalty %
+{\indexdummies % Must do this here, since \bf, etc expand at this stage
+\escapechar=`\\%
+{\let\folio=0%
+\def\rawbackslashxx{\indexbackslash}%
+%
+% Now process the index-string once, with all font commands turned off,
+% to get the string to sort the index by.
+{\indexnofonts
+\xdef\temp1{#2 #3}%
+}%
+% Now produce the complete index entry. We process the index-string again,
+% this time with font commands expanded, to get what to print in the index.
+\edef\temp{%
+\write \csname#1indfile\endcsname{%
+\realbackslash entry {\temp1}{\folio}{#2}{#3}}}%
+\temp }%
+}\penalty\count10}}
+
+% The index entry written in the file actually looks like
+% \entry {sortstring}{page}{topic}
+% or
+% \entry {sortstring}{page}{topic}{subtopic}
+% The texindex program reads in these files and writes files
+% containing these kinds of lines:
+% \initial {c}
+% before the first topic whose initial is c
+% \entry {topic}{pagelist}
+% for a topic that is used without subtopics
+% \primary {topic}
+% for the beginning of a topic that is used with subtopics
+% \secondary {subtopic}{pagelist}
+% for each subtopic.
+
+% Define the user-accessible indexing commands
+% @findex, @vindex, @kindex, @cindex.
+
+\def\findex {\fnindex}
+\def\kindex {\kyindex}
+\def\cindex {\cpindex}
+\def\vindex {\vrindex}
+\def\tindex {\tpindex}
+\def\pindex {\pgindex}
+
+\def\cindexsub {\begingroup\obeylines\cindexsub}
+{\obeylines %
+\gdef\cindexsub "#1" #2^^M{\endgroup %
+\dosubind{cp}{#2}{#1}}}
+
+% Define the macros used in formatting output of the sorted index material.
+
+% @printindex causes a particular index (the ??s file) to get printed.
+% It does not print any chapter heading (usually an @unnumbered).
+%
+\def\printindex{\parsearg\doprintindex}
+\def\doprintindex#1{\begingroup
+ \dobreak \chapheadingskip{10000}%
+ %
+ \indexfonts \rm
+ \tolerance = 9500
+ \indexbreaks
+ %
+ % See if the index file exists and is nonempty.
+ \openin 1 \jobname.#1s
+ \ifeof 1
+ % \enddoublecolumns gets confused if there is no text in the index,
+ % and it loses the chapter title and the aux file entries for the
+ % index. The easiest way to prevent this problem is to make sure
+ % there is some text.
+ (Index is nonexistent)
+ \else
+ %
+ % If the index file exists but is empty, then \openin leaves \ifeof
+ % false. We have to make TeX try to read something from the file, so
+ % it can discover if there is anything in it.
+ \read 1 to \temp
+ \ifeof 1
+ (Index is empty)
+ \else
+ % Index files are almost Texinfo source, but we use \ as the escape
+ % character. It would be better to use @, but that's too big a change
+ % to make right now.
+ \def\indexbackslash{\rawbackslashxx}%
+ \catcode`\\ = 0
+ \catcode`\@ = 11
+ \escapechar = `\\
+ \begindoublecolumns
+ \input \jobname.#1s
+ \enddoublecolumns
+ \fi
+ \fi
+ \closein 1
+\endgroup}
+
+% These macros are used by the sorted index file itself.
+% Change them to control the appearance of the index.
+
+% Same as \bigskipamount except no shrink.
+% \balancecolumns gets confused if there is any shrink.
+\newskip\initialskipamount \initialskipamount 12pt plus4pt
+
+\def\initial #1{%
+{\let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt
+\ifdim\lastskip<\initialskipamount
+\removelastskip \penalty-200 \vskip \initialskipamount\fi
+\line{\secbf#1\hfill}\kern 2pt\penalty10000}}
+
+% This typesets a paragraph consisting of #1, dot leaders, and then #2
+% flush to the right margin. It is used for index and table of contents
+% entries. The paragraph is indented by \leftskip.
+%
+\def\entry #1#2{\begingroup
+ %
+ % Start a new paragraph if necessary, so our assignments below can't
+ % affect previous text.
+ \par
+ %
+ % Do not fill out the last line with white space.
+ \parfillskip = 0in
+ %
+ % No extra space above this paragraph.
+ \parskip = 0in
+ %
+ % Do not prefer a separate line ending with a hyphen to fewer lines.
+ \finalhyphendemerits = 0
+ %
+ % \hangindent is only relevant when the entry text and page number
+ % don't both fit on one line. In that case, bob suggests starting the
+ % dots pretty far over on the line. Unfortunately, a large
+ % indentation looks wrong when the entry text itself is broken across
+ % lines. So we use a small indentation and put up with long leaders.
+ %
+ % \hangafter is reset to 1 (which is the value we want) at the start
+ % of each paragraph, so we need not do anything with that.
+ \hangindent=2em
+ %
+ % When the entry text needs to be broken, just fill out the first line
+ % with blank space.
+ \rightskip = 0pt plus1fil
+ %
+ % Start a ``paragraph'' for the index entry so the line breaking
+ % parameters we've set above will have an effect.
+ \noindent
+ %
+ % Insert the text of the index entry. TeX will do line-breaking on it.
+ #1%
+ % The following is kludged to not output a line of dots in the index if
+ % there are no page numbers. The next person who breaks this will be
+ % cursed by a Unix daemon.
+ \def\tempa{{\rm }}%
+ \def\tempb{#2}%
+ \edef\tempc{\tempa}%
+ \edef\tempd{\tempb}%
+ \ifx\tempc\tempd\ \else%
+ %
+ % If we must, put the page number on a line of its own, and fill out
+ % this line with blank space. (The \hfil is overwhelmed with the
+ % fill leaders glue in \indexdotfill if the page number does fit.)
+ \hfil\penalty50
+ \null\nobreak\indexdotfill % Have leaders before the page number.
+ %
+ % The `\ ' here is removed by the implicit \unskip that TeX does as
+ % part of (the primitive) \par. Without it, a spurious underfull
+ % \hbox ensues.
+ \ #2% The page number ends the paragraph.
+ \fi%
+ \par
+\endgroup}
+
+% Like \dotfill except takes at least 1 em.
+\def\indexdotfill{\cleaders
+ \hbox{$\mathsurround=0pt \mkern1.5mu ${\it .}$ \mkern1.5mu$}\hskip 1em plus 1fill}
+
+\def\primary #1{\line{#1\hfil}}
+
+\newskip\secondaryindent \secondaryindent=0.5cm
+
+\def\secondary #1#2{
+{\parfillskip=0in \parskip=0in
+\hangindent =1in \hangafter=1
+\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\par
+}}
+
+% Define two-column mode, which we use to typeset indexes.
+% Adapted from the TeXbook, page 416, which is to say,
+% the manmac.tex format used to print the TeXbook itself.
+\catcode`\@=11
+
+\newbox\partialpage
+\newdimen\doublecolumnhsize
+
+\def\begindoublecolumns{\begingroup % ended by \enddoublecolumns
+ % Grab any single-column material above us.
+ \output = {\global\setbox\partialpage = \vbox{%
+ %
+ % Here is a possibility not foreseen in manmac: if we accumulate a
+ % whole lot of material, we might end up calling this \output
+ % routine twice in a row (see the doublecol-lose test, which is
+ % essentially a couple of indexes with @setchapternewpage off). In
+ % that case, we must prevent the second \partialpage from
+ % simply overwriting the first, causing us to lose the page.
+ % This will preserve it until a real output routine can ship it
+ % out. Generally, \partialpage will be empty when this runs and
+ % this will be a no-op.
+ \unvbox\partialpage
+ %
+ % Unvbox the main output page.
+ \unvbox255
+ \kern-\topskip \kern\baselineskip
+ }}%
+ \eject
+ %
+ % Use the double-column output routine for subsequent pages.
+ \output = {\doublecolumnout}%
+ %
+ % Change the page size parameters. We could do this once outside this
+ % routine, in each of @smallbook, @afourpaper, and the default 8.5x11
+ % format, but then we repeat the same computation. Repeating a couple
+ % of assignments once per index is clearly meaningless for the
+ % execution time, so we may as well do it in one place.
+ %
+ % First we halve the line length, less a little for the gutter between
+ % the columns. We compute the gutter based on the line length, so it
+ % changes automatically with the paper format. The magic constant
+ % below is chosen so that the gutter has the same value (well, +-<1pt)
+ % as it did when we hard-coded it.
+ %
+ % We put the result in a separate register, \doublecolumhsize, so we
+ % can restore it in \pagesofar, after \hsize itself has (potentially)
+ % been clobbered.
+ %
+ \doublecolumnhsize = \hsize
+ \advance\doublecolumnhsize by -.04154\hsize
+ \divide\doublecolumnhsize by 2
+ \hsize = \doublecolumnhsize
+ %
+ % Double the \vsize as well. (We don't need a separate register here,
+ % since nobody clobbers \vsize.)
+ \vsize = 2\vsize
+}
+\def\doublecolumnout{%
+ \splittopskip=\topskip \splitmaxdepth=\maxdepth
+ % Get the available space for the double columns -- the normal
+ % (undoubled) page height minus any material left over from the
+ % previous page.
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpage
+ % box0 will be the left-hand column, box2 the right.
+ \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@
+ \onepageout\pagesofar
+ \unvbox255
+ \penalty\outputpenalty
+}
+\def\pagesofar{%
+ % Re-output the contents of the output page -- any previous material,
+ % followed by the two boxes we just split.
+ \unvbox\partialpage
+ \hsize = \doublecolumnhsize
+ \wd0=\hsize \wd2=\hsize \hbox to\pagewidth{\box0\hfil\box2}%
+}
+\def\enddoublecolumns{%
+ \output = {\balancecolumns}\eject % split what we have
+ \endgroup % started in \begindoublecolumns
+ %
+ % Back to normal single-column typesetting, but take account of the
+ % fact that we just accumulated some stuff on the output page.
+ \pagegoal = \vsize
+}
+\def\balancecolumns{%
+ % Called at the end of the double column material.
+ \setbox0 = \vbox{\unvbox255}%
+ \dimen@ = \ht0
+ \advance\dimen@ by \topskip
+ \advance\dimen@ by-\baselineskip
+ \divide\dimen@ by 2
+ \splittopskip = \topskip
+ % Loop until we get a decent breakpoint.
+ {\vbadness=10000 \loop
+ \global\setbox3=\copy0
+ \global\setbox1=\vsplit3 to\dimen@
+ \ifdim\ht3>\dimen@ \global\advance\dimen@ by1pt
+ \repeat}%
+ \setbox0=\vbox to\dimen@{\unvbox1}%
+ \setbox2=\vbox to\dimen@{\unvbox3}%
+ \pagesofar
+}
+\catcode`\@ = \other
+
+
+\message{sectioning,}
+% Define chapters, sections, etc.
+
+\newcount\chapno
+\newcount\secno \secno=0
+\newcount\subsecno \subsecno=0
+\newcount\subsubsecno \subsubsecno=0
+
+% This counter is funny since it counts through charcodes of letters A, B, ...
+\newcount\appendixno \appendixno = `\@
+\def\appendixletter{\char\the\appendixno}
+
+\newwrite\contentsfile
+% This is called from \setfilename.
+\def\opencontents{\openout\contentsfile = \jobname.toc }
+
+% Each @chapter defines this as the name of the chapter.
+% page headings and footings can use it. @section does likewise
+
+\def\thischapter{} \def\thissection{}
+\def\seccheck#1{\ifnum \pageno<0
+ \errmessage{@#1 not allowed after generating table of contents}%
+\fi}
+
+\def\chapternofonts{%
+ \let\rawbackslash=\relax
+ \let\frenchspacing=\relax
+ \def\result{\realbackslash result}%
+ \def\equiv{\realbackslash equiv}%
+ \def\expansion{\realbackslash expansion}%
+ \def\print{\realbackslash print}%
+ \def\TeX{\realbackslash TeX}%
+ \def\dots{\realbackslash dots}%
+ \def\copyright{\realbackslash copyright}%
+ \def\tt{\realbackslash tt}%
+ \def\bf{\realbackslash bf}%
+ \def\w{\realbackslash w}%
+ \def\less{\realbackslash less}%
+ \def\gtr{\realbackslash gtr}%
+ \def\hat{\realbackslash hat}%
+ \def\char{\realbackslash char}%
+ \def\tclose##1{\realbackslash tclose{##1}}%
+ \def\code##1{\realbackslash code{##1}}%
+ \def\samp##1{\realbackslash samp{##1}}%
+ \def\r##1{\realbackslash r{##1}}%
+ \def\b##1{\realbackslash b{##1}}%
+ \def\key##1{\realbackslash key{##1}}%
+ \def\file##1{\realbackslash file{##1}}%
+ \def\kbd##1{\realbackslash kbd{##1}}%
+ % These are redefined because @smartitalic wouldn't work inside xdef.
+ \def\i##1{\realbackslash i{##1}}%
+ \def\cite##1{\realbackslash cite{##1}}%
+ \def\var##1{\realbackslash var{##1}}%
+ \def\emph##1{\realbackslash emph{##1}}%
+ \def\dfn##1{\realbackslash dfn{##1}}%
+}
+
+\newcount\absseclevel % used to calculate proper heading level
+\newcount\secbase\secbase=0 % @raise/lowersections modify this count
+
+% @raisesections: treat @section as chapter, @subsection as section, etc.
+\def\raisesections{\global\advance\secbase by -1}
+\let\up=\raisesections % original BFox name
+
+% @lowersections: treat @chapter as section, @section as subsection, etc.
+\def\lowersections{\global\advance\secbase by 1}
+\let\down=\lowersections % original BFox name
+
+% Choose a numbered-heading macro
+% #1 is heading level if unmodified by @raisesections or @lowersections
+% #2 is text for heading
+\def\numhead#1#2{\absseclevel=\secbase\advance\absseclevel by #1
+\ifcase\absseclevel
+ \chapterzzz{#2}
+\or
+ \seczzz{#2}
+\or
+ \numberedsubseczzz{#2}
+\or
+ \numberedsubsubseczzz{#2}
+\else
+ \ifnum \absseclevel<0
+ \chapterzzz{#2}
+ \else
+ \numberedsubsubseczzz{#2}
+ \fi
+\fi
+}
+
+% like \numhead, but chooses appendix heading levels
+\def\apphead#1#2{\absseclevel=\secbase\advance\absseclevel by #1
+\ifcase\absseclevel
+ \appendixzzz{#2}
+\or
+ \appendixsectionzzz{#2}
+\or
+ \appendixsubseczzz{#2}
+\or
+ \appendixsubsubseczzz{#2}
+\else
+ \ifnum \absseclevel<0
+ \appendixzzz{#2}
+ \else
+ \appendixsubsubseczzz{#2}
+ \fi
+\fi
+}
+
+% like \numhead, but chooses numberless heading levels
+\def\unnmhead#1#2{\absseclevel=\secbase\advance\absseclevel by #1
+\ifcase\absseclevel
+ \unnumberedzzz{#2}
+\or
+ \unnumberedseczzz{#2}
+\or
+ \unnumberedsubseczzz{#2}
+\or
+ \unnumberedsubsubseczzz{#2}
+\else
+ \ifnum \absseclevel<0
+ \unnumberedzzz{#2}
+ \else
+ \unnumberedsubsubseczzz{#2}
+ \fi
+\fi
+}
+
+
+\def\thischaptername{No Chapter Title}
+\outer\def\chapter{\parsearg\chapteryyy}
+\def\chapteryyy #1{\numhead0{#1}} % normally numhead0 calls chapterzzz
+\def\chapterzzz #1{\seccheck{chapter}%
+\secno=0 \subsecno=0 \subsubsecno=0
+\global\advance \chapno by 1 \message{\putwordChapter \the\chapno}%
+\chapmacro {#1}{\the\chapno}%
+\gdef\thissection{#1}%
+\gdef\thischaptername{#1}%
+% We don't substitute the actual chapter name into \thischapter
+% because we don't want its macros evaluated now.
+\xdef\thischapter{\putwordChapter{} \the\chapno: \noexpand\thischaptername}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash chapentry{\the\toks0}{\the\chapno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\donoderef %
+\global\let\section = \numberedsec
+\global\let\subsection = \numberedsubsec
+\global\let\subsubsection = \numberedsubsubsec
+}}
+
+\outer\def\appendix{\parsearg\appendixyyy}
+\def\appendixyyy #1{\apphead0{#1}} % normally apphead0 calls appendixzzz
+\def\appendixzzz #1{\seccheck{appendix}%
+\secno=0 \subsecno=0 \subsubsecno=0
+\global\advance \appendixno by 1 \message{Appendix \appendixletter}%
+\chapmacro {#1}{\putwordAppendix{} \appendixletter}%
+\gdef\thissection{#1}%
+\gdef\thischaptername{#1}%
+\xdef\thischapter{\putwordAppendix{} \appendixletter: \noexpand\thischaptername}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash chapentry{\the\toks0}%
+ {\putwordAppendix{} \appendixletter}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\appendixnoderef %
+\global\let\section = \appendixsec
+\global\let\subsection = \appendixsubsec
+\global\let\subsubsection = \appendixsubsubsec
+}}
+
+% @centerchap is like @unnumbered, but the heading is centered.
+\outer\def\centerchap{\parsearg\centerchapyyy}
+\def\centerchapyyy #1{{\let\unnumbchapmacro=\centerchapmacro \unnumberedyyy{#1}}}
+
+\outer\def\top{\parsearg\unnumberedyyy}
+\outer\def\unnumbered{\parsearg\unnumberedyyy}
+\def\unnumberedyyy #1{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz
+\def\unnumberedzzz #1{\seccheck{unnumbered}%
+\secno=0 \subsecno=0 \subsubsecno=0
+%
+% This used to be simply \message{#1}, but TeX fully expands the
+% argument to \message. Therefore, if #1 contained @-commands, TeX
+% expanded them. For example, in `@unnumbered The @cite{Book}', TeX
+% expanded @cite (which turns out to cause errors because \cite is meant
+% to be executed, not expanded).
+%
+% Anyway, we don't want the fully-expanded definition of @cite to appear
+% as a result of the \message, we just want `@cite' itself. We use
+% \the<toks register> to achieve this: TeX expands \the<toks> only once,
+% simply yielding the contents of the <toks register>.
+\toks0 = {#1}\message{(\the\toks0)}%
+%
+\unnumbchapmacro {#1}%
+\gdef\thischapter{#1}\gdef\thissection{#1}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash unnumbchapentry{\the\toks0}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\unnumbnoderef %
+\global\let\section = \unnumberedsec
+\global\let\subsection = \unnumberedsubsec
+\global\let\subsubsection = \unnumberedsubsubsec
+}}
+
+\outer\def\numberedsec{\parsearg\secyyy}
+\def\secyyy #1{\numhead1{#1}} % normally calls seczzz
+\def\seczzz #1{\seccheck{section}%
+\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 %
+\gdef\thissection{#1}\secheading {#1}{\the\chapno}{\the\secno}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash secentry %
+{\the\toks0}{\the\chapno}{\the\secno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\donoderef %
+\penalty 10000 %
+}}
+
+\outer\def\appendixsection{\parsearg\appendixsecyyy}
+\outer\def\appendixsec{\parsearg\appendixsecyyy}
+\def\appendixsecyyy #1{\apphead1{#1}} % normally calls appendixsectionzzz
+\def\appendixsectionzzz #1{\seccheck{appendixsection}%
+\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 %
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}{\the\secno}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash secentry %
+{\the\toks0}{\appendixletter}{\the\secno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\appendixnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\unnumberedsec{\parsearg\unnumberedsecyyy}
+\def\unnumberedsecyyy #1{\unnmhead1{#1}} % normally calls unnumberedseczzz
+\def\unnumberedseczzz #1{\seccheck{unnumberedsec}%
+\plainsecheading {#1}\gdef\thissection{#1}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash unnumbsecentry{\the\toks0}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\unnumbnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\numberedsubsec{\parsearg\numberedsubsecyyy}
+\def\numberedsubsecyyy #1{\numhead2{#1}} % normally calls numberedsubseczzz
+\def\numberedsubseczzz #1{\seccheck{subsection}%
+\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 %
+\subsecheading {#1}{\the\chapno}{\the\secno}{\the\subsecno}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash subsecentry %
+{\the\toks0}{\the\chapno}{\the\secno}{\the\subsecno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\donoderef %
+\penalty 10000 %
+}}
+
+\outer\def\appendixsubsec{\parsearg\appendixsubsecyyy}
+\def\appendixsubsecyyy #1{\apphead2{#1}} % normally calls appendixsubseczzz
+\def\appendixsubseczzz #1{\seccheck{appendixsubsec}%
+\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 %
+\subsecheading {#1}{\appendixletter}{\the\secno}{\the\subsecno}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash subsecentry %
+{\the\toks0}{\appendixletter}{\the\secno}{\the\subsecno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\appendixnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\unnumberedsubsec{\parsearg\unnumberedsubsecyyy}
+\def\unnumberedsubsecyyy #1{\unnmhead2{#1}} %normally calls unnumberedsubseczzz
+\def\unnumberedsubseczzz #1{\seccheck{unnumberedsubsec}%
+\plainsubsecheading {#1}\gdef\thissection{#1}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash unnumbsubsecentry{\the\toks0}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\unnumbnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\numberedsubsubsec{\parsearg\numberedsubsubsecyyy}
+\def\numberedsubsubsecyyy #1{\numhead3{#1}} % normally numberedsubsubseczzz
+\def\numberedsubsubseczzz #1{\seccheck{subsubsection}%
+\gdef\thissection{#1}\global\advance \subsubsecno by 1 %
+\subsubsecheading {#1}
+ {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash subsubsecentry{\the\toks0}
+ {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}
+ {\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\donoderef %
+\penalty 10000 %
+}}
+
+\outer\def\appendixsubsubsec{\parsearg\appendixsubsubsecyyy}
+\def\appendixsubsubsecyyy #1{\apphead3{#1}} % normally appendixsubsubseczzz
+\def\appendixsubsubseczzz #1{\seccheck{appendixsubsubsec}%
+\gdef\thissection{#1}\global\advance \subsubsecno by 1 %
+\subsubsecheading {#1}
+ {\appendixletter}{\the\secno}{\the\subsecno}{\the\subsubsecno}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash subsubsecentry{\the\toks0}%
+ {\appendixletter}
+ {\the\secno}{\the\subsecno}{\the\subsubsecno}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\appendixnoderef %
+\penalty 10000 %
+}}
+
+\outer\def\unnumberedsubsubsec{\parsearg\unnumberedsubsubsecyyy}
+\def\unnumberedsubsubsecyyy #1{\unnmhead3{#1}} %normally unnumberedsubsubseczzz
+\def\unnumberedsubsubseczzz #1{\seccheck{unnumberedsubsubsec}%
+\plainsubsubsecheading {#1}\gdef\thissection{#1}%
+{\chapternofonts%
+\toks0 = {#1}%
+\edef\temp{{\realbackslash unnumbsubsubsecentry{\the\toks0}{\noexpand\folio}}}%
+\escapechar=`\\%
+\write \contentsfile \temp %
+\unnumbnoderef %
+\penalty 10000 %
+}}
+
+% These are variants which are not "outer", so they can appear in @ifinfo.
+% Actually, they should now be obsolete; ordinary section commands should work.
+\def\infotop{\parsearg\unnumberedzzz}
+\def\infounnumbered{\parsearg\unnumberedzzz}
+\def\infounnumberedsec{\parsearg\unnumberedseczzz}
+\def\infounnumberedsubsec{\parsearg\unnumberedsubseczzz}
+\def\infounnumberedsubsubsec{\parsearg\unnumberedsubsubseczzz}
+
+\def\infoappendix{\parsearg\appendixzzz}
+\def\infoappendixsec{\parsearg\appendixseczzz}
+\def\infoappendixsubsec{\parsearg\appendixsubseczzz}
+\def\infoappendixsubsubsec{\parsearg\appendixsubsubseczzz}
+
+\def\infochapter{\parsearg\chapterzzz}
+\def\infosection{\parsearg\sectionzzz}
+\def\infosubsection{\parsearg\subsectionzzz}
+\def\infosubsubsection{\parsearg\subsubsectionzzz}
+
+% These macros control what the section commands do, according
+% to what kind of chapter we are in (ordinary, appendix, or unnumbered).
+% Define them by default for a numbered chapter.
+\global\let\section = \numberedsec
+\global\let\subsection = \numberedsubsec
+\global\let\subsubsection = \numberedsubsubsec
+
+% Define @majorheading, @heading and @subheading
+
+% NOTE on use of \vbox for chapter headings, section headings, and
+% such:
+% 1) We use \vbox rather than the earlier \line to permit
+% overlong headings to fold.
+% 2) \hyphenpenalty is set to 10000 because hyphenation in a
+% heading is obnoxious; this forbids it.
+% 3) Likewise, headings look best if no \parindent is used, and
+% if justification is not attempted. Hence \raggedright.
+
+
+\def\majorheading{\parsearg\majorheadingzzz}
+\def\majorheadingzzz #1{%
+{\advance\chapheadingskip by 10pt \chapbreak }%
+{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}\bigskip \par\penalty 200}
+
+\def\chapheading{\parsearg\chapheadingzzz}
+\def\chapheadingzzz #1{\chapbreak %
+{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}\bigskip \par\penalty 200}
+
+% @heading, @subheading, @subsubheading.
+\def\heading{\parsearg\plainsecheading}
+\def\subheading{\parsearg\plainsubsecheading}
+\def\subsubheading{\parsearg\plainsubsubsecheading}
+
+% These macros generate a chapter, section, etc. heading only
+% (including whitespace, linebreaking, etc. around it),
+% given all the information in convenient, parsed form.
+
+%%% Args are the skip and penalty (usually negative)
+\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi}
+
+\def\setchapterstyle #1 {\csname CHAPF#1\endcsname}
+
+%%% Define plain chapter starts, and page on/off switching for it
+% Parameter controlling skip before chapter headings (if needed)
+
+\newskip\chapheadingskip
+
+\def\chapbreak{\dobreak \chapheadingskip {-4000}}
+\def\chappager{\par\vfill\supereject}
+\def\chapoddpage{\chappager \ifodd\pageno \else \hbox to 0pt{} \chappager\fi}
+
+\def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname}
+
+\def\CHAPPAGoff{
+\global\let\contentsalignmacro = \chappager
+\global\let\pchapsepmacro=\chapbreak
+\global\let\pagealignmacro=\chappager}
+
+\def\CHAPPAGon{
+\global\let\contentsalignmacro = \chappager
+\global\let\pchapsepmacro=\chappager
+\global\let\pagealignmacro=\chappager
+\global\def\HEADINGSon{\HEADINGSsingle}}
+
+\def\CHAPPAGodd{
+\global\let\contentsalignmacro = \chapoddpage
+\global\let\pchapsepmacro=\chapoddpage
+\global\let\pagealignmacro=\chapoddpage
+\global\def\HEADINGSon{\HEADINGSdouble}}
+
+\CHAPPAGon
+
+\def\CHAPFplain{
+\global\let\chapmacro=\chfplain
+\global\let\unnumbchapmacro=\unnchfplain
+\global\let\centerchapmacro=\centerchfplain}
+
+% Plain chapter opening.
+% #1 is the text, #2 the chapter number or empty if unnumbered.
+\def\chfplain#1#2{%
+ \pchapsepmacro
+ {%
+ \chapfonts \rm
+ \def\chapnum{#2}%
+ \setbox0 = \hbox{#2\ifx\chapnum\empty\else\enspace\fi}%
+ \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright
+ \hangindent = \wd0 \centerparametersmaybe
+ \unhbox0 #1\par}%
+ }%
+ \nobreak\bigskip % no page break after a chapter title
+ \nobreak
+}
+
+% Plain opening for unnumbered.
+\def\unnchfplain#1{\chfplain{#1}{}}
+
+% @centerchap -- centered and unnumbered.
+\let\centerparametersmaybe = \relax
+\def\centerchfplain#1{{%
+ \def\centerparametersmaybe{%
+ \advance\rightskip by 3\rightskip
+ \leftskip = \rightskip
+ \parfillskip = 0pt
+ }%
+ \chfplain{#1}{}%
+}}
+
+\CHAPFplain % The default
+
+\def\unnchfopen #1{%
+\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt\raggedright
+ \rm #1\hfill}}\bigskip \par\penalty 10000 %
+}
+
+\def\chfopen #1#2{\chapoddpage {\chapfonts
+\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}%
+\par\penalty 5000 %
+}
+
+\def\centerchfopen #1{%
+\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
+ \parindent=0pt
+ \hfill {\rm #1}\hfill}}\bigskip \par\penalty 10000 %
+}
+
+\def\CHAPFopen{
+\global\let\chapmacro=\chfopen
+\global\let\unnumbchapmacro=\unnchfopen
+\global\let\centerchapmacro=\centerchfopen}
+
+
+% Section titles.
+\newskip\secheadingskip
+\def\secheadingbreak{\dobreak \secheadingskip {-1000}}
+\def\secheading#1#2#3{\sectionheading{sec}{#2.#3}{#1}}
+\def\plainsecheading#1{\sectionheading{sec}{}{#1}}
+
+% Subsection titles.
+\newskip \subsecheadingskip
+\def\subsecheadingbreak{\dobreak \subsecheadingskip {-500}}
+\def\subsecheading#1#2#3#4{\sectionheading{subsec}{#2.#3.#4}{#1}}
+\def\plainsubsecheading#1{\sectionheading{subsec}{}{#1}}
+
+% Subsubsection titles.
+\let\subsubsecheadingskip = \subsecheadingskip
+\let\subsubsecheadingbreak = \subsecheadingbreak
+\def\subsubsecheading#1#2#3#4#5{\sectionheading{subsubsec}{#2.#3.#4.#5}{#1}}
+\def\plainsubsubsecheading#1{\sectionheading{subsubsec}{}{#1}}
+
+
+% Print any size section title.
+%
+% #1 is the section type (sec/subsec/subsubsec), #2 is the section
+% number (maybe empty), #3 the text.
+\def\sectionheading#1#2#3{%
+ {%
+ \expandafter\advance\csname #1headingskip\endcsname by \parskip
+ \csname #1headingbreak\endcsname
+ }%
+ {%
+ % Switch to the right set of fonts.
+ \csname #1fonts\endcsname \rm
+ %
+ % Only insert the separating space if we have a section number.
+ \def\secnum{#2}%
+ \setbox0 = \hbox{#2\ifx\secnum\empty\else\enspace\fi}%
+ %
+ \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright
+ \hangindent = \wd0 % zero if no section number
+ \unhbox0 #3}%
+ }%
+ \ifdim\parskip<10pt \nobreak\kern10pt\nobreak\kern-\parskip\fi \nobreak
+}
+
+
+\message{toc printing,}
+% Finish up the main text and prepare to read what we've written
+% to \contentsfile.
+
+\newskip\contentsrightmargin \contentsrightmargin=1in
+\def\startcontents#1{%
+ % If @setchapternewpage on, and @headings double, the contents should
+ % start on an odd page, unlike chapters. Thus, we maintain
+ % \contentsalignmacro in parallel with \pagealignmacro.
+ % From: Torbjorn Granlund <tege@matematik.su.se>
+ \contentsalignmacro
+ \immediate\closeout \contentsfile
+ \ifnum \pageno>0
+ \pageno = -1 % Request roman numbered pages.
+ \fi
+ % Don't need to put `Contents' or `Short Contents' in the headline.
+ % It is abundantly clear what they are.
+ \unnumbchapmacro{#1}\def\thischapter{}%
+ \begingroup % Set up to handle contents files properly.
+ \catcode`\\=0 \catcode`\{=1 \catcode`\}=2 \catcode`\@=11
+ \catcode`\^=7 % to see ^^e4 as \"a etc. juha@piuha.ydi.vtt.fi
+ \raggedbottom % Worry more about breakpoints than the bottom.
+ \advance\hsize by -\contentsrightmargin % Don't use the full line length.
+}
+
+
+% Normal (long) toc.
+\outer\def\contents{%
+ \startcontents{\putwordTableofContents}%
+ \input \jobname.toc
+ \endgroup
+ \vfill \eject
+}
+
+% And just the chapters.
+\outer\def\summarycontents{%
+ \startcontents{\putwordShortContents}%
+ %
+ \let\chapentry = \shortchapentry
+ \let\unnumbchapentry = \shortunnumberedentry
+ % We want a true roman here for the page numbers.
+ \secfonts
+ \let\rm=\shortcontrm \let\bf=\shortcontbf \let\sl=\shortcontsl
+ \rm
+ \hyphenpenalty = 10000
+ \advance\baselineskip by 1pt % Open it up a little.
+ \def\secentry ##1##2##3##4{}
+ \def\unnumbsecentry ##1##2{}
+ \def\subsecentry ##1##2##3##4##5{}
+ \def\unnumbsubsecentry ##1##2{}
+ \def\subsubsecentry ##1##2##3##4##5##6{}
+ \def\unnumbsubsubsecentry ##1##2{}
+ \input \jobname.toc
+ \endgroup
+ \vfill \eject
+}
+\let\shortcontents = \summarycontents
+
+% These macros generate individual entries in the table of contents.
+% The first argument is the chapter or section name.
+% The last argument is the page number.
+% The arguments in between are the chapter number, section number, ...
+
+% Chapter-level things, for both the long and short contents.
+\def\chapentry#1#2#3{\dochapentry{#2\labelspace#1}{#3}}
+
+% See comments in \dochapentry re vbox and related settings
+\def\shortchapentry#1#2#3{%
+ \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno{#3}}%
+}
+
+% Typeset the label for a chapter or appendix for the short contents.
+% The arg is, e.g. `Appendix A' for an appendix, or `3' for a chapter.
+% We could simplify the code here by writing out an \appendixentry
+% command in the toc file for appendices, instead of using \chapentry
+% for both, but it doesn't seem worth it.
+\setbox0 = \hbox{\shortcontrm \putwordAppendix }
+\newdimen\shortappendixwidth \shortappendixwidth = \wd0
+
+\def\shortchaplabel#1{%
+ % We typeset #1 in a box of constant width, regardless of the text of
+ % #1, so the chapter titles will come out aligned.
+ \setbox0 = \hbox{#1}%
+ \dimen0 = \ifdim\wd0 > \shortappendixwidth \shortappendixwidth \else 0pt \fi
+ %
+ % This space should be plenty, since a single number is .5em, and the
+ % widest letter (M) is 1em, at least in the Computer Modern fonts.
+ % (This space doesn't include the extra space that gets added after
+ % the label; that gets put in by \shortchapentry above.)
+ \advance\dimen0 by 1.1em
+ \hbox to \dimen0{#1\hfil}%
+}
+
+\def\unnumbchapentry#1#2{\dochapentry{#1}{#2}}
+\def\shortunnumberedentry#1#2{\tocentry{#1}{\doshortpageno{#2}}}
+
+% Sections.
+\def\secentry#1#2#3#4{\dosecentry{#2.#3\labelspace#1}{#4}}
+\def\unnumbsecentry#1#2{\dosecentry{#1}{#2}}
+
+% Subsections.
+\def\subsecentry#1#2#3#4#5{\dosubsecentry{#2.#3.#4\labelspace#1}{#5}}
+\def\unnumbsubsecentry#1#2{\dosubsecentry{#1}{#2}}
+
+% And subsubsections.
+\def\subsubsecentry#1#2#3#4#5#6{%
+ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}{#6}}
+\def\unnumbsubsubsecentry#1#2{\dosubsubsecentry{#1}{#2}}
+
+% This parameter controls the indentation of the various levels.
+\newdimen\tocindent \tocindent = 3pc
+
+% Now for the actual typesetting. In all these, #1 is the text and #2 is the
+% page number.
+%
+% If the toc has to be broken over pages, we want it to be at chapters
+% if at all possible; hence the \penalty.
+\def\dochapentry#1#2{%
+ \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip
+ \begingroup
+ \chapentryfonts
+ \tocentry{#1}{\dopageno{#2}}%
+ \endgroup
+ \nobreak\vskip .25\baselineskip plus.1\baselineskip
+}
+
+\def\dosecentry#1#2{\begingroup
+ \secentryfonts \leftskip=\tocindent
+ \tocentry{#1}{\dopageno{#2}}%
+\endgroup}
+
+\def\dosubsecentry#1#2{\begingroup
+ \subsecentryfonts \leftskip=2\tocindent
+ \tocentry{#1}{\dopageno{#2}}%
+\endgroup}
+
+\def\dosubsubsecentry#1#2{\begingroup
+ \subsubsecentryfonts \leftskip=3\tocindent
+ \tocentry{#1}{\dopageno{#2}}%
+\endgroup}
+
+% Final typesetting of a toc entry; we use the same \entry macro as for
+% the index entries, but we want to suppress hyphenation here. (We
+% can't do that in the \entry macro, since index entries might consist
+% of hyphenated-identifiers-that-do-not-fit-on-a-line-and-nothing-else.)
+%
+% \turnoffactive is for the sake of @" used for umlauts.
+\def\tocentry#1#2{\begingroup
+ \vskip 0pt plus1pt % allow a little stretch for the sake of nice page breaks
+ \entry{\turnoffactive #1}{\turnoffactive #2}%
+\endgroup}
+
+% Space between chapter (or whatever) number and the title.
+\def\labelspace{\hskip1em \relax}
+
+\def\dopageno#1{{\rm #1}}
+\def\doshortpageno#1{{\rm #1}}
+
+\def\chapentryfonts{\secfonts \rm}
+\def\secentryfonts{\textfonts}
+\let\subsecentryfonts = \textfonts
+\let\subsubsecentryfonts = \textfonts
+
+
+\message{environments,}
+
+% Since these characters are used in examples, it should be an even number of
+% \tt widths. Each \tt character is 1en, so two makes it 1em.
+% Furthermore, these definitions must come after we define our fonts.
+\newbox\dblarrowbox \newbox\longdblarrowbox
+\newbox\pushcharbox \newbox\bullbox
+\newbox\equivbox \newbox\errorbox
+
+%{\tentt
+%\global\setbox\dblarrowbox = \hbox to 1em{\hfil$\Rightarrow$\hfil}
+%\global\setbox\longdblarrowbox = \hbox to 1em{\hfil$\mapsto$\hfil}
+%\global\setbox\pushcharbox = \hbox to 1em{\hfil$\dashv$\hfil}
+%\global\setbox\equivbox = \hbox to 1em{\hfil$\ptexequiv$\hfil}
+% Adapted from the manmac format (p.420 of TeXbook)
+%\global\setbox\bullbox = \hbox to 1em{\kern.15em\vrule height .75ex width .85ex
+% depth .1ex\hfil}
+%}
+
+% @point{}, @result{}, @expansion{}, @print{}, @equiv{}.
+\def\point{$\star$}
+\def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}}
+\def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}}
+\def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}}
+\def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}}
+
+% Adapted from the TeXbook's \boxit.
+{\tentt \global\dimen0 = 3em}% Width of the box.
+\dimen2 = .55pt % Thickness of rules
+% The text. (`r' is open on the right, `e' somewhat less so on the left.)
+\setbox0 = \hbox{\kern-.75pt \tensf error\kern-1.5pt}
+
+\global\setbox\errorbox=\hbox to \dimen0{\hfil
+ \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right.
+ \advance\hsize by -2\dimen2 % Rules.
+ \vbox{
+ \hrule height\dimen2
+ \hbox{\vrule width\dimen2 \kern3pt % Space to left of text.
+ \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below.
+ \kern3pt\vrule width\dimen2}% Space to right.
+ \hrule height\dimen2}
+ \hfil}
+
+% The @error{} command.
+\def\error{\leavevmode\lower.7ex\copy\errorbox}
+
+% @tex ... @end tex escapes into raw Tex temporarily.
+% One exception: @ is still an escape character, so that @end tex works.
+% But \@ or @@ will get a plain tex @ character.
+
+\def\tex{\begingroup
+\catcode `\\=0 \catcode `\{=1 \catcode `\}=2
+\catcode `\$=3 \catcode `\&=4 \catcode `\#=6
+\catcode `\^=7 \catcode `\_=8 \catcode `\~=13 \let~=\tie
+\catcode `\%=14
+\catcode 43=12 % plus
+\catcode`\"=12
+\catcode`\==12
+\catcode`\|=12
+\catcode`\<=12
+\catcode`\>=12
+\escapechar=`\\
+%
+\let\,=\ptexcomma
+\let\{=\ptexlbrace
+\let\}=\ptexrbrace
+\let\.=\ptexdot
+\let\*=\ptexstar
+\let\dots=\ptexdots
+\def\endldots{\mathinner{\ldots\ldots\ldots\ldots}}%
+\def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi}%
+\def\@{@}%
+\let\bullet=\ptexbullet
+\let\b=\ptexb \let\c=\ptexc \let\i=\ptexi \let\t=\ptext
+%
+\let\Etex=\endgroup}
+
+% Define @lisp ... @endlisp.
+% @lisp does a \begingroup so it can rebind things,
+% including the definition of @endlisp (which normally is erroneous).
+
+% Amount to narrow the margins by for @lisp.
+\newskip\lispnarrowing \lispnarrowing=0.4in
+
+% This is the definition that ^^M gets inside @lisp, @example, and other
+% such environments. \null is better than a space, since it doesn't
+% have any width.
+\def\lisppar{\null\endgraf}
+
+% Make each space character in the input produce a normal interword
+% space in the output. Don't allow a line break at this space, as this
+% is used only in environments like @example, where each line of input
+% should produce a line of output anyway.
+%
+{\obeyspaces %
+\gdef\sepspaces{\obeyspaces\let =\tie}}
+
+% Define \obeyedspace to be our active space, whatever it is. This is
+% for use in \parsearg.
+{\sepspaces%
+\global\let\obeyedspace= }
+
+% This space is always present above and below environments.
+\newskip\envskipamount \envskipamount = 0pt
+
+% Make spacing and below environment symmetrical. We use \parskip here
+% to help in doing that, since in @example-like environments \parskip
+% is reset to zero; thus the \afterenvbreak inserts no space -- but the
+% start of the next paragraph will insert \parskip
+%
+\def\aboveenvbreak{{\advance\envskipamount by \parskip
+\endgraf \ifdim\lastskip<\envskipamount
+\removelastskip \penalty-50 \vskip\envskipamount \fi}}
+
+\let\afterenvbreak = \aboveenvbreak
+
+% \nonarrowing is a flag. If "set", @lisp etc don't narrow margins.
+\let\nonarrowing=\relax
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% \cartouche: draw rectangle w/rounded corners around argument
+\font\circle=lcircle10
+\newdimen\circthick
+\newdimen\cartouter\newdimen\cartinner
+\newskip\normbskip\newskip\normpskip\newskip\normlskip
+\circthick=\fontdimen8\circle
+%
+\def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth
+\def\ctr{{\hskip 6pt\circle\char'010}}
+\def\cbl{{\circle\char'012\hskip -6pt}}
+\def\cbr{{\hskip 6pt\circle\char'011}}
+\def\carttop{\hbox to \cartouter{\hskip\lskip
+ \ctl\leaders\hrule height\circthick\hfil\ctr
+ \hskip\rskip}}
+\def\cartbot{\hbox to \cartouter{\hskip\lskip
+ \cbl\leaders\hrule height\circthick\hfil\cbr
+ \hskip\rskip}}
+%
+\newskip\lskip\newskip\rskip
+
+\long\def\cartouche{%
+\begingroup
+ \lskip=\leftskip \rskip=\rightskip
+ \leftskip=0pt\rightskip=0pt %we want these *outside*.
+ \cartinner=\hsize \advance\cartinner by-\lskip
+ \advance\cartinner by-\rskip
+ \cartouter=\hsize
+ \advance\cartouter by 18pt % allow for 3pt kerns on either
+% side, and for 6pt waste from
+% each corner char
+ \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip
+ % Flag to tell @lisp, etc., not to narrow margin.
+ \let\nonarrowing=\comment
+ \vbox\bgroup
+ \baselineskip=0pt\parskip=0pt\lineskip=0pt
+ \carttop
+ \hbox\bgroup
+ \hskip\lskip
+ \vrule\kern3pt
+ \vbox\bgroup
+ \hsize=\cartinner
+ \kern3pt
+ \begingroup
+ \baselineskip=\normbskip
+ \lineskip=\normlskip
+ \parskip=\normpskip
+ \vskip -\parskip
+\def\Ecartouche{%
+ \endgroup
+ \kern3pt
+ \egroup
+ \kern3pt\vrule
+ \hskip\rskip
+ \egroup
+ \cartbot
+ \egroup
+\endgroup
+}}
+
+
+% This macro is called at the beginning of all the @example variants,
+% inside a group.
+\def\nonfillstart{%
+ \aboveenvbreak
+ \inENV % This group ends at the end of the body
+ \hfuzz = 12pt % Don't be fussy
+ \sepspaces % Make spaces be word-separators rather than space tokens.
+ \singlespace
+ \let\par = \lisppar % don't ignore blank lines
+ \obeylines % each line of input is a line of output
+ \parskip = 0pt
+ \parindent = 0pt
+ \emergencystretch = 0pt % don't try to avoid overfull boxes
+ % @cartouche defines \nonarrowing to inhibit narrowing
+ % at next level down.
+ \ifx\nonarrowing\relax
+ \advance \leftskip by \lispnarrowing
+ \exdentamount=\lispnarrowing
+ \let\exdent=\nofillexdent
+ \let\nonarrowing=\relax
+ \fi
+}
+
+% To ending an @example-like environment, we first end the paragraph
+% (via \afterenvbreak's vertical glue), and then the group. That way we
+% keep the zero \parskip that the environments set -- \parskip glue
+% will be inserted at the beginning of the next paragraph in the
+% document, after the environment.
+%
+\def\nonfillfinish{\afterenvbreak\endgroup}%
+
+% This macro is
+\def\lisp{\begingroup
+ \nonfillstart
+ \let\Elisp = \nonfillfinish
+ \tt
+ \rawbackslash % have \ input char produce \ char from current font
+ \gobble
+}
+
+% Define the \E... control sequence only if we are inside the
+% environment, so the error checking in \end will work.
+%
+% We must call \lisp last in the definition, since it reads the
+% return following the @example (or whatever) command.
+%
+\def\example{\begingroup \def\Eexample{\nonfillfinish\endgroup}\lisp}
+\def\smallexample{\begingroup \def\Esmallexample{\nonfillfinish\endgroup}\lisp}
+\def\smalllisp{\begingroup \def\Esmalllisp{\nonfillfinish\endgroup}\lisp}
+
+% @smallexample and @smalllisp. This is not used unless the @smallbook
+% command is given. Originally contributed by Pavel@xerox.
+%
+\def\smalllispx{\begingroup
+ \nonfillstart
+ \let\Esmalllisp = \nonfillfinish
+ \let\Esmallexample = \nonfillfinish
+ %
+ % Smaller fonts for small examples.
+ \indexfonts \tt
+ \rawbackslash % make \ output the \ character from the current font (tt)
+ \gobble
+}
+
+% This is @display; same as @lisp except use roman font.
+%
+\def\display{\begingroup
+ \nonfillstart
+ \let\Edisplay = \nonfillfinish
+ \gobble
+}
+
+% This is @format; same as @display except don't narrow margins.
+%
+\def\format{\begingroup
+ \let\nonarrowing = t
+ \nonfillstart
+ \let\Eformat = \nonfillfinish
+ \gobble
+}
+
+% @flushleft (same as @format) and @flushright.
+%
+\def\flushleft{\begingroup
+ \let\nonarrowing = t
+ \nonfillstart
+ \let\Eflushleft = \nonfillfinish
+ \gobble
+}
+\def\flushright{\begingroup
+ \let\nonarrowing = t
+ \nonfillstart
+ \let\Eflushright = \nonfillfinish
+ \advance\leftskip by 0pt plus 1fill
+ \gobble}
+
+% @quotation does normal linebreaking (hence we can't use \nonfillstart)
+% and narrows the margins.
+%
+\def\quotation{%
+ \begingroup\inENV %This group ends at the end of the @quotation body
+ {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
+ \singlespace
+ \parindent=0pt
+ % We have retained a nonzero parskip for the environment, since we're
+ % doing normal filling. So to avoid extra space below the environment...
+ \def\Equotation{\parskip = 0pt \nonfillfinish}%
+ %
+ % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
+ \ifx\nonarrowing\relax
+ \advance\leftskip by \lispnarrowing
+ \advance\rightskip by \lispnarrowing
+ \exdentamount = \lispnarrowing
+ \let\nonarrowing = \relax
+ \fi
+}
+
+\message{defuns,}
+% Define formatter for defuns
+% First, allow user to change definition object font (\df) internally
+\def\setdeffont #1 {\csname DEF#1\endcsname}
+
+\newskip\defbodyindent \defbodyindent=.4in
+\newskip\defargsindent \defargsindent=50pt
+\newskip\deftypemargin \deftypemargin=12pt
+\newskip\deflastargmargin \deflastargmargin=18pt
+
+\newcount\parencount
+% define \functionparens, which makes ( and ) and & do special things.
+% \functionparens affects the group it is contained in.
+\def\activeparens{%
+\catcode`\(=\active \catcode`\)=\active \catcode`\&=\active
+\catcode`\[=\active \catcode`\]=\active}
+
+% Make control sequences which act like normal parenthesis chars.
+\let\lparen = ( \let\rparen = )
+
+{\activeparens % Now, smart parens don't turn on until &foo (see \amprm)
+
+% Be sure that we always have a definition for `(', etc. For example,
+% if the fn name has parens in it, \boldbrax will not be in effect yet,
+% so TeX would otherwise complain about undefined control sequence.
+\global\let(=\lparen \global\let)=\rparen
+\global\let[=\lbrack \global\let]=\rbrack
+
+\gdef\functionparens{\boldbrax\let&=\amprm\parencount=0 }
+\gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb}
+% This is used to turn on special parens
+% but make & act ordinary (given that it's active).
+\gdef\boldbraxnoamp{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb\let&=\ampnr}
+
+% Definitions of (, ) and & used in args for functions.
+% This is the definition of ( outside of all parentheses.
+\gdef\oprm#1 {{\rm\char`\(}#1 \bf \let(=\opnested
+ \global\advance\parencount by 1
+}
+%
+% This is the definition of ( when already inside a level of parens.
+\gdef\opnested{\char`\(\global\advance\parencount by 1 }
+%
+\gdef\clrm{% Print a paren in roman if it is taking us back to depth of 0.
+ % also in that case restore the outer-level definition of (.
+ \ifnum \parencount=1 {\rm \char `\)}\sl \let(=\oprm \else \char `\) \fi
+ \global\advance \parencount by -1 }
+% If we encounter &foo, then turn on ()-hacking afterwards
+\gdef\amprm#1 {{\rm\&#1}\let(=\oprm \let)=\clrm\ }
+%
+\gdef\normalparens{\boldbrax\let&=\ampnr}
+} % End of definition inside \activeparens
+%% These parens (in \boldbrax) actually are a little bolder than the
+%% contained text. This is especially needed for [ and ]
+\def\opnr{{\sf\char`\(}\global\advance\parencount by 1 }
+\def\clnr{{\sf\char`\)}\global\advance\parencount by -1 }
+\def\ampnr{\&}
+\def\lbrb{{\bf\char`\[}}
+\def\rbrb{{\bf\char`\]}}
+
+% First, defname, which formats the header line itself.
+% #1 should be the function name.
+% #2 should be the type of definition, such as "Function".
+
+\def\defname #1#2{%
+% Get the values of \leftskip and \rightskip as they were
+% outside the @def...
+\dimen2=\leftskip
+\advance\dimen2 by -\defbodyindent
+\dimen3=\rightskip
+\advance\dimen3 by -\defbodyindent
+\noindent %
+\setbox0=\hbox{\hskip \deflastargmargin{\rm #2}\hskip \deftypemargin}%
+\dimen0=\hsize \advance \dimen0 by -\wd0 % compute size for first line
+\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuations
+\parshape 2 0in \dimen0 \defargsindent \dimen1 %
+% Now output arg 2 ("Function" or some such)
+% ending at \deftypemargin from the right margin,
+% but stuck inside a box of width 0 so it does not interfere with linebreaking
+{% Adjust \hsize to exclude the ambient margins,
+% so that \rightline will obey them.
+\advance \hsize by -\dimen2 \advance \hsize by -\dimen3
+\rlap{\rightline{{\rm #2}\hskip \deftypemargin}}}%
+% Make all lines underfull and no complaints:
+\tolerance=10000 \hbadness=10000
+\advance\leftskip by -\defbodyindent
+\exdentamount=\defbodyindent
+{\df #1}\enskip % Generate function name
+}
+
+% Actually process the body of a definition
+% #1 should be the terminating control sequence, such as \Edefun.
+% #2 should be the "another name" control sequence, such as \defunx.
+% #3 should be the control sequence that actually processes the header,
+% such as \defunheader.
+
+\def\defparsebody #1#2#3{\begingroup\inENV% Environment for definitionbody
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2{\begingroup\obeylines\activeparens\spacesplit#3}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup %
+\catcode 61=\active % 61 is `='
+\obeylines\activeparens\spacesplit#3}
+
+\def\defmethparsebody #1#2#3#4 {\begingroup\inENV %
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2##1 {\begingroup\obeylines\activeparens\spacesplit{#3{##1}}}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup\obeylines\activeparens\spacesplit{#3{#4}}}
+
+\def\defopparsebody #1#2#3#4#5 {\begingroup\inENV %
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2##1 ##2 {\def#4{##1}%
+\begingroup\obeylines\activeparens\spacesplit{#3{##2}}}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup\obeylines\activeparens\spacesplit{#3{#5}}}
+
+% These parsing functions are similar to the preceding ones
+% except that they do not make parens into active characters.
+% These are used for "variables" since they have no arguments.
+
+\def\defvarparsebody #1#2#3{\begingroup\inENV% Environment for definitionbody
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2{\begingroup\obeylines\spacesplit#3}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup %
+\catcode 61=\active %
+\obeylines\spacesplit#3}
+
+% This is used for \def{tp,vr}parsebody. It could probably be used for
+% some of the others, too, with some judicious conditionals.
+%
+\def\parsebodycommon#1#2#3{%
+ \begingroup\inENV %
+ \medbreak %
+ % Define the end token that this defining construct specifies
+ % so that it will exit this group.
+ \def#1{\endgraf\endgroup\medbreak}%
+ \def#2##1 {\begingroup\obeylines\spacesplit{#3{##1}}}%
+ \parindent=0in
+ \advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+ \exdentamount=\defbodyindent
+ \begingroup\obeylines
+}
+
+\def\defvrparsebody#1#2#3#4 {%
+ \parsebodycommon{#1}{#2}{#3}%
+ \spacesplit{#3{#4}}%
+}
+
+% This loses on `@deftp {Data Type} {struct termios}' -- it thinks the
+% type is just `struct', because we lose the braces in `{struct
+% termios}' when \spacesplit reads its undelimited argument. Sigh.
+% \let\deftpparsebody=\defvrparsebody
+%
+% So, to get around this, we put \empty in with the type name. That
+% way, TeX won't find exactly `{...}' as an undelimited argument, and
+% won't strip off the braces.
+%
+\def\deftpparsebody #1#2#3#4 {%
+ \parsebodycommon{#1}{#2}{#3}%
+ \spacesplit{\parsetpheaderline{#3{#4}}}\empty
+}
+
+% Fine, but then we have to eventually remove the \empty *and* the
+% braces (if any). That's what this does.
+%
+\def\removeemptybraces\empty#1\relax{#1}
+
+% After \spacesplit has done its work, this is called -- #1 is the final
+% thing to call, #2 the type name (which starts with \empty), and #3
+% (which might be empty) the arguments.
+%
+\def\parsetpheaderline#1#2#3{%
+ #1{\removeemptybraces#2\relax}{#3}%
+}%
+
+\def\defopvarparsebody #1#2#3#4#5 {\begingroup\inENV %
+\medbreak %
+% Define the end token that this defining construct specifies
+% so that it will exit this group.
+\def#1{\endgraf\endgroup\medbreak}%
+\def#2##1 ##2 {\def#4{##1}%
+\begingroup\obeylines\spacesplit{#3{##2}}}%
+\parindent=0in
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent
+\exdentamount=\defbodyindent
+\begingroup\obeylines\spacesplit{#3{#5}}}
+
+% Split up #2 at the first space token.
+% call #1 with two arguments:
+% the first is all of #2 before the space token,
+% the second is all of #2 after that space token.
+% If #2 contains no space token, all of it is passed as the first arg
+% and the second is passed as empty.
+
+{\obeylines
+\gdef\spacesplit#1#2^^M{\endgroup\spacesplitfoo{#1}#2 \relax\spacesplitfoo}%
+\long\gdef\spacesplitfoo#1#2 #3#4\spacesplitfoo{%
+\ifx\relax #3%
+#1{#2}{}\else #1{#2}{#3#4}\fi}}
+
+% So much for the things common to all kinds of definitions.
+
+% Define @defun.
+
+% First, define the processing that is wanted for arguments of \defun
+% Use this to expand the args and terminate the paragraph they make up
+
+\def\defunargs #1{\functionparens \sl
+% Expand, preventing hyphenation at `-' chars.
+% Note that groups don't affect changes in \hyphenchar.
+\hyphenchar\tensl=0
+#1%
+\hyphenchar\tensl=45
+\ifnum\parencount=0 \else \errmessage{Unbalanced parentheses in @def}\fi%
+\interlinepenalty=10000
+\advance\rightskip by 0pt plus 1fil
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000%
+}
+
+\def\deftypefunargs #1{%
+% Expand, preventing hyphenation at `-' chars.
+% Note that groups don't affect changes in \hyphenchar.
+% Use \boldbraxnoamp, not \functionparens, so that & is not special.
+\boldbraxnoamp
+\tclose{#1}% avoid \code because of side effects on active chars
+\interlinepenalty=10000
+\advance\rightskip by 0pt plus 1fil
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000%
+}
+
+% Do complete processing of one @defun or @defunx line already parsed.
+
+% @deffn Command forward-char nchars
+
+\def\deffn{\defmethparsebody\Edeffn\deffnx\deffnheader}
+
+\def\deffnheader #1#2#3{\doind {fn}{\code{#2}}%
+\begingroup\defname {#2}{#1}\defunargs{#3}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @defun == @deffn Function
+
+\def\defun{\defparsebody\Edefun\defunx\defunheader}
+
+\def\defunheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index
+\begingroup\defname {#1}{Function}%
+\defunargs {#2}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @deftypefun int foobar (int @var{foo}, float @var{bar})
+
+\def\deftypefun{\defparsebody\Edeftypefun\deftypefunx\deftypefunheader}
+
+% #1 is the data type. #2 is the name and args.
+\def\deftypefunheader #1#2{\deftypefunheaderx{#1}#2 \relax}
+% #1 is the data type, #2 the name, #3 the args.
+\def\deftypefunheaderx #1#2 #3\relax{%
+\doind {fn}{\code{#2}}% Make entry in function index
+\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Function}%
+\deftypefunargs {#3}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @deftypefn {Library Function} int foobar (int @var{foo}, float @var{bar})
+
+\def\deftypefn{\defmethparsebody\Edeftypefn\deftypefnx\deftypefnheader}
+
+% \defheaderxcond#1\relax$$$
+% puts #1 in @code, followed by a space, but does nothing if #1 is null.
+\def\defheaderxcond#1#2$$${\ifx#1\relax\else\code{#1#2} \fi}
+
+% #1 is the classification. #2 is the data type. #3 is the name and args.
+\def\deftypefnheader #1#2#3{\deftypefnheaderx{#1}{#2}#3 \relax}
+% #1 is the classification, #2 the data type, #3 the name, #4 the args.
+\def\deftypefnheaderx #1#2#3 #4\relax{%
+\doind {fn}{\code{#3}}% Make entry in function index
+\begingroup
+\normalparens % notably, turn off `&' magic, which prevents
+% at least some C++ text from working
+\defname {\defheaderxcond#2\relax$$$#3}{#1}%
+\deftypefunargs {#4}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @defmac == @deffn Macro
+
+\def\defmac{\defparsebody\Edefmac\defmacx\defmacheader}
+
+\def\defmacheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index
+\begingroup\defname {#1}{Macro}%
+\defunargs {#2}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% @defspec == @deffn Special Form
+
+\def\defspec{\defparsebody\Edefspec\defspecx\defspecheader}
+
+\def\defspecheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index
+\begingroup\defname {#1}{Special Form}%
+\defunargs {#2}\endgroup %
+\catcode 61=\other % Turn off change made in \defparsebody
+}
+
+% This definition is run if you use @defunx
+% anywhere other than immediately after a @defun or @defunx.
+
+\def\deffnx #1 {\errmessage{@deffnx in invalid context}}
+\def\defunx #1 {\errmessage{@defunx in invalid context}}
+\def\defmacx #1 {\errmessage{@defmacx in invalid context}}
+\def\defspecx #1 {\errmessage{@defspecx in invalid context}}
+\def\deftypefnx #1 {\errmessage{@deftypefnx in invalid context}}
+\def\deftypemethodx #1 {\errmessage{@deftypemethodx in invalid context}}
+\def\deftypeunx #1 {\errmessage{@deftypeunx in invalid context}}
+
+% @defmethod, and so on
+
+% @defop {Funny Method} foo-class frobnicate argument
+
+\def\defop #1 {\def\defoptype{#1}%
+\defopparsebody\Edefop\defopx\defopheader\defoptype}
+
+\def\defopheader #1#2#3{%
+\dosubind {fn}{\code{#2}}{on #1}% Make entry in function index
+\begingroup\defname {#2}{\defoptype{} on #1}%
+\defunargs {#3}\endgroup %
+}
+
+% @deftypemethod foo-class return-type foo-method args
+%
+\def\deftypemethod{%
+ \defmethparsebody\Edeftypemethod\deftypemethodx\deftypemethodheader}
+%
+% #1 is the class name, #2 the data type, #3 the method name, #4 the args.
+\def\deftypemethodheader#1#2#3#4{%
+ \deftypefnheaderx{Method on #1}{#2}#3 #4\relax
+}
+
+% @defmethod == @defop Method
+
+\def\defmethod{\defmethparsebody\Edefmethod\defmethodx\defmethodheader}
+
+\def\defmethodheader #1#2#3{%
+\dosubind {fn}{\code{#2}}{on #1}% entry in function index
+\begingroup\defname {#2}{Method on #1}%
+\defunargs {#3}\endgroup %
+}
+
+% @defcv {Class Option} foo-class foo-flag
+
+\def\defcv #1 {\def\defcvtype{#1}%
+\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}
+
+\def\defcvarheader #1#2#3{%
+\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index
+\begingroup\defname {#2}{\defcvtype{} of #1}%
+\defvarargs {#3}\endgroup %
+}
+
+% @defivar == @defcv {Instance Variable}
+
+\def\defivar{\defvrparsebody\Edefivar\defivarx\defivarheader}
+
+\def\defivarheader #1#2#3{%
+\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index
+\begingroup\defname {#2}{Instance Variable of #1}%
+\defvarargs {#3}\endgroup %
+}
+
+% These definitions are run if you use @defmethodx, etc.,
+% anywhere other than immediately after a @defmethod, etc.
+
+\def\defopx #1 {\errmessage{@defopx in invalid context}}
+\def\defmethodx #1 {\errmessage{@defmethodx in invalid context}}
+\def\defcvx #1 {\errmessage{@defcvx in invalid context}}
+\def\defivarx #1 {\errmessage{@defivarx in invalid context}}
+
+% Now @defvar
+
+% First, define the processing that is wanted for arguments of @defvar.
+% This is actually simple: just print them in roman.
+% This must expand the args and terminate the paragraph they make up
+\def\defvarargs #1{\normalparens #1%
+\interlinepenalty=10000
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000}
+
+% @defvr Counter foo-count
+
+\def\defvr{\defvrparsebody\Edefvr\defvrx\defvrheader}
+
+\def\defvrheader #1#2#3{\doind {vr}{\code{#2}}%
+\begingroup\defname {#2}{#1}\defvarargs{#3}\endgroup}
+
+% @defvar == @defvr Variable
+
+\def\defvar{\defvarparsebody\Edefvar\defvarx\defvarheader}
+
+\def\defvarheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index
+\begingroup\defname {#1}{Variable}%
+\defvarargs {#2}\endgroup %
+}
+
+% @defopt == @defvr {User Option}
+
+\def\defopt{\defvarparsebody\Edefopt\defoptx\defoptheader}
+
+\def\defoptheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index
+\begingroup\defname {#1}{User Option}%
+\defvarargs {#2}\endgroup %
+}
+
+% @deftypevar int foobar
+
+\def\deftypevar{\defvarparsebody\Edeftypevar\deftypevarx\deftypevarheader}
+
+% #1 is the data type. #2 is the name, perhaps followed by text that
+% is actually part of the data type, which should not be put into the index.
+\def\deftypevarheader #1#2{%
+\dovarind#2 \relax% Make entry in variables index
+\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Variable}%
+\interlinepenalty=10000
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000
+\endgroup}
+\def\dovarind#1 #2\relax{\doind{vr}{\code{#1}}}
+
+% @deftypevr {Global Flag} int enable
+
+\def\deftypevr{\defvrparsebody\Edeftypevr\deftypevrx\deftypevrheader}
+
+\def\deftypevrheader #1#2#3{\dovarind#3 \relax%
+\begingroup\defname {\defheaderxcond#2\relax$$$#3}{#1}
+\interlinepenalty=10000
+\endgraf\penalty 10000\vskip -\parskip\penalty 10000
+\endgroup}
+
+% This definition is run if you use @defvarx
+% anywhere other than immediately after a @defvar or @defvarx.
+
+\def\defvrx #1 {\errmessage{@defvrx in invalid context}}
+\def\defvarx #1 {\errmessage{@defvarx in invalid context}}
+\def\defoptx #1 {\errmessage{@defoptx in invalid context}}
+\def\deftypevarx #1 {\errmessage{@deftypevarx in invalid context}}
+\def\deftypevrx #1 {\errmessage{@deftypevrx in invalid context}}
+
+% Now define @deftp
+% Args are printed in bold, a slight difference from @defvar.
+
+\def\deftpargs #1{\bf \defvarargs{#1}}
+
+% @deftp Class window height width ...
+
+\def\deftp{\deftpparsebody\Edeftp\deftpx\deftpheader}
+
+\def\deftpheader #1#2#3{\doind {tp}{\code{#2}}%
+\begingroup\defname {#2}{#1}\deftpargs{#3}\endgroup}
+
+% This definition is run if you use @deftpx, etc
+% anywhere other than immediately after a @deftp, etc.
+
+\def\deftpx #1 {\errmessage{@deftpx in invalid context}}
+
+
+\message{cross reference,}
+% Define cross-reference macros
+\newwrite \auxfile
+
+\newif\ifhavexrefs % True if xref values are known.
+\newif\ifwarnedxrefs % True if we warned once that they aren't known.
+
+% @inforef is simple.
+\def\inforef #1{\inforefzzz #1,,,,**}
+\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}},
+ node \samp{\ignorespaces#1{}}}
+
+% \setref{foo} defines a cross-reference point named foo.
+
+\def\setref#1{%
+\dosetq{#1-title}{Ytitle}%
+\dosetq{#1-pg}{Ypagenumber}%
+\dosetq{#1-snt}{Ysectionnumberandtype}}
+
+\def\unnumbsetref#1{%
+\dosetq{#1-title}{Ytitle}%
+\dosetq{#1-pg}{Ypagenumber}%
+\dosetq{#1-snt}{Ynothing}}
+
+\def\appendixsetref#1{%
+\dosetq{#1-title}{Ytitle}%
+\dosetq{#1-pg}{Ypagenumber}%
+\dosetq{#1-snt}{Yappendixletterandtype}}
+
+% \xref, \pxref, and \ref generate cross-references to specified points.
+% For \xrefX, #1 is the node name, #2 the name of the Info
+% cross-reference, #3 the printed node name, #4 the name of the Info
+% file, #5 the name of the printed manual. All but the node name can be
+% omitted.
+%
+\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]}
+\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]}
+\def\ref#1{\xrefX[#1,,,,,,,]}
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup
+ \def\printedmanual{\ignorespaces #5}%
+ \def\printednodename{\ignorespaces #3}%
+ \setbox1=\hbox{\printedmanual}%
+ \setbox0=\hbox{\printednodename}%
+ \ifdim \wd0 = 0pt
+ % No printed node name was explicitly given.
+ \expandafter\ifx\csname SETxref-automatic-section-title\endcsname\relax
+ % Use the node name inside the square brackets.
+ \def\printednodename{\ignorespaces #1}%
+ \else
+ % Use the actual chapter/section title appear inside
+ % the square brackets. Use the real section title if we have it.
+ \ifdim \wd1>0pt%
+ % It is in another manual, so we don't have it.
+ \def\printednodename{\ignorespaces #1}%
+ \else
+ \ifhavexrefs
+ % We know the real title if we have the xref values.
+ \def\printednodename{\refx{#1-title}{}}%
+ \else
+ % Otherwise just copy the Info node name.
+ \def\printednodename{\ignorespaces #1}%
+ \fi%
+ \fi
+ \fi
+ \fi
+ %
+ % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not
+ % insert empty discretionaries after hyphens, which means that it will
+ % not find a line break at a hyphen in a node names. Since some manuals
+ % are best written with fairly long node names, containing hyphens, this
+ % is a loss. Therefore, we give the text of the node name again, so it
+ % is as if TeX is seeing it for the first time.
+ \ifdim \wd1 > 0pt
+ \putwordsection{} ``\printednodename'' in \cite{\printedmanual}%
+ \else
+ % _ (for example) has to be the character _ for the purposes of the
+ % control sequence corresponding to the node, but it has to expand
+ % into the usual \leavevmode...\vrule stuff for purposes of
+ % printing. So we \turnoffactive for the \refx-snt, back on for the
+ % printing, back off for the \refx-pg.
+ {\turnoffactive \refx{#1-snt}{}}%
+ \space [\printednodename],\space
+ \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
+ \fi
+\endgroup}
+
+% \dosetq is the interface for calls from other macros
+
+% Use \turnoffactive so that punctuation chars such as underscore
+% work in node names.
+\def\dosetq #1#2{{\let\folio=0 \turnoffactive
+\edef\next{\write\auxfile{\internalsetq {#1}{#2}}}%
+\next}}
+
+% \internalsetq {foo}{page} expands into
+% CHARACTERS 'xrdef {foo}{...expansion of \Ypage...}
+% When the aux file is read, ' is the escape character
+
+\def\internalsetq #1#2{'xrdef {#1}{\csname #2\endcsname}}
+
+% Things to be expanded by \internalsetq
+
+\def\Ypagenumber{\folio}
+
+\def\Ytitle{\thissection}
+
+\def\Ynothing{}
+
+\def\Ysectionnumberandtype{%
+\ifnum\secno=0 \putwordChapter\xreftie\the\chapno %
+\else \ifnum \subsecno=0 \putwordSection\xreftie\the\chapno.\the\secno %
+\else \ifnum \subsubsecno=0 %
+\putwordSection\xreftie\the\chapno.\the\secno.\the\subsecno %
+\else %
+\putwordSection\xreftie\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno %
+\fi \fi \fi }
+
+\def\Yappendixletterandtype{%
+\ifnum\secno=0 \putwordAppendix\xreftie'char\the\appendixno{}%
+\else \ifnum \subsecno=0 \putwordSection\xreftie'char\the\appendixno.\the\secno %
+\else \ifnum \subsubsecno=0 %
+\putwordSection\xreftie'char\the\appendixno.\the\secno.\the\subsecno %
+\else %
+\putwordSection\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %
+\fi \fi \fi }
+
+\gdef\xreftie{'tie}
+
+% Use TeX 3.0's \inputlineno to get the line number, for better error
+% messages, but if we're using an old version of TeX, don't do anything.
+%
+\ifx\inputlineno\thisisundefined
+ \let\linenumber = \empty % Non-3.0.
+\else
+ \def\linenumber{\the\inputlineno:\space}
+\fi
+
+% Define \refx{NAME}{SUFFIX} to reference a cross-reference string named NAME.
+% If its value is nonempty, SUFFIX is output afterward.
+
+\def\refx#1#2{%
+ \expandafter\ifx\csname X#1\endcsname\relax
+ % If not defined, say something at least.
+ $\langle$un\-de\-fined$\rangle$%
+ \ifhavexrefs
+ \message{\linenumber Undefined cross reference `#1'.}%
+ \else
+ \ifwarnedxrefs\else
+ \global\warnedxrefstrue
+ \message{Cross reference values unknown; you must run TeX again.}%
+ \fi
+ \fi
+ \else
+ % It's defined, so just use it.
+ \csname X#1\endcsname
+ \fi
+ #2% Output the suffix in any case.
+}
+
+% This is the macro invoked by entries in the aux file.
+\def\xrdef #1#2{{%
+ \catcode`\'=\other
+ \expandafter\gdef\csname X#1\endcsname{#2}%
+}}
+
+% Read the last existing aux file, if any. No error if none exists.
+\def\readauxfile{\begingroup
+ \catcode`\^^@=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\^^C=\other
+ \catcode`\^^D=\other
+ \catcode`\^^E=\other
+ \catcode`\^^F=\other
+ \catcode`\^^G=\other
+ \catcode`\^^H=\other
+ \catcode`\ =\other
+ \catcode`\^^L=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode`\=\other
+ \catcode26=\other
+ \catcode`\^^[=\other
+ \catcode`\^^\=\other
+ \catcode`\^^]=\other
+ \catcode`\^^^=\other
+ \catcode`\^^_=\other
+ \catcode`\@=\other
+ \catcode`\^=\other
+ % It was suggested to define this as 7, which would allow ^^e4 etc.
+ % in xref tags, i.e., node names. But since ^^e4 notation isn't
+ % supported in the main text, it doesn't seem desirable. Furthermore,
+ % that is not enough: for node names that actually contain a ^
+ % character, we would end up writing a line like this: 'xrdef {'hat
+ % b-title}{'hat b} and \xrdef does a \csname...\endcsname on the first
+ % argument, and \hat is not an expandable control sequence. It could
+ % all be worked out, but why? Either we support ^^ or we don't.
+ %
+ % The other change necessary for this was to define \auxhat:
+ % \def\auxhat{\def^{'hat }}% extra space so ok if followed by letter
+ % and then to call \auxhat in \setq.
+ %
+ \catcode`\~=\other
+ \catcode`\[=\other
+ \catcode`\]=\other
+ \catcode`\"=\other
+ \catcode`\_=\other
+ \catcode`\|=\other
+ \catcode`\<=\other
+ \catcode`\>=\other
+ \catcode`\$=\other
+ \catcode`\#=\other
+ \catcode`\&=\other
+ % `\+ does not work, so use 43.
+ \catcode43=\other
+ % Make the characters 128-255 be printing characters
+ {%
+ \count 1=128
+ \def\loop{%
+ \catcode\count 1=\other
+ \advance\count 1 by 1
+ \ifnum \count 1<256 \loop \fi
+ }%
+ }%
+ % The aux file uses ' as the escape (for now).
+ % Turn off \ as an escape so we do not lose on
+ % entries which were dumped with control sequences in their names.
+ % For example, 'xrdef {$\leq $-fun}{page ...} made by @defun ^^
+ % Reference to such entries still does not work the way one would wish,
+ % but at least they do not bomb out when the aux file is read in.
+ \catcode`\{=1
+ \catcode`\}=2
+ \catcode`\%=\other
+ \catcode`\'=0
+ \catcode`\\=\other
+ %
+ \openin 1 \jobname.aux
+ \ifeof 1 \else
+ \closein 1
+ \input \jobname.aux
+ \global\havexrefstrue
+ \global\warnedobstrue
+ \fi
+ % Open the new aux file. TeX will close it automatically at exit.
+ \openout\auxfile=\jobname.aux
+\endgroup}
+
+
+% Footnotes.
+
+\newcount \footnoteno
+
+% The trailing space in the following definition for supereject is
+% vital for proper filling; pages come out unaligned when you do a
+% pagealignmacro call if that space before the closing brace is
+% removed. (Generally, numeric constants should always be followed by a
+% space to prevent strange expansion errors.)
+\def\supereject{\par\penalty -20000\footnoteno =0 }
+
+% @footnotestyle is meaningful for info output only..
+\let\footnotestyle=\comment
+
+\let\ptexfootnote=\footnote
+
+{\catcode `\@=11
+%
+% Auto-number footnotes. Otherwise like plain.
+\gdef\footnote{%
+ \global\advance\footnoteno by \@ne
+ \edef\thisfootno{$^{\the\footnoteno}$}%
+ %
+ % In case the footnote comes at the end of a sentence, preserve the
+ % extra spacing after we do the footnote number.
+ \let\@sf\empty
+ \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\/\fi
+ %
+ % Remove inadvertent blank space before typesetting the footnote number.
+ \unskip
+ \thisfootno\@sf
+ \footnotezzz
+}%
+
+% Don't bother with the trickery in plain.tex to not require the
+% footnote text as a parameter. Our footnotes don't need to be so general.
+%
+% Oh yes, they do; otherwise, @ifset and anything else that uses
+% \parseargline fail inside footnotes because the tokens are fixed when
+% the footnote is read. --karl, 16nov96.
+%
+\long\gdef\footnotezzz{\insert\footins\bgroup
+ % We want to typeset this text as a normal paragraph, even if the
+ % footnote reference occurs in (for example) a display environment.
+ % So reset some parameters.
+ \interlinepenalty\interfootnotelinepenalty
+ \splittopskip\ht\strutbox % top baseline for broken footnotes
+ \splitmaxdepth\dp\strutbox
+ \floatingpenalty\@MM
+ \leftskip\z@skip
+ \rightskip\z@skip
+ \spaceskip\z@skip
+ \xspaceskip\z@skip
+ \parindent\defaultparindent
+ %
+ % Hang the footnote text off the number.
+ \hang
+ \textindent{\thisfootno}%
+ %
+ % Don't crash into the line above the footnote text. Since this
+ % expands into a box, it must come within the paragraph, lest it
+ % provide a place where TeX can split the footnote.
+ \footstrut
+ \futurelet\next\fo@t
+}
+\def\fo@t{\ifcat\bgroup\noexpand\next \let\next\f@@t
+ \else\let\next\f@t\fi \next}
+\def\f@@t{\bgroup\aftergroup\@foot\let\next}
+\def\f@t#1{#1\@foot}
+\def\@foot{\strut\egroup}
+
+}%end \catcode `\@=11
+
+% Set the baselineskip to #1, and the lineskip and strut size
+% correspondingly. There is no deep meaning behind these magic numbers
+% used as factors; they just match (closely enough) what Knuth defined.
+%
+\def\lineskipfactor{.08333}
+\def\strutheightpercent{.70833}
+\def\strutdepthpercent {.29167}
+%
+\def\setleading#1{%
+ \normalbaselineskip = #1\relax
+ \normallineskip = \lineskipfactor\normalbaselineskip
+ \normalbaselines
+ \setbox\strutbox =\hbox{%
+ \vrule width0pt height\strutheightpercent\baselineskip
+ depth \strutdepthpercent \baselineskip
+ }%
+}
+
+% @| inserts a changebar to the left of the current line. It should
+% surround any changed text. This approach does *not* work if the
+% change spans more than two lines of output. To handle that, we would
+% have adopt a much more difficult approach (putting marks into the main
+% vertical list for the beginning and end of each change).
+%
+\def\|{%
+ % \vadjust can only be used in horizontal mode.
+ \leavevmode
+ %
+ % Append this vertical mode material after the current line in the output.
+ \vadjust{%
+ % We want to insert a rule with the height and depth of the current
+ % leading; that is exactly what \strutbox is supposed to record.
+ \vskip-\baselineskip
+ %
+ % \vadjust-items are inserted at the left edge of the type. So
+ % the \llap here moves out into the left-hand margin.
+ \llap{%
+ %
+ % For a thicker or thinner bar, change the `1pt'.
+ \vrule height\baselineskip width1pt
+ %
+ % This is the space between the bar and the text.
+ \hskip 12pt
+ }%
+ }%
+}
+
+% For a final copy, take out the rectangles
+% that mark overfull boxes (in case you have decided
+% that the text looks ok even though it passes the margin).
+%
+\def\finalout{\overfullrule=0pt}
+
+
+% End of control word definitions.
+
+\message{and turning on texinfo input format.}
+
+\def\openindices{%
+ \newindex{cp}%
+ \newcodeindex{fn}%
+ \newcodeindex{vr}%
+ \newcodeindex{tp}%
+ \newcodeindex{ky}%
+ \newcodeindex{pg}%
+}
+
+% Set some numeric style parameters, for 8.5 x 11 format.
+
+\hsize = 6in
+\hoffset = .25in
+\newdimen\defaultparindent \defaultparindent = 15pt
+\parindent = \defaultparindent
+\parskip 3pt plus 2pt minus 1pt
+\setleading{13.2pt}
+\advance\topskip by 1.2cm
+
+\chapheadingskip = 15pt plus 4pt minus 2pt
+\secheadingskip = 12pt plus 3pt minus 2pt
+\subsecheadingskip = 9pt plus 2pt minus 2pt
+
+% Prevent underfull vbox error messages.
+\vbadness=10000
+
+% Following George Bush, just get rid of widows and orphans.
+\widowpenalty=10000
+\clubpenalty=10000
+
+% Use TeX 3.0's \emergencystretch to help line breaking, but if we're
+% using an old version of TeX, don't do anything. We want the amount of
+% stretch added to depend on the line length, hence the dependence on
+% \hsize. This makes it come to about 9pt for the 8.5x11 format.
+%
+\ifx\emergencystretch\thisisundefined
+ % Allow us to assign to \emergencystretch anyway.
+ \def\emergencystretch{\dimen0}%
+\else
+ \emergencystretch = \hsize
+ \divide\emergencystretch by 45
+\fi
+
+% Use @smallbook to reset parameters for 7x9.5 format (or else 7x9.25)
+\def\smallbook{
+ \global\chapheadingskip = 15pt plus 4pt minus 2pt
+ \global\secheadingskip = 12pt plus 3pt minus 2pt
+ \global\subsecheadingskip = 9pt plus 2pt minus 2pt
+ %
+ \global\lispnarrowing = 0.3in
+ \setleading{12pt}
+ \advance\topskip by -1cm
+ \global\parskip 2pt plus 1pt
+ \global\hsize = 5in
+ \global\vsize=7.5in
+ \global\tolerance=700
+ \global\hfuzz=1pt
+ \global\contentsrightmargin=0pt
+ \global\deftypemargin=0pt
+ \global\defbodyindent=.5cm
+ %
+ \global\pagewidth=\hsize
+ \global\pageheight=\vsize
+ %
+ \global\let\smalllisp=\smalllispx
+ \global\let\smallexample=\smalllispx
+ \global\def\Esmallexample{\Esmalllisp}
+}
+
+% Use @afourpaper to print on European A4 paper.
+\def\afourpaper{
+\global\tolerance=700
+\global\hfuzz=1pt
+\setleading{12pt}
+\global\parskip 15pt plus 1pt
+
+\global\vsize= 53\baselineskip
+\advance\vsize by \topskip
+%\global\hsize= 5.85in % A4 wide 10pt
+\global\hsize= 6.5in
+\global\outerhsize=\hsize
+\global\advance\outerhsize by 0.5in
+\global\outervsize=\vsize
+\global\advance\outervsize by 0.6in
+
+\global\pagewidth=\hsize
+\global\pageheight=\vsize
+}
+
+\bindingoffset=0pt
+\normaloffset=\hoffset
+\pagewidth=\hsize
+\pageheight=\vsize
+
+% Allow control of the text dimensions. Parameters in order: textheight;
+% textwidth; voffset; hoffset; binding offset; topskip.
+% All require a dimension;
+% header is additional; added length extends the bottom of the page.
+
+\def\changepagesizes#1#2#3#4#5#6{
+ \global\vsize= #1
+ \global\topskip= #6
+ \advance\vsize by \topskip
+ \global\voffset= #3
+ \global\hsize= #2
+ \global\outerhsize=\hsize
+ \global\advance\outerhsize by 0.5in
+ \global\outervsize=\vsize
+ \global\advance\outervsize by 0.6in
+ \global\pagewidth=\hsize
+ \global\pageheight=\vsize
+ \global\normaloffset= #4
+ \global\bindingoffset= #5}
+
+% A specific text layout, 24x15cm overall, intended for A4 paper. Top margin
+% 29mm, hence bottom margin 28mm, nominal side margin 3cm.
+\def\afourlatex
+ {\global\tolerance=700
+ \global\hfuzz=1pt
+ \setleading{12pt}
+ \global\parskip 15pt plus 1pt
+ \advance\baselineskip by 1.6pt
+ \changepagesizes{237mm}{150mm}{3.6mm}{3.6mm}{3mm}{7mm}
+ }
+
+% Use @afourwide to print on European A4 paper in wide format.
+\def\afourwide{\afourpaper
+\changepagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}{7mm}}
+
+% Define macros to output various characters with catcode for normal text.
+\catcode`\"=\other
+\catcode`\~=\other
+\catcode`\^=\other
+\catcode`\_=\other
+\catcode`\|=\other
+\catcode`\<=\other
+\catcode`\>=\other
+\catcode`\+=\other
+\def\normaldoublequote{"}
+\def\normaltilde{~}
+\def\normalcaret{^}
+\def\normalunderscore{_}
+\def\normalverticalbar{|}
+\def\normalless{<}
+\def\normalgreater{>}
+\def\normalplus{+}
+
+% This macro is used to make a character print one way in ttfont
+% where it can probably just be output, and another way in other fonts,
+% where something hairier probably needs to be done.
+%
+% #1 is what to print if we are indeed using \tt; #2 is what to print
+% otherwise. Since all the Computer Modern typewriter fonts have zero
+% interword stretch (and shrink), and it is reasonable to expect all
+% typewriter fonts to have this, we can check that font parameter.
+%
+\def\ifusingtt#1#2{\ifdim \fontdimen3\the\font=0pt #1\else #2\fi}
+
+% Turn off all special characters except @
+% (and those which the user can use as if they were ordinary).
+% Most of these we simply print from the \tt font, but for some, we can
+% use math or other variants that look better in normal text.
+
+\catcode`\"=\active
+\def\activedoublequote{{\tt \char '042}}
+\let"=\activedoublequote
+\catcode`\~=\active
+\def~{{\tt \char '176}}
+\chardef\hat=`\^
+\catcode`\^=\active
+\def^{{\tt \hat}}
+
+\catcode`\_=\active
+\def_{\ifusingtt\normalunderscore\_}
+% Subroutine for the previous macro.
+\def\_{\leavevmode \kern.06em \vbox{\hrule width.3em height.1ex}}
+
+\catcode`\|=\active
+\def|{{\tt \char '174}}
+\chardef \less=`\<
+\catcode`\<=\active
+\def<{{\tt \less}}
+\chardef \gtr=`\>
+\catcode`\>=\active
+\def>{{\tt \gtr}}
+\catcode`\+=\active
+\def+{{\tt \char 43}}
+%\catcode 27=\active
+%\def^^[{$\diamondsuit$}
+
+% Set up an active definition for =, but don't enable it most of the time.
+{\catcode`\==\active
+\global\def={{\tt \char 61}}}
+
+\catcode`+=\active
+\catcode`\_=\active
+
+% If a .fmt file is being used, characters that might appear in a file
+% name cannot be active until we have parsed the command line.
+% So turn them off again, and have \everyjob (or @setfilename) turn them on.
+% \otherifyactive is called near the end of this file.
+\def\otherifyactive{\catcode`+=\other \catcode`\_=\other}
+
+\catcode`\@=0
+
+% \rawbackslashxx output one backslash character in current font
+\global\chardef\rawbackslashxx=`\\
+%{\catcode`\\=\other
+%@gdef@rawbackslashxx{\}}
+
+% \rawbackslash redefines \ as input to do \rawbackslashxx.
+{\catcode`\\=\active
+@gdef@rawbackslash{@let\=@rawbackslashxx }}
+
+% \normalbackslash outputs one backslash in fixed width font.
+\def\normalbackslash{{\tt\rawbackslashxx}}
+
+% Say @foo, not \foo, in error messages.
+\escapechar=`\@
+
+% \catcode 17=0 % Define control-q
+\catcode`\\=\active
+
+% Used sometimes to turn off (effectively) the active characters
+% even after parsing them.
+@def@turnoffactive{@let"=@normaldoublequote
+@let\=@realbackslash
+@let~=@normaltilde
+@let^=@normalcaret
+@let_=@normalunderscore
+@let|=@normalverticalbar
+@let<=@normalless
+@let>=@normalgreater
+@let+=@normalplus}
+
+@def@normalturnoffactive{@let"=@normaldoublequote
+@let\=@normalbackslash
+@let~=@normaltilde
+@let^=@normalcaret
+@let_=@normalunderscore
+@let|=@normalverticalbar
+@let<=@normalless
+@let>=@normalgreater
+@let+=@normalplus}
+
+% Make _ and + \other characters, temporarily.
+% This is canceled by @fixbackslash.
+@otherifyactive
+
+% If a .fmt file is being used, we don't want the `\input texinfo' to show up.
+% That is what \eatinput is for; after that, the `\' should revert to printing
+% a backslash.
+%
+@gdef@eatinput input texinfo{@fixbackslash}
+@global@let\ = @eatinput
+
+% On the other hand, perhaps the file did not have a `\input texinfo'. Then
+% the first `\{ in the file would cause an error. This macro tries to fix
+% that, assuming it is called before the first `\' could plausibly occur.
+% Also back turn on active characters that might appear in the input
+% file name, in case not using a pre-dumped format.
+%
+@gdef@fixbackslash{@ifx\@eatinput @let\ = @normalbackslash @fi
+ @catcode`+=@active @catcode`@_=@active}
+
+%% These look ok in all fonts, so just make them not special. The @rm below
+%% makes sure that the current font starts out as the newly loaded cmr10
+@catcode`@$=@other @catcode`@%=@other @catcode`@&=@other @catcode`@#=@other
+
+@textfonts
+@rm
+
+@c Local variables:
+@c page-delimiter: "^\\\\message"
+@c End:
diff --git a/texinfo/texinfo.texi b/texinfo/texinfo.texi
new file mode 100644
index 00000000000..0f55da09901
--- /dev/null
+++ b/texinfo/texinfo.texi
@@ -0,0 +1,16886 @@
+\input texinfo.tex @c -*-texinfo-*-
+@comment %**start of header
+@setfilename texinfo
+@settitle Texinfo @value{edition}
+@c Define a new index for options.
+@defcodeindex op
+@c Put everything except function (command, in this case) names in one
+index (arbitrarily chosen to be the concept index).
+@syncodeindex op cp
+@syncodeindex vr cp
+@syncodeindex pg cp
+@footnotestyle separate
+@paragraphindent 2
+@finalout
+@comment %**end of header
+@comment $Id: texinfo.texi,v 1.1 1997/08/21 22:57:54 jason Exp $
+
+@c Before release, run C-u C-c C-u C-a (texinfo-all-menus-update with a
+@c prefix arg). This updates the node pointers, which texinfmt.el needs.
+
+@dircategory Texinfo documentation system
+@direntry
+* Texinfo: (texinfo). The GNU documentation format.
+* install-info: (texinfo)Invoking install-info. Updating info/dir entries.
+* texi2dvi: (texinfo)Format with texi2dvi. Printing Texinfo documentation.
+* texindex: (texinfo)Format with tex/texindex. Sorting Texinfo index files.
+@end direntry
+
+@c Set smallbook if printing in smallbook format so the example of the
+@c smallbook font is actually written using smallbook; in bigbook, a kludge
+@c is used for TeX output.
+@smallbook
+@set smallbook
+@c @@clear smallbook
+
+@set edition 2.23
+@set update-month October 1996
+@set update-date 1 @value{update-month}
+
+@c Currently undocumented command, 5 December 1993:
+@c
+@c nwnode (Same as node, but no warnings; for `makeinfo'.)
+
+@ifinfo
+This file documents Texinfo, a documentation system that can produce
+both on-line information and a printed manual from a single source file.
+
+Copyright (C) 1988, 90, 91, 92, 93, 95, 1996 Free Software Foundation, Inc.
+
+This is the second edition of the Texinfo documentation,@*
+and is consistent with version 2 of @file{texinfo.tex}.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+@ignore
+Permission is granted to process this file through TeX and print the
+results, provided the printed document carries copying permission
+notice identical to this one except for the removal of this paragraph
+(this paragraph not being relevant to the printed manual).
+
+@end ignore
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@end ifinfo
+
+@setchapternewpage odd
+
+@shorttitlepage Texinfo
+
+@titlepage
+@c use the new format for titles
+@title Texinfo
+@subtitle The GNU Documentation Format
+@subtitle Edition @value{edition}, for Texinfo Version Three
+@subtitle @value{update-month}
+
+@author Robert J.@: Chassell
+@author Richard M.@: Stallman
+
+@c Include the Distribution inside the titlepage so
+@c that headings are turned off.
+
+@page
+@vskip 0pt plus 1filll
+Copyright @copyright{} 1988, 1990, 1991, 1992, 1993, 1995, 1996 Free Software Foundation, Inc.
+
+@sp 2
+This is the second edition of the Texinfo documentation,@*
+and is consistent with version 2 of @file{texinfo.tex}.
+@sp 2
+
+Published by the Free Software Foundation @*
+59 Temple Place Suite 330, @*
+Boston, MA 02111-1307 USA @*
+Printed copies are available for $15 each.@*
+ISBN 1-882114-64-7
+@c ISBN 1-882114-63-9 is for edition 2.20 of 28 February 1995
+@c ISBN 1-882114-64-7 is for edition 2.23 of 1 October 1996.
+
+Permission is granted to make and distribute verbatim copies of
+this manual provided the copyright notice and this permission notice
+are preserved on all copies.
+
+Permission is granted to copy and distribute modified versions of this
+manual under the conditions for verbatim copying, provided that the entire
+resulting derived work is distributed under the terms of a permission
+notice identical to this one.
+
+Permission is granted to copy and distribute translations of this manual
+into another language, under the above conditions for modified versions,
+except that this permission notice may be stated in a translation approved
+by the Free Software Foundation.
+@sp 2
+Cover art by Etienne Suvasa.
+@end titlepage
+
+@ifinfo
+@node Top, Copying, (dir), (dir)
+@top Texinfo
+
+Texinfo is a documentation system that uses a single source file to
+produce both on-line information and printed output.@refill
+
+The first part of this master menu lists the major nodes in this Info
+document, including the @@-command and concept indices. The rest of
+the menu lists all the lower level nodes in the document.@refill
+
+This is Edition @value{edition} of the Texinfo documentation,
+@w{@value{update-date},} for Texinfo Version Three.
+@end ifinfo
+
+@c Here is a spare copy of the chapter menu entry descriptions,
+@c in case they are accidently deleted
+@ignore
+Your rights.
+Texinfo in brief.
+How to use Texinfo mode.
+What is at the beginning of a Texinfo file?
+What is at the end of a Texinfo file?
+How to create chapters, sections, subsections,
+ appendices, and other parts.
+How to provide structure for a document.
+How to write nodes.
+How to write menus.
+How to write cross references.
+How to mark words and phrases as code,
+ keyboard input, meta-syntactic
+ variables, and the like.
+How to write quotations, examples, etc.
+How to write lists and tables.
+How to create indices.
+How to insert @@-signs, braces, etc.
+How to indicate results of evaluation,
+ expansion of macros, errors, etc.
+How to force and prevent line and page breaks.
+How to describe functions and the like in a uniform manner.
+How to write footnotes.
+How to specify text for either @TeX{} or Info.
+How to print hardcopy.
+How to create an Info file.
+How to install an Info file
+A list of all the Texinfo @@-commands.
+Hints on how to write a Texinfo document.
+A sample Texinfo file to look at.
+Tell readers they have the right to copy
+ and distribute.
+How to incorporate other Texinfo files.
+How to write page headings and footings.
+How to find formatting mistakes.
+All about paragraph refilling.
+A description of @@-Command syntax.
+Texinfo second edition features.
+A menu containing commands and variables.
+A menu covering many topics.
+@end ignore
+
+@menu
+* Copying:: Your rights.
+* Overview:: Texinfo in brief.
+* Texinfo Mode:: How to use Texinfo mode.
+* Beginning a File:: What is at the beginning of a Texinfo file?
+* Ending a File:: What is at the end of a Texinfo file?
+* Structuring:: How to create chapters, sections, subsections,
+ appendices, and other parts.
+* Nodes:: How to write nodes.
+* Menus:: How to write menus.
+* Cross References:: How to write cross references.
+* Marking Text:: How to mark words and phrases as code,
+ keyboard input, meta-syntactic
+ variables, and the like.
+* Quotations and Examples:: How to write quotations, examples, etc.
+* Lists and Tables:: How to write lists and tables.
+* Indices:: How to create indices.
+* Insertions:: How to insert @@-signs, braces, etc.
+* Glyphs:: How to indicate results of evaluation,
+ expansion of macros, errors, etc.
+* Breaks:: How to force and prevent line and page breaks.
+* Definition Commands:: How to describe functions and the like
+ in a uniform manner.
+* Footnotes:: How to write footnotes.
+* Conditionals:: How to specify text for either @TeX{} or Info.
+* Macros:: Defining new Texinfo commands.
+* Format/Print Hardcopy:: How to convert a Texinfo file to a file
+ for printing and how to print that file.
+* Create an Info File:: Convert a Texinfo file into an Info file.
+* Install an Info File:: Make an Info file accessible to users.
+* Command List:: All the Texinfo @@-commands.
+* Tips:: Hints on how to write a Texinfo document.
+* Sample Texinfo File:: A sample Texinfo file to look at.
+* Sample Permissions:: Tell readers they have the right to copy
+ and distribute.
+* Include Files:: How to incorporate other Texinfo files.
+* Headings:: How to write page headings and footings.
+* Catching Mistakes:: How to find formatting mistakes.
+* Refilling Paragraphs:: All about paragraph refilling.
+* Command Syntax:: A description of @@-Command syntax.
+* Obtaining TeX:: How to Obtain @TeX{}.
+* New Features:: Texinfo second edition features.
+* Command and Variable Index:: A menu containing commands and variables.
+* Concept Index:: A menu covering many topics.
+
+@detailmenu
+
+ --- The Detailed Node Listing ---
+
+Overview of Texinfo
+
+* Using Texinfo:: Create a conventional printed book
+ or an Info file.
+* Info Files:: What is an Info file?
+* Printed Books:: Characteristics of a printed book or manual.
+* Formatting Commands:: @@-commands are used for formatting.
+* Conventions:: General rules for writing a Texinfo file.
+* Comments:: How to write comments and mark regions that
+ the formatting commands will ignore.
+* Minimum:: What a Texinfo file must have.
+* Six Parts:: Usually, a Texinfo file has six parts.
+* Short Sample:: A short sample Texinfo file.
+* Acknowledgements::
+
+Using Texinfo Mode
+
+* Texinfo Mode Overview:: How Texinfo mode can help you.
+* Emacs Editing:: Texinfo mode adds to GNU Emacs' general
+ purpose editing features.
+* Inserting:: How to insert frequently used @@-commands.
+* Showing the Structure:: How to show the structure of a file.
+* Updating Nodes and Menus:: How to update or create new nodes and menus.
+* Info Formatting:: How to format for Info.
+* Printing:: How to format and print part or all of a file.
+* Texinfo Mode Summary:: Summary of all the Texinfo mode commands.
+
+Updating Nodes and Menus
+
+* Updating Commands:: Five major updating commands.
+* Updating Requirements:: How to structure a Texinfo file for
+ using the updating command.
+* Other Updating Commands:: How to indent descriptions, insert
+ missing nodes lines, and update
+ nodes in sequence.
+
+Beginning a Texinfo File
+
+* Four Parts:: Four parts begin a Texinfo file.
+* Sample Beginning:: Here is a sample beginning for a Texinfo file.
+* Header:: The very beginning of a Texinfo file.
+* Info Summary and Permissions:: Summary and copying permissions for Info.
+* Titlepage & Copyright Page:: Creating the title and copyright pages.
+* The Top Node:: Creating the `Top' node and master menu.
+* Software Copying Permissions:: Ensure that you and others continue to
+ have the right to use and share software.
+
+The Texinfo File Header
+
+* First Line:: The first line of a Texinfo file.
+* Start of Header:: Formatting a region requires this.
+* setfilename:: Tell Info the name of the Info file.
+* settitle:: Create a title for the printed work.
+* setchapternewpage:: Start chapters on right-hand pages.
+* paragraphindent:: An option to specify paragraph indentation.
+* End of Header:: Formatting a region requires this.
+
+The Title and Copyright Pages
+
+* titlepage:: Create a title for the printed document.
+* titlefont center sp:: The @code{@@titlefont}, @code{@@center},
+ and @code{@@sp} commands.
+* title subtitle author:: The @code{@@title}, @code{@@subtitle},
+ and @code{@@author} commands.
+* Copyright & Permissions:: How to write the copyright notice and
+ include copying permissions.
+* end titlepage:: Turn on page headings after the title and
+ copyright pages.
+* headings on off:: An option for turning headings on and off
+ and double or single sided printing.
+
+The `Top' Node and Master Menu
+
+* Title of Top Node:: Sketch what the file is about.
+* Master Menu Parts:: A master menu has three or more parts.
+
+Ending a Texinfo File
+
+* Printing Indices & Menus:: How to print an index in hardcopy and
+ generate index menus in Info.
+* Contents:: How to create a table of contents.
+* File End:: How to mark the end of a file.
+
+Chapter Structuring
+
+* Tree Structuring:: A manual is like an upside down tree @dots{}
+* Structuring Command Types:: How to divide a manual into parts.
+* makeinfo top:: The @code{@@top} command, part of the `Top' node.
+* chapter::
+* unnumbered & appendix::
+* majorheading & chapheading::
+* section::
+* unnumberedsec appendixsec heading::
+* subsection::
+* unnumberedsubsec appendixsubsec subheading::
+* subsubsection:: Commands for the lowest level sections.
+* Raise/lower sections:: How to change commands' hierarchical level.
+
+Nodes
+
+* Two Paths:: Different commands to structure
+ Info output and printed output.
+* Node Menu Illustration:: A diagram, and sample nodes and menus.
+* node:: How to write a node, in detail.
+* makeinfo Pointer Creation:: How to create node pointers with @code{makeinfo}.
+
+The @code{@@node} Command
+
+* Node Names:: How to choose node and pointer names.
+* Writing a Node:: How to write an @code{@@node} line.
+* Node Line Tips:: Keep names short.
+* Node Line Requirements:: Keep names unique, without @@-commands.
+* First Node:: How to write a `Top' node.
+* makeinfo top command:: How to use the @code{@@top} command.
+* Top Node Summary:: Write a brief description for readers.
+
+Menus
+
+* Menu Location:: Put a menu in a short node.
+* Writing a Menu:: What is a menu?
+* Menu Parts:: A menu entry has three parts.
+* Less Cluttered Menu Entry:: Two part menu entry.
+* Menu Example:: Two and three part menu entries.
+* Other Info Files:: How to refer to a different Info file.
+
+Cross References
+
+* References:: What cross references are for.
+* Cross Reference Commands:: A summary of the different commands.
+* Cross Reference Parts:: A cross reference has several parts.
+* xref:: Begin a reference with `See' @dots{}
+* Top Node Naming:: How to refer to the beginning of another file.
+* ref:: A reference for the last part of a sentence.
+* pxref:: How to write a parenthetical cross reference.
+* inforef:: How to refer to an Info-only file.
+
+@code{@@xref}
+
+* Reference Syntax:: What a reference looks like and requires.
+* One Argument:: @code{@@xref} with one argument.
+* Two Arguments:: @code{@@xref} with two arguments.
+* Three Arguments:: @code{@@xref} with three arguments.
+* Four and Five Arguments:: @code{@@xref} with four and five arguments.
+
+Marking Words and Phrases
+
+* Indicating:: How to indicate definitions, files, etc.
+* Emphasis:: How to emphasize text.
+
+Indicating Definitions, Commands, etc.
+
+* Useful Highlighting:: Highlighting provides useful information.
+* code:: How to indicate code.
+* kbd:: How to show keyboard input.
+* key:: How to specify keys.
+* samp:: How to show a literal sequence of characters.
+* var:: How to indicate a metasyntactic variable.
+* file:: How to indicate the name of a file.
+* dfn:: How to specify a definition.
+* cite:: How to refer to a book that is not in Info.
+* url:: How to indicate a world wide web reference.
+* email:: How to indicate an electronic mail address.
+
+Emphasizing Text
+
+* emph & strong:: How to emphasize text in Texinfo.
+* Smallcaps:: How to use the small caps font.
+* Fonts:: Various font commands for printed output.
+* Customized Highlighting:: How to define highlighting commands.
+
+Quotations and Examples
+
+* Block Enclosing Commands:: Use different constructs for
+ different purposes.
+* quotation:: How to write a quotation.
+* example:: How to write an example in a fixed-width font.
+* noindent:: How to prevent paragraph indentation.
+* Lisp Example:: How to illustrate Lisp code.
+* smallexample & smalllisp:: Forms for the @code{@@smallbook} option.
+* display:: How to write an example in the current font.
+* format:: How to write an example that does not narrow
+ the margins.
+* exdent:: How to undo the indentation of a line.
+* flushleft & flushright:: How to push text flushleft or flushright.
+* cartouche:: How to draw cartouches around examples.
+
+Making Lists and Tables
+
+* Introducing Lists:: Texinfo formats lists for you.
+* itemize:: How to construct a simple list.
+* enumerate:: How to construct a numbered list.
+* Two-column Tables:: How to construct a two-column table.
+* Multi-column Tables:: How to construct generalized tables.
+
+Making a Two-column Table
+
+* table:: How to construct a two-column table.
+* ftable vtable:: How to construct a two-column table
+ with automatic indexing.
+* itemx:: How to put more entries in the first column.
+
+Multi-column Tables
+
+* Multitable Column Widths:: Defining multitable column widths.
+* Multitable Rows:: Defining multitable rows, with examples.
+
+Creating Indices
+
+* Index Entries:: Choose different words for index entries.
+* Predefined Indices:: Use different indices for different kinds
+ of entry.
+* Indexing Commands:: How to make an index entry.
+* Combining Indices:: How to combine indices.
+* New Indices:: How to define your own indices.
+
+Combining Indices
+
+* syncodeindex:: How to merge two indices, using @code{@@code}
+ font for the merged-from index.
+* synindex:: How to merge two indices, using the
+ default font of the merged-to index.
+
+Special Insertions
+
+* Braces Atsigns:: How to insert braces, @samp{@@}.
+* Inserting Space:: How to insert the right amount of space
+ within a sentence.
+* Inserting Accents:: How to insert accents and special characters.
+* Dots Bullets:: How to insert dots and bullets.
+* TeX and copyright:: How to insert the @TeX{} logo
+ and the copyright symbol.
+* pounds:: How to insert the pounds currency symbol.
+* minus:: How to insert a minus sign.
+* math:: How to format a mathematical expression.
+
+Inserting @@ and Braces
+
+* Inserting An Atsign:: How to insert @samp{@@}.
+* Inserting Braces:: How to insert @samp{@{} and @samp{@}}.
+
+Inserting Space
+
+* Not Ending a Sentence:: Sometimes a . doesn't end a sentence.
+* Ending a Sentence:: Sometimes it does.
+* Multiple Spaces:: Inserting multiple spaces.
+* dmn:: How to format a dimension.
+
+Inserting Ellipsis, Dots, and Bullets
+
+* dots:: How to insert dots @dots{}
+* bullet:: How to insert a bullet.
+
+Inserting @TeX{} and the Copyright Symbol
+
+* tex:: How to insert the @TeX{} logo.
+* copyright symbol:: How to use @code{@@copyright}@{@}.
+
+Glyphs for Examples
+
+* Glyphs Summary::
+* result:: How to show the result of expression.
+* expansion:: How to indicate an expansion.
+* Print Glyph:: How to indicate printed output.
+* Error Glyph:: How to indicate an error message.
+* Equivalence:: How to indicate equivalence.
+* Point Glyph:: How to indicate the location of point.
+
+Making and Preventing Breaks
+
+* Break Commands:: Cause and prevent splits.
+* Line Breaks:: How to force a single line to use two lines.
+* - and hyphenation:: How to tell TeX about hyphenation points.
+* w:: How to prevent unwanted line breaks.
+* sp:: How to insert blank lines.
+* page:: How to force the start of a new page.
+* group:: How to prevent unwanted page breaks.
+* need:: Another way to prevent unwanted page breaks.
+
+Definition Commands
+
+* Def Cmd Template:: How to structure a description using a
+ definition command.
+* Optional Arguments:: How to handle optional and repeated arguments.
+* deffnx:: How to group two or more `first' lines.
+* Def Cmds in Detail:: All the definition commands.
+* Def Cmd Conventions:: Conventions for writing definitions.
+* Sample Function Definition::
+
+The Definition Commands
+
+* Functions Commands:: Commands for functions and similar entities.
+* Variables Commands:: Commands for variables and similar entities.
+* Typed Functions:: Commands for functions in typed languages.
+* Typed Variables:: Commands for variables in typed languages.
+* Abstract Objects:: Commands for object-oriented programming.
+* Data Types:: The definition command for data types.
+
+Footnotes
+
+* Footnote Commands:: How to write a footnote in Texinfo.
+* Footnote Styles:: Controlling how footnotes appear in Info.
+
+Conditionally Visible Text
+
+* Conditional Commands:: How to specify text for HTML, Info, or @TeX{}.
+* Using Ordinary TeX Commands:: You can use any and all @TeX{} commands.
+* set clear value:: How to designate which text to format (for
+ both Info and @TeX{}); and how to set a
+ flag to a string that you can insert.
+
+@code{@@set}, @code{@@clear}, and @code{@@value}
+
+* ifset ifclear:: Format a region if a flag is set.
+* value:: Replace a flag with a string.
+* value Example:: An easy way to update edition information.
+
+Macros: Defining New Texinfo Commands
+
+* Defining Macros:: Both defining and undefining new commands.
+* Invoking Macros:: Using a macro, once you've defined it.
+
+Format and Print Hardcopy
+
+* Use TeX:: Use @TeX{} to format for hardcopy.
+* Format with tex/texindex:: How to format in a shell.
+* Format with texi2dvi:: A simpler way to use the shell.
+* Print with lpr:: How to print.
+* Within Emacs:: How to format and print from an Emacs shell.
+* Texinfo Mode Printing:: How to format and print in Texinfo mode.
+* Compile-Command:: How to print using Emacs's compile command.
+* Requirements Summary:: @TeX{} formatting requirements summary.
+* Preparing for TeX:: What you need to do to use @TeX{}.
+* Overfull hboxes:: What are and what to do with overfull hboxes.
+* smallbook:: How to print small format books and manuals.
+* A4 Paper:: How to print on European A4 paper.
+* Cropmarks and Magnification:: How to print marks to indicate the size
+ of pages and how to print scaled up output.
+
+Creating an Info File
+
+* makeinfo advantages:: @code{makeinfo} provides better error checking.
+* Invoking makeinfo:: How to run @code{makeinfo} from a shell.
+* makeinfo options:: Specify fill-column and other options.
+* Pointer Validation:: How to check that pointers point somewhere.
+* makeinfo in Emacs:: How to run @code{makeinfo} from Emacs.
+* texinfo-format commands:: Two Info formatting commands written
+ in Emacs Lisp are an alternative
+ to @code{makeinfo}.
+* Batch Formatting:: How to format for Info in Emacs Batch mode.
+* Tag and Split Files:: How tagged and split files help Info
+ to run better.
+
+Installing an Info File
+
+* Directory file:: The top level menu for all Info files.
+* New Info File:: Listing a new info file.
+* Other Info Directories:: How to specify Info files that are
+ located in other directories.
+* Installing Dir Entries:: How to specify what menu entry to add
+ to the Info directory.
+* Invoking install-info:: @code{install-info} options.
+
+Sample Permissions
+
+* Inserting Permissions:: How to put permissions in your document.
+* ifinfo Permissions:: Sample @samp{ifinfo} copying permissions.
+* Titlepage Permissions:: Sample Titlepage copying permissions.
+
+Include Files
+
+* Using Include Files:: How to use the @code{@@include} command.
+* texinfo-multiple-files-update:: How to create and update nodes and
+ menus when using included files.
+* Include File Requirements:: What @code{texinfo-multiple-files-update} expects.
+* Sample Include File:: A sample outer file with included files
+ within it; and a sample included file.
+* Include Files Evolution:: How use of the @code{@@include} command
+ has changed over time.
+
+Page Headings
+
+* Headings Introduced:: Conventions for using page headings.
+* Heading Format:: Standard page heading formats.
+* Heading Choice:: How to specify the type of page heading.
+* Custom Headings:: How to create your own headings and footings.
+
+Formatting Mistakes
+
+* makeinfo preferred:: @code{makeinfo} finds errors.
+* Debugging with Info:: How to catch errors with Info formatting.
+* Debugging with TeX:: How to catch errors with @TeX{} formatting.
+* Using texinfo-show-structure:: How to use @code{texinfo-show-structure}.
+* Using occur:: How to list all lines containing a pattern.
+* Running Info-Validate:: How to find badly referenced nodes.
+
+Finding Badly Referenced Nodes
+
+* Using Info-validate:: How to run @code{Info-validate}.
+* Unsplit:: How to create an unsplit file.
+* Tagifying:: How to tagify a file.
+* Splitting:: How to split a file manually.
+
+Second Edition Features
+
+* New Texinfo Mode Commands:: The updating commands are especially useful.
+* New Commands:: Many newly described @@-commands.
+@end detailmenu
+@end menu
+
+@node Copying, Overview, Top, Top
+@comment node-name, next, previous, up
+@unnumbered Texinfo Copying Conditions
+@cindex Copying conditions
+@cindex Conditions for copying Texinfo
+
+The programs currently being distributed that relate to Texinfo include
+portions of GNU Emacs, plus other separate programs (including
+@code{makeinfo}, @code{info}, @code{texindex}, and @file{texinfo.tex}).
+These programs are @dfn{free}; this means that everyone is free to use
+them and free to redistribute them on a free basis. The Texinfo-related
+programs are not in the public domain; they are copyrighted and there
+are restrictions on their distribution, but these restrictions are
+designed to permit everything that a good cooperating citizen would want
+to do. What is not allowed is to try to prevent others from further
+sharing any version of these programs that they might get from
+you.@refill
+
+ Specifically, we want to make sure that you have the right to give
+away copies of the programs that relate to Texinfo, that you receive
+source code or else can get it if you want it, that you can change these
+programs or use pieces of them in new free programs, and that you know
+you can do these things.@refill
+
+ To make sure that everyone has such rights, we have to forbid you to
+deprive anyone else of these rights. For example, if you distribute
+copies of the Texinfo related programs, you must give the recipients all
+the rights that you have. You must make sure that they, too, receive or
+can get the source code. And you must tell them their rights.@refill
+
+ Also, for our own protection, we must make certain that everyone finds
+out that there is no warranty for the programs that relate to Texinfo.
+If these programs are modified by someone else and passed on, we want
+their recipients to know that what they have is not what we distributed,
+so that any problems introduced by others will not reflect on our
+reputation.@refill
+
+ The precise conditions of the licenses for the programs currently
+being distributed that relate to Texinfo are found in the General Public
+Licenses that accompany them.@refill
+
+@node Overview, Texinfo Mode, Copying, Top
+@comment node-name, next, previous, up
+@chapter Overview of Texinfo
+@cindex Overview of Texinfo
+@cindex Texinfo overview
+
+@dfn{Texinfo}@footnote{Note that the first syllable of ``Texinfo'' is
+pronounced like ``speck'', not ``hex''. This odd pronunciation is
+derived from, but is not the same as, the pronunciation of @TeX{}. In
+the word @TeX{}, the @samp{X} is actually the Greek letter ``chi''
+rather than the English letter ``ex''. Pronounce @TeX{} as if the
+@samp{X} were the last sound in the name `Bach'; but pronounce Texinfo
+as if the @samp{x} were a `k'. Spell ``Texinfo'' with a capital ``T''
+and write the other letters in lower case.}
+is a documentation system that uses a single source file to produce both
+on-line information and printed output. This means that instead of
+writing two different documents, one for the on-line help or other on-line
+information and the other for a typeset manual or other printed work, you
+need write only one document. When the work is revised, you need revise
+only one document. (You can read the on-line information, known as an
+@dfn{Info file}, with an Info documentation-reading program.)@refill
+
+@menu
+* Using Texinfo:: Create a conventional printed book
+ or an Info file.
+* Info Files:: What is an Info file?
+* Printed Books:: Characteristics of a printed book or manual.
+* Formatting Commands:: @@-commands are used for formatting.
+* Conventions:: General rules for writing a Texinfo file.
+* Comments:: How to write comments and mark regions that
+ the formatting commands will ignore.
+* Minimum:: What a Texinfo file must have.
+* Six Parts:: Usually, a Texinfo file has six parts.
+* Short Sample:: A short sample Texinfo file.
+* Acknowledgements::
+@end menu
+
+@node Using Texinfo, Info Files, Overview, Overview
+@ifinfo
+@heading Using Texinfo
+@end ifinfo
+
+Using Texinfo, you can create a printed document with the normal
+features of a book, including chapters, sections, cross references,
+and indices. From the same Texinfo source file, you can create a
+menu-driven, on-line Info file with nodes, menus, cross references,
+and indices. You can, if you wish, make the chapters and sections of
+the printed document correspond to the nodes of the on-line
+information; and you use the same cross references and indices for
+both the Info file and the printed work. @cite{The GNU
+Emacs Manual} is a good example of a Texinfo file, as is this manual.@refill
+
+To make a printed document, you process a Texinfo source file with the
+@TeX{} typesetting program. This creates a @sc{dvi} file that you can
+typeset and print as a book or report. (Note that the Texinfo language
+is completely different from @TeX{}'s usual language, plain @TeX{}.) If
+you do not have @TeX{}, but do have @code{troff} or @code{nroff}, you
+can use the @code{texi2roff} program instead.@refill
+
+To make an Info file, you process a Texinfo source file with the
+@code{makeinfo} utility or Emacs's @code{texinfo-format-buffer} command;
+this creates an Info file that you can install on-line.@refill
+
+@TeX{} and @code{texi2roff} work with many types of printer; similarly,
+Info works with almost every type of computer terminal. This power
+makes Texinfo a general purpose system, but brings with it a constraint,
+which is that a Texinfo file may contain only the customary
+``typewriter'' characters (letters, numbers, spaces, and punctuation
+marks) but no special graphics.@refill
+
+A Texinfo file is a plain @sc{ascii} file containing text and
+@dfn{@@-commands} (words preceded by an @samp{@@}) that tell the
+typesetting and formatting programs what to do. You may edit a
+Texinfo file with any text editor; but it is especially convenient to
+use GNU Emacs since that editor has a special mode, called Texinfo
+mode, that provides various Texinfo-related features. (@xref{Texinfo
+Mode}.)@refill
+
+Before writing a Texinfo source file, you should become familiar with
+the Info documentation reading program and learn about nodes,
+menus, cross references, and the rest. (@inforef{Top, info, info},
+for more information.)@refill
+
+You can use Texinfo to create both on-line help and printed manuals;
+moreover, Texinfo is freely redistributable. For these reasons, Texinfo
+is the format in which documentation for GNU utilities and libraries is
+written.@refill
+
+@node Info Files, Printed Books, Using Texinfo, Overview
+@comment node-name, next, previous, up
+@section Info files
+@cindex Info files
+
+An Info file is a Texinfo file formatted so that the Info documentation
+reading program can operate on it. (@code{makeinfo}
+and @code{texinfo-format-buffer} are two commands that convert a Texinfo file
+into an Info file.)@refill
+
+Info files are divided into pieces called @dfn{nodes}, each of which
+contains the discussion of one topic. Each node has a name, and
+contains both text for the user to read and pointers to other nodes,
+which are identified by their names. The Info program displays one node
+at a time, and provides commands with which the user can move to other
+related nodes.@refill
+
+@ifinfo
+@inforef{Top, info, info}, for more information about using Info.@refill
+@end ifinfo
+
+Each node of an Info file may have any number of child nodes that
+describe subtopics of the node's topic. The names of child
+nodes are listed in a @dfn{menu} within the parent node; this
+allows you to use certain Info commands to move to one of the child
+nodes. Generally, an Info file is organized like a book. If a node
+is at the logical level of a chapter, its child nodes are at the level
+of sections; likewise, the child nodes of sections are at the level
+of subsections.@refill
+
+All the children of any one parent are linked together in a
+bidirectional chain of `Next' and `Previous' pointers. The `Next'
+pointer provides a link to the next section, and the `Previous' pointer
+provides a link to the previous section. This means that all the nodes
+that are at the level of sections within a chapter are linked together.
+Normally the order in this chain is the same as the order of the
+children in the parent's menu. Each child node records the parent node
+name as its `Up' pointer. The last child has no `Next' pointer, and the
+first child has the parent both as its `Previous' and as its `Up'
+pointer.@footnote{In some documents, the first child has no `Previous'
+pointer. Occasionally, the last child has the node name of the next
+following higher level node as its `Next' pointer.}@refill
+
+The book-like structuring of an Info file into nodes that correspond
+to chapters, sections, and the like is a matter of convention, not a
+requirement. The `Up', `Previous', and `Next' pointers of a node can
+point to any other nodes, and a menu can contain any other nodes.
+Thus, the node structure can be any directed graph. But it is usually
+more comprehensible to follow a structure that corresponds to the
+structure of chapters and sections in a printed book or report.@refill
+
+In addition to menus and to `Next', `Previous', and `Up' pointers, Info
+provides pointers of another kind, called references, that can be
+sprinkled throughout the text. This is usually the best way to
+represent links that do not fit a hierarchical structure.@refill
+
+Usually, you will design a document so that its nodes match the
+structure of chapters and sections in the printed output. But there
+are times when this is not right for the material being discussed.
+Therefore, Texinfo uses separate commands to specify the node
+structure for the Info file and the section structure for the printed
+output.@refill
+
+Generally, you enter an Info file through a node that by convention is
+called @samp{Top}. This node normally contains just a brief summary
+of the file's purpose, and a large menu through which the rest of the
+file is reached. From this node, you can either traverse the file
+systematically by going from node to node, or you can go to a specific
+node listed in the main menu, or you can search the index menus and
+then go directly to the node that has the information you want.@refill
+@c !!! With the standalone Info system you may go to specific nodes
+@c directly..
+
+If you want to read through an Info file in sequence, as if it were a
+printed manual, you can get the whole file with the advanced Info
+command @kbd{g* @key{RET}}. (@inforef{Expert, Advanced Info commands,
+info}.)@refill
+
+@c !!! dir file may be located in one of many places:
+@c /usr/local/emacs/info mentioned in info.c DEFAULT_INFOPATH
+@c /usr/local/lib/emacs/info mentioned in info.c DEFAULT_INFOPATH
+@c /usr/gnu/info mentioned in info.c DEFAULT_INFOPATH
+@c /usr/local/info
+@c /usr/local/lib/info
+The @file{dir} file in the @file{info} directory serves as the
+departure point for the whole Info system. From it, you can reach the
+`Top' nodes of each of the documents in a complete Info system.@refill
+
+@node Printed Books, Formatting Commands, Info Files, Overview
+@comment node-name, next, previous, up
+@section Printed Books
+@cindex Printed book and manual characteristics
+@cindex Manual characteristics, printed
+@cindex Book characteristics, printed
+@cindex Texinfo printed book characteristics
+@cindex Characteristics, printed books or manuals
+
+@cindex Knuth, Donald
+A Texinfo file can be formatted and typeset as a printed book or manual.
+To do this, you need @TeX{}, a powerful, sophisticated typesetting
+program written by Donald Knuth.@footnote{You can also use the
+@code{texi2roff} program if you do not have @TeX{}; since Texinfo is
+designed for use with @TeX{}, @code{texi2roff} is not described here.
+@code{texi2roff} is part of the standard GNU distribution.}@refill
+
+A Texinfo-based book is similar to any other typeset, printed work: it
+can have a title page, copyright page, table of contents, and preface,
+as well as chapters, numbered or unnumbered sections and subsections,
+page headers, cross references, footnotes, and indices.@refill
+
+You can use Texinfo to write a book without ever having the intention
+of converting it into on-line information. You can use Texinfo for
+writing a printed novel, and even to write a printed memo, although
+this latter application is not recommended since electronic mail is so
+much easier.@refill
+
+@TeX{} is a general purpose typesetting program. Texinfo provides a
+file called @file{texinfo.tex} that contains information (definitions or
+@dfn{macros}) that @TeX{} uses when it typesets a Texinfo file.
+(@file{texinfo.tex} tells @TeX{} how to convert the Texinfo @@-commands
+to @TeX{} commands, which @TeX{} can then process to create the typeset
+document.) @file{texinfo.tex} contains the specifications for printing
+a document.@refill
+
+Most often, documents are printed on 8.5 inch by 11 inch
+pages (216@dmn{mm} by 280@dmn{mm}; this is the default size), but you
+can also print for 7 inch by 9.25 inch pages (178@dmn{mm} by
+235@dmn{mm}; the @code{@@smallbook} size) or on European A4 size paper
+(@code{@@afourpaper}). (@xref{smallbook, , Printing ``Small'' Books}.
+Also, see @ref{A4 Paper, ,Printing on A4 Paper}.)@refill
+
+By changing the parameters in @file{texinfo.tex}, you can change the
+size of the printed document. In addition, you can change the style in
+which the printed document is formatted; for example, you can change the
+sizes and fonts used, the amount of indentation for each paragraph, the
+degree to which words are hyphenated, and the like. By changing the
+specifications, you can make a book look dignified, old and serious, or
+light-hearted, young and cheery.@refill
+
+@TeX{} is freely distributable. It is written in a dialect of Pascal
+called WEB and can be compiled either in Pascal or (by using a
+conversion program that comes with the @TeX{} distribution) in C.
+(@xref{TeX Mode, ,@TeX{} Mode, emacs, The GNU Emacs Manual}, for information
+about @TeX{}.)@refill
+
+@TeX{} is very powerful and has a great many features. Because a
+Texinfo file must be able to present information both on a
+character-only terminal in Info form and in a typeset book, the
+formatting commands that Texinfo supports are necessarily
+limited.@refill
+
+@xref{Obtaining TeX, , How to Obtain @TeX{}}.
+
+
+@node Formatting Commands, Conventions, Printed Books, Overview
+@comment node-name, next, previous, up
+@section @@-commands
+@cindex @@-commands
+@cindex Formatting commands
+
+In a Texinfo file, the commands that tell @TeX{} how to typeset the
+printed manual and tell @code{makeinfo} and
+@code{texinfo-format-buffer} how to create an Info file are preceded
+by @samp{@@}; they are called @dfn{@@-commands}. For example,
+@code{@@node} is the command to indicate a node and @code{@@chapter}
+is the command to indicate the start of a chapter.@refill
+
+@quotation
+@strong{Please note:} All the @@-commands, with the exception of the
+@code{@@TeX@{@}} command, must be written entirely in lower
+case.@refill
+@end quotation
+
+The Texinfo @@-commands are a strictly limited set of constructs. The
+strict limits make it possible for Texinfo files to be understood both
+by @TeX{} and by the code that converts them into Info files. You can
+display Info files on any terminal that displays alphabetic and
+numeric characters. Similarly, you can print the output generated by
+@TeX{} on a wide variety of printers.@refill
+
+Depending on what they do or what arguments@footnote{The word
+@dfn{argument} comes from the way it is used in mathematics and does
+not refer to a disputation between two people; it refers to the
+information presented to the command. According to the @cite{Oxford
+English Dictionary}, the word derives from the Latin for @dfn{to make
+clear, prove}; thus it came to mean `the evidence offered as proof',
+which is to say, `the information offered', which led to its
+mathematical meaning. In its other thread of derivation, the word
+came to mean `to assert in a manner against which others may make
+counter assertions', which led to the meaning of `argument' as a
+disputation.} they take, you need to write @@-commands on lines of
+their own or as part of sentences:@refill
+
+@itemize @bullet
+@item
+Write a command such as @code{@@noindent} at the beginning of a line as
+the only text on the line. (@code{@@noindent} prevents the beginning of
+the next line from being indented as the beginning of a
+paragraph.)@refill
+
+@item
+Write a command such as @code{@@chapter} at the beginning of a line
+followed by the command's arguments, in this case the chapter title, on
+the rest of the line. (@code{@@chapter} creates chapter titles.)@refill
+
+@item
+Write a command such as @code{@@dots@{@}} wherever you wish but usually
+within a sentence. (@code{@@dots@{@}} creates dots @dots{})@refill
+
+@item
+Write a command such as @code{@@code@{@var{sample-code}@}} wherever you
+wish (but usually within a sentence) with its argument,
+@var{sample-code} in this example, between the braces. (@code{@@code}
+marks text as being code.)@refill
+
+@item
+Write a command such as @code{@@example} at the beginning of a line of
+its own; write the body-text on following lines; and write the matching
+@code{@@end} command, @code{@@end example} in this case, at the
+beginning of a line of its own after the body-text. (@code{@@example}
+@dots{} @code{@@end example} indents and typesets body-text as an
+example.)@refill
+@end itemize
+
+@noindent
+@cindex Braces, when to use
+As a general rule, a command requires braces if it mingles among other
+text; but it does not need braces if it starts a line of its own. The
+non-alphabetic commands, such as @code{@@:}, are exceptions to the rule;
+they do not need braces.@refill
+
+As you gain experience with Texinfo, you will rapidly learn how to
+write the different commands: the different ways to write commands
+make it easier to write and read Texinfo files than if all commands
+followed exactly the same syntax. (For details about @@-command
+syntax, see @ref{Command Syntax, , @@-Command Syntax}.)@refill
+
+@node Conventions, Comments, Formatting Commands, Overview
+@comment node-name, next, previous, up
+@section General Syntactic Conventions
+@cindex General syntactic conventions
+@cindex Syntactic conventions
+@cindex Conventions, syntactic
+
+All printable @sc{ascii} characters except @samp{@@}, @samp{@{} and
+@samp{@}} can appear in a Texinfo file and stand for themselves.
+@samp{@@} is the escape character which introduces commands.
+@samp{@{} and @samp{@}} should be used only to surround arguments to
+certain commands. To put one of these special characters into the
+document, put an @samp{@@} character in front of it, like this:
+@samp{@@@@}, @samp{@@@{}, and @samp{@@@}}.@refill
+
+@ifinfo
+It is customary in @TeX{} to use doubled single-quote characters to
+begin and end quotations: ` ` and ' ' (but without a space between the
+two single-quote characters). This convention should be followed in
+Texinfo files. @TeX{} converts doubled single-quote characters to
+left- and right-hand doubled quotation marks and Info converts doubled
+single-quote characters to @sc{ascii} double-quotes: ` ` and ' ' to " .@refill
+@end ifinfo
+@iftex
+It is customary in @TeX{} to use doubled single-quote characters to
+begin and end quotations: @w{@tt{ `` }} and @w{@tt{ '' }}. This
+convention should be followed in Texinfo files. @TeX{} converts
+doubled single-quote characters to left- and right-hand doubled
+quotation marks, ``like this'', and Info converts doubled single-quote
+characters to @sc{ascii} double-quotes: @w{@tt{ `` }} and
+@w{@tt{ '' }} to @w{@tt{ " }}.@refill
+@end iftex
+
+Use three hyphens in a row, @samp{---}, for a dash---like this. In
+@TeX{}, a single or even a double hyphen produces a printed dash that
+is shorter than the usual typeset dash. Info reduces three hyphens to two for
+display on the screen.@refill
+
+To prevent a paragraph from being indented in the printed manual, put
+the command @code{@@noindent} on a line by itself before the
+paragraph.@refill
+
+If you mark off a region of the Texinfo file with the @code{@@iftex}
+and @w{@code{@@end iftex}} commands, that region will appear only in
+the printed copy; in that region, you can use certain commands
+borrowed from plain @TeX{} that you cannot use in Info. Likewise, if
+you mark off a region with the @code{@@ifinfo} and @code{@@end ifinfo}
+commands, that region will appear only in the Info file; in that
+region, you can use Info commands that you cannot use in @TeX{}.
+Similarly for @code{@@ifhtml} and @code{@@end ifhtml}.
+@xref{Conditionals}.
+
+@cindex Tabs; don't use!
+@quotation
+@strong{Caution:} Do not use tabs in a Texinfo file! @TeX{} uses
+variable-width fonts, which means that it cannot predefine a tab to work
+in all circumstances. Consequently, @TeX{} treats tabs like single
+spaces, and that is not what they look like.@refill
+
+@noindent
+To avoid this problem, Texinfo mode causes GNU Emacs to insert multiple
+spaces when you press the @key{TAB} key.@refill
+
+@noindent
+Also, you can run @code{untabify} in Emacs to convert tabs in a region
+to multiple spaces.@refill
+@end quotation
+
+@node Comments, Minimum, Conventions, Overview
+@comment node-name, next, previous, up
+@section Comments
+
+You can write comments in a Texinfo file that will not appear in
+either the Info file or the printed manual by using the
+@code{@@comment} command (which may be abbreviated to @code{@@c}).
+Such comments are for the person who reads the Texinfo file. All the
+text on a line that follows either @code{@@comment} or @code{@@c} is a
+comment; the rest of the line does not appear in either the Info file
+or the printed manual. (Often, you can write the @code{@@comment} or
+@code{@@c} in the middle of a line, and only the text that follows after
+the @code{@@comment} or @code{@@c} command does not appear; but some
+commands, such as @code{@@settitle} and @code{@@setfilename}, work on a
+whole line. You cannot use @code{@@comment} or @code{@@c} in a line
+beginning with such a command.)@refill
+@cindex Comments
+@findex comment
+@findex c @r{(comment)}
+
+You can write long stretches of text that will not appear in either
+the Info file or the printed manual by using the @code{@@ignore} and
+@code{@@end ignore} commands. Write each of these commands on a line
+of its own, starting each command at the beginning of the line. Text
+between these two commands does not appear in the processed output.
+You can use @code{@@ignore} and @code{@@end ignore} for writing
+comments. Often, @code{@@ignore} and @code{@@end ignore} is used
+to enclose a part of the copying permissions that applies to the
+Texinfo source file of a document, but not to the Info or printed
+version of the document.@refill
+@cindex Ignored text
+@cindex Unprocessed text
+@findex ignore
+@c !!! Perhaps include this comment about ignore and ifset:
+@ignore
+Text enclosed by @code{@@ignore} or by failing @code{@@ifset} or
+@code{@@ifclear} conditions is ignored in the sense that it will not
+contribute to the formatted output. However, TeX and makeinfo must
+still parse the ignored text, in order to understand when to
+@emph{stop} ignoring text from the source file; that means that you
+will still get error messages if you have invalid Texinfo markup
+within ignored text.
+@end ignore
+
+@node Minimum, Six Parts, Comments, Overview
+@comment node-name, next, previous, up
+@section What a Texinfo File Must Have
+@cindex Minimal Texinfo file (requirements)
+@cindex Must have in Texinfo file
+@cindex Required in Texinfo file
+@cindex Texinfo file minimum
+
+By convention, the names of Texinfo files end with one of the
+extensions @file{.texinfo}, @file{.texi}, or @file{.tex}. The longer
+extension is preferred since it describes more clearly to a human
+reader the nature of the file. The shorter extensions are for
+operating systems that cannot handle long file names.@refill
+
+In order to be made into a printed manual and an Info file, a Texinfo
+file @strong{must} begin with lines like this:@refill
+
+@example
+@group
+\input texinfo
+@@setfilename @var{info-file-name}
+@@settitle @var{name-of-manual}
+@end group
+@end example
+
+@noindent
+The contents of the file follow this beginning, and then you @strong{must} end
+a Texinfo file with a line like this:@refill
+
+@example
+@@bye
+@end example
+
+@findex input @r{(@TeX{} command)}
+@noindent
+The @samp{\input texinfo} line tells @TeX{} to use the
+@file{texinfo.tex} file, which tells @TeX{} how to translate the Texinfo
+@@-commands into @TeX{} typesetting commands. (Note the use of the
+backslash, @samp{\}; this is correct for @TeX{}.) The
+@samp{@@setfilename} line provides a name for the Info file and tells
+@TeX{} to open auxiliary files. The @samp{@@settitle} line specifies a
+title for the page headers (or footers) of the printed manual.@refill
+
+The @code{@@bye} line at the end of the file on a line of its own tells
+the formatters that the file is ended and to stop formatting.@refill
+
+Usually, you will not use quite such a spare format, but will include
+mode setting and start-of-header and end-of-header lines at the
+beginning of a Texinfo file, like this:@refill
+
+@example
+@group
+\input texinfo @@c -*-texinfo-*-
+@@c %**start of header
+@@setfilename @var{info-file-name}
+@@settitle @var{name-of-manual}
+@@c %**end of header
+@end group
+@end example
+
+@noindent
+In the first line, @samp{-*-texinfo-*-} causes Emacs to switch into
+Texinfo mode when you edit the file.
+
+The @code{@@c} lines which surround the @samp{@@setfilename} and
+@samp{@@settitle} lines are optional, but you need them in order to
+run @TeX{} or Info on just part of the file. (@xref{Start of Header},
+for more information.)@refill
+
+Furthermore, you will usually provide a Texinfo file with a title
+page, indices, and the like. But the minimum, which can be useful
+for short documents, is just the three lines at the beginning and the
+one line at the end.@refill
+
+@node Six Parts, Short Sample, Minimum, Overview
+@comment node-name, next, previous, up
+@section Six Parts of a Texinfo File
+
+Generally, a Texinfo file contains more than the minimal
+beginning and end---it usually contains six parts:@refill
+
+@table @r
+@item 1. Header
+The @dfn{Header} names the file, tells @TeX{} which definitions' file to
+use, and performs other ``housekeeping'' tasks.@refill
+
+@item 2. Summary Description and Copyright
+The @dfn{Summary Description and Copyright} segment describes the document
+and contains the copyright notice and copying permissions for the Info
+file. The segment must be enclosed between @code{@@ifinfo} and
+@code{@@end ifinfo} commands so that the formatters place it only in the Info
+file.@refill
+
+@item 3. Title and Copyright
+The @dfn{Title and Copyright} segment contains the title and copyright pages
+and copying permissions for the printed manual. The segment must be
+enclosed between @code{@@titlepage} and @code{@@end titlepage} commands.
+The title and copyright page appear only in the printed @w{manual}.@refill
+
+@item 4. `Top' Node and Master Menu
+The @dfn{Master Menu} contains a complete menu of all the nodes in the whole
+Info file. It appears only in the Info file, in the `Top' node.@refill
+
+@item 5. Body
+The @dfn{Body} of the document may be structured like a traditional book or
+encyclopedia or it may be free form.@refill
+
+@item 6. End
+The @dfn{End} contains commands for printing indices and generating
+the table of contents, and the @code{@@bye} command on a line of its
+own.@refill
+@end table
+
+@node Short Sample, Acknowledgements, Six Parts, Overview
+@comment node-name, next, previous, up
+@section A Short Sample Texinfo File
+@cindex Sample Texinfo file
+
+Here is a complete but very short Texinfo file, in 6 parts. The first
+three parts of the file, from @samp{\input texinfo} through to
+@samp{@@end titlepage}, look more intimidating than they are. Most of
+the material is standard boilerplate; when you write a manual, simply
+insert the names for your own manual in this segment. (@xref{Beginning a
+File}.)@refill
+
+@noindent
+In the following, the sample text is @emph{indented}; comments on it are
+not. The complete file, without any comments, is shown in
+@ref{Sample Texinfo File}.
+
+@subheading Part 1: Header
+
+@noindent
+The header does not appear in either the Info file or the@*
+printed output. It sets various parameters, including the@*
+name of the Info file and the title used in the header.
+
+@example
+@group
+\input texinfo @@c -*-texinfo-*-
+@@c %**start of header
+@@setfilename sample.info
+@@settitle Sample Document
+@@c %**end of header
+
+@@setchapternewpage odd
+@end group
+@end example
+
+@subheading Part 2: Summary Description and Copyright
+
+@noindent
+The summary description and copyright segment does not@*
+appear in the printed document.
+
+@example
+@group
+@@ifinfo
+This is a short example of a complete Texinfo file.
+
+Copyright @@copyright@{@} 1990 Free Software Foundation, Inc.
+@@end ifinfo
+@end group
+@end example
+
+@subheading Part 3: Titlepage and Copyright
+
+@noindent
+The titlepage segment does not appear in the Info file.
+
+@example
+@group
+@@titlepage
+@@sp 10
+@@comment The title is printed in a large font.
+@@center @@titlefont@{Sample Title@}
+@end group
+
+@group
+@@c The following two commands start the copyright page.
+@@page
+@@vskip 0pt plus 1filll
+Copyright @@copyright@{@} 1990 Free Software Foundation, Inc.
+@@end titlepage
+@end group
+@end example
+
+@subheading Part 4: `Top' Node and Master Menu
+
+@noindent
+The `Top' node contains the master menu for the Info file.@*
+Since a printed manual uses a table of contents rather than@*
+a menu, the master menu appears only in the Info file.
+
+@example
+@group
+@@node Top, First Chapter, (dir), (dir)
+@@comment node-name, next, previous, up
+@end group
+@end example
+
+@example
+@group
+@@menu
+* First Chapter:: The first chapter is the
+ only chapter in this sample.
+* Concept Index:: This index has two entries.
+@@end menu
+@end group
+@end example
+
+@subheading Part 5: The Body of the Document
+
+@noindent
+The body segment contains all the text of the document, but not the
+indices or table of contents. This example illustrates a node and a
+chapter containing an enumerated list.@refill
+
+@example
+@group
+@@node First Chapter, Concept Index, Top, Top
+@@comment node-name, next, previous, up
+@@chapter First Chapter
+@@cindex Sample index entry
+@end group
+
+@group
+This is the contents of the first chapter.
+@@cindex Another sample index entry
+@end group
+
+@group
+Here is a numbered list.
+
+@@enumerate
+@@item
+This is the first item.
+
+@@item
+This is the second item.
+@@end enumerate
+@end group
+
+@group
+The @@code@{makeinfo@} and @@code@{texinfo-format-buffer@}
+commands transform a Texinfo file such as this into
+an Info file; and @@TeX@{@} typesets it for a printed
+manual.
+@end group
+@end example
+
+@subheading Part 6: The End of the Document
+
+@noindent
+The end segment contains commands both for generating an index in a node
+and unnumbered chapter of its own and for generating the table of
+contents; and it contains the @code{@@bye} command that marks the end of
+the document.@refill
+
+@example
+@group
+@@node Concept Index, , First Chapter, Top
+@@comment node-name, next, previous, up
+@@unnumbered Concept Index
+@end group
+
+@group
+@@printindex cp
+
+@@contents
+@@bye
+@end group
+@end example
+
+@subheading The Results
+
+Here is what the contents of the first chapter of the sample look like:
+
+@sp 1
+@need 700
+@quotation
+This is the contents of the first chapter.
+
+Here is a numbered list.
+
+@enumerate
+@item
+This is the first item.
+
+@item
+This is the second item.
+@end enumerate
+
+The @code{makeinfo} and @code{texinfo-format-buffer}
+commands transform a Texinfo file such as this into
+an Info file; and @TeX{} typesets it for a printed
+manual.
+@end quotation
+
+@node Acknowledgements, , Short Sample, Overview
+@comment node-name, next, previous, up
+@section Acknowledgements
+
+@cindex Stallman, Richard M.
+@cindex Chassell, Robert J.
+@cindex Berry, Karl
+Richard M.@: Stallman wrote Edition 1.0 of this manual. @w{Robert J.@:
+Chassell} revised and extended it, starting with Edition 1.1. Karl
+Berry made updates for the Texinfo 3.8 and subsequent releases, starting
+with Edition 2.22.
+
+@cindex Pinard, Fran@,{c}ois
+@cindex Zuhn, David D.
+@cindex Weisshaus, Melissa
+Our thanks go out to all who helped improve this work, particularly to
+Fran@,{c}ois Pinard and @w{David D.@: Zuhn}, who tirelessly recorded and
+reported mistakes and obscurities; our special thanks go to Melissa
+Weisshaus for her frequent and often tedious reviews of nearly similar
+editions. Our mistakes are our own.
+
+Please send suggestions and corrections to:
+
+@example
+@group
+@r{Internet address:}
+ bug-texinfo@@prep.ai.mit.edu
+@end group
+@end example
+
+@noindent
+Please include the manual's edition number and update date in your messages.
+
+@node Texinfo Mode, Beginning a File, Overview, Top
+@comment node-name, next, previous, up
+@chapter Using Texinfo Mode
+@cindex Texinfo mode
+@cindex Mode, using Texinfo
+@cindex GNU Emacs
+@cindex Emacs
+
+You may edit a Texinfo file with any text editor you choose. A Texinfo
+file is no different from any other @sc{ascii} file. However, GNU Emacs
+comes with a special mode, called Texinfo
+mode, that provides Emacs commands and tools to help ease your work.@refill
+
+This chapter describes features of GNU Emacs' Texinfo mode but not any
+features of the Texinfo formatting language. If you are reading this
+manual straight through from the beginning, you may want to skim through
+this chapter briefly and come back to it after reading succeeding
+chapters which describe the Texinfo formatting language in
+detail.@refill
+
+@menu
+* Texinfo Mode Overview:: How Texinfo mode can help you.
+* Emacs Editing:: Texinfo mode adds to GNU Emacs' general
+ purpose editing features.
+* Inserting:: How to insert frequently used @@-commands.
+* Showing the Structure:: How to show the structure of a file.
+* Updating Nodes and Menus:: How to update or create new nodes and menus.
+* Info Formatting:: How to format for Info.
+* Printing:: How to format and print part or all of a file.
+* Texinfo Mode Summary:: Summary of all the Texinfo mode commands.
+@end menu
+
+@node Texinfo Mode Overview, Emacs Editing, Texinfo Mode, Texinfo Mode
+@ifinfo
+@heading Texinfo Mode Overview
+@end ifinfo
+
+Texinfo mode provides special features for working with Texinfo
+files:@refill
+
+@itemize @bullet
+@item
+Insert frequently used @@-commands. @refill
+
+@item
+Automatically create @code{@@node} lines.
+
+@item
+Show the structure of a Texinfo source file.@refill
+
+@item
+Automatically create or update the `Next',@*
+`Previous', and `Up' pointers of a node.
+
+@item
+Automatically create or update menus.@refill
+
+@item
+Automatically create a master menu.@refill
+
+@item
+Format a part or all of a file for Info.@refill
+
+@item
+Typeset and print part or all of a file.@refill
+@end itemize
+
+Perhaps the two most helpful features are those for inserting frequently
+used @@-commands and for creating node pointers and menus.@refill
+
+@node Emacs Editing, Inserting, Texinfo Mode Overview, Texinfo Mode
+@section The Usual GNU Emacs Editing Commands
+
+In most cases, the usual Text mode commands work the same in Texinfo
+mode as they do in Text mode. Texinfo mode adds new editing commands
+and tools to GNU Emacs' general purpose editing features. The major
+difference concerns filling. In Texinfo mode, the paragraph
+separation variable and syntax table are redefined so that Texinfo
+commands that should be on lines of their own are not inadvertently
+included in paragraphs. Thus, the @kbd{M-q} (@code{fill-paragraph})
+command will refill a paragraph but not mix an indexing command on a
+line adjacent to it into the paragraph.@refill
+
+In addition, Texinfo mode sets the @code{page-delimiter} variable to
+the value of @code{texinfo-chapter-level-regexp}; by default, this is
+a regular expression matching the commands for chapters and their
+equivalents, such as appendices. With this value for the page
+delimiter, you can jump from chapter title to chapter title with the
+@kbd{C-x ]} (@code{forward-page}) and @kbd{C-x [}
+(@code{backward-page}) commands and narrow to a chapter with the
+@kbd{C-x p} (@code{narrow-to-page}) command. (@xref{Pages, , ,emacs,
+The GNU Emacs Manual}, for details about the page commands.)@refill
+
+You may name a Texinfo file however you wish, but the convention is to
+end a Texinfo file name with one of the three extensions
+@file{.texinfo}, @file{.texi}, or @file{.tex}. A longer extension is
+preferred, since it is explicit, but a shorter extension may be
+necessary for operating systems that limit the length of file names.
+GNU Emacs automatically enters Texinfo mode when you visit a file with
+a @file{.texinfo} or @file{.texi}
+extension. Also, Emacs switches to Texinfo mode
+when you visit a
+file that has @samp{-*-texinfo-*-} in its first line. If ever you are
+in another mode and wish to switch to Texinfo mode, type @code{M-x
+texinfo-mode}.@refill
+
+Like all other Emacs features, you can customize or enhance Texinfo
+mode as you wish. In particular, the keybindings are very easy to
+change. The keybindings described here are the default or standard
+ones.@refill
+
+@node Inserting, Showing the Structure, Emacs Editing, Texinfo Mode
+@comment node-name, next, previous, up
+@section Inserting Frequently Used Commands
+@cindex Inserting frequently used commands
+@cindex Frequently used commands, inserting
+@cindex Commands, inserting them
+
+Texinfo mode provides commands to insert various frequently used
+@@-commands into the buffer. You can use these commands to save
+keystrokes.@refill
+
+The insert commands are invoked by typing @kbd{C-c} twice and then the
+first letter of the @@-command:@refill
+
+@table @kbd
+@item C-c C-c c
+@itemx M-x texinfo-insert-@@code
+@findex texinfo-insert-@@code
+Insert @code{@@code@{@}} and put the
+cursor between the braces.@refill
+
+@item C-c C-c d
+@itemx M-x texinfo-insert-@@dfn
+@findex texinfo-insert-@@dfn
+Insert @code{@@dfn@{@}} and put the
+cursor between the braces.@refill
+
+@item C-c C-c e
+@itemx M-x texinfo-insert-@@end
+@findex texinfo-insert-@@end
+Insert @code{@@end} and attempt to insert the correct following word,
+such as @samp{example} or @samp{table}. (This command does not handle
+nested lists correctly, but inserts the word appropriate to the
+immediately preceding list.)@refill
+
+@item C-c C-c i
+@itemx M-x texinfo-insert-@@item
+@findex texinfo-insert-@@item
+Insert @code{@@item} and put the
+cursor at the beginning of the next line.@refill
+
+@item C-c C-c k
+@itemx M-x texinfo-insert-@@kbd
+@findex texinfo-insert-@@kbd
+Insert @code{@@kbd@{@}} and put the
+cursor between the braces.@refill
+
+@item C-c C-c n
+@itemx M-x texinfo-insert-@@node
+@findex texinfo-insert-@@node
+Insert @code{@@node} and a comment line
+listing the sequence for the `Next',
+`Previous', and `Up' nodes.
+Leave point after the @code{@@node}.@refill
+
+@item C-c C-c o
+@itemx M-x texinfo-insert-@@noindent
+@findex texinfo-insert-@@noindent
+Insert @code{@@noindent} and put the
+cursor at the beginning of the next line.@refill
+
+@item C-c C-c s
+@itemx M-x texinfo-insert-@@samp
+@findex texinfo-insert-@@samp
+Insert @code{@@samp@{@}} and put the
+cursor between the braces.@refill
+
+@item C-c C-c t
+@itemx M-x texinfo-insert-@@table
+@findex texinfo-insert-@@table
+Insert @code{@@table} followed by a @key{SPC}
+and leave the cursor after the @key{SPC}.@refill
+
+@item C-c C-c v
+@itemx M-x texinfo-insert-@@var
+@findex texinfo-insert-@@var
+Insert @code{@@var@{@}} and put the
+cursor between the braces.@refill
+
+@item C-c C-c x
+@itemx M-x texinfo-insert-@@example
+@findex texinfo-insert-@@example
+Insert @code{@@example} and put the
+cursor at the beginning of the next line.@refill
+
+@c M-@{ was the binding for texinfo-insert-braces;
+@c in Emacs 19, backward-paragraph will take this binding.
+@item C-c C-c @{
+@itemx M-x texinfo-insert-braces
+@findex texinfo-insert-braces
+Insert @code{@{@}} and put the cursor between the braces.@refill
+
+@item C-c C-c @}
+@itemx C-c C-c ]
+@itemx M-x up-list
+@findex up-list
+Move from between a pair of braces forward past the closing brace.
+Typing @kbd{C-c C-c ]} is easier than typing @kbd{C-c C-c @}}, which
+is, however, more mnemonic; hence the two keybindings. (Also, you can
+move out from between braces by typing @kbd{C-f}.)@refill
+@end table
+
+To put a command such as @w{@code{@@code@{@dots{}@}}} around an
+@emph{existing} word, position the cursor in front of the word and type
+@kbd{C-u 1 C-c C-c c}. This makes it easy to edit existing plain text.
+The value of the prefix argument tells Emacs how many words following
+point to include between braces---1 for one word, 2 for two words, and
+so on. Use a negative argument to enclose the previous word or words.
+If you do not specify a prefix argument, Emacs inserts the @@-command
+string and positions the cursor between the braces. This feature works
+only for those @@-commands that operate on a word or words within one
+line, such as @code{@@kbd} and @code{@@var}.@refill
+
+This set of insert commands was created after analyzing the frequency
+with which different @@-commands are used in the @cite{GNU Emacs
+Manual} and the @cite{GDB Manual}. If you wish to add your own insert
+commands, you can bind a keyboard macro to a key, use abbreviations,
+or extend the code in @file{texinfo.el}.@refill
+
+@findex texinfo-start-menu-description
+@cindex Menu description, start
+@cindex Description for menu, start
+@kbd{C-c C-c C-d} (@code{texinfo-start-menu-description}) is an insert
+command that works differently from the other insert commands. It
+inserts a node's section or chapter title in the space for the
+description in a menu entry line. (A menu entry has three parts, the
+entry name, the node name, and the description. Only the node name is
+required, but a description helps explain what the node is about.
+@xref{Menu Parts, , The Parts of a Menu}.)@refill
+
+To use @code{texinfo-start-menu-description}, position point in a menu
+entry line and type @kbd{C-c C-c C-d}. The command looks for and copies
+the title that goes with the node name, and inserts the title as a
+description; it positions point at beginning of the inserted text so you
+can edit it. The function does not insert the title if the menu entry
+line already contains a description.@refill
+
+This command is only an aid to writing descriptions; it does not do the
+whole job. You must edit the inserted text since a title tends to use
+the same words as a node name but a useful description uses different
+words.@refill
+
+@node Showing the Structure, Updating Nodes and Menus, Inserting, Texinfo Mode
+@comment node-name, next, previous, up
+@section Showing the Section Structure of a File
+@cindex Showing the section structure of a file
+@cindex Section structure of a file, showing it
+@cindex Structure of a file, showing it
+@cindex Outline of file structure, showing it
+@cindex Contents-like outline of file structure
+@cindex File section structure, showing it
+@cindex Texinfo file section structure, showing it
+
+You can show the section structure of a Texinfo file by using the
+@kbd{C-c C-s} command (@code{texinfo-show-structure}). This command
+shows the section structure of a Texinfo file by listing the lines
+that begin with the @@-commands for @code{@@chapter},
+@code{@@section}, and the like. It constructs what amounts
+to a table of contents. These lines are displayed in another buffer
+called the @samp{*Occur*} buffer. In that buffer, you can position
+the cursor over one of the lines and use the @kbd{C-c C-c} command
+(@code{occur-mode-goto-occurrence}), to jump to the corresponding spot
+in the Texinfo file.@refill
+
+@table @kbd
+@item C-c C-s
+@itemx M-x texinfo-show-structure
+@findex texinfo-show-structure
+Show the @code{@@chapter}, @code{@@section}, and such lines of a
+Texinfo file.@refill
+
+@item C-c C-c
+@itemx M-x occur-mode-goto-occurrence
+@findex occur-mode-goto-occurrence
+Go to the line in the Texinfo file corresponding to the line under the
+cursor in the @file{*Occur*} buffer.@refill
+@end table
+
+If you call @code{texinfo-show-structure} with a prefix argument by
+typing @w{@kbd{C-u C-c C-s}}, it will list not only those lines with the
+@@-commands for @code{@@chapter}, @code{@@section}, and the like,
+but also the @code{@@node} lines. (This is how the
+@code{texinfo-show-structure} command worked without an argument in
+the first version of Texinfo. It was changed because @code{@@node}
+lines clutter up the @samp{*Occur*} buffer and are usually not
+needed.) You can use @code{texinfo-show-structure} with a prefix
+argument to check whether the `Next', `Previous', and `Up' pointers of
+an @code{@@node} line are correct.@refill
+
+Often, when you are working on a manual, you will be interested only
+in the structure of the current chapter. In this case, you can mark
+off the region of the buffer that you are interested in by using the
+@kbd{C-x n n} (@code{narrow-to-region}) command and
+@code{texinfo-show-structure} will work on only that region. To see
+the whole buffer again, use @w{@kbd{C-x n w}} (@code{widen}).
+(@xref{Narrowing, , , emacs, The GNU Emacs Manual}, for more
+information about the narrowing commands.)@refill
+
+@vindex page-delimiter
+@cindex Page delimiter in Texinfo mode
+In addition to providing the @code{texinfo-show-structure} command,
+Texinfo mode sets the value of the page delimiter variable to match
+the chapter-level @@-commands. This enables you to use the @kbd{C-x
+]} (@code{forward-page}) and @kbd{C-x [} (@code{backward-page})
+commands to move forward and backward by chapter, and to use the
+@kbd{C-x p} (@code{narrow-to-page}) command to narrow to a chapter.
+@xref{Pages, , , emacs, The GNU Emacs Manual}, for more information
+about the page commands.@refill
+
+@node Updating Nodes and Menus, Info Formatting, Showing the Structure, Texinfo Mode
+@comment node-name, next, previous, up
+@section Updating Nodes and Menus
+@cindex Updating nodes and menus
+@cindex Create nodes, menus automatically
+@cindex Insert nodes, menus automatically
+@cindex Automatically insert nodes, menus
+
+Texinfo mode provides commands for automatically creating or updating
+menus and node pointers. The commands are called ``update'' commands
+because their most frequent use is for updating a Texinfo file after
+you have worked on it; but you can use them to insert the `Next',
+`Previous', and `Up' pointers into an @code{@@node} line that has none and to
+create menus in a file that has none.@refill
+
+If you do not use the updating commands, you need to write menus and
+node pointers by hand, which is a tedious task.@refill
+
+@menu
+* Updating Commands:: Five major updating commands.
+* Updating Requirements:: How to structure a Texinfo file for
+ using the updating command.
+* Other Updating Commands:: How to indent descriptions, insert
+ missing nodes lines, and update
+ nodes in sequence.
+@end menu
+
+@node Updating Commands, Updating Requirements, Updating Nodes and Menus, Updating Nodes and Menus
+@ifinfo
+@subheading The Updating Commands
+@end ifinfo
+
+You can use the updating commands@refill
+
+@itemize @bullet
+@item
+to insert or update the `Next', `Previous', and `Up' pointers of a
+node,@refill
+
+@item
+to insert or update the menu for a section, and@refill
+
+@item
+to create a master menu for a Texinfo source file.@refill
+@end itemize
+
+You can also use the commands to update all the nodes and menus in a
+region or in a whole Texinfo file.@refill
+
+The updating commands work only with conventional Texinfo files, which
+are structured hierarchically like books. In such files, a structuring
+command line must follow closely after each @code{@@node} line, except
+for the `Top' @code{@@node} line. (A @dfn{structuring command line} is
+a line beginning with @code{@@chapter}, @code{@@section}, or other
+similar command.)
+
+You can write the structuring command line on the line that follows
+immediately after an @code{@@node} line or else on the line that
+follows after a single @code{@@comment} line or a single
+@code{@@ifinfo} line. You cannot interpose more than one line between
+the @code{@@node} line and the structuring command line; and you may
+interpose only an @code{@@comment} line or an @code{@@ifinfo} line.
+
+Commands which work on a whole buffer require that the `Top' node be
+followed by a node with an @code{@@chapter} or equivalent-level command.
+Note that the menu updating commands will not create a main or master
+menu for a Texinfo file that has only @code{@@chapter}-level nodes! The
+menu updating commands only create menus @emph{within} nodes for lower level
+nodes. To create a menu of chapters, you must provide a `Top'
+node.@refill
+
+The menu updating commands remove menu entries that refer to other Info
+files since they do not refer to nodes within the current buffer. This
+is a deficiency. Rather than use menu entries, you can use cross
+references to refer to other Info files. None of the updating commands
+affect cross references.@refill
+
+Texinfo mode has five updating commands that are used most often: two
+are for updating the node pointers or menu of a single node (or a
+region); two are for updating every node pointer and menu in a file;
+and one, the @code{texinfo-master-menu} command, is for creating a
+master menu for a complete file, and optionally, for updating every
+node and menu in the whole Texinfo file.@refill
+
+The @code{texinfo-master-menu} command is the primary command:@refill
+
+@table @kbd
+@item C-c C-u m
+@itemx M-x texinfo-master-menu
+@findex texinfo-master-menu
+Create or update a master menu that includes all the other menus
+(incorporating the descriptions from pre-existing menus, if
+any).@refill
+
+With an argument (prefix argument, @kbd{C-u,} if interactive), first create or
+update all the nodes and all the regular menus in the buffer before
+constructing the master menu. (@xref{The Top Node, , The Top Node and
+Master Menu}, for more about a master menu.)@refill
+
+For @code{texinfo-master-menu} to work, the Texinfo file must have a
+`Top' node and at least one subsequent node.@refill
+
+After extensively editing a Texinfo file, you can type the following:
+
+@example
+C-u M-x texinfo-master-menu
+@exdent or
+C-u C-c C-u m
+@end example
+
+@noindent
+This updates all the nodes and menus completely and all at once.@refill
+@end table
+
+The other major updating commands do smaller jobs and are designed for
+the person who updates nodes and menus as he or she writes a Texinfo
+file.@refill
+
+@need 1000
+The commands are:@refill
+
+@table @kbd
+@item C-c C-u C-n
+@itemx M-x texinfo-update-node
+@findex texinfo-update-node
+Insert the `Next', `Previous', and `Up' pointers for the node that point is
+within (i.e., for the @code{@@node} line preceding point). If the
+@code{@@node} line has pre-existing `Next', `Previous', or `Up'
+pointers in it, the old pointers are removed and new ones inserted.
+With an argument (prefix argument, @kbd{C-u}, if interactive), this command
+updates all @code{@@node} lines in the region (which is the text
+between point and mark).@refill
+
+@item C-c C-u C-m
+@itemx M-x texinfo-make-menu
+@findex texinfo-make-menu
+Create or update the menu in the node that point is within.
+With an argument (@kbd{C-u} as prefix argument, if
+interactive), the command makes or updates menus for the
+nodes which are either within or a part of the
+region.@refill
+
+Whenever @code{texinfo-make-menu} updates an existing menu, the
+descriptions from that menu are incorporated into the new menu. This
+is done by copying descriptions from the existing menu to the entries
+in the new menu that have the same node names. If the node names are
+different, the descriptions are not copied to the new menu.@refill
+
+@item C-c C-u C-e
+@itemx M-x texinfo-every-node-update
+@findex texinfo-every-node-update
+Insert or update the `Next', `Previous', and `Up' pointers for every
+node in the buffer.@refill
+
+@item C-c C-u C-a
+@itemx M-x texinfo-all-menus-update
+@findex texinfo-all-menus-update
+Create or update all the menus in the buffer. With an argument
+(@kbd{C-u} as prefix argument, if interactive), first insert
+or update all the node
+pointers before working on the menus.@refill
+
+If a master menu exists, the @code{texinfo-all-menus-update} command
+updates it; but the command does not create a new master menu if none
+already exists. (Use the @code{texinfo-master-menu} command for
+that.)@refill
+
+When working on a document that does not merit a master menu, you can
+type the following:
+
+@example
+C-u C-c C-u C-a
+@exdent or
+C-u M-x texinfo-all-menus-update
+@end example
+
+@noindent
+This updates all the nodes and menus.@refill
+@end table
+
+The @code{texinfo-column-for-description} variable specifies the
+column to which menu descriptions are indented. By default, the value
+is 32 although it is often useful to reduce it to as low as 24. You
+can set the variable with the @kbd{M-x edit-options} command
+(@pxref{Edit Options, , Editing Variable Values, emacs, The GNU Emacs
+Manual}) or with the @kbd{M-x set-variable} command (@pxref{Examining,
+, Examining and Setting Variables, emacs, The GNU Emacs
+Manual}).@refill
+
+Also, the @code{texinfo-indent-menu-description} command may be used to
+indent existing menu descriptions to a specified column. Finally, if
+you wish, you can use the @code{texinfo-insert-node-lines} command to
+insert missing @code{@@node} lines into a file. (@xref{Other Updating
+Commands}, for more information.)@refill
+
+@node Updating Requirements, Other Updating Commands, Updating Commands, Updating Nodes and Menus
+@comment node-name, next, previous, up
+@subsection Updating Requirements
+@cindex Updating requirements
+@cindex Requirements for updating commands
+
+To use the updating commands, you must organize the Texinfo file
+hierarchically with chapters, sections, subsections, and the like.
+When you construct the hierarchy of the manual, do not `jump down'
+more than one level at a time: you can follow the `Top' node with a
+chapter, but not with a section; you can follow a chapter with a
+section, but not with a subsection. However, you may `jump up' any
+number of levels at one time---for example, from a subsection to a
+chapter.@refill
+
+Each @code{@@node} line, with the exception of the line for the `Top'
+node, must be followed by a line with a structuring command such as
+@code{@@chapter}, @code{@@section}, or
+@code{@@unnumberedsubsec}.@refill
+
+Each @code{@@node} line/structuring-command line combination
+must look either like this:@refill
+
+@example
+@group
+@@node Comments, Minimum, Conventions, Overview
+@@comment node-name, next, previous, up
+@@section Comments
+@end group
+@end example
+
+or like this (without the @code{@@comment} line):
+
+@example
+@group
+@@node Comments, Minimum, Conventions, Overview
+@@section Comments
+@end group
+@end example
+
+@noindent
+In this example, `Comments' is the name of both the node and the
+section. The next node is called `Minimum' and the previous node is
+called `Conventions'. The `Comments' section is within the `Overview'
+node, which is specified by the `Up' pointer. (Instead of an
+@code{@@comment} line, you can write an @code{@@ifinfo} line.)@refill
+
+If a file has a `Top' node, it must be called @samp{top} or @samp{Top}
+and be the first node in the file.@refill
+
+The menu updating commands create a menu of sections within a chapter,
+a menu of subsections within a section, and so on. This means that
+you must have a `Top' node if you want a menu of chapters.@refill
+
+Incidentally, the @code{makeinfo} command will create an Info file for
+a hierarchically organized Texinfo file that lacks `Next', `Previous'
+and `Up' pointers. Thus, if you can be sure that your Texinfo file
+will be formatted with @code{makeinfo}, you have no need for the
+`update node' commands. (@xref{Create an Info File, , Creating an
+Info File}, for more information about @code{makeinfo}.) However,
+both @code{makeinfo} and the @code{texinfo-format-@dots{}} commands
+require that you insert menus in the file.@refill
+
+@node Other Updating Commands, , Updating Requirements, Updating Nodes and Menus
+@comment node-name, next, previous, up
+@subsection Other Updating Commands
+
+In addition to the five major updating commands, Texinfo mode
+possesses several less frequently used updating commands:@refill
+
+@table @kbd
+@item M-x texinfo-insert-node-lines
+@findex texinfo-insert-node-lines
+Insert @code{@@node} lines before the @code{@@chapter},
+@code{@@section}, and other sectioning commands wherever they are
+missing throughout a region in a Texinfo file.@refill
+
+With an argument (@kbd{C-u} as prefix argument, if interactive), the
+@code{texinfo-insert-node-lines} command not only inserts
+@code{@@node} lines but also inserts the chapter or section titles as
+the names of the corresponding nodes. In addition, it inserts the
+titles as node names in pre-existing @code{@@node} lines that lack
+names. Since node names should be more concise than section or
+chapter titles, you must manually edit node names so inserted.@refill
+
+For example, the following marks a whole buffer as a region and inserts
+@code{@@node} lines and titles throughout:@refill
+
+@example
+C-x h C-u M-x texinfo-insert-node-lines
+@end example
+
+(Note that this command inserts titles as node names in @code{@@node}
+lines; the @code{texinfo-start-menu-description} command
+(@pxref{Inserting, Inserting Frequently Used Commands}) inserts titles
+as descriptions in menu entries, a different action. However, in both
+cases, you need to edit the inserted text.)@refill
+
+@item M-x texinfo-multiple-files-update
+@findex texinfo-multiple-files-update @r{(in brief)}
+Update nodes and menus in a document built from several separate files.
+With @kbd{C-u} as a prefix argument, create and insert a master menu in
+the outer file. With a numeric prefix argument, such as @kbd{C-u 2}, first
+update all the menus and all the `Next', `Previous', and `Up' pointers
+of all the included files before creating and inserting a master menu in
+the outer file. The @code{texinfo-multiple-files-update} command is
+described in the appendix on @code{@@include} files.
+@ifinfo
+@xref{texinfo-multiple-files-update}.@refill
+@end ifinfo
+@iftex
+@xref{texinfo-multiple-files-update, ,
+@code{texinfo-multiple-files-update}}.@refill
+@end iftex
+
+@item M-x texinfo-indent-menu-description
+@findex texinfo-indent-menu-description
+Indent every description in the menu following point to the specified
+column. You can use this command to give yourself more space for
+descriptions. With an argument (@kbd{C-u} as prefix argument, if
+interactive), the @code{texinfo-indent-menu-description} command indents
+every description in every menu in the region. However, this command
+does not indent the second and subsequent lines of a multi-line
+description.@refill
+
+@item M-x texinfo-sequential-node-update
+@findex texinfo-sequential-node-update
+Insert the names of the nodes immediately following and preceding the
+current node as the `Next' or `Previous' pointers regardless of those
+nodes' hierarchical level. This means that the `Next' node of a
+subsection may well be the next chapter. Sequentially ordered nodes are
+useful for novels and other documents that you read through
+sequentially. (However, in Info, the @code{g* @key{RET}} command lets
+you look through the file sequentially, so sequentially ordered nodes
+are not strictly necessary.) With an argument (prefix argument, if
+interactive), the @code{texinfo-sequential-node-update} command
+sequentially updates all the nodes in the region.@refill
+@end table
+
+@node Info Formatting, Printing, Updating Nodes and Menus, Texinfo Mode
+@comment node-name, next, previous, up
+@section Formatting for Info
+@cindex Formatting for Info
+@cindex Running an Info formatter
+@cindex Info formatting
+
+Texinfo mode provides several commands for formatting part or all of a
+Texinfo file for Info. Often, when you are writing a document, you
+want to format only part of a file---that is, a region.@refill
+
+You can use either the @code{texinfo-format-region} or the
+@code{makeinfo-region} command to format a region:@refill
+
+@table @kbd
+@findex texinfo-format-region
+@item C-c C-e C-r
+@itemx M-x texinfo-format-region
+@itemx C-c C-m C-r
+@itemx M-x makeinfo-region
+Format the current region for Info.@refill
+@end table
+
+You can use either the @code{texinfo-format-buffer} or the
+@code{makeinfo-buffer} command to format a whole buffer:@refill
+
+@table @kbd
+@findex texinfo-format-buffer
+@item C-c C-e C-b
+@itemx M-x texinfo-format-buffer
+@itemx C-c C-m C-b
+@itemx M-x makeinfo-buffer
+Format the current buffer for Info.@refill
+@end table
+
+@need 1000
+For example, after writing a Texinfo file, you can type the following:
+
+@example
+C-u C-c C-u m
+@exdent or
+C-u M-x texinfo-master-menu
+@end example
+
+@noindent
+This updates all the nodes and menus. Then type the following to create
+an Info file:
+
+@example
+C-c C-m C-b
+@exdent or
+M-x makeinfo-buffer
+@end example
+
+For @TeX{} or the Info formatting commands to work, the file @emph{must}
+include a line that has @code{@@setfilename} in its header.@refill
+
+@xref{Create an Info File}, for details about Info formatting.@refill
+
+@node Printing, Texinfo Mode Summary, Info Formatting, Texinfo Mode
+@comment node-name, next, previous, up
+@section Formatting and Printing
+@cindex Formatting for printing
+@cindex Printing a region or buffer
+@cindex Region formatting and printing
+@cindex Buffer formatting and printing
+@cindex Part of file formatting and printing
+
+Typesetting and printing a Texinfo file is a multi-step process in which
+you first create a file for printing (called a @sc{dvi} file), and then
+print the file. Optionally, you may also create indices. To do this,
+you must run the @code{texindex} command after first running the
+@code{tex} typesetting command; and then you must run the @code{tex}
+command again. Or else run the @code{texi2dvi} command which
+automatically creates indices as needed.@refill
+
+Often, when you are writing a document, you want to typeset and print
+only part of a file to see what it will look like. You can use the
+@code{texinfo-tex-region} and related commands for this purpose. Use
+the @code{texinfo-tex-buffer} command to format all of a
+buffer.@refill
+
+@table @kbd
+@item C-c C-t C-b
+@itemx M-x texinfo-tex-buffer
+@findex texinfo-tex-buffer
+Run @code{texi2dvi} on the buffer. In addition to running @TeX{} on the
+buffer, this command automatically creates or updates indices as
+needed.@refill
+
+@item C-c C-t C-r
+@itemx M-x texinfo-tex-region
+@findex texinfo-tex-region
+Run @TeX{} on the region.@refill
+
+@item C-c C-t C-i
+@itemx M-x texinfo-texindex
+Run @code{texindex} to sort the indices of a Texinfo file formatted with
+@code{texinfo-tex-region}. The @code{texinfo-tex-region} command does
+not run @code{texindex} automatically; it only runs the @code{tex}
+typesetting command. You must run the @code{texinfo-tex-region} command
+a second time after sorting the raw index files with the @code{texindex}
+command. (Usually, you do not format an index when you format a region,
+only when you format a buffer. Now that the @code{texi2dvi} command
+exists, there is no little need for this command.)@refill
+
+@item C-c C-t C-p
+@itemx M-x texinfo-tex-print
+@findex texinfo-tex-print
+Print the file (or the part of the file) previously formatted with
+@code{texinfo-tex-buffer} or @code{texinfo-tex-region}.@refill
+@end table
+
+For @code{texinfo-tex-region} or @code{texinfo-tex-buffer} to work, the
+file @emph{must} start with a @samp{\input texinfo} line and must
+include an @code{@@settitle} line. The file must end with @code{@@bye}
+on a line by itself. (When you use @code{texinfo-tex-region}, you must
+surround the @code{@@settitle} line with start-of-header and
+end-of-header lines.)@refill
+
+@xref{Format/Print Hardcopy}, for a description of the other @TeX{} related
+commands, such as @code{tex-show-print-queue}.@refill
+
+@node Texinfo Mode Summary, , Printing, Texinfo Mode
+@comment node-name, next, previous, up
+@section Texinfo Mode Summary
+
+In Texinfo mode, each set of commands has default keybindings that
+begin with the same keys. All the commands that are custom-created
+for Texinfo mode begin with @kbd{C-c}. The keys are somewhat
+mnemonic.@refill
+
+@subheading Insert Commands
+
+The insert commands are invoked by typing @kbd{C-c} twice and then the
+first letter of the @@-command to be inserted. (It might make more
+sense mnemonically to use @kbd{C-c C-i}, for `custom insert', but
+@kbd{C-c C-c} is quick to type.)@refill
+
+@example
+C-c C-c c @r{Insert} @samp{@@code}.
+C-c C-c d @r{Insert} @samp{@@dfn}.
+C-c C-c e @r{Insert} @samp{@@end}.
+C-c C-c i @r{Insert} @samp{@@item}.
+C-c C-c n @r{Insert} @samp{@@node}.
+C-c C-c s @r{Insert} @samp{@@samp}.
+C-c C-c v @r{Insert} @samp{@@var}.
+C-c C-c @{ @r{Insert braces.}
+C-c C-c ]
+C-c C-c @} @r{Move out of enclosing braces.}
+
+@group
+C-c C-c C-d @r{Insert a node's section title}
+ @r{in the space for the description}
+ @r{in a menu entry line.}
+@end group
+@end example
+
+@subheading Show Structure
+
+The @code{texinfo-show-structure} command is often used within a
+narrowed region.@refill
+
+@example
+C-c C-s @r{List all the headings.}
+@end example
+
+@subheading The Master Update Command
+
+The @code{texinfo-master-menu} command creates a master menu; and can
+be used to update every node and menu in a file as well.@refill
+
+@example
+@group
+C-c C-u m
+M-x texinfo-master-menu
+ @r{Create or update a master menu.}
+@end group
+
+@group
+C-u C-c C-u m @r{With @kbd{C-u} as a prefix argument, first}
+ @r{create or update all nodes and regular}
+ @r{menus, and then create a master menu.}
+@end group
+@end example
+
+@subheading Update Pointers
+
+The update pointer commands are invoked by typing @kbd{C-c C-u} and
+then either @kbd{C-n} for @code{texinfo-update-node} or @kbd{C-e} for
+@code{texinfo-every-node-update}.@refill
+
+@example
+C-c C-u C-n @r{Update a node.}
+C-c C-u C-e @r{Update every node in the buffer.}
+@end example
+
+@subheading Update Menus
+
+Invoke the update menu commands by typing @kbd{C-c C-u}
+and then either @kbd{C-m} for @code{texinfo-make-menu} or
+@kbd{C-a} for @code{texinfo-all-menus-update}. To update
+both nodes and menus at the same time, precede @kbd{C-c C-u
+C-a} with @kbd{C-u}.@refill
+
+@example
+C-c C-u C-m @r{Make or update a menu.}
+
+@group
+C-c C-u C-a @r{Make or update all}
+ @r{menus in a buffer.}
+@end group
+
+@group
+C-u C-c C-u C-a @r{With @kbd{C-u} as a prefix argument,}
+ @r{first create or update all nodes and}
+ @r{then create or update all menus.}
+@end group
+@end example
+
+@subheading Format for Info
+
+The Info formatting commands that are written in Emacs Lisp are
+invoked by typing @kbd{C-c C-e} and then either @kbd{C-r} for a region
+or @kbd{C-b} for the whole buffer.@refill
+
+The Info formatting commands that are written in C and based on the
+@code{makeinfo} program are invoked by typing @kbd{C-c C-m} and then
+either @kbd{C-r} for a region or @kbd{C-b} for the whole buffer.@refill
+
+@need 800
+@noindent
+Use the @code{texinfo-format@dots{}} commands:
+
+@example
+@group
+C-c C-e C-r @r{Format the region.}
+C-c C-e C-b @r{Format the buffer.}
+@end group
+@end example
+
+@need 750
+@noindent
+Use @code{makeinfo}:
+
+@example
+C-c C-m C-r @r{Format the region.}
+C-c C-m C-b @r{Format the buffer.}
+C-c C-m C-l @r{Recenter the @code{makeinfo} output buffer.}
+C-c C-m C-k @r{Kill the @code{makeinfo} formatting job.}
+@end example
+
+@subheading Typeset and Print
+
+The @TeX{} typesetting and printing commands are invoked by typing
+@kbd{C-c C-t} and then another control command: @kbd{C-r} for
+@code{texinfo-tex-region}, @kbd{C-b} for @code{texinfo-tex-buffer},
+and so on.@refill
+
+@example
+C-c C-t C-r @r{Run @TeX{} on the region.}
+C-c C-t C-b @r{Run} @code{texi2dvi} @r{on the buffer.}
+C-c C-t C-i @r{Run} @code{texindex}.
+C-c C-t C-p @r{Print the @sc{dvi} file.}
+C-c C-t C-q @r{Show the print queue.}
+C-c C-t C-d @r{Delete a job from the print queue.}
+C-c C-t C-k @r{Kill the current @TeX{} formatting job.}
+C-c C-t C-x @r{Quit a currently stopped @TeX{} formatting job.}
+C-c C-t C-l @r{Recenter the output buffer.}
+@end example
+
+@subheading Other Updating Commands
+
+The `other updating commands' do not have standard keybindings because
+they are rarely used.
+
+@example
+@group
+M-x texinfo-insert-node-lines
+ @r{Insert missing @code{@@node} lines in region.}
+ @r{With @kbd{C-u} as a prefix argument,}
+ @r{use section titles as node names.}
+@end group
+
+@group
+M-x texinfo-multiple-files-update
+ @r{Update a multi-file document.}
+ @r{With @kbd{C-u 2} as a prefix argument,}
+ @r{create or update all nodes and menus}
+ @r{in all included files first.}
+@end group
+
+@group
+M-x texinfo-indent-menu-description
+ @r{Indent descriptions.}
+@end group
+
+@group
+M-x texinfo-sequential-node-update
+ @r{Insert node pointers in strict sequence.}
+@end group
+@end example
+
+@node Beginning a File, Ending a File, Texinfo Mode, Top
+@comment node-name, next, previous, up
+@chapter Beginning a Texinfo File
+@cindex Beginning a Texinfo file
+@cindex Texinfo file beginning
+@cindex File beginning
+
+Certain pieces of information must be provided at the beginning of a
+Texinfo file, such as the name of the file and the title of the
+document.@refill
+
+@menu
+* Four Parts:: Four parts begin a Texinfo file.
+* Sample Beginning:: Here is a sample beginning for a Texinfo file.
+* Header:: The very beginning of a Texinfo file.
+* Info Summary and Permissions:: Summary and copying permissions for Info.
+* Titlepage & Copyright Page:: Creating the title and copyright pages.
+* The Top Node:: Creating the `Top' node and master menu.
+* Software Copying Permissions:: Ensure that you and others continue to
+ have the right to use and share software.
+@end menu
+
+@node Four Parts, Sample Beginning, Beginning a File, Beginning a File
+@ifinfo
+@heading Four Parts Begin a File
+@end ifinfo
+
+Generally, the beginning of a Texinfo file has four parts:@refill
+
+@enumerate
+@item
+The header, delimited by special comment lines, that includes the
+commands for naming the Texinfo file and telling @TeX{} what
+definitions' file to use when processing the Texinfo file.@refill
+
+@item
+A short statement of what the file is about, with a copyright notice
+and copying permissions. This is enclosed in @code{@@ifinfo} and
+@code{@@end ifinfo} commands so that the formatters place it only
+in the Info file.@refill
+
+@item
+A title page and copyright page, with a copyright notice and copying
+permissions. This is enclosed between @code{@@titlepage} and
+@code{@@end titlepage} commands. The title and copyright page appear
+only in the printed @w{manual}.@refill
+
+@item
+The `Top' node that contains a menu for the whole Info file. The
+contents of this node appear only in the Info file.@refill
+@end enumerate
+
+Also, optionally, you may include the copying conditions for a program
+and a warranty disclaimer. The copying section will be followed by an
+introduction or else by the first chapter of the manual.@refill
+
+Since the copyright notice and copying permissions for the Texinfo
+document (in contrast to the copying permissions for a program) are in
+parts that appear only in the Info file or only in the printed manual,
+this information must be given twice.@refill
+
+@node Sample Beginning, Header, Four Parts, Beginning a File
+@comment node-name, next, previous, up
+@section Sample Texinfo File Beginning
+
+The following sample shows what is needed.@refill
+
+@example
+\input texinfo @@c -*-texinfo-*-
+@@c %**start of header
+@@setfilename @var{name-of-info-file}
+@@settitle @var{name-of-manual}
+@@setchapternewpage odd
+@@c %**end of header
+
+@@ifinfo
+This file documents @dots{}
+
+Copyright @var{year} @var{copyright-owner}
+
+@group
+Permission is granted to @dots{}
+@@end ifinfo
+@end group
+
+@group
+@@c This title page illustrates only one of the
+@@c two methods of forming a title page.
+@end group
+
+@group
+@@titlepage
+@@title @var{name-of-manual-when-printed}
+@@subtitle @var{subtitle-if-any}
+@@subtitle @var{second-subtitle}
+@@author @var{author}
+@end group
+
+@group
+@@c The following two commands
+@@c start the copyright page.
+@@page
+@@vskip 0pt plus 1filll
+Copyright @@copyright@{@} @var{year} @var{copyright-owner}
+@end group
+
+Published by @dots{}
+
+Permission is granted to @dots{}
+@@end titlepage
+
+@@node Top, Overview, (dir), (dir)
+
+@@ifinfo
+This document describes @dots{}
+
+This document applies to version @dots{}
+of the program named @dots{}
+@@end ifinfo
+
+@group
+@@menu
+* Copying:: Your rights and freedoms.
+* First Chapter:: Getting started @dots{}
+* Second Chapter:: @dots{}
+ @dots{}
+ @dots{}
+@@end menu
+@end group
+
+@group
+@@node First Chapter, Second Chapter, top, top
+@@comment node-name, next, previous, up
+@@chapter First Chapter
+@@cindex Index entry for First Chapter
+@end group
+@end example
+
+@node Header, Info Summary and Permissions, Sample Beginning, Beginning a File
+@comment node-name, next, previous, up
+@section The Texinfo File Header
+@cindex Header for Texinfo files
+@cindex Texinfo file header
+
+Texinfo files start with at least three lines that provide Info and
+@TeX{} with necessary information. These are the @code{\input
+texinfo} line, the @code{@@settitle} line, and the
+@code{@@setfilename} line. If you want to run @TeX{} on just a part
+of the Texinfo File, you must write the @code{@@settitle}
+and @code{@@setfilename} lines between start-of-header and end-of-header
+lines.@refill
+
+Thus, the beginning of a Texinfo file looks like this:
+
+@example
+@group
+\input texinfo @@c -*-texinfo-*-
+@@setfilename sample.info
+@@settitle Sample Document
+@end group
+@end example
+
+@noindent
+or else like this:
+
+@example
+@group
+\input texinfo @@c -*-texinfo-*-
+@@c %**start of header
+@@setfilename sample.info
+@@settitle Sample Document
+@@c %**end of header
+@end group
+@end example
+
+@menu
+* First Line:: The first line of a Texinfo file.
+* Start of Header:: Formatting a region requires this.
+* setfilename:: Tell Info the name of the Info file.
+* settitle:: Create a title for the printed work.
+* setchapternewpage:: Start chapters on right-hand pages.
+* paragraphindent:: An option to specify paragraph indentation.
+* End of Header:: Formatting a region requires this.
+@end menu
+
+@node First Line, Start of Header, Header, Header
+@comment node-name, next, previous, up
+@subsection The First Line of a Texinfo File
+@cindex First line of a Texinfo file
+@cindex Beginning line of a Texinfo file
+@cindex Header of a Texinfo file
+
+Every Texinfo file that is to be the top-level input to @TeX{} must begin
+with a line that looks like this:@refill
+
+@example
+\input texinfo @@c -*-texinfo-*-
+@end example
+
+@noindent
+This line serves two functions:
+
+@enumerate
+@item
+When the file is processed by @TeX{}, the @code{\input texinfo} command
+tells @TeX{} to load the macros needed for processing a Texinfo file.
+These are in a file called @file{texinfo.tex}, which is usually located
+in the @file{/usr/lib/tex/macros} directory. @TeX{} uses the backslash,
+@samp{\}, to mark the beginning of a command, just as Texinfo uses
+@code{@@}. The @file{texinfo.tex} file causes the switch from @samp{\}
+to @samp{@@}; before the switch occurs, @TeX{} requires @samp{\}, which
+is why it appears at the beginning of the file.@refill
+
+@item
+When the file is edited in GNU Emacs, the @samp{-*-texinfo-*-} mode
+specification tells Emacs to use Texinfo mode.@refill
+@end enumerate
+
+@node Start of Header, setfilename, First Line, Header
+@comment node-name, next, previous, up
+@subsection Start of Header
+@cindex Start of header line
+
+Write a start-of-header line on the second line of a Texinfo file.
+Follow the start-of-header line with @code{@@setfilename} and
+@code{@@settitle} lines and, optionally, with other command lines, such
+as @code{@@smallbook} or @code{@@footnotestyle}; and then by an
+end-of-header line (@pxref{End of Header}).@refill
+
+With these lines, you can format part of a Texinfo file for Info or
+typeset part for printing.@refill
+
+A start-of-header line looks like this:@refill
+
+@example
+@@c %**start of header
+@end example
+
+The odd string of characters, @samp{%**}, is to ensure that no other
+comment is accidentally taken for a start-of-header line.@refill
+
+@node setfilename, settitle, Start of Header, Header
+@comment node-name, next, previous, up
+@subsection @code{@@setfilename}
+@cindex Info file requires @code{@@setfilename}
+@findex setfilename
+
+In order to serve as the primary input file for either @code{makeinfo}
+or @TeX{}, a Texinfo file must contain a line that looks like this:
+
+@example
+@@setfilename @var{info-file-name}
+@end example
+
+Write the @code{@@setfilename} command at the beginning of a line and
+follow it on the same line by the Info file name. Do not write
+anything else on the line; anything on the line after the command is
+considered part of the file name, including a comment.@refill
+
+The @code{@@setfilename} line specifies the name of the Info file to be
+generated. This name should be different from the name of the Texinfo
+file. There are two conventions for choosing the name: you can either
+remove the @samp{.tex} extension from the input file name, or replace it
+with the @samp{.info} extension.
+
+Some operating systems cannot handle long file names. You can run into
+a problem even when the file name you specify is itself short enough.
+This occurs because the Info formatters split a long Info file into
+short indirect subfiles, and name them by appending `-1', `-2', @dots{},
+`-10', `-11', and so on, to the original file name. (@xref{Tag and
+Split Files, , Tag Files and Split Files}.) The subfile name
+@file{texinfo.info-10}, for example, is too long for some systems; so
+the Info file name for this document is @file{texinfo} rather than
+@file{texinfo.info}.@refill
+
+The Info formatting commands ignore everything written before the
+@code{@@setfilename} line, which is why the very first line of
+the file (the @code{\input} line) does not need to be commented out.
+
+The @code{@@setfilename} line produces no output when you typeset a
+printed manual, but is does an essential job: it opens the index,
+cross-reference, and other auxiliary files used by Texinfo.
+
+@node settitle, setchapternewpage, setfilename, Header
+@comment node-name, next, previous, up
+@subsection @code{@@settitle}
+@findex settitle
+
+In order to be made into a printed manual, a Texinfo file must contain
+a line that looks like this:@refill
+
+@example
+@@settitle @var{title}
+@end example
+
+Write the @code{@@settitle} command at the beginning of a line and
+follow it on the same line by the title. This tells @TeX{} the title
+to use in a header or footer. Do not write anything else on the line;
+anything on the line after the command is considered part of the
+title, including a comment.@refill
+
+Conventionally, when @TeX{} formats a Texinfo file for double-sided
+output, the title is printed in the left-hand (even-numbered) page
+headings and the current chapter title is printed in the right-hand
+(odd-numbered) page headings. (@TeX{} learns the title of each chapter
+from each @code{@@chapter} command.) Page footers are not
+printed.@refill
+
+Even if you are printing in a single-sided style, @TeX{} looks for an
+@code{@@settitle} command line, in case you include the manual title
+in the heading. @refill
+
+The @code{@@settitle} command should precede everything that generates
+actual output in @TeX{}.@refill
+
+Although the title in the @code{@@settitle} command is usually the
+same as the title on the title page, it does not affect the title as
+it appears on the title page. Thus, the two do not need not match
+exactly; and the title in the @code{@@settitle} command can be a
+shortened or expanded version of the title as it appears on the title
+page. (@xref{titlepage, , @code{@@titlepage}}.)@refill
+
+@TeX{} prints page headings only for that text that comes after the
+@code{@@end titlepage} command in the Texinfo file, or that comes
+after an @code{@@headings} command that turns on headings.
+(@xref{headings on off, , The @code{@@headings} Command}, for more
+information.)@refill
+
+You may, if you wish, create your own, customized headings and
+footings. @xref{Headings, , Page Headings}, for a detailed discussion
+of this process.@refill
+
+@node setchapternewpage, paragraphindent, settitle, Header
+@comment node-name, next, previous, up
+@subsection @code{@@setchapternewpage}
+@cindex Starting chapters
+@cindex Pages, starting odd
+@findex setchapternewpage
+
+In a book or a manual, text is usually printed on both sides of the
+paper, chapters start on right-hand pages, and right-hand pages have
+odd numbers. But in short reports, text often is printed only on one
+side of the paper. Also in short reports, chapters sometimes do not
+start on new pages, but are printed on the same page as the end of the
+preceding chapter, after a small amount of vertical whitespace.@refill
+
+You can use the @code{@@setchapternewpage} command with various
+arguments to specify how @TeX{} should start chapters and whether it
+should typeset pages for printing on one or both sides of the paper
+(single-sided or double-sided printing).@refill
+
+Write the @code{@@setchapternewpage} command at the beginning of a
+line followed by its argument.@refill
+
+For example, you would write the following to cause each chapter to
+start on a fresh odd-numbered page:@refill
+
+@example
+@@setchapternewpage odd
+@end example
+
+You can specify one of three alternatives with the
+@code{@@setchapternewpage} command:@refill
+
+@table @asis
+@ignore
+@item No @code{@@setchapternewpage} command
+If the Texinfo file does not contain an @code{@@setchapternewpage}
+command before the @code{@@titlepage} command, @TeX{} automatically
+begins chapters on new pages and prints headings in the standard
+format for single-sided printing. This is the conventional format for
+single-sided printing.@refill
+
+The result is exactly the same as when you write
+@code{@@setchapternewpage on}.@refill
+@end ignore
+@item @code{@@setchapternewpage off}
+Cause @TeX{} to typeset a new chapter on the same page as the last
+chapter, after skipping some vertical whitespace. Also, cause @TeX{} to
+format page headers for single-sided printing. (You can override the
+headers format with the @code{@@headings double} command; see
+@ref{headings on off, , The @code{@@headings} Command}.)@refill
+
+@item @code{@@setchapternewpage on}
+Cause @TeX{} to start new chapters on new pages and to typeset page
+headers for single-sided printing. This is the form most often
+used for short reports.@refill
+
+This alternative is the default.@refill
+
+@item @code{@@setchapternewpage odd}
+Cause @TeX{} to start new chapters on new, odd-numbered pages
+(right-handed pages) and to typeset for double-sided printing. This is
+the form most often used for books and manuals.@refill
+@end table
+
+@noindent
+Texinfo does not have an @code{@@setchapternewpage even} command.@refill
+
+@noindent
+(You can countermand or modify an @code{@@setchapternewpage} command
+with an @code{@@headings} command. @xref{headings on off, , The
+@code{@@headings} Command}.)@refill
+
+At the beginning of a manual or book, pages are not numbered---for
+example, the title and copyright pages of a book are not numbered.
+By convention, table of contents pages are numbered with roman
+numerals and not in sequence with the rest of the document.@refill
+
+Since an Info file does not have pages, the @code{@@setchapternewpage}
+command has no effect on it.@refill
+
+Usually, you do not write an @code{@@setchapternewpage} command for
+single-sided printing, but accept the default which is to typeset for
+single-sided printing and to start new chapters on new pages. Usually,
+you write an @code{@@setchapternewpage odd} command for double-sided
+printing.@refill
+
+@node paragraphindent, End of Header, setchapternewpage, Header
+@comment node-name, next, previous, up
+@subsection Paragraph Indenting
+@cindex Indenting paragraphs
+@cindex Paragraph indentation
+@findex paragraphindent
+
+The Info formatting commands may insert spaces at the beginning of the
+first line of each paragraph, thereby indenting that paragraph. You
+can use the @code{@@paragraphindent} command to specify the
+indentation. Write an @code{@@paragraphindent} command at the
+beginning of a line followed by either @samp{asis} or a number. The
+template is:@refill
+
+@example
+@@paragraphindent @var{indent}
+@end example
+
+The Info formatting commands indent according to the value of
+@var{indent}:@refill
+
+@itemize @bullet
+@item
+If the value of @var{indent} is @samp{asis}, the Info formatting
+commands do not change the existing indentation.@refill
+
+@item
+If the value of @var{indent} is 0, the Info formatting commands delete
+existing indentation.@refill
+
+@item
+If the value of @var{indent} is greater than 0, the Info formatting
+commands indent the paragraph by that number of spaces.@refill
+@end itemize
+
+The default value of @var{indent} is @samp{asis}.@refill
+
+Write the @code{@@paragraphindent} command before or shortly after the
+end-of-header line at the beginning of a Texinfo file. (If you write
+the command between the start-of-header and end-of-header lines, the
+region formatting commands indent paragraphs as specified.)@refill
+
+A peculiarity of the @code{texinfo-format-buffer} and
+@code{texinfo-format-region} commands is that they do not indent (nor
+fill) paragraphs that contain @code{@@w} or @code{@@*} commands.
+@xref{Refilling Paragraphs}, for a detailed description of what goes
+on.@refill
+
+@node End of Header, , paragraphindent, Header
+@comment node-name, next, previous, up
+@subsection End of Header
+@cindex End of header line
+
+Follow the header lines with an @w{end-of-header} line.
+An end-of-header line looks like this:@refill
+
+@example
+@@c %**end of header
+@end example
+
+If you include the @code{@@setchapternewpage} command between the
+start-of-header and end-of-header lines, @TeX{} will typeset a region as
+that command specifies. Similarly, if you include an @code{@@smallbook}
+command between the start-of-header and end-of-header lines, @TeX{} will
+typeset a region in the ``small'' book format.@refill
+
+@ifinfo
+The reason for the odd string of characters (@samp{%**}) is so that the
+@code{texinfo-tex-region} command does not accidentally find
+something that it should not when it is looking for the header.@refill
+
+The start-of-header line and the end-of-header line are Texinfo mode
+variables that you can change.@refill
+@end ifinfo
+
+@iftex
+@xref{Start of Header}.
+@end iftex
+
+@node Info Summary and Permissions, Titlepage & Copyright Page, Header, Beginning a File
+@comment node-name, next, previous, up
+@section Summary and Copying Permissions for Info
+
+The title page and the copyright page appear only in the printed copy of
+the manual; therefore, the same information must be inserted in a
+section that appears only in the Info file. This section usually
+contains a brief description of the contents of the Info file, a
+copyright notice, and copying permissions.@refill
+
+The copyright notice should read:@refill
+
+@example
+Copyright @var{year} @var{copyright-owner}
+@end example
+
+@noindent
+and be put on a line by itself.@refill
+
+Standard text for the copyright permissions is contained in an appendix
+to this manual; see @ref{ifinfo Permissions, , @samp{ifinfo} Copying
+Permissions}, for the complete text.@refill
+
+The permissions text appears in an Info file @emph{before} the first
+node. This mean that a reader does @emph{not} see this text when
+reading the file using Info, except when using the advanced Info command
+@kbd{g *}.
+
+@node Titlepage & Copyright Page, The Top Node, Info Summary and Permissions, Beginning a File
+@comment node-name, next, previous, up
+@section The Title and Copyright Pages
+
+A manual's name and author are usually printed on a title page.
+Sometimes copyright information is printed on the title page as well;
+more often, copyright information is printed on the back of the title
+page.
+
+The title and copyright pages appear in the printed manual, but not in the
+Info file. Because of this, it is possible to use several slightly
+obscure @TeX{} typesetting commands that cannot be used in an Info file.
+In addition, this part of the beginning of a Texinfo file contains the text
+of the copying permissions that will appear in the printed manual.@refill
+
+@xref{Titlepage Permissions, , Titlepage Copying Permissions}, for the
+standard text for the copyright permissions.@refill
+
+@menu
+* titlepage:: Create a title for the printed document.
+* titlefont center sp:: The @code{@@titlefont}, @code{@@center},
+ and @code{@@sp} commands.
+* title subtitle author:: The @code{@@title}, @code{@@subtitle},
+ and @code{@@author} commands.
+* Copyright & Permissions:: How to write the copyright notice and
+ include copying permissions.
+* end titlepage:: Turn on page headings after the title and
+ copyright pages.
+* headings on off:: An option for turning headings on and off
+ and double or single sided printing.
+@end menu
+
+@node titlepage, titlefont center sp, Titlepage & Copyright Page, Titlepage & Copyright Page
+@comment node-name, next, previous, up
+@subsection @code{@@titlepage}
+@cindex Title page
+@findex titlepage
+
+Start the material for the title page and following copyright page
+with @code{@@titlepage} on a line by itself and end it with
+@code{@@end titlepage} on a line by itself.@refill
+
+The @code{@@end titlepage} command starts a new page and turns on page
+numbering. (@xref{Headings, , Page Headings}, for details about how to
+generate page headings.) All the material that you want to
+appear on unnumbered pages should be put between the
+@code{@@titlepage} and @code{@@end titlepage} commands. By using the
+@code{@@page} command you can force a page break within the region
+delineated by the @code{@@titlepage} and @code{@@end titlepage}
+commands and thereby create more than one unnumbered page. This is
+how the copyright page is produced. (The @code{@@titlepage} command
+might perhaps have been better named the
+@code{@@titleandadditionalpages} command, but that would have been
+rather long!)@refill
+
+@c !!! append refill to footnote when makeinfo can handle it.
+When you write a manual about a computer program, you should write the
+version of the program to which the manual applies on the title
+page. If the manual changes more frequently than the program or is
+independent of it, you should also include an edition
+number@footnote{We have found that it is helpful to refer to versions
+of manuals as `editions' and versions of programs as `versions';
+otherwise, we find we are liable to confuse each other in conversation
+by referring to both the documentation and the software with the same
+words.} for the manual. This helps readers keep track of which manual
+is for which version of the program. (The `Top' node
+should also contain this information; see @ref{makeinfo top, ,
+@code{@@top}}.)@refill
+
+Texinfo provides two main methods for creating a title page. One method
+uses the @code{@@titlefont}, @code{@@sp}, and @code{@@center} commands
+to generate a title page in which the words on the page are
+centered.@refill
+
+The second method uses the @code{@@title}, @code{@@subtitle}, and
+@code{@@author} commands to create a title page with black rules under
+the title and author lines and the subtitle text set flush to the
+right hand side of the page. With this method, you do not specify any
+of the actual formatting of the title page. You specify the text
+you want, and Texinfo does the formatting. You may use either
+method.@refill
+
+@findex shorttitlepage
+For extremely simple applications, Texinfo also provides a command
+@code{@@shorttitlepage} which takes a single argument as the title.
+The argument is typeset on a page by itself and followed by a blank
+page.
+
+
+@node titlefont center sp, title subtitle author, titlepage, Titlepage & Copyright Page
+@comment node-name, next, previous, up
+@subsection @code{@@titlefont}, @code{@@center}, and @code{@@sp}
+@findex titlefont
+@findex center
+@findex sp @r{(titlepage line spacing)}
+
+You can use the @code{@@titlefont}, @code{@@sp}, and @code{@@center}
+commands to create a title page for a printed document. (This is the
+first of the two methods for creating a title page in Texinfo.)@refill
+
+Use the @code{@@titlefont} command to select a large font suitable for
+the title itself.@refill
+
+@need 700
+For example:
+
+@example
+@@titlefont@{Texinfo@}
+@end example
+
+Use the @code{@@center} command at the beginning of a line to center
+the remaining text on that line. Thus,@refill
+
+@example
+@@center @@titlefont@{Texinfo@}
+@end example
+
+@noindent
+centers the title, which in this example is ``Texinfo'' printed
+in the title font.@refill
+
+Use the @code{@@sp} command to insert vertical space. For example:@refill
+
+@example
+@@sp 2
+@end example
+
+@noindent
+This inserts two blank lines on the printed page. (@xref{sp, ,
+@code{@@sp}}, for more information about the @code{@@sp}
+command.)@refill
+
+A template for this method looks like this:@refill
+
+@example
+@group
+@@titlepage
+@@sp 10
+@@center @@titlefont@{@var{name-of-manual-when-printed}@}
+@@sp 2
+@@center @var{subtitle-if-any}
+@@sp 2
+@@center @var{author}
+@dots{}
+@@end titlepage
+@end group
+@end example
+
+The spacing of the example fits an 8 1/2 by 11 inch manual.@refill
+
+@node title subtitle author, Copyright & Permissions, titlefont center sp, Titlepage & Copyright Page
+@comment node-name, next, previous, up
+@subsection @code{@@title}, @code{@@subtitle}, and @code{@@author}
+@findex title
+@findex subtitle
+@findex author
+
+You can use the @code{@@title}, @code{@@subtitle}, and @code{@@author}
+commands to create a title page in which the vertical and horizontal
+spacing is done for you automatically. This contrasts with the method
+described in
+the previous section, in which the @code{@@sp} command is needed to
+adjust vertical spacing.@refill
+
+Write the @code{@@title}, @code{@@subtitle}, or @code{@@author}
+commands at the beginning of a line followed by the title, subtitle,
+or author.@refill
+
+The @code{@@title} command produces a line in which the title is set
+flush to the left-hand side of the page in a larger than normal font.
+The title is underlined with a black rule.@refill
+
+The @code{@@subtitle} command sets subtitles in a normal-sized font
+flush to the right-hand side of the page.@refill
+
+The @code{@@author} command sets the names of the author or authors in
+a middle-sized font flush to the left-hand side of the page on a line
+near the bottom of the title page. The names are underlined with a
+black rule that is thinner than the rule that underlines the title.
+(The black rule only occurs if the @code{@@author} command line is
+followed by an @code{@@page} command line.)@refill
+
+There are two ways to use the @code{@@author} command: you can write
+the name or names on the remaining part of the line that starts with
+an @code{@@author} command:@refill
+
+@example
+@@author by Jane Smith and John Doe
+@end example
+
+@noindent
+or you can write the names one above each other by using two (or more)
+@code{@@author} commands:@refill
+
+@example
+@group
+@@author Jane Smith
+@@author John Doe
+@end group
+@end example
+
+@noindent
+(Only the bottom name is underlined with a black rule.)@refill
+
+@need 950
+A template for this method looks like this:@refill
+
+@example
+@group
+@@titlepage
+@@title @var{name-of-manual-when-printed}
+@@subtitle @var{subtitle-if-any}
+@@subtitle @var{second-subtitle}
+@@author @var{author}
+@@page
+@dots{}
+@@end titlepage
+@end group
+@end example
+
+@ifinfo
+@noindent
+Contrast this form with the form of a title page written using the
+@code{@@sp}, @code{@@center}, and @code{@@titlefont} commands:@refill
+
+@example
+@@titlepage
+@@sp 10
+@@center @@titlefont@{Name of Manual When Printed@}
+@@sp 2
+@@center Subtitle, If Any
+@@sp 1
+@@center Second subtitle
+@@sp 2
+@@center Author
+@@page
+@dots{}
+@@end titlepage
+@end example
+@end ifinfo
+
+@node Copyright & Permissions, end titlepage, title subtitle author, Titlepage & Copyright Page
+@comment node-name, next, previous, up
+@subsection Copyright Page and Permissions
+@cindex Copyright page
+@cindex Printed permissions
+@cindex Permissions, printed
+
+By international treaty, the copyright notice for a book should be
+either on the title page or on the back of the title page. The
+copyright notice should include the year followed by the name of the
+organization or person who owns the copyright.@refill
+
+When the copyright notice is on the back of the title page, that page
+is customarily not numbered. Therefore, in Texinfo, the information
+on the copyright page should be within @code{@@titlepage} and
+@code{@@end titlepage} commands.@refill
+
+@findex vskip
+@findex filll
+@cindex Vertical whitespace (@samp{vskip})
+Use the @code{@@page} command to cause a page break. To push the
+copyright notice and the other text on the copyright page towards the
+bottom of the page, you can write a somewhat mysterious line after the
+@code{@@page} command that reads like this:@refill
+
+@example
+@@vskip 0pt plus 1filll
+@end example
+
+@noindent
+This is a @TeX{} command that is not supported by the Info formatting
+commands. The @code{@@vskip} command inserts whitespace. The
+@samp{0pt plus 1filll} means to put in zero points of mandatory whitespace,
+and as much optional whitespace as needed to push the
+following text to the bottom of the page. Note the use of three
+@samp{l}s in the word @samp{filll}; this is the correct usage in
+@TeX{}.@refill
+
+@findex copyright
+In a printed manual, the @code{@@copyright@{@}} command generates a
+@samp{c} inside a circle. (In Info, it generates @samp{(C)}.) The
+copyright notice itself has the following legally defined sequence:@refill
+
+@example
+Copyright @copyright{} @var{year} @var{copyright-owner}
+@end example
+
+It is customary to put information on how to get a manual after the
+copyright notice, followed by the copying permissions for the
+manual.@refill
+
+Note that permissions must be given here as well as in the summary
+segment within @code{@@ifinfo} and @code{@@end ifinfo} that
+immediately follows the header since this text appears only in the
+printed manual and the @samp{ifinfo} text appears only in the Info
+file.@refill
+
+@xref{Sample Permissions}, for the standard text.@refill
+
+@node end titlepage, headings on off, Copyright & Permissions, Titlepage & Copyright Page
+@comment node-name, next, previous, up
+@subsection Heading Generation
+@findex end titlepage
+@cindex Headings, page, begin to appear
+@cindex Titlepage end starts headings
+@cindex End titlepage starts headings
+
+An @code{@@end titlepage} command on a line by itself not only marks
+the end of the title and copyright pages, but also causes @TeX{} to start
+generating page headings and page numbers.
+
+To repeat what is said elsewhere, Texinfo has two standard page heading
+formats, one for documents which are printed on one side of each sheet of paper
+(single-sided printing), and the other for documents which are printed on both
+sides of each sheet (double-sided printing).
+(@xref{setchapternewpage, ,@code{@@setchapternewpage}}.)
+You can specify these formats in different ways:@refill
+
+@itemize @bullet
+@item
+The conventional way is to write an @code{@@setchapternewpage} command
+before the title page commands, and then have the @code{@@end
+titlepage} command start generating page headings in the manner desired.
+(@xref{setchapternewpage, , @code{@@setchapternewpage}}.)@refill
+
+@item
+Alternatively, you can use the @code{@@headings} command to prevent page
+headings from being generated or to start them for either single or
+double-sided printing. (Write an @code{@@headings} command immediately
+after the @code{@@end titlepage} command. @xref{headings on off, , The
+@code{@@headings} Command}, for more information.)@refill
+
+@item
+Or, you may specify your own page heading and footing format.
+@xref{Headings, , Page Headings}, for detailed
+information about page headings and footings.@refill
+@end itemize
+
+Most documents are formatted with the standard single-sided or
+double-sided format, using @code{@@setchapternewpage odd} for
+double-sided printing and no @code{@@setchapternewpage} command for
+single-sided printing.@refill
+
+@node headings on off, , end titlepage, Titlepage & Copyright Page
+@comment node-name, next, previous, up
+@subsection The @code{@@headings} Command
+@findex headings
+
+The @code{@@headings} command is rarely used. It specifies what kind of
+page headings and footings to print on each page. Usually, this is
+controlled by the @code{@@setchapternewpage} command. You need the
+@code{@@headings} command only if the @code{@@setchapternewpage} command
+does not do what you want, or if you want to turn off pre-defined page
+headings prior to defining your own. Write an @code{@@headings} command
+immediately after the @code{@@end titlepage} command.@refill
+
+You can use @code{@@headings} as follows:@refill
+
+@table @code
+@item @@headings off
+Turn off printing of page headings.@refill
+
+@item @@headings single
+Turn on page headings appropriate for single-sided printing.
+@refill
+
+@item @@headings double
+Turn on page headings appropriate for double-sided printing. The two
+commands, @code{@@headings on} and @code{@@headings double}, are
+synonymous.@refill
+
+@item @@headings singleafter
+@itemx @@headings doubleafter
+Turn on @code{single} or @code{double} headings, respectively, after the
+current page is output.
+
+@item @@headings on
+Turn on page headings: @code{single} if @samp{@@setchapternewpage
+on}, @code{double} otherwise.
+@end table
+
+For example, suppose you write @code{@@setchapternewpage off} before the
+@code{@@titlepage} command to tell @TeX{} to start a new chapter on the
+same page as the end of the last chapter. This command also causes
+@TeX{} to typeset page headers for single-sided printing. To cause
+@TeX{} to typeset for double sided printing, write @code{@@headings
+double} after the @code{@@end titlepage} command.
+
+You can stop @TeX{} from generating any page headings at all by
+writing @code{@@headings off} on a line of its own immediately after the
+line containing the @code{@@end titlepage} command, like this:@refill
+
+@example
+@@end titlepage
+@@headings off
+@end example
+
+@noindent
+The @code{@@headings off} command overrides the @code{@@end titlepage}
+command, which would otherwise cause @TeX{} to print page
+headings.@refill
+
+You can also specify your own style of page heading and footing.
+@xref{Headings, , Page Headings}, for more information.@refill
+
+@node The Top Node, Software Copying Permissions, Titlepage & Copyright Page, Beginning a File
+@comment node-name, next, previous, up
+@section The `Top' Node and Master Menu
+@cindex @samp{@r{Top}} node
+@cindex Master menu
+@cindex Node, `Top'
+
+The `Top' node is the node from which you enter an Info file.@refill
+
+A `Top' node should contain a brief description of the Info file and an
+extensive, master menu for the whole Info file.
+This helps the reader understand what the Info file is
+about. Also, you should write the version number of the program to
+which the Info file applies; or, at least, the edition number.@refill
+
+The contents of the `Top' node should appear only in the Info file; none
+of it should appear in printed output, so enclose it between
+@code{@@ifinfo} and @code{@@end ifinfo} commands. (@TeX{} does not
+print either an @code{@@node} line or a menu; they appear only in Info;
+strictly speaking, you are not required to enclose these parts between
+@code{@@ifinfo} and @code{@@end ifinfo}, but it is simplest to do so.
+@xref{Conditionals, , Conditionally Visible Text}.)@refill
+
+@menu
+* Title of Top Node:: Sketch what the file is about.
+* Master Menu Parts:: A master menu has three or more parts.
+@end menu
+
+@node Title of Top Node, Master Menu Parts, The Top Node, The Top Node
+@ifinfo
+@subheading `Top' Node Title
+@end ifinfo
+
+Sometimes, you will want to place an @code{@@top} sectioning command
+line containing the title of the document immediately after the
+@code{@@node Top} line (@pxref{makeinfo top command, , The @code{@@top}
+Sectioning Command}, for more information).@refill
+
+For example, the beginning of the Top node of this manual contains an
+@code{@@top} sectioning command, a short description, and edition and
+version information. It looks like this:@refill
+
+@example
+@group
+@dots{}
+@@end titlepage
+
+@@ifinfo
+@@node Top, Copying, (dir), (dir)
+@@top Texinfo
+
+Texinfo is a documentation system@dots{}
+@end group
+
+@group
+This is edition@dots{}
+@dots{}
+@@end ifinfo
+@end group
+
+@group
+@@menu
+* Copying:: Texinfo is freely
+ redistributable.
+* Overview:: What is Texinfo?
+@dots{}
+@end group
+@@end menu
+@end example
+
+In a `Top' node, the `Previous', and `Up' nodes usually refer to the top
+level directory of the whole Info system, which is called @samp{(dir)}.
+The `Next' node refers to the first node that follows the main or master
+menu, which is usually the copying permissions, introduction, or first
+chapter.@refill
+
+@node Master Menu Parts, , Title of Top Node, The Top Node
+@subsection Parts of a Master Menu
+@cindex Master menu parts
+@cindex Parts of a master menu
+
+A @dfn{master menu} is a detailed main menu listing all the nodes in a
+file.
+
+A master menu is enclosed in @code{@@menu} and @code{@@end menu}
+commands and does not appear in the printed document.@refill
+
+Generally, a master menu is divided into parts.@refill
+
+@itemize @bullet
+@item
+The first part contains the major nodes in the Texinfo file: the nodes
+for the chapters, chapter-like sections, and the appendices.@refill
+
+@item
+The second part contains nodes for the indices.@refill
+
+@item
+The third and subsequent parts contain a listing of the other, lower
+level nodes, often ordered by chapter. This way, rather than go
+through an intermediary menu, an inquirer can go directly to a
+particular node when searching for specific information. These menu
+items are not required; add them if you think they are a
+convenience. If you do use them, put @code{@@detailmenu} before the
+first one, and @code{@@end detailmenu} after the last; otherwise,
+@code{makeinfo} will get confused.
+@end itemize
+
+Each section in the menu can be introduced by a descriptive line. So
+long as the line does not begin with an asterisk, it will not be
+treated as a menu entry. (@xref{Writing a Menu}, for more
+information.)@refill
+
+For example, the master menu for this manual looks like the following
+(but has many more entries):@refill
+
+@example
+@group
+@@menu
+* Copying:: Texinfo is freely
+ redistributable.
+* Overview:: What is Texinfo?
+* Texinfo Mode:: Special features in GNU Emacs.
+@dots{}
+@dots{}
+@end group
+@group
+* Command and Variable Index::
+ An entry for each @@-command.
+* Concept Index:: An entry for each concept.
+@end group
+
+@group
+@@detailmenu
+ --- The Detailed Node Listing ---
+
+Overview of Texinfo
+
+* Info Files:: What is an Info file?
+* Printed Manuals:: Characteristics of
+ a printed manual.
+@dots{}
+@dots{}
+@end group
+
+@group
+Using Texinfo Mode
+
+* Info on a Region:: Formatting part of a file
+ for Info.
+@dots{}
+@dots{}
+@@end detailmenu
+@@end menu
+@end group
+@end example
+
+@node Software Copying Permissions, , The Top Node, Beginning a File
+@comment node-name, next, previous, up
+@section Software Copying Permissions
+@cindex Software copying permissions
+@cindex Copying software
+@cindex Distribution
+@cindex License agreement
+
+If the Texinfo file has a section containing the ``General Public
+License'' and the distribution information and a warranty disclaimer
+for the software that is documented, this section usually follows the
+`Top' node. The General Public License is very important to Project
+GNU software. It ensures that you and others will continue to have a
+right to use and share the software.@refill
+
+The copying and distribution information and the disclaimer are
+followed by an introduction or else by the first chapter of the
+manual.@refill
+
+@cindex Introduction, as part of file
+Although an introduction is not a required part of a Texinfo file, it
+is very helpful. Ideally, it should state clearly and concisely what
+the file is about and who would be interested in reading it. In
+general, an introduction would follow the licensing and distribution
+information, although sometimes people put it earlier in the document.
+Usually, an introduction is put in an @code{@@unnumbered} section.
+(@xref{unnumbered & appendix, , The @code{@@unnumbered} and
+@code{@@appendix} Commands}.)@refill
+
+@node Ending a File, Structuring, Beginning a File, Top
+@comment node-name, next, previous, up
+@chapter Ending a Texinfo File
+@cindex Ending a Texinfo file
+@cindex Texinfo file ending
+@cindex File ending
+@findex bye
+
+The end of a Texinfo file should include the commands that create
+indices and generate detailed and summary tables of contents.
+And it must include the @code{@@bye} command that marks the last line
+processed by @TeX{}.@refill
+
+@need 700
+For example:
+
+@example
+@@node Concept Index, , Variables Index, Top
+@@c node-name, next, previous, up
+@@unnumbered Concept Index
+
+@@printindex cp
+
+@@contents
+@@bye
+@end example
+
+@menu
+* Printing Indices & Menus:: How to print an index in hardcopy and
+ generate index menus in Info.
+* Contents:: How to create a table of contents.
+* File End:: How to mark the end of a file.
+@end menu
+
+@node Printing Indices & Menus, Contents, Ending a File, Ending a File
+@comment node-name, next, previous, up
+@section Index Menus and Printing an Index
+@findex printindex
+@cindex Printing an index
+@cindex Indices, printing and menus
+@cindex Generating menus with indices
+@cindex Menus generated with indices
+
+To print an index means to include it as part of a manual or Info
+file. This does not happen automatically just because you use
+@code{@@cindex} or other index-entry generating commands in the
+Texinfo file; those just cause the raw data for the index to be
+accumulated. To generate an index, you must include the
+@code{@@printindex} command at the place in the document where you
+want the index to appear. Also, as part of the process of creating a
+printed manual, you must run a program called @code{texindex}
+(@pxref{Format/Print Hardcopy}) to sort the raw data to produce a sorted
+index file. The sorted index file is what is actually used to
+print the index.@refill
+
+Texinfo offers six different types of predefined index: the concept
+index, the function index, the variables index, the keystroke index, the
+program index, and the data type index (@pxref{Predefined Indices}). Each
+index type has a two-letter name: @samp{cp}, @samp{fn}, @samp{vr},
+@samp{ky}, @samp{pg}, and @samp{tp}. You may merge indices, or put them
+into separate sections (@pxref{Combining Indices}); or you may define
+your own indices (@pxref{New Indices, , Defining New Indices}).@refill
+
+The @code{@@printindex} command takes a two-letter index name, reads
+the corresponding sorted index file and formats it appropriately into
+an index.@refill
+
+@ignore
+The two-letter index names are:
+
+@table @samp
+@item cp
+concept index
+@item fn
+function index
+@item vr
+variable index
+@item ky
+key index
+@item pg
+program index
+@item tp
+data type index
+@end table
+@end ignore
+The @code{@@printindex} command does not generate a chapter heading
+for the index. Consequently, you should precede the
+@code{@@printindex} command with a suitable section or chapter command
+(usually @code{@@unnumbered}) to supply the chapter heading and put
+the index into the table of contents. Precede the @code{@@unnumbered}
+command with an @code{@@node} line.@refill
+
+@need 1200
+For example:
+
+@smallexample
+@group
+@@node Variable Index, Concept Index, Function Index, Top
+@@comment node-name, next, previous, up
+@@unnumbered Variable Index
+
+@@printindex vr
+@end group
+
+@group
+@@node Concept Index, , Variable Index, Top
+@@comment node-name, next, previous, up
+@@unnumbered Concept Index
+
+@@printindex cp
+@end group
+
+@group
+@@summarycontents
+@@contents
+@@bye
+@end group
+@end smallexample
+
+@noindent
+(Readers often prefer that the concept index come last in a book,
+since that makes it easiest to find.)@refill
+
+@ignore
+In @TeX{}, the @code{@@printindex} command needs a sorted index file
+to work from. @TeX{} does not know how to do sorting; this is a
+deficiency. @TeX{} writes output files of raw index data; use the
+@code{texindex} program to convert these files to sorted index files.
+(@xref{Format/Print Hardcopy}, for more information.)@refill
+@end ignore
+@node Contents, File End, Printing Indices & Menus, Ending a File
+@comment node-name, next, previous, up
+@section Generating a Table of Contents
+@cindex Table of contents
+@cindex Contents, Table of
+@findex contents
+@findex summarycontents
+@findex shortcontents
+
+The @code{@@chapter}, @code{@@section}, and other structuring commands
+supply the information to make up a table of contents, but they do not
+cause an actual table to appear in the manual. To do this, you must
+use the @code{@@contents} and @code{@@summarycontents}
+commands:@refill
+
+@table @code
+@item @@contents
+Generate a table of contents in a printed manual, including all
+chapters, sections, subsections, etc., as well as appendices and
+unnumbered chapters. (Headings generated by the @code{@@heading}
+series of commands do not appear in the table of contents.) The
+@code{@@contents} command should be written on a line by
+itself.@refill
+
+@item @@shortcontents
+@itemx @@summarycontents
+(@code{@@summarycontents} is a synonym for @code{@@shortcontents}; the
+two commands are exactly the same.)@refill
+
+Generate a short or summary table of contents that lists only the
+chapters (and appendices and unnumbered chapters). Omit sections, subsections
+and subsubsections. Only a long manual needs a short table
+of contents in addition to the full table of contents.@refill
+
+Write the @code{@@shortcontents} command on a line by itself right
+@emph{before} the @code{@@contents} command.@refill
+@end table
+
+The table of contents commands automatically generate a chapter-like
+heading at the top of the first table of contents page. Write the table
+of contents commands at the very end of a Texinfo file, just before the
+@code{@@bye} command, following any index sections---anything in the
+Texinfo file after the table of contents commands will be omitted from
+the table of contents.@refill
+
+When you print a manual with a table of contents, the table of
+contents are printed last and numbered with roman numerals. You need
+to place those pages in their proper place, after the title page,
+yourself. (This is the only collating you need to do for a printed
+manual. The table of contents is printed last because it is generated
+after the rest of the manual is typeset.)@refill
+
+@need 700
+Here is an example of where to write table of contents commands:@refill
+
+@example
+@group
+@var{indices}@dots{}
+@@shortcontents
+@@contents
+@@bye
+@end group
+@end example
+
+Since an Info file uses menus instead of tables of contents, the Info
+formatting commands ignore the @code{@@contents} and
+@code{@@shortcontents} commands.@refill
+
+@node File End, , Contents, Ending a File
+@comment node-name, next, previous, up
+@section @code{@@bye} File Ending
+@findex bye
+
+An @code{@@bye} command terminates @TeX{} or Info formatting. None of
+the formatting commands see any of the file following @code{@@bye}.
+The @code{@@bye} command should be on a line by itself.@refill
+
+If you wish, you may follow the @code{@@bye} line with notes. These notes
+will not be formatted and will not appear in either Info or a printed
+manual; it is as if text after @code{@@bye} were within @code{@@ignore}
+@dots{} @code{@@end ignore}. Also, you may follow the @code{@@bye} line
+with a local variables list. @xref{Compile-Command, , Using Local
+Variables and the Compile Command}, for more information.@refill
+
+@node Structuring, Nodes, Ending a File, Top
+@comment node-name, next, previous, up
+@chapter Chapter Structuring
+@cindex Chapter structuring
+@cindex Structuring of chapters
+
+The @dfn{chapter structuring} commands divide a document into a hierarchy of
+chapters, sections, subsections, and subsubsections. These commands
+generate large headings; they also provide information for the table
+of contents of a printed manual (@pxref{Contents, , Generating a Table
+of Contents}).@refill
+
+The chapter structuring commands do not create an Info node structure,
+so normally you should put an @code{@@node} command immediately before
+each chapter structuring command (@pxref{Nodes}). The only time you
+are likely to use the chapter structuring commands without using the
+node structuring commands is if you are writing a document that
+contains no cross references and will never be transformed into Info
+format.@refill
+
+It is unlikely that you will ever write a Texinfo file that is
+intended only as an Info file and not as a printable document. If you
+do, you might still use chapter structuring commands to create a
+heading at the top of each node---but you don't need to.@refill
+
+@menu
+* Tree Structuring:: A manual is like an upside down tree @dots{}
+* Structuring Command Types:: How to divide a manual into parts.
+* makeinfo top:: The @code{@@top} command, part of the `Top' node.
+* chapter::
+* unnumbered & appendix::
+* majorheading & chapheading::
+* section::
+* unnumberedsec appendixsec heading::
+* subsection::
+* unnumberedsubsec appendixsubsec subheading::
+* subsubsection:: Commands for the lowest level sections.
+* Raise/lower sections:: How to change commands' hierarchical level.
+@end menu
+
+@node Tree Structuring, Structuring Command Types, Structuring, Structuring
+@comment node-name, next, previous, up
+@section Tree Structure of Sections
+@cindex Tree structuring
+
+A Texinfo file is usually structured like a book with chapters,
+sections, subsections, and the like. This structure can be visualized
+as a tree (or rather as an upside-down tree) with the root at the top
+and the levels corresponding to chapters, sections, subsection, and
+subsubsections.@refill
+
+Here is a diagram that shows a Texinfo file with three chapters,
+each of which has two sections.@refill
+
+@example
+@group
+ Top
+ |
+ -------------------------------------
+ | | |
+ Chapter 1 Chapter 2 Chapter 3
+ | | |
+ -------- -------- --------
+ | | | | | |
+ Section Section Section Section Section Section
+ 1.1 1.2 2.1 2.2 3.1 3.2
+
+@end group
+@end example
+
+In a Texinfo file that has this structure, the beginning of Chapter 2
+looks like this:@refill
+
+@example
+@group
+@@node Chapter 2, Chapter 3, Chapter 1, top
+@@chapter Chapter 2
+@end group
+@end example
+
+The chapter structuring commands are described in the sections that
+follow; the @code{@@node} and @code{@@menu} commands are described in
+following chapters. (@xref{Nodes}, and see @ref{Menus}.)@refill
+
+@node Structuring Command Types, makeinfo top, Tree Structuring, Structuring
+@comment node-name, next, previous, up
+@section Types of Structuring Command
+
+The chapter structuring commands fall into four groups or series, each
+of which contains structuring commands corresponding to the
+hierarchical levels of chapters, sections, subsections, and
+subsubsections.@refill
+
+The four groups are the @code{@@chapter} series, the
+@code{@@unnumbered} series, the @code{@@appendix} series, and the
+@code{@@heading} series.@refill
+
+Each command produces titles that have a different appearance on the
+printed page or Info file; only some of the commands produce
+titles that are listed in the table of contents of a printed book or
+manual.@refill
+
+@itemize @bullet
+@item
+The @code{@@chapter} and @code{@@appendix} series of commands produce
+numbered or lettered entries both in the body of a printed work and in
+its table of contents.@refill
+
+@item
+The @code{@@unnumbered} series of commands produce unnumbered entries
+both in the body of a printed work and in its table of contents. The
+@code{@@top} command, which has a special use, is a member of this
+series (@pxref{makeinfo top, , @code{@@top}}).@refill
+
+@item
+The @code{@@heading} series of commands produce unnumbered headings
+that do not appear in a table of contents. The heading commands never
+start a new page.@refill
+
+@item
+The @code{@@majorheading} command produces results similar to using
+the @code{@@chapheading} command but generates a larger vertical
+whitespace before the heading.@refill
+
+@item
+When an @code{@@setchapternewpage} command says to do so, the
+@code{@@chapter}, @code{@@unnumbered}, and @code{@@appendix} commands
+start new pages in the printed manual; the @code{@@heading} commands
+do not.@refill
+@end itemize
+
+@need 1000
+Here are the four groups of chapter structuring commands:@refill
+
+@c Slightly different formatting for regular sized books and smallbooks.
+@ifset smallbook
+@sp 1
+@tex
+{\let\rm=\indrm \let\tt=\indtt
+\halign{\hskip\itemindent#\hfil& \hskip.5em#\hfil& \hskip.5em#\hfil&
+\hskip.5em#\hfil\cr
+
+& & & \rm No new pages\cr
+\rm Numbered& \rm Unnumbered& \rm Lettered and numbered& \rm Unnumbered\cr
+\rm In contents& \rm In contents& \rm In contents& \rm Not in contents\cr
+
+& & & \cr
+ & \tt @@top& & \tt @@majorheading\cr
+\tt @@chapter& \tt @@unnumbered& \tt @@appendix& \tt @@chapheading\cr
+\tt @@section& \tt @@unnumberedsec& \tt @@appendixsec& \tt @@heading\cr
+\tt @@subsection&\tt @@unnumberedsubsec&\tt @@appendixsubsec&
+\tt @@subheading\cr
+\tt @@subsubsection& \tt @@unnumberedsubsubsec& \tt @@appendixsubsubsec&
+\tt @@subsubheading\cr}}
+@end tex
+@end ifset
+@ifclear smallbook
+@sp 1
+@tex
+\vbox{
+\halign{\hskip\itemindent\hskip.5em#\hfil& \hskip.5em#\hfil&
+\hskip.5em#\hfil& \hskip.5em #\hfil\cr
+
+& & & \cr
+& & & \rm No new pages\cr
+\rm Numbered& \rm Unnumbered& \rm Lettered and numbered& \rm Unnumbered\cr
+\rm In contents& \rm In contents& \rm In contents& \rm Not in contents\cr
+
+& & & \cr
+ & \tt @@top& & \tt @@majorheading\cr
+\tt @@chapter& \tt @@unnumbered& \tt @@appendix& \tt @@chapheading\cr
+\tt @@section& \tt @@unnumberedsec& \tt @@appendixsec& \tt @@heading\cr
+\tt @@subsection&\tt @@unnumberedsubsec&\tt @@appendixsubsec&
+\tt @@subheading\cr
+\tt @@subsubsection& \tt @@unnumberedsubsubsec& \tt @@appendixsubsubsec&
+\tt @@subsubheading\cr}}
+@end tex
+@end ifclear
+@ifinfo
+@example
+@group
+ @r{No new pages}
+@r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered}
+@r{In contents} @r{In contents} @r{In contents} @r{Not in contents}
+
+ @@top @@majorheading
+@@chapter @@unnumbered @@appendix @@chapheading
+@@section @@unnumberedsec @@appendixsec @@heading
+@@subsection @@unnumberedsubsec @@appendixsubsec @@subheading
+@@subsubsection @@unnumberedsubsubsec @@appendixsubsubsec @@subsubheading
+@end group
+@end example
+@end ifinfo
+
+@c Cannot line up columns properly inside of an example because of roman
+@c proportional fonts.
+@ignore
+@ifset smallbook
+@iftex
+@smallexample
+@group
+ @r{No new pages}
+@r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered}
+@r{In contents} @r{In contents} @r{In contents} @r{Not in contents}
+
+ @@top @@majorheading
+@@chapter @@unnumbered @@appendix @@chapheading
+@@section @@unnumberedsec @@appendixsec @@heading
+@@subsection @@unnumberedsubsec @@appendixsubsec @@subheading
+@@subsubsection @@unnumberedsubsubsec @@appendixsubsubsec @@subsubheading
+@end group
+@end smallexample
+@end iftex
+@end ifset
+@ifclear smallbook
+@iftex
+@smallexample
+@group
+ @r{No new pages}
+@r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered}
+@r{In contents} @r{In contents} @r{In contents} @r{Not in contents}
+
+ @@top @@majorheading
+@@chapter @@unnumbered @@appendix @@chapheading
+@@section @@unnumberedsec @@appendixsec @@heading
+@@subsection @@unnumberedsubsec @@appendixsubsec @@subheading
+@@subsubsection @@unnumberedsubsubsec @@appendixsubsubsec @@subsubheading
+@end group
+@end smallexample
+@end iftex
+@end ignore
+
+@node makeinfo top, chapter, Structuring Command Types, Structuring
+@comment node-name, next, previous, up
+@section @code{@@top}
+
+The @code{@@top} command is a special sectioning command that you use
+only after an @code{@@node Top} line at the beginning of a Texinfo file.
+The @code{@@top} command tells the @code{makeinfo} formatter
+which node is the `Top'
+node. It has the same typesetting effect as @code{@@unnumbered}
+(@pxref{unnumbered & appendix, , @code{@@unnumbered}, @code{@@appendix}}).
+For detailed information, see
+@ref{makeinfo top command, , The @code{@@top} Command}.@refill
+
+@node chapter, unnumbered & appendix, makeinfo top, Structuring
+@comment node-name, next, previous, up
+@section @code{@@chapter}
+@findex chapter
+
+@code{@@chapter} identifies a chapter in the document. Write the
+command at the beginning of a line and follow it on the same line by
+the title of the chapter.@refill
+
+For example, this chapter in this manual is entitled ``Chapter
+Structuring''; the @code{@@chapter} line looks like this:@refill
+
+@example
+@@chapter Chapter Structuring
+@end example
+
+In @TeX{}, the @code{@@chapter} command creates a chapter in the
+document, specifying the chapter title. The chapter is numbered
+automatically.@refill
+
+In Info, the @code{@@chapter} command causes the title to appear on a
+line by itself, with a line of asterisks inserted underneath. Thus,
+in Info, the above example produces the following output:@refill
+
+@example
+Chapter Structuring
+*******************
+@end example
+
+@findex centerchap
+Texinfo also provides a command @code{@@centerchap}, which is analogous
+to @code{@@unnumbered}, but centers its argument in the printed output.
+This kind of stylistic choice is not usually offered by Texinfo.
+@c but the Hacker's Dictionary wanted it ...
+
+
+@node unnumbered & appendix, majorheading & chapheading, chapter, Structuring
+@comment node-name, next, previous, up
+@section @code{@@unnumbered}, @code{@@appendix}
+@findex unnumbered
+@findex appendix
+
+Use the @code{@@unnumbered} command to create a chapter that appears
+in a printed manual without chapter numbers of any kind. Use the
+@code{@@appendix} command to create an appendix in a printed manual
+that is labelled by letter instead of by number.@refill
+
+For Info file output, the @code{@@unnumbered} and @code{@@appendix}
+commands are equivalent to @code{@@chapter}: the title is printed on a
+line by itself with a line of asterisks underneath. (@xref{chapter, ,
+@code{@@chapter}}.)@refill
+
+To create an appendix or an unnumbered chapter, write an
+@code{@@appendix} or @code{@@unnumbered} command at the beginning of a
+line and follow it on the same line by the title, as you would if you
+were creating a chapter.@refill
+
+
+@node majorheading & chapheading, section, unnumbered & appendix, Structuring
+@section @code{@@majorheading}, @code{@@chapheading}
+@findex majorheading
+@findex chapheading
+
+The @code{@@majorheading} and @code{@@chapheading} commands put
+chapter-like headings in the body of a document.@refill
+
+However, neither command causes @TeX{} to produce a numbered heading
+or an entry in the table of contents; and neither command causes
+@TeX{} to start a new page in a printed manual.@refill
+
+In @TeX{}, an @code{@@majorheading} command generates a larger vertical
+whitespace before the heading than an @code{@@chapheading} command but
+is otherwise the same.@refill
+
+In Info,
+the @code{@@majorheading} and
+@code{@@chapheading} commands are equivalent to
+@code{@@chapter}: the title is printed on a line by itself with a line
+of asterisks underneath. (@xref{chapter, , @code{@@chapter}}.)@refill
+
+@node section, unnumberedsec appendixsec heading, majorheading & chapheading, Structuring
+@comment node-name, next, previous, up
+@section @code{@@section}
+@findex section
+
+In a printed manual, an @code{@@section} command identifies a
+numbered section within a chapter. The section title appears in the
+table of contents. In Info, an @code{@@section} command provides a
+title for a segment of text, underlined with @samp{=}.@refill
+
+This section is headed with an @code{@@section} command and looks like
+this in the Texinfo file:@refill
+
+@example
+@@section @@code@{@@@@section@}
+@end example
+
+To create a section, write the @code{@@section} command at the
+beginning of a line and follow it on the same line by the section
+title.@refill
+
+Thus,
+
+@example
+@@section This is a section
+@end example
+
+@noindent
+produces
+
+@example
+@group
+This is a section
+=================
+@end group
+@end example
+
+@noindent
+in Info.
+
+@node unnumberedsec appendixsec heading, subsection, section, Structuring
+@comment node-name, next, previous, up
+@section @code{@@unnumberedsec}, @code{@@appendixsec}, @code{@@heading}
+@findex unnumberedsec
+@findex appendixsec
+@findex heading
+
+The @code{@@unnumberedsec}, @code{@@appendixsec}, and @code{@@heading}
+commands are, respectively, the unnumbered, appendix-like, and
+heading-like equivalents of the @code{@@section} command.
+(@xref{section, , @code{@@section}}.)@refill
+
+@table @code
+@item @@unnumberedsec
+The @code{@@unnumberedsec} command may be used within an
+unnumbered chapter or within a regular chapter or appendix to
+provide an unnumbered section.@refill
+
+@item @@appendixsec
+@itemx @@appendixsection
+@code{@@appendixsection} is a longer spelling of the
+@code{@@appendixsec} command; the two are synonymous.@refill
+@findex appendixsection
+
+Conventionally, the @code{@@appendixsec} or @code{@@appendixsection}
+command is used only within appendices.@refill
+
+@item @@heading
+You may use the @code{@@heading} command anywhere you wish for a
+section-style heading that will not appear in the table of contents.@refill
+@end table
+
+@node subsection, unnumberedsubsec appendixsubsec subheading, unnumberedsec appendixsec heading, Structuring
+@comment node-name, next, previous, up
+@section The @code{@@subsection} Command
+@findex subsection
+
+Subsections are to sections as sections are to chapters.
+(@xref{section, , @code{@@section}}.) In Info, subsection titles are
+underlined with @samp{-}. For example,@refill
+
+@example
+@@subsection This is a subsection
+@end example
+
+@noindent
+produces
+
+@example
+@group
+This is a subsection
+--------------------
+@end group
+@end example
+
+In a printed manual, subsections are listed in the table of contents
+and are numbered three levels deep.@refill
+
+@node unnumberedsubsec appendixsubsec subheading, subsubsection, subsection, Structuring
+@comment node-name, next, previous, up
+@section The @code{@@subsection}-like Commands
+@cindex Subsection-like commands
+@findex unnumberedsubsec
+@findex appendixsubsec
+@findex subheading
+
+The @code{@@unnumberedsubsec}, @code{@@appendixsubsec}, and
+@code{@@subheading} commands are, respectively, the unnumbered,
+appendix-like, and heading-like equivalents of the @code{@@subsection}
+command. (@xref{subsection, , @code{@@subsection}}.)@refill
+
+In Info, the @code{@@subsection}-like commands generate a title
+underlined with hyphens. In a printed manual, an @code{@@subheading}
+command produces a heading like that of a subsection except that it is
+not numbered and does not appear in the table of contents. Similarly,
+an @code{@@unnumberedsubsec} command produces an unnumbered heading like
+that of a subsection and an @code{@@appendixsubsec} command produces a
+subsection-like heading labelled with a letter and numbers; both of
+these commands produce headings that appear in the table of
+contents.@refill
+
+@node subsubsection, Raise/lower sections, unnumberedsubsec appendixsubsec subheading, Structuring
+@comment node-name, next, previous, up
+@section The `subsub' Commands
+@cindex Subsub commands
+@findex subsubsection
+@findex unnumberedsubsubsec
+@findex appendixsubsubsec
+@findex subsubheading
+
+The fourth and lowest level sectioning commands in Texinfo are the
+`subsub' commands. They are:@refill
+
+@table @code
+@item @@subsubsection
+Subsubsections are to subsections as subsections are to sections.
+(@xref{subsection, , @code{@@subsection}}.) In a printed manual,
+subsubsection titles appear in the table of contents and are numbered
+four levels deep.@refill
+
+@item @@unnumberedsubsubsec
+Unnumbered subsubsection titles appear in the table of contents of a
+printed manual, but lack numbers. Otherwise, unnumbered
+subsubsections are the same as subsubsections. In Info, unnumbered
+subsubsections look exactly like ordinary subsubsections.@refill
+
+@item @@appendixsubsubsec
+Conventionally, appendix commands are used only for appendices and are
+lettered and numbered appropriately in a printed manual. They also
+appear in the table of contents. In Info, appendix subsubsections look
+exactly like ordinary subsubsections.@refill
+
+@item @@subsubheading
+The @code{@@subsubheading} command may be used anywhere that you need
+a small heading that will not appear in the table of contents. In
+Info, subsubheadings look exactly like ordinary subsubsection
+headings.@refill
+@end table
+
+In Info, `subsub' titles are underlined with periods.
+For example,@refill
+
+@example
+@@subsubsection This is a subsubsection
+@end example
+
+@noindent
+produces
+
+@example
+@group
+This is a subsubsection
+.......................
+@end group
+@end example
+
+@node Raise/lower sections, , subsubsection, Structuring
+@comment node-name, next, previous, up
+@section @code{@@raisesections} and @code{@@lowersections}
+@findex raisesections
+@findex lowersections
+@cindex Raising and lowering sections
+@cindex Sections, raising and lowering
+
+The @code{@@raisesections} and @code{@@lowersections} commands raise and
+lower the hierarchical level of chapters, sections, subsections and the
+like. The @code{@@raisesections} command changes sections to chapters,
+subsections to sections, and so on. The @code{@@lowersections} command
+changes chapters to sections, sections to subsections, and so on.
+
+An @code{@@lowersections} command is useful if you wish to include text
+that is written as an outer or standalone Texinfo file in another
+Texinfo file as an inner, included file. If you write the command at
+the beginning of the file, all your @code{@@chapter} commands are
+formatted as if they were @code{@@section} commands, all your
+@code{@@section} command are formatted as if they were
+@code{@@subsection} commands, and so on.
+
+@need 1000
+@code{@@raisesections} raises a command one level in the chapter
+structuring hierarchy:@refill
+
+@example
+@group
+ @r{Change} @r{To}
+
+@@subsection @@section,
+@@section @@chapter,
+@@heading @@chapheading,
+ @r{etc.}
+@end group
+@end example
+
+@need 1000
+@code{@@lowersections} lowers a command one level in the chapter
+structuring hierarchy:@refill
+
+@example
+@group
+ @r{Change} @r{To}
+
+@@chapter @@section,
+@@subsection @@subsubsection,
+@@heading @@subheading,
+ @r{etc.}
+@end group
+@end example
+
+An @code{@@raisesections} or @code{@@lowersections} command changes only
+those structuring commands that follow the command in the Texinfo file.
+Write an @code{@@raisesections} or @code{@@lowersections} command on a
+line of its own.
+
+An @code{@@lowersections} command cancels an @code{@@raisesections}
+command, and vice versa.
+
+Repeated use of the commands continue to raise or lower the hierarchical
+level a step at a time.
+
+An attempt to raise above `chapters' reproduces chapter commands; an
+attempt to lower below `subsubsections' reproduces subsubsection
+commands.
+
+@node Nodes, Menus, Structuring, Top
+@comment node-name, next, previous, up
+@chapter Nodes
+
+@dfn{Nodes} are the primary segments of a Texinfo file. They do not
+themselves impose a hierarchic or any other kind of structure on a file.
+Nodes contain @dfn{node pointers} that name other nodes, and can contain
+@dfn{menus} which are lists of nodes. In Info, the movement commands
+can carry you to a pointed-to node or to a node listed in a menu. Node
+pointers and menus provide structure for Info files just as chapters,
+sections, subsections, and the like, provide structure for printed
+books.@refill
+
+@menu
+* Two Paths:: Different commands to structure
+ Info output and printed output.
+* Node Menu Illustration:: A diagram, and sample nodes and menus.
+* node:: How to write a node, in detail.
+* makeinfo Pointer Creation:: How to create node pointers with @code{makeinfo}.
+@end menu
+
+@node Two Paths, Node Menu Illustration, Nodes, Nodes
+@ifinfo
+@heading Two Paths
+@end ifinfo
+
+The node and menu commands and the chapter structuring commands are
+independent of each other:
+
+@itemize @bullet
+@item
+In Info, node and menu commands provide structure. The chapter
+structuring commands generate headings with different kinds of
+underlining---asterisks for chapters, hyphens for sections, and so on;
+they do nothing else.@refill
+
+@item
+In @TeX{}, the chapter structuring commands generate chapter and section
+numbers and tables of contents. The node and menu commands provide
+information for cross references; they do nothing else.@refill
+@end itemize
+
+You can use node pointers and menus to structure an Info file any way
+you want; and you can write a Texinfo file so that its Info output has a
+different structure than its printed output. However, most Texinfo
+files are written such that the structure for the Info output
+corresponds to the structure for the printed output. It is not
+convenient to do otherwise.@refill
+
+Generally, printed output is structured in a tree-like hierarchy in
+which the chapters are the major limbs from which the sections branch
+out. Similarly, node pointers and menus are organized to create a
+matching structure in the Info output.@refill
+
+@node Node Menu Illustration, node, Two Paths, Nodes
+@comment node-name, next, previous, up
+@section Node and Menu Illustration
+
+Here is a copy of the diagram shown earlier that illustrates a Texinfo
+file with three chapters, each of which contains two sections.@refill
+
+Note that the ``root'' is at the top of the diagram and the ``leaves''
+are at the bottom. This is how such a diagram is drawn conventionally;
+it illustrates an upside-down tree. For this reason, the root node is
+called the `Top' node, and `Up' node pointers carry you closer to the
+root.@refill
+
+@example
+@group
+ Top
+ |
+ -------------------------------------
+ | | |
+ Chapter 1 Chapter 2 Chapter 3
+ | | |
+ -------- -------- --------
+ | | | | | |
+ Section Section Section Section Section Section
+ 1.1 1.2 2.1 2.2 3.1 3.2
+
+@end group
+@end example
+
+Write the beginning of the node for Chapter 2 like this:@refill
+
+@example
+@group
+@@node Chapter 2, Chapter 3, Chapter 1, top
+@@comment node-name, next, previous, up
+@end group
+@end example
+
+@noindent
+This @code{@@node} line says that the name of this node is ``Chapter 2'', the
+name of the `Next' node is ``Chapter 3'', the name of the `Previous'
+node is ``Chapter 1'', and the name of the `Up' node is ``Top''.
+
+@quotation
+@strong{Please Note:} `Next' refers to the next node at the same
+hierarchical level in the manual, not necessarily to the next node
+within the Texinfo file. In the Texinfo file, the subsequent node may
+be at a lower level---a section-level node may follow a chapter-level
+node, and a subsection-level node may follow a section-level node.
+`Next' and `Previous' refer to nodes at the @emph{same} hierarchical
+level. (The `Top' node contains the exception to this rule. Since the
+`Top' node is the only node at that level, `Next' refers to the first
+following node, which is almost always a chapter or chapter-level
+node.)@refill
+@end quotation
+
+To go to Sections 2.1 and 2.2 using Info, you need a menu inside Chapter
+2. (@xref{Menus}.) You would write the menu just
+before the beginning of Section 2.1, like this:@refill
+
+@example
+@group
+ @@menu
+ * Sect. 2.1:: Description of this section.
+ * Sect. 2.2::
+ @@end menu
+@end group
+@end example
+
+Write the node for Sect. 2.1 like this:@refill
+
+@example
+@group
+ @@node Sect. 2.1, Sect. 2.2, Chapter 2, Chapter 2
+ @@comment node-name, next, previous, up
+@end group
+@end example
+
+In Info format, the `Next' and `Previous' pointers of a node usually
+lead to other nodes at the same level---from chapter to chapter or from
+section to section (sometimes, as shown, the `Previous' pointer points
+up); an `Up' pointer usually leads to a node at the level above (closer
+to the `Top' node); and a `Menu' leads to nodes at a level below (closer
+to `leaves'). (A cross reference can point to a node at any level;
+see @ref{Cross References}.)@refill
+
+Usually, an @code{@@node} command and a chapter structuring command are
+used in sequence, along with indexing commands. (You may follow the
+@code{@@node} line with a comment line that reminds you which pointer is
+which.)@refill
+
+Here is the beginning of the chapter in this manual called ``Ending a
+Texinfo File''. This shows an @code{@@node} line followed by a comment
+line, an @code{@@chapter} line, and then by indexing lines.@refill
+
+@example
+@group
+@@node Ending a File, Structuring, Beginning a File, Top
+@@comment node-name, next, previous, up
+@@chapter Ending a Texinfo File
+@@cindex Ending a Texinfo file
+@@cindex Texinfo file ending
+@@cindex File ending
+@end group
+@end example
+
+@node node, makeinfo Pointer Creation, Node Menu Illustration, Nodes
+@comment node-name, next, previous, up
+@section The @code{@@node} Command
+
+@cindex Node, defined
+A @dfn{node} is a segment of text that begins at an @code{@@node}
+command and continues until the next @code{@@node} command. The
+definition of node is different from that for chapter or section. A
+chapter may contain sections and a section may contain subsections;
+but a node cannot contain subnodes; the text of a node continues only
+until the next @code{@@node} command in the file. A node usually
+contains only one chapter structuring command, the one that follows
+the @code{@@node} line. On the other hand, in printed output nodes
+are used only for cross references, so a chapter or section may
+contain any number of nodes. Indeed, a chapter usually contains
+several nodes, one for each section, subsection, and
+subsubsection.@refill
+
+To create a node, write an @code{@@node} command at the beginning of a
+line, and follow it with four arguments, separated by commas, on the
+rest of the same line. These arguments are the name of the node, and
+the names of the `Next', `Previous', and `Up' pointers, in that order.
+You may insert spaces before each pointer if you wish; the spaces are
+ignored. You must write the name of the node, and the names of the
+`Next', `Previous', and `Up' pointers, all on the same line. Otherwise,
+the formatters fail. (@inforef{Top, info, info}, for more information
+about nodes in Info.)@refill
+
+Usually, you write one of the chapter-structuring command lines
+immediately after an @code{@@node} line---for example, an
+@code{@@section} or @code{@@subsection} line. (@xref{Structuring
+Command Types, , Types of Structuring Command}.)@refill
+
+@quotation
+@strong{Please note:} The GNU Emacs Texinfo mode updating commands work
+only with Texinfo files in which @code{@@node} lines are followed by chapter
+structuring lines. @xref{Updating Requirements}.@refill
+@end quotation
+
+@TeX{} uses @code{@@node} lines to identify the names to use for cross
+references. For this reason, you must write @code{@@node} lines in a
+Texinfo file that you intend to format for printing, even if you do not
+intend to format it for Info. (Cross references, such as the one at the
+end of this sentence, are made with @code{@@xref} and its related
+commands; see @ref{Cross References}.)@refill
+
+@menu
+* Node Names:: How to choose node and pointer names.
+* Writing a Node:: How to write an @code{@@node} line.
+* Node Line Tips:: Keep names short.
+* Node Line Requirements:: Keep names unique, without @@-commands.
+* First Node:: How to write a `Top' node.
+* makeinfo top command:: How to use the @code{@@top} command.
+* Top Node Summary:: Write a brief description for readers.
+@end menu
+
+@node Node Names, Writing a Node, node, node
+@ifinfo
+@subheading Choosing Node and Pointer Names
+@end ifinfo
+
+The name of a node identifies the node. The pointers enable
+you to reach other nodes and consist of the names of those nodes.@refill
+
+Normally, a node's `Up' pointer contains the name of the node whose menu
+mentions that node. The node's `Next' pointer contains the name of the
+node that follows that node in that menu and its `Previous' pointer
+contains the name of the node that precedes it in that menu. When a
+node's `Previous' node is the same as its `Up' node, both node pointers
+name the same node.@refill
+
+Usually, the first node of a Texinfo file is the `Top' node, and its
+`Up' and `Previous' pointers point to the @file{dir} file, which
+contains the main menu for all of Info.@refill
+
+The `Top' node itself contains the main or master menu for the manual.
+Also, it is helpful to include a brief description of the manual in the
+`Top' node. @xref{First Node}, for information on how to write the
+first node of a Texinfo file.@refill
+
+@node Writing a Node, Node Line Tips, Node Names, node
+@comment node-name, next, previous, up
+@subsection How to Write an @code{@@node} Line
+@cindex Writing an @code{@@node} line
+@cindex @code{@@node} line writing
+@cindex Node line writing
+
+The easiest way to write an @code{@@node} line is to write @code{@@node}
+at the beginning of a line and then the name of the node, like
+this:@refill
+
+@example
+@@node @var{node-name}
+@end example
+
+If you are using GNU Emacs, you can use the update node commands
+provided by Texinfo mode to insert the names of the pointers; or you
+can leave the pointers out of the Texinfo file and let @code{makeinfo}
+insert node pointers into the Info file it creates. (@xref{Texinfo
+Mode}, and @ref{makeinfo Pointer Creation}.)@refill
+
+Alternatively, you can insert the `Next', `Previous', and `Up'
+pointers yourself. If you do this, you may find it helpful to use the
+Texinfo mode keyboard command @kbd{C-c C-c n}. This command inserts
+@samp{@@node} and a comment line listing the names of the pointers in
+their proper order. The comment line helps you keep track of which
+arguments are for which pointers. This comment line is especially useful
+if you are not familiar with Texinfo.@refill
+
+The template for a node line with `Next', `Previous', and `Up' pointers
+looks like this:@refill
+
+@example
+@@node @var{node-name}, @var{next}, @var{previous}, @var{up}
+@end example
+
+If you wish, you can ignore @code{@@node} lines altogether in your first
+draft and then use the @code{texinfo-insert-node-lines} command to
+create @code{@@node} lines for you. However, we do not
+recommend this practice. It is better to name the node itself
+at the same time that you
+write a segment so you can easily make cross references. A large number
+of cross references are an especially important feature of a good Info
+file.@refill
+
+After you have inserted an @code{@@node} line, you should immediately
+write an @@-command for the chapter or section and insert its name.
+Next (and this is important!), put in several index entries. Usually,
+you will find at least two and often as many as four or five ways of
+referring to the node in the index. Use them all. This will make it
+much easier for people to find the node.@refill
+
+@node Node Line Tips, Node Line Requirements, Writing a Node, node
+@comment node-name, next, previous, up
+@subsection @code{@@node} Line Tips
+
+Here are three suggestions:
+
+@itemize @bullet
+@item
+Try to pick node names that are informative but short.@refill
+
+In the Info file, the file name, node name, and pointer names are all
+inserted on one line, which may run into the right edge of the window.
+(This does not cause a problem with Info, but is ugly.)@refill
+
+@item
+Try to pick node names that differ from each other near the beginnings
+of their names. This way, it is easy to use automatic name completion in
+Info.@refill
+
+@item
+By convention, node names are capitalized just as they would be for
+section or chapter titles---initial and significant words are
+capitalized; others are not.@refill
+@end itemize
+
+@node Node Line Requirements, First Node, Node Line Tips, node
+@comment node-name, next, previous, up
+@subsection @code{@@node} Line Requirements
+
+@cindex Node line requirements
+Here are several requirements for @code{@@node} lines:
+
+@itemize @bullet
+@cindex Unique nodename requirement
+@cindex Nodename must be unique
+@item
+All the node names for a single Info file must be unique.@refill
+
+Duplicates confuse the Info movement commands. This means, for
+example, that if you end every chapter with a summary, you must name
+each summary node differently. You cannot just call each one
+``Summary''. You may, however, duplicate the titles of chapters, sections,
+and the like. Thus you can end each chapter in a book with a section
+called ``Summary'', so long as the node names for those sections are all
+different.@refill
+
+@item
+A pointer name must be the name of a node.@refill
+
+The node to which a pointer points may come before or after the
+node containing the pointer.@refill
+
+@cindex @@-command in nodename
+@cindex Nodename, cannot contain
+@item
+You cannot use any of the Texinfo @@-commands in a node name;
+@w{@@-commands} confuse Info.@refill
+
+@need 750
+Thus, the beginning of the section called @code{@@chapter} looks like
+this:@refill
+
+@smallexample
+@group
+@@node chapter, unnumbered & appendix, makeinfo top, Structuring
+@@comment node-name, next, previous, up
+@@section @@code@{@@@@chapter@}
+@@findex chapter
+@end group
+@end smallexample
+
+@cindex Comma in nodename
+@cindex Colon in nodename
+@cindex Apostrophe in nodename
+@item
+You cannot use commas, colons, or apostrophes within a node name; these
+confuse @TeX{} or the Info formatters.@refill
+
+@need 700
+For example, the following is a section title:
+
+@smallexample
+@@code@{@@@@unnumberedsec@}, @@code@{@@@@appendixsec@}, @@code@{@@@@heading@}
+@end smallexample
+
+@noindent
+The corresponding node name is:
+
+@smallexample
+unnumberedsec appendixsec heading
+@end smallexample
+
+@cindex Case in nodename
+@item
+Case is significant.
+@end itemize
+
+@node First Node, makeinfo top command, Node Line Requirements, node
+@comment node-name, next, previous, up
+@subsection The First Node
+@cindex @samp{@r{Top}} node is first
+@cindex First node
+
+The first node of a Texinfo file is the `Top' node, except in an
+included file (@pxref{Include Files}).
+
+The `Top' node (which must be named @samp{top} or @samp{Top}) should
+have as its `Up' and `Previous' nodes the name of a node in another
+file, where there is a menu that leads to this file. Specify the file
+name in parentheses. If the file is to be installed directly in the
+Info directory file, use @samp{(dir)} as the parent of the `Top' node;
+this is short for @samp{(dir)top}, and specifies the `Top' node in the
+@file{dir} file, which contains the main menu for Info. For example,
+the @code{@@node Top} line of this manual looks like this:@refill
+
+@example
+@@node Top, Overview, (dir), (dir)
+@end example
+
+@noindent
+(You may use the Texinfo updating commands or the @code{makeinfo}
+utility to insert these `Next' and @samp{(dir)} pointers
+automatically.)@refill
+
+@xref{Install an Info File}, for more information about installing
+an Info file in the @file{info} directory.@refill
+
+The `Top' node contains the main or master menu for the document.
+
+@node makeinfo top command, Top Node Summary, First Node, node
+@comment node-name, next, previous, up
+@subsection The @code{@@top} Sectioning Command
+@findex top @r{(@@-command)}
+
+A special sectioning command, @code{@@top}, has been created for use
+with the @code{@@node Top} line. The @code{@@top} sectioning command tells
+@code{makeinfo} that it marks the `Top' node in the file. It provides
+the information that @code{makeinfo} needs to insert node
+pointers automatically. Write the @code{@@top} command at the
+beginning of the line immediately following the @code{@@node Top}
+line. Write the title on the remaining part of the same line as the
+@code{@@top} command.@refill
+
+In Info, the @code{@@top} sectioning command causes the title to appear on a
+line by itself, with a line of asterisks inserted underneath.@refill
+
+In @TeX{} and @code{texinfo-format-buffer}, the @code{@@top}
+sectioning command is merely a synonym for @code{@@unnumbered}.
+Neither of these formatters require an @code{@@top} command, and do
+nothing special with it. You can use @code{@@chapter} or
+@code{@@unnumbered} after the @code{@@node Top} line when you use
+these formatters. Also, you can use @code{@@chapter} or
+@code{@@unnumbered} when you use the Texinfo updating commands to
+create or update pointers and menus.@refill
+
+@node Top Node Summary, , makeinfo top command, node
+@subsection The `Top' Node Summary
+@cindex @samp{@r{Top}} node summary
+
+You can help readers by writing a summary in the `Top' node, after the
+@code{@@top} line, before the main or master menu. The summary should
+briefly describe the document. In Info, this summary will appear just
+before the master menu. In a printed manual, this summary will appear
+on a page of its own.@refill
+
+If you do not want the summary to appear on a page of its own in a
+printed manual, you can enclose the whole of the `Top' node, including
+the @code{@@node Top} line and the @code{@@top} sectioning command line
+or other sectioning command line between @code{@@ifinfo} and @code{@@end
+ifinfo}. This prevents any of the text from appearing in the printed
+output. (@pxref{Conditionals, , Conditionally Visible Text}). You can
+repeat the brief description from the `Top' node within @code{@@iftex}
+@dots{} @code{@@end iftex} at the beginning of the first chapter, for
+those who read the printed manual. This saves paper and may look
+neater.@refill
+
+You should write the version number of the program to which the manual
+applies in the summary. This helps the reader keep track of which
+manual is for which version of the program. If the manual changes more
+frequently than the program or is independent of it, you should also
+include an edition number for the manual. (The title page should also
+contain this information: see @ref{titlepage, ,
+@code{@@titlepage}}.)@refill
+
+@node makeinfo Pointer Creation, , node, Nodes
+@section Creating Pointers with @code{makeinfo}
+@cindex Creating pointers with @code{makeinfo}
+@cindex Pointer creation with @code{makeinfo}
+@cindex Automatic pointer creation with @code{makeinfo}
+
+The @code{makeinfo} program has a feature for automatically creating
+node pointers for a hierarchically organized file that lacks
+them.@refill
+
+When you take advantage of this feature, you do not need to write the
+`Next', `Previous', and `Up' pointers after the name of a node.
+However, you must write a sectioning command, such as @code{@@chapter}
+or @code{@@section}, on the line immediately following each truncated
+@code{@@node} line. You cannot write a comment line after a node
+line; the section line must follow it immediately.@refill
+
+In addition, you must follow the `Top' @code{@@node} line with a line beginning
+with @code{@@top} to mark the `Top' node in the file. @xref{makeinfo
+top, , @code{@@top}}.
+
+Finally, you must write the name of each node (except for the `Top'
+node) in a menu that is one or more hierarchical levels above the
+node's hierarchical level.@refill
+
+This node pointer insertion feature in @code{makeinfo} is an
+alternative to the menu and pointer creation and update commands in
+Texinfo mode. (@xref{Updating Nodes and Menus}.) It is especially
+helpful to people who do not use GNU Emacs for writing Texinfo
+documents.@refill
+
+@node Menus, Cross References, Nodes, Top
+@comment node-name, next, previous, up
+@chapter Menus
+@cindex Menus
+@findex menu
+
+@dfn{Menus} contain pointers to subordinate
+nodes.@footnote{Menus can carry you to any node, regardless
+of the hierarchical structure; even to nodes in a different
+Info file. However, the GNU Emacs Texinfo mode updating
+commands work only to create menus of subordinate nodes.
+Conventionally, cross references are used to refer to other
+nodes.} In Info, you use menus to go to such nodes. Menus
+have no effect in printed manuals and do not appear in
+them.@refill
+
+By convention, a menu is put at the end of a node since a reader who
+uses the menu may not see text that follows it.@refill
+
+@ifinfo
+A node that has a menu should @emph{not} contain much text. If you
+have a lot of text and a menu, move most of the text into a new
+subnode---all but a few lines.@refill
+@end ifinfo
+@iftex
+@emph{A node that has a menu should not contain much text.} If you
+have a lot of text and a menu, move most of the text into a new
+subnode---all but a few lines. Otherwise, a reader with a terminal
+that displays only a few lines may miss the menu and its associated
+text. As a practical matter, you should locate a menu within 20 lines
+of the beginning of the node.@refill
+@end iftex
+
+@menu
+* Menu Location:: Put a menu in a short node.
+* Writing a Menu:: What is a menu?
+* Menu Parts:: A menu entry has three parts.
+* Less Cluttered Menu Entry:: Two part menu entry.
+* Menu Example:: Two and three part menu entries.
+* Other Info Files:: How to refer to a different Info file.
+@end menu
+
+@node Menu Location, Writing a Menu, Menus, Menus
+@ifinfo
+@heading Menus Need Short Nodes
+@end ifinfo
+@cindex Menu location
+@cindex Location of menus
+@cindex Nodes for menus are short
+@cindex Short nodes for menus
+
+@ifinfo
+A reader can easily see a menu that is close to the beginning of the
+node. The node should be short. As a practical matter, you should
+locate a menu within 20 lines of the beginning of the node.
+Otherwise, a reader with a terminal that displays only a few lines may
+miss the menu and its associated text.@refill
+@end ifinfo
+
+The short text before a menu may look awkward in a printed manual. To
+avoid this, you can write a menu near the beginning of its node and
+follow the menu by an @code{@@node} line, and then an @code{@@heading}
+line located within @code{@@ifinfo} and @code{@@end ifinfo}. This way,
+the menu, @code{@@node} line, and title appear only in the Info file,
+not the printed document.@refill
+
+For example, the preceding two paragraphs follow an Info-only menu,
+@code{@@node} line, and heading, and look like this:@refill
+
+@example
+@group
+@@menu
+* Menu Location:: Put a menu in a short node.
+* Writing a Menu:: What is a menu?
+* Menu Parts:: A menu entry has three parts.
+* Less Cluttered Menu Entry:: Two part menu entry.
+* Menu Example:: Two and three part entries.
+* Other Info Files:: How to refer to a different
+ Info file.
+@@end menu
+
+@@node Menu Location, Writing a Menu, , Menus
+@@ifinfo
+@@heading Menus Need Short Nodes
+@@end ifinfo
+@end group
+@end example
+
+The Texinfo file for this document contains more than a dozen
+examples of this procedure. One is at the beginning of this chapter;
+another is at the beginning of the ``Cross References'' chapter.@refill
+
+@node Writing a Menu, Menu Parts, Menu Location, Menus
+@section Writing a Menu
+@cindex Writing a menu
+@cindex Menu writing
+
+A menu consists of an @code{@@menu} command on a line by
+itself followed by menu entry lines or menu comment lines
+and then by an @code{@@end menu} command on a line by
+itself.@refill
+
+A menu looks like this:@refill
+
+@example
+@group
+@@menu
+Larger Units of Text
+
+* Files:: All about handling files.
+* Multiples: Buffers. Multiple buffers; editing
+ several files at once.
+@@end menu
+@end group
+@end example
+
+In a menu, every line that begins with an @w{@samp{* }} is a
+@dfn{menu entry}. (Note the space after the asterisk.) A
+line that does not start with an @w{@samp{* }} may also
+appear in a menu. Such a line is not a menu entry but is a
+menu comment line that appears in the Info file. In
+the example above, the line @samp{Larger Units of Text} is a
+menu comment line; the two lines starting with @w{@samp{* }}
+are menu entries.
+
+@node Menu Parts, Less Cluttered Menu Entry, Writing a Menu, Menus
+@section The Parts of a Menu
+@cindex Parts of a menu
+@cindex Menu parts
+@cindex @code{@@menu} parts
+
+A menu entry has three parts, only the second of which is
+required:@refill
+
+@enumerate
+@item
+The menu entry name.
+
+@item
+The name of the node (required).
+
+@item
+A description of the item.
+@end enumerate
+
+The template for a menu entry looks like this:@refill
+
+@example
+* @var{menu-entry-name}: @var{node-name}. @var{description}
+@end example
+
+Follow the menu entry name with a single colon and follow the node name
+with tab, comma, period, or newline.@refill
+
+In Info, a user selects a node with the @kbd{m} (@code{Info-menu})
+command. The menu entry name is what the user types after the @kbd{m}
+command.@refill
+
+The third part of a menu entry is a descriptive phrase or
+sentence. Menu entry names and node names are often short; the
+description explains to the reader what the node is about. The
+description, which is optional, can spread over two or more lines. A
+useful description complements the node name rather than repeats
+it.@refill
+
+@node Less Cluttered Menu Entry, Menu Example, Menu Parts, Menus
+@comment node-name, next, previous, up
+@section Less Cluttered Menu Entry
+@cindex Two part menu entry
+@cindex Double-colon menu entries
+@cindex Menu entries with two colons
+@cindex Less cluttered menu entry
+@cindex Uncluttered menu entry
+
+When the menu entry name and node name are the same, you can write
+the name immediately after the asterisk and space at the beginning of
+the line and follow the name with two colons.@refill
+
+@need 800
+For example, write
+
+@example
+* Name:: @var{description}
+@end example
+
+@need 800
+@noindent
+instead of
+
+@example
+* Name: Name. @var{description}
+@end example
+
+You should use the node name for the menu entry name whenever possible,
+since it reduces visual clutter in the menu.@refill
+
+@node Menu Example, Other Info Files, Less Cluttered Menu Entry, Menus
+@comment node-name, next, previous, up
+@section A Menu Example
+@cindex Menu example
+@cindex Example menu
+
+A menu looks like this in Texinfo:@refill
+
+@example
+@group
+@@menu
+* menu entry name: Node name. A short description.
+* Node name:: This form is preferred.
+@@end menu
+@end group
+@end example
+
+@need 800
+@noindent
+This produces:
+
+@example
+@group
+* menu:
+
+* menu entry name: Node name. A short description.
+* Node name:: This form is preferred.
+@end group
+@end example
+
+@need 700
+Here is an example as you might see it in a Texinfo file:@refill
+
+@example
+@group
+@@menu
+Larger Units of Text
+
+* Files:: All about handling files.
+* Multiples: Buffers. Multiple buffers; editing
+ several files at once.
+@@end menu
+@end group
+@end example
+
+@need 800
+@noindent
+This produces:
+
+@example
+@group
+* menu:
+Larger Units of Text
+
+* Files:: All about handling files.
+* Multiples: Buffers. Multiple buffers; editing
+ several files at once.
+@end group
+@end example
+
+In this example, the menu has two entries. @samp{Files} is both a menu
+entry name and the name of the node referred to by that name.
+@samp{Multiples} is the menu entry name; it refers to the node named
+@samp{Buffers}. The line @samp{Larger Units of Text} is a comment; it
+appears in the menu, but is not an entry.@refill
+
+Since no file name is specified with either @samp{Files} or
+@samp{Buffers}, they must be the names of nodes in the same Info file
+(@pxref{Other Info Files, , Referring to Other Info Files}).@refill
+
+@node Other Info Files, , Menu Example, Menus
+@comment node-name, next, previous, up
+@section Referring to Other Info Files
+@cindex Referring to other Info files
+@cindex Nodes in other Info files
+@cindex Other Info files' nodes
+@cindex Going to other Info files' nodes
+@cindex Info; other files' nodes
+
+You can create a menu entry that enables a reader in Info to go to a
+node in another Info file by writing the file name in parentheses just
+before the node name. In this case, you should use the three-part menu
+entry format, which saves the reader from having to type the file
+name.@refill
+
+@need 800
+The format looks like this:@refill
+
+@example
+@group
+@@menu
+* @var{first-entry-name}:(@var{filename})@var{nodename}. @var{description}
+* @var{second-entry-name}:(@var{filename})@var{second-node}. @var{description}
+@@end menu
+@end group
+@end example
+
+For example, to refer directly to the @samp{Outlining} and
+@samp{Rebinding} nodes in the @cite{Emacs Manual}, you would write a
+menu like this:@refill
+
+@example
+@group
+@@menu
+* Outlining: (emacs)Outline Mode. The major mode for
+ editing outlines.
+* Rebinding: (emacs)Rebinding. How to redefine the
+ meaning of a key.
+@@end menu
+@end group
+@end example
+
+If you do not list the node name, but only name the file, then Info
+presumes that you are referring to the `Top' node.@refill
+
+The @file{dir} file that contains the main menu for Info has menu
+entries that list only file names. These take you directly to the `Top'
+nodes of each Info document. (@xref{Install an Info File}.)@refill
+
+@need 700
+For example:
+
+@example
+@group
+* Info: (info). Documentation browsing system.
+* Emacs: (emacs). The extensible, self-documenting
+ text editor.
+@end group
+@end example
+
+@noindent
+(The @file{dir} top level directory for the Info system is an Info file,
+not a Texinfo file, but a menu entry looks the same in both types of
+file.)@refill
+
+Note that the GNU Emacs Texinfo mode menu updating commands only work
+with nodes within the current buffer, so you cannot use them to create
+menus that refer to other files. You must write such menus by hand.@refill
+
+@node Cross References, Marking Text, Menus, Top
+@comment node-name, next, previous, up
+@chapter Cross References
+@cindex Making cross references
+@cindex Cross references
+@cindex References
+
+@dfn{Cross references} are used to refer the reader to other parts of the
+same or different Texinfo files. In Texinfo, nodes are the
+places to which cross references can refer.@refill
+
+@menu
+* References:: What cross references are for.
+* Cross Reference Commands:: A summary of the different commands.
+* Cross Reference Parts:: A cross reference has several parts.
+* xref:: Begin a reference with `See' @dots{}
+* Top Node Naming:: How to refer to the beginning of another file.
+* ref:: A reference for the last part of a sentence.
+* pxref:: How to write a parenthetical cross reference.
+* inforef:: How to refer to an Info-only file.
+@end menu
+
+@node References, Cross Reference Commands, Cross References, Cross References
+@ifinfo
+@heading What References Are For
+@end ifinfo
+
+Often, but not always, a printed document should be designed so that
+it can be read sequentially. People tire of flipping back and forth
+to find information that should be presented to them as they need
+it.@refill
+
+However, in any document, some information will be too detailed for
+the current context, or incidental to it; use cross references to
+provide access to such information. Also, an on-line help system or a
+reference manual is not like a novel; few read such documents in
+sequence from beginning to end. Instead, people look up what they
+need. For this reason, such creations should contain many cross
+references to help readers find other information that they may not
+have read.@refill
+
+In a printed manual, a cross reference results in a page reference,
+unless it is to another manual altogether, in which case the cross
+reference names that manual.@refill
+
+In Info, a cross reference results in an entry that you can follow using
+the Info @samp{f} command. (@inforef{Help-Adv, Some advanced Info
+commands, info}.)@refill
+
+The various cross reference commands use nodes to define cross
+reference locations. This is evident in Info, in which a cross
+reference takes you to the specified node. @TeX{} also uses nodes to
+define cross reference locations, but the action is less obvious. When
+@TeX{} generates a @sc{dvi} file, it records nodes' page numbers and
+uses the page numbers in making references. Thus, if you are writing
+a manual that will only be printed, and will not be used on-line, you
+must nonetheless write @code{@@node} lines to name the places to which
+you make cross references.@refill
+
+@need 800
+@node Cross Reference Commands, Cross Reference Parts, References, Cross References
+@comment node-name, next, previous, up
+@section Different Cross Reference Commands
+@cindex Different cross reference commands
+
+There are four different cross reference commands:@refill
+
+@table @code
+@item @@xref
+Used to start a sentence in the printed manual saying @w{`See @dots{}'}
+or an Info cross-reference saying @samp{*Note @var{name}: @var{node}.}.
+
+@item @@ref
+Used within or, more often, at the end of a sentence; same as
+@code{@@xref} for Info; produces just the reference in the printed
+manual without a preceding `See'.@refill
+
+@item @@pxref
+Used within parentheses to make a reference that suits both an Info
+file and a printed book. Starts with a lower case `see' within the
+printed manual. (@samp{p} is for `parenthesis'.)@refill
+
+@item @@inforef
+Used to make a reference to an Info file for which there is no printed
+manual.@refill
+@end table
+
+@noindent
+(The @code{@@cite} command is used to make references to books and
+manuals for which there is no corresponding Info file and, therefore,
+no node to which to point. @xref{cite, , @code{@@cite}}.)@refill
+
+@node Cross Reference Parts, xref, Cross Reference Commands, Cross References
+@comment node-name, next, previous, up
+@section Parts of a Cross Reference
+@cindex Cross reference parts
+@cindex Parts of a cross reference
+
+A cross reference command requires only one argument, which is the
+name of the node to which it refers. But a cross reference command
+may contain up to four additional arguments. By using these
+arguments, you can provide a cross reference name for Info, a topic
+description or section title for the printed output, the name of a
+different Info file, and the name of a different printed
+manual.@refill
+
+Here is a simple cross reference example:@refill
+
+@example
+@@xref@{Node name@}.
+@end example
+
+@noindent
+which produces
+
+@example
+*Note Node name::.
+@end example
+
+@noindent
+and
+
+@quotation
+See Section @var{nnn} [Node name], page @var{ppp}.
+@end quotation
+
+@need 700
+Here is an example of a full five-part cross reference:@refill
+
+@example
+@group
+@@xref@{Node name, Cross Reference Name, Particular Topic,
+info-file-name, A Printed Manual@}, for details.
+@end group
+@end example
+
+@noindent
+which produces
+
+@example
+*Note Cross Reference Name: (info-file-name)Node name,
+for details.
+@end example
+
+@noindent
+in Info and
+
+@quotation
+See section ``Particular Topic'' in @i{A Printed Manual}, for details.
+@end quotation
+
+@noindent
+in a printed book.
+
+The five possible arguments for a cross reference are:@refill
+
+@enumerate
+@item
+The node name (required). This is the node to which the
+cross reference takes you. In a printed document, the location of the
+node provides the page reference only for references within the same
+document.@refill
+
+@item
+The cross reference name for the Info reference, if it is to be different
+from the node name. If you include this argument, it argument becomes
+the first part of the cross reference. It is usually omitted.@refill
+
+@item
+A topic description or section name. Often, this is the title of the
+section. This is used as the name of the reference in the printed
+manual. If omitted, the node name is used.@refill
+
+@item
+The name of the Info file in which the reference is located, if it is
+different from the current file.@refill
+
+@item
+The name of a printed manual from a different Texinfo file.@refill
+@end enumerate
+
+The template for a full five argument cross reference looks like
+this:@refill
+
+@example
+@group
+@@xref@{@var{node-name}, @var{cross-reference-name}, @var{title-or-topic},
+@var{info-file-name}, @var{printed-manual-title}@}.
+@end group
+@end example
+
+Cross references with one, two, three, four, and five arguments are
+described separately following the description of @code{@@xref}.@refill
+
+Write a node name in a cross reference in exactly the same way as in
+the @code{@@node} line, including the same capitalization; otherwise, the
+formatters may not find the reference.@refill
+
+You can write cross reference commands within a paragraph, but note
+how Info and @TeX{} format the output of each of the various commands:
+write @code{@@xref} at the beginning of a sentence; write
+@code{@@pxref} only within parentheses, and so on.@refill
+
+@node xref, Top Node Naming, Cross Reference Parts, Cross References
+@comment node-name, next, previous, up
+@section @code{@@xref}
+@findex xref
+@cindex Cross references using @code{@@xref}
+@cindex References using @code{@@xref}
+
+The @code{@@xref} command generates a cross reference for the
+beginning of a sentence. The Info formatting commands convert it into
+an Info cross reference, which the Info @samp{f} command can use to
+bring you directly to another node. The @TeX{} typesetting commands
+convert it into a page reference, or a reference to another book or
+manual.@refill
+
+@menu
+* Reference Syntax:: What a reference looks like and requires.
+* One Argument:: @code{@@xref} with one argument.
+* Two Arguments:: @code{@@xref} with two arguments.
+* Three Arguments:: @code{@@xref} with three arguments.
+* Four and Five Arguments:: @code{@@xref} with four and five arguments.
+@end menu
+
+@node Reference Syntax, One Argument, xref, xref
+@ifinfo
+@subheading What a Reference Looks Like and Requires
+@end ifinfo
+
+Most often, an Info cross reference looks like this:@refill
+
+@example
+*Note @var{node-name}::.
+@end example
+
+@noindent
+or like this
+
+@example
+*Note @var{cross-reference-name}: @var{node-name}.
+@end example
+
+@noindent
+In @TeX{}, a cross reference looks like this:
+
+@example
+See Section @var{section-number} [@var{node-name}], page @var{page}.
+@end example
+
+@noindent
+or like this
+
+@example
+See Section @var{section-number} [@var{title-or-topic}], page @var{page}.
+@end example
+
+The @code{@@xref} command does not generate a period or comma to end
+the cross reference in either the Info file or the printed output.
+You must write that period or comma yourself; otherwise, Info will not
+recognize the end of the reference. (The @code{@@pxref} command works
+differently. @xref{pxref, , @code{@@pxref}}.)@refill
+
+@quotation
+@strong{Please note:} A period or comma @strong{must} follow the closing
+brace of an @code{@@xref}. It is required to terminate the cross
+reference. This period or comma will appear in the output, both in
+the Info file and in the printed manual.@refill
+@end quotation
+
+@code{@@xref} must refer to an Info node by name. Use @code{@@node}
+to define the node (@pxref{Writing a Node}).@refill
+
+@code{@@xref} is followed by several arguments inside braces, separated by
+commas. Whitespace before and after these commas is ignored.@refill
+
+A cross reference requires only the name of a node; but it may contain
+up to four additional arguments. Each of these variations produces a
+cross reference that looks somewhat different.@refill
+
+@quotation
+@strong{Please note:} Commas separate arguments in a cross reference;
+avoid including them in the title or other part lest the formatters
+mistake them for separators.@refill
+@end quotation
+
+@node One Argument, Two Arguments, Reference Syntax, xref
+@subsection @code{@@xref} with One Argument
+
+The simplest form of @code{@@xref} takes one argument, the name of
+another node in the same Info file. The Info formatters produce
+output that the Info readers can use to jump to the reference; @TeX{}
+produces output that specifies the page and section number for you.@refill
+
+@need 700
+@noindent
+For example,
+
+@example
+@@xref@{Tropical Storms@}.
+@end example
+
+@noindent
+produces
+
+@example
+*Note Tropical Storms::.
+@end example
+
+@noindent
+and
+
+@quotation
+See Section 3.1 [Tropical Storms], page 24.
+@end quotation
+
+@noindent
+(Note that in the preceding example the closing brace is followed by a
+period.)@refill
+
+You can write a clause after the cross reference, like this:@refill
+
+@example
+@@xref@{Tropical Storms@}, for more info.
+@end example
+
+@noindent
+which produces
+
+@example
+*Note Tropical Storms::, for more info.
+@end example
+
+@quotation
+See Section 3.1 [Tropical Storms], page 24, for more info.
+@end quotation
+
+@noindent
+(Note that in the preceding example the closing brace is followed by a
+comma, and then by the clause, which is followed by a period.)@refill
+
+@node Two Arguments, Three Arguments, One Argument, xref
+@subsection @code{@@xref} with Two Arguments
+
+With two arguments, the second is used as the name of the Info cross
+reference, while the first is still the name of the node to which the
+cross reference points.@refill
+
+@need 750
+@noindent
+The template is like this:
+
+@example
+@@xref@{@var{node-name}, @var{cross-reference-name}@}.
+@end example
+
+@need 700
+@noindent
+For example,
+
+@example
+@@xref@{Electrical Effects, Lightning@}.
+@end example
+
+@noindent
+produces:
+
+@example
+*Note Lightning: Electrical Effects.
+@end example
+
+@noindent
+and
+
+@quotation
+See Section 5.2 [Electrical Effects], page 57.
+@end quotation
+
+@noindent
+(Note that in the preceding example the closing brace is followed by a
+period; and that the node name is printed, not the cross reference name.)@refill
+
+You can write a clause after the cross reference, like this:@refill
+
+@example
+@@xref@{Electrical Effects, Lightning@}, for more info.
+@end example
+
+@noindent
+which produces
+@example
+*Note Lightning: Electrical Effects, for more info.
+@end example
+
+@noindent
+and
+
+@quotation
+See Section 5.2 [Electrical Effects], page 57, for more info.
+@end quotation
+
+@noindent
+(Note that in the preceding example the closing brace is followed by a
+comma, and then by the clause, which is followed by a period.)@refill
+
+@node Three Arguments, Four and Five Arguments, Two Arguments, xref
+@subsection @code{@@xref} with Three Arguments
+
+A third argument replaces the node name in the @TeX{} output. The third
+argument should be the name of the section in the printed output, or
+else state the topic discussed by that section. Often, you will want to
+use initial upper case letters so it will be easier to read when the
+reference is printed. Use a third argument when the node name is
+unsuitable because of syntax or meaning.@refill
+
+Remember to avoid placing a comma within the title or topic section of
+a cross reference, or within any other section. The formatters divide
+cross references into arguments according to the commas; a comma
+within a title or other section will divide it into two arguments. In
+a reference, you need to write a title such as ``Clouds, Mist, and
+Fog'' without the commas.@refill
+
+Also, remember to write a comma or period after the closing brace of a
+@code{@@xref} to terminate the cross reference. In the following
+examples, a clause follows a terminating comma.@refill
+
+
+@need 750
+@noindent
+The template is like this:
+
+@example
+@group
+@@xref@{@var{node-name}, @var{cross-reference-name}, @var{title-or-topic}@}.
+@end group
+@end example
+
+@need 700
+@noindent
+For example,
+
+@example
+@group
+@@xref@{Electrical Effects, Lightning, Thunder and Lightning@},
+for details.
+@end group
+@end example
+
+@noindent
+produces
+
+@example
+*Note Lightning: Electrical Effects, for details.
+@end example
+
+@noindent
+and
+
+@quotation
+See Section 5.2 [Thunder and Lightning], page 57, for details.
+@end quotation
+
+If a third argument is given and the second one is empty, then the
+third argument serves both. (Note how two commas, side by side, mark
+the empty second argument.)@refill
+
+@example
+@group
+@@xref@{Electrical Effects, , Thunder and Lightning@},
+for details.
+@end group
+@end example
+
+@noindent
+produces
+
+@example
+*Note Thunder and Lightning: Electrical Effects, for details.
+@end example
+
+@noindent
+and
+
+@quotation
+See Section 5.2 [Thunder and Lightning], page 57, for details.
+@end quotation
+
+As a practical matter, it is often best to write cross references with
+just the first argument if the node name and the section title are the
+same, and with the first and third arguments if the node name and title
+are different.@refill
+
+Here are several examples from @cite{The GAWK Manual}:@refill
+
+@smallexample
+@@xref@{Sample Program@}.
+@@xref@{Glossary@}.
+@@xref@{Case-sensitivity, ,Case-sensitivity in Matching@}.
+@@xref@{Close Output, , Closing Output Files and Pipes@},
+ for more information.
+@@xref@{Regexp, , Regular Expressions as Patterns@}.
+@end smallexample
+
+@node Four and Five Arguments, , Three Arguments, xref
+@subsection @code{@@xref} with Four and Five Arguments
+
+In a cross reference, a fourth argument specifies the name of another
+Info file, different from the file in which the reference appears, and
+a fifth argument specifies its title as a printed manual.@refill
+
+Remember that a comma or period must follow the closing brace of an
+@code{@@xref} command to terminate the cross reference. In the
+following examples, a clause follows a terminating comma.@refill
+
+@need 800
+@noindent
+The template is:
+
+@example
+@group
+@@xref@{@var{node-name}, @var{cross-reference-name}, @var{title-or-topic},
+@var{info-file-name}, @var{printed-manual-title}@}.
+@end group
+@end example
+
+@need 700
+@noindent
+For example,
+
+@example
+@@xref@{Electrical Effects, Lightning, Thunder and Lightning,
+weather, An Introduction to Meteorology@}, for details.
+@end example
+
+@noindent
+produces
+
+@example
+*Note Lightning: (weather)Electrical Effects, for details.
+@end example
+
+@noindent
+The name of the Info file is enclosed in parentheses and precedes
+the name of the node.
+
+@noindent
+In a printed manual, the reference looks like this:@refill
+
+@quotation
+See section ``Thunder and Lightning'' in @i{An Introduction to
+Meteorology}, for details.
+@end quotation
+
+@noindent
+The title of the printed manual is typeset in italics; and the
+reference lacks a page number since @TeX{} cannot know to which page a
+reference refers when that reference is to another manual.@refill
+
+Often, you will leave out the second argument when you use the long
+version of @code{@@xref}. In this case, the third argument, the topic
+description, will be used as the cross reference name in Info.@refill
+
+@noindent
+The template looks like this:
+
+@example
+@@xref@{@var{node-name}, , @var{title-or-topic}, @var{info-file-name},
+@var{printed-manual-title}@}, for details.
+@end example
+
+@noindent
+which produces
+
+@example
+*Note @var{title-or-topic}: (@var{info-file-name})@var{node-name}, for details.
+@end example
+
+@noindent
+and
+
+@quotation
+See section @var{title-or-topic} in @var{printed-manual-title}, for details.
+@end quotation
+
+@need 700
+@noindent
+For example,
+
+@example
+@@xref@{Electrical Effects, , Thunder and Lightning,
+weather, An Introduction to Meteorology@}, for details.
+@end example
+
+@noindent
+produces
+
+@example
+@group
+*Note Thunder and Lightning: (weather)Electrical Effects,
+for details.
+@end group
+@end example
+
+@noindent
+and
+
+@quotation
+See section ``Thunder and Lightning'' in @i{An Introduction to
+Meteorology}, for details.
+@end quotation
+
+On rare occasions, you may want to refer to another Info file that
+is within a single printed manual---when multiple Texinfo files are
+incorporated into the same @TeX{} run but make separate Info files.
+In this case, you need to specify only the fourth argument, and not
+the fifth.@refill
+
+@node Top Node Naming, ref, xref, Cross References
+@section Naming a `Top' Node
+@cindex Naming a `Top' Node in references
+@cindex @samp{@r{Top}} node naming for references
+
+In a cross reference, you must always name a node. This means that in
+order to refer to a whole manual, you must identify the `Top' node by
+writing it as the first argument to the @code{@@xref} command. (This
+is different from the way you write a menu entry; see @ref{Other Info
+Files, , Referring to Other Info Files}.) At the same time, to
+provide a meaningful section topic or title in the printed cross
+reference (instead of the word `Top'), you must write an appropriate
+entry for the third argument to the @code{@@xref} command.
+@refill
+
+@noindent
+Thus, to make a cross reference to @cite{The GNU Make Manual},
+write:@refill
+
+@example
+@@xref@{Top, , Overview, make, The GNU Make Manual@}.
+@end example
+
+@noindent
+which produces
+
+@example
+*Note Overview: (make)Top.
+@end example
+
+@noindent
+and
+
+@quotation
+See section ``Overview'' in @i{The GNU Make Manual}.
+@end quotation
+
+@noindent
+In this example, @samp{Top} is the name of the first node, and
+@samp{Overview} is the name of the first section of the manual.@refill
+@node ref, pxref, Top Node Naming, Cross References
+@comment node-name, next, previous, up
+@section @code{@@ref}
+@cindex Cross references using @code{@@ref}
+@cindex References using @code{@@ref}
+@findex ref
+
+@code{@@ref} is nearly the same as @code{@@xref} except that it does
+not generate a `See' in the printed output, just the reference itself.
+This makes it useful as the last part of a sentence.@refill
+
+@need 700
+@noindent
+For example,
+
+@example
+For more information, see @@ref@{Hurricanes@}.
+@end example
+
+@noindent
+produces
+
+@example
+For more information, see *Note Hurricanes.
+@end example
+
+@noindent
+and
+
+@quotation
+For more information, see Section 8.2 [Hurricanes], page 123.
+@end quotation
+
+The @code{@@ref} command sometimes leads writers to express themselves
+in a manner that is suitable for a printed manual but looks awkward
+in the Info format. Bear in mind that your audience will be using
+both the printed and the Info format.@refill
+
+@need 800
+@noindent
+For example,
+
+@example
+@group
+Sea surges are described in @@ref@{Hurricanes@}.
+@end group
+@end example
+
+@need 800
+@noindent
+produces
+
+@quotation
+Sea surges are described in Section 6.7 [Hurricanes], page 72.
+@end quotation
+
+@need 800
+@noindent
+in a printed document, and the following in Info:
+
+@example
+Sea surges are described in *Note Hurricanes::.
+@end example
+
+@quotation
+@strong{Caution:} You @emph{must} write a period or comma immediately
+after an @code{@@ref} command with two or more arguments. Otherwise,
+Info will not find the end of the cross reference entry and its
+attempt to follow the cross reference will fail. As a general rule,
+you should write a period or comma after every @code{@@ref} command.
+This looks best in both the printed and the Info output.@refill
+@end quotation
+
+@node pxref, inforef, ref, Cross References
+@comment node-name, next, previous, up
+@section @code{@@pxref}
+@cindex Cross references using @code{@@pxref}
+@cindex References using @code{@@pxref}
+@findex pxref
+
+The parenthetical reference command, @code{@@pxref}, is nearly the
+same as @code{@@xref}, but you use it @emph{only} inside parentheses
+and you do @emph{not} type a comma or period after the command's
+closing brace. The command differs from @code{@@xref} in two
+ways:@refill
+
+@enumerate
+@item
+@TeX{} typesets the reference for the printed manual with a lower case
+`see' rather than an upper case `See'.@refill
+
+@item
+The Info formatting commands automatically end the reference with a
+closing colon or period.@refill
+@end enumerate
+
+Because one type of formatting automatically inserts closing
+punctuation and the other does not, you should use @code{@@pxref}
+@emph{only} inside parentheses as part of another sentence. Also, you
+yourself should not insert punctuation after the reference, as you do
+with @code{@@xref}.@refill
+
+@code{@@pxref} is designed so that the output looks right and works
+right between parentheses both in printed output and in an Info file.
+In a printed manual, a closing comma or period should not follow a
+cross reference within parentheses; such punctuation is wrong. But in
+an Info file, suitable closing punctuation must follow the cross
+reference so Info can recognize its end. @code{@@pxref} spares you
+the need to use complicated methods to put a terminator into one form
+of the output and not the other.@refill
+
+@noindent
+With one argument, a parenthetical cross reference looks like
+this:@refill
+
+@example
+@dots{} storms cause flooding (@@pxref@{Hurricanes@}) @dots{}
+@end example
+
+@need 800
+@noindent
+which produces
+
+@example
+@group
+@dots{} storms cause flooding (*Note Hurricanes::) @dots{}
+@end group
+@end example
+
+@noindent
+and
+
+@quotation
+@dots{} storms cause flooding (see Section 6.7 [Hurricanes], page 72) @dots{}
+@end quotation
+
+With two arguments, a parenthetical cross reference has this
+template:@refill
+
+@example
+@dots{} (@@pxref@{@var{node-name}, @var{cross-reference-name}@}) @dots{}
+@end example
+
+@noindent
+which produces
+
+@example
+@dots{} (*Note @var{cross-reference-name}: @var{node-name}.) @dots{}
+@end example
+
+@noindent
+and
+
+@need 1500
+@quotation
+@dots{} (see Section @var{nnn} [@var{node-name}], page @var{ppp}) @dots{}
+@end quotation
+
+@code{@@pxref} can be used with up to five arguments just like
+@code{@@xref} (@pxref{xref, , @code{@@xref}}).@refill
+
+@quotation
+@strong{Please note:} Use @code{@@pxref} only as a parenthetical
+reference. Do not try to use @code{@@pxref} as a clause in a sentence.
+It will look bad in either the Info file, the printed output, or
+both.@refill
+
+Also, parenthetical cross references look best at the ends of sentences.
+Although you may write them in the middle of a sentence, that location
+breaks up the flow of text.@refill
+@end quotation
+
+@node inforef, , pxref, Cross References
+@comment node-name, next, previous, up
+@section @code{@@inforef}
+@cindex Cross references using @code{@@inforef}
+@cindex References using @code{@@inforef}
+@findex inforef
+
+@code{@@inforef} is used for cross references to Info files for which
+there are no printed manuals. Even in a printed manual,
+@code{@@inforef} generates a reference directing the user to look in
+an Info file.@refill
+
+The command takes either two or three arguments, in the following
+order:@refill
+
+@enumerate
+@item
+The node name.
+
+@item
+The cross reference name (optional).
+
+@item
+The Info file name.
+@end enumerate
+
+@noindent
+Separate the arguments with commas, as with @code{@@xref}. Also, you
+must terminate the reference with a comma or period after the
+@samp{@}}, as you do with @code{@@xref}.@refill
+
+@noindent
+The template is:
+
+@example
+@@inforef@{@var{node-name}, @var{cross-reference-name}, @var{info-file-name}@},
+@end example
+
+@need 800
+@noindent
+Thus,
+
+@example
+@group
+@@inforef@{Expert, Advanced Info commands, info@},
+for more information.
+@end group
+@end example
+
+@need 800
+@noindent
+produces
+
+@example
+@group
+*Note Advanced Info commands: (info)Expert,
+for more information.
+@end group
+@end example
+
+@need 800
+@noindent
+and
+
+@quotation
+See Info file @file{info}, node @samp{Expert}, for more information.
+@end quotation
+
+@need 800
+@noindent
+Similarly,
+
+@example
+@group
+@@inforef@{Expert, , info@}, for more information.
+@end group
+@end example
+
+@need 800
+@noindent
+produces
+
+@example
+*Note (info)Expert::, for more information.
+@end example
+
+@need 800
+@noindent
+and
+
+@quotation
+See Info file @file{info}, node @samp{Expert}, for more information.
+@end quotation
+
+The converse of @code{@@inforef} is @code{@@cite}, which is used to
+refer to printed works for which no Info form exists. @xref{cite, ,
+@code{@@cite}}.@refill
+
+@node Marking Text, Quotations and Examples, Cross References, Top
+@comment node-name, next, previous, up
+@chapter Marking Words and Phrases
+@cindex Paragraph, marking text within
+@cindex Marking words and phrases
+@cindex Words and phrases, marking them
+@cindex Marking text within a paragraph
+
+In Texinfo, you can mark words and phrases in a variety of ways.
+The Texinfo formatters use this information to determine how to
+highlight the text.
+You can specify, for example, whether a word or phrase is a
+defining occurrence, a metasyntactic variable, or a symbol used in a
+program. Also, you can emphasize text.@refill
+
+@menu
+* Indicating:: How to indicate definitions, files, etc.
+* Emphasis:: How to emphasize text.
+@end menu
+
+@node Indicating, Emphasis, Marking Text, Marking Text
+@comment node-name, next, previous, up
+@section Indicating Definitions, Commands, etc.
+@cindex Highlighting text
+@cindex Indicating commands, definitions, etc.
+
+Texinfo has commands for indicating just what kind of object a piece of
+text refers to. For example, metasyntactic variables are marked by
+@code{@@var}, and code by @code{@@code}. Since the pieces of text are
+labelled by commands that tell what kind of object they are, it is easy
+to change the way the Texinfo formatters prepare such text. (Texinfo is
+an @emph{intentional} formatting language rather than a @emph{typesetting}
+formatting language.)@refill
+
+For example, in a printed manual,
+code is usually illustrated in a typewriter font;
+@code{@@code} tells @TeX{} to typeset this text in this font. But it
+would be easy to change the way @TeX{} highlights code to use another
+font, and this change would not effect how keystroke examples are
+highlighted. If straight typesetting commands were used in the body
+of the file and you wanted to make a change, you would need to check
+every single occurrence to make sure that you were changing code and
+not something else that should not be changed.@refill
+
+@menu
+* Useful Highlighting:: Highlighting provides useful information.
+* code:: How to indicate code.
+* kbd:: How to show keyboard input.
+* key:: How to specify keys.
+* samp:: How to show a literal sequence of characters.
+* var:: How to indicate a metasyntactic variable.
+* file:: How to indicate the name of a file.
+* dfn:: How to specify a definition.
+* cite:: How to refer to a book that is not in Info.
+* url:: How to indicate a world wide web reference.
+* email:: How to indicate an electronic mail address.
+@end menu
+
+@node Useful Highlighting, code, Indicating, Indicating
+@ifinfo
+@subheading Highlighting Commands are Useful
+@end ifinfo
+
+The highlighting commands can be used to generate useful information
+from the file, such as lists of functions or file names. It is
+possible, for example, to write a program in Emacs Lisp (or a keyboard
+macro) to insert an index entry after every paragraph that contains
+words or phrases marked by a specified command. You could do this to
+construct an index of functions if you had not already made the
+entries.@refill
+
+The commands serve a variety of purposes:@refill
+
+@table @code
+@item @@code@{@var{sample-code}@}
+Indicate text that is a literal example of a piece of a program.@refill
+
+@item @@kbd@{@var{keyboard-characters}@}
+Indicate keyboard input.@refill
+
+@item @@key@{@var{key-name}@}
+Indicate the conventional name for a key on a keyboard.@refill
+
+@item @@samp@{@var{text}@}
+Indicate text that is a literal example of a sequence of characters.@refill
+
+@item @@var@{@var{metasyntactic-variable}@}
+Indicate a metasyntactic variable.@refill
+
+@item @@url@{@var{uniform-resource-locator}@}
+Indicate a uniform resource locator for the World Wide Web.
+
+@item @@file@{@var{file-name}@}
+Indicate the name of a file.@refill
+
+@item @@email@{@var{email-address}@}
+Indicate an electronic mail address.
+
+@item @@dfn@{@var{term}@}
+Indicate the introductory or defining use of a term.@refill
+
+@item @@cite@{@var{reference}@}
+Indicate the name of a book.@refill
+
+@ignore
+@item @@ctrl@{@var{ctrl-char}@}
+Use for an @sc{ascii} control character.@refill
+@end ignore
+@end table
+
+@node code, kbd, Useful Highlighting, Indicating
+@comment node-name, next, previous, up
+@subsection @code{@@code}@{@var{sample-code}@}
+@findex code
+
+Use the @code{@@code} command to indicate text that is a piece of a
+program and which consists of entire syntactic tokens. Enclose the
+text in braces.@refill
+
+Thus, you should use @code{@@code} for an expression in a program, for
+the name of a variable or function used in a program, or for a
+keyword. Also, you should use @code{@@code} for the name of a
+program, such as @code{diff}, that is a name used in the machine. (You
+should write the name of a program in the ordinary text font if you
+regard it as a new English word, such as `Emacs' or `Bison'.)@refill
+
+Use @code{@@code} for environment variables such as @code{TEXINPUTS},
+and other variables.@refill
+
+Use @code{@@code} for command names in command languages that
+resemble programming languages, such as Texinfo or the shell.
+For example, @code{@@code} and @code{@@samp} are produced by writing
+@samp{@@code@{@@@@code@}} and @samp{@@code@{@@@@samp@}} in the Texinfo
+source, respectively.@refill
+
+Note, however, that you should not use @code{@@code} for shell options
+such as @samp{-c} when such options stand alone. (Use @code{@@samp}.)
+Also, an entire shell command often looks better if written using
+@code{@@samp} rather than @code{@@code}. In this case, the rule is to
+choose the more pleasing format.@refill
+
+It is incorrect to alter the case of a word inside an @code{@@code}
+command when it appears at the beginning of a sentence. Most computer
+languages are case sensitive. In C, for example, @code{Printf} is
+different from the identifier @code{printf}, and most likely is a
+misspelling of it. Even in languages which are not case sensitive, it
+is confusing to a human reader to see identifiers spelled in different
+ways. Pick one spelling and always use that. If you do not want to
+start a sentence with a command written all in lower case, you should
+rearrange the sentence.@refill
+
+Do not use the @code{@@code} command for a string of characters shorter
+than a syntactic token. If you are writing about @samp{TEXINPU}, which
+is just a part of the name for the @code{TEXINPUTS} environment
+variable, you should use @code{@@samp}.@refill
+
+In particular, you should not use the @code{@@code} command when writing
+about the characters used in a token; do not, for example, use
+@code{@@code} when you are explaining what letters or printable symbols
+can be used in the names of functions. (Use @code{@@samp}.) Also, you
+should not use @code{@@code} to mark text that is considered input to
+programs unless the input is written in a language that is like a
+programming language. For example, you should not use @code{@@code} for
+the keystroke commands of GNU Emacs (use @code{@@kbd} instead) although
+you may use @code{@@code} for the names of the Emacs Lisp functions that
+the keystroke commands invoke.@refill
+
+In the printed manual, @code{@@code} causes @TeX{} to typeset the
+argument in a typewriter face. In the Info file, it causes the Info
+formatting commands to use single quotation marks around the text.
+
+@need 700
+For example,
+
+@example
+Use @@code@{diff@} to compare two files.
+@end example
+
+@noindent
+produces this in the printed manual:@refill
+
+@quotation
+Use @code{diff} to compare two files.
+@end quotation
+@iftex
+
+@noindent
+and this in the Info file:@refill
+
+@example
+Use `diff' to compare two files.
+@end example
+@end iftex
+
+@node kbd, key, code, Indicating
+@comment node-name, next, previous, up
+@subsection @code{@@kbd}@{@var{keyboard-characters}@}
+@findex kbd
+
+Use the @code{@@kbd} command for characters of input to be typed by
+users. For example, to refer to the characters @kbd{M-a},
+write@refill
+
+@example
+@@kbd@{M-a@}
+@end example
+
+@noindent
+and to refer to the characters @kbd{M-x shell}, write@refill
+
+@example
+@@kbd@{M-x shell@}
+@end example
+
+The @code{@@kbd} command has the same effect as @code{@@code} in Info,
+but may produce a different font in a printed manual.@refill
+
+You can embed another @@-command inside the braces of an @code{@@kbd}
+command. Here, for example, is the way to describe a command that
+would be described more verbosely as ``press an @samp{r} and then
+press the @key{RET} key'':@refill
+
+@example
+@@kbd@{r @@key@{RET@}@}
+@end example
+
+@noindent
+This produces: @kbd{r @key{RET}}
+
+You also use the @code{@@kbd} command if you are spelling out the letters
+you type; for example:@refill
+
+@example
+To give the @@code@{logout@} command,
+type the characters @@kbd@{l o g o u t @@key@{RET@}@}.
+@end example
+
+@noindent
+This produces:
+
+@quotation
+To give the @code{logout} command,
+type the characters @kbd{l o g o u t @key{RET}}.
+@end quotation
+
+(Also, this example shows that you can add spaces for clarity. If you
+really want to mention a space character as one of the characters of
+input, write @kbd{@@key@{SPC@}} for it.)@refill
+
+@node key, samp, kbd, Indicating
+@comment node-name, next, previous, up
+@subsection @code{@@key}@{@var{key-name}@}
+@findex key
+
+Use the @code{@@key} command for the conventional name for a key on a
+keyboard, as in:@refill
+
+@example
+@@key@{RET@}
+@end example
+
+You can use the @code{@@key} command within the argument of an
+@code{@@kbd} command when the sequence of characters to be typed
+includes one or more keys that are described by name.@refill
+
+@need 700
+For example, to produce @kbd{C-x @key{ESC}} you would type:@refill
+
+@example
+@@kbd@{C-x @@key@{ESC@}@}
+@end example
+
+Here is a list of the recommended names for keys:
+@cindex Recommended names for keys
+@cindex Keys, recommended names
+@cindex Names recommended for keys
+@cindex Abbreviations for keys
+
+@quotation
+@table @t
+@item SPC
+Space
+@item RET
+Return
+@item LFD
+Linefeed (however, since most keyboards nowadays do not have a Linefeed key,
+it might be better to call this character @kbd{C-j}.
+@item TAB
+Tab
+@item BS
+Backspace
+@item ESC
+Escape
+@item DEL
+Delete
+@item SHIFT
+Shift
+@item CTRL
+Control
+@item META
+Meta
+@end table
+@end quotation
+
+@cindex META key
+There are subtleties to handling words like `meta' or `ctrl' that are
+names of shift keys. When mentioning a character in which the shift key
+is used, such as @kbd{Meta-a}, use the @code{@@kbd} command alone; do
+not use the @code{@@key} command; but when you are referring to the
+shift key in isolation, use the @code{@@key} command. For example,
+write @samp{@@kbd@{Meta-a@}} to produce @kbd{Meta-a} and
+@samp{@@key@{META@}} to produce @key{META}.
+
+@c I don't think this is a good explanation.
+@c I think it will puzzle readers more than it clarifies matters. -- rms.
+@c In other words, use @code{@@kbd} for what you do, and use @code{@@key}
+@c for what you talk about: ``Press @code{@@kbd@{M-a@}} to move point to
+@c the beginning of the sentence. The @code{@@key@{META@}} key is often in
+@c the lower left of the keyboard.''@refill
+
+@node samp, var, key, Indicating
+@comment node-name, next, previous, up
+@subsection @code{@@samp}@{@var{text}@}
+@findex samp
+
+Use the @code{@@samp} command to indicate text that is a literal example
+or `sample' of a sequence of characters in a file, string, pattern, etc.
+Enclose the text in braces. The argument appears within single
+quotation marks in both the Info file and the printed manual; in
+addition, it is printed in a fixed-width font.@refill
+
+@example
+To match @@samp@{foo@} at the end of the line,
+use the regexp @@samp@{foo$@}.
+@end example
+
+@noindent
+produces
+
+@quotation
+To match @samp{foo} at the end of the line, use the regexp
+@samp{foo$}.@refill
+@end quotation
+
+Any time you are referring to single characters, you should use
+@code{@@samp} unless @code{@@kbd} is more appropriate. Use
+@code{@@samp} for the names of command-line options. Also, you may use
+@code{@@samp} for entire statements in C and for entire shell
+commands---in this case, @code{@@samp} often looks better than
+@code{@@code}. Basically, @code{@@samp} is a catchall for whatever is
+not covered by @code{@@code}, @code{@@kbd}, or @code{@@key}.@refill
+
+Only include punctuation marks within braces if they are part of the
+string you are specifying. Write punctuation marks outside the braces
+if those punctuation marks are part of the English text that surrounds
+the string. In the following sentence, for example, the commas and
+period are outside of the braces:@refill
+
+@example
+@group
+In English, the vowels are @@samp@{a@}, @@samp@{e@},
+@@samp@{i@}, @@samp@{o@}, @@samp@{u@}, and sometimes
+@@samp@{y@}.
+@end group
+@end example
+
+@noindent
+This produces:
+
+@quotation
+In English, the vowels are @samp{a}, @samp{e},
+@samp{i}, @samp{o}, @samp{u}, and sometimes
+@samp{y}.
+@end quotation
+
+@node var, file, samp, Indicating
+@comment node-name, next, previous, up
+@subsection @code{@@var}@{@var{metasyntactic-variable}@}
+@findex var
+
+Use the @code{@@var} command to indicate metasyntactic variables. A
+@dfn{metasyntactic variable} is something that stands for another piece of
+text. For example, you should use a metasyntactic variable in the
+documentation of a function to describe the arguments that are passed
+to that function.@refill
+
+Do not use @code{@@var} for the names of particular variables in
+programming languages. These are specific names from a program, so
+@code{@@code} is correct for them. For example, the Lisp variable
+@code{texinfo-tex-command} is not a metasyntactic variable; it is
+properly formatted using @code{@@code}.@refill
+
+The effect of @code{@@var} in the Info file is to change the case of
+the argument to all upper case; in the printed manual, to italicize it.
+
+@need 700
+For example,
+
+@example
+To delete file @@var@{filename@},
+type @@code@{rm @@var@{filename@}@}.
+@end example
+
+@noindent
+produces
+
+@quotation
+To delete file @var{filename}, type @code{rm @var{filename}}.
+@end quotation
+
+@noindent
+(Note that @code{@@var} may appear inside @code{@@code},
+@code{@@samp}, @code{@@file}, etc.)@refill
+
+Write a metasyntactic variable all in lower case without spaces, and
+use hyphens to make it more readable. Thus, the Texinfo source for
+the illustration of how to begin a Texinfo manual looks like
+this:@refill
+
+@example
+@group
+\input texinfo
+@@@@setfilename @@var@{info-file-name@}
+@@@@settitle @@var@{name-of-manual@}
+@end group
+@end example
+
+@noindent
+This produces:
+
+@example
+@group
+\input texinfo
+@@setfilename @var{info-file-name}
+@@settitle @var{name-of-manual}
+@end group
+@end example
+
+In some documentation styles, metasyntactic variables are shown with
+angle brackets, for example:@refill
+
+@example
+@dots{}, type rm <filename>
+@end example
+
+@noindent
+However, that is not the style that Texinfo uses. (You can, of
+course, modify the sources to @TeX{} and the Info formatting commands
+to output the @code{<@dots{}>} format if you wish.)@refill
+
+@node file, dfn, var, Indicating
+@comment node-name, next, previous, up
+@subsection @code{@@file}@{@var{file-name}@}
+@findex file
+
+Use the @code{@@file} command to indicate text that is the name of a
+file, buffer, or directory, or is the name of a node in Info. You can
+also use the command for file name suffixes. Do not use @code{@@file}
+for symbols in a programming language; use @code{@@code}.
+
+Currently, @code{@@file} is equivalent to @code{@@samp} in its effects.
+For example,@refill
+
+@example
+The @@file@{.el@} files are in
+the @@file@{/usr/local/emacs/lisp@} directory.
+@end example
+
+@noindent
+produces
+
+@quotation
+The @file{.el} files are in
+the @file{/usr/local/emacs/lisp} directory.
+@end quotation
+
+@node dfn, cite, file, Indicating
+@comment node-name, next, previous, up
+@subsection @code{@@dfn}@{@var{term}@}
+@findex dfn
+
+Use the @code{@@dfn} command to identify the introductory or defining
+use of a technical term. Use the command only in passages whose
+purpose is to introduce a term which will be used again or which the
+reader ought to know. Mere passing mention of a term for the first
+time does not deserve @code{@@dfn}. The command generates italics in
+the printed manual, and double quotation marks in the Info file. For
+example:@refill
+
+@example
+Getting rid of a file is called @@dfn@{deleting@} it.
+@end example
+
+@noindent
+produces
+
+@quotation
+Getting rid of a file is called @dfn{deleting} it.
+@end quotation
+
+As a general rule, a sentence containing the defining occurrence of a
+term should be a definition of the term. The sentence does not need
+to say explicitly that it is a definition, but it should contain the
+information of a definition---it should make the meaning clear.
+
+@node cite, url, dfn, Indicating
+@comment node-name, next, previous, up
+@subsection @code{@@cite}@{@var{reference}@}
+@findex cite
+
+Use the @code{@@cite} command for the name of a book that lacks a
+companion Info file. The command produces italics in the printed
+manual, and quotation marks in the Info file.@refill
+
+(If a book is written in Texinfo, it is better to use a cross reference
+command since a reader can easily follow such a reference in Info.
+@xref{xref, , @code{@@xref}}.)@refill
+
+@ignore
+@c node ctrl, , cite, Indicating
+@comment node-name, next, previous, up
+@c subsection @code{@@ctrl}@{@var{ctrl-char}@}
+@findex ctrl
+
+The @code{@@ctrl} command is seldom used. It describes an @sc{ascii}
+control character by inserting the actual character into the Info
+file.
+
+Usually, in Texinfo, you talk what you type as keyboard entry by
+describing it with @code{@@kbd}: thus, @samp{@@kbd@{C-a@}} for
+@kbd{C-a}. Use @code{@@kbd} in this way when talking about a control
+character that is typed on the keyboard by the user. When talking
+about a control character appearing in a file or a string, do not use
+@code{@@kbd} since the control character is not typed. Also, do not
+use @samp{C-} but spell out @code{control-}, as in @samp{control-a},
+to make it easier for a reader to understand.@refill
+
+@code{@@ctrl} is an idea from the beginnings of Texinfo which may not
+really fit in to the scheme of things. But there may be times when
+you want to use the command. The pattern is
+@code{@@ctrl@{@var{ch}@}}, where @var{ch} is an @sc{ascii} character
+whose control-equivalent is wanted. For example, to specify
+@samp{control-f}, you would enter@refill
+
+@example
+@@ctrl@{f@}
+@end example
+
+@noindent
+produces
+
+@quotation
+@ctrl{f}
+@end quotation
+
+In the Info file, this generates the specified control character, output
+literally into the file. This is done so a user can copy the specified
+control character (along with whatever else he or she wants) into another
+Emacs buffer and use it. Since the `control-h',`control-i', and
+`control-j' characters are formatting characters, they should not be
+indicated with @code{@@ctrl}.@refill
+
+In a printed manual, @code{@@ctrl} generates text to describe or
+identify that control character: an uparrow followed by the character
+@var{ch}.@refill
+@end ignore
+
+@node url, email, cite, Indicating
+@subsection @code{@@url}@{@var{uniform-resource-locator}@}
+@findex url
+
+Use the @code{@@url} command to indicate a uniform resource locator on
+the World Wide Web. For example:
+
+@c Two lines because one is too long for smallbook format.
+@example
+The official GNU ftp site is
+@@url@{ftp://ftp.gnu.ai.mit.edu/pub/gnu@}.
+@end example
+
+In Info and @TeX{}, this acts like @code{@@samp}. When
+Texinfo is converted to HTML, this produces a link you can follow.
+
+@node email, , url, Indicating
+@subsection @code{@@email}@{@var{email-address}@}
+@findex email
+
+Use the @code{@@email} command to indicate an electronic mail address.
+For example:
+
+@example
+Send bug reports to @email{bug-texinfo@@prep.ai.mit.edu}.
+@end example
+
+In Info and @TeX{}, this acts like @code{@@samp}. When we have support
+for conversion of Texinfo to HTML, this will produce a link you can
+follow to bring up a mail composition window initialized with
+@var{email-address}.
+
+@node Emphasis, , Indicating, Marking Text
+@comment node-name, next, previous, up
+@section Emphasizing Text
+@cindex Emphasizing text
+
+Usually, Texinfo changes the font to mark words in the text according to
+what category the words belong to; an example is the @code{@@code} command.
+Most often, this is the best way to mark words.
+However, sometimes you will want to emphasize text without indicating a
+category. Texinfo has two commands to do this. Also, Texinfo has
+several commands that specify the font in which @TeX{} will typeset
+text. These commands have no affect on Info and only one of them,
+the @code{@@r} command, has any regular use.@refill
+
+@menu
+* emph & strong:: How to emphasize text in Texinfo.
+* Smallcaps:: How to use the small caps font.
+* Fonts:: Various font commands for printed output.
+* Customized Highlighting:: How to define highlighting commands.
+@end menu
+
+@node emph & strong, Smallcaps, Emphasis, Emphasis
+@comment node-name, next, previous, up
+@subsection @code{@@emph}@{@var{text}@} and @code{@@strong}@{@var{text}@}
+@cindex Emphasizing text, font for
+@findex emph
+@findex strong
+
+The @code{@@emph} and @code{@@strong} commands are for emphasis;
+@code{@@strong} is stronger. In printed output, @code{@@emph}
+produces @emph{italics} and @code{@@strong} produces
+@strong{bold}.@refill
+
+@need 800
+For example,
+
+@example
+@group
+@@quotation
+@@strong@{Caution:@} @@code@{rm * .[^.]*@} removes @@emph@{all@}
+files in the directory.
+@@end quotation
+@end group
+@end example
+
+@iftex
+@noindent
+produces the following in printed output:
+
+@quotation
+@strong{Caution}: @code{rm * .[^.]*} removes @emph{all}
+files in the directory.
+@end quotation
+
+@noindent
+and the following in Info:
+@end iftex
+@ifinfo
+@noindent
+produces:
+@end ifinfo
+
+@example
+ *Caution*: `rm * .[^.]*' removes *all*
+ files in the directory.
+@end example
+
+The @code{@@strong} command is seldom used except to mark what is, in
+effect, a typographical element, such as the word `Caution' in the
+preceding example.
+
+In the Info file, both @code{@@emph} and @code{@@strong} put asterisks
+around the text.@refill
+
+@quotation
+@strong{Caution:} Do not use @code{@@emph} or @code{@@strong} with the
+word @samp{Note}; Info will mistake the combination for a cross
+reference. Use a phrase such as @strong{Please note} or
+@strong{Caution} instead.@refill
+@end quotation
+
+@node Smallcaps, Fonts, emph & strong, Emphasis
+@subsection @code{@@sc}@{@var{text}@}: The Small Caps Font
+@cindex Small caps font
+@findex sc @r{(small caps font)}
+
+@iftex
+Use the @samp{@@sc} command to set text in the printed output in @sc{a
+small caps font} and set text in the Info file in upper case letters.@refill
+@end iftex
+@ifinfo
+Use the @samp{@@sc} command to set text in the printed output in a
+small caps font and set text in the Info file in upper case letters.@refill
+@end ifinfo
+
+Write the text between braces in lower case, like this:@refill
+
+@example
+The @@sc@{acm@} and @@sc@{ieee@} are technical societies.
+@end example
+
+@noindent
+This produces:
+
+@display
+The @sc{acm} and @sc{ieee} are technical societies.
+@end display
+
+@TeX{} typesets the small caps font in a manner that prevents the
+letters from `jumping out at you on the page'. This makes small caps
+text easier to read than text in all upper case. The Info formatting
+commands set all small caps text in upper case.@refill
+
+@ifinfo
+If the text between the braces of an @code{@@sc} command is upper case,
+@TeX{} typesets in full-size capitals. Use full-size capitals
+sparingly.@refill
+@end ifinfo
+@iftex
+If the text between the braces of an @code{@@sc} command is upper case,
+@TeX{} typesets in @sc{FULL-SIZE CAPITALS}. Use full-size capitals
+sparingly.@refill
+@end iftex
+
+You may also use the small caps font for a jargon word such as
+@sc{ato} (a @sc{nasa} word meaning `abort to orbit').@refill
+
+There are subtleties to using the small caps font with a jargon word
+such as @sc{cdr}, a word used in Lisp programming. In this case, you
+should use the small caps font when the word refers to the second and
+subsequent elements of a list (the @sc{cdr} of the list), but you
+should use @samp{@@code} when the word refers to the Lisp function of
+the same spelling.@refill
+
+@node Fonts, Customized Highlighting, Smallcaps, Emphasis
+@comment node-name, next, previous, up
+@subsection Fonts for Printing, Not Info
+@cindex Fonts for printing, not for Info
+@findex i @r{(italic font)}
+@findex b @r{(bold font)}
+@findex t @r{(typewriter font)}
+@findex r @r{(Roman font)}
+
+Texinfo provides four font commands that specify font changes in the
+printed manual but have no effect in the Info file. @code{@@i}
+requests @i{italic} font (in some versions of @TeX{}, a slanted font
+is used), @code{@@b} requests @b{bold} face, @code{@@t} requests the
+@t{fixed-width}, typewriter-style font used by @code{@@code}, and @code{@@r} requests a
+@r{roman} font, which is the usual font in which text is printed. All
+four commands apply to an argument that follows, surrounded by
+braces.@refill
+
+Only the @code{@@r} command has much use: in example programs, you
+can use the @code{@@r} command to convert code comments from the
+fixed-width font to a roman font. This looks better in printed
+output.@refill
+
+@need 700
+For example,
+
+@example
+@group
+@@lisp
+(+ 2 2) ; @@r@{Add two plus two.@}
+@@end lisp
+@end group
+@end example
+
+@noindent
+produces
+
+@lisp
+(+ 2 2) ; @r{Add two plus two.}
+@end lisp
+
+If possible, you should avoid using the other three font commands. If
+you need to use one, it probably indicates a gap in the Texinfo
+language.@refill
+
+@node Customized Highlighting, , Fonts, Emphasis
+@comment node-name, next, previous, up
+@subsection Customized Highlighting
+@cindex Highlighting, customized
+@cindex Customized highlighting
+
+@c I think this whole section is obsolete with the advent of macros
+@c --karl, 15sep96.
+You can use regular @TeX{} commands inside of @code{@@iftex} @dots{}
+@code{@@end iftex} to create your own customized highlighting commands
+for Texinfo. The easiest way to do this is to equate your customized
+commands with pre-existing commands, such as those for italics. Such
+new commands work only with @TeX{}.@refill
+
+@findex definfoenclose
+@cindex Enclosure command for Info
+You can use the @code{@@definfoenclose} command inside of
+@code{@@ifinfo} @dots{} @code{@@end ifinfo} to define commands for Info
+with the same names as new commands for @TeX{}.
+@code{@@definfoenclose} creates new commands for Info that mark text by
+enclosing it in strings that precede and follow the text.
+@footnote{Currently, @code{@@definfoenclose} works only with
+@code{texinfo-format-buffer} and @code{texinfo-format-region}, not with
+@code{makeinfo}.}@refill
+
+Here is how to create a new @@-command called @code{@@phoo} that causes
+@TeX{} to typeset its argument in italics and causes Info to display the
+argument between @samp{//} and @samp{\\}.@refill
+
+@need 1300
+For @TeX{}, write the following to equate the @code{@@phoo} command with
+the existing @code{@@i} italics command:@refill
+
+@example
+@group
+@@iftex
+@@global@@let@@phoo=@@i
+@@end iftex
+@end group
+@end example
+
+@noindent
+This defines @code{@@phoo} as a command that causes @TeX{} to typeset
+the argument to @code{@@phoo} in italics. @code{@@global@@let} tells
+@TeX{} to equate the next argument with the argument that follows the
+equals sign.
+
+@need 1300
+For Info, write the following to tell the Info formatters to enclose the
+argument between @samp{//} and @samp{\\}:
+
+@example
+@group
+@@ifinfo
+@@definfoenclose phoo, //, \\
+@@end ifinfo
+@end group
+@end example
+
+@noindent
+Write the @code{@@definfoenclose} command on a line and follow it with
+three arguments separated by commas (commas are used as separators in an
+@code{@@node} line in the same way).@refill
+
+@itemize @bullet
+@item
+The first argument to @code{@@definfoenclose} is the @@-command name
+@strong{without} the @samp{@@};
+
+@item
+the second argument is the Info start delimiter string; and,
+
+@item
+the third argument is the Info end delimiter string.
+@end itemize
+
+@noindent
+The latter two arguments enclose the highlighted text in the Info file.
+A delimiter string may contain spaces. Neither the start nor end
+delimiter is required. However, if you do not provide a start
+delimiter, you must follow the command name with two commas in a row;
+otherwise, the Info formatting commands will misinterpret the end
+delimiter string as a start delimiter string.@refill
+
+After you have defined @code{@@phoo} both for @TeX{} and for Info, you
+can then write @code{@@phoo@{bar@}} to see @samp{//bar\\}
+in Info and see
+@ifinfo
+@samp{bar} in italics in printed output.
+@end ifinfo
+@iftex
+@i{bar} in italics in printed output.
+@end iftex
+
+Note that each definition applies to its own formatter: one for @TeX{},
+the other for Info.
+
+@need 1200
+Here is another example:
+
+@example
+@group
+@@ifinfo
+@@definfoenclose headword, , :
+@@end ifinfo
+@@iftex
+@@global@@let@@headword=@@b
+@@end iftex
+@end group
+@end example
+
+@noindent
+This defines @code{@@headword} as an Info formatting command that
+inserts nothing before and a colon after the argument and as a @TeX{}
+formatting command to typeset its argument in bold.
+
+@node Quotations and Examples, Lists and Tables, Marking Text, Top
+@comment node-name, next, previous, up
+@chapter Quotations and Examples
+
+Quotations and examples are blocks of text consisting of one or more
+whole paragraphs that are set off from the bulk of the text and
+treated differently. They are usually indented.@refill
+
+In Texinfo, you always begin a quotation or example by writing an
+@@-command at the beginning of a line by itself, and end it by writing
+an @code{@@end} command that is also at the beginning of a line by
+itself. For instance, you begin an example by writing @code{@@example}
+by itself at the beginning of a line and end the example by writing
+@code{@@end example} on a line by itself, at the beginning of that
+line.@refill
+@findex end
+
+@menu
+* Block Enclosing Commands:: Use different constructs for
+ different purposes.
+* quotation:: How to write a quotation.
+* example:: How to write an example in a fixed-width font.
+* noindent:: How to prevent paragraph indentation.
+* Lisp Example:: How to illustrate Lisp code.
+* smallexample & smalllisp:: Forms for the @code{@@smallbook} option.
+* display:: How to write an example in the current font.
+* format:: How to write an example that does not narrow
+ the margins.
+* exdent:: How to undo the indentation of a line.
+* flushleft & flushright:: How to push text flushleft or flushright.
+* cartouche:: How to draw cartouches around examples.
+@end menu
+
+@node Block Enclosing Commands, quotation, Quotations and Examples, Quotations and Examples
+@section The Block Enclosing Commands
+
+Here are commands for quotations and examples:@refill
+
+@table @code
+@item @@quotation
+Indicate text that is quoted. The text is filled, indented, and
+printed in a roman font by default.@refill
+
+@item @@example
+Illustrate code, commands, and the like. The text is printed
+in a fixed-width font, and indented but not filled.@refill
+
+@item @@lisp
+Illustrate Lisp code. The text is printed in a fixed-width font,
+and indented but not filled.@refill
+
+@item @@smallexample
+Illustrate code, commands, and the like. Similar to
+@code{@@example}, except that in @TeX{} this command typesets text in
+a smaller font for the smaller @code{@@smallbook} format than for the
+8.5 by 11 inch format.@refill
+
+@item @@smalllisp
+Illustrate Lisp code. Similar to @code{@@lisp}, except that
+in @TeX{} this command typesets text in a smaller font for the smaller
+@code{@@smallbook} format than for the 8.5 by 11 inch format.@refill
+
+@item @@display
+Display illustrative text. The text is indented but not filled, and
+no font is specified (so, by default, the font is roman).@refill
+
+@item @@format
+Print illustrative text. The text is not indented and not filled
+and no font is specified (so, by default, the font is roman).@refill
+@end table
+
+The @code{@@exdent} command is used within the above constructs to
+undo the indentation of a line.
+
+The @code{@@flushleft} and @code{@@flushright} commands are used to line
+up the left or right margins of unfilled text.@refill
+
+The @code{@@noindent} command may be used after one of the above
+constructs to prevent the following text from being indented as a new
+paragraph.@refill
+
+You can use the @code{@@cartouche} command within one of the above
+constructs to highlight the example or quotation by drawing a box with
+rounded corners around it. (The @code{@@cartouche} command affects
+only the printed manual; it has no effect in the Info file; see
+@ref{cartouche, , Drawing Cartouches Around Examples}.)@refill
+
+@node quotation, example, Block Enclosing Commands, Quotations and Examples
+@comment node-name, next, previous, up
+@section @code{@@quotation}
+@cindex Quotations
+@findex quotation
+
+The text of a quotation is
+processed normally except that:@refill
+
+@itemize @bullet
+@item
+the margins are closer to the center of the page, so the whole of the
+quotation is indented;@refill
+
+@item
+the first lines of paragraphs are indented no more than other
+lines;@refill
+
+@item
+in the printed output, interparagraph spacing is reduced.@refill
+@end itemize
+
+@quotation
+This is an example of text written between an @code{@@quotation}
+command and an @code{@@end quotation} command. An @code{@@quotation}
+command is most often used to indicate text that is excerpted from
+another (real or hypothetical) printed work.@refill
+@end quotation
+
+Write an @code{@@quotation} command as text on a line by itself. This
+line will disappear from the output. Mark the end of the quotation
+with a line beginning with and containing only @code{@@end quotation}.
+The @code{@@end quotation} line will likewise disappear from the
+output. Thus, the following,@refill
+
+@example
+@@quotation
+This is
+a foo.
+@@end quotation
+@end example
+
+@noindent
+produces
+
+@quotation
+This is a foo.
+@end quotation
+
+@node example, noindent, quotation, Quotations and Examples
+@comment node-name, next, previous, up
+@section @code{@@example}
+@cindex Examples, formatting them
+@cindex Formatting examples
+@findex example
+
+The @code{@@example} command is used to indicate an example that is
+not part of the running text, such as computer input or output.@refill
+
+@example
+@group
+This is an example of text written between an
+@code{@@example} command
+and an @code{@@end example} command.
+The text is indented but not filled.
+@end group
+
+@group
+In the printed manual, the text is typeset in a
+fixed-width font, and extra spaces and blank lines are
+significant. In the Info file, an analogous result is
+obtained by indenting each line with five spaces.
+@end group
+@end example
+
+Write an @code{@@example} command at the beginning of a line by itself.
+This line will disappear from the output. Mark the end of the example
+with an @code{@@end example} command, also written at the beginning of a
+line by itself. The @code{@@end example} will disappear from the
+output.@refill
+
+@need 700
+For example,
+
+@example
+@@example
+mv foo bar
+@@end example
+@end example
+
+@noindent
+produces
+
+@example
+mv foo bar
+@end example
+
+Since the lines containing @code{@@example} and @code{@@end example}
+will disappear, you should put a blank line before the
+@code{@@example} and another blank line after the @code{@@end
+example}. (Remember that blank lines between the beginning
+@code{@@example} and the ending @code{@@end example} will appear in
+the output.)@refill
+
+@quotation
+@strong{Caution:} Do not use tabs in the lines of an example (or anywhere
+else in Texinfo, for that matter)! @TeX{} treats tabs as single
+spaces, and that is not what they look like. This is a problem with
+@TeX{}. (If necessary, in Emacs, you can use @kbd{M-x untabify} to
+convert tabs in a region to multiple spaces.)@refill
+@end quotation
+
+Examples are often, logically speaking, ``in the middle'' of a
+paragraph, and the text continues after an example should not be
+indented. The @code{@@noindent} command prevents a piece of text from
+being indented as if it were a new paragraph.
+@ifinfo
+(@xref{noindent}.)
+@end ifinfo
+
+(The @code{@@code} command is used for examples of code that are
+embedded within sentences, not set off from preceding and following
+text. @xref{code, , @code{@@code}}.)
+
+@node noindent, Lisp Example, example, Quotations and Examples
+@comment node-name, next, previous, up
+@section @code{@@noindent}
+@findex noindent
+
+An example or other inclusion can break a paragraph into segments.
+Ordinarily, the formatters indent text that follows an example as a new
+paragraph. However, you can prevent this by writing @code{@@noindent}
+at the beginning of a line by itself preceding the continuation
+text.@refill
+
+@need 1500
+For example:
+
+@example
+@group
+@@example
+This is an example
+@@end example
+
+@@noindent
+This line is not indented. As you can see, the
+beginning of the line is fully flush left with the line
+that follows after it. (This whole example is between
+@@code@{@@@@display@} and @@code@{@@@@end display@}.)
+@end group
+@end example
+
+@noindent
+produces
+
+@display
+@example
+This is an example
+@end example
+@tex
+% Remove extra vskip; this is a kludge to counter the effect of display
+\vskip-3.5\baselineskip
+@end tex
+
+@noindent
+This line is not indented. As you can see, the
+beginning of the line is fully flush left with the line
+that follows after it. (This whole example is between
+@code{@@display} and @code{@@end display}.)
+@end display
+
+To adjust the number of blank lines properly in the Info file output,
+remember that the line containing @code{@@noindent} does not generate a
+blank line, and neither does the @code{@@end example} line.@refill
+
+In the Texinfo source file for this manual, each line that says
+`produces' is preceded by a line containing @code{@@noindent}.@refill
+
+Do not put braces after an @code{@@noindent} command; they are not
+necessary, since @code{@@noindent} is a command used outside of
+paragraphs (@pxref{Command Syntax}).@refill
+
+@node Lisp Example, smallexample & smalllisp, noindent, Quotations and Examples
+@comment node-name, next, previous, up
+@section @code{@@lisp}
+@cindex Lisp example
+@findex lisp
+
+The @code{@@lisp} command is used for Lisp code. It is synonymous
+with the @code{@@example} command.
+
+@lisp
+This is an example of text written between an
+@code{@@lisp} command and an @code{@@end lisp} command.
+@end lisp
+
+Use @code{@@lisp} instead of @code{@@example} so as to preserve
+information regarding the nature of the example. This is useful, for
+example, if you write a function that evaluates only and all the Lisp
+code in a Texinfo file. Then you can use the Texinfo file as a Lisp
+library.@footnote{It would be straightforward to extend Texinfo to
+work in a similar fashion for C, @sc{fortran}, or other languages.}@refill
+
+Mark the end of @code{@@lisp} with @code{@@end lisp} on a line by
+itself.@refill
+
+@node smallexample & smalllisp, display, Lisp Example, Quotations and Examples
+@comment node-name, next, previous, up
+@section @code{@@smallexample} and @code{@@smalllisp}
+@cindex Small book example
+@cindex Example for a small book
+@cindex Lisp example for a small book
+@findex smallexample
+@findex smalllisp
+
+In addition to the regular @code{@@example} and @code{@@lisp} commands,
+Texinfo has two other ``example-style'' commands. These are the
+@code{@@smallexample} and @code{@@smalllisp} commands. Both these
+commands are designed for use with the @code{@@smallbook} command that
+causes @TeX{} to produce a printed manual in a 7 by 9.25 inch format
+rather than the regular 8.5 by 11 inch format.@refill
+
+In @TeX{}, the @code{@@smallexample} and @code{@@smalllisp} commands
+typeset text in a smaller font for the smaller @code{@@smallbook}
+format than for the 8.5 by 11 inch format. Consequently, many examples
+containing long lines fit in a narrower, @code{@@smallbook} page
+without needing to be shortened. Both commands typeset in the normal
+font size when you format for the 8.5 by 11 inch size; indeed,
+in this situation, the @code{@@smallexample} and @code{@@smalllisp}
+commands are defined to be the @code{@@example} and @code{@@lisp}
+commands.@refill
+
+In Info, the @code{@@smallexample} and @code{@@smalllisp} commands are
+equivalent to the @code{@@example} and @code{@@lisp} commands, and work
+exactly the same.@refill
+
+Mark the end of @code{@@smallexample} or @code{@@smalllisp} with
+@code{@@end smallexample} or @code{@@end smalllisp},
+respectively.@refill
+
+@iftex
+Here is an example written in the small font used by the
+@code{@@smallexample} and @code{@@smalllisp} commands:
+
+@ifclear smallbook
+@display
+@tex
+% Remove extra vskip; this is a kludge to counter the effect of display
+\vskip-3\baselineskip
+{\ninett
+\dots{} 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.}
+@end tex
+@end display
+@end ifclear
+@end iftex
+@ifset smallbook
+@iftex
+@smallexample
+This is an example of text written between @code{@@smallexample} and
+@code{@@end smallexample}. In Info and in an 8.5 by 11 inch manual,
+this text appears in its normal size; but in a 7 by 9.25 inch manual,
+this text appears in a smaller font.
+@end smallexample
+@end iftex
+@end ifset
+@ifinfo
+@smallexample
+This is an example of text written between @code{@@smallexample} and
+@code{@@end smallexample}. In Info and in an 8.5 by 11 inch manual,
+this text appears in its normal size; but in a 7 by 9.25 inch manual,
+this text appears in a smaller font.
+@end smallexample
+@end ifinfo
+
+The @code{@@smallexample} and @code{@@smalllisp} commands make it
+easier to prepare smaller format manuals without forcing you to edit
+examples by hand to fit them onto narrower pages.@refill
+
+As a general rule, a printed document looks better if you write all the
+examples in a chapter consistently in @code{@@example} or in
+@code{@@smallexample}. Only occasionally should you mix the two
+formats.@refill
+
+@xref{smallbook, , Printing ``Small'' Books}, for more information
+about the @code{@@smallbook} command.@refill
+
+@node display, format, smallexample & smalllisp, Quotations and Examples
+@comment node-name, next, previous, up
+@section @code{@@display}
+@cindex Display formatting
+@findex display
+
+The @code{@@display} command begins a kind of example. It is like the
+@code{@@example} command
+except that, in
+a printed manual, @code{@@display} does not select the fixed-width
+font. In fact, it does not specify the font at all, so that the text
+appears in the same font it would have appeared in without the
+@code{@@display} command.@refill
+
+@display
+This is an example of text written between an @code{@@display} command
+and an @code{@@end display} command. The @code{@@display} command
+indents the text, but does not fill it.
+@end display
+
+@node format, exdent, display, Quotations and Examples
+@comment node-name, next, previous, up
+@section @code{@@format}
+@findex format
+
+The @code{@@format} command is similar to @code{@@example} except
+that, in the printed manual, @code{@@format} does not select the
+fixed-width font and does not narrow the margins.@refill
+
+@format
+This is an example of text written between an @code{@@format} command
+and an @code{@@end format} command. As you can see
+from this example,
+the @code{@@format} command does not fill the text.
+@end format
+
+@node exdent, flushleft & flushright, format, Quotations and Examples
+@section @code{@@exdent}: Undoing a Line's Indentation
+@cindex Indentation undoing
+@findex exdent
+
+The @code{@@exdent} command removes any indentation a line might have.
+The command is written at the beginning of a line and applies only to
+the text that follows the command that is on the same line. Do not use
+braces around the text. In a printed manual, the text on an
+@code{@@exdent} line is printed in the roman font.@refill
+
+@code{@@exdent} is usually used within examples. Thus,@refill
+
+@example
+@group
+@@example
+This line follows an @@@@example command.
+@@exdent This line is exdented.
+This line follows the exdented line.
+The @@@@end example comes on the next line.
+@@end group
+@end group
+@end example
+
+@noindent
+produces
+
+@example
+@group
+This line follows an @@example command.
+@exdent This line is exdented.
+This line follows the exdented line.
+The @@end example comes on the next line.
+@end group
+@end example
+
+In practice, the @code{@@exdent} command is rarely used.
+Usually, you un-indent text by ending the example and
+returning the page to its normal width.@refill
+
+@node flushleft & flushright, cartouche, exdent, Quotations and Examples
+@section @code{@@flushleft} and @code{@@flushright}
+@findex flushleft
+@findex flushright
+
+The @code{@@flushleft} and @code{@@flushright} commands line up the
+ends of lines on the left and right margins of a page,
+but do not fill the text. The commands are written on lines of their
+own, without braces. The @code{@@flushleft} and @code{@@flushright}
+commands are ended by @code{@@end flushleft} and @code{@@end
+flushright} commands on lines of their own.@refill
+
+@need 1500
+For example,
+
+@example
+@group
+@@flushleft
+This text is
+written flushleft.
+@@end flushleft
+@end group
+@end example
+
+@noindent
+produces
+
+@quotation
+@flushleft
+This text is
+written flushleft.
+@end flushleft
+@end quotation
+
+
+Flushright produces the type of indentation often used in the return
+address of letters.@refill
+
+@need 1500
+@noindent
+For example,
+
+@example
+@group
+@@flushright
+Here is an example of text written
+flushright. The @@code@{@@flushright@} command
+right justifies every line but leaves the
+left end ragged.
+@@end flushright
+@end group
+@end example
+
+@noindent
+produces
+
+@flushright
+Here is an example of text written
+flushright. The @code{@@flushright} command
+right justifies every line but leaves the
+left end ragged.
+@end flushright
+
+@node cartouche, , flushleft & flushright, Quotations and Examples
+@section Drawing Cartouches Around Examples
+@findex cartouche
+@cindex Box with rounded corners
+
+In a printed manual, the @code{@@cartouche} command draws a box with
+rounded corners around its contents. You can use this command to
+further highlight an example or quotation. For instance, you could
+write a manual in which one type of example is surrounded by a cartouche
+for emphasis.@refill
+
+The @code{@@cartouche} command affects only the printed manual; it has
+no effect in the Info file.@refill
+
+@need 1500
+For example,
+
+@example
+@group
+@@example
+@@cartouche
+% pwd
+/usr/local/lib/emacs/info
+@@end cartouche
+@@end example
+@end group
+@end example
+
+@noindent
+surrounds the two-line example with a box with rounded corners, in the
+printed manual.
+
+@iftex
+In a printed manual, the example looks like this:@refill
+
+@example
+@group
+@cartouche
+% pwd
+/usr/local/lib/emacs/info
+@end cartouche
+@end group
+@end example
+@end iftex
+
+@node Lists and Tables, Indices, Quotations and Examples, Top
+@comment node-name, next, previous, up
+@chapter Making Lists and Tables
+@cindex Making lists and tables
+@cindex Lists and tables, making them
+@cindex Tables and lists, making them
+
+Texinfo has several ways of making lists and two-column tables. Lists can
+be bulleted or numbered, while two-column tables can highlight the items in
+the first column.@refill
+
+@menu
+* Introducing Lists:: Texinfo formats lists for you.
+* itemize:: How to construct a simple list.
+* enumerate:: How to construct a numbered list.
+* Two-column Tables:: How to construct a two-column table.
+* Multi-column Tables:: How to construct generalized tables.
+@end menu
+
+@ifinfo
+@node Introducing Lists, itemize, Lists and Tables, Lists and Tables
+@heading Introducing Lists
+@end ifinfo
+
+Texinfo automatically indents the text in lists or tables, and numbers
+an enumerated list. This last feature is useful if you modify the
+list, since you do not need to renumber it yourself.@refill
+
+Numbered lists and tables begin with the appropriate @@-command at the
+beginning of a line, and end with the corresponding @code{@@end}
+command on a line by itself. The table and itemized-list commands
+also require that you write formatting information on the same line as
+the beginning @@-command.@refill
+
+Begin an enumerated list, for example, with an @code{@@enumerate}
+command and end the list with an @code{@@end enumerate} command.
+Begin an itemized list with an @code{@@itemize} command, followed on
+the same line by a formatting command such as @code{@@bullet}, and end
+the list with an @code{@@end itemize} command.@refill
+@findex end
+
+Precede each element of a list with an @code{@@item} or @code{@@itemx}
+command.@refill
+
+@sp 1
+@noindent
+Here is an itemized list of the different kinds of table and lists:@refill
+
+@itemize @bullet
+@item
+Itemized lists with and without bullets.
+
+@item
+Enumerated lists, using numbers or letters.
+
+@item
+Two-column tables with highlighting.
+@end itemize
+
+@sp 1
+@noindent
+Here is an enumerated list with the same items:@refill
+
+@enumerate
+@item
+Itemized lists with and without bullets.
+
+@item
+Enumerated lists, using numbers or letters.
+
+@item
+Two-column tables with highlighting.
+@end enumerate
+
+@sp 1
+@noindent
+And here is a two-column table with the same items and their
+@w{@@-commands}:@refill
+
+@table @code
+@item @@itemize
+Itemized lists with and without bullets.
+
+@item @@enumerate
+Enumerated lists, using numbers or letters.
+
+@item @@table
+@itemx @@ftable
+@itemx @@vtable
+Two-column tables with indexing.
+@end table
+
+@node itemize, enumerate, Introducing Lists, Lists and Tables
+@comment node-name, next, previous, up
+@section Making an Itemized List
+@cindex Itemization
+@findex itemize
+
+The @code{@@itemize} command produces sequences of indented
+paragraphs, with a bullet or other mark inside the left margin
+at the beginning of each paragraph for which such a mark is desired.@refill
+
+Begin an itemized list by writing @code{@@itemize} at the beginning of
+a line. Follow the command, on the same line, with a character or a
+Texinfo command that generates a mark. Usually, you will write
+@code{@@bullet} after @code{@@itemize}, but you can use
+@code{@@minus}, or any character or any special symbol that results in
+a single character in the Info file. (When you write @code{@@bullet}
+or @code{@@minus} after an @code{@@itemize} command, you may omit the
+@samp{@{@}}.)@refill
+
+Write the text of the indented paragraphs themselves after the
+@code{@@itemize}, up to another line that says @code{@@end
+itemize}.@refill
+
+Before each paragraph for which a mark in the margin is desired, write
+a line that says just @code{@@item}. Do not write any other text on this
+line.@refill
+@findex item
+
+Usually, you should put a blank line before an @code{@@item}. This
+puts a blank line in the Info file. (@TeX{} inserts the proper
+interline whitespace in either case.) Except when the entries are
+very brief, these blank lines make the list look better.@refill
+
+Here is an example of the use of @code{@@itemize}, followed by the
+output it produces. Note that @code{@@bullet} produces an @samp{*} in
+Info and a round dot in @TeX{}.@refill
+
+@example
+@group
+@@itemize @@bullet
+@@item
+Some text for foo.
+
+@@item
+Some text
+for bar.
+@@end itemize
+@end group
+@end example
+
+@noindent
+This produces:
+
+@quotation
+@itemize @bullet
+@item
+Some text for foo.
+
+@item
+Some text
+for bar.
+@end itemize
+@end quotation
+
+Itemized lists may be embedded within other itemized lists. Here is a
+list marked with dashes embedded in a list marked with bullets:@refill
+
+@example
+@group
+@@itemize @@bullet
+@@item
+First item.
+
+@@itemize @@minus
+@@item
+Inner item.
+
+@@item
+Second inner item.
+@@end itemize
+
+@@item
+Second outer item.
+@@end itemize
+@end group
+@end example
+
+@noindent
+This produces:
+
+@quotation
+@itemize @bullet
+@item
+First item.
+
+@itemize @minus
+@item
+Inner item.
+
+@item
+Second inner item.
+@end itemize
+
+@item
+Second outer item.
+@end itemize
+@end quotation
+
+@node enumerate, Two-column Tables, itemize, Lists and Tables
+@comment node-name, next, previous, up
+@section Making a Numbered or Lettered List
+@cindex Enumeration
+@findex enumerate
+
+@code{@@enumerate} is like @code{@@itemize} except that the marks in
+the left margin contain successive integers or letters.
+(@xref{itemize, , @code{@@itemize}}.)@refill
+
+Write the @code{@@enumerate} command at the beginning of a line.
+The command does not require an argument, but accepts either a number or
+a letter as an option.
+Without an argument, @code{@@enumerate} starts the list
+with the number 1. With a numeric argument, such as 3,
+the command starts the list with that number.
+With an upper or lower case letter, such as @kbd{a} or @kbd{A},
+the command starts the list with that letter.@refill
+
+Write the text of the enumerated list in the same way you write an
+itemized list: put @code{@@item} on a line of its own before the start of
+each paragraph that you want enumerated. Do not write any other text on
+the line beginning with @code{@@item}.@refill
+
+You should put a blank line between entries in the list.
+This generally makes it easier to read the Info file.@refill
+
+@need 1500
+Here is an example of @code{@@enumerate} without an argument:@refill
+
+@example
+@group
+@@enumerate
+@@item
+Underlying causes.
+
+@@item
+Proximate causes.
+@@end enumerate
+@end group
+@end example
+
+@noindent
+This produces:
+
+@enumerate
+@item
+Underlying causes.
+
+@item
+Proximate causes.
+@end enumerate
+@sp 1
+Here is an example with an argument of @kbd{3}:@refill
+@sp 1
+@example
+@group
+@@enumerate 3
+@@item
+Predisposing causes.
+
+@@item
+Precipitating causes.
+
+@@item
+Perpetuating causes.
+@@end enumerate
+@end group
+@end example
+
+@noindent
+This produces:
+
+@enumerate 3
+@item
+Predisposing causes.
+
+@item
+Precipitating causes.
+
+@item
+Perpetuating causes.
+@end enumerate
+@sp 1
+Here is a brief summary of the alternatives. The summary is constructed
+using @code{@@enumerate} with an argument of @kbd{a}.@refill
+@sp 1
+@enumerate a
+@item
+@code{@@enumerate}
+
+Without an argument, produce a numbered list, starting with the number
+1.@refill
+
+@item
+@code{@@enumerate @var{positive-integer}}
+
+With a (positive) numeric argument, start a numbered list with that
+number. You can use this to continue a list that you interrupted with
+other text.@refill
+
+@item
+@code{@@enumerate @var{upper-case-letter}}
+
+With an upper case letter as argument, start a list
+in which each item is marked
+by a letter, beginning with that upper case letter.@refill
+
+@item
+@code{@@enumerate @var{lower-case-letter}}
+
+With a lower case letter as argument, start a list
+in which each item is marked by
+a letter, beginning with that lower case letter.@refill
+@end enumerate
+
+You can also nest enumerated lists, as in an outline.@refill
+
+@node Two-column Tables, Multi-column Tables, enumerate, Lists and Tables
+@section Making a Two-column Table
+@cindex Tables, making two-column
+@findex table
+
+@code{@@table} is similar to @code{@@itemize}, but the command allows
+you to specify a name or heading line for each item. (@xref{itemize,
+, @code{@@itemize}}.) The @code{@@table} command is used to produce
+two-column tables, and is especially useful for glossaries and
+explanatory exhibits.@refill
+
+@menu
+* table:: How to construct a two-column table.
+* ftable vtable:: How to construct a two-column table
+ with automatic indexing.
+* itemx:: How to put more entries in the first column.
+@end menu
+
+@ifinfo
+@node table, ftable vtable, Two-column Tables, Two-column Tables
+@subheading Using the @code{@@table} Command
+
+Use the @code{@@table} command to produce two-column tables.@refill
+@end ifinfo
+
+Write the @code{@@table} command at the beginning of a line and follow
+it on the same line with an argument that is a Texinfo command such as
+@code{@@code}, @code{@@samp}, @code{@@var}, or @code{@@kbd}.
+Although these commands are usually followed by arguments in braces,
+in this case you use the command name without an argument because
+@code{@@item} will supply the argument. This command will be applied
+to the text that goes into the first column of each item and
+determines how it will be highlighted. For example, @code{@@samp}
+will cause the text in the first column to be highlighted with an
+@code{@@samp} command.@refill
+
+You may also choose to use the @code{@@asis} command as an argument to
+@code{@@table}. @code{@@asis} is a command that does nothing; if you use this
+command after @code{@@table}, @TeX{} and the Info formatting commands
+output the first column entries without added highlighting (`as
+is').@refill
+
+(The @code{@@table} command may work with other commands besides those
+listed here. However, you can only use commands
+that normally take arguments in braces.)@refill
+
+Begin each table entry with an @code{@@item} command at the beginning
+of a line. Write the first column text on the same line as the
+@code{@@item} command. Write the second column text on the line
+following the @code{@@item} line and on subsequent lines. (You do not
+need to type anything for an empty second column entry.) You may
+write as many lines of supporting text as you wish, even several
+paragraphs. But only text on the same line as the @code{@@item} will
+be placed in the first column.@refill
+@findex item
+
+Normally, you should put a blank line before an @code{@@item} line.
+This puts a blank like in the Info file. Except when the entries are
+very brief, a blank line looks better.@refill
+
+@need 1500
+The following table, for example, highlights the text in the first
+column with an @code{@@samp} command:@refill
+
+@example
+@group
+@@table @@samp
+@@item foo
+This is the text for
+@@samp@{foo@}.
+
+@@item bar
+Text for @@samp@{bar@}.
+@@end table
+@end group
+@end example
+
+@noindent
+This produces:
+
+@table @samp
+@item foo
+This is the text for
+@samp{foo}.
+@item bar
+Text for @samp{bar}.
+@end table
+
+If you want to list two or more named items with a single block of
+text, use the @code{@@itemx} command. (@xref{itemx, ,
+@code{@@itemx}}.)@refill
+
+@node ftable vtable, itemx, table, Two-column Tables
+@comment node-name, next, previous, up
+@subsection @code{@@ftable} and @code{@@vtable}
+@cindex Tables with indexes
+@cindex Indexing table entries automatically
+@findex ftable
+@findex vtable
+
+The @code{@@ftable} and @code{@@vtable} commands are the same as the
+@code{@@table} command except that @code{@@ftable} automatically enters
+each of the items in the first column of the table into the index of
+functions and @code{@@vtable} automatically enters each of the items in
+the first column of the table into the index of variables. This
+simplifies the task of creating indices. Only the items on the same
+line as the @code{@@item} commands are indexed, and they are indexed in
+exactly the form that they appear on that line. @xref{Indices, ,
+Creating Indices}, for more information about indices.@refill
+
+Begin a two-column table using @code{@@ftable} or @code{@@vtable} by
+writing the @@-command at the beginning of a line, followed on the same
+line by an argument that is a Texinfo command such as @code{@@code},
+exactly as you would for an @code{@@table} command; and end the table
+with an @code{@@end ftable} or @code{@@end vtable} command on a line by
+itself.
+
+See the example for @code{@@table} in the previous section.
+
+@node itemx, , ftable vtable, Two-column Tables
+@comment node-name, next, previous, up
+@subsection @code{@@itemx}
+@cindex Two named items for @code{@@table}
+@findex itemx
+
+Use the @code{@@itemx} command inside a table when you have two or
+more first column entries for the same item, each of which should
+appear on a line of its own. Use @code{@@itemx} for all but the first
+entry. The @code{@@itemx} command works exactly like @code{@@item}
+except that it does not generate extra vertical space above the first
+column text.@refill
+
+@need 1000
+For example,
+
+@example
+@group
+@@table @@code
+@@item upcase
+@@itemx downcase
+These two functions accept a character or a string as
+argument, and return the corresponding upper case (lower
+case) character or string.
+@@end table
+@end group
+@end example
+
+@noindent
+This produces:
+
+@table @code
+@item upcase
+@itemx downcase
+These two functions accept a character or a string as
+argument, and return the corresponding upper case (lower
+case) character or string.@refill
+@end table
+
+@noindent
+(Note also that this example illustrates multi-line supporting text in
+a two-column table.)@refill
+
+
+@node Multi-column Tables, , Two-column Tables, Lists and Tables
+@section Multi-column Tables
+@cindex Tables, making multi-column
+@findex multitable
+
+@code{@@multitable} allows you to construct tables with any number of
+columns, with each column having any width you like.
+
+You define the column widths on the @code{@@multitable} line itself, and
+write each row of the actual table following an @code{@@item} command,
+with columns separated by an @code{@@tab} command. Finally, @code{@@end
+multitable} completes the table. Details in the sections below.
+
+@menu
+* Multitable Column Widths:: Defining multitable column widths.
+* Multitable Rows:: Defining multitable rows, with examples.
+@end menu
+
+@node Multitable Column Widths, Multitable Rows, Multi-column Tables, Multi-column Tables
+@subsection Multitable Column Widths
+@cindex Multitable column widths
+@cindex Column widths, defining for multitables
+@cindex Widths, defining multitable column
+
+You can define the column widths for a multitable in two ways: as
+fractions of the line length; or with a prototype row. Mixing the two
+methods is not supported. In either case, the widths are defined
+entirely on the same line as the @code{@@multitable} command.
+
+@enumerate
+@item
+@findex columnfractions
+@cindex Line length, column widths as fraction of
+To specify column widths as fractions of the line length, write
+@code{@@columnfractions} and the decimal numbers (presumably less than
+1) after the @code{@@multitable} command, as in:
+
+@example
+@@multitable @@columnfractions .33 .33 .33
+@end example
+
+@noindent The fractions need not add up exactly to 1.0, as these do
+not. This allows you to produce tables that do not need the full line
+length.
+
+@item
+@cindex Prototype row, column widths defined by
+To specify a prototype row, write the longest entry for each column
+enclosed in braces after the @code{@@multitable} command. For example:
+
+@example
+@@multitable @{some text for column one@} @{for column two@}
+@end example
+
+@noindent
+The first column will then have the width of the typeset `some text for
+column one', and the second column the width of `for column two'.
+
+The prototype entries need not appear in the table itself.
+
+Although we used simple text in this example, the prototype entries can
+contain Texinfo commands; markup commands such as @code{@@code} are
+particularly likely to be useful.
+
+@end enumerate
+
+
+@node Multitable Rows, , Multitable Column Widths, Multi-column Tables
+@subsection Multitable Rows
+@cindex Multitable rows
+@cindex Rows, of a multitable
+
+@findex item
+@cindex tab
+After the @code{@@multitable} command defining the column widths (see
+the previous section), you begin each row in the body of a multitable
+with @code{@@item}, and separate the column entries with @code{@@tab}.
+Line breaks are not special within the table body, and you may break
+input lines in your source file as necessary.
+
+Here is a complete example of a multi-column table (the text is from
+the GNU Emacs manual):
+
+@example
+@@multitable @@columnfractions .15 .45 .4
+@@item Key @@tab Command @@tab Description
+@@item C-x 2
+@@tab @@code@{split-window-vertically@}
+@@tab Split the selected window into two windows,
+with one above the other.
+@@item C-x 3
+@@tab @@code@{split-window-horizontally@}
+@@tab Split the selected window into two windows
+positioned side by side.
+@@item C-Mouse-2
+@@tab
+@@tab In the mode line or scroll bar of a window,
+split that window.
+@@end multitable
+@end example
+
+@noindent produces:
+
+@multitable @columnfractions .15 .45 .4
+@item Key @tab Command @tab Description
+@item C-x 2
+@tab @code{split-window-vertically}
+@tab Split the selected window into two windows,
+with one above the other.
+@item C-x 3
+@tab @code{split-window-horizontally}
+@tab Split the selected window into two windows
+positioned side by side.
+@item C-Mouse-2
+@tab
+@tab In the mode line or scroll bar of a window,
+split that window.
+@end multitable
+
+
+@node Indices, Insertions, Lists and Tables, Top
+@comment node-name, next, previous, up
+@chapter Creating Indices
+@cindex Indices
+@cindex Creating indices
+
+Using Texinfo, you can generate indices without having to sort and
+collate entries manually. In an index, the entries are listed in
+alphabetical order, together with information on how to find the
+discussion of each entry. In a printed manual, this information
+consists of page numbers. In an Info file, this information is a menu
+entry leading to the first node referenced.@refill
+
+Texinfo provides several predefined kinds of index: an index
+for functions, an index for variables, an index for concepts, and so
+on. You can combine indices or use them for other than their
+canonical purpose. If you wish, you can define your own indices.@refill
+
+@menu
+* Index Entries:: Choose different words for index entries.
+* Predefined Indices:: Use different indices for different kinds
+ of entry.
+* Indexing Commands:: How to make an index entry.
+* Combining Indices:: How to combine indices.
+* New Indices:: How to define your own indices.
+@end menu
+
+@node Index Entries, Predefined Indices, Indices, Indices
+@comment node-name, next, previous, up
+@section Making Index Entries
+@cindex Index entries, making
+@cindex Entries, making index
+
+When you are making index entries, it is good practice to think of the
+different ways people may look for something. Different people
+@emph{do not} think of the same words when they look something up. A
+helpful index will have items indexed under all the different words
+that people may use. For example, one reader may think it obvious that
+the two-letter names for indices should be listed under ``Indices,
+two-letter names'', since the word ``Index'' is the general concept.
+But another reader may remember the specific concept of two-letter
+names and search for the entry listed as ``Two letter names for
+indices''. A good index will have both entries and will help both
+readers.@refill
+
+Like typesetting, the construction of an index is a highly skilled,
+professional art, the subtleties of which are not appreciated until you
+need to do it yourself.@refill
+
+@xref{Printing Indices & Menus}, for information about printing an index
+at the end of a book or creating an index menu in an Info file.@refill
+
+@node Predefined Indices, Indexing Commands, Index Entries, Indices
+@comment node-name, next, previous, up
+@section Predefined Indices
+
+Texinfo provides six predefined indices:@refill
+
+@itemize @bullet
+@item
+A @dfn{concept index} listing concepts that are discussed.@refill
+
+@item
+A @dfn{function index} listing functions (such as entry points of
+libraries).@refill
+
+@item
+A @dfn{variables index} listing variables (such as global variables
+of libraries).@refill
+
+@item
+A @dfn{keystroke index} listing keyboard commands.@refill
+
+@item
+A @dfn{program index} listing names of programs.@refill
+
+@item
+A @dfn{data type index} listing data types (such as structures defined in
+header files).@refill
+@end itemize
+
+@noindent
+Not every manual needs all of these, and most manuals use two or three
+of them. This manual has two indices: a
+concept index and an @@-command index (that is actually the function
+index but is called a command index in the chapter heading). Two or
+more indices can be combined into one using the @code{@@synindex} or
+@code{@@syncodeindex} commands. @xref{Combining Indices}.@refill
+
+@node Indexing Commands, Combining Indices, Predefined Indices, Indices
+@comment node-name, next, previous, up
+@section Defining the Entries of an Index
+@cindex Defining indexing entries
+@cindex Index entries
+@cindex Entries for an index
+@cindex Specifying index entries
+@cindex Creating index entries
+
+The data to make an index come from many individual indexing commands
+scattered throughout the Texinfo source file. Each command says to add
+one entry to a particular index; after formatting, the index will give
+the current page number or node name as the reference.@refill
+
+An index entry consists of an indexing command at the beginning of a
+line followed, on the rest of the line, by the entry.@refill
+
+For example, this section begins with the following five entries for
+the concept index:@refill
+
+@example
+@@cindex Defining indexing entries
+@@cindex Index entries
+@@cindex Entries for an index
+@@cindex Specifying index entries
+@@cindex Creating index entries
+@end example
+
+Each predefined index has its own indexing command---@code{@@cindex}
+for the concept index, @code{@@findex} for the function index, and so
+on.@refill
+
+@cindex Writing index entries
+@cindex Index entry writing
+Concept index entries consist of text. The best way to write an index
+is to choose entries that are terse yet clear. If you can do this,
+the index often looks better if the entries are not capitalized, but
+written just as they would appear in the middle of a sentence.
+(Capitalize proper names and acronyms that always call for upper case
+letters.) This is the case convention we use in most GNU manuals'
+indices.
+
+If you don't see how to make an entry terse yet clear, make it longer
+and clear---not terse and confusing. If many of the entries are several
+words long, the index may look better if you use a different convention:
+to capitalize the first word of each entry. But do not capitalize a
+case-sensitive name such as a C or Lisp function name or a shell
+command; that would be a spelling error.
+
+Whichever case convention you use, please use it consistently!
+
+@ignore
+Concept index entries consist of English text. The usual convention
+is to capitalize the first word of each such index entry, unless that
+word is the name of a function, variable, or other such entity that
+should not be capitalized. However, if your concept index entries are
+consistently short (one or two words each) it may look better for each
+regular entry to start with a lower case letter, aside from proper
+names and acronyms that always call for upper case letters. Whichever
+convention you adapt, please be consistent!
+@end ignore
+
+Entries in indices other than the concept index are symbol names in
+programming languages, or program names; these names are usually
+case-sensitive, so use upper and lower case as required for them.
+
+By default, entries for a concept index are printed in a small roman
+font and entries for the other indices are printed in a small
+@code{@@code} font. You may change the way part of an entry is
+printed with the usual Texinfo commands, such as @code{@@file} for
+file names and @code{@@emph} for emphasis (@pxref{Marking
+Text}).@refill
+@cindex Index font types
+
+@cindex Predefined indexing commands
+@cindex Indexing commands, predefined
+The six indexing commands for predefined indices are:
+
+@table @code
+@item @@cindex @var{concept}
+@findex cindex
+Make an entry in the concept index for @var{concept}.@refill
+
+@item @@findex @var{function}
+@findex findex
+Make an entry in the function index for @var{function}.@refill
+
+@item @@vindex @var{variable}
+@findex vindex
+Make an entry in the variable index for @var{variable}.@refill
+
+@item @@kindex @var{keystroke}
+@findex kindex
+Make an entry in the key index for @var{keystroke}.@refill
+
+@item @@pindex @var{program}
+@findex pindex
+Make an entry in the program index for @var{program}.@refill
+
+@item @@tindex @var{data type}
+@findex tindex
+Make an entry in the data type index for @var{data type}.@refill
+@end table
+
+@quotation
+@strong{Caution:} Do not use a colon in an index entry. In Info, a
+colon separates the menu entry name from the node name. An extra
+colon confuses Info.
+@xref{Menu Parts, , The Parts of a Menu},
+for more information about the structure of a menu entry.@refill
+@end quotation
+
+If you write several identical index entries in different places in a
+Texinfo file, the index in the printed manual will list all the pages to
+which those entries refer. However, the index in the Info file will
+list @strong{only} the node that references the @strong{first} of those
+index entries. Therefore, it is best to write indices in which each
+entry refers to only one place in the Texinfo file. Fortunately, this
+constraint is a feature rather than a loss since it means that the index
+will be easy to use. Otherwise, you could create an index that lists
+several pages for one entry and your reader would not know to which page
+to turn. If you have two identical entries for one topic, change the
+topics slightly, or qualify them to indicate the difference.@refill
+
+You are not actually required to use the predefined indices for their
+canonical purposes. For example, suppose you wish to index some C
+preprocessor macros. You could put them in the function index along
+with actual functions, just by writing @code{@@findex} commands for
+them; then, when you print the ``Function Index'' as an unnumbered
+chapter, you could give it the title `Function and Macro Index' and
+all will be consistent for the reader. Or you could put the macros in
+with the data types by writing @code{@@tindex} commands for them, and
+give that index a suitable title so the reader will understand.
+(@xref{Printing Indices & Menus}.)@refill
+
+@node Combining Indices, New Indices, Indexing Commands, Indices
+@comment node-name, next, previous, up
+@section Combining Indices
+@cindex Combining indices
+@cindex Indices, combining them
+
+Sometimes you will want to combine two disparate indices such as functions
+and concepts, perhaps because you have few enough of one of them that
+a separate index for them would look silly.@refill
+
+You could put functions into the concept index by writing
+@code{@@cindex} commands for them instead of @code{@@findex} commands,
+and produce a consistent manual by printing the concept index with the
+title `Function and Concept Index' and not printing the `Function
+Index' at all; but this is not a robust procedure. It works only if
+your document is never included as part of another
+document that is designed to have a separate function index; if your
+document were to be included with such a document, the functions from
+your document and those from the other would not end up together.
+Also, to make your function names appear in the right font in the
+concept index, you would need to enclose every one of them between
+the braces of @code{@@code}.@refill
+
+@menu
+* syncodeindex:: How to merge two indices, using @code{@@code}
+ font for the merged-from index.
+* synindex:: How to merge two indices, using the
+ default font of the merged-to index.
+@end menu
+
+@node syncodeindex, synindex, Combining Indices, Combining Indices
+@subsection @code{@@syncodeindex}
+@findex syncodeindex
+
+When you want to combine functions and concepts into one index, you
+should index the functions with @code{@@findex} and index the concepts
+with @code{@@cindex}, and use the @code{@@syncodeindex} command to
+redirect the function index entries into the concept index.@refill
+@findex syncodeindex
+
+The @code{@@syncodeindex} command takes two arguments; they are the name
+of the index to redirect, and the name of the index to redirect it to.
+The template looks like this:@refill
+
+@example
+@@syncodeindex @var{from} @var{to}
+@end example
+
+@cindex Predefined names for indices
+@cindex Two letter names for indices
+@cindex Indices, two letter names
+@cindex Names for indices
+For this purpose, the indices are given two-letter names:@refill
+
+@table @samp
+@item cp
+concept index
+@item fn
+function index
+@item vr
+variable index
+@item ky
+key index
+@item pg
+program index
+@item tp
+data type index
+@end table
+
+Write an @code{@@syncodeindex} command before or shortly after the
+end-of-header line at the beginning of a Texinfo file. For example,
+to merge a function index with a concept index, write the
+following:@refill
+
+@example
+@@syncodeindex fn cp
+@end example
+
+@noindent
+This will cause all entries designated for the function index to merge
+in with the concept index instead.@refill
+
+To merge both a variables index and a function index into a concept
+index, write the following:@refill
+
+@example
+@group
+@@syncodeindex vr cp
+@@syncodeindex fn cp
+@end group
+@end example
+
+@cindex Fonts for indices
+The @code{@@syncodeindex} command puts all the entries from the `from'
+index (the redirected index) into the @code{@@code} font, overriding
+whatever default font is used by the index to which the entries are
+now directed. This way, if you direct function names from a function
+index into a concept index, all the function names are printed in the
+@code{@@code} font as you would expect.@refill
+
+@node synindex, , syncodeindex, Combining Indices
+@subsection @code{@@synindex}
+@findex synindex
+
+The @code{@@synindex} command is nearly the same as the
+@code{@@syncodeindex} command, except that it does not put the
+`from' index entries into the @code{@@code} font; rather it puts
+them in the roman font. Thus, you use @code{@@synindex} when you
+merge a concept index into a function index.@refill
+
+@xref{Printing Indices & Menus}, for information about printing an index
+at the end of a book or creating an index menu in an Info file.@refill
+
+@node New Indices, , Combining Indices, Indices
+@section Defining New Indices
+@cindex Defining new indices
+@cindex Indices, defining new
+@cindex New index defining
+@findex defindex
+@findex defcodeindex
+
+In addition to the predefined indices, you may use the
+@code{@@defindex} and @code{@@defcodeindex} commands to define new
+indices. These commands create new indexing @@-commands with which
+you mark index entries. The @code{@@defindex }command is used like
+this:@refill
+
+@example
+@@defindex @var{name}
+@end example
+
+The name of an index should be a two letter word, such as @samp{au}.
+For example:@refill
+
+@example
+@@defindex au
+@end example
+
+This defines a new index, called the @samp{au} index. At the same
+time, it creates a new indexing command, @code{@@auindex}, that you
+can use to make index entries. Use the new indexing command just as
+you would use a predefined indexing command.@refill
+
+For example, here is a section heading followed by a concept index
+entry and two @samp{au} index entries.@refill
+
+@example
+@@section Cognitive Semantics
+@@cindex kinesthetic image schemas
+@@auindex Johnson, Mark
+@@auindex Lakoff, George
+@end example
+
+@noindent
+(Evidently, @samp{au} serves here as an abbreviation for ``author''.)
+Texinfo constructs the new indexing command by concatenating the name
+of the index with @samp{index}; thus, defining an @samp{au} index
+leads to the automatic creation of an @code{@@auindex} command.@refill
+
+Use the @code{@@printindex} command to print the index, as you do with
+the predefined indices. For example:@refill
+
+@example
+@group
+@@node Author Index, Subject Index, , Top
+@@unnumbered Author Index
+
+@@printindex au
+@end group
+@end example
+
+The @code{@@defcodeindex} is like the @code{@@defindex} command, except
+that, in the printed output, it prints entries in an @code{@@code} font
+instead of a roman font. Thus, it parallels the @code{@@findex} command
+rather than the @code{@@cindex} command.@refill
+
+You should define new indices within or right after the end-of-header
+line of a Texinfo file, before any @code{@@synindex} or
+@code{@@syncodeindex} commands (@pxref{Header}).@refill
+
+@node Insertions, Glyphs, Indices, Top
+@comment node-name, next, previous, up
+@chapter Special Insertions
+@cindex Inserting special characters and symbols
+@cindex Special insertions
+
+Texinfo provides several commands for formatting dimensions, for
+inserting single characters that have special meaning in Texinfo, such
+as braces, and for inserting special graphic symbols that do not
+correspond to characters, such as dots and bullets.@refill
+
+@iftex
+These are:
+
+@itemize @bullet
+@item
+Braces, @samp{@@} and periods.
+
+@item
+Format a dimension, such as @samp{12@dmn{pt}}.
+
+@item
+Dots and bullets.
+
+@item
+The @TeX{} logo and the copyright symbol.
+
+@item
+A minus sign.
+@end itemize
+@end iftex
+
+@menu
+* Braces Atsigns:: How to insert braces, @samp{@@}.
+* Inserting Space:: How to insert the right amount of space
+ within a sentence.
+* Inserting Accents:: How to insert accents and special characters.
+* Dots Bullets:: How to insert dots and bullets.
+* TeX and copyright:: How to insert the @TeX{} logo
+ and the copyright symbol.
+* pounds:: How to insert the pounds currency symbol.
+* minus:: How to insert a minus sign.
+* math:: How to format a mathematical expression.
+@end menu
+
+
+@node Braces Atsigns, Inserting Space, Insertions, Insertions
+@section Inserting @@ and Braces
+@cindex Inserting @@, braces
+@cindex Braces, inserting
+@cindex Special characters, commands to insert
+@cindex Commands to insert special characters
+
+@samp{@@} and curly braces are special characters in Texinfo. To insert
+these characters so they appear in text, you must put an @samp{@@} in
+front of these characters to prevent Texinfo from misinterpreting
+them.
+
+Do not put braces after any of these commands; they are not
+necessary.
+
+@menu
+* Inserting An Atsign:: How to insert @samp{@@}.
+* Inserting Braces:: How to insert @samp{@{} and @samp{@}}.
+@end menu
+
+@node Inserting An Atsign, Inserting Braces, Braces Atsigns, Braces Atsigns
+@subsection Inserting @samp{@@} with @@@@
+@findex @@ @r{(single @samp{@@})}
+
+@code{@@@@} stands for a single @samp{@@} in either printed or Info
+output.
+
+Do not put braces after an @code{@@@@} command.
+
+@node Inserting Braces, , Inserting An Atsign, Braces Atsigns
+@subsection Inserting @samp{@{} and @samp{@}}with @@@{ and @@@}
+@findex @{ @r{(single @samp{@{})}
+@findex @} @r{(single @samp{@}})}
+
+@code{@@@{} stands for a single @samp{@{} in either printed or Info
+output.
+
+@code{@@@}} stands for a single @samp{@}} in either printed or Info
+output.
+
+Do not put braces after either an @code{@@@{} or an @code{@@@}}
+command.
+
+
+@node Inserting Space, Inserting Accents, Braces Atsigns, Insertions
+@section Inserting Space
+
+@cindex Inserting space
+@cindex Spacing, inserting
+@cindex Whitespace, inserting
+The following sections describe commands that control spacing of various
+kinds within and after sentences.
+
+@menu
+* Not Ending a Sentence:: Sometimes a . doesn't end a sentence.
+* Ending a Sentence:: Sometimes it does.
+* Multiple Spaces:: Inserting multiple spaces.
+* dmn:: How to format a dimension.
+@end menu
+
+@node Not Ending a Sentence, Ending a Sentence, Inserting Space, Inserting Space
+@subsection Not Ending a Sentence
+
+@cindex Not ending a sentence
+@cindex Sentence non-ending punctuation
+@cindex Periods, inserting
+Depending on whether a period or exclamation point or question mark is
+inside or at the end of a sentence, less or more space is inserted after
+a period in a typeset manual. Since it is not always possible for
+Texinfo to determine when a period ends a sentence and when it is used
+in an abbreviation, special commands are needed in some circumstances.
+(Usually, Texinfo can guess how to handle periods, so you do not need to
+use the special commands; you just enter a period as you would if you
+were using a typewriter, which means you put two spaces after the
+period, question mark, or exclamation mark that ends a sentence.)
+
+@findex : @r{(suppress widening)}
+Use the @code{@@:}@: command after a period, question mark,
+exclamation mark, or colon that should not be followed by extra space.
+For example, use @code{@@:}@: after periods that end abbreviations
+which are not at the ends of sentences. @code{@@:}@: has no effect on
+the Info file output.
+
+@need 700
+For example,
+
+@example
+The s.o.p.@@: has three parts @dots{}
+The s.o.p. has three parts @dots{}
+@end example
+
+@noindent
+@ifinfo
+produces
+@end ifinfo
+@iftex
+produces the following. If you look carefully at this printed output,
+you will see a little more whitespace after @samp{s.o.p.} in the second
+line.@refill
+@end iftex
+
+@quotation
+The s.o.p.@: has three parts @dots{}@*
+The s.o.p. has three parts @dots{}
+@end quotation
+
+@noindent
+@kbd{@@:} has no effect on the Info output. (@samp{s.o.p.} is an
+abbreviation for ``Standard Operating Procedure''.)
+
+Do not put braces after @code{@@:}.
+
+
+@node Ending a Sentence, Multiple Spaces, Not Ending a Sentence, Inserting Space
+@subsection Ending a Sentence
+
+@cindex Ending a Sentence
+@cindex Sentence ending punctuation
+
+@findex . @r{(end of sentence)}
+@findex ! @r{(end of sentence)}
+@findex ? @r{(end of sentence)}
+Use @code{@@.}@: instead of a period, @code{@@!}@: instead of an
+exclamation point, and @code{@@?}@: instead of a question mark at the end
+of a sentence that ends with a single capital letter. Otherwise, @TeX{}
+will think the letter is an abbreviation and will not insert the correct
+end-of-sentence spacing. Here is an example:
+
+@example
+Give it to M.I.B. and to M.E.W@@. Also, give it to R.J.C@@.
+Give it to M.I.B. and to M.E.W. Also, give it to R.J.C.
+@end example
+
+@noindent
+@ifinfo
+produces
+@end ifinfo
+@iftex
+produces the following. If you look carefully at this printed output,
+you will see a little more whitespace after the @samp{W} in the first
+line.
+@end iftex
+
+@quotation
+Give it to M.I.B. and to M.E.W@. Also, give it to R.J.C@.@*
+Give it to M.I.B. and to M.E.W. Also, give it to R.J.C.
+@end quotation
+
+In the Info file output, @code{@@.}@: is equivalent to a simple
+@samp{.}; likewise for @code{@@!}@: and @code{@@?}@:.
+
+The meanings of @code{@@:} and @code{@@.}@: in Texinfo are designed to
+work well with the Emacs sentence motion commands (@pxref{Sentences,,,
+emacs, GNU Emacs}). This made it necessary for them to be incompatible
+with some other formatting systems that use @@-commands.
+
+Do not put braces after any of these commands.
+
+
+@node Multiple Spaces, dmn, Ending a Sentence, Inserting Space
+@subsection Multiple Spaces
+
+@cindex Multiple spaces
+@cindex Whitespace, inserting
+@findex (space)
+@findex (tab)
+@findex (newline)
+
+Ordinarily, @TeX{} collapses multiple whitespace characters (space, tab,
+and newline) into a single space. (Info output, on the other hand,
+preserves whitespace as you type it, except for changing a newline into
+a space; this is why it is important to put two spaces at the end of
+sentences in Texinfo documents.)
+
+Occasionally, you may want to actually insert several consecutive
+spaces, either for purposes of example (what your program does with
+multiple spaces as input), or merely for purposes of appearance in
+headings or lists. Texinfo supports three commands: @code{@@ },
+@code{@@@kbd{TAB}}, and @code{@@@kbd{NL}}, all of which insert a single
+space into the output. (Here, @kbd{TAB} and @kbd{NL} represent the tab
+character and end-of-line, i.e., when @samp{@@} is the last character on
+a line.)
+
+For example,
+@example
+Spacey@@ @@ @@ @@
+example.
+@end example
+
+@noindent produces
+
+@example
+Spacey@ @ @ @
+example.
+@end example
+
+Other possible uses of @code{@@ } have been subsumed by @code{@@multitable}
+(@pxref{Multi-column Tables}).
+
+Do not follow any of these commands with braces.
+
+
+@node dmn, , Multiple Spaces, Inserting Space
+@subsection @code{@@dmn}@{@var{dimension}@}: Format a Dimension
+@cindex Thin space between number, dimension
+@cindex Dimension formatting
+@cindex Format a dimension
+@findex dmn
+
+At times, you may want to write @samp{12@dmn{pt}} or
+@samp{8.5@dmn{in}} with little or no space between the number and the
+abbreviation for the dimension. You can use the @code{@@dmn} command
+to do this. On seeing the command, @TeX{} inserts just enough space
+for proper typesetting; the Info formatting commands insert no space
+at all, since the Info file does not require it.@refill
+
+To use the @code{@@dmn} command, write the number and then follow it
+immediately, with no intervening space, by @code{@@dmn}, and then by
+the dimension within braces.@refill
+
+@need 700
+@noindent
+For example,
+
+@example
+A4 paper is 8.27@@dmn@{in@} wide.
+@end example
+
+@noindent
+produces
+
+@quotation
+A4 paper is 8.27@dmn{in} wide.
+@end quotation
+
+Not everyone uses this style. Instead of writing
+@w{@samp{8.27@@dmn@{in@}}} in the Texinfo file, you may write
+@w{@samp{8.27 in.}} or @w{@samp{8.27 inches}}. (In these cases, the
+formatters may insert a line break between the number and the
+dimension. Also, if you write a period after an abbreviation within a
+sentence, you should write @samp{@@:} after the period to prevent
+@TeX{} from inserting extra whitespace. @xref{Inserting Space}.
+
+
+@node Inserting Accents, Dots Bullets, Inserting Space, Insertions
+@section Inserting Accents
+
+@cindex Inserting accents
+@cindex Accents, inserting
+@cindex Floating accents, inserting
+
+Here is a table with the commands Texinfo provides for inserting
+floating accents. The commands with non-alphabetic names do not take
+braces around their argument (which is taken to be the next character).
+(Exception: @code{@@,} @emph{does} take braces around its argument.)
+This is so as to make the source as convenient to type and read as
+possible, since accented characters are very common in some languages.
+
+@findex "
+@cindex Umlaut accent
+@findex '
+@cindex Acute accent
+@findex =
+@cindex Macron accent
+@findex ^
+@cindex Circumflex accent
+@findex `
+@cindex Grave accent
+@findex ~
+@cindex Tilde accent
+@findex ,
+@cindex Cedilla accent
+@findex dotaccent
+@cindex Dot accent
+@findex H
+@cindex Hungariam umlaut accent
+@findex ringaccent
+@cindex Ring accent
+@findex tieaccent
+@cindex Tie-after accent
+@findex u
+@cindex Breve accent
+@findex ubaraccent
+@cindex Underbar accent
+@findex udotaccent
+@cindex Underdot accent
+@findex v
+@cindex Check accent
+@multitable {@@questiondown@{@}} {Output} {macron/overbar accent}
+@item Command @tab Output @tab What
+@item @t{@@"o} @tab @"o @tab umlaut accent
+@item @t{@@'o} @tab @'o @tab acute accent
+@item @t{@@,@{c@}} @tab @,{c} @tab cedilla accent
+@item @t{@@=o} @tab @=o @tab macron/overbar accent
+@item @t{@@^o} @tab @^o @tab circumflex accent
+@item @t{@@`o} @tab @`o @tab grave accent
+@item @t{@@~o} @tab @~o @tab tilde accent
+@item @t{@@dotaccent@{o@}} @tab @dotaccent{o} @tab overdot accent
+@item @t{@@H@{o@}} @tab @H{o} @tab long Hungarian umlaut
+@item @t{@@ringaccent@{o@}} @tab @ringaccent{o} @tab ring accent
+@item @t{@@tieaccent@{oo@}} @tab @tieaccent{oo} @tab tie-after accent
+@item @t{@@u@{o@}} @tab @u{o} @tab breve accent
+@item @t{@@ubaraccent@{o@}} @tab @ubaraccent{o} @tab underbar accent
+@item @t{@@udotaccent@{o@}} @tab @udotaccent{o} @tab underdot accent
+@item @t{@@v@{o@}} @tab @v{o} @tab hacek or check accent
+@end multitable
+
+This table lists the Texinfo commands for inserting other characters
+commonly used in languages other than English.
+
+@findex questiondown
+@cindex @questiondown{}
+@findex exclamdown
+@cindex @exclamdown{}
+@findex aa
+@cindex @aa{}
+@findex AA
+@cindex @AA{}
+@findex ae
+@cindex @ae{}
+@findex AE
+@cindex @AE{}
+@findex dotless
+@cindex @dotless{i}
+@cindex @dotless{j}
+@cindex Dotless i, j
+@findex l
+@cindex @l{}
+@findex L
+@cindex @L{}
+@findex o
+@cindex @o{}
+@findex O
+@cindex @O{}
+@findex oe
+@cindex @oe{}
+@findex OE
+@cindex @OE{}
+@findex ss
+@cindex @ss{}
+@cindex Es-zet
+@cindex Sharp S
+@cindex German S
+@multitable {@@questiondown@{@}} {oe,OE} {es-zet or sharp S}
+@item @t{@@exclamdown@{@}} @tab @exclamdown{} @tab upside-down !
+@item @t{@@questiondown@{@}} @tab @questiondown{} @tab upside-down ?
+@item @t{@@aa@{@},@@AA@{@}} @tab @aa{},@AA{} @tab A,a with circle
+@item @t{@@ae@{@},@@AE@{@}} @tab @ae{},@AE{} @tab ae,AE ligatures
+@item @t{@@dotless@{i@}} @tab @dotless{i} @tab dotless i
+@item @t{@@dotless@{j@}} @tab @dotless{j} @tab dotless j
+@item @t{@@l@{@},@@L@{@}} @tab @l{},@L{} @tab suppressed-L,l
+@item @t{@@o@{@},@@O@{@}} @tab @o{},@O{} @tab O,o with slash
+@item @t{@@oe@{@},@@OE@{@}} @tab @oe{},@OE{} @tab OE,oe ligatures
+@item @t{@@ss@{@}} @tab @ss{} @tab es-zet or sharp S
+@end multitable
+
+
+@node Dots Bullets, TeX and copyright, Inserting Accents, Insertions
+@section Inserting Ellipsis, Dots, and Bullets
+@cindex Dots, inserting
+@cindex Bullets, inserting
+@cindex Ellipsis, inserting
+@cindex Inserting ellipsis
+@cindex Inserting dots
+@cindex Special typesetting commands
+@cindex Typesetting commands for dots, etc.
+
+An @dfn{ellipsis} (a line of dots) is not typeset as a string of
+periods, so a special command is used for ellipsis in Texinfo. The
+@code{@@bullet} command is special, too. Each of these commands is
+followed by a pair of braces, @samp{@{@}}, without any whitespace
+between the name of the command and the braces. (You need to use braces
+with these commands because you can use them next to other text; without
+the braces, the formatters would be confused. @xref{Command Syntax, ,
+@@-Command Syntax}, for further information.)@refill
+
+@menu
+* dots:: How to insert dots @dots{}
+* bullet:: How to insert a bullet.
+@end menu
+
+@node dots, bullet, Dots Bullets, Dots Bullets
+@comment node-name, next, previous, up
+@subsection @code{@@dots}@{@}
+@findex dots
+@cindex Inserting dots
+@cindex Dots, inserting
+
+Use the @code{@@dots@{@}} command to generate an ellipsis, which is
+three dots in a row, appropriately spaced, like this: `@dots{}'. Do
+not simply write three periods in the input file; that would work for
+the Info file output, but would produce the wrong amount of space
+between the periods in the printed manual.
+
+Similarly, the @code{@@enddots@{@}} command generates an
+end-of-sentence ellipsis (four dots) @enddots{}
+
+@iftex
+Here is an ellipsis: @dots{}
+Here are three periods in a row: ...
+
+In printed output, the three periods in a row are closer together than
+the dots in the ellipsis.
+@end iftex
+
+@node bullet, , dots, Dots Bullets
+@comment node-name, next, previous, up
+@subsection @code{@@bullet}@{@}
+@findex bullet
+
+Use the @code{@@bullet@{@}} command to generate a large round dot, or
+the closest possible thing to one. In Info, an asterisk is used.@refill
+
+Here is a bullet: @bullet{}
+
+When you use @code{@@bullet} in @code{@@itemize}, you do not need to
+type the braces, because @code{@@itemize} supplies them.
+(@xref{itemize, , @code{@@itemize}}.)@refill
+
+@node TeX and copyright, pounds, Dots Bullets, Insertions
+@comment node-name, next, previous, up
+@section Inserting @TeX{} and the Copyright Symbol
+
+The logo `@TeX{}' is typeset in a special fashion and it needs an
+@@-command. The copyright symbol, `@copyright{}', is also special.
+Each of these commands is followed by a pair of braces, @samp{@{@}},
+without any whitespace between the name of the command and the
+braces.@refill
+
+@menu
+* tex:: How to insert the @TeX{} logo.
+* copyright symbol:: How to use @code{@@copyright}@{@}.
+@end menu
+
+@node tex, copyright symbol, TeX and copyright, TeX and copyright
+@comment node-name, next, previous, up
+@subsection @code{@@TeX}@{@}
+@findex tex (command)
+
+Use the @code{@@TeX@{@}} command to generate `@TeX{}'. In a printed
+manual, this is a special logo that is different from three ordinary
+letters. In Info, it just looks like @samp{TeX}. The
+@code{@@TeX@{@}} command is unique among Texinfo commands in that the
+@kbd{T} and the @kbd{X} are in upper case.@refill
+
+@node copyright symbol, , tex, TeX and copyright
+@comment node-name, next, previous, up
+@subsection @code{@@copyright}@{@}
+@findex copyright
+
+Use the @code{@@copyright@{@}} command to generate `@copyright{}'. In
+a printed manual, this is a @samp{c} inside a circle, and in Info,
+this is @samp{(C)}.@refill
+
+@node pounds, minus, TeX and copyright, Insertions
+@section @code{@@pounds}@{@}
+@findex pounds
+
+Use the @code{@@pounds@{@}} command to generate `@pounds{}'. In a
+printed manual, this is the symbol for the currency pounds sterling.
+In Info, it is a @samp{#}. Other currency symbols are unfortunately not
+available.
+
+@node minus, math, pounds, Insertions
+@section @code{@@minus}@{@}: Inserting a Minus Sign
+@findex minus
+
+Use the @code{@@minus@{@}} command to generate a minus sign. In a
+fixed-width font, this is a single hyphen, but in a proportional font,
+the symbol is the customary length for a minus sign---a little longer
+than a hyphen.@refill
+
+You can compare the two forms:
+
+@display
+@samp{@minus{}} is a minus sign generated with @samp{@@minus@{@}},
+
+`-' is a hyphen generated with the character @samp{-}.
+@end display
+
+@noindent
+In the fixed-width font used by Info, @code{@@minus@{@}} is the same
+as a hyphen.@refill
+
+You should not use @code{@@minus@{@}} inside @code{@@code} or
+@code{@@example} because the width distinction is not made in the
+fixed-width font they use.@refill
+
+When you use @code{@@minus} to specify the mark beginning each entry in
+an itemized list, you do not need to type the braces
+(@pxref{itemize, , @code{@@itemize}}.)@refill
+
+@node math, , minus, Insertions
+@comment node-name, next, previous, up
+@section @code{@@math}: Inserting Mathematical Expressions
+@findex math
+@cindex Mathematical expressions
+
+You can write a short mathematical expression with the @code{@@math}
+command. Write the mathematical expression between braces, like this:
+
+@example
+@@math@{(a + b)(a + b) = a^2 + 2ab + b^2@}
+@end example
+
+@iftex
+@need 1000
+@noindent
+This produces the following in @TeX{}:
+
+@display
+@math{(a + b)(a + b) = a^2 + 2ab + b^2}
+@end display
+
+@noindent
+and the following in Info:
+@end iftex
+@ifinfo
+@noindent
+This produces the following in Info:
+@end ifinfo
+
+@example
+(a + b)(a + b) = a^2 + 2ab + b^2
+@end example
+
+The @code{@@math} command has no effect on the Info output. Currently,
+it has limited effect on typeset output. However, this may change since
+@TeX{} itself is designed for mathematical typesetting and does a
+splendid job.
+
+Certainly, for complex mathematical expressions, you could use @TeX{}
+directly. @xref{Using Ordinary TeX Commands, , Using Ordinary @TeX{}
+Commands}. When you use @TeX{} directly, remember to write the
+mathematical expression between one or two @samp{$} (dollar-signs) as
+appropriate.
+
+@node Glyphs, Breaks, Insertions, Top
+@comment node-name, next, previous, up
+@chapter Glyphs for Examples
+@cindex Glyphs
+
+In Texinfo, code is often illustrated in examples that are delimited
+by @code{@@example} and @code{@@end example}, or by @code{@@lisp} and
+@code{@@end lisp}. In such examples, you can indicate the results of
+evaluation or an expansion using @samp{@result{}} or
+@samp{@expansion{}}. Likewise, there are commands to insert glyphs
+to indicate
+printed output, error messages, equivalence of expressions, and the
+location of point.@refill
+
+The glyph-insertion commands do not need to be used within an example, but
+most often they are. Every glyph-insertion command is followed by a pair of
+left- and right-hand braces.@refill
+
+@menu
+* Glyphs Summary::
+* result:: How to show the result of expression.
+* expansion:: How to indicate an expansion.
+* Print Glyph:: How to indicate printed output.
+* Error Glyph:: How to indicate an error message.
+* Equivalence:: How to indicate equivalence.
+* Point Glyph:: How to indicate the location of point.
+@end menu
+
+@node Glyphs Summary, result, Glyphs, Glyphs
+@ifinfo
+@heading Glyphs Summary
+
+Here are the different glyph commands:@refill
+@end ifinfo
+
+@table @asis
+@item @result{}
+@code{@@result@{@}} points to the result of an expression.@refill
+
+@item @expansion{}
+@code{@@expansion@{@}} shows the results of a macro expansion.@refill
+
+@item @print{}
+@code{@@print@{@}} indicates printed output.@refill
+
+@item @error{}
+@code{@@error@{@}} indicates that the following text is an error
+message.@refill
+
+@item @equiv{}
+@code{@@equiv@{@}} indicates the exact equivalence of two forms.@refill
+
+@item @point{}
+@code{@@point@{@}} shows the location of point.@refill
+@end table
+
+@node result, expansion, Glyphs Summary, Glyphs
+@section @result{}: Indicating Evaluation
+@cindex Result of an expression
+@cindex Indicating evaluation
+@cindex Evaluation glyph
+@cindex Value of an expression, indicating
+
+Use the @code{@@result@{@}} command to indicate the result of
+evaluating an expression.@refill
+
+@iftex
+The @code{@@result@{@}} command is displayed as @samp{=>} in Info and
+as @samp{@result{}} in the printed output.
+@end iftex
+@ifinfo
+The @code{@@result@{@}} command is displayed as @samp{@result{}} in Info
+and as a double stemmed arrow in the printed output.@refill
+@end ifinfo
+
+Thus, the following,
+
+@lisp
+(cdr '(1 2 3))
+ @result{} (2 3)
+@end lisp
+
+@noindent
+may be read as ``@code{(cdr '(1 2 3))} evaluates to @code{(2 3)}''.
+
+@node expansion, Print Glyph, result, Glyphs
+@section @expansion{}: Indicating an Expansion
+@cindex Expansion, indicating it
+
+When an expression is a macro call, it expands into a new expression.
+You can indicate the result of the expansion with the
+@code{@@expansion@{@}} command.@refill
+
+@iftex
+The @code{@@expansion@{@}} command is displayed as @samp{==>} in Info and
+as @samp{@expansion{}} in the printed output.
+@end iftex
+@ifinfo
+The @code{@@expansion@{@}} command is displayed as @samp{@expansion{}}
+in Info and as a long arrow with a flat base in the printed output.@refill
+@end ifinfo
+
+@need 700
+For example, the following
+
+@example
+@group
+@@lisp
+(third '(a b c))
+ @@expansion@{@} (car (cdr (cdr '(a b c))))
+ @@result@{@} c
+@@end lisp
+@end group
+@end example
+
+@noindent
+produces
+
+@lisp
+@group
+(third '(a b c))
+ @expansion{} (car (cdr (cdr '(a b c))))
+ @result{} c
+@end group
+@end lisp
+
+@noindent
+which may be read as:
+
+@quotation
+@code{(third '(a b c))} expands to @code{(car (cdr (cdr '(a b c))))};
+the result of evaluating the expression is @code{c}.
+@end quotation
+
+@noindent
+Often, as in this case, an example looks better if the
+@code{@@expansion@{@}} and @code{@@result@{@}} commands are indented
+five spaces.@refill
+
+@node Print Glyph, Error Glyph, expansion, Glyphs
+@section @print{}: Indicating Printed Output
+@cindex Printed output, indicating it
+
+Sometimes an expression will print output during its execution. You
+can indicate the printed output with the @code{@@print@{@}} command.@refill
+
+@iftex
+The @code{@@print@{@}} command is displayed as @samp{-|} in Info and
+as @samp{@print{}} in the printed output.
+@end iftex
+@ifinfo
+The @code{@@print@{@}} command is displayed as @samp{@print{}} in Info
+and similarly, as a horizontal dash butting against a vertical bar, in
+the printed output.@refill
+@end ifinfo
+
+In the following example, the printed text is indicated with
+@samp{@print{}}, and the value of the expression follows on the
+last line.@refill
+
+@lisp
+@group
+(progn (print 'foo) (print 'bar))
+ @print{} foo
+ @print{} bar
+ @result{} bar
+@end group
+@end lisp
+
+@noindent
+In a Texinfo source file, this example is written as follows:
+
+@lisp
+@group
+@@lisp
+(progn (print 'foo) (print 'bar))
+ @@print@{@} foo
+ @@print@{@} bar
+ @@result@{@} bar
+@@end lisp
+@end group
+@end lisp
+
+@node Error Glyph, Equivalence, Print Glyph, Glyphs
+@section @error{}: Indicating an Error Message
+@cindex Error message, indicating it
+
+A piece of code may cause an error when you evaluate it. You can
+designate the error message with the @code{@@error@{@}} command.@refill
+
+@iftex
+The @code{@@error@{@}} command is displayed as @samp{error-->} in Info
+and as @samp{@error{}} in the printed output.
+@end iftex
+@ifinfo
+The @code{@@error@{@}} command is displayed as @samp{@error{}} in Info
+and as the word `error' in a box in the printed output.@refill
+@end ifinfo
+
+@need 700
+Thus,
+
+@example
+@@lisp
+(+ 23 'x)
+@@error@{@} Wrong type argument: integer-or-marker-p, x
+@@end lisp
+@end example
+
+@noindent
+produces
+
+@lisp
+(+ 23 'x)
+@error{} Wrong type argument: integer-or-marker-p, x
+@end lisp
+
+@noindent
+This indicates that the following error message is printed
+when you evaluate the expression:
+
+@lisp
+Wrong type argument: integer-or-marker-p, x
+@end lisp
+
+Note that @samp{@error{}} itself is not part of the error
+message.
+
+@node Equivalence, Point Glyph, Error Glyph, Glyphs
+@section @equiv{}: Indicating Equivalence
+@cindex Equivalence, indicating it
+
+Sometimes two expressions produce identical results. You can indicate the
+exact equivalence of two forms with the @code{@@equiv@{@}} command.@refill
+
+@iftex
+The @code{@@equiv@{@}} command is displayed as @samp{==} in Info and
+as @samp{@equiv{}} in the printed output.
+@end iftex
+@ifinfo
+The @code{@@equiv@{@}} command is displayed as @samp{@equiv{}} in Info
+and as a three parallel horizontal lines in the printed output.@refill
+@end ifinfo
+
+Thus,
+
+@example
+@@lisp
+(make-sparse-keymap) @@equiv@{@} (list 'keymap)
+@@end lisp
+@end example
+
+@noindent
+produces
+
+@lisp
+(make-sparse-keymap) @equiv{} (list 'keymap)
+@end lisp
+
+@noindent
+This indicates that evaluating @code{(make-sparse-keymap)} produces
+identical results to evaluating @code{(list 'keymap)}.
+
+@c Cannot write point command here because it causes trouble with TOC.
+@node Point Glyph, , Equivalence, Glyphs
+@section Indicating Point in a Buffer
+@cindex Point, indicating it in a buffer
+
+Sometimes you need to show an example of text in an Emacs buffer. In
+such examples, the convention is to include the entire contents of the
+buffer in question between two lines of dashes containing the buffer
+name.@refill
+
+You can use the @samp{@@point@{@}} command to show the location of point
+in the text in the buffer. (The symbol for point, of course, is not
+part of the text in the buffer; it indicates the place @emph{between}
+two characters where point is located.)@refill
+
+@iftex
+The @code{@@point@{@}} command is displayed as @samp{-!-} in Info and
+as @samp{@point{}} in the printed output.
+@end iftex
+@ifinfo
+The @code{@@point@{@}} command is displayed as @samp{@point{}} in Info
+and as a small five pointed star in the printed output.@refill
+@end ifinfo
+
+The following example shows the contents of buffer @file{foo} before
+and after evaluating a Lisp command to insert the word @code{changed}.@refill
+
+@example
+@group
+---------- Buffer: foo ----------
+This is the @point{}contents of foo.
+---------- Buffer: foo ----------
+
+@end group
+@end example
+
+@example
+@group
+(insert "changed ")
+ @result{} nil
+---------- Buffer: foo ----------
+This is the changed @point{}contents of foo.
+---------- Buffer: foo ----------
+
+@end group
+@end example
+
+In a Texinfo source file, the example is written like this:@refill
+
+@example
+@@example
+---------- Buffer: foo ----------
+This is the @@point@{@}contents of foo.
+---------- Buffer: foo ----------
+
+(insert "changed ")
+ @@result@{@} nil
+---------- Buffer: foo ----------
+This is the changed @@point@{@}contents of foo.
+---------- Buffer: foo ----------
+@@end example
+@end example
+
+@node Breaks, Definition Commands, Glyphs, Top
+@comment node-name, next, previous, up
+@chapter Making and Preventing Breaks
+@cindex Making line and page breaks
+@cindex Preventing line and page breaks
+
+Usually, a Texinfo file is processed both by @TeX{} and by one of the
+Info formatting commands. Line, paragraph, or page breaks sometimes
+occur in the `wrong' place in one or other form of output. You must
+ensure that text looks right both in the printed manual and in the
+Info file.@refill
+
+For example, in a printed manual, page breaks may occur awkwardly in
+the middle of an example; to prevent this, you can hold text together
+using a grouping command that keeps the text from being split across
+two pages. Conversely, you may want to force a page break where none
+would occur normally. Fortunately, problems like these do not often
+arise. When they do, use the break, break prevention, or pagination
+commands.@refill
+
+@menu
+* Break Commands:: Cause and prevent splits.
+* Line Breaks:: How to force a single line to use two lines.
+* - and hyphenation:: How to tell TeX about hyphenation points.
+* w:: How to prevent unwanted line breaks.
+* sp:: How to insert blank lines.
+* page:: How to force the start of a new page.
+* group:: How to prevent unwanted page breaks.
+* need:: Another way to prevent unwanted page breaks.
+@end menu
+
+@ifinfo
+@node Break Commands, Line Breaks, Breaks, Breaks
+@heading The Break Commands
+@end ifinfo
+@iftex
+@sp 1
+@end iftex
+
+The break commands create or allow line and paragraph breaks:@refill
+
+@table @code
+@item @@*
+Force a line break.
+
+@item @@sp @var{n}
+Skip @var{n} blank lines.@refill
+
+@item @@-
+Insert a discretionary hyphen.
+
+@item @@hyphenation@{@var{hy-phen-a-ted words}@}
+Define hyphen points in @var{hy-phen-a-ted words}.
+@end table
+
+The line-break-prevention command holds text together all on one
+line:@refill
+
+@table @code
+@item @@w@{@var{text}@}
+Prevent @var{text} from being split and hyphenated across two lines.@refill
+@end table
+@iftex
+@sp 1
+@end iftex
+
+The pagination commands apply only to printed output, since Info
+files do not have pages.@refill
+
+@table @code
+@item @@page
+Start a new page in the printed manual.@refill
+
+@item @@group
+Hold text together that must appear on one printed page.@refill
+
+@item @@need @var{mils}
+Start a new printed page if not enough space on this one.@refill
+@end table
+
+@node Line Breaks, - and hyphenation, Break Commands, Breaks
+@comment node-name, next, previous, up
+@section @code{@@*}: Generate Line Breaks
+@findex * @r{(force line break)}
+@cindex Line breaks
+@cindex Breaks in a line
+
+The @code{@@*} command forces a line break in both the printed manual and
+in Info.@refill
+
+@need 700
+For example,
+
+@example
+This line @@* is broken @@*in two places.
+@end example
+
+@noindent
+produces
+
+@example
+@group
+This line
+ is broken
+in two places.
+@end group
+@end example
+
+@noindent
+(Note that the space after the first @code{@@*} command is faithfully
+carried down to the next line.)@refill
+
+@need 800
+The @code{@@*} command is often used in a file's copyright page:@refill
+
+@example
+@group
+This is edition 2.0 of the Texinfo documentation,@@*
+and is for @dots{}
+@end group
+@end example
+
+@noindent
+In this case, the @code{@@*} command keeps @TeX{} from stretching the
+line across the whole page in an ugly manner.@refill
+
+@quotation
+@strong{Please note:} Do not write braces after an @code{@@*} command;
+they are not needed.@refill
+
+Do not write an @code{@@refill} command at the end of a paragraph
+containing an @code{@@*} command; it will cause the paragraph to be
+refilled after the line break occurs, negating the effect of the line
+break.@refill
+@end quotation
+
+@node - and hyphenation, w, Line Breaks, Breaks
+@section @code{@@-} and @code{@@hyphenation}: Helping @TeX{} hyphenate
+
+@findex -
+@findex hyphenation
+@cindex Hyphenation, helping @TeX{} do
+@cindex Fine-tuning, and hyphenation
+
+Although @TeX{}'s hyphenation algorithm is generally pretty good, it
+does miss useful hyphenation points from time to time. (Or, far more
+rarely, insert an incorrect hyphenation.) So, for documents with an
+unusual vocabulary or when fine-tuning for a printed edition, you may
+wish to help @TeX{} out. Texinfo supports two commands for this:
+
+@table @code
+@item @@-
+Insert a discretionary hyphen, i.e., a place where @TeX{} can (but does
+not have to) hyphenate. This is especially useful when you notice
+an overfull hbox is due to @TeX{} missing a hyphenation (@pxref{Overfull
+hboxes}). @TeX{} will not insert any hyphenation points in a word
+containing @code{@@-}.
+
+@item @@hyphenation@{@var{hy-phen-a-ted words}@}
+Tell @TeX{} how to hyphenate @var{hy-phen-a-ted words}. As shown, you
+put a @samp{-} at each hyphenation point. For example:
+@example
+@@hyphenation@{man-u-script man-u-scripts@}
+@end example
+@noindent @TeX{} only uses the specified hyphenation points when the
+words match exactly, so give all necessary variants.
+@end table
+
+Info output is not hyphenated, so these commands have no effect there.
+
+@node w, sp, - and hyphenation, Breaks
+@comment node-name, next, previous, up
+@section @code{@@w}@{@var{text}@}: Prevent Line Breaks
+@findex w @r{(prevent line break)}
+@cindex Line breaks, preventing
+@cindex Hyphenation, preventing
+
+@code{@@w@{@var{text}@}} outputs @var{text} and prohibits line breaks
+within @var{text}.@refill
+
+You can use the @code{@@w} command to prevent @TeX{} from automatically
+hyphenating a long name or phrase that accidentally falls near the end
+of a line.@refill
+
+@example
+You can copy GNU software from @@w@{@@file@{prep.ai.mit.edu@}@}.
+@end example
+
+@noindent
+produces
+
+@quotation
+You can copy GNU software from @w{@file{prep.ai.mit.edu}}.
+@end quotation
+
+@quotation
+@strong{Caution:} Do not write an @code{@@refill} command at the end
+of a paragraph containing an @code{@@w} command; it will cause the
+paragraph to be refilled and may thereby negate the effect of the
+@code{@@w} command.@refill
+@end quotation
+
+@node sp, page, w, Breaks
+@comment node-name, next, previous, up
+@section @code{@@sp} @var{n}: Insert Blank Lines
+@findex sp @r{(line spacing)}
+@cindex Spaces (blank lines)
+@cindex Blank lines
+@cindex Line spacing
+
+A line beginning with and containing only @code{@@sp @var{n}}
+generates @var{n} blank lines of space in both the printed manual and
+the Info file. @code{@@sp} also forces a paragraph break. For
+example,@refill
+
+@example
+@@sp 2
+@end example
+
+@noindent
+generates two blank lines.
+
+The @code{@@sp} command is most often used in the title page.@refill
+
+@ignore
+@c node br, page, sp, Breaks
+@comment node-name, next, previous, up
+@c section @code{@@br}: Generate Paragraph Breaks
+@findex br @r{(paragraph breaks)}
+@cindex Paragraph breaks
+@cindex Breaks in a paragraph
+
+The @code{@@br} command forces a paragraph break. It inserts a blank
+line. You can use the command within or at the end of a line. If
+used within a line, the @code{@@br@{@}} command must be followed by
+left and right braces (as shown here) to mark the end of the
+command.@refill
+
+@need 700
+For example,
+
+@example
+@group
+This line @@br@{@}contains and is ended by paragraph breaks@@br
+and is followed by another line.
+@end group
+@end example
+
+@noindent
+produces
+
+@example
+@group
+This line
+
+contains and is ended by paragraph breaks
+
+and is followed by another line.
+@end group
+@end example
+
+The @code{@@br} command is seldom used.
+@end ignore
+
+@node page, group, sp, Breaks
+@comment node-name, next, previous, up
+@section @code{@@page}: Start a New Page
+@cindex Page breaks
+@findex page
+
+A line containing only @code{@@page} starts a new page in a printed
+manual. The command has no effect on Info files since they are not
+paginated. An @code{@@page} command is often used in the @code{@@titlepage}
+section of a Texinfo file to start the copyright page.@refill
+
+@node group, need, page, Breaks
+@comment node-name, next, previous, up
+@section @code{@@group}: Prevent Page Breaks
+@cindex Group (hold text together vertically)
+@cindex Holding text together vertically
+@cindex Vertically holding text together
+@findex group
+
+The @code{@@group} command (on a line by itself) is used inside an
+@code{@@example} or similar construct to begin an unsplittable vertical
+group, which will appear entirely on one page in the printed output.
+The group is terminated by a line containing only @code{@@end group}.
+These two lines produce no output of their own, and in the Info file
+output they have no effect at all.@refill
+
+@c Once said that these environments
+@c turn off vertical spacing between ``paragraphs''.
+@c Also, quotation used to work, but doesn't in texinfo-2.72
+Although @code{@@group} would make sense conceptually in a wide
+variety of contexts, its current implementation works reliably only
+within @code{@@example} and variants, and within @code{@@display},
+@code{@@format}, @code{@@flushleft} and @code{@@flushright}.
+@xref{Quotations and Examples}. (What all these commands have in
+common is that each line of input produces a line of output.) In
+other contexts, @code{@@group} can cause anomalous vertical
+spacing.@refill
+
+@need 750
+This formatting requirement means that you should write:
+
+@example
+@group
+@@example
+@@group
+@dots{}
+@@end group
+@@end example
+@end group
+@end example
+
+@noindent
+with the @code{@@group} and @code{@@end group} commands inside the
+@code{@@example} and @code{@@end example} commands.
+
+The @code{@@group} command is most often used to hold an example
+together on one page. In this Texinfo manual, more than 100 examples
+contain text that is enclosed between @code{@@group} and @code{@@end
+group}.
+
+If you forget to end a group, you may get strange and unfathomable
+error messages when you run @TeX{}. This is because @TeX{} keeps
+trying to put the rest of the Texinfo file onto the one page and does
+not start to generate error messages until it has processed
+considerable text. It is a good rule of thumb to look for a missing
+@code{@@end group} if you get incomprehensible error messages in
+@TeX{}.@refill
+
+@node need, , group, Breaks
+@comment node-name, next, previous, up
+@section @code{@@need @var{mils}}: Prevent Page Breaks
+@cindex Need space at page bottom
+@findex need
+
+A line containing only @code{@@need @var{n}} starts
+a new page in a printed manual if fewer than @var{n} mils (thousandths
+of an inch) remain on the current page. Do not use
+braces around the argument @var{n}. The @code{@@need} command has no
+effect on Info files since they are not paginated.@refill
+
+@need 800
+This paragraph is preceded by an @code{@@need} command that tells
+@TeX{} to start a new page if fewer than 800 mils (eight-tenths
+inch) remain on the page. It looks like this:@refill
+
+@example
+@group
+@@need 800
+This paragraph is preceded by @dots{}
+@end group
+@end example
+
+The @code{@@need} command is useful for preventing orphans (single
+lines at the bottoms of printed pages).@refill
+
+@node Definition Commands, Footnotes, Breaks, Top
+@chapter Definition Commands
+@cindex Definition commands
+
+The @code{@@deffn} command and the other @dfn{definition commands}
+enable you to describe functions, variables, macros, commands, user
+options, special forms and other such artifacts in a uniform
+format.@refill
+
+In the Info file, a definition causes the entity
+category---`Function', `Variable', or whatever---to appear at the
+beginning of the first line of the definition, followed by the
+entity's name and arguments. In the printed manual, the command
+causes @TeX{} to print the entity's name and its arguments on the left
+margin and print the category next to the right margin. In both
+output formats, the body of the definition is indented. Also, the
+name of the entity is entered into the appropriate index:
+@code{@@deffn} enters the name into the index of functions,
+@code{@@defvr} enters it into the index of variables, and so
+on.@refill
+
+A manual need not and should not contain more than one definition for
+a given name. An appendix containing a summary should use
+@code{@@table} rather than the definition commands.@refill
+
+@menu
+* Def Cmd Template:: How to structure a description using a
+ definition command.
+* Optional Arguments:: How to handle optional and repeated arguments.
+* deffnx:: How to group two or more `first' lines.
+* Def Cmds in Detail:: All the definition commands.
+* Def Cmd Conventions:: Conventions for writing definitions.
+* Sample Function Definition::
+@end menu
+
+@node Def Cmd Template, Optional Arguments, Definition Commands, Definition Commands
+@section The Template for a Definition
+@cindex Definition template
+@cindex Template for a definition
+
+The @code{@@deffn} command is used for definitions of entities that
+resemble functions. To write a definition using the @code{@@deffn}
+command, write the @code{@@deffn} command at the beginning of a line
+and follow it on the same line by the category of the entity, the name
+of the entity itself, and its arguments (if any). Then write the body
+of the definition on succeeding lines. (You may embed examples in the
+body.) Finally, end the definition with an @code{@@end deffn} command
+written on a line of its own. (The other definition commands follow
+the same format.)@refill
+
+The template for a definition looks like this:
+
+@example
+@group
+@@deffn @var{category} @var{name} @var{arguments}@dots{}
+@var{body-of-definition}
+@@end deffn
+@end group
+@end example
+
+@need 700
+@noindent
+For example,
+
+@example
+@group
+@@deffn Command forward-word count
+This command moves point forward @@var@{count@} words
+(or backward if @@var@{count@} is negative). @dots{}
+@@end deffn
+@end group
+@end example
+
+@noindent
+produces
+
+@quotation
+@deffn Command forward-word count
+This function moves point forward @var{count} words
+(or backward if @var{count} is negative). @dots{}
+@end deffn
+@end quotation
+
+Capitalize the category name like a title. If the name of the
+category contains spaces, as in the phrase `Interactive Command',
+write braces around it. For example:@refill
+
+@example
+@group
+@@deffn @{Interactive Command@} isearch-forward
+@dots{}
+@@end deffn
+@end group
+@end example
+
+@noindent
+Otherwise, the second word will be mistaken for the name of the
+entity.@refill
+
+Some of the definition commands are more general than others. The
+@code{@@deffn} command, for example, is the general definition command
+for functions and the like---for entities that may take arguments. When
+you use this command, you specify the category to which the entity
+belongs. The @code{@@deffn} command possesses three predefined,
+specialized variations, @code{@@defun}, @code{@@defmac}, and
+@code{@@defspec}, that specify the category for you: ``Function'',
+``Macro'', and ``Special Form'' respectively. The @code{@@defvr}
+command also is accompanied by several predefined, specialized
+variations for describing particular kinds of variables.@refill
+
+The template for a specialized definition, such as @code{@@defun}, is
+similar to the template for a generalized definition, except that you
+do not need to specify the category:@refill
+
+@example
+@group
+@@defun @var{name} @var{arguments}@dots{}
+@var{body-of-definition}
+@@end defun
+@end group
+@end example
+
+@noindent
+Thus,
+
+@example
+@group
+@@defun buffer-end flag
+This function returns @@code@{(point-min)@} if @@var@{flag@}
+is less than 1, @@code@{(point-max)@} otherwise.
+@dots{}
+@@end defun
+@end group
+@end example
+
+@noindent
+produces
+
+@quotation
+@defun buffer-end flag
+This function returns @code{(point-min)} if @var{flag} is less than 1,
+@code{(point-max)} otherwise. @dots{}
+@end defun
+@end quotation
+
+@noindent
+@xref{Sample Function Definition, Sample Function Definition, A Sample
+Function Definition}, for a more detailed example of a function
+definition, including the use of @code{@@example} inside the
+definition.@refill
+
+The other specialized commands work like @code{@@defun}.@refill
+
+@node Optional Arguments, deffnx, Def Cmd Template, Definition Commands
+@section Optional and Repeated Arguments
+@cindex Optional and repeated arguments
+@cindex Repeated and optional arguments
+@cindex Arguments, repeated and optional
+@cindex Syntax, optional & repeated arguments
+@cindex Meta-syntactic chars for arguments
+
+Some entities take optional or repeated arguments, which may be
+specified by a distinctive glyph that uses square brackets and
+ellipses. For @w{example}, a special form often breaks its argument list
+into separate arguments in more complicated ways than a
+straightforward function.@refill
+
+@iftex
+An argument enclosed within square brackets is optional.
+Thus, the phrase
+@samp{@code{@r{[}@var{optional-arg}@r{]}}} means that
+@var{optional-arg} is optional.
+An argument followed by an ellipsis is optional
+and may be repeated more than once.
+@c This is consistent with Emacs Lisp Reference manual
+Thus, @samp{@var{repeated-args}@dots{}} stands for zero or more arguments.
+Parentheses are used when several arguments are grouped
+into additional levels of list structure in Lisp.
+@end iftex
+@c The following looks better in Info (no `r', `samp' and `code'):
+@ifinfo
+An argument enclosed within square brackets is optional.
+Thus, [@var{optional-arg}] means that @var{optional-arg} is optional.
+An argument followed by an ellipsis is optional
+and may be repeated more than once.
+@c This is consistent with Emacs Lisp Reference manual
+Thus, @var{repeated-args}@dots{} stands for zero or more arguments.
+Parentheses are used when several arguments are grouped
+into additional levels of list structure in Lisp.
+@end ifinfo
+
+Here is the @code{@@defspec} line of an example of an imaginary
+special form:@refill
+
+@quotation
+@defspec foobar (@var{var} [@var{from} @var{to} [@var{inc}]]) @var{body}@dots{}
+@end defspec
+@tex
+\vskip \parskip
+@end tex
+@end quotation
+
+@noindent
+In this example, the arguments @var{from} and @var{to} are optional,
+but must both be present or both absent. If they are present,
+@var{inc} may optionally be specified as well. These arguments are
+grouped with the argument @var{var} into a list, to distinguish them
+from @var{body}, which includes all remaining elements of the
+form.@refill
+
+In a Texinfo source file, this @code{@@defspec} line is written like
+this (except it would not be split over two lines, as it is in this
+example).@refill
+
+@example
+@group
+@@defspec foobar (@@var@{var@} [@@var@{from@} @@var@{to@}
+ [@@var@{inc@}]]) @@var@{body@}@@dots@{@}
+@end group
+@end example
+
+@noindent
+The function is listed in the Command and Variable Index under
+@samp{foobar}.@refill
+
+@node deffnx, Def Cmds in Detail, Optional Arguments, Definition Commands
+@section Two or More `First' Lines
+@cindex Two `First' Lines for @code{@@deffn}
+@cindex Grouping two definitions together
+@cindex Definitions grouped together
+@findex deffnx
+
+To create two or more `first' or header lines for a definition, follow
+the first @code{@@deffn} line by a line beginning with @code{@@deffnx}.
+The @code{@@deffnx} command works exactly like @code{@@deffn}
+except that it does not generate extra vertical white space between it
+and the preceding line.@refill
+
+@need 1000
+For example,
+
+@example
+@group
+@@deffn @{Interactive Command@} isearch-forward
+@@deffnx @{Interactive Command@} isearch-backward
+These two search commands are similar except @dots{}
+@@end deffn
+@end group
+@end example
+
+@noindent
+produces
+
+@deffn {Interactive Command} isearch-forward
+@deffnx {Interactive Command} isearch-backward
+These two search commands are similar except @dots{}
+@end deffn
+
+Each of the other definition commands has an `x' form: @code{@@defunx},
+@code{@@defvrx}, @code{@@deftypefunx}, etc.
+
+The `x' forms work just like @code{@@itemx}; see @ref{itemx, , @code{@@itemx}}.
+
+@node Def Cmds in Detail, Def Cmd Conventions, deffnx, Definition Commands
+@section The Definition Commands
+
+Texinfo provides more than a dozen definition commands, all of which
+are described in this section.@refill
+
+The definition commands automatically enter the name of the entity in
+the appropriate index: for example, @code{@@deffn}, @code{@@defun},
+and @code{@@defmac} enter function names in the index of functions;
+@code{@@defvr} and @code{@@defvar} enter variable names in the index
+of variables.@refill
+
+Although the examples that follow mostly illustrate Lisp, the commands
+can be used for other programming languages.@refill
+
+@menu
+* Functions Commands:: Commands for functions and similar entities.
+* Variables Commands:: Commands for variables and similar entities.
+* Typed Functions:: Commands for functions in typed languages.
+* Typed Variables:: Commands for variables in typed languages.
+* Abstract Objects:: Commands for object-oriented programming.
+* Data Types:: The definition command for data types.
+@end menu
+
+@node Functions Commands, Variables Commands, Def Cmds in Detail, Def Cmds in Detail
+@subsection Functions and Similar Entities
+
+This section describes the commands for describing functions and similar
+entities:@refill
+
+@table @code
+@findex deffn
+@item @@deffn @var{category} @var{name} @var{arguments}@dots{}
+The @code{@@deffn} command is the general definition command for
+functions, interactive commands, and similar entities that may take
+arguments. You must choose a term to describe the category of entity
+being defined; for example, ``Function'' could be used if the entity is
+a function. The @code{@@deffn} command is written at the beginning of a
+line and is followed on the same line by the category of entity being
+described, the name of this particular entity, and its arguments, if
+any. Terminate the definition with @code{@@end deffn} on a line of its
+own.@refill
+
+@need 750
+For example, here is a definition:
+
+@example
+@group
+@@deffn Command forward-char nchars
+Move point forward @@var@{nchars@} characters.
+@@end deffn
+@end group
+@end example
+
+@noindent
+This shows a rather terse definition for a ``command'' named
+@code{forward-char} with one argument, @var{nchars}.
+
+@code{@@deffn} prints argument names such as @var{nchars} in italics or
+upper case, as if @code{@@var} had been used, because we think of these
+names as metasyntactic variables---they stand for the actual argument
+values. Within the text of the description, write an argument name
+explicitly with @code{@@var} to refer to the value of the argument. In
+the example above, we used @samp{@@var@{nchars@}} in this way.
+
+The template for @code{@@deffn} is:
+
+@example
+@group
+@@deffn @var{category} @var{name} @var{arguments}@dots{}
+@var{body-of-definition}
+@@end deffn
+@end group
+@end example
+
+@findex defun
+@item @@defun @var{name} @var{arguments}@dots{}
+The @code{@@defun} command is the definition command for functions.
+@code{@@defun} is equivalent to @samp{@@deffn Function
+@dots{}}.@refill
+
+@need 800
+@noindent
+For example,
+
+@example
+@group
+@@defun set symbol new-value
+Change the value of the symbol @@var@{symbol@}
+to @@var@{new-value@}.
+@@end defun
+@end group
+@end example
+
+@noindent
+shows a rather terse definition for a function @code{set} whose
+arguments are @var{symbol} and @var{new-value}. The argument names on
+the @code{@@defun} line automatically appear in italics or upper case as
+if they were enclosed in @code{@@var}. Terminate the definition with
+@code{@@end defun} on a line of its own.@refill
+
+The template is:
+
+@example
+@group
+@@defun @var{function-name} @var{arguments}@dots{}
+@var{body-of-definition}
+@@end defun
+@end group
+@end example
+
+@code{@@defun} creates an entry in the index of functions.
+
+@findex defmac
+@item @@defmac @var{name} @var{arguments}@dots{}
+The @code{@@defmac} command is the definition command for macros.
+@code{@@defmac} is equivalent to @samp{@@deffn Macro @dots{}} and
+works like @code{@@defun}.@refill
+
+@findex defspec
+@item @@defspec @var{name} @var{arguments}@dots{}
+The @code{@@defspec} command is the definition command for special
+forms. (In Lisp, a special form is an entity much like a function.)
+@code{@@defspec} is equivalent to @samp{@@deffn @{Special Form@}
+@dots{}} and works like @code{@@defun}.@refill
+@end table
+
+@node Variables Commands, Typed Functions, Functions Commands, Def Cmds in Detail
+@subsection Variables and Similar Entities
+
+Here are the commands for defining variables and similar
+entities:@refill
+
+@table @code
+@findex defvr
+@item @@defvr @var{category} @var{name}
+The @code{@@defvr} command is a general definition command for
+something like a variable---an entity that records a value. You must
+choose a term to describe the category of entity being defined; for
+example, ``Variable'' could be used if the entity is a variable.
+Write the @code{@@defvr} command at the beginning of a line and
+followed it on the same line by the category of the entity and the
+name of the entity.@refill
+
+Capitalize the category name like a title. If the name of the
+category contains spaces, as in the name `User Option', write braces
+around it. Otherwise, the second word will be mistaken for the name
+of the entity, for example:
+
+@example
+@group
+@@defvr @{User Option@} fill-column
+This buffer-local variable specifies
+the maximum width of filled lines.
+@dots{}
+@@end defvr
+@end group
+@end example
+
+Terminate the definition with @code{@@end defvr} on a line of its
+own.@refill
+
+The template is:
+
+@example
+@group
+@@defvr @var{category} @var{name}
+@var{body-of-definition}
+@@end defvr
+@end group
+@end example
+
+@code{@@defvr} creates an entry in the index of variables for @var{name}.
+
+@findex defvar
+@item @@defvar @var{name}
+The @code{@@defvar} command is the definition command for variables.
+@code{@@defvar} is equivalent to @samp{@@defvr Variable
+@dots{}}.@refill
+
+@need 750
+For example:
+
+@example
+@group
+@@defvar kill-ring
+@dots{}
+@@end defvar
+@end group
+@end example
+
+The template is:
+
+@example
+@group
+@@defvar @var{name}
+@var{body-of-definition}
+@@end defvar
+@end group
+@end example
+
+@code{@@defvar} creates an entry in the index of variables for
+@var{name}.@refill
+
+@findex defopt
+@item @@defopt @var{name}
+The @code{@@defopt} command is the definition command for user
+options. @code{@@defopt} is equivalent to @samp{@@defvr @{User
+Option@} @dots{}} and works like @code{@@defvar}.@refill
+@end table
+
+@node Typed Functions, Typed Variables, Variables Commands, Def Cmds in Detail
+@subsection Functions in Typed Languages
+
+The @code{@@deftypefn} command and its variations are for describing
+functions in C or any other language in which you must declare types
+of variables and functions.@refill
+
+@table @code
+@findex deftypefn
+@item @@deftypefn @var{category} @var{data-type} @var{name} @var{arguments}@dots{}
+The @code{@@deftypefn} command is the general definition command for
+functions and similar entities that may take arguments and that are
+typed. The @code{@@deftypefn} command is written at the beginning of
+a line and is followed on the same line by the category of entity
+being described, the type of the returned value, the name of this
+particular entity, and its arguments, if any.@refill
+
+@need 800
+@noindent
+For example,
+
+@example
+@group
+@@deftypefn @{Library Function@} int foobar
+ (int @@var@{foo@}, float @@var@{bar@})
+@dots{}
+@@end deftypefn
+@end group
+@end example
+
+@need 1000
+@noindent
+(where the text before the ``@dots{}'', shown above as two lines, would
+actually be a single line in a real Texinfo file) produces the following
+in Info:
+
+@smallexample
+@group
+-- Library Function: int foobar (int FOO, float BAR)
+@dots{}
+@end group
+@end smallexample
+@iftex
+
+In a printed manual, it produces:
+
+@quotation
+@deftypefn {Library Function} int foobar (int @var{foo}, float @var{bar})
+@dots{}
+@end deftypefn
+@end quotation
+@end iftex
+
+This means that @code{foobar} is a ``library function'' that returns an
+@code{int}, and its arguments are @var{foo} (an @code{int}) and
+@var{bar} (a @code{float}).@refill
+
+The argument names that you write in @code{@@deftypefn} are not subject
+to an implicit @code{@@var}---since the actual names of the arguments in
+@code{@@deftypefn} are typically scattered among data type names and
+keywords, Texinfo cannot find them without help. Instead, you must write
+@code{@@var} explicitly around the argument names. In the example
+above, the argument names are @samp{foo} and @samp{bar}.@refill
+
+The template for @code{@@deftypefn} is:@refill
+
+@example
+@group
+@@deftypefn @var{category} @var{data-type} @var{name} @var{arguments} @dots{}
+@var{body-of-description}
+@@end deftypefn
+@end group
+@end example
+
+@noindent
+Note that if the @var{category} or @var{data type} is more than one
+word then it must be enclosed in braces to make it a single argument.@refill
+
+If you are describing a procedure in a language that has packages,
+such as Ada, you might consider using @code{@@deftypefn} in a manner
+somewhat contrary to the convention described in the preceding
+paragraphs.@refill
+
+@need 800
+@noindent
+For example:
+
+@example
+@group
+@@deftypefn stacks private push
+ (@@var@{s@}:in out stack;
+ @@var@{n@}:in integer)
+@dots{}
+@@end deftypefn
+@end group
+@end example
+
+@noindent
+(The @code{@@deftypefn} arguments are shown split into three lines, but
+would be a single line in a real Texinfo file.)
+
+In this instance, the procedure is classified as belonging to the
+package @code{stacks} rather than classified as a `procedure' and its
+data type is described as @code{private}. (The name of the procedure
+is @code{push}, and its arguments are @var{s} and @var{n}.)@refill
+
+@code{@@deftypefn} creates an entry in the index of functions for
+@var{name}.@refill
+
+@findex deftypefun
+@item @@deftypefun @var{data-type} @var{name} @var{arguments}@dots{}
+The @code{@@deftypefun} command is the specialized definition command
+for functions in typed languages. The command is equivalent to
+@samp{@@deftypefn Function @dots{}}.@refill
+
+@need 800
+@noindent
+Thus,
+
+@smallexample
+@group
+@@deftypefun int foobar (int @@var@{foo@}, float @@var@{bar@})
+@dots{}
+@@end deftypefun
+@end group
+@end smallexample
+
+@noindent
+produces the following in Info:
+
+@example
+@group
+-- Function: int foobar (int FOO, float BAR)
+@dots{}
+@end group
+@end example
+@iftex
+
+@need 800
+@noindent
+and the following in a printed manual:
+
+@quotation
+@deftypefun int foobar (int @var{foo}, float @var{bar})
+@dots{}
+@end deftypefun
+@end quotation
+@end iftex
+
+@need 800
+The template is:
+
+@example
+@group
+@@deftypefun @var{type} @var{name} @var{arguments}@dots{}
+@var{body-of-description}
+@@end deftypefun
+@end group
+@end example
+
+@code{@@deftypefun} creates an entry in the index of functions for
+@var{name}.@refill
+@end table
+
+@node Typed Variables, Abstract Objects, Typed Functions, Def Cmds in Detail
+@subsection Variables in Typed Languages
+
+Variables in typed languages are handled in a manner similar to
+functions in typed languages. @xref{Typed Functions}. The general
+definition command @code{@@deftypevr} corresponds to
+@code{@@deftypefn} and the specialized definition command
+@code{@@deftypevar} corresponds to @code{@@deftypefun}.@refill
+
+@table @code
+@findex deftypevr
+@item @@deftypevr @var{category} @var{data-type} @var{name}
+The @code{@@deftypevr} command is the general definition command for
+something like a variable in a typed language---an entity that records
+a value. You must choose a term to describe the category of the
+entity being defined; for example, ``Variable'' could be used if the
+entity is a variable.@refill
+
+The @code{@@deftypevr} command is written at the beginning of a line
+and is followed on the same line by the category of the entity
+being described, the data type, and the name of this particular
+entity.@refill
+
+@need 800
+@noindent
+For example:
+
+@example
+@group
+@@deftypevr @{Global Flag@} int enable
+@dots{}
+@@end deftypevr
+@end group
+@end example
+
+@noindent
+produces the following in Info:
+
+@example
+@group
+-- Global Flag: int enable
+@dots{}
+@end group
+@end example
+@iftex
+
+@noindent
+and the following in a printed manual:
+
+@quotation
+@deftypevr {Global Flag} int enable
+@dots{}
+@end deftypevr
+@end quotation
+@end iftex
+
+@need 800
+The template is:
+
+@example
+@@deftypevr @var{category} @var{data-type} @var{name}
+@var{body-of-description}
+@@end deftypevr
+@end example
+
+@code{@@deftypevr} creates an entry in the index of variables for
+@var{name}.@refill
+
+@findex deftypevar
+@item @@deftypevar @var{data-type} @var{name}
+The @code{@@deftypevar} command is the specialized definition command
+for variables in typed languages. @code{@@deftypevar} is equivalent
+to @samp{@@deftypevr Variable @dots{}}.@refill
+
+@need 800
+@noindent
+For example:
+
+@example
+@group
+@@deftypevar int fubar
+@dots{}
+@@end deftypevar
+@end group
+@end example
+
+@noindent
+produces the following in Info:
+
+@example
+@group
+-- Variable: int fubar
+@dots{}
+@end group
+@end example
+@iftex
+
+@need 800
+@noindent
+and the following in a printed manual:
+
+@quotation
+@deftypevar int fubar
+@dots{}
+@end deftypevar
+@end quotation
+@end iftex
+
+@need 800
+@noindent
+The template is:
+
+@example
+@group
+@@deftypevar @var{data-type} @var{name}
+@var{body-of-description}
+@@end deftypevar
+@end group
+@end example
+
+@code{@@deftypevar} creates an entry in the index of variables for
+@var{name}.@refill
+@end table
+
+@node Abstract Objects, Data Types, Typed Variables, Def Cmds in Detail
+@subsection Object-Oriented Programming
+
+Here are the commands for formatting descriptions about abstract
+objects, such as are used in object-oriented programming. A class is
+a defined type of abstract object. An instance of a class is a
+particular object that has the type of the class. An instance
+variable is a variable that belongs to the class but for which each
+instance has its own value.@refill
+
+In a definition, if the name of a class is truly a name defined in the
+programming system for a class, then you should write an @code{@@code}
+around it. Otherwise, it is printed in the usual text font.@refill
+
+@table @code
+@findex defcv
+@item @@defcv @var{category} @var{class} @var{name}
+The @code{@@defcv} command is the general definition command for
+variables associated with classes in object-oriented programming. The
+@code{@@defcv} command is followed by three arguments: the category of
+thing being defined, the class to which it belongs, and its
+name. Thus,@refill
+
+@example
+@group
+@@defcv @{Class Option@} Window border-pattern
+@dots{}
+@@end defcv
+@end group
+@end example
+
+@noindent
+illustrates how you would write the first line of a definition of the
+@code{border-pattern} class option of the class @code{Window}.@refill
+
+The template is
+
+@example
+@group
+@@defcv @var{category} @var{class} @var{name}
+@dots{}
+@@end defcv
+@end group
+@end example
+
+@code{@@defcv} creates an entry in the index of variables.
+
+@findex defivar
+@item @@defivar @var{class} @var{name}
+The @code{@@defivar} command is the definition command for instance
+variables in object-oriented programming. @code{@@defivar} is
+equivalent to @samp{@@defcv @{Instance Variable@} @dots{}}@refill
+
+The template is:
+
+@example
+@group
+@@defivar @var{class} @var{instance-variable-name}
+@var{body-of-definition}
+@@end defivar
+@end group
+@end example
+
+@code{@@defivar} creates an entry in the index of variables.
+
+@findex defop
+@item @@defop @var{category} @var{class} @var{name} @var{arguments}@dots{}
+The @code{@@defop} command is the general definition command for
+entities that may resemble methods in object-oriented programming.
+These entities take arguments, as functions do, but are associated
+with particular classes of objects.@refill
+
+For example, some systems have constructs called @dfn{wrappers} that
+are associated with classes as methods are, but that act more like
+macros than like functions. You could use @code{@@defop Wrapper} to
+describe one of these.@refill
+
+Sometimes it is useful to distinguish methods and @dfn{operations}.
+You can think of an operation as the specification for a method.
+Thus, a window system might specify that all window classes have a
+method named @code{expose}; we would say that this window system
+defines an @code{expose} operation on windows in general. Typically,
+the operation has a name and also specifies the pattern of arguments;
+all methods that implement the operation must accept the same
+arguments, since applications that use the operation do so without
+knowing which method will implement it.@refill
+
+Often it makes more sense to document operations than methods. For
+example, window application developers need to know about the
+@code{expose} operation, but need not be concerned with whether a
+given class of windows has its own method to implement this operation.
+To describe this operation, you would write:@refill
+
+@example
+@@defop Operation windows expose
+@end example
+
+The @code{@@defop} command is written at the beginning of a line and
+is followed on the same line by the overall name of the category of
+operation, the name of the class of the operation, the name of the
+operation, and its arguments, if any.@refill
+
+@need 800
+@noindent
+The template is:
+
+@example
+@group
+@@defop @var{category} @var{class} @var{name} @var{arguments}@dots{}
+@var{body-of-definition}
+@@end defop
+@end group
+@end example
+
+@code{@@defop} creates an entry, such as `@code{expose} on
+@code{windows}', in the index of functions.@refill
+
+@findex defmethod
+@item @@defmethod @var{class} @var{name} @var{arguments}@dots{}
+The @code{@@defmethod} command is the definition command for methods
+in object-oriented programming. A method is a kind of function that
+implements an operation for a particular class of objects and its
+subclasses. In the Lisp Machine, methods actually were functions, but
+they were usually defined with @code{defmethod}.
+
+@code{@@defmethod} is equivalent to @samp{@@defop Method @dots{}}.
+The command is written at the beginning of a line and is followed by
+the name of the class of the method, the name of the method, and its
+arguments, if any.@refill
+
+@need 800
+@noindent
+For example,
+
+@example
+@group
+@@defmethod @code{bar-class} bar-method argument
+@dots{}
+@@end defmethod
+@end group
+@end example
+
+@noindent
+illustrates the definition for a method called @code{bar-method} of
+the class @code{bar-class}. The method takes an argument.@refill
+
+The template is:
+
+@example
+@group
+@@defmethod @var{class} @var{method-name} @var{arguments}@dots{}
+@var{body-of-definition}
+@@end defmethod
+@end group
+@end example
+
+@code{@@defmethod} creates an entry, such as `@code{bar-method} on
+@code{bar-class}', in the index of functions.@refill
+@end table
+
+@node Data Types, , Abstract Objects, Def Cmds in Detail
+@subsection Data Types
+
+Here is the command for data types:@refill
+
+@table @code
+@findex deftp
+@item @@deftp @var{category} @var{name} @var{attributes}@dots{}
+The @code{@@deftp} command is the generic definition command for data
+types. The command is written at the beginning of a line and is
+followed on the same line by the category, by the name of the type
+(which is a word like @code{int} or @code{float}), and then by names of
+attributes of objects of that type. Thus, you could use this command
+for describing @code{int} or @code{float}, in which case you could use
+@code{data type} as the category. (A data type is a category of
+certain objects for purposes of deciding which operations can be
+performed on them.)@refill
+
+In Lisp, for example, @dfn{pair} names a particular data
+type, and an object of that type has two slots called the
+@sc{car} and the @sc{cdr}. Here is how you would write the first line
+of a definition of @code{pair}.@refill
+
+@example
+@group
+@@deftp @{Data type@} pair car cdr
+@dots{}
+@@end deftp
+@end group
+@end example
+
+@need 950
+The template is:
+
+@example
+@group
+@@deftp @var{category} @var{name-of-type} @var{attributes}@dots{}
+@var{body-of-definition}
+@@end deftp
+@end group
+@end example
+
+@code{@@deftp} creates an entry in the index of data types.
+@end table
+
+@node Def Cmd Conventions, Sample Function Definition, Def Cmds in Detail, Definition Commands
+@section Conventions for Writing Definitions
+@cindex Definition conventions
+@cindex Conventions for writing definitions
+
+When you write a definition using @code{@@deffn}, @code{@@defun}, or
+one of the other definition commands, please take care to use
+arguments that indicate the meaning, as with the @var{count} argument
+to the @code{forward-word} function. Also, if the name of an argument
+contains the name of a type, such as @var{integer}, take care that the
+argument actually is of that type.@refill
+
+@node Sample Function Definition, , Def Cmd Conventions, Definition Commands
+@section A Sample Function Definition
+@cindex Function definitions
+@cindex Command definitions
+@cindex Macro definitions
+@cindex Sample function definition
+
+A function definition uses the @code{@@defun} and @code{@@end defun}
+commands. The name of the function follows immediately after the
+@code{@@defun} command and it is followed, on the same line, by the
+parameter list.@refill
+
+Here is a definition from @cite{The GNU Emacs Lisp Reference Manual}.
+(@xref{Calling Functions, , Calling Functions, elisp, The GNU Emacs
+Lisp Reference Manual}.)
+
+@quotation
+@defun apply function &rest arguments
+@code{apply} calls @var{function} with @var{arguments}, just
+like @code{funcall} but with one difference: the last of
+@var{arguments} is a list of arguments to give to
+@var{function}, rather than a single argument. We also say
+that this list is @dfn{appended} to the other arguments.
+
+@code{apply} returns the result of calling @var{function}.
+As with @code{funcall}, @var{function} must either be a Lisp
+function or a primitive function; special forms and macros
+do not make sense in @code{apply}.
+
+@example
+(setq f 'list)
+ @result{} list
+(apply f 'x 'y 'z)
+@error{} Wrong type argument: listp, z
+(apply '+ 1 2 '(3 4))
+ @result{} 10
+(apply '+ '(1 2 3 4))
+ @result{} 10
+
+(apply 'append '((a b c) nil (x y z) nil))
+ @result{} (a b c x y z)
+@end example
+
+An interesting example of using @code{apply} is found in the description
+of @code{mapcar}.@refill
+@end defun
+@end quotation
+
+@need 1200
+In the Texinfo source file, this example looks like this:
+
+@example
+@group
+@@defun apply function &rest arguments
+
+@@code@{apply@} calls @@var@{function@} with
+@@var@{arguments@}, just like @@code@{funcall@} but with one
+difference: the last of @@var@{arguments@} is a list of
+arguments to give to @@var@{function@}, rather than a single
+argument. We also say that this list is @@dfn@{appended@}
+to the other arguments.
+@end group
+
+@group
+@@code@{apply@} returns the result of calling
+@@var@{function@}. As with @@code@{funcall@},
+@@var@{function@} must either be a Lisp function or a
+primitive function; special forms and macros do not make
+sense in @@code@{apply@}.
+@end group
+
+@group
+@@example
+(setq f 'list)
+ @@result@{@} list
+(apply f 'x 'y 'z)
+@@error@{@} Wrong type argument: listp, z
+(apply '+ 1 2 '(3 4))
+ @@result@{@} 10
+(apply '+ '(1 2 3 4))
+ @@result@{@} 10
+
+(apply 'append '((a b c) nil (x y z) nil))
+ @@result@{@} (a b c x y z)
+@@end example
+@end group
+
+@group
+An interesting example of using @@code@{apply@} is found
+in the description of @@code@{mapcar@}.@@refill
+@@end defun
+@end group
+@end example
+
+@noindent
+In this manual, this function is listed in the Command and Variable
+Index under @code{apply}.@refill
+
+Ordinary variables and user options are described using a format like
+that for functions except that variables do not take arguments.
+
+@node Footnotes, Conditionals, Definition Commands, Top
+@comment node-name, next, previous, up
+@chapter Footnotes
+@cindex Footnotes
+@findex footnote
+
+A @dfn{footnote} is for a reference that documents or elucidates the
+primary text.@footnote{A footnote should complement or expand upon
+the primary text, but a reader should not need to read a footnote to
+understand the primary text. For a thorough discussion of footnotes,
+see @cite{The Chicago Manual of Style}, which is published by the
+University of Chicago Press.}@refill
+
+@menu
+* Footnote Commands:: How to write a footnote in Texinfo.
+* Footnote Styles:: Controlling how footnotes appear in Info.
+@end menu
+
+@node Footnote Commands, Footnote Styles, Footnotes, Footnotes
+@section Footnote Commands
+
+In Texinfo, footnotes are created with the @code{@@footnote} command.
+This command is followed immediately by a left brace, then by the text
+of the footnote, and then by a terminating right brace. The template
+is:
+
+@example
+@@footnote@{@var{text}@}
+@end example
+
+Footnotes may be of any length, but are usually short.@refill
+
+For example, this clause is followed by a sample
+footnote@footnote{Here is the sample footnote.}; in the Texinfo
+source, it looks like this:@refill
+
+@example
+@dots{}a sample footnote @@footnote@{Here is the sample
+footnote.@}; in the Texinfo source@dots{}
+@end example
+
+@strong{Warning:} Don't use footnotes in the argument of the
+@code{@@item} command for a @code{@@table} table. This doesn't work;
+because of limitations of @TeX{}, there is no way to fix it. To avoid
+the problem, move the footnote into the body text of the table.
+
+In a printed manual or book, the reference mark for a footnote is a
+small, superscripted number; the text of the footnote appears at the
+bottom of the page, below a horizontal line.@refill
+
+In Info, the reference mark for a footnote is a pair of parentheses
+with the footnote number between them, like this: @samp{(1)}.@refill
+
+@node Footnote Styles, , Footnote Commands, Footnotes
+@section Footnote Styles
+
+Info has two footnote styles, which determine where the text of the
+footnote is located:@refill
+
+@itemize @bullet
+@cindex @samp{@r{End}} node footnote style
+@item
+In the `End' node style, all the footnotes for a single node
+are placed at the end of that node. The footnotes are separated from
+the rest of the node by a line of dashes with the word
+@samp{Footnotes} within it. Each footnote begins with an
+@samp{(@var{n})} reference mark.@refill
+
+@need 700
+@noindent
+Here is an example of a single footnote in the end of node style:@refill
+
+@example
+@group
+ --------- Footnotes ---------
+
+(1) Here is a sample footnote.
+@end group
+@end example
+
+@cindex @samp{@r{Separate}} footnote style
+@item
+In the `Separate' node style, all the footnotes for a single
+node are placed in an automatically constructed node of
+their own. In this style, a ``footnote reference'' follows
+each @samp{(@var{n})} reference mark in the body of the
+node. The footnote reference is actually a cross reference
+which you use to reach the footnote node.@refill
+
+The name of the node containing the footnotes is constructed
+by appending @w{@samp{-Footnotes}} to the name of the node
+that contains the footnotes. (Consequently, the footnotes'
+node for the @file{Footnotes} node is
+@w{@file{Footnotes-Footnotes}}!) The footnotes' node has an
+`Up' node pointer that leads back to its parent node.@refill
+
+@noindent
+Here is how the first footnote in this manual looks after being
+formatted for Info in the separate node style:@refill
+
+@smallexample
+@group
+File: texinfo.info Node: Overview-Footnotes, Up: Overview
+
+(1) Note that the first syllable of "Texinfo" is
+pronounced like "speck", not "hex". @dots{}
+@end group
+@end smallexample
+@end itemize
+
+A Texinfo file may be formatted into an Info file with either footnote
+style.@refill
+
+@findex footnotestyle
+Use the @code{@@footnotestyle} command to specify an Info file's
+footnote style. Write this command at the beginning of a line followed
+by an argument, either @samp{end} for the end node style or
+@samp{separate} for the separate node style.
+
+@need 700
+For example,
+
+@example
+@@footnotestyle end
+@end example
+@noindent
+or
+@example
+@@footnotestyle separate
+@end example
+
+Write an @code{@@footnotestyle} command before or shortly after the
+end-of-header line at the beginning of a Texinfo file. (If you
+include the @code{@@footnotestyle} command between the start-of-header
+and end-of-header lines, the region formatting commands will format
+footnotes as specified.)@refill
+
+If you do not specify a footnote style, the formatting commands use
+their default style. Currently, @code{texinfo-format-buffer} and
+@code{texinfo-format-region} use the `separate' style and
+@code{makeinfo} uses the `end' style.@refill
+
+@c !!! note: makeinfo's --footnote-style option overrides footnotestyle
+@ignore
+If you use @code{makeinfo} to create the Info file, the
+@samp{--footnote-style} option determines which style is used,
+@samp{end} for the end of node style or @samp{separate} for the
+separate node style. Thus, to format the Texinfo manual in the
+separate node style, you would use the following shell command:@refill
+
+@example
+makeinfo --footnote-style=separate texinfo.texi
+@end example
+
+@noindent
+To format the Texinfo manual in the end of node style, you would
+type:@refill
+
+@example
+makeinfo --footnote-style=end texinfo.texi
+@end example
+@end ignore
+@ignore
+If you use @code{texinfo-format-buffer} or
+@code{texinfo-format-region} to create the Info file, the value of the
+@code{texinfo-footnote-style} variable controls the footnote style.
+It can be either @samp{"separate"} for the separate node style or
+@samp{"end"} for the end of node style. (You can change the value of
+this variable with the @kbd{M-x edit-options} command (@pxref{Edit
+Options, , Editing Variable Values, emacs, The GNU Emacs Manual}), or
+with the @kbd{M-x set-variable} command (@pxref{Examining, , Examining
+and Setting Variables, emacs, The GNU Emacs Manual}).@refill
+
+The @code{texinfo-footnote-style} variable also controls the style if
+you use the @kbd{M-x makeinfo-region} or @kbd{M-x makeinfo-buffer}
+command in Emacs.@refill
+@end ignore
+This chapter contains two footnotes.@refill
+
+@node Conditionals, Macros, Footnotes, Top
+@comment node-name, next, previous, up
+@chapter Conditionally Visible Text
+@cindex Conditionally visible text
+@cindex Text, conditionally visible
+@cindex Visibility of conditional text
+@cindex If text conditionally visible
+@findex ifhtml
+@findex ifinfo
+@findex iftex
+
+Sometimes it is good to use different text for a printed manual and
+its corresponding Info file. In this case, you can use the
+@dfn{conditional commands} to specify which text is for the printed manual
+and which is for the Info file.@refill
+
+@menu
+* Conditional Commands:: How to specify text for HTML, Info, or @TeX{}.
+* Using Ordinary TeX Commands:: You can use any and all @TeX{} commands.
+* set clear value:: How to designate which text to format (for
+ both Info and @TeX{}); and how to set a
+ flag to a string that you can insert.
+@end menu
+
+@node Conditional Commands, Using Ordinary TeX Commands, Conditionals, Conditionals
+@ifinfo
+@heading Using @code{@@ifinfo} and @code{@@iftex}
+@end ifinfo
+
+@code{@@ifinfo} begins segments of text that should be ignored
+by @TeX{} when it
+typesets the printed manual. The segment of text appears only
+in the Info file.
+The @code{@@ifinfo} command should appear on a line by itself; end
+the Info-only text with a line containing @code{@@end ifinfo} by
+itself. At the beginning of a Texinfo file, the Info permissions are
+contained within a region marked by @code{@@ifinfo} and @code{@@end
+ifinfo}. (@xref{Info Summary and Permissions}.)@refill
+
+The @code{@@iftex} and @code{@@end iftex} commands are similar to the
+@code{@@ifinfo} and @code{@@end ifinfo} commands, except that they
+specify text that will appear in the printed manual but not in the Info
+file. Likewise for @code{@@ifhtml} and @code{@@end ifhtml}, which
+specify text to appear only in HTML output.@refill
+
+@need 700
+For example,
+
+@example
+@@iftex
+This text will appear only in the printed manual.
+@@end iftex
+
+@@ifinfo
+However, this text will appear only in Info.
+@@end ifinfo
+@end example
+
+@noindent
+The preceding example produces the following line:
+
+@iftex
+This text will appear only in the printed manual.
+@end iftex
+
+@ifinfo
+However, this text will appear only in Info.
+@end ifinfo
+
+@noindent
+Note how you only see one of the two lines, depending on whether you
+are reading the Info version or the printed version of this
+manual.@refill
+
+The @code{@@titlepage} command is a special variant of @code{@@iftex} that
+is used for making the title and copyright pages of the printed
+manual. (@xref{titlepage, , @code{@@titlepage}}.) @refill
+
+@node Using Ordinary TeX Commands, set clear value, Conditional Commands, Conditionals
+@comment node-name, next, previous, up
+@section Using Ordinary @TeX{} Commands
+@cindex @TeX{} commands, using ordinary
+@cindex Ordinary @TeX{} commands, using
+@cindex Commands using ordinary @TeX{}
+@cindex plain @TeX{}
+
+Inside a region delineated by @code{@@iftex} and @code{@@end iftex},
+you can embed some plain @TeX{} commands. Info will ignore these
+commands since they are only in that part of the file which is seen by
+@TeX{}. You can write the @TeX{} commands as you would write them in
+a normal @TeX{} file, except that you must replace the @samp{\} used
+by @TeX{} with an @samp{@@}. For example, in the @code{@@titlepage}
+section of a Texinfo file, you can use the @TeX{} command
+@code{@@vskip} to format the copyright page. (The @code{@@titlepage}
+command causes Info to ignore the region automatically, as it does
+with the @code{@@iftex} command.)@refill
+
+However, many features of plain @TeX{} will not work, as they are
+overridden by features of Texinfo.
+
+@findex tex
+You can enter plain @TeX{} completely, and use @samp{\} in the @TeX{}
+commands, by delineating a region with the @code{@@tex} and @code{@@end
+tex} commands. (The @code{@@tex} command also causes Info to ignore the
+region, like the @code{@@iftex}
+command.)@refill
+
+@cindex Mathematical expressions
+For example, here is a mathematical expression written in
+plain @TeX{}:@refill
+
+@example
+@@tex
+$$ \chi^2 = \sum_@{i=1@}^N
+ \left (y_i - (a + b x_i)
+ \over \sigma_i\right)^2 $$
+@@end tex
+@end example
+
+@noindent
+The output of this example will appear only in a printed manual. If
+you are reading this in Info, you will not see anything after this
+paragraph.
+@iftex
+In a printed manual, the above expression looks like
+this:
+@end iftex
+
+@tex
+$$ \chi^2 = \sum_{i=1}^N
+ \left(y_i - (a + b x_i)
+ \over \sigma_i\right)^2 $$
+@end tex
+
+@node set clear value, , Using Ordinary TeX Commands, Conditionals
+@comment node-name, next, previous, up
+@section @code{@@set}, @code{@@clear}, and @code{@@value}
+
+You can direct the Texinfo formatting commands to format or ignore parts
+of a Texinfo file with the @code{@@set}, @code{@@clear}, @code{@@ifset},
+and @code{@@ifclear} commands.@refill
+
+In addition, you can use the @code{@@set @var{flag}} command to set the
+value of @var{flag} to a string of characters; and use
+@code{@@value@{@var{flag}@}} to insert that string. You can use
+@code{@@set}, for example, to set a date and use @code{@@value} to
+insert the date in several places in the Texinfo file.@refill
+
+@menu
+* ifset ifclear:: Format a region if a flag is set.
+* value:: Replace a flag with a string.
+* value Example:: An easy way to update edition information.
+@end menu
+
+@node ifset ifclear, value, set clear value, set clear value
+@subsection @code{@@ifset} and @code{@@ifclear}
+
+@findex ifset
+When a @var{flag} is set, the Texinfo formatting commands format text
+between subsequent pairs of @code{@@ifset @var{flag}} and @code{@@end
+ifset} commands. When the @var{flag} is cleared, the Texinfo formatting
+commands do @emph{not} format the text.
+
+Use the @code{@@set @var{flag}} command to turn on, or @dfn{set}, a
+@var{flag}; a @dfn{flag} can be any single word. The format for the
+command looks like this:@refill
+@findex set
+
+@example
+@@set @var{flag}
+@end example
+
+Write the conditionally formatted text between @code{@@ifset @var{flag}}
+and @code{@@end ifset} commands, like this:@refill
+
+@example
+@group
+@@ifset @var{flag}
+@var{conditional-text}
+@@end ifset
+@end group
+@end example
+
+For example, you can create one document that has two variants, such as
+a manual for a `large' and `small' model:@refill
+
+@example
+You can use this machine to dig up shrubs
+without hurting them.
+
+@@set large
+
+@@ifset large
+It can also dig up fully grown trees.
+@@end ifset
+
+Remember to replant promptly @dots{}
+@end example
+
+@noindent
+In the example, the formatting commands will format the text between
+@code{@@ifset large} and @code{@@end ifset} because the @code{large}
+flag is set.@refill
+
+@findex clear
+Use the @code{@@clear @var{flag}} command to turn off, or @dfn{clear},
+a flag. Clearing a flag is the opposite of setting a flag. The
+command looks like this:@refill
+
+@example
+@@clear @var{flag}
+@end example
+
+@noindent
+Write the command on a line of its own.
+
+When @var{flag} is cleared, the Texinfo formatting commands do
+@emph{not} format the text between @code{@@ifset @var{flag}} and
+@code{@@end ifset}; that text is ignored and does not appear in either
+printed or Info output.@refill
+
+For example, if you clear the flag of the preceding example by writing
+an @code{@@clear large} command after the @code{@@set large} command
+(but before the conditional text), then the Texinfo formatting commands
+ignore the text between the @code{@@ifset large} and @code{@@end ifset}
+commands. In the formatted output, that text does not appear; in both
+printed and Info output, you see only the lines that say, ``You can use
+this machine to dig up shrubs without hurting them. Remember to replant
+promptly @dots{}''.
+
+@findex ifclear
+If a flag is cleared with an @code{@@clear @var{flag}} command, then
+the formatting commands format text between subsequent pairs of
+@code{@@ifclear} and @code{@@end ifclear} commands. But if the flag
+is set with @code{@@set @var{flag}}, then the formatting commands do
+@emph{not} format text between an @code{@@ifclear} and an @code{@@end
+ifclear} command; rather, they ignore that text. An @code{@@ifclear}
+command looks like this:@refill
+
+@example
+@@ifclear @var{flag}
+@end example
+
+@need 700
+In brief, the commands are:@refill
+
+@table @code
+@item @@set @var{flag}
+Tell the Texinfo formatting commands that @var{flag} is set.@refill
+
+@item @@clear @var{flag}
+Tell the Texinfo formatting commands that @var{flag} is cleared.@refill
+
+@item @@ifset @var{flag}
+If @var{flag} is set, tell the Texinfo formatting commands to format
+the text up to the following @code{@@end ifset} command.@refill
+
+If @var{flag} is cleared, tell the Texinfo formatting commands to
+ignore text up to the following @code{@@end ifset} command.@refill
+
+@item @@ifclear @var{flag}
+If @var{flag} is set, tell the Texinfo formatting commands to ignore
+the text up to the following @code{@@end ifclear} command.@refill
+
+If @var{flag} is cleared, tell the Texinfo formatting commands to
+format the text up to the following @code{@@end ifclear}
+command.@refill
+@end table
+
+@node value, value Example, ifset ifclear, set clear value
+@subsection @code{@@value}
+@findex value
+
+You can use the @code{@@set} command to specify a value for a flag,
+which is expanded by the @code{@@value} command. The value is a string
+a characters.
+
+Write the @code{@@set} command like this:
+
+@example
+@@set foo This is a string.
+@end example
+
+@noindent
+This sets the value of @code{foo} to ``This is a string.''
+
+The Texinfo formatters replace an @code{@@value@{@var{flag}@}} command with
+the string to which @var{flag} is set.@refill
+
+Thus, when @code{foo} is set as shown above, the Texinfo formatters convert
+
+@example
+@group
+@@value@{foo@}
+@exdent @r{to}
+This is a string.
+@end group
+@end example
+
+You can write an @code{@@value} command within a paragraph; but you
+must write an @code{@@set} command on a line of its own.
+
+If you write the @code{@@set} command like this:
+
+@example
+@@set foo
+@end example
+
+@noindent
+without specifying a string, the value of @code{foo} is an empty string.
+
+If you clear a previously set flag with an @code{@@clear @var{flag}}
+command, a subsequent @code{@@value@{flag@}} command is invalid and the
+string is replaced with an error message that says @samp{@{No value for
+"@var{flag}"@}}.
+
+For example, if you set @code{foo} as follows:@refill
+
+@example
+@@set how-much very, very, very
+@end example
+
+@noindent
+then the formatters transform
+
+@example
+@group
+It is a @@value@{how-much@} wet day.
+@exdent @r{into}
+It is a very, very, very wet day.
+@end group
+@end example
+
+If you write
+
+@example
+@@clear how-much
+@end example
+
+@noindent
+then the formatters transform
+
+@example
+@group
+It is a @@value@{how-much@} wet day.
+@exdent @r{into}
+It is a @{No value for "how-much"@} wet day.
+@end group
+@end example
+
+@node value Example, , value, set clear value
+@subsection @code{@@value} Example
+
+You can use the @code{@@value} command to limit the number of places you
+need to change when you record an update to a manual.
+Here is how it is done in @cite{The GNU Make Manual}:
+
+@need 1000
+@noindent
+Set the flags:
+
+@example
+@group
+@@set EDITION 0.35 Beta
+@@set VERSION 3.63 Beta
+@@set UPDATED 14 August 1992
+@@set UPDATE-MONTH August 1992
+@end group
+@end example
+
+@need 750
+@noindent
+Write text for the first @code{@@ifinfo} section, for people reading the
+Texinfo file:
+
+@example
+@group
+This is Edition @@value@{EDITION@},
+last updated @@value@{UPDATED@},
+of @@cite@{The GNU Make Manual@},
+for @@code@{make@}, Version @@value@{VERSION@}.
+@end group
+@end example
+
+@need 1000
+@noindent
+Write text for the title page, for people reading the printed manual:
+@c List only the month and the year since that looks less fussy on a
+@c printed cover than a date that lists the day as well.
+
+@example
+@group
+@@title GNU Make
+@@subtitle A Program for Directing Recompilation
+@@subtitle Edition @@value@{EDITION@}, @dots{}
+@@subtitle @@value@{UPDATE-MONTH@}
+@end group
+@end example
+
+@noindent
+(On a printed cover, a date listing the month and the year looks less
+fussy than a date listing the day as well as the month and year.)
+
+@need 750
+@noindent
+Write text for the Top node, for people reading the Info file:
+
+@example
+@group
+This is Edition @@value@{EDITION@}
+of the @@cite@{GNU Make Manual@},
+last updated @@value@{UPDATED@}
+for @@code@{make@} Version @@value@{VERSION@}.
+@end group
+@end example
+
+@need 950
+After you format the manual, the text in the first @code{@@ifinfo}
+section looks like this:
+
+@example
+@group
+This is Edition 0.35 Beta, last updated 14 August 1992,
+of `The GNU Make Manual', for `make', Version 3.63 Beta.
+@end group
+@end example
+
+When you update the manual, change only the values of the flags; you do
+not need to rewrite the three sections.
+
+
+@node Macros, Format/Print Hardcopy, Conditionals, Top
+@chapter Macros: Defining New Texinfo Commands
+@cindex Macros
+@cindex Defining new Texinfo commands
+@cindex New Texinfo commands, defining
+@cindex Texinfo commands, defining new
+@cindex User-defined Texinfo commands
+
+A Texinfo @dfn{macro} allows you to define a new Texinfo command as any
+sequence of text and/or existing commands (including other macros). The
+macro can have any number of @dfn{parameters}---text you supply each
+time you use the macro. (This has nothing to do with the
+@code{@@defmac} command, which is for documenting macros in the subject
+of the manual; @pxref{Def Cmd Template}.)
+
+@menu
+* Defining Macros:: Both defining and undefining new commands.
+* Invoking Macros:: Using a macro, once you've defined it.
+@end menu
+
+
+@node Defining Macros, Invoking Macros, Macros, Macros
+@section Defining Macros
+@cindex Defining macros
+@cindex Macro definitions
+
+@findex macro
+You use the Texinfo @code{@@macro} command to define a macro. For example:
+
+@example
+@@macro @var{macro-name}@{@var{param1}, @var{param2}, @dots{}@}
+@var{text} @dots{} \@var{param1}\ @dots{}
+@@end macro
+@end example
+
+The @dfn{parameters} @var{param1}, @var{param2}, @dots{} correspond to
+arguments supplied when the macro is subsequently used in the document
+(see the next section).
+
+If a macro needs no parameters, you can define it either with an empty
+list (@samp{@@macro foo @{@}}) or with no braces at all (@samp{@@macro
+foo}).
+
+@cindex Body of a macro
+@cindex Mutually recursive macros
+@cindex Recursion, mutual
+The definition or @dfn{body} of the macro can contain any Texinfo
+commands, including previously-defined macros. (It is not possible to
+have mutually recursive Texinfo macros.) In the body, instances of a
+parameter name surrounded by backslashes, as in @samp{\@var{param1}\} in
+the example above, are replaced by the corresponding argument from the
+macro invocation.
+
+@findex unmacro
+@cindex Macros, undefining
+@cindex Undefining macros
+You can undefine a macro @var{foo} with @code{@@unmacro @var{foo}}.
+It is not an error to undefine a macro that is already undefined.
+For example:
+
+@example
+@@unmacro foo
+@end example
+
+
+@node Invoking Macros, , Defining Macros, Macros
+@section Invoking Macros
+@cindex Invoking macros
+@cindex Macro invocation
+
+After a macro is defined (see the previous section), you can use
+(@dfn{invoke}) it in your document like this:
+
+@example
+@@@var{macro-name} @{@var{arg1}, @var{arg2}, @dots{}@}
+@end example
+
+@noindent and the result will be just as if you typed the body of
+@var{macro-name} at that spot. For example:
+
+@example
+@@macro foo @{p, q@}
+Together: \p\ & \q\.
+@@end macro
+@@foo@{a, b@}
+@end example
+
+@noindent produces:
+
+@display
+Together: a & b.
+@end display
+
+@cindex Backslash, and macros
+Thus, the arguments and parameters are separated by commas and delimited
+by braces; any whitespace after (but not before) a comma is ignored. To
+insert a comma, brace, or backslash in an argument, prepend a backslash,
+as in
+
+@example
+@@@var{macro-name} @{\\\@{\@}\,@}
+@end example
+
+@noindent
+which will pass the (almost certainly error-producing) argument
+@samp{\@{@},} to @var{macro-name}.
+
+If the macro is defined to take a single argument, and is invoked
+without any braces, the entire rest of the line after the macro name is
+supplied as the argument. For example:
+
+@example
+@@macro bar @{p@}
+Twice: \p\, \p\.
+@@end macro
+@@bar aah
+@end example
+
+@noindent produces:
+
+@display
+Twice: aah, aah.
+@end display
+
+
+@node Format/Print Hardcopy, Create an Info File, Macros, Top
+@comment node-name, next, previous, up
+@chapter Format and Print Hardcopy
+@cindex Format and print hardcopy
+@cindex Hardcopy, printing it
+@cindex Making a printed manual
+@cindex Sorting indices
+@cindex Indices, sorting
+@cindex @TeX{} index sorting
+@pindex texindex
+
+There are three major shell commands for making a printed manual from a
+Texinfo file: one for converting the Texinfo file into a file that will be
+printed, a second for sorting indices, and a third for printing the
+formatted document. When you use the shell commands, you can either
+work directly in the operating system shell or work within a shell
+inside GNU Emacs.@refill
+
+If you are using GNU Emacs, you can use commands provided by Texinfo
+mode instead of shell commands. In addition to the three commands to
+format a file, sort the indices, and print the result, Texinfo mode
+offers key bindings for commands to recenter the output buffer, show the
+print queue, and delete a job from the print queue.@refill
+
+@menu
+* Use TeX:: Use @TeX{} to format for hardcopy.
+* Format with tex/texindex:: How to format in a shell.
+* Format with texi2dvi:: A simpler way to use the shell.
+* Print with lpr:: How to print.
+* Within Emacs:: How to format and print from an Emacs shell.
+* Texinfo Mode Printing:: How to format and print in Texinfo mode.
+* Compile-Command:: How to print using Emacs's compile command.
+* Requirements Summary:: @TeX{} formatting requirements summary.
+* Preparing for TeX:: What you need to do to use @TeX{}.
+* Overfull hboxes:: What are and what to do with overfull hboxes.
+* smallbook:: How to print small format books and manuals.
+* A4 Paper:: How to print on European A4 paper.
+* Cropmarks and Magnification:: How to print marks to indicate the size
+ of pages and how to print scaled up output.
+@end menu
+
+@node Use TeX, Format with tex/texindex, Format/Print Hardcopy, Format/Print Hardcopy
+@ifinfo
+@heading Use @TeX{}
+@end ifinfo
+
+The typesetting program called @TeX{} is used for formatting a Texinfo
+file. @TeX{} is a very powerful typesetting program and, if used right,
+does an exceptionally good job. @xref{Obtaining TeX, , How to Obtain
+@TeX{}}, for information on how to obtain @TeX{}.@refill
+
+The @code{makeinfo}, @code{texinfo-format-region}, and
+@code{texinfo-format-buffer} commands read the very same @@-commands
+in the Texinfo file as does @TeX{}, but process them differently to
+make an Info file; see @ref{Create an Info File}.@refill
+
+@node Format with tex/texindex, Format with texi2dvi, Use TeX, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Format using @code{tex} and @code{texindex}
+@cindex Shell formatting with @code{tex} and @code{texindex}
+@cindex Formatting with @code{tex} and @code{texindex}
+@cindex DVI file
+
+Format the Texinfo file with the shell command @code{tex} followed by
+the name of the Texinfo file. This command produces a formatted
+@sc{dvi} file as well as several auxiliary files containing indices,
+cross references, etc. The @sc{dvi} file (for @dfn{DeVice Independent}
+file) can be printed on a wide variety of printers.@refill
+
+The @code{tex} formatting command itself does not sort the indices; it
+writes an output file of unsorted index data. This is a misfeature of
+@TeX{}. (The @code{texi2dvi} command automatically generates indices;
+see @ref{Format with texi2dvi, , Format using @code{texi2dvi}}.) To
+generate a printed index after running the @code{tex} command, you first
+need a sorted index to work from. The @code{texindex} command sorts
+indices. (The source file @file{texindex.c} comes as part of the
+standard GNU distribution and is usually installed when Emacs is
+installed.)@refill
+@pindex texindex
+@ignore
+Usage: texindex [-k] [-T tempdir] infile [-o outfile] ...
+
+Each infile arg can optionally be followed by a `-o outfile' arg;
+for each infile that is not followed by a -o arg, the infile name with
+`s' (for `sorted') appended is used for the outfile.
+
+-T dir is the directory to put temp files in, instead of /tmp.
+-k means `keep tempfiles', for debugging.
+@end ignore
+
+The @code{tex} formatting command outputs unsorted index files under
+names that obey a standard convention. These names are the name of
+your main input file to the @code{tex} formatting command, with
+everything after the first period thrown away, and the two letter
+names of indices added at the end. For example, the raw index output
+files for the input file @file{foo.texinfo} would be @file{foo.cp},
+@file{foo.vr}, @file{foo.fn}, @file{foo.tp}, @file{foo.pg} and
+@file{foo.ky}. Those are exactly the arguments to give to
+@code{texindex}.@refill
+
+@need 1000
+Or else, you can use @samp{??} as ``wild-cards'' and give the command in
+this form:@refill
+
+@example
+texindex foo.??
+@end example
+
+@noindent
+This command will run @code{texindex} on all the unsorted index files,
+including any that you have defined yourself using @code{@@defindex}
+or @code{@@defcodeindex}. (You may execute @samp{texindex foo.??}
+even if there are similarly named files with two letter extensions
+that are not index files, such as @samp{foo.el}. The @code{texindex}
+command reports but otherwise ignores such files.)@refill
+
+For each file specified, @code{texindex} generates a sorted index file
+whose name is made by appending @samp{s} to the input file name. The
+@code{@@printindex} command knows to look for a file of that name.
+@code{texindex} does not alter the raw index output file.@refill
+
+After you have sorted the indices, you need to rerun the @code{tex}
+formatting command on the Texinfo file. This regenerates a formatted
+@sc{dvi} file with up-to-date index entries.@footnote{If you use more
+than one index and have cross references to an index other than the
+first, you must run @code{tex} @emph{three times} to get correct output:
+once to generate raw index data; again (after @code{texindex}) to output
+the text of the indices and determine their true page numbers; and a
+third time to output correct page numbers in cross references to them.
+However, cross references to indices are rare.}@refill
+
+To summarize, this is a three step process:
+
+@enumerate
+@item
+Run the @code{tex} formatting command on the Texinfo file. This
+generates the formatted @sc{dvi} file as well as the raw index files
+with two letter extensions.@refill
+
+@item
+Run the shell command @code{texindex} on the raw index files to sort
+them. This creates the corresponding sorted index files.@refill
+
+@item
+Rerun the @code{tex} formatting command on the Texinfo file. This
+regenerates a formatted @sc{dvi} file with the index entries in the
+correct order. This second run also corrects the page numbers for
+the cross references. (The tables of contents are always correct.)@refill
+@end enumerate
+
+You need not run @code{texindex} each time after you run the
+@code{tex} formatting. If you do not, on the next run, the @code{tex}
+formatting command will use whatever sorted index files happen to
+exist from the previous use of @code{texindex}. This is usually
+@sc{ok} while you are debugging.@refill
+
+@node Format with texi2dvi, Print with lpr, Format with tex/texindex, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Format using @code{texi2dvi}
+@pindex texi2dvi @r{(shell script)}
+
+The @code{texi2dvi} command is a shell script that automatically runs
+both @code{tex} and @code{texindex} as many times as necessary to
+produce a @sc{dvi} file with up-to-date, sorted indices. It simplifies
+the @code{tex}---@code{texindex}---@code{tex} sequence described in the
+previous section.
+
+@need 1000
+The syntax for @code{texi2dvi} is like this (where @samp{prompt$} is the
+shell prompt):@refill
+
+@example
+prompt$ @kbd{texi2dvi @var{filename}@dots{}}
+@end example
+
+@node Print with lpr, Within Emacs, Format with texi2dvi, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Shell Print Using @code{lpr -d}
+@pindex lpr @r{(@sc{dvi} print command)}
+
+You can print a @sc{dvi} file with the @sc{dvi} print command. The
+precise printing command to use depends on your system; @samp{lpr -d} is
+common. The @sc{dvi} print command may require a file name without any
+extension or with a @samp{.dvi} extension.@refill
+
+@need 1200
+The following commands, for example, sort the indices, format, and
+print the @cite{Bison Manual} (where @samp{%} is the shell
+prompt):@refill
+
+@example
+@group
+% tex bison.texinfo
+% texindex bison.??
+% tex bison.texinfo
+% lpr -d bison.dvi
+@end group
+@end example
+
+@noindent
+(Remember that the shell commands may be different at your site; but
+these are commonly used versions.)@refill
+
+@need 1000
+Using the @code{texi2dvi} shell script, you simply need type:@refill
+
+@example
+@group
+% texi2dvi bison.texinfo
+% lpr -d bison.dvi
+@end group
+@end example
+
+@node Within Emacs, Texinfo Mode Printing, Print with lpr, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section From an Emacs Shell @dots{}
+@cindex Print, format from Emacs shell
+@cindex Format, print from Emacs shell
+@cindex Shell, format, print from
+@cindex Emacs shell, format, print from
+@cindex GNU Emacs shell, format, print from
+
+You can give formatting and printing commands from a shell within GNU
+Emacs. To create a shell within Emacs, type @kbd{M-x shell}. In this
+shell, you can format and print the document. @xref{Format/Print
+Hardcopy, , Format and Print Hardcopy}, for details.@refill
+
+You can switch to and from the shell buffer while @code{tex} is
+running and do other editing. If you are formatting a long document
+on a slow machine, this can be very convenient.@refill
+
+You can also use @code{texi2dvi} from an Emacs shell. For example,
+here is how to use @code{texi2dvi} to format and print @cite{Using and
+Porting GNU CC} from a shell within Emacs (where @samp{%} is the shell
+prompt):@refill
+
+@example
+@group
+% texi2dvi gcc.texinfo
+% lpr -d gcc.dvi
+@end group
+@end example
+@ifinfo
+
+@xref{Texinfo Mode Printing}, for more information about formatting
+and printing in Texinfo mode.@refill
+@end ifinfo
+
+@node Texinfo Mode Printing, Compile-Command, Within Emacs, Format/Print Hardcopy
+@section Formatting and Printing in Texinfo Mode
+@cindex Region printing in Texinfo mode
+@cindex Format and print in Texinfo mode
+@cindex Print and format in Texinfo mode
+
+Texinfo mode provides several predefined key commands for @TeX{}
+formatting and printing. These include commands for sorting indices,
+looking at the printer queue, killing the formatting job, and
+recentering the display of the buffer in which the operations
+occur.@refill
+
+@table @kbd
+@item C-c C-t C-b
+@itemx M-x texinfo-tex-buffer
+Run @code{texi2dvi} on the current buffer.@refill
+
+@item C-c C-t C-r
+@itemx M-x texinfo-tex-region
+Run @TeX{} on the current region.@refill
+
+@item C-c C-t C-i
+@itemx M-x texinfo-texindex
+Sort the indices of a Texinfo file formatted with
+@code{texinfo-tex-region}.@refill
+
+@item C-c C-t C-p
+@itemx M-x texinfo-tex-print
+Print a @sc{dvi} file that was made with @code{texinfo-tex-region} or
+@code{texinfo-tex-buffer}.@refill
+
+@item C-c C-t C-q
+@itemx M-x tex-show-print-queue
+Show the print queue.@refill
+
+@item C-c C-t C-d
+@itemx M-x texinfo-delete-from-print-queue
+Delete a job from the print queue; you will be prompted for the job
+number shown by a preceding @kbd{C-c C-t C-q} command
+(@code{texinfo-show-tex-print-queue}).@refill
+
+@item C-c C-t C-k
+@itemx M-x tex-kill-job
+Kill the currently running @TeX{} job started by
+@code{texinfo-tex-region} or @code{texinfo-tex-buffer}, or any other
+process running in the Texinfo shell buffer.@refill
+
+@item C-c C-t C-x
+@itemx M-x texinfo-quit-job
+Quit a @TeX{} formatting job that has stopped because of an error by
+sending an @key{x} to it. When you do this, @TeX{} preserves a record
+of what it did in a @file{.log} file.@refill
+
+@item C-c C-t C-l
+@itemx M-x tex-recenter-output-buffer
+Redisplay the shell buffer in which the @TeX{} printing and formatting
+commands are run to show its most recent output.@refill
+@end table
+
+@need 1000
+Thus, the usual sequence of commands for formatting a buffer is as
+follows (with comments to the right):@refill
+
+@example
+@group
+C-c C-t C-b @r{Run @code{texi2dvi} on the buffer.}
+C-c C-t C-p @r{Print the @sc{dvi} file.}
+C-c C-t C-q @r{Display the printer queue.}
+@end group
+@end example
+
+The Texinfo mode @TeX{} formatting commands start a subshell in Emacs
+called the @file{*tex-shell*}. The @code{texinfo-tex-command},
+@code{texinfo-texindex-command}, and @code{tex-dvi-print-command}
+commands are all run in this shell.
+
+You can watch the commands operate in the @samp{*tex-shell*} buffer,
+and you can switch to and from and use the @samp{*tex-shell*} buffer
+as you would any other shell buffer.@refill
+
+@need 1500
+The formatting and print commands depend on the values of several variables.
+The default values are:@refill
+
+@example
+@group
+ @r{Variable} @r{Default value}
+
+texinfo-texi2dvi-command "texi2dvi"
+texinfo-tex-command "tex"
+texinfo-texindex-command "texindex"
+texinfo-delete-from-print-queue-command "lprm"
+texinfo-tex-trailer "@@bye"
+tex-start-of-header "%**start"
+tex-end-of-header "%**end"
+tex-dvi-print-command "lpr -d"
+tex-show-queue-command "lpq"
+@end group
+@end example
+
+You can change the values of these variables with the @kbd{M-x
+edit-options} command (@pxref{Edit Options, , Editing Variable Values,
+emacs, The GNU Emacs Manual}), with the @kbd{M-x set-variable} command
+(@pxref{Examining, , Examining and Setting Variables, emacs, The GNU
+Emacs Manual}), or with your @file{.emacs} initialization file
+(@pxref{Init File, , , emacs, The GNU Emacs Manual}).@refill
+
+@node Compile-Command, Requirements Summary, Texinfo Mode Printing, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Using the Local Variables List
+@cindex Local variables
+@cindex Compile command for formatting
+@cindex Format with the compile command
+
+Yet another way to apply the @TeX{} formatting command to a Texinfo file
+is to put that command in a @dfn{local variables list} at the end of the
+Texinfo file. You can then specify the @code{tex} or @code{texi2dvi}
+commands as a @code{compile-command} and have Emacs run it by typing
+@kbd{M-x compile}. This creates a special shell called the
+@file{*compilation*} buffer in which Emacs runs the compile command.
+For example, at the end of the @file{gdb.texinfo} file, after the
+@code{@@bye}, you could put the following:@refill
+
+@example
+@group
+@@c Local Variables:
+@@c compile-command: "texi2dvi gdb.texinfo"
+@@c End:
+@end group
+@end example
+
+@noindent
+This technique is most often used by programmers who also compile programs
+this way; see @ref{Compilation, , , emacs, The GNU Emacs Manual}.@refill
+
+@node Requirements Summary, Preparing for TeX, Compile-Command, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section @TeX{} Formatting Requirements Summary
+@cindex Requirements for formatting
+@cindex Formatting requirements
+
+Every Texinfo file that is to be input to @TeX{} must begin with a
+@code{\input} command and must contain an @code{@@setfilename} command and
+an @code{@@settitle} command:@refill
+
+@example
+\input texinfo
+@@setfilename @var{arg-not-used-by-@TeX{}}
+@@settitle @var{name-of-manual}
+@end example
+
+@noindent
+The first command instructs @TeX{} to load the macros it needs to
+process a Texinfo file, the second command opens auxiliary files, and
+the third specifies the title of printed manual.
+
+@need 1000
+Every Texinfo file must end with a line that terminates @TeX{}
+processing and forces out unfinished pages:@refill
+
+@example
+@@bye
+@end example
+
+Strictly speaking, these four lines are all a Texinfo file needs for
+@TeX{}, besides the body. (The @code{@@setfilename} line is the only
+line that a Texinfo file needs for Info formatting.)@refill
+
+Usually, the file's first line contains an @samp{@@c -*-texinfo-*-}
+comment that causes Emacs to switch to Texinfo mode when you edit the
+file. In addition, the beginning usually includes an
+@code{@@setchapternewpage} command, a title page, a copyright page, and
+permissions. Besides an @code{@@bye}, the end of a file usually
+includes indices and a table of contents.@refill
+
+@iftex
+For more information, see
+@ref{setchapternewpage, , @code{@@setchapternewpage}},
+@ref{Headings, ,Page Headings},
+@ref{Titlepage & Copyright Page},
+@ref{Printing Indices & Menus}, and
+@ref{Contents}.
+@end iftex
+@noindent
+@ifinfo
+For more information, see@*
+@ref{setchapternewpage, , @code{@@setchapternewpage}},@*
+@ref{Headings, ,Page Headings},@*
+@ref{Titlepage & Copyright Page},@*
+@ref{Printing Indices & Menus}, and@*
+@ref{Contents}.
+@end ifinfo
+
+@node Preparing for TeX, Overfull hboxes, Requirements Summary, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Preparing to Use @TeX{}
+@cindex Preparing to use @TeX{}
+@cindex @TeX{} input initialization
+@cindex @code{TEXINPUTS} environment variable
+@vindex TEXINPUTS
+@cindex @b{.profile} initialization file
+@cindex @b{.cshrc} initialization file
+@cindex Initialization file for @TeX{} input
+
+@TeX{} needs to know where to find the @file{texinfo.tex} file
+that you have told it to input with the @samp{\input texinfo} command
+at the beginning of the first line. The @file{texinfo.tex} file tells
+@TeX{} how to handle @@-commands. (@file{texinfo.tex} is
+included in the standard GNU distributions.)@refill
+
+Usually, the @file{texinfo.tex} file is put in the default directory
+that contains @TeX{} macros (the @file{/usr/lib/tex/macros}
+directory) when GNU Emacs or other GNU software is installed.
+In this case, @TeX{} will
+find the file and you do not need to do anything special.
+Alternatively, you can put @file{texinfo.tex} in the directory in
+which the Texinfo source file is located, and @TeX{} will find it
+there.@refill
+
+However, you may want to specify the location of the @code{\input} file
+yourself. One way to do this is to write the complete path for the file
+after the @code{\input} command. Another way is to set the
+@code{TEXINPUTS} environment variable in your @file{.cshrc} or
+@file{.profile} file. The @code{TEXINPUTS} environment variable will tell
+@TeX{} where to find the @file{texinfo.tex} file and any other file that
+you might want @TeX{} to use.@refill
+
+Whether you use a @file{.cshrc} or @file{.profile} file depends on
+whether you use @code{csh}, @code{sh}, or @code{bash} for your shell
+command interpreter. When you use @code{csh}, it looks to the
+@file{.cshrc} file for initialization information, and when you use
+@code{sh} or @code{bash}, it looks to the @file{.profile} file.@refill
+
+@need 1000
+In a @file{.cshrc} file, you could use the following @code{csh} command
+sequence:@refill
+
+@example
+setenv TEXINPUTS .:/usr/me/mylib:/usr/lib/tex/macros
+@end example
+
+@need 1000
+In a @file{.profile} file, you could use the following @code{sh} command
+sequence:
+
+@example
+@group
+TEXINPUTS=.:/usr/me/mylib:/usr/lib/tex/macros
+export TEXINPUTS
+@end group
+@end example
+
+@noindent
+This would cause @TeX{} to look for @file{\input} file first in the current
+directory, indicated by the @samp{.}, then in a hypothetical user's
+@file{me/mylib} directory, and finally in the system library.@refill
+
+@node Overfull hboxes, smallbook, Preparing for TeX, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Overfull ``hboxes''
+@cindex Overfull @samp{hboxes}
+@cindex @samp{hboxes}, overfull
+@cindex Final output
+
+@TeX{} is sometimes unable to typeset a line without extending it into
+the right margin. This can occur when @TeX{} comes upon what it
+interprets as a long word that it cannot hyphenate, such as an
+electronic mail network address or a very long title. When this
+happens, @TeX{} prints an error message like this:@refill
+
+@example
+Overfull \hbox (20.76302pt too wide)
+@end example
+
+@noindent
+(In @TeX{}, lines are in ``horizontal boxes'', hence the term, ``hbox''.
+The backslash, @samp{\}, is the @TeX{} equivalent of @samp{@@}.)@refill
+
+@TeX{} also provides the line number in the Texinfo source file and
+the text of the offending line, which is marked at all the places that
+@TeX{} knows how to hyphenate words.
+@xref{Debugging with TeX, , Catching Errors with @TeX{} Formatting},
+for more information about typesetting errors.@refill
+
+If the Texinfo file has an overfull hbox, you can rewrite the sentence
+so the overfull hbox does not occur, or you can decide to leave it. A
+small excursion into the right margin often does not matter and may not
+even be noticeable.@refill
+
+@cindex Black rectangle in hardcopy
+@cindex Rectangle, ugly, black in hardcopy
+However, unless told otherwise, @TeX{} will print a large, ugly, black
+rectangle beside the line that contains the overfull hbox. This is so
+you will notice the location of the problem if you are correcting a
+draft.@refill
+
+@need 1000
+@findex finalout
+To prevent such a monstrosity from marring your final printout, write
+the following in the beginning of the Texinfo file on a line of its own,
+before the @code{@@titlepage} command:@refill
+
+@example
+@@finalout
+@end example
+
+@node smallbook, A4 Paper, Overfull hboxes, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Printing ``Small'' Books
+@findex smallbook
+@cindex Small book size
+@cindex Book, printing small
+@cindex Page sizes for books
+@cindex Size of printed book
+
+By default, @TeX{} typesets pages for printing in an 8.5 by 11 inch
+format. However, you can direct @TeX{} to typeset a document in a 7 by
+9.25 inch format that is suitable for bound books by inserting the
+following command on a line by itself at the beginning of the Texinfo
+file, before the title page:@refill
+
+@example
+@@smallbook
+@end example
+
+@noindent
+(Since regular sized books are often about 7 by 9.25 inches, this
+command might better have been called the @code{@@regularbooksize}
+command, but it came to be called the @code{@@smallbook} command by
+comparison to the 8.5 by 11 inch format.)@refill
+
+If you write the @code{@@smallbook} command between the
+start-of-header and end-of-header lines, the Texinfo mode @TeX{}
+region formatting command, @code{texinfo-tex-region}, will format the
+region in ``small'' book size (@pxref{Start of Header}).@refill
+
+The Free Software Foundation distributes printed copies of @cite{The GNU
+Emacs Manual} and other manuals in the ``small'' book size.
+@xref{smallexample & smalllisp, , @code{@@smallexample} and
+@code{@@smalllisp}}, for information about commands that make it easier
+to produce examples for a smaller manual.@refill
+
+@node A4 Paper, Cropmarks and Magnification, smallbook, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Printing on A4 Paper
+@cindex A4 paper, printing on
+@cindex Paper size, European A4
+@cindex European A4 paper
+@findex afourpaper
+
+You can tell @TeX{} to typeset a document for printing on European size
+A4 paper with the @code{@@afourpaper} command. Write the command on a
+line by itself between @code{@@iftex} and @code{@@end iftex} lines near
+the beginning of the Texinfo file, before the title page:@refill
+
+For example, this is how you would write the header for this manual:@refill
+
+@example
+@group
+\input texinfo @@c -*-texinfo-*-
+@@c %**start of header
+@@setfilename texinfo
+@@settitle Texinfo
+@@syncodeindex vr fn
+@@iftex
+@@afourpaper
+@@end iftex
+@@c %**end of header
+@end group
+@end example
+
+@node Cropmarks and Magnification, , A4 Paper, Format/Print Hardcopy
+@comment node-name, next, previous, up
+@section Cropmarks and Magnification
+
+@findex cropmarks
+@cindex Cropmarks for printing
+@cindex Printing cropmarks
+You can attempt to direct @TeX{} to print cropmarks at the corners of
+pages with the @code{@@cropmarks} command. Write the @code{@@cropmarks}
+command on a line by itself between @code{@@iftex} and @code{@@end
+iftex} lines near the beginning of the Texinfo file, before the title
+page, like this:@refill
+
+@example
+@group
+@@iftex
+@@cropmarks
+@@end iftex
+@end group
+@end example
+
+This command is mainly for printers that typeset several pages on one
+sheet of film; but you can attempt to use it to mark the corners of a
+book set to 7 by 9.25 inches with the @code{@@smallbook} command.
+(Printers will not produce cropmarks for regular sized output that is
+printed on regular sized paper.) Since different printing machines work
+in different ways, you should explore the use of this command with a
+spirit of adventure. You may have to redefine the command in the
+@file{texinfo.tex} definitions file.@refill
+
+@findex mag @r{(@TeX{} command)}
+@cindex Magnified printing
+@cindex Larger or smaller pages
+You can attempt to direct @TeX{} to typeset pages larger or smaller than
+usual with the @code{\mag} @TeX{} command. Everything that is typeset
+is scaled proportionally larger or smaller. (@code{\mag} stands for
+``magnification''.) This is @emph{not} a Texinfo @@-command, but is a
+plain @TeX{} command that is prefixed with a backslash. You have to
+write this command between @code{@@tex} and @code{@@end tex}
+(@pxref{Using Ordinary TeX Commands, , Using Ordinary @TeX{}
+Commands}).@refill
+
+Follow the @code{\mag} command with an @samp{=} and then a number that
+is 1000 times the magnification you desire. For example, to print pages
+at 1.2 normal size, write the following near the beginning of the
+Texinfo file, before the title page:@refill
+
+@example
+@group
+@@tex
+\mag=1200
+@@end tex
+@end group
+@end example
+
+With some printing technologies, you can print normal-sized copies that
+look better than usual by using a larger-than-normal master.@refill
+
+Depending on your system, @code{\mag} may not work or may work only at
+certain magnifications. Be prepared to experiment.@refill
+
+@node Create an Info File, Install an Info File, Format/Print Hardcopy, Top
+@comment node-name, next, previous, up
+@chapter Creating an Info File
+@cindex Creating an Info file
+@cindex Info, creating an on-line file
+@cindex Formatting a file for Info
+
+@code{makeinfo} is a utility that converts a Texinfo file into an Info
+file; @code{texinfo-format-region} and @code{texinfo-format-buffer} are
+GNU Emacs functions that do the same.@refill
+
+A Texinfo file must possess an @code{@@setfilename} line near its
+beginning, otherwise the Info formatting commands will fail.@refill
+
+For information on installing the Info file in the Info system, see
+@ref{Install an Info File}.@refill
+
+@menu
+* makeinfo advantages:: @code{makeinfo} provides better error checking.
+* Invoking makeinfo:: How to run @code{makeinfo} from a shell.
+* makeinfo options:: Specify fill-column and other options.
+* Pointer Validation:: How to check that pointers point somewhere.
+* makeinfo in Emacs:: How to run @code{makeinfo} from Emacs.
+* texinfo-format commands:: Two Info formatting commands written
+ in Emacs Lisp are an alternative
+ to @code{makeinfo}.
+* Batch Formatting:: How to format for Info in Emacs Batch mode.
+* Tag and Split Files:: How tagged and split files help Info
+ to run better.
+@end menu
+
+@node makeinfo advantages, Invoking makeinfo, Create an Info File, Create an Info File
+@ifinfo
+@heading @code{makeinfo} Preferred
+@end ifinfo
+
+The @code{makeinfo} utility creates an Info file from a Texinfo source
+file more quickly than either of the Emacs formatting commands and
+provides better error messages. We recommend it. @code{makeinfo} is a
+C program that is independent of Emacs. You do not need to run Emacs to
+use @code{makeinfo}, which means you can use @code{makeinfo} on machines
+that are too small to run Emacs. You can run @code{makeinfo} in
+any one of three ways: from an operating system shell, from a shell
+inside Emacs, or by typing a key command in Texinfo mode in Emacs.
+@refill
+
+The @code{texinfo-format-region} and the @code{texinfo-format-buffer}
+commands are useful if you cannot run @code{makeinfo}. Also, in some
+circumstances, they format short regions or buffers more quickly than
+@code{makeinfo}.@refill
+
+@node Invoking makeinfo, makeinfo options, makeinfo advantages, Create an Info File
+@section Running @code{makeinfo} from a Shell
+
+To create an Info file from a Texinfo file, type @code{makeinfo}
+followed by the name of the Texinfo file. Thus, to create the Info
+file for Bison, type the following at the shell prompt (where @samp{%}
+is the prompt):@refill
+
+@example
+% makeinfo bison.texinfo
+@end example
+
+(You can run a shell inside Emacs by typing @kbd{M-x
+shell}.)@refill
+
+@ifinfo
+Sometimes you will want to specify options. For example, if you wish
+to discover which version of @code{makeinfo} you are using,
+type:@refill
+
+@example
+% makeinfo --version
+@end example
+
+@xref{makeinfo options}, for more information.
+@end ifinfo
+
+@node makeinfo options, Pointer Validation, Invoking makeinfo, Create an Info File
+@comment node-name, next, previous, up
+@section Options for @code{makeinfo}
+@cindex @code{makeinfo} options
+@cindex Options for @code{makeinfo}
+
+The @code{makeinfo} command takes a number of options. Most often,
+options are used to set the value of the fill column and specify the
+footnote style. Each command line option is a word preceded by
+@samp{--}@footnote{@samp{--} has replaced @samp{+}, the old introductory
+character, to maintain POSIX.2 compatibility without losing long-named
+options.} or a letter preceded by @samp{-}. You can use abbreviations
+for the option names as long as they are unique.@refill
+
+For example, you could use the following command to create an Info
+file for @file{bison.texinfo} in which each line is filled to only 68
+columns (where @samp{%} is the prompt):@refill
+
+@example
+% makeinfo --fill-column=68 bison.texinfo
+@end example
+
+You can write two or more options in sequence, like this:@refill
+
+@example
+% makeinfo --no-split --fill-column=70 @dots{}
+@end example
+
+@noindent
+This would keep the Info file together as one possibly very long
+file and would also set the fill column to 70.@refill
+
+@iftex
+If you wish to discover which version of @code{makeinfo}
+you are using, type:@refill
+
+@example
+% makeinfo --version
+@end example
+@end iftex
+
+The options are:@refill
+
+@need 100
+@table @code
+@item -D @var{var}
+Cause @var{var} to be defined. This is equivalent to
+@code{@@set @var{var}} in the Texinfo file.
+
+@need 150
+@item --error-limit @var{limit}
+Set the maximum number of errors that @code{makeinfo} will report
+before exiting (on the assumption that continuing would be useless).
+The default number of errors that can be reported before
+@code{makeinfo} gives up is 100.@refill
+
+@need 150
+@item --fill-column @var{width}
+Specify the maximum number of columns in a line; this is the right-hand
+edge of a line. Paragraphs that are filled will be filled to this
+width. (Filling is the process of breaking up and connecting lines so
+that lines are the same length as or shorter than the number specified
+as the fill column. Lines are broken between words.) The default value
+for @code{fill-column} is 72.
+@refill
+
+@item --footnote-style @var{style}
+Set the footnote style to @var{style}, either @samp{end} for the end
+node style or @samp{separate} for the separate node style. The value
+set by this option overrides the value set in a Texinfo file by an
+@code{@@footnotestyle} command. When the footnote style is
+@samp{separate}, @code{makeinfo} makes a new node containing the
+footnotes found in the current node. When the footnote style is
+@samp{end}, @code{makeinfo} places the footnote references at the end
+of the current node.@refill
+
+@need 150
+@item -I @var{dir}
+Add @code{dir} to the directory search list for finding files that are
+included using the @code{@@include} command. By default,
+@code{makeinfo} searches only the current directory.
+
+@need 150
+@item --no-headers
+Do not include menus or node lines in the output. This results in an
+@sc{ascii} file that you cannot read in Info since it does not contain
+the requisite nodes or menus; but you can print such a file in a
+single, typewriter-like font and produce acceptable output.
+
+@need 150
+@item --no-split
+Suppress the splitting stage of @code{makeinfo}. Normally, large
+output files (where the size is greater than 70k bytes) are split into
+smaller subfiles, each one approximately 50k bytes. If you specify
+@samp{--no-split}, @code{makeinfo} will not split up the output
+file.@refill
+
+@need 100
+@item --no-pointer-validate
+@item --no-validate
+Suppress the pointer-validation phase of @code{makeinfo}. Normally,
+after a Texinfo file is processed, some consistency checks are made to
+ensure that cross references can be resolved, etc.
+@xref{Pointer Validation}.@refill
+
+@need 150
+@item --no-warn
+Suppress the output of warning messages. This does @emph{not}
+suppress the output of error messages, only warnings. You might
+want this if the file you are creating has examples of Texinfo cross
+references within it, and the nodes that are referenced do not actually
+exist.@refill
+
+@item --no-number-footnotes
+Suppress automatic footnote numbering. By default, @code{makeinfo}
+numbers each footnote sequentially in a single node, resetting the
+current footnote number to 1 at the start of each node.
+
+@need 150
+@item --output @var{file}
+@itemx -o @var{file}
+Specify that the output should be directed to @var{file} and not to the
+file name specified in the @code{@@setfilename} command found in the Texinfo
+source. @var{file} can be the special token @samp{-}, which specifies
+standard output.
+
+@need 150
+@item --paragraph-indent @var{indent}
+Set the paragraph indentation style to @var{indent}. The value set by
+this option overrides the value set in a Texinfo file by an
+@code{@@paragraphindent} command. The value of @var{indent} is
+interpreted as follows:@refill
+
+@itemize @bullet
+@item
+If the value of @var{indent} is @samp{asis}, do not change the
+existing indentation at the starts of paragraphs.@refill
+
+@item
+If the value of @var{indent} is zero, delete any existing
+indentation.@refill
+
+@item
+If the value of @var{indent} is greater than zero, indent each
+paragraph by that number of spaces.@refill
+@end itemize
+
+@need 100
+@item --reference-limit @var{limit}
+Set the value of the number of references to a node that
+@code{makeinfo} will make without reporting a warning. If a node has more
+than this number of references in it, @code{makeinfo} will make the
+references but also report a warning.@refill
+
+@need 150
+@item -U @var{var}
+Cause @var{var} to be undefined. This is equivalent to
+@code{@@clear @var{var}} in the Texinfo file.
+
+@need 100
+@item --verbose
+Cause @code{makeinfo} to display messages saying what it is doing.
+Normally, @code{makeinfo} only outputs messages if there are errors or
+warnings.@refill
+
+@need 100
+@item --version
+Report the version number of this copy of @code{makeinfo}.@refill
+@end table
+
+@node Pointer Validation, makeinfo in Emacs, makeinfo options, Create an Info File
+@section Pointer Validation
+@cindex Pointer validation with @code{makeinfo}
+@cindex Validation of pointers
+
+If you do not suppress pointer-validation, @code{makeinfo} will check
+the validity of the final Info file. Mostly, this means ensuring that
+nodes you have referenced really exist. Here is a complete list of what
+is checked:@refill
+
+@enumerate
+@item
+If a `Next', `Previous', or `Up' node reference is a reference to a
+node in the current file and is not an external reference such as to
+@file{(dir)}, then the referenced node must exist.@refill
+
+@item
+In every node, if the `Previous' node is different from the `Up' node,
+then the `Previous' node must also be pointed to by a `Next' node.@refill
+
+@item
+Every node except the `Top' node must have an `Up' pointer.@refill
+
+@item
+The node referenced by an `Up' pointer must contain a reference to the
+current node in some manner other than through a `Next' reference.
+This includes menu entries and cross references.@refill
+
+@item
+If the `Next' reference of a node is not the same as the `Next' reference
+of the `Up' reference, then the node referenced by the `Next' pointer
+must have a `Previous' pointer that points back to the current node.
+This rule allows the last node in a section to point to the first node
+of the next chapter.@refill
+@end enumerate
+
+@node makeinfo in Emacs, texinfo-format commands, Pointer Validation, Create an Info File
+@section Running @code{makeinfo} inside Emacs
+@cindex Running @code{makeinfo} in Emacs
+@cindex @code{makeinfo} inside Emacs
+@cindex Shell, running @code{makeinfo} in
+
+You can run @code{makeinfo} in GNU Emacs Texinfo mode by using either the
+@code{makeinfo-region} or the @code{makeinfo-buffer} commands. In
+Texinfo mode, the commands are bound to @kbd{C-c C-m C-r} and @kbd{C-c
+C-m C-b} by default.@refill
+
+@table @kbd
+@item C-c C-m C-r
+@itemx M-x makeinfo-region
+Format the current region for Info.@refill
+@findex makeinfo-region
+
+@item C-c C-m C-b
+@itemx M-x makeinfo-buffer
+Format the current buffer for Info.@refill
+@findex makeinfo-buffer
+@end table
+
+When you invoke either @code{makeinfo-region} or
+@code{makeinfo-buffer}, Emacs prompts for a file name, offering the
+name of the visited file as the default. You can edit the default
+file name in the minibuffer if you wish, before typing @key{RET} to
+start the @code{makeinfo} process.@refill
+
+The Emacs @code{makeinfo-region} and @code{makeinfo-buffer} commands
+run the @code{makeinfo} program in a temporary shell buffer. If
+@code{makeinfo} finds any errors, Emacs displays the error messages in
+the temporary buffer.@refill
+
+@cindex Errors, parsing
+@cindex Parsing errors
+@findex next-error
+You can parse the error messages by typing @kbd{C-x `}
+(@code{next-error}). This causes Emacs to go to and position the
+cursor on the line in the Texinfo source that @code{makeinfo} thinks
+caused the error. @xref{Compilation, , Running @code{make} or
+Compilers Generally, emacs, The GNU Emacs Manual}, for more
+information about using the @code{next-error} command.@refill
+
+In addition, you can kill the shell in which the @code{makeinfo}
+command is running or make the shell buffer display its most recent
+output.@refill
+
+@table @kbd
+@item C-c C-m C-k
+@itemx M-x makeinfo-kill-job
+@findex makeinfo-kill-job
+Kill the current running @code{makeinfo} job created by
+@code{makeinfo-region} or @code{makeinfo-buffer}.@refill
+
+@item C-c C-m C-l
+@itemx M-x makeinfo-recenter-output-buffer
+@findex makeinfo-recenter-output-buffer
+Redisplay the @code{makeinfo} shell buffer to display its most recent
+output.@refill
+@end table
+
+@noindent
+(Note that the parallel commands for killing and recentering a @TeX{}
+job are @kbd{C-c C-t C-k} and @kbd{C-c C-t C-l}. @xref{Texinfo Mode
+Printing}.)@refill
+
+You can specify options for @code{makeinfo} by setting the
+@code{makeinfo-options} variable with either the @kbd{M-x
+edit-options} or the @kbd{M-x set-variable} command, or by setting the
+variable in your @file{.emacs} initialization file.@refill
+
+For example, you could write the following in your @file{.emacs} file:@refill
+
+@example
+@group
+(setq makeinfo-options
+ "--paragraph-indent=0 --no-split
+ --fill-column=70 --verbose")
+@end group
+@end example
+
+@c If you write these three cross references using xref, you see
+@c three references to the same named manual, which looks strange.
+@iftex
+For more information, see @ref{makeinfo options, , Options for
+@code{makeinfo}}, as well as ``Editing Variable Values,''``Examining and
+Setting Variables,'' and ``Init File'' in the @cite{The GNU Emacs
+Manual}.
+@end iftex
+@noindent
+@ifinfo
+For more information, see@*
+@ref{Edit Options, , Editing Variable Values, emacs, The GNU Emacs Manual},@*
+@ref{Examining, , Examining and Setting Variables, emacs, The GNU Emacs Manual},@*
+@ref{Init File, , , emacs, The GNU Emacs Manual}, and@*
+@ref{makeinfo options, , Options for @code{makeinfo}}.
+@end ifinfo
+
+@node texinfo-format commands, Batch Formatting, makeinfo in Emacs, Create an Info File
+@comment node-name, next, previous, up
+@section The @code{texinfo-format@dots{}} Commands
+@findex texinfo-format-region
+@findex texinfo-format-buffer
+
+In GNU Emacs in Texinfo mode, you can format part or all of a Texinfo
+file with the @code{texinfo-format-region} command. This formats the
+current region and displays the formatted text in a temporary buffer
+called @samp{*Info Region*}.@refill
+
+Similarly, you can format a buffer with the
+@code{texinfo-format-buffer} command. This command creates a new
+buffer and generates the Info file in it. Typing @kbd{C-x C-s} will
+save the Info file under the name specified by the
+@code{@@setfilename} line which must be near the beginning of the
+Texinfo file.@refill
+
+@table @kbd
+@item C-c C-e C-r
+@itemx @code{texinfo-format-region}
+Format the current region for Info.
+@findex texinfo-format-region
+
+@item C-c C-e C-b
+@itemx @code{texinfo-format-buffer}
+Format the current buffer for Info.
+@findex texinfo-format-buffer
+@end table
+
+The @code{texinfo-format-region} and @code{texinfo-format-buffer}
+commands provide you with some error checking, and other functions can
+provide you with further help in finding formatting errors. These
+procedures are described in an appendix; see @ref{Catching Mistakes}.
+However, the @code{makeinfo} program is often faster and
+provides better error checking (@pxref{makeinfo in Emacs}).@refill
+
+@node Batch Formatting, Tag and Split Files, texinfo-format commands, Create an Info File
+@comment node-name, next, previous, up
+@section Batch Formatting
+@cindex Batch formatting for Info
+@cindex Info batch formatting
+
+You can format Texinfo files for Info using @code{batch-texinfo-format}
+and Emacs Batch mode. You can run Emacs in Batch mode from any shell,
+including a shell inside of Emacs. (@xref{Command Switches, , Command
+Line Switches and Arguments, emacs, The GNU Emacs Manual}.)@refill
+
+Here is the command to format all the files that end in @file{.texinfo}
+in the current directory (where @samp{%} is the shell prompt):@refill
+
+@example
+% emacs -batch -funcall batch-texinfo-format *.texinfo
+@end example
+
+@noindent
+Emacs processes all the files listed on the command line, even if an
+error occurs while attempting to format some of them.@refill
+
+Run @code{batch-texinfo-format} only with Emacs in Batch mode as shown;
+it is not interactive. It kills the Batch mode Emacs on completion.@refill
+
+@code{batch-texinfo-format} is convenient if you lack @code{makeinfo}
+and want to format several Texinfo files at once. When you use Batch
+mode, you create a new Emacs process. This frees your current Emacs, so
+you can continue working in it. (When you run
+@code{texinfo-format-region} or @code{texinfo-format-buffer}, you cannot
+use that Emacs for anything else until the command finishes.)@refill
+
+@node Tag and Split Files, , Batch Formatting, Create an Info File
+@comment node-name, next, previous, up
+@section Tag Files and Split Files
+@cindex Making a tag table automatically
+@cindex Tag table, making automatically
+
+If a Texinfo file has more than 30,000 bytes,
+@code{texinfo-format-buffer} automatically creates a tag table
+for its Info file; @code{makeinfo} always creates a tag table. With
+a @dfn{tag table}, Info can jump to new nodes more quickly than it can
+otherwise.@refill
+
+@cindex Indirect subfiles
+In addition, if the Texinfo file contains more than about 70,000
+bytes, @code{texinfo-format-buffer} and @code{makeinfo} split the
+large Info file into shorter @dfn{indirect} subfiles of about 50,000
+bytes each. Big files are split into smaller files so that Emacs does
+not need to make a large buffer to hold the whole of a large Info
+file; instead, Emacs allocates just enough memory for the small, split
+off file that is needed at the time. This way, Emacs avoids wasting
+memory when you run Info. (Before splitting was implemented, Info
+files were always kept short and @dfn{include files} were designed as
+a way to create a single, large printed manual out of the smaller Info
+files. @xref{Include Files}, for more information. Include files are
+still used for very large documents, such as @cite{The Emacs Lisp
+Reference Manual}, in which each chapter is a separate file.)@refill
+
+When a file is split, Info itself makes use of a shortened version of
+the original file that contains just the tag table and references to
+the files that were split off. The split off files are called
+@dfn{indirect} files.@refill
+
+The split off files have names that are created by appending @w{@samp{-1}},
+@w{@samp{-2}}, @w{@samp{-3}} and so on to the file name specified by the
+@code{@@setfilename} command. The shortened version of the original file
+continues to have the name specified by @code{@@setfilename}.@refill
+
+At one stage in writing this document, for example, the Info file was saved
+as @file{test-texinfo} and that file looked like this:@refill
+
+@example
+@group
+Info file: test-texinfo, -*-Text-*-
+produced by texinfo-format-buffer
+from file: new-texinfo-manual.texinfo
+
+^_
+Indirect:
+test-texinfo-1: 102
+test-texinfo-2: 50422
+@end group
+@group
+test-texinfo-3: 101300
+^_^L
+Tag table:
+(Indirect)
+Node: overview^?104
+Node: info file^?1271
+@end group
+@group
+Node: printed manual^?4853
+Node: conventions^?6855
+@dots{}
+@end group
+@end example
+
+@noindent
+(But @file{test-texinfo} had far more nodes than are shown here.) Each of
+the split off, indirect files, @file{test-texinfo-1},
+@file{test-texinfo-2}, and @file{test-texinfo-3}, is listed in this file
+after the line that says @samp{Indirect:}. The tag table is listed after
+the line that says @samp{Tag table:}. @refill
+
+In the list of indirect files, the number following the file name
+records the cumulative number of bytes in the preceding indirect files,
+not counting the file list itself, the tag table, or the permissions
+text in each file. In the tag table, the number following the node name
+records the location of the beginning of the node, in bytes from the
+beginning.@refill
+
+If you are using @code{texinfo-format-buffer} to create Info files,
+you may want to run the @code{Info-validate} command. (The
+@code{makeinfo} command does such a good job on its own, you do not
+need @code{Info-validate}.) However, you cannot run the @kbd{M-x
+Info-validate} node-checking command on indirect files. For
+information on how to prevent files from being split and how to
+validate the structure of the nodes, see @ref{Using
+Info-validate}.@refill
+
+
+@node Install an Info File, Command List, Create an Info File, Top
+@comment node-name, next, previous, up
+@chapter Installing an Info File
+@cindex Installing an Info file
+@cindex Info file installation
+@cindex @file{dir} directory for Info installation
+
+Info files are usually kept in the @file{info} directory. You can read
+Info files using the standalone Info program or the Info reader built
+into Emacs. (@inforef{Top, info, info}, for an introduction to Info.)
+
+@menu
+* Directory file:: The top level menu for all Info files.
+* New Info File:: Listing a new info file.
+* Other Info Directories:: How to specify Info files that are
+ located in other directories.
+* Installing Dir Entries:: How to specify what menu entry to add
+ to the Info directory.
+* Invoking install-info:: @code{install-info} options.
+@end menu
+
+@node Directory file, New Info File, Install an Info File, Install an Info File
+@ifinfo
+@heading The @file{dir} File
+@end ifinfo
+
+For Info to work, the @file{info} directory must contain a file that
+serves as a top level directory for the Info system. By convention,
+this file is called @file{dir}. (You can find the location of this file
+within Emacs by typing @kbd{C-h i} to enter Info and then typing
+@kbd{C-x C-f} to see the pathname to the @file{info} directory.)
+
+The @file{dir} file is itself an Info file. It contains the top level
+menu for all the Info files in the system. The menu looks like
+this:@refill
+
+@example
+@group
+* Menu:
+
+* Info: (info). Documentation browsing system.
+* Emacs: (emacs). The extensible, self-documenting
+ text editor.
+* Texinfo: (texinfo). With one source file, make
+ either a printed manual using
+ TeX or an Info file.
+@dots{}
+@end group
+@end example
+
+Each of these menu entries points to the `Top' node of the Info file
+that is named in parentheses. (The menu entry does not need to
+specify the `Top' node, since Info goes to the `Top' node if no node
+name is mentioned. @xref{Other Info Files, , Nodes in Other Info
+Files}.)@refill
+
+Thus, the @samp{Info} entry points to the `Top' node of the
+@file{info} file and the @samp{Emacs} entry points to the `Top' node
+of the @file{emacs} file.@refill
+
+In each of the Info files, the `Up' pointer of the `Top' node refers
+back to the @code{dir} file. For example, the line for the `Top'
+node of the Emacs manual looks like this in Info:@refill
+
+@example
+File: emacs Node: Top, Up: (DIR), Next: Distrib
+@end example
+
+@noindent
+(Note that in this case, the @file{dir} file name is written in upper
+case letters---it can be written in either upper or lower case. Info
+has a feature that it will change the case of the file name to lower
+case if it cannot find the name as written.)@refill
+@c !!! Can any file name be written in upper or lower case,
+@c or is dir a special case?
+@c Yes, apparently so, at least with Gillespie's Info. --rjc 24mar92
+
+
+@node New Info File, Other Info Directories, Directory file, Install an Info File
+@section Listing a New Info File
+@cindex Adding a new info file
+@cindex Listing a new info file
+@cindex New info file, listing it in @file{dir} file
+@cindex Info file, listing new one
+@cindex @file{dir} file listing
+
+To add a new Info file to your system, you must write a menu entry to
+add to the menu in the @file{dir} file in the @file{info} directory.
+For example, if you were adding documentation for GDB, you would write
+the following new entry:@refill
+
+@example
+* GDB: (gdb). The source-level C debugger.
+@end example
+
+@noindent
+The first part of the menu entry is the menu entry name, followed by a
+colon. The second part is the name of the Info file, in parentheses,
+followed by a period. The third part is the description.
+
+The name of an Info file often has a @file{.info} extension. Thus, the
+Info file for GDB might be called either @file{gdb} or @file{gdb.info}.
+The Info reader programs automatically try the file name both with and
+without @file{.info}; so it is better to avoid clutter and not to write
+@samp{.info} explicitly in the menu entry. For example, the GDB menu
+entry should use just @samp{gdb} for the file name, not @samp{gdb.info}.
+
+
+@node Other Info Directories, Installing Dir Entries, New Info File, Install an Info File
+@comment node-name, next, previous, up
+@section Info Files in Other Directories
+@cindex Installing Info in another directory
+@cindex Info installed in another directory
+@cindex Another Info directory
+
+If an Info file is not in the @file{info} directory, there are three
+ways to specify its location:@refill
+
+@itemize @bullet
+@item
+Write the pathname in the @file{dir} file as the second part of the
+menu.@refill
+
+@item
+If you are using Emacs, list the name of the file in a second @file{dir}
+file, in its directory; and then add the name of that directory to the
+@code{Info-directory-list} variable in your personal or site
+initialization file.
+
+This tells Emacs's Info reader where to look for @file{dir}
+files. Emacs merges the files named @file{dir} from each of the listed
+directories. (In Emacs Version 18, you can set the
+@code{Info-directory} variable to the name of only one
+directory.)@refill
+
+@item
+Specify the @file{info} directory name in the @code{INFOPATH}
+environment variable in your @file{.profile} or @file{.cshrc}
+initialization file. (Only you and others who set this environment
+variable will be able to find Info files whose location is specified
+this way.)@refill
+@end itemize
+
+For example, to reach a test file in the @file{~bob/manuals}
+directory, you could add an entry like this to the menu in the
+@file{dir} file:@refill
+
+@example
+* Test: (/home/bob/manuals/info-test). Bob's own test file.
+@end example
+
+@noindent
+In this case, the absolute file name of the @file{info-test} file is
+written as the second part of the menu entry.@refill
+
+@vindex Info-directory-list
+Alternatively, you could write the following in your @file{.emacs}
+file:@refill
+
+@example
+@group
+(setq Info-directory-list
+ '("/home/bob/manuals"
+ "/usr/local/emacs/info"))
+@end group
+@end example
+
+@c reworded to avoid overfill hbox
+This tells Emacs to merge the @file{dir} file from the
+@file{/home/bob/manuals} directory with the @file{dir} file from the
+@file{"/usr/local/emacs/info}" directory. Info will list the
+@file{/home/bob/manuals/info-test} file as a menu entry in the
+@file{/home/bob/manuals/dir} file.@refill
+
+@vindex INFOPATH
+Finally, you can tell Info where to look by setting the
+@code{INFOPATH} environment variable in your @file{.cshrc} or
+@file{.profile} file.@refill
+
+If you use @code{sh} or @code{bash} for your shell command interpreter,
+you must set the @code{INFOPATH} environment variable in the
+@file{.profile} initialization file; but if you use @code{csh}, you must
+set the variable in the @file{.cshrc} initialization file. The two
+files use slightly different command formats.@refill
+
+@itemize @bullet
+@item
+In a @file{.cshrc} file, you could set the @code{INFOPATH}
+variable as follows:@refill
+
+@smallexample
+setenv INFOPATH .:~bob/manuals:/usr/local/emacs/info
+@end smallexample
+
+@item
+In a @file{.profile} file, you would achieve the same effect by
+writing:@refill
+
+@smallexample
+INFOPATH=.:~bob/manuals:/usr/local/emacs/info
+export INFOPATH
+@end smallexample
+@end itemize
+
+@noindent
+The @samp{.} indicates the current directory. Emacs uses the
+@code{INFOPATH} environment variable to initialize the value of Emacs's
+own @code{Info-directory-list} variable.
+
+
+@node Installing Dir Entries, Invoking install-info, Other Info Directories, Install an Info File
+@section Installing Info Directory Files
+
+When you install an Info file onto your system, you can use the program
+@code{install-info} to update the Info directory file @file{dir}.
+Normally the makefile for the package runs @code{install-info}, just
+after copying the Info file into its proper installed location.
+
+@findex dircategory
+@findex direntry
+In order for the Info file to work with @code{install-info}, you should
+use the commands @code{@@dircategory} and @code{@@direntry} in the
+Texinfo source file. Use @code{@@direntry} to specify the menu entry to
+add to the Info directory file, and use @code{@@dircategory} to specify
+which part of the Info directory to put it in. Here is how these
+commands are used in this manual:
+
+@smallexample
+@@dircategory Texinfo documentation system
+@@direntry
+* Texinfo: (texinfo). The GNU documentation format.
+* install-info: (texinfo)Invoking install-info. @dots{}
+@dots{}
+@@end direntry
+@end smallexample
+
+Here's what this produces in the Info file:
+
+@smallexample
+INFO-DIR-SECTION Texinfo documentation system
+START-INFO-DIR-ENTRY
+* Texinfo: (texinfo). The GNU documentation format.
+* install-info: (texinfo)Invoking install-info. @dots{}
+@dots{}
+END-INFO-DIR-ENTRY
+@end smallexample
+
+@noindent
+The @code{install-info} program sees these lines in the Info file, and
+that is how it knows what to do.
+
+Always use the @code{@@direntry} and @code{@@dircategory} commands near
+the beginning of the Texinfo input, before the first @code{@@node}
+command. If you use them later on in the input, @code{install-info}
+will not notice them.
+
+If you use @code{@@dircategory} more than once in the Texinfo source,
+each usage specifies one category; the new menu entry is added to the
+Info directory file in each of the categories you specify. If you use
+@code{@@direntry} more than once, each usage specifies one menu entry;
+each of these menu entries is added to the directory in each of the
+specified categories.
+
+
+@node Invoking install-info, , Installing Dir Entries, Install an Info File
+@section Invoking install-info
+
+@pindex install-info
+
+@code{install-info} inserts menu entries from an Info file into the
+top-level @file{dir} file in the Info system (see the previous sections
+for an explanation of how the @file{dir} file works). It's most often
+run as part of software installation, or when constructing a dir file
+for all manuals on a system. Synopsis:
+
+@example
+install-info [@var{option}]@dots{} [@var{info-file} [@var{dir-file}]]
+@end example
+
+If @var{info-file} or @var{dir-file} are not specified, the various
+options (described below) that define them must be. There are no
+compile-time defaults, and standard input is never used.
+@code{install-info} can read only one info file and write only one dir
+file per invocation.
+
+Options:
+
+@table @samp
+@item --delete
+@opindex --delete
+Only delete existing entries in @var{info-file}; don't insert any new
+entries.
+
+@item --dir-file=@var{name}
+@opindex --dir-file=@var{name}
+Specify file name of the Info directory file. This is equivalent to
+using the @var{dir-file} argument.
+
+@item --entry=@var{text}
+@opindex --entry=@var{text}
+Insert @var{text} as an Info directory entry; @var{text} should have the
+form of an Info menu item line plus zero or more extra lines starting
+with whitespace. If you specify more than one entry, they are all
+added. If you don't specify any entries, they are determined from
+information in the Info file itself.
+
+@item --help
+@opindex --help
+Display a usage message listing basic usage and all available options,
+then exit successfully.
+
+@item --info-file=@var{file}
+@opindex --info-file=@var{file}
+Specify Info file to install in the directory.
+This is equivalent to using the @var{info-file} argument.
+
+@item --info-dir=@var{dir}
+@opindex --info-dir=@var{dir}
+Equivalent to @samp{--dir-file=@var{dir}/dir}.
+
+@item --item=@var{text}
+@opindex --item=@var{text}
+Same as --entry=@var{text}. An Info directory entry is actually a menu
+item.
+
+@item --quiet
+@opindex --quiet
+Suppress warnings.
+
+@item --remove
+@opindex --remove
+Same as --delete.
+
+@item --section=@var{sec}
+@opindex --section=@var{sec}
+Put this file's entries in section @var{sec} of the directory. If you
+specify more than one section, all the entries are added in each of the
+sections. If you don't specify any sections, they are determined from
+information in the Info file itself.
+
+@item --version
+@opindex --version
+@cindex version number, finding
+Display version information and exit successfully.
+
+@end table
+
+
+@c ================ Appendix starts here ================
+
+@node Command List, Tips, Install an Info File, Top
+@appendix @@-Command List
+@cindex Alphabetical @@-command list
+@cindex List of @@-commands
+@cindex @@-command list
+
+Here is an alphabetical list of the @@-commands in Texinfo. Square
+brackets, @t{[}@w{ }@t{]}, indicate optional arguments; an ellipsis,
+@samp{@dots{}}, indicates repeated text.@refill
+
+@sp 1
+@table @code
+@item @@@var{whitespace}
+An @code{@@} followed by a space, tab, or newline produces a normal,
+stretchable, interword space. @xref{Multiple Spaces}.
+
+@item @@!
+Generate an exclamation point that really does end a sentence (usually
+after an end-of-sentence capital letter). @xref{Ending a Sentence}.
+
+@item @@"
+@itemx @@'
+Generate an umlaut or acute accent, respectively, over the next
+character, as in @"o and @'o. @xref{Inserting Accents}.
+
+@item @@*
+Force a line break. Do not end a paragraph that uses @code{@@*} with
+an @code{@@refill} command. @xref{Line Breaks}.@refill
+
+@item @@,@{@var{c}@}
+Generate a cedilla accent under @var{c}, as in @,{c}. @xref{Inserting
+Accents}.
+
+@item @@-
+Insert a discretionary hyphenation point. @xref{- and hyphenation}.
+
+@item @@.
+Produce a period that really does end a sentence (usually after an
+end-of-sentence capital letter). @xref{Ending a Sentence}.
+
+@item @@:
+Indicate to @TeX{} that an immediately preceding period, question
+mark, exclamation mark, or colon does not end a sentence. Prevent
+@TeX{} from inserting extra whitespace as it does at the end of a
+sentence. The command has no effect on the Info file output.
+@xref{Not Ending a Sentence}.@refill
+
+@item @@=
+Generate a macro (bar) accent over the next character, as in @=o.
+@xref{Inserting Accents}.
+
+@item @@?
+Generate a question mark that really does end a sentence (usually after
+an end-of-sentence capital letter). @xref{Ending a Sentence}.
+
+@item @@@@
+Stands for an at sign, @samp{@@}.@*
+@xref{Braces Atsigns, , Inserting @@ and braces}.
+
+@item @@^
+@itemx @@`
+Generate a circumflex (hat) or grave accent, respectively, over the next
+character, as in @^o.
+@xref{Inserting Accents}.
+
+@item @@@{
+Stands for a left brace, @samp{@{}.@*
+@xref{Braces Atsigns, , Inserting @@ and braces}.
+
+@item @@@}
+Stands for a right-hand brace, @samp{@}}.@*
+@xref{Braces Atsigns, , Inserting @@ and braces}.
+
+@item @@=
+Generate a tilde accent over the next character, as in @~N.
+@xref{Inserting Accents}.
+
+@item @@AA@{@}
+@itemx @@aa@{@}
+Generate the uppercase and lowercase Scandinavian A-ring letters,
+respectively: @AA{}, @aa{}. @xref{Inserting Accents}.
+
+@item @@AE@{@}
+@itemx @@ae@{@}
+Generate the uppercase and lowercase AE ligatures, respectively:
+@AE{}, @ae{}. @xref{Inserting Accents}.
+
+@item @@appendix @var{title}
+Begin an appendix. The title appears in the table
+of contents of a printed manual. In Info, the title is
+underlined with asterisks. @xref{unnumbered & appendix, , The
+@code{@@unnumbered} and @code{@@appendix} Commands}.@refill
+
+@item @@appendixsec @var{title}
+@itemx @@appendixsection @var{title}
+Begin an appendix section within an appendix. The section title appears
+in the table of contents of a printed manual. In Info, the title is
+underlined with equal signs. @code{@@appendixsection} is a longer
+spelling of the @code{@@appendixsec} command. @xref{unnumberedsec
+appendixsec heading, , Section Commands}.@refill
+
+@item @@appendixsubsec @var{title}
+Begin an appendix subsection within an appendix. The title appears
+in the table of contents of a printed manual. In Info, the title is
+underlined with hyphens. @xref{unnumberedsubsec appendixsubsec
+subheading, , Subsection Commands}.@refill
+
+@item @@appendixsubsubsec @var{title}
+Begin an appendix subsubsection within a subappendix. The title
+appears in the table of contents of a printed manual. In Info, the
+title is underlined with periods. @xref{subsubsection,, The `subsub'
+Commands}.@refill
+
+@item @@asis
+Used following @code{@@table}, @code{@@ftable}, and @code{@@vtable} to
+print the table's first column without highlighting (``as is'').
+@xref{Two-column Tables, , Making a Two-column Table}.@refill
+
+@item @@author @var{author}
+Typeset @var{author} flushleft and underline it. @xref{title
+subtitle author, , The @code{@@title} and @code{@@author}
+Commands}.@refill
+
+@item @@b@{@var{text}@}
+Print @var{text} in @b{bold} font. No effect in Info. @xref{Fonts}.@refill
+
+@ignore
+@item @@br
+Force a paragraph break. If used within a line, follow @code{@@br}
+with braces. @xref{br, , @code{@@br}}.@refill
+@end ignore
+
+@item @@bullet@{@}
+Generate a large round dot, or the closest possible
+thing to one. @xref{bullet, , @code{@@bullet}}.@refill
+
+@item @@bye
+Stop formatting a file. The formatters do not see the contents of a
+file following an @code{@@bye} command. @xref{Ending a File}.@refill
+
+@item @@c @var{comment}
+Begin a comment in Texinfo. The rest of the line does not appear in
+either the Info file or the printed manual. A synonym for
+@code{@@comment}. @xref{Comments, , Comments}.@refill
+
+@item @@cartouche
+Highlight an example or quotation by drawing a box with rounded
+corners around it. Pair with @code{@@end cartouche}. No effect in
+Info. @xref{cartouche, , Drawing Cartouches Around Examples}.)@refill
+
+@item @@center @var{line-of-text}
+Center the line of text following the command.
+@xref{titlefont center sp, , @code{@@center}}.@refill
+
+@item @@centerchap @var{line-of-text}
+Like @code{@@chapter}, but centers the chapter title. @xref{chapter,,
+@code{@@chapter}}.
+
+@item @@chapheading @var{title}
+Print a chapter-like heading in the text, but not in the table of
+contents of a printed manual. In Info, the title is underlined with
+asterisks. @xref{majorheading & chapheading, , @code{@@majorheading}
+and @code{@@chapheading}}.@refill
+
+@item @@chapter @var{title}
+Begin a chapter. The chapter title appears in the table of
+contents of a printed manual. In Info, the title is underlined with
+asterisks. @xref{chapter, , @code{@@chapter}}.@refill
+
+@item @@cindex @var{entry}
+Add @var{entry} to the index of concepts. @xref{Index Entries, ,
+Defining the Entries of an Index}.@refill
+
+@item @@cite@{@var{reference}@}
+Highlight the name of a book or other reference that lacks a
+companion Info file. @xref{cite, , @code{@@cite}}.@refill
+
+@item @@clear @var{flag}
+Unset @var{flag}, preventing the Texinfo formatting commands from
+formatting text between subsequent pairs of @code{@@ifset @var{flag}}
+and @code{@@end ifset} commands, and preventing
+@code{@@value@{@var{flag}@}} from expanding to the value to which
+@var{flag} is set.
+@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill
+
+@item @@code@{@var{sample-code}@}
+Highlight text that is an expression, a syntactically complete token
+of a program, or a program name. @xref{code, , @code{@@code}}.@refill
+
+@item @@comment @var{comment}
+Begin a comment in Texinfo. The rest of the line does not appear in
+either the Info file or the printed manual. A synonym for @code{@@c}.
+@xref{Comments, , Comments}.@refill
+
+@item @@contents
+Print a complete table of contents. Has no effect in Info, which uses
+menus instead. @xref{Contents, , Generating a Table of
+Contents}.@refill
+
+@item @@copyright@{@}
+Generate a copyright symbol. @xref{copyright symbol, ,
+@code{@@copyright}}.@refill
+
+@ignore
+@item @@ctrl@{@var{ctrl-char}@}
+Describe an @sc{ascii} control character. Insert actual control character
+into Info file. @xref{ctrl, , @code{@@ctrl}}.@refill
+@end ignore
+
+@item @@defcodeindex @var{index-name}
+Define a new index and its indexing command. Print entries in an
+@code{@@code} font. @xref{New Indices, , Defining New
+Indices}.@refill
+
+@item @@defcv @var{category} @var{class} @var{name}
+@itemx @@defcvx @var{category} @var{class} @var{name}
+Format a description for a variable associated with a class in
+object-oriented programming. Takes three arguments: the category of
+thing being defined, the class to which it belongs, and its name.
+@xref{Definition Commands}, and @ref{deffnx,, Def Cmds in Detail}.
+
+@item @@deffn @var{category} @var{name} @var{arguments}@dots{}
+@itemx @@deffnx @var{category} @var{name} @var{arguments}@dots{}
+Format a description for a function, interactive command, or similar
+entity that may take arguments. @code{@@deffn} takes as arguments the
+category of entity being described, the name of this particular
+entity, and its arguments, if any. @xref{Definition Commands}.@refill
+
+@item @@defindex @var{index-name}
+Define a new index and its indexing command. Print entries in a roman
+font. @xref{New Indices, , Defining New Indices}.@refill
+
+@c Unused so far as I can see and unsupported by makeinfo -- karl, 15sep96.
+@item @@definfoenclose @var{new-command}, @var{before}, @var{after},
+Create new @@-command for Info that marks text by enclosing it in
+strings that precede and follow the text. Write definition inside of
+@code{@@ifinfo} @dots{} @code{@@end ifinfo}. @xref{Customized
+Highlighting}.@refill
+
+@item @@defivar @var{class} @var{instance-variable-name}
+@itemx @@defivarx @var{class} @var{instance-variable-name}
+This command formats a description for an instance variable in
+object-oriented programming. The command is equivalent to @samp{@@defcv
+@{Instance Variable@} @dots{}}. @xref{Definition Commands}, and
+@ref{deffnx,, Def Cmds in Detail}.
+
+@item @@defmac @var{macro-name} @var{arguments}@dots{}
+@itemx @@defmacx @var{macro-name} @var{arguments}@dots{}
+Format a description for a macro. The command is equivalent to
+@samp{@@deffn Macro @dots{}}. @xref{Definition Commands}, and
+@ref{deffnx,, Def Cmds in Detail}.
+
+@item @@defmethod @var{class} @var{method-name} @var{arguments}@dots{}
+@itemx @@defmethodx @var{class} @var{method-name} @var{arguments}@dots{}
+Format a description for a method in object-oriented programming. The
+command is equivalent to @samp{@@defop Method @dots{}}. Takes as
+arguments the name of the class of the method, the name of the
+method, and its arguments, if any. @xref{Definition Commands}, and
+@ref{deffnx,, Def Cmds in Detail}.
+
+@item @@defop @var{category} @var{class} @var{name} @var{arguments}@dots{}
+@itemx @@defopx @var{category} @var{class} @var{name} @var{arguments}@dots{}
+Format a description for an operation in object-oriented programming.
+@code{@@defop} takes as arguments the overall name of the category of
+operation, the name of the class of the operation, the name of the
+operation, and its arguments, if any. @xref{Definition
+Commands}, and @ref{deffnx,, Def Cmds in Detail}.
+
+@item @@defopt @var{option-name}
+@itemx @@defoptx @var{option-name}
+Format a description for a user option. The command is equivalent to
+@samp{@@defvr @{User Option@} @dots{}}. @xref{Definition Commands}, and
+@ref{deffnx,, Def Cmds in Detail}.
+
+@item @@defspec @var{special-form-name} @var{arguments}@dots{}
+@itemx @@defspecx @var{special-form-name} @var{arguments}@dots{}
+Format a description for a special form. The command is equivalent to
+@samp{@@deffn @{Special Form@} @dots{}}. @xref{Definition Commands},
+and @ref{deffnx,, Def Cmds in Detail}.
+
+@item @@deftp @var{category} @var{name-of-type} @var{attributes}@dots{}
+@itemx @@deftpx @var{category} @var{name-of-type} @var{attributes}@dots{}
+Format a description for a data type. @code{@@deftp} takes as arguments
+the category, the name of the type (which is a word like @samp{int} or
+@samp{float}), and then the names of attributes of objects of that type.
+@xref{Definition Commands}, and @ref{deffnx,, Def Cmds in Detail}.
+
+@item @@deftypefn @var{classification} @var{data-type} @var{name} @var{arguments}@dots{}
+@itemx @@deftypefnx @var{classification} @var{data-type} @var{name} @var{arguments}@dots{}
+Format a description for a function or similar entity that may take
+arguments and that is typed. @code{@@deftypefn} takes as arguments the
+classification of entity being described, the type, the name of the
+entity, and its arguments, if any. @xref{Definition Commands}, and
+@ref{deffnx,, Def Cmds in Detail}.
+
+@item @@deftypefun @var{data-type} @var{function-name} @var{arguments}@dots{}
+@itemx @@deftypefunx @var{data-type} @var{function-name} @var{arguments}@dots{}
+Format a description for a function in a typed language.
+The command is equivalent to @samp{@@deftypefn Function @dots{}}.
+@xref{Definition Commands},
+and @ref{deffnx,, Def Cmds in Detail}.
+
+@item @@deftypevr @var{classification} @var{data-type} @var{name}
+@itemx @@deftypevrx @var{classification} @var{data-type} @var{name}
+Format a description for something like a variable in a typed
+language---an entity that records a value. Takes as arguments the
+classification of entity being described, the type, and the name of the
+entity. @xref{Definition Commands}, and @ref{deffnx,, Def Cmds in
+Detail}.
+
+@item @@deftypevar @var{data-type} @var{variable-name}
+@itemx @@deftypevarx @var{data-type} @var{variable-name}
+Format a description for a variable in a typed language. The command is
+equivalent to @samp{@@deftypevr Variable @dots{}}. @xref{Definition
+Commands}, and @ref{deffnx,, Def Cmds in Detail}.
+
+@item @@defun @var{function-name} @var{arguments}@dots{}
+@itemx @@defunx @var{function-name} @var{arguments}@dots{}
+Format a description for functions. The command is equivalent to
+@samp{@@deffn Function @dots{}}. @xref{Definition Commands}, and
+@ref{deffnx,, Def Cmds in Detail}.
+
+@item @@defvar @var{variable-name}
+@itemx @@defvarx @var{variable-name}
+Format a description for variables. The command is equivalent to
+@samp{@@defvr Variable @dots{}}. @xref{Definition Commands}, and
+@ref{deffnx,, Def Cmds in Detail}.
+
+@item @@defvr @var{category} @var{name}
+@itemx @@defvrx @var{category} @var{name}
+Format a description for any kind of variable. @code{@@defvr} takes
+as arguments the category of the entity and the name of the entity.
+@xref{Definition Commands},
+and @ref{deffnx,, Def Cmds in Detail}.
+
+@item @@detailmenu@{@}
+Use to avoid Makeinfo confusion stemming from the detailed node listing
+in a master menu. @xref{Master Menu Parts}.
+
+@item @@dfn@{@var{term}@}
+Highlight the introductory or defining use of a term.
+@xref{dfn, , @code{@@dfn}}.@refill
+
+@item @@dircategory @var{dirpart}
+Specify a part of the Info directory menu where this file's entry should
+go. @xref{Installing Dir Entries}.
+
+@item @@direntry
+Begin the Info directory menu entry for this file.
+@xref{Installing Dir Entries}.
+
+@need 100
+@item @@display
+Begin a kind of example. Indent text, do not fill, do not select a
+new font. Pair with @code{@@end display}. @xref{display, ,
+@code{@@display}}.@refill
+
+@item @@dmn@{@var{dimension}@}
+Format a unit of measure, as in 12@dmn{pt}. Causes @TeX{} to insert a
+thin space before @var{dimension}. No effect in Info.
+@xref{dmn, , @code{@@dmn}}.@refill
+
+@need 100
+@item @@dots@{@}
+Insert an ellipsis: @samp{@dots{}}.
+@xref{dots, , @code{@@dots}}.@refill
+
+@item @@email@{@var{address}@}
+Indicate an electronic mail address.
+@xref{email, , @code{@@email}}.@refill
+
+@need 100
+@item @@emph@{@var{text}@}
+Highlight @var{text}; text is displayed in @emph{italics} in printed
+output, and surrounded by asterisks in Info. @xref{Emphasis, , Emphasizing Text}.@refill
+
+@item @@end @var{environment}
+Ends @var{environment}, as in @samp{@@end example}. @xref{Formatting
+Commands,,@@-commands}.
+
+@item @@enddots@{@}
+Generate an end-of-sentence of ellipsis, like this @enddots{}
+@xref{dots,,@code{@@dots@{@}}}.
+
+@need 100
+@item @@enumerate [@var{number-or-letter}]
+Begin a numbered list, using @code{@@item} for each entry.
+Optionally, start list with @var{number-or-letter}. Pair with
+@code{@@end enumerate}. @xref{enumerate, ,
+@code{@@enumerate}}.@refill
+
+@need 100
+@item @@equiv@{@}
+Indicate to the reader the exact equivalence of two forms with a
+glyph: @samp{@equiv{}}. @xref{Equivalence}.@refill
+
+@item @@error@{@}
+Indicate to the reader with a glyph that the following text is
+an error message: @samp{@error{}}. @xref{Error Glyph}.@refill
+
+@item @@evenfooting [@var{left}] @@| [@var{center}] @@| [@var{right}]
+Specify page footings for even-numbered (left-hand) pages. Not relevant to
+Info. @xref{Custom Headings, , How to Make Your Own Headings}.@refill
+
+@item @@evenheading [@var{left}] @@| [@var{center}] @@| [@var{right}]
+Specify page headings for even-numbered (left-hand) pages. Only
+supported within @code{@@iftex}. @xref{Custom Headings, , How to Make
+Your Own Headings}.@refill
+
+@item @@everyfooting [@var{left}] @@| [@var{center}] @@| [@var{right}]
+@itemx @@everyheading [@var{left}] @@| [@var{center}] @@| [@var{right}]
+Specify page footings resp.@: headings for every page. Not relevant to
+Info. @xref{Custom Headings, , How to Make Your Own Headings}.@refill
+
+@item @@example
+Begin an example. Indent text, do not fill, and select fixed-width font.
+Pair with @code{@@end example}. @xref{example, ,
+@code{@@example}}.@refill
+
+@item @@exclamdown@{@}
+Generate an upside-down exclamation point. @xref{Inserting Accents}.
+
+@item @@exdent @var{line-of-text}
+Remove any indentation a line might have. @xref{exdent, ,
+Undoing the Indentation of a Line}.@refill
+
+@item @@expansion@{@}
+Indicate the result of a macro expansion to the reader with a special
+glyph: @samp{@expansion{}}.
+@xref{expansion, , @expansion{} Indicating an Expansion}.@refill
+
+@item @@file@{@var{filename}@}
+Highlight the name of a file, buffer, node, or directory. @xref{file, ,
+@code{@@file}}.@refill
+
+@item @@finalout
+Prevent @TeX{} from printing large black warning rectangles beside
+over-wide lines. @xref{Overfull hboxes}.@refill
+
+@need 100
+@item @@findex @var{entry}
+Add @var{entry} to the index of functions. @xref{Index Entries, ,
+Defining the Entries of an Index}.@refill
+
+@need 200
+@item @@flushleft
+@itemx @@flushright
+Left justify every line but leave the right end ragged.
+Leave font as is. Pair with @code{@@end flushleft}.
+@code{@@flushright} analogous.
+@xref{flushleft & flushright, , @code{@@flushleft} and
+@code{@@flushright}}.@refill
+
+@need 200
+@item @@footnote@{@var{text-of-footnote}@}
+Enter a footnote. Footnote text is printed at the bottom of the page
+by @TeX{}; Info may format in either `End' node or `Separate' node style.
+@xref{Footnotes}.@refill
+
+@item @@footnotestyle @var{style}
+Specify an Info file's footnote style, either @samp{end} for the end
+node style or @samp{separate} for the separate node style.
+@xref{Footnotes}.@refill
+
+@item @@format
+Begin a kind of example. Like @code{@@example} or @code{@@display},
+but do not narrow the margins and do not select the fixed-width font.
+Pair with @code{@@end format}. @xref{example, ,
+@code{@@example}}.@refill
+
+@item @@ftable @var{formatting-command}
+Begin a two-column table, using @code{@@item} for each entry.
+Automatically enter each of the items in the first column into the
+index of functions. Pair with @code{@@end ftable}. The same as
+@code{@@table}, except for indexing. @xref{ftable vtable, ,
+@code{@@ftable} and @code{@@vtable}}.@refill
+
+@item @@group
+Hold text together that must appear on one printed page. Pair with
+@code{@@end group}. Not relevant to Info. @xref{group, ,
+@code{@@group}}.@refill
+
+@item @@H@{@var{c}@}
+Generate the long Hungarian umlaut accent over @var{c}, as in @H{o}.
+
+@item @@heading @var{title}
+Print an unnumbered section-like heading in the text, but not in the
+table of contents of a printed manual. In Info, the title is
+underlined with equal signs. @xref{unnumberedsec appendixsec heading,
+, Section Commands}.@refill
+
+@item @@headings @var{on-off-single-double}
+Turn page headings on or off, and/or specify single-sided or double-sided
+page headings for printing. @xref{headings on off, , The
+@code{@@headings} Command}.
+
+@item @@i@{@var{text}@}
+Print @var{text} in @i{italic} font. No effect in Info.
+@xref{Fonts}.@refill
+
+@item @@ifclear @var{flag}
+If @var{flag} is cleared, the Texinfo formatting commands format text
+between @code{@@ifclear @var{flag}} and the following @code{@@end
+ifclear} command.
+@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill
+
+@item @@ifhtml
+@itemx @@ifinfo
+Begin a stretch of text that will be ignored by @TeX{} when it typesets
+the printed manual. The text appears only in the HTML resp.@: Info
+file. Pair with @code{@@end ifhtml} resp.@: @code{@@end ifinfo}.
+@xref{Conditionals, , Conditionally Visible Text}.@refill
+
+@item @@ifset @var{flag}
+If @var{flag} is set, the Texinfo formatting commands format text
+between @code{@@ifset @var{flag}} and the following @code{@@end ifset}
+command.
+@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill
+
+@item @@iftex
+Begin a stretch of text that will not appear in the Info file, but
+will be processed only by @TeX{}. Pair with @code{@@end iftex}.
+@xref{Conditionals, , Conditionally Visible Text}.@refill
+
+@item @@ignore
+Begin a stretch of text that will not appear in either the Info file
+or the printed output. Pair with @code{@@end ignore}.
+@xref{Comments, , Comments and Ignored Text}.@refill
+
+@item @@include @var{filename}
+Incorporate the contents of the file @var{filename} into the Info file
+or printed document. @xref{Include Files}.@refill
+
+@item @@inforef@{@var{node-name}, [@var{entry-name}], @var{info-file-name}@}
+Make a cross reference to an Info file for which there is no printed
+manual. @xref{inforef, , Cross references using
+@code{@@inforef}}.@refill
+
+@item \input @var{macro-definitions-file}
+Use the specified macro definitions file. This command is used only
+in the first line of a Texinfo file to cause @TeX{} to make use of the
+@file{texinfo} macro definitions file. The backslash in @code{\input}
+is used instead of an @code{@@} because @TeX{} does not
+recognize @code{@@} until after it has read the definitions file.
+@xref{Header, , The Texinfo File Header}.@refill
+
+@item @@item
+Indicate the beginning of a marked paragraph for @code{@@itemize} and
+@code{@@enumerate}; indicate the beginning of the text of a first column
+entry for @code{@@table}, @code{@@ftable}, and @code{@@vtable}.
+@xref{Lists and Tables}.@refill
+
+@item @@itemize @var{mark-generating-character-or-command}
+Produce a sequence of indented paragraphs, with a mark inside the left
+margin at the beginning of each paragraph. Pair with @code{@@end
+itemize}. @xref{itemize, , @code{@@itemize}}.@refill
+
+@item @@itemx
+Like @code{@@item} but do not generate extra vertical space above the
+item text. @xref{itemx, , @code{@@itemx}}.@refill
+
+@item @@kbd@{@var{keyboard-characters}@}
+Indicate text that is characters of input to be typed by
+users. @xref{kbd, , @code{@@kbd}}.@refill
+
+@item @@key@{@var{key-name}@}
+Highlight @var{key-name}, a name for a key on a keyboard.
+@xref{key, , @code{@@key}}.@refill
+
+@item @@kindex @var{entry}
+Add @var{entry} to the index of keys. @xref{Index Entries, , Defining the
+Entries of an Index}.@refill
+
+@item @@L@{@}
+@itemx @@l@{@}
+Generate the uppercase and lowercase Polish suppressed-L letters,
+respectively: @L{}, @l{}.
+
+@c Possibly this can be tossed now that we have macros. --karl, 16sep96.
+@item @@global@@let@var{new-command}=@var{existing-command}
+Equate a new highlighting command with an existing one. Only for
+@TeX{}. Write definition inside of @code{@@iftex} @dots{} @code{@@end
+iftex}. @xref{Customized Highlighting}.@refill
+
+@item @@lisp
+Begin an example of Lisp code. Indent text, do not fill, and select
+fixed-width font. Pair with @code{@@end lisp}. @xref{Lisp Example, ,
+@code{@@lisp}}.@refill
+
+@item @@lowersections
+Change subsequent chapters to sections, sections to subsections, and so
+on. @xref{Raise/lower sections, , @code{@@raisesections} and
+@code{@@lowersections}}.@refill
+
+@item @@macro @var{macro-name} @{@var{params}@}
+Define a new Texinfo command @code{@@@var{macro-name}@{@var{params}@}}.
+Only supported by Makeinfo and Texi2dvi. @xref{Defining Macros}.
+
+@item @@majorheading @var{title}
+Print a chapter-like heading in the text, but not in the table of
+contents of a printed manual. Generate more vertical whitespace before
+the heading than the @code{@@chapheading} command. In Info, the chapter
+heading line is underlined with asterisks. @xref{majorheading &
+chapheading, , @code{@@majorheading} and @code{@@chapheading}}.@refill
+
+@item @@math@{@var{mathematical-expression}@}
+Format a mathematical expression.
+@xref{math, , @code{@@math}: Inserting Mathematical Expressions}.
+
+@item @@menu
+Mark the beginning of a menu of nodes in Info. No effect in a printed
+manual. Pair with @code{@@end menu}. @xref{Menus}.@refill
+
+@item @@minus@{@}
+Generate a minus sign, `@minus{}'. @xref{minus, , @code{@@minus}}.@refill
+
+@item @@multitable @var{column-width-spec}
+Begin a multi-column table. Pair with @code{@@end multitable}.
+@xref{Multitable Column Widths}.
+
+@item @@need @var{n}
+Start a new page in a printed manual if fewer than @var{n} mils
+(thousandths of an inch) remain on the current page. @xref{need, ,
+@code{@@need}}.@refill
+
+@item @@node @var{name, next, previous, up}
+Define the beginning of a new node in Info, and serve as a locator for
+references for @TeX{}. @xref{node, , @code{@@node}}.@refill
+
+@item @@noindent
+Prevent text from being indented as if it were a new paragraph.
+@xref{noindent, , @code{@@noindent}}.@refill
+
+@item @@O@{@}
+@itemx @@o@{@}
+Generate the uppercase and lowercase Owith-slash letters, respectively:
+@O{}, @o{}.
+
+@item @@oddfooting [@var{left}] @@| [@var{center}] @@| [@var{right}]
+@itemx @@oddheading [@var{left}] @@| [@var{center}] @@| [@var{right}]
+Specify page footings resp.@: headings for odd-numbered (right-hand)
+pages. Only allowed inside @code{@@iftex}. @xref{Custom Headings, ,
+How to Make Your Own Headings}.@refill
+
+@item @@OE@{@}
+@itemx @@oe@{@}
+Generate the uppercase and lowercase OE ligatures, respectively:
+@OE{}, @oe{}. @xref{Inserting Accents}.
+
+@item @@page
+Start a new page in a printed manual. No effect in Info.
+@xref{page, , @code{@@page}}.@refill
+
+@item @@paragraphindent @var{indent}
+Indent paragraphs by @var{indent} number of spaces; delete indentation
+if the value of @var{indent} is 0; and do not change indentation if
+@var{indent} is @code{asis}. @xref{paragraphindent, , Paragraph
+Indenting}.@refill
+
+@item @@pindex @var{entry}
+Add @var{entry} to the index of programs. @xref{Index Entries, , Defining
+the Entries of an Index}.@refill
+
+@item @@point@{@}
+Indicate the position of point in a buffer to the reader with a
+glyph: @samp{@point{}}. @xref{Point Glyph, , Indicating
+Point in a Buffer}.@refill
+
+@item @@pounds@{@}
+Generate the pounds sterling currency sign.
+@xref{pounds,,@code{@@pounds@{@}}}.
+
+@item @@print@{@}
+Indicate printed output to the reader with a glyph:
+@samp{@print{}}. @xref{Print Glyph}.@refill
+
+@item @@printindex @var{index-name}
+Print an alphabetized two-column index in a printed manual or generate
+an alphabetized menu of index entries for Info. @xref{Printing
+Indices & Menus}.@refill
+
+@item @@pxref@{@var{node-name}, [@var{entry}], [@var{topic-or-title}], [@var{info-file}], [@var{manual}]@}
+Make a reference that starts with a lower case `see' in a printed
+manual. Use within parentheses only. Do not follow command with a
+punctuation mark---the Info formatting commands automatically insert
+terminating punctuation as needed. Only the first argument is mandatory.
+@xref{pxref, , @code{@@pxref}}.@refill
+
+@item @@questiondown@{@}
+Generate an upside-down question mark. @xref{Inserting Accents}.
+
+@item @@quotation
+Narrow the margins to indicate text that is quoted from another real
+or imaginary work. Write command on a line of its own. Pair with
+@code{@@end quotation}. @xref{quotation, ,
+@code{@@quotation}}.@refill
+
+@need 100
+@item @@r@{@var{text}@}
+Print @var{text} in @r{roman} font. No effect in Info.
+@xref{Fonts}.@refill
+
+@item @@raisesections
+Change subsequent sections to chapters, subsections to sections, and so
+on. @xref{Raise/lower sections, , @code{@@raisesections} and
+@code{@@lowersections}}.@refill
+
+@need 300
+@item @@ref@{@var{node-name}, [@var{entry}], [@var{topic-or-title}], [@var{info-file}], [@var{manual}]@}
+Make a reference. In a printed manual, the reference does not start
+with a `See'. Follow command with a punctuation mark. Only the first
+argument is mandatory. @xref{ref, , @code{@@ref}}.@refill
+
+@need 300
+@item @@refill
+In Info, refill and indent the paragraph after all the other processing
+has been done. No effect on @TeX{}, which always refills. This command
+is no longer needed, since all formatters now automatically refill.
+@xref{Refilling Paragraphs}.@refill
+
+@need 300
+@item @@result@{@}
+Indicate the result of an expression to the reader with a special
+glyph: @samp{@result{}}. @xref{result, , @code{@@result}}.@refill
+
+@item @@ringaccent@{@var{c}@}
+Generate a ring accent over the next character, as in @ringaccent{o}.
+@xref{Inserting Accents}.
+
+@item @@samp@{@var{text}@}
+Highlight @var{text} that is a literal example of a sequence of
+characters. Used for single characters, for statements, and often for
+entire shell commands. @xref{samp, , @code{@@samp}}.@refill
+
+@item @@sc@{@var{text}@}
+Set @var{text} in a printed output in @sc{the small caps font} and
+set text in the Info file in uppercase letters.
+@xref{Smallcaps}.@refill
+
+@item @@section @var{title}
+Begin a section within a chapter. In a printed manual, the section
+title is numbered and appears in the table of contents. In Info, the
+title is underlined with equal signs. @xref{section, ,
+@code{@@section}}.@refill
+
+@item @@set @var{flag} [@var{string}]
+Make @var{flag} active, causing the Texinfo formatting commands to
+format text between subsequent pairs of @code{@@ifset @var{flag}} and
+@code{@@end ifset} commands. Optionally, set value of @var{flag} to
+@var{string}.
+@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill
+
+@item @@setchapternewpage @var{on-off-odd}
+Specify whether chapters start on new pages, and if so, whether on
+odd-numbered (right-hand) new pages. @xref{setchapternewpage, ,
+@code{@@setchapternewpage}}.@refill
+
+@item @@setfilename @var{info-file-name}
+Provide a name to be used by the Info file. This command is essential
+for @TeX{} formatting as well, even though it produces no output.
+@xref{setfilename, , @code{@@setfilename}}.@refill
+
+@item @@settitle @var{title}
+Provide a title for page headers in a printed manual.
+@xref{settitle, , @code{@@settitle}}.@refill
+
+@item @@shortcontents
+Print a short table of contents. Not relevant to Info, which uses
+menus rather than tables of contents. A synonym for
+@code{@@summarycontents}. @xref{Contents, , Generating a Table of
+Contents}.@refill
+
+@item @@shorttitlepage@{@var{title}@}
+Generate a minimal title page. @xref{titlepage,,@code{@@titlepage}}.
+
+@need 400
+@item @@smallbook
+Cause @TeX{} to produce a printed manual in a 7 by 9.25 inch format
+rather than the regular 8.5 by 11 inch format. @xref{smallbook, ,
+Printing Small Books}. Also, see @ref{smallexample & smalllisp, ,
+@code{@@smallexample} and @code{@@smalllisp}}.@refill
+
+@need 400
+@item @@smallexample
+Indent text to indicate an example. Do not fill, select fixed-width
+font. In @code{@@smallbook} format, print text in a smaller font than
+with @code{@@example}. Pair with @code{@@end smallexample}.
+@xref{smallexample & smalllisp, , @code{@@smallexample} and
+@code{@@smalllisp}}.@refill
+
+@need 400
+@item @@smalllisp
+Begin an example of Lisp code. Indent text, do not fill, select
+fixed-width font. In @code{@@smallbook} format, print text in a
+smaller font. Pair with @code{@@end smalllisp}. @xref{smallexample &
+smalllisp, , @code{@@smallexample} and @code{@@smalllisp}}.@refill
+
+@need 700
+@item @@sp @var{n}
+Skip @var{n} blank lines. @xref{sp, , @code{@@sp}}.@refill
+
+@item @@ss@{@}
+Generate the German sharp-S es-zet letter, @ss{}. @xref{Inserting Accents}.
+
+@need 700
+@item @@strong @var{text}
+Emphasize @var{text} by typesetting it in a @strong{bold} font for the
+printed manual and by surrounding it with asterisks for Info.
+@xref{emph & strong, , Emphasizing Text}.@refill
+
+@item @@subheading @var{title}
+Print an unnumbered subsection-like heading in the text, but not in
+the table of contents of a printed manual. In Info, the title is
+underlined with hyphens. @xref{unnumberedsubsec appendixsubsec
+subheading, , @code{@@unnumberedsubsec} @code{@@appendixsubsec}
+@code{@@subheading}}.@refill
+
+@item @@subsection @var{title}
+Begin a subsection within a section. In a printed manual, the
+subsection title is numbered and appears in the table of contents. In
+Info, the title is underlined with hyphens. @xref{subsection, ,
+@code{@@subsection}}.@refill
+
+@item @@subsubheading @var{title}
+Print an unnumbered subsubsection-like heading in the text, but not in
+the table of contents of a printed manual. In Info, the title is
+underlined with periods. @xref{subsubsection, , The `subsub'
+Commands}.@refill
+
+@item @@subsubsection @var{title}
+Begin a subsubsection within a subsection. In a printed manual,
+the subsubsection title is numbered and appears in the table of
+contents. In Info, the title is underlined with periods.
+@xref{subsubsection, , The `subsub' Commands}.@refill
+
+@item @@subtitle @var{title}
+In a printed manual, set a subtitle in a normal sized font flush to
+the right-hand side of the page. Not relevant to Info, which does not
+have title pages. @xref{title subtitle author, , @code{@@title}
+@code{@@subtitle} and @code{@@author} Commands}.@refill
+
+@item @@summarycontents
+Print a short table of contents. Not relevant to Info, which uses
+menus rather than tables of contents. A synonym for
+@code{@@shortcontents}. @xref{Contents, , Generating a Table of
+Contents}.@refill
+
+@need 300
+@item @@syncodeindex @var{from-index} @var{into-index}
+Merge the index named in the first argument into the index named in
+the second argument, printing the entries from the first index in
+@code{@@code} font. @xref{Combining Indices}.@refill
+
+@need 300
+@item @@synindex @var{from-index} @var{into-index}
+Merge the index named in the first argument into the index named in
+the second argument. Do not change the font of @var{from-index}
+entries. @xref{Combining Indices}.@refill
+
+@need 100
+@item @@t@{@var{text}@}
+Print @var{text} in a @t{fixed-width}, typewriter-like font.
+No effect in Info. @xref{Fonts}.@refill
+
+@item @@tab
+Separate columns in a multitable. @xref{Multitable Rows}.
+
+@need 400
+@item @@table @var{formatting-command}
+Begin a two-column table, using @code{@@item} for each entry. Write
+each first column entry on the same line as @code{@@item}. First
+column entries are printed in the font resulting from
+@var{formatting-command}. Pair with @code{@@end table}.
+@xref{Two-column Tables, , Making a Two-column Table}.
+Also see @ref{ftable vtable, , @code{@@ftable} and @code{@@vtable}},
+and @ref{itemx, , @code{@@itemx}}.@refill
+
+@item @@TeX@{@}
+Insert the logo @TeX{}. @xref{TeX and copyright, , Inserting @TeX{}
+and @copyright{}}.@refill
+
+@item @@tex
+Enter @TeX{} completely. Pair with @code{@@end tex}. @xref{Using
+Ordinary TeX Commands, , Using Ordinary @TeX{} Commands}.@refill
+
+@item @@thischapter
+@itemx @@thischaptername
+@itemx @@thisfile
+@itemx @@thispage
+@itemx @@thistitle
+Only allowed in a heading or footing. Stands for the number and name of
+the current chapter (in the format `Chapter 1: Title'), the chapter name
+only, the filename, the current page number, and the title of the
+document, respectively. @xref{Custom Headings, , How to Make Your Own
+Headings}.@refill
+
+@item @@tindex @var{entry}
+Add @var{entry} to the index of data types. @xref{Index Entries, ,
+Defining the Entries of an Index}.@refill
+
+@item @@title @var{title}
+In a printed manual, set a title flush to the left-hand side of the
+page in a larger than normal font and underline it with a black rule.
+Not relevant to Info, which does not have title pages. @xref{title
+subtitle author, , The @code{@@title} @code{@@subtitle} and
+@code{@@author} Commands}.@refill
+
+@need 400
+@item @@titlefont@{@var{text}@}
+In a printed manual, print @var{text} in a larger than normal font.
+Not relevant to Info, which does not have title pages.
+@xref{titlefont center sp, , The @code{@@titlefont} @code{@@center}
+and @code{@@sp} Commands}.@refill
+
+@need 300
+@item @@titlepage
+Indicate to Texinfo the beginning of the title page. Write command on
+a line of its own. Pair with @code{@@end titlepage}. Nothing between
+@code{@@titlepage} and @code{@@end titlepage} appears in Info.
+@xref{titlepage, , @code{@@titlepage}}.@refill
+
+@need 150
+@item @@today@{@}
+Insert the current date, in `1 Jan 1900' style. @xref{Custom
+Headings, , How to Make Your Own Headings}.@refill
+
+@item @@top @var{title}
+In a Texinfo file to be formatted with @code{makeinfo}, identify the
+topmost @code{@@node} line in the file, which must be written on the line
+immediately preceding the @code{@@top} command. Used for
+@code{makeinfo}'s node pointer insertion feature. The title is
+underlined with asterisks. Both the @code{@@node} line and the @code{@@top}
+line normally should be enclosed by @code{@@ifinfo} and @code{@@end
+ifinfo}. In @TeX{} and @code{texinfo-format-buffer}, the @code{@@top}
+command is merely a synonym for @code{@@unnumbered}. @xref{makeinfo
+Pointer Creation, , Creating Pointers with @code{makeinfo}}.
+
+@item @@u@var{c}
+@itemx @@ubaraccent@var{c}
+@itemx @@udotaccent@var{c}
+Generate a breve, underbar, or underdot accent, respectively, over or
+under the character @var{c}, as in @u{o}, @ubaraccent{o},
+@udotaccent{o}. @xref{Inserting Accents}.
+
+@item @@unnumbered @var{title}
+In a printed manual, begin a chapter that appears without chapter
+numbers of any kind. The title appears in the table of contents of a
+printed manual. In Info, the title is underlined with asterisks.
+@xref{unnumbered & appendix, , @code{@@unnumbered} and
+@code{@@appendix}}.@refill
+
+@item @@unnumberedsec @var{title}
+In a printed manual, begin a section that appears without section
+numbers of any kind. The title appears in the table of contents of a
+printed manual. In Info, the title is underlined with equal signs.
+@xref{unnumberedsec appendixsec heading, , Section Commands}.@refill
+
+@item @@unnumberedsubsec @var{title}
+In a printed manual, begin an unnumbered subsection within a
+chapter. The title appears in the table of contents of a printed
+manual. In Info, the title is underlined with hyphens.
+@xref{unnumberedsubsec appendixsubsec subheading, ,
+@code{@@unnumberedsubsec} @code{@@appendixsubsec}
+@code{@@subheading}}.@refill
+
+@item @@unnumberedsubsubsec @var{title}
+In a printed manual, begin an unnumbered subsubsection within a
+chapter. The title appears in the table of contents of a printed
+manual. In Info, the title is underlined with periods.
+@xref{subsubsection, , The `subsub' Commands}.@refill
+
+@item @@url@{@var{url}@}
+Highlight text that is a uniform resource locator for the World Wide
+Web. @xref{url, , @code{@@url}}.@refill
+
+@item @@v@var{c}
+Generate check accent over the character @var{c}, as in @v{o}.
+@xref{Inserting Accents}.
+
+@item @@value@{@var{flag}@}
+Replace @var{flag} with the value to which it is set by @code{@@set
+@var{flag}}.
+@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill
+
+@item @@var@{@var{metasyntactic-variable}@}
+Highlight a metasyntactic variable, which is something that stands for
+another piece of text. @xref{var, , Indicating Metasyntactic
+Variables}.@refill
+
+@need 400
+@item @@vindex @var{entry}
+Add @var{entry} to the index of variables. @xref{Index Entries, ,
+Defining the Entries of an Index}.@refill
+
+@need 400
+@item @@vskip @var{amount}
+In a printed manual, insert whitespace so as to push text on the
+remainder of the page towards the bottom of the page. Used in
+formatting the copyright page with the argument @samp{0pt plus
+1filll}. (Note spelling of @samp{filll}.) @code{@@vskip} may be used
+only in contexts ignored for Info. @xref{Copyright & Permissions, ,
+The Copyright Page and Printed Permissions}.@refill
+
+@need 400
+@item @@vtable @var{formatting-command}
+Begin a two-column table, using @code{@@item} for each entry.
+Automatically enter each of the items in the first column into the
+index of variables. Pair with @code{@@end vtable}. The same as
+@code{@@table}, except for indexing. @xref{ftable vtable, ,
+@code{@@ftable} and @code{@@vtable}}.@refill
+
+@need 400
+@item @@w@{@var{text}@}
+Prevent @var{text} from being split across two lines. Do not end a
+paragraph that uses @code{@@w} with an @code{@@refill} command.
+@xref{w, , @code{@@w}}.@refill
+
+@need 400
+@item @@xref@{@var{node-name}, [@var{entry}], [@var{topic-or-title}], [@var{info-file}], [@var{manual}]@}
+Make a reference that starts with `See' in a printed manual. Follow
+command with a punctuation mark. Only the first argument is
+mandatory. @xref{xref, , @code{@@xref}}.@refill
+@end table
+
+@node Tips, Sample Texinfo File, Command List, Top
+@comment node-name, next, previous, up
+@appendix Tips and Hints
+
+Here are some tips for writing Texinfo documentation:@refill
+
+@cindex Tips
+@cindex Usage tips
+@cindex Hints
+@itemize @bullet
+@item
+Write in the present tense, not in the past or the future.
+
+@item
+Write actively! For example, write ``We recommend that @dots{}'' rather
+than ``It is recommended that @dots{}''.
+
+@item
+Use 70 or 72 as your fill column. Longer lines are hard to read.
+
+@item
+Include a copyright notice and copying permissions.
+@end itemize
+
+@subsubheading Index, index, index!
+
+Write many index entries, in different ways.
+Readers like indices; they are helpful and convenient.
+
+Although it is easiest to write index entries as you write the body of
+the text, some people prefer to write entries afterwards. In either
+case, write an entry before the paragraph to which it applies. This
+way, an index entry points to the first page of a paragraph that is
+split across pages.
+
+Here are more hints we have found valuable:
+
+@itemize @bullet
+@item
+Write each index entry differently, so each entry refers to a different
+place in the document.
+
+@item
+Write index entries only where a topic is discussed significantly. For
+example, it is not useful to index ``debugging information'' in a
+chapter on reporting bugs. Someone who wants to know about debugging
+information will certainly not find it in that chapter.
+
+@item
+Consistently capitalize the first word of every concept index entry,
+or else consistently use lower case. Terse entries often call for
+lower case; longer entries for capitalization. Whichever case
+convention you use, please use one or the other consistently! Mixing
+the two styles looks bad.
+
+@item
+Always capitalize or use upper case for those words in an index for
+which this is proper, such as names of countries or acronyms. Always
+use the appropriate case for case-sensitive names, such as those in C or
+Lisp.
+
+@item
+Write the indexing commands that refer to a whole section immediately
+after the section command, and write the indexing commands that refer to
+the paragraph before the paragraph.
+
+@need 1000
+In the example that follows, a blank line comes after the index
+entry for ``Leaping'':
+
+@example
+@group
+@@section The Dog and the Fox
+@@cindex Jumping, in general
+@@cindex Leaping
+
+@@cindex Dog, lazy, jumped over
+@@cindex Lazy dog jumped over
+@@cindex Fox, jumps over dog
+@@cindex Quick fox jumps over dog
+The quick brown fox jumps over the lazy dog.
+@end group
+@end example
+
+@noindent
+(Note that the example shows entries for the same concept that are
+written in different ways---@samp{Lazy dog}, and @samp{Dog, lazy}---so
+readers can look up the concept in different ways.)
+@end itemize
+
+@subsubheading Blank lines
+
+@itemize @bullet
+@item
+Insert a blank line between a sectioning command and the first following
+sentence or paragraph, or between the indexing commands associated with
+the sectioning command and the first following sentence or paragraph, as
+shown in the tip on indexing. Otherwise, a formatter may fold title and
+paragraph together.
+
+@item
+Always insert a blank line before an @code{@@table} command and after an
+@code{@@end table} command; but never insert a blank line after an
+@code{@@table} command or before an @code{@@end table} command.
+
+@need 1000
+For example,
+
+@example
+@group
+Types of fox:
+
+@@table @@samp
+@@item Quick
+Jump over lazy dogs.
+@end group
+
+@group
+@@item Brown
+Also jump over lazy dogs.
+@@end table
+
+@end group
+@group
+@@noindent
+On the other hand, @dots{}
+@end group
+@end example
+
+Insert blank lines before and after @code{@@itemize} @dots{} @code{@@end
+itemize} and @code{@@enumerate} @dots{} @code{@@end enumerate} in the
+same way.
+@end itemize
+
+@subsubheading Complete phrases
+
+Complete phrases are easier to read than @dots{}
+
+@itemize @bullet
+@item
+Write entries in an itemized list as complete sentences; or at least, as
+complete phrases. Incomplete expressions @dots{} awkward @dots{} like
+this.
+
+@item
+Write the prefatory sentence or phrase for a multi-item list or table as
+a complete expression. Do not write ``You can set:''; instead, write
+``You can set these variables:''. The former expression sounds cut off.
+@end itemize
+
+@subsubheading Editions, dates and versions
+
+Write the edition and version numbers and date in three places in every
+manual:
+
+@enumerate
+@item
+In the first @code{@@ifinfo} section, for people reading the Texinfo file.
+
+@item
+In the @code{@@titlepage} section, for people reading the printed manual.
+
+@item
+In the `Top' node, for people reading the Info file.
+@end enumerate
+
+@noindent
+Also, it helps to write a note before the first @code{@@ifinfo}
+section to explain what you are doing.
+
+@need 800
+@noindent
+For example:
+
+@example
+@group
+@@c ===> NOTE! <==
+@@c Specify the edition and version numbers and date
+@@c in *three* places:
+@@c 1. First ifinfo section 2. title page 3. top node
+@@c To find the locations, search for !!set
+@end group
+
+@group
+@@ifinfo
+@@c !!set edition, date, version
+This is Edition 4.03, January 1992,
+of the @@cite@{GDB Manual@} for GDB Version 4.3.
+@dots{}
+@end group
+@end example
+
+@noindent
+---or use @code{@@set} and @code{@@value}
+(@pxref{value Example, , @code{@@value} Example}).
+
+@subsubheading Definition Commands
+
+Definition commands are @code{@@deffn}, @code{@@defun},
+@code{@@defmac}, and the like, and enable you to write descriptions in
+a uniform format.@refill
+
+@itemize @bullet
+@item
+Write just one definition command for each entity you define with a
+definition command. The automatic indexing feature creates an index
+entry that leads the reader to the definition.
+
+@item
+Use @code{@@table} @dots{} @code{@@end table} in an appendix that
+contains a summary of functions, not @code{@@deffn} or other definition
+commands.
+@end itemize
+
+@subsubheading Capitalization
+
+@itemize @bullet
+@item
+Capitalize @samp{Texinfo}; it is a name. Do not write the @samp{x} or
+@samp{i} in upper case.
+
+@item
+Capitalize @samp{Info}; it is a name.
+
+@item
+Write @TeX{} using the @code{@@TeX@{@}} command. Note the uppercase
+@samp{T} and @samp{X}. This command causes the formatters to
+typeset the name according to the wishes of Donald Knuth, who wrote
+@TeX{}.
+@end itemize
+
+@subsubheading Spaces
+
+Do not use spaces to format a Texinfo file, except inside of
+@code{@@example} @dots{} @code{@@end example} and similar commands.
+
+@need 700
+For example, @TeX{} fills the following:
+
+@example
+@group
+ @@kbd@{C-x v@}
+ @@kbd@{M-x vc-next-action@}
+ Perform the next logical operation
+ on the version-controlled file
+ corresponding to the current buffer.
+@end group
+@end example
+
+@need 950
+@noindent
+so it looks like this:
+
+@iftex
+@quotation
+ @kbd{C-x v}
+ @kbd{M-x vc-next-action}
+ Perform the next logical operation on the version-controlled file
+ corresponding to the current buffer.
+@end quotation
+@end iftex
+@ifinfo
+@quotation
+`C-x v' `M-x vc-next-action' Perform the next logical operation on the
+version-controlled file corresponding to the current buffer.
+@end quotation
+@end ifinfo
+
+@noindent
+In this case, the text should be formatted with
+@code{@@table}, @code{@@item}, and @code{@@itemx}, to create a table.
+
+@subsubheading @@code, @@samp, @@var, and @samp{---}
+
+@itemize @bullet
+@item
+Use @code{@@code} around Lisp symbols, including command names.
+For example,
+
+@example
+The main function is @@code@{vc-next-action@}, @dots{}
+@end example
+
+@item
+Avoid putting letters such as @samp{s} immediately after an
+@samp{@@code}. Such letters look bad.
+
+@item
+Use @code{@@var} around meta-variables. Do not write angle brackets
+around them.
+
+@item
+Use three hyphens in a row, @samp{---}, to indicate a long dash. @TeX{}
+typesets these as a long dash and the Info formatters reduce three
+hyphens to two.
+@end itemize
+
+@subsubheading Periods Outside of Quotes
+
+Place periods and other punctuation marks @emph{outside} of quotations,
+unless the punctuation is part of the quotation. This practice goes
+against publishing conventions in the United States, but enables the
+reader to distinguish between the contents of the quotation and the
+whole passage.
+
+For example, you should write the following sentence with the period
+outside the end quotation marks:
+
+@example
+Evidently, @samp{au} is an abbreviation for ``author''.
+@end example
+
+@noindent
+since @samp{au} does @emph{not} serve as an abbreviation for
+@samp{author.} (with a period following the word).
+
+@subsubheading Introducing New Terms
+
+@itemize @bullet
+@item
+Introduce new terms so that a reader who does not know them can
+understand them from context; or write a definition for the term.
+
+For example, in the following, the terms ``check in'', ``register'' and
+``delta'' are all appearing for the first time; the example sentence should be
+rewritten so they are understandable.
+
+@quotation
+The major function assists you in checking in a file to your
+version control system and registering successive sets of changes to
+it as deltas.
+@end quotation
+
+@item
+Use the @code{@@dfn} command around a word being introduced, to indicate
+that the reader should not expect to know the meaning already, and
+should expect to learn the meaning from this passage.
+@end itemize
+
+@subsubheading @@pxref
+
+@c !!! maybe include this in the tips on pxref
+@ignore
+By the way, it is okay to use pxref with something else in front of
+it within the parens, as long as the pxref is followed by the close
+paren, and the material inside the parens is not part of a larger
+sentence. Also, you can use xref inside parens as part of a complete
+sentence so long as you terminate the cross reference with punctuation.
+@end ignore
+Absolutely never use @code{@@pxref} except in the special context for
+which it is designed: inside parentheses, with the closing parenthesis
+following immediately after the closing brace. One formatter
+automatically inserts closing punctuation and the other does not. This
+means that the output looks right both in printed output and in an Info
+file, but only when the command is used inside parentheses.
+
+@subsubheading Invoking from a Shell
+
+You can invoke programs such as Emacs, GCC, and GAWK from a shell.
+The documentation for each program should contain a section that
+describes this. Unfortunately, if the node names and titles for these
+sections are all different, readers find it hard to search for the
+section.@refill
+
+Name such sections with a phrase beginning with the word
+@w{`Invoking @dots{}'}, as in `Invoking Emacs'; this way
+users can find the section easily.
+
+@subsubheading @sc{ansi c} Syntax
+
+When you use @code{@@example} to describe a C function's calling
+conventions, use the @sc{ansi c} syntax, like this:@refill
+
+@example
+void dld_init (char *@@var@{path@});
+@end example
+
+@noindent
+And in the subsequent discussion, refer to the argument values by
+writing the same argument names, again highlighted with
+@code{@@var}.@refill
+
+@need 800
+Avoid the obsolete style that looks like this:@refill
+
+@example
+#include <dld.h>
+
+dld_init (path)
+char *path;
+@end example
+
+Also, it is best to avoid writing @code{#include} above the
+declaration just to indicate that the function is declared in a
+header file. The practice may give the misimpression that the
+@code{#include} belongs near the declaration of the function. Either
+state explicitly which header file holds the declaration or, better
+yet, name the header file used for a group of functions at the
+beginning of the section that describes the functions.@refill
+
+@subsubheading Bad Examples
+
+Here are several examples of bad writing to avoid:
+
+In this example, say, `` @dots{} you must @code{@@dfn}@{check
+in@} the new version.'' That flows better.
+
+@quotation
+When you are done editing the file, you must perform a
+@code{@@dfn}@{check in@}.
+@end quotation
+
+In the following example, say, ``@dots{} makes a unified interface such as VC
+mode possible.''
+
+@quotation
+SCCS, RCS and other version-control systems all perform similar
+functions in broadly similar ways (it is this resemblance which makes
+a unified control mode like this possible).
+@end quotation
+
+And in this example, you should specify what `it' refers to:
+
+@quotation
+If you are working with other people, it assists in coordinating
+everyone's changes so they do not step on each other.
+@end quotation
+
+@subsubheading And Finally @dots{}
+
+@itemize @bullet
+@item
+Pronounce @TeX{} as if the @samp{X} were a Greek `chi', as the last
+sound in the name `Bach'. But pronounce Texinfo as in `speck':
+@samp{teckinfo}.
+
+@item
+Write notes for yourself at the very end of a Texinfo file after the
+@code{@@bye}. None of the formatters process text after the
+@code{@@bye}; it is as if the text were within @code{@@ignore} @dots{}
+@code{@@end ignore}.
+@end itemize
+
+@node Sample Texinfo File, Sample Permissions, Tips, Top
+@comment node-name, next, previous, up
+@appendix A Sample Texinfo File
+@cindex Sample Texinfo file, no comments
+
+Here is a complete, short sample Texinfo file, without any commentary.
+You can see this file, with comments, in the first chapter.
+@xref{Short Sample, , A Short Sample Texinfo File}.
+
+@sp 1
+@example
+\input texinfo @@c -*-texinfo-*-
+@@c %**start of header
+@@setfilename sample.info
+@@settitle Sample Document
+@@c %**end of header
+
+@@setchapternewpage odd
+
+@@ifinfo
+This is a short example of a complete Texinfo file.
+
+Copyright 1990 Free Software Foundation, Inc.
+@@end ifinfo
+
+@@titlepage
+@@sp 10
+@@comment The title is printed in a large font.
+@@center @@titlefont@{Sample Title@}
+
+@@c The following two commands start the copyright page.
+@@page
+@@vskip 0pt plus 1filll
+Copyright @@copyright@{@} 1990 Free Software Foundation, Inc.
+@@end titlepage
+
+@@node Top, First Chapter, (dir), (dir)
+@@comment node-name, next, previous, up
+
+@@menu
+* First Chapter:: The first chapter is the
+ only chapter in this sample.
+* Concept Index:: This index has two entries.
+@@end menu
+
+@@node First Chapter, Concept Index, Top, Top
+@@comment node-name, next, previous, up
+@@chapter First Chapter
+@@cindex Sample index entry
+
+This is the contents of the first chapter.
+@@cindex Another sample index entry
+
+Here is a numbered list.
+
+@@enumerate
+@@item
+This is the first item.
+
+@@item
+This is the second item.
+@@end enumerate
+
+The @@code@{makeinfo@} and @@code@{texinfo-format-buffer@}
+commands transform a Texinfo file such as this into
+an Info file; and @@TeX@{@} typesets it for a printed
+manual.
+
+@@node Concept Index, , First Chapter, Top
+@@comment node-name, next, previous, up
+@@unnumbered Concept Index
+
+@@printindex cp
+
+@@contents
+@@bye
+@end example
+
+@node Sample Permissions, Include Files, Sample Texinfo File, Top
+@appendix Sample Permissions
+@cindex Permissions
+@cindex Copying permissions
+
+Texinfo files should contain sections that tell the readers that they
+have the right to copy and distribute the Texinfo file, the Info file,
+and the printed manual.@refill
+
+Also, if you are writing a manual about software, you should explain
+that the software is free and either include the GNU General Public
+License (GPL) or provide a reference to it. @xref{Distrib, ,
+Distribution, emacs, The GNU Emacs Manual}, for an example of the text
+that could be used in the software ``Distribution'', ``General Public
+License'', and ``NO WARRANTY'' sections of a document. @xref{Copying,
+, Texinfo Copying Conditions}, for an example of a brief explanation
+of how the copying conditions provide you with rights. @refill
+
+@menu
+* Inserting Permissions:: How to put permissions in your document.
+* ifinfo Permissions:: Sample @samp{ifinfo} copying permissions.
+* Titlepage Permissions:: Sample Titlepage copying permissions.
+@end menu
+
+@node Inserting Permissions, ifinfo Permissions, Sample Permissions, Sample Permissions
+@ifinfo
+@appendixsec Inserting Permissions
+@end ifinfo
+
+In a Texinfo file, the first @code{@@ifinfo} section usually begins
+with a line that says what the file documents. This is what a person
+reading the unprocessed Texinfo file or using the advanced Info
+command @kbd{g *} sees first. @inforef{Expert, Advanced Info
+commands, info}, for more information. (A reader using the regular
+Info commands usually starts reading at the first node and skips
+this first section, which is not in a node.)@refill
+
+In the @code{@@ifinfo} section, the summary sentence is followed by a
+copyright notice and then by the copying permission notice. One of
+the copying permission paragraphs is enclosed in @code{@@ignore} and
+@code{@@end ignore} commands. This paragraph states that the Texinfo
+file can be processed through @TeX{} and printed, provided the printed
+manual carries the proper copying permission notice. This paragraph
+is not made part of the Info file since it is not relevant to the Info
+file; but it is a mandatory part of the Texinfo file since it permits
+people to process the Texinfo file in @TeX{} and print the
+results.@refill
+
+In the printed manual, the Free Software Foundation copying permission
+notice follows the copyright notice and publishing information and is
+located within the region delineated by the @code{@@titlepage} and
+@code{@@end titlepage} commands. The copying permission notice is exactly
+the same as the notice in the @code{@@ifinfo} section except that the
+paragraph enclosed in @code{@@ignore} and @code{@@end ignore} commands is
+not part of the notice.@refill
+
+To make it simple to insert a permission notice into each section of
+the Texinfo file, sample permission notices for each section are
+reproduced in full below.@refill
+
+Note that you may need to specify the correct name of a section
+mentioned in the permission notice. For example, in @cite{The GDB
+Manual}, the name of the section referring to the General Public
+License is called the ``GDB General Public License'', but in the
+sample shown below, that section is referred to generically as the
+``GNU General Public License''. If the Texinfo file does not carry a
+copy of the General Public License, leave out the reference to it, but
+be sure to include the rest of the sentence.@refill
+
+@node ifinfo Permissions, Titlepage Permissions, Inserting Permissions, Sample Permissions
+@comment node-name, next, previous, up
+@appendixsec @samp{ifinfo} Copying Permissions
+@cindex @samp{ifinfo} permissions
+
+In the @code{@@ifinfo} section of a Texinfo file, the standard Free
+Software Foundation permission notice reads as follows:@refill
+
+@example
+This file documents @dots{}
+
+Copyright 1992 Free Software Foundation, Inc.
+
+Permission is granted to make and distribute verbatim
+copies of this manual provided the copyright notice and
+this permission notice are preserved on all copies.
+
+@@ignore
+Permission is granted to process this file through TeX
+and print the results, provided the printed document
+carries a copying permission notice identical to this
+one except for the removal of this paragraph (this
+paragraph not being relevant to the printed manual).
+
+@@end ignore
+Permission is granted to copy and distribute modified
+versions of this manual under the conditions for
+verbatim copying, provided also that the sections
+entitled ``Copying'' and ``GNU General Public License''
+are included exactly as in the original, and provided
+that the entire resulting derived work is distributed
+under the terms of a permission notice identical to this
+one.
+
+Permission is granted to copy and distribute
+translations of this manual into another language,
+under the above conditions for modified versions,
+except that this permission notice may be stated in a
+translation approved by the Free Software Foundation.
+@end example
+
+@node Titlepage Permissions, , ifinfo Permissions, Sample Permissions
+@comment node-name, next, previous, up
+@appendixsec Titlepage Copying Permissions
+@cindex Titlepage permissions
+
+In the @code{@@titlepage} section of a Texinfo file, the standard Free
+Software Foundation copying permission notice follows the copyright
+notice and publishing information. The standard phrasing is as
+follows:@refill
+
+@example
+Permission is granted to make and distribute verbatim
+copies of this manual provided the copyright notice and
+this permission notice are preserved on all copies.
+
+Permission is granted to copy and distribute modified
+versions of this manual under the conditions for
+verbatim copying, provided also that the sections
+entitled ``Copying'' and ``GNU General Public License''
+are included exactly as in the original, and provided
+that the entire resulting derived work is distributed
+under the terms of a permission notice identical to this
+one.
+
+Permission is granted to copy and distribute
+translations of this manual into another language,
+under the above conditions for modified versions,
+except that this permission notice may be stated in a
+translation approved by the Free Software Foundation.
+@end example
+
+@node Include Files, Headings, Sample Permissions, Top
+@comment node-name, next, previous, up
+@appendix Include Files
+@cindex Include files
+
+When @TeX{} or an Info formatting command sees an @code{@@include}
+command in a Texinfo file, it processes the contents of the file named
+by the command and incorporates them into the @sc{dvi} or Info file being
+created. Index entries from the included file are incorporated into
+the indices of the output file.@refill
+
+Include files let you keep a single large document as a collection of
+conveniently small parts.@refill
+
+@menu
+* Using Include Files:: How to use the @code{@@include} command.
+* texinfo-multiple-files-update:: How to create and update nodes and
+ menus when using included files.
+* Include File Requirements:: What @code{texinfo-multiple-files-update} expects.
+* Sample Include File:: A sample outer file with included files
+ within it; and a sample included file.
+* Include Files Evolution:: How use of the @code{@@include} command
+ has changed over time.
+@end menu
+
+@node Using Include Files, texinfo-multiple-files-update, Include Files, Include Files
+@appendixsec How to Use Include Files
+@findex include
+
+To include another file within a Texinfo file, write the
+@code{@@include} command at the beginning of a line and follow it on
+the same line by the name of a file to be included. For
+example:@refill
+
+@example
+@@include buffers.texi
+@end example
+
+An included file should simply be a segment of text that you expect to
+be included as is into the overall or @dfn{outer} Texinfo file; it
+should not contain the standard beginning and end parts of a Texinfo
+file. In particular, you should not start an included file with a
+line saying @samp{\input texinfo}; if you do, that phrase is inserted
+into the output file as is. Likewise, you should not end an included
+file with an @code{@@bye} command; nothing after @code{@@bye} is
+formatted.@refill
+
+In the past, you were required to write an @code{@@setfilename} line at the
+beginning of an included file, but no longer. Now, it does not matter
+whether you write such a line. If an @code{@@setfilename} line exists
+in an included file, it is ignored.@refill
+
+Conventionally, an included file begins with an @code{@@node} line that
+is followed by an @code{@@chapter} line. Each included file is one
+chapter. This makes it easy to use the regular node and menu creating
+and updating commands to create the node pointers and menus within the
+included file. However, the simple Emacs node and menu creating and
+updating commands do not work with multiple Texinfo files. Thus you
+cannot use these commands to fill in the `Next', `Previous', and `Up'
+pointers of the @code{@@node} line that begins the included file. Also,
+you cannot use the regular commands to create a master menu for the
+whole file. Either you must insert the menus and the `Next',
+`Previous', and `Up' pointers by hand, or you must use the GNU Emacs
+Texinfo mode command, @code{texinfo-multiple-files-update}, that is
+designed for @code{@@include} files.@refill
+
+@node texinfo-multiple-files-update, Include File Requirements, Using Include Files, Include Files
+@appendixsec @code{texinfo-multiple-files-update}
+@findex texinfo-multiple-files-update
+
+GNU Emacs Texinfo mode provides the @code{texinfo-multiple-files-update}
+command. This command creates or updates `Next', `Previous', and `Up'
+pointers of included files as well as those in the outer or overall
+Texinfo file, and it creates or updates a main menu in the outer file.
+Depending whether you call it with optional arguments, the command
+updates only the pointers in the first @code{@@node} line of the
+included files or all of them:@refill
+
+@table @kbd
+@item M-x texinfo-multiple-files-update
+Called without any arguments:@refill
+
+@itemize @minus
+@item
+Create or update the `Next', `Previous', and `Up' pointers of the
+first @code{@@node} line in each file included in an outer or overall
+Texinfo file.@refill
+
+@item
+Create or update the `Top' level node pointers of the outer or
+overall file.@refill
+
+@item
+Create or update a main menu in the outer file.@refill
+@end itemize
+
+@item C-u M-x texinfo-multiple-files-update
+Called with @kbd{C-u} as a prefix argument:
+
+@itemize @minus{}
+@item
+Create or update pointers in the first @code{@@node} line in each
+included file.
+
+@item
+Create or update the `Top' level node pointers of the outer file.
+
+@item
+Create and insert a master menu in the outer file. The master menu
+is made from all the menus in all the included files.@refill
+@end itemize
+
+@item C-u 8 M-x texinfo-multiple-files-update
+Called with a numeric prefix argument, such as @kbd{C-u 8}:
+
+@itemize @minus
+@item
+Create or update @strong{all} the `Next', `Previous', and `Up' pointers
+of all the included files.@refill
+
+@item
+Create or update @strong{all} the menus of all the included
+files.@refill
+
+@item
+Create or update the `Top' level node pointers of the outer or
+overall file.@refill
+
+@item
+And then create a master menu in the outer file. This is similar to
+invoking @code{texinfo-master-menu} with an argument when you are
+working with just one file.@refill
+@end itemize
+@end table
+
+Note the use of the prefix argument in interactive use: with a regular
+prefix argument, just @w{@kbd{C-u}}, the
+@code{texinfo-multiple-files-update} command inserts a master menu;
+with a numeric prefix argument, such as @kbd{C-u 8}, the command
+updates @strong{every} pointer and menu in @strong{all} the files and then inserts a
+master menu.@refill
+
+@node Include File Requirements, Sample Include File, texinfo-multiple-files-update, Include Files
+@appendixsec Include File Requirements
+@cindex Include file requirements
+@cindex Requirements for include files
+
+If you plan to use the @code{texinfo-multiple-files-update} command,
+the outer Texinfo file that lists included files within it should
+contain nothing but the beginning and end parts of a Texinfo file, and
+a number of @code{@@include} commands listing the included files. It
+should not even include indices, which should be listed in an included
+file of their own.@refill
+
+Moreover, each of the included files must contain exactly one highest
+level node (conventionally, @code{@@chapter} or equivalent),
+and this node must be the first node in the included file.
+Furthermore, each of these highest level nodes in each included file
+must be at the same hierarchical level in the file structure.
+Usually, each is an @code{@@chapter}, an @code{@@appendix}, or an
+@code{@@unnumbered} node. Thus, normally, each included file contains
+one, and only one, chapter or equivalent-level node.@refill
+
+The outer file should contain only @emph{one} node, the `Top' node. It
+should @emph{not} contain any nodes besides the single `Top' node. The
+@code{texinfo-multiple-files-update} command will not process
+them.@refill
+
+@node Sample Include File, Include Files Evolution, Include File Requirements, Include Files
+@appendixsec Sample File with @code{@@include}
+@cindex Sample @code{@@include} file
+@cindex Include file sample
+@cindex @code{@@include} file sample
+
+Here is an example of a complete outer Texinfo file with @code{@@include} files
+within it before running @code{texinfo-multiple-files-update}, which
+would insert a main or master menu:@refill
+
+@example
+@group
+\input texinfo @@c -*-texinfo-*-
+@c %**start of header
+@@setfilename include-example.info
+@@settitle Include Example
+@c %**end of header
+@end group
+
+@group
+@@setchapternewpage odd
+@@titlepage
+@@sp 12
+@@center @@titlefont@{Include Example@}
+@@sp 2
+@@center by Whom Ever
+@end group
+
+@group
+@@page
+@@vskip 0pt plus 1filll
+Copyright @@copyright@{@} 1990 Free Software Foundation, Inc.
+@@end titlepage
+@end group
+
+@group
+@@ifinfo
+@@node Top, First, (dir), (dir)
+@@top Master Menu
+@@end ifinfo
+@end group
+
+@group
+@@include foo.texinfo
+@@include bar.texinfo
+@@include concept-index.texinfo
+@end group
+
+@group
+@@summarycontents
+@@contents
+
+@@bye
+@end group
+@end example
+
+An included file, such as @file{foo.texinfo}, might look like
+this:@refill
+
+@example
+@group
+@@node First, Second, , Top
+@@chapter First Chapter
+
+Contents of first chapter @dots{}
+@end group
+@end example
+
+The full contents of @file{concept-index.texinfo} might be as simple as this:
+
+@example
+@group
+@@node Concept Index, , Second, Top
+@@unnumbered Concept Index
+
+@@printindex cp
+@end group
+@end example
+
+The outer Texinfo source file for @cite{The GNU Emacs Lisp Reference
+Manual} is named @file{elisp.texi}. This outer file contains a master
+menu with 417 entries and a list of 41 @code{@@include}
+files.@refill
+
+@node Include Files Evolution, , Sample Include File, Include Files
+@comment node-name, next, previous, up
+@appendixsec Evolution of Include Files
+
+When Info was first created, it was customary to create many small
+Info files on one subject. Each Info file was formatted from its own
+Texinfo source file. This custom meant that Emacs did not need to
+make a large buffer to hold the whole of a large Info file when
+someone wanted information; instead, Emacs allocated just enough
+memory for the small Info file that contained the particular
+information sought. This way, Emacs could avoid wasting memory.@refill
+
+References from one file to another were made by referring to the file
+name as well as the node name. (@xref{Other Info Files, , Referring to
+Other Info Files}. Also, see @ref{Four and Five Arguments, ,
+@code{@@xref} with Four and Five Arguments}.)@refill
+
+Include files were designed primarily as a way to create a single,
+large printed manual out of several smaller Info files. In a printed
+manual, all the references were within the same document, so @TeX{}
+could automatically determine the references' page numbers. The Info
+formatting commands used include files only for creating joint
+indices; each of the individual Texinfo files had to be formatted for
+Info individually. (Each, therefore, required its own
+@code{@@setfilename} line.)@refill
+
+However, because large Info files are now split automatically, it is
+no longer necessary to keep them small.@refill
+
+Nowadays, multiple Texinfo files are used mostly for large documents,
+such as @cite{The GNU Emacs Lisp Reference Manual}, and for projects
+in which several different people write different sections of a
+document simultaneously.@refill
+
+In addition, the Info formatting commands have been extended to work
+with the @code{@@include} command so as to create a single large Info
+file that is split into smaller files if necessary. This means that
+you can write menus and cross references without naming the different
+Texinfo files.@refill
+
+@node Headings, Catching Mistakes, Include Files, Top
+@comment node-name, next, previous, up
+@appendix Page Headings
+@cindex Headings
+@cindex Footings
+@cindex Page numbering
+@cindex Page headings
+@cindex Formatting headings and footings
+
+Most printed manuals contain headings along the top of every page
+except the title and copyright pages. Some manuals also contain
+footings. (Headings and footings have no meaning to Info, which is
+not paginated.)@refill
+
+@menu
+* Headings Introduced:: Conventions for using page headings.
+* Heading Format:: Standard page heading formats.
+* Heading Choice:: How to specify the type of page heading.
+* Custom Headings:: How to create your own headings and footings.
+@end menu
+
+@node Headings Introduced, Heading Format, Headings, Headings
+@ifinfo
+@heading Headings Introduced
+@end ifinfo
+
+Texinfo provides standard page heading formats for manuals that are printed
+on one side of each sheet of paper and for manuals that are printed on
+both sides of the paper. Usually, you will use one or other of these
+formats, but you can specify your own format, if you wish.@refill
+
+In addition, you can specify whether chapters should begin on a new
+page, or merely continue the same page as the previous chapter; and if
+chapters begin on new pages, you can specify whether they must be
+odd-numbered pages.@refill
+
+By convention, a book is printed on both sides of each sheet of paper.
+When you open a book, the right-hand page is odd-numbered, and
+chapters begin on right-hand pages---a preceding left-hand page is
+left blank if necessary. Reports, however, are often printed on just
+one side of paper, and chapters begin on a fresh page immediately
+following the end of the preceding chapter. In short or informal
+reports, chapters often do not begin on a new page at all, but are
+separated from the preceding text by a small amount of whitespace.@refill
+
+The @code{@@setchapternewpage} command controls whether chapters begin
+on new pages, and whether one of the standard heading formats is used.
+In addition, Texinfo has several heading and footing commands that you
+can use to generate your own heading and footing formats.@refill
+
+In Texinfo, headings and footings are single lines at the tops and
+bottoms of pages; you cannot create multiline headings or footings.
+Each header or footer line is divided into three parts: a left part, a
+middle part, and a right part. Any part, or a whole line, may be left
+blank. Text for the left part of a header or footer line is set
+flushleft; text for the middle part is centered; and, text for the
+right part is set flushright.@refill
+
+@node Heading Format, Heading Choice, Headings Introduced, Headings
+@comment node-name, next, previous, up
+@appendixsec Standard Heading Formats
+
+Texinfo provides two standard heading formats, one for manuals printed
+on one side of each sheet of paper, and the other for manuals printed
+on both sides of the paper.
+
+By default, nothing is specified for the footing of a Texinfo file,
+so the footing remains blank.@refill
+
+The standard format for single-sided printing consists of a header
+line in which the left-hand part contains the name of the chapter, the
+central part is blank, and the right-hand part contains the page
+number.@refill
+
+@need 950
+A single-sided page looks like this:
+
+@example
+@group
+ _______________________
+ | |
+ | chapter page number |
+ | |
+ | Start of text ... |
+ | ... |
+ | |
+
+@end group
+@end example
+
+The standard format for two-sided printing depends on whether the page
+number is even or odd. By convention, even-numbered pages are on the
+left- and odd-numbered pages are on the right. (@TeX{} will adjust the
+widths of the left- and right-hand margins. Usually, widths are
+correct, but during double-sided printing, it is wise to check that
+pages will bind properly---sometimes a printer will produce output in
+which the even-numbered pages have a larger right-hand margin than the
+odd-numbered pages.)@refill
+
+In the standard double-sided format, the left part of the left-hand
+(even-numbered) page contains the page number, the central part is
+blank, and the right part contains the title (specified by the
+@code{@@settitle} command). The left part of the right-hand
+(odd-numbered) page contains the name of the chapter, the central part
+is blank, and the right part contains the page number.@refill
+
+@need 750
+Two pages, side by side as in an open book, look like this:@refill
+
+@example
+@group
+ _______________________ _______________________
+ | | | |
+ | page number title | | chapter page number |
+ | | | |
+ | Start of text ... | | More text ... |
+ | ... | | ... |
+ | | | |
+
+@end group
+@end example
+
+@noindent
+The chapter name is preceded by the word @samp{Chapter}, the chapter
+number and a colon. This makes it easier to keep track of where you
+are in the manual.@refill
+
+@node Heading Choice, Custom Headings, Heading Format, Headings
+@comment node-name, next, previous, up
+@appendixsec Specifying the Type of Heading
+
+@TeX{} does not begin to generate page headings for a standard Texinfo
+file until it reaches the @code{@@end titlepage} command. Thus, the
+title and copyright pages are not numbered. The @code{@@end
+titlepage} command causes @TeX{} to begin to generate page headings
+according to a standard format specified by the
+@code{@@setchapternewpage} command that precedes the
+@code{@@titlepage} section.@refill
+
+@need 1000
+There are four possibilities:@refill
+
+@table @asis
+@item No @code{@@setchapternewpage} command
+Cause @TeX{} to specify the single-sided heading format, with chapters
+on new pages. This is the same as @code{@@setchapternewpage on}.@refill
+
+@item @code{@@setchapternewpage on}
+Specify the single-sided heading format, with chapters on new pages.@refill
+
+@item @code{@@setchapternewpage off}
+Cause @TeX{} to start a new chapter on the same page as the last page of
+the preceding chapter, after skipping some vertical whitespace. Also
+cause @TeX{} to typeset for single-sided printing. (You can override
+the headers format with the @code{@@headings double} command; see
+@ref{headings on off, , The @code{@@headings} Command}.)@refill
+
+@item @code{@@setchapternewpage odd}
+Specify the double-sided heading format, with chapters on new pages.@refill
+@end table
+
+@noindent
+Texinfo lacks an @code{@@setchapternewpage even} command.@refill
+
+@node Custom Headings, , Heading Choice, Headings
+@comment node-name, next, previous, up
+@appendixsec How to Make Your Own Headings
+
+You can use the standard headings provided with Texinfo or specify
+your own.@refill
+
+@c Following paragraph is verbose to prevent overfull hboxes.
+Texinfo provides six commands for specifying headings and
+footings. The @code{@@everyheading} command and
+@code{@@everyfooting} command generate page headers and footers
+that are the same for both even- and odd-numbered pages.
+The @code{@@evenheading} command and @code{@@evenfooting}
+command generate headers and footers for even-numbered
+(left-hand) pages; and the @code{@@oddheading} command and
+@code{@@oddfooting} command generate headers and footers for
+odd-numbered (right-hand) pages.@refill
+
+Write custom heading specifications in the Texinfo file immediately
+after the @code{@@end titlepage} command. Enclose your specifications
+between @code{@@iftex} and @code{@@end iftex} commands since the
+@code{texinfo-format-buffer} command may not recognize them. Also,
+you must cancel the predefined heading commands with the
+@code{@@headings off} command before defining your own
+specifications.@refill
+
+@need 1000
+Here is how to tell @TeX{} to place the chapter name at the left, the
+page number in the center, and the date at the right of every header
+for both even- and odd-numbered pages:@refill
+
+@example
+@group
+@@iftex
+@@headings off
+@@everyheading @@thischapter @@| @@thispage @@| @@today@{@}
+@@end iftex
+@end group
+@end example
+
+@noindent
+You need to divide the left part from the central part and the central
+part from the right had part by inserting @samp{@@|} between parts.
+Otherwise, the specification command will not be able to tell where
+the text for one part ends and the next part begins.@refill
+
+Each part can contain text or @@-commands. The text
+is printed as if the part were within an ordinary paragraph in the
+body of the page. The @@-commands replace
+themselves with the page number, date, chapter name, or
+whatever.@refill
+
+@need 950
+Here are the six heading and footing commands:@refill
+
+@findex everyheading
+@findex everyfooting
+@table @code
+@item @@everyheading @var{left} @@| @var{center} @@| @var{right}
+@itemx @@everyfooting @var{left} @@| @var{center} @@| @var{right}
+
+The `every' commands specify the format for both even- and odd-numbered
+pages. These commands are for documents that are printed on one side
+of each sheet of paper, or for documents in which you want symmetrical
+headers or footers.@refill
+
+@findex evenheading
+@findex evenfooting
+@findex oddheading
+@findex oddfooting
+@item @@evenheading @var{left} @@| @var{center} @@| @var{right}
+@itemx @@oddheading @var{left} @@| @var{center} @@| @var{right}
+
+@itemx @@evenfooting @var{left} @@| @var{center} @@| @var{right}
+@itemx @@oddfooting @var{left} @@| @var{center} @@| @var{right}
+
+The `even' and `odd' commands specify the format for even-numbered
+pages and odd-numbered pages. These commands are for books and
+manuals that are printed on both sides of each sheet of paper.@refill
+@end table
+
+Use the @samp{@@this@dots{}} series of @@-commands to
+provide the names of chapters
+and sections and the page number. You can use the
+@samp{@@this@dots{}} commands in the left, center, or right portions
+of headers and footers, or anywhere else in a Texinfo file so long as
+they are between @code{@@iftex} and @code{@@end iftex} commands.@refill
+
+@need 1000
+Here are the @samp{@@this@dots{}} commands:@refill
+
+@table @code
+@findex thispage
+@item @@thispage
+Expands to the current page number.@refill
+@c !!! Karl Berry says that `thissection' fails on page breaks.
+@ignore
+@item @@thissection
+Expands to the name of the current section.@refill
+@end ignore
+
+@findex thischaptername
+@item @@thischaptername
+Expands to the name of the current chapter.@refill
+
+@findex thischapter
+@item @@thischapter
+Expands to the number and name of the current
+chapter, in the format `Chapter 1: Title'.@refill
+
+@findex thistitle
+@item @@thistitle
+Expands to the name of the document, as specified by the
+@code{@@settitle} command.@refill
+
+@findex thisfile
+@item @@thisfile
+For @code{@@include} files only: expands to the name of the current
+@code{@@include} file. If the current Texinfo source file is not an
+@code{@@include} file, this command has no effect. This command does
+@emph{not} provide the name of the current Texinfo source file unless
+it is an @code{@@include} file. (@xref{Include Files}, for more
+information about @code{@@include} files.)@refill
+@end table
+
+@noindent
+You can also use the @code{@@today@{@}} command, which expands to the
+current date, in `1 Jan 1900' format.@refill
+@findex today
+
+Other @@-commands and text are printed in a header or footer just as
+if they were in the body of a page. It is useful to incorporate text,
+particularly when you are writing drafts:@refill
+
+@example
+@group
+@@iftex
+@@headings off
+@@everyheading @@emph@{Draft!@} @@| @@thispage @@| @@thischapter
+@@everyfooting @@| @@| Version: 0.27: @@today@{@}
+@@end iftex
+@end group
+@end example
+
+Beware of overlong titles: they may overlap another part of the
+header or footer and blot it out.@refill
+
+@node Catching Mistakes, Refilling Paragraphs, Headings, Top
+@comment node-name, next, previous, up
+@appendix Formatting Mistakes
+@cindex Structure, catching mistakes in
+@cindex Nodes, catching mistakes
+@cindex Catching mistakes
+@cindex Correcting mistakes
+@cindex Mistakes, catching
+@cindex Problems, catching
+@cindex Debugging the Texinfo structure
+
+Besides mistakes in the content of your documentation, there
+are two kinds of mistake you can make with Texinfo: you can make mistakes
+with @@-commands, and you can make mistakes with the structure of the
+nodes and chapters.@refill
+
+Emacs has two tools for catching the @@-command mistakes and two for
+catching structuring mistakes.@refill
+
+For finding problems with @@-commands, you can run @TeX{} or a region
+formatting command on the region that has a problem; indeed, you can
+run these commands on each region as you write it.@refill
+
+For finding problems with the structure of nodes and chapters, you can use
+@kbd{C-c C-s} (@code{texinfo-show-structure}) and the related @code{occur}
+command and you can use the @kbd{M-x Info-validate} command.@refill
+
+@menu
+* makeinfo preferred:: @code{makeinfo} finds errors.
+* Debugging with Info:: How to catch errors with Info formatting.
+* Debugging with TeX:: How to catch errors with @TeX{} formatting.
+* Using texinfo-show-structure:: How to use @code{texinfo-show-structure}.
+* Using occur:: How to list all lines containing a pattern.
+* Running Info-Validate:: How to find badly referenced nodes.
+@end menu
+
+@node makeinfo preferred, Debugging with Info, Catching Mistakes, Catching Mistakes
+@ifinfo
+@heading @code{makeinfo} Find Errors
+@end ifinfo
+
+The @code{makeinfo} program does an excellent job of catching errors
+and reporting them---far better than @code{texinfo-format-region} or
+@code{texinfo-format-buffer}. In addition, the various functions for
+automatically creating and updating node pointers and menus remove
+many opportunities for human error.@refill
+
+If you can, use the updating commands to create and insert pointers
+and menus. These prevent many errors. Then use @code{makeinfo} (or
+its Texinfo mode manifestations, @code{makeinfo-region} and
+@code{makeinfo-buffer}) to format your file and check for other
+errors. This is the best way to work with Texinfo. But if you
+cannot use @code{makeinfo}, or your problem is very puzzling, then you
+may want to use the tools described in this appendix.@refill
+
+@node Debugging with Info, Debugging with TeX, makeinfo preferred, Catching Mistakes
+@comment node-name, next, previous, up
+@appendixsec Catching Errors with Info Formatting
+@cindex Catching errors with Info formatting
+@cindex Debugging with Info formatting
+
+After you have written part of a Texinfo file, you can use the
+@code{texinfo-format-region} or the @code{makeinfo-region} command to
+see whether the region formats properly.@refill
+
+Most likely, however, you are reading this section because for some
+reason you cannot use the @code{makeinfo-region} command; therefore, the
+rest of this section presumes that you are using
+@code{texinfo-format-region}.@refill
+
+If you have made a mistake with an @@-command,
+@code{texinfo-format-region} will stop processing at or after the
+error and display an error message. To see where in the buffer the
+error occurred, switch to the @samp{*Info Region*} buffer; the cursor
+will be in a position that is after the location of the error. Also,
+the text will not be formatted after the place where the error
+occurred (or more precisely, where it was detected).@refill
+
+For example, if you accidentally end a menu with the command @code{@@end
+menus} with an `s' on the end, instead of with @code{@@end menu}, you
+will see an error message that says:@refill
+
+@example
+@@end menus is not handled by texinfo
+@end example
+
+@noindent
+The cursor will stop at the point in the buffer where the error
+occurs, or not long after it. The buffer will look like this:@refill
+
+@example
+@group
+---------- Buffer: *Info Region* ----------
+* Menu:
+
+* Using texinfo-show-structure:: How to use
+ `texinfo-show-structure'
+ to catch mistakes.
+* Running Info-Validate:: How to check for
+ unreferenced nodes.
+@@end menus
+@point{}
+---------- Buffer: *Info Region* ----------
+@end group
+@end example
+
+The @code{texinfo-format-region} command sometimes provides slightly
+odd error messages. For example, the following cross reference fails to format:@refill
+
+@example
+(@@xref@{Catching Mistakes, for more info.)
+@end example
+
+@noindent
+In this case, @code{texinfo-format-region} detects the missing closing
+brace but displays a message that says @samp{Unbalanced parentheses}
+rather than @samp{Unbalanced braces}. This is because the formatting
+command looks for mismatches between braces as if they were
+parentheses.@refill
+
+Sometimes @code{texinfo-format-region} fails to detect mistakes. For
+example, in the following, the closing brace is swapped with the
+closing parenthesis:@refill
+
+@example
+(@@xref@{Catching Mistakes), for more info.@}
+@end example
+
+@noindent
+Formatting produces:
+@example
+(*Note for more info.: Catching Mistakes)
+@end example
+
+The only way for you to detect this error is to realize that the
+reference should have looked like this:@refill
+
+@example
+(*Note Catching Mistakes::, for more info.)
+@end example
+
+Incidentally, if you are reading this node in Info and type @kbd{f
+@key{RET}} (@code{Info-follow-reference}), you will generate an error
+message that says:
+
+@example
+No such node: "Catching Mistakes) The only way @dots{}
+@end example
+
+@noindent
+This is because Info perceives the example of the error as the first
+cross reference in this node and if you type a @key{RET} immediately
+after typing the Info @kbd{f} command, Info will attempt to go to the
+referenced node. If you type @kbd{f catch @key{TAB} @key{RET}}, Info
+will complete the node name of the correctly written example and take
+you to the `Catching Mistakes' node. (If you try this, you can return
+from the `Catching Mistakes' node by typing @kbd{l}
+(@code{Info-last}).)
+
+@c !!! section on using Elisp debugger ignored.
+@ignore
+Sometimes @code{texinfo-format-region} will stop long after the
+original error; this is because it does not discover the problem until
+then. In this case, you will need to backtrack.@refill
+
+@c menu
+@c * Using the Emacs Lisp Debugger:: How to use the Emacs Lisp debugger.
+@c end menu
+
+@c node Using the Emacs Lisp Debugger
+@c appendixsubsec Using the Emacs Lisp Debugger
+@c index Using the Emacs Lisp debugger
+@c index Emacs Lisp debugger
+@c index Debugger, using the Emacs Lisp
+
+If an error is especially elusive, you can turn on the Emacs Lisp
+debugger and look at the backtrace; this tells you where in the
+@code{texinfo-format-region} function the problem occurred. You can
+turn on the debugger with the command:@refill
+
+@example
+M-x set-variable @key{RET} debug-on-error @key{RET} t @key{RET}
+@end example
+
+@noindent
+and turn it off with
+
+@example
+M-x set-variable @key{RET} debug-on-error @key{RET} nil @key{RET}
+@end example
+
+Often, when you are using the debugger, it is easier to follow what is
+going on if you use the Emacs Lisp files that are not byte-compiled.
+The byte-compiled sources send octal numbers to the debugger that may
+look mysterious. To use the uncompiled source files, load
+@file{texinfmt.el} and @file{texinfo.el} with the @kbd{M-x load-file}
+command.@refill
+
+The debugger will not catch an error if @code{texinfo-format-region}
+does not detect one. In the example shown above,
+@code{texinfo-format-region} did not find the error when the whole
+list was formatted, but only when part of the list was formatted.
+When @code{texinfo-format-region} did not find an error, the debugger
+did not find one either. @refill
+
+However, when @code{texinfo-format-region} did report an error, it
+invoked the debugger. This is the backtrace it produced:@refill
+
+@example
+---------- Buffer: *Backtrace* ----------
+Signalling: (search-failed "[@},]")
+ re-search-forward("[@},]")
+ (while ...)
+ (let ...)
+ texinfo-format-parse-args()
+ (let ...)
+ texinfo-format-xref()
+ funcall(texinfo-format-xref)
+ (if ...)
+ (let ...)
+ (if ...)
+ (while ...)
+ texinfo-format-scan()
+ (save-excursion ...)
+ (let ...)
+ texinfo-format-region(103370 103631)
+* call-interactively(texinfo-format-region)
+---------- Buffer: *Backtrace* ----------
+@end example
+
+The backtrace is read from the bottom up.
+@code{texinfo-format-region} was called interactively; and it, in
+turn, called various functions, including @code{texinfo-format-scan},
+@code{texinfo-format-xref} and @code{texinfo-format-parse-args}.
+Inside the function @code{texinfo-format-parse-args}, the function
+@code{re-search-forward} was called; it was this function that could
+not find the missing right-hand brace.@refill
+
+@xref{Lisp Debug, , Debugging Emacs Lisp, emacs, The GNU Emacs
+Manual}, for more information.@refill
+@end ignore
+
+@node Debugging with TeX, Using texinfo-show-structure, Debugging with Info, Catching Mistakes
+@comment node-name, next, previous, up
+@appendixsec Catching Errors with @TeX{} Formatting
+@cindex Catching errors with @TeX{} formatting
+@cindex Debugging with @TeX{} formatting
+
+You can also catch mistakes when you format a file with @TeX{}.@refill
+
+Usually, you will want to do this after you have run
+@code{texinfo-format-buffer} (or, better, @code{makeinfo-buffer}) on
+the same file, because @code{texinfo-format-buffer} sometimes displays
+error messages that make more sense than @TeX{}. (@xref{Debugging
+with Info}, for more information.)@refill
+
+For example, @TeX{} was run on a Texinfo file, part of which is shown
+here:@refill
+
+@example
+---------- Buffer: texinfo.texi ----------
+name of the Texinfo file as an extension. The
+@@samp@{??@} are `wildcards' that cause the shell to
+substitute all the raw index files. (@@xref@{sorting
+indices, for more information about sorting
+indices.)@@refill
+---------- Buffer: texinfo.texi ----------
+@end example
+
+@noindent
+(The cross reference lacks a closing brace.)
+@TeX{} produced the following output, after which it stopped:@refill
+
+@example
+---------- Buffer: *tex-shell* ----------
+Runaway argument?
+@{sorting indices, for more information about sorting
+indices.) @@refill @@ETC.
+! Paragraph ended before @@xref was complete.
+<to be read again>
+ @@par
+l.27
+
+?
+---------- Buffer: *tex-shell* ----------
+@end example
+
+In this case, @TeX{} produced an accurate and
+understandable error message:
+
+@example
+Paragraph ended before @@xref was complete.
+@end example
+
+@noindent
+@samp{@@par} is an internal @TeX{} command of no relevance to Texinfo.
+@samp{l.27} means that @TeX{} detected the problem on line 27 of the
+Texinfo file. The @samp{?} is the prompt @TeX{} uses in this
+circumstance.@refill
+
+Unfortunately, @TeX{} is not always so helpful, and sometimes you must
+truly be a Sherlock Holmes to discover what went wrong.@refill
+
+In any case, if you run into a problem like this, you can do one of three
+things.@refill
+
+@enumerate
+@item
+You can tell @TeX{} to continue running and ignore just this error by
+typing @key{RET} at the @samp{?} prompt.@refill
+
+@item
+You can tell @TeX{} to continue running and to ignore all errors as best
+it can by typing @kbd{r @key{RET}} at the @samp{?} prompt.@refill
+
+This is often the best thing to do. However, beware: the one error
+may produce a cascade of additional error messages as its consequences
+are felt through the rest of the file. (To stop @TeX{} when it is
+producing such an avalanche of error messages, type @kbd{C-d} (or
+@kbd{C-c C-d}, if you are running a shell inside Emacs.))@refill
+
+@item
+You can tell @TeX{} to stop this run by typing @kbd{x @key{RET}}
+at the @samp{?} prompt.@refill
+@end enumerate
+
+Please note that if you are running @TeX{} inside Emacs, you need to
+switch to the shell buffer and line at which @TeX{} offers the @samp{?}
+prompt.@refill
+
+Sometimes @TeX{} will format a file without producing error messages even
+though there is a problem. This usually occurs if a command is not ended
+but @TeX{} is able to continue processing anyhow. For example, if you fail
+to end an itemized list with the @code{@@end itemize} command, @TeX{} will
+write a @sc{dvi} file that you can print out. The only error message that
+@TeX{} will give you is the somewhat mysterious comment that@refill
+
+@example
+(@@end occurred inside a group at level 1)
+@end example
+
+@noindent
+However, if you print the @sc{dvi} file, you will find that the text
+of the file that follows the itemized list is entirely indented as if
+it were part of the last item in the itemized list. The error message
+is the way @TeX{} says that it expected to find an @code{@@end}
+command somewhere in the file; but that it could not determine where
+it was needed.@refill
+
+Another source of notoriously hard-to-find errors is a missing
+@code{@@end group} command. If you ever are stumped by
+incomprehensible errors, look for a missing @code{@@end group} command
+first.@refill
+
+If the Texinfo file lacks header lines,
+@TeX{} may stop in the
+beginning of its run and display output that looks like the following.
+The @samp{*} indicates that @TeX{} is waiting for input.@refill
+
+@example
+This is TeX, Version 3.14159 (Web2c 7.0)
+(test.texinfo [1])
+*
+@end example
+
+@noindent
+In this case, simply type @kbd{\end @key{RET}} after the asterisk. Then
+write the header lines in the Texinfo file and run the @TeX{} command
+again. (Note the use of the backslash, @samp{\}. @TeX{} uses @samp{\}
+instead of @samp{@@}; and in this circumstance, you are working
+directly with @TeX{}, not with Texinfo.)@refill
+
+@node Using texinfo-show-structure, Using occur, Debugging with TeX, Catching Mistakes
+@comment node-name, next, previous, up
+@appendixsec Using @code{texinfo-show-structure}
+@cindex Showing the structure of a file
+@findex texinfo-show-structure
+
+It is not always easy to keep track of the nodes, chapters, sections, and
+subsections of a Texinfo file. This is especially true if you are revising
+or adding to a Texinfo file that someone else has written.@refill
+
+In GNU Emacs, in Texinfo mode, the @code{texinfo-show-structure}
+command lists all the lines that begin with the @@-commands that
+specify the structure: @code{@@chapter}, @code{@@section},
+@code{@@appendix}, and so on. With an argument (@w{@kbd{C-u}}
+as prefix argument, if interactive),
+the command also shows the @code{@@node} lines. The
+@code{texinfo-show-structure} command is bound to @kbd{C-c C-s} in
+Texinfo mode, by default.@refill
+
+The lines are displayed in a buffer called the @samp{*Occur*} buffer,
+indented by hierarchical level. For example, here is a part of what was
+produced by running @code{texinfo-show-structure} on this manual:@refill
+
+@example
+@group
+ Lines matching "^@@\\(chapter \\|sect\\|subs\\|subh\\|
+ unnum\\|major\\|chapheading \\|heading \\|appendix\\)"
+ in buffer texinfo.texi.
+ @dots{}
+ 4177:@@chapter Nodes
+ 4198: @@heading Two Paths
+ 4231: @@section Node and Menu Illustration
+ 4337: @@section The @@code@{@@@@node@} Command
+ 4393: @@subheading Choosing Node and Pointer Names
+ 4417: @@subsection How to Write an @@code@{@@@@node@} Line
+ 4469: @@subsection @@code@{@@@@node@} Line Tips
+ @dots{}
+@end group
+@end example
+
+This says that lines 4337, 4393, and 4417 of @file{texinfo.texi} begin
+with the @code{@@section}, @code{@@subheading}, and @code{@@subsection}
+commands respectively. If you move your cursor into the @samp{*Occur*}
+window, you can position the cursor over one of the lines and use the
+@kbd{C-c C-c} command (@code{occur-mode-goto-occurrence}), to jump to
+the corresponding spot in the Texinfo file. @xref{Other Repeating
+Search, , Using Occur, emacs, The GNU Emacs Manual}, for more
+information about @code{occur-mode-goto-occurrence}.@refill
+
+The first line in the @samp{*Occur*} window describes the @dfn{regular
+expression} specified by @var{texinfo-heading-pattern}. This regular
+expression is the pattern that @code{texinfo-show-structure} looks for.
+@xref{Regexps, , Using Regular Expressions, emacs, The GNU Emacs Manual},
+for more information.@refill
+
+When you invoke the @code{texinfo-show-structure} command, Emacs will
+display the structure of the whole buffer. If you want to see the
+structure of just a part of the buffer, of one chapter, for example,
+use the @kbd{C-x n n} (@code{narrow-to-region}) command to mark the
+region. (@xref{Narrowing, , , emacs, The GNU Emacs Manual}.) This is
+how the example used above was generated. (To see the whole buffer
+again, use @kbd{C-x n w} (@code{widen}).)@refill
+
+If you call @code{texinfo-show-structure} with a prefix argument by
+typing @w{@kbd{C-u C-c C-s}}, it will list lines beginning with
+@code{@@node} as well as the lines beginning with the @@-sign commands
+for @code{@@chapter}, @code{@@section}, and the like.@refill
+
+You can remind yourself of the structure of a Texinfo file by looking at
+the list in the @samp{*Occur*} window; and if you have mis-named a node
+or left out a section, you can correct the mistake.@refill
+
+@node Using occur, Running Info-Validate, Using texinfo-show-structure, Catching Mistakes
+@comment node-name, next, previous, up
+@appendixsec Using @code{occur}
+@cindex Occurrences, listing with @code{@@occur}
+@findex occur
+
+Sometimes the @code{texinfo-show-structure} command produces too much
+information. Perhaps you want to remind yourself of the overall structure
+of a Texinfo file, and are overwhelmed by the detailed list produced by
+@code{texinfo-show-structure}. In this case, you can use the @code{occur}
+command directly. To do this, type@refill
+
+@example
+@kbd{M-x occur}
+@end example
+
+@noindent
+and then, when prompted, type a @dfn{regexp}, a regular expression for
+the pattern you want to match. (@xref{Regexps, , Regular Expressions,
+emacs, The GNU Emacs Manual}.) The @code{occur} command works from
+the current location of the cursor in the buffer to the end of the
+buffer. If you want to run @code{occur} on the whole buffer, place
+the cursor at the beginning of the buffer.@refill
+
+For example, to see all the lines that contain the word
+@samp{@@chapter} in them, just type @samp{@@chapter}. This will
+produce a list of the chapters. It will also list all the sentences
+with @samp{@@chapter} in the middle of the line.@refill
+
+If you want to see only those lines that start with the word
+@samp{@@chapter}, type @samp{^@@chapter} when prompted by
+@code{occur}. If you want to see all the lines that end with a word
+or phrase, end the last word with a @samp{$}; for example,
+@samp{catching mistakes$}. This can be helpful when you want to see
+all the nodes that are part of the same chapter or section and
+therefore have the same `Up' pointer.@refill
+
+@xref{Other Repeating Search, , Using Occur, emacs , The GNU Emacs Manual},
+for more information.@refill
+
+@node Running Info-Validate, , Using occur, Catching Mistakes
+@comment node-name, next, previous, up
+@appendixsec Finding Badly Referenced Nodes
+@findex Info-validate
+@cindex Nodes, checking for badly referenced
+@cindex Checking for badly referenced nodes
+@cindex Looking for badly referenced nodes
+@cindex Finding badly referenced nodes
+@cindex Badly referenced nodes
+
+You can use the @code{Info-validate} command to check whether any of
+the `Next', `Previous', `Up' or other node pointers fail to point to a
+node. This command checks that every node pointer points to an
+existing node. The @code{Info-validate} command works only on Info
+files, not on Texinfo files.@refill
+
+The @code{makeinfo} program validates pointers automatically, so you
+do not need to use the @code{Info-validate} command if you are using
+@code{makeinfo}. You only may need to use @code{Info-validate} if you
+are unable to run @code{makeinfo} and instead must create an Info file
+using @code{texinfo-format-region} or @code{texinfo-format-buffer}, or
+if you write an Info file from scratch.@refill
+
+@menu
+* Using Info-validate:: How to run @code{Info-validate}.
+* Unsplit:: How to create an unsplit file.
+* Tagifying:: How to tagify a file.
+* Splitting:: How to split a file manually.
+@end menu
+
+@node Using Info-validate, Unsplit, Running Info-Validate, Running Info-Validate
+@appendixsubsec Running @code{Info-validate}
+@cindex Running @code{Info-validate}
+@cindex Info validating a large file
+@cindex Validating a large file
+
+To use @code{Info-validate}, visit the Info file you wish to check and
+type:@refill
+
+@example
+M-x Info-validate
+@end example
+
+@noindent
+(Note that the @code{Info-validate} command requires an upper case
+`I'. You may also need to create a tag table before running
+@code{Info-validate}. @xref{Tagifying}.)@refill
+
+If your file is valid, you will receive a message that says ``File appears
+valid''. However, if you have a pointer that does not point to a node,
+error messages will be displayed in a buffer called @samp{*problems in
+info file*}.@refill
+
+For example, @code{Info-validate} was run on a test file that contained
+only the first node of this manual. One of the messages said:@refill
+
+@example
+In node "Overview", invalid Next: Texinfo Mode
+@end example
+
+@noindent
+This meant that the node called @samp{Overview} had a `Next' pointer that
+did not point to anything (which was true in this case, since the test file
+had only one node in it).@refill
+
+Now suppose we add a node named @samp{Texinfo Mode} to our test case
+but we do not specify a `Previous' for this node. Then we will get
+the following error message:@refill
+
+@example
+In node "Texinfo Mode", should have Previous: Overview
+@end example
+
+@noindent
+This is because every `Next' pointer should be matched by a
+`Previous' (in the node where the `Next' points) which points back.@refill
+
+@code{Info-validate} also checks that all menu entries and cross references
+point to actual nodes.@refill
+
+Note that @code{Info-validate} requires a tag table and does not work
+with files that have been split. (The @code{texinfo-format-buffer}
+command automatically splits large files.) In order to use
+@code{Info-validate} on a large file, you must run
+@code{texinfo-format-buffer} with an argument so that it does not split
+the Info file; and you must create a tag table for the unsplit
+file.@refill
+
+@node Unsplit, Tagifying, Using Info-validate, Running Info-Validate
+@comment node-name, next, previous, up
+@appendixsubsec Creating an Unsplit File
+@cindex Creating an unsplit file
+@cindex Unsplit file creation
+
+You can run @code{Info-validate} only on a single Info file that has a
+tag table. The command will not work on the indirect subfiles that
+are generated when a master file is split. If you have a large file
+(longer than 70,000 bytes or so), you need to run the
+@code{texinfo-format-buffer} or @code{makeinfo-buffer} command in such
+a way that it does not create indirect subfiles. You will also need
+to create a tag table for the Info file. After you have done this,
+you can run @code{Info-validate} and look for badly referenced
+nodes.@refill
+
+The first step is to create an unsplit Info file. To prevent
+@code{texinfo-format-buffer} from splitting a Texinfo file into
+smaller Info files, give a prefix to the @kbd{M-x
+texinfo-format-buffer} command:@refill
+
+@example
+C-u M-x texinfo-format-buffer
+@end example
+
+@noindent
+or else
+
+@example
+C-u C-c C-e C-b
+@end example
+
+@noindent
+When you do this, Texinfo will not split the file and will not create
+a tag table for it. @refill
+@cindex Making a tag table manually
+@cindex Tag table, making manually
+
+@node Tagifying, Splitting, Unsplit, Running Info-Validate
+@appendixsubsec Tagifying a File
+
+After creating an unsplit Info file, you must create a tag table for
+it. Visit the Info file you wish to tagify and type:@refill
+
+@example
+M-x Info-tagify
+@end example
+
+@noindent
+(Note the upper case @samp{I} in @code{Info-tagify}.) This creates an
+Info file with a tag table that you can validate.@refill
+
+The third step is to validate the Info file:@refill
+
+@example
+M-x Info-validate
+@end example
+
+@noindent
+(Note the upper case @samp{I} in @code{Info-validate}.)
+In brief, the steps are:@refill
+
+@example
+@group
+C-u M-x texinfo-format-buffer
+M-x Info-tagify
+M-x Info-validate
+@end group
+@end example
+
+After you have validated the node structure, you can rerun
+@code{texinfo-format-buffer} in the normal way so it will construct a
+tag table and split the file automatically, or you can make the tag
+table and split the file manually.@refill
+
+@node Splitting, , Tagifying, Running Info-Validate
+@comment node-name, next, previous, up
+@appendixsubsec Splitting a File Manually
+@cindex Splitting an Info file manually
+@cindex Info file, splitting manually
+
+You should split a large file or else let the
+@code{texinfo-format-buffer} or @code{makeinfo-buffer} command do it
+for you automatically. (Generally you will let one of the formatting
+commands do this job for you. @xref{Create an Info File}.)@refill
+
+The split-off files are called the indirect subfiles.@refill
+
+Info files are split to save memory. With smaller files, Emacs does not
+have make such a large buffer to hold the information.@refill
+
+If an Info file has more than 30 nodes, you should also make a tag
+table for it. @xref{Using Info-validate}, for information
+about creating a tag table. (Again, tag tables are usually created
+automatically by the formatting command; you only need to create a tag
+table yourself if you are doing the job manually. Most likely, you
+will do this for a large, unsplit file on which you have run
+@code{Info-validate}.)@refill
+
+@c Info-split is autoloaded in `loaddefs.el' in Emacs 18.51
+@ignore
+Before running @code{Info-split}, you need to load the @code{info} library
+into Emacs by giving the command @kbd{M-x load-library @key{RET} info
+@key{RET}}.
+@end ignore
+
+Visit the Info file you wish to tagify and split and type the two
+commands:@refill
+
+@example
+M-x Info-tagify
+M-x Info-split
+@end example
+
+@noindent
+(Note that the @samp{I} in @samp{Info} is upper case.)@refill
+
+When you use the @code{Info-split} command, the buffer is modified into a
+(small) Info file which lists the indirect subfiles. This file should be
+saved in place of the original visited file. The indirect subfiles are
+written in the same directory the original file is in, with names generated
+by appending @samp{-} and a number to the original file name.@refill
+
+The primary file still functions as an Info file, but it contains just
+the tag table and a directory of subfiles.@refill
+
+@node Refilling Paragraphs, Command Syntax, Catching Mistakes, Top
+@comment node-name, next, previous, up
+@appendix Refilling Paragraphs
+@cindex Refilling paragraphs
+@cindex Filling paragraphs
+@findex refill
+
+The @code{@@refill} command refills and, optionally, indents the first
+line of a paragraph.@footnote{Perhaps the command should have been
+called the @code{@@refillandindent} command, but @code{@@refill} is
+shorter and the name was chosen before indenting was possible.} The
+@code{@@refill} command is no longer important, but we describe it here
+because you once needed it. You will see it in many old Texinfo
+files.@refill
+
+Without refilling, paragraphs containing long @@-constructs may look
+bad after formatting because the formatter removes @@-commands and
+shortens some lines more than others. In the past, neither the
+@code{texinfo-format-region} command nor the
+@code{texinfo-format-buffer} command refilled paragraphs
+automatically. The @code{@@refill} command had to be written at the
+end of every paragraph to cause these formatters to fill them. (Both
+@TeX{} and @code{makeinfo} have always refilled paragraphs
+automatically.) Now, all the Info formatters automatically fill and
+indent those paragraphs that need to be filled and indented.@refill
+
+The @code{@@refill} command causes @code{texinfo-format-region} and
+@code{texinfo-format-buffer} to refill a paragraph in the Info file
+@emph{after} all the other processing has been done. For this reason,
+you can not use @code{@@refill} with a paragraph containing either
+@code{@@*} or @code{@@w@{ @dots{} @}} since the refilling action will
+override those two commands.@refill
+
+The @code{texinfo-format-region} and @code{texinfo-format-buffer}
+commands now automatically append @code{@@refill} to the end of each
+paragraph that should be filled. They do not append @code{@@refill} to
+the ends of paragraphs that contain @code{@@*} or @w{@code{@@w@{ @dots{}@}}}
+and therefore do not refill or indent them.@refill
+
+@node Command Syntax, Obtaining TeX, Refilling Paragraphs, Top
+@comment node-name, next, previous, up
+@appendix @@-Command Syntax
+@cindex @@-command syntax
+
+The character @samp{@@} is used to start special Texinfo commands.
+(It has the same meaning that @samp{\} has in plain @TeX{}.) Texinfo
+has four types of @@-command:@refill
+
+@table @asis
+@item 1. Non-alphabetic commands.
+These commands consist of an @@ followed by a punctuation mark or other
+character that is not part of the alphabet. Non-alphabetic commands
+are almost always part of the text within a paragraph, and never take
+any argument. The two characters (@@ and the other one) are complete
+in themselves; none is followed by braces. The non-alphabetic
+commands are: @code{@@.}, @code{@@:}, @code{@@*}, @code{@@@@},
+@code{@@@{}, and @code{@@@}}.@refill
+
+@item 2. Alphabetic commands that do not require arguments.
+These commands start with @@ followed by a word followed by left- and
+right-hand braces. These commands insert special symbols in the
+document; they do not require arguments. For example,
+@code{@@dots@{@}} @result{} @samp{@dots{}}, @code{@@equiv@{@}}
+@result{} @samp{@equiv{}}, @code{@@TeX@{@}} @result{} `@TeX{}',
+and @code{@@bullet@{@}} @result{} @samp{@bullet{}}.@refill
+
+@item 3. Alphabetic commands that require arguments within braces.
+These commands start with @@ followed by a letter or a word, followed by an
+argument within braces. For example, the command @code{@@dfn} indicates
+the introductory or defining use of a term; it is used as follows: @samp{In
+Texinfo, @@@@-commands are @@dfn@{mark-up@} commands.}@refill
+
+@item 4. Alphabetic commands that occupy an entire line.
+These commands occupy an entire line. The line starts with @@,
+followed by the name of the command (a word); for example, @code{@@center}
+or @code{@@cindex}. If no argument is needed, the word is followed by
+the end of the line. If there is an argument, it is separated from
+the command name by a space. Braces are not used.@refill
+@end table
+
+@cindex Braces and argument syntax
+Thus, the alphabetic commands fall into classes that have
+different argument syntaxes. You cannot tell to which class a command
+belongs by the appearance of its name, but you can tell by the
+command's meaning: if the command stands for a glyph, it is in
+class 2 and does not require an argument; if it makes sense to use the
+command together with other text as part of a paragraph, the command
+is in class 3 and must be followed by an argument in braces;
+otherwise, it is in class 4 and uses the rest of the line as its
+argument.@refill
+
+The purpose of having a different syntax for commands of classes 3 and
+4 is to make Texinfo files easier to read, and also to help the GNU
+Emacs paragraph and filling commands work properly. There is only one
+exception to this rule: the command @code{@@refill}, which is always
+used at the end of a paragraph immediately following the final period
+or other punctuation character. @code{@@refill} takes no argument and
+does @emph{not} require braces. @code{@@refill} never confuses the
+Emacs paragraph commands because it cannot appear at the beginning of
+a line.@refill
+
+@node Obtaining TeX, New Features, Command Syntax, Top
+@appendix How to Obtain @TeX{}
+@cindex Obtaining @TeX{}
+@cindex @TeX{}, how to obtain
+
+@c !!! Here is information about obtaining TeX. Update it whenever.
+@c !!! Also consider updating TeX.README on prep.
+@c Updated by RJC on 1 March 1995, conversation with MacKay.
+@c Updated by kb@cs.umb.edu on 29 July 1996.
+@TeX{} is freely redistributable. You can obtain @TeX{} for Unix
+systems via anonymous ftp or on tape or CD-ROM. The core material
+consists of Karl Berry's Web2c @TeX{} distribution.
+
+On-line retrieval instructions are available from either:
+@example
+@url{ftp://ftp.tug.org/tex/unixtex.ftp}
+@url{http://www.tug.org/unixtex.ftp}
+@end example
+
+The Free Software Foundation provides a core distribution on its Source
+Code CD-ROM suitable for printing Texinfo manuals; the University of
+Washington maintains and supports a tape distribution; the @TeX{} Users
+Group co-sponsors a complete CD-ROM @TeX{} distribution.
+
+For the FSF Source Code CD-ROM, please contact:
+
+@iftex
+@display
+@group
+Free Software Foundation, Inc.
+59 Temple Place Suite 330
+Boston, MA w{ } 02111-1307
+USA
+
+Telephone: @w{@t{+}1--617--542--5942}
+Fax: (including Japan) @w{@t{+}1--617--542--2652}
+Free Dial Fax (in Japan):
+@w{ } @w{ } @w{ } 0031--13--2473 (KDD)
+@w{ } @w{ } @w{ } 0066--3382--0158 (IDC)
+Electronic mail: @code{gnu@@prep.ai.mit.edu}
+@end group
+@end display
+@end iftex
+@ifinfo
+@display
+@group
+Free Software Foundation, Inc.
+59 Temple Place Suite 330
+Boston, MA @w{ } 02111-1307
+USA
+
+Telephone: @w{@t{+}1-617-542-5942}
+Fax: (including Japan) @w{@t{+}1-617-542-2652}
+Free Dial Fax (in Japan):
+@w{ } @w{ } @w{ } 0031-13-2473 (KDD)
+@w{ } @w{ } @w{ } 0066-3382-0158 (IDC)
+Electronic mail: @code{gnu@@prep.ai.mit.edu}
+@end group
+@end display
+@end ifinfo
+
+To order a full distribution on CD-ROM, please see:
+@display
+@url{http://www.tug.org/tex-live.html}
+@end display
+
+@noindent
+(The distribution is also available by FTP; see the URL's above.)
+
+To order a full distribution from the University of Washington on either a
+1/4@dmn{in} 4-track QIC-24 cartridge or a 4@dmn{mm} DAT cartridge, send
+$210 to:
+
+@display
+@group
+Pierre A. MacKay
+Denny Hall, Mail Stop DH-10
+University of Washington
+Seattle, WA @w{ } 98195
+USA
+
+Telephone: @t{+}1--206--543--2268
+Electronic mail: @code{mackay@@cs.washington.edu}
+@end group
+@end display
+
+Please make checks payable to the University of Washington.
+Checks must be in U.S.@: dollars, drawn on a U.S.@: bank.
+
+Prepaid orders are the only orders that can now be handled. Overseas
+sites: please add to the base cost, if desired, $20.00 for shipment
+via air parcel post, or $30.00 for shipment via courier.
+
+Please check with the above for current prices and formats.
+
+
+@node New Features, Command and Variable Index, Obtaining TeX, Top
+@appendix Second Edition Features
+
+@tex
+% Widen the space for the first column so three control-character
+% strings fit in the first column. Switched back to default .8in
+% value at end of chapter.
+\global\tableindent=1.0in
+@end tex
+
+The second edition of the Texinfo manual describes more than 20 new
+Texinfo mode commands and more than 50 previously undocumented Texinfo
+@@-commands. This edition is more than twice the length of the first
+edition.@refill
+
+Here is a brief description of the new commands.@refill
+
+@menu
+* New Texinfo Mode Commands:: The updating commands are especially useful.
+* New Commands:: Many newly described @@-commands.
+@end menu
+
+@node New Texinfo Mode Commands, New Commands, New Features, New Features
+@appendixsec New Texinfo Mode Commands
+
+Texinfo mode provides commands and features especially designed for
+working with Texinfo files. More than 20 new commands have been
+added, including commands for automatically creating and updating
+both nodes and menus. This is a tedious task when done by hand.@refill
+
+The keybindings are intended to be somewhat mnemonic.@refill
+
+@subheading Update all nodes and menus
+
+The @code{texinfo-master-menu} command is the primary command:
+
+@table @kbd
+@item C-c C-u m
+@itemx M-x texinfo-master-menu
+Create or update a master menu.
+With @kbd{C-u} as a prefix argument,
+first create or update all nodes
+and regular menus.
+@end table
+
+@subheading Update Pointers
+
+@noindent
+Create or update `Next', `Previous', and `Up' node pointers.@refill
+
+@noindent
+@xref{Updating Nodes and Menus}.
+
+@table @kbd
+@item C-c C-u C-n
+@itemx M-x texinfo-update-node
+Update a node.
+
+@item C-c C-u C-e
+@itemx M-x texinfo-every-node-update
+Update every node in the buffer.
+@end table
+
+@subheading Update Menus
+
+@noindent
+Create or update menus.@refill
+
+@noindent
+@xref{Updating Nodes and Menus}.
+
+@table @kbd
+@item C-c C-u C-m
+@itemx M-x texinfo-make-menu
+Make or update a menu.
+
+@item C-c C-u C-a
+@itemx M-x texinfo-all-menus-update
+Make or update all the menus in a buffer.
+With @kbd{C-u} as a prefix argument,
+first update all the nodes.
+@end table
+
+@subheading Insert Title as Description
+
+@noindent
+Insert a node's chapter or section title in the space for the
+description in a menu entry line; position point so you can edit the
+insert. (This command works somewhat differently than the other
+insertion commands, which insert only a predefined string.)@refill
+
+@noindent
+@xref{Inserting, Inserting Frequently Used Commands}.
+
+@table @kbd
+@item C-c C-c C-d
+Insert title.
+@end table
+
+@subheading Format for Info
+
+@noindent
+Provide keybindings both for the Info formatting commands that are
+written in Emacs Lisp and for @code{makeinfo} that is written in
+C.@refill
+
+@noindent
+@xref{Info Formatting}.
+
+@noindent
+Use the Emacs lisp @code{texinfo-format@dots{}} commands:
+
+@table @kbd
+@item C-c C-e C-r
+Format the region.
+
+@item C-c C-e C-b
+Format the buffer.
+@end table
+
+@noindent
+Use @code{makeinfo}:
+
+@table @kbd
+@item C-c C-m C-r
+Format the region.
+
+@item C-c C-m C-b
+Format the buffer.
+
+@item C-c C-m C-l
+Recenter the @code{makeinfo} output buffer.
+
+@item C-c C-m C-k
+Kill the @code{makeinfo} formatting job.
+@end table
+
+@subheading Typeset and Print
+
+@noindent
+Typeset and print Texinfo documents from within Emacs.@refill
+
+@ifinfo
+@noindent
+@xref{Printing}.
+@end ifinfo
+@iftex
+@noindent
+@xref{Printing, , Formatting and Printing}.
+@end iftex
+
+@table @kbd
+@item C-c C-t C-b
+Run @code{texi2dvi} on the buffer.
+
+@item C-c C-t C-r
+Run @TeX{} on the region.
+
+@item C-c C-t C-i
+Run @code{texindex}.
+
+@item C-c C-t C-p
+Print the @sc{dvi} file.
+
+@item C-c C-t C-q
+Show the print queue.
+
+@item C-c C-t C-d
+Delete a job from the print queue.
+
+@item C-c C-t C-k
+Kill the current @TeX{} formatting job.
+
+@item C-c C-t C-x
+Quit a currently stopped @TeX{} formatting job.
+
+@item C-c C-t C-l
+Recenter the output buffer.
+@end table
+
+@subheading Other Updating Commands
+
+@noindent
+The ``other updating commands'' do not have standard keybindings because
+they are used less frequently.@refill
+
+@noindent
+@xref{Other Updating Commands}.
+
+@table @kbd
+@item M-x texinfo-insert-node-lines
+Insert missing @code{@@node} lines using
+section titles as node names.
+
+@item M-x texinfo-multiple-files-update
+Update a multi-file document.
+With a numeric prefix, such as @kbd{C-u 8},
+update @strong{every} pointer and
+menu in @strong{all} the files and
+then insert a master menu.
+
+@item M-x texinfo-indent-menu-description
+Indent descriptions in menus.
+
+@item M-x texinfo-sequential-node-update
+Insert node pointers in strict sequence.
+@end table
+
+@node New Commands, , New Texinfo Mode Commands, New Features
+@appendixsec New Texinfo @@-Commands
+
+The second edition of the Texinfo manual describes more than 50
+commands that were not described in the first edition. A third or so
+of these commands existed in Texinfo but were not documented in the
+manual; the others are new. Here is a listing, with brief
+descriptions of them:@refill
+
+@subheading Indexing
+
+@noindent
+Create your own index, and merge indices.@refill
+
+@noindent
+@xref{Indices}.
+
+@table @kbd
+@item @@defindex @var{index-name}
+Define a new index and its indexing command.
+See also the @code{@@defcodeindex} command.
+
+@c written verbosely to avoid overfull hbox
+@item @@synindex @var{from-index} @var{into-index}
+Merge the @var{from-index} index into the @var{into-index} index.
+See also the @code{@@syncodeindex} command.
+@end table
+
+@subheading Definitions
+
+@noindent
+Describe functions, variables, macros,
+commands, user options, special forms, and other such artifacts in a
+uniform format.@refill
+
+@noindent
+@xref{Definition Commands}.
+
+@table @kbd
+@item @@deffn @var{category} @var{name} @var{arguments}@dots{}
+Format a description for functions, interactive
+commands, and similar entities.
+
+@item @@defvr, @@defop, @dots{}
+15 other related commands.
+@end table
+
+@subheading Glyphs
+
+@noindent
+Indicate the results of evaluation, expansion,
+printed output, an error message, equivalence of expressions, and the
+location of point.@refill
+
+@noindent
+@xref{Glyphs}.
+
+@table @kbd
+@item @@equiv@{@}
+@itemx @equiv{}
+Equivalence:
+
+@item @@error@{@}
+@itemx @error{}
+Error message
+
+@item @@expansion@{@}
+@itemx @expansion{}
+Macro expansion
+
+@item @@point@{@}
+@itemx @point{}
+Position of point
+
+@item @@print@{@}
+@itemx @print{}
+Printed output
+
+@item @@result@{@}
+@itemx @result{}
+Result of an expression
+@end table
+
+@subheading Page Headings
+
+@noindent
+Customize page headings.
+
+@noindent
+@xref{Headings}.
+
+@table @kbd
+@item @@headings @var{on-off-single-double}
+Headings on or off, single, or double-sided.
+
+@item @@evenfooting [@var{left}] @@| [@var{center}] @@| [@var{right}]
+Footings for even-numbered (left-hand) pages.
+
+@item @@evenheading, @@everyheading, @@oddheading, @dots{}
+Five other related commands.
+
+@item @@thischapter
+Insert name of chapter and chapter number.
+
+@item @@thischaptername, @@thisfile, @@thistitle, @@thispage
+Related commands.
+@end table
+
+@subheading Formatting
+
+@noindent
+Format blocks of text.
+
+@noindent
+@xref{Quotations and Examples}, and@*
+@ref{Lists and Tables, , Making Lists and Tables}.
+
+@table @kbd
+@item @@cartouche
+Draw rounded box surrounding text (not in Info).
+
+@item @@enumerate @var{optional-arg}
+Enumerate a list with letters or numbers.
+
+@item @@exdent @var{line-of-text}
+Remove indentation.
+
+@item @@flushleft
+Left justify.
+
+@item @@flushright
+Right justify.
+
+@item @@format
+Do not narrow nor change font.
+
+@item @@ftable @var{formatting-command}
+@itemx @@vtable @var{formatting-command}
+Two-column table with indexing.
+
+@item @@lisp
+For an example of Lisp code.
+
+@item @@smallexample
+@itemx @@smalllisp
+Like @@table and @@lisp @r{but for} @@smallbook.
+@end table
+
+@subheading Conditionals
+
+@noindent
+Conditionally format text.
+
+@noindent
+@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill
+
+@table @kbd
+@item @@set @var{flag} [@var{string}]
+Set a flag. Optionally, set value
+of @var{flag} to @var{string}.
+
+@item @@clear @var{flag}
+Clear a flag.
+
+@item @@value@{@var{flag}@}
+Replace with value to which @var{flag} is set.
+
+@item @@ifset @var{flag}
+Format, if @var{flag} is set.
+
+@item @@ifclear @var{flag}
+Ignore, if @var{flag} is set.
+@end table
+
+@subheading @@heading series for Titles
+
+@noindent
+Produce unnumbered headings that do not appear in a table of contents.
+
+@noindent
+@xref{Structuring}.
+
+@table @kbd
+@item @@heading @var{title}
+Unnumbered section-like heading not listed
+in the table of contents of a printed manual.
+
+@item @@chapheading, @@majorheading, @@subheading, @@subsubheading
+Related commands.
+@end table
+
+@need 1000
+@subheading Font commands
+
+@need 1000
+@noindent
+@xref{Smallcaps}, and @*
+@ref{Fonts}.
+
+@table @kbd
+@item @@r@{@var{text}@}
+Print in roman font.
+
+@item @@sc@{@var{text}@}
+Print in @sc{small caps} font.
+@end table
+
+@subheading Miscellaneous
+
+@noindent
+See @ref{title subtitle author, , @code{@@title} @code{@@subtitle} and @code{@@author} Commands},@*
+see @ref{Customized Highlighting},@*
+see @ref{Overfull hboxes},@*
+see @ref{Footnotes},@*
+see @ref{dmn, , Format a Dimension},@*
+see @ref{Raise/lower sections, , @code{@@raisesections} and @code{@@lowersections}},@*
+see @ref{math, , @code{@@math}: Inserting Mathematical Expressions}.@*
+see @ref{minus, , Inserting a Minus Sign},@*
+see @ref{paragraphindent, , Paragraph Indenting},@*
+see @ref{Cross Reference Commands},@*
+see @ref{title subtitle author, , @code{@@title} @code{@@subtitle} and @code{@@author}}, and@*
+see @ref{Custom Headings, , How to Make Your Own Headings}.
+
+@table @kbd
+@item @@author @var{author}
+Typeset author's name.
+
+@ignore
+@item @@definfoenclose @var{new-command}, @var{before}, @var{after},
+Define a highlighting command for Info. (Info only.)
+@end ignore
+
+@item @@finalout
+Produce cleaner printed output.
+
+@item @@footnotestyle @var{end-or-separate}
+Specify footnote style.
+
+@item @@dmn@{@var{dimension}@}
+Format a dimension.
+
+@item @@global@@let@var{new-cmd}=@var{existing-cmd}
+Define a highlighting command for @TeX{}. (@TeX{} only.)
+
+@item @@lowersections
+Reduce hierarchical level of sectioning commands.
+
+@item @@math@{@var{mathematical-expression}@}
+Format a mathematical expression.
+
+@item @@minus@{@}
+Generate a minus sign.
+
+@item @@paragraphindent @var{asis-or-number}
+Specify paragraph indentation.
+
+@item @@raisesections
+Raise hierarchical level of sectioning commands.
+
+@item @@ref@{@var{node-name}, @r{[}@var{entry}@r{]}, @r{[}@var{topic-or-title}@r{]}, @r{[}@var{info-file}@r{]}, @r{[}@var{manual}@r{]}@}
+Make a reference. In the printed manual, the
+reference does not start with the word `see'.
+
+@item @@title @var{title}
+Typeset @var{title} in the alternative
+title page format.
+
+@item @@subtitle @var{subtitle}
+Typeset @var{subtitle} in the alternative
+title page format.
+
+@item @@today@{@}
+Insert the current date.
+@end table
+@tex
+% Switch width of first column of tables back to default value
+\global\tableindent=.8in
+@end tex
+
+
+@node Command and Variable Index, Concept Index, New Features, Top
+@comment node-name, next, previous, up
+@unnumbered Command and Variable Index
+
+This is an alphabetical list of all the @@-commands, assorted Emacs Lisp
+functions, and several variables. To make the list easier to use, the
+commands are listed without their preceding @samp{@@}.@refill
+
+@printindex fn
+
+
+@node Concept Index, , Command and Variable Index, Top
+@unnumbered Concept Index
+
+@printindex cp
+
+
+@summarycontents
+@contents
+@bye
diff --git a/texinfo/util/Makefile.in b/texinfo/util/Makefile.in
new file mode 100644
index 00000000000..9108632535f
--- /dev/null
+++ b/texinfo/util/Makefile.in
@@ -0,0 +1,105 @@
+# Makefile for GNU Texindex and other utilities.
+# $Id: Makefile.in,v 1.1 1997/08/21 22:58:12 jason Exp $
+#
+# Copyright (C) 1990, 91, 92, 96 Free Software Foundation, Inc.
+
+# This program 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.
+
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#### Start of system configuration section. ####
+
+srcdir = @srcdir@
+VPATH = $(srcdir):$(common)
+
+common = $(srcdir)/../libtxi
+
+EXEEXT = @EXEEXT@
+CC = @CC@
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+LN = ln
+RM = rm -f
+MKDIR = mkdir
+
+DEFS = @DEFS@
+LIBS = -L../libtxi -ltxi @LIBS@
+LOADLIBES = $(LIBS)
+
+SHELL = /bin/sh
+
+CFLAGS = @CFLAGS@
+LDFLAGS = @LDFLAGS@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+# Prefix for each installed program, normally empty or `g'.
+binprefix =
+# Prefix for each installed man page, normally empty or `g'.
+manprefix =
+mandir = @mandir@/man1
+manext = 1
+infodir = @infodir@
+
+#### End of system configuration section. ####
+
+all: texindex$(EXEEXT) install-info$(EXEEXT)
+sub-all: all
+
+.c.o:
+ $(CC) -c $(CPPFLAGS) $(DEFS) -I. -I$(srcdir) -I$(common) $(CFLAGS) $<
+
+
+install: all
+ $(INSTALL_PROGRAM) texindex$(EXEEXT) $(bindir)/texindex$(EXEEXT)
+ $(INSTALL_PROGRAM) $(srcdir)/texi2dvi $(bindir)/texi2dvi
+ $(INSTALL_PROGRAM) install-info$(EXEEXT) $(bindir)/install-info$(EXEEXT)
+
+install-info:
+dvi:
+
+uninstall:
+ rm -f $(bindir)/texindex$(EXEEXT) $(bindir)/texi2dvi $(bindir)/install-info$(EXEEXT)
+
+Makefile: Makefile.in ../config.status
+ cd ..; $(SHELL) config.status
+
+TAGS:
+ etags *.c *.h $(common)/getopt*.c $(common)/getopt.h
+
+clean:
+ rm -f *.o a.out core core.* texindex install-info
+
+mostlyclean: clean
+
+distclean: clean
+ rm -f Makefile config.status
+
+realclean: distclean
+ rm -f TAGS
+
+texindex: texindex.o ../libtxi/libtxi.a
+ $(CC) $(LDFLAGS) -o texindex texindex.o $(LOADLIBES)
+
+texindex.o: texindex.c $(common)/getopt.h
+
+install-info: install-info.o
+ $(CC) $(LDFLAGS) -o install-info install-info.o $(LOADLIBES)
+
+install-info.o: install-info.c $(common)/getopt.h
+
+# Prevent GNU make v3 from overflowing arg limit on SysV.
+.NOEXPORT:
diff --git a/texinfo/util/deref.c b/texinfo/util/deref.c
new file mode 100644
index 00000000000..c15bc1abcf1
--- /dev/null
+++ b/texinfo/util/deref.c
@@ -0,0 +1,238 @@
+/*
+ * deref.c
+
+ * compile command: gcc -g -o deref deref.c
+
+ * execute command: deref filename.texi > newfile.texi
+
+ * To: bob@gnu.ai.mit.edu
+ * Subject: another tool
+ * Date: 18 Dec 91 16:03:13 EST (Wed)
+ * From: gatech!skeeve!arnold@eddie.mit.edu (Arnold D. Robbins)
+ *
+ * Here is deref.c. It turns texinfo cross references back into the
+ * one argument form. It has the same limitations as fixref; one xref per
+ * line and can't cross lines. You can use it to find references that do
+ * cross a line boundary this way:
+ *
+ * deref < manual > /dev/null 2>errs
+ *
+ * (This assumes bash or /bin/sh.) The file errs will have list of lines
+ * where deref could not find matching braces.
+ *
+ * A gawk manual processed by deref goes through makeinfo without complaint.
+ * Compile with gcc and you should be set.
+ *
+ * Enjoy,
+ *
+ * Arnold
+ * -----------
+ */
+
+/*
+ * deref.c
+ *
+ * Make all texinfo references into the one argument form.
+ *
+ * Arnold Robbins
+ * arnold@skeeve.atl.ga.us
+ * December, 1991
+ *
+ * Copyright, 1991, Arnold Robbins
+ */
+
+/*
+ * LIMITATIONS:
+ * One texinfo cross reference per line.
+ * Cross references may not cross newlines.
+ * Use of fgets for input (to be fixed).
+ */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <errno.h>
+
+/* for gcc on the 3B1, delete if this gives you grief */
+extern int fclose (FILE * fp);
+extern int fprintf (FILE * fp, const char *str,...);
+
+extern char *strerror (int errno);
+extern char *strchr (char *cp, int ch);
+extern int strncmp (const char *s1, const char *s2, int count);
+
+extern int errno;
+
+void process (FILE * fp);
+void repair (char *line, char *ref, int toffset);
+
+int Errs = 0;
+char *Name = "stdin";
+int Line = 0;
+char *Me;
+
+/* main --- handle arguments, global vars for errors */
+
+int
+main (int argc, char **argv)
+{
+ FILE *fp;
+
+ Me = argv[0];
+
+ if (argc == 1)
+ process (stdin);
+ else
+ for (argc--, argv++; *argv != NULL; argc--, argv++)
+ {
+ if (argv[0][0] == '-' && argv[0][1] == '\0')
+ {
+ Name = "stdin";
+ Line = 0;
+ process (stdin);
+ }
+ else if ((fp = fopen (*argv, "r")) != NULL)
+ {
+ Name = *argv;
+ Line = 0;
+ process (fp);
+ fclose (fp);
+ }
+ else
+ {
+ fprintf (stderr, "%s: can not open: %s\n",
+ *argv, strerror (errno));
+ Errs++;
+ }
+ }
+ return Errs != 0;
+}
+
+/* isref --- decide if we've seen a texinfo cross reference */
+
+int
+isref (char *cp)
+{
+ if (strncmp (cp, "@ref{", 5) == 0)
+ return 5;
+ if (strncmp (cp, "@xref{", 6) == 0)
+ return 6;
+ if (strncmp (cp, "@pxref{", 7) == 0)
+ return 7;
+ return 0;
+}
+
+/* process --- read files, look for references, fix them up */
+
+void
+process (FILE * fp)
+{
+ char buf[BUFSIZ];
+ char *cp;
+ int count;
+
+ while (fgets (buf, sizeof buf, fp) != NULL)
+ {
+ Line++;
+ cp = strchr (buf, '@');
+ if (cp == NULL)
+ {
+ fputs (buf, stdout);
+ continue;
+ }
+ do
+ {
+ count = isref (cp);
+ if (count == 0)
+ {
+ cp++;
+ cp = strchr (cp, '@');
+ if (cp == NULL)
+ {
+ fputs (buf, stdout);
+ goto next;
+ }
+ continue;
+ }
+ /* got one */
+ repair (buf, cp, count);
+ break;
+ }
+ while (cp != NULL);
+ next:;
+ }
+}
+
+/* repair --- turn all texinfo cross references into the one argument form */
+
+void
+repair (char *line, char *ref, int toffset)
+{
+ int braces = 1; /* have seen first left brace */
+ char *cp;
+
+ ref += toffset;
+
+ /* output line up to and including left brace in reference */
+ for (cp = line; cp <= ref; cp++)
+ putchar (*cp);
+
+ /* output node name */
+ for (; *cp && *cp != '}' && *cp != ',' && *cp != '\n'; cp++)
+ putchar (*cp);
+
+ if (*cp != '}')
+ { /* could have been one arg xref */
+ /* skip to matching right brace */
+ for (; braces > 0; cp++)
+ {
+ switch (*cp)
+ {
+ case '@':
+ cp++; /* blindly skip next character */
+ break;
+ case '{':
+ braces++;
+ break;
+ case '}':
+ braces--;
+ break;
+ case '\n':
+ case '\0':
+ Errs++;
+ fprintf (stderr,
+ "%s: %s: %d: mismatched braces\n",
+ Me, Name, Line);
+ goto out;
+ default:
+ break;
+ }
+ }
+ out:
+ ;
+ }
+
+ putchar ('}');
+ if (*cp == '}')
+ cp++;
+
+ /* now the rest of the line */
+ for (; *cp; cp++)
+ putchar (*cp);
+ return;
+}
+
+/* strerror --- return error string, delete if in your library */
+
+char *
+strerror (int errno)
+{
+ static char buf[100];
+ extern int sys_nerr;
+ extern char *sys_errlist[];
+
+ if (errno < sys_nerr && errno >= 0)
+ return sys_errlist[errno];
+
+ sprintf (buf, "unknown error %d", errno);
+ return buf;
+}
diff --git a/texinfo/util/fixfonts b/texinfo/util/fixfonts
new file mode 100755
index 00000000000..ee2ea719219
--- /dev/null
+++ b/texinfo/util/fixfonts
@@ -0,0 +1,84 @@
+#!/bin/sh
+# Make links named `lcircle10' for all TFM and GF/PK files, if no
+# lcircle10 files already exist.
+
+# Don't override definition of prefix and/or libdir if they are
+# already defined in the environment.
+if test "z${prefix}" = "z" ; then
+ prefix=/usr/local
+else
+ # prefix may contain references to other variables, thanks to make.
+ eval prefix=\""${prefix}"\"
+fi
+
+if test "z${libdir}" = "z" ; then
+ libdir="${prefix}/lib/tex"
+else
+ # libdir may contain references to other variables, thanks to make.
+ eval libdir=\""${libdir}"\"
+fi
+
+texlibdir="${libdir}"
+texfontdir="${texlibdir}/fonts"
+
+# Directories for the different font formats, in case they're not all
+# stored in one place.
+textfmdir="${textfmdir-${texfontdir}}"
+texpkdir="${texpkdir-${texfontdir}}"
+texgfdir="${texgfdir-${texfontdir}}"
+
+test "z${TMPDIR}" = "z" && TMPDIR="/tmp"
+
+tempfile="${TMPDIR}/circ$$"
+tempfile2="${TMPDIR}/circ2$$"
+
+# EXIT SIGHUP SIGINT SIGQUIT SIGTERM
+#trap 'rm -f "${tempfile}" "${tempfile2}"' 0 1 2 3 15
+
+# Find all the fonts with names that include `circle'.
+(cd "${texfontdir}"; find . -name '*circle*' -print > "${tempfile}")
+
+# If they have lcircle10.tfm, assume everything is there, and quit.
+if grep 'lcircle10\.tfm' "${tempfile}" > /dev/null 2>&1 ; then
+ echo "Found lcircle10.tfm."
+ exit 0
+fi
+
+# No TFM file for lcircle. Make a link to circle10.tfm if it exists,
+# and then make a link to the bitmap files.
+grep 'circle10\.tfm' "${tempfile}" > "${tempfile2}" \
+ || {
+ echo "I can't find any circle fonts in ${texfontdir}.
+If it isn't installed somewhere else, you need to get the Metafont sources
+from somewhere, e.g., labrea.stanford.edu:pub/tex/latex/circle10.mf, and
+run Metafont on them."
+ exit 1
+ }
+
+# We have circle10.tfm. (If we have it more than once, take the first
+# one.) Make the link.
+tempfile2_line1="`sed -ne '1p;q' \"${tempfile2}\"`"
+ln "${tempfile2_line1}" "${textfmdir}/lcircle10.tfm"
+echo "Linked to ${tempfile2_line1}."
+
+# Now make a link for the PK files, if any.
+(cd "${texpkdir}"
+ for f in `grep 'circle10.*pk' "${tempfile}"` ; do
+ set - `echo "$f" \
+ | sed -ne '/\//!s/^/.\//;s/\(.*\)\/\([^\/][^\/]*\)$/\1 \2/;p'`
+ ln "$f" "${1}/l${2}"
+ echo "Linked to $f."
+ done
+)
+
+# And finally for the GF files.
+(cd "${texgfdir}"
+ for f in `grep 'circle10.*gf' "${tempfile}"` ; do
+ set - `echo "$f" \
+ | sed -ne '/\//!s/^/.\//;s/\(.*\)\/\([^\/][^\/]*\)$/\1 \2/;p'`
+ ln "$f" "${1}/l${2}"
+ echo "Linked to $f."
+ done
+)
+
+# eof
diff --git a/texinfo/util/gen-dir-node b/texinfo/util/gen-dir-node
new file mode 100755
index 00000000000..ed825043db6
--- /dev/null
+++ b/texinfo/util/gen-dir-node
@@ -0,0 +1,176 @@
+#!/bin/sh
+# $Id: gen-dir-node,v 1.1 1997/08/21 22:58:12 jason Exp $
+# Generate the top-level Info node, given a directory of Info files
+# and (optionally) a skeleton file. The output will be suitable for a
+# top-level dir file. The skeleton file contains info topic names in the
+# order they should appear in the output. There are three special
+# lines that alter the behavior: a line consisting of just "--" causes
+# the next line to be echoed verbatim to the output. A line
+# containing just "%%" causes all the remaining filenames (wildcards
+# allowed) in the rest of the file to be ignored. A line containing
+# just "!!" exits the script when reached (unless preceded by a line
+# containing just "--"). Once the script reaches the end of the
+# skeleton file, it goes through the remaining files in the directory
+# in order, putting their entries at the end. The script will use the
+# ENTRY information in each info file if it exists. Otherwise it will
+# make a minimal entry.
+
+# sent by Jeffrey Osier <jeffrey@cygnus.com>, who thinks it came from
+# zoo@winternet.com (david d `zoo' zuhn)
+
+# modified 7 April 1995 by Joe Harrington <jh@tecate.gsfc.nasa.gov> to
+# take special flags
+
+INFODIR=$1
+if [ $# = 2 ] ; then
+ SKELETON=$2
+else
+ SKELETON=/dev/null
+fi
+
+skip=
+
+if [ $# -gt 2 ] ; then
+ echo usage: $0 info-directory [ skeleton-file ] 1>&2
+ exit 1
+else
+ true
+fi
+
+if [ ! -d ${INFODIR} ] ; then
+ echo "$0: first argument must specify a directory"
+ exit 1
+fi
+
+### output the dir header
+echo "-*- Text -*-"
+echo "This file was generated automatically by $0."
+echo "This version was generated on `date`"
+echo "by `whoami`@`hostname` for `(cd ${INFODIR}; pwd)`"
+
+cat << moobler
+
+This is the file .../info/dir, which contains the topmost node of the
+Info hierarchy. The first time you invoke Info you start off
+looking at that node, which is (dir)Top.
+
+File: dir Node: Top This is the top of the INFO tree
+ This (the Directory node) gives a menu of major topics.
+ Typing "d" returns here, "q" exits, "?" lists all INFO commands, "h"
+ gives a primer for first-timers, "mTexinfo<Return>" visits Texinfo topic,
+ etc.
+ Or click mouse button 2 on a menu item or cross reference to select it.
+ --- PLEASE ADD DOCUMENTATION TO THIS TREE. (See INFO topic first.) ---
+
+* Menu: The list of major topics begins on the next line.
+
+moobler
+
+### go through the list of files in the skeleton. If an info file
+### exists, grab the ENTRY information from it. If an entry exists
+### use it, otherwise create a minimal dir entry.
+###
+### Then remove that file from the list of existing files. If any
+### additional files remain (ones that don't have a skeleton entry),
+### then generate entries for those in the same way, putting the info for
+### those at the end....
+
+infofiles=`(cd ${INFODIR}; ls | egrep -v '\-|^dir$|^dir\.info$|^dir\.orig$')`
+
+# echoing gets clobbered by backquotes; we do it the hard way...
+lines=`wc $SKELETON | awk '{print $1}'`
+line=1
+while [ $lines -ge $line ] ; do
+ # Read one line from the file. This is so that we can echo lines with
+ # whitespace and quoted characters in them.
+ fileline=`awk NR==$line $SKELETON`
+
+ # flag fancy features
+ if [ ! -z "$echoline" ] ; then # echo line
+ echo "$fileline"
+ fileline=
+ echoline=
+ elif [ "${fileline}" = "--" ] ; then # should we echo the next line?
+ echoline=1
+ elif [ "${fileline}" = "%%" ] ; then # eliminate remaining files from dir?
+ skip=1
+ elif [ "${fileline}" = "!!" ] ; then # quit now
+ exit 0
+ fi
+
+ # handle files if they exist
+ for file in $fileline"" ; do # expand wildcards ("" handles blank lines)
+
+ fname=
+
+ if [ -z "$echoline" -a ! -z "$file" ] ; then
+
+ # Find the file to operate upon. Check both possible names.
+ infoname=`echo $file | sed 's/\.info$//'`
+ noext=
+ ext=
+ if [ -f ${INFODIR}/$infoname ] ; then
+ noext=$infoname
+ fi
+ if [ -f ${INFODIR}/${infoname}.info ] ; then
+ ext=${infoname}.info
+ fi
+
+ # If it exists with both names take what was said in the file.
+ if [ ! -z "$ext" -a ! -z "$noext" ]; then
+ fname=$file
+ warn="### Warning: $ext and $noext both exist! Using ${file}. ###"
+ elif [ ! \( -z "$ext" -a -z "$noext" \) ]; then
+ # just take the name if it exists only once
+ fname=${noext}${ext}
+ fi
+
+ # if we found something and aren't skipping, do the entry
+ if [ ! -z "$fname" ] ; then
+ if [ -z "$skip" ] ; then
+
+ if [ ! -z "$warn" ] ; then # issue any warning
+ echo $warn
+ warn=
+ fi
+
+ entry=`sed -e '1,/START-INFO-DIR-ENTRY/d' \
+ -e '/END-INFO-DIR-ENTRY/,$d' ${INFODIR}/$fname`
+ if [ ! -z "${entry}" ] ; then
+ echo "${entry}"
+ else
+ echo "* ${infoname}: (${fname})."
+ fi
+ fi
+
+ # remove the name from the directory listing
+ infofiles=`echo ${infofiles} | sed -e "s/ ${fname} / /" \
+ -e "s/^${fname} //" \
+ -e "s/ ${fname}$//"`
+
+ fi
+
+ fi
+
+ done
+
+ line=`expr $line + 1`
+done
+
+if [ -z "${infofiles}" ] ; then
+ exit 0
+else
+ echo
+fi
+
+for file in ${infofiles}; do
+ infoname=`echo $file | sed 's/\.info$//'`
+ entry=`sed -e '1,/START-INFO-DIR-ENTRY/d' \
+ -e '/END-INFO-DIR-ENTRY/,$d' ${INFODIR}/${file}`
+
+ if [ ! -z "${entry}" ] ; then
+ echo "${entry}"
+ else
+ echo "* ${infoname}: (${file})."
+ fi
+done
diff --git a/texinfo/util/install-info.c b/texinfo/util/install-info.c
new file mode 100644
index 00000000000..53fa4aa1116
--- /dev/null
+++ b/texinfo/util/install-info.c
@@ -0,0 +1,1111 @@
+/* install-info -- create Info directory entry(ies) for an Info file.
+ Copyright (C) 1996 Free Software Foundation, Inc.
+
+$Id: install-info.c,v 1.12 1996/10/03 23:13:36 karl Exp $
+
+This program 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 of the License, or
+(at your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+#define INSTALL_INFO_VERSION_STRING "GNU install-info (Texinfo 3.9) 1.2"
+
+#include <stdio.h>
+#include <errno.h>
+#include <getopt.h>
+#include <sys/types.h>
+
+/* Get O_RDONLY. */
+#ifdef HAVE_SYS_FCNTL_H
+#include <sys/fcntl.h>
+#else
+#include <fcntl.h>
+#endif /* !HAVE_SYS_FCNTL_H */
+#ifdef HAVE_SYS_FILE_H
+#include <sys/file.h>
+#endif
+
+/* Name this program was invoked with. */
+char *progname;
+
+char *readfile ();
+struct line_data *findlines ();
+char *my_strerror ();
+void fatal ();
+void insert_entry_here ();
+int compare_section_names ();
+
+struct spec_entry;
+
+/* Data structures. */
+
+/* Record info about a single line from a file
+ as read into core. */
+
+struct line_data
+{
+ /* The start of the line. */
+ char *start;
+ /* The number of characters in the line,
+ excluding the terminating newline. */
+ int size;
+ /* Vector containing pointers to the entries to add before this line.
+ The vector is null-terminated. */
+ struct spec_entry **add_entries_before;
+ /* 1 means output any needed new sections before this line. */
+ int add_sections_before;
+ /* 1 means don't output this line. */
+ int delete;
+};
+
+/* This is used for a list of the specified menu section names
+ in which entries should be added. */
+
+struct spec_section
+{
+ struct spec_section *next;
+ char *name;
+ /* 1 means we have not yet found an existing section with this name
+ in the dir file--so we will need to add a new section. */
+ int missing;
+};
+
+/* This is used for a list of the entries specified to be added. */
+
+struct spec_entry
+{
+ struct spec_entry *next;
+ char *text;
+};
+
+/* This is used for a list of nodes found by parsing the dir file. */
+
+struct node
+{
+ struct node *next;
+ /* The node name. */
+ char *name;
+ /* The line number of the line where the node starts.
+ This is the line that contains control-underscore. */
+ int start_line;
+ /* The line number of the line where the node ends,
+ which is the end of the file or where the next line starts. */
+ int end_line;
+ /* Start of first line in this node's menu
+ (the line after the * Menu: line). */
+ char *menu_start;
+ /* The start of the chain of sections in this node's menu. */
+ struct menu_section *sections;
+ /* The last menu section in the chain. */
+ struct menu_section *last_section;
+};
+
+/* This is used for a list of sections found in a node's menu.
+ Each struct node has such a list in the sections field. */
+
+struct menu_section
+{
+ struct menu_section *next;
+ char *name;
+ /* Line number of start of section. */
+ int start_line;
+ /* Line number of end of section. */
+ int end_line;
+};
+
+/* Memory allocation and string operations. */
+
+/* Like malloc but get fatal error if memory is exhausted. */
+
+void *
+xmalloc (size)
+ unsigned int size;
+{
+ extern void *malloc ();
+ void *result = malloc (size);
+ if (result == NULL)
+ fatal ("virtual memory exhausted", 0);
+ return result;
+}
+
+/* Like malloc but get fatal error if memory is exhausted. */
+
+void *
+xrealloc (obj, size)
+ void *obj;
+ unsigned int size;
+{
+ extern void *realloc ();
+ void *result = realloc (obj, size);
+ if (result == NULL)
+ fatal ("virtual memory exhausted", 0);
+ return result;
+}
+
+/* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */
+
+char *
+concat (s1, s2, s3)
+ char *s1, *s2, *s3;
+{
+ int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3);
+ char *result = (char *) xmalloc (len1 + len2 + len3 + 1);
+
+ strcpy (result, s1);
+ strcpy (result + len1, s2);
+ strcpy (result + len1 + len2, s3);
+ *(result + len1 + len2 + len3) = 0;
+
+ return result;
+}
+
+/* Return a string containing SIZE characters
+ copied from starting at STRING. */
+
+char *
+copy_string (string, size)
+ char *string;
+ int size;
+{
+ int i;
+ char *copy = (char *) xmalloc (size + 1);
+ for (i = 0; i < size; i++)
+ copy[i] = string[i];
+ copy[size] = 0;
+ return copy;
+}
+
+/* Error message functions. */
+
+/* Print error message. `s1' is printf control string, `s2' is arg for it. */
+
+/* VARARGS1 */
+void
+error (s1, s2, s3)
+ char *s1, *s2, *s3;
+{
+ fprintf (stderr, "%s: ", progname);
+ fprintf (stderr, s1, s2, s3);
+ fprintf (stderr, "\n");
+}
+
+/* VARARGS1 */
+void
+warning (s1, s2, s3)
+ char *s1, *s2, *s3;
+{
+ fprintf (stderr, "%s: Warning: ", progname);
+ fprintf (stderr, s1, s2, s3);
+ fprintf (stderr, "\n");
+}
+
+/* Print error message and exit. */
+
+void
+fatal (s1, s2, s3)
+ char *s1, *s2, *s3;
+{
+ error (s1, s2, s3);
+ exit (1);
+}
+
+/* Print fatal error message based on errno, with file name NAME. */
+
+void
+pfatal_with_name (name)
+ char *name;
+{
+ char *s = concat ("", my_strerror (errno), " for %s");
+ fatal (s, name);
+}
+
+/* Given the full text of a menu entry, null terminated,
+ return just the menu item name (copied). */
+
+char *
+extract_menu_item_name (item_text)
+ char *item_text;
+{
+ char *p;
+
+ if (*item_text == '*')
+ item_text++;
+ while (*item_text == ' ')
+ item_text++;
+
+ p = item_text;
+ while (*p && *p != ':') p++;
+ return copy_string (item_text, p - item_text);
+}
+
+/* Given the full text of a menu entry, terminated by null or newline,
+ return just the menu item file (copied). */
+
+char *
+extract_menu_file_name (item_text)
+ char *item_text;
+{
+ char *p = item_text;
+
+ /* If we have text that looks like * ITEM: (FILE)NODE...,
+ extract just FILE. Otherwise return "(none)". */
+
+ if (*p == '*')
+ p++;
+ while (*p == ' ')
+ p++;
+
+ /* Skip to and past the colon. */
+ while (*p && *p != '\n' && *p != ':') p++;
+ if (*p == ':') p++;
+
+ /* Skip past the open-paren. */
+ while (1)
+ {
+ if (*p == '(')
+ break;
+ else if (*p == ' ' || *p == '\t')
+ p++;
+ else
+ return "(none)";
+ }
+ p++;
+
+ item_text = p;
+
+ /* File name ends just before the close-paren. */
+ while (*p && *p != '\n' && *p != ')') p++;
+ if (*p != ')')
+ return "(none)";
+
+ return copy_string (item_text, p - item_text);
+}
+
+void
+suggest_asking_for_help ()
+{
+ fprintf (stderr, "\tTry `%s --help' for a complete list of options.\n",
+ progname);
+ exit (1);
+}
+
+void
+print_help ()
+{
+ printf ("%s [OPTION]... [INFO-FILE [DIR-FILE]]\n\
+ Install INFO-FILE in the Info directory file DIR-FILE.\n\
+\n\
+Options:\n\
+--delete Delete existing entries in INFO-FILE;\n\
+ don't insert any new entries.\n\
+--dir-file=NAME Specify file name of Info directory file.\n\
+ This is equivalent to using the DIR-FILE argument.\n\
+--entry=TEXT Insert TEXT as an Info directory entry.\n\
+ TEXT should have the form of an Info menu item line\n\
+ plus zero or more extra lines starting with whitespace.\n\
+ If you specify more than one entry, they are all added.\n\
+ If you don't specify any entries, they are determined\n\
+ from information in the Info file itself.\n\
+--help Display this help and exit.\n\
+--info-file=FILE Specify Info file to install in the directory.\n\
+ This is equivalent to using the INFO-FILE argument.\n\
+--info-dir=DIR Same as --dir-file=DIR/dir.\n\
+--item=TEXT Same as --entry TEXT.\n\
+ An Info directory entry is actually a menu item.\n\
+--quiet Suppress warnings.\n\
+--remove Same as --delete.\n\
+--section=SEC Put this file's entries in section SEC of the directory.\n\
+ If you specify more than one section, all the entries\n\
+ are added in each of the sections.\n\
+ If you don't specify any sections, they are determined\n\
+ from information in the Info file itself.\n\
+--version Display version information and exit.\n\
+\n\
+Email bug reports to bug-texinfo@prep.ai.mit.edu.\n\
+", progname);
+}
+
+/* Convert an errno value into a string describing the error.
+ We define this function here rather than using strerror
+ because not all systems have strerror. */
+
+char *
+my_strerror (errnum)
+ int errnum;
+{
+ extern char *sys_errlist[];
+ extern int sys_nerr;
+
+ if (errnum >= 0 && errnum < sys_nerr)
+ return sys_errlist[errnum];
+ return (char *) "Unknown error";
+}
+
+/* This table defines all the long-named options, says whether they
+ use an argument, and maps them into equivalent single-letter options. */
+
+struct option longopts[] =
+{
+ { "delete", no_argument, NULL, 'r' },
+ { "dir-file", required_argument, NULL, 'd' },
+ { "entry", required_argument, NULL, 'e' },
+ { "help", no_argument, NULL, 'h' },
+ { "info-dir", required_argument, NULL, 'D' },
+ { "info-file", required_argument, NULL, 'i' },
+ { "item", required_argument, NULL, 'e' },
+ { "quiet", no_argument, NULL, 'q' },
+ { "remove", no_argument, NULL, 'r' },
+ { "section", required_argument, NULL, 's' },
+ { "version", no_argument, NULL, 'V' },
+ { 0 }
+};
+
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ char *infile = 0, *dirfile = 0;
+ char *infile_sans_info;
+ unsigned infilelen_sans_info;
+ FILE *output;
+
+ /* Record the text of the Info file, as a sequence of characters
+ and as a sequence of lines. */
+ char *input_data;
+ int input_size;
+ struct line_data *input_lines;
+ int input_nlines;
+
+ /* Record here the specified section names and directory entries. */
+ struct spec_section *input_sections = NULL;
+ struct spec_entry *entries_to_add = NULL;
+ int n_entries_to_add = 0;
+
+ /* Record the old text of the dir file, as plain characters,
+ as lines, and as nodes. */
+ char *dir_data;
+ int dir_size;
+ int dir_nlines;
+ struct line_data *dir_lines;
+ struct node *dir_nodes;
+
+ /* Nonzero means --delete was specified (just delete existing entries). */
+ int delete_flag = 0;
+ int something_deleted = 0;
+ /* Nonzero means -q was specified. */
+ int quiet_flag = 0;
+
+ int node_header_flag;
+ int prefix_length;
+ int i;
+
+ progname = argv[0];
+
+ while (1)
+ {
+ int opt = getopt_long (argc, argv, "i:d:e:s:hHr", longopts, 0);
+
+ if (opt == EOF)
+ break;
+
+ switch (opt)
+ {
+ case 0:
+ /* If getopt returns 0, then it has already processed a
+ long-named option. We should do nothing. */
+ break;
+
+ case 1:
+ abort ();
+
+ case 'd':
+ if (dirfile)
+ {
+ fprintf (stderr, "%s: Specify the Info directory only once.\n",
+ progname);
+ suggest_asking_for_help ();
+ }
+ dirfile = optarg;
+ break;
+
+ case 'D':
+ if (dirfile)
+ {
+ fprintf (stderr, "%s: Specify the Info directory only once.\n",
+ progname);
+ suggest_asking_for_help ();
+ }
+ dirfile = concat (optarg, "", "/dir");
+ break;
+
+ case 'e':
+ {
+ struct spec_entry *next
+ = (struct spec_entry *) xmalloc (sizeof (struct spec_entry));
+ if (! (*optarg != 0 && optarg[strlen (optarg) - 1] == '\n'))
+ optarg = concat (optarg, "\n", "");
+ next->text = optarg;
+ next->next = entries_to_add;
+ entries_to_add = next;
+ n_entries_to_add++;
+ }
+ break;
+
+ case 'h':
+ case 'H':
+ print_help ();
+ exit (0);
+
+ case 'i':
+ if (infile)
+ {
+ fprintf (stderr, "%s: Specify the Info file only once.\n",
+ progname);
+ suggest_asking_for_help ();
+ }
+ infile = optarg;
+ break;
+
+ case 'q':
+ quiet_flag = 1;
+ break;
+
+ case 'r':
+ delete_flag = 1;
+ break;
+
+ case 's':
+ {
+ struct spec_section *next
+ = (struct spec_section *) xmalloc (sizeof (struct spec_section));
+ next->name = optarg;
+ next->next = input_sections;
+ next->missing = 1;
+ input_sections = next;
+ }
+ break;
+
+ case 'V':
+ puts (INSTALL_INFO_VERSION_STRING);
+puts ("Copyright (C) 1996 Free Software Foundation, Inc.\n\
+There is NO warranty. You may redistribute this software\n\
+under the terms of the GNU General Public License.\n\
+For more information about these matters, see the files named COPYING.");
+ exit (0);
+
+ default:
+ suggest_asking_for_help ();
+ }
+ }
+
+ /* Interpret the non-option arguments as file names. */
+ for (; optind < argc; ++optind)
+ {
+ if (infile == 0)
+ infile = argv[optind];
+ else if (dirfile == 0)
+ dirfile = argv[optind];
+ else
+ error ("excess command line argument `%s'", argv[optind]);
+ }
+
+ if (!infile)
+ fatal ("No input file specified");
+ if (!dirfile)
+ fatal ("No dir file specified");
+
+ /* Read the Info file and parse it into lines. */
+
+ input_data = readfile (infile, &input_size);
+ input_lines = findlines (input_data, input_size, &input_nlines);
+
+ /* Parse the input file to find the section names it specifies. */
+
+ if (input_sections == 0)
+ {
+ prefix_length = strlen ("INFO-DIR-SECTION ");
+ for (i = 0; i < input_nlines; i++)
+ {
+ if (!strncmp ("INFO-DIR-SECTION ", input_lines[i].start,
+ prefix_length))
+ {
+ struct spec_section *next
+ = (struct spec_section *) xmalloc (sizeof (struct spec_section));
+ next->name = copy_string (input_lines[i].start + prefix_length,
+ input_lines[i].size - prefix_length);
+ next->next = input_sections;
+ next->missing = 1;
+ input_sections = next;
+ }
+ }
+ }
+
+ /* Default to section "Miscellaneous" if no sections specified. */
+ if (input_sections == 0)
+ {
+ input_sections
+ = (struct spec_section *) xmalloc (sizeof (struct spec_section));
+ input_sections->name = "Miscellaneous";
+ input_sections->next = 0;
+ input_sections->missing = 1;
+ }
+
+ /* Now find the directory entries specified in the file
+ and put them on entries_to_add. But not if entries
+ were specified explicitly with command options. */
+
+ if (entries_to_add == 0)
+ {
+ char *start_of_this_entry = 0;
+ for (i = 0; i < input_nlines; i++)
+ {
+ if (!strncmp ("START-INFO-DIR-ENTRY", input_lines[i].start,
+ input_lines[i].size)
+ && sizeof ("START-INFO-DIR-ENTRY") - 1 == input_lines[i].size)
+ {
+ if (start_of_this_entry != 0)
+ fatal ("START-INFO-DIR-ENTRY without matching END-INFO-DIR-ENTRY");
+ start_of_this_entry = input_lines[i + 1].start;
+ }
+ if (!strncmp ("END-INFO-DIR-ENTRY", input_lines[i].start,
+ input_lines[i].size)
+ && sizeof ("END-INFO-DIR-ENTRY") - 1 == input_lines[i].size)
+ {
+ if (start_of_this_entry != 0)
+ {
+ struct spec_entry *next
+ = (struct spec_entry *) xmalloc (sizeof (struct spec_entry));
+ next->text = copy_string (start_of_this_entry,
+ input_lines[i].start - start_of_this_entry);
+ next->next = entries_to_add;
+ entries_to_add = next;
+ n_entries_to_add++;
+ start_of_this_entry = 0;
+ }
+ else
+ fatal ("END-INFO-DIR-ENTRY without matching START-INFO-DIR-ENTRY");
+ }
+ }
+ if (start_of_this_entry != 0)
+ fatal ("START-INFO-DIR-ENTRY without matching END-INFO-DIR-ENTRY");
+ }
+
+ if (!delete_flag)
+ if (entries_to_add == 0)
+ fatal ("no info dir entry in `%s'", infile);
+
+ /* Now read in the Info dir file. */
+ dir_data = readfile (dirfile, &dir_size);
+ dir_lines = findlines (dir_data, dir_size, &dir_nlines);
+
+ /* We will be comparing the entries in the dir file against the
+ current filename, so need to strip off any directory prefix and any
+ .info suffix. */
+ {
+ unsigned basename_len;
+ extern char *strrchr ();
+ char *infile_basename = strrchr (infile, '/');
+ if (infile_basename)
+ infile_basename++;
+ else
+ infile_basename = infile;
+
+ basename_len = strlen (infile_basename);
+ infile_sans_info
+ = (strlen (infile_basename) > 5
+ && strcmp (infile_basename + basename_len - 5, ".info") == 0)
+ ? copy_string (infile_basename, basename_len - 5)
+ : infile_basename;
+
+ infilelen_sans_info = strlen (infile_sans_info);
+ }
+
+ /* Parse the dir file. Find all the nodes, and their menus,
+ and the sections of their menus. */
+
+ dir_nodes = 0;
+ node_header_flag = 0;
+ for (i = 0; i < dir_nlines; i++)
+ {
+ /* Parse node header lines. */
+ if (node_header_flag)
+ {
+ int j, end;
+ for (j = 0; j < dir_lines[i].size; j++)
+ /* Find the node name and store it in the `struct node'. */
+ if (!strncmp ("Node:", dir_lines[i].start + j, 5))
+ {
+ char *line = dir_lines[i].start;
+ /* Find the start of the node name. */
+ j += 5;
+ while (line[j] == ' ' || line[j] == '\t')
+ j++;
+ /* Find the end of the node name. */
+ end = j;
+ while (line[end] != 0 && line[end] != ',' && line[end] != '\n'
+ && line[end] != '\t')
+ end++;
+ dir_nodes->name = copy_string (line + j, end - j);
+ }
+ node_header_flag = 0;
+ }
+
+ /* Notice the start of a node. */
+ if (*dir_lines[i].start == 037)
+ {
+ struct node *next
+ = (struct node *) xmalloc (sizeof (struct node));
+ next->next = dir_nodes;
+ next->name = NULL;
+ next->start_line = i;
+ next->end_line = 0;
+ next->menu_start = NULL;
+ next->sections = NULL;
+ next->last_section = NULL;
+
+ if (dir_nodes != 0)
+ dir_nodes->end_line = i;
+ /* Fill in the end of the last menu section
+ of the previous node. */
+ if (dir_nodes != 0 && dir_nodes->last_section != 0)
+ dir_nodes->last_section->end_line = i;
+
+ dir_nodes = next;
+
+ /* The following line is the header of this node;
+ parse it. */
+ node_header_flag = 1;
+ }
+
+ /* Notice the lines that start menus. */
+ if (dir_nodes != 0
+ && !strncmp ("* Menu:", dir_lines[i].start, 7))
+ dir_nodes->menu_start = dir_lines[i + 1].start;
+
+ /* Notice sections in menus. */
+ if (dir_nodes != 0
+ && dir_nodes->menu_start != 0
+ && *dir_lines[i].start != '\n'
+ && *dir_lines[i].start != '*'
+ && *dir_lines[i].start != ' '
+ && *dir_lines[i].start != '\t')
+ {
+ /* Add this menu section to the node's list.
+ This list grows in forward order. */
+ struct menu_section *next
+ = (struct menu_section *) xmalloc (sizeof (struct menu_section));
+ next->start_line = i + 1;
+ next->next = 0;
+ next->end_line = 0;
+ next->name = copy_string (dir_lines[i].start, dir_lines[i].size);
+ if (dir_nodes->sections)
+ {
+ dir_nodes->last_section->next = next;
+ dir_nodes->last_section->end_line = i;
+ }
+ else
+ dir_nodes->sections = next;
+ dir_nodes->last_section = next;
+ }
+
+ /* Check for an existing entry that should be deleted.
+ Delete all entries which specify this file name. */
+ if (*dir_lines[i].start == '*')
+ {
+ char *p = dir_lines[i].start;
+
+ while (*p != 0 && *p != ':')
+ p++;
+ p++;
+ while (*p == ' ') p++;
+ if (*p == '(')
+ {
+ p++;
+ if ((dir_lines[i].size
+ > (p - dir_lines[i].start + infilelen_sans_info))
+ && !strncmp (p, infile_sans_info, infilelen_sans_info)
+ && p[infilelen_sans_info] == ')')
+ dir_lines[i].delete = 1;
+ }
+ }
+ /* Treat lines that start with whitespace
+ as continuations; if we are deleting an entry,
+ delete all its continuations as well. */
+ else if (i > 0
+ && (*dir_lines[i].start == ' '
+ || *dir_lines[i].start == '\t'))
+ {
+ dir_lines[i].delete = dir_lines[i - 1].delete;
+ something_deleted = 1;
+ }
+ }
+
+ /* Finish the info about the end of the last node. */
+ if (dir_nodes != 0)
+ {
+ dir_nodes->end_line = dir_nlines;
+ if (dir_nodes->last_section != 0)
+ dir_nodes->last_section->end_line = dir_nlines;
+ }
+
+ /* Decide where to add the new entries (unless --delete was used).
+ Find the menu sections to add them in.
+ In each section, find the proper alphabetical place to add
+ each of the entries. */
+
+ if (!delete_flag)
+ {
+ struct node *node;
+ struct menu_section *section;
+ struct spec_section *spec;
+
+ for (node = dir_nodes; node; node = node->next)
+ for (section = node->sections; section; section = section->next)
+ {
+ for (i = section->end_line; i > section->start_line; i--)
+ if (dir_lines[i - 1].size != 0)
+ break;
+ section->end_line = i;
+
+ for (spec = input_sections; spec; spec = spec->next)
+ if (!strcmp (spec->name, section->name))
+ break;
+ if (spec)
+ {
+ int add_at_line = section->end_line;
+ struct spec_entry *entry;
+ /* Say we have found at least one section with this name,
+ so we need not add such a section. */
+ spec->missing = 0;
+ /* For each entry, find the right place in this section
+ to add it. */
+ for (entry = entries_to_add; entry; entry = entry->next)
+ {
+ int textlen = strlen (entry->text);
+ /* Subtract one because dir_lines is zero-based,
+ but the `end_line' and `start_line' members are
+ one-based. */
+ for (i = section->end_line - 1;
+ i >= section->start_line - 1; i--)
+ {
+ /* If an entry exists with the same name,
+ and was not marked for deletion
+ (which means it is for some other file),
+ we are in trouble. */
+ if (dir_lines[i].start[0] == '*'
+ && menu_line_equal (entry->text, textlen,
+ dir_lines[i].start,
+ dir_lines[i].size)
+ && !dir_lines[i].delete)
+ fatal ("menu item `%s' already exists, for file `%s'",
+ extract_menu_item_name (entry->text),
+ extract_menu_file_name (dir_lines[i].start));
+ if (dir_lines[i].start[0] == '*'
+ && menu_line_lessp (entry->text, textlen,
+ dir_lines[i].start,
+ dir_lines[i].size))
+ add_at_line = i;
+ }
+ insert_entry_here (entry, add_at_line,
+ dir_lines, n_entries_to_add);
+ }
+ }
+ }
+
+ /* Mark the end of the Top node as the place to add any
+ new sections that are needed. */
+ for (node = dir_nodes; node; node = node->next)
+ if (node->name && strcmp (node->name, "Top") == 0)
+ dir_lines[node->end_line].add_sections_before = 1;
+ }
+
+ if (delete_flag && !something_deleted && !quiet_flag)
+ warning ("no entries found for `%s'; nothing deleted", infile);
+
+ /* Output the old dir file, interpolating the new sections
+ and/or new entries where appropriate. */
+
+ output = fopen (dirfile, "w");
+ if (!output)
+ {
+ perror (dirfile);
+ exit (1);
+ }
+
+ for (i = 0; i <= dir_nlines; i++)
+ {
+ int j;
+
+ /* If we decided to output some new entries before this line,
+ output them now. */
+ if (dir_lines[i].add_entries_before)
+ for (j = 0; j < n_entries_to_add; j++)
+ {
+ struct spec_entry *this = dir_lines[i].add_entries_before[j];
+ if (this == 0)
+ break;
+ fputs (this->text, output);
+ }
+ /* If we decided to add some sections here
+ because there are no such sections in the file,
+ output them now. */
+ if (dir_lines[i].add_sections_before)
+ {
+ struct spec_section *spec;
+ struct spec_section **sections;
+ int n_sections = 0;
+
+ /* Count the sections and allocate a vector for all of them. */
+ for (spec = input_sections; spec; spec = spec->next)
+ n_sections++;
+ sections = ((struct spec_section **)
+ xmalloc (n_sections * sizeof (struct spec_section *)));
+
+ /* Fill the vector SECTIONS with pointers to all the sections,
+ and sort them. */
+ j = 0;
+ for (spec = input_sections; spec; spec = spec->next)
+ sections[j++] = spec;
+ qsort (sections, n_sections, sizeof (struct spec_section *),
+ compare_section_names);
+
+ /* Generate the new sections in alphabetical order.
+ In each new section, output all of our entries. */
+ for (j = 0; j < n_sections; j++)
+ {
+ spec = sections[j];
+ if (spec->missing)
+ {
+ struct spec_entry *entry;
+
+ putc ('\n', output);
+ fputs (spec->name, output);
+ putc ('\n', output);
+ for (entry = entries_to_add; entry; entry = entry->next)
+ fputs (entry->text, output);
+ }
+ }
+
+ free (sections);
+ }
+
+ /* Output the original dir lines unless marked for deletion. */
+ if (i < dir_nlines && !dir_lines[i].delete)
+ {
+ fwrite (dir_lines[i].start, 1, dir_lines[i].size, output);
+ putc ('\n', output);
+ }
+ }
+
+ fclose (output);
+
+ exit (0);
+}
+
+/* Read all of file FILNAME into memory
+ and return the address of the data.
+ Store the size into SIZEP.
+ If there is trouble, do a fatal error. */
+
+char *
+readfile (filename, sizep)
+ char *filename;
+ int *sizep;
+{
+ int data_size = 1024;
+ char *data = (char *) xmalloc (data_size);
+ int filled = 0;
+ int nread = 0;
+
+ int desc = open (filename, O_RDONLY);
+
+ if (desc < 0)
+ pfatal_with_name (filename);
+
+ while (1)
+ {
+ nread = read (desc, data + filled, data_size - filled);
+ if (nread < 0)
+ pfatal_with_name (filename);
+ if (nread == 0)
+ break;
+
+ filled += nread;
+ if (filled == data_size)
+ {
+ data_size *= 2;
+ data = (char *) xrealloc (data, data_size);
+ }
+ }
+
+ *sizep = filled;
+ return data;
+}
+
+/* Divide the text at DATA (of SIZE bytes) into lines.
+ Return a vector of struct line_data describing the lines.
+ Store the length of that vector into *NLINESP. */
+
+struct line_data *
+findlines (data, size, nlinesp)
+ char *data;
+ int size;
+ int *nlinesp;
+{
+ struct line_data *lines;
+ int lines_allocated = 512;
+ int filled = 0;
+ int i = 0;
+ int lineflag;
+
+ lines = (struct line_data *) xmalloc (lines_allocated * sizeof (struct line_data));
+
+ lineflag = 1;
+ for (i = 0; i < size; i++)
+ {
+ if (lineflag)
+ {
+ if (filled == lines_allocated)
+ {
+ lines_allocated *= 2;
+ lines = (struct line_data *) xrealloc (lines, lines_allocated * sizeof (struct line_data));
+ }
+ lines[filled].start = &data[i];
+ lines[filled].add_entries_before = 0;
+ lines[filled].add_sections_before = 0;
+ lines[filled].delete = 0;
+ if (filled > 0)
+ lines[filled - 1].size
+ = lines[filled].start - lines[filled - 1].start - 1;
+ filled++;
+ }
+ lineflag = (data[i] == '\n');
+ }
+ if (filled > 0)
+ lines[filled - 1].size = &data[i] - lines[filled - 1].start - lineflag;
+
+ /* Do not leave garbage in the last element. */
+ lines[filled].start = NULL;
+ lines[filled].add_entries_before = NULL;
+ lines[filled].add_sections_before = 0;
+ lines[filled].delete = 0;
+ lines[filled].size = 0;
+
+ *nlinesp = filled;
+ return lines;
+}
+
+/* Compare the menu item names in LINE1 (line length LEN1)
+ and LINE2 (line length LEN2). Return 1 if the item name
+ in LINE1 is less, 0 otherwise. */
+
+int
+menu_line_lessp (line1, len1, line2, len2)
+ char *line1;
+ int len1;
+ char *line2;
+ int len2;
+{
+ int minlen = (len1 < len2 ? len1 : len2);
+ int i;
+
+ for (i = 0; i < minlen; i++)
+ {
+ /* If one item name is a prefix of the other,
+ the former one is less. */
+ if (line1[i] == ':' && line2[i] != ':')
+ return 1;
+ if (line2[i] == ':' && line1[i] != ':')
+ return 0;
+ /* If they both continue and differ, one is less. */
+ if (line1[i] < line2[i])
+ return 1;
+ if (line1[i] > line2[i])
+ return 0;
+ }
+ /* With a properly formatted dir file,
+ we can only get here if the item names are equal. */
+ return 0;
+}
+
+/* Compare the menu item names in LINE1 (line length LEN1)
+ and LINE2 (line length LEN2). Return 1 if the item names are equal,
+ 0 otherwise. */
+
+int
+menu_line_equal (line1, len1, line2, len2)
+ char *line1;
+ int len1;
+ char *line2;
+ int len2;
+{
+ int minlen = (len1 < len2 ? len1 : len2);
+ int i;
+
+ for (i = 0; i < minlen; i++)
+ {
+ /* If both item names end here, they are equal. */
+ if (line1[i] == ':' && line2[i] == ':')
+ return 1;
+ /* If they both continue and differ, one is less. */
+ if (line1[i] != line2[i])
+ return 0;
+ }
+ /* With a properly formatted dir file,
+ we can only get here if the item names are equal. */
+ return 1;
+}
+
+/* This is the comparison function for qsort
+ for a vector of pointers to struct spec_section.
+ Compare the section names. */
+
+int
+compare_section_names (sec1, sec2)
+ struct spec_section **sec1, **sec2;
+{
+ char *name1 = (*sec1)->name;
+ char *name2 = (*sec2)->name;
+ return strcmp (name1, name2);
+}
+
+/* Insert ENTRY into the add_entries_before vector
+ for line number LINE_NUMBER of the dir file.
+ DIR_LINES and N_ENTRIES carry information from like-named variables
+ in main. */
+
+void
+insert_entry_here (entry, line_number, dir_lines, n_entries)
+ struct spec_entry *entry;
+ int line_number;
+ struct line_data *dir_lines;
+ int n_entries;
+{
+ int i;
+
+ if (dir_lines[line_number].add_entries_before == 0)
+ {
+ dir_lines[line_number].add_entries_before
+ = (struct spec_entry **) xmalloc (n_entries * sizeof (struct spec_entry *));
+ for (i = 0; i < n_entries; i++)
+ dir_lines[line_number].add_entries_before[i] = 0;
+ }
+
+ for (i = 0; i < n_entries; i++)
+ if (dir_lines[line_number].add_entries_before[i] == 0)
+ break;
+
+ if (i == n_entries)
+ abort ();
+
+ dir_lines[line_number].add_entries_before[i] = entry;
+}
diff --git a/texinfo/util/mkinstalldirs b/texinfo/util/mkinstalldirs
new file mode 100755
index 00000000000..934c6714923
--- /dev/null
+++ b/texinfo/util/mkinstalldirs
@@ -0,0 +1,40 @@
+#! /bin/sh
+# mkinstalldirs --- make directory hierarchy
+# Author: Noah Friedman <friedman@prep.ai.mit.edu>
+# Created: 1993-05-16
+# Public domain
+
+# $Id: mkinstalldirs,v 1.1 1997/08/21 22:58:12 jason Exp $
+
+errstatus=0
+
+for file
+do
+ set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
+ shift
+
+ pathcomp=
+ for d
+ do
+ pathcomp="$pathcomp$d"
+ case "$pathcomp" in
+ -* ) pathcomp=./$pathcomp ;;
+ esac
+
+ if test ! -d "$pathcomp"; then
+ echo "mkdir $pathcomp" 1>&2
+
+ mkdir "$pathcomp" || lasterr=$?
+
+ if test ! -d "$pathcomp"; then
+ errstatus=$lasterr
+ fi
+ fi
+
+ pathcomp="$pathcomp/"
+ done
+done
+
+exit $errstatus
+
+# mkinstalldirs ends here
diff --git a/texinfo/util/tex3patch b/texinfo/util/tex3patch
new file mode 100755
index 00000000000..1708c7588bb
--- /dev/null
+++ b/texinfo/util/tex3patch
@@ -0,0 +1,71 @@
+#!/bin/sh
+# Auxiliary script to work around TeX 3.0 bug. ---- tex3patch ----
+# patches texinfo.tex in current directory, or in directory given as arg.
+
+ANYVERSION=no
+
+for arg in $1 $2
+do
+ case $arg in
+ --dammit | -d ) ANYVERSION=yes ;;
+
+ * ) dir=$arg
+ esac
+done
+
+if [ -z "$dir" ]; then
+ dir='.'
+fi
+
+if [ \( 2 -lt $# \) -o \
+ \( ! -f $dir/texinfo.tex \) ]; then
+ echo "To patch texinfo.tex for peaceful coexistence with Unix TeX 3.0,"
+ echo "run $0"
+ echo "with no arguments in the same directory as texinfo.tex; or run"
+ echo " $0 DIRECTORY"
+ echo "(where DIRECTORY is a path leading to texinfo.tex)."
+ exit
+fi
+
+if [ -z "$TMPDIR" ]; then
+ TMPDIR=/tmp
+fi
+
+echo "Checking for \`dummy.tfm'"
+
+( cd $TMPDIR; tex '\relax \batchmode \font\foo=dummy \bye' )
+
+grep -s '3.0' $TMPDIR/texput.log
+if [ 1 = "$?" -a "$ANYVERSION" != "yes" ]; then
+ echo "You probably do not need this patch,"
+ echo "since your TeX does not seem to be version 3.0."
+ echo "If you insist on applying the patch, run $0"
+ echo "again with the option \`--dammit'"
+ exit
+fi
+
+grep -s 'file not found' $TMPDIR/texput.log
+if [ 0 = $? ]; then
+ echo "This patch requires the dummy font metric file \`dummy.tfm',"
+ echo "which does not seem to be part of your TeX installation."
+ echo "Please get your TeX maintainer to install \`dummy.tfm',"
+ echo "then run this script again."
+ exit
+fi
+rm $TMPDIR/texput.log
+
+echo "Patching $dir/texinfo.tex"
+
+sed -e 's/%%*\\font\\nullfont/\\font\\nullfont/' \
+ $dir/texinfo.tex >$TMPDIR/texinfo.tex
+mv $dir/texinfo.tex $dir/texinfo.tex-distrib; mv $TMPDIR/texinfo.tex $dir
+
+if [ 0 = $? ]; then
+ echo "Patched $dir/texinfo.tex to avoid TeX 3.0 bug."
+ echo "The original version is saved as $dir/texinfo.tex-distrib."
+else
+ echo "Patch failed. Sorry."
+fi
+----------------------------------------tex3patch ends
+
+
diff --git a/texinfo/util/texi2dvi b/texinfo/util/texi2dvi
new file mode 100755
index 00000000000..d9f1b3e1a51
--- /dev/null
+++ b/texinfo/util/texi2dvi
@@ -0,0 +1,367 @@
+#! /bin/sh
+# texi2dvi --- smartly produce DVI files from texinfo sources
+
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+
+# $Id: texi2dvi,v 1.1 1997/08/21 22:58:13 jason Exp $
+
+# This program 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.
+#
+# This program 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 this program; if not, you can either send email to this
+# program's maintainer or write to: The Free Software Foundation,
+# Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+# Commentary:
+
+# Author: Noah Friedman <friedman@prep.ai.mit.edu>
+
+# Please send bug reports, etc. to bug-texinfo@prep.ai.mit.edu
+# If possible, please send a copy of the output of the script called with
+# the `--debug' option when making a bug report.
+
+# In the interest of general portability, some common bourne shell
+# constructs were avoided because they weren't guaranteed to be available
+# in some earlier implementations. I've tried to make this program as
+# portable as possible. Welcome to unix, where the lowest common
+# denominator is rapidly diminishing.
+#
+# Among the more interesting lossages I noticed with some bourne shells
+# are:
+# * No shell functions.
+# * No `unset' builtin.
+# * `shift' cannot take a numeric argument, and signals an error if
+# there are no arguments to shift.
+
+# Code:
+
+# Name by which this script was invoked.
+progname=`echo "$0" | sed -e 's/[^\/]*\///g'`
+
+# This string is expanded by rcs automatically when this file is checked out.
+rcs_revision='$Revision: 1.1 $'
+version=`set - $rcs_revision; echo $2`
+
+# To prevent hairy quoting and escaping later.
+bq='`'
+eq="'"
+
+usage="Usage: $0 [OPTION]... FILE...
+Run a Texinfo document through TeX.
+
+Options:
+-D, --debug Turn on shell debugging ($bq${bq}set -x$eq$eq).
+-t, --texinfo CMD Insert CMD after @setfilename before running TeX.
+--verbose Report on what is done.
+-h, --help Display this help and exit.
+-v, --version Display version information and exit.
+
+The values of the TEX, TEXINDEX, and MAKEINFO environment variables are
+used to run those commands, if they are set.
+
+Email bug reports to bug-texinfo@prep.ai.mit.edu.
+"
+
+# Initialize variables.
+# Don't use `unset' since old bourne shells don't have this command.
+# Instead, assign them an empty value.
+# Some of these, like TEX and TEXINDEX, may be inherited from the environment.
+backup_extension=.bak # these files get deleted if all goes well.
+debug=
+orig_pwd="`pwd`"
+textra=
+verbose=false
+makeinfo="${MAKEINFO-makeinfo}"
+texindex="${TEXINDEX-texindex}"
+tex="${TEX-tex}"
+
+# Save this so we can construct a new TEXINPUTS path for each file.
+TEXINPUTS_orig="$TEXINPUTS"
+export TEXINPUTS
+
+# Parse command line arguments.
+# Make sure that all wildcarded options are long enough to be unambiguous.
+# It's a good idea to document the full long option name in each case.
+# Long options which take arguments will need a `*' appended to the
+# canonical name to match the value appended after the `=' character.
+while : ; do
+ case $# in 0) break ;; esac
+ case "$1" in
+ -D | --debug | --d* ) debug=t; shift ;;
+ -h | --help | --h* ) echo "$usage"; exit 0 ;;
+ # OK, we should do real option parsing here, but be lazy for now.
+ -t | --texinfo | --t*) shift; textra="$textra $1"; shift ;;
+ -v | --vers* )
+ echo "$progname (Texinfo 3.9) $version"
+ echo "Copyright (C) 1996 Free Software Foundation, Inc.
+There is NO warranty. You may redistribute this software
+under the terms of the GNU General Public License.
+For more information about these matters, see the files named COPYING."
+ exit 0 ;;
+ --verb* ) verbose=echo; shift ;;
+ -- ) # Stop option processing
+ shift
+ break
+ ;;
+ -* )
+ case "$1" in
+ --*=* ) arg=`echo "$1" | sed -e 's/=.*//'` ;;
+ * ) arg="$1" ;;
+ esac
+ exec 1>&2
+ echo "$progname: Unknown or ambiguous option $bq$arg$eq."
+ echo "$progname: Try $bq--help$eq for more information."
+ exit 1
+ ;;
+ * )
+ break
+ ;;
+ esac
+done
+
+# See if there are any command line args left (which will be interpreted as
+# filename arguments).
+if test $# -eq 0; then
+ exec 1>&2
+ echo "$progname: At least one file name is required as an argument."
+ echo "$progname: Try $bq--help$eq for more information."
+ exit 2
+fi
+
+test "$debug" = t && set -x
+
+# Texify files
+for command_line_filename in ${1+"$@"} ; do
+ $verbose "Processing $command_line_filename ..."
+
+ # See if file exists. If it doesn't we're in trouble since, even
+ # though the user may be able to reenter a valid filename at the tex
+ # prompt (assuming they're attending the terminal), this script won't
+ # be able to find the right index files and so forth.
+ if test ! -r "${command_line_filename}" ; then
+ echo "$0: Could not read ${command_line_filename}." >&2
+ continue
+ fi
+
+ # Roughly equivalent to `dirname ...`, but more portable
+ directory="`echo ${command_line_filename} | sed 's/\/[^\/]*$//'`"
+ filename_texi="`basename ${command_line_filename}`"
+ # Strip off the last extension part (probably .texinfo or .texi)
+ filename_noext="`echo ${filename_texi} | sed 's/\.[^.]*$//'`"
+
+ # Use same basename since we want to generate aux files with the same
+ # basename as the manual. Use extension .texi for the temp file so
+ # that TeX will ignore it. Thus, we must use a subdirectory.
+ #
+ # Output the macro-expanded file to here.
+ tmp_dir=${TMPDIR-/tmp}/$$
+ filename_tmp=$tmp_dir/$filename_noext.texi
+ # Output the file with the user's extra commands to here.
+ filename_tmp2=$tmp_dir.2/$filename_noext.texi
+ mkdir $tmp_dir $tmp_dir.2
+
+ # If directory and file are the same, then it's probably because there's
+ # no pathname component. Set dirname to `.', the current directory.
+ if test "z${directory}" = "z${command_line_filename}" ; then
+ directory=.
+ fi
+
+ # Source file might @include additional texinfo sources. Put `.' and
+ # directory where source file(s) reside in TEXINPUTS before anything
+ # else. `.' goes first to ensure that any old .aux, .cps, etc. files in
+ # ${directory} don't get used in preference to fresher files in `.'.
+ TEXINPUTS=".:${directory}:${TEXINPUTS_orig}"
+
+ # Expand macro commands in the original source file using Makeinfo;
+ # the macro syntax bfox implemented is impossible to implement in TeX.
+ # Always use `end' footnote style, since the `separate' style
+ # generates different output (arguably this is a bug in -E).
+ # Discard main info output, the user asked to run TeX, not makeinfo.
+ # Redirect output to /dev/null to throw away `Making info file...' msg.
+ $verbose "Macro-expanding $command_line_filename to $filename_tmp ..."
+ $makeinfo --footnote-style=end -E $filename_tmp -o /dev/null \
+ $command_line_filename >/dev/null
+
+ # But if there were no macros, or makeinfo failed for some reason,
+ # just use the original file. (It shouldn't make any difference, but
+ # let's be safe.)
+ if test $? -ne 0 || cmp -s $filename_tmp $command_line_filename; then
+ $verbose "Reverting to $command_line_filename ..."
+ filename_input=$command_line_filename
+ else
+ filename_input=$filename_tmp
+ fi
+
+ # Used most commonly for @finalout, @smallbook, etc.
+ if test -n "$textra"; then
+ $verbose "Inserting extra commands: $textra."
+ sed '/^@setfilename/a\
+'"$textra" $filename_input >$filename_tmp2
+ filename_input=$filename_tmp2
+ fi
+
+ while true; do # will break out of loop below
+ # "Unset" variables that might have values from previous iterations and
+ # which won't be completely reset later.
+ definite_index_files=
+
+ # Find all files having root filename with a two-letter extension,
+ # determine whether they're really index files, and save them. Foo.aux
+ # is actually the cross-references file, but we need to keep track of
+ # that too.
+ possible_index_files="`eval echo ${filename_noext}.?? ${filename_noext}.aux`"
+ for this_file in ${possible_index_files} ; do
+ # If file is empty, forget it.
+ test -s "${this_file}" || continue
+
+ # Examine first character of file. If it's not suitable to be an
+ # index or xref file, don't process it.
+ first_character="`sed -n '1s/^\(.\).*$/\1/p;q' ${this_file}`"
+ if test "x${first_character}" = "x\\" \
+ || test "x${first_character}" = "x'"; then
+ definite_index_files="${definite_index_files} ${this_file}"
+ fi
+ done
+ orig_index_files="${definite_index_files}"
+ orig_index_files_sans_aux="`echo ${definite_index_files} \
+ | sed 's/'${filename_noext}'\.aux//;
+ s/^[ ]*//;s/[ ]*$//;'`"
+
+ # Now save copies of original index files so we have some means of
+ # comparison later.
+ $verbose "Backing up current index files: $orig_index_files ..."
+ for index_file_to_save in ${orig_index_files} ; do
+ cp "${index_file_to_save}" "${index_file_to_save}${backup_extension}"
+ done
+
+ # Run texindex on current index files. If they already exist, and
+ # after running TeX a first time the index files don't change, then
+ # there's no reason to run TeX again. But we won't know that if the
+ # index files are out of date or nonexistent.
+ if test -n "${orig_index_files_sans_aux}" ; then
+ $verbose "Running $texindex $orig_index_files_sans_aux ..."
+ ${texindex} ${orig_index_files_sans_aux}
+ fi
+
+ # Finally, run TeX.
+ $verbose "Running $tex $filename_input ..."
+ ${tex} "$filename_input"
+
+ # Check if index files changed.
+ #
+ definite_index_files=
+ # Get list of new index files.
+ possible_index_files="`eval echo ${filename_noext}.?? ${filename_noext}.aux`"
+ for this_file in ${possible_index_files} ; do
+ # If file is empty, forget it.
+ test -s "${this_file}" || continue
+
+ # Examine first character of file. If it's not a backslash or
+ # single quote, then it's definitely not an index or xref file.
+ # (Will have to check for @ when we switch to Texinfo syntax in
+ # all these files...)
+ first_character="`sed -n '1s/^\(.\).*$/\1/p;q' ${this_file}`"
+ if test "x${first_character}" = "x\\" \
+ || test "x${first_character}" = "x'"; then
+ definite_index_files="${definite_index_files} ${this_file}"
+ fi
+ done
+ new_index_files="${definite_index_files}"
+ new_index_files_sans_aux="`echo ${definite_index_files} \
+ | sed 's/'${filename_noext}'\.aux//;
+ s/^[ ]*//;s/[ ]*$//;'`"
+
+ # If old and new list don't at least have the same file list, then one
+ # file or another has definitely changed.
+ $verbose "Original index files =$orig_index_files"
+ $verbose "New index files =$new_index_files"
+ if test "z${orig_index_files}" != "z${new_index_files}" ; then
+ index_files_changed_p=t
+ else
+ # File list is the same. We must compare each file until we find a
+ # difference.
+ index_files_changed_p=
+ for this_file in ${new_index_files} ; do
+ $verbose "Comparing index file $this_file ..."
+ # cmp -s will return nonzero exit status if files differ.
+ cmp -s "${this_file}" "${this_file}${backup_extension}"
+ if test $? -ne 0 ; then
+ # We only need to keep comparing until we find *one* that
+ # differs, because we'll have to run texindex & tex no
+ # matter what.
+ index_files_changed_p=t
+ $verbose "Index file $this_file differed:"
+ test $verbose = echo \
+ && diff -c "${this_file}${backup_extension}" "${this_file}"
+ break
+ fi
+ done
+ fi
+
+ # If index files have changed since TeX has been run, or if the aux
+ # file wasn't present originally, run texindex and TeX again.
+ if test "${index_files_changed_p}" ; then :; else
+ # Nothing changed. We're done with TeX.
+ break
+ fi
+ done
+
+ # Generate list of files to delete, then call rm once with the entire
+ # list. This is significantly faster than multiple executions of rm.
+ file_list=
+ for file in ${orig_index_files} ; do
+ file_list="${file_list} ${file}${backup_extension}"
+ done
+ if test -n "${file_list}" ; then
+ $verbose "Removing $file_list $tmp_dir $tmp_dir.2 ..."
+ rm -f ${file_list}
+ rm -rf $tmp_dir $tmp_dir.2
+ fi
+done
+
+$verbose "$0 done."
+true # exit successfully.
+
+# texi2dvi ends here
+# $Log: texi2dvi,v $
+# Revision 1.1 1997/08/21 22:58:13 jason
+# Initial revision
+#
+# Revision 1.10 1996/10/04 18:21:55 karl
+# Include only the current year in the copyright message.
+#
+# Revision 1.9 1996/10/04 11:49:48 karl
+# Exit successfully. From arnold.
+#
+# Revision 1.8 1996/10/03 23:14:26 karl
+# Only show diff if verbose.
+# Update version number.
+#
+# Revision 1.7 1996/09/29 22:56:08 karl
+# Use $progname instead of $0 for --version.
+#
+# Revision 1.6 1996/09/28 21:01:23 karl
+# Recompute original index files each time through loop.
+# Make indentation uniform.
+# Use same basename for the temp input files.
+# Standardize --version output.
+#
+# Revision 1.5 1996/09/26 14:46:34 karl
+# (texi2dvi): Run TeX until the aux/index files stabilize, instead of just
+# twice. From: David Shaw <daves@gsms01.alcatel.com.au>.
+#
+# Revision 1.4 1996/08/27 18:59:26 karl
+# Include bug reporting address.
+#
+# Revision 1.3 1996/07/26 18:20:56 karl
+# Do macro expansion with makeinfo before running TeX.
+# Various expansion safety measures added for test; avoid use of -o.
+#
diff --git a/texinfo/util/texindex.c b/texinfo/util/texindex.c
new file mode 100644
index 00000000000..306aa1fd601
--- /dev/null
+++ b/texinfo/util/texindex.c
@@ -0,0 +1,1793 @@
+/* Prepare TeX index dribble output into an actual index.
+ $Id: texindex.c,v 1.1 1997/08/21 22:58:13 jason Exp $
+
+ Copyright (C) 1987, 91, 92, 96 Free Software Foundation, Inc.
+
+ This program 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.
+
+ This program 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 this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307. */
+
+#include <stdio.h>
+#include <ctype.h>
+#include <errno.h>
+#include "getopt.h"
+
+#define TEXINDEX_VERSION_STRING "GNU Texindex (Texinfo 3.9) 2.1"
+
+#if defined (emacs)
+# include "../src/config.h"
+/* Some s/os.h files redefine these. */
+# undef read
+# undef close
+# undef write
+# undef open
+#endif
+
+#if defined (HAVE_STRING_H)
+# include <string.h>
+#endif /* HAVE_STRING_H */
+
+#if !defined (HAVE_STRCHR)
+char *strrchr ();
+#endif /* !HAVE_STRCHR */
+
+#if defined (STDC_HEADERS)
+# include <stdlib.h>
+#else /* !STDC_HEADERS */
+char *getenv (), *malloc (), *realloc ();
+#endif /* !STDC_HEADERS */
+
+#if defined (HAVE_UNISTD_H)
+# include <unistd.h>
+#else /* !HAVE_UNISTD_H */
+off_t lseek ();
+#endif /* !HAVE_UNISTD_H */
+
+#if !defined (HAVE_MEMSET)
+#undef memset
+#define memset(ptr, ignore, count) bzero (ptr, count)
+#endif
+
+
+char *mktemp ();
+
+#if defined (VMS)
+# include <file.h>
+# define TI_NO_ERROR ((1 << 28) | 1)
+# define TI_FATAL_ERROR ((1 << 28) | 4)
+# define unlink delete
+#else /* !VMS */
+# if defined (HAVE_SYS_FCNTL_H)
+# include <sys/types.h>
+# include <sys/fcntl.h>
+# endif /* HAVE_SYS_FCNTL_H */
+
+# if defined (_AIX) || !defined (_POSIX_VERSION)
+# include <sys/file.h>
+# else /* !AIX && _POSIX_VERSION */
+# if !defined (HAVE_SYS_FCNTL_H)
+# include <fcntl.h>
+# endif /* !HAVE_FCNTL_H */
+# endif /* !_AIX && _POSIX_VERSION */
+# define TI_NO_ERROR 0
+# define TI_FATAL_ERROR 1
+#endif /* !VMS */
+
+#if !defined (SEEK_SET)
+# define SEEK_SET 0
+# define SEEK_CUR 1
+# define SEEK_END 2
+#endif /* !SEEK_SET */
+
+#ifndef errno
+extern int errno;
+#endif
+#ifndef strerror
+extern char *strerror ();
+#endif
+
+/* When sorting in core, this structure describes one line
+ and the position and length of its first keyfield. */
+struct lineinfo
+{
+ char *text; /* The actual text of the line. */
+ union {
+ char *text; /* The start of the key (for textual comparison). */
+ long number; /* The numeric value (for numeric comparison). */
+ } key;
+ long keylen; /* Length of KEY field. */
+};
+
+/* This structure describes a field to use as a sort key. */
+struct keyfield
+{
+ int startwords; /* Number of words to skip. */
+ int startchars; /* Number of additional chars to skip. */
+ int endwords; /* Number of words to ignore at end. */
+ int endchars; /* Ditto for characters of last word. */
+ char ignore_blanks; /* Non-zero means ignore spaces and tabs. */
+ char fold_case; /* Non-zero means case doesn't matter. */
+ char reverse; /* Non-zero means compare in reverse order. */
+ char numeric; /* Non-zeros means field is ASCII numeric. */
+ char positional; /* Sort according to file position. */
+ char braced; /* Count balanced-braced groupings as fields. */
+};
+
+/* Vector of keyfields to use. */
+struct keyfield keyfields[3];
+
+/* Number of keyfields stored in that vector. */
+int num_keyfields = 3;
+
+/* Vector of input file names, terminated with a null pointer. */
+char **infiles;
+
+/* Vector of corresponding output file names, or NULL, meaning default it
+ (add an `s' to the end). */
+char **outfiles;
+
+/* Length of `infiles'. */
+int num_infiles;
+
+/* Pointer to the array of pointers to lines being sorted. */
+char **linearray;
+
+/* The allocated length of `linearray'. */
+long nlines;
+
+/* Directory to use for temporary files. On Unix, it ends with a slash. */
+char *tempdir;
+
+/* Start of filename to use for temporary files. */
+char *tempbase;
+
+/* Number of last temporary file. */
+int tempcount;
+
+/* Number of last temporary file already deleted.
+ Temporary files are deleted by `flush_tempfiles' in order of creation. */
+int last_deleted_tempcount;
+
+/* During in-core sort, this points to the base of the data block
+ which contains all the lines of data. */
+char *text_base;
+
+/* Additional command switches .*/
+
+/* Nonzero means do not delete tempfiles -- for debugging. */
+int keep_tempfiles;
+
+/* The name this program was run with. */
+char *program_name;
+
+/* Forward declarations of functions in this file. */
+
+void decode_command ();
+void sort_in_core ();
+void sort_offline ();
+char **parsefile ();
+char *find_field ();
+char *find_pos ();
+long find_value ();
+char *find_braced_pos ();
+char *find_braced_end ();
+void writelines ();
+int compare_field ();
+int compare_full ();
+long readline ();
+int merge_files ();
+int merge_direct ();
+void pfatal_with_name ();
+void fatal ();
+void error ();
+void *xmalloc (), *xrealloc ();
+char *concat ();
+char *maketempname ();
+void flush_tempfiles ();
+char *tempcopy ();
+
+#define MAX_IN_CORE_SORT 500000
+
+int
+main (argc, argv)
+ int argc;
+ char **argv;
+{
+ int i;
+
+ tempcount = 0;
+ last_deleted_tempcount = 0;
+
+ program_name = strrchr (argv[0], '/');
+ if (program_name != (char *)NULL)
+ program_name++;
+ else
+ program_name = argv[0];
+
+ /* Describe the kind of sorting to do. */
+ /* The first keyfield uses the first braced field and folds case. */
+ keyfields[0].braced = 1;
+ keyfields[0].fold_case = 1;
+ keyfields[0].endwords = -1;
+ keyfields[0].endchars = -1;
+
+ /* The second keyfield uses the second braced field, numerically. */
+ keyfields[1].braced = 1;
+ keyfields[1].numeric = 1;
+ keyfields[1].startwords = 1;
+ keyfields[1].endwords = -1;
+ keyfields[1].endchars = -1;
+
+ /* The third keyfield (which is ignored while discarding duplicates)
+ compares the whole line. */
+ keyfields[2].endwords = -1;
+ keyfields[2].endchars = -1;
+
+ decode_command (argc, argv);
+
+ tempbase = mktemp (concat ("txiXXXXXX", "", ""));
+
+ /* Process input files completely, one by one. */
+
+ for (i = 0; i < num_infiles; i++)
+ {
+ int desc;
+ long ptr;
+ char *outfile;
+
+ desc = open (infiles[i], O_RDONLY, 0);
+ if (desc < 0)
+ pfatal_with_name (infiles[i]);
+ lseek (desc, (off_t) 0, SEEK_END);
+ ptr = (long) lseek (desc, (off_t) 0, SEEK_CUR);
+
+ close (desc);
+
+ outfile = outfiles[i];
+ if (!outfile)
+ {
+ outfile = concat (infiles[i], "s", "");
+ }
+
+ if (ptr < MAX_IN_CORE_SORT)
+ /* Sort a small amount of data. */
+ sort_in_core (infiles[i], ptr, outfile);
+ else
+ sort_offline (infiles[i], ptr, outfile);
+ }
+
+ flush_tempfiles (tempcount);
+ exit (TI_NO_ERROR);
+}
+
+typedef struct
+{
+ char *long_name;
+ char *short_name;
+ int *variable_ref;
+ int variable_value;
+ char *arg_name;
+ char *doc_string;
+} TEXINDEX_OPTION;
+
+TEXINDEX_OPTION texindex_options[] = {
+ { "--keep", "-k", &keep_tempfiles, 1, (char *)NULL,
+ "keep temporary files around after processing" },
+ { "--no-keep", 0, &keep_tempfiles, 0, (char *)NULL,
+ "do not keep temporary files around after processing (default)" },
+ { "--output", "-o", (int *)NULL, 0, "FILE",
+ "send output to FILE" },
+ { "--version", (char *)NULL, (int *)NULL, 0, (char *)NULL,
+ "display version information and exit" },
+ { "--help", "-h", (int *)NULL, 0, (char *)NULL,
+ "display this help and exit" },
+ { (char *)NULL, (char *)NULL, (int *)NULL, 0, (char *)NULL }
+};
+
+void
+usage (result_value)
+ int result_value;
+{
+ register int i;
+ FILE *f = result_value ? stderr : stdout;
+
+ fprintf (f, "Usage: %s [OPTION]... FILE...\n", program_name);
+ fprintf (f, "Generate a sorted index for each TeX output FILE.\n");
+ /* Avoid trigraph nonsense. */
+ fprintf (f, "Usually FILE... is `foo.??\' for a document `foo.texi'.\n");
+ fprintf (f, "\nOptions:\n");
+
+ for (i = 0; texindex_options[i].long_name; i++)
+ {
+ if (texindex_options[i].short_name)
+ fprintf (f, "%s, ", texindex_options[i].short_name);
+
+ fprintf (f, "%s %s",
+ texindex_options[i].long_name,
+ texindex_options[i].arg_name
+ ? texindex_options[i].arg_name : "");
+
+ fprintf (f, "\t%s\n", texindex_options[i].doc_string);
+ }
+ puts ("\nEmail bug reports to bug-texinfo@prep.ai.mit.edu.");
+
+ exit (result_value);
+}
+
+/* Decode the command line arguments to set the parameter variables
+ and set up the vector of keyfields and the vector of input files. */
+
+void
+decode_command (argc, argv)
+ int argc;
+ char **argv;
+{
+ int arg_index = 1;
+ int optc;
+ char **ip;
+ char **op;
+
+ /* Store default values into parameter variables. */
+
+ tempdir = getenv ("TMPDIR");
+#ifdef VMS
+ if (tempdir == NULL)
+ tempdir = "sys$scratch:";
+#else
+ if (tempdir == NULL)
+ tempdir = "/tmp/";
+ else
+ tempdir = concat (tempdir, "/", "");
+#endif
+
+ keep_tempfiles = 0;
+
+ /* Allocate ARGC input files, which must be enough. */
+
+ infiles = (char **) xmalloc (argc * sizeof (char *));
+ outfiles = (char **) xmalloc (argc * sizeof (char *));
+ ip = infiles;
+ op = outfiles;
+
+ while (arg_index < argc)
+ {
+ char *arg = argv[arg_index++];
+
+ if (*arg == '-')
+ {
+ if (strcmp (arg, "--version") == 0)
+ {
+ puts (TEXINDEX_VERSION_STRING);
+puts ("Copyright (C) 1996 Free Software Foundation, Inc.\n\
+There is NO warranty. You may redistribute this software\n\
+under the terms of the GNU General Public License.\n\
+For more information about these matters, see the files named COPYING.");
+ exit (0);
+ }
+ else if ((strcmp (arg, "--keep") == 0) ||
+ (strcmp (arg, "-k") == 0))
+ {
+ keep_tempfiles = 1;
+ }
+ else if ((strcmp (arg, "--help") == 0) ||
+ (strcmp (arg, "-h") == 0))
+ {
+ usage (0);
+ }
+ else if ((strcmp (arg, "--output") == 0) ||
+ (strcmp (arg, "-o") == 0))
+ {
+ if (argv[arg_index] != (char *)NULL)
+ {
+ arg_index++;
+ if (op > outfiles)
+ *(op - 1) = argv[arg_index];
+ }
+ else
+ usage (1);
+ }
+ else
+ usage (1);
+ }
+ else
+ {
+ *ip++ = arg;
+ *op++ = (char *)NULL;
+ }
+ }
+
+ /* Record number of keyfields and terminate list of filenames. */
+ num_infiles = ip - infiles;
+ *ip = (char *)NULL;
+ if (num_infiles == 0)
+ usage (1);
+}
+
+/* Return a name for a temporary file. */
+
+char *
+maketempname (count)
+ int count;
+{
+ char tempsuffix[10];
+ sprintf (tempsuffix, "%d", count);
+ return concat (tempdir, tempbase, tempsuffix);
+}
+
+/* Delete all temporary files up to TO_COUNT. */
+
+void
+flush_tempfiles (to_count)
+ int to_count;
+{
+ if (keep_tempfiles)
+ return;
+ while (last_deleted_tempcount < to_count)
+ unlink (maketempname (++last_deleted_tempcount));
+}
+
+/* Copy the input file open on IDESC into a temporary file
+ and return the temporary file name. */
+
+#define BUFSIZE 1024
+
+char *
+tempcopy (idesc)
+ int idesc;
+{
+ char *outfile = maketempname (++tempcount);
+ int odesc;
+ char buffer[BUFSIZE];
+
+ odesc = open (outfile, O_WRONLY | O_CREAT, 0666);
+
+ if (odesc < 0)
+ pfatal_with_name (outfile);
+
+ while (1)
+ {
+ int nread = read (idesc, buffer, BUFSIZE);
+ write (odesc, buffer, nread);
+ if (!nread)
+ break;
+ }
+
+ close (odesc);
+
+ return outfile;
+}
+
+/* Compare LINE1 and LINE2 according to the specified set of keyfields. */
+
+int
+compare_full (line1, line2)
+ char **line1, **line2;
+{
+ int i;
+
+ /* Compare using the first keyfield;
+ if that does not distinguish the lines, try the second keyfield;
+ and so on. */
+
+ for (i = 0; i < num_keyfields; i++)
+ {
+ long length1, length2;
+ char *start1 = find_field (&keyfields[i], *line1, &length1);
+ char *start2 = find_field (&keyfields[i], *line2, &length2);
+ int tem = compare_field (&keyfields[i], start1, length1, *line1 - text_base,
+ start2, length2, *line2 - text_base);
+ if (tem)
+ {
+ if (keyfields[i].reverse)
+ return -tem;
+ return tem;
+ }
+ }
+
+ return 0; /* Lines match exactly. */
+}
+
+/* Compare LINE1 and LINE2, described by structures
+ in which the first keyfield is identified in advance.
+ For positional sorting, assumes that the order of the lines in core
+ reflects their nominal order. */
+
+int
+compare_prepared (line1, line2)
+ struct lineinfo *line1, *line2;
+{
+ int i;
+ int tem;
+ char *text1, *text2;
+
+ /* Compare using the first keyfield, which has been found for us already. */
+ if (keyfields->positional)
+ {
+ if (line1->text - text_base > line2->text - text_base)
+ tem = 1;
+ else
+ tem = -1;
+ }
+ else if (keyfields->numeric)
+ tem = line1->key.number - line2->key.number;
+ else
+ tem = compare_field (keyfields, line1->key.text, line1->keylen, 0,
+ line2->key.text, line2->keylen, 0);
+ if (tem)
+ {
+ if (keyfields->reverse)
+ return -tem;
+ return tem;
+ }
+
+ text1 = line1->text;
+ text2 = line2->text;
+
+ /* Compare using the second keyfield;
+ if that does not distinguish the lines, try the third keyfield;
+ and so on. */
+
+ for (i = 1; i < num_keyfields; i++)
+ {
+ long length1, length2;
+ char *start1 = find_field (&keyfields[i], text1, &length1);
+ char *start2 = find_field (&keyfields[i], text2, &length2);
+ int tem = compare_field (&keyfields[i], start1, length1, text1 - text_base,
+ start2, length2, text2 - text_base);
+ if (tem)
+ {
+ if (keyfields[i].reverse)
+ return -tem;
+ return tem;
+ }
+ }
+
+ return 0; /* Lines match exactly. */
+}
+
+/* Like compare_full but more general.
+ You can pass any strings, and you can say how many keyfields to use.
+ POS1 and POS2 should indicate the nominal positional ordering of
+ the two lines in the input. */
+
+int
+compare_general (str1, str2, pos1, pos2, use_keyfields)
+ char *str1, *str2;
+ long pos1, pos2;
+ int use_keyfields;
+{
+ int i;
+
+ /* Compare using the first keyfield;
+ if that does not distinguish the lines, try the second keyfield;
+ and so on. */
+
+ for (i = 0; i < use_keyfields; i++)
+ {
+ long length1, length2;
+ char *start1 = find_field (&keyfields[i], str1, &length1);
+ char *start2 = find_field (&keyfields[i], str2, &length2);
+ int tem = compare_field (&keyfields[i], start1, length1, pos1,
+ start2, length2, pos2);
+ if (tem)
+ {
+ if (keyfields[i].reverse)
+ return -tem;
+ return tem;
+ }
+ }
+
+ return 0; /* Lines match exactly. */
+}
+
+/* Find the start and length of a field in STR according to KEYFIELD.
+ A pointer to the starting character is returned, and the length
+ is stored into the int that LENGTHPTR points to. */
+
+char *
+find_field (keyfield, str, lengthptr)
+ struct keyfield *keyfield;
+ char *str;
+ long *lengthptr;
+{
+ char *start;
+ char *end;
+ char *(*fun) ();
+
+ if (keyfield->braced)
+ fun = find_braced_pos;
+ else
+ fun = find_pos;
+
+ start = (*fun) (str, keyfield->startwords, keyfield->startchars,
+ keyfield->ignore_blanks);
+ if (keyfield->endwords < 0)
+ {
+ if (keyfield->braced)
+ end = find_braced_end (start);
+ else
+ {
+ end = start;
+ while (*end && *end != '\n')
+ end++;
+ }
+ }
+ else
+ {
+ end = (*fun) (str, keyfield->endwords, keyfield->endchars, 0);
+ if (end - str < start - str)
+ end = start;
+ }
+ *lengthptr = end - start;
+ return start;
+}
+
+/* Return a pointer to a specified place within STR,
+ skipping (from the beginning) WORDS words and then CHARS chars.
+ If IGNORE_BLANKS is nonzero, we skip all blanks
+ after finding the specified word. */
+
+char *
+find_pos (str, words, chars, ignore_blanks)
+ char *str;
+ int words, chars;
+ int ignore_blanks;
+{
+ int i;
+ char *p = str;
+
+ for (i = 0; i < words; i++)
+ {
+ char c;
+ /* Find next bunch of nonblanks and skip them. */
+ while ((c = *p) == ' ' || c == '\t')
+ p++;
+ while ((c = *p) && c != '\n' && !(c == ' ' || c == '\t'))
+ p++;
+ if (!*p || *p == '\n')
+ return p;
+ }
+
+ while (*p == ' ' || *p == '\t')
+ p++;
+
+ for (i = 0; i < chars; i++)
+ {
+ if (!*p || *p == '\n')
+ break;
+ p++;
+ }
+ return p;
+}
+
+/* Like find_pos but assumes that each field is surrounded by braces
+ and that braces within fields are balanced. */
+
+char *
+find_braced_pos (str, words, chars, ignore_blanks)
+ char *str;
+ int words, chars;
+ int ignore_blanks;
+{
+ int i;
+ int bracelevel;
+ char *p = str;
+ char c;
+
+ for (i = 0; i < words; i++)
+ {
+ bracelevel = 1;
+ while ((c = *p++) != '{' && c != '\n' && c)
+ /* Do nothing. */ ;
+ if (c != '{')
+ return p - 1;
+ while (bracelevel)
+ {
+ c = *p++;
+ if (c == '{')
+ bracelevel++;
+ if (c == '}')
+ bracelevel--;
+ if (c == 0 || c == '\n')
+ return p - 1;
+ }
+ }
+
+ while ((c = *p++) != '{' && c != '\n' && c)
+ /* Do nothing. */ ;
+
+ if (c != '{')
+ return p - 1;
+
+ if (ignore_blanks)
+ while ((c = *p) == ' ' || c == '\t')
+ p++;
+
+ for (i = 0; i < chars; i++)
+ {
+ if (!*p || *p == '\n')
+ break;
+ p++;
+ }
+ return p;
+}
+
+/* Find the end of the balanced-brace field which starts at STR.
+ The position returned is just before the closing brace. */
+
+char *
+find_braced_end (str)
+ char *str;
+{
+ int bracelevel;
+ char *p = str;
+ char c;
+
+ bracelevel = 1;
+ while (bracelevel)
+ {
+ c = *p++;
+ if (c == '{')
+ bracelevel++;
+ if (c == '}')
+ bracelevel--;
+ if (c == 0 || c == '\n')
+ return p - 1;
+ }
+ return p - 1;
+}
+
+long
+find_value (start, length)
+ char *start;
+ long length;
+{
+ while (length != 0L)
+ {
+ if (isdigit (*start))
+ return atol (start);
+ length--;
+ start++;
+ }
+ return 0l;
+}
+
+/* Vector used to translate characters for comparison.
+ This is how we make all alphanumerics follow all else,
+ and ignore case in the first sorting. */
+int char_order[256];
+
+void
+init_char_order ()
+{
+ int i;
+ for (i = 1; i < 256; i++)
+ char_order[i] = i;
+
+ for (i = '0'; i <= '9'; i++)
+ char_order[i] += 512;
+
+ for (i = 'a'; i <= 'z'; i++)
+ {
+ char_order[i] = 512 + i;
+ char_order[i + 'A' - 'a'] = 512 + i;
+ }
+}
+
+/* Compare two fields (each specified as a start pointer and a character count)
+ according to KEYFIELD.
+ The sign of the value reports the relation between the fields. */
+
+int
+compare_field (keyfield, start1, length1, pos1, start2, length2, pos2)
+ struct keyfield *keyfield;
+ char *start1;
+ long length1;
+ long pos1;
+ char *start2;
+ long length2;
+ long pos2;
+{
+ if (keyfields->positional)
+ {
+ if (pos1 > pos2)
+ return 1;
+ else
+ return -1;
+ }
+ if (keyfield->numeric)
+ {
+ long value = find_value (start1, length1) - find_value (start2, length2);
+ if (value > 0)
+ return 1;
+ if (value < 0)
+ return -1;
+ return 0;
+ }
+ else
+ {
+ char *p1 = start1;
+ char *p2 = start2;
+ char *e1 = start1 + length1;
+ char *e2 = start2 + length2;
+
+ while (1)
+ {
+ int c1, c2;
+
+ if (p1 == e1)
+ c1 = 0;
+ else
+ c1 = *p1++;
+ if (p2 == e2)
+ c2 = 0;
+ else
+ c2 = *p2++;
+
+ if (char_order[c1] != char_order[c2])
+ return char_order[c1] - char_order[c2];
+ if (!c1)
+ break;
+ }
+
+ /* Strings are equal except possibly for case. */
+ p1 = start1;
+ p2 = start2;
+ while (1)
+ {
+ int c1, c2;
+
+ if (p1 == e1)
+ c1 = 0;
+ else
+ c1 = *p1++;
+ if (p2 == e2)
+ c2 = 0;
+ else
+ c2 = *p2++;
+
+ if (c1 != c2)
+ /* Reverse sign here so upper case comes out last. */
+ return c2 - c1;
+ if (!c1)
+ break;
+ }
+
+ return 0;
+ }
+}
+
+/* A `struct linebuffer' is a structure which holds a line of text.
+ `readline' reads a line from a stream into a linebuffer
+ and works regardless of the length of the line. */
+
+struct linebuffer
+{
+ long size;
+ char *buffer;
+};
+
+/* Initialize LINEBUFFER for use. */
+
+void
+initbuffer (linebuffer)
+ struct linebuffer *linebuffer;
+{
+ linebuffer->size = 200;
+ linebuffer->buffer = (char *) xmalloc (200);
+}
+
+/* Read a line of text from STREAM into LINEBUFFER.
+ Return the length of the line. */
+
+long
+readline (linebuffer, stream)
+ struct linebuffer *linebuffer;
+ FILE *stream;
+{
+ char *buffer = linebuffer->buffer;
+ char *p = linebuffer->buffer;
+ char *end = p + linebuffer->size;
+
+ while (1)
+ {
+ int c = getc (stream);
+ if (p == end)
+ {
+ buffer = (char *) xrealloc (buffer, linebuffer->size *= 2);
+ p += buffer - linebuffer->buffer;
+ end += buffer - linebuffer->buffer;
+ linebuffer->buffer = buffer;
+ }
+ if (c < 0 || c == '\n')
+ {
+ *p = 0;
+ break;
+ }
+ *p++ = c;
+ }
+
+ return p - buffer;
+}
+
+/* Sort an input file too big to sort in core. */
+
+void
+sort_offline (infile, nfiles, total, outfile)
+ char *infile;
+ int nfiles;
+ long total;
+ char *outfile;
+{
+ /* More than enough. */
+ int ntemps = 2 * (total + MAX_IN_CORE_SORT - 1) / MAX_IN_CORE_SORT;
+ char **tempfiles = (char **) xmalloc (ntemps * sizeof (char *));
+ FILE *istream = fopen (infile, "r");
+ int i;
+ struct linebuffer lb;
+ long linelength;
+ int failure = 0;
+
+ initbuffer (&lb);
+
+ /* Read in one line of input data. */
+
+ linelength = readline (&lb, istream);
+
+ if (lb.buffer[0] != '\\' && lb.buffer[0] != '@')
+ {
+ error ("%s: not a texinfo index file", infile);
+ return;
+ }
+
+ /* Split up the input into `ntemps' temporary files, or maybe fewer,
+ and put the new files' names into `tempfiles' */
+
+ for (i = 0; i < ntemps; i++)
+ {
+ char *outname = maketempname (++tempcount);
+ FILE *ostream = fopen (outname, "w");
+ long tempsize = 0;
+
+ if (!ostream)
+ pfatal_with_name (outname);
+ tempfiles[i] = outname;
+
+ /* Copy lines into this temp file as long as it does not make file
+ "too big" or until there are no more lines. */
+
+ while (tempsize + linelength + 1 <= MAX_IN_CORE_SORT)
+ {
+ tempsize += linelength + 1;
+ fputs (lb.buffer, ostream);
+ putc ('\n', ostream);
+
+ /* Read another line of input data. */
+
+ linelength = readline (&lb, istream);
+ if (!linelength && feof (istream))
+ break;
+
+ if (lb.buffer[0] != '\\' && lb.buffer[0] != '@')
+ {
+ error ("%s: not a texinfo index file", infile);
+ failure = 1;
+ goto fail;
+ }
+ }
+ fclose (ostream);
+ if (feof (istream))
+ break;
+ }
+
+ free (lb.buffer);
+
+fail:
+ /* Record number of temp files we actually needed. */
+
+ ntemps = i;
+
+ /* Sort each tempfile into another tempfile.
+ Delete the first set of tempfiles and put the names of the second
+ into `tempfiles'. */
+
+ for (i = 0; i < ntemps; i++)
+ {
+ char *newtemp = maketempname (++tempcount);
+ sort_in_core (&tempfiles[i], MAX_IN_CORE_SORT, newtemp);
+ if (!keep_tempfiles)
+ unlink (tempfiles[i]);
+ tempfiles[i] = newtemp;
+ }
+
+ if (failure)
+ return;
+
+ /* Merge the tempfiles together and indexify. */
+
+ merge_files (tempfiles, ntemps, outfile);
+}
+
+/* Sort INFILE, whose size is TOTAL,
+ assuming that is small enough to be done in-core,
+ then indexify it and send the output to OUTFILE (or to stdout). */
+
+void
+sort_in_core (infile, total, outfile)
+ char *infile;
+ long total;
+ char *outfile;
+{
+ char **nextline;
+ char *data = (char *) xmalloc (total + 1);
+ char *file_data;
+ long file_size;
+ int i;
+ FILE *ostream = stdout;
+ struct lineinfo *lineinfo;
+
+ /* Read the contents of the file into the moby array `data'. */
+
+ int desc = open (infile, O_RDONLY, 0);
+
+ if (desc < 0)
+ fatal ("failure reopening %s", infile);
+ for (file_size = 0;;)
+ {
+ i = read (desc, data + file_size, total - file_size);
+ if (i <= 0)
+ break;
+ file_size += i;
+ }
+ file_data = data;
+ data[file_size] = 0;
+
+ close (desc);
+
+ if (file_size > 0 && data[0] != '\\' && data[0] != '@')
+ {
+ error ("%s: not a texinfo index file", infile);
+ return;
+ }
+
+ init_char_order ();
+
+ /* Sort routines want to know this address. */
+
+ text_base = data;
+
+ /* Create the array of pointers to lines, with a default size
+ frequently enough. */
+
+ nlines = total / 50;
+ if (!nlines)
+ nlines = 2;
+ linearray = (char **) xmalloc (nlines * sizeof (char *));
+
+ /* `nextline' points to the next free slot in this array.
+ `nlines' is the allocated size. */
+
+ nextline = linearray;
+
+ /* Parse the input file's data, and make entries for the lines. */
+
+ nextline = parsefile (infile, nextline, file_data, file_size);
+ if (nextline == 0)
+ {
+ error ("%s: not a texinfo index file", infile);
+ return;
+ }
+
+ /* Sort the lines. */
+
+ /* If we have enough space, find the first keyfield of each line in advance.
+ Make a `struct lineinfo' for each line, which records the keyfield
+ as well as the line, and sort them. */
+
+ lineinfo = (struct lineinfo *) malloc ((nextline - linearray) * sizeof (struct lineinfo));
+
+ if (lineinfo)
+ {
+ struct lineinfo *lp;
+ char **p;
+
+ for (lp = lineinfo, p = linearray; p != nextline; lp++, p++)
+ {
+ lp->text = *p;
+ lp->key.text = find_field (keyfields, *p, &lp->keylen);
+ if (keyfields->numeric)
+ lp->key.number = find_value (lp->key.text, lp->keylen);
+ }
+
+ qsort (lineinfo, nextline - linearray, sizeof (struct lineinfo),
+ compare_prepared);
+
+ for (lp = lineinfo, p = linearray; p != nextline; lp++, p++)
+ *p = lp->text;
+
+ free (lineinfo);
+ }
+ else
+ qsort (linearray, nextline - linearray, sizeof (char *), compare_full);
+
+ /* Open the output file. */
+
+ if (outfile)
+ {
+ ostream = fopen (outfile, "w");
+ if (!ostream)
+ pfatal_with_name (outfile);
+ }
+
+ writelines (linearray, nextline - linearray, ostream);
+ if (outfile)
+ fclose (ostream);
+
+ free (linearray);
+ free (data);
+}
+
+/* Parse an input string in core into lines.
+ DATA is the input string, and SIZE is its length.
+ Data goes in LINEARRAY starting at NEXTLINE.
+ The value returned is the first entry in LINEARRAY still unused.
+ Value 0 means input file contents are invalid. */
+
+char **
+parsefile (filename, nextline, data, size)
+ char *filename;
+ char **nextline;
+ char *data;
+ long size;
+{
+ char *p, *end;
+ char **line = nextline;
+
+ p = data;
+ end = p + size;
+ *end = 0;
+
+ while (p != end)
+ {
+ if (p[0] != '\\' && p[0] != '@')
+ return 0;
+
+ *line = p;
+ while (*p && *p != '\n')
+ p++;
+ if (p != end)
+ p++;
+
+ line++;
+ if (line == linearray + nlines)
+ {
+ char **old = linearray;
+ linearray = (char **) xrealloc (linearray, sizeof (char *) * (nlines *= 4));
+ line += linearray - old;
+ }
+ }
+
+ return line;
+}
+
+/* Indexification is a filter applied to the sorted lines
+ as they are being written to the output file.
+ Multiple entries for the same name, with different page numbers,
+ get combined into a single entry with multiple page numbers.
+ The first braced field, which is used for sorting, is discarded.
+ However, its first character is examined, folded to lower case,
+ and if it is different from that in the previous line fed to us
+ a \initial line is written with one argument, the new initial.
+
+ If an entry has four braced fields, then the second and third
+ constitute primary and secondary names.
+ In this case, each change of primary name
+ generates a \primary line which contains only the primary name,
+ and in between these are \secondary lines which contain
+ just a secondary name and page numbers. */
+
+/* The last primary name we wrote a \primary entry for.
+ If only one level of indexing is being done, this is the last name seen. */
+char *lastprimary;
+/* Length of storage allocated for lastprimary. */
+int lastprimarylength;
+
+/* Similar, for the secondary name. */
+char *lastsecondary;
+int lastsecondarylength;
+
+/* Zero if we are not in the middle of writing an entry.
+ One if we have written the beginning of an entry but have not
+ yet written any page numbers into it.
+ Greater than one if we have written the beginning of an entry
+ plus at least one page number. */
+int pending;
+
+/* The initial (for sorting purposes) of the last primary entry written.
+ When this changes, a \initial {c} line is written */
+
+char *lastinitial;
+
+int lastinitiallength;
+
+/* When we need a string of length 1 for the value of lastinitial,
+ store it here. */
+
+char lastinitial1[2];
+
+/* Initialize static storage for writing an index. */
+
+void
+init_index ()
+{
+ pending = 0;
+ lastinitial = lastinitial1;
+ lastinitial1[0] = 0;
+ lastinitial1[1] = 0;
+ lastinitiallength = 0;
+ lastprimarylength = 100;
+ lastprimary = (char *) xmalloc (lastprimarylength + 1);
+ memset (lastprimary, '\0', lastprimarylength + 1);
+ lastsecondarylength = 100;
+ lastsecondary = (char *) xmalloc (lastsecondarylength + 1);
+ memset (lastsecondary, '\0', lastsecondarylength + 1);
+}
+
+/* Indexify. Merge entries for the same name,
+ insert headers for each initial character, etc. */
+
+void
+indexify (line, ostream)
+ char *line;
+ FILE *ostream;
+{
+ char *primary, *secondary, *pagenumber;
+ int primarylength, secondarylength = 0, pagelength;
+ int nosecondary;
+ int initiallength;
+ char *initial;
+ char initial1[2];
+ register char *p;
+
+ /* First, analyze the parts of the entry fed to us this time. */
+
+ p = find_braced_pos (line, 0, 0, 0);
+ if (*p == '{')
+ {
+ initial = p;
+ /* Get length of inner pair of braces starting at `p',
+ including that inner pair of braces. */
+ initiallength = find_braced_end (p + 1) + 1 - p;
+ }
+ else
+ {
+ initial = initial1;
+ initial1[0] = *p;
+ initial1[1] = 0;
+ initiallength = 1;
+
+ if (initial1[0] >= 'a' && initial1[0] <= 'z')
+ initial1[0] -= 040;
+ }
+
+ pagenumber = find_braced_pos (line, 1, 0, 0);
+ pagelength = find_braced_end (pagenumber) - pagenumber;
+ if (pagelength == 0)
+ abort ();
+
+ primary = find_braced_pos (line, 2, 0, 0);
+ primarylength = find_braced_end (primary) - primary;
+
+ secondary = find_braced_pos (line, 3, 0, 0);
+ nosecondary = !*secondary;
+ if (!nosecondary)
+ secondarylength = find_braced_end (secondary) - secondary;
+
+ /* If the primary is different from before, make a new primary entry. */
+ if (strncmp (primary, lastprimary, primarylength))
+ {
+ /* Close off current secondary entry first, if one is open. */
+ if (pending)
+ {
+ fputs ("}\n", ostream);
+ pending = 0;
+ }
+
+ /* If this primary has a different initial, include an entry for
+ the initial. */
+ if (initiallength != lastinitiallength ||
+ strncmp (initial, lastinitial, initiallength))
+ {
+ fprintf (ostream, "\\initial {");
+ fwrite (initial, 1, initiallength, ostream);
+ fprintf (ostream, "}\n", initial);
+ if (initial == initial1)
+ {
+ lastinitial = lastinitial1;
+ *lastinitial1 = *initial1;
+ }
+ else
+ {
+ lastinitial = initial;
+ }
+ lastinitiallength = initiallength;
+ }
+
+ /* Make the entry for the primary. */
+ if (nosecondary)
+ fputs ("\\entry {", ostream);
+ else
+ fputs ("\\primary {", ostream);
+ fwrite (primary, primarylength, 1, ostream);
+ if (nosecondary)
+ {
+ fputs ("}{", ostream);
+ pending = 1;
+ }
+ else
+ fputs ("}\n", ostream);
+
+ /* Record name of most recent primary. */
+ if (lastprimarylength < primarylength)
+ {
+ lastprimarylength = primarylength + 100;
+ lastprimary = (char *) xrealloc (lastprimary,
+ 1 + lastprimarylength);
+ }
+ strncpy (lastprimary, primary, primarylength);
+ lastprimary[primarylength] = 0;
+
+ /* There is no current secondary within this primary, now. */
+ lastsecondary[0] = 0;
+ }
+
+ /* Should not have an entry with no subtopic following one with a subtopic. */
+
+ if (nosecondary && *lastsecondary)
+ error ("entry %s follows an entry with a secondary name", line);
+
+ /* Start a new secondary entry if necessary. */
+ if (!nosecondary && strncmp (secondary, lastsecondary, secondarylength))
+ {
+ if (pending)
+ {
+ fputs ("}\n", ostream);
+ pending = 0;
+ }
+
+ /* Write the entry for the secondary. */
+ fputs ("\\secondary {", ostream);
+ fwrite (secondary, secondarylength, 1, ostream);
+ fputs ("}{", ostream);
+ pending = 1;
+
+ /* Record name of most recent secondary. */
+ if (lastsecondarylength < secondarylength)
+ {
+ lastsecondarylength = secondarylength + 100;
+ lastsecondary = (char *) xrealloc (lastsecondary,
+ 1 + lastsecondarylength);
+ }
+ strncpy (lastsecondary, secondary, secondarylength);
+ lastsecondary[secondarylength] = 0;
+ }
+
+ /* Here to add one more page number to the current entry. */
+ if (pending++ != 1)
+ fputs (", ", ostream); /* Punctuate first, if this is not the first. */
+ fwrite (pagenumber, pagelength, 1, ostream);
+}
+
+/* Close out any unfinished output entry. */
+
+void
+finish_index (ostream)
+ FILE *ostream;
+{
+ if (pending)
+ fputs ("}\n", ostream);
+ free (lastprimary);
+ free (lastsecondary);
+}
+
+/* Copy the lines in the sorted order.
+ Each line is copied out of the input file it was found in. */
+
+void
+writelines (linearray, nlines, ostream)
+ char **linearray;
+ int nlines;
+ FILE *ostream;
+{
+ char **stop_line = linearray + nlines;
+ char **next_line;
+
+ init_index ();
+
+ /* Output the text of the lines, and free the buffer space. */
+
+ for (next_line = linearray; next_line != stop_line; next_line++)
+ {
+ /* If -u was specified, output the line only if distinct from previous one. */
+ if (next_line == linearray
+ /* Compare previous line with this one, using only the
+ explicitly specd keyfields. */
+ || compare_general (*(next_line - 1), *next_line, 0L, 0L, num_keyfields - 1))
+ {
+ char *p = *next_line;
+ char c;
+
+ while ((c = *p++) && c != '\n')
+ /* Do nothing. */ ;
+ *(p - 1) = 0;
+ indexify (*next_line, ostream);
+ }
+ }
+
+ finish_index (ostream);
+}
+
+/* Assume (and optionally verify) that each input file is sorted;
+ merge them and output the result.
+ Returns nonzero if any input file fails to be sorted.
+
+ This is the high-level interface that can handle an unlimited
+ number of files. */
+
+#define MAX_DIRECT_MERGE 10
+
+int
+merge_files (infiles, nfiles, outfile)
+ char **infiles;
+ int nfiles;
+ char *outfile;
+{
+ char **tempfiles;
+ int ntemps;
+ int i;
+ int value = 0;
+ int start_tempcount = tempcount;
+
+ if (nfiles <= MAX_DIRECT_MERGE)
+ return merge_direct (infiles, nfiles, outfile);
+
+ /* Merge groups of MAX_DIRECT_MERGE input files at a time,
+ making a temporary file to hold each group's result. */
+
+ ntemps = (nfiles + MAX_DIRECT_MERGE - 1) / MAX_DIRECT_MERGE;
+ tempfiles = (char **) xmalloc (ntemps * sizeof (char *));
+ for (i = 0; i < ntemps; i++)
+ {
+ int nf = MAX_DIRECT_MERGE;
+ if (i + 1 == ntemps)
+ nf = nfiles - i * MAX_DIRECT_MERGE;
+ tempfiles[i] = maketempname (++tempcount);
+ value |= merge_direct (&infiles[i * MAX_DIRECT_MERGE], nf, tempfiles[i]);
+ }
+
+ /* All temporary files that existed before are no longer needed
+ since their contents have been merged into our new tempfiles.
+ So delete them. */
+ flush_tempfiles (start_tempcount);
+
+ /* Now merge the temporary files we created. */
+
+ merge_files (tempfiles, ntemps, outfile);
+
+ free (tempfiles);
+
+ return value;
+}
+
+/* Assume (and optionally verify) that each input file is sorted;
+ merge them and output the result.
+ Returns nonzero if any input file fails to be sorted.
+
+ This version of merging will not work if the number of
+ input files gets too high. Higher level functions
+ use it only with a bounded number of input files. */
+
+int
+merge_direct (infiles, nfiles, outfile)
+ char **infiles;
+ int nfiles;
+ char *outfile;
+{
+ struct linebuffer *lb1, *lb2;
+ struct linebuffer **thisline, **prevline;
+ FILE **streams;
+ int i;
+ int nleft;
+ int lossage = 0;
+ int *file_lossage;
+ struct linebuffer *prev_out = 0;
+ FILE *ostream = stdout;
+
+ if (outfile)
+ {
+ ostream = fopen (outfile, "w");
+ }
+ if (!ostream)
+ pfatal_with_name (outfile);
+
+ init_index ();
+
+ if (nfiles == 0)
+ {
+ if (outfile)
+ fclose (ostream);
+ return 0;
+ }
+
+ /* For each file, make two line buffers.
+ Also, for each file, there is an element of `thisline'
+ which points at any time to one of the file's two buffers,
+ and an element of `prevline' which points to the other buffer.
+ `thisline' is supposed to point to the next available line from the file,
+ while `prevline' holds the last file line used,
+ which is remembered so that we can verify that the file is properly sorted. */
+
+ /* lb1 and lb2 contain one buffer each per file. */
+ lb1 = (struct linebuffer *) xmalloc (nfiles * sizeof (struct linebuffer));
+ lb2 = (struct linebuffer *) xmalloc (nfiles * sizeof (struct linebuffer));
+
+ /* thisline[i] points to the linebuffer holding the next available line in file i,
+ or is zero if there are no lines left in that file. */
+ thisline = (struct linebuffer **)
+ xmalloc (nfiles * sizeof (struct linebuffer *));
+ /* prevline[i] points to the linebuffer holding the last used line
+ from file i. This is just for verifying that file i is properly
+ sorted. */
+ prevline = (struct linebuffer **)
+ xmalloc (nfiles * sizeof (struct linebuffer *));
+ /* streams[i] holds the input stream for file i. */
+ streams = (FILE **) xmalloc (nfiles * sizeof (FILE *));
+ /* file_lossage[i] is nonzero if we already know file i is not
+ properly sorted. */
+ file_lossage = (int *) xmalloc (nfiles * sizeof (int));
+
+ /* Allocate and initialize all that storage. */
+
+ for (i = 0; i < nfiles; i++)
+ {
+ initbuffer (&lb1[i]);
+ initbuffer (&lb2[i]);
+ thisline[i] = &lb1[i];
+ prevline[i] = &lb2[i];
+ file_lossage[i] = 0;
+ streams[i] = fopen (infiles[i], "r");
+ if (!streams[i])
+ pfatal_with_name (infiles[i]);
+
+ readline (thisline[i], streams[i]);
+ }
+
+ /* Keep count of number of files not at eof. */
+ nleft = nfiles;
+
+ while (nleft)
+ {
+ struct linebuffer *best = 0;
+ struct linebuffer *exch;
+ int bestfile = -1;
+ int i;
+
+ /* Look at the next avail line of each file; choose the least one. */
+
+ for (i = 0; i < nfiles; i++)
+ {
+ if (thisline[i] &&
+ (!best ||
+ 0 < compare_general (best->buffer, thisline[i]->buffer,
+ (long) bestfile, (long) i, num_keyfields)))
+ {
+ best = thisline[i];
+ bestfile = i;
+ }
+ }
+
+ /* Output that line, unless it matches the previous one and we
+ don't want duplicates. */
+
+ if (!(prev_out &&
+ !compare_general (prev_out->buffer,
+ best->buffer, 0L, 1L, num_keyfields - 1)))
+ indexify (best->buffer, ostream);
+ prev_out = best;
+
+ /* Now make the line the previous of its file, and fetch a new
+ line from that file. */
+
+ exch = prevline[bestfile];
+ prevline[bestfile] = thisline[bestfile];
+ thisline[bestfile] = exch;
+
+ while (1)
+ {
+ /* If the file has no more, mark it empty. */
+
+ if (feof (streams[bestfile]))
+ {
+ thisline[bestfile] = 0;
+ /* Update the number of files still not empty. */
+ nleft--;
+ break;
+ }
+ readline (thisline[bestfile], streams[bestfile]);
+ if (thisline[bestfile]->buffer[0] || !feof (streams[bestfile]))
+ break;
+ }
+ }
+
+ finish_index (ostream);
+
+ /* Free all storage and close all input streams. */
+
+ for (i = 0; i < nfiles; i++)
+ {
+ fclose (streams[i]);
+ free (lb1[i].buffer);
+ free (lb2[i].buffer);
+ }
+ free (file_lossage);
+ free (lb1);
+ free (lb2);
+ free (thisline);
+ free (prevline);
+ free (streams);
+
+ if (outfile)
+ fclose (ostream);
+
+ return lossage;
+}
+
+/* Print error message and exit. */
+
+void
+fatal (format, arg)
+ char *format, *arg;
+{
+ error (format, arg);
+ exit (TI_FATAL_ERROR);
+}
+
+/* Print error message. FORMAT is printf control string, ARG is arg for it. */
+void
+error (format, arg)
+ char *format, *arg;
+{
+ printf ("%s: ", program_name);
+ printf (format, arg);
+ if (format[strlen (format) -1] != '\n')
+ printf ("\n");
+}
+
+void
+perror_with_name (name)
+ char *name;
+{
+ char *s;
+
+ s = strerror (errno);
+ printf ("%s: ", program_name);
+ printf ("%s; for file `%s'.\n", s, name);
+}
+
+void
+pfatal_with_name (name)
+ char *name;
+{
+ char *s;
+
+ s = strerror (errno);
+ printf ("%s: ", program_name);
+ printf ("%s; for file `%s'.\n", s, name);
+ exit (TI_FATAL_ERROR);
+}
+
+/* Return a newly-allocated string whose contents concatenate those of
+ S1, S2, S3. */
+
+char *
+concat (s1, s2, s3)
+ char *s1, *s2, *s3;
+{
+ int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3);
+ char *result = (char *) xmalloc (len1 + len2 + len3 + 1);
+
+ strcpy (result, s1);
+ strcpy (result + len1, s2);
+ strcpy (result + len1 + len2, s3);
+ *(result + len1 + len2 + len3) = 0;
+
+ return result;
+}
+
+#if !defined (HAVE_STRERROR)
+extern char *sys_errlist[];
+extern int sys_nerr;
+
+char *
+strerror (num)
+ int num;
+{
+ if (num >= sys_nerr)
+ return ("");
+ else
+ return (sys_errlist[num]);
+}
+#endif /* !HAVE_STRERROR */
+
+#if !defined (HAVE_STRCHR)
+char *
+strrchr (string, character)
+ char *string;
+ int character;
+{
+ register int i;
+
+ for (i = strlen (string) - 1; i > -1; i--)
+ if (string[i] == character)
+ return (string + i);
+
+ return ((char *)NULL);
+}
+#endif /* HAVE_STRCHR */
+
+/* Just like malloc, but kills the program in case of fatal error. */
+void *
+xmalloc (nbytes)
+ int nbytes;
+{
+ void *temp = (void *) malloc (nbytes);
+
+ if (nbytes && temp == (void *)NULL)
+ memory_error ("xmalloc", nbytes);
+
+ return (temp);
+}
+
+/* Like realloc (), but barfs if there isn't enough memory. */
+void *
+xrealloc (pointer, nbytes)
+ void *pointer;
+ int nbytes;
+{
+ void *temp;
+
+ if (!pointer)
+ temp = (void *)xmalloc (nbytes);
+ else
+ temp = (void *)realloc (pointer, nbytes);
+
+ if (nbytes && !temp)
+ memory_error ("xrealloc", nbytes);
+
+ return (temp);
+}
+
+memory_error (callers_name, bytes_wanted)
+ char *callers_name;
+ int bytes_wanted;
+{
+ char printable_string[80];
+
+ sprintf (printable_string,
+ "Virtual memory exhausted in %s ()! Needed %d bytes.",
+ callers_name, bytes_wanted);
+
+ error (printable_string);
+ abort ();
+}
+
diff --git a/xiberty/configure.in b/xiberty/configure.in
new file mode 100644
index 00000000000..2729c096a49
--- /dev/null
+++ b/xiberty/configure.in
@@ -0,0 +1,101 @@
+# This file is a shell script fragment that supplies the information
+# necessary for a configure script to process the program in
+# this directory. For more information, look at ../configure.
+
+# We need multilib support.
+. ${srcdir}/../cfg-ml-com.in
+
+configdirs=
+srctrigger=../libiberty/getopt1.c
+srcname="cross -liberty library"
+Makefile_in=../libiberty/Makefile.in
+
+case "$srcdir" in
+ ".") ;;
+ *) srcdir=${srcdir}/../libiberty ;;
+esac
+
+# per-host:
+
+# per-target:
+
+files="../libiberty/alloca-norm.h"
+links="alloca-conf.h"
+
+xhost=${target}
+xsrcdir=../libiberty/
+. ${srcdir}/../libiberty/config.table
+target_makefile_frag=${frag}
+
+case "$srcdir" in
+ ".")
+ # Make sure we also make links to all the source files
+ source_files=`echo ../libiberty/*.[ch] ../libiberty/functions.def`
+ files="${files} ${source_files}"
+ source_links=`echo "$source_files" | sed -e 's|../libiberty/||g'`
+ links="${links} ${source_links}"
+ ;;
+ *)
+ ;;
+esac
+
+# post-target:
+
+# if we are candian crossing the we need to pick up host copies of
+# the tools, otherwise we can look in the current tree
+# but we shouldn't build xiberty if we're not canadian crossing.
+if [ "${host}" != "${target}" ] ; then
+ echo "CC = ${target_alias}-gcc" > Makefile.tem
+ echo "AR = ${target_alias}-ar " >> Makefile.tem
+ echo "RANLIB = ${target_alias}-ranlib " >> Makefile.tem
+else
+ echo > Makefile.tem
+fi
+
+echo "INSTALL_DEST = tooldir" >> Makefile.tem
+
+# If we are cross-compiling, check at compile time whether we are
+# using newlib. If we are, we already know the files we need, since
+# the linker will fail when run on some of the newlib targets.
+if [ "${host}" != "${target}" ] ; then
+ cat > Makefile.tem2 <<'!EOF!'
+CONFIG_H = xconfig.h
+NEEDED_LIST = xneeded-list
+
+xconfig.h: Makefile
+ if [ -f ../newlib/Makefile ]; then \
+ echo "#define NEED_sys_nerr 1" >xconfig.h; \
+ echo "#define NEED_sys_errlist 1" >>xconfig.h; \
+ echo "#define NEED_sys_siglist 1" >>xconfig.h; \
+ echo "#define NEED_psignal 1" >>xconfig.h; \
+ else \
+ $(MAKE) $(FLAGS_TO_PASS) lconfig.h; \
+ cp lconfig.h xconfig.h; \
+ fi
+
+xneeded-list: Makefile
+ if [ -f ../newlib/Makefile ]; then \
+ echo insque.o random.o strdup.o alloca.o >xneeded-list; \
+ else \
+ $(MAKE) $(FLAGS_TO_PASS) lneeded-list; \
+ cp lneeded-list xneeded-list; \
+ fi
+!EOF!
+fi
+sed -e "/^####/ r Makefile.tem" -e "/^####/ r Makefile.tem2" ${Makefile} > Makefile.tem3
+mv Makefile.tem3 ${Makefile}
+rm -f Makefile.tem Makefile.tem2
+
+if [ "${srcdir}" = "." ] ; then
+ echo "EXTRA_LINKS = ${source_links}" >>Makefile
+fi
+mv Makefile Makefile.tmp
+# Patch 'install' and 'Makefile' rules in Makefile
+# (The latter is only needed when "$srcdir" = ".".)
+sed <Makefile.tmp -e '/INSTALL_DEST =/s/libdir/tooldir/' \
+ -e '/Makefile/s|(srcdir)/Makefile.in|(srcdir)/../libiberty/Makefile.in|' \
+ >Makefile
+rm -f Makefile.tmp
+
+# We need multilib support.
+. ${srcdir}/../cfg-ml-pos.in
diff --git a/ylwrap b/ylwrap
new file mode 100755
index 00000000000..b5b62184383
--- /dev/null
+++ b/ylwrap
@@ -0,0 +1,107 @@
+#! /bin/sh
+# ylwrap - wrapper for lex/yacc invocations.
+# Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+# Written by Tom Tromey <tromey@cygnus.com>.
+#
+# This program 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.
+#
+# This program 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 this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# Usage:
+# ylwrap PROGRAM INPUT [OUTPUT DESIRED]... -- [ARGS]...
+# * PROGRAM is program to run.
+# * INPUT is the input file
+# * OUTPUT is file PROG generates
+# * DESIRED is file we actually want
+# * ARGS are passed to PROG
+# Any number of OUTPUT,DESIRED pairs may be used.
+
+# The program to run.
+prog="$1"
+shift
+# Make any relative path in $prog absolute.
+case "$prog" in
+ /*) ;;
+ */*) prog="`pwd`/$prog" ;;
+esac
+
+# The input.
+input="$1"
+shift
+case "$input" in
+ /*)
+ # Absolute path; do nothing.
+ ;;
+ *)
+ # Relative path. Make it absolute. Why? Because otherwise any
+ # debugging info in the generated file will point to the wrong
+ # place. This is really gross.
+ input="`pwd`/$input"
+ ;;
+esac
+
+pairlist=
+while test "$#" -ne 0; do
+ if test "$1" = "--"; then
+ shift
+ break
+ fi
+ pairlist="$pairlist $1"
+ shift
+done
+
+# FIXME: add hostname here for parallel makes that run commands on
+# other machines. But that might take us over the 14-char limit.
+dirname=ylwrap$$
+trap "cd `pwd`; rm -rf $dirname > /dev/null 2>&1" 1 2 3 15
+mkdir $dirname || exit 1
+
+cd $dirname
+$prog ${1+"$@"} "$input"
+status=$?
+
+if test $status -eq 0; then
+ set X $pairlist
+ shift
+ first=yes
+ while test "$#" -ne 0; do
+ if test -f "$1"; then
+ # If $2 is an absolute path name, then just use that,
+ # otherwise prepend `../'.
+ case "$2" in
+ /*) target="$2";;
+ *) target="../$2";;
+ esac
+ mv "$1" "$target" || status=$?
+ else
+ # A missing file is only an error for the first file. This
+ # is a blatant hack to let us support using "yacc -d". If -d
+ # is not specified, we don't want an error when the header
+ # file is "missing".
+ if test $first = yes; then
+ status=1
+ fi
+ fi
+ shift
+ shift
+ first=no
+ done
+else
+ status=$?
+fi
+
+# Remove the directory.
+cd ..
+rm -rf $dirname
+
+exit $status